CREDIT CARD VERIFICATION PROGRAM This is a short description of how I developped a program to use the commercial ICVERIFY program to interface to INFORMIX-4GL or R4GL. I also have the same interface to ISQL. The ICVERIFY program looks at the data directory and scans for files that end with ".REQ". It picks up the request and dials the creditcard service with a modem and then gets an answer for the transaction which was posted in the .REQ file. When it has picked up the file it moves it to .HLD and when it has received the answer it moves it to .ANS. This process usually takes 13 to 23 seconds. The user gets a small display at the bottom of the screen that scrolls every 5 seconds to let him know that it is being processed. My C program creates the .REQ file using parameters from the CALL in Informix-4GL. It then watches the directory where the file was put and scans for the .HLD and the .ANS files. When the .ANS file is there it picks it up and uses the data returned from the creditcard service and fills in the appropriate fields on the screen and saves the form. I have built some safegards for refused or cancelled creditcard authorizations but there may be more messages from the creditcard company that I don't know about. To use this you must create a .4ge program that includes call to the C-program or create a new 4glgo engine to use it with R4GL. I included the programs to generate the new 4glgo that I called sell and selldbug. The C program is called credit.ec. You also need to use fgisell.c The script to create the sell engine is called mksell. I included the source for chk_cre.4gl so you can debug your program. I included the 4gl source code for the simple call to credit_chk() in psc_cshr1.4gl. This program is just a module part of a large set of modules. You can use the example of the call to credit_chk(...) as a start for your application. I also included the form that goes with this 4gl module psc_cshr1.per. You can contact IC-SYSTEMS at 283 Beau Forest Dr. Oakland CA 94611 (510) 339-3480. ICVERIFY is not cheap but the return in time saved pays the program in no time. Good luck to all of you. Guy St-Amant gstamant@aol.com (305) 779-7803 ---------------------------------------------------------------------- /** credit.ec program Guy St-Amant July 1994 **/ #include "ctools.h" #include #include #include #include $include sqlca; #define ERROR (-1) /* Program Created by Guy St-Amant February 94 */ int FROMTIMEOUT = 1, MAXTRIES = 15,tries,loop; FILE *ap,*hp,*rp,*fopen(); int abort_p(); int oldint,oldquit,oldhup,oldterm,oldalarm; static jmp_buf jmp; int credit_chk() { char creditcard[ 20 ]; char exp[ 5 ]; char sh_exp[ 5 ]; char sh_creditcard[ 20 ]; char trans_type[ 2 ]; char apv_code[ 7 ]; char seq_no[ 7 ]; char sh_seq_no[ 7 ]; char ref_no[ 9 ]; char ref_noap[ 9 ]; char sh_ref_no[ 9 ]; char sh_apv_code[ 7 ]; char capt_msgap[ 50 ]; char capt_msgapp[ 50 ]; char sh_capt_msg[ 16 ]; char tmp_capt_msg[ 16 ]; dec_t totalrec; dec_t p_trans; dec_t p_tot; char camt1[ 38 ]; char lname[ 16 ]; char notes[ 66 ]; char sh_notes[ 66 ]; char ic_msg[ 71 ]; int ret_code; char ext[80]; char ext1[80]; char icver_ida[4]; int cnt,i,k,c_cnt; char *lognm; char *getlogin(); char *getenv(); char *icver_id = icver_ida; char trans_short; char trans_proc[3]; char afile[34]; char rfile[34]; char hfile[34]; char msg[60]; char cmd[81]; char comment[21]; char messag[190]; char ret_msg[161]; char *pdest; char *trans_msg = ic_msg; char *apv_no; char *ref_nop = ref_no; char *ref_nopp = ref_noap; char *capt_msg = capt_msgap; char *capt_msgp = capt_msgapp; char *ref_id; char *seq_nop = seq_no; char *apv_codep = apv_code; lognm = getlogin(); icver_id=getenv("ICVER_ID"); strcpy(ic_msg,""); if (stcmpr(icver_id,"") == 0) /* If not set then use 008 */ strcpy(icver_id,"008"); popdec(&totalrec); popquote(notes,66); popquote(ref_no,9); popquote(seq_no,7); popquote(apv_code,7); popquote(trans_type,2); popquote(exp,5); popquote(creditcard,20); /** printf("\n\r %s %s %s %s ",creditcard,exp,trans_type,notes); **/ /** pf_getval("card", creditcard, CCHARTYPE, 20); **/ /** pf_getval("exp", exp, CCHARTYPE, 5); **/ /** pf_getval("t0",trans_type, CCHARTYPE, 2); **/ /** pf_getval("apvc",apv_code, CCHARTYPE, 7); **/ /** pf_getval("seq_no",seq_no, CCHARTYPE, 7); **/ /** pf_getval("ref_no",ref_no, CCHARTYPE, 9); **/ /** pf_getval("f067",notes, CCHARTYPE, 66); **/ /** pf_getval("f066", &totalrec, CDECIMALTYPE, 0); **/ stchar(exp,sh_exp,5); c_cnt=byleng(sh_exp,5); ldchar(exp,c_cnt,sh_exp); stchar(creditcard,sh_creditcard,20); c_cnt=byleng(sh_creditcard,20); ldchar(creditcard,c_cnt,sh_creditcard); stchar(apv_code,sh_apv_code,7); c_cnt=byleng(sh_apv_code,7); ldchar(apv_code,c_cnt,sh_apv_code); stchar(ref_no,sh_ref_no,9); c_cnt=byleng(sh_ref_no,9); ldchar(ref_no,c_cnt,sh_ref_no); stchar(seq_no,sh_seq_no,7); c_cnt=byleng(sh_seq_no,7); ldchar(seq_no,c_cnt,sh_seq_no); stchar(notes,sh_notes,66); c_cnt=byleng(sh_notes,66); ldchar(notes,c_cnt,sh_notes); dectoasc(&totalrec, camt1, 11, 2); ldchar(camt1,11,camt1); /**printf(" %s %s %s %s %s %s\r\n",sh_creditcard,sh_exp,sh_apv_code,sh_seq_no,sh_ref_no,trans_type); **/ strcpy(ext,",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\""); strcpy(ext1,",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\",\"\""); trans_short = trans_type[0]; switch(trans_short) { case 'S': strcpy(trans_proc,"C1"); sprintf(messag,"\"%s\",\"%s,\",\"%s\",\"%s\",\"%s\",\"%s\"%s\n", trans_proc,lognm,sh_notes,sh_creditcard,sh_exp,camt1,ext); break; case 'V': deccvint(0,&p_trans); if (deccmp(&totalrec,&p_trans) == -1) { /** Check for -amt **/ decsub(&p_trans,&totalrec,&p_tot); /** then convert to + **/ dectoasc(&p_tot, camt1, 11, 2); ldchar(camt1,11,camt1); } strcpy(trans_proc,"C2"); sprintf(messag,"\"%s\",\"%s,\",\"%s\",\"%s\",\"%s\",\"%s\"\ ,\"%s\"%s\n", trans_proc,lognm,sh_notes,sh_creditcard,sh_exp,camt1, sh_ref_no,ext1); break; case 'R': deccvint(0,&p_trans); decsub(&p_trans,&totalrec,&p_tot); dectoasc(&p_tot, camt1, 11, 2); ldchar(camt1,11,camt1); strcpy(trans_proc,"C3"); sprintf(messag,"\"%s\",\"%s,\",\"%s\",\"%s\",\"%s\",\"%s\"%s\n", trans_proc,lognm,sh_notes,sh_creditcard,sh_exp,camt1,ext); break; case 'F': strcpy(trans_proc,"C5"); sprintf(messag,"\"%s\",\"%s,\",\"%s\",\"%s\",\"%s\",\"%s\"\ ,\"%s\"%s\n", trans_proc,lognm,sh_notes,sh_creditcard,sh_exp,camt1, sh_apv_code,ext1); break; } strcpy(rfile,"/v/usr/icverify/multi/ICVER"); strcat(rfile,icver_id); strcat(rfile,".REQ"); strcpy(afile,"/v/usr/icverify/multi/ICVER"); strcat(afile,icver_id); strcat(afile,".ANS"); strcpy(hfile,"/v/usr/icverify/multi/ICVER"); strcat(hfile,icver_id); strcat(hfile,".HLD"); sprintf(cmd,"rm %s 2>1 > /dev/null",afile); system(cmd); /* Remove old answer code file */ if ((rp=fopen(rfile,"w")) == NULL) { msg_prog(0,"chk","Could not prepare file for ICverify"); } /** printf("\r\n%s",messag); **/ fprintf(rp,"%s",messag); fclose(rp); if ((oldint = signal(SIGINT, abort_p)) == ERROR || (oldquit = signal(SIGQUIT,abort_p)) == ERROR || (oldhup = signal(SIGHUP,abort_p)) == ERROR || (oldterm = signal(SIGTERM,abort_p)) == ERROR || (oldalarm = signal(SIGALRM,abort_p)) == ERROR) { printf("Error while setting signals\n"); ret_code = 1; } while(1) { loop = 0; tries = MAXTRIES; if (setjmp(jmp) == FROMTIMEOUT && --tries == 0) { msg_prog(1,"chk","Quitting the credit card approval process "); signal(SIGINT, oldint); signal(SIGQUIT,oldquit); signal(SIGHUP,oldhup); signal(SIGTERM,oldterm); signal(SIGALRM,oldalarm); strcpy(apv_code,"Quit"); ret_code = 1; retquote(apv_code); retquote(seq_no); retquote(ref_no); retquote(ic_msg); retint(ret_code); /** pf_putval(apv_code, CCHARTYPE, "apvc"); **/ /** pf_putval(seq_no, CCHARTYPE, "seq_no"); **/ /** pf_putval(ref_no, CCHARTYPE, "ref_no"); **/ /** pf_putval(ic_msg, CCHARTYPE, "f168"); **/ fclose(hp); fclose(ap); /**break;**/ return(5); } alarm(5); sprintf(msg,"WAITING FOR %s",hfile); while (((hp=fopen(hfile,"r")) == NULL) && (loop == 0)) { loop=0; msg_prog(tries,"chk",msg); sleep(1); } fclose(hp); sprintf(msg,"WAITING FOR %s",afile); while ((ap=fopen(afile,"r")) == NULL) { loop=1; msg_prog(tries,"chk",msg); sleep(1); } break; } signal(SIGINT, oldint); signal(SIGQUIT,oldquit); signal(SIGHUP,oldhup); signal(SIGTERM,oldterm); signal(SIGALRM,oldalarm); alarm(0); msg_prog(0,"chk","OK processed "); while (fgets(ret_msg,160,ap) != NULL) { cnt = 0; } /*printf("\n\r%s",ret_msg); */ cnt = 0; pdest = strtok(ret_msg,"'\",\"',"); /* Find first token */ while ( pdest !=NULL) { switch(cnt) { case 0: break; case 1: break; case 2: trans_msg = pdest; break; case 3: break; case 4: seq_nop = pdest; break; } /* printf("\r\nToken %d: %s\n",cnt,pdest); */ cnt++; pdest = strtok (NULL,"'\",\"',"); /* Find next token */ } strncpy(ic_msg,trans_msg,71); strncpy(seq_no,seq_nop,7); cnt = 0; pdest = strtok(trans_msg,"\>"); /* Find first token */ while ( pdest !=NULL) { switch(cnt) { case 0: capt_msg = pdest; break; case 1: break; case 2: ref_nop = pdest; break; case 3: break; } /* printf("Capt_msg %d: %s\n",cnt,pdest); */ cnt++; pdest = strtok (NULL,"\>"); /* Find next token */ } /* printf("\n\rcapt_msg =XX%sXX\n\r",capt_msg); */ strcpy(tmp_capt_msg,capt_msg); cnt = 0; pdest = strtok(capt_msg," "); /* Find first token */ while ( pdest !=NULL) { switch(cnt) { case 0: capt_msgp = pdest; break; case 1: apv_codep = pdest; break; } /* printf("Apv_cd %d: %s\n",cnt,pdest); */ cnt++; pdest = strtok (NULL," "); /* Find next token */ } /** printf("\n\rtmp_capt_msg =XX%sXX",tmp_capt_msg); **/ strncpy(apv_code,apv_codep,7); ret_code = 0; if (stcmpr(tmp_capt_msg,"DUPLICATE TRANS") == 0) { ret_code = 1; strncpy(apv_code,capt_msgp,7); } if (stcmpr(tmp_capt_msg,"CAPTURE COMPLET") == 0) { strncpy(apv_code,sh_apv_code,7); ret_code = 0; } if (stcmpr(tmp_capt_msg,"VOID COMPLETE ") == 0) { ret_code = 2; strncpy(apv_code,capt_msgp,7); } if (stcmpr(tmp_capt_msg,"NO DATA MATCH ") == 0) { ret_code = 1; strncpy(apv_code,"NODATA",7); } if (stcmpr(tmp_capt_msg," REDO ") == 0) { ret_code = 1; strncpy(apv_code,"REDO ",7); } if (stcmpr(tmp_capt_msg,"TIME OUT") == 0) { ret_code = 1; strncpy(apv_code,"REDO ",7); } if (stcmpr(tmp_capt_msg,"INVALID ACCOUNT NUMBER") == 0) { ret_code = 1; strncpy(apv_code,"REDO ",7); } cnt = 0; pdest = strtok(ref_nop," "); /* Find first token */ while ( pdest !=NULL) { switch(cnt) { case 0: break; case 1: break; case 2: ref_nopp = pdest; break; } /* printf("ref_no %d: %s\n",cnt,pdest); */ cnt++; pdest = strtok (NULL," "); /* Find next token */ } strncpy(ref_no,ref_nopp,9); retquote(apv_code); retquote(seq_no); retquote(ref_no); retquote(ic_msg); retint(ret_code); /** pf_putval(apv_code, CCHARTYPE, "apvc"); **/ /** pf_putval(seq_no, CCHARTYPE, "seq_no"); **/ /** pf_putval(ref_no, CCHARTYPE, "ref_no"); **/ /** pf_putval(ic_msg, CCHARTYPE, "f168"); **/ fclose(hp); fclose(ap); if (ret_code == 1) { msg_prog(0,"chk","Error this transaction is not processed "); } return(5); /** return(ret_code); **/ } int abort_p(signo) int signo; { char ch; fflush(stdout); if (signo == SIGALRM) { if (tries == 1) { msg_prog(0,"chk","Do you want to continue (w)aiting or (A)bort"); scanf("%c",ch); if ((stcmpr(ch,"W") == 0 ) || (stcmpr(ch,"w") == 0)) { loop = 1; tries = MAXTRIES; fclose(ap); } if ((stcmpr(ch,"A") == 0 ) || (stcmpr(ch,"a") == 0)) { /** Quitting (Alarm is already at 0) **/ tries = 1; } } signal(SIGALRM,abort_p); longjmp(jmp,FROMTIMEOUT); } else /** Quitting (Reset alarm to 0) **/ alarm(0); tries = 1; longjmp(jmp,FROMTIMEOUT); } msg_prog(err_no1,stat_typ1,stat_name1) int err_no1; char stat_typ1[4]; char stat_name1[60]; { char errstr[80]; sprintf(errstr,"msg-no %2d in %s %s",err_no1, stat_typ1,stat_name1); printf(" \r%s",errstr); } ---------------------------------------------------------------------- /*************************************************************************** * * fgisell.c Guy St-Amant * This code is modified from Informix doc. * This table is for user-defined C functions. * * Each initializer has the form: * * "name", name, nargs * * Variable # of arguments: * * set nargs to -(maximum # args) * * Be sure to declare name before the table and to leave the * line of 0's at the end of the table. * * Example: * * You want to call your C function named "mycfunc" and it expects * 2 arguments. You must declare it: * * int mycfunc(); * * and then insert an initializer for it in the table: * * "mycfunc", mycfunc, 2 * *************************************************************************** */ #include "fgicfunc.h" int makepas(); int numit(); int tempname(); int get_env(); int chk_file(); int credit_chk(); cfunc_t usrcfuncs[] = { "chk_file", chk_file, 1, "credit_chk",credit_chk, 8, 0, 0, 0 }; ---------------------------------------------------------------------- # Script mksell Guy St-Amant June 1994. : (PATH=/bin:/usr/informix1:/usr/informix1/bin:/usr/bin:$HOME/cod.wrk:. INFORMIXDIR=/usr/informix1 export PATH INFORMIXDIR echo $PATH cfglgo fgisell.c credit.c -o sell cfgldb fgisell.c credit.c -o selldbug selldbug chk_cre.4gi) ---------------------------------------------------------------------- { chk_cre.4gl Guy St-Amant } MAIN DEFINE creditcard CHAR(19), exp CHAR(4), trans_typ,answer CHAR(1), apv_code,seq_no CHAR(6), ref_no CHAR(8), notes,ic_msg CHAR(65), totalrec MONEY, ret_code INT LET answer = "X" LET ic_msg = "" LET ret_code = 0 LET creditcard = "Your credit card #" LET exp = "9411" LET trans_typ = "S" LET apv_code = "" LET seq_no = "" LET ref_no = "" LET notes = "This is a test of the credit card system " LET totalrec = 1.01 WHILE (answer NOT MATCHES "[Yy]") CALL credit_chk(creditcard,exp,trans_typ,apv_code,seq_no,ref_no,notes, totalrec) RETURNING apv_code,seq_no,ref_no,ic_msg,ret_code DISPLAY apv_code DISPLAY seq_no DISPLAY ref_no DISPLAY ic_msg DISPLAY ret_code PROMPT "Press y to quit loop " FOR CHAR answer END WHILE END MAIN ----------------------------------------------------------------------------- { psc_cshr1.4gl MODULE } database orchestra globals "psc_glob.4gl" ###################################################################### ## add3 does all of the add/update function ## it will not save any of the changes made to the screen ## if interupt or quit (usually del or ^c) is pressed FUNCTION add3 () DEFINE tmp RECORD LIKE receipts.* DEFINE tmpck LIKE receipts.patron_id DEFINE ser_no1 LIKE receipts.patron_id DEFINE r_season LIKE receipts.r_season1 DEFINE r_media LIKE receipts.r_media1 DEFINE r_date LIKE receipts.date1 DEFINE amt MONEY DEFINE u_name CHAR(13) DEFINE prmpt CHAR(60) DEFINE s17 CHAR(250) DEFINE s18 CHAR(250) DEFINE s20 CHAR(250) DEFINE quer CHAR(250) DEFINE season_dflt CHAR(2) DEFINE u_name1 CHAR(13) DEFINE ld_date1 DATE DEFINE ret_code SMALLINT LET tmp.* = inrec3.* LET ret_code = NULL CALL let5_1() INITIALIZE inrec3.* TO NULL LET scr_stat = 3 CALL initial() ####### USER DEFAULT DATE-NAME ######## LET quer = "SELECT u_name,dat_e FROM u_name, log_dflt ", " WHERE user_n MATCHES u_name " PREPARE ld_date FROM quer DECLARE dec_ld_date CURSOR FOR ld_date DELETE FROM u_name INSERT INTO u_name VALUES (user) FOREACH dec_ld_date INTO u_name1,ld_date1 END FOREACH LET scrrec3.daterec = ld_date1 LET scrrec3.c_user = u_name1 OPEN WINDOW cshr_form1w AT 1,1 WITH FORM "psc_cshr1" ATTRIBUTE(CYAN) # DISPLAY FORM cshr_form1 ATTRIBUTE(cyan) ## display correct form CURRENT WINDOW IS cshr_form1w INPUT BY NAME scrrec3.* WITHOUT DEFAULTS before field ser_no IF ( override_valid = 0) THEN IF glob_ser_no IS NULL OR glob_ser_no = 0 THEN MESSAGE 'Patron ID is required' SLEEP 2 MESSAGE '' CALL get_valid_pat() END IF LET scrrec3.ser_no = glob_ser_no IF (pat_default_flag = 1) THEN LET rec_default_flag = 1 CALL disp_pat_def() END IF END IF display scrrec3.ser_no to ser_no attribute(reverse,yellow) after field ser_no IF (override_valid = 0) THEN IF (scrrec3.ser_no IS NULL) THEN MESSAGE 'PATRON ID IS A REQUIRED FIELD' ATTRIBUTE(REVERSE, YELLOW) SLEEP 2 MESSAGE '' NEXT FIELD ser_no END IF INITIALIZE tmpck TO NULL LET ser_no1 = scrrec3.ser_no LET s17 ="SELECT ser_no FROM patron WHERE patron.ser_no = '",ser_no1 CLIPPED,"'" PREPARE s_17 FROM s17 DECLARE dec_s_17 SCROLL CURSOR FOR s_17 OPEN dec_s_17 FETCH FIRST dec_s_17 INTO tmpck IF tmpck IS NULL THEN MESSAGE 'PATRON ID INVALID, PLEASE RE-ENTER' SLEEP 2 MESSAGE '' CLEAR FORM INITIALIZE inrec3.* TO NULL NEXT FIELD ser_no END IF LET s20 = "SELECT * FROM patron WHERE patron.ser_no = '",ser_no1 CLIPPED,"'" PREPARE dec_s20 FROM s20 DECLARE cur_s20 SCROLL CURSOR FOR dec_s20 OPEN cur_s20 FETCH FIRST cur_s20 INTO patron_tmp.* display scrrec3.ser_no TO ser_no attribute(yellow) display by name patron_tmp.first_name attribute(yellow) display by name patron_tmp.mi attribute(yellow) display by name patron_tmp.last_name attribute(yellow) display by name patron_tmp.p_flag attribute(yellow) display by name scrrec3.how_pay attribute(yellow) display by name scrrec3.rec_code1 attribute(yellow) display by name scrrec3.r_season1 attribute(yellow) display by name scrrec3.daterec attribute(yellow) display by name scrrec3.c_user attribute(yellow) display by name scrrec3.quan1 attribute(yellow) NEXT FIELD daterec ELSE display by name scrrec3.ser_no attribute(yellow) END IF before field daterec display by name scrrec3.daterec attribute(reverse, yellow) after field daterec display by name scrrec3.daterec attribute(yellow) before field how_pay display by name scrrec3.how_pay attribute(reverse, yellow) after field how_pay display by name scrrec3.how_pay attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.how_pay = "CA") THEN NEXT FIELD rec_code1 END IF IF (scrrec3.how_pay = "CK") THEN NEXT FIELD check_no ELSE NEXT FIELD creditcard END IF END IF before field check_no display by name scrrec3.check_no attribute(reverse, yellow) after field check_no display by name scrrec3.check_no attribute(yellow) IF (override_valid = 0) THEN NEXT FIELD rec_code1 END IF before field creditcard display by name scrrec3.creditcard attribute(reverse, yellow) after field creditcard display by name scrrec3.creditcard attribute(yellow) before field exp display by name scrrec3.exp attribute(reverse, yellow) after field exp display by name scrrec3.exp attribute(yellow) before field trans_typ display by name scrrec3.trans_typ attribute(reverse, yellow) after field trans_typ display by name scrrec3.trans_typ attribute(yellow) IF (override_valid = 0) THEN CASE (scrrec3.trans_typ) WHEN "S" NEXT FIELD rec_code1 WHEN "C" NEXT FIELD rec_code1 WHEN "V" NEXT FIELD apvc OTHERWISE NEXT FIELD trans_typ END CASE END IF before field apvc display by name scrrec3.apvc attribute(reverse, yellow) after field apvc display by name scrrec3.apvc attribute(yellow) before field seq_no display by name scrrec3.seq_no attribute(reverse, yellow) after field seq_no display by name scrrec3.seq_no attribute(yellow) before field ref_no display by name scrrec3.ref_no attribute(reverse, yellow) after field ref_no display by name scrrec3.ref_no attribute(yellow) before field rec_code1 display by name scrrec3.rec_code1 attribute(reverse, yellow) after field rec_code1 display by name scrrec3.rec_code1 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_season1 IS NULL OR scrrec3.r_media1 IS NULL) THEN CALL get_dflt(scrrec3.rec_code1[1],u_name1) RETURNING r_season,r_media LET scrrec3.r_season1 = r_season LET scrrec3.r_media1 = r_media DISPLAY BY NAME scrrec3.r_season1 DISPLAY BY NAME scrrec3.r_media1 END IF IF (scrrec3.rec_code1[1] MATCHES "[AB]") THEN NEXT FIELD quan1 ELSE NEXT FIELD r_media1 END IF END IF before field quan1 display by name scrrec3.quan1 attribute(reverse, yellow) after field quan1 display by name scrrec3.quan1 attribute(yellow) IF (scrrec3.quan1 IS NULL) THEN NEXT FIELD quan1 END IF before field status1 display by name scrrec3.status1 attribute(reverse, yellow) after field status1 display by name scrrec3.status1 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code1[1] MATCHES "[AB]") THEN IF (scrrec3.status1 IS NULL) THEN NEXT FIELD status1 END IF END IF END IF before field p_code1 display by name scrrec3.p_code1 attribute(reverse, yellow) after field p_code1 display by name scrrec3.p_code1 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.p_code1 IS NULL) THEN NEXT FIELD p_code1 END IF IF (scrrec3.rec_code1[1] MATCHES "[AB]") THEN CALL get_cprice(scrrec3.rec_code1,scrrec3.p_code1,scrrec3.quan1) RETURNING amt IF (scrrec3.amt1 IS NULL) THEN LET scrrec3.amt1 = amt DISPLAY BY NAME scrrec3.amt1 ELSE IF (scrrec3.amt1 <> amt) THEN LET prmpt = "The correct value is ", amt USING "$$,$$$.$$", " Adjust Y/N [N] " IF get_answer(prmpt) THEN LET scrrec3.amt1 = amt DISPLAY BY NAME scrrec3.amt1 END IF END IF END IF END IF IF (scrrec3.rec_code1[1] MATCHES "A") THEN NEXT FIELD r_media1 END IF END IF before field date1 display by name scrrec3.date1 attribute(reverse, yellow) after field date1 display by name scrrec3.date1 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code1[1] MATCHES "B") THEN CALL get_date(scrrec3.rec_code1,scrrec3.date1) RETURNING r_date LET scrrec3.date1 = r_date DISPLAY BY NAME scrrec3.date1 END IF END IF before field r_media1 display by name scrrec3.r_media1 attribute(reverse, yellow) after field r_media1 display by name scrrec3.r_media1 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_media1 IS NULL) THEN NEXT FIELD r_media1 END IF END IF before field r_season1 display by name scrrec3.r_season1 attribute(reverse, yellow) after field r_season1 display by name scrrec3.r_season1 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_season1 IS NULL) THEN NEXT FIELD r_season1 END IF END IF before field amt1 display by name scrrec3.amt1 attribute(reverse, yellow) after field amt1 display by name scrrec3.amt1 attribute(yellow) before field rec_code2 display by name scrrec3.rec_code2 attribute(reverse, yellow) after field rec_code2 display by name scrrec3.rec_code2 attribute(yellow) IF (override_valid = 0) THEN IF(scrrec3.rec_code2 IS NULL) THEN NEXT FIELD totalrec END IF IF (scrrec3.r_season2 IS NULL OR scrrec3.r_media2 IS NULL) THEN CALL get_dflt(scrrec3.rec_code2[1],u_name1) RETURNING r_season,r_media LET scrrec3.r_season2 = r_season LET scrrec3.r_media2 = r_media DISPLAY BY NAME scrrec3.r_season2 DISPLAY BY NAME scrrec3.r_media2 END IF IF (scrrec3.rec_code2[1] MATCHES "[AB]") THEN NEXT FIELD quan2 ELSE NEXT FIELD r_media2 END IF END IF before field quan2 display by name scrrec3.quan2 attribute(reverse, yellow) after field quan2 display by name scrrec3.quan2 attribute(yellow) IF (scrrec3.quan2 IS NULL) THEN NEXT FIELD quan2 END IF before field status2 display by name scrrec3.status2 attribute(reverse, yellow) after field status2 display by name scrrec3.status2 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code2[1] MATCHES "[AB]") THEN IF (scrrec3.status2 IS NULL) THEN NEXT FIELD status2 END IF END IF END IF before field p_code2 display by name scrrec3.p_code2 attribute(reverse, yellow) after field p_code2 display by name scrrec3.p_code2 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.p_code2 IS NULL) THEN NEXT FIELD p_code2 END IF IF (scrrec3.rec_code2[1] MATCHES "[AB]") THEN CALL get_cprice(scrrec3.rec_code2,scrrec3.p_code2,scrrec3.quan2) RETURNING amt IF (scrrec3.amt2 IS NULL) THEN LET scrrec3.amt2 = amt DISPLAY BY NAME scrrec3.amt2 ELSE IF (scrrec3.amt2 <> amt) THEN LET prmpt = "The correct value is ", amt USING "$$,$$$.$$", " Adjust Y/N [N] " IF get_answer(prmpt) THEN LET scrrec3.amt2 = amt DISPLAY BY NAME scrrec3.amt2 END IF END IF END IF END IF IF (scrrec3.rec_code2[1] MATCHES "A") THEN NEXT FIELD r_media2 END IF END IF before field date2 display by name scrrec3.date2 attribute(reverse, yellow) after field date2 display by name scrrec3.date2 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code2[1] MATCHES "B") THEN CALL get_date(scrrec3.rec_code2,scrrec3.date2) RETURNING r_date LET scrrec3.date2 = r_date DISPLAY BY NAME scrrec3.date2 END IF END IF before field r_media2 display by name scrrec3.r_media2 attribute(reverse, yellow) after field r_media2 display by name scrrec3.r_media2 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_media2 IS NULL) THEN NEXT FIELD r_media2 END IF END IF before field r_season2 display by name scrrec3.r_season2 attribute(reverse, yellow) after field r_season2 display by name scrrec3.r_season2 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_season2 IS NULL) THEN NEXT FIELD r_season2 END IF END IF before field amt2 display by name scrrec3.amt2 attribute(reverse, yellow) after field amt2 display by name scrrec3.amt2 attribute(yellow) before field rec_code3 display by name scrrec3.rec_code3 attribute(reverse, yellow) after field rec_code3 display by name scrrec3.rec_code3 attribute(yellow) IF (override_valid = 0) THEN IF(scrrec3.rec_code3 IS NULL) THEN NEXT FIELD totalrec END IF IF (scrrec3.r_season3 IS NULL OR scrrec3.r_media3 IS NULL) THEN CALL get_dflt(scrrec3.rec_code3[1],u_name1) RETURNING r_season,r_media LET scrrec3.r_season3 = r_season LET scrrec3.r_media3 = r_media DISPLAY BY NAME scrrec3.r_season3 DISPLAY BY NAME scrrec3.r_media3 END IF IF (scrrec3.rec_code3[1] MATCHES "[AB]") THEN NEXT FIELD quan3 ELSE NEXT FIELD r_media3 END IF END IF before field quan3 display by name scrrec3.quan3 attribute(reverse, yellow) after field quan3 display by name scrrec3.quan3 attribute(yellow) IF (scrrec3.quan3 IS NULL) THEN NEXT FIELD quan3 END IF before field status3 display by name scrrec3.status3 attribute(reverse, yellow) after field status3 display by name scrrec3.status3 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code3[1] MATCHES "[AB]") THEN IF (scrrec3.status3 IS NULL) THEN NEXT FIELD status3 END IF END IF END IF before field p_code3 display by name scrrec3.p_code3 attribute(reverse, yellow) after field p_code3 display by name scrrec3.p_code3 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.p_code3 IS NULL) THEN NEXT FIELD p_code3 END IF IF (scrrec3.rec_code3[1] MATCHES "[AB]") THEN CALL get_cprice(scrrec3.rec_code3,scrrec3.p_code3,scrrec3.quan3) RETURNING amt IF (scrrec3.amt3 IS NULL) THEN LET scrrec3.amt3 = amt DISPLAY BY NAME scrrec3.amt3 ELSE IF (scrrec3.amt3 <> amt) THEN LET prmpt = "The correct value is ", amt USING "$$,$$$.$$", " Adjust Y/N [N] " IF get_answer(prmpt) THEN LET scrrec3.amt3 = amt DISPLAY BY NAME scrrec3.amt3 END IF END IF END IF END IF IF (scrrec3.rec_code3[1] MATCHES "A") THEN NEXT FIELD r_media3 END IF END IF before field date3 display by name scrrec3.date3 attribute(reverse, yellow) after field date3 display by name scrrec3.date3 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code3[1] MATCHES "B") THEN CALL get_date(scrrec3.rec_code3,scrrec3.date3) RETURNING r_date LET scrrec3.date3 = r_date DISPLAY BY NAME scrrec3.date3 END IF END IF before field r_media3 display by name scrrec3.r_media3 attribute(reverse, yellow) after field r_media3 display by name scrrec3.r_media3 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_media3 IS NULL) THEN NEXT FIELD r_media3 END IF END IF before field r_season3 display by name scrrec3.r_season3 attribute(reverse, yellow) after field r_season3 display by name scrrec3.r_season3 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_season3 IS NULL) THEN NEXT FIELD r_season3 END IF END IF before field amt3 display by name scrrec3.amt3 attribute(reverse, yellow) after field amt3 display by name scrrec3.amt3 attribute(yellow) before field rec_code4 display by name scrrec3.rec_code4 attribute(reverse, yellow) after field rec_code4 display by name scrrec3.rec_code4 attribute(yellow) IF ( override_valid = 0 ) THEN IF(scrrec3.rec_code4 IS NULL) THEN NEXT FIELD totalrec END IF IF (scrrec3.r_season4 IS NULL OR scrrec3.r_media4 IS NULL) THEN CALL get_dflt(scrrec3.rec_code4[1],u_name1) RETURNING r_season,r_media LET scrrec3.r_season4 = r_season LET scrrec3.r_media4 = r_media DISPLAY BY NAME scrrec3.r_season4 DISPLAY BY NAME scrrec3.r_media4 END IF IF (scrrec3.rec_code4[1] MATCHES "[AB]") THEN NEXT FIELD quan4 ELSE NEXT FIELD r_media4 END IF END IF before field quan4 display by name scrrec3.quan4 attribute(reverse, yellow) after field quan4 display by name scrrec3.quan4 attribute(yellow) IF (scrrec3.quan4 IS NULL) THEN NEXT FIELD quan4 END IF before field status4 display by name scrrec3.status4 attribute(reverse, yellow) after field status4 display by name scrrec3.status4 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code4[1] MATCHES "[AB]") THEN IF (scrrec3.status4 IS NULL) THEN NEXT FIELD status4 END IF END IF END IF before field p_code4 display by name scrrec3.p_code4 attribute(reverse, yellow) after field p_code4 display by name scrrec3.p_code4 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.p_code4 IS NULL) THEN NEXT FIELD p_code4 END IF IF (scrrec3.rec_code4[1] MATCHES "[AB]") THEN CALL get_cprice(scrrec3.rec_code4,scrrec3.p_code4,scrrec3.quan4) RETURNING amt IF (scrrec3.amt4 IS NULL) THEN LET scrrec3.amt4 = amt DISPLAY BY NAME scrrec3.amt4 ELSE IF (scrrec3.amt4 <> amt) THEN LET prmpt = "The correct value is ", amt USING "$$,$$$.$$", " Adjust Y/N [N] " IF get_answer(prmpt) THEN LET scrrec3.amt4 = amt DISPLAY BY NAME scrrec3.amt4 END IF END IF END IF END IF IF (scrrec3.rec_code4[1] MATCHES "A") THEN NEXT FIELD r_media4 END IF END IF before field date4 display by name scrrec3.date4 attribute(reverse, yellow) after field date4 display by name scrrec3.date4 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.rec_code4[1] MATCHES "B") THEN CALL get_date(scrrec3.rec_code4,scrrec3.date4) RETURNING r_date LET scrrec3.date4 = r_date DISPLAY BY NAME scrrec3.date4 END IF END IF before field r_media4 display by name scrrec3.r_media4 attribute(reverse, yellow) after field r_media4 display by name scrrec3.r_media4 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_media4 IS NULL) THEN NEXT FIELD r_media4 END IF END IF before field r_season4 display by name scrrec3.r_season4 attribute(reverse, yellow) after field r_season4 display by name scrrec3.r_season4 attribute(yellow) IF (override_valid = 0) THEN IF (scrrec3.r_season4 IS NULL) THEN NEXT FIELD r_season4 END IF END IF before field amt4 display by name scrrec3.amt4 attribute(reverse, yellow) after field amt4 display by name scrrec3.amt4 attribute(yellow) before field totalrec IF (scrrec3.rec_code1 IS NULL) THEN LET scrrec3.amt1 = 0 END IF IF (scrrec3.rec_code2 IS NULL) THEN LET scrrec3.amt2 = 0 END IF IF (scrrec3.rec_code3 IS NULL) THEN LET scrrec3.amt3 = 0 END IF IF (scrrec3.rec_code4 IS NULL) THEN LET scrrec3.amt4 = 0 END IF LET scrrec3.totalrec = scrrec3.amt1 + scrrec3.amt2 + scrrec3.amt3 + scrrec3.amt4 display by name scrrec3.totalrec attribute(reverse, yellow) IF ( override_valid = 0 ) THEN NEXT FIELD fin_close END IF after field totalrec display by name scrrec3.totalrec attribute(yellow) before field fin_close display by name scrrec3.fin_close attribute(reverse, yellow) after field fin_close display by name scrrec3.fin_close attribute(yellow) IF ( override_valid = 0 ) THEN IF (scrrec3.fin_close = "Y") THEN NEXT FIELD check_ck END IF IF (scrrec3.fin_close = "N") THEN NEXT FIELD rec_code1 ELSE MESSAGE 'INVALID ENTRY, PLEASE RE-ENTER' SLEEP 2 MESSAGE '' NEXT FIELD fin_close END IF END IF before field check_ck display by name scrrec3.check_ck attribute(reverse, yellow) IF (scrrec3.check_ck IS NULL) THEN LET scrrec3.check_ck = "N" DISPLAY BY NAME scrrec3.check_ck END IF after field check_ck display by name scrrec3.check_ck attribute(yellow) before field ty_let display by name scrrec3.ty_let attribute(reverse, yellow) after field ty_let display by name scrrec3.ty_let attribute(yellow) IF ( override_valid = 0 ) THEN IF(scrrec3.ty_let IS NULL) THEN MESSAGE 'TY IS A REQUIRED ENTRY' SLEEP 2 MESSAGE '' NEXT FIELD ty_let END IF END IF before field notes display by name scrrec3.notes attribute(reverse, yellow) after field notes display by name scrrec3.notes attribute(yellow) NEXT FIELD confirm before field ic_msg display by name scrrec3.ic_msg attribute(reverse, yellow) after field ic_msg display by name scrrec3.ic_msg attribute(yellow) before field confirm display by name scrrec3.confirm attribute(reverse, yellow) IF (scrrec3.how_pay = "CC") THEN MESSAGE "Press (F5) to process IC-VERIFY transaction " ATTRIBUTE(REVERSE) END IF after field confirm IF ( override_valid = 0 ) THEN IF (scrrec3.confirm = "N") THEN NEXT FIELD patron_id END IF IF (scrrec3.confirm = "Y") THEN display by name scrrec3.confirm attribute(yellow) IF (inrec3.totalrec <> scrrec3.totalrec AND #We have CC in upd scrrec3.how_pay = "CC") OR (scrrec3.how_pay = "CC" AND inrec3.totalrec IS NULL) THEN LET prmpt = "Do you want to process IC-VERIFY Transaction ", " NOW Y/N [N] " IF (get_answer(prmpt)) THEN MESSAGE "Processing IC-VERIFY credit card please wait" ATTRIBUTE(REVERSE) CALL chk_credit(scrrec3.creditcard,scrrec3.exp, scrrec3.trans_typ,scrrec3.apvc,scrrec3.seq_no, scrrec3.ref_no,scrrec3.notes,scrrec3.totalrec) RETURNING scrrec3.apvc,scrrec3.seq_no,scrrec3.ref_no, scrrec3.ic_msg,ret_code DISPLAY BY NAME scrrec3.apvc DISPLAY BY NAME scrrec3.seq_no DISPLAY BY NAME scrrec3.ref_no DISPLAY BY NAME scrrec3.ic_msg CASE (ret_code) WHEN 1 # Error we must fix problem MESSAGE "Error this transaction is not complete" ATTRIBUTE(REVERSE) NEXT FIELD how_pay WHEN 2 MESSAGE "Void complete" ATTRIBUTE(REVERSE) NEXT FIELD how_pay END CASE END IF END IF EXIT INPUT ELSE MESSAGE 'INVALID ENTRY, PLEASE RE-ENTER' SLEEP 2 MESSAGE '' display by name scrrec3.confirm attribute(yellow) NEXT FIELD confirm END IF ELSE display by name scrrec3.confirm attribute(yellow) END IF ON KEY (F5) MESSAGE "Processing IC-VERIFY credit card please wait" ATTRIBUTE(REVERSE) CALL chk_credit(scrrec3.creditcard,scrrec3.exp,scrrec3.trans_typ, scrrec3.apvc,scrrec3.seq_no,scrrec3.ref_no, scrrec3.notes,scrrec3.totalrec) RETURNING scrrec3.apvc,scrrec3.seq_no,scrrec3.ref_no, scrrec3.ic_msg,ret_code DISPLAY BY NAME scrrec3.apvc DISPLAY BY NAME scrrec3.seq_no DISPLAY BY NAME scrrec3.ref_no DISPLAY BY NAME scrrec3.ic_msg CASE (ret_code) WHEN 1 # Error we must fix problem MESSAGE "Error this transactions is not complete " ATTRIBUTE(REVERSE) NEXT FIELD how_pay WHEN 2 MESSAGE "Void complete" ATTRIBUTE(REVERSE) NEXT FIELD how_pay END CASE ON KEY (CONTROL-O) LET override_valid = 1 ON KEY (CONTROL-I) LET quit_flag = 1 MESSAGE "Exiting this form no add/update done" ATTRIBUTE(REVERSE) SLEEP 1 MESSAGE '' EXIT INPUT END INPUT CALL let5_2() IF (int_flag = 0) AND (quit_flag = 0) THEN IF (tmp.ser_no IS NULL) THEN LET inrec3.ser_no = 0 INSERT INTO receipts VALUES (inrec3.*) MESSAGE 'RECORD HAS BEEN ADDED' ATTRIBUTE(REVERSE,YELLOW) SLEEP 1 LET tmp.ser_no = NULL ELSE UPDATE receipts SET * = inrec3.* where receipts.ser_no = tmp.ser_no AND receipts.patron_id = tmp.patron_id MESSAGE 'RECORD HAS BEEN UPDATED' ATTRIBUTE(REVERSE, YELLOW) SLEEP 1 MESSAGE '' END IF END IF LET override_valid = 0 CLOSE WINDOW cshr_form1w END FUNCTION ####################################################################### ## this function gets the query input, ## creates a sql statment, and prepares the cursor function query3 () define s1 char(300) let qrycnt3 = 0 CURRENT WINDOW IS SCREEN display form cshr_form1 attribute(cyan) ## display correct form clear form IF (pat_default_flag = 1) THEN LET rec_default_flag = 1 CALL disp_pat_def() END IF let scr_stat = 3 CONSTRUCT BY NAME s1 ON patron.ser_no, patron.first_name, patron.mi, patron.last_name, patron.p_flag, receipts.daterec, receipts.how_pay, receipts.check_no, receipts.creditcard, receipts.exp, receipts.trans_typ, receipts.apvc, receipts.seq_no, receipts.ref_no, receipts.rec_code1, receipts.quan1, receipts.status1, receipts.p_code1, receipts.date1, receipts.r_media1, receipts.r_season1, receipts.amt1, receipts.rec_code2, receipts.quan2, receipts.status2, receipts.p_code2, receipts.date2, receipts.r_media2, receipts.r_season2, receipts.amt2, receipts.rec_code3, receipts.quan3, receipts.status3, receipts.p_code3, receipts.date3, receipts.r_media3, receipts.r_season3, receipts.amt3, receipts.rec_code4, receipts.quan4, receipts.status4, receipts.p_code4, receipts.date4, receipts.r_media4, receipts.r_season4, receipts.amt4, receipts.totalrec, receipts.check_ck, receipts.ty_let, receipts.tax_code, receipts.ic_msg, receipts.notes, receipts.confirm, receipts.clo_se, receipts.fin_close, receipts.c_user let s1 = 'select * ', 'from receipts,patron ', 'where receipts.patron_id = patron.ser_no AND ', s1 clipped prepare s_1 from s1 call get_qry3 () ## displays the query results end function ####################################################################### ## cre_qry3 opens the cursor ## this is done in a seperate function so that the ## cursor can be re-opened anywhere in the routine. ## re-opening the cursor is done so that the latest ## data is displayed function cre_qry3() declare qrycurs scroll cursor for s_1 open qrycurs end function ####################################################################### ## display the next record in the query set ## this program will always display a record function next3 () clear form ## increment the counter let qrycnt3 = qrycnt3 + 1 call cre_qry3() ## get the qrycnt3 record fetch absolute qrycnt3 qrycurs into inrec3.*,inrec.* if status = notfound then ## if the program could not get the next record ## get the last record, decrement qrycnt3 let qrycnt3 = qrycnt3 - 1 fetch last qrycurs into inrec3.*,inrec.* message 'No Next Record Found' attribute (reverse, yellow) sleep 2 ## give the user a chance to see the message message '' end if call disp3 () end function ####################################################################### ## prior_rec will display the previous record on the screen ## it will always find something to display function prior3 () let qrycnt3 = qrycnt3 - 1 ## lower qry counter call cre_qry3() if qrycnt3 <= 0 then ## there is not a previous record so get the ## first record from the set message 'No Previous Record Found' attribute (reverse, yellow) sleep 2 ## give the user time to see the message message '' let qrycnt3 = 1 end if ## get the record fetch absolute qrycnt3 qrycurs into inrec3.*,inrec.* call disp3 () end function ####################################################################### ## delete_rec does the deletion function delete3 () whenever error continue ## systems not fault tolerant begin work delete from receipts where receipts.ser_no = inrec3.ser_no commit work whenever error stop ## systems not fault tolerant end function ####################################################################### ## disp_rec displays the record on the screen, ## including the scrolling region if needed function disp3 () define i smallint display form cshr_form1 attribute(cyan) ## display correct form clear form let scr_stat = 3 display BY NAME inrec.first_name ATTRIBUTE(YELLOW) display BY NAME inrec.mi ATTRIBUTE(YELLOW) display BY NAME inrec.last_name ATTRIBUTE(YELLOW) display BY NAME inrec.p_flag ATTRIBUTE(YELLOW) display BY NAME inrec3.clo_se ATTRIBUTE(YELLOW) display BY NAME inrec3.daterec ATTRIBUTE(YELLOW) display inrec3.patron_id TO ser_no ATTRIBUTE(YELLOW) display BY NAME inrec3.trans_typ ATTRIBUTE(YELLOW) display BY NAME inrec3.apvc ATTRIBUTE(YELLOW) display BY NAME inrec3.seq_no ATTRIBUTE(YELLOW) display BY NAME inrec3.ref_no ATTRIBUTE(YELLOW) display BY NAME inrec3.rec_code1 ATTRIBUTE(YELLOW) display BY NAME inrec3.amt1 ATTRIBUTE(YELLOW) display BY NAME inrec3.rec_code2 ATTRIBUTE(YELLOW) display BY NAME inrec3.amt2 ATTRIBUTE(YELLOW) display BY NAME inrec3.rec_code3 ATTRIBUTE(YELLOW) display BY NAME inrec3.amt3 ATTRIBUTE(YELLOW) display BY NAME inrec3.rec_code4 ATTRIBUTE(YELLOW) display BY NAME inrec3.amt4 ATTRIBUTE(YELLOW) display BY NAME inrec3.totalrec ATTRIBUTE(YELLOW) display BY NAME inrec3.quan1 ATTRIBUTE(YELLOW) display BY NAME inrec3.quan2 ATTRIBUTE(YELLOW) display BY NAME inrec3.quan3 ATTRIBUTE(YELLOW) display BY NAME inrec3.quan4 ATTRIBUTE(YELLOW) display BY NAME inrec3.status1 ATTRIBUTE(YELLOW) display BY NAME inrec3.status2 ATTRIBUTE(YELLOW) display BY NAME inrec3.status3 ATTRIBUTE(YELLOW) display BY NAME inrec3.status4 ATTRIBUTE(YELLOW) display BY NAME inrec3.p_code1 ATTRIBUTE(YELLOW) display BY NAME inrec3.p_code2 ATTRIBUTE(YELLOW) display BY NAME inrec3.p_code3 ATTRIBUTE(YELLOW) display BY NAME inrec3.p_code4 ATTRIBUTE(YELLOW) display BY NAME inrec3.date1 ATTRIBUTE(YELLOW) display BY NAME inrec3.date2 ATTRIBUTE(YELLOW) display BY NAME inrec3.date3 ATTRIBUTE(YELLOW) display BY NAME inrec3.date4 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_season1 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_season2 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_season3 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_season4 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_media1 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_media2 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_media3 ATTRIBUTE(YELLOW) display BY NAME inrec3.r_media4 ATTRIBUTE(YELLOW) display BY NAME inrec3.ty_let ATTRIBUTE(YELLOW) display BY NAME inrec3.tax_code ATTRIBUTE(YELLOW) display BY NAME inrec3.confirm ATTRIBUTE(YELLOW) display BY NAME inrec3.how_pay ATTRIBUTE(YELLOW) display BY NAME inrec3.check_no ATTRIBUTE(YELLOW) display BY NAME inrec3.check_ck ATTRIBUTE(YELLOW) display BY NAME inrec3.creditcard ATTRIBUTE(YELLOW) display BY NAME inrec3.exp ATTRIBUTE(YELLOW) display BY NAME inrec3.notes ATTRIBUTE(YELLOW) display BY NAME inrec3.ic_msg ATTRIBUTE(YELLOW) display BY NAME inrec3.c_user ATTRIBUTE(YELLOW) display BY NAME inrec3.fin_close ATTRIBUTE(YELLOW) end function ####################################################################### ## get_qry will display the records in a pop window ## if more than one is found. if only one record ## is found it is displayed, otherwise it informs ## the user that no records were found function get_qry3 () define i integer define scrarr array[200] of record clo_se like receipts.clo_se, daterec like receipts.daterec, patron_id like receipts.patron_id, rec_code1 like receipts.rec_code1, amt1 like receipts.amt1, rec_code2 like receipts.rec_code2, amt2 like receipts.amt2, rec_code3 like receipts.rec_code3, amt3 like receipts.amt3, rec_code4 like receipts.rec_code4, amt4 like receipts.amt4, totalrec like receipts.totalrec, quan1 like receipts.quan1, quan2 like receipts.quan2, quan3 like receipts.quan3, quan4 like receipts.quan4, status1 like receipts.status1, status2 like receipts.status2, status3 like receipts.status3, status4 like receipts.status4, p_code1 like receipts.p_code1, p_code2 like receipts.p_code2, p_code3 like receipts.p_code3, p_code4 like receipts.p_code4, date1 like receipts.date1, date2 like receipts.date2, date3 like receipts.date3, date4 like receipts.date4, r_season1 like receipts.r_season1, r_season2 like receipts.r_season2, r_season3 like receipts.r_season3, r_season4 like receipts.r_season4, r_media1 like receipts.r_media1, r_media2 like receipts.r_media2, r_media3 like receipts.r_media3, r_media4 like receipts.r_media4, ty_let like receipts.ty_let, confirm like receipts.confirm, how_pay like receipts.how_pay, check_no like receipts.check_no, check_ck like receipts.check_ck, creditcard like receipts.creditcard, exp like receipts.exp, trans_typ like receipts.trans_typ, apvc like receipts.apvc, seq_no like receipts.seq_no, ref_no like receipts.ref_no, notes like receipts.notes, ic_msg like receipts.ic_msg, c_user like receipts.c_user, fin_close like receipts.fin_close end record ## stores partial record for display within window define progarr array[200] of record like receipts.* ## stores full record - this is done to avoid having ## to run the query again call cre_qry3() fetch first qrycurs into inrec3.*,inrec.* ## is something found? if status <> notfound then let i = 1 ## insert the record into the array let progarr[1].* = inrec3.* while status <> notfound ## insert the record into the pop window array let scrarr[i].clo_se = progarr[i].clo_se let scrarr[i].daterec = progarr[i].daterec let scrarr[i].patron_id = progarr[i].patron_id let scrarr[i].rec_code1 = progarr[i].rec_code1 let scrarr[i].amt1 = progarr[i].amt1 let scrarr[i].rec_code2 = progarr[i].rec_code2 let scrarr[i].amt2 = progarr[i].amt2 let scrarr[i].rec_code3 = progarr[i].rec_code3 let scrarr[i].amt3 = progarr[i].amt3 let scrarr[i].rec_code4 = progarr[i].rec_code4 let scrarr[i].amt4 = progarr[i].amt4 let scrarr[i].totalrec = progarr[i].totalrec let scrarr[i].quan1 = progarr[i].quan1 let scrarr[i].quan2 = progarr[i].quan2 let scrarr[i].quan3 = progarr[i].quan3 let scrarr[i].quan4 = progarr[i].quan4 let scrarr[i].status1 = progarr[i].status1 let scrarr[i].status2 = progarr[i].status2 let scrarr[i].status3 = progarr[i].status3 let scrarr[i].status4 = progarr[i].status4 let scrarr[i].p_code1 = progarr[i].p_code1 let scrarr[i].p_code2 = progarr[i].p_code2 let scrarr[i].p_code3 = progarr[i].p_code3 let scrarr[i].p_code4 = progarr[i].p_code4 let scrarr[i].date1 = progarr[i].date1 let scrarr[i].date2 = progarr[i].date2 let scrarr[i].date3 = progarr[i].date3 let scrarr[i].date4 = progarr[i].date4 let scrarr[i].r_season1 = progarr[i].r_season1 let scrarr[i].r_season2 = progarr[i].r_season2 let scrarr[i].r_season3 = progarr[i].r_season3 let scrarr[i].r_season4 = progarr[i].r_season4 let scrarr[i].r_media1 = progarr[i].r_media1 let scrarr[i].r_media2 = progarr[i].r_media2 let scrarr[i].r_media3 = progarr[i].r_media3 let scrarr[i].r_media4 = progarr[i].r_media4 let scrarr[i].ty_let = progarr[i].ty_let let scrarr[i].confirm = progarr[i].confirm let scrarr[i].how_pay = progarr[i].how_pay let scrarr[i].check_no = progarr[i].check_no let scrarr[i].check_ck = progarr[i].check_ck let scrarr[i].creditcard = progarr[i].creditcard let scrarr[i].exp = progarr[i].exp let scrarr[i].trans_typ = progarr[i].trans_typ let scrarr[i].apvc = progarr[i].apvc let scrarr[i].seq_no = progarr[i].seq_no let scrarr[i].ref_no = progarr[i].ref_no let scrarr[i].notes = progarr[i].notes let scrarr[i].ic_msg = progarr[i].ic_msg let scrarr[i].c_user = progarr[i].c_user let scrarr[i].fin_close = progarr[i].fin_close ## if more than 200 records were returned ## stop. most users will never look through ## this many records- but will try a different query if i >= 200 then exit while else let i = i + 1 fetch absolute i qrycurs into progarr[i].* ,inrec.* ## read next record end if end while let i = i - 1 MESSAGE "Found ",i USING "<<<"," row(s) " ## did the query contain more than 1 record { if i > 1 then ## open the pop window form and let the user select call set_count(i) open window w1 at 5,4 with form 'cash_recp' attribute (border, cyan, prompt line 1, message line 1, form line 2, comment line 1) display array scrarr to viewscr2.* attribute(yellow) let i = arr_curr() ## current row is user selection close window w1 end if } LET glob_ser_no = inrec3.patron_id call disp3 () let qrycnt3 = 1 else ## no records were found in the query so reset counters message 'No Records Were Found' attribute(reverse, yellow) sleep 2 message '' let qrycnt3 = 0 clear form end if CALL let5_1() end function #################################################################### ## get_dflt(rec_code[1],user_id) FUNCTION TO get user defaults ## for this cash code ## WILL RETURN season and date and media FUNCTION get_dflt(rec_code,u_name) DEFINE rec_code CHAR(1), r_media LIKE receipts.r_media1, sea_a,sea_b LIKE receipts.r_season1, u_name LIKE u_name.u_name DELETE FROM u_name INSERT INTO u_name VALUES (user) SELECT season_a,season_b,media INTO sea_a,sea_b,r_media FROM log_dflt WHERE user_n MATCHES u_name IF (rec_code = "B") THEN RETURN sea_b,r_media ELSE RETURN sea_a,r_media END IF END FUNCTION #################################################################### ## get_date(rec_code) FUNCTION TO get date that correspond to this ## cash code ## WILL RETURN r_date if found else will open a ## window and display available dates for this ## cash_code ## FUNCTION get_date(rec_code,i_date) DEFINE rec_code LIKE receipts.rec_code1, quer CHAR(250), date_arr ARRAY[25] OF RECORD event_no LIKE event_date.event_no, season LIKE event_date.season, ## TES 12/14/94 e_date LIKE event_date.e_date, e_f02 LIKE event_date.e_f02, e_f03 LIKE event_date.e_f03, e_f04 LIKE event_date.e_f04 END RECORD, i,j,cnt SMALLINT, r_date,i_date DATE LET cnt = 0 SELECT COUNT(*) INTO cnt FROM event,event_date WHERE event.event_no = event_date.event_no AND e_date = i_date AND event.cash_code MATCHES rec_code IF (cnt < 1) THEN OPEN WINDOW e_datew AT 3,2 WITH FORM "eventp" ATTRIBUTE(BORDER) LET quer = " SELECT event.event_no,season,e_date,e_f02,e_f03,e_f04 ", " FROM event,event_date WHERE event.event_no = ", " event_date.event_no AND event.cash_code MATCHES '",rec_code, "'", " ORDER BY e_date " PREPARE sel_date_p FROM quer DECLARE sel_date CURSOR FOR sel_date_p LET i = 1 FOREACH sel_date INTO date_arr[i].* LET i = i + 1 END FOREACH LET i = i - 1 CALL set_count(i) MESSAGE "Move to desired date and press ESC " INPUT ARRAY date_arr WITHOUT DEFAULTS FROM viewscr2.* BEFORE ROW LET j = arr_curr() END INPUT LET r_date = date_arr[j].e_date CLOSE WINDOW e_datew RETURN r_date END IF RETURN i_date END FUNCTION #################################################################### ## get_cprice(rec_code,p_code,quan) FUNCTION TO get price that ## correspond to this cash code ## WILL RETURN amt if found else will open a ## window and display available price_codes for this ## cash_code ## FUNCTION get_cprice(rec_code,p_code,quan) DEFINE rec_code LIKE receipts.rec_code1, quer CHAR(250), price_arr ARRAY[25] OF CHAR(2), i,j,cnt SMALLINT, quan INTEGER, p_code CHAR(2), price_amt,price_sgl,price_tot MONEY, iloca,d_loca,iseries,u_series CHAR(4) SELECT loca,desc_code INTO iloca,iseries FROM cash_codes WHERE cash_code MATCHES rec_code LET d_loca = DOWNSHIFT(iloca) LET u_series = UPSHIFT(iseries) LET quer = "SELECT price_amt,price_sgl FROM ",d_loca CLIPPED,"_amt ", "WHERE series MATCHES '",u_series CLIPPED,"' AND ", "price_code MATCHES '",p_code CLIPPED,"'" PREPARE sel_price_p FROM quer DECLARE sel_price CURSOR FOR sel_price_p LET i = 1 FOREACH sel_price INTO price_amt,price_sgl LET i = i + 1 END FOREACH IF (rec_code[1] = "A") THEN LET price_tot = price_amt * quan ELSE LET price_tot = price_sgl * quan END IF RETURN price_tot END FUNCTION ############################################################################## ## get_answer(prmpt) FUNCTION that opens a little window and prompts user ## for a y/n answer ## FUNCTION get_answer(prmpt) DEFINE prmpt CHAR(60) DEFINE answer CHAR(1) LET answer = "x" # default OPEN WINDOW get_answerw AT 17,3 WITH 5 ROWS, 70 COLUMNS ATTRIBUTE(BORDER) PROMPT prmpt FOR CHAR answer WHILE (answer NOT MATCHES "[YyNn]") PROMPT prmpt FOR CHAR answer END WHILE CLOSE WINDOW get_answerw IF (answer MATCHES "[Yy]") THEN RETURN TRUE ELSE RETURN FALSE END IF END FUNCTION ---------------------------------------------------------------------------- {psc_cshr1.per FORM Guy St-Amant Aug 1993 } database orchestra screen { Patron No. [a4 ] [f001 ] [mi] [f002 ] Flag [a20] ------------------------------------------------------------------------------ Date Received [a3 ] How Paid [hp] Check No. [check ] CC.#[card ] Exp [exp ] Trans_type [t] Appv [apvc ] Seq#[seq_no] Ref_no [ref_no ] ============================================================================= CCode #Ticks Stat Code Perf Date Media Sea Amt Received ----- ------ ---- ---- --------- ----- --- ------------ [a5 ] [a14] [b] [aa] [date1 ] [a34 ] [ee] [a6 ] [a7 ] [a15] [c] [bb] [date2 ] [a35 ] [ff] [a8 ] [a9 ] [a16] [d] [cc] [date3 ] [a36 ] [gg] [a10 ] [a11] [a17] [e] [dd] [date4 ] [a37 ] [hh] [a12 ] Total [a21 ] Is the data Correct? [i] Is this a check refund: "Y" or "N" [f] ty_let [f166 ] Tax-code [f266 ] User [f167 ] Comments [f067 ] IC_MSG [f168 ] Is the data Correct? [g] Closed [h] } end tables receipts patron attributes a4 = *patron.ser_no ; = receipts.patron_id; f001 = patron.first_name; mi = patron.mi; f002 = patron.last_name; a20 = patron.p_flag; a3 = receipts.daterec; hp = receipts.how_pay, DEFAULT="CK", UPSHIFT, COMMENTS="Enter CC = Credit Card, CK = Check, or CA = Cash", INCLUDE=("CC","CK","CA"); check = receipts.check_no; card = receipts.creditcard; exp = receipts.exp; t = receipts.trans_typ, UPSHIFT, COMMENTS="Enter (S)ales, (V)oid, (R)efund, (F)orce for CC transaction"; apvc = receipts.apvc; seq_no = receipts.seq_no; ref_no = receipts.ref_no; a5 = receipts.rec_code1, UPSHIFT; a14 = receipts.quan1; b = receipts.status1, UPSHIFT; aa = receipts.p_code1, UPSHIFT; date1 = receipts.date1; a34 = receipts.r_media1, UPSHIFT; ee = receipts.r_season1; a6 = receipts.amt1; a7 = receipts.rec_code2, UPSHIFT; a15 = receipts.quan2; c = receipts.status2, UPSHIFT; bb = receipts.p_code2, UPSHIFT; date2 = receipts.date2; a35 = receipts.r_media2, UPSHIFT; ff = receipts.r_season2; a8 = receipts.amt2; a9 = receipts.rec_code3, UPSHIFT; a16 = receipts.quan3; d = receipts.status3, UPSHIFT; cc = receipts.p_code3, UPSHIFT; date3 = receipts.date3; a36 = receipts.r_media3, UPSHIFT; gg = receipts.r_season3; a10 = receipts.amt3; a11 = receipts.rec_code4, UPSHIFT; a17 = receipts.quan4; e = receipts.status4, UPSHIFT; dd = receipts.p_code4, UPSHIFT; date4 = receipts.date4; a37 = receipts.r_media4, UPSHIFT; hh = receipts.r_season4; a12 = receipts.amt4; a21 = receipts.totalrec; i = receipts.fin_close, COMMENTS = "Enter Y or N ", UPSHIFT; f = receipts.check_ck, COMMENTS = "Enter Y or N ", DEFAULT = "N", UPSHIFT; f166 = receipts.ty_let; f266 = receipts.tax_code; f067 = receipts.notes; f168 = receipts.ic_msg; f167 = receipts.c_user; h = receipts.clo_se; g = receipts.confirm, COMMENTS = "Enter Y or N ", UPSHIFT; instructions delimiters '[]' end -----------------------------------------------------------------------------