|
Code:
- /* */
- /* Out: 2/21/06 15:06 Ver: 1. 0 Level40 CHRISTEN, DUANE J. - IT&S */
- /* Ref: ANIN040601 ANI Inventory/MSAG Update Process Redesign */
- /* DJC: Initial Program Creation */
-
- /* Copyright McLeod, Inc., as an unpublished work created in
- /* 2005. This program is CONFIDENTIAL, unpublished work of
- /* authorship. IT IS A TRADE SECRET which is the property of
- /* McLeod, Inc. All use, disclosure, and/or reproduction not
- /* specifically authorized by McLeod, Inc., is prohibited.
- /* This program may also be protected under the copyright
- /* and/or trade secret laws of non-U.S. countries. All rights
- /* reserved.
-
- /*=============================================================================================
- /* Notes
- /*=============================================================================================
-
- /* Compile with ACTGRP(PDR4305)
-
- /*=============================================================================================
- /* Control Specifications
- /*=============================================================================================
-
- H Option(*NODEBUGIO)
-
- /*=============================================================================================
- /* File Specifications
- /*=============================================================================================
-
- FMGD101000 CF E WorkStn IndDs(displayInd)
- F SFile(SFMSAG1 : sflRRN1)
- F SFile(SFMSAG2 : sflRRN1)
-
- FUTPSTDINF IF E Disk Rename(UTPSTDINF : UTFSTDINF)
-
- /*=============================================================================================
- /* Prototype Specifications
- /*=============================================================================================
-
- /Include QRPGCBSRC,MGR1010
- /Include QRPGCBSRC,MGR1011
-
- D maintainMSAGData... Maintain MSAG Data
- D PR
- D 7A Value Action/Mode
-
- D UTR1000 PR ExtPgm('UTR1000')
- D 10A Const
- D 10A Const
- D placeHolder LikeDs(security)
-
- D UTR1001 PR ExtPgm('UTR1001')
- D placeHolder LikeDs(security)
- D 10A Const
-
- /Include QRPGCBSRC,PVS9999
- /Include QRPGCBSRC,PVS9998
- /Include QRPGCBSRC,MGS0800
-
- /*=============================================================================================
- /* Data Specifications
- /*=============================================================================================
-
- /*---------------------------------------------------------------------------------------------
- /* Data Structure Specifications
- /*---------------------------------------------------------------------------------------------
-
- /Include QRPGCBSRC,DQUSEC
- /Include QRPGCBSRC,DQMHSNDPM
- /Include QRPGCBSRC,DQMHRMVPM
-
- D SDS
- D program 334 343A
- D jobName 244 253A
- D userName 254 263A
-
- D security E DS ExtName(W$PSECR)
-
- D subfile DS
- D mgmsagid 9B 0
- D houserange 21A
- D mgstreetnm 60A
- D mgcommnm 32A
- D mgstreetsx 4A
- D mgpostdir 2A
- D mgstate 2A
-
- D msagData E DS ExtName(MGPMSAG)
- D Prefix(D : 2)
-
- /*---------------------------------------------------------------------------------------------
- /* Array Specifications
- /*---------------------------------------------------------------------------------------------
-
-
- /*---------------------------------------------------------------------------------------------
- /* Indicator Specifications
- /*---------------------------------------------------------------------------------------------
-
- D EoSf S N
- D BoSf S N
-
- D refreshSfl S N
-
- /*---------------------------------------------------------------------------------------------
- /* Display Indicator Specifications
- /*---------------------------------------------------------------------------------------------
-
- D displayInd DS
- D fKeys 26A Function Keys
- D exit N OverLay(fkeys : 3) F3=Exit
- D prompt N OverLay(fkeys : 4) F4=Prompt
- D refresh N OverLay(fkeys : 5) F5=Refresh
- D add N OverLay(fkeys : 9) F9=Add
- D viewChange N OverLay(fkeys : 10) F10=View 1/2
- D cancel N OverLay(fkeys : 12) F12=Cancel
- D pageDown N OverLay(fkeys : 25) Page Down
- D pageUp N OverLay(fkeys : 26) Page Up
- D recordAtr 13A Special Rec. atribs.
- D screenChanged...
- D N Overlay(recordAtr : 1) *IN27
- D sflDsp N OverLay(recordAtr : 4) *IN30
- D sflDspCtl N OverLay(recordAtr : 5) *IN31
- D sflEnd N OverLay(recordAtr : 6) *IN32
- D msgSflEnd N OverLay(recordAtr : 7) MsgSFL SFLEND *IN33
- D sflNxtChg N OverLay(recordAtr : 12) *IN38
- D editError 20A Field error indictor
- D fieldError N Overlay(editError : 1) *IN40 - *IN59
- D Dim(20)
- D optionError N OverLay(editError : 1) *IN40
- D fieldAtr 20A Special field atribs
- D sflHome N OverLay(fieldAtr : 1) *IN60
- D optionModified...
- D N OverLay(fieldAtr : 5) *IN64
- D ptSKeyModified...
- D N OverLay(fieldAtr : 6) *IN65
- D ptAddrModified...
- D N OverLay(fieldAtr : 7) *IN66
- D fileAtr 20A Special file atribs.
- D displayF2 N OverLay(fileAtr : 1) *IN80
-
- /*---------------------------------------------------------------------------------------------
- /* Standalone Data Specifications
- /*---------------------------------------------------------------------------------------------
-
- D recordFound S 10I 0
-
- D screen S 10I 0
- D saveOption S 1A
-
- D sflRRN1 S 4P 0
- D sflPgmQ S 10A Inz('*')
- D sflPage S 10I 0 Inz(13)
- D sflLength S 10I 0
-
- D relative S 10I 0
- D cursorToExec S 10I 0
-
- D optionValue S 1A
-
- /*---------------------------------------------------------------------------------------------
- /* Constant Specifications
- /*---------------------------------------------------------------------------------------------
-
-
- /*=============================================================================================
- /* Program *Entry
- /*=============================================================================================
-
- D MGR1010 PI
- D msagId 10I 0 Const
-
- /*=============================================================================================
- /* SQL Specifications
- /*=============================================================================================
-
- C/Exec Sql
- C+ declare snmCursor scroll cursor for
- C+ select mgmsagid, char(mglowhn || '-' || trim(mghighhn), 21),
- C+ mgstreetnm, mgcommnm, mgstreetsx, mgpostdir, mgstate
- C+ from mgpmsag
- C+ where mgstreetnm like trim(:ptstreetnm)
- C+ order by mgstreetnm, mgstate, mgcommnm
- C+ for read only
- C/End-Exec
-
- C/Exec Sql
- C+ declare ctycursor scroll cursor for
- C+ select mgmsagid, char(mglowhn || '-' || trim(mghighhn), 21),
- C+ mgstreetnm, mgcommnm, mgstreetsx, mgpostdir, mgstate
- C+ from mgpmsag
- C+ where mgcommnm like trim(:ptcommnm) and
- C+ mgstreetnm like trim(:ptstreetnm)
- C+ order by mgcommnm, mgstreetnm, mgstate
- C+ for read only
- C/End-Exec
-
- C/Exec Sql
- C+ declare stctysnmCursor scroll cursor for
- C+ select mgmsagid, char(mglowhn || '-' || trim(mghighhn), 21),
- C+ mgstreetnm, mgcommnm, mgstreetsx, mgpostdir, mgstate
- C+ from mgpmsag
- C+ where mgstate = :ptstate and
- C+ mgcommnm like trim(:ptcommnm) and
- C+ mgstreetnm like trim(:ptstreetnm)
- C+ order by mgstate, mgcommnm, mgstreetnm
- C+ for read only
- C/End-Exec
-
- C/Exec Sql
- C+ declare keycursor scroll cursor for
- C+ select mgmsagid, char(mglowhn || '-' || trim(mghighhn), 21),
- C+ mgstreetnm, mgcommnm, mgstreetsx, mgpostdir, mgstate
- C+ from mgpmsag
- C+ where mgmsagid = :ptmsagid
- C+ for read only
- C/End-Exec
-
- /*=============================================================================================
- /* MainLine
- /*=============================================================================================
-
- /Free
-
- ExSr initialize;
-
- displayInd = *ALL'0';
- displayF2= *ON;
-
- ExSr clearSfl;
-
- BoSf = *ON;
- EoSf = *ON;
-
- If %Parms >= 1 and
- msagId <> 0;
- PTMSAGID = msagid;
- ptSKeyModified = *ON;
- ExSr positionTo;
- EndIf;
-
- DoU exit or cancel;
-
- ExSr prepareDisplay;
-
- Write SCMSG;
- Write HEADER;
- Write PTHEADER;
-
- If screen = 1;
- ExFmt SCMSAG1;
-
- Else;
- ExFmt SCMSAG2;
- EndIf;
-
- Read PTHEADER;
-
- /Include QRPGCBSRC,CQMHRMVPM
-
- Select;
-
- When exit or cancel;
- Leave;
-
- When refresh;
- ExSr refreshScreen;
-
- When screenChanged;
- ExSr nextChanged;
- ExSr positionTo;
-
- When pageDown;
- ExSr nextChanged;
- ExSr rollDown;
-
- When pageUp;
- ExSr nextChanged;
- ExSr rollUp;
-
- When viewChange;
- ExSr changeView;
-
- When add;
- maintainMSAGData('Add');
-
-
- Other;
- ExSr nextChanged;
-
- EndSl;
-
- If refreshSfl;
- ExSr refreshScreen;
- EndIf;
-
- EndDo;
-
- ExSr closeCursor;
-
- *INLR = *ON;
-
- //===========================================================================================
- // Prepare Display
- //===========================================================================================
-
- BegSr prepareDisplay;
-
- msgSflEnd = *ON;
- sndPm_Msg_Id = 'GEN0005';
- /Include QRPGCBSRC,CQMHSNDPM
-
- TIME = %Time;
- DAY = %SubDt(%Date : *D);
-
- sflEnd = EoSf;
-
- FKEYLINE = 'F3=Exit F5=Refresh F9=Add';
-
- If screen = 1;
- FKEYLINE = %Trim(FKEYLINE) + ' F10=View 1 F12=Cancel';
-
- Else;
- FKEYLINE = %Trim(FKEYLINE) + ' F10=View 2 F12=Cancel';
- EndIf;
-
- EndSr;
-
- //===========================================================================================
- // Position To
- //===========================================================================================
-
- BegSr positionTo;
-
- displayF2 = *ON;
-
- Select;
-
- When ptSKeyModified and
- PTMSAGID > 0;
- ExSr closeCursor;
- cursorToExec = 4;
- displayF2 = *OFF;
- PTSTATE = *BLANKS;
- PTCOMMNM = *BLANKS;
- PTSTREETNM = *BLANKS;
-
- ExSr openCursor;
- ExSr setBefore;
- ExSr rollDown;
-
- When ptAddrModified and
- PTSTATE <> *BLANKS;
- ExSr closeCursor;
- cursorToExec = 3;
- PTMSAGID = 0;
-
- PTCOMMNM = %Trim(PTCOMMNM) + '%';
- PTSTREETNM = %Trim(PTSTREETNM) + '%';
-
- ExSr openCursor;
- ExSr setBefore;
- ExSr rollDown;
-
- PTCOMMNM = %XLate('%' : ' ' : PTCOMMNM);
- PTSTREETNM = %XLate('%' : ' ' : PTSTREETNM);
-
- When ptAddrModified and
- PTCOMMNM <> *BLANKS;
- ExSr closeCursor;
- cursorToExec = 2;
- PTMSAGID = 0;
-
- PTCOMMNM = %Trim(PTCOMMNM) + '%';
- PTSTREETNM = %Trim(PTSTREETNM) + '%';
-
- ExSr openCursor;
- ExSr setBefore;
- ExSr rollDown;
-
- PTCOMMNM = %XLate('%' : ' ' : PTCOMMNM);
- PTSTREETNM = %XLate('%' : ' ' : PTSTREETNM);
-
- When ptAddrModified and
- PTSTREETNM <> *BLANKS;
-
- ExSr closeCursor;
- cursorToExec = 1;
- PTMSAGID = 0;
-
- PTSTREETNM = %Trim(PTSTREETNM) + '%';
-
- ExSr openCursor;
- ExSr setBefore;
- ExSr rollDown;
-
- PTSTREETNM = %XLate('%' : ' ' : PTSTREETNM);
-
- Other;
- If cursorToExec <> 0;
- ExSr closeCursor;
- cursorToExec = 0;
- EndIf;
-
- EndSl;
-
- EndSr;
-
- //===========================================================================================
- // Refresh Screen
- //===========================================================================================
-
- BegSr refreshScreen;
-
- If sflDsp;
- sflRRN1 = 1;
-
- Chain sflRRN1 SFMSAG1;
-
- EoSf = *OFF;
-
- ExSr setBefore;
- ExSr rollDown;
- EndIf;
-
- EndSr;
-
- //===========================================================================================
- // Next Changed
- //===========================================================================================
-
- BegSr NextChanged;
-
- If sflDsp;
- refreshSfl = *OFF;
-
- If screen = 1;
- ReadC SFMSAG1;
-
- Else;
- ReadC SFMSAG2;
- EndIf;
-
- DoW Not %EoF(MGD101000);
-
- optionValue = OPTION;
-
- If screen = 1;
- Chain sflRrn1 SFMSAG2;
-
- Else;
- Chain sflRrn1 SFMSAG1;
- EndIf;
-
- Select;
-
- When optionValue = '2';
- OPTION = ' ';
- refreshSfl = *ON;
- maintainMSAGData('Change');
-
- When optionValue = '3';
- OPTION = ' ';
- refreshSfl = *ON;
- maintainMSAGData('Copy');
-
- When optionValue = '4';
- OPTION = ' ';
- refreshSfl = *ON;
- /End-Free
- C/Exec Sql
- C+ select 1 into :recordFound
- C+ from oppaddx
- C+ where axmsagskey = :mgmsagid
- C+ fetch first 1 rows only
- C/End-Exec
- /Free
- If sqlErrorTrap(sqlcod : 'Select' : 'OPPADDX' : sqlstt) =
- 100;
- /End-Free
- C/Exec Sql
- C+ select 1 into :recordFound
- C+ from pdpe911
- C+ where e9pkey = :mgmsagid
- C+ fetch first 1 rows only
- C/End-Exec
- /Free
- If sqlErrorTrap(sqlcod : 'Select' : 'PDPE911' : sqlstt) =
- 100;
- maintainMSAGData('Delete');
-
- Else;
- optionError = *ON;
- sflNxtChg = *ON;
- sndPm_Msg_Id = 'PVMF011';
- %SubSt(sndPm_Data : 1 : 28) = x'0007' + 'MGPMSAG' +
- x'0007' + 'PDPE911' + x'0008' + 'Deletion';
- /Include QRpgCbSrc,DQMhSndPm
- EndIf;
-
- Else;
- optionError = *ON;
- sflNxtChg = *ON;
- sndPm_Msg_Id = 'PVMF011';
- %SubSt(sndPm_Data : 1 : 28) = x'0007' + 'MGPMSAG' +
- x'0007' + 'OPPADDX' + x'0008' + 'Deletion';
- /Include QRpgCbSrc,DQMhSndPm
- EndIf;
-
- When optionValue = '5';
- OPTION = ' ';
- maintainMSAGData('Display');
-
- When optionValue = '8';
- OPTION = ' ';
- MGR1011(MGMSAGID);
-
- Other;
- optionError = *ON;
- sflNxtChg = *ON;
-
- SndPm_Msg_Id = 'PVMAE80';
- %SubSt(SndPM_Data : 1 : 5) = x'0001' + OPTION + x'0000';
- /Include QRpgCbSrc,CQMhSndPm
-
- EndSl;
-
- If sflRrn1 = 1;
- sflHome = *ON;
-
- Else;
- sflHome = *OFF;
- EndIf;
-
- Update SFMSAG1;
- Update SFMSAG2;
-
- optionError = *OFF;
- sflNxtChg = *OFF;
-
- If screen = 1;
- ReadC SFMSAG1;
-
- Else;
- ReadC SFMSAG2;
- EndIf;
- EndDo;
-
- EndIf;
-
- EndSr;
-
- //===========================================================================================
- // Change View
- //===========================================================================================
-
- BegSr changeView;
-
- If sflDsp;
- If screen = 1;
- ReadC SFMSAG1;
-
- Else;
- ReadC SFMSAG2;
- EndIf;
-
- DoW Not %Eof(MGD101000);
- saveOption = OPTION;
- OPTION = *BLANKS;
-
- If screen = 1;
- Update SFMSAG1;
- Chain SflRrn1 SFMSAG2;
-
- OPTION = saveOption;
- optionModified = *ON;
-
- Update SFMSAG2;
-
- ReadC SFMSAG1;
-
- Else;
- Update SFMSAG2;
- Chain SflRrn1 SFMSAG1;
-
- OPTION = saveOption;
- optionModified = *ON;
-
- Update SFMSAG1;
-
- ReadC SFMSAG1;
- EndIf;
- EndDo;
-
- If screen = 1;
- screen = 2;
-
- Else;
- screen = 1;
- EndIf;
- EndIf;
-
- optionModified = *OFF;
-
- EndSr;
-
- //===========================================================================================
- // rollDown
- //===========================================================================================
-
- BegSr rollDown;
-
- If EoSf;
- sndPM_Msg_Id = 'GEN0429';
- /Include QRPGCBSRC,CQMHSNDPM
-
- Else;
- refreshSfl = *OFF;
- BoSf = *OFF;
-
- ExSr readNext;
-
- If sqlCod = 100;
- ExSr SetAfter;
- ExSr readPrevious;
- EndIf;
-
- ExSr clearSFL;
-
- sflRRN1 = 0;
-
- DoW sqlCod <> 100 and
- sflRRN1 < sflPage;
-
- sflRRN1 += 1;
-
|
|