000001 IDENTIFICATION  DIVISION.
000002* FormInvTrans.
000003 PROGRAM-ID.     FormInvTrans.
000004 ENVIRONMENT     DIVISION.
000005 CONFIGURATION   SECTION.
000006 POW-REPOSITORY.
000007     CLASS  AMethodSetFormInvTrans AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{01224792-0704-40B7-A9B2-41AAD15C51ED},Fujitsu-PcobForm-4"
000008     CLASS  AMixed-DCfGWnd-Main-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{378B7DAF-A303-453B-B31C-130171EAC90E},Fujitsu-PcobFormWnd-4"
000009     CLASS  AMixed-DCmSText-Main-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{C912753B-0518-49F4-9412-64FD46BFC5C7},Fujitsu-PcobStaticText-4"
000010     CLASS  ICfDataBinding AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{ADB7A782-9BBB-11D3-83B1-00A0C9614886}"
000011     CLASS  AMixed--DctMEdit-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{E11B2CD9-406C-45EB-B060-65D6E03C0406},ctMEDIT-ctMEditCtrl-5"
000012     CLASS  AMixed--DctPush-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{9E7F6657-3CC9-4A39-9DE7-D0B82CA4F0DE},ctPUSH-ctPushCtrl-4"
000013     CLASS  AMixed--DctCombo-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{014062E9-C50B-4DDE-88A5-DA0348EDD747},ctCOMBO-ctComboCtrl-5"
000014     CLASS  AMixed--DctGrid-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{995A9E3F-C0E2-4270-8D54-CD0C06D8C4C3},ctGRID-ctGridCtrl-3"
000015     CLASS  AMixed--DctGroup-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{721AF92D-224D-4FA2-810A-4DAEFAB03638},ctGROUP-ctGroupCtrl-3"
000016     CLASS  AMixed--DCtDEdit-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{8D3B59AB-783C-481A-BAF7-B9F96F95E159},ctDEDIT-ctDEditCtrl-6"
000017     CLASS  AMixed--DctNEdit-with-DCfGroupItem-Main AS "TLB=D:\CBL4\Prof4x\PowerCOBOL\Profits Programs\I0000\Debug\~build.tlb,{98D04E34-2138-46B5-9B88-4D59014D9D61},ctNEDIT-ctNEditCtrl-5"
000018 .
000019 SPECIAL-NAMES.
000020 REPOSITORY.
000021 .
000022 INPUT-OUTPUT    SECTION.
000023 FILE-CONTROL.
000024*<SCRIPT DIVISION="ENVIRONMENT", SECTION="CONFIGURATION", PARAGRAPH="FILE-CONTROL">
000025     COPY "UserF.SL".
000026     COPY "CNTLF.SL".
000027     COPY "ITEMF.SL".
000028     COPY "STYLF.SL".
000029     COPY "COLRF.SL".
000030     COPY "SCATF.SL".
000031     COPY "ITRNF.SL".
000032     COPY "ITMBF.SL".
000033     COPY "ROLLF.SL".
000034*</SCRIPT>
000035 DATA            DIVISION.
000036 BASED-STORAGE   SECTION.
000037 FILE            SECTION.
000038*<SCRIPT DIVISION="DATA", SECTION="FILE">
000039     COPY "USERF.FD" REPLACING ==USERF== BY ==USERF GLOBAL EXTERNAL==.
000040     COPY "CNTLF.FD" REPLACING ==CNTLF== BY ==CNTLF GLOBAL EXTERNAL==.
000041     COPY "ITEMF.FD" REPLACING ==ITEMF== BY ==ITEMF GLOBAL==.
000042     COPY "STYLF.FD" REPLACING ==STYLF== BY ==STYLF GLOBAL==.
000043     COPY "COLRF.FD" REPLACING ==COLRF== BY ==COLRF GLOBAL==.
000044     COPY "SCATF.FD" REPLACING ==SCATF== BY ==SCATF GLOBAL==.
000045     COPY "ITRNF.FD" REPLACING ==ITRNF== BY ==ITRNF GLOBAL==.
000046     COPY "ITMBF.FD" REPLACING ==ITMBF== BY ==ITMBF GLOBAL==.
000047     COPY "ROLLF.FD" REPLACING ==ROLLF== BY ==ROLLF GLOBAL==.
000048*</SCRIPT>
000049 WORKING-STORAGE SECTION.
000050*<SCRIPT DIVISION="DATA", SECTION="WORKING-STORAGE">
000051* 01  ReturnValue                  Pic s9(9)  Comp-5  Global.
000052* 01  Profits-Programs-Loc         Pic x(256)         Global External.
000053* 01  Profits-Data-Loc             Pic x(256)         Global External.
000054* 01  Temp-Master-Dir              Pic x(15)          Global External.
000055* 01  Temp-Sub-Dir                 Pic x(08)          Global External.
000056* 01  Master-dir                   Pic x(15)          Global External.
000057 
000058* 01  PROG-NAME                    PIC X(14)           GLOBAL External.
000059
000060     COPY "UserF.Dta".
000061     COPY "CNTLF.DTA".
000062     COPY "ITEMF.DTA".
000063     COPY "STYLF.DTA".
000064     COPY "COLRF.DTA".
000065     COPY "SCATF.DTA".
000066     COPY "ITRNF.DTA".
000067     COPY "ITMBF.DTA".
000068     COPY "ROLLF.DTA".
000069     COPY "ITEMSRCH.DTA".
000070     COPY "ERROR.DTA". 
000071     COPY "IOSDESCR.DTA".
000072     COPY "STATUS.DTA"  REPLACING ==FILE-STATUS-CODES== BY
000073                                  ==FILE-STATUS-CODES GLOBAL==.  
000074*--  11JUL19 --*
000075* 01  ERROR-FIELDS     IS GLOBAL.
000076*     05  FILE-STATUS     PIC XX.
000077*     05  FILE-NAME       PIC X(40).
000078
000079
000080 
000081     COPY "DATE.DTA2".
000082
000083*     COPY "CONSTANT.DTA2".     *> REPLACE WITH NEWER PC_CONSTANT.DTA
000084     COPY "PC_CONSTANT.DTA".
000085
000086 01  WORKMODE          PIC X GLOBAL EXTERNAL.
000087     88 MODE_M0205     VALUE "M".
000088     88 MODE_QUICKVIEW VALUE "Q".
000089        
000090
000091*  11JUL19 -- PART OF PC_CONSTANT.DTA
000092* 01  IO-WAIT-CD          PIC X              GLOBAL.
000093*     88 IO-WAIT-ON       VALUE IS "1".
000094*     88 IO-WAIT-OFF      VALUE IS "0".
000095     
000096 01  GLOBAL-EXTERNAL-VARIABLES  IS GLOBAL EXTERNAL.
000097     05  WS-MULTI-WHSE-CD               PIC S9(4) COMP-5.
000098         88  WS-MULTI-WHSE-YES          VALUE POW-TRUE.
000099     05  WS-PROFITS-APPAREL-CD          PIC S9(4) COMP-5.
000100         88  WS-PROFITS-APPAREL-YES     VALUE POW-TRUE.
000101     05  WS-DECIMAL-POSITIONS           PIC 9.
000102
000103 01  WS-CUSTOMIZED-FLAG             PIC 9(5) IS GLOBAL EXTERNAL.
000104         88 PROTECTI                    VALUE 196.
000105         
000106 01  NEXT-ITRNF-KEY                     PIC 9(6)  GLOBAL.
000107
000108 01  WS-GRID-INVTRAN                              GLOBAL.
000109     05  WS-GRID-ITEM-NUMBER                  PIC X(12).
000110     05  FILLER                               PIC X(01)  VALUE "~".
000111     05  WS-GRID-COLOR                        PIC X(11).
000112     05  FILLER                               PIC X(01)  VALUE "~".
000113     05  WS-GRID-SIZE                         PIC X(05).
000114     05  FILLER                               PIC X(01)  VALUE "~".
000115     05  WS-GRID-CATEGORY                     PIC X(10).
000116     05  FILLER                               PIC X(01)  VALUE "~".
000117     05  WS-GRID-WHSE-NO                      PIC X(04).
000118     05  FILLER                               PIC X(01)  VALUE "~".
000119     05  WS-GRID-TRAN-TYPE                    PIC X(12).
000120     05  FILLER                               PIC X(01)  VALUE "~".
000121     05  WS-GRID-TRAN-QTY                     PIC -9(8).9(3).
000122     05  FILLER                               PIC X(01)  VALUE "~".
000123     05  WS-GRID-BIN-LOC                      PIC X(06).
000124     05  FILLER                               PIC X(01)  VALUE "~".
000125     05  WS-GRID-NEW-BIN                      PIC X(06).
000126     05  FILLER                               PIC X(01)  VALUE "~".
000127     05  WS-GRID-REF                          PIC X(20).
000128     05  FILLER                               PIC X(01)  VALUE "~".
000129     05  WS-GRID-ROLL-NBR                     PIC X(10).
000130     05  FILLER                               PIC X(01)  VALUE "~".
000131     05  WS-GRID-LOT-NBR                      PIC X(20).
000132     05  FILLER                               PIC X(01)  VALUE "~".
000133     05  WS-GRID-ITRNF-KEY                    PIC 9(06).
000134     05  FILLER                               PIC X(01)  VALUE "~".
000135 
000136 01  EDIT-FLAG                                PIC X  GLOBAL.
000137     88 EDIT-YES                              VALUE "E".
000138     88 NEW-YES                               VALUE "N".
000139 01  EDIT-ITRNF-KEY                           PIC 9(6)  GLOBAL.
000140 01  EDIT-GRID-INDEX                          PIC S9(9) COMP-5 GLOBAL.
000141 01  DATA-PASSED-FLAG                         PIC X     GLOBAL.
000142     88 DATA-FAILED                           VALUE "F".
000143     88 DATA-PASSED                           VALUE "P".
000144     
000145 01  WS-SCAT-GROUP-NBR            PIC 9(3)  VALUE ZERO  GLOBAL.
000146 01  WS-HOLD-COLOR-INDEX          PIC S9(9)  COMP-5     GLOBAL.
000147 01  WS-HOLD-SIZE-INDEX           PIC S9(9)  COMP-5     GLOBAL.
000148 01  WS-HOLD-CATEGORY-INDEX       PIC S9(9)  COMP-5     GLOBAL.
000149     
000150*</SCRIPT>
000151 CONSTANT        SECTION.
000152 LINKAGE         SECTION.
000153 01  POW-FORM IS GLOBAL.
000154   02  POW-SELF OBJECT REFERENCE AMethodSetFormInvTrans.
000155   02  POW-SUPER  PIC X(4).
000156   02  POW-THIS OBJECT REFERENCE AMethodSetFormInvTrans.
000157   02  CmStaticItemNbr OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000158   02  ctMEditItemNo OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000159   02  ctPushClose OBJECT REFERENCE AMixed--DctPush-with-DCfGroupItem-Main.
000160   02  CmStaticItemColor OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000161   02  CmStaticItemSize OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000162   02  CmStaticItemCat OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000163   02  CmStaticItemWhse OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000164   02  ctMEditItemWhseNo OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000165   02  ctComboColors OBJECT REFERENCE AMixed--DctCombo-with-DCfGroupItem-Main.
000166   02  ctComboSize OBJECT REFERENCE AMixed--DctCombo-with-DCfGroupItem-Main.
000167   02  ctComboCategory OBJECT REFERENCE AMixed--DctCombo-with-DCfGroupItem-Main.
000168   02  ctGridInvTrans OBJECT REFERENCE AMixed--DctGrid-with-DCfGroupItem-Main.
000169   02  ctPushPrintEdit OBJECT REFERENCE AMixed--DctPush-with-DCfGroupItem-Main.
000170   02  ctPushClear OBJECT REFERENCE AMixed--DctPush-with-DCfGroupItem-Main.
000171   02  ctGroup1 OBJECT REFERENCE AMixed--DctGroup-with-DCfGroupItem-Main.
000172   02  CmStaticRollNbr OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000173   02  ctMEditRollNo OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000174   02  ctDEditTransDate OBJECT REFERENCE AMixed--DCtDEdit-with-DCfGroupItem-Main.
000175   02  CmStaticTransDate OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000176   02  CmStaticVendor OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000177   02  ctMEditVendor OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000178   02  CmStaticDateOrdered OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000179   02  ctDEditDateOrdered OBJECT REFERENCE AMixed--DCtDEdit-with-DCfGroupItem-Main.
000180   02  CmStaticMillName OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000181   02  ctMEditMillName OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000182   02  ctMEditLotNbr OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000183   02  CmStaticLotNbr OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000184   02  CmStaticBinLoc OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000185   02  ctMEditBinLocation OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000186   02  ctNEditPOSeqNo OBJECT REFERENCE AMixed--DctNEdit-with-DCfGroupItem-Main.
000187   02  ctNEditPONbr OBJECT REFERENCE AMixed--DctNEdit-with-DCfGroupItem-Main.
000188   02  CmStaticPONbr OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000189   02  CmStaticLengthReceived1 OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000190   02  ctNEditTranQty OBJECT REFERENCE AMixed--DctNEdit-with-DCfGroupItem-Main.
000191   02  CmStaticRefer OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000192   02  ctMEditRef OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000193   02  CmStaticNewBin OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000194   02  ctMEditNewBin OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000195   02  CmStaticAmt OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000196   02  ctNEditTranAmt OBJECT REFERENCE AMixed--DctNEdit-with-DCfGroupItem-Main.
000197   02  CmStaticItemDesc1 OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000198   02  ctMEditItemDesc OBJECT REFERENCE AMixed--DctMEdit-with-DCfGroupItem-Main.
000199   02  CmStaticDateReceived OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000200   02  ctDEditDateReceived OBJECT REFERENCE AMixed--DCtDEdit-with-DCfGroupItem-Main.
000201   02  CmStaticPOSlash OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000202   02  ctPushSave OBJECT REFERENCE AMixed--DctPush-with-DCfGroupItem-Main.
000203   02  ctComboTranType OBJECT REFERENCE AMixed--DctCombo-with-DCfGroupItem-Main.
000204   02  CmStaticTransType OBJECT REFERENCE AMixed-DCmSText-Main-with-DCfGroupItem-Main.
000205   02  ctPushDelete OBJECT REFERENCE AMixed--DctPush-with-DCfGroupItem-Main.
000206   02  ctPushItemSearch OBJECT REFERENCE AMixed--DctPush-with-DCfGroupItem-Main.
000207 01  FormInvTrans REDEFINES POW-FORM GLOBAL OBJECT REFERENCE AMethodSetFormInvTrans.
000208 01  POW-CONTROL-ID PIC S9(9) COMP-5.
000209 01  POW-EVENT-ID   PIC S9(9) COMP-5.
000210 01  POW-OLE-PARAM  PIC X(4).
000211 01  POW-OLE-RETURN PIC X(4).
000212 01  WK-COB-PARAM.
000213   02  WK-DEFAULT-PARAM PIC X(4).
000214   02  WK-SCRIPTLET1 REDEFINES WK-DEFAULT-PARAM.
000215     03  POW-ARG-00  PIC S9(4) COMP-5.
000216     03  POW-ARG-01  PIC S9(4) COMP-5.
000217   02  WK-SCRIPTLET2 REDEFINES WK-DEFAULT-PARAM.
000218     03  POW-ARG-00  PIC S9(4) COMP-5.
000219     03  POW-ARG-01  PIC S9(4) COMP-5.
000220   02  WK-SCRIPTLET10 REDEFINES WK-DEFAULT-PARAM.
000221     03  POW-ARG-00  PIC S9(4) COMP-5.
000222     03  POW-ARG-01  PIC S9(4) COMP-5.
000223   02  WK-SCRIPTLET12 REDEFINES WK-DEFAULT-PARAM.
000224     03  POW-ARG-00  PIC S9(4) COMP-5.
000225     03  POW-ARG-01  PIC S9(4) COMP-5.
000226   02  WK-SCRIPTLET13 REDEFINES WK-DEFAULT-PARAM.
000227     03  POW-ARG-00  PIC S9(4) COMP-5.
000228     03  POW-ARG-01  PIC S9(4) COMP-5.
000229   02  WK-SCRIPTLET14 REDEFINES WK-DEFAULT-PARAM.
000230     03  POW-ARG-00  PIC S9(4) COMP-5.
000231     03  POW-ARG-01  PIC S9(4) COMP-5.
000232   02  WK-SCRIPTLET15 REDEFINES WK-DEFAULT-PARAM.
000233     03  POW-ARG-00  PIC S9(4) COMP-5.
000234     03  POW-ARG-01  PIC S9(4) COMP-5.
000235   02  WK-SCRIPTLET16 REDEFINES WK-DEFAULT-PARAM.
000236     03  POW-ARG-00  PIC S9(4) COMP-5.
000237     03  POW-ARG-01  PIC S9(4) COMP-5.
000238   02  WK-SCRIPTLET17 REDEFINES WK-DEFAULT-PARAM.
000239     03  POW-ARG-00  PIC S9(4) COMP-5.
000240     03  POW-ARG-01  PIC S9(4) COMP-5.
000241   02  WK-SCRIPTLET19 REDEFINES WK-DEFAULT-PARAM.
000242     03  POW-ARG-00  PIC S9(4) COMP-5.
000243     03  POW-ARG-01  PIC S9(4) COMP-5.
000244   02  WK-SCRIPTLET20 REDEFINES WK-DEFAULT-PARAM.
000245     03  POW-ARG-00  PIC S9(4) COMP-5.
000246     03  POW-ARG-01  PIC S9(4) COMP-5.
000247   02  WK-SCRIPTLET21 REDEFINES WK-DEFAULT-PARAM.
000248     03  POW-ARG-00  PIC S9(4) COMP-5.
000249     03  POW-ARG-01  PIC S9(4) COMP-5.
000250   02  WK-SCRIPTLET22 REDEFINES WK-DEFAULT-PARAM.
000251     03  POW-ARG-00  PIC S9(4) COMP-5.
000252     03  POW-ARG-01  PIC S9(4) COMP-5.
000253   02  WK-SCRIPTLET23 REDEFINES WK-DEFAULT-PARAM.
000254     03  POW-ARG-00  PIC S9(4) COMP-5.
000255     03  POW-ARG-01  PIC S9(4) COMP-5.
000256   02  WK-SCRIPTLET24 REDEFINES WK-DEFAULT-PARAM.
000257     03  POW-ARG-00  PIC S9(4) COMP-5.
000258     03  POW-ARG-01  PIC S9(4) COMP-5.
000259   02  WK-SCRIPTLET25 REDEFINES WK-DEFAULT-PARAM.
000260     03  POW-ARG-00  PIC S9(4) COMP-5.
000261     03  POW-ARG-01  PIC S9(4) COMP-5.
000262   02  WK-SCRIPTLET26 REDEFINES WK-DEFAULT-PARAM.
000263     03  POW-ARG-00  PIC S9(4) COMP-5.
000264     03  POW-ARG-01  PIC S9(4) COMP-5.
000265   02  WK-SCRIPTLET27 REDEFINES WK-DEFAULT-PARAM.
000266     03  POW-ARG-00  PIC S9(4) COMP-5.
000267     03  POW-ARG-01  PIC S9(4) COMP-5.
000268   02  WK-SCRIPTLET28 REDEFINES WK-DEFAULT-PARAM.
000269     03  POW-ARG-00  PIC S9(4) COMP-5.
000270     03  POW-ARG-01  PIC S9(4) COMP-5.
000271   02  WK-SCRIPTLET29 REDEFINES WK-DEFAULT-PARAM.
000272     03  POW-ARG-00  PIC S9(4) COMP-5.
000273     03  POW-ARG-01  PIC S9(4) COMP-5.
000274   02  WK-SCRIPTLET30 REDEFINES WK-DEFAULT-PARAM.
000275     03  POW-ARG-00  PIC S9(4) COMP-5.
000276     03  POW-ARG-01  PIC S9(4) COMP-5.
000277   02  WK-SCRIPTLET31 REDEFINES WK-DEFAULT-PARAM.
000278     03  POW-ARG-00  PIC S9(4) COMP-5.
000279     03  POW-ARG-01  PIC S9(4) COMP-5.
000280   02  WK-SCRIPTLET32 REDEFINES WK-DEFAULT-PARAM.
000281     03  POW-ARG-00  PIC S9(4) COMP-5.
000282     03  POW-ARG-01  PIC S9(4) COMP-5.
000283   02  WK-SCRIPTLET35 REDEFINES WK-DEFAULT-PARAM.
000284     03  POW-ARG-00  PIC S9(4) COMP-5.
000285   02  WK-SCRIPTLET36 REDEFINES WK-DEFAULT-PARAM.
000286     03  POW-ARG-00  PIC S9(4) COMP-5.
000287   02  WK-SCRIPTLET37 REDEFINES WK-DEFAULT-PARAM.
000288     03  POW-ARG-00  PIC S9(4) COMP-5.
000289   02  WK-COB-PARAM-LEN PIC S9(9) COMP-5.
000290   02  WK-OLE-PARAM-NUM PIC S9(9) COMP-5.
000291   02  WK-OLE-VT-LIST.
000292     03  WK-OLE-VT1 PIC S9(9) COMP-5.
000293     03  WK-OLE-VT2 PIC S9(9) COMP-5.
000294 PROCEDURE       DIVISION USING POW-FORM POW-CONTROL-ID POW-EVENT-ID POW-OLE-PARAM POW-OLE-RETURN WK-COB-PARAM.
000295     EVALUATE POW-CONTROL-ID
000296     WHEN 117440513
000297     EVALUATE POW-EVENT-ID
000298     WHEN 117440775
000299       MOVE 4 TO WK-COB-PARAM-LEN
000300       MOVE 2 TO WK-OLE-PARAM-NUM
000301       MOVE 33554434 TO WK-OLE-VT1
000302       MOVE 33751042 TO WK-OLE-VT2
000303       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000304         WK-OLE-VT1
000305         WK-OLE-VT2
000306       CALL "POW-SCRIPTLET1" USING
000307         POW-ARG-00 OF WK-SCRIPTLET1
000308         POW-ARG-01 OF WK-SCRIPTLET1
000309       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000310         WK-OLE-VT1
000311         WK-OLE-VT2
000312     WHEN 117440773
000313       MOVE 4 TO WK-COB-PARAM-LEN
000314       MOVE 2 TO WK-OLE-PARAM-NUM
000315       MOVE 33554434 TO WK-OLE-VT1
000316       MOVE 33751042 TO WK-OLE-VT2
000317       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000318         WK-OLE-VT1
000319         WK-OLE-VT2
000320       CALL "POW-SCRIPTLET2" USING
000321         POW-ARG-00 OF WK-SCRIPTLET2
000322         POW-ARG-01 OF WK-SCRIPTLET2
000323       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000324         WK-OLE-VT1
000325         WK-OLE-VT2
000326     WHEN 117440768
000327       CALL "POW-SCRIPTLET3"
000328     WHEN 117440769
000329       CALL "POW-SCRIPTLET4"
000330     END-EVALUATE
000331     WHEN 117440594
000332     EVALUATE POW-EVENT-ID
000333     WHEN -604
000334       MOVE 4 TO WK-COB-PARAM-LEN
000335       MOVE 2 TO WK-OLE-PARAM-NUM
000336       MOVE 33554434 TO WK-OLE-VT1
000337       MOVE 33554434 TO WK-OLE-VT2
000338       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000339         WK-OLE-VT1
000340         WK-OLE-VT2
000341       CALL "POW-SCRIPTLET10" USING
000342         POW-ARG-00 OF WK-SCRIPTLET10
000343         POW-ARG-01 OF WK-SCRIPTLET10
000344       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000345         WK-OLE-VT1
000346         WK-OLE-VT2
000347     WHEN -2147405824
000348       CALL "POW-SCRIPTLET18"
000349     END-EVALUATE
000350     WHEN 117440618
000351     EVALUATE POW-EVENT-ID
000352     WHEN -600
000353       CALL "POW-SCRIPTLET8"
000354     END-EVALUATE
000355     WHEN 117440648
000356     EVALUATE POW-EVENT-ID
000357     WHEN -604
000358       MOVE 4 TO WK-COB-PARAM-LEN
000359       MOVE 2 TO WK-OLE-PARAM-NUM
000360       MOVE 33554434 TO WK-OLE-VT1
000361       MOVE 33554434 TO WK-OLE-VT2
000362       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000363         WK-OLE-VT1
000364         WK-OLE-VT2
000365       CALL "POW-SCRIPTLET15" USING
000366         POW-ARG-00 OF WK-SCRIPTLET15
000367         POW-ARG-01 OF WK-SCRIPTLET15
000368       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000369         WK-OLE-VT1
000370         WK-OLE-VT2
000371     END-EVALUATE
000372     WHEN 117440649
000373     EVALUATE POW-EVENT-ID
000374     WHEN -604
000375       MOVE 4 TO WK-COB-PARAM-LEN
000376       MOVE 2 TO WK-OLE-PARAM-NUM
000377       MOVE 33554434 TO WK-OLE-VT1
000378       MOVE 33554434 TO WK-OLE-VT2
000379       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000380         WK-OLE-VT1
000381         WK-OLE-VT2
000382       CALL "POW-SCRIPTLET14" USING
000383         POW-ARG-00 OF WK-SCRIPTLET14
000384         POW-ARG-01 OF WK-SCRIPTLET14
000385       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000386         WK-OLE-VT1
000387         WK-OLE-VT2
000388     END-EVALUATE
000389     WHEN 117440650
000390     EVALUATE POW-EVENT-ID
000391     WHEN -604
000392       MOVE 4 TO WK-COB-PARAM-LEN
000393       MOVE 2 TO WK-OLE-PARAM-NUM
000394       MOVE 33554434 TO WK-OLE-VT1
000395       MOVE 33554434 TO WK-OLE-VT2
000396       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000397         WK-OLE-VT1
000398         WK-OLE-VT2
000399       CALL "POW-SCRIPTLET13" USING
000400         POW-ARG-00 OF WK-SCRIPTLET13
000401         POW-ARG-01 OF WK-SCRIPTLET13
000402       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000403         WK-OLE-VT1
000404         WK-OLE-VT2
000405     END-EVALUATE
000406     WHEN 117440651
000407     EVALUATE POW-EVENT-ID
000408     WHEN -604
000409       MOVE 4 TO WK-COB-PARAM-LEN
000410       MOVE 2 TO WK-OLE-PARAM-NUM
000411       MOVE 33554434 TO WK-OLE-VT1
000412       MOVE 33554434 TO WK-OLE-VT2
000413       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000414         WK-OLE-VT1
000415         WK-OLE-VT2
000416       CALL "POW-SCRIPTLET12" USING
000417         POW-ARG-00 OF WK-SCRIPTLET12
000418         POW-ARG-01 OF WK-SCRIPTLET12
000419       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000420         WK-OLE-VT1
000421         WK-OLE-VT2
000422     END-EVALUATE
000423     WHEN 117440679
000424     EVALUATE POW-EVENT-ID
000425     WHEN -601
000426       CALL "POW-SCRIPTLET6"
000427     END-EVALUATE
000428     WHEN 117440680
000429     EVALUATE POW-EVENT-ID
000430     WHEN -600
000431       CALL "POW-SCRIPTLET9"
000432     END-EVALUATE
000433     WHEN 117440688
000434     EVALUATE POW-EVENT-ID
000435     WHEN -600
000436       CALL "POW-SCRIPTLET38"
000437     END-EVALUATE
000438     WHEN 117440694
000439     EVALUATE POW-EVENT-ID
000440     WHEN -604
000441       MOVE 4 TO WK-COB-PARAM-LEN
000442       MOVE 2 TO WK-OLE-PARAM-NUM
000443       MOVE 33554434 TO WK-OLE-VT1
000444       MOVE 33554434 TO WK-OLE-VT2
000445       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000446         WK-OLE-VT1
000447         WK-OLE-VT2
000448       CALL "POW-SCRIPTLET25" USING
000449         POW-ARG-00 OF WK-SCRIPTLET25
000450         POW-ARG-01 OF WK-SCRIPTLET25
000451       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000452         WK-OLE-VT1
000453         WK-OLE-VT2
000454     END-EVALUATE
000455     WHEN 117440696
000456     EVALUATE POW-EVENT-ID
000457     WHEN -604
000458       MOVE 4 TO WK-COB-PARAM-LEN
000459       MOVE 2 TO WK-OLE-PARAM-NUM
000460       MOVE 33554434 TO WK-OLE-VT1
000461       MOVE 33554434 TO WK-OLE-VT2
000462       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000463         WK-OLE-VT1
000464         WK-OLE-VT2
000465       CALL "POW-SCRIPTLET28" USING
000466         POW-ARG-00 OF WK-SCRIPTLET28
000467         POW-ARG-01 OF WK-SCRIPTLET28
000468       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000469         WK-OLE-VT1
000470         WK-OLE-VT2
000471     WHEN 2
000472       MOVE 2 TO WK-COB-PARAM-LEN
000473       MOVE 1 TO WK-OLE-PARAM-NUM
000474       MOVE 33554434 TO WK-OLE-VT1
000475       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000476         WK-OLE-VT1
000477       CALL "POW-SCRIPTLET37" USING
000478         POW-ARG-00 OF WK-SCRIPTLET37
000479       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000480         WK-OLE-VT1
000481     END-EVALUATE
000482     WHEN 117440700
000483     EVALUATE POW-EVENT-ID
000484     WHEN -604
000485       MOVE 4 TO WK-COB-PARAM-LEN
000486       MOVE 2 TO WK-OLE-PARAM-NUM
000487       MOVE 33554434 TO WK-OLE-VT1
000488       MOVE 33554434 TO WK-OLE-VT2
000489       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000490         WK-OLE-VT1
000491         WK-OLE-VT2
000492       CALL "POW-SCRIPTLET17" USING
000493         POW-ARG-00 OF WK-SCRIPTLET17
000494         POW-ARG-01 OF WK-SCRIPTLET17
000495       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000496         WK-OLE-VT1
000497         WK-OLE-VT2
000498     END-EVALUATE
000499     WHEN 117440703
000500     EVALUATE POW-EVENT-ID
000501     WHEN -604
000502       MOVE 4 TO WK-COB-PARAM-LEN
000503       MOVE 2 TO WK-OLE-PARAM-NUM
000504       MOVE 33554434 TO WK-OLE-VT1
000505       MOVE 33554434 TO WK-OLE-VT2
000506       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000507         WK-OLE-VT1
000508         WK-OLE-VT2
000509       CALL "POW-SCRIPTLET22" USING
000510         POW-ARG-00 OF WK-SCRIPTLET22
000511         POW-ARG-01 OF WK-SCRIPTLET22
000512       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000513         WK-OLE-VT1
000514         WK-OLE-VT2
000515     WHEN 2
000516       MOVE 2 TO WK-COB-PARAM-LEN
000517       MOVE 1 TO WK-OLE-PARAM-NUM
000518       MOVE 33554434 TO WK-OLE-VT1
000519       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000520         WK-OLE-VT1
000521       CALL "POW-SCRIPTLET36" USING
000522         POW-ARG-00 OF WK-SCRIPTLET36
000523       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000524         WK-OLE-VT1
000525     END-EVALUATE
000526     WHEN 117440706
000527     EVALUATE POW-EVENT-ID
000528     WHEN -604
000529       MOVE 4 TO WK-COB-PARAM-LEN
000530       MOVE 2 TO WK-OLE-PARAM-NUM
000531       MOVE 33554434 TO WK-OLE-VT1
000532       MOVE 33554434 TO WK-OLE-VT2
000533       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000534         WK-OLE-VT1
000535         WK-OLE-VT2
000536       CALL "POW-SCRIPTLET23" USING
000537         POW-ARG-00 OF WK-SCRIPTLET23
000538         POW-ARG-01 OF WK-SCRIPTLET23
000539       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000540         WK-OLE-VT1
000541         WK-OLE-VT2
000542     END-EVALUATE
000543     WHEN 117440708
000544     EVALUATE POW-EVENT-ID
000545     WHEN -604
000546       MOVE 4 TO WK-COB-PARAM-LEN
000547       MOVE 2 TO WK-OLE-PARAM-NUM
000548       MOVE 33554434 TO WK-OLE-VT1
000549       MOVE 33554434 TO WK-OLE-VT2
000550       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000551         WK-OLE-VT1
000552         WK-OLE-VT2
000553       CALL "POW-SCRIPTLET24" USING
000554         POW-ARG-00 OF WK-SCRIPTLET24
000555         POW-ARG-01 OF WK-SCRIPTLET24
000556       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000557         WK-OLE-VT1
000558         WK-OLE-VT2
000559     END-EVALUATE
000560     WHEN 117440712
000561     EVALUATE POW-EVENT-ID
000562     WHEN -604
000563       MOVE 4 TO WK-COB-PARAM-LEN
000564       MOVE 2 TO WK-OLE-PARAM-NUM
000565       MOVE 33554434 TO WK-OLE-VT1
000566       MOVE 33554434 TO WK-OLE-VT2
000567       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000568         WK-OLE-VT1
000569         WK-OLE-VT2
000570       CALL "POW-SCRIPTLET31" USING
000571         POW-ARG-00 OF WK-SCRIPTLET31
000572         POW-ARG-01 OF WK-SCRIPTLET31
000573       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000574         WK-OLE-VT1
000575         WK-OLE-VT2
000576     END-EVALUATE
000577     WHEN 117440714
000578     EVALUATE POW-EVENT-ID
000579     WHEN -604
000580       MOVE 4 TO WK-COB-PARAM-LEN
000581       MOVE 2 TO WK-OLE-PARAM-NUM
000582       MOVE 33554434 TO WK-OLE-VT1
000583       MOVE 33554434 TO WK-OLE-VT2
000584       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000585         WK-OLE-VT1
000586         WK-OLE-VT2
000587       CALL "POW-SCRIPTLET19" USING
000588         POW-ARG-00 OF WK-SCRIPTLET19
000589         POW-ARG-01 OF WK-SCRIPTLET19
000590       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000591         WK-OLE-VT1
000592         WK-OLE-VT2
000593     END-EVALUATE
000594     WHEN 117440716
000595     EVALUATE POW-EVENT-ID
000596     WHEN -604
000597       MOVE 4 TO WK-COB-PARAM-LEN
000598       MOVE 2 TO WK-OLE-PARAM-NUM
000599       MOVE 33554434 TO WK-OLE-VT1
000600       MOVE 33554434 TO WK-OLE-VT2
000601       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000602         WK-OLE-VT1
000603         WK-OLE-VT2
000604       CALL "POW-SCRIPTLET20" USING
000605         POW-ARG-00 OF WK-SCRIPTLET20
000606         POW-ARG-01 OF WK-SCRIPTLET20
000607       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000608         WK-OLE-VT1
000609         WK-OLE-VT2
000610     END-EVALUATE
000611     WHEN 117440720
000612     EVALUATE POW-EVENT-ID
000613     WHEN -2147405823
000614       CALL "POW-SCRIPTLET11"
000615     WHEN -604
000616       MOVE 4 TO WK-COB-PARAM-LEN
000617       MOVE 2 TO WK-OLE-PARAM-NUM
000618       MOVE 33554434 TO WK-OLE-VT1
000619       MOVE 33554434 TO WK-OLE-VT2
000620       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000621         WK-OLE-VT1
000622         WK-OLE-VT2
000623       CALL "POW-SCRIPTLET30" USING
000624         POW-ARG-00 OF WK-SCRIPTLET30
000625         POW-ARG-01 OF WK-SCRIPTLET30
000626       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000627         WK-OLE-VT1
000628         WK-OLE-VT2
000629     WHEN 4
000630       CALL "POW-SCRIPTLET33"
000631     END-EVALUATE
000632     WHEN 117440723
000633     EVALUATE POW-EVENT-ID
000634     WHEN -604
000635       MOVE 4 TO WK-COB-PARAM-LEN
000636       MOVE 2 TO WK-OLE-PARAM-NUM
000637       MOVE 33554434 TO WK-OLE-VT1
000638       MOVE 33554434 TO WK-OLE-VT2
000639       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000640         WK-OLE-VT1
000641         WK-OLE-VT2
000642       CALL "POW-SCRIPTLET27" USING
000643         POW-ARG-00 OF WK-SCRIPTLET27
000644         POW-ARG-01 OF WK-SCRIPTLET27
000645       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000646         WK-OLE-VT1
000647         WK-OLE-VT2
000648     END-EVALUATE
000649     WHEN 117440726
000650     EVALUATE POW-EVENT-ID
000651     WHEN -604
000652       MOVE 4 TO WK-COB-PARAM-LEN
000653       MOVE 2 TO WK-OLE-PARAM-NUM
000654       MOVE 33554434 TO WK-OLE-VT1
000655       MOVE 33554434 TO WK-OLE-VT2
000656       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000657         WK-OLE-VT1
000658         WK-OLE-VT2
000659       CALL "POW-SCRIPTLET16" USING
000660         POW-ARG-00 OF WK-SCRIPTLET16
000661         POW-ARG-01 OF WK-SCRIPTLET16
000662       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000663         WK-OLE-VT1
000664         WK-OLE-VT2
000665     END-EVALUATE
000666     WHEN 117440729
000667     EVALUATE POW-EVENT-ID
000668     WHEN -604
000669       MOVE 4 TO WK-COB-PARAM-LEN
000670       MOVE 2 TO WK-OLE-PARAM-NUM
000671       MOVE 33554434 TO WK-OLE-VT1
000672       MOVE 33554434 TO WK-OLE-VT2
000673       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000674         WK-OLE-VT1
000675         WK-OLE-VT2
000676       CALL "POW-SCRIPTLET29" USING
000677         POW-ARG-00 OF WK-SCRIPTLET29
000678         POW-ARG-01 OF WK-SCRIPTLET29
000679       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000680         WK-OLE-VT1
000681         WK-OLE-VT2
000682     END-EVALUATE
000683     WHEN 117440732
000684     EVALUATE POW-EVENT-ID
000685     WHEN -604
000686       MOVE 4 TO WK-COB-PARAM-LEN
000687       MOVE 2 TO WK-OLE-PARAM-NUM
000688       MOVE 33554434 TO WK-OLE-VT1
000689       MOVE 33554434 TO WK-OLE-VT2
000690       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000691         WK-OLE-VT1
000692         WK-OLE-VT2
000693       CALL "POW-SCRIPTLET26" USING
000694         POW-ARG-00 OF WK-SCRIPTLET26
000695         POW-ARG-01 OF WK-SCRIPTLET26
000696       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000697         WK-OLE-VT1
000698         WK-OLE-VT2
000699     END-EVALUATE
000700     WHEN 117440735
000701     EVALUATE POW-EVENT-ID
000702     WHEN -604
000703       MOVE 4 TO WK-COB-PARAM-LEN
000704       MOVE 2 TO WK-OLE-PARAM-NUM
000705       MOVE 33554434 TO WK-OLE-VT1
000706       MOVE 33554434 TO WK-OLE-VT2
000707       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000708         WK-OLE-VT1
000709         WK-OLE-VT2
000710       CALL "POW-SCRIPTLET21" USING
000711         POW-ARG-00 OF WK-SCRIPTLET21
000712         POW-ARG-01 OF WK-SCRIPTLET21
000713       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000714         WK-OLE-VT1
000715         WK-OLE-VT2
000716     WHEN 2
000717       MOVE 2 TO WK-COB-PARAM-LEN
000718       MOVE 1 TO WK-OLE-PARAM-NUM
000719       MOVE 33554434 TO WK-OLE-VT1
000720       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000721         WK-OLE-VT1
000722       CALL "POW-SCRIPTLET35" USING
000723         POW-ARG-00 OF WK-SCRIPTLET35
000724       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000725         WK-OLE-VT1
000726     END-EVALUATE
000727     WHEN 117440737
000728     EVALUATE POW-EVENT-ID
000729     WHEN -600
000730       CALL "POW-SCRIPTLET34"
000731     END-EVALUATE
000732     WHEN 117440738
000733     EVALUATE POW-EVENT-ID
000734     WHEN -604
000735       MOVE 4 TO WK-COB-PARAM-LEN
000736       MOVE 2 TO WK-OLE-PARAM-NUM
000737       MOVE 33554434 TO WK-OLE-VT1
000738       MOVE 33554434 TO WK-OLE-VT2
000739       CALL "XPOW_SET_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM    BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000740         WK-OLE-VT1
000741         WK-OLE-VT2
000742       CALL "POW-SCRIPTLET32" USING
000743         POW-ARG-00 OF WK-SCRIPTLET32
000744         POW-ARG-01 OF WK-SCRIPTLET32
000745       CALL "XPOW_CPY_COBOL_PARAM" USING POW-OLE-PARAM WK-COB-PARAM POW-OLE-RETURN BY VALUE WK-COB-PARAM-LEN WK-OLE-PARAM-NUM
000746         WK-OLE-VT1
000747         WK-OLE-VT2
000748     END-EVALUATE
000749     WHEN 117440740
000750     EVALUATE POW-EVENT-ID
000751     WHEN -600
000752       CALL "POW-SCRIPTLET7"
000753     END-EVALUATE
000754     WHEN 117440741
000755     EVALUATE POW-EVENT-ID
000756     WHEN -600
000757       CALL "POW-SCRIPTLET5"
000758     END-EVALUATE
000759     END-EVALUATE
000760     EXIT PROGRAM.
000761 IDENTIFICATION  DIVISION.
000762* ProcInitControls.
000763 PROGRAM-ID.     ProcInitControls IS COMMON.
000764*<SCRIPT DIVISION="PROCEDURE", NAME="ProcInitControls">
000765 ENVIRONMENT     DIVISION.
000766**************************************************************************
000767* FIX KWS 11OCT02 V4.5.3 - FG RECEIPT (8) BEFORE FG ORDER (9)            *
000768**************************************************************************
000769 DATA            DIVISION.
000770 WORKING-STORAGE SECTION.
000771 PROCEDURE       DIVISION.
000772*     MOVE POW-FALSE TO "Visible" OF ctDateRecvd.
000773*     MOVE 3750 TO "Left" OF ctDateRecvd.
000774*     MOVE 2775 TO "Width" OF ctDateRecvd.
000775*     MOVE 1815 TO "Height" OF ctDateRecvd.
000776*     
000777*     MOVE POW-FALSE TO "Visible" OF ctDateOrdered.
000778*     MOVE 3750 TO "Left" OF ctDateOrdered.
000779*     MOVE 2775 TO "Width" OF ctDateOrdered.
000780*     MOVE 1815 TO "Height" OF ctDateOrdered.
000781
000782      Call "ProcDisableSection1".
000783      Call "ProcDisableSection2".
000784      Call "ProcDisableSection3".
000785      
000786*-- Load BillMethod ComboBox Selections --*
000787     INVOKE ctComboTranType "AddItem" USING "Cost Adjustment" RETURNING ReturnValue.  *> 11FEB25
000788     INVOKE ctComboTranType "AddItem" USING "Receipt" RETURNING ReturnValue.
000789     INVOKE ctComboTranType "AddItem" USING "Adjustment" RETURNING ReturnValue.
000790*10MAR15
000791     INVOKE ctComboTranType "AddItem" USING "Purchase  " RETURNING ReturnValue
000792     INVOKE ctComboTranType "AddItem" USING "Issue     " RETURNING ReturnValue.
000793*11FEB25 - REORDER SELECTIONS TO MATCH ITRN-TRAN-CD OPTIONS
000794     INVOKE ctComboTranType "AddItem" USING "B/O       " RETURNING ReturnValue.
000795     INVOKE ctComboTranType "AddItem" USING "Sale      " RETURNING ReturnValue.
000796     INVOKE ctComboTranType "AddItem" USING "Reserve   " RETURNING ReturnValue.
000797*     INVOKE ctComboTranType "AddItem" USING "Bin Transfer" RETURNING ReturnValue.   *> 11FEB25
000798*10MAR22
000799*     INVOKE ctComboTranType "AddItem" USING "F.G. Order  " RETURNING ReturnValue.  *> 11OCT02
000800     INVOKE ctComboTranType "AddItem" USING "F.G. Receipt" RETURNING ReturnValue.
000801     INVOKE ctComboTranType "AddItem" USING "F.G. Order  " RETURNING ReturnValue.  *> 11OCT02
000802     INVOKE ctComboTranType "AddItem" USING "Bin Transfer" RETURNING ReturnValue.  
000803
000804     MOVE 1 TO "ListIndex" OF ctComboTranType.
000805
000806     MOVE 1 TO "DateOffset" OF ctDEditTransDate
000807               "DateOffset" OF ctDEditDateOrdered
000808               "DateOffset" OF ctDEditDateReceived
000809                .
000810      
000811     MOVE "~" TO "BreakChar" OF ctGridInvTrans
000812                 "BreakChar" OF ctComboColors
000813                 .
000814    
000815*</SCRIPT>
000816 END PROGRAM     ProcInitControls.
000817 IDENTIFICATION  DIVISION.
000818* ProcClearFields.
000819 PROGRAM-ID.     ProcClearFields IS COMMON.
000820*<SCRIPT DIVISION="PROCEDURE", NAME="ProcClearFields">
000821 ENVIRONMENT     DIVISION.
000822 DATA            DIVISION.
000823 WORKING-STORAGE SECTION.
000824 01  HOLD-ITEM-NO                             PIC X(12)  VALUE SPACES.
000825 01  HOLD-WHSE-NO                             PIC X(04)  VALUE SPACES.
000826 01  HOLD-DATE-RECEIVED                       PIC 9(06)  VALUE ZERO.
000827 PROCEDURE       DIVISION.
000828 BEGIN-PROGRAM.
000829     MOVE "Text" OF ctMEditItemNo       TO HOLD-ITEM-NO.
000830     MOVE "Text" OF ctMEditItemWhseNo   TO HOLD-WHSE-NO.
000831     MOVE "Value" OF ctDEditDateReceived TO HOLD-DATE-RECEIVED.
000832     INVOKE ctDEditTransDate "CurrentDate" RETURNING ReturnValue.     
000833     MOVE SPACES   TO "Text" OF ctMEditItemNo
000834                      "Text" OF ctMEditItemWhseNo
000835                      "Text" OF ctMEditVendor
000836                      "Text" OF ctMEditBinLocation
000837                      "Text" OF ctMEditNewBin
000838                      "Text" OF ctMEditRef
000839                      "Text" OF ctMEditItemDesc
000840                      "Text" OF ctMEditRollNo
000841                      "Text" OF ctMEditLotNbr
000842                      "Text" OF ctMEditMillName
000843                      .
000844                      
000845     MOVE ZERO     TO "Value" OF ctNEditTranQty
000846                      "Value" OF ctNEditTranAmt                      
000847                      "Value" OF ctNEditPONbr
000848                      "Value" OF ctNEditPOSeqNo
000849                      .
000850     MOVE SPACES   TO "Text" OF ctDEditDateOrdered
000851                      "Text" OF ctDEditDateReceived
000852                      .
000853                      
000854     MOVE 1        TO "ListIndex" OF ctComboTranType
000855     
000856     MOVE 0        TO "ListIndex" OF ctComboColors
000857                      "ListIndex" OF ctComboSize
000858                      "ListIndex" OF ctComboCategory
000859                      .
000860                      
000861     MOVE HOLD-ITEM-NO        TO "Text" OF ctMEditItemNo.
000862     MOVE HOLD-WHSE-NO        TO "Text" OF ctMEditItemWhseNo.
000863     MOVE HOLD-DATE-RECEIVED  TO "Value" OF ctDEditDateReceived.
000864     
000865     INVOKE ctComboSize "ClearList".
000866     INVOKE ctComboCategory "ClearList".
000867     Call "ProcDisableSection1".
000868     Call "ProcDisableSection2".
000869     Call "ProcEnableSection1".
000870     SET NEW-YES TO TRUE.
000871     
000872 END-PROGRAM.
000873     EXIT PROGRAM.
000874         
000875*</SCRIPT>
000876 END PROGRAM     ProcClearFields.
000877 IDENTIFICATION  DIVISION.
000878* ProcInitializeVariables.
000879 PROGRAM-ID.     ProcInitializeVariables IS COMMON.
000880*<SCRIPT DIVISION="PROCEDURE", NAME="ProcInitializeVariables">
000881 ENVIRONMENT     DIVISION.
000882 DATA            DIVISION.
000883 WORKING-STORAGE SECTION.
000884 PROCEDURE       DIVISION.
000885 BEGIN-PROGRAM.
000886     Move spaces to CntlF-status, Userf-Status.
000887     Move 1      to Cntlf-Key.
000888     Move "\Profits" to Profits-Programs-Loc.
000889     SET IO-WAIT-ON  TO TRUE.
000890     
000891*</SCRIPT>
000892 END PROGRAM     ProcInitializeVariables.
000893 IDENTIFICATION  DIVISION.
000894* ProcSetPrintButton.
000895 PROGRAM-ID.     ProcSetPrintButton IS COMMON.
000896*<SCRIPT DIVISION="PROCEDURE", NAME="ProcSetPrintButton">
000897 ENVIRONMENT     DIVISION.
000898 DATA            DIVISION.
000899 WORKING-STORAGE SECTION.
000900 PROCEDURE       DIVISION.
000901     INVOKE ctGridInvTrans "ItemCount" RETURNING ReturnValue.
000902     IF RETURNVALUE NOT < ZERO
000903        MOVE POW-TRUE TO "Enabled" OF ctPushPrintEdit
000904     ELSE
000905        MOVE POW-FALSE TO "Enabled" OF ctPushPrintEdit.
000906     
000907*</SCRIPT>
000908 END PROGRAM     ProcSetPrintButton.
000909 IDENTIFICATION  DIVISION.
000910* ProcEnableSection2.
000911 PROGRAM-ID.     ProcEnableSection2 IS COMMON.
000912*<SCRIPT DIVISION="PROCEDURE", NAME="ProcEnableSection2">
000913 ENVIRONMENT     DIVISION.
000914 DATA            DIVISION.
000915 WORKING-STORAGE SECTION.
000916* UPD KWS 11APR22 V4.5.3 - START IN QTY FIELD INSTEAD OF BINLOC          *
000917**************************************************************************
000918 PROCEDURE       DIVISION.
000919 BEGIN-PROGRAM.
000920     MOVE SPACES TO "StatusText" OF POW-SELF.
000921     IF PROTECTI 
000922        IF "Text" OF ctComboTranType = "Purchase" OR
000923           "Text" OF ctComboTranType = "Issue"
000924           Move "This trans type is not supported for PACA!"
000925                TO "StatusText" OF POW-SELF
000926           GO TO END-PROGRAM.
000927              
000928     MOVE POW-FALSE       TO "Enabled"   OF ctComboTranType.
000929     MOVE POW-COLOR-BUTTONLIGHTSHADOW TO "BackColor" OF ctComboTranType.
000930*-- 11FEB25 - Add message for not yet support tran types --*
000931     IF "Text" OF ctComboTranType = "Cost Adjustment"
000932         Move "Cost Adjustments are not currently supported!"
000933                TO "StatusText" OF POW-SELF
000934           PERFORM SET-TRANTYPE-ACTIVE
000935     ELSE
000936     IF "Text" OF ctComboTranType = "Receipt"
000937        PERFORM OPEN-RECEIPT-FIELDS
000938     Else
000939     IF "Text" OF ctComboTranType = "Adjustment"
000940        If ITEM-ROLL-TRACKING-YES
000941           Move "Roll Adjustments should be made using menu 4.1.8!"
000942                TO "StatusText" OF POW-SELF
000943           PERFORM SET-TRANTYPE-ACTIVE
000944        ELSE
000945           PERFORM OPEN-ADJUSTMENT-FIELDS
000946     Else
000947*10MAR15 BEGIN
000948     IF "Text" OF ctComboTranType = "Purchase"
000949        PERFORM OPEN-PURCHASE-FIELDS
000950     Else
000951     IF "Text" OF ctComboTranType = "Issue"
000952        PERFORM OPEN-ISSUE-FIELDS
000953     Else
000954*10MAR15 END
000955     IF "Text" OF ctComboTranType = "B/O            "
000956         Move "Back orders are not currently supported!"
000957                TO "StatusText" OF POW-SELF
000958           PERFORM SET-TRANTYPE-ACTIVE
000959     ELSE
000960     IF "Text" OF ctComboTranType = "Sale           "
000961         Move "Sales are not currently supported!"
000962                TO "StatusText" OF POW-SELF
000963           PERFORM SET-TRANTYPE-ACTIVE
000964     ELSE
000965     IF "Text" OF ctComboTranType = "Reserve        "
000966         Move "Reserves are not currently supported!"
000967                TO "StatusText" OF POW-SELF
000968           PERFORM SET-TRANTYPE-ACTIVE
000969     ELSE
000970*10MAR22 BEGIN
000971     IF "Text" OF ctComboTranType = "F.G. Order"
000972        If NOT NON-STRUCTURED-ITEM-NO
000973           Move "FG transactions are only valid for Structured Items.      "
000974                TO "StatusText" OF POW-SELF
000975           PERFORM SET-TRANTYPE-ACTIVE
000976        ELSE
000977           PERFORM OPEN-FGOrder-Fields 
000978        END-IF
000979     Else
000980     IF "Text" OF ctComboTranType = "F.G. Receipt"
000981        If NOT NON-STRUCTURED-ITEM-NO
000982           Move "FG transactions are only valid for Structured Items.      "
000983                TO "StatusText" OF POW-SELF
000984           PERFORM SET-TRANTYPE-ACTIVE
000985        ELSE
000986           PERFORM OPEN-FGReceipt-Fields
000987        END-IF
000988     Else
000989*10MAR22 END
000990     IF "Text" OF ctComboTranType = "Bin Transfer"
000991        If NOT ITEM-BIN-TRACKING-YES
000992           Move "Bin Transfers are only valid for items set to Bin Tracking"
000993                TO "StatusText" OF POW-SELF
000994           PERFORM SET-TRANTYPE-ACTIVE
000995        ELSE
000996           PERFORM OPEN-BIN-TRANSFER-FIELDS
000997        END-IF
000998     End-If.
000999
001000     IF NEW-YES
001001        MOVE ITEM-DESC TO "Text" OF ctMEditItemDesc.
001002
001003     IF EDIT-YES
001004        MOVE POW-TRUE  TO "Enabled" OF ctPushDelete
001005     ELSE 
001006        MOVE POW-FALSE TO "Enabled" OF ctPushDelete.
001007     
001008 END-PROGRAM.
001009     EXIT PROGRAM.
001010     
001011     
001012 SUBROUTINE SECTION.
001013 SET-TRANTYPE-ACTIVE.
001014     MOVE POW-TRUE        TO "Enabled"   OF ctComboTranType.
001015     MOVE POW-COLOR-WHITE TO "BackColor" OF ctComboTranType.
001016     INVOKE ctComboTranType "SetFocus".
001017 
001018 OPEN-RECEIPT-FIELDS.
001019     MOVE POW-TRUE    TO "Enabled" OF ctMEditBinLocation
001020                         "Enabled" OF ctNEditTranQty
001021                         "Enabled" OF ctNEditTranAmt
001022                         "Enabled" OF ctDEditTransDate
001023                         "Enabled" OF ctMEditRef
001024                         "Enabled" OF ctMEditVendor
001025                         "Enabled" OF ctMEditItemDesc.
001026                         
001027     MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditBinLocation
001028                         "BackColor" OF ctNEditTranQty
001029                         "BackColor" OF ctNEditTranAmt
001030                         "BackColor" OF ctDEditTransDate
001031                         "BackColor" OF ctMEditRef
001032                         "BackColor" OF ctMEditVendor
001033                         "BackColor" OF ctMEditItemDesc.
001034                         
001035     IF ITEM-ROLL-TRACKING-YES
001036        MOVE POW-TRUE TO "Enabled" OF ctMEditRollNo
001037                         "Enabled" OF ctMEditLotNbr
001038                         "Enabled" OF ctMEditMillName 
001039                         "Enabled" OF ctDEditDateOrdered 
001040                         "Enabled" OF ctDEditDateReceived        
001041                         "Enabled" OF ctNEditPONbr
001042                         "Enabled" OF ctNEditPOSeqNo
001043        MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditRollNo
001044                         "BackColor" OF ctMEditLotNbr
001045                         "BackColor" OF ctMEditMillName 
001046                         "BackColor" OF ctDEditDateOrdered 
001047                         "BackColor" OF ctDEditDateReceived        
001048                         "BackColor" OF ctNEditPONbr
001049                         "BackColor" OF ctNEditPOSeqNo.
001050                         
001051*     INVOKE ctMEditBinLocation "SetFocus".    *> START IN QTY FIELD  11APR22
001052     INVOKE ctNEditTranQty "SetFocus".         *> START IN QTY FIELD  11APR22
001053
001054                              
001055 OPEN-ADJUSTMENT-FIELDS.
001056     MOVE POW-TRUE    TO "Enabled" OF ctMEditBinLocation
001057                         "Enabled" OF ctNEditTranQty
001058                         "Enabled" OF ctNEditTranAmt
001059                         "Enabled" OF ctDEditTransDate
001060                         "Enabled" OF ctMEditRef
001061                         "Enabled" OF ctMEditVendor
001062                         "Enabled" OF ctMEditItemDesc.
001063                         
001064     MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditBinLocation
001065                         "BackColor" OF ctNEditTranQty
001066                         "BackColor" OF ctNEditTranAmt
001067                         "BackColor" OF ctDEditTransDate
001068                         "BackColor" OF ctMEditRef
001069                         "BackColor" OF ctMEditVendor
001070                         "BackColor" OF ctMEditItemDesc.
001071*     INVOKE ctMEditBinLocation "SetFocus".    *> START IN QTY FIELD 11APR22
001072     INVOKE ctNEditTranQty "SetFocus".         *> START IN QTY FIELD  11APR22
001073  
001074 OPEN-PURCHASE-FIELDS.
001075     MOVE POW-TRUE    TO "Enabled" OF ctMEditBinLocation
001076                         "Enabled" OF ctNEditTranQty
001077                         "Enabled" OF ctNEditTranAmt
001078                         "Enabled" OF ctDEditTransDate
001079                         "Enabled" OF ctMEditRef
001080                         "Enabled" OF ctMEditVendor
001081                         "Enabled" OF ctMEditItemDesc.
001082                         
001083     MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditBinLocation
001084                         "BackColor" OF ctNEditTranQty
001085                         "BackColor" OF ctNEditTranAmt
001086                         "BackColor" OF ctDEditTransDate
001087                         "BackColor" OF ctMEditRef
001088                         "BackColor" OF ctMEditVendor
001089                         "BackColor" OF ctMEditItemDesc.
001090*     INVOKE ctMEditBinLocation "SetFocus".    *> START IN QTY FIELD  11APR22
001091     INVOKE ctNEditTranQty "SetFocus".         *> START IN QTY FIELD  11APR22
001092
001093 OPEN-ISSUE-FIELDS.
001094     MOVE POW-TRUE    TO "Enabled" OF ctMEditBinLocation
001095                         "Enabled" OF ctNEditTranQty
001096                         "Enabled" OF ctDEditTransDate
001097                         "Enabled" OF ctMEditRef.
001098                         
001099     MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditBinLocation
001100                         "BackColor" OF ctNEditTranQty
001101                         "BackColor" OF ctDEditTransDate
001102                         "BackColor" OF ctMEditRef.
001103*     INVOKE ctMEditBinLocation "SetFocus".    *> START IN QTY FIELD  11APR22
001104     INVOKE ctNEditTranQty "SetFocus".         *> START IN QTY FIELD  11APR22
001105  
001106 OPEN-BIN-TRANSFER-FIELDS.
001107     MOVE POW-TRUE    TO "Enabled" OF ctMEditBinLocation
001108                         "Enabled" OF ctNEditTranQty
001109                         "Enabled" OF ctDEditTransDate
001110                         "Enabled" OF ctMEditNewBin
001111                         "Enabled" OF ctMEditRef
001112                         
001113     MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditBinLocation
001114                         "BackColor" OF ctNEditTranQty
001115                         "BackColor" OF ctDEditTransDate
001116                         "BackColor" OF ctMEditNewBin
001117                         "BackColor" OF ctMEditRef.
001118     INVOKE ctMEditBinLocation "SetFocus".
001119  
001120 OPEN-FGOrder-Fields.
001121     MOVE POW-TRUE    TO "Enabled" OF ctNEditTranQty
001122                         "Enabled" OF ctDEditTransDate
001123                         "Enabled" OF ctMEditRef
001124                         
001125     MOVE POW-COLOR-WHITE TO "BackColor" OF ctNEditTranQty
001126                         "BackColor" OF ctDEditTransDate
001127                         "BackColor" OF ctMEditRef.
001128     INVOKE ctNEditTranQty "SetFocus".
001129     
001130 OPEN-FGReceipt-Fields.
001131     MOVE POW-TRUE    TO "Enabled" OF ctNEditTranQty
001132                         "Enabled" OF ctDEditTransDate
001133                         "Enabled" OF ctMEditRef
001134                         
001135     MOVE POW-COLOR-WHITE TO "BackColor" OF ctNEditTranQty
001136                         "BackColor" OF ctDEditTransDate
001137                         "BackColor" OF ctMEditRef.
001138     INVOKE ctNEditTranQty "SetFocus".
001139     
001140 SUBROUTINE-EXIT. EXIT.
001141 
001142     
001143*</SCRIPT>
001144 END PROGRAM     ProcEnableSection2.
001145 IDENTIFICATION  DIVISION.
001146* ProcGetTermID.
001147 PROGRAM-ID.     ProcGetTermID IS COMMON.
001148*<SCRIPT DIVISION="PROCEDURE", NAME="ProcGetTermID">
001149 ENVIRONMENT     DIVISION.
001150 DATA            DIVISION.
001151     
001152 WORKING-STORAGE SECTION.
001153 01  Term-id-alpha.
001154*    05  Term-IP-Addr              Pic x(4).
001155     05  Term-Computer-or-User-Name pic x(62).
001156     05  Term-ID-Aport             Pic x(2).
001157 PROCEDURE       DIVISION.
001158     Call "TermID" using Term-ID-Alpha.
001159     Move Term-Id-Alpha   to userf-key.
001160     
001161*</SCRIPT>
001162 END PROGRAM     ProcGetTermID.
001163 IDENTIFICATION  DIVISION.
001164* ProcEnableSection1.
001165 PROGRAM-ID.     ProcEnableSection1 IS COMMON.
001166*<SCRIPT DIVISION="PROCEDURE", NAME="ProcEnableSection1">
001167 ENVIRONMENT     DIVISION.
001168 DATA            DIVISION.
001169 WORKING-STORAGE SECTION.
001170 PROCEDURE       DIVISION.
001171 BEGIN-PROGRAM.
001172     Move Pow-True to "Enabled" OF ctMEditItemNo.
001173     MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditItemNo.
001174     If WS-Multi-Whse-Yes
001175        Move Pow-True to "Enabled" OF ctMEditItemWhseNo
001176        MOVE POW-COLOR-WHITE TO "BackColor" OF ctMEditItemWhseNo.
001177     MOVE POW-TRUE TO "Enabled" OF ctPushItemSearch.
001178     INVOKE ctMEditItemNo "SetFocus".
001179     
001180 END-PROGRAM.
001181     EXIT PROGRAM.    
001182     
001183*</SCRIPT>
001184 END PROGRAM     ProcEnableSection1.
001185 IDENTIFICATION  DIVISION.
001186* ProcDisableSection3.
001187 PROGRAM-ID.     ProcDisableSection3 IS COMMON.
001188*<SCRIPT DIVISION="PROCEDURE", NAME="ProcDisableSection3">
001189 ENVIRONMENT     DIVISION.
001190 DATA            DIVISION.
001191 WORKING-STORAGE SECTION.
001192 PROCEDURE       DIVISION.
001193 BEGIN-PROGRAM.
001194     MOVE POW-FALSE TO "Enabled" OF ctPushPrintEdit
001195                       .
001196 END-PROGRAM.
001197     EXIT PROGRAM.    
001198*</SCRIPT>
001199 END PROGRAM     ProcDisableSection3.
001200 IDENTIFICATION  DIVISION.
001201* ProcCTJulianDate.
001202 PROGRAM-ID.     ProcCTJulianDate IS COMMON.
001203*<SCRIPT DIVISION="PROCEDURE", NAME="ProcCTJulianDate">
001204 ENVIRONMENT     DIVISION.
001205 DATA            DIVISION.
001206 WORKING-STORAGE SECTION.
001207 PROCEDURE       DIVISION.
001208 BEGIN-PROGRAM.
001209     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
001210 END-PROGRAM.
001211     EXIT PROGRAM.    
001212     
001213     COPY "CTJULIAN.SR".
001214     
001215     
001216*</SCRIPT>
001217 END PROGRAM     ProcCTJulianDate.
001218 IDENTIFICATION  DIVISION.
001219* ProcDisableSection2.
001220 PROGRAM-ID.     ProcDisableSection2 IS COMMON.
001221*<SCRIPT DIVISION="PROCEDURE", NAME="ProcDisableSection2">
001222 ENVIRONMENT     DIVISION.
001223 DATA            DIVISION.
001224 WORKING-STORAGE SECTION.
001225 PROCEDURE       DIVISION.
001226     MOVE POW-FALSE   TO  "Enabled" OF ctComboTranType
001227                           "Enabled" OF ctDEditTransDate
001228                           "Enabled" OF ctMEditBinLocation
001229                           "Enabled" OF ctNEditTranQty
001230                           "Enabled" OF ctNEditTranAmt
001231                           "Enabled" OF ctMEditVendor
001232                           "Enabled" OF ctMEditNewBin
001233                           "Enabled" OF ctMEditRef
001234                           "Enabled" OF ctMEditItemDesc
001235                           "Enabled" OF ctMEditRollNo
001236                           "Enabled" OF ctMEditLotNbr
001237                           "Enabled" OF ctMEditMillName
001238                           "Enabled" OF ctDEditDateOrdered
001239                           "Enabled" OF ctDEditDateReceived
001240                           "Enabled" OF ctNEditPONbr
001241                           "Enabled" OF ctNEditPOSeqNo
001242                           "Enabled" OF ctPushDelete
001243                           "Enabled" OF ctPushSave
001244                           .
001245                        
001246     MOVE POW-COLOR-BUTTONLIGHTSHADOW
001247                       TO  "BackColor" OF ctComboTranType
001248                           "BackColor" OF ctDEditTransDate
001249                           "BackColor" OF ctMEditBinLocation
001250                           "BackColor" OF ctNEditTranQty
001251                           "BackColor" OF ctNEditTranAmt
001252                           "BackColor" OF ctMEditVendor
001253                           "BackColor" OF ctMEditNewBin
001254                           "BackColor" OF ctMEditRef
001255                           "BackColor" OF ctMEditItemDesc
001256                           "BackColor" OF ctMEditRollNo
001257                           "BackColor" OF ctMEditLotNbr
001258                           "BackColor" OF ctMEditMillName
001259                           "BackColor" OF ctDEditDateOrdered
001260                           "BackColor" OF ctDEditDateReceived
001261                           "BackColor" OF ctNEditPONbr
001262                           "BackColor" OF ctNEditPOSeqNo
001263                           .
001264                        
001265                           
001266*</SCRIPT>
001267 END PROGRAM     ProcDisableSection2.
001268 IDENTIFICATION  DIVISION.
001269* ProcDisableSection1.
001270 PROGRAM-ID.     ProcDisableSection1 IS COMMON.
001271*<SCRIPT DIVISION="PROCEDURE", NAME="ProcDisableSection1">
001272 ENVIRONMENT     DIVISION.
001273 DATA            DIVISION.
001274 WORKING-STORAGE SECTION.
001275 PROCEDURE       DIVISION.
001276     MOVE POW-FALSE   TO  "Enabled" OF ctMEditItemNo
001277                          "Enabled" OF ctMEditItemWhseNo
001278                          "Enabled" OF ctComboColors
001279                          "Enabled" OF ctComboSize
001280                          "Enabled" OF ctComboCategory
001281                          "Enabled" OF ctPushItemSearch.
001282
001283      MOVE POW-COLOR-BUTTONLIGHTSHADOW   TO  "BackColor" OF ctMEditItemNo
001284                                             "BackColor" OF ctMEditItemWhseNo
001285                                             "BackColor" OF ctComboColors
001286                                             "BackColor" OF ctComboSize
001287                                             "BackColor" OF ctComboCategory
001288                                             .
001289     
001290*</SCRIPT>
001291 END PROGRAM     ProcDisableSection1.
001292 IDENTIFICATION  DIVISION.
001293* ProcCloseFiles.
001294 PROGRAM-ID.     ProcCloseFiles IS COMMON.
001295*<SCRIPT DIVISION="PROCEDURE", NAME="ProcCloseFiles">
001296 ENVIRONMENT     DIVISION.
001297 DATA            DIVISION.
001298 WORKING-STORAGE SECTION.
001299 PROCEDURE       DIVISION.
001300     IF ITEMF-OPEN
001301        CLOSE ITEMF
001302        SET ITEMF-CLOSED TO TRUE.
001303     IF STYLF-OPEN
001304        CLOSE STYLF
001305        SET STYLF-CLOSED TO TRUE.
001306     IF COLRF-OPEN
001307        CLOSE COLRF
001308        SET COLRF-CLOSED TO TRUE.
001309     IF SCATF-OPEN
001310        CLOSE SCATF
001311        SET SCATF-CLOSED TO TRUE.
001312     IF ITRNF-OPEN
001313        CLOSE ITRNF
001314        SET ITRNF-CLOSED TO TRUE.
001315     IF CNTLF-OPEN
001316        CLOSE CNTLF
001317        SET CNTLF-CLOSED TO TRUE.
001318     IF USERF-OPEN
001319        CLOSE USERF    
001320        SET USERF-CLOSED TO TRUE.
001321     IF ITMBF-OPEN
001322        CLOSE ITMBF    
001323        SET ITMBF-CLOSED TO TRUE.
001324     IF ROLLF-OPEN
001325        CLOSE ROLLF    
001326        SET ROLLF-CLOSED TO TRUE.
001327     
001328*</SCRIPT>
001329 END PROGRAM     ProcCloseFiles.
001330 IDENTIFICATION  DIVISION.
001331* ProcLoadExistingTrans.
001332 PROGRAM-ID.     ProcLoadExistingTrans IS COMMON.
001333*<SCRIPT DIVISION="PROCEDURE", NAME="ProcLoadExistingTrans">
001334 ENVIRONMENT     DIVISION.
001335 DATA            DIVISION.
001336 WORKING-STORAGE SECTION.
001337 01  WS-INDEX                     PIC S9(9) COMP-5 VALUE ZERO.
001338 01  Ws-Color-String              pic x(20) value spaces.
001339 01  Ws-Color-Name                Pic x(11) value spaces.
001340 01  Ws-Color-Code                PIC X(02) Value spaces.
001341 PROCEDURE       DIVISION.
001342 DECLARATIVES.
001343    COPY "ITRNF.DS".
001344 STATUS-CHECK.
001345           IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001346              GO TO STATUS-EXIT.
001347
001348           SET DBIO OF ERROR-KIND TO TRUE.
001349           MOVE FILE-NAME         TO ERROR-DBIO.
001350           MOVE FILE-STATUS       TO IOSTATUS OF ERROR-DBIO.
001351           MOVE PROG-NAME         TO ERROR-PROGRNAME.
001352           INVOKE POW-SELF "CallForm" USING "DBIOERROR" "ERRORBOX"
001353                 RETURNING ReturnValue.
001354           INVOKE POW-SELF "CloseForm" USING "FormMaint"
001355                 RETURNING ReturnValue.
001356           EXIT PROGRAM.
001357           
001358 STATUS-EXIT. EXIT.       
001359 END DECLARATIVES. 
001360 BEGIN-PROGRAMS.
001361     INVOKE ctGridInvTrans "ClearItems" RETURNING ReturnValue.
001362     MOVE ZERO TO ITRNF-KEY.
001363     PERFORM START-ITRNF.
001364     IF C-NOT-FOUND OF ITRNF-STATUS
001365        GO TO END-PROGRAM.
001366     PERFORM WITH TEST AFTER UNTIL ITRNF-STATUS = AT-END
001367         READ ITRNF NEXT
001368              AT END MOVE ITRNF-STATUS TO ITRNF-STATUS
001369         END-READ
001370         IF C-FOUND OF ITRNF-STATUS
001371            IF WS-PROFITS-APPAREL-YES 
001372*               MOVE ITRN-ITEM-NO(1:8)  TO WS-GRID-ITEM-NUMBER
001373               PERFORM LOAD-APPAREL-FIELDS
001374            ELSE
001375               MOVE ITRN-ITEM-NO       TO WS-GRID-ITEM-NUMBER
001376               MOVE SPACES                TO WS-GRID-COLOR
001377               MOVE SPACES                TO WS-GRID-SIZE
001378               MOVE SPACES                TO WS-GRID-CATEGORY
001379            END-IF
001380            MOVE ITRN-WHSE-NO          TO WS-GRID-WHSE-NO
001381*            MOVE SPACES                TO WS-GRID-COLOR
001382*            MOVE SPACES                TO WS-GRID-SIZE
001383*            MOVE SPACES                TO WS-GRID-CATEGORY
001384            PERFORM MOVE-TRAN-TYPE  
001385            MOVE ITRN-QTY              TO WS-GRID-TRAN-QTY
001386            MOVE ITRN-REF              TO WS-GRID-REF
001387            MOVE ITRN-BIN              TO WS-GRID-BIN-LOC
001388            MOVE ITRN-NEW-BIN-LOC      TO WS-GRID-NEW-BIN
001389            MOVE ITRN-ROLL-NUMBER      TO WS-GRID-ROLL-NBR
001390            MOVE ITRN-ROLL-LOT-NBR     TO WS-GRID-LOT-NBR
001391            MOVE ITRNF-KEY             TO WS-GRID-ITRNF-KEY
001392            INVOKE ctGridInvTrans "AddItem" USING WS-GRID-INVTRAN RETURNING ReturnValue
001393         END-IF
001394     END-PERFORM.
001395     MOVE 0 TO "ListIndex" OF ctComboColors.
001396     MOVE 0 TO "ListIndex" OF ctComboSize.
001397     MOVE 0 TO "ListIndex" OF ctComboCategory.
001398
001399 END-PROGRAM.
001400     Call "ProcSetPrintButton".
001401     MOVE ITRNF-KEY TO NEXT-ITRNF-KEY.
001402     MOVE FOUND  TO ITRNF-STATUS.
001403     EXIT PROGRAM.
001404 SUBROUTINE SECTION.
001405 MOVE-TRAN-TYPE.
001406     IF ITRN-TRAN-CD = 10 
001407        MOVE "Bin Transfer"       TO WS-GRID-TRAN-TYPE
001408     ELSE
001409     IF ITRN-TRAN-CD = 1 
001410        MOVE "Receipt     "       TO WS-GRID-TRAN-TYPE
001411     ELSE
001412     IF ITRN-TRAN-CD = 2 
001413        MOVE "Adjustment  "       TO WS-GRID-TRAN-TYPE
001414*10MAR22 BEGIN
001415     ELSE
001416     IF ITRN-TRAN-CD = 3 
001417        MOVE "Purchase  "       TO WS-GRID-TRAN-TYPE
001418     ELSE
001419     IF ITRN-TRAN-CD = 4 
001420        MOVE "Issue  "       TO WS-GRID-TRAN-TYPE
001421     ELSE
001422     IF ITRN-TRAN-CD = 9 
001423        MOVE "F.G. Order  "       TO WS-GRID-TRAN-TYPE
001424     ELSE
001425     IF ITRN-TRAN-CD = 8 
001426        MOVE "F.G. Receipt "       TO WS-GRID-TRAN-TYPE.
001427*10MAR22 END
001428        
001429 LOAD-APPAREL-FIELDS.
001430*            MOVE SPACES                TO WS-GRID-COLOR
001431*            MOVE SPACES                TO WS-GRID-SIZE
001432*            MOVE SPACES                TO WS-GRID-CATEGORY
001433     MOVE ITRN-ITEM-NO   TO ITEM-NUMBER, STYLE-NUMBER.
001434     MOVE ITRN-ITEM-NO(1:8) TO WS-GRID-ITEM-NUMBER.
001435     Call "ProcLoadApparelControls".
001436     Call "ProcSetApparelControls".
001437     MOVE "ListIndex" OF ctComboColors   TO WS-INDEX.
001438     MOVE "ListText"(WS-INDEX) OF ctComboColors TO WS-COLOR-STRING.
001439     UNSTRING WS-COLOR-STRING DELIMITED BY "~"
001440              INTO WS-COLOR-NAME, WS-COLOR-CODE.
001441     MOVE WS-COLOR-NAME TO WS-GRID-COLOR.
001442     MOVE "ListIndex" OF ctComboSize     TO WS-INDEX.
001443     MOVE "ListText"(WS-INDEX) OF ctComboSize TO WS-GRID-SIZE.
001444     MOVE "ListIndex" OF ctComboCategory      TO WS-INDEX.
001445     MOVE "ListText"(WS-INDEX) OF ctComboCategory  TO WS-GRID-CATEGORY.
001446     
001447 SUBROUTINE-EXIT.
001448     EXIT PROGRAM.
001449 IN-OUT SECTION.
001450 START-ITRNF.
001451     START ITRNF KEY IS NOT < ITRNF-KEY
001452           INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
001453
001454 READ-ITRNF-NEXT.
001455     READ ITRNF NEXT
001456          AT END MOVE ITRNF-STATUS TO ITRNF-STATUS.
001457          
001458 IN-OUT-EXIT. EXIT.
001459 
001460         
001461*</SCRIPT>
001462 END PROGRAM     ProcLoadExistingTrans.
001463 IDENTIFICATION  DIVISION.
001464* ProcReadItemF.
001465 PROGRAM-ID.     ProcReadItemF IS COMMON.
001466*<SCRIPT DIVISION="PROCEDURE", NAME="ProcReadItemF">
001467 ENVIRONMENT     DIVISION.
001468 DATA            DIVISION.
001469 WORKING-STORAGE SECTION.
001470 PROCEDURE       DIVISION.
001471 DECLARATIVES.
001472     COPY "SCATF.DS". 
001473     COPY "STYLF.DS". 
001474     GO TO STATUS-EXIT.
001475 STATUS-CHECK.
001476     IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001477        GO TO STATUS-EXIT.
001478
001479 STATUS-DISPLAY.
001480*     SET DBIO OF ERROR-KIND TO TURE.
001481     MOVE "F"       TO ERROR-KIND.
001482     MOVE FILE-NAME TO NAME OF ERROR-DBIO.
001483     MOVE FILE-STATUS TO IOSTATUS OF ERROR-DBIO.
001484     MOVE PROG-NAME   TO ERROR-PROGRNAME.
001485     INVOKE POW-SELF "CallForm" USING "DBIOError" "\PROFITS\ERRORBOX" RETURNING ReturnValue .
001486     INVOKE POW-SELF "CloseForm".
001487 STATUS-EXIT. EXIT.            
001488 END DECLARATIVES.
001489 BEGIN-PROGRAM.
001490     READ ITEMF KEY IS ITEMF-KEY
001491*11FEB22          INVALID KEY MOVE ITEMF-KEY TO ITEMF-KEY.
001492          INVALID KEY MOVE ITEMF-STATUS TO ITEMF-STATUS.
001493     IF C-FOUND OF ITEMF-STATUS
001494        MOVE "Item Record Found"  TO "StatusText" OF POW-SELF
001495     ELSE
001496     IF C-NOT-FOUND OF ITEMF-STATUS
001497        MOVE "Item Not Found "    TO "StatusText" OF POW-SELF.
001498             
001499 END-PROGRAM.
001500     EXIT PROGRAM.
001501     
001502          
001503*</SCRIPT>
001504 END PROGRAM     ProcReadItemF.
001505 IDENTIFICATION  DIVISION.
001506* ProcLoadColors.
001507 PROGRAM-ID.     ProcLoadColors IS COMMON.
001508*<SCRIPT DIVISION="PROCEDURE", NAME="ProcLoadColors">
001509 ENVIRONMENT     DIVISION.
001510 DATA            DIVISION.
001511 WORKING-STORAGE SECTION.
001512 01  WS-COLOR-STRING.
001513     05  WS-COLOR-NAME              PIC X(11).
001514     05  FILLER                     PIC X     VALUE "~".
001515     05  WS-COLOR-NUMBER            PIC X(02).
001516 PROCEDURE       DIVISION.
001517 DECLARATIVES.
001518     COPY "COLRF.DS".
001519     GO TO STATUS-EXIT.
001520        
001521 STATUS-CHECK.
001522           IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001523              GO TO STATUS-EXIT.
001524
001525           SET DBIO OF ERROR-KIND TO TRUE.
001526           MOVE FILE-NAME         TO ERROR-DBIO.
001527           MOVE FILE-STATUS       TO IOSTATUS OF ERROR-DBIO.
001528           MOVE PROG-NAME         TO ERROR-PROGRNAME.
001529           INVOKE POW-SELF "CallForm" USING "DBIOERROR" "ERRORBOX"
001530                 RETURNING ReturnValue.
001531           INVOKE POW-SELF "CloseForm" USING "FormMaint"
001532                 RETURNING ReturnValue.
001533           EXIT PROGRAM.
001534           
001535 STATUS-EXIT. EXIT.       
001536 END DECLARATIVES. 
001537 Begin-Program.
001538     PERFORM START-COLRF.
001539     IF NOT C-FOUND OF COLRF-STATUS
001540        INVOKE ctComboColors "ClearList"
001541        GO TO END-PROGRAM.
001542        
001543     INVOKE ctComboColors "AddItem" USING " " RETURNING ReturnValue.
001544     PERFORM READ-COLRF-NEXT.
001545     MOVE FOUND TO COLRF-STATUS.
001546          
001547 END-PROGRAM.
001548     MOVE FOUND TO COLRF-STATUS.
001549     EXIT PROGRAM.
001550
001551 SUBROUTINE SECTION.
001552
001553 SUBROUTINE-EXIT. EXIT.
001554
001555 IN-OUT SECTION.
001556 START-COLRF.
001557     MOVE SPACES TO COLRF-KEY.
001558     START COLRF KEY NOT < COLRF-KEY
001559           INVALID MOVE COLRF-STATUS TO COLRF-STATUS.
001560
001561 READ-COLRF-NEXT.
001562     PERFORM WITH TEST AFTER UNTIL COLRF-STATUS NOT = FOUND
001563        READ COLRF NEXT
001564             AT END MOVE COLRF-STATUS TO COLRF-STATUS
001565        END-READ
001566        IF C-FOUND OF COLRF-STATUS
001567           MOVE COLR-NAME   TO WS-COLOR-NAME
001568           MOVE COLR-NUMBER TO WS-COLOR-NUMBER
001569           INVOKE ctComboColors "AddItem" USING WS-COLOR-STRING RETURNING ReturnValue
001570        END-IF
001571     END-PERFORM.
001572                     
001573 IN-OUT-EXIT. EXIT.
001574       
001575     
001576*</SCRIPT>
001577 END PROGRAM     ProcLoadColors.
001578 IDENTIFICATION  DIVISION.
001579* ProcLoadApparelFields.
001580 PROGRAM-ID.     ProcLoadApparelFields IS COMMON.
001581*<SCRIPT DIVISION="PROCEDURE", NAME="ProcLoadApparelFields">
001582 ENVIRONMENT     DIVISION.
001583 DATA            DIVISION.
001584 WORKING-STORAGE SECTION.
001585 01  WS-INDEX                     PIC S9(9) COMP-5 VALUE ZERO.
001586 01  Ws-Color-String              pic x(20) value spaces.
001587 01  Ws-Color-Name                Pic x(11) value spaces.
001588 01  Ws-Color-Code                PIC X(02) Value spaces.
001589
001590 PROCEDURE       DIVISION.
001591 DECLARATIVES.
001592     COPY "SCATF.DS". 
001593     COPY "STYLF.DS". 
001594     GO TO STATUS-EXIT.
001595 STATUS-CHECK.
001596     IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001597        GO TO STATUS-EXIT.
001598
001599 STATUS-DISPLAY.
001600*     SET DBIO OF ERROR-KIND TO TURE.
001601     MOVE "F"       TO ERROR-KIND.
001602     MOVE FILE-NAME TO NAME OF ERROR-DBIO.
001603     MOVE FILE-STATUS TO IOSTATUS OF ERROR-DBIO.
001604     MOVE PROG-NAME   TO ERROR-PROGRNAME.
001605     INVOKE POW-SELF "CallForm" USING "DBIOError" "\PROFITS\ERRORBOX" RETURNING ReturnValue .
001606     INVOKE POW-SELF "CloseForm".
001607 STATUS-EXIT. EXIT.            
001608 END DECLARATIVES.
001609
001610 BEGIN-PROGRAM.
001611     Call "ProcLoadApparelControls".
001612     Call "ProcSetApparelControls".
001613     IF C-FOUND OF STYLF-STATUS
001614        MOVE POW-FALSE TO "Enabled" OF ctMEditItemNo
001615                          "Enabled" OF ctMEditItemWhseNo
001616        MOVE POW-COLOR-BUTTONLIGHTSHADOW TO "BackColor" OF ctMEditItemNo
001617                                            "BackColor" OF ctMEditItemWhseNo
001618        MOVE POW-TRUE  TO "Enabled" OF ctComboColors
001619                          "Enabled" OF ctComboSize
001620                          "Enabled" OF ctComboCategory
001621        MOVE POW-COLOR-WHITE 
001622                       TO "BackColor" OF ctComboColors
001623                          "BackColor" OF ctComboSize
001624                          "BackColor" OF ctComboCategory
001625        INVOKE ctComboColors "SetFocus"
001626     ELSE
001627        MOVE ZERO TO "ListIndex" OF ctComboColors
001628        MOVE POW-FALSE TO "Enabled" OF ctComboColors
001629                          "Enabled" OF ctComboSize
001630                          "Enabled" OF ctComboCategory
001631        MOVE POW-COLOR-BUTTONLIGHTSHADOW 
001632                       TO "BackColor" OF ctComboColors
001633                          "BackColor" OF ctComboSize
001634                          "BackColor" OF ctComboCategory
001635        INVOKE ctGridInvTrans "SetFocus"
001636        INVOKE ctMEditItemNo "SetFocus".
001637
001638                             
001639 END-PROGRAM.
001640     EXIT PROGRAM.
001641
001642 SUBROUTINE-SECTION.
001643     
001644 SUBROUTINE-EXIT. EXIT.
001645 
001646 IN-OUT SECTION.
001647 IN-OUT-EXIT. EXIT.
001648 
001649          
001650*</SCRIPT>
001651 END PROGRAM     ProcLoadApparelFields.
001652 IDENTIFICATION  DIVISION.
001653* ProcBegin.
001654 PROGRAM-ID.     ProcBegin IS COMMON.
001655*<SCRIPT DIVISION="PROCEDURE", NAME="ProcBegin">
001656 ENVIRONMENT     DIVISION.
001657 DATA            DIVISION.
001658 WORKING-STORAGE SECTION.
001659 PROCEDURE       DIVISION.
001660 DECLARATIVES.
001661     COPY "USERF.DS".
001662     COPY "CNTLF.DS".
001663     COPY "ITEMF.DS".
001664     COPY "STYLF.DS".
001665     COPY "COLRF.DS".
001666     COPY "SCATF.DS".
001667     COPY "ITMBF.DS".
001668     COPY "ROLLF.DS".
001669*     COPY "ITRNF.DS".    *>  If file missing will create a new empty file.
001670 Z-ITRNF SECTION.
001671     USE AFTER ERROR PROCEDURE ON ITRNF.
001672 Z-ITRNF-D.
001673     MOVE ITRNF-FULLPATH TO FILE-NAME.
001674     MOVE ITRNF-STATUS TO FILE-STATUS.
001675     IF NOT ITRNF-STATUS = NO-FILE
001676        PERFORM STATUS-CHECK THRU STATUS-EXIT.
001677     GO TO STATUS-EXIT.
001678        
001679 STATUS-CHECK.
001680           IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001681              GO TO STATUS-EXIT.
001682
001683           SET DBIO OF ERROR-KIND TO TRUE.
001684           MOVE FILE-NAME         TO ERROR-DBIO.
001685           MOVE FILE-STATUS       TO IOSTATUS OF ERROR-DBIO.
001686           MOVE PROG-NAME         TO ERROR-PROGRNAME.
001687           INVOKE POW-SELF "CallForm" USING "DBIOERROR" "ERRORBOX"
001688                 RETURNING ReturnValue.
001689           INVOKE POW-SELF "CloseForm" USING "FormMaint"
001690                 RETURNING ReturnValue.
001691           EXIT PROGRAM.
001692           
001693 STATUS-EXIT. EXIT.       
001694 END DECLARATIVES. 
001695 Begin-Program.
001696     COPY "USERF.SR".
001697     PERFORM OPEN-USERF.
001698     IF NOT C-FOUND OF USERF-STATUS
001699        GO TO END-PROGRAM.
001700        
001701     PERFORM GET-TERMID.
001702     PERFORM READ-USERF.
001703     UNLOCK USERF.
001704     COPY "CNTLF.SR".
001705     COPY "ITEMF.SR".
001706     COPY "STYLF.SR".
001707     COPY "COLRF.SR".
001708     COPY "SCATF.SR".
001709     COPY "ITMBF.SR".
001710     COPY "ROLLF.SR".
001711     MOVE SPACES TO ITRNF--NAME.
001712     STRING "ITRN"         DELIMITED BY SIZE
001713            USER-TERMID    DELIMITED BY SIZE
001714            ".FIL"         DELIMITED BY SIZE
001715            INTO ITRNF--NAME.
001716     COPY "ITRNF.SR".
001717
001718     PERFORM OPEN-CNTLF.
001719     IF NOT C-FOUND OF CNTLF-STATUS
001720        GO TO END-PROGRAM.
001721     PERFORM READ-CNTLF-NOLOCK.
001722
001723*     PERFORM OPEN-ROLLF.
001724*     IF NOT C-FOUND OF ROLLF-STATUS
001725*        GO TO END-PROGRAM.
001726
001727     PERFORM OPEN-ITEMF.
001728     IF NOT C-FOUND OF ITEMF-STATUS
001729        GO TO END-PROGRAM.
001730
001731     PERFORM OPEN-STYLF.
001732     IF NOT C-FOUND OF STYLF-STATUS
001733        GO TO END-PROGRAM.
001734
001735     PERFORM OPEN-COLRF.
001736     IF NOT C-FOUND OF COLRF-STATUS
001737        GO TO END-PROGRAM.
001738
001739     PERFORM OPEN-SCATF.
001740     IF NOT C-FOUND OF SCATF-STATUS
001741        GO TO END-PROGRAM.
001742
001743     PERFORM OPEN-ROLLF.
001744     IF NOT C-FOUND OF ROLLF-STATUS
001745        GO TO END-PROGRAM.
001746
001747     PERFORM OPEN-ITMBF.
001748     IF NOT C-FOUND OF ITMBF-STATUS
001749        GO TO END-PROGRAM.
001750
001751     PERFORM OPEN-ITRNF.
001752     IF NOT C-FOUND OF ITRNF-STATUS
001753        GO TO END-PROGRAM.
001754*    PERFORM LOAD-ITRNF.
001755
001756     MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
001757     
001758     IF MULTI-WHSE
001759        MOVE POW-TRUE    TO WS-MULTI-WHSE-CD
001760     ELSE
001761        MOVE POW-FALSE   TO WS-MULTI-WHSE-CD
001762        MOVE POW-FALSE   TO "ColumnVisible"(4) OF ctGridInvTrans.
001763        
001764     IF PROFITS-APPAREL-YES
001765        MOVE "XXXXXXXX"  TO "EditMask" OF ctMEditItemNo
001766        MOVE POW-TRUE    TO WS-PROFITS-APPAREL-CD
001767        MOVE POW-TRUE    TO "ColumnVisible"(1) OF ctGridInvTrans
001768                            "ColumnVisible"(2) OF ctGridInvTrans
001769                            "ColumnVisible"(3) OF ctGridInvTrans
001770     ELSE
001771        MOVE "XXXXXXXXXXXX"  TO "EditMask" OF ctMEditItemNo
001772        MOVE POW-FALSE       TO WS-PROFITS-APPAREL-CD
001773        MOVE POW-FALSE       TO "ColumnVisible"(1) OF ctGridInvTrans
001774                                "ColumnVisible"(2) OF ctGridInvTrans
001775                                "ColumnVisible"(3) OF ctGridInvTrans.
001776                          
001777     COMPUTE WS-DECIMAL-POSITIONS = CNTL-DECIMAL-POS - 1.
001778
001779 
001780     Call "ProcLoadColors".
001781     Call "ProcClearFields".
001782
001783     MOVE 1              TO NEXT-ITRNF-KEY.
001784     Call "ProcLoadExistingTrans".
001785     Call "ProcEnableSection1".
001786 
001787 End-Program.
001788     IF NOT C-FOUND OF ITEMF-STATUS OR
001789        NOT C-FOUND OF STYLF-STATUS OR
001790        NOT C-FOUND OF COLRF-STATUS OR
001791        NOT C-FOUND OF SCATF-STATUS OR
001792        NOT C-FOUND OF ITRNF-STATUS OR
001793        NOT C-FOUND OF CNTLF-STATUS 
001794           Call "ProcCloseFiles"
001795           INVOKE pow-self "CloseForm" RETURNING ReturnValue
001796     END-IF.
001797     
001798     Exit Program.
001799     
001800 Subroutine Section.
001801 GET-TERMID.
001802      Call "ProcGetTermId".
001803
001804 Subroutine-Exit. Exit.
001805
001806 IN-OUT SECTION.
001807 OPEN-USERF.
001808     Open I-O UserF.
001809     IF C-FOUND OF USERF-STATUS
001810        SET USERF-OPEN TO TRUE
001811     ELSE
001812        SET USERF-CLOSED TO TRUE.
001813 
001814 OPEN-CNTLF.
001815     Open INPUT Cntlf.
001816     IF C-FOUND OF CNTLF-STATUS
001817        SET CNTLF-OPEN TO TRUE
001818     ELSE
001819        SET CNTLF-CLOSED TO TRUE.
001820  
001821* OPEN-ROLLF.
001822*     Open I-O   ROLLF.
001823*     IF C-FOUND OF ROLLF-STATUS
001824*        SET ROLLF-OPEN TO TRUE
001825*     ELSE
001826*        SET ROLLF-CLOSED TO TRUE.
001827  
001828 OPEN-ITEMF.
001829     Open INPUT   ITEMF.
001830     IF C-FOUND OF ITEMF-STATUS
001831        SET ITEMF-OPEN TO TRUE
001832     ELSE
001833        SET ITEMF-CLOSED TO TRUE.
001834
001835 OPEN-STYLF.
001836     Open INPUT STYLF.
001837     IF C-FOUND OF STYLF-STATUS
001838        SET STYLF-OPEN   TO TRUE
001839     ELSE
001840        SET STYLF-CLOSED TO TRUE.
001841
001842 OPEN-COLRF.
001843     Open INPUT COLRF.
001844     IF C-FOUND OF COLRF-STATUS
001845        SET COLRF-OPEN   TO TRUE
001846     ELSE
001847        SET COLRF-CLOSED TO TRUE.
001848
001849 OPEN-SCATF.
001850     Open INPUT SCATF.
001851     IF C-FOUND OF SCATF-STATUS
001852        SET SCATF-OPEN   TO TRUE
001853     ELSE
001854        SET SCATF-CLOSED TO TRUE.
001855
001856 OPEN-ITMBF.
001857     Open INPUT ITMBF.
001858     IF C-FOUND OF ITMBF-STATUS
001859        SET ITMBF-OPEN   TO TRUE
001860     ELSE
001861        SET ITMBF-CLOSED TO TRUE.
001862
001863 OPEN-ROLLF.
001864     Open INPUT ROLLF.
001865     IF C-FOUND OF ROLLF-STATUS
001866        SET ROLLF-OPEN   TO TRUE
001867     ELSE
001868        SET ROLLF-CLOSED TO TRUE.
001869
001870 OPEN-ITRNF.
001871     Open I-O ITRNF.
001872     IF C-NO-FILE OF ITRNF-STATUS
001873        OPEN OUTPUT ITRNF
001874        CLOSE ITRNF
001875        GO TO OPEN-ITRNF
001876     END-IF.
001877     IF C-FOUND OF ITRNF-STATUS
001878        SET ITRNF-OPEN TO TRUE
001879     ELSE
001880        SET ITRNF-CLOSED TO TRUE.
001881 
001882  
001883 READ-USERF.
001884      Read UserF Key is Userf-Key
001885         Invalid Key Move UserF-STATUS to Userf-STATUS.
001886     Move User-sub-dir  to Profits-Data-Loc. 
001887
001888 READ-CNTLF-NOLOCK.
001889     Read CNTLF NO LOCK
001890         Invalid key Move Cntlf-Status to Cntlf-Status.
001891 IN-OUT-EXIT. EXIT.
001892 
001893      
001894*</SCRIPT>
001895 END PROGRAM     ProcBegin.
001896 IDENTIFICATION  DIVISION.
001897* ProcLoadApparelControls.
001898 PROGRAM-ID.     ProcLoadApparelControls IS COMMON.
001899*<SCRIPT DIVISION="PROCEDURE", NAME="ProcLoadApparelControls">
001900 ENVIRONMENT     DIVISION.
001901 DATA            DIVISION.
001902 WORKING-STORAGE SECTION.
001903 PROCEDURE       DIVISION.
001904 DECLARATIVES.
001905     COPY "SCATF.DS". 
001906     COPY "STYLF.DS". 
001907     GO TO STATUS-EXIT.
001908 STATUS-CHECK.
001909     IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001910        GO TO STATUS-EXIT.
001911
001912 STATUS-DISPLAY.
001913*     SET DBIO OF ERROR-KIND TO TURE.
001914     MOVE "F"       TO ERROR-KIND.
001915     MOVE FILE-NAME TO NAME OF ERROR-DBIO.
001916     MOVE FILE-STATUS TO IOSTATUS OF ERROR-DBIO.
001917     MOVE PROG-NAME   TO ERROR-PROGRNAME.
001918     INVOKE POW-SELF "CallForm" USING "DBIOError" "\PROFITS\ERRORBOX" RETURNING ReturnValue .
001919     INVOKE POW-SELF "CloseForm".
001920 STATUS-EXIT. EXIT.            
001921 END DECLARATIVES.
001922 BEGIN-PROGRAM.
001923     INVOKE ctComboSize "ClearList".
001924     INVOKE ctComboCategory "ClearList".
001925     PERFORM CHECK-STYLE
001926     IF C-FOUND OF STYLF-STATUS
001927        MOVE STYLE-GROUP-NAME TO SCAT-GROUP-NBR
001928        PERFORM LOAD-SCAT.
001929
001930                             
001931 END-PROGRAM.
001932     EXIT PROGRAM.
001933
001934 SUBROUTINE-SECTION.
001935 CHECK-STYLE.
001936     MOVE ITEM-NUMBER(1:8)    TO STYLE-NUMBER.
001937     PERFORM READ-STYLF.
001938     INVOKE ctComboSize "AddItem" USING " " RETURNING ReturnValue.  
001939     INVOKE ctComboCategory "AddItem" USING " " RETURNING ReturnValue.
001940     
001941 LOAD-SCAT.
001942     MOVE SCAT-GROUP-NBR TO WS-SCAT-GROUP-NBR.
001943     READ SCATF KEY IS SCAT-GROUP-NBR
001944          INVALID KEY MOVE SCATF-STATUS TO SCATF-STATUS.          
001945     PERFORM UNTIL 
001946            NOT C-FOUND OF SCATF-STATUS 
001947            OR SCAT-GROUP-NBR NOT = WS-SCAT-GROUP-NBR
001948        EVALUATE TRUE
001949        WHEN SCAT-REC-SIZE
001950           MOVE SCAT-SIZE-NUM TO LOPT-X
001951           INVOKE ctComboSize "AddItem" USING SCAT-SIZE RETURNING ReturnValue  
001952        WHEN SCAT-REC-CATEGORY
001953           MOVE SCAT-CAT-NUM TO LOPT-X
001954           INVOKE ctComboCategory "AddItem" USING SCAT-CAT RETURNING ReturnValue
001955        END-EVALUATE
001956        READ SCATF NEXT
001957             AT END MOVE SCATF-STATUS TO SCATF-STATUS
001958        END-READ 
001959     END-PERFORM.
001960     
001961 SUBROUTINE-EXIT. EXIT.
001962 
001963 IN-OUT SECTION.
001964 READ-STYLF.
001965     READ STYLF KEY IS STYLF-KEY
001966          INVALID KEY
001967              MOVE STYLF-STATUS TO STYLF-STATUS.
001968 IN-OUT-EXIT. EXIT.
001969 
001970     
001971*</SCRIPT>
001972 END PROGRAM     ProcLoadApparelControls.
001973 IDENTIFICATION  DIVISION.
001974* ProcSaveTran.
001975 PROGRAM-ID.     ProcSaveTran IS COMMON.
001976*<SCRIPT DIVISION="PROCEDURE", NAME="ProcSaveTran">
001977 ENVIRONMENT     DIVISION.
001978*****************************************************************
001979* 11MAR21 UPD KWS - AFTER EDIT OF ITEM, LOOSES WHSE-NO          *
001980*****************************************************************
001981 DATA            DIVISION.
001982 WORKING-STORAGE SECTION.
001983     
001984 01  GridInvTrans-Index                       PIC S9(9)  COMP-5  VALUE ZERO.
001985 
001986 PROCEDURE       DIVISION.
001987 DECLARATIVES.
001988     COPY "ITRNF.DS". 
001989     COPY "ITMBF.DS". 
001990     COPY "ROLLF.DS". 
001991     GO TO STATUS-EXIT.
001992 STATUS-CHECK.
001993     IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
001994        GO TO STATUS-EXIT.
001995 
001996 STATUS-DISPLAY.
001997*     SET DBIO OF ERROR-KIND TO TURE.
001998     MOVE "F"       TO ERROR-KIND.
001999     MOVE FILE-NAME TO NAME OF ERROR-DBIO.
002000     MOVE FILE-STATUS TO IOSTATUS OF ERROR-DBIO.
002001     MOVE PROG-NAME   TO ERROR-PROGRNAME.
002002     INVOKE POW-SELF "CallForm" USING "DBIOError" "\PROFITS\ERRORBOX" RETURNING ReturnValue .
002003     INVOKE POW-SELF "CloseForm".
002004 STATUS-EXIT. EXIT.            
002005 END DECLARATIVES.
002006
002007 BEGIN-PROGRAM.
002008       If "Value" OF ctDEditTransDate < 1
002009         SET DATA-FAILED TO TRUE
002010         INVOKE ctDEditTransDate "SetFocus"
002011         MOVE POW-COLOR-RED TO "BACKColor" OF ctDEditTransDate
002012         MOVE "You must have a transaction date" TO "StatusText" OF POW-SELF 
002013      ELSE
002014         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctDEditTransDate.
002015 
002016     PERFORM VALIDATE-DATA.
002017     IF DATA-FAILED
002018        MOVE POW-TRUE TO "Enabled" OF ctPushSave
002019        GO TO END-PROGRAM.
002020        
002021     PERFORM UPDATE-ITRNF-FILE.
002022     COMPUTE NEXT-ITRNF-KEY = ITRNF-KEY + 1.
002023     IF EDIT-YES
002024        PERFORM UPDATE-TRAN-GRID
002025     ELSE
002026        PERFORM WRITE-TRAN-GRID.
002027     INVOKE ctGridInvTrans "ItemCount" RETURNING ReturnValue.
002028*-*-      If ReturnValue < zero 
002029*         MOVE POW-FALSE TO "Enabled" OF ctGridInvTrans
002030*      ELSE
002031*         MOVE POW-TRUE TO "Enabled" OF ctGridInvTrans.
002032     SET NEW-YES TO TRUE.
002033     Call "ProcClearFields".            
002034      
002035     Call "ProcSetPrintButton".
002036          
002037 END-PROGRAM.
002038     EXIT PROGRAM.
002039
002040 SUBROUTINE SECTION.
002041 VALIDATE-DATA.
002042      SET DATA-PASSED TO TRUE.
002043      IF "Text" OF ctComboTranType = "Receipt"
002044         IF ITEM-ROLL-TRACKING-YES
002045            PERFORM VALIDATE-ROLL-RECEIPT-REC
002046         ELSE
002047         IF ITEM-BIN-TRACKING-YES
002048            PERFORM VALIDATE-BIN-RECEIPT-REC
002049         ELSE
002050            PERFORM VALIDATE-RECEIPT-REC
002051      ELSE
002052      IF "Text" OF ctComboTranType = "Adjustment"
002053         IF ITEM-BIN-TRACKING-YES
002054            PERFORM VALIDATE-BIN-ADJUSTMENT-REC
002055         ELSE
002056            PERFORM VALIDATE-ADJUSTMENT-REC
002057      ELSE
002058*10MAR15 BEGIN
002059      IF "Text" OF ctComboTranType = "Purchase"
002060         PERFORM VALIDATE-PURCHASE-REC
002061      ELSE
002062      IF "Text" OF ctComboTranType = "Issue"
002063         PERFORM VALIDATE-ISSUE-REC
002064      ELSE
002065*10MAR15 END
002066*10MAR22 BEGIN
002067      IF "Text" OF ctComboTranType = "F.G. Order"
002068         PERFORM VALIDATE-FGOrder
002069      ELSE
002070      IF "Text" OF ctComboTranType = "F.G. Receipt"
002071         PERFORM VALIDATE-FGReceipt
002072      ELSE
002073*10MAR22 END
002074      IF "Text" OF ctComboTranType = "Bin Transfer"
002075         PERFORM VALIDATE-BIN-TRANSFER-REC
002076      ELSE
002077         SET DATA-FAILED TO TRUE.
002078         
002079 VALIDATE-ROLL-RECEIPT-REC.
002080      If "Value" OF ctNEditTranQty < zero
002081         SET DATA-FAILED TO TRUE
002082         INVOKE ctNEditTranQty "SetFocus"
002083         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002084         MOVE "The quantity must be a positive number!" TO "StatusText" OF POW-SELF 
002085      ELSE
002086         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002087
002088     IF "Text" OF ctMEditRollNo = SPACES
002089         SET DATA-FAILED TO TRUE
002090         INVOKE ctMEditRollNo "SetFocus"
002091         MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditRollNo
002092         MOVE "You must specify a Roll Number for this item type!" TO "StatusText" OF POW-SELF
002093      ELSE
002094         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditRollNo.
002095     
002096     IF "Text" OF ctMEditLotNbr = SPACES
002097         SET DATA-FAILED TO TRUE
002098         INVOKE ctMEditLotNbr "SetFocus"
002099         MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditLotNbr
002100         MOVE "You must specify a Lot Number for this item type!" TO "StatusText" OF POW-SELF
002101      ELSE
002102         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditLotNbr.
002103     
002104     IF "Value" OF ctDEditDateReceived = zero
002105        MOVE "Value" OF ctDEditTransDate TO "Value" OF ctDEditDateReceived.
002106*         SET DATA-FAILED TO TRUE
002107*         INVOKE ctDEditDateReceived "SetFocus"
002108*         MOVE POW-COLOR-RED TO "BACKColor" OF ctDEditDateReceived
002109*         MOVE "You must specify the date this roll was received at your location!" TO "StatusText" OF POW-SELF
002110*      ELSE
002111*         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctDEditDateReceived.
002112     
002113*-- Verify that the Roll/Lot does not already exist--*
002114     IF DATA-PASSED
002115        MOVE ITEM-NUMBER      TO ROLL-ITEM-NO
002116*       MOVE ITEM-WHSE        TO ITMB-WHSE-NO
002117        MOVE "Text" OF ctMEditRollNo TO ROLL-ROLL-NBR
002118        MOVE "Text" OF ctMEditLotNbr TO ROLL-LOT-NBR
002119        PERFORM READ-ROLLF
002120        IF C-FOUND OF ROLLF-STATUS
002121           SET DATA-FAILED TO TRUE
002122           INVOKE ctMEditRollNo "SetFocus"
002123           MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditRollNo
002124           MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditLotNbr
002125           MOVE "Bin location must already exist to do a transfer!"
002126                to "StatusText" OF pow-self
002127        ELSE
002128           MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditRollNo
002129           MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditLotNbr.
002130
002131 VALIDATE-BIN-RECEIPT-REC.
002132      If "Value" OF ctNEditTranQty < zero
002133         SET DATA-FAILED TO TRUE
002134         INVOKE ctNEditTranQty "SetFocus"
002135         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002136         MOVE "The quantity must be a positive number!" TO "StatusText" OF POW-SELF 
002137      ELSE
002138         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002139
002140      If "Text" OF ctMEditBinLocation = SPACES
002141         SET DATA-FAILED TO TRUE
002142         INVOKE ctMEditBinLocation "SetFocus"
002143         MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditBinLocation
002144         MOVE "You must specify where these goods will be stored." TO "StatusText" OF POW-SELF 
002145      ELSE
002146         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditBinLocation.
002147
002148 VALIDATE-RECEIPT-REC.
002149      If "Value" OF ctNEditTranQty < zero
002150         SET DATA-FAILED TO TRUE
002151         INVOKE ctNEditTranQty "SetFocus"
002152         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002153         MOVE "The quantity must be a positive number!" TO "StatusText" OF POW-SELF 
002154      ELSE
002155         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002156      
002157 VALIDATE-ADJUSTMENT-REC.
002158      If "Value" OF ctNEditTranQty = zero
002159         SET DATA-FAILED TO TRUE
002160         INVOKE ctNEditTranQty "SetFocus"
002161         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002162         MOVE "The quantity must be a positive number!" TO "StatusText" OF POW-SELF 
002163      ELSE
002164         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002165      
002166 
002167 VALIDATE-BIN-ADJUSTMENT-REC.
002168      If "Value" OF ctNEditTranQty = zero
002169         SET DATA-FAILED TO TRUE
002170         INVOKE ctNEditTranQty "SetFocus"
002171         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002172         MOVE "The quantity must be a positive number!" TO "StatusText" OF POW-SELF 
002173      ELSE
002174         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002175      
002176      If "Text" OF ctMEditBinLocation = SPACES
002177         SET DATA-FAILED TO TRUE
002178         INVOKE ctMEditBinLocation "SetFocus"
002179         MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditBinLocation
002180         MOVE "You must specify where these goods will be stored." TO "StatusText" OF POW-SELF 
002181      ELSE
002182         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditBinLocation.
002183
002184*-- Verify that the Bin Record to be adjusted is valid --*
002185     MOVE ITEM-NUMBER      TO ITMB-ITEM-NO
002186     MOVE ITEM-WHSE-NO     TO ITMB-WHSE-NO
002187     MOVE "Text" OF ctMEditBinLocation TO ITMB-BIN-LOC
002188     PERFORM READ-ITMBF
002189     IF NOT C-FOUND OF ITMBF-STATUS
002190        SET DATA-FAILED TO TRUE
002191        INVOKE ctMEditBinLocation "SetFocus"
002192        MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditBinLocation
002193        MOVE "Bin location must already exist to do an adjustment, try a Receipt instead."
002194             to "StatusText" OF pow-self
002195     ELSE
002196        MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditBinLocation.
002197      
002198 
002199 VALIDATE-PURCHASE-REC.
002200      If "Value" OF ctNEditTranQty = zero
002201         SET DATA-FAILED TO TRUE
002202         INVOKE ctNEditTranQty "SetFocus"
002203         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002204         MOVE "The quantity must be entered!" TO "StatusText" OF POW-SELF 
002205      ELSE
002206         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002207      
002208 VALIDATE-ISSUE-REC.
002209      If "Value" OF ctNEditTranQty = zero
002210         SET DATA-FAILED TO TRUE
002211         INVOKE ctNEditTranQty "SetFocus"
002212         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002213         MOVE "The quantity must be entered!" TO "StatusText" OF POW-SELF 
002214      ELSE
002215         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002216      
002217         
002218 VALIDATE-BIN-TRANSFER-REC.
002219      If "Text" OF ctMEditBinLocation = SPACES
002220         SET DATA-FAILED TO TRUE
002221         INVOKE ctMEditBinLocation "SetFocus"
002222         MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditBinLocation
002223         MOVE "You must specify the current bin location!" TO "StatusText" OF POW-SELF
002224      ELSE
002225         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditBinLocation
002226         
002227
002228      If "Text" OF ctMEditNewBin = SPACES
002229         SET DATA-FAILED TO TRUE
002230         INVOKE ctMEditNewBin "SetFocus"
002231         MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditNewBin
002232         MOVE "You must specify the NEW bin location!" TO "StatusText" OF POW-SELF
002233      ELSE
002234         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditNewBin.
002235            
002236         
002237      If "Value" OF ctNEditTranQty = zero
002238         SET DATA-FAILED TO TRUE
002239         INVOKE ctNEditTranQty "SetFocus"
002240         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002241         MOVE "You must specify the quantity to transfer to the new bin location!" TO "StatusText" OF POW-SELF
002242      ELSE
002243         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002244         
002245      If "Value" OF ctNEditTranQty < zero
002246         SET DATA-FAILED TO TRUE
002247         INVOKE ctNEditTranQty "SetFocus"
002248         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002249         MOVE "The quantity must be a positive number!" TO "StatusText" OF POW-SELF 
002250      ELSE
002251         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002252
002253*-- Verify that the FROM Bin Record for transfer --*
002254     MOVE ITEM-NUMBER      TO ITMB-ITEM-NO
002255     MOVE ITEM-WHSE-NO     TO ITMB-WHSE-NO
002256     MOVE "Text" OF ctMEditBinLocation TO ITMB-BIN-LOC
002257     PERFORM READ-ITMBF
002258     IF NOT C-FOUND OF ITMBF-STATUS
002259        SET DATA-FAILED TO TRUE
002260        INVOKE ctNEditTranQty "SetFocus"
002261        MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditBinLocation
002262        MOVE "Bin location must already exist to do a transfer!"
002263             to "StatusText" OF pow-self
002264     ELSE
002265        MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditBinLocation.
002266      
002267*-- Verify that the TO Bin Record for transfer --*
002268*     MOVE ITEM-NUMBER      TO ITMB-ITEM-NO
002269*     MOVE ITEM-WHSE-NO     TO ITMB-WHSE-NO
002270*     MOVE "Text" OF ctMEditNewBin TO ITMB-BIN-LOC
002271*     PERFORM READ-ITMBF
002272*     IF NOT C-FOUND OF ITMBF-STATUS
002273*        SET DATA-FAILED TO TRUE
002274*        INVOKE ctNEditTranQty "SetFocus"
002275*        MOVE POW-COLOR-RED TO "BACKColor" OF ctMEditNewBin
002276*        MOVE "Bin location must already exist to do a transfer!"
002277*             to "StatusText" OF pow-self
002278*     ELSE
002279*        MOVE POW-COLOR-WHITE TO "BACKColor" OF ctMEditNewBin.
002280      
002281         
002282 VALIDATE-FGORDER.
002283      If "Value" OF ctNEditTranQty = zero
002284         SET DATA-FAILED TO TRUE
002285         INVOKE ctNEditTranQty "SetFocus"
002286         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002287         MOVE "The quantity must be entered!" TO "StatusText" OF POW-SELF 
002288      ELSE
002289         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002290
002291 VALIDATE-FGRECEIPT.
002292      If "Value" OF ctNEditTranQty = zero
002293         SET DATA-FAILED TO TRUE
002294         INVOKE ctNEditTranQty "SetFocus"
002295         MOVE POW-COLOR-RED TO "BACKColor" OF ctNEditTranQty
002296         MOVE "The quantity must be entered!" TO "StatusText" OF POW-SELF 
002297      ELSE
002298         MOVE POW-COLOR-WHITE TO "BACKColor" OF ctNEditTranQty.
002299
002300
002301 UPDATE-ITRNF-FILE.
002302      IF EDIT-YES
002303         MOVE ITRN-ITEM-NO    TO ITEM-NUMBER           *> 11MAR21
002304         MOVE ITRN-WHSE-NO    TO ITEM-WHSE-NO          *> 11MAR21
002305         PERFORM READ-ITRNF.
002306      MOVE SPACES             TO ITRNF-DATA1.
002307      MOVE ITEM-NUMBER        TO ITRN-ITEM-NO.
002308      MOVE ITEM-WHSE-NO       TO ITRN-WHSE-NO.
002309      
002310*-- 11FEB25
002311*      IF "Text" OF ctComboTranType = "Receipt"
002312*         MOVE 1               TO ITRN-TRAN-CD
002313*      ELSE
002314*      IF "Text" OF ctComboTranType = "Adjustment"
002315*         MOVE 2               TO ITRN-TRAN-CD
002316*      ELSE
002317*      IF "Text" OF ctComboTranType = "Purchase"
002318*         MOVE 3               TO ITRN-TRAN-CD
002319*      ELSE
002320*      IF "Text" OF ctComboTranType = "Issue"
002321*         MOVE 4               TO ITRN-TRAN-CD
002322*      ELSE
002323*10MAR22 BEGIN
002324*      IF "Text" OF ctComboTranType = "F.G. Receipt"
002325*         MOVE 8               TO ITRN-TRAN-CD
002326*      ELSE
002327*      IF "Text" OF ctComboTranType = "F.G. Order"
002328*         MOVE 9               TO ITRN-TRAN-CD
002329*      ELSE
002330*10MAR22 END      
002331*      IF "Text" OF ctComboTranType = "Bin Transfer"
002332*         MOVE 10              TO ITRN-TRAN-CD.
002333      MOVE "ListIndex" OF ctComboTranType TO ITRN-TRAN-CD.
002334      MOVE "Value" OF ctNEditTranQty TO ITRN-QTY.
002335      MOVE "Value" OF ctNEditTranAmt TO ITRN-AMT.
002336      IF ITRN-AMT = ZERO
002337         MOVE ZERO TO ITRN-UNIT-PRICE
002338      ELSE
002339         COMPUTE ITRN-UNIT-PRICE ROUNDED = ITRN-AMT / ITRN-QTY
002340                 ON SIZE ERROR MOVE ZERO TO ITRN-UNIT-PRICE.
002341      MOVE "Text" OF ctMEditRef  TO ITRN-REF.
002342      MOVE "Value" OF ctDEditTransDate TO JULIAN-DAYS.
002343      PERFORM JULIAN-TO-MMDDYYYY THRU JULIAN-TO-MMDDYYYY-EXIT.
002344      MOVE DATE-IN               TO ITRN-DATE.
002345      MOVE "Text" OF ctMEditItemDesc TO ITRN-ITEM-DESC.
002346      MOVE "Text" OF ctMEditVendor   TO ITRN-VEND-NUMBER.
002347      MOVE "Value" OF ctNEditPONbr   TO ITRN-PO-NO.
002348      MOVE "Text" OF ctNEditPOSeqNo  TO ITRN-PO-SEQ.
002349      MOVE 0                         TO ITRN-LABEL-CNT
002350      MOVE "Text" OF ctMEditBinLocation TO ITRN-BIN.
002351      MOVE "Text" OF ctMEditNewBin      TO ITRN-NEW-BIN-LOC.
002352      MOVE SPACES TO ITRN-ITEM-DESC-2, ITRN-ITEM-DESC-3.
002353      MOVE ZERO                      TO ITRN-WEIGHT.
002354      MOVE ZERO                      TO ITRN-LGTH.
002355      MOVE SPACES                    TO ITRN-ALT-BIN.
002356      MOVE "Text" OF ctMEditRollNo   TO ITRN-ROLL-NUMBER.
002357      MOVE "Text" OF ctMEditLotNbr   TO ITRN-ROLL-LOT-NBR.
002358      MOVE "Text" OF ctMEditMillName TO ITRN-ROLL-MILL-NAME.
002359      MOVE ZERO                      TO ITRN-ROLL-WIDTH.
002360      MOVE "Value" OF ctDEditDateReceived TO ITRN-ROLL-RECVD-DATE-J.
002361      MOVE "Value" OF ctDEditDateOrdered  TO ITRN-ROLL-ORDER-DATE-J.
002362      MOVE ITRN-QTY  TO ITRN-ROLL-LGTH-RECVD.
002363      MOVE ZERO    TO ITRN-ROLL-LGTH-USED
002364                      ITRN-ROLL-COST-UOM
002365                      ITRN-ORDER-NO
002366                      ITRN-SUB-ORDER-NO
002367                      ITRN-SEQ-NO
002368                      ITRN-ROLL-TRAN-CD.
002369      
002370     IF EDIT-YES
002371        PERFORM REWRITE-ITRNF
002372     ELSE
002373        MOVE NEXT-ITRNF-KEY  TO ITRNF-KEY
002374        PERFORM WRITE-ITRNF.
002375           
002376 WRITE-TRAN-GRID.
002377     IF WS-PROFITS-APPAREL-YES
002378        MOVE ITEM-NUMBER(1:8) TO WS-GRID-ITEM-NUMBER
002379     ELSE
002380        MOVE ITEM-NUMBER      TO WS-GRID-ITEM-NUMBER.
002381     MOVE ITEM-WHSE-NO     TO WS-GRID-WHSE-NO.
002382     MOVE "Text" OF ctComboColors  TO WS-GRID-COLOR.
002383     MOVE "Text" OF ctComboSize    TO WS-GRID-SIZE.
002384     MOVE "Text" OF ctComboCategory TO WS-GRID-CATEGORY.
002385     MOVE "Text" OF ctComboTranType TO WS-GRID-TRAN-TYPE.
002386     MOVE "Value" OF ctNEditTranQty       TO WS-GRID-TRAN-QTY.
002387     MOVE "Text" OF ctMEditBinLocation    TO WS-GRID-BIN-LOC.
002388     MOVE "Text" OF ctMEditNewBin         TO WS-GRID-NEW-BIN.
002389     MOVE "Text" OF ctMEditRef            TO WS-GRID-REF.
002390     MOVE "Text" OF ctMEditRollNo TO WS-GRID-ROLL-NBR.
002391     MOVE "Text" OF ctMEditLotNbr TO WS-GRID-LOT-NBR.
002392     MOVE ITRNF-KEY                       TO WS-GRID-ITRNF-KEY.
002393         
002394     INVOKE ctGridInvTrans "AddItem" USING WS-GRID-INVTRAN RETURNING GridInvTrans-Index.
002395
002396 UPDATE-TRAN-GRID.
002397     MOVE "Value" OF ctNEditTranQty       TO "CellValue"(EDIT-GRID-INDEX 6) OF ctGridInvTrans.
002398     MOVE "Text" OF ctMEditBinLocation    TO "CellText"(EDIT-GRID-INDEX 7)  OF ctGridInvTrans.
002399     MOVE "Text" OF ctMEditNewBin         TO "CellText"(EDIT-GRID-INDEX 8)  OF ctGridInvTrans.
002400     MOVE "Text" OF ctMEditRef            TO "CellText"(EDIT-GRID-INDEX 9)  OF ctGridInvTrans.
002401     MOVE "Text" OF ctMEditRollNo         TO "CellText"(EDIT-GRID-INDEX 10) OF ctGridInvTrans.
002402     MOVE "Text" OF ctMEditLotNbr         TO "CellText"(EDIT-GRID-INDEX 11) OF ctGridInvTrans.
002403      
002404 SUBROUTINE-EXIT. EXIT.
002405     COPY "JTM2D2Y2.SR".
002406     
002407 IN-OUT SECTION.
002408 READ-ITRNF.
002409     MOVE EDIT-ITRNF-KEY TO ITRNF-KEY.
002410     READ ITRNF KEY IS ITRNF-KEY
002411          INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
002412          
002413 READ-ITMBF.
002414     READ ITMBF KEY IS ITMBF-KEY
002415          INVALID KEY MOVE ITMBF-STATUS TO ITMBF-STATUS.
002416          
002417 READ-ROLLF.
002418     READ ROLLF KEY IS ROLLF-KEY
002419          INVALID KEY MOVE ROLLF-STATUS TO ROLLF-STATUS.
002420          
002421 WRITE-ITRNF.
002422     IF ITRNF-KEY < 1
002423        MOVE 1 TO ITRNF-KEY.
002424     WRITE ITRNF-REC 
002425           INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
002426     IF C-DUP-RECORD OF ITRNF-STATUS
002427        ADD 1 TO ITRNF-KEY
002428        GO TO WRITE-ITRNF.           
002429
002430 REWRITE-ITRNF.
002431     REWRITE ITRNF-REC 
002432           INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
002433 IN-OUT-EXIT. EXIT.
002434 
002435 
002436*</SCRIPT>
002437 END PROGRAM     ProcSaveTran.
002438 IDENTIFICATION  DIVISION.
002439* ProcGetItemRecord.
002440 PROGRAM-ID.     ProcGetItemRecord IS COMMON.
002441*<SCRIPT DIVISION="PROCEDURE", NAME="ProcGetItemRecord">
002442 ENVIRONMENT     DIVISION.
002443 DATA            DIVISION.
002444 WORKING-STORAGE SECTION.
002445 PROCEDURE       DIVISION.
002446 BEGIN-PROGRAM.
002447     MOVE "Text" OF ctMEditItemNo TO ITEM-NUMBER.
002448     MOVE "Text" OF ctMEditItemWhseNo TO ITEM-WHSE-NO.
002449
002450*-- 11FEB22 - Removed lines below, not sure why the were needed --*
002451*-- 12MAR16 - PUT BACK FOR LIBERTY 
002452     IF WS-PROFITS-APPAREL-YES
002453        MOVE "0  0"  TO ITEM-NUMBER(9:4). 
002454     PERFORM READ-ITEMF.
002455     If C-FOUND OF ITEMF-STATUS
002456        Call "ProcDisableSection1"
002457        MOVE POW-TRUE        TO "Enabled"   OF ctComboTranType
002458        MOVE POW-COLOR-WHITE TO "BackColor" OF ctComboTranType
002459        INVOKE ctGridInvTrans "SetFocus"
002460        INVOKE ctComboTranType "SetFocus"
002461        GO TO END-PROGRAM.
002462     
002463        
002464     IF C-NOT-FOUND OF ITEMF-STATUS
002465        Call "ProcLoadApparelFields".
002466     
002467        
002468 END-PROGRAM.
002469     EXIT PROGRAM.
002470     
002471 SUBROUTINE SECTION.
002472 READ-ITEMF.
002473     Call "ProcReadItemF".
002474     
002475 SUBROUTINE-EXIT. EXIT.     
002476         
002477*</SCRIPT>
002478 END PROGRAM     ProcGetItemRecord.
002479 IDENTIFICATION  DIVISION.
002480* ProcStringApparelItemNbr.
002481 PROGRAM-ID.     ProcStringApparelItemNbr IS COMMON.
002482*<SCRIPT DIVISION="PROCEDURE", NAME="ProcStringApparelItemNbr">
002483 ENVIRONMENT     DIVISION.
002484 DATA            DIVISION.
002485 WORKING-STORAGE SECTION.
002486 01  Color-Index                  PIC s9(9) comp-5 value zero.
002487 01  Ws-Color-String              pic x(20) value spaces.
002488 01  Ws-Color-Name                Pic x(11) value spaces.
002489 01  Ws-Color-Code                PIC X(02) Value spaces.
002490 
002491* 01  SIZE-Index                   PIC s9(9) comp-5 value zero.
002492 01  Ws-SIZE                      PIC X(05) Value spaces.
002493 
002494* 01  CAT-Index                    PIC S9(9) comp-5 value zero.
002495 01  Ws-CAT                       PIC X(09) Value spaces.
002496 
002497* 01  LOPT-EXCH.
002498*     05 FILLER PIC X VALUE LOW-VALUE.
002499*     05 LOPT-X PIC X.
002500*        88 NON-APPAREL-SC VALUES "0", " ".
002501* 01  LOPT-BIN REDEFINES LOPT-EXCH PIC 9(4) BINARY.
002502 
002503 PROCEDURE       DIVISION.
002504 BEGIN-PROGRAM.
002505     MOVE SPACES TO ITEMF-KEY.
002506     
002507     MOVE "Text" OF ctMEditItemNo TO ITEM-NUMBER.
002508     MOVE "Text" OF ctMEditItemWhseNo TO ITEM-WHSE-NO.
002509     
002510     MOVE "ListIndex" OF ctComboColors TO Color-Index.
002511     move "ListText"(Color-Index) OF ctComboColors to Ws-Color-String.
002512     UNSTRING WS-COLOR-String DELIMITED BY "~"
002513              INTO WS-Color-Name, ITEM-COLOR.
002514
002515     MOVE SPACES TO SCAT-NAME-DATA.
002516     MOVE WS-SCAT-GROUP-NBR TO SCAT-GROUP-NBR.
002517     MOVE "Text" OF ctComboSize TO SCAT-SIZE.
002518     SET SCAT-REC-SIZE TO TRUE.
002519     PERFORM READ-SCAT-GN.
002520     MOVE SCAT-SIZE-NUM       TO ITEM-SIZE.
002521     
002522     MOVE SPACES TO SCAT-NAME-DATA.
002523     MOVE WS-SCAT-GROUP-NBR TO SCAT-GROUP-NBR.
002524     MOVE "Text" OF ctComboCategory TO SCAT-CAT.
002525     SET SCAT-REC-CATEGORY TO TRUE.
002526     PERFORM READ-SCAT-GN.
002527     MOVE SCAT-CAT-NUM    TO ITEM-CATEGORY.
002528     
002529     
002530     CALL "ProcReadItemF".
002531     If C-FOUND OF ITEMF-STATUS
002532        Call "ProcDisableSection1"
002533        MOVE POW-TRUE        TO "Enabled"   OF ctComboTranType
002534        MOVE POW-COLOR-WHITE TO "BackColor" OF ctComboTranType
002535        INVOKE ctGridInvTrans "SetFocus"
002536        INVOKE ctComboTranType "SetFocus"
002537        GO TO END-PROGRAM.
002538*DEBUG 
002539     IF NOT C-FOUND OF ITEMF-STATUS
002540       MOVE ITEMF-KEY TO "StatusText" OF POW-SELF.        
002541       
002542 END-PROGRAM.
002543     EXIT PROGRAM.
002544
002545 SUBROUTINE SECTION.
002546 SUBROUTINE-EXIT. EXIT.
002547 
002548     COPY "APPARELD.SR".
002549*</SCRIPT>
002550 END PROGRAM     ProcStringApparelItemNbr.
002551 IDENTIFICATION  DIVISION.
002552* ProcSetApparelControls.
002553 PROGRAM-ID.     ProcSetApparelControls IS COMMON.
002554*<SCRIPT DIVISION="PROCEDURE", NAME="ProcSetApparelControls">
002555 ENVIRONMENT     DIVISION.
002556 DATA            DIVISION.
002557 WORKING-STORAGE SECTION.
002558 01  ws-i                         pic s9(9) comp-5.
002559 01  ws-CNT                       pic s9(9) comp-5.
002560 01  COLOR-CNT                    PIC S9(9) COMP-5 VALUE ZERO.
002561 01  Color-Index                  PIC s9(9) comp-5 value zero.
002562 01  Ws-Color-String              pic x(20) value spaces.
002563 01  Ws-Color-Name                Pic x(11) value spaces.
002564 01  Ws-Color-Code                PIC X(02) Value spaces.
002565 PROCEDURE       DIVISION.
002566 BEGIN-PROGRAM.
002567     MOVE SPACES TO WS-COLOR-STRING, WS-COLOR-NAME, WS-COLOR-CODE.
002568     INVOKE ctComboColors "ListCount" RETURNING COLOR-CNT.
002569     PERFORM FIND-COLOR VARYING COLOR-INDEX FROM 0 BY 1 
002570             UNTIL COLOR-INDEX >= COLOR-CNT OR
002571                   ITEM-COLOR = WS-COLOR-CODE.
002572     ADD -1 TO COLOR-INDEX.
002573     MOVE COLOR-INDEX   TO "ListIndex" OF ctComboColors.
002574     MOVE COLOR-INDEX   TO WS-HOLD-COLOR-INDEX.
002575
002576     MOVE WS-SCAT-GROUP-NBR TO SCAT-GROUP-NBR.
002577     MOVE ITEM-SIZE TO SCAT-SIZE-NUM.
002578     PERFORM READ-SCAT-GS.
002579     INVOKE ctComboSize "ListCount" RETURNING WS-CNT.
002580     PERFORM VARYING WS-I FROM 0 BY 1 UNTIL WS-I >= WS-CNT
002581        IF "ListText"(WS-I) OF ctComboSize = SCAT-SIZE
002582           MOVE WS-I TO "ListIndex" OF ctComboSize
002583           MOVE WS-I TO WS-HOLD-SIZE-INDEX
002584        END-IF
002585     END-PERFORM.
002586     MOVE WS-SCAT-GROUP-NBR TO SCAT-GROUP-NBR.
002587     MOVE ITEM-CATEGORY TO SCAT-CAT-NUM.
002588     PERFORM READ-SCAT-GC.
002589     INVOKE ctComboCategory "ListCount" RETURNING WS-CNT.
002590     PERFORM VARYING WS-I FROM 0 BY 1 UNTIL WS-I >= WS-CNT
002591        IF "ListText"(WS-I) OF ctComboCategory = SCAT-CAT
002592           MOVE WS-I TO "ListIndex" OF ctComboCategory
002593           MOVE WS-I TO WS-HOLD-CATEGORY-INDEX
002594        END-IF
002595     END-PERFORM.
002596 END-PROGRAM.
002597     EXIT PROGRAM.
002598     
002599 FIND-COLOR.
002600     MOVE "ListText"(COLOR-INDEX) OF ctComboColors TO WS-COLOR-STRING.
002601     UNSTRING WS-COLOR-STRING DELIMITED BY "~"
002602              INTO WS-COLOR-NAME, WS-COLOR-CODE.
002603
002604          COPY "APPARELD.SR".
002605      
002606*</SCRIPT>
002607 END PROGRAM     ProcSetApparelControls.
002608 IDENTIFICATION  DIVISION.
002609* FormInvTrans-PreKeyUp.
002610 PROGRAM-ID.     POW-SCRIPTLET1.
002611*<SCRIPT DIVISION="PROCEDURE", CONTROL="FormInvTrans", EVENT="PreKeyUp", POW-NAME="SCRIPTLET1", TYPE="FORM">
002612 ENVIRONMENT     DIVISION.
002613 DATA            DIVISION.
002614 WORKING-STORAGE SECTION.
002615 
002616 LINKAGE         SECTION.
002617 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
002618 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
002619 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
002620*     IF POW-ARG-KEYCODE = POW-KEY-ESCAPE
002621*        INVOKE POW-SELF "CloseForm" RETURNING ReturnValue.  
002622*     MOVE SPACES TO "StatusText" OF POW-SELF.
002623
002624     IF "Enabled" OF ctPushSave = POW-TRUE
002625        if (pow-arg-keycode = POW-KEY-S AND POW-ARG-SHIFT = pow-shiftstate-ctrl) OR
002626           (POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL)
002627           CALL "ProcSaveTran"
002628           INVOKE ctMEditItemNo "SetFocus".
002629     
002630*     if pow-arg-keycode = POW-KEY-D AND POW-ARG-SHIFT = pow-shiftstate-ctrl
002631*        MOVE POW-FALSE TO "Enabled" OF ctPushSave
002632*        CALL "ProcSaveTran"
002633*        INVOKE ctMEditItemNo "SetFocus".
002634*</SCRIPT>
002635 END PROGRAM     POW-SCRIPTLET1.
002636 IDENTIFICATION  DIVISION.
002637* FormInvTrans-PreKeyDown.
002638 PROGRAM-ID.     POW-SCRIPTLET2.
002639*<SCRIPT DIVISION="PROCEDURE", CONTROL="FormInvTrans", EVENT="PreKeyDown", POW-NAME="SCRIPTLET2", TYPE="FORM">
002640 ENVIRONMENT     DIVISION.
002641 DATA            DIVISION.
002642 WORKING-STORAGE SECTION.
002643 LINKAGE         SECTION.
002644 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
002645 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
002646 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
002647
002648      
002649*</SCRIPT>
002650 END PROGRAM     POW-SCRIPTLET2.
002651 IDENTIFICATION  DIVISION.
002652* FormInvTrans-Opened.
002653 PROGRAM-ID.     POW-SCRIPTLET3.
002654*<SCRIPT DIVISION="PROCEDURE", CONTROL="FormInvTrans", EVENT="Opened", POW-NAME="SCRIPTLET3", TYPE="FORM">
002655 ENVIRONMENT     DIVISION.
002656 DATA            DIVISION.
002657 WORKING-STORAGE SECTION.
002658 PROCEDURE       DIVISION.
002659* DECLARATIVES.
002660*     GO TO STATUS-EXIT.
002661* STATUS-CHECK.
002662*     IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
002663*        GO TO STATUS-EXIT.
002664 
002665* STATUS-DISPLAY.
002666*     MOVE "F"       TO ERROR-KIND.
002667*     MOVE FILE-NAME TO NAME OF ERROR-DBIO.
002668*     MOVE FILE-STATUS TO IOSTATUS OF ERROR-DBIO.
002669*     MOVE PROG-NAME   TO ERROR-PROGRNAME.
002670*     INVOKE POW-SELF "CallForm" USING "DBIOError" "\PROFITS\ERRORBOX" RETURNING ReturnValue .
002671*     INVOKE POW-SELF "CloseForm".
002672* STATUS-EXIT. EXIT.            
002673* END DECLARATIVES.
002674 
002675 Begin-Program.
002676     Call "ProcInitializeVariables".
002677     Call "ProcInitControls".
002678     Call "ProcBegin".
002679     
002680 End-Program.
002681     Exit Program.
002682    
002683 Subroutine Section.
002684 
002685 Subroutine-Exit. Exit.
002686 
002687 In-Out Section.
002688 In-Out-Exit. Exit.
002689     
002690*</SCRIPT>
002691 END PROGRAM     POW-SCRIPTLET3.
002692 IDENTIFICATION  DIVISION.
002693* FormInvTrans-Closed.
002694 PROGRAM-ID.     POW-SCRIPTLET4.
002695*<SCRIPT DIVISION="PROCEDURE", CONTROL="FormInvTrans", EVENT="Closed", POW-NAME="SCRIPTLET4", TYPE="FORM">
002696 ENVIRONMENT     DIVISION.
002697 DATA            DIVISION.
002698 WORKING-STORAGE SECTION.
002699 PROCEDURE       DIVISION.
002700     CANCEL "I0015".
002701     CANCEL "I0010".
002702     CALL "ProcCloseFiles".
002703     
002704*</SCRIPT>
002705 END PROGRAM     POW-SCRIPTLET4.
002706 IDENTIFICATION  DIVISION.
002707* ctPushItemSearch-Click.
002708 PROGRAM-ID.     POW-SCRIPTLET5.
002709*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctPushItemSearch", EVENT="Click", POW-NAME="SCRIPTLET5", TYPE="ETC">
002710 ENVIRONMENT     DIVISION.
002711 DATA            DIVISION.
002712 WORKING-STORAGE SECTION.
002713 01  Color-Index                  PIC s9(9) comp-5 value zero.
002714 01  ws-i                         pic s9(9) comp-5.
002715 01  ws-CNT                       pic s9(9) comp-5.
002716 01  Ws-Color-String              pic x(20) value spaces.
002717 01  Ws-Color-Name                Pic x(11) value spaces.
002718 01  Ws-Color-Code                PIC X(02) Value spaces.
002719 01  COLOR-CNT                    PIC S9(9) COMP-5 VALUE ZERO.
002720 
002721* 01  SIZE-Index                   PIC s9(9) comp-5 value zero.
002722 01  Ws-SIZE                      PIC X(05) Value spaces.
002723 
002724* 01  CAT-Index                    PIC s9(9) comp-5 value zero.
002725 01  Ws-CAT                       PIC X(09) Value spaces.
002726* 01  LOPT-EXCH.
002727*     05 FILLER PIC X VALUE LOW-VALUE.
002728*     05 LOPT-X PIC X.
002729*        88 NON-APPAREL-SC VALUES "0", " ".
002730* 01  LOPT-BIN REDEFINES LOPT-EXCH PIC 9(4) BINARY.
002731 PROCEDURE       DIVISION.
002732 BEGIN-PROGRAM.
002733     SET MODE_M0205 TO TRUE.
002734     IF PROFITS-APPAREL-YES
002735        move "Text" OF ctMEditItemNo TO ITEM-STYLE
002736        PERFORM STRING-APPAREL-NBR
002737        MOVE ITEM-NUMBER             TO ESSI-FIND-NO
002738     ELSE
002739        MOVE "Text" OF ctMEditItemNo TO ESSI-FIND-NO.
002740     CLOSE ITEMF.
002741     SET ITEMF-CLOSED TO TRUE.
002742     CLOSE USERF.
002743     SET USERF-CLOSED TO TRUE.
002744     CLOSE CNTLF.
002745     SET CNTLF-CLOSED TO TRUE.
002746     INVOKE pow-self "CallForm" USING "FormM0205List" "M0205" RETURNING ReturnValue.
002747     IF PROFITS-APPAREL-YES
002748        PERFORM UNSTRING-APPAREL-NBR
002749        MOVE WS-PASS-ITEM-NUMBER(1:8) TO "Text" OF ctMEditItemNo
002750     ELSE
002751        MOVE WS-PASS-ITEM-NUMBER TO "Text" OF ctMEditItemNo.
002752     MOVE WS-PASS-ITEM-WHSE   TO "Text" OF ctMEditItemWhseNo.
002753     OPEN INPUT ITEMF.
002754     SET ITEMF-OPEN TO TRUE.
002755     OPEN I-O   USERF.
002756     SET USERF-OPEN TO TRUE.
002757     OPEN I-O   CNTLF.
002758     SET CNTLF-OPEN TO TRUE.
002759     IF PROFITS-APPAREL-YES
002760        INVOKE ctComboColors "SetFocus"
002761     ELSE
002762        INVOKE ctMEditItemNo "SetFocus".
002763     
002764 END-PROGRAM.
002765     EXIT PROGRAM.
002766     
002767 SUBROUTINE SECTION.
002768 STRING-APPAREL-NBR.
002769     MOVE "ListIndex" OF ctComboColors TO Color-Index.
002770     move "ListText"(Color-Index) OF ctComboColors to Ws-Color-String.
002771     UNSTRING WS-COLOR-String DELIMITED BY "~"
002772              INTO WS-Color-Name, ITEM-COLOR.
002773
002774     MOVE SPACES TO SCAT-NAME-DATA.
002775     MOVE WS-SCAT-GROUP-NBR TO SCAT-GROUP-NBR.
002776     MOVE "Text" OF ctComboSize TO SCAT-SIZE.
002777     SET SCAT-REC-SIZE TO TRUE.
002778     PERFORM READ-SCAT-GN.
002779     MOVE SCAT-SIZE-NUM       TO ITEM-SIZE.
002780
002781     MOVE SPACES TO SCAT-NAME-DATA.
002782     MOVE WS-SCAT-GROUP-NBR TO SCAT-GROUP-NBR.
002783     MOVE "Text" OF ctComboCategory TO SCAT-CAT.
002784     SET SCAT-REC-CATEGORY TO TRUE.
002785     PERFORM READ-SCAT-GN.
002786     MOVE SCAT-CAT-NUM    TO ITEM-CATEGORY.
002787 
002788 UNSTRING-APPAREL-NBR.
002789     MOVE WS-PASS-ITEM-NUMBER TO ITEM-NUMBER.
002790     Call "ProcLoadApparelFields".
002791     Call "ProcSetApparelControls".
002792                 
002793 SUBROUTINE-EXIT. EXIT.
002794      
002795          COPY "APPARELD.SR".
002796          
002797*</SCRIPT>
002798 END PROGRAM     POW-SCRIPTLET5.
002799 IDENTIFICATION  DIVISION.
002800* ctGridInvTrans-DblClick.
002801 PROGRAM-ID.     POW-SCRIPTLET6.
002802*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctGridInvTrans", EVENT="DblClick", POW-NAME="SCRIPTLET6", TYPE="ETC">
002803 ENVIRONMENT     DIVISION.
002804 DATA            DIVISION.
002805 WORKING-STORAGE SECTION.
002806 01  GRID-INDEX                 PIC S9(9) COMP-5  VALUE ZERO.
002807* 01  Color-Index                  PIC s9(9) comp-5 value zero.
002808* 01  Ws-Color-String              pic x(20) value spaces.
002809* 01  Ws-Color-Name                Pic x(11) value spaces.
002810* 01  Ws-Color-Code                PIC X(02) Value spaces.
002811* 01  COLOR-CNT                    PIC S9(9) COMP-5 VALUE ZERO.
002812* 01  ws-i                         pic s9(9) comp-5.
002813* 01  ws-CNT                       pic s9(9) comp-5.
002814 
002815 PROCEDURE       DIVISION.
002816 BEGIN-PROGRAM.
002817     MOVE "Selected" OF ctGridInvTrans TO Grid-Index.
002818     MOVE "CellValue"(Grid-Index 12) OF ctGridInvTrans  TO ITRNF-KEY.
002819     IF ITRNF-KEY = ZERO
002820        Call "ProcClearFields"
002821        GO TO END-PROGRAM.
002822     PERFORM READ-ITRNF.
002823     IF NOT C-FOUND OF ITRNF-STATUS
002824        MOVE "Transaction not found in Inventory Transaction File!"  TO "StatusText" OF POW-SELF
002825     ELSE
002826        MOVE SPACES TO "StatusText" OF POW-SELF.
002827
002828     Call "ProcClearFields".
002829     Call "ProcDisableSection1".
002830     PERFORM LOAD-FIELDS.
002831     SET EDIT-YES TO TRUE.   
002832     MOVE ITRN-TRAN-CD TO "ListIndex" OF ctComboTranType.
002833     Call "ProcEnableSection2".
002834     MOVE ITRNF-KEY   TO EDIT-ITRNF-KEY.
002835     MOVE GRID-INDEX  TO EDIT-GRID-INDEX.
002836*- NOT SURE WHY BUT DROPDOWNS NOT SHOWING SELECTIONS --*
002837     MOVE WS-HOLD-COLOR-INDEX    TO "ListIndex" OF ctComboColors.
002838     MOVE WS-HOLD-SIZE-INDEX     TO "ListIndex" OF ctComboSize.
002839     MOVE WS-HOLD-CATEGORY-INDEX TO "ListIndex" OF ctComboCategory.
002840     
002841 END-PROGRAM.
002842     EXIT PROGRAM.
002843
002844 SUBROUTINE SECTION.
002845 LOAD-FIELDS.
002846     IF WS-PROFITS-APPAREL-YES
002847        PERFORM LOAD-APPAREL-FIELDS
002848     ELSE
002849        MOVE ITRN-ITEM-NO      TO  "Text" OF ctMEditItemNo.
002850     MOVE ITRN-WHSE-NO         TO "Text" OF ctMEditItemWhseNo.
002851*-- 11feb25 - Reseq tran codes to match itrn-tran-cd numbers --*
002852*     IF ITRN-TRAN-CD = 1
002853*        MOVE 1 TO "ListIndex" OF ctComboTranType
002854*     ELSE
002855*     IF ITRN-TRAN-CD = 2
002856*        MOVE 2 TO "ListIndex" OF ctComboTranType
002857*     ELSE
002858*     IF ITRN-TRAN-CD = 3
002859*        MOVE 3 TO "ListIndex" OF ctComboTranType
002860*     ELSE
002861*     IF ITRN-TRAN-CD = 4
002862*        MOVE 4 TO "ListIndex" OF ctComboTranType
002863*     ELSE
002864*     IF ITRN-TRAN-CD = 6
002865*        MOVE 6 TO "ListIndex" OF ctComboTranType
002866*     ELSE
002867*     IF ITRN-TRAN-CD = 7
002868*        MOVE 7 TO "ListIndex" OF ctComboTranType
002869*     ELSE
002870*     IF ITRN-TRAN-CD = 10
002871*        MOVE 5 TO "ListIndex" OF ctComboTranType.
002872     MOVE ITRN-TRAN-CD TO "ListIndex" OF ctComboTranType.
002873
002874     MOVE ITRN-BIN             TO "Text" OF ctMEditBinLocation.
002875     MOVE ITRN-NEW-BIN-LOC     TO "Text" OF ctMEditNewBin.
002876     MOVE ITRN-QTY             TO "Value" OF ctNEditTranQty.
002877     MOVE ITRN-AMT             TO "Value" OF ctNEditTranAmt.
002878     MOVE ITRN-REF             TO "Text" OF ctMEditRef.
002879     MOVE ITRN-DATE  TO DATE-IN.
002880     Call "ProcCTJulianDate".
002881     MOVE JULIAN-DAYS          TO "Value" OF ctDEditTransDate.
002882     MOVE ITRN-ITEM-DESC       TO "Text" OF ctMEditItemDesc.
002883     MOVE ITRN-VEND-NUMBER     TO "Text" OF ctMEditVendor.
002884     MOVE ITRN-PO-NO           TO "Value" OF ctNEditPONbr.
002885     MOVE ITRN-PO-SEQ          TO "Value" OF ctNEditPOSeqNo.
002886     MOVE ITRN-ROLL-NUMBER     TO "Text" OF ctMEditRollNo.
002887     MOVE ITRN-ROLL-LOT-NBR    TO "Text" OF ctMEditLotNbr.
002888     MOVE ITRN-ROLL-RECVD-DATE-J  TO "Value" OF ctDEditDateReceived.
002889     MOVE ITRN-ROLL-ORDER-DATE-J  TO "Value" OF ctDEditDateOrdered.
002890     INVOKE POW-SELF "Refresh".
002891        
002892 LOAD-APPAREL-FIELDS.
002893     MOVE ITRN-ITEM-NO(1:8) TO  "Text" OF ctMEditItemNo
002894     MOVE ITRN-ITEM-NO      TO ITEM-NUMBER, STYLE-NUMBER.
002895*- 11FEB25 @ 7:17     Call "ProcLoadApparelFields".
002896     Call "ProcLoadApparelControls".
002897     Call "ProcSetApparelControls".
002898
002899                  
002900 SUBROUTINE-EXIT. EXIT.
002901
002902          COPY "APPARELD.SR".
002903
002904 IN-OUT SECTION.
002905 READ-ITRNF.
002906     READ ITRNF KEY IS ITRNF-KEY
002907          INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
002908          
002909          
002910 IN-OUT-EXIT. EXIT.
002911 
002912 
002913     
002914*</SCRIPT>
002915 END PROGRAM     POW-SCRIPTLET6.
002916 IDENTIFICATION  DIVISION.
002917* ctPushDelete-Click.
002918 PROGRAM-ID.     POW-SCRIPTLET7.
002919*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctPushDelete", EVENT="Click", POW-NAME="SCRIPTLET7", TYPE="ETC">
002920 ENVIRONMENT     DIVISION.
002921 DATA            DIVISION.
002922 WORKING-STORAGE SECTION.
002923 PROCEDURE       DIVISION.
002924 DECLARATIVES.
002925    COPY "ITRNF.DS".
002926 STATUS-CHECK.
002927           IF FILE-STATUS = RECORD-LOCK OR DUPLICATE-RECORD
002928              GO TO STATUS-EXIT.
002929
002930           SET DBIO OF ERROR-KIND TO TRUE.
002931           MOVE FILE-NAME         TO ERROR-DBIO.
002932           MOVE FILE-STATUS       TO IOSTATUS OF ERROR-DBIO.
002933           MOVE PROG-NAME         TO ERROR-PROGRNAME.
002934           INVOKE POW-SELF "CallForm" USING "DBIOERROR" "ERRORBOX"
002935                 RETURNING ReturnValue.
002936           INVOKE POW-SELF "CloseForm" USING "FormMaint"
002937                 RETURNING ReturnValue.
002938           EXIT PROGRAM.
002939           
002940 STATUS-EXIT. EXIT.       
002941 END DECLARATIVES. 
002942 BEGIN-PROGRAMS.
002943     MOVE POW-FALSE TO "Enabled" OF ctPushDelete.
002944     MOVE SPACES TO "StatusText" OF POW-SELF.
002945     IF EDIT-ITRNF-KEY NOT > ZERO
002946        MOVE "ITRNF-Record could not be found" TO "StatusText" OF POW-SELF
002947        GO TO END-PROGRAM.
002948
002949     IF EDIT-GRID-INDEX < ZERO
002950        MOVE "Grid Record could not be found" TO "StatusText" OF POW-SELF
002951        GO TO END-PROGRAM.
002952
002953     PERFORM READ-ITRNF.
002954     IF NOT C-FOUND OF ITRNF-STATUS
002955        MOVE "Read of ITRNF-Record failed, record not deleted!" TO "StatusText" OF POW-SELF
002956        GO TO END-PROGRAM.
002957     PERFORM DELETE-ITRNF.
002958     IF NOT C-FOUND OF ITRNF-STATUS
002959        MOVE "Delete of ITRNF-Record failed, record not deleted!" TO "StatusText" OF POW-SELF
002960        GO TO END-PROGRAM.
002961        
002962     INVOKE ctGridInvTrans "RemoveItem" USING EDIT-GRID-INDEX RETURNING ReturnValue.
002963     Call "ProcClearFields".
002964     
002965 END-PROGRAM.
002966     EXIT PROGRAM.
002967
002968 SUBROUTINE SECTION.
002969 SUBROUTINE-EXIT. EXIT.
002970
002971 IN-OUT SECTION.
002972 READ-ITRNF.
002973     MOVE EDIT-ITRNF-KEY  TO ITRNF-KEY.
002974     READ ITRNF KEY IS ITRNF-KEY
002975          INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
002976 
002977 DELETE-ITRNF.
002978     DELETE ITRNF 
002979            INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
002980                     
002981 IN-OUT-EXIT. EXIT.
002982           
002983*</SCRIPT>
002984 END PROGRAM     POW-SCRIPTLET7.
002985 IDENTIFICATION  DIVISION.
002986* ctPushClose-Click.
002987 PROGRAM-ID.     POW-SCRIPTLET8.
002988*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctPushClose", EVENT="Click", POW-NAME="SCRIPTLET8", TYPE="ETC">
002989 ENVIRONMENT     DIVISION.
002990 DATA            DIVISION.
002991 WORKING-STORAGE SECTION.
002992 PROCEDURE       DIVISION.
002993     Call "ProcCloseFiles".
002994     INVOKE pow-self "CloseForm" RETURNING ReturnValue.
002995     
002996*</SCRIPT>
002997 END PROGRAM     POW-SCRIPTLET8.
002998 IDENTIFICATION  DIVISION.
002999* ctPushPrintEdit-Click.
003000 PROGRAM-ID.     POW-SCRIPTLET9.
003001*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctPushPrintEdit", EVENT="Click", POW-NAME="SCRIPTLET9", TYPE="ETC">
003002 ENVIRONMENT     DIVISION.
003003 DATA            DIVISION.
003004*****************************************************************************
003005* FIX KWS 11APR08 - ITEM FILE BEING LEFT OPEN SOMETIMES. MAYBE THIS WILL FIX*
003006*****************************************************************************
003007 WORKING-STORAGE SECTION.
003008     COPY "MSGBOX.DTA".
003009
003010 PROCEDURE       DIVISION.
003011 DECLARATIVES.
003012     COPY "USERF.DS".
003013     GO TO STATUS-EXIT.
003014     COPY "ERROR.DS".
003015 STATUS-EXIT. EXIT.
003016 END DECLARATIVES.
003017
003018 BEGIN-PROGRAM.
003019     Move Pow-False to "Enabled" OF ctPushPrintEdit
003020                       "Enabled" OF ctPushClose
003021                       "Enabled" OF ctPushDelete
003022                       "Enabled" OF ctPushSave
003023                       .
003024                       
003025     MOVE 2 TO USER-PTR-CHN.
003026     PERFORM REWRITE-USERF.                       
003027*     CLOSE USERF.                  *> 11APR08
003028*     SET USERF-CLOSED TO TRUE.     *> 11APR08
003029     CALL "ProcCloseFiles".     
003030     INVOKE POW-SELF "ShowForm" USING POW-SWHIDE.
003031     IF user-sn = 00196
003032        Call "I0015"
003033        CANCEL "I0015"
003034     else
003035        Call "I0010"
003036        Cancel "I0010".
003037     
003038     Move Pow-DMRnO  to ReturnValue
003039*     CALL "ProcCloseFiles".      *> 11apr08 
003040     INVOKE pow-self "CloseForm" RETURNING ReturnValue.
003041     
003042 END-PROGRAM.
003043     EXIT PROGRAM.
003044     
003045 REWRITE-USERF.
003046     REWRITE USERF-REC
003047         INVALID KEY MOVE USERF-STATUS TO USERF-STATUS.
003048                     
003049     
003050*</SCRIPT>
003051 END PROGRAM     POW-SCRIPTLET9.
003052 IDENTIFICATION  DIVISION.
003053* ctMEditItemNo-KeyUp.
003054 PROGRAM-ID.     POW-SCRIPTLET10.
003055*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditItemNo", EVENT="KeyUp", POW-NAME="SCRIPTLET10", TYPE="ETC">
003056 ENVIRONMENT     DIVISION.
003057* KWS UPD 11APR22 - REPLACE KEYDOWN WITH KEYUP TO PREVENT NOT STOPPING AT NEXT FIELD *
003058**************************************************************************************
003059 DATA            DIVISION.
003060 WORKING-STORAGE SECTION.
003061 LINKAGE         SECTION.
003062 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003063 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003064 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003065      IF POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL
003066         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003067            Call "ProcGetItemRecord".
003068            
003069      IF POW-ARG-SHIFT = ZERO
003070         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003071            MOVE SPACES TO "StatusText" OF POW-SELF
003072            IF WS-MULTI-WHSE-YES
003073               INVOKE ctMEditItemWhseNo "SetFocus"
003074            ELSE
003075               Call "ProcGetItemRecord".
003076       
003077*</SCRIPT>
003078 END PROGRAM     POW-SCRIPTLET10.
003079 IDENTIFICATION  DIVISION.
003080* ctNEditTranQty-LostFocus.
003081 PROGRAM-ID.     POW-SCRIPTLET11.
003082*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctNEditTranQty", EVENT="LostFocus", POW-NAME="SCRIPTLET11", TYPE="ETC">
003083 ENVIRONMENT     DIVISION.
003084 DATA            DIVISION.
003085 WORKING-STORAGE SECTION.
003086 PROCEDURE       DIVISION.
003087     If "Text" OF ctComboTranType = "Receipt"
003088        If "Value" OF ctNEditTranQty < zero
003089           MOVE "Receipt Qtys cannot be negative! " TO "StatusText" OF POW-SELF
003090           INVOKE ctNEditTranQty "SetFocus".
003091*</SCRIPT>
003092 END PROGRAM     POW-SCRIPTLET11.
003093 IDENTIFICATION  DIVISION.
003094* ctComboCategory-KeyUp.
003095 PROGRAM-ID.     POW-SCRIPTLET12.
003096*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctComboCategory", EVENT="KeyUp", POW-NAME="SCRIPTLET12", TYPE="ETC">
003097 ENVIRONMENT     DIVISION.
003098 DATA            DIVISION.
003099 WORKING-STORAGE SECTION.
003100 LINKAGE         SECTION.
003101 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003102 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003103 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003104      IF POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL
003105         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003106            Call "ProcStringApparelItemNbr".
003107            
003108*-- 11FEB22, CAUSED JUMP TO SIZE - NEED TO ADD A DELAY TO GIVE TIME FOR SYSTEM TO SETTLE --
003109*      IF POW-ARG-SHIFT = ZERO
003110*         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003111*            MOVE SPACES TO "StatusText" OF POW-SELF
003112*            INVOKE ctComboColors "SetFocus".
003113
003114     IF POW-ARG-KEYCODE = POW-KEY-ESCAPE
003115        CALL "ProcDisableSection1"
003116        CALL "ProcEnableSection1".
003117        
003118*</SCRIPT>
003119 END PROGRAM     POW-SCRIPTLET12.
003120 IDENTIFICATION  DIVISION.
003121* ctComboSize-KeyUp.
003122 PROGRAM-ID.     POW-SCRIPTLET13.
003123*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctComboSize", EVENT="KeyUp", POW-NAME="SCRIPTLET13", TYPE="ETC">
003124 ENVIRONMENT     DIVISION.
003125 DATA            DIVISION.
003126 WORKING-STORAGE SECTION.
003127 LINKAGE         SECTION.
003128 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003129 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003130 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003131      IF POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL
003132         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003133            Call "ProcStringApparelItemNbr".
003134            
003135*-- 11FEB22, CAUSED JUMP TO SIZE - NEED TO ADD A DELAY TO GIVE TIME FOR SYSTEM TO SETTLE --
003136*      IF POW-ARG-SHIFT = ZERO
003137*         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003138*            MOVE SPACES TO "StatusText" OF POW-SELF
003139*            INVOKE ctComboCategory "SetFocus".
003140
003141     IF POW-ARG-KEYCODE = POW-KEY-ESCAPE
003142        CALL "ProcDisableSection1"
003143        CALL "ProcEnableSection1".
003144        
003145*</SCRIPT>
003146 END PROGRAM     POW-SCRIPTLET13.
003147 IDENTIFICATION  DIVISION.
003148* ctComboColors-KeyUp.
003149 PROGRAM-ID.     POW-SCRIPTLET14.
003150*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctComboColors", EVENT="KeyUp", POW-NAME="SCRIPTLET14", TYPE="ETC">
003151 ENVIRONMENT     DIVISION.
003152 DATA            DIVISION.
003153 WORKING-STORAGE SECTION.
003154 LINKAGE         SECTION.
003155 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003156 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003157 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003158      IF POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL
003159         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003160            Call "ProcStringApparelItemNbr".
003161            
003162*-- 11FEB22, CAUSED JUMP TO SIZE - NEED TO ADD A DELAY TO GIVE TIME FOR SYSTEM TO SETTLE --
003163*      IF POW-ARG-SHIFT = ZERO
003164*         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003165*            MOVE SPACES TO "StatusText" OF POW-SELF
003166*            INVOKE ctComboSize "SetFocus".
003167
003168     IF POW-ARG-KEYCODE = POW-KEY-ESCAPE
003169        CALL "ProcDisableSection1"
003170        CALL "ProcEnableSection1".
003171        
003172*</SCRIPT>
003173 END PROGRAM     POW-SCRIPTLET14.
003174 IDENTIFICATION  DIVISION.
003175* ctMEditItemWhseNo-KeyUp.
003176 PROGRAM-ID.     POW-SCRIPTLET15.
003177*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditItemWhseNo", EVENT="KeyUp", POW-NAME="SCRIPTLET15", TYPE="ETC">
003178 ENVIRONMENT     DIVISION.
003179 DATA            DIVISION.
003180 WORKING-STORAGE SECTION.
003181 LINKAGE         SECTION.
003182 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003183 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003184 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003185     IF POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL
003186         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003187            Call "ProcGetItemRecord".
003188            
003189      IF POW-ARG-SHIFT = ZERO
003190         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003191            MOVE SPACES TO "StatusText" OF POW-SELF
003192            INVOKE ctMEditItemNo "SetFocus".
003193            
003194              
003195*</SCRIPT>
003196 END PROGRAM     POW-SCRIPTLET15.
003197 IDENTIFICATION  DIVISION.
003198* ctMEditNewBin-KeyUp.
003199 PROGRAM-ID.     POW-SCRIPTLET16.
003200*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditNewBin", EVENT="KeyUp", POW-NAME="SCRIPTLET16", TYPE="ETC">
003201 ENVIRONMENT     DIVISION.
003202 DATA            DIVISION.
003203 WORKING-STORAGE SECTION.
003204 LINKAGE         SECTION.
003205 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003206 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003207 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003208     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003209            MOVE SPACES TO "StatusText" OF POW-SELF
003210           INVOKE ctMEditRef "SetFocus"
003211     
003212*</SCRIPT>
003213 END PROGRAM     POW-SCRIPTLET16.
003214 IDENTIFICATION  DIVISION.
003215* ctMEditVendor-KeyUp.
003216 PROGRAM-ID.     POW-SCRIPTLET17.
003217*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditVendor", EVENT="KeyUp", POW-NAME="SCRIPTLET17", TYPE="ETC">
003218 ENVIRONMENT     DIVISION.
003219 DATA            DIVISION.
003220 WORKING-STORAGE SECTION.
003221 LINKAGE         SECTION.
003222 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003223 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003224 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003225     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003226            MOVE SPACES TO "StatusText" OF POW-SELF
003227        INVOKE ctMEditItemDesc "SetFocus". 
003228     
003229*</SCRIPT>
003230 END PROGRAM     POW-SCRIPTLET17.
003231 IDENTIFICATION  DIVISION.
003232* ctMEditItemNo-GotFocus.
003233 PROGRAM-ID.     POW-SCRIPTLET18.
003234*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditItemNo", EVENT="GotFocus", POW-NAME="SCRIPTLET18", TYPE="ETC">
003235 ENVIRONMENT     DIVISION.
003236 DATA            DIVISION.
003237 WORKING-STORAGE SECTION.
003238 01  HOLD-ITEM-NO             PIC X(12).
003239 PROCEDURE       DIVISION.
003240*     MOVE "Text" OF ctMEditItemNo TO HOLD-ITEM-NO.
003241*     Call "ProcClearFields".
003242*     MOVE HOLD-ITEM-NO  TO "Text" OF ctMEditItemNo . 
003243*</SCRIPT>
003244 END PROGRAM     POW-SCRIPTLET18.
003245 IDENTIFICATION  DIVISION.
003246* ctNEditPOSeqNo-KeyUp.
003247 PROGRAM-ID.     POW-SCRIPTLET19.
003248*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctNEditPOSeqNo", EVENT="KeyUp", POW-NAME="SCRIPTLET19", TYPE="ETC">
003249 ENVIRONMENT     DIVISION.
003250 DATA            DIVISION.
003251 WORKING-STORAGE SECTION.
003252 LINKAGE         SECTION.
003253 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003254 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003255 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003256     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003257            MOVE SPACES TO "StatusText" OF POW-SELF
003258        INVOKE ctMEditBinLocation "SetFocus". 
003259     
003260*</SCRIPT>
003261 END PROGRAM     POW-SCRIPTLET19.
003262 IDENTIFICATION  DIVISION.
003263* ctNEditPONbr-KeyUp.
003264 PROGRAM-ID.     POW-SCRIPTLET20.
003265*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctNEditPONbr", EVENT="KeyUp", POW-NAME="SCRIPTLET20", TYPE="ETC">
003266 ENVIRONMENT     DIVISION.
003267 DATA            DIVISION.
003268 WORKING-STORAGE SECTION.
003269 LINKAGE         SECTION.
003270 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003271 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003272 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003273     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003274            MOVE SPACES TO "StatusText" OF POW-SELF
003275        INVOKE ctNEditPOSeqNo "SetFocus". 
003276     
003277*</SCRIPT>
003278 END PROGRAM     POW-SCRIPTLET20.
003279 IDENTIFICATION  DIVISION.
003280* ctDEditDateReceived-KeyUp.
003281 PROGRAM-ID.     POW-SCRIPTLET21.
003282*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctDEditDateReceived", EVENT="KeyUp", POW-NAME="SCRIPTLET21", TYPE="ETC">
003283 ENVIRONMENT     DIVISION.
003284 DATA            DIVISION.
003285 WORKING-STORAGE SECTION.
003286 LINKAGE         SECTION.
003287 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003288 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003289 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003290     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003291            MOVE SPACES TO "StatusText" OF POW-SELF
003292        INVOKE ctNEditPONbr "SetFocus". 
003293     
003294*</SCRIPT>
003295 END PROGRAM     POW-SCRIPTLET21.
003296 IDENTIFICATION  DIVISION.
003297* ctDEditDateOrdered-KeyUp.
003298 PROGRAM-ID.     POW-SCRIPTLET22.
003299*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctDEditDateOrdered", EVENT="KeyUp", POW-NAME="SCRIPTLET22", TYPE="ETC">
003300 ENVIRONMENT     DIVISION.
003301 DATA            DIVISION.
003302 WORKING-STORAGE SECTION.
003303 LINKAGE         SECTION.
003304 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003305 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003306 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003307     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003308            MOVE SPACES TO "StatusText" OF POW-SELF
003309        INVOKE ctDEditDateReceived "SetFocus". 
003310     
003311*</SCRIPT>
003312 END PROGRAM     POW-SCRIPTLET22.
003313 IDENTIFICATION  DIVISION.
003314* ctMEditMillName-KeyUp.
003315 PROGRAM-ID.     POW-SCRIPTLET23.
003316*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditMillName", EVENT="KeyUp", POW-NAME="SCRIPTLET23", TYPE="ETC">
003317 ENVIRONMENT     DIVISION.
003318 DATA            DIVISION.
003319 WORKING-STORAGE SECTION.
003320 LINKAGE         SECTION.
003321 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003322 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003323 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003324     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003325            MOVE SPACES TO "StatusText" OF POW-SELF
003326        INVOKE ctDEditDateOrdered "SetFocus". 
003327     
003328*</SCRIPT>
003329 END PROGRAM     POW-SCRIPTLET23.
003330 IDENTIFICATION  DIVISION.
003331* ctMEditLotNbr-KeyUp.
003332 PROGRAM-ID.     POW-SCRIPTLET24.
003333*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditLotNbr", EVENT="KeyUp", POW-NAME="SCRIPTLET24", TYPE="ETC">
003334 ENVIRONMENT     DIVISION.
003335 DATA            DIVISION.
003336 WORKING-STORAGE SECTION.
003337 LINKAGE         SECTION.
003338 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003339 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003340 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003341     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003342            MOVE SPACES TO "StatusText" OF POW-SELF
003343        INVOKE ctMEditMillName "SetFocus". 
003344     
003345*</SCRIPT>
003346 END PROGRAM     POW-SCRIPTLET24.
003347 IDENTIFICATION  DIVISION.
003348* ctMEditRollNo-KeyUp.
003349 PROGRAM-ID.     POW-SCRIPTLET25.
003350*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditRollNo", EVENT="KeyUp", POW-NAME="SCRIPTLET25", TYPE="ETC">
003351 ENVIRONMENT     DIVISION.
003352 DATA            DIVISION.
003353 WORKING-STORAGE SECTION.
003354 LINKAGE         SECTION.
003355 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003356 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003357 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003358     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003359            MOVE SPACES TO "StatusText" OF POW-SELF
003360        INVOKE ctMEditLotNbr "SetFocus". 
003361     
003362*</SCRIPT>
003363 END PROGRAM     POW-SCRIPTLET25.
003364 IDENTIFICATION  DIVISION.
003365* ctMEditItemDesc-KeyUp.
003366 PROGRAM-ID.     POW-SCRIPTLET26.
003367*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditItemDesc", EVENT="KeyUp", POW-NAME="SCRIPTLET26", TYPE="ETC">
003368 ENVIRONMENT     DIVISION.
003369 DATA            DIVISION.
003370 WORKING-STORAGE SECTION.
003371 LINKAGE         SECTION.
003372 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003373 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003374 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003375     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003376            MOVE SPACES TO "StatusText" OF POW-SELF
003377        IF "Enabled" OF ctMEditRollNo = POW-TRUE
003378           INVOKE ctMEditRollNo "SetFocus"
003379        ELSE
003380           INVOKE ctMEditBinLocation "SetFocus".
003381         
003382     
003383*</SCRIPT>
003384 END PROGRAM     POW-SCRIPTLET26.
003385 IDENTIFICATION  DIVISION.
003386* ctMEditRef-KeyUp.
003387 PROGRAM-ID.     POW-SCRIPTLET27.
003388*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditRef", EVENT="KeyUp", POW-NAME="SCRIPTLET27", TYPE="ETC">
003389 ENVIRONMENT     DIVISION.
003390 DATA            DIVISION.
003391 WORKING-STORAGE SECTION.
003392 LINKAGE         SECTION.
003393 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003394 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003395 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003396     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003397            MOVE SPACES TO "StatusText" OF POW-SELF
003398        IF "Enabled" OF ctMEditVendor = POW-TRUE
003399           INVOKE ctMEditVendor "SetFocus"
003400        ELSE
003401        IF "Enabled" OF ctMEditItemDesc = POW-TRUE
003402           INVOKE ctMEditItemDesc "SetFocus"
003403        ELSE
003404           INVOKE ctMEditBinLocation "SetFocus".
003405            
003406     
003407*</SCRIPT>
003408 END PROGRAM     POW-SCRIPTLET27.
003409 IDENTIFICATION  DIVISION.
003410* ctDEditTransDate-KeyUp.
003411 PROGRAM-ID.     POW-SCRIPTLET28.
003412*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctDEditTransDate", EVENT="KeyUp", POW-NAME="SCRIPTLET28", TYPE="ETC">
003413 ENVIRONMENT     DIVISION.
003414 DATA            DIVISION.
003415 WORKING-STORAGE SECTION.
003416 LINKAGE         SECTION.
003417 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003418 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003419 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003420     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003421            MOVE SPACES TO "StatusText" OF POW-SELF
003422        IF "Enabled" OF ctMEditNewBin = POW-TRUE
003423           INVOKE ctMEditNewBin "SetFocus"
003424        ELSE
003425           INVOKE ctMEditRef "SetFocus".
003426                  
003427*</SCRIPT>
003428 END PROGRAM     POW-SCRIPTLET28.
003429 IDENTIFICATION  DIVISION.
003430* ctNEditTranAmt-KeyUp.
003431 PROGRAM-ID.     POW-SCRIPTLET29.
003432*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctNEditTranAmt", EVENT="KeyUp", POW-NAME="SCRIPTLET29", TYPE="ETC">
003433 ENVIRONMENT     DIVISION.
003434 DATA            DIVISION.
003435 WORKING-STORAGE SECTION.
003436 LINKAGE         SECTION.
003437 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003438 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003439 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003440     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003441            MOVE SPACES TO "StatusText" OF POW-SELF
003442        INVOKE ctDEditTransDate "SetFocus".          
003443*</SCRIPT>
003444 END PROGRAM     POW-SCRIPTLET29.
003445 IDENTIFICATION  DIVISION.
003446* ctNEditTranQty-KeyUp.
003447 PROGRAM-ID.     POW-SCRIPTLET30.
003448*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctNEditTranQty", EVENT="KeyUp", POW-NAME="SCRIPTLET30", TYPE="ETC">
003449 ENVIRONMENT     DIVISION.
003450 DATA            DIVISION.
003451 WORKING-STORAGE SECTION.
003452 LINKAGE         SECTION.
003453 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003454 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003455 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003456     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003457        IF "Enabled" OF ctNEditTranAmt = POW-TRUE
003458            MOVE SPACES TO "StatusText" OF POW-SELF
003459           INVOKE ctNEditTranAmt "SetFocus"
003460        ELSE
003461           INVOKE ctDEditTransDate "SetFocus".          
003462*</SCRIPT>
003463 END PROGRAM     POW-SCRIPTLET30.
003464 IDENTIFICATION  DIVISION.
003465* ctMEditBinLocation-KeyUp.
003466 PROGRAM-ID.     POW-SCRIPTLET31.
003467*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctMEditBinLocation", EVENT="KeyUp", POW-NAME="SCRIPTLET31", TYPE="ETC">
003468 ENVIRONMENT     DIVISION.
003469 DATA            DIVISION.
003470 WORKING-STORAGE SECTION.
003471 LINKAGE         SECTION.
003472 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003473 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003474 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003475     IF POW-ARG-KEYCODE = POW-KEY-RETURN AND POW-ARG-SHIFT = 0
003476            MOVE SPACES TO "StatusText" OF POW-SELF
003477        INVOKE ctNEditTranQty "SetFocus". 
003478            
003479*</SCRIPT>
003480 END PROGRAM     POW-SCRIPTLET31.
003481 IDENTIFICATION  DIVISION.
003482* ctComboTranType-KeyUp.
003483 PROGRAM-ID.     POW-SCRIPTLET32.
003484*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctComboTranType", EVENT="KeyUp", POW-NAME="SCRIPTLET32", TYPE="ETC">
003485 ENVIRONMENT     DIVISION.
003486 DATA            DIVISION.
003487 WORKING-STORAGE SECTION.
003488 LINKAGE         SECTION.
003489 01  POW-ARG-KEYCODE PIC S9(4) COMP-5.
003490 01  POW-ARG-SHIFT   PIC S9(4) COMP-5.
003491 PROCEDURE       DIVISION USING POW-ARG-KEYCODE POW-ARG-SHIFT.
003492      IF POW-ARG-SHIFT = POW-SHIFTSTATE-CTRL
003493         IF POW-ARG-KEYCODE = POW-KEY-RETURN
003494           Call "ProcEnableSection2".
003495            
003496     if pow-arg-shift = 0 
003497        if pow-arg-keycode = pow-key-return
003498           Call "ProcEnableSection2".
003499
003500     IF POW-ARG-KEYCODE = POW-KEY-ESCAPE
003501        CALL "ProcEnableSection1"
003502        CALL "ProcDisableSection2".
003503*</SCRIPT>
003504 END PROGRAM     POW-SCRIPTLET32.
003505 IDENTIFICATION  DIVISION.
003506* ctNEditTranQty-Change.
003507 PROGRAM-ID.     POW-SCRIPTLET33.
003508*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctNEditTranQty", EVENT="Change", POW-NAME="SCRIPTLET33", TYPE="ETC">
003509 ENVIRONMENT     DIVISION.
003510 DATA            DIVISION.
003511 WORKING-STORAGE SECTION.
003512 PROCEDURE       DIVISION.
003513     IF "Value" OF ctNEditTranQty NOT = ZERO
003514        MOVE POW-TRUE TO "Enabled" OF ctPushSave
003515     ELSE
003516        MOVE POW-FALSE TO "Enabled" OF ctPushSave.
003517        
003518     
003519*</SCRIPT>
003520 END PROGRAM     POW-SCRIPTLET33.
003521 IDENTIFICATION  DIVISION.
003522* ctPushSave-Click.
003523 PROGRAM-ID.     POW-SCRIPTLET34.
003524*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctPushSave", EVENT="Click", POW-NAME="SCRIPTLET34", TYPE="ETC">
003525 ENVIRONMENT     DIVISION.
003526 DATA            DIVISION.
003527 WORKING-STORAGE SECTION.
003528 PROCEDURE       DIVISION.
003529     MOVE POW-FALSE TO "Enabled" OF ctPushSave.
003530     CALL "ProcSaveTran".
003531     IF "Enabled" OF ctMEditItemNo = POW-TRUE
003532         INVOKE ctMEditItemNo "SetFocus".
003533*</SCRIPT>
003534 END PROGRAM     POW-SCRIPTLET34.
003535 IDENTIFICATION  DIVISION.
003536* ctDEditDateReceived-ClickSpin.
003537 PROGRAM-ID.     POW-SCRIPTLET35.
003538*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctDEditDateReceived", EVENT="ClickSpin", POW-NAME="SCRIPTLET35", TYPE="ETC">
003539 ENVIRONMENT     DIVISION.
003540 DATA            DIVISION.
003541 WORKING-STORAGE SECTION.
003542 LINKAGE         SECTION.
003543 01  POW-ARG-NBUTTON PIC S9(4) COMP-5.
003544 PROCEDURE       DIVISION USING POW-ARG-NBUTTON.
003545     IF POW-ARG-NBUTTON = 1
003546        SUBTRACT 1 FROM "Value" OF ctDEditDateReceived
003547     ELSE
003548        ADD 1 TO  "Value" OF ctDEditDateReceived.        
003549*</SCRIPT>
003550 END PROGRAM     POW-SCRIPTLET35.
003551 IDENTIFICATION  DIVISION.
003552* ctDEditDateOrdered-ClickSpin.
003553 PROGRAM-ID.     POW-SCRIPTLET36.
003554*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctDEditDateOrdered", EVENT="ClickSpin", POW-NAME="SCRIPTLET36", TYPE="ETC">
003555 ENVIRONMENT     DIVISION.
003556 DATA            DIVISION.
003557 WORKING-STORAGE SECTION.
003558 LINKAGE         SECTION.
003559 01  POW-ARG-NBUTTON PIC S9(4) COMP-5.
003560 PROCEDURE       DIVISION USING POW-ARG-NBUTTON.
003561     IF POW-ARG-NBUTTON = 1
003562        SUBTRACT 1 FROM "Value" OF ctDEditDateOrdered
003563     ELSE
003564        ADD 1 TO  "Value" OF ctDEditDateOrdered.     
003565*</SCRIPT>
003566 END PROGRAM     POW-SCRIPTLET36.
003567 IDENTIFICATION  DIVISION.
003568* ctDEditTransDate-ClickSpin.
003569 PROGRAM-ID.     POW-SCRIPTLET37.
003570*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctDEditTransDate", EVENT="ClickSpin", POW-NAME="SCRIPTLET37", TYPE="ETC">
003571 ENVIRONMENT     DIVISION.
003572 DATA            DIVISION.
003573 WORKING-STORAGE SECTION.
003574 LINKAGE         SECTION.
003575 01  POW-ARG-NBUTTON PIC S9(4) COMP-5.
003576 PROCEDURE       DIVISION USING POW-ARG-NBUTTON.
003577     IF POW-ARG-NBUTTON = 1
003578        SUBTRACT 1 FROM "Value" OF ctDEditTransDate
003579     ELSE
003580        ADD 1 TO  "Value" OF ctDEditTransDate.
003581        
003582*</SCRIPT>
003583 END PROGRAM     POW-SCRIPTLET37.
003584 IDENTIFICATION  DIVISION.
003585* ctPushClear-Click.
003586 PROGRAM-ID.     POW-SCRIPTLET38.
003587*<SCRIPT DIVISION="PROCEDURE", CONTROL="ctPushClear", EVENT="Click", POW-NAME="SCRIPTLET38", TYPE="ETC">
003588 ENVIRONMENT     DIVISION.
003589 DATA            DIVISION.
003590 WORKING-STORAGE SECTION.
003591 PROCEDURE       DIVISION.
003592 BEGIN-PROGRAM.
003593     Call "ProcClearFields".
003594     
003595 END-PROGRAM.
003596     EXIT PROGRAM.
003597     
003598         
003599*</SCRIPT>
003600 END PROGRAM     POW-SCRIPTLET38.
003601 END PROGRAM     FormInvTrans.
