ctl-Opt DEBUG(*YES) OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE') Main(SC0335RP) BNDDIR('SC0000_BD') ; ******************************************************************** * Program Name - SC0335RP - this program was designed to display * * a maintenance panel for object entries. * * * * Programmer - Steve Croy 12/05/14 * ******************************************************************** ******************************************************************** * Modification log * * * * Date Programmer Description * * * ******************************************************************** Dcl-F SC0335DF WORKSTN usrOpn INFDS(DSPDS); **------------ Procedure Copybooks ---------------------------------- /copy qrpglesrc,SC0016_pr /copy qrpglesrc,SC0000_pr /copy qrpglesrc,SC0335_pr **------------ Data Structures -------------------------------------- Dcl-DS DETAIL extname('SCOBJSPF') end-DS ; Dcl-DS ScreenFields extname('SCOBJSPF') prefix('ZF':2) end-DS ; Dcl-DS before extname('SCOBJSPF') qualified end-DS ; Dcl-DS after extname('SCOBJSPF') qualified end-DS ; Dcl-DS alternate extname('SCACMDPF') OCCURS(30) end-DS ; /copy qrpglesrc,SCMAPS_pr Dcl-DS CmdText len(256) INZ ; zfc001 char(60) pos(1) ; zfc002 char(60) pos(61) ; zfc003 char(60) pos(121) ; zfc004 char(60) pos(181) ; zfc005 char(16) pos(241) ; End-DS ; Dcl-DS #DFPOS INZ ; // Cursor position DFROW packed(2:0) INZ(6) ; // Default row DFCOL packed(3:0) INZ(18) ; // Default column End-DS ; **------------ Define Global Constants ------------------------------ Dcl-C #TITLE2 CONST(' Update Object Entry '); Dcl-C #TITLE4 CONST(' Delete Object Entry '); Dcl-C #TITLE5 CONST(' Review Object Entry '); Dcl-C #TITLE9 CONST(' Insert Object Entry '); **------------ Define Global Variables ------------------------------ Dcl-S indPtr pointer inz( %addr(*in) ) ; Dcl-DS indicators len(99) based( indPtr ) ; ScreenChange ind pos(22) ; SflMSGQdisplay ind pos(59) ; End-DS ; Dcl-S AltCmdFound ind ; Dcl-S errorOccurred ind ; Dcl-S InvalidData ind ; Dcl-S NoErrorFound ind ; Dcl-S ObjectFound ind ; Dcl-S RecordAdded ind ; Dcl-S RecordUpdated ind ; Dcl-S RecordDeleted ind ; Dcl-S ReturnRequested ind ; Dcl-S UpdateOccurred ind ; Dcl-S authl char(3) inz('999') ; Dcl-S CMDKEY char(720) ; dcl-S FKEYDS char(1) ; dcl-S messageString char(255) ; Dcl-S thisPgm char(10) inz('SC0335RP') ; dcl-S trnMsg char(7) ; Dcl-S CATEG zoned(3:0) inz(500) ; dcl-S rw zoned(3:0) ; dcl-S cl zoned(3:0) ; dcl-S thisSeq zoned(3:0) ; //*=============== Main Procedure Definition ====================== Dcl-Proc SC0335RP ; //*================================================================ Dcl-PI SC0335RP extPgm('SC0335RP') ; p$OBJ char(10) ; p$TYP char(10) ; p$mode char(1) ; p$rtn char(7) ; End-PI ; FunctionKey = FunctionKeys() ; If not %open(SC0335DF) ; Open SC0335DF ; ENDIF ; trnMSG = *blanks ; IF p$mode <> 'A' ; ObjectFound = RetrieveObject( p$obj : p$typ ) ; IF ObjectFound ; detail = GetObjectData() ; before = detail ; after = detail ; ELSE ; trnMsg = 'MIS0035' ; Exsr returnToCaller ; ENDIF ; ENDIF ; SELECT; WHEN p$mode = 'A' ; // Add mode setAddMode() ; WHEN p$mode = 'C' ; // Change mode setChangeMode() ; WHEN p$mode = 'D' ; // Delete mode setDeleteMode() ; OTHER ; setViewMode() ; // View only ENDSL; setCmdKeys() ; DOU ReturnRequested ; moveDataToScreen() ; EXFMT SC033501 ; getCsrLoc(ROW:COL:rw:cl) ; #ROW = rw ; #COL = cl ; GetFunction(thisPgm:ZFmode:keypressed:fkeyid:macro:authl) ; //*------------------------------------------------------------ //* Determine what action to perform; get key function //*------------------------------------------------------------ ReturnRequested = *off ; SELECT ; WHEN function = 'EXIT' ; Exsr ReturnToCaller ; WHEN function = 'VIEW' ; setViewMode() ; WHEN function = 'ADD' ; setAddMode() ; WHEN function = 'CHANGE' ; setChangeMode() ; WHEN function = 'DELETE' ; setDeleteMode() ; WHEN function = 'PROCESS' ; ProcessRequest() ; ENDSL ; setCmdkeys() ; ENDDO ; EXSR ReturnToCaller ; //*------------ Exit Subroutine ---------------------------------- BEGSR ReturnToCaller ; //*--------------------------------------------------------------- *INLR = *ON; If %open(SC0335DF) ; Close SC0335DF ; ENDIF; IF trnMsg <> *blank ; p$rtn = trnMsg ; ELSE ; p$rtn = 'MIS0032' ; ENDIF ; RETURN; ENDSR; End-Proc SC0335RP ; //*============= Process function request ========================= Dcl-Proc processRequest ; Dcl-PI processRequest end-PI ; NoErrorFound = *on ; moveScreenToFields() ; SELECT ; When ZFmode = 'CHANGE' ; IF before <> after ; setDetails() ; RecordUpdated = UpdateObject() ; Before = after ; trnMsg = 'MIS0009' ; ELSE ; ReturnRequested = *on ; ENDIF ; When ZFmode = 'DELETE' ; ReturnRequested = DeleteObject() ; IF ReturnRequested ; RemoveObject( after.exobnm : after.exobtp ) ; IF after.exombr <> *blanks ; RemoveMember( after.exombr : after.exobsr ) ; ENDIF ; trnMsg = 'MIS0011' ; ELSE ; trnMsg = 'MIS0030' ; ENDIF ; When ZFmode = 'ADD' ; editFields() ; IF not InvalidData ; detail = after ; ClearObject() ; setDetails() ; RecordAdded = InsertObject() ; trnMsg = 'MIS0008' ; setAddMode() ; ELSE ; trnMsg = 'MIS0028' ; ENDIF ; ENDSL ; END-PROC processRequest ; //*============= Set variables for Add ============================ Dcl-Proc setAddMode ; Dcl-PI setAddMode end-PI ; ZFmode = 'ADD' ; keyflds = SetColor('GRN':'UL') ; chgflds = keyflds ; CLEAR ScreenFields ; z$seq1 = #title9 ; #ROW = dfrow - 2 ; #COL = dfcol ; ClearObject() ; END-Proc setAddMode ; //*============= Set variables for Change ========================= Dcl-Proc setChangeMode ; Dcl-PI setChangeMode end-PI ; ZFmode = 'CHANGE' ; keyflds = SetColor('WHT':'UL':'PR') ; chgflds = SetColor('TRQ':'UL') ; z$seq1 = #title2 ; #ROW = dfrow ; #COL = dfcol ; END-Proc ; //*============= Set variables for Delete ========================= Dcl-Proc setDeleteMode ; Dcl-PI setDeleteMode end-PI ; ZFmode = 'DELETE' ; chgflds = SetColor('RED':'BL':'PR') ; keyflds = chgflds ; z$seq1 = #title4 ; END-proc ; //*============= Set variables for View ========================== Dcl-Proc setViewMode ; Dcl-PI setViewMode end-PI ; keyflds = SetColor('WHT':'UL':'PR') ; chgflds = SetColor('YLW':'NL':'PR') ; ZFmode = 'VIEW' ; z$seq1 = #title5 ; END-Proc ; //*============= Edit screen fields ============================== Dcl-Proc EditFields ; Dcl-PI EditFields end-PI ; InvalidData = *off ; IF zfobnm = *blanks or zfobtp = *blanks ; invalidData = *ON ; EndIf ; END-Proc ; //*============= Move table data to display ====================== Dcl-Proc MoveDataToScreen ; Dcl-PI moveDataToScreen end-PI ; ScreenFields = before ; cmdflds = SetColor('ND') ; SELECT ; WHEN exproc = 'E' ; zfstat = 'Object exception; under review' ; stsflds = SetColor('YLW') ; WHEN exproc = 'Y' ; zfstat = 'Object expanded; awaiting test' ; stsflds = SetColor('BLU') ; WHEN exproc = 'X' ; zfstat = 'Object flagged as implemented ' ; stsflds = SetColor('WHT') ; WHEN exproc = 'O' ; zfstat = '** Object flagged as obsolete ' ; stsflds = SetColor('RED') ; OTHER ; zfstat = '* Action pending for this item' ; stsflds = SetColor('GRN') ; ENDSL ; IF zfacmd = 'Y' ; altCmdFound = RetrieveAltCmd( zfobnm : zfobtp : thisSeq) ; IF altCmdFound ; alternate = GetAltCommand() ; cmdText = eccmdx ; Else ; clear CmdText ; EndIf ; ENDIf ; END-proc moveDataToScreen ; //*============= Move display fields to output =================== Dcl-Proc moveScreenToFields ; Dcl-PI moveScreenToFields end-PI ; InvalidData = *off ; editFields() ; IF not InvalidData ; after = ScreenFields ; ELSE ; NoErrorFound = *off ; ENDIF ; END-Proc moveScreenToFields ; //*============== Set table fields to new values ================== Dcl-Proc setDetails ; Dcl-PI setDetails end-PI ; SetObjCat(after.excats) ; SetObjSeq(after.excseq) ; SetObjNam(after.exobnm) ; SetObjTyp(after.exobtp) ; SetObjDsc(after.exdesc) ; SetObjSrc(after.exobsr) ; SetObjMbr(after.exombr) ; SetSrcLib(after.exobsl) ; SetObjLib(after.exoblb) ; CompileObject(after.excomp) ; MoveObject(after.exmovo) ; MoveSource(after.exmovs) ; AlternateCmd(after.exacmd) ; END-proc setDetails ; //*=============== Set function key text for display =============== Dcl-Proc setCmdKeys ; Dcl-PI setCmdKeys end-PI ; Dcl-S M zoned(3:0) inz ; GetKeyText( thisPgm : ZFmode : cmdkey : authl ) ; DisplayKeys( cmdkey : z$key1 : z$key2 : M ) ; END-Proc setCmdKeys ;