Function SET190A
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_190);
********** COMMENT(Function .......: SET190A);
********** COMMENT(Created on .....: 26/07/00 at 14:43:32);
********** COMMENT(Description ....: Select and present a poll);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(offer polls on the internet.);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as an);
********** COMMENT(example only. No warranty is expressed or implied.);
********** COMMENT();
********** COMMENT();
********** COMMENT(Receives: nothing);
********** COMMENT();
********** COMMENT(=======================================================);
********** COMMENT(Function control options);
FUNCTION OPTIONS(*DIRECT *WEBEVENT);
********** COMMENT();
********** COMMENT(Group and field definitions);
********** COMMENT();
GROUP_BY NAME(#S_GRPPDF) FIELDS((#S_190PID)(#S_190PDS)(#S_190PPW)(#S_190PBN)(#S_190PST));
GROUP_BY NAME(#S_GRPPQU) FIELDS((#S_190PID)(#S_190PQN)(#S_190PQA)(#S_190PQL)(#S_190PQS));
GROUP_BY NAME(#S_GRPPQS) FIELDS((#S_190PID)(#S_190PQN)(#S_190PSN)(#S_190PSA)(#S_190PSL));
GROUP_BY NAME(#S_GRPPRA) FIELDS((#S_190PID)(#S_190RID)(#S_190PQN)(#S_190PSN)(#S_190RV)(#S_190RANK));
GROUP_BY NAME(#S_GRPPRE) FIELDS((#S_190PID)(#S_190RID)(#S_190RNM)(#S_190RAG));
********** COMMENT();
DEFINE FIELD(#S_190PSNW) REFFLD(#S_190PSN);
DEFINE FIELD(#S_190SELF) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('This entry is selected 1-0');
DEFINE FIELD(#S_190SE) TYPE(*CHAR) LENGTH(010) DESC('Holds browselist entry component name') COLHDG('Selection');
DEFINE FIELD(#S_190QENT) REFFLD(#LISTCOUNT) DESC('Current list entry');
DEFINE FIELD(#S_190QCNT) REFFLD(#LISTCOUNT) DESC('Number of quest in this poll');
********** COMMENT();
DEFINE FIELD(#S_190UPW) REFFLD(#S_190PPW);
DEFINE FIELD(#S_190CBOX) TYPE(*CHAR) LENGTH(001) DESC('Checkbox value');
DEFINE FIELD(#S_190NXT) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('1 indicates next button is to be used');
DEFINE FIELD(#S_190PRV) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('1 indicates prev button is to be used');
DEFINE FIELD(#S_190FIN) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('1 indicates prev button is to be used');
DEFINE FIELD(#S_190NXTQ) REFFLD(#S_190PQN) DESC('Next Question number');
DEFINE FIELD(#S_190PSWF) TYPE(*CHAR) LENGTH(020) DESC('Password Required Indicator') INPUT_ATR(LC);
********** COMMENT();
OVERRIDE FIELD(#STD_COUNT) LABEL('Iteration');
********** COMMENT();
********** COMMENT();
********** COMMENT(Mainline);
********** COMMENT();
CHANGE FIELD(#S_FUNDES) TO(*FUNCTION_DESC);
********** COMMENT();
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= *BLANKS');
********** COMMENT(first time in);
CHANGE FIELD(#STDRENTRY) TO(P);
********** COMMENT();
********** COMMENT(List all the open polls - allow the user to select);
********** COMMENT(Set selection field to a general purpose selector);
********** COMMENT(component.);
CHANGE FIELD(#S_190SE) TO(S_190SEGP);
DEF_LIST NAME(#S_190PDF) FIELDS((#S_190SE *INPUT)(#S_190PDS *OUTPUT)(#S_190PSWF *OUTPUT)(#S_190PID *HIDDEN));
CLR_LIST NAMED(#S_190PDF);
********** COMMENT();
SELECT FIELDS(#S_GRPPDF) FROM_FILE(SETPDF);
IF COND('#S_190PST *EQ OPEN');
********** COMMENT(Indicate whether a password is required on the list);
IF COND('#S_190PPW *EQ NONE');
CHANGE FIELD(#S_190PSWF) TO(*BLANKS);
ELSE;
CHANGE FIELD(#S_190PSWF) TO('''(Password Required)''');
ENDIF;
ADD_ENTRY TO_LIST(#S_190PDF);
ENDIF;
ENDSELECT;
CHANGE FIELD(#S_190PBN) TO(*NULL);
CHANGE FIELD(#S_190HDR) TO(S_190HDRBLANK);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190RID *HIDDEN)(#STDRENTRY *HIDDEN)(#STDROWNUM *HIDDEN)(#S_ACTIONX *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(The browselist is displayed via component S_190HDRBLANK);
********** COMMENT(so that it can be positioned within the text);
IF COND('1 *EQ 2');
REQUEST BROWSELIST(#S_190PDF) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
********** COMMENT();
WHEN VALUE_IS('= P');
********** COMMENT(user has selected a poll);
IF COND('#S_190RID *EQ 0');
********** COMMENT(assign the user an identifer #S_190RID);
CHANGE FIELD(#S_190RID) TO(*AUTONUM15S_190RID);
ELSE;
********** COMMENT(get the repondent details previously entered);
FETCH FIELDS((#S_190RNM)(#S_190RAG)) FROM_FILE(SETPREL1) WITH_KEY(#S_190RID);
ENDIF;
********** COMMENT();
********** COMMENT(Get the selected entry from the list of polls);
GET_ENTRY NUMBER(#STDROWNUM) FROM_LIST(#S_190PDF);
FETCH FIELDS(#S_GRPPDF) FROM_FILE(SETPDF) WITH_KEY(#S_190PID);
********** COMMENT(Request the user details and the password if required.);
********** COMMENT(- let the user drop out of the first case statement);
********** COMMENT(into the request password section of the second case);
********** COMMENT(statement.);
CHANGE FIELD(#STDRENTRY) TO(W);
********** COMMENT();
WHEN VALUE_IS('= R');
********** COMMENT(User has input a password and user details);
CHANGE FIELD(#S_190PPW) TO(*NULL);
FETCH FIELDS(#S_190PPW) FROM_FILE(SETPDF) WITH_KEY(#S_190PID);
********** COMMENT(If the user entered the right password, and their user);
********** COMMENT(details, let them drop out of the case statement,);
********** COMMENT(into the first question.);
********** COMMENT(Otherwise let them re-enter the password);
CHANGE FIELD(#STDRENTRY) TO(W);
IF COND('(#S_190UPW *EQ #S_190PPW) *OR (#S_190PPW *EQ NONE)');
CHECK_FOR IN_FILE(SETPRE) WITH_KEY(#S_190PID #S_190RID);
IF_STATUS IS(*EQUALKEY);
UPDATE FIELDS(#S_GRPPRE) IN_FILE(SETPRE) WITH_KEY(#S_190PID #S_190RID) VAL_ERROR(*NEXT);
ELSE;
INSERT FIELDS(#S_GRPPRE) TO_FILE(SETPRE) VAL_ERROR(*NEXT);
ENDIF;
IF_STATUS IS(*OKAY);
CHANGE FIELD(#STDRENTRY) TO(Q);
CHANGE FIELD(#S_ACTIONX) TO(NEXT);
CHANGE FIELD(#S_190QENT) TO(0);
ENDIF;
ELSE;
********** COMMENT(User entered blank or invalid password);
MESSAGE MSGTXT('Password invalid or not entered');
ENDIF;
********** COMMENT();
********** COMMENT();
ENDCASE;
********** COMMENT(Second Case statement.);
********** COMMENT(Allows multiple logic pathways to use the same REQUEST);
********** COMMENT(statement.);
********** COMMENT();
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= Q');
IF COND('#S_190QENT *NE 0');
********** COMMENT(Not the first question. Store the responses to the);
********** COMMENT(previous question.);
********** COMMENT();
FETCH FIELDS(#S_GRPPQU) FROM_FILE(SETPQU) WITH_KEY(#S_190PID #S_190PQN);
********** COMMENT();
********** COMMENT(Processing of the response varies according to the);
********** COMMENT(question type.);
********** COMMENT();
********** COMMENT(Delete any existing responses for this poll, user, and);
********** COMMENT(question (the user can re-do a question if they use);
********** COMMENT(the previous button));
DELETE FROM_FILE(SETPRA) WITH_KEY(#S_190PID #S_190RID #S_190PQN);
********** COMMENT();
CASE OF_FIELD(#S_190PQS);
WHEN VALUE_IS('= YESNO' '= YESNOUNK' '= SELECT');
********** COMMENT(User selects one entry: #S_190PSN contains the option);
********** COMMENT(number that the user selected.);
IF COND('#S_190PSN *NE 0');
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
ENDIF;
WHEN VALUE_IS('= RANK');
********** COMMENT(User assigns a rank to every entry);
********** COMMENT();
********** COMMENT(Standardize the users ranking numbers);
********** COMMENT(e.g. if the user entered ranks 10 40 60);
********** COMMENT(store these as ranks 1 2 3);
DEFINE FIELD(#S_190RNKW) REFFLD(#S_190RANK);
DEF_LIST NAME(#S_190RWRK) FIELDS((#S_190PSN)(#S_190RNKW)) TYPE(*WORKING);
CLR_LIST NAMED(#S_190RWRK);
SELECTLIST NAMED(#S_190SELS);
IF COND('#S_190RANK *NE 0');
CHANGE FIELD(#S_190RNKW) TO(#S_190RANK);
ADD_ENTRY TO_LIST(#S_190RWRK);
ENDIF;
ENDSELECT;
SORT_LIST NAMED(#S_190RWRK) BY_FIELDS((#S_190RNKW));
********** COMMENT();
CHANGE FIELD(#S_190RANK) TO(0);
SELECTLIST NAMED(#S_190RWRK);
CHANGE FIELD(#S_190RANK) TO('#S_190RANK + 1');
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
ENDSELECT;
********** COMMENT();
WHEN VALUE_IS('= MSELECT');
********** COMMENT(User can choose several selections);
SELECTLIST NAMED(#S_190SELS);
IF COND('#S_190CBOX *EQ Y');
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
ENDIF;
ENDSELECT;
WHEN VALUE_IS('= ANSWER');
********** COMMENT(User has entered a free format answer in #S_190RV);
GET_ENTRY NUMBER(1) FROM_LIST(#S_190SELS);
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
********** COMMENT();
ENDCASE;
ELSE;
********** COMMENT(This is the first time a question will be displayed);
********** COMMENT();
********** COMMENT(Get the complete list of questions in order of);
********** COMMENT(question sequence and store permanently in list);
********** COMMENT(that is always passed. (#S_190QN));
********** COMMENT();
CLR_LIST NAMED(#S_190QN);
SELECT FIELDS(#S_190PQN) FROM_FILE(SETPQUL3) WITH_KEY(#S_190PID);
ADD_ENTRY TO_LIST(#S_190QN);
ENDSELECT;
IF COND('#S_190QCNT *NE 0');
CHANGE FIELD(#S_190QENT) TO(0);
ELSE;
********** COMMENT(There are no questions in this poll);
CHANGE FIELD(#S_ACTIONX) TO(FINISH);
ENDIF;
ENDIF;
********** COMMENT(Determine which question is next);
********** COMMENT();
CASE OF_FIELD(#S_ACTIONX);
WHEN VALUE_IS('= NEXT');
********** COMMENT(Next Question);
CHANGE FIELD(#S_190QENT) TO('#S_190QENT + 1');
********** COMMENT();
WHEN VALUE_IS('= PREVIOUS');
********** COMMENT(Previous Question);
CHANGE FIELD(#S_190QENT) TO('#S_190QENT - 1');
WHEN VALUE_IS('= FINISH');
********** COMMENT(Finish Questions);
********** COMMENT(There are no more questions to display for this poll);
********** COMMENT(Thank the person doing the poll.);
********** COMMENT();
CHANGE FIELD(#STDRENTRY) TO(*NULL);
CHANGE FIELD(#S_190HDR) TO(S_190HDRLAST);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_190PQN *HIDDEN)(#S_190QENT *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDCASE;
********** COMMENT(Get the next question identifier);
GET_ENTRY NUMBER(#S_190QENT) FROM_LIST(#S_190QN);
FETCH FIELDS(#S_GRPPQU) FROM_FILE(SETPQU) WITH_KEY(#S_190PID #S_190PQN);
IF_STATUS IS(*OKAY);
********** COMMENT(Build the list of possible selections for this);
********** COMMENT(question.);
CHANGE FIELD(#S_190CBOX #S_190RANK #S_190RV) TO(*NULL);
********** COMMENT();
********** COMMENT(Browselist of components (*NOBIC));
DEF_LIST NAME(#S_190SELS) FIELDS((#S_190SE *INPUT)(#S_190PSN *HIDDEN)(#S_190PSA *HIDDEN)(#S_190PSL *HIDDEN)(#S_190CBOX *HIDDEN)(#S_190RANK *HIDDEN)(#S_190RV *HIDDEN));
********** COMMENT(Browselist of radio buttons (*NOBIC));
DEF_LIST NAME(#S_190OPTS) FIELDS((#S_190SE *INPUT)(#S_190PSN *HIDDEN)(#S_190SELF *HIDDEN)(#S_190PSA *HIDDEN)(#S_190PSL *HIDDEN)(#S_190CBOX *HIDDEN)(#S_190RANK *HIDDEN)(#S_190RV *HIDDEN));
********** COMMENT(Determine the appropriate component to be used to);
********** COMMENT(display each selection, based on the question style.);
CASE OF_FIELD(#S_190PQS);
WHEN VALUE_IS('= YESNO' '= YESNOUNK' '= SELECT');
********** COMMENT(User selects one entry);
WHEN VALUE_IS('= RANK');
********** COMMENT(User assigns a rank to every entry);
CHANGE FIELD(#S_190SE) TO(S_190SERK);
WHEN VALUE_IS('= MSELECT');
********** COMMENT(User can choose several selections);
CHANGE FIELD(#S_190SE) TO(S_190SECB);
WHEN VALUE_IS('= ANSWER');
********** COMMENT(Free format answer to question);
CHANGE FIELD(#S_190SE) TO(S_190SEAN);
ENDCASE;
********** COMMENT();
********** COMMENT(Determine whether the "previous question" button should);
********** COMMENT(be displayed.);
IF COND('#S_190QENT *EQ 1');
CHANGE FIELD(#S_190PRV) TO(0);
ELSE;
CHANGE FIELD(#S_190PRV) TO(1);
ENDIF;
********** COMMENT(Determine whether the "next question" or "finish");
********** COMMENT(buttons should be displayed);
CHANGE FIELD(#S_190NXT #S_190FIN) TO(*NULL);
IF COND('#S_190QENT *LT #S_190QCNT');
CHANGE FIELD(#S_190NXT) TO(1);
********** COMMENT(default to next if they don't press a button);
CHANGE FIELD(#S_ACTIONX) TO(NEXT);
ELSE;
CHANGE FIELD(#S_190FIN) TO(1);
********** COMMENT(default to finish if they don't press a button);
CHANGE FIELD(#S_ACTIONX) TO(FINISH);
ENDIF;
********** COMMENT();
********** COMMENT();
********** COMMENT(The type of list used depends on the Question type.);
CASE OF_FIELD(#S_190PQS);
WHEN VALUE_IS('= YESNO' '= YESNOUNK' '= SELECT');
********** COMMENT(When a single entry is chosen from a list of options);
********** COMMENT(a browselist of radio buttons is used.);
CLR_LIST NAMED(#S_190OPTS);
********** COMMENT(Browselist #S_190OPTS has no border, column headings or);
********** COMMENT(selection image.);
********** COMMENT(It has a graphic variable *LW3BL_S_190OPTS set to);
********** COMMENT(*NOBIC);
********** COMMENT();
********** COMMENT(determine what the user chose for this question);
********** COMMENT(previously (if anything));
CHANGE FIELD(#S_190PSN) TO(*NULL);
FETCH FIELDS(#S_190PSN) FROM_FILE(SETPRA) WITH_KEY(#S_190PID #S_190RID #S_190PQN);
CHANGE FIELD(#S_190PSNW) TO(#S_190PSN);
********** COMMENT();
********** COMMENT(Add the radio button entries to the list);
CHANGE FIELD(#S_190SE) TO(S_190SERB);
SELECT FIELDS(#S_GRPPQS) FROM_FILE(SETPQS) WITH_KEY(#S_190PID #S_190PQN);
********** COMMENT(<INPUT TYPE="RADIO" NAME="PS_190PSN" VALUE="1">Yes);
********** COMMENT();
********** COMMENT(Use #S_190SELF in an ONCONDITION in component S_190OOPT);
********** COMMENT(to set an entry to selected (CHECKED));
********** COMMENT(Under LANSA H9 this logic can be simplified because);
********** COMMENT(the ONCONDITION can compare #S_190PSN with a field);
********** COMMENT(value instead of requiring a flag.);
IF COND('#S_190PSNW *EQ #S_190PSN');
CHANGE FIELD(#S_190SELF) TO(1);
ELSE;
CHANGE FIELD(#S_190SELF) TO(*NULL);
ENDIF;
ADD_ENTRY TO_LIST(#S_190OPTS);
ENDSELECT;
********** COMMENT(Default to no row selected);
CHANGE FIELD(#S_190PSN) TO(*NULL);
********** COMMENT();
CHANGE FIELD(#S_190HDR) TO(S_190HDRQUESOPTS);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_190PQN *HIDDEN)(#S_190PQS *HIDDEN)(#S_190PQL *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190QENT *HIDDEN)(#STDROWNUM *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Display the browselist via component S_190QUESOPTS);
********** COMMENT(to allow positioning of the browselist);
IF COND('1 *EQ 2');
REQUEST BROWSELIST(#S_190OPTS) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
OTHERWISE;
********** COMMENT(For multi-selection or ranking or free format);
********** COMMENT(a browselist of components with input fields is used);
********** COMMENT(Browselist #S_190SELS has no border, column headings or);
********** COMMENT(selection image.);
********** COMMENT(It has a graphic variable *LW3BL_S_190SELS set to);
********** COMMENT(*NOBIC);
********** COMMENT();
CLR_LIST NAMED(#S_190SELS);
SELECT FIELDS(#S_GRPPQS) FROM_FILE(SETPQS) WITH_KEY(#S_190PID #S_190PQN);
********** COMMENT(Get any previous response by this individual that);
********** COMMENT(relates to this selection);
CHANGE FIELD(#S_190RV #S_190RANK) TO(*NULL);
FETCH FIELDS((#S_190RV)(#S_190RANK)) FROM_FILE(SETPRA) WITH_KEY(#S_190PID #S_190RID #S_190PQN #S_190PSN);
********** COMMENT();
ADD_ENTRY TO_LIST(#S_190SELS);
ENDSELECT;
********** COMMENT(Default to no row selected);
CHANGE FIELD(#STDROWNUM #S_190PSN) TO(*NULL);
********** COMMENT();
CHANGE FIELD(#S_190HDR) TO(S_190HDRQUESSELS);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_190PQN *HIDDEN)(#S_190PQS *HIDDEN)(#S_190PQL *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190QENT *HIDDEN)(#STDROWNUM *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Display the browselist via component S_190QUESSELS);
********** COMMENT(to allow positioning of the browselist);
IF COND('1 *EQ 2');
REQUEST BROWSELIST(#S_190SELS) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
ENDCASE;
ENDIF;
WHEN VALUE_IS('= W');
********** COMMENT(Ask for the password and user details (again));
CHANGE FIELD(#STDRENTRY) TO(R);
FETCH FIELDS(#S_190PDS) FROM_FILE(SETPDF) WITH_KEY(#S_190PID);
********** COMMENT();
IF COND('#S_190PPW *NE NONE');
CHANGE FIELD(#S_190HDR) TO(S_190HDRPASSWORD);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Note that fields #S_190UPW, #S_190RNM and #S_190RAG);
********** COMMENT(have been omitted from the request statement. This is);
********** COMMENT(because they are input capable fields displayed via the);
********** COMMENT(component S_190HDRPASSWORD.);
ELSE;
CHANGE FIELD(#S_190HDR) TO(S_190HDRUSERDET);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Note that fields #S_190RNM and #S_190RAG);
********** COMMENT(have been omitted from the request statement. This is);
********** COMMENT(because they are input capable fields displayed via the);
********** COMMENT(component S_190HDRUSERDET.);
ENDIF;
ENDCASE;
********** COMMENT();
********** COMMENT(The complete list of questions is always passed);
********** COMMENT(Note how #S_190QCNT gets passed with it automatically);
IF COND('1 *EQ 2');
********** COMMENT();
DEF_LIST NAME(#S_190QN) FIELDS(#S_190PQN) COUNTER(#S_190QCNT);
REQUEST BROWSELIST(#S_190QN) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
********** COMMENT();
********** COMMENT(=======================================================);
********** COMMENT(Process ........: SET_190);
********** COMMENT(Function .......: SET190A);
********** COMMENT(Created on .....: 26/07/00 at 14:43:32);
********** COMMENT(Description ....: Select and present a poll);
********** COMMENT(Version.........: 1);
********** COMMENT();
********** COMMENT(Full Description: The purpose of this function is to);
********** COMMENT(offer polls on the internet.);
********** COMMENT();
********** COMMENT(Disclaimer: The following material is supplied as an);
********** COMMENT(example only. No warranty is expressed or implied.);
********** COMMENT();
********** COMMENT();
********** COMMENT(Receives: nothing);
********** COMMENT();
********** COMMENT(=======================================================);
********** COMMENT(Function control options);
FUNCTION OPTIONS(*DIRECT *WEBEVENT);
********** COMMENT();
********** COMMENT(Group and field definitions);
********** COMMENT();
GROUP_BY NAME(#S_GRPPDF) FIELDS((#S_190PID)(#S_190PDS)(#S_190PPW)(#S_190PBN)(#S_190PST));
GROUP_BY NAME(#S_GRPPQU) FIELDS((#S_190PID)(#S_190PQN)(#S_190PQA)(#S_190PQL)(#S_190PQS));
GROUP_BY NAME(#S_GRPPQS) FIELDS((#S_190PID)(#S_190PQN)(#S_190PSN)(#S_190PSA)(#S_190PSL));
GROUP_BY NAME(#S_GRPPRA) FIELDS((#S_190PID)(#S_190RID)(#S_190PQN)(#S_190PSN)(#S_190RV)(#S_190RANK));
GROUP_BY NAME(#S_GRPPRE) FIELDS((#S_190PID)(#S_190RID)(#S_190RNM)(#S_190RAG));
********** COMMENT();
DEFINE FIELD(#S_190PSNW) REFFLD(#S_190PSN);
DEFINE FIELD(#S_190SELF) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('This entry is selected 1-0');
DEFINE FIELD(#S_190SE) TYPE(*CHAR) LENGTH(010) DESC('Holds browselist entry component name') COLHDG('Selection');
DEFINE FIELD(#S_190QENT) REFFLD(#LISTCOUNT) DESC('Current list entry');
DEFINE FIELD(#S_190QCNT) REFFLD(#LISTCOUNT) DESC('Number of quest in this poll');
********** COMMENT();
DEFINE FIELD(#S_190UPW) REFFLD(#S_190PPW);
DEFINE FIELD(#S_190CBOX) TYPE(*CHAR) LENGTH(001) DESC('Checkbox value');
DEFINE FIELD(#S_190NXT) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('1 indicates next button is to be used');
DEFINE FIELD(#S_190PRV) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('1 indicates prev button is to be used');
DEFINE FIELD(#S_190FIN) TYPE(*DEC) LENGTH(001) DECIMALS(0) DESC('1 indicates prev button is to be used');
DEFINE FIELD(#S_190NXTQ) REFFLD(#S_190PQN) DESC('Next Question number');
DEFINE FIELD(#S_190PSWF) TYPE(*CHAR) LENGTH(020) DESC('Password Required Indicator') INPUT_ATR(LC);
********** COMMENT();
OVERRIDE FIELD(#STD_COUNT) LABEL('Iteration');
********** COMMENT();
********** COMMENT();
********** COMMENT(Mainline);
********** COMMENT();
CHANGE FIELD(#S_FUNDES) TO(*FUNCTION_DESC);
********** COMMENT();
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= *BLANKS');
********** COMMENT(first time in);
CHANGE FIELD(#STDRENTRY) TO(P);
********** COMMENT();
********** COMMENT(List all the open polls - allow the user to select);
********** COMMENT(Set selection field to a general purpose selector);
********** COMMENT(component.);
CHANGE FIELD(#S_190SE) TO(S_190SEGP);
DEF_LIST NAME(#S_190PDF) FIELDS((#S_190SE *INPUT)(#S_190PDS *OUTPUT)(#S_190PSWF *OUTPUT)(#S_190PID *HIDDEN));
CLR_LIST NAMED(#S_190PDF);
********** COMMENT();
SELECT FIELDS(#S_GRPPDF) FROM_FILE(SETPDF);
IF COND('#S_190PST *EQ OPEN');
********** COMMENT(Indicate whether a password is required on the list);
IF COND('#S_190PPW *EQ NONE');
CHANGE FIELD(#S_190PSWF) TO(*BLANKS);
ELSE;
CHANGE FIELD(#S_190PSWF) TO('''(Password Required)''');
ENDIF;
ADD_ENTRY TO_LIST(#S_190PDF);
ENDIF;
ENDSELECT;
CHANGE FIELD(#S_190PBN) TO(*NULL);
CHANGE FIELD(#S_190HDR) TO(S_190HDRBLANK);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190RID *HIDDEN)(#STDRENTRY *HIDDEN)(#STDROWNUM *HIDDEN)(#S_ACTIONX *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(The browselist is displayed via component S_190HDRBLANK);
********** COMMENT(so that it can be positioned within the text);
IF COND('1 *EQ 2');
REQUEST BROWSELIST(#S_190PDF) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
********** COMMENT();
WHEN VALUE_IS('= P');
********** COMMENT(user has selected a poll);
IF COND('#S_190RID *EQ 0');
********** COMMENT(assign the user an identifer #S_190RID);
CHANGE FIELD(#S_190RID) TO(*AUTONUM15S_190RID);
ELSE;
********** COMMENT(get the repondent details previously entered);
FETCH FIELDS((#S_190RNM)(#S_190RAG)) FROM_FILE(SETPREL1) WITH_KEY(#S_190RID);
ENDIF;
********** COMMENT();
********** COMMENT(Get the selected entry from the list of polls);
GET_ENTRY NUMBER(#STDROWNUM) FROM_LIST(#S_190PDF);
FETCH FIELDS(#S_GRPPDF) FROM_FILE(SETPDF) WITH_KEY(#S_190PID);
********** COMMENT(Request the user details and the password if required.);
********** COMMENT(- let the user drop out of the first case statement);
********** COMMENT(into the request password section of the second case);
********** COMMENT(statement.);
CHANGE FIELD(#STDRENTRY) TO(W);
********** COMMENT();
WHEN VALUE_IS('= R');
********** COMMENT(User has input a password and user details);
CHANGE FIELD(#S_190PPW) TO(*NULL);
FETCH FIELDS(#S_190PPW) FROM_FILE(SETPDF) WITH_KEY(#S_190PID);
********** COMMENT(If the user entered the right password, and their user);
********** COMMENT(details, let them drop out of the case statement,);
********** COMMENT(into the first question.);
********** COMMENT(Otherwise let them re-enter the password);
CHANGE FIELD(#STDRENTRY) TO(W);
IF COND('(#S_190UPW *EQ #S_190PPW) *OR (#S_190PPW *EQ NONE)');
CHECK_FOR IN_FILE(SETPRE) WITH_KEY(#S_190PID #S_190RID);
IF_STATUS IS(*EQUALKEY);
UPDATE FIELDS(#S_GRPPRE) IN_FILE(SETPRE) WITH_KEY(#S_190PID #S_190RID) VAL_ERROR(*NEXT);
ELSE;
INSERT FIELDS(#S_GRPPRE) TO_FILE(SETPRE) VAL_ERROR(*NEXT);
ENDIF;
IF_STATUS IS(*OKAY);
CHANGE FIELD(#STDRENTRY) TO(Q);
CHANGE FIELD(#S_ACTIONX) TO(NEXT);
CHANGE FIELD(#S_190QENT) TO(0);
ENDIF;
ELSE;
********** COMMENT(User entered blank or invalid password);
MESSAGE MSGTXT('Password invalid or not entered');
ENDIF;
********** COMMENT();
********** COMMENT();
ENDCASE;
********** COMMENT(Second Case statement.);
********** COMMENT(Allows multiple logic pathways to use the same REQUEST);
********** COMMENT(statement.);
********** COMMENT();
CASE OF_FIELD(#STDRENTRY);
WHEN VALUE_IS('= Q');
IF COND('#S_190QENT *NE 0');
********** COMMENT(Not the first question. Store the responses to the);
********** COMMENT(previous question.);
********** COMMENT();
FETCH FIELDS(#S_GRPPQU) FROM_FILE(SETPQU) WITH_KEY(#S_190PID #S_190PQN);
********** COMMENT();
********** COMMENT(Processing of the response varies according to the);
********** COMMENT(question type.);
********** COMMENT();
********** COMMENT(Delete any existing responses for this poll, user, and);
********** COMMENT(question (the user can re-do a question if they use);
********** COMMENT(the previous button));
DELETE FROM_FILE(SETPRA) WITH_KEY(#S_190PID #S_190RID #S_190PQN);
********** COMMENT();
CASE OF_FIELD(#S_190PQS);
WHEN VALUE_IS('= YESNO' '= YESNOUNK' '= SELECT');
********** COMMENT(User selects one entry: #S_190PSN contains the option);
********** COMMENT(number that the user selected.);
IF COND('#S_190PSN *NE 0');
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
ENDIF;
WHEN VALUE_IS('= RANK');
********** COMMENT(User assigns a rank to every entry);
********** COMMENT();
********** COMMENT(Standardize the users ranking numbers);
********** COMMENT(e.g. if the user entered ranks 10 40 60);
********** COMMENT(store these as ranks 1 2 3);
DEFINE FIELD(#S_190RNKW) REFFLD(#S_190RANK);
DEF_LIST NAME(#S_190RWRK) FIELDS((#S_190PSN)(#S_190RNKW)) TYPE(*WORKING);
CLR_LIST NAMED(#S_190RWRK);
SELECTLIST NAMED(#S_190SELS);
IF COND('#S_190RANK *NE 0');
CHANGE FIELD(#S_190RNKW) TO(#S_190RANK);
ADD_ENTRY TO_LIST(#S_190RWRK);
ENDIF;
ENDSELECT;
SORT_LIST NAMED(#S_190RWRK) BY_FIELDS((#S_190RNKW));
********** COMMENT();
CHANGE FIELD(#S_190RANK) TO(0);
SELECTLIST NAMED(#S_190RWRK);
CHANGE FIELD(#S_190RANK) TO('#S_190RANK + 1');
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
ENDSELECT;
********** COMMENT();
WHEN VALUE_IS('= MSELECT');
********** COMMENT(User can choose several selections);
SELECTLIST NAMED(#S_190SELS);
IF COND('#S_190CBOX *EQ Y');
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
ENDIF;
ENDSELECT;
WHEN VALUE_IS('= ANSWER');
********** COMMENT(User has entered a free format answer in #S_190RV);
GET_ENTRY NUMBER(1) FROM_LIST(#S_190SELS);
INSERT FIELDS(#S_GRPPRA) TO_FILE(SETPRA);
********** COMMENT();
ENDCASE;
ELSE;
********** COMMENT(This is the first time a question will be displayed);
********** COMMENT();
********** COMMENT(Get the complete list of questions in order of);
********** COMMENT(question sequence and store permanently in list);
********** COMMENT(that is always passed. (#S_190QN));
********** COMMENT();
CLR_LIST NAMED(#S_190QN);
SELECT FIELDS(#S_190PQN) FROM_FILE(SETPQUL3) WITH_KEY(#S_190PID);
ADD_ENTRY TO_LIST(#S_190QN);
ENDSELECT;
IF COND('#S_190QCNT *NE 0');
CHANGE FIELD(#S_190QENT) TO(0);
ELSE;
********** COMMENT(There are no questions in this poll);
CHANGE FIELD(#S_ACTIONX) TO(FINISH);
ENDIF;
ENDIF;
********** COMMENT(Determine which question is next);
********** COMMENT();
CASE OF_FIELD(#S_ACTIONX);
WHEN VALUE_IS('= NEXT');
********** COMMENT(Next Question);
CHANGE FIELD(#S_190QENT) TO('#S_190QENT + 1');
********** COMMENT();
WHEN VALUE_IS('= PREVIOUS');
********** COMMENT(Previous Question);
CHANGE FIELD(#S_190QENT) TO('#S_190QENT - 1');
WHEN VALUE_IS('= FINISH');
********** COMMENT(Finish Questions);
********** COMMENT(There are no more questions to display for this poll);
********** COMMENT(Thank the person doing the poll.);
********** COMMENT();
CHANGE FIELD(#STDRENTRY) TO(*NULL);
CHANGE FIELD(#S_190HDR) TO(S_190HDRLAST);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_190PQN *HIDDEN)(#S_190QENT *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDCASE;
********** COMMENT(Get the next question identifier);
GET_ENTRY NUMBER(#S_190QENT) FROM_LIST(#S_190QN);
FETCH FIELDS(#S_GRPPQU) FROM_FILE(SETPQU) WITH_KEY(#S_190PID #S_190PQN);
IF_STATUS IS(*OKAY);
********** COMMENT(Build the list of possible selections for this);
********** COMMENT(question.);
CHANGE FIELD(#S_190CBOX #S_190RANK #S_190RV) TO(*NULL);
********** COMMENT();
********** COMMENT(Browselist of components (*NOBIC));
DEF_LIST NAME(#S_190SELS) FIELDS((#S_190SE *INPUT)(#S_190PSN *HIDDEN)(#S_190PSA *HIDDEN)(#S_190PSL *HIDDEN)(#S_190CBOX *HIDDEN)(#S_190RANK *HIDDEN)(#S_190RV *HIDDEN));
********** COMMENT(Browselist of radio buttons (*NOBIC));
DEF_LIST NAME(#S_190OPTS) FIELDS((#S_190SE *INPUT)(#S_190PSN *HIDDEN)(#S_190SELF *HIDDEN)(#S_190PSA *HIDDEN)(#S_190PSL *HIDDEN)(#S_190CBOX *HIDDEN)(#S_190RANK *HIDDEN)(#S_190RV *HIDDEN));
********** COMMENT(Determine the appropriate component to be used to);
********** COMMENT(display each selection, based on the question style.);
CASE OF_FIELD(#S_190PQS);
WHEN VALUE_IS('= YESNO' '= YESNOUNK' '= SELECT');
********** COMMENT(User selects one entry);
WHEN VALUE_IS('= RANK');
********** COMMENT(User assigns a rank to every entry);
CHANGE FIELD(#S_190SE) TO(S_190SERK);
WHEN VALUE_IS('= MSELECT');
********** COMMENT(User can choose several selections);
CHANGE FIELD(#S_190SE) TO(S_190SECB);
WHEN VALUE_IS('= ANSWER');
********** COMMENT(Free format answer to question);
CHANGE FIELD(#S_190SE) TO(S_190SEAN);
ENDCASE;
********** COMMENT();
********** COMMENT(Determine whether the "previous question" button should);
********** COMMENT(be displayed.);
IF COND('#S_190QENT *EQ 1');
CHANGE FIELD(#S_190PRV) TO(0);
ELSE;
CHANGE FIELD(#S_190PRV) TO(1);
ENDIF;
********** COMMENT(Determine whether the "next question" or "finish");
********** COMMENT(buttons should be displayed);
CHANGE FIELD(#S_190NXT #S_190FIN) TO(*NULL);
IF COND('#S_190QENT *LT #S_190QCNT');
CHANGE FIELD(#S_190NXT) TO(1);
********** COMMENT(default to next if they don't press a button);
CHANGE FIELD(#S_ACTIONX) TO(NEXT);
ELSE;
CHANGE FIELD(#S_190FIN) TO(1);
********** COMMENT(default to finish if they don't press a button);
CHANGE FIELD(#S_ACTIONX) TO(FINISH);
ENDIF;
********** COMMENT();
********** COMMENT();
********** COMMENT(The type of list used depends on the Question type.);
CASE OF_FIELD(#S_190PQS);
WHEN VALUE_IS('= YESNO' '= YESNOUNK' '= SELECT');
********** COMMENT(When a single entry is chosen from a list of options);
********** COMMENT(a browselist of radio buttons is used.);
CLR_LIST NAMED(#S_190OPTS);
********** COMMENT(Browselist #S_190OPTS has no border, column headings or);
********** COMMENT(selection image.);
********** COMMENT(It has a graphic variable *LW3BL_S_190OPTS set to);
********** COMMENT(*NOBIC);
********** COMMENT();
********** COMMENT(determine what the user chose for this question);
********** COMMENT(previously (if anything));
CHANGE FIELD(#S_190PSN) TO(*NULL);
FETCH FIELDS(#S_190PSN) FROM_FILE(SETPRA) WITH_KEY(#S_190PID #S_190RID #S_190PQN);
CHANGE FIELD(#S_190PSNW) TO(#S_190PSN);
********** COMMENT();
********** COMMENT(Add the radio button entries to the list);
CHANGE FIELD(#S_190SE) TO(S_190SERB);
SELECT FIELDS(#S_GRPPQS) FROM_FILE(SETPQS) WITH_KEY(#S_190PID #S_190PQN);
********** COMMENT(<INPUT TYPE="RADIO" NAME="PS_190PSN" VALUE="1">Yes);
********** COMMENT();
********** COMMENT(Use #S_190SELF in an ONCONDITION in component S_190OOPT);
********** COMMENT(to set an entry to selected (CHECKED));
********** COMMENT(Under LANSA H9 this logic can be simplified because);
********** COMMENT(the ONCONDITION can compare #S_190PSN with a field);
********** COMMENT(value instead of requiring a flag.);
IF COND('#S_190PSNW *EQ #S_190PSN');
CHANGE FIELD(#S_190SELF) TO(1);
ELSE;
CHANGE FIELD(#S_190SELF) TO(*NULL);
ENDIF;
ADD_ENTRY TO_LIST(#S_190OPTS);
ENDSELECT;
********** COMMENT(Default to no row selected);
CHANGE FIELD(#S_190PSN) TO(*NULL);
********** COMMENT();
CHANGE FIELD(#S_190HDR) TO(S_190HDRQUESOPTS);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_190PQN *HIDDEN)(#S_190PQS *HIDDEN)(#S_190PQL *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190QENT *HIDDEN)(#STDROWNUM *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Display the browselist via component S_190QUESOPTS);
********** COMMENT(to allow positioning of the browselist);
IF COND('1 *EQ 2');
REQUEST BROWSELIST(#S_190OPTS) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
OTHERWISE;
********** COMMENT(For multi-selection or ranking or free format);
********** COMMENT(a browselist of components with input fields is used);
********** COMMENT(Browselist #S_190SELS has no border, column headings or);
********** COMMENT(selection image.);
********** COMMENT(It has a graphic variable *LW3BL_S_190SELS set to);
********** COMMENT(*NOBIC);
********** COMMENT();
CLR_LIST NAMED(#S_190SELS);
SELECT FIELDS(#S_GRPPQS) FROM_FILE(SETPQS) WITH_KEY(#S_190PID #S_190PQN);
********** COMMENT(Get any previous response by this individual that);
********** COMMENT(relates to this selection);
CHANGE FIELD(#S_190RV #S_190RANK) TO(*NULL);
FETCH FIELDS((#S_190RV)(#S_190RANK)) FROM_FILE(SETPRA) WITH_KEY(#S_190PID #S_190RID #S_190PQN #S_190PSN);
********** COMMENT();
ADD_ENTRY TO_LIST(#S_190SELS);
ENDSELECT;
********** COMMENT(Default to no row selected);
CHANGE FIELD(#STDROWNUM #S_190PSN) TO(*NULL);
********** COMMENT();
CHANGE FIELD(#S_190HDR) TO(S_190HDRQUESSELS);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_190PQN *HIDDEN)(#S_190PQS *HIDDEN)(#S_190PQL *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190QENT *HIDDEN)(#STDROWNUM *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Display the browselist via component S_190QUESSELS);
********** COMMENT(to allow positioning of the browselist);
IF COND('1 *EQ 2');
REQUEST BROWSELIST(#S_190SELS) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
ENDCASE;
ENDIF;
WHEN VALUE_IS('= W');
********** COMMENT(Ask for the password and user details (again));
CHANGE FIELD(#STDRENTRY) TO(R);
FETCH FIELDS(#S_190PDS) FROM_FILE(SETPDF) WITH_KEY(#S_190PID);
********** COMMENT();
IF COND('#S_190PPW *NE NONE');
CHANGE FIELD(#S_190HDR) TO(S_190HDRPASSWORD);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Note that fields #S_190UPW, #S_190RNM and #S_190RAG);
********** COMMENT(have been omitted from the request statement. This is);
********** COMMENT(because they are input capable fields displayed via the);
********** COMMENT(component S_190HDRPASSWORD.);
ELSE;
CHANGE FIELD(#S_190HDR) TO(S_190HDRUSERDET);
REQUEST FIELDS((#S_190HDR *INPUT *NOID)(#S_190PDS *HIDDEN)(#S_190RID *HIDDEN)(#S_190PID *HIDDEN)(#S_ACTIONX *HIDDEN)(#S_190PBN *HIDDEN)(#STDRENTRY *HIDDEN)) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
********** COMMENT(Note that fields #S_190RNM and #S_190RAG);
********** COMMENT(have been omitted from the request statement. This is);
********** COMMENT(because they are input capable fields displayed via the);
********** COMMENT(component S_190HDRUSERDET.);
ENDIF;
ENDCASE;
********** COMMENT();
********** COMMENT(The complete list of questions is always passed);
********** COMMENT(Note how #S_190QCNT gets passed with it automatically);
IF COND('1 *EQ 2');
********** COMMENT();
DEF_LIST NAME(#S_190QN) FIELDS(#S_190PQN) COUNTER(#S_190QCNT);
REQUEST BROWSELIST(#S_190QN) EXIT_KEY(*NO) MENU_KEY(*NO) PROMPT_KEY(*NO);
ENDIF;
********** COMMENT();