/TITLE ** WORK WITH SOFTCODE USERS ** H DEBUG(*YES) H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE') H BNDDIR('SC0000_BD':'QC2LE') ******************************************************************** * Program Name - SC0190RP * * * * Function - This program was designed to allow a user to * * manage the softcode application users * * * * Programmer - Steve Croy iSoftwerks, Inc. * ******************************************************************** FSC0190DF CF E WORKSTN F SFILE(SC0190S1:RRNSI) F INFDS(DSPDS) *================================================================ D FunctionKey E DS EXTNAME(SCKEYSPF) qualified D PGMDS ESDS EXTNAME(SCPSTSPF) D DSPDS E DS EXTNAME(SCDSPFPF) D MACDS E DS EXTNAME(SCFUNCPF) INZ D OPTDS E DS EXTNAME(SCOPTNPF) INZ D FUNCT E DS EXTNAME(SCMACRPF) INZ D USERPR E DS extname(SCUSRSPF) D BEFORE E DS extname(SCUSRSPF) prefix(b_) inz D AFTER E DS extname(SCUSRSPF) prefix(a_) inz D SC0190RP PR D p$find 10 Const options(*nopass) D SC0190RP PI D p$find 10 Const options(*nopass) *-- Common prototypes /copy qrpglesrc,sc0000_pr *--- d indPtr s * inz( %addr(*in) ) * define named indicators d indicators ds 99 based( indPtr ) d ScreenChange n overlay( indicators : 22 ) d SflControl n overlay( indicators : 50 ) d SflDisplay n overlay( indicators : 51 ) d SflInitialize n overlay( indicators : 52 ) d SflClear n overlay( indicators : 53 ) d SflEnd n overlay( indicators : 54 ) d SflDelete n overlay( indicators : 55 ) d SflNxtChange n overlay( indicators : 58 ) d SflMSGQdisplay... d n overlay( indicators : 59 ) D WithParms PR extpgm(SUBPGM) D p$user 10 D WithParms2 PR extpgm(SUBPGM) D p$user 10 D p$mode 1 D NoParms PR extpgm(SUBPGM) D Quit pr D Exit pr extproc('exit') D 3u 0 value * Default cursor position D #DFPOS DS INZ D #DFROW 2 0 INZ(4) D #DFCOL 3 0 INZ(61) *--------------------------------------------------------------------- * Define constants *--------------------------------------------------------------------- D #MSGF C CONST('SCMSSGF') D #SAME C CONST('*SAME') D #TITLE C CONST('Work With Softcode Users') *--------------------------------------------------------------------- * START of work fields *--------------------------------------------------------------------- D MessageToDisplay... D S n D rw S 3s 0 D cl S 3s 0 D AUTHL S 3 D CATEG S 3S 0 inz(500) D CMDKEY S 720 D DTAFLD S 256 D EOFIND S 1 INZ('0') D FKEYDS S 1 D INDLR S 1 D M S 3S 0 D MSG S 80 D MSGDTA S 132 D MSGF S 10 D MSGPGM S 10 D MSGRLQ S 5 D O S 3S 0 D OPTION S 720 D p$catg S 3s 0 D p$mode S 1 D PNLNAM S 10 INZ('PROMPT') D prmdata S 256 D PARM1 S 9 0 D PARM2 S 256 D FieldName s 10 D PASSC S 1 D RCDNBR S 5 0 INZ(1) D RRNSI S 4 0 D SAVRRN S 4 0 D ScanRequested... D S n inz(*ON) D MoreRecordsRemain... D S n inz(*OFF) D NoMoreRecords... D S n inz(*OFF) D ErrorOccurred... D S n inz(*OFF) D SFLLOD S 4 0 D SFLMAX S 4 0 INZ(12) D SFLPOS S 4 0 D SFLRCN S 4 0 D W$SCAN S LIKE(Z$SCAN) d P$GATE s 10 d P$USER s 10 d P$MOD s 1 d P$ERR s 7 d P$RTN s 7 d orderBy s 50a inz('order by msusrp') d selectOnly s 50a *--------------------------------------------------------------------- * END of work fields *--------------------------------------------------------------------- /free z$seq1 = #TITLE; z$seq1 = CenterTxt(z$seq1:%size(z$seq1)); //* The security checking program tests whether the user is allowed CheckAuthority(USER:PRGNAM:CATEG:PASSC:AUTHL); IF PASSC <> 'P'; QUIT(); ENDIF; FunctionKey = FunctionKeys(); MSGID = 'MIS0001'; EXSR @GetMsg; IF %parms = 1; z$scan = p$find; ELSE; z$scan = *blanks; ENDIF; EXSR @reset; DOU FUNCT = 'EXIT'; IF MessageToDisplay; SflMSGQdisplay = *ON; ELSE; SflMSGQdisplay = *OFF; ENDIF; // write subfile message queue WRITE SC0190C2; IF ScanRequested; #ROW = #DFROW; #COL = #DFCOL; ENDIF; // Display subfile, test for EOJ, and function requested. rrnsi = 0; sflControl = *ON; IF sflrcn > 0; sflDisplay = *ON; ENDIF; WRITE SC019001; EXFMT SC0190C1; sflControl = *OFF; sflDisplay = *OFF; getCsrLoc(ROW:COL:rw:cl); #ROW = rw; #COL = cl; IF MessageToDisplay; RmvMessage(prgnam); MessageToDisplay = *OFF; ENDIF; // Get the program function based on the key detected. EXSR @EditKeyPressed; SELECT; WHEN KeyPressed = FunctionKey.ENTER; EXSR @ENTER; WHEN KeyPressed = FunctionKey.ROLLUP; EXSR @LOAD; WHEN KeyPressed = FunctionKey.ROLLDN; EXSR @DOWN; WHEN SUBOP = 'CALL'; EXSR @CALLS; WHEN FUNCT = 'EXIT'; QUIT(); WHEN FUNCT = 'RESET'; EXSR @RESET; WHEN FUNCT = 'PROMPT'; EXSR @PROMPT; WHEN FUNCT = 'MORE'; DisplayKeys(cmdkey: z$key1: z$key2: M); WHEN FUNCT = 'MOREOPT'; DisplayOptions(option: z$opt1: z$opt2: O); ENDSL; FUNCT = *BLANKS; ENDDO; //*================================================================ //* Process ENTER key //* Read and Update subfile records ... //*================================================================ BEGSR @ENTER; IF Z$RRN1 > 0; DOU %eof(SC0190DF); READC SC0190S1; IF NOT %eof(SC0190DF); IF Z$OPT <> *BLANK; z$opt = %triml(z$opt); EXSR @EditOptions; IF SUBOP = 'CALL'; EXSR @CALLS; ENDIF; z$opt = *BLANK; IF before <> after; SELECT; WHEN subact = 'C'; z$stat = '*changed'; USERPR = after; WHEN subact = 'D'; z$stat = '*deleted'; *IN30 = *ON; ENDSL; ENDIF; z$rrn2 = z$rrn1; UPDATE SC0190S1; *IN30 = *OFF; ENDIF; funct = *BLANKS; ENDIF; ENDDO; ENDIF; EXSR @READ; ENDSR; //*================================================================ //* Read the scan record format and move the scan value to the //* appropriate field. //*================================================================ BEGSR @READ; ScanRequested = *OFF; READ SC019001; IF ScreenChange; // Change indicator on ScanRequested = *ON; EXSR @RESET; ENDIF; z$scan = *BLANKS; ENDSR; //*================================================================ //* Prompt for a scan value //*================================================================ BEGSR @prompt; Prompter(PrgNam: PnlNam: Prmdata); IF Prmdata <> *blanks; Z$SCAN = PRMDATA; ScanRequested = *ON; EXSR @RESET; Z$SCAN = *BLANKS; ENDIF; ENDSR; //*================================================================ //* Initialize subfile, and reposition file for subfile load //*================================================================ BEGSR @reset; rrnsi = 1; rcdnbr = 1; sflrcn = 0; sflpos = 0; SflInitialize = *ON; WRITE SC0190C1; SflInitialize = *OFF; SflEnd = *OFF; selectOnly = %trim(z$scan); CloseUserCursor(); ClearUserRec(); SetUserCursor(orderby: selectOnly); EXSR @LOAD; EXSR @GetCmdKeys; EXSR @GetOptions; ENDSR; //*================================================================ //* Subroutine to process rolldown key //*================================================================ BEGSR @DOWN; Z$RRN2 = SFLPOS - SFLMAX; SFLPOS = SFLPOS - SFLMAX; IF SFLPOS < 1; SFLPOS = 1; ENDIF; IF Z$RRN2 < 1; Z$RRN2 = 1; MSGID = 'MIS0006'; EXSR @GetMsg; ENDIF; ENDSR; //*================================================================ //* Set lower limits using search argument, load subfile from DBF //* read file until end of file, or max nbr of records loaded //*================================================================ BEGSR @LOAD; sfllod = 0; savrrn = z$rrn2; SflEnd = *OFF; NoMoreRecords = *OFF; DOU NoMoreRecords or sfllod >= sflmax; MoreRecordsRemain = GetNextUser(); IF MoreRecordsRemain; USERPR = GetUserData(); sflrcn = sflrcn + 1; sfllod = sfllod + 1; RRNSI = SFLRCN; Z$RRN1 =SFLRCN; Z$DBRN = 0; z$opt = *BLANKS; IF msstat = '1'; z$stat = '*active'; ELSE; z$stat = '*expired'; ENDIF; IF msxdte = 99999999; z$xdte = 999999; ELSE; z$xdte = CvtToDate6('*MDY':msxdte:'*ISO'); ENDIF; IF msedte = 00000000; z$efdt = 0; ELSE; z$efdt = CvtToDate6('*MDY':msedte:'*ISO'); ENDIF; z$mail = msmail; WRITE SC0190S1; ELSE ; Sflend = *ON; NoMoreRecords = *ON; ENDIF; ENDDO; sflpos = sflpos + sflmax; IF sfllod > 0; z$rrn2 = (sflrcn - sfllod) + 1; ELSE; z$rrn2 = z$rrn2 + SFLPOS; ENDIF; IF z$rrn2 > sflrcn; z$rrn2 = sflrcn; sflpos = sflpos - sflmax; msgid = 'MIS0007'; EXSR @GetMsg; ENDIF; ENDSR; //*===================================================================== //* Get message text from message file and turn on message flag //*===================================================================== BEGSR @getmsg; msgdta = *BLANKS; msg = *BLANKS; msgf = #MSGF; MONITOR; RtvMessage(msgid:msgf:msgdta:msg); ON-ERROR; MessageToDisplay = *ON; ENDMON; msgtxt = msg; EXSR @SendMessage; ENDSR; //*===================================================================== //* Subroutine to send messages to program message queue //*===================================================================== BEGSR @SendMessage; msgdta = msgtxt; msgpgm = PRGNAM; msgrlq = #SAME; msgf = #MSGF; SndMessage(msgid:msgf:msgdta:msgrlq:msgpgm); MessageToDisplay = *ON; ENDSR; //*===================================================================== //* Subroutine to edit command key functions //* The program name, panel ID and the key are used to retreive the //* function macro. If the call fails, default to EXIT. //*===================================================================== BEGSR @EditKeyPressed; fkeyds = KeyPressed; funct = *BLANKS; fpgmid = PRGNAM; fpnlid = FMTNAM; fmacro = *BLANKS; MONITOR; GetFunction(fpgmid:fpnlid:fkeyds:fkeyid:fmacro:authl); ON-ERROR; msgid = 'MIS0003'; EXSR @GetMsg; ENDMON; FUNCT = FMACRO; ENDSR; //*===================================================================== // * Subroutine to Get the command keys for the application //*===================================================================== BEGSR @GetCmdKeys; fpgmid = PRGNAM; fpnlid = FMTNAM; CMDKEY = *BLANKS; MONITOR; GetKeyText(fpgmid:fpnlid:cmdkey:authl); ON-ERROR; msgid = 'MIS0005'; EXSR @GetMsg; ENDMON; m=0; DisplayKeys(cmdkey: z$key1: z$key2: M); ENDSR; //*===================================================================== //* Subroutine to edit program option functions //*===================================================================== BEGSR @EditOptions; FUNCT = *BLANKS; opgmid = PRGNAM; OPTNID = Z$OPT; opnlid = FMTNAM; OMACRO = *BLANKS; MONITOR; GetOption(opgmid: opnlid: optnid: omacro: authl); ON-ERROR; MSGID = 'MIS0002'; EXSR @GetMsg; OMACRO = *BLANKS; ENDMON; FUNCT = OMACRO; ENDSR; //*===================================================================== //* Subroutine to get program options for the application // *===================================================================== BEGSR @GetOptions; OPTION = *BLANKS; opnlid = FMTNAM; MONITOR; GetOptText(prgnam: opnlid: option: authl); ON-ERROR; MSGID = 'MIS0004'; EXSR @GetMsg; ENDMON; o = 0; DisplayOptions(option: z$opt1: z$opt2: O); ENDSR; //*================================================================ //* This subroutine allows program calls using pre-defined PLISTs //*================================================================ BEGSR @CALLS; EXSR @SETPM; MONITOR; SELECT; WHEN CALLPM = 'PLIST1'; CALLP WithParms(p$USER); WHEN CALLPM = 'PLIST2'; CALLP WithParms2(p$USER:p$mode); OTHER; CALLP NoParms(); ENDSL; ON-ERROR; P$ERR = 'MIS0012'; ENDMON; EXSR @RETPM; ENDSR; //*================================================================ //* This subroutine sets values for pre-defined PLISTs //*================================================================ BEGSR @SETPM; IF UserFound(msusrp); before = GetUserData(); ELSE; CLEAR before; ENDIF; p$user = msusrp; p$mode = subact; P$RTN = *BLANK; ENDSR; //*================================================================ //* This subroutine determines actions based on returned parms //*================================================================ BEGSR @retpm; IF UserFound(msusrp); after = GetUserData(); ELSE; CLEAR after; ENDIF; IF p$err<>*BLANKS; msgid = p$err; EXSR @GetMsg; MessageToDisplay = *ON; ENDIF; ENDSR; /end-free P Quit b /free ErrorOccurred = CloseUserCursor() ; *inlr = *on ; exit(0) ; /end-free P Quit e