È(È œ ÈTX035XP Pð¸101183101183(èÈÐ00010H Q035XP00020F* PRINT EXPLOSION WHERE-USED (MODEL/PROD LINE) 00030F* REVISED 11-07-82 12:45 PM. 00040FPNSTRT IP F 80 DISK 00050FSAVXPM IS F 99 22AI 1 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FPRINT O F 132 LPRINTER 00080E******************************************************************* 00090E TABPL 1 20 4 0ATABCD 6 00100E CPN 1 140 10 0 00110E PDL 1 140 4 0 00120E COD 1 140 2 0 00130E MOD 1 140 12 00140L***************************************************************** 00150LPRINT 66FL 60OL 00160I******************************************************************* 00170IPNSTRT PN 09 00180I 1 100PNCOMP 00190I 11 140PGSTRT 00200I******************************************************************* 00210ISAVXPM XP 01 00220I 3 120XPCPN L1 00230I 13 220XPTPN 00240I******************************************************************* 00250IPMMST2 PM ÐÐ00260I 15 180PMPL 00270I 19 30 PMMODL 00280C******************************************************************** 00290C* INITIALIZE. 00300C SETOF 4030 00310C N09 GOTO START 00320C Z-ADDPGSTRT EGAP 40 00330C Z-ADDPNCOMP SAVPN 100 00340C Z-ADD0 CPN 00350C Z-ADD0 PDL 00360C MOVE ' ' BLK12 12 00370C MOVE BLK12 MOD 00380C*------------------------------------------------------------------- 00390C START TAG 00400C XPCPN COMP SAVPN 58 58 00410C N58 GOTO END 00420C XPCPN COMP XPTPN 54 00430C 54 GOTO END 00440C MOVELXPTPN W12A 12 00450C MOVE ' ' W12A 00460C W12A CHAINPMMST2 54 00470C 54 SETON 30 NO P/M 00480C 54 GOTO END 00490C SETON 40 00500C PMPL LOKUPTABPL TABCD 5858 ÐÐ00510C 58 MOVELTABCD W4N 40 00520C 58 PMPL COMP W4N 5656 00530C 56 MOVE TABCD CODE 20 00540C*---------------------------------------------------------------- 00550C END TAG 00560CL0N40 GOTO ENDL0 00570CL0 EXSR SR102 LOAD ARRAYS 00580CL0 L COMP 120 54 54 00590CL0 54 EXSR SR103 PRINT ARRAYS 00600C*------------------------------------------------------------------- 00610CL0 ENDL0 TAG 00620CLR L COMP 0 54 00630CLR 54 EXSR SR103 FINAL PRINT 00640C****************************************************************** 00650CSR SR102 BEGSR 00660C* LOAD ARRAYS AND PRINT 00670CSR 1 ADD L L 30 00680CSR L COMP 120 54 00690CSRN54 GOTO T102A ARRAY NOT FULL 00700CSR EXSR SR103 PRINT 00710CSR GOTO SR102 TRY AGAIN 00720C*------------------------------------------------------------------- 00730CSR T102A TAG 00740CSR XPCPN COMP LSTCPN 56 00750CSRN56 1 ADD L L ÐÐ00760CSR L COMP 120 54 00770CSRN54 GOTO T102B DID NOT EXCEED AR 00780CSR EXSR SR103 PRINT 00790CSR GOTO SR102 TRY AGAIN 00800C*------------------------------------------------------------------ 00810CSR T102B TAG 00820CSR Z-ADDXPCPN LSTCPN 100 00830CSR Z-ADDXPCPN CPN,L 00840CSRN30 MOVE PMPL PDL,L 00850CSRN30 MOVE PMMODL MOD,L 00860CSR MOVE CODE COD,L 00870CSR ENDSR 00880C******************************************************************* 00890CSR SR103 BEGSR 00900C* PRINT ARRAYS 00910CSR Z-ADD0 L 30 00920CSR 1 ADD EGAP EGAP 00930CSR SETON 81 00940CSR EXCPT PRINT HEADING 00950CSR SETOF 81 00960C*-------------------------------------------------------------------- 00970CSR T103A TAG 00980CSR 1 ADD L L 00990CSR L COMP 60 54 01000CSR 54 GOTO T103C ÐÐ01010CSR 60 ADD L R 30 01020CSR SETON 82 01030CSR EXCPT PRINT DATA 01040CSR SETOF 82 01050CSR GOTO T103A 01060C*-------------------------------------------------------------------- 01070CSR T103C TAG 01080CSR L COMP 64 54 54 01090CSR 54 Z-ADD0 L 01100CSR 54 GOTO END103 PAGE IS DONE 01110CSR SETON 83 01120CSR EXCPT LF 01130CSR SETOF 83 01140CSR 1 ADD L L 01150CSR L COMP 64 54 54 01160CSRN54 GOTO T103C 01170CSR Z-ADD0 L 01180CSR END103 ENDSR 01190O******************************************************************** 01200OPRINT E 2 81 01210O 62 'S U M M A R Y W H E R ' 01220O 86 'E U S E D ' 01230O UDATE Y 8 01240O EGAP Z 132 01250O 127 'PAGE' ÐÐ01260O*---------------------------------------------------------------- 01270O E 1 81 01280O 11 'COMPONENT' 01290O 22 'MODEL' 01300O 39 'PROD LINE' 01310O 49 'IMS P.L.' 01320O 56 '*' 01330O 79 'COMPONENT' 01340O 90 'MODEL' 01350O 107 'PROD LINE' 01360O 117 'IMS P.L.' 01370O*------------------------------------------------------------------- 01380O E 1 83 01390O 56 '*' 01400O*----------------------------------------------------------------- 01410O E 1 82 01420O CPN,L B 12 ' - - ' 01430O MOD,L B 29 01440O PDL,L ZB 39 01450O COD,L ZB 49 01460O 56 '*' 01470O CPN,R B 80 ' - - ' 01480O MOD,R B 97 01490O PDL,R ZB 107 01500O COD,R ZB 117 ÐÐ01510O******************************************************************** ** PRODUCT LINE - IMS CODE 0015201110111905 015301120112910 015401130113915 015501210121920 015601220122925 015701230123929 015801240124930 015901410141935 016001420142940 0016101430143945 016201510151950 016301530153960 016401550156955 016501570157965 016601580158980 016701590159065 016801591159385 016901600169975 017001700179970 017101900199998 01720** CPN 01730 01740** PDL 01750ÐÐ 01760** COD 01770 01780** MOD 01790 01800/* 01810_‚ ÐÐ_‚_‚ 01760** COD 01770 01780** MOD 01790 01800/* 01810_‚ ÐÈ(X" XúX099XP P999999120282(èÈÐ00010H Q099XP00020F* SET-UP XPMAST FROM DISK80 INPUT. (X099XP) 00030F* REVISED 1-29-81 2:45 PM. 00040F* NOTE: DISK80 DATA MUST FIRST BE LOADED FROM FLOPPY USING Q067DP. 00050FXPCONT IP F 128 DISK 00060FDISK80 IS F 80 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FXPMAST UC F 99R22AI 1 DISK A 00090FMCNCR2 IC F 16R 5AI 1 DISK 00100FREQMTIN O F 10 DISK 00110E******************************************************************** 00120E XPQ 18 7 0 REQMTS 00130E XCD 18 6 0A DATES 00140E TCD 12 5 0A 00150I******************************************************************* 00160IDISK80 FL 01 1 CK 2 C1 00170I* UNIVAC FORECAST. 00180I* MCN 5A 00190I 3 7 TMCN 00200I* FORECAST 12 X 5N 00210I 8 67 TCD 00220I* 1ST PERIOD DATE 4N (MMYY) 00230I 76 790TFPDAT 00240I 1 80 RECORD 00250I GG 02 ÐÐ00260I****************************************************************** 00270IXPMAST XP 00280I* EXPLOSION MASTER. 00290I* KEY AREA. 00300I* LOW LEVEL CODE 2N 00310I 1 20XPLL 00320I* COMPONENT PART # 10N 00330I 3 120XPCPN 00340I* TOP ASSY PN 10N 00350I 13 220XPAPN 00360I* REQMTS 7P X 18 00370I P 23 94 XPQ 00380I* RECORD STATUS 1A 00390I 99 99 XPSTAT 00400I****************************************************************** 00410IXPCONT XC 00420I* EXPLOSION CONTROL MAST. 00430I* DATES 6N X 18 00440I 1 108 XCD 00450I* CUR INDENT LEVEL 2N 00460I 127 1280XCCIL 00470I******************************************************************** 00480IPMMST2 PM 00490I 1 100PMPN 00500I 19 30 PMMODL ÐÐ00510I 31 59 PMDESC 00520I 430 4310PMLL 00530I 674 674 PMSTAT 00540I******************************************************************** 00550IMCNCR2 MC 00560I* PART NO. 10N 00570I 6 150MCPN 00580I 16 16 MCSTAT 00590C******************************************************************** 00600C N01 GOTO END 00610C 01 Z-ADD0 ZERO10 100 00620C TMCN CHAINMCNCR2 60 00630C N60 MCSTAT COMP 'D' 60 00640C 60 SETOF 01 00650C 60 GOTO END 00660C MOVELMCPN W12A 12 00670C MOVE ' ' W12A 00680C W12A CHAINPMMST2 61 00690C N61 PMSTAT COMP 'D' 61 00700C 61 SETOF 01 00710C 61 GOTO END 00720C********* MOVELPMLL W22A 22 00730C MOVELPMPN W20A 20 00740C MOVE PMPN W20A 00750C MOVE W20A W22A 22 ÐÐ00760C W22A CHAINXPMAST 62 00770C 62 Z-ADD0 XPQ 00780C MOVE 'A' XPSTAT 00790C MOVELTFPDAT W2N 20 MONTH 00800C MOVE TFPDAT W2A 2 YEAR 00810C MOVELW2A DATE 60 00820C MOVELW2N W4A 4 00830C MOVE '01' W4A 00840C MOVE W4A DATE STARTING DATE 00850C Z-ADD1 X 30 00860C DATE LOKUPXCD,X 54 54 00870C N54 Z-ADD18 X 00880C Z-ADD1 T 30 00890C TCD,T ADD XPQ,X XPQ,X 00900C*------------------------------------------------------------------- 00910C TAG10 TAG 00920C 1 ADD T T 00930C T COMP 12 54 00940C 54 GOTO TAG20 00950C 1 ADD X X 00960C X COMP 18 54 00970C 54 Z-ADD18 X 00980C TCD,T ADD XPQ,X XPQ,X 00990C GOTO TAG10 01000C*------------------------------------------------------------------- ÐÐ01010C TAG20 TAG 01020C SETON 83 01030C EXCPT UPDATE XPMAST 01040C SETOF 83 01050C*------------------------------------------------------------------- 01060C END TAG 01070O******************************************************************** 01080OXPMAST EADD 83 62 01090O W22A 22 01100O XPQ 94P 01110O 99 'A' 01120O*------------------------------------------------------------------- 01130O E 83N62 01140O XPQ 94P 01150O 99 'A' 01160O******************************************************************** 01170OREQMTIN E 83 01180O PMPN 10 01190O********************************************************************* /* 001200_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(â â X030WM P999999120282(èÈÐ00010H Q030WM00020F* UNPLANNED STOCK RECPT. (X030WM) 00030F* REVISED 3/09/82 4:50 PM. 00040F* 1. RECEIVES STOCK FROM PROD WORK ORDER (WMMAST) 00050F* OR PROJECT (PJMAST) 00060F* OR ACCOUNT (GLMAST) 00070F* 2. INCREASES ON HAND BALANCE 00080F* 3. ADDS RECORD TO MATL DISTR FILE TO ACCUMULATE 00090F* MATERIAL CREDITS. 00100F* MENU: MQNS01 00110FBITTAB IP F 33 DISK 00120FMGFILE IC F 80R DISK 00130FCRTFILE IC F 256R DISK 00140FPMMST2 UC F 674R12AI 1 DISK 00150FWMMAST IC F 470R 6AI 1 DISK 00160FPJMAST IC F 170R12AI 1 DISK 00170FTERM132 O F 132 5 00180FGLMAST IC F 165R 9AI 1 DISK 00190FWMISSUE UC F 60R21AI 1 DISK A 00200FWUKEY UC F 22R21AI 1 DISK A 00210FSFPNA O F 10 DISK A 00220FSTKLOC UC F 17R16AI 1 DISK A 00230FCALENDARIC F 22R 7AI 1 DISK 00240FPRODWO IT F 80 EDISK 00250FDEPTNAMEIT F 80 EDISK ÐÐ00260E******************************************************************** 00270E DEPTNAME TABDEP 1 55 5 0 TABNAM 20 00280E PRODWO TABPWO 1 4 1 PROD WO PREFIXES 00290E NUL 1 132 1 NULL CHAR 00300E A16 16 16 1 A INPUT DATA ARRAY 00310E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00320E LOC 1 3 3 FIELD START COL # 00330E A9 9 9 1 00340E COL 1 6 3 00350E DUN 1 6 1 A EDIT CMPLT FLAG 00360E MES 1 1 30 00370E PM$ 7 9 3 ACTG STDS 00380E PA$ 2 9 00390E PB$ 2 7 0 00400E PC$ 2 9 2 00410E PT$ 2 9 2 00420E BIT 33 1 SCREEN CONTR. CHAR 00430I******************************************************************* 00440IBITTAB BT 00450I 1 33 BIT 00460I******************************************************************** 00470ICALENDARCL 00480I 1 1 CLPRFX 00490I******************************************************************* 00500IMGFILE MG ÐÐ00510I* MESSAGE FILE. 00520I 1 35 MGTEXT 00530I******************************************************************** 00540IPMMST2 PM 00550I* PART # 10N 00560I 1 100PMPN 00570I P 110 1120PMACNT 00580I* DESCRIPTION 29A 00590I 31 59 PMDESC 00600I* COSTS 9.3P X 7 00610I* 1 = LAB 3 = MATL 00620I* 2 = LAB BUR 4 = MATL BUR 00630I P 185 219 PM$ 00640I* ON HAND STOCK 7P 00650I P 311 3140PMOHB 00660I* QTY ON B/O 7P 00670I* UNPLAN RECEIPT QTY 7P 00680I P 383 3860PMURCT 00690I* UNPLAN RECEIPT FREQUENCY 5P 00700I P 413 4150PMQRCT 00710I* STD COST 9.3P 00720I P 489 4933PMOSUC 00730I* STOCK LOCATION 6A 00740I 621 626 PMSLOC 00750I 674 674 PMSTAT ÐÐ00760I********************************************************************* 00770ICRTFILE CR 00780I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00790I* STD AREA - SAME FOR ALL PROGRAMS. 00800I* EMPLOYEE # 5N 00810I* 1 50CREMPL 00820I* USER CODE 8A 00830I* 6 13 CRUSER 00840I* DEPT # 5N 00850I* 14 180CRDEPT 00860I* JOB NAME 8A (JOB LOADED BY MENU) 00870I* 19 26 CRJOB 00880I* SHUTDOWN FLAG 1A 00890I* BLANK = NO SHUTDOWN 00900I* 27 27 CRSHUT 00910I* TIME STARTED 6N 00920I* 28 330CRTIME 00930I* DATE STARTED 4N 00940I* 34 370CRDATE 00950I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00960I 68 73 CRRET 00970I* MENU NAME 6A 00980I 74 79 CRMENU 00990I******************************************************************** 01000IWMMAST WM ÐÐ01010I* WORK ORDER MASTER. 01020I 411 4160WMCLOS 01030I 422 4310WMPN 01040I 470 470 WMSTAT 01050I****************************************************************** 01060ISTKLOC SL 01070I 17 17 SLSTAT 01080I******************************************************************** 01090IPJMAST PJ 01100I* PROJECT WORK ORDER. 01110I* WORK ORDER NO. 01120I 1 9 PJORD 01130I* PRIME 6A 01140I 1 6 PJPRIM 01150I* DASH 3N 01160I 7 90PJDASH 01170I* DEPT 3N 01180I 10 120PJDEPT 01190I* ACCOUNT 5N 01200I 13 170PJACNT 01210I* MODEL 12A 01220I 18 29 PJMODL 01230I* DESCRIPTION 40A 01240I 30 69 PJDESC 01250I* SCHEDULE. ÐÐ01260I* START DATE 6N 01270I 70 750PJBSD 01280I* COMPLETION DATE 6N 01290I 76 810PJBCD 01300I* BUDGET - LABOR HRS 7P 01310I P 82 850PJBLH 01320I* BUDGET - LABOR $ 7P 01330I P 86 89 PB$,1 01340I* BUDGET - MATERIAL $ 7P 01350I P 90 93 PB$,2 01360I* ACTUAL. 01370I* START DATE 6N 01380I 94 990PJASD 01390I* COMPLETION DATE 6N 01400I 100 1050PJACD 01410I* LABOR HRS 7.1P 01420I P 106 1091PJALH 01430I* LABOR $ 9.2P 01440I P 110 114 PA$,1 01450I* MATERIAL $ 9.2P 01460I P 115 119 PA$,2 01470I* STATUS. 01480I* LABOR - % COMPLETE 3.2P 01490I P 120 1212PJLPCT 01500I* MATERIAL - % COMPLETE 3.2P ÐÐ01510I P 122 1232PJMPCT 01520I* CURRENT MONTH - ACTUAL. 01530I* LABOR HRS 7.1P 01540I P 124 1271PJCLH 01550I* LABOR $ 9.2P 01560I P 128 132 PC$,1 01570I* MATERIAL $ 9.2P 01580I P 133 137 PC$,2 01590I* TRANSFER $ 2 X 9.2P 01600I P 138 147 PT$ 01610I* RECORD STATUS 1A 01620I 170 170 PJSTAT 01630I******************************************************************** 01640IGLMAST GL 01650I* GENERAL LEDGER MASTER. 01660I* ACCOUNT NAME 40A 01670I 18 57 GLNAME 01680I* RECORD STATUS 1A 01690I 165 165 GLSTAT 01700I****************************************************************** 01710IWMISSUE WS 01720I* MATERIAL ISSUE RECORD. 01730I* KEY AREA. 01740I* PART NO. 10N 01750I 1 100WUPN ÐÐ01760I* WORK ORDER/ACCOUNT 11A 01770I 11 21 WUWO 01780I* PRIME 6A 01790I 11 16 WUWOP 01800I* DASH 3N 01810I 17 190WUDASH 01820I* SUB 2N 01830I 20 210WUSUB 01840I* CURRENT MONTH ISSUES. 01850I* PLANNED 7P 01860I P 22 250WUPCM 01870I* UNPLAN 7P 01880I P 26 290WUUCM 01890I* RETURNED 7P 01900I P 30 330WURCM 01910I* SUBSTITUTED 7P 01920I P 34 370WUSCM 01930I* TOTAL ISSUES. 01940I* PLANNED 7P 01950I P 38 410WUPTOT 01960I* UNPLAN 7P 01970I P 42 450WUUTOT 01980I* RETURNED 7P 01990I P 46 490WURTOT 02000I* SUBSTITUTED 7P ÐÐ02010I P 50 530WUSTOT 02020I* REQD QTY 7P 02030I P 56 590WUREQD 02040I********************************************************************** 02050IWUKEY WK 02060I* ALT KEY FOR WMISSUE 02070I 1 11 WKORD 02080I 12 210WKPN 02090I 22 22 WKSTAT 02100C******************************************************************** 02110C* INITIALIZE 02120C EXSR SR101 1-TIME INIT 02130C Z-ADD0 ZERO7 70 STUPIDITY 02140C MOVE ' ' PREFIX 1 STUPIDITY 02150C EXSR SR71 PUT HEADING 02160C*------------------------------------------------------------------ 02170C START TAG 02180C* SET-UP 1ST FIELD NO. 02190C MOVE ' ' DUN INIT EDIT ARRAY 02200C Z-ADD0 TPN 02210C Z-ADD0 TQTY 02220C MOVE BLK12 TWO 02230C MOVE BLK12 TWOP 02240C Z-ADD0 TWOD 02250C MOVE ' ' TTYPE ÐÐ02260C Z-ADD0 TDEPT 02270C Z-ADD0 SAVASY 02280C MOVE BLK35 PMDESC 02290C Z-ADD0 PMOHB 02300C Z-ADD1 F 30 FIELD # 02310C SETOF 70 02320C GOTO READ 02330C*------------------------------------------------------------------ 02340C NEXT TAG 02350C* SET-UP NEXT FIELD NO. 02360C 1 ADD F F FIELD # 02370C*----------------------------------------------------------------- 02380C READ TAG 02390C* READ DATA FROM TERMINAL. 02400C SETOF 909677 02410C EXSR SR102 VALIDATE FIELD # 02420C 55 GOTO UPDATE DONE 02430C EXSR SR201 IDENTIFY-F 02440C DUN,1 COMP ' ' 54 02450C N54 Z-ADD1 F 02460C EXSR SR75 READ TERMINAL 02470C 98 GOTO GOODBY GOODBY 02480C 94 GOTO MENU MENU REQUEST 02490C 90 EXSR SR72 REWRITE INPUT DATA 02500C 93 GOTO NEWITM NEW ITEM ÐÐ02510C 92 GOTO JUMP FIELD JUMP REQST 02520C 89 F SUB 1 F SKIP BACKWARD 02530C 89 GOTO READ " " 02540C 88 SETOF 90 SPACE FILL 02550C 88 SETON 77 " " 02560C 86 GOTO UPDATE UPDATE 02570C 96 GOTO ERROR ERROR 02580C N77 GOTO EDIT NO DATA INPUT 02590C*------------------------------------------------------------------ 02600C PROCES TAG 02610C* PROCESS INPUT DATA 02620C EXSR SR103 MOVE DATA 02630C*------------------------------------------------------------------- 02640C EDIT TAG 02650C EXSR SR104 EDIT DATA 02660C EXSR SR72 REWRITE DATA 02670C 96 GOTO ERROR ERROR 02680C GOTO NEXT 02690C*------------------------------------------------------------------ 02700C UPDATE TAG 02710C* UPDATE DATA BASE. 02720C EXSR SR105 FINAL EDIT 02730C 96 GOTO ERROR ERROR 02740C EXSR SR106 UPDATE 02750C 96 GOTO ERROR ERROR ÐÐ02760C Z-ADD4 F 02770C EXSR SR72 PUT DATA 02780C ERRCNT ADD COUNT COUNT 30 02790C 1 ADD COUNT COUNT 02800C ERRCNT COMP 0 54 02810C 54 1 ADD COUNT COUNT 02820C Z-ADD0 ERRCNT 02830C COUNT COMP 119 54 54 02840C 54 EXSR SR71 02850C Z-ADD0 TPN 02860C Z-ADD0 TQTY 02870C MOVEABLK35 DUN,4 02880C GOTO READ 02890C*------------------------------------------------------------------- 02900C JUMP TAG 02910C* SET-UP JUMP TO REQUESTED FIELD 02920C 1 ADD W W 30 02930C W COMP 12 54 02940C 54 Z-ADD318 M 50 96 FLAG ERROR 02950C 54 GOTO ERROR BAD ESC 02960C MOVE ' ' W3A 3 02970C MOVEAA16,W W3A 02980C Z-ADD3 W2N 20 02990C EXIT SUBRAJ R. JUSTIFY 03000C RLABL W2N ÐÐ03010C RLABL W3A 03020C MOVE W3A F NEW FIELD # 03030C GOTO READ 03040C*-------------------------------------------------------------------- 03050C ERROR TAG 03060C EXSR SR102 VALIDATE FIELD # 03070C EXSR SR89 GET MSG 03080C EXSR SR73 PUT MSG 03090C GOTO READ 03100C*------------------------------------------------------------------ 03110C NEWITM TAG 03120C* NEW ITEM ESC CODE. 03130C MOVEL'Q030WM' PROG 8 03140C GOTO END 03150C*------------------------------------------------------------------- 03160C MENU TAG 03170C* SET-UP LINK TO MENU 03180C MOVEL'Q059DP' PROG 8 03190C GOTO END 03200C*-------------------------------------------------------------------- 03210C GOODBY TAG 03220C* LINK TO SIGN-OFF 03230C MOVEL'GOODBY' PROG 03240C GOTO END 03250C*------------------------------------------------------------------- ÐÐ03260C END TAG 03270C EXITFCHAIN LINK TO NEXT PROG 03280C RLABL PROG 03290C********************************************************************* 03300CSR SR1 BEGSR 03310C* EDIT ORDER #. 03320CSR PREFIX LOKUPTABPWO 70 FLAG INVEN ITEM 03330CSR MOVE TWOP W5N 50 03340CSR W5N COMP 0 57 03350CSRN57 Z-ADD618 M 96 WORK ORDER INVALID 03360CSR 96 GOTO END1 03370CSR EXSR SR80 GET WMMAST 03380CSR 60 GOTO T1B 03390C*R 61 * * * * * * Z-ADD506 M 96 03400CSR 61 GOTO END1 ERROR 03410CSR WMCLOS COMP 0 54 03420C*R 54 * * * * * * Z-ADD506 M 96 FLAG ERROR 03430CSR 54 GOTO END1 03440CSR MOVE WMPN SAVASY 100 03450CSR GOTO END1 03460C*------------------------------------------------------------------- 03470CSR T1B TAG 03480CSR EXSR SR85 GET PJMAST 03490CSRN60N61 GOTO END1 03500CSR EXSR SR86 GET GLMAST ÐÐ03510CSRN60N61 GOTO END1 03520C*R* * * * * * * * Z-ADD506 M 96 FLAG ERROR 03530CSR END1 ENDSR 03540C******************************************************************** 03550CSR SR2 BEGSR 03560C* EDIT DEPT #. 03570CSR MOVE BLK35 DEPNAM 17 03580CSR TDEPT COMP 0 54 03590CSRN54 GOTO END2 03600CSR Z-ADDTDEPT W5N 50 03610CSR W5N LOKUPTABDEP TABNAM 54 03620CSR 54 MOVE TABNAM DEPNAM 03630CSR END2 ENDSR 03640C******************************************************************** 03650CSR SR3 BEGSR 03660C* EDIT TYPE CODE. 03670CSR ENDSR 03680C******************************************************************** 03690CSR SR4 BEGSR 03700C* EDIT PART #. 03710CSR TPN COMP 0 54 03720CSRN54 Z-ADD299 M 96 PART # MISSING 03730CSRN54 GOTO END4 03740CSR MOVELTPN W12A 12 03750CSR EXSR SR81 GET PMMST2 ÐÐ03760CSR 60 Z-ADD291 M 96 NO PART MAST 03770CSR 60 GOTO END4 03780CSR END4 ENDSR 03790C******************************************************************** 03800CSR SR5 BEGSR 03810C* EDIT QTY RECEIVED. 03820CSR TQTY ADD PMOHB W7N 70 54 03830CSRN54 Z-ADD563 M NEG ON HAND WARNING 03840CSRN54 EXSR SR74 PUT WARNING 03850CSR TQTY COMP 0 54 03860CSRN54 Z-ADD184 M 96 FLAG ERROR 03870CSR END5 ENDSR 03880C******************************************************************** 03890CSR SR66 BEGSR 03900CSR EXITFQCLF LINE FEED 03910CSR ENDSR 03920C******************************************************************** 03930CSR SR69 BEGSR 03940C* POSITION CURSOR. 03950CSR EXITFQXYPOS POSITION CURSOR 03960CSR RLABL W6A CLEAR SCREEN 03970CSR ENDSR 03980C********************************************************************** 03990CSR SR71 BEGSR 04000C* PUT HEADINGS TO TERMINAL ÐÐ04010CSR EXITFZCPAGE CLEAR PAGE-4 04020CSR SETON 71 04030CSR EXCPT PUT HEADINGS 04040CSR SETOF 71 04050CSR Z-ADD101 COUNT 04060CSR ENDSR 04070C********************************************************************* 04080CSR SR72 BEGSR 04090C* PUT DATA TO TERMINAL 04100CSR TWOD COMP 0 55 04110CSR F COMP 3 54 04120CSRN54 MOVELLOC,F W3N 30 04130CSR 54 MOVE COUNT W3N 04140CSR W3N SUB 1 W3N 04150CSR MOVELW3N W6A 6 04160CSR MOVE '001' W6A 04170CSR EXSR SR69 POSITION CURSOR 04180CSR SETON 72 04190CSR EXCPT PUT DATA 04200CSR SETOF 72 04210CSR ENDSR 04220C*********************************************************************** 04230CSR SR73 BEGSR 04240C* PUT ERROR MESSAGE TO TERMINAL 04250CSR COUNT ADD ERRCNT W3N 30 ÐÐ04260CSR W3N COMP 119 54 54 04270CSRN54 GOTO T73A 04280CSR EXSR SR71 PUT HEADING 04290CSR EXSR SR72 REPUT DATA 04300CSR Z-ADD0 ERRCNT 04310C*--------------------------------------------------------------- 04320CSR T73A TAG 04330CSR MOVELW3N W6A 04340CSR MOVE '001' W6A 04350CSR EXSR SR69 POSITION CURSOR 04360CSR SETON 73 04370CSR EXCPT PUT MSG 04380CSR SETOF 73 04390CSRN50 1 ADD ERRCNT ERRCNT 30 04400CSR ENDSR 04410C****************************************************************** 04420CSR SR74 BEGSR 04430C* PUT MESSAGE 04440CSR EXSR SR89 GET MESSAGE 04450CSR EXSR SR73 PUT MESSAGE 04460CSR ENDSR 04470C******************************************************************** 04480CSR SR75 BEGSR 04490C* READ FROM TERMINAL 04500CSR SETOF 779096 ÐÐ04510CSR SETOF 9392 04520CSR SETOF 8988 04530CSR SETOF 86 04540CSR MOVE BIT,7 BUFLGT 2 READ BUFFER LGTH 04550CSR MOVE BLK16 W16A 16 BUFFER 04560CSR MOVE BIT,28 A9,1 04570CSR MOVE '8' A9,2 04580CSR F COMP 3 54 04590CSRN54 MOVEALOC,F A9,3 04600CSR 54 MOVE COUNT W3A 04610CSR 54 MOVEAW3A A9,3 04620CSR MOVEACOL,F A9,6 04630CSR MOVE BIT,8 A9,9 04640CSR MOVEAA9 W9A 9 04650CSR EXITFQPREED READ FROM TERMINAL 04660CSR RLABL W9A X-Y POS 04670CSR RLABL W16A READ BUFFER 04680CSR RLABL BUFLGT READ BUFFER LGTH 04690CSR MOVEAW16A A16 INPUT DATA ARRAY 04700CSR MOVE BLK12 W16A INIT INPUT ARRAY 04710CSR Z-ADD1 W 30 04720CSR '\' LOKUPA16,W 90 FLAG ESC 04730CSRN90 GOTO T75B NOT ESC 04740CSR 1 ADD W W 04750CSR W COMP 12 54 ÐÐ04760CSR 54 GOTO T75A BAD ESC 04770CSR A16,W COMP 'G' 98 GOODBY 04780CSR A16,W COMP 'E' 94 MENU 04790CSR A16,W COMP 'N' 93 NEW ITEM 04800CSR A16,W COMP 'J' 92 JUMP 04810CSR A16,W COMP 'B' 89 SKIP BKWRD 04820CSR A16,W COMP 'S' 88 SPACE FILL 04830CSR A16,W COMP 'U' 86 UPDATE 04840CSR 98 04850COR 94 04860COR 93 04870COR 92 04880COR 89 04890COR 88 04900COR 86 GOTO END75 GOOD ESC 04910C*------------------------------------------------------------------ 04920CSR T75A TAG 04930C* FLAG BAD ESC INPUT 04940CSR Z-ADD318 M 96 FLAG ERROR 04950CSR GOTO END75 04960C*-------------------------------------------------------------------- 04970CSR T75B TAG 04980C* MOVE DATA 04990CSR Z-ADD1 W 05000CSR ' ' LOKUPA16,W 77 ÐÐ05010CSR 77 MOVEAA16,W W16A INPUT DATA 05020C*-------------------------------------------------------------------- 05030CSR END75 TAG 05040C* INIT PREV ERROR MSG. 05050CSR EXSR SR76 INIT MSG'S 05060CSR ENDSR 05070C******************************************************************* 05080CSR SR76 BEGSR 05090C* INIT MESSAGES ON CRT 05100CSR ERRCNT COMP 0 54 54 05110CSRN54 GOTO END76 05120CSR MOVE BLK35 MGTEXT 05130CSR SETON 50 05140CSR EXSR SR73 INIT MSG 05150CSR SETOF 50 05160CSR ERRCNT SUB 1 ERRCNT 54 54 05170CSR 54 GOTO SR76 05180CSR Z-ADD0 ERRCNT 05190CSR END76 ENDSR 05200C********************************************************************* 05210CSR SR80 BEGSR 05220C* GET WMMAST. 05230CSR SETOF 61 05240CSR TWOP CHAINWMMAST 60 05250CSRN60 WMSTAT COMP 'D' 61 ÐÐ05260CSR ENDSR 05270C******************************************************************** 05280CSR SR81 BEGSR 05290C* GET PART MASTER. 05300CSR MOVE ' ' W12A 05310CSR W12A CHAINPMMST2 60 05320CSRN60 PMSTAT COMP 'D' 60 05330CSRN60 PMACNT COMP 12100 41 05340CSRN60 PMACNT COMP 14100 42 05350CSRN60 PMACNT COMP 14600 43 05360CSR 60 MOVE BLK8 OLDLOC 6 05370CSRN60 MOVE PMSLOC OLDLOC STOCK LOCATION 05380CSR ENDSR 05390C******************************************************************** 05400CSR SR83 BEGSR 05410C* UPDATE PART MASTER, WMISSUE AND STOCK LOCATION. 05420CSRN70 GOTO T83A NOT INVENTORY ITEM 05430CSR MOVE OLDLOC W6A 6 05440CSR EXSR SR84 GET STKLOC FILE 05450CSRN60 MOVE 'D' SLSTAT 05460CSRN60 EXSR SR87 DELETE OLD LOCATION 05470CSR PMSLOC COMP ' ' 54 05480CSRN54 GOTO T83A NO NEW STOCK LOC 05490CSR MOVE PMSLOC W6A 05500CSR EXSR SR84 GET STKLOC FILE ÐÐ05510CSR MOVE 'A' SLSTAT 05520CSR EXSR SR87 ADD STKLOC FILE 05530C*------------------------------------------------------------------ 05540CSR T83A TAG 05550CSR MOVELTWO W11A 11 05560CSR MOVE '00' W11A 05570CSR MOVE W11A W21A 21 05580CSR 70 MOVELTPN W21A 05590CSRN70 MOVELZERO10 W21A 05600CSR W21A CHAINWMISSUE 60 05610CSRN60 TQTY ADD WURCM WURCM 05620CSRN60 TQTY ADD WURTOT WURTOT 05630CSR PMOHB COMP 0 54 LESS THAN 05640CSR 54 Z-ADD563 M 05650CSR 54 EXSR SR74 PUT WARNING 05660CSR SETON 83 05670CSR EXCPT UPDATE PMMST2 & 05680CSR SETOF 83 WMISSUE 05690CSR MOVELW21A W10A 10 05700CSR MOVE W21A W11A 05710CSR MOVELW11A W21A 05720CSR MOVE W10A W21A 05730CSR W21A CHAINWUKEY 60 05740CSR SETON 84 05750CSR EXCPT UPDATE WUKEY ÐÐ05760CSR SETOF 84 05770CSR ENDSR 05780C***************************************************************** 05790CSR SR84 BEGSR 05800C* GET STOCK LOCATION ALT-KEY FILE (STKLOC) 05810CSR MOVELW6A W16A 16 05820CSR MOVE PMPN W16A 05830CSR W16A CHAINSTKLOC 60 GET STKLOC FILE 05840CSR ENDSR 05850C******************************************************************** 05860CSR SR85 BEGSR 05870C* GET PROJECT MAST. 05880CSR MOVELTWO W12A 12 05890CSR MOVE '620' W12A 05900CSR W12A CHAINPJMAST 60 05910CSRN60 PJSTAT COMP 'D' 61 05920CSR ENDSR 05930C******************************************************************** 05940CSR SR86 BEGSR 05950C* GET GLMAST. 05960CSR SETOF 61 05970CSR TWO CHAINGLMAST 60 05980CSRN60 GLSTAT COMP 'D' 61 05990CSR ENDSR 06000C****************************************************************** ÐÐ06010CSR SR87 BEGSR 06020C* UPDATE STOCK LOCATION ALT-KEY FILE (STKLOC) 06030CSR SETON 87 06040CSR EXCPT UPDATE STKLOC FILE 06050CSR SETOF 87 06060CSR ENDSR 06070C******************************************************************** 06080CSR SR89 BEGSR 06090C* GET MESSAGE MASTER 06100CSR M CHAINMGFILE 54 06110CSR 54 MOVE BLK35 MGTEXT 06120CSR 54 MOVELM MGTEXT 06130CSR 54 MOVE MES,1 MGTEXT 06140CSR ENDSR 06150C*********************************************************************** 06160CSR SR101 BEGSR 06170C* 1-TIME INITIALIZE 06180CSR MOVE BIT,1 NUL 06190CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 06200CSR Z-ADD6 FLIMIT 30 TOTAL NUMB FIELDS 06210CSR MOVE ' ' BLK12 12 06220C* GET PORT # AND CRTFILE 06230CSR MOVE ' ' W8A 8 06240CSR Z-ADD0 W2N 20 06250CSR Z-ADD0 W1N 10 ÐÐ06260CSR MOVE ' ' W2A 2 06270CSR EXITFPGMINX GET PORT # 06280CSR RLABL W8A 06290CSR RLABL W2N 06300CSR RLABL W1N 06310CSR RLABL W2A 06320CSR MOVE W2A PORT 20 PORT NO. 06330CSR PORT COMP 0 54 06340CSRN54 Z-ADD25 PORT DEFAULT 06350CSR PORT CHAINCRTFILE H9 06360C* DEFINE WORK FIELDS,ETC. 06370CSR MOVE ' ' BLK35 35 06380CSR Z-ADD0 ZERO9 9 06390CSR MOVELUDATE W4N 40 06400CSR MOVE UDATE W2N 20 06410CSR MOVELW2N TODAY 60 06420CSR MOVE W4N TODAY 06430CSR MOVE ' ' BLK16 16 06440CSR MOVE ' ' BLK8 8 06450CSR Z-ADD0 ZERO10 100 06460CSR ENDSR 06470C********************************************************************** 06480CSR SR102 BEGSR 06490C* VALIDATE FIELD NO. 06500CSR F COMP 0 54 ÐÐ06510CSRN54 Z-ADD1 F 06520CSR F COMP FLIMIT 55 06530CSR 55 Z-ADD1 F 06540CSR 55 GOTO END102 06550CSR F COMP 6 55 06560CSR END102 ENDSR 06570C******************************************************************** 06580CSR SR103 BEGSR 06590C* MOVE INPUT DATA 06600CSR EXSR SR201 IDENTIFY-F 06610CSR EXSR SR202 R. JUSTIFY 06620CSR 01 EXSR SR210 BUILD WORK ORDER 06630CSR 02 MOVE W10A TDEPT 30 DEPT # 06640CSR 03 MOVELW16A TTYPE 1 REASON CODE 06650CSR 04 MOVE W10A TPN 100 PART # 06660CSR 05 MOVE W10A TQTY 70 QTY RECEIVED 06670CSR 06 MOVELW16A PMSLOC STOCK LOCATION 06680CSR MOVE ' ' DUN,F EDIT FLAG 06690CSR ENDSR 06700C******************************************************************** 06710CSR SR104 BEGSR 06720C* EDIT INPUT DATA 06730CSR 01 EXSR SR1 06740CSR 02 EXSR SR2 06750CSR 03 EXSR SR3 ÐÐ06760CSR 04 EXSR SR4 06770CSR 05 EXSR SR5 06780CSR 96 MOVE ' ' DUN,F EDIT FLAG 06790CSRN96 MOVE 'X' DUN,F 06800CSR ENDSR 06810C*********************************************************************** 06820CSR SR105 BEGSR 06830C* FINAL EDIT 06840CSR SETOF 77 06850CSR SETON 79 FINAL EDIT FLAG 06860CSR Z-ADD1 F 96 06870C*-------------------------------------------------------------------- 06880CSR T105A TAG 06890CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06900CSRN54 GOTO END105 06910CSR EXSR SR201 IDENTIFY-F 06920CSR EXSR SR104 EDIT 06930CSRN96 GOTO T105A 06940C*-------------------------------------------------------------------- 06950CSR END105 TAG 06960CSR SETOF 79 06970CSR ENDSR 06980C******************************************************************** 06990CSR SR106 BEGSR 07000C* UPDATE. ÐÐ07010CSR TQTY COMP 0 54 07020CSR 54 PMOHB ADD TQTY PMOHB ON HAND STK 07030CSR 54 TQTY ADD PMURCT PMURCT QTY UNPLAN RCPTS 07040CSR 54 1 ADD PMQRCT PMQRCT FREQ UNPLAN RCPTS 07050CSR EXSR SR83 UPD PMMST/MATL DIST 07060CSR ENDSR 07070C************************************************************************ 07080CSR SR201 BEGSR 07090C* IDENTIFY FIELD NO. 07100CSR F COMP 1 01 07110CSR F COMP 2 02 07120CSR F COMP 3 03 07130CSR F COMP 4 04 07140CSR F COMP 5 05 07150CSR F COMP 6 06 07160CSR ENDSR 07170C********************************************************************** 07180CSR SR202 BEGSR 07190C* RIGHT JUSTIFY 07200CSR F LOKUPNUM 54 07210CSRN54 GOTO END202 NOT NUMERIC FIELD 07220CSR Z-ADD10 W2N 20 07230CSR MOVELW16A W10A 10 07240CSR EXIT SUBRAJ R. JUSTIFY 07250CSR RLABL W2N ÐÐ07260CSR RLABL W10A 07270CSR END202 ENDSR 07280C**************************************************************************07290CSR SR210 BEGSR 07300C* BUILD WORK ORDER. 07310CSR MOVE ' ' A16 07320CSR MOVEAW16A A16 07330CSR Z-ADD1 W 07340CSR '-' LOKUPA16,W 54 07350CSR MOVE ' ' W4A 4 07360CSR 54 MOVEAA16,W W4A 07370CSR 54 MOVEL' ' W4A 07380CSR 54 MOVEABLK16 A16,W 07390CSR Z-ADD4 W2N 07400CSR EXIT SUBRAJ R.J. 07410CSR RLABL W2N 07420CSR RLABL W4A 07430CSR MOVE W4A TWOD 30 WORK ORDER DASH 07440CSR Z-ADD1 W 07450CSR ' ' LOKUPA16,W 54 07460CSRN54 Z-ADD1 W 07470CSR A16,W COMP '0' 54 54 07480CSRN54 MOVEAA16,W TWOP 6 07490CSRN54 MOVE TWOP W5A 5 07500CSR 54 MOVEAA16,W W5A ÐÐ07510CSR 54 MOVEL' ' TWOP 07520CSR Z-ADD5 W2N 07530CSR EXIT SUBRAJ R.J. 07540CSR RLABL W2N 07550CSR RLABL W5A 07560CSR MOVE W5A TWOP 07570CSR MOVELTWOP TWO 9 07580CSR MOVE TWOD TWO 07590CSR MOVELTWOP PREFIX 1 07600CSR END210 ENDSR 07610O******************************************************************** 07620OTERM132 E 71 07630O BIT,28 1 07640O 8 '8091001' 07650O* LINE 1 07660O 83 'UNPLANNED STOCK RECEIPTS' 07670O UDATE Y 16 07680O*------------------------------------------------------------------- 07690O E 71 07700O* LINE 2 07710O 1 ' ' 07720O*------------------------------------------------------------------- 07730O E 71 07740O OR 72 01 07750O* LINE 3 ÐÐ07760O 15 '(1) WORK ORDER' 07770O 22 ':' 07780O TWOP 30 07790O 55 31 '-' 07800O 55 TWOD 34 07810O*------------------------------------------------------------------- 07820O E 71 07830O OR 72 02 07840O* LINE 4 07850O 21 '(2) FROM DEPT NO. ' 07860O 22 ':' 07870O TDEPT Z 27 07880O DEPNAM 55 07890O*------------------------------------------------------------------- 07900O E 71 07910O OR 72 03 07920O* LINE 5 07930O 16 '(3) REASON CODE' 07940O 22 ':' 07950O TTYPE 25 07960O* * * * * TYPNAM 55 07970O*------------------------------------------------------------------- 07980O E 71 07990O* LINE 6 08000O 1 ' ' ÐÐ08010O*------------------------------------------------------------------- 08020O E 71 08030O* LINE 7 08040O 55 'QUANTITY' 08050O 69 'QUANTITY' 08060O 77 'STOCK' 08070O*------------------------------------------------------------------- 08080O E 71 08090O* LINE 8 08100O 8 'PART-NO.' 08110O 25 'DESCRIPTION' 08120O 54 'ON-HAND' 08130O 69 'RECEIVED' 08140O 79 'LOCATION' 08150O*------------------------------------------------------------------- 08160O E 71 08170O* LINE 9 08180O 5 '(4)' 08190O 67 '(5)' 08200O 76 '(6)' 08210O*------------------------------------------------------------------- 08220O E 71 08230O* LINE 10 08240O 1 ' ' 08250O*------------------------------------------------------------------- ÐÐ08260O E 72 04 08270O OR 72 05 08280O* LINE-11 UP-- DO NOT USE LINE 120 08290O TPN 12 ' - - ' 08300O PMDESC 43 08310O PMOHB K 55 08320O PMSLOC 66 08330O 41 89 'FIN-GOODS' 08340O 42 92 'PURCH-PARTS' 08350O 43 88 'SUB-ASSY' 08360O TQTY 2 69 08370O PMSLOC 78 08380O*------------------------------------------------------------------- 08390O* 08400O E 73 08410O* WRITE AT CUR LINE + 1 08420O MGTEXT 35 08430O BIT,28 131 08440O 132 'K' 08450O******************************************************************** 08460OPMMST2 E 83 08470O PMACNT 112P 08480O PM$ 219P 08490O PMOHB 314P 08500O PMURCT 386P ÐÐ08510O PMQRCT 415P 08520O PMOSUC 493P 08530O PMSLOC 626 08540O********************************************************************* 08550OSTKLOC EADD 87 60 08560O W16A 16 08570O 17 'A' 08580O*-------------------------------------------------------------------- 08590O E 87N60 08600O SLSTAT 17 08610O****************************************************************** 08620OSFPNA EADD 83 08630O TPN 10 08640O******************************************************************* 08650OWUKEY EADD 84 60 08660O W21A 21 08670O 22 'A' 08680O*------------------------------------------------------------------ 08690O E 84N60 08700O 22 'A' 08710O******************************************************************** 08720OWMISSUE EADD 83 60 08730O W21A 21 08740O ZERO7 25P 08750O ZERO7 29P ÐÐ08760O TQTY 33P 08770O ZERO7 37P 08780O ZERO7 41P 08790O ZERO7 45P 08800O TQTY 49P 08810O ZERO7 53P 08820O ZERO7 59P 08830O*------------------------------------------------------------------ 08840O E 83N60 08850O WUPCM 25P 08860O WUUCM 29P 08870O WURCM 33P 08880O WUSCM 37P 08890O WUPTOT 41P 08900O WUUTOT 45P 08910O WURTOT 49P 08920O WUSTOT 53P 08930O WUREQD 59P ** NUL ARRAY 008940 008950** A16 ARRAY 008960 008970** NUM ARRAY 008980002 DEPT 008990004 PART NO 009000ÐÐ005 QTY ISS 009010** LOC ARRAY 09020093 CHARGE NO 1 09030094 DEPT 2 09040095 TYPE (REASON) 3 09050** A9 ARRAY 09060 09070** COL ARRAY 09080025 WO# 1 09090025 DEPT 2 09100025 REASON CODE 3 09110001 PART NO. 4 09120062 QTY RECEIVED 5 09130074 STOCK LOCATION 6 09140** DUN ARRAY 09150 009160** MES ARRAY 009170---MESSAGE NOT ON FILE--- 009180/* 09190_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ('  XTIME P999999120282(èÈÐ00010H TIME 00020F* PUT TIME AND DATE TO TERMINAL 00030FBITTAB IP F 33 DISK 00040FTERM35 O F 35 5 00050IBITTAB BT 00060I 1 1 BIT 00070C TIME TIME 60 00080C EXCPT 00090OTERM35 E 00100O TIME 9 ' : : ' 00110O UDATE 25 ' - - ' /* _‚ ÐÐ_‚_‚0H TIME 00020F* PUT TIME AND DATE TO TERMINAL 00030FBITTAB IP F 33 DISK 00040FTERM35 O F 35 5 00050IBITTAB BT 00060I 1 1 BIT 00070C TIME TIME 60 00080C EXCPT 00090OTERM35 E 00100O TIME 9 ' : : ' 00110O UDATE 25 ' - - ' /* _‚ ÐÈ(Š3 ŠX012BM P999999120282(èÈÐ00010H Q012BM00020F* DISPLAY INDENTED PARTS LIST, SUB-ASSY'S ONLY. (X012BM) 00030F* REVISED 8-11-82 3:40 PM. 00040F* MENU: QQBM02 00050F* MENU: MQBM02 00060FBITPAR IP F 90 DISK 00070FCRTFILE UC F 256R DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FBMMAST ID F 86L20AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E NUL 50 50 1 NULL CHAR. 00140E N20 20 20 1 NULL CHAR. 00150E A12 12 12 1 A INPUT ARRAY. 00160E LEV 1 20 20 NEXT RRN AT EA LEVEL 00170E QTY 1 20 7 0 QTY MULTIPLIER 00180E LNK 1 7 6 A 00190E CALL 7 6 00200E PAR 25 1 00210E TST 25 1 00220E BIT 33 1 BITTAB. 00230I******************************************************************** 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************** 00290ICRTFILE CR 00300I 28 330CRTIME 00310I 34 370CRDATE 00320I 38 79 CALL 00330I******************************************************************** 00340IPMMST2 PM 00350I* PART MASTER RECORD (XPMMST) 00360I* KEY AREA 00370I* PART NO. 12A 00380I 1 12 PMPN 00390I* NUMB OF COMPONENTS 3P 00400I P 13 140PMNOBM 00410I* PROD LINE 4N 00420I 15 180PMPL 00430I* MODEL NAME 12A 00440I 19 30 PMMODL 00450I* DESCRIPTION 29A 00460I 31 59 PMDESC 00470I* COMMODITY CODE 9P 00480I P 60 640PMCC 00490I* ENG CHANGE STATUS. 00500I* CUR CHG LEVEL 2A ÐÐ00510I 70 71 PMECHG 00520I* CUR CHG DATE 6N 00530I 72 770PMDCHG 00540I* LAST ECN NO. 5A 00550I 65 69 PMECN 00560I* DRAWING INFO 00570I* DWG SIZE 1A 00580I 82 82 PMSIZ 00590I* DWG CLASS 1A 00600I* D = DYNAIR DWG 00610I* V = VENDOR DWG 00620I 83 83 PMDCLS 00630I* STANDARD CODE 1A 00640I 84 84 PMSTDC 00650I* DWG REL CODE 1A 00660I* E = ENG ONLY 00670I* M = REL TO MFG 00680I* P = PROTOTYPE 00690I 78 78 PMDREL 00700I* UNIT MEAS 2A 00710I* EA = EACH OC = OUNCE 00720I* ST = SET TC = TROY OUNCE 00730I* IN = INCH LB = POUND 00740I* FT = FEET PT = PINT 00750I* YD = YARD QT = QUART ÐÐ00760I* SI = SQ.INCH GL = GALLON 00770I* SF = SQ.FEET DR = DRUM 00780I* SY = SQ.YARD 00790I 85 86 PMUM 00800I* SOURCE CODE 2A 00810I* MA = MFG ASSY 00820I* MP = MFG PART 00830I* PA = PURCH ASSY 00840I* PP = PURCH PART 00850I* RS = RAW STOCK 00860I 94 95 PMSC 00870I* PROVISIONING CODE 1A 00880I* A = FORECAST,NO VALUE ADDED 00890I* B = FORECAST,VALUE ADDED 00900I* C = BUILD TO ORDER (B) 00910I* D = BUILD TO ORDER (NOT B) 00920I* E = CUSTOM 00930I* Y = OBSOLETE,REPAIRABLE 00940I* Z = OBSOLETE,NOT REPAIRABLE 00950I 96 96 PMPROV 00960I* ISSUE CODE 2A 00970I* PT = PULL TIME 00980I* OR = ON REQUEST 00990I* BI = BULK ISSUE 01000I* AR = AS REQUIRED ÐÐ01010I* VS = VENDOR SUPPLIED 01020I* SD = SHIPPING DOCUMENT 01030I* TD = TRAV DOCUMENT 01040I* RD = REF DOCUMENT 01050I* RA = REF ASSY 01060I 97 98 PMISSU 01070I* DELIVER TO DEPT 5P 01080I P 99 1010PMDEL 01090I* RESPONSIBILITY CODES 01100I* ENGR CODE 2A 01110I 102 103 PMEGR 01120I* PLANNER CODE 2A 01130I 104 105 PMPLNR 01140I* BUYER CODE 2A 01150I 106 107 PMBUYR 01160I* SALESMAN CODE 2A 01170I 108 109 PMSLSM 01180I* INVENTORY ACCOUNT 5P 01190I P 110 1120PMACNT 01200I* FAB CODE 2A 01210I 487 488 PMFABC 01220I* RECORD STATUS 1A 01230I* D = DELETED 01240I 674 674 PMSTAT 01250I******************************************************************** ÐÐ01260IBMMAST BM 01270I* BILL OF MATERIAL RECORD 01280I* KEY AREA 01290I* ASSY PART NO. 10N 01300I 1 100BMAPN 01310I* COMPONENT PART # 10N 01320I 11 200BMCPN 01330I* ITEM NO. 3N 01340I 25 270BMITNO 01350I* QTY PER ASSY 7P 01360I P 28 310BMQTY 01370I* SCRAP ALLOW .2N 01380I 34 352BMSCRP 01390I* ISSUE CODE 2A 01400I* PT = PULL TIME 01410I* OR = ON REQUEST 01420I* BI = BULK ISSUE 01430I* AR = AS REQUIRED 01440I* RA = REF ASSY 01450I* TD = TRAV DOC 01460I* SD = SHIP DOC 01470I* RD = REF DOC 01480I* VS = VENDOR SUPPLIED 01490I 36 37 BMISSU 01500I* EFFECTIVITY. ÐÐ01510I* BEGIN CHANGE LEVEL 2A 01520I 38 39 BMBCHG 01530I* ENDING CHANGE LEVEL 2A 01540I 40 41 BMECHG 01550I* BEGIN ECN # 5A 01560I 42 46 BMBECN 01570I* ENDING ECN # 5A 01580I 47 51 BMEECN 01590I* DISPOSITION CODE 1A 01600I* U = USE UP OLD STYLE 01610I* N = NOW (IMMEDIATE) 01620I 52 52 BMDISP 01630I* FILLER 5A 53 57 FFFFFF 01640I* ROUTING. 01650I* OPER NO. 5P 01660I P 58 600BMOPER 01670I* DEPT NO. 5P 01680I P 61 630BMDEPT 01690I* WORK CENTER NO. 3P 01700I P 64 650BMWC 01710I* COMPONENT OPER REFERENCE INFO 10A 01720I 66 75 BMREF 01730I* FILLER 10A 76 85 FFFFFF 01740I* 01750I* RECORD STATUS 1A ÐÐ01760I* D = DELETED 01770I 86 86 BMSTAT 01780I******************************************************************** 01790IMGFILE MG 01800I* MESSAGE FILE. 01810I* TEXT 35A 01820I 1 35 MGTEXT 01830I* LINE-2 35A 01840I 36 70 MGLIN2 01850I* PROG NAME 5A 01860I 71 75 MGPROG 01870C******************************************************************** 01880C* INITIALIZE 01890C EXSR SR101 INIT 01900C MOVE ' ' BLK6 6 STUPIDITY 01910C*---------------------------------------------------------------- 01920C START TAG 01930C* GET ASSY PART NO FROM TERMINAL 01940C SETOF 9693 01950C Z-ADD185 M 50 MSG # 01960C EXSR SR73 PROMPT 01970C EXSR SR75 READ 01980C 96 GOTO START ERROR 01990C 93 GOTO START NEW ITEM REQST 02000C N77 GOTO START NO INPUT ÐÐ02010C Z-ADD12 W2N 20 02020C EXIT SUBRAJ R. JUSITFY 02030C RLABL W2N 02040C RLABL W12A 02050C MOVE W12A TAPN 100 TOP ASSY PN 02060C MOVE BLK12 W12A 02070C MOVELTAPN W12A 02080C EXSR SR81 GET PMMST2 02090C N60 GOTO TAG10 GOT IT 02100C Z-ADD302 M 96 FLAG ERROR 02110C EXSR SR73 PUT MSG 02120C GOTO START 02130C*-------------------------------------------------------------------- 02140C TAG10 TAG 02150C* FLAG NO COMPONENTS ON FILE 02160C PMNOBM COMP 0 55 02170C N55 Z-ADD316 M 50 02180C N55 EXSR SR73 PUT ERR MSG 02190C N55 GOTO START 02200C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02210C Z-ADD1 QTY,2 QTY MULTIPLIER 02220C SETON 89 02230C EXSR SR71 PUT HEADING 02240C SETOF 89 02250C* SET-UP INITIAL BILL MATERIAL READ ÐÐ02260C Z-ADD3 L 20 INDENTURE LEVEL 02270C MOVE BLK20 LEV 02280C MOVELTAPN LEV,2 02290C*----------------------------------------------------------------- 02300C TAG20 TAG 02310C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02320C L SUB 1 L 54 INDENT LEVEL 02330C N54 GOTO ENDASY BOTTOM INDENT 02340C LEV,L COMP BLK20 54 02350C N54 GOTO TAG20 NONE THIS LEVEL 02360C MOVE LEV,L W20A 20 02370C MOVELLEV,L CURASY 100 MATCH PART # 02380C MOVE BLK20 LEV,L 02390C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02400C*------------------------------------------------------------------ 02410C TAG30 TAG 02420C* SET-UP NEXT READ 02430C W20A SETLLBMMAST 02440C*--------------------------------------------------------------- 02450C TAG40 TAG 02460C* GET NEXT COMPONENT. 02470C SETOF 54 02480C READ BMMAST 54GET COMPONENT 02490C 54 GOTO TAG20 END OF FILE 02500C BMAPN COMP CURASY 54 ÐÐ02510C N54 GOTO TAG20 WRONG ASSY 02520C BMSTAT COMP 'D' 54 02530C 54 GOTO TAG40 DELETED RECORD 02540C* DISPLAY COMPONENT DATA 02550C EXSR SR72 DISPLAY DATA 02560C 93 GOTO START 02570C* BRANCH IF NOT ASSY 02580C PMNOBM COMP 0 54 02590C N54 GOTO TAG40 NOT ASSY 02600C*------------------------------------------------------------------- 02610C TAG50 TAG 02620C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02630C MOVELBMAPN LEV,L 02640C 1 ADD BMCPN W10N 100 02650C MOVE W10N LEV,L 02660C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02670C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02680C MOVE BMCPN CURASY 02690C MOVELBMCPN W20A 02700C MOVE ZERO10 W20A 02710C 1 ADD L L INDENT LEVEL 02720C GOTO TAG30 02730C*------------------------------------------------------------------ 02740C ENDASY TAG 02750C* END OF ASSY PROMPT ÐÐ02760C EXSR SR76 END ASSY PROMPT 02770C GOTO START 02780C*----------------------------------------------------------------- 02790C MENU TAG 02800C* SET RETURN TO MENU LINKAGE 02810C EXSR SR96 GET CRTFILE 02820C Z-ADD1 W 02830C BLK6 LOKUPLNK,W 54 02840C 54 MOVELLNK,W PROG 8 02850C 54 MOVE BLK6 LNK,W 02860C N54 MOVEL'CONTU' PROG 02870C EXSR SR97 UPD CRTFILE 02880C EXSR SR98 >>>>>>>>>> 02890C*----------------------------------------------------------------- 02900C GOODBY TAG 02910C* SET ABORT LINKAGE 02920C MOVEL'GOODBY' PROG 02930C GOTO END 02940C*----------------------------------------------------------------- 02950C END TAG 02960C* LINK TO NEXT PROG 02970C EXSR SR96 GET CRTFILE 02980C EXSR SR97 UPD CRTFILE 02990C EXSR SR98 >>>>>>>>>> 03000C*------------------------------------------------------------------ ÐÐ03010C ENDJOB TAG 03020C MOVEL'ENDJOB 'PROG 03030C EXSR SR98 >>>>>>>>>> 03040C******************************************************************** 03050CSR SR69 BEGSR 03060CSR 50 EXITFZPUTXY 03070CSR RLABL RPGLIN 03080CSR RLABL RPGCOL 03090CSRN50 EXITFZMOVXY 03100CSR RLABL RPGLIN 03110CSR RLABL RPGCOL 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR70 BEGSR 03150CSR 50 EXITFZISTAT 03160CSR 50 EXITFZESCH 03170CSRN50 EXITFZCPAGE 03180CSRN50 MOVEL'091' RPGLIN 4 03190CSRN50 MOVEL'001' RPGCOL 4 03200CSRN50 EXSR SR69 MOVE CURSOR 03210CSR ENDSR 03220C******************************************************************** 03230CSR SR71 BEGSR 03240C* CLEAR CRT. PUT HEADINGS. 03250CSR EXSR SR70 CLEAR SCREEN ÐÐ03260CSR Z-ADD4 COUNT 30 LINE COUNT 03270CSR MOVELTAPN W12A 03280CSR MOVE ' ' W12A 03290CSR EXSR SR81 GET TOP-ASSY PMMST2 03300CSR SETON 71 03310CSR EXCPT PUT HEADING 03320CSR SETOF 71 03330CSR SETON 75 03340CSR EXCPT PUT TOP ASSY DATA 03350CSR SETOF 75 03360CSR ENDSR 03370C******************************************************************** 03380CSR SR72 BEGSR 03390C* DISPLAY DATA LINE TO CRT. 03400CSR SETOF 779093 03410CSR MOVE BLK12 W12A 03420CSR MOVELBMCPN W12A COMP PN 03430CSR EXSR SR81 GET PMMST2 03440C* BYPASS IF NOT ASSY. 03450CSR PMNOBM COMP 0 54 03460CSRN54 GOTO END72 NOT ASSY 03470CSR 1 ADD COUNT COUNT 30 LINE COUNT 03480CSR L COMP 1 0101 03490CSR L COMP 2 02 03500CSR L COMP 3 03 ÐÐ03510CSR L COMP 4 04 03520CSR L COMP 5 05 03530CSR L COMP 6 06 03540CSR L COMP 7 07 07 03550CSR 01 Z-ADD1 L 03560CSR BMISSU COMP ' ' 55 03570CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03580CSR SETON 72 03590CSR EXCPT PUT DATA. 03600CSR SETOF 72 03610CSR 50 COUNT COMP 23 54 03620CSRN50 COUNT COMP 28 54 54 03630CSRN54 GOTO END72 NOT END PAGE 03640CSR EXITFQEPAGE END PAGE MSG 03650CSR EXSR SR75 READ 03660CSR 93 GOTO END72 03670CSR EXSR SR71 PUT HEADINGS 03680CSR END72 ENDSR 03690C******************************************************************** 03700CSR SR73 BEGSR 03710C* PUT PROMPT TO CRT. 03720CSR EXSR SR89 03730CSR 54 MOVELM MGTEXT 03740CSR 2 ADD COUNT COUNT 03750CSR SETON 73 ÐÐ03760CSR EXCPT PUT PROMPT. 03770CSR SETOF 73 03780CSR ENDSR 03790C******************************************************************** 03800CSR SR75 BEGSR 03810C* READ CRT. 03820CSR T75 TAG 03830CSR SETOF 9093 03840CSR SETOF 7796 03850CSR MOVE BLK12 W12A 12 03860CSR EXITFZR12 03870CSR RLABL W12A 03880CSR MOVEAW12A A12 03890CSR MOVE BLK12 W12A 03900CSR Z-ADD1 W 20 03910CSR '\' LOKUPA12,W 90 03920CSRN90 GOTO T75A NOT ESC. 03930CSR 1 ADD W W 03940CSR W COMP 12 54 03950CSR 54 GOTO T75C BAD ESC. 03960CSR A12,W COMP 'E' 94 EXIT. 03970CSR A12,W COMP 'N' 93 NEW ASSY. 03980CSR A12,W COMP 'G' 98 GOODBY 03990CSR 98 GOTO GOODBY 04000CSR 94 GOTO MENU ÐÐ04010CSR 93 GOTO END75 04020CSR GOTO T75C BAD ESCAPE 04030C*------------------------------------------------------------------- 04040CSR T75A TAG 04050CSR Z-ADD1 W 04060CSR ' ' LOKUPA12,W 77 04070CSR 77 MOVEAA12,W W12A INPUT DATA. 04080CSR GOTO END75 04090C*------------------------------------------------------------------- 04100CSR T75C TAG 04110C* FLAG BAD ESCAPE. 04120CSR Z-ADD318 M 96 04130CSR EXSR SR73 FLAG ERROR. 04140CSR GOTO T75 04150CSR END75 ENDSR 04160C******************************************************************** 04170CSR SR76 BEGSR 04180C* END OF ASSY PROMPT/READ. 04190CSR Z-ADD317 M 04200CSR EXSR SR73 PUT MSG. 04210CSR EXSR SR75 04220CSR ENDSR 04230C******************************************************************** 04240CSR SR81 BEGSR 04250C* GET PART MAST. ÐÐ04260CSR SETOF 61 04270CSR W12A CHAINPMMST2 60 GET PMMST. 04280CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 04290CSR ENDSR 04300C******************************************************************** 04310CSR SR89 BEGSR 04320C* GET MGFILE. 04330CSR M CHAINMGFILE 54 GET MGFILE. 04340CSR 54 MOVE BLK35 MGTEXT 04350CSR 54 MOVELM MGTEXT 04360CSR 54 MOVE 'NO MSG' MGTEXT 04370CSR ENDSR 04380C******************************************************************** 04390CSR SR96 BEGSR 04400CSR # CHAINCRTFILE H9 GET CRTFILE 04410CSR H9 GOTO ENDJOB 04420CSR ENDSR 04430C******************************************************************** 04440CSR SR97 BEGSR 04450C* UPDATE CRTFILE. EXIT PROGRAM. 04460CSR TIME CRTIME 04470CSR MOVELUDATE CRDATE 04480CSR SETON 97 04490CSR EXCPT UPD CRTFILE 04500CSR SETOF 97 ÐÐ04510CSR ENDSR 04520C******************************************************************** 04530CSR SR98 BEGSR 04540CSR EXSR SR70 CLEAR SCREEN 04550CSR EXITFCHAIN >>>>>>>>>> 04560CSR RLABL PROG 04570CSR ENDSR 04580C******************************************************************** 04590CSR SR101 BEGSR 04600C* INITIALIZE (1-TIME). 04610CSR MOVE BIT,1 N20 04620CSR MOVE BIT,1 NUL INIT NULL CHAR. 04630CSR MOVE ' ' W2A 2 04640CSR EXITFZGMINX 04650CSR RLABL W2A 04660CSR MOVE W2A # 20 04670CSR # COMP 0 54 04680CSRN54 Z-ADD25 # 04690CSR EXSR SR96 GET CRTFILE 04700CSR MOVE CALL LNK 04710CSR MOVE 'Q012BM 'PROG 04720CSR PAR,# COMP '1' 50 04730CSR TST,# COMP 'S' 54 04740CSR 54 MOVE 'SHUTDOWN'PROG 04750CSR EXSR SR97 UPD CRTFILE ÐÐ04760CSR 54 EXSR SR98 >>>>>>>>>> 04761CSR MOVE ' 'PROG 04770CSR MOVE ' ' BLK35 35 04780CSR MOVE ' ' BLK12 12 04790CSR MOVE ' ' BLK20 20 04800CSR Z-ADD0 ZERO10 100 04810CSR ENDSR 04820O******************************************************************** 04830OTERM132 E 72 04840O* DATA LINE. 04850O 11 '.' 04860O 14 '.' 04870O 17 '.' 04880O 20 '.' 04890O 23 '.' 04900O 26 '.' 04910O 29 '.' 04920O 02 29 ' ' 04930O 03 29 ' ' 04940O L Z 2 04950O BMITNOZ 8 04960O 01 BMCPN 22 ' - - ' 04970O 02 BMCPN 25 ' - - ' 04980O 03 BMCPN 28 ' - - ' 04990O 04 BMCPN 31 ' - - ' ÐÐ05000O 05 BMCPN 34 ' - - ' 05010O 06 BMCPN 37 ' - - ' 05020O 07 BMCPN 40 ' - - ' 05030O PMDESC 71 05040O BMQTY 2 82 05050O PMUM 86 05060O PMSC 92 05070O PMISSU 98 05080O 55 BMISSU 98 05090O PMPROV 103 05100O EXTQTY2 115 05110O PMSTDC 119 05120O PMFABC 125 05130O*------------------------------------------------------------------- 05140O E 75 05150O* PUT TOP ASSY LINE. 05160O 2 '1' 05170O TAPN 22 ' - - ' 05180O N89 29 'CONT''D' 05190O PMDESC 71 05200O 82 '1' 05210O PMUM 86 05220O PMISSU 98 05230O PMSC 92 05240O PMPROV 103 ÐÐ05250O 115 '1' 05260O PMSTDC 119 05270O PMFABC 125 05280O*------------------------------------------------------------------- 05290O E 73 05300O* PUT ERROR MESSAGE. 05310O NUL 50 05320O NUL 100 05330O NUL 132 05340O MGTEXT 35 05350O 37 ' ' 05360O*------------------------------------------------------------------- 05370O E 71 05380O* CLEAR SCREEN - LINE-1. 05390O BIT,28 1 05400O N50 8 '8091001' 05410O N50 BIT,1 9 05420O N50 BIT,1 10 05430O 50 10 '[001 ]001' 05440O 50 BIT,28 6 05450O UDATE 18 ' - - ' 05460O 81 'INDENTED ASSY LIST ' 05470O 89 'ASSY=' 05480O TAPN 101 ' - - ' 05490O*------------------------------------------------------------------- ÐÐ05500O E 71 05510O* HEADING, LINE-2. 05520O 26 '--------------INDENTURE' 05530O 40 '--------------' 05540O 82 'QUANTITY' 05550O 94 'SOURCE' 05560O 100 'ISSUE' 05570O 105 'PROV' 05580O 115 'EXTENDED' 05590O 120 'STD' 05600O 126 'FAB' 05610O*------------------------------------------------------------------- 05620O E 71 05630O* HEADING, LINE-3. 05640O 3 'LEV' 05650O 8 'ITEM' 05660O 29 '1 2 3 4 5 6 7' 05670O 32 '-UP' 05680O 53 'DESCRIPTION' 05690O 82 'PER-ASSY' 05700O 86 'UM' 05710O 93 'CODE' 05720O 99 'CODE' 05730O 105 'CODE' 05740O 115 'QUANTITY' ÐÐ05750O 121 'CODE' 05760O 127 'CODE' 05770O E 71 05780O* HEADING, LINE-4 (BLANK). 05790O 1 ' ' 05800O******************************************************************** 05810OCRTFILE E 97 05820O PROG 26 05830O CRTIME 33 05840O CRDATE 37 05850O LNK 79 ** NUL ARRAY 005860 005870** N20 ARRAY 005880 005890** A12 ARRAY 005900 005910** LEV ARRAY 005920 005930** QTY ARRAY 005940 005950** LNK ARRAY 005960 05970/* 05980_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(@C @›X012WM P999999120282(èÈÐ00010H Q012WM00020F* INPUT WORK ORDER RELEASE TRANSACTION. (X012WM) 00030F* REVISED 11-25-81 11:10 AM. 00040F* MENU: MQNS01 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FWMMAST UC F 470R 6AI 1 DISK A 00090FPMMST2 UC F 674R12AI 1 DISK 00100FSFMAST UC F 128R29AI 1 DISK A 00110FALTKEY UC F 32R29AI 1 DISK A 00120FWMLUWO UC F 8R 2AI 1 DISK 00130FCALENDARIC F 22R 7AI 1 DISK 00140FPRODWO IT F 80 EDISK 00150FWMUPDATEO F 16 DISK A 00160FWMPULL O F 46 12AI 1 DISK A 00170FSFPNA O F 10 DISK A 00180FTERM132 O F 132 5 00190E******************************************************************** 00200E PRODWO TABPWO 1 4 1 PROD WO PREFIXES 00210E NUL 1 132 1 NULL CHAR 00220E A16 16 16 1 A INPUT DATA ARRAY 00230E DUN 1 3 1 A EDIT CMPLT FLAG 00240E A29 29 29 1 00250E AK 29 29 1 ÐÐ00260E A9 9 9 1 00270E DOT 26 26 1 DIVIDER 00280E RCD 1 26 7 0A RECEIVED QTYS 00290E OPN 1 26 7 0A NOT RECD QTYS 00300E REL 1 26 7 0A RELEASED QTYS 00310E NR 1 26 7 0A NOT REL QTYS 00320E OLD 1 26 7 0A SAVE QTYS 00330E SVD 1 26 6 0 SAVE DATES 00340E SVL 1 26 3 0 SAVE LEAD TIMES 00350E NUM 1 1 3 0 NUMERIC FIELD NUMBERS 00360E BIT 33 1 SCREEN CONTR. CHAR 00370E WA$ 6 11 3 WMMAST $ ARRAYS 00380E WMD 26 6 0A SCHED DATES 00390E WMQ 26 7 0A SCHED QTYS 00400E WLT 26 3 0 SCHED LEAD TIMES 00410E PLT 8 3 0 PMMST LEAD TIMES 00420I******************************************************************* 00430IBITTAB BT 00440I 1 33 BIT 00450I******************************************************************* 00460IMGFILE MG 00470I* MESSAGE FILE. 00480I 1 35 MGTEXT 00490I******************************************************************** 00500ICALENDARCA 20 1 CC ÐÐ00510I* CALENDAR DATE RECORD. 00520I 2 70CACAL 00530I 14 170CAMDAY 00540I 18 200CAWK 00550I 21 220CADOW 00560I*------------------------------------------------------------------- 00570I CB 21 1 CM 00580I* MFG DATE RECORD. 00590I 4 70CAMDAY 00600I 8 130CACAL 00610I 18 200CAWK 00620I 21 220CADOW 00630I*------------------------------------------------------------------- 00640I GG 02 00650I******************************************************************** 00660IWMLUWO WL 00670I 3 70WLNO 00680I******************************************************************** 00690ICRTFILE CR 00700I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00710I* STD AREA - SAME FOR ALL PROGRAMS. 00720I* EMPLOYEE # 5N 00730I 1 50CREMPL 00740I* USER CODE 8A 00750I 6 13 CRUSER ÐÐ00760I* DEPT # 5N 00770I 14 180CRDEPT 00780I* JOB NAME 8A (JOB LOADED BY MENU) 00790I 19 26 CRJOB 00800I* SHUTDOWN FLAG 1A 00810I* BLANK = NO SHUTDOWN 00820I 27 27 CRSHUT 00830I* TIME STARTED 6N 00840I 28 330CRTIME 00850I* DATE STARTED 4N 00860I 34 370CRDATE 00870I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00880I 68 73 CRRET 00890I* MENU NAME 6A 00900I 74 79 CRMENU 00910I******************************************************************** 00920IPMMST2 PM 00930I* PART NUMBER 10N 00940I 1 100PMPN 00950I* NUMBER OF COMPONENTS 3P 00960I P 13 140PMNOBM 00970I* PROD LINE 4N 00980I 15 180PMPL 00990I* MODEL NO. 12A 01000I 19 30 PMMODL ÐÐ01010I* PART DESCRIPTION 29A 01020I 31 59 PMDESC 01030I* ENG CHANGE LEVEL 2A 01040I 70 71 PMECHG 01050I* DRAWING SIZE 1A 01060I 82 82 PMSIZE 01070I* SOURCE CODE 2A 01080I 94 95 PMSC 01090I* LEAD TIMES 3P X 8 01100I P 113 128 PLT 01110I* ON-HAND BALANCE 7P 01120I P 311 3140PMOHB 01130I* ALLOCATIONS 7P 01140I P 319 3220PMALB 01150I P 351 3540PMPWOB 01160I* W.O. BAL 7P 01170I P 355 3580PMRWOB 01180I* PLANNED RECEIPT QTYS 7P 01190I P 367 3700PMPRCT 01200I* PLANNED RECEIPT FREQ 5P 01210I P 401 4030PMFRCT 01220I* STD ACTG COST 9.3P 01230I P 489 4933PMOSUC 01240I* RECORD STATUS 1A 01250I 674 674 PMSTAT ÐÐ01260I******************************************************************** 01270IWMMAST WM 01280I* WORK ORDER MASTER. 01290I* WORK ORDER # 6A 01300I 1 6 WMWO 01310I* DESCRIPTION 40A 01320I 7 46 WMDESC 01330I 7 26 WM20 01340I* COST ARRAY (ACTUAL $) 11.3P X 6 01350I* 1 = LABOR 01360I* 2 = LABOR BURDEN 01370I* 3 = MATERIAL 01380I* 4 = MATERIAL BURDEN 01390I* 5 = NOT USED 01400I* 6 = NOT USED 01410I P 47 82 WA$ 01420I* TRANSFERRED TO STORES $ 11.3P 01430I P 83 883WMSTK$ 01440I* VARIANCE TAKEN $ 11.3P 01450I P 89 943WMVAR$ 01460I* QTY RECEIVED 7P 01470I P 95 980WMQRCD 01480I* SCHEDULE. 01490I* DATES 6N X 26 01500I 99 254 WMD ÐÐ01510I* QTYS 7P X 26 01520I P 255 358 WMQ 01530I* LEAD TIMES 3P X 26 01540I P 359 410 WLT 01550I* CLOSE DATE 6N 01560I 411 4160WMCLOS 01570I* QTY RELEASED 7P 01580I P 417 4200WMQREL 01590I* PART NO. 10N 01600I 422 4310WMPN 01610I 422 431 WMPNA 01620I* DRAWING REV. 2A 01630I 432 433 WMREV 01640I* UPDATE COUNTER 3P 01650I* INCREMENTED BY 1 EACH TIME 01660I* RECORD UPDATED BY Q009WM. 01670I P 434 4350WMCHG 01680I* DATE LAST TRAN 6N 01690I 436 4410WMDLT 01700I* LAST USED PULL # 3P 01710I P 442 4430WMPULL 01720I* ALTERNATE B/M PART # 10N 01730I 444 4530WMABM 01740I* ALTERNATE ROUTING PART # 10N 01750I 454 4630WMAR ÐÐ01760I* RECORD STATUS 1A 01770I 470 470 WMSTAT 01780I******************************************************************** 01790ISFMAST SF 01800I P 30 330SFQTY 01810I P 34 370SFQTYC 01820I 128 128 SFSTAT 01830I******************************************************************* 01840IALTKEY AK 01850I 32 32 AKSTAT 01860C******************************************************************** 01870C* INITIALIZE 01880C EXSR SR101 1-TIME INIT 01890C Z-ADD0 ZERO7 70 STUPIDITY 01900C*------------------------------------------------------------------ 01910C START TAG 01920C* SET-UP 1ST FIELD NO. 01930C MOVE ' ' DUN INIT EDIT ARRAY 01940C Z-ADD1 F 30 FIELD # 01950C SETOF 303141 01960C EXSR SR205 INIT WMMAST FIELDS 01970C MOVE ' ' TWO 01980C MOVE ' ' TPC 01990C MOVE BLK35 PULNAM 02000C MOVE BLK35 PMDESC ÐÐ02010C MOVE ' ' PMECHG 02020C MOVE ' ' PMSIZE 02030C MOVE BLK35 ALTDES 02040C MOVE BLK35 ALTRTG 02050C Z-ADD0 TQTY 02060C EXSR SR70 CLEAR SCREEN 02070C EXSR SR71 PUT HEADING 02080C GOTO READ 02090C*------------------------------------------------------------------ 02100C NEXT TAG 02110C* SET-UP NEXT FIELD NO. 02120C 1 ADD F F FIELD # 02130C*----------------------------------------------------------------- 02140C READ TAG 02150C* READ DATA FROM TERMINAL. 02160C SETOF 909677 02170C EXSR SR102 VALIDATE FIELD # 02180C 55 GOTO UPDATE DONE 02190C EXSR SR201 IDENTIFY-F 02200C 02 DUN,1 COMP ' ' 54 02210C 02N54 Z-ADD1 F 02220C 02N54 GOTO READ 02230C SETON 69 02240C EXSR SR72 PROMPT 02250C SETOF 69 ÐÐ02260C EXSR SR75 READ TERMINAL 02270C 98 GOTO GOODBY GOODBY 02280C 94 GOTO MENU MENU REQUEST 02290C 93 GOTO NEWITM NEW ITEM 02300C 90 EXSR SR72 PUT DATA 02310C 92 GOTO JUMP FIELD JUMP REQST 02320C 89 F SUB 1 F SKIP BACKWARD 02330C 89 GOTO READ " " 02340C 88 SETOF 90 SPACE FILL 02350C 88 SETON 77 " " 02360C 91 GOTO UPDATE UPDATE 02370C 96 GOTO ERROR ERROR 02380C N77 GOTO EDIT NO DATA INPUT 02390C*------------------------------------------------------------------ 02400C PROCES TAG 02410C* PROCESS INPUT DATA 02420C EXSR SR103 MOVE DATA 02430C*------------------------------------------------------------------- 02440C EDIT TAG 02450C N96 EXSR SR104 EDIT DATA 02460C EXSR SR72 REWRITE DATA 02470C 96 GOTO ERROR ERROR 02480C GOTO NEXT 02490C*------------------------------------------------------------------ 02500C UPDATE TAG ÐÐ02510C* UPDATE DATA BASE. 02520C EXSR SR105 FINAL EDIT 02530C 96 GOTO ERROR ERROR 02540C EXSR SR106 UPDATE 02550C 96 GOTO ERROR ERROR 02560C GOTO START 02570C*------------------------------------------------------------------- 02580C JUMP TAG 02590C* SET-UP JUMP TO REQUESTED FIELD 02600C 1 ADD W W 30 02610C W COMP 16 54 02620C 54 Z-ADD318 M 50 96 FLAG ERROR 02630C 54 GOTO ERROR BAD ESC 02640C MOVE ' ' W3A 3 02650C MOVEAA16,W W3A 02660C Z-ADD3 W2N 20 02670C EXIT SUBRAJ R. JUSTIFY 02680C RLABL W2N 02690C RLABL W3A 02700C MOVE W3A F NEW FIELD # 02710C GOTO READ 02720C*-------------------------------------------------------------------- 02730C ERROR TAG 02740C EXSR SR102 VALIDATE FIELD # 02750C EXSR SR89 GET MSG ÐÐ02760C GOTO READ 02770C*------------------------------------------------------------------ 02780C NEWITM TAG 02790C* SET-UP LINK FOR NEW ITEM 02800C GOTO START 02810C*------------------------------------------------------------------- 02820C MENU TAG 02830C* SET-UP LINK TO MENU 02840C MOVELCRMENU CRRET 02850C GOTO END 02860C*-------------------------------------------------------------------- 02870C GOODBY TAG 02880C* LINK TO SIGN-OFF 02890C MOVEL'GOODBY' CRRET 02900C GOTO END 02910C*------------------------------------------------------------------- 02920C END TAG 02930C 42 MOVE '119001' W6A 02940C 42 EXSR SR69 MOVE CURSOR 02950C 42 SETON 81 02960C 42 EXCPT 2NDARY UPD MSG 02970C SETOF 81 02980C EXSR SR97 UPDATE CRTFILE 02990C 42 MOVEL'Q005WM' PROG 8 PROG LOADER 03000C PROG COMP BLK8 54 ÐÐ03010C N54 MOVELCRRET PROG 03020C EXITFCHAIN LINK TO NEXT PROG 03030C RLABL PROG 03040C*------------------------------------------------------------------- 03050C ENDJOB TAG 03060C********************************************************************* 03070CSR SR1 BEGSR 03080C* EDIT WO #. 03090CSR MOVE BLK35 ALTDES 29 03100CSR MOVE BLK35 ALTRTG 29 03110CSR MOVE BLK16 SAVPN 10 03120CSR Z-ADD0 OLDNR 70 03130CSR Z-ADD0 OLDOPN 70 03140CSR MOVELTWO PREFIX 1 03150CSR PREFIX LOKUPTABPWO 70 FLAG PROD WO 03160CSR PREFIX COMP 'T' 41 03170CSR MOVE TWO W5N 50 03180CSR W5N COMP 0 54 03190CSRN54 Z-ADD341 M 96 FLAG ERROR 03200CSRN54 GOTO END1 03210C* GET WORK ORDER MASTER AND PART MASTER 03220CSR EXSR SR80 GET WORK ORDER MAST 03230CSR 30 NOT ON FILE 03240COR 31 Z-ADD302 M 96 FLAG ERROR 03250CSR 30 ÐÐ03260COR 31 EXSR SR205 INIT WMMAST DATA 03270CSRN70 03280COR 30 03290COR 31 GOTO T1C 03300CSR MOVELWMABM W12A 12 ALT BM PN 03310CSR EXSR SR83 GET PART MAST 03320CSRN60 MOVE PMDESC ALTDES 03330CSR MOVELWMAR W12A ALT RTG PN 03340CSR EXSR SR83 GET PART MAST 03350CSRN60 MOVE PMDESC ALTRTG 03360CSR MOVE BLK35 PMDESC 03370CSR MOVE WMPN SAVPN 10 03380CSR MOVELSAVPN W12A 03390CSR EXSR SR83 GET PART MASTER 03400CSR 60 SETON H4 03410CSR 60 GOTO ENDJOB 03420CSR PMNOBM COMP 0 54 03430CSR 54 MOVE 'Y' TPC 1 03440CSRN54 MOVE 'N' TPC 03450CSR MOVE WMPN SAVPN 03460CSR EXSR SR83 03470C*------------------------------------------------------------------- 03480CSR T1C TAG 03490CSR EXSR SR3 EDIT PULL CODE 03500CSR Z-ADDWMQREL NEWREL 70 ÐÐ03510CSR EXSR SR71 PUT HEADING 03520CSR EXSR SR300 ALLOC REL/RCD QTYS 03530CSR Z-ADD1 A 03540CSR ZERO7 LOKUPNR,A 54 03550CSR 54 Z-ADDWMD,A DUEDAT 60 DUE DATE 03560CSR 54 Z-ADDWMD,A W6N 03570CSR 54 EXSR SR500 CALC START DATE 03580CSR Z-ADDREL OLD SAVE RELEASE QTYS 03590CSR Z-ADDWMD SVD SAVE SCHED DATES 03600CSR Z-ADDWLT SVL SAVE LEAD TIMES 03610CSR EXSR SR253 DISPLAY SCHEDULE 03620CSR Z-ADDTOTNR OLDNR 03630CSR Z-ADDTOTOPN OLDOPN 03640CSR END1 ENDSR 03650C******************************************************************* 03660CSR SR2 BEGSR 03670C* EDIT RELEASE QTY. 03680CSR TQTY COMP 0 54 03690CSRN54 Z-ADD292 M 96 FLAG ERROR 03700CSRN54 GOTO END2 03710CSR WMQREL ADD TQTY NEWREL 70 03720CSR TQTY COMP TOTNR 54 03730CSR 54 Z-ADD620 M 96 FLAG ERROR 03740CSR 54 GOTO END2 03750CSR EXSR SR300 ALLOC REL/RCD QTYS ÐÐ03760CSR EXSR SR253 DISPLAY SCHEDULE 03770CSR END2 ENDSR 03780C******************************************************************** 03790CSR SR3 BEGSR 03800C* EDIT PULL CODE. (Y=PULL SHEET REQD, NOT Y=NOT REQD) 03810CSR MOVE BLK35 PULNAM 9 03820CSR TPC COMP 'Y' 54 03830CSRN54 MOVEL'N' TPC 03840CSRN54 MOVEL'NOT REQD'PULNAM 03850CSR 54 MOVEL'YES REQD'PULNAM 03860CSR ENDSR 03870C***************************************************************** 03880CSR SR66 BEGSR 03890CSR EXITFQCLF LINE FEED 03900CSR ENDSR 03910C******************************************************************* 03920CSR SR69 BEGSR 03930CSR EXITFQXYPOS POSITION CURSOR 03940CSR RLABL W6A 03950CSR ENDSR 03960C***************************************************************** 03970CSR SR70 BEGSR 03980C* CLEAR TERM SCREEN. 03990CSR EXITFZCPAGE CLEAR PAGE-4 04000CSR ENDSR ÐÐ04010C********************************************************************** 04020CSR SR71 BEGSR 04030C* PUT HEADINGS TO TERMINAL 04040CSR SETON 71 04050CSR EXCPT PUT HEADINGS 04060CSR SETOF 71 04070CSR ENDSR 04080C********************************************************************* 04090CSR SR72 BEGSR 04100C* PUT DATA TO TERMINAL 04110CSR 70 WMREV COMP ' ' 55 04120CSR 91 ADD F W3N 30 04130CSR MOVELW3N W6A 6 04140CSR MOVE '001' W6A 04150CSR EXSR SR69 POSITION CURSOR 04160CSR SETON 72 04170CSR EXCPT PUT DATA 04180CSR SETOF 72 04190CSR ENDSR 04200C******************************************************************** 04210CSR SR73 BEGSR 04220C* PUT MGTEXT TO CRT. 04230CSR 91 ADD F W3N 30 04240CSR MOVE W3N LOC 3 04250CSR SETON 73 ÐÐ04260CSR EXCPT PUT MSG 04270CSR SETOF 73 04280CSR ENDSR 04290C******************************************************************* 04300CSR SR75 BEGSR 04310C* READ FROM TERMINAL 04320CSR SETOF 779096 04330CSR SETOF 9392 04340CSR SETOF 8988 04350CSR SETOF 91 04360CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 04370CSR MOVE BLK16 W16A 16 BUFFER 04380CSR MOVE BIT,28 A9,1 04390CSR MOVE '8' A9,2 04400CSR 92 ADD F W3N 30 04410CSR MOVE W3N W3A 3 04420CSR MOVEAW3A A9,3 04430CSR MOVEA'046' A9,6 04440CSR MOVE BIT,8 A9,9 04450CSR MOVEAA9 W9A 9 04460CSR EXITFQPREED READ FROM TERMINAL 04470CSR RLABL W9A 04480CSR RLABL W16A READ BUFFER 04490CSR RLABL BUFLGT READ BUFFER LGTH 04500CSR MOVEAW16A A16 INPUT DATA ARRAY ÐÐ04510CSR MOVE BLK16 W16A INIT INPUT ARRAY 04520CSR Z-ADD1 W 30 04530CSR '\' LOKUPA16,W 90 FLAG ESC 04540CSRN90 GOTO T75B NOT ESC 04550CSR 1 ADD W W 04560CSR W COMP 16 54 04570CSR 54 GOTO T75A BAD ESC 04580CSR A16,W COMP 'G' 98 GOODBY 04590CSR A16,W COMP 'E' 94 MENU 04600CSR A16,W COMP 'N' 93 NEW ITEM 04610CSR A16,W COMP 'J' 92 JUMP 04620CSR A16,W COMP 'B' 89 SKIP BKWRD 04630CSR A16,W COMP 'S' 88 SPACE FILL 04640CSR A16,W COMP 'U' 91 UPDATE 04650CSR 98 04660COR 94 04670COR 93 04680COR 92 04690COR 89 04700COR 88 04710COR 91 GOTO END75 GOOD ESC 04720C*------------------------------------------------------------------ 04730CSR T75A TAG 04740C* FLAG BAD ESC INPUT 04750CSR Z-ADD318 M 96 FLAG ERROR ÐÐ04760CSR GOTO END75 04770C*-------------------------------------------------------------------- 04780CSR T75B TAG 04790C* MOVE DATA 04800CSR Z-ADD1 W 04810CSR ' ' LOKUPA16,W 77 04820CSR 77 MOVEAA16,W W16A INPUT DATA 04830C*-------------------------------------------------------------------- 04840CSR END75 TAG 04850C* INIT PREV ERROR MSG. 04860CSR MOVE BLK35 MGTEXT 04870CSR ENDSR 04880C******************************************************************** 04890CSR SR76 BEGSR 04900C* PUT SCHEDULE HEADINGS 04910CSR 40 GOTO T76B 04920CSR MOVE '104001' W6A 04930CSR EXSR SR69 MOVE CURSOR 04940CSR SETON 75 04950CSR EXCPT PUT SCHED HEADING 04960CSR SETOF 75 04970C*------------------------------------------------------------------- 04980CSR T76B TAG 04990C* PUT SCHEDULE DATA TO CRT 05000CSR S ADD 105 W3N 30 ÐÐ05010CSR S COMP 13 54 05020CSR 54 MOVE '060' W6A 05030CSRN54 MOVE '001' W6A 05040CSR W3N SUB 1 W3N 05050CSR MOVELW3N W6A 6 05060CSR EXSR SR69 MOVE CURSOR 05070CSR SETON 76 05080CSR EXCPT PUT SCHED DATA 05090CSR SETOF 76 05100CSR SETON 40 05110CSR ENDSR 05120C********************************************************************** 05130CSR SR80 BEGSR 05140C* GET WMMAST MASTER. 05150CSR Z-ADD0 TOTORD 70 05160CSR Z-ADD0 OLDRCD 70 05170CSR Z-ADD0 OLDREL 70 05180CSR MOVELTWO PREFIX 1 05190CSR PREFIX COMP 'T' 41 05200CSR SETOF 31 05210CSR TWO CHAINWMMAST 30 GET WMMAST 05220CSRN30 WMSTAT COMP 'D' 31 FLAG DELETE 05230CSR 30 NOT ON FILE 05240COR 31 GOTO END80 DELETED 05250CSR END80 ENDSR ÐÐ05260C******************************************************************** 05270CSR SR81 BEGSR 05280C* GET CALENDAR RECORD. 05290CSR W7A CHAINCALENDAR 60 05300CSR ENDSR 05310C*********************************************************************** 05320CSR SR82 BEGSR 05330C* OUTPUT WMUPDATE. 05340CSR 70 1 ADD WMPULL WMPULL 05350CSR 70N41 Z-ADDWMPULL PULLNO 30 05360CSR 70 41 Z-ADD1 PULLNO 05370CSR MOVE '100001' W6A 05380CSR EXSR SR69 MOVE CURSOR 05390CSR SETON 82 05400CSR EXCPT OUTPUT WMUPDATE 05410CSR SETOF 82 05420CSR SETON 42 05430CSR ENDSR 05440C******************************************************************** 05450CSR SR83 BEGSR 05460C* GET PART MAST. 05470CSR Z-ADD0 PLT 05480CSR MOVE ' ' W12A 05490CSR W12A CHAINPMMST2 60 GET PMMST2 05500CSRN60 PMSTAT COMP 'D' 60 ÐÐ05510CSR XFOOTPLT TOTLT 30 05520CSR ENDSR 05530C**************************************************************** 05540CSR SR84 BEGSR 05550CSR KEYSF CHAINSFMAST 60 GET SFMAST 05560CSR ENDSR 05570C*************************************************************** 05580CSR SR85 BEGSR 05590CSR KEYAK CHAINALTKEY 60 GET ALTKEY 05600CSR ENDSR 05610C******************************************************************* 05620CSR SR86 BEGSR 05630CSR SETON 86 05640CSR EXCPT UPDATE SFMAST 05650CSR SETOF 86 05660CSR ENDSR 05670C****************************************************************** 05680CSR SR87 BEGSR 05690CSR SETON 87 05700CSR EXCPT UPDATE ALTKEY 05710CSR SETOF 87 05720CSR ENDSR 05730C******************************************************************* 05740CSR SR89 BEGSR 05750C* GET MESSAGE MASTER ÐÐ05760CSR M CHAINMGFILE 54 05770CSR 54 MOVE BLK35 MGTEXT 05780CSR 54 MOVELM MGTEXT 05790CSR 54 MOVE '????????'MGTEXT 05800CSR ENDSR 05810C****************************************************************** 05820CSR SR97 BEGSR 05830C* UPDATE CRTFILE. 05840CSR SETON 97 05850CSR EXCPT UPDATE CRTFILE 05860CSR SETOF 97 05870CSR ENDSR 05880C*********************************************************************** 05890CSR SR101 BEGSR 05900C* 1-TIME INITIALIZE 05910CSR MOVE BIT,1 NUL 05920CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05930CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 05940CSR MOVE ' ' BLK16 16 05950CSR Z-ADDUDATE W6N 60 05960CSR EXSR SR208 05970CSR Z-ADDW6N TODAY 60 05980CSR Z-ADDDAYNO CURDAY 60 CUR DATE YMD 05990C* GET PORT # AND CRTFILE 06000CSR MOVE ' ' W8A 8 ÐÐ06010CSR Z-ADD0 W2N 20 06020CSR Z-ADD0 W1N 10 06030CSR MOVE ' ' W2A 2 06040CSR EXITFPGMINX GET PORT # 06050CSR RLABL W8A 06060CSR RLABL W2N 06070CSR RLABL W1N 06080CSR RLABL W2A 06090CSR MOVE W2A PORT 20 PORT NO. 06100CSR PORT COMP 0 54 06110CSRN54 Z-ADD25 PORT DEFAULT 06120CSR PORT CHAINCRTFILE H9 06130C* DEFINE WORK FIELDS,ETC. 06140CSR EXSR SR205 INIT WM FIELDS 06150CSR MOVE ' ' BLK35 35 06160CSR MOVE ' ' BLK8 8 06170CSR Z-ADD0 ZERO7 70 06180CSR Z-ADD0 ZERO6 60 06190CSR Z-ADD0 ZERO5 50 06200CSR Z-ADD0 ZERO9 90 06210CSR Z-ADD0 ZERO3 30 06220CSR ENDSR 06230C********************************************************************** 06240CSR SR102 BEGSR 06250C* VALIDATE FIELD NO. ÐÐ06260CSR F COMP 0 54 06270CSRN54 Z-ADD1 F 06280CSR F COMP FLIMIT 55 06290CSR 55 Z-ADD1 F 06300CSR ENDSR 06310C******************************************************************** 06320CSR SR103 BEGSR 06330C* MOVE INPUT DATA 06340CSR EXSR SR201 IDENTIFY-F 06350CSR EXSR SR202 R. JUSTIFY 06360CSR 01 EXSR SR211 BUILD W.O.# 06370CSR 02 MOVE W10A TQTY 70 QTY TO BE REL 06380CSR 03 MOVELW16A TPC 1 06390CSR MOVE ' ' DUN,F EDIT FLAG 06400CSR ENDSR 06410C******************************************************************** 06420CSR SR104 BEGSR 06430C* EDIT INPUT DATA 06440CSR 01 EXSR SR1 06450CSR 02 EXSR SR2 06460CSR 03 EXSR SR3 06470CSR 96 MOVE ' ' DUN,F EDIT FLAG 06480CSRN96 MOVE 'X' DUN,F 06490CSR ENDSR 06500C*********************************************************************** ÐÐ06510CSR SR105 BEGSR 06520C* FINAL EDIT 06530CSR SETOF 77 06540CSR SETON 79 FINAL EDIT FLAG 06550CSR Z-ADD1 F 96 06560C*-------------------------------------------------------------------- 06570CSR T105A TAG 06580CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06590CSRN54 GOTO END105 06600CSR EXSR SR201 IDENTIFY-F 06610CSR EXSR SR104 EDIT 06620CSRN96 GOTO T105A 06630C*-------------------------------------------------------------------- 06640CSR END105 TAG 06650CSR SETOF 79 06660CSR ENDSR 06670C*************************************************************** 06680CSR SR106 BEGSR 06690C* UPDATE SR 06700CSR Z-ADD0 A 06710C*-------------------------------------------------------------- 06720CSR T106A TAG 06730CSR 1 ADD A A 06740CSR A COMP 26 54 06750CSR 54 GOTO T106E ÐÐ06760CSR WMQ,A COMP 0 54 06770CSRN54 GOTO T106E 06780CSR REL,A COMP OLD,A 54 06790CSR 54 GOTO T106A 06800CSR MOVE WMD,A DUEA 6 ALPHA DUE DATE 06810CSR WMQ,A SUB OLD,A NOTREL 70 58 06820CSR NR,A COMP 0 59 06830CSRN58N59 GOTO T106C NO UN-RELEASED QTY 06840C* UPDATE PLANNED WORK ORDER SFMAST 06850CSR MOVE '40' W2A 06860CSR EXSR SR255 BUILD SF-KEY 06870CSR EXSR SR84 GET SFMAST 06880CSR 58 MOVE 'D' SFSTAT 06890CSR 58 Z-ADD0 SFQTY 06900CSR 58 Z-ADD0 SFQTYC 06910CSR 59 MOVE 'A' SFSTAT 06920CSR 59 Z-ADDNR,A SFQTY 06930CSR 59 Z-ADD0 SFQTYC 06940CSR EXSR SR86 UPDATE SFMAST 06950CSR EXSR SR256 BUILD AK-ORD KEY 06960CSR EXSR SR85 GET ALTKEY 06970CSR 58 MOVE 'D' AKSTAT 06980CSR 59 MOVE 'A' AKSTAT 06990CSR EXSR SR87 UPDATE AK-ORD 07000CSR EXSR SR257 BUILD AK-DUE KEY ÐÐ07010CSR EXSR SR85 GET ALTKEY 07020CSR 58 MOVE 'D' AKSTAT 07030CSR 59 MOVE 'A' AKSTAT 07040CSR EXSR SR87 UPDATE AK-DUE 07050CSR 41 WMQ,A SUB REL,A WMQ,A T-PREFIX ONLY 07060C*------------------------------------------------------------------ 07070CSR T106C TAG 07080C* UPDATE RELEASED WORK ORDER SFMAST, IF NOT T-PREFIX. 07090CSR 41 GOTO T106A T-PREFIX 07100CSR OLD,A COMP 0 58 07110CSR REL,A COMP 0 59 07120CSR MOVE '20' W2A 07130CSR EXSR SR255 BUILD SFMAST KEY 07140CSR EXSR SR84 GET SFMAST 07150CSR 58 MOVE 'D' SFSTAT 07160CSR 58 Z-ADD0 SFQTY 07170CSR 58 Z-ADD0 SFQTYC 07180CSR 59 MOVE 'A' SFSTAT 07190CSR 59 Z-ADDREL,A SFQTY 07200CSR 59 Z-ADDRCD,A SFQTYC 07210CSR EXSR SR86 UPDATE SFMAST 07220CSR EXSR SR256 BUILD AK-ORD KEY 07230CSR EXSR SR85 GET ALTKEY 07240CSR 58 MOVE 'D' AKSTAT 07250CSR 59 MOVE 'A' AKSTAT ÐÐ07260CSR EXSR SR87 UPDATE AK-ORD 07270CSR EXSR SR257 BUILD AK-DUE 07280CSR EXSR SR85 GET AK-DUE 07290CSR 58 MOVE 'D' AKSTAT 07300CSR 59 MOVE 'A' AKSTAT 07310CSR EXSR SR87 UPDATE AK-DUE 07320CSR GOTO T106A 07330C*------------------------------------------------------------------- 07340CSR T106E TAG 07350C* UPDATE WMMAST,PMMST2,WMUPDATE, AND WMPULL FILES 07360CSR Z-ADDTODAY WMDLT 07370CSRN41 TQTY ADD WMQREL NEWREL 54 07380CSRN41N54 07390COR 41 Z-ADD0 NEWREL 07400CSR PMPWOB SUB TQTY PMPWOB 07410CSR PMRWOB ADD TQTY PMRWOB 07420CSR EXSR SR82 UPDATE WMMAST 07430C* OUTPUT R-PREFIX WO IF REL MADE TO T-PREFIX WO 07440C* NOTE: DETAILED SCHEDULE (OLD ARRAY) NOW 07450C* BEING OUTPUT TO R-PREFIX WO. 07460C* THAT MAY BE CHANGED TO A LUMP 07470C* QTY (TQTY) WITH A SINGLE 07480C* DUE DATE (DUEDAT) AND START 07490C* DATE (START) IF DESIRED. 07500C* SVD AND SVL ARRAYS WOULD ÐÐ07510C* THEN NOT BE NEEDED. 07520CSRN41 GOTO END106 NOT T-PREFIX 07530CSR Z-ADDREL OLD SAVE REL QTYS 07540CSR MOVE WMDESC SVDESC 40 SAVE DESCR 07550CSR Z-ADDWMD SVD SAVE SCHD DATES 07560CSR Z-ADDWLT SVL SAVE LEAD TIMES 07570CSR Z-ADDWMABM SAVABM 100 SAVE ALT BM 07580CSR Z-ADDWMAR SAVAR 100 SAVE ALT RTG 07590CSR XFOOTOLD NEWREL 07600C*--------------------------------------------------------------- 07610CSR T106G TAG 07620CSR MOVE 'R ' W2A 07630CSR W2A CHAINWMLUWO H6 07640CSR H6 GOTO ENDJOB 07650CSR 1 ADD WLNO WLNO 07660CSR SETON 44 07670CSR EXCPT UPDATE WMLUWO 07680CSR SETOF 44 07690CSR MOVEL'R' TWO 07700CSR MOVE WLNO TWO 07710CSR SETON 45 07720CSR EXSR SR80 GET WMMAST 07730CSR SETOF 45 07740CSRN30 GOTO T106G NOT NEW WO # 07750CSR Z-ADDSVL WLT ÐÐ07760CSR MOVELSVDESC WM20 07770CSR Z-ADD0 WA$ 07780CSR Z-ADD0 WMSTK$ 07790CSR Z-ADD0 WMVAR$ 07800CSR Z-ADD0 WMQRCD 07810CSR Z-ADD1 WMCHG 07820CSR Z-ADD0 WMCLOS 07830CSR EXSR SR301 ADJUST SVD/SVL ARRAYS07840CSR SETON 47 07850CSR EXCPT ADD R-PREFIX WO 07860CSR SETOF 47 07870C* UPDATE SFMAST/ALTKEYS FOR R-PREFIX WO 07880CSR Z-ADD1 A 07890C*----------------------------------------------------------------- 07900CSR T106J TAG 07910CSR ZERO7 LOKUPOLD,A 54 07920CSRN54 GOTO END106 07930CSR MOVE SVD,A DUEA 6 07940CSR Z-ADDSVD,A W6N 60 07950CSR EXSR SR500 CALC START DATE 07960CSR MOVE '20' W2A 07970CSR EXSR SR255 BUILD SFMAST KEY 07980CSR EXSR SR84 GET SFMAST 07990CSR Z-ADDOLD,A SFQTY 08000CSR Z-ADD0 SFQTYC ÐÐ08010CSR MOVE 'A' SFSTAT 08020CSR EXSR SR86 UPDATE SFMAST 08030CSR EXSR SR256 BUILD AK-ORD KEY 08040CSR EXSR SR85 GET ALTKEY 08050CSR MOVE 'A' AKSTAT 08060CSR EXSR SR87 UPDATE AK-ORD 08070CSR EXSR SR257 BUILD AK-DUE KEY 08080CSR EXSR SR85 GET ALTKEY 08090CSR MOVE 'A' AKSTAT 08100CSR EXSR SR87 UPDATE AK-DUE 08110CSR 1 ADD A A 08120CSR A COMP 26 54 08130CSRN54 GOTO T106J 08140CSR END106 ENDSR 08150C************************************************************************ 08160CSR SR201 BEGSR 08170C* IDENTIFY FIELD NO. 08180CSR F COMP 1 01 08190CSR F COMP 2 02 08200CSR F COMP 3 03 08210CSR ENDSR 08220C***************************************************************** 08230CSR SR202 BEGSR 08240C* RIGHT ADJUST INPUT 08250CSR F LOKUPNUM 54 ÐÐ08260CSRN54 GOTO END202 08270CSR Z-ADD10 W2N 08280CSR MOVELW16A W10A 10 08290CSR EXIT SUBRAJ R.J. 08300CSR RLABL W2N 08310CSR RLABL W10A 08320CSR END202 ENDSR 08330C******************************************************************* 08340CSR SR205 BEGSR 08350C* INIT WMMAST FIELDS 08360CSR MOVE BLK8 WMWO 08370CSR MOVELBLK35 WMDESC 08380CSR MOVE BLK35 WMDESC 08390CSR MOVE BLK35 WM20 08400CSR Z-ADD0 WA$ 08410CSR Z-ADD0 WMSTK$ 08420CSR Z-ADD0 WMQRCD 08430CSR Z-ADD0 WMQ 08440CSR Z-ADD0 WMD 08450CSR Z-ADD0 WMCLOS 08460CSR Z-ADD0 WMQREL 08470CSR Z-ADD0 WMABM 08480CSR Z-ADD0 WMAR 08490CSR Z-ADD0 WMPN 08500CSR MOVE ' ' WMREV ÐÐ08510CSR Z-ADD0 WMCHG 08520CSR Z-ADD0 WMDLT 08530CSR Z-ADD0 WMPULL 08540CSR MOVE ' ' WMSTAT 08550CSR Z-ADD0 REL 08560CSR Z-ADD0 NR 08570CSR Z-ADD0 RCD 08580CSR Z-ADD0 OPN 08590CSR ENDSR 08600C******************************************************************* 08610CSR SR207 BEGSR 08620C* EDIT DATE/GET CALENDAR. 08630CSR MOVELW6N W2N 20 08640CSR W2N COMP 12 54 08650CSR 54 GOTO T207A 08660CSR MOVELW6N W4N 40 08670CSR MOVE W6N W2N 08680CSR MOVELW2N W6N 60 08690CSR MOVE W4N W6N 08700C*------------------------------------------------------------------- 08710CSR T207A TAG 08720CSR MOVEL'C' W7A 7 08730CSR MOVE W6N W7A 08740CSR EXSR SR81 GET CALENDAR 08750CSR END207 ENDSR ÐÐ08760C******************************************************************** 08770CSR SR208 BEGSR 08780C* COMPUTE DAY #. 08790CSR EXSR SR207 EDIT DATE 08800CSR EXSR SR81 GET CALENDAR 08810CSR 60 Z-ADD390 M 96 FLAG ERROR 08820CSR 60 GOTO END208 08830CSR CAWK SUB 1 CAWK 54 08840CSRN54 Z-ADD0 CAWK 08850CSR 7 MULT CAWK DAYNO 40 08860CSR CADOW ADD DAYNO DAYNO DAY # 08870CSR END208 ENDSR 08880C******************************************************************** 08890CSR SR211 BEGSR 08900C* BUILD WO #. 08910CSR MOVELW16A TWO 6 08920CSR MOVE TWO W5A 5 08930CSR Z-ADD5 W2N 08940CSR EXIT SUBRAJ RJ 08950CSR RLABL W2N 08960CSR RLABL W5A 08970CSR MOVE W5A TWO 08980CSR END211 ENDSR 08990C******************************************************************* 09000CSR SR252 BEGSR ÐÐ09010C* APPLY RECEIPTS TO SCHEDULE 09020CSR 32 Z-ADD0 RCD 09030CSR 32 Z-ADDWMQRCD SAVQTY 70 57 09040CSR 33 Z-ADD0 REL 09050CSR 33 Z-ADDNEWREL SAVQTY 57 09060CSR Z-ADD1 A 09070C*------------------------------------------------------------------- 09080CSR T252A TAG 09090CSRN57 GOTO END252 QTY RECVD = 0 09100CSR 33 ZERO7 LOKUPWMQ,A 54 09110CSR 32 ZERO7 LOKUPREL,A 54 09120CSRN54 GOTO T252C 09130CSR 33 Z-ADDWMQ,A W7N 70 09140CSR 32 Z-ADDREL,A W7N 09150CSR SETOF 57 09160CSR SAVQTY COMP W7N 545556 09170CSR 54 32 Z-ADDW7N RCD,A 09180CSR 54 33 Z-ADDW7N REL,A 09190CSR 54 SAVQTY SUB W7N SAVQTY 57 09200CSR 54 Z-ADD0 W7N 09210CSR 55 32 Z-ADDSAVQTY RCD,A 09220CSR 55 33 Z-ADDSAVQTY REL,A 09230CSR 55 W7N SUB SAVQTY W7N 09240CSR 55 Z-ADD0 SAVQTY 57 09250CSR 56 32 Z-ADDSAVQTY RCD,A ÐÐ09260CSR 56 33 Z-ADDSAVQTY REL,A 09270CSR 56 Z-ADD0 SAVQTY 57 09280CSR 56 Z-ADD0 W7N 09290CSR 1 ADD A A 30 09300CSR A COMP 26 54 09310CSRN57 09320COR 54 GOTO END252 09330CSR GOTO T252A 09340C*-------------------------------------------------------------------- 09350CSR T252C TAG 09360CSR Z-ADD1 A 09370CSR 33 ZERO7 LOKUPWMQ,A 54 09380CSR 32 ZERO7 LOKUPREL,A 54 09390CSR 54 32 Z-ADDSAVQTY RCD,A 09400CSR 54 33 Z-ADDSAVQTY REL,A 09410C*------------------------------------------------------------------- 09420CSR END252 TAG 09430CSR EXSR SR254 COMPUTE TOTALS 09440CSR ENDSR 09450C********************************************************************* 09460CSR SR253 BEGSR 09470C* DISPLAY SCHEDULE. 09480CSR Z-ADD0 S 30 09490CSR SETOF 40 09500CSR MOVE BLK35 MGTEXT ÐÐ09510C*------------------------------------------------------------------- 09520CSR T253A TAG 09530CSR 1 ADD S S 09540CSR S COMP 13 54 09550CSR 54 GOTO T253C 09560CSR WMQ,S COMP 0 54 09570CSRN54 REL,S COMP 0 54 09580CSRN54 RCD,S COMP 0 54 09590CSR 13 ADD S Y 30 09600CSRN54 WMQ,Y COMP 0 54 09610CSRN54 REL,Y COMP 0 54 09620CSRN54 RCD,Y COMP 0 54 09630CSRN54 GOTO T253A 09640CSR EXSR SR76 PUT SCHEDULE 09650CSR GOTO T253A 09660C*------------------------------------------------------------------- 09670CSR T253C TAG 09680CSR MOVE '119001' W6A 09690CSR EXSR SR69 MOVE CURSOR 09700CSR SETON 74 09710CSR EXCPT PUT TOTAL LINE 09720CSR SETOF 74 09730CSR ENDSR 09740C******************************************************************** 09750CSR SR254 BEGSR ÐÐ09760C* COMPUTE TOTALS 09770CSR WMQ SUB REL NR NOT REL QTYS 09780CSR REL SUB RCD OPN NOT RCD QTYS 09790CSR XFOOTWMQ TOTWMQ 70 09800CSR XFOOTRCD TOTRCD 70 09810CSR XFOOTREL TOTREL 70 09820CSR XFOOTOPN TOTOPN 70 09830CSR XFOOTNR TOTNR 70 09840CSR ENDSR 09850C********************************************************************* 09860CSR SR255 BEGSR 09870C* BUILD SFMAST KEY 09880CSR MOVEASAVPN A29 09890CSR MOVEADUEA A29,11 09900CSR MOVEAW2A A29,17 09910CSR MOVEATWO A29,19 09920CSR MOVEA'00000' A29,25 09930CSR MOVEAA29 KEYSF 29 09940CSR ENDSR 09950C******************************************************************** 09960CSR SR256 BEGSR 09970C* BUILD KEY FOR ORDER ALTKEY 09980CSR MOVE 'A' AK,1 09990CSR MOVE A29,17 AK,2 10000CSR MOVEAA29,19 AK,3 ÐÐ10010CSR MOVEAA29,1 AK,14 10020CSR MOVEAA29,11 AK,24 10030CSR MOVEAAK KEYAK 29 10040CSR ENDSR 10050C******************************************************************* 10060CSR SR257 BEGSR 10070C* BUILD KEY FOR DUE DATE ALTKEY 10080CSR MOVE 'B' AK,1 10090CSR MOVE A29,17 AK,2 10100CSR MOVEAA29,11 AK,3 10110CSR MOVEAA29,19 AK,9 10120CSR MOVEAA29,1 AK,20 10130CSR MOVEAAK KEYAK 10140CSR ENDSR 10150C****************************************************************** 10160CSR SR300 BEGSR 10170C* ALLOCATE RCPTS/REL QTYS 10180CSR SETON 33 10190CSR EXSR SR252 ALLOC REL QTYS 10200CSR SETOF 33 10210CSR SETON 32 10220CSR EXSR SR252 ALLOC RCD QTYS 10230CSR SETOF 32 10240CSR ENDSR 10250C******************************************************************* ÐÐ10260CSR SR301 BEGSR 10270C* ADJUST SCHED DATES AND LEAD TIMES TO FIT OLD ARRAY (T-PREFIX) 10280CSR Z-ADD1 A 10290C*----------------------------------------------------------------- 10300CSR T301A TAG 10310CSR ZERO7 LOKUPOLD,A 54 10320CSRN54 GOTO T301B 10330CSR Z-ADD0 SVD,A 10340CSR Z-ADD0 SVL,A 10350CSR Z-ADD0 NR,A 10360CSR Z-ADD0 REL,A 10370CSR Z-ADD0 RCD,A 10380CSR 1 ADD A A 10390CSR A COMP 26 54 10400CSRN54 GOTO T301A 10410C*--------------------------------------------------------------- 10420CSR T301B TAG 10430C* SHIFT NON-BLANK ELEMENTS TO FRONT OF ARRAY 10440CSR Z-ADD1 A 10450CSR Z-ADD0 S 10460C*--------------------------------------------------------------- 10470CSR T301C TAG 10480CSR ZERO7 LOKUPOLD,A 54 10490CSRN54 GOTO END301 10500CSR 1 ADD S S ÐÐ10510CSR A COMP S 54 10520CSR 54 GOTO T301D 10530CSR Z-ADDOLD,A OLD,S 10540CSR Z-ADDSVD,A SVD,S 10550CSR Z-ADDSVL,A SVL,A 10560CSR Z-ADDNR,A NR,S 10570CSR Z-ADDREL,A REL,S 10580CSR Z-ADDRCD,A RCD,S 10590CSR Z-ADD0 OLD,A 10600CSR Z-ADD0 SVD,A 10610CSR Z-ADD0 SVL,A 10620CSR Z-ADD0 NR,A 10630CSR Z-ADD0 REL,A 10640CSR Z-ADD0 RCD,A 10650CSR GOTO T301C 10660C*----------------------------------------------------------------- 10670CSR T301D TAG 10680CSR 1 ADD A A 10690CSR A COMP 26 54 10700CSRN54 GOTO T301C 10710CSR END301 ENDSR 10720C***************************************************************** 10730CSR SR500 BEGSR 10740C* USE LEAD TIME TO COMPUTE START DATE. 10750CSR MOVEL'C' W7A 7 ÐÐ10760CSR MOVE W6N W7A 10770CSR EXSR SR81 GET CALENDAR 10780CSR 60 GOTO T500Z 10790CSR Z-ADDWLT,A W3N 30 54 10800CSRN54 Z-ADDTOTLT W3N 10810CSR CAMDAY SUB W3N MDAY 60 10820CSR MOVE BLK8 W7A 10830CSR MOVEL'M' W7A 10840CSR MOVE MDAY W7A 10850CSR EXSR SR81 GET CALENDAR 10860CSR 60 GOTO T500Z 10870CSR Z-ADDCACAL START 60 10880CSR GOTO END500 10890C*------------------------------------------------------------------- 10900CSR T500Z TAG 10910CSR Z-ADDTODAY START 10920CSR END500 ENDSR 10930C******************************************************************** 10940OTERM132 E 71 10950O BIT,28 1 10960O 8 '8091001' 10970O 80 'WORK ORDER RELEASE' 10980O UDATE 16 ' - - ' 10990O*------------------------------------------------------------------- 11000O E 71 ÐÐ11010O 1 ' ' 11020O*------------------------------------------------------------------- 11030O E 71 11040O OR 72 01 11050O DOT 43 11060O 18 ' (1) WORK ORDER #' 11070O TWO 51 11080O 70 75 'PRODUCTION WORK ORDER' 11090O MGTEXT 132 11100O*----------------------------------------------------------------------- 11110O E 71 11120O OR 72 02 11130O DOT 43 11140O 24 ' (2) QUANTITY TO BE REL' 11150O 29 'EASED' 11160O TQTY 2 54 11170O MGTEXT 132 11180O*------------------------------------------------------------------- 11190O E 71 11200O OR 72 03 11210O DOT 43 11220O 24 ' (3) PRINT PULL SHEET? ' 11230O TPC 46 11240O PULNAM 54 11250O*------------------------------------------------------------------- ÐÐ11260O E 71 11270O 43 ':' 11280O 14 ' PART NO.' 11290O WMPN 57 ' - - ' 11300O 70 PMDESC 88 11310O MGTEXT 132 11320O*------------------------------------------------------------------- 11330O E 71 11340O 43 ':' 11350O 22 ' DRAWING REVISION' 11360O WMREV 47 11370O 70N55 51 'LATEST' 11380O 78 'CURRENT REVISION:' 11390O PMECHG 81 11400O 94 'DWG-SIZE:' 11410O PMSIZE 96 11420O MGTEXT 132 11430O*------------------------------------------------------------------- 11440O E 71 11450O 43 ':' 11460O 17 ' DESCRIPTION' 11470O WMDESC 85 11480O MGTEXT 132 11490O*------------------------------------------------------------------- 11500O E 71 ÐÐ11510O 43 ':' 11520O 18 ' ALTERNATE BI' 11530O 39 'LL OF MATERIAL PART #' 11540O WMABM 57 ' - - ' 11550O ALTDES 88 11560O MGTEXT 132 11570O*------------------------------------------------------------------- 11580O E 71 11590O 43 ':' 11600O 23 'ALTERNATE ROUTING' 11610O WMAR 57 ' - - ' 11620O ALTRTG 88 11630O*------------------------------------------------------------------- 11640O E 71 11650O OR 82 11660O 43 ':' 11670O 19 'LAST PULL NO.' 11680O WMPULLZ 48 11690O*------------------------------------------------------------------- 11700O E 71 11710O 1 ' ' 11720O E 71 11730O 1 ' ' 11740O E 71 11750O 64 '*' ÐÐ11760O*----------------------------------------------------------------- 11770O E 75 11780O* SCHEDULE HEADING 11790O 8 'DUE-DATE' 11800O 18 'SCHED-QTY' 11810O 28 'QTY-REL' 11820O 38 'QTY-RCD' 11830O 48 'NOT-RCD' 11840O 58 'NOT-REL' 11850O 62 'LT' 11860O 64 '*' 11870O 76 'DUE-DATE' 11880O 86 'SCHED-QTY' 11890O 96 'QTY-REL' 11900O 106 'QTY-RCD' 11910O 116 'NOT-RCD' 11920O 126 'NOT-REL' 11930O 130 'LT' 11940O*-------------------------------------------------------------- 11950O E 76 11960O* PUT SCHEDULE DATA 11970O WMD,S 8 ' - - ' 11980O WMQ,S 2 18 11990O REL,S K 28 12000O RCD,S K 38 ÐÐ12010O OPN,S K 48 12020O NR,S K 58 12030O WLT,S Z 62 12040O 64 '*' 12050O WMD,Y 76 ' - - ' 12060O WMQ,Y 2 86 12070O REL,Y K 96 12080O RCD,Y K 106 12090O OPN,Y K 116 12100O NR,Y K 126 12110O WLT,Y Z 130 12120O*-------------------------------------------------------------------- 12130O E 73 12140O* PUT MESSAGE. 12150O NUL 132 12160O BIT,28 1 12170O 2 '8' 12180O LOC 5 12190O 8 '098' 12200O MGTEXT 43 12210O 96 BIT,8 132 12220O*------------------------------------------------------------------- 12230O E 74 12240O* PUT SCHED TOTALS. 12250O 76 'TOTALS ' ÐÐ12260O TOTWMQ2 86 12270O TOTRELK 96 12280O TOTRCDK 106 12290O TOTOPNK 116 12300O TOTNR K 126 12310O BIT,28 131 12320O 132 'K' 12330O*------------------------------------------------------------------- 12340O E 81 12350O 16 'SECONDARY UPDATE' 12360O 31 'IN PROGRESS...' 12370O 43 'PLEASE WAIT' 12380O******************************************************************** 12390OPMMST2 E 82 70 12400O PMNOBM 14P 12410O PLT 128P 12420O PMOHB 314P 12430O PMALB 322P 12440O PMPWOB 354P 12450O PMRWOB 358P 12460O PMPRCT 370P 12470O PMFRCT 403P 12480O PMOSUC 493P 12490O****************************************************************** 12500OWMPULL EADD 82N41 70 ÐÐ12510O OR 47 70 12520O TWO 6 12530O 9 '000' 12540O PULLNO 12 12550O SAVPN 22 12560O START 28 12570O DUEDAT 34 12580O TQTY 38P 12590O TPC 39 12600O 40 'Y' 12610O ZERO5 43P 12620O 46 'A' 12630O******************************************************************* 12640OSFMAST EADD 86 60 70 12650O KEYSF 29 12660O SFQTY 33P 12670O SFQTYC 37P 12680O TODAY 43 12690O ZERO5 46P 12700O PMECHG 66 12710O WM20 90 12720O ZERO3 97P 12730O START 103 12740O**** SAVSD 103 12750O ZERO7 123P ÐÐ12760O ZERO7 127P 12770O SFSTAT 128 12780O*---------------------------------------------------------------- 12790O E 86N60 70 12800O SFQTY 33P 12810O SFQTYC 37P 12820O TODAY 43 12830O ZERO5 43 12840O PMECHG 66 12850O WM20 90 12860O ZERO3 97P 12870O START 103 12880O**** SAVSD 103 12890O ZERO7 123P 12900O ZERO7 127P 12910O SFSTAT 128 12920O******************************************************************* 12930OALTKEY EADD 87 60 70 12940O KEYAK 29 12950O AKSTAT 32 12960O*--------------------------------------------------------------- 12970O E 87N60 70 12980O AKSTAT 32 12990O***************************************************************** 13000OWMLUWO E 44 ÐÐ13010O WLNO 7 13020O****************************************************************** 13030OWMMAST E 82 13040O WA$ 82P 13050O WMSTK$ 88P 13060O WMVAR$ 94P 13070O WMQRCD 98P 13080O WMQ 358P 13090O WLT 410P 13100O 41 WMQREL 420P 13110O N41 NEWREL 420P 13120O WMCHG 435P 13130O WMPULL 443P 13140O*---------------------------------------------------------------- 13150O EADD 47 13160O TWO 6 13170O SVDESC 46 13180O WA$ 82P 13190O WMSTK$ 88P 13200O WMVAR$ 94P 13210O WMQRCD 98P 13220O SVD 254 13230O OLD 358P 13240O SVL 410P 13250O WMCLOS 416 ÐÐ13260O NEWREL 420P 13270O SAVPN 431 13280O PMECHG 433 13290O WMCHG 435P 13300O TODAY 441 13310O PULLNO 443P 13320O SAVABM 453 13330O SAVAR 463 13340O 470 'A' 13350O******************************************************************** 13360OSFPNA EADD 82 13370O WMPN 10 13380O******************************************************************** 13390OWMUPDATEEADD 82 70 13400O OR 47 70 13410O* RESCHED REQUIREMTS TRANS. 13420O PORT 2 13430O TWO 8 13440O 10 'CW' 13450O 16 ' ' 13460O******************************************************************* ** NUL ARRAY 013470 013480** A16 ARRAY 013490 013500ÐÐ** DUN ARRAY 013510 013520** A29 ARRAY 13530 13540** AK ARRAY 13550 13560** A9 ARRAY 013570 13580** DOT ARRAY 13590 - - - - - - - - - -> 13600** RCD ARRAY 13610 13620** OPN ARRAY 13630 13640** REL ARRAY 13650 13660** NR ARRAY 13670 13680** OLD ARRAY 13690 13700** SVD ARRAY 13710 13720** SVL ARRAY 13730 13740** NUM ARRAY 13750ÐÐ002 QTY 13760/* 13770_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–ß –?X047PM P 999999120282(èÈÐ00010H Q047PM00020F* LIST MFD PART #'S AND/OR ASSYS STARTING WITH INPUT #. (X047PM) 00030F* REVISED 1-29-82 2:45 PM. 00040FBITTAB IP F 33 DISK 00050FPMMST2 ID F 674L12AI 1 DISK 00060FBMWU ID F 21L20AI 1 DISK 00070FRMMAST ID F 140L15AI 1 DISK 00080FPRINT O F 132 OF PRINTER 00090FTERM23 O F 23 5 00100E******************************************************************** 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160IPMMST2 PM 00170I 1 100PMPN 00180I P 13 140PMNOBM 00190I 19 30 PMMODL 00200I 31 59 PMDESC 00210I 94 95 PMSC 00220I P 315 3180PMFRCB 00230I 487 488 PMFAB 00240I 620 620 PMDCAN 00250I 674 674 PMSTAT ÐÐ00260I***************************************************************** 00270IBMWU BW 00280I 1 100BWPN 00290I 21 21 BWSTAT 00300I******************************************************************** 00310IRMMAST RM 00320I 1 100RMPN 00330I 140 140 RMSTAT 00340C******************************************************************** 00350C MOVE ' ' BLK12 12 00360C MOVE BLK12 W12A 12 00370C MOVELBIT,1 BUFLGT 2 00380C MOVE BIT,7 BUFLGT 00390C SETON 71 00400C EXCPT PROMPT 00410C SETOF 71 00420C EXITFQWREED READ CRT 00430C RLABL W12A 00440C RLABL BUFLGT 00450C Z-ADD12 W2N 20 00460C EXIT SUBRAJ 00470C RLABL W2N 00480C RLABL W12A 00490C MOVE W12A W10A 10 00500C MOVE BLK12 W12A ÐÐ00510C MOVELW10A W12A 00520C W12A SETLLPMMST2 00530C*--------------------------------------------------------------------- 00540C START TAG 00550C SETOF 5481 00560C SETOF 404142 00570C READ PMMST2 54 00580C 54 GOTO END 00590C PMPN COMP LASTPN 54 00600C N54 GOTO END 00610C PMSTAT COMP 'D' 54 00620C 54 GOTO START 00630C PMDCAN COMP ' ' 54 00640C 54 GOTO START 00650C Z-ADDPMPN LASTPN 100 00660C MOVELPMSC W1A 1 00670C W1A COMP 'M' 54 00680C PMNOBM COMP 0 40 00690C N54N40 GOTO START 00700C MOVELPMPN W20A 20 00710C W20A SETLLBMWU 00720C Z-ADD0 LASTBW 00730C*----------------------------------------------------------------- 00740C BEGIN TAG 00750C SETOF 54 ÐÐ00760C READ BMWU 54 00770C 54 GOTO BEGIN2 00780C BWPN COMP LASTBW 54 00790C N54 GOTO BEGIN2 00800C Z-ADDBWPN LASTBW 100 00810C BWPN COMP PMPN 54 00820C N54 GOTO BEGIN2 00830C BWSTAT COMP 'D' 54 00840C 54 GOTO BEGIN 00850C SETON 41 00860C*------------------------------------------------------------------- 00870C BEGIN2 TAG 00880C MOVELPMPN W15A 15 00890C W15A SETLLRMMAST 00900C*------------------------------------------------------------------- 00910C READRM TAG 00920C SETOF 54 00930C READ RMMAST 54 00940C 54 GOTO CONTU 00950C RMPN COMP PMPN 54 00960C N54 GOTO CONTU 00970C RMSTAT COMP 'D' 54 00980C 54 GOTO READRM 00990C SETON 81 01000C*------------------------------------------------------------------- ÐÐ01010C CONTU TAG 01020C PMFRCB COMP 0 42 01030C SETON 80 01040C EXCPT 01050C SETOF 804041 01060C SETOF 8142 01070C GOTO START 01080C*--------------------------------------------------------------- 01090C END TAG 01100O***************************************************************** 01110OPRINT H 201 1P 01120O OR OF 01130O 67 'PARTS,MFD,STARTING WITH' 01140O 80 'INPUT PART #' 01150O UDATE Y 8 01160O 127 'PAGE' 01170O PAGE Z 132 01180O*------------------------------------------------------------------- 01190O H 2 1P 01200O OR OF 01210O 10 'PART #' 01220O 26 'DESCRIPTION' 01230O 50 'MODEL' 01240O 70 'SOURCE-CODE' 01250O 80 'FAB-CODE' ÐÐ01260O 92 'ROUTING?' 01270O 104 'COMPONENTS' 01280O 116 'WHERE-USED' 01290O 128 'FORECAST' 01300O*------------------------------------------------------------------- 01310O EF 1 80 01320O PMPN 12 ' - - ' 01330O PMDESC 43 01340O PMMODL 57 01350O PMSC 65 01360O PMFAB 77 01370O 81 89 'YES' 01380O 40 100 'YES' 01390O 41 113 'YES' 01400O 42 PMFRCB2 128 01410O******************************************************************** 01420OTERM23 E 71 01430O 21 'ENTER STARTING PART #' /* 01440_‚ ÐÐ_‚_‚0O 92 'ROUTING?' 01270O 104 'COMPONENTS' 01280O 116 'WHERE-USED' 01290O 128 'FORECAST' 01300O*------------------------------------------------------------------- 01310O EF 1 80 01320O PMPN 12 ' - - ' 01330O PMDESC 43 01340O PMMODL 57 01350O PMSC 65 01360O PMFAB 77 01370O 81 89 'YES' 01380O 40 100 'YES' 01390O 41 113 'YES' 01400O 42 PMFRCB2 128 01410O******************************************************************** 01420OTERM23 E 71 01430O 21 'ENTER STARTING PART #' /* 01440_‚ ÐÈ(  X903SF P999999120282(èÈÐ00010H Q903SF00020F* REORG AKMAST - OMIT DELETED RECORDS ONLY 00030FOLDAK IP F 32 29AI 1 DISK 00040FNEWAK O F 32 29AI 1 DISK U 00050IOLDAK OS 01 32 NCD 00060I 1 32 REC 00070I GG 02 00080ONEWAK D 01 00090O REC 32 /* 00100_‚ ÐÐ _‚_‚0I 1 32 REC 00070I GG 02 00080ONEWAK D 01 00090O REC 32 /* 00100_‚ ÐÈ(ú- úiX091RM P999999120282(èÈÐ00010H Q091RM00020F* GENERATE ROUTING FROM PMMST2HOURS - CONVERSION ONLY. (X091RM) 00030F* REVISED 9/24/80 5:30 PM. 00040FPMMST2 IP F 674 12AI 1 DISK 00050FRMMAST UC F 140R15AI 1 DISK A 00060FTERM20 O F 20 5 00070E DES 1 3 40 00071E PLT 8 3 0 LEAD TIME 00080I******************************************************************** 00090IRMMAST RM 00100I* ROUTING MASTER. 00110I* KEY AREA. 00120I* PART # 12A 00130I 1 12 RMPN 00140I* OPER SEQ # 3N 00150I 13 150RMSEQ 00160I* OPER GROUP CODE 2A 00170I 16 17 RMGRUP 00180I* OVERLAP % .2N 00190I 18 192RMOVLP 00200I* OPER CODE 5A 00210I 20 24 RMOPER 00220I* OPER DEPT. 00230I* DEPT # 5P 00240I P 25 270RMDEPT ÐÐ00250I* WORK CENTER 3P 00260I P 28 290RMWC 00270I* OPER DESCRIPTION 40A 00280I 30 69 RMDESC 00290I* LABOR STDS. 00300I* ACCOUNTING STD. 00310I* DATE ADOPTED 7P 00320I P 70 730RMADAT 00330I* SET-UP 9.3P 00340I P 74 783RMASU 00350I* RUN 9.3P 00360I P 79 833RMARUN 00370I* MIN CHARGE 7.2P 00380I P 84 872RMAMIN 00390I* STD LOT SIZE 7P 00400I P 88 910RMALOT 00410I* REVISED STDS. 00420I* DATE LAST REVISED 7P 00430I P 92 950RMRDAT 00440I* SET-UP 9.3P 00450I P 96 1003RMRSU 00460I* RUN 9.3P 00470I P 101 1053RMRRUN 00480I* MIN. CHARGE 7.2P 00490I P 106 1092RMRMIN ÐÐ00500I* STD LOT SIZE 7P 00510I P 110 1130RMRLOT 00520I* METHOD ESTAB 1A 00530I 114 114 RMMETH 00540I* JOB SKILL 5A 00550I 115 119 RMSKIL 00560I* PERFORM FACTOR. 00570I* ACTUAL 5.2P 00580I P 120 1222RMPER 00590I* ASSIGNED 5.2P 00600I P 123 1252RMPER2 00610I* NUMB LOTS RUN 5P 00620I P 126 1280RMLRUN 00630I* NUMB UNITS RUN 5P 00640I P 129 1310RMQRUN 00650I* FILLER 132 139 FFFFFF 00660I* RECORD STATUS 1A 00670I 140 140 RMSTAT 00680I******************************************************************** 00690IPMMST2 PM 01 674NCD 00700I* PART MASTER RECORD (XPMMST) 00710I* KEY AREA 00720I* PART NO. 10N 00730I 1 100PMPN 00740I* CUR COST DATE 6N ÐÐ00750I 294 2990PMCDAT 00760I* ASSY DEPT # 3P 00770I P 537 5380PMADEP 00780I* ASSY HRS 7.3P 00790I P 525 5283PMAHRS 00800I* TEST DEPT # 3P 00810I P 539 5400PMTDEP 00820I* TEST HOURS 7.3P 00830I P 529 5323PMTHRS 00840I* Q.C. DEPT # 3P 00850I P 541 5420PMQDEP 00860I* Q.C. HRS 7.3P 00870I P 533 5363PMQHRS 00880I* LOT QTY 5P 00890I P 484 4860PMOSLQ 00900I* FAB CODE 2A 00910I 487 488 PMFABC 00920I* STD UNIT COST 9.3P 00930I P 489 4933PMOSUC 00940I* LEAD TIME 3P X 8 00950I P 113 1280PLT 00960I* OLD STYLE MCN 5A 00970I 496 500 PMMCN 00980I* SPARES CODE 1A 00990I* 501 501 PMSPAR ÐÐ01010I* RECORD STATUS 1A 01020I* D = DELETED 01030I 674 674 PMSTAT 01040I GG 02 01050C******************************************************************** 01060C N79 EXSR SR101 01070C N01 GOTO END DELETED 01080C Z-ADDPMOSLQ LOT 70 01090C Z-ADDPMCDAT TODAY7 70 01100C Z-ADD1000 SEQ4 40 01110C*------------------------------------------------------------------- 01120C TAG10 TAG 01130C* DO QC HOURS. 01140C Z-ADD3 X 30 01150C PMQHRS COMP 0 54 01160C N54 GOTO TAG20 NO HRS 01170C SEQ4 SUB 1 SEQ4 01180C Z-ADDSEQ4 SEQ 30 01190C MOVELPMPN W15A 15 01200C MOVE SEQ W15A 01210C EXSR SR80 01220C N60N61 GOTO TAG10 01230C Z-ADDPMQHRS HOURS 93 01240C Z-ADDPMQDEP DEPT 50 01250C EXSR SR81 ÐÐ01260C*------------------------------------------------------------------- 01270C TAG20 TAG 01280C* DO TEST HRS. 01290C Z-ADD2 X 01300C PMTHRS COMP 0 54 01310C N54 GOTO TAG30 NO HRS 01320C SEQ4 SUB 1 SEQ4 01330C Z-ADDSEQ4 SEQ 30 01340C MOVELPMPN W15A 01350C MOVE SEQ W15A 01360C EXSR SR80 01370C N60N61 GOTO TAG20 01380C Z-ADDPMTHRS HOURS 01390C Z-ADDPMTDEP DEPT 01400C EXSR SR81 01410C*------------------------------------------------------------------- 01420C TAG30 TAG 01430C* DO ASSY HRS. 01440C Z-ADD1 X 01450C PMAHRS COMP 0 54 01460C N54 GOTO END 01470C SEQ4 SUB 1 SEQ4 01480C Z-ADDSEQ4 SEQ 01490C MOVELPMPN W15A 01500C MOVE SEQ W15A ÐÐ01510C EXSR SR80 01520C N60N61 GOTO TAG30 01530C Z-ADDPMAHRS HOURS 01540C Z-ADDPMADEP DEPT 01550C EXSR SR81 01560C*------------------------------------------------------------------- 01570C END TAG 01580C******************************************************************** 01590CSR SR80 BEGSR 01600C* GET ROUTING. 01610CSR SETOF 61 01620CSR W15A CHAINRMMAST 60 01630CSRN60 RMSTAT COMP 'D' 61 01640CSR ENDSR 01650C******************************************************************** 01660CSR SR81 BEGSR 01670CSR SETON 81 01680CSR EXCPT 01690CSR SETOF 81 01700CSR ENDSR 01710C******************************************************************** 01720CSR SR101 BEGSR 01730CSR Z-ADD0 ZERO2 20 01740CSR Z-ADD0 ZERO3 30 01750CSR Z-ADD0 ZERO9 90 ÐÐ01760CSR Z-ADD0 ZERO7 70 01770CSR Z-ADD0 ZERO5 50 01780CSR ENDSR 01790O******************************************************************** 01800ORMMAST EADD 81 60 01810O W15A 15 01820O 17 ' ' 01830O ZERO2 19 01840O 24 ' ' 01850O DEPT 27P 01860O ZERO3 29P 01870O DES,X 69 01880O TODAY7 73P 01890O ZERO9 78P 01900O HOURS 83P 01910O ZERO7 87P 01920O LOT 91P 01930O TODAY7 95P 01940O ZERO9 100P 01950O HOURS 105P 01960O ZERO7 109P 01970O LOT 113P 01980O 114 'C' 01990O 119 ' ' 02000O ZERO5 122P ÐÐ02010O ZERO5 125P 02020O ZERO5 128P 02030O ZERO5 131P 02040O 140 'G' 02050O*------------------------------------------------------------------- 02060O E 81N60 02070O 17 ' ' 02080O ZERO2 19 02090O 24 ' ' 02100O DEPT 27P 02110O ZERO3 29P 02120O DES,X 69 02130O TODAY7 73P 02140O ZERO9 78P 02150O HOURS 83P 02160O ZERO7 87P 02170O LOT 91P 02180O TODAY7 95P 02190O ZERO9 100P 02200O HOURS 105P 02210O ZERO7 109P 02220O LOT 113P 02230O 114 'C' 02240O 119 ' ' 02250O ZERO5 122P ÐÐ02260O ZERO5 125P 02270O ZERO5 128P 02280O ZERO5 131P 02290O 140 'G' 02300O******************************************************************** 02310OTERM20 E 81 02320O PMPN 12 ' - - ' ** 002330FABRICATE OR ASSEMBLE PER DRAWING 002340TEST PER DRAWING/SPECIFICATIONS 002350INSPECT PER DRAWING 002360/* 002370_‚ ÐÐ_‚_‚0O ZERO5 125P 02270O ZERO5 128P 02280O ZERO5 131P 02290O 140 'G' 02300O******************************************************************** 02310OTERM20 E 81 02320O PMPN 12 ' - - ' ** 002330FABRICATE OR ASSEMBLE PER DRAWING 002340TEST PER DRAWING/SPECIFICATIONS 002350INSPECT PER DRAWING 002360/* 002370_‚ ÐÈ(— ¼XQPM02 P999999120282(èÈÐ00010H QQPM0200020F* PART MASTER DISPLAY MENU. (XQPM02) 00030F* REVISED 8-09-82 3:45 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070E******************************************************************** 00080E PA 1 23 8 NA 50 PROGRAM #/NAMES 00090E PB 1 23 8 NB 50 PROGRAM #/NAMES 00100E NUL 1 132 1 NULL CHAR 00110E A4 4 4 1 A 00120E TITL 1 6 66 MENU TITLE,HEADINGS 00130E MSG 1 3 25 00140E SEL 1 46 8 00150E PRG 1 23 8 NAM 50 AWORK ARRAY 00160E LNK 1 7 6 A 00170E BIT 33 1 00180E PAR 25 1 00190E TST 25 1 00200E CALL 7 6 A 00210E REC 177 1 00220I******************************************************************** 00230IBITPAR BT 02 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I******************************************************************** 00280ICRTFILE CR 00290I 19 26 CRJOB 00300I 27 27 CRSHUT 00310I 28 330CRTIME 00320I 34 370CRDATE 00330I 38 79 CALL 00340I 80 256 REC 00350C******************************************************************** 00360C EXSR SR101 INIT 00370C EXSR SR102 DISPLAY MENU 00380C EXSR SR103 REQUEST SELECTION 00390C*------------------------------------------------------------------ 00400C NEWITM TAG 00410C MOVEL'QQPM02' PROG 8 00420C EXSR SR98 <<>> 00430C*------------------------------------------------------------------ 00440C MENU TAG 00450C EXSR SR97 <<>> 00460C*--------------------------------------------------------------------- 00470C GOODBY TAG 00480C MOVEL'GOODBY' PROG 8 00490C EXSR SR98 <<>> 00500C*----------------------------------------------------------------- ÐÐ00510C ENDJOB TAG <<>> 00520C MOVEL'ENDJOB 'PROG 00530C EXITFCHAIN 00540C RLABL PROG 00550C************************************************************************ 00560CSR SR68 BEGSR 00570CSR EXITFZLFCR LF/CR 00580CSR ENDSR 00590C***************************************************************** 00600CSR SR69 BEGSR 00610C* MOVE CURSOR 00620CSR 50 EXITFZPUTXY 00630CSR RLABL RPGLIN 00640CSR RLABL RPGCOL 00650CSRN50 EXITFZMOVXY 00660CSR RLABL RPGLIN 00670CSR RLABL RPGCOL 00680CSR ENDSR 00690C**************************************************************** 00700CSR SR70 BEGSR 00710CSR MOVELW66A OUTPUT 80 00720CSR EXITFZW80 WRITE 80-BYTES CRT 00730CSR RLABL OUTPUT 00740CSR ENDSR 00750C****************************************************************** ÐÐ00760CSR SR71 BEGSR 00770CSR MOVELREQST RPGLIN 00780CSR MOVEL'067' RPGCOL 00790CSR EXSR SR69 MOVE CURSOR 00800CSR 50 EXITFZBLINK START BLINK 00810CSR EXSR SR70 WRITE MESSAGE 00820CSR EXITFZBLUNK STOP BLINK 00830CSR ENDSR 00840C******************************************************************* 00850CSR SR72 BEGSR 00860CSR MOVE BLK66 W66A 00870CSR EXSR SR71 INIT MESSAGE 00880CSR ENDSR 00890C****************************************************************** 00900CSR SR75 BEGSR 00910C* READ CRT 00920CSR SETOF 7790 00930CSR MOVE BLK4 W4A 4 00940CSR EXITFZR4 READ CRT 00950CSR RLABL W4A 00960CSR MOVEAW4A A4 00970CSR MOVE BLK4 W4A 4 00980CSR Z-ADD1 W 30 00990CSR '\' LOKUPA4,W 90 01000CSRN90 GOTO T75C ÐÐ01010CSR 1 ADD W W 01020CSR W COMP 4 54 01030CSRN54 GOTO T75B 01040C*--------------------------------------------------------------- 01050CSR T75A TAG 01060C* FLAG BAD ESCAPE CODE 01070CSR MOVE BLK66 W66A 01080CSR MOVELMSG,3 W66A 01090CSR EXSR SR71 PUT ERROR MESSAGE 01100CSR GOTO SR75 01110C*-------------------------------------------------------------- 01120CSR T75B TAG 01130CSR A4,W COMP 'G' 98 01140CSR A4,W COMP 'E' 94 01150CSR A4,W COMP 'N' 93 01160CSR 98 GOTO GOODBY 01170CSR 94 GOTO MENU 01180CSR 93 GOTO NEWITM 01190CSR GOTO T75A BAD ESCAPE CODE 01200C*-------------------------------------------------------------------- 01210CSR T75C TAG 01220CSR Z-ADD1 W 01230CSR ' ' LOKUPA4,W 77 01240CSR 77 MOVEAA4,W W4A 01250CSR END75 TAG ÐÐ01260CSR EXSR SR72 INIT MESSAGE 01270CSR ENDSR 01280C******************************************************************** 01290CSR SR96 BEGSR 01300CSR # CHAINCRTFILE H9 GET CRTFILE 01310CSR H9 GOTO ENDJOB 01320CSR ENDSR 01330C***************************************************************** 01340CSR SR97 BEGSR 01350C* MENU REQUEST EXIT. 01360CSR Z-ADD1 W 30 01370CSR ' ' LOKUPLNK,W 54 01380CSRN54 MOVEL'CONTU' PROG 01390CSR 54 MOVELLNK,W PROG 8 01400CSR 54 MOVE ' ' LNK,W 01410CSR EXSR SR98 <<>> 01420CSR ENDSR 01430C**************************************************************** 01440CSR SR98 BEGSR 0UPDATE CRTFILE AND LINK TO PROG PROGRAM. 01460CSR 50 EXITFZISTAT 01470CSR 50 EXITFZESCH 01480CSRN50 EXITFZCPAGE 01490CSR # CHAINCRTFILE H8 01500CSR H8 <<>> 01510CSR MOVE LNK CALL ÐÐ 01520CSR MOVE ' ' REC MOVE PROG CRJOB 01540CSR MOVELUDATE CRDATE 01550CSR TIME CRTIME 01560CSR SETON 97 01570CSR EXCPT UPDATE CRTFILE 01580CSR 97 01590CSR EXITFCHAIN <<>> 01600CSR RLABL PROG ENDSR 01620C******************************************************************* 01630CSR SR99 BEGSR 01640C* PROGRAM SELECTED - LOAD THIS MENU AS RETURN-TO PROG 01650CSR Z-ADD8 W 01660C*--------------------------------------------- 01670CSR T99A TAG 01680CSR W SUB 1 W 54 54 SETON H7 01700CSRN54 GOTO ENDJOB <<>> 01710CSR LNK,W COMP ' ' 01720CSRN54 GOTO T99A 01730CSR MOVEL'QQPM02' LNK,W 01740CSR R98 <<>> 01750CSR ENDSR 01760C***********************************************************C* 01780C* 01790C* ÐÐ 01800C* 01810C* 01820C* 01830C* 01840C*******************************************************1850CSR SR101 BEGSR 01860C* 1-TIME INIT 01870CSR MOVE B 01880CSR MOVEANUL OUTPUT 01890CSR MOVE ' ' W2A 2 01900 EXITFZGMINX GET TERMINAL # 01910CSR RLABL W2A 01920CSR MOVE W2A # 20 01930CSR # COMP 0 54 01940CSRN54 Z-ADD25 # 01950CSR # CH H9 01960CSR H9 GOTO ENDJOB <<>> 01970CSR MOVE CALL LNK 0# COMP '1' 50 01990CSR 50 EXITFZISTAT CLEAR STATUS LINE 02000CSR 50 EXITFZESCH 02010CSRN50 EXITFZCPAGE CLEAR SCREEN 02020CSRN50 MOVEL'091' RPGLIN 4 02030CSRN50 COL 4 02040CSRN50 EXSR SR69 MOVE CURSOR 02050CSR TST,# COMP 'S' 54 CRSHUT COMP 'S' 54 0ÐÐ2070CSR 54 MOVE 'SHUTDOWN'PROG 02080CSR 54 EXSR SR98 OGRAM>>> 02090CSR MOVE ' ' BLK50 50 02100CSR MOVE ' ' BLK66 66 02110CSR BLK132132 02120CSR MOVE ' ' BLK35 35 02130CSR MOVE ' ' BLK8 8 MOVE ' ' BLK4 4 02150C* 02160C* 02170CSR MOVE ' ' REC 02180CSR MOVE 'QQPM02 'CRJOB 02190CSR CRTIME 02200CSR MOVELUDATE CRDATE 02210CSR SETON 97 EXCPT REWRITE CRTFILE 02230CSR SETOF 97 02240CSR ENDSR 02250C********************************************************************** 02260CSR SR102 BEGSR 02270C* DISPL 02280CSR Z-ADD-1 M 20 02290CSR Z-ADD1 REQST 30 CSR 50 Z-ADD0 W3N 30 02310CSRN50 Z-ADD90 W3N 02320C*------------------------------------------------- 02330CSR T102A TAG 02340CSR MOVE BLK132 ÐÐ W132A 132 02350CSR D M M 20 02360CSR M COMP 5 54 02370CSR 54 GOTO T102C 2380CSR 1 ADD M A 20 02390CSR TITL,M COMP BLK66 54 02400CSR 54 MOVELT 02410CSR TITL,A COMP BLK66 55 02420CSR 55 MOVE TITL,A W132A 02430 GOTO T102A 02440CSR 1 ADD W3N W3N 02450CSR MOVELW3N RPGLIN 4 02460CSR MOVEL'001' RPGCOL 4 02470CSR EXSR SR69 MOVE CURSOR 02480CSR EX WRITE TITLE LINE 02490CSR RLABL W132A 02500CSR Z-ADDW3N REQST 30 0 GOTO T102A 02520C*---------------------------------------------------------------- T102A 02440CSR 1 ADD W3N W3N 02450CSR MOVELW3N RPGLIN 4 02460CSR MOVEL'001' RPGCOL 4 02470CSR EXSR SR69 MOVE CURSOR 02480CSR EXITFZW132 WRITE TITLE LINE 02490CSR RLABL W132A 02500CSR Z-ADDW3N REQST 30 ÐÐ02510CSR GOTO T102A 02520C*---------------------------------------------------------------- 02530CSR T102C TAG 02540CSR Z-ADD0 M 02550CSR Z-ADD0 S 20 02560CSR MOVE BLK8 SEL 02570CSR 1 ADD REQST REQST 02580CSR Z-ADDREQST W3N 30 02590CSR MOVE PA PRG 02600CSR MOVE NA NAM 02610CSR MOVEL'001' RPGCOL 02620CSR EXSR SR201 OUTPUT MENU 02630CSR MOVE PB PRG 02640CSR MOVE NB NAM 02650CSR MOVEL'067' RPGCOL 02660CSR Z-ADDREQST W3N 02670CSR EXSR SR201 OUTPUT MENU 02680CSR ENDSR 02690C******************************************************************** 02700CSR SR103 BEGSR 02710C* REQUEST SELECTION. 02720C*------------------------------------------------------------------- 02730CSR MOVEANUL W66A 66 02740CSR MOVELMSG,1 W66A 02750CSR MOVELREQST RPGLIN 4 ÐÐ02760CSR MOVEL'001' RPGCOL 4 02770CSR EXSR SR69 MOVE CURSOR 02780CSR EXSR SR70 WRITE PROMPT 02790CSR EXSR SR75 READ CRT 02800CSR Z-ADD4 W2N 20 02810CSR EXIT SUBRAJ RJ 02820CSR RLABL W2N 02830CSR RLABL W4A 02840CSR MOVE W4A S 20 02850CSR S COMP 0 54 02860CSR 54 S COMP 46 5454 02870CSR 54 SEL,S COMP BLK8 54 02880CSR 54 MOVELSEL,S PROG 8 02890CSR 54 EXSR SR99 <<>> 02900CSR MOVELBLK66 W66A 02910CSR MOVE MSG,2 W66A 02920CSR EXSR SR71 PUT MESSAGE 02930CSR GOTO SR103 REQUEST AGAIN 02940CSR ENDSR 02950C********************************************************************* 02960CSR SR201 BEGSR 02970C* DISPLAY PROGRAM SELECTIONS 02980CSR Z-ADD1 M 20 02990C*------------------------------------------------------------------ 03000CSR T201C TAG ÐÐ03010CSR BLK50 LOKUPNAM,M 54 03020CSRN54 GOTO END201 03030CSR 1 ADD W3N W3N 03040CSR MOVELW3N RPGLIN 03050C* 03060CSR PRG,M COMP BLK8 55 03070CSR 55 1 ADD S S 03080CSR 55 MOVE PRG,M SEL,S SAVE PROG NAME 03090CSR MOVEANUL W66A 03100CSR MOVE BLK66 W54A 54 03110CSR 55 MOVELS W54A 03120CSR 55 S COMP 9 54 03130CSR 55N54 MOVEL' ' W54A 03140CSR MOVE NAM,M W54A 03150CSR MOVELW54A W66A 03160CSR MOVE '. ' W66A 03170CSR EXSR SR69 MOVE CURSOR 03180CSR EXSR SR70 DISPLAY ENTRY 03190CSR MOVE BLK50 NAM,M 03200CSR GOTO T201C 03210CSR END201 ENDSR 03220C* 03230C* 03240C* 03250C* ÐÐ03260O*************************************************************** 03270OCRTFILE E 97 03280O CRJOB 26 03290O CRTIME 33 03300O CRDATE 37 03310O CALL 79 03320O REC 256 03330O******************************************************************** ** PA/NA ARRAY 03340Q032PM PART MASTER INQUIRY, FULL DETAIL 1 03350Q011PM PART MASTER LIST, 1 LINE PER PART # 2 03360 3 03370 4 03380 5 03390 6 03400 7 03410 8 03420 9 03430 10 03440 11 03450 12 03460 13 03470 14 03480 15 03490 16 03500ÐÐ 37 03510 18 03520 19 03530 20 03540 21 03550 22 03560 23 03570** PB/NB ARRAY 03580Q018PM PART #/MCN CROSS REFERENCE LIST 1 03590 2 03600 3 03610 4 03620 5 03630 6 03640 7 03650 8 03660 9 03670 10 03680 11 03690 12 03700 13 03710 14 03720 15 03730 16 03740 17 03750ÐÐ 18 03760 19 03770 20 03780 21 03790 22 03800 23 03810** NUL ARRAY 03820 03830** A4 ARRAY 03840 03850** TITL ARRAY (EA ELEMENT = 1/2 TITLE LINE) 03860 P A R T M A S T E R D 03870 I S P L A Y M E N U 03880<------------------------------------------------> 03890<------------------------------------------------> 03900 03910 03920** MSG ARRAY 03930ENTER SELECTION NO.: 03940INVALID... TRY AGAIN: 03950\ CODE INVALID.... TRY AGAIN: 03960** SEL ARRAY 03970 03980** PRG/NAM ARRAY 03990 04000ÐÐ** LNK ARRAY 04010 04020/* 04030_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(T §X017GL P120282120282(èÈÐ00010H Q017GL00020F* PRINT CHART OF ACCOUNTS- INDENTED. (X017GL) SYSTEM PRINTER 00030F* REVISED 4-14-82 11:30 AM. 00040F* NOTE: MUST BE RUN FROM PROCEDURE Z017GL. 00050FGLGUIDE IP AF 9 DISK 00060FGLWU IS AF 19 18AI 1 DISK 00070FCAMAST ID F 40L18AI 1 DISK 00080FGLMAST IC F 165R 9AI 1 DISK 00090FPRINT O F 132 OF LPRINTER 00100F**************************************************************** 00110E LEV 1 20 18 00120E DASH 1 1 43 00130E A24 24 24 1 00140E DOTS 43 43 1 00150E GLA 12 11 2 00160L******************************************************************** 00170LPRINT 88FL 80OL 00180I******************************************************************** 00190IGLGUIDE GG 01 00200I 1 9 GGACT L1M1 00210I 2 60GGPRIM 70 00220I******************************************************************** 00230IGLWU GW 02 19NCD 00240I 1 9 GWSUB L1M1 00250I 10 18 GWPAR ÐÐ00260I 19 19 GWSTAT 00270I WG 03 00280I******************************************************************** 00290IGLMAST GL 00300I* ACCOUNT MASTER. 00310I* KEY AREA 00320I* ACCOUNT # 9A 00330I 1 9 GLKEY 00340I 1 1 GLPRFX 00350I 2 60GLPRIM 00360I 7 90GLDASH 00370I* ACCOUNT GROUP 4A 00380I 14 17 GLGRUP 00390I* ACCOUNT DESCRIPTION 40A 00400I 18 57 GLDESC 00410I* BALANCE FORWARD AMOUNT 11.2P 00420I P 58 632GLBALF 00430I* ACTUAL $ 11.2P X 12 00440I P 64 135 GLA 00450I* CURRENT MONTH-PLUS 11.2P 00460I P 136 1412GLCMP 00470I* CURRENT MONTH-MINUS 11.2P 00480I P 142 1472GLCMM 00490I* SOURCE CODE 1A 00500I* S = SUB-ACCOUNT ONLY, ÐÐ00510I* MAY NOT BE PARENT 00520I 148 148 GLSC 00530I* BALANCE FORWARD CODE 2A 00540I* 1ST COL 00550I* 1 = ZERO BAL AT START NEW YR 00560I* 2 = CARRY PREV YR FRWD 00570I* 2ND COL 00580I* A = ZERO BAL AT START NEW MO 00590I* B = CARRY PREV MO FRWD 00600I 149 150 GLBFC 00610I* NUMB OF SUB-ACCOUNTS 5P 00620I P 157 1590GLNOSA 00630I* LOW LEVEL CODE 3N 00640I 160 1620GLLL 00650I* FILLER 00660I* RECORD STATUS 1A 00670I 165 165 GLSTAT 00680I******************************************************************** 00690ICAMAST CA 00700I* CHART OF ACCOUNTS. 00710I* KEY AREA. 00720I* PARENT ACCOUNT 9A 00730I 1 9 CAPAR 00740I* SUB-ACCOUNT 9A 00750I 10 18 CASUB ÐÐ00760I* OPERATOR 1A 00770I* S = SUBTRACT 00780I* A = ADD 00790I 25 25 CAOPER 00800I* EFFECTIVITY 00810I* START DATE 6N (YMD) 00820I 26 310CASDAT 00830I* END DATE 6N (YMD) 00840I 32 370CAEDAT 00850I* FILLER 00860I* RECORD STATUS 1A 00870I 40 40 CASTAT 00880C******************************************************************** 00890C N79 EXSR SR101 INIT. 00900C MR 00910CORN70 00920CORN01 GOTO END 00930C EXSR SR106 00940C*------------------------------------------------------------------- 00950C END TAG 00960C******************************************************************** 00970CSR SR71 BEGSR 00980C* PUT HEADINGS TO TERMINAL 00990CSR 1 ADD EGAP EGAP 40 01000CSR MOVELGGACT W9A ÐÐ01010CSR EXSR SR80 GET TOP GLMAST 01020CSR EXSR SR204 SET-UP ACTNO 01030CSR SETON 71 01040CSR EXCPT PUT HEADINGS 01050CSR SETOF 71 01060CSR Z-ADD8 COUNT 30 01070CSR ENDSR 01080C********************************************************************* 01090CSR SR72 BEGSR 01100C* PUT DATA TO TERMINAL 01110CSR 1 ADD COUNT COUNT 30 01120CSR MOVE CASUB W9A 01130CSR EXSR SR80 GET GLMAST 01140CSR EXSR SR203 FLAG LEVEL 01150CSR EXSR SR204 BUILD ACCT # 01160CSR SETON 7278 01170CSR EXCPT PUT DATA 01180CSR SETOF 72 01190CSR COUNT COMP 80 54 54 01200CSRN54 GOTO END72 01210CSR EXSR SR71 PUT HEADING 01220CSR END72 ENDSR 01230C********************************************************************** 01240CSR SR80 BEGSR 01250C* GET MASTER RECORD ÐÐ01260CSR W9A CHAINGLMAST 60 GET MASTER 01270CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 01280CSR ENDSR 01290C*********************************************************************** 01300CSR SR101 BEGSR 01310C* 1-TIME INITIALIZE 01320CSR SETON 79 01330CSR MOVE ' ' BLK8 8 01340C* DEFINE WORK FIELDS,ETC. 01350CSR MOVE ' ' BLK35 35 01360CSR MOVE ' ' BLK9 9 01370CSR MOVE ' ' BLK18 18 01380CSR MOVE BLK18 BLK43 43 01390CSR ENDSR 01400C**************************************************************** 01410CSR SR106 BEGSR 01420C* DISPLAY CHART OF ACCOUNTS 01430CSR SETOF 78 01440CSR MOVE GGACT W9A 9 01450CSR EXSR SR80 GET GLMAST 01460CSR MOVE GLDESC PADESC 40 01470CSR MOVE GLSC PASC 1 01480CSRN77 EXSR SR71 HEADING,1ST PAGE 01490CSR 77 SETON 76 01500CSR 77 EXCPT PUT SPACE LINES ÐÐ01510CSR 77 EXCPT 01520CSR 77 SETOF 76 01530CSR 2 ADD COUNT COUNT 01540CSR Z-ADD1 L 30 01550CSR EXSR SR203 FLAG LEVEL 01560CSR EXSR SR204 BUILD ACTNO 01570CSR SETON 7477 01580CSR EXCPT PUT LEVEL-1 01590CSR SETOF 74 01600CSR 1 ADD COUNT COUNT 01610CSR MOVE BLK18 LEV 01620CSR Z-ADD3 L 01630CSR MOVELGGACT LEV,2 01640C*------------------------------------------------------------------- 01650CSR T106A TAG 01660C* GET SAVED LOWER LEVEL SUB-ACCOUNTS, IF ANY. 01670CSR L SUB 1 L 54 INDENT LEVEL 01680CSRN54 GOTO T106R 01690CSR LEV,L COMP BLK18 54 01700CSRN54 GOTO T106A NONE THIS LEVEL 01710CSR MOVELLEV,L W18A 18 01720CSR MOVELLEV,L CURACT 9 MACH ACNT # 01730CSR MOVE BLK18 LEV,L 01740CSR SETON 75 01750CSR EXCPT ÐÐ01760CSR SETOF 75 01770CSR 1 ADD COUNT COUNT 01780C*------------------------------------------------------------------- 01790CSR T106B TAG 01800CSR W18A SETLLCAMAST 01810C*------------------------------------------------------------------- 01820CSR T106C TAG 01830C* READ CHART ACCOUNTS FILE. 01840CSR SETOF 54 01850CSR READ CAMAST 54 01860CSR 54 GOTO T106A END FILE 01870CSR CAPAR COMP CURACT 54 01880CSRN54 GOTO T106A END ASSY 01890CSR CASTAT COMP 'D' 54 01900CSR 54 GOTO T106C DELETED 01910C* DISPLAY LINE ENTRY. 01920CSR EXSR SR72 PUT DATA 01930C* BRANCH IF NOT PARENT. 01940CSR GLNOSA COMP 0 54 01950CSRN54 GOTO T106C NOT PARENT 01960C*------------------------------------------------------------------- 01970CSR T106D TAG 01980C* SAVE CUR ACCT + 1 AND CHASE NEXT LOWER INDENT. 01990CSR MOVE CASUB W9A 02000CSR MOVE CASUB W3N 30 ÐÐ02010CSR 1 ADD W3N W3N 02020CSR MOVE W3N W9A 02030CSR MOVE W9A LEV,L 02040CSR MOVELCURACT LEV,L SAVE PAR/SUB 02050CSR MOVE CASUB CURACT 02060CSR MOVELCASUB W18A 02070CSR MOVE BLK9 W18A 02080CSR 1 ADD L L NEW INDENT LEV 02090CSR SETON 75 02100CSR EXCPT 02110CSR SETOF 75 02120CSR 1 ADD COUNT COUNT 02130CSR GOTO T106B CHASE DOWN 02140C*------------------------------------------------------------------- 02150CSR T106R TAG 02160CSR END106 ENDSR 02170C******************************************************************** 02180CSR SR203 BEGSR 02190C* FLAG INDENTURE LEVEL. 02200CSR L COMP 1 2121 02210CSR L COMP 2 22 02220CSR L COMP 3 23 02230CSR L COMP 4 24 02240CSR L COMP 5 25 02250CSR L COMP 6 26 ÐÐ02260CSR L COMP 7 27 02270CSR L COMP 8 28 02280CSR L COMP 9 29 02290CSR L COMP 10 30 02300CSR L COMP 11 31 31 02310CSR 21 Z-ADD1 L 02320CSR MOVEADASH DOTS 02330CSR 3 MULT L X 30 02340CSR X SUB 2 X 02350CSR X COMP 43 54 02360CSR 54 GOTO END203 02370CSR MOVEABLK43 DOTS,X 02380CSR MOVEADOTS W43A 43 02390CSR END203 ENDSR 02400C******************************************************************** 02410CSR SR204 BEGSR 02420C* BUILD ACTNO FIELD FOR OUTPUT. 02430CSR MOVEAGLPRFX A24 02440CSR GLPRFX COMP ' ' 54 02450CSRN54 MOVEA'_' A24,1 02460CSR MOVE GLPRIM W5A 5 02470CSR MOVEAW5A A24,2 02480CSR MOVE '-' A24,7 02490CSR MOVE GLDASH W3A 3 02500CSR MOVEAW3A A24,8 ÐÐ02510CSR MOVEAA24 ACTNO 10 02520CSR GLCMP SUB GLCMM CURNET 112 02530CSR ENDSR 02540O******************************************************************** 02550OPRINT E 101 71 02560O* PUT HEADING. 02570O UDATE Y 8 02580O 127 'PAGE' 02590O EGAP Z 132 02600O 67 'INDENTED CHART OF' 02610O 76 'ACCOUNTS' 02620O*------------------------------------------------------------------- 02630O E 71 02640O 19 'ACCOUNT NO.' 02650O 90 'TYPE' 02660O 95 'OPER' 02670O 99 'GRP' 02680O 114 'EFFECTIVITY' 02690O 131 'CUR-MO.' 02700O*------------------------------------------------------------------- 02710O E 71 02720O* 02730O 1 '1' 02740O 4 '2' 02750O 7 '3' ÐÐ02760O 10 '4' 02770O 13 '5' 02780O 16 '6' 02790O 19 '7' 02800O 22 '8' 02810O 25 '9' 02820O 29 '10' 02830O 32 '11' 02840O 60 '<--------------' 02850O 71 'DESCRIPTION' 02860O 85 '------------->' 02870O 90 'CODE' 02880O 95 'CODE' 02890O 100 'CODE' 02900O 108 'START' 02910O 115 'STOP' 02920O 131 'NET-BAL' 02930O*------------------------------------------------------------------- 02940O E 71 02950O DASH 43 02960O*---------------------------------------------------------------- 02970O E 71 02980O*------------------------------------------------------------------- 02990O E 72 03000O* SUB-ACCOUNT DATA. ÐÐ03010O DASH 43 03020O 21 ACTNO 13 03030O 22 ACTNO 16 03040O 23 ACTNO 19 03050O 24 ACTNO 22 03060O 25 ACTNO 25 03070O 26 ACTNO 28 03080O 27 ACTNO 31 03090O 28 ACTNO 34 03100O 29 ACTNO 37 03110O 30 ACTNO 40 03120O 31 ACTNO 43 03130O GLDESC 85 03140O GLSC 88 03150O CAOPER 93 03160O GLGRUP 100 03170O CURNETK 132 03180O CASDAT 109 ' - - ' 03190O CAEDAT 118 ' - - ' 03200O*------------------------------------------------------------------- 03210O E 74 03220O OR 71 78 03230O DASH 43 03240O ACTNO 13 03250O 78 71 21 'CONT''D' ÐÐ03260O PADESC 85 03270O PASC 89 03280O CURNETK 132 03290O*------------------------------------------------------------------- 03300O E 75 03310O W43A 43 03320O*------------------------------------------------------------- 03330O E 76 03340O*------------------------------------------------------------- ** LEV ARRAY 03350 03360** DASH ARRAY 03370. . . . . . . . . . . . . . . 003380** A24 ARRAY 003390 003400** DOTS ARRAY 003410 003420/* 003430_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ü X013PC P999999120282(èÈÐ00010H Q013PC00020F* ADOPT MFG COST AS ACCTG COST UPDATE. (X013PC) 00030F* REVISED 8-25-81 9:30 AM. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FPMMST2 UC F 674R12AI 1 DISK 00090FTERM132 O F 132 5 00100F**************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A14 14 14 1 A INPUT DATA ARRAY 00130E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 1 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E PA$ 7 9 3 00170E PM$ 7 9 3 00180E ADP 3 3 0 00190E AHR 3 7 3 00200E MHR 12 7 3 00210E MDP 12 3 0 00220E BIT 33 1 SCREEN CONTR. CHAR 00230E CALL 5 6 CALL STACK 00240I******************************************************************* 00250IBITTAB BT ÐÐ00260I 1 33 BIT 00270I******************************************************************* 00280IMGFILE MG 00290I* MESSAGE FILE. 00300I 1 35 MGTEXT 00310I****************************************************************** 00320ICRTFILE CR 00330I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00340I* STD AREA - SAME FOR ALL PROGRAMS. 00350I* EMPLOYEE # 5N 00360I 1 50CREMPL 00370I* USER CODE 8A 00380I 6 13 CRUSER 00390I* DEPT # 5N 00400I 14 180CRDEPT 00410I* JOB NAME 8A (JOB LOADED BY MENU) 00420I 19 26 CRJOB 00430I* SHUTDOWN FLAG 1A 00440I* BLANK = NO SHUTDOWN 00450I 27 27 CRSHUT 00460I* TIME STARTED 6N 00470I 28 330CRTIME 00480I* DATE STARTED 4N 00490I 34 370CRDATE 00500I* CALL STACK 5 X 6A ÐÐ00510I 38 67 CALL 00520I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00530I 68 73 CRRET 00540I* MENU NAME 6A 00550I 74 79 CRMENU 00560I******************************************************************** 00570IPMMST2 PM 00580I* PART MASTER RECORD. 00590I* KEY AREA 00600I* PART NO. 10N 00610I 1 100PMPN 00620I* DESCRIPTION 29A 00630I 31 59 PMDESC 00640I* INVENTORY ACCOUNT 5P 00650I P 110 1120PMACNT 00660I*------------------------------------------------------------------- 00670I* STANDARD COSTS 9.3P X 7 00680I* ADDED COSTS 00690I* 1 = LABOR 00700I* 2 = LABOR BURDEN 00710I* 3 = MATERIAL 00720I* 4 = MATERIAL BURDEN 00730I* 5 = OUTSIDE PROC 00740I* CUM COSTS 00750I* 6 = LABOR ÐÐ00760I* 7 = MATERIAL 00770I P 185 219 PA$ 00780I* STANDARD LABOR HOURS. 00790I* STD LOT SIZE 7P 00800I P 220 2230PMSLOT 00810I* STD SET-UP HRS 9.3P 00820I P 224 2283PMSSUH 00830I* STD RUN HRS 9.3P 00840I P 229 2333PMSRH 00850I* STD COST DATE 6N 00860I 234 2390PMSDAT 00870I* STD COST CODE 1A 00880I* E = ESTIMATED 00890I* H = HISTORICAL 00900I* X = ACCOUNTING 00910I 240 240 PMSCCD 00920I* AVER LABOR **** 7.2P 00930I P 241 2442PMOSAL 00940I*------------------------------------------------------------------- 00950I* CURRENT COSTS 9.3P X 7 00960I* ADDED COSTS 00970I* 1 = LABOR 00980I* 2 = LABOR BURDEN 00990I* 3 = MATERIAL 01000I* 4 = MATERIAL BURDEN ÐÐ01010I* 5 = OUTSIDE PROC 01020I* CUM COSTS 01030I* 6 = LABOR 01040I* 7 = MATERIAL 01050I P 245 279 PM$ 01060I* CURRENT LABOR HOURS. 01070I* CUR LOT SIZE 7P 01080I P 280 2830PMCLOT 01090I* CUR SET-UP HRS 9.3P 01100I P 284 2883PMCSUH 01110I* CUR RUN HRS 9.3P 01120I P 289 2933PMCRH 01130I* CUR COST DATE 6N 01140I 294 2990PMCDAT 01150I* CUR COST CODE 1A 01160I* E = ESTIMATED 01170I* H = HISTORICAL 01180I* X = ACCOUNTING 01190I 300 300 PMCCCD 01200I* STD UNIT COST 9.3P 01210I P 489 4933PMOSUC 01220I* ACCOUNTING ROUTING HRS 3 X 7.3P 01230I P 525 536 AHR 01240I* ACCOUNTING ROUTING DEPT 3 X 3P 01250I P 537 542 ADP ÐÐ01260I* MFG ROUTING HRS 12 X 7.3P 01270I P 543 590 MHR 01280I* MFG ROUTING DEPT 12 X 3P 01290I P 591 614 MDP 01300I* STD UNIT COST- MFG 9.3P 01310I P 615 6193PMTCST 01320I* TO BE DELETED FLAG 1A 01330I* * = DELETE CANDIDATE 01340I 620 620 PMDELC 01350I* RECORD STATUS 1A 01360I* D = DELETED 01370I 674 674 PMSTAT 01380C******************************************************************** 01390C* INITIALIZE 01400C EXSR SR101 1-TIME INIT 01410C*------------------------------------------------------------------ 01420C START TAG 01430C* SET-UP 1ST FIELD NO. 01440C MOVE ' ' DUN INIT EDIT ARRAY 01450C Z-ADD1 F 30 FIELD # 01460C GOTO READ 01470C*------------------------------------------------------------------ 01480C NEXT TAG 01490C* SET-UP NEXT FIELD NO. 01500C 1 ADD F F FIELD # ÐÐ01510C*----------------------------------------------------------------- 01520C READ TAG 01530C* READ DATA FROM TERMINAL. 01540C SETOF 909677 01550C EXSR SR102 VALIDATE FIELD # 01560C 55 GOTO UPDATE DONE 01570C EXSR SR201 IDENTIFY-F 01580C SETON 69 01590C EXSR SR72 PROMPT 01600C SETOF 69 01610C EXSR SR75 READ TERMINAL 01620C 98 GOTO GOODBY GOODBY 01630C 94 GOTO MENU MENU REQUEST 01640C N77N88 EXSR SR104 EDIT INPUT FIELD 01650C 96 ERROR 01660CORN77N88 EXSR SR72 REWRITE INPUT DATA 01670C 93 GOTO NEWITM NEW ITEM 01680C 92 GOTO JUMP FIELD JUMP REQST 01690C 91 GOTO NEXT SKIP FORWARD 01700C 89 F SUB 1 F SKIP BACKWARD 01710C 89 GOTO READ " " 01720C 88 SETOF 90 SPACE FILL 01730C 88 SETON 77 " " 01740C 87 GOTO START 01750C 86 GOTO UPDATE UPDATE ÐÐ01760C 85 GOTO READ REPEAT 01770C 96 GOTO ERROR ERROR 01780C N77 GOTO EDIT NO DATA INPUT 01790C*------------------------------------------------------------------ 01800C PROCES TAG 01810C* PROCESS INPUT DATA 01820C EXSR SR103 MOVE DATA 01830C*------------------------------------------------------------------- 01840C EDIT TAG 01850C N96 EXSR SR104 EDIT DATA 01860C EXSR SR72 REWRITE DATA 01870C 96 GOTO ERROR ERROR 01880C GOTO NEXT 01890C*------------------------------------------------------------------ 01900C UPDATE TAG 01910C* UPDATE DATA BASE. 01920C EXSR SR105 FINAL EDIT 01930C 96 GOTO ERROR ERROR 01940C EXSR SR106 UPDATE 01950C 96 GOTO ERROR ERROR 01960C GOTO END 01970C*------------------------------------------------------------------- 01980C JUMP TAG 01990C* SET-UP JUMP TO REQUESTED FIELD 02000C 1 ADD W W 30 ÐÐ02010C W COMP 14 54 02020C 54 Z-ADD318 M 50 96 FLAG ERROR 02030C 54 GOTO ERROR BAD ESC 02040C MOVE ' ' W3A 3 02050C MOVEAA14,W W3A 02060C Z-ADD3 W2N 20 02070C EXIT SUBRAJ R. JUSTIFY 02080C RLABL W2N 02090C RLABL W3A 02100C MOVE W3A F NEW FIELD # 02110C GOTO READ 02120C*-------------------------------------------------------------------- 02130C ERROR TAG 02140C EXSR SR102 VALIDATE FIELD # 02150C EXSR SR89 GET MSG 02160C EXSR SR73 PUT MSG 02170C GOTO READ 02180C*------------------------------------------------------------------ 02190C NEWITM TAG 02200C* SET-UP LINK FOR NEW ITEM 02210C MOVEL'Q013PC' PROG 8 02220C GOTO END 02230C*------------------------------------------------------------------- 02240C MENU TAG 02250C* SET-UP LINK TO MENU ÐÐ02260C MOVELCRMENU PROG 02270C GOTO END 02280C*-------------------------------------------------------------------- 02290C GOODBY TAG 02300C* LINK TO SIGN-OFF 02310C MOVEL'GOODBY' PROG 02320C GOTO END 02330C*------------------------------------------------------------------- 02340C END TAG 02350C EXITFCHAIN LINK TO NEXT PROG 02360C RLABL PROG 02370C********************************************************************* 02380CSR SR1 BEGSR 02390C* EDIT PART MASTER. 02400CSR MOVELTPN W12A 12 02410CSR EXSR SR80 GET PMMST2 02420CSR 60 Z-ADD291 M 96 FLAG ERROR 02430CSR ENDSR 02440C***************************************************************** 02450CSR SR70 BEGSR 02460C* CLEAR TERM SCREEN. 02470CSR SETON 70 02480CSR EXCPT CLEAR SCREEN 02490CSR SETOF 70 02500CSR ENDSR ÐÐ02510C********************************************************************** 02520CSR SR71 BEGSR 02530C* PUT HEADINGS TO TERMINAL 02540CSR SETON 71 02550CSR EXCPT PUT HEADINGS 02560CSR SETOF 71 02570CSR ENDSR 02580C********************************************************************* 02590CSR SR72 BEGSR 02600C* PUT DATA TO TERMINAL 02610CSR SETON 72 02620CSR EXCPT PUT DATA 02630CSR SETOF 72 02640CSR ENDSR 02650C*********************************************************************** 02660CSR SR73 BEGSR 02670C* PUT ERROR MESSAGE TO TERMINAL 02680CSR SETON 73 02690CSR EXCPT PUT MSG 02700CSR SETOF 73 02710CSR Z-ADDM LSTERR 50 02720CSR ENDSR 02730C******************************************************************* 02740CSR SR75 BEGSR 02750C* READ FROM TERMINAL ÐÐ02760CSR SETOF 779096 02770CSR SETOF 939291 02780CSR SETOF 898887 02790CSR SETOF 8685 02800CSR MOVE BIT,8 BUFLGT 2 READ BUFFER LGTH 02810CSR MOVE BLK14 W14A 14 BUFFER 02820CSR EXITFQWREED READ FROM TERMINAL 02830CSR RLABL W14A READ BUFFER 02840CSR RLABL BUFLGT READ BUFFER LGTH 02850CSR MOVEAW14A A14 INPUT DATA ARRAY 02860CSR MOVE BLK14 W14A INIT INPUT ARRAY 02870CSR Z-ADD1 W 30 02880CSR '\' LOKUPA14,W 90 FLAG ESC 02890CSRN90 GOTO T75B NOT ESC 02900CSR 1 ADD W W 02910CSR W COMP 14 54 02920CSR 54 GOTO T75A BAD ESC 02930CSR A14,W COMP 'G' 98 GOODBY 02940CSR A14,W COMP 'E' 94 MENU 02950CSR A14,W COMP 'N' 93 NEW ITEM 02960CSR A14,W COMP 'J' 92 JUMP 02970CSR A14,W COMP 'F' 91 SKIP FRWRD 02980CSR A14,W COMP 'B' 89 SKIP BKWRD 02990CSR A14,W COMP 'S' 88 SPACE FILL 03000CSR A14,W COMP 'H' 87 HOME ÐÐ03010CSR A14,W COMP 'U' 86 UPDATE 03020CSR A14,W COMP 'R' 85 REPEAT 03030CSR 98 03040COR 94 03050COR 93 03060COR 92 03070COR 91 03080COR 89 03090COR 88 03100COR 87 03110COR 86 03120COR 85 GOTO END75 GOOD ESC 03130C*------------------------------------------------------------------ 03140CSR T75A TAG 03150C* FLAG BAD ESC INPUT 03160CSR Z-ADD318 M 96 FLAG ERROR 03170CSR GOTO END75 03180C*-------------------------------------------------------------------- 03190CSR T75B TAG 03200C* MOVE DATA 03210CSR Z-ADD1 W 03220CSR ' ' LOKUPA14,W 77 03230CSR 77 MOVEAA14,W W14A INPUT DATA 03240C*-------------------------------------------------------------------- 03250CSR END75 TAG ÐÐ03260C* INIT PREV ERROR MSG. 03270CSR LSTERR COMP 0 54 03280CSR 54 MOVE BLK35 MGTEXT 03290CSR 54 EXSR SR73 BLANK MESSAGE 03300CSR Z-ADD0 LSTERR 50 03310CSR ENDSR 03320C********************************************************************** 03330CSR SR80 BEGSR 03340C* GET MASTER RECORD 03350CSR MOVE ' ' W12A 12 03360CSR W12A CHAINPMMST2 60 GET MASTER 03370CSRN60 PMSTAT COMP 'D' 60 FLAG DELETE 03380CSR ENDSR 03390C*********************************************************************** 03400CSR SR82 BEGSR 03410C* REWRITE MASTER 03420CSR SETON 82 03430CSR EXCPT REWRITE MASTER 03440CSR SETOF 82 03450CSR ENDSR 03460C********************************************************************** 03470CSR SR89 BEGSR 03480C* GET MESSAGE MASTER 03490CSR M CHAINMGFILE 54 03500CSR 54 MOVE BLK35 MGTEXT ÐÐ03510CSR 54 MOVELM MGTEXT 03520CSR 54 MOVE MES,1 MGTEXT 03530CSR ENDSR 03540C******************************************************************** 03550C* 03560C* 03570C* 03580C* 03590C* 03600C* 03610C* 03620C* 03630C* 03640C* 03650C* 03660C*********************************************************************** 03670CSR SR101 BEGSR 03680C* 1-TIME INITIALIZE 03690CSR MOVE BIT,1 NUL 03700CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03710CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 03720CSR MOVE ' ' BLK14 14 03730C* GET PORT # AND CRTFILE 03740CSR MOVE ' ' W8A 8 03750CSR Z-ADD0 W2N 20 ÐÐ03760CSR Z-ADD0 W1N 10 03770CSR MOVE ' ' W2A 2 03780CSR EXITFPGMINX GET PORT # 03790CSR RLABL W8A 03800CSR RLABL W2N 03810CSR RLABL W1N 03820CSR RLABL W2A 03830CSR MOVE W2A PORT 20 PORT NO. 03840CSR PORT COMP 0 54 03850CSRN54 Z-ADD25 PORT DEFAULT 03860CSR PORT CHAINCRTFILE H9 03870C* DEFINE WORK FIELDS,ETC. 03880CSR MOVE ' ' BLK35 35 03890C* 03900C* 03910CSR ENDSR 03920C********************************************************************** 03930CSR SR102 BEGSR 03940C* VALIDATE FIELD NO. 03950CSR F COMP 0 54 03960CSRN54 Z-ADD1 F 03970CSR F COMP FLIMIT 55 03980CSR 55 Z-ADD1 F 03990CSR ENDSR 04000C******************************************************************** ÐÐ04010CSR SR103 BEGSR 04020C* MOVE INPUT DATA 04030CSR EXSR SR201 IDENTIFY-F 04040CSR EXSR SR202 R. JUSTIFY 04050CSR 01 MOVE W14A TPN 100 PORT # 04060C* 04070C* 04080CSR MOVE ' ' DUN,F EDIT FLAG 04090CSR ENDSR 04100C******************************************************************** 04110CSR SR104 BEGSR 04120C* EDIT INPUT DATA 04130CSR 01 EXSR SR1 04140CSR 96 MOVE ' ' DUN,F EDIT FLAG 04150CSRN96 MOVE 'X' DUN,F 04160CSR ENDSR 04170C*********************************************************************** 04180CSR SR105 BEGSR 04190C* FINAL EDIT 04200CSR SETOF 77 04210CSR SETON 79 FINAL EDIT FLAG 04220CSR Z-ADD1 F 96 04230C*-------------------------------------------------------------------- 04240CSR T105A TAG 04250CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD ÐÐ04260CSRN54 GOTO END105 04270CSR EXSR SR201 IDENTIFY-F 04280CSR EXSR SR104 EDIT 04290CSRN96 GOTO T105A 04300C*-------------------------------------------------------------------- 04310CSR END105 TAG 04320CSR SETOF 79 04330CSR ENDSR 04340C******************************************************************** 04350CSR SR106 BEGSR 04360C* UPDATE DATA BASE. 04370CSR EXSR SR80 GET MASTER 04380CSRN60 GOTO T106A GOT IT 04390C* FLAG NO MASTER ERROR 04400CSR Z-ADD302 M 96 FLAG ERROR 04410CSR Z-ADD1 F FIELD # 04420CSR GOTO END106 04430C*----------------------------------------------------------------------- 04440CSR T106A TAG 04450C* REWRITE MASTER 04460CSR Z-ADDPM$ PA$ 04470CSR Z-ADDPMCLOT PMSLOT 04480CSR Z-ADDPMCSUH PMSSUH 04490CSR Z-ADDPMCRH PMSRH 04500CSR Z-ADDPMCDAT PMSDAT ÐÐ04510CSR MOVE PMCCCD PMSCCD 04520CSR Z-ADDMDP ADP 04530CSR Z-ADDMHR AHR 04540CSR Z-ADDPMTCST PMOSUC 04550CSR EXSR SR82 REWRITE MAST 04560CSR END106 ENDSR 04570C************************************************************************ 04580CSR SR201 BEGSR 04590C* IDENTIFY FIELD NO. 04600CSR SETOF 010203 04610CSR SETOF 040506 04620CSR SETOF 070809 04630CSR SETOF 10 04640CSR F COMP 1 01 04650CSR ENDSR 04660C********************************************************************** 04670CSR SR202 BEGSR 04680C* RIGHT JUSTIFY 04690CSR F LOKUPNUM 54 04700CSRN54 GOTO END202 NOT NUMERIC FIELD 04710CSR Z-ADD14 W2N 20 04720CSR EXIT SUBRAJ R. JUSTIFY 04730CSR RLABL W2N 04740CSR RLABL W14A 04750CSR END202 ENDSR ÐÐ04760O******************************************************************** 04770OPMMST2 E 82 04780O PMACNT 112P 04790O PA$ 219P 04800O PMSLOT 223P 04810O PMSSUH 228P 04820O PMSRH 233P 04830O PMOSAL 244P 04840O PM$ 279P 04850O PMCLOT 283P 04860O PMCSUH 288P 04870O PMCRH 293P 04880O PMOSUC 493P 04890O AHR 536P 04900O ADP 542P 04910O MHR 590P 04920O MDP 614P 04930O PMTCST 619P 04940O******************************************************************** 04950OTERM132 E 71 04960O 68 'ADOPT MFG COST' 04970O 85 'AS STANDARD COST' 04980O UDATE Y 8 04990O*------------------------------------------------------------------- 05000O E 72 ÐÐ05010O NUL 132 05020O 19 'ENTER PART NO. : ' 05030O BIT,8 132 05040O*------------------------------------------------------------------- 05050O E 73 05060O MGTEXT 35 05070O* 05080O* 05090O* 05100O* 05110O* 05120O* 05130O* ** NUL ARRAY 005140 005150** A14 ARRAY 005160 005170** NUM ARRAY 005180001 005190** DUN ARRAY 005200 005210** MES ARRAY 005220---MESSAGE NOT ON FILE--- 005230/* 005240_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Ü" ÜqX002RT P999999120282(èÈÐ00010H Q002RT00020F* ROUTING UPDATE - ADD, CHG, DELETE. (X002RT) 00030F* REVISED 9-08-82 4:45 PM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FRTMAST UC F 90R11AI 1 DISK A 00080FROMAST UC F 80R DISK 00090FROTEXT UC F 55R DISK 00100FRTCONT UC F 10R DISK 00110FWCMAST IC F 960R 8AI 1 DISK 00120FPMMST2 IC F 674R12AI 1 DISK 00130FOPDESCR IC F 47R 5AI 1 DISK 00140FTERM132 O F 132 5 00150E***************************************************************** 00160E NUL 1 132 1 NUL CHAR 00170E A50 50 50 1 A TERM INPUT 00180E A39 39 39 1 ERROR MESG 00190E DUN 3 3 1 EDIT OK FLAGS 00200E MES 1 35 1 NO MSG MSG 00210E LNK 1 7 6 A RETURN STACK 00220E OT 1 21 1 A OPER TRAN CODE 00230E DEP 1 21 3 0 DEPT # 00240E WC 1 21 3 0 WORK CENTER NO. 00250E OS 1 21 2 0A OPER SEQ # ÐÐ00260E MAX 1 21 3 0A MAX F VALUE 00270E OP 1 21 5 OPER CODES 00280E OL 1 21 5 0 OPTIMUM LOT SIZES 00290E SU 1 21 7 1 SET-UP HRS 00300E RUN 1 21 9 6 RUN HRS 00310E FAC 1 21 5 2 RUN FACTOR 00320E MIN 1 21 5 0 MIN CHARGES 00330E TS 1 15 2 0A TEXT LINE/MAX F VALUES 00340E TMX 1 15 3 0A 00350E TT 1 15 1 A TEXT TRAN CODES 00360E TP 1 15 1 TEXT SPACE CODES 00370E TXT 1 15 50 A TEXT TEXT 00380E OC 1 9 3 0 OPER START COL 00390E TC 1 3 3 0 TEXT START COL 00400E RMO 21 5 0A OPERATION PTRS 00410E BIT 33 1 CONTROL CODES 00420E ROT 15 5 0A TEXT PTRS 00430E PAR 25 1 TERM TYPE CODES 00440E TST 25 1 TERM STATUS 00450E CALL 7 6 00460I****************************************************************** 00470IBITPAR BP 00480I 1 33 BIT 00490I 34 58 PAR 00500I 59 83 TST ÐÐ00510I***************************************************************** 00520IMGFILE MG 00530I 1 35 MGTEXT 00540I***************************************************************** 00550ICRTFILE CR 00560I 27 27 CRSHUT 00570I 28 330CRTIME 00580I 34 370CRDATE 00590I 38 79 CALL 00600I********************************************************************* 00610IPMMST2 PM 00620I* PART MASTER 00630I* PART NO. 00640I 1 100PMPN 00650I 19 30 PMMODL 00660I 487 488 PMFAB 00670I* ENG. CHANGE 2A 00680I 70 71 PMECHG 00690I* SOURCE CODE 00700I 94 95 PMSC 00710I* DESCRIPTION 29A 00720I 31 59 PMDESC 00730I* RTMAST RRN 5P 00740I P 627 6290PMRTRN 00750I P 220 2230PMSLOT ÐÐ00760I 674 674 PMSTAT 00770I******************************************************************** 00780IWCMAST WC 00790I* WORK CENTER MASTER 00800I* WORK CENTER NAME 29A 00810I 9 37 WCNAME 00820I* RECORD STATUS 1A 00830I 960 960 WCSTAT 00840I******************************************************************** 00850IRTMAST RM 00860I* ROUTING MASTER 00870I* PART # 10N 00880I 1 100RMPN 00890I* VERSION 1A 00900I 11 11 RMVERS 00910I* ENGR REV 2A 00920I 12 13 RMECHG 00930I* MFG REV 2N 00940I 14 150RMMCHG 00950I* STD LOT SIZE 5P 00960I P 16 180RMSLOT 00970I* OPER PTRS 5P X 21 00980I P 19 81 RMO 00990I* STATUS 1A 01000I 90 90 RMSTAT ÐÐ01010I******************************************************************** 01020IROMAST RO 01030I* ROUTING OPER MASTER 01040I* DEPT 3P 01050I P 1 20RODEPT 01060I* WORK CENTER 3P 01070I P 4 60ROWC 01080I* OPER CODE 5A 01090I 7 11 ROOPER 01100I* OPTIMUM LOT SIZE 5P 01110I P 12 140ROOLOT 01120I* SET-UP HRS 7.1P 01130I P 15 181ROSU 01140I* RUN HRS 11.5P 01150I P 19 245RORUN 01160I* RUN FACTOR 5.2P 01170I P 25 272ROFACT 01180I* MIN CHARGE 5P 01190I P 28 300ROMIN 01200I* RTMAST RRN 5P 01210I P 31 330RORRN 01220I* TEXT RRNS 15 X 5P 01230I P 34 78 ROT 01240I******************************************************************** 01250IROTEXT RT ÐÐ01260I* ROUTING TEXT 01270I* OPER MASTER RRN 5P 01280I P 1 30RTRRN 01290I* TEXT 50A 01300I 4 53 RTTEXT 01310I 54 54 RTSPAC 01320I******************************************************************** 01330IRTCONT RC 01340I* NEXT AVAIL ROMAST RRN 5N 01350I 1 50RCRO 01360I* NEXT AVAIL ROTEXT RRN 5N 01370I 6 100RCRX 01380I******************************************************************** 01390IOPDESCR OP 01400I 47 47 OPSTAT 01410C******************************************************************* 01420C* NOTE: INDICATOR 50 = 132-1 TERMINAL 01430C* INDEX X RELATES TO OPER\TEXT SCREEN AR'S 01440C* 01450C*CRT SCREEN <-------------- F VALUES-----------------------------> 01460C*LINE IDX FIELD# TRAN DEP WC OPER LOT SU RUN FACT MIN TRAN TEXT SPAC 01470C*4 1 7 7 8 9 10 11 12 13 14 15 196 197 198 01480C*5 2 8 16 17 18 19 20 21 22 23 24 199 200 201 01490C*6 3 9 25 26 27 28 29 30 31 32 33 202 203 204 01500C*7 4 10 34 35 36 37 38 39 40 41 42 205 206 207 ÐÐ01510C*8 5 11 43 44 45 46 47 48 49 50 51 208 209 210 01520C*9 6 12 52 53 54 55 56 57 58 59 60 211 212 213 01530C*10 7 13 61 62 63 64 65 66 67 68 69 214 215 216 01540C*11 8 14 70 71 72 73 74 75 76 77 78 217 218 219 01550C*12 9 15 79 80 81 82 83 84 85 86 87 220 221 222 01560C*13 10 16 88 89 90 91 92 93 94 95 96 223 224 225 01570C*14 11 17 97 98 99 100 101 102 103 104 105 226 227 228 01580C*15 12 18 106 107 108 109 110 111 112 113 114 229 230 231 01590C*16 13 19 115 116 117 118 119 120 121 122 123 232 233 234 01600C*17 14 20 124 125 126 127 128 129 130 131 132 235 236 237 01610C*18 15 21 133 134 135 136 137 138 139 140 141 238 239 240 01620C*19 16 22 142 143 144 145 146 147 148 149 150 01630C*20 17 23 151 152 153 154 155 156 157 158 159 01640C*21 18 24 160 161 162 163 164 165 166 167 168 01650C*22 19 25 169 170 171 172 173 174 175 176 177 01660C*23 20 26 178 179 180 181 182 183 184 185 186 01670C*24 21 27 187 188 189 190 191 192 193 194 195 01680C* 01690C* INITIALIZE 01700C EXSR SR101 1-TIME INIT 01710C MOVE ' ' BLK6 6 STUPIDITY 01720C Z-ADD0 ZERO5 50 01730C*------------------------------------------------------------------ 01740C START TAG 01750C* SET-UP 1ST FIELD NO. ÐÐ01760C EXSR SR66 INIT A39 01770C MOVE ' ' DUN INIT EDIT ARRAY 01780C Z-ADD1 F 30 FIELD # 01790C EXSR SR205 INIT RTMAST 01800C EXSR SR206 INIT ROMAST 01810C EXSR SR207 INIT ROTEXT 01820C EXSR SR219 INIT OPER 01830C EXSR SR220 INIT TEXT 01840C EXSR SR70 NEW PAGE 01850C GOTO READ 01860C*------------------------------------------------------------------ 01870C NEXT TAG 01880C EXSR SR66 INIT A39 01890C 1 ADD F F FIELD # 01900C*----------------------------------------------------------------- 01910C READ TAG 01920C* READ DATA FROM TERMINAL. 01930C SETOF 909677 01940C EXSR SR102 VALIDATE FIELD # 01950C 55 Z-ADD3 F DONE 01960C EXSR SR201 IDENTIFY-F 01970C SETON 69 01980C EXSR SR72 PROMPT 01990C SETOF 69 02000C EXSR SR75 READ TERMINAL ÐÐ02010C 90N88 EXSR SR72 DISPLAY INPUT DATA 02020C 93 GOTO START NEW ITEM 02030C 92 GOTO JUMP FIELD JUMP REQST 02040C 89 F SUB 1 F SKIP BACKWARD 02050C 89 GOTO READ " " 02060C 88 SETOF 90 SPACE FILL 02070C 88 SETON 77 " " 02080C 86 GOTO UPDATE UPDATE 02090C 85 GOTO READ REPEAT 02100C 29 91 Z-ADDX S 30 02110C 29 91 GOTO TEXT 02120C 29 87 MAX,X ADD 1 F 02130C 29 87 GOTO READ 02140C 96 GOTO ERROR ERROR 02150C 77 EXSR SR103 MOVE DATA 02160C*------------------------------------------------------------------- 02170C EDIT TAG 02180C EXSR SR104 EDIT DATA 02190C EXSR SR72 REWRITE DATA 02200C 96 GOTO ERROR ERROR 02210C N03 GOTO NEXT 02220C PTRAN COMP 'D' 54 PART # DELETE 02230C 54 GOTO UPDATE 02240C GOTO NEXT 02250C*------------------------------------------------------------------- ÐÐ02260C TEXT TAG 02270C EXSR SR201 IDENTIFY-F 02280C Z-ADDX TEXTX 20 02290C EXSR SR106 UPDATE OPER 02300C EXSR SR110 DISPLAY TEXT 02310C EXSR SR111 UPDATE TEXT 02320C Z-ADDTEXTX X 02330C MAX,X SUB 8 F 02340C GOTO READ 02350C*------------------------------------------------------------------ 02360C UPDATE TAG 02370C* UPDATE DATA BASE. 02380C EXSR SR105 FINAL EDIT 02390C 96 GOTO ERROR ERROR 02400C EXSR SR106 UPDATE 02410C 96 GOTO ERROR ERROR 02420C GOTO START 02430C*------------------------------------------------------------------- 02440C JUMP TAG 02450C* SET-UP JUMP TO REQUESTED FIELD 02460C 1 ADD W W 30 02470C W COMP 50 54 02480C 54 Z-ADD318 M 50 96 FLAG ERROR 02490C 54 GOTO ERROR BAD ESC 02500C MOVE ' ' W3A 3 ÐÐ02510C MOVEAA50,W W3A 02520C Z-ADD3 W2N 20 02530C EXIT SUBRAJ R. JUSTIFY 02540C RLABL W2N 02550C RLABL W3A 02560C MOVE W3A A NEW FIELD # 02570C A COMP 7 54 54 02580C N54 Z-ADDA F 02590C N54 GOTO READ 02600C A COMP 21 5454 02610C N54 Z-ADD21 A 02620C A SUB 6 A 02630C MAX,A SUB 8 F 02640C GOTO READ 02650C*-------------------------------------------------------------------- 02660C ERROR TAG 02670C EXSR SR102 VALIDATE FIELD # 02680C EXSR SR89 GET MSG 02690C EXSR SR73 PUT MSG 02700C GOTO READ 02710C*------------------------------------------------------------------ 02720C NEWITM TAG 02730C MOVEL'Q002RT' PROG 02740C GOTO END 02750C*------------------------------------------------------------------- ÐÐ02760C MENU TAG 02770C* SET-UP LINK TO MENU 02780C EXSR SR96 GET CRTFILE 02790C Z-ADD1 W 02800C BLK6 LOKUPLNK,W 54 02810C 54 MOVELLNK,W PROG 8 02820C 54 MOVE BLK6 LNK,W 02830C N54 MOVEL'CONTU 'PROG 02840C EXSR SR97 UPDATE CRTFILE 02850C EXSR SR98 >>>>>>>>>>>>> 02860C*-------------------------------------------------------------------- 02870C GOODBY TAG 02880C* LINK TO SIGN-OFF 02890C MOVEL'GOODBY' PROG 02900C*---------------------------------------------------------------- 02910C END TAG 02920C EXSR SR96 GET CRTFILE 02930C EXSR SR97 REWRITE CRTFILE 02940C EXSR SR98 >>>>>>>>>>> 02950C*------------------------------------------------------------------- 02960C ENDJOB TAG 02970C MOVEL'ENDJOB' PROG 02980C EXSR SR97 >>>>>>>>>>>>>>>> 02990C******************************************************************** 03000CSR SR1 BEGSR ÐÐ03010C* EDIT PART #. 03020CSR TPN COMP 0 54 03030CSRN54 Z-ADD299 M 96 FLAG ERROR 03040CSRN54 GOTO END1 03050CSR MOVELTPN W12A 12 03060CSR MOVE ' ' W12A 03070CSR W12A CHAINPMMST2 54 03080CSRN54 PMSTAT COMP 'D' 54 03090CSR 54 Z-ADD291 M 96 FLAG ERROR 03100CSR 54 GOTO END1 03110CSR MOVELPMSC W1A 1 03120CSR W1A COMP 'M' 54 03130CSRN54 Z-ADD413 M FLAG WARNING 03140CSR EXSR SR89 03150CSR END1 ENDSR 03160C******************************************************************** 03170CSR SR2 BEGSR 03180C* EDIT VERSION CODE. 03190CSR MOVELTPN W11A 11 03200CSR MOVE TVERS W11A 03210CSR SETOF 31 03220CSR W11A CHAINRTMAST 30 03230CSRN30 RMSTAT COMP 'D' 31 03240CSR 30 03250COR 31 EXSR SR205 INIT RTMAST ÐÐ03260CSR 30 03270COR 31 EXSR SR82 ADD NEW RTMAST 03280CSR 30 03290COR 31 GOTO SR2 03300CSR EXSR SR71 PUT SCREEN 03310CSR ENDSR 03320C******************************************************************** 03330CSR SR3 BEGSR 03340C* EDIT PART NO. TRAN 03350CSR MOVE PTRAN TRAN 1 03360CSR EXSR SR203 CLASSIFY TRAN 03370CSR 63 SETON 62 03380CSR 30 62 03390COR 31 62 Z-ADD5 M 96 FLAG ERROR 03400CSR MOVE TRNNAM PTRNAM 10 03410CSR END3 ENDSR 03420C******************************************************************** 03430CSR SR4 BEGSR 03440C* EDIT ENG CHANGE FIELD 03450CSR 77 Z-ADD0 RMMCHG INIT MFG CHANGE 03460CSR ENDSR 03470C******************************************************************** 03480CSR SR5 BEGSR 03490C* EDIT MFG CHANGE FIELD 03500CSRN77 1 ADD RMMCHG RMMCHG ÐÐ03510CSR ENDSR 03520C********************************************************************* 03530CSR SR7 BEGSR 03540C* EDIT OPER TRAN CODE 03550CSR OT,X COMP ' ' 54 03560CSRN54 GOTO END7 03570CSR MOVE OT,X TRAN 03580CSR EXSR SR203 CLASSIFY TRAN 03590CSRN60N61N62 03600CANN63 Z-ADD300 M 96 FLAG ERROR 03610CSR END7 ENDSR 03620C*************************************************************** 03630CSR SR8 BEGSR 03640C* EDIT DEPARTMENT 03650CSR DEP,X COMP 0 54 03660CSRN54 Z-ADD232 M 96 FLAG ERROR 03670CSR ENDSR 03680C*************************************************************** 03690CSR SR9 BEGSR 03700C* EDIT WORK CENTER 03710CSR Z-ADDDEP,X W5N 50 03720CSR MOVELW5N W8A 8 03730CSR MOVE WC,X W8A 03740CSR W8A CHAINWCMAST 54 03750CSRN54 WCSTAT COMP 'D' 54 ÐÐ03760CSR 54 Z-ADD383 M 96 FLAG ERROR 03770CSR ENDSR 03780C*************************************************************** 03790CSR SR10 BEGSR 03800C* EDIT OPER CODE 03810CSR OP,X COMP BLK5 54 03820CSRN54 GOTO END10 03830CSR OP,X CHAINOPDESCR 54 03840CSRN54 OPSTAT COMP 'D' 54 03850CSR 54 Z-ADD637 M 96 FLAG ERROR 03860CSR END10 ENDSR 03870C**************************************************************** 03880CSR SR12 BEGSR 03890C* EDIT SET-UP HRS 03900CSR SU,X COMP 0 54 03910CSR OL,X COMP 0 55 03920CSR 54N55 Z-ADD234 M 96 FLAG ERROR 03930CSR ENDSR 03940C******************************************************************* 03950CSR SR27 BEGSR 03960C* EDIT TEXT TRAN 03970CSR TT,X COMP ' ' 54 03980CSRN54 GOTO END27 03990CSR MOVE TT,X TRAN 04000CSR EXSR SR203 CLASSIFY TRAN ÐÐ04010CSRN60N61N62 04020CANN63 Z-ADD300 M 96 FLAG ERROR 04030CSR END27 ENDSR 04040C******************************************************************* 04050CSR SR28 BEGSR 04060C* EDIT MISSING TEXT 04070CSR TT,X COMP ' ' 54 04080CSR TXT,X COMP BLK50 55 04090CSR 54N55 Z-ADD469 M 96 FLAG ERROR 04100CSR ENDSR 04110C****************************************************************** 04120CSR SR29 BEGSR 04130C* EDIT SPACE CODE 04140CSR TP,X COMP ' ' 54 04150CSR TXT,X COMP BLK50 55 04160CSR 54N55 Z-ADD385 M 96 FLAG ERROR 04170CSR 54 TP,X COMP '1' 55 04180CSR 54N55 TP,X COMP '2' 55 04190CSR 54N55 TP,X COMP '3' 55 04200CSR 54N55 Z-ADD385 M 96 FLAG ERROR 04210CSR ENDSR 04220C**************************************************************** 04230CSR SR41 BEGSR 04240C* GET CONTROL RECORD 04250CSR RRNRC CHAINRTCONT H6 GET RTCONT FILE ÐÐ04260CSR H6 GOTO ENDJOB 04270CSR ENDSR 04280C**************************************************************** 04290CSR SR42 BEGSR 04300C* REWRITE CONTROL RECORD 04310CSR SETON 42 04320CSR EXCPT UPDATE RTCONT 04330CSR SETOF 42 04340CSR ENDSR 04350C******************************************************************** 04360CSR SR65 BEGSR 04370CSR EXITFQMOVUP BUMP UP 04380CSR ENDSR 04390C******************************************************************** 04400CSR SR66 BEGSR 04410CSR MOVEABLK35 A39,3 INIT A39 04420CSR ENDSR 04430C******************************************************************** 04440CSR SR67 BEGSR 04450CSR EXITFZCR 04460CSR ENDSR 04470C***************************************************************** 04480CSR SR68 BEGSR 04490CSR EXITFZLF LINE FEED 04500CSR ENDSR ÐÐ04510C**************************************************************** 04520CSR SR69 BEGSR 04530CSR 50 EXITFZPUTXY MOVE CURSOR 04540CSR RLABL RPGLIN 04550CSR RLABL RPGCOL 04560CSRN50 EXITFZMOVXY MOVE CURSOR 04570CSR RLABL RPGLIN 04580CSR RLABL RPGCOL 04590CSR ENDSR 04600C***************************************************************** 04610CSR SR70 BEGSR 04620C* CLEAR TERM SCREEN. 04630CSR 50 EXITFZISTAT INIT STATUS LINE 04640CSR 50 EXITFZESCH CLEAR SCREEN 04650CSRN50 EXITFZCPAGE CLEAR SCREEN 04660CSRN50 MOVEL'091' RPGLIN 04670CSRN50 MOVEL'001' RPGCOL 04680CSRN50 EXSR SR69 MOVE CURSOR 04690CSR ENDSR 04700C********************************************************************** 04710CSR SR71 BEGSR 04720C* DISPLAY OPERATIONS 04730CSR Z-ADDF SAVEF 30 04740CSR Z-ADD0 A 04750CSR 50 MOVEL'002' RPGLIN ÐÐ04760CSRN50 MOVEL'092' RPGLIN 04770CSR MOVEL'001' RPGCOL 04780CSR EXSR SR69 MOVE CURSOR 04790CSR SETON 74 04800CSR EXCPT PUT OPER HEADING 04810CSR SETOF 74 04820C*------------------------------------------------------------------- 04830CSR T71A TAG 04840CSR 1 ADD A A 04850CSR A COMP 21 54 04860CSR 54 GOTO END71 04870CSR MAX,A SUB 8 F 04880CSR EXSR SR201 CLASSIFY-F 04890CSR Z-ADDRMO,A RRNRO 50 55 04900CSR 55 EXSR SR80 GET ROMAST 04910CSR 55 EXSR SR218 MOVE DATA TO AR'S 04920CSR EXSR SR72 DISPLAY 04930CSR GOTO T71A 04940C*---------------------------------------------------------------- 04950CSR END71 TAG 04960CSR 50 EXSR SR65 BUMP UP 04970CSR Z-ADDSAVEF F 04980CSR EXSR SR201 REIDENTIFY F 04990CSR ENDSR 05000C********************************************************************* ÐÐ05010CSR SR72 BEGSR 05020C* PUT DATA TO TERMINAL 05030CSR LINE SUB 1 W3N 30 05040CSRN50 W3N ADD 90 W3N 05050CSR MOVELW3N RPGLIN 4 05060CSR MOVEL'001' RPGCOL 4 05070CSR EXSR SR69 MOVE CURSOR 05080CSR SETON 72 05090CSR EXCPT PUT DATA 05100CSR SETOF 72 05110CSR 50 LINE COMP 24 54 05120CSR 50 54 EXSR SR65 BUMP UP 05130CSR ENDSR 05140C*********************************************************************** 05150CSR SR73 BEGSR 05160C* PUT ERROR MESSAGE TO TERMINAL 05170CSR SETON 7368 05180CSR EXCPT PUT MSG 05190CSR SETOF 73 05200CSR ENDSR 05210C******************************************************************** 05220CSR SR74 BEGSR 05230C* PUT MESSAGE 05240CSR EXSR SR89 GET MESSAGE 05250CSR EXSR SR73 PUT MESSAGE ÐÐ05260CSR ENDSR 05270C******************************************************************* 05280CSR SR75 BEGSR 05290C* READ FROM TERMINAL 05300CSR SETOF 779096 05310CSR SETOF 939291 05320CSR SETOF 898887 05330CSR SETOF 8685 05340CSR EXSR SR66 INIT A39 05350CSR MOVE BLK50 W50A 50 BUFFER 05360CSR Z-ADDLINE W3N 30 05370CSRN50 W3N ADD 90 W3N 05380CSR MOVELW3N RPGLIN 4 05390CSR MOVELCOLUM RPGCOL 4 05400CSR EXSR SR69 MOVE CURSOR 05410CSR EXITFZR50 READ FROM TERMINAL 05420CSR RLABL W50A READ BUFFER 05430CSR 50 LINE COMP 24 54 05440CSR 50 54 EXSR SR65 BUMP UP 05450CSR MOVEAW50A A50 INPUT DATA ARRAY 05460CSR MOVE BLK50 W50A INIT INPUT ARRAY 05470CSR Z-ADD1 W 30 05480CSR '\' LOKUPA50,W 90 FLAG ESC 05490CSRN90 GOTO T75B NOT ESC 05500CSR 1 ADD W W ÐÐ05510CSR W COMP 50 54 05520CSR 54 GOTO T75A BAD ESC 05530CSR A50,W COMP 'G' 98 GOODBY 05540CSR A50,W COMP 'E' 94 MENU 05550CSR A50,W COMP 'N' 93 NEW ITEM 05560CSR 28 05570COR 29 A50,W COMP 'J' 92 JUMP 05580CSR 29 A50,W COMP 'T' 91 GO TO TEXT 05590CSR A50,W COMP 'B' 89 SKIP BKWRD 05600CSR A50,W COMP 'S' 88 SPACE FILL 05610CSR 27 05620COR 29 A50,W COMP 'D' 87 DONE 05630CSR A50,W COMP 'U' 86 UPDATE 05640CSR A50,W COMP 'R' 85 REPEAT 05650CSR 98 GOTO GOODBY 05660CSR 94 GOTO MENU 05670CSR 93 GOTO NEWITM 05680CSR 92 05690COR 91 05700COR 89 05710COR 88 05720COR 87 05730COR 86 05740COR 85 GOTO END75 GOOD ESC 05750C*------------------------------------------------------------------ ÐÐ05760CSR T75A TAG 05770C* FLAG BAD ESC INPUT 05780CSR Z-ADD318 M 96 FLAG ERROR 05790CSR GOTO END75 05800C*-------------------------------------------------------------------- 05810CSR T75B TAG 05820C* MOVE DATA 05830CSR Z-ADD1 W 05840CSR ' ' LOKUPA50,W 77 05850CSR 77 MOVEAA50,W W50A INPUT DATA 05860C*-------------------------------------------------------------------- 05870CSR END75 TAG 05880C* INIT PREV ERROR MSG. 05890CSR 68 EXSR SR66 INIT A39 05900CSR 68 EXSR SR73 PUT A39 05910CSR SETOF 68 05920CSR ENDSR 05930C********************************************************************** 05940CSR SR80 BEGSR 05950C* GET OPER MASTER 05960CSR RRNRO CHAINROMAST H8 GET OPER MAST 05970CSR H8 GOTO ENDJOB 05980CSR ENDSR 05990C********************************************************************** 06000CSR SR81 BEGSR ÐÐ06010C* GET TEXT RECORD 06020CSR RRNRT CHAINROTEXT H7 GET TEXT RECORD 06030CSR H7 GOTO ENDJOB 06040CSR ENDSR 06050C*********************************************************************** 06060CSR SR82 BEGSR 06070C* UPDATE RTMAST 06080CSR SETON 82 06090CSR EXCPT UPDATE RTMAST 06100CSR SETOF 82 06110CSR ENDSR 06120C****************************************************************** 06130CSR SR83 BEGSR 06140C* UPDATE ROMAST 06150CSR SETON 83 06160CSR EXCPT UPDATE ROMAST 06170CSR SETOF 83 06180CSR ENDSR 06190C**************************************************************** 06200CSR SR84 BEGSR 06210CSR SETON 84 06220CSR EXCPT UPDATE ROTEXT 06230CSR SETOF 84 06240CSR ENDSR 06250C*************************************************************** ÐÐ06260CSR SR89 BEGSR 06270C* GET MESSAGE MASTER 06280CSR M CHAINMGFILE 54 06290CSR 54 MOVE BLK35 MGTEXT 06300CSR 54 MOVELM MGTEXT 06310CSR 54 MOVE MES,1 MGTEXT 06320CSR MOVEAMGTEXT A39,3 06330CSR ENDSR 06340C******************************************************************** 06350CSR SR96 BEGSR 06360CSR # CHAINCRTFILE H9 GET CRTFILE 06370CSR H9 GOTO ENDJOB 06380CSR ENDSR 06390C****************************************************************** 06400CSR SR97 BEGSR 06410C* UPDATE CRTFILE. EXIT PROGRAM. 06420CSR TIME CRTIME 06430CSR MOVELUDATE CRDATE 06440CSR SETON 97 06450CSR EXCPT UPDATE CRTFILE 06460CSR SETOF 97 06470CSR ENDSR 06480C******************************************************************** 06490CSR SR98 BEGSR 06500CSR EXSR SR70 CLEAR SCREEN ÐÐ06510CSR EXITFCHAIN >>>>>>>>>> 06520CSR RLABL PROG 06530CSR ENDSR 06540C******************************************************************** 06550CSR SR99 BEGSR 06560C* STORE THIS PROG AS RETURN TO PROG. 06570CSR EXSR SR96 GET CRTFILE 06580CSR Z-ADD8 W 06590C*------------------------------------------------------------------- 06600CSR T99A TAG 06610CSR W SUB 1 W 54 06620CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 06630CSR LNK,W COMP BLK6 54 06640CSRN54 GOTO T99A 06650CSR MOVELRETURN LNK,W 06660CSR EXSR SR97 UPDATE CRTFILE 06670CSR EXSR SR98 >>>>>>>>>>>>>> 06680CSR END99 ENDSR 06690C******************************************************************** 06700C* 06710C* 06720C* 06730C* 06740C* 06750C* ÐÐ06760C* 06770C* 06780C* 06790C*********************************************************************** 06800CSR SR101 BEGSR 06810C* 1-TIME INITIALIZE 06820CSR MOVE BIT,1 NUL 06830CSR Z-ADD0 NEXTRO 50 06840CSR Z-ADD15000 LASTRO 50 06850CSR Z-ADD5000 LASTRX 50 06860CSR Z-ADD0 NEXTRX 50 06870CSR MOVE ' ' A39 06880CSR MOVE BIT,28 A39,1 06890CSR MOVE 'D' A39,2 06900CSR MOVE BIT,28 A39,38 06910CSR MOVE 'E' A39,39 06920CSR Z-ADD195 FLIMIT 30 06930CSR MOVE ' ' BLK50 50 06940C* GET PORT # AND CRTFILE 06950CSR MOVE ' ' W2A 2 06960CSR EXITFZGMINX GET PORT # 06970CSR RLABL W2A 06980CSR MOVE W2A # 20 PORT NO. 06990CSR # COMP 0 54 07000CSRN54 Z-ADD25 # DEFAULT ÐÐ07010CSR EXSR SR96 GET CRTFILE 07020CSR MOVE CALL LNK 07030CSR MOVE 'Q002RT 'PROG 07040CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 07050CSR TST,# COMP 'S' 56 07060CSRN56 CRSHUT COMP 'S' 56 07070CSR 56 MOVE 'S' CRSHUT SHUTDOWN 07080CSR 56 MOVE 'SHUTDOWN'PROG 07090CSR EXSR SR97 UPDATE CRTFILE 07100CSR 56 EXSR SR98 >>>>>>>>>>>>> 07110CSR MOVE BLK35 PROG 07120C* DEFINE WORK FIELDS,ETC. 07130CSR EXSR SR219 INIT CRT OPER 07140CSR EXSR SR220 INIT CRT TEXT 07150CSR MOVE ' ' BLK35 35 07160CSR MOVE ' ' BLK6 6 07170CSR Z-ADD0 A 30 07180CSR Z-ADD0 B 30 07190CSR MOVE ' ' BLK5 5 07200CSR MOVE BLK35 RETURN 8 07210CSR Z-ADD0 ZERO5 50 07220CSR ENDSR 07230C********************************************************************** 07240CSR SR102 BEGSR 07250C* VALIDATE FIELD NO. ÐÐ07260CSR F COMP 0 54 07270CSRN54 Z-ADD1 F 07280CSR F COMP FLIMIT 55 07290CSR 55 Z-ADD7 F 07300CSR ENDSR 07310C******************************************************************** 07320CSR SR103 BEGSR 07330C* MOVE INPUT DATA 07340CSR EXSR SR201 IDENTIFY-F 07350CSR EXSR SR202 R. JUSTIFY 07360CSR 01 MOVE W10A TPN 100 PART # 07370CSR 02 MOVELW50A TVERS 1 VERSION CODE 07380CSR 03 MOVELW50A PTRAN 1 RTMAST TRAN 07390CSR 04 MOVELW50A RMECHG ENG REV 07400CSR 05 MOVE W10A RMMCHG MFG REV 07410CSR 06 MOVE W10A RMSLOT STD LOT SIZE 07420C*--------------- 07430CSR 07 29 MOVELW50A OT,X OPER TRAN CODE 07440CSR 08 29 MOVE W10A DEP,X DEPT NO. 07450CSR 09 29 MOVE W10A WC,X WORK CENTER 07460CSR 10 29 MOVELW50A OP,X OPER CODE 07470CSR 11 29 MOVE W10A OL,X OPTIMUM LOT SIZE 07480CSR 12 29 MOVE W10A SU,X SET UP HOURS 07490CSR 13 29 MOVE W10A RUN,X RUN HOURS 07500CSR 14 29 MOVE W10A FAC,X RUN FACTOR ÐÐ07510CSR 15 29 MOVE W10A MIN,X MIN CHARGE 07520C*--------------- 07530CSR 07 27 MOVELW50A TT,X TEXT TRAN CODE 07540CSR 08 27 MOVE W50A TXT,X TEXT DATA 07550CSR 09 27 MOVELW50A TP,X TEXT SPACE CODE 07560CSR ENDSR 07570C******************************************************************** 07580CSR SR104 BEGSR 07590C* EDIT INPUT DATA 07600CSR 01 EXSR SR1 07610CSR 02 EXSR SR2 07620CSR 03 EXSR SR3 07630CSR 04 EXSR SR4 07640CSR 05 EXSR SR5 07650CSR 07 29 EXSR SR7 07660CSR 08 29 EXSR SR8 07670CSR 09 29 EXSR SR9 07680CSR 10 29 EXSR SR10 07690CSR 12 29 EXSR SR12 07700CSR 07 27 EXSR SR27 07710CSR 08 27 EXSR SR28 07720CSR 09 27 EXSR SR29 07730CSR 01 MOVE ' ' DUN,1 07740CSR 02 MOVE ' ' DUN,2 07750CSR 03 MOVE ' ' DUN,3 ÐÐ07760CSR 01N96 MOVE 'X' DUN,1 07770CSR 02N96 MOVE 'X' DUN,2 07780CSR 03N96 MOVE 'X' DUN,3 07790CSR ENDSR 07800C************************************************************** 07810CSR SR105 BEGSR 07820C* FINAL EDIT 07830CSR Z-ADD1 F 07840C*--------------------------------------------------------------- 07850CSR T105A TAG 07860CSR ' ' LOKUPDUN,F 54 07870CSRN54 GOTO END105 07880CSR EXSR SR104 EDIT 07890CSRN96 GOTO T105A 07900CSR END105 ENDSR 07910C***************************************************************** 07920CSR SR106 BEGSR 07930C* UPDATE OPERATIONS (TEXT DONE PREVIOUSLY) 07940CSR PTRAN COMP 'D' 54 FLAG PART# DELETE 07950CSR 54 GOTO T106P 07960CSR Z-ADD1 X 07970C* 07980C*------------------------------------------------------------------ 07990CSR T106C TAG 08000CSR ' ' LOKUPOT,X 54 ÐÐ08010CSRN54 GOTO T106Z OPER UPDATE DONE 08020CSR MOVE OT,X TRAN 08030CSR EXSR SR203 CLASSIFY OPER TRAN 08040CSR 60 ADD TRAN 08050COR 61 GOTO T106E CHANGE TRAN 08060CSR 62 GOTO T106L DELETE 08070CSR MOVE ' ' OT,X 08080CSR GOTO T106C 08090C*------------------------------------------------------------------- 08100CSR T106E TAG 08110C* ADD/CHANGE 08120CSR RMO,X COMP 0 54 08130CSRN54 EXSR SR215 ADD NEW RECORD 08140CSR Z-ADDRMO,X RRNRO 50 PRT 08150CSR EXSR SR80 GET ROMAST 08160CSR EXSR SR83 REWRITE ROMAST 08170CSR MOVE ' ' OT,X 08180CSR GOTO T106C 08190C*-------------------------------------------------------------------- 08200CSR T106L TAG 08210C* DELETE SINGLE OPER 08220CSR Z-ADDRMO,X RRNRO 54 08230CSRN54 MOVE ' ' OT,X 08240CSRN54 GOTO T106C 08250CSR ZERO5 LOKUPROT 54 ÐÐ08260CSR 54 EXSR SR212 DELETE TEXT 08270CSR EXSR SR216 DELETE OPER 08280CSR MOVE ' ' OT,X 08290CSR GOTO T106C 08300C*----------------------------------------------------------------- 08310CSR T106P TAG 08320C* DELETE ALL OPER 08330CSR Z-ADDX OPERXX 20 08340CSR EXSR SR217 DELETE ALL OPER 08350C*----------------------------------------------------------------- 08360CSR T106Z TAG 08370CSR EXSR SR82 UPDATE RTMAST 08380CSR ENDSR 08390C***************************************************************** 08400CSR SR110 BEGSR 08410C* DISPLAY TEXT 08420CSR Z-ADD1 A 08430C*------------------------------------------------------------------- 08440CSR T110A TAG 08450CSR ZERO5 LOKUPROT,A 54 08460CSRN54 GOTO END110 08470CSR Z-ADDROT,A RRNRT 50 08480CSR EXSR SR81 GET TEXT 08490CSR TMX,A SUB 2 F 08500CSR EXSR SR201 CLASSIFY-F ÐÐ08510CSR MOVE RTTEXT TXT,X 08520CSR MOVE RTSPAC TP,X 08530CSR EXSR SR72 DISPLAY TEXT 08540CSR 1 ADD A A 08550CSR A COMP 15 54 08560CSRN54 GOTO T110A 08570CSR END110 ENDSR 08580C******************************************************************** 08590CSR SR111 BEGSR 08600C* UPDATE TEXT 08610CSR Z-ADD195 F 08620C*------------------------------------------------------------------- 08630CSR T111B TAG 08640CSR 1 ADD F F 08650CSR F COMP 271 54 08660CSR 54 GOTO SR111 08670C*------------------------------------------------------------------- 08680CSR T111E TAG 08690CSR EXSR SR201 CLASSIFY-F 08700CSR EXSR SR75 READ CRT 08710CSR 89 F SUB 1 F 08720CSR 89 F COMP 195 54 08730CSR 89N54 GOTO SR111 SKIP BACK 08740CSR 89 GOTO T111E 08750CSR 88 SETON 77 SPACE FILL ÐÐ08760CSR 87 GOTO T111Z DONE 08770CSR 86 GOTO T111J UPDATE 08780CSR 85 GOTO T111E REPEAT 08790CSR 77 EXSR SR103 MOVE DATA 08800CSR GOTO T111E 08810C*------------------------------------------------------------------- 08820CSR T111J TAG 08830C* UPDATE 08840CSR Z-ADD1 A 30 08850C*------------------------------------------------------------------- 08860CSR T111K TAG 08870CSR ' ' LOKUPTT,A 54 08880CSRN54 GOTO T111Z 08890CSR TT,A COMP 'A' 60 ADD/INSERT 08900CSR TT,A COMP 'C' 61 CHANGE 08910CSR TT,A COMP 'D' 62 DELETE ITEM 08920CSR TT,A COMP '#' 63 DELETE ALL 08930CSR 60 GOTO T111M 08940CSR 61 GOTO T111M 08950CSR 62 GOTO T111Q 08960CSR 63 GOTO T111S 08970CSR Z-ADD300 M 96 FLAG ERROR 08980CSR EXSR SR74 08990CSR TMX,A SUB 2 F 09000CSR GOTO T111E ÐÐ09010C*------------------------------------------------------------------- 09020CSR T111M TAG 09030C* ADD TEXT LINE 09040CSR ROT,A COMP 0 54 09050CSRN54 EXSR SR210 GET NEW PTR 09060CSR Z-ADDROT,A RRNRT 50 09070CSR EXSR SR81 GET TEXT 09080CSR EXSR SR84 REWRITE TEXT 09090CSR GOTO T111W 09100C*------------------------------------------------------------------- 09110CSR T111Q TAG 09120C* DELETE TEXT LINE 09130CSR Z-ADDROT,A RRNRT 54 09140CSR 54 EXSR SR211 DELETE TEXT RECORD 09150CSR GOTO T111W 09160C*------------------------------------------------------------------- 09170CSR T111S TAG 09180C* DELETE ALL TEXT 09190CSR EXSR SR212 DELETE ALL TEXT 09200CSR GOTO T111Z 09210C*------------------------------------------------------------------- 09220CSR T111U TAG 09230C* JUMP 09240CSR 1 ADD W W 09250CSR W COMP 50 56 ÐÐ09260CSR 56 Z-ADD318 M 96 FLAG ERROR 09270CSR 56 EXSR SR74 PUT MESSAGE 09280CSR 56 GOTO T111E 09290CSR MOVE ' ' W3A 09300CSR MOVEAA50,W W3A 09310CSR Z-ADD3 W2N 09320CSR EXIT SUBRAJ R.J. 09330CSR RLABL W2N 09340CSR RLABL W2A 09350CSR MOVE W3A A 09360CSR A COMP 1 54 54 09370CSRN54 Z-ADD1 A 09380CSR A COMP 15 54 09390CSR 54 Z-ADD15 A 09400CSR TMX,A SUB 2 F 09410CSR GOTO T111E 09420C*------------------------------------------------------------------- 09430CSR T111W TAG 09440CSR 1 ADD A A 09450CSR A COMP 15 54 09460CSRN54 GOTO T111K 09470C*------------------------------------------------------------------- 09480CSR T111Z TAG 09490CSR ENDSR 09500C******************************************************************** ÐÐ09510CSR SR201 BEGSR 09520C* IDENTIFY-F. 09530CSR SETOF 26 09540C* DO HEADER FIELDS. 09550CSR F COMP 7 28 LT 09560CSRN28 GOTO T201C 09570CSR SETON 26 09580CSR EXSR SR301 SETOFFS 09590CSR EXSR SR302 SETOFFS 09600CSR F COMP 1 01 09610CSR F COMP 2 02 09620CSR F COMP 3 03 09630CSR F COMP 4 04 09640CSR F COMP 5 05 09650CSR F COMP 6 06 09660CSR Z-ADD1 LINE 30 09670CSRN01N02 Z-ADD2 LINE 09680CSR 01 Z-ADD15 COLUM 30 09690CSR 02 Z-ADD45 COLUM 09700CSR 03 Z-ADD17 COLUM 09710CSR 04 Z-ADD45 COLUM 09720CSR 05 Z-ADD66 COLUM 09730CSR 06 Z-ADD103 COLUM 09740CSR GOTO END201 09750C*------------------------------------------------------------------- ÐÐ09760CSR T201C TAG 09770C* DO OPER FIELDS. 09780CSR F COMP 195 272929 09790CSR 27 GOTO T201G TEXT FIELD 09800CSR F COMP 141 26 09810CSR EXSR SR302 SETOFFS 09820CSR EXSR SR303 SETOFFS 09830CSR Z-ADD1 X 20 09840CSR F LOKUPMAX,X 54 54 09850CSR MAX,X SUB 8 FIRSTF 30 09860CSR X ADD 3 LINE 30 09870CSR EXSR SR304 IDENTIFY COL # 09880CSR MOVE OC,R COLUM 30 09890CSR GOTO END201 09900C*------------------------------------------------------------------- 09910CSR T201G TAG 09920C* DO TEXT FIELDS. 09930CSR EXSR SR301 SETOFFS 09940CSR EXSR SR303 SETOFFS 09950CSR Z-ADD1 X 20 09960CSR F LOKUPTMX,X 54 54 09970CSR TMX,X SUB 2 FIRSTF 09980CSR X ADD 3 LINE 09990CSR EXSR SR304 IDENTIFY COL # 10000CSR MOVE TC,R COLUM ÐÐ10010C*------------------------------------------------------------------- 10020CSR END201 TAG 10030C* 10040C* INDIC 07 08 09 10 11 12 13 14 15 10050C* ROW 1 2 3 4 5 6 7 8 9 10060C* OPER FIELD TRAN DEP WC OPER LOT SU RUN FAC MIN 10070C* TEXT FIELD TRAN TEXT SPACE 10080C* 10090CSR ENDSR 10100C********************************************************************** 10110CSR SR202 BEGSR 10120C* RIGHT JUSTIFY 10130CSR Z-ADD10 W2N 20 10140CSR MOVELW50A W10A 10 10150CSR EXIT SUBRAJ R. JUSTIFY 10160CSR RLABL W2N 10170CSR RLABL W10A 10180CSR END202 ENDSR 10190C*********************************************************************** 10200CSR SR203 BEGSR 10210C* CLASSIFY TRAN CODE 10220CSR TRAN COMP 'A' 60 ADD 10230CSR TRAN COMP 'C' 61 CHANGE 10240CSR TRAN COMP 'D' 62 DELETE 10250CSR MOVE BLK35 TRNNAM 6 ÐÐ10260CSR 60 MOVE 'ADD ' TRNNAM 10270CSR 61 MOVE 'CHANGE' TRNNAM 10280CSR 62 MOVE 'DELETE' TRNNAM 10290CSR ENDSR 10300C**************************************************************************10310CSR SR205 BEGSR 10320C* INIT RTMAST FILE. 10330CSR Z-ADD0 RMPN 10340CSR MOVE ' ' RMVERS 10350CSR MOVE ' ' RMECHG 10360CSR Z-ADD0 RMMCHG 10370CSR Z-ADD0 RMSLOT 10380CSR Z-ADD0 RMO 10390CSR MOVE ' ' RMSTAT 10400CSR ENDSR 10410C******************************************************************** 10420CSR SR206 BEGSR 10430C* INIT ROMAST FILE. 10440CSR Z-ADD0 RODEPT 10450CSR Z-ADD0 ROWC 10460CSR MOVE BLK6 ROOPER 10470CSR Z-ADD0 ROOLOT 10480CSR Z-ADD0 ROSU 10490CSR Z-ADD0 RORUN 10500CSR Z-ADD0 ROFACT ÐÐ10510CSR Z-ADD0 ROMIN 10520CSR Z-ADD0 RORRN 10530CSR Z-ADD0 ROT 10540CSR ENDSR 10550C******************************************************************** 10560CSR SR207 BEGSR 10570C* INIT ROTEXT FILE. 10580CSR Z-ADD0 RTRRN 10590CSR MOVE BLK50 RTTEXT 10600CSR ENDSR 10610C******************************************************************** 10620CSR SR210 BEGSR 10630C* SET-UP NEW TEXT PTR. 10640CSR 1 ADD NEXTRX NEXTRX 10650CSR Z-ADDNEXTRX RRNRC 10660CSR EXSR SR41 GET RTCONT 10670CSR RCRX COMP 0 54 10680CSRN54 GOTO SR210 10690CSR Z-ADDRCRX ROT,X 10700CSR Z-ADD0 RCRX 10710CSR EXSR SR42 UPDATE RTCONT 10720CSR ENDSR 10730C******************************************************************** 10740CSR SR211 BEGSR 10750C* DELETE TEXT LINE ÐÐ10760CSR LASTRX SUB 1 LASTRX 10770CSR Z-ADDLASTRX RRNRC 10780CSR EXSR SR41 GET RTCONT 10790CSR RCRX COMP 0 54 10800CSR 54 GOTO SR211 10810CSR Z-ADDROT,X RCRX 10820CSR EXSR SR42 UPD RTCONT 10830CSR Z-ADD0 ROT,X 10840CSR ENDSR 10850C******************************************************************** 10860CSR SR212 BEGSR 10870C* DELETE ALL TEXT. 10880CSR Z-ADD1 X 10890C*------------------------------------------------------------------- 10900CSR T212A TAG 10910CSR ZERO5 LOKUPROT,X 54 10920CSRN54 GOTO END212 10930CSR EXSR SR211 DELETE TEXT 10940CSR GOTO T212A 10950CSR END212 ENDSR 10960C* 10970C* 10980C* 10990C* 11000C* ÐÐ11010C* 11020C* 11030C* 11040C* 11050C* 11060C* 11070C***************************************************************** 11080CSR SR215 BEGSR 11090C* SET UP NEW OPER PTR 11100CSR 1 ADD NEXTRO NEXTRO 11110CSR Z-ADDNEXTRO RRNRC 11120CSR EXSR SR41 GET RTCONT 11130CSR RCRO COMP 0 54 11140CSRN54 GOTO SR215 TRY AGAIN 11150CSR Z-ADDRCRO RMO,X 11160CSR Z-ADD0 RCRO 11170CSR EXSR SR42 UPDATE RTCONT 11180CSR ENDSR 11190C***************************************************************** 11200CSR SR216 BEGSR 11210C* DELETE SINGLE OPER 11220CSR Z-ADDRMO,X RRNRO 11230CSR EXSR SR80 GET ROMAST 11240CSR EXSR SR212 DELETE TEXT 11250CSR EXSR SR83 REWRITE ROMAST ÐÐ11260C*---------------------------------------------------------------- 11270CSR T216C TAG 11280CSR LASTRO SUB 1 LASTRO 11290CSR Z-ADDLASTRO RRNRC 50 11300CSR EXSR SR41 GET RTCONT 11310CSR RCRO COMP 0 54 11320CSR 54 GOTO T216C 11330CSR Z-ADDRMO,X RCRO 11340CSR EXSR SR42 UPDATE RTCONT 11350CSR Z-ADD0 RMO,X INIT PTR 11360CSR ENDSR 11370C****************************************************************** 11380CSR SR217 BEGSR 11390C* DELETE ALL OPER 11400CSR Z-ADD1 X 11410C*---------------------------------------------------------------- 11420CSR T217A TAG 11430CSR ZERO5 LOKUPRMO,X 54 11440CSRN54 GOTO END217 11450CSR EXSR SR216 DELETE OPER 11460CSR GOTO T217A 11470CSR END217 ENDSR 11480C**************************************************************** 11490CSR SR218 BEGSR 11500C* LOAD OPER DATA TO SCREEN ÐÐ11510CSR Z-ADDRODEPT DEP,A 11520CSR Z-ADDROWC WC,A 11530CSR MOVE ROOPER OP,A 11540CSR Z-ADDROOLOT OL,A 11550CSR Z-ADDROSU SU,A 11560CSR Z-ADDRORUN RUN,A 11570CSR Z-ADDROFACT FAC,A 11580CSR Z-ADDROMIN MIN,A 11590CSR ENDSR 11600C****************************************************************** 11610CSR SR219 BEGSR 11620C* INIT SCREEN OPER. 11630CSR MOVE ' ' OT 11640CSR Z-ADD0 DEP 11650CSR Z-ADD0 WC 11660CSR MOVE BLK6 OP 11670CSR Z-ADD0 OL 11680CSR Z-ADD0 SU 11690CSR Z-ADD0 RUN 11700CSR Z-ADD0 FAC 11710CSR Z-ADD0 MIN 11720CSR ENDSR 11730C***************************************************************** 11740CSR SR220 BEGSR 11750C* INIT TEXT SCREEN ÐÐ11760CSR MOVE ' ' TT 11770CSR MOVE BLK50 TXT 11780CSR MOVE ' ' TP 11790CSR ENDSR 11800C******************************************************************** 11810CSR SR301 BEGSR 11820CSR SETOF 29 11830CSR ENDSR 11840C******************************************************************** 11850CSR SR302 BEGSR 11860CSR SETOF 27 11870CSR ENDSR 11880C******************************************************************** 11890CSR SR303 BEGSR 11900CSR SETOF 280102 11910CSR SETOF 030405 11920CSR SETOF 06 11930CSR ENDSR 11940C******************************************************************** 11950CSR SR304 BEGSR 11960CSR F SUB FIRSTF R 20 11970CSR 1 ADD R R 11980CSR R COMP 1 07 11990CSR R COMP 2 08 12000CSR R COMP 3 09 ÐÐ12010CSR R COMP 4 10 12020CSR R COMP 5 11 12030CSR R COMP 6 12 12040CSR R COMP 7 13 12050CSR R COMP 8 14 12060CSR R COMP 9 15 12070CSR ENDSR 12080C******************************************************************** 12090C* 12100C* 12110C* 12120C* 12130C* 12140C* 12150C* 12160C* 12170C* 12180C* 12190C* 12200C* 12210C* 12220C* 12230C* 12240C* 12250O******************************************************************** ÐÐ12260OTERM132 E 72 01 12270O OR 72 02 12280O BIT,28 1 12290O N50 8 '8091001' 12300O N50 BIT,1 9 12310O N50 BIT,1 10 12320O 50 10 '[001 ]001' 12330O 50 BIT,28 6 12340O 23 '(1) PART NO:' 12350O TPN 36 ' - - ' 12360O 52 '(2) VERSION:' 12370O TVERS 54 12380O PMDESC 90 12390O 99 'MODEL:' 12400O PMMODL 112 12410O* * * * * SCNAME 132 12420O*----------------------------------------------------------------- 12430O E 72 03 12440O OR 72 04 12450O OR 72 05 12460O OR 72 06 12470O 15 '(3) TRAN CODE:' 12480O TRAN 16 12490O* * * * * PTRNAM 24 12500O 43 '(4) ENGR REV:' ÐÐ12510O RMECHG 45 12520O 63 '(5) MFG REV:' 12530O RMMCHGZ 66 12540O 100 '(6) STD LOT SIZE:' 12550O RMSLOT2 107 12560O*----------------------------------------------------------------- 12570O E 72N01N02 12580O AND N03N04N05 12590O AND N06 12600O 4 '( )' 12610O OS,X Z 3 12620O OT,X 6 12630O DEP,X Z 12 12640O WC,X Z 16 12650O OP,X 22 12660O OL,X 2 28 12670O SU,X 2 37 12680O RUN,X 2 51 12690O FAC,X 2 58 12700O MIN,X 2 66 12710O 69 '*' 12720O N26 73 '( )' 12730O N26 TS,X Z 72 12740O N26 TT,X 76 12750O N26 TXT,X 129 ÐÐ12760O N26 TP,X 132 12770O*------------------------------------------------------------------- 12780O E 73 12790O BIT,28 1 12800O N50 8 '8111001' 12810O N50 BIT,1 9 12820O N50 BIT,1 10 12830O 50 10 '[021 ]001' 12840O 50 BIT,28 6 12850O 14 '( )' 12860O OS,19 Z 13 12870O OT,19 16 12880O DEP,19Z 22 12890O WC,19 Z 26 12900O OP,19 32 12910O OL,19 2 38 12920O SU,19 2 47 12930O RUN,192 61 12940O FAC,192 68 12950O MIN,192 76 12960O 79 '*' 12970O BIT,28 84 12980O N50 91 '8111094' 12990O N50 BIT,1 92 13000O N50 BIT,1 93 ÐÐ13010O 50 93 '[021 ]094' 13020O 50 BIT,28 89 13030O A39 132 13040O*------------------------------------------------------------------- 13050O E 74 13060O 3 'SEQ' 13070O 8 'TRAN' 13080O 13 'DEPT' 13090O 16 'WC' 13100O 21 'OPER' 13110O 28 'O.LOT' 13120O 37 'SET-UP' 13130O 46 'RUN' 13140O 58 'R.FACT' 13150O 66 'MIN' 13160O 73 'LINE' 13170O 78 'TRAN' 13180O 103 'T E X T' 13190O 132 'SPACE' 13200O******************************************************************** 13210OCRTFILE E 97 13220O PROG 26 13230O CRTIME 33 13240O CRDATE 37 13250O LNK 79 ÐÐ13260O H9 81 'H9' 13270O H8 81 'H8' 13280O H7 81 'H7' 13290O********************************************************************* 13300ORTMAST EADD 82 30 13310O TPN 10 13320O TVERS 11 13330O RMECHG 13 13340O RMMCHG 15 13350O RMSLOT 18P 13360O RMO 81P 13370O 90 'A' 13380O*------------------------------------------------------------------- 13390O E 82 31 13400O RMECHG 13 13410O RMMCHG 14 13420O RMSLOT 18P 13430O RMO 81P 13440O RMSTAT 90 13450O******************************************************************** 13460OROMAST E 83 13470O DEP,X 3P 13480O WC,X 6P 13490O OP,X 11 13500O OL,X 14P ÐÐ13510O SU,X 18P 13520O RUN,X 24P 13530O FAC,X 27P 13540O MIN,X 30P 13550O RRNRO 33P 13560O ROT 78P 13570O******************************************************************** 13580OROTEXT E 84 13590O RRNRT 3P 13600O TXT,X 53 13610O TP,X 54 13620O****************************************************************** 13630ORTCONT E 42 13640O RCRO 5 13650O RCRX 10 13660O******************************************************************** ** NUL ARRAY 013670 013680** A50 ARRAY 013690 013700** A39 ARRAY 13710 13720** DUN ARRAY 13730 13740** MES ARRAY 013750ÐÐ---MESSAGE NOT ON FILE--- 013760** LNK ARRAY 013770 13780** OT ARRAY (OPER TRAN CODES) 13790 13800** DEP ARRAY (DEPT NOS) 13810 13820** WC ARRAY (WORK CENTER NOS) 13830 13840** OS ARRAY 1385007 1 1386008 2 1387009 3 1388010 4 1389011 5 1390012 6 1391013 7 1392014 8 1393015 9 1394016 10 1395017 11 1396018 12 1397019 13 1398020 14 1399021 15 14000ÐÐ22 16 1401023 17 1402024 18 1403025 19 1404026 20 1405027 21 14060** MAX ARRAY 14070015 1 14080024 2 14090033 3 14100042 4 14110051 5 14120060 6 14130069 7 14140078 8 14150087 9 14160096 10 14170105 11 14180114 12 14190123 13 14200132 14 14210141 15 14220150 16 14230159 17 14240168 18 14250ÐÐ177 19 14260186 20 14270195 21 14280** OP (OPER CODES) 14290 14300** OL (LOT SIZES) 14310 14320** SU (SET UP HRS) 14330 14340** RUN (RUN HRS) 14350 14360** FAC (RUN FACTORS) 14370 14380** MIN (MIN CHARGES) 14390 14400** TS/TMX (TEXT LINE NOS / MAX F VALUE) 1441007 1 1442008 2 1443009 3 1444010 4 1445011 5 1446012 6 1447013 7 1448014 8 1449015 9 14500ÐÐ16 10 1451017 11 1452018 12 1453019 13 1454020 14 1455021 15 14560** TMX ARRAY 14570201 1 14580204 2 14590204 3 14600207 4 14610210 5 14620213 6 14630216 7 14640219 8 14650222 9 14660225 10 14670228 11 14680231 12 14690234 13 14700237 14 14710240 15 14720** TT ARRAY 14730 14740** TP (TEXT SPACE CODES) 14750ÐÐ 14760** TXT (TEXT TEXT) 14770 14780** OC (OPER START COL) 14790007 1 TRAN 14800011 2 DEPT 14810015 3 TEXT 14820019 4 OPER 14830025 5 LOT 14840031 6 SET UP 14850040 7 RUN 14860054 8 FACTOR 14870062 9 MIN 14880** TC (TEXT START COL) 14890077 1 TRAN 14900081 2 TEXT 14910132 3 SPACE 14920/* 14930_‚ ÐÐ_‚_‚ 14760** TXT (TEXT TEXT) 14770 14780** OC (OPER START COL) 14790007 1 TRAN 14800011 2 DEPT 14810015 3 TEXT 14820019 4 OPER 14830025 5 LOT 14840031 6 SET UP 14850040 7 RUN 14860054 8 FACTOR 14870062 9 MIN 14880** TC (TEXT START COL) 14890077 1 TRAN 14900081 2 TEXT 14910132 3 SPACE 14920/* 14930_‚ ÐÈ($ XR40 P999999120282(èÈÐ SUBROUTINE ZR40 (IBUF) 00010C RING BELL. READ 40-CHAR FROM TERMINAL. 00020 ILU = 0 00030 IXY = -1 00040 N1 = 2 00050 N2 = 40 00060 ITC = 0 00070 IA = $0700 00080 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00090 RETURN 00100 END 00110_‚ _‚_‚ 2 TEXT 14910132 3 SPACE 14920/* 14930_‚ ÐÈ(î$• î9OUUT P120282120282(èÈÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(,%Ï ,}POACCT P120282120282(èÈÐ12700F/G OFF-SITE INVENTORY S 0001013100WIP,STD PRODUCTS W 0002013200WIP,SPECIAL PRODUCTS W 0003013210WIP,SB SPECIAL PRODUCTS W 0004013300WIP,FAB PARTS W 0005013500WIP,ENGINEERING W 0006013600WIP,CONSTRUCTION W 0007014100PURCHASED PARTS IN STOCK S 0008014600SLOW MOVING PARTS IN STOCK S 0009017100BUILDINGS 0010017200BUILDING IMPROVEMENTS 0011017300TOOLING 0012017400MACHINERY & EQUIPMENT 0013017400ELECTRONIC TEST EQPT 0014017600DISPLAY & DEMO EQPT 0015017700OFFICE FURN & FIXTURES 0016017800TRANSPORTATION EQPT 0017017900LAND 0018041041O/A-OFC SUPPLIES & SVCS 0019041043O/A-TELEPHONE & TELEGPH 0020041045O/A-DUES & SUBSCRIPTIONS 0021041046O/A-CONSULT FEE & TMP LBR 0022041049O/A-EMPLOYEE EDUCATION 0023041051O/A-PLACEMENT OF ADVTSG 0024041064O/A-TRAVEL EXPENSES 00250ÐÐ41068O/A-ENTERTAINMENT EXPENSE 0026041069O/A-MISC. EXPENSES 0027042121S/A-DIRECT MATERIAL 0028042123S/A-PROD SUPPLIES & SVCS 0029042127S/A-REWORK MATERIALS 0030042144S/A-EQUIP REPAIR & MAINT 0031042148S/A-EQUIPMENT RENTAL 0032042149S/A-EMPLOYEE EDUCATION 0033042169S/A-MISC. EXPENSE 0034042221C/B-DIRECT MATERIAL 0035042223C/B-PROD SUPPLIES & SVCS 0036042227C/B-REWORK MATERIALS 0037042244C/B-EQUIP REPAIR & MAINT 0038042248C/B-EQUIPMENT RENTAL 0039042249C/B-EMPLOYEE EDUCATION 0040042269C/B-MISC. EXPENSE 0041042321T/U-DIRECT MATERIAL 0042042323T/U-PROD SUPPLIES & SVCS 0043042327T/U-REWORK MATERIALS 0044042344T/U-EQUIP REPAIR & MAINT 0045042348T/U-EQUIPMENT RENTAL 0046042349T/U-EMPLOYEE EDUCATION 0047042369T/U-MISC. EXPENSE 0048042521F/A-DIRECT MATERIAL 0049042523F/A-PROD SUPPLIES & SVCS 00500ÐÐ42527F/A-REWORK MATERIALS 0051042544F/A-EQUIP REPAIR & MAINT 0052042548F/A-EQUIPMENT RENTAL 0053042549F/A-EMPLOYEE EDUCATION 0054042569F/A-MISC. EXPENSE 0055042721SYS-DIRECT MATERIAL 0056042723SYS-PROD SUPPLIES & SVCS 0057042727SYS-REWORK MATERIALS 0058042744SYS-EQUIP REPAIR & MAINT 0059042748SYS-EQUIPMENT RENTAL 0060042749SYS-EMPLOYEE EDUCATION 0061042769SYS-MISC. EXPENSE 0062042921PRC-DIRECT MATERIAL 0063042923PRC-PROD SUPPLIES & SVCS 0064042927PRC-REWORK MATERIALS 0065042944PRC-EQUIP REPAIR & MAINT 0066042948PRC-EQUIPMENT RENTAL 0067042949PRC-EMPLOYEE EDUCATION 0068042969PRC-MISC. EXPENSE 0069043021FAB-DIRECT MATERIAL 0070043023FAB-PROD SUPPLIES & SVCS 0071043044FAB-EQUIP REPAIR & MAINT 0072043064FAB-TRAVEL EXPENSE 0073043069FAB-MISC. EXPENSE 0074044021TST-DIRECT MATERIAL 00750ÐÐ44023TST-PROD SUPPLIES & SVCS 0076044027TST-REWORK MATERIALS 0077044044TST-EQUIP REPAIR & MAINT 0078044048TST-EQUIPMENT RENTAL 0079044049TST-EMPLOYEE EDUCATION 0080044069TST-MISC. EXPENSE 0081046023Q/A-PROD SUPPLIES & SVCS 0082046041Q/A-OFC SUPPLIES & SVCS 0083046044Q/A-EQUIP REPAIR & MAINT 0084046045Q/A-DUES & SUBSCRIPTIONS 0085046049Q/A-EMPLOYEE EDUCATION 0086046051Q/A-PLACEMENT OF ADVTSG 0087046064Q/A-TRAVEL EXPENSE 0088047045MFC-DUES & SUBSCRIPTIONS 0089047049MFC-EMPLOYEE EDUCATION 0090047064MFC-TRAVEL EXPENSE 0091048121PCH-DIRECT MATERIAL 0092048123PCH-PROD SUPPLIES & SVCS 0093048141PCH-OFC SUPPLIES & SVCS 0094048142PCH-POSTAGE 0095048144PCH-EQUIP REPAIR & MAINT 0096048145PCH-DUES & SUBSCRIPTIONS 0097048147PCH-AUTO & AIR EXPENSE 0098048148PCH-EQUIPMENT RENTAL 0099048149PCH-EMPLOYEE EDUCATION 01000ÐÐ48153PCH-COST,PTS LSTS & MANLS 0101048164PCH-TRAVEL EXPENSE 0102048521M/C-DIRECT MATERIAL 0103048523M/C-PROD SUPPLIES & SVCS 0104048541M/C-OFC SUPPLIES & SVCS 0105048542M/C-POSTAGE 0106048544M/C-EQUIP REPAIR & MAINT 0107048545M/C-DUES & SUBSCRIPTIONS 0108048547M/C-AUTO & AIR EXPENSE 0109048548M/C-EQUIPMENT RENTAL 0110048549M/C-EMPLOYEE EDUCATION 0111048553M/C-COST,PTS LSTS & MANLS 0112048564M/C-TRAVEL EXPENSE 0113049023I/E-PROD SUPPLIES & SVCS 0114049041I/E-OFC SUPPLIES & SVCS 0115050200STD COST VARIANCE 0116050750FREIGHT OTH THAN ON PURCH 0117050760FREIGHT-14100 ON PURCH 0118050950IN-WARRANTEE REPAIR - TV 0119061023E/A-PROD SUPPLIES & SVCS 0120061041E/A-OFC SUPPLIES & SVCS 0121061042E/A-POSTAGE 0122061043E/A-TELEPHONE & TELEGPH 0123061044E/A-EQUIP REPAIR & MAINT 0124061045E/A-DUES & SUBSCRIPTIONS 01250ÐÐ61046E/A-CONSULT FEE & TMP LBR 0126061048E/A-EQUIPMENT RENTAL 0127061049E/A-EMPLOYEE EDUCATION 0128061051E/A-PLACEMENT OF ADVTSG 0129061054E/A-COST,SLS CATLG & DATA 0130061069E/A-MISC. EXPENSE 0131071041M/A-OFC SUPPLIES & SVCS 0132071042M/A-POSTAGE 0133071043M/A-TELEPHONE & TELEGPH 0134071044M/A-EQUIP REPAIR & MAINT 0135071045M/A-DUES & SUBSCRIPTIONS 0136071046M/A-CONSULT FEE & TMP LBR 0137071047M/A-AUTO & AIR EXPENSE 0138071049M/A-EMPLOYEE EDUCATION 0139071064M/A-TRAVEL EXPENSE 0140071068M/A-ENTERTAINMENT EXPENSE 0141071069M/A-MISC. EXPENSE 0142072041ADV-OFC SUPPLIES & SVCS 0143072052ADV-ADV MATL & PROD COSTS 0144072057ADV-PUBLIC RELATIONS 0145074051M/G-PLACEMENT OF ADVTSG 0146074054M/G-COST SLS CATLG & DATA 0147074056M/G-DIRECT MAIL EXPENSE 0148074064M/G-TRAVEL EXPENSE 0149075051M/P-PLACEMENT OF ADVTSG 01500ÐÐ75054M/P-COST SLS CATLG & DATA 0151075055M/P-COST OF TRADE SHOWS 0152075056M/P-DIRECT MAIL EXPENSE 0153076051MGD-PLACEMENT OF ADVTSG 0154076054MGD-COST SLS CATLG & DATA 0155076055MGD-COST OF TRADE SHOWS 0156076056MGD-DIRECT MAIL EXPENSE 0157076064MGD-TRAVEL EXPENSE 0158076068MGD-ENTERTAINMENT EXPENSE 0159077051MGP-PLACEMENT OF ADVTSG 0160077054MGP-COST SLS CATLG & DATA 0161077055MGP-COST OF TRADE SHOWS 0162077056MGP-DIRECT MAIL EXPENSE 0163077064MGP-TRAVEL EXPENSE 0164077068MGP-ENTERTAINMENT EXPENSE 0165079051MIN-PLACEMENT OF ADVTSG 0166079054MIN-COST SLS CATLG & DATA 0167079055MIN-COST OF TRADE SHOWS 0168079064MIN-TRAVEL EXPENSE 0169079065MIN-LEGAL & ACCTG FEES 0170079068MIN-ENTERTAINMENT EXPENSE 0171079069MIN-MISC. EXPENSE 0172081041F/P-OFC SUPPLIES & SVCS 0173081042F/P-POSTAGE 0174081043F/P-TELEPHONE & TELEGPH 01750ÐÐ81044F/P-EQUIP REPAIR & MAINT 0176081045F/P-DUES & SUBSCRIPTIONS 0177081046F/P-CONSULT FEE & TMP LBR 0178081047F/P-AUTO & AIR EXPENSE 0179081048F/P-EQUIPMENT RENTAL 0180081049F/P-EMPLOYEE EDUCATION 0181081051F/P-PLACEMENT OF ADVTSG 0182081061F/P-INSURANCE 0183081062F/P-BAD DEBT EXPENSE 0184081063F/P-DONATIONS 0185081064F/P-TRAVEL EXPENSE 0186081065F/P-LEGAL & ACCTG FEES 0187081066F/P-COMMISSIONS EXPENSE 0188081067F/P-DIRECTORS FEES 0189081068F/P-ENTERTAINMENT EXPENSE 0190081069F/P-MISC. EXPENSE 0191084041EDP-OFC SUPPLIES & SVCS 0192084044EDP-EQUIP REPAIR & MAINT 0193084045EDP-DUES & SUBSCRIPTIONS 0194084046EDP-CONSULT FEE & TMP LBR 0195084048EDP-EQUIPMENT RENTAL 0196084049EDP-EMPLOYEE EDUCATION 0197091041OCC-OFC SUPPLIES & SVCS 0198091044OCC-EQUIP REPAIR & MAINT 0199091046OCC-CONSULT FEE & TMP LBR 02000ÐÐ91048OCC-EQUIPMENT RENTAL 0201091069OCC-MISC. EXPENSE 0202091073OCC-PLANT PROTECTION 0203091075OCC-MAINT SUPPLIES & SVCS 0204091078OCC-EMPLOYEE RELATIONS 02050_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ô&M ôÑX031WO P999999120282(èÈÐ00010H Q031WO00020F* UPDATE COMPONENT ALT KEYS ON WORK ORDER CHANGE. 00030F* REVISED 8-01-82 12:55 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FWOBATCH UC F 64R DISK 00070FALTDUE UC F 32R29AI 1 DISK A 00080FALTPN UC F 32R29AI 1 DISK A 00090FBOMAST UD F 80L19AI 1 DISK 00100FWOPULL UD F 64L19AI 1 DISK 00110FWOOPER UD F 64L20AI 1 DISK 00120FCRTFILE UC F 256R DISK 00130FTERM50 O F 50 5 00140E******************************************************************** 00150E A29 29 29 1 00160E LNK 1 7 6 A 00170E BIT 33 1 00180E PAR 25 1 00190E TST 25 1 00200E CALL 7 6 00210I******************************************************************** 00220IBITPAR BP 00230I 1 33 BIT 00240I 34 58 PAR 00250I 59 83 TST ÐÐ00260I********************************************************************** 00270ICRTFILE CR 00280I 28 330CRTIME 00290I 34 370CRDATE 00300I 38 79 CALL 00310I P 81 830CRRRN 00320I******************************************************************** 00330IALTPN AP 00340I 32 32 APSTAT 00350I******************************************************************** 00360IALTDUE AD 00370I 32 32 ADSTAT 00380I******************************************************************** 00390IBOMAST BO 00400I* BACKORDER MASTER. 00410I* ORDER NO. 9A 00420I 1 19 BOKEY 00430I 1 9 BOWO 00440I* PART NO. 10N 00450I 10 19 BOPN 00460I* DATE REQD 6N (YMD) 00470I 30 35 BODUE 00480I* RECORD STATUS 1A 00490I 80 80 BOSTAT 00500I******************************************************************** ÐÐ00510IWOPULL WP 00520I* WORK ORDER PULL FILE. 00530I* KEY AREA. 00540I 1 19 WPKEY 00550I* WORK ORDER 9A 00560I 1 9 WPWO 00570I* COMPONENT PART # 10N 00580I 10 19 WPCPN 00590I* DATE LAST TRAN 6N 00600I 52 570WPDLT 00610I* RECORD STATUS 1A 00620I 64 64 WPSTAT 00630I******************************************************************** 00640IWOBATCH WB 00650I* WORK ORDER BATCH FILE 00660I* RECORD CODE 2A 00670I* RW = RELEASE WORK ORDER 00680I* DW = DELETE WORK ORDER 00690I* CW = CHANGE WORK ORDER 00700I 1 2 WBREC 00710I* WORK ORDER NO. 9A 00720I 3 11 WBWO 00730I* CURRENT QUANTITY 7P 00740I P 12 150WBQTY 00750I* CURRENT DUE DATE 6N ÐÐ00760I 16 210WBDUE 00770I* CURRENT START DATE 6N 00780I 22 27 WBSTRT 00790I* OLD QTY 7P 00800I P 28 310WBQTYO 00810I* OLD DUE DATE 6N 00820I 32 37 WBDUEO 00830I* OLD START DATE 6N 00840I 38 43 WBSDO 00850I* QTY COMPLETE 7P 00860I P 44 470WBQTYC 00870I* WO PART # 10N 00880I 48 570WBPN 00890I* RECORD STATUS 1A 00900I 64 64 WBSTAT 00910I**************************************************************** 00920IWOOPER WR 00930I 1 9 WRWO 00940I 1 20 WRKEY 00950I 64 64 WRSTAT 00960C******************************************************************** 00970C* INIT 1-TIME 00980C SETON 70 00990C U1 EXCPT TERM50 MSG 01000C SETOF 70 ÐÐ01010C EXSR SR101 INIT 01020C EXSR SR80 GET WOBATCH 01030C* GET BACKORDERS. UPDATE BOMAST AND ALT KEY FILES. 01040C MOVE BLK35 W19A 01050C MOVELWBWO W19A 19 01060C W19A SETLLBOMAST 01070C MOVE BLK35 LASTBO 19 01080C*------------------------------------------------------------------- 01090C TAG10 TAG 01100C SETOF 54 01110C READ BOMAST 54 01120C 54 GOTO TAG100 01130C BOKEY COMP LASTBO 54 01140C 54 BOWO COMP WBWO 54 01150C N54 GOTO TAG100 01160C MOVE BOKEY LASTBO 01170C BOSTAT COMP 'D' 54 01180C 54 GOTO TAG10 01190C SETON 82 01200C EXCPT UPDATE WOBATCH 01210C SETOF 82 01220C*------------------------------------------------------------------- 01230C TAG20 TAG 01240C SETON 83 01250C EXCPT UPDATE BOMAST ÐÐ01260C SETOF 83 01270C MOVEABOPN A29 01280C MOVEABODUE A29,11 01290C MOVEA'70' A29,17 01300C MOVEABOWO A29,19 01310C MOVEA'00' A29,28 01320C MOVEAA29 W29A 29 01330C W29A CHAINALTPN 60 01340C N60 SETON 85 01350C N60 EXCPT DELETE ALTPN 01360C SETOF 85 01370C MOVEAWBSTRT A29,11 01380C MOVEAA29 W29A 01390C W29A CHAINALTPN 60 01400C SETON 86 01410C EXCPT ADD ALTPN 01420C SETOF 86 01430C MOVEA'70' A29 01440C MOVEABODUE A29,3 01450C MOVEABOWO A29,9 01460C MOVEA'00' A29,18 01470C MOVEABOPN A29,20 01480C MOVEAA29 W29A 01490C W29A CHAINALTDUE 60 01500C N60 SETON 87 ÐÐ01510C N60 EXCPT DELETE ALTDUE 01520C SETOF 87 01530C MOVEAWBSTRT A29,3 01540C MOVEAA29 W29A 01550C W29A CHAINALTDUE 60 01560C SETON 88 01570C EXCPT ADD ALTDUE 01580C SETOF 88 01590C GOTO TAG10 01600C*------------------------------------------------------------------- 01610C TAG100 TAG 01620C* READ WOPULL FILE. UPDATE ALT KEYS. 01630C MOVE BLK35 W19A 19 01640C MOVE BLK35 LASTWP 19 01650C MOVELWBWO W19A 01660C W19A SETLLWOPULL 01670C*------------------------------------------------------------------- 01680C TAG110 TAG 01690C SETOF 54 01700C READ WOPULL 54 01710C 54 GOTO TAG200 01720C WPKEY COMP LASTWP 54 01730C 54 WPWO COMP WBWO 54 01740C N54 GOTO TAG200 01750C MOVE WPKEY LASTWP ÐÐ01760C WPSTAT COMP 'D' 54 01770C 54 GOTO TAG110 01780C SETON 81 01790C EXCPT UPDATE WOPULL 01800C SETOF 81 01810C MOVEAWPCPN A29,1 01820C MOVEAWBSDO A29,11 01830C MOVEA'80' A29,17 01840C MOVEAWPWO A29,19 01850C MOVEA'00' A29,28 01860C MOVEAA29 W29A 01870C W29A CHAINALTPN 60 01880C N60 SETON 85 01890C N60 EXCPT DELETE ALTPN 01900C SETOF 85 01910C MOVEAWBSTRT A29,11 01920C MOVEAA29 W29A 01930C W29A CHAINALTPN 60 01940C SETON 86 01950C EXCPT ADD ALTPN 01960C SETOF 86 01970C MOVEA'80' A29 01980C MOVEAWBSDO A29,3 01990C MOVEAWPWO A29,9 02000C MOVEA'00' A29,18 ÐÐ02010C MOVEAWPCPN A29,20 02020C MOVEAA29 W29A 02030C W29A CHAINALTDUE 60 02040C N60 SETON 87 02050C N60 EXCPT DELETE ALTDUE 02060C SETOF 87 02070C MOVEAWBSTRT A29,3 02080C MOVEAA29 W29A 02090C W29A CHAINALTDUE 60 02100C SETON 88 02110C EXCPT ADD ALTDUE 02120C SETOF 88 02130C GOTO TAG110 02140C*----------------------------------------------------------------- 02150C TAG200 TAG 02160C* UPDATE WOOPER DUE DATE (START DATE) 02170C MOVE BLK35 W20A 20 02180C MOVELWBWO W20A 02190C W20A SETLLWOOPER 02200C MOVE BLK35 W20A 02210C*----------------------------------------------------------------- 02220C TAG210 TAG 02230C SETOF 54 02240C READ WOOPER 54 02250C 54 GOTO END ÐÐ02260C WRKEY COMP W20A 54 02270C N54 GOTO END 02280C MOVE WRKEY W20A 02290C WRWO COMP WBWO 54 02300C N54 GOTO END 02310C WRSTAT COMP 'D' 54 02320C 54 GOTO TAG210 02330C SETON 80 02340C EXCPT UPDATE WOOPER 02350C SETOF 80 02360C GOTO TAG210 02370C*------------------------------------------------------------------ 02380C END TAG 02390C EXSR SR96 GET CRTFILE 02400C Z-ADD1 W 30 02410C ' ' LOKUPLNK,W 54 02420C 54 MOVELLNK,W PROG 8 02430C 54 MOVE ' ' LNK,W 02440C N54 MOVEL'CONTU' PROG 02450C EXSR SR97 UPATE CRTFILE 02460C EXSR SR98 >>>>>>>>>>>>>>>>> 02470C*----------------------------------------------------------------- 02480C ENDJOB TAG 02490C MOVEL'ENDJOB' PROG 02500C EXSR SR98 >>>>>>>>>> ÐÐ02510C******************************************************************* 02520CSR SR80 BEGSR 02530CSR CRRRN CHAINWOBATCH H8 02540CSR H8 GOTO ENDJOB 02550CSR ENDSR 02560C*************************************************************** 02570CSR SR96 BEGSR 02580CSR # CHAINCRTFILE H9 02590CSR H9 GOTO ENDJOB 02600CSR ENDSR 02610C**************************************************************** 02620CSR SR97 BEGSR 02630CSR TIME CRTIME 02640CSR MOVELUDATE CRDATE 02650CSR SETON 97 02660CSR EXCPT REWRITE CRTFILE 02670CSR SETOF 97 02680CSR ENDSR 02690C***************************************************************** 02700CSR SR98 BEGSR 02710CSR EXITFCHAIN >>>>>>>>>>>>>>>>> 02720CSR RLABL PROG 02730CSR ENDSR 02740C****************************************************************** 02750CSR SR101 BEGSR ÐÐ02760C* 1-TIME INIT 02770CSR MOVELUDATE W4N 40 02780CSR MOVE UDATE W2N 20 02790CSR MOVELW2N TODAY 60 02800CSR MOVE W4N TODAY 02810CSR MOVE ' ' W2A 2 02820CSR EXITFZGMINX 02830CSR RLABL W2A 02840CSR MOVE W2A # 20 02850CSR # COMP 0 54 02860CSRN54 Z-ADD25 # 02870CSR EXSR SR96 GET CRTFILE 02880CSR MOVE CALL LNK 02890CSR MOVEL'Q031WO' PROG 02900CSR TST,# COMP 'S' 54 02910CSR 54 MOVE 'SHUTDOWN'PROG 8 02920CSR 54 EXSR SR97 REWRITE CRTFILE 02930CSR 54 EXSR SR98 >>>>>>>>>>>>>>>> 02940CSR MOVE ' 'PROG 02950CSR MOVE ' ' BLK35 35 02960CSR ENDSR 02970O******************************************************************** 02980OWOBATCH E 82 02990O WBQTY 15P 03000O WBQTYO 31P ÐÐ03010O WBQTYC 47P 03020O 64 'D' 03030O***************************************************************** 03040OWOPULL E 81 03050O WBPN 29 03060O******************************************************************** 03070OBOMAST E 83 03080O WBSTRT 35 03090O******************************************************************** 03100OALTPN E 85 03110O 32 'D' 03120O*------------------------------------------------------------------- 03130O EADD 86 60 03140O W29A 29 03150O 32 'A' 03160O*------------------------------------------------------------------- 03170O E 86N60 03180O 32 'A' 03190O******************************************************************** 03200OALTDUE E 87 03210O 32 'D' 03220O*--------------------------------------------------------------- 03230O EADD 88 60 03240O W29A 29 03250O 32 'A' ÐÐ03260O*---------------------------------------------------------------- 03270O E 88N60 03280O 32 'A' 03290O******************************************************************** 03300OTERM50 E 70 U1 03310O 7 'ALTKEYS' 03320O****************************************************************** 03330OWOOPER E 80 03340O WBSTRT 56 03350O TODAY 63 03360O***************************************************************** 03370OCRTFILE E 97 03380O PROG 26 03390O CRTIME 33 03400O CRDATE 37 03410O LNK 79 03420O***************************************************************** ** A29 ARRAY 03430 03440** LNK ARRAY 03450 03460/* 03470_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(è' è¡X223SF P999999120282(èÈÐ00010H Q223SF00020F* DISPLAY SFMAST FOR PART NO.'S HAVING B/O'S FOR INPUT W/O #. (X223SF) 00030F* REVISED 11/16/82 3:40 PM. 00040FBITPAR IP F 90 DISK 00050FALTKEY ID F 32L29AI 1 DISK 00060FSFMAST ID F 128L29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FCRTFILE UC F 256R DISK 00090FMGFILE IC F 80R DISK 00100FCALENDARIC F 22R 7AI 1 DISK 00110FCMMAST IC F 576R 5AI 1 DISK 00120FREMARKS ID F 90L29AI 1 DISK 00130FTERM132 O F 132 5 00140E******************************************************************** 00150E A12 12 12 1 A 00160E AR 1 132 1 00170E TABSC 1 6 2 TABSCN 15 00180E DIV 1 132 1 00190E LNK 1 7 6 A 00200E SWO 1 25 11 A 00210E CALL 7 6 00220E BIT 33 1 00230E PAR 25 1 00240E TST 25 1 00250E NUL 1 132 1 ÐÐ00260E PM$ 7 9 3 MFG $ FILE 00270E PLT 8 3 0 LEAD TIMES 00280I******************************************************************** 00290IBITPAR BT 00300I 1 33 BIT 00310I 34 58 PAR 00320I 59 83 TST 00330I********************************************************************** 00340ICRTFILE CR 00350I 28 330CRTIME 00360I 34 370CRDATE 00370I 38 79 CALL 00380I******************************************************************** 00390IALTKEY AK 00400I 1 29 AKKEY 00410I 1 2 AKREC 00420I 3 11 AKWO 00430I 14 230AKPN 00440I 24 290AKDUE 00450I 32 32 AKSTAT 00460I******************************************************************** 00470ISFMAST SF 00480I* SCHEDULE MASTER. 00490I* COMMON FIELDS. 00500I* KEY AREA. ÐÐ00510I 1 29 SFKEY 00520I* PART NO. 10N 00530I 1 100SFPN 00540I* DATE DUE 6N (YMD) 00550I 11 160SFDUE 00560I* RECORD CODE 2N 00570I* 10 = RECEIVED PO 00580I* 20 = REL WO 00590I* 30 = PURCHASE ORDER 00600I* 40 = PLANNED WORK ORDER 00610I* 50 = PURCHASE REQ 00620I* 60 = SALES ORDER-BACKLOG 00630I* 70 = REL REQUIREMENT 00640I* 80 = PLAN REQUIREMENT 00650I* 90 = RUN RELEASE 00660I 17 180SFREC 00670I* ORDER NO. 00680I 19 29 SFORD 00690I* PREFIX 1A 00700I 19 19 SFPRFX 00710I* PRIME 5N 00720I 19 24 SFPRIM 00730I* DASH 3N 00740I 25 270SFDASH 00750I 19 27 SFWO ÐÐ00760I* RECEIVING LOG 2N 00770I 28 290SFRLOG 00780I* QUANTITY 7P 00790I P 30 330SFQTY 00800I* QTY COMPLETE 7P 00810I P 34 370SFQTYC 00820I* DATE LAST TRAN 6N (YMD) 00830I 38 430SFDLT 00840I* CUST #/DEPT #/VEND # 5P 00850I P 44 460SFCUST 00860I* VARIABLE AREA. 00870I* PLAN/REL REQMTS 00880I* NEXT ASSY PART # 10N 00890I 47 560SFNAPN 00900I* QTY PER ASSY 7P 00910I P 57 600SFQPA 00920I* ISSUE CODE 2A 00930I 61 62 SFISSU 00940I* ASSY REVISION 2A 00950I 65 66 SFREV 00960I* ASSY WO QTY 7P 00970I 67 700SFQTYA 00980I* SALES ORDERS 00990I* PRICE CODE 1A 01000I* SEE WORK ORDERS. ÐÐ01010I* CUST P.O. 20A 01020I 71 90 SFCPO 01030I* UNIT PRICE 9.3P 01040I P 91 953SFPRIC 01050I* PURCH ORDERS 01060I* PRICE CODE 1A 01070I* SEE WORK ORDERS. 01080I* VENDOR NAME 20A 01090I* SEE SFCPO UNDER SALES ORDERS. 01100I* UNIT PRICE 9.3P 01110I* SEE SFPRIC UNDER SALES ORDERS. 01120I* PACKING SLIP 9A 01130I* 96 104 SFPKGS 01140I* WORK ORDERS 01150I* DEPT NAME 20A 01160I* SEE SFCPO UNDER SALES ORDERS. 01170I* OPER SEQ # 3P 01180I P 96 970SFSEQ 01190I* START DATE 6N 01200I 98 1030SFSTRT 01210I* PRICE CODE 1A 01220I 105 105 SFPCOD 01230I* BACKORDER FLAG 1A 01240I 106 106 SFBOF 01250I* REVISION 2A ÐÐ01260I* SEE PLAN/REL REQMTS. 01270I* RECORD STATUS 1A 01280I 128 128 SFSTAT 01290I******************************************************************** 01300IPMMST2 PM 01310I 1 100PMPN 01320I 15 180PMPL 01330I 19 30 PMMODL 01340I 31 59 PMDESC 01350I 70 71 PMECHG 01360I 94 95 PMSC 01370I P 113 128 PLT 01380I P 163 1660PMSSTK 01390I P 245 279 PM$ 01400I P 311 3140PMOHB 01410I P 489 4933PMOSUC 01420I 674 674 PMSTAT 01430I******************************************************************** 01440IMGFILE MG 01450I 1 35 MGTEXT 01460I******************************************************************** 01470ICALENDARCA 20 1 CC 01480I* CALENDAR DATE RECORD. 01490I 2 30CAYR 01500I 4 50CAMO ÐÐ01510I 6 70CADAY 01520I 14 170CAMDAY 01530I 18 200CAWK 01540I 21 220CADOW 01550I*------------------------------------------------------------------- 01560I CB 21 1 CM 01570I* MFG DATE RECORD. 01580I 4 70CAMDAY 01590I 8 90CAYR 01600I 10 110CAMO 01610I 12 130CADAY 01620I 18 200CAWK 01630I 21 220CADOW 01640I*------------------------------------------------------------------- 01650I GG 22 01660I******************************************************************** 01670ICMMAST CM 01680I* CUSTOMER MASTER 01690I* CUST NAME 35A 01700I 26 60 CMNAME 01710I****************************************************************** 01720IREMARKS RK 01730I* COMMENT FILE 01740I* KEY FIELD 29A 01750I 1 19 RKKEY ÐÐ01760I 1 100RKPN 01770I* RECORD CODE 2A 01780I 17 180RKREC 01790I* PO NO. 9A 01800I 19 27 RKWO 01810I* TEXT 60A 01820I 30 89 RKTEXT 01830I* RECORD STATUS 1A 01840I 90 90 RKSTAT 01850C******************************************************************* 01860C* INITIALIZE. 01870C EXSR SR101 INIT 01880C MOVE ' ' BLK6 6 01890C EXSR SR71 PUT HEADINGS 01900C*------------------------------------------------------------------- 01910C START TAG 01920C* REQUEST WORK ORDER # 01930C Z-ADD0 PMPN 01940C EXSR SR67 LF 01950C SETON 82 01960C EXCPT PROMPT 01970C SETOF 82 01980C 3 ADD COUNT COUNT 30 01990C EXSR SR75 READ 02000C*--------------------------------------------------------------- ÐÐ02010C TAG10 TAG 02020C SETOF 7790 02030C EXSR SR210 BUILD WO 02040C MOVEL'A7' W11A 11 02050C MOVE TWO W11A 11 02060C MOVE BLK35 W29A 29 02070C MOVELW11A W29A 02080C W29A SETLLALTKEY 02090C MOVE BLK35 LASTAK 29 02100C*------------------------------------------------------------- 02110C TAG20 TAG 02120C* READ ALTKEY ORDER RECORDS. 02130C SETOF 907754 02140C READ ALTKEY 54 02150C 54 GOTO START 02160C AKKEY COMP LASTAK 54 02170C 54 AKREC COMP 'A7' 54 02180C N54 GOTO START 02190C AKSTAT COMP 'D' 54 02200C 54 GOTO TAG20 02210C AKPN COMP LSTAKP 54 02220C 54 GOTO TAG20 02230C MOVE AKPN PN 100 02240C AKWO COMP LASTWO 54 02250C N54 SETON 78 ÐÐ02260C N54 EXCPT PUT DIVIDER 02270C SETOF 78 02280C EXSR SR102 PUT PMMST 02290C 77 GOTO TAG10 02300C 60 GOTO TAG20 02310C MOVE BLK35 W29A 02320C MOVELPN W29A 29 02330C Z-ADDAKPN LSTAKP 100 02340C W29A SETLLSFMAST SET-UP 1ST READ 02350C Z-ADD0 AVAIL 70 OVERALL AVAIL BAL 02360C Z-ADD0 SAVAIL 70 AVAIL STOCK BAL 02370C MOVE BLK35 LSTKEY 02380C*------------------------------------------------------------------ 02390C TAG40 TAG 02400C* READ SFMAST IN PART NO. SEQUENCE 02410C SETOF 77 02420C SETOF 549390 02430C READ SFMAST 54 GET SFMAST 02440C 54 GOTO TOTALS 02450C SFKEY COMP LSTKEY 54 CHECK KEY SEQ 02460C 54 SFPN COMP AKPN 54 02470C N54 GOTO TOTALS 02480C MOVE SFKEY LSTKEY 29 02490C SFSTAT COMP 'D' 54 FLAG DELETED 02500C 54 GOTO TAG40 ÐÐ02510C Z-ADDSFPN PN 02520C SFQTY SUB SFQTYC QTYBAL 70 54 02530C N54 GOTO TAG40 INACTIVE QTY 02540C EXSR SR103 CLASSIFY SFMAST 02550C 77 GOTO TAG10 02560C 13 Z-ADDSFQPA QPA5 50 QTY PER ASSY (CRT) 02570C 06 SFCUST CHAINCMMAST 54 GET CUSTOMER MAST 02580C 06N54 MOVELCMNAME SFCPO CUST NAME 02590C EXSR SR72 PUT DATA 02600C 77 GOTO TAG10 02610C GOTO TAG40 GET NEXT SFMAST 02620C*------------------------------------------------------------------- 02630C TOTALS TAG 02640C* PUT TOTALS. 02650C SETOF 7790 02660C AVAIL COMP 0 55 LESS THAN 02670C 55 Z-ADD1 XTRA 30 02680C EXSR SR69 CHECK END PAGE 02690C 77 GOTO TAG10 NEW PN INPUT 02700C AVAIL COMP 0 55 LESS THAN 02710C 55 1 ADD COUNT COUNT 02720C SETON 76 02730C EXCPT PUT TOTALS 02740C SETOF 76 02750C 1 ADD COUNT COUNT ÐÐ02760C GOTO TAG20 02770C*------------------------------------------------------------------- 02780C NEWITM TAG 02790C MOVEL'Q223SF' PROG 8 02800C GOTO END 02810C*------------------------------------------------------------------- 02820C MENU TAG 02830C EXSR SR96 GET CRTFILE 02840C Z-ADD1 W 02850C BLK6 LOKUPLNK,W 54 02860C 54 MOVELLNK,W PROG 02870C 54 MOVE BLK6 LNK,W 02880C N54 MOVEL'CONTU' PROG 02890C EXSR SR97 UPD CRTFILE 02900C EXSR SR98 >>>>>>>>>> 02910C*------------------------------------------------------------------- 02920C GOODBY TAG 02930C MOVEL'GOODBY' PROG 02940C END TAG 02950C EXITFZBRITE 02960C EXSR SR96 GET CRTFILE 02970C EXSR SR97 UPD CRTFILE 02980C EXSR SR98 >>>>>>>>>> 02990C*------------------------------------------------------------------- 03000C ENDJOB TAG ÐÐ03010C MOVEL'ENDJOB' PROG 03020C EXSR SR98 >>>>>>>>>> 03030C**************************************************************** 03040CSR SR67 BEGSR 03050CSR EXITFZLF LF 03060CSR 1 ADD COUNT COUNT 03070CSR ENDSR 03080C****************************************************************** 03090CSR SR69 BEGSR 03100C* CHECK END PAGE 03110CSR SETOF 7790 03120CSR 1 ADD COUNT W3N 30 03130CSR XTRA ADD W3N W3N 03140CSR Z-ADD0 XTRA 03150CSR 50 W3N COMP 23 54 03160CSRN50 W3N COMP 28 54 03170CSRN54 GOTO END69 03180CSR MOVE BIT,1 AR 03190CSR SETON 83 03200CSR EXCPT END OF PAGE PROMPT 03210CSR SETOF 83 03220CSR MOVE '.' AR 03230CSR EXSR SR75 READ CRT 03240CSR EXSR SR71 PUT HEADINGS 03250CSR EXSR SR67 LF ÐÐ03260CSR 77 GOTO END69 03270CSR SFPN COMP LASTPN 54 03280CSR 54 EXSR SR74 PUT PART MAST 03290CSR SFPN COMP LASTPN 54 03300CSR 54 SETON 81 03310CSR 54 EXCPT CONT'D LINE 03320CSR SETOF 81 03330CSR 1 ADD COUNT COUNT 03340CSR END69 ENDSR 03350C******************************************************************** 03360CSR SR70 BEGSR 03370C* CLEAR CRT. 03380CSR 50 EXITFZISTAT 03390CSR 50 EXITFZESCH 03400CSRN50 EXITFZCPAGE CLEAR PAGE-4 03410CSR EXITFZBRITE 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR71 BEGSR 03450C* PUT HEADING. 03460CSR EXSR SR70 CLEAR CRT 03470CSR Z-ADD4 COUNT 03480CSR SETON 71 03490CSR EXCPT PUT HDG 03500CSR SETOF 71 ÐÐ03510CSR EXITFZDIM 03520CSR ENDSR 03530C******************************************************************** 03540CSR SR72 BEGSR 03550C* PUT DATA LINE. 03560CSR SETOF 7790 03570CSR 10 QTYBAL ADD ORDBAL ORDBAL 70 03580CSR 11 QTYBAL ADD REQBAL REQBAL 70 03590CSR 10 Z-ADDQTYBAL QTYORD 70 03600CSR 11 Z-ADDQTYBAL QTYREQ 70 03610CSR ORDBAL ADD STKQTY AVAIL 70 03620CSR AVAIL SUB REQBAL AVAIL 03630CSR SAVAIL SUB REQBAL SAVAIL 03640CSR EXSR SR204 DATES/$ 03650CSR EXSR SR69 CHECK END PAGE 03660CSR 77 GOTO END72 03670CSR SFDASH COMP 0 56 03680CSR SETOF 70 03690CSR 01 03700COR 06 SETON 70 03710CSR 07 SFWO COMP AKWO 54 03720CSR 07 54 EXITFZBRITE 03730CSR SETON 72 03740CSR EXCPT PUT DATA 03750CSR SETOF 72 ÐÐ03760CSR EXSR SR206 PUT REMARKS 03770CSR EXITFZDIM 03780CSR Z-ADDSFPN LASTPN 100 03790CSR MOVE AKWO LASTWO 11 03800CSR 1 ADD COUNT COUNT 30 03810CSR EXSR SR104 COMPUTE EXCEPTIONS 03820CSR END72 ENDSR 03830C******************************************************************** 03840CSR SR73 BEGSR 03850C* PUT MESSAGE. 03860CSR SETOF 7790 03870CSR EXSR SR69 CHECK END PAGE 03880CSR 77 GOTO END73 03890CSR M CHAINMGFILE 54 03900CSR 54 MOVE BLK35 MGTEXT 03910CSR 54 MOVEL'??????' MGTEXT 03920CSR SETON 73 03930CSR EXCPT PUT MSG 03940CSR SETOF 7396 03950CSR 1 ADD COUNT COUNT 03960CSR END73 ENDSR 03970C******************************************************************** 03980CSR SR74 BEGSR 03990C* PUT PART MAST LINE. 04000CSR EXITFZBRITE ÐÐ04010CSR SETON 74 04020CSR EXCPT PUT PMMST2 TO CRT 04030CSR SETOF 74 04040CSR 2 ADD COUNT COUNT 04050CSR ENDSR 04060C******************************************************************** 04070CSR SR75 BEGSR 04080C* READ. 04090CSR SETOF 7790 04100CSR SETOF 939498 04110CSR MOVE BLK12 W12A 12 04120CSR EXITFZR12 READ TERMINAL 04130CSR RLABL W12A 04140CSR MOVEAW12A A12 04150CSR MOVE BLK12 W12A 04160CSR Z-ADD1 W 30 04170CSR '\' LOKUPA12,W 90 04180CSRN90 GOTO T75B 04190CSR 1 ADD W W 04200CSR W COMP 12 54 04210CSR 54 GOTO T75A 04220CSR A12,W COMP 'G' 98 GOODBY 04230CSR A12,W COMP 'N' 93 NEW ITEM 04240CSR A12,W COMP 'E' 94 EXIT 04250CSR 93 GOTO NEWITM ÐÐ04260CSR 94 GOTO MENU 04270CSR 98 GOTO GOODBY 04280C*------------------------------------------------------------------- 04290CSR T75A TAG 04300CSR Z-ADD318 M 50 FLAG ERROR 04310CSR EXSR SR73 PUT MSG 04320CSR 77 04330COR 90 GOTO END75 04340CSR GOTO SR75 04350C*------------------------------------------------------------------- 04360CSR T75B TAG 04370CSR Z-ADD1 W 04380CSR ' ' LOKUPA12,W 77 04390CSR 77 MOVEAA12,W W12A 04400CSR END75 ENDSR 04410C******************************************************************** 04420CSR SR96 BEGSR 04430CSR # CHAINCRTFILE H9 GET CRTFILE 04440CSR H9 GOTO ENDJOB 04450CSR ENDSR 04460C******************************************************************** 04470CSR SR97 BEGSR 04480C* UPDATE CRTFILE. EXIT PROGRAM. 04490CSR TIME CRTIME 04500CSR MOVELUDATE CRDATE ÐÐ04510CSR SETON 97 04520CSR EXCPT UPDATE CRTFILE 04530CSR SETOF 97 04540CSR ENDSR 04550C******************************************************************** 04560CSR SR98 BEGSR 04570CSR EXSR SR70 CLEAR SCREEN 04580CSR EXITFCHAIN >>>>>>>>>> 04590CSR RLABL PROG 04600CSR ENDSR 04610C******************************************************************** 04620CSR SR101 BEGSR 04630C* 1-TIME INITIALIZE. 04640CSR MOVELBIT,1 BUFLGT 2 04650CSR MOVE BIT,1 NUL 04660CSR MOVE '-' DIV 04670CSR MOVE '.' AR 04680CSR MOVE ' ' BLK35 35 04690CSR MOVE ' ' BLK12 12 04700CSR Z-ADDUDATE W6N 60 04710CSR EXSR SR205 04720CSR Z-ADDCAMDAY TODAY 40 CUR MDAY 04730CSR Z-ADDW6N CURCAL 60 CUR CAL DATE 04740CSR MOVE ' ' W2A 2 04750CSR EXITFZGMINX GET PORT# ÐÐ04760CSR RLABL W2A 04770CSR MOVE W2A # 20 04780CSR # COMP 0 54 04790CSRN54 Z-ADD25 # 04800CSR EXSR SR96 GET CRTFILE 04810CSR MOVE CALL LNK 04820CSR MOVE 'Q223SF 'PROG 04830CSR PAR,# COMP '1' 50 04840CSR TST,# COMP 'S' 54 04850CSR 54 MOVE 'SHUTDOWN'PROG 04860CSR EXSR SR97 UPD CRTFILE 04870CSR 54 EXSR SR98 >>>>>>>>>> 04880CSR MOVE ' 'PROG 04890CSR MOVE ' ' BLK11 11 04900CSR ENDSR 04910C******************************************************************** 04920CSR SR102 BEGSR 04930C* DISPLAY PART MASTER. 04940CSR SETOF 607790 04950CSR MOVE BLK11 SWO 04960CSR Z-ADD0 AVAIL 04970CSR Z-ADD0 ORDBAL 04980CSR Z-ADD0 REQBAL 04990CSR MOVE BLK12 SCNAME 15 05000CSR MOVELPN W12A ÐÐ05010CSR MOVE ' ' W12A 05020CSR W12A CHAINPMMST2 60 05030CSR 60 GOTO END102 05040CSR PMMODL COMP BLK12 54 05050CSR 54 MOVEL'MODEL' W18A 18 05060CSR 54 MOVE PMMODL W18A 05070CSR 54 MOVE BLK35 PMDESC 05080CSR 54 MOVELW18A PMDESC 05090CSR PMSC LOKUPTABSC TABSCN 54 05100CSR 54 MOVE TABSCN SCNAME 05110CSR Z-ADDPMOHB STKQTY 70 54 05120CSRN54 Z-ADD0 STKQTY 05130CSR Z-ADDSTKQTY BOSTK 70 STOCK FOR BACKORDERS 05140CSR Z-ADDSTKQTY AVAIL OVERALL AVAIL BAL 05150CSR Z-ADDAVAIL SAVAIL 70 AVAIL STOCK BAL 05160CSR XFOOTPLT LEAD 30 05170CSR EXSR SR203 CALC COST 05180CSR PMSSTK COMP 0 54 05190CSR Z-ADD4 XTRA 05200CSR 54 1 ADD XTRA XTRA 05210CSR PMOHB COMP 0 54 LESS THAN 05220CSR 54 1 ADD XTRA XTRA 05230CSR EXSR SR69 CHECK END PAGE 05240CSR 77 05250COR 90 GOTO END102 ÐÐ05260CSR EXSR SR74 PUT PM LINE 05270CSR PMOHB COMP 0 54 54 05280CSRN54 Z-ADD630 M 96 05290CSRN54 EXSR SR73 FLAG NEG ON HAND 05300CSR 77 05310COR 90 GOTO END102 05320CSR PMSSTK COMP 0 54 05330CSRN54 GOTO END102 05340CSR Z-ADDPMSSTK REQBAL 05350CSR AVAIL SUB PMSSTK AVAIL 05360CSR Z-ADDAVAIL SAVAIL 05370CSR SETON 75 05380CSR EXCPT PUT SAFETY STOCK 05390CSR SETOF 75 05400CSR 1 ADD COUNT COUNT 05410CSR END102 ENDSR 05420C******************************************************************** 05430CSR SR103 BEGSR 05440C* CLASSIFY SFMAST RECORD. 05450CSR SETOF 101112 05460CSR SETOF 131415 05470CSR SETOF 1617 05480CSR SFREC COMP 10 01 RPO 05490CSR SFREC COMP 20 02 RWO 05500CSR SFREC COMP 30 03 PO ÐÐ05510CSR SFREC COMP 40 04 PWO 05520CSR SFREC COMP 50 05 PURREQ 05530CSR SFREC COMP 60 06 SO 05540CSR SFREC COMP 70 07 RREQ 05550CSR SFREC COMP 80 08 PREQ 05560CSR SFREC COMP 90 09 FORECAST 05570CSR 01 05580COR 02 05590COR 03 05600COR 04 05610COR 05 SETON 10 ORDER 05620CSRN10 SETON 11 REQMT 05630C* FLAG PROD REQMTS. 05640CSR 07 REL REQ 05650COR 08 SETON 13 PLN REQ 05660C* FLAG PUR ORD. 05670CSR 01 RPO 05680COR 03 PO 05690COR 05 SETON 12 PUR REQ 05700C* FLAG WO. 05710CSR 02 REL WO 05720COR 04 SETON 14 PLN WO 05730C* FLAG USES CPO FIELD. 05740CSR 02 REL WO 05750COR 12 PO'S ÐÐ05760COR 06 SETON 15 SO'S 05770C* FLAG USES PRICE FIELD. 05780CSR 15N14 SETON 16 05790C* FLAG WORK ORDER OR WO/REQMT. 05800CSR 13 REQUIREMENT 05810COR 14 SETON 17 WORK ORDER 05820CSR ENDSR 05830C******************************************************************** 05840CSR SR104 BEGSR 05850C* PUT EXCEPTION MESSAGES. 05860CSR SETOF 7790 05870CSR TODAY COMP MDUE 54 05880CSR 01 RECD PO 05890COR 04 PLAN WO 05900COR 08 PLAN REQMT 05910CORN54 GOTO T104A NOT PAST DUE 05920CSRN09 Z-ADD518 M 96 05930CSR 96 EXSR SR73 FLAG PAST DUE 05940CSR 77 05950COR 90 GOTO END104 05960CSR 09 Z-ADD520 M 96 05970CSR 09 EXSR SR73 FLAG NOT SOLD 05980CSR 77 05990COR 90 GOTO END104 06000C*------------------------------------------------------------------- ÐÐ06010CSR T104A TAG 06020CSRN04N08 GOTO T104B NOT PLAN WO OR REQMT 06030CSR 04 CURCAL COMP SFSTRT 54 06040CSR 08 CURCAL COMP SFDUE 54 06050CSRN54 GOTO T104B START DATE OK 06060CSR Z-ADD521 M 06070CSR EXSR SR73 FLAG NOT REL 06080CSR 77 06090COR 90 GOTO END104 06100C*------------------------------------------------------------------- 06110CSR T104B TAG 06120CSRN05 GOTO T104C NOT PUR REQ 06130CSR TODAY ADD LEAD W4N 40 06140CSR W4N COMP SFDUE 54 06150CSRN54 GOTO T104C LT OK 06160CSR Z-ADD522 M FLAG NOT ENOUGH 06170CSR EXSR SR73 LEAD TIME. 06180CSR 77 06190COR 90 GOTO END104 06200C*------------------------------------------------------------------- 06210CSR T104C TAG 06220CSRN05 GOTO T104D NOT PUR REQ 06230CSR TODAY SUB SFDLT DIF 40 06240CSR DIF COMP 5 54 06250CSRN54 GOTO T104D ÐÐ06260CSR 05 Z-ADD524 M FLAG NOT PLACED 06270CSR EXSR SR73 06280CSR 77 06290COR 90 GOTO END104 06300C*------------------------------------------------------------------- 06310CSR T104D TAG 06320CSRN06 GOTO END104 DONT FLAG BACKORDER 06330C* REL REQMTS ARE TEMPORARILY BYPASSED-- THEY ARE ALL CONSIDERED B/O 06340C* ---SEE CRT OUTPUT 06350CSR SFQTYC COMP 0 54 06360CSR 54 MOVE 'B' SFBOF 06370CSRN54 SFBOF COMP 'B' 54 06380CSRN54 GOTO END104 06390CSR Z-ADD565 M FLAG BACKORDER 06400CSR EXSR SR73 06410CSR 77 06420COR 90 GOTO END104 06430CSR BOSTK COMP 0 54 06440CSR 54 Z-ADD519 M 06450CSR 54 EXSR SR73 NOT ISSUED 06460CSR 77 GOTO END104 06470CSR BOSTK SUB QTYREQ BOSTK UPD BO QTY 06480CSR END104 ENDSR 06490C****************************************************************** 06500CSR SR202 BEGSR ÐÐ06510C* R. ADJUST. 06520CSR Z-ADD12 W2N 20 06530CSR EXIT SUBRAJ R. ADJUST 06540CSR RLABL W2N 06550CSR RLABL W12A 06560CSR ENDSR 06570C******************************************************************** 06580CSR SR203 BEGSR 06590C* CALC PART MAST COST, EXTEND BY ON HAND, IF ANY. 06600CSR XFOOTPM$ TOTCST 93 06610CSR PMOHB MULT TOTCST TOTCST 54 06620CSRN54 XFOOTPM$ TOTCST 06630CSR ENDSR 06640C******************************************************************** 06650CSR SR204 BEGSR 06660C* CONVERT CAL DATES TO MDAYS. 06670CSR Z-ADDSFDUE W6N 06680CSR EXSR SR205 06690CSR Z-ADDCAMDAY MDUE 40 DUE DATE 06700C* CALC LINE ITEM COST. 06710CSR ENDSR 06720C******************************************************************** 06730CSR SR205 BEGSR 06740C* GET MDAYS. 06750CSR MOVELW6N W2N ÐÐ06760CSR W2N COMP 12 54 06770CSR 54 GOTO T205A 06780CSR MOVELW6N W4N 06790CSR MOVE W6N W2N 06800CSR MOVELW2N W6N 06810CSR MOVE W4N W6N 06820C*------------------------------------------------------------------- 06830CSR T205A TAG 06840CSR MOVEL'C' W7A 7 06850CSR MOVE W6N W7A 06860CSR W7A CHAINCALENDAR 54 06870CSR ENDSR 06880C******************************************************************** 06890CSR SR206 BEGSR 06900C* PUT REMARKS. 06910CSR MOVELSFORD W9A 9 06920CSR MOVELSFREC W11A 11 06930CSR MOVE W9A W11A 06940CSR W11A LOKUPSWO 54 06950CSR 54 GOTO END206 06960CSR MOVELSFPN W16A 16 06970CSR MOVE '000000' W16A 06980CSR MOVELSFREC W13A 13 06990CSR MOVE SFORD W13A 07000CSR MOVE '00' W13A ÐÐ07010CSR MOVELW16A KEY29 29 07020CSR MOVE W13A KEY29 07030CSR KEY29 SETLLREMARKS 07040CSR MOVE BLK35 LASTRK 29 07050C*------------------------------------------------------------------- 07060CSR T206C TAG 07070CSR SETOF 54 07080CSR READ REMARKS 54 07090CSR 54 GOTO END206 07100CSR RKKEY COMP LASTRK 54 07110CSRN54 GOTO END206 07120CSR MOVE RKKEY LASTRK 07130CSR RKPN COMP SFPN 54 07140CSR 54 RKREC COMP SFREC 54 07150CSR 54 MOVELSFORD W9A 07160CSR 54 RKWO COMP W9A 54 07170CSRN54 GOTO END206 07180CSR RKSTAT COMP 'D' 54 07190CSR 54 GOTO T206C 07200CSR MOVELRKREC W11A 07210CSR MOVELRKWO W11A 07220CSR Z-ADD1 X 07230CSR W11A LOKUPSWO,X 54 07240CSR 54 GOTO T206E 07250CSR Z-ADD1 X 30 ÐÐ07260CSR BLK11 LOKUPSWO,X 54 07270CSR 54 MOVE W11A SWO,X 07280C*------------------------------------------------------------------- 07290CSR T206E TAG 07300CSR EXSR SR69 CHECK END PAGE 07310CSR SETON 85 07320CSR EXCPT PUT REMARKS 07330CSR SETOF 85 07340CSR 1 ADD COUNT COUNT 07350CSR GOTO T206C 07360CSR END206 ENDSR 07370C******************************************************************** 07380CSR SR210 BEGSR 07390C* BUILD WORK ORDER NO. 07400CSR MOVEAW12A A12 07410CSR Z-ADD1 W 07420CSR '-' LOKUPA12,W 54 07430CSRN54 Z-ADD7 W 07440CSR MOVEAA12,W W4A 4 07450CSR 54 MOVEL' ' W4A 07460CSR Z-ADD4 W2N 07470CSR EXIT SUBRAJ RJ 07480CSR RLABL W2N 07490CSR RLABL W4A 07500CSR MOVE W4A TWOD 30 WORK ORDER DASH ÐÐ07510CSR MOVEABLK12 A12,W 07520CSR A12,1 COMP '0' 54 54 07530CSR 54 MOVEAA12,1 W5A 5 07540CSR 54 MOVEL' ' TWOP 6 07550CSRN54 MOVEAA12 TWOP 07560CSRN54 MOVE TWOP W5A 07570CSR Z-ADD5 W2N 07580CSR EXIT SUBRAJ RJ 07590CSR RLABL W2N 07600CSR RLABL W5A 07610CSR MOVE W5A TWOP WORK ORDER PRIME 07620CSR MOVELTWOP TWO WORK ORDER NO. 07630CSR MOVE TWOD TWO 9 07640CSR MOVELTWOP PREFIX 1 07650CSR ENDSR 07660O******************************************************************** 07670OCRTFILE E 97 07680O PROG 26 07690O CRTIME 33 07700O CRDATE 37 07710O LNK 79 07720O******************************************************************** 07730OTERM132 E 71 07740O BIT,28 1 07750O N50 8 '8091001' ÐÐ07760O N50 BIT,1 9 07770O N50 BIT,1 10 07780O 50 10 '[001 ]001' 07790O 50 BIT,28 6 07800O 64 'I N V E N T O R Y' 07810O 78 'S T A T U S' 07820O 84 'B Y' 07830O 109 'REQUIREMENT WORK ORDER' 07840O UDATE Y 18 07850O TODAY Z 25 07860O*------------------------------------------------------------------- 07870O E 71 07880O 46 'VENDOR' 07890O*------------------------------------------------------------------- 07900O E 71 07910O 48 'CUSTOMER' 07920O 75 'COST/PRICE' 07930O 90 'QUANTITY' 07940O 100 'QUANTITY' 07950O 111 'QUANTITY' 07960O 121 'SCHEDULE' 07970O 131 'AVAILABLE' 07980O*------------------------------------------------------------------- 07990O E 71 08000O 8 'PART-NO.' ÐÐ08010O 25 'DESCRIPTION' 08020O 38 'ORDER-NO.' 08030O 60 'ASSY PART-NO,QTY-PER' 08040O 79 'REV,START-DATE' 08050O 89 'ON-HAND' 08060O 100 'ON-ORDER' 08070O 111 'REQUIRED' 08080O 119 'DATE' 08090O 130 'BALANCE' 08100O*------------------------------------------------------------------- 08110O E 74 08120O 1 ' ' 08130O*------------------------------------------------------------------- 08140O E 74 08150O PMPN 12 ' - - ' 08160O BIT,32 13 08170O PMDESC 44 08180O SCNAME 56 08190O PMECHG 70 08200O PMOSUC2 81 08210O PMOHB J 92 08220O AVAIL 2 132 08230O*------------------------------------------------------------------- 08240O E 75 08250O 26 'SAFETY STOCK' ÐÐ08260O PMSSTKJ 111 08270O AVAIL J 132 08280O*------------------------------------------------------------------ 08290O E 81 08300O 12 '...CONT''D' 08310O*------------------------------------------------------------------- 08320O E 72 08330O 01 21 'RECD-PO' 08340O 02 20 'REL-WO' 08350O 03 23 'PUR-ORDER' 08360O 04 21 'PLAN-WO' 08370O 05 23 'PURCH-REQ' 08380O 06 25 'SALES-ORDER' 08390O 07 23 'BACKORDER' 08400O 08 24 'PLAN-REQMT' 08410O 09 22 'FORECAST' 08420O N09 SFPRIM 32 08430O N09 33 '-' 08440O N09 SFDASH 36 08450O 70 37 '-' 08460O 70 SFRLOG 39 08470O N13 SFCUSTZ 45 08480O 13 SFNAPN 52 ' - - ' 08490O 17 SFREV 69 08500O 13 QPA5 Z 59 ÐÐ08510O 13 SFISSU 62 08520O 15 SFCPO 60 08530O 14 SFSTRT 79 ' - - ' 08540O 16 SFPRIC2 80 08550O 16 SFPCOD 81 08560O 01 SFDLT 69 ' - - ' 08570O QTYORDKB 101 08580O QTYREQKB 111 08590O SFDUE 121 ' - - ' 08600O AVAIL J 132 08610O*------------------------------------------------------------------- 08620O E 76 55 08630O 17 '***' 08640O 30 'TO BE ORDERED' 08650O 35 '***' 08660O*------------------------------------------------------------------- 08670O E 85 08680O RKTEXT 79 08690O*-------------------------------------------------------------- 08700O E 76 08710O* PUT PART NUMBER TOTALS 08720O AR 132 08730O 80 'TOTALS.....' 08740O PMOHB J 91 08750O ORDBALJB 101 ÐÐ08760O REQBALJB 111 08770O AVAIL J 132 08780O*------------------------------------------------------------------- 08790O E 73 08800O 17 '...' 08810O MGTEXT 54 08820O*--------------------------------------------------------------------- 08830O E 78 08840O DIV 132 08850O BIT,31 1 08860O BIT,32 132 08870O*---------------------------------------------------------------- 08880O E 82 08890O DIV 132 08900O*---------------------------------------------------------------- 08910O E 82 08920O NUL 132 08930O BIT,31 1 08940O 25 'ENTER WORK ORDER NUMBER ' 08950O 27 ' ' 08960O BIT,32 132 08970O*------------------------------------------------------------------ 08980O E 83 08990O NUL 132 09000O BIT,31 1 ÐÐ09010O 17 'END OF PAGE--- ' 09020O 41 'ENTER WORK ORDER, \-CODE' 09030O 69 ', OR PRESS RETURN: ' 09040O BIT,32 132 09050O******************************************************************** ** A12 ARRAY 009060 009070** AR ARRAY 009080 009090** TABSC/TABSCN SOURCE CODES/NAMES 009100MAMFG-ASSY 009110PAPURCH-ASSY 009120MPMFG-PART 009130PPPURCH-PART 009140RSRAW-STOCK 009150RDREF-DOCUMENT 009160** DIV ARRAY 09170 09180** NUL ARRAY 09190 09200** LNK ARRAY 09210 09220** SWO ARRAY 09230 09240/* 09250ÐÐ_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈd(Á 8RPGTAB 120282120282ùòÈàC10 C18 C28 C33 C43 C49 C54 C60 E11 E19 E27 E40 E43 E46 E52 E58 F07 F15 F19 F24 F39 F53 F60 F66 H07 H15 H21 H26 H41 H43 H48 H75 I15 I21 I28 I35 I43 I45 I49 I53 I59 I63 L15 L18 L20 L23 L25 L28 L30 L33 O14 O23 O32 O38 O41 O45 _‚_‚ Š{–„¦ÿŠ–‚–ƒ dàÈ(È(Å ÈTX114DP P999999120282(èÈÐ00010H Q114DP00020F* DISPLAY FILE NAMES IN HEX. (X114DP) 00030F* REVISED 2-24-82 3:55 PM. 00040FBITTAB IP F 33 DISK 00050FTERM74 O F 74 5 00060E******************************************************************** 00070E RG 1 152 1 00080E AR 4 4 2 00090E HEX 4 4 4 00100E NUL 1 74 1 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150C******************************************************************** 00160C START TAG 00170C* INITIALIZE 1-TIME. 00180C EXSR SR101 INIT 00190C*------------------------------------------------------------------- 00200C TAG10 TAG 00210C* GET NEXT FCB. 00220C EXSR SR103 GET FCB 00230C 72 SETON LR 00240C 72 GOTO END 00250C 72 GOTO END END FILE ÐÐ00260C EXSR SR105 CONVERT TO HEX 00270C SETON 80 00280C EXCPT DISPLAY LINE 00290C SETOF 80 00300C FILNAM COMP START 54 54 00310C N54 GOTO TAG10 00320C 1 ADD COUNT COUNT 30 00330C COUNT COMP 10 54 00340C 54 EXITFQPAUSE 00350C 54 Z-ADD0 COUNT 00360C MOVE ' ' W2A 2 00370C EXITFQSTOP CONT-D 00380C RLABL W2A 00390C W2A COMP 'XX' 54 00400C 54 GOTO START 00410C GOTO TAG10 00420C*------------------------------------------------------------------ 00430C ERROR TAG 00440C SETON 84 00450C EXCPT PUT ERROR MSG 00460C SETOF 84 00470C*------------------------------------------------------------------- 00480C END TAG 00490C******************************************************************** 00500CSR SR101 BEGSR ÐÐ00510C* INIT. 00520CSR MOVE BIT,1 NUL 00530CSR Z-ADD0 INDEX 00540CSR MOVE ' ' BLK8 8 00550CSR MOVE ' ' BLK152152 00560CSR MOVE BLK152 W12A 12 00570CSR SETON 81 00580CSR EXCPT PROMPT-START NAME 00590CSR SETOF 81 00600CSR EXITFZRED12 00610CSR RLABL W12A 00620CSR MOVELW12A START 8 00630CSR SETON 82 00640CSR EXCPT PROMPT- VOLUME 00650CSR SETOF 82 00660CSR MOVE BLK152 W12A 00670CSR EXITFZRED12 00680CSR RLABL W12A 00690CSR MOVELW12A VOLNAM 8 00700CSR SETON 69 00710CSR ENDSR 00720C******************************************************************** 00730CSR SR103 BEGSR 00740C* GET FCB. 00750CSR SETOF 72 ÐÐ00760CSR MOVE BLK152 W152A 152 00770CSR 1 ADD INDEX INDEX 60 00780CSR MOVE INDEX W6A 6 00790CSR EXITFZGFCB GET FCB 00800CSR RLABL VOLNAM 00810CSR RLABL W152A 00820CSR RLABL W6A 00830CSR MOVEAW152A RG 00840CSR MOVEARG,1 W2A 00850CSR W2A COMP 'DD' 54 00860CSR 54 GOTO SR103 DELETED FILE 00870CSR RG,117 COMP '8' 72 72 00880CSRN72 RG,117 COMP 'A' 54 54 00890CSRN72 54 RG,117 COMP 'F' 5454 00900CSRN72 54 SETON 72 00910CSR MOVEARG,3 FILNAM 8 00920CSR FILNAM COMP BLK8 54 00930CSRN54N72 GOTO SR103 BLANK 00940CSR ENDSR 00950C******************************************************************* 00960CSR SR104 BEGSR 00970C* CONVERT TO HEX CHAR 00980CSR MOVE ' ' W4A 4 00990CSR EXITFZASCHX CONVERT TO HEX 01000CSR RLABL W2A ÐÐ01010CSR RLABL W4A 01020CSR ENDSR 01030C******************************************************************* 01040CSR SR105 BEGSR 01050C* CONVERT NAMES TO HEX 01060CSR MOVEARG,3 FILNAM 8 01070CSR MOVEAFILNAM AR 01080CSR EXSR SR106 01090CSR MOVEAHEX FILHEX 32 01100CSR MOVEARG,11 OWNNAM 8 01110CSR MOVEAOWNNAM AR 01120CSR EXSR SR106 CONVERT 01130CSR MOVEAHEX OWNHEX 32 01140CSR ENDSR 01150C**************************************************************** 01160CSR SR106 BEGSR 01170CSR Z-ADD0 X 30 01180CSR Z-ADD0 H 30 01190CSR MOVE ' ' HEX 01200C*----------------------------------------------------------------- 01210CSR T106A TAG 01220CSR 1 ADD X X 01230CSR X COMP 4 54 01240CSR 54 GOTO END106 01250CSR MOVEAAR,X W2A 2 ÐÐ01260CSR EXSR SR104 01270CSR 1 ADD H H 30 01280CSR MOVEAW4A HEX,H 01290CSR GOTO T106A 01300CSR END106 ENDSR 01310O**************************************************************** 01320OTERM74 E 80 01330O FILNAM 8 01340O OWNNAM 50 01350O E 80 01360O FILHEX 32 01370O OWNHEX 74 01380O E 81 01390O NUL 74 01400O 24 'ENTER STARTING NAME. . .' 01410O E 82 01420O NUL 74 01430O 24 'ENTER VOLUME NAME. . . .' 01440O E 84 ** RG ARRAY 01450 01460** AR ARRAY 01470 01480** HEX ARRAY 01490 01500ÐÐ** NUL ARRAY 01510 01520/* 01530_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(n îX009PI PBTC”999999120282(èÈÐ00010H Q009PI00020F* P. O. ITEM - ADD, CHANGE, DELETE. (X009PI) 00030F* REVISED 4-26-83 11:45 AM. 00040FBITPAR IP F 90 DISK 00050FPOITEM UC F 384R 9AI 1 DISK A 00060FPMMST2 UC F 674R12AI 1 DISK 00070FPOMAST UC F 128R 6AI 1 DISK 00080FWMMAST IC F 470R 6AI 1 DISK 00090FPJMAST IC F 170R12AI 1 DISK 00100FGLMAST IC F 165R 9AI 1 DISK 00110FMGFILE IC F 80R DISK 00120FCRTFILE UC F 256R DISK 00130FSFMAST UC F 128R29AI 1 DISK A 00140FALTKEY UC F 32R29AI 1 DISK A 00150FCALENDARIC F 22R 7AI 1 DISK 00160FSFPNA O F 10 DISK A 00170FTERM132 O F 132 5 00180E***************************************************************** 00190E NUL 1 132 1 NULL CHAR 00200E A39 39 39 1 MGTEXT 00210E A70 70 70 1 A SR75 READ CRT BUF 00220E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00230E DUN 1 8 1 A EDIT VMPLT FLAG 00240E DOT 26 26 1 CRT OUTPUT CONSTANT 00250E RCD 1 24 7 0 RECEIVED QTYS ÐÐ00260E OPN 1 24 7 0 OPEN QTYS 00270E UP 24 24 1 UPDATE FLAGS 00280E LN 1 3 10 LOT CODE NAMES 00290E BQ 1 24 7 0A SCHED QTYS BEF UPDATE 00300E BD 1 24 6 0 SCHED DATES BEF UPDATE 00310E NAM 1 1 15 NAME ARRAY 00320E LNK 1 7 6 A 00330E BIT 33 1 SCREEN CONTR. CHAR 00340E CALL 7 6 LINK TO PROG 00350E PAR 25 1 00360E TST 25 1 00370E PLT 8 3 0 PART MAST LEAD TIMES 00380E PID 26 6 0A POITEM SCHED DATES 00390E PIQ 26 7 0A POITEM SCHED QTYS 00400I******************************************************************** 00410IBITPAR BT 00420I 1 33 BIT 00430I 34 58 PAR 00440I 59 83 TST 00450I****************************************************************** 00460ICRTFILE CR 00470I* TIME ; 00480I 28 330CRTIME 00490I* DATE 00500I 34 370CRDATE ÐÐ00510I 38 79 CALL 00520I* TRAN CODE - PO MAST 00530I 81 81 CRPOTR 00540I* ORDER NO. 6A 00550I 82 87 CRPO 00560I* ITEM # 3N 00570I 88 900CRITEM 00580I* VENDOR NAME 35A 00590I 91 125 CRVNAM 00600I***************************************************************** 00610IWMMAST WM 00620I* DATE CLOSED 6N 00630I 411 4160WMCLOS 00640I* QTY REL 7P 00650I P 417 4200WMQREL 00660I* RECORD STATUS 1A 00670I 470 470 WMSTAT 00680I***************************************************************** 00690IPJMAST PJ 00700I 30 69 PJNAME 00710I 170 170 PJSTAT 00720I****************************************************************** 00730IGLMAST GL 00740I 18 57 PJNAME 00750I 165 165 GLSTAT ÐÐ00760I****************************************************************** 00770IPMMST2 PM 00780I* PART NUMBER 10N 00790I 1 100PMPN 00800I* PART DESCRIPTION 29A 00810I 31 59 PMDESC 00820I* ENG CHANGE LEVEL 2A 00830I 70 71 PMECHG 00840I* SOURCE CODE 2A 00850I 94 95 PMSC 00860I* LEAD TIMES 3P X 8 00870I P 113 128 PLT 00880I* ON-HAND BALANCE 7P 00890I P 311 3140PMOHB 00900I* P.O. BAL 7P 00910I P 343 3460PMPOB 00920I* UNIT COST - MFG 9.3P 00930I P 615 6193PMTCST 00940I* RECORD STATUS 1A 00950I 674 674 PMSTAT 00960I******************************************************************** 00970IMGFILE MG 00980I 1 35 MGTEXT 00990I******************************************************************** 01000ICALENDARCA ÐÐ01010I* CALENDAR DATE RECORD. 01020I 2 70CACAL 01030I******************************************************************** 01040IPOMAST PO 01050I* PURCHASE ORDER MASTER RECORD. 01060I* P.O. # 6A (KEY) 01070I 1 6 POPO 01080I* VENDOR # 5N 01090I 7 110POVEND 01100I* DELIVER TO 12A 01110I 12 23 POBY 01120I* ORDER TYPE 1A 01130I* Y = CONFIRMATION 01140I 24 24 POTYPE 01150I* WORK ORDER/ACCOUNT 9A 01160I 27 35 POWO 01170I* FILLER 36 41 FFFFFF 01180I* INSPECTION CODE 3A 01190I 42 44 POINSP 01200I* ORDER DATE 6N 01210I 45 500PODORD 01220I* SHIP VIA 10A 01230I 51 60 POVIA 01240I* ORDER ATTENTION OF 10A 01250I 61 70 POATT ÐÐ01260I* TERMS 8A 01270I 71 78 POTERM 01280I* FOB 1A 01290I 79 79 POFOB 01300I* RESALE 1A 01310I 80 80 PORSAL 01320I* CONTRACT NO. 12A 01330I 81 92 POCNTR 01340I* PRIORITY 15A 01350I 93 107 POPRTY 01360I* CONFIRMATION REQD 1A 01370I 108 108 POCONF 01380I* DATE CLOSED 6N 01390I 109 1140PODCLS 01400I* BUYER CODE 2A 01410I 115 116 POBUYR 01420I* CERTS REQD (Y,N) 1A 01430I 117 117 POCERT 01440I* LAST ITEM NO. USED 3P 01450I P 118 1190POLITM 01460I* RECORD STATUS 1A 01470I 128 128 POSTAT 01480I******************************************************************** 01490IPOITEM PI 01500I* PURCHASE ORDER ITEM RECORD. ÐÐ01510I* KEY AREA. 01520I* PO # 6N 01530I 1 60PIPO 01540I* PO ITEM 3N 01550I* * * * * * 7 90PIITEM 01560I* DYNAIR PART # 10N 01570I 10 190PIPN 01580I* VENDOR PART # 15A 01590I 20 34 PIVPN 01600I* DESCRIPTION 29A 01610I 35 63 PIDESC 01620I* NON-INVENTORY DESCRIPTION 70A 01630I 10 79 PINDES 01640I* DATE LAST RECEIPT 6N 01650I 80 850PIDLR 01660I* QTY RECEIVED 7P 01670I P 86 890PIQRCD 01680I* QTY TO STK,SCRAP,RTV 7P 01690I P 90 930PIQSTK 01700I* PRICE CODE 1A 01710I* L = LOT 01720I* N = NO CHARGE 01730I 94 94 PILOT 01740I* PRICE 9.3P 01750I P 95 993PI$PRC ÐÐ01760I* WORK ORDER # 9A 01770I 100 108 PIWO 01780I 100 105 PIWOP 01790I 106 1080PIWOD 01800I* VENDOR # 5P (FROM POMAST) 01810I P 109 1110PIVEND 01820I* LAST RCVG LOG # USED 2N 01830I 112 1130PILLOG 01840I* SCHEDULE DATES 6N X 26 (Y,M,D) 01850I 114 269 PID 01860I* SCHED QTYS 7P X 26 01870I P 270 373 PIQ 01880I* BACKORDERS SUPPLIED BY P/O 01890I P 374 3770PIABOQ 01900I* DATE ENTERED 4N (MM/DD) 01910I 378 3810PIDATE 01920I* RECORD STATUS 1A 01930I 384 384 PISTAT 01940I********************************************************************* 01950ISFMAST SF 01960I 128 128 SFSTAT 01970I********************************************************************* 01980IALTKEY AK 01990I 32 32 AKSTAT 02000C******************************************************************** ÐÐ02010C* INITIALIZE 02020C EXSR SR101 1-TIME INIT 02030C MOVE ' ' BLK6 6 STUPIDITY 02040C*------------------------------------------------------------------ 02050C START TAG 02060C* SET-UP 1ST FIELD NO. 02070C SETOF 603140 02080C SETOF 70 02090C Z-ADD0 TITEM 02100C MOVE ' ' DUN INIT EDIT ARRAY 02110C Z-ADD1 F 30 FIELD # 02120C EXSR SR205 INIT ITEM FIELDS 02130C EXSR SR70 NEW PAGE 02140C EXSR SR71 PUT HEADING 02150C GOTO READ 02160C*------------------------------------------------------------------ 02170C NEXT TAG 02180C* SET-UP NEXT FIELD NO. 02190C 1 ADD F F FIELD # 02200C*----------------------------------------------------------------- 02210C READ TAG 02220C* PROCESS CURRENT DATA FIELD. 02230C SETOF 909677 02240C SETOF 40 02250C* DO AUTO-DEFAULTS ON ILLEGAL FIELD #S. ÐÐ02260C EXSR SR203 CLASSIFY TRAN 02270C EXSR SR102 VALIDATE FIELD # 02280C 55 GOTO SCHED DONE 02290C* BRANCH ON TEXT OR LIST TRAN. 02300C EXSR SR201 IDENTIFY-F 02310C EXSR SR203 CLASSIFY TRAN 02320C 03 02330COR 04 70 61 GOTO EDIT 02340C F COMP 3 55 54 02350C 65 54 GOTO LINK2 LIST TRAN 02360C 62 55 GOTO SCHED DELETE TRAN 02370C* READ TERMINAL 02380C SETON 69 02390C EXSR SR72 PROMPT 02400C SETOF 69 02410C EXSR SR75 READ TERMINAL 02420C EXSR SR67 INIT A39 ARRAY 02430C 90 EXSR SR72 PUT DATA ON ESC 02440C*------------------------------------------------------------------- 02450C ESCAPE TAG 02460C* BRANCH ON ESCAPE CODE INPUT 02470C 92 GOTO JUMP FIELD JUMP REQST 02480C 91 F SUB 1 F SKIP BACKWARD 02490C 91 EXSR SR201 02500C 91N70 04 ÐÐ02510COR 91N60 04 02520COR 91N70 05 Z-ADD3 F 02530C 91 GOTO READ " " 02540C 95 SETOF 90 SPACE FILL 02550C 95 SETON 77 " " 02560C 88 GOTO SCHED UPDATE 02570C 96 EXSR SR89 GET MGFILE 02580C 96 GOTO READ ERROR 02590C 99 GOTO LINK TEXT OR LIST 02600C N77 GOTO EDIT NO DATA INPUT 02610C*------------------------------------------------------------------ 02620C PROCES TAG 02630C* PROCESS INPUT DATA 02640C EXSR SR103 MOVE DATA 02650C*------------------------------------------------------------------- 02660C EDIT TAG 02670C EXSR SR104 EDIT DATA 02680C N96 EXSR SR72 REWRITE DATA 02690C 96 EXSR SR89 GET MGFILE 02700C 96 GOTO READ ERROR 02710C EXSR SR203 CLASSIFY TRAN 02720C 62 03 GOTO SCHED DELETE 02730C 63 02 GOTO LINK2 TEXT 02740C 64N01 GOTO SCHED SCHED 02750C 65 02 GOTO LINK2 LIST ÐÐ02760C GOTO NEXT 02770C*------------------------------------------------------------------- 02780C SCHED TAG 02790C* UPDATE SCHEDULE. 02800C SETOF 9096 02810C Z-ADD20 F 02820C EXSR SR201 SETOFF 01-08 02830C Z-ADD1 F 02840C EXSR SR250 SCHED UPDATE 02850C 91 SKIP BACK 02860COR 92 JUMP 02870COR 99 GOTO ESCAPE LIST,TEXT 02880C 90 GOTO UPDATE OTHER ESCAPE 02890C 96 GOTO ERROR 02900C GOTO UPDATE 02910C*------------------------------------------------------------------ 02920C UPDATE TAG 02930C* UPDATE DATA BASE. 02940C EXSR SR105 FINAL EDIT 02950C 96 GOTO ERROR ERROR 02960C EXSR SR106 UPDATE 02970C 96 GOTO ERROR ERROR 02980C EXSR SR300 UPDATE SFMAST 02990C SETON 48 03000C EXCPT NOW WHADAYAWANNADO ÐÐ03010C SETOF 48 03020C SETON 44 03030C EXSR SR75 03040C SETOF 44 03050C 99 GOTO LINK 03060C GOTO START 03070C*------------------------------------------------------------------- 03080C JUMP TAG 03090C* SET-UP JUMP TO REQUESTED FIELD 03100C 1 ADD W W 30 03110C W COMP 70 54 03120C 54 Z-ADD318 M 50 96 FLAG ERROR 03130C 54 GOTO ERROR BAD ESC 03140C MOVE ' ' W3A 3 03150C MOVEAA70,W W3A 03160C Z-ADD3 W2N 20 03170C EXIT SUBRAJ R. JUSTIFY 03180C RLABL W2N 03190C RLABL W3A 03200C MOVE W3A F NEW FIELD # 03210C GOTO READ 03220C*-------------------------------------------------------------------- 03230C ERROR TAG 03240C EXSR SR102 VALIDATE FIELD # 03250C EXSR SR89 GET MSG ÐÐ03260C GOTO READ 03270C*--------------------------------------------------------------- 03280C LINK TAG 03290C* LINK TO PRODUCT MENU OR TO TEXT UPDATE 03300C A70,W COMP 'T' 63 TEXT UPDATE 03310C A70,W COMP 'L' 65 LIST REQUEST 03320C*------------------------------------------------------------------ 03330C LINK2 TAG 03340C 63 MOVEL'Q003PX' PROG TEXT UPDATE 03350C 65 MOVEL'Q010PO' PROG LIST TRAN 03360C EXSR SR99 <<>> 03370C*------------------------------------------------------------------ 03380C NEWITM TAG 03390C* SET-UP LINK FOR NEW ITEM 03400C MOVEL'Q009PI' PROG 8 03410C GOTO END 03420C*------------------------------------------------------------------- 03430C MENU TAG 03440C* SET-UP LINK TO MENU 03450C EXSR SR96 GET CRTFILE 03460C Z-ADD1 W 03470C BLK6 LOKUPLNK,W 54 03480C 54 MOVELLNK,W PROG 8 03490C 54 MOVE BLK6 LNK,W 03500C N54 MOVEL'CONTU 'PROG ÐÐ03510C EXSR SR97 REWRITE CRTFILE 03520C EXSR SR98 >>>>>>>>>>>>>>>>> 03530C*-------------------------------------------------------------------- 03540C END TAG 03550C EXSR SR96 GET CRTFILE 03560C EXSR SR97 REWRITE CRTFILE 03570C EXSR SR98 >>>>>>>>>>>>>>>>> 03580C*------------------------------------------------------------------- 03590C GOODBY TAG 03600C* LINK TO SIGN-OFF 03610C MOVEL'GOODBY' PROG 03620C EXSR SR98 <<>> 03630C*------------------------------------------------------------------- 03640C ENDJOB TAG 03650C MOVEL'ENDJOB' PROG 03660C EXSR SR98 >>>>>>>>>> 03670C******************************************************************** 03680CSR SR1 BEGSR 03690C* EDIT TRAN CODE 03700CSR TRAN COMP ' ' 54 03710CSR CRPOTR COMP 'I' 55 03720CSR 54N55 MOVE CRPOTR TRAN 03730CSR EXSR SR203 CLASSIFY TRAN 03740CSRN63N65N64 03750CANN60N61N62 Z-ADD300 M 50 96 FLAG ERROR ÐÐ03760CSR ENDSR 03770C******************************************************************* 03780CSR SR2 BEGSR 03790C* EDIT ITEM # 03800CSR TITEM COMP 0 54 03810CSRN54 EXSR SR203 CLASSIFY TRAN 03820CSRN54 60 POLITM ADD 1 POLITM 03830CSRN54 60 Z-ADDPOLITM TITEM DEFAULT 03840CSR TITEM COMP 0 54 03850CSRN54 Z-ADD47 M 96 FLAG ERROR 03860CSRN54 GOTO END2 03870CSR TITEM COMP POLITM 54 03880CSR 54 Z-ADDTITEM POLITM 03890CSR MOVELCRPO W9A 9 03900CSR MOVE TITEM W9A 03910CSR EXSR SR205 INIT POITEM 03920CSR EXSR SR80 GET POITEM 03930CSR 30 NOT ON FILE 03940COR 31 GOTO T2B DELETED 03950C* ITEM IS ON FILE. 03960CSR SETON 49 03970CSR EXSR SR3 EDIT WO # 03980CSR MOVE ' ' DUN,3 03990CSRN96 MOVE 'X' DUN,3 04000CSR EXSR SR4 EDIT PART NO. ÐÐ04010CSR MOVE ' ' DUN,4 04020CSRN96 MOVE 'X' DUN,4 04030CSR EXSR SR203 CLASSIFY TRAN 04040CSR 60 Z-ADD0 TITEM 04050CSR 60 Z-ADD301 M 96 FLAG ERROR 04060CSR PIQRCD SUB PIQSTK W7N 70 54 04070CSR 62 54 70 Z-ADD29 M 96 FLAG ERROR 04080CSR EXSR SR7 EDIT LOT CODE 04090CSR EXSR SR204 CLASSIFY WORK ORDER 04100CSR EXSR SR252 CALC RECEIPTS 04110CSR EXSR SR71 PUT SCREEN 04120CSR EXSR SR253 DISPLAY SCHED 04130CSR GOTO END2 04140C*--------------------------------------------------------------------- 04150CSR T2B TAG 04160C* ITEM NOT ON FILE. 04170CSR EXSR SR205 INIT POITEM 04180CSR EXSR SR203 CLASSIFY TRAN 04190CSRN60 Z-ADD5 M 96 FLAG NOT ON FILE 04200C*---------------------------------------------------------------------- 04210CSR END2 TAG 04220CSR SETOF 49 04230CSR ENDSR 04240C******************************************************************** 04250CSR SR3 BEGSR ÐÐ04260C* EDIT WORK ORDER. 04270C* FLAG ERROR IF ACCOUNT NO. BEING CHANGED AFTER RECEIVED PO ON FILE. 04280CSR EXSR SR204 CLASSIFY ACCOUNT 04290CSR 70 EXSR SR203 CLASSIFY TRAN 04300CSRN61 04310CORN70 04320COR 30 04330COR 31 GOTO T3 04340C* 04350CSR PIWO COMP SAVWO 5454 04360CSR 54 PIQRCD COMP PIQSTK 54 04370CSR 54 61N49 Z-ADD692 M 96 FLAG ERROR 04380CSR 96 GOTO END3 04390C*------------------------------------------------------------------- 04400CSR T3 TAG 04410CSR MOVE BLK70 PJNAME 04420CSR PIWOP COMP ' 00000' 54 04430CSRN54 MOVE POWO PIWO DEFAULT 04440CSRN54 MOVELPOWO PIWOP 04450CSRN54 MOVE POWO PIWOD 04460CSR PIWOP COMP ' 00000' 54 04470CSRN54 MOVE ' 14100' PIWOP DEFAULT 04480CSRN54 Z-ADD0 PIWOD 04490CSR MOVELPIWOP PIWO 04500CSR MOVE PIWOD PIWO ÐÐ04510CSR EXSR SR204 CLASSIFY ACCOUNT 04520CSR 70 GOTO T3B INVENTORY ACCOUNT 04530CSR PIWOP CHAINWMMAST 54 GET PROD WORK ORDER 04540CSR 54 GOTO T3A NO HIT 04550CSR MOVELNAM,1 PJNAME 04560CSR WMSTAT COMP 'D' 54 04570CSR WMQREL COMP 0 54 04580CSR WMCLOS COMP 0 56 04590C*R 56 ********** CLOSED 04600C*R 54 ********** DELETED 04610C*RN55 ********** Z-ADD506 M 96 NOT RELEASED 04620CSR GOTO END3 04630C*----------------------------------------------------------------- 04640CSR T3A TAG 04650CSR MOVELPIWO W12A 12 04660CSR MOVE '620' W12A 04670CSR W12A CHAINPJMAST 54 GET PROJECT MASTER 04680CSR 54 GOTO T3B NO HIT 04690CSR PJSTAT COMP 'D' 54 04700C*R 54 ********** Z-ADD506 M 96 DELETED 04710CSR GOTO END3 04720C*---------------------------------------------------------------- 04730CSR T3B TAG 04740CSR PIWO CHAINGLMAST 54 GET ACCOUNT MASTER 04750CSRN54 GLSTAT COMP 'D' 54 FLAG DELETE ÐÐ04760C*R 54 ********** Z-ADD506 M 96 FLAG ERROR 04770CSR END3 ENDSR 04780C***************************************************************** 04790CSR SR4 BEGSR 04800C* EDIT PART NUMBER 04810CSR EXSR SR204 CLASSIFY WORK ORDER 04820CSRN70 GOTO END4 NOT INVENTORY ITEM 04830CSR PIPN COMP 0 54 04840CSRN54N49 Z-ADD299 M 96 FLAG ERROR 04850CSRN54 GOTO END4 04860CSR MOVELPIPN W12A 12 04870CSR EXSR SR83 GET PART MAST 04880CSR 60N49 Z-ADD291 M 96 FLAG ERROR 04890CSR 60 GOTO END4 04900CSR PIDESC COMP BLK29 54 04910CSRN54 MOVELPMDESC PIDESC 04920CSR END4 ENDSR 04930C******************************************************************** 04940CSR SR7 BEGSR 04950C* EDIT LOT CODE 04960CSR PILOT COMP 'L' 50 04970CSR PILOT COMP 'N' 51 04980CSR MOVE BLK35 LOTNAM 10 04990CSR 50 MOVE LN,1 LOTNAM LOT CHARGE 05000CSR 51 MOVE LN,2 LOTNAM NO CHARGE ÐÐ05010CSRN50N51 MOVE LN,3 LOTNAM UNIT PRICE 05020CSRN50N51 MOVE 'U' PILOT 05030CSR ENDSR 05040C******************************************************************** 05050CSR SR8 BEGSR 05060C* EDIT UNIT/LOT PRICE $ 05070CSR 51 GOTO T8B NO CHARGE 05080CSR 50 GOTO T8D LOT CHARGE 05090CSR GOTO T8H NET PRICE 05100C*--------------------------------------------------------------- 05110CSR T8B TAG 05120C* NO CHARGE 05130CSR Z-ADD0 PI$PRC NO CHARGE 05140CSR GOTO END8 05150C*--------------------------------------------------------------- 05160CSR T8D TAG 05170C* LOT CHARGE 05180CSR PI$PRC COMP 0 54 05190CSRN54 Z-ADD262 M 96 FLAG ERROR 05200CSR GOTO END8 05210C*---------------------------------------------------------------- 05220CSR T8H TAG 05230C* INPUT PRICE. 05240CSR PI$PRC COMP 0 55 05250CSRN55 Z-ADD262 M 96 FLAG ERROR ÐÐ05260CSR END8 ENDSR 05270C*************************************************************** 05280CSR SR66 BEGSR 05290C* SETUP BLINK/STOP-BLINK CODES IN A39 MSG ARRAN 05300CSR EXSR SR67 INIT A39 05310CSR MOVE BIT,28 A39,1 05320CSR MOVE 'D' A39,2 05330CSR MOVE BIT,28 A39,38 05340CSR MOVE 'E' A39,39 05350CSR ENDSR 05360C*************************************************************** 05370CSR SR67 BEGSR 05380CSR MOVEABLK35 A39,3 05390CSR ENDSR 05400C****************************************************************** 05410CSR SR68 BEGSR 05420C* LINE FEED 05430CSR EXITFQCLF LF 05440CSR ENDSR 05450C***************************************************************** 05460CSR SR69 BEGSR 05470C* POSITION CURSOR 05480CSR 39 EXITFZPUTXY 05490CSR RLABL RPGLIN 05500CSR RLABL RPGCOL ÐÐ05510CSRN39 EXITFZMOVXY POSITION CURSOR 05520CSR RLABL RPGLIN 05530CSR RLABL RPGCOL 05540CSR ENDSR 05550C******************************************************************** 05560CSR SR70 BEGSR 05570C* CLEAR NEW PAGE. 05580CSRN39 EXITFZCPAGE CLEAR PAGE-4 05590CSR 39 EXITFZISTAT 05600CSR 39 EXITFZESCH 05610CSR ENDSR 05620C********************************************************************** 05630CSR SR71 BEGSR 05640C* PUT HEADINGS TO TERMINAL 05650CSR PIWOD COMP 0 55 05660CSR SETON 7146 05670CSR EXCPT PUT HEADINGS 05680CSR SETOF 7146 05690CSR EXSR SR66 SETUP A39 ARRAY 05700CSR ENDSR 05710C********************************************************************* 05720CSR SR72 BEGSR 05730C* PUT DATA TO TERMINAL 05740CSR PIWOD COMP 0 55 05750CSR 39 1 ADD F W3N ÐÐ05760CSRN39 91 ADD F W3N 30 05770CSR W3N SUB 1 W3N 05780CSR MOVELW3N RPGLIN 4 05790CSR MOVEL'001' RPGCOL 4 05800CSR EXSR SR69 POSITION CURSOR 05810CSR SETON 72 05820CSR EXCPT PUT DATA 05830CSR SETOF 72 05840CSR ENDSR 05850C*********************************************************************** 05860CSR SR73 BEGSR 05870C* PUT ERROR MESSAGE TO TERMINAL 05880CSRN41 39 1 ADD F W3N 05890CSRN41N39 91 ADD F W3N 05900CSRN41 MOVE W3N LOC 3 05910CSR SETON 73 05920CSR EXCPT PUT MSG 05930CSR SETOF 73 05940CSR ENDSR 05950C******************************************************************** 05960CSR SR74 BEGSR 05970C* PUT WARNING MESSAGE 05980CSR EXSR SR89 GET MESSAGE 05990CSR EXSR SR73 PUT MESSAGE 06000CSR ENDSR ÐÐ06010C******************************************************************* 06020CSR SR75 BEGSR 06030C* READ FROM TERMINAL 06040CSR SETOF 779096 06050CSR SETOF 9291 06060CSR SETOF 8887 06070CSR SETOF 9995 06080CSR MOVE BLK70 W70A 70 BUFFER 06090CSR 04N70 06100COR 05N70 GOTO END75 06110CSR 44 06120COR 41 Z-ADD102 W3N 30 06130CSRN41N44 F ADD 91 W3N 30 06140CSR 39 W3N SUB 90 W3N 06150CSR MOVELW3N RPGLIN 4 06160CSRN41N44 MOVEL'029' RPGCOL 06170CSR 41 MOVEL'025' RPGCOL 06180CSR 44 MOVEL'050' RPGCOL 06190CSR EXSR SR69 POSITION CURSOR 06200CSR EXITFZR70 READ FROM TERMINAL 06210CSR RLABL W70A READ BUFFER 06220CSR MOVEAW70A A70 INPUT DATA ARRAY 06230CSR MOVE BLK70 W70A INIT INPUT ARRAY 06240CSR Z-ADD1 W 30 06250CSR '\' LOKUPA70,W 90 FLAG ESC ÐÐ06260CSRN90 GOTO T75B NOT ESC 06270CSR 1 ADD W W 06280CSR W COMP 70 54 06290CSR 54 GOTO T75A BAD ESC 06300CSR A70,W COMP 'G' 98 GOODBY 06310CSR A70,W COMP 'E' 94 MENU 06320CSR A70,W COMP 'N' 93 NEW ITEM 06330CSR A70,W COMP 'J' 92 JUMP 06340CSR A70,W COMP 'B' 91 SKIP BKWRD 06350CSR A70,W COMP 'S' 95 SPACE FILL 06360CSR A70,W COMP 'D' 87 DONE 06370CSR A70,W COMP 'U' 88 UPDATE 06380CSR A70,W COMP 'T' 99 TEXT REQUEST 06390CSRN99 A70,W COMP 'L' 99 LIST REQUEST 06400CSR 99N41 06410COR 92 06420COR 91N41 06430COR 95N41 06440COR 87 41 06450COR 88 GOTO END75 GOOD ESC 06460CSR 98 GOTO GOODBY <<>> 06470CSR 93 GOTO NEWITM <<>> 06480CSR 94 GOTO MENU <<>> 06490CSR MOVEAA70,W W2A 2 06500CSR W2A COMP 'IS' 54 ÐÐ06510CSR 54 MOVE 'Q102SF 'PROG 8 06511CSR 54 EXITFCHAIN >>>>>>>>>>>>>> 06512CSR RLABL PROG 06520C*------------------------------------------------------------------ 06530CSR T75A TAG 06540C* FLAG BAD ESC INPUT 06550CSR Z-ADD318 M 96 FLAG ERROR 06560CSR EXSR SR89 GET MSG 06570CSR EXSR SR73 PUT MSG 06580CSR GOTO SR75 06590C*-------------------------------------------------------------------- 06600CSR T75B TAG 06610C* MOVE DATA 06620CSR Z-ADD1 W 06630CSR ' ' LOKUPA70,W 77 06640CSR 77 MOVEAA70,W W70A INPUT DATA 06650CSR GOTO END75 06660C*----------------------------------------------------------------- 06670CSR END75 TAG 06680CSR EXSR SR67 INIT A39 ARRAY 06690CSR 41N89 EXSR SR73 INIT PREV ERR MSG 06700CSR ENDSR 06710C*************************************************************** 06720CSR SR76 BEGSR 06730C* PUT SCHEDULE DATA TO CRT (SEE SR250,253). ÐÐ06740CSR A ADD 104 W3N 30 06750CSR 39 W3N SUB 90 W3N 06760CSR MOVELW3N RPGLIN 06770CSR MOVEL'001' RPGCOL 06780CSR UP,A COMP ' ' 42 06790CSR UP,B COMP ' ' 43 06800CSR UP,C COMP ' ' 38 06810CSR EXSR SR69 PUT CURSOR 06820CSR A COMP 8 55 LAST BUCKET 06830CSR SETON 76 06840CSRN55 EXCPT PUT SCHED DATA 06850CSR SETOF 76 06860CSR ENDSR 06870C**************************************************************** 06880CSR SR79 BEGSR 06890C* GET PURCH ORDER MASTER. 06900CSR CRPO CHAINPOMAST H8 GET POMAST 06910CSRN60 POSTAT COMP 'D' H8 06920CSR H8 GOTO ENDJOB 06930CSR ENDSR 06940C********************************************************************** 06950CSR SR80 BEGSR 06960C* GET PURCH ITEM MASTER 06970CSR SETOF 3170 06980CSR MOVE BLK35 SAVWO ÐÐ06990CSR W9A CHAINPOITEM 30 GET POITEM 07000CSRN30 PISTAT COMP 'D' 31 FLAG DELETE 07010CSR Z-ADD0 BEGPOB 70 BEGIN PO QTY TOTAL 07020CSR 30 07030COR 31 GOTO END80 07040CSR MOVE PIWO SAVWO 9 07050CSR EXSR SR204 CLASSIFY ACCOUNT 07060CSR XFOOTPIQ BEGPOB 07070CSR BEGPOB SUB PIQRCD BEGPOB 54 07080CSRN54 Z-ADD0 BEGPOB 07090CSR END80 ENDSR 07100C********************************************************************** 07110CSR SR81 BEGSR 07120C* ADD NEW PURCH ITEM MASTER 07130CSR MOVELUDATE W4N 40 07140CSR SETON 81 07150CSR EXCPT ADD POITEM 07160CSR SETOF 813031 07170CSR Z-ADD0 W4N 07180CSR ENDSR 07190C*********************************************************************** 07200CSR SR82 BEGSR 07210C* REWRITE PURCH ITEM MASTER 07220CSR SETON 82 07230CSR EXCPT REWRITE POITEM ÐÐ07240CSR SETOF 823031 07250CSR ENDSR 07260C*************************************************************** 07270CSR SR83 BEGSR 07280C* GET PART MASTER 07290CSR MOVE ' ' W12A 07300CSR W12A CHAINPMMST2 60 GET PMMST2 07310CSRN60 PMSTAT COMP 'D' 60 FLAG DELETE 07320CSR ENDSR 07330C*************************************************************** 07340CSR SR84 BEGSR 07350C* GET CALENDAR 07360CSR W7A CHAINCALENDAR 60 GET CALENDAR 07370CSR ENDSR 07380C****************************************************************** 07390CSR SR85 BEGSR 07400C* UPDATE PART MASTER 07410CSR PMPOB SUB BEGPOB PMPOB 07420CSR XFOOTPIQ W7N 70 07430CSR W7N SUB PIQRCD W7N 54 07440CSRN54 Z-ADD0 W7N 07450CSR W7N ADD PMPOB PMPOB ENDING PO QTY TOTAL 07460CSR SETON 85 07470CSR EXCPT UPDATE PMMST2 07480CSR SETOF 85 ÐÐ07490CSR ENDSR 07500C***************************************************************** 07510CSR SR86 BEGSR 07520C* UPDATE PO MASTER 07530CSR SETON 86 07540CSR EXCPT UPDATE POMAST 07550CSR SETOF 86 07560CSR ENDSR 07570C***************************************************************** 07580CSR SR89 BEGSR 07590C* GET MESSAGE MASTER 07600CSR M CHAINMGFILE 54 07610CSR 54 MOVE BLK35 MGTEXT 07620CSR 54 MOVELM MGTEXT 07630CSR MOVEAMGTEXT A39,3 07640CSR ENDSR 07650C********************************************************************** 07660CSR SR96 BEGSR 07670CSR # CHAINCRTFILE H9 07680CSR H9 GOTO ENDJOB 07690CSR ENDSR 07700C****************************************************************** 07710CSR SR97 BEGSR 07720C* UPDATE CRTFILE. 07730CSR PROG COMP 'Q003PX ' 55 ÐÐ07740CSR TIME CRTIME 07750CSR MOVELUDATE CRDATE 07760CSR SETON 97 07770CSR EXCPT REWRITE CRTFILE 07780CSR SETOF 97 07790CSR ENDSR 07800C*************************************************************** 07810CSR SR98 BEGSR 07820CSR EXSR SR70 CLEAR SCREEN 07830CSR EXITFCHAIN >>>>>>>>>>>>>>>>>> 07840CSR RLABL PROG 07850CSR ENDSR 07860C**************************************************************** 07870CSR SR99 BEGSR 07880C* SETUP THIS PROG AS RETURN-TO PROG 07890CSR EXSR SR96 GET CRTFILE 07900CSR Z-ADD8 W 07910C*---------------------------------------------------------------- 07920CSR T99A TAG 07930CSR W SUB 1 W 54 07940CSRN54 GOTO ENDJOB 07950CSR LNK,W COMP ' ' 54 07960CSRN54 GOTO T99A 07970CSR MOVE 'Q009PI' LNK,W 07980C*---------------------------------------------------------------------- ÐÐ07990CSR END99 TAG 08000CSR EXSR SR97 UPDATE CRTFILE 08010CSR EXSR SR98 >>>>>>>>>>>>>>>>>> 08020CSR ENDSR 08030C************************************************************************ 08040CSR SR101 BEGSR 08050C* 1-TIME INITIALIZE 08060CSR MOVE BIT,1 NUL 08070CSR EXSR SR66 SETUP A39 MSG ARRAY 08080CSR Z-ADD8 FLIMIT 30 TOTAL NUMB FIELDS 08090CSR MOVE ' ' BLK70 70 08100CSR MOVE ' ' BLK29 29 08110C* GET PORT # AND CRTFILE 08120CSR MOVE ' ' W2A 2 08130CSR EXITFZGMINX GET PORT # 08140CSR RLABL W2A 08150CSR MOVE W2A # 20 PORT NO. 08160CSR # COMP 0 54 08170CSRN54 Z-ADD25 # DEFAULT 08180CSR EXSR SR96 GET CRTFILE 08190CSR MOVE CALL LNK 08200CSR MOVE 'Q009PI 'PROG 08210CSR H9 GOTO ENDJOB PROG ERROR 08220CSR PAR,# COMP '1' 39 08230CSR TST,# COMP 'S' 56 ÐÐ08240CSR 56 MOVE 'SHUTDOWN'PROG 08250CSR EXSR SR97 REWRITE CRTFILE 08260CSR 56 EXSR SR98 >>>>>>>>>>>>>>>>> 08270CSR MOVE ' 'PROG 08280CSR EXSR SR1 CLASSIFY TRAN CODE 08290CSR SETOF 96 08300CSR EXSR SR79 GET PURCH ORDER MAST 08310C* DEFINE WORK FIELDS,ETC. 08320CSR MOVE ' ' BLK8 8 08330CSR MOVE ' ' BLK35 35 08340CSR Z-ADDUDATE W6N 08350CSR EXSR SR207 REVERSE DATE 08360CSR Z-ADDW6N TODAY 60 CUR DATE(YR,MO,DAY) 08370CSR Z-ADD0 ZERO7 70 08380CSR Z-ADD0 ZERO6 60 08390CSR END101 ENDSR 08400C********************************************************************** 08410CSR SR102 BEGSR 08420C* VALIDATE FIELD NO. 08430CSR F COMP 0 54 08440CSRN54 Z-ADD1 F 08450CSR F COMP FLIMIT 55 08460CSR 55 Z-ADD1 F 08470CSR ENDSR 08480C******************************************************************** ÐÐ08490CSR SR103 BEGSR 08500C* MOVE INPUT DATA 08510CSR EXSR SR201 IDENTIFY-F 08520CSR EXSR SR202 R. JUSTIFY 08530CSR 02 Z-ADD0 PIQ INIT POITEM ARRAYS 08540CSR 02 Z-ADD0 PID 08550CSR 02 Z-ADD0 RCD 08560CSR 02 Z-ADD0 OPN 08570CSR 01 MOVELW70A TRAN 1 TRAN CODE 08580CSR 02 MOVE W15A TITEM 30 PO ITEM # 08590CSR 03N95 EXSR SR212 BUILD ORD/ACNT 08600CSR 03 95 MOVELBLK6 PIWOP 08610CSR 03 95 Z-ADD0 PIWOD 08620CSR 03 MOVELPIWOP PIWO 08630CSR 03 MOVE PIWOD PIWO 08640CSR 04 70 MOVE W15A PIPN PART # 08650CSR 05 70 MOVELW70A PIVPN VENDOR PART # 08660CSR 06 70 MOVELW70A PIDESC DESCRIPTION 08670CSR 06N70 MOVELW70A PINDES NON-INV DESC 08680CSR 07 MOVELW70A PILOT LOT CODE 08690CSR 08 MOVE W15A PI$PRC COST 08700CSR MOVE ' ' DUN,F 08710CSR ENDSR 08720C******************************************************************** 08730CSR SR104 BEGSR ÐÐ08740C* EDIT INPUT DATA 08750CSR 01 EXSR SR1 08760CSR 02 EXSR SR2 08770CSR 03 EXSR SR3 08780CSR EXSR SR203 CLASSIFY TRAN 08790CSR 62 GOTO END104 08800CSR 03 61 08810COR 04 EXSR SR4 08820CSR 07 EXSR SR7 08830CSR 08 EXSR SR8 08840C*------------------------------------------------------------------- 08850CSR END104 TAG 08860CSR 96 MOVE ' ' DUN,F EDIT FLAG 08870CSRN96 MOVE 'X' DUN,F 08880CSR ENDSR 08890C*********************************************************************** 08900CSR SR105 BEGSR 08910C* FINAL EDIT 08920CSR SETOF 77 08930CSR SETON 79 FINAL EDIT FLAG 08940CSR Z-ADD1 F 96 08950C*-------------------------------------------------------------------- 08960CSR T105A TAG 08970CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 08980CSRN54 GOTO END105 ÐÐ08990CSR TRAN COMP 'D' 54 09000CSR 54 F COMP 6 54 09010CSR 54 GOTO END105 DELETE TRAN 09020CSR EXSR SR201 IDENTIFY-F 09030CSR EXSR SR104 EDIT 09040CSRN96 GOTO T105A 09050C*-------------------------------------------------------------------- 09060CSR END105 TAG 09070CSR SETOF 79 09080CSR ENDSR 09090C******************************************************************** 09100CSR SR106 BEGSR 09110C* UPDATE DATA BASE. 09120CSR EXSR SR204 CLASSIFY WORK ORDER 09130CSR EXSR SR203 CLASSIFY TRAN 09140CSR 64 SETON 61 09150CSR 60 GOTO T106A ADD TRAN 09160CSR 61 GOTO T106D CHANGE TRAN 09170CSR 62 GOTO T106F DELETE TRAN 09180C* FLAG BAD TRAN CODE 09190CSR Z-ADD300 M 96 FLAG ERROR 09200CSR Z-ADD1 F FIELD # 09210CSR GOTO END106 09220C*------------------------------------------------------------------- 09230CSR T106A TAG ÐÐ09240C* ADD TRANSACTION 09250CSR 30 GOTO T106B POITEM NOT ON FILE 09260CSR 31 GOTO T106C DELETED MASTER 09270C* FLAG DUPLICATE ADD ERROR 09280CSR Z-ADD301 M 96 FLAG ERROR 09290CSR Z-ADD1 F FIELD # 09300CSR GOTO END106 09310C*--------------------------------------------------------------------- 09320CSR T106B TAG 09330C* ADD-- MAST NOT ON FILE 09340CSR MOVE 'A' PISTAT 09350CSR EXSR SR81 ADD NEW MASTER 09360CSR GOTO T106U 09370C*--------------------------------------------------------------------- 09380CSR T106C TAG 09390C* ADD-- MAST IS DELETED 09400CSR MOVE 'A' PISTAT RECORD STATUS 09410CSR EXSR SR82 REWRITE MAST 09420CSR GOTO T106U 09430C*---------------------------------------------------------------------- 09440CSR T106D TAG 09450C* CHANGE TRANSACTION. 09460CSRN30N31 GOTO T106E ACTIVE POITEM 09470C* FLAG NO MASTER ERROR 09480CSR Z-ADD5 M 96 FLAG ERROR ÐÐ09490CSR Z-ADD1 F FIELD # 09500CSR GOTO END106 09510C*----------------------------------------------------------------------- 09520CSR T106E TAG 09530C* REWRITE MASTER - CHANGE 09540CSR EXSR SR82 REWRITE MAST 09550CSR GOTO T106U 09560C*----------------------------------------------------------------------- 09570CSR T106F TAG 09580C* DELETE TRANSACTION 09590CSRN30N31 GOTO T106G ACTIVE POITEM 09600C* FLAG NO MASTER ERROR 09610CSR Z-ADD5 M 96 FLAG ERROR 09620CSR Z-ADD1 F FIELD # 09630CSR GOTO END106 09640C*----------------------------------------------------------------------- 09650CSR T106G TAG 09660C* CHECK FOR ACTIVITY. (DONE IN SR2) 09670C* DELETE MASTER. 09680CSR MOVE 'D' PISTAT RECORD STATUS 09690CSR EXSR SR82 REWRITE MASTER 09700C*--------------------------------------------------------------------- 09710CSR T106U TAG 09720CSR 70 EXSR SR85 UPDATE PMMST2 09730CSR EXSR SR86 UPDATE POMAST ÐÐ09740CSR EXSR SR79 GET POMAST 09750CSR END106 ENDSR 09760C************************************************************************ 09770CSR SR201 BEGSR 09780C* IDENTIFY FIELD NO. 09790CSR F COMP 1 01 09800CSR F COMP 2 02 09810CSR F COMP 3 03 09820CSR F COMP 4 04 09830CSR F COMP 5 05 09840CSR F COMP 6 06 09850CSR F COMP 7 07 09860CSR F COMP 8 08 09870CSR ENDSR 09880C********************************************************************** 09890CSR SR202 BEGSR 09900C* RIGHT JUSTIFY 09910CSR 41 GOTO T202A SCHED INPUT 09920CSR F LOKUPNUM 54 09930CSRN54 GOTO END202 NOT NUMERIC FIELD 09940C*------------------------------------------------------------------- 09950CSR T202A TAG 09960CSR Z-ADD15 W2N 20 09970CSRN41 MOVELW70A W15A 15 09980CSR EXIT SUBRAJ R. JUSTIFY ÐÐ09990CSR RLABL W2N 10000CSR RLABL W15A 10010CSR END202 ENDSR 10020C*********************************************************************** 10030CSR SR203 BEGSR 10040C* CLASSIFY TRAN CODE 10050CSR TRAN COMP 'A' 60 ADD 10060CSR TRAN COMP 'C' 61 CHANGE 10070CSR TRAN COMP 'D' 62 DELETE 10080CSR TRAN COMP 'T' 63 TEXT ONLY 10090CSR TRAN COMP 'S' 64 SCHED CHG ONLY 10100CSR TRAN COMP 'L' 65 LIST TRAN 10110CSR MOVE BLK35 TRNNAM 8 10120CSR 60 MOVEL'ADD' TRNNAM 10130CSR 61 MOVEL'CHANGE' TRNNAM 10140CSR 62 MOVEL'DELETE' TRNNAM 10150CSR 63 MOVEL'TEXT' TRNNAM 10160CSR 64 MOVEL'SCHEDULE'TRNNAM 10170CSR 65 MOVEL'LIST' TRNNAM 10180CSR ENDSR 10190C******************************************************************** 10200CSR SR204 BEGSR 10210C* CLASSIFY ACCOUNT. 10220CSR PIWOP COMP ' 14100' 70 10230CSRN70 PIWOP COMP ' 12100' 70 ÐÐ10240CSRN70 PIWOP COMP ' 14600' 70 10250CSRN70 Z-ADD0 PIPN 10260CSRN70 MOVE BLK35 PIVPN 10270CSR 70 MOVE BLK70 PINDES 10280CSR ENDSR 10290C******************************************************************** 10300CSR SR205 BEGSR 10310C* INIT POITEM MAST. 10320CSR Z-ADD0 PIPO 10330CSR Z-ADD0 PIPN 10340CSR MOVE BLK35 PIVPN 10350CSR Z-ADD0 PIDLR 10360CSR Z-ADD0 PIQRCD 10370CSR Z-ADD0 PIQSTK 10380CSR MOVE ' ' PILOT 10390CSR Z-ADD0 PI$PRC 10400CSR MOVE BLK35 PIWO 10410CSR MOVE ' ' PIWOP 10420CSR Z-ADD0 PIWOD 10430CSR Z-ADD0 PIVEND 10440CSR Z-ADD0 PILLOG 10450CSR Z-ADD0 PID 10460CSR Z-ADD0 PIQ 10470CSR MOVE ' ' PISTAT 10480CSR Z-ADD0 RCD ÐÐ10490CSR Z-ADD0 OPN 10500CSR Z-ADD0 BD 10510CSR Z-ADD0 BQ 10520CSR MOVE BLK29 PMDESC 10530CSR Z-ADD0 TOTPIQ 10540CSR Z-ADD0 TOTOPN 10550CSR MOVE BLK35 LOTNAM 10560CSR MOVE BLK70 PJNAME 10570CSR MOVE BLK8 TRNNAM 10580CSR MOVE BLK70 PINDES 10590CSR SETOF 40 10600CSR ENDSR 10610C******************************************************************** 10620CSR SR207 BEGSR 10630C* REVERSE DATE FIELDS 10640CSR MOVELW6N W2N 20 10650CSR W2N COMP 12 54 10660CSR 54 GOTO T207B 10670CSR MOVELW6N W4N 40 10680CSR MOVE W6N W2N 10690CSR MOVELW2N W6N 10700CSR MOVE W4N W6N 10710C*------------------------------------------------------------------- 10720CSR T207B TAG 10730CSR MOVEL'C' W7A 7 ÐÐ10740CSR MOVE W6N W7A 10750CSR EXSR SR84 GET CALENDAR 10760CSR END207 ENDSR 10770C******************************************************************** 10780CSR SR212 BEGSR 10790C* BUILD WORK ORDER # 10800CSR MOVEAW70A A70 10810CSR Z-ADD1 W 10820CSR '-' LOKUPA70,W 54 10830CSRN54 Z-ADD7 W 10840CSR MOVEAA70,W W4A 4 10850CSR 54 MOVEL' ' W4A 10860CSR Z-ADD4 W2N 10870CSR EXIT SUBRAJ RJ 10880CSR RLABL W2N 10890CSR RLABL W4A 10900CSR MOVE W4A PIWOD 30 WORK ORDER DASH 10910CSR MOVEABLK70 A70,W 10920CSR A70,1 COMP '0' 54 54 10930CSR 54 MOVEAA70,1 W5A 10940CSR 54 MOVEL' ' PIWOP 10950CSRN54 MOVEAA70 PIWOP 6 10960CSRN54 MOVE PIWOP W5A 5 10970CSR Z-ADD5 W2N 10980CSR EXIT SUBRAJ RJ ÐÐ10990CSR RLABL W2N 11000CSR RLABL W5A 11010CSR MOVE W5A PIWOP WORK ORDER PRIME 11020CSR EXSR SR204 CLASSIFY WO 11030CSR ENDSR 11040C******************************************************************** 11050CSR SR250 BEGSR 11060C* UPDATE SCHEDULE. 11070CSR SETOF 878990 11080CSR Z-ADDPIQ BQ 11090CSR Z-ADDPID BD 11100CSR EXSR SR203 CLASSIFY TRAN 11110CSR 62 Z-ADD0 PIQ DELETE TRAN 11120CSR 62 Z-ADD0 PID 11130CSR 62 Z-ADD0 RCD 11140CSR 62 Z-ADD0 OPN 11150CSR 62 MOVE ' ' UP 11160CSR 62 GOTO T250K 11170CSRN40 EXSR SR252 ALLOC RCPTS 11180CSRN40 EXSR SR253 DISPLAY SCHED 11190C*------------------------------------------------------------------- 11200CSR T250A TAG 11210C* REQUEST DATE,QTY. 11220CSR SETOF 96 11230CSR SETOF 908789 ÐÐ11240CSR SETON 4146 11250CSR EXCPT PROMPT 11260CSR SETOF 46 11270CSR EXSR SR75 READ 11280CSR 89 GOTO T250A HELP REQUEST 11290CSR 87 GOTO T250K DONE REQUEST 11300CSR 90 GOTO T250K ESC OTHER 11310CSR MOVEAW70A A70 11320CSR Z-ADD1 S 30 11330CSR ',' LOKUPA70,S 54 11340CSR 54 GOTO T250B 11350C* COMMA MISSING - FLAG INVALID DATE, ETC. 11360CSR Z-ADD615 M 96 FLAG ERROR 11370CSR EXSR SR74 PUT MSG 11380CSR GOTO T250A 11390C*------------------------------------------------------------------- 11400CSR T250B TAG 11410C* ISOLATE DATE,QTY. CHECK DATE TO CALENDAR FILE 11420CSR MOVE BLK35 W15A 11430CSR MOVEAA70,S W15A 11440CSR MOVEABLK70 A70,S 11450CSR EXSR SR202 R.J. 11460CSR MOVE W15A TQTY 70 SCHED QTY 11470CSR MOVEAA70,1 W15A 11480CSR EXSR SR202 R.J. ÐÐ11490CSR MOVE W15A TDATE 60 SCHED DATE 11500CSR Z-ADDTDATE W6N 60 11510CSR EXSR SR207 EDIT DATE 11520CSR Z-ADDW6N TDATE 11530CSR 60 Z-ADD390 M 96 FLAG ERROR 11540CSR 60 EXSR SR74 PUT MSG 11550CSR 60 GOTO T250A 11560CSR Z-ADD1 A 30 11570C*------------------------------------------------------------------- 11580CSR T250E TAG 11590C* MATCH DATE TO SCHEDULE 11600CSR TDATE LOKUPPID,A 55 FIND EXISING DATE 11610CSRN55 Z-ADD1 A 11620CSRN55 ZERO6 LOKUPPID,A 55 FIND EMPTY BUCKET 11630CSR 55 A COMP 24 5555 11640CSR 55 GOTO T250G 11650CSR Z-ADD616 M 96 FLAG ERROR 11660CSR EXSR SR74 PUT MSG 11670CSR GOTO T250A 11680C*------------------------------------------------------------------- 11690CSR T250G TAG 11700CSR Z-ADDTDATE PID,A UPDATE DATE 11710CSR Z-ADDTQTY PIQ,A 54 UPDATE QTY 11720CSRN54 Z-ADD0 PIQ,A 11730CSRN54 Z-ADD0 PID,A ÐÐ11740CSR Z-ADD0 RCD,A 11750CSR Z-ADD0 OPN,A 11760CSR MOVE 'X' UP,A 11770CSR A COMP 8 54 11780CSR A COMP 16 55 11790CSR 55 SETOF 54 11800CSR 54 A SUB 8 A 11810CSR 55 A SUB 16 A 11820CSR A ADD 8 B 11830CSR B ADD 8 C 11840CSR EXSR SR76 PUT UPDATED SCHED 11850CSR GOTO T250A 11860C*------------------------------------------------------------------- 11870CSR T250K TAG 11880C* SORT/DISPLAY UPDATED SCHEDULE 11890CSR SETOF 41 11900CSR EXSR SR251 SORT SCHED 11910CSR EXSR SR252 APPLY RCPTS TO SCHED 11920CSR EXSR SR253 DISPLAY 11930CSR 87 GOTO T250A ESC-D 11940C*------------------------------------------------------------------- 11950CSR END250 TAG 11960CSR SETOF 4187 11970CSR MOVE BLK35 MGTEXT 11980CSR ENDSR ÐÐ11990C******************************************************************** 12000CSR SR251 BEGSR 12010C* SORT POITEM SCHEDULE. 12020CSR Z-ADD0 A 30 12030CSR SETOF 40 12040C*------------------------------------------------------------------- 12050CSR T251B TAG 12060CSR 1 ADD A A 12070CSR A COMP 24 54 12080CSR 54 GOTO END251 12090CSR PID,A COMP 0 54 12100CSR 54 GOTO T251E 12110CSR Z-ADDA B 30 12120CSR ZERO6 LOKUPPID,B 54 12130CSRN54 GOTO END251 12140CSR Z-ADDPID,B PID,A 12150CSR Z-ADDPIQ,B PIQ,A 12160CSR Z-ADD0 PID,B 12170CSR Z-ADD0 PIQ,B 12180C*------------------------------------------------------------------- 12190CSR T251E TAG 12200CSR Z-ADDA B 12210C*------------------------------------------------------------------- 12220CSR T251G TAG 12230CSR B COMP 24 54 ÐÐ12240CSR 54 GOTO T251B 12250CSR ZERO6 LOKUPPID,B 54 12260CSRN54 GOTO T251B 12270CSR PID,A COMP PID,B 54 12280CSRN54 1 ADD B B 12290CSRN54 GOTO T251G 12300CSR Z-ADDPID,A SAVDAT 60 12310CSR Z-ADDPIQ,A SAVQTY 70 12320CSR Z-ADDPID,B PID,A 12330CSR Z-ADDPIQ,B PIQ,A 12340CSR Z-ADDSAVDAT PID,B 12350CSR Z-ADDSAVQTY PIQ,B 12360CSR 1 ADD B B 12370CSR GOTO T251G 12380CSR END251 ENDSR 12390C******************************************************************** 12400CSR SR252 BEGSR 12410C* APPLY RCPTS TO SCHEDULE. 12420CSR MOVE ' ' UP 12430CSR Z-ADD0 RCD 12440CSR Z-ADD1 A 12450CSR Z-ADDPIQRCD SAVQTY 70 12460CSR XFOOTPIQ TOTPIQ 12470C*------------------------------------------------------------------- 12480CSR T252A TAG ÐÐ12490CSR ZERO7 LOKUPPIQ,A 54 12500CSRN54 GOTO T252C 12510CSR Z-ADDPIQ,A W7N 70 12520CSR SETOF 57 12530CSR SAVQTY COMP W7N 545556 12540CSR 54 Z-ADDW7N RCD,A 12550CSR 54 SAVQTY SUB W7N SAVQTY 57 12560CSR 54 Z-ADD0 W7N 12570CSR 55 Z-ADDSAVQTY RCD,A 12580CSR 55 W7N SUB SAVQTY W7N 12590CSR 55 Z-ADD0 SAVQTY 57 12600CSR 56 Z-ADDSAVQTY RCD,A 12610CSR 56 Z-ADD0 SAVQTY 57 12620CSR 56 Z-ADD0 W7N 12630CSR 57 1 ADD A A 12640CSR 57 A COMP 24 54 12650CSR 57 GOTO T252A 12660CSR GOTO END252 12670C*------------------------------------------------------------------- 12680CSR T252C TAG 12690CSR Z-ADD1 A 12700CSR ZERO7 LOKUPPIQ,A 54 12710CSR 54 Z-ADDSAVQTY RCD,A 12720CSR END252 ENDSR 12730C******************************************************************** ÐÐ12740CSR SR253 BEGSR 12750C* DISPLAY SCHEDULE. 12760CSR Z-ADD0 A 12770CSR PIQ SUB RCD OPN OPEN PO QTYS 12780C* PUT SCHEDULE HEADING. 12790CSR 40 GOTO T253A 12800CSR 39 MOVEL'013' RPGLIN 4 12810CSRN39 MOVEL'103' RPGLIN 12820CSR MOVEL'001' RPGCOL 4 12830CSR EXSR SR69 MOVE CURSOR 12840CSR SETON 7540 12850CSR EXCPT PUT SCHED HEADING 12860CSR SETOF 75 12870C*------------------------------------------------------------------- 12880CSR T253A TAG 12890CSR 1 ADD A A 12900CSR A COMP 8 54 12910CSR 54 GOTO T253C 12920CSR PIQ,A COMP 0 54 12930CSRN54 RCD,A COMP 0 54 12940CSR 8 ADD A B 30 12950CSR 8 ADD B C 30 12960CSRN54 PIQ,B COMP 0 54 12970CSRN54 RCD,B COMP 0 54 12980CSRN54 PIQ,C COMP 0 54 ÐÐ12990CSRN54 RCD,C COMP 0 54 13000CSRN54 GOTO T253A 13010CSR EXSR SR76 PUT SCHEDULE 13020CSR GOTO T253A 13030C*------------------------------------------------------------------- 13040CSR T253C TAG 13050C* PUT TOTALS. 13060CSR XFOOTPIQ TOTPIQ 80 13070CSR XFOOTRCD TOTRCD 80 13080CSR TOTPIQ SUB TOTRCD TOTOPN 80 13090CSR SETON 74 13100CSR EXCPT PUT TOTALS 13110CSR SETOF 74 13120CSR ENDSR 13130C****************************************************************** 13140CSR SR300 BEGSR 13150C* UPDATE SFMAST 13160CSRN70 GOTO END300 13170CSR MOVELCRVNAM VEND20 20 VENDOR NAME 13180CSR Z-ADD1 S 13190CSR MOVE 'D' STAT 1 13200C*--------------------------------------------------------------- 13210CSR T300B TAG 13220CSR ZERO7 LOKUPBQ,S 54 13230CSRN54 GOTO T300E ÐÐ13240CSR MOVE BD,S DUEDAT 6 13250CSR Z-ADDBQ,S DUEQTY 70 13260CSR Z-ADD0 QTYRCD 70 RECORD STATUS 13270CSR EXSR SR400 UPDATE SFMAST 13280CSR Z-ADD0 BD,S 13290CSR Z-ADD0 BQ,S 13300CSR GOTO T300B 13310C*---------------------------------------------------------------- 13320CSR T300E TAG 13330CSR Z-ADD1 S 13340CSR MOVE 'A' STAT 13350C*------------------------------------------------------------------- 13360CSR T300G TAG 13370CSR ZERO7 LOKUPPIQ,S 54 13380CSRN54 GOTO END300 13390CSR Z-ADDPIQ,S DUEQTY 13400CSR MOVE PID,S DUEDAT 13410CSR Z-ADDRCD,S QTYRCD 13420CSR EXSR SR400 UPDATE SFMAST 13430CSR 1 ADD S S 13440CSR S COMP 26 54 13450CSRN54 GOTO T300G 13460CSR END300 ENDSR 13470C******************************************************************* 13480CSR SR400 BEGSR ÐÐ13490C* UPDATE SFMAST/ALTKEY (SEE SR300) 13500CSR MOVELPIPN W10A 10 13510CSR MOVEAW10A A70,1 13520CSR MOVEADUEDAT A70,11 13530CSR MOVEA'30' A70,17 13540CSR MOVEACRPO A70,19 13550CSR MOVE TITEM W3A 3 13560CSR MOVEAW3A A70,25 13570CSR MOVEA'00' A70,28 13580CSR MOVEAA70 W29A 29 13590CSR W29A CHAINSFMAST 60 13600CSR 60 STAT COMP 'D' 54 13610CSR 60 54 GOTO T400B 13620CSR SETON 83 13630CSR EXCPT UPDATE SFMAST 13640CSR SETOF 83 13650C*------------------------------------------------------------------ 13660CSR T400B TAG 13670CSR MOVEA'B3' A70,1 13680CSR MOVEADUEDAT A70,3 13690CSR MOVEACRPO A70,9 13700CSR MOVEAW3A A70,15 13710CSR MOVEA'00' A70,18 13720CSR MOVEAW10A A70,20 13730CSR MOVEAA70 W29A ÐÐ13740CSR W29A CHAINALTKEY 60 13750CSR 60 STAT COMP 'D' 54 13760CSR 60 54 GOTO END400 13770CSR SETON 84 13780CSR EXCPT UPDATE AK-DUE 13790CSR SETOF 84 13800CSR END400 ENDSR 13810O************************************************************** 13820OTERM132 E 71 13830O* PUT HEADINGS 13840O BIT,28 1 13850O N39 8 '8091001' 13860O N39 BIT,1 9 13870O N39 BIT,1 10 13880O 39 10 '[001 ]001' 13890O 39 BIT,28 6 13900O 66 'P U R C H A S E O R D' 13910O 70 ' E R' 13920O CRPO 78 13930O 103 'I T E M I N P U T' 13940O UDATE Y 18 13950O*------------------------------------------------------------------- 13960O E 71 13970O OR 72 01 13980O DOT 26 ÐÐ13990O 3 '(1)' 14000O 13 'TRAN CODE' 14010O TRAN 31 14020O TRNNAM 46 14030O A39 132 14040O*------------------------------------------------------------------- 14050O E 71 14060O OR 72 02 14070O DOT 26 14080O 3 '(2)' 14090O 15 'ITEM NUMBER' 14100O TITEM Z 31 14110O 72 A39 132 14120O 71 A39 B 132 14130O*------------------------------------------------------------------- 14140O E 71 14150O OR 72 03 14160O DOT 26 14170O 3 '(3)' 14180O 19 'ORDER/ACCOUNT #' 14190O PIWOP 34 14200O 55 35 '-' 14210O 55 PIWOD 38 14220O PJNAME 80 14230O A39 132 ÐÐ14240O*------------------------------------------------------------------- 14250O E 71 14260O OR 72 04 70 14270O DOT 26 14280O 3 '(4)' 14290O 10 'PART #' 14300O PIPN 40 ' - - ' 14310O PMDESC 71 14320O A39 132 14330O*------------------------------------------------------------------- 14340O E 71 14350O OR 72 05 70 14360O DOT 26 14370O 3 '(5)' 14380O 17 'VENDOR PART #' 14390O PIVPN 43 14400O A39 132 14410O*------------------------------------------------------------------- 14420O E 71 14430O OR 72 06 14440O DOT 26 14450O N70 26 ' ' 14460O N70 20 '>' 14470O 3 '(6)' 14480O 16 'ITEM DESCRIP' ÐÐ14490O 20 'TION' 14500O 70 PIDESC 57 14510O N70 PINDES 92 14520O 69 70 28 '[' 14530O 69 70 58 ']' 14540O 69N70 28 '[' 14550O 69N70 100 ']' 14560O A39 132 14570O*------------------------------------------------------------------- 14580O E 71 14590O OR 72 07 14600O DOT 26 14610O 3 '(7)' 14620O 20 'PRICE-CODE (L,N)' 14630O PILOT 29 14640O LOTNAM 44 14650O A39 132 14660O*------------------------------------------------------------------- 14670O E 71 14680O OR 72 08 14690O DOT 26 14700O 3 '(8)' 14710O 9 'PRICE' 14720O PI$PRC2 41 14730O 56 'STD. COST =' ÐÐ14740O PMTCST2 69 14750O A39 132 14760O*-------------------------------------------------------------- 14770O E 71 14780O OR 74 14790O BIT,28 1 14800O N39 8 '8100001' 14810O N39 BIT,1 9 14820O N39 BIT,1 10 14830O 39 10 '[010 ]001' 14840O 39 BIT,28 6 14850O 24 'TOTAL ORDERED:' 14860O TOTPIQ2 34 14870O 51 'TOTAL RECEIVED:' 14880O PIQRCD2 61 14890O 84 'TOTAL STOCKED:' 14900O PIQSTK2 94 14910O 122 'TOTAL OPEN:' 14920O TOTOPNK 132 14930O*------------------------------------------------------------------- 14940O E 71 14950O 59 'S C H E D U L E' 14960O 72 'D A T E S' 14970O 76 '&' 14980O 87 'Q T Y''S' ÐÐ14990O*------------------------------------------------------------------- 15000O E 75 15010O 16 'QTY' 15020O 26 'QTY' 15030O 39 'QTY' 15040O 41 '*' 15050O 59 'QTY' 15060O 69 'QTY' 15070O 82 'QTY' 15080O 84 '*' 15090O 102 'QTY' 15100O 112 'QTY' 15110O 125 'QTY' 15120O*------------------------------------------------------------------- 15130O E 75 15140O* SCHEDULE HEADING 15150O 8 'DUE-DATE' 15160O 19 'SCHEDULED' 15170O 29 'RECEIVED' 15180O 39 'OPEN' 15190O 41 '*' 15200O 51 'DUE-DATE' 15210O 62 'SCHEDULED' 15220O 72 'RECIEVED' 15230O 82 'OPEN' ÐÐ15240O 84 '*' 15250O 94 'DUE-DATE' 15260O 105 'SCHEDULED' 15270O 115 'RECEIVED' 15280O 125 'OPEN' 15290O*-------------------------------------------------------------- 15300O E 76 15310O* PUT SCHEDULE DATA 15320O PID,A 8 ' - - ' 15330O PIQ,A 2 19 15340O RCD,A 2 29 15350O 42 41 29 ' XXXXXXX' 15360O OPN,A K 40 15370O 42 41 40 ' XXXXXXX ' 15380O 41 '*' 15390O PID,B 51 ' - - ' 15400O PIQ,B 2 62 15410O RCD,B 2 72 15420O 43 41 72 ' XXXXXXX' 15430O OPN,B K 83 15440O 43 41 83 ' XXXXXXX ' 15450O 84 '*' 15460O PID,C 94 ' - - ' 15470O PIQ,C 2 105 15480O RCD,C 2 115 ÐÐ15490O 38 41 115 ' XXXXXXX' 15500O OPN,C K 126 15510O 38 41 126 ' XXXXXXX ' 15520O*--------------------------------------------------------------------- 15530O E 46 15540O NUL 132 15550O BIT,28 1 15560O N39 8 '8102001' 15570O N39 BIT,1 9 15580O N39 BIT,1 10 15590O 39 10 '[012 ]001' 15600O 39 BIT,28 6 15610O 29 '(9) ENTER DATE,QTY:' 15620O 31 ' ' 15630O 50 ' ' 15640O*-------------------------------------------------------------------- 15650O E 73 15660O* PUT MESSAGE. 15670O NUL 132 15680O BIT,28 1 15690O 41N39 8 '8103001' 15700O N41N39 2 '8' 15710O N41 LOC 5 15720O 41 39 10 '[013 ]001' 15730O 39 BIT,28 6 ÐÐ15740O N39 BIT,1 9 15750O N39 BIT,1 10 15760O A39 49 15770O N96 12 ' ' 15780O N96 49 ' ' 15790O*------------------------------------------------------------------- 15800O E 48 15810O BIT,28 1 15820O N39 8 '8101001' 15830O N39 BIT,1 9 15840O N39 BIT,1 10 15850O 39 10 '[011 ]001' 15860O 39 BIT,28 6 15870O 23 'ITEM UPDATED.' 15880O*------------------------------------------------------------------- 15890O E 48 15900O 24 'ENTER \G, \E, \N, \L, \T' 15910O 48 ', OR RETURN TO CONTINUE.' 15920O*------------------------------------------------------------------- 15930O E 97 55 15940O BIT,28 1 15950O N39 8 '8101001' 15960O N39 BIT,1 9 15970O N39 BIT,1 10 15980O 39 10 '[011 ]001' ÐÐ15990O 39 BIT,28 6 16000O 34 'LOADING TEXT-PLEASE WAIT' 16010O E 97 55 16020O 1 ' ' 16030O******************************************************************** 16040OPOITEM EADD 81 16050O CRPO 6 16060O TITEM 9 16070O 70 PIPN 19 16080O 70 PIVPN 34 16090O 70 PIDESC 63 16100O N70 PINDES 79 16110O PIDLR 85 16120O PIQRCD 89P 16130O PIQSTK 93P 16140O PILOT 94 16150O PI$PRC 99P 16160O PIWO 108 16170O POVEND 111P 16180O 113 '00' 16190O PID 269 16200O PIQ 373P 16210O ZERO7 377P 16220O W4N 381 16230O 384 'A' ÐÐ16240O*-------------------------------------------------------------------- 16250O E 82 16260O 70 PIPN 19 16270O 70 PIVPN 34 16280O 70 PIDESC 63 16290O N70 PINDES 79 16300O PIDLR 85 16310O PIQRCD 89P 16320O PIQSTK 93P 16330O PILOT 94 16340O PI$PRC 99P 16350O PIWO 108 16360O POVEND 111P 16370O PILLOG 113 16380O PID 269 16390O PIQ 373P 16400O PIABOQ 377P 16410O PIDATE 381 16420O PISTAT 384 16430O******************************************************************** 16440OSFPNA EADD 81 16450O OR 82 16460O PIPN 10 16470O******************************************************************* 16480OPMMST2 E 85 ÐÐ16490O PLT 128P 16500O PMOHB 314P 16510O PMPOB 346P 16520O PMTCST 619P 16530O******************************************************************** 16540OPOMAST E 86 16550O POLITM 119P 16560O***************************************************************** 16570OCRTFILE E 97 16580O PROG 26 16590O CRTIME 33 16600O CRDATE 37 16610O LNK 79 16620O TITEM 90 16630O***************************************************************** 16640OSFMAST EADD 83 60 16650O W29A 29 16660O DUEQTY 33P 16670O QTYRCD 37P 16680O TODAY 43 16690O POVEND 46P 16700O PMECHG 66 16710O VEND20 90 16720O PI$PRC 95P 16730O PILOT 105 ÐÐ16740O ZERO7 123P 16750O ZERO7 127P 16760O 128 'A' 16770O*------------------------------------------------------------------ 16780O E 83N60 16790O DUEQTY 33P 16800O QTYRCD 37P 16810O TODAY 43 16820O POVEND 46P 16830O PMECHG 66 16840O VEND20 90 16850O PI$PRC 95P 16860O PILOT 105 16870O ZERO7 123P 16880O ZERO7 127P 16890O STAT 128 16900O***************************************************************** 16910OALTKEY EADD 84 60 16920O W29A 29 16930O 32 'A' 16940O*----------------------------------------------------------------- 16950O E 84N60 16960O STAT 32 16970O****************************************************************** ** NUL ARRAY 016980ÐÐ 016990** A39 ARRAY 17000 17010** A70 ARRAY 017020 017030** NUM ARRAY 017040002 ITEM 017050004 PART NO 017060008 UNIT COST 017070** DUN ARRAY 017080 017090** DOT ARRAY 017100 - - - - - - - - - -> 017110** RCD ARRAY 17120 17130** OPN ARRAY 17140 17150** UP ARRAY 17160 17170** LN ARRAY 17180LOT PRICE 17190NO CHARGE 17200UNIT PRICE 17210** BQ ARRAY 17220 17230ÐÐ** BD ARRAY 17240 17250** NAM ARRAY 17260PROD WORK ORDER 17270** LNK ARRAY 017280 17290/* 17300_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ú)ì úiX009CF P120282120282(èÈÐ00010H Q009CF00020F* PRINT CFKEYOUT BY COMPANY,ADDROUT. (X009CF) 00030F* REVISED 10/06/80 3:00 PM. DG-REL006 OK. 00031F* NOTE: RUN THIS PROGRAM WITH PROCEDURE, ZCFPRT. 00040F* SWITCH-8 USES CFSTART FILE FOR RE-START. 00050FCFSTART IP F 80 DISK 00060FCFKEYOUTIS F 59 59R I DISK 00070FCFADRT IR F 300 3 3IT EDISK 00080FCFMAST IC F 370R15AI 1 DISK 00090FPRINT O F 132 OF PRINTER 00100E******************************************************************** 00110E CFADRT CFKEYOUT 00120E NA4 5 5 6 00130E NB4 5 5 4 0 00140E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00150E BIT 33 1 00160E CFA 8 35 00170E CFN 5 3 00180E CFC 5 3 0 00190E NAC 24 1 00200I******************************************************************** 00210ICFKEYOUTCK 00220I 36 50 CKKEY 00230I 51 590CKZIP 00240I******************************************************************** ÐÐ00250ICFSTART CS 02 00260I 1 15 CSKEY 00270I******************************************************************** 00280ICFMAST CF 01 00290I* CATALOG HOLDER (MAIL LIST) MASTER. 00300I* KEY AREA. 00310I* NAME KEY 15A 00320I 1 15 CFKEY 00330I* ADDRESS LINES 35A X 8 00340I 16 295 CFA 00350I* STATE CODE 2A 00360I 296 297 CFSTCD 00370I* ZIP 9P 00380I P 298 3020CFZIP 00390I* CATALOGS. 00400I* NAME 3A X 5 00410I 303 317 CFN 00420I* COPIES 3P X 5 00430I P 318 327 CFC 00440I* SELECTOR CODES 24 X 1A 1 00450I 328 351 NAC 00460I* TELEPHONE # 12A 00470I 352 363 CFTEL 00480I* DATE LAST TRAN 6N (YMD) 00490I 364 3690CFDLT ÐÐ00500I* RECORD STATUS 1A 00510I 370 370 CFSTAT 00520C******************************************************************** 00530C* INITIALIZE - 1 TIME. 00540C N79 EXSR SR101 INIT. 00550C*------------------------------------------------------------------- 00560C 02 GOTO END 00570C* BYPASS RECORDS PRIOR TO MATCH ON CKKEY. 00580C NU8 SETON 77 00590C 77 GOTO TAG10 00600C CKKEY COMP CSKEY 77 00610C N77 SETOF 01 00620C N77 GOTO END 00630C*------------------------------------------------------------------- 00640C TAG10 TAG 00650C CKKEY CHAINCFMAST 54 00660C SETOF 65 00670C CFSTAT COMP 'D' 54 00680C 54 SETOF 01 00690C 54 GOTO END DELETED CFMAST. 00700C CFSTCD COMP ' ' 54 00710C 54 CFSTCD LOKUPTABSC 54 00720C 'E' LOKUPNAC 55 00730C CFA,8 COMP BLK35 57 00740C 57 54 ÐÐ00750COR 57N55 SETON 65 00760C MOVE CFN NA4 00770C Z-ADDCFC NB4 00780C CFSTCD COMP ' ' 54 00790C 54 CFSTCD LOKUPTABSC TABSCN 54 00800C 54 MOVE TABSCN W25A 25 00810C N54 MOVE BLK35 W25A 00820C*------------------------------------------------------------------- 00830C END TAG 00840C******************************************************************** 00850CSR SR101 BEGSR 00860C* INITIALIZE 1-TIME. 00870CSR SETON 79 00880CSR MOVE ' ' BLK16 16 00890CSR MOVE ' ' BLK35 35 00900CSR ENDSR 00910O******************************************************************** 00920OPRINT H 201 1P 00930O OR OF 00940O* PUT HEADINGS. 00950O UDATE Y 8 00960O 55 'MAILING LIST REPORT' 00970O 76 '- COMPANY SEQUENCE' 00980O 127 'PAGE' 00990O PAGE Z 132 ÐÐ01000O H 2 1P 01010O OR OF 01020O* PUT HEADINGS. 01030O 10 'KEY FIELD' 01040O 47 'N A M E A N D A D D ' 01050O 54 'R E S S' 01060O 92 'S E L E C T O R C O D ' 01070O 95 'E S' 01080O 123 'MAILER CODES' 01090O*------------------------------------------------------------------- 01100O D 21 01 01110O* PUT DATA. 01120O CFKEY 15 01130O 22 'NAME' 01140O CFA,1 66 01150O NAC 94 01160O NA4 131 01170O*------------------------------------------------------------------- 01180O D 1 01 01190O 23 'TITLE' 01200O CFA,2 66 01210O NB4 Z 131 01220O*------------------------------------------------------------------- 01230O D 1 01 01240O 25 'COMPANY' ÐÐ01250O CFA,3 66 01260O*------------------------------------------------------------------- 01270O D 1 01 01280O 25 'COMPANY' 01290O CFA,4 66 01300O*------------------------------------------------------------------- 01310O D 1 01 01320O 25 'ADDRESS' 01330O CFA,5 66 01340O*------------------------------------------------------------------- 01350O D 1 01 01360O 25 'ADDRESS' 01370O CFA,6 66 01380O 79 'TELEPHONE:' 01390O CFTEL 92 01400O 110 'LAST UPDATED:' 01410O CFDLT Y 118 01420O*------------------------------------------------------------------- 01430O D 1 01 01440O 22 'CITY' 01450O CFA,7 66 01460O 74 'STATE' 01470O 79 ':' 01480O CFSTCD 82 01490O W25A 104 ÐÐ01500O 112 'ZIP:' 01510O CFZIP Z 122 01520O*------------------------------------------------------------------- 01530O D 1 01 01540O 30 'FOREIGN CTRY' 01550O CFA,8 66 01560O*------------------------------------------------------------------- 01570O D 1 01 65 01580O 19 '*** INVALID COUNTRY' ** NA4 ARRAY 001590 001600** NB4 ARRAY 001610 001620** TABSC/TABSCN --- STATE CODES/NAMES 001630 001640ALALABAMA 001650AKALASKA 001660AZARIZONA 001670ARARKANSAS 001680ASAMERICAN SAMOA 001690CACALIFORNIA 001700CZCANAL ZONE 001710COCOLORADO 001720CTCONNECTICUT 001730DEDELAWARE 001740ÐÐDCDISTRICT OF COLUMBIA 001750FLFLORIDA 001760GAGEORGIA 001770GUGUAM 001780HIHAWAII 001790IDIDAHO 001800ILILLINOIS 001810ININDIANA 001820IAIOWA 001830KSKANSAS 001840KYKENTUCKY 001850LALOUISIANA 001860MEMAINE 001870MDMARYLAND 001880MAMASSACHUSETTS 001890MIMICHIGAN 001900MNMINNESOTA 001910MSMISSISSIPPI 001920MOMISSOURI 001930MTMONTANA 001940NENEBRASKA 001950NVNEVADA 001960NHNEW HAMPSHIRE 001970NJNEW JERSEY 001980NMNEW MEXICO 001990ÐÐNYNEW YORK 002000NCNORTH CAROLINA 002010NDNORTH DAKOTA 002020OHOHIO 002030OKOKLAHOMA 002040OROREGON 002050PAPENNSYLVANIA 002060PRPUERTO RICO 002070RIRHODE ISLAND 002080SCSOUTH CAROLINA 002090SDSOUTH DAKOTA 002100TNTENNESSEE 002110TTTRUST TERRITORIES 002120TXTEXAS 002130UTUTAH 002140VTVERMONT 002150VAVIRGINIA 002160VIVIRGIN ISLANDS 002170WAWASHINGTON 002180WVWEST VIRGINIA 002190WIWISCONSIN 002200WYWYOMING 002210/* 002220_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( Ä*V ÄX028PM P=®120282120282(èÈÐ00010H Q028PM00020F* PMMST ORDER POLICY UPDATE - PROG-2. (X028PM) 00030F* REVISED 8-09-82 12:40 PM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FPMMST2 UC F 674R12AI 1 DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A12 12 12 1 A INPUT DATA ARRAY 00120E NUM 1 28 3 0 NUMERIC FIELD NO.'S 00130E DUN 1 38 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E LOC 1 38 6 00160E TABISS 1 9 2 TABICN 15 ISSUE CODES 00170E TABSC 1 6 2 TABSCN 15 SOURCE CODES 00180E TABUM 1 15 2 TABUMN 15 UNITS OF MEAS 00190E TABPV 1 7 1 TABPVN 22 PROVISION CODES 00200E A9 9 9 1 00210E DIV 1 1 37 00220E LNK 1 7 6 A 00230E BIT 33 1 SCREEN CONTR. CHAR 00240E PAR 25 1 00250E TST 25 1 ÐÐ00260E CALL 7 6 CALL STACK 00270E PA$ 7 9 3 00280E PM$ 7 9 3 00290E PLT 8 3 0 LEAD TIMES 00300E PHZ 5 3 0 HORIZON M-DAYS 00310E PMM 6 7 0 MIN/MAX CODES 00320E ADP 3 3 0 ACTG HRS DEPT 00330E AHR 3 7 3 ACTG HRS REQD 00340E MDP 12 3 0 MFG HRS DEPT 00350E MHR 12 7 3 MFG HRS REQD 00360E* 00370I******************************************************************* 00380IBITPAR BT 00390I 1 33 BIT 00400I 34 58 PAR 00410I 59 83 TST 00420I******************************************************************* 00430IMGFILE MG 00440I* MESSAGE FILE. 00450I 1 35 MGTEXT 00460I****************************************************************** 00470ICRTFILE CR 00480I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00490I* STD AREA - SAME FOR ALL PROGRAMS. 00500I* EMPLOYEE # 5N ÐÐ00510I 1 50CREMPL 00520I* USER CODE 8A 00530I 6 13 CRUSER 00540I* DEPT # 5N 00550I 14 180CRDEPT 00560I* JOB NAME 8A (JOB LOADED BY MENU) 00570I 19 26 CRJOB 00580I* SHUTDOWN FLAG 1A 00590I* BLANK = NO SHUTDOWN 00600I 27 27 CRSHUT 00610I* TIME STARTED 6N 00620I 28 330CRTIME 00630I* DATE STARTED 4N 00640I 34 370CRDATE 00650I* CALL STACK 7 X 6A 00660I 38 79 CALL 00670I*------------------------------------------------------------------- 00680I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 00690I 80 890CRPN 00700I 90 90 CRTRAN 00710I 91 93 CRWU 00720I 94 94 CRKFLG 00730I******************************************************************** 00740IPMMST2 PM 00750I* PART MASTER RECORD (XPMMST) ÐÐ00760I* KEY AREA 00770I* PART NO. 10N 00780I 1 100PMPN 00790I* NUMB OF COMPONENTS 3P 00800I P 13 140PMNOBM 00810I* PROD LINE 4N 00820I 15 180PMPL 00830I* MODEL NAME 12A 00840I 19 30 PMMODL 00850I* DESCRIPTION 29A 00860I 31 59 PMDESC 00870I* COMMODITY CODE 9P 00880I P 60 640PMCC 00890I* ENG CHANGE STATUS. 00900I* LAST ECN # 5A 00910I 65 69 PMECN 00920I* CUR CHG LEVEL 2A 00930I 70 71 PMECHG 00940I* CUR CHG DATE 6N 00950I 72 770PMDCHG 00960I* RELEASE STATUS 1A 00970I* E = ENG ONLY 00980I* M = REL TO MFG 00990I* P = PROTOTYPE 01000I* X = PRE-RELEASE ÐÐ01010I 78 78 PMRELS 01020I* INSPECT CODE 3A 01030I 79 81 PMINSP 01040I* DRAWING INFO. 01050I* DWG SIZE 1A 01060I 82 82 PMSIZ 01070I* DWG CLASS 1A 01080I* D = DYNAIR DWG 01090I* V = VENDOR DWG 01100I 83 83 PMDCLS 01110I* STANDARD CODE 1A 01120I 84 84 PMSTDC 01130I* UNIT MEAS 2A 01140I* EA = EACH OZ = OUNCE 01150I* ST = SET TC = TROY OUNCE 01160I* IN = INCH LB = POUND 01170I* FT = FEET PT = PINT 01180I* YD = YARD QT = QUART 01190I* SI = SQ.INCH GL = GALLON 01200I* SF = SQ.FEET DR = DRUM 01210I* SY = SQ.YARD 01220I 85 86 PMUM 01230I***** UNIT MEAS CONVERSION. 01240I***** UM MULTIPLIER 7.2P 01250I***** P 87 902PMUMM ÐÐ01260I***** UM CONVERTER 1A 01270I***** M = MULTIPLY 01280I***** D = DIVIDE 01290I***** 91 91 PMUMC 01300I***** SET/DRUM UM 2A 01310I***** 92 93 PMUMUM 01320I* SOURCE CODE 2A 01330I* MA = MFG ASSY 01340I* MP = MFG PART 01350I* PA = PURCH ASSY 01360I* PP = PURCH PART 01370I* RS = RAW STOCK 01380I 94 95 PMSC 01390I* PROVISIONING CODE 1A 01400I* A = FORECAST,NO VALUE ADDED 01410I* B = FORECAST,VALUE ADDED 01420I* C = BUILD TO ORDER 01430I* E = CUSTOM 01440I* Y = OBSOLETE,REPAIRABLE 01450I* Z = OBSOLETE,NOT REPAIRABLE 01460I 96 96 PMPROV 01470I* ISSUE CODE 2A 01480I* PT = PULL TIME 01490I* OR = ON REQUEST 01500I* BI = BULK ISSUE ÐÐ01510I* AR = AS REQUIRED 01520I* VS = VENDOR SUPPLIED 01530I* SD = SHIPPING DOCUMENT 01540I* TD = TRAV DOCUMENT 01550I* RD = REF DOCUMENT 01560I* RA = REF ASSY 01570I 97 98 PMISSU 01580I* DELIVER TO DEPT 5P 01590I P 99 1010PMDEL 01600I* RESPONSIBILITY CODES 01610I* ENGR CODE 2A 01620I 102 103 PMEGR 01630I* PLANNER CODE 2A 01640I 104 105 PMPLNR 01650I* BUYER CODE 2A 01660I 106 107 PMBUYR 01670I* SALESMAN CODE 2A 01680I 108 109 PMSLSM 01690I* INVENTORY ACCOUNT 5P 01700I P 110 1120PMACNT 01710I* LEAD TIMES 3P X 8 01720I* MFG BUCKET PURCH 01730I* 01740I* SCHEDULING 1 SCHEDULING 01750I* KIT 2 PLACE PO ÐÐ01760I* VENDOR 3 VENDOR 01770I* PRODUCTION 4 01780I* INSPECT/TEST 5 INSPECT 01790I* STOCK 6 STOCK 01800I* 7 01810I* CUM LEAD 8 01820I* 01830I P 113 128 PLT 01840I* ORDER POLICY CODES. 01850I* HORIZON M-DAYS 3P X 5 01860I* 1 = SALES ORDERS 01870I* 2 = PROD REQMTS-REL 01880I* 3 = PROD REQMTS-PLAN 01890I* 4 = FORECAST 01900I* 5 = SAFETY STOCK 01910I P 129 138 PHZ 01920I* MIN/MAX CODES. 01930I* ARRAY 7P X 6 01940I* 1 = MIN ORDER SPAN 01950I* 2 = MIN ORDER QTY 01960I* 3 = MIN ORDER $$$ 01970I* 4 = MAX ORDER SPAN 01980I* 5 = MAX ORDER QTY 01990I* 6 = MAX ORDER $$$ 02000I P 139 162 PMM ÐÐ02010I* MINIMUM STOCK QTY (SAFETY STOCK) 7P 02020I P 163 1660PMSSTK 02030I* ROUNDING FACTOR 5P 02040I P 167 1690PMRNDF 02050I* EOQ CODE 2A 02060I 170 171 PMEOQ 02070I* EOQ PARAMETER 2A 02080I 172 173 PMEOQP 02090I* EXCEPTION REPORT CRITERIA. 02100I* ALLOWABLE SURPLUS QTY 7P 02110I P 174 1770PMSQTY 02120I* ALLOWABLE SURPLUS % 5.2P 02130I P 178 1802PMSPCT 02140I* ALLOWABLE SURPLUS SPAN 3P 02150I P 181 1820PMSSP 02160I* ALLOWABLE SHORTAGE SPAN 3P 02170I P 183 1840PMSHSP 02180I* STANDARD COSTS 9.3P X 7 02190I* ADDED COSTS 02200I* 1 = LABOR 02210I* 2 = LABOR BURDEN 02220I* 3 = MATERIAL 02230I* 4 = MATERIAL BURDEN 02240I* 5 = OUTSIDE PROC 02250I* CUM COSTS ÐÐ02260I* 6 = LABOR 02270I* 7 = MATERIAL 02280I P 185 219 PA$ 02290I* STANDARD LABOR HOURS. 02300I* STD LOT SIZE 7P 02310I P 220 2230PMSLOT 02320I* STD SET-UP HRS 9.3P 02330I P 224 2283PMSSUH 02340I* STD RUN HRS 9.3P 02350I P 229 2333PMSRH 02360I* STD COST DATE 6N 02370I 234 2390PMSDAT 02380I* STD COST CODE 1A 02390I* E = ESTIMATED 02400I* H = HISTORICAL 02410I* X = ACCOUNTING 02420I 240 240 PMSCCD 02430I* AVER LABOR **** 7.2P 02440I P 241 2442PMOSAL 02450I* CURRENT COSTS 9.3P X 7 02460I* ADDED COSTS 02470I* 1 = LABOR 02480I* 2 = LABOR BURDEN 02490I* 3 = MATERIAL 02500I* 4 = MATERIAL BURDEN ÐÐ02510I* 5 = OUTSIDE PROC 02520I* CUM COSTS 02530I* 6 = LABOR 02540I* 7 = MATERIAL 02550I P 245 279 PM$ 02560I* CURRENT LABOR HOURS. 02570I* CUR LOT SIZE 7P 02580I P 280 2830PMCLOT 02590I* CUR SET-UP HRS 9.3P 02600I P 284 2883PMCSUH 02610I* CUR RUN HRS 9.3P 02620I P 289 2933PMCRH 02630I* CUR COST DATE 6N 02640I 294 2990PMCDAT 02650I* CUR COST CODE 1A 02660I* E = ESTIMATED 02670I* H = HISTORICAL 02680I* X = ACCOUNTING 02690I 300 300 PMCCCD 02700I* PREV MO STK BAL **** 7P 02710I P 301 3040PMPMSB 02720I* DATE LAST TRAN 6N 02730I 305 3100PMDLT 02740I* CALCULATED DATA. 02750I* CURRENT BALANCES. ÐÐ02760I* ON HAND STOCK 7P 02770I P 311 3140PMOHB 02780I* REQUIRED QTYS. 02790I* FORECAST BAL 7P 02800I P 315 3180PMFRCB 02810I* ALLOCATIONS 7P 02820I P 319 3220PMALB 02830I* REL REQS 7P 02840I P 323 3260PMRLB 02850I* SALES BACKLOG 7P 02860I P 327 3300PMSOB 02870I* QUOTES 7P 02880I P 331 3340PMQTB 02890I* BACKORDERS 7P 02900I P 335 3380PMBOB 02910I* ON ORDER BALANCES. 02920I* PURCHASE REQS 7P 02930I P 339 3420PMPRB 02940I* PURCH ORDERS 7P 02950I P 343 3460PMPOB 02960I* RECD P.O. 7P 02970I P 347 3500PMRPOB 02980I* OPEN WORK ORDER 7P 02990I P 351 3540PMPWOB 03000I* REL WORK ORDER 7P ÐÐ03010I P 355 3580PMRWOB 03020I* PAST USAGE. 03030I* PLANNED USAGE QTYS. 03040I* SHIPPED QTYS 7P 03050I P 359 3620PMPSHP 03060I* ISSUE QTYS 7P 03070I P 363 3660PMPISS 03080I* RECEIPT QTYS 7P 03090I P 367 3700PMPRCT 03100I* SCRAP QTYS 7P 03110I P 371 3740PMPSCR 03120I* UNPLANNED USAGE QTYS. 03130I* SHIPPED QTYS 7P 03140I P 375 3780PMUSHP 03150I* ISSUE QTYS 7P 03160I P 379 3820PMUISS 03170I* RECEIPT QTYS 7P 03180I P 383 3860PMURCT 03190I* SCRAP QTYS 7P 03200I P 387 3900PMUSCR 03210I* CUST RET $ 7P 03220I P 391 3940PMUCRT 03230I* PLANNED USAGE FREQ. 03240I* SHIPPED 5P 03250I P 395 3970PMFSHP ÐÐ03260I* ISSUE 5P 03270I P 398 4000PMFISS 03280I* RECEIPT 5P 03290I P 401 4030PMFRCT 03300I* SCRAP 5P 03310I P 404 4060PMFSCR 03320I* UNPLANNED USAGE FREQ. 03330I* SHIPPED 5P 03340I P 407 4090PMQSHP 03350I* ISSUE 5P 03360I P 410 4120PMQISS 03370I* RECEIPT 5P 03380I P 413 4150PMQRCT 03390I* SCRAP 5P 03400I P 416 4180PMQSCR 03410I* CUST RET 5P 03420I P 419 4210PMQCRT 03430I* BACKORDER FREQ 5P 03440I P 422 4240PMFBO 03450I* USAGE RATIO .7P 03460I P 425 4287PMRATO 03470I* INVENTORY CLASS 1A 03480I 429 429 PMINVC 03490I* LOW LEVEL CODE 2N 03500I 430 4310PMLL ÐÐ03510I* PHYSICAL INVENTORY. 03520I* CYCLE INV FREQ 3P 03530I P 432 4330PMFCYC 03540I* DATE LAST CYCLE 6N 03550I 434 4390PMDLCI 03560I* ADJ FREQ 3P 03570I P 440 4410PMFADJ 03580I* ADJ NET VALUE $ 9.2P 03590I P 442 4462PMVADJ 03600I* LAST SALE INFO. 03610I* LAST SALE DATE 6N 03620I 447 4520PMDLS 03630I* LAST SALE QTY 7P 03640I P 453 4560PMLSQ 03650I* LAST SALE PRICE 9.3P 03660I P 457 4613PMLSP 03670I* LAST BUY INFO. 03680I* LAST BUY DATE 6N 03690I 462 4670PMDLB 03700I* LAST BUY QTY 7P 03710I P 468 4710PMLBQ 03720I* LAST BUY PRICE 9.3P 03730I P 472 4763PMLBP 03740I* DATE LAST STK TRANS 6N 03750I 477 4820PMDLST ÐÐ03760I* OLD STYLE PART MASTER FIELDS. HRS=ACCOUNTING STD HRS 03770I* AVER LABOR 7.2P P 241 2442PMOSAL 03780I* PREV MO STK BAL 7P P 301 3040PMPMSB 03790I* DEVALUED CODE 1A 03800I 483 483 PMDVAL 03810I*** LOT QTY 5P 03820I*** P 484 4860PMOSLQ 03830I* FAB CODE 2A 03840I 487 488 PMFABC 03850I*** STD UNIT COST 9.3P 03860I P 489 4933PMOSUC 03870I*** LEAD TIME 3P 03880I*** P 494 4950PMOSLT 03890I* OLD STYLE MCN 5A 03900I 496 500 PMMCN 03910I* SPARES CODE 1A 03920I 501 501 PMSPAR 03930I* GSA PRICE 9.2P 03940I P 502 5062PMGSA 03950I* SET-UP PRICE 9.2P 03960I P 507 5112PMSUPR 03970I* LIST PRICE 9.2P 03980I P 512 5162PMLPR 03990I* PMDESCR FILE KEY CODE 3P 04000I P 517 5180PMPDKC ÐÐ04010I* LAST PRICE UPDATE DATE 6N 04020I 519 5240PMLPUD 04030I* ACCOUNTING ROUTING HRS 3 X 7.3P 04040I P 525 536 AHR 04050I* ACCOUNTING ROUTING DEPT 3 X 3P 04060I P 537 542 ADP 04070I* MFG ROUTING HRS 12 X 7.3P 04080I P 543 590 MHR 04090I* MFG ROUTING DEPT 12 X 3P 04100I P 591 614 MDP 04110I* TOT STD COST - MFG 9.3P 04120I P 615 6193PMTCST 04130I* DELETE CANDIDATE FLAG 1A (*) 04140I 620 620 PMDELC 04150I* RECORD STATUS 1A 04160I* D = DELETED 04170I 674 674 PMSTAT 04180C******************************************************************** 04190C* INITIALIZE 04200C EXSR SR101 1-TIME INIT 04210C MOVE ' ' BLK6 6 04220C*------------------------------------------------------------------ 04230C START TAG 04240C* SET-UP 1ST FIELD NO. 04250C MOVE ' ' DUN INIT EDIT ARRAY ÐÐ04260C Z-ADD1 F 30 FIELD # 04270C N99 GOTO READ NOT FROM ADD PROG 04280C MOVELCRPN TPN 100 PART # 04290C EXSR SR201 IDENTIFY F 04300C GOTO EDIT SKIP 1ST READ 04310C*------------------------------------------------------------------ 04320C NEXT TAG 04330C* SET-UP NEXT FIELD NO. 04340C 1 ADD F F FIELD # 04350C*----------------------------------------------------------------- 04360C READ TAG 04370C* READ DATA FROM TERMINAL. 04380C SETOF 909677 04390C EXSR SR102 VALIDATE FIELD # 04400C 55 GOTO UPDATE DONE 04410C EXSR SR201 IDENTIFY F 04420C 09 GOTO NEXT 04430C 01 49 GOTO NEWITM 04440C F COMP 1 54 04450C 55N49 Z-ADD1 F 04460C 55N49 EXSR SR201 IDENTIFY-F 04470C 08 04480COR 09 04490COR 10 04500COR 11 ÐÐ04510COR 19 04520COR 27 04530COR 31 04540COR 32 04550COR 33 04560COR 34 GOTO NEXT 04570C EXSR SR75 READ TERMINAL 04580C 90 EXSR SR72 REWRITE INPUT DATA 04590C 92 GOTO JUMP FIELD JUMP REQST 04600C 91 GOTO NEXT SKIP FORWARD 04610C*----------------------------------------------------------------- 04620C CONTU TAG 04630C 89 F SUB 1 F SKIP BACKWARD 04640C 89 EXSR SR201 CLASSIFY F 04650C 89 SETOF 54 04660C 89 08 04670COR 89 09 04680COR 89 10 04690COR 89 11 04700COR 89 19 04710COR 89 27 04720COR 89 31 04730COR 89 32 04740COR 89 33 04750COR 89 34 SETON 54 ÐÐ04760C 89 54 GOTO CONTU 04770C 89 GOTO READ 04780C 88 SETOF 90 SPACE FILL 04790C 88 SETON 77 " " 04800C 87 GOTO START 04810C 86 GOTO UPDATE UPDATE 04820C 85 GOTO READ REPEAT 04830C 96 GOTO ERROR ERROR 04840C N77 GOTO EDIT NO DATA INPUT 04850C*------------------------------------------------------------------ 04860C PROCES TAG 04870C* PROCESS INPUT DATA 04880C EXSR SR103 MOVE DATA 04890C*------------------------------------------------------------------- 04900C EDIT TAG 04910C N96 EXSR SR104 EDIT DATA 04920C EXSR SR72 REWRITE DATA 04930C 96 GOTO ERROR ERROR 04940C GOTO NEXT 04950C*------------------------------------------------------------------ 04960C UPDATE TAG 04970C* UPDATE DATA BASE. 04980C EXSR SR105 FINAL EDIT 04990C 96 GOTO ERROR ERROR 05000C EXSR SR106 UPDATE ÐÐ05010C 96 GOTO ERROR ERROR 05020C GOTO NEWITM 05030C*------------------------------------------------------------------- 05040C JUMP TAG 05050C* SET-UP JUMP TO REQUESTED FIELD 05060C 1 ADD W W 30 05070C W COMP 12 54 05080C 54 Z-ADD318 M 50 96 FLAG ERROR 05090C 54 GOTO ERROR BAD ESC 05100C MOVE ' ' W3A 3 05110C MOVEAA12,W W3A 05120C Z-ADD3 W2N 20 05130C EXIT SUBRAJ R. JUSTIFY 05140C RLABL W2N 05150C RLABL W3A 05160C MOVE W3A F NEW FIELD # 05170C GOTO READ 05180C*-------------------------------------------------------------------- 05190C ERROR TAG 05200C EXSR SR102 VALIDATE FIELD # 05210C EXSR SR89 GET MSG 05220C EXSR SR73 PUT MSG 05230C GOTO READ 05240C*------------------------------------------------------------------ 05250C NEWITM TAG ÐÐ05260C* SET-UP LINK FOR NEW ITEM 05270C 99 GOTO MENU 05280C MOVEL'Q028PM' PROG 05290C GOTO END 05300C*------------------------------------------------------------------- 05310C MENU TAG 05320C* SET-UP LINK TO MENU 05330C EXSR SR96 GET CRTFILE 05340C Z-ADD1 W 05350C BLK6 LOKUPLNK,W 54 05360C 54 MOVELLNK,W PROG 05370C 54 MOVE BLK6 LNK,W 05380C N54 MOVEL'CONTU' PROG 05390C 99 MOVEL'Q027PM 'PROG 05400C EXSR SR97 UPD CRTFILE 05410C EXSR SR98 >>>>>>>>>> 05420C*-------------------------------------------------------------------- 05430C GOODBY TAG 05440C* LINK TO SIGN-OFF 05450C 99 GOTO MENU 05460C MOVEL'GOODBY' PROG 8 05470C GOTO END 05480C*------------------------------------------------------------------- 05490C END TAG 05500C 99 GOTO MENU ÐÐ05510C EXSR SR96 GET CRTFILE 05520C 99 MOVEL'Q027PM 'PROG 05530C EXSR SR97 UPD CRTFILE 05540C EXSR SR98 >>>>>>>>>> 05550C*------------------------------------------------------------------- 05560C ENDJOB TAG 05570C MOVEL'ENDJOB' PROG 05580C EXSR SR98 >>>>>>>>>> 05590C******************************************************************** 05600CSR SR1 BEGSR 05610C* EDIT PART# 05620CSR TPN COMP 0 54 05630CSRN54 Z-ADD299 M 96 FLAG ERROR 05640CSRN54 GOTO END1 05650CSR EXSR SR80 GET PMMST 05660CSRN60N61 GOTO T1A GOT IT 05670CSR Z-ADD291 M 96 FLAG ERROR 05680CSR GOTO END1 05690C*--------------------------------------------------------------- 05700CSR T1A TAG 05710CSR SETON 49 05720CSR EXSR SR71 PUT SCREEN 05730CSR END1 ENDSR 05740C****************************************************************** 05750CSR SR2 BEGSR ÐÐ05760C* EDIT PROD CONTROL LEAD TIME 05770CSR PLT,1 COMP 0 54 05780CSRN54 Z-ADD407 M 05790CSRN54 EXSR SR74 WARNING 05800CSR ENDSR 05810C************************************************************** 05820CSR SR3 BEGSR 05830C* EDIT PURCH LEAD TIME 05840CSR PLT,2 COMP 0 54 05850CSR 54 GOTO T2A LT EXISTS 05860CSR EXSR SR305 CLASSIFY SOURCE 05870CSR 55 Z-ADD408 M 05880CSR 55 EXSR SR74 WARNING 05890CSR GOTO END3 05900C*------------------------------------------------------------- 05910CSR T2A TAG 05920CSR EXSR SR305 CLASSIFY SOURCE 05930CSRN55 Z-ADD409 M 05940CSRN55 EXSR SR74 WARNING 05950CSR END3 ENDSR 05960C*************************************************************** 05970CSR SR5 BEGSR 05980C* EDIT STOCK PULL LEAD TIME 05990CSR PLT,2 COMP 0 54 06000CSR 54 GOTO T5A LT EXISTS ÐÐ06010CSR EXSR SR305 CLASSIFY SOURCE 06020CSR 58 Z-ADD410 M 06030CSR 58 EXSR SR74 WARNING 06040CSR GOTO END5 06050C*---------------------------------------------------------------- 06060CSR T5A TAG 06070CSR EXSR SR305 CLASSIFY SOURCE 06080CSRN58 Z-ADD411 M 06090CSRN58 EXSR SR74 WARNING 06100CSR END5 ENDSR 06110C***************************************************************** 06120CSR SR6 BEGSR 06130C* EDIT SHOP LEAD TIME 06140CSR PLT,4 COMP 0 54 06150CSR 54 GOTO T6A LT EXISTS 06160CSR EXSR SR305 CLASSIFY SOURCE 06170CSR 56 Z-ADD412 M 06180CSR 56 EXSR SR74 WARNING 06190CSR GOTO END6 06200C*--------------------------------------------------------------- 06210CSR T6A TAG 06220CSR EXSR SR305 CLASSIFY SOURCE 06230CSRN56 Z-ADD413 M 06240CSRN56 EXSR SR74 WARNING 06250CSR END6 ENDSR ÐÐ06260C*************************************************************** 06270CSR SR30 BEGSR 06280C* EDIT EOQ 06290CSR PMEOQ COMP ' ' 54 06300CSR PMEOQP COMP ' ' 55 06310CSR 54N55 06320CORN54 55 Z-ADD19 M 96 FLAG ERROR 06330CSR ENDSR 06340C*************************************************************** 06350CSR SR50 BEGSR 06360C* EDIT MIN-MAX 06370CSR PMM,4 COMP 0 54 ORDER QTY 06380CSR PMM,4 COMP PMM,1 55 55 06390CSR 54N55 Z-ADD292 M 96 FLAG ERROR 06400CSR 96 Z-ADD24 F 06410CSR 96 GOTO END50 06420CSR PMM,5 COMP 0 54 06430CSR PMM,5 COMP PMM,2 55 55 06440CSR 54N55 Z-ADD414 M 96 FLAG ERROR 06450CSR 96 Z-ADD25 F 06460CSR 96 GOTO END50 06470CSR PMM,6 COMP 0 54 06480CSR PMM,6 COMP PMM,3 55 55 06490CSR 54N55 Z-ADD292 M 96 FLAG ERROR 06500CSR 96 Z-ADD26 F ÐÐ06510CSR 96 GOTO END50 06520CSR END50 ENDSR 06530C******************************************************************** 06540CSR SR69 BEGSR 06550C* POSITION CURSOR. 06560CSR EXITFQXYPOS MOVE CURSOR 06570CSR RLABL W6A 06580CSR ENDSR 06590C***************************************************************** 06600CSR SR70 BEGSR 06610C* GET PAGE 2. 06620CSR MOVE '060001' W6A 6 06630CSR EXSR SR69 POSITION CURSOR 06640CSR MOVE '031001' W6A 06650CSR EXSR SR69 POSITION CURSOR 06660CSR ENDSR 06670C********************************************************************** 06680CSR SR71 BEGSR 06690C* PUT HEADINGS TO TERMINAL 06700CSR EXSR SR70 CLEAR SCREEN 06710CSR SETON 71 06720CSR EXCPT PUT HEADINGS 06730CSR SETOF 71 06740CSR ENDSR 06750C********************************************************************* ÐÐ06760CSR SR72 BEGSR 06770C* PUT DATA LINE TO CRT 06780CSR PMDELC COMP '*' 70 DELETE CANDIDATE 06790CSR MOVELLOC,F W3N 30 06800CSR W3N SUB 1 W3N 06810CSR 70 01 W3N SUB 1 W3N 06820CSR MOVELW3N W6A 6 06830CSR MOVE '001' W6A X-Y POSITION 06840CSR EXSR SR69 MOVE CURSOR 06850CSR SETON 72 06860CSR EXCPT PUT DATA 06870CSR SETOF 72 06880CSR ENDSR 06890C*********************************************************************** 06900CSR SR73 BEGSR 06910C* PUT ERROR MESSAGE TO TERMINAL 06920CSR SETON 73 06930CSR EXCPT PUT MSG 06940CSR SETOF 73 06950CSR Z-ADDM LSTERR 50 06960CSR ENDSR 06970C******************************************************************** 06980CSR SR74 BEGSR 06990C* PUT WARNING TO CRT. 07000CSR EXSR SR89 GET MSG. ÐÐ07010CSR SETON 74 07020CSR EXCPT PUT MSG. 07030CSR SETOF 74 07040CSR Z-ADDM LSTERR 07050CSR ENDSR 07060C******************************************************************* 07070CSR SR75 BEGSR 07080C* READ FROM TERMINAL 07090CSR SETOF 779096 07100CSR SETOF 939291 07110CSR SETOF 898887 07120CSR SETOF 8685 07130CSR MOVE BIT,28 A9,1 07140CSR MOVE '8' A9,2 07150CSR MOVEALOC,F A9,3 07160CSR MOVE BIT,8 A9,9 07170CSR MOVEAA9 W9A 9 07180CSR MOVE BIT,7 BUFLGT 2 READ BUFFER LGTH 07190CSR MOVE BLK12 W12A 12 BUFFER 07200CSR EXITFQPREED READ FROM TERMINAL 07210CSR RLABL W9A 07220CSR RLABL W12A READ BUFFER 07230CSR RLABL BUFLGT READ BUFFER LGTH 07240CSR MOVEAW12A A12 INPUT DATA ARRAY 07250CSR MOVE BLK12 W12A INIT INPUT ARRAY ÐÐ07260CSR Z-ADD1 W 30 07270CSR '\' LOKUPA12,W 90 FLAG ESC 07280CSRN90 GOTO T75B NOT ESC 07290CSR 1 ADD W W 07300CSR W COMP 12 54 07310CSR 54 GOTO T75A BAD ESC 07320CSR A12,W COMP 'G' 98 GOODBY 07330CSR A12,W COMP 'E' 94 MENU 07340CSR A12,W COMP 'N' 93 NEW ITEM 07350CSR A12,W COMP 'J' 92 JUMP 07360CSR A12,W COMP 'F' 91 SKIP FRWRD 07370CSR A12,W COMP 'B' 89 SKIP BKWRD 07380CSR A12,W COMP 'S' 88 SPACE FILL 07390CSR A12,W COMP 'H' 87 HOME 07400CSR A12,W COMP 'U' 86 UPDATE 07410CSR A12,W COMP 'R' 85 REPEAT 07420CSR 98 GOTO GOODBY 07430CSR 94 GOTO MENU 07440CSR 93 GOTO NEWITM 07450CSR 92 07460COR 91 07470COR 89 07480COR 88 07490COR 87 07500COR 86 ÐÐ07510COR 85 GOTO END75 GOOD ESC 07520C*------------------------------------------------------------------ 07530CSR T75A TAG 07540C* FLAG BAD ESC INPUT 07550CSR Z-ADD318 M 96 FLAG ERROR 07560CSR GOTO END75 07570C*-------------------------------------------------------------------- 07580CSR T75B TAG 07590C* MOVE DATA 07600CSR Z-ADD1 W 07610CSR ' ' LOKUPA12,W 77 07620CSR 77 MOVEAA12,W W12A INPUT DATA 07630C*-------------------------------------------------------------------- 07640CSR END75 TAG 07650C* INIT PREV ERROR MSG. 07660CSR LSTERR COMP 0 54 07670CSR 54 MOVE BLK35 MGTEXT 07680CSR 54 EXSR SR73 BLANK MESSAGE 07690CSR Z-ADD0 LSTERR 50 07700CSR ENDSR 07710C********************************************************************** 07720CSR SR80 BEGSR 07730C* GET MASTER RECORD 07740CSR Z-ADD0 TOTWOB 70 07750CSR MOVELTPN PART12 12 ÐÐ07760CSR SETOF 61 07770CSR PART12 CHAINPMMST2 60 GET MASTER 07780CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE 07790CSR 60 MOVE 'N' IOFLAG 1 07800CSR 61 MOVE 'D' IOFLAG 07810CSR 60 07820COR 61 GOTO END80 07830CSR PMPWOB ADD PMRWOB TOTWOB 70 07840CSR EXSR SR305 CLASSIFY SOURCE CODE 07850CSR XFOOTPLT LTTOT 40 07860CSR 56 LTTOT SUB PLT,8 LTTOT 07870CSR EXSR SR401 LOKUPS 07880CSR EXSR SR402 COMPUTE LEAD TIME 07890CSR END80 ENDSR 07900C*********************************************************************** 07910CSR SR82 BEGSR 07920C* REWRITE MASTER 07930CSR SETON 82 07940CSR EXCPT REWRITE MASTER 07950CSR SETOF 82 07960CSR ENDSR 07970C********************************************************************** 07980CSR SR89 BEGSR 07990C* GET MESSAGE MASTER 08000CSR M CHAINMGFILE 54 ÐÐ08010CSR 54 MOVE BLK35 MGTEXT 08020CSR 54 MOVELM MGTEXT 08030CSR 54 MOVE MES,1 MGTEXT 08040CSR ENDSR 08050C******************************************************************** 08060CSR SR96 BEGSR 08070CSR # CHAINCRTFILE H9 GET CRTFILE 08080CSR H9 GOTO ENDJOB 08090CSR ENDSR 08100C******************************************************************** 08110CSR SR97 BEGSR 08120C* UPDATE CRTFILE. 08130CSR TIME CRTIME 08140CSR MOVELUDATE CRDATE 08150CSR SETON 97 08160CSR EXCPT UPD CRTFILE 08170CSR SETOF 97 08180CSR ENDSR 08190C******************************************************************** 08200CSR SR98 BEGSR 08210CSR EXITFCHAIN >>>>>>>>>> 08220CSR RLABL PROG 08230CSR ENDSR 08240C*********************************************************************** 08250CSR SR101 BEGSR ÐÐ08260C* 1-TIME INITIALIZE 08270CSR MOVE BIT,1 NUL 08280CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 08290CSR Z-ADD38 FLIMIT 30 TOTAL NUMB FIELDS 08300CSR MOVE ' ' BLK12 12 08310C* GET PORT # AND CRTFILE 08320CSR MOVE ' ' W2A 2 08330CSR EXITFZGMINX GET PORT # 08340CSR RLABL W2A 08350CSR MOVE W2A # 20 PORT NO. 08360CSR # COMP 0 54 08370CSRN54 Z-ADD25 # DEFAULT 08380CSR EXSR SR96 GET CRTFILE 08390CSR MOVE CALL LNK 08400CSR MOVE 'Q028PM 'PROG 08410CSR EXSR SR97 UPD CRTFILE 08411CSR MOVE ' 'PROG 08420CSR Z-ADD1 W 08430CSR BLK6 LOKUPLNK,W 54 08440CSR 54 LNK,W COMP 'Q027PM' 54 08450CSR 54 CRKFLG COMP 'K' 99 08460CSRN54 EXSR SR71 PUT INIT SCREEN 08470C* DEFINE WORK FIELDS,ETC. 08480CSR MOVE ' ' BLK35 35 08490CSR MOVE ' ' BLK8 8 ÐÐ08500CSR END101 ENDSR 08510C********************************************************************** 08520CSR SR102 BEGSR 08530C* VALIDATE FIELD NO. 08540CSR F COMP 0 54 08550CSRN54 Z-ADD1 F 08560CSR F COMP FLIMIT 55 08570CSR 55 Z-ADD1 F 08580CSR ENDSR 08590C******************************************************************** 08600CSR SR103 BEGSR 08610C* MOVE INPUT DATA 08620CSR EXSR SR201 IDENTIFY-F 08630CSR EXSR SR202 R. JUSTIFY 08640CSR 01 MOVE W12A TPN 100 PART # 08650CSR 02 MOVE W12A PLT,1 P.C.LEAD 08660CSR 03 MOVE W12A PLT,2 PURCH LEAD 08670CSR 04 MOVE W12A PLT,3 VEND LEAD 08680CSR 05 MOVE W12A PLT,4 ISSUE LEAD 08690CSR 06 MOVE W12A PLT,5 SHOP LEAD 08700CSR 07 MOVE W12A PLT,6 INSP LEAD 08710CSR 08 MOVE W12A PLT,7 STK RECV LEAD 08720CSR 09 MOVE W12A PLT,8 SAFETY LEAD 08730CSR 12 MOVE W12A PHZ,1 SALES HORIZON 08740CSR 13 MOVE W12A PHZ,2 PROD-REL HORIZ ÐÐ08750CSR 14 MOVE W12A PHZ,3 PROD-PLAN HORIZ 08760CSR 15 MOVE W12A PHZ,4 FORECAST HORIZ 08770CSR 16 MOVE W12A PHZ,5 SAFETY STK HORIZ 08780CSR 17 MOVELW12A PMINVC INV CLASS 08790CSR 18 MOVE W12A PMFCYC INV FREQ 08800CSR 20 MOVE W12A PMM,1 MIN ORD SPAN 08810CSR 21 MOVE W12A PMM,2 MIN ORD QTY 08820CSR 22 MOVE W12A PMM,3 MIN ORD $$$ 08830CSR 23 MOVE W12A PMM,4 MAX ORD SPAN 08840CSR 24 MOVE W12A PMM,5 MAX ORD QTY 08850CSR 25 MOVE W12A PMM,6 MAX ORDER $ 08860CSR 26 MOVE W12A PMSSTK SAFETY STOCK QTY 08870CSR 28 MOVE W12A PMRNDF ROUNDING FACTOR 08880CSR 29 MOVELW12A PMEOQ EOQ CODE 08890CSR 30 MOVELW12A PMEOQP EOQ PARAM. 08900CSR 35 MOVE W12A PMSQTY SURPLUS QTY 08910CSR 36 MOVE W12A PMSPCT SURPLUS % 08920CSR 37 MOVE W12A PMSSP SURPLUS SPAN 08930CSR 38 MOVE W12A PMSHSP SHORTAGE SPAN 08940CSR MOVE ' ' DUN,F EDIT FLAG 08950CSR ENDSR 08960C******************************************************************** 08970CSR SR104 BEGSR 08980C* EDIT INPUT DATA 08990CSR 01N79 EXSR SR1 ÐÐ09000CSR 02 EXSR SR2 09010CSR 03 EXSR SR3 09020CSR 05 EXSR SR5 09030CSR 06 EXSR SR6 09040CSR 24 09050COR 25 09060COR 26 09070COR 27 09080COR 30 EXSR SR50 EDIT MIN MAX 09090CSR F COMP 2 54 54 09100CSR 54 F COMP 9 5454 09110CSR 54 EXSR SR402 TOTAL LT 09120CSR 96 MOVE ' ' DUN,F EDIT FLAG 09130CSRN96 MOVE 'X' DUN,F 09140CSR ENDSR 09150C*********************************************************************** 09160CSR SR105 BEGSR 09170C* FINAL EDIT 09180CSR SETOF 77 09190CSR SETON 79 FINAL EDIT FLAG 09200CSR Z-ADD1 F 96 09210C*-------------------------------------------------------------------- 09220CSR T105A TAG 09230CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 09240CSRN54 GOTO END105 ÐÐ09250CSR EXSR SR201 IDENTIFY-F 09260CSR EXSR SR104 EDIT 09270CSRN96 GOTO T105A 09280C*-------------------------------------------------------------------- 09290CSR END105 TAG 09300CSR SETOF 79 09310CSR ENDSR 09320C******************************************************************** 09330CSR SR106 BEGSR 09340C* UPDATE DATA BASE. 09350C* CHANGE TRANSACTION. 09360CSR IOFLAG COMP 'N' 60 09370CSR IOFLAG COMP 'D' 61 09380CSRN60N61 GOTO T106E GOT IT 09390C* FLAG NO MASTER ERROR 09400CSR Z-ADD302 M 96 FLAG ERROR 09410CSR Z-ADD1 F FIELD # 09420CSR GOTO END106 09430C*----------------------------------------------------------------------- 09440CSR T106E TAG 09450C* REWRITE MASTER 09460CSR EXSR SR82 REWRITE MAST 09470CSR END106 ENDSR 09480C************************************************************************ 09490CSR SR201 BEGSR ÐÐ09500C* IDENTIFY FIELD NO. 09510CSR F COMP 30 54 09520CSR 54 GOTO T201C 09530CSR F COMP 20 54 09540CSR 54 GOTO T201B 09550CSR F COMP 10 54 09560CSR 54 GOTO T201A 09570CSR EXSR SR302 SET-OFFS 09580CSR EXSR SR303 SET-OFFS 09590CSR EXSR SR304 SET-OFFS 09600CSR F COMP 1 01 09610CSR F COMP 2 02 09620CSR F COMP 3 03 09630CSR F COMP 4 04 09640CSR F COMP 5 05 09650CSR F COMP 6 06 09660CSR F COMP 7 07 09670CSR F COMP 8 08 09680CSR F COMP 9 09 09690CSR F COMP 10 10 09700CSR GOTO END201 09710C*------------------------------------------------------------------- 09720CSR T201A TAG 09730CSR F COMP 11 11 09740CSR F COMP 12 12 ÐÐ09750CSR F COMP 13 13 09760CSR F COMP 14 14 09770CSR F COMP 15 15 09780CSR F COMP 16 16 09790CSR F COMP 17 17 09800CSR F COMP 18 18 09810CSR F COMP 19 19 09820CSR F COMP 20 20 09830CSR EXSR SR301 SET-OFFS 09840CSR EXSR SR303 SET-OFFS 09850CSR EXSR SR304 SET-OFFS 09860CSR GOTO END201 09870C*------------------------------------------------------------------- 09880CSR T201B TAG 09890CSR F COMP 21 21 09900CSR F COMP 22 22 09910CSR F COMP 23 23 09920CSR F COMP 24 24 09930CSR F COMP 25 25 09940CSR F COMP 26 26 09950CSR F COMP 27 27 09960CSR F COMP 28 28 09970CSR F COMP 29 29 09980CSR F COMP 30 30 09990CSR EXSR SR301 SET-OFFS ÐÐ10000CSR EXSR SR302 SET-OFFS 10010CSR EXSR SR304 SET-OFFS 10020CSR GOTO END201 10030C*------------------------------------------------------------------- 10040CSR T201C TAG 10050CSR F COMP 31 31 10060CSR F COMP 32 32 10070CSR F COMP 33 33 10080CSR F COMP 34 34 10090CSR F COMP 35 35 10100CSR F COMP 36 36 10110CSR F COMP 37 37 10120CSR F COMP 38 38 10130CSR EXSR SR301 SET-OFFS 10140CSR EXSR SR302 SET-OFFS 10150CSR EXSR SR303 SET-OFFS 10160CSR END201 ENDSR 10170C********************************************************************** 10180CSR SR202 BEGSR 10190C* RIGHT JUSTIFY 10200CSR F LOKUPNUM 54 10210CSRN54 GOTO END202 NOT NUMERIC FIELD 10220CSR Z-ADD12 W2N 20 10230CSR EXIT SUBRAJ R. JUSTIFY 10240CSR RLABL W2N ÐÐ10250CSR RLABL W12A 10260CSR END202 ENDSR 10270C**************************************************************************10280CSR SR301 BEGSR 10290CSR SETOF 010203 10300CSR SETOF 040506 10310CSR SETOF 070809 10320CSR SETOF 10 10330CSR ENDSR 10340C******************************************************************** 10350CSR SR302 BEGSR 10360CSR SETOF 111213 10370CSR SETOF 141516 10380CSR SETOF 171819 10390CSR SETOF 20 10400CSR ENDSR 10410C******************************************************************** 10420CSR SR303 BEGSR 10430CSR SETOF 212223 10440CSR SETOF 242526 10450CSR SETOF 272829 10460CSR SETOF 30 10470CSR ENDSR 10480C******************************************************************** 10490CSR SR304 BEGSR ÐÐ10500CSR SETOF 313233 10510CSR SETOF 343536 10520CSR SETOF 3738 10530CSR ENDSR 10540C******************************************************************** 10550CSR SR305 BEGSR 10560C* CLASSIFY SOURCE CODE. 10570CSR MOVELPMSC W1A 1 10580CSR W1A COMP 'M' 56 MFG ITEM 10590CSR W1A COMP 'P' 55 PURCH ITEM 10600CSR MOVE PMSC W1A 10610CSR W1A COMP 'P' 57 PART 10620CSR W1A COMP 'A' 58 ASSY 10630CSR ENDSR 10640C******************************************************************** 10650CSR SR401 BEGSR 10660CSR PMISSU LOKUPTABISS TABICN 54 10670CSR PMSC LOKUPTABSC TABSCN 55 10680CSR PMUM LOKUPTABUM TABUMN 56 10690CSR PMPROV LOKUPTABPV TABPVN 57 10700CSR 54 MOVE TABICN ICNAME 15 10710CSR 55 MOVE TABSCN SCNAME 15 10720CSR 56 MOVE TABUMN UMNAME 15 10730CSR 57 MOVE TABPVN PVNAME 22 10740CSR ENDSR ÐÐ10750C**************************************************************** 10760CSR SR402 BEGSR 10770C* COMPUTE TOTAL LEAD TIME 10780CSR XFOOTPLT LTTOT 40 TOTAL LEAD TIME 10790CSR EXSR SR305 CLASSIFY SOURCE 10800CSR 56 LTTOT SUB PLT,8 LTTOT 10810CSR MOVE '047001' W6A 6 10820CSR EXSR SR69 POSITION CUROSR 10830CSR SETON 50 10840CSRN01 EXCPT PUT LEAD TIME TOT 10850CSR SETOF 50 10860CSR ENDSR 10870O*************************************************************** 10880OTERM132 E 71 10890O* PUT HEADING. 10900O BIT,28 1 10910O 8 '8031001' 10920O 58 'O R D E R' 10930O 72 'P O L I C Y' 10940O 86 'U P D A T E' 10950O*------------------------------------------------------------------- 10960O E 71 10970O 6 '(1)' 10980O*------------------------------------------------------------------- 10990O E 71 ÐÐ11000O 11 'PART-NUMBER' 11010O 25 'DESCRIPTION' 11020O 50 'MODEL' 11030O 63 'PROD' 11040O 76 'SOURCE-CODE' 11050O 92 'ISSUE-CODE' 11060O 107 'FAB-CODE' 11070O 121 'PROV-CODE' 11080O*------------------------------------------------------------------- 11090O E 71 11100O OR 72 01 70 11110O 71 1 ' ' 11120O 72 24 '*** DELETE CANDIDATE ***' 11130O*------------------------------------------------------------------- 11140O E 71 11150O OR 72 01 11160O PMPN 12 ' - - ' 11170O PMDESC 43 11180O PMMODL 57 11190O PMPL Z 63 11200O PMSC 67 11210O SCNAME 80 11220O PMISSU 84 11230O ICNAME 97 11240O PMFABC 101 ÐÐ11250O PMPROV 112 11260O PVNAME 132 11270O*------------------------------------------------------------------- 11280O E 71 11290O DIV 37 11300O 39 '--' 11310O DIV 76 11320O 77 '*' 11330O DIV 114 11340O DIV 132 11350O*------------------------------------------------------------------- 11360O E 71 11370O 33 'O R D E R' 11380O 47 'P O L I C Y' 11390O 77 '*' 11400O 100 'S T A T U S' 11410O 116 '/ H I S T O R Y' 11420O*------------------------------------------------------------------- 11430O E 71 11440O 10 'LEAD-TIMES' 11450O 19 '(M-DAYS)' 11460O 38 '*' 11470O 58 'LOT-SIZING-CRITERIA' 11480O 77 '*' 11490O 86 'ACTIVITY' ÐÐ11500O 110 'CURRENT-BALANCE' 11510O 120 'USAGE' 11520O 132 'FREQUENCY' 11530O*------------------------------------------------------------------- 11540O E 71 11550O OR 72 02 11560O OR 72 20 11570O 19 '(2) SCHEDULING ' 11580O 24 ':' 11590O PLT,1 Z 28 11600O 60 '(20) MIN ORDER SPAN' 11610O 64 ':' 11620O 38 '*' 11630O PMM,1 2 74 11640O 77 '*' 11650O 93 'ON-HAND-STOCK' 11660O 99 ':' 11670O PMOHB K 110 11680O*---------------------------------------------------------------- 11690O E 71 11700O OR 72 03 11710O OR 72 21 11720O 22 '(3) PLACE PO, PULL KIT' 11730O 25 ':' 11740O PLT,2 Z 28 ÐÐ11750O 38 '*' 11760O 45 '(21)' 11770O 59 'MIN ORDER QTY' 11780O 64 ':' 11790O PMM,2 2 74 11800O 77 '*' 11810O 91 'PURCH REQ''S' 11820O 99 ':' 11830O PMPRB K 110 11840O*--------------------------------------------------------------- 11850O E 71 11860O OR 72 04 11870O OR 72 22 11880O 13 '(4) VENDOR' 11890O 24 ':' 11900O PLT,3 Z 28 11910O 38 '*' 11920O 45 '(22)' 11930O 57 'MIN ORD $$$' 11940O 64 ':' 11950O PMM,3 2 74 11960O 77 '*' 11970O 92 'PURCH-ORDERS' 11980O 99 ':' 11990O PMPOB K 110 ÐÐ12000O*------------------------------------------------------------------- 12010O E 71 12020O OR 72 05 12030O OR 72 23 12040O 24 '(5) PRODUCTION :' 12050O PLT,4 Z 28 12060O 38 '*' 12070O 60 '(23) MAX ORDER SPAN' 12080O 64 ':' 12090O PMM,4 2 74 12100O 77 '*' 12110O 93 'RECEIVED-P.O.' 12120O 99 ':' 12130O PMRPOBK 110 12140O*------------------------------------------------------------------- 12150O E 71 12160O OR 72 06 12170O OR 72 24 12180O 21 '(6) INSPECT/TEST ' 12190O 24 ':' 12200O PLT,5 Z 28 12210O 38 '*' 12220O 45 '(24)' 12230O 59 'MAX ORDER QTY' 12240O 64 ':' ÐÐ12250O PMM,5 2 74 12260O 77 '*' 12270O 91 'WORK ORDERS' 12280O 99 ':' 12290O TOTWOBK 110 12300O*------------------------------------------------------------------- 12310O E 71 12320O OR 72 07 12330O OR 72 25 12340O 19 '(7) PUT IN STOCK' 12350O 24 ':' 12360O PLT,6 Z 28 12370O 38 '*' 12380O 45 '(25)' 12390O 59 'MAX ORDER $$$' 12400O 64 ':' 12410O PMM,6 2 74 12420O 77 '*' 12430O 92 'SALES ORDERS' 12440O 99 ':' 12450O PMSOB K 110 12460O*------------------------------------------------------------------- 12470O E 71 12480O OR 72 08 12490O OR 72 26 ÐÐ12500O 24 '(8) :' 12510O PLT,7 Z 28 12520O 38 '*' 12530O 45 '(26)' 12540O 62 'SAFETY STOCK QTY' 12550O 64 ':' 12560O PMSSTK2 74 12570O 77 '*' 12580O 94 'PROD-REQMT,REL' 12590O 99 ':' 12600O PMRLB K 110 12610O*------------------------------------------------------------------- 12620O E 71 12630O OR 72 09 12640O OR 72 27 12650O 18 '(9) CUM LEAD ' 12660O 24 ':' 12670O PLT,8 Z 28 12680O 38 '*' 12690O 45 '(27)' 12700O 64 ':' 12710O 77 '*' 12720O 98 'PROD-REQMT,PLANNED' 12730O 99 ':' 12740O PMALB K 110 ÐÐ12750O*------------------------------------------------------------------- 12760O E 71 12770O OR 72 28 12780O 38 '*' 12790O 61 '(28) ROUNDING FACTOR' 12800O 64 ':' 12810O PMRNDF2 74 12820O 77 '*' 12830O 88 'FORECAST' 12840O PMFRCBK 110 12850O 99 ':' 12860O*------------------------------------------------------------------- 12870O E 71 12880O OR 72 29 12890O OR 50 12900O 24 'TOTAL LEAD TIME:' 12910O LTTOT Z 28 12920O 38 '*' 12930O 45 '(29)' 12940O 57 'E.O.Q. CODE' 12950O 64 ':' 12960O PMEOQ 67 12970O 77 '*' 12980O 90 'BACKORDERS' 12990O 99 ':' ÐÐ13000O PMBOB K 110 13010O*------------------------------------------------------------------- 13020O E 71 13030O OR 72 30 13040O DIV 37 13050O 38 '*' 13060O 45 '(30)' 13070O 62 'E.O.Q. PARAMETER' 13080O 64 ':' 13090O PMEOQP 67 13100O 77 '*' 13110O 93 'AVAILABLE-BAL' 13120O 99 ':' 13130O*** *** *** AVAIL K 110 13140O*------------------------------------------------------------------- 13150O E 71 13160O 16 'PLANNING HORIZON' 13170O 31 'BY REQUIREMENT' 13180O 36 'TYPE' 13190O 38 '*' 13200O 39 '-' 13210O DIV 76 13220O 77 '*' 13230O 96 'CUSTOMER RETURNS' 13240O 99 ':' ÐÐ13250O PMUCRTK 122 13260O PMQCRTK 131 13270O*------------------------------------------------------------------- 13280O E 71 13290O OR 72 12 13300O 19 '(12) SALES ORDERS' 13310O 24 ':' 13320O PHZ,1 Z 28 13330O 38 '*' 13340O 55 'EXCEPTION-REPORT' 13350O 64 'CRITERIA' 13360O 77 '*' 13370O 85 'SCRAP' 13380O 99 ':' 13390O PMUSCRK 122 13400O PMQSCRK 131 13410O*------------------------------------------------------------------- 13420O E 71 13430O OR 72 13 13440O OR 72 35 13450O 22 '(13) PROD-REQMT, REL' 13460O 24 ':' 13470O PHZ,2 Z 28 13480O 38 '*' 13490O 45 '(35)' ÐÐ13500O 61 'MAX SURPLUS QTY' 13510O 64 ':' 13520O PMSQTY2 74 13530O 77 '*' 13540O 95 'UNPLANNED-USAGE' 13550O 99 ':' 13560O PMUISSK 122 13570O PMQISSK 131 13580O*------------------------------------------------------------------- 13590O E 71 13600O OR 72 14 13610O OR 72 36 13620O 23 '(14) PROD-REQMT, PLAN' 13630O 24 ':' 13640O PHZ,3 Z 28 13650O 38 '*' 13660O 59 '(36) MAX-SURPLUS %' 13670O 64 ':' 13680O PMSPCTZ 74 13690O 75 '%' 13700O 77 '*' 13710O 93 'PLANNED-USAGE' 13720O 99 ':' 13730O PMPISSK 122 13740O PMFISSK 131 ÐÐ13750O*------------------------------------------------------------------- 13760O E 71 13770O OR 72 15 13780O OR 72 37 13790O 15 '(15) FORECAST' 13800O 24 ':' 13810O PHZ,4 Z 28 13820O 38 '*' 13830O 45 '(37)' 13840O 62 'MAX-SURPLUS-SPAN' 13850O 64 ':' 13860O PMSSP 2 74 13870O 77 '*' 13880O 89 'SHIPMENTS' 13890O 99 ':' 13900O PMPSHPK 122 13910O PMFSHPK 131 13920O*------------------------------------------------------------------- 13930O E 71 13940O OR 72 16 13950O OR 72 38 13960O 19 '(16) SAFETY-STOCK' 13970O 24 ':' 13980O PHZ,5 Z 28 13990O 38 '*' ÐÐ14000O 45 '(38)' 14010O 63 'MAX-SHORTAGE-SPAN' 14020O 64 ':' 14030O PMSHSP2 74 14040O 77 '*' 14050O 96 'PLANNED-RECEIPTS' 14060O 99 ':' 14070O PMPRCTK 122 14080O PMFRCTK 131 14090O*------------------------------------------------------------------- 14100O E 71 14110O DIV 37 14120O 38 '*' 14130O 77 '*' 14140O*------------------------------------------------------------------- 14150O E 71 14160O OR 72 17 14170O 24 '(17) INVENTORY CLASS :' 14180O PMINVC 27 14190O 38 '*' 14200O 77 '*' 14210O 123 '* CURRENT-REV :' 14220O PMECHG 126 14230O*------------------------------------------------------------------- 14240O E 71 ÐÐ14250O OR 72 18 14260O 24 '(18) CYCLE INV FREQ :' 14270O PMFCYCZ 29 14280O 38 '*' 14290O 77 '*' 14300O 98 'NUMB OF COMPONENTS' 14310O 99 ':' 14320O PMNOBMZ 106 14330O 118 '* DWG-SIZE' 14340O 123 ':' 14350O PMSIZ 125 14360O*------------------------------------------------------------------- 14370O E 71 14380O 77 '*' 14390O 109 '*' 14400O*------------------------------------------------------------------- 14410O E 71 14420O OR 73 14430O OR 74 14440O BIT,28 1 14450O 8 '8060001' 14460O 46 '*' 14470O 21 ' ' 14480O 74 21 'W A R N I N G' 14490O 96 17 'E R R O R' ÐÐ14500O MGTEXT 59 14510O 85 '*' 14520O 102 'LOW-LEVEL-CODE' 14530O 107 ':' 14540O PMLL Z 110 14550O 117 '*' 14560O BIT,28 130 14570O 131 'K' 14580O 96 BIT,8 132 14590O 74 BIT,8 132 14600O******************************************************************** 14610OPMMST2 E 82 14620O PMNOBM 14P 14630O PMPL 18 14640O PMMODL 30 14650O PMDESC 59 14660O PMCC 64P 14670O PMECN 69 14680O PMECHG 71 14690O PMDCHG 77 14700O PMRELS 78 14710O PMINSP 81 14720O PMSIZ 82 14730O PMDCLS 83 14740O PMSTDC 84 ÐÐ14750O PMUM 86 14760O PMSC 95 14770O PMPROV 96 14780O PMISSU 98 14790O PMDEL 101P 14800O PMEGR 103 14810O PMPLNR 105 14820O PMBUYR 107 14830O PMSLSM 109 14840O PMACNT 112P 14850O PLT 128P 14860O PHZ 138P 14870O PMM 162P 14880O PMSSTK 166P 14890O PMRNDF 169P 14900O PMEOQ 171 14910O PMEOQP 173 14920O PMSQTY 177P 14930O PMSPCT 180P 14940O PMSSP 182P 14950O PMSHSP 184P 14960O PA$ 219P 14970O PMSLOT 223P 14980O PMCSUH 228P 14990O PMSRH 233P ÐÐ15000O PMSDAT 239 15010O PMSCCD 240 15020O PMOSAL 244P 15030O PM$ 279P 15040O PMCLOT 283P 15050O PMCSUH 288P 15060O PMCRH 293P 15070O PMCDAT 299 15080O PMCCCD 300 15090O PMPMSB 304P 15100O PMDLT 310 15110O PMOHB 314P 15120O PMFRCB 318P 15130O PMALB 322P 15140O PMRLB 326P 15150O PMSOB 330P 15160O PMQTB 334P 15170O PMBOB 338P 15180O PMPRB 342P 15190O PMPOB 346P 15200O PMRPOB 350P 15210O PMPWOB 354P 15220O PMRWOB 358P 15230O PMPSHP 362P 15240O PMPISS 366P ÐÐ15250O PMPRCT 370P 15260O PMPSCR 374P 15270O PMUSHP 378P 15280O PMUISS 382P 15290O PMURCT 386P 15300O PMUSCR 390P 15310O PMUCRT 394P 15320O PMFSHP 397P 15330O PMFISS 400P 15340O PMFRCT 403P 15350O PMFSCR 406P 15360O PMQSHP 409P 15370O PMQISS 412P 15380O PMQRCT 415P 15390O PMQSCR 418P 15400O PMQCRT 421P 15410O PMFBO 424P 15420O PMRATO 428P 15430O PMINVC 429 15440O PMLL 431 15450O PMFCYC 433P 15460O PMDLCI 439 15470O PMFADJ 441P 15480O PMVADJ 446P 15490O PMDLS 452 ÐÐ15500O PMLSQ 456P 15510O PMLSP 461P 15520O PMDLB 467 15530O PMLBQ 471P 15540O PMLBP 476P 15550O PMDLST 482 15560O PMDVAL 483 15570O PMFABC 488 15580O PMOSUC 493P 15590O PMMCN 500 15600O PMSPAR 501 15610O PMGSA 506P 15620O PMSUPR 511P 15630O PMLPR 516P 15640O PMPDKC 518P 15650O PMLPUD 524 15660O AHR 536P 15670O ADP 542P 15680O MHR 590P 15690O MDP 614P 15700O PMTCST 619P 15710O PMSTAT 674 15720O******************************************************************** 15730OCRTFILE E 97 15740O PROG 26 ÐÐ15750O CRTIME 33 15760O CRDATE 37 15770O LNK 79 15780O******************************************************************** ** NUL ARRAY 015790 015800** A12 ARRAY 015810 015820** NUM ARRAY 015830001 015840002 015850003 015860004 015870005 015880006 015890007 015900008 015910009 015920012 015930013 015940014 015950015 015960016 015970018 015980020 015990ÐÐ021 016000022 016010023 016020024 016030025 016040026 016050027 016060028 016070035 016080036 016090037 016100038 016110** DUN ARRAY 016120 016130** MES ARRAY 016140---MESSAGE NOT ON FILE--- 016150** LOC ARRAY 016160035001 1 16170039026 2 16180040026 3 16190041026 4 16200042026 5 16210043026 6 16220044026 7 16230045026 8 16240ÐÐ046026 9 16250 10 16260 11 16270051026 12 16280052026 13 16290053026 14 16300054026 15 16310055026 16 16320057026 17 16330058026 18 16340 19 16350039066 20 16360040066 21 16370041066 22 16380042066 23 16390043066 24 16400044066 25 16410045066 26 16420046066 27 16430047066 28 16440048066 29 16450049066 30 16460 31 16470 32 16480 33 16490ÐÐ 34 16500052066 35 16510053066 36 16520054066 37 16530055066 38 16540** TABISS/TABICN - ISSUE CODES 016550PTPULL TIME 016560ORON REQUEST 016570BIBULK ISSUE 016580ARAS REQD 016590VSVENDOR SUPL 016600SDSHIPPING DOC 016610TDTRAVELER DOC 016620RDREF DOC ONLY 016630RAREF ASSY/PART 016640** TABSC/TABSCN - SOURCE CODES 016650MAMFG ASSY 016660MPMFG PART 016670PAPURCH ASSY 016680PPPURCH PART 016690RSRAW STOCK 016700RDREF DOC ONLY 016710** TABUM/TABUMN - UNITS MEASURE 016720EAEACH 016730STSET 016740ÐÐININCH 016750FTFOOT 016760YDYARD 016770SISQ INCH 016780SFSQ FOOT 016790SYSQ YARD 016800OZOUNCE 016810TCTROY OZ 016820LBPOUND 016830PTPINT 016840QTQUART 016850GLGALLON 016860DRDRUM 016870** TABPV/TABPVN - PROVISIONING CODES/NAMES 016880AFRCST-NO VAL ADDED 016890BFRCST-VAL ADDED 016900CFRCST-BUILD TO ORD 016910DNON-FRCST-BUILD TO ORD 016920ECUSTOM 016930YOBSLETE-REPAIRABLE 016940ZOBSLETE-NO REPAIR 016950** A9 ARRAY 16960 16970** DIV ARRAY 016980------------------------------------- 016990ÐÐ** LNK ARRAY 017000 17010/* 17020_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ+ ó PXFILE V112183112183+ÝȺ 7041600200*** PARTS HAVE BEEN REJECTED BY Q.C. *** 0 7041600200*** PURCHASING IS WAITING FOR A REPLACEMENT DATE ***** 0 _‚_‚ ºÈ(,.o ,}X008PC P999999120282(èÈÐ00010H Q008PC00020F* LIST DIFFERENCE STD-VS-CUR COSTS, PMMST. (X008PC) 00030F* REVISED 3/31/81 4:15 PM. 00040FPMVAR IP F 2 DISK 00050FPMMST2 IS F 674 12AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070E******************************************************************** 00080E DIF 1 7 9 3 00090E D1 53 53 1 00100E D2 17 17 1 00110E PM$ 7 9 3 00120E PMA 7 9 3 00130I******************************************************************** 00140IPMVAR PV 03 00150I 1 22IPVAR 00160I******************************************************************** 00170IPMMST2 PM 01 674NCD 00180I* PART MAST FILE. 00190I* PART # 10N 00200I 1 100PMPN 00210I* PROD LINE 4N 00220I 15 180PMPL 00230I* MODEL NAME 12A 00240I 19 30 PMMODL 00250I* DESCRIPTION 29A ÐÐ00260I 31 59 PMDESC 00270I* UNIT MEASURE 2A 00280I 85 86 PMUM 00290I* SOURCE CODE 2A 00300I 94 95 PMSC 00310I* STD COST 7 X 9.3P 00320I P 185 219 PMA 00330I* CUR COST 7 X 9.3P 00340I P 245 279 PM$ 00350I* RECORD STATUS 1A 00360I 674 674 PMSTAT 00370I*------------------------------------------------------------------- 00380I GG 02 00390C******************************************************************** 00400C SETOF 80 00410C N01 GOTO END 00420C XFOOTPMA STDTOT 103 STD COST 00430C XFOOTPM$ MFGTOT 103 CUR COST 00440C PM$ SUB PMA DIF 00450C XFOOTDIF DIFTOT 103 00460C DIFTOT COMP 0 545556 00470C 55 Z-ADDDIFTOT W9D3 93 00480C 55 Z-SUBW9D3 W9D3 93 54 00490C N54 SETOF 01 00500C N54 GOTO END ÐÐ00510C W9D3 DIV STDTOT W2D2 22H 00520C W2D2 COMP IPVAR 54 54 00530C N54 SETOF 01 00540C*------------------------------------------------------------------- 00550C END TAG 00560C 01 SETON 80 00570CL0 80 SETON 81 00580CL0 80 EXCPT 00590CL0 80 SETOF 81 00600CL0 80 SETON 82 00610CL0 80 EXCPT 00620CL0 SETOF 82 00630O******************************************************************** 00640OPRINT H 101 1P 00650O OR OF 00660O UDATE Y 8 00670O 63 'STANDARD VS MFG' 00680O 76 'COST LISTING' 00690O 78 '-' 00700O IPVAR 1 81 00710O 93 '% OR GREATER' 00720O 127 'PAGE' 00730O PAGE Z 132 00740O*--------------------------------------------------------------- 00750O H 1 1P ÐÐ00760O OR OF 00770O 8 'PART-NO.' 00780O*------------------------------------------------------------------- 00790O H 1 1P 00800O OR OF 00810O 11 'DESCRIPTION' 00820O 22 'SC' 00830O 17 'PROD' 00840O D1 95 00850O D2 119 00860O 63 'ADDED' 00870O* * * * * 110 'CUM' 00880O*------------------------------------------------------------------- 00890O H 1 1P 00900O OR OF 00910O 5 'MODEL' 00920O 22 ' CLASS UM' 00930O 47 'LABOR' 00940O 59 'LAB-BURD' 00950O 71 'MATERIAL' 00960O* * * * * 83 'MATL-BURD' 00970O* * * * * 95 'VENDOR' 00980O* * * * * 107 'LABOR' 00990O* * * * * 119 'MATERIAL' 01000O 132 'TOTAL' ÐÐ01010O*------------------------------------------------------------------- 01020O D 11 01 01030O PMPN 12 ' - - ' 01040O 34 'STD' 01050O PMA,1 1 47 01060O PMA,2 1 59 01070O PMA,3 1 71 01080O* * * * * PMA,4 1 83 01090O* * * * * PMA,5 1 95 01100O* * * * * PMA,6 1 107 01110O* * * * * PMA,7 1 118 01120O STDTOT1 131 01130O 34 'STD' 01140O*------------------------------------------------------------------- 01150O E 1 81 01160O PMDESC 29 01170O 34 'MFG' 01180O PMSC 22 01190O PM$,1 1 47 01200O PM$,2 1 59 01210O PM$,3 1 71 01220O* * * * * PM$,4 1 83 01230O* * * * * PM$,5 1 95 01240O* * * * * PM$,6 1 107 01250O* * * * * PM$,7 1 118 ÐÐ01260O MFGTOT1 131 01270O*------------------------------------------------------------------- 01280O E 1 82 01290O PMMODL 12 01300O PMPL Z 18 01310O PMUM 22 01320O 34 'DIF' 01330O DIF,1 J 48 01340O DIF,2 J 60 01350O DIF,3 J 72 01360O* * * * * DIF,4 J 84 01370O* * * * * DIF,5 J 96 01380O* * * * * DIF,6 J 107 01390O* * * * * DIF,7 J 119 01400O DIFTOTJ 132 01410O*------------------------------------------------------------------- 01420O****** T 1 L0 80 U1 01430O****** W2D2 2 2 ** DIF ARRAY 001440 001450** D1 ARRAY 001460------------------------------------------------------------- 001470** D2 ARRAY 001480----------------------- 001490/* 001500ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È1¥ ÈTX039WO PRp999999120882(èÈÐ00010H Q039WO00020F* LIST NEWLY UPDATED REMARKS (X039WO) 00030F* REVISED 1-17-83 11:35 AM. 00040F* 00050FREMMAT UP AF 11 10AI 1 DISK 00060FREMARKS US AF 90 29AI 1 DISK 00070FPRINT O F 132 OF PRINTER 00080I******************************************************************* 00090IREMMAT RM 03 11NCD 00100I 1 100RMPN M1 00110I 11 11 RMSTAT 00120I RG 04 00130I******************************************************************** 00140IREMARKS RK 01 90NCD 00150I* PART # 10N 00160I 1 100RKPN L4M1 00170I* DUE DATE 6N (YMD) N O T U S E D 00180I 11 160RKDUE 00190I* RECORD CODE 2A 00200I 17 180RKREC L1 00210I* ORDER NO. 9A 00220I 19 27 RKWO 00230I 19 24 RKWOP L3 00240I 25 270RKWOD L2 00250I* LINE # 2N ÐÐ00260I 28 290RKLINE 00270I* TEXT 60A 00280I 30 89 RKTEXT 00290I* RECORD STATUS 1A 00300I 90 90 RKSTAT 00310I GG 02 00320C******************************************************************* 00330C SETOF 85 00340C N01 00350COR 01NMR GOTO END 00360C RKREC COMP 10 10 RECD PO 00370C RKREC COMP 20 12 REL WO 00380C RKREC COMP 30 13 PO 00390C RKREC COMP 40 14 OPEN WO 00400C RKREC COMP 50 15 PURCH REQ 00410C RKREC COMP 60 16 SALES ORDER 00420C RKREC COMP 70 17 REL REQMT 00430C RKREC COMP 80 18 OPEN REQMT 00440C RKREC COMP 90 19 FORECAST 00450C RKREC COMP 0 20 PART NO (ALL) 00460C RKWOD COMP 0 55 00470C RKSTAT COMP 'W' 85 00480C*-------------------------------------------------------------- 00490C END TAG 00500C 01NMR SETOF 01 ÐÐ00510O***************************************************************** 00520OREMARKS D 01 00530O 90 'W' 00540O****************************************************************** 00550OPRINT H 201 1P 00560O OR OF 00570O UDATE 8 ' - - ' 00580O 20 'OW930R' 00590O 78 'NEW EXPEDITING MESSAGES ' 00600O 127 'PAGE' 00610O PAGE Z 132 00620O H 2 1P 00630O OR OF 00640O 8 'PART-NO.' 00650O 21 'RECORD-TYPE' 00660O 34 'ORDER' 00670O 45 'LINE' 00680O 68 'M E S S A G E' 00690O*----------------------------------------------------------------- 00700O D 2 01 00710O RKPN 12 ' - - ' 00720O 10 22 'RECVD-PO' 00730O 13 18 'P.O.' 00740O 17 23 'BACKORDER' 00750O 20 17 'ALL' ÐÐ00760O RKWOP 35 00770O 55 36 '-' 00780O 55 RKWOD 39 00790O RKLINEZ 45 00800O RKTEXT 115 00810O 85 118 '*' 00820O******************************************************************** 00830OREMMAT D 03 00840O 11 'D' /* 00850_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(,1' ,}X040PM P\R120282120282(èÈÐ00010H Q040PM00020F* INIT QTY BAL/USAGE HIST FIELDS. (X040PM) 00030F* REVISED 4/28/83 2:25 PM. 00040F* U1 = INIT CUR BALANCES, OTHER THAN ON HAND STOCK BAL. 00050F* U2 = INIT USAGE DATA 00060F* U3 = INIT USAGE RATIO & INVENTORY CLASS, PLUS FORECAST 00070F* U4 = INIT ON HAND STOCK BALANCE 00080F* U6U7U8 = BYPASS PAUSE 00090FPMMST2 UP F 674 12AI 1 DISK 00100FTERM70 O F 70 5 00110I******************************************************************** 00120IPMMST2 PM 01 674NCD 00130I* CALCULATED DATA. 00140I* CURRENT BALANCES. 00150I* ON HAND STOCK 7P 00160I P 311 3140PMOHB 00170I* REQUIRED QTYS. 00180I* FORECAST BAL 7P 00190I P 315 3180PMFRCB 00200I* ALLOCATIONS 7P 00210I P 319 3220PMALB 00220I* REL REQS 7P 00230I P 323 3260PMRLB 00240I* SALES BACKLOG 7P 00250I P 327 3300PMSOB ÐÐ00260I* QUOTES 7P 00270I P 331 3340PMQTB 00280I* BACKORDERS 7P 00290I P 335 3380PMBOB 00300I* ON ORDER BALANCES. 00310I* PURCHASE REQS 7P 00320I P 339 3420PMPRB 00330I* PURCH ORDERS 7P 00340I P 343 3460PMPOB 00350I* RECD P.O. 7P 00360I P 347 3500PMRPOB 00370I* OPEN WORK ORDER 7P 00380I P 351 3540PMPWOB 00390I* REL WORK ORDER 7P 00400I P 355 3580PMRWOB 00410I* PAST USAGE. 00420I* PLANNED USAGE QTYS. 00430I* SHIPPED QTYS 7P 00440I P 359 3620PMPSHP 00450I* ISSUE QTYS 7P 00460I P 363 3660PMPISS 00470I* RECEIPT QTYS 7P 00480I P 367 3700PMPRCT 00490I* SCRAP QTYS 7P 00500I P 371 3740PMPSCR ÐÐ00510I* UNPLANNED USAGE QTYS. 00520I* SHIPPED QTYS 7P 00530I P 375 3780PMUSHP 00540I* USAGE RATIO .7P 00550I P 425 4287PMRATO 00560I* INVENTORY CLASS 1A 00570I 429 429 PMINVC 00580I* ISSUE QTYS 7P 00590I P 379 3820PMUISS 00600I* RECEIPT QTYS 7P 00610I P 383 3860PMURCT 00620I* SCRAP QTYS 7P 00630I P 387 3900PMUSCR 00640I* CUST RET $ 7P 00650I P 391 3940PMUCRT 00660I* PLANNED USAGE FREQ. 00670I* SHIPPED 5P 00680I P 395 3970PMFSHP 00690I* ISSUE 5P 00700I P 398 4000PMFISS 00710I* RECEIPT 5P 00720I P 401 4030PMFRCT 00730I* SCRAP 5P 00740I P 404 4060PMFSCR 00750I* UNPLANNED USAGE FREQ. ÐÐ00760I* SHIPPED 5P 00770I P 407 4090PMQSHP 00780I* ISSUE 5P 00790I P 410 4120PMQISS 00800I* RECEIPT 5P 00810I P 413 4150PMQRCT 00820I* SCRAP 5P 00830I P 416 4180PMQSCR 00840I* CUST RET 5P 00850I P 419 4210PMQCRT 00860I* BACKORDER FREQ 5P 00870I P 422 4240PMFBO 00880I*------------------------------------------------------------------- 00890I GG 02 00900C******************************************************************** 00910C 70 GOTO START 00920C NU1NU2NU3 SETON H9 00930C H9 GOTO END 00940C SETON 707273 00950C EXCPT 00960C SETOF 7273 00970C NU8NU7NU6 EXITFQPAUSE 00980C SETON 78 00990C EXCPT 01000C SETOF 78 ÐÐ01010C NU8NU7NU6 EXITFQPAUSE 01020C*------------------------------------------------------------------- 01030C START TAG 01040C* CURRENT BALANCES. 01050C U1 01060COR U3 Z-ADD0 PMFRCB 01070C U1 Z-ADD0 PMALB 01080C U1 Z-ADD0 PMRLB 01090C U1 Z-ADD0 PMSOB 01100C U1 Z-ADD0 PMQTB 01110C U1 Z-ADD0 PMBOB 01120C U1 Z-ADD0 PMPRB 01130C U1 Z-ADD0 PMPOB 01140C U1 Z-ADD0 PMRPOB 01150C U1 Z-ADD0 PMPWOB 01160C U1 Z-ADD0 PMRWOB 01170C* PAST USAGE. 01180C U2 Z-ADD0 PMPSHP 01190C U2 Z-ADD0 PMPISS 01200C U2 Z-ADD0 PMPRCT 01210C U2 Z-ADD0 PMPSCR 01220C U2 Z-ADD0 PMUSHP 01230C U2 Z-ADD0 PMUISS 01240C U2 Z-ADD0 PMURCT 01250C U2 Z-ADD0 PMUSCR ÐÐ01260C U2 Z-ADD0 PMUCRT 01270C U2 Z-ADD0 PMFSHP 01280C U2 Z-ADD0 PMFISS 01290C U2 Z-ADD0 PMFRCT 01300C U2 Z-ADD0 PMFSCR 01310C U2 Z-ADD0 PMQSHP 01320C U2 Z-ADD0 PMQISS 01330C U2 Z-ADD0 PMQRCT 01340C U2 Z-ADD0 PMQSCR 01350C U2 Z-ADD0 PMQCRT 01360C U2 Z-ADD0 PMFBO 01370C U3 Z-ADD0 PMRATO 01380C U3 MOVE ' ' PMINVC 01390C U4 Z-ADD0 PMOHB 01400C*------------------------------------------------------------------- 01410C END TAG 01420O******************************************************************** 01430OPMMST2 D 01 01440O PMOHB 314P 01450O PMFRCB 318P 01460O PMALB 322P 01470O PMRLB 326P 01480O PMSOB 330P 01490O PMQTB 334P 01500O PMBOB 338P ÐÐ01510O PMPRB 342P 01520O PMPOB 346P 01530O PMRPOB 350P 01540O PMPWOB 354P 01550O PMRWOB 358P 01560O PMPSHP 362P 01570O PMPISS 366P 01580O PMPRCT 370P 01590O PMPSCR 374P 01600O PMUSHP 378P 01610O PMUISS 382P 01620O PMURCT 386P 01630O PMUSCR 390P 01640O PMUCRT 394P 01650O PMFSHP 397P 01660O PMFISS 400P 01670O PMFRCT 403P 01680O PMFSCR 406P 01690O PMQSHP 409P 01700O PMQISS 412P 01710O PMQRCT 415P 01720O PMQSCR 418P 01730O PMQCRT 421P 01740O PMFBO 424P 01750O PMRATO 428P ÐÐ01760O PMINVC 429 01770O******************************************************************** 01780OTERM70 E 72 01790O 24 'THIS PROGRAM WIPES OUT A' 01800O 48 'LL CURRENT BAL AND PAST ' 01810O 70 'USAGE IN PART MAST--- ' 01820O E 72 01830O 24 'DO CONTROL-A CANCEL IF Y' 01840O 48 'OU AIN''T SURE! ' 01850O E 78 01860O 24 'ARE YOU SURE YOU''RE SUR' 01870O 29 'E ???' 01880O E 73 01890O 15 'SWITCHES ON....' 01900O E 73 U1 01910O 21 '1 = CUR BALANCES' 01920O E 73 U2 01930O 19 '2 = PAST USAGE' 01940O E 73 U3 01950O 30 '3 = INVENTORY CLASS AND ' 01960O 35 'RATIO' 01970O E 73 U4 01980O 22 '4 = ON HAND STOCK' 01990O E 73 02000O 1 ' ' ÐÐ02010O E 73 02020O 35 'USUAL SWITCHES ARE 1 & 2' 02030O 36 '.' 02040O E 73 02050O 35 'SW-4 IF ON HAND BALANCES' 02060O E 73 02070O 35 'ARE BEING UPDATED. SW-3' 02080O E 73 02090O 35 'IF INVENTORY RATIOS ARE ' 02100O E 73 02110O 35 'BEING RECALCULATED. ' 02120O E 73 02130O 1 ' ' /* 02140_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2T 2X304SF P052583052583(èÈÐ00010H Q304SF00020F* UPDATE POFILE WITH VENDOR (X304SF) 00030F* REVISED 5/25/83 10:10 AM. 00040FPOFILE UP F 44 DISK 00050FPOITEM IC F 384R 9AI 1 DISK 00060I********************************************************************** 00070IPOFILE PO 10 17 C1 18 C0 00080I OR 17 C3 18 C0 00090I* PURCHASE ORDERS (10, 30) 00100I* PART NO. 10N 00110I 1 100POPN 00120I* DUE DATE (YMD) 00130I 11 160PODUE 00140I* REC TYPE 00150I* 10=REC P/O 00160I* 30=P/O 00170I 17 18 POREC 00180I* P/O #, ITEM # 9N 00190I 19 27 POIT 00200I* TOTAL QTY P/O, ITEM 7N 00210I 30 360POQTY 00220I* VENDOR 5N (REPLACES 7N ABOQTY) 00230I 37 430POVEND 00240I* C=P/O COMMITTED 00250I 44 44 POABO ÐÐ00260I******************************************************************** 00270IPOITEM PO 00280I* PURCHASE ORDER ITEM RECORD 00290I* VENDOR # 5P 00300I P 109 1110PIVEND 00310I******************************************************************** 00320C 10 Z-ADD0 POVEND 70 00330C 10 MOVE POIT W9A 9 KEY FOR CHAIN 00340C W9A CHAINPOITEM 60 00350C N60 Z-ADDPIVEND POVEND 00360C************************************************************************ 00370OPOFILE D 10 00380O POVEND 43 00390O****************************************************************** /* 00400_‚ ÐÐ_‚_‚0I******************************************************************** 00270IPOITEM PO 00280I* PURCHASE ORDER ITEM RECORD 00290I* VENDOR # 5P 00300I P 109 1110PIVEND 00310I******************************************************************** 00320C 10 Z-ADD0 POVEND 70 00330C 10 MOVE POIT W9A 9 KEY FOR CHAIN 00340C W9A CHAINPOITEM 60 00350C N60 Z-ADDPIVEND POVEND 00360C************************************************************************ 00370OPOFILE D 10 00380O POVEND 43 00390O****************************************************************** /* 00400_‚ ÐÈ(–Nº –?X020CD Pjj061083061083(èÈÐ00010H Q020CD00020F* OUTPUT BEGINNING COMMODITY MASTER W/CDT & MFR CODES (X020CD) 00030F* LAST REVISED 6-09-83 1:15 PM. 00040F* 00050FPMMST2 IP F 674R I DISK 00060FPMADRT IR F 3 3IT EDISK 00070FEGMAST IC F 100R10AI 1 DISK 00080FEGMFRPN IC F 40R DISK 00090FCDTMFR UC F 17R14AI 1 DISK A 00100F************************************************************** 00110E PMADRT PMMST2 00120E EGT 10 5 0A 00130E EGM 15 5 0A 00140I****************************************************************** 00150IPMMST2 PM 10 674NCD 94 CP 00160I* PART NO. 10N 00170I 1 100PMPN L1 00180I* COMMODITY CODE 9P 00190I P 60 640PMCC L2 00200I* FORECAST QTY 7P 00210I P 315 3180PMFRCB 00220I* INVENTORY CLASS A,B,C 1A 00230I 429 429 PMINVC 00240I* STD COST 9.3P 00250I P 489 4933PMOSUC ÐÐ00260I*-------------------------------------------------------------------- 00270I PZ 11 00280I********************************************************************* 00290IEGMAST EG 00300I* ENGR STD MASTER 00310I* PART NO. 10N 00320I 1 100EGPN 00330I* STANDARDS CODE 6A 00340I 11 16 EGSTD 00350I* INSPECTION CODE 5A 00360I 17 21 EGINSP 00370I* TEXT RRN'S 5P X 10 00380I P 22 51 EGT 00390I* PART NO. CROSS-REF RRN'S 5P X 15 00400I P 52 96 EGM 00410I* RECORD STATUS 1A 00420I 100 100 EGSTAT 00430I********************************************************* 00440IEGMFRPN EP 00450I* ENG STD DYNAIR/MFR PART-NO CROSS REF. 00460I* MFR CODE 5A 00470I 1 5 EPMFR 00480I* MFR PART NO. 24A 00490I 6 29 EPMPN 00500I* DYNAIR PART NO. 10N ÐÐ00510I 30 39 EPPN 00520I* RECORD STATUS 1A 00530I 40 40 EPSTAT 00540I*********************************************************************** 00550ICDTMFR CD 00560I* COMMODITY/MFR KEY 14A 00570I* COMMODITY CODE 9N 00580I 1 90CDCODE 00590I* MFR CODE 5A 00600I 10 14 CDMFR 00610I* CTR USAGE 3N 00620I 15 170CDCTR 00630C***************************************************************** 00640C SETOF 3654 00650C N10 GOTO END 00660C MOVELPMPN W10A 10 00670C W10A CHAINEGMAST 54 00680C N54 EGSTAT COMP 'D' 54 00690C 54 GOTO END 00700C Z-ADD1 T 30 00710C Z-ADD1 M 30 00720C Z-ADD0 ZERO5 50 00730C*------------------------------------------------------------------- 00740C TAG10 TAG 00750C 36 GOTO END ÐÐ00760C ZERO5 LOKUPEGM,M 54 00770C N54 SETON 36 00780C N54 GOTO END 00790C Z-ADDEGM,M RRN 50 00800C Z-ADD0 EGM,M 00810C RRN CHAINEGMFRPN 36 00820C N36 EXSR SR90 GET CDT/MFR 00830C N36 GOTO TAG10 00840C*--------------------------------------------------------------- 00850C END TAG 00860C************************************************************************* 00870CSR SR90 BEGSR 00880C* GET CDT/MFR - ADD TO CTR OR ADD NEW TO FILE 00890CSR SETOF 6061 00900CSR MOVE PMCC W9A 9 00910CSR MOVE EPMFR W14A 14 00920CSR MOVELW9A W14A 00930CSR W14A CHAINCDTMFR 54 00940CSR 54 SETON 60 NEW ONE 00950CSRN54 SETON 61 GOT ONE-UPDATE 00960CSR 60 Z-ADD1 CDCTR INIT CTR 00970CSR 60 Z-ADDPMCC CDCODE 00980CSR 60 MOVE EPMFR CDMFR 00990CSR 61 1 ADD CDCTR CDCTR 01000CSR SETON 80 ÐÐ01010CSR EXCPT OUTPUT/UPDATE 01020CSR SETOF 80 01030CSR ENDSR 01040C********************************************************************** 01050OCDTMFR EADD 80 60 01060O CDCODE 9 01070O CDMFR 14 01080O CDCTR 17 01090O*-------------------------------------------------------------------- 01100O E 80 61 01110O CDCTR 17 01120O********************************************************************* /* 01130_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¬Z’ ¬HX013CD P$$062283062283(èÈÐ00010H Q013CD00020F* LIST MANUFACTURERS WITH THEIR VENDOR SUPPLIERS 00030F* REVISED 06-17-83 11:00 AM 00040FMFRVND IP F 55 5AI 1 DISK 00050FVMMAST IC F 384R 5AI 1 DISK 00060FMFRNAME IC F 32R 5AI 1 DISK 00070FPRINT O F 132 OF PRINTER 00080F********************************************************************* 00090E VND 10 5 0A 00100E******************************************************************** 00110IMFRVND MF 00120I* MFR CODE 5A 00130I 1 5 CDMFR 00140I* VENDORS 5N X 10 00150I 6 55 VND 00160I************************************************************************ 00170IVMMAST VM 00180I* VENDOR NO. KEY 5N 00190I 1 50VMVEND 00200I* VENDOR NAME 20A 00210I 6 25 VMSORT 00220I********************************************************************** 00230IMFRNAME MF 00240I* MFR CODE 5A 00250I 1 5 MFRCOD ÐÐ00260I* MFR NAME 25A 00270I 6 30 MFRNAM 00280I************************************************************************ 00290C N99 EXSR SR10 00300C EXSR SR20 GET MFR,VEND 00310C*-------------------------------------------------------------------- 00320C END TAG 00330C******************************************************************* 00340CSR SR10 BEGSR 00350C* INIT 00360CSR SETON 99 1 TIME 00370CSR Z-ADD0 ZERO5 50 00380CSR MOVE ' ' W5A 5 00390CSR ENDSR 00400C********************************************************************** 00410CSR SR20 BEGSR 00420CSR MOVE CDMFR W5A 00430CSR W5A CHAINMFRNAME 54 00440CSRN54 SETON 31 00450CSR SETON 61 00460CSR EXCPT SPACE 00470CSR SETOF 61 00480CSR SETON 60 00490CSR EXCPT MFR LINE 00500CSR SETOF 3160 ÐÐ00510CSR EXSR SR40 GET VENDORS 00520CSR ENDSR 00530C******************************************************************* 00540CSR SR40 BEGSR 00550C* GET VENDORS 00560CSR Z-ADD1 X 30 00570C*-------------------------------------------------------------------- 00580CSR T40A TAG 00590CSR Z-ADDVND,X VEND 50 00600CSR VEND COMP ZERO5 58 00610CSR 58 GOTO T40B 00620CSR EXSR SR70 GOOD ONE, GET VEND 00630C*----------------------------------------------------------------------- 00640CSR T40B TAG 00650CSR 1 ADD X X 00660CSR X COMP 10 54 00670CSRN54 GOTO T40A 00680CSR END40 ENDSR 00690C******************************************************************** 00700CSR SR70 BEGSR 00710CSR MOVE VEND W5A 5 00720CSR W5A CHAINVMMAST 54 00730CSRN54 SETON 41 00740CSR SETON 70 00750CSR EXCPT LIST VENDOR ÐÐ00760CSR SETOF 4170 00770CSR ENDSR 00780C******************************************************************** 00790OPRINT H 203 1P 00800O OR OF 00810O UDATE 8 ' - - ' 00820O 44 'MANUFACTURERS AND' 00830O 63 'THEIR DISTRIBUTORS' 00840O PAGE Z 132 00850O 128 'PAGE' 00860O*--------------------------------------------------------------------- 00870O H 2 1P 00880O OR OF 00890O 19 'CODE' 00900O 35 'MANUFACTURERS' 00910O 58 'CODE' 00920O 68 'VENDORS' 00930O*-------------------------------------------------------------------- 00940O E 1 61 00950O 1 ' ' 00960O*-------------------------------------------------------------------- 00970O EF 60 00980O 31 MFRNAM B 47 00990O CDMFR 20 01000O N31 27 '***' ÐÐ01010O*--------------------------------------------------------------------- 01020O EF 1 70 01030O 41 VMSORT B 81 01040O VEND Z 59 01050O************************************************************************ /* 01060_‚ ÐÐ ÐÐ _‚_‚ ÐÈ(¶l“ ¶ŒX102SF P"ì#–999999120282(èÈÐ00010H Q102SF00020F* DISPLAY SCHEDULE FILE (SFMAST). (X102SF) 00030F* REVISED 12/08/82 11:35 AM. 00040F* NOTE: MOST CHANGES MADE TO THIS PROGRAM SHOULD ALSO BE MADE TO X114SF.00050F* 00060FBITPAR IP F 90 DISK 00070FSFMAST ID F 128L29AI 1 DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FCRTFILE UC F 256R DISK 00100FMGFILE IC F 80R DISK 00110FCALENDARIC F 22R 7AI 1 DISK 00120FCMMAST IC F 576R 5AI 1 DISK 00130FPMMODEL2ID F 23L22AI 1 DISK 00140FREMARKS ID F 90L29AI 1 DISK 00150FTERM132 O F 132 5 00160E******************************************************************** 00170E A12 12 12 1 A 00180E AR 1 132 1 00190E TABSC 1 6 2 TABSCN 15 00200E NUL 1 132 1 00210E LNK 1 7 6 A 00220E SWO 1 25 11 A 00230E BIT 33 1 00240E PAR 25 1 00250E TST 25 1 ÐÐ00260E PM$ 7 9 3 MFG $ FILE 00270E PLT 8 3 0 LEAD TIMES 00280E CALL 7 6 A 00290I******************************************************************** 00300IBITPAR BT 00310I 1 33 BIT 00320I 34 58 PAR 00330I 59 83 TST 00340I********************************************************************** 00350ICRTFILE CR 00360I 27 27 CRSHUT 00370I 28 330CRTIME 00380I 34 370CRDATE 00390I 38 79 CALL 00400I******************************************************************** 00410IPMMODEL2PD 00420I 1 12 PDMODL 00430I 13 220PDPN 00440I 23 23 PDSTAT 00450I******************************************************************** 00460ISFMAST SF 00470I* SCHEDULE MASTER. 00480I* COMMON FIELDS. 00490I* KEY AREA. 00500I 1 29 SFKEY ÐÐ00510I* PART NO. 10N 00520I 1 100SFPN 00530I* DATE DUE 6N (YMD) 00540I 11 160SFDUE 00550I* RECORD CODE 2N 00560I* 10 = RECEIVED PO 00570I* 20 = REL WO 00580I* 30 = PURCHASE ORDER 00590I* 40 = PLANNED WORK ORDER 00600I* 50 = PURCHASE REQ 00610I* 60 = SALES ORDER-BACKLOG 00620I* 70 = REL REQUIREMENT 00630I* 80 = PLAN REQUIREMENT 00640I* 90 = RUN RELEASE 00650I 17 180SFREC 00660I* ORDER NO. 00670I 19 29 SFORD 00680I* PREFIX 1A 00690I 19 19 SFPRFX 00700I* PRIME 5N 00710I 19 24 SFPRIM 00720I* DASH 3N 00730I 25 270SFDASH 00740I* RECEIVING LOG 2N 00750I 28 290SFRLOG ÐÐ00760I* QUANTITY 7P 00770I P 30 330SFQTY 00780I* QTY COMPLETE 7P 00790I P 34 370SFQTYC 00800I* DATE LAST TRAN 6N (YMD) 00810I 38 430SFDLT 00820I* CUST #/DEPT #/VEND # 5P 00830I P 44 460SFCUST 00840I* VARIABLE AREA. 00850I* PLAN/REL REQMTS 00860I* NEXT ASSY PART # 10N 00870I 47 560SFNAPN 00880I* QTY PER ASSY 7P 00890I P 57 600SFQPA 00900I* ISSUE CODE 2A 00910I 61 62 SFISSU 00920I* ASSY REVISION 2A 00930I 65 66 SFREV 00940I* ASSY WO QTY 7P 00950I 67 700SFQTYA 00960I* SALES ORDERS 00970I* PRICE CODE 1A 00980I* SEE WORK ORDERS. 00990I* CUST P.O. 20A 01000I 71 90 SFCPO ÐÐ01010I* UNIT PRICE 9.3P 01020I P 91 953SFPRIC 01030I* PURCH ORDERS 01040I* PRICE CODE 1A 01050I* SEE WORK ORDERS. 01060I* VENDOR NAME 20A 01070I* SEE SFCPO UNDER SALES ORDERS. 01080I* UNIT PRICE 9.3P 01090I* SEE SFPRIC UNDER SALES ORDERS. 01100I* PACKING SLIP 9A 01110I* 96 104 SFPKGS 01120I* WORK ORDERS 01130I* DEPT NAME 20A 01140I* SEE SFCPO UNDER SALES ORDERS. 01150I* OPER SEQ # 3P 01160I P 96 970SFSEQ 01170I* START DATE 6N 01180I 98 1030SFSTRT 01190I* PRICE CODE 1A 01200I 105 105 SFPCOD 01210I* BACKORDER FLAG 1A 01220I 106 106 SFBOF 01230I* REVISION 2A 01240I* SEE PLAN/REL REQMTS. 01250I* RECORD STATUS 1A ÐÐ01260I 128 128 SFSTAT 01270I******************************************************************** 01280IPMMST2 PM 01290I 1 100PMPN 01300I 15 180PMPL 01310I 19 30 PMMODL 01320I 31 59 PMDESC 01330I 70 71 PMECHG 01340I 94 95 PMSC 01350I P 113 128 PLT 01360I P 163 1660PMSSTK 01370I P 245 279 PM$ 01380I P 311 3140PMOHB 01390I P 489 4933PMOSUC 01400I 674 674 PMSTAT 01410I******************************************************************** 01420IMGFILE MG 01430I 1 35 MGTEXT 01440I******************************************************************** 01450ICALENDARCA 20 1 CC 01460I* CALENDAR DATE RECORD. 01470I 2 30CAYR 01480I 4 50CAMO 01490I 6 70CADAY 01500I 14 170CAMDAY ÐÐ01510I 18 200CAWK 01520I 21 220CADOW 01530I*------------------------------------------------------------------- 01540I CB 21 1 CM 01550I* MFG DATE RECORD. 01560I 4 70CAMDAY 01570I 8 90CAYR 01580I 10 110CAMO 01590I 12 130CADAY 01600I 18 200CAWK 01610I 21 220CADOW 01620I*------------------------------------------------------------------- 01630I GG 22 01640I******************************************************************** 01650ICMMAST CM 01660I* CUSTOMER MASTER 01670I* CUST NAME 35A 01680I 26 60 CMNAME 01690I******************************************************************** 01700IREMARKS RK 01710I* COMMENT FILE 01720I 1 100RKPN 01730I 11 160RKDUE 01740I 17 180RKREC 01750I 19 27 RKWO ÐÐ01760I 28 290RKLINE 01770I 1 29 RKKEY 01780I 30 89 RKTEXT 01790I 90 90 RKSTAT 01800C********************************************************************* 01810C* INITIALIZE. 01820C EXSR SR101 INIT 01830C MOVE ' ' BLK6 6 01840C EXSR SR71 PUT HEADINGS 01850C*------------------------------------------------------------------- 01860C START TAG 01870C* REQUEST PART #. 01880C Z-ADD0 PMPN 01890C EXSR SR67 LF 01900C SETON 82 01910C EXCPT PROMPT 01920C SETOF 82 01930C 1 ADD COUNT COUNT 30 01940C EXSR SR75 READ 01950C 93 GOTO START 01960C*--------------------------------------------------------------- 01970C TAG5 TAG 01980C SETOF 779068 01990C MOVE BLK35 LSTKEY 02000C EXSR SR106 CONVERT MOD TO PN ÐÐ02010C N56 EXSR SR202 R. ADJUST 02020C N56 MOVE W12A PN 100 STARTING PART# 02030C MOVE BLK11 SWO 02040C PN COMP 0 54 02050C 54 EXSR SR102 PART MASTER LINE 02060C MOVE BLK35 W29A 02070C MOVELPN W29A 29 02080C W29A SETLLSFMAST SET-UP 1ST READ 02090C Z-ADD0 AVAIL 70 OVERALL AVAIL BAL 02100C Z-ADD0 SAVAIL 70 AVAIL STOCK BAL 02110C*------------------------------------------------------------------ 02120C TAG10 TAG 02130C* GET NEXT SFMAST. 02140C SETOF 549390 02150C READ SFMAST 54 GET SFMAST 02160C 54 68 GOTO TOTALS 02170C 54 GOTO START 02180C SFKEY COMP LSTKEY 54 CHECK KEY SEQ 02190C N54 GOTO TOTALS 02200C MOVE SFKEY LSTKEY 29 02210C SFSTAT COMP 'D' 54 FLAG DELETED 02220C 54 GOTO TAG10 02230C SFPN COMP PMPN 54 02240C N54 SETOF 47 02250C Z-ADDSFPN PN ÐÐ02260C SFQTY SUB SFQTYC QTYBAL 70 54 02270C N54 GOTO TAG10 INACTIVE QTY 02280C EXSR SR103 CLASSIFY SFMAST 02290C 13 Z-ADDSFQPA QPA5 50 QTY PER ASSY (CRT) 02300C 06 SFCUST CHAINCMMAST 54 GET CUSTOMER MAST 02310C 06N54 MOVELCMNAME SFCPO CUST NAME 02320C EXSR SR72 PUT DATA 02330C 47 GOTO TAG10 02340C 77 GOTO TAG5 02350C GOTO TAG10 GET NEXT SFMAST 02360C*------------------------------------------------------------------- 02370C TOTALS TAG 02380C* PUT TOTALS. 02390C SETOF 7790 02400C PN COMP 0 54 02410C N54 GOTO START NO PART NO. ACTIVE 02420C N68 EXSR SR102 PART MAST LINE 02430C 47 GOTO START 02440C AVAIL COMP 0 55 LESS THAN 02450C 55 Z-ADD1 XTRA 30 02460C EXSR SR69 CHECK END PAGE 02470C 77 GOTO TAG5 NEW PN INPUT 02480C AVAIL COMP 0 55 LESS THAN 02490C 55 1 ADD COUNT COUNT 02500C SETON 76 ÐÐ02510C EXCPT PUT TOTALS 02520C SETOF 76 02530C MOVE BLK11 SWO 02540C 1 ADD COUNT COUNT 02550C GOTO START 02560C*------------------------------------------------------------------- 02570C MENU TAG 02580C EXSR SR96 GET CRTFILE 02590C Z-ADD1 W 02600C BLK6 LOKUPLNK,W 54 02610C 54 MOVELLNK,W PROG 02620C 54 MOVE BLK6 LNK,W 02630C N54 MOVEL'CONTU' PROG 02640C EXSR SR96 GET CRTFILE 02650C EXSR SR97 UPD CRTFILE 02660C EXSR SR98 >>>>>>>>>> 02670C*------------------------------------------------------------------- 02680C END TAG 02690C 93 MOVEL'QBVH ' PROG 8 02700C 98 MOVEL'GOODBY' PROG 02710C EXSR SR96 GET CRTFILE 02720C EXSR SR97 UPD CRTFILE 02730C EXSR SR98 >>>>>>>>>> 02740C*------------------------------------------------------------------- 02750C ENDJOB TAG ÐÐ02760C MOVEL'ENDJOB' PROG 02770C EXSR SR98 >>>>>>>>>> 02780C******************************************************************** 02790CSR SR60 BEGSR 02800CSR 50 EXITFZISTAT CLEAR STATUS LINE 02810CSR ENDSR 02820C**************************************************************** 02830CSR SR67 BEGSR 02840CSR EXITFQCLF LF 02850CSR 1 ADD COUNT COUNT 02860CSR ENDSR 02870C****************************************************************** 02880CSR SR69 BEGSR 02890C* CHECK END PAGE 02900CSR SETOF 7790 02910CSR 1 ADD COUNT W3N 30 02920CSR XTRA ADD W3N W3N 02930CSR Z-ADD0 XTRA 02940CSR 50 W3N COMP 23 54 02950CSRN50 W3N COMP 29 54 02960CSRN54 GOTO END69 02970CSR SETON 83 02980CSR EXCPT END OF PAGE PROMPT 02990CSR SETOF 83 03000CSR EXSR SR75 READ CRT ÐÐ03010CSR EXSR SR71 PUT HEADINGS 03020CSR 68 EXSR SR67 LF 03030CSR 77 GOTO END69 03040CSR 68 EXSR SR74 PUT PART MAST 03050CSR 68 SETON 81 03060CSR 68 EXCPT CONT'D LINE 03070CSR SETOF 81 03080CSR 68 1 ADD COUNT COUNT 03090CSR END69 ENDSR 03100C******************************************************************** 03110CSR SR70 BEGSR 03120C* CLEAR CRT. 03130CSRN50 EXITFZCPAGE CLEAR PAGE-4 03140CSR 50 EXSR SR60 CLEAR STATUS 03150CSR 50 EXITFZESCH CLEAR SCREEN 03160CSR ENDSR 03170C******************************************************************** 03180CSR SR71 BEGSR 03190C* PUT HEADING 03200CSR EXSR SR70 CLEAR CRT 03210CSR Z-ADD4 COUNT 03220CSR SETON 71 03230CSR EXCPT PUT HDG 03240CSR SETOF 71 03250CSR ENDSR ÐÐ03260C******************************************************************** 03270CSR SR72 BEGSR 03280C* PUT DATA LINE. 03290CSR SETOF 7790 03300CSR SFPN COMP PMPN 54 03310CSR 54 GOTO T72B NOT NEW PART# 03320CSRN68 GOTO T72A NO DATA PUT YET 03330CSR AVAIL COMP 0 55 LESS THAN 03340CSR 55 Z-ADD1 XTRA 03350CSR EXSR SR69 CHECK END PAGE 03360CSR 77 03370COR 90 GOTO END72 03380CSR SETON 76 03390CSR EXCPT PUT TOTALS 03400CSR SETOF 7668 03410CSR MOVE BLK11 SWO 03420CSR 1 ADD COUNT COUNT 03430CSR 55 1 ADD COUNT COUNT 03440C*------------------------------------------------------------------ 03450CSR T72A TAG 03460CSR Z-ADDSFPN PN 03470CSR EXSR SR102 DO PART MAST 03480CSR 77 03490COR 90 03500COR 47 GOTO END72 ÐÐ03510C*-------------------------------------------------------------- 03520CSR T72B TAG 03530CSR 10 QTYBAL ADD ORDBAL ORDBAL 70 03540CSR 11 QTYBAL ADD REQBAL REQBAL 70 03550CSR 10 Z-ADDQTYBAL QTYORD 70 03560CSR 11 Z-ADDQTYBAL QTYREQ 70 03570CSR ORDBAL ADD STKQTY AVAIL 70 03580CSR AVAIL SUB REQBAL AVAIL 03590CSR SAVAIL SUB REQBAL SAVAIL 03600CSR EXSR SR204 DATES/$ 03610CSR EXSR SR69 CHECK END PAGE 03620CSR 77 GOTO END72 03630CSR SFDASH COMP 0 56 03640CSR SETOF 70 03650CSR 01 03660COR 06 SETON 70 03670CSR SETON 72 03680CSR EXCPT PUT DATA 03690CSR SETOF 72 03700CSR 1 ADD COUNT COUNT 30 03710CSR SETON 68 03720CSR EXSR SR206 PUT REMARKS 03730CSR EXSR SR104 COMPUTE EXCEPTIONS 03740CSR END72 ENDSR 03750C******************************************************************** ÐÐ03760CSR SR73 BEGSR 03770C* PUT MESSAGE. 03780CSR EXSR SR69 CHECK END PAGE 03790CSR 77 GOTO END73 03800CSR M CHAINMGFILE 54 03810CSR 54 MOVE BLK35 MGTEXT 03820CSR 54 MOVEL'??????' MGTEXT 03830CSR 48 EXITFZDIM 03840CSR 48 EXITFZBLINK 03850CSR SETON 73 03860CSR EXCPT PUT MSG 03870CSR SETOF 7396 03880CSR 48 EXITFZBLUNK 03890CSR 48 EXITFZBRITE 03900CSR 1 ADD COUNT COUNT 03910CSR END73 ENDSR 03920C******************************************************************** 03930CSR SR74 BEGSR 03940C* PUT PART MAST LINE. 03950CSR SETON 74 03960CSR EXCPT PUT PMMST2 TO CRT 03970CSR SETOF 74 03980CSR 2 ADD COUNT COUNT 03990CSR ENDSR 04000C******************************************************************** ÐÐ04010CSR SR75 BEGSR 04020C* READ. 04030CSR SETOF 779092 04040CSR SETOF 939498 04050CSR MOVE BLK12 W12A 12 04060CSR EXITFZR12 READ TERMINAL 04070CSR RLABL W12A 04080CSR MOVEAW12A A12 04090CSR MOVE BLK12 W12A 04100CSR Z-ADD1 W 30 04110CSR '\' LOKUPA12,W 90 04120CSRN90 GOTO T75B 04130CSR 1 ADD W W 04140CSR W COMP 12 54 04150CSR 54 GOTO T75A 04160CSR A12,W COMP 'G' 98 GOODBY 04170CSR A12,W COMP 'N' 93 NEW ITEM 04180CSR A12,W COMP 'E' 94 EXIT 04190CSR 93 GOTO END75 04200CSR 98 GOTO END 04210CSR 94 GOTO MENU 04220CSR MOVEAA12,W W2A 2 04230CSR W2A COMP 'PI' 54 04240CSR 54 MOVE 'Q009PI 'PROG 04250CSR 54 EXITFCHAIN >>>>>>>>>>>>> ÐÐ04260CSR RLABL PROG 04270C*------------------------------------------------------------------- 04280CSR T75A TAG 04290CSR Z-ADD318 M 50 FLAG ERROR 04300CSR EXSR SR73 PUT MSG 04310CSR GOTO SR75 04320C*------------------------------------------------------------------- 04330CSR T75B TAG 04340CSR Z-ADD1 W 04350CSR ' ' LOKUPA12,W 77 04360CSR 77 MOVEAA12,W W12A 04370CSR END75 ENDSR 04380C******************************************************************** 04390CSR SR76 BEGSR 04400CSR 50 SETON 48 04410CSR EXSR SR73 04420CSR 50 SETOF 48 04430CSR ENDSR 04440C******************************************************************** 04450CSR SR96 BEGSR 04460CSR # CHAINCRTFILE H9 GET CRTFILE 04470CSR H9 GOTO ENDJOB 04480CSR ENDSR 04490C******************************************************************** 04500CSR SR97 BEGSR ÐÐ04510C* UPDATE CRTFILE. EXIT PROGRAM. 04520CSR TIME CRTIME 04530CSR MOVELUDATE CRDATE 04540CSR SETON 97 04550CSR EXCPT UPDATE CRTFILE 04560CSR SETOF 97 04570CSR ENDSR 04580C******************************************************************** 04590CSR SR98 BEGSR 04600CSR EXSR SR70 CLEAR SCREEN 04610CSR EXITFCHAIN >>>>>>>>>> 04620CSR RLABL PROG 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR101 BEGSR 04660C* 1-TIME INITIALIZE. 04670CSR MOVE BIT,1 NUL 04680CSR MOVE '.' AR 04690CSR MOVE ' ' BLK35 35 04700CSR MOVE ' ' BLK12 12 04710CSR Z-ADDUDATE W6N 60 04720CSR EXSR SR205 04730CSR Z-ADDCAMDAY TODAY 40 CUR MDAY 04740CSR Z-ADDW6N CURCAL 60 CUR CAL DATE 04750CSR Z-ADD0 W2N 20 ÐÐ04760CSR MOVE ' ' W2A 2 04770CSR EXITFZGMINX GET PORT# 04780CSR RLABL W2A 04790CSR MOVE W2A # 20 04800CSR # COMP 0 54 04810CSRN54 Z-ADD25 # 04820CSR EXSR SR96 GET CRTFILE 04830CSR MOVE CALL LNK 04840CSR PAR,# COMP '1' 50 04850CSR TST,# COMP 'S' 56 04860CSR 56 MOVE 'SHUTDOWN'PROG 04870CSR EXSR SR97 UPDATE CRTFILE 04880CSR 56 EXSR SR98 >>>>>>>>>> 04890CSR 50 EXSR SR60 CLEAR STATUS LINE 04900CSR MOVE ' 'PROG 04910CSR MOVE ' ' BLK11 11 04920CSR MOVE ' ' BLK9 9 04930CSR ENDSR 04940C******************************************************************** 04950CSR SR102 BEGSR 04960C* DISPLAY PART MASTER. 04970CSR SETOF 47 04980CSR Z-ADD0 AVAIL 04990CSR Z-ADD0 ORDBAL 05000CSR Z-ADD0 REQBAL ÐÐ05010CSR MOVE BLK12 SCNAME 15 05020CSR MOVELPN W12A 05030CSR MOVE ' ' W12A 05040CSR W12A CHAINPMMST2 47 05050CSRN47 PMSTAT COMP 'D' 47 05060CSR Z-ADD0 PMOHB 05070CSR 47 GOTO END102 05080CSR Z-ADDPMPN SAVEPN 100 05090CSR PMMODL COMP BLK12 54 05100CSR 54 MOVEL'MODEL' W18A 18 05110CSR 54 MOVE PMMODL W18A 05120CSR 54 MOVE BLK35 PMDESC 05130CSR 54 MOVELW18A PMDESC 05140CSR 54 MOVE '***' PMDESC 05150CSR PMSC LOKUPTABSC TABSCN 54 05160CSR 54 MOVE TABSCN SCNAME 05170CSR Z-ADDPMOHB STKQTY 70 54 05180CSRN54 Z-ADD0 STKQTY 05190CSR Z-ADDSTKQTY BOSTK 70 STOCK FOR BACKORDERS 05200CSR Z-ADDSTKQTY AVAIL OVERALL AVAIL BAL 05210CSR Z-ADDAVAIL SAVAIL 70 AVAIL STOCK BAL 05220CSR XFOOTPLT LEAD 30 05230CSR EXSR SR203 CALC COST 05240CSR PMSSTK COMP 0 54 05250CSR Z-ADD2 XTRA ÐÐ05260CSR 54 1 ADD XTRA XTRA 05270CSR PMOHB COMP 0 54 LESS THAN 05280CSR 54 1 ADD XTRA XTRA 05290CSR EXSR SR69 CHECK END PAGE 05300CSR 77 GOTO END102 05310CSR EXSR SR74 PUT PM LINE 05320CSR SETON 68 05330CSR SETON 80 05340CSR EXSR SR206 PUT REMARKS 05350CSR SETOF 80 05360CSR PMOHB COMP 0 54 54 05370CSRN54 Z-ADD630 M 96 05380CSRN54 EXSR SR73 FLAG NEG ON HAND 05390CSR PMSSTK COMP 0 54 05400CSRN54 GOTO END102 05410CSR Z-ADDPMSSTK REQBAL 05420CSR AVAIL SUB PMSSTK AVAIL 05430CSR Z-ADDAVAIL SAVAIL 05440CSR SETON 75 05450CSR EXCPT PUT SAFETY STOCK 05460CSR SETOF 75 05470CSR 1 ADD COUNT COUNT 05480CSR END102 ENDSR 05490C******************************************************************** 05500CSR SR103 BEGSR ÐÐ05510C* CLASSIFY SFMAST RECORD. 05520CSR SETOF 101112 05530CSR SETOF 131415 05540CSR SETOF 1617 05550CSR SFREC COMP 10 01 RPO 05560CSR SFREC COMP 20 02 RWO 05570CSR SFREC COMP 30 03 PO 05580CSR SFREC COMP 40 04 PWO 05590CSR SFREC COMP 50 05 PURREQ 05600CSR SFREC COMP 60 06 SO 05610CSR SFREC COMP 70 07 RREQ 05620CSR SFREC COMP 80 08 PREQ 05630CSR SFREC COMP 90 09 FORECAST 05640CSR 01 05650COR 02 05660COR 03 05670COR 04 05680COR 05 SETON 10 ORDER 05690CSRN10 SETON 11 REQMT 05700C* FLAG PROD REQMTS. 05710CSR 07 REL REQ 05720COR 08 SETON 13 PLN REQ 05730C* FLAG PUR ORD. 05740CSR 01 RPO 05750COR 03 PO ÐÐ05760COR 05 SETON 12 PUR REQ 05770C* FLAG WO. 05780CSR 02 REL WO 05790COR 04 SETON 14 PLN WO 05800C* FLAG USES CPO FIELD. 05810CSR 02 REL WO 05820COR 12 PO'S 05830COR 06 SETON 15 SO'S 05840C* FLAG USES PRICE FIELD. 05850CSR 15N14 SETON 16 05860C* FLAG WORK ORDER OR WO/REQMT. 05870CSR 13 REQUIREMENT 05880COR 14 SETON 17 WORK ORDER 05890CSR ENDSR 05900C******************************************************************** 05910CSR SR104 BEGSR 05920C* PUT EXCEPTION MESSAGES. 05930CSR TODAY COMP MDUE 54 05940CSR 01 RECD PO 05950COR 04 PLAN WO 05960COR 08 PLAN REQMT 05970CORN54 GOTO T104A NOT PAST DUE 05980CSRN09 Z-ADD518 M 96 05990CSR 96 EXSR SR76 FLAG PAST DUE 06000CSR 09 Z-ADD520 M 96 ÐÐ06010CSR 09 EXSR SR76 FLAG NOT SOLD 06020CSR 77 GOTO END104 06030C*------------------------------------------------------------------- 06040CSR T104A TAG 06050CSRN04N08 GOTO T104B NOT PLAN WO OR REQMT 06060CSR 04 CURCAL COMP SFSTRT 54 06070CSR 08 CURCAL COMP SFDUE 54 06080CSRN54 GOTO T104B START DATE OK 06090CSR Z-ADD521 M 06100CSR EXSR SR76 FLAG NOT REL 06110CSR 77 GOTO END104 06120C*------------------------------------------------------------------- 06130CSR T104B TAG 06140CSRN05 GOTO T104C NOT PUR REQ 06150CSR TODAY ADD LEAD W4N 40 06160CSR W4N COMP SFDUE 54 06170CSRN54 GOTO T104C LT OK 06180CSR Z-ADD522 M FLAG NOT ENOUGH 06190CSR EXSR SR76 LEAD TIME. 06200CSR 77 GOTO END104 06210C*------------------------------------------------------------------- 06220CSR T104C TAG 06230CSRN05 GOTO T104D NOT PUR REQ 06240CSR TODAY SUB SFDLT DIF 40 06250CSR DIF COMP 5 54 ÐÐ06260CSRN54 GOTO T104D 06270CSR 05 Z-ADD524 M FLAG NOT PLACED 06280CSR EXSR SR76 06290CSR 77 GOTO END104 06300C*------------------------------------------------------------------- 06310CSR T104D TAG 06320CSRN06 GOTO END104 DONT FLAG BACKORDER 06330C* REL REQMTS ARE TEMPORARILY BYPASSED-- THEY ARE ALL CONSIDERED B/O 06340C* ---SEE CRT OUTPUT 06350CSR SFQTYC COMP 0 54 06360CSR 54 MOVE 'B' SFBOF 06370CSRN54 SFBOF COMP 'B' 54 06380CSRN54 GOTO END104 06390CSR Z-ADD565 M FLAG BACKORDER 06400CSR EXSR SR76 06410CSR 77 GOTO END104 06420CSR BOSTK COMP 0 54 06430CSR 54 Z-ADD519 M 06440CSR 54 EXSR SR76 NOT ISSUED 06450CSR BOSTK SUB QTYREQ BOSTK UPD BO QTY 06460CSR END104 ENDSR 06470C******************************************************************** 06480CSR SR106 BEGSR 06490C* CONVERT MODEL TO PART NO. 06500CSR SETOF 56 GOT IT FLAG ÐÐ06510CSR MOVE BLK35 W22A 22 06520CSR MOVELW12A W22A 06530CSR W22A SETLLPMMODEL2 06540C*------------------------------------------------------------------- 06550CSR T106A TAG 06560CSR SETOF 54 06570CSR READ PMMODEL2 54 06580CSR 54 GOTO END106 06590CSR PDMODL COMP W12A 54 06600CSRN54 GOTO END106 06610CSR PDSTAT COMP 'D' 54 06620CSR 54 GOTO T106A 06630CSR Z-ADDPDPN PN PART # 06640CSR SETON 56 GOT IT FLAG 06650CSR END106 ENDSR 06660C******************************************************************** 06670CSR SR202 BEGSR 06680C* R. ADJUST. 06690CSR Z-ADD12 W2N 20 06700CSR EXIT SUBRAJ R. ADJUST 06710CSR RLABL W2N 06720CSR RLABL W12A 06730CSR ENDSR 06740C******************************************************************** 06750CSR SR203 BEGSR ÐÐ06760C* CALC PART MAST COST, EXTEND BY ON HAND, IF ANY. 06770CSR XFOOTPM$ TOTCST 93 06780CSR PMOHB MULT TOTCST TOTCST 54 06790CSRN54 XFOOTPM$ TOTCST 06800CSR ENDSR 06810C******************************************************************** 06820CSR SR204 BEGSR 06830C* CONVERT CAL DATES TO MDAYS. 06840CSR Z-ADDSFDUE W6N 06850CSR EXSR SR205 06860CSR Z-ADDCAMDAY MDUE 40 DUE DATE 06870C* CALC LINE ITEM COST. 06880CSR ENDSR 06890C******************************************************************** 06900CSR SR205 BEGSR 06910C* GET MDAYS. 06920CSR MOVELW6N W2N 06930CSR W2N COMP 12 54 06940CSR 54 GOTO T205A 06950CSR MOVELW6N W4N 06960CSR MOVE W6N W2N 06970CSR MOVELW2N W6N 06980CSR MOVE W4N W6N 06990C*------------------------------------------------------------------- 07000CSR T205A TAG ÐÐ07010CSR MOVEL'C' W7A 7 07020CSR MOVE W6N W7A 07030CSR W7A CHAINCALENDAR 54 07040CSR ENDSR 07050C******************************************************************* 07060CSR SR206 BEGSR 07070C* PUT REMARKS 07080CSR MOVELSFORD W9A 9 07090CSR MOVELSFREC W11A 11 07100CSR MOVE W9A W11A 07110CSR W11A LOKUPSWO 54 07120CSR 54 GOTO END206 07130CSR MOVELSFPN W16A 16 07140CSR MOVE '000000' W16A 07150CSR MOVELSFREC W13A 13 07160CSR MOVE SFORD W13A 07170CSR MOVE '00' W13A 07180CSR MOVELW16A W29A 29 07190CSR MOVE W13A W29A 07200CSR W29A SETLLREMARKS 07210CSR MOVE BLK35 LASTRK 29 07220C*-------------------------------------------------------------------- 07230CSR T206C TAG 07240CSR SETOF 54 07250CSR READ REMARKS 54 ÐÐ07260CSR 54 GOTO END206 07270CSR RKKEY COMP LASTRK 54 07280CSRN54 GOTO END206 07290CSR MOVE RKKEY LASTRK 07300CSR RKPN COMP SFPN 54 07310CSRN54 GOTO END206 07320CSRN80 RKREC COMP SFREC 54 07330CSR 54N80 MOVELSFORD W9A 07340CSR 54N80 RKWO COMP W9A 54 07350CSR 80 RKREC COMP 0 54 07360CSR 80 54 RKWO COMP BLK9 54 07370CSRN54 GOTO END206 07380CSR RKSTAT COMP 'D' 54 07390CSR 54 GOTO T206C 07400CSR MOVELRKREC W11A 07410CSR MOVE RKWO W11A 07420CSR Z-ADD1 X 07430CSR W11A LOKUPSWO,X 54 07440CSR 54 GOTO T206E 07450CSR Z-ADD1 X 30 07460CSR BLK11 LOKUPSWO,X 54 07470CSR 54 MOVE W11A SWO,X 07480C*---------------------------------------------------------------- 07490CSR T206E TAG 07500CSR EXSR SR69 CHECK END PAGE ÐÐ07510CSR EXITFZDIM START DIM 07520CSR SETON 78 07530CSR EXCPT PUT REMARKS 07540CSR SETOF 78 07550CSR EXITFZBRITE STOP DIM 07560CSR 1 ADD COUNT COUNT 07570CSR GOTO T206C 07580CSR END206 ENDSR 07590O******************************************************************** 07600OTERM132 E 71 07610O BIT,28 1 07620O N50 8 '8091001' 07630O 50 10 '[001 ]001' 07640O 50 BIT,28 6 07650O 64 'I N V E N T O R Y' 07660O 78 'S T A T U S' 07670O 84 'B Y' 07680O 100 'P A R T N O.' 07690O UDATE Y 18 07700O TODAY Z 25 07710O*------------------------------------------------------------------- 07720O E 71 07730O 46 'VENDOR' 07740O*------------------------------------------------------------------- 07750O E 71 ÐÐ07760O 48 'CUSTOMER' 07770O 75 'COST/PRICE' 07780O 90 'QUANTITY' 07790O 100 'QUANTITY' 07800O 111 'QUANTITY' 07810O 121 'SCHEDULE' 07820O 131 'AVAILABLE' 07830O*------------------------------------------------------------------- 07840O E 71 07850O 8 'PART-NO.' 07860O 25 'DESCRIPTION' 07870O 38 'ORDER-NO.' 07880O 60 'ASSY PART-NO,QTY-PER' 07890O 79 'REV,START-DATE' 07900O 89 'ON-HAND' 07910O 100 'ON-ORDER' 07920O 111 'REQUIRED' 07930O 119 'DATE' 07940O 130 'BALANCE' 07950O*------------------------------------------------------------------- 07960O E 74 07970O 1 ' ' 07980O*------------------------------------------------------------------- 07990O E 74 08000O PMPN 12 ' - - ' ÐÐ08010O PMDESC 43 08020O SCNAME 55 08030O PMECHG 69 08040O PMOSUC2 80 08050O PMOHB J 91 08060O AVAIL J 132 08070O*------------------------------------------------------------------- 08080O E 75 08090O 26 'SAFETY STOCK' 08100O PMSSTKJ 111 08110O AVAIL J 132 08120O*------------------------------------------------------------------ 08130O E 81 08140O 12 '...CONT''D' 08150O*------------------------------------------------------------------- 08160O E 72 08170O 01 21 'RECD-PO' 08180O 02 20 'REL-WO' 08190O 03 23 'PUR-ORDER' 08200O 04 21 'PLAN-WO' 08210O 05 23 'PURCH-REQ' 08220O 06 25 'SALES-ORDER' 08230O 07 23 'BACKORDER' 08240O 08 24 'PLAN-REQMT' 08250O 09 22 'FORECAST' ÐÐ08260O N09 SFPRIM 32 08270O N09 33 '-' 08280O N09 SFDASH 36 08290O 70 37 '-' 08300O 70 SFRLOG 39 08310O N13 SFCUSTZ 45 08320O 13 SFNAPN 52 ' - - ' 08330O 17 SFREV 69 08340O 13 QPA5 Z 59 08350O 13 SFISSU 62 08360O 15 SFCPO 60 08370O 14 SFSTRT 79 ' - - ' 08380O 16 SFPRIC2 80 08390O 16 SFPCOD 81 08400O 01 SFDLT 69 ' - - ' 08410O QTYORDKB 101 08420O QTYREQKB 111 08430O SFDUE 121 ' - - ' 08440O AVAIL J 132 08450O*------------------------------------------------------------------- 08460O E 76 55 08470O BIT,28 1 08480O 2 'D' 08490O 17 '***' 08500O 30 'TO BE ORDERED' ÐÐ08510O 35 '***' 08520O BIT,28 100 08530O 101 'E' 08540O*-------------------------------------------------------------- 08550O E 76 08560O* PUT PART NUMBER TOTALS 08570O AR 132 08580O 80 'TOTALS.....' 08590O PMOHB J 91 08600O ORDBALJB 101 08610O REQBALJB 111 08620O AVAIL J 132 08630O*------------------------------------------------------------------- 08640O E 73 08650O NUL 132 08660O BLK12 12 08670O BLK12 16 08680O N50 19 '... ' 08690O 50 19 ' ' 08700O MGTEXT 54 08710O*---------------------------------------------------------------- 08720O E 82 08730O NUL 132 08740O 24 'ENTER PART OR MODEL NO. ' 08750O 26 ' ' ÐÐ08760O*------------------------------------------------------------------ 08770O E 83 08780O NUL 132 08790O 16 'END OF PAGE--- ' 08800O 38 'ENTER PART #, MODEL #,' 08810O 61 '\-CODE, OR RETURN: ' 08820O*--------------------------------------------------------------------- 08830O E 78 08840O RKTEXT 79 08850O 18 '*' 08860O 81 '*' 08870O******************************************************************** 08880OCRTFILE E 97 08890O PROG 26 08900O CRTIME 33 08910O CRDATE 37 08920O LNK 79 08930O******************************************************************** ** A12 ARRAY 008940 008950** AR ARRAY 008960 008970** TABSC/TABSCN SOURCE CODES/NAMES 008980MAMFG-ASSY 008990PAPURCH-ASSY 009000ÐÐMPMFG-PART 009010PPPURCH-PART 009020RSRAW-STOCK 009030RDREF-DOCUMENT 009040** NUL ARRAY 09050 09060** LNK ARRAY 09070 09080** SWO ARRAY 09090 09100/* 09110_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È3\ ÈTX004DC P”050383050383(èÈÐ00010H Q004DC00020F* P. O. ITEM - TO DISK80 FOR FLOPPY CONVERSION TO DEC 00030F* REVISED 5-03-83 11:45 AM. 00040FPOITEM IP F 384 9AI 1 DISK 00050FDISK80 O F 80 DISK 00060E***************************************************************** 00070E PID 26 6 0A POITEM SCHED DATES 00080E PIQ 26 7 0A POITEM SCHED QTYS 00090I******************************************************************** 00100IPOITEM PI 00110I* PURCHASE ORDER ITEM RECORD. 00120I* KEY AREA. 00130I* PO # 6N 00140I 1 60PIPO 00150I* PO ITEM 3N 00160I* * * * * * 7 90PIITEM 00170I* DYNAIR PART # 10N 00180I 10 190PIPN 00190I* VENDOR PART # 15A 00200I 20 34 PIVPN 00210I* DESCRIPTION 29A 00220I 35 63 PIDESC 00230I* NON-INVENTORY DESCRIPTION 70A 00240I 10 79 PINDES 00250I* DATE LAST RECEIPT 6N ÐÐ00260I 80 850PIDLR 00270I* QTY RECEIVED 7P 00280I P 86 890PIQRCD 00290I* QTY TO STK,SCRAP,RTV 7P 00300I P 90 930PIQSTK 00310I* PRICE CODE 1A 00320I* L = LOT 00330I* N = NO CHARGE 00340I 94 94 PILOT 00350I* PRICE 9.3P 00360I P 95 993PI$PRC 00370I* WORK ORDER # 9A 00380I 100 108 PIWO 00390I 100 105 PIWOP 00400I 106 1080PIWOD 00410I* VENDOR # 5P (FROM POMAST) 00420I P 109 1110PIVEND 00430I* LAST RCVG LOG # USED 2N 00440I 112 1130PILLOG 00450I* SCHEDULE DATES 6N X 26 (Y,M,D) 00460I 114 269 PID 00470I* SCHED QTYS 7P X 26 00480I P 270 373 PIQ 00490I* BACKORDERS SUPPLIED BY P/O 00500I P 374 3770PIABOQ ÐÐ00510I* DATE ENTERED 4N (MM/DD) 00520I 378 3810PIDATE 00530I* RECORD STATUS 1A 00540I 384 384 PISTAT 00550I********************************************************************* _‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(  Š  NX109DP P999999120282(èÈÐ00010H Q109DP00020F* UPDATE JOBLOAD FILE. (X109DP) 00030F* REVISED 10-02-81 4:45 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FJOBLOAD UC F 1150R DISK 00080FTERM78 O F 78 5 00090F**************************************************************** 00100E NUL 1 78 1 NULL CHAR 00110E A16 16 16 1 A INPUT DATA ARRAY 00120E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00130E DUN 1 4 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E BIT 33 1 SCREEN CONTR. CHAR 00160E CALL 5 6 CALL STACK 00170E JOB 50 8 A 00180E DES 50 15 00190I******************************************************************* 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************* 00230IMGFILE MG 00240I* MESSAGE FILE. 00250I 1 35 MGTEXT ÐÐ00260I****************************************************************** 00270ICRTFILE CR 00280I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00290I* EMPLOYEE # 5N 00300I 1 50CREMPL 00310I* USER CODE 8A 00320I 6 13 CRUSER 00330I* DEPT # 5N 00340I 14 180CRDEPT 00350I* JOB NAME 8A (JOB LOADED BY MENU) 00360I 19 26 CRJOB 00370I* SHUTDOWN FLAG 1A 00380I* BLANK = NO SHUTDOWN 00390I 27 27 CRSHUT 00400I* TIME STARTED 6N 00410I 28 330CRTIME 00420I* DATE STARTED 4N 00430I 34 370CRDATE 00440I* CALL STACK 5 X 6A 00450I 38 67 CALL 00460I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00470I 68 73 CRRET 00480I* MENU NAME 6A 00490I 74 79 CRMENU 00500I******************************************************************** ÐÐ00510IJOBLOAD JL 00520I 1 400 JOB 00530I 4011150 DES 00540C******************************************************************** 00550C* INITIALIZE 00560C EXSR SR101 1-TIME INIT 00570C*------------------------------------------------------------------ 00580C START TAG 00590C* SET-UP 1ST FIELD NO. 00600C EXSR SR68 MOVE CURSOR 00610C EXSR SR68 MOVE CURSOR 00620C MOVE ' ' TRAN 00630C MOVE ' 'TJOB 00640C MOVE BLK35 TDES 00650C Z-ADD0 J 00660C MOVE ' ' DUN INIT EDIT ARRAY 00670C Z-ADD1 F 30 FIELD # 00680C GOTO READ 00690C*------------------------------------------------------------------ 00700C NEXT TAG 00710C* SET-UP NEXT FIELD NO. 00720C 1 ADD F F FIELD # 00730C*----------------------------------------------------------------- 00740C READ TAG 00750C* READ DATA FROM TERMINAL. ÐÐ00760C SETOF 909677 00770C EXSR SR308 00780C N54 EXSR SR308 00790C N54 EXSR SR308 00800C 54 GOTO START 00810C EXSR SR102 VALIDATE FIELD # 00820C 55 GOTO UPDATE DONE 00830C EXSR SR201 IDENTIFY-F 00840C 03 EXSR SR203 00850C 03 63 LIST 00860COR 03 64 GOTO UPDATE DEL-ALL 00870C SETON 69 00880C EXSR SR72 PROMPT 00890C SETOF 69 00900C EXSR SR75 READ TERMINAL 00910C*------------------------------------------------------------------- 00920C ESCAPE TAG 00930C 98 GOTO GOODBY GOODBY 00940C 94 GOTO MENU MENU REQUEST 00950C 93 GOTO NEWITM NEW ITEM 00960C 92 GOTO JUMP FIELD JUMP REQST 00970C 91 GOTO START 00980C 89 F SUB 1 F SKIP BACKWARD 00990C 89 GOTO READ " " 01000C 88 SETOF 90 SPACE FILL ÐÐ01010C 88 SETON 77 " " 01020C 87 GOTO START 01030C 86 EXSR SR82 01040C 86 GOTO MENU 01050C 85 GOTO READ REPEAT 01060C 96 GOTO ERROR ERROR 01070C N77 GOTO EDIT NO DATA INPUT 01080C*------------------------------------------------------------------ 01090C PROCES TAG 01100C* PROCESS INPUT DATA 01110C EXSR SR103 MOVE DATA 01120C*------------------------------------------------------------------- 01130C EDIT TAG 01140C N96 EXSR SR104 EDIT DATA 01150C EXITFQMOVUP 01160C EXSR SR72 01170C 96 GOTO ERROR ERROR 01180C GOTO NEXT 01190C*------------------------------------------------------------------ 01200C UPDATE TAG 01210C* UPDATE DATA BASE. 01220C EXSR SR105 FINAL EDIT 01230C 96 GOTO ERROR ERROR 01240C EXSR SR106 UPDATE 01250C 96 GOTO ERROR ERROR ÐÐ01260C 90 GOTO ESCAPE 01270C EXSR SR203 01280C 60 ADD 01290COR 61 Z-ADD3 F CHG 01300C 62 Z-ADD2 F 01310C 60 MOVE BLK35 TJOB 01320C 61 MOVE BLK35 TJOB 01330C 60 MOVE BLK35 TDES 01340C 61 MOVE BLK35 TDES 01350C 60 01360COR 61 01370COR 62 GOTO READ 01380C GOTO START 01390C*------------------------------------------------------------------- 01400C JUMP TAG 01410C* SET-UP JUMP TO REQUESTED FIELD 01420C 1 ADD W W 30 01430C W COMP 16 54 01440C 54 Z-ADD318 M 50 96 FLAG ERROR 01450C 54 GOTO ERROR BAD ESC 01460C MOVE ' ' W3A 3 01470C MOVEAA16,W W3A 01480C Z-ADD3 W2N 20 01490C EXIT SUBRAJ R. JUSTIFY 01500C RLABL W2N ÐÐ01510C RLABL W3A 01520C MOVE W3A F NEW FIELD # 01530C GOTO READ 01540C*-------------------------------------------------------------------- 01550C ERROR TAG 01560C EXSR SR102 VALIDATE FIELD # 01570C EXSR SR89 GET MSG 01580C EXSR SR73 PUT MSG 01590C GOTO READ 01600C*------------------------------------------------------------------ 01610C NEWITM TAG 01620C* SET-UP LINK FOR NEW ITEM 01630C MOVEL'Q109DP' PROG 8 01640C GOTO START 01650C*------------------------------------------------------------------- 01660C MENU TAG 01670C* SET-UP LINK TO MENU 01680C MOVELCRMENU PROG 01690C GOTO END 01700C*-------------------------------------------------------------------- 01710C GOODBY TAG 01720C* LINK TO SIGN-OFF 01730C MOVEL'GOODBY' PROG 01740C GOTO END 01750C*------------------------------------------------------------------- ÐÐ01760C END TAG 01770C EXITFCHAIN LINK TO NEXT PROG 01780C RLABL PROG 01790C*------------------------------------------------------------------- 01800C ENDJOB TAG 01810C********************************************************************* 01820CSR SR1 BEGSR 01830C* EDIT TRAN CODE. 01840CSR EXSR SR203 CLASSIFY TRAN 01850CSRN60N61N62 01860CANN63N64 Z-ADD300 M 50 96 FLAG ERROR 01870CSR ENDSR 01880C******************************************************************* 01890CSR SR2 BEGSR 01900C* EDIT ARRAY INDEX (J). 01910CSR J COMP 0 54 01920CSR 54 J COMP 50 5454 01930CSRN54 Z-ADD436 M 96 FLAG ERROR 01940CSR ENDSR 01950C******************************************************************** 01960CSR SR68 BEGSR 01970CSR EXITFQCLF LF 01980CSR ENDSR 01990C********************************************************************** 02000CSR SR71 BEGSR ÐÐ02010C* PUT HEADINGS TO TERMINAL 02020CSR Z-ADD1 COUNT 30 02030CSR EXSR SR68 LF 02040CSR SETON 71 02050CSR EXCPT PUT HEADINGS 02060CSR SETOF 71 02070CSR ENDSR 02080C********************************************************************* 02090CSR SR72 BEGSR 02100C* PUT DATA TO TERMINAL 02110CSR 03 MOVE JOB,J JOB9 9 02120CSR 04 MOVE DES,J DES16 16 02130CSR SETON 72 02140CSR EXCPT PUT DATA 02150CSR SETOF 72 02160CSR ENDSR 02170C******************************************************************** 02180CSR SR73 BEGSR 02190C* PUT MESSAGE. 02200CSR SETON 73 02210CSR EXCPT PUT MSG 02220CSR SETOF 73 02230CSR ENDSR 02240C******************************************************************* 02250CSR SR75 BEGSR ÐÐ02260C* READ FROM TERMINAL 02270CSR SETOF 779096 02280CSR SETOF 939291 02290CSR SETOF 898887 02300CSR SETOF 8685 02310CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 02320CSR MOVE BLK16 W16A 16 BUFFER 02330CSR EXITFQBELL RING BELL 02340CSR EXITFQWREED READ FROM TERMINAL 02350CSR RLABL W16A READ BUFFER 02360CSR RLABL BUFLGT READ BUFFER LGTH 02370CSR MOVEAW16A A16 INPUT DATA ARRAY 02380CSR MOVE BLK16 W16A INIT INPUT ARRAY 02390CSR Z-ADD1 W 30 02400CSR '\' LOKUPA16,W 90 FLAG ESC 02410CSRN90 GOTO T75B NOT ESC 02420CSR 1 ADD W W 02430CSR W COMP 16 54 02440CSR 54 GOTO T75A BAD ESC 02450CSR A16,W COMP 'G' 98 GOODBY 02460CSR A16,W COMP 'E' 94 MENU 02470CSR A16,W COMP 'N' 93 NEW ITEM 02480CSR A16,W COMP 'J' 92 JUMP 02490CSR A16,W COMP 'D' 91 DONE 02500CSR A16,W COMP 'B' 89 SKIP BKWRD ÐÐ02510CSR A16,W COMP 'S' 88 SPACE FILL 02520CSR A16,W COMP 'H' 87 HOME 02530CSR A16,W COMP 'U' 86 UPDATE 02540CSR A16,W COMP 'R' 85 REPEAT 02550CSR 98 02560COR 94 02570COR 93 02580COR 92 02590COR 91 02600COR 89 02610COR 88 02620COR 87 02630COR 86 02640COR 85 GOTO END75 GOOD ESC 02650C*------------------------------------------------------------------ 02660CSR T75A TAG 02670C* FLAG BAD ESC INPUT 02680CSR Z-ADD318 M 96 FLAG ERROR 02690CSR GOTO END75 02700C*-------------------------------------------------------------------- 02710CSR T75B TAG 02720C* MOVE DATA 02730CSR Z-ADD1 W 02740CSR ' ' LOKUPA16,W 77 02750CSR 77 MOVEAA16,W W16A INPUT DATA ÐÐ02760C*-------------------------------------------------------------------- 02770CSR END75 TAG 02780C* INIT PREV ERROR MSG. 02790CSR MOVE BLK35 MGTEXT 02800CSR ENDSR 02810C********************************************************************** 02820CSR SR80 BEGSR 02830C* GET JOBLOAD RECORD. 02840CSR SETOF 61 02850CSR PORT CHAINJOBLOAD H8 GET MASTER 02860CSR H8 GOTO ENDJOB 02870CSR ENDSR 02880C*********************************************************************** 02890CSR SR82 BEGSR 02900C* REWRITE MASTER 02910CSR SETON 82 02920CSR EXCPT REWRITE MASTER 02930CSR SETOF 82 02940CSR ENDSR 02950C********************************************************************** 02960CSR SR89 BEGSR 02970C* GET MESSAGE MASTER 02980CSR M CHAINMGFILE 54 02990CSR 54 MOVE BLK35 MGTEXT 03000CSR 54 MOVELM MGTEXT ÐÐ03010CSR 54 MOVE MES,1 MGTEXT 03020CSR ENDSR 03030C*********************************************************************** 03040CSR SR101 BEGSR 03050C* 1-TIME INITIALIZE 03060CSR MOVE BIT,1 NUL 03070CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03080CSR Z-ADD4 FLIMIT 30 TOTAL NUMB FIELDS 03090CSR MOVE ' ' BLK16 16 03100C* GET PORT # AND CRTFILE 03110CSR MOVE ' ' W8A 8 03120CSR Z-ADD0 W2N 20 03130CSR Z-ADD0 W1N 10 03140CSR MOVE ' ' W2A 2 03150CSR EXITFPGMINX GET PORT # 03160CSR RLABL W8A 03170CSR RLABL W2N 03180CSR RLABL W1N 03190CSR RLABL W2A 03200CSR MOVE W2A PORT 20 PORT NO. 03210CSR PORT COMP 0 54 03220CSRN54 Z-ADD25 PORT DEFAULT 03230CSR PORT CHAINCRTFILE H9 03240CSR H9 GOTO ENDJOB 03250CSR EXSR SR80 ÐÐ03260C* DEFINE WORK FIELDS,ETC. 03270CSR MOVE ' ' BLK35 35 03280CSR MOVE ' ' BLK15 15 03290CSR MOVE ' ' BLK8 8 03300CSR ENDSR 03310C********************************************************************** 03320CSR SR102 BEGSR 03330C* VALIDATE FIELD NO. 03340CSR F COMP 0 54 03350CSRN54 Z-ADD1 F 03360CSR F COMP FLIMIT 55 03370CSR 55 Z-ADD1 F 03380CSR ENDSR 03390C******************************************************************** 03400CSR SR103 BEGSR 03410C* MOVE INPUT DATA 03420CSR EXSR SR201 IDENTIFY-F 03430CSR EXSR SR202 R. JUSTIFY 03440CSR 01 MOVELW16A TRAN 1 03450CSR 02 MOVE W10A J 30 03460CSR 03 MOVELW16A TJOB 8 03470CSR 04 MOVELW16A TDES 15 03480CSR MOVE ' ' DUN,F EDIT FLAG 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR104 BEGSR 03520C* EDIT INPUT DATA 03530CSR 01 EXSR SR1 03540CSR 02 EXSR SR2 03550CSR 96 MOVE ' ' DUN,F EDIT FLAG 03560CSRN96 MOVE 'X' DUN,F 03570CSR ENDSR 03580C*********************************************************************** 03590CSR SR105 BEGSR 03600C* FINAL EDIT 03610CSR SETOF 77 03620CSR SETON 79 FINAL EDIT FLAG 03630CSR Z-ADD1 F 96 03640C*-------------------------------------------------------------------- 03650CSR T105A TAG 03660CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03670CSRN54 GOTO END105 03680CSR EXSR SR201 IDENTIFY-F 03690CSR EXSR SR104 EDIT 03700CSRN96 GOTO T105A 03710C*-------------------------------------------------------------------- 03720CSR END105 TAG 03730CSR SETOF 79 03740CSR ENDSR 03750C******************************************************************** ÐÐ03760CSR SR106 BEGSR 03770C* UPDATE. 03780CSR EXSR SR203 CLASSIFY TRAN 03790CSR 60 GOTO T106A ADD/INSERT 03800CSR 61 GOTO T106C CHG 03810CSR 62 DEL 03820COR 63 LIST 03830COR 64 GOTO T106B DEL ALL 03840CSR Z-ADD300 M 96 FLAG ERROR 03850CSR GOTO END106 03860C*-------------------------------------------------------------------- 03870CSR T106A TAG 03880CSR EXSR SR300 ADD/INSERT 03890CSR GOTO END106 03900C*-------------------------------------------------------------------- 03910CSR T106B TAG 03920CSR EXSR SR301 NOT ADD/CHG 03930CSR GOTO END106 03940C*--------------------------------------------------------------- 03950CSR T106C TAG 03960CSR EXSR SR302 CHANGE 03970CSR END106 ENDSR 03980C************************************************************************ 03990CSR SR201 BEGSR 04000C* IDENTIFY FIELD NO. ÐÐ04010CSR F COMP 1 01 04020CSR F COMP 2 02 04030CSR F COMP 3 03 04040CSR F COMP 4 04 04050CSR ENDSR 04060C********************************************************************** 04070CSR SR202 BEGSR 04080C* RIGHT JUSTIFY 04090CSR F LOKUPNUM 54 04100CSRN54 GOTO END202 NOT NUMERIC FIELD 04110CSR Z-ADD10 W2N 20 04120CSR MOVELW16A W10A 10 04130CSR EXIT SUBRAJ R. JUSTIFY 04140CSR RLABL W2N 04150CSR RLABL W10A 04160CSR END202 ENDSR 04170C*********************************************************************** 04180CSR SR203 BEGSR 04190C* CLASSIFY TRAN CODE 04200CSR TRAN COMP 'A' 60 ADD 04210CSR TRAN COMP 'C' 61 CHANGE 04220CSR TRAN COMP 'D' 62 DELETE 04230CSR TRAN COMP 'L' 63 LIST 04240CSR TRAN COMP '#' 64 DELETE ALL 04250CSR MOVE BLK35 TRNNAM 10 ÐÐ04260CSR 60 MOVEL'ADD' TRNNAM 04270CSR 61 MOVEL'CHANGE' TRNNAM 04280CSR 62 MOVEL'DELETE' TRNNAM 04290CSR 63 MOVEL'LIST' TRNNAM 04300CSR 64 MOVEL'DELETE' TRNNAM 04310CSR 64 MOVE 'ALL' TRNNAM 04320CSR ENDSR 04330C**************************************************************************04340CSR SR300 BEGSR 04350C* INSERT. 04360CSR Z-ADD49 A 30 04370C*------------------------------------------------------------------- 04380CSR T300A TAG 04390CSR 1 ADD A B 30 04400CSR MOVE JOB,A JOB,B 04410CSR MOVE DES,A DES,B 04420CSR A SUB 1 A 04430CSR A COMP J 54 04440CSRN54 GOTO T300A 04450CSR MOVE TJOB JOB,J 04460CSR MOVE TDES DES,J 04470CSR 1 ADD J J 04480CSR J COMP 50 54 04490CSR 54 SETON 9091 04500CSR END300 ENDSR ÐÐ04510C******************************************************************** 04520CSR SR301 BEGSR 04530C* NON-ADD TRAN. 04540CSR EXSR SR203 CLASSIFY TRAN 04550CSR 63 EXSR SR71 04560CSR J SUB 1 A 04570C*------------------------------------------------------------------- 04580CSR T301A TAG 04590CSR EXSR SR308 04600CSRN54 EXSR SR308 04610CSRN54 EXSR SR308 04620CSRN54 EXSR SR308 04630CSRN54 EXSR SR308 04640CSRN54 EXSR SR308 04650CSR 54 SETON 9091 04660CSR 54 GOTO END301 04670CSR 1 ADD A A 04680CSR A COMP 50 54 04690CSR 54 GOTO END301 04700CSR EXSR SR203 CLASSIFY TRAN 04710CSR 61 GOTO T301C CHG 04720CSR 62 GOTO T301E DEL 04730CSR 63 GOTO T301G LIST 04740CSR 64 GOTO T301E DEL-ALL 04750C*------------------------------------------------------------------- ÐÐ04760CSR T301C TAG 04770CSR MOVE TJOB JOB,A 04780CSR MOVE TDES DES,A 04790CSR GOTO END301 04800C*------------------------------------------------------------------- 04810CSR T301E TAG 04820CSR MOVE BLK8 JOB,A 04830CSR MOVE BLK15 DES,A 04840CSR SETON 83 04850CSR EXCPT 04860CSR SETOF 83 04870CSR 62 1 ADD J J 04880CSR 62 J COMP 50 54 04890CSR 62 54 SETON 9091 04900CSR 62 GOTO END301 DEL-ONE 04910CSR GOTO T301A DEL-ALL 04920C*------------------------------------------------------------------- 04930CSR T301G TAG 04940CSR 1 ADD COUNT COUNT 04950CSR SETON 83 04960CSR EXCPT LIST 04970CSR SETOF 83 04980CSR COUNT COMP 23 54 04990CSRN54 GOTO T301A 05000CSR SETON 84 ÐÐ05010CSR EXCPT END PAGE 05020CSR SETOF 84 05030CSR EXSR SR75 READ 05040CSR 90 GOTO END301 05050CSR EXSR SR71 PUT HDG 05060CSR GOTO T301A 05070CSR END301 ENDSR 05080C***************************************************************** 05090CSR SR302 BEGSR 05100C* CHANGE 05110CSR MOVE TJOB JOB,J 05120CSR MOVE TDES DES,J 05130CSR 1 ADD J J 05140CSR J COMP 50 54 54 05150CSR 54 SETON 9091 05160CSR END302 ENDSR 05170C****************************************************************** 05180CSR SR308 BEGSR 05190C* CHECK FOR CONTROL-D INPUT. 05200CSR EXITFQSTOP CHECK CONTROL-D 05210CSR RLABL W2A 05220CSR W2A COMP 'XX' 54 05230CSR ENDSR 05240O******************************************************************** 05250OTERM78 E 72 ÐÐ05260O NUL 78 05270O 01 24 'TRAN CODE,(A,C,D,L,#) : ' 05280O 02 24 'LINE # : ' 05290O 03 24 'JOB # : ' 05300O 04 24 'DESCRIPTION : ' 05310O 26 ' ' 05320O 01 TRAN 27 05330O 01 29 ' ' 05340O 01 TRNNAM 39 05350O 01 43 ' ' 05360O 02 J Z 29 05370O 02 43 ' ' 05380O 03 JOB9 35 05390O 03 43 ' ' 05400O 04 DES16 42 05410O 04 43 ' ' 05420O BIT,28 44 05430O 45 'L' 05440O*------------------------------------------------------------------- 05450O E 71 05460O 4 'LINE' 05470O 11 'JOB' 05480O 26 'DESCRIPTION' 05490O*------------------------------------------------------------------- 05500O E 83 ÐÐ05510O A Z 3 05520O JOB,A 13 05530O DES,A 30 05540O*------------------------------------------------------------------- 05550O E 84 05560O NUL 78 05570O 24 'END PAGE ' 05580O*------------------------------------------------------------------- 05590O E 73 05600O MGTEXT 35 05610O******************************************************************** 05620OJOBLOAD E 82 05630O JOB 400 05640O DES 1150 05650O******************************************************************** ** NUL ARRAY 005660 005670** A16 ARRAY 005680 005690** NUM ARRAY 005700002 INDEX # 005710** DUN ARRAY 005720 005730** MES ARRAY 005740---MESSAGE NOT ON FILE--- 005750ÐÐ/* 005760_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( Ù §X001BG P120282120282(èÈÐ00010H Q001BG00020F* UPDATE ACCOUNTING PERIOD DATES. (X001BG) 00030F* REVISED 3-18-80 10:10 AM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FBGCONT UC F 160R DISK 00070F* 00080F* 00090F* 00100FTERM60 O F 60 5 00110E******************************************************************** 00120E NUL 1 60 1 00130E A6 6 6 1 A INPUT DATA ARRAY 00140E NUM 1 25 3 0 NUMERIC FIELD NO.'S 00150E MES 1 1 30 00160E* 00170E* 00180E* 00190E BIT 33 1 SCREEN CONTR. CHAR 00200E BCD 25 6 0 DATES 00210E* 00220I******************************************************************* 00230IBITTAB BT 00240I 1 33 BIT 00250I******************************************************************* ÐÐ00260IMGFILE MG 00270I* MESSAGE FILE. 00280I 1 35 MGTEXT 00290I****************************************************************** 00300IBGCONT BG 00310I* BUDGET CONTROL MAST. 00320I* DATES 6N X 25 00330I 1 150 BCD 00340I* CUR INDEN LEVEL 2N 00350I 151 1520BCCIL 00360C******************************************************************** 00370C* INITIALIZE 00380C EXSR SR101 1-TIME INIT 00390C*------------------------------------------------------------------ 00400C START TAG 00410C* SET-UP 1ST FIELD NO. 00420C Z-ADD1 F 30 FIELD # 00430C GOTO READ 00440C*------------------------------------------------------------------ 00450C NEXT TAG 00460C* SET-UP NEXT FIELD NO. 00470C 1 ADD F F FIELD # 00480C*----------------------------------------------------------------- 00490C READ TAG 00500C* READ DATA FROM TERMINAL. ÐÐ00510C SETOF 9096 00520C EXSR SR102 VALIDATE FIELD # 00530C 55 GOTO UPDATE DONE 00540C SETON 69 00550C EXSR SR72 PROMPT 00560C SETOF 69 00570C EXSR SR75 READ TERMINAL 00580C*------------------------------------------------------------------- 00590C ESCAPE TAG 00600C 98 GOTO GOODBY GOODBY 00610C 94 GOTO MENU MENU REQUEST 00620C N77N88 EXSR SR104 EDIT INPUT FIELD 00630C 96 ERROR 00640CORN77N88 EXSR SR72 REWRITE INPUT DATA 00650C 93 GOTO NEWITM NEW ITEM 00660C 92 GOTO JUMP FIELD JUMP REQST 00670C 91 GOTO NEXT SKIP FORWARD 00680C 89 F SUB 1 F SKIP BACKWARD 00690C 89 GOTO READ " " 00700C 88 SETOF 90 SPACE FILL 00710C 88 SETON 77 " " 00720C 87 GOTO START 00730C 86 GOTO UPDATE UPDATE 00740C 85 GOTO READ REPEAT 00750C 96 GOTO ERROR ERROR ÐÐ00760C N77 GOTO NEXT NO DATA INPUT 00770C*------------------------------------------------------------------ 00780C PROCES TAG 00790C* PROCESS INPUT DATA 00800C EXSR SR103 MOVE DATA 00810C N96 EXSR SR104 EDIT DATA 00820C EXSR SR72 REWRITE DATA 00830C 96 GOTO ERROR ERROR 00840C GOTO NEXT 00850C*------------------------------------------------------------------ 00860C UPDATE TAG 00870C* UPDATE DATA BASE. 00880C EXSR SR105 FINAL EDIT 00890C 96 GOTO ERROR ERROR 00900C EXSR SR106 UPDATE 00910C 96 GOTO ERROR ERROR 00920C GOTO MENU 00930C*------------------------------------------------------------------- 00940C JUMP TAG 00950C* SET-UP JUMP TO REQUESTED FIELD 00960C 1 ADD W W 30 00970C W COMP 6 54 00980C 54 Z-ADD318 M 50 96 FLAG ERROR 00990C 54 GOTO ERROR BAD ESC 01000C MOVE '000' W3A 3 ÐÐ01010C MOVEAA6,W W3A 01020C Z-ADD3 W2N 20 01030C EXIT SUBRAJ R. JUSTIFY 01040C RLABL W2N 01050C RLABL W3A 01060C MOVE W3A F NEW FIELD # 01070C GOTO READ 01080C*-------------------------------------------------------------------- 01090C ERROR TAG 01100C EXSR SR102 VALIDATE FIELD # 01110C EXSR SR89 GET MSG 01120C EXSR SR72 PUT MSG 01130C GOTO READ 01140C*------------------------------------------------------------------ 01150C NEWITM TAG 01160C* SET-UP LINK FOR NEW ITEM 01170C MOVEL'Q001BG' PROG 8 01180C GOTO END 01190C*------------------------------------------------------------------- 01200C MENU TAG 01210C* SET-UP LINK TO MENU 01220C MOVEL'QQBG01' PROG 01230C GOTO END 01240C*-------------------------------------------------------------------- 01250C GOODBY TAG ÐÐ01260C* LINK TO SIGN-OFF 01270C MOVEL'GOODBY' PROG 01280C GOTO END 01290C*------------------------------------------------------------------- 01300C END TAG 01310C EXITFCHAIN LINK TO NEXT PROG 01320C RLABL PROG 01330C***************************************************************** 01340CSR SR70 BEGSR 01350C* CLEAR TERM SCREEN. 01360CSR SETON 70 01370CSR EXCPT CLEAR SCREEN 01380CSR SETOF 70 01390CSR ENDSR 01400C********************************************************************** 01410CSR SR71 BEGSR 01420C* PUT HEADINGS TO TERMINAL 01430CSR SETON 71 01440CSR EXCPT PUT HEADINGS 01450CSR SETOF 71 01460CSR Z-ADD0 F 01470C*------------------------------------------------------------------- 01480CSR T71A TAG 01490CSR 1 ADD F F 01500CSR F COMP 25 54 ÐÐ01510CSR 54 GOTO END71 01520CSR EXSR SR72 01530CSR GOTO T71A 01540CSR END71 ENDSR 01550C********************************************************************* 01560CSR SR72 BEGSR 01570C* PUT DATA TO TERMINAL 01580CSR F ADD 2 W3N 30 01590CSR MOVELW3N W6A 6 01600CSR MOVE '001' W6A 01610CSR EXITFQXYPOS 01620CSR RLABL W6A 01630CSR EXITFQMOVUP 01640CSR SETON 72 01650CSR EXCPT PUT DATA 01660CSR SETOF 72 01670CSR EXITFQCCR 01680CSR MOVE BIT,9 BUFLGT 01690CSR EXITFQMOVR MOVE CURSOR RIGHT 01700CSR RLABL BUFLGT 01710CSR ENDSR 01720C******************************************************************* 01730CSR SR75 BEGSR 01740C* READ FROM TERMINAL 01750CSR SETOF 779096 ÐÐ01760CSR SETOF 939291 01770CSR SETOF 898887 01780CSR SETOF 8685 01790CSR MOVE BIT,4 BUFLGT 2 READ BUFFER LGTH 01800CSR MOVE BLK6 W6A 6 BUFFER 01810CSR EXITFQWREED READ FROM TERMINAL 01820CSR RLABL W6A READ BUFFER 01830CSR RLABL BUFLGT READ BUFFER LGTH 01840CSR MOVEAW6A A6 INPUT DATA ARRAY 01850CSR MOVE BLK6 W6A INIT INPUT ARRAY 01860CSR Z-ADD1 W 30 01870CSR '\' LOKUPA6,W 90 FLAG ESC 01880CSRN90 GOTO T75B NOT ESC 01890CSR 1 ADD W W 01900CSR W COMP 6 54 01910CSR 54 GOTO T75A BAD ESC 01920CSR A6,W COMP 'G' 98 GOODBY 01930CSR A6,W COMP 'E' 94 MENU 01940CSR A6,W COMP 'N' 93 NEW ITEM 01950CSR A6,W COMP 'J' 92 JUMP 01960CSR A6,W COMP 'F' 91 SKIP FRWRD 01970CSR A6,W COMP 'B' 89 SKIP BKWRD 01980CSR A6,W COMP 'S' 88 SPACE FILL 01990CSR A6,W COMP 'H' 87 HOME 02000CSR A6,W COMP 'U' 86 UPDATE ÐÐ02010CSR A6,W COMP 'R' 85 REPEAT 02020CSR 98 02030COR 94 02040COR 93 02050COR 92 02060COR 91 02070COR 89 02080COR 88 02090COR 87 02100COR 86 02110COR 85 GOTO END75 GOOD ESC 02120C*------------------------------------------------------------------ 02130CSR T75A TAG 02140C* FLAG BAD ESC INPUT 02150CSR Z-ADD318 M 96 FLAG ERROR 02160CSR GOTO END75 02170C*-------------------------------------------------------------------- 02180CSR T75B TAG 02190C* MOVE DATA 02200CSR Z-ADD1 W 02210CSR ' ' LOKUPA6,W 77 02220CSR 77 MOVEAA6,W W6A INPUT DATA 02230CSR END75 ENDSR 02240C*********************************************************************** 02250CSR SR82 BEGSR ÐÐ02260C* REWRITE MASTER 02270CSR SETON 82 02280CSR EXCPT REWRITE MASTER 02290CSR SETOF 82 02300CSR ENDSR 02310C********************************************************************** 02320CSR SR89 BEGSR 02330C* GET MESSAGE MASTER 02340CSR M CHAINMGFILE 54 02350CSR 54 MOVE BLK35 MGTEXT 02360CSR 54 MOVELM MGTEXT 02370CSR 54 MOVE MES,1 MGTEXT 02380CSR ENDSR 02390C*********************************************************************** 02400CSR SR101 BEGSR 02410C* 1-TIME INITIALIZE 02420CSR MOVE BIT,1 NUL 02430CSR EXSR SR70 CLEAR SCREEN. 02440CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 02450CSR Z-ADD25 FLIMIT 30 TOTAL NUMB FIELDS 02460CSR MOVE ' ' BLK6 6 02470C* GET CONTROL MAST. 02480CSR Z-ADD1 RRN 50 02490CSR RRN CHAINBGCONT H9 02500CSR H9 GOTO END101 ÐÐ02510CSR EXSR SR71 02520C* DEFINE WORK FIELDS,ETC. 02530CSR MOVE ' ' BLK35 35 02540CSR MOVE ' ' BLK10 10 02550C* 02560C* 02570C* 02580C* 02590CSR END101 ENDSR 02600C********************************************************************** 02610CSR SR102 BEGSR 02620C* VALIDATE FIELD NO. 02630CSR F COMP 0 54 02640CSRN54 Z-ADD1 F 02650CSR F COMP FLIMIT 55 02660CSR 55 Z-ADD1 F 02670CSR ENDSR 02680C******************************************************************** 02690CSR SR103 BEGSR 02700C* MOVE INPUT DATA 02710CSR EXSR SR202 R. JUSTIFY 02720CSR MOVE W6A BCD,F DATE 02730CSR ENDSR 02740C******************************************************************** 02750CSR SR104 BEGSR ÐÐ02760C* EDIT INPUT DATA 02770CSR EXSR SR105 02780CSR ENDSR 02790C*********************************************************************** 02800CSR SR105 BEGSR 02810C* FINAL EDIT 02820CSR Z-ADD0 W6N 60 02830CSR Z-ADD0 X 30 02840C*-------------------------------------------------------------------- 02850CSR T105A TAG 02860CSR 1 ADD X X 02870CSR X COMP 25 54 02880CSR 54 GOTO END105 02890CSR BCD,X COMP 0 54 02900CSRN54 GOTO T105A 02910CSR BCD,X COMP W6N 54 02920CSRN54 Z-ADD351 M 96 FLAG ERROR. 02930CSRN54 Z-ADDX F 02940CSRN54 GOTO END105 02950CSR Z-ADDBCD,X W6N 02960CSR GOTO T105A 02970CSR END105 ENDSR 02980C******************************************************************** 02990CSR SR106 BEGSR 03000C* UPDATE DATA BASE. ÐÐ03010CSR EXSR SR82 PUT BGCONT 03020CSR END106 ENDSR 03030C********************************************************************** 03040CSR SR202 BEGSR 03050C* RIGHT JUSTIFY 03060CSR F LOKUPNUM 54 03070CSRN54 GOTO END202 NOT NUMERIC FIELD 03080CSR Z-ADD6 W2N 20 03090CSR EXIT SUBRAJ R. JUSTIFY 03100CSR RLABL W2N 03110CSR RLABL W6A 03120CSR END202 ENDSR 03130O******************************************************************** 03140OBGCONT E 82 03150O BCD 150 03160O 152 '00' 03170O******************************************************************** 03180OTERM60 E 71 03190O BIT,28 1 03200O 8 '8001016' 03210O 32 'ENTER PERIOD START DATES' 03220O 33 ':' 03230O*------------------------------------------------------------------- 03240O E 71 03250O*------------------------------------------------------------------- ÐÐ03260O E 72 03270O NUL 60 03280O F Z 3 03290O 7 ' ' 03300O BCD,F 15 ' - - ' 03310O BLK10 25 03320O N69 MGTEXT B 60 03330O*------------------------------------------------------------------- 03340O E 70 03350O NUL 60 03360O BIT,13 1 ** NUL ARRAY 003370 003380** A6 ARRAY 003390 003400** NUM ARRAY 003410001 003420002 003430003 003440004 003450005 003460006 003470007 003480008 003490009 003500ÐÐ010 003510011 003520012 003530013 003540014 003550015 003560016 003570017 003580018 003590019 003600020 003610021 003620022 003630023 003640024 003650025 003660** MES ARRAY 003670---MESSAGE NOT ON FILE--- 003680/* 003690_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(– –?X001CM P120282120282(èÈÐ00010H Q001CM00020F* INITIALIZE CR2FILE. (X001CM) 00030F* ORDER ENTRY CUSTOMER MAST UPDATE START PROG. 00040F* REVISED 1/07/81 9:50 AM. DG-REL006 OK. 00050FBITTAB IP F 33 DISK 00060FCR2FILE UC F 672R DISK 00070E******************************************************************** 00080E BIT 33 1 SCREEN CONTR. CHAR 00090E CALL 5 6 CALL STACK 00100I******************************************************************* 00110IBITTAB BT 01 00120I 1 33 BIT 00130I******************************************************************** 00140ICR2FILE CR 00150I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00160I* STD AREA - SAME FOR ALL PROGRAMS. 00170I* CALL STACK 5 X 6A 00180I 38 67 CALL 00190I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00200I 68 73 CRRET 00210C******************************************************************** 00220C* INITIALIZE 00230C EXSR SR101 1-TIME INIT 00240C MOVE BLK6 CALL 00250C MOVE BLK6 CRRET ÐÐ00260C NH9 SETON 80 00270C NH9 EXCPT UPDATE CR2FILE. 00280C SETOF 80 00290CLR MOVEL'Q002CM' PROG 8 00300CLR EXITFCHAIN 00310CLR RLABL PROG 00320C*********************************************************************** 00330CSR SR101 BEGSR 00340C* 1-TIME INITIALIZE 00350C* GET PORT # AND CR2FILE 00360CSR MOVE ' ' W8A 8 00370CSR Z-ADD0 W2N 20 00380CSR Z-ADD0 W1N 10 00390CSR MOVE ' ' W2A 2 00400CSR EXITFPGMINX GET PORT # 00410CSR RLABL W8A 00420CSR RLABL W2N 00430CSR RLABL W1N 00440CSR RLABL W2A 00450CSR MOVE W2A PORT 20 PORT NO. 00460CSR PORT COMP 0 54 00470CSRN54 Z-ADD25 PORT DEFAULT 00480CSR PORT CHAINCR2FILE H9 00490C* DEFINE WORK FIELDS,ETC. 00500CSR MOVE ' ' BLK35 35 ÐÐ00510CSR MOVE ' ' BLK5 5 00520CSR MOVE ' ' BLK6 6 00530CSR Z-ADD0 ZERO5 50 00540CSR MOVE ' ' BLK20 20 00550CSR MOVE ' ' BLK11 11 00560CSR MOVE ' ' BLK15 15 00570CSR MOVE ' ' BLK21 21 00580CSR MOVE ' ' BLK3 3 00590CSR Z-ADD0 ZERO7 70 00600CSR Z-ADD0 ZERO1 10 00610CSR MOVE ' ' BLK1 1 00620CSR MOVE ' ' BLK2 2 00630CSR Z-ADD0 ZERO9 90 00640CSR Z-ADD0 ZERO3 30 00650CSR MOVE ' ' BLK8 8 00660CSR ENDSR 00670O******************************************************************** 00680OCR2FILE E 80 00690O ZERO5 5 00700O BLK20 25 00710O BLK35 60 00720O BLK35 95 00730O BLK35 130 00740O BLK35 165 00750O BLK35 200 ÐÐ00760O BLK35 235 00770O BLK35 270 00780O BLK2 272 00790O ZERO9 277P 00800O BLK35 307 00810O BLK35 342 00820O BLK35 367 00830O ZERO7 371P 00840O BLK8 379 00850O ZERO1 380 00860O BLK20 400 00870O ZERO9 405P 00880O ZERO9 410P 00890O ZERO9 415P 00900O ZERO9 420P 00910O ZERO9 425P 00920O ZERO9 430P 00930O ZERO9 435P 00940O ZERO9 440P 00950O ZERO9 445P 00960O ZERO9 450P 00970O ZERO9 455P 00980O ZERO9 460P 00990O ZERO9 465P 01000O ZERO9 470P ÐÐ01010O ZERO9 475P 01020O ZERO9 480P 01030O ZERO9 485P 01040O ZERO9 490P 01050O ZERO9 495P 01060O ZERO9 500P 01070O ZERO9 505P 01080O ZERO9 510P 01090O ZERO9 515P 01100O ZERO9 520P 01110O BLK1 521 01120O ZERO3 523P 01130O BLK1 524 01140O ZERO7 528P 01150O ZERO7 532P 01160O ZERO7 536P 01170O ZERO7 540P 01180O ZERO7 544P 01190O BLK5 549 01200O BLK1 550 01210O BLK8 558 01220O 559 ' ' 01230O BLK6 565 01240O BLK6 571 01250O 572 ' ' ÐÐ01260O ZERO5 575P 01270O BLK21 596 01280O 671 'Q001CM' 01290O BLK1 672 /* 001300_‚ ÐÐ_‚_‚0O ZERO5 575P 01270O BLK21 596 01280O 671 'Q001CM' 01290O BLK1 672 /* 001300_‚ ÐÈ( Á îX001EG P120282120282(èÈÐ00010H Q001EG00020F* UPDATE ENGINEERING TASK SCHED. (X001EG) DG REL006 OK 00030F* REVISED 5/15/80 4:30 PM. 00040FBITHEX IP F 256 DISK 00050FEGTABLE UC F 1202R DISK 00060FMGFILE IC F 80R DISK 00070FTERM132 O F 132 5 00080E********************************************************************* 00090E M1 60 60 1 A MAN 00100E N1 1 60 12 NAME 00110E M3 1 300 1 A MAN 00120E B3 1 300 4 START 00130E J3 1 300 1 JOB 00140E S3 1 300 1 SKILL 00150E E3 1 300 4 STOP 00160E H3 1 300 4 HRS 00170E P3 1 300 2 % 00180E J4 1 100 1 A JOB 00190E D4 1 100 12 DESCR 00200E W4 1 100 6 WO # 00210E J5 1 300 1 A JOB 00220E B5 1 300 4 START 00230E S5 1 300 1 SKILL 00240E H5 1 300 4 HRS 00250E E5 1 300 4 STOP ÐÐ00260E P5 1 300 2 % 00270E S6 60 60 1 A SKILL 00280E T6 1 60 12 TITLE 00290E A12 1 12 1 A 00300E BIT 256 1 00310E REC 1200 1 00320E* ARRAY STRUCTURE. 00330E* * M1+* * * * * * 1. MAN - M,N 00340E* * * N1 * * * * * 1.1 NAME - M,N 00350E*------------------------------------------------------------------- 00360E* * M3+* * * * * * 3. MAN - M,S,J,B,H,E 00370E* * * B3+* * * * * 3.1 START-M,S,J,B,H,E 00380E* * * * J3+* * * * 3.2 JOB -M,S,J,B,H,E 00390E* * * * * S3+* * * 3.3 SKILL-M,S,J,B,H,E 00400E* * * * * * E3 * * 3.4 STOP -M,S,J,B,H,E 00410E* * * * * * * H3 * 3.5 HRS -M,S,J,B,H,E 00420E* * * * * * * * P3 3.6 % -M,S,J,B,H,E 00430E*------------------------------------------------------------------- 00440E* * J4+* * * * * * 4. JOB -J,D,W 00450E* * * W4 * * * * * 4.1 NUMB -J,D,W 00460E* * * * D4 * * * * 4.2 DESCR-J,D,W 00470E*------------------------------------------------------------------- 00480E* * J5+* * * * * * 5. JOB -J,S,H,B,P,E 00490E* * * B5+* * * * * 5.1 START-J,S,H,B,P,E 00500E* * * * S5+* * * * 5.2 SKILL-J,S,H,B,P,E ÐÐ00510E* * * * * E5 * * * 5.3 STOP -J,S,H,B,P,E 00520E* * * * * * H5 * * 5.4 HRS -J,S,H,B,P,E 00530E* * * * * * * P5 * 5.5 % -J,S,H,B,P,E 00540E*------------------------------------------------------------------- 00550E* * S6+* * * * * * 6. SKILL-S,T 00560E* * * T6 * * * * * 6.1 TITLE-S,T 00570E*------------------------------------------------------------------- 00580E* + INDICATES CONTROL FIELDS IN ARRAY GROUP 00590E* M = MAN CODE 00600E* N = MAN NAME 00610E* S = SKILL 00620E* J = JOB CODE 00630E* B = START DATE 00640E* H = HRS AVAIL/REQD 00650E* P = PER CENT CMPLT 00660E* T = SKILL TITLE 00670E* D = JOB DESCRIPTION 00680E* W = JOB # 00690E* E = STOP DATE 00700E* SUB-ROUTINES TABLE GROUP 00710E* 10 UPDATE MAN/NAME TABLES (1) 00720E* 20 UPDATE MAN/SCHED TABLES (2) 00730E* 30 UPDATE JOB/DESCR TABLES (3) 00740E* 40 UPDATE JOB/SCHED TABLES (4) 00750E* 50 UPDATE SKILL/TITLE TABLES (5) ÐÐ00760E* 00770E* 00780E* 1400 DISPLAY MAN/NAME TABLES (6) 00790E* 1410 DISPLAY MAN/JOB TABLES (7) 00800E* 1420 DISPLAY JOB/DESCR TABLES (8) 00810E* 1430 DISPLAY JOB/SCHED TABLES (9) 00820E* 1440 DISPLAY SKILL/TITLE TABLES (10) 00830I********************************************************************* 00840IBITHEX BT 00850I 1 256 BIT 00860I********************************************************************* 00870IMGFILE MG 00880I 1 35 MGTEXT 00890I*************************************************************** 00900IEGTABLE EG 00910I 31202 REC 00920C**************************************************************** 00930C* SUB-ROUTINE STRUCTURE 00940C* REQUEST INPUT SR'S 00950C* 100 TRAN CODE 00960C* 110 MAN NAME 00970C* 120 SKILL TITLE 00980C* 130 JOB # 00990C* 140 JOB DESCRIPTION 01000C* 150 START DATE ÐÐ01010C* 160 STOP DATE 01020C* 170 HOURS 01030C* 180 % COMPLETE 01040C* 01050C* MATCH INPUT TO MASTER TABLES & GET CODE 01060C* 200 NAME TO N1 01070C* 210 TITLE TO T6 01080C* 220 JOBNO TO W4 01090C* 01100C* MATCH CODES TO CONTROL TABLES 01110C* 300 MATMAN TO M1 MAN CODE/MAN NAME 01120C* 301 MATMAN TO M3 MAN CODE/MAN SCHEDULE 01130C* 302 MATJOB TO J3 JOB CODE/MAN SCHEDULE 01140C* 303 MATSKL TO S3 SKILL CODE/MAN SCHEDULE 01150C* 304 START TO B3 START DATE/MAN SCHEDULE 01160C* 305 MATJOB TO J4 JOB CODE/JOB DESCRIPTION 01170C* 306 MATJOB TO J5 JOB CODE/JOB SCHEDULE 01180C* 307 START TO B5 START DATE/JOB SCHEDULE 01190C* 308 MATSKL TO S5 SKILL CODE/JOB SCHEDULE 01200C* 309 STOP TO E5 STOP DATE/JOB SCHEDULE 01210C* 310 MATSKL TO S6 SKILL CODE/SKILL TITLE 01220C* 01230C* GET NEXT AVAIL CODE 01240C* 400 MAN CODE MAN CODE/MAN NAME 01250C* 410 JOB CODE JOB CODE/JOB DESCRIPTION ÐÐ01260C* 420 SKILL CODE SKILL CODE/SKILL TITLE 01270C* 01280C* FIND EMPTY BUCKET 01290C* 500 MAN/NAME 01300C* 510 MAN/SCHED 01310C* 520 JOB/JOB DESCR 01320C* 530 JOB/JOB SCHED 01330C* 540 SKILL/TITLE 01340C* 01350C* REPLACE TABLE DATA 01360C* 600 MAN/NAME 01370C* 610 MAN/SCHED 01380C* 620 JOB/DESCR 01390C* 630 JOB/SCHED 01400C* 640 SKILL/TITLE 01410C* 01420C* DELETE TABLE DATA 01430C* 700 MAN/NAME 01440C* 710 MAN/SCHED 01450C* 720 JOB/DESCR 01460C* 730 JOB/SCHED 01470C* 740 SKILL TITLE 01480C* 01490C* MISCELLANEOUS 01500C* 800 CLASSIFY TRAN ÐÐ01510C* 810 PUT MESSAGE TO CRT 01520C* 820 PROMPT/READ MANDATORY DATA 01530C* 830 RIGHT ADJUST 01540C* 840 PROMPT/READ OPTIONAL DATA 01550C* 01560C* FLAG ERRORS 01570C* 1000 NOT ON FILE 01580C* 1010 DUPLICATE 01590C* 1020 TABLE FULL 01600C* 1030 MISSING DATA 01610C* 1040 INVALID INPUT 01620C* 1050 MASTER NOT SET-UP 01630C* 01640C* SORT TABLES 01650C* 1100 MAN/NAME 01660C* 1110 MAN/SCHED 01670C* 1120 JOB/DESCR 01680C* 1130 JOB/SCHED 01690C* 1140 SKILL/TITLE 01700C* 01710C* PUT DATA TO CRT 01720C* 1200 MAN/NAME 01730C* 1210 MAN/SCHED 01740C* 1220 JOB/DESCR 01750C* 1230 JOB/SCHED ÐÐ01760C* 1240 SKILL/TITLE 01770C******************************************************************** 01780C MOVE ' ' BLK12 12 01790C MOVE ' ' BLK6 6 01800C Z-ADD0 W2NN 20 01810C MOVE '0000' ZERO4 4 01820C*------------------------------------------------------------------ 01830C START TAG 01840C* GET TABLE MASTER 01850C 1 ADD W2NN W2NN 01860C W2NN COMP 20 54 01870C 54 GOTO MENU 01880C W2NN CHAINEGTABLE H9 01890C H9 GOTO ENDJOB 01900C EXSR SR83 SET 1-20 01910C 01 MOVEAREC M1 01920C 02 MOVEAREC N1 01930C 03 MOVEAREC M3 01940C 04 MOVEAREC B3 01950C 05 MOVEAREC J3 01960C 06 MOVEAREC S3 01970C 07 MOVEAREC E3 01980C 08 MOVEAREC H3 01990C 09 MOVEAREC P3 02000C 10 MOVEAREC J4 ÐÐ02010C 11 MOVEAREC D4 02020C 12 MOVEAREC W4 02030C 13 MOVEAREC J5 02040C 14 MOVEAREC B5 02050C 15 MOVEAREC S5 02060C 16 MOVEAREC H5 02070C 17 MOVEAREC E5 02080C 18 MOVEAREC P5 02090C 19 MOVEAREC S6 02100C 20 MOVEAREC T6 02110C GOTO START 02120C*------------------------------------------------------------ 02130C MENU TAG 02140C* PUT MENU 02150C EXSR SR870 SETOFFS 02160C SETON 69 02170C Z-ADD416 M 02180C EXSR SR810 02190C Z-ADD417 M 02200C EXSR SR810 02210C Z-ADD418 M 02220C EXSR SR810 02230C Z-ADD419 M 02240C EXSR SR810 02250C Z-ADD420 M ÐÐ02260C EXSR SR810 02270C Z-ADD421 M 02280C EXSR SR810 02290C Z-ADD422 M 02300C EXSR SR810 02310C Z-ADD423 M 02320C EXSR SR810 02330C Z-ADD424 M 02340C EXSR SR810 02350C Z-ADD425 M 02360C EXSR SR810 02370C SETOF 69 02380C*------------------------------------------------------------------- 02390C SELECT TAG 02400C* REQUEST SELECTION. 02410C 94 GOTO MENU LOCAL MENU 02420C 91 GOTO END PERSONAL MENU 02430C EXSR SR870 SETOFFS 02440C EXSR SR855 LF/CR 02450C Z-ADD426 M 50 02460C EXSR SR820 PROMPT/READ 02470C 89 GOTO MENU 02480C 94 GOTO MENU 02490C 90 GOTO END 02500C EXSR SR830 R. ADJUST ÐÐ02510C MOVE W12A TYPE 30 02520C EXSR SR851 CLASSIFY TYPE 02530C 55 GOTO TAG10 UPDATE MAN/NAME 1 02540C 56 GOTO TAG20 UPDATE MAN/SCHD 2 02550C 57 GOTO TAG30 UPDATE JOB/DESC 3 02560C 58 GOTO TAG40 UPDATE JOB/SCHD 4 02570C 59 GOTO TAG50 UPDATE SKILL/TITLE 5 02580C 60 GOTO TAG60 LIST MAN/NAME 6 02590C 61 GOTO TAG70 LIST MAN/SCHD 7 02600C 62 GOTO TAG80 LIST JOB/DESC 8 02610C 63 GOTO TAG90 LIST JOB/SCHD 9 02620C 64 GOTO TAG100 LIST SKILL/TITLE 10 02630C Z-ADD300 M 02640C EXSR SR810 PUT ERR MSG 02650C GOTO MENU 02660C* UPDATE PROGRAMS. 02670C*------------------------------------------------------------------- 02680C TAG10 TAG 02690C EXSR SR10 MAN/NAME 02700C GOTO SELECT 02710C*------------------------------------------------------------------- 02720C TAG20 TAG 02730C EXSR SR20 MAN/SCHD 02740C GOTO SELECT 02750C*------------------------------------------------------------------- ÐÐ02760C TAG30 TAG 02770C EXSR SR30 JOB/DESCR 02780C GOTO SELECT 02790C*------------------------------------------------------------------- 02800C TAG40 TAG 02810C EXSR SR40 JOB/SCHD 02820C GOTO SELECT 02830C*------------------------------------------------------------------- 02840C TAG50 TAG 02850C EXSR SR50 SKILL/TITLE 02860C GOTO SELECT 02870C*------------------------------------------------------------------- 02880C* LIST DATA PROGRAMS. 02890C TAG60 TAG 02900C EXSR SR1400 MAN/NAME 02910C GOTO SELECT 02920C*------------------------------------------------------------------- 02930C TAG70 TAG 02940C EXSR SR1410 MAN/SCHD 02950C GOTO SELECT 02960C*------------------------------------------------------------------- 02970C TAG80 TAG 02980C EXSR SR1420 JOB/DESCR 02990C GOTO SELECT 03000C*------------------------------------------------------------------- ÐÐ03010C TAG90 TAG 03020C EXSR SR1430 JOB/SCHD 03030C GOTO SELECT 03040C*------------------------------------------------------------------- 03050C TAG100 TAG 03060C EXSR SR1440 SKILL/TITLE 03070C GOTO SELECT 03080C*------------------------------------------------------------------- 03090C END TAG 03100C* PROMPT FOR FILE KEEP. 03110C 89 ESC BKWD 03120COR 94 GOTO MENU LOCAL MENU ESC 03130C Z-ADD427 M 03140C EXSR SR820 PROMPT/READ 03150C MOVELW12A W1A 1 03160C W1A COMP 'N' 54 03170C N54 EXSR SR81 03180C*------------------------------------------------------------------- 03190C ENDJOB TAG 03200C MOVEL'CONTU' PROG 8 03210C EXITFCHAIN 03220C RLABL PROG 03230C************************************************************** 03240CSR SR10 BEGSR 03250C* UPDATE MAN/NAME TABLES ÐÐ03260CSR EXSR SR870 SETOFFS 03270CSR EXSR SR1390 PUT DIVIDER 03280CSR EXSR SR100 REQUEST TRAN 03290CSR 90 GOTO END10 ESC INPUT 03300CSR EXSR SR800 CLASSIFY TRAN 03310CSR 60 GOTO T10A ADD 03320CSR 61 GOTO T10C CHANGE 03330CSR 62 GOTO T10C DELETE 03340CSR GOTO SR10 03350C*--------------------------------------------------------------- 03360CSR T10A TAG 03370C* PROCESS ADD TRAN 03380CSR EXSR SR110 REQUEST NAME 03390CSR 89 GOTO SR10 BKWD ESC 03400CSR 90 GOTO END10 OTHER ESC 03410CSR EXSR SR200 MATCH NAME/N1 03420CSRN55 GOTO T10B NO MATCH 03430CSR EXSR SR1010 FLAG DUPLICATE 03440CSR GOTO SR10 TRY AGAIN 03450C*---------------------------------------------------------------- 03460CSR T10B TAG 03470CSR EXSR SR400 GET NEXT AVAIL 03480CSR 96 GOTO SR10 NO MORE CODES 03490CSR EXSR SR500 GET EMPTY BUCKET 03500CSR 96 GOTO SR10 M1 TABLE FULL ÐÐ03510CSR EXSR SR600 ADD MAN/NAME ENTRY 03520CSR GOTO SR10 03530C*----------------------------------------------------------------- 03540CSR T10C TAG 03550C* PROCESS CHANGE/DELETE TRAN 03560CSR EXSR SR110 REQUEST NAME 03570CSR 89 GOTO T10A BKWD ESC 03580CSR 90 GOTO END10 OTHER ESC 03590CSR EXSR SR200 MATCH NAME/N1 03600CSR 55 GOTO T10D GOT MATCH 03610CSR EXSR SR1000 FLAG NOT ON FILE 03620CSR GOTO T10C TRY AGAIN 03630C*------------------------------------------------------------------ 03640CSR T10D TAG 03650CSR EXSR SR800 CLASSIFY TRAN 03660CSR 62 GOTO T10E DELETE TRAN 03670C* PROCESS CHANGE TRAN 03680CSR EXSR SR110 REQUEST NEW NAME 03690CSR 89 GOTO SR10 ESC BKWD 03700CSR 90 GOTO END10 OTHER ESC 03710CSR Z-ADDX SAVEX 30 03720CSR MOVE MATMAN SAVMAT 1 03730CSR EXSR SR200 MATCH NEW NAME 03740CSR 55 EXSR SR1010 FLAG DUPLICATE 03750CSR 55 GOTO SR10 TRY AGAIN ÐÐ03760CSR Z-ADDSAVEX X 03770CSR MOVE SAVMAT MATMAN 03780CSR EXSR SR600 REPLACE M1/N1 DATA 03790CSR GOTO SR10 GET NEXT 03800C*------------------------------------------------------------------- 03810CSR T10E TAG 03820C* PROCESS DELETE TRAN 03830CSR EXSR SR700 DELETE M1/N1 03840C*---------------------------------------------------------------- 03850CSR T10F TAG 03860CSR Z-ADD1 X 30 03870CSR EXSR SR301 MATCH TO M3 03880CSR 55 EXSR SR710 DELETE M3 03890CSR 55 GOTO T10F GET ANOTHER 03900CSR GOTO SR10 START AGAIN 03910CSR END10 ENDSR 03920C***************************************************************** 03930CSR SR20 BEGSR 03940C* UPDATE MAN/SCHEDULE TABLES 03950CSR EXSR SR870 SETOFFS 03960CSR EXSR SR1390 PUT DIVIDER 03970CSR EXSR SR110 REQUEST NAME 03980CSR 90 GOTO END20 ESC INPUT 03990CSR EXSR SR200 MATCH NAME/N1 04000CSRN55 EXSR SR1050 FLAG NO HIT ERROR ÐÐ04010CSRN55 GOTO SR20 TRY AGAIN 04020C*----------------------------------------------------------------- 04030CSR T20A TAG 04040CSR EXSR SR130 REQUEST JOB# 04050CSR 89 GOTO SR20 BKWD ESC 04060CSR 90 GOTO END20 OTHER ESC 04070CSR EXSR SR220 MATCH JOBNO/WR 04080CSRN55 EXSR SR1050 FLAG NO HIT ERR 04090CSRN55 GOTO T20A TRY AGAIN 04100C*------------------------------------------------------------------ 04110CSR T20B TAG 04120CSR EXSR SR120 REQUEST SKILL 04130CSR 89 GOTO T20A BKWD ESC 04140CSR 90 GOTO END20 OTHER ESC 04150CSR EXSR SR210 MATCH SKILL/T6 04160CSRN55 EXSR SR1050 FLAG NO HIT ERR 04170CSRN55 GOTO T20B TRY AGAIN 04180C*------------------------------------------------------------------ 04190CSR T20C TAG 04200CSR EXSR SR150 REQUEST START DATE 04210CSR 89 GOTO T20B BKWD ESC 04220CSR 90 GOTO END20 OTHER ESC 04230CSR Z-ADD0 X 58 04240C*------------------------------------------------------------- 04250CSR T20D TAG ÐÐ04260C* MATCH INPUT TO SCHEDULE. 04270CSR 1 ADD X X 04280CSR X COMP 300 54 04290CSR 54 GOTO T20E NO MATCH 04300CSR EXSR SR301 GET M3 MATCH 04310CSRN55 GOTO T20E NO MATCH 04320CSR MATJOB COMP J3,X 54 04330CSRN54 GOTO T20D NO MATCH 04340CSR MATSKL COMP S3,X 54 04350CSRN54 GOTO T20D NO MATCH 04360CSR MOVE START W4A 4 04370CSR W4A COMP B3,X 54 04380CSRN54 GOTO T20D NO MATCH 04390CSR SETON 58 MATCH FLAG 04400C*------------------------------------------------------------------- 04410CSR T20E TAG 04420CSR EXSR SR100 REQUEST TRAN 04430CSR 89 GOTO T20C BKWD ESC 04440CSR 90 GOTO END20 OTHER ESC 04450CSR EXSR SR800 CLASSIFY TRAN. 04460CSR 60 GOTO T20F ADD 04470CSR 58 EXSR SR21 MOVE DATA 04480CSR 58 EXSR SR1310 PUT HEADING 04490CSR 58 EXSR SR1210 PUT DATA 04500CSR 61 GOTO T20G CHANGE ÐÐ04510CSR 62 GOTO T20L DELETE 04520C*------------------------------------------------------------------- 04530CSR T20F TAG 04540C* PROCESS ADD TRAN. 04550CSR 58 EXSR SR1010 FLAG DUPLICATE 04560CSR 58 GOTO T20E 04570CSR EXSR SR510 GET EMPTY BUCKET 04580CSR 96 GOTO SR20 TABLE FULL 04590CSR GOTO T20H CONTU 04600C*------------------------------------------------------------------- 04610CSR T20G TAG 04620C* PROCESS CHANGE. 04630CSRN58 EXSR SR1000 FLAG NOT ON FILE 04640CSRN58 GOTO T20E 04650C*------------------------------------------------------------------- 04660CSR T20H TAG 04670C* REPLACE OTHER DATA. 04680CSR EXSR SR160 REQUEST STOP 04690CSR 89 GOTO T20E ESC BKWD 04700CSR 90 GOTO END20 OTHER ESC 04710C*------------------------------------------------------------------- 04720CSR T20J TAG 04730CSR EXSR SR170 REQUEST HOURS 04740CSR 89 GOTO T20H ESC BKWD 04750CSR 90 GOTO END20 OTHER ESC ÐÐ04760C*------------------------------------------------------------------- 04770CSR T20K TAG 04780CSR EXSR SR180 REQUEST % 04790CSR 89 GOTO T20J ESC BKWD 04800CSR 90 GOTO END20 OTHER ESC 04810CSR EXSR SR610 CHANGE SCHED 04820CSR GOTO SR20 04830C*------------------------------------------------------------------- 04840CSR T20L TAG 04850C* PROCESS DELETE. 04860CSRN58 EXSR SR1000 FLAG NOT ON FILE 04870CSRN58 GOTO T20E TRY AGAIN 04880CSR EXSR SR710 DELETE SCHED 04890CSR GOTO SR20 04900CSR END20 ENDSR 04910C******************************************************************** 04920CSR SR21 BEGSR 04930C* MOVE TO OUTPUT FIELDS. 04940CSR MOVE E3,X STOP 04950CSR MOVE P3,X PERCNT 04960CSR MOVE H3,X HOURS 04970CSR MOVE B3,X START 04980CSR ENDSR 04990C******************************************************************** 05000CSR SR30 BEGSR ÐÐ05010C* UPDATE JOB/DESCR TABLES. 05020CSR EXSR SR870 SETOFFS 05030CSR EXSR SR1390 PUT DIVIDER 05040CSR EXSR SR100 REQUEST TRAN 05050CSR 90 GOTO END30 ESC INPUT 05060CSR EXSR SR800 CLASSIFY TRAN 05070CSR 60 GOTO T30A ADD 05080CSR 61 GOTO T30C CHANGE 05090CSR 62 GOTO T30C DELETE 05100C*------------------------------------------------------------------- 05110CSR T30A TAG 05120C* PROCESS ADD TRAN. 05130CSR EXSR SR130 REQUEST JOB# 05140CSR 89 GOTO SR30 BKWD ESC 05150CSR 90 GOTO END30 OTHER ESC 05160CSR EXSR SR220 MATCH W4 05170CSRN55 GOTO T30B NO MATCH 05180CSR EXSR SR1320 PUT HEADING 05190CSR EXSR SR1220 PUT DATA 05200CSR EXSR SR1010 FLAG DUPLIC 05210CSR GOTO T30A TRY AGAIN 05220C*------------------------------------------------------------------- 05230CSR T30B TAG 05240CSR EXSR SR140 REQUEST DESCR 05250CSR 89 GOTO T30A BKWD ESC ÐÐ05260CSR 90 GOTO END30 OTHER ESC 05270CSR EXSR SR410 GET NEXT AVAIL W4 05280CSR 96 GOTO SR30 NO MORE CODES 05290CSR EXSR SR520 GET EMPTY W4 05300CSR 96 GOTO SR30 TABLE FULL 05310CSR EXSR SR620 ADD JOB/DESCR 05320CSR GOTO SR30 05330C*------------------------------------------------------------------- 05340CSR T30C TAG 05350C* PROCESS CHANGE/DELETE TRAN. 05360CSR EXSR SR130 REQUEST JOB#. 05370CSR 89 GOTO SR30 BKWD ESC 05380CSR 90 GOTO END30 OTHER ESC 05390CSR EXSR SR220 MATCH W4 05400CSRN55 EXSR SR1000 FLAG ERROR 05410CSRN55 GOTO T30C 05420C*------------------------------------------------------------------- 05430CSR T30D TAG 05440CSR EXSR SR1320 PUT HEADING 05450CSR EXSR SR1220 PUT DATA 05460CSR EXSR SR800 CLASSIFY TRAN 05470CSR 62 GOTO T30E DELETE 05480C* PROCESS CHANGE ONLY. 05490CSR EXSR SR130 REQUEST NEW JOB# 05500CSR 89 GOTO T30C BKWD ESC ÐÐ05510CSR 90 GOTO END30 OTHER ESC 05520CSR MOVE MATJOB SAVMAT 05530CSR Z-ADDX SAVEX 05540CSR EXSR SR220 MATCH J4 05550CSR 55 EXSR SR1010 FLAG DUPLIC 05560CSR 55 GOTO T30C TRY AGAIN 05570CSR Z-ADDSAVEX X 05580CSR MOVE SAVMAT MATJOB 05590CSR EXSR SR140 REQUEST DESCR 05600CSR 89 GOTO T30C BKWD ESC 05610CSR 90 GOTO END30 OTHER ESC 05620CSR EXSR SR620 CHANGE JOB/DESCR 05630CSR GOTO SR30 05640C*------------------------------------------------------------------- 05650CSR T30E TAG 05660C* PROCESS DELETE ONLY. 05670CSR EXSR SR720 DELETE JOB/DESCR 05680CSR EXSR SR302 MATCH J3 05690CSR 55 EXSR SR710 DELETE J3 05700CSR EXSR SR306 MATCH J5 05710CSR 55 EXSR SR730 DELETE J5 05720CSR GOTO SR30 05730CSR END30 ENDSR 05740C******************************************************************** 05750CSR SR40 BEGSR ÐÐ05760C* UPDATE JOB/SCHEDULE TABLES. 05770CSR EXSR SR870 SETOFFS 05780CSR EXSR SR1390 PUT DIVIDER 05790CSR EXSR SR130 REQUEST JOB # 05800CSR 90 GOTO END40 ESC INPUT 05810CSR EXSR SR220 MATCH W4 05820CSRN55 EXSR SR1050 FLAG ERROR 05830CSRN55 GOTO SR40 05840C*------------------------------------------------------------------- 05850CSR T40A TAG 05860CSR EXSR SR150 REQUEST START 05870CSR 89 GOTO SR40 BKWD ESC 05880CSR 90 GOTO END40 OTHER ESC 05890C*------------------------------------------------------------------- 05900CSR T40B TAG 05910CSR EXSR SR120 REQUEST SKILL 05920CSR 89 GOTO T40A BKWD ESC 05930CSR 90 GOTO END40 OTHER ESC 05940CSR EXSR SR210 MATCH T6 05950CSRN55 EXSR SR1000 FLAG ERROR 05960CSRN55 GOTO T40B 05970CSR Z-ADD0 X 58 05980C*------------------------------------------------------------------- 05990CSR T40C TAG 06000CSR 1 ADD X X ÐÐ06010CSR X COMP 300 54 06020CSR 54 GOTO T40D NO MATCH 06030CSR EXSR SR306 MATCH J5 06040CSRN55 GOTO T40D NO MATCH 06050CSR MOVE START W4A 06060CSR W4A COMP B5,X 54 MATCH B5 06070CSRN54 GOTO T40C NO MATCH 06080CSR MATSKL COMP S5,X 54 MATCH S5 06090CSRN54 GOTO T40C NO MATCH 06100CSR SETON 58 MATCH FLAG 06110C*------------------------------------------------------------------- 06120CSR T40D TAG 06130CSR EXSR SR100 REQUEST TRAN 06140CSR 89 GOTO T40B BKWD ESC 06150CSR 90 GOTO END40 OTHER ESC 06160CSR EXSR SR800 CLASSIFY TRAN 06170CSR 60 GOTO T40E ADD 06180CSR 58 EXSR SR41 MOVE DATA 06190CSR 58 EXSR SR1330 PUT HEADING 06200CSR 58 EXSR SR1230 PUT DATA 06210CSR 61 GOTO T40G CHG 06220CSR 62 GOTO T40K DEL 06230C*------------------------------------------------------------------- 06240CSR T40E TAG 06250C* PROCESS ADD TRAN. ÐÐ06260CSR 58 EXSR SR1010 FLAG DUPLICATE 06270CSR 58 GOTO T40D 06280CSR EXSR SR530 GET EMPTY J5 06290CSR 96 GOTO SR40 TABLE FULL 06300CSR GOTO T40G UPDATE 06310C*------------------------------------------------------------------- 06320CSR T40F TAG 06330C* PROCESS CHANGE. 06340CSRN58 EXSR SR1000 FLAG NOT ON FILE 06350CSRN58 GOTO T40D 06360C*------------------------------------------------------------------- 06370CSR T40G TAG 06380C* REPLACE DATA. 06390CSR EXSR SR160 REQUEST STOP 06400CSR 89 GOTO T40D BKWD ESC 06410CSR 90 GOTO END40 OTHER ESC 06420C*------------------------------------------------------------------- 06430CSR T40H TAG 06440CSR EXSR SR170 REQUEST HOURS 06450CSR 89 GOTO T40G BKWD ESC 06460CSR 90 GOTO END40 OTHER ESC 06470C*------------------------------------------------------------------- 06480CSR T40J TAG 06490CSR EXSR SR180 REQUEST % 06500CSR 89 GOTO T40H BKWD ESC ÐÐ06510CSR 90 GOTO END40 OTHER ESC 06520CSR EXSR SR630 REPLACE DATA 06530CSR GOTO SR40 06540C*------------------------------------------------------------------- 06550CSR T40K TAG 06560C* PROCESS DELETE. 06570CSRN58 EXSR SR1000 FLAG NOT ON FILE 06580CSRN58 GOTO T40D 06590CSR EXSR SR730 DELETE JOB DESCR 06600CSR GOTO SR40 06610CSR END40 ENDSR 06620C******************************************************************** 06630CSR SR41 BEGSR 06640C* MOVE TO OUTPUT FIELDS. 06650CSR MOVE E5,X STOP 06660CSR MOVE P5,X PERCNT 06670CSR MOVE H5,X HOURS 06680CSR MOVE B5,X START 06690CSR ENDSR 06700C******************************************************************** 06710CSR SR50 BEGSR 06720C* UPDATE SKILL/TITLE TABLES. 06730CSR EXSR SR870 SETOFFS 06740CSR EXSR SR1390 PUT DIVIDER 06750CSR EXSR SR100 REQUEST TRAN ÐÐ06760CSR 90 GOTO END50 ESC INPUT 06770CSR EXSR SR800 CLASSIFY TRAN 06780CSR 60 GOTO T50A ADD 06790CSR 61 GOTO T50B CHANGE 06800CSR 62 GOTO T50B DELETE 06810CSR GOTO SR50 06820C*------------------------------------------------------------------- 06830CSR T50A TAG 06840C* PROCESS ADD TRAN. 06850CSR EXSR SR120 REQUEST TITLE 06860CSR 89 GOTO SR50 BKWD ESC 06870CSR 90 GOTO END50 OTHER ESC 06880CSR EXSR SR210 MATCH T6 06890CSR 55 EXSR SR1010 FLAG DUPLIC 06900CSR 55 GOTO T50A TRY AGAIN 06910CSR EXSR SR420 GET NEXT AVAIL 06920CSR 96 GOTO SR50 NO MORE CODES 06930CSR EXSR SR540 GET EMPTY S6 06940CSR 96 GOTO SR50 TABLE FULL 06950CSR EXSR SR640 MOVE DATA 06960CSR GOTO SR50 06970C*------------------------------------------------------------------- 06980CSR T50B TAG 06990C* PROCESS CHANGE/DELETE. 07000CSR EXSR SR120 REQUEST TITLE ÐÐ07010CSR 89 GOTO SR50 BKWD ESC 07020CSR 90 GOTO END50 OTHER ESC 07030CSR EXSR SR210 MATCH T6 07040CSRN55 EXSR SR1000 FLAG NOT ON FILE 07050CSRN55 GOTO SR50 TRY AGAIN 07060CSR EXSR SR800 CLASSIFY TRAN 07070CSR 62 GOTO T50C DELETE 07080C* PROCESS CHANGE ONLY. 07090CSR EXSR SR120 RQST NEW TITLE 07100CSR 89 GOTO SR50 ESC BKWD 07110CSR 90 GOTO END50 OTHER ESC 07120CSR MOVE MATSKL SAVMAT 07130CSR Z-ADDX SAVEX 07140CSR EXSR SR210 MATCH T6 07150CSR 55 EXSR SR1010 FLAG DUPLIC 07160CSR 55 GOTO SR50 TRY AGAIN 07170CSR Z-ADDSAVEX X 07180CSR MOVE SAVMAT MATSKL 07190CSR EXSR SR640 MOVE NEW TITLE 07200CSR GOTO SR50 07210C*------------------------------------------------------------------- 07220CSR T50C TAG 07230C* PROCESS DELETE ONLY. 07240CSR EXSR SR740 DELETE SKILL/TITLE 07250CSR EXSR SR303 MATCH S3 ÐÐ07260CSR 55 EXSR SR710 DELETE S3 07270CSR EXSR SR308 MATCH S5 07280CSR 55 EXSR SR730 DELETE S5 07290CSR GOTO SR50 07300CSR END50 ENDSR 07310C******************************************************************** 07320CSR SR75 BEGSR 07330C* READ TERM. 07340CSR EXSR SR870 SETOFFS 07350CSR MOVE BLK12 W12A 12 07360CSR MOVELBIT,1 BUFLGT 2 07370CSR MOVE BIT,7 BUFLGT 07380CSR EXITFQWREED 07390CSR RLABL W12A 07400CSR RLABL BUFLGT 07410CSR MOVEAW12A A12 07420CSR MOVE BLK12 W12A 07430CSR Z-ADD1 W 30 07440CSR '\' LOKUPA12,W 90 07450CSRN90 GOTO T75B 07460CSR 1 ADD W W 30 07470CSR W COMP 12 54 07480CSR 54 GOTO T75A 07490CSR A12,W COMP 'B' 89 SKIP BKWD 07500CSR A12,W COMP 'E' 91 MENU ÐÐ07510CSR A12,W COMP 'G' 92 GOODBY 07520CSR A12,W COMP 'N' 93 NEW ITEM 07530CSR A12,W COMP 'M' 94 LOCAL MENU 07540CSR 89 07550COR 91 07560COR 92 07570COR 93 NEW ITEM 07580COR 94 GOTO END75 LOCAL MENU 07590C*------------------------------------------------------------------- 07600CSR T75A TAG 07610CSR Z-ADD318 M FLAG BAD ESC 07620CSR EXSR SR810 ERROR MSG 07630CSR EXITFQCLFCR 07640CSR GOTO SR75 07650C*------------------------------------------------------------------- 07660CSR T75B TAG 07670CSR Z-ADD1 W 07680CSR ' ' LOKUPA12,W 77 07690CSR 77 MOVEAA12,W W12A INPUT DATA 07700CSR END75 ENDSR 07710C******************************************************************** 07720CSR SR81 BEGSR 07730C* UPDATE EGTABLE ARRAYS. 07740CSR Z-ADD0 W2NN 20 07750C*------------------------------------------------------------------- ÐÐ07760CSR T81A TAG 07770CSR 1 ADD W2NN W2NN 07780CSR W2NN COMP 20 54 07790CSR 54 GOTO END81 07800CSR W2NN CHAINEGTABLE H8 07810CSR H8 GOTO END81 07820CSR EXSR SR83 SET 1-20 07830CSR SETON 81 07840CSR EXCPT UPDATE EGTABLE 07850CSR SETOF 81 07860CSR GOTO T81A 07870CSR END81 ENDSR 07880C******************************************************************** 07890CSR SR83 BEGSR 07900CSR W2NN COMP 1 01 07910CSR W2NN COMP 2 02 07920CSR W2NN COMP 3 03 07930CSR W2NN COMP 4 04 07940CSR W2NN COMP 5 05 07950CSR W2NN COMP 6 06 07960CSR W2NN COMP 7 07 07970CSR W2NN COMP 8 08 07980CSR W2NN COMP 9 09 07990CSR W2NN COMP 10 10 08000CSR W2NN COMP 11 11 ÐÐ08010CSR W2NN COMP 12 12 08020CSR W2NN COMP 13 13 08030CSR W2NN COMP 14 14 08040CSR W2NN COMP 15 15 08050CSR W2NN COMP 16 16 08060CSR W2NN COMP 17 17 08070CSR W2NN COMP 18 18 08080CSR W2NN COMP 19 19 08090CSR W2NN COMP 20 20 08100CSR ENDSR 08110C******************************************************************** 08120CSR SR100 BEGSR 08130C* REQUEST TRAN CODE. 08140CSR Z-ADD276 M 50 08150CSR EXSR SR840 PROMPT/READ 08160CSR 90 GOTO END100 ESC 08170CSR MOVELW12A TTCODE 1 08180CSR EXSR SR800 CLASSIFY TRAN 08190CSRN60N61N62 EXSR SR1040 FLAG ERROR 08200CSRN60N61N62 GOTO SR100 TRY AGAIN 08210CSR END100 ENDSR 08220C******************************************************************** 08230CSR SR110 BEGSR 08240C* REQUEST MAN/NAME. 08250CSR Z-ADD428 M ÐÐ08260CSR EXSR SR840 PROMPT/READ 08270CSRN90 MOVE W12A NAME 12 08280CSR ENDSR 08290C******************************************************************** 08300CSR SR120 BEGSR 08310C* REQUEST SKILL TITLE. 08320CSR Z-ADD429 M 08330CSR EXSR SR840 PROMPT/READ 08340CSRN90 MOVE W12A TITLE 12 08350CSR ENDSR 08360C******************************************************************** 08370CSR SR130 BEGSR 08380C* REQUEST JOB #. 08390CSR Z-ADD249 M 08400CSR EXSR SR840 PROMPT/READ 08410CSRN90 MOVELW12A JOBNO 6 08420CSR ENDSR 08430C******************************************************************** 08440CSR SR140 BEGSR 08450C* REQUEST JOB DESCR. 08460CSR Z-ADD296 M 08470CSR EXSR SR840 PROMPT/READ 08480CSRN90 MOVE W12A DESCR 12 08490CSR ENDSR 08500C******************************************************************** ÐÐ08510CSR SR150 BEGSR 08520C* REQUEST START DATE. 08530CSR Z-ADD430 M 08540CSR EXSR SR840 PROMPT/READ 08550CSRN90 EXSR SR830 R. ADJUST 08560CSRN90 MOVE W12A START 40 08570CSR ENDSR 08580C******************************************************************** 08590CSR SR160 BEGSR 08600C* REQUEST STOP DATE. 08610CSR Z-ADD431 M 08620CSR EXSR SR840 PROMPT/READ 08630CSRN90 EXSR SR830 R. ADJUST 08640CSRN90 MOVE W12A STOP 40 08650CSR ENDSR 08660C******************************************************************** 08670CSR SR170 BEGSR 08680C* REQUEST HOURS. 08690CSR Z-ADD432 M 08700CSR EXSR SR840 PROMPT/READ 08710CSRN90 EXSR SR830 R. ADJUST 08720CSRN90 MOVE W12A HOURS 40 08730CSR ENDSR 08740C******************************************************************** 08750CSR SR180 BEGSR ÐÐ08760C* REQUEST PER CENT COMPLETE. 08770CSR Z-ADD433 M 08780CSR EXSR SR820 READ/PROMPT 08790CSRN90 EXSR SR830 R. ADJUST 08800CSRN90 MOVE W12A PERCNT 22 08810CSR ENDSR 08820C******************************************************************** 08830CSR SR200 BEGSR 08840C* MATCH NAME - GET MAN CODE. 08850CSR Z-ADD1 X 30 08860CSR NAME LOKUPN1,X 55 08870CSR 55 MOVE M1,X MATMAN 1 MAN CODE 08880CSRN55 MOVE BIT,1 MATMAN 08890CSR ENDSR 08900C******************************************************************** 08910CSR SR210 BEGSR 08920C* MATCH TITLE - GET SKILL CODE. 08930CSR Z-ADD1 X 08940CSR TITLE LOKUPT6,X 55 08950CSR 55 MOVE S6,X MATSKL 1 SKILL CODE 08960CSRN55 MOVE BIT,1 MATSKL 08970CSR ENDSR 08980C******************************************************************** 08990CSR SR220 BEGSR 09000C* MATCH JOB # - GET JOB CODE. ÐÐ09010CSR Z-ADD1 X 09020CSR JOBNO LOKUPW4,X 55 09030CSR 55 MOVE J4,X MATJOB 1 JOB CODE 09040CSRN55 MOVE BIT,1 MATJOB 09050CSR ENDSR 09060C******************************************************************** 09070CSR SR300 BEGSR 09080C* MATCH MAN TO M1 MAN/NAME TABLE. 09090CSR Z-ADD1 X 09100CSR MATMAN LOKUPM1,X 55 09110CSR ENDSR 09120C******************************************************************** 09130CSR SR301 BEGSR 09140C* MATCH MAN TO M3 MAN/SCHED TABLE. 09150CSR MATMAN LOKUPM3,X 55 09160CSR ENDSR 09170C******************************************************************** 09180CSR SR302 BEGSR 09190C* MATCH JOB CODE TO J3 MAN/SCHED TABLE. 09200CSR Z-ADD1 X 09210CSR MATJOB LOKUPJ3,X 55 09220CSR ENDSR 09230C******************************************************************** 09240CSR SR303 BEGSR 09250C* MATCH SKILL CODE TO S3 MAN/SCHED TABLE. ÐÐ09260CSR Z-ADD1 X 09270CSR MATSKL LOKUPS3,X 55 09280CSR ENDSR 09290C******************************************************************** 09300CSR SR304 BEGSR 09310C* MATCH START DATE TO B3 MAN/SCHED TABLE. 09320CSR Z-ADD1 X 09330CSR MOVE START W4A 4 09340CSR W4A LOKUPB3,X 55 09350CSR ENDSR 09360C******************************************************************** 09370CSR SR305 BEGSR 09380C* MATCH JOB CODE TO J4 JOB/DESCR TABLE. 09390CSR Z-ADD1 X 09400CSR MATJOB LOKUPJ4,X 55 09410CSR ENDSR 09420C******************************************************************** 09430CSR SR306 BEGSR 09440C* MATCH JOB CODE TO J5 JOB/SCHED TABLE. 09450CSR MATJOB LOKUPJ5,X 55 09460CSR ENDSR 09470C******************************************************************** 09480CSR SR307 BEGSR 09490C* MATCH START DATE TO B5 JOB/SCHED TABLE. 09500CSR Z-ADD1 X ÐÐ09510CSR MOVE START W4A 09520CSR W4A LOKUPB5,X 55 09530CSR ENDSR 09540C******************************************************************** 09550CSR SR308 BEGSR 09560C* MATCH SKILL CODE TO S5 JOB/SCHED TABLE. 09570CSR Z-ADD1 X 09580CSR MATSKL LOKUPS5,X 55 09590CSR ENDSR 09600C******************************************************************** 09610CSR SR309 BEGSR 09620C* MATCH STOP DATE TO E5 JOB/SCHED TABLE. 09630CSR Z-ADD1 X 09640CSR MOVE STOP W4A 09650CSR W4A LOKUPE5,X 55 09660CSR ENDSR 09670C******************************************************************** 09680CSR SR310 BEGSR 09690C* MATCH SKILL CODE TO S6 SKILL/TITLE TABLE. 09700CSR Z-ADD1 X 09710CSR MATSKL LOKUPS6,X 55 09720CSR ENDSR 09730C******************************************************************** 09740CSR SR400 BEGSR 09750C* GET NEXT AVAIL MAN CODE. ÐÐ09760CSR MOVE BIT,1 MATMAN 1 09770CSR Z-ADD1 X 30 09780C*------------------------------------------------------------------- 09790CSR T400A TAG 09800CSR 1 ADD X X 09810CSR X COMP 256 54 09820CSR 54 GOTO T400B EXCEEDS TABLE 09830CSR Z-ADD1 N 30 09840CSR BIT,X LOKUPM1,N 54 09850CSR 54 GOTO T400A 09860CSR MOVE BIT,X MATMAN NEXT AVAIL CODE 09870CSR GOTO END400 09880C*------------------------------------------------------------------- 09890CSR T400B TAG 09900C* FLAG NO AVAIL CODES. 09910CSR EXSR SR1020 FLAG ERROR 09920CSR SETON 96 09930CSR END400 ENDSR 09940C******************************************************************** 09950CSR SR410 BEGSR 09960C* GET NEXT AVAIL JOB CODE. 09970CSR MOVE BIT,1 MATJOB 1 09980CSR Z-ADD1 X 09990C*------------------------------------------------------------------- 10000CSR T410A TAG ÐÐ10010CSR 1 ADD X X 10020CSR X COMP 256 54 10030CSR 54 GOTO T410B ERROR 10040CSR Z-ADD1 N 10050CSR BIT,X LOKUPJ4,N 54 10060CSR 54 GOTO T410A 10070CSR MOVE BIT,X MATJOB JOB CODE 10080CSR GOTO END410 10090C*------------------------------------------------------------------- 10100CSR T410B TAG 10110CSR EXSR SR1020 FLAG ERROR 10120CSR SETON 96 10130CSR END410 ENDSR 10140C******************************************************************** 10150CSR SR420 BEGSR 10160C* GET NEXT AVAIL SKILL CODE. 10170CSR MOVE BIT,1 MATSKL 1 10180CSR Z-ADD1 X 10190C*------------------------------------------------------------------- 10200CSR T420A TAG 10210CSR 1 ADD X X 10220CSR X COMP 256 54 10230CSR 54 GOTO T420B ERROR 10240CSR Z-ADD1 N 10250CSR BIT,X LOKUPS6,N 54 ÐÐ10260CSR 54 GOTO T420A 10270CSR MOVE BIT,X MATSKL SKILL CODE 10280CSR GOTO END420 10290C*------------------------------------------------------------------- 10300CSR T420B TAG 10310CSR EXSR SR1020 FLAG ERROR 10320CSR SETON 96 10330CSR END420 ENDSR 10340C******************************************************************** 10350CSR SR500 BEGSR 10360C* FIND EMPTY MAN/NAME BUCKET. 10370CSR Z-ADD1 X 10380CSR BIT,1 LOKUPM1,X 54 10390CSRN54 SETON 96 10400CSRN54 EXSR SR1020 FLAG ERROR 10410CSR ENDSR 10420C******************************************************************** 10430CSR SR510 BEGSR 10440C* FIND EMPTY MAN/SCHED BUCKET. 10450CSR Z-ADD1 X 10460CSR BIT,1 LOKUPM3,X 54 10470CSRN54 SETON 96 10480CSRN54 EXSR SR1020 FLAG ERROR 10490CSR ENDSR 10500C******************************************************************** ÐÐ10510CSR SR520 BEGSR 10520C* FIND EMPTY JOB/DESCR BUCKET. 10530CSR Z-ADD1 X 10540CSR BIT,1 LOKUPJ4,X 54 10550CSRN54 SETON 96 10560CSRN54 EXSR SR1020 FLAG ERROR 10570CSR ENDSR 10580C******************************************************************** 10590CSR SR530 BEGSR 10600C* FIND EMPTY JOB/SCHED BUCKET. 10610CSR Z-ADD1 X 10620CSR BIT,1 LOKUPJ5,X 54 10630CSRN54 SETON 96 10640CSRN54 EXSR SR1020 FLAG ERROR 10650CSR ENDSR 10660C******************************************************************** 10670CSR SR540 BEGSR 10680C* FIND EMPTY SKILL/TITLE BUCKET. 10690CSR Z-ADD1 X 10700CSR BIT,1 LOKUPS6,X 54 10710CSRN54 SETON 96 10720CSRN54 EXSR SR1020 FLAG ERROR 10730CSR ENDSR 10740C******************************************************************** 10750CSR SR600 BEGSR ÐÐ10760C* REPLACE DATA IN MAN/NAME. 10770CSR MOVE MATMAN M1,X MAN CODE 10780CSR MOVE NAME N1,X NAME 10790CSR ENDSR 10800C******************************************************************** 10810CSR SR610 BEGSR 10820C* REPLACE MAN/SCHED DATA. 10830CSR MOVE MATMAN M3,X MAN CODE 10840CSR MOVE MATJOB J3,X JOB CODE 10850CSR MOVE MATSKL S3,X SKILL CODE 10860CSR MOVE START B3,X START DATE 10870CSR MOVE HOURS H3,X HRS REQD 10880CSR MOVE STOP E3,X STOP DATE 10890CSR MOVE PERCNT P3,X % DONE 10900CSR ENDSR 10910C******************************************************************** 10920CSR SR620 BEGSR 10930C* REPLACE JOB/DESCR DATA. 10940CSR MOVE MATJOB J4,X JOB CODE 10950CSR MOVE JOBNO W4,X JOB # 10960CSR MOVE DESCR D4,X JOB DESCR 10970CSR ENDSR 10980C******************************************************************** 10990CSR SR630 BEGSR 11000C* REPLACE JOB/SCHED DATA. ÐÐ11010CSR MOVE MATJOB J5,X JOB CODE 11020CSR MOVE START B5,X START DATE 11030CSR MOVE MATSKL S5,X SKILL CODE 11040CSR MOVE STOP E5,X STOP DATE 11050CSR MOVE HOURS H5,X HOURS 11060CSR MOVE PERCNT P5,X % DONE 11070CSR ENDSR 11080C******************************************************************** 11090CSR SR640 BEGSR 11100C* REPLACE SKILL/TITLE DATA. 11110CSR MOVE MATSKL S6,X SKILL CODE 11120CSR MOVE TITLE T6,X SKILL TITLE 11130CSR ENDSR 11140C******************************************************************** 11150CSR SR700 BEGSR 11160C* DELETE MAN/NAME. 11170CSR MOVE BIT,1 M1,X MAN 11180CSR MOVE BLK12 N1,X NAME 11190CSR ENDSR 11200C******************************************************************** 11210CSR SR710 BEGSR 11220C* DELETE MAN/SCHED. 11230CSR MOVE BIT,1 M3,X MAN 11240CSR MOVE BIT,1 J3,X JOB 11250CSR MOVE BIT,1 S3,X SKILL ÐÐ11260CSR MOVE ZERO4 B3,X START 11270CSR MOVE ZERO4 H3,X HOURS 11280CSR MOVE ZERO4 E3,X STOP 11290CSR MOVE ZERO4 P3,X PER CENT 11300CSR ENDSR 11310C******************************************************************** 11320CSR SR720 BEGSR 11330C* DELETE JOB/DESCR. 11340CSR MOVE BIT,1 J4,X JOB CODE 11350CSR MOVE BLK6 W4,X JOB # 11360CSR MOVE BLK12 D4,X DESCR 11370CSR ENDSR 11380C******************************************************************** 11390CSR SR730 BEGSR 11400C* DELETE JOB/SCHED. 11410CSR MOVE BIT,1 J5,X JOB 11420CSR MOVE ZERO4 B5,X START 11430CSR MOVE BIT,1 S5,X SKILL 11440CSR MOVE ZERO4 E5,X STOP 11450CSR MOVE ZERO4 H5,X HOURS 11460CSR MOVE ZERO4 P5,X PER CENT 11470CSR ENDSR 11480C******************************************************************** 11490CSR SR740 BEGSR 11500C* DELETE SKILL/TITLE. ÐÐ11510CSR MOVE BIT,1 S6,X SKILL 11520CSR MOVE BLK12 T6,X TITLE 11530CSR ENDSR 11540C******************************************************************** 11550CSR SR800 BEGSR 11560C* CLASSIFY TRAN. 11570CSR TTCODE COMP 'A' 60 ADD 11580CSR TTCODE COMP 'C' 61 CHANGE 11590CSR TTCODE COMP 'D' 62 DELETE 11600CSR ENDSR 11610C******************************************************************** 11620CSR SR810 BEGSR 11630C* PUT MESSAGE. 11640CSR M CHAINMGFILE 54 11650CSR SETON 73 11660CSR EXCPT PUT MSG 11670CSR SETOF 73 11680CSR ENDSR 11690C******************************************************************** 11700CSR SR820 BEGSR 11710C* PROMPT/READ - INPUT OPTIONAL. 11720CSR EXSR SR810 PROMPT 11730CSR EXSR SR75 READ 11740CSR ENDSR 11750C******************************************************************** ÐÐ11760CSR SR830 BEGSR 11770C* RIGHT ADJUST. 11780CSR Z-ADD12 W2N 20 11790CSR EXIT SUBRAJ R. ADJUST 11800CSR RLABL W2N 11810CSR RLABL W12A 11820CSR ENDSR 11830C******************************************************************** 11840CSR SR840 BEGSR 11850C* PROMPT/READ - INPUT MANDATORY. 11860CSR EXSR SR820 PROMPT/READ 11870CSR 90 GOTO END840 ESC INPUT 11880CSR Z-ADDM W5N 50 11890CSRN77 EXSR SR1030 FLAG ERROR 11900CSR Z-ADDW5N M 11910CSRN77 GOTO SR840 11920CSR END840 ENDSR 11930C******************************************************************** 11940CSR SR850 BEGSR 11950C* UTILITY DATA DISPLAY. 11960CSR Z-ADD1 X 11970C*------------------------------------------------------------------- 11980CSR T850A TAG 11990CSR EXSR SR851 CLASSIFY TYPE 12000CSR 60 EXSR SR1300 MAN/NAME ÐÐ12010CSR 61 EXSR SR1310 MAN/SCHD HDG 12020CSR 62 EXSR SR1320 JOB/DESCR HDG 12030CSR 63 EXSR SR1330 JOB/SCHD HDG 12040CSR 64 EXSR SR1340 SKILL/TITLE HDG 12050CSR Z-ADD0 COUNT 30 12060C*------------------------------------------------------------------- 12070CSR T850B TAG 12080CSR SETOF 54 12090CSR 60 BIT,1 LOKUPM1,X 54 12100CSR 61 BIT,1 LOKUPM3,X 54 12110CSR 62 BIT,1 LOKUPJ4,X 54 12120CSR 63 BIT,1 LOKUPJ5,X 54 12130CSR 64 BIT,1 LOKUPS6,X 54 12140CSRN54 GOTO END850 12150CSR 61 12160COR 63 EXSR SR860 GET NAMES 12170CSR 60 EXSR SR1200 MAN/NAME DATA 12180CSR 61 EXSR SR1210 MAN/SCHED DATA 12190CSR 62 EXSR SR1220 JOB/DESCR DATA 12200CSR 63 EXSR SR1230 JOB/SCHED DATA 12210CSR 64 EXSR SR1240 SKILL/TITLE DATA 12220CSR 1 ADD COUNT COUNT 12230CSR COUNT COMP 27 54 54 12240CSR 54 GOTO T850A END PAGE 12250CSR 1 ADD X X ÐÐ12260CSR X COMP LIMIT 54 12270CSRN54 GOTO T850B 12280CSR END850 ENDSR 12290C******************************************************************** 12300CSR SR851 BEGSR 12310C* CLASSIFY TYPE CODE. 12320CSR TYPE COMP 1 55 UPD MAN/NAME 12330CSR TYPE COMP 2 56 UPD MAN/SCHD 12340CSR TYPE COMP 3 57 UPD JOB/DESC 12350CSR TYPE COMP 4 58 UPD JOB/SCHD 12360CSR TYPE COMP 5 59 UPD SKILL/TITLE 12370CSR TYPE COMP 6 60 LIST MAN/NAME 12380CSR TYPE COMP 7 61 LIST MAN/SCHD 12390CSR TYPE COMP 8 62 LIST JOB/DESC 12400CSR TYPE COMP 9 63 LIST JOB/SCHD 12410CSR TYPE COMP 10 64 LIST SKILL/TITLE 12420CSR ENDSR 12430C******************************************************************** 12440CSR SR855 BEGSR 12450C* LINE-FEED/CAR RET. 12460CSR EXITFQCLFCR LF/CR 12470CSR ENDSR 12480C******************************************************************** 12490CSR SR860 BEGSR 12500C* GET OUTPUT NAMES FOR CODES IN SR850 DISPLAY. ÐÐ12510CSRN61 GOTO T860A NOT MAN/SCHED 12520CSR Z-ADD1 A 30 12530CSR M3,X LOKUPM1,A 54 12540CSR 54 MOVE N1,A NAME 12550CSR Z-ADD1 A 12560CSR J3,X LOKUPJ4,A 54 12570CSR 54 MOVE W4,A JOBNO 12580CSR 54 MOVE D4,A DESCR 12590CSR Z-ADD1 A 12600CSR S3,X LOKUPS6,A 54 12610CSR 54 MOVE T6,A TITLE 12620CSR EXSR SR21 12630CSR GOTO END860 12640C*------------------------------------------------------------------- 12650CSR T860A TAG 12660CSRN63 GOTO END860 NOT JOB/SCHED 12670CSR Z-ADD1 A 12680CSR J5,X LOKUPJ4,A 54 12690CSR 54 MOVE W4,A JOBNO 12700CSR 54 MOVE D4,A DESCR 12710CSR Z-ADD1 A 12720CSR S5,X LOKUPS6,A 54 12730CSR 54 MOVE T6,A TITLE 12740CSR EXSR SR41 12750CSR END860 ENDSR ÐÐ12760C*************************************************************** 12770CSR SR870 BEGSR 12780C* SET-OFF HEAVY INDICATORS 12790CSR SETOF 778990 12800CSR SETOF 919293 12810CSR SETOF 9496 12820CSR ENDSR 12830C******************************************************************** 12840CSR SR1000 BEGSR 12850C* FLAG NOT ON FILE ERROR. 12860CSR Z-ADD302 M 12870CSR EXSR SR810 PUT ERR MSG 12880CSR ENDSR 12890C******************************************************************** 12900CSR SR1010 BEGSR 12910C* FLAG DUPLICATE ADD. 12920CSR Z-ADD301 M 12930CSR EXSR SR810 PUT ERR MSG 12940CSR ENDSR 12950C******************************************************************** 12960CSR SR1020 BEGSR 12970C* FLAG FULL TABLE. 12980CSR Z-ADD434 M 12990CSR EXSR SR810 PUT ERR MSG 13000CSR ENDSR ÐÐ13010C******************************************************************** 13020CSR SR1030 BEGSR 13030C* FLAG MISSING DATA INPUT. 13040CSR Z-ADD435 M 13050CSR EXSR SR810 PUT ERR MSG 13060CSR ENDSR 13070C******************************************************************** 13080CSR SR1040 BEGSR 13090C* FLAG INPUT DATA INVALID. 13100CSR Z-ADD436 M 13110CSR EXSR SR810 PUT ERR MSG 13120CSR ENDSR 13130C******************************************************************** 13140CSR SR1050 BEGSR 13150C* FLAG MASTER NOT ON FILE. 13160CSR Z-ADD5 M 13170CSR EXSR SR810 PUT ERR MSG 13180CSR ENDSR 13190C******************************************************************** 13200CSR SR1200 BEGSR 13210C* PUT MAN/NAME DATA. 13220CSR SETON 74 13230CSR EXCPT PUT MAN/NAME 13240CSR SETOF 74 13250CSR ENDSR ÐÐ13260C******************************************************************** 13270CSR SR1210 BEGSR 13280C* PUT MAN/SCHED DATA. 13290CSR SETON 75 13300CSR EXCPT PUT MAN/SCHED 13310CSR SETOF 75 13320CSR ENDSR 13330C******************************************************************** 13340CSR SR1220 BEGSR 13350C* PUT JOB/DESCR DATA. 13360CSR SETON 76 13370CSR EXCPT PUT JOB/DESCR 13380CSR SETOF 76 13390CSR ENDSR 13400C******************************************************************** 13410CSR SR1230 BEGSR 13420C* PUT JOB/SCHED DATA. 13430CSR SETON 78 13440CSR EXCPT PUT JOB/SCHED 13450CSR SETOF 78 13460CSR ENDSR 13470C******************************************************************** 13480CSR SR1240 BEGSR 13490C* PUT SKILL/TITLE DATA. 13500CSR SETON 79 ÐÐ13510CSR EXCPT PUT SKILL/TITLE 13520CSR SETOF 79 13530CSR ENDSR 13540C******************************************************************** 13550CSR SR1300 BEGSR 13560C* PUT MAN/NAME HEADING. 13570CSR Z-ADD60 LIMIT 30 13580CSR SETON 40 13590CSR EXCPT MAN/NAME HDG 13600CSR SETOF 40 13610CSR ENDSR 13620C******************************************************************** 13630CSR SR1310 BEGSR 13640C* PUT MAN/SCHEDULE HEADING. 13650CSR Z-ADD300 LIMIT 13660CSR SETON 41 13670CSR EXCPT MAN/SCHD HDG 13680CSR SETOF 41 13690CSR ENDSR 13700C******************************************************************** 13710CSR SR1320 BEGSR 13720C* PUT JOB/DESCR HEADING. 13730CSR Z-ADD100 LIMIT 13740CSR SETON 42 13750CSR EXCPT JOB/DESCR HDG ÐÐ13760CSR SETOF 42 13770CSR ENDSR 13780C******************************************************************** 13790CSR SR1330 BEGSR 13800C* PUT JOB/SCHEDULE HEADING. 13810CSR Z-ADD300 LIMIT 13820CSR SETON 43 13830CSR EXCPT JOB/SCHD HDG 13840CSR SETOF 43 13850CSR ENDSR 13860C******************************************************************** 13870CSR SR1340 BEGSR 13880C* PUT SKILL/TITLE HEADING. 13890CSR Z-ADD60 LIMIT 13900CSR SETON 44 13910CSR EXCPT SKILL/TITLE HDG 13920CSR SETOF 44 13930CSR ENDSR 13940C******************************************************************** 13950CSR SR1390 BEGSR 13960C* PUT DIVIDER TO CRT. 13970CSR MOVE '-' A12 13980CSR SETON 45 13990CSR EXCPT 14000CSR SETOF 45 ÐÐ14010CSR ENDSR 14020C******************************************************************** 14030CSR SR1400 BEGSR 14040C* DISPLAY MAN/NAME. 14050CSR Z-ADD6 TYPE 30 14060CSR EXSR SR850 14070CSR ENDSR 14080C******************************************************************** 14090CSR SR1410 BEGSR 14100C* DISPLAY MAN/SCHEDULE. 14110CSR Z-ADD7 TYPE 14120CSR EXSR SR850 14130CSR ENDSR 14140C******************************************************************** 14150CSR SR1420 BEGSR 14160C* DISPLAY JOB/DESCR. 14170CSR Z-ADD8 TYPE 14180CSR EXSR SR850 14190CSR ENDSR 14200C******************************************************************** 14210CSR SR1430 BEGSR 14220C* DISPLAY JOB/SCHED. 14230CSR Z-ADD9 TYPE 14240CSR EXSR SR850 14250CSR ENDSR ÐÐ14260C******************************************************************** 14270CSR SR1440 BEGSR 14280C* DISPLAY SKILL/TITLE. 14290CSR Z-ADD10 TYPE 14300CSR EXSR SR850 14310CSR ENDSR 14320O******************************************************************** 14330OTERM132 E 73 14340O* PUT MSG. 14350O BIT,28 1 14360O 8 '8120001' 14370O MGTEXT 43 14380O BIT,28 124 14390O 131 '8120037' 14400O N69 BIT,8 132 14410O*------------------------------------------------------------------- 14420O E 40 14430O* PUT MAN/NAME HEADING. 14440O E 40 14450O 7 'N A M E' 14460O E 40 14470O*------------------------------------------------------------------- 14480O E 41 14490O* PUT MAN/SCHED HEADING. 14500O E 41 ÐÐ14510O 7 'N A M E' 14520O 24 'START-DATE' 14530O 45 'STOP-DATE' 14540O 64 'JOB-NO.' 14550O 81 'JOB-DESCRIPTION' 14560O 92 'TASK-NAME' 14570O 110 'HOURS-PER-DAY' 14580O 122 '% COMPLETE' 14590O E 41 14600O*------------------------------------------------------------------- 14610O E 42 14620O* PUT JOB/DESCR HEADING. 14630O E 42 14640O 7 'JOB-NO.' 14650O 25 'JOB-DESCRIPTION' 14660O E 42 14670O*------------------------------------------------------------------- 14680O E 43 14690O* PUT JOB/SCHED HEADING. 14700O 7 'JOB-NO.' 14710O 24 'JOB-DESCRIPTION' 14720O 36 'START-DATE' 14730O 48 'STOP-DATE' 14740O 59 'TASK-NAME' 14750O 68 'HOURS' ÐÐ14760O 81 '% COMPLETE' 14770O E 43 14780O*------------------------------------------------------------------- 14790O E 44 14800O* SKILL/TITLE HEADING. 14810O E 44 14820O 9 'TASK-NAME' 14830O E 44 14840O*------------------------------------------------------------------- 14850O E 74 14860O* PUT MAN/NAME DATA. 14870O N1,X 12 14880O*------------------------------------------------------------------- 14890O E 75 14900O* PUT MAN/SCHED DATA. 14910O NAME 12 14920O START Z 21 14930O STOP Z 42 14940O JOBNO 63 14950O DESCR 78 14960O TITLE 95 14970O HOURS 2 105 14980O PERCNTZ 118 14990O 119 '%' 15000O*------------------------------------------------------------------- ÐÐ15010O E 76 15020O* PUT JOB/DESCR DATA. 15030O W4,X 6 15040O D4,X 22 15050O*------------------------------------------------------------------- 15060O E 78 15070O* JOB/SCHED DATA. 15080O JOBNO 6 15090O DESCR 22 15100O START Z 33 15110O STOP Z 45 15120O TITLE 62 15130O HOURS 2 68 15140O PERCNTZ 77 15150O 78 '%' 15160O*------------------------------------------------------------------- 15170O E 79 15180O* SKILL/TITLE DATA. 15190O T6,X 12 15200O*------------------------------------------------------------------- 15210O E 45 15220O A12 12 15230O A12 24 15240O A12 36 15250O A12 48 ÐÐ15260O A12 60 15270O************************************************************* 15280OEGTABLE E 81 15290O W2NN 2 15300O 01 M1 62 15310O 02 N1 722 15320O 03 M3 302 15330O 04 B3 1202 15340O 05 J3 302 15350O 06 S3 302 15360O 07 E3 1202 15370O 08 H3 1202 15380O 09 P3 602 15390O 10 J4 102 15400O 11 D4 1202 15410O 12 W4 602 15420O 13 J5 302 15430O 14 B5 1202 15440O 15 S5 302 15450O 16 H5 1202 15460O 17 E5 1202 15470O 18 P5 602 15480O 19 S6 62 15490O 20 T6 722 ** 015500ÐÐ 015510** 015520 015530** 015540 015550** 015560 015570** 015580 015590** 015600 015610** 015620 015630** 015640 015650** 015660 015670** 015680 015690** 015700 015710** 015720 015730** 015740 015750ÐÐ** 015760 015770** 015780 015790** 015800 015810** 015820 015830** 015840 015850** 015860 015870** 015880 015890** A12 ARRAY 015900 015910/* 015920_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( °  NXINDXUPD P120282120282(èÈÐ00010H QXXXXX00020F* STD INDEX FILE UPDATE PROG (XINDXUPD) 00030F* REVISED XX-XX-XX XX AM 00040F* FIELD SUBSTITUTIONS-------- 00050F* #A = INPUT DATA ARRAY NAME (SR75) 00060F* 00070F* #F = 1ST UPDATABLE FIELD NO. 00080F* 00090F* #L = LGTH OF #A ARRAY 00100F* 00110F* QXXXXX = NEW ITEM PROG NAME 00120F* 00130F* BLK#L= BLK FIELD FOR READ BUFFER 00140F* 00150F* W#LA = READ BUFFER FIELD NAME 00160F* 00170F* #E = LAST UPDATABLE FIELD # 00180F* 00190F* #N = NUMBER OF NUMERIC FIELDS 00200F* 00210F* #P = UPDATE FILE PREFIX 00220F* 00230FBITPAR IP F 90 DISK 00240FMGFILE IC F 80R DISK 00250FCRTFILE UC F 256R DISK ÐÐ00260F* 00270F* 00280F* 00290FTERM132 O F 132 5 00300F**************************************************************** 00310E NUL 1 132 1 NULL CHAR 00320E #A #L #L 1 A INPUT DATA ARRAY 00330E LOC 1 #E 3 FIELD STARTING COL # 00340E A39 39 39 1 MGTEXT ARRAY 00350E NUM 1 #N 3 0 NUMERIC FIELD NO.'S 00360E DUN 1 #E 1 A EDIT CMPLT FLAG 00370E MES 1 1 30 00380E LNK 1 7 6 A 00390E* 00400E* 00410E* 00420E BIT 33 1 SCREEN CONTR. CHAR 00430E PAR 25 1 00440E TST 25 1 00450E CALL 7 6 CALL STACK 00460E* 00470E* 00480I******************************************************************* 00490IBITPAR BT 00500I 1 33 BIT ÐÐ00510I 34 58 PAR 00520I 59 83 TST 00530I******************************************************************* 00540IMGFILE MG 00550I* MESSAGE FILE. 00560I 1 35 MGTEXT 00570I****************************************************************** 00580ICRTFILE CR 00590I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00600I* STD AREA - SAME FOR ALL PROGRAMS. 00610I* EMPLOYEE # 5N 00620I* 1 50CREMPL 00630I* USER CODE 8A 00640I* 6 13 CRUSER 00650I* DEPT # 5N 00660I* 14 180CRDEPT 00670I* JOB NAME 8A (JOB LOADED BY MENU) 00680I* 19 26 CRJOB 00690I* SHUTDOWN FLAG 1A 00700I* BLANK = NO SHUTDOWN 00710I 27 27 CRSHUT 00720I* TIME STARTED 6N 00730I 28 330CRTIME 00740I* DATE STARTED 4N 00750I 34 370CRDATE ÐÐ00760I* CALL STACK 7 X 6A 00770I 38 79 CALL 00780I*------------------------------------------------------------------- 00790I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 00800I* 00810I* 00820I* 00830I* 00840I* 00850I* 00860I* 00870I* 00880I* 00890I* 00900I* 00910I* 00920I* 00930I* 00940I******************************************************************** 00950I* 00960I* 00970I* 00980I* 00990I* 01000I* ÐÐ01010I* 01020I* 01030I* 01040I* 01050I* 01060I* 01070I* 01080I* 01090I* 01100I* 01110C******************************************************************** 01120C* NOTE: INDICATORS 50 = DATAGRAPHIX 132-1 CRT 01130C* INITIALIZE 01140C EXSR SR101 1-TIME INIT 01150C MOVE ' ' BLK6 6 STUPIDITY 01160C*------------------------------------------------------------------ 01170C START TAG 01180C* SET-UP 1ST FIELD NO. 01190C EXSR SR66 INIT A39 01200C MOVE ' ' DUN INIT EDIT ARRAY 01210C Z-ADD#F F 30 FIELD # 01220C EXSR SR205 INIT MAST 01230C EXSR SR206 INIT INPUT 01240C EXSR SR70 CLEAR SCREEN 01250C GOTO READ ÐÐ01260C*------------------------------------------------------------------ 01270C NEXT TAG 01280C EXSR SR66 INIT A39 01290C 1 ADD F F FIELD # 01300C*----------------------------------------------------------------- 01310C READ TAG 01320C* READ DATA FROM TERMINAL. 01330C SETOF 909677 01340C EXSR SR102 VALIDATE FIELD # 01350C 55 GOTO UPDATE DONE 01360C EXSR SR201 IDENTIFY-F 01370C SETON 69 01380C EXSR SR72 PROMPT 01390C SETOF 69 01400C EXSR SR75 READ TERMINAL 01410C 90N88 EXSR SR72 DISPLAY INPUT DATA 01420C 93 GOTO START NEW ITEM 01430C 92 GOTO JUMP FIELD JUMP REQST 01440C 89 F SUB 1 F SKIP BACKWARD 01450C 89 GOTO READ " " 01460C 88 SETOF 90 SPACE FILL 01470C 88 SETON 77 " " 01480C 86 GOTO UPDATE UPDATE 01490C 85 GOTO READ REPEAT 01500C 96 GOTO ERROR ERROR ÐÐ01510C 77 EXSR SR103 MOVE DATA 01520C*------------------------------------------------------------------- 01530C EDIT TAG 01540C EXSR SR104 EDIT DATA 01550C EXSR SR72 REWRITE DATA 01560C 96 GOTO ERROR ERROR 01570C GOTO NEXT 01580C*------------------------------------------------------------------ 01590C UPDATE TAG 01600C* UPDATE DATA BASE. 01610C EXSR SR105 FINAL EDIT 01620C 96 GOTO ERROR ERROR 01630C EXSR SR106 UPDATE 01640C 96 GOTO ERROR ERROR 01650C 1 ADD COUNT COUNT 30 01660C GOTO START 01670C*------------------------------------------------------------------- 01680C JUMP TAG 01690C* SET-UP JUMP TO REQUESTED FIELD 01700C 1 ADD W W 30 01710C W COMP #L 54 01720C 54 Z-ADD318 M 50 96 FLAG ERROR 01730C 54 GOTO ERROR BAD ESC 01740C MOVE ' ' W3A 3 01750C MOVEA#A,W W3A ÐÐ01760C Z-ADD3 W2N 20 01770C EXIT SUBRAJ R. JUSTIFY 01780C RLABL W2N 01790C RLABL W3A 01800C MOVE W3A F NEW FIELD # 01810C GOTO READ 01820C*-------------------------------------------------------------------- 01830C ERROR TAG 01840C EXSR SR102 VALIDATE FIELD # 01850C EXSR SR89 GET MSG 01860C* * * * * EXSR SR73 PUT MSG 01870C GOTO READ 01880C*------------------------------------------------------------------ 01890C NEWITM TAG 01900C MOVEL'QXXXXX' PROG 01910C GOTO END 01920C*------------------------------------------------------------------- 01930C MENU TAG 01940C* SET-UP LINK TO MENU 01950C EXSR SR96 GET CRTFILE 01960C Z-ADD1 W 01970C BLK6 LOKUPLNK,W 54 01980C 54 MOVELLNK,W PROG 8 01990C 54 MOVE BLK6 LNK,W 02000C N54 MOVEL'CONTU 'PROG ÐÐ02010C EXSR SR97 UPDATE CRTFILE 02020C EXSR SR98 >>>>>>>>>>>>> 02030C*-------------------------------------------------------------------- 02040C GOODBY TAG 02050C* LINK TO SIGN-OFF 02060C MOVEL'GOODBY' PROG 02070C*---------------------------------------------------------------- 02080C END TAG 02090C EXSR SR96 GET CRTFILE 02100C EXSR SR97 REWRITE CRTFILE 02110C EXSR SR98 >>>>>>>>>>> 02120C*------------------------------------------------------------------- 02130C ENDJOB TAG 02140C MOVEL'ENDJOB' PROG 02150C EXSR SR98 >>>>>>>>>>>>>>>> 02160C********************************************************************* 02170C* 02180C* 02190C* 02200C* 02210C* 02220C* 02230C* 02240C* 02250C* ÐÐ02260C* 02270C* 02280C* 02290C* 02300C* 02310C* 02320C* 02330C* 02340C* 02350C* 02360C* 02370C* 02380C* 02390C* 02400C******************************************************************** 02410CSR SR66 BEGSR 02420CSR MOVEABLK35 A39,3 INIT A39 02430CSR ENDSR 02440C******************************************************************** 02450CSR SR67 BEGSR 02460CSR EXITFZCR 02470CSR ENDSR 02480C***************************************************************** 02490CSR SR68 BEGSR 02500CSR EXITFZLF LINE FEED ÐÐ02510CSR ENDSR 02520C**************************************************************** 02530CSR SR69 BEGSR 02540CSR 50 EXITFZPUTXY MOVE CURSOR 02550CSR RLABL RPGLIN 02560CSR RLABL RPGCOL 02570CSRN50 EXITFZMOVXY MOVE CURSOR 02580CSR RLABL RPGLIN 02590CSR RLABL RPGCOL 02600CSR ENDSR 02610C***************************************************************** 02620CSR SR70 BEGSR 02630C* CLEAR TERM SCREEN. 02640CSR 50 EXITFZISTAT INIT STATUS LINE 02650CSR 50 EXITFZESCH CLEAR SCREEN 02660CSRN50 EXITFZCPAGE CLEAR SCREEN 02670CSRN50 MOVEL'091' RPGLIN 02680CSRN50 MOVEL'001' RPGCOL 02690CSRN50 EXSR SR69 MOVE CURSOR 02700CSR Z-ADD91 COUNT 30 02710CSR SETON 70 02720CSRN51 EXCPT PUT PARTIAL HDG 02730CSR SETOF 70 02740CSR ENDSR 02750C********************************************************************** ÐÐ02760CSR SR71 BEGSR 02770C* PUT HEADINGS TO TERMINAL 02780CSR SETON 71 02790CSR EXCPT PUT HEADINGS 02800CSR SETOF 71 02810CSR Z-ADD COUNT 02820CSR ENDSR 02830C********************************************************************* 02840CSR SR72 BEGSR 02850C* PUT DATA TO TERMINAL 02860CSR COUNT SUB 1 W3N 30 02870CSR 50 W3N SUB 90 W3N 02880CSR MOVELW3N RPGLIN 4 02890CSR MOVEL'001' RPGCOL 4 02900CSR EXSR SR69 MOVE CURSOR 02910CSR SETON 72 02920CSR EXCPT PUT DATA 02930CSR SETOF 72 02940CSR ENDSR 02950C*********************************************************************** 02960CSR SR73 BEGSR 02970C* PUT ERROR MESSAGE TO TERMINAL 02980CSR Z-ADDCOUNT W3N 30 02990CSR 50 W3N SUB 90 W3N 03000CSR MOVELW3N RPGLIN ÐÐ03010CSR MOVEL'001' RPGCOL 03020CSR EXSR SR69 MOVE CURSOR 03030CSR SETON 73 03040CSR EXCPT PUT MSG 03050CSR SETOF 73 03060CSR ENDSR 03070C******************************************************************* 03080CSR SR75 BEGSR 03090C* READ FROM TERMINAL 03100CSR SETOF 779096 03110CSR SETOF 9392 03120CSR SETOF 8988 03130CSR SETOF 8685 03140CSR EXSR SR66 INIT A39 03150CSR MOVE BLK#L W#LA #L BUFFER 03160CSR Z-ADDCOUNT W3N 30 03170CSR 50 W3N SUB 90 W3N 03180CSR MOVELW3N RPGLIN 4 03190CSR MOVE LOC,F W3A 03200CSR MOVELW3A RPGCOL 4 03210CSR EXSR SR69 MOVE CURSOR 03220CSR EXITFZR#L READ FROM TERMINAL 03230CSR RLABL W#LA READ BUFFER 03240CSR MOVEAW#LA #A INPUT DATA ARRAY 03250CSR MOVE BLK#L W#LA INIT INPUT ARRAY ÐÐ03260CSR Z-ADD1 W 30 03270CSR '\' LOKUP#A,W 90 FLAG ESC 03280CSRN90 GOTO T75B NOT ESC 03290CSR 1 ADD W W 03300CSR W COMP #L 54 03310CSR 54 GOTO T75A BAD ESC 03320CSR #A,W COMP 'G' 98 GOODBY 03330CSR #A,W COMP 'E' 94 MENU 03340CSR #A,W COMP 'N' 93 NEW ITEM 03350CSR #A,W COMP 'J' 92 JUMP 03360CSR #A,W COMP 'B' 89 SKIP BKWRD 03370CSR #A,W COMP 'S' 88 SPACE FILL 03380CSR #A,W COMP 'U' 86 UPDATE 03390CSR #A,W COMP 'R' 85 REPEAT 03400CSR 98 GOTO GOODBY 03410CSR 94 GOTO MENU 03420CSR 93 GOTO NEWITM 03430CSR 92 03440COR 89 03450COR 88 03460COR 86 03470COR 85 GOTO END75 GOOD ESC 03480C*------------------------------------------------------------------ 03490CSR T75A TAG 03500C* FLAG BAD ESC INPUT ÐÐ03510CSR Z-ADD318 M 96 FLAG ERROR 03520CSR GOTO END75 03530C*-------------------------------------------------------------------- 03540CSR T75B TAG 03550C* MOVE DATA 03560CSR Z-ADD1 W 03570CSR ' ' LOKUP#A,W 77 03580CSR 77 MOVEA#A,W W#LA INPUT DATA 03590C*-------------------------------------------------------------------- 03600CSR END75 TAG 03610C* INIT PREV ERROR MSG. 03620CSR MOVEABLK35 A39,3 03630CSR ENDSR 03640C********************************************************************** 03650CSR SR80 BEGSR 03660C* GET MASTER RECORD 03670CSR SETOF 31 03680CSR CHAIN 30 GET MASTER 03690CSRN30 COMP 'D' 31 FLAG DELETE 03700CSR 30 03710COR 31 EXSR SR205 INIT MASTER 03720CSR EXSR SR207 SAVE MASTER 03730CSR ENDSR 03740C********************************************************************** 03750CSR SR81 BEGSR ÐÐ03760C* ADD NEW MASTER TO FILE 03770CSR SETON 81 03780CSR EXCPT ADD MASTER 03790CSR SETOF 81 03800CSR ENDSR 03810C*********************************************************************** 03820CSR SR82 BEGSR 03830C* REWRITE MASTER 03840CSR SETON 82 03850CSR EXCPT REWRITE MASTER 03860CSR SETOF 82 03870CSR ENDSR 03880C********************************************************************** 03890CSR SR89 BEGSR 03900C* GET MESSAGE MASTER 03910CSR M CHAINMGFILE 54 03920CSR 54 MOVE BLK35 MGTEXT 03930CSR 54 MOVELM MGTEXT 03940CSR 54 MOVE MES,1 MGTEXT 03950CSR MOVEAMGTEXT A39,3 03960CSR ENDSR 03970C******************************************************************** 03980CSR SR96 BEGSR 03990CSR # CHAINCRTFILE H9 GET CRTFILE 04000CSR H9 GOTO ENDJOB ÐÐ04010CSR ENDSR 04020C****************************************************************** 04030CSR SR97 BEGSR 04040C* UPDATE CRTFILE. EXIT PROGRAM. 04050CSR TIME CRTIME 04060CSR MOVELUDATE CRDATE 04070CSR SETON 97 04080CSR EXCPT UPDATE CRTFILE 04090CSR SETOF 97 04100CSR ENDSR 04110C******************************************************************** 04120CSR SR98 BEGSR 04130CSR SETON 51 SUPPRESS HDG FLAG 04140CSR EXSR SR70 CLEAR SCREEN 04150CSR EXITFCHAIN >>>>>>>>>> 04160CSR RLABL PROG 04170CSR ENDSR 04180C******************************************************************** 04190CSR SR99 BEGSR 04200C* STORE THIS PROG AS RETURN TO PROG. 04210CSR EXSR SR96 GET CRTFILE 04220CSR Z-ADD8 W 04230C*------------------------------------------------------------------- 04240CSR T99A TAG 04250CSR W SUB 1 W 54 ÐÐ04260CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 04270CSR LNK,W COMP BLK6 54 04280CSRN54 GOTO T99A 04290CSR MOVELRETURN LNK,W 04300CSR EXSR SR97 UPDATE CRTFILE 04310CSR EXSR SR98 >>>>>>>>>>>>>> 04320CSR END99 ENDSR 04330C******************************************************************** 04340C* 04350C* 04360C* 04370C* 04380C* 04390C* 04400C* 04410C* 04420C* 04430C*********************************************************************** 04440CSR SR101 BEGSR 04450C* 1-TIME INITIALIZE 04460CSR MOVE BIT,1 NUL 04470CSR Z-ADD#E FLIMIT 30 TOTAL NUMB FIELDS 04480CSR MOVE ' ' BLK#L #L 04490C* GET PORT # AND CRTFILE 04500CSR MOVE ' ' W2A 2 ÐÐ04510CSR EXITFZGMINX GET PORT # 04520CSR RLABL W2A 04530CSR MOVE W2A # 20 PORT NO. 04540CSR # COMP 0 54 04550CSRN54 Z-ADD25 # DEFAULT 04560CSR EXSR SR96 GET CRTFILE 04570CSR MOVE CALL LNK 04580CSR MOVE 'QXXXXX 'PROG 04590CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 04600CSR TST,# COMP 'S' 56 04610CSRN56 CRSHUT COMP 'S' 56 04620CSR 56 MOVE 'S' CRSHUT SHUTDOWN 04630CSR 56 MOVE 'SHUTDOWN'PROG 04640CSR EXSR SR97 UPDATE CRTFILE 04650CSR 56 EXSR SR98 >>>>>>>>>>>>> 04660CSR MOVE ' 'PROG 04670CSR MOVE ' ' A39 INIT A39 04680CSR 50 MOVE BIT,28 A39,1 04690CSR 50 MOVE 'D' A39,2 04700CSR 50 MOVE BIT,28 A39,38 04710CSR 50 MOVE 'E' A39,39 04720C* DEFINE WORK FIELDS,ETC. 04730CSR MOVE ' ' BLK35 35 04740CSR MOVE ' ' BLK6 6 04750C* ÐÐ04760C* 04770C* 04780C* 04790CSR ENDSR 04800C********************************************************************** 04810CSR SR102 BEGSR 04820C* VALIDATE FIELD NO. 04830CSR F COMP 0 54 04840CSRN54 Z-ADD#F F 04850CSR F COMP FLIMIT 55 04860CSR 55 Z-ADD#F F 04870CSR ENDSR 04880C******************************************************************** 04890CSR SR103 BEGSR 04900C* MOVE INPUT DATA 04910CSR EXSR SR201 IDENTIFY-F 04920CSR EXSR SR202 R. JUSTIFY 04930C* 04940C* 04950C* 04960C* 04970C* 04980C* 04990C* 05000C* ÐÐ05010C* 05020C* 05030C* 05040C* 05050C* 05060C* 05070C* 05080C* 05090C* 05100C* 05110C* 05120C* 05130CSR MOVE ' ' DUN,F EDIT FLAG 05140CSR ENDSR 05150C******************************************************************** 05160CSR SR104 BEGSR 05170C* EDIT INPUT DATA 05180CSR 01 EXSR XXX 05190C* 05200CSR 96 MOVE ' ' DUN,F EDIT FLAG 05210CSRN96 MOVE 'X' DUN,F 05220CSR ENDSR 05230C*********************************************************************** 05240CSR SR105 BEGSR 05250C* FINAL EDIT ÐÐ05260CSR SETOF 77 05270CSR SETON 79 FINAL EDIT FLAG 05280CSR Z-ADD1 F 96 05290C*-------------------------------------------------------------------- 05300CSR T105A TAG 05310CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05320CSRN54 GOTO END105 05330CSR EXSR SR201 IDENTIFY-F 05340CSR EXSR SR104 EDIT 05350CSRN96 GOTO T105A 05360C*-------------------------------------------------------------------- 05370CSR END105 TAG 05380CSR SETOF 79 05390CSR ENDSR 05400C******************************************************************** 05410CSR SR106 BEGSR 05420C* UPDATE DATA BASE. 05430CSR EXSR SR203 CLASSIFY TRAN 05440CSR 60 GOTO T106A ADD TRAN 05450CSR 61 GOTO T106D CHANGE TRAN 05460CSR 62 GOTO T106F DELETE TRAN 05470C* FLAG BAD TRAN CODE 05480CSR Z-ADD300 M 96 FLAG ERROR 05490CSR Z-ADD#F F FIELD # 05500CSR GOTO END106 ÐÐ05510C*------------------------------------------------------------------- 05520CSR T106A TAG 05530C* ADD TRANSACTION 05540CSR 30 GOTO T106B NOT ON FILE 05550CSR 31 GOTO T106C DELETED MASTER 05560C* FLAG DUPLICATE ADD ERROR 05570CSR Z-ADD301 M 96 FLAG ERROR 05580CSR Z-ADD#F F FIELD # 05590CSR GOTO END106 05600C*--------------------------------------------------------------------- 05610CSR T106B TAG 05620C* ADD-- MAST NOT ON FILE 05630CSR EXSR SR81 ADD NEW MASTER 05640CSR GOTO END106 05650C*--------------------------------------------------------------------- 05660CSR T106C TAG 05670C* ADD-- MAST IS DELETED 05680CSR MOVE 'A' #PSTAT RECORD STATUS 05690CSR EXSR SR82 REWRITE MAST 05700CSR GOTO END106 05710C*---------------------------------------------------------------------- 05720CSR T106D TAG 05730C* CHANGE TRANSACTION. 05740CSRN30N31 GOTO T106E GOT IT 05750C* FLAG NO MASTER ERROR ÐÐ05760CSR Z-ADD302 M 96 FLAG ERROR 05770CSR Z-ADD#F F FIELD # 05780CSR GOTO END106 05790C*----------------------------------------------------------------------- 05800CSR T106E TAG 05810C* REWRITE MASTER 05820CSR EXSR SR82 REWRITE MAST 05830CSR GOTO END106 05840C*----------------------------------------------------------------------- 05850CSR T106F TAG 05860C* DELETE TRANSACTION 05870CSRN30N31 GOTO T106G GOT IT 05880C* FLAG NO MASTER ERROR 05890CSR Z-ADD302 M 96 FLAG ERROR 05900CSR Z-ADD#F F FIELD # 05910CSR GOTO END106 05920C*----------------------------------------------------------------------- 05930CSR T106G TAG 05940C* DELETE MASTER. 05950CSR EXSR SR204 CHECK FOR ACTIVITY 05960CSR 96 Z-ADD#F F FIELD # 05970CSR 96 GOTO END106 ERROR 05980CSR MOVE 'D' #PSTAT RECORD STATUS 05990CSR EXSR SR82 REWRITE MASTER 06000CSR END106 ENDSR ÐÐ06010C************************************************************************ 06020CSR SR201 BEGSR 06030C* IDENTIFY FIELD NO. 06040CSR SETOF 010203 06050CSR SETOF 040506 06060CSR SETOF 070809 06070CSR SETOF 10 06080CSR F COMP 1 01 06090CSR F COMP 2 02 06100CSR F COMP 3 03 06110CSR F COMP 4 04 06120CSR F COMP 5 05 06130CSR F COMP 6 06 06140CSR F COMP 7 07 06150CSR F COMP 8 08 06160CSR F COMP 9 09 06170CSR F COMP 10 10 06180CSR ENDSR 06190C********************************************************************** 06200CSR SR202 BEGSR 06210C* RIGHT JUSTIFY 06220CSR F LOKUPNUM 54 06230CSRN54 GOTO END202 NOT NUMERIC FIELD 06240CSR Z-ADD10 W2N 20 06250CSR MOVELW#LA W#LA #L ÐÐ06260CSR EXIT SUBRAJ R. JUSTIFY 06270CSR RLABL W2N 06280CSR RLABL W#LA 06290CSR END202 ENDSR 06300C*********************************************************************** 06310CSR SR203 BEGSR 06320C* CLASSIFY TRAN CODE 06330CSR TRAN COMP 'A' 60 ADD 06340CSR TRAN COMP 'C' 61 CHANGE 06350CSR TRAN COMP 'D' 62 DELETE 06360CSR MOVE BLK35 TRNNAM 6 06370CSR 60 MOVE 'ADD ' TRNNAM 06380CSR 61 MOVE 'CHANGE' TRNNAM 06390CSR 62 MOVE 'DELETE' TRNNAM 06400CSR ENDSR 06410C**************************************************************************06420C* 06430C* 06440C* 06450C* 06460C* 06470C* 06480C* 06490C* 06500C******************************************************************** ÐÐ06510CSR SR210 BEGSR 06520C* BUILD WORK ORDER NO. 06530CSR MOVEAW#LA #A 06540CSR Z-ADD1 W 06550CSR '-' LOKUP#A 54 06560CSRN54 Z-ADD7 W 06570CSR MOVEA#A,W W4A 4 06580CSR 54 MOVEL' ' W4A 06590CSR Z-ADD4 W2N 06600CSR EXIT SUBRAJ RJ 06610CSR RLABL W2N 06620CSR RLABL W4A 06630CSR MOVE W4A XWOD 30 WORK ORDER DASH 06640CSR MOVEABLK#L #A,W 06650CSR #A,W COMP '0' 54 54 06660CSR 54 MOVEA#A,1 W5A 5 06670CSR 54 MOVELL' ' XWOP 6 06680CSRN54 MOVEA#A XWOP 06690CSRN54 MOVE XWOP W5A 06700CSR Z-ADD5 W2N 06710CSR EXIT SUBRAJ RJ 06720CSR RLABL W2N 06730CSR RLABL W5A 06740CSR MOVE W5A XWOP WORK ORDER PRIME 06750CSR MOVELXWOP XWO WORK ORDER NO. ÐÐ06760CSR MOVE XWOD XWO 9 06770CSR 04 MOVELXWOP PREFIX 1 06780CSR ENDSR 06790C******************************************************************** 06800C* 06810C* 06820C* 06830C* 06840C* 06850C* 06860C* 06870C* 06880C* 06890C* 06900C* 06910C* 06920C* 06930C* 06940C* 06950C* 06960C* 06970C* 06980C* 06990C* 07000C* ÐÐ07010C* 07020C* 07030C* 07040C* 07050C* 07060C* 07070C* 07080C* 07090C* 07100C* 07110C* 07120C* 07130C* 07140C* 07150C* 07160C* 07170C* 07180C* 07190C* 07200C* 07210C* 07220O******************************************************************** 07230OTERM132 E 70 07240O OR 71 07250O BIT,28 1 ÐÐ07260O N50 8 '8091001' 07270O N50 BIT,1 9 07280O N50 BIT,1 10 07290O 50 10 '[001 ]001' 07300O 50 BIT,28 6 07310O UDATE 18 ' - - ' 07320O*------------------------------------------------------------------- 07330O E 70 07340O OR 71 07350O 1 ' ' 07360O*------------------------------------------------------------------- 07370O E 70 07380O OR 71 07390O OR 72 01 07400O* 07410O* 07420O* 07430O* 07440O* 07450O* 07460O* 07470O* 07480O* 07490O* 07500O* ÐÐ07510O* 07520O* 07530O* 07540O* 07550O* 07560O* 07570O* 07580O* 07590O* 07600O* 07610O* 07620O* 07630O* 07640O* 07650O* 07660O*-------------------------------------------------------------------- 07670O E 73 07680O NUL 132 07690O A39 75 07700O* 07710O* 07720O* 07730O* 07740O* 07750O* ÐÐ07760O* 07770O******************************************************************** 07780OCRTFILE E 97 07790O PROG 26 07800O CRTIME 33 07810O CRDATE 37 07820O LNK 79 07830O******************************************************************** ** NUL ARRAY 007840 007850** #A ARRAY 007860 007870** LOC ARRAY 07880 07890** A39 ARRAY 07900 07910** NUM ARRAY 007920 007930** DUN ARRAY 007940 007950** MES ARRAY 007960---MESSAGE NOT ON FILE--- 007970** LNK ARRAY 007980 07990/* 08000ÐÐ_‚_‚0O* 07770O******************************************************************** 07780OCRTFILE E 97 07790O PROG 26 07800O CRTIME 33 07810O CRDATE 37 07820O LNK 79 07830O******************************************************************** ** NUL ARRAY 007840 007850** #A ARRAY 007860 007870** LOC ARRAY 07880 07890** A39 ARRAY 07900 07910** NUM ARRAY 007920 007930** DUN ARRAY 007940 007950** MES ARRAY 007960---MESSAGE NOT ON FILE--- 007970** LNK ARRAY 007980 07990/* 08000ÐÈ(2ÿ 2X001PG P999999120282(èÈÐ00010H Q001PG00020F* PUT DELETED AND NON-DELETED PROGNAMES TO 2 SEPARATE FILES 00030F* 00040F* REVISED 6/14/82 1:10 PM 00050FPROGNAMEIP F 80 DISK 00060FPG1 O F 80 DISK 00070FPG2 O F 80 DISK 00080E******************************************************************** 00090E* TXT 35 1 00100IMGFILE MG 10 00110I 1 35 MSG 90 00120I 2 2 TEST2 03 00130I 3 3 TEST3 04 00140I 4 4 TEST4 05 00150I 5 5 TEST5 06 00160I 1 1 TEST1 00170I 76 80 RECNO 00180I 1 35 TXT 00190C 10 90 GOTO OUT 00200C 10 TEST1 COMP '0' 91 91 00210C 10 91 TEST1 COMP '9' 9191 00220C 10N91 GOTO OUT 00230C 10 06 MOVEATXT,6 W35A 35 00240C 10 06 GOTO OUT 00250C 10 05 MOVEATXT,5 W35A ÐÐ00260C 10 05 GOTO OUT 00270C 10 04 MOVEATXT,4 W35A 00280C 10 04 GOTO OUT 00290C 10 03 MOVEATXT,3 W35A 00300C OUT TAG 00310OMG1 D 10N91N90 00320O MSG 35 00330O RECNO 80 00340OMG2 D 10 91N90 00350O W35A B 35 00360O RECNO 80 /* 000370_‚ ÐÐ_‚_‚0C 10 05 GOTO OUT 00270C 10 04 MOVEATXT,4 W35A 00280C 10 04 GOTO OUT 00290C 10 03 MOVEATXT,3 W35A 00300C OUT TAG 00310OMG1 D 10N91N90 00320O MSG 35 00330O RECNO 80 00340OMG2 D 10 91N90 00350O W35A B 35 00360O RECNO 80 /* 000370_‚ ÐÈ(( (X001MG P120282120282(èÈÐ00010H Q001MG00020F* PUT ERROR-TYPE & PROMPT-TYPE MESSAGES TO 2 SEPARATE FILES 00030F* LEFT JUSTIFY (OMIT ERROR NUMBERS) 00040F* REVISED 8/20/79 1:10 PM 00050FMGFILE IP F 80 DISK 00060FMG1 O F 80 DISK 00070FMG2 O F 80 DISK 00080E******************************************************************** 00090E TXT 35 1 00100IMGFILE MG 10 00110I 1 35 MSG 90 00120I 2 2 TEST2 03 00130I 3 3 TEST3 04 00140I 4 4 TEST4 05 00150I 5 5 TEST5 06 00160I 1 1 TEST1 00170I 76 80 RECNO 00180I 1 35 TXT 00190C 10 90 GOTO OUT 00200C 10 TEST1 COMP '0' 91 91 00210C 10 91 TEST1 COMP '9' 9191 00220C 10N91 GOTO OUT 00230C 10 06 MOVEATXT,6 W35A 35 00240C 10 06 GOTO OUT 00250C 10 05 MOVEATXT,5 W35A ÐÐ00260C 10 05 GOTO OUT 00270C 10 04 MOVEATXT,4 W35A 00280C 10 04 GOTO OUT 00290C 10 03 MOVEATXT,3 W35A 00300C OUT TAG 00310OMG1 D 10N91N90 00320O MSG 35 00330O RECNO 80 00340OMG2 D 10 91N90 00350O W35A B 35 00360O RECNO 80 /* 000370_‚ _‚_‚0I 1 1 TEST1 00170I 76 80 RECNO 00180I 1 35 TXT 00190C 10 90 GOTO OUT 00200C 10 TEST1 COMP '0' 91 91 00210C 10 91 TEST1 COMP '9' 9191 00220C 10N91 GOTO OUT 00230C 10 06 MOVEATXT,6 W35A 35 00240C 10 06 GOTO OUT 00250C 10 05 MOVEATXT,5 W35A ÐÈ(X' XúX001PC P120282120282(èÈÐ00010H Q001PC00020F* GENERATE PROD COST GUIDE FILE. (X001PC) 00030F* REVISED 9/15/80 4:15 PM. 00040F* CHASE BILL MATL DOWN. 00050F* SWITCH-1 BYPASSES CHAIN TO CHASE WHERE-USED (Q007PC) 00060FPCCAND IP F 10 DISK 00070FPCGUIDE UC F 11R10AI 1 DISK A 00080FBMMAST ID F 86L20AI 1 DISK 00090FTERM80 O F 80 5 00100I******************************************************************** 00110IPCCAND PC 01 00120I 1 100PCPN 00130I******************************************************************** 00140IPCGUIDE PG 00150I* PROD COST GUIDE FILE. 00160I* PART # 10N 00170I 1 100PGPN 00180I* RECORD STATUS 1A 00190I 11 11 PGSTAT 00200I******************************************************************** 00210IBMMAST BM 00220I* BILL OF MATERIAL RECORD 00230I* KEY AREA 00240I* ASSY PART NO. 10N 00250I 1 100BMAPN ÐÐ00260I* COMPONENT PART # 10N 00270I 11 200BMCPN 00280I* ITEM NO. 3N 00290I 25 270BMITNO 00300I* QTY PER ASSY 7P 00310I P 28 310BMQTY 00320I* SCRAP ALLOW .2N 00330I 34 352BMSCRP 00340I* ISSUE CODE 2A 00350I* PT = PULL TIME 00360I* OR = ON REQUEST 00370I* BI = BULK ISSUE 00380I* AR = AS REQUIRED 00390I* RA = REF ASSY 00400I* TD = TRAV DOC 00410I* SD = SHIP DOC 00420I* RD = REF DOC 00430I* VS = VENDOR SUPPLIED 00440I 36 37 BMISSU 00450I* EFFECTIVITY. 00460I* BEGIN CHANGE LEVEL 2A 00470I 38 39 BMBCHG 00480I* ENDING CHANGE LEVEL 2A 00490I 40 41 BMECHG 00500I* BEGIN ECN # 5A ÐÐ00510I 42 46 BMBECN 00520I* ENDING ECN # 5A 00530I 47 51 BMEECN 00540I* DISPOSITION CODE 1A 00550I* U = USE UP OLD STYLE 00560I* N = NOW (IMMEDIATE) 00570I 52 52 BMDISP 00580I* FILLER 5A 53 57 FFFFFF 00590I* ROUTING. 00600I* OPER NO. 5P 00610I P 58 600BMOPER 00620I* DEPT NO. 5P 00630I P 61 630BMDEPT 00640I* WORK CENTER NO. 3P 00650I P 64 650BMWC 00660I* COMPONENT OPER REFERENCE INFO 10A 00670I 66 75 BMREF 00680I* FILLER 10A 76 85 FFFFFF 00690I* 00700I* RECORD STATUS 1A 00710I* D = DELETED 00720I 86 86 BMSTAT 00730C******************************************************************** 00740C* INITIALIZE 00750C N79 EXSR SR101 INIT ÐÐ00760C N01 GOTO END 00770C U1 Z-ADDPCPN BMCPN 00780C U1 EXSR SR72 00790C MOVELPCPN W20A 20 00800C MOVE ZERO10 W20A 00810C*------------------------------------------------------------------ 00820C TAG30 TAG 00830C* SET-UP NEXT READ 00840C W20A SETLLBMMAST 00850C*--------------------------------------------------------------- 00860C TAG40 TAG 00870C* GET NEXT COMPONENT. 00880C SETOF 5465 00890C READ BMMAST 54GET COMPONENT 00900C 54 GOTO END END OF FILE 00910C BMAPN COMP PCPN 54 00920C N54 GOTO END WRONG ASSY 00930C BMSTAT COMP 'D' 54 00940C 54 GOTO TAG40 DELETED RECORD 00950C* PUT GUIDE RECORD IF NOT ALREADY DONE. 00960C EXSR SR72 PUT GUIDE 00970C GOTO TAG40 GET NEXT COMPONENT 00980C*------------------------------------------------------------------ 00990C END TAG 01000CLRNU1 MOVEL'Q007PC' PROG 8 ÐÐ01010CLR U1 MOVEL'Q003PC' PROG 01020CLR EXITFCHAIN 01030CLR RLABL PROG 01040C***************************************************************** 01050CSR SR72 BEGSR 01060C* PUT GUIDE RECORD. 01070CSR BMCPN CHAINPCGUIDE 65 01080CSRN65 GOTO END72 ALREADY DONE 01090CSR SETON 72 01100CSR EXCPT PUT GUIDE 01110CSR SETOF 72 01120CSR END72 ENDSR 01130C******************************************************************** 01140CSR SR101 BEGSR 01150C* INITIALIZE (1-TIME). 01160CSR SETON 79 01170CSR MOVE ' ' BLK12 12 01180CSR MOVE ' ' BLK20 20 01190CSR Z-ADD0 ZERO10 100 01200CSR TIME TIME 60 01210CSR SETON 80 01220CSR EXCPT 01230CSR SETOF 80 01240CSR ENDSR 01250O******************************************************************** ÐÐ01260OTERM80 E 80 01270O 11 'START 001PC' 01280O TIME 25 01290O PCPN 45 ' - - ' 01300O******************************************************************** 01310OPCGUIDE EADD 72 65 01320O BMCPN 10 01330O 11 ' ' /* 001340_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(" XR12 P999999120282(èÈÐ SUBROUTINE ZR12 (IBUF) 00010C RING BELL. READ 12-CHAR FROM TERMINAL. 00020 INTEGER IBUF (6) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 12 00070 ITC = 0 00080 IA = $0700 00090 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00100 RETURN 00110 END 00120_‚ _‚_‚ ÐÈ(*  X001PM P120282120282(èÈÐ00010H Q001PM00020F* GENERATE PART NUMBER GUIDE FILE FROM PART MASTER. 00030F* INCLUDES ALL ACTIVE PART NUMBERS 00040FPMMST2 IP F 674 12AI 1 DISK 00050FPNGUIDE O F 10 DISK 00060I******************************************************************* 00070IPMMST2 PM 01 674NCD 00080I 1 100PMPN 00090I GG 02 00100O****************************************************************** 00110OPNGUIDE D 01 00120O PMPN 10 /* 000130_‚ ÐÐ_‚_‚0H Q001PM00020F* GENERATE PART NUMBER GUIDE FILE FROM PART MASTER. 00030F* INCLUDES ALL ACTIVE PART NUMBERS 00040FPMMST2 IP F 674 12AI 1 DISK 00050FPNGUIDE O F 10 DISK 00060I******************************************************************* 00070IPMMST2 PM 01 674NCD 00080I 1 100PMPN 00090I GG 02 00100O****************************************************************** 00110OPNGUIDE D 01 00120O PMPN 10 /* 000130_‚ ÐÈ(–6 –?X001QM P120282120282(èÈÐ00010H Q001QM00020F* INITIALIZE CRT512 . (X001QM) 00030F* REVISED 1/02/80 6:15 PM. 00040FBITTAB IP F 33 DISK 00050FCRT512 UC F 512R DISK 00060E******************************************************************** 00070E BIT 33 1 SCREEN CONTR. CHAR 00080E CALL 5 6 CALL STACK 00090I******************************************************************* 00100IBITTAB BT 01 00110I 1 33 BIT 00120I******************************************************************** 00130ICRT512 CR 00140I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00150I* STD AREA - SAME FOR ALL PROGRAMS. 00160I* CALL STACK 5 X 6A 00170I 38 67 CALL 00180I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00190I* 68 73 CRRET 00200I* QUOTE # 5A 00210I 80 84 CRQOTE 00220C******************************************************************** 00230C* INITIALIZE 00240C EXSR SR101 1-TIME INIT 00250C MOVE BLK6 CALL ÐÐ00260C*------------------------------------------------------------------- 00270C TAG10 TAG 00280C NH9 SETON 80 00290C NH9 EXCPT UPDATE CRT512 . 00300C SETOF 80 00310CLR MOVEL'Q002QM' PROG 8 00320CLR EXITFCHAIN 00330CLR RLABL PROG 00340C*********************************************************************** 00350CSR SR101 BEGSR 00360C* 1-TIME INITIALIZE 00370C* GET PORT # AND CRT512 00380CSR MOVE ' ' W8A 8 00390CSR Z-ADD0 W2N 20 00400CSR Z-ADD0 W1N 10 00410CSR MOVE ' ' W2A 2 00420CSR EXITFPGMINX GET PORT # 00430CSR RLABL W8A 00440CSR RLABL W2N 00450CSR RLABL W1N 00460CSR RLABL W2A 00470CSR MOVE W2A PORT 20 PORT NO. 00480CSR PORT COMP 0 54 00490CSRN54 Z-ADD25 PORT DEFAULT 00500CSR PORT CHAINCRT512 H9 ÐÐ00510C* DEFINE WORK FIELDS,ETC. 00520CSR MOVE ' ' BLK35 35 00530CSR MOVE ' ' BLK5 5 00540CSR Z-ADD0 ZERO3 30 00550CSR MOVE ' ' BLK20 20 00560CSR MOVE ' ' BLK4 4 00570CSR MOVE ' ' BLK3 3 00580CSR MOVE ' ' BLK2 2 00590CSR Z-ADD0 ZERO7 70 00600CSR MOVE ' ' BLK1 1 00610CSR MOVE ' ' BLK6 6 00620CSR MOVE ' ' BLK40 40 00630CSR Z-ADD0 ZERO9 90 00640CSR Z-ADD0 ZERO6 60 00650CSR ENDSR 00660O******************************************************************** 00670OCRT512 E 80NH9 00680O CALL 67 00690O BLK6 73 00700O BLK5 84 00710O ZERO3 87 00720O BLK20 107 00730O BLK20 127 00740O BLK4 131 00750O BLK20 151 ÐÐ00760O BLK3 154 00770O ZERO7 158P 00780O ZERO7 162P 00790O ZERO7 166P 00800O ZERO7 170P 00810O ZERO7 174P 00820O ZERO7 178P 00830O BLK2 180 00840O BLK1 181 00850O 182 ' ' 00860O ZERO7 186P 00870O ZERO3 188P 00880O BLK1 189 00890O ZERO3 191P 00900O BLK1 192 00910O BLK40 232 00920O BLK1 233 00930O BLK20 253 00940O BLK3 256 00950O ZERO7 260P 00960O 265 ' ' /* 000970_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–5ð –?X117PM Pø\040683040683(èÈÐ00010H Q117PM00020F* OUTPUT PURCHASED PARTS WITH LEAD TIMES > 10 WEEKS (X117PM) 00030F* REVISED 4-13-83 11:25 AM. 00040F*------------------------------------------------------------------- 00050FPPLEAD IP F 52 DISK 00060FBMWU ID F 21L20AI 1 DISK 00070FPPLEAD2 O F 52 DISK 00080I*********************************************************************** 00090IPPLEAD PP 01 00100I 1 42 PPREC 00110I 43 520PPAPN 00120I********************************************************************* 00130IBMWU BM 00140I* BILL OF MATERIAL WHERE-USED 00150I* COMPONENT P/N 10N 00160I 1 100BWPN 00170I* ASSY P/N 10N 00180I 11 200BWAPN 00190I* RECORD STATUS 1A 00200I 21 21 BWSTAT 00210C*********************************************************************** 00220C N99 EXSR SR101 INIT 00230C N01 GOTO END 00240C EXSR SR80 OUTPUT DETAIL 00250C EXSR SR301 GET W/U ÐÐ00260C*--------------------------------------------------------------- 00270C END TAG 00280C******************************************************************* 00290CSR SR80 BEGSR 00300C* OUTPUT DETAIL RECORDS ON 00310CSR SETON 80 00320CSR EXCPT OUTPUT ALL RECS 00330CSR SETOF 80 00340CSR ENDSR 00350C********************************************************************** 00360CSR SR81 BEGSR 00370C* OUTPUT END ITEMS FOR ASSY 00380CSR SETON 81 00390CSR EXCPT OUTPUT REC 00400CSR SETOF 81 00410CSR ENDSR 00420C*********************************************************************** 00430CSR SR101 BEGSR 00440C* INITIALIZE FIELDS 00450CSR SETON 99 1 TIME 00460CSR MOVE ' ' BLK20 20 00470CSR MOVE ' ' W20A 20 00480CSR MOVE ' ' W1A 1 00490CSR ENDSR 00500C************************************************************************ ÐÐ00510CSR SR301 BEGSR 00520C* GET END ITEMS FROM B/M WHERE-USED 00530CSR MOVE BLK20 W20A 00540CSR MOVELPPAPN W20A 00550CSR W20A SETLLBMWU 00560CSR SETOF 54 00570C*------------------------------------------------------------------------ 00580CSR T30A TAG 00590CSR READ BMWU 54 00600CSR 54 GOTO END301 00610CSR BWPN COMP PPAPN 54 00620CSRN54 GOTO END301 00630CSR BWSTAT COMP 'D' 54 00640CSR 54 GOTO T30A 00650CSR EXSR SR81 OUTPUT W/U 00660CSR GOTO T30A 00670CSR END301 ENDSR 00680O********************************************************************** 00690OPPLEAD2 E 80 00700O PPREC 42 00710O PPAPN 52 00720OPPLEAD2 E 81 00730O PPREC 42 00740O BWAPN 52 00750O************************************************************************* ÐÐ/* 00760_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–î –?X001RX P120282120282(èÈÐ00010H Q001RX00020F* INIT CRTFILE - ROUTING TEXT UPDATE. (X001RX) DG REL006 OK 00030F* REVISED 12/01/82 11:10 AM. 00040F* 00050FBITTAB IP F 33 DISK 00060FCRTFILE UC F 256R DISK 00070FTERMO O F 10 5 00080E******************************************************************** 00090E BIT 33 1 00100E CALL 5 6 00110E CTX 60 1 00120I******************************************************************* 00130IBITTAB BT 00140I 1 33 BIT 00150I****************************************************************** 00160ICRTFILE CR 00170I* CURRENT JOB 6A 00180I 21 26 CRJOB 00190I* CALL STACK 6A X 5 00200I 38 67 CALL 00210I* RET TO PROG 6A 00220I 68 73 CRRET 00230I* MENU NAME 6A 00240I 74 79 CRMENU 00250I*------------------------------------------------------------------- ÐÐ00260I* PART # 12A 00270I 80 91 CRPN 00280I* SEQ # 3N 00290I 92 940CRSEQ 00300I* TEXT WORK AREA 1A X 60 00310I 95 154 CTX 00320I* TEXT TYPE 1A 00330I 212 212 CRTYPE 00340I* HEAD LINE # 1N 00350I 213 2130CRLINE 00360I* SPACE 1A 00370I 214 214 CRSPAC 00380I* CUR INSTR 1A 00390I 215 215 CRTRAN 00400I* COPY FROM TEXT 6A 00410I 216 221 CRFTXT 00420I* FROM LINE # 7P 00430I P 222 2250CRFLIN 00440I* ENDING LINE 7P 00450I P 226 2290CRELIN 00460I* COPY TO TEXT 6A 00470I 230 235 CRTTXT 00480I* COPY TO LINE 7P 00490I P 236 2390CRTLIN 00500I* TEXT NAME 6A ÐÐ00510I 240 245 CRNAME 00520I* CURRENT LINE # 7P 00530I P 246 2490CRCLIN 00540I* LINE INCREMENT 3P 00550I P 250 2510CRINCR 00560C********************************************************************* 00570C MOVE ' ' BLK35 35 00580C MOVE ' ' BLK12 12 00590C MOVE ' ' BLK8 8 00600C MOVE ' ' BLK6 6 00610C Z-ADD0 ZERO5 50 00620C Z-ADD0 ZERO3 30 00630C Z-ADD0 ZERO7 70 00640C MOVE ' ' W2A 2 00650C EXITFZGMINX 00660C RLABL W2A 00670C MOVE W2A PORT 20 00680C PORT COMP 0 54 00690C N54 Z-ADD25 PORT 00700C PORT CHAINCRTFILE H9 00710C H9 GOTO END 00720C SETON 80 00730C EXCPT 00740C SETOF 80 00750C MOVEL'Q002RX 'PROG 8 ÐÐ00760C EXITFCHAIN 00770C RLABL PROG 00780C*-------------------------------------------------------------------- 00790C END TAG 00800O******************************************************************** 00810OTERMO E 80 00820O BIT,28 1 00830O 8 '8120001' 00840O********************************************************************* 00850OCRTFILE E 80 00860O CRPN 91 00870O CRSEQ 94 00880O CTX 154 00890O BLK12 221 00900O ZERO7 225P 00910O ZERO7 229P 00920O BLK6 235 00930O ZERO7 239P 00940O BLK6 245 00950O ZERO7 249P 00960O ZERO3 251P /* 00970_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(.  X001WC P120282120282(èÈÐ00010H Q001WC00020F* INIT SCHEDULED HOURS IN WORK CENTER MASTER.(X001WC) 00030F* REVISED 7/10/81 3:35 PM. 00040FWCMAST UP F 960 8AI 1 DISK 00050E******************************************************************** 00060E WSH 104 9 3 SCHEDULES LOAD-HRS 00070I******************************************************************** 00080IWCMAST WC 00090I* WORK CENTER MAST 00100I* SCHEDULED HRS 104 X 9.3B 00110I B 62 477 WSH 00120C******************************************************************** 00130C Z-ADD0 WSH 00140O******************************************************************** 00150OWCMAST D 01 00160O WSH 477B /* 00170_‚ ÐÐ_‚_‚0H Q001WC00020F* INIT SCHEDULED HOURS IN WORK CENTER MASTER.(X001WC) 00030F* REVISED 7/10/81 3:35 PM. 00040FWCMAST UP F 960 8AI 1 DISK 00050E******************************************************************** 00060E WSH 104 9 3 SCHEDULES LOAD-HRS 00070I******************************************************************** 00080IWCMAST WC 00090I* WORK CENTER MAST 00100I* SCHEDULED HRS 104 X 9.3B 00110I B 62 477 WSH 00120C******************************************************************** 00130C Z-ADD0 WSH 00140O******************************************************************** 00150OWCMAST D 01 00160O WSH 477B /* 00170_‚ ÐÈ(Â: ¼X001XP P120282120282(èÈÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Š÷ ŠX002BG P120282120282(èÈÐ00010H Q002BG00020F* UPDATE BUDGET, PROGRAM 2. (X002BG) 00030F* REVISED 3-26-80 2:00 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FBGMAST UC F 160R22AI 3 DISK A 00070FBGCONT IC F 160R DISK 00080FGLMAST IC F 165R11AI 3 DISK 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A10 10 10 1 A INPUT DATA ARRAY 00130E NUM 1 5 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 7 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E LOC 1 7 3 COL # 00170E BIT 33 1 SCREEN CONTR. CHAR 00180E BGQ 25 7 0 REQMTS 00190E BCD 25 6 0A DATES 00200I******************************************************************* 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I******************************************************************** 00280IGLMAST GL 00290I 18 57 GLDESC 00300I****************************************************************** 00310IBGMAST BG 00320I* BUDGET MASTER. 00330I* ACCOUNT # 00340I 3 4 BGPRFX 00350I 5 100BGPRIM 00360I 11 130BGDASH 00370I 3 13 BGKEY 00380I* DESCRIPTION 40A 00390I 14 53 BGDESC 00400I* BUDGET AMOUNTS 7P X 25 00410I P 54 153 BGQ 00420I* RECORD STATUS 1A 00430I 160 160 BGSTAT 00440I****************************************************************** 00450IBGCONT BC 00460I* BUDGET CONTROL MAST. 00470I* DATES 6N X 25 00480I 1 150 BCD 00490I* CUR INDENT LEVEL 2N 00500I 151 1520BCCIL ÐÐ00510C******************************************************************** 00520C* INITIALIZE 00530C EXSR SR101 1-TIME INIT 00540C Z-ADD0 TDATE 60 STUPIDITY 00550C*------------------------------------------------------------------ 00560C START TAG 00570C* SET-UP 1ST FIELD NO. 00580C Z-ADD0 BGQ 00590C MOVE ' ' TPFRX 2 00600C Z-ADD0 TPRIM 60 00610C Z-ADD0 TDASH 30 00620C Z-ADD0 TITEM 30 00630C Z-ADD0 TDATE 60 00640C Z-ADD0 TQTY 70 00650C MOVE ' ' DUN INIT EDIT ARRAY 00660C MOVE ' ' IOSW 00670C SETON 76 00680C EXCPT PUT HEADING 00690C SETOF 76 00700C Z-ADD1 F 30 FIELD # 00710C GOTO READ 00720C*------------------------------------------------------------------ 00730C NEXT TAG 00740C* SET-UP NEXT FIELD NO. 00750C 1 ADD F F FIELD # ÐÐ00760C*----------------------------------------------------------------- 00770C READ TAG 00780C* READ DATA FROM TERMINAL. 00790C SETOF 9096 00800C EXSR SR102 VALIDATE FIELD # 00810C 55 GOTO UPDATE DONE 00820C EXSR SR203 CLASSIFY TRAN 00830C 62 F COMP 6 54 00840C 62 54 GOTO UPDATE 00850C EXSR SR201 IDENTIFY-F 00860C SETON 69 00870C EXSR SR72 PROMPT 00880C SETOF 69 00890C EXSR SR75 READ TERMINAL 00900C 98 GOTO GOODBY GOODBY 00910C 94 GOTO MENU MENU REQUEST 00920C N04N03 00930CANN77N88 EXSR SR104 EDIT INPUT FIELD 00940C 96 ERROR 00950CORN77N88 EXSR SR72 REWRITE INPUT DATA 00960C 93 GOTO NEWITM NEW ITEM 00970C 92 GOTO JUMP FIELD JUMP REQST 00980C 91 GOTO NEXT SKIP FORWARD 00990C 89 F SUB 1 F SKIP BACKWARD 01000C 89 GOTO READ " " ÐÐ01010C 88 SETOF 90 SPACE FILL 01020C 88 SETON 77 " " 01030C 87 GOTO START 01040C 86 GOTO UPDATE UPDATE 01050C 85 GOTO READ REPEAT 01060C 96 GOTO ERROR ERROR 01070C N77 07 GOTO PROCES NO DATA INPUT 01080C N77 GOTO NEXT 01090C*------------------------------------------------------------------ 01100C PROCES TAG 01110C* PROCESS INPUT DATA 01120C EXSR SR103 MOVE DATA 01130C*------------------------------------------------------------------- 01140C EDIT TAG 01150C N96 EXSR SR104 EDIT DATA 01160C EXSR SR72 REWRITE DATA 01170C 96 GOTO ERROR ERROR 01180C 06 Z-ADD0 TQTY 01190C 06 Z-ADD0 TITEM 01200C 06 MOVE ' ' DUN,3 01210C 06 MOVE ' ' DUN,4 01220C 06 Z-ADD2 F 01230C GOTO NEXT 01240C*------------------------------------------------------------------ 01250C UPDATE TAG ÐÐ01260C* UPDATE DATA BASE. 01270C EXSR SR105 FINAL EDIT 01280C 96 GOTO ERROR ERROR 01290C EXSR SR106 UPDATE 01300C 96 GOTO ERROR ERROR 01310C GOTO NEWITM 01320C*------------------------------------------------------------------- 01330C JUMP TAG 01340C* SET-UP JUMP TO REQUESTED FIELD 01350C 1 ADD W W 30 01360C W COMP 10 54 01370C 54 Z-ADD318 M 50 96 FLAG ERROR 01380C 54 GOTO ERROR BAD ESC 01390C MOVE ' ' W3A 3 01400C MOVEAA10,W W3A 01410C Z-ADD3 W2N 20 01420C EXIT SUBRAJ R. JUSTIFY 01430C RLABL W2N 01440C RLABL W3A 01450C MOVE W3A F NEW FIELD # 01460C GOTO READ 01470C*-------------------------------------------------------------------- 01480C ERROR TAG 01490C EXSR SR102 VALIDATE FIELD # 01500C EXSR SR89 GET MSG ÐÐ01510C EXSR SR72 PUT MSG/DATA 01520C GOTO READ 01530C*------------------------------------------------------------------ 01540C NEWITM TAG 01550C* SET-UP LINK FOR NEW ITEM 01560C MOVEL'Q002BG' PROG 8 01570C GOTO END 01580C*------------------------------------------------------------------- 01590C MENU TAG 01600C* SET-UP LINK TO MENU 01610C MOVEL'QQBG01' PROG 01620C GOTO END 01630C*-------------------------------------------------------------------- 01640C GOODBY TAG 01650C* LINK TO SIGN-OFF 01660C MOVEL'GOODBY' PROG 01670C GOTO END 01680C*------------------------------------------------------------------- 01690C END TAG 01700C PROG COMP BLK8 54 01710C N54 MOVEL'Q002BG' PROG 01720C EXITFCHAIN LINK TO NEXT PROG 01730C RLABL PROG 01740C******************************************************************** 01750CSR SR1 BEGSR ÐÐ01760C* EDIT TRAN CODE. 01770CSR EXSR SR203 CLASSIFY TRAN. 01780CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 01790CSR ENDSR 01800C********************************************************************* 01810CSR SR4 BEGSR 01820C* EDIT ITEM. 01830CSR TITEM COMP 0 54 01840CSRN54 Z-ADD335 M 96 FLAG ERROR 01850CSRN54 GOTO END4 01860CSR TDATE COMP 99 54 01870CSRN54 GOTO T4A ITEM# INPUT 01880CSR MOVELTDATE W4N 40 01890CSR MOVE TDATE W2N 20 01900CSR MOVELW2N TDATE 01910CSR MOVELW4N MO 20 01920CSR MOVE W4N DAY 20 01930CSR MO SUB 3 MO 54 01940CSRN54 12 ADD MO MO 01950CSRN54 Z-ADD29 DAY 01960CSRN54 W2N SUB 1 W2N 01970CSR MOVELW2N TDATE 01980CSR MOVELMO W4N 01990CSR MOVE DAY W4N 02000CSR MOVE W4N TDATE ÐÐ02010CSR Z-ADD1 X 02020CSR TDATE LOKUPBCD,X 54 54 02030CSRN54 Z-ADD18 X 02040CSR Z-ADDX TITEM 02050CSR GOTO END4 02060C*------------------------------------------------------------- 02070CSR T4A TAG 02080C* T E M P O R A R Y C L U D G E 02090CSR TITEM SUB 3 TITEM 54 02100CSRN54 Z-ADD1 TITEM 02110CSR TITEM COMP 18 54 02120CSR 54 Z-ADD18 TITEM 02130C*.................................................................. 02140CSR END4 ENDSR 02150C********************************************************************** 02160CSR SR7 BEGSR 02170C* EDIT QTY. 02180CSR Z-ADDTITEM X 30 54 02190CSRN54 GOTO END7 02200CSR TQTY ADD BGQ,X BGQ,X 54 02210CSRN54 Z-ADD0 BGQ,X 02220CSR END7 ENDSR 02230C******************************************************************** 02240CSR SR70 BEGSR 02250C* CLEAR SCREEN. ÐÐ02260CSR SETON 70 02270CSR EXCPT CLEAR SCREEN. 02280CSR SETOF 70 02290CSR ENDSR 02300C******************************************************************* 02310CSR SR71 BEGSR 02320C* PUT HEADINGS TO TERMINAL 02330CSR SETON 71 02340CSR EXCPT PUT HEADINGS 02350CSR SETOF 71 02360CSR Z-ADD0 X 30 02370C*------------------------------------------------------------------- 02380CSR T71A TAG 02390CSR 1 ADD X X 02400CSR X COMP 18 54 02410CSR 54 GOTO END71 02420CSR 5 ADD X W3N 30 02430CSR MOVELW3N LINE 02440CSR MOVE '001' LINE 02450CSR SETON 74 02460CSR EXCPT 02470CSR SETOF 74 02480CSR GOTO T71A 02490CSR END71 ENDSR 02500C********************************************************************* ÐÐ02510CSR SR72 BEGSR 02520C* PUT DATA TO TERMINAL 02530CSR TITEM COMP 0 54 02540CSR 54 TITEM COMP 25 5454 02550CSRN54 GOTO T72A 02560CSR 5 ADD TITEM W3N 30 02570CSR MOVELW3N LINE 6 02580CSR MOVE '001' LINE 02590CSR Z-ADDTITEM X 02600CSR SETON 74 02610C*------------------------------------------------------------------- 02620CSR T72A TAG 02630CSR SETON 72 02640CSR EXCPT PUT DATA 02650CSR SETOF 7274 02660CSRN69 GOTO END72 02670CSR MOVEL'005' W6A 6 02680CSR MOVE LOC,F W6A 02690CSR EXITFQXYPOS 02700CSR RLABL W6A 02710CSR EXITFQBELL 02720CSR END72 ENDSR 02730C******************************************************************* 02740CSR SR75 BEGSR 02750C* READ FROM TERMINAL ÐÐ02760CSR SETOF 779096 02770CSR SETOF 939291 02780CSR SETOF 898887 02790CSR SETOF 8685 02800CSR MOVE BIT,6 BUFLGT 2 READ BUFFER LGTH 02810CSR MOVE BLK10 W10A 10 BUFFER 02820CSR EXITFQWREED READ FROM TERMINAL 02830CSR RLABL W10A READ BUFFER 02840CSR RLABL BUFLGT READ BUFFER LGTH 02850CSR MOVEAW10A A10 INPUT DATA ARRAY 02860CSR MOVE BLK10 W10A INIT INPUT ARRAY 02870CSR Z-ADD1 W 30 02880CSR '\' LOKUPA10,W 90 FLAG ESC 02890CSRN90 GOTO T75B NOT ESC 02900CSR 1 ADD W W 02910CSR W COMP 10 54 02920CSR 54 GOTO T75A BAD ESC 02930CSR A10,W COMP 'G' 98 GOODBY 02940CSR A10,W COMP 'E' 94 MENU 02950CSR A10,W COMP 'N' 93 NEW ITEM 02960CSR A10,W COMP 'J' 92 JUMP 02970CSR A10,W COMP 'F' 91 SKIP FRWRD 02980CSR A10,W COMP 'B' 89 SKIP BKWRD 02990CSR A10,W COMP 'S' 88 SPACE FILL 03000CSR A10,W COMP 'H' 87 HOME ÐÐ03010CSR A10,W COMP 'U' 86 UPDATE 03020CSR A10,W COMP 'R' 85 REPEAT 03030CSR 98 03040COR 94 03050COR 93 03060COR 92 03070COR 91 03080COR 89 03090COR 88 03100COR 87 03110COR 86 03120COR 85 GOTO END75 GOOD ESC 03130C*------------------------------------------------------------------ 03140CSR T75A TAG 03150C* FLAG BAD ESC INPUT 03160CSR Z-ADD318 M 96 FLAG ERROR 03170CSR GOTO END75 03180C*-------------------------------------------------------------------- 03190CSR T75B TAG 03200C* MOVE DATA 03210CSR Z-ADD1 W 03220CSR ' ' LOKUPA10,W 77 03230CSR 77 MOVEAA10,W W10A INPUT DATA 03240C*-------------------------------------------------------------------- 03250CSR END75 TAG ÐÐ03260CSR MOVE BLK35 MGTEXT 03270CSR ENDSR 03280C********************************************************************** 03290CSR SR80 BEGSR 03300C* GET BUDGET MAST. 03310CSR SETOF 6061 03320CSR IOSW COMP ' ' 54 03330CSR 54 TKEY COMP BGKEY 54 03340CSR 54 GOTO T80A ALREADY DONE 03350CSR TKEY CHAINBGMAST 60 GET BGMAST 03360CSRN60 BGSTAT COMP 'D' 61 FLAG DELETE 03370CSR MOVE 'A' IOSW 1 03380CSR 60 MOVE 'N' IOSW 03390CSR 61 MOVE 'D' IOSW 03400CSR 60 MOVE TKEY BGKEY NEW ACCOUNT 03410CSR 60 NOT ON FILE 03420COR 61 Z-ADD0 BGQ 03430CSR GOTO END80 03440C*----------------------------------------------------------------- 03450CSR T80A TAG 03460CSR IOSW COMP 'D' 61 03470CSR IOSW COMP 'N' 60 03480CSR END80 ENDSR 03490C********************************************************************** 03500CSR SR81 BEGSR ÐÐ03510C* ADD NEW MASTER TO FILE 03520CSR SETON 81 03530CSR EXCPT ADD MASTER 03540CSR SETOF 81 03550CSR MOVE ' ' BGPRFX 03560CSR Z-ADD0 BGPRIM 03570CSR Z-ADD0 BGDASH 03580CSR MOVE BLK1 BGKEY 03590CSR MOVE ' ' IOSW 03600CSR ENDSR 03610C*********************************************************************** 03620CSR SR82 BEGSR 03630C* REWRITE MASTER 03640CSR SETON 82 03650CSR EXCPT REWRITE MASTER 03660CSR SETOF 82 03670CSR Z-ADD0 BGCPN 03680CSR MOVE ' ' IOSW 03690CSR ENDSR 03700C********************************************************************** 03710CSR SR89 BEGSR 03720C* GET MESSAGE MASTER 03730CSR M CHAINMGFILE 54 03740CSR 54 MOVE BLK35 MGTEXT 03750CSR 54 MOVELM MGTEXT ÐÐ03760CSR 54 MOVE MES,1 MGTEXT 03770CSR ENDSR 03780C*********************************************************************** 03790CSR SR101 BEGSR 03800C* 1-TIME INITIALIZE 03810CSR MOVE BIT,1 NUL 03820CSR EXSR SR70 CLEAR SCREEN. 03830CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03840CSR Z-ADD7 FLIMIT 30 TOTAL NUMB FIELDS 03850CSR MOVE ' ' BLK10 10 03860CSR Z-ADD1 RRN 50 03870CSR RRN CHAINBGCONT H9 03880CSR H9 GOTO END101 03890C* DEFINE WORK FIELDS,ETC. 03900CSR MOVE ' ' BLK35 35 03910CSR MOVE ' ' BLK8 8 03920CSR Z-ADD0 ZERO10 100 03930CSR END101 ENDSR 03940C********************************************************************** 03950CSR SR102 BEGSR 03960C* VALIDATE FIELD NO. 03970CSR F COMP 0 54 03980CSRN54 Z-ADD1 F 03990CSR F COMP FLIMIT 55 04000CSR 55 Z-ADD1 F ÐÐ04010CSR ENDSR 04020C******************************************************************** 04030CSR SR103 BEGSR 04040C* MOVE INPUT DATA 04050CSR EXSR SR201 IDENTIFY-F 04060CSR EXSR SR202 R. JUSTIFY 04070CSR 01 MOVELW10A TTCODE 1 TRAN CODE 04080CSR 02 MOVELW10A TPRFX 2 ACCT PREFIX 04090CSR 03 MOVE W10A TPRIM 60 ACCT PRIME 04100CSR 04 MOVE W10A TDASH 30 ACCT DASH 04110CSR 05 MOVE W10A TITEM 30 BUCKET # 04120CSR 06 MOVE W10A TDATE BUCKET DATE 04130CSR 07 MOVE W10A TQTY 70 04140CSR MOVE ' ' DUN,F EDIT FLAG 04150CSR ENDSR 04160C******************************************************************** 04170CSR SR104 BEGSR 04180C* EDIT INPUT DATA 04190CSR 01 EXSR SR1 04200CSR EXSR SR203 CLASSIFY TRAN 04210CSR 04 EXSR SR4 04220CSR 07 EXSR SR7 04230CSR 96 MOVE ' ' DUN,F EDIT FLAG 04240CSRN96 MOVE 'X' DUN,F 04250CSR ENDSR ÐÐ04260C*********************************************************************** 04270CSR SR105 BEGSR 04280C* FINAL EDIT 04290CSR SETON 79 FINAL EDIT FLAG 04300CSR Z-ADD1 F 96 04310C*-------------------------------------------------------------------- 04320CSR T105A TAG 04330CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04340CSRN54 GOTO END105 04350CSR EXSR SR201 IDENTIFY-F 04360CSR EXSR SR104 EDIT 04370CSRN96 GOTO T105A 04380C*-------------------------------------------------------------------- 04390CSR END105 TAG 04400CSR SETOF 79 04410CSR ENDSR 04420C******************************************************************** 04430CSR SR106 BEGSR 04440C* UPDATE DATA BASE. 04450CSR EXSR SR203 CLASSIFY TRAN 04460CSR 60 GOTO T106A ADD TRAN 04470CSR 61 GOTO T106D CHANGE TRAN 04480CSR 62 GOTO T106F DELETE TRAN 04490C* FLAG BAD TRAN CODE 04500CSR Z-ADD300 M 96 FLAG ERROR ÐÐ04510CSR Z-ADD1 F FIELD # 04520CSR GOTO END106 04530C*------------------------------------------------------------------- 04540CSR T106A TAG 04550C* ADD TRANSACTION 04560CSR EXSR SR80 GET MASTER 04570CSR 96 GOTO END106 ERROR 04580CSR 60 GOTO T106B NOT ON FILE 04590CSR 61 GOTO T106C DELETED MASTER 04600C* FLAG DUPLICATE ADD ERROR 04610CSR Z-ADD301 M 96 FLAG ERROR 04620CSR Z-ADD1 F FIELD # 04630CSR GOTO END106 04640C*--------------------------------------------------------------------- 04650CSR T106B TAG 04660C* ADD-- MAST NOT ON FILE 04670CSRN40 EXSR SR81 ADD NEW MASTER 04680CSR GOTO END106 04690C*--------------------------------------------------------------------- 04700CSR T106C TAG 04710C* ADD-- MAST IS DELETED 04720CSR MOVE 'A' BGSTAT RECORD STATUS 04730CSRN40 EXSR SR82 REWRITE MAST 04740CSR GOTO END106 04750C*---------------------------------------------------------------------- ÐÐ04760CSR T106D TAG 04770C* CHANGE TRANSACTION. 04780CSR EXSR SR80 GET MASTER 04790CSR 96 GOTO END106 ERROR 04800CSRN60N61 GOTO T106E GOT IT 04810C* FLAG NO MASTER ERROR 04820CSR Z-ADD302 M 96 FLAG ERROR 04830CSR Z-ADD1 F FIELD # 04840CSR GOTO END106 04850C*----------------------------------------------------------------------- 04860CSR T106E TAG 04870C* REWRITE MASTER 04880CSR MOVE 'A' BGSTAT RECORD STATUS 04890CSRN40 EXSR SR82 REWRITE MAST 04900CSR GOTO END106 04910C*----------------------------------------------------------------------- 04920CSR T106F TAG 04930C* DELETE TRANSACTION 04940CSR EXSR SR80 GET MASTER 04950CSR 96 GOTO END106 ERROR 04960CSRN60N61 GOTO T106G GOT IT 04970C* FLAG NO MASTER ERROR 04980CSR Z-ADD302 M 96 FLAG ERROR 04990CSR Z-ADD1 F FIELD # 05000CSR GOTO END106 ÐÐ05010C*----------------------------------------------------------------------- 05020CSR T106G TAG 05030C* DELETE MASTER. 05040CSR MOVE 'D' BGSTAT RECORD STATUS 05050CSRN40 EXSR SR82 REWRITE MASTER 05060CSR END106 ENDSR 05070C************************************************************************ 05080CSR SR201 BEGSR 05090C* IDENTIFY FIELD NO. 05100CSR F COMP 1 01 05110CSR F COMP 2 02 05120CSR F COMP 3 03 05130CSR F COMP 4 04 05140CSR ENDSR 05150C********************************************************************** 05160CSR SR202 BEGSR 05170C* RIGHT JUSTIFY 05180CSR F LOKUPNUM 54 05190CSRN54 GOTO END202 NOT NUMERIC FIELD 05200CSR Z-ADD10 W2N 20 05210CSR EXIT SUBRAJ R. JUSTIFY 05220CSR RLABL W2N 05230CSR RLABL W10A 05240CSR END202 ENDSR 05250C*********************************************************************** ÐÐ05260CSR SR203 BEGSR 05270C* CLASSIFY TRAN CODE 05280CSR TTCODE COMP 'A' 60 ADD 05290CSR TTCODE COMP 'C' 61 CHANGE 05300CSR TTCODE COMP 'D' 62 DELETE 05310CSR ENDSR 05320O******************************************************************** 05330OTERM132 E 71 05340O OR 76 05350O BIT,28 1 05360O 8 '8001001' 05370O 81 'INPUT FORECAST' 05380O*------------------------------------------------------------------- 05390O E 71 05400O OR 76 05410O 3 '(1)' 05420O 10 '(2)' 05430O 22 '(3)' 05440O 31 '(4)' 05450O*------------------------------------------------------------------ 05460O E 71 05470O OR 76 05480O 4 'TRAN' 05490O 12 'PREFIX' 05500O 19 'PRIME' ÐÐ05510O 26 'DASH' 05520O 40 'ACCOUNT NAME' 05530O 44 'QUANTITY' 05540O 53 'DATE' 05550O 32 'ITEM' 05560O*------------------------------------------------------------------- 05570O E 71 05580O OR 76 05590O*------------------------------------------------------------------- 05600O E 72 05610O BIT,28 1 05620O 8 '8005001' 05630O TTCODE 11 05640O TPRFX 10 05650O TPRIM Z 20 05660O TDASH Z 25 05670O TITEM Z 31 05680O GLDESC 96 05690O TQTY K 44 05700O TDATE 54 ' - - ' 05710O MGTEXT 132 05720O*------------------------------------------------------------------- 05730O E 74 05740O BIT,28 1 05750O 2 '8' ÐÐ05760O LINE 8 05770O X Z 31 05780O BCD,X 64 ' - - ' 05790O BGQ,X K 43 05800O*------------------------------------------------------------------- 05810O E 70 05820O NUL 132 05830O BIT,13 1 05840O******************************************************************** 05850OBGMAST EADD 81 05860O TKEY 13 05870O BGQ 153P 05880O 160 'A' 05890O*------------------------------------------------------------------ 05900O E 82 05910O BGQ 153P 05920O BGSTAT 160 ** NUL ARRAY 005930 005940** A10 ARRAY 005950 005960** NUM ARRAY 005970003 PRIME 005980004 DASH 005990005 ITEM 006000ÐÐ006 DATE 006010007 QTY 006020** DUN ARRAY 006030 006040** MES ARRAY 006050---MESSAGE NOT ON FILE--- 006060** LOC ARRAY 006070002 1 TRAN CODE 006080009 2 PREFIX 006090019 3 PRIME 006100023 4 DASH 006110029 5 ITEM 006120035 6 DATE 006130047 7 QTY 006140/* 006150_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(   NX002BJ P120282120282(èÈÐ00010H Q002BJ00020F* UPDATE BJMAST FILE. (X002BJ) 00030F* REVISED 7/09/81 12:15 PM. 00040F* SYSTEM DESCRIPTION: 00050F* 1. ESTABLISHES MENU FOR EACH DEPT TO REQUEST 00060F* BATCH JOBS, REPORTS. 00070F* 2. PLACES JOBS SELECTED VIA MENU IN JOB QUEUE 00080F* EXECUTED LATER BY E.D.P. 00090F* DATABASE: 00100F* BJMAST BATCH MASTER. ONE MASTER FOR EACH 00110F* BATCH JOB IN THE SYSTEM. 00120F* UJMAST USER MASTER (DEPT,JOB). SETS-UP JOB 00130F* ON DEPT MENU. ALT KEY IS UJKEY (JOB,DEPT). 00140F* JQMAST JOB QUEUE MAST. PLACED ON FILE EACH 00150F* TIME A MENU ITEM IS SELECTED TO BE RUN. 00160F* KEY IS JOB # (SEE JQCONT). 00170F* ALT KEYS SHOWN BELOW: 00180F* JQDEVICE JOBS IN QUEUE FOR EACH OUTPUT DEVICE. 00190F* JQDEPT JOBS ON QUEUE FOR EACH DEPT. 00200F* JQJOB JOBS ON QUEUE BY JOB NAME. 00210F* JQCONT CONTROL COUNTER INCREMENTED BY ONE 00220F* TO ASSIGN JOB # (JQMAST) WHEN MENU 00230F* ITEM SELECTED BY DEPT. 00240FBITHEX IP F 256 DISK 00250FMGFILE IC F 80R DISK ÐÐ00260FBJMAST UC F 106R 6AI 1 DISK A 00270FUJKEY ID F 12L11AI 1 DISK 00280FTERM132 O F 132 5 00290F**************************************************************** 00300E NUL 1 132 1 NULL CHAR 00310E A6 6 6 1 CALL READ PARAM. 00320E A40 40 40 1 A INPUT DATA ARRAY 00330E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00340E DUN 14 14 1 A EDIT CMPLT FLAG 00350E MES 1 1 30 00360E CRD 6 6 4 A 00370E LOC 1 14 3 0 00380E DASH 1 1 10 00390E BIT 256 1 SCREEN CONTR. CHAR 00400E CALL 5 6 CALL STACK 00410E BJD 6 4 REPORT DISTR. 00420I******************************************************************* 00430IBITHEX BT 00440I 1 256 BIT 00450I******************************************************************* 00460IMGFILE MG 00470I* MESSAGE FILE. 00480I 1 35 MGTEXT 00490I******************************************************************** 00500IBJMAST BJ ÐÐ00510I* BATCH JOB MAST. 00520I* JOB NAME 6A 00530I 1 6 BJNAME 00540I* DESCRIPTION 40A 00550I 7 46 BJDESC 00560I* PRINTER 1A 00570I* D = DIABLO 00580I* S = SYST PRINTER 00590I* T = DATAGRAPHIX 00600I* C = CONSOLE 00610I 47 47 BJPRTR 00620I* PAPER 25A 00630I 48 72 BJPAP 00640I* COPIES 1N 00650I 73 730BJCOPY 00660I* DISTRIBUTION 00670I* 4A X 6 00680I 74 97 BJD 00690I* UPDATE CODE 1A 00700I* Y = SHARABLE 00710I* N = NOT SHARABLE 00720I* BLK = NO DISK UPDATE 00730I 98 98 BJUPD 00740I* TYPE CODE 1A 00750I* P = PROGRAM (MAINLINE OR CALLED BY PROC) ÐÐ00760I* U = UTILITY (ONLY) 00770I* Z = JOB STREAM 00780I* M = MENU 00790I* C = CALLED PROGRAM 00800I 99 99 BJTYPE 00810I* RECORD STATUS 1A 00820I 106 106 BJSTAT 00830I******************************************************************** 00840IUJKEY JU 00850I* UJMAST ALT-KEY FILE. 00860I* JOB NAME 6A 00870I 1 6 UJNAME 00880I* DEPT 5N 00890I 7 110UJDEPT 00900I* RECORD STATUS 1A 00910I 12 12 UJSTAT 00920C******************************************************************** 00930C* INITIALIZE 00940C EXSR SR101 1-TIME INIT 00950C H9 GOTO ENDJOB 00960C EXSR SR71 PUT HEADINGS. 00970C*------------------------------------------------------------------ 00980C START TAG 00990C* SET-UP 1ST FIELD NO. 01000C MOVE ' ' DUN EDIT ARRAY ÐÐ01010C Z-ADD1 F 30 FIELD # 01020C EXSR SR109 INIT TRAN DATA 01030C EXITFQCLFCR LF/CR 01040C 1 ADD LINENO LINENO 30 01050C LINENO COMP 28 54 01060C 54 EXSR SR71 01070C GOTO READ 01080C*------------------------------------------------------------------ 01090C NEXT TAG 01100C* SET-UP NEXT FIELD NO. 01110C 1 ADD F F FIELD # 01120C*----------------------------------------------------------------- 01130C READ TAG 01140C* READ DATA FROM TERMINAL. 01150C SETOF 9096 01160C SETOF 9096 01170C EXSR SR102 VALIDATE FIELD # 01180C 55 GOTO UPDATE DONE 01190C EXSR SR203 CLASSIFY TRAN 01200C 62 F COMP 2 54 01210C 62 54 GOTO UPDATE DELETE BYPASS 01220C EXSR SR201 IDENTIFY-F 01230C SETON 69 01240C EXSR SR72 PROMPT 01250C SETOF 69 ÐÐ01260C EXSR SR75 READ TERMINAL 01270C 98 GOTO GOODBY GOODBY 01280C 94 GOTO MENU MENU REQUEST 01290C N77N88 EXSR SR104 EDIT INPUT FIELD 01300C 96 ERROR 01310CORN77N88 EXSR SR72 REWRITE INPUT DATA 01320C 93 GOTO NEWITM NEW ITEM 01330C 92 GOTO JUMP FIELD JUMP REQST 01340C 91 GOTO NEXT SKIP FORWARD 01350C 89 F SUB 1 F SKIP BACKWARD 01360C 89 GOTO READ " " 01370C 88 SETOF 90 SPACE FILL 01380C 88 SETON 77 " " 01390C 87 GOTO START 01400C 86 GOTO UPDATE UPDATE 01410C 85 GOTO READ REPEAT 01420C 96 GOTO ERROR ERROR 01430C N77 GOTO NEXT NO DATA INPUT 01440C*------------------------------------------------------------------ 01450C PROCES TAG 01460C* PROCESS INPUT DATA 01470C EXSR SR103 MOVE DATA 01480C N96 EXSR SR104 EDIT DATA 01490C EXSR SR72 REWRITE DATA 01500C 96 GOTO ERROR ERROR ÐÐ01510C GOTO NEXT 01520C*------------------------------------------------------------------ 01530C UPDATE TAG 01540C* UPDATE DATA BASE. 01550C EXSR SR105 FINAL EDIT 01560C 96 GOTO ERROR ERROR 01570C EXSR SR106 UPDATE 01580C 96 GOTO ERROR ERROR 01590C GOTO START 01600C*------------------------------------------------------------------- 01610C JUMP TAG 01620C* SET-UP JUMP TO REQUESTED FIELD 01630C 1 ADD W W 30 01640C W COMP 40 54 01650C 54 Z-ADD318 M 50 96 FLAG ERROR 01660C 54 GOTO ERROR BAD ESC 01670C MOVE '000' W3A 3 01680C MOVEAA40,W W3A 01690C Z-ADD3 W2N 20 01700C EXIT SUBRAJ R. JUSTIFY 01710C RLABL W2N 01720C RLABL W3A 01730C MOVE W3A F NEW FIELD # 01740C GOTO READ 01750C*-------------------------------------------------------------------- ÐÐ01760C ERROR TAG 01770C EXSR SR102 VALIDATE FIELD # 01780C EXSR SR89 GET MSG 01790C EXSR SR73 PUT MSG 01800C GOTO READ 01810C*------------------------------------------------------------------ 01820C NEWITM TAG 01830C* SET-UP LINK FOR NEW ITEM 01840C MOVEL'Q002BJ' PROG 8 01850C GOTO END 01860C*------------------------------------------------------------------- 01870C MENU TAG 01880C* SET-UP LINK TO MENU 01890C MOVEL'QQDP01' PROG 01900C GOTO END 01910C*-------------------------------------------------------------------- 01920C GOODBY TAG 01930C* LINK TO SIGN-OFF 01940C MOVEL'GOODBY' PROG 01950C GOTO END 01960C*------------------------------------------------------------------- 01970C END TAG 01980C EXITFCHAIN LINK TO NEXT PROG 01990C RLABL PROG 02000C*------------------------------------------------------------------- ÐÐ02010C ENDJOB TAG 02020C********************************************************************* 02030CSR SR1 BEGSR 02040C* EDIT TRAN CODE. 02050CSR EXSR SR203 CLASSIFY TRAN. 02060CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 02070CSR ENDSR 02080C******************************************************************* 02090CSR SR2 BEGSR 02100C* EDIT JOB NAME. 02110CSR CRNAME COMP BLK6 54 02120CSRN54 Z-ADD224 M 96 02130CSRN54 GOTO END2 02140CSR EXSR SR80 GET BJMAST. 02150CSR 61 02160COR 60 GOTO T2A NOT ON FILE. 02170CSR EXSR SR108 MOVE BJ DATA. 02180CSR EXSR SR203 CLASSIFY TRAN. 02190CSR 60 Z-ADD301 M 96 FLAG ERROR. 02200CSR GOTO END2 02210C*------------------------------------------------------------------- 02220CSR T2A TAG 02230CSR EXSR SR203 CLASSIFY TRAN. 02240CSRN60 Z-ADD302 M 96 FLAG ERROR. 02250CSR END2 ENDSR ÐÐ02260C********************************************************************* 02270CSR SR3 BEGSR 02280C* EDIT DESCRIPTION. 02290CSR CRDESC COMP BLK40 54 02300CSRN54 Z-ADD310 M 96 FLAG ERROR. 02310CSR ENDSR 02320C********************************************************************** 02330CSR SR4 BEGSR 02340C* EDIT PRINTER CODE. 02350CSR CRPRTR COMP ' ' 54 02360CSRN54 CRPRTR COMP 'D' 54 DIABLO 02370CSRN54 CRPRTR COMP 'S' 54 SYST PRTR 02380CSRN54 CRPRTR COMP 'T' 54 TERMINAL 02390CSRN54 CRPRTR COMP 'C' 54 CONSOLE 02400CSRN54 Z-ADD240 M 96 FLAG ERROR. 02410CSR ENDSR 02420C*********************************************************************** 02430CSR SR5 BEGSR 02440C* EDIT PAPER DESCRIPTION. 02450CSR CRPRTR COMP 'S' 54 02460CSRN54 CRPRTR COMP 'D' 54 02470CSR CRPAP COMP ' ' 55 02480CSR 54N55 02490COR 55N54 Z-ADD229 M 96 FLAG ERROR. 02500CSR END5 ENDSR ÐÐ02510C******************************************************************* 02520CSR SR6 BEGSR 02530C* EDIT NUMBER OF COPIES. 02540CSR CRCOPY COMP 0 54 COPIES. 02550CSR CRPAP COMP ' ' 55 PAPER. 02560CSR 54N55 02570CORN54 55 Z-ADD230 M 96 FLAG ERROR. 02580CSR ENDSR 02590C******************************************************************* 02600CSR SR14 BEGSR 02610C* EDIT TYPE CODE. 02620CSR CRTYPE COMP 'P' 54 PROGRAM. 02630CSRN54 CRTYPE COMP 'U' 54 UTILITY. 02640CSRN54 CRTYPE COMP 'Z' 54 JOB STREAM. 02650CSRN54 CRTYPE COMP 'M' 54 MENU PROG. 02660CSRN54 Z-ADD76 M 96 FLAG ERROR. 02670CSR ENDSR 02680C************************************************************** 02690CSR SR50 BEGSR 02700C* GENERAL EDIT 02710CSR ' ' LOKUPCRD 55 DISTRIBUTION 02720CSR CRCOPY COMP 0 56 NUMB OF COPIES 02730CSR CRPAP COMP BLK25 57 KIND OF PAPER 02740CSR 55N56 02750COR 55N56N57 Z-ADD229 M 96 FLAG ERROR ÐÐ02760CSR ENDSR 02770C********************************************************************** 02780CSR SR71 BEGSR 02790C* PUT HEADINGS TO TERMINAL 02800CSR SETON 71 02810CSR EXCPT PUT HEADINGS 02820CSR SETOF 71 02830CSR Z-ADD3 LINENO 02840CSR ENDSR 02850C********************************************************************* 02860CSR SR72 BEGSR 02870C* PUT DATA TO TERMINAL 02880CSR EXITFQMOVUP MOVE CURSOR. 02890CSR SETON 72 02900CSR EXCPT PUT DATA 02910CSR SETOF 72 02920CSRN69 GOTO END72 NOT PROMPT 02930CSR 1 ADD LOC,F X 30 02940CSR MOVE BIT,X W2A 2 02950CSR MOVELBIT,1 W2A 02960CSR EXITFQCCR MOVE CURSOR. 02970CSR EXITFQMOVR MOVE CURSOR. 02980CSR RLABL W2A 02990CSR EXITFQBELL RING BELL. 03000CSR END72 ENDSR ÐÐ03010C*********************************************************************** 03020CSR SR73 BEGSR 03030C* PUT ERROR MESSAGE TO TERMINAL 03040CSR SETON 73 03050CSR EXCPT PUT MSG 03060CSR SETOF 73 03070CSR Z-ADDM LSTERR 50 03080CSR EXITFQMOVUP MOVE CURSOR. 03090CSR ENDSR 03100C******************************************************************* 03110CSR SR75 BEGSR 03120C* READ FROM TERMINAL 03130CSR SETOF 779096 03140CSR SETOF 939291 03150CSR SETOF 898887 03160CSR SETOF 8685 03170CSR MOVE BIT,21 A6,2 BUF LENGTH 03180CSR MOVEAA6 W6A 6 03190CSR MOVE BLK40 W40A 40 BUFFER 03200CSR EXITFQWREED READ TERM 03210CSR RLABL W40A 03220CSR RLABL W6A 03230CSR MOVEAW40A A40 03240CSR MOVE BLK40 W40A 03250CSR Z-ADD1 W 30 ÐÐ03260CSR '\' LOKUPA40,W 90 FLAG ESC 03270CSRN90 GOTO T75B NOT ESC 03280CSR 1 ADD W W 03290CSR W COMP 40 54 03300CSR 54 GOTO T75A BAD ESC 03310CSR A40,W COMP 'G' 98 GOODBY 03320CSR A40,W COMP 'E' 94 MENU 03330CSR A40,W COMP 'N' 93 NEW ITEM 03340CSR A40,W COMP 'J' 92 JUMP 03350CSR A40,W COMP 'F' 91 SKIP FRWRD 03360CSR A40,W COMP 'B' 89 SKIP BKWRD 03370CSR A40,W COMP 'S' 88 SPACE FILL 03380CSR A40,W COMP 'H' 87 HOME 03390CSR A40,W COMP 'U' 86 UPDATE 03400CSR A40,W COMP 'R' 85 REPEAT 03410CSR 98 03420COR 94 03430COR 93 03440COR 92 03450COR 91 03460COR 89 03470COR 88 03480COR 87 03490COR 86 03500COR 85 GOTO END75 GOOD ESC ÐÐ03510C*------------------------------------------------------------------ 03520CSR T75A TAG 03530C* FLAG BAD ESC INPUT 03540CSR Z-ADD318 M 96 FLAG ERROR 03550CSR GOTO END75 03560C*-------------------------------------------------------------------- 03570CSR T75B TAG 03580C* MOVE DATA 03590CSR Z-ADD1 W 03600CSR ' ' LOKUPA40,W 77 03610CSR 77 MOVEAA40,W W40A INPUT DATA 03620C*-------------------------------------------------------------------- 03630CSR END75 TAG 03640C* INIT PREV ERROR MSG. 03650CSR LSTERR COMP 0 54 03660CSR 54 MOVE BLK35 MGTEXT 03670CSR 54 EXSR SR73 BLANK MESSAGE 03680CSR Z-ADD0 LSTERR 50 03690CSR ENDSR 03700C********************************************************************** 03710CSR SR80 BEGSR 03720C* GET MASTER RECORD 03730CSR SETOF 61 03740CSR CRNAME CHAINBJMAST 60 GET MASTER 03750CSRN60 BJSTAT COMP 'D' 61 FLAG DELETE ÐÐ03760CSR ENDSR 03770C********************************************************************** 03780CSR SR81 BEGSR 03790C* ADD NEW MASTER TO FILE 03800CSR SETON 81 03810CSR EXCPT ADD MASTER 03820CSR SETOF 81 03830CSR ENDSR 03840C*********************************************************************** 03850CSR SR82 BEGSR 03860C* REWRITE MASTER 03870CSR SETON 82 03880CSR EXCPT REWRITE MASTER 03890CSR SETOF 82 03900CSR ENDSR 03910C********************************************************************** 03920CSR SR89 BEGSR 03930C* GET MESSAGE MASTER 03940CSR M CHAINMGFILE 54 03950CSR 54 MOVE BLK35 MGTEXT 03960CSR 54 MOVELM MGTEXT 03970CSR 54 MOVE MES,1 MGTEXT 03980CSR ENDSR 03990C*********************************************************************** 04000CSR SR101 BEGSR ÐÐ04010C* 1-TIME INITIALIZE 04020CSR MOVE BIT,1 NUL 04030CSR MOVE BIT,1 A6 04040CSR Z-ADD14 FLIMIT 30 TOTAL NUMB FIELDS 04050CSR MOVE ' ' BLK40 40 04060C* DEFINE WORK FIELDS,ETC. 04070CSR MOVE ' ' BLK35 35 04080CSR MOVE ' ' BLK6 6 04090CSR MOVE ' ' BLK4 4 04100CSR MOVE ' ' BLK25 25 04110CSR ENDSR 04120C********************************************************************** 04130CSR SR102 BEGSR 04140C* VALIDATE FIELD NO. 04150CSR F COMP 0 54 04160CSRN54 Z-ADD1 F 04170CSR F COMP FLIMIT 55 04180CSR 55 Z-ADD1 F 04190CSR ENDSR 04200C******************************************************************** 04210CSR SR103 BEGSR 04220C* MOVE INPUT DATA 04230CSR EXSR SR201 IDENTIFY-F 04240CSR EXSR SR202 R. JUSTIFY 04250CSR 01 MOVELW40A CRTRAN 1 TRAN CODE. ÐÐ04260CSR 02 MOVELW40A CRNAME 6 JOB NAME. 04270CSR 03 MOVELW40A CRDESC 40 DESCRIPTION. 04280CSR 04 MOVELW40A CRPRTR 1 PRINTER. 04290CSR 05 MOVELW40A CRPAP 25 PAPER. 04300CSR 06 MOVE W15A CRCOPY 10 NO. COPIES. 04310CSR 07 MOVELW40A CRD,1 DISTR-1. 04320CSR 08 MOVELW40A CRD,2 DISTR-2. 04330CSR 09 MOVELW40A CRD,3 DISTR-3. 04340CSR 10 MOVELW40A CRD,4 DISTR-4. 04350CSR 11 MOVELW40A CRD,5 DISTR-5. 04360CSR 12 MOVELW40A CRD,6 DISTR-6. 04370CSR 13 MOVELW40A CRUPD 1 UPDATE CODE. 04380CSR 14 MOVELW40A CRTYPE 1 TYPE CODE. 04390CSR MOVE ' ' DUN,F EDIT FLAG 04400CSR ENDSR 04410C******************************************************************** 04420CSR SR104 BEGSR 04430C* EDIT INPUT DATA 04440CSR 01 EXSR SR1 04450CSR 02 EXSR SR2 04460CSR 03 EXSR SR3 04470CSR 04 EXSR SR4 04480CSR 05 EXSR SR5 04490CSR 06 EXSR SR6 04500CSR 14 EXSR SR14 ÐÐ04510CSR 96 MOVE ' ' DUN,F EDIT FLAG 04520CSRN96 MOVE 'X' DUN,F 04530CSR ENDSR 04540C*********************************************************************** 04550CSR SR105 BEGSR 04560C* FINAL EDIT 04570CSR SETON 79 FINAL EDIT FLAG 04580CSR Z-ADD1 F 96 04590C*-------------------------------------------------------------------- 04600CSR T105A TAG 04610CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04620CSRN54 GOTO END105 04630CSR EXSR SR201 IDENTIFY-F 04640CSR EXSR SR104 EDIT 04650CSRN96 GOTO T105A 04660C*-------------------------------------------------------------------- 04670CSR END105 TAG 04680CSR EXSR SR50 GENERAL EDIT 04690CSR SETOF 79 04700CSR ENDSR 04710C******************************************************************** 04720CSR SR106 BEGSR 04730C* UPDATE DATA BASE. 04740CSR EXSR SR203 CLASSIFY TRAN 04750CSR 60 GOTO T106A ADD TRAN ÐÐ04760CSR 61 GOTO T106D CHANGE TRAN 04770CSR 62 GOTO T106F DELETE TRAN 04780C* FLAG BAD TRAN CODE 04790CSR Z-ADD300 M 96 FLAG ERROR 04800CSR Z-ADD1 F FIELD # 04810CSR GOTO END106 04820C*------------------------------------------------------------------- 04830CSR T106A TAG 04840C* ADD TRANSACTION 04850CSR EXSR SR80 GET MASTER 04860CSR 60 GOTO T106B NOT ON FILE 04870CSR 61 GOTO T106C DELETED MASTER 04880C* FLAG DUPLICATE ADD ERROR 04890CSR Z-ADD301 M 96 FLAG ERROR 04900CSR Z-ADD1 F FIELD # 04910CSR GOTO END106 04920C*--------------------------------------------------------------------- 04930CSR T106B TAG 04940C* ADD-- MAST NOT ON FILE 04950CSR EXSR SR81 ADD NEW MASTER 04960CSR GOTO END106 04970C*--------------------------------------------------------------------- 04980CSR T106C TAG 04990C* ADD-- MAST IS DELETED 05000CSR MOVE 'A' BJSTAT RECORD STATUS ÐÐ05010CSR EXSR SR82 REWRITE MAST 05020CSR GOTO END106 05030C*---------------------------------------------------------------------- 05040CSR T106D TAG 05050C* CHANGE TRANSACTION. 05060CSR EXSR SR80 GET MASTER 05070CSRN60N61 GOTO T106E GOT IT 05080C* FLAG NO MASTER ERROR 05090CSR Z-ADD302 M 96 FLAG ERROR 05100CSR Z-ADD1 F FIELD # 05110CSR GOTO END106 05120C*----------------------------------------------------------------------- 05130CSR T106E TAG 05140C* REWRITE MASTER 05150CSR EXSR SR82 REWRITE MAST 05160CSR GOTO END106 05170C*----------------------------------------------------------------------- 05180CSR T106F TAG 05190C* DELETE TRANSACTION 05200CSR EXSR SR80 GET MASTER 05210CSRN60N61 GOTO T106G GOT IT 05220C* FLAG NO MASTER ERROR 05230CSR Z-ADD302 M 96 FLAG ERROR 05240CSR Z-ADD1 F FIELD # 05250CSR GOTO END106 ÐÐ05260C*----------------------------------------------------------------------- 05270CSR T106G TAG 05280C* DELETE MASTER. 05290CSR EXSR SR204 CHECK FOR ACTIVITY 05300CSR 96 Z-ADD1 F FIELD # 05310CSR 96 GOTO END106 ERROR 05320CSR MOVE 'D' BJSTAT RECORD STATUS 05330CSR EXSR SR82 REWRITE MASTER 05340CSR END106 ENDSR 05350C******************************************************************** 05360CSR SR108 BEGSR 05370C* MOVE MAST TO TRAN FIELDS. 05380CSR CRDESC COMP BLK40 54 05390CSRN54 MOVE BJDESC CRDESC 05400CSR CRPRTR COMP ' ' 54 05410CSRN54 MOVE BJPRTR CRPRTR 05420CSR CRPAP COMP ' ' 54 05430CSRN54 MOVE BJPAP CRPAP 05440CSR CRCOPY COMP 0 54 05450CSRN54 MOVE BJCOPY CRCOPY 05460CSR CRD,1 COMP BLK4 54 05470CSRN54 MOVE BJD,1 CRD,1 05480CSR CRD,2 COMP BLK4 54 05490CSRN54 MOVE BJD,2 CRD,2 05500CSR CRD,3 COMP BLK4 54 ÐÐ05510CSRN54 MOVE BJD,3 CRD,3 05520CSR CRD,4 COMP BLK4 54 05530CSRN54 MOVE BJD,4 CRD,4 05540CSR CRD,5 COMP BLK4 54 05550CSRN54 MOVE BJD,5 CRD,5 05560CSR CRD,6 COMP BLK4 54 05570CSRN54 MOVE BJD,6 CRD,6 05580CSR CRUPD COMP BLK4 54 05590CSRN54 MOVE BJUPD CRUPD 05600CSR CRTYPE COMP BLK4 54 05610CSRN54 MOVE BJTYPE CRTYPE 05620CSR ENDSR 05630C******************************************************************** 05640CSR SR109 BEGSR 05650C* INIT TRAN DATA. 05660CSR MOVE ' ' CRTRAN TRAN CODE. 05670CSR MOVE BLK40 CRDESC DESCR. 05680CSR MOVE BLK6 CRNAME JOB NAME 05690CSR MOVE ' ' CRPRTR PRINTER. 05700CSR MOVE BLK25 CRPAP PAPER 05710CSR Z-ADD0 CRCOPY NO. COPIES. 05720CSR MOVE ' ' CRD DISTR. 05730CSR MOVE ' ' CRUPD UPDATE CODE 05740CSR MOVE ' ' CRTYPE TYPE CODE. 05750CSR ENDSR ÐÐ05760C******************************************************************** 05770CSR SR201 BEGSR 05780C* IDENTIFY FIELD NO. 05790CSR F COMP 1 01 05800CSR F COMP 2 02 05810CSR F COMP 3 03 05820CSR F COMP 4 04 05830CSR F COMP 5 05 05840CSR F COMP 6 06 05850CSR F COMP 7 07 05860CSR F COMP 8 08 05870CSR F COMP 9 09 05880CSR F COMP 10 10 05890CSR F COMP 11 11 05900CSR F COMP 12 12 05910CSR F COMP 13 13 05920CSR F COMP 14 14 05930CSR ENDSR 05940C********************************************************************** 05950CSR SR202 BEGSR 05960C* RIGHT JUSTIFY 05970CSR F LOKUPNUM 54 05980CSRN54 GOTO END202 NOT NUMERIC FIELD 05990CSR Z-ADD15 W2N 20 06000CSR MOVELW40A W15A 15 ÐÐ06010CSR EXIT SUBRAJ R. JUSTIFY 06020CSR RLABL W2N 06030CSR RLABL W15A 06040CSR END202 ENDSR 06050C*********************************************************************** 06060CSR SR203 BEGSR 06070C* CLASSIFY TRAN CODE 06080CSR CRTRAN COMP 'A' 60 ADD 06090CSR CRTRAN COMP 'C' 61 CHANGE 06100CSR CRTRAN COMP 'D' 62 DELETE 06110CSR ENDSR 06120C**************************************************************************06130CSR SR204 BEGSR 06140C* CHECK ACTIVITY. 06150CSR MOVE ' ' W11A 06160CSR MOVELCRNAME W11A 11 06170CSR W11A SETLLUJKEY 06180C*------------------------------------------------------------------- 06190CSR T204A TAG 06200CSR SETOF 54 06210CSR READ UJKEY 54 06220CSR 54 GOTO END204 06230CSR CRNAME COMP UJNAME 54 06240CSRN54 GOTO END204 06250CSR UJSTAT COMP 'D' 54 ÐÐ06260CSR 54 GOTO T204A 06270CSR UJNAME COMP CRNAME 55 06280CSR 55 Z-ADD29 M 96 FLAG ERROR. 06290CSR END204 ENDSR 06300O******************************************************************** 06310OTERM132 E 71 06320O* PUT HEADINGS 06330O*------------------------------------------------------------------- 06340O E 71 06350O* PUT HEADINGS. 06360O 1 'T' 06370O 7 'NAME' 06380O DASH,1 21 06390O DASH,1 31 06400O DASH,1 41 06410O DASH,1 51 06420O 22 'DESCRIPTION' 06430O 55 'PRT' 06440O DASH,1 67 06450O DASH,1 77 06460O DASH,1 82 06470O 62 'PAPER' 06480O 86 'COP' 06490O 91 'D-1' 06500O 97 'D-2' ÐÐ06510O 103 'D-3' 06520O 109 'D-4' 06530O 115 'D-5' 06540O 121 'D-6' 06550O 125 'UPD' 06560O 132 'TYPE' 06570O*------------------------------------------------------------- 06580O E 71 06590O 1 '1' 06600O 5 '2' 06610O 12 '3' 06620O 54 '4' 06630O 59 '5' 06640O 85 '6' 06650O 90 '7' 06660O 96 '8' 06670O 102 '9' 06680O 108 '10' 06690O 114 '11' 06700O 120 '12' 06710O 125 '13' 06720O 131 '14' 06730O*------------------------------------------------------------------ 06740O E 71 06750O*------------------------------------------------------------------- ÐÐ06760O E 72 06770O* PUT DATA. 06780O CRTRAN 1 06790O CRNAME 9 06800O CRDESC 51 06810O CRPRTR 54 06820O CRPAP 82 06830O CRCOPYZ 85 06840O CRD,1 92 06850O CRD,2 98 06860O CRD,3 104 06870O CRD,4 110 06880O CRD,5 116 06890O CRD,6 122 06900O CRUPD 125 06910O CRTYPE 130 06920O*------------------------------------------------------------------- 06930O E 73 06940O* PUT MESSAGE. 06950O NUL 132 06960O MGTEXT 35 06970O 37 ' ' 06980O******************************************************************** 06990OBJMAST EADD 81 07000O CRNAME 6 ÐÐ07010O CRDESC 46 07020O CRPRTR 47 07030O CRPAP 72 07040O CRCOPY 73 07050O CRD 97 07060O CRUPD 98 07070O CRTYPE 99 07080O 106 'A' 07090O*------------------------------------------------------------------- 07100O E 82 07110O CRDESC 46 07120O CRPRTR 47 07130O CRPAP 72 07140O CRCOPY 73 07150O CRD 97 07160O CRUPD 98 07170O CRTYPE 99 07180O BJSTAT 106 ** NUL ARRAY 007190 007200** A6 ARRAY 007210 007220** A40 ARRAY 007230 007240** NUM ARRAY 007250ÐÐ006 007260** DUN ARRAY 007270 007280** MES ARRAY 007290---MESSAGE NOT ON FILE--- 007300** CRD ARRAY 007310 007320** LOC ARRAY 007330001 1 CRTRAN 07340004 2 NAME 07350012 3 DESCRIPTION 07360054 4 PRINTER 07370058 5 PAPER 07380085 6 COPIES 07390089 7 DISTR-1 07400095 8 DISTR-2 07410101 9 DISTR-3 07420107 10 DISTR-4 07430113 11 DISTR-5 07440119 12 DISTR-6 07450125 13 UPDATE 07460130 14 TYPE 07470** DASH ARRAY 007480---------- 007490/* 07500ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(áV á^XQDP01 P120282120282(èÈÐ00010H QQDP0100020F* EDP MENU DISPLAY/SELECT PROGRAM. (XQDP01) 00030F* REVISED 1/15/82 4:35 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMQDP01 IS F 80 DISK 00070FCRTFILE UC F 256R DISK 00080FTERM50 O F 50 5 00090E******************************************************************** 00100E NUL 1 50 1 00110E PRG 1 75 6 00120E A6 1 6 1 00130E A4 1 4 1 A 00140E BIT 33 1 00150I******************************************************************** 00160IBITTAB BT 01 00170I 1 33 BIT 00180I******************************************************************** 00190IMQDP01 MU 02 00200I* MENU FILE 00210I 1 35 MTEXT 00220I 58 600MSEQ 00230I 65 70 MPROG 70 00240I 76 800MLINE 00250I********************************************************************* ÐÐ00260ICRTFILE CR 00270I 19 26 CRJOB 00280I 27 27 CRSHUT 00290I 28 330CRTIMI 00300C******************************************************************** 00310C* BYPASS BITTAB. 00320C 01 EXSR SR101 GET CRTFILE 00330C 86 GOTO ENDJOB SHUT DOWN 00340C 01 GOTO END 00350C* BYPASS END OF FILE. 00360C MOVELMTEXT W2A 2 00370C W2A COMP '/*' 54 00380C 54 SETON LR 00390C 54 GOTO END 00400C Z-ADDMSEQ X 30 00410C X COMP 75 54 00420C 54 SETOF 02 00430C 54 SETON LR 00440C 54 GOTO END 00450C 70 GOTO CONTU 00460C MOVE MPROG PRG,X 00470C*------------------------------------------------------------------ 00480C CONTU TAG 00490C MLINE COMP 1 54 00500C MLINE COMP 26 55 ÐÐ00510C MLINE COMP 51 56 00520C 54 00530COR 55 00540COR 56 Z-ADD2 LN 30 00550C 54 Z-ADD1 CN 30 00560C 55 Z-ADD44 CN 00570C 56 Z-ADD90 CN 00580C 1 ADD LN LN 00590C MOVE CN CA 3 00600C MOVE LN LA 3 00610C*------------------------------------------------------------------- 00620C END TAG 00630C 02N84 EXITFQTOPF CLEAR SCREEN. 00640C 02 SETON 85 00650CL0 85 SETON 84 00660C*------------------------------------------------------------------- 00670CLR MOVE ' ' BLK8 8 00680CLR START TAG 00690CLR SETON 82 00700CLR EXCPT 00710CLR SETOF 82 00720CLR MOVE BIT,1 A6 00730CLR MOVE BIT,3 A6,2 00740CLR MOVEAA6 W6A 6 00750CLR MOVE ' ' W4A 4 ÐÐ00760CLR EXITFXCREAD 00770CLR RLABL W4A 00780CLR RLABL W6A 00790CLR Z-ADD4 W2N 20 00800CLR MOVEAW4A A4 00810CLR '\' LOKUPA4 94 00820CLR '\' LOKUPA4 90 00830CLR 90 'E' LOKUPA4 94 00840CLR 90 'G' LOKUPA4 98 00850CLR 90 'M' LOKUPA4 93 00860CLR 98 MOVEL'GOODBY' PROG 00870CLR 93 MOVEL'CONTU' PROG 00880CLR 90N93 00890CANN98 SETON 94 00900CLR 94 MOVE BLK8 PROG 00910CLR 94 MOVEL'CONTU' PROG 00920CLR 90 GOTO ENDJOB 00930CLR EXIT SUBRAJ 00940CLR RLABL W2N 00950CLR RLABL W4A 00960CLR MOVE W4A W3N 30 00970CLR W3N COMP 0 54 00980CLR W3N COMP 75 55 00990CLRN54 01000COR 55 GOTO LRERR ÐÐ01010CLR Z-ADDW3N X 01020CLR MOVE BLK8 PROG 01030CLR MOVELPRG,X PROG 8 01040CLR GOTO ENDJOB 01050C*------------------------------------------------------------------- 01060CLR LRERR TAG 01070CLR SETON 83 01080CLR EXCPT 01090CLR SETOF 83 01100CLR GOTO START 01110C*------------------------------------------------------------------- 01120CLR ENDJOB TAG 01130CLR PROG COMP BLK8 54 01140CLRN54N86 GOTO LRERR 01150CLR TIME TIMEIN TIME OUT 01160CLR 86 MOVE 'SHUTDOWN'PROG 01170CLR MOVE PROG JOB 01180CLR PORT CHAINCRTFILE 54 01190CLR SETON 87 01200CLR EXCPT UPDATE CRTFILE 01210CLR SETOF 87 01220CLR EXITFQTOPF CLEAR CRT 01230CLR EXITFCHAIN 01240CLR RLABL PROG 01250C******************************************************************** ÐÐ01260CSR SR101 BEGSR 01270C* GET CRTFILE 01280CSR MOVE ' ' BLK33 33 01290CSR MOVE ' ' BLK8 8 01300CSR MOVE BLK8 W8A 8 01310CSR Z-ADD0 W2N 20 01320CSR Z-ADD0 W1N 10 01330CSR MOVE ' ' W2A 2 01340CSR EXITFPGMINX GET PORT # 01350CSR RLABL W8A 01360CSR RLABL W2N 01370CSR RLABL W1N 01380CSR RLABL W2A 01390CSR MOVE W2A PORT 20 01400CSR PORT COMP 0 54 01410CSRN54 Z-ADD25 PORT 01420CSR PORT CHAINCRTFILE H9 01430CSR H9 GOTO END101 01440CSR CRSHUT COMP ' ' 86 FLAG SHUTDOWN 01450CSR 86 MOVE 'SHUTDOWN'PROG 01460CSR TIME TIMEIN 60 TIME IN 01470CSR MOVE BLK8 PROG 8 01480CSR MOVEL'QQDP01' PROG 01490CSR MOVE PROG JOB 8 01500CSR SETON 87 ÐÐ01510CSR EXCPT UPDATE CRTFILE 01520CSR SETOF 87 01530CSR END101 ENDSR 01540O******************************************************************** 01550OTERM50 D 02NLR 01560O BIT,28 1 01570O 2 '8' 01580O LA 5 01590O CA 8 01600O N70 X Z 11 01610O MTEXT 48 01620O*------------------------------------------------------------------- 01630O E 82 01640O NUL 50 01650O BIT,28 1 01660O 2 '8' 01670O 8 '001001' 01680O BIT,28 9 01690O 10 '3' 01700O BIT,1 11 01710O BIT,1 12 01720O 29 'ENTER SELECTION #' 01730O BIT,28 30 01740O 31 '8' 01750O 37 '001019' ÐÐ01760O BIT,8 50 01770O*------------------------------------------------------------------- 01780O E 83 01790O NUL 50 01800O BIT,28 1 01810O 2 '8' 01820O 8 '001060' 01830O 33 'INVALID SELECTION' 01840O******************************************************************** 01850OCRTFILE E 87 01860O JOB 26 01870O TIMEIN 33 01880O 86 BLK33 33 01890O 86 27 'X' 01900O UDATE 37 01910O 73 'QQDP01' 01920O 79 'QQDP01' ** NUL ARRAY 001930 001940** PRG ARRAY 001950 001960** A6 ARRAY 001970 001980** A4 ARRAY 001990 002000ÐÐ/* 002010_‚ ÐÐ_‚_‚ 002010_‚ ÐÈ(èµ è¡X002CM PÌ120282120282(èÈÐ00010H Q002CM00020F* INIT CR2FILE (CMMAST) AND PUT CMMAST INPUT SCREEN.(X002CM) 00030F* REVISED 6-25-81 3:40 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCMMAST IC F 576R 5AI 1 DISK 00080FCR2FILE UC F 672R DISK 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E TABSTC 1 58 2 TABSCN 20 STATE NAMES 00120E TABCLC 1 17 2 TABCLN 20 CUST CLASS NAMES 00130E TABTAX 1 5 1 TABTAN 20 TAX CODES 00140E TABTER 1 5 3 TABTN 20 TERRITORY NAMES 00150E NUL 1 132 1 NULL CHAR 00160E A6 6 6 1 CALL READ PARAM. 00170E A8 8 8 1 A INPUT DATA ARRAY 00180E NUM 1 9 3 0 NUMERIC FIELD NO.'S 00190E DUN 3 3 1 A EDIT CMPLT FLAG 00200E INT 3 3 1 00210E MES 1 1 30 00220E TRN 1 3 6 00230E* 00240E CMA 7 35 00250E CMB 10 9 2 ÐÐ00260E CMS 10 9 2 00270E CMAR 4 9 2 00280E CMD 5 7 0 00290E CMM 3 3 00300E CMC 3 2 0 00310E BIT 33 1 SCREEN CONTR. CHAR 00320E CALL 5 6 CALL STACK 00330E* 00340E* 00350I******************************************************************* 00360IBITTAB BT 00370I 1 33 BIT 00380I******************************************************************* 00390IMGFILE MG 00400I* MESSAGE FILE. 00410I 1 35 MGTEXT 00420I******************************************************************** 00430ICMMAST CM 00440I* CUSTOMER MASTER. 00450I* CUSTOMER NO. 5N 00460I 1 50CMCUST 00470I* SORT (ALT) KEY 20A 00480I 6 25 CMSORT 00490I* ADDRESS 35A X 7 00500I 26 270 CMA ÐÐ00510I* STATE CODE 2A 00520I 271 272 CMSTCD 00530I* ZIP CODE 9P 00540I P 273 2770CMZIP 00550I* PHONE NO. 15A 00560I 278 292 CMPHON 00570I* CONTACT NAME 35A 00580I 293 327 CMCONT 00590I* REMARKS 35A 00600I 328 362 CMREM 00610I* CUSTOMER CLASS 2A 00620I 363 364 CMCLAS 00630I* TERRITORY CODE 3A 00640I 365 367 CMTER 00650I* CREDIT LIMIT 7P 00660I P 368 3710CMCRLM 00670I* PAYMENT TERMS 8A 00680I 372 379 CMTERM 00690I* NUMBER OF INVOICE COPIES 1N 00700I 380 380 CMINV 00710I* SHIPPING METHOD 20A 00720I 381 400 CMSHIP 00730I* CURRENT BACKLOG 9.2P X 10 00740I P 401 450 CMB 00750I* LAST 12-MOS SHIPMENTS 9.2P X 10 ÐÐ00760I P 451 500 CMS 00770I* CURRENT RECEIVABLES 9.2P X 4 00780I P 501 520 CMAR 00790I* TAX CODE 1A 00800I 521 521 CMTAX 00810I* STD DISCOUNT 3.2P 00820I P 522 5232CMDISC 00830I* EXPORT CODE 1A 00840I 524 524 CMEXPT 00850I* DATE HISTORY 7P X 5 00860I* 1 = DATE INPUT 00870I* 2 = DATE LAST ORDER 00880I* 3 = DATE LAST SHIPMENT 00890I* 4 = NOT USED 00900I* 5 = NOT USED 00910I P 525 544 CMD 00920I* GEOGRAPHIC CODE 5A 00930I 545 549 CMGEO 00940I* HOLD CODE 1A 00950I 550 550 CMHOLD 00960I* MAILING CODES. 00970I* MAILER CODE 3 X 3A 00980I 551 559 CMM 00990I* NUMB OF COPIES 3 X 2N 01000I 560 565 CMC ÐÐ01010I* POINTERS. 01020I* CREDIT CHANGES 5P 01030I P 573 5750CMFCC 01040I* RECORD STATUS 1A 01050I 576 576 CMSTAT 01060I******************************************************************** 01070ICR2FILE CR 01080I* CUSTOMER NO. 5N 01090I 1 50CRCUST 01100I* START PROG 6A 01110I 666 671 CRPROG 01120I* TRANSACTION CODE 1A 01130I 672 672 CRTRAN 01140C******************************************************************** 01150C* INITIALIZE 01160C EXSR SR101 1-TIME INIT 01170C*------------------------------------------------------------------ 01180C START TAG 01190C* SET-UP 1ST FIELD NO. 01200C Z-ADD1 F 30 FIELD # 01210C SETOF 96 01220C MOVE ' ' IOSW 1 01230C MOVE BLK5 KEY 5 01240C MOVE ' ' DUN 01250C MOVE ' ' INT ÐÐ01260C GOTO READ 01270C*------------------------------------------------------------------ 01280C NEXT TAG 01290C* SET-UP NEXT FIELD NO. 01300C 1 ADD F F FIELD # 01310C*----------------------------------------------------------------- 01320C READ TAG 01330C* READ DATA FROM TERMINAL. 01340C EXSR SR102 VALIDATE FIELD # 01350C 55 GOTO UPDATE DONE 01360C EXSR SR201 IDENTIFY-F 01370C 01 CRPROG COMP 'Q007CM' 54 01380C 01 54 MOVE 'C' CRTRAN 01390C 01 54 GOTO NEXT 01400C SETON 69 01410C EXSR SR72 PROMPT 01420C SETOF 69 01430C EXSR SR75 READ TERMINAL 01440C 98 GOTO GOODBY GOODBY 01450C 94 GOTO MENU MENU REQUEST 01460C N77N88 EXSR SR104 EDIT INPUT FIELD 01470C 96 ERROR 01480CORN77N88 EXSR SR72 REWRITE INPUT DATA 01490C 93 GOTO NEWITM NEW ITEM 01500C 92 GOTO JUMP FIELD JUMP REQST ÐÐ01510C 91 GOTO NEXT SKIP FORWARD 01520C 89 F SUB 1 F SKIP BACKWARD 01530C 89 GOTO READ " " 01540C 88 SETOF 90 SPACE FILL 01550C 88 SETON 77 " " 01560C 88 MOVE 'X' INT,F 01570C N88 MOVE ' ' INT,F 01580C 87 GOTO START 01590C 86 GOTO UPDATE UPDATE 01600C 85 GOTO READ REPEAT 01610C 96 GOTO ERROR ERROR 01620C N77 GOTO NEXT NO DATA INPUT 01630C*------------------------------------------------------------------ 01640C PROCES TAG 01650C* PROCESS INPUT DATA 01660C EXSR SR103 MOVE DATA 01670C N96 EXSR SR104 EDIT DATA 01680C EXSR SR72 REWRITE DATA 01690C 96 GOTO ERROR ERROR 01700C GOTO NEXT 01710C*------------------------------------------------------------------ 01720C UPDATE TAG 01730C* UPDATE DATA BASE. 01740C EXSR SR105 FINAL EDIT 01750C 96 GOTO ERROR ERROR ÐÐ01760C EXSR SR71 PUT SCREEN 01770C MOVEL'Q003CM' PROG 8 01780C GOTO END 01790C*------------------------------------------------------------------- 01800C JUMP TAG 01810C* SET-UP JUMP TO REQUESTED FIELD 01820C 1 ADD W W 30 01830C W COMP 8 54 01840C 54 Z-ADD318 M 50 96 FLAG ERROR 01850C 54 GOTO ERROR BAD ESC 01860C MOVE '000' W3A 3 01870C MOVEAA8,W W3A 01880C Z-ADD3 W2N 20 01890C EXIT SUBRAJ R. JUSTIFY 01900C RLABL W2N 01910C RLABL W3A 01920C MOVE W3A F NEW FIELD # 01930C GOTO READ 01940C*-------------------------------------------------------------------- 01950C ERROR TAG 01960C EXSR SR102 VALIDATE FIELD # 01970C EXSR SR89 GET MSG 01980C EXSR SR73 PUT MSG 01990C GOTO READ 02000C*------------------------------------------------------------------ ÐÐ02010C NEWITM TAG 02020C* SET-UP LINK FOR NEW ITEM 02030C EXSR SR107 CLASSIFY START. 02040C 54 MOVEL'Q001CM' PROG 8 SALES. 02050C 55 MOVEL'Q007CM' PROG ACCTG. 02060C GOTO END 02070C*------------------------------------------------------------------- 02080C MENU TAG 02090C* SET-UP LINK TO MENU 02100C MOVEL'Q070DP' PROG 02110C GOTO END 02120C*-------------------------------------------------------------------- 02130C GOODBY TAG 02140C* LINK TO SIGN-OFF 02150C MOVEL'GOODBY' PROG 02160C GOTO END 02170C*------------------------------------------------------------------- 02180C END TAG 02190C PROG COMP BLK8 54 02200C N54 MOVEL'Q070DP' PROG 02210C EXSR SR97 UPDATE CR2FILE 02220C EXITFCHAIN LINK TO NEXT PROG 02230C RLABL PROG 02240C********************************************************************* 02250CSR SR1 BEGSR ÐÐ02260C* EDIT TRAN CODE 02270CSR EXSR SR203 CLASSIFY TRAN 02280CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02290C* 02300C* 02310CSR ENDSR 02320C******************************************************************** 02330CSR SR2 BEGSR 02340C* EDIT CUST NO. 02350CSR CRCUST COMP 0 54 02360CSRN54 Z-ADD45 M 96 FLAG ERROR 02370CSR 54 EXSR SR106 GET MAST 02380CSR ENDSR 02390C***************************************************************** 02400CSR SR70 BEGSR 02410C* CLEAR TERM SCREEN. 02420CSR EXITFQTOPF CLEAR SCREEN 02430CSR ENDSR 02440C******************************************************************** 02450CSR SR71 BEGSR 02460C* PUT HEADINGS TO TERMINAL 02470CSR EXITFQTOPF CLEAR SCREEN 02480CSR CMINV COMP ' ' 54 02490CSRN54 MOVE '2' CMINV 02500CSR SETON 71 ÐÐ02510CSR EXCPT PUT HEADINGS 02520CSR SETOF 71 02530CSR ENDSR 02540C********************************************************************* 02550CSR SR72 BEGSR 02560C* PUT DATA TO TERMINAL 02570CSR SETON 72 02580CSR EXCPT PUT DATA 02590CSR SETOF 72 02600CSR ENDSR 02610C*********************************************************************** 02620CSR SR73 BEGSR 02630C* PUT ERROR MESSAGE TO TERMINAL 02640CSR SETON 73 02650CSR EXCPT PUT MSG 02660CSR SETOF 73 02670CSR Z-ADDM LSTERR 50 02680CSR ENDSR 02690C******************************************************************* 02700CSR SR75 BEGSR 02710C* READ FROM TERMINAL 02720CSR SETOF 779096 02730CSR SETOF 939291 02740CSR SETOF 898887 02750CSR SETOF 8685 ÐÐ02760CSR MOVE BIT,5 A6,2 BUF LENGTH 02770CSR MOVEAA6 W6A 6 02780CSR MOVE BLK8 W8A 8 BUFFER 02790CSR EXITFXCREAD READ TERM 02800CSR RLABL W8A 02810CSR RLABL W6A 02820CSR MOVEAW8A A8 02830CSR MOVE BLK8 W8A 02840CSR Z-ADD1 W 30 02850CSR '\' LOKUPA8,W 90 FLAG ESC 02860CSRN90 GOTO T75B NOT ESC 02870CSR 1 ADD W W 02880CSR W COMP 8 54 02890CSR 54 GOTO T75A BAD ESC 02900CSR A8,W COMP 'G' 98 GOODBY 02910CSR A8,W COMP 'E' 94 MENU 02920CSR A8,W COMP 'N' 93 NEW ITEM 02930CSR A8,W COMP 'J' 92 JUMP 02940CSR A8,W COMP 'F' 91 SKIP FRWRD 02950CSR A8,W COMP 'B' 89 SKIP BKWRD 02960CSR A8,W COMP 'S' 88 SPACE FILL 02970CSR A8,W COMP 'H' 87 HOME 02980CSR A8,W COMP 'U' 86 UPDATE 02990CSR A8,W COMP 'R' 85 REPEAT 03000CSR 98 ÐÐ03010COR 94 03020COR 93 03030COR 92 03040COR 91 03050COR 89 03060COR 88 03070COR 87 03080COR 86 03090COR 85 GOTO END75 GOOD ESC 03100C*------------------------------------------------------------------ 03110CSR T75A TAG 03120C* FLAG BAD ESC INPUT 03130CSR Z-ADD318 M 96 FLAG ERROR 03140CSR GOTO END75 03150C*-------------------------------------------------------------------- 03160CSR T75B TAG 03170C* MOVE DATA 03180CSR Z-ADD1 W 03190CSR ' ' LOKUPA8,W 77 03200CSR 77 MOVEAA8,W W8A INPUT DATA 03210C*-------------------------------------------------------------------- 03220CSR END75 TAG 03230C* INIT PREV ERROR MSG. 03240CSR LSTERR COMP 0 54 03250CSR 54 MOVE BLK35 MGTEXT ÐÐ03260CSR 54 EXSR SR73 BLANK MESSAGE 03270CSR Z-ADD0 LSTERR 50 03280CSR ENDSR 03290C********************************************************************** 03300CSR SR80 BEGSR 03310C* GET MASTER RECORD 03320CSR SETOF 61 03330CSR CRCUST CHAINCMMAST 60 GET MASTER 03340CSRN60 CMSTAT COMP 'D' 61 FLAG DELETE 03350CSR 60 03360COR 61 GOTO END80 03370CSR CMSTCD LOKUPTABSTC TABSCN 54 03380CSR 54 MOVE TABSCN STCNAM 20 03390CSRN54 MOVE BLK20 STCNAM 03400CSR CMCLAS LOKUPTABCLC TABCLN 54 03410CSR 54 MOVE TABCLN CLSNAM 20 03420CSRN54 MOVE BLK20 CLSNAM 03430CSR CMTAX LOKUPTABTAX TABTAN 54 03440CSR 54 MOVE TABTAN TAXNAM 20 03450CSRN54 MOVE BLK20 TAXNAM 03460CSR CMTER LOKUPTABTER TABTN 54 03470CSR 54 MOVE TABTN TERNAM 20 03480CSRN54 MOVE BLK20 TERNAM 03490CSR XFOOTCMB TOTBKL 92 03500CSR XFOOTCMS TOTSHP 92 ÐÐ03510CSR XFOOTCMAR TOTAR 92 TOTAL RECEIVABLES 03520CSR END80 ENDSR 03530C******************************************************************** 03540CSR SR89 BEGSR 03550C* GET MESSAGE MASTER 03560CSR M CHAINMGFILE 54 03570CSR 54 MOVE BLK35 MGTEXT 03580CSR 54 MOVELM MGTEXT 03590CSR 54 MOVE MES,1 MGTEXT 03600CSR ENDSR 03610C******************************************************************** 03620CSR SR97 BEGSR 03630C* UPDATE CR2FILE. 03640CSR SETON 97 03650CSR EXCPT UPDATE CR2FILE. 03660CSR SETOF 97 03670CSR ENDSR 03680C*********************************************************************** 03690CSR SR101 BEGSR 03700C* 1-TIME INITIALIZE 03710CSR MOVE BIT,1 NUL 03720CSR MOVE BIT,1 A6 03730CSR EXSR SR70 CLEAR CRT. 03740CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS 03750C* GET PORT # AND CR2FILE ÐÐ03760CSR MOVE ' ' W8A 8 03770CSR Z-ADD0 W2N 20 03780CSR Z-ADD0 W1N 10 03790CSR MOVE ' ' W2A 2 03800CSR EXITFPGMINX GET PORT # 03810CSR RLABL W8A 03820CSR RLABL W2N 03830CSR RLABL W1N 03840CSR RLABL W2A 03850CSR MOVE W2A PORT 20 PORT NO. 03860CSR PORT COMP 0 54 03870CSRN54 Z-ADD25 PORT DEFAULT 03880CSR PORT CHAINCR2FILE H9 03890C* DEFINE WORK FIELDS,ETC. 03900CSR MOVE ' ' BLK35 35 03910CSR MOVE ' ' BLK5 5 03920CSR MOVE ' ' BLK8 8 03930CSR MOVE ' ' BLK20 20 03940CSR MOVE ' ' BLK6 6 03950CSR ENDSR 03960C********************************************************************** 03970CSR SR102 BEGSR 03980C* VALIDATE FIELD NO. 03990CSR F COMP 0 54 04000CSRN54 Z-ADD1 F ÐÐ04010CSR F COMP FLIMIT 55 04020CSR 55 Z-ADD1 F 04030CSR ENDSR 04040C******************************************************************** 04050CSR SR103 BEGSR 04060C* MOVE INPUT DATA 04070CSR EXSR SR201 IDENTIFY-F 04080CSR EXSR SR202 R. JUSTIFY 04090CSR 01 MOVELW8A CRTRAN TRAN CODE. 04100CSR 02 MOVE W8A CRCUST CUSTOMER # 04110CSR MOVE ' ' DUN,F EDIT FLAG 04120CSR ENDSR 04130C******************************************************************** 04140CSR SR104 BEGSR 04150C* EDIT INPUT DATA 04160CSR 01 EXSR SR1 04170CSR 02 EXSR SR2 04180CSR 96 MOVE ' ' DUN,F EDIT FLAG 04190CSRN96 MOVE 'X' DUN,F 04200CSR ENDSR 04210C*********************************************************************** 04220CSR SR105 BEGSR 04230C* FINAL EDIT 04240CSR SETOF 96 04250CSR SETON 79 FINAL EDIT FLAG ÐÐ04260CSR Z-ADD1 F 04270C*-------------------------------------------------------------------- 04280CSR T105A TAG 04290CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04300CSRN54 GOTO END105 04310CSR EXSR SR201 IDENTIFY-F 04320CSR EXSR SR104 EDIT 04330CSRN96 GOTO T105A 04340C*-------------------------------------------------------------------- 04350CSR END105 TAG 04360CSR SETOF 79 04370CSR ENDSR 04380C******************************************************************** 04390CSR SR106 BEGSR 04400C* UPDATE DATA BASE. 04410CSR EXSR SR203 CLASSIFY TRAN 04420CSR 60 GOTO T106A ADD TRAN 04430CSR 61 GOTO T106D CHANGE TRAN 04440CSR 62 GOTO T106F DELETE TRAN 04450C* FLAG BAD TRAN CODE 04460CSR Z-ADD300 M 96 FLAG ERROR 04470CSR Z-ADD1 F FIELD # 04480CSR GOTO END106 04490C*------------------------------------------------------------------- 04500CSR T106A TAG ÐÐ04510C* ADD TRANSACTION 04520CSR EXSR SR80 GET MASTER 04530CSR 60 NOT ON FILE 04540COR 61 GOTO END106 DELETED MASTER 04550C* FLAG DUPLICATE ADD ERROR 04560CSR Z-ADD301 M 96 FLAG ERROR 04570CSR Z-ADD1 F FIELD # 04580CSR GOTO END106 04590C*---------------------------------------------------------------------- 04600CSR T106D TAG 04610C* CHANGE TRANSACTION. 04620CSR EXSR SR80 GET MASTER 04630CSRN60N61 GOTO END106 GOT IT 04640C* FLAG NO MASTER ERROR 04650CSR Z-ADD302 M 96 FLAG ERROR 04660CSR Z-ADD1 F FIELD # 04670CSR GOTO END106 04680C*----------------------------------------------------------------------- 04690CSR T106F TAG 04700C* DELETE TRANSACTION 04710CSR EXSR SR80 GET MASTER 04720CSRN60N61 GOTO END106 GOT IT 04730C* FLAG NO MASTER ERROR 04740CSR Z-ADD302 M 96 FLAG ERROR 04750CSR Z-ADD1 F FIELD # ÐÐ04760CSR GOTO END106 04770CSR END106 ENDSR 04780C******************************************************************** 04790CSR SR107 BEGSR 04800C* CLASSIFY STARTING PROG. 04810CSR CRPROG COMP 'Q001CM' 54 SALES. 04820CSR CRPROG COMP 'Q007CM' 55 ACCTG. 04830CSR ENDSR 04840C************************************************************************ 04850CSR SR201 BEGSR 04860C* IDENTIFY FIELD NO. 04870CSR F COMP 1 01 04880CSR F COMP 2 02 04890CSR END201 ENDSR 04900C********************************************************************** 04910CSR SR202 BEGSR 04920C* RIGHT JUSTIFY 04930CSR F COMP 2 54 04940CSRN54 GOTO END202 NOT NUMERIC FIELD 04950CSR Z-ADD8 W2N 20 04960CSR EXIT SUBRAJ R. JUSTIFY 04970CSR RLABL W2N 04980CSR RLABL W8A 04990CSR END202 ENDSR 05000C*********************************************************************** ÐÐ05010CSR SR203 BEGSR 05020C* CLASSIFY TRAN CODE 05030CSR CRTRAN COMP 'A' 60 ADD 05040CSR CRTRAN COMP 'C' 61 CHANGE 05050CSR CRTRAN COMP 'D' 62 DELETE 05060CSR 60 MOVE TRN,1 TRNNAM 6 05070CSR 61 MOVE TRN,2 TRNNAM 05080CSR 62 MOVE TRN,3 TRNNAM 05090CSRN60N61N62 MOVE BLK35 TRNNAM 05100CSR ENDSR 05110O******************************************************************** 05120OTERM132 E 72 01 05130O* REQUEST TRAN CODE. 05140O NUL 132 05150O BIT,28 1 05160O 2 '8' 05170O 8 '002001' 05180O 25 'ENTER TRANS CODE:' 05190O 27 ' ' 05200O CRTRAN 28 05210O 30 ' ' 05220O TRNNAM 36 05230O BIT,28 124 05240O 125 '8' 05250O 131 '002020' ÐÐ05260O BIT,8 132 05270O*------------------------------------------------------------------- 05280O E 72 02 05290O* REQUEST CUST #. 05300O NUL 132 05310O BIT,28 1 05320O 2 '8' 05330O 8 '003001' 05340O 21 'ENTER CUST #:' 05350O 27 ' ' 05360O CRCUSTZ 32 05370O BIT,28 124 05380O 125 '8' 05390O 131 '003020' 05400O BIT,8 132 05410O*------------------------------------------------------------------- 05420O E 71 05430O* HEADINGS AND DATA. 05440O BIT,28 1 05450O 8 '8001001' 05460O 30 '(1) TRANSACTION CODE' 05470O 31 ':' 05480O CRTRAN 42 05490O TRNNAM 50 05500O*------------------------------------------------------------------- ÐÐ05510O E 71 05520O 21 '(2) CUSTOMER NUMBER' 05530O CRCUSTZ 38 05540O 31 ':' 05550O 83 'DATE INPUT' 05560O 92 ':' 05570O CMD,1 103 ' - - ' 05580O*------------------------------------------------------------------- 05590O E 71 05600O 88 'DATE LAST ORDER' 05610O 92 ':' 05620O CMD,2 103 ' - - ' 05630O*------------------------------------------------------------------- 05640O E 71 05650O 92 'DATE LAST SHIPMENT:' 05660O CMD,3 103 ' - - ' 05670O*------------------------------------------------------------------- 05680O E 71 05690O 14 ' (5) SORT KEY' 05700O 31 ':' 05710O CMSORT 53 05720O 94 'CURRENT BACKLOG VALUE' 05730O 104 'BY MONTH' 05740O*------------------------------------------------------------------- 05750O E 71 ÐÐ05760O 17 'CUSTOMER ADDRESS' 05770O 77 '1' 05780O CMB,1 2 93 05790O*------------------------------------------------------------------- 05800O E 71 05810O 18 '(6) COMPANY NAME' 05820O 31 ':' 05830O CMA,1 68 05840O 77 '2' 05850O CMB,2 2 93 05860O*------------------------------------------------------------------- 05870O E 71 05880O 18 '(7) COMPANY NAME' 05890O 31 ':' 05900O CMA,2 68 05910O 77 '3' 05920O CMB,3 2 93 05930O*------------------------------------------------------------------- 05940O E 71 05950O 15 '(8) ADDRESS-1' 05960O 31 ':' 05970O CMA,3 68 05980O 77 '4' 05990O CMB,4 2 93 06000O*------------------------------------------------------------------- ÐÐ06010O E 71 06020O 15 '(9) ADDRESS-2' 06030O 31 ':' 06040O CMA,4 68 06050O 77 '5' 06060O CMB,5 2 93 06070O*------------------------------------------------------------------- 06080O E 71 06090O 12 '(10) LINE-5' 06100O 31 ':' 06110O CMA,5 68 06120O 77 '6' 06130O CMB,6 2 93 06140O*------------------------------------------------------------------- 06150O E 71 06160O 10 '(11) CITY' 06170O 31 ':' 06180O CMA,6 68 06190O 77 '7' 06200O CMB,7 2 93 06210O*------------------------------------------------------------------- 06220O E 71 06230O 21 '(12) FOREIGN COUNTRY' 06240O 31 ':' 06250O CMA,7 68 ÐÐ06260O 77 '8' 06270O CMB,8 2 93 06280O*------------------------------------------------------------------- 06290O E 71 06300O 14 '(13) ZIP CODE' 06310O 31 ':' 06320O CMZIP Z 42 06330O 77 '9' 06340O CMB,9 2 93 06350O*------------------------------------------------------------------- 06360O E 71 06370O 16 '(14) STATE CODE' 06380O 31 ':' 06390O CMSTCD 35 06400O STCNAM 58 06410O 81 '10-12' 06420O CMB,102 93 06430O*------------------------------------------------------------------- 06440O E 71 06450O 15 '(15) TELEPHONE' 06460O 31 ':' 06470O CMPHON 48 06480O 81 'TOTAL' 06490O TOTBKL2 93 06500O*------------------------------------------------------------------- ÐÐ06510O E 71 06520O 18 '(16) CONTACT NAME' 06530O 31 ':' 06540O CMCONT 68 06550O 94 'LAST 12-MOS SHIPMENTS' 06560O*------------------------------------------------------------------- 06570O E 71 06580O 13 '(17) REMARKS' 06590O 31 ':' 06600O CMREM 68 06610O 77 '1' 06620O CMS,1 2 93 06630O*------------------------------------------------------------------- 06640O E 71 06650O 20 '(18) CUSTOMER CLASS' 06660O 31 ':' 06670O CMCLAS 35 06680O CLSNAM 58 06690O 77 '2' 06700O CMS,2 2 93 06710O*------------------------------------------------------------------- 06720O E 71 06730O 17 '(19) EXPORT CODE' 06740O 31 ':' 06750O CMEXPT 34 ÐÐ06760O 77 '3' 06770O CMS,3 2 93 06780O*------------------------------------------------------------------- 06790O E 71 06800O 14 '(20) TAX CODE' 06810O 31 ':' 06820O CMTAX 34 06830O TAXNAM 58 06840O 77 '4' 06850O CMS,4 2 93 06860O*------------------------------------------------------------------- 06870O E 71 06880O 14 '(21) SHIP-VIA' 06890O 31 ':' 06900O CMSHIP 53 06910O 77 '5' 06920O CMS,5 2 93 06930O*------------------------------------------------------------------- 06940O E 71 06950O 19 '(22) PAYMENT TERMS' 06960O 31 ':' 06970O CMTERM 41 06980O 77 '6' 06990O CMS,6 2 93 07000O*------------------------------------------------------------------- ÐÐ07010O E 71 07020O 20 '(23) STD DISCOUNT %' 07030O 31 ':' 07040O CMDISCZ 37 07050O 77 '7' 07060O CMS,7 2 93 07070O*------------------------------------------------------------------- 07080O E 71 07090O 21 '(24) GEOGRAPHIC CODE' 07100O 31 ':' 07110O CMGEO 38 07120O 77 '8' 07130O CMS,8 2 93 07140O*------------------------------------------------------------------- 07150O E 71 07160O 20 '(25) TERRITORY CODE' 07170O 31 ':' 07180O CMTER 36 07190O TERNAM 59 07200O 77 '9' 07210O CMS,9 2 93 07220O*------------------------------------------------------------------- 07230O E 71 07240O 18 '(26) CREDIT LIMIT' 07250O 31 ':' ÐÐ07260O 32 '$' 07270O CMCRLM1 42 07280O 81 '10-12' 07290O CMS,102 93 07300O*------------------------------------------------------------------- 07310O E 71 07320O 24 '(27) HOLD SHIPMENT CODE' 07330O 31 ':' 07340O CMHOLD 34 07350O 81 'TOTAL' 07360O TOTSHP2 93 07370O*------------------------------------------------------------------- 07380O E 71 07390O 24 '(28) NUMBER OF INVOICE ' 07400O 31 'COPIES:' 07410O CMINV 34 07420O 93 'CURRENT RECEIVABLES:' 07430O TOTAR K 117 07440O*------------------------------------------------------------------- 07450O E 71 07460O 24 '(29) MAILER CODE-1 ' 07470O 31 ':' 07480O CMM,1 36 07490O*------------------------------------------------------------------- 07500O E 71 ÐÐ07510O 24 '(30) CODE-1,NUMB COPIES' 07520O 31 ':' 07530O CMC,1 Z 36 07540O*------------------------------------------------------------------- 07550O E 71 07560O 24 '(31) MAILER CODE-2 ' 07570O 31 ':' 07580O CMM,2 36 07590O*------------------------------------------------------------------- 07600O E 71 07610O 24 '(32) CODE-2,NUMB COPIES' 07620O 31 ':' 07630O CMC,2 Z 36 07640O*------------------------------------------------------------------- 07650O E 71 07660O 24 '(33) MAILER CODE-3 ' 07670O 31 ':' 07680O CMM,3 36 07690O*------------------------------------------------------------------- 07700O E 71 07710O 24 '(34) CODE-3,NUMB COPIES' 07720O 31 ':' 07730O CMC,3 Z 36 07740O*------------------------------------------------------------------- 07750O E 73 ÐÐ07760O* PUT ERROR MSG. 07770O BIT,28 1 07780O 8 '8030080' 07790O 96 19 '**********' 07800O MGTEXT 55 07810O 96 66 '**********' 07820O BIT,28 131 07830O 132 'K' 07840O******************************************************************** 07850OCR2FILE E 97 07860O CRCUST 5 07870O CMSORT 25 07880O CMA 270 07890O CMSTCD 272 07900O CMZIP 277P 07910O CMPHON 292 07920O CMCONT 327 07930O CMREM 362 07940O CMCLAS 364 07950O CMTER 367 07960O CMCRLM 371P 07970O CMTERM 379 07980O CMINV 380 07990O CMSHIP 400 08000O CMB 450P ÐÐ08010O CMS 500P 08020O CMAR 520P 08030O CMTAX 521 08040O CMDISC 523P 08050O CMEXPT 524 08060O CMD 544P 08070O CMGEO 549 08080O CMHOLD 550 08090O CMM 559 08100O CMC 565 08110O CMFCC 575P 08120O CMSORT 596 08130O CRTRAN 672 ** TABSTC/TABSCN - STATE CODES 008140 008150ALALABAMA 008160AKALASKA 008170AZARIZONA 008180ARARKANSAS 008190ASAMERICAN SAMOA 008200CACALIFORNIA 008210CZCANAL ZONE 008220COCOLORADO 008230CTCONNECTICUT 008240DEDELAWARE 008250ÐÐDCDISTRICT OF COLUMBIA 008260FLFLORIDA 008270GAGEORGIA 008280GUGUAM 008290HIHAWAII 008300IDIDAHO 008310ILILLINOIS 008320ININDIANA 008330IAIOWA 008340KSKANSAS 008350KYKENTUCKY 008360LALOUISIANA 008370MEMAINE 008380MDMARYLAND 008390MAMASSACHUSETTS 008400MIMICHIGAN 008410MNMINNESOTA 008420MSMISSISSIPPI 008430MOMISSOURI 008440MTMONTANA 008450NENEBRASKA 008460NVNEVADA 008470NHNEW HAMPSHIRE 008480NJNEW JERSEY 008490NMNEW MEXICO 008500ÐÐNYNEW YORK 008510NCNORTH CAROLINA 008520NDNORTH DAKOTA 008530OHOHIO 008540OKOKLAHOMA 008550OROREGON 008560PAPENNSYLVANIA 008570PRPUERTO RICO 008580RIRHODE ISLAND 008590SCSOUTH CAROLINA 008600SDSOUTH DAKOTA 008610TNTENNESSEE 008620TTTRUST TERRITORIES 008630TXTEXAS 008640UTUTAH 008650VTVERMONT 008660VAVIRGINIA 008670VIVIRGIN ISLANDS 008680WAWASHINGTON 008690WVWEST VIRGINIA 008700WIWISCONSIN 008710WYWYOMING 008720** TABCLC/TABCLN - CUST CLASS NAMES 00873010COMMERCIAL END USER 00874015U.S. GOVERNMENT 008750ÐÐ20GENERAL O.E.M. 00876021BROADCAST O.E.M. 00877030GENERAL LINE DEALER 00878031BROADCAST DEALER 00879033BROADCAST DLR,BRANCH 00880034GEN LINE DLR,BRANCH 00881035DESIGNATED PROD DLR 00882050SPECIAL 00883060AVIONICS END USER 00884065AVIONICS OEM 00885070AVIONICS DISTRIB 00886075AVIONICS REPAIR SHOP 00887090AVIONICS SPECIAL 00888098TO BE DELETED 00889099DISCONTINUED DLR 008900** TABTAX/TABTAN - TAX CODE RATES 0089101CA NON-TAXABLE,CARD 0089202CA NON-TAXABLE,NO CD 0089303NON-TAXABLE,US GOVT 0089404NON-TAXABLE,OTHER 0089505TAXABLE 008960** TABTER/TABTN - TERRITORY NAMES 008970 008980 008990 009000ÐÐ 009010 009020** NUL ARRAY 009030 009040** A6 ARRAY 009050 009060** A40 ARRAY 009070 009080** NUM ARRAY 009090002 009100** DUN ARRAY 009110 009120** INT ARRAY 009130 009140** MES ARRAY 009150---MESSAGE NOT ON FILE--- 009160** TRN ARRAY 009170ADD 009180CHANGE 009190DELETE 009200/* 009210_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(W §X002DH P120282120282(èÈÐ00010H Q002DH00020F* UPDATE DEPT FILE - DEPT HEAD RECORD. (X002DH) 00030F* REVISED 4/26/80 1:15 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FDEPTFILEUC F 32R12AI 1 DISK A 00070FTERM70 O F 70 5 00080FMGFILE IC F 80R DISK 00090E******************************************************************** 00100E NUL 1 70 1 00110E A6 1 6 1 00120E A8 1 8 1 A 00130E BIT 33 1 00140I******************************************************************** 00150IBITTAB BT 00160I 1 33 BIT 00170I******************************************************************** 00180IDEPTFILEDH 54 1 CH 00190I* RECORD CODE 1A 00200I* H = DEPT HEAD RECORD 00210I* J = DEPT JOB RECORD 00220I 1 1 DHREC 00230I* DEPT # 5N 00240I 2 60DHDEPT 00250I* DEPT HEAD EMPLOYEE # 5N ÐÐ00260I 7 110DHEMPL 00270I* RECORD STATUS 1A 00280I 32 32 DHSTAT 00290I*------------------------------------------------------------------- 00300I DJ 54 1 CJ 00310I* RECORD CODE 1A 00320I 1 1 DJREC 00330I* DEPT # 5N 00340I 2 60DJDEPT 00350I* SEQ # 3N 00360I 7 90DJSEQ 00370I* JOB CODE 6A 00380I 13 18 DJJOB 00390I* RECORD CODE 1A 00400I 32 32 DJSTAT 00410I XX 54 00420I******************************************************************** 00430IMGFILE MG 00440I* MESSAGE FILE 00450I* TEXT 35A 00460I 1 35 MGTEXT 00470I* LINE-2 35A 00480I 36 70 MGLIN2 61 00490I* PROG NAME 5A 00500I 71 75 MGPROG ÐÐ00510C******************************************************************** 00520C START TAG 00530C* INITIALIZE - PUT HEADINGS. 00540C EXSR SR101 00550C*------------------------------------------------------------------- 00560C CONTU TAG 00570C* READ NEXT FIELD. 00580C SETOF 949596 00590C 1 ADD F F 30 FIELD #. 00600C F COMP 3 54 00610C 54 GOTO UPDATE UPDATE. 00620C EXSR SR71 READ. 00630C 94 'H' LOKUPA8 54 00640C 94 54 GOTO START 00650C 94 GOTO END EXIT. 00660C EXSR SR102 IDENTIFY-F. 00670C 61 77 MOVELW8A TTCODE 1 TRAN CODE. 00680C 62 77 MOVE W8A DEPT 50 DEPT #. 00690C 63 77 MOVE W8A HEAD 50 DEPT HEAD. 00700C EXSR SR72 PROMPT. 00710C 61 TRAN CODE. 00720COR 62 GOTO CONTU DEPT #. 00730C*------------------------------------------------------------------- 00740C UPDATE TAG 00750C EXSR SR103 CLASSIFY TRAN. ÐÐ00760C 61 GOTO ADD ADD TRAN. 00770C 63 GOTO DELETE DELETE TRAN. 00780C* FLAG INVALID TRAN CODE. 00790C Z-ADD1 F 00800C Z-ADD250 M 50 96 MSG #. 00810C GOTO ERROR FLAG ERROR. 00820C*------------------------------------------------------------------- 00830C ADD TAG 00840C* ADD TRANS. 00850C EXSR SR80 GET DEPTFILE. 00860C 60 GOTO NOFILE NOT ON FILE. 00870C 61 GOTO DELFIL DELETED. 00880C* FLAG DUPLICATE ADD. 00890C Z-ADD251 M 96 MSG #. 00900C Z-ADD1 F 00910C GOTO ERROR 00920C*------------------------------------------------------------------- 00930C NOFILE TAG 00940C* ADD--- NOT ON FILE. 00950C EXSR SR104 INIT MAST. 00960C EXSR SR105 MOVE DATA. 00970C EXSR SR106 EDIT. 00980C 96 GOTO ERROR ERROR. 00990C Z-ADDDEPT DHDEPT 01000C EXSR SR81 ADD NEW MAST. ÐÐ01010C GOTO START 01020C*------------------------------------------------------------------- 01030C DELFIL TAG 01040C* ADD--- DELETED. 01050C EXSR SR105 MOVE DATA. 01060C EXSR SR106 EDIT. 01070C 96 GOTO ERROR ERROR. 01080C MOVE 'A' DHSTAT RECORD STATUS. 01090C EXSR SR82 REWRITE MAST. 01100C GOTO START 01110C*------------------------------------------------------------------- 01120C DELETE TAG 01130C EXSR SR80 GET MAST. 01140C N60N61 GOTO DELOK GOT IT. 01150C* FLAG NO MAST ERROR. 01160C Z-ADD252 M 96 MSG #. 01170C GOTO ERROR ERROR. 01180C*------------------------------------------------------------------- 01190C DELOK TAG 01200C MOVE 'D' DHSTAT RECORD STATUS. 01210C EXSR SR82 REWRITE MAST. 01220C GOTO START 01230C*------------------------------------------------------------------- 01240C ERROR TAG 01250C* PUT ERROR MESSAGE. ÐÐ01260C EXSR SR89 01270C SETON 70 01280C EXCPT PUT ERROR. 01290C SETOF 7096 01300C F SUB 1 F 01310C GOTO CONTU 01320C*------------------------------------------------------------------- 01330C END TAG 01340C EXSR SR70 CLEAR CRT. 01350C MOVEL'QQDP01' PROG 8 01360C EXITFCHAIN 01370C RLABL PROG 01380C******************************************************************** 01390CSR SR70 BEGSR 01400C* PUT ERROR MESSAGE. 01410CSR SETON 70 01420CSR EXCPT PUT ERR MSG. 01430CSR SETOF 70 01440CSR ENDSR 01450C******************************************************************** 01460CSR SR71 BEGSR 01470C* READ FROM CRT. 01480CSR MOVE BIT,5 A6,2 BUF LGTH. 01490CSR MOVE ' ' A8 01500CSR MOVEAA8 W8A 8 ÐÐ01510CSR MOVEAA6 W6A 6 01520CSR EXSR SR72 PROMPT. 01530CSR EXITFXCREAD READ CRT. 01540CSR RLABL W8A BUFFER. 01550CSR RLABL W6A BUF LGTH. 01560CSR MOVEAW8A A8 01570CSR MOVE BLK8 W8A 01580CSR '\' LOKUPA8 94 01590CSR 94 GOTO END71 EXIT. 01600CSR Z-ADD1 W 30 01610CSR ' ' LOKUPA8,W 77 01620CSR 77 MOVEAA8 W8A 01630CSRN77 GOTO END71 NO INPUT. 01640CSR F COMP 1 54 01650CSR 54 GOTO END71 F=TRAN CODE. 01660CSR Z-ADD8 W2N 20 01670CSR EXIT SUBRAJ RIGHT ADJUST. 01680CSR RLABL W2N 01690CSR RLABL W8A 01700CSR MOVE W8A W8N 80 01710CSR MOVE 'Z' EDIT 1 01720CSR EXIT SUBRED 01730CSR RLABL W8N 01740CSR RLABL EDIT 01750CSR RLABL W8A ÐÐ01760CSR RLABL W2N 01770C*------------------------------------------------------------------- 01780CSR END71 TAG 01790CSR MOVE BLK35 MGTEXT 01800CSR EXSR SR70 CLEAR ERR MSG. 01810CSR ENDSR 01820C******************************************************************** 01830CSR SR72 BEGSR 01840C* PUT PROMPT FOR READ. 01850CSR EXSR SR102 IDENTIFY-F. 01860CSR SETON 72 01870CSR EXCPT PUT PROMPT. 01880CSR SETOF 72 01890CSR ENDSR 01900C******************************************************************** 01910CSR SR73 BEGSR 01920C* CLEAR SCREEN, PUT TITLE. 01930CSR EXITFQTOPF CLEAR SCREEN 01940CSR SETON 73 01950CSR EXCPT CLEAR SCREEN. 01960CSR SETOF 73 01970CSR ENDSR 01980C******************************************************************** 01990CSR SR80 BEGSR 02000C* GET DEPT HEAD RECORD. ÐÐ02010CSR MOVEL'H' W12A 12 02020CSR MOVELDEPT W10A 10 02030CSR MOVE HEAD W10A 02040CSR MOVELW10A W11A 11 02050CSR MOVE W11A W12A 02060CSR SETOF 6061 02070CSR W12A CHAINDEPTFILE 60 GET DEPTFILE. 02080CSRN60 DHSTAT COMP 'D' 61 FLAG DELETE. 02090CSR ENDSR 02100C******************************************************************** 02110CSR SR81 BEGSR 02120C* ADD NEW MAST. 02130CSR SETON 81 02140CSR EXCPT ADD NEW MAST. 02150CSR SETOF 81 02160CSR ENDSR 02170C******************************************************************** 02180CSR SR82 BEGSR 02190C* REWRITE MAST. 02200CSR SETON 82 02210CSR EXCPT REWRITE MAST. 02220CSR SETOF 82 02230CSR ENDSR 02240C******************************************************************** 02250CSR SR89 BEGSR ÐÐ02260C* GET MGFILE. 02270CSR M CHAINMGFILE 60 02280CSR 60 MOVE BLK35 MGTEXT 02290CSR 60 MOVELM MGTEXT 02300CSR 60 MOVE 'NO-FILE' MGTEXT 02310CSR ENDSR 02320C******************************************************************** 02330CSR SR101 BEGSR 02340C* INITIALIZE. 02350CSR MOVE BIT,1 NUL 02360CSR Z-ADD0 F 02370CSR MOVE BIT,1 A6 02380CSR MOVE ' ' BLK8 8 02390CSR SETON 80 02400CSR EXSR SR73 PUT HEADINGS. 02410CSR SETOF 80 02420CSR MOVE ' ' BLK35 35 02430CSR Z-ADD0 DEPT 02440CSR Z-ADD0 HEAD 02450CSR ENDSR 02460C******************************************************************** 02470CSR SR102 BEGSR 02480C* IDENTIFY FIELD #. 02490CSR F COMP 1 61 TRAN CODE. 02500CSR F COMP 2 62 DEPT #. ÐÐ02510CSR F COMP 3 63 EMPLOYEE #. 02520CSR ENDSR 02530C******************************************************************** 02540CSR SR103 BEGSR 02550C* CLASSIFY TRANS. 02560CSR TTCODE COMP 'A' 61 ADD 02570CSR TTCODE COMP 'D' 63 DELETE 02580CSR ENDSR 02590C******************************************************************** 02600CSR SR104 BEGSR 02610C* INIT MAST FIELDS. 02620CSR MOVE 'H' DHREC 02630CSR Z-ADD0 DHDEPT 02640CSR Z-ADD0 DHEMPL 02650CSR MOVE 'A' DHSTAT 02660CSR ENDSR 02670C******************************************************************** 02680CSR SR105 BEGSR 02690C* MOVE DATA. 02700CSR TTCODE COMP 'A' 55 02710CSR 55 DEPT COMP 0 54 02720CSR 54 55 Z-ADDDEPT DHDEPT 02730CSR 55 HEAD COMP 0 54 02740CSR 54 55 Z-ADDHEAD DHEMPL 02750CSR ENDSR ÐÐ02760C******************************************************************** 02770CSR SR106 BEGSR 02780C* EDIT MAST. 02790CSR Z-ADD2 F 02800CSR DHDEPT COMP 0 54 02810CSRN54 Z-ADD304 M 96 02820CSR 96 GOTO END106 02830CSR Z-ADD1 F 02840CSR DHREC COMP 'H' 54 02850CSRN54 Z-ADD303 M 96 02860CSR GOTO END106 02870CSR Z-ADD3 F 02880CSR DHEMPL COMP 0 54 02890CSRN54 Z-ADD308 M 02900CSR END106 ENDSR 02910O******************************************************************** 02920ODEPTFILEEADD 81 02930O* ADD NEW MAST. 02940O 1 'H' 02950O DHDEPT 6 02960O DHEMPL 11 02970O 32 'A' 02980O*------------------------------------------------------------------- 02990O E 82 03000O DHSTAT 32 ÐÐ03010O******************************************************************** 03020OTERM70 E 73 03030O* CLEAR SCREEN, PUT TITLE. 03040O 80 BIT,28 1 03050O 80 2 '8' 03060O 80 8 '001050' 03070O 80 24 'DEPT HEAD UPDATE' 03080O*------------------------------------------------------------------- 03090O E 70 03100O* PUT ERROR MESSAGE. 03110O NUL 70 03120O BIT,28 1 03130O 2 '8' 03140O 8 '010090' 03150O 61 8 '003090' 03160O 62 8 '005090' 03170O 63 8 '007090' 03180O MGTEXT 43 03190O 96 BIT,8 44 03200O*------------------------------------------------------------------- 03210O E 72 03220O* PUT PROMPT BEFORE READ. 03230O NUL 70 03240O BIT,28 1 03250O 2 '8' ÐÐ03260O 61 8 '003001' 03270O 62 8 '005001' 03280O 63 8 '007001' 03290O 61 32 'ENTER TRAN CODE (A,D) ' 03300O 62 32 'ENTER DEPT # ' 03310O 63 32 'ENTER EMPLOYEE # ' 03320O 34 ' ' 03330O 61 TTCODE 35 03340O 62 DEPT Z 39 03350O 63 HEAD Z 39 03360O BIT,28 63 03370O 64 '8' 03380O 61 67 '003' 03390O 62 67 '005' 03400O 63 67 '007' 03410O 70 '027' ** NUL ARRAY 003420 003430** A6 ARRAY 003440 003450** A8 ARRAY 003460 003470/* 003480_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(&ÿ &æX002DJ P120282120282(èÈÐ00010H Q002DJ00020F* UPDATE DEPT/JOB RECORDS. (X002DJ) 00030F* REVISED 4/26/80 1:20 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FDEPTFILEUC F 32R12AI 1 DISK A 00070FJOBFILE ID F 48L 7AI 1 DISK 00080FEMPLFILEUD F 64L14AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FTERM50 O F 50 5 00110E******************************************************************** 00120E NUL 1 50 1 00130E A6 1 6 1 00140E A8 1 8 1 A 00150E A36 1 36 1 00160E BIT 33 1 00170I******************************************************************** 00180IBITTAB BT 01 00190I 1 33 BIT 00200I******************************************************************** 00210IDEPTFILEDH 02 1 CH 00220I* RECORD CODE 1A 00230I* H = DEPT HEAD RECORD 00240I* J = DEPT JOB RECORD 00250I 1 1 DHREC ÐÐ00260I* DEPT # 5N 00270I 2 60DHDEPT 00280I* DEPT HEAD EMPLOYEE # 5N 00290I 13 170DHEMP 00300I* RECORD STATUS 1A 00310I 32 32 DHSTAT 00320I*------------------------------------------------------------------- 00330I DJ 03 1 CJ 00340I* RECORD CODE 1A 00350I 1 1 DJREC 00360I* DEPT # 5N 00370I 2 60DJDEPT 00380I* SEQ # 3N 00390I 7 90DJSEQ 00400I* JOB NUMB 6A 00410I 13 18 DJJOB 00420I* RECORD STATUS 1A 00430I 32 32 DJSTAT 00440I*------------------------------------------------------------------- 00450I XX 54 00460I******************************************************************** 00470IJOBFILE JN 04 1 CN 00480I* RECORD CODE 1A 00490I* N = JOB NAME RECORD 00500I* C = JOB CODE RECORD ÐÐ00510I 1 1 JNREC 00520I* JOB NAME 6A 00530I 2 7 JNJOB 00540I* JOB DESCRIPTION 35A 00550I 8 42 JNDESC 00560I* RECORD STATUS 1A 00570I 48 48 JNSTAT 00580I XX 54 00590I******************************************************************** 00600IEMPLFILEEJ 00610I 1 1 EJREC 00620I 50 55 EJJOB 00630I 56 600EJDEPT 00640I******************************************************************** 00650IMGFILE MG 00660I* MESSAGE FILE 00670I* TEXT 35A 00680I 1 35 MGTEXT 00690I* LINE-2 35A 00700I 36 70 MGLIN2 61 00710I* PROG NAME 5A 00720I 71 75 MGPROG 00730C******************************************************************** 00740C START TAG 00750C* INITIALIZE - CLEAR - PUT HEADINGS. ÐÐ00760C EXSR SR101 INIT. 00770C*------------------------------------------------------------------- 00780C CONTU TAG 00790C* READ DATA FROM CRT. 00800C SETOF 949677 00810C 1 ADD F F 30 FIELD #. 00820C F COMP 4 54 00830C 54 GOTO UPDATE 00840C EXSR SR71 READ,ETC. 00850C 94 'H' LOKUPA8 54 00860C 94 54 GOTO START 00870C 94 GOTO END EXIT. 00880C N77 GOTO CONTU 00890C EXSR SR102 IDENTIFY-F. 00900C 61 MOVELW8A TTCODE 1 TRAN CODE. 00910C 62 MOVE W8A DEPT 50 DEPT #. 00920C 63 MOVE W8A SEQ 30 SEQ #. 00930C 64 MOVELW8A JOB 6 JOB CODE. 00940C EXSR SR72 PUT PROMPT. 00950C 96 GOTO ERROR 00960C GOTO CONTU 00970C*------------------------------------------------------------------- 00980C UPDATE TAG 00990C EXSR SR103 CLASSIFY TRAN. 01000C 60 GOTO ADD ADD TRAN. ÐÐ01010C 61 GOTO CHANGE CHANGE TRAN. 01020C 62 GOTO DELETE DELETE TRAN. 01030C* FLAG INVALID TRANS CODE. 01040C Z-ADD1 F 01050C Z-ADD300 M 50 MSG #. 01060C GOTO ERROR 01070C*------------------------------------------------------------------- 01080C ADD TAG 01090C* ADD TRANS. 01100C EXSR SR80 GET MAST. 01110C 60 GOTO NOFILE NOT ON FILE. 01120C 61 GOTO DELFIL DELETED. 01130C* FLAG DUPLICATE ADD. 01140C Z-ADD1 F 01150C Z-ADD301 M 01160C GOTO ERROR 01170C*------------------------------------------------------------------- 01180C NOFILE TAG 01190C* ADD--- NOT ON FILE. 01200C EXSR SR104 INIT MAST. 01210C EXSR SR105 MOVE DATA. 01220C EXSR SR106 EDIT. 01230C 96 GOTO ERROR ERROR. 01240C MOVE DEPT DJDEPT DEPT #. 01250C EXSR SR81 ADD NEW MAST. ÐÐ01260C GOTO START 01270C*------------------------------------------------------------------- 01280C DELFIL TAG 01290C* ADD--- DELETED MAST. 01300C EXSR SR105 MOVE DATA. 01310C EXSR SR106 EDIT. 01320C 96 GOTO ERROR ERROR. 01330C MOVE 'A' DJSTAT RECORD STATUS. 01340C EXSR SR82 REWRITE MAST. 01350C GOTO START 01360C*------------------------------------------------------------------- 01370C CHANGE TAG 01380C* CHANGE TRANS. 01390C EXSR SR80 GET MAST. 01400C N60N61 GOTO CHGOK 01410C* FLAG NO MAST ERROR. 01420C Z-ADD1 F 01430C Z-ADD302 M 01440C GOTO ERROR ERROR 01450C*------------------------------------------------------------------- 01460C CHGOK TAG 01470C EXSR SR105 MOVE DATA. 01480C EXSR SR106 EDIT. 01490C 96 GOTO ERROR ERROR. 01500C EXSR SR82 REWRITE MAST. ÐÐ01510C GOTO START 01520C*------------------------------------------------------------------- 01530C DELETE TAG 01540C EXSR SR80 GET MAST. 01550C N60N61 GOTO DELOK GOT IT. 01560C* FLAG NO MAST ERROR. 01570C Z-ADD1 F 01580C Z-ADD302 M MSG #. 01590C GOTO ERROR ERROR. 01600C*------------------------------------------------------------------- 01610C DELOK TAG 01620C MOVE 'D' DJSTAT RECORD STATUS. 01630C EXSR SR82 REWRITE MAST. 01640C EXSR SR107 DEL EJ REC. 01650C GOTO START 01660C*------------------------------------------------------------------- 01670C ERROR TAG 01680C EXSR SR73 PUT MSG. 01690C F SUB 1 F 01700C GOTO CONTU 01710C*------------------------------------------------------------------- 01720C END TAG 01730C MOVEL'QQDP01' PROG 8 01740C*------------------------------------------------------------------- 01750C ENDJOB TAG ÐÐ01760C SETON LR 01770C EXITFCHAIN 01780C RLABL PROG 01790C******************************************************************** 01800CSR SR70 BEGSR 01810C* CLEAR CRT, PUT HEADING. 01820CSR EXITFQTOPF CLEAR CRT 01830CSR SETON 70 01840CSR EXCPT PUT HEADING. 01850CSR SETOF 70 01860CSR ENDSR 01870C******************************************************************** 01880CSR SR71 BEGSR 01890C* READ FROM TERMINAL. 01900CSR SETOF 779496 01910CSR EXSR SR72 PUT PROMPT. 01920CSR MOVE BIT,5 A6,2 01930CSR MOVEAA6 W6A 6 BUF LGTH. 01940CSR MOVE BLK8 W8A 8 01950CSR EXITFXCREAD READ CRT. 01960CSR RLABL W8A BUFFER. 01970CSR RLABL W6A BUF LGTH. 01980CSR MOVEAW8A A8 01990CSR MOVE BLK8 W8A 02000CSR '\' LOKUPA8 94 ÐÐ02010CSR 94 GOTO END71 EXIT. 02020CSR Z-ADD1 W 30 02030CSR ' ' LOKUPA8,W 77 02040CSRN77 GOTO END71 02050CSR MOVEAA8,W W8A 02060CSR F COMP 1 54 02070CSRN54 F COMP 4 54 02080CSR 54 GOTO END71 NOT NUMERIC. 02090CSR Z-ADD8 W2N 20 02100CSR EXIT SUBRAJ RIGHT ADJUST. 02110CSR RLABL W2N 02120CSR RLABL W8A 02130CSR MOVE W8A W8N 80 02140CSR MOVE BLK8 W8A 02150CSR MOVE 'Z' EDIT 1 02160CSR EXIT SUBRED 02170CSR RLABL W8N 02180CSR RLABL EDIT 02190CSR RLABL W8A 02200CSR RLABL W2N 02210C*------------------------------------------------------------------- 02220CSR END71 TAG 02230CSR MOVE BLK35 MGTEXT 02240CSR EXSR SR74 CLEAR ERR MSG. 02250CSR ENDSR ÐÐ02260C******************************************************************** 02270CSR SR72 BEGSR 02280C* PUT PROMPT. 02290CSR EXSR SR102 IDENTIFY-F. 02300CSR SETON 72 02310CSR EXCPT PUT PROMPT. 02320CSR SETOF 72 02330CSR ENDSR 02340C******************************************************************** 02350CSR SR73 BEGSR 02360C* PUT ERR MESSAGE. 02370CSR EXSR SR89 GET MSG. 02380CSR EXSR SR74 PUT MSG. 02390CSR ENDSR 02400C******************************************************************** 02410CSR SR74 BEGSR 02420C* PUT MSG TO CRT. 02430CSR EXSR SR102 IDENTIFY-F. 02440CSR SETON 74 02450CSR EXCPT PUT MSG. 02460CSR SETOF 74 02470CSR ENDSR 02480C******************************************************************** 02490CSR SR80 BEGSR 02500C* GET DEPT FILE RECORD. ÐÐ02510CSR SETOF 6061 02520CSR MOVEL'J' W6A RECORD CODE. 02530CSR MOVE DEPT W6A DEPT #. 02540CSR MOVE BLK12 W12A 12 02550CSR MOVELW6A W9A 9 02560CSR MOVE SEQ W9A 02570CSR MOVELW9A W12A 02580CSR W12A CHAINDEPTFILE 60 GET MAST. 02590CSRN60 DJSTAT COMP 'D' 61 FLAG DEL. 02600CSR 60 02610COR 61 GOTO END80 02620CSR DEPT COMP 0 54 02630CSRN54 Z-ADDDJDEPT DEPT 02640CSR SEQ COMP 0 54 02650CSRN54 Z-ADDDJSEQ SEQ 02660CSR JOB COMP BLK6 54 02670CSRN54 MOVE DJJOB JOB 02680CSR END80 ENDSR 02690C******************************************************************** 02700CSR SR81 BEGSR 02710C* ADD NEW MAST. 02720CSR SETON 81 02730CSR EXCPT ADD NEW MAST. 02740CSR SETOF 81 02750CSR ENDSR ÐÐ02760C******************************************************************** 02770CSR SR82 BEGSR 02780C* REWRITE MAST. 02790CSR SETON 82 02800CSR EXCPT REWRITE MAST. 02810CSR SETOF 82 02820CSR ENDSR 02830C******************************************************************** 02840CSR SR83 BEGSR 02850C* WRITE DELETE CODE TO EJ RECORD. 02860CSR SETON 83 02870CSR EXCPT REWRITE EJ REC. 02880CSR SETOF 83 02890CSR ENDSR 02900C******************************************************************** 02910CSR SR89 BEGSR 02920C* GET MGFILE MSG. 02930CSR M CHAINMGFILE 60 GET MGFILE. 02940CSR 60 MOVE BLK35 MGTEXT FLAG ERR. 02950CSR 60 MOVELM MGTEXT FLAG ERR. 02960CSR 60 MOVE 'NO-FILE' MGTEXT FLAG ERR. 02970CSR ENDSR 02980C******************************************************************** 02990CSR SR101 BEGSR 03000C* INITIALIZE. ÐÐ03010CSR Z-ADD0 F 03020CSR MOVE BIT,1 NUL 03030CSR MOVE BIT,1 A6 03040CSR SETON 80 03050CSR EXSR SR70 CLEAR CRT. 03060CSR SETOF 80 03070CSR MOVE ' ' BLK8 8 03080CSR MOVE ' ' BLK35 35 03090CSR MOVE ' ' BLK12 12 03100CSR MOVE ' ' BLK6 6 03110CSR Z-ADD0 DEPT 03120CSR Z-ADD0 SEQ 03130CSR MOVE BLK6 JOB 03140CSR ENDSR 03150C******************************************************************** 03160CSR SR102 BEGSR 03170C* IDENTIFY FIELD #. 03180CSR F COMP 1 61 TRAN CODE. 03190CSR F COMP 2 62 DEPT #. 03200CSR F COMP 3 63 SEQ #. 03210CSR F COMP 4 64 JOB #. 03220CSR ENDSR 03230C******************************************************************** 03240CSR SR103 BEGSR 03250C* CLASSIFY TRANS CODE. ÐÐ03260CSR TTCODE COMP 'A' 60 ADD 03270CSR TTCODE COMP 'C' 61 CHANGE 03280CSR TTCODE COMP 'D' 62 DELETE 03290CSR ENDSR 03300C******************************************************************** 03310CSR SR104 BEGSR 03320C* INIT MASTER FIELDS. 03330CSR MOVE 'J' DJREC RECORD CODE. 03340CSR Z-ADD0 DJDEPT DEPT #. 03350CSR Z-ADD0 DJSEQ SEQ #. 03360CSR MOVE BLK6 DJJOB JOB #. 03370CSR ENDSR 03380C******************************************************************** 03390CSR SR105 BEGSR 03400C* MOVE DATA. 03410CSR TTCODE COMP 'A' 55 03420CSR 55 DEPT COMP 0 54 03430CSR 54 55 Z-ADDDEPT DJDEPT DEPT #. 03440CSR JOB COMP BLK6 54 03450CSR 54 MOVE JOB DJJOB JOB #. 03460CSR 55 SEQ COMP 0 54 03470CSR 54 55 Z-ADDSEQ DJSEQ SEQ #. 03480CSR ENDSR 03490C******************************************************************** 03500CSR SR106 BEGSR ÐÐ03510C* EDIT MAST. 03520CSR Z-ADD1 F 03530CSR DJREC COMP 'J' 54 03540CSRN54 Z-ADD303 M 50 96 FLAG ERROR. 03550CSRN54 GOTO END106 03560CSR Z-ADD2 F 03570CSR DJDEPT COMP 0 54 03580CSRN54 Z-ADD304 M 96 FLAG ERROR. 03590CSRN54 GOTO END106 03600CSR Z-ADD3 F 03610CSR DJSEQ COMP 0 54 03620CSRN54 Z-ADD305 M 96 FLAG ERROR. 03630CSRN54 GOTO END106 03640CSR Z-ADD4 F 03650CSR DJJOB COMP BLK6 54 03660CSRN54 Z-ADD309 M 96 FLAG ERROR. 03670CSRN54 GOTO END106 03680CSR MOVEL'N' W7A 7 03690CSR MOVE DJJOB W7A 03700CSR W7A CHAINJOBFILE 60 03710CSR SETOF 61 03720CSRN60 JNSTAT COMP 'D' 61 03730CSRN60N61 GOTO END106 03740CSR Z-ADD309 M 96 FLAG ERROR. 03750CSR END106 ENDSR ÐÐ03760C******************************************************************** 03770CSR SR107 BEGSR 03780C* DELETE EMPLOYEE JOB RECORDS. 03790CSR MOVE BLK35 W14A 14 03800CSR MOVEL'J' W14A 03810CSR W14A SETLLEMPLFILE 03820C*------------------------------------------------------------------- 03830CSR T107A TAG 03840CSR SETOF 54 03850CSR READ EMPLFILE 54 03860CSR 54 GOTO END107 03870CSR EJREC COMP 'J' 54 03880CSRN54 GOTO END107 03890CSR EJJOB COMP DJJOB 54 03900CSR 54 EJDEPT COMP DJDEPT 54 03910CSRN54 GOTO T107A 03920CSR EXSR SR83 REWRITE EMPL. 03930CSR GOTO T107A 03940CSR END107 ENDSR 03950O******************************************************************** 03960OTERM50 E 72 03970O* PUT PROMPT. 03980O NUL 50 03990O BIT,28 1 04000O 2 '8' ÐÐ04010O 61 5 '003' 04020O 62 5 '005' 04030O 63 5 '007' 04040O 64 5 '009' 04050O 8 '001' 04060O 61 32 'ENTER TRANS CODE (A,C,D)' 04070O 62 32 'ENTER DEPT # ' 04080O 63 32 'ENTER MENU SEQ ' 04090O 64 32 'ENTER JOB # ' 04100O 34 ' ' 04110O 61 TTCODE 35 04120O 62 DEPT Z 39 04130O 63 SEQ Z 37 04140O 64 JOB 40 04150O BIT,28 43 04160O 44 '8' 04170O 61 47 '003' 04180O 62 47 '005' 04190O 63 47 '007' 04200O 64 47 '009' 04210O 50 '027' 04220O*------------------------------------------------------------------- 04230O E 74 04240O* PUT MESSAGE. 04250O NUL 50 ÐÐ04260O BIT,28 1 04270O 2 '8' 04280O 8 '011090' 04290O 61 8 '003090' 04300O 62 8 '005090' 04310O 63 8 '007090' 04320O 64 8 '009090' 04330O MGTEXT 43 04340O 96 BIT,8 44 04350O*------------------------------------------------------------------- 04360O E 70 04370O* PUT HEADING. 04380O 80 BIT,28 1 04390O 80 2 '8' 04400O 80 8 '001050' 04410O 80 23 'DEPT JOB UPDATE' 04420O******************************************************************** 04430ODEPTFILEEADD 81 04440O DJREC 1 04450O DJDEPT 6 04460O DJSEQ 9 04470O DJJOB 18 04480O 32 'A' 04490O*------------------------------------------------------------------- 04500O E 82 ÐÐ04510O DJJOB 18 04520O DJSTAT 32 04530O******************************************************************** 04540OEMPLFILEE 83 04550O 64 'D' ** NUL ARRAY 004560 004570** A6 ARRAY 004580 004590** A8 ARRAY 004600 004610** A36 ARRAY 004620 004630/* 004640_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Šæ ŠX002EE P„À120282120282(èÈÐ00010H Q002EE00020F* UPDATE EMPLOYEE FILE - EMPLOYEE/USER RECORD. (X002EE) 00030F* REVISED 3/16/83 12:10 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FEMPLFILEUC F 64R14AI 1 DISK A 00060FDEPTFILEIC F 32R12AI 1 DISK 00070FJOBFILE IC F 48R 7AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FCRTFILE IC F 256R DISK 00100FTERM63 O F 63 5 00110E******************************************************************** 00120E NUL 1 63 1 00130E A6 1 6 1 00140E A22 1 22 1 A 00150E BIT 33 1 00160I******************************************************************** 00170IBITTAB BT 00180I 1 33 BIT 00190I******************************************************************** 00200IEMPLFILEEE 01 1 CE 00210I* RECORD CODE 2A 00220I* E = EMPLOYEE/USER CROSS-REF 00230I* U = USER/EMPLOYEE CROSS-REF 00240I* J = EMPLOYEE/JOB 00250I 1 1 EEREC ÐÐ00260I* EMPLOYEE # 5N 00270I 2 60EEEMPL 00280I* USER-ID 8A 00290I 15 22 EEUSER 00300I* EMPLOYEE NAME 20A 00310I 23 42 EENAME 00320I* EMPLOYEE DEPT # 5N 00330I 43 470EEDEPT 00340I* RECORD STATUS 1A 00350I 64 64 EESTAT 00360I*------------------------------------------------------------------- 00370I EU 02 1 CU 00380I 1 1 EUREC 00390I 2 9 EUUSER 00400I 15 190EUEMPL 00410I 64 64 EUSTAT 00420I*------------------------------------------------------------------- 00430I EJ 03 1 CJ 00440I 1 1 EJREC 00450I 2 60EJEMPL 00460I 7 90EJSEQ 00470I 15 49 EJDESC 00480I 50 55 EJJOB 00490I 56 600EJDEPT 00500I 64 64 EJSTAT ÐÐ00510I*----------------------------------------------------------------- 00520I EG 10 00530I******************************************************************** 00540IDEPTFILEDH 04 1 CH 00550I* RECORD CODE 1A 00560I* H = DEPT HEAD RECORD 00570I* J = DEPT JOB RECORD 00580I 1 1 DHREC 00590I* DEPT # 5N 00600I 2 60DHDEPT 00610I* DEPT HEAD EMPLOYEE # 5N 00620I 7 110DHEMP 00630I* RECORD STATUS 1A 00640I 32 32 DHSTAT 00650I*------------------------------------------------------------------- 00660I DJ 05 1 CJ 00670I* RECORD CODE 1A 00680I 1 1 DJREC 00690I* DEPT # 5N 00700I 2 60DJDEPT 00710I* SEQ # 3N 00720I 7 90DJSEQ 00730I* JOB CODE 6A 00740I 13 18 DJJOB 00750I* RECORD STATUS 1A ÐÐ00760I 32 32 DJSTAT 00770I*---------------------------------------------------------------- 00780I DG 10 00790I* GARBAGE RECORD 00800I******************************************************************** 00810IJOBFILE JN 54 1 CN 00820I* RECORD CODE 1A 00830I* N = JOB NAME RECORD 00840I* C = JOB CODE RECORD 00850I 1 1 JNREC 00860I* JOB NAME 6A 00870I 2 7 JNJOB 00880I* JOB DESCRIPTION 35A 00890I 8 42 JNDESC 00900I* RECORD STATUS 1A 00910I 48 48 JNSTAT 00920I*----------------------------------------------------------------- 00930I JG 10 00940I* GARBAGE RECORD 00950I******************************************************************** 00960IMGFILE MG 00970I* MESSAGE FILE 00980I* TEXT 35A 00990I 1 35 MGTEXT 01000I* LINE-2 35A ÐÐ01010I 36 70 MGLIN2 61 01020I* PROG NAME 5A 01030I 71 75 MGPROG 01040I******************************************************************** 01050ICRTFILE CR 01060I 1 5 CREMPL 01070I 6 13 CRUSER 01080C******************************************************************** 01090C EXSR SR109 GET PORT/CRTFILE 01100C*------------------------------------------------------------------- 01110C START TAG 01120C* INITIALIZE - CLEAR - PUT HEADINGS. 01130C EXSR SR101 INIT. 01140C Z-ADD0 F 01150C*------------------------------------------------------------------- 01160C CONTU TAG 01170C* READ DATA FROM CRT. 01180C SETOF 949677 01190C SETOF 90 01200C 1 ADD F F 30 FIELD #. 01210C F COMP 5 54 01220C 54 GOTO UPDATE 01230C EXSR SR75 READ,ETC. 01240C 94 GOTO END NEW ITEM 01250C 93 GOTO START ÐÐ01260C 90 GOTO END 01270C N77 GOTO CONTU NO INPUT. 01280C EXSR SR102 IDENTIFY-F. 01290C 61 MOVELW22A TTCODE 1 TRAN CODE. 01300C 62 MOVE W15A EMPLOY 50 EMPLOY #. 01310C 63 MOVELW22A USERID 8 USER-ID. 01320C 64 MOVELW22A NAME 20 NAME. 01330C 65 MOVE W15A DEPT 50 DEPT #. 01340C EXSR SR72 PROMPT. 01350C 65 EXSR SR110 VERIFY USER. 01360C 96 GOTO ERROR 01370C GOTO CONTU 01380C*------------------------------------------------------------------- 01390C UPDATE TAG 01400C Z-ADD5 F 01410C EXSR SR103 CLASSIFY TRAN. 01420C 60 GOTO ADD ADD TRAN. 01430C 61 GOTO CHANGE CHANGE TRAN. 01440C 62 GOTO DELETE DELETE TRAN. 01450C* FLAG INVALID TRANS CODE. 01460C Z-ADD300 M 50 96 MSG #. 01470C Z-ADD1 F 01480C GOTO ERROR 01490C*------------------------------------------------------------------- 01500C ADD TAG ÐÐ01510C* ADD TRANS. 01520C EXSR SR206 CHECK USER-ID 01530C EXSR SR80 GET MAST. 01540C 60 GOTO NOFILE NOT ON FILE. 01550C 61 GOTO DELFIL DELETED. 01560C* FLAG DUPLICATE ADD. 01570C Z-ADD1 F 01580C Z-ADD301 M 96 01590C GOTO ERROR 01600C*------------------------------------------------------------------- 01610C NOFILE TAG 01620C* ADD--- NOT ON FILE. 01630C EXSR SR104 INIT MAST. 01640C EXSR SR105 MOVE DATA. 01650C EXSR SR106 EDIT. 01660C 96 GOTO ERROR ERROR. 01670C MOVE EMPLOY EEEMPL EMPLOYEE #. 01680C EXSR SR81 ADD NEW MAST. 01690C EXSR SR107 ADD CROSS-REF. 01700C GOTO START 01710C*------------------------------------------------------------------- 01720C DELFIL TAG 01730C* ADD--- DELETED MAST. 01740C EXSR SR105 MOVE DATA. 01750C EXSR SR106 EDIT. ÐÐ01760C 96 GOTO ERROR ERROR. 01770C MOVE 'A' EESTAT RECORD STATUS. 01780C EXSR SR82 REWRITE MAST. 01790C EXSR SR108 DELETE OLD USER 01800C EXSR SR107 ADD NEW USER. 01810C GOTO START 01820C*------------------------------------------------------------------- 01830C CHANGE TAG 01840C* CHANGE TRANS. 01850C EXSR SR206 CHECK USER-ID 01860C EXSR SR80 GET MAST. 01870C N60N61 GOTO CHGOK 01880C* FLAG NO MAST ERROR. 01890C Z-ADD1 F 01900C Z-ADD302 M 96 01910C GOTO ERROR ERROR 01920C*------------------------------------------------------------------- 01930C CHGOK TAG 01940C EXSR SR105 MOVE DATA. 01950C EXSR SR106 EDIT. 01960C 96 GOTO ERROR ERROR. 01970C EXSR SR82 REWRITE MAST. 01980C EXSR SR108 DELETE OLD USER 01990C EXSR SR107 ADD NEW USER. 02000C GOTO START ÐÐ02010C*------------------------------------------------------------------- 02020C DELETE TAG 02030C* DELETE TRANS. 02040C EXSR SR80 GET MAST. 02050C N60N61 GOTO DELOK GOT IT. 02060C* FLAG NO MAST ERROR. 02070C Z-ADD1 F 02080C Z-ADD302 M 96 MSG #. 02090C GOTO ERROR ERROR. 02100C*------------------------------------------------------------------- 02110C DELOK TAG 02120C MOVE 'D' EESTAT RECORD STATUS. 02130C EXSR SR82 REWRITE MAST. 02140C Z-ADD500 M 02150C EXSR SR73 WAIT MSG 02160C EXSR SR108 DELETE OLD USER 02170C GOTO START 02180C*------------------------------------------------------------------- 02190C ERROR TAG 02200C EXSR SR73 PUT MSG. 02210C F SUB 1 F 02220C GOTO CONTU 02230C*------------------------------------------------------------------- 02240C END TAG 02250C 98 MOVEL'GOODBY' PROG ÐÐ02260C PROG COMP BLK8 54 02270C N54 MOVEL'Q010EE' PROG 8 02280C Z-ADD500 M 02290C EXSR SR73 WAIT MSG 02300C EXITFCHAIN 02310C RLABL PROG 02320C******************************************************************** 02330CSR SR70 BEGSR 02340C* CLEAR CRT AND PUT TITLE. 02350CSR EXITFQTOPF CLEAR CRT 02360CSR SETON 70 02370CSR EXCPT PUT HEADING 02380CSR SETOF 70 02390CSR ENDSR 02400C******************************************************************** 02410CSR SR72 BEGSR 02420C* PUT PROMPT. 02430CSR EXSR SR102 IDENTIFY-F. 02440CSR SETON 72 02450CSR EXCPT PUT PROMPT. 02460CSR SETOF 72 02470CSR ENDSR 02480C******************************************************************** 02490CSR SR73 BEGSR 02500C* PUT ERR MSG. ÐÐ02510CSR EXSR SR89 GET MSG. 02520CSR EXSR SR74 PUT MSG. 02530CSR ENDSR 02540C******************************************************************** 02550CSR SR74 BEGSR 02560C* PUT MSG. 02570CSR EXSR SR102 IDENTIFY-F. 02580CSR SETON 74 02590CSR EXCPT PUT MSG. 02600CSR SETOF 74 02610CSR ENDSR 02620C******************************************************************** 02630CSR SR75 BEGSR 02640C* READ DATA FROM CRT. 02650CSR SETOF 949677 02660CSR SETOF 90 02670CSR MOVE BLK22 W22A 22 02680CSR MOVE BLK22 W15A 15 02690CSR EXSR SR72 PROMPT. 02700CSR MOVE BIT,12 BUFLGT 2 BUF LGTH. 02710CSR MOVE ' ' A22 02720CSR EXITFQWREED READ CRT. 02730CSR RLABL W22A BUF. 02740CSR RLABL BUFLGT BUF LGTH. 02750CSR MOVEAW22A A22 ÐÐ02760CSR MOVE BLK22 W22A 02770CSR '\' LOKUPA22 90 02780CSRN90 GOTO T75A 02790CSR 1 ADD W W 02800CSR A22,W COMP 'E' 94 02810CSR A22,W COMP 'N' 93 02820CSR A22,W COMP 'G' 98 GOODBY 02830CSR GOTO END75 02840C*------------------------------------------------------------------- 02850CSR T75A TAG 02860CSR Z-ADD1 W 30 02870CSR ' ' LOKUPA22,W 77 02880CSRN77 GOTO END75 02890CSR MOVEAA22,W W22A 02900CSR F COMP 2 54 02910CSRN54 F COMP 5 54 02920CSRN54 GOTO END75 ALPHA. 02930CSR Z-ADD15 W2N 20 02940CSR MOVELW22A W15A 15 02950CSR EXIT SUBRAJ RIGHT ADJUST. 02960CSR RLABL W2N 02970CSR RLABL W15A 02980CSR MOVE W15A W15N 150 02990CSR MOVE 'Z' EDIT 1 03000CSR EXIT SUBRED ÐÐ03010CSR RLABL W15N 03020CSR RLABL EDIT 03030CSR RLABL W15A 03040CSR RLABL W2N 03050C*------------------------------------------------------------------- 03060CSR END75 TAG 03070CSR MOVE BLK35 MGTEXT 03080CSR EXSR SR74 INIT ERR MSG. 03090CSR ENDSR 03100C******************************************************************** 03110CSR SR80 BEGSR 03120C* GET EMPL/USER MAST. 03130CSR SETOF 6061 03140CSR MOVEL'E' W6A 6 03150CSR MOVE EMPLOY W6A 03160CSR MOVE BLK14 W14A 14 03170CSR MOVELW6A W14A 03180CSR W14A CHAINEMPLFILE 60 03190CSRN60 EESTAT COMP 'D' 61 03200CSRN60 MOVE EEUSER OLDUSE 8 03210CSR ENDSR 03220C******************************************************************** 03230CSR SR81 BEGSR 03240C* ADD NEW MAST. 03250CSR SETON 81 ÐÐ03260CSR EXCPT ADD NEW MAST. 03270CSR SETOF 81 03280CSR ENDSR 03290C******************************************************************** 03300CSR SR82 BEGSR 03310C* REWRITE MAST. 03320CSR SETON 82 03330CSR EXCPT REWRITE MAST. 03340CSR SETOF 82 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR84 BEGSR 03380C* GET EU MAST. 03390C* W8A FIELD SET-UP AT EXSR STATEMENT 03400CSR SETOF 6061 03410CSR MOVEL'U' W14A 14 03420CSR MOVE BLK13 W13A 13 03430CSR MOVELW8A W13A 03440CSR MOVE W13A W14A 03450CSR W14A CHAINEMPLFILE 60 GET EU MAST. 03460CSRN60 EUSTAT COMP 'D' 61 FLAG DELETE 03470CSR ENDSR 03480C******************************************************************** 03490CSR SR85 BEGSR 03500C* REWRITE EU MAST. ÐÐ03510CSR SETON 85 03520CSR EXCPT REWRITE EU MAST 03530CSR SETOF 85 03540CSR ENDSR 03550C******************************************************************** 03560CSR SR89 BEGSR 03570C* GET MGFILE. 03580CSR M CHAINMGFILE 60 03590CSR 60 MOVE BLK35 MGTEXT 03600CSR 60 MOVEL'M' MGTEXT 03610CSR 60 MOVE 'NO-FILE' MGTEXT 03620CSR ENDSR 03630C******************************************************************** 03640CSR SR101 BEGSR 03650C* INITIALIZE. 03660CSR Z-ADD0 F 03670CSR MOVE BIT,1 NUL 03680CSR MOVELBIT,1 BUFLGT 2 03690CSR SETON 80 03700CSR EXSR SR70 CLEAR CRT. 03710CSR SETOF 80 03720CSR MOVE ' ' BLK8 8 03730CSR MOVE ' ' BLK20 20 03740CSR MOVE ' ' BLK14 14 03750CSR MOVE ' ' BLK35 35 ÐÐ03760CSR MOVE ' ' BLK13 13 03770CSR MOVE ' ' BLK22 22 03780CSR Z-ADD0 EMPLOY 03790CSR MOVE BLK8 USERID 03800CSR MOVE BLK35 NAME 03810CSR Z-ADD0 DEPT 03820CSR ENDSR 03830C******************************************************************** 03840CSR SR102 BEGSR 03850C* IDENTIFY-F. 03860CSR F COMP 1 61 TRAN CODE. 03870CSR F COMP 2 62 EMPLOY. 03880CSR F COMP 3 63 USER. 03890CSR F COMP 4 64 NAME. 03900CSR F COMP 5 65 DEPT. 03910CSR ENDSR 03920C******************************************************************** 03930CSR SR103 BEGSR 03940C* CLASSIFY TRAN. 03950CSR TTCODE COMP 'A' 60 ADD 03960CSR TTCODE COMP 'C' 61 CHANGE 03970CSR TTCODE COMP 'D' 62 DELETE 03980CSR ENDSR 03990C******************************************************************** 04000CSR SR104 BEGSR ÐÐ04010C* INIT MAST FIELDS. 04020CSR MOVE 'E' EEREC RECORD CODE. 04030CSR Z-ADD0 EEEMPL EMPLOYEE #. 04040CSR MOVE BLK8 EEUSER USER-ID. 04050CSR MOVE BLK20 EENAME EMPL NAME. 04060CSR Z-ADD0 EEDEPT DEPT #. 04070CSR MOVE 'A' EESTAT RECORD STATUS. 04080CSR MOVE BLK8 OLDUSE 8 04090CSR ENDSR 04100C******************************************************************** 04110CSR SR105 BEGSR 04120C* MOVE DATA. 04130CSR TTCODE COMP 'A' 55 04140CSR EMPLOY COMP 0 54 04150CSR 55 54 Z-ADDEMPLOY EEEMPL 04160CSR USERID COMP BLK8 54 04170CSR 54 MOVE USERID EEUSER 04180CSR 55 MOVE 'A' EESTAT 04190CSR NAME COMP BLK20 54 04200CSR 54 MOVE NAME EENAME 04210CSR DEPT COMP 0 54 04220CSR 54 Z-ADDDEPT EEDEPT 04230CSR ENDSR 04240C******************************************************************** 04250CSR SR106 BEGSR ÐÐ04260C* EDIT MASTER. 04270CSR Z-ADD1 F 04280CSR EEREC COMP 'E' 54 RECORD CODE. 04290CSRN54 Z-ADD303 M 50 96 FLAG ERR. 04300CSRN54 GOTO END106 04310CSR Z-ADD2 F 04320CSR EEEMPL COMP 0 54 EMPLOYEE #. 04330CSRN54 Z-ADD308 M 96 04340CSRN54 GOTO END106 04350CSR Z-ADD3 F 04360CSR EEUSER COMP BLK8 54 USER-ID. 04370CSRN54 Z-ADD307 M 96 04380CSRN54 GOTO END106 04390CSR Z-ADD4 F 04400CSR EENAME COMP BLK20 54 EMPL NAME. 04410CSRN54 Z-ADD311 M 96 04420CSRN54 GOTO END106 04430CSR Z-ADD5 F 04440CSR EEDEPT COMP 0 54 DEPT #. 04450CSRN54 Z-ADD304 M 96 04460CSR END106 ENDSR 04470C******************************************************************** 04480CSR SR107 BEGSR 04490C* ADD USER/EMPLOYEE CROSS-REF RECORD. 04500CSR MOVE EEUSER W8A ÐÐ04510CSR EXSR SR84 GET EU MAST. 04520CSRN60N61 GOTO END107 ALREADY ON FILE 04530CSR 61 GOTO T107A DELETED. 04540CSR MOVE EEUSER EUUSER 04550CSR MOVE EEEMPL EUEMPL 04560CSR SETON 84 04570CSR EXCPT ADD EU MAST. 04580CSR SETOF 84 04590CSR GOTO END107 04600C*------------------------------------------------------------------- 04610CSR T107A TAG 04620CSR MOVE 'A' EUSTAT RECORD STATUS. 04630CSR MOVE EEEMPL EUEMPL 04640CSR EXSR SR85 REWRITE EUMAST. 04650CSR END107 ENDSR 04660C******************************************************************** 04670CSR SR108 BEGSR 04680C* DELETE EU MASTER. 04690CSR OLDUSE COMP BLK8 54 04700CSRN54 GOTO END108 04710CSR MOVE OLDUSE W8A 04720CSR EXSR SR84 GET EU MAST. 04730CSR 60 04740COR 61 GOTO END108 04750CSR MOVE 'D' EUSTAT RECORD STATUS. ÐÐ04760CSR EXSR SR85 REWRITE EUMAST. 04770CSR END108 ENDSR 04780C******************************************************************** 04790CSR SR109 BEGSR 04800C* GET CRT FILE. 04810CSR MOVE ' ' W2A 2 04820CSR EXITFZGMINX 04830CSR RLABL W2A 04840CSR MOVE W2A PORT 20 04850CSR PORT CHAINCRTFILE H9 04860CSR MOVELCREMPL W13A 13 04870CSR MOVEL'E' W14A 14 04880CSR MOVE W13A W14A 04890CSR W14A CHAINEMPLFILE 54 04900CSRN54 Z-ADDEEDEPT CRDEPT 50 04910CSR ENDSR 04920C******************************************************************** 04930CSR SR110 BEGSR 04940C* VERIFY USER. 04950CSR CREMPL COMP '95857' 54 04960CSR 54 GOTO END110 04970CSR CRDEPT COMP 0 54 04980CSRN54 Z-ADD304 M 96 04990CSRN54 GOTO END110 05000CSR MOVE 'H' A22,1 ÐÐ05010CSR MOVE CRDEPT W5A 5 05020CSR MOVEAW5A A22,2 05030CSR MOVEACREMPL A22,7 05040CSR MOVE ' ' A22,12 05050CSR MOVEAA22,1 W12A 12 05060CSR SETOF 61 05070CSR W12A CHAINDEPTFILE 60 05080CSRN60 DHSTAT COMP 'D' 61 05090CSR 60 05100COR 61 Z-ADD304 M 96 05110CSR 96 Z-ADD3 F 05120CSR END110 ENDSR 05130C******************************************************************** 05140CSR SR206 BEGSR 05150C* SEE IF USER CODE IS BEING USED. 05160CSR USERID COMP BLK8 54 05170CSRN54 GOTO END206 05180CSR MOVE USERID W8A 8 05190CSR EXSR SR84 GET EU MAST. 05200CSR 60 05210COR 61 GOTO END206 05220CSR EMPLOY COMP EUEMPL 54 05230CSR 54 GOTO END206 05240CSR Z-ADD312 M 96 05250CSR Z-ADD3 F ÐÐ05260CSR END206 ENDSR 05270O******************************************************************** 05280OTERM63 E 72 05290O* PROMPT. 05300O NUL 63 05310O BIT,28 1 05320O 2 '8' 05330O 61 5 '003' 05340O 62 5 '005' 05350O 63 5 '007' 05360O 64 5 '009' 05370O 65 5 '011' 05380O 8 '001' 05390O 61 32 'ENTER TRAN CODE (A,C,D) ' 05400O 62 32 'ENTER EMPLOYEE # ' 05410O 63 32 'ENTER USER-ID ' 05420O 64 32 'ENTER NAME ' 05430O 65 32 'ENTER DEPT # ' 05440O 33 ' ' 05450O 61 TTCODE 34 05460O 62 EMPLOYZ 38 05470O 63 USERID 41 05480O 64 NAME 53 05490O 65 DEPT Z 38 05500O BIT,28 56 ÐÐ05510O 57 '8' 05520O 61 60 '003' 05530O 62 60 '005' 05540O 63 60 '007' 05550O 64 60 '009' 05560O 65 60 '011' 05570O 63 '026' 05580O*------------------------------------------------------------------- 05590O E 74 05600O* ERROR MESSAGE. 05610O NUL 63 05620O BIT,28 1 05630O 2 '8' 05640O 8 '015090' 05650O MGTEXT 43 05660O 96 BIT,8 50 05670O*------------------------------------------------------------------- 05680O E 70 05690O* CLEAR CRT, PUT TITLE. 05700O 80 BIT,28 1 05710O 80 2 '8' 05720O 80 8 '001050' 05730O 80 28 'EMPLOYEE MAST UPDATE' 05740O******************************************************************** 05750OEMPLFILEEADD 81 ÐÐ05760O* ADD NEW MASTER. 05770O 1 'E' 05780O EEEMPL 6 05790O EEUSER 22 05800O EENAME 42 05810O EEDEPT 47 05820O 64 'A' 05830O*------------------------------------------------------------------- 05840O E 82 05850O* REWRITE MASTER. 05860O EEUSER 22 05870O EENAME 42 05880O EEDEPT 47 05890O EESTAT 64 05900O*------------------------------------------------------------------- 05910O EADD 84 05920O* ADD NEW USER MASTER. 05930O 1 'U' 05940O EUUSER 9 05950O EUEMPL 19 05960O 64 'A' 05970O*------------------------------------------------------------------- 05980O E 85 05990O* REWRITE USER MAST. 06000O EUEMPL 19 ÐÐ06010O EUSTAT 64 ** NUL ARRAY 006020 006030** A6 ARRAY 006040 006050** A22 ARRAY 006060 006070/* 006080_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(–ö –?X002EG P120282120282(èÈÐ00010H Q002EG00020F* UPDATE ENGINEERING TASK SCHED. (X002EG) 00030F* REVISED 4/29/80 12:30 PM. 00040FBITHEX IP F 256 DISK 00050FEGTABLE O F 1202 DISK 00060E********************************************************************* 00070E M1 12 60 1 A MAN 00080E N1 1 60 12 NAME 00090E M3 12 300 1 A MAN 00100E B3 3 300 4 0 START 00110E J3 12 300 1 JOB 00120E S3 12 300 1 SKILL 00130E E3 3 300 4 0 STOP 00140E H3 3 300 4 0 HRS 00150E P3 6 300 2 2 % 00160E J4 10 100 1 A JOB 00170E D4 1 100 12 DESCR 00180E W4 2 100 6 WO # 00190E J5 12 300 1 A JOB 00200E B5 3 300 4 0 START 00210E S5 12 300 1 SKILL 00220E H5 3 300 4 0 HRS 00230E E5 3 300 4 0 STOP 00240E P5 6 300 2 2 % 00250E S6 12 60 1 A SKILL ÐÐ00260E T6 1 60 12 TITLE 00270E BIT 256 1 00280IBITHEX BT 00290I 1 256 BIT 00300C MOVE ' ' BLK12 12 00310C MOVE BIT,1 M1 00320C MOVE BLK12 N1 00330C MOVE BIT,1 M3 00340C MOVE BIT,1 J3 00350C MOVE BIT,1 S3 00360C Z-ADD0 B3 00370C Z-ADD0 E3 00380C Z-ADD0 H3 00390C Z-ADD0 P3 00400C MOVE BIT,1 J4 00410C MOVE ' ' W4 00420C MOVE BLK12 D4 00430C MOVE BIT,1 J5 00440C Z-ADD0 B5 00450C MOVE BIT,1 S5 00460C Z-ADD0 E5 00470C Z-ADD0 H5 00480C Z-ADD0 P5 00490C MOVE BIT,1 S6 00500C MOVE BLK12 T6 ÐÐ00510C Z-ADD0 X 20 00520C START TAG 00530C 1 ADD X X 00540C X COMP 20 54 00550C 54 GOTO END 00560C EXSR SR101 00570C EXCPT 00580C GOTO START 00590C END TAG 00600CSR SR101 BEGSR 00610CSR X COMP 1 01 00620CSR X COMP 2 02 00630CSR X COMP 3 03 00640CSR X COMP 4 04 00650CSR X COMP 5 05 00660CSR X COMP 6 06 00670CSR X COMP 7 07 00680CSR X COMP 8 08 00690CSR X COMP 9 09 00700CSR X COMP 10 10 00710CSR X COMP 11 11 00720CSR X COMP 12 12 00730CSR X COMP 13 13 00740CSR X COMP 14 14 00750CSR X COMP 15 15 ÐÐ00760CSR X COMP 16 16 00770CSR X COMP 17 17 00780CSR X COMP 18 18 00790CSR X COMP 19 19 00800CSR X COMP 20 20 00810CSR ENDSR 00820OEGTABLE E 00830O X 2 00840O 01 M1 62 00850O 02 N1 722 00860O 03 M3 302 00870O 04 B3 1202 00880O 05 J3 302 00890O 06 S3 302 00900O 07 E3 1202 00910O 08 H3 1202 00920O 09 P3 602 00930O 10 J4 102 00940O 11 D4 1202 00950O 12 W4 602 00960O 13 J5 302 00970O 14 B5 1202 00980O 15 S5 302 00990O 16 H5 1202 01000O 17 E5 1202 ÐÐ01010O 18 P5 602 01020O 19 S6 62 01030O 20 T6 720 ** 001040 001050** 001060 001070** 001080 001090** 001100 001110** 001120 001130** 001140 001150** 001160 001170** 001180 001190** 001200 001210** 001220 001230** 001240 001250ÐÐ** 001260 001270** 001280 001290** 001300 001310** 001320 001330** 001340 001350** 001360 001370** 001380 001390** 001400 001410** 001420 001430/* 001440_‚ ÐÐ_‚_‚ 001260 001270** 001280 001290** 001300 001310** 001320 001330** 001340 001350** 001360 001370** 001380 001390** 001400 001410** 001420 001430/* 001440_‚ ÐÈ(&6 &æX014BM P999999030383(èÈÐ00010H Q014BM00020F* PRINT INDENTED PART LIST COMPLETE - SYST PRINTER (X014BM) 00030F* REV 9/03/81 5:00 PM. 00040F* 00050FBITTAB IP F 33 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FBMMAST ID F 86L20AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FPRINT O F 132 PRINTER 00100FTERM80 O F 80 5 00110E******************************************************************** 00120E NUL 50 50 1 NULL CHAR. 00130E N20 20 20 1 NULL CHAR. 00140E A6 6 6 1 00150E A12 12 12 1 A INPUT ARRAY. 00160E LEV 1 20 20 NEXT RRN AT EA LEVEL 00170E QTY 1 20 7 0 QTY MULTIPLIER 00180E BIT 33 1 BITTAB. 00190I******************************************************************** 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************** 00230IPMMST2 PM 00240I* PART MASTER RECORD (XPMMST) 00250I* KEY AREA ÐÐ00260I* PART NO. 12A 00270I 1 12 PMPN 00280I* NUMB OF COMPONENTS 3P 00290I P 13 140PMNOBM 00300I* PROD LINE 4N 00310I 15 180PMPL 00320I* MODEL NAME 12A 00330I 19 30 PMMODL 00340I* DESCRIPTION 29A 00350I 31 59 PMDESC 00360I* COMMODITY CODE 9P 00370I P 60 640PMCC 00380I* ENG CHANGE STATUS. 00390I* LAST ECN NO. 5A 00400I 65 69 PMECN 00410I* CUR CHG LEVEL 2A 00420I 70 71 PMECHG 00430I* CUR CHG DATE 6N 00440I 72 770PMDCHG 00450I* DRAWING INFO 00460I* RELEASE STATUS 1A 00470I* E = ENG ONLY 00480I* M = REL TO MFG 00490I* P = PROTOTYPE 00500I* X = PRE-RELEASE ÐÐ00510I 78 78 PMDREL 00520I* DWG SIZE 1A 00530I 82 82 PMSIZ 00540I* DWG CLASS 1A 00550I* D = DYNAIR DWG 00560I* V = VENDOR DWG 00570I 83 83 PMDCLS 00580I* STANDARD CODE 1A 00590I 84 84 PMSTDC 00600I* UNIT MEAS 2A 00610I* EA = EACH OC = OUNCE 00620I* ST = SET TC = TROY OUNCE 00630I* IN = INCH LB = POUND 00640I* FT = FEET PT = PINT 00650I* YD = YARD QT = QUART 00660I* SI = SQ.INCH GL = GALLON 00670I* SF = SQ.FEET DR = DRUM 00680I* SY = SQ.YARD 00690I 85 86 PMUM 00700I***** UNIT MEAS CONVERSION. 00710I***** UM MULTIPLIER 7.2P 00720I***** P 107 1102PMUMM 00730I***** UM CONVERTER 1A 00740I***** M = MULTIPLY 00750I***** D = DIVIDE ÐÐ00760I***** 111 111 PMUMC 00770I***** SET/DRUM UM 2A 00780I***** 112 113 PMUMUM 00790I* SOURCE CODE 2A 00800I* MA = MFG ASSY 00810I* MP = MFG PART 00820I* PA = PURCH ASSY 00830I* PP = PURCH PART 00840I* RS = RAW STOCK 00850I* RD = REF DOCUMENT 00860I 94 95 PMSC 00870I* PROVISIONING CODE 1A 00880I* A = FORECAST,NO VALUE ADDED 00890I* B = FORECAST,VALUE ADDED 00900I* C = FRCST-BUILD TO ORDER 00910I* D = NON-FRCST-BUILD TO ORDER 00920I* E = CUSTOM 00930I* Y = OBSOLETE,REPAIRABLE 00940I* Z = OBSOLETE,NOT REPAIRABLE 00950I 96 96 PMPROV 00960I* ISSUE CODE 2A 00970I* PT = PULL TIME 00980I* OR = ON REQUEST 00990I* BI = BULK ISSUE 01000I* AR = AS REQUIRED ÐÐ01010I* VS = VENDOR SUPPLIED 01020I* SD = SHIPPING DOCUMENT 01030I* TD = TRAV DOCUMENT 01040I* RD = REF DOCUMENT 01050I* RA = REF ASSY 01060I 97 98 PMISSU 01070I* DELIVER TO DEPT 5P 01080I P 99 1010PMDEL 01090I* RESPONSIBILITY CODES 01100I* ENGR CODE 2A 01110I 102 103 PMEGR 01120I* PLANNER CODE 2A 01130I 104 105 PMPLNR 01140I* BUYER CODE 2A 01150I 106 107 PMBUYR 01160I* SALESMAN CODE 2A 01170I 108 109 PMSLSM 01180I* INVENTORY ACCOUNT 5P 01190I P 110 1120PMACNT 01200I* FAB CODE 2A 01210I 487 488 PMFABC 01220I* RECORD STATUS 1A 01230I* D = DELETED 01240I 674 674 PMSTAT 01250I******************************************************************** ÐÐ01260IBMMAST BM 01270I* BILL OF MATERIAL RECORD 01280I* KEY AREA 01290I* ASSY PART NO. 10N 01300I 1 100BMAPN 01310I* COMPONENT PART # 10N 01320I 11 200BMCPN 01330I* ITEM NO. 3N 01340I 25 270BMITNO 01350I* QTY PER ASSY 7P 01360I P 28 310BMQTY 01370I* SCRAP ALLOW .2N 01380I 34 352BMSCRP 01390I* ISSUE CODE 2A 01400I* PT = PULL TIME 01410I* OR = ON REQUEST 01420I* BI = BULK ISSUE 01430I* AR = AS REQUIRED 01440I* RA = REF ASSY 01450I* TD = TRAV DOC 01460I* SD = SHIP DOC 01470I* RD = REF DOC 01480I* VS = VENDOR SUPPLIED 01490I 36 37 BMISSU 01500I* EFFECTIVITY. ÐÐ01510I* BEGIN CHANGE LEVEL 2A 01520I 38 39 BMBCHG 01530I* ENDING CHANGE LEVEL 2A 01540I 40 41 BMECHG 01550I* BEGIN ECN # 5A 01560I 42 46 BMBECN 01570I* ENDING ECN # 5A 01580I 47 51 BMEECN 01590I* DISPOSITION CODE 1A 01600I* U = USE UP OLD STYLE 01610I* N = NOW (IMMEDIATE) 01620I 52 52 BMDISP 01630I* FILLER 5A 53 57 FFFFFF 01640I* ROUTING. 01650I* OPER NO. 5P 01660I P 58 600BMOPER 01670I* DEPT NO. 5P 01680I P 61 630BMDEPT 01690I* WORK CENTER NO. 3P 01700I P 64 650BMWC 01710I* COMPONENT OPER REFERENCE INFO 10A 01720I 66 75 BMREF 01730I* FILLER 10A 76 85 FFFFFF 01740I* 01750I* RECORD STATUS 1A ÐÐ01760I* D = DELETED 01770I 86 86 BMSTAT 01780I******************************************************************** 01790IMGFILE MG 01800I* MESSAGE FILE. 01810I* TEXT 35A 01820I 1 35 MGTEXT 01830I* LINE-2 35A 01840I 36 70 MGLIN2 01850I* PROG NAME 5A 01860I 71 75 MGPROG 01870C******************************************************************** 01880C* INITIALIZE 01890C EXSR SR101 INIT 01900C*---------------------------------------------------------------- 01910C START TAG 01920C* GET ASSY PART NO FROM TERMINAL 01930C SETOF 9693 01940C Z-ADD185 M 50 MSG # 01950C EXSR SR73 PROMPT 01960C EXSR SR75 READ 01970C 96 GOTO START ERROR 01980C 98 GOTO END ABORT 01990C 94 GOTO END RET TO END 02000C 93 GOTO START NEW ITEM REQST ÐÐ02010C N77 GOTO START NO INPUT 02020C Z-ADD12 W2N 20 02030C EXIT SUBRAJ R. JUSITFY 02040C RLABL W2N 02050C RLABL W12A 02060C MOVE W12A TAPN 100 TOP ASSY PN 02070C MOVE BLK12 W12A 02080C MOVELTAPN W12A 02090C EXSR SR81 GET PMMST2 02100C N60 GOTO TAG10 GOT IT 02110C Z-ADD302 M 96 FLAG ERROR 02120C EXSR SR73 PUT MSG 02130C GOTO START 02140C*-------------------------------------------------------------------- 02150C TAG10 TAG 02160C* FLAG NO COMPONENTS ON FILE 02170C PMNOBM COMP 0 55 02180C N55 Z-ADD316 M 50 02190C N55 EXSR SR73 PUT ERR MSG 02200C N55 GOTO START 02210C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02220C Z-ADD1 QTY,2 QTY MULTIPLIER 02230C SETON 89 02240C EXSR SR71 PUT HEADING 02250C SETOF 89 ÐÐ02260C* SET-UP INITIAL BILL MATERIAL READ 02270C Z-ADD3 L 20 INDENTURE LEVEL 02280C MOVE BLK20 LEV 02290C MOVELTAPN LEV,2 02300C*----------------------------------------------------------------- 02310C TAG20 TAG 02320C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02330C L SUB 1 L 54 INDENT LEVEL 02340C N54 GOTO ENDASY BOTTOM INDENT 02350C LEV,L COMP BLK20 54 02360C N54 GOTO TAG20 NONE THIS LEVEL 02370C MOVE LEV,L W20A 20 02380C MOVELLEV,L CURASY 100 MATCH PART # 02390C MOVE BLK20 LEV,L 02400C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02410C*------------------------------------------------------------------ 02420C TAG30 TAG 02430C* SET-UP NEXT READ 02440C W20A SETLLBMMAST 02450C*--------------------------------------------------------------- 02460C TAG40 TAG 02470C* GET NEXT COMPONENT. 02480C SETOF 54 02490C READ BMMAST 54GET COMPONENT 02500C 54 GOTO TAG20 END OF FILE ÐÐ02510C BMAPN COMP CURASY 54 02520C N54 GOTO TAG20 WRONG ASSY 02530C BMSTAT COMP 'D' 54 02540C 54 GOTO TAG40 DELETED RECORD 02550C* DISPLAY COMPONENT DATA 02560C EXSR SR72 DISPLAY DATA 02570C 98 GOTO END 02580C 94 GOTO END 02590C 93 GOTO START 02600C* BRANCH IF NOT ASSY 02610C PMNOBM COMP 0 54 02620C N54 GOTO TAG40 NOT ASSY 02630C*------------------------------------------------------------------ 02640C TAG50 TAG 02650C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02660C MOVELBMAPN LEV,L 02670C 1 ADD BMCPN W10N 100 02680C MOVE W10N LEV,L 02690C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02700C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02710C MOVE BMCPN CURASY 02720C MOVELBMCPN W20A 02730C MOVE ZERO10 W20A 02740C 1 ADD L L INDENT LEVEL 02750C GOTO TAG30 ÐÐ02760C*------------------------------------------------------------------ 02770C ENDASY TAG 02780C* END OF ASSY PROMPT 02790C EXSR SR76 END ASSY PROMPT 02800C*----------------------------------------------------------------- 02810C END TAG 02820C* LINK TO NEXT PROG 02830C*------------------------------------------------------------------ 02840C ENDJOB TAG 02850C******************************************************************** 02860CSR SR71 BEGSR 02870C* CLEAR CRT. PUT HEADINGS. 02880CSR Z-ADD4 COUNT 30 LINE COUNT 02890CSR MOVELTAPN W12A 02900CSR MOVE ' ' W12A 02910CSR EXSR SR81 GET TOP-ASSY PMMST2 02920CSR SETON 71 02930CSR EXCPT PUT HEADING 02940CSR SETOF 71 02950CSR SETON 75 02960CSR EXCPT PUT TOP ASSY DATA 02970CSR SETOF 75 02980CSR ENDSR 02990C******************************************************************** 03000CSR SR72 BEGSR ÐÐ03010C* DISPLAY DATA LINE TO CRT. 03020CSR 1 ADD COUNT COUNT 03030CSR MOVE BLK12 W12A 03040CSR MOVELBMCPN W12A COMP PN 03050CSR EXSR SR81 GET PMMST2 03060CSR L COMP 1 0101 03070CSR L COMP 2 02 03080CSR L COMP 3 03 03090CSR L COMP 4 04 03100CSR L COMP 5 05 03110CSR L COMP 6 06 03120CSR L COMP 7 07 07 03130CSR 01 Z-ADD1 L 03140CSR BMISSU COMP ' ' 55 03150CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03160CSR SETON 72 03170CSR EXCPT PUT DATA. 03180CSR SETOF 72 03190CSR COUNT COMP 60 54 54 03200CSRN54 GOTO END72 NOT END PAGE 03210CSR EXSR SR71 PUT HEADINGS 03220CSR END72 ENDSR 03230C******************************************************************** 03240CSR SR73 BEGSR 03250C* PUT PROMPT TO CRT. ÐÐ03260CSR EXSR SR89 03270CSR 54 MOVELM MGTEXT 03280CSR 2 ADD COUNT COUNT 03290CSR SETON 73 03300CSR EXCPT PUT PROMPT. 03310CSR SETOF 73 03320CSR ENDSR 03330C******************************************************************** 03340CSR SR75 BEGSR 03350C* READ CRT. 03360CSR T75 TAG 03370CSR SETOF 909493 03380CSR SETOF 7796 03390CSR MOVE BIT,7 A6,2 03400CSR MOVEAA6 W6A 6 03410CSR MOVE BLK12 W12A 12 03420CSR EXITFXCREAD 03430CSR RLABL W12A 03440CSR RLABL W6A 03450CSR MOVEAW12A A12 03460CSR MOVE BLK12 W12A 03470CSR Z-ADD1 W 20 03480CSR '\' LOKUPA12,W 90 03490CSRN90 GOTO T75A NOT ESC. 03500CSR 1 ADD W W ÐÐ03510CSR W COMP 12 54 03520CSR 54 GOTO T75C BAD ESC. 03530CSR A12,W COMP 'E' 94 EXIT. 03540CSR A12,W COMP 'N' 93 NEW ASSY. 03550CSR A12,W COMP 'G' 98 END 03560CSRN94N93N98 GOTO T75C BAD ESCAPE 03570CSR GOTO T75Z 03580C*------------------------------------------------------------------- 03590CSR T75A TAG 03600CSR Z-ADD1 W 03610CSR ' ' LOKUPA12,W 77 03620CSR 77 MOVEAA12,W W12A INPUT DATA. 03630CSR GOTO T75Z 03640C*------------------------------------------------------------------- 03650CSR T75C TAG 03660C* FLAG BAD ESCAPE. 03670CSR Z-ADD318 M 96 03680CSR EXSR SR73 FLAG ERROR. 03690CSR GOTO T75 03700C*--------------------------------------------------------------------- 03710CSR T75Z TAG 03720CSR END75 ENDSR 03730C******************************************************************** 03740CSR SR76 BEGSR 03750C* END OF ASSY PROMPT/READ. ÐÐ03760CSR Z-ADD317 M 03770CSR EXSR SR73 PUT MSG. 03780CSR ENDSR 03790C******************************************************************** 03800CSR SR81 BEGSR 03810C* GET PART MAST. 03820CSR SETOF 61 03830CSR W12A CHAINPMMST2 60 GET PMMST. 03840CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR89 BEGSR 03880C* GET MGFILE. 03890CSR M CHAINMGFILE 54 GET MGFILE. 03900CSR 54 MOVE BLK35 MGTEXT 03910CSR 54 MOVELM MGTEXT 03920CSR 54 MOVE 'NO MSG' MGTEXT 03930CSR ENDSR 03940C******************************************************************** 03950CSR SR101 BEGSR 03960C* INITIALIZE (1-TIME). 03970CSR MOVE BIT,1 N20 03980CSR MOVE BIT,1 A6 03990CSR MOVE BIT,1 NUL INIT NULL CHAR. 04000CSR MOVE ' ' BLK35 35 ÐÐ04010CSR MOVE ' ' BLK12 12 04020CSR MOVE ' ' BLK20 20 04030CSR Z-ADD0 ZERO10 100 04040CSR ENDSR 04050O**************************************************************** 04060OTERM80 E 73 04070O NUL 80 04080O MGTEXT 35 04090O 37 ' ' 04100O 96 BIT,8 80 04110O******************************************************************** 04120OPRINT E 72 04130O* DATA LINE. 04140O 11 '.' 04150O 14 '.' 04160O 17 '.' 04170O 20 '.' 04180O 23 '.' 04190O 26 '.' 04200O 29 '.' 04210O 02 29 ' ' 04220O 03 29 ' ' 04230O L Z 2 04240O BMITNOZ 8 04250O 01 BMCPN 22 ' - - ' ÐÐ04260O 02 BMCPN 25 ' - - ' 04270O 03 BMCPN 28 ' - - ' 04280O 04 BMCPN 31 ' - - ' 04290O 05 BMCPN 34 ' - - ' 04300O 06 BMCPN 37 ' - - ' 04310O 07 BMCPN 40 ' - - ' 04320O PMDESC 71 04330O BMQTY 2 82 04340O PMUM 86 04350O PMSC 92 04360O PMISSU 98 04370O 55 BMISSU 98 04380O PMPROV 103 04390O EXTQTY2 115 04400O PMSTDC 119 04410O PMFABC 125 04420O*------------------------------------------------------------------- 04430O E 75 04440O* PUT TOP ASSY LINE. 04450O 2 '1' 04460O TAPN 22 ' - - ' 04470O N89 29 'CONT''D' 04480O PMDESC 71 04490O 82 '1' 04500O PMUM 86 ÐÐ04510O PMISSU 98 04520O PMSC 92 04530O PMPROV 103 04540O 115 '1' 04550O PMSTDC 119 04560O PMFABC 125 04570O*------------------------------------------------------------------- 04580O E 201 71 04590O* CLEAR SCREEN - LINE-1. 04600O 71 'INDENTED PARTS LIST' 04610O 79 'ASSY=' 04620O TAPN 91 ' - - ' 04630O*------------------------------------------------------------------- 04640O E 71 04650O* HEADING, LINE-2. 04660O 26 '--------------INDENTURE' 04670O 40 '--------------' 04680O 82 'QUANTITY' 04690O 94 'SOURCE' 04700O 100 'ISSUE' 04710O 105 'PROV' 04720O 115 'EXTENDED' 04730O 120 'STD' 04740O 126 'FAB' 04750O*------------------------------------------------------------------- ÐÐ04760O E 71 04770O* HEADING, LINE-3. 04780O 3 'LEV' 04790O 8 'ITEM' 04800O 29 '1 2 3 4 5 6 7' 04810O 32 '-UP' 04820O 53 'DESCRIPTION' 04830O 82 'PER-ASSY' 04840O 86 'UM' 04850O 93 'CODE' 04860O 99 'CODE' 04870O 105 'CODE' 04880O 115 'QUANTITY' 04890O 121 'CODE' 04900O 127 'CODE' 04910O E 71 04920O* HEADING, LINE-4 (BLANK). ** NUL ARRAY 004930 004940** N20 ARRAY 004950 004960** A6 ARRAY 004970 004980** A12 ARRAY 004990 005000ÐÐ** LEV ARRAY 005010 005020** QTY ARRAY 005030 005040/* 005050_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È1 ÈTX025EG P999999120282(èÈÐ00010H Q025EG00020F* CREATE MFR PART NO. / DYNAIR PART NO. CROSS REF FILE 00030F* 00040FEGMAST IP F 100 10AI 1 DISK 00050FEGMFRPN IC F 40R DISK 00060FMFRPNEG O F 40 DISK 00070F**************************************************************** 00080E EXT 40 2 A 00090E EGT 10 5 0A 00100E EGM 15 5 0A 00110I******************************************************************** 00120IEGMAST EG 00130I* ENGR STD MASTER 00140I* PART NO. 10N 00150I 1 100EGPN 00160I* STANDARDS CODE 6A 00170I 11 16 EGSTD 00180I* INSPECTION CODE 5A 00190I 17 21 EGINSP 00200I* TEXT RRN'S 5P X 10 00210I P 22 51 EGT 00220I* PART NO. CROSS-REF RRN'S 5P X 15 00230I P 52 96 EGM 00240I* RECORD STATUS 1A 00250I 100 100 EGSTAT ÐÐ00260I*********************************************************** 00270IEGMFRPN EP 00280I* ENG STD DYNAIR/MFR PART-NO CROSS REF. 00290I* MFR CODE 5A 00300I 1 5 EPMFR 00310I* MFR PART NO. 24A 00320I 6 29 EPMPN 00330I* DYNAIR PART NO. 10N 00340I 30 39 EPPN 00350I* RECORD STATUS 1A 00360I 40 40 EPSTAT 00370C****************************************************************** 00380C EGSTAT COMP 'D' 54 00390C 54 GOTO END 00400C Z-ADD1 X 50 00410C*------------------------------------------------------------- 00420C START TAG 00430C 00000 LOKUPEGM,X 54 00440C N54 GOTO END 00450C EGM,X CHAINEGMFRPN 54 00460C Z-ADD0 EGM,X 00470C N54 SETON 80 00480C N54 EXCPT 00490C SETOF 80 00500C GOTO START ÐÐ00510C*---------------------------------------------------------------- 00520C END TAG 00530O***************************************************************** 00540OMFRPNEG E 80 00550O EPMPN 24 00560O EPPN 34 00570O EPMFR 39 /* 00580_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(†  ZPRGSRT3 P120282120282(èÈÐ * ZPRGSRT3- SORT PROGNAME FILE - BATCH JOBS 00010INPUT=ZPRGSRT3 00020DSORT 00030FN=PROGNAM, 00040F2=PROGBAT,,D1 00050OP=TAG,F,A 00060KF=A,60,4,A,1,6 00070SL=INCLUDE,51,1,NE,' ' 00080 * END ZPRGSRT3. 00090_‚ _‚_‚ ÐÈ( ¼X002EU P120282120282(èÈÐ00010H Q002EU00020F* UPDATE EMPLOYEE FILE - EMPLOYEE/USER RECORD. (X002EU) 00030F* NOTE: EMPLFILE IS NORMALLY UPDATED BY Q002EE. 00040F* REVISED 4/23/80 9:45 AM. DG-REL006 OK. 00050F* 00060FBITTAB IP F 33 DISK 00070FEMPLFILEUC F 64R14AI 1 DISK A 00080FDEPTFILEIC F 32R12AI 1 DISK 00090FJOBFILE IC F 48R 7AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FTERM63 O F 63 5 00120E******************************************************************** 00130E NUL 1 63 1 00140E A6 1 6 1 00150E A10 1 10 1 A 00160E BIT 33 1 00170I******************************************************************** 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************** 00210IEMPLFILEEE 54 1 CE 00220I* RECORD CODE 2A 00230I* E = EMPLOYEE/USER CROSS-REF 00240I* U = USER/EMPLOYEE CROSS-REF 00250I* J = EMPLOYEE/JOB ÐÐ00260I 1 1 EEREC 00270I* EMPLOYEE # 5N 00280I 2 60EEEMPL 00290I* USER-ID 8A 00300I 15 22 EEUSER 00310I* EMPLOYEE NAME 20A 00320I 23 42 EENAME 00330I* EMPLOYEE DEPT # 5N 00340I 43 470EEDEPT 00350I* RECORD STATUS 1A 00360I 64 64 EESTAT 00370I*------------------------------------------------------------------- 00380I EU 54 1 CU 00390I 1 1 EUREC 00400I 2 9 EUUSER 00410I 15 190EUEMPL 00420I 64 64 EUSTAT 00430I*------------------------------------------------------------------- 00440I EJ 54 1 CJ 00450I 1 1 EJREC 00460I 2 60EJEMPL 00470I 7 90EJSEQ 00480I 15 49 EJDESC 00490I 50 55 EJJOB 00500I 64 64 EJSTAT ÐÐ00510I******************************************************************** 00520IDEPTFILEDH 54 1 CH 00530I* RECORD CODE 1A 00540I* H = DEPT HEAD RECORD 00550I* J = DEPT JOB RECORD 00560I 1 1 DHREC 00570I* DEPT # 5N 00580I 2 60DHDEPT 00590I* DEPT HEAD EMPLOYEE # 5N 00600I 7 110DHEMP 00610I* RECORD STATUS 1A 00620I 32 32 DHSTAT 00630I*------------------------------------------------------------------- 00640I DJ 54 1 CJ 00650I* RECORD CODE 1A 00660I 1 1 DJREC 00670I* DEPT # 5N 00680I 2 60DJDEPT 00690I* SEQ # 3N 00700I 7 90DJSEQ 00710I* JOB CODE 6A 00720I 13 18 DJJOB 00730I* RECORD STATUS 1A 00740I 32 32 DJSTAT 00750I******************************************************************** ÐÐ00760IJOBFILE JN 54 1 CN 00770I* RECORD CODE 1A 00780I* N = JOB NAME RECORD 00790I* C = JOB CODE RECORD 00800I 1 1 JNREC 00810I* JOB NAME 6A 00820I 2 7 JNJOB 00830I* JOB DESCRIPTION 35A 00840I 8 42 JNDESC 00850I* RECORD STATUS 1A 00860I 48 48 JNSTAT 00870I******************************************************************** 00880IMGFILE MG 00890I* MESSAGE FILE 00900I* TEXT 35A 00910I 1 35 MGTEXT 00920I* LINE-2 35A 00930I 36 70 MGLIN2 61 00940I* PROG NAME 5A 00950I 71 75 MGPROG 00960C******************************************************************** 00970C START TAG 00980C* INITIALIZE - CLEAR - PUT HEADINGS. 00990C EXSR SR101 INIT. 01000C*------------------------------------------------------------------- ÐÐ01010C CONTU TAG 01020C* READ DATA FROM CRT. 01030C SETOF 949677 01040C 1 ADD F F 30 FIELD #. 01050C F COMP 3 54 01060C 54 GOTO UPDATE 01070C EXSR SR75 READ,ETC. 01080C 94 'H' LOKUPA10 54 01090C 94 54 GOTO START 01100C 94 GOTO END EXIT. 01110C N77 GOTO CONTU NO INPUT. 01120C EXSR SR102 IDENTIFY-F. 01130C 61 MOVELW10A TTCODE 1 TRAN CODE. 01140C 62 MOVE W10A EMPLOY 50 EMPLOY #. 01150C 63 MOVELW10A USERID 8 USER-ID. 01160C 62 EXSR SR206 VERIFY EMPLOY. 01170C 96 GOTO ERROR 01180C SETON 75 01190C EXCPT PROMPT. 01200C SETOF 75 01210C GOTO CONTU 01220C*------------------------------------------------------------------- 01230C UPDATE TAG 01240C EXSR SR103 CLASSIFY TRAN. 01250C 60 GOTO ADD ADD TRAN. ÐÐ01260C 62 GOTO DELETE DELETE TRAN. 01270C* FLAG INVALID TRANS CODE. 01280C Z-ADD1 F 01290C Z-ADD300 M 50 96 MSG #. 01300C GOTO ERROR 01310C*------------------------------------------------------------------- 01320C ADD TAG 01330C* ADD TRANS. 01340C EXSR SR80 GET MAST. 01350C 60 GOTO NOFILE NOT ON FILE. 01360C 61 GOTO DELFIL DELETED. 01370C* FLAG DUPLICATE ADD. 01380C Z-ADD1 F 01390C Z-ADD301 M 96 01400C GOTO ERROR 01410C*------------------------------------------------------------------- 01420C NOFILE TAG 01430C* ADD--- NOT ON FILE. 01440C EXSR SR104 INIT MAST. 01450C EXSR SR105 MOVE DATA. 01460C EXSR SR106 EDIT. 01470C 96 GOTO ERROR ERROR. 01480C MOVE EMPLOY EEEMPL EMPLOYEE #. 01490C EXSR SR81 ADD NEW MAST. 01500C GOTO START ÐÐ01510C*------------------------------------------------------------------- 01520C DELFIL TAG 01530C* ADD--- DELETED MAST. 01540C EXSR SR105 MOVE DATA. 01550C EXSR SR106 EDIT. 01560C 96 GOTO ERROR ERROR. 01570C MOVE 'A' EESTAT RECORD STATUS. 01580C EXSR SR82 REWRITE MAST. 01590C GOTO START 01600C*------------------------------------------------------------------- 01610C DELETE TAG 01620C* DELETE TRANS. 01630C EXSR SR80 GET MAST. 01640C N60N61 GOTO DELOK GOT IT. 01650C* FLAG NO MAST ERROR. 01660C Z-ADD1 F 01670C Z-ADD302 M 96 MSG #. 01680C GOTO ERROR ERROR. 01690C*------------------------------------------------------------------- 01700C DELOK TAG 01710C MOVE 'D' EESTAT RECORD STATUS. 01720C EXSR SR82 REWRITE MAST. 01730C GOTO START 01740C*------------------------------------------------------------------- 01750C ERROR TAG ÐÐ01760C EXSR SR73 PUT MSG. 01770C F SUB 1 F 01780C GOTO CONTU 01790C*------------------------------------------------------------------- 01800C END TAG 01810C MOVEL'CONTU' PROG 8 01820C EXITFCHAIN 01830C RLABL PROG 01840C******************************************************************** 01850CSR SR70 BEGSR 01860C* CLEAR CRT. 01870CSR EXITFQTOPF CLEAR CRT. 01880CSR ENDSR 01890C******************************************************************** 01900CSR SR72 BEGSR 01910C* PUT PROMPT TO CRT. 01920CSR SETON 72 01930CSR EXCPT PROMPT. 01940CSR SETOF 72 01950CSR ENDSR 01960C******************************************************************** 01970CSR SR73 BEGSR 01980C* PUT ERROR MESSAGE. 01990CSR EXSR SR89 GET MGFILE. 02000CSR EXSR SR74 PUT MSG. ÐÐ02010CSR ENDSR 02020C******************************************************************** 02030CSR SR74 BEGSR 02040C* PUT MSG. 02050CSR EXSR SR102 IDENTIFY-F. 02060CSR SETON 74 02070CSR EXCPT PUT MSG. 02080CSR SETOF 74 02090CSR ENDSR 02100C******************************************************************** 02110CSR SR75 BEGSR 02120C* READ DATA FROM TERMINAL. 02130CSR MOVE BLK10 W10A 10 02140CSR EXSR SR102 IDENTIFY-F. 02150CSR SETON 75 02160CSR EXCPT PUT PROMPT. 02170CSR SETOF 75 02180CSR MOVE BIT,6 A6,2 BUF LGTH. 02190CSR MOVEAA6 W6A 6 02200CSR EXITFXCREAD READ CRT. 02210CSR RLABL W10A BUFFER. 02220CSR RLABL W6A BUF LGTH. 02230CSR MOVEAW10A A10 02240CSR MOVE BLK10 W10A 02250CSR '\' LOKUPA10 94 ÐÐ02260CSR 94 GOTO END75 02270CSR Z-ADD1 W 30 02280CSR ' ' LOKUPA10,W 77 02290CSRN77 GOTO END75 02300CSR MOVEAA10,W W10A 02310CSR F COMP 2 54 02320CSRN54 GOTO END75 NOT NUMERIC. 02330CSR Z-ADD10 W2N 20 02340CSR EXIT SUBRAJ RIGHT JUSTIFY. 02350CSR RLABL W2N 02360CSR RLABL W10A 02370CSR MOVE W10A W10N 100 02380CSR MOVE 'Z' EDIT 1 02390CSR EXIT SUBRED 02400CSR RLABL W10N 02410CSR RLABL EDIT 02420CSR RLABL W10A 02430CSR RLABL W2N 02440C*------------------------------------------------------------------- 02450CSR END75 TAG 02460CSR MOVE BLK35 MGTEXT 02470CSR EXSR SR74 INIT ERR MSGS. 02480CSR ENDSR 02490C******************************************************************** 02500CSR SR80 BEGSR ÐÐ02510C* GET MAST. 02520CSR MOVE BLK13 W13A 13 02530CSR MOVEL'U' W14A 14 02540CSR MOVELUSERID W13A 02550CSR MOVE W13A W14A 02560CSR SETOF 6061 02570CSR W14A CHAINEMPLFILE 60 02580CSRN60 EUSTAT COMP 'D' 61 02590CSR ENDSR 02600C******************************************************************** 02610CSR SR81 BEGSR 02620C* ADD NEW MAST. 02630CSR SETON 81 02640CSR EXCPT ADD MAST. 02650CSR SETOF 81 02660CSR ENDSR 02670C******************************************************************** 02680CSR SR82 BEGSR 02690C* REWRITE MAST. 02700CSR SETON 82 02710CSR EXCPT REWRITE MAST. 02720CSR SETOF 82 02730CSR ENDSR 02740C******************************************************************** 02750CSR SR89 BEGSR ÐÐ02760C* GET MGFILE. 02770CSR M CHAINMGFILE 60 02780CSR 60 MOVE BLK35 MGTEXT 02790CSR 60 MOVELM MGTEXT 02800CSR 60 MOVE 'NO-FILE' MGTEXT 02810CSR ENDSR 02820C******************************************************************** 02830CSR SR101 BEGSR 02840C* INITIALIZE. 02850CSR Z-ADD0 F 02860CSR MOVE BIT,1 NUL 02870CSR MOVE BIT,1 A6 02880CSR EXSR SR70 CLEAR CRT. 02890CSR MOVE ' ' BLK13 13 02900CSR MOVE ' ' BLK8 8 02910CSR MOVE ' ' BLK35 35 02920CSR MOVE ' ' BLK10 10 02930CSR Z-ADD0 EMPLOY 02940CSR MOVE BLK8 USERID 02950CSR ENDSR 02960C******************************************************************** 02970CSR SR102 BEGSR 02980C* IDENTIFY FIELD #. 02990CSR F COMP 1 61 TRAN CODE. 03000CSR F COMP 2 62 USER-ID. ÐÐ03010CSR F COMP 3 63 EMPLOYEE #. 03020CSR ENDSR 03030C******************************************************************** 03040CSR SR103 BEGSR 03050C* CLASSIFY TRANS. 03060CSR TTCODE COMP 'A' 60 ADD 03070CSR TTCODE COMP 'D' 62 DELETE 03080CSR ENDSR 03090C******************************************************************** 03100CSR SR104 BEGSR 03110C* INIT MAST. 03120CSR Z-ADD0 EUEMPL 03130CSR MOVE BLK8 EUUSER 03140CSR MOVE 'U' EUREC 03150CSR MOVE 'A' EUSTAT 03160CSR ENDSR 03170C******************************************************************** 03180CSR SR105 BEGSR 03190C* MOVE DATA. 03200CSR USERID COMP BLK8 54 03210CSR 54 MOVE USERID EUUSER 03220CSR EMPLOY COMP 0 54 03230CSR 54 Z-ADDEMPLOY EUEMPL 03240CSR ENDSR 03250C******************************************************************** ÐÐ03260CSR SR106 BEGSR 03270C* EDIT MAST. 03280CSR Z-ADD1 F 03290CSR EUREC COMP 'U' 54 03300CSRN54 Z-ADD303 M 50 96 MSG #. 03310CSRN54 GOTO END106 03320CSR Z-ADD2 F 03330CSR EUUSER COMP BLK8 54 03340CSRN54 Z-ADD307 M 96 03350CSRN54 GOTO END106 03360CSR Z-ADD3 F 03370CSR EUEMPL COMP 0 54 03380CSRN54 Z-ADD308 M 96 03390CSRN54 GOTO END106 03400CSR END106 ENDSR 03410C******************************************************************** 03420CSR SR206 BEGSR 03430C* SEE IF EMPLOYEE IS ON FILE. 03440CSR SETOF 6061 03450CSR MOVEL'E' W14A 14 03460CSR MOVE BLK13 W13A 13 03470CSR MOVELEMPLOY W13A 03480CSR MOVE W13A W14A 03490CSR W14A CHAINEMPLFILE 60 03500CSRN60 EESTAT COMP 'D' 61 ÐÐ03510CSRN60N61 GOTO END206 03520CSR Z-ADD308 M 96 03530CSR END206 ENDSR 03540O******************************************************************** 03550OTERM63 E 70 03560O* CLEAR CRT. 03570O 63 'EMPLOYEE/USER UPDATE' 03580O*------------------------------------------------------------------- 03590O E 75 03600O* PROMPT. 03610O NUL 63 03620O BIT,28 1 03630O 2 '8' 03640O 61 5 '003' 03650O 62 5 '005' 03660O 63 5 '007' 03670O 8 '001' 03680O 61 32 'ENTER TRANS CODE (A,C,D)' 03690O 62 32 'ENTER USER-ID ' 03700O 63 32 'ENTER EMPLOYEE # ' 03710O 34 ' ' 03720O 61 TTCODE 35 03730O 62 USERID 42 03740O 63 EMPLOY 39 03750O BIT,28 45 ÐÐ03760O 46 '8' 03770O 61 49 '003' 03780O 62 49 '005' 03790O 63 49 '007' 03800O 52 '027' 03810O*------------------------------------------------------------------- 03820O E 74 03830O* ERR MESSAGE. 03840O NUL 63 03850O BIT,28 1 03860O 2 '8' 03870O 8 '009090' 03880O MGTEXT 43 03890O 96 BIT,8 44 03900O******************************************************************** 03910OEMPLFILEEADD 81 03920O* ADD NEW MASTER. 03930O 1 'U' 03940O EUUSER 9 03950O EUEMPL 19 03960O 64 'A' 03970O*------------------------------------------------------------------- 03980O E 82 03990O* REWRITE MAST. 04000O EUEMPL 19 ÐÐ04010O EUSTAT 64 ** NUL ARRAY 004020 004030** A6 ARRAY 004040 004050** A10 ARRAY 004060 004070/* 004080_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(2PW 2X901CD PÌÌ042283042283(èÈÐ00010H Q901CD00020F* LOAD INDEXED COMMODITY MASTER FROM TEXT FILE 00030F* REVISED 06-09-83 12:30 PM 00040F* 00050FCDTTEXT IP F 80 DISK 00060FCDTDESC UC F 79R 9AI 1 DISK A 00070F******************************************************************* 00080ICDTTEXT CT 10 1NC 00090I* TEXT FILE OF COMMODITY CODE (MAIN) + DESCRIPTION 00100I* MAIN CODE 4N 00110I 1 4 CTNO L1 00120I* DESC 69A 00130I 7 75 CTDES 00140I*-------------------------------------------------------------------- 00150I ZZ 11 00160I********************************************************************** 00170ICDTDESC CD 00180I* COMMODITY MASTER KEY 9N 00190I 1 90CDTNO 00200I* DESC 70A 00210I 10 79 CDTDES 00220I******************************************************************* 00230C N10 GOTO END 00240C L1 Z-ADD0 W5N 50 00250C NL1 10 ADD W5N W5N ÐÐ00260C MOVE W5N W9N 90 00270C MOVELCTNO W9N 00280C MOVE W9N W9A 9 00290C W9A CHAINCDTDESC 30 00300C N30 SETON 62 FOUND IT 00310C N62 MOVE W9N CDTNO 00320C MOVELCTDES CDTDES 00330C SETON 80 00340C EXCPT OUTPUT MAST 00350C SETOF 8062 00360C*------------------------------------------------------------------ 00370C END TAG 00380C******************************************************************** 00390OCDTDESC EADD 80N62 00400O CDTNO 9 00410O CDTDES 79 00420O*------------------------------------------------------------------ 00430O E 80 62 00440O CDTDES 79 00450O******************************************************************* /* 00460_‚ ÐÐ_‚_‚0C MOVE W5N W9N 90 00270C MOVELCTNO W9N 00280C MOVE W9N W9A 9 00290C W9A CHAINCDTDESC 30 00300C N30 SETON 62 FOUND IT 00310C N62 MOVE W9N CDTNO 00320C MOVELCTDES CDTDES 00330C SETON 80 00340C EXCPT OUTPUT MAST 00350C SETOF 8062 00360C*------------------------------------------------------------------ 00370C END TAG 00380C******************************************************************** 00390OCDTDESC EADD 80N62 00400O CDTNO 9 00410O CDTDES 79 00420O*------------------------------------------------------------------ 00430O E 80 62 00440O CDTDES 79 00450O******************************************************************* /* 00460_‚ ÐÈ( x XR16 P999999120282(èÈÐ SUBROUTINE ZR16 (IBUF) 00010C RING BELL. READ 16-CHAR FROM TERMINAL. 00020 INTEGER IBUF (8) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 16 00070 ITC = 0 00080 IA = $0700 00090 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00100 RETURN 00110 END 00120_‚_‚0C******************************************************************** 00390OCDTDESC EADD 80N62 00400O CDTNO 9 00410O CDTDES 79 00420O*------------------------------------------------------------------ 00430O E 80 62 00440O CDTDES 79 00450O******************************************************************* /* 00460_‚ ÐÈ( ~  NX002GL P120282120282(èÈÐ00010H Q002GL00020F* ACCOUNT MASTER UPDATE. (X002GL) 00030F* REVISED 7-27-81 11:35 AM. DG-REL006 OK. 00040F* MENU: MQGL01 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FGLMAST UC F 165R 9AI 1 DISK A 00080FCAMAST ID F 40L18AI 1 DISK 00090FGLWU ID F 19L18AI 1 DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A40 40 40 1 A INPUT DATA ARRAY 00140E A9 9 9 1 00150E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00160E DUN 9 9 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E LOC 1 9 3 XY-POSITIONS 00190E BIT 33 1 SCREEN CONTR. CHAR 00200E GLA 12 11 2 ACTUAL $ 00210I******************************************************************* 00220IBITTAB BT 00230I 1 33 BIT 00240I******************************************************************* 00250IMGFILE MG ÐÐ00260I* MESSAGE FILE. 00270I 1 35 MGTEXT 00280I****************************************************************** 00290IGLMAST GL 00300I* ACCOUNT MASTER. 00310I* KEY AREA 9A 00320I 1 9 GLKEY 00330I* ACCOUNT PREFIX 1A 00340I 1 1 GLPRFX 00350I* ACCOUNT PRIME 5N 00360I 2 60GLPRIM 00370I* ACCOUNT DASH 3N 00380I 7 90GLDASH 00390I* ACCOUNT GROUP 4A 00400I 14 17 GLGRUP 00410I* ACCOUNT DESCRIPTION 40A 00420I 18 57 GLDESC 00430I* BALANCE FORWARD AMOUNT 11.2P 00440I P 58 632GLBALF 00450I* ACTUAL $ 11.2P X 12 00460I P 64 135 GLA 00470I* CURRENT MONTH-PLUSES 11.2P 00480I P 136 1412GLCMP 00490I* CURRENT MONTH-MINUS 11.2P 00500I P 142 1472GLCMM ÐÐ00510I* SOURCE CODE 1A 00520I* S = SUB-ACCOUNT ONLY, 00530I* MAY NOT BE PARENT 00540I 148 148 GLSC 00550I* BALANCE FORWARD CODE 2A 00560I* 1ST COL 00570I* 1 = ZERO BAL AT START NEW YR 00580I* 2 = CARRY PREV YR FRWD 00590I* 2ND COL 00600I* A = ZERO BAL AT START NEW MO 00610I* B = CARRY PREV MO FRWD 00620I 149 150 GLBFC 00630I* NUMB OF SUB-ACCOUNTS 5P 00640I P 157 1590GLNOSA 00650I* LOW LEVEL CODE 3N 00660I 160 1620GLLL 00670I* FILLER 00680I* RECORD STATUS 1A 00690I 165 165 GLSTAT 00700I******************************************************************* 00710ICAMAST CA 00720I* CHART OF ACCOUNTS. 00730I* KEY AREA. 00740I* PARENT ACCOUNT 9A 00750I 1 9 CAPAR ÐÐ00760I* SUB-ACCOUNT 9A 00770I 10 18 CASUB 00780I* OPERATOR 1A 00790I* S = SUBTRACT 00800I* A = ADD 00810I 25 25 CAOPER 00820I* EFFECTIVITY 00830I* START DATE 6N (YMD) 00840I 26 310CASDAT 00850I* END DATE 6N (YMD) 00860I 32 370CAEDAT 00870I* FILLER 00880I* RECORD STATUS 1A 00890I 40 40 CASTAT 00900I******************************************************************** 00910IGLWU GW 00920I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00930I* KEY AREA. 00940I* SUB-ACCOUNT 9A 00950I 1 9 GWSUB 00960I* PARENT ACCOUNT 9A 00970I 10 18 GWPAR 00980I* RECORD STATUS 1A 00990I 19 19 GWSTAT 01000C******************************************************************** ÐÐ01010C* INITIALIZE 01020C EXSR SR101 1-TIME INIT 01030C*------------------------------------------------------------------ 01040C START TAG 01050C* SET-UP 1ST FIELD NO. 01060C EXSR SR205 INIT GLMAST FIELDS 01070C EXSR SR207 INIT TRAN FIELDS 01080C MOVE ' ' DUN INIT EDIT ARRAY 01090C Z-ADD1 F 30 FIELD # 01100C GOTO READ 01110C*------------------------------------------------------------------ 01120C NEXT TAG 01130C* SET-UP NEXT FIELD NO. 01140C 1 ADD F F FIELD # 01150C*----------------------------------------------------------------- 01160C READ TAG 01170C* READ DATA FROM TERMINAL. 01180C SETOF 9096 01190C EXSR SR102 VALIDATE FIELD # 01200C 55 GOTO UPDATE DONE 01210C EXSR SR203 CLASSIFY TRAN 01220C 62 F COMP 5 54 01230C 62 54 GOTO UPDATE DELETE SHORTCUT 01240C EXSR SR201 IDENTIFY-F 01250C 02 GOTO NEXT ÐÐ01260C SETON 69 01270C EXSR SR72 PROMPT 01280C SETOF 69 01290C EXSR SR75 READ TERMINAL 01300C 98 GOTO GOODBY GOODBY 01310C 94 GOTO MENU MENU REQUEST 01320C N77N88 EXSR SR104 EDIT INPUT FIELD 01330C 96 ERROR 01340CORN77N88 EXSR SR72 REWRITE INPUT DATA 01350C 93 GOTO NEWITM NEW ITEM 01360C 92 GOTO JUMP FIELD JUMP REQST 01370C 91 GOTO NEXT SKIP FORWARD 01380C 89 F SUB 1 F SKIP BACKWARD 01390C 89 EXSR SR201 01400C 89 02 Z-ADD1 F 01410C 89 GOTO READ " " 01420C 88 SETOF 90 SPACE FILL 01430C 88 SETON 77 " " 01440C 87 GOTO START 01450C 86 GOTO UPDATE UPDATE 01460C 85 GOTO READ REPEAT 01470C 96 GOTO ERROR ERROR 01480C 04N77 GOTO EDIT 01490C N77 GOTO NEXT NO DATA INPUT 01500C*------------------------------------------------------------------ ÐÐ01510C PROCES TAG 01520C* PROCESS INPUT DATA 01530C EXSR SR103 MOVE DATA 01540C*------------------------------------------------------------------- 01550C EDIT TAG 01560C N96 EXSR SR104 EDIT DATA 01570C EXSR SR72 REWRITE DATA 01580C 96 GOTO ERROR ERROR 01590C GOTO NEXT 01600C*------------------------------------------------------------------ 01610C UPDATE TAG 01620C* UPDATE DATA BASE. 01630C EXSR SR105 FINAL EDIT 01640C 96 GOTO ERROR ERROR 01650C EXSR SR106 UPDATE 01660C 96 GOTO ERROR ERROR 01670C 1 ADD LINE LINE 30 01680C GOTO START 01690C*------------------------------------------------------------------- 01700C JUMP TAG 01710C* SET-UP JUMP TO REQUESTED FIELD 01720C 1 ADD W W 30 01730C W COMP 40 54 01740C 54 Z-ADD318 M 50 96 FLAG ERROR 01750C 54 GOTO ERROR BAD ESC ÐÐ01760C MOVE '000' W3A 3 01770C MOVEAA40,W W3A 01780C Z-ADD3 W2N 20 01790C EXIT SUBRAJ R. JUSTIFY 01800C RLABL W2N 01810C RLABL W3A 01820C MOVE W3A F NEW FIELD # 01830C GOTO READ 01840C*-------------------------------------------------------------------- 01850C ERROR TAG 01860C EXSR SR102 VALIDATE FIELD # 01870C EXSR SR89 GET MSG 01880C EXSR SR73 PUT MSG 01890C GOTO READ 01900C*------------------------------------------------------------------ 01910C NEWITM TAG 01920C* SET-UP LINK FOR NEW ITEM 01930C GOTO START 01940C*------------------------------------------------------------------- 01950C MENU TAG 01960C* SET-UP LINK TO MENU 01970C MOVEL'QQGL01' PROG 8 01980C GOTO END 01990C*-------------------------------------------------------------------- 02000C GOODBY TAG ÐÐ02010C* LINK TO SIGN-OFF 02020C MOVEL'GOODBY' PROG 02030C GOTO END 02040C*------------------------------------------------------------------- 02050C END TAG 02060C EXITFCHAIN LINK TO NEXT PROG 02070C RLABL PROG 02080C********************************************************************* 02090CSR SR1 BEGSR 02100C* EDIT TRAN CODE. 02110CSR EXSR SR203 CLASSIFY TRAN. 02120CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 02130CSR ENDSR 02140C******************************************************************** 02150CSR SR2 BEGSR 02160C* EDIT ACCOUNT PREFIX 02170CSRN79 MOVE ' ' IOTRAP 1 02180CSR ENDSR 02190C******************************************************************** 02200CSR SR3 BEGSR 02210C* EDIT ACCOUNT PRIME 02220CSRN79 MOVE ' ' IOTRAP 02230CSR TPRIM COMP 0 54 02240CSRN54 Z-ADD338 M 96 FLAG ERROR 02250CSR ENDSR ÐÐ02260C*************************************************************** 02270CSR SR4 BEGSR 02280C* EDIT ACCOUNT DASH 02290CSR EXSR SR80 GET GLMAST 02300CSR SETOF 55 02310CSR 60 02320COR 61 SETON 55 02330CSR EXSR SR1 EDIT TRAN CODE 02340CSR 96 GOTO END4 ERROR 02350CSR 60N55 Z-ADD301 M 96 FLAG ERROR 02360CSR 61 55 02370COR 62 55 Z-ADD302 M 96 FLAG ERROR 02380CSR 55 EXSR SR205 INIT GLMAST 02390CSRN55 EXSR SR206 MOVE DATA 02400CSRN96 MOVE 'X' IOTRAP 02410CSR END4 ENDSR 02420C******************************************************************** 02430CSR SR5 BEGSR 02440C* EDIT DESCRIPTION. 02450CSR TDESC COMP BLK40 54 02460CSRN54 Z-ADD310 M 96 FLAG ERROR. 02470CSR ENDSR 02480C******************************************************************** 02490CSR SR7 BEGSR 02500C* EDIT SOURCE CODE. ÐÐ02510CSR TSC COMP ' ' 54 PARENT OK 02520CSRN54 TSC COMP 'S' 54 SUB-ONLY 02530CSRN54 Z-ADD339 M 96 FLAG ERROR. 02540CSRN54 GOTO END7 02550C* FLAG ERROR IF SOURCE CODE=S AND USED AS A PARENT. 02560CSR TSC COMP 'S' 54 02570CSR 54 GLNOSA COMP 0 54 02580CSR 54 Z-ADD361 M 96 FLAG ERROR 02590CSR END7 ENDSR 02600C***************************************************************** 02610CSR SR9 BEGSR 02620C* EDIT BAL-FORWARD CODE 02630CSR TBFC COMP '1A' 54 02640CSRN54 TBFC COMP '1B' 54 02650CSRN54 TBFC COMP '2A' 54 02660CSRN54 TBFC COMP '3A' 54 02670CSRN54 Z-ADD357 M 96 FLAG ERROR 02680CSR ENDSR 02690C***************************************************************** 02700CSR SR70 BEGSR 02710C* CLEAR TERM SCREEN. 02720CSR EXITFQTOPF CLEAR SCREEN 02730CSR ENDSR 02740C********************************************************************** 02750CSR SR71 BEGSR ÐÐ02760C* PUT HEADINGS 02770CSR SETON 71 02780CSR EXCPT PUT HEADING 02790CSR SETOF 71 02800CSR Z-ADD8 LINE 30 02810CSR ENDSR 02820C********************************************************************* 02830CSR SR72 BEGSR 02840C* PUT DATA TO TERMINAL 02850CSR LINE COMP 28 54 02860CSR 54 EXSR SR71 PUT HEADING 02870CSR LINE SUB 1 W3N 30 54 02880CSRN54 Z-ADD1 W3N 02890CSR MOVELW3N XYPOS 6 02900CSR MOVE '001' XYPOS 02910CSR EXITFQXYPOS POSITION CURSOR 02920CSR RLABL XYPOS 02930CSR SETON 72 02940CSR EXCPT PUT DATA 02950CSR SETOF 72 02960CSR END72 ENDSR 02970C*********************************************************************** 02980CSR SR73 BEGSR 02990C* PUT ERROR MESSAGE TO TERMINAL 03000CSR SETON 73 ÐÐ03010CSR EXCPT PUT MSG 03020CSR SETOF 73 03030CSR Z-ADDM LSTERR 50 03040CSR ENDSR 03050C******************************************************************* 03060CSR SR75 BEGSR 03070C* READ FROM TERMINAL 03080CSR SETOF 779096 03090CSR SETOF 939291 03100CSR SETOF 898887 03110CSR SETOF 8685 03120CSR MOVE BIT,21 BUFLGT 2 READ BUFFER LGTH 03130CSR MOVE BLK40 W40A 40 BUFFER 03140CSR MOVE BIT,28 A9,1 03150CSR MOVE '8' A9,2 03160CSR MOVE LINE W3A 3 03170CSR MOVEAW3A A9,3 03180CSR MOVEALOC,F A9,6 03190CSR MOVE BIT,8 A9,9 03200CSR MOVEAA9 W9A 9 03210CSR EXITFQPREED READ FROM TERMINAL 03220CSR RLABL W9A 03230CSR RLABL W40A READ BUFFER 03240CSR RLABL BUFLGT READ BUFFER LGTH 03250CSR MOVEAW40A A40 INPUT DATA ARRAY ÐÐ03260CSR MOVE BLK40 W40A INIT INPUT ARRAY 03270CSR Z-ADD1 W 30 03280CSR '\' LOKUPA40,W 90 FLAG ESC 03290CSRN90 GOTO T75B NOT ESC 03300CSR 1 ADD W W 03310CSR W COMP 40 54 03320CSR 54 GOTO T75A BAD ESC 03330CSR A40,W COMP 'G' 98 GOODBY 03340CSR A40,W COMP 'E' 94 MENU 03350CSR A40,W COMP 'N' 93 NEW ITEM 03360CSR A40,W COMP 'J' 92 JUMP 03370CSR A40,W COMP 'F' 91 SKIP FRWRD 03380CSR A40,W COMP 'B' 89 SKIP BKWRD 03390CSR A40,W COMP 'S' 88 SPACE FILL 03400CSR A40,W COMP 'H' 87 HOME 03410CSR A40,W COMP 'U' 86 UPDATE 03420CSR A40,W COMP 'R' 85 REPEAT 03430CSR 98 03440COR 94 03450COR 93 03460COR 92 03470COR 91 03480COR 89 03490COR 88 03500COR 87 ÐÐ03510COR 86 03520COR 85 GOTO END75 GOOD ESC 03530C*------------------------------------------------------------------ 03540CSR T75A TAG 03550C* FLAG BAD ESC INPUT 03560CSR Z-ADD318 M 96 FLAG ERROR 03570CSR GOTO END75 03580C*-------------------------------------------------------------------- 03590CSR T75B TAG 03600C* MOVE DATA 03610CSR Z-ADD1 W 03620CSR ' ' LOKUPA40,W 77 03630CSR 77 MOVEAA40,W W40A INPUT DATA 03640C*-------------------------------------------------------------------- 03650CSR END75 TAG 03660C* INIT PREV ERROR MSG. 03670CSR LSTERR COMP 0 54 03680CSR 54 MOVE BLK35 MGTEXT 03690CSR 54 EXSR SR73 BLANK MESSAGE 03700CSR Z-ADD0 LSTERR 50 03710CSR ENDSR 03720C********************************************************************** 03730CSR SR80 BEGSR 03740C* GET MASTER RECORD 03750CSR SETOF 61 ÐÐ03760CSR MOVELTPRFX TKEY 9 03770CSR MOVELTPRIM W8A 8 03780CSR MOVE TDASH W8A 03790CSR MOVE W8A TKEY 03800CSR TKEY CHAINGLMAST 60 GET MASTER 03810CSRN60 GLSTAT COMP 'D' 61 FLAG DELETE 03820CSR ENDSR 03830C********************************************************************** 03840CSR SR81 BEGSR 03850C* ADD NEW MASTER TO FILE 03860CSR SETON 81 03870CSR EXCPT ADD MASTER 03880CSR SETOF 81 03890CSR ENDSR 03900C*********************************************************************** 03910CSR SR82 BEGSR 03920C* REWRITE MASTER 03930CSR SETON 82 03940CSR EXCPT REWRITE MASTER 03950CSR SETOF 82 03960CSR ENDSR 03970C********************************************************************** 03980CSR SR89 BEGSR 03990C* GET MESSAGE MASTER 04000CSR M CHAINMGFILE 54 ÐÐ04010CSR 54 MOVE BLK35 MGTEXT 04020CSR 54 MOVELM MGTEXT 04030CSR 54 MOVE MES,1 MGTEXT 04040CSR ENDSR 04050C******************************************************************** 04060CSR SR101 BEGSR 04070C* 1-TIME INITIALIZE 04080CSR MOVE BIT,1 NUL 04090CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04100CSR EXSR SR70 CLEAR SCREEN 04110CSR EXSR SR71 PUT HEADING 04120CSR Z-ADD9 FLIMIT 30 TOTAL NUMB FIELDS 04130CSR MOVE ' ' BLK40 40 04140C* DEFINE WORK FIELDS,ETC. 04150CSR MOVE ' ' BLK35 35 04160CSR MOVE ' ' BLK6 6 04170CSR ENDSR 04180C********************************************************************** 04190CSR SR102 BEGSR 04200C* VALIDATE FIELD NO. 04210CSR F COMP 0 54 04220CSRN54 Z-ADD1 F 04230CSR F COMP FLIMIT 55 04240CSR 55 Z-ADD1 F 04250CSR ENDSR ÐÐ04260C******************************************************************** 04270CSR SR103 BEGSR 04280C* MOVE INPUT DATA 04290CSR EXSR SR201 IDENTIFY-F 04300CSR EXSR SR202 R. JUSTIFY 04310CSR 01 MOVELW40A TTCODE 1 TRAN CODE. 04320CSR 02 MOVELW40A TPRFX 1 ACCOUNT PREFIX 04330CSR 03 MOVE W10A TPRIM 50 ACCOUNT PRIME 04340CSR 04 MOVE W10A TDASH 30 ACCOUNT DASH 04350CSR 05 MOVELW40A TDESC 40 DESCRIPTION. 04360CSR 06 MOVELW40A TGRUP 4 ACCT GROUP.E. 04370CSR 07 MOVELW40A TSC 1 SOURCE CODE. 04380CSR 08 MOVELW40A TYBFC 1 YEARLY BAL FWD 04390CSR 08 MOVELTYBFC TBFC 2 04400CSR 09 MOVELW40A TMBFC 1 MONTHLY BAL FWD 04410CSR 09 MOVE TMBFC TBFC 04420CSR MOVE ' ' DUN,F EDIT FLAG 04430CSR ENDSR 04440C******************************************************************** 04450CSR SR104 BEGSR 04460C* EDIT INPUT DATA 04470CSR F COMP 4 54 04480CSR 54 IOTRAP COMP ' ' 55 04490CSR 54N55 EXSR SR4 EDIT KEY. 04500CSR 01 EXSR SR1 ÐÐ04510CSR 02 EXSR SR2 04520CSR 03 EXSR SR3 04530CSR 04N79 EXSR SR4 04540CSR 05 EXSR SR5 04550CSR 07 EXSR SR7 04560CSR 09 EXSR SR9 04570CSR 96 MOVE ' ' DUN,F EDIT FLAG 04580CSRN96 MOVE 'X' DUN,F 04590CSR ENDSR 04600C*********************************************************************** 04610CSR SR105 BEGSR 04620C* FINAL EDIT 04630CSR SETON 79 FINAL EDIT FLAG 04640CSR Z-ADD1 F 96 04650C*-------------------------------------------------------------------- 04660CSR T105A TAG 04670CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04680CSRN54 GOTO END105 04690CSR EXSR SR201 IDENTIFY-F 04700CSR EXSR SR104 EDIT 04710CSRN96 GOTO T105A 04720C*-------------------------------------------------------------------- 04730CSR END105 TAG 04740CSR SETOF 79 04750CSR ENDSR ÐÐ04760C******************************************************************** 04770CSR SR106 BEGSR 04780C* UPDATE DATA BASE. 04790CSR EXSR SR203 CLASSIFY TRAN 04800CSR 60 GOTO T106A ADD TRAN 04810CSR 61 GOTO T106D CHANGE TRAN 04820CSR 62 GOTO T106F DELETE TRAN 04830C* FLAG BAD TRAN CODE 04840CSR Z-ADD300 M 96 FLAG ERROR 04850CSR Z-ADD1 F FIELD # 04860CSR GOTO END106 04870C*------------------------------------------------------------------- 04880CSR T106A TAG 04890C* ADD TRANSACTION 04900CSR EXSR SR80 GET MASTER 04910CSR 60 GOTO T106B NOT ON FILE 04920CSR 61 GOTO T106C DELETED MASTER 04930C* FLAG DUPLICATE ADD ERROR 04940CSR Z-ADD301 M 96 FLAG ERROR 04950CSR Z-ADD1 F FIELD # 04960CSR GOTO END106 04970C*--------------------------------------------------------------------- 04980CSR T106B TAG 04990C* ADD-- MAST NOT ON FILE 05000CSR EXSR SR81 ADD NEW MASTER ÐÐ05010CSR GOTO END106 05020C*--------------------------------------------------------------------- 05030CSR T106C TAG 05040C* ADD-- MAST IS DELETED 05050CSR MOVE 'A' GLSTAT RECORD STATUS 05060CSR EXSR SR82 REWRITE MAST 05070CSR GOTO END106 05080C*---------------------------------------------------------------------- 05090CSR T106D TAG 05100C* CHANGE TRANSACTION. 05110CSR EXSR SR80 GET MASTER 05120CSRN60N61 GOTO T106E GOT IT 05130C* FLAG NO MASTER ERROR 05140CSR Z-ADD302 M 96 FLAG ERROR 05150CSR Z-ADD1 F FIELD # 05160CSR GOTO END106 05170C*----------------------------------------------------------------------- 05180CSR T106E TAG 05190C* REWRITE MASTER 05200CSR EXSR SR82 REWRITE MAST 05210CSR GOTO END106 05220C*----------------------------------------------------------------------- 05230CSR T106F TAG 05240C* DELETE TRANSACTION 05250CSR EXSR SR80 GET MASTER ÐÐ05260CSRN60N61 GOTO T106G GOT IT 05270C* FLAG NO MASTER ERROR 05280CSR Z-ADD302 M 96 FLAG ERROR 05290CSR Z-ADD1 F FIELD # 05300CSR GOTO END106 05310C*----------------------------------------------------------------------- 05320CSR T106G TAG 05330C* DELETE MASTER. 05340CSR EXSR SR204 CHECK FOR ACTIVITY 05350CSR 96 Z-ADD1 F FIELD # 05360CSR 96 GOTO END106 ERROR 05370CSR MOVE 'D' GLSTAT RECORD STATUS 05380CSR EXSR SR82 REWRITE MASTER 05390CSR END106 ENDSR 05400C************************************************************************ 05410CSR SR201 BEGSR 05420CSR F COMP 1 01 05430CSR F COMP 2 02 05440CSR F COMP 3 03 05450CSR F COMP 4 04 05460CSR F COMP 5 05 05470CSR F COMP 6 06 05480CSR F COMP 7 07 05490CSR F COMP 8 08 05500CSR F COMP 9 09 ÐÐ05510CSR END201 ENDSR 05520C********************************************************************** 05530CSR SR202 BEGSR 05540C* RIGHT JUSTIFY 05550CSR F LOKUPNUM 54 05560CSRN54 GOTO END202 NOT NUMERIC FIELD 05570CSR Z-ADD10 W2N 20 05580CSR MOVELW40A W10A 10 05590CSR EXIT SUBRAJ R. JUSTIFY 05600CSR RLABL W2N 05610CSR RLABL W10A 05620CSR END202 ENDSR 05630C*********************************************************************** 05640CSR SR203 BEGSR 05650C* CLASSIFY TRAN CODE 05660CSR TTCODE COMP 'A' 60 ADD 05670CSR TTCODE COMP 'C' 61 CHANGE 05680CSR TTCODE COMP 'D' 62 DELETE 05690CSR ENDSR 05700C**************************************************************** 05710CSR SR204 BEGSR 05720C* FLAG ERROR ON DELETE IF ACCOUNT IS ACTIVE 05730CSR GLNOSA COMP 0 54 05740CSRN54 XFOOTGLA W11D2 112 54 05750CSR 54 Z-ADD29 M 96 FLAG ERROR ÐÐ05760CSR 54 GOTO END204 05770CSR MOVELTKEY W18A 18 05780CSR W18A SETLLGLWU 05790C*---------------------------------------------------------------- 05800CSR T204A TAG 05810CSR SETOF 54 05820CSR READ GLWU 54 READ WHERE-USED 05830CSR 54 GOTO END204 05840CSR GWSUB COMP TKEY 54 05850CSRN54 GOTO END204 05860CSR GWSTAT COMP 'D' 54 05870CSR 54 GOTO T204A DELETED RECORD 05880CSR Z-ADD29 M 96 FLAG ERROR 05890CSR END204 ENDSR 05900C**************************************************************************05910CSR SR205 BEGSR 05920C* INIT GLMAST. 05930CSR MOVE TPRFX GLPRFX ACCOUNT PREFIX 05940CSR Z-ADDTPRIM GLPRIM ACCOUNT PRIME 05950CSR Z-ADDTDASH GLDASH ACCOUNT DASH 05960CSR MOVE ' ' GLSC SOURCE CODE 05970CSR MOVE BLK40 GLDESC DESCRIPTION 05980CSR Z-ADD0 GLA ACTUAL $ 05990CSR Z-ADD0 GLCMP CUR-MO PLUS$ 06000CSR Z-ADD0 GLCMM CUR-MO MINUS$ ÐÐ06010CSR Z-ADD0 GLNOSA NUMB OF SUBS 06020CSR Z-ADD0 GLLL LOW LEVEL CODE 06030CSR MOVE ' ' GLBFC BAL FORWARD CODE 06040CSR ENDSR 06050C*************************************************************** 06060CSR SR206 BEGSR 06070C* MOVE GLMAST TO TRAN FIELDS 06080CSR TDESC COMP BLK40 54 06090CSRN54 MOVE GLDESC TDESC DESCRIPTION 06100CSR TGRUP COMP ' ' 54 06110CSRN54 MOVE GLGRUP TGRUP GROUP CODE 06120CSR TSC COMP ' ' 54 06130CSRN54 MOVE GLSC TSC SOURCE CODE 06140CSR TBFC COMP ' ' 54 06150CSRN54 MOVE GLBFC TBFC BAL FRWRD CODE 06160CSR MOVELTBFC TYBFC 06170CSR MOVE TBFC TMBFC 06180CSR ENDSR 06190C**************************************************************** 06200CSR SR207 BEGSR 06210C* INIT TRAN FIELDS 06220CSR MOVE BLK40 TDESC 06230CSR MOVE ' ' TGRUP 06240CSR MOVE ' ' TSC 06250CSR MOVE ' ' TBFC ÐÐ06260CSR MOVE ' ' TYBFC 06270CSR MOVE ' ' TMBFC 06280CSR MOVE ' ' TPRFX 06290CSR Z-ADD0 TPRIM 06300CSR Z-ADD0 TDASH 06310CSR MOVE BLK35 TKEY 06320CSR ENDSR 06330O******************************************************************** 06340OTERM132 E 71 06350O* PUT HEADING. 06360O 70 'ACCOUNT MASTER UPDATE' 06370O*------------------------------------------------------------------- 06380O E 71 06390O 2 '1' 06400O* * * * 9 '2' 06410O 16 '3' 06420O 21 '4' 06430O 27 '5' 06440O 69 '6' 06450O 77 '7' 06460O 84 '8' 06470O 93 '9' 06480O*------------------------------------------------------------------- 06490O E 71 06500O 87 'YEARLY' ÐÐ06510O 97 'MONTHLY' 06520O*-------------------------------------------------------------------- 06530O E 71 06540O 4 'TRAN' 06550O 21 'ACCOUNT NO.' 06560O 79 'ACNT' 06570O 88 'BAL-FWD' 06580O 97 'BAL-FWD' 06590O 120 'CURRENT-MONTH' 06600O*------------------------------------------------------------------- 06610O E 71 06620O 4 'CODE' 06630O* * * * 12 'PREFIX' 06640O 18 'PRIME' 06650O 24 'DASH' 06660O 41 '<--------------' 06670O 52 'DESCRIPTION' 06680O 65 '------------>' 06690O 73 'GROUP' 06700O 79 'TYPE' 06710O 86 'CODE' 06720O 95 'CODE' 06730O 108 'PLUS' 06740O 123 'MINUS' 06750O*------------------------------------------------------------------- ÐÐ06760O E 71 06770O*------------------------------------------------------------------- 06780O E 72 06790O* PUT DATA. 06800O TTCODE 2 06810O TPRFX 10 06820O TPRIM Z 19 06830O TDASH Z 23 06840O TDESC 65 06850O TGRUP 73 06860O TSC 78 06870O TYBFC 85 06880O TMBFC 94 06890O GLCMP K 109 06900O GLCMM K 124 06910O*------------------------------------------------------------------- 06920O E 73 06930O 96 9 'E R R O R' 06940O N96 9 ' ' 06950O MGTEXT 47 06960O BIT,28 130 06970O 131 'K' 06980O BIT,8 132 06990O******************************************************************** 07000OGLMAST EADD 81 ÐÐ07010O TKEY 9 07020O TGRUP 17 07030O TDESC 57 07040O GLBALF 63P 07050O GLA 135P 07060O GLCMP 141P 07070O GLCMM 147P 07080O TSC 148 07090O TBFC 150 07100O GLNOSA 159P 07110O GLLL 162 07120O 165 'A' 07130O*------------------------------------------------------------------- 07140O E 82 07150O TGRUP 17 07160O TDESC 57 07170O GLBALF 63P 07180O GLA 135P 07190O GLCMP 141P 07200O GLCMM 147P 07210O TSC 148 07220O TBFC 150 07230O GLNOSA 159P 07240O GLLL 162 07250O GLSTAT 165 ÐÐ** NUL ARRAY 007260 007270** A40 ARRAY 007280 007290** A9 ARRAY 007300 007310** NUM ARRAY 007320003 PRIME 007330004 DASH 007340** DUN ARRAY 007350 007360** MES ARRAY 007370---MESSAGE NOT ON FILE--- 007380** LOC ARRAY 007390003 1 TRAN CODE 007400010 2 PREFIX-- NOT USED 007410016 3 PRIME 007420023 4 DASH 007430028 5 DESCR 007440071 6 GROUP 007450079 7 SOURCE 007460086 8 BAL FWD - YEARLY 007470095 9 BAL FWD - MONTHLY 007480/* 07490_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ôÍ ôÑX002JN P120282120282(èÈÐ00010H Q002JN00020F* UPDATE JOB MASTERS. (X002JN) 00030F* REVISED 4/25/80 9:45 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FJOBFILE UC F 48R 7AI 1 DISK A 00070FDEPTFILEUD F 32L12AI 1 DISK 00080FEMPLFILEUD F 64L14AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FTERM78 O F 78 5 00110E******************************************************************** 00120E NUL 1 78 1 00130E A6 1 6 1 00140E A36 1 36 1 A 00150E BIT 33 1 00160I******************************************************************** 00170IBITTAB BT 00180I 1 33 BIT 00190I******************************************************************** 00200IJOBFILE JN 00210I* RECORD CODE 1A 00220I* N = JOB NAME RECORD 00230I* C = JOB CODE RECORD 00240I 1 1 JNREC 00250I* JOB NAME 6A ÐÐ00260I 2 7 JNJOB 00270I* JOB DESCRIPTION 35A 00280I 8 42 JNDESC 00290I* RECORD STATUS 1A 00300I 48 48 JNSTAT 00310I******************************************************************** 00320IDEPTFILEDJ 00330I 1 2 DJREC 00340I 13 18 DJJOB 00350I******************************************************************** 00360IEMPLFILEEJ 00370I 1 2 EJREC 00380I 50 55 EJJOB 00390I******************************************************************** 00400IMGFILE MG 00410I* MESSAGE FILE 00420I* TEXT 35A 00430I 1 35 MGTEXT 00440I* LINE-2 35A 00450I 36 70 MGLIN2 61 00460I* PROG NAME 5A 00470I 71 75 MGPROG 00480C******************************************************************** 00490C START TAG 00500C* INITIALIZE & CLEAR SCREEN. ÐÐ00510C EXSR SR101 00520C*------------------------------------------------------------------- 00530C CONTU TAG 00540C* READ DATA AND STORE. 00550C SETOF 947796 00560C 1 ADD F F 30 FIELD #. 00570C F COMP 3 54 00580C 54 GOTO TAG60 DONE 00590C EXSR SR75 READ. 00600C 94 1 ADD W X 30 00610C 94 A36,X COMP 'H' 54 00620C 94 54 GOTO START 00630C 94 GOTO END EXIT. 00640C N77 GOTO CONTU NO INPUT. 00650C EXSR SR102 IDENTIFY FLD. 00660C 61 GOTO TAG10 TRANS. 00670C 62 GOTO TAG20 JOB #. 00680C 63 GOTO TAG30 JOB DESCR. 00690C GOTO CONTU 00700C*------------------------------------------------------------------- 00710C TAG10 TAG 00720C* TRANS CODE. 00730C EXSR SR103 CLASFY TRAN. 00740C N61N62N63 Z-ADD1 F 00750C N61N62N63 Z-ADD300 M 50 96 ÐÐ00760C N61N62N63 GOTO TAG500 FLAG ERR. 00770C GOTO CONTU 00780C*------------------------------------------------------------------- 00790C TAG20 TAG 00800C* JOB #. 00810C GOTO CONTU 00820C*------------------------------------------------------------------- 00830C TAG30 TAG 00840C* JOB DESCRIPTION. 00850C GOTO TAG60 UPDATE. 00860C*------------------------------------------------------------------- 00870C TAG60 TAG 00880C* UPDATE. 00890C EXSR SR103 CLASSIFY TRAN. 00900C 61 GOTO TAG70 ADD. 00910C 62 GOTO TAG90 CHANGE. 00920C 63 GOTO TAG100 DELETE. 00930C Z-ADD300 M 96 00940C GOTO TAG500 ERROR. 00950C*------------------------------------------------------------------- 00960C TAG70 TAG 00970C* ADD TRANS. 00980C EXSR SR80 GET JOBFILE. 00990C 60 GOTO TAG75 NOT ON FILE. 01000C 61 GOTO TAG80 DELETED. ÐÐ01010C* FLAG DUPLICATE ADD. 01020C Z-ADD1 F 01030C Z-ADD301 M 96 01040C GOTO TAG500 01050C*------------------------------------------------------------------- 01060C TAG75 TAG 01070C* ADD--- NOT ON FILE. 01080C EXSR SR104 INIT JOBFILE. 01090C EXSR SR105 MOVE DATA. 01100C MOVE JOBNO JNJOB 01110C EXSR SR106 EDIT JOBFILE. 01120C 96 GOTO TAG500 ERROR. 01130C EXSR SR81 ADD NEW REC. 01140C GOTO START 01150C*------------------------------------------------------------------- 01160C TAG80 TAG 01170C* ADD--- DELETED MASTER. 01180C EXSR SR105 MOVE DATA. 01190C EXSR SR106 EDIT. 01200C 96 GOTO TAG500 ERROR. 01210C MOVE 'A' JNSTAT 01220C EXSR SR82 REWRITE MAST. 01230C GOTO START 01240C*------------------------------------------------------------------- 01250C TAG90 TAG ÐÐ01260C* CHANGE TRANS. 01270C EXSR SR80 GET JOB FILE. 01280C N60N61 GOTO TAG95 GOT IT. 01290C* FLAG NOT ON FILE ERROR. 01300C Z-ADD1 F 01310C Z-ADD302 M 96 01320C GOTO TAG500 FLAG ERR. 01330C*------------------------------------------------------------------- 01340C TAG95 TAG 01350C EXSR SR105 MOVE DATA. 01360C EXSR SR106 EDIT. 01370C 96 GOTO TAG500 FLAG ERR. 01380C EXSR SR82 REWRITE JOBFILE 01390C EXSR SR107 01400C EXSR SR108 01410C GOTO START 01420C*------------------------------------------------------------------- 01430C TAG100 TAG 01440C* DELETE TRANS. 01450C EXSR SR80 GET JOBFILE. 01460C N60N61 GOTO TAG105 GOT IT. 01470C* FLAG NOT ON FILE ERROR. 01480C Z-ADD1 F 01490C Z-ADD302 M 96 01500C GOTO TAG500 FLAG ERR. ÐÐ01510C*------------------------------------------------------------------- 01520C TAG105 TAG 01530C MOVE 'D' JNSTAT 01540C EXSR SR82 REWRITE JOBFILE 01550C EXSR SR107 DELETE EJ REC. 01560C EXSR SR108 DELETE DJ REC. 01570C GOTO START 01580C*------------------------------------------------------------------- 01590C TAG500 TAG 01600C* PUT ERROR MSG TO CRT. 01610C EXSR SR102 IDENTIFY-F. 01620C EXSR SR89 GET MGFILE. 01630C EXSR SR74 PUT MSG. 01640C F SUB 1 F 01650C GOTO CONTU 01660C*------------------------------------------------------------------- 01670C END TAG 01680C MOVEL'QQDP01' PROG 8 01690C EXITFCHAIN 01700C RLABL PROG 01710C******************************************************************** 01720CSR SR70 BEGSR 01730C* CLEAR CRT. PUT TITLE. 01740CSR EXITFQTOPF CLEAR CRT. 01750CSR ENDSR ÐÐ01760C******************************************************************** 01770CSR SR72 BEGSR 01780C* PUT PROMPT. 01790CSR EXSR SR102 IDENTIFY-F 01800CSR SETON 72 01810CSR EXCPT PUT PROMPT. 01820CSR SETOF 72 01830CSR ENDSR 01840C******************************************************************** 01850CSR SR74 BEGSR 01860C* PUT MSG. 01870CSR SETON 74 01880CSR EXCPT PUT MSG. 01890CSR SETOF 74 01900CSR ENDSR 01910C******************************************************************** 01920CSR SR75 BEGSR 01930C* POSITION CURSOR AND READ. 01940CSR SETOF 949677 01950CSR MOVE BLK36 W36A 36 01960CSR EXSR SR72 PROMPT. 01970CSR MOVE BIT,19 A6,2 01980CSR MOVEAA6 W6A 6 01990CSR EXITFXCREAD 02000CSR RLABL W36A ÐÐ02010CSR RLABL W6A 02020CSR MOVEAW36A A36 02030CSR MOVE BLK36 W36A 02040CSR '\' LOKUPA36 94 02050CSR 94 GOTO END75 02060CSR Z-ADD1 W 30 02070CSR ' ' LOKUPA36,W 77 02080CSRN77 GOTO END75 02090CSR MOVEAA36,W W36A 02100CSR EXSR SR102 IDENTIFY-F 02110CSR 61 MOVELW36A TTCODE 1 TRAN CODE 02120CSR 62 MOVELW36A JOBNO 6 JOB NO. 02130CSR 63 MOVELW36A DESCR 35 JOB DESCRIPTION 02140C*------------------------------------------------------------------- 02150CSR END75 TAG 02160CSR EXSR SR72 PROMPT. 02170CSR MOVE BLK35 MGTEXT 02180CSR EXSR SR74 INIT ERR. 02190CSR ENDSR 02200C******************************************************************** 02210CSR SR80 BEGSR 02220C* GET MASTER. 02230CSR SETOF 6061 02240CSR MOVEL'N' W7A 7 02250CSR MOVE JOBNO W7A ÐÐ02260CSR W7A CHAINJOBFILE 60 02270CSRN60 JNSTAT COMP 'D' 61 02280CSR ENDSR 02290C******************************************************************** 02300CSR SR81 BEGSR 02310C* ADD NEW MAST. 02320CSR SETON 81 02330CSR EXCPT ADD MAST. 02340CSR SETOF 81 02350CSR ENDSR 02360C******************************************************************** 02370CSR SR82 BEGSR 02380C* REWRITE MAST. 02390CSR SETON 82 02400CSR EXCPT REWRITE MAST. 02410CSR SETOF 82 02420CSR ENDSR 02430C******************************************************************** 02440CSR SR83 BEGSR 02450C* WRITE DELETE CODE TO EJ RECORD. 02460CSR SETON 83 02470CSR EXCPT REWRITE EJ REC. 02480CSR SETOF 83 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR84 BEGSR 02520C* WRITE DELETE CODE TO DJ RECORD. 02530CSR SETON 84 02540CSR EXCPT REWRITE DJ REC. 02550CSR SETOF 84 02560CSR ENDSR 02570C******************************************************************** 02580CSR SR89 BEGSR 02590C* GET MGFILE MSG. 02600CSR M CHAINMGFILE 60 GET MGFILE. 02610CSR 60 MOVE BLK35 MGTEXT FLAG ERR. 02620CSR 60 MOVELM MGTEXT FLAG ERR. 02630CSR 60 MOVE 'NO-FILE' MGTEXT FLAG ERR. 02640CSR ENDSR 02650C******************************************************************** 02660CSR SR101 BEGSR 02670C* CLEAR SCREEN AND PUT OUT HEADINGS. 02680CSR Z-ADD0 F 02690CSR MOVE ' ' BLK6 6 02700CSR MOVE BLK6 A6 02710CSR MOVE BIT,1 A6 02720CSR EXSR SR70 CLEAR CRT. 02730CSR MOVE ' ' BLK36 36 02740CSR MOVE ' ' BLK35 35 02750CSR MOVE BLK35 DESCR ÐÐ02760CSR MOVE BLK6 JOBNO 02770CSR ENDSR 02780C******************************************************************** 02790CSR SR102 BEGSR 02800C* IDENTIFY FIELD #. 02810CSR F COMP 1 61 TRAN CODE. 02820CSR F COMP 2 62 JOB #. 02830CSR F COMP 3 63 DESCRIPTION. 02840CSR ENDSR 02850C******************************************************************** 02860CSR SR103 BEGSR 02870C* CLASSIFY TRANS CODE. 02880CSR TTCODE COMP 'A' 61 ADD 02890CSR TTCODE COMP 'C' 62 CHANGE 02900CSR TTCODE COMP 'D' 63 DELETE 02910CSR ENDSR 02920C******************************************************************** 02930CSR SR104 BEGSR 02940C* INIT MASTER. 02950CSR MOVE 'N' JNREC RECORD CODE. 02960CSR MOVE BLK6 JNJOB JOB #. 02970CSR MOVE BLK35 JNDESC DESCRIPTION. 02980CSR MOVE 'A' JNSTAT RECORD STATUS. 02990CSR ENDSR 03000C******************************************************************** ÐÐ03010CSR SR105 BEGSR 03020C* MOVE DATA. 03030CSR DESCR COMP BLK35 54 03040CSR 54 MOVE DESCR JNDESC DESCRIPTION. 03050CSR ENDSR 03060C******************************************************************** 03070CSR SR106 BEGSR 03080C* EDIT MAST. 03090CSR Z-ADD1 F 03100CSR JNREC COMP 'N' 54 03110CSRN54 Z-ADD303 M 96 03120CSRN54 GOTO END106 03130CSR Z-ADD2 F 03140CSR JNJOB COMP BLK6 54 03150CSRN54 Z-ADD309 M 96 03160CSRN54 GOTO END106 03170CSR Z-ADD3 F 03180CSR JNDESC COMP BLK35 54 03190CSRN54 Z-ADD310 M 96 03200CSR END106 ENDSR 03210C******************************************************************** 03220CSR SR107 BEGSR 03230C* DELETE EMPLOYEE JOB RECORDS. 03240CSR MOVE BLK35 W14A 14 03250CSR MOVEL'J' W14A ÐÐ03260CSR W14A SETLLEMPLFILE 03270C*------------------------------------------------------------------- 03280CSR T107A TAG 03290CSR SETOF 54 03300CSR READ EMPLFILE 54 03310CSR 54 GOTO END107 03320CSR EJREC COMP 'J' 54 03330CSRN54 GOTO END107 03340CSR EJJOB COMP JNJOB 54 03350CSRN54 GOTO T107A 03360CSR JNSTAT COMP 'D' 56 03370CSR EXSR SR83 REWRITE EMPL. 03380CSR GOTO T107A 03390CSR END107 ENDSR 03400C******************************************************************** 03410CSR SR108 BEGSR 03420C* DELETE DEPT JOB RECORDS. 03430CSR MOVE BLK35 W12A 12 03440CSR MOVEL'J' W12A 03450CSR W12A SETLLDEPTFILE 03460C*------------------------------------------------------------------- 03470CSR T108A TAG 03480CSR SETOF 54 03490CSR READ DEPTFILE 54 03500CSR 54 GOTO END108 ÐÐ03510CSR DJREC COMP 'J' 54 03520CSRN54 GOTO END108 03530CSR DJJOB COMP JNJOB 54 03540CSRN54 GOTO T108A 03550CSR JNSTAT COMP 'D' 56 03560CSR EXSR SR84 REWRITE DJ REC. 03570CSR GOTO T108A 03580CSR END108 ENDSR 03590O******************************************************************** 03600OTERM78 E 70 03610O* CLEAR CRT, PUT TITLE. 03620O BIT,28 1 03630O 2 '8' 03640O 8 '001050' 03650O 23 'JOB MAST UPDATE' 03660O*------------------------------------------------------------------- 03670O E 72 03680O* PROMPT. 03690O NUL 78 03700O BIT,28 1 03710O 2 '8' 03720O 61 5 '003' 03730O 62 5 '005' 03740O 63 5 '007' 03750O 8 '001' ÐÐ03760O 61 32 'ENTER TRAN CODE (A,C,D) ' 03770O 62 32 'ENTER JOB # ' 03780O 63 32 'ENTER DESCRIPTION ' 03790O 34 ' ' 03800O 61 TTCODE 35 03810O 62 JOBNO 40 03820O 63 DESCR 69 03830O BIT,28 71 03840O 72 '8' 03850O 61 75 '003' 03860O 62 75 '005' 03870O 63 75 '007' 03880O 78 '027' 03890O*------------------------------------------------------------------- 03900O E 74 03910O* PUT MSG. 03920O NUL 78 03930O BIT,28 1 03940O 2 '8' 03950O 61 5 '003' 03960O 62 5 '005' 03970O 63 5 '007' 03980O 8 '090' 03990O MGTEXT 43 04000O 96 BIT,8 44 ÐÐ04010O******************************************************************** 04020OJOBFILE EADD 81 04030O* ADD NEW MAST. 04040O 1 'N' 04050O JNJOB 7 04060O JNDESC 42 04070O 48 'A' 04080O*------------------------------------------------------------------- 04090O E 82 04100O* REWRITE MAST. 04110O JNDESC 42 04120O JNSTAT 48 04130O******************************************************************** 04140OEMPLFILEE 83 04150O JNDESC 49 04160O 56 JNSTAT 64 04170O******************************************************************** 04180ODEPTFILEE 84 04190O 32 'D' ** NUL ARRAY 004200 004210** A6 ARRAY 004220 004230** A36 ARRAY 004240 004250ÐÐ/* 004260_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(XŸ XúX002JQ P120282120282(èÈÐ00010H Q002JQ00020F* UPDATE JOB QUEUE. (X002JQ) 00030F* REVISED 7-09-81 11:45 AM. 00040F* BATCH MENU FOR SIGN-ON DEPT IS DISPLAYED AND ITEM 00050F* SELECTED IS ADDED TO BATCH QUEUE. MUST THEN BE CALLED 00060F* FROM DIABLO USING Q005JQ (PRINT). 00070F* 1. DISPLAYS DEPT MENU (UJMAST). 00080F* 2. REQUESTS SELECTION. 00090F* 3. PUTS SELECTED ITEM IN JOB QUE (JQMAST,JQDEVICE, 00100F* JQDEPT,JQJOB). 00110F* 4. DELETES UJMAST (MENU ITEM) IF JOB MASTER (BJMAST) 00120F* NO LONGER ACTIVE. 00130F* 00140FBITHEX IP F 256 DISK 00150FJQMAST UC F 96R 4AI 1 DISK A 00160FJQDEVICEUC F 8R 6AI 1 DISK A 00170FJQDEPT UC F 10R 9AI 1 DISK A 00180FJQJOB UC F 11R10AI 1 DISK A 00190FJQCONT UC F 6R DISK 00200FCRTFILE IC F 256R DISK 00210FBJMAST IC F 106R 6AI 1 DISK 00220FUJMAST UD F 12L11AI 1 DISK 00230FMGFILE IC F 80R DISK 00240FTERM70 O F 72 5 00250E******************************************************************** ÐÐ00260E NUL 1 70 1 00270E A6 6 6 1 00280E A12 12 12 1 A 00290E SEL 1 120 3 0 JOB 6 00300E BIT 256 1 00310E BJD 6 4 00320I******************************************************************** 00330IBITHEX BT 00340I 1 256 BIT 00350I******************************************************************** 00360IJQMAST JQ 00370I* JOB QUEUE MASTER. 00380I* JOB NUMB 4N 00390I 1 40JQNUMB 00400I* DEVICE 2A 00410I* COL-2,DEVICE CODE 00420I* Y = SHARED 00430I* N = NON-SHARABLE 00440I* COL-1,DEVICE CODE 00450I* S = SYST PRINTER 00460I* D = DIABLO PRINTER 00470I* T = TERMINAL 00480I* C = CONSOLE 00490I 5 6 JQDEV 00500I* DEPT # 5N ÐÐ00510I 7 110JQDEPT 00520I* JOB NAME 6A 00530I 12 17 JQJOB 00540I* PRINTER 1A 00550I 18 18 JQPRTR 00560I* PAPER 25A 00570I 19 43 JQPAP 00580I* COPIES REQUESTED 1N 00590I 44 440JQCOPY 00600I* REQUESTED BY 12A 00610I 45 56 JQRBY 00620I* REQUEST DATE 6N 00630I 57 620JQRDAT 00640I* REQUEST TIME 6N 00650I 63 680JQRTIM 00660I* NEED BY DATE 6N 00670I 69 740JQNDAT 00680I* NEED BY TIME 6N 00690I 75 800JQNTIM 00700I* DATE COMPLETED 6N 00710I 81 860JQCDAT 00720I* TIME COMPLETED 6N 00730I 87 920JQCTIM 00740I* RECORD STATUS 1A 00750I 96 96 JQSTAT ÐÐ00760I******************************************************************** 00770IJQDEVICEJD 00780I* JOB QUEUE DEVICE ALT-KEY. 00790I* KEY AREA. 00800I* DEVICE CODE 2A 00810I* COL-1 IS BJPRTR CODE 00820I* COL-2 IS BJUPD CODE 00830I 1 2 JDDEV 00840I* JOB # 4N 00850I 3 60JDJOB 00860I* RECORD STATUS 1A 00870I 8 8 JDSTAT 00880I******************************************************************** 00890IJQDEPT JP 00900I* JOB QUEUE DEPT ALT-KEY. 00910I* KEY AREA. 00920I* DEPT # 5N 00930I 1 50JPDEPT 00940I* JOB # 4N 00950I 6 90JPJOB 00960I* RECORD STATUS 1A 00970I 10 10 JPSTAT 00980I******************************************************************** 00990IJQJOB JJ 01000I* JOB QUEUE JOB ALT-KEY. ÐÐ01010I* KEY AREA. 01020I* JOB NAME 6A 01030I 1 6 JJNAME 01040I* JOB NUMB 4N 01050I 7 100JJJOB 01060I* RECORD STATUS 1A 01070I 11 11 JJSTAT 01080I******************************************************************** 01090IJQCONT JC 01100I* JOB QUEUE CONTROL RECORD. 01110I* LAST USED JOB # 4N 01120I 1 40JCJOB 01130I******************************************************************** 01140ICRTFILE CR 01150I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 01160I* STD AREA - SAME FOR ALL PROGRAMS. 01170I* EMPLOYEE # 5N 01180I 1 50CREMPL 01190I* USER CODE 8A 01200I 6 13 CRUSER 01210I* DEPT # 5N 01220I 14 180CRDEPT 01230I* JOB NAME 8A (JOB LOADED BY MENU) 01240I 19 26 CRJOB 01250I* SHUTDOWN FLAG 1A ÐÐ01260I* BLANK = NO SHUTDOWN 01270I 27 27 CRSHUT 01280I* TIME STARTED 6N 01290I 28 330CRTIME 01300I* DATE STARTED 4N 01310I 34 370CRDATE 01320I* CALL STACK 5 X 6A 01330I 38 67 CALL 01340I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 01350I 68 73 CRRET 01360I* MENU NAME 6A 01370I 74 79 CRMENU 01380I******************************************************************** 01390IBJMAST BJ 01400I* BATCH JOB MAST. 01410I* JOB NAME 6A 01420I 1 6 BJNAME 01430I* DESCRIPTION 40A 01440I 7 46 BJDESC 01450I* PRINTER 1A 01460I* D = DIABLO 01470I* S = SYSTEM PRINTER 01480I* T = DATAGRAPHIX 01490I* C = CONSOLE 01500I 47 47 BJPRTR ÐÐ01510I* PAPER 25A 01520I 48 72 BJPAP 01530I* COPIES 1N 01540I 73 730BJCOPY 01550I* DISTRIBUTION 4A X 6 01560I 74 97 BJD 01570I* UPDATE CODE 1A 01580I* Y = SHARABLE 01590I* N = NOT SHARABLE 01600I* BLK = NO DISK UPDATE 01610I 98 98 BJUPD 01620I* TYPE CODE 1A 01630I* P = PROGRAM (MAINLINE OR CALLED BY PROC) 01640I* U = UTILITY (ONLY) 01650I* Z = JOB STREAM 01660I* M = MENU 01670I* C = CALLED PROGRAM 01680I 99 99 BJTYPE 01690I* RECORD STATUS 1A 01700I 106 106 BJSTAT 01710I******************************************************************** 01720IUJMAST UJ 01730I* USER JOB MENU. 01740I* DEPT 5N 01750I 1 50UJDEPT ÐÐ01760I* JOB NAME 6A 01770I 6 11 UJNAME 01780I* RECORD STATUS 1A 01790I 12 12 UJSTAT 01800I******************************************************************** 01810IMGFILE MG 01820I 1 35 MGTEXT 01830C******************************************************************** 01840C* INITIALIZE. 01850C EXSR SR101 INIT. 01860C H9 GOTO ENDJOB PROG ERROR. 01870C*------------------------------------------------------------------- 01880C START TAG 01890C* DISPLAY JOB MENU. 01900C SETOF 9678 01910C Z-ADD3 LINENO 30 01920C Z-ADD0 COUNT 30 01930C EXSR SR102 DISPLAY MENU. 01940C 96 GOTO ENDJOB NO MENU. 01950C*------------------------------------------------------------------- 01960C TAG50 TAG 01970C Z-ADD0 CRSEL 01980C Z-ADD0 JQNDAT 01990C Z-ADD0 JQNTIM 02000C* REQUEST SELECTION. ÐÐ02010C EXITFQCLFCR LF/CR 02020C SETON 74 02030C EXCPT PROMPT. 02040C SETOF 74 02050C EXSR SR75 READ. 02060C 96 GOTO TAG50 02070C 98 GOTO GOODBY 02080C 94 GOTO MENU 02090C 93 GOTO TAG50 02100C EXSR SR203 R. JUSTIFY 02110C MOVE W12A CRSEL 30 SELECTION # 02120C CRSEL COMP 0 54 02130C 54 CRSEL COMP J 5454 CHK SEL # 02140C 54 GOTO TAG100 SEL # OK 02150C Z-ADD241 M 96 FLAG ERROR 02160C EXSR SR999 02170C GOTO TAG50 02180C*------------------------------------------------------------------- 02190C TAG100 TAG 02200C* REQUEST NEED DATE,TIME. 02210C SETOF 96 02220C EXSR SR103 02230C 96 GOTO TAG100 02240C 98 GOTO GOODBY 02250C 94 GOTO MENU ÐÐ02260C 93 GOTO TAG50 02270C Z-ADD1 X 30 02280C CRSEL LOKUPSEL,X 55 02290C N55 Z-ADD241 M 50 96 FLAG ERROR. 02300C N55 EXSR SR999 02310C N55 GOTO TAG100 02320C* UPDATE JOB QUEUE 02330C EXSR SR104 02340C GOTO TAG50 02350C*------------------------------------------------------------------- 02360C MENU TAG 02370C* LINK TO MENU. 02380C MOVEL'Q070DP' PROG 8 02390C GOTO END 02400C*------------------------------------------------------------------- 02410C GOODBY TAG 02420C* SIGN-OFF. 02430C MOVEL'GOODBY' PROG 02440C GOTO END 02450C*------------------------------------------------------------------- 02460C END TAG 02470C PROG COMP BLK8 54 02480C N54 MOVEL'Q070DP' PROG 02490C EXITFCHAIN 02500C RLABL PROG ÐÐ02510C*------------------------------------------------------------------- 02520C ENDJOB TAG 02530C******************************************************************** 02540CSR SR72 BEGSR 02550C* DISPLAY MENU. 02560CSR 1 ADD LINENO LINENO 30 02570CSR LINENO COMP 31 54 54 02580CSR 54 Z-ADD2 LINENO 02590CSR 54 SETON 71 02600CSR 54 EXCPT PUT CONTD MSG. 02610CSR 54 SETOF 71 02620CSR SETON 72 02630CSR EXCPT PUT MENU LINE. 02640CSR SETOF 72 02650CSR SETON 78 02660CSR ENDSR 02670C******************************************************************** 02680CSR SR73 BEGSR 02690C* PUT MESSAGE. 02700CSR SETON 73 02710CSR EXCPT PUT MSG. 02720CSR SETOF 73 02730CSR ENDSR 02740C******************************************************************* 02750CSR SR75 BEGSR ÐÐ02760C* READ FROM TERMINAL 02770CSR SETOF 779096 02780CSR SETOF 939291 02790CSR SETOF 898887 02800CSR SETOF 8685 02810CSR MOVE BIT,7 A6,2 BUF LENGTH 02820CSR MOVEAA6 W6A 6 02830CSR MOVE BLK12 W12A 12 BUFFER 02840CSR EXITFQWREED READ TERM 02850CSR RLABL W12A 02860CSR RLABL W6A 02870CSR MOVEAW12A A12 02880CSR MOVE BLK12 W12A 02890CSR Z-ADD1 W 30 02900CSR '\' LOKUPA12,W 90 FLAG ESC 02910CSRN90 GOTO T75B NOT ESC 02920CSR 1 ADD W W 02930CSR W COMP 12 54 02940CSR 54 GOTO T75A BAD ESC 02950CSR A12,W COMP 'G' 98 GOODBY 02960CSR A12,W COMP 'E' 94 MENU 02970CSR A12,W COMP 'N' 93 NEW ITEM 02980CSR A12,W COMP 'J' 92 JUMP 02990CSR A12,W COMP 'F' 91 SKIP FRWRD 03000CSR A12,W COMP 'B' 89 SKIP BKWRD ÐÐ03010CSR A12,W COMP 'S' 88 SPACE FILL 03020CSR A12,W COMP 'H' 87 HOME 03030CSR A12,W COMP 'U' 86 UPDATE 03040CSR A12,W COMP 'R' 85 REPEAT 03050CSR 98 03060COR 94 03070COR 93 03080COR 92 03090COR 91 03100COR 89 03110COR 88 03120COR 87 03130COR 86 03140COR 85 GOTO END75 GOOD ESC 03150C*------------------------------------------------------------------ 03160CSR T75A TAG 03170C* FLAG BAD ESC INPUT 03180CSR Z-ADD318 M 96 FLAG ERROR 03190CSR GOTO END75 03200C*-------------------------------------------------------------------- 03210CSR T75B TAG 03220C* MOVE DATA 03230CSR Z-ADD1 W 03240CSR ' ' LOKUPA12,W 77 03250CSR 77 MOVEAA12,W W12A INPUT DATA ÐÐ03260C*-------------------------------------------------------------------- 03270CSR END75 TAG 03280C* INIT PREV ERROR MSG. 03290CSR LSTERR COMP 0 54 03300CSR 54 MOVE BLK35 MGTEXT 03310CSR 54 EXSR SR73 BLANK MESSAGE 03320CSR Z-ADD0 LSTERR 50 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR81 BEGSR 03360C* UPDATE JQMAST AND ALT-KEY FILES. 03370CSR TIME TIME 60 03380CSR SETON 81 03390CSR EXCPT 03400CSR SETOF 81 03410CSR ENDSR 03420C******************************************************************** 03430CSR SR101 BEGSR 03440C* INIT. 03450CSR MOVE BIT,1 NUL 03460CSR MOVE BIT,1 A6 03470CSR MOVE ' ' BLK35 35 03480CSR MOVE ' ' W8A 8 03490CSR Z-ADD0 W1N 10 03500CSR Z-ADD0 W2N 20 ÐÐ03510CSR MOVE ' ' W2A 2 03520CSR EXITFPGMINX 03530CSR RLABL W8A 03540CSR RLABL W2N 03550CSR RLABL W1N 03560CSR RLABL W2A 03570CSR MOVE W2A PORT 20 03580CSR PORT COMP 0 54 03590CSRN54 Z-ADD25 PORT 03600CSR PORT CHAINCRTFILE H9 03610C* DEFINE WORK FIELDS, ETC. 03620CSR MOVE ' ' BLK12 12 03630CSR MOVE ' ' BLK8 8 03640CSR ENDSR 03650C******************************************************************** 03660CSR SR102 BEGSR 03670C* DISPLAY MENU. 03680CSR MOVELCRDEPT W9A 9 03690CSR W9A SETLLUJMAST 03700C*------------------------------------------------------------------- 03710CSR T102A TAG 03720CSR SETOF 54 03730CSR READ UJMAST 54 03740CSR 54 GOTO END102 END FILE. 03750CSR UJSTAT COMP 'D' 54 ÐÐ03760CSR 54 GOTO T102A DELETED. 03770CSR UJDEPT COMP CRDEPT 54 03780CSRN54 CRDEPT COMP 840 54 03790CSRN54 GOTO END102 DONE. 03800CSR UJNAME CHAINBJMAST 60 03810CSRN60 BJSTAT COMP 'D' 60 03820CSR 60 SETON 83 03830CSR 60 EXCPT DELETE UJMAST. 03840CSR 60 SETOF 83 03850CSR 60 GOTO T102A 03860CSR 1 ADD COUNT COUNT 30 03870CSR Z-ADDCOUNT J 30 03880CSR Z-ADDCOUNT SEL,J 03890CSR MOVE BJNAME JOB,J 03900CSR EXSR SR72 DISPLAY MENU. 03910CSR GOTO T102A GET NEXT. 03920CSR END102 ENDSR 03930C******************************************************************** 03940CSR SR103 BEGSR 03950C* REQUEST NEED DATE AND TIME. 03960CSR SETON 75 03970CSR EXCPT DATE PROMPT. 03980CSR SETOF 75 03990CSR EXSR SR75 READ. 04000CSR 96 ERROR. ÐÐ04010COR 90 GOTO END103 ESCAPE. 04020CSR EXSR SR203 R. JUSTIFY. 04030CSR MOVE W12A JQNDAT DATE REQUESTED. 04040CSR SETON 76 04050CSR EXCPT TIME PROMPT. 04060CSR SETOF 76 04070CSR EXSR SR75 READ. 04080CSR 96 ERROR. 04090COR 90 GOTO END103 ESCAPE. 04100CSR EXSR SR203 R. JUSTIFY. 04110CSR MOVE W12A JQNTIM TIME REQUESTED. 04120CSR END103 ENDSR 04130C******************************************************************** 04140CSR SR104 BEGSR 04150C* UPDATE JOB QUEUE. 04160CSR EXSR SR201 GET JOB #. 04170CSR JOB,X CHAINBJMAST H8 GET JOB MAST. 04180CSR H8 Z-ADD100 M 96 FLAG PROG ERR. 04190CSR H8 EXSR SR999 04200CSR H8 GOTO END104 04210C* REQUEST # OF COPIES. 04220CSR BJPRTR COMP 'D' 54 04230CSRN54 BJPRTR COMP 'S' 54 04240CSR 54 EXSR SR202 REQUEST COPIES 04250CSR 96 ÐÐ04260COR 98 04270COR 94 04280COR 93 GOTO END104 04290C* UPDATE JQMAST AND ALT-KEY FILES. 04300CSR EXSR SR81 04310CSR END104 ENDSR 04320C******************************************************************** 04330CSR SR201 BEGSR 04340C* GET JOB #. 04350CSR Z-ADD1 RRN 50 04360CSR RRN CHAINJQCONT H7 04370CSR H7 GOTO END201 04380CSR 1 ADD JCJOB JCJOB 54 04390CSRN54 Z-ADD1 JCJOB 04400CSR SETON 82 04410CSR EXCPT REWRITE JQCONT. 04420CSR SETOF 82 04430CSR END201 ENDSR 04440C******************************************************************** 04450CSR SR202 BEGSR 04460C* REQUEST # OF COPIES. 04470CSR SETON 79 04480CSR EXCPT PROMPT. 04490CSR SETOF 79 04500CSR EXSR SR75 READ. ÐÐ04510CSR 96 04520COR 90 GOTO END202 04530CSR EXSR SR203 R. JUSTIFY. 04540CSR MOVE W12A CRCOPY 10 04550CSR END202 ENDSR 04560C******************************************************************** 04570CSR SR203 BEGSR 04580C* R. JUSTIFY. 04590CSR Z-ADD12 W2N 20 04600CSR EXIT SUBRAJ 04610CSR RLABL W2N 04620CSR RLABL W12A 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR999 BEGSR 04660C* GET/PUT MESSAGE. 04670CSR M CHAINMGFILE 54 GET MSG. 04680CSRN54 EXSR SR73 PUT MSG. 04690CSR ENDSR 04700O******************************************************************** 04710OTERM70 E 72N78 04720O* PUT HEADING. 04730O 70 'JOB QUEUE UPDATE' 04740O*----------------------------------------------------------------- 04750O E 71 ÐÐ04760O 6 'CONT''D' 04770O 70 'JOB QUEUE UPDATE' 04780O*------------------------------------------------------------------- 04790O E 73 04800O* PUT MESSAGE. 04810O NUL 70 04820O 96 5 '*****' 04830O MGTEXT 45 04840O 47 ' ' 04850O*------------------------------------------------------------------- 04860O E 74 04870O* REQUEST SELECTION. 04880O NUL 70 04890O 19 'ENTER SELECTION # ' 04900O BIT,8 70 04910O*------------------------------------------------------------------- 04920O E 75 04930O* REQUEST NEED DATE. 04940O NUL 70 04950O 16 'ENTER DATE REQ''D' 04960O 18 ' ' 04970O BIT,8 70 04980O*------------------------------------------------------------------- 04990O E 76 05000O NUL 70 ÐÐ05010O 23 'ENTER TIME-OF-DAY REQ''D' 05020O 25 ' ' 05030O BIT,8 70 05040O*----------------------------------------------------------------- 05050O E 79 05060O NUL 70 05070O 24 'ENTER NUMBER OF COPIES ' 05080O*------------------------------------------------------------------- 05090O E 72 05100O* DISPLAY MENU. 05110O NUL 70 05120O BLK8 8 05130O COUNT Z 3 05140O 5 ' ' 05150O BJDESC 45 05160O******************************************************************** 05170OJQMAST EADD 81 05180O* ADD NEW JOB QUEUE MAST. 05190O JCJOB 4 05200O BJPRTR 5 05210O BJUPD 6 05220O CRDEPT 11 05230O BJNAME 17 05240O BJPRTR 18 05250O BJPAP 43 ÐÐ05260O CRCOPY 44 05270O CRUSER 52 05280O UDATE 62 05290O TIME 68 05300O JQNDAT 74 05310O JQNTIM 80 05320O******************************************************************** 05330OJQCONT E 82 05340O JCJOB 4 05350O******************************************************************** 05360OJQDEVICEEADD 81 05370O* DEVICE ALT-KEY FILE. 05380O BJPRTR 1 05390O BJUPD 2 05400O JCJOB 6 05410O 8 'A' 05420O******************************************************************** 05430OJQDEPT EADD 81 05440O* DEPT ALT-KEY FILE. 05450O CRDEPT 5 05460O JCJOB 9 05470O******************************************************************** 05480OJQJOB EADD 81 05490O* JOB ALT-KEY FILE. 05500O BJNAME 6 ÐÐ05510O JCJOB 10 05520O******************************************************************** 05530OUJMAST E 83 05540O 12 'D' ** NUL ARRAY 005550 005560** A6 ARRAY 005570 005580** A12 ARRAY 005590 005600** SEL/JOB ARRAY 005610 005620/* 005630_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(~ š ~àX002FC P999999120282(èÈÐ00010H Q002FC00020F* UPDATE FORECAST MASTER. (X002FC) 00030F* REVISED 10-14-82 12:45 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FFORECASTUC F 675R11AI 1 DISK A 00080FFCMODEL UC F 24R13AI 1 DISK A 00090FALTPN UC F 32R29AI 1 DISK A 00100FALTDUE UC F 32R29AI 1 DISK A 00110FPMMST2 IC F 674R12AI 1 DISK 00120FPMMODEL2ID F 23L22AI 1 DISK 00130FFORECONTIC F 216R DISK 00140FTERM132 O F 132 5 00150F**************************************************************** 00160E NUL 1 132 1 NULL CHAR 00170E DOT 1 132 1 DIVIDER 00180E A30 30 30 1 A INPUT DATA ARRAY 00190E A9 9 9 1 EXITF QPREED PAR. 00200E NUM 1 24 3 0 NUMERIC FIELD NO.'S 00210E DUN 1 28 1 A EDIT CMPLT FLAG 00220E MES 1 1 30 00230E BB 1 24 7 0 BOOK - BKLG 00240E BW 1 24 7 0 WIP - BKLG 00250E BMU 1 12 7 0 OLD BOOK - USAGE ÐÐ00260E OLD 1 24 7 0A SEE SR212 00270E* FILE ARRAYS 00280E* CURRENT AND FUTURE PERIODS 00290E FBC 24 7 0A CUR BOOK FORECAST 00300E FWS 24 7 0 WIP SCHEDULE 00310E FBS 24 7 0 BACKLOG SCHEDULE 00320E FNO 24 5 0 NUMB OF ORDERS 00330E* PAST PERIODS 00340E FOB 12 7 0 OLD BOOK FORECAST 00350E FPB 12 7 0 PAST BOOK ACTUAL 00360E FPU 12 7 0 PAST USAGE 00370E FUF 12 5 0 USAGE FREQ 00380E FFD 24 6 0 FUTURE DATES 00390E FPD 12 6 0 HISTORY DATES 00400E* OTHER 00410E BIT 33 1 SCREEN CONTR. CHAR 00420I******************************************************************* 00430IBITTAB BT 00440I 1 33 BIT 00450I******************************************************************* 00460IMGFILE MG 00470I* MESSAGE FILE. 00480I 1 35 MGTEXT 00490I****************************************************************** 00500ICRTFILE CR ÐÐ00510I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00520I* STD AREA - SAME FOR ALL PROGRAMS. 00530I* EMPLOYEE # 5N 00540I 1 50CREMPL 00550I* USER CODE 8A 00560I 6 13 CRUSER 00570I* DEPT # 5N 00580I 14 180CRDEPT 00590I* JOB NAME 8A (JOB LOADED BY MENU) 00600I 19 26 CRJOB 00610I* SHUTDOWN FLAG 1A 00620I* BLANK = NO SHUTDOWN 00630I 27 27 CRSHUT 00640I* TIME STARTED 6N 00650I 28 330CRTIME 00660I* DATE STARTED 4N 00670I 34 370CRDATE 00680I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00690I 68 73 CRRET 00700I* MENU NAME 6A 00710I 74 79 CRMENU 00720I******************************************************************** 00730IFORECASTFC 00740I* FORECAST MASTER. 00750I* PART NUMBER 10N (KEY) ÐÐ00760I 1 100FCPN 00770I* VERSION 1A (KEY) 00780I 11 11 FCVERS 00790I* BOOKING FORECAST 24 X 7P 00800I P 12 107 FBC 00810I* FUTURE WIP SCHED 24 X 7P 00820I P 108 203 FWS 00830I* BACKLOG SCHEDULE 24 X 7P 00840I P 204 299 FBS 00850I* NUMB OF ORDERS 24 X 5P 00860I P 300 371 FNO 00870I* PAST ACTUAL BOOKINGS 12 X 7P 00880I P 372 419 FPB 00890I* PAST USAGE QTY 12 X 7P 00900I P 420 467 FPU 00910I* USAGE FREQUENCY 12 X 5P 00920I P 468 503 FUF 00930I* PAST FORECAST BOOKINGS 12 X 7P 00940I P 504 551 FOB 00950I* CUR MO. USAGE QTY 7P 00960I P 552 5550FCMQTY 00970I* CUR MO. USAGE FREQ 5P 00980I P 556 5580FCMFRQ 00990I* CURRENT ON HAND BAL 7P 01000I P 559 5620FCOHB ÐÐ01010I* MODEL 12A 01020I 563 574 FCMODL 01030I* PRODUCT CLASS 4N 01040I 575 5780FCPC 01050I* SOURCE CODE 1A 01060I 579 579 FCSC 01070I* UNIT COST 9.3P 01080I P 580 5843FCCOST 01090I* UNIT PRICE 9.2P 01100I P 585 5892FCPRIC 01110I* DESCRIPTION 29A 01120I 590 618 FCDESC 01130I* RECORD STATUS 1A 01140I 675 675 FCSTAT 01150I******************************************************************** 01160IFCMODEL FM 01170I* FORECAST MODEL ALT KEY 01180I* MODEL 12A 01190I 1 12 FMMODL 01200I* VERSION 1A 01210I 13 13 FMVERS 01220I* PART NO. 10N 01230I 14 230FMPN 01240I* RECORD STATUS 1A 01250I 24 24 FMSTAT ÐÐ01260I******************************************************************** 01270IALTPN FP 01280I* ALTERNATE KEY - PART NO. 01290I* PART NO. 10N 01300I* 1 100APPN 01310I* DUE DATE 6N 01320I* 11 160APDUE 01330I* RECORD CODE 2A 01340I* 17 18 APREC 01350I* ORDER NO. 11A 01360I* 19 29 APORD 01370I* RECORD STATUS 1A 01380I 32 32 APSTAT 01390I******************************************************************** 01400IALTDUE FD 01410I* ALTERNATE KEY - DUE DATE 01420I* RECORD CODE 2A 01430I* 1 2 ADREC 01440I* DUE DATE 6N (YMD) 01450I* 3 80ADDUE 01460I* ORDER NO. 11A 01470I* 9 19 ADORD 01480I* PART # 10N (REQUIREMENTS ONLY) 01490I* 20 290ADPN 01500I* RECORD STATUS 1A ÐÐ01510I 32 32 ADSTAT 01520I******************************************************************** 01530IFORECONTFT 01540I* FORECAST CALENDAR 01550I* FUTURE DATES 24 X 6N 01560I 1 144 FFD 01570I* PAST DATES 12 X 6 01580I 145 216 FPD 01590I******************************************************************** 01600IPMMST2 PM 01610I 15 180PMPL 01620I 19 30 PMMODL 01630I 31 59 PMDESC 01640I 96 96 PMPROV 01650I P 311 3140PMOHB 01660I P 489 4933PMOSUC 01670I P 512 5162PMLPR 01680I 674 674 PMSTAT 01690I********************************************************************* 01700IPMMODEL2PD 01710I 1 12 PDMODL 01720I 13 220PDPN 01730I 23 23 PDSTAT 01740C******************************************************************** 01750C* INITIALIZE ÐÐ01760C EXSR SR101 1-TIME INIT 01770C*------------------------------------------------------------------ 01780C START TAG 01790C* SET-UP 1ST FIELD NO. 01800C MOVE ' ' DUN INIT EDIT ARRAY 01810C Z-ADD1 F 30 FIELD # 01820C EXSR SR205 INIT FORECAST 01830C MOVE ' ' TRAN 01840C MOVE BLK25 TMODL 01850C MOVE ' ' TVERS 01860C MOVE BLK25 TRNNAM 01870C MOVE BLK35 PMDESC 01880C Z-ADD0 BB 01890C Z-ADD0 BW 01900C Z-ADD0 BMU 01910C GOTO READ 01920C*------------------------------------------------------------------ 01930C NEXT TAG 01940C* SET-UP NEXT FIELD NO. 01950C 1 ADD F F FIELD # 01960C*----------------------------------------------------------------- 01970C READ TAG 01980C* READ DATA FROM TERMINAL. 01990C SETOF 909677 02000C EXSR SR102 VALIDATE FIELD # ÐÐ02010C 55 GOTO UPDATE DONE 02020C EXSR SR203 CLASSIFY TRAN 02030C 62 F COMP 4 54 02040C 62 54 GOTO UPDATE DELETE 02050C EXSR SR201 IDENTIFY-F 02060C SETON 69 02070C EXSR SR72 PROMPT 02080C SETOF 69 02090C EXSR SR75 READ TERMINAL 02100C 98 GOTO GOODBY GOODBY 02110C 94 GOTO MENU MENU REQUEST 02120C 90 EXSR SR72 DISPLAY INPUT DATA 02130C 93 GOTO NEWITM NEW ITEM 02140C 92 GOTO JUMP FIELD JUMP REQST 02150C 89 F SUB 1 F SKIP BACKWARD 02160C 89 GOTO READ " " 02170C 88 SETOF 90 SPACE FILL 02180C 88 SETON 77 " " 02190C 86 GOTO UPDATE UPDATE 02200C 85 GOTO READ REPEAT 02210C 96 GOTO ERROR ERROR 02220C N77 GOTO EDIT NO DATA INPUT 02230C*------------------------------------------------------------------ 02240C PROCES TAG 02250C* PROCESS INPUT DATA ÐÐ02260C EXSR SR103 MOVE DATA 02270C*------------------------------------------------------------------- 02280C EDIT TAG 02290C N96 EXSR SR104 EDIT DATA 02300C EXSR SR72 REWRITE DATA 02310C 96 GOTO ERROR ERROR 02320C GOTO NEXT 02330C*------------------------------------------------------------------ 02340C UPDATE TAG 02350C* UPDATE DATA BASE. 02360C EXSR SR105 FINAL EDIT 02370C 96 GOTO ERROR ERROR 02380C EXSR SR106 UPDATE 02390C 96 GOTO ERROR ERROR 02400C EXSR SR70 PUT HEADING 02410C GOTO START 02420C*------------------------------------------------------------------- 02430C JUMP TAG 02440C* SET-UP JUMP TO REQUESTED FIELD 02450C 1 ADD W W 30 02460C W COMP 30 54 02470C 54 Z-ADD318 M 50 96 FLAG ERROR 02480C 54 GOTO ERROR BAD ESC 02490C MOVE ' ' W3A 3 02500C MOVEAA30,W W3A ÐÐ02510C Z-ADD3 W2N 20 02520C EXIT SUBRAJ R. JUSTIFY 02530C RLABL W2N 02540C RLABL W3A 02550C MOVE W3A F NEW FIELD # 02560C GOTO READ 02570C*-------------------------------------------------------------------- 02580C ERROR TAG 02590C EXSR SR102 VALIDATE FIELD # 02600C EXSR SR89 GET MSG 02610C EXSR SR73 PUT MSG 02620C GOTO READ 02630C*------------------------------------------------------------------ 02640C NEWITM TAG 02650C* SET-UP LINK FOR NEW ITEM 02660C MOVEL'Q002FC' PROG 8 02670C GOTO END 02680C*------------------------------------------------------------------- 02690C MENU TAG 02700C* SET-UP LINK TO MENU 02710C MOVELCRMENU PROG 02720C GOTO END 02730C*-------------------------------------------------------------------- 02740C GOODBY TAG 02750C* LINK TO SIGN-OFF ÐÐ02760C MOVEL'GOODBY' PROG 02770C GOTO END 02780C*------------------------------------------------------------------- 02790C END TAG 02800C EXITFCHAIN LINK TO NEXT PROG 02810C RLABL PROG 02820C*------------------------------------------------------------------- 02830C ENDJOB TAG 02840C********************************************************************* 02850CSR SR1 BEGSR 02860C* EDIT TRAN CODE. 02870CSR EXSR SR203 CLASSIFY TRAN 02880CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02890CSR ENDSR 02900C******************************************************************** 02910CSR SR2 BEGSR 02920C* EDIT MODEL/PART # INPUT. 02930CSR MOVELTMODL W22A 22 02940CSR W22A SETLLPMMODEL2 02950C*------------------------------------------------------------------- 02960CSR T2A TAG 02970CSR SETOF 60 02980CSR READ PMMODEL2 60 GET PMMODEL2 02990CSR 60 GOTO T2C END FILE 03000CSR PDSTAT COMP 'D' 54 ÐÐ03010CSR 54 GOTO T2A 03020CSR PDMODL COMP TMODL 54 03030CSRN54 GOTO T2C 03040CSR Z-ADDPDPN TPN 100 03050CSR GOTO T2P 03060C*------------------------------------------------------------------- 03070CSR T2C TAG 03080CSR MOVELW30A W10A 10 03090CSR Z-ADD20 W2N 03100CSR EXIT SUBRAJ 03110CSR RLABL W2N 03120CSR RLABL W10A 03130CSR MOVE W10A TPN 03140C*------------------------------------------------------------------- 03150CSR T2P TAG 03160CSR MOVELTPN W12A 12 03170CSR MOVE ' ' W12A 03180CSR W12A CHAINPMMST2 60 03190CSRN60 PMSTAT COMP 'D' 60 03200CSR 60 Z-ADD291 M 96 FLAG ERROR 03210CSR 60 GOTO END2 03220CSR MOVE PMMODL TMODL 03230CSR END2 ENDSR 03240C******************************************************************** 03250CSR SR3 BEGSR ÐÐ03260C* EDIT VERSION. 03270CSR MOVELTPN W11A 11 03280CSR MOVE TVERS W11A 03290CSR EXSR SR80 GET FORECAST 03300CSRN30N31 GOTO T3C GOT IT 03310C* NOT ON FILE CONDITION. 03320CSR EXSR SR205 INIT FORECAST 03330CSR EXSR SR203 CLASSIFY TRAN 03340CSRN60 Z-ADD302 M 96 FLAG ERROR 03350CSR EXSR SR214 UPDATE P/M DATA 03360CSR EXSR SR71 PUT DATA TO CRT 03370CSR GOTO END3 03380C*------------------------------------------------------------------- 03390CSR T3C TAG 03400C* IS ON FILE CONDITION. 03410CSR EXSR SR203 CLASSIFY TRAN 03420CSR 60 Z-ADD301 M 96 FLAG ERROR 03430CSR EXSR SR214 UPDATE P/M DATA 03440CSR EXSR SR213 CALC COMPARE VALUES 03450CSR EXSR SR71 PUT DATA 03460CSR END3 ENDSR 03470C******************************************************************** 03480CSR SR68 BEGSR 03490CSR EXITFQCLF LINE FEED 03500CSR ENDSR ÐÐ03510C**************************************************************** 03520CSR SR69 BEGSR 03530CSR EXITFQXYPOS MOVE CURSOR 03540CSR RLABL W6A 03550CSR ENDSR 03560C***************************************************************** 03570CSR SR70 BEGSR 03580C* CLEAR TERM SCREEN. 03590CSR EXITFZCPAGE CLEAR SCREEN 03600CSR SETON 70 03610CSR EXCPT TOP PAGE HDG 03620CSR SETOF 70 03630CSR Z-ADD91 COUNT 30 03640CSR ENDSR 03650C********************************************************************** 03660CSR SR71 BEGSR 03670C* PUT HEADINGS TO TERMINAL 03680CSR Z-ADDF SAVEF 30 03690CSR SETON 7170 03700CSR EXCPT PUT HEADINGS 03710CSR SETOF 7170 03720CSR Z-ADD99 COUNT 30 03730CSR Z-ADD4 F 03740C*------------------------------------------------------------------- 03750CSR T71C TAG ÐÐ03760CSR 1 ADD F F 03770CSR F COMP 28 54 03780CSR 54 GOTO END71 03790CSR EXSR SR201 IDENTIFY-F 03800CSR EXSR SR72 PUT DATA 03810CSR GOTO T71C 03820CSR END71 TAG 03830CSR Z-ADDSAVEF F 03840CSR EXSR SR201 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR72 BEGSR 03880C* PUT DATA TO TERMINAL 03890CSR Z-ADDF W2N 20 03900CSR F SUB 4 T 30 03910CSR F COMP 4 54 03920CSR 54 95 ADD T W3N 30 03930CSR T COMP 12 50 03940CSRN54 Z-ADD91 W3N 03950CSR MOVELW3N W6A 03960CSR MOVE '001' W6A 03970CSR EXSR SR69 MOVE CURSOR 03980CSR SETON 72 03990CSR EXCPT PUT DATA 04000CSR SETOF 72 ÐÐ04010CSR END72 ENDSR 04020C*********************************************************************** 04030CSR SR73 BEGSR 04040C* PUT ERROR MESSAGE TO TERMINAL 04050CSR MOVE '119001' W6A 6 04060CSR EXSR SR69 MOVE CURSOR 04070CSR SETON 73 04080CSR EXCPT PUT MSG 04090CSR SETOF 73 04100CSR ENDSR 04110C******************************************************************* 04120CSR SR75 BEGSR 04130C* READ FROM TERMINAL 04140CSR SETOF 779096 04150CSR SETOF 9392 04160CSR SETOF 8988 04170CSR SETOF 8685 04180CSR MOVE BIT,16 BUFLGT 2 READ BUFFER LGTH 04190CSR MOVE BLK30 W30A BUFFER 04200CSR MOVE BIT,28 A9,1 04210CSR MOVE '8' A9,2 04220CSR F COMP 4 54 04230CSR 54 96 ADD F W3N 30 04240CSR 54 W3N SUB 4 W3N 04250CSRN54 Z-ADD92 W3N ÐÐ04260CSR MOVE W3N W3A 3 04270CSR MOVEAW3A A9,3 04280CSR MOVEA'016' A9,6 04290CSR 01 MOVEA'018' A9,6 04300CSR 02 MOVEA'052' A9,6 04310CSR 03 MOVEA'085' A9,6 04320CSR 04 MOVEA'105' A9,6 04330CSR MOVE BIT,8 A9,9 04340CSR MOVEAA9 W9A 9 04350CSR EXITFQPREED READ FROM TERMINAL 04360CSR RLABL W9A STARTING POSITION 04370CSR RLABL W30A READ BUFFER 04380CSR RLABL BUFLGT READ BUFFER LGTH 04390CSR MOVEAW30A A30 INPUT DATA ARRAY 04400CSR MOVE BLK30 W30A 30 INIT INPUT ARRAY 04410CSR Z-ADD1 W 30 04420CSR '\' LOKUPA30,W 90 FLAG ESC 04430CSRN90 GOTO T75B NOT ESC 04440CSR 1 ADD W W 04450CSR W COMP 30 54 04460CSR 54 GOTO T75A BAD ESC 04470CSR A30,W COMP 'G' 98 GOODBY 04480CSR A30,W COMP 'E' 94 MENU 04490CSR A30,W COMP 'N' 93 NEW ITEM 04500CSR A30,W COMP 'J' 92 JUMP ÐÐ04510CSR A30,W COMP 'B' 89 SKIP BKWRD 04520CSR A30,W COMP 'S' 88 SPACE FILL 04530CSR A30,W COMP 'U' 86 UPDATE 04540CSR A30,W COMP 'R' 85 REPEAT 04550CSR 98 04560COR 94 04570COR 93 04580COR 92 04590COR 89 04600COR 88 04610COR 86 04620COR 85 GOTO END75 GOOD ESC 04630C*------------------------------------------------------------------ 04640CSR T75A TAG 04650C* FLAG BAD ESC INPUT 04660CSR Z-ADD318 M 96 FLAG ERROR 04670CSR GOTO END75 04680C*-------------------------------------------------------------------- 04690CSR T75B TAG 04700C* MOVE DATA 04710CSR Z-ADD1 W 04720CSR ' ' LOKUPA30,W 77 04730CSR 77 MOVEAA30,W W30A INPUT DATA 04740C*-------------------------------------------------------------------- 04750CSR END75 TAG ÐÐ04760C* INIT PREV ERROR MSG. 04770CSR LSTERR COMP 0 54 04780CSR 54 MOVE BLK35 MGTEXT 04790CSR 54 EXSR SR73 BLANK MESSAGE 04800CSR Z-ADD0 LSTERR 50 04810CSR ENDSR 04820C********************************************************************** 04830CSR SR80 BEGSR 04840C* GET MASTER RECORD 04850CSR MOVE BLK12 OLDMOD 12 04860CSR SETOF 31 04870CSR W11A CHAINFORECAST 30 GET MASTER 04880CSRN30 FCSTAT COMP 'D' 31 FLAG DELETE 04890CSRN30N31 MOVE FCMODL OLDMOD 04900CSR MOVE ' ' OLD 04910CSRN30N31 EXSR SR212 SET-UP ARRAY OLD 04920CSR ENDSR 04930C********************************************************************** 04940CSR SR81 BEGSR 04950C* ADD NEW MASTER TO FILE 04960CSR SETON 81 04970CSR EXCPT ADD MASTER 04980CSR SETOF 81 04990CSR ENDSR 05000C*********************************************************************** ÐÐ05010CSR SR82 BEGSR 05020C* REWRITE MASTER 05030CSR SETON 82 05040CSR EXCPT REWRITE MASTER 05050CSR SETOF 82 05060CSR ENDSR 05070C********************************************************************** 05080CSR SR89 BEGSR 05090C* GET MESSAGE MASTER 05100CSR M CHAINMGFILE 54 05110CSR 54 MOVE BLK35 MGTEXT 05120CSR 54 MOVELM MGTEXT 05130CSR 54 MOVE MES,1 MGTEXT 05140CSR ENDSR 05150C*********************************************************************** 05160CSR SR101 BEGSR 05170C* 1-TIME INITIALIZE 05180CSR MOVE BIT,1 NUL 05190CSR MOVE '-' DOT 05200CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05210CSR Z-ADD28 FLIMIT 30 TOTAL NUMB FIELDS 05220CSR MOVE ' ' BLK30 30 05230C* GET PORT # AND CRTFILE 05240CSR MOVE ' ' W8A 8 05250CSR Z-ADD0 W2N 20 ÐÐ05260CSR Z-ADD0 W1N 10 05270CSR MOVE ' ' W2A 2 05280CSR EXITFPGMINX GET PORT # 05290CSR RLABL W8A 05300CSR RLABL W2N 05310CSR RLABL W1N 05320CSR RLABL W2A 05330CSR MOVE W2A PORT 20 PORT NO. 05340CSR PORT COMP 0 54 05350CSRN54 Z-ADD25 PORT DEFAULT 05360CSR Z-ADD1 W5N 50 05370CSR W5N CHAINFORECONT H8 05380CSR H8 GOTO ENDJOB 05390CSR EXSR SR70 PUT HEADING 05400CSR PORT CHAINCRTFILE H9 05410C* DEFINE WORK FIELDS,ETC. 05420CSR Z-ADD0 ZERO7 70 05430CSR MOVE ' ' BLK35 35 05440CSR MOVE ' ' BLK12 12 05450CSR MOVE ' ' BLK25 25 05460CSR ENDSR 05470C********************************************************************** 05480CSR SR102 BEGSR 05490C* VALIDATE FIELD NO. 05500CSR F COMP 0 54 ÐÐ05510CSRN54 Z-ADD1 F 05520CSR F COMP FLIMIT 55 05530CSR 55 Z-ADD1 F 05540CSR ENDSR 05550C******************************************************************** 05560CSR SR103 BEGSR 05570C* MOVE INPUT DATA 05580CSR EXSR SR201 IDENTIFY-F 05590CSR EXSR SR202 R. JUSTIFY 05600CSR 01 MOVELW30A TRAN 1 TRAN CODE 05610CSR 02 MOVELW30A TMODL 12 05620CSR 03 MOVELW30A TVERS 1 05630CSR 04 MOVELW30A FCDESC 05640CSR 05 MOVE W10A FBC,1 05650CSR 06 MOVE W10A FBC,2 05660CSR 07 MOVE W10A FBC,3 05670CSR 08 MOVE W10A FBC,4 05680CSR 09 MOVE W10A FBC,5 05690CSR 10 MOVE W10A FBC,6 05700CSR 11 MOVE W10A FBC,7 05710CSR 12 MOVE W10A FBC,8 05720CSR 13 MOVE W10A FBC,9 05730CSR 14 MOVE W10A FBC,10 05740CSR 15 MOVE W10A FBC,11 05750CSR 16 MOVE W10A FBC,12 ÐÐ05760CSR 17 MOVE W10A FBC,13 05770CSR 18 MOVE W10A FBC,14 05780CSR 19 MOVE W10A FBC,15 05790CSR 20 MOVE W10A FBC,16 05800CSR 21 MOVE W10A FBC,17 05810CSR 22 MOVE W10A FBC,18 05820CSR 23 MOVE W10A FBC,19 05830CSR 24 MOVE W10A FBC,20 05840CSR 25 MOVE W10A FBC,21 05850CSR 26 MOVE W10A FBC,22 05860CSR 27 MOVE W10A FBC,23 05870CSR 28 MOVE W10A FBC,24 05880CSR MOVE ' ' DUN,F EDIT FLAG 05890CSR ENDSR 05900C******************************************************************** 05910CSR SR104 BEGSR 05920C* EDIT INPUT DATA 05930CSR 01 EXSR SR1 05940CSR 02 EXSR SR2 05950CSR 03 EXSR SR3 05960CSR 96 MOVE ' ' DUN,F EDIT FLAG 05970CSRN96 MOVE 'X' DUN,F 05980CSR ENDSR 05990C*********************************************************************** 06000CSR SR105 BEGSR ÐÐ06010C* FINAL EDIT 06020CSR SETOF 77 06030CSR SETON 79 FINAL EDIT FLAG 06040CSR Z-ADD1 F 96 06050C*-------------------------------------------------------------------- 06060CSR T105A TAG 06070CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06080CSRN54 GOTO END105 06090CSR EXSR SR201 IDENTIFY-F 06100CSR EXSR SR104 EDIT 06110CSRN96 GOTO T105A 06120C*-------------------------------------------------------------------- 06130CSR END105 TAG 06140CSR SETOF 79 06150CSR ENDSR 06160C******************************************************************** 06170CSR SR106 BEGSR 06180C* UPDATE DATA BASE. 06190CSR EXSR SR203 CLASSIFY TRAN 06200CSR 60 GOTO T106A ADD TRAN 06210CSR 61 GOTO T106D CHANGE TRAN 06220CSR 62 GOTO T106F DELETE TRAN 06230C* FLAG BAD TRAN CODE 06240CSR Z-ADD300 M 96 FLAG ERROR 06250CSR Z-ADD1 F FIELD # ÐÐ06260CSR GOTO END106 06270C*------------------------------------------------------------------- 06280CSR T106A TAG 06290C* ADD TRANSACTION 06300CSR 30 GOTO T106B NOT ON FILE 06310CSR 31 GOTO T106C DELETED MASTER 06320C* FLAG DUPLICATE ADD ERROR 06330CSR Z-ADD301 M 96 FLAG ERROR 06340CSR Z-ADD1 F FIELD # 06350CSR GOTO END106 06360C*--------------------------------------------------------------------- 06370CSR T106B TAG 06380C* ADD-- MAST NOT ON FILE 06390CSR EXSR SR81 ADD NEW MASTER 06400CSR EXSR SR210 ADD ALT KEY 06410CSR GOTO END106 06420C*--------------------------------------------------------------------- 06430CSR T106C TAG 06440C* ADD-- MAST IS DELETED 06450CSR MOVE 'A' FCSTAT RECORD STATUS 06460CSR EXSR SR82 REWRITE MAST 06470CSR GOTO END106 06480C*---------------------------------------------------------------------- 06490CSR T106D TAG 06500C* CHANGE TRANSACTION. ÐÐ06510CSRN30N31 GOTO T106E GOT IT 06520C* FLAG NO MASTER ERROR 06530CSR Z-ADD302 M 96 FLAG ERROR 06540CSR Z-ADD1 F FIELD # 06550CSR GOTO END106 06560C*----------------------------------------------------------------------- 06570CSR T106E TAG 06580C* REWRITE MASTER 06590CSR EXSR SR82 REWRITE MAST 06600CSR EXSR SR211 DELETE ALT KEY 06610CSR EXSR SR210 ADD ALT KEY 06620CSR GOTO END106 06630C*----------------------------------------------------------------------- 06640CSR T106F TAG 06650C* DELETE TRANSACTION 06660CSRN30N31 GOTO T106G GOT IT 06670C* FLAG NO MASTER ERROR 06680CSR Z-ADD302 M 96 FLAG ERROR 06690CSR Z-ADD1 F FIELD # 06700CSR GOTO END106 06710C*----------------------------------------------------------------------- 06720CSR T106G TAG 06730C* DELETE MASTER. 06740CSR 96 Z-ADD1 F FIELD # 06750CSR 96 GOTO END106 ERROR ÐÐ06760CSR MOVE 'D' FCSTAT RECORD STATUS 06770CSR EXSR SR82 REWRITE MASTER 06780CSR EXSR SR211 DELETE ALT KEY 06790CSR END106 ENDSR 06800C************************************************************************ 06810CSR SR201 BEGSR 06820C* IDENTIFY FIELD NO. 06830CSR F COMP 1 01 06840CSR F COMP 2 02 06850CSR F COMP 3 03 06860CSR F COMP 4 04 06870CSR F COMP 5 05 06880CSR F COMP 6 06 06890CSR F COMP 7 07 06900CSR F COMP 8 08 06910CSR F COMP 9 09 06920CSR F COMP 10 10 06930CSR F COMP 11 11 06940CSR F COMP 12 12 06950CSR F COMP 13 13 06960CSR F COMP 14 14 06970CSR F COMP 15 15 06980CSR F COMP 16 16 06990CSR F COMP 17 17 07000CSR F COMP 18 18 ÐÐ07010CSR F COMP 19 19 07020CSR F COMP 20 20 07030CSR F COMP 21 21 07040CSR F COMP 22 22 07050CSR F COMP 23 23 07060CSR F COMP 24 24 07070CSR F COMP 25 25 07080CSR F COMP 26 26 07090CSR F COMP 27 27 07100CSR F COMP 28 28 07110CSR ENDSR 07120C********************************************************************** 07130CSR SR202 BEGSR 07140C* RIGHT JUSTIFY 07150CSR F LOKUPNUM 54 07160CSRN54 GOTO END202 NOT NUMERIC FIELD 07170CSR Z-ADD10 W2N 20 07180CSR MOVELW30A W10A 10 07190CSR EXIT SUBRAJ R. JUSTIFY 07200CSR RLABL W2N 07210CSR RLABL W10A 07220CSR END202 ENDSR 07230C*********************************************************************** 07240CSR SR203 BEGSR 07250C* CLASSIFY TRAN CODE ÐÐ07260CSR TRAN COMP 'A' 60 ADD 07270CSR TRAN COMP 'C' 61 CHANGE 07280CSR TRAN COMP 'D' 62 DELETE 07290CSR MOVE ' ' TRNNAM 6 07300CSR 60 MOVE 'ADD' TRNNAM 07310CSR 61 MOVE 'CHANGE' TRNNAM 07320CSR 62 MOVE 'DELETE' TRNNAM 07330CSR ENDSR 07340C**************************************************************************07350CSR SR205 BEGSR 07360C* INIT FORECAST FILE. 07370CSR Z-ADD0 FCPN 07380CSR MOVE ' ' FCVERS 07390CSR Z-ADD0 FBC 07400CSR Z-ADD0 FWS 07410CSR Z-ADD0 FBS 07420CSR Z-ADD0 FNO 07430CSR Z-ADD0 FPB 07440CSR Z-ADD0 FPU 07450CSR Z-ADD0 FUF 07460CSR Z-ADD0 FOB 07470CSR Z-ADD0 FCMQTY 07480CSR Z-ADD0 FCMFRQ 07490CSR Z-ADD0 FCOHB 07500CSR MOVE BLK12 FCMODL ÐÐ07510CSR Z-ADD0 FCPC 07520CSR MOVE ' ' FCSC 07530CSR Z-ADD0 FCCOST 07540CSR Z-ADD0 FCPRIC 07550CSR MOVE BLK35 FCDESC 07560CSR MOVE ' ' FCSTAT 07570CSR ENDSR 07580C******************************************************************* 07590CSR SR210 BEGSR 07600C* ADD ALT KEY 07610CSR MOVELTMODL W13A 13 07620CSR MOVE TVERS W13A 07630CSR W13A CHAINFCMODEL 60 07640CSR MOVE 'A' FMSTAT 07650CSR SETON 83 07660CSR EXCPT ADD MODEL-AK 07670CSR SETOF 83 07680CSR Z-ADD1 X 30 07690C*------------------------------------------------------------------- 07700CSR T210B TAG 07710C* ADD ALT PN. 07720CSR ZERO7 LOKUPFBC,X 54 07730CSRN54 GOTO END210 07740CSR FBC,X COMP OLD,X 54 07750CSR 54 GOTO T210D ÐÐ07760CSR MOVE TPN W10A 07770CSR MOVE ' ' A30 07780CSR MOVEAW10A A30 07790CSR MOVE FFD,X W6A 07800CSR MOVEAW6A A30,11 07810CSR MOVEA'31' A30,15 07820CSR MOVEA'90' A30,17 07830CSR MOVE FBC,X W7A 7 07840CSR MOVEAW7A A30,19 07850CSR MOVEAA30 W29A 29 07860CSR W29A CHAINALTPN 60 07870CSR MOVE 'A' APSTAT 07880CSR SETON 80 07890CSR EXCPT ADD PN-AK 07900CSR SETOF 80 07910C* ADD ALT DUE. 07920CSR MOVE ' ' A30 07930CSR MOVEA'90' A30 07940CSR MOVEAW6A A30,3 07950CSR MOVEA'31' A30,7 07960CSR MOVEAW7A A30,9 07970CSR MOVEAW10A A30,20 07980CSR MOVE 'A' ADSTAT 07990CSR MOVEAA30 W29A 08000CSR W29A CHAINALTDUE 60 ÐÐ08010CSR SETON 84 08020CSR EXCPT ADD DUE-AK 08030CSR SETOF 84 08040C*---------------------------------------------------------------- 08050CSR T210D TAG 08060CSR 1 ADD X X 08070CSR X COMP 24 54 08080CSRN54 GOTO T210B 08090CSR END210 ENDSR 08100C******************************************************************** 08110CSR SR211 BEGSR 08120C* DELETE ALT KEY 08130CSR MOVELOLDMOD W13A 08140CSR MOVE TVERS W13A 08150CSR W13A CHAINFCMODEL 60 08160CSRN60 MOVE 'D' FMSTAT 08170CSRN60 SETON 83 08180CSRN60 EXCPT DELETE MODEL-AK 08190CSR SETOF 83 08200CSR Z-ADD1 X 08210C*------------------------------------------------------------------- 08220CSR T211B TAG 08230C* DELETE ALT PN. 08240CSR ZERO7 LOKUPOLD,X 54 08250CSRN54 GOTO END211 ÐÐ08260CSR OLD,X COMP FBC,X 54 08270CSR 54 GOTO T211D 08280CSR MOVE TPN W10A 08290CSR MOVE ' ' A30 08300CSR MOVEAW10A A30 08310CSR MOVE FFD,X W6A 08320CSR MOVEAW6A A30,11 08330CSR MOVEA'31' A30,15 08340CSR MOVEA'90' A30,17 08350CSR MOVE OLD,X W7A 08360CSR MOVEAW7A A30,19 08370CSR MOVEAA30 W29A 08380CSR W29A CHAINALTPN 60 08390CSRN60 MOVE 'D' APSTAT 08400CSRN60 SETON 80 08410CSRN60 EXCPT DELETE PN-AK 08420CSR SETOF 80 08430C* DELETE ALT DUE. 08440CSR MOVE ' ' A30 08450CSR MOVE '90' A30 08460CSR MOVEAW6A A30,3 08470CSR MOVEA'31' A30,7 08480CSR MOVEAW7A A30,9 08490CSR MOVEAW10A A30,20 08500CSR MOVE 'D' ADSTAT ÐÐ08510CSR MOVEAA30 W29A 08520CSR W29A CHAINALTDUE 60 08530CSRN60 SETON 84 08540CSRN60 EXCPT DELETE DUE-AK 08550CSR SETOF 84 08560C*------------------------------------------------------------------ 08570CSR T211D TAG 08580CSR 1 ADD X X 08590CSR X COMP 24 54 08600CSRN54 GOTO T211B 08610CSR END211 ENDSR 08620C******************************************************************** 08630CSR SR212 BEGSR 08640C* SAVE QTY IN OLD ARRAY, WHERE CURRENT SCHEDULE EXISTS. 08650C* (SEE SR80) 08660CSR Z-ADD1 X 30 08670C*------------------------------------------------------------------- 08680CSR T212C TAG 08690CSR ZERO7 LOKUPFBC,X 54 08700CSRN54 GOTO END212 08710CSR Z-ADDFBC,X OLD,X 08720CSR 1 ADD X X 08730CSR X COMP 24 54 08740CSRN54 GOTO T212C 08750CSR END212 ENDSR ÐÐ08760C******************************************************************** 08770CSR SR213 BEGSR 08780C* CALCULATE COMPARE VALUE ARRAYS 08790CSR FBC SUB FBS BB 08800CSR FWS SUB FBS BW 08810CSR FPB SUB FPU BMU 08820CSR END213 ENDSR 08830C*********************************************************************** 08840CSR SR214 BEGSR 08850C* UPDATE BOTH ADD * CHG FORECASTS WITH CURRENT P/M INFO 08860CSR MOVE PMDESC FCDESC 08870CSR Z-ADDPMOHB FCOHB ON HAND BALANCE 08880CSR Z-ADDPMPL FCPC PRODUCT CODE 08890CSR MOVE PMPROV FCSC PROV CODE 08900CSR Z-ADDPMOSUC FCCOST STD COST 08910CSR Z-ADDPMLPR FCPRIC LIST PRICE 08920CSR ENDSR 08930O******************************************************************** 08940OTERM132 E 70 08950O BIT,28 1 08960O 8 '8091001' 08970O UDATE 16 ' - - ' 08980O 69 'F O R E C A S T' 08990O 84 'U P D A T E' 09000O*------------------------------------------------------------------- ÐÐ09010O E 70 09020O OR 72 01 09030O OR 72 02 09040O OR 72 03 09050O OR 72 04 09060O 14 '(1) TRAN CODE:' 09070O TRAN 17 09080O TRNNAM 25 09090O 48 '(2) MODEL OR PART #:' 09100O TPN 62 ' - - ' 09110O 81 '(3) VERSION CODE:' 09120O TVERS 84 09130O 102 '(4) DESCRIPTION:' 09140O PMDESC 132 09150O*------------------------------------------------------------------- 09160O E 71 09170O DOT 132 09180O 1 '<' 09190O 85 '>' 09200O 87 '<' 09210O 132 '>' 09220O 86 '*' 09230O 49 'F O R E C A S T' 09240O 114 'H I S T O R Y' 09250O*------------------------------------------------------------------- ÐÐ09260O E 71 09270O 64 'FORECAST' 09280O 73 'W.I.P.' 09290O 86 '*' 09300O 125 'BOOKINGS' 09310O*------------------------------------------------------------------- 09320O E 71 09330O 23 'BOOKINGS' 09340O 33 'CURRENT' 09350O 53 'SCHED' 09360O 63 'MINUS' 09370O 72 'MINUS' 09380O 86 '*' 09390O 105 'BOOKINGS' 09400O 124 'MINUS' 09410O*------------------------------------------------------------------- 09420O E 71 09430O 23 'FORECAST' 09440O 33 'BACKLOG' 09450O 54 'W.I.P.' 09460O 64 'BACKLOG' 09470O 73 'BACKLOG' 09480O 86 '*' 09490O 104 'ACTUAL' 09500O 114 'USAGE' ÐÐ09510O 124 'USAGE' 09520O*------------------------------------------------------------------- 09530O E 72N01N02 09540O AND N03N04 09550O F Z 3 09560O 1 '(' 09570O 4 ')' 09580O W2N 3 09590O FFD,T 14 ' - - ' 09600O FBC,T 2 23 09610O FBS,T 2 32 09620O FWS,T 2 54 09630O BB,T K 64 09640O BW,T K 74 09650O 86 '*' 09660O N50 FPD,T 96 ' - - ' 09670O N50 FPB,T K 105 09680O N50 FPU,T 2 114 09690O N50 BMU,T K 124 09700O 28 BIT,28 131 09710O 28 132 'K' 09720O*-------------------------------------------------------------------- 09730O E 73 09740O NUL 132 09750O BIT,28 1 ÐÐ09760O 8 '8120087' 09770O MGTEXT 129 09780O BIT,28 130 09790O 131 'K' 09800O BIT,8 132 09810O******************************************************************** 09820OFORECASTEADD 81 09830O TPN 10 09840O TVERS 11 09850O FBC 107P 09860O FWS 203P 09870O FBS 299P 09880O FNO 371P 09890O FPB 419P 09900O FPU 467P 09910O FUF 503P 09920O FOB 551P 09930O FCMQTY 555P 09940O FCMFRQ 558P 09950O FCOHB 562P 09960O TMODL 574 09970O FCPC 578 09980O FCSC 579 09990O FCCOST 584P 10000O FCPRIC 589P ÐÐ10010O FCDESC 618 10020O 675 'A' 10030O*------------------------------------------------------------------- 10040O E 82 10050O FBC 107P 10060O FWS 203P 10070O FBS 299P 10080O FNO 371P 10090O FPB 419P 10100O FPU 467P 10110O FUF 503P 10120O FOB 551P 10130O FCMQTY 555P 10140O FCMFRQ 558P 10150O FCOHB 562P 10160O TMODL 574 10170O FCPC 578 10180O FCSC 579 10190O FCCOST 584P 10200O FCPRIC 589P 10210O FCDESC 618 10220O FCSTAT 675 10230O******************************************************************* 10240OFCMODEL EADD 83 60 10250O W13A 13 ÐÐ10260O TPN 23 10270O 24 'A' 10280O*---------------------------------------------------------------- 10290O E 83N60 10300O TPN 23 10310O FMSTAT 24 10320O******************************************************************** 10330OALTPN EADD 80 60 10340O W29A 29 10350O APSTAT 32 10360O*------------------------------------------------------------------- 10370O E 80N60 10380O APSTAT 32 10390O******************************************************************** 10400OALTDUE EADD 84 60 10410O W29A 29 10420O ADSTAT 32 10430O*------------------------------------------------------------------- 10440O E 84N60 10450O ADSTAT 32 10460O******************************************************************** ** NUL ARRAY 010470 010480** DOT ARRAY 10490 10500ÐÐ** A30 ARRAY 010510 010520** A9 ARRAY 10530 10540** NUM ARRAY 010550005 10560006 10570007 10580008 10590009 10600010 10610011 10620012 10630013 010640014 10650015 10660016 10670017 10680018 10690019 10700020 10710021 10720022 10730023 010740024 10750ÐÐ025 10760026 10770027 10780028 10790** DUN ARRAY 10800 010810** MES ARRAY 010820---MESSAGE NOT ON FILE--- 010830** BB 010840 10850** BW 10860 10870** BMU 10880 10890** OLD ARRAY 10900 10910/* 10920_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( "{  NX002LD P120282120282(èÈÐ00010H Q002LD00020F* LIST DAILY LABOR INPUT. (X002LD) 00030F* REVISED 3/05/81 11:00 AM. 00040FKPLABOR IP F 192 14AI 1 DISK 00050FORDERLOGIC F 32R13AI 1 DISK 00060FPJMAST IC F 170R12AI 1 DISK 00070FEMMAST IC F 1056R 5AI 3 DISK 00080FGLMAST IC F 165R11AI 3 DISK 00090FLABRATE IT F 80 EDISK 00100FDEPTNAMEIT F 80 EDISK 00110FPRINT O F 132 OF PRINTER 00120E******************************************************************** 00130E LABRATE TABDEP 1 10 5 0 TABRAT 9 LABOR RATES 00140E DEPTNAME TABDN 1 30 5 0 TABNAM 20 DEPT #/NAME 00150E A50 50 50 1 A 00160E WOQ 4 7 0 00170E WOD 6 6 0 00180E WOC 7 9 3 00190E ENJ 5 1 00200E ECJ 5 1 00210E EMN 2 30 00220E ECW 7 1 0 00230E ENW 7 1 0 00240E EJC 14 6 0 00250E ECD 8 6 0 ÐÐ00260E END 8 6 0 00270E ECM 23 7 2 00280E EYM 23 7 2 00290E PA$ 2 9 2 00300E PB$ 2 7 0 00310E PC$ 2 9 2 00320E GLA 12 11 2 ACTUAL $ 00330E ERR 5 5 0A 00340I******************************************************************** 00350IKPLABOR KL 01 102NCD 00360I* TIME CARD LABOR FILE. 00370I* KEY AREA. 00380I* JOB # 6A 00390I 1 60KLJOB 00400I* BATCH # 5N 00410I 7 90KLBAT 00420I* LAST SERIAL NO. 5N 00430I 10 140KLLUSN 00440I* EMPLOYEE # 5N 00450I 15 190KLEMPL 00460I* PORT # 2N 00470I 20 210KLPORT 00480I*------------------------------------------------------------------- 00490I* EMPLOYEE # 5N (5) 00500I 22 260KLEMPN ÐÐ00510I* DEPT WORKED 5N (5) 00520I 30 340KLDEPW 00530I* WORK ORDER PRIME 6A (6) 00540I 38 43 KLPRIM 00550I* WORK ORDER DASH 3N (3) 00560I 45 470KLDASH 49 00570I* ACCOUNT # 5N (5) 00580I 53 570KLACNT 00590I* HOURS WORKED 3.1N (4) 00600I 63 660KLHRS 00610I* DATE WORKED 6N (8) 00620I 73 800KLDATE 00630I* SHIFT PREMIUM 1A (1) 00640I 85 85 KLSHFT 00650I* REWORK CODE 1A (1) 00660I 93 93 KLRWK 00670I* ECN # 8A (8) 00680I 98 105 KLECN 00690I*------------------------------------------------------------------- 00700I* NON-INPUT FIELDS. 00710I* DEPT ASSIGNED 5P (5) 00720I P 145 1470KLDEPA 00730I* DATE INPUT 6N 00740I 148 1530KLDLT 00750I* ERROR ARRAY 5P X 5 ÐÐ00760I P 154 168 ERR 00770I*------------------------------------------------------------------- 00780I* RECORD STATUS 1A 00790I 192 192 KLSTAT 00800I GG 02 00810I******************************************************************** 00820IORDERLOGOL 00830I* RECORD CODE 2A 00840I* SAME AS SFMAST. 00850I* 1 2 OLREC 00860I* ORDER 11A 00870I* 3 13 OLORD 00880I* PART # 10N 00890I* 14 230OLPN 00900I* DUE 6N 00910I* 24 290OLDUE 00920I* RECORD STATUS 1A 00930I 32 32 OLSTAT 00940I******************************************************************** 00950IPJMAST PJ 00960I* PROJECT WORK ORDER. 00970I* WORK ORDER NO. 00980I* 1 9 PJORD 00990I* PRIME 6A 01000I* 1 6 PJPRIM ÐÐ01010I* DASH 3N 01020I* 7 90PJDASH 01030I* DEPT 3N 01040I* 10 120PJDEPT 01050I* ACCOUNT 5N 01060I* 13 170PJACNT 01070I* MODEL 12A 01080I* 18 29 PJMODL 01090I* DESCRIPTION 40A 01100I* 30 69 PJDESC 01110I* SCHEDULE. 01120I* START DATE 6N 01130I* 70 750PJBSD 01140I* COMPLETION DATE 6N 01150I* 76 810PJBCD 01160I* BUDGET - LABOR HRS 7P 01170I* P 82 850PJBLH 01180I* BUDGET - LABOR $ 7P 01190I* P 86 89 PB$,1 01200I* BUDGET - MATERIAL $ 7P 01210I* P 90 93 PB$,2 01220I* ACTUAL. 01230I* START DATE 6N 01240I* 94 990PJASD 01250I* COMPLETION DATE 6N ÐÐ01260I* 100 1050PJACD 01270I* LABOR HRS 7.1P 01280I* P 106 1091PJALH 01290I* LABOR $ 9.2P 01300I* P 110 114 PA$,1 01310I* MATERIAL $ 9.2P 01320I* P 115 119 PA$,2 01330I* STATUS. 01340I* LABOR - % COMPLETE 3.2P 01350I* P 120 1212PJLPCT 01360I* MATERIAL - % COMPLETE 3.2P 01370I* P 122 1232PJMPCT 01380I* CURRENT MONTH - ACTUAL. 01390I* LABOR HRS 7.1P 01400I* P 124 1271PJCLH 01410I* LABOR $ 9.2P 01420I* P 128 132 PC$,1 01430I* MATERIAL $ 9.2P 01440I* P 133 137 PC$,2 01450I* RECORD STATUS 1A 01460I 170 170 PJSTAT 01470I******************************************************************** 01480IEMMAST EM 01490I* EMPLOYEE MASTER. 01500I* EMPLOYEE NO. 5N ÐÐ01510I* 3 70EMCLOK 01520I* 1ST NAME 20A 01530I 8 27 EMFNAM 01540I* MIDDLE INITIAL 1A 01550I 28 28 EMINIT 01560I* LAST NAME 25A 01570I 29 53 EMLNAM 01580I* STREET-1 30A 01590I* 54 83 EMST1 01600I* STREET-2 30A 01610I* 84 113 EMST2 01620I* CITY 30A 01630I* 114 143 EMCITY 01640I* STATE CODE 2A 01650I* 144 145 EMSTCD 01660I* ZIP CODE 9P 01670I* P 146 1500EMZIP 01680I* TELEPHONE 14A 01690I* 151 164 EMPHON 01700I* NOTIFY 30A X 2 01710I* 165 224 EMN 01720I* SOCIAL SECURITY # 14A 01730I* 225 238 EMSSN 01740I* EEO CODE 1A X 8 01750I* 239 246 EMEEO ÐÐ01760I* CITIZENSHIP 14A 01770I* 247 260 EMCITZ 01780I* DATE OF BIRTH 6N 01790I* 261 2660EMDBIR 01800I* HI-SCHOOL GRAD 1A (Y,N) 01810I* 267 267 EMHIS 01820I* NUMB YRS COLLEGE 2N 01830I* 268 2690EMCOLY 01840I* EDUCATION REMARKS 30A 01850I* 270 299 EMCREM 01860I* HIRE SOURCE 30A 01870I* 300 329 EMHIRS 01880I* HIRE DATE-CURRENT 6N 01890I* 330 3350EMHIRC 01900I* HIRE DATE-ORIGINAL 6N 01910I* 336 3410EMHIRO 01920I* SENIORITY DATE 6N 01930I* 342 3470EMSEND 01940I* SPOUSE'S NAME 30A 01950I* 348 377 EMSNAM 01960I* SPOUSE'S BIRTHDATE 6N 01970I* 378 3830EMSBIR 01980I*------------------------------------------------------------------- 01990I* JOB STATUS FIELDS. 02000I* COMPANY CODE 2A ÐÐ02010I* 384 385 EMCCD 02020I* DEPT # 5P 02030I P 386 3880EMCDEP 02040I* WORK CENTER 3P 02050I* P 389 3900EMCWC 02060I* JOB CODE 8A 02070I* 391 398 EMCJC 02080I* JOB NAME 20A 02090I* 399 418 EMCJN 02100I* JOB CODES 1A X 5 02110I* 1=DIR/INDIR LABOR CODE (D/I) 02120I* 2=PERM/TEMP LABOR CODE (P/T) 02130I* 3=FULL/PART TIME LABOR CODE (F/T) 02140I* 4=HOURLY/SALARY LABOR CODE (H/S) 02150I* 5=ADMIN/FACTORY CODE (A/F) 02160I* 419 423 ECJ 02170I* PAY RATE 7.2P 02180I* P 424 4272EMCRAT 02190I* PAY UNIT 1A (H,D,W,S,M,Y) 02200I* 428 428 EMCPUM 02210I* PAY FREQUENCY 1A (D,W,S,M) 02220I* 429 429 EMCPFQ 02230I* WORK SHIFT 1N X 7 (1,2,3) 02240I* (1ST DAY IS SAT) 02250I* 430 436 ECW ÐÐ02260I* NEXT SCHED REVIEW DATE 6N 02270I* 437 4420EMNSRD 02280I*------------------------------------------------------------------- 02290I* JOB STATUS CHANGE PENDING AREA. 02300I* COMPANY 2A 02310I* 443 444 EMNCO 02320I* DEPT # 5P 02330I* P 445 4470EMNDEP 02340I* WORK CENTER 3P 02350I* P104810490EMNWC 02360I* JOB CODE 8A 02370I* 448 455 EMNJC 02380I* JOB NAME 20A 02390I* 456 475 EMNJN 02400I* JOB CODES 1A X 5 02410I* 1 = DIR/INDIR 02420I* 2 = PERM/TEMP 02430I* 3 = FULL/PART TIME 02440I* 4 = HRLY/SAL 02450I* 5 = ADMIN/FACTORY 02460I* 476 480 ENJ 02470I* PAY RATE 7.2P 02480I* P 481 4842EMNRAT 02490I* PAY UNIT 1A 02500I* 485 485 EMNPUM ÐÐ02510I* PAY FREQ 1A 02520I* 486 486 EMNPFQ 02530I* WORK SHIFT 1N X 7 02540I* 487 493 ENW 02550I* CHANGE EFFECTIVE DATES 6N X 14 02560I* 1 COMPANY 02570I* 2 DEPT 02580I* 3 WORK CENTER 02590I* 4 JOB CODE 02600I* 5 JOB NAME 02610I* 6 DIR/INDIR 02620I* 7 PERM/TEMP 02630I* 8 FULL/PART 02640I* 9 HRLY/SAL 02650I* 10 ADMIN/FACTORY 02660I* 11 PAY RATE 02670I* 12 PAY UNIT 02680I* 13 PAY FREQ 02690I* 14 SHIFT 02700I* 494 577 EJC 02710I*------------------------------------------------------------------- 02720I* DEDUCTIONS. 02730I* CURRENT PARAMETERS. 02740I* FED-INCOME-TAX: 02750I* NUMB EXEMPT 2N ÐÐ02760I* 578 5790EMCFEX 02770I* XTRA DEDUCTION 7.2P 02780I* P 580 5832EMCFX$ 02790I* XTRA DEDUCT FREQ 1A (W,S,M) 02800I* 584 584 EMCFXF 02810I* LAST REBATE AMOUNT 7.2P 02820I* P 585 5882EMFLRB 02830I* DATE 6N 02840I* 589 594 ECD,1 02850I* STATE-INCOME TAX: 02860I* NUMB EXEMPT 2N 02870I* 595 5960EMCSEX 02880I* XTRA DEDUCTION 7.2P 02890I* P 597 6002EMCSXD 02900I* XTRA DEDUCT FREQ 1A (W,S,M) 02910I* 601 601 EMCSXF 02920I* LAST REBATE 7.2P 02930I* P 602 6052EMSLRB 02940I* DATE 6N 02950I* 606 611 ECD,2 02960I* WORKMAN'S-COMP CODE 1A 02970I* 612 612 EMCWCC 02980I* DATE 6N 02990I* 613 618 ECD,3 03000I* INSURANCE: ÐÐ03010I* MEDICAL. 03020I* PLAN 1A 03030I* 619 619 EMCIMP 03040I* # DEPENDENTS 2N 03050I* 620 6210EMCIMD 03060I* DATE 6N 03070I* 622 627 ECD,4 03080I* DISABILITY. 03090I* PLAN 1A 03100I* 628 628 EMCIDP 03110I* DATE 6N 03120I* 629 634 ECD,5 03130I* SAVINGS: 03140I* ACCOUNT NO. 14A 03150I* 635 648 EMCSA 03160I* AMOUNT 7.2P 03170I* P 649 6522EMCS$ 03180I* FREQ 1A (W,S,M) 03190I* 653 653 EMCSFQ 03200I* DATE 6N 03210I* 654 659 ECD,6 03220I* CHECKING: 03230I* ACCOUNT # 14A 03240I* 660 673 EMCCA 03250I* AMOUNT 7.2P ÐÐ03260I* P 674 6772EMCC$ 03270I* FREQ 1A (W,S,M) 03280I* 678 678 EMCCF 03290I* DATE 6N 03300I* 679 684 ECD,7 03310I* U.S. BONDS: 03320I* TYPE 1A 03330I* 685 685 EMCSBT 03340I* AMOUNT 7.2P 03350I* P 686 6892EMCSB$ 03360I* FREQ 1A (W,S,M) 03370I* 690 690 EMCSBF 03380I* PREV CONVERSION AMT 7.2P 03390I* P 691 6942EMPCV$ 03400I* DATE 6N 03410I* 695 700 ECD,8 03420I*------------------------------------------------------------------- 03430I* DEDUCTIONS-CONT'D. 03440I* CHANGE-TO PARAMETERS. 03450I* FEDERAL-TAX: 03460I* NUMB EXEMPTIONS 2N 03470I* 701 7020EMNFEX 03480I* XTRA DEDUCTION 7.2P 03490I* P 703 7062EMNFX$ 03500I* FREQ 1A ÐÐ03510I* 707 707 EMNFXF 03520I* TO-BE-REBATED AMT 7.2P 03530I* P 708 7112EMFTBR 03540I* DATE 6N 03550I* 712 717 END,1 03560I* STATE-TAX: 03570I* NUMB EXEMPTIONS 2N 03580I* 718 7190EMNSEX 03590I* XTRA DEDUCTION 7.2P 03600I* P 720 7232EMNSX$ 03610I* FREQ 1A 03620I* 724 724 EMNSXF 03630I* TO-BE-REBATED AMT 7.2P 03640I* P 725 7282EMSTBR 03650I* DATE 6N 03660I* 729 734 END,2 03670I* WORKMAN'S-COMP CODE 1A 03680I* 735 735 EMNWCC 03690I* DATE 6N 03700I* 736 741 END,3 03710I* INSURANCE: 03720I* MEDICAL. 03730I* PLAN 1A 03740I* 742 742 EMNIMP 03750I* NUMB DEPENDENTS 2N ÐÐ03760I* 743 7440EMNIMD 03770I* DATE 6N 03780I* 745 750 END,4 03790I* DISABILITY. 03800I* PLAN 1A 03810I* 751 751 EMNIDP 03820I* DATE 6N 03830I* 752 757 END,5 03840I* SAVINGS: 03850I* ACCOUNT # 14A 03860I* 758 771 EMNSA 03870I* AMOUNT 7.2P 03880I* P 772 7752EMNSA$ 03890I* FREQ 1A 03900I* 776 776 EMNSAF 03910I* DATE 6N 03920I* 777 782 END,6 03930I* CHECKING: 03940I* ACCOUNT # 14A 03950I* 783 796 EMNCA 03960I* AMOUNT 7.2P 03970I* P 797 8002EMNC$ 03980I* FREQ 1A 03990I* 801 801 EMNCF 04000I* DATE 6N ÐÐ04010I* 802 807 END,7 04020I* U.S. BONDS: 04030I* TYPE 1A 04040I* 808 808 EMNSBT 04050I* AMOUNT 7.2P 04060I* P 809 8122EMNSB$ 04070I* FREQ 1A 04080I* 813 813 EMNSBF 04090I* TO BE CONVERTED 7.2P 04100I* P 814 8172EMTBC$ 04110I* DATE 6N 04120I* 818 823 END,8 04130I*------------------------------------------------------------------- 04140I* PAYROLL TOTALS. 04150I* CURRENT PERIOD - TOTALS 7.2P X 23 04160I* 1 = FED TAX-REGULAR 04170I* 2 = FED TAX-XTRA 04180I* 3 = STATE TAX-REGULAR 04190I* 4 = STATE TAX-XTRA 04200I* 5 = FICA 04210I* 6 = STATE DISABILITY 04220I* 7 = WORKMAN'S COMP 04230I* 8 = INSURANCE-MEDICAL 04240I* 9 = INSURANCE-DISABILITY 04250I* 10 = SAVINGS ÐÐ04260I* 11 = CHECKING 04270I* 12 = BONDS-DEDUCTED 04280I* 13 = FED-TAX REBATES 04290I* 14 = FED-TAX DEDUCTED AMT 04300I* 15 = STATE-TAX REBATES 04310I* 16 = STATE-TAX DEDUCTED AMT 04320I* 17 = BONDS-CONVERTED 04330I* 18 = REGULAR-PAY 04340I* 19 = OVERTIME-PAY 04350I* 20 = SHIFT PREM-PAY 04360I* 21 = OTHER PAY 04370I* 22,23 = NOT USED 04380I* P 824 915 ECM 04390I* YEAR-TO-DATE-TOTALS 7.2P X 23 04400I* P 9161007 EYM 04410I*------------------------------------------------------------------- 04420I* TERMINATION. 04430I* DATE 6N 04440I* 100810130EMTDAT 04450I* REASON CODE 2A 04460I* 10141015 EMTREA 04470I* REMARKS 30A 04480I* 10161045 EMTREM 04490I* RE-HIRE ELIGIBILITY CODE 2A 04500I* 10461047 EMTREC ÐÐ04510I* SEE WORK CENTER (JOB STAT CHG) P10481049------ 04520I* RECORD STATUS 1A 04530I 10561056 EMSTAT 04540I****************************************************************** 04550IGLMAST GL 04560I* ACCOUNT MASTER. 04570I* KEY AREA. 04580I* 3 13 GLKEY 04590I* ACCOUNT PREFIX 2A 04600I* 3 4 GLPRFX 04610I* ACCOUNT PRIME 6N 04620I* 5 100GLPRIM 04630I* ACCOUNT DASH 3N 04640I* 11 130GLDASH 04650I* ACCOUNT GROUP 4A 04660I* 14 17 GLGRUP 04670I* ACCOUNT DESCRIPTION 40A 04680I* 18 57 GLDESC 04690I* BALANCE FORWARD AMOUNT 11.2P 04700I* P 58 632GLBALF 04710I* ACTUAL $ 11.2P X 12 04720I* P 64 135 GLA 04730I* CURRENT MONTH-PLUSES 11.2P 04740I* P 136 1412GLCMP 04750I* CURRENT MONTH-MINUS 11.2P ÐÐ04760I* P 142 1472GLCMM 04770I* SOURCE CODE 1A 04780I* S = SUB-ACCOUNT ONLY, 04790I* MAY NOT BE PARENT 04800I* 148 148 GLSC 04810I* BALANCE FORWARD CODE 2A 04820I* 1ST COL 04830I* 1 = ZERO BAL AT START NEW YR 04840I* 2 = CARRY PREV YR FRWD 04850I* 2ND COL 04860I* A = ZERO BAL AT START NEW MO 04870I* B = CARRY PREV MO FRWD 04880I* 149 150 GLBFC 04890I* NUMB OF SUB-ACCOUNTS 5P 04900I* P 157 1590GLNOSA 04910I* LOW LEVEL CODE 3N 04920I* 160 1620GLLL 04930I* FILLER 04940I* RECORD STATUS 1A 04950I 165 165 GLSTAT 04960C******************************************************************** 04970C* INITIALIZE 1-TIME. 04980C SETOF 80 04990C N79 EXSR SR101 INIT 05000C N01 GOTO END DELETED REC ÐÐ05010C MOVELKLPRIM KLWO 9 05020C MOVE KLDASH KLWO 05030C SETON 80 05040C MOVE BLK20 DEPNAM 17 05050C KLDEPW LOKUPTABDN TABNAM 54 05060C 54 MOVE TABNAM DEPNAM 05070C* EDIT EMPLOYEE #. 05080C KLEMPL COMP 0 54 05090C N54 Z-ADD531 M 50 05100C N54 EXSR SR900 FLAG ERROR 05110C KLEMPN CHAINEMMAST 60 05120C N60 EMSTAT COMP 'D' 60 05130C 60 Z-ADD308 M 05140C 60 EXSR SR900 FLAG ERROR 05150C N60 Z-ADDEMCDEP KLDEPA DEPT ASSIGN 05160C N60 EXSR SR102 BUILD NAME 05170C* EDIT DEPT WORKED. 05180C KLDEPW COMP 0 54 05190C N54 Z-ADD232 M 05200C N54 EXSR SR900 FLAG ERROR 05210C KLDEPW LOKUPTABDEP TABRAT 54 05220C N54 Z-ADD232 M 05230C N54 EXSR SR900 FLAG ERROR 05240C* EDIT HOURS. 05250C KLHRS COMP 0 54 ÐÐ05260C N54 Z-ADD530 M 05270C N54 EXSR SR900 FLAG ERROR 05280C* EDIT JOB NO. 05290C* MATCH TO PROJECTS. 05300C MOVELKLWO W9A 9 05310C W9A CHAINPJMAST 54 05320C N54 GOTO TAG10 NO MATCH 05330C PJSTAT COMP 'D' 54 05340C N54 GOTO TAG30 MATCHED 05350C*------------------------------------------------------------------- 05360C TAG10 TAG 05370C* MATCH TO PROD WO. 05380C MOVELKLWO W11A 11 05390C MOVE '00' W11A 05400C MOVEL'20' W13A 13 05410C MOVE W11A W13A 05420C W13A CHAINORDERLOG 54 05430C 54 GOTO TAG20 NO HIT 05440C OLSTAT COMP 'D' 54 05450C N54 GOTO TAG30 GOT HIT 05460C MOVELKLWO W11A 05470C W11A CHAINGLMAST 54 05480C 54 GOTO TAG20 05490C GLSTAT COMP 'D' 54 05500C N54 GOTO TAG30 GOT HIT ÐÐ05510C Z-ADD309 M 05520C EXSR SR900 FLAG ERROR 05530C*------------------------------------------------------------------- 05540C TAG20 TAG 05550C*------------------------------------------------------------------- 05560C TAG30 TAG 05570C* 05580C* 05590C* 05600C*------------------------------------------------------------------- 05610C END TAG 05620CL0 EXSR SR901 PRINT 05630C******************************************************************** 05640CSR SR101 BEGSR 05650CSR SETON 79 05660CSR Z-ADD0 ZERO5 50 05670CSR MOVE ' ' BLK20 20 05680C* 05690CSR ENDSR 05700C******************************************************************** 05710CSR SR102 BEGSR 05720C* BUILD EMPLOYEE NAME. 05730CSR MOVE ' ' A50 05740CSR MOVEAEMFNAM A50,1 05750CSR EXSR SR201 GET NEW START ÐÐ05760CSR MOVE EMINIT A50,X 05770CSR 1 ADD X X 05780CSR X COMP 50 54 05790CSR 54 GOTO T102A 05800CSR MOVE '.' A50,X 05810CSR 2 ADD X X 05820CSR X COMP 50 54 05830CSR 54 GOTO T102A 05840CSR MOVEAEMLNAM A50,X 05850C*------------------------------------------------------------------- 05860CSR T102A TAG 05870CSR MOVEAA50,1 MANNAM 25 05880CSR ENDSR 05890C******************************************************************** 05900CSR SR201 BEGSR 05910C* FIND LAST NON-BLK CHAR. 05920CSR Z-ADD51 X 30 05930C*------------------------------------------------------------------- 05940CSR T201A TAG 05950CSR X SUB 1 X 54 05960CSRN54 Z-ADD1 X 05970CSRN54 GOTO END201 05980CSR A50,X COMP ' ' 54 05990CSRN54 GOTO T201A 06000CSR END201 ENDSR ÐÐ06010C******************************************************************** 06020CSR SR900 BEGSR 06030C* FLAG ERROR. 06040CSR Z-ADD1 E 30 06050CSR ZERO5 LOKUPERR,E 54 06060CSR 54 Z-ADDM ERR,M 06070CSR ENDSR 06080C******************************************************************** 06090CSR SR901 BEGSR 06100C* PRINT ERROR MSG. 06110CSR Z-ADD1 E 06120C*------------------------------------------------------------------- 06130CSR T901A TAG 06140CSR ZERO5 LOKUPERR,E 54 06150CSRN54 GOTO END901 06160CSR SETON 81 06170CSR EXCPT PUT MSG 06180CSR SETOF 81 06190CSR Z-ADD0 ERR,E 06200CSR GOTO T901A 06210CSR END901 ENDSR 06220O******************************************************************** 06230OPRINT H 201 1P 06240O OR OF 06250O UDATE Y 8 ÐÐ06260O 70 'TIME CARD INPUT' 06270O 127 'PAGE' 06280O PAGE Z 132 06290O*------------------------------------------------------------------- 06300O H 1 1P 06310O OR OF 06320O 5 'BATCH' 06330O 11 'EMPL' 06340O 44 'DEPT' 06350O 77 'JOB' 06360O 86 'NUMB' 06370O 96 'DATE' 06380O 105 'SHIFT' 06390O 114 'REWORK' 06400O 119 'ECN' 06410O*------------------------------------------------------------------- 06420O H 2 1P 06430O OR OF 06440O 4 'NUMB' 06450O 11 'NUMB' 06460O 44 'NUMB' 06470O 78 'NUMB' 06480O 87 'HOURS' 06490O 97 'WORKED' 06500O 106 'PREMIUM' ÐÐ06510O 113 'CODE' 06520O 122 'NUMBER' 06530O*------------------------------------------------------------------- 06540O D 1 1P 06550O OR OF 06560O KLBAT Z 5 06570O KLEMPNZ 12 06580O MANNAM 37 06590O KLDEPWZ 44 06600O DEPNAM 63 06610O KLPRIM 75 06620O KLDASHZ 79 06630O 49 76 '-' 06640O KLACNT 74 ' - ' 06650O KLHRS K 87 06660O KLDATEY 97 06670O KLSHFT 102 06680O KLRWK 110 06690O KLECN 124 ** A50 ARRAY 006700 006710/* 006720_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È#Ê ÈTX114BM P999999120282(èÈÐ00010H Q114BM00020F* PRINT COMP COST EXPLODED BY Q113BM. (X114BM) 00030F* REVISED 8-13-81 1:15 PM. 00040F* NOTE: MUST BE RUN AS PART OF Z114BM PROCEDURE. 00050FCOMPCOSTIP F 96 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FLABRATE IT F 80 EDISK 00080FPRINT O F 132 OF PRINTER 00090E******************************************************************** 00100E MHR 12 7 3A 00110E MDP 12 3 0A 00120E LABRATE TABDEP 1 11 5 0 TABRAT 9 LABOR RATES 00130I******************************************************************** 00140ICOMPCOSTCP 01 00150I 1 100CPN L3 00160I 11 200NAPN L1 00170I 21 300TAPN L2 00180I 31 59 DESCR 00190I 60 61 SC 00200I 62 63 PMISSU 00210I 64 65 BMISSU 00220I P 66 690BMQTY 00230I P 70 730EXTQTY 00240I 74 75 FAB 00250I P 76 803PMOSUC ÐÐ00260I P 81 853PMTCST 00270I P 86 870PMNOBM 00280I******************************************************************** 00290IPMMST2 PM 00300I P 543 590 MHR 00310I P 591 614 MDP 00320C******************************************************************** 00330C EXSR SR104 CLASSIFY 00340C 25 40 EXSR SR102 ASSY 00350C N25 40 EXSR SR103 NON-ASSY 00360CL3 EXSR SR105 TOTALS 00370C******************************************************************** 00380CSR SR102 BEGSR 00390CSR MOVELCPN W12A 12 00400CSR MOVE ' ' W12A 00410CSR W12A CHAINPMMST2 54 00420CSR 54 GOTO END102 00430CSR Z-ADD1 X 30 00440C*------------------------------------------------------------------- 00450CSR T102A TAG 00460CSR 000 LOKUPMDP,X 54 00470CSRN54 GOTO END102 00480CSR Z-ADDMDP,X W5N 50 00490CSR W5N LOKUPTABDEP TABRAT 54 00500CSRN54 GOTO END102 ÐÐ00510CSR MOVELTABRAT RATE 52 00520CSR MOVE TABRAT BURD 42 00530CSR MHR,X MULT RATE LAB$ 93 00540CSR BURD MULT LAB$ BUR$ 93 00550CSR EXTQTY MULT LAB$ LAB$ 00560CSR EXTQTY MULT BUR$ BUR$ 00570CSR EXTQTY ADD TOTQTY TOTQTY 00580CSR LAB$ ADD LABOR LABOR 93 00590CSR BUR$ ADD LABOH LABOH 93 00600CSR END102 ENDSR 00610C******************************************************************** 00620CSR SR103 BEGSR 00630CSR EXTQTY ADD TOTQTY TOTQTY 70 00640CSR EXTQTY MULT PMTCST MAT$ 93 00650CSR MAT$ ADD MATL MATL 93 00660CSR ENDSR 00670C******************************************************************** 00680CSR SR104 BEGSR 00690C* CLASSIFY PART. 00700CSR SC COMP 'MA' 20 00710CSR SC COMP 'MP' 21 00720CSR SC COMP 'PA' 22 00730CSR SC COMP 'PP' 23 00740CSR MOVELSC W1A 1 00750CSR W1A COMP 'R' 24 ÐÐ00760CSR PMNOBM COMP 0 25 00770CSR BMISSU COMP ' ' 54 00780CSRN54 MOVE PMISSU BMISSU 00790CSR BMISSU COMP 'PT' 26 00800CSR BMISSU COMP 'BI' 27 00810CSR BMISSU COMP 'RA' 28 00820CSR BMISSU COMP 'OR' 41 00830CSR MOVELBMISSU W1A 00840CSR W1A COMP 'R' 29 00850CSR MOVELFAB W1A 00860CSR W1A COMP '0' 30 00870CSR W1A COMP '1' 31 00880CSR W1A COMP '2' 32 00890CSR W1A COMP '5' 33 00900CSR W1A COMP '8' 34 00910CSR W1A COMP '9' 35 00920CSR SETOF 40 00930CSR 26 00940COR 27 00950COR 41 00960COR 28 SETON 40 00970CSR ENDSR 00980C******************************************************************** 00990CSR SR105 BEGSR 01000CSR MATL ADD TOTMAT TOTMAT 92H ÐÐ01010CSR LABOR ADD TOTLAB TOTLAB 92H 01020CSR LABOH ADD TOTOH TOTOH 92H 01030CSR MATL ADD LABOR LINCST 92H 01040CSR LABOH ADD LINCST LINCST 01050CSR LR TOTMAT ADD TOTLAB TOTCST 92H 01060CSR LR TOTOH ADD TOTCST TOTCST 01070CSR ENDSR 01080O******************************************************************** 01090OPRINT H 201 1P 01100O OR OF 01110O 76 'COSTED COMPONENT LISTING' 01120O UDATE Y 8 01130O 127 'PAGE' 01140O PAGE Z 132 01150O*------------------------------------------------------------------- 01160O H 1 1P 01170O OR OF 01180O 8 'PART-NO.' 01190O 25 'DESCRIPTION' 01200O 47 'SC' 01210O 58 'QUANTITY' 01220O 71 'LABOR' 01230O 84 'OVERHEAD' 01240O 97 'MATERIAL' 01250O 115 'TOTAL' ÐÐ01260O*------------------------------------------------------------------- 01270O TF11 L3 01280O CPN B 12 ' - - ' 01290O DESCR B 43 01300O SC B 47 01310O TOTQTY2B 58 01320O LABOR 2B 71 01330O LABOH 2B 84 01340O MATL 2B 97 01350O LINCST2B 112 01360O*------------------------------------------------------------------- 01370O TF11 LR 01380O 50 'TOTALS' 01390O TOTLAB2 71 01400O TOTOH 2 84 01410O TOTMAT2 97 01420O TOTCST2 112 /* 01430_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¶$ ¶ŒX004SO Pˆæ999999120282(èÈÐ00010H Q004SO00020F* INPUT SALES ORDER SHIPMENT. (X004SO) 00030F* REVISED 1-13-83 4:05 PM. 00040FBITPAR IP F 90 DISK 00050FSOMAST UC F 128R11AI 1 DISK 00060FPMMST2 UC F 674R12AI 1 DISK 00070FSOSHIP O F 100 DISK A 00080FCMMAST IC F 576R 5AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FCRTFILE UC F 256R DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A30 30 30 1 A INPUT DATA ARRAY 00150E NUM 1 11 3 0 NUMERIC FIELD NO.'S 00160E DUN 23 23 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E TABCC 1 17 2 TABCCN 20 CUSTOMER CLASS CODES 00190E A39 39 39 1 00200E DOT 40 40 1 00210E LNK 1 7 6 A 00220E BIT 33 1 SCREEN CONTR. CHAR 00230E PAR 25 1 00240E TST 25 1 00250E CALL 7 6 A ÐÐ00260I******************************************************************* 00270IBITPAR BT 00280I 1 33 BIT 00290I 35 58 PAR 00300I 59 83 TST 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I****************************************************************** 00360ICRTFILE CR 00370I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00380I* STD AREA - SAME FOR ALL PROGRAMS. 00390I* EMPLOYEE # 5N 00400I* 1 50CREMPL 00410I* USER CODE 8A 00420I* 6 13 CRUSER 00430I* DEPT # 5N 00440I* 14 180CRDEPT 00450I* JOB NAME 8A (JOB LOADED BY MENU) 00460I 19 26 CRJOB 00470I* SHUTDOWN FLAG 1A 00480I* BLANK = NO SHUTDOWN 00490I 27 27 CRSHUT 00500I* TIME STARTED 6N ÐÐ00510I 28 330CRTIME 00520I* DATE STARTED 4N 00530I 34 370CRDATE 00540I* CALL STACK 7 X 6A 00550I 38 79 CALL 00560I******************************************************************** 00570ISOMAST SO 00580I* SALES ORDER MASTER 00590I* SALES ORDER (KEY) 11A 00600I 1 11 SOSO 00610I* PRIME 6A (1A+5N) 00620I 1 6 SOSOP 00630I* ITEM 3N 00640I 7 90SOSOD 00650I* INCLUDES DASH # 2N 00660I 10 110SOINCL 00670I* CUSTOMER NO. 5P 00680I P 12 140SOCUST 00690I* CUSTOMER NAME (SORT CODE) 20A 00700I 15 34 SONAME 00710I* MODEL NO. 12A (IF STD PROD) 00720I 35 46 SOMODL 00730I* PART NO. 10N (IF STD PROD) 00740I 47 560SOPN 00750I* DESCRIPTION (NON-STD PROD)29A ÐÐ00760I 35 63 SODESC 00770I* QUANTITY REQUIRED 7P (BEFORE SHPMTS) 00780I P 64 670SOQTYR 00790I* QTY SHIPPED 7P 00800I P 68 710SOQTYS 00810I* FORECAST UPDATE QTY 7P 00820I P 72 750SOQTYF 00830I* DATE BOOKED 6N (Y,M,D) 00840I 76 810SOBOOK 00850I* DUE DATE 6N (Y,M,D) 00860I 82 870SODUE 00870I* ORIGIN CODE 3A 00880I 88 90 SOORGN 00890I* PROD CLASS 4N 00900I 91 940SOPC 00910I* CUSTOMER CLASS 2A 00920I 95 96 SOCC 00930I* TERMS 1A 00940I 97 97 SOTERM 00950I* UNIT PRICE 9.2P 00960I P 98 1022SOPRIC 00970I* DISCOUNT PERCENT .2N 00980I 103 1042SODISC 00990I* DATE LAST SHIPMENT 6N (YMD) 01000I 105 1100SODLS ÐÐ01010I* DATE LAST STOCK ISSUE 6N (YMD) 01020I 111 1160SODLK 01030I* QTY ISSUED FROM STOCK 7P 01040I P 117 1200SOQTYK 01050I* PRODUCT CODE 1A 01060I* Y = STD PRODUCT 01070I 121 121 SOPCOD 01080I* PRICE CODE 1A 01090I* N = NO CHARGE 01100I* L = LOT CHARGE 01110I* DEFAULT = UNIT COST 01120I 122 122 SOPRCD 01130I* RECORD STATUS 1A 01140I 128 128 SOSTAT 01150I******************************************************************** 01160IPMMST2 PM 01170I* PART MASTER FILE 01180I* PRODUCT CLASS 4N 01190I 15 180PMPC 01200I* MODEL NO. 12A 01210I 19 30 PMMODL 01220I* DESCRIPTION 29A 01230I 31 59 PMDESC 01240I* ON HAND STOCK 7P 01250I P 311 3140PMOHB ÐÐ01260I* SALES ORDER BALANCE 7P 01270I P 327 3300PMSOB 01280I* BACKORDERS 7P 01290I P 335 3380PMBOB 01300I* SHIPMENTS 7P 01310I P 359 3620PMPSHP 01320I* B/O FREQ 5P 01330I P 422 4240PMFBO 01340I* GSA PRICE 9.2P 01350I P 502 5062PMGSA 01360I* LIST PRICE 9.2P 01370I P 512 5162PMLIST 01380I* RECORD STATUS 1A 01390I 674 674 PMSTAT 01400I******************************************************************* 01410ICMMAST CM 01420I* CUSTOMER MASTER 01430I* CUSTOMER # 5N 01440I 1 50CMCUST 01450I* SORT KEY 20A 01460I 6 25 CMSORT 01470I* CUST NAME 35A 01480I 26 60 CMNAME 01490I* CUSTOMER CLASS 2A 01500I 363 364 CMCC ÐÐ01510I* PAYMENT TERMS 8A 01520I 372 379 CMTERM 01530I* RECORD STATUS 1A 01540I 576 576 CMSTAT 01550C******************************************************************** 01560C* INITIALIZE 01570C EXSR SR101 1-TIME INIT 01580C MOVE ' ' BLK6 6 STUPIDITY 01590C*------------------------------------------------------------------ 01600C START TAG 01610C* SET-UP 1ST FIELD NO. 01620C SETOF 404142 01630C SETOF 4344 01640C Z-ADD0 TINCL 01650C Z-ADD0 TSOD 01660C MOVE ' ' DUN INIT EDIT ARRAY 01670C Z-ADD1 F 30 FIELD # 01680C EXSR SR70 CLEAR NEW PAGE 01690C GOTO READ 01700C*------------------------------------------------------------------ 01710C NEXT TAG 01720C* SET-UP NEXT FIELD NO. 01730C 1 ADD F F FIELD # 01740C EXSR SR65 INIT A39 01750C*----------------------------------------------------------------- ÐÐ01760C READ TAG 01770C* READ DATA FROM TERMINAL. 01780C SETOF 909677 01790C EXSR SR102 VALIDATE FIELD # 01800C 55 GOTO UPDATE DONE 01810C* SET-UP FIELD DEFAULTS/BYPASSES BY CHANGING VALUE OF "F" 01820C EXSR SR201 IDENTIFY-F 01830C SETON 69 01840C EXSR SR72 PROMPT 01850C SETOF 69 01860C EXSR SR75 READ TERMINAL 01870C 90 EXSR SR72 DISPLAY INPUT DATA 01880C 92 GOTO JUMP FIELD JUMP REQST 01890C 89 F SUB 1 F SKIP BACKWARD 01900C 89 GOTO READ " " 01910C 88 SETOF 90 SPACE FILL 01920C 88 SETON 77 " " 01930C 86 GOTO UPDATE UPDATE 01940C 85 GOTO READ REPEAT 01950C 96 GOTO ERROR ERROR 01960C N77 GOTO EDIT NO DATA INPUT 01970C*------------------------------------------------------------------ 01980C PROCES TAG 01990C* PROCESS INPUT DATA 02000C EXSR SR103 MOVE DATA ÐÐ02010C*------------------------------------------------------------------- 02020C EDIT TAG 02030C N96 EXSR SR104 EDIT DATA 02040C N96 EXSR SR72 REWRITE DATA 02050C 96 GOTO ERROR ERROR 02060C GOTO NEXT 02070C*------------------------------------------------------------------ 02080C UPDATE TAG 02090C* UPDATE DATA BASE. 02100C EXSR SR105 FINAL EDIT 02110C 96 GOTO ERROR ERROR 02120C EXSR SR106 UPDATE 02130C 96 GOTO ERROR ERROR 02140C GOTO START 02150C*------------------------------------------------------------------- 02160C JUMP TAG 02170C* SET-UP JUMP TO REQUESTED FIELD 02180C 1 ADD W W 30 02190C W COMP 30 54 02200C 54 Z-ADD318 M 50 96 FLAG ERROR 02210C 54 GOTO ERROR BAD ESC 02220C MOVE ' ' W3A 3 02230C MOVEAA30,W W3A 02240C Z-ADD3 W2N 20 02250C EXIT SUBRAJ R. JUSTIFY ÐÐ02260C RLABL W2N 02270C RLABL W3A 02280C MOVE W3A F NEW FIELD # 02290C GOTO READ 02300C*-------------------------------------------------------------------- 02310C ERROR TAG 02320C EXSR SR102 VALIDATE FIELD # 02330C EXSR SR89 GET MSG 02340C SETON 78 02350C GOTO READ 02360C*------------------------------------------------------------------ 02370C NEWITM TAG 02380C* SET-UP LINK FOR NEW ITEM 02390C MOVEL'Q004SO' PROG 8 02400C GOTO END 02410C*------------------------------------------------------------------- 02420C MENU TAG 02430C* SET-UP LINK TO MENU 02440C EXSR SR96 GET CRTFILE 02450C Z-ADD1 W 02460C BLK6 LOKUPLNK,W 54 02470C N54 MOVEL'CONTU' PROG 8 02480C 54 MOVELLNK,W PROG 02490C 54 MOVE BLK6 LNK,W 02500C EXSR SR97 UPD CRTFILE ÐÐ02510C EXSR SR98 >>>>>>>>>> 02520C*-------------------------------------------------------------------- 02530C GOODBY TAG 02540C* LINK TO SIGN-OFF 02550C MOVEL'GOODBY' PROG 02560C GOTO END 02570C*------------------------------------------------------------------- 02580C END TAG 02590C EXSR SR96 GET CRTFILE 02600C EXSR SR97 UPDATE CRTFILE 02610C EXSR SR98 >>>>>>>>>> 02620C*------------------------------------------------------------------- 02630C ENDJOB TAG 02640C MOVEL'ENDJOB' PROG 02650C EXSR SR98 >>>>>>>>>> 02660C******************************************************************* 02670CSR SR1 BEGSR 02680C* EDIT SALES ORDER # (LESS INCLUDES DASH) 02690CSR MOVE TSOP W5N 50 02700CSR W5N COMP 0 54 02710CSRN54 Z-ADD341 M 96 FLAG ERROR 02720CSRN54 GOTO END1 02730CSR TSOD COMP 0 54 02740CSRN54 Z-ADD47 M 96 FLAG ERROR 02750CSR END1 ENDSR ÐÐ02760C******************************************************************** 02770CSR SR2 BEGSR 02780C* EDIT INCLUDES DASH NO. 02790CSR SETOF 414243 02800CSR SETOF 4445 02810CSR MOVELTSO W11A 11 02820CSR MOVE TINCL W11A 02830CSR EXSR SR80 GET SALES ORDER 02840CSRN30N31 GOTO T2C GOT IT 02850CSR Z-ADD662 M 96 FLAG ERROR 02860CSR GOTO END2 02870C*------------------------------------------------------------------- 02880CSR T2C TAG 02890C* IS ON FILE. 02900CSR EXSR SR212 CLASSIFY PROD CODE 02910CSR EXSR SR213 CLASSIFY PRICE CODE 02920CSR 41 EXSR SR84 GET PART MAST 02930CSR 41 60 Z-ADD291 M 96 FLAG ERROR 02940CSR END2 ENDSR 02950C******************************************************************** 02960CSR SR3 BEGSR 02970C* EDIT QTY SHIPPED. 02980CSR TQTY COMP 0 54 02990CSRN54 Z-ADD184 M 96 FLAG ERROR 03000CSRN54 GOTO END3 ÐÐ03010CSR SOQTYR SUB SOQTYS PREVBO 70 54 03020CSRN54 Z-ADD0 PREVBO 03030CSR TQTY ADD SOQTYS SOQTYS UPDATE QTY COMPLETE 03040CSR SOQTYS COMP SOQTYR 54 03050CSR 54 Z-ADD607 M FLAG OVERSHIP WARN 03060CSR 54 EXSR SR89 GET MSG 03070CSR SOQTYR SUB SOQTYS QTYBO 70 54 03080CSRN54 Z-ADD0 QTYBO 03090CSR END3 ENDSR 03100C******************************************************************** 03110CSR SR65 BEGSR 03120CSR MOVEABLK35 A39,3 INIT MSG ARRAY 03130CSR ENDSR 03140C******************************************************************** 03150CSR SR66 BEGSR 03160C* SET-UP MESSAGE ARRAY. 03170CSR MOVE BIT,28 A39,1 03180CSR MOVE 'D' A39,2 03190CSR MOVEABLK35 A39,3 03200CSR MOVE BIT,28 A39,38 03210CSR MOVE 'E' A39,39 03220CSR ENDSR 03230CSR SR68 BEGSR 03240CSR EXITFZLF LINE FEED 03250CSR ENDSR ÐÐ03260C**************************************************************** 03270CSR SR69 BEGSR 03280CSR 50 EXITFZPUTXY MOVE CURSOR 03290CSR RLABL RPGLIN 03300CSR RLABL RPGCOL 03310CSRN50 EXITFZMOVXY MOVE CURSOR 03320CSR RLABL RPGLIN 03330CSR RLABL RPGCOL 03340CSR ENDSR 03350C***************************************************************** 03360CSR SR70 BEGSR 03370C* CLEAR PAGE, PUT HEADINGS. 03380CSR 50 EXITFZISTAT INIT STATUS 03390CSR 50 EXITFZESCH CLEAR SCREEN 03400CSR EXSR SR65 INIT A39 03410CSRN50 EXITFZCPAGE CLEAR SCREEN 03420CSR SETON 70 03430CSRN51 EXCPT PUT HEADINGS 03440CSR SETOF 70 03450CSR Z-ADD93 COUNT 30 03460CSR ENDSR 03470C********************************************************************** 03480CSR SR71 BEGSR 03490C* PUT DATA RECORD TO TERMINAL 03500CSRN50 MOVEL'093' RPGLIN ÐÐ03510CSR 50 MOVEL'003' RPGLIN 03520CSR MOVEL'001' RPGCOL 03530CSR EXSR SR69 MOVE CURSOR 03540CSR TSOD COMP 0 55 03550CSRN55 TINCL COMP 0 55 03560CSR SETON 71 03570CSR EXCPT PUT SOMAST TO CRT 03580CSR SETOF 71 03590CSR ENDSR 03600C********************************************************************* 03610CSR SR72 BEGSR 03620C* PUT DATA LINE TO TERMINAL 03630CSR TSOD COMP 0 55 03640CSRN55 TINCL COMP 0 55 03650CSR F ADD COUNT W3N 30 03660CSR W3N SUB 1 W3N 30 03670CSR 50 W3N SUB 90 W3N 03680CSR MOVELW3N RPGLIN 4 03690CSR MOVEL'001' RPGCOL 4 03700CSR EXSR SR69 MOVE CURSOR 03710CSR SETON 72 03720CSR EXCPT PUT DATA LINE 03730CSR SETOF 72 03740CSR ENDSR 03750C******************************************************************* ÐÐ03760CSR SR75 BEGSR 03770C* READ FROM TERMINAL 03780CSR SETOF 779096 03790CSR SETOF 9392 03800CSR SETOF 8988 03810CSR SETOF 8685 03820CSR F ADD COUNT W3N 03830CSR 50 W3N SUB 90 W3N 03840CSR MOVELW3N RPGLIN 03850CSR MOVEL'044' RPGCOL 03860CSR MOVE BLK30 W30A 30 BUFFER 03870CSR EXITFZR30 READ FROM TERMINAL 03880CSR RLABL W30A READ BUFFER 03890CSR MOVEAW30A A30 INPUT DATA ARRAY 03900CSR MOVE BLK30 W30A INIT INPUT ARRAY 03910CSR Z-ADD1 W 30 03920CSR '\' LOKUPA30,W 90 FLAG ESC 03930CSRN90 GOTO T75B NOT ESC 03940CSR 1 ADD W W 03950CSR W COMP 30 54 03960CSR 54 GOTO T75A BAD ESC 03970CSR A30,W COMP 'G' 98 GOODBY 03980CSR A30,W COMP 'E' 94 MENU 03990CSR A30,W COMP 'N' 93 NEW ITEM 04000CSR A30,W COMP 'J' 92 JUMP ÐÐ04010CSR A30,W COMP 'B' 89 SKIP BKWRD 04020CSR A30,W COMP 'S' 88 SPACE FILL 04030CSR A30,W COMP 'U' 86 UPDATE 04040CSR A30,W COMP 'R' 85 REPEAT 04050CSR 98 GOTO GOODBY 04060CSR 94 GOTO MENU 04070CSR 93 GOTO NEWITM 04080CSR 92 04090COR 89 04100COR 88 04110COR 86 04120COR 85 GOTO END75 GOOD ESC 04130C*------------------------------------------------------------------ 04140CSR T75A TAG 04150C* FLAG BAD ESC INPUT 04160CSR Z-ADD318 M 96 FLAG ERROR 04170CSR GOTO END75 04180C*-------------------------------------------------------------------- 04190CSR T75B TAG 04200C* MOVE DATA 04210CSR Z-ADD1 W 04220CSR ' ' LOKUPA30,W 77 04230CSR 77 MOVEAA30,W W30A INPUT DATA 04240C*-------------------------------------------------------------------- 04250CSR END75 TAG ÐÐ04260C* INIT PREV ERROR MSG. 04270CSR EXSR SR65 INIT MSG ARRAY 04280CSR ENDSR 04290C********************************************************************** 04300CSR SR80 BEGSR 04310C* GET MASTER RECORD 04320CSR SETOF 3141 04330CSR W11A CHAINSOMAST 30 GET MASTER 04340CSRN30 SOSTAT COMP 'D' 31 FLAG DELETE 04350CSR ENDSR 04360C*********************************************************************** 04370CSR SR82 BEGSR 04380C* REWRITE MASTER 04390CSR TQTY COMP PREVBO 5455 04400CSR 54 PMBOB SUB PREVBO PMBOB 04410CSRN54 PMBOB SUB TQTY PMFBO 04420CSR 55 1 ADD PMFBO PMFBO 04430CSR TQTY ADD PMSOB PMSOB 04440CSR TQTY ADD PMPSHP PMPSHP 04450CSR PMOHB SUB TQTY PMOHB 04460CSR SETON 82 04470CSR EXCPT REWRITE MASTER 04480CSR SETOF 82 04490CSR ENDSR 04500C**************************************************************** ÐÐ04510CSR SR84 BEGSR 04520C* GET PART MASTER 04530CSR MOVELSOPN W12A 12 04540CSR MOVE ' ' W12A 04550CSR W12A CHAINPMMST2 60 04560CSRN60 PMSTAT COMP 'D' 60 04570CSR ENDSR 04580C********************************************************************** 04590CSR SR89 BEGSR 04600C* GET MESSAGE MASTER 04610CSR M CHAINMGFILE 54 04620CSR 54 MOVE BLK35 MGTEXT 04630CSR 54 MOVELM MGTEXT 04640CSR 54 MOVE MES,1 MGTEXT 04650CSR MOVEAMGTEXT A39,3 04660CSR ENDSR 04670C******************************************************************** 04680CSR SR96 BEGSR 04690CSR # CHAINCRTFILE H9 GET CRTFILE 04700CSR H9 GOTO ENDJOB 04710CSR ENDSR 04720C******************************************************************** 04730CSR SR97 BEGSR 04740C* UPDATE CRTFILE. EXIT PROGRAM. 04750CSR TIME CRTIME ÐÐ04760CSR MOVELUDATE CRDATE 04770CSR SETON 97 04780CSR EXCPT UPDATE CRTFILE 04790CSR SETOF 97 04800CSR ENDSR 04810C******************************************************************** 04820CSR SR98 BEGSR 04830CSR SETON 51 04840CSR EXSR SR70 CLEAR SCREEN 04850CSR EXITFCHAIN >>>>>>>>>> 04860CSR RLABL PROG 04870CSR ENDSR 04880C******************************************************************** 04890CSR SR101 BEGSR 04900C* 1-TIME INITIALIZE 04910CSR MOVE BIT,1 NUL 04920CSR EXSR SR66 SET-UP A39 04930CSR Z-ADD6 FLIMIT 30 TOTAL NUMB FIELDS 04940CSR MOVELUDATE W4N 40 04950CSR MOVE UDATE W2N 04960CSR MOVELW2N TODAY 60 CURRENT DATE YMD 04970CSR MOVE W4N TODAY 04980CSR MOVE ' ' BLK30 30 04990C* GET PORT # AND CRTFILE 05000CSR MOVE ' ' W2A 2 ÐÐ05010CSR EXITFZGMINX GET PORT # 05020CSR RLABL W2A 05030CSR MOVE W2A # 20 PORT NO. 05040CSR # COMP 0 54 05050CSRN54 Z-ADD25 # DEFAULT 05060CSR EXSR SR96 GET CRTFILE 05070CSR MOVE CALL LNK 05080CSR PAR,# COMP '1' 50 05090CSR TST,# COMP 'S' 56 05100CSR 56 MOVE 'SHUTDOWN'PROG 8 05110CSR EXSR SR97 >>>>>>>>>> 05120CSR 56 EXSR SR98 >>>>>>>>>> 05130C* DEFINE WORK FIELDS,ETC. 05140CSR MOVE ' ' BLK35 35 05150CSR MOVE ' ' BLK6 6 05160CSR MOVE ' ' BLK15 15 05170CSR MOVE ' ' BLK20 20 05180CSR MOVE ' ' BLK12 12 05190CSR ENDSR 05200C********************************************************************** 05210CSR SR102 BEGSR 05220C* VALIDATE FIELD NO. 05230CSR F COMP 0 54 05240CSRN54 Z-ADD1 F 05250CSR F COMP FLIMIT 55 ÐÐ05260CSR 55 Z-ADD1 F 05270CSR ENDSR 05280C******************************************************************** 05290CSR SR103 BEGSR 05300C* MOVE INPUT DATA 05310CSR EXSR SR201 IDENTIFY-F 05320CSR EXSR SR202 R. JUSTIFY 05330CSR 01 EXSR SR210 BUILD SALES ORDER 05340CSR 02 MOVE W15A TINCL 20 INCLUDES DASH NO. 05350CSR 03 MOVE W15A TQTY 70 QTY SHIPPED 05360CSR 04 MOVELW30A TCAR 12 CARRIER 05370CSR 05 MOVELW30A TWBILL 15 WAYBILL # 05380CSR MOVE ' ' DUN,F EDIT FLAG 05390CSR ENDSR 05400C******************************************************************** 05410CSR SR104 BEGSR 05420C* EDIT INPUT DATA 05430CSR 01 EXSR SR1 05440CSR 02 EXSR SR2 05450CSR 03 EXSR SR3 05460CSR 96 MOVE ' ' DUN,F EDIT FLAG 05470CSRN96 MOVE 'X' DUN,F 05480CSR ENDSR 05490C*********************************************************************** 05500CSR SR105 BEGSR ÐÐ05510C* FINAL EDIT 05520CSR SETOF 77 05530CSR SETON 79 FINAL EDIT FLAG 05540CSR Z-ADD1 F 96 05550C*-------------------------------------------------------------------- 05560CSR T105A TAG 05570CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05580CSRN54 GOTO END105 05590CSR EXSR SR201 IDENTIFY-F 05600CSR EXSR SR104 EDIT 05610CSRN96 GOTO T105A 05620C*-------------------------------------------------------------------- 05630CSR END105 TAG 05640CSR SETOF 79 05650CSR ENDSR 05660C******************************************************************** 05670CSR SR106 BEGSR 05680C* UPDATE. 05690CSRN30N31 GOTO T106C 05700C* FLAG SALES ORDER NOT ON FILE. 05710CSR Z-ADD662 M 96 FLAG ERROR 05720CSR GOTO END106 05730C*------------------------------------------------------------------- 05740CSR T106C TAG 05750CSR EXSR SR82 UPDATE SOMAST ÐÐ05760CSR END106 ENDSR 05770C********************************************************************* 05780CSR SR201 BEGSR 05790C* IDENTIFY FIELD NO. 05800CSR F COMP 1 01 05810CSR F COMP 2 02 05820CSR F COMP 3 03 05830CSR F COMP 4 04 05840CSR F COMP 5 05 05850CSR ENDSR 05860C********************************************************************** 05870CSR SR202 BEGSR 05880C* RIGHT JUSTIFY 05890CSR F LOKUPNUM 54 05900CSRN54 GOTO END202 NOT NUMERIC FIELD 05910CSR Z-ADD15 W2N 20 05920CSR MOVELW30A W15A 15 05930CSR EXIT SUBRAJ R. JUSTIFY 05940CSR RLABL W2N 05950CSR RLABL W15A 05960CSR END202 ENDSR 05970C******************************************************************** 05980CSR SR210 BEGSR 05990C* BUILD SALE ORDER NO. 06000CSR MOVEAW30A A30 ÐÐ06010CSR Z-ADD1 W 06020CSR '-' LOKUPA30,W 54 06030CSRN54 Z-ADD7 W 06040CSR MOVEAA30,W W4A 4 06050CSR 54 MOVEL' ' W4A 06060CSR Z-ADD4 W2N 06070CSR EXIT SUBRAJ RJ 06080CSR RLABL W2N 06090CSR RLABL W4A 06100CSR MOVE W4A TSOD 30 SALE ORDER DASH 06110CSR MOVEABLK30 A30,W 06120CSR A30,1 COMP '0' 54 54 06130CSR 54 MOVEAA30,1 W5A 5 06140CSR 54 MOVEL' ' TSOP 6 06150CSRN54 MOVEAA30 TSOP 06160CSRN54 MOVE TSOP W5A 06170CSR Z-ADD5 W2N 06180CSR EXIT SUBRAJ RJ 06190CSR RLABL W2N 06200CSR RLABL W5A 06210CSR MOVE W5A TSOP SALE ORDER DASH 06220CSR MOVELTSOP TSO SALE ORDER NO. 06230CSR MOVE TSOD TSO 9 06240CSR MOVELTSOP PREFIX 1 06250CSR MOVE TSOP SOSOP ÐÐ06260CSR Z-ADDTSOD SOSOD 06270CSR MOVE TSO SOSO 06280CSR ENDSR 06290C****************************************************************** 06300CSR SR212 BEGSR 06310C* CLASSIFY PRODUCT CODE 06320CSR SOPCOD COMP 'Y' 41 FLAG STD PRODUCT 06330CSRN41 SOPCOD COMP 'S' 41 06340CSR ENDSR 06350C****************************************************************** 06360CSR SR213 BEGSR 06370C* CLASSIFY PRICE CODE 06380CSR SOPRCD COMP 'N' 42 NO CHARGE 06390CSR SOPRCD COMP 'L' 43 LOT CHARGE 06400CSR SOPRCD COMP 'G' 45 GSA PRICE 06410CSR ENDSR 06420O******************************************************************** 06430OTERM132 E 71 06440O BIT,28 1 06450O N50 8 '8091001' 06460O N50 BIT,1 9 06470O N50 BIT,1 10 06480O 50 10 '[001 ]001' 06490O 50 BIT,28 6 06500O UDATE 18 ' - - ' ÐÐ06510O 78 'S H I P M E N T I N P ' 06520O 81 'U T' 06530O*------------------------------------------------------------------- 06540O E 71 06550O 1 ' ' 06560O*------------------------------------------------------------------- 06570O E 71 06580O OR 72 01 06590O DOT 40 06600O 24 '(1) ENTER ORDER-ITEM NO' 06610O TSOP 48 06620O 49 '-' 06630O TSOD 52 06640O CMNAME 90 06650O A39 132 06660O*------------------------------------------------------------------- 06670O E 71 06680O OR 72 02 06690O DOT 40 06700O 24 '(2) ENTER INCLUDES DASH' 06710O 36 '# (PARTIAL)' 06720O TINCL Z 44 06730O 41 SOPN 58 ' - - ' 06740O 41 SOMODL 72 06750O N41 SODESC 71 ÐÐ06760O A39 132 06770O*------------------------------------------------------------------- 06780O E 71 06790O OR 72 03 06800O DOT 40 06810O 22 '(3) ENTER QTY SHIPPED' 06820O TQTY K 52 06830O 63 'ORDERED:' 06840O SOQTYR2 72 06850O 79 'B/O:' 06860O QTYBO K 89 06870O A39 132 06880O*------------------------------------------------------------------- 06890O E 71 06900O OR 72 04 06910O DOT 40 06920O 18 '(4) ENTER CARRIER' 06930O TCAR 54 06940O A39 132 06950O*------------------------------------------------------------------- 06960O E 71 06970O OR 72 05 06980O DOT 40 06990O 14 '(5) WAYBILL #' 07000O TWBILL 57 ÐÐ07010O A39 132 07020O******************************************************************** 07030OSOMAST E 82 07040O SOCUST 14P 07050O SONAME 34 07060O 41 SOMODL 46 07070O 41 SOPN 56 07080O N41 SODESC 63 07090O SOQTYR 67P 07100O SOQTYS 71P 07110O SOQTYF 75P 07120O SOBOOK 81 07130O SODUE 87 07140O SOORGN 90 07150O SOPC 94 07160O SOCC 96 07170O SOTERM 97 07180O SOPRIC 102P 07190O SODISC 104 07200O SODLS 110 07210O SODLK 116 07220O SOQTYK 120P 07230O SOPCOD 121 07240O SOPRCD 122 07250O SOSTAT 128 ÐÐ07260O***************************************************************** 07270OSOSHIP EADD 82 07280O SOSO 11 07290O 41 SOPN 21 07300O 41 SOMODL 33 07310O N41 SODESC 40 07320O SOCUST 43P 07330O TQTY 47P 07340O QTYBO 51P 07350O TCAR 63 07360O TWBILL 78 07370O TODAY 84 07380O SODUE 90 07390O 92 ' ' 07400O******************************************************************** 07410OPMMST2 E 82 07420O PMOHB 314P 07430O PMSOB 330P 07440O PMBOB 338P 07450O PMPSHP 362P 07460O PMFBO 424P 07470O PMGSA 506P 07480O PMLIST 516P 07490O******************************************************************** 07500OCRTFILE E 97 ÐÐ07510O PROG 26 07520O CRTIME 33 07530O CRDATE 37 07540O LNK 79 07550O* ** NUL ARRAY 007560 007570** A30 ARRAY 007580 007590** NUM ARRAY 007600004 INCLUDES DASH 07610005 CUST NO. 07620** DUN ARRAY 007630 007640** MES ARRAY 007650---MESSAGE NOT ON FILE--- 007660** TABCC/TABCCN 00767010COMMERCIAL END USER 0768015U.S. GOVERNMENT 0769020GENERAL O.E.M. 0770021BROADCAST O.E.M. 0771030GENERAL LINE DEALER 0772031BROADCAST DEALER 0773033BROADCAST DLR,BRANCH 0774034GEN LINE DLR,BRANCH 07750ÐÐ35DESIGNATED PROD DLR 0776050SPECIAL 0777060AVIONICS END USER 0778065AVIONICS OEM 0779070AVIONICS DISTRIB 0780075AVIONICS REPAIR SHOP 0781090AVIONICS SPECIAL 0782098TO BE DELETED 0783099DISCONTINUED DLR 07840** A39 ARRAY 07850 07860** DOT ARRAY 07870 - - - - - - - - - - - - - - - - -> 07880** LNK ARRAY 07890 07900/* 07910_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(7%¬ 7XOF P999999120282(èÈÐ SUBROUTINE ZOF (REQBUF,FILNAM,ACCESS,IERROR) 00010* OPEN FILE. 00020*--------------------------------------------------------------------------00030* REQBUF = FILE MGR REQUEST BUFFER 00040* FILNAM = FILE MGR 00050* ACCESS = SEE IDATA (13) 00060* IERROR = ERROR FLAG, ASCII HEX CHAR 00070*--------------------------------------------------------------------------00080* IDATA 1-4 FILE NAME, 8-CHAR 00090* IDATA 5-8 OWNER, 8-CHAR 00100* IDATA 9-12 PACK NAME, 8-CHAR 00110* IDATA 13 ACCESS INDICATOR, 1-WORD INTEGER 00120* 0 = BY RRN 00130* 1 = BY INDEX KEY #1 00140* 2 = BY INDEX KEY #2 00150* 3 = BY INDEX KEY #3 00160* 4 = BY INDEX KEY #4 00170* -1 = ACCESS FOR COMPRESSION 00180* IDATA 14 NUMBER OF RECORDS PER ACCESS, INTEGER 00190* (MUST BE = 1 IF INDEX FILE) 00200* IDATA 15 LOCK INDICATOR (IGNORED BY OPEN FOR COMPRESSION) 00210* 0 = NO AUTOMATIC LOCKING PERFORMED 00220* >0 = RECORD LOCKING 00230* <0 = FILE IS LOCKED 00240* IERROR ERROR FLAG, ASCII HEX CHAR 00250ÐÐ*--------------------------------------------------------------------------00260 INTEGER FILNAM (4) 00270 INTEGER REQBUF (24) 00280 INTEGER IDATA (15) 00290 INTEGER ACCESS (3) 00300 INTEGER IERROR(2) 00310 DO 5 I=1, 2 00320 5 IERROR(I) = $2020 00330 DO 10 I = 1, 24 00340 10 REQBUF (I) = 0 00350 DO 20 I = 1, 20 00360 20 IDATA (I) = $2020 00370 DO 30 I = 1, 4 00380 30 IDATA (I) = FILNAM (I) 00390 IDATA (13) = 0 00400 CALL DECHEX (ACCESS,IDATA(13)) 00410 IDATA (14) = 1 00420 IDATA (15) = 1 00430 ISTAT = 0 00440 DO 40 I = 1, 24 00450 40 REQBUF (I) = $0000 00460 CALL OPENFL (REQBUF,IDATA,ISTAT) 00470 IF (ISTAT.GE.$8000) CALL HEXASC (ISTAT,IERROR) 00480 RETURN 00490 END 00500ÐÐ_‚ _‚_‚ INTEGER IERROR(2) 00310 DO 5 I=1, 2 00320 5 IERROR(I) = $2020 00330 DO 10 I = 1, 24 00340 10 REQBUF (I) = 0 00350 DO 20 I = 1, 20 00360 20 IDATA (I) = $2020 00370 DO 30 I = 1, 4 00380 30 IDATA (I) = FILNAM (I) 00390 IDATA (13) = 0 00400 CALL DECHEX (ACCESS,IDATA(13)) 00410 IDATA (14) = 1 00420 IDATA (15) = 1 00430 ISTAT = 0 00440 DO 40 I = 1, 24 00450 40 REQBUF (I) = $0000 00460 CALL OPENFL (REQBUF,IDATA,ISTAT) 00470 IF (ISTAT.GE.$8000) CALL HEXASC (ISTAT,IERROR) 00480 RETURN 00490 END 00500ÐÈ(è%Ä è¡X002QM P120282120282(èÈÐ00010H Q002QM00020F* INIT CRT512 (QMMAST) AND PUT QUOTE INPUT SCREEN. (X002QM) 00030F* REVISED 3/09/81 2:30 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FQMMAST UC F 160R 8AI 1 DISK 00070FCRT512 UC F 512R DISK 00080FSLMNAME IT F 80 EDISK 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E SLMNAME TABSLM 1 15 3 TABSLN 20 SALESMAN 00120E TABPRD 1 18 2 TABPRN 20 PROD CODE 00130E TABSYS 1 2 1 TABSYN 20 SYST CODE 00140E TABSTC 1 6 1 TABSTN 10 STATUS WORD 00150E TABRES 1 5 1 TABREN 20 REASON LOST 00160E NUL 1 132 1 NULL CHAR 00170E A6 6 6 1 CALL READ PARAM. 00180E A40 40 40 1 A INPUT DATA ARRAY 00190E DUN 3 3 1 A EDIT CMPLT FLAG 00200E INT 3 3 1 00210E MES 1 1 30 00220E HED 1 22 36 00230E TRN 1 3 6 00240E QMD 6 7 0 DATE ARRAY 00250E CRD 6 7 0 ÐÐ00260E BIT 33 1 SCREEN CONTR. CHAR 00270E CALL 5 6 CALL STACK 00280I******************************************************************* 00290IBITTAB BT 00300I 1 33 BIT 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I******************************************************************** 00360IQMMAST QM 00370I* QUOTE MASTER. 00380I* QUOTE # 5A 00390I* 1 5 QMQOTE 00400I* ITEM # 3N 00410I 6 80QMITEM 00420I* CUSTOMER NAME 20A 00430I 9 28 QMNAME 00440I* CUSTOMER RFQ # 20A 00450I 29 48 QMRFQ 00460I* RFQ ITEM # 4A 00470I 49 52 QMRFQI 00480I* CONTACT 20A 00490I 53 72 QMCONT 00500I* ASSIGNED TO (SALESMAN) 3A ÐÐ00510I 73 75 QMSLSM 00520I* DATE ARRAY 7P X 6 00530I* 1 = RECEIVED 00540I* 2 = DUE 00550I* 3 = SENT 00560I* 4 = EXPECTED AWARD 00570I* 5 = FOLLOW-UP 00580I* 6 = NOT USED 00590I P 76 99 QMD 00600I* PRODUCT CLASS 2A 00610I 100 101 QMPCLS 00620I* SYSTEM CODE 1A 00630I 102 102 QMSYST 00640I* FILLER 103 103 FFFFFF 00650I* QUOTE AMOUNT 7P ($) 00660I P 104 1070QMAMT 00670I* DELIVERY PROMISED (DAYS ARO) 3P 00680I P 108 1090QMDEL 00690I* STATUS 1A 00700I* E = ENTERED 00710I* N = NO BID 00720I* B = BID 00730I* P = PENDING 00740I* L = LOST 00750I* W = WON ÐÐ00760I* C = CANCELLED 00770I 110 110 QMSCOD 00780I* PROBABILITY OF AWARD 3.2P 00790I P 111 1122QMPROB 00800I* WON/LOST REASON 1A 00810I 113 113 QMREAS 00820I* REMARKS 40A 00830I 114 153 QMREM 00840I* RECORD STATUS 1A 00850I 160 160 QMSTAT 00860I******************************************************************** 00870ICRT512 CR 00880I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00890I* STD AREA - SAME FOR ALL PROGRAMS. 00900I* EMPLOYEE # 5N 00910I 1 50CREMPL 00920I* USER CODE 8A 00930I 6 13 CRUSER 00940I* DEPT # 5N 00950I 14 180CRDEPT 00960I* JOB NAME 8A (JOB LOADED BY MENU) 00970I 19 26 CRJOB 00980I* SHUTDOWN FLAG 1A 00990I* BLANK = NO SHUTDOWN 01000I 27 27 CRSHUT ÐÐ01010I* TIME STARTED 6N 01020I 28 330CRTIME 01030I* DATE STARTED 6N 01040I 34 370CRDATE 01050I* CALL STACK 5 X 6A 01060I 38 67 CALL 01070I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 01080I 68 73 CRRET 01090I* MENU NAME 6A 01100I 74 79 CRMENU 01110I*------------------------------------------------------------------- 01120I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 01130I* CRT512 QMMAST FIELDS. 01140I* QUOTE # 5A 01150I 80 84 CRQOTE 01160I* ITEM # 3N 01170I 85 870CRITEM 01180I* CUSTOMER NAME 20A 01190I 88 107 CRNAME 01200I* CUSTOMER RFQ # 20A 01210I 108 127 CRRFQ 01220I* RFQ ITEM # 4A 01230I 128 131 CRRFQI 01240I* CONTACT 20A 01250I 132 151 CRCONT ÐÐ01260I* ASSIGNED TO (SALESMAN) 3A 01270I 152 154 CRSLSM 01280I* DATE ARRAY 7P X 6 01290I* (SEE CODES QMMAST) 01300I P 155 178 CRD 01310I* PRODUCT CLASS 2A 01320I 179 180 CRPCLS 01330I* SYSTEM CODE 1A 01340I 181 181 CRSYST 01350I* FILLER 182 182 FFFFFF 01360I* QUOTE AMOUNT 7P ($) 01370I P 183 1860CRAMT 01380I* DELIVERY PROMISED (DAYS ARO) 3P 01390I P 187 1880CRDEL 01400I* STATUS 1A 01410I* (SEE CODES QMMAST) 01420I 189 189 CRSCOD 01430I* PROBABILITY OF AWARD 3.2P 01440I P 190 1912CRPROB 01450I* WON/LOST REASON 1A 01460I 192 192 CRREAS 01470I* REMARKS 40A 01480I 193 232 CRREM 01490I* 01500I* TRAN CODE 1A ÐÐ01510I 233 233 CRTRAN 01520I* ORIGINAL CUST NAME 20A 01530I 234 253 CROCUS 01540I* ORIGINAL SALESMAN 3A 01550I 254 256 CROSLS 01560I* ORIGINAL FOLLOW-UP DATE 7P 01570I P 257 2600CROFU 01580I* LAST QUOTE INITIALIZED 5A 01590I 261 265 CRLQI 01600C******************************************************************** 01610C* INITIALIZE 01620C EXSR SR101 1-TIME INIT 01630C*------------------------------------------------------------------ 01640C START TAG 01650C* SET-UP 1ST FIELD NO. 01660C Z-ADD1 F 30 FIELD # 01670C SETOF 96 01680C MOVE BLK5 KEY 5 01690C MOVE ' ' DUN 01700C MOVE ' ' INT 01710C GOTO READ 01720C*------------------------------------------------------------------ 01730C NEXT TAG 01740C* SET-UP NEXT FIELD NO. 01750C 1 ADD F F FIELD # ÐÐ01760C*----------------------------------------------------------------- 01770C READ TAG 01780C* READ DATA FROM TERMINAL. 01790C EXSR SR102 VALIDATE FIELD # 01800C 55 GOTO UPDATE DONE 01810C EXSR SR201 IDENTIFY-F 01820C SETON 69 01830C EXSR SR72 PROMPT 01840C SETOF 69 01850C EXSR SR75 READ TERMINAL 01860C*---------------------------------------------------------------- 01870C CONTU TAG 01880C 98 GOTO GOODBY GOODBY 01890C 94 GOTO MENU MENU REQUEST 01900C N77N88 EXSR SR104 EDIT INPUT FIELD 01910C 96 ERROR 01920CORN77N88 EXSR SR72 REWRITE INPUT DATA 01930C 93 GOTO NEWITM NEW ITEM 01940C 92 GOTO JUMP FIELD JUMP REQST 01950C 91 GOTO NEXT SKIP FORWARD 01960C 89 GOTO NEWITM 01970C 88 SETOF 90 SPACE FILL 01980C 88 SETON 77 " " 01990C 88 MOVE 'X' INT,F 02000C N88 MOVE ' ' INT,F ÐÐ02010C 87 GOTO START 02020C 86 GOTO UPDATE UPDATE 02030C 85 GOTO READ REPEAT 02040C 96 GOTO ERROR ERROR 02050C* CHECK ESCAPE CODE 02060C 90 Z-ADD318 M 96 FLAG ERROR 02070C 90 GOTO ERROR 02080C N77 GOTO NEXT NO DATA INPUT 02090C*------------------------------------------------------------------ 02100C PROCES TAG 02110C* PROCESS INPUT DATA 02120C EXSR SR103 MOVE DATA 02130C N96 EXSR SR104 EDIT DATA 02140C EXSR SR72 REWRITE DATA 02150C 96 GOTO ERROR ERROR 02160C GOTO NEXT 02170C*------------------------------------------------------------------ 02180C UPDATE TAG 02190C* UPDATE DATA BASE. 02200C EXSR SR105 FINAL EDIT 02210C 96 GOTO ERROR ERROR 02220C CRITEM COMP 0 54 02230C N54 CRTRAN COMP 'D' 55 02240C N54N55 EXSR SR81 MOVE 0 CR TO QM 02250C EXSR SR71 PUT SCREEN. ÐÐ02260C CRTRAN COMP 'D' 54 02270C 54 MOVE BLK8 W6A 02280C 54 EXITFQPAUSE 02290C RLABL W6A 02300C 98 GOTO GOODBY 02310C 94 GOTO MENU 02320C 93 GOTO NEWITM 02330C EXSR SR203 CLASSIFY TRAN. 02340C 62 MOVEL'Q004QM' PROG DELETE. 02350C N62 MOVEL'Q003QM' PROG 8 NOT DELETE. 02360C GOTO END 02370C*------------------------------------------------------------------- 02380C JUMP TAG 02390C* SET-UP JUMP TO REQUESTED FIELD 02400C 1 ADD W W 30 02410C W COMP 40 54 02420C 54 Z-ADD318 M 50 96 FLAG ERROR 02430C 54 GOTO ERROR BAD ESC 02440C MOVE '000' W3A 3 02450C MOVEAA40,W W3A 02460C Z-ADD3 W2N 20 02470C EXIT SUBRAJ R. JUSTIFY 02480C RLABL W2N 02490C RLABL W3A 02500C MOVE W3A F NEW FIELD # ÐÐ02510C GOTO READ 02520C*-------------------------------------------------------------------- 02530C ERROR TAG 02540C EXSR SR102 VALIDATE FIELD # 02550C EXSR SR89 GET MSG 02560C EXSR SR73 PUT MSG 02570C GOTO READ 02580C*------------------------------------------------------------------ 02590C NEWITM TAG 02600C* SET-UP LINK FOR NEW ITEM 02610C MOVEL'Q001QM' PROG 8 02620C GOTO END 02630C*------------------------------------------------------------------- 02640C MENU TAG 02650C* SET-UP LINK TO MENU 02660C MOVEL'QQQM01' PROG 02670C GOTO END 02680C*-------------------------------------------------------------------- 02690C GOODBY TAG 02700C* LINK TO SIGN-OFF 02710C MOVEL'GOODBY' PROG 02720C GOTO END 02730C*------------------------------------------------------------------- 02740C END TAG 02750C PROG COMP BLK8 54 ÐÐ02760C N54 MOVEL'Q001QM' PROG 02770C EXSR SR97 UPDATE CRT512 02780C EXSR SR203 CLASSIFY TRAN. 02790C CRITEM COMP 0 54 02800C N60N54 02810COR 98 02820COR 94 02830COR 93 MOVELCRQOTE W8A 8 02840C N60N54 02850COR 98 02860COR 94 02870COR 93 EXSR SR120 DELETE ZERO ITEM 02880C EXITFCHAIN LINK TO NEXT PROG 02890C RLABL PROG 02900C********************************************************************* 02910CSR SR1 BEGSR 02920C* EDIT TRAN CODE. 02930CSR EXSR SR203 CLASSIFY TRAN. 02940CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 02950CSR ENDSR 02960C******************************************************************** 02970CSR SR2 BEGSR 02980C* EDIT QUOTE #. 02990CSR CRQOTE COMP BLK5 54 03000CSRN54 Z-ADD46 M 96 FLAG ERROR. ÐÐ03010CSRN54 GOTO END2 03020CSR CRQOTE COMP CRLQI 54 03030CSR CRLQI COMP BLK5 55 03040CSR 54 03050CORN55 GOTO END2 03060CSR MOVELCRLQI W8A 8 03070CSR EXSR SR120 DELETE ZERO ITEM. 03080CSR END2 ENDSR 03090C******************************************************************* 03100CSR SR3 BEGSR 03110C* EDIT QUOTE ITEM. 03120CSR EXSR SR1 EDIT TRAN CODE. 03130CSR 96 Z-ADD1 F 03140CSR 96 GOTO END3 ERROR. 03150C* GET ZERO ITEM DEFAULT. 03160CSR CRITEM COMP 0 54 03170CSRN54 CRTRAN COMP 'D' 55 03180CSRN54N55 EXSR SR107 MOVE QM TO 0 CR 03190CSR EXSR SR106 GET MASTER. 03200CSR END3 ENDSR 03210C***************************************************************** 03220CSR SR70 BEGSR 03230C* CLEAR TERM SCREEN. 03240CSR EXITFQTOPF CLEAR SCREEN 03250CSR ENDSR ÐÐ03260C******************************************************************** 03270CSR SR71 BEGSR 03280C* GET SALESMAN NAME. 03290CSR EXSR SR70 CLEAR CRT 03300CSR QMSLSM LOKUPTABSLM TABSLN 54 03310CSR 54 MOVE TABSLN SLMNAM 20 03320CSRN54 MOVE BLK35 SLMNAM 03330C* GET PRODUCT NAME. 03340CSR QMPCLS LOKUPTABPRD TABPRN 54 03350CSR 54 MOVE TABPRN PRDNAM 20 03360CSRN54 MOVE BLK35 PRDNAM 03370C* GET SYSTEM NAME. 03380CSR QMSYST LOKUPTABSYS TABSYN 54 03390CSR 54 MOVE TABSYN SYSNAM 20 03400CSRN54 MOVE BLK35 SYSNAM 03410C* GET STATUS. 03420CSR QMSCOD LOKUPTABSTC TABSTN 54 03430CSR 54 MOVE TABSTN STCNAM 10 03440CSRN54 MOVE BLK35 STCNAM 03450C* GET REASON LOST DESCR. 03460CSR QMREAS LOKUPTABRES TABREN 54 03470CSR 54 MOVE TABREN RESNAM 20 03480CSRN54 MOVE BLK35 RESNAM 03490C* PUT HEADINGS TO TERMINAL 03500CSR SETON 71 ÐÐ03510CSR EXCPT PUT HEADINGS 03520CSR SETOF 71 03530CSR ENDSR 03540C********************************************************************* 03550CSR SR72 BEGSR 03560C* PUT DATA TO TERMINAL 03570CSR SETON 72 03580CSR EXCPT PUT DATA 03590CSR SETOF 72 03600CSR ENDSR 03610C*********************************************************************** 03620CSR SR73 BEGSR 03630C* PUT ERROR MESSAGE TO TERMINAL 03640CSR SETON 73 03650CSR EXCPT PUT MSG 03660CSR SETOF 73 03670CSR Z-ADDM LSTERR 50 03680CSR ENDSR 03690C******************************************************************* 03700CSR SR75 BEGSR 03710C* READ FROM TERMINAL 03720CSR SETOF 779096 03730CSR SETOF 939291 03740CSR SETOF 898887 03750CSR SETOF 8685 ÐÐ03760CSR MOVE BIT,21 A6,2 BUF LENGTH 03770CSR MOVEAA6 W6A 6 03780CSR MOVE BLK40 W40A 40 BUFFER 03790CSR EXITFQWREED READ TERM 03800CSR RLABL W40A 03810CSR RLABL W6A 03820CSR MOVEAW40A A40 03830CSR MOVE BLK40 W40A 03840CSR Z-ADD1 W 30 03850CSR '\' LOKUPA40,W 90 FLAG ESC 03860CSRN90 GOTO T75B NOT ESC 03870CSR 1 ADD W W 03880CSR W COMP 40 54 03890CSR 54 GOTO T75A BAD ESC 03900CSR A40,W COMP 'G' 98 GOODBY 03910CSR A40,W COMP 'E' 94 MENU 03920CSR A40,W COMP 'N' 93 NEW ITEM 03930CSR A40,W COMP 'J' 92 JUMP 03940CSR A40,W COMP 'F' 91 SKIP FRWRD 03950CSR A40,W COMP 'B' 89 SKIP BKWRD 03960CSR A40,W COMP 'S' 88 SPACE FILL 03970CSR A40,W COMP 'H' 87 HOME 03980CSR A40,W COMP 'U' 86 UPDATE 03990CSR A40,W COMP 'R' 85 REPEAT 04000CSR 98 ÐÐ04010COR 94 04020COR 93 04030COR 92 04040COR 91 04050COR 89 04060COR 88 04070COR 87 04080COR 86 04090COR 85 GOTO END75 GOOD ESC 04100C*------------------------------------------------------------------ 04110CSR T75A TAG 04120C* FLAG BAD ESC INPUT 04130CSR Z-ADD318 M 96 FLAG ERROR 04140CSR GOTO END75 04150C*-------------------------------------------------------------------- 04160CSR T75B TAG 04170C* MOVE DATA 04180CSR Z-ADD1 W 04190CSR ' ' LOKUPA40,W 77 04200CSR 77 MOVEAA40,W W40A INPUT DATA 04210C*-------------------------------------------------------------------- 04220CSR END75 TAG 04230C* INIT PREV ERROR MSG. 04240CSR LSTERR COMP 0 54 04250CSR 54 MOVE BLK35 MGTEXT ÐÐ04260CSR 54 EXSR SR73 BLANK MESSAGE 04270CSR Z-ADD0 LSTERR 50 04280CSR ENDSR 04290C********************************************************************** 04300CSR SR80 BEGSR 04310C* GET MASTER RECORD 04320CSR MOVELCRQOTE W8A 8 04330CSR MOVE CRITEM W8A 04340CSR SETOF 61 04350CSR W8A CHAINQMMAST 60 GET MASTER 04360CSRN60 QMSTAT COMP 'D' 61 FLAG DELETE 04370CSR 60 04380COR 61 GOTO END80 04390CSR MOVE QMNAME OLDNAM 20 04400CSR MOVE QMSLSM OLDSLM 3 04410CSR Z-ADDQMD,5 OLDFU 70 04420CSR END80 ENDSR 04430C********************************************************************** 04440CSR SR81 BEGSR 04450C* MOVE QUOTE CONTROL RECORD FIELDS 04460CSR CRITEM COMP 0 54 04470CSR 54 GOTO END81 04480CSR CRQOTE COMP CRLQI 54 04490CSRN54 GOTO END81 04500CSR CRNAME COMP BLK20 54 ÐÐ04510CSR 54 MOVE CRNAME QMNAME 04520CSR CRRFQ COMP BLK20 54 04530CSR 54 MOVE CRRFQ QMRFQ 04540CSR CRRFQI COMP ' ' 54 04550CSR 54 MOVE CRRFQI QMRFQI 04560CSR CRCONT COMP BLK20 54 04570CSR 54 MOVE CRCONT QMCONT 04580CSR CRSLSM COMP ' ' 54 04590CSR 54 MOVE CRSLSM QMSLSM 04600CSR CRD,2 COMP 0 54 04610CSR 54 Z-ADDCRD,2 QMD,2 04620CSR CRD,3 COMP 0 54 04630CSR 54 Z-ADDCRD,3 QMD,3 04640CSR CRD,4 COMP 0 54 04650CSR 54 Z-ADDCRD,4 QMD,4 04660CSR CRD,5 COMP 0 54 04670CSR 54 Z-ADDCRD,5 QMD,5 04680CSR CRPCLS COMP ' ' 54 04690CSR 54 MOVE CRPCLS QMPCLS 04700CSR CRSYST COMP ' ' 54 04710CSR 54 MOVE CRSYST QMSYST 04720CSR CRAMT COMP 0 54 04730CSR 54 Z-ADDCRAMT QMAMT 04740CSR CRDEL COMP 0 54 04750CSR 54 Z-ADDCRDEL QMDEL ÐÐ04760CSR CRSCOD COMP ' ' 54 04770CSR 54 MOVE CRSCOD QMSCOD 04780CSR CRPROB COMP 0 54 04790CSR 54 Z-ADDCRPROB QMPROB 04800CSR CRREAS COMP ' ' 54 04810CSR 54 MOVE CRREAS QMREAS 04820CSR CRREM COMP BLK40 54 04830CSR 54 MOVE CRREM QMREM 04840CSR END81 ENDSR 04850C******************************************************************** 04860CSR SR89 BEGSR 04870C* GET MESSAGE MASTER 04880CSR M CHAINMGFILE 54 04890CSR 54 MOVE BLK35 MGTEXT 04900CSR 54 MOVELM MGTEXT 04910CSR 54 MOVE MES,1 MGTEXT 04920CSR ENDSR 04930C******************************************************************** 04940CSR SR97 BEGSR 04950C* UPDATE CRT512 . 04960CSR SETON 97 04970CSR EXCPT UPDATE CRT512 . 04980CSR SETOF 97 04990CSR ENDSR 05000C*********************************************************************** ÐÐ05010CSR SR101 BEGSR 05020C* 1-TIME INITIALIZE 05030CSR MOVE BIT,1 NUL 05040CSR MOVE BIT,1 A6 05050CSR EXSR SR70 CLEAR CRT. 05060CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 05070CSR MOVE ' ' BLK40 40 05080C* GET PORT # AND CRT512 05090CSR MOVE ' ' W8A 8 05100CSR Z-ADD0 W2N 20 05110CSR Z-ADD0 W1N 10 05120CSR MOVE ' ' W2A 2 05130CSR EXITFPGMINX GET PORT # 05140CSR RLABL W8A 05150CSR RLABL W2N 05160CSR RLABL W1N 05170CSR RLABL W2A 05180CSR MOVE W2A PORT 20 PORT NO. 05190CSR PORT COMP 0 54 05200CSRN54 Z-ADD25 PORT DEFAULT 05210CSR PORT CHAINCRT512 H9 05220C* DEFINE WORK FIELDS,ETC. 05230CSR MOVE ' ' BLK35 35 05240CSR MOVE ' ' BLK5 5 05250CSR MOVE ' ' BLK8 8 ÐÐ05260CSR MOVE ' ' BLK20 20 05270CSR ENDSR 05280C********************************************************************** 05290CSR SR102 BEGSR 05300C* VALIDATE FIELD NO. 05310CSR F COMP 0 54 05320CSRN54 Z-ADD1 F 05330CSR F COMP FLIMIT 55 05340CSR 55 Z-ADD1 F 05350CSR ENDSR 05360C******************************************************************** 05370CSR SR103 BEGSR 05380C* MOVE INPUT DATA 05390CSR EXSR SR201 IDENTIFY-F 05400CSR EXSR SR202 R. JUSTIFY 05410CSR 01 MOVELW40A CRTRAN TRAN CODE. 05420CSR 02 MOVELW40A CRQOTE QUOTE #. 05430CSR 03 MOVE W15A CRITEM ITEM #. 05440CSR MOVE ' ' DUN,F EDIT FLAG 05450CSR ENDSR 05460C******************************************************************** 05470CSR SR104 BEGSR 05480C* EDIT INPUT DATA 05490CSR 01 EXSR SR1 05500CSR 02 EXSR SR2 ÐÐ05510CSR 03 EXSR SR3 05520CSR 96 MOVE ' ' DUN,F EDIT FLAG 05530CSRN96 MOVE 'X' DUN,F 05540CSR ENDSR 05550C*********************************************************************** 05560CSR SR105 BEGSR 05570C* FINAL EDIT 05580CSR SETON 79 FINAL EDIT FLAG 05590CSR Z-ADD1 F 96 05600C*-------------------------------------------------------------------- 05610CSR T105A TAG 05620CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05630CSRN54 GOTO END105 05640CSR EXSR SR201 IDENTIFY-F 05650CSR EXSR SR104 EDIT 05660CSRN96 GOTO T105A 05670C*-------------------------------------------------------------------- 05680CSR END105 TAG 05690CSR SETOF 79 05700CSR ENDSR 05710C******************************************************************** 05720CSR SR106 BEGSR 05730C* UPDATE DATA BASE. 05740CSR EXSR SR203 CLASSIFY TRAN 05750CSR 60 GOTO T106A ADD TRAN ÐÐ05760CSR 61 GOTO T106D CHANGE TRAN 05770CSR 62 GOTO T106F DELETE TRAN 05780C* FLAG BAD TRAN CODE 05790CSR Z-ADD300 M 96 FLAG ERROR 05800CSR Z-ADD1 F FIELD # 05810CSR GOTO END106 05820C*------------------------------------------------------------------- 05830CSR T106A TAG 05840C* ADD TRANSACTION 05850CSR EXSR SR80 GET MASTER 05860CSR 60 05870COR 61 EXSR SR204 05880CSR 60 NOT ON FILE 05890COR 61 GOTO END106 DELETED MASTER 05900C* FLAG DUPLICATE ADD ERROR 05910CSR CRITEM COMP 0 54 05920CSR 54 GOTO END106 05930CSR Z-ADD301 M 96 FLAG ERROR 05940CSR Z-ADD1 F FIELD # 05950CSR GOTO END106 05960C*---------------------------------------------------------------------- 05970CSR T106D TAG 05980C* CHANGE TRANSACTION. 05990CSR EXSR SR80 GET MASTER 06000CSRN60N61 GOTO END106 GOT IT ÐÐ06010C* FLAG NO MASTER ERROR 06020CSR CRITEM COMP 0 54 06030CSR 54 GOTO END106 06040CSR Z-ADD302 M 96 FLAG ERROR 06050CSR Z-ADD1 F FIELD # 06060CSR GOTO END106 06070C*----------------------------------------------------------------------- 06080CSR T106F TAG 06090C* DELETE TRANSACTION 06100CSR EXSR SR80 GET MASTER 06110CSRN60N61 GOTO END106 GOT IT 06120C* FLAG NO MASTER ERROR 06130CSR Z-ADD302 M 96 FLAG ERROR 06140CSR Z-ADD1 F FIELD # 06150CSR GOTO END106 06160CSR END106 ENDSR 06170C******************************************************************** 06180CSR SR107 BEGSR 06190C* PICK-UP ZERO ITEM DEFAULTS. 06200CSR CRITEM COMP 0 54 06210CSRN54 GOTO END107 ZERO ITEM UPDATE 06220CSR CRQOTE COMP CRLQI 54 06230CSRN54 GOTO END107 06240CSR MOVELCRQOTE W8A 8 06250CSR MOVE '000' W8A ÐÐ06260CSR W8A CHAINQMMAST 54 06270CSRN54 QMSTAT COMP 'D' 54 06280CSR 54 GOTO END107 06290CSR QMNAME COMP BLK20 54 06300CSR 54 MOVE QMNAME CRNAME 06310CSR QMRFQ COMP BLK20 54 06320CSR 54 MOVE QMRFQ CRRFQ 06330CSR QMRFQI COMP ' ' 54 06340CSR 54 MOVE QMRFQI CRRFQI 06350CSR QMCONT COMP BLK20 54 06360CSR 54 MOVE QMCONT CRCONT 06370CSR QMSLSM COMP ' ' 54 06380CSR 54 MOVE QMSLSM CRSLSM 06390CSR QMD,2 COMP 0 54 06400CSR 54 Z-ADDQMD,2 CRD,2 06410CSR QMD,3 COMP 0 54 06420CSR 54 Z-ADDQMD,3 CRD,3 06430CSR QMD,4 COMP 0 54 06440CSR 54 Z-ADDQMD,4 CRD,4 06450CSR QMD,5 COMP 0 54 06460CSR 54 Z-ADDQMD,5 CRD,5 06470CSR QMPCLS COMP ' ' 54 06480CSR 54 MOVE QMPCLS CRPCLS 06490CSR QMSYST COMP ' ' 54 06500CSR 54 MOVE QMSYST CRSYST ÐÐ06510CSR QMAMT COMP 0 54 06520CSR 54 Z-ADDQMAMT CRAMT 06530CSR QMDEL COMP 0 54 06540CSR 54 Z-ADDQMDEL CRDEL 06550CSR QMSCOD COMP ' ' 54 06560CSR 54 MOVE QMSCOD CRSCOD 06570CSR QMPROB COMP 0 54 06580CSR 54 Z-ADDQMPROB CRPROB 06590CSR QMREAS COMP ' ' 54 06600CSR 54 MOVE QMREAS CRREAS 06610CSR QMREM COMP BLK40 54 06620CSR 54 MOVE QMREM CRREM 06630CSR END107 ENDSR 06640C******************************************************************** 06650CSR SR120 BEGSR 06660C* DELETE ZERO ITEM MAST. 06670CSR MOVE '000' W8A 06680CSR W8A CHAINQMMAST 54 GET QMMAST. 06690CSR 54 GOTO END120 NO HIT. 06700CSR SETON 83 06710CSR EXCPT DELETE ZERO ITEM 06720CSR SETOF 83 06730CSR END120 ENDSR 06740C******************************************************************** 06750CSR SR201 BEGSR ÐÐ06760C* IDENTIFY FIELD NO. 06770CSR F COMP 1 01 06780CSR F COMP 2 02 06790CSR F COMP 3 03 06800CSR END201 ENDSR 06810C********************************************************************** 06820CSR SR202 BEGSR 06830C* RIGHT JUSTIFY 06840CSR F COMP 3 54 06850CSRN54 GOTO END202 NOT NUMERIC FIELD 06860CSR Z-ADD15 W2N 20 06870CSR MOVELW40A W15A 15 06880CSR EXIT SUBRAJ R. JUSTIFY 06890CSR RLABL W2N 06900CSR RLABL W15A 06910CSR END202 ENDSR 06920C*********************************************************************** 06930CSR SR203 BEGSR 06940C* CLASSIFY TRAN CODE 06950CSR CRTRAN COMP 'A' 60 ADD 06960CSR CRTRAN COMP 'C' 61 CHANGE 06970CSR CRTRAN COMP 'D' 62 DELETE 06980CSR 60 MOVE TRN,1 TRNNAM 6 06990CSR 61 MOVE TRN,2 TRNNAM 07000CSR 62 MOVE TRN,3 TRNNAM ÐÐ07010CSRN60N61N62 MOVE BLK35 TRNNAM 07020CSR ENDSR 07030C**************************************************************************07040CSR SR204 BEGSR 07050C* INITIALIZE MASTER FIELDS. 07060CSR MOVE BLK40 QMNAME 07070CSR MOVE BLK40 QMRFQ 07080CSR MOVE BLK40 QMRFQI 07090CSR MOVE BLK40 QMCONT 07100CSR MOVE ' ' QMSLSM 07110CSR Z-ADD0 QMD 07120CSR MOVE ' ' QMPCLS 07130CSR MOVE ' ' QMSYST 07140CSR Z-ADD0 QMAMT 07150CSR Z-ADD0 QMDEL 07160CSR MOVE ' ' QMSCOD 07170CSR MOVE BLK40 QMREM 07180CSR MOVE ' ' QMREAS 07190CSR Z-ADD0 QMPROB 07200CSR ENDSR 07210O******************************************************************** 07220OTERM132 E 72 01 07230O* REQUEST TRAN CODE. 07240O BIT,28 1 07250O 2 '8' ÐÐ07260O 8 '002001' 07270O 24 'ENTER TRANS CODE' 07280O 44 ':' 07290O CRTRAN 47 07300O TRNNAM 56 07310O BIT,28 124 07320O 125 '8' 07330O 131 '002039' 07340O BIT,8 132 07350O*------------------------------------------------------------------- 07360O E 72 02 07370O* REQUEST QUOTE #. 07380O BIT,28 1 07390O 2 '8' 07400O 8 '003001' 07410O 21 'ENTER QUOTE #' 07420O 44 ':' 07430O CRQOTE 51 07440O BIT,28 124 07450O 125 '8' 07460O 131 '003039' 07470O BIT,8 132 07480O*------------------------------------------------------------------- 07490O E 72 03 07500O* REQUEST ITEM #. ÐÐ07510O BIT,28 1 07520O 2 '8' 07530O 8 '004001' 07540O 26 'ENTER QUOTE ITEM #' 07550O 44 ':' 07560O CRITEMZ 49 07570O BIT,28 124 07580O 125 '8' 07590O 131 '004039' 07600O BIT,8 132 07610O*------------------------------------------------------------------- 07620O E 71 07630O* HEADINGS AND DATA. 07640O 50 'Q U O T E ' 07650O 67 'S Y S T E M ' 07660O 79 'I N P U T' 07670O*------------------------------------------------------------------- 07680O E 71 07690O HED,1 36 07700O CRTRAN 39 07710O TRNNAM 48 07720O*------------------------------------------------------------------- 07730O E 71 07740O HED,2 36 07750O CRQOTE 43 ÐÐ07760O*------------------------------------------------------------------- 07770O E 71 07780O HED,3 36 07790O CRITEMZ 41 07800O*------------------------------------------------------------------- 07810O E 71 07820O HED,4 36 07830O QMNAME 58 07840O*------------------------------------------------------------------- 07850O E 71 07860O HED,5 36 07870O QMRFQ 58 07880O*------------------------------------------------------------------- 07890O E 71 07900O* HED,6 36 07910O* QMRFQI 42 07920O*------------------------------------------------------------------- 07930O E 71 07940O HED,7 36 07950O QMCONT 58 07960O*------------------------------------------------------------------- 07970O E 71 07980O HED,8 36 07990O QMSLSM 41 08000O SLMNAM 64 ÐÐ08010O*------------------------------------------------------------------- 08020O E 71 08030O*------------------------------------------------------------------- 08040O E 71 08050O 16 'QUOTATION DATES' 08060O*------------------------------------------------------------------- 08070O E 71 08080O HED,9 36 08090O QMD,1 47 ' - - ' 08100O*------------------------------------------------------------------- 08110O E 71 08120O HED,10 36 08130O QMD,2 47 ' - - ' 08140O*------------------------------------------------------------------- 08150O E 71 08160O HED,11 36 08170O QMD,3 47 ' - - ' 08180O*------------------------------------------------------------------- 08190O E 71 08200O HED,12 36 08210O QMD,4 47 ' - - ' 08220O*------------------------------------------------------------------- 08230O E 71 08240O HED,13 36 08250O QMD,5 47 ' - - ' ÐÐ08260O*------------------------------------------------------------------- 08270O E 71 08280O HED,14 36 08290O QMD,6 47 ' - - ' 08300O*------------------------------------------------------------------- 08310O E 71 08320O*------------------------------------------------------------------- 08330O E 71 08340O HED,15 36 08350O QMPCLS 40 08360O PRDNAM 63 08370O*------------------------------------------------------------------- 08380O E 71 08390O HED,16 36 08400O QMSYST 39 08410O SYSNAM 62 08420O*------------------------------------------------------------------- 08430O E 71 08440O HED,17 36 08450O QMAMT 49 ' , , $0' 08460O*------------------------------------------------------------------- 08470O E 71 08480O HED,18 36 08490O QMDEL Z 41 08500O 48 'DAYS' ÐÐ08510O*------------------------------------------------------------------- 08520O E 71 08530O HED,19 36 08540O QMSCOD 39 08550O STCNAM 52 08560O*------------------------------------------------------------------- 08570O E 71 08580O HED,20 36 08590O QMREM 78 08600O*------------------------------------------------------------------- 08610O E 71 08620O HED,21 36 08630O QMREAS 39 08640O RESNAM 62 08650O*------------------------------------------------------------------- 08660O E 71 08670O HED,22 36 08680O QMPROBZ 42 08690O 43 '%' 08700O*------------------------------------------------------------------- 08710O E 73 08720O* PUT ERROR MSG. 08730O NUL 132 08740O BIT,28 1 08750O 8 '8006001' ÐÐ08760O MGTEXT 43 08770O******************************************************************** 08780OCRT512 E 97 08790O CRQOTE 84 08800O CRITEM 87 08810O QMNAME 107 08820O QMRFQ 127 08830O QMRFQI 131 08840O QMCONT 151 08850O QMSLSM 154 08860O QMD 178P 08870O QMPCLS 180 08880O QMSYST 181 08890O QMAMT 186P 08900O QMDEL 188P 08910O QMSCOD 189 08920O QMPROB 191P 08930O QMREAS 192 08940O QMREM 232 08950O CRTRAN 233 08960O OLDNAM 253 08970O OLDSLM 256 08980O OLDFU 260P 08990O******************************************************************** 09000OQMMAST E 83 ÐÐ09010O QMD 99P 09020O QMAMT 107P 09030O QMDEL 109P 09040O QMPROB 112P 09050O 160 'D' ** TABPRD/TABPRN - PROD CLASS 00906011MINI SERIES 00907012SERIES 1500 00908021SERIES 1000 00909022SERIES 3000 00910023SERIES 5900 00911024SERIES 5300 00912041SERIES X 00913042SERIES 10 00914041SERIES 5100 00915052SERIES 1400 00916053SERIES 8100 009170541400/8100 CONTROLS 00918055SYSTEM 21 00919059OTHER SYSTEMS 00920060RF EQUIPMENT 00921070EQUA-DYNE EQUIPMENT 00922090MISC. EQUIPMENT 00923099SKY 515 009240** TABSYS/TABSYN - SYST CODE 009250ÐÐSSYSTEM 009260NNON-SYSTEM 009270** TABSTC/TABSTN - STATUS CODE 009280EENTERED 009290NNO BID 009300PPENDING 009310LLOST 009320WWON 009330CCANCELLED 009340** TABRES/TABREN - REASON LOST 0093501PRICE 0093602DELIVERY 0093703SPECIFICATION 0093804OTHER 0093905NOT KNOWN 009400** NUL ARRAY 009410 009420** A6 ARRAY 009430 009440** A40 ARRAY 009450 009460** DUN ARRAY 009470 009480** INT ARRAY 009490 009500ÐÐ** MES ARRAY 009510---MESSAGE NOT ON FILE--- 009520** HED ARRAY 009530 (1) TRANSACTION CODE - - - - - - - 009540 (2) QUOTE NUMBER - - - - - - - - - 009550 (3) QUOTE ITEM - - - - - - - - - - 009560 (4) CUSTOMER NAME- - - - - - - - - 009570 (5) CUSTOMER RFQ # - - - - - - - - 009580 (6) CUSTOMER RFQ ITEM- - - - - - - 009590 (7) CUSTOMER CONTACT - - - - - - - 009600 (8) SALESMAN - - - - - - - - - - - 009610 (9) RECEIVED - - - - - - - - - - - 009620(10) DUE- - - - - - - - - - - - - - 009630(11) SENT - - - - - - - - - - - - - 009640(12) AWARD EXPECTED - - - - - - - - 009650(13) FOLLOW-UP- - - - - - - - - - - 009660(14) EXPIRES- - - - - - - - - - - - 009670(15) PRODUCT CLASS- - - - - - - - - 009680(16) SYSTEM CODE- - - - - - - - - - 009690(17) AMOUNT - - - - - - - - - - - - 009700(18) DELIVERY PROMISE ARO - - - - - 009710(19) STATUS CODE- - - - - - - - - - 009720(20) REMARKS- - - - - - - - - - - - 009730(21) REASON LOST- - - - - - - - - - 009740(22) PROBABILITY OF AWARD - - - - - 009750ÐÐ** TRN ARRAY 009760ADD 009770CHANGE 009780DELETE 009790/* 009800_‚ ÐÐ_‚_‚TRN ARRAY 009760ADD 009770CHANGE 009780DELETE 009790/* 009800_‚ ÐÈ(R'f RcX118DP P999999120282(èÈÐ00010H Q118DP00020F* PROGRAM MASTER UPDATE. (X118DP) 00030F* REVISED 4-14-82 2:15 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FPROGMASTUC F 85R 8AI 1 DISK A 00080FPROGALTTUC F 10R 9AI 1 DISK A 00090FPROGALTCUC F 10R 9AI 1 DISK A 00100FPROGALTGUC F 12R11AI 1 DISK A 00110FPROGALTDUC F 30R29AI 1 DISK A 00120FTERM78 O F 78 5 00130F**************************************************************** 00140E NUL 1 79 1 NULL CHAR 00150E A60 60 60 1 A INPUT DATA ARRAY 00160E DUN 1 15 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E A29 29 29 1 00190E BIT 33 1 SCREEN CONTR. CHAR 00200E PIO 9 1 00210I******************************************************************* 00220IBITTAB BT 00230I 1 33 BIT 00240I******************************************************************* 00250IMGFILE MG ÐÐ00260I* MESSAGE FILE. 00270I 1 35 MGTEXT 00280I****************************************************************** 00290ICRTFILE CR 00300I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00310I* STD AREA - SAME FOR ALL PROGRAMS. 00320I* EMPLOYEE # 5N 00330I 1 50CREMPL 00340I* USER CODE 8A 00350I 6 13 CRUSER 00360I* DEPT # 5N 00370I 14 180CRDEPT 00380I* JOB NAME 8A (JOB LOADED BY MENU) 00390I 19 26 CRJOB 00400I* SHUTDOWN FLAG 1A 00410I* BLANK = NO SHUTDOWN 00420I 27 27 CRSHUT 00430I* TIME STARTED 6N 00440I 28 330CRTIME 00450I* DATE STARTED 4N 00460I 34 370CRDATE 00470I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00480I 68 73 CRRET 00490I* MENU NAME 6A 00500I 74 79 CRMENU ÐÐ00510I******************************************************************** 00520IPROGMASTPG 00530I* PROGRAM MASTER. 00540I* PROG NAME 8A 00550I 1 8 PGNAME 00560I* DESCRIPTION 60A 00570I 9 68 PGDESC 00580I 9 27 PG18 00590I 28 68 PG42 00600I* TYPE 1A 00610I* F = FORTRAN PROG 00620I* R = RPG PROGRAM 00630I* P = PROCEDURE 00640I 69 69 PGTYPE 00650I* CLASS 1A 00660I* M = MENU PROG 00670I* P = BATCH (CALLED FROM PROCEDURE) 00680I* K = CALLED FROM KEYBOARD 00690I* O = ON LINE - SELECTED FROM MENU 00700I* S = SUB PROG - CALLED OR CHAINED TO BY OTHER PROG 00710I 70 70 PGCLAS 00720I* GROUP 3A (PREFIX) 00730I 71 73 PGGRUP 00740I* I/O ARRAY 1A X 9 00750I* 1 = DISK IN ÐÐ00760I* 2 = DISK OUT 00770I* 3 = DATAGRAPHIX 00780I* 4 = CDC TERMINAL 00790I* 5 = SYST PRINTER 00800I* 6 = DIABLO 00810I* 7 = FLOPPY - INPUT 00820I* 8 = FLOPPY - OUTPUT 00830I* 9 = NOT USED 00840I 74 82 PIO 00850I* RECORD STATUS 1A 00860I 85 85 PGSTAT 00870I******************************************************************** 00880IPROGALTTPT 00890I 10 10 PTSTAT 00900I******************************************************************** 00910IPROGALTCPC 00920I 10 10 PCSTAT 00930I******************************************************************** 00940IPROGALTGPR 00950I 12 12 PRSTAT 00960I******************************************************************** 00970IPROGALTDPD 00980I 4 21 PD18 00990I 30 30 PDSTAT 01000C******************************************************************** ÐÐ01010C* INITIALIZE 01020C EXSR SR101 1-TIME INIT 01030C*------------------------------------------------------------------ 01040C START TAG 01050C* SET-UP 1ST FIELD NO. 01060C MOVE ' ' TRAN 1 01070C MOVE ' 'TNAME 8 01080C MOVE ' ' DUN INIT EDIT ARRAY 01090C EXSR SR205 INIT PROGMAST 01100C EXSR SR71 PUT HEADINGS 01110C Z-ADD1 F 30 FIELD # 01120C GOTO READ 01130C*------------------------------------------------------------------ 01140C NEXT TAG 01150C* SET-UP NEXT FIELD NO. 01160C 1 ADD F F FIELD # 01170C*----------------------------------------------------------------- 01180C READ TAG 01190C* READ DATA FROM TERMINAL. 01200C SETOF 909677 01210C EXSR SR102 VALIDATE FIELD # 01220C 55 GOTO UPDATE DONE 01230C EXSR SR201 IDENTIFY-F 01240C 04 GOTO NEXT 01250C SETON 69 ÐÐ01260C EXSR SR72 PROMPT 01270C SETOF 69 01280C EXSR SR75 READ TERMINAL 01290C 98 GOTO GOODBY GOODBY 01300C 94 GOTO MENU MENU REQUEST 01310C 93 GOTO NEWITM NEW ITEM 01320C 92 GOTO JUMP FIELD JUMP REQST 01330C 91 GOTO NEXT SKIP FORWARD 01340C 89 F SUB 1 F SKIP BACKWARD 01350C 89 EXSR SR201 01360C 89 04 Z-ADD3 F 01370C 89 GOTO READ " " 01380C 88 SETOF 90 SPACE FILL 01390C 88 SETON 77 " " 01400C 87 GOTO START 01410C 86 GOTO UPDATE UPDATE 01420C 85 GOTO READ REPEAT 01430C 96 GOTO ERROR ERROR 01440C N77 GOTO EDIT NO DATA INPUT 01450C*------------------------------------------------------------------ 01460C PROCES TAG 01470C* PROCESS INPUT DATA 01480C EXSR SR103 MOVE DATA 01490C*------------------------------------------------------------------- 01500C EDIT TAG ÐÐ01510C N96 EXSR SR104 EDIT DATA 01520C 96 GOTO ERROR ERROR 01530C GOTO NEXT 01540C*------------------------------------------------------------------ 01550C UPDATE TAG 01560C* UPDATE DATA BASE. 01570C EXSR SR105 FINAL EDIT 01580C 96 GOTO ERROR ERROR 01590C EXSR SR106 UPDATE 01600C 96 GOTO ERROR ERROR 01610C 1 ADD COUNT COUNT 30 01620C GOTO START 01630C*------------------------------------------------------------------- 01640C JUMP TAG 01650C* SET-UP JUMP TO REQUESTED FIELD 01660C 1 ADD W W 30 01670C W COMP 60 54 01680C 54 Z-ADD318 M 50 96 FLAG ERROR 01690C 54 GOTO ERROR BAD ESC 01700C MOVE ' ' W3A 3 01710C MOVEAA60,W W3A 01720C Z-ADD3 W2N 20 01730C EXIT SUBRAJ R. JUSTIFY 01740C RLABL W2N 01750C RLABL W3A ÐÐ01760C MOVE W3A F NEW FIELD # 01770C EXSR SR201 01780C 04 Z-ADD3 F 01790C GOTO READ 01800C*-------------------------------------------------------------------- 01810C ERROR TAG 01820C EXSR SR102 VALIDATE FIELD # 01830C EXSR SR89 GET MSG 01840C EXSR SR73 PUT MSG 01850C GOTO READ 01860C*------------------------------------------------------------------ 01870C NEWITM TAG 01880C* SET-UP LINK FOR NEW ITEM 01890C MOVEL'Q118DP' PROG 8 01900C GOTO END 01910C*------------------------------------------------------------------- 01920C MENU TAG 01930C* SET-UP LINK TO MENU 01940C MOVELCRMENU PROG 01950C GOTO END 01960C*-------------------------------------------------------------------- 01970C GOODBY TAG 01980C* LINK TO SIGN-OFF 01990C MOVEL'GOODBY' PROG 02000C GOTO END ÐÐ02010C*------------------------------------------------------------------- 02020C END TAG 02030C EXITFCHAIN LINK TO NEXT PROG 02040C RLABL PROG 02050C******************************************************************** 02060CSR SR1 BEGSR 02070C* EDIT TRAN CODE. 02080CSR EXSR SR203 CLASSIFY TRAN 02090CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02100CSR ENDSR 02110C******************************************************************** 02120CSR SR2 BEGSR 02130C* EDIT PROG NAME. 02140CSR TNAME COMP ' ' 54 02150CSRN54 Z-ADD224 M 96 FLAG ERROR 02160CSRN54 GOTO END2 02170CSR EXSR SR80 GET PROGMAST 02180CSRN30N31 GOTO T2C GOT IT 02190C* NOT ON FILE CONDITION. 02200CSR EXSR SR205 INIT PROGMAST 02210CSR EXSR SR203 CLASSIFY TRAN 02220CSRN60 Z-ADD302 M 96 FLAG ERROR 02230CSR GOTO END2 02240C*------------------------------------------------------------------- 02250CSR T2C TAG ÐÐ02260C* IS ON FILE CONDITION. 02270CSR EXSR SR203 CLASSIFY TRAN 02280CSR 60 Z-ADD301 M 96 FLAG DUPLICATE 02290CSR EXSR SR71 PUT HEADING/DATA 02300CSR END2 ENDSR 02310C********************************************************************* 02320CSR SR31 BEGSR 02330CSR SETON 31 02340CSR EXCPT UPDATE PROGALTT 02350CSR SETOF 31 02360CSR ENDSR 02370C********************************************************************* 02380CSR SR32 BEGSR 02390CSR SETON 32 02400CSR EXCPT UPDATE PROGALTC 02410CSR SETOF 32 02420CSR ENDSR 02430C********************************************************************* 02440CSR SR33 BEGSR 02450CSR SETON 33 02460CSR EXCPT UPDATE PROGALTG 02470CSR SETOF 33 02480CSR ENDSR 02490C********************************************************************* 02500CSR SR34 BEGSR ÐÐ02510CSR SETOF 34 02520CSR EXCPT UPDATE PROGALTD 02530CSR SETOF 34 02540CSR ENDSR 02550C******************************************************************** 02560CSR SR41 BEGSR 02570CSR W9A CHAINPROGALTT 60 02580CSR ENDSR 02590C******************************************************************** 02600CSR SR42 BEGSR 02610CSR W9A CHAINPROGALTC 60 02620CSR ENDSR 02630C******************************************************************** 02640CSR SR43 BEGSR 02650CSR W11A CHAINPROGALTG 60 02660CSR ENDSR 02670C******************************************************************** 02680CSR SR44 BEGSR 02690CSR W29A CHAINPROGALTD 60 02700CSR ENDSR 02710C***************************************************************** 02720CSR SR68 BEGSR 02730CSR EXITFQCLF LINE FEED 02740CSR ENDSR 02750C********************************************************************** ÐÐ02760CSR SR71 BEGSR 02770C* PUT HEADINGS TO TERMINAL 02780CSR SETON 71 02790CSR EXCPT PUT HEADINGS 02800CSR SETOF 71 02810CSR ENDSR 02820C********************************************************************* 02830CSR SR72 BEGSR 02840C* PUT DATA TO TERMINAL 02850CSR SETON 72 02860CSR EXCPT PUT DATA 02870CSR SETOF 72 02880CSR EXITFQCLFCR LF/CR 02890CSR ENDSR 02900C*********************************************************************** 02910CSR SR73 BEGSR 02920C* PUT ERROR MESSAGE TO TERMINAL 02930CSR SETON 73 02940CSR EXCPT PUT MSG 02950CSR SETOF 73 02960CSR ENDSR 02970C******************************************************************* 02980CSR SR75 BEGSR 02990C* READ FROM TERMINAL 03000CSR SETOF 779096 ÐÐ03010CSR SETOF 939291 03020CSR SETOF 898887 03030CSR SETOF 8685 03040CSR MOVE BIT,31 BUFLGT 2 READ BUFFER LGTH 03050CSR MOVE BLK60 W60A 60 BUFFER 03060CSR EXITFQWREED READ FROM TERMINAL 03070CSR RLABL W60A READ BUFFER 03080CSR RLABL BUFLGT READ BUFFER LGTH 03090CSR MOVEAW60A A60 INPUT DATA ARRAY 03100CSR MOVE BLK60 W60A INIT INPUT ARRAY 03110CSR Z-ADD1 W 30 03120CSR '\' LOKUPA60,W 90 FLAG ESC 03130CSRN90 GOTO T75B NOT ESC 03140CSR 1 ADD W W 03150CSR W COMP 60 54 03160CSR 54 GOTO T75A BAD ESC 03170CSR A60,W COMP 'G' 98 GOODBY 03180CSR A60,W COMP 'E' 94 MENU 03190CSR A60,W COMP 'N' 93 NEW ITEM 03200CSR A60,W COMP 'B' 89 SKIP BKWRD 03210CSR A60,W COMP 'S' 88 SPACE FILL 03220CSR A60,W COMP 'U' 86 UPDATE 03230CSR 98 03240COR 94 03250COR 93 ÐÐ03260COR 89 03270COR 88 03280COR 86 GOTO END75 GOOD ESC 03290C*------------------------------------------------------------------ 03300CSR T75A TAG 03310C* FLAG BAD ESC INPUT 03320CSR Z-ADD318 M 96 FLAG ERROR 03330CSR GOTO END75 03340C*-------------------------------------------------------------------- 03350CSR T75B TAG 03360C* MOVE DATA 03370CSR Z-ADD1 W 03380CSR ' ' LOKUPA60,W 77 03390CSR 77 MOVEAA60,W W60A INPUT DATA 03400C*-------------------------------------------------------------------- 03410CSR END75 TAG 03420C* INIT PREV ERROR MSG. 03430CSR MOVE BLK35 MGTEXT 03440CSR ENDSR 03450C********************************************************************** 03460CSR SR80 BEGSR 03470C* GET MASTER RECORD 03480CSR MOVE ' ' OLDCLS 03490CSR MOVE ' ' OLDTYP 03500CSR MOVE ' ' OLDGRP ÐÐ03510CSR MOVE BLK20 OLD18 03520CSR SETOF 31 03530CSR TNAME CHAINPROGMAST 30 GET MASTER 03540CSRN30N31 PGSTAT COMP 'D' 31 FLAG DELETE 03550CSRN30N31 MOVE PGCLAS OLDCLS 1 03560CSRN30N31 MOVE PGTYPE OLDTYP 1 03570CSRN30N31 MOVE PGGRUP OLDGRP 1 03580CSRN30N31 MOVE PG18 OLD18 18 03590CSR ENDSR 03600C********************************************************************** 03610CSR SR81 BEGSR 03620C* ADD NEW MASTER TO FILE 03630CSR SETON 81 03640CSR EXCPT ADD MASTER 03650CSR SETOF 81 03660CSR ENDSR 03670C******************************************************************** 03680CSR SR82 BEGSR 03690C* REWRITE MASTER. 03700CSR SETON 82 03710CSR EXCPT REWRITE MASTER 03720CSR SETOF 82 03730CSR ENDSR 03740C******************************************************************** 03750CSR SR83 BEGSR ÐÐ03760C* ADD ALT KEYS. 03770C* ADD TYPE ALT. 03780CSR MOVELPGTYPE W9A 9 03790CSR MOVE PGNAME W9A 03800CSR EXSR SR41 GET PROGALTT 03810CSR MOVE 'A' PTSTAT 03820CSR EXSR SR31 ADD PROGALTT 03830C* ADD CLASS ALT. 03840CSR MOVELPGCLAS W9A 03850CSR MOVE PGNAME W9A 03860CSR EXSR SR42 GET PROGALTC 03870CSR MOVE 'A' PCSTAT 03880CSR EXSR SR32 ADD PROGALTC 03890C* ADD GROUP ALT. 03900CSR MOVELPGGRUP W11A 11 03910CSR MOVE PGNAME W11A 03920CSR EXSR SR43 GET PROGALTG 03930CSR MOVE 'A' PRSTAT 03940CSR EXSR SR33 ADD PROGALTG 03950C* ADD DESCRIPTION ALT. 03960CSR MOVEAPGGRUP A29 03970CSR MOVEAPG18 A29,4 03980CSR MOVEAPGNAME A29,22 03990CSR MOVEAA29 W29A 29 04000CSR EXSR SR44 GET PROGALTD ÐÐ04010CSR MOVE 'A' PDSTAT 04020CSR EXSR SR34 ADD PROGALTD 04030CSR ENDSR 04040C******************************************************************** 04050CSR SR84 BEGSR 04060C* DELETE ALT KEYS. 04070C* DELETE TYPE ALT. 04080CSR MOVELOLDTYP W9A 04090CSR MOVE PGNAME W9A 04100CSR EXSR SR41 GET PROGALTT 04110CSRN60 MOVE 'D' PTSTAT 04120CSRN60 EXSR SR31 DELETE PROGALTT 04130C* DELETE CLASS ALT. 04140CSR MOVELOLDCLS W9A 04150CSR MOVE PGNAME W9A 04160CSR EXSR SR42 GET PROGALTC 04170CSRN60 MOVE 'D' PCSTAT 04180CSRN60 EXSR SR32 DELETE PROGALTC 04190C* DELETE GROUP ALT. 04200CSR MOVELOLDGRP W11A 04210CSR MOVE PGNAME W11A 04220CSR EXSR SR43 GET PROGALTG 04230CSRN60 MOVE 'D' PRSTAT 04240CSRN60 EXSR SR33 DELETE PROGALTG 04250C* DELETE DESCRIPTION ALT. ÐÐ04260CSR MOVEAOLDGRP A29 04270CSR MOVEAOLD18 A29,4 04280CSR MOVEAPGNAME A29,22 04290CSR MOVEAA29 W29A 04300CSR EXSR SR44 GET PROGALTD 04310CSRN60 MOVE 'A' PDSTAT 04320CSRN60 EXSR SR34 DELETE PROGALTD 04330CSR ENDSR 04340C********************************************************************** 04350CSR SR89 BEGSR 04360C* GET MESSAGE MASTER 04370CSR M CHAINMGFILE 54 04380CSR 54 MOVE BLK35 MGTEXT 04390CSR 54 MOVELM MGTEXT 04400CSR 54 MOVE MES,1 MGTEXT 04410CSR ENDSR 04420C*********************************************************************** 04430CSR SR101 BEGSR 04440C* 1-TIME INITIALIZE 04450CSR MOVE BIT,1 NUL 04460CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04470CSR Z-ADD15 FLIMIT 30 TOTAL NUMB FIELDS 04480CSR MOVE ' ' BLK60 60 04490C* GET PORT # AND CRTFILE 04500CSR MOVE ' ' W8A 8 ÐÐ04510CSR Z-ADD0 W2N 20 04520CSR Z-ADD0 W1N 10 04530CSR MOVE ' ' W2A 2 04540CSR EXITFPGMINX GET PORT # 04550CSR RLABL W8A 04560CSR RLABL W2N 04570CSR RLABL W1N 04580CSR RLABL W2A 04590CSR MOVE W2A PORT 20 PORT NO. 04600CSR PORT COMP 0 54 04610CSRN54 Z-ADD25 PORT DEFAULT 04620CSR PORT CHAINCRTFILE H9 04630C* DEFINE WORK FIELDS,ETC. 04640CSR MOVE ' ' BLK35 35 04650CSR MOVE ' ' BLK20 20 04660CSR MOVE ' ' BLK8 8 04670CSR ENDSR 04680C********************************************************************** 04690CSR SR102 BEGSR 04700C* VALIDATE FIELD NO. 04710CSR F COMP 0 54 04720CSRN54 Z-ADD1 F 04730CSR F COMP FLIMIT 55 04740CSR 55 Z-ADD1 F 04750CSR ENDSR ÐÐ04760C******************************************************************** 04770CSR SR103 BEGSR 04780C* MOVE INPUT DATA 04790CSR EXSR SR201 IDENTIFY-F 04800CSR 01 MOVELW60A TRAN 1 TRAN CODE 04810CSR 02 MOVELW60A TNAME 8 PROG NAME 04820CSR 03 MOVE W60A PGDESC DESCR 04830CSR 05 MOVELW60A PGGRUP GROUP CODE 04840CSR 06 MOVELW60A PGTYPE TYPE CODE 04850CSR 07 MOVELW60A PGCLAS CLASS CODE 04860CSR 08 MOVELW60A PIO,1 04870CSR 09 MOVELW60A PIO,2 04880CSR 10 MOVELW60A PIO,3 04890CSR 11 MOVELW60A PIO,4 04900CSR 12 MOVELW60A PIO,5 04910CSR 13 MOVELW60A PIO,6 04920CSR 14 MOVELW60A PIO,7 04930CSR 15 MOVELW60A PIO,8 04940CSR MOVE ' ' DUN,F EDIT FLAG 04950CSR ENDSR 04960C******************************************************************** 04970CSR SR104 BEGSR 04980C* EDIT INPUT DATA 04990CSR 01 EXSR SR1 05000CSR 02 EXSR SR2 ÐÐ05010C* 05020CSR 96 MOVE ' ' DUN,F EDIT FLAG 05030CSRN96 MOVE 'X' DUN,F 05040CSR ENDSR 05050C*********************************************************************** 05060CSR SR105 BEGSR 05070C* FINAL EDIT 05080CSR SETOF 77 05090CSR SETON 79 FINAL EDIT FLAG 05100CSR Z-ADD1 F 96 05110C*-------------------------------------------------------------------- 05120CSR T105A TAG 05130CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05140CSRN54 GOTO END105 05150CSR EXSR SR201 IDENTIFY-F 05160CSR EXSR SR104 EDIT 05170CSRN96 GOTO T105A 05180C*-------------------------------------------------------------------- 05190CSR END105 TAG 05200CSR SETOF 79 05210CSR ENDSR 05220C******************************************************************** 05230CSR SR106 BEGSR 05240C* UPDATE DATA BASE. 05250CSR EXSR SR203 CLASSIFY TRAN ÐÐ05260CSR 60 GOTO T106A ADD TRAN 05270CSR 61 GOTO T106D CHANGE TRAN 05280CSR 62 GOTO T106F DELETE TRAN 05290C* FLAG BAD TRAN CODE 05300CSR Z-ADD300 M 96 FLAG ERROR 05310CSR Z-ADD1 F FIELD # 05320CSR GOTO END106 05330C*------------------------------------------------------------------- 05340CSR T106A TAG 05350C* ADD TRANSACTION 05360CSR 30 GOTO T106B NOT ON FILE 05370CSR 31 GOTO T106C DELETED MASTER 05380C* FLAG DUPLICATE ADD ERROR 05390CSR Z-ADD301 M 96 FLAG ERROR 05400CSR Z-ADD1 F FIELD # 05410CSR GOTO END106 05420C*--------------------------------------------------------------------- 05430CSR T106B TAG 05440C* ADD-- MAST NOT ON FILE 05450CSR EXSR SR81 ADD NEW MASTER 05460CSR EXSR SR83 ADD ALT 05470CSR GOTO END106 05480C*--------------------------------------------------------------------- 05490CSR T106C TAG 05500C* ADD-- MAST IS DELETED ÐÐ05510CSR MOVE 'A' PGSTAT RECORD STATUS 05520CSR EXSR SR82 REWRITE MAST 05530CSR EXSR SR83 ADD ALT 05540CSR GOTO END106 05550C*---------------------------------------------------------------------- 05560CSR T106D TAG 05570C* CHANGE TRANSACTION. 05580CSRN30N31 GOTO T106E GOT IT 05590C* FLAG NO MASTER ERROR 05600CSR Z-ADD302 M 96 FLAG ERROR 05610CSR Z-ADD1 F FIELD # 05620CSR GOTO END106 05630C*----------------------------------------------------------------------- 05640CSR T106E TAG 05650C* REWRITE MASTER 05660CSR EXSR SR82 REWRITE MAST 05670CSR EXSR SR84 DELETE ALT 05680CSR EXSR SR83 ADD ALT 05690CSR GOTO END106 05700C*----------------------------------------------------------------------- 05710CSR T106F TAG 05720C* DELETE TRANSACTION 05730CSRN30N31 GOTO T106G GOT IT 05740C* FLAG NO MASTER ERROR 05750CSR Z-ADD302 M 96 FLAG ERROR ÐÐ05760CSR Z-ADD1 F FIELD # 05770CSR GOTO END106 05780C*----------------------------------------------------------------------- 05790CSR T106G TAG 05800C* DELETE MASTER. 05810CSR MOVE 'D' PGSTAT RECORD STATUS 05820CSR EXSR SR82 REWRITE MASTER 05830CSR EXSR SR84 DELETE ALT 05840CSR END106 ENDSR 05850C************************************************************************ 05860CSR SR201 BEGSR 05870C* IDENTIFY FIELD NO. 05880CSR F COMP 1 01 05890CSR F COMP 2 02 05900CSR F COMP 3 03 05910CSR F COMP 4 04 05920CSR F COMP 5 05 05930CSR F COMP 6 06 05940CSR F COMP 7 07 05950CSR F COMP 8 08 05960CSR F COMP 9 09 05970CSR F COMP 10 10 05980CSR F COMP 11 11 05990CSR F COMP 12 12 06000CSR F COMP 13 13 ÐÐ06010CSR F COMP 14 14 06020CSR F COMP 15 15 06030CSR ENDSR 06040C*********************************************************************** 06050CSR SR203 BEGSR 06060C* CLASSIFY TRAN CODE 06070CSR TRAN COMP 'A' 60 ADD 06080CSR TRAN COMP 'C' 61 CHANGE 06090CSR TRAN COMP 'D' 62 DELETE 06100CSR MOVE ' ' TRNNAM 6 06110CSR 60 MOVE 'ADD ' TRNNAM 06120CSR 61 MOVE 'CHANGE' TRNNAM 06130CSR 62 MOVE 'DELETE' TRNNAM 06140CSR ENDSR 06150C******************************************************************** 06160CSR SR205 BEGSR 06170C* INIT PROGMAST. 06180CSR MOVE BLK20 PGNAME 06190CSR MOVE BLK60 PGDESC 06200CSR MOVE BLK20 PG18 06210CSR MOVE BLK60 PG42 06220CSR MOVE ' ' PGTYPE 06230CSR MOVE ' ' PGCLAS 06240CSR MOVE ' ' PGGRUP 06250CSR MOVE ' ' PIO ÐÐ06260CSR MOVE ' ' PGSTAT 06270CSR ENDSR 06280O******************************************************************** 06290OTERM78 E 72 01 06300O 14 '(1) TRAN CODE' 06310O TRAN 18 06320O TRNNAM 26 06330O*------------------------------------------------------------------- 06340O E 71 06350O OR 72 02 06360O 14 '(2) FILE NAME' 06370O TNAME 25 06380O*------------------------------------------------------------------- 06390O E 71 06400O OR 72 03 06410O 10 '(3) DESCR' 06420O PGDESC 77 06430O*------------------------------------------------------------------- 06440O E 71 06450O OR 72 05 06460O 10 '(5) GROUP' 06470O PGGRUP 20 06480O*------------------------------------------------------------------- 06490O E 71 06500O OR 72 06 ÐÐ06510O 9 '(6) TYPE' 06520O PGTYPE 18 06530O*------------------------------------------------------------------- 06540O E 71 06550O OR 72 07 06560O 10 '(7) CLASS' 06570O PGCLAS 18 06580O*------------------------------------------------------------------- 06590O E 71 06600O OR 72 08 06610O 12 '(8) DISK-IN' 06620O PIO,1 18 06630O*------------------------------------------------------------------- 06640O E 71 06650O OR 72 09 06660O 13 '(9) DISK-OUT' 06670O PIO,2 18 06680O*------------------------------------------------------------------- 06690O E 71 06700O OR 72 10 06710O 15 '(10) D. GRAPHIX' 06720O PIO,3 18 06730O*------------------------------------------------------------------- 06740O E 71 06750O OR 72 11 ÐÐ06760O 12 '(11) CDC CRT' 06770O PIO,4 18 06780O*------------------------------------------------------------------- 06790O E 71 06800O OR 72 12 06810O 13 '(12) SYS PRTR' 06820O PIO,5 18 06830O*------------------------------------------------------------------- 06840O E 71 06850O OR 72 13 06860O 12 '(13) DIABLO?' 06870O PIO,6 18 06880O*------------------------------------------------------------------- 06890O E 71 06900O OR 72 14 06910O 14 '(14) FLOPPY-IN' 06920O PIO,7 18 06930O*------------------------------------------------------------------- 06940O E 71 06950O OR 72 15 06960O 15 '(15) FLOPPY-OUT' 06970O PIO,8 18 06980O*------------------------------------------------------------------- 06990O E 73 07000O MGTEXT 35 ÐÐ07010O******************************************************************** 07020OPROGMASTEADD 81 07030O TNAME 8 07040O PGDESC 68 07050O PGTYPE 69 07060O PGCLAS 70 07070O PGGRUP 73 07080O PIO 82 07090O 85 'A' 07100O*------------------------------------------------------------------- 07110O E 82 07120O PGDESC 68 07130O PGTYPE 69 07140O PGCLAS 70 07150O PGGRUP 73 07160O PIO 82 07170O PGSTAT 85 07180O******************************************************************** 07190OPROGALTTEADD 31 60 07200O W9A 9 07210O 10 'A' 07220O*------------------------------------------------------------------- 07230O E 31N60 07240O PTSTAT 10 07250O******************************************************************** ÐÐ07260OPROGALTCEADD 32 60 07270O W9A 9 07280O 10 'A' 07290O*------------------------------------------------------------------- 07300O E 32N60 07310O PCSTAT 10 07320O******************************************************************** 07330OPROGALTGEADD 33 60 07340O W11A 11 07350O 12 'A' 07360O*------------------------------------------------------------------- 07370O E 33N60 07380O PRSTAT 12 07390O******************************************************************** 07400OPROGALTDEADD 34 60 07410O W29A 29 07420O 30 'A' 07430O*------------------------------------------------------------------- 07440O E 34N60 07450O PDSTAT 30 ** NUL ARRAY 07460 007470** A60 ARRAY 007480 007490** DUN ARRAY 007500ÐÐ 007510** MES ARRAY 007520*--MESSAGE NOT ON FILE--- 007530** A29 ARRAY 07540 07550/* 07560_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ((Ê §X013RX P120282120282(èÈÐ00010H Q013RX00020F* ROUTING TEXT DELETE PROGRAM. (X013RX) DG REL006 OK 00030F* REVISED 5/14/80 12:35 PM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060FREXTPTR UD F 25L21AI 1 DISK 00070FREXTFILEUC F 90R DISK 00080FREXTCONTUC F 16R DISK 00090FMGFILE IC F 80R DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 50 50 1 00130E A6 6 6 1 00140E A20 20 20 1 A 00150E A44 44 44 1 00160E BIT 33 1 00170E CALL 5 6 00180E CTX 60 1 A 00190E TXT 60 1 A 00200I******************************************************************* 00210IBITTAB BT 00220I 1 33 BIT 00230I********************************************************************* 00240IMGFILE MG 00250I 1 35 MGTEXT ÐÐ00260I********************************************************************** 00270IREXTCONTTC 00280I* TEXT CONTROL FILE 00290I* LAST USED RRN 7P 00300I 1 70TCLUTX 00310I* LAST DELETED RRN 7P 00320I 8 140TCLDTX 00330I********************************************************************** 00340ICRTFILE CR 00350I* MENU FIELDS 1 33 XXXXXX 00360I* CURRENT JOB 6A 00370I 21 26 CRJOB 00380I* CALLED BY PROG 6A 00390I 68 73 CRRET 00400I* CALL STACK 6A X 5 00410I 38 67 CALL 00420I* MENU NAME 6A 00430I 74 79 CRMENU 00440I*------------------------------------------------------------------- 00450I* PART # 12A 00460I 80 91 CRPN 00470I* OPER SEQ 3N 00480I 92 940CRSEQ 00490I* TEXT WORK AREA 1A X 60 00500I 95 154 CTX ÐÐ00510I* CUR INSTR 1A 00520I 215 215 CRTRAN 00530I* COPY FROM TEXT 6A 00540I 216 221 CRFTXT 00550I* COPY FROM LINE 7P 00560I P 222 2250CRFLIN 00570I* COPY THRU LINE 7P 00580I P 226 2290CRELIN 00590I* COPY TO TEXT 6A 00600I 230 235 CRTTXT 00610I* COPY TO LINE 7P 00620I P 236 2390CRTLIN 00630I* CURRENT LINE # 7P 00640I P 246 2490CRCLIN 00650I* LINE INCREMENT 3P 00660I P 250 2510CRINCR 00670I******************************************************************** 00680IREXTPTR TP 00690I* TEXT POINTER FILE. 00700I* TEXT KEY 15A 00710I 1 15 TPKEY 00720I* LINE # 6N 00730I 16 210TPLINE 00740I* POINTER 7P 00750I P 22 250TPPTR 61 ÐÐ00760I******************************************************************** 00770IREXTFILETX 00780I* REXTFILE RECORD. 00790I* KEY 15A 00800I 1 15 TXKEY 00810I* LINE # 6N 00820I 16 210TXLINE 00830I* TEXT 1A X 60 00840I 22 81 TXT 00850I* BACKWARD PTR (DELETE) 7P 00860I P 82 850TXBPTR 00870I* RECORD STATUS 1A 00880I 90 90 TXSTAT 00890C******************************************************************** 00900C* INITIALIZE. 00910C EXSR SR101 INIT. 00920C H9 GOTO ENDJOB PROG ERROR. 00930C 96 MOVEL'Q002RX' PROG 8 TEXT NOT ON FILE 00940C 96 GOTO END 00950C MOVELCRPN CRKEY 15 00960C MOVE CRSEQ CRKEY 00970C*------------------------------------------------------------------- 00980C START TAG 00990C* PROMPT/READ: FROM-LINE/THRU-LINE. 01000C SETOF 606162 ÐÐ01010C EXSR SR102 PROMPT/READ. 01020C 96 GOTO START ERROR. 01030C 98 GOTO GOODBY 01040C 94 GOTO MENU 01050C 93 GOTO NEWITM 01060C 92 GOTO START 01070C MOVELCRKEY W21A 21 01080C MOVE CRFLIN W6A 6 01090C MOVE W6A W21A 01100C W21A SETLLREXTPTR 01110C*------------------------------------------------------------------- 01120C TAG20 TAG 01130C EXSR SR77 CHK CONT-D. 01140C 54 GOTO NEWITM 01150C SETOF 54 01160C READ REXTPTR 54 01170C 54 GOTO START 01180C 61 GOTO TAG20 01190C TPKEY COMP CRKEY 54 01200C N54 GOTO START 01210C TPLINE COMP CRELIN 54 01220C 54 GOTO START 01230C Z-ADD1 RRN 70 01240C RRN CHAINREXTCONT H7 01250C H7 GOTO ENDJOB PROG ERROR. ÐÐ01260C TPPTR CHAINREXTFILE H8 01270C H8 GOTO ENDJOB 01280C Z-ADDTCLDTX TXBPTR 01290C Z-ADDTPPTR TCLDTX 01300C Z-ADD0 TPPTR 01310C EXSR SR77 CHK CONT-D. 01320C 54 GOTO NEWITM 01330C SETON 81 01340C EXCPT DELETE TEXT 01350C SETOF 81 01360C GOTO TAG20 01370C*------------------------------------------------------------------- 01380C NEWITM TAG 01390C MOVEL'Q002RX' PROG 01400C GOTO END 01410C*------------------------------------------------------------------- 01420C MENU TAG 01430C GOTO NEWITM 01440C*------------------------------------------------------------------- 01450C GOODBY TAG 01460C MOVEL'GOODBY' PROG 01470C*------------------------------------------------------------------- 01480C END TAG 01490C PROG COMP BLK8 54 01500C N54 MOVEL'Q002RX' PROG ÐÐ01510C EXSR SR97 UPDATE CRTFILE. 01520C EXITFCHAIN 01530C RLABL PROG 01540C*------------------------------------------------------------------- 01550C ENDJOB TAG 01560C******************************************************************* 01570CSR SR73 BEGSR 01580C* PUT MESSAGE TO TERMINAL 01590CSR SETON 73 01600CSR EXCPT PUT MSG 01610CSR SETOF 73 01620CSR ENDSR 01630C******************************************************************** 01640CSR SR75 BEGSR 01650C* READ 20-BYTES FROM SCREEN. 01660CSR SETOF 969098 01670CSR SETOF 949392 01680CSR SETOF 77 01690CSR MOVE BIT,1 A6 01700CSR MOVE BIT,11 A6,2 01710CSR MOVEAA6 W6A 6 01720CSR MOVE BLK20 W20A 20 01730CSR EXITFQWREED READ TERMINAL. 01740CSR RLABL W20A 01750CSR RLABL W6A ÐÐ01760CSR MOVEAW20A A20 01770CSR MOVE BLK20 W20A 01780CSR Z-ADD1 W 30 01790CSR '\' LOKUPA20,W 90 01800CSRN90 GOTO T75B NO ESCAPE 01810CSR 1 ADD W W 01820CSR W COMP 20 54 01830CSR 54 GOTO T75A BAD ESC 01840CSR A20,W COMP 'G' 98 GOODBY 01850CSR A20,W COMP 'E' 94 MENU 01860CSR A20,W COMP 'N' 93 NEW ITEM 01870CSR A20,W COMP 'D' 92 DONE 01880CSR 98 01890COR 94 01900COR 93 01910COR 92 GOTO END75 01920C*----------------------------------------------------------------- 01930CSR T75A TAG 01940C* FLAG BAD ESC CODE. 01950CSR Z-ADD318 M 50 96 FLAG ERROR. 01960CSR EXSR SR999 01970CSR GOTO END75 01980C*------------------------------------------------------------------- 01990CSR T75B TAG 02000CSR Z-ADD1 W ÐÐ02010CSR ' ' LOKUPA20,W 77 02020CSR 77 MOVEAA20,W W20A 02030C*------------------------------------------------------------------- 02040CSR END75 ENDSR 02050C******************************************************************** 02060CSR SR84 BEGSR 02070C* GET TEXT FILE. 02080CSR RRN CHAINREXTFILE 62 02090CSR 62 SETON H8 02100CSR 62 Z-ADD146 M 96 02110CSR 62 EXSR SR999 FLAG ERROR. 02120CSR ENDSR 02130C******************************************************************** 02140CSR SR77 BEGSR 02150C* CHK FOR CONTROL-D INTERRUPT. 02160CSR MOVE ' ' W2A 2 02170CSR EXITFQSTOP 02180CSR RLABL W2A 02190CSR W2A COMP ' ' 54 02200CSR ENDSR 02210C******************************************************************** 02220CSR SR89 BEGSR 02230C* GET MESSAGE MAST. 02240CSR M CHAINMGFILE 54 02250CSR ENDSR ÐÐ02260C******************************************************************** 02270CSR SR97 BEGSR 02280C* UPDATE CRTFILE. 02290CSR SETON 97 02300CSR EXCPT UPDATE CRTFILE. 02310CSR SETOF 97 02320CSR ENDSR 02330C*********************************************************************** 02340CSR SR101 BEGSR 02350C* 1-TIME INITIALIZE 02360CSR MOVE BIT,1 NUL 02370CSR MOVE BIT,1 A6 02380CSR MOVE ' ' W2A 2 02390CSR EXITFZGMINX GET PORT # 02400CSR RLABL W2A 02410CSR MOVE W2A PORT 20 02420CSR PORT CHAINCRTFILE H9 02430CSR H9 GOTO ENDJOB PROG ERROR 02440C* DEFINE WORK FIELDS. 02450CSR MOVE ' ' BLK8 8 02460CSR MOVE ' ' BLK6 6 02470CSR MOVE ' ' BLK10 10 02480CSR Z-ADD0 ZERO7 70 02490CSR MOVE ' ' BLK35 35 02500CSR MOVE ' ' BLK20 20 ÐÐ02510CSR MOVE ' ' BLK66 66 02520CSR END101 ENDSR 02530C******************************************************************* 02540CSR SR102 BEGSR 02550C* PROMPT/READ: FROM LINE #, ENDING LINE #. 02560C*------------------------------------------------------------------- 02570CSR T102A TAG 02580CSR Z-ADD0 CRFLIN 02590CSR Z-ADD0 CRELIN 02600CSR SETOF 96 02610CSR Z-ADD154 M MSG # 02620CSR EXSR SR89 GET MSG 02630CSR EXSR SR73 PROMPT. 02640CSR EXSR SR75 READ. 02650CSR 96 GOTO T102A 02660CSR 98 GOODBY 02670COR 94 MENU 02680COR 93 NEW ITEM 02690COR 92 GOTO END102 DONE 02700CSR MOVEAW20A A20 02710CSR Z-ADD1 W 02720CSR ',' LOKUPA20,W 54 02730CSRN54 GOTO T102B 02740CSR MOVEAA20,W W7A 7 02750CSR MOVE W7A W6A ÐÐ02760CSR EXSR SR202 R. JUSTIFY. 02770CSR MOVE W6A CRELIN ENDING LINE. 02780CSR MOVEABLK20 A20,W 02790C*------------------------------------------------------------------- 02800CSR T102B TAG 02810CSR MOVEAA20 W6A 02820CSR EXSR SR202 R. JUSTIFY 02830CSR MOVE W6A CRFLIN FROM LINE. 02840CSR CRFLIN COMP 0 55 02850CSRN55 Z-ADD171 M 96 02860CSRN55 EXSR SR999 02870CSRN55 GOTO T102A 02880CSR CRELIN COMP 0 54 02890CSRN54 Z-ADDCRFLIN CRELIN DEFAULT. 02900CSR END102 ENDSR 02910C******************************************************************** 02920CSR SR202 BEGSR 02930C* RIGHT JUSTIFY. 02940CSR Z-ADD6 W2N 20 02950CSR EXIT SUBRAJ R. JUSTIFY. 02960CSR RLABL W2N 02970CSR RLABL W6A 02980CSR ENDSR 02990C********************************************************************* 03000CSR SR999 BEGSR ÐÐ03010C* PUT ERR MSG TO TERM. 03020CSR EXSR SR89 GET MESSAGE 03030CSR EXSR SR73 PUT MSG 03040CSR ENDSR 03050O********************************************************************* 03060OCRTFILE E 97 03070O CTX 154 03080O CRTRAN 215 03090O CRFTXT 221 03100O CRFLIN 225P 03110O CRELIN 229P 03120O CRTTXT 235 03130O CRTLIN 249P 03140O CRCLIN 249P 03150O CRINCR 251P 03160O****************************************************************** 03170OREXTFILEE 81 03180O* DELETE TEXT RECORD 03190O TXBPTR 85P 03200O 90 'D' 03210O******************************************************************* 03220OREXTPTR E 81 03230O* REMOVE TEXT POINTER 03240O ZERO7 25P 03250O******************************************************************** ÐÐ03260OTERM132 E 81 03270O TXT 60 03280O TPLINEZ 75 03290O*-------------------------------------------------------------------- 03300O E 73 03310O* PUT MESSAGE TO TERMINAL 03320O NUL 93 03330O NUL 132 03340O MGTEXT 40 03350O 96 5 '*****' 03360O***************************************************************** 03370OREXTCONTE 81 03380O TCLUTX 7 03390O TCLDTX 14 03400O******************************************************************* ** NUL ARRAY 003410 003420** A6 ARRAY 003430 003440** A20 ARRAY 003450 003460** A44 ARRAY 003470 003480/* 003490_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(š)r š«X050PM P999999120282(èÈÐ00010H Q050PM00020F* DISPLAY PART MASTER IN STOCK LOCATION SEQ. (X050PM) 00030F* REVISED 1-04-82 11:35 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FSTKLOC ID F 17L16AI 1 DISK 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E AST 1 66 2 00120E A14 14 14 1 A INPUT DATA ARRAY 00130E MES 1 1 30 00140E BIT 33 1 SCREEN CONTR. CHAR 00150I******************************************************************** 00160IBITTAB BT 00170I 1 33 BIT 00180I******************************************************************** 00190ICRTFILE CR 00200I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00210I* EMPLOYEE # 5N 00220I 1 50CREMPL 00230I* USER CODE 8A 00240I 6 13 CRUSER 00250I* DEPT # 5N ÐÐ00260I 14 180CRDEPT 00270I* JOB NAME 8A (JOB LOADED BY MENU) 00280I 19 26 CRJOB 00290I* SHUTDOWN FLAG 1A 00300I* BLANK = NO SHUTDOWN 00310I 27 27 CRSHUT 00320I* TIME STARTED 6N 00330I 28 330CRTIME 00340I* DATE STARTED 4N 00350I 34 370CRDATE 00360I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00370I 68 73 CRRET 00380I* MENU NAME 6A 00390I 74 79 CRMENU 00400I******************************************************************** 00410IPMMST2 PM 00420I 1 100PMPN 00430I 94 95 PMSC 00440I 15 180PMPL 00450I 19 30 PMMODL 00460I 70 71 PMECHG 00470I 82 82 PMSIZ 00480I 85 86 PMUM 00490I 487 488 PMFAB 00500I P 315 3180PMFRCB ÐÐ00510I P 319 3220PMALB 00520I P 323 3260PMRLB 00530I P 327 3300PMSOB 00540I P 339 3420PMPRB 00550I P 343 3460PMPOB 00560I P 347 3500PMRPOB 00570I P 351 3540PMPWOB 00580I P 355 3580PMRWOB 00590I 31 59 PMDESC 00600I P 311 3140PMOHB 00610I 620 620 PMDEL 00620I 621 626 PMSLOC 00630I 674 674 PMSTAT 00640I******************************************************************** 00650ISTKLOC SL 00660I* STOCK LOCATION ALT-KEY FILE. 00670I* STOCK LOCATION 6A 00680I 1 6 SLLOC 00690I* PART # 10N 00700I 7 160SLPN 00710I* RECORD STATUS 1A 00720I 17 17 SLSTAT 00730C******************************************************************** 00740C* INITIALIZE 00750C EXSR SR101 1-TIME INIT ÐÐ00760C EXSR SR71 00770C*------------------------------------------------------------------ 00780C START TAG 00790C* SET-UP 1ST FIELD NO. 00800C* REQUEST STARTING LOCATION. 00810C SETON 76 00820C EXCPT PROMPT 00830C SETOF 76 00840C 1 ADD COUNT COUNT 00850C EXSR SR75 READ 00860C 98 GOTO GOODBY 00870C 94 GOTO MENU 00880C 90 GOTO NEWITM 00890C*------------------------------------------------------------------- 00900C TAG5 TAG 00910C MOVELW14A W6A 6 00920C MOVELW6A KEYSL 16 00930C KEYSL SETLLSTKLOC 00940C MOVE ' ' LSTLOC 6 00950C*------------------------------------------------------------------- 00960C TAG10 TAG 00970C SETOF 54 00980C READ STKLOC 54 00990C 54 GOTO TAG30 END OF FILE 01000C SLLOC COMP LSTLOC 54 ÐÐ01010C N54 GOTO TAG30 END OF FILE 01020C MOVE SLLOC LSTLOC 01030C SLSTAT COMP 'D' 54 01040C 54 GOTO TAG10 01050C EXSR SR80 GET PMMST2 01060C 30 GOTO TAG10 NOT ON FILE 01070C 1 ADD COUNT COUNT 30 01080C EXSR SR72 PUT DATA 01090C COUNT COMP 118 54 54 01100C N54 GOTO TAG10 01110C*----------------------------------------------------------------- 01120C TAG20 TAG 01130C SETON 74 01140C EXCPT END PAGE 01150C SETOF 74 01160C GOTO TAG40 01170C*--------------------------------------------------------------- 01180C TAG30 TAG 01190C SETON 70 01200C EXCPT END OF FILE MSG 01210C SETOF 70 01220C*---------------------------------------------------------------- 01230C TAG40 TAG 01240C 1 ADD COUNT COUNT 30 01250C EXSR SR75 READ ÐÐ01260C 98 GOTO GOODBY 01270C 94 GOTO MENU 01280C 90 GOTO NEWITM 01290C EXSR SR71 01300C 77 GOTO TAG5 01310C GOTO TAG10 01320C*------------------------------------------------------------------ 01330C NEWITM TAG 01340C* SET-UP LINK FOR NEW ITEM 01350C MOVEL'Q050PM' PROG 8 01360C GOTO END 01370C*------------------------------------------------------------------- 01380C MENU TAG 01390C* SET-UP LINK TO MENU 01400C MOVELCRMENU PROG 01410C GOTO END 01420C*-------------------------------------------------------------------- 01430C GOODBY TAG 01440C* LINK TO SIGN-OFF 01450C MOVEL'GOODBY' PROG 01460C GOTO END 01470C*------------------------------------------------------------------- 01480C END TAG 01490C EXITFCHAIN LINK TO NEXT PROG 01500C RLABL PROG ÐÐ01510C******************************************************************** 01520CSR SR68 BEGSR 01530CSR EXITFQCLF LF 01540CSR 1 ADD COUNT COUNT 01550CSR ENDSR 01560C******************************************************************** 01570CSR SR69 BEGSR 01580CSR EXITFQXYPOS MOVE CURSOR 01590CSR RLABL W6A 01600CSR ENDSR 01610C********************************************************************** 01620CSR SR71 BEGSR 01630C* PUT HEADING. 01640CSR EXITFZCPAGE CLEAR PAGE 01650CSR SETON 71 01660CSR EXCPT PUT HEADING 01670CSR SETOF 71 01680CSR Z-ADD95 COUNT 30 01690CSR ENDSR 01700C********************************************************************* 01710CSR SR72 BEGSR 01720C* PUT DATA TO TERMINAL 01730CSR Z-ADDPMFRCB TOTREQ 70 01740CSR PMALB ADD TOTREQ TOTREQ 01750CSR PMRLB ADD TOTREQ TOTREQ ÐÐ01760CSR PMSOB ADD TOTREQ TOTREQ 01770CSR PMPRB ADD PMPOB TOTORD 70 01780CSR PMRPOB ADD TOTORD TOTORD 01790CSR PMPWOB ADD TOTORD TOTORD 01800CSR PMRWOB ADD TOTORD TOTORD 01810CSR Z-ADDPMOHB AVAIL 70 54 01820CSRN54 Z-ADD0 AVAIL 01830CSR TOTORD ADD AVAIL AVAIL 01840CSR AVAIL SUB TOTREQ AVAIL 01850CSR SETON 72 01860CSR EXCPT PUT DATA 01870CSR SETOF 72 01880CSR ENDSR 01890C******************************************************************** 01900CSR SR75 BEGSR 01910C* READ FROM TERMINAL 01920CSR SETOF 779096 01930CSR SETOF 93 01940CSR MOVE BIT,8 BUFLGT 2 READ BUFFER LGTH 01950CSR MOVE BLK14 W14A 14 BUFFER 01960CSR EXITFQBELL RING BELL 01970CSR EXITFQWREED READ FROM TERMINAL 01980CSR RLABL W14A READ BUFFER 01990CSR RLABL BUFLGT READ BUFFER LGTH 02000CSR MOVEAW14A A14 INPUT DATA ARRAY ÐÐ02010CSR MOVE BLK14 W14A INIT INPUT ARRAY 02020CSR Z-ADD1 W 30 02030CSR '\' LOKUPA14,W 90 FLAG ESC 02040CSRN90 GOTO T75B NOT ESC 02050CSR 1 ADD W W 02060CSR W COMP 14 54 02070CSR 54 GOTO T75A BAD ESC 02080CSR A14,W COMP 'G' 98 GOODBY 02090CSR A14,W COMP 'E' 94 MENU 02100CSR A14,W COMP 'N' 93 NEW ITEM 02110CSR 98 02120COR 94 02130COR 93 GOTO END75 GOOD ESC 02140C*------------------------------------------------------------------ 02150CSR T75A TAG 02160C* FLAG BAD ESC INPUT 02170CSR GOTO END75 02180C*-------------------------------------------------------------------- 02190CSR T75B TAG 02200C* MOVE DATA 02210CSR Z-ADD1 W 02220CSR ' ' LOKUPA14,W 77 02230CSR 77 MOVEAA14,W W14A INPUT DATA 02240CSR END75 ENDSR 02250C********************************************************************** ÐÐ02260CSR SR80 BEGSR 02270C* GET MASTER RECORD 02280CSR SETOF 45 02290CSR MOVELSLPN W12A 12 02300CSR MOVE ' ' W12A 02310CSR W12A CHAINPMMST2 30 GET MASTER 02320CSR 30 MOVE ' ' OLDLOC 6 02330CSRN30 MOVE PMSLOC OLDLOC 02340CSRN30 PMSTAT COMP 'D' 30 FLAG DELETE 02350CSR 30 MOVE ' ' PMSLOC 02360CSRN30 PMDEL COMP '*' 45 FLAG DEL CANDIDATE 02370CSR ENDSR 02380C*********************************************************************** 02390CSR SR101 BEGSR 02400C* 1-TIME INITIALIZE 02410CSR MOVE '- ' AST 02420CSR MOVE BIT,1 NUL 02430CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 02440CSR MOVE ' ' BLK14 14 02450C* GET PORT # AND CRTFILE 02460CSR MOVE ' ' W8A 8 02470CSR Z-ADD0 W2N 20 02480CSR Z-ADD0 W1N 10 02490CSR MOVE ' ' W2A 2 02500CSR EXITFPGMINX GET PORT # ÐÐ02510CSR RLABL W8A 02520CSR RLABL W2N 02530CSR RLABL W1N 02540CSR RLABL W2A 02550CSR MOVE W2A PORT 20 PORT NO. 02560CSR PORT COMP 0 54 02570CSRN54 Z-ADD25 PORT DEFAULT 02580CSR PORT CHAINCRTFILE H9 02590C* DEFINE WORK FIELDS,ETC. 02600CSR MOVE ' ' BLK35 35 02610CSR ENDSR 02620O******************************************************************** 02630OTERM132 E 71 02640O* PUT HEADINGS. 02650O BIT,28 1 02660O 8 '8091001' 02670O UDATE Y 16 02680O 64 'PART NUMBERS BY STO' 02690O 86 'CK LOCATION ' 02700O*---------------------------------------------------------------- 02710O E 71 02720O 19 'STOCK' 02730O 70 'FAB' 02740O 75 'CHG' 02750O 80 'DWG' ÐÐ02760O 90 'PROD' 02770O 98 'QTY' 02780O 108 'QTY' 02790O 121 'QUANTITY' 02800O 129 'QTY' 02810O*----------------------------------------------------------------- 02820O E 71 02830O 6 'PART #' 02840O 18 'LOC' 02850O 34 'DESCRIPTION' 02860O 61 'MODEL NAME' 02870O 66 'SC' 02880O 71 'CODE' 02890O 75 'LEV' 02900O 80 'SIZ' 02910O 84 'UM' 02920O 91 'CLASS' 02930O 100 'ON-HAND' 02940O 111 'ON-ORDER' 02950O 121 'REQUIRED' 02960O 131 'AVAIL' 02970O*------------------------------------------------------------------- 02980O E 71 02990O AST 132 03000O*------------------------------------------------------------------- ÐÐ03010O E 72 03020O* PUT DATA. 03030O PMPN 12 ' - - ' 03040O 45 13 '*' 03050O PMSLOC 20 03060O PMDESC 50 03070O PMMODL 63 03080O PMSC 66 03090O PMFAB 70 03100O PMECHG 74 03110O PMSIZ 79 03120O PMUM 84 03130O PMPL Z 90 03140O PMOHB K 101 03150O TOTORD2 112 03160O TOTREQ2 121 03170O AVAIL K 132 03180O*------------------------------------------------------------------- 03190O E 74 03200O OR 70 03210O NUL 132 03220O 17 'END OF PAGE.... ' 03230O 70 11 'FILE' 03240O 36 'ENTER ESC-CODE, OR ' 03250O 53 'STARTING LOCATION' ÐÐ03260O 74 67 ', OR RETURN ' 03270O 70 55 ' ' 03280O*-------------------------------------------------------------- 03290O E 76 03300O NUL 132 03310O 24 'ENTER STARTING LOCATION ' 03320O 26 ' ' 03330O********************************************************************* ** NUL ARRAY 003340 003350** AST ARRAY 03360 03370** A14 ARRAY 003380 003390** MES ARRAY 003400---MESSAGE NOT ON FILE--- 003410/* 003420_‚ ÐÐ ÐÐ ÐÐ _‚_‚ ÐÈ(Š* ŠX002UJ P120282120282(èÈÐ00010H Q002UJ00020F* UPDATE UJMAST/UJKEY FILES. (X002UJ) DG REL006 OK 00030F* REVISED 11/23/79 5:50 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FUJMAST UC F 12R11AI 1 DISK A 00070FUJKEY UC F 12R11AI 1 DISK A 00080FBJMAST IC F 106R 6AI 1 DISK 00090FMENUDEPTIT F 25 EDISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A6 6 6 1 CALL READ PARAM. 00140E A8 8 8 1 A INPUT DATA ARRAY 00150E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 3 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E LOC 1 3 3 0 XY-POSITION 00190E MENUDEPT TABDEP 1 10 5 0 TABDN 20 DEPT #/NAME 00200E* 00210E* 00220E BIT 256 1 SCREEN CONTR. CHAR 00230E CALL 5 6 CALL STACK 00240E BJD 6 4 REPORT DISTR. 00250E* ÐÐ00260I******************************************************************* 00270IBITHEX BT 00280I 1 256 BIT 00290I******************************************************************* 00300IMGFILE MG 00310I* MESSAGE FILE. 00320I 1 35 MGTEXT 00330I******************************************************************** 00340IUJMAST UJ 00350I* USER JOB MENU. 00360I* DEPT 5N 00370I 1 50UJDEPT 00380I* JOB NAME 6A 00390I 6 11 UJNAME 00400I* RECORD STATUS 1A 00410I 12 12 UJSTAT 00420I******************************************************************** 00430IUJKEY JU 00440I* UJMAST ALT-KEY FILE. 00450I* JOB NAME 6A 00460I 1 6 JUNAME 00470I* DEPT 5N 00480I 7 110JUDEPT 00490I* RECORD STATUS 1A 00500I 12 12 JUSTAT ÐÐ00510I******************************************************************** 00520IBJMAST BJ 00530I* BATCH JOB MAST. 00540I* JOB NAME 6A 00550I 1 6 BJNAME 00560I* DESCRIPTION 40A 00570I 7 46 BJDESC 00580I* PRINTER 1A 00590I* D = DIABLO 00600I* S = SYSTEM PRINTER 00610I* T = DATAGRAPHIX 00620I* C = CONSOLE 00630I 47 47 BJPRTR 00640I* PAPER 25A 00650I 48 72 BJPAP 00660I* COPIES 1N 00670I 73 730BJCOPY 00680I* DISTRIBUTION 4A X 6 00690I 74 97 BJD 00700I* UPDATE CODE 1A 00710I* Y = SHARABLE 00720I* N = NOT SHARABLE 00730I* BLK = NO DISK UPDATE 00740I 98 98 BJUPD 00750I* TYPE CODE 1A ÐÐ00760I* P = PROGRAM (MAINLINE OR CALLED BY PROC) 00770I* U = UTILITY (ONLY) 00780I* Z = JOB STREAM 00790I* M = MENU 00800I* C = CALLED PROGRAM 00810I 99 99 BJTYPE 00820I* RECORD STATUS 1A 00830I 106 106 BJSTAT 00840C******************************************************************** 00850C* INITIALIZE 00860C EXSR SR101 1-TIME INIT 00870C Z-ADD28 LINENO 30 TRIGGER HEADING 00880C*------------------------------------------------------------------ 00890C START TAG 00900C* SET-UP 1ST FIELD NO. 00910C MOVE ' ' DUN EDIT ARRAY 00920C Z-ADD1 F 30 FIELD # 00930C Z-ADD0 CRDEPT 50 DEPT # 00940C MOVE BLK6 CRNAME JOB NAME 00950C MOVE ' ' CRTRAN TRAN CODE 00960C MOVE BLK40 JOBNAM 00970C MOVE BLK40 DEPNAM 00980C EXITFQCLFCR MOVE CURSOR. 00990C 1 ADD LINENO LINENO 30 01000C LINENO COMP 28 54 ÐÐ01010C 54 EXSR SR71 01020C GOTO READ 01030C*------------------------------------------------------------------ 01040C NEXT TAG 01050C* SET-UP NEXT FIELD NO. 01060C 1 ADD F F FIELD # 01070C*----------------------------------------------------------------- 01080C READ TAG 01090C* READ DATA FROM TERMINAL. 01100C SETOF 9096 01110C EXSR SR102 VALIDATE FIELD # 01120C 55 GOTO UPDATE DONE 01130C EXSR SR201 IDENTIFY-F 01140C SETON 69 01150C EXSR SR72 PROMPT 01160C SETOF 69 01170C EXSR SR75 READ TERMINAL 01180C 98 GOTO GOODBY GOODBY 01190C 94 GOTO MENU MENU REQUEST 01200C N77N88 EXSR SR104 EDIT INPUT FIELD 01210C 96 ERROR 01220CORN77N88 EXSR SR72 REWRITE INPUT DATA 01230C 93 GOTO NEWITM NEW ITEM 01240C 92 GOTO JUMP FIELD JUMP REQST 01250C 91 GOTO NEXT SKIP FORWARD ÐÐ01260C 89 F SUB 1 F SKIP BACKWARD 01270C 89 GOTO READ " " 01280C 88 SETOF 90 SPACE FILL 01290C 88 SETON 77 " " 01300C 87 GOTO START 01310C 86 GOTO UPDATE UPDATE 01320C 85 GOTO READ REPEAT 01330C 96 GOTO ERROR ERROR 01340C N77 GOTO NEXT NO DATA INPUT 01350C*------------------------------------------------------------------ 01360C PROCES TAG 01370C* PROCESS INPUT DATA 01380C EXSR SR103 MOVE DATA 01390C N96 EXSR SR104 EDIT DATA 01400C EXSR SR72 REWRITE DATA 01410C 96 GOTO ERROR ERROR 01420C GOTO NEXT 01430C*------------------------------------------------------------------ 01440C UPDATE TAG 01450C* UPDATE DATA BASE. 01460C EXSR SR105 FINAL EDIT 01470C 96 GOTO ERROR ERROR 01480C EXSR SR106 UPDATE 01490C 96 GOTO ERROR ERROR 01500C* UPDATE ALT-KEY. ÐÐ01510C EXSR SR203 CLASSIFY TRAN. 01520C 60 ADD. 01530COR 62 EXSR SR108 DELETE. 01540C GOTO START 01550C*------------------------------------------------------------------- 01560C JUMP TAG 01570C* SET-UP JUMP TO REQUESTED FIELD 01580C 1 ADD W W 30 01590C W COMP 8 54 01600C 54 Z-ADD318 M 50 96 FLAG ERROR 01610C 54 GOTO ERROR BAD ESC 01620C MOVE '000' W3A 3 01630C MOVEAA8,W W3A 01640C Z-ADD3 W2N 20 01650C EXIT SUBRAJ R. JUSTIFY 01660C RLABL W2N 01670C RLABL W3A 01680C MOVE W3A F NEW FIELD # 01690C GOTO READ 01700C*-------------------------------------------------------------------- 01710C ERROR TAG 01720C EXSR SR102 VALIDATE FIELD # 01730C EXSR SR89 GET MSG 01740C EXSR SR73 PUT MSG 01750C GOTO READ ÐÐ01760C*------------------------------------------------------------------ 01770C NEWITM TAG 01780C* SET-UP LINK FOR NEW ITEM 01790C GOTO START 01800C*------------------------------------------------------------------- 01810C MENU TAG 01820C* SET-UP LINK TO MENU 01830C MOVEL'QQDP01' PROG 8 01840C GOTO END 01850C*-------------------------------------------------------------------- 01860C GOODBY TAG 01870C* LINK TO SIGN-OFF 01880C MOVEL'GOODBY' PROG 01890C GOTO END 01900C*------------------------------------------------------------------- 01910C END TAG 01920C* LINK TO MENU OR SIGN-OFF 01930C PROG COMP BLK8 54 01940C N54 MOVEL'QQDP01' PROG 01950C EXITFCHAIN LINK NEXT PROG 01960C RLABL PROG 01970C********************************************************************* 01980CSR SR1 BEGSR 01990C* EDIT TRAN CODE. 02000CSR EXSR SR203 CLASSIFY TRAN. ÐÐ02010CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 02020CSR ENDSR 02030C******************************************************************* 02040CSR SR2 BEGSR 02050C* EDIT DEPT. 02060CSR CRDEPT COMP 0 54 02070CSRN54 Z-ADD232 M 96 FLAG ERROR. 02080CSRN54 MOVE BLK35 DEPNAM 20 DEPT NAME OUTPUT 02090CSRN54 GOTO END2 02100CSR CRDEPT LOKUPTABDEP TABDN 54 02110CSRN54 Z-ADD232 M 96 FLAG ERROR 02120CSRN54 MOVE BLK35 DEPNAM 02130CSR 54 MOVE TABDN DEPNAM 02140CSR END2 ENDSR 02150C********************************************************************* 02160CSR SR3 BEGSR 02170C* EDIT JOB NAME. 02180CSR CRNAME COMP BLK6 54 02190CSRN54 Z-ADD224 M 96 FLAG ERROR. 02200CSRN54 GOTO END3 02210CSR CRNAME CHAINBJMAST 60 02220CSRN60 BJSTAT COMP 'D' 60 02230CSR 60 Z-ADD302 M 96 FLAG ERROR. 02240CSR 60 MOVE BLK40 JOBNAM 40 JOB NAME 02250CSRN60 MOVE BJDESC JOBNAM ÐÐ02260CSR END3 ENDSR 02270C********************************************************************** 02280CSR SR71 BEGSR 02290C* PUT HEADINGS TO TERMINAL 02300CSR SETON 71 02310CSR EXCPT PUT HEADINGS 02320CSR SETOF 71 02330CSR Z-ADD4 LINENO 02340CSR ENDSR 02350C********************************************************************* 02360CSR SR72 BEGSR 02370C* PUT DATA TO TERMINAL 02380CSR EXITFQMOVUP MOVE CURSOR. 02390CSR SETON 72 02400CSR EXCPT PUT DATA 02410CSR SETOF 72 02420CSRN69 GOTO END72 02430CSR EXITFQCCR MOVE CURSOR. 02440CSR 1 ADD LOC,F X 30 02450CSR MOVE BIT,X W2A 2 02460CSR MOVELBIT,1 W2A 02470CSR EXITFQMOVR MOVE CURSOR. 02480CSR RLABL W2A 02490CSR EXITFQBELL RING BELL. 02500CSR END72 ENDSR ÐÐ02510C*********************************************************************** 02520CSR SR73 BEGSR 02530C* PUT ERROR MESSAGE TO TERMINAL 02540CSR SETON 73 02550CSR EXCPT PUT MSG 02560CSR SETOF 73 02570CSR Z-ADDM LSTERR 50 02580CSR EXITFQMOVUP MOVE CURSOR. 02590CSR ENDSR 02600C******************************************************************* 02610CSR SR75 BEGSR 02620C* READ FROM TERMINAL 02630CSR SETOF 779096 02640CSR SETOF 939291 02650CSR SETOF 898887 02660CSR SETOF 8685 02670CSR MOVE BIT,5 A6,2 BUF LENGTH 02680CSR MOVEAA6 W6A 6 02690CSR MOVE BLK8 W8A 8 BUFFER 02700CSR EXITFQWREED READ TERM 02710CSR RLABL W8A 02720CSR RLABL W6A 02730CSR MOVEAW8A A8 02740CSR MOVE BLK8 W8A 02750CSR Z-ADD1 W 30 ÐÐ02760CSR '\' LOKUPA8,W 90 FLAG ESC 02770CSRN90 GOTO T75B NOT ESC 02780CSR 1 ADD W W 02790CSR W COMP 8 54 02800CSR 54 GOTO T75A BAD ESC 02810CSR A8,W COMP 'G' 98 GOODBY 02820CSR A8,W COMP 'E' 94 MENU 02830CSR A8,W COMP 'N' 93 NEW ITEM 02840CSR A8,W COMP 'J' 92 JUMP 02850CSR A8,W COMP 'F' 91 SKIP FRWRD 02860CSR A8,W COMP 'B' 89 SKIP BKWRD 02870CSR A8,W COMP 'S' 88 SPACE FILL 02880CSR A8,W COMP 'H' 87 HOME 02890CSR A8,W COMP 'U' 86 UPDATE 02900CSR A8,W COMP 'R' 85 REPEAT 02910CSR 98 02920COR 94 02930COR 93 02940COR 92 02950COR 91 02960COR 89 02970COR 88 02980COR 87 02990COR 86 03000COR 85 GOTO END75 GOOD ESC ÐÐ03010C*------------------------------------------------------------------ 03020CSR T75A TAG 03030C* FLAG BAD ESC INPUT 03040CSR Z-ADD318 M 96 FLAG ERROR 03050CSR GOTO END75 03060C*-------------------------------------------------------------------- 03070CSR T75B TAG 03080C* MOVE DATA 03090CSR Z-ADD1 W 03100CSR ' ' LOKUPA8,W 77 03110CSR 77 MOVEAA8,W W8A INPUT DATA 03120C*-------------------------------------------------------------------- 03130CSR END75 TAG 03140C* INIT PREV ERROR MSG. 03150CSR LSTERR COMP 0 54 03160CSR 54 MOVE BLK35 MGTEXT 03170CSR 54 EXSR SR73 BLANK MESSAGE 03180CSR Z-ADD0 LSTERR 50 03190CSR ENDSR 03200C********************************************************************** 03210CSR SR80 BEGSR 03220C* GET MASTER RECORD 03230CSR SETOF 61 03240CSR MOVELCRDEPT W11A 11 03250CSR MOVE CRNAME W11A ÐÐ03260CSR W11A CHAINUJMAST 60 GET MASTER 03270CSRN60 UJSTAT COMP 'D' 61 FLAG DELETE 03280CSR ENDSR 03290C********************************************************************** 03300CSR SR81 BEGSR 03310C* ADD NEW MASTER TO FILE 03320CSR SETON 81 03330CSR EXCPT ADD MASTER 03340CSR SETOF 81 03350CSR ENDSR 03360C*********************************************************************** 03370CSR SR82 BEGSR 03380C* REWRITE MASTER 03390CSR SETON 82 03400CSR EXCPT REWRITE MASTER 03410CSR SETOF 82 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR84 BEGSR 03450C* REWRITE ALT-KEY. 03460CSR SETON 84 03470CSR EXCPT REWRITE UJKEY. 03480CSR SETOF 84 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR85 BEGSR 03520C* ADD NEW ALT-KEY. 03530CSR SETON 85 03540CSR EXCPT ADD UJKEY. 03550CSR SETOF 85 03560CSR ENDSR 03570C********************************************************************** 03580CSR SR89 BEGSR 03590C* GET MESSAGE MASTER 03600CSR M CHAINMGFILE 54 03610CSR 54 MOVE BLK35 MGTEXT 03620CSR 54 MOVELM MGTEXT 03630CSR 54 MOVE MES,1 MGTEXT 03640CSR ENDSR 03650C******************************************************************** 03660CSR SR101 BEGSR 03670C* 1-TIME INITIALIZE 03680CSR MOVE BIT,1 NUL 03690CSR MOVE BIT,1 A6 03700CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03710CSR MOVE ' ' BLK8 8 03720C* DEFINE WORK FIELDS,ETC. 03730CSR MOVE ' ' BLK35 35 03740CSR MOVE ' ' BLK6 6 03750CSR MOVE ' ' BLK40 40 ÐÐ03760C* 03770C* 03780C* 03790CSR ENDSR 03800C********************************************************************** 03810CSR SR102 BEGSR 03820C* VALIDATE FIELD NO. 03830CSR F COMP 0 54 03840CSRN54 Z-ADD1 F 03850CSR F COMP FLIMIT 55 03860CSR 55 Z-ADD1 F 03870CSR ENDSR 03880C******************************************************************** 03890CSR SR103 BEGSR 03900C* MOVE INPUT DATA 03910CSR EXSR SR201 IDENTIFY-F 03920CSR EXSR SR202 R. JUSTIFY 03930CSR 01 MOVELW8A CRTRAN 1 TRAN CODE. 03940CSR 02 MOVE W8A CRDEPT 50 DEPT #. 03950CSR 03 MOVELW8A CRNAME 6 JOB NAME. 03960CSR MOVE ' ' DUN,F EDIT FLAG 03970CSR ENDSR 03980C******************************************************************** 03990CSR SR104 BEGSR 04000C* EDIT INPUT DATA ÐÐ04010CSR 01 EXSR SR1 04020CSR 02 EXSR SR2 04030CSR 03 EXSR SR3 04040CSR 96 MOVE ' ' DUN,F EDIT FLAG 04050CSRN96 MOVE 'X' DUN,F 04060CSR ENDSR 04070C*********************************************************************** 04080CSR SR105 BEGSR 04090C* FINAL EDIT 04100CSR SETON 79 FINAL EDIT FLAG 04110CSR Z-ADD1 F 96 04120C*-------------------------------------------------------------------- 04130CSR T105A TAG 04140CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04150CSRN54 GOTO END105 04160CSR EXSR SR201 IDENTIFY-F 04170CSR EXSR SR104 EDIT 04180CSRN96 GOTO T105A 04190C*-------------------------------------------------------------------- 04200CSR END105 TAG 04210CSR SETOF 79 04220CSR ENDSR 04230C******************************************************************** 04240CSR SR106 BEGSR 04250C* UPDATE DATA BASE. ÐÐ04260CSR EXSR SR203 CLASSIFY TRAN 04270CSR 60 GOTO T106A ADD TRAN 04280CSR 61 GOTO T106D CHANGE TRAN 04290CSR 62 GOTO T106F DELETE TRAN 04300C* FLAG BAD TRAN CODE 04310CSR Z-ADD300 M 96 FLAG ERROR 04320CSR Z-ADD1 F FIELD # 04330CSR GOTO END106 04340C*------------------------------------------------------------------- 04350CSR T106A TAG 04360C* ADD TRANSACTION 04370CSR EXSR SR80 GET MASTER 04380CSR 60 GOTO T106B NOT ON FILE 04390CSR 61 GOTO T106C DELETED MASTER 04400C* FLAG DUPLICATE ADD ERROR 04410CSR Z-ADD301 M 96 FLAG ERROR 04420CSR Z-ADD1 F FIELD # 04430CSR GOTO END106 04440C*--------------------------------------------------------------------- 04450CSR T106B TAG 04460C* ADD-- MAST NOT ON FILE 04470CSR EXSR SR81 ADD NEW MASTER 04480CSR GOTO END106 04490C*--------------------------------------------------------------------- 04500CSR T106C TAG ÐÐ04510C* ADD-- MAST IS DELETED 04520CSR MOVE 'A' UJSTAT RECORD STATUS 04530CSR EXSR SR82 REWRITE MAST 04540CSR GOTO END106 04550C*---------------------------------------------------------------------- 04560CSR T106D TAG 04570C* CHANGE TRANSACTION. 04580CSR EXSR SR80 GET MASTER 04590CSRN60N61 GOTO T106E GOT IT 04600C* FLAG NO MASTER ERROR 04610CSR Z-ADD302 M 96 FLAG ERROR 04620CSR Z-ADD1 F FIELD # 04630CSR GOTO END106 04640C*----------------------------------------------------------------------- 04650CSR T106E TAG 04660C* REWRITE MASTER 04670CSR EXSR SR82 REWRITE MAST 04680CSR GOTO END106 04690C*----------------------------------------------------------------------- 04700CSR T106F TAG 04710C* DELETE TRANSACTION 04720CSR EXSR SR80 GET MASTER 04730CSRN60N61 GOTO T106G GOT IT 04740C* FLAG NO MASTER ERROR 04750CSR Z-ADD302 M 96 FLAG ERROR ÐÐ04760CSR Z-ADD1 F FIELD # 04770CSR GOTO END106 04780C*----------------------------------------------------------------------- 04790CSR T106G TAG 04800C* DELETE MASTER. 04810CSR MOVE 'D' UJSTAT RECORD STATUS 04820CSR EXSR SR82 REWRITE MASTER 04830CSR END106 ENDSR 04840C******************************************************************** 04850CSR SR108 BEGSR 04860C* UPDATE ALT-KEY FILE. 04870CSR MOVELCRNAME W11A 04880CSR MOVE CRDEPT W11A 04890CSR W11A CHAINUJKEY 60 GET ALT-KEY. 04900CSR 60 GOTO T108A NOT ON FILE. 04910CSR EXSR SR203 CLASSIFY TRAN. 04920CSR 60 MOVE 'A' JUSTAT 04930CSRN60 MOVE 'D' JUSTAT 04940CSR EXSR SR84 REWRITE ALT-KEY. 04950CSR GOTO END108 04960C*------------------------------------------------------------------- 04970CSR T108A TAG 04980C* NO ALT-KEY ON FILE. 04990CSR EXSR SR203 CLASSIFY TRAN. 05000CSR 60 EXSR SR85 ADD ALT-KEY. ÐÐ05010CSR END108 ENDSR 05020C************************************************************************ 05030CSR SR201 BEGSR 05040C* IDENTIFY FIELD NO. 05050CSR SETOF 010203 05060CSR F COMP 1 01 05070CSR F COMP 2 02 05080CSR F COMP 3 03 05090CSR ENDSR 05100C********************************************************************** 05110CSR SR202 BEGSR 05120C* RIGHT JUSTIFY 05130CSR F LOKUPNUM 54 05140CSRN54 GOTO END202 NOT NUMERIC FIELD 05150CSR Z-ADD8 W2N 20 05160CSR EXIT SUBRAJ R. JUSTIFY 05170CSR RLABL W2N 05180CSR RLABL W8A 05190CSR END202 ENDSR 05200C*********************************************************************** 05210CSR SR203 BEGSR 05220C* CLASSIFY TRAN CODE 05230CSR CRTRAN COMP 'A' 60 ADD 05240CSR CRTRAN COMP 'C' 61 CHANGE 05250CSR CRTRAN COMP 'D' 62 DELETE ÐÐ05260CSR ENDSR 05270C**************************************************************************05280O******************************************************************** 05290OUJMAST EADD 81 05300O CRDEPT 5 05310O CRNAME 11 05320O 12 'A' 05330O*------------------------------------------------------------------- 05340O E 82 05350O UJSTAT 12 05360O******************************************************************** 05370OUJKEY EADD 85 05380O CRNAME 6 05390O CRDEPT 11 05400O 12 'A' 05410O*------------------------------------------------------------------- 05420O E 84 05430O UJSTAT 12 05440O******************************************************************** 05450OTERM132 E 71 05460O* PUT HEADING. 05470O E 71 05480O 4 'TRAN' 05490O 15 'DEPT' 05500O 44 'JOB' ÐÐ05510O*------------------------------------------------------------------- 05520O E 71 05530O*------------------------------------------------------------------- 05540O E 72 05550O* PUT DATA. 05560O CRTRAN 2 05570O CRDEPTZ 15 05580O DEPNAM 38 05590O CRNAME 46 05600O JOBNAM 88 05610O*------------------------------------------------------------------- 05620O E 73 05630O* PUT MESSAGE. 05640O NUL 132 05650O MGTEXT 35 05660O 37 ' ' ** NUL ARRAY 005670 005680** A6 ARRAY 005690 005700** A8 ARRAY 005710 005720** NUM ARRAY 005730002 005740** DUN ARRAY 005750ÐÐ 005760** MES ARRAY 005770---MESSAGE NOT ON FILE--- 005780** LOC ARRAY 005790002 1 TRAN CODE 005800012 2 DEPT # 005810041 3 JOB NAME 005820/* 005830_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–W: –?X003DP PÈÈ999999050383(èÈÐ00010H Q003DP00020F* INSERT DEBUG STATEMENTS IN RPG PROG 00030F* REV 1/15/81 10:45 AM. 00040F* 00050F* SWITCH-1: INSERTS DEBUG STATEMENT AFTER BEGSR STATEMENT. 00060F* SWITCH-2: " " " " EXSR " . 00070F* SWITCH-3: " " " " TAG " . 00080F* NORMAL RUN IS SWITCH 1 AND 3. 00090FRPGCONT UP F 5 DISK 00100FEDPIN IS F 80 80 DISK 00110FEDPOUT O F 80 80 DISK 00120E REC 80 1 00130IRPGCONT RP 02 00140I 1 50BEGLIN 00150IEDPIN EI 01 00160I 1 50RPGLIN 00170I 1 80 REC 00180C NU1NU2NU3 SETON H8LR 00190C H8 GOTO END 00200C 02 Z-ADDBEGLIN CHKLIN 50 00210C 02 GOTO END 00220C 02 Z-ADD0 ZERO5 50 00230C N68 00240COR 85 GOTO TAG2 00250C MOVEAREC,1 W2A 2 ÐÐ00260C W2A COMP '**' 70 00270C N70 W2A COMP '/*' 70 00280C N70 GOTO TAG2 00290C SETON 1469 00300C EXCPT PRINT OUTPUT LINE 00310C SETOF 14 00320C*---------------------------------------------------------------- 00330C TAG2 TAG 00340C N85 W2A COMP '**' 85 00350C W2A COMP '/*' 86 00360C 86 SETON 85 00370C 85 GOTO END 00380C 67 GOTO TAG5 00390C REC,6 COMP 'H' 54 00400C 54 MOVE '1' REC,15 00410C REC,6 COMP 'F' 54 00420C 54 MOVEAREC,7 W8A 8 00430C 54 W8A COMP 'PRINT ' 67 00440C 67 GOTO TAG5 00450C REC,6 COMP 'F' 54 00460C N54 REC,6 COMP 'C' 54 00470C N54 GOTO TAG5 00480C SETON 1368 00490C EXCPT PRINT F SPEC 00500C SETOF 13 ÐÐ00510C*--------------------------------------------------------------- 00520C TAG5 TAG 00530C N68 00540COR 69 GOTO TAG6 00550C REC,6 COMP 'O' 69 00560C 69 MOVEAREC,7 W8A 8 00570C 69 W8A COMP 'PRINT ' 69 00580C*-------------------------------------------------------------- 00590C TAG6 TAG 00600C RPGLIN COMP CHKLIN 54 54 00610C N54 GOTO END 00620C REC,6 COMP 'C' 54 00630C N54 GOTO END 00640C MOVEAREC,28 W3A 3 00650C MOVEAREC,28 W5A 5 00660C MOVEAREC,28 W4A 4 00670C SETOF 545556 00680C U2 W4A COMP 'EXSR' 54 00690C U1 W5A COMP 'BEGSR' 55 00700C U3 W3A COMP 'TAG' 56 00710C 54 U2 GOTO TAG10 EXSR STMT 00720C 55 U1 GOTO TAG20 BEGSR STMT 00730C 56 U3 GOTO TAG20 TAG STMT 00740C GOTO END 00750C*------------------------------------------------------------------ ÐÐ00760C TAG10 TAG 00770C* PROCESS EXSR STATEMENT 00780C SETOF 01 00790C MOVEAREC,7 W11A 11 00800C EXSR SR10 PUT REC 00810C MOVEAREC,7 W2A 00820C W2A COMP 'OR' 54 00830C 54 GOTO END 00840C MOVEAREC,33 W6A 6 00850C SETON 12 00860C EXSR SR11 PUT DEBUG 00870C SETOF 12 00880C GOTO END 00890C*----------------------------------------------------------------- 00900C TAG20 TAG 00910C* PROCESS BEGSR OR TAG STATEMENT 00920C SETOF 01 00930C EXSR SR10 PUT REC 00940C MOVEAREC,18 W6A 00950C EXSR SR11 PUT DEBUG 00960C*----------------------------------------------------------------- 00970C END TAG 00980C 86 SETON LR 00990CLRN68 01000COR 69 GOTO END ÐÐ01010CLR SETON 14 01020CLR EXCPT 01030CLR SETOF 14 01040C********************************************************************** 01050CSR SR10 BEGSR 01060C* PUT REC TO EDPOUT 01070CSR SETON 10 01080CSR EXCPT 01090CSR SETOF 10 01100CSR ENDSR 01110C****************************************************************** 01120CSR SR11 BEGSR 01130C* PUT DEBUG STMT TO EDPOUT 01140CSR SETON 11 01150CSR EXCPT 01160CSR SETOF 11 01170CSR ENDSR 01180O******************************************************************* 01190ORPGCONT D 02 01200O ZERO5 5 01210OEDPOUT D 01 01220O REC 80 01230O E 10 01240O REC 80 01250O E 11 ÐÐ01260O REC,7 7 01270O REC,8 8 01280O 6 'C' 01290O 11 'U8' 01300O 18 '''' 01310O W6A 24 01320O 25 '''' 01330O 32 'DEBUG' 01340O 37 'PRINT' 01350O 67 '********' 01360O E 13 01370O 6 'F' 01380O 11 'PRINT' 01390O 15 'O' 01400O 19 'F' 01410O 27 '132' 01420O 46 'PRINTER' 01430O E 14 01440O 6 'O' 01450O 11 'PRINT' 01460O 15 'D' 01470O 28 'LRNLR' /* 01480_‚ ÐÐ_‚_‚0O REC,7 7 01270O REC,8 8 01280O 6 'C' 01290O 11 'U8' 01300O 18 '''' 01310O W6A 24 01320O 25 '''' 01330O 32 'DEBUG' 01340O 37 'PRINT' 01350O 67 '********' 01360O E 13 01370O 6 'F' 01380O 11 'PRINT' 01390O 15 'O' 01400O 19 'F' 01410O 27 '132' 01420O 46 'PRINTER' 01430O E 14 01440O 6 'O' 01450O 11 'PRINT' 01460O 15 'D' 01470O 28 'LRNLR' /* 01480_‚ ÐÈ(Â+0 ¼X016RM P120282120282(èÈÐ00010H Q016RM00020F* PRINT SHOP TRAVELLERS (SYSTEM PTR). (X016RM) 00030F* REVISED 10-02-81 4:55 PM. 00040FBITHEX IP F 256 DISK 00050FWOINPUT US F 32 27AI 1 DISK 00060FRMMAST ID F 140L15AI 1 DISK 00070FREXTPTR ID F 25L21AI 1 DISK 00080FREXTFILEIC F 90R DISK 00090FPMMST2 IC F 674R12AI 1 DISK 00100FWCMAST IC F 960R 8AI 1 DISK 00110FPRINT O F 132 PRINTER 00120FTERM80 O F 80 5 00130E******************************************************************** 00140E BIT 256 1 00150E TXT 60 1 00160E REC 132 1 00170I******************************************************************** 00180IBITHEX BT 00190I 1 256 BIT 00200I******************************************************************** 00210IWOINPUT WI 01 00220I* WORK ORDER INPUT FILE. 00230I* PART # 12A 00240I 1 12 WIPN 00250I* DUE DATE 6N ÐÐ00260I 13 180WIDUE 00270I* WORK ORDER # 6N 00280I 19 24 WIORD 00290I* SPLIT # 3N 00300I 25 270WISPLT 00310I* QTY 7P 00320I P 28 310WIQTY 00330I* STATUS CODE 1A 00340I 32 32 WISTAT 00350I******************************************************************** 00360IRMMAST RM 00370I* ROUTING MASTER. 00380I* KEY AREA. 00390I* PART # 12A 00400I 1 12 RMPN 00410I* OPER SEQ # 3N 00420I 13 150RMSEQ 00430I 1 15 RMKEY 00440I* OPER GROUP CODE 2A 00450I 16 17 RMGRUP 00460I* OVERLAP % .2N 00470I 18 192RMOVLP 00480I* OPER CODE 5A 00490I 20 24 RMOPER 00500I* OPER DEPT. ÐÐ00510I* DEPT # 5P 00520I P 25 270RMDEPT 00530I* WORK CENTER 3P 00540I P 28 290RMWC 00550I* OPER DESCRIPTION 40A 00560I 30 69 RMDESC 00570I* LABOR STDS. 00580I* ACCOUNTING STD. 00590I* DATE ADOPTED 7P 00600I P 70 730RMADAT 00610I* SET-UP 9.3P 00620I P 74 783RMASU 00630I* RUN 9.3P 00640I P 79 833RMARUN 00650I* MIN CHARGE 7.2P 00660I P 84 872RMAMIN 00670I* STD LOT SIZE 7P 00680I P 88 910RMALOT 00690I* REVISED STDS. 00700I* DATE LAST REVISED 7P 00710I P 92 950RMRDAT 00720I* SET-UP 9.3P 00730I P 96 1003RMRSU 00740I* RUN 9.3P 00750I P 101 1053RMRRUN ÐÐ00760I* MIN. CHARGE 7.2P 00770I P 106 1092RMRMIN 00780I* STD LOT SIZE 7P 00790I P 110 1130RMRLOT 00800I* METHOD ESTAB 1A 00810I 114 114 RMMETH 00820I* JOB SKILL 5A 00830I 115 119 RMSKIL 00840I* PERFORM FACTOR. 00850I* ACTUAL 5.2P 00860I P 120 1222RMPER 00870I* ASSIGNED 5.2P 00880I P 123 1252RMPER2 00890I* NUMB LOTS RUN 5P 00900I P 126 1280RMLRUN 00910I* NUMB UNITS RUN 5P 00920I P 129 1310RMQRUN 00930I* FILLER 132 139 FFFFFF 00940I* RECORD STATUS 1A 00950I 140 140 RMSTAT 00960I******************************************************************** 00970IREXTPTR TP 00980I* TEXT POINTER FILE. 00990I* TEXT KEY 15A 01000I 1 15 TPKEY ÐÐ01010I 1 12 TPPN 01020I 13 150TPSEQ 01030I* LINE # 6N 01040I 16 210TPLINE 01050I* POINTER 7P 01060I P 22 250TPPTR 61 01070I******************************************************************** 01080IREXTFILETX 01090I* REXTFILE RECORD. 01100I* KEY 15A 01110I 1 15 TXKEY 01120I* LINE # 6N 01130I 16 210TXLINE 01140I* TEXT 1A X 60 01150I 22 81 TXT 01160I* BACKWARD PTR (DELETE) 7P 01170I P 82 850TXBPTR 01180I* RECORD STATUS 1A 01190I 90 90 TXSTAT 01200I******************************************************************** 01210IPMMST2 PM 01220I 15 180PMPL 01230I 19 30 PMMODL 01240I 31 59 PMDESC 01250I 70 71 PMREV ÐÐ01260I 496 500 PMMCN 01270I 674 674 PMSTAT 01280I******************************************************************** 01290IWCMAST WC 01300I 9 37 WCNAME 01310C******************************************************************** 01320C* INITIALIZE. 01330C H8 GOTO END 01340C N79 EXSR SR101 INIT. 01350C* BYPASS BITHEX FILE 01360C N01 GOTO END NOT WOINPUT FILE 01370C* BYPASS ALREADY DONE. 01380C WISTAT COMP 'D' 54 01390C 54 SETOF 01 01400C 54 GOTO END 01410C MOVELWIPN NUMPN 100 01420C MOVELWIPN W15A 15 01430C Z-ADD0 EGAP 01440C*------------------------------------------------------------------- 01450C TAG100 TAG 01460C* GET ROUTING MAST/TEXT AND PRINT. 01470C EXSR SR102 PRINT OPER. 01480C*------------------------------------------------------------------- 01490C END TAG 01500CLR EXSR SR81 TOP OF FORM ÐÐ01510C******************************************************************** 01520CSR SR71 BEGSR 01530C* SKIP NEW PAGE. 01540CSR 1 ADD EGAP EGAP 20 01550CSR Z-ADD13 LINE 30 01560CSR EXSR SR81 SKIP PAGE. 01570CSR Z-ADD0 X 30 01580C*--------------------------------------------------------------- 01590CSR T71A TAG 01600CSR 1 ADD X X 01610CSR X COMP 12 54 01620CSR 54 GOTO END71 01630CSR X COMP 1 41 01640CSR X COMP 3 43 01650CSR X COMP 4 44 01660CSR X COMP 5 45 01670CSR X COMP 6 46 01680CSR X COMP 7 47 01690CSR X COMP 8 48 01700CSR X COMP 9 49 01710CSR X COMP 10 50 01720CSR X COMP 11 51 01730CSR X COMP 12 52 01740CSR 41 01750COR 45 ÐÐ01760COR 49 GOTO T71B 01770CSR 41 01780COR 43 01790COR 44 01800COR 45 01810COR 46 01820COR 47 01830COR 48 01840COR 49 01850COR 50 01860COR 51 01870COR 52 EXSR SR72 PUT HEADING 01880CSR GOTO T71A 01890C*------------------------------------------------------------- 01900CSR T71B TAG 01910CSR EXSR SR82 LINE FEED 01920CSR GOTO T71A 01930CSR END71 ENDSR 01940C******************************************************************** 01950CSR SR72 BEGSR 01960C* PUT LINE TO PRINTER. 01970CSR SETON 83 01980CSR EXCPT 01990CSR SETOF 83 02000C*------------------------------------------------------------------- ÐÐ02010CSR END72 TAG 02020CSR SETOF 717273 02030CSR SETOF 444647 02040CSR SETOF 485051 02050CSR SETOF 527573 02060CSR SETOF 7441 02070CSR SETOF 424549 02080CSR SETOF 53 02090CSR ENDSR 02100C******************************************************************** 02110CSR SR81 BEGSR 02120C* TOP OF FORM. 02130CSR SETON 81 02140CSR EXCPT 02150CSR SETOF 81 02160CSR ENDSR 02170C******************************************************************** 02180CSR SR82 BEGSR 02190C* LINE FEED. 02200CSR SETON 82 02210CSR EXCPT 02220CSR SETOF 82 02230CSR ENDSR 02240C******************************************************************** 02250CSR SR101 BEGSR ÐÐ02260C* 1-TIME INITIALIZE. 02270CSR SETON 79 02280CSR MOVELBIT,1 NULLGT 2 NULL LGTH 02290CSR MOVE BIT,6 NULLGT 02300CSR MOVE ' ' BLK60 60 02310CSR MOVE ' ' W8A 8 02320CSR Z-ADD0 W2N 20 02330CSR Z-ADD0 W1N 10 02340CSR MOVE ' ' W2A 2 02350CSR MOVE ' ' REC 02360CSR EXITFQBELL RING BELL 02370CSR EXITFQBELL 02380CSR EXITFQBELL 02390CSR EXITFQBELL 02400CSR EXITFQBELL 02410CSR SETON 84 02420CSR EXCPT 02430CSR SETOF 84 02440CSR EXITFQPAUSE 02450CSR END101 ENDSR 02460C******************************************************************** 02470CSR SR102 BEGSR 02480C* PRINT TRAVELER. 02490C* GET PART MASTER. 02500CSR WIPN CHAINPMMST2 60 ÐÐ02510CSRN60 PMSTAT COMP 'D' 60 02520CSR 60 Z-ADD291 M 50 96 02530C* PRINT HEADING. 02540CSR EXSR SR71 02550CSR MOVELWIPN W15A 15 02560CSR W15A SETLLRMMAST 02570C*------------------------------------------------------------------- 02580CSR T102A TAG 02590C* GET ROUTING OPER. 02600CSR SETOF 54 02610CSR READ RMMAST 54 02620CSR 54 GOTO T102W END FILE. 02630CSR WIPN COMP RMPN 54 02640CSRN54 GOTO T102W 02650CSR MOVELRMDEPT W8N 80 02660CSR MOVE RMWC W8N 02670CSR W8N CHAINWCMAST 54 02680CSRN54 MOVELWCNAME DEPNAM 16 02690CSR 54 MOVE BLK60 DEPNAM 02700C* PRINT ROUTING OPER. 02710CSR SETON 75 02720CSR EXSR SR72 SKIP LINE 02730CSR SETOF 75 02740CSR SETON 72 02750CSR EXSR SR72 PRINT OPER. ÐÐ02760CSR SETOF 72 02770CSR 2 ADD LINE LINE 02780CSR LINE COMP 50 54 02790CSR 54 EXSR SR71 SKIP PAGE. 02800CSR MOVELRMKEY W21A 21 02810CSR W21A SETLLREXTPTR 02820C*------------------------------------------------------------------- 02830CSR T102B TAG 02840C* PRINT TEXT. 02850CSR SETOF 54 02860CSR READ REXTPTR 54 02870CSR 54 GOTO T102A 02880CSR TPPN COMP RMPN 54 02890CSR 54 TPSEQ COMP RMSEQ 54 02900CSRN54 GOTO T102A 02910CSR TPPTR COMP 0 54 02920CSRN54 GOTO T102B INACTIVE PTR 02930CSR TPPTR CHAINREXTFILE H8 02940CSR H8 GOTO END102 02950CSR SETON 73 02960CSR EXSR SR72 PRINT TEXT. 02970CSR SETOF 73 02980CSR 1 ADD LINE LINE 02990CSR LINE COMP 55 54 PAGE LGTH. 03000CSR 54 EXSR SR71 SKIP PAGE. ÐÐ03010CSR GOTO T102B 03020C*------------------------------------------------------------------- 03030CSR T102W TAG 03040C* PRINT END TRAVELER LEGEND. 03050CSR EXSR SR82 LINE FEED. 03060CSR SETON 74 03070CSR EXSR SR72 END TRAV MSG. 03080CSR SETOF 74 03090CSR END102 ENDSR 03100O******************************************************************** 03110OWOINPUT D 01 03120O 32 'D' 03130O******************************************************************** 03140OPRINT E 43 83 03150O 4 'PAGE' 03160O EGAP Z 7 03170O UDATE Y 18 03180O 38 'W O R K -' 03190O 50 'O R D E R -' 03200O 66 'T R A V E L E R' 03210O 86 'WORK' 03220O*------------------------------------------------------------------- 03230O E 44 83 03240O 88 'ORDER#' 03250O WIORD 95 ÐÐ03260O*------------------------------------------------------------------- 03270O E 46 83 03280O 13 'PART NO.' 03290O 18 ':' 03300O NUMPN 32 ' - - ' 03310O 78 'QUANTITY :' 03320O WIQTY 2 86 03330O*------------------------------------------------------------------- 03340O E 47 83 03350O 16 'DESCRIPTION' 03360O 18 ':' 03370O PMDESC 49 03380O 75 'DATE DUE' 03390O 78 ':' 03400O WIDUE 87 ' - - ' 03410O*------------------------------------------------------------------- 03420O E 48 83 03430O 14 'MODEL NO.' 03440O 18 ':' 03450O PMMODL 32 03460O 38 'MCN=' 03470O PMMCN 43 03480O 76 'PROD-LINE' 03490O 78 ':' 03500O PMPL 87 ' - - - ' ÐÐ03510O 96 'REV' 03520O PMREV 99 03530O*------------------------------------------------------------------- 03540O E 50 83 03550O 10 'OPER*' 03560O 24 '---D E P A R T' 03570O 36 'M E N T---*' 03580O 57 '- - - - - - - - - - -' 03590O 78 'D E S C R I P T I O N' 03600O 99 '- - - - - - - - - - -' 03610O*------------------------------------------------------------------- 03620O E 51 83 03630O 8 'SEQ' 03640O 10 '*' 03650O 14 'NUMB' 03660O 20 'W.C.' 03670O 26 'NAME' 03680O 36 '*' 03690O*------------------------------------------------------------------- 03700O E 52 83 03710O 10 '*' 03720O 36 '*' 03730O*------------------------------------------------------------------ 03740O E 75 83 03750O 10 '*' ÐÐ03760O 36 '*' 03770O*------------------------------------------------------------------- 03780O E 72 83 03790O RMSEQ Z 8 03800O RMDEPTZ 15 03810O RMWC Z 19 03820O 54 16 '-' 03830O DEPNAM 36 03840O 10 '*' 03850O 36 '*' 03860O RMDESC 77 03870O*------------------------------------------------------------------- 03880O E 73 83 03890O TXT 97 03900O 10 '*' 03910O 36 '*' 03920O*------------------------------------------------------------------- 03930O E 74 83 03940O 17 'END TRAVELER' 03950O*------------------------------------------------------------------- 03960O E 0001 81 03970O 1 ' ' 03980O*------------------------------------------------------------------- 03990O E 82 04000O 1 ' ' ÐÐ04010O******************************************************************** 04020OTERM80 E 84 04030O 18 'SET PRINTER 6-LPI' /* 004040_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(+í X023WM P999999120282(èÈÐ00010H Q023WM00020F* PULL SHEET STOCK ISSUE (X023WM) 00030F* REVISED 1-11-82 10:00 AM. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FWMPULL UC F 46R12AI 1 DISK 00090FPULLFILEUC F 64R17AI 1 DISK A 00100FPMMST2 UC F 674R12AI 1 DISK 00110FWMISSUE UC F 60R21AI 1 DISK A 00120FWUKEY UC F 22R21AI 1 DISK A 00130FSFPNA O F 10 DISK A 00140FTERM132 O F 132 5 00150F**************************************************************** 00160E NUL 1 132 1 NULL CHAR 00170E A16 16 16 1 A INPUT DATA ARRAY 00180E NUM 1 5 3 0 NUMERIC FIELD NO.'S 00190E DUN 6 6 1 A EDIT CMPLT FLAG 00200E MES 1 1 30 00210E LOC 1 6 3 00220E DIV 1 66 2 00230E A9 9 9 1 00240E BIT 33 1 SCREEN CONTR. CHAR 00250I******************************************************************* ÐÐ00260IBITTAB BT 00270I 1 33 BIT 00280I******************************************************************* 00290IMGFILE MG 00300I* MESSAGE FILE. 00310I 1 35 MGTEXT 00320I****************************************************************** 00330ICRTFILE CR 00340I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00350I* STD AREA - SAME FOR ALL PROGRAMS. 00360I* EMPLOYEE # 5N 00370I 1 50CREMPL 00380I* USER CODE 8A 00390I 6 13 CRUSER 00400I* DEPT # 5N 00410I 14 180CRDEPT 00420I* JOB NAME 8A (JOB LOADED BY MENU) 00430I 19 26 CRJOB 00440I* SHUTDOWN FLAG 1A 00450I* BLANK = NO SHUTDOWN 00460I 27 27 CRSHUT 00470I* TIME STARTED 6N 00480I 28 330CRTIME 00490I* DATE STARTED 4N 00500I 34 370CRDATE ÐÐ00510I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00520I 68 73 CRRET 00530I* MENU NAME 6A 00540I 74 79 CRMENU 00550I******************************************************************** 00560IWMPULL WP 00570I* WORK ORDER PULL FILE- 1 REC FOR EACH ACTIVE PULL 00580I* KEY AREA 00590I* WORK ORDER 9A 00600I 1 9 WPWO 00610I 1 6 WPWOP 00620I 7 9 WPWOD 00630I* PULL NO. 3N 00640I 10 120WPPULL 00650I 1 12 WPKEY 00660I* ASSY PART NO. 10N 00670I 13 220WPPN 00680I* START DATE 6N 00690I 23 280WPSTRT 00700I* DUE DATE 6N 00710I 29 340WPDUE 00720I* PULL QTY 7P 00730I P 35 380WPQTY 00740I* PULL CODE 1A 00750I* Y = TO BE PRINTED ÐÐ00760I* D = PRINTING DONE 00770I* P = PULLED 00780I 39 39 WPPC 00790I* TRAVELER CODE 1A 00800I* Y = TRAVELER REQUIRED 00810I 40 40 WPTRAV 00820I* LAST USED ITEM 5P 00830I P 41 430WPLITM 00840I* RECORD STATUS 1A 00850I 46 46 WPSTAT 00860I****************************************************************** 00870IPULLFILEPF 00880I* PULL ITEM FILE- 1 RECORD FOR EA COMPONENT 00890I* KEY AREA 00900I* WORK ORDER 9A 00910I 1 9 PFWO 00920I 1 6 PFWOP 00930I 7 9 PFWOD 00940I* PULL NO. 3N 00950I 10 120PFPULL 00960I* ITEM NO. 5N 00970I 13 170PFITEM 00980I 1 17 PFKEY 00990I* STOCK LOCATION 6A 01000I 18 23 PFLOC ÐÐ01010I* COMPONENT PART NO. 10N 01020I 24 330PFCPN 01030I* ASSY PART NO. 10N 01040I 34 430PFAPN 01050I* QTY REQD 7P 01060I P 44 470PFQTYR 01070I* QTY ISSUED 7P 01080I P 48 510PFQTYC 01090I* QTY SUBSTITUTED 7P 01100I P 52 550PFQTYS 01110I* QTY PER ASSY 7P 01120I P 56 590PFQPA 01130I* ITEM SUBST FOR 5P 01140I P 60 620PFSUB 01150I* RECORD STATUS 1A 01160I* D = DELETED 01170I* S = ISSUED AS SUBSTITUTE (SEE PFSUB) 01180I* B = REGULAR ISSUE 01190I 64 64 PFSTAT 01200I************************************************************** 01210IPMMST2 PM 01220I 1 100PMPN 01230I 19 30 PMMODL 01240I 31 59 PMDESC 01250I 621 626 PMSLOC ÐÐ01260I P 311 3140PMOHB 01270I P 363 3660PMPISS 01280I P 379 3820PMUISS 01290I P 398 4000PMFISS 01300I P 410 4120PMQISS 01310I P 322 3240PMFBO 01320I 674 674 PMSTAT 01330I****************************************************************** 01340IWMISSUE WU 01350I P 22 250WUPCM 01360I P 26 290WUUCM 01370I P 30 330WURCM 01380I P 34 370WUSCM 01390I P 38 410WUPTOT 01400I P 42 450WUUTOT 01410I P 46 490WURTOT 01420I P 50 530WUSTOT 01430I P 56 590WUREQD 01440I 60 60 WUSTAT 01450I******************************************************************* 01460IWUKEY WK 01470I* WMISSUE ALT KEY FILE 01480I 1 11 WKORD 01490I 12 21 WKPN 01500I 22 22 WKSTAT ÐÐ01510C********************************************************************** 01520C* INITIALIZE 01530C EXSR SR101 1-TIME INIT 01540C EXSR SR70 NEW PAGE 01550C*------------------------------------------------------------------ 01560C START TAG 01570C* SET-UP 1ST FIELD NO. 01580C SETOF 4170 01590C MOVE BLK35 TWO 01600C MOVE ' ' TWOP 01610C Z-ADD0 TWOD 01620C Z-ADD0 TPULL 01630C Z-ADD0 TSUBPN 01640C EXSR SR205 INIT PULLFILE 01650C MOVE BLK35 PMDESC 01660C Z-ADD0 QTYDUN 01670C Z-ADD0 QTYBO 01680C MOVE BLK35 DESCWP 01690C MOVE BLK16 MODLWP 01700C MOVE ' ' DUN INIT EDIT ARRAY 01710C Z-ADD1 F 30 FIELD # 01720C GOTO READ 01730C*------------------------------------------------------------------ 01740C NEXT TAG 01750C* SET-UP NEXT FIELD NO. ÐÐ01760C 1 ADD F F FIELD # 01770C*----------------------------------------------------------------- 01780C READ TAG 01790C* READ DATA FROM TERMINAL. 01800C SETOF 909677 01810C DUN,3 COMP ' ' 54 01820C F COMP 3 55 01830C N54 55 Z-ADD3 F 01840C EXSR SR102 VALIDATE FIELD # 01850C 55 GOTO UPDATE DONE 01860C EXSR SR201 IDENTIFY-F 01870C N01N02N41 EXSR SR71 PUT HEADINGS 01880C N01N02 SETON 41 01890C SETON 69 01900C EXSR SR72 PROMPT 01910C SETOF 69 01920C 04N70 GOTO NEXT PN FIELD,NOT SUBST. 01930C 06 70 GOTO NEXT QTY BO, IS SUBST. 01940C EXSR SR75 READ TERMINAL 01950C 98 GOTO GOODBY GOODBY 01960C 94 GOTO MENU MENU REQUEST 01970C 90 EXSR SR72 REWRITE INPUT DATA 01980C 93 GOTO NEWITM NEW ITEM 01990C 92 GOTO JUMP FIELD JUMP REQST 02000C 89 F SUB 1 F SKIP BACKWARD ÐÐ02010C 89N70 05F SUB 1 F SKIP BACKWARD 02020C 89 GOTO READ " " 02030C 88 SETOF 90 SPACE FILL 02040C 88 SETON 77 " " 02050C 86 GOTO UPDATE UPDATE 02060C 96 GOTO ERROR ERROR 02070C N77 GOTO EDIT NO DATA INPUT 02080C*------------------------------------------------------------------ 02090C PROCES TAG 02100C* PROCESS INPUT DATA 02110C EXSR SR103 MOVE DATA 02120C 96 GOTO ERROR 02130C*------------------------------------------------------------------- 02140C EDIT TAG 02150C EXSR SR104 EDIT DATA 02160C EXSR SR72 REWRITE DATA 02170C 96 GOTO ERROR ERROR 02180C GOTO NEXT 02190C*------------------------------------------------------------------ 02200C UPDATE TAG 02210C* UPDATE DATA BASE. 02220C EXSR SR105 FINAL EDIT 02230C 96 GOTO ERROR ERROR 02240C Z-ADDTITEM SAVITM 50 02250C EXSR SR106 UPDATE ÐÐ02260C Z-ADDSAVITM TITEM 02270C 96 GOTO ERROR ERROR 02280C 2 ADD COUNT COUNT 02290C COUNT COMP 117 54 02300C 54 EXSR SR70 NEW PAGE 02310C 54 EXSR SR71 PUT HEADING 02320C Z-ADD3 F 02330C 1 ADD TITEM TITEM 02340C MOVE WPKEY W17A 17 02350C MOVE TITEM W17A 02360C EXSR SR80 GET NEXT ITEM 02370C 30 02380COR 31 02390COR 32 Z-ADD0 TITEM 02400C Z-ADD0 TISSU 02410C Z-ADD0 TBOQ 02420C Z-ADD0 TSUBPN 02430C MOVE BLK35 PMDESC 02440C Z-ADD0 QTYDUN 02450C Z-ADD0 QTYBO 02460C Z-ADD0 PFQTYR 02470C Z-ADD0 PFQTYC 02480C Z-ADD0 PFQTYS 02490C Z-ADD0 PFCPN 02500C Z-ADD0 PFQPA ÐÐ02510C SETOF 70 02520C EXSR SR78 PUT DIVIDER 02530C GOTO READ 02540C*------------------------------------------------------------------ 02550C JUMP TAG 02560C* SET-UP JUMP TO REQUESTED FIELD 02570C 1 ADD W W 30 02580C W COMP 16 54 02590C 54 Z-ADD318 M 50 96 FLAG ERROR 02600C 54 GOTO ERROR BAD ESC 02610C MOVE ' ' W3A 3 02620C MOVEAA16,W W3A 02630C Z-ADD3 W2N 20 02640C EXIT SUBRAJ R. JUSTIFY 02650C RLABL W2N 02660C RLABL W3A 02670C MOVE W3A F NEW FIELD # 02680C GOTO READ 02690C*-------------------------------------------------------------------- 02700C ERROR TAG 02710C EXSR SR102 VALIDATE FIELD # 02720C EXSR SR89 GET MSG 02730C GOTO READ 02740C*------------------------------------------------------------------ 02750C NEWITM TAG ÐÐ02760C* SET-UP LINK FOR NEW ITEM 02770C MOVEL'Q023WM' PROG 8 02780C GOTO END 02790C*------------------------------------------------------------------- 02800C MENU TAG 02810C* SET-UP LINK TO MENU 02820C MOVELCRMENU CRRET 02830C GOTO END 02840C*-------------------------------------------------------------------- 02850C GOODBY TAG 02860C* LINK TO SIGN-OFF 02870C MOVEL'GOODBY' CRRET 02880C GOTO END 02890C*------------------------------------------------------------------- 02900C END TAG 02910C SETON 97 02920C EXCPT UPDATE CRTFILE 02930C SETOF 97 02940C PROG COMP BLK8 54 02950C N54 MOVEL'Q033WM' PROG 02960C N54 SETON 80 02970C N54 EXCPT 2NDARY UPD 02980C SETOF 80 02990C EXITFCHAIN LINK TO NEXT PROG 03000C RLABL PROG ÐÐ03010C*------------------------------------------------------------------- 03020C ENDJOB TAG 03030C********************************************************************* 03040CSR SR2 BEGSR 03050C* EDIT PULL NO. 03060CSR TPULL COMP 0 54 03070CSRN54 Z-ADD631 M 50 96 FLAG ERROR 03080CSRN54 GOTO END2 03090CSR EXSR SR83 GET WMPULL FILE 03100CSR 60 Z-ADD632 M 96 FLAG ERROR 03110CSR 60 GOTO END2 03120CSR MOVELWPPN W12A 03130CSR EXSR SR84 GET PART MASTER 03140CSR 60 Z-ADD291 M 96 FLAG ERROR 03150CSR 60 GOTO END2 03160CSR MOVE PMDESC DESCWP 29 SAVE DESCRIPTION 03170CSR MOVE PMMODL MODLWP 12 SAVE MODEL # 03180C*--------------------------------------------------------------- 03190CSR END2 TAG 03200CSR 96 MOVE BLK35 DESCWP 03210CSR 96 MOVE BLK16 MODLWP 03220CSR MOVE BLK35 PMDESC 03230CSR MOVE BLK16 PMMODL 03240CSR ENDSR 03250C**************************************************************** ÐÐ03260CSR SR3 BEGSR 03270C* EDIT ITEM NO. 03280CSR TITEM COMP 0 54 03290CSRN54 Z-ADD1 TITEM DEFAULT 03300CSRN54 Z-ADD643 M FLAG WARNING 03310CSRN54 EXSR SR89 GET MSG 03320CSR MOVELWPKEY W17A 17 03330CSR MOVE TITEM W17A 03340CSR SETOF 55 03350CSR EXSR SR80 GET PULLFILE 03360CSR 30 NOT ON FILE 03370COR 31 DELETED 03380COR 32 GOTO T3Z SUBSTITUE 03390CSR MOVELPFCPN W12A 03400CSR EXSR SR84 GET PART MASTER 03410CSR GOTO END3 GOT IT 03420C*------------------------------------------------------------------- 03430CSR T3Z TAG 03440C* FLAG PFSTAT CODE ERRORS. 03450CSR 30 Z-ADD510 M 96 NOT ON FILE 03460CSR 32 Z-ADD645 M 96 SUBSTITUTION 03470CSR 31 Z-ADD644 M 96 PREV PROCESSED 03480CSR END3 ENDSR 03490C********************************************************************* 03500CSR SR4 BEGSR ÐÐ03510C* EDIT SUBSTITUTE PART NO. 03520CSRN70 GOTO END4 NOT SUBSTITUTE ISSUE 03530CSR TSUBPN COMP 0 54 03540CSRN54 Z-ADD299 M 96 FLAG ERROR 03550CSRN54 GOTO END4 03560CSR MOVELTSUBPN W12A 03570CSR EXSR SR84 GET PART MAST 03580CSR 60 Z-ADD291 M 96 FLAG ERROR 03590CSR END4 ENDSR 03600C******************************************************************* 03610CSR SR5 BEGSR 03620C* EDIT ISSUE QTY 03630CSR TISSU COMP 0 54 03640CSRN54 Z-ADD0 TISSU 03650CSRN54 70 Z-ADD184 M 96 FLAG ERROR 03660CSR ENDSR 03670C****************************************************************** 03680CSR SR6 BEGSR 03690C* EDIT INPUT QTYS 03700CSR TBOQ COMP 0 54 03710CSRN54 Z-ADD0 TBOQ 03720CSR TISSU ADD PFQTYC W7N 70 03730CSR PFQTYS ADD W7N W7N 03740CSRN70 TBOQ ADD W7N W7N 03750CSR W7N COMP PFQTYR 5454 ÐÐ03760CSRN54 Z-ADD633 M 96 FLAG ERROR 03770CSRN54 Z-ADD4 F 03780CSR ENDSR 03790C******************************************************************** 03800CSR SR40 BEGSR 03810C* UPDATE WMPULL. 03820CSR SETON 40 03830CSR EXCPT UPDATE WMPULL 03840CSR SETOF 40 03850CSR EXSR SR83 GET WMPULL 03860CSR ENDSR 03870C***************************************************************** 03880CSR SR45 BEGSR 03890CSR W21A CHAINWMISSUE 60 GET WMISSUE 03900CSR ENDSR 03910C******************************************************************* 03920CSR SR46 BEGSR 03930CSR SETON 46 03940CSR EXCPT UPDATE WMISSUE 03950CSR SETOF 46 03960CSR MOVE W21A W11A 11 03970CSR MOVELW21A W10A 10 03980CSR MOVE W10A W21AA 21 03990CSR MOVELW11A W21AA 04000CSR W21AA CHAINWUKEY 60 ÐÐ04010CSR SETON 84 04020CSR EXCPT UPDATE WUKEY FILE 04030CSR SETOF 84 04040CSR ENDSR 04050C********************************************************************* 04060CSR SR68 BEGSR 04070CSR EXITFQCLF LF 04080CSR ENDSR 04090C*************************************************************** 04100CSR SR69 BEGSR 04110CSR EXITFQXYPOS MOVE CURSOR 04120CSR RLABL W6A 04130CSR ENDSR 04140C***************************************************************** 04150CSR SR70 BEGSR 04160C* CLEAR TERM SCREEN. 04170CSR EXITFZCPAGE CLEAR PAGE 4 04180CSR Z-ADD91 COUNT 30 CRT LINE NO. 04190CSR ENDSR 04200C********************************************************************** 04210CSR SR71 BEGSR 04220C* PUT HEADINGS TO TERMINAL 04230CSR EXSR SR207 SET OUTPUT INDICATORS04240CSR EXSR SR209 SET PULL STATUS IND. 04250CSR SETON 71 ÐÐ04260CSR EXCPT PUT HEADINGS 04270CSR SETOF 71 04280CSR Z-ADD101 COUNT 30 04290CSR EXSR SR78 PUT DIVIDER 04300CSR ENDSR 04310C********************************************************************* 04320CSR SR72 BEGSR 04330C* PUT DATA TO TERMINAL 04340CSR TISSU ADD PFQTYC QTYDUN 70 04350CSR PFQTYS ADD QTYDUN QTYDUN 04360CSR PFQTYR SUB QTYDUN QTYBO 70 04370CSR EXSR SR207 SET OUTPUT INDICATORS04380CSRN01N02 COUNT SUB 1 W3N 30 04390CSRN01N02 MOVELW3N W6A 6 04400CSRN01N02 MOVE '001' W6A 04410CSRN01N02 EXSR SR69 MOVE CURSOR 04420CSR SETON 72 04430CSR EXCPT PUT DATA 04440CSR SETOF 72 04450CSR ENDSR 04460C******************************************************************* 04470CSR SR75 BEGSR 04480C* READ FROM TERMINAL 04490CSR SETOF 779096 04500CSR SETOF 9392 ÐÐ04510CSR SETOF 8988 04520CSR SETOF 86 04530CSRN01N02 MOVE COUNT W3A 04540CSR 01 04550COR 02 MOVE '091' W3A 04560CSR MOVE BIT,28 A9,1 04570CSR MOVE '8' A9,2 04580CSR MOVEAW3A A9,3 04590CSR MOVEALOC,F A9,6 04600CSR MOVE BIT,8 A9,9 04610CSR MOVEAA9 W9A 9 04620CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 04630CSR MOVE BLK16 W16A 16 BUFFER 04640CSR EXITFQPREED READ FROM TERMINAL 04650CSR RLABL W9A 04660CSR RLABL W16A READ BUFFER 04670CSR RLABL BUFLGT READ BUFFER LGTH 04680CSR MOVEAW16A A16 INPUT DATA ARRAY 04690CSR MOVE BLK16 W16A INIT INPUT ARRAY 04700CSR Z-ADD1 W 30 04710CSR '\' LOKUPA16,W 90 FLAG ESC 04720CSRN90 GOTO T75B NOT ESC 04730CSR 1 ADD W W 04740CSR W COMP 16 54 04750CSR 54 GOTO T75A BAD ESC ÐÐ04760CSR A16,W COMP 'G' 98 GOODBY 04770CSR A16,W COMP 'E' 94 MENU 04780CSR A16,W COMP 'N' 93 NEW ITEM 04790CSRN93 A16,W COMP 'D' 93 DONE 04800CSR A16,W COMP 'J' 92 JUMP 04810CSR A16,W COMP 'B' 89 SKIP BKWRD 04820CSR A16,W COMP 'S' 88 SPACE FILL 04830CSR A16,W COMP 'U' 86 UPDATE 04840CSR 98 04850COR 94 04860COR 93 04870COR 92 04880COR 89 04890COR 88 04900COR 86 GOTO END75 GOOD ESC 04910C*------------------------------------------------------------------ 04920CSR T75A TAG 04930C* FLAG BAD ESC INPUT 04940CSR Z-ADD318 M 96 FLAG ERROR 04950CSR GOTO END75 04960C*-------------------------------------------------------------------- 04970CSR T75B TAG 04980C* MOVE DATA 04990CSR Z-ADD1 W 05000CSR ' ' LOKUPA16,W 77 ÐÐ05010CSR 77 MOVEAA16,W W16A INPUT DATA 05020C*-------------------------------------------------------------------- 05030CSR END75 TAG 05040C* INIT PREV ERROR MSG. 05050CSR MOVE BLK35 MGTEXT 05060CSR ENDSR 05070C******************************************************************* 05080CSR SR78 BEGSR 05090C* PUT DIVIDER. 05100CSR SETON 78 05110CSR EXCPT 05120CSR SETOF 78 05130CSR 1 ADD COUNT COUNT 05140CSR ENDSR 05150C********************************************************************** 05160CSR SR80 BEGSR 05170C* GET PULLFILE RECORD 05180CSR SETOF 3132 05190CSR W17A CHAINPULLFILE 30 GET PULLFILE 05200CSRN30 PFSTAT COMP 'D' 31 FLAG DELETE 05210CSRN30 PFSTAT COMP 'S' 32 FLAG SUBSTITUTION 05220CSR ENDSR 05230C********************************************************************** 05240CSR SR81 BEGSR 05250C* ADD NEW PULLFILE RECORD ÐÐ05260CSR SETON 81 05270CSR EXCPT ADD PULLFILE 05280CSR SETOF 81 05290CSR ENDSR 05300C*********************************************************************** 05310CSR SR82 BEGSR 05320C* REWRITE PULLFILE RECORD. 05330CSR SETON 82 05340CSR EXCPT REWRITE PULLFILE 05350CSR SETOF 82 05360CSR ENDSR 05370C******************************************************************** 05380CSR SR83 BEGSR 05390C* GET WMPULL FILE. 05400CSR MOVELTWO W12A 12 05410CSR MOVE TPULL W12A 05420CSR W12A CHAINWMPULL 60 GET WMPULL 05430CSR ENDSR 05440C******************************************************************** 05450CSR SR84 BEGSR 05460C* GET PART MAST. 05470CSR MOVE ' ' W12A 05480CSR W12A CHAINPMMST2 60 GET PMMST2 05490CSRN60 PMSTAT COMP 'D' 60 05500CSR ENDSR ÐÐ05510C**************************************************************** 05520CSR SR85 BEGSR 05530CSR SETON 85 05540CSR EXCPT UPDATE PART MASTER 05550CSR SETOF 85 05560CSR ENDSR 05570C********************************************************************** 05580CSR SR89 BEGSR 05590C* GET MESSAGE MASTER 05600CSR M CHAINMGFILE 54 05610CSR 54 MOVE BLK35 MGTEXT 05620CSR 54 MOVELM MGTEXT 05630CSR 54 MOVE MES,1 MGTEXT 05640CSR ENDSR 05650C*********************************************************************** 05660CSR SR101 BEGSR 05670C* 1-TIME INITIALIZE 05680CSR MOVE BIT,1 NUL 05690CSR MOVEL'-' DIV 05700CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05710CSR Z-ADD6 FLIMIT 30 TOTAL NUMB FIELDS 05720CSR MOVE ' ' BLK16 16 05730C* GET PORT # AND CRTFILE 05740CSR MOVE ' ' W8A 8 05750CSR Z-ADD0 W2N 20 ÐÐ05760CSR Z-ADD0 W1N 10 05770CSR MOVE ' ' W2A 2 05780CSR EXITFPGMINX GET PORT # 05790CSR RLABL W8A 05800CSR RLABL W2N 05810CSR RLABL W1N 05820CSR RLABL W2A 05830CSR MOVE W2A PORT 20 PORT NO. 05840CSR PORT COMP 0 54 05850CSRN54 Z-ADD25 PORT DEFAULT 05860CSR PORT CHAINCRTFILE H9 05870C* DEFINE WORK FIELDS,ETC. 05880CSR MOVE ' ' BLK35 35 05890CSR Z-ADD0 ZERO7 70 05900CSR MOVE ' ' BLK8 8 05910CSR ENDSR 05920C********************************************************************** 05930CSR SR102 BEGSR 05940C* VALIDATE FIELD NO. 05950CSR SETOF 55 05960CSR F COMP 0 54 05970CSRN54 Z-ADD1 F 05980CSR F COMP FLIMIT 55 05990CSR 55 Z-ADD1 F 06000CSR ENDSR ÐÐ06010C******************************************************************** 06020CSR SR103 BEGSR 06030C* MOVE INPUT DATA 06040CSR EXSR SR201 IDENTIFY-F 06050CSR EXSR SR202 R. JUSTIFY 06060CSR 01 EXSR SR210 BUILD WORK ORDER 06070CSR 02 MOVE W10A TPULL 30 PULL NUMBER 06080CSR 03 EXSR SR211 BUILD ITEM # 06090CSR 04 MOVE W10A TSUBPN 100 SUBSTITUTE PART NO. 06100CSR 05 MOVE W10A TISSU 70 ISSUE QTY 06110CSR 06 MOVE W10A TBOQ 70 BACKORDER QTY 06120CSR MOVE ' ' DUN,F EDIT FLAG 06130CSR ENDSR 06140C******************************************************************** 06150CSR SR104 BEGSR 06160C* EDIT INPUT DATA 06170CSR 02 EXSR SR2 06180CSR 03 EXSR SR3 06190CSR 04 EXSR SR4 06200CSR 05 EXSR SR5 06210CSR 06 EXSR SR6 06220CSR 96 MOVE ' ' DUN,F EDIT FLAG 06230CSRN96 MOVE 'X' DUN,F 06240CSR ENDSR 06250C*********************************************************************** ÐÐ06260CSR SR105 BEGSR 06270C* FINAL EDIT 06280CSR SETOF 77 06290CSR SETON 79 FINAL EDIT FLAG 06300CSR Z-ADD1 F 96 06310C*-------------------------------------------------------------------- 06320CSR T105A TAG 06330CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06340CSRN54 GOTO END105 06350CSR EXSR SR201 IDENTIFY-F 06360CSR EXSR SR104 EDIT 06370CSRN96 GOTO T105A 06380C*-------------------------------------------------------------------- 06390CSR END105 TAG 06400CSR SETOF 79 06410CSR ENDSR 06420C******************************************************************** 06430CSR SR106 BEGSR 06440C* UPDATE SR. 06450CSR MOVELWPKEY W17A 17 06460CSR MOVE TITEM W17A 06470CSR EXSR SR80 GET PULLFILE 06480CSR 30 06490COR 31 SETON H4 PROG ERROR 06500CSR 30 NOT ON FILE ÐÐ06510COR 31 GOTO ENDJOB DELETED 06520CSR 70 GOTO T106B SUBSTITUTE ISSUE 06530C* PROCESS NON-SUBST. ISSUE. 06540CSR TISSU ADD PFQTYC PFQTYC QTY ISSUED 06550CSR PFQTYC ADD PFQTYS QTYDUN 70 QTY ISSUED OR SUBST. 06560CSR PFQTYR SUB QTYDUN QTYBO 70 54 06570CSRN54 Z-ADD0 QTYBO QTY BACKORDERED 06580CSR EXSR SR82 UPDATE PULLFILE 06590CSR MOVELPFCPN W12A 12 06600CSR EXSR SR84 GET PART MASTER 06610CSR 60 SETON H7 06620CSR 60 GOTO ENDJOB PROG ERROR 06630CSR PMOHB SUB TISSU PMOHB ON HAND STOCK BAL 06640CSR TISSU ADD PMPISS PMPISS PLAN ISSUE QTY HIST 06650CSR TISSU COMP 0 54 06660CSR 54 1 ADD PMFISS PMFISS PLAN ISSUE FREQ 06670CSR TBOQ COMP 0 54 06680CSR 54 1 ADD PMFBO PMFBO BACKORDER FREQ 06690CSR EXSR SR85 UPDATE PART MASTER 06700CSR TISSU COMP 0 54 06710CSRN54 GOTO END106 06720CSR MOVELPFCPN W21A 21 06730CSR MOVELTWO W11A 06740CSR MOVE '00' W11A 06750CSR MOVE W11A W21A ÐÐ06760CSR EXSR SR45 GET WMISSUE 06770CSR 60 EXSR SR206 INIT WMISSUE 06780CSR TISSU ADD WUPCM WUPCM PLAN ISSUE,CUR MO. 06790CSR TISSU ADD WUPTOT WUPTOT PLAN ISSUE,TOT. 06800CSR EXSR SR46 UPDATE WMISSUE 06810CSR GOTO END106 06820C*------------------------------------------------------------------- 06830CSR T106B TAG 06840C* PROCESS SUBSTITUTE ISSUE. 06850C* DO SUBSTITUTED-FOR PART # RECORDS. 06860CSR TISSU COMP 0 54 06870CSRN54 GOTO END106 06880CSR TISSU ADD PFQTYS PFQTYS QTY SUBSTITUTED 06890CSR PFQTYS ADD PFQTYC QTYDUN QTY ISSUED OR SUBST. 06900CSR PFQTYR SUB QTYDUN QTYBO 54 06910CSRN54 Z-ADD0 QTYBO QTY BACKORDERED 06920CSR EXSR SR82 UPDATE PULLFILE 06930CSR MOVELPFCPN W12A 06940CSR EXSR SR84 GET PART MASTER 06950CSR 60 SETON H6 PROG ERROR 06960CSR 60 GOTO ENDJOB 06970CSR TISSU ADD PMPISS PMPISS PLAN ISSUE 06980CSR TISSU COMP 0 54 06990CSR 54 1 ADD PMFISS PMFISS PLAN FREQ 07000CSR TBOQ COMP 0 54 ÐÐ07010CSR 54 1 ADD PMFBO PMFBO BO FREQ 07020CSR EXSR SR85 UPDATE PMMST2 07030CSR MOVELPFCPN W21A 07040CSR MOVELTWO W11A 07050CSR MOVE '00' W11A 07060CSR MOVE W11A W21A 07070CSR EXSR SR45 GET WMISSUE 07080CSR 60 EXSR SR206 INIT WMISSUE 07090CSR TISSU ADD WUSCM WUSCM SUBSTITUTION 07100CSR TISSU ADD WUSTOT WUSTOT QTYS 07110CSR EXSR SR46 UPDATE WMISSUE 07120C* DO SUBSTITUTE PART # RECORDS. 07130CSR 1 ADD WPLITM WPLITM LAST USED ITEM # 07140CSR EXSR SR40 UPD/GET WMPULL 07150CSR Z-ADDTITEM PFSUB 07160CSR Z-ADDWPLITM TITEM 07170CSR MOVELTSUBPN W12A 07180CSR EXSR SR84 GET PART MASTER 07190CSR 60 SETON H5 07200CSR 60 GOTO ENDJOB PROG ERROR 07210CSR EXSR SR81 SUBST PN TO PULLFILE 07220CSR PMOHB SUB TISSU PMOHB 55 55 STOCK BAL 07230CSRN55 Z-ADD563 M 07240CSRN55 EXSR SR89 07250CSRN55 EXSR SR72 FLAG MINUS ON HAND ÐÐ07260CSR TISSU ADD PMUISS PMUISS 07270CSR TISSU COMP 0 54 07280CSR 54 1 ADD PMQISS PMQISS 07290CSR EXSR SR85 UPDATE PART MASTER 07300CSR MOVELTSUBPN W21A 07310CSR MOVELTWO W11A 07320CSR MOVE '00' W11A 07330CSR MOVE W11A W21A 07340CSR EXSR SR45 GET WMISSUE 07350CSR 60 EXSR SR206 INIT WMISSUE 07360CSR TISSU ADD WUUCM WUUCM UNPLAN CUR MO. 07370CSR TISSU ADD WUUTOT WUUTOT UNPLAN TOT. 07380CSR EXSR SR46 UPDATE WMISSUE 07390CSR END106 ENDSR 07400C********************************************************************* 07410CSR SR201 BEGSR 07420C* IDENTIFY FIELD NO. 07430CSR F COMP 1 01 07440CSR F COMP 2 02 07450CSR F COMP 3 03 07460CSR F COMP 4 04 07470CSR F COMP 5 05 07480CSR F COMP 6 06 07490CSR ENDSR 07500C********************************************************************** ÐÐ07510CSR SR202 BEGSR 07520C* RIGHT JUSTIFY 07530CSR F LOKUPNUM 54 07540CSRN54 GOTO END202 NOT NUMERIC FIELD 07550CSR Z-ADD10 W2N 20 07560CSR MOVELW16A W10A 10 07570CSR EXIT SUBRAJ R. JUSTIFY 07580CSR RLABL W2N 07590CSR RLABL W10A 07600CSR END202 ENDSR 07610C******************************************************************** 07620CSR SR205 BEGSR 07630C* INIT PULLFILE DATA. 07640CSR MOVE BLK16 PFWO 07650CSR MOVE BLK16 PFWOP 07660CSR MOVE ' ' PFWOD 07670CSR Z-ADD0 PFPULL 07680CSR Z-ADD0 PFITEM 07690CSR MOVE BLK35 PFKEY 07700CSR MOVE BLK16 PFLOC 07710CSR Z-ADD0 PFCPN 07720CSR Z-ADD0 PFAPN 07730CSR Z-ADD0 PFQTYR 07740CSR Z-ADD0 PFQTYC 07750CSR Z-ADD0 PFQTYS ÐÐ07760CSR Z-ADD0 PFQPA 07770CSR Z-ADD0 PFSUB 07780CSR MOVE ' ' PFSTAT 07790CSR ENDSR 07800C***************************************************************** 07810CSR SR206 BEGSR 07820C* INIT WMISSUE RECORD 07830CSR Z-ADD0 WUPCM 07840CSR Z-ADD0 WUUCM 07850CSR Z-ADD0 WURCM 07860CSR Z-ADD0 WUSCM 07870CSR Z-ADD0 WUPTOT 07880CSR Z-ADD0 WUUTOT 07890CSR Z-ADD0 WURTOT 07900CSR Z-ADD0 WUSTOT 07910CSR Z-ADD0 WUREQD 07920CSR ENDSR 07930C**************************************************************** 07940CSR SR207 BEGSR 07950C* SET OUTPUT INDICATORS (SEE SR71, SR72) 07960CSR TWOP COMP ' ' 55 07970CSR TWOD COMP 0 56 07980CSR TPULL COMP 0 57 07990CSR MGTEXT COMP BLK35 58 08000CSR ENDSR ÐÐ08010C******************************************************************* 08020CSR SR209 BEGSR 08030C* SET PULL STATUS INDICATORS 08040CSR WPPC COMP 'Y' 58 TO BE PRINTED 08050CSRN58 WPPC COMP 'E' 58 TO BE PRINTED 08060CSR WPPC COMP 'D' 59 TO BE PULLED 08070CSR WPPC COMP 'P' 60 PULLED 08080CSR ENDSR 08090C***************************************************************** 08100CSR SR210 BEGSR 08110C* BUILD WORK ORDER NO. 08120CSR MOVE ' ' A16 08130CSR MOVEAW16A A16 08140CSR Z-ADD1 W 08150CSR '-' LOKUPA16,W 54 08160CSRN54 Z-ADD7 W 08170CSR MOVE ' ' W4A 4 08180CSR MOVEAA16,W W4A 08190CSR 54 MOVEL' ' W4A 08200CSR MOVEABLK16 A16,W 08210CSR Z-ADD4 W2N 08220CSR EXIT SUBRAJ RJ 08230CSR RLABL W2N 08240CSR RLABL W4A 08250CSR MOVE W4A TWOD 30 WORK ORDER DASH ÐÐ08260CSR Z-ADD1 W 08270CSR ' ' LOKUPA16,W 54 08280CSRN54 Z-ADD1 W 08290CSR A16,W COMP '0' 54 54 08300CSRN54 MOVEAA16,W TWOP 6 08310CSRN54 MOVE TWOP W5A 5 08320CSR 54 MOVEAA16,W W5A 08330CSR 54 MOVEL' ' TWOP 08340CSR Z-ADD5 W2N 08350CSR EXIT SUBRAJ RJ 08360CSR RLABL W2N 08370CSR RLABL W5A 08380CSR MOVE W5A TWOP WORK ORDER PRIME 08390CSR MOVELTWOP TWO 9 08400CSR MOVE TWOD TWO WORK ORDER NO. 08410CSR MOVELTWOP PREFIX 1 WORK ORDER PREFIX 08420CSR ENDSR 08430C******************************************************************** 08440CSR SR211 BEGSR 08450C* BUILD ITEM #. 08460CSR MOVELW16A TSUBST 1 SUBST SW 08470CSR TSUBST COMP 'S' 70 08480CSR 70 MOVEL' ' W16A 08490CSR EXSR SR202 R.J. 08500CSR MOVE W10A TITEM 50 ÐÐ08510CSR ENDSR 08520O******************************************************************** 08530OTERM132 E 71 08540O OR 72 01 08550O OR 72 02 08560O BIT,28 1 08570O 8 '8091001' 08580O UDATE 16 ' - - ' 08590O 37 'P U L L S H E E T' 08600O 62 'WORK ORDER: (1)' 08610O 69 '______' 08620O 55 TWOP 69 08630O 56 70 '-' 08640O 73 '___' 08650O 56 TWOD 73 08660O 95 'PULL #: (2) ___' 08670O 57 TPULL Z 95 08680O N57N69 95 ' ' 08690O MGTEXT 132 08700O*--------------------------------------------------------------- 08710O E 71 08720O 50 'STATUS :' 08730O 58 65 'TO BE PRINTED' 08740O 59 64 'TO BE PULLED' 08750O 60 58 'PULLED' ÐÐ08760O*------------------------------------------------------------------- 08770O E 1 71 08780O 11 'START DATE:' 08790O WPSTRT 20 ' - - ' 08800O 47 'ASSEMBLY' 08810O 50 ':' 08820O WPPN 64 ' - - ' 08830O MODLWP 78 08840O*------------------------------------------------------------------- 08850O E 1 71 08860O 11 'QUANTITY :' 08870O WPQTY 2 20 08880O DESCWP 81 08890O*------------------------------------------------------------------- 08900O E 1 71 08910O 1 ' ' 08920O*------------------------------------------------------------------- 08930O E 1 71 08940O* COMPONENT HEADINGS. 08950O 50 '*' 08960O 62 '*' 08970O 75 '*' 08980O 81 'SUBST' 08990O 82 '*' 09000O*------------------------------------------------------------------- ÐÐ09010O E 1 71 09020O 16 'PART-NO.' 09030O 27 'STOCK' 09040O 37 'QTY' 09050O 47 'QTY' 09060O 50 '*' 09070O 59 'QUANTITY' 09080O 62 '*' 09090O 71 'QUANTITY' 09100O 75 '*' 09110O 80 'FOR' 09120O 82 '*' 09130O*------------------------------------------------------------------- 09140O E 1 71 09150O 5 'ITEM' 09160O 19 'DESCRIPTION' 09170O 30 'LOCATION' 09180O 37 'PER' 09190O 48 'REQ''D' 09200O 50 '*' 09210O 58 'ISSUED' 09220O 62 '*' 09230O 73 'BACKORDERED' 09240O 75 '*' 09250O 80 'ITEM' ÐÐ09260O 82 '*' 09270O 109 'R E M A R K S / E R R ' 09280O 132 ' O R S ' 09290O*------------------------------------------------------------------- 09300O E 71 09310O 4 '(3)' 09320O 14 '(4)' 09330O 54 '(5)' 09340O 66 '(6)' 09350O 50 '*' 09360O 62 '*' 09370O 75 '*' 09380O 82 '*' 09390O*------------------------------------------------------------------- 09400O E 71 09410O 50 '*' 09420O 62 '*' 09430O 75 '*' 09440O 82 '*' 09450O*------------------------------------------------------------------- 09460O E 1 72N01N02 09470O* COMPONENT LINE. 09480O TITEM Z 5 09490O 70 TSUBPN 20 ' - - ' 09500O N70 PFCPN 20 ' - - ' ÐÐ09510O PMSLOC 28 09520O PFQPA Z 37 09530O PFQTYR2 48 09540O 50 '*' 09550O TISSU K 61 09560O 62 '*' 09570O N32 TBOQ K 74 09580O 75 '*' 09590O PFSUB Z 81 09600O 82 '*' 09610O N32 PFQTYC1 115 09620O N32 132 'QTY ISSUED ' 09630O 32 132 'SUBSTITUTION ' 09640O 58 MGTEXT 132 09650O*------------------------------------------------------------------- 09660O E 1 72N01N02 09670O PMDESC 37 09680O 49 'TOTALS...' 09690O QTYDUNK 61 09700O N32 QTYBO K 74 09710O 50 '*' 09720O 62 '*' 09730O 75 '*' 09740O 82 '*' 09750O N32 PFQTYS1 115 ÐÐ09760O N32 132 'QTY SUBSTITUTED ' 09770O*------------------------------------------------------------------- 09780O E 78 09790O DIV 132 09800O 50 '*' 09810O 62 '*' 09820O 75 '*' 09830O 82 '*' 09840O*------------------------------------------------------------------- 09850O E 80 09860O BIT,28 1 09870O 8 '8120001' 09880O 26 'STARTING SECONDARY' 09890O 37 'UPDATE....' 09900O 50 'PLEASE WAIT.' 09910O BIT,28 131 09920O 132 'K' 09930O****************************************************************** 09940OPMMST2 E 85 09950O PMOHB 314P 09960O PMPISS 366P 09970O PMUISS 382P 09980O PMFISS 400P 09990O PMQISS 412P 10000O PMFBO 324P ÐÐ10010O******************************************************************** 10020OSFPNA EADD 85 10030O PMPN 10 10040O***************************************************************** 10050OWMISSUE EADD 46 60 10060O W21A 21 10070O WUPCM 25P 10080O WUUCM 29P 10090O WURCM 33P 10100O WUSCM 37P 10110O WUPTOT 41P 10120O WUUTOT 45P 10130O WURTOT 49P 10140O WUSTOT 53P 10150O WUREQD 59P 10160O 60 'A' 10170O*----------------------------------------------------------------- 10180O E 46N60 10190O WUPCM 25P 10200O WUUCM 29P 10210O WURCM 33P 10220O WUSCM 37P 10230O WUPTOT 41P 10240O WUUTOT 45P 10250O WURTOT 49P ÐÐ10260O WUSTOT 53P 10270O WUREQD 59P 10280O 60 'A' 10290O********************************************************************** 10300OWUKEY EADD 84 60 10310O W21AA 21 10320O 22 'A' 10330O*--------------------------------------------------------------------- 10340O E 84N60 10350O 22 'A' 10360O******************************************************************** 10370OPULLFILEEADD 81 10380O* SUBSTITUTE ISSUE 10390O TWO 9 10400O TPULL 12 10410O TITEM 17 10420O PMSLOC 23 10430O TSUBPN 33 10440O WPPN 43 10450O ZERO7 47P 10460O ZERO7 51P 10470O TISSU 55P 10480O ZERO7 59P 10490O PFSUB 62P 10500O 64 'S' ÐÐ10510O*-------------------------------------------------------------------- 10520O E 82 10530O* REGULAR ISSUE. 10540O PMSLOC 23 10550O PFQTYR 47P 10560O PFQTYC 51P 10570O PFQTYS 55P 10580O PFQPA 59P 10590O PFSUB 62P 10600O 64 'B' 10610O******************************************************************** 10620OWMPULL E 40 10630O WPQTY 38P 10640O WPLITM 43P 10650O******************************************************************* 10660OCRTFILE E 97 10670O CRRET 73 10680O******************************************************************** ** NUL ARRAY 010690 010700** A16 ARRAY 010710 010720** NUM ARRAY 010730002 PULL # 010740003 ITEM # 10750ÐÐ004 SUBSTITUTE PART NO. 10760005 ISSUE QTY 10770006 BO QTY 10780** DUN ARRAY 010790 010800** MES ARRAY 010810---MESSAGE NOT ON FILE--- 010820** LOC ARRAY 10830057 1 WO # 10840086 2 PULL # 10850003 3 ITEM 10860009 4 SUBST. PART NO. 10870053 5 QTY ISSUED 10880066 6 QTY BO 10890** DIV ARRAY 010900 10910** A9 ARRAY 10920 10930/* 10940_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼. ¼$X002XP P120282120282(èÈÐ00010H Q002XP00020F* UPDATE EXPLOSION MASTER FILE. (X002XP) DG REL006 OK 00030F* REVISED 1-18-81 1:45 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FXPMAST UC F 99R22AI 1 DISK A 00070FXPCONT IC F 128R DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FMCNCR2 IC F 16R 5AI 1 DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A10 10 10 1 A INPUT DATA ARRAY 00140E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00150E DUN 1 4 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E LOC 1 4 3 COL # 00180E BIT 33 1 SCREEN CONTR. CHAR 00190E XPQ 18 7 0 REQMTS 00200E XCD 18 6 0A DATES 00210I******************************************************************* 00220IBITTAB BT 00230I 1 33 BIT 00240I******************************************************************* 00250IMGFILE MG ÐÐ00260I* MESSAGE FILE. 00270I 1 35 MGTEXT 00280I****************************************************************** 00290IXPMAST XP 00300I* EXPLOSION MASTER. 00310I* KEY AREA. 00320I* LOW LEVEL CODE 2N 00330I 1 20XPLL 00340I* COMPONENT PART # 10N 00350I 3 120XPCPN 00360I* TOP ASSY PN 10N 00370I 13 220XPAPN 00380I* REQMTS 7P X 18 00390I P 23 94 XPQ 00400I* RECORD STATUS 1A 00410I 99 99 XPSTAT 00420I****************************************************************** 00430IXPCONT XC 00440I* EXPLOSION CONTROL MAST. 00450I* DATES 6N X 18 00460I 1 108 XCD 00470I* CUR INDENT LEVEL 2N 00480I 127 1280XCCIL 00490I******************************************************************** 00500IPMMST2 PM ÐÐ00520I 1 100PMPN 00530I 19 30 PMMODL 00540I 31 59 PMDESC 00550I 430 4310PMLL 00560I******************************************************************** 00570IMCNCR2 MC 00580I* PART NO. 10N 00590I 6 150MCPN 00600C******************************************************************** 00610C* INITIALIZE 00620C EXSR SR101 1-TIME INIT 00630C Z-ADD0 TDATE 60 STUDPIDITY 00640C*------------------------------------------------------------------ 00650C START TAG 00660C* SET-UP 1ST FIELD NO. 00670C Z-ADD0 XPQ 00680C Z-ADD0 TPN 100 00690C Z-ADD0 PMPN 00700C MOVE ' ' CRTRAN 1 00710C Z-ADD0 TITEM 30 00720C Z-ADD0 TQTY 70 00730C Z-ADD0 PMLL 00740C MOVE BLK35 PMDESC 00750C MOVE BLK35 PMMODL 00760C MOVE ' ' DUN INIT EDIT ARRAY ÐÐ00770C MOVE ' ' IOSW 00780C SETON 76 00790C EXCPT PUT HEADING 00800C SETOF 76 00810C Z-ADD1 F 30 FIELD # 00820C GOTO READ 00830C*------------------------------------------------------------------ 00840C NEXT TAG 00850C* SET-UP NEXT FIELD NO. 00860C 1 ADD F F FIELD # 00870C*----------------------------------------------------------------- 00880C READ TAG 00890C* READ DATA FROM TERMINAL. 00900C SETOF 9096 00910C EXSR SR102 VALIDATE FIELD # 00920C 55 GOTO UPDATE DONE 00930C EXSR SR203 CLASSIFY TRAN 00940C 62 F COMP 3 54 00950C 62 54 GOTO UPDATE 00960C EXSR SR201 IDENTIFY-F 00970C SETON 69 00980C EXSR SR72 PROMPT 00990C SETOF 69 01000C EXSR SR75 READ TERMINAL 01010C 98 GOTO GOODBY GOODBY ÐÐ01020C 94 GOTO MENU MENU REQUEST 01030C N04N03 01040CANN77N88 EXSR SR104 EDIT INPUT FIELD 01050C 96 ERROR 01060CORN77N88 EXSR SR72 REWRITE INPUT DATA 01070C 93 GOTO NEWITM NEW ITEM 01080C 92 GOTO JUMP FIELD JUMP REQST 01090C 91 GOTO NEXT SKIP FORWARD 01100C 89 F SUB 1 F SKIP BACKWARD 01110C 89 GOTO READ " " 01120C 88 SETOF 90 SPACE FILL 01130C 88 SETON 77 " " 01140C 87 GOTO START 01150C 86 GOTO UPDATE UPDATE 01160C 85 GOTO READ REPEAT 01170C 96 GOTO ERROR ERROR 01180C N77 04 GOTO PROCES NO DATA INPUT 01190C N77 GOTO NEXT 01200C*------------------------------------------------------------------ 01210C PROCES TAG 01220C* PROCESS INPUT DATA 01230C EXSR SR103 MOVE DATA 01240C*------------------------------------------------------------------- 01250C EDIT TAG 01260C N96 EXSR SR104 EDIT DATA ÐÐ01270C EXSR SR72 REWRITE DATA 01280C 96 GOTO ERROR ERROR 01290C 04 Z-ADD0 TQTY 01300C 04 Z-ADD0 TITEM 01310C 04 MOVE ' ' DUN,3 01320C 04 MOVE ' ' DUN,4 01330C 04 Z-ADD2 F 01340C GOTO NEXT 01350C*------------------------------------------------------------------ 01360C UPDATE TAG 01370C* UPDATE DATA BASE. 01380C EXSR SR105 FINAL EDIT 01390C 96 GOTO ERROR ERROR 01400C EXSR SR106 UPDATE 01410C 96 GOTO ERROR ERROR 01420C GOTO NEWITM 01430C*------------------------------------------------------------------- 01440C JUMP TAG 01450C* SET-UP JUMP TO REQUESTED FIELD 01460C 1 ADD W W 30 01470C W COMP 10 54 01480C 54 Z-ADD318 M 50 96 FLAG ERROR 01490C 54 GOTO ERROR BAD ESC 01500C MOVE ' ' W3A 3 01510C MOVEAA10,W W3A ÐÐ01520C Z-ADD3 W2N 20 01530C EXIT SUBRAJ R. JUSTIFY 01540C RLABL W2N 01550C RLABL W3A 01560C MOVE W3A F NEW FIELD # 01570C GOTO READ 01580C*-------------------------------------------------------------------- 01590C ERROR TAG 01600C EXSR SR102 VALIDATE FIELD # 01610C EXSR SR89 GET MSG 01620C EXSR SR72 PUT MSG/DATA 01630C GOTO READ 01640C*------------------------------------------------------------------ 01650C NEWITM TAG 01660C* SET-UP LINK FOR NEW ITEM 01670C MOVEL'Q002XP' PROG 8 01680C GOTO END 01690C*------------------------------------------------------------------- 01700C MENU TAG 01710C* SET-UP LINK TO MENU 01720C MOVEL'QQXP01' PROG 01730C GOTO END 01740C*-------------------------------------------------------------------- 01750C GOODBY TAG 01760C* LINK TO SIGN-OFF ÐÐ01770C MOVEL'GOODBY' PROG 01780C GOTO END 01790C*------------------------------------------------------------------- 01800C END TAG 01810C PROG COMP BLK8 54 01820C N54 MOVEL'Q002XP' PROG 01830C EXITFCHAIN LINK TO NEXT PROG 01840C RLABL PROG 01850C******************************************************************** 01860CSR SR1 BEGSR 01870C* EDIT TRAN CODE. 01880CSR EXSR SR203 CLASSIFY TRAN. 01890CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 01900CSR ENDSR 01910C********************************************************************* 01920CSR SR2 BEGSR 01930C* EDIT PART NO. 01940CSR TPN COMP 0 54 01950CSRN54 Z-ADD299 M 96 FLAG ERROR 01960CSRN54 GOTO END2 PART# MISSING 01970CSR SETOF 55 01980C*------------------------------------------------------------------- 01990CSR T2A TAG 02000C* GET PART MASTER. 02010CSR MOVELTPN W12A 12 ÐÐ02020CSR MOVE ' ' W12A 02030CSR W12A CHAINPMMST2 54 GET PART MAST 02040CSRN54 GOTO T2B GOT IT 02050CSR 55 GOTO T2E ERROR 02060CSR MOVE TPN W5A 5 02070CSR W5A CHAINMCNCR2 54 GET MCN CROSS REF 02080CSR 54 GOTO T2E ERROR 02090CSR SETON 55 02100CSR MOVELMCPN TPN PART # 02110CSR GOTO T2A TRY AGAIN 02120C*--------------------------------------------------------------- 02130CSR T2B TAG 02140C* GET XPMAST IF NOT FINAL EDIT 02150CSR TPN COMP XPCPN 54 02160CSR 54 GOTO END2 02170CSR SETON 40 02180CSR EXSR SR106 GET XPMAST 02190CSR SETOF 40 02200CSR EXSR SR71 PUT DATES 02210CSR GOTO END2 02220C*--------------------------------------------------------------- 02230CSR T2E TAG 02240C* FLAG ERROR 02250CSR Z-ADD291 M 96 FLAG ERROR 02260CSR Z-ADD0 PMPN ÐÐ02270CSR Z-ADD0 PMLL 02280CSR MOVE BLK35 PMDESC 02290CSR MOVE BLK35 PMMODL 02300CSR END2 ENDSR 02310C********************************************************************* 02320CSR SR3 BEGSR 02330C* EDIT ITEM. 02340CSR TITEM COMP 0 54 02350CSRN54 Z-ADD335 M 96 FLAG ERROR 02360CSRN54 GOTO END3 02370CSR TDATE COMP 99 54 02380CSRN54 GOTO T3A ITEM# INPUT 02390C* CHANGE TO ITEM # IF DATE INPUT. 02400CSR MOVELTDATE W2N 20 02410CSR W2N COMP 12 54 02420CSR 54 GOTO T3 02430CSR MOVELTDATE W4N 40 02440CSR MOVE TDATE W2N 02450CSR MOVE W4N TDATE 02460CSR MOVELW2N TDATE 02470C*------------------------------------------------------------------- 02480CSR T3 TAG 02490CSR Z-ADD1 X 30 02500CSR TDATE LOKUPXCD,X 54 54 02510CSRN54 Z-ADD18 X ÐÐ02520CSR Z-ADDX TITEM 02530C*R ****** TITEM SUB 1 TITEM 54 02540CSRN54 Z-ADD1 TITEM 02550CSR TDATE COMP XCD,18 54 02560CSR 54 Z-ADD18 TITEM 02570CSR GOTO END3 02580C*------------------------------------------------------------- 02590CSR T3A TAG 02600C* T E M P O R A R Y C L U D G E 02610CSR TITEM SUB 1 TITEM 54 02620CSRN54 Z-ADD1 TITEM 02630CSR TITEM COMP 18 54 02640CSR 54 Z-ADD18 TITEM 02650C*.................................................................. 02660CSR END3 ENDSR 02670C********************************************************************** 02680CSR SR4 BEGSR 02690C* EDIT QTY. 02700CSR Z-ADDTITEM X 30 54 02710CSRN54 GOTO END4 02720CSR TQTY ADD XPQ,X XPQ,X 54 02730CSRN54 Z-ADD0 XPQ,X 02740CSR END4 ENDSR 02750C******************************************************************* 02760CSR SR71 BEGSR ÐÐ02770C* PUT HEADINGS TO TERMINAL 02780CSR SETON 71 02790CSR EXCPT PUT HEADINGS 02800CSR SETOF 71 02810CSR Z-ADD0 X 30 02820C*------------------------------------------------------------------- 02830CSR T71A TAG 02840CSR 1 ADD X X 02850CSR X COMP 18 54 02860CSR 54 GOTO END71 02870CSR 5 ADD X W3N 30 02880CSR MOVELW3N LINE 02890CSR MOVE '001' LINE 02900CSR SETON 74 02910CSR EXCPT 02920CSR SETOF 74 02930CSR GOTO T71A 02940CSR END71 ENDSR 02950C********************************************************************* 02960CSR SR72 BEGSR 02970C* PUT DATA TO TERMINAL 02980CSR TITEM COMP 0 54 02990CSR 54 TITEM COMP 18 5454 03000CSRN54 GOTO T72A 03010CSR 5 ADD TITEM W3N 30 ÐÐ03020CSR MOVELW3N LINE 6 03030CSR MOVE '001' LINE 03040CSR Z-ADDTITEM X 03050CSR SETON 74 03060C*------------------------------------------------------------------- 03070CSR T72A TAG 03080CSR SETON 72 03090CSR EXCPT PUT DATA 03100CSR SETOF 7274 03110CSRN69 GOTO END72 03120CSR MOVEL'005' W6A 6 03130CSR MOVE LOC,F W6A 03140CSR EXITFQXYPOS 03150CSR RLABL W6A 03160CSR EXITFQBELL 03170CSR END72 ENDSR 03180C******************************************************************* 03190CSR SR75 BEGSR 03200C* READ FROM TERMINAL 03210CSR SETOF 779096 03220CSR SETOF 939291 03230CSR SETOF 898887 03240CSR SETOF 8685 03250CSR MOVE BIT,6 BUFLGT 2 READ BUFFER LGTH 03260CSR MOVE BLK10 W10A 10 BUFFER ÐÐ03270CSR EXITFQWREED READ FROM TERMINAL 03280CSR RLABL W10A READ BUFFER 03290CSR RLABL BUFLGT READ BUFFER LGTH 03300CSR MOVEAW10A A10 INPUT DATA ARRAY 03310CSR MOVE BLK10 W10A INIT INPUT ARRAY 03320CSR Z-ADD1 W 30 03330CSR '\' LOKUPA10,W 90 FLAG ESC 03340CSRN90 GOTO T75B NOT ESC 03350CSR 1 ADD W W 03360CSR W COMP 10 54 03370CSR 54 GOTO T75A BAD ESC 03380CSR A10,W COMP 'G' 98 GOODBY 03390CSR A10,W COMP 'E' 94 MENU 03400CSR A10,W COMP 'N' 93 NEW ITEM 03410CSR A10,W COMP 'J' 92 JUMP 03420CSR A10,W COMP 'F' 91 SKIP FRWRD 03430CSR A10,W COMP 'B' 89 SKIP BKWRD 03440CSR A10,W COMP 'S' 88 SPACE FILL 03450CSR A10,W COMP 'H' 87 HOME 03460CSR A10,W COMP 'U' 86 UPDATE 03470CSR A10,W COMP 'R' 85 REPEAT 03480CSR 98 03490COR 94 03500COR 93 03510COR 92 ÐÐ03520COR 91 03530COR 89 03540COR 88 03550COR 87 03560COR 86 03570COR 85 GOTO END75 GOOD ESC 03580C*------------------------------------------------------------------ 03590CSR T75A TAG 03600C* FLAG BAD ESC INPUT 03610CSR Z-ADD318 M 96 FLAG ERROR 03620CSR GOTO END75 03630C*-------------------------------------------------------------------- 03640CSR T75B TAG 03650C* MOVE DATA 03660CSR Z-ADD1 W 03670CSR ' ' LOKUPA10,W 77 03680CSR 77 MOVEAA10,W W10A INPUT DATA 03690C*-------------------------------------------------------------------- 03700CSR END75 TAG 03710CSR MOVE BLK35 MGTEXT 03720CSR ENDSR 03730C********************************************************************** 03740CSR SR80 BEGSR 03750C* GET EXPLOSION MAST. 03760CSR SETOF 6061 ÐÐ03770CSR IOSW COMP ' ' 54 03780CSR 54 TPN COMP XPCPN 54 03790CSR 54 GOTO T80A ALREADY DONE 03800C*R ******** MOVELPMLL W22A 22 03810CSR MOVELTPN W20A 20 03820CSR MOVE PMPN W20A 03830CSR MOVE W20A W22A 22 03840CSR W22A CHAINXPMAST 60 GET XPMAST 03850CSRN60 XPSTAT COMP 'D' 61 FLAG DELETE 03860CSR MOVE 'A' IOSW 1 03870CSR 60 MOVE 'N' IOSW 03880CSR 61 MOVE 'D' IOSW 03890CSR 60 Z-ADDTPN XPCPN NEW PART# 03900CSR 60 NOT ON FILE 03910COR 61 Z-ADD0 XPQ 03920CSR GOTO END80 03930C*----------------------------------------------------------------- 03940CSR T80A TAG 03950CSR IOSW COMP 'D' 61 03960CSR IOSW COMP 'N' 60 03970CSR END80 ENDSR 03980C********************************************************************** 03990CSR SR81 BEGSR 04000C* ADD NEW MASTER TO FILE 04010CSR SETON 81 ÐÐ04020CSR EXCPT ADD MASTER 04030CSR SETOF 81 04040CSR Z-ADD0 XPCPN 04050CSR MOVE ' ' IOSW 04060CSR ENDSR 04070C*********************************************************************** 04080CSR SR82 BEGSR 04090C* REWRITE MASTER 04100CSR SETON 82 04110CSR EXCPT REWRITE MASTER 04120CSR SETOF 82 04130CSR Z-ADD0 XPCPN 04140CSR MOVE ' ' IOSW 04150CSR ENDSR 04160C********************************************************************** 04170CSR SR89 BEGSR 04180C* GET MESSAGE MASTER 04190CSR M CHAINMGFILE 54 04200CSR 54 MOVE BLK35 MGTEXT 04210CSR 54 MOVELM MGTEXT 04220CSR 54 MOVE MES,1 MGTEXT 04230CSR ENDSR 04240C*********************************************************************** 04250CSR SR101 BEGSR 04260C* 1-TIME INITIALIZE ÐÐ04270CSR MOVE BIT,1 NUL 04280CSR EXITFQTOPF CLEAR SCREEN. 04290CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04300CSR Z-ADD4 FLIMIT 30 TOTAL NUMB FIELDS 04310CSR MOVE ' ' BLK10 10 04320CSR Z-ADD1 RRN 50 04330CSR RRN CHAINXPCONT H9 04340CSR H9 GOTO END101 04350C* DEFINE WORK FIELDS,ETC. 04360CSR MOVE ' ' BLK35 35 04370CSR MOVE ' ' BLK8 8 04380CSR Z-ADD0 ZERO10 100 04390CSR END101 ENDSR 04400C********************************************************************** 04410CSR SR102 BEGSR 04420C* VALIDATE FIELD NO. 04430CSR F COMP 0 54 04440CSRN54 Z-ADD1 F 04450CSR F COMP FLIMIT 55 04460CSR 55 Z-ADD1 F 04470CSR ENDSR 04480C******************************************************************** 04490CSR SR103 BEGSR 04500C* MOVE INPUT DATA 04510CSR EXSR SR201 IDENTIFY-F ÐÐ04520CSR EXSR SR202 R. JUSTIFY 04530CSR 01 MOVELW10A CRTRAN 1 04540CSR 02 MOVE W10A TPN 04550CSR 03 MOVE W10A TITEM 04560CSR 03 MOVE W10A TDATE 60 04570CSR 04 MOVE W10A TQTY 04580CSR MOVE ' ' DUN,F EDIT FLAG 04590CSR ENDSR 04600C******************************************************************** 04610CSR SR104 BEGSR 04620C* EDIT INPUT DATA 04630CSR 01 EXSR SR1 04640CSR 02 EXSR SR2 04650CSR EXSR SR203 CLASSIFY TRAN 04660CSR 03N79N62 EXSR SR3 04670CSR 04N79N62 EXSR SR4 04680CSR 96 MOVE ' ' DUN,F EDIT FLAG 04690CSRN96 MOVE 'X' DUN,F 04700CSR ENDSR 04710C*********************************************************************** 04720CSR SR105 BEGSR 04730C* FINAL EDIT 04740CSR SETON 79 FINAL EDIT FLAG 04750CSR Z-ADD1 F 96 04760C*-------------------------------------------------------------------- ÐÐ04770CSR T105A TAG 04780CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04790CSRN54 GOTO END105 04800CSR EXSR SR201 IDENTIFY-F 04810CSR EXSR SR104 EDIT 04820CSRN96 GOTO T105A 04830C*-------------------------------------------------------------------- 04840CSR END105 TAG 04850CSR SETOF 79 04860CSR ENDSR 04870C******************************************************************** 04880CSR SR106 BEGSR 04890C* UPDATE DATA BASE. 04900CSR EXSR SR203 CLASSIFY TRAN 04910CSR 60 GOTO T106A ADD TRAN 04920CSR 61 GOTO T106D CHANGE TRAN 04930CSR 62 GOTO T106F DELETE TRAN 04940C* FLAG BAD TRAN CODE 04950CSR Z-ADD300 M 96 FLAG ERROR 04960CSR Z-ADD1 F FIELD # 04970CSR GOTO END106 04980C*------------------------------------------------------------------- 04990CSR T106A TAG 05000C* ADD TRANSACTION 05010CSR EXSR SR80 GET MASTER ÐÐ05020CSR 96 GOTO END106 ERROR 05030CSR 60 GOTO T106B NOT ON FILE 05040CSR 61 GOTO T106C DELETED MASTER 05050C* FLAG DUPLICATE ADD ERROR 05060CSR Z-ADD301 M 96 FLAG ERROR 05070CSR Z-ADD1 F FIELD # 05080CSR GOTO END106 05090C*--------------------------------------------------------------------- 05100CSR T106B TAG 05110C* ADD-- MAST NOT ON FILE 05120CSRN40 EXSR SR81 ADD NEW MASTER 05130CSR GOTO END106 05140C*--------------------------------------------------------------------- 05150CSR T106C TAG 05160C* ADD-- MAST IS DELETED 05170CSR MOVE 'A' XPSTAT RECORD STATUS 05180CSRN40 EXSR SR82 REWRITE MAST 05190CSR GOTO END106 05200C*---------------------------------------------------------------------- 05210CSR T106D TAG 05220C* CHANGE TRANSACTION. 05230CSR EXSR SR80 GET MASTER 05240CSR 96 GOTO END106 ERROR 05250CSRN60N61 GOTO T106E GOT IT 05260C* FLAG NO MASTER ERROR ÐÐ05270CSR Z-ADD302 M 96 FLAG ERROR 05280CSR Z-ADD1 F FIELD # 05290CSR GOTO END106 05300C*----------------------------------------------------------------------- 05310CSR T106E TAG 05320C* REWRITE MASTER 05330CSR MOVE 'A' XPSTAT RECORD STATUS 05340CSRN40 EXSR SR82 REWRITE MAST 05350CSR GOTO END106 05360C*----------------------------------------------------------------------- 05370CSR T106F TAG 05380C* DELETE TRANSACTION 05390CSR EXSR SR80 GET MASTER 05400CSR 96 GOTO END106 ERROR 05410CSRN60N61 GOTO T106G GOT IT 05420C* FLAG NO MASTER ERROR 05430CSR Z-ADD302 M 96 FLAG ERROR 05440CSR Z-ADD1 F FIELD # 05450CSR GOTO END106 05460C*----------------------------------------------------------------------- 05470CSR T106G TAG 05480C* DELETE MASTER. 05490CSR MOVE 'D' XPSTAT RECORD STATUS 05500CSRN40 EXSR SR82 REWRITE MASTER 05510CSR END106 ENDSR ÐÐ05520C************************************************************************ 05530CSR SR201 BEGSR 05540C* IDENTIFY FIELD NO. 05550CSR F COMP 1 01 05560CSR F COMP 2 02 05570CSR F COMP 3 03 05580CSR F COMP 4 04 05590CSR ENDSR 05600C********************************************************************** 05610CSR SR202 BEGSR 05620C* RIGHT JUSTIFY 05630CSR F LOKUPNUM 54 05640CSRN54 GOTO END202 NOT NUMERIC FIELD 05650CSR Z-ADD10 W2N 20 05660CSR EXIT SUBRAJ R. JUSTIFY 05670CSR RLABL W2N 05680CSR RLABL W10A 05690CSR END202 ENDSR 05700C*********************************************************************** 05710CSR SR203 BEGSR 05720C* CLASSIFY TRAN CODE 05730CSR CRTRAN COMP 'A' 60 ADD 05740CSR CRTRAN COMP 'C' 61 CHANGE 05750CSR CRTRAN COMP 'D' 62 DELETE 05760CSR ENDSR ÐÐ05770O******************************************************************** 05780OTERM132 E 71 05790O OR 76 05800O BIT,28 1 05810O 8 '8001001' 05820O 81 'INPUT FORECAST' 05830O*------------------------------------------------------------------- 05840O E 71 05850O OR 76 05860O 3 '(1)' 05870O 10 '(2)' 05880O 22 '(3)' 05890O 31 '(4)' 05900O*------------------------------------------------------------------ 05910O E 71 05920O OR 76 05930O 4 'TRAN' 05940O 14 'PART-NO.' 05950O 24 'ITEM' 05960O 35 'QUANTITY' 05970O 54 'DATE' 05980O*------------------------------------------------------------------- 05990O E 71 06000O OR 76 06010O*------------------------------------------------------------------- ÐÐ06020O E 72 06030O BIT,28 1 06040O 8 '8005001' 06050O CRTRAN 11 06060O TPN 26 ' - - ' 06070O TITEM Z 31 06080O TQTY K 43 06090O PMDESC 74 06100O PMMODL 88 06110O MGTEXT 125 06120O 96 132 'ERROR' 06130O N96 132 ' ' 06140O*------------------------------------------------------------------- 06150O E 74 06160O BIT,28 1 06170O 2 '8' 06180O LINE 8 06190O X Z 31 06200O XCD,X 64 ' - - ' 06210O XPQ,X K 43 06220O******************************************************************** 06230OXPMAST EADD 81 06240O W22A 22 06250O XPQ 94P 06260O 99 'A' ÐÐ06270O*------------------------------------------------------------------ 06280O E 82 06290O XPQ 94P 06300O XPSTAT 99 ** NUL ARRAY 006310 006320** A10 ARRAY 006330 006340** NUM ARRAY 006350002 PART # 006360003 ITEM 006370004 QTY 006380** DUN ARRAY 006390 006400** MES ARRAY 006410---MESSAGE NOT ON FILE--- 006420** LOC ARRAY 006430001 1 TRAN 006440008 2 PART # 006450022 3 ITEM 006460027 4 QTY 006470/* 006480_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Â/1 ¼X003BJ P120282120282(èÈÐ00010H Q003BJ00020F* DISPLAY BJMAST FILE (X003BJ) 00030F* REVISED 11/23/79 5:00 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FBJMAST ID F 106L 6AI 1 DISK 00070F* 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A6 6 6 1 CALL READ PARAM. 00120E A40 40 40 1 A INPUT DATA ARRAY 00130E DUN 1 1 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E LOC 1 1 3 0 00160E DASH 1 1 10 00170E BIT 256 1 SCREEN CONTR. CHAR 00180E CALL 5 6 CALL STACK 00190E BJD 6 4 REPORT DISTR. 00200E* 00210I******************************************************************* 00220IBITHEX BT 00230I 1 256 BIT 00240I******************************************************************* 00250IMGFILE MG ÐÐ00260I* MESSAGE FILE. 00270I 1 35 MGTEXT 00280I******************************************************************** 00290IBJMAST BJ 00300I* BATCH JOB MAST. 00310I* JOB NAME 6A 00320I 1 6 BJNAME 00330I* DESCRIPTION 40A 00340I 7 46 BJDESC 00350I* PRINTER 1A 00360I* D = DIABLO 00370I* S = SYST PRINTER 00380I* T = DATAGRAPHIX 00390I* C = CONSOLE 00400I 47 47 BJPRTR 00410I* PAPER 25A 00420I 48 72 BJPAP 00430I* COPIES 1N 00440I 73 730BJCOPY 00450I* DISTRIBUTION 00460I* 4A X 6 00470I 74 97 BJD 00480I* UPDATE CODE 1A 00490I* Y = SHARABLE 00500I* N = NOT SHARABLE ÐÐ00510I* BLK = NO DISK UPDATE 00520I 98 98 BJUPD 00530I* TYPE CODE 1A 00540I* P = PROGRAM (MAINLINE OR CALLED BY PROC) 00550I* U = UTILITY (ONLY) 00560I* Z = JOB STREAM 00570I* M = MENU 00580I* C = CALLED PROGRAM 00590I 99 99 BJTYPE 00600I* RECORD STATUS 1A 00610I 106 106 BJSTAT 00620C******************************************************************** 00630C* INITIALIZE 00640C EXSR SR101 1-TIME INIT 00650C H9 GOTO ENDJOB 00660C*------------------------------------------------------------------ 00670C START TAG 00680C* SET-UP 1ST FIELD NO. 00690C MOVE ' ' DUN 00700C MOVE ' ' CRNAME 6 00710C Z-ADD1 F 30 FIELD # 00720C EXSR SR71 00730C GOTO READ 00740C*------------------------------------------------------------------ 00750C NEXT TAG ÐÐ00760C* SET-UP NEXT FIELD NO. 00770C 1 ADD F F FIELD # 00780C*----------------------------------------------------------------- 00790C READ TAG 00800C* READ DATA FROM TERMINAL. 00810C SETOF 9096 00820C SETOF 9096 00830C EXSR SR102 VALIDATE FIELD # 00840C 55 GOTO UPDATE DONE 00850C EXSR SR201 IDENTIFY-F 00860C SETON 69 00870C EXSR SR72 PROMPT 00880C SETOF 69 00890C EXSR SR75 READ TERMINAL 00900C*--------------------------------------------------------------- 00910C ESCAPE TAG 00920C 98 GOTO GOODBY GOODBY 00930C 94 GOTO MENU MENU REQUEST 00940C N77N88 EXSR SR104 EDIT INPUT FIELD 00950C 93 GOTO NEWITM NEW ITEM 00960C 92 GOTO JUMP FIELD JUMP REQST 00970C 91 GOTO NEXT SKIP FORWARD 00980C 89 F SUB 1 F SKIP BACKWARD 00990C 89 GOTO READ " " 01000C 88 SETOF 90 SPACE FILL ÐÐ01010C 88 SETON 77 " " 01020C 87 GOTO START 01030C 86 GOTO UPDATE UPDATE 01040C 85 GOTO READ REPEAT 01050C 96 GOTO ERROR ERROR 01060C 90 Z-ADD318 M 96 FLAG ERROR 01070C 90 GOTO ERROR 01080C N77 GOTO NEXT NO DATA INPUT 01090C*------------------------------------------------------------------ 01100C PROCES TAG 01110C* PROCESS INPUT DATA 01120C EXSR SR103 MOVE DATA 01130C 96 GOTO ERROR ERROR 01140C GOTO NEXT 01150C*------------------------------------------------------------------ 01160C UPDATE TAG 01170C* UPDATE DATA BASE. 01180C EXSR SR106 UPDATE 01190C 96 GOTO ERROR ERROR 01200C 90 GOTO ESCAPE ESCAPE INPUT 01210C GOTO START 01220C*------------------------------------------------------------------- 01230C JUMP TAG 01240C* SET-UP JUMP TO REQUESTED FIELD 01250C 1 ADD W W 30 ÐÐ01260C W COMP 40 54 01270C 54 Z-ADD318 M 50 96 FLAG ERROR 01280C 54 GOTO ERROR BAD ESC 01290C MOVE '000' W3A 3 01300C MOVEAA40,W W3A 01310C Z-ADD3 W2N 20 01320C EXIT SUBRAJ R. JUSTIFY 01330C RLABL W2N 01340C RLABL W3A 01350C MOVE W3A F NEW FIELD # 01360C GOTO READ 01370C*-------------------------------------------------------------------- 01380C ERROR TAG 01390C EXSR SR102 VALIDATE FIELD # 01400C EXSR SR89 GET MSG 01410C EXSR SR73 PUT MSG 01420C GOTO READ 01430C*------------------------------------------------------------------ 01440C NEWITM TAG 01450C* SET-UP LINK FOR NEW ITEM 01460C MOVEL'Q003BJ' PROG 8 01470C GOTO END 01480C*------------------------------------------------------------------- 01490C MENU TAG 01500C* SET-UP LINK TO MENU ÐÐ01510C MOVEL'QQDP01' PROG 01520C GOTO END 01530C*-------------------------------------------------------------------- 01540C GOODBY TAG 01550C* LINK TO SIGN-OFF 01560C MOVEL'GOODBY' PROG 01570C GOTO END 01580C*------------------------------------------------------------------- 01590C END TAG 01600C EXITFCHAIN LINK TO NEXT PROG 01610C RLABL PROG 01620C*------------------------------------------------------------------- 01630C ENDJOB TAG 01640C********************************************************************** 01650CSR SR71 BEGSR 01660C* PUT HEADINGS TO TERMINAL 01670CSR SETON 71 01680CSR EXCPT PUT HEADINGS 01690CSR SETOF 71 01700CSR Z-ADD5 LINENO 01710CSR ENDSR 01720C********************************************************************* 01730CSR SR72 BEGSR 01740C* PUT DATA TO TERMINAL 01750CSR 1 ADD LINENO LINENO 30 ÐÐ01760CSR SETON 72 01770CSR EXCPT PUT DATA 01780CSR SETOF 72 01790CSRN69 GOTO END72 NOT PROMPT 01800CSR 1 ADD LOC,F X 30 01810CSR MOVE BIT,X W2A 2 01820CSR MOVELBIT,1 W2A 01830CSR EXITFQCCR MOVE CURSOR. 01840CSR EXITFQMOVR MOVE CURSOR. 01850CSR RLABL W2A 01860CSR EXITFQBELL RING BELL. 01870CSR END72 ENDSR 01880C*********************************************************************** 01890CSR SR73 BEGSR 01900C* PUT ERROR MESSAGE TO TERMINAL 01910CSR SETON 73 01920CSR EXCPT PUT MSG 01930CSR SETOF 73 01940CSR Z-ADDM LSTERR 50 01950CSR EXITFQMOVUP MOVE CURSOR. 01960CSR ENDSR 01970C******************************************************************* 01980CSR SR75 BEGSR 01990C* READ FROM TERMINAL 02000CSR SETOF 779096 ÐÐ02010CSR SETOF 939291 02020CSR SETOF 898887 02030CSR SETOF 8685 02040CSR MOVE BIT,21 A6,2 BUF LENGTH 02050CSR MOVEAA6 W6A 6 02060CSR MOVE BLK40 W40A 40 BUFFER 02070CSR EXITFQWREED READ TERM 02080CSR RLABL W40A 02090CSR RLABL W6A 02100CSR MOVEAW40A A40 02110CSR MOVE BLK40 W40A 02120CSR Z-ADD1 W 30 02130CSR '\' LOKUPA40,W 90 FLAG ESC 02140CSRN90 GOTO T75B NOT ESC 02150CSR 1 ADD W W 02160CSR W COMP 40 54 02170CSR 54 GOTO T75A BAD ESC 02180CSR A40,W COMP 'G' 98 GOODBY 02190CSR A40,W COMP 'E' 94 MENU 02200CSR A40,W COMP 'N' 93 NEW ITEM 02210CSR A40,W COMP 'J' 92 JUMP 02220CSR A40,W COMP 'F' 91 SKIP FRWRD 02230CSR A40,W COMP 'B' 89 SKIP BKWRD 02240CSR A40,W COMP 'S' 88 SPACE FILL 02250CSR A40,W COMP 'H' 87 HOME ÐÐ02260CSR A40,W COMP 'U' 86 UPDATE 02270CSR A40,W COMP 'R' 85 REPEAT 02280CSR 98 02290COR 94 02300COR 93 02310COR 92 02320COR 91 02330COR 89 02340COR 88 02350COR 87 02360COR 86 02370COR 85 GOTO END75 GOOD ESC 02380C*------------------------------------------------------------------ 02390CSR T75A TAG 02400C* FLAG BAD ESC INPUT 02410CSR Z-ADD318 M 96 FLAG ERROR 02420CSR GOTO END75 02430C*-------------------------------------------------------------------- 02440CSR T75B TAG 02450C* MOVE DATA 02460CSR Z-ADD1 W 02470CSR ' ' LOKUPA40,W 77 02480CSR 77 MOVEAA40,W W40A INPUT DATA 02490C*-------------------------------------------------------------------- 02500CSR END75 TAG ÐÐ02510C* INIT PREV ERROR MSG. 02520CSR LSTERR COMP 0 54 02530CSR 54 MOVE BLK35 MGTEXT 02540CSR 54 EXSR SR73 BLANK MESSAGE 02550CSR Z-ADD0 LSTERR 50 02560CSR ENDSR 02570C********************************************************************** 02580CSR SR89 BEGSR 02590C* GET MESSAGE MASTER 02600CSR M CHAINMGFILE 54 02610CSR 54 MOVE BLK35 MGTEXT 02620CSR 54 MOVELM MGTEXT 02630CSR 54 MOVE MES,1 MGTEXT 02640CSR ENDSR 02650C*********************************************************************** 02660CSR SR101 BEGSR 02670C* 1-TIME INITIALIZE 02680CSR MOVE BIT,1 NUL 02690CSR MOVE BIT,1 A6 02700CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02710CSR MOVE ' ' BLK40 40 02720C* DEFINE WORK FIELDS,ETC. 02730CSR MOVE ' ' BLK35 35 02740CSR MOVE ' ' BLK6 6 02750CSR MOVE ' ' BLK4 4 ÐÐ02760CSR MOVE ' ' BLK25 25 02770C* 02780CSR ENDSR 02790C********************************************************************** 02800CSR SR102 BEGSR 02810C* VALIDATE FIELD NO. 02820CSR F COMP 0 54 02830CSRN54 Z-ADD1 F 02840CSR F COMP FLIMIT 55 02850CSR 55 Z-ADD1 F 02860CSR ENDSR 02870C******************************************************************** 02880CSR SR103 BEGSR 02890C* MOVE INPUT DATA 02900CSR EXSR SR201 IDENTIFY-F 02910CSR 01 MOVELW40A CRNAME 6 JOB NAME. 02920CSR MOVE ' ' DUN,F EDIT FLAG 02930CSR ENDSR 02940C******************************************************************** 02950CSR SR104 BEGSR 02960C* EDIT INPUT DATA 02970CSR 96 MOVE ' ' DUN,F EDIT FLAG 02980CSRN96 MOVE 'X' DUN,F 02990CSR ENDSR 03000C******************************************************************** ÐÐ03010CSR SR106 BEGSR 03020C* DISPLAY BATCH JOB MASTER (BJMAST) 03030CSR CRNAME SETLLBJMAST 03040C*------------------------------------------------------------------ 03050CSR T106A TAG 03060CSR SETOF 54 03070CSR READ BJMAST 54 03080CSR 54 GOTO T106T END OF FILE 03090CSR BJSTAT COMP 'D' 54 03100CSR 54 GOTO T106A DELETED 03110CSR EXSR SR72 DISPLAY DATA 03120CSR LINENO COMP 31 54 54 03130CSRN54 GOTO T106A GET NEXT LINE 03140CSR EXITFQEPAGE END PAGE MSG 03150C*--------------------------------------------------------------- 03160CSR T106B TAG 03170C* REQUEST INPUT 03180CSR EXSR SR75 READ 03190CSR 90 GOTO END106 ESCAPE 03200CSR 77 EXSR SR103 MOVE INPUT DATA 03210CSR 77 CRNAME SETLLBJMAST 03220CSR EXSR SR71 PUT HEADINGS 03230CSR GOTO T106A GET NEXT LINE 03240C*------------------------------------------------------------------- 03250CSR T106T TAG ÐÐ03260C* END FILE MSG 03270CSR EXITFQEFILE END FILE MSG 03280CSR END106 ENDSR 03290C******************************************************************** 03300CSR SR201 BEGSR 03310C* IDENTIFY FIELD NO. 03320CSR F COMP 1 01 03330CSR F COMP 2 02 03340CSR F COMP 3 03 03350CSR F COMP 4 04 03360CSR F COMP 5 05 03370CSR F COMP 6 06 03380CSR F COMP 7 07 03390CSR F COMP 8 08 03400CSR F COMP 9 09 03410CSR F COMP 10 10 03420CSR F COMP 11 11 03430CSR F COMP 12 12 03440CSR F COMP 13 13 03450CSR F COMP 14 14 03460CSR ENDSR 03470O******************************************************************** 03480OTERM132 E 71 03490O* PUT HEADINGS 03500O*------------------------------------------------------------------- ÐÐ03510O E 71 03520O* PUT HEADINGS. 03530O 7 'NAME' 03540O DASH,1 21 03550O DASH,1 31 03560O DASH,1 41 03570O DASH,1 51 03580O 22 'DESCRIPTION' 03590O 55 'PRT' 03600O DASH,1 67 03610O DASH,1 77 03620O DASH,1 82 03630O 62 'PAPER' 03640O 86 'COP' 03650O 91 'D-1' 03660O 97 'D-2' 03670O 103 'D-3' 03680O 109 'D-4' 03690O 115 'D-5' 03700O 121 'D-6' 03710O 125 'UPD' 03720O 132 'TYPE' 03730O*------------------------------------------------------------------ 03740O E 71 03750O*------------------------------------------------------------------- ÐÐ03760O E 72 03770O* PUT DATA. 03780O BJNAME B 9 03790O BJDESC B 51 03800O BJPRTR B 54 03810O BJPAP B 82 03820O BJCOPYZB 85 03830O BJD,1 B 92 03840O BJD,2 B 98 03850O BJD,3 B 104 03860O BJD,4 B 110 03870O BJD,5 B 116 03880O BJD,6 B 122 03890O BJUPD B 125 03900O BJTYPE B 130 03910O*------------------------------------------------------------------- 03920O E 73 03930O* PUT MESSAGE. 03940O NUL 132 03950O MGTEXT 35 03960O 37 ' ' ** NUL ARRAY 003970 003980** A6 ARRAY 003990 004000ÐÐ** A40 ARRAY 004010 004020** DUN ARRAY 004030 004040** MES ARRAY 004050---MESSAGE NOT ON FILE--- 004060** LOC ARRAY 004070004 1 NAME 04080** DASH ARRAY 004090---------- 004100/* 04110_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(/î X003CM P#n120282120282(èÈÐ00010H Q003CM00020F* REQUEST INPUT DATA FOR CMMAST. (X003CM) 00030F* REVISED 6-25-81 3:35 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCR2FILE UC F 672R DISK 00070FCMMAST IC F 576R 5AI 1 DISK 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E TABSTC 1 58 2 TABSCN 20 STATE NAMES. 00110E TABCLC 1 17 2 0 TABCLN 20 CUST CLASS NAMES. 00120E TABTAX 1 5 1 TABTAN 20 TAX CODES 00130E TABTER 1 5 3 TABTN 20 TERRITORY NAMES 00140E NUL 1 132 1 NULL CHAR 00150E A6 6 6 1 CALL READ PARAM. 00160E A36 36 36 1 A INPUT DATA ARRAY 00170E NUM 1 10 3 0 NUMERIC FIELD NO.'S 00180E DUN 34 34 1 A EDIT CMPLT FLAG 00190E MES 1 1 30 00200E CMA 7 35 00210E CMB 10 9 2 00220E CMS 10 9 2 00230E CRAR 4 9 2 00240E CMD 5 7 0 00250E CRA 7 35 A ADDRESS ÐÐ00260E CRB 10 9 2 00270E CRS 10 9 2 00280E CRD 5 7 0 00290E CRM 3 3 MAILER CODES 00300E CRC 3 2 0 NUMB COPIES 00310E BIT 33 1 SCREEN CONTR. CHAR 00320I******************************************************************* 00330IBITTAB BT 00340I 1 33 BIT 00350I******************************************************************* 00360IMGFILE MG 00370I* MESSAGE FILE. 00380I 1 35 MGTEXT 00390I****************************************************************** 00400ICR2FILE CR 00410I* CUSTOMER NO. 5N 00420I 1 50CRCUST 00430I* SORT KEY 20A 00440I 6 25 CRSORT 00450I* ADDRESS 35A X 7 00460I 26 270 CRA 00470I* STATE CODE 2A 00480I 271 272 CRSTCD 00490I* ZIP CODE 9P 00500I P 273 2770CRZIP ÐÐ00510I* PHONE NO. 15A 00520I 278 292 CRPHON 00530I* CONTACT NAME 35A 00540I 293 327 CRCONT 00550I* REMARKS 35A 00560I 328 362 CRREM 00570I* CUSTOMER CLASS 2A 00580I 363 3640CRCLAS 00590I* TERRITORY CODE 3A 00600I 365 367 CRTER 00610I* CREDIT LIMIT 7P 00620I P 368 3710CRCRLM 00630I* PAYMENT TERMS 8A 00640I 372 379 CRTERM 00650I* NUMBER OF INVOICE COPIES 1N 00660I 380 380 CRINV 00670I* SHIPPING METHOD 20A 00680I 381 400 CRSHIP 00690I* CURRENT BACKLOG 9.2P X 10 00700I P 401 450 CRB 00710I* LAST 12-MOS SHIPMENTS 9.2P X 10 00720I P 451 500 CRS 00730I* CURRENT RECEIVABLES 9.2P X 4 00740I P 501 520 CRAR 00750I* TAX CODE 1A ÐÐ00760I 521 521 CRTAX 00770I* STD DISCOUNT 3.2P 00780I P 522 5232CRDISC 00790I* EXPORT CODE 1A 00800I 524 524 CREXPT 00810I* DATE HISTORY 7P X 5 00820I P 525 544 CRD 00830I* GEOGRAPHIC CODE 5A 00840I 545 549 CRGEO 00850I* HOLD CODE 1A 00860I 550 550 CRHOLD 00870I* MAILING CODES. 00880I* MAILER CODES 3 X 3A 00890I 551 559 CRM 00900I* NUMB OF COPIES 3 X 2N 00910I 560 565 CRC 00920I* POINTERS. 00930I* CREDIT CHANGES 5P 00940I P 573 5750CRFCC 00950I* PREVIOUS SORT KEY 20A 00960I 577 596 CROSRT 00970I* START PROG NAME 6A 00980I 666 671 CRPROG 00990I* TRANSACTION CODE 1A 01000I 672 672 CRTRAN ÐÐ01010I******************************************************************** 01020ICMMAST CM 01030I* RECORD STATUS 1A 01040I 576 576 CMSTAT 01050C******************************************************************** 01060C* INITIALIZE 01070C EXSR SR101 1-TIME INIT 01080C MOVE ' ' BLK35 35 01090C*------------------------------------------------------------------ 01100C START TAG 01110C* SET-UP 1ST FIELD NO. 01120C Z-ADD5 F 30 FIELD # 01130C GOTO READ 01140C*------------------------------------------------------------------ 01150C NEXT TAG 01160C* SET-UP NEXT FIELD NO. 01170C 1 ADD F F FIELD # 01180C*----------------------------------------------------------------- 01190C READ TAG 01200C* READ DATA FROM TERMINAL. 01210C EXSR SR102 VALIDATE FIELD # 01220C 55 GOTO UPDATE DONE 01230C F COMP 3 54 NOT USED 01240C N54 F COMP 4 54 NOT USED 01250C 54 GOTO NEXT ÐÐ01260C EXSR SR107 CLASSIFY START 01270C N54 GOTO CONTU NOT SALES DEPT. 01280C* SALES DEPT. 01290C EXSR SR203 CLASSIFY TRAN. 01300C 62 F COMP 5 54 01310C 62 54 GOTO UPDATE 01320C F COMP 17 54 REMARKS 01330C N54 F COMP 22 54 TERMS. 01340C N54 F COMP 26 54 CREDIT LIMIT. 01350C N54 F COMP 27 54 HOLD. 01360C N54 F COMP 28 54 NUMB INVOICES. 01370C 54 GOTO NEXT 01380C GOTO CONTU2 01390C*------------------------------------------------------------------- 01400C CONTU TAG 01410C* ACCOUNTING DEPT. 01420C EXSR SR203 CLASSIFY TRAN. 01430C 62 F COMP 17 54 01440C 62 54 MOVEL'Q006CM' PROG 8 01450C 62 54 GOTO END 01460C Z-ADDF W3N 30 01470C F COMP 17 545555 01480C 55 Z-ADD17 F 01490C 55 GOTO CONTU2 01500C N54 GOTO CONTU2 ÐÐ01510C Z-ADD22 W3N 01520C F COMP 22 54 01530C N54 GOTO CONTU1 01540C Z-ADD26 W3N 01550C F COMP 26 54 01560C N54 GOTO CONTU1 01570C Z-ADD27 W3N 01580C F COMP 27 54 01590C N54 GOTO CONTU1 01600C Z-ADD28 W3N 01610C F COMP 28 54 55 01620C 54 GOTO UPDATE 01630C 55 GOTO CONTU2 01640C*------------------------------------------------------------------- 01650C CONTU1 TAG 01660C Z-ADDW3N F 01670C*------------------------------------------------------------------- 01680C CONTU2 TAG 01690C EXSR SR201 IDENTIFY-F. 01700C SETON 69 01710C EXSR SR72 PROMPT 01720C SETOF 69 01730C EXSR SR75 READ TERMINAL 01740C 98 GOTO GOODBY GOODBY 01750C 94 GOTO MENU MENU REQUEST ÐÐ01760C N77N88 EXSR SR104 EDIT INPUT FIELD 01770C 96 ERROR 01780CORN77N88 EXSR SR72 REWRITE INPUT DATA 01790C 93 GOTO NEWITM NEW ITEM 01800C 92 GOTO JUMP FIELD JUMP REQST 01810C 91 GOTO NEXT SKIP FORWARD 01820C 89 F SUB 1 F SKIP BACKWARD 01830C 89 GOTO READ " " 01840C 88 SETOF 90 SPACE FILL 01850C 88 SETON 77 " " 01860C 87 GOTO START 01870C 86 GOTO UPDATE UPDATE 01880C 85 GOTO READ REPEAT 01890C 96 GOTO ERROR ERROR 01900C N77 GOTO NEXT NO DATA INPUT 01910C*------------------------------------------------------------------ 01920C PROCES TAG 01930C* PROCESS INPUT DATA 01940C EXSR SR103 MOVE DATA 01950C N96 EXSR SR104 EDIT DATA 01960C EXSR SR72 REWRITE DATA 01970C 96 GOTO ERROR ERROR 01980C GOTO NEXT 01990C*------------------------------------------------------------------ 02000C UPDATE TAG ÐÐ02010C* UPDATE DATA BASE. 02020C EXSR SR105 FINAL EDIT 02030C 96 GOTO ERROR ERROR 02040C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 02050C MOVEL'Q004CM' PROG 8 02060C GOTO END 02070C*------------------------------------------------------------------- 02080C JUMP TAG 02090C* SET-UP JUMP TO REQUESTED FIELD 02100C 1 ADD W W 30 02110C W COMP 36 54 02120C 54 Z-ADD318 M 50 96 FLAG ERROR 02130C 54 GOTO ERROR BAD ESC 02140C MOVE '000' W3A 3 02150C MOVEAA36,W W3A 02160C Z-ADD3 W2N 20 02170C EXIT SUBRAJ R. JUSTIFY 02180C RLABL W2N 02190C RLABL W3A 02200C MOVE W3A F NEW FIELD # 02210C GOTO READ 02220C*-------------------------------------------------------------------- 02230C ERROR TAG 02240C EXSR SR102 VALIDATE FIELD # 02250C EXSR SR89 GET MSG ÐÐ02260C EXSR SR73 PUT MSG 02270C GOTO READ 02280C*------------------------------------------------------------------ 02290C NEWITM TAG 02300C* SET-UP LINK FOR NEW ITEM 02310C EXSR SR107 CLASSIFY START. 02320C 54 MOVEL'Q001CM' PROG 8 SALES. 02330C 55 MOVEL'Q007CM' PROG ACCTG. 02340C GOTO END 02350C*------------------------------------------------------------------- 02360C MENU TAG 02370C* SET-UP LINK TO MENU 02380C MOVEL'Q070DP' PROG 02390C GOTO END 02400C*-------------------------------------------------------------------- 02410C GOODBY TAG 02420C* LINK TO SIGN-OFF 02430C MOVEL'GOODBY' PROG 02440C GOTO END 02450C*------------------------------------------------------------------- 02460C END TAG 02470C EXSR SR97 UPDATE CR2FILE 02480C PROG COMP BLK8 54 02490C N54 MOVEL'Q070DP' PROG 02500C EXITFCHAIN LINK TO NEXT PROG ÐÐ02510C RLABL PROG 02520C********************************************************************* 02530CSR SR1 BEGSR 02540C* EDIT TRAN CODE. 02550CSR EXSR SR203 CLASSIFY TRAN. 02560CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 02570CSR ENDSR 02580C******************************************************************* 02590CSR SR2 BEGSR 02600C* EDIT CUSTOMER #. 02610CSR CRCUST COMP 0 54 02620CSRN54 Z-ADD45 M 96 FLAG ERROR. 02630CSRN54 GOTO END2 02640C* GET CUSTOMER MAST. 02650CSR EXSR SR106 GET CUST. 02660CSR END2 ENDSR 02670C******************************************************************** 02680CSR SR12 BEGSR 02690C* EDIT ADDRESS. 02700CSR BLK35 LOKUPCRA 54 02710CSRN54 Z-ADD117 M 96 FLAG ERROR. 02720CSR ENDSR 02730C********************************************************************* 02740CSR SR14 BEGSR 02750C* EDIT STATE CODE. ÐÐ02760CSR CRSTCD COMP ' ' 54 02770CSRN54 GOTO T14A NOT INPUT. 02780CSR CRA,7 COMP BLK35 54 02790CSR 54 Z-ADD118 M 96 FLAG ERROR. 02800CSR 54 GOTO END14 02810CSR CRSTCD LOKUPTABSTC 54 02820CSRN54 Z-ADD130 M 96 FLAG ERROR. 02830CSR GOTO END14 02840C*------------------------------------------------------------------- 02850CSR T14A TAG 02860C* STATE CODE IS BLANK. 02870CSR CRA,7 COMP BLK35 54 02880CSRN54 Z-ADD132 M 96 FLAG ERROR. 02890CSR END14 ENDSR 02900C********************************************************************* 02910CSR SR18 BEGSR 02920C* EDIT CUSTOMER CLASS. 02930CSR CRCLAS COMP 0 54 02940CSRN54 Z-ADD133 M 96 FLAG ERROR. 02950CSRN54 GOTO END18 02960CSR CRCLAS LOKUPTABCLC 54 02970CSRN54 Z-ADD134 M 96 FLAG ERROR. 02980CSRN54 GOTO END18 02990CSR CRCLAS COMP 20 54 54 03000CSR 54 CRCLAS COMP 39 5454 ÐÐ03010CSR 54 CRDISC COMP 0 54 03020CSR 54 Z-ADD30 CRDISC DEFAULT DISCOUNT 03030CSR END18 ENDSR 03040C******************************************************************** 03050CSR SR20 BEGSR 03060C* EDIT TAX CODE. 03070CSR GOTO END20 03080CSR CRTAX COMP ' ' 54 03090CSR 54 CRTAX LOKUPTABTAX 54 03100CSRN54 Z-ADD151 M 96 FLAG ERROR. 03110CSR END20 ENDSR 03120C********************************************************************* 03130CSR SR72 BEGSR 03140C* PUT DATA TO TERMINAL 03150CSR Z-ADDF W3N 30 03160CSR F COMP 6 54 54 03170CSR 54 1 ADD W3N W3N 03180CSR MOVE W3N LINE 3 LINE # 03190CSR 28 CRINV COMP ' ' 54 03200CSR 28N54 MOVE '2' CRINV 03210CSR SETON 72 03220CSR EXCPT PUT DATA 03230CSR SETOF 72 03240CSR ENDSR 03250C*********************************************************************** ÐÐ03260CSR SR73 BEGSR 03270C* PUT ERROR MESSAGE TO TERMINAL 03280CSR SETON 73 03290CSR EXCPT PUT MSG 03300CSR SETOF 73 03310CSR Z-ADDM LSTERR 50 03320CSR ENDSR 03330C******************************************************************* 03340CSR SR75 BEGSR 03350C* READ FROM TERMINAL 03360CSR SETOF 779096 03370CSR SETOF 939291 03380CSR SETOF 898887 03390CSR SETOF 8685 03400CSR MOVE BIT,19 A6,2 BUF LENGTH 03410CSR MOVEAA6 W6A 6 03420CSR MOVE BLK36 W36A 36 BUFFER 03430CSR EXITFXCREAD READ TERM 03440CSR RLABL W36A 03450CSR RLABL W6A 03460CSR MOVEAW36A A36 03470CSR MOVE BLK36 W36A 03480CSR Z-ADD1 W 30 03490CSR '\' LOKUPA36,W 90 FLAG ESC 03500CSRN90 GOTO T75B NOT ESC ÐÐ03510CSR 1 ADD W W 03520CSR W COMP 36 54 03530CSR 54 GOTO T75A BAD ESC 03540CSR A36,W COMP 'G' 98 GOODBY 03550CSR A36,W COMP 'E' 94 MENU 03560CSR A36,W COMP 'N' 93 NEW ITEM 03570CSR A36,W COMP 'J' 92 JUMP 03580CSR A36,W COMP 'F' 91 SKIP FRWRD 03590CSR A36,W COMP 'B' 89 SKIP BKWRD 03600CSR A36,W COMP 'S' 88 SPACE FILL 03610CSR A36,W COMP 'H' 87 HOME 03620CSR A36,W COMP 'U' 86 UPDATE 03630CSR A36,W COMP 'R' 85 REPEAT 03640CSR 98 03650COR 94 03660COR 93 03670COR 92 03680COR 91 03690COR 89 03700COR 88 03710COR 87 03720COR 86 03730COR 85 GOTO END75 GOOD ESC 03740C*------------------------------------------------------------------ 03750CSR T75A TAG ÐÐ03760C* FLAG BAD ESC INPUT 03770CSR Z-ADD318 M 96 FLAG ERROR 03780CSR GOTO END75 03790C*-------------------------------------------------------------------- 03800CSR T75B TAG 03810C* MOVE DATA 03820CSR Z-ADD1 W 03830CSR ' ' LOKUPA36,W 77 03840CSR 77 MOVEAA36,W W36A INPUT DATA 03850C*-------------------------------------------------------------------- 03860CSR END75 TAG 03870C* INIT PREV ERROR MSG. 03880CSR LSTERR COMP 0 54 03890CSR 54 MOVE BLK35 MGTEXT 03900CSR 54 EXSR SR73 BLANK MESSAGE 03910CSR Z-ADD0 LSTERR 50 03920CSR ENDSR 03930C********************************************************************** 03940CSR SR80 BEGSR 03950C* GET MASTER RECORD 03960CSR SETOF 61 03970CSR CRCUST CHAINCMMAST 60 GET MASTER 03980CSRN60 CMSTAT COMP 'D' 61 FLAG DELETE 03990CSR ENDSR 04000C********************************************************************** ÐÐ04010CSR SR89 BEGSR 04020C* GET MESSAGE MASTER 04030CSR M CHAINMGFILE 54 04040CSR 54 MOVE BLK35 MGTEXT 04050CSR 54 MOVELM MGTEXT 04060CSR 54 MOVE MES,1 MGTEXT 04070CSR ENDSR 04080C****************************************************************** 04090CSR SR97 BEGSR 04100C* UPDATE CR2FILE. 04110CSR SETON 97 04120CSR EXCPT UPDATE CR2FILE 04130CSR SETOF 97 04140CSR ENDSR 04150C*********************************************************************** 04160CSR SR101 BEGSR 04170C* 1-TIME INITIALIZE 04180CSR MOVE BIT,1 NUL 04190CSR MOVE BIT,1 A6 04200CSR Z-ADD34 FLIMIT 30 TOTAL NUMB FIELDS 04210CSR MOVE ' ' BLK36 36 04220C* GET PORT # AND CR2FILE 04230CSR MOVE ' ' W8A 8 04240CSR Z-ADD0 W2N 20 04250CSR Z-ADD0 W1N 10 ÐÐ04260CSR MOVE ' ' W2A 2 04270CSR EXITFPGMINX GET PORT # 04280CSR RLABL W8A 04290CSR RLABL W2N 04300CSR RLABL W1N 04310CSR RLABL W2A 04320CSR MOVE W2A PORT 20 PORT NO. 04330CSR PORT COMP 0 54 04340CSRN54 Z-ADD25 PORT DEFAULT 04350CSR PORT CHAINCR2FILE H9 04360CSR H9 GOTO END101 04370CSR SETON 141820 04380CSR EXSR SR103A GET TABLES. 04390CSR SETOF 141820 04400CSR SETOF 25 04410CSR XFOOTCRB TOTBKL 92 TOTAL BACKLOG. 04420CSR XFOOTCRS TOTSHP 92 TOTAL SHIPPED. 04430CSR XFOOTCRAR TOTAR 92 04440C* DEFINE WORK FIELDS,ETC. 04450CSR MOVE ' ' BLK6 6 04460CSR MOVE ' ' BLK8 8 04470CSR MOVE ' ' BLK20 20 04480CSR END101 ENDSR 04490C********************************************************************** 04500CSR SR102 BEGSR ÐÐ04510C* VALIDATE FIELD NO. 04520CSR F COMP 5 54 04530CSRN54 Z-ADD5 F 04540CSR F COMP FLIMIT 55 04550CSR 55 Z-ADD5 F 04560CSR ENDSR 04570C******************************************************************** 04580CSR SR103 BEGSR 04590C* MOVE INPUT DATA 04600CSR EXSR SR201 IDENTIFY-F 04610CSR EXSR SR202 R. JUSTIFY 04620CSR 01 MOVELW36A CRTRAN TRAN CODE. 04630CSR 02 MOVE W15A CRCUST CUST #. 04640CSR 05 MOVELW36A CRSORT ADDRESS 04650CSR 06 MOVELW36A CRA,1 ARRAY. 04660CSR 07 MOVELW36A CRA,2 04670CSR 08 MOVELW36A CRA,3 04680CSR 09 MOVELW36A CRA,4 04690CSR 10 MOVELW36A CRA,5 04700CSR 11 MOVELW36A CRA,6 04710CSR 12 MOVELW36A CRA,7 04720CSR 13 MOVE W15A CRZIP ZIP CODE. 04730CSR 14 MOVELW36A CRSTCD STATE CODE. 04740CSR 15 MOVELW36A CRPHON PHONE #. 04750CSR 16 MOVELW36A CRCONT CONTACT. ÐÐ04760CSR 17 MOVELW36A CRREM REMARKS. 04770CSR 18 MOVELW36A CRCLAS CUST CLASS. 04780CSR 19 MOVELW36A CREXPT EXPORT CODE. 04790CSR 20 MOVELW36A CRTAX TAX CODE. 04800CSR 21 MOVELW36A CRSHIP SHIP INSTR. 04810CSR 22 MOVELW36A CRTERM PAYMENT TERMS. 04820CSR 23 MOVE W15A CRDISC DISCOUNT %. 04830CSR 24 MOVELW36A CRGEO LOCATION CODE. 04840CSR 25 MOVELW36A CRTER TERRITORY 04850CSR 26 MOVE W15A CRCRLM CREDIT LIMIT. 04860CSR 27 MOVELW36A CRHOLD HOLD CODE. 04870CSR 28 MOVE W15A CRINV NUMB INVOICES. 04880CSR 29 MOVELW36A CRM,1 MAILER CODES. 04890CSR 30 MOVE W15A CRC,1 NUMB COPIES. 04900CSR 31 MOVELW36A CRM,2 04910CSR 32 MOVE W15A CRC,2 04920CSR 33 MOVELW36A CRM,3 04930CSR 34 MOVE W15A CRC,3 04940CSR MOVE ' ' DUN,F EDIT FLAG. 04950CSR EXSR SR103A 04960CSR ENDSR 04970C******************************************************************** 04980CSR SR103A BEGSR 04990C* GET FIELD DESCRIPTORS. 05000CSR 14 CRSTCD LOKUPTABSTC TABSCN 54 ÐÐ05010CSR 14 54 MOVE TABSCN STCNAM STATE NAME. 05020CSR 14N54 MOVE BLK20 STCNAM 20 05030CSR 18 CRCLAS LOKUPTABCLC TABCLN 54 05040CSR 18 54 MOVE TABCLN CLSNAM 20 CUST CLASS. 05050CSR 18N54 MOVE BLK20 CLSNAM 05060CSR 20 CRTAX LOKUPTABTAX TABTAN 54 05070CSR 20 54 MOVE TABTAN TAXNAM 20 TAX CODE NAME. 05080CSR 20N54 MOVE BLK20 TAXNAM 05090CSR 25 CRTER LOKUPTABTER TABTN 54 05100CSR 25 54 MOVE TABTN TERNAM 20 05110CSR 25N54 MOVE BLK20 TERNAM 05120CSR ENDSR 05130C******************************************************************** 05140CSR SR104 BEGSR 05150C* EDIT INPUT DATA 05160CSR 01 EXSR SR1 05170CSR 02 EXSR SR2 05180CSR 12 EXSR SR12 05190CSR 14 EXSR SR14 05200CSR 18 EXSR SR18 05210CSR 20 EXSR SR20 05220CSR 23 EXSR SR18 DISCOUNT DEFAULT 05230CSR 96 MOVE ' ' DUN,F EDIT FLAG 05240CSRN96 MOVE 'X' DUN,F 05250CSR ENDSR ÐÐ05260C*********************************************************************** 05270CSR SR105 BEGSR 05280C* FINAL EDIT 05290CSR SETON 79 FINAL EDIT FLAG 05300CSR Z-ADD1 F 05310C*-------------------------------------------------------------------- 05320CSR T105A TAG 05330CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05340CSRN54 GOTO END105 05350CSR EXSR SR201 IDENTIFY-F 05360CSR EXSR SR104 EDIT 05370CSR EXSR SR203 CLASSIFY TRAN. 05380CSR 62 F COMP 5 54 54 05390CSR 62 54 GOTO END105 05400CSRN96 GOTO T105A 05410C*-------------------------------------------------------------------- 05420CSR END105 TAG 05430CSR SETOF 79 05440CSR ENDSR 05450C******************************************************************** 05460CSR SR106 BEGSR 05470C* UPDATE DATA BASE. 05480CSR EXSR SR203 CLASSIFY TRAN 05490CSR 60 GOTO T106A ADD TRAN 05500CSR 61 GOTO T106D CHANGE TRAN ÐÐ05510CSR 62 GOTO T106F DELETE TRAN 05520C* FLAG BAD TRAN CODE 05530CSR Z-ADD300 M 96 FLAG ERROR 05540CSR Z-ADD3 F FIELD # 05550CSR GOTO END106 05560C*------------------------------------------------------------------- 05570CSR T106A TAG 05580C* ADD TRANSACTION 05590CSR EXSR SR80 GET MASTER 05600CSR 60 GOTO T106B NOT ON FILE 05610CSR 61 GOTO T106C DELETED MASTER 05620C* FLAG DUPLICATE ADD ERROR 05630CSR Z-ADD301 M 96 FLAG ERROR 05640CSR Z-ADD3 F FIELD # 05650CSR GOTO END106 05660C*--------------------------------------------------------------------- 05670CSR T106B TAG 05680C* ADD-- MAST NOT ON FILE 05690CSR GOTO END106 05700C*--------------------------------------------------------------------- 05710CSR T106C TAG 05720C* ADD-- MAST IS DELETED 05730CSR MOVE 'A' CMSTAT RECORD STATUS 05740CSR GOTO END106 05750C*---------------------------------------------------------------------- ÐÐ05760CSR T106D TAG 05770C* CHANGE TRANSACTION. 05780CSR EXSR SR80 GET MASTER 05790CSRN60N61 GOTO T106E GOT IT 05800C* FLAG NO MASTER ERROR 05810CSR Z-ADD302 M 96 FLAG ERROR 05820CSR Z-ADD3 F FIELD # 05830CSR GOTO END106 05840C*----------------------------------------------------------------------- 05850CSR T106E TAG 05860CSR GOTO END106 05870C*----------------------------------------------------------------------- 05880CSR T106F TAG 05890C* DELETE TRANSACTION 05900CSR EXSR SR80 GET MASTER 05910CSRN60N61 GOTO T106G GOT IT 05920C* FLAG NO MASTER ERROR 05930CSR Z-ADD302 M 96 FLAG ERROR 05940CSR Z-ADD3 F FIELD # 05950CSR GOTO END106 05960C*----------------------------------------------------------------------- 05970CSR T106G TAG 05980C* DELETE MASTER. 05990CSR EXSR SR204 CHECK FOR ACTIVITY 06000CSR 96 Z-ADD3 F FIELD # ÐÐ06010CSR 96 GOTO END106 ERROR 06020CSR MOVE 'D' CMSTAT RECORD STATUS 06030CSR END106 ENDSR 06040C******************************************************************** 06050CSR SR107 BEGSR 06060C* CLASSIFY START PROG. 06070CSR CRPROG COMP 'Q001CM' 54 SALES. 06080CSR CRPROG COMP 'Q007CM' 55 ACCTG. 06090CSR ENDSR 06100C************************************************************************ 06110CSR SR201 BEGSR 06120C* IDENTIFY FIELD NO. 06130CSR SETOF 010203 06140CSR SETOF 040506 06150CSR SETOF 070809 06160CSR SETOF 101112 06170CSR SETOF 131415 06180CSR SETOF 161718 06190CSR SETOF 192021 06200CSR SETOF 222324 06210CSR SETOF 252627 06220CSR SETOF 282930 06230CSR SETOF 313233 06240CSR SETOF 34 06250CSR F COMP 10 54 ÐÐ06260CSR 54 GOTO T201A 06270CSR F COMP 1 01 06280CSR F COMP 2 02 06290CSR F COMP 3 03 06300CSR F COMP 4 04 06310CSR F COMP 5 05 06320CSR F COMP 6 06 06330CSR F COMP 7 07 06340CSR F COMP 8 08 06350CSR F COMP 9 09 06360CSR F COMP 10 10 06370CSR GOTO END201 06380C*------------------------------------------------------------------- 06390CSR T201A TAG 06400CSR F COMP 20 54 06410CSR 54 GOTO T201B 06420CSR F COMP 11 11 06430CSR F COMP 12 12 06440CSR F COMP 13 13 06450CSR F COMP 14 14 06460CSR F COMP 15 15 06470CSR F COMP 16 16 06480CSR F COMP 17 17 06490CSR F COMP 18 18 06500CSR F COMP 19 19 ÐÐ06510CSR F COMP 20 20 06520CSR GOTO END201 06530C*------------------------------------------------------------------- 06540CSR T201B TAG 06550CSR F COMP 21 21 06560CSR F COMP 22 22 06570CSR F COMP 23 23 06580CSR F COMP 24 24 06590CSR F COMP 25 25 06600CSR F COMP 26 26 06610CSR F COMP 27 27 06620CSR F COMP 28 28 06630CSR F COMP 29 29 06640CSR F COMP 30 30 06650CSR F COMP 31 31 06660CSR F COMP 32 32 06670CSR F COMP 33 33 06680CSR F COMP 34 34 06690CSR END201 ENDSR 06700C********************************************************************** 06710CSR SR202 BEGSR 06720C* RIGHT JUSTIFY 06730CSR F LOKUPNUM 54 06740CSRN54 GOTO END202 NOT NUMERIC FIELD 06750CSR Z-ADD15 W2N 20 ÐÐ06760CSR MOVELW36A W15A 15 06770CSR EXIT SUBRAJ R. JUSTIFY 06780CSR RLABL W2N 06790CSR RLABL W15A 06800CSR END202 ENDSR 06810C*********************************************************************** 06820CSR SR203 BEGSR 06830C* CLASSIFY TRAN CODE 06840CSR CRTRAN COMP 'A' 60 ADD 06850CSR CRTRAN COMP 'C' 61 CHANGE 06860CSR CRTRAN COMP 'D' 62 DELETE 06870CSR ENDSR 06880C******************************************************************** 06890CSR SR204 BEGSR 06900C* FLAG ACTIVE ITEM ERROR. 06910C* * * * * BYPASS TEMPORARILY * * * * * 06920CSR GOTO END204 06930CSR TOTBKL COMP 0 54 06940CSRN54 TOTAR COMP 0 54 06950CSR 54 Z-ADD29 M 96 FLAG ERROR. 06960CSR END204 ENDSR 06970O******************************************************************** 06980OCR2FILE E 97 06990O CRCUST 5 07000O CRSORT 25 ÐÐ07010O CRA 270 07020O CRSTCD 272 07030O CRZIP 277P 07040O CRPHON 292 07050O CRCONT 327 07060O CRREM 362 07070O CRCLAS 364 07080O CRTER 367 07090O CRCRLM 371P 07100O CRTERM 379 07110O CRINV 380 07120O CRSHIP 400 07130O CRB 450P 07140O CRS 500P 07150O CRTAX 521 07160O CRAR 520P 07170O CRDISC 523P 07180O CREXPT 524 07190O CRD 544P 07200O CRGEO 549 07210O CRHOLD 550 07220O CRM 559 07230O CRC 565 07240O CRFCC 575P 07250O CROSRT 596 ÐÐ07260O CRTRAN 672 07270O******************************************************************** 07280OTERM132 E 72 07290O BIT,28 1 07300O 2 '8' 07310O LINE 5 07320O 8 '001' 07330O*................................................................... 07340O 02 29 '(2) CUSTOMER NUMBER' 07350O 02 CRCUSTZ 46 07360O 02 91 'DATE INPUT' 07370O 02 100 ':' 07380O 02 CRD,1 111 ' - - ' 07390O*................................................................... 07400O 03 96 'DATE LAST ORDER' 07410O 03 100 ':' 07420O 03 CRD,2 111 ' - - ' 07430O*................................................................... 07440O 04 100 'DATE LAST SHIPMENT' 07450O 04 CRD,3 111 ' - - ' 07460O*................................................................... 07470O 05 22 '(5) SORT KEY' 07480O 05 CRSORT 61 07490O 05 85 '1' 07500O 05 102 'CURRENT BACKLOG VALUE' ÐÐ07510O 05 112 'BY MONTH' 07520O*................................................................... 07530O 06 26 '(6) COMPANY NAME' 07540O 06 CRA,1 76 07550O 06 85 '2' 07560O 06 CRB,2 2 101 07570O*................................................................... 07580O 07 26 '(7) COMPANY NAME' 07590O 07 CRA,2 76 07600O 07 85 '3' 07610O 07 CRB,3 2 101 07620O*................................................................... 07630O 08 23 '(8) ADDRESS-1' 07640O 08 CRA,3 76 07650O 08 85 '4' 07660O 08 CRB,4 2 101 07670O*................................................................... 07680O 09 23 '(9) ADDRESS-2' 07690O 09 CRA,4 76 07700O 09 85 '5' 07710O 09 CRB,5 2 101 07720O*................................................................... 07730O 10 20 '(10) LINE-5' 07740O 10 CRA,5 76 07750O 10 85 '6' ÐÐ07760O 10 CRB,6 2 101 07770O*................................................................... 07780O 11 18 '(11) CITY' 07790O 11 CRA,6 76 07800O 11 85 '7' 07810O 11 CRB,7 2 101 07820O*................................................................... 07830O 12 29 '(12) FOREIGN COUNTRY' 07840O 12 CRA,7 76 07850O 12 85 '8' 07860O 12 CRB,8 2 101 07870O*................................................................... 07880O 13 22 '(13) ZIP CODE' 07890O 13 CRZIP Z 50 07900O 13 85 '9' 07910O 13 CRB,9 2 101 07920O*................................................................... 07930O 14 24 '(14) STATE CODE' 07940O 14 CRSTCD 43 07950O 14 STCNAM 65 07960O 14 89 '10-12' 07970O 14 CRB,102 101 07980O*................................................................... 07990O 15 23 '(15) TELEPHONE' 08000O 15 CRPHON 56 ÐÐ08010O 15 89 'TOTAL' 08020O 15 TOTBKL2 101 08030O*................................................................... 08040O 16 26 '(16) CONTACT NAME' 08050O 16 CRCONT 76 08060O 16 102 'LAST 12-MOS SHIPMENTS' 08070O*................................................................... 08080O 17 21 '(17) REMARKS' 08090O 17 CRREM 76 08100O 17 85 '1' 08110O 17 CRS,1 2 101 08120O*................................................................... 08130O 18 28 '(18) CUSTOMER CLASS' 08140O 18 CRCLAS 43 08150O 18 CLSNAM 66 08160O 18 85 '2' 08170O 18 CRS,2 2 101 08180O*................................................................... 08190O 19 25 '(19) EXPORT CODE' 08200O 19 CREXPT 42 08210O 19 85 '3' 08220O 19 CRS,3 2 101 08230O*................................................................... 08240O 20 22 '(20) TAX CODE' 08250O 20 CRTAX 42 ÐÐ08260O 20 TAXNAM 66 08270O 20 85 '4' 08280O 20 CRS,4 2 101 08290O*................................................................... 08300O 21 22 '(21) SHIP-VIA' 08310O 21 CRSHIP 61 08320O 21 85 '5' 08330O 21 CRS,5 2 101 08340O*................................................................... 08350O 22 27 '(22) PAYMENT TERMS' 08360O 22 CRTERM 49 08370O 22 85 '6' 08380O 22 CRS,6 2 101 08390O*................................................................... 08400O 23 28 '(23) STD DISCOUNT %' 08410O 23 CRDISCZ 45 08420O 23 85 '7' 08430O 23 CRS,7 2 101 08440O*................................................................... 08450O 24 29 '(24) GEOGRAPHIC CODE' 08460O 24 CRGEO 46 08470O 24 85 '8' 08480O 24 CRS,8 2 101 08490O*................................................................... 08500O 25 28 '(25) TERRITORY CODE' ÐÐ08510O 25 CRTER 44 08520O 25 85 '9' 08530O 25 CRS,9 2 101 08540O*................................................................... 08550O 26 26 '(26) CREDIT LIMIT' 08560O 26 40 '$' 08570O 26 CRCRLM1 51 08580O 26 89 '10-12' 08590O 26 CRS,102 101 08600O*................................................................... 08610O 27 32 '(27) HOLD SHIPMENT CODE' 08620O 27 CRHOLD 42 08630O 27 89 'TOTAL' 08640O 27 TOTSHP2 101 08650O*................................................................... 08660O 28 31 '(28) NUMBER OF INVOICE' 08670O 28 39 'COPIES:' 08680O 28 CRINV 42 08690O 28 101 'CURRENT RECEIVABLES:' 08700O 28 TOTAR K 116 08710O*................................................................... 08720O 29 32 '(29) MAILER CODE-1 ' 08730O 29 CRM,1 44 08740O*................................................................... 08750O 30 32 '(30) CODE-1,NUMB COPIES' ÐÐ08760O 30 CRC,1 Z 44 08770O*................................................................... 08780O 31 32 '(31) MAILER CODE-2 ' 08790O 31 CRM,2 44 08800O*................................................................... 08810O 32 32 '(32) CODE-2,NUMB COPIES' 08820O 32 CRC,2 Z 44 08830O*................................................................... 08840O 33 32 '(33) MAILER CODE-3 ' 08850O 33 CRM,3 44 08860O*................................................................... 08870O 34 32 '(34) CODE-3,NUMB COPIES' 08880O 34 CRC,3 Z 44 08890O*................................................................... 08900O 39 ':' 08910O*---------------------------------------------------------------- 08920O 69 BIT,28 124 08930O 69 125 '8' 08940O 69 LINE 128 08950O 69 131 '034' 08960O 69 BIT,8 132 08970O*-------------------------------------------------------------- 08980O E 73 08990O* PUT ERROR MESSAGE 09000O BIT,28 1 ÐÐ09010O 8 '8030080' 09020O 96 19 '**********' 09030O MGTEXT 55 09040O 96 66 '**********' 09050O BIT,28 131 09060O 132 'K' ** TABSTC/TABSCN - STATE NAMES 009070 009080ALALABAMA 009090AKALASKA 009100AZARIZONA 009110ARARKANSAS 009120ASAMERICAN SAMOA 009130CACALIFORNIA 009140CZCANAL ZONE 009150COCOLORADO 009160CTCONNECTICUT 009170DEDELAWARE 009180DCDISTRICT OF COLUMBIA 009190FLFLORIDA 009200GAGEORGIA 009210GUGUAM 009220HIHAWAII 009230IDIDAHO 009240ILILLINOIS 009250ÐÐININDIANA 009260IAIOWA 009270KSKANSAS 009280KYKENTUCKY 009290LALOUISIANA 009300MEMAINE 009310MDMARYLAND 009320MAMASSACHUSETTS 009330MIMICHIGAN 009340MNMINNESOTA 009350MSMISSISSIPPI 009360MOMISSOURI 009370MTMONTANA 009380NENEBRASKA 009390NVNEVADA 009400NHNEW HAMPSHIRE 009410NJNEW JERSEY 009420NMNEW MEXICO 009430NYNEW YORK 009440NCNORTH CAROLINA 009450NDNORTH DAKOTA 009460OHOHIO 009470OKOKLAHOMA 009480OROREGON 009490PAPENNSYLVANIA 009500ÐÐPRPUERTO RICO 009510RIRHODE ISLAND 009520SCSOUTH CAROLINA 009530SDSOUTH DAKOTA 009540TNTENNESSEE 009550TTTRUST TERRITORIES 009560TXTEXAS 009570UTUTAH 009580VTVERMONT 009590VAVIRGINIA 009600VIVIRGIN ISLANDS 009610WAWASHINGTON 009620WVWEST VIRGINIA 009630WIWISCONSIN 009640WYWYOMING 009650** TABCLC/TABCLN - CUST CLASS NAMES 00966010COMMERCIAL END USER 00967015U.S. GOVERNMENT 00968020GENERAL O.E.M. 00969021BROADCAST O.E.M. 00970030GENERAL LINE DEALER 00971031BROADCAST DEALER 00972033BROADCAST DLR,BRANCH 00973034GEN LINE DLR,BRANCH 00974035DESIGNATED PROD DLR 009750ÐÐ50SPECIAL 00976060AVIONICS END USER 00977065AVIONICS OEM 00978070AVIONICS DISTRIB 00979075AVIONICS REPAIR SHOP 00980090AVIONICS SPECIAL 00981098TO BE DELETED 00982099DISCONTINUED DLR 009830** TABTAX/TABTAN - TAX CODE NAMES 0098401CA NON-TAXABLE,CARD 0098502CA NON-TAXABLE,NO CD 0098603NON-TAXABLE,US GOVT 0098704NON-TAXABLE,OTHER 0098805TAXABLE 009890** TABTER/TABTN - TERRITORY NAMES 009900 009910 009920 009930 009940 009950** NUL ARRAY 009960 009970** A6 ARRAY 009980 009990** A36 ARRAY 010000ÐÐ 010010** NUM ARRAY 010020002 010030003 010040013 010050018 010060023 010070026 010080028 010090030 010100032 010110034 010120** DUN ARRAY 010130 010140** MES ARRAY 010150---MESSAGE NOT ON FILE--- 010160/* 010170_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¯2 ¯IX003DH P120282120282(èÈÐ00010H Q003DH00020F* LIST DEPT HEADS. (X003DH) 00030F* REV 4/26/80 1:15 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FEMPLFILEIC F 64R14AI 1 DISK 00070FDEPTFILEIS F 32 12AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FTERM70 O F 70 5 00100E******************************************************************** 00110E A6 1 6 1 00120E NUL 1 70 1 00130E BIT 33 1 00140I******************************************************************** 00150IBITTAB BT 00160I 1 33 BIT 00170I******************************************************************** 00180IEMPLFILEEE 54 1 CE 00190I* RECORD CODE 2A 00200I* E = EMPLOYEE/USER CROSS-REF 00210I 1 1 EEREC 00220I* EMPLOYEE # 5N 00230I 2 60EEEMPL 00240I* USER-ID 8A 00250I 15 22 EEUSER ÐÐ00260I* EMPLOYEE NAME 20A 00270I 23 42 EENAME 00280I* EMPLOYEE DEPT # 5N 00290I 43 470EEDEPT 00300I* RECORD STATUS 1A 00310I 64 64 EESTAT 00320I*------------------------------------------------------------------- 00330I XX 54 00340I******************************************************************** 00350IDEPTFILEDH 01 1 CH 32NCD 00360I* RECORD CODE 1A 00370I* H = DEPT HEAD RECORD 00380I 1 1 DHREC 00390I* DEPT # 5N 00400I 2 60DHDEPT 00410I* DEPT HEAD EMPLOYEE # 5N 00420I 7 110DHHEAD 00430I* RECORD STATUS 1A 00440I 32 32 DHSTAT 00450I*------------------------------------------------------------------- 00460I XX 54 00470I******************************************************************** 00480IMGFILE MG 00490I* MESSAGE FILE 00500I* TEXT 35A ÐÐ00510I 1 35 MGTEXT 00520I* LINE-2 35A 00530I 36 70 MGLIN2 61 00540I* PROG NAME 5A 00550I 71 75 MGPROG 00560C******************************************************************** 00570C* PUT TITLE,CLEAR SCREEN 00580C 79 GOTO START 00590C MOVE BIT,1 NUL 00600C MOVE BIT,1 A6 00610C MOVE BIT,2 A6,2 00620C EXITFQTOPF CLEAR SCREEN 00630C SETON 70 00640C EXCPT 00650C SETOF 70 00660C SETON 79 00670C MOVE ' ' BLK13 13 00680C*------------------------------------------------------------------- 00690C START TAG 00700C* BYPASS NON-DEPT HEAD OR DELETED RECORDS 00710C N01 GOTO END 00720C* GET EMPLOYEE MASTER. 00730C MOVEL'E' W14A 14 00740C MOVE BLK13 W13A 13 00750C MOVELDHHEAD W13A ÐÐ00760C MOVE W13A W14A 00770C W14A CHAINEMPLFILE 60 00780C 60 MOVELBLK13 EENAME 00790C 60 MOVE BLK13 EENAME 00800C N60 EESTAT COMP 'D' 61 00810C COUNT COMP 55 54 54 00820C N54 GOTO NOHALT 00830C SETON 71 00840C EXCPT PAUSE. 00850C SETOF 71 00860C MOVE ' ' W2A 2 00870C MOVEAA6 W6A 6 00880C EXITFXCREAD 00890C RLABL W2A 00900C RLABL W6A 00910C MOVELW2A W1A 1 00920C W1A COMP '\' 54 00930C N54 MOVE W2A W1A 00940C N54 W1A COMP '\' 54 00950C N54 GOTO NOHALT 00960C SETON LR 00970C*------------------------------------------------------------------- 00980C NOHALT TAG 00990C 1 ADD COUNT COUNT 50 01000C*------------------------------------------------------------------- ÐÐ01010C END TAG 01020CLR SETON 72 01030CLR EXCPT 01040CLR SETOF 72 01050CLR MOVEAA6 W6A 01060CLR EXITFXCREAD 01070CLR RLABL W2A 01080CLR RLABL W6A 01090CLR MOVEL'QQDP01' PROG 8 01100CLR EXITFCHAIN 01110CLR RLABL PROG 01120O******************************************************************** 01130OTERM70 E 70 01140O* CLEAR CRT 01150O BIT,28 1 01160O 2 '8' 01170O 8 '001050' 01180O 23 'LIST DEPT HEADS' 01190O BIT,11 52 01200O*------------------------------------------------------------------- 01210O D 01 01220O* LIST DEPT HEAD RECORDS 01230O DHDEPTZ 5 01240O DHHEADZ 15 01250O EENAME 40 ÐÐ01260O 61 70 'DELETED EMPL MAST' 01270O 60 70 'NO MAST' 01280O*------------------------------------------------------------------- 01290O E 71 01300O* PAUSE. 01310O NUL 70 01320O 12 'CONTINUED...' 01330O 14 ' ' 01340O*------------------------------------------------------------------- 01350O E 72 01360O NUL 70 01370O BIT,11 1 01380O 20 'PRESS "CR" FOR MENU' 01390O 22 ' ' ** A6 ARRAY 001400 001410** NUL ARRAY 001420 001430/* 001440_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È2W ÈTX003DJ P120282120282(èÈÐ00010H Q003DJ00020F* LIST JOBS BY DEPARTMENT. (X003DJ) 00030F* REV 4/26/80 1:20 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FDEPTFILEIS F 32 12AI 1 DISK 00070FJOBFILE IC F 48R 7AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FTERM75 O F 75 5 00100E******************************************************************** 00110E NUL 1 75 1 00120E BIT 33 1 00130I******************************************************************** 00140IBITTAB BT 00150I 1 33 BIT 00160I******************************************************************** 00170IDEPTFILEDJ 01 1 CJ 32NCD 00180I* RECORD CODE 1A 00190I 1 1 DJREC 00200I* DEPT # 5N 00210I 2 60DJDEPT 00220I* SEQ # 3N 00230I 7 90DJSEQ 00240I* JOB CODE 6A 00250I 13 18 DJJOB ÐÐ00260I* RECORD STATUS 1A 00270I 32 32 DJSTAT 00280I*----------------------------------------------------------------- 00290I XX 54 00300I******************************************************************** 00310IJOBFILE JN 00320I* RECORD CODE 1A 00330I* N = JOB NAME RECORD 00340I 1 1 JNREC 00350I* JOB NAME 6A 00360I 2 7 JNJOB 00370I* JOB DESCRIPTION 35A 00380I 8 42 JNDESC 00390I* RECORD STATUS 1A 00400I 48 48 JNSTAT 00410I******************************************************************** 00420IMGFILE MG 00430I* MESSAGE FILE 00440I* TEXT 35A 00450I 1 35 MGTEXT 00460I* LINE-2 35A 00470I 36 70 MGLIN2 61 00480I* PROG NAME 5A 00490I 71 75 MGPROG 00500C******************************************************************** ÐÐ00510C* INITIALIZE, CLEAR SCREEN 00520C 79 GOTO START 00530C SETON 79 00540C MOVE BIT,1 NUL 00550C MOVELBIT,1 BUFLGT 2 00560C MOVE BIT,2 BUFLGT 00570C MOVE ' ' BLK35 35 00580C EXITFQTOPF CLEAR CRT 00590C SETON 70 00600C EXCPT 00610C SETOF 70 00620C*------------------------------------------------------------------- 00630C START TAG 00640C* BYPASS NON-DEPT/JOB OR DELETED RECORDS 00650C N01 GOTO END 00660C* GET JOB MASTER. 00670C MOVEL'N' W7A 7 00680C MOVE DJJOB W7A 00690C W7A CHAINJOBFILE 60 00700C SETOF 61 00710C 60 MOVE BLK35 JNDESC 00720C N60 JNSTAT COMP 'D' 61 00730C COUNT COMP 28 54 54 00740C N54 GOTO NOHALT 00750C SETON 71 ÐÐ00760C EXCPT PAUSE. 00770C SETOF 71 00780C Z-ADD2 COUNT 00790C MOVE ' ' W2A 2 00800C EXSR SR102 READ CRT 00810C MOVELW2A W1A 1 00820C W1A COMP '\' 54 00830C N54 MOVE W2A W1A 00840C N54 W1A COMP '\' 54 00850C N54 GOTO NOHALT 00860C SETON LR 00870C*------------------------------------------------------------------- 00880C NOHALT TAG 00890C 1 ADD COUNT COUNT 50 00900C*------------------------------------------------------------------- 00910C END TAG 00920CLR SETON 72 00930CLR EXCPT 00940CLR EXSR SR102 00950CLR MOVEL'QQDP01' PROG 8 00960CLR EXITFCHAIN 00970CLR RLABL PROG 00980C******************************************************************** 00990CSR SR102 BEGSR 01000C* READ CRT. ÐÐ01010CSR MOVE ' ' W2A 2 01020CSR EXITFQWREED 01030CSR RLABL W2A 01040CSR RLABL BUFLGT 01050CSR ENDSR 01060O******************************************************************** 01070OTERM75 E 70 01080O* PUT HEADING. 01090O BIT,28 1 01100O 2 '8' 01110O 8 '001055' 01120O 31 'LIST JOBS BY DEPARTMENT' 01130O BIT,11 75 01140O*------------------------------------------------------------------- 01150O D 01 01160O* LIST JOBS 01170O DJDEPTZ 5 01180O DJSEQ Z 13 01190O U1 DJJOB 60 01200O JNDESC 51 01210O 60 75 'NO MAST' 01220O 61 75 'DELETED' 01230O*------------------------------------------------------------------- 01240O E 71 01250O* PAUSE. ÐÐ01260O NUL 75 01270O 12 'CONTINUED...' 01280O 14 ' ' 01290O*------------------------------------------------------------------- 01300O E 72 01310O NUL 75 01320O BIT,14 1 01330O BIT,11 2 01340O 19 'PRESS "CR" FOR MENU' 01350O 21 ' ' ** NUL ARRAY 001360 001370/* 001380_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(>2Ì >X030XP P081883081883(èÈÐ ÐÐ ÐÐ _‚_‚ ÐÈ(–2× –?X003EE P120282120282(èÈÐ00010H Q003EE00020F* LIST EMPLOYEE MASTERS. (X003EE) 00030F* REV 4/26/80 1:35 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FEMPLFILEIS F 64 14AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FTERM75 O F 75 5 00090E******************************************************************** 00100E A6 1 6 1 00110E NUL 1 75 1 00120E BIT 33 1 00130I******************************************************************** 00140IBITTAB BT 00150I 1 33 BIT 00160I******************************************************************** 00170IEMPLFILEEE 01 1 CE 64NCD 00180I* RECORD CODE 1A 00190I* E = EMPLOYEE/USER CROSS-REF 00200I 1 1 EEREC 00210I* EMPLOYEE # 5N 00220I 2 60EEEMPL 00230I* USER-ID 8A 00240I 15 22 EEUSER 00250I* EMPLOYEE NAME 20A ÐÐ00260I 23 42 EENAME 00270I* EMPLOYEE DEPT # 5N 00280I 43 470EEDEPT 00290I* RECORD STATUS 1A 00300I 64 64 EESTAT 00310I*------------------------------------------------------------------- 00320I XX 54 00330I******************************************************************** 00340IMGFILE MG 00350I* MESSAGE FILE 00360I* TEXT 35A 00370I 1 35 MGTEXT 00380I* LINE-2 35A 00390I 36 70 MGLIN2 61 00400I* PROG NAME 5A 00410I 71 75 MGPROG 00420C******************************************************************** 00430C* INITIALIZE, CLEAR SCREEN 00440C 79 GOTO START 00450C SETON 79 00460C MOVE BIT,1 NUL 00470C MOVE BIT,1 A6 00480C MOVE BIT,2 A6,2 00490C MOVE ' ' BLK35 35 00500C EXITFQTOPF CLEAR CRT ÐÐ00510C SETON 70 00520C EXCPT 00530C SETOF 70 00540C*------------------------------------------------------------------- 00550C START TAG 00560C* BYPASS NON-DEPT/JOB OR DELETED RECORDS 00570C N01 GOTO END 00580C COUNT COMP 55 54 54 00590C N54 GOTO NOHALT 00600C SETON 71 00610C EXCPT PAUSE. 00620C SETOF 71 00630C MOVE ' ' W2A 2 00640C MOVEAA6 W6A 6 00650C EXITFXCREAD 00660C RLABL W2A 00670C RLABL W6A 00680C MOVELW2A W1A 1 00690C W1A COMP '\' 54 00700C N54 MOVE W2A W1A 00710C N54 W1A COMP '\' 54 00720C N54 GOTO NOHALT 00730C SETON LR 00740C*------------------------------------------------------------------- 00750C NOHALT TAG ÐÐ00760C 1 ADD COUNT COUNT 50 00770C*------------------------------------------------------------------- 00780C END TAG 00790CLR SETON 72 00800CLR EXCPT 00810CLR SETOF 72 00820CLR MOVEAA6 W6A 00830CLR EXITFXCREAD 00840CLR RLABL W2A 00850CLR RLABL W6A 00860CLR MOVEL'QQDP01' PROG 8 00870CLR EXITFCHAIN 00880CLR RLABL PROG 00890O******************************************************************** 00900OTERM75 E 70 00910O* CLEAR SCREEN 00920O BIT,28 1 00930O 2 '8' 00940O 8 '001055' 00950O 29 'LIST EMPLOYEE MASTERS' 00960O BIT,11 75 00970O*------------------------------------------------------------------- 00980O D 01 00990O* LIST EMPLOYEES. 01000O EEEMPLZ 5 ÐÐ01010O EEUSER 16 01020O EENAME 55 01030O EEDEPTZ 65 01040O*------------------------------------------------------------------- 01050O E 71 01060O* PAUSE. 01070O NUL 75 01080O 12 'CONTINUED...' 01090O 14 ' ' 01100O*------------------------------------------------------------------- 01110O E 72 01120O NUL 75 01130O BIT,11 1 01140O 20 'PRESS "CR" FOR MENU' 01150O 22 ' ' ** A6 ARRAY 001160 001170** NUL ARRAY 001180 001190/* 001200_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(3 §X003EG P120282120282(èÈÐ00010H Q003EG00020F* SORT ENGINEERING TASK TABLES. (X003EG) 00030F* REVISED 5/08/80 11:00 AM. 00040FEGTABLE IP F 1202 DISK 00050FEGTABOUTO F 1202 DISK 00060E********************************************************************* 00070E M1 12 60 1 A MAN 00080E N1 1 60 12 NAME 00090E M3 12 300 1 A MAN 00100E B3 3 300 4 START 00110E J3 12 300 1 JOB 00120E S3 12 300 1 SKILL 00130E E3 3 300 4 STOP 00140E H3 3 300 4 HRS 00150E P3 6 300 2 % 00160E J4 10 100 1 A JOB 00170E D4 1 100 12 DESCR 00180E W4 2 100 6 WO # 00190E J5 12 300 1 A JOB 00200E B5 3 300 4 START 00210E S5 12 300 1 SKILL 00220E H5 3 300 4 HRS 00230E E5 3 300 4 STOP 00240E P5 6 300 2 % 00250E S6 12 60 1 SKILL ÐÐ00260E T6 1 60 12 TITLE 00270E REC 1200 1 00280E* ARRAY STRUCTURE. 00290E* * M1+* * * * * * 1. MAN - M,N 00300E* * * N1 * * * * * 1.1 NAME - M,N 00310E*------------------------------------------------------------------- 00320E* * M3+* * * * * * 3. MAN - M,S,J,B,H,E 00330E* * * B3+* * * * * 3.1 START-M,S,J,B,H,E 00340E* * * * J3+* * * * 3.2 JOB -M,S,J,B,H,E 00350E* * * * * S3+* * * 3.3 SKILL-M,S,J,B,H,E 00360E* * * * * * E3 * * 3.4 STOP -M,S,J,B,H,E 00370E* * * * * * * H3 * 3.5 HRS -M,S,J,B,H,E 00380E* * * * * * * * P3 3.6 % -M,S,J,B,H,E 00390E*------------------------------------------------------------------- 00400E* * J4+* * * * * * 4. JOB -J,D,W 00410E* * * W4 * * * * * 4.1 NUMB -J,D,W 00420E* * * * D4 * * * * 4.2 DESCR-J,D,W 00430E*------------------------------------------------------------------- 00440E* * J5+* * * * * * 5. JOB -J,S,H,B,P,E 00450E* * * B5+* * * * * 5.1 START-J,S,H,B,P,E 00460E* * * * S5+* * * * 5.2 SKILL-J,S,H,B,P,E 00470E* * * * * E5 * * * 5.3 STOP -J,S,H,B,P,E 00480E* * * * * * H5 * * 5.4 HRS -J,S,H,B,P,E 00490E* * * * * * * P5 * 5.5 % -J,S,H,B,P,E 00500E*------------------------------------------------------------------- ÐÐ00510E* * S6+* * * * * * 6. SKILL-S,T 00520E* * * T6 * * * * * 6.1 TITLE-S,T 00530E*------------------------------------------------------------------- 00540E* + INDICATES CONTROL FIELDS IN ARRAY GROUP 00550E* M = MAN CODE 00560E* N = MAN NAME 00570E* S = SKILL 00580E* J = JOB CODE 00590E* B = START DATE 00600E* H = HRS AVAIL/REQD 00610E* P = PER CENT CMPLT 00620E* T = SKILL TITLE 00630E* D = JOB DESCRIPTION 00640E* W = JOB # 00650E* E = STOP DATE 00660I******************************************************************** 00670IEGTABLE EG 01 00680I 1 20EGNO 00690I 31202 REC 00700C******************************************************************** 00710C EGNO COMP 1 01 00720C EGNO COMP 2 02 00730C EGNO COMP 3 03 00740C EGNO COMP 4 04 00750C EGNO COMP 5 05 ÐÐ00760C EGNO COMP 6 06 00770C EGNO COMP 7 07 00780C EGNO COMP 8 08 00790C EGNO COMP 9 09 00800C EGNO COMP 10 10 00810C EGNO COMP 11 11 00820C EGNO COMP 12 12 00830C EGNO COMP 13 13 00840C EGNO COMP 14 14 00850C EGNO COMP 15 15 00860C EGNO COMP 16 16 00870C EGNO COMP 17 17 00880C EGNO COMP 18 18 00890C EGNO COMP 19 19 00900C EGNO COMP 20 20 00910C 01 MOVEAREC M1 00920C 02 MOVEAREC N1 00930C 03 MOVEAREC M3 00940C 04 MOVEAREC B3 00950C 05 MOVEAREC J3 00960C 06 MOVEAREC S3 00970C 07 MOVEAREC E3 00980C 08 MOVEAREC H3 00990C 09 MOVEAREC P3 01000C 10 MOVEAREC J4 ÐÐ01010C 11 MOVEAREC D4 01020C 12 MOVEAREC W4 01030C 13 MOVEAREC J5 01040C 14 MOVEAREC B5 01050C 15 MOVEAREC S5 01060C 16 MOVEAREC H5 01070C 17 MOVEAREC E5 01080C 18 MOVEAREC P5 01090C 19 MOVEAREC S6 01100C 20 MOVEAREC T6 01110CLR EXSR SR101 MAN/NAME 01120CLR EXSR SR102 MAN/SCHED 01130CLR EXSR SR103 JOB/DESCR 01140CLR EXSR SR104 JOB/SCHED 01150CLR EXSR SR105 SKILL/TITLE 01160C******************************************************************** 01170CSR SR101 BEGSR 01180C* SORT MAN/NAME TABLES. 01190CSR Z-ADD0 A 30 01200C*------------------------------------------------------------------- 01210CSR T101A TAG 01220CSR 1 ADD A A 01230CSR A COMP 60 54 01240CSR 54 GOTO END101 01250CSR Z-ADDA B 30 ÐÐ01260C*------------------------------------------------------------------- 01270CSR T101B TAG 01280CSR 1 ADD B B 01290CSR B COMP 60 54 01300CSR 54 GOTO T101A 01310CSR N1,A COMP N1,B 54 01320CSRN54 GOTO T101B 01330CSR MOVE N1,A NAME 12 01340CSR MOVE M1,A MANCOD 1 01350CSR MOVE N1,B N1,A 01360CSR MOVE M1,B M1,A 01370CSR MOVE MANCOD M1,B 01380CSR MOVE NAME N1,B 01390CSR GOTO T101B 01400CSR END101 ENDSR 01410C******************************************************************** 01420CSR SR102 BEGSR 01430C* SORT MAN/SCHED TABLE. 01440CSR Z-ADD0 A 01450C*------------------------------------------------------------------- 01460CSR T102A TAG 01470CSR 1 ADD A A 01480CSR A COMP 300 54 01490CSR 54 GOTO END102 01500CSR Z-ADDA B ÐÐ01510C*------------------------------------------------------------------- 01520CSR T102B TAG 01530CSR 1 ADD B B 01540CSR B COMP 300 54 01550CSR 54 GOTO T102A NO SWAP 01560CSR M3,A COMP M3,B 54 55 01570CSRN54N55 GOTO T102B NO SWAP 01580CSRN54 GOTO T102C MAN IS EQUAL 01590CSR GOTO T102F SWAP 01600C*------------------------------------------------------------------- 01610CSR T102C TAG 01620CSR B3,A COMP B3,B 54 55 01630CSRN54N55 GOTO T102B NO SWAP 01640CSRN54 GOTO T102D START IS EQUAL 01650CSR GOTO T102F SWAP 01660C*------------------------------------------------------------------- 01670CSR T102D TAG 01680CSR J3,A COMP J3,B 54 55 01690CSRN54N55 GOTO T102B NO SWAP 01700CSRN54 GOTO T102E JOB IS EQUAL 01710CSR GOTO T102F SWAP 01720C*------------------------------------------------------------------- 01730CSR T102E TAG 01740CSR S3,A COMP S3,B 54 01750CSRN54 GOTO T102B NO SWAP ÐÐ01760C*------------------------------------------------------------------- 01770CSR T102F TAG 01780CSR MOVE M3,A MANCOD 01790CSR MOVE J3,A JOBCOD 1 01800CSR MOVE B3,A START 40 01810CSR MOVE S3,A SKLCOD 1 01820CSR MOVE E3,A STOP 40 01830CSR MOVE H3,A HOURS 40 01840CSR MOVE P3,A PERCNT 22 01850CSR MOVE M3,B M3,A 01860CSR MOVE J3,B J3,A 01870CSR MOVE B3,B B3,A 01880CSR MOVE S3,B S3,A 01890CSR MOVE E3,B E3,A 01900CSR MOVE H3,B H3,A 01910CSR MOVE P3,B P3,A 01920CSR MOVE MANCOD M3,B 01930CSR MOVE JOBCOD J3,B 01940CSR MOVE START B3,B 01950CSR MOVE SKLCOD S3,B 01960CSR MOVE STOP E3,B 01970CSR MOVE HOURS H3,B 01980CSR MOVE PERCNT P3,B 01990CSR GOTO T102B 02000CSR END102 ENDSR ÐÐ02010C******************************************************************** 02020CSR SR103 BEGSR 02030C* SORT JOB/DESCR. 02040CSR Z-ADD0 A 02050C*------------------------------------------------------------------ 02060CSR T103A TAG 02070CSR 1 ADD A A 02080CSR A COMP 100 54 02090CSR 54 GOTO END103 02100CSR Z-ADDA B 02110C*------------------------------------------------------------------- 02120CSR T103B TAG 02130CSR 1 ADD B B 02140CSR B COMP 100 54 02150CSR 54 GOTO T103A 02160CSR W4,A COMP W4,B 54 02170CSRN54 GOTO T103B NO SWAP 02180CSR MOVE J4,A JOBCOD 02190CSR MOVE W4,A JOBNO 6 02200CSR MOVE D4,A DESCR 12 02210CSR MOVE J4,B J4,A 02220CSR MOVE W4,B W4,A 02230CSR MOVE D4,B D4,A 02240CSR MOVE JOBCOD J4,B 02250CSR MOVE JOBNO W4,B ÐÐ02260CSR MOVE DESCR D4,B 02270CSR GOTO T103B 02280CSR END103 ENDSR 02290C******************************************************************** 02300CSR SR104 BEGSR 02310C* SORT JOB/SCHED TABLE. 02320CSR Z-ADD0 A 02330C*------------------------------------------------------------------- 02340CSR T104A TAG 02350CSR 1 ADD A A 02360CSR A COMP 300 54 02370CSR 54 GOTO END104 02380CSR Z-ADDA B 02390C*------------------------------------------------------------------- 02400CSR T104B TAG 02410CSR 1 ADD B B 02420CSR B COMP 300 54 02430CSR 54 GOTO T104A 02440CSR J5,A COMP J5,B 54 55 02450CSRN54N55 GOTO T104B NO SWAP 02460CSRN54 GOTO T104C JOB CODE IS EQUAL 02470CSR GOTO T104F SWAP 02480C*------------------------------------------------------------------- 02490CSR T104C TAG 02500CSR B5,A COMP B5,B 54 55 ÐÐ02510CSRN54N55 GOTO T104B NO SWAP 02520CSRN54 GOTO T104D START IS EQUAL 02530CSR GOTO T104F SWAP 02540C*------------------------------------------------------------------- 02550CSR T104D TAG 02560CSR S5,A COMP S5,B 54 55 02570CSRN54N55 GOTO T104B NO SWAP 02580CSRN54 GOTO T104E SKILL IS EQUAL 02590CSR GOTO T104F SWAP 02600C*------------------------------------------------------------------- 02610CSR T104E TAG 02620CSR E5,A COMP E5,B 54 02630CSRN54 GOTO T104B NO SWAP 02640C*------------------------------------------------------------------- 02650CSR T104F TAG 02660CSR MOVE J5,A JOBCOD 02670CSR MOVE B5,A START 02680CSR MOVE S5,A SKLCOD 02690CSR MOVE E5,A STOP 02700CSR MOVE H5,A HOURS 02710CSR MOVE P5,A PERCNT 02720CSR MOVE J5,B J5,A 02730CSR MOVE B5,B B5,A 02740CSR MOVE S5,B S5,A 02750CSR MOVE E5,B E5,A ÐÐ02760CSR MOVE H5,B H5,A 02770CSR MOVE P5,B P5,A 02780CSR MOVE JOBCOD J5,B 02790CSR MOVE START B5,B 02800CSR MOVE SKLCOD S5,B 02810CSR MOVE STOP E5,B 02820CSR MOVE HOURS H5,B 02830CSR MOVE PERCNT P5,B 02840CSR GOTO T104B 02850CSR END104 ENDSR 02860C******************************************************************** 02870CSR SR105 BEGSR 02880C* SORT SKILL/TITLE TABLE. 02890CSR Z-ADD0 A 02900C*------------------------------------------------------------------- 02910CSR T105A TAG 02920CSR 1 ADD A A 02930CSR A COMP 60 54 02940CSR 54 GOTO END105 02950CSR Z-ADDA B 02960C*------------------------------------------------------------------- 02970CSR T105B TAG 02980CSR 1 ADD B B 02990CSR B COMP 60 54 03000CSR 54 GOTO T105A ÐÐ03010CSR T6,A COMP T6,B 54 03020CSRN54 GOTO T105B NO SWAP 03030CSR MOVE S6,A SKLCOD 03040CSR MOVE T6,A TITLE 12 03050CSR MOVE S6,B S6,A 03060CSR MOVE T6,B T6,A 03070CSR MOVE SKLCOD S6,B 03080CSR MOVE TITLE T6,B 03090CSR GOTO T105B 03100CSR END105 ENDSR 03110O******************************************************************** 03120OEGTABOUTD 01 03130O EGNO 2 03140O REC 1202 ** 003150 003160** 003170 003180** 003190 003200** 003210 003220** 003230 003240** 003250ÐÐ 003260** 003270 003280** 003290 003300** 003310 003320** 003330 003340** 003350 003360** 003370 003380** 003390 003400** 003410 003420** 003430 003440** 003450 003460** 003470 003480** 003490 003500ÐÐ** 003510 003520** 003530 003540/* 003550_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(–3¿ –?X003EJ P120282120282(èÈÐ00010H Q003EJ00020F* LIST EMPLOYEE/JOB RECORDS. (X003EJ) 00030F* REV 4/26/80 2:30 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FEMPLFILEIS F 64 14AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FTERM75 O F 75 5 00090E******************************************************************** 00100E NUL 1 75 1 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160IEMPLFILEEE 01 1 CJ 64NCD 00170I* RECORD CODE 1A 00180I* J = EMPLOYEE/JOB 00190I 1 1 EJREC 00200I* EMPLOYEE # 5N 00210I 2 60EJEMPL 00220I* SEQUENCE # 3N 00230I 7 90EJSEQ 00240I* DESCRIPTION 35A 00250I 15 49 EJDESC ÐÐ00260I* JOB CODE 6A 00270I 50 55 EJJOB 00280I 56 600EJDEPT 00290I* RECORD STATUS 1A 00300I 64 64 EJSTAT 00310I*------------------------------------------------------------------- 00320I XX 54 00330I******************************************************************** 00340IMGFILE MG 00350I* MESSAGE FILE 00360I* TEXT 35A 00370I 1 35 MGTEXT 00380I* LINE-2 35A 00390I 36 70 MGLIN2 61 00400I* PROG NAME 5A 00410I 71 75 MGPROG 00420C******************************************************************** 00430C* INITIALIZE, CLEAR SCREEN 00440C 79 GOTO START 00450C SETON 79 00460C MOVE BIT,1 NUL 00470C MOVELBIT,1 BUFLGT 2 00480C MOVE BIT,2 BUFLGT 00490C MOVE ' ' BLK35 35 00500C EXITFQTOPF CLEAR CRT ÐÐ00510C SETON 70 00520C EXCPT 00530C SETOF 70 00540C*------------------------------------------------------------------- 00550C START TAG 00560C* BYPASS NON-EMPL/JOB OR DELETED RECORDS 00570C N01 GOTO END 00580C COUNT COMP 28 54 54 00590C N54 GOTO NOHALT 00600C SETON 71 00610C EXCPT PAUSE. 00620C SETOF 71 00630C Z-ADD2 COUNT 00640C MOVELBIT,1 BUFLGT 2 00650C MOVE BIT,2 BUFLGT 00660C MOVE ' ' W2A 2 00670C EXITFQWREED READ TERM 00680C RLABL W2A 00690C RLABL BUFLGT 00700C MOVELW2A W1A 1 00710C W1A COMP '\' 54 00720C N54 MOVE W2A W1A 00730C N54 W1A COMP '\' 54 00740C N54 GOTO NOHALT 00750C SETON LR ÐÐ00760C*------------------------------------------------------------------- 00770C NOHALT TAG 00780C 1 ADD COUNT COUNT 50 00790C*------------------------------------------------------------------- 00800C END TAG 00810CLR SETON 72 00820CLR EXCPT 00830CLR SETOF 72 00840CLR MOVE ' ' W2A 2 00850CLR MOVELBIT,1 BUFLGT 00860CLR MOVE BIT,2 BUFLGT 00870CLR EXITFQWREED 00880CLR RLABL W2A 00890CLR RLABL BUFLGT 00900CLR MOVEL'QQDP01' PROG 8 00910CLR EXITFCHAIN 00920CLR RLABL PROG 00930O******************************************************************** 00940OTERM75 E 70 00950O* CLEAR SCREEN 00960O BIT,28 1 00970O 2 '8' 00980O 8 '001055' 00990O 26 'LIST EMPLOYEE MENU' 01000O BIT,11 75 ÐÐ01010O*------------------------------------------------------------------- 01020O D 01 01030O* LIST EMPLOYEES. 01040O EJEMPLZ 5 01050O EJSEQ Z 12 01060O EJDESC 50 01070O EJJOB 65 01080O EJDEPTZ 73 01090O*------------------------------------------------------------------- 01100O E 71 01110O* PAUSE. 01120O NUL 75 01130O 12 'CONTINUED...' 01140O 14 ' ' 01150O*------------------------------------------------------------------- 01160O E 72 01170O NUL 75 01180O BIT,11 1 01190O 20 'PRESS "CR" FOR MENU' 01200O 22 ' ' ** NUL ARRAY 001210 001220/* 001230_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(3ÿ §X025WO P999999120282(èÈÐ00010H Q025WO00020F* PRINT JOBS BY WORK CENTER. (X025WO) 00030F* REVISED 11/24/82 11:40 AM. 00040F* 00050FWOOPADRTIR F 300 3 3IT EDISK 00060FWOOPER IP F 64R I DISK 00070FWOMAST IC F 228R 9AI 1 DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FWCMAST IC F 960R 8AI 1 DISK 00100FCALENDARIC F 22R 7AI 1 DISK 00110FPRINT O F 132 OF PRINTER 00120E******************************************************************** 00130E WOOPADRTWOOPER 00140E RCD 1 26 7 0 00150E REL 1 26 7 0A 00160E OPN 1 26 7 0A 00170E NR 1 26 7 0A 00180E A16 16 16 1 A 00190E BIT 33 1 00200E MHR 12 7 3A 00210E MDP 12 3 0 00220E PLT 8 3 0 00230I******************************************************************** 00240IWOOPER WP 01 64NCD 00250I* WORK ORDER OPER RECORD. ÐÐ00260I* WORK ORDER # 9A 00270I 1 9 WPORD L2 00280I* PRIME 6A 00290I 1 6 WPWOP 00300I* DASH 3N 00310I 7 90WPWOD 00320I* OPER SEQ # 3N 00330I 10 120WPSEQ L1 00340I 1 12 WPKEY 00350I* DEPT # 5N 00360I 13 170WPDEPTL4 00370I* WORK CENTER 3N 00380I 18 200WPWC L3 00390I 13 20 WPWHO 00400I* STD HRS - PER UNIT 00410I* SET-UP 9.3P 00420I P 25 293WPSSUH 00430I* RUN 9.3P 00440I P 30 343WPSRUN 00450I* ACTUAL HRS - TOTALS 00460I* SET-UP 7.1P 00470I P 35 381WPASUH 00480I* RUN 7.1P 00490I P 39 421WPARUN 00500I* QTY MOVED-IN 7P ÐÐ00510I P 43 460WPQIN 00520I* QTY MOVED-OUT 7P 00530I P 47 500WPQOUT 00540I* DUE DATE 6N 00550I 51 560WPDUE 00560I* DATE LAST TRAN 6N 00570I 58 630WPDLT 00580I* RECORD STATUS 1A 00590I 64 64 WPSTAT 00600I*------------------------------------------------------------------- 00610I GG 02 00620I* GARBAGE 00630I******************************************************************** 00640IWOMAST WO 00650I* WORK ORDER MASTER. 00660I* WORK ORDER NO. 00670I 1 9 WOWO 00680I* PRIME 6A 00690I 1 1 PREFIX 00700I 1 6 WOWOP 00710I* DASH 3N 00720I 7 90WOWOD 00730I* PART NO. 10N 00740I 10 190WOPN 00750I* TOP ASSY PN 10N ÐÐ00760I 20 290WOTAPN 00770I* RUN NO. 3N 00780I 30 320WORUN 00790I* PROD LINE 4N 00800I 33 360WOPL 00810I* SCHED QTY 7P 00820I P 37 400WOQTYS 00830I* RELEASED QTY 7P 00840I P 41 440WOQTYR 00850I* COMPLETED QTY 7P 00860I P 45 480WOQTYC 00870I* START DATE 6N (YMD) 00880I 49 540WOSTRT 00890I* DUE DATE 6N (YMD) 00900I 55 600WODUE 00910I* DATE ENTERED 6N (YMD) 00920I 61 660WODATE 00930I* DATE LAST REL 6N (YMD) 00940I 67 720WODLTR 00950I* DATE LAST COMPLETION 6N (YMD) 00960I 73 780WODLTC 00970I* DATE LAST LABOR 6N (YMD) 00980I 79 840WODLTL 00990I* DATE LAST MATL CHARGE 6N (YMD) 01000I 85 900WODLTM ÐÐ01010I* LABOR HRS CHARGED 7.1P 01020I P 91 941WOLABH 01030I* LABOR $ CHARGED 9.3P 01040I P 95 993WOLAB$ 01050I* MATL $ CHARGED 9.3P 01060I P 100 1043WOMAT$ 01070I* QTY TRSF 7P 01080I P 105 1080WOQTYT 01090I* AMOUNT TRANSFERRED 9.3P 01100I P 109 1133WO$T 01110I* REMARKS 35A 01120I 114 148 WODESC 01130I* MODEL 12A 01140I 149 160 WOSNTO 01150I* FAB CODE 2A 01160I 161 162 WOFAB 01170I* ALTERNATE BILL OF MATERIAL PART NO. 10N 01180I 163 1720WOABM 01190I* ALTERNATE ROUTING PART NO. 10N 01200I 173 1820WOARPN 01210I* DATE CLOSED 6N (YMD) 01220I 183 1880WOCLOS 01230I* RECORD STATUS 1A 01240I 228 228 WOSTAT 01250I******************************************************************** ÐÐ01260IWCMAST WC 01270I* WORK CENTER MASTER 01280I* WORK CENTER NAME 29A 01290I 9 37 WCDESC 01300I 960 960 WCSTAT 01310I**************************************************************** 01320ICALENDARCA 20 1 CC 01330I* CALENDAR DATE RECORD 01340I* CALENDAR DATE 6N (Y,M,D) 01350I 2 70CACAL 01360I* MFG DAY 4N 01370I 14 170CAMDAY 01380I* SEQUENTIAL WEEK # 3N 01390I 18 200CAWKNO 01400I* DAY OF WEEK 2N 01410I 21 220CADOW 01420I*-------------------------------------------------------------------- 01430I CB 21 1 CM 01440I* MFG DATE RECORD 01450I* MFG DATE 4N 01460I 4 70CAMDAY 01470I* CALDENDAR DATE 6N 01480I 8 130CACAL 01490I* SEQ WEEK # 3N 01500I 18 200CAWKNO ÐÐ01510I* DAY OF WEEK 2N 01520I 21 220CADOW 01530I******************************************************************** 01540IPMMST2 PM 01550I 1 100PMPN 01560I* 15 180PMPL 01570I 19 30 PMMODL 01580I 31 59 PMDESC 01590I* 70 71 PMECHG 01600I 94 95 PMSC 01610I* LEAD TIMES 3P X 8 01620I P 113 128 PLT 01630I* ON HAND BAL 01640I* P 311 3140PMOHB 01650I* REL REQS 7P 01660I* P 323 3260PMRLB 01670I* PURCH REQ BAL 7P 01680I* P 339 3420PMPRB 01690I* PO BAL 01700I* P 343 3460PMPOB 01710I* PLAN REQMT BAL 01720I* P 319 3220PMALB 01730I* FAB CODE 2A 01740I 487 488 PMFAB 01750I* MFG HRS 12 X 7.3P ÐÐ01760I P 543 590 MHR 01770I* MFG DEPTS 12 X 3P 01780I P 591 614 MDP 01790I 674 674 PMSTAT 01800C******************************************************************** 01810C L3 SETOF 7978 01820C N01 GOTO END 01830C L3 WPWHO CHAINWCMAST 54 01840C L3 54 MOVE BLK35 WCDESC 01850C L2 WPORD CHAINWOMAST 54 01860C L2 54 Z-ADD0 WOPN 01870C L2N54 MOVELWOPN W12A 12 01880C L2N54 MOVE ' ' W12A 01890C L2N54 W12A CHAINPMMST2 54 01900C L2 54 MOVE BLK35 PMMODL 01910C WPQIN SUB WPQOUT BAL 70 01920C BAL MULT WPSSUH HOURS 71H 01930C BAL MULT WPSRUN W7D1 71H 01940C W7D1 ADD HOURS HOURS 78 01950C HOURS ADD TOTHRS TOTHRS 71 79 01960C WPWOD COMP 0 55 01970C Z-ADDWPDLT DLT 40 01980C*------------------------------------------------------------------- 01990C END TAG 02000C LR MOVE ' ' BLK35 35 ÐÐ02010O******************************************************************** 02020OPRINT H 201 L4 02030O OR OF 02040O UDATE 8 ' - - ' 02050O 72 'WORK CENTER BACKLOG' 02060O 127 'PAGE' 02070O PAGE Z 132 02080O*------------------------------------------------------------------- 02090O H 1 L4 02100O OR OF 02110O 81 'SEQ' 02120O 121 'LAST' 02130O 131 'DATE' 02140O*------------------------------------------------------------------- 02150O H 2 L4 02160O OR OF 02170O 7 'DEPT' 02180O 53 'PART-NO.' 02190O 59 'MODEL' 02200O 75 'WORK-ORD' 02210O 81 'NO.' 02220O 88 'QTY-IN' 02230O 96 'QTY-OUT' 02240O 105 'QTY-BAL' 02250O 115 'HOURS' ÐÐ02260O 121 'TRAN' 02270O 130 'DUE' 02280O*------------------------------------------------------------------- 02290O D 1 L3 01 02300O 1 ' ' 02310O*------------------------------------------------------------------- 02320O D 1 01 02330O WPDEPTZ 5 02340O 56 6 '-' 02350O 56 WPWC 9 02360O WCDESC 40 02370O WOPN 53 ' - - ' 02380O PMMODL 66 02390O WPWOP 73 02400O 55 74 '-' 02410O 55 WPWOD 77 02420O WPSEQ Z 81 02430O WPQIN Z 88 02440O WPQOUTZ 96 02450O BAL Z 105 02460O HOURS 2 115 02470O DLT 121 ' - ' 02480O WPDUE 132 ' - - ' 02490O*------------------------------------------------------------------- 02500O TF12 L3 79 ÐÐ02510O TOTHRS2B 115 ** RCD ARRAY 02520 02530** REL ARRAY 02540 02550** OPN ARRAY 02560 02570** NR ARRAY 02580 02590** A16 ARRAY 002600 002610/* 002620_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(4§  XCDCTF P999999120282(èÈÐ SUBROUTINE ZCDCTF 00010* CLEAR CDC CRT (PUT HEX 18 CODE) 00020 DIMENSION IBUF (10) 000305 DO 10 I=1, 10 0004010 IBUF(I) = $0000 00050 ILU = 0 00060 IXY = -1 00070 N1 = 20 00080 N2 = 0 00090 ITC = 0 00100 IBUF(1) = $1800 00110 CALL WTREAD (ILU,IXY,IBUF,N1,IXY,IBUF,N2,ITC) 00120 RETURN 00130 END 00140_‚ _‚_‚ ÐÈ(‚4± ‚7X003EU P120282120282(èÈÐ00010H Q003EU00020F* LIST USERS. (X003EU) 00030F* REVISED 4/23/80 9:50 AM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FEMPLFILEIS F 64 14AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FTERM75 O F 75 5 00090E******************************************************************** 00100E A6 1 6 1 00110E NUL 1 75 1 00120E BIT 33 1 00130I******************************************************************** 00140IBITTAB BT 00150I 1 33 BIT 00160I******************************************************************** 00170IEMPLFILEEE 01 1 CU 64NCD 00180I* RECORD CODE 1A 00190I* U = USER/EMPLOYEE CROSS-REF 00200I 1 1 EUREC 00210I* USER-ID 8A 00220I 2 9 EUUSER 00230I* EMPLOYEE # 5N 00240I 15 190EUEMPL 00250I* RECORD STATUS 1A ÐÐ00260I 64 64 EUSTAT 00270I*----------------------------------------------------------------- 00280I XX 54 00290I******************************************************************** 00300IMGFILE MG 00310I* MESSAGE FILE 00320I* TEXT 35A 00330I 1 35 MGTEXT 00340I* LINE-2 35A 00350I 36 70 MGLIN2 61 00360I* PROG NAME 5A 00370I 71 75 MGPROG 00380C******************************************************************** 00390C* INITIALIZE, CLEAR SCREEN 00400C 79 GOTO START 00410C SETON 79 00420C MOVE BIT,1 NUL 00430C MOVE BIT,1 A6 00440C MOVE BIT,2 A6,2 00450C MOVE ' ' BLK35 35 00460C EXITFQTOPF CLEAR SCREEN 00470C SETON 70 00480C EXCPT 00490C SETOF 70 00500C*------------------------------------------------------------------- ÐÐ00510C START TAG 00520C* BYPASS NON-DEPT/JOB OR DELETED RECORDS 00530C N01 GOTO END 00540C COUNT COMP 55 54 54 00550C N54 GOTO NOHALT 00560C SETON 71 00570C EXCPT PAUSE. 00580C SETOF 71 00590C MOVE ' ' W2A 2 00600C MOVEAA6 W6A 6 00610C EXITFXCREAD 00620C RLABL W2A 00630C RLABL W6A 00640C MOVELW2A W1A 1 00650C W1A COMP '\' 54 00660C N54 MOVE W2A W1A 00670C N54 W1A COMP '\' 54 00680C N54 GOTO NOHALT 00690C SETON LR 00700C*------------------------------------------------------------------- 00710C NOHALT TAG 00720C 1 ADD COUNT COUNT 50 00730C*------------------------------------------------------------------- 00740C END TAG 00750CLR SETON 72 ÐÐ00760CLR EXCPT 00770CLR SETOF 72 00780CLR MOVEAA6 W6A 00790CLR EXITFXCREAD 00800CLR RLABL W2A 00810CLR RLABL W6A 00820CLR MOVEL'QQDP01' PROG 8 00830CLR EXITFCHAIN 00840CLR RLABL PROG 00850O******************************************************************** 00860OTERM75 E 70 00870O* CLEAR SCREEN 00880O 60 'LIST USERS ' 00890O BIT,11 52 00900O*------------------------------------------------------------------- 00910O D 01 00920O* LIST JOBS 00930O EUUSER 8 00940O EUEMPLZ 16 00950O*------------------------------------------------------------------- 00960O E 71 00970O* PAUSE. 00980O NUL 75 00990O 12 'CONTINUED...' 01000O 14 ' ' ÐÐ01010O*------------------------------------------------------------------- 01020O E 72 01030O NUL 75 01040O BIT,11 1 01050O 20 'PRESS "CR" FOR MENU' 01060O 22 ' ' ** A6 ARRAY 001070 001080** NUL ARRAY 001090 001100/* 001110_‚ ÐÐ _‚_‚0O 22 ' ' ** A6 ARRAY 001070 001080** NUL ARRAY 001090 001100/* 001110_‚ ÐÈ( 4é XW66 P999999120282(èÈÐ SUBROUTINE ZW66 (IBUF) 00010* WRITE 66 BYTES TO CRT 00020 INTEGER IBUF (33) 00030 ILU = 0 00040 IXY = -1 00050 ITC = 0 00060 N1 = 66 00070 N2 = 0 00080 CALL WTREAD (ILU,IXY,IBUF,N1,IXY,IBUF,N2,ITC) 00090 RETURN 00100 END 00110_‚ _‚_‚ ÐÈ(è4ï è¡X003GL P120282120282(èÈÐ00010H Q003GL00020F* CHART OF ACCOUNTS UPDATE PROGRAM (X003GL) 00030F* REVISED 7-27-81 11:25 AM. D A T A G R A P H I X 00040F* MENU: MQGL01 00050FBITHEX IP F 256 DISK 00060FMGFILE IC F 80R DISK 00070FCAMAST UC F 40R18AI 1 DISK A 00080FGLWU ID F 19L18AI 1 DISK 00090FGLMAST UC F 165R 9AI 1 DISK 00100FCRTFILE UC F 256R DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A8 8 8 1 A INPUT DATA ARRAY 00150E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00160E DUN 10 10 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E LOC 1 10 3 00190E LEV 1 20 18 00200E A9 9 9 1 00210E BIT 256 1 SCREEN CONTR. CHAR 00220E GLA 12 11 2 00230E* 00240E* 00250I******************************************************************* ÐÐ00260IBITHEX BT 00270I 1 256 BIT 00280I******************************************************************* 00290IMGFILE MG 00300I* MESSAGE FILE. 00310I 1 35 MGTEXT 00320I******************************************************************** 00330ICRTFILE CR 00340I 68 73 CRRET 00350I 81 89 CRPAR 00360I 90 98 CRSUB 00370I 103 1050CRLINE 00380I 106 106 CRTRAN 00390I******************************************************************** 00400IGLWU GW 00410I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00420I* KEY AREA. 00430I* SUB-ACCOUNT 9A 00440I 1 9 GWSUB 00450I* PARENT ACCOUNT 9A 00460I 10 18 GWPAR 00470I* RECORD STATUS 1A 00480I 19 19 GWSTAT 00490I******************************************************************** 00500IGLMAST GL ÐÐ00510I* ACCOUNT MASTER. 00520I* KEY AREA 00530I* ACCOUNT # 9A 00540I 1 9 GLACNT 00550I* ACCOUNT GROUP 4A 00560I 14 17 GLGRUP 00570I* ACCOUNT DESCRIPTION 40A 00580I 18 57 GLDESC 00590I* BALANCE FORWARD AMOUNT 11.2P 00600I P 58 632GLBALF 00610I* ACTUAL $ 11.2P X 12 00620I P 64 135 GLA 00630I* CURRENT MONTH-PLUS 11.2P 00640I P 136 1412GLCMP 00650I* CURRENT MONTH-MINUS 11.2P 00660I P 142 1472GLCMM 00670I* SOURCE CODE 1A 00680I* S = SUB-ACCOUNT ONLY, 00690I* MAY NOT BE PARENT 00700I 148 148 GLSC 00710I* BALANCE FORWARD CODE 2A 00720I* 1ST COL 00730I* 1 = ZERO BAL AT START NEW YR 00740I* 2 = CARRY PREV YR FRWD 00750I* 2ND COL ÐÐ00760I* A = ZERO BAL AT START NEW MO 00770I* B = CARRY PREV MO FRWD 00780I 149 150 GLBFC 00790I* NUMB OF SUB-ACCOUNTS 5P 00800I P 157 1590GLNOSA 00810I* LOW LEVEL CODE 3N 00820I 160 1620GLLL 00830I* FILLER 00840I* RECORD STATUS 1A 00850I 165 165 GLSTAT 00860I******************************************************************** 00870ICAMAST CA 00880I* CHART OF ACCOUNTS. 00890I* KEY AREA. 00900I* PARENT ACCOUNT 9A 00910I 1 9 CAPAR 00920I* SUB-ACCOUNT 9A 00930I 10 18 CASUB 00940I* OPERATOR 1A 00950I* S = SUBTRACT 00960I* A = ADD 00970I 25 25 CAOPER 00980I* EFFECTIVITY 00990I* START DATE 6N (YMD) 01000I 26 310CASDAT ÐÐ01010I* END DATE 6N (YMD) 01020I 32 370CAEDAT 01030I* FILLER 01040I* RECORD STATUS 1A 01050I 40 40 CASTAT 01060C******************************************************************** 01070C* INITIALIZE 01080C EXSR SR101 1-TIME INIT 01090C MOVE ' ' SAOPER 1 STUPIDITY. 01100C CRRET COMP 'QQGL01' 54 01110C 54 GOTO START 01120C MOVE 'QQGL01' CRRET 01130C MOVE CRPAR PAKEY 01140C MOVELCRPAR PAPRFX 01150C MOVE CRPAR W9A 01160C MOVELW9A PAPRIM 01170C MOVE W9A PADASH 01180C Z-ADD3 F 01190C Z-ADDCRLINE CRTLIN 01200C SETON 78 01210C EXSR SR205 INIT TRAN FIELDS 01220C GOTO EDIT 01230C*------------------------------------------------------------------- 01240C START TAG 01250C* SET-UP 1ST FIELD NO. ÐÐ01260C SETOF 78 01270C EXSR SR205 INIT TRAN DATA 01280C MOVE ' ' DUN 01290C EXSR SR71 PUT HEADING 01300C Z-ADD1 F 30 FIELD # 01310C GOTO READ 01320C*------------------------------------------------------------------ 01330C NEXT TAG 01340C* SET-UP NEXT FIELD NO. 01350C 1 ADD F F FIELD # 01360C*----------------------------------------------------------------- 01370C READ TAG 01380C* READ DATA FROM TERMINAL. 01390C SETOF 9096 01400C EXSR SR102 VALIDATE FIELD # 01410C 55 GOTO UPDATE DONE 01420C EXSR SR201 IDENTIFY-F 01430C 01 01440COR 05 GOTO NEXT 01450C F COMP 7 54 55 01460C EXSR SR203 CLASSIFY TRAN 01470C 62 54 GOTO UPDATE DELETE TRAN 01480C N54N55 MOVE ' ' IOTRAP 1 01490C SETON 69 01500C EXSR SR72 PROMPT ÐÐ01510C SETOF 69 01520C EXSR SR75 READ TERMINAL 01530C 98 GOTO GOODBY GOODBY 01540C 94 GOTO MENU MENU REQUEST 01550C N77N88 EXSR SR104 EDIT INPUT FIELD 01560C 96 ERROR 01570CORN77N88 EXSR SR72 REWRITE INPUT DATA 01580C 93 GOTO NEWITM NEW ITEM 01590C 92 GOTO JUMP FIELD JUMP REQST 01600C 91 GOTO NEXT SKIP FORWARD 01610C 89 F SUB 1 F SKIP BACKWARD 01620C 89 EXSR SR201 01630C 89 01 Z-ADD2 F 01640C 89 05 Z-ADD4 F 01650C 89 GOTO READ " " 01660C 88 SETOF 90 SPACE FILL 01670C 88 SETON 77 " " 01680C 87 GOTO START 01690C 86 GOTO UPDATE UPDATE 01700C 85 GOTO READ REPEAT 01710C 96 GOTO ERROR ERROR 01720C 03N77 PRIME DASH 01730COR 07N77 GOTO EDIT SUB DASH 01740C N77 GOTO NEXT NO DATA INPUT 01750C*------------------------------------------------------------------ ÐÐ01760C PROCES TAG 01770C* PROCESS INPUT DATA 01780C EXSR SR103 MOVE DATA 01790C*---------------------------------------------------------------- 01800C EDIT TAG 01810C N96 EXSR SR104 EDIT DATA 01820C N78 EXSR SR72 REWRITE DATA 01830C SETOF 78 01840C 96 GOTO ERROR ERROR 01850C GOTO NEXT 01860C*------------------------------------------------------------------ 01870C UPDATE TAG 01880C* UPDATE DATA BASE. 01890C EXSR SR105 FINAL EDIT 01900C 96 GOTO ERROR ERROR 01910C EXSR SR106 UPDATE 01920C 96 GOTO ERROR ERROR 01930C 1 ADD CRTLIN CRTLIN 01940C CRTLIN COMP 29 54 01950C 54 Z-ADD29 CRTLIN 30 01960C 54 EXSR SR69 DELETE TOP LINE 01970C EXSR SR203 CLASSIFY TRAN 01980C N60N62 GOTO CONTU NOT ADD/DEL 01990C MOVE PAKEY W9A 02000C EXSR SR84 GET PAR GLMAST ÐÐ02010C EXSR SR203 CLASSIFY TRAN 02020C 60 1 ADD GLNOSA GLNOSA 02030C 62 GLNOSA SUB 1 GLNOSA 02040C EXSR SR85 UPDATE PAR GL 02050C MOVEL'Q018GL' PROG 8 02060C EXITFCHAIN 02070C RLABL PROG 02080C*------------------------------------------------------------------- 02090C CONTU TAG 02100C Z-ADD3 F 02110C SETON 78 02120C EXSR SR205 INIT TRAN FIELDS 02130C SETOF 78 02140C GOTO NEXT CHANGE 02150C*------------------------------------------------------------------- 02160C JUMP TAG 02170C* SET-UP JUMP TO REQUESTED FIELD 02180C 1 ADD W W 30 02190C W COMP 8 54 02200C 54 Z-ADD318 M 50 96 FLAG ERROR 02210C 54 GOTO ERROR BAD ESC 02220C MOVE ' ' W3A 3 02230C MOVEAA8,W W3A 02240C Z-ADD3 W2N 20 02250C EXIT SUBRAJ R. JUSTIFY ÐÐ02260C RLABL W2N 02270C RLABL W3A 02280C MOVE W3A F NEW FIELD # 02290C GOTO READ 02300C*-------------------------------------------------------------------- 02310C ERROR TAG 02320C EXSR SR102 VALIDATE FIELD # 02330C EXSR SR89 GET MSG 02340C EXSR SR73 PUT MSG 02350C GOTO READ 02360C*------------------------------------------------------------------ 02370C NEWITM TAG 02380C* SET-UP LINK FOR NEW ITEM 02390C GOTO START 02400C*------------------------------------------------------------------- 02410C MENU TAG 02420C* SET-UP LINK TO MENU 02430C MOVEL'QQGL01' PROG 8 02440C GOTO END 02450C*-------------------------------------------------------------------- 02460C GOODBY TAG 02470C* LINK TO SIGN-OFF 02480C MOVEL'GOODBY' PROG 8 02490C GOTO END 02500C*------------------------------------------------------------------- ÐÐ02510C END TAG 02520C PROG COMP BLK8 54 02530C N54 MOVEL'Q003GL' PROG 8 02540C EXITFCHAIN LINK TO NEXT PROG 02550C RLABL PROG 02560C*------------------------------------------------------------------- 02570C ENDJOB TAG 02580C********************************************************************* 02590CSR SR2 BEGSR 02600C* EDIT PARENT PRIME 02610CSR PAPRIM COMP 0 54 02620CSRN54 Z-ADD358 M 96 FLAG ERROR 02630CSR ENDSR 02640C****************************************************************** 02650CSR SR3 BEGSR 02660C* EDIT PARENT DASH 02670CSR MOVELPAPRFX PAKEY 9 02680CSR MOVELPAPRIM W8A 8 02690CSR MOVE PADASH W8A 02700CSR MOVE W8A PAKEY 02710CSR MOVE PAKEY W9A 9 02720CSR EXSR SR84 GET GLMAST 02730CSR 60 02740COR 61 Z-ADD302 M 96 FLAG ERROR 02750CSR 60 ÐÐ02760COR 61 EXSR SR212 INIT PARENT 02770CSR MOVE GLDESC PADESC 40 02780CSR MOVE GLSC PASC 1 02790CSR Z-ADDGLLL PALL 30 02800CSRN60N61 GLSC COMP 'S' 54 FLAG PARENT ONLY 02810CSRN60N61 54 Z-ADD356 M 96 FLAG ERROR 02820CSR MOVE BLK40 GLDESC 02830CSR MOVE ' ' GLSC 02840CSR END3 ENDSR 02850C************************************************************ 02860CSR SR4 BEGSR 02870C* EDIT TRAN CODE 02880CSR EXSR SR203 CLASSIFY TRAN 02890CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02900CSR ENDSR 02910C**************************************************************** 02920CSR SR6 BEGSR 02930C* EDIT SUB PRIME 02940CSR SAPRIM COMP 0 54 02950CSRN54 Z-ADD358 M 96 FLAG ERROR 02960CSR ENDSR 02970C************************************************************ 02980CSR SR7 BEGSR 02990C* EDIT SUB DASH 03000CSR MOVELSAPRFX SAKEY 9 ÐÐ03010CSR MOVELSAPRIM W8A 03020CSR MOVE SADASH W8A 03030CSR MOVE W8A SAKEY 03040CSR MOVE SAKEY W9A 03050CSR EXSR SR207 INIT CAMAST 03060CSR EXSR SR84 GET GLMAST 03070CSR 60 03080COR 61 Z-ADD302 M 96 FLAG ERROR 03090CSR 96 GOTO END7 03100CSR Z-ADDGLLL SALL 30 03110CSR SETOF 555657 03120CSR EXSR SR80 GET CAMAST 03130CSR 60 NOT ON FILE 03140COR 61 SETON 55 DELETED CAMAST 03150CSR EXSR SR206 MOVE DATA 03160CSR EXSR SR203 CLASSIFY TRAN 03170CSR 60N55 Z-ADD301 M 96 FLAG ERROR 03180CSR 61 55 03190COR 62 55 Z-ADD359 M 96 FLAG ERROR 03200C*------------------------------------------------------------------- 03210CSR END7 TAG 03220CSR EXSR SR203 CLASSIFY TRAN 03230CSR 60N96 EXSR SR209 CHECK GUZINTA 03240CSRN96 MOVE 'X' IOTRAP 1 03250CSR 96 MOVE ' ' IOTRAP ÐÐ03260CSR ENDSR 03270C**************************************************************** 03280CSR SR8 BEGSR 03290C* EDIT OPERATOR CODE 03300CSR SAOPER COMP 'A' 54 ADD 03310CSRN54 SAOPER COMP 'S' 54 SUBTRACT 03320CSRN54 Z-ADD360 M 96 FLAG ERROR 03330CSR ENDSR 03340C***************************************************************** 03350CSR SR9 BEGSR 03360C* EDIT START DATE 03370CSR Z-ADDSASDAT W6N 60 55 03380CSR 55 EXSR SR211 DATE EDIT 03390CSR 55 Z-ADDW6N SASDAT 03400CSR ENDSR 03410C***************************************************************** 03420CSR SR10 BEGSR 03430C* EDIT END DATE 03440CSR Z-ADDSAEDAT W6N 55 03450CSR 55 EXSR SR211 DATE EDIT 03460CSR 55 Z-ADDW6N SAEDAT 03470CSR ENDSR 03480C*************************************************************** 03490CSR SR69 BEGSR 03500C* DELETE TOP SUB-ACCOUNT ENTRY LINE ÐÐ03510CSR MOVE '012001' W6A 6 03520CSR EXITFQXYPOS POSITION CURSOR 03530CSR RLABL W6A 03540CSR EXITFQDELT DELETE LINE 03550CSR ENDSR 03560C******************************************************************** 03570CSR SR70 BEGSR 03580C* CLEAR SCREEN. 03590CSR EXITFQTOPF CLEAR SCREEN. 03600CSR ENDSR 03610C********************************************************************** 03620CSR SR71 BEGSR 03630C* PUT HEADINGS TO TERMINAL 03640CSR EXSR SR70 CLEAR CRT 03650CSR SETON 71 03660CSR EXCPT PUT HEADINGS 03670CSR SETOF 71 03680CSR Z-ADD12 CRTLIN 03690CSR ENDSR 03700C********************************************************************* 03710CSR SR72 BEGSR 03720C* PUT COMPONENT DATA TO TERMINAL. 03730CSR F COMP 3 54 03740CSR 54 CRTLIN SUB 1 W3N 30 03750CSRN54 Z-ADD5 W3N PARENT FIELD ÐÐ03760CSR MOVELW3N W6A 03770CSR MOVE '001' W6A 03780CSR EXITFQXYPOS POSITION CURSOR 03790CSR RLABL W6A 03800CSR PADASH COMP 0 56 03810CSR SADASH COMP 0 57 03820CSR SETON 72 03830CSR EXCPT PUT DATA. 03840CSR SETOF 72 03850CSR END72 ENDSR 03860C*********************************************************************** 03870CSR SR73 BEGSR 03880C* PUT ERROR MESSAGE TO TERMINAL 03890CSR SETON 73 03900CSR EXCPT PUT MSG 03910CSR SETOF 73 03920CSR Z-ADDM LSTERR 50 03930CSR EXITFQMOVUP 03940CSR ENDSR 03950C******************************************************************* 03960CSR SR75 BEGSR 03970C* READ FROM TERMINAL 03980CSR SETOF 779096 03990CSR SETOF 939291 04000CSR SETOF 898887 ÐÐ04010CSR SETOF 8685 04020CSR F COMP 3 54 04030CSR 54 MOVE CRTLIN W3A 3 04040CSRN54 MOVE '006' W3A 04050CSR MOVE BIT,28 A9,1 04060CSR MOVE '8' A9,2 04070CSR MOVEAW3A A9,3 04080CSR MOVEALOC,F A9,6 04090CSR MOVE BIT,8 A9,9 04100CSR MOVEAA9 W9A 9 04110CSR MOVE BIT,5 BUFLGT BUF LENGTH 04120CSR MOVE BLK8 W8A 8 BUFFER 04130CSR EXITFQPREED READ TERM 04140CSR RLABL W9A 04150CSR RLABL W8A 04160CSR RLABL BUFLGT 04170CSR MOVEAW8A A8 04180CSR MOVE BLK8 W8A 04190CSR Z-ADD1 W 30 04200CSR '\' LOKUPA8,W 90 FLAG ESC 04210CSRN90 GOTO T75B NOT ESC 04220CSR 1 ADD W W 04230CSR W COMP 12 54 04240CSR 54 GOTO T75A BAD ESC 04250CSR A8,W COMP 'G' 98 GOODBY ÐÐ04260CSR A8,W COMP 'E' 94 MENU 04270CSR A8,W COMP 'N' 93 NEW ITEM 04280CSR A8,W COMP 'J' 92 JUMP 04290CSR A8,W COMP 'F' 91 SKIP FRWRD 04300CSR A8,W COMP 'B' 89 SKIP BKWRD 04310CSR A8,W COMP 'S' 88 SPACE FILL 04320CSR A8,W COMP 'H' 87 HOME 04330CSR A8,W COMP 'U' 86 UPDATE 04340CSR A8,W COMP 'R' 85 REPEAT 04350CSR 98 04360COR 94 04370COR 93 04380COR 92 04390COR 91 04400COR 89 04410COR 88 04420COR 87 04430COR 86 04440COR 85 GOTO END75 GOOD ESC 04450C*------------------------------------------------------------------ 04460CSR T75A TAG 04470C* FLAG BAD ESC INPUT 04480CSR Z-ADD318 M 96 FLAG ERROR 04490CSR GOTO END75 04500C*-------------------------------------------------------------------- ÐÐ04510CSR T75B TAG 04520C* MOVE DATA 04530CSR Z-ADD1 W 04540CSR ' ' LOKUPA8,W 77 04550CSR 77 MOVEAA8,W W8A INPUT DATA 04560C*-------------------------------------------------------------------- 04570CSR END75 TAG 04580C* INIT PREV ERROR MSG. 04590CSR LSTERR COMP 0 54 04600CSR 54 MOVE BLK35 MGTEXT 04610CSR 54 EXSR SR73 BLANK MESSAGE 04620CSR Z-ADD0 LSTERR 50 04630CSR ENDSR 04640C********************************************************************** 04650CSR SR80 BEGSR 04660C* GET CAMAST RECORD 04670CSR SETOF 61 04680CSR MOVELPAKEY W18A 18 04690CSR MOVE SAKEY W18A 04700CSR W18A CHAINCAMAST 60 GET MASTER 04710CSRN60 CASTAT COMP 'D' 61 FLAG DELETE 04720CSR ENDSR 04730C********************************************************************** 04740CSR SR81 BEGSR 04750C* ADD NEW MASTER TO FILE ÐÐ04760CSR EXSR SR210 CALC LL. 04770CSR SETON 81 04780CSR EXCPT ADD MASTER 04790CSR SETOF 81 04800CSR ENDSR 04810C*********************************************************************** 04820CSR SR82 BEGSR 04830C* REWRITE MASTER 04840CSR EXSR SR210 CALC LL. 04850CSR SETON 82 04860CSR EXCPT REWRITE MASTER 04870CSR SETOF 82 04880CSR ENDSR 04890C******************************************************************** 04900CSR SR84 BEGSR 04910C* GET GLMAST 04920CSR SETOF 61 04930CSR W9A CHAINGLMAST 60 04940CSRN60 GLSTAT COMP 'D' 61 04950CSR ENDSR 04960C******************************************************************** 04970CSR SR85 BEGSR 04980C* UPDATE PAR PART MASTER. 04990CSR SETON 85 05000CSR EXCPT UPD PAR PMMST2 ÐÐ05010CSR SETOF 85 05020CSR ENDSR 05030C******************************************************************** 05040CSR SR89 BEGSR 05050C* GET MESSAGE MASTER 05060CSR M CHAINMGFILE 54 05070CSR 54 MOVE BLK35 MGTEXT 05080CSR 54 MOVELM MGTEXT 05090CSR 54 MOVE MES,1 MGTEXT 05100CSR ENDSR 05110C*********************************************************************** 05120CSR SR101 BEGSR 05130C* 1-TIME INITIALIZE 05140CSR MOVE BIT,1 NUL 05150CSR MOVELBIT,1 BUFLGT 2 05160CSR Z-ADD10 FLIMIT 30 TOTAL NUMB FIELDS 05170CSR MOVE ' ' BLK8 8 05180C* GET PORT # AND CRTFILE. 05190CSR MOVE ' ' W8A 8 05200CSR Z-ADD0 W2N 20 05210CSR Z-ADD0 W1N 10 05220CSR MOVE ' ' W2A 2 05230CSR EXITFPGMINX GET PORT #. 05240CSR RLABL W8A 05250CSR RLABL W2N ÐÐ05260CSR RLABL W1N 05270CSR RLABL W2A 05280CSR MOVE W2A PORT 20 PORT NO. 05290CSR PORT COMP 0 54 05300CSRN54 Z-ADD25 PORT DEFAULT 05310CSR PORT CHAINCRTFILE H9 05320C* DEFINE WORK FIELDS,ETC. 05330CSR MOVE ' ' BLK35 35 05340CSR MOVE ' ' BLK18 18 05350CSR Z-ADD0 ZERO3 30 05360CSR MOVE ' ' BLK8 8 05370CSR MOVE ' ' BLK20 20 05380CSR MOVE ' ' BLK9 9 05390CSR MOVE ' ' BLK5 5 05400CSR MOVE ' ' BLK40 40 05410CSR ENDSR 05420C********************************************************************** 05430CSR SR102 BEGSR 05440C* VALIDATE FIELD NO. 05450CSR F COMP 0 54 05460CSRN54 Z-ADD1 F 05470CSR F COMP FLIMIT 55 05480CSR 55 Z-ADD1 F 05490CSR ENDSR 05500C******************************************************************** ÐÐ05510CSR SR103 BEGSR 05520C* MOVE INPUT DATA 05530CSR EXSR SR201 IDENTIFY-F 05540CSR EXSR SR202 R.JUSTIFY 05550CSR 01 MOVELW8A PAPRFX 1 PARENT PREFIX 05560CSR 02 MOVE W8A PAPRIM 50 PARENT PRIME 05570CSR 03 MOVE W8A PADASH 30 PARENT DASH 05580CSR 04 MOVELW8A TTCODE 1 TRAN CODE 05590CSR 05 MOVELW8A SAPRFX 1 SUB PREFIX 05600CSR 06 MOVE W8A SAPRIM 50 SUB PRIME 05610CSR 07 MOVE W8A SADASH 30 SUB DASH 05620CSR 08 MOVELW8A SAOPER 1 OPERATOR 05630CSR 09 MOVE W8A SASDAT 60 START DATE 05640CSR 10 MOVE W8A SAEDAT 60 END DATE 05650CSR ENDSR 05660C******************************************************************** 05670CSR SR104 BEGSR 05680C* EDIT INPUT DATA 05690CSR F COMP 7 54 05700CSR 54 IOTRAP COMP ' ' 55 05710CSR 54N55 EXSR SR7 05720CSR 02 EXSR SR2 05730CSR 03 EXSR SR3 05740CSR 04 EXSR SR4 05750CSR 07 EXSR SR7 ÐÐ05760CSR 08 EXSR SR8 05770CSR 09 EXSR SR9 05780CSR 10 EXSR SR10 05790CSR 96 MOVE ' ' DUN,F EDIT FLAG 05800CSRN96 MOVE 'X' DUN,F 05810CSR ENDSR 05820C*********************************************************************** 05830CSR SR105 BEGSR 05840C* FINAL EDIT 05850CSR SETON 79 FINAL EDIT FLAG 05860CSR Z-ADD1 F 96 05870C*-------------------------------------------------------------------- 05880CSR T105A TAG 05890CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05900CSRN54 GOTO END105 05910CSR EXSR SR201 IDENTIFY-F 05920CSR EXSR SR104 EDIT 05930CSRN96 GOTO T105A 05940C*-------------------------------------------------------------------- 05950CSR END105 TAG 05960CSR SETOF 79 05970CSR ENDSR 05980C******************************************************************** 05990CSR SR106 BEGSR 06000C* UPDATE DATA BASE. ÐÐ06010CSR EXSR SR203 CLASSIFY TRAN 06020CSR 60 GOTO T106A ADD TRAN 06030CSR 61 GOTO T106D CHANGE TRAN 06040CSR 62 GOTO T106F DELETE TRAN 06050C* FLAG BAD TRAN CODE 06060CSR Z-ADD300 M 96 FLAG ERROR 06070CSR Z-ADD1 F FIELD # 06080CSR GOTO END106 06090C*------------------------------------------------------------------- 06100CSR T106A TAG 06110C* ADD TRANSACTION 06120CSR EXSR SR80 GET MASTER 06130CSR 60 GOTO T106B NOT ON FILE 06140CSR 61 GOTO T106C DELETED MASTER 06150C* FLAG DUPLICATE ADD ERROR 06160CSR Z-ADD301 M 96 FLAG ERROR 06170CSR Z-ADD1 F FIELD # 06180CSR GOTO END106 06190C*--------------------------------------------------------------------- 06200CSR T106B TAG 06210C* ADD-- MAST NOT ON FILE 06220CSR EXSR SR81 ADD NEW MASTER 06230CSR GOTO END106 06240C*--------------------------------------------------------------------- 06250CSR T106C TAG ÐÐ06260C* ADD-- MAST IS DELETED 06270CSR MOVE 'A' CASTAT RECORD STATUS 06280CSR EXSR SR82 REWRITE MAST 06290CSR GOTO END106 06300C*---------------------------------------------------------------------- 06310CSR T106D TAG 06320C* CHANGE TRANSACTION. 06330CSR EXSR SR80 GET MASTER 06340CSRN60N61 GOTO T106E GOT IT 06350C* FLAG NO MASTER ERROR 06360CSR Z-ADD182 M 96 FLAG ERROR 06370CSR Z-ADD1 F FIELD # 06380CSR GOTO END106 06390C*----------------------------------------------------------------------- 06400CSR T106E TAG 06410C* REWRITE MASTER 06420CSR EXSR SR82 REWRITE MAST 06430CSR GOTO END106 06440C*----------------------------------------------------------------------- 06450CSR T106F TAG 06460C* DELETE TRANSACTION 06470CSR EXSR SR80 GET MASTER 06480CSRN60N61 GOTO T106G GOT IT 06490C* FLAG NO MASTER ERROR 06500CSR Z-ADD182 M 96 FLAG ERROR ÐÐ06510CSR Z-ADD1 F FIELD # 06520CSR GOTO END106 06530C*----------------------------------------------------------------------- 06540CSR T106G TAG 06550C* DELETE MASTER. 06560CSR MOVE 'D' CASTAT RECORD STATUS 06570CSR EXSR SR82 REWRITE MASTER 06580CSR END106 ENDSR 06590C************************************************************************ 06600CSR SR201 BEGSR 06610C* IDENTIFY FIELD NO. 06620CSR F COMP 1 01 06630CSR F COMP 2 02 06640CSR F COMP 3 03 06650CSR F COMP 4 04 06660CSR F COMP 5 05 06670CSR F COMP 6 06 06680CSR F COMP 7 07 06690CSR F COMP 8 08 06700CSR F COMP 9 09 06710CSR F COMP 10 10 06720CSR ENDSR 06730C********************************************************************** 06740CSR SR202 BEGSR 06750C* RIGHT JUSTIFY ÐÐ06760CSR F LOKUPNUM 54 06770CSRN54 GOTO END202 NOT NUMERIC FIELD 06780CSR Z-ADD8 W2N 20 06790CSR EXIT SUBRAJ R. JUSTIFY 06800CSR RLABL W2N 06810CSR RLABL W8A 06820CSR END202 ENDSR 06830C*********************************************************************** 06840CSR SR203 BEGSR 06850C* CLASSIFY TRAN CODE 06860CSR TTCODE COMP 'A' 60 ADD 06870CSR TTCODE COMP 'C' 61 CHANGE 06880CSR TTCODE COMP 'D' 62 DELETE 06890CSR ENDSR 06900C***************************************************************** 06910CSR SR205 BEGSR 06920C* INIT TRAN FIELDS 06930CSR MOVE ' ' IOTRAP 06940CSRN78 MOVE BLK35 PAKEY 9 06950CSR MOVE BLK35 SAKEY 9 06960CSRN78 MOVE BLK8 PAPRFX 1 06970CSR MOVE BLK8 TTCODE 1 06980CSRN78 MOVE BLK8 SAPRFX 1 06990CSR MOVE BLK8 SAOPER 1 07000CSRN78 EXSR SR212 INIT PARENT SAVES ÐÐ07010CSRN78 Z-ADD0 PAPRIM 50 07020CSRN78 Z-ADD0 PADASH 30 07030CSR Z-ADD0 SAPRIM 50 07040CSR Z-ADD0 SADASH 30 07050CSR Z-ADD0 SASDAT 60 07060CSR Z-ADD0 SAEDAT 60 07070CSR MOVE BLK40 GLDESC 07080CSR MOVE BLK40 GLSC 07090CSR ENDSR 07100C****************************************************************** 07110CSR SR206 BEGSR 07120C* MOVE CAMAST TO TRAN FIELDS 07130CSR SAOPER COMP ' ' 54 07140CSRN54 MOVE CAOPER SAOPER 1 07150CSR SASDAT COMP 0 54 07160CSRN54 Z-ADDCASDAT SASDAT 07170CSR SAEDAT COMP 0 54 07180CSRN54 Z-ADDCAEDAT SAEDAT 07190CSR ENDSR 07200C********************************************************* 07210CSR SR207 BEGSR 07220C* INIT CAMAST DATA FIELDS 07230CSR MOVE ' ' CAOPER 07240CSR Z-ADD0 CASDAT 07250CSR Z-ADD0 CAEDAT ÐÐ07260CSR MOVE BLK40 GLDESC 07270CSR MOVE ' ' GLSC 07280CSR ENDSR 07290C************************************************************** 07300CSR SR209 BEGSR 07310C* CHECK TO SEE IF NEW SUB-ACCT GUZINTA ITSELF. 07320CSR PAKEY COMP SAKEY 54 07330CSR 54 Z-ADD368 M 96 FLAG ERROR. 07340CSR 54 GOTO END209 07350CSR GLNOSA COMP 0 54 07360CSRN54 GOTO END209 NOT PARENT 07370CSR MOVE BLK18 LEV 07380CSR MOVELPAKEY LEV,2 07390CSR Z-ADD3 L 30 07400C*------------------------------------------------------------------- 07410CSR T209A TAG 07420C* GET SAVED LOWER LEVEL, IF ANY. 07430CSR L SUB 1 L 54 INDENT LEVEL. 07440CSRN54 GOTO END209 BOT INDENT. 07450CSR LEV,L COMP BLK18 54 07460CSRN54 GOTO T209A NONE THIS LEVEL 07470CSR MOVE LEV,L W18A 18 07480CSR MOVELLEV,L CURSUB 9 07490CSR MOVE BLK18 LEV,L 07500C*------------------------------------------------------------------ ÐÐ07510CSR T209B TAG 07520CSR W18A SETLLGLWU 07530C*------------------------------------------------------------------- 07540CSR T209C TAG 07550CSR SETOF 54 07560CSR READ GLWU 54 07570CSR 54 GOTO END209 07580CSR GWSUB COMP CURSUB 54 07590CSRN54 GOTO T209A 07600CSR GWSTAT COMP 'D' 54 07610CSR 54 GOTO T209C 07620CSR GWPAR COMP SAKEY 54 07630CSR 54 Z-ADD368 M 96 FLAG ERROR. 07640CSR 54 GOTO END209 07650C* SAVE CUR LEVEL DATA. 07660CSR MOVELGWSUB LEV,L 07670CSR MOVE GWPAR W3N 30 07680CSR MOVE GWPAR LEV,L 07690CSR 1 ADD W3N W3N 07700CSR MOVE W3N LEV,L 07710CSR MOVE GWPAR CURSUB 07720CSR MOVELGWPAR W18A 07730CSR MOVE BLK9 W18A 07740CSR 1 ADD L L 07750CSR GOTO T209B ÐÐ07760CSR END209 ENDSR 07770C******************************************************************** 07780CSR SR210 BEGSR 07790C* CALCULATE LOW LEVEL CODE. 07800CSR SALL COMP PALL 54 07810CSRN54 1 ADD PALL NEWLL 30 07820CSR 54 Z-ADDSALL NEWLL 07830CSR ENDSR 07840C*************************************************************** 07850CSR SR211 BEGSR 07860C* UTILITY DATE EDIT 07870CSR MOVELW6N W2N 07880CSR W2N COMP 12 54 07890CSR 54 GOTO END211 07900CSR MOVE W6N W2N 07910CSR MOVELW6N W4N 40 07920CSR MOVELW2N W6N 07930CSR MOVE W4N W6N 07940CSR END211 ENDSR 07950C*************************************************************** 07960CSR SR212 BEGSR 07970C* INIT PARENT SAVE FIELDS 07980CSR MOVE BLK40 PADESC 07990CSR MOVE ' ' PASC 08000CSR Z-ADD0 PALL ÐÐ08010CSR ENDSR 08020O******************************************************************** 08030OTERM132 E 71 08040O* PUT HEADING - PARENT ACCOUNT. 08050O 73 'CHART OF ACCOUNTS UPDATE' 08060O*------------------------------------------------------------------- 08070O E 71 08080O 17 'PARENT ACCOUNT' 08090O 66 'TYPE' 08100O*------------------------------------------------------------------- 08110O E 71 08120O* * * * 6 'PREFIX' 08130O 13 'PRIME' 08140O 14 '-' 08150O 19 'DASH' 08160O 35 '<--------------' 08170O 46 'DESCRIPTION' 08180O 60 '------------->' 08190O 66 'CODE' 08200O*------------------------------------------------------------------ 08210O E 71 08220O* * * * 4 '(1)' 08230O 11 '(2)' 08240O 18 '(3)' 08250O*------------------------------------------------------------------- ÐÐ08260O E 71 08270O OR 72 01 08280O OR 72 02 08290O OR 72 03 08300O* PARENT ACCOUNT DATA. 08310O PAPRFX 4 08320O PAPRIMZ 13 08330O 56 14 '-' 08340O PADASHZ 17 08350O PADESC 60 08360O PASC 64 08370O*----------------------------------------------------------------- 08380O E 71 08390O*------------------------------------------------------------------- 08400O E 71 08410O* PUT HEADING - SUB-ACCOUNT. 08420O 4 'TRAN' 08430O 24 '---SUB ACCOUNT---' 08440O 71 'TYPE' 08450O 77 'OPER' 08460O 94 'EFFECTIVITY' 08470O 122 'CURRENT-MONTH' 08480O*------------------------------------------------------------------- 08490O E 71 08500O 4 'CODE' ÐÐ08510O* * * * 12 'PREFIX' 08520O 19 'PRIME' 08530O 20 '-' 08540O 24 'DASH' 08550O 40 '<--------------' 08560O 51 'DESCRIPTION' 08570O 65 '------------->' 08580O 71 'CODE' 08590O 77 'CODE' 08600O 87 'START' 08610O 96 'STOP' 08620O 111 'PLUS' 08630O 125 'MINUS' 08640O*----------------------------------------------------------------- 08650O E 71 08660O 3 '(4)' 08670O* * * * 10 '(5)' 08680O 16 '(6)' 08690O 24 '(7)' 08700O 76 '(8)' 08710O 85 '(9)' 08720O 96 '(10)' 08730O*------------------------------------------------------------------- 08740O E 72N01N02 08750O AND N03 ÐÐ08760O* SUB-ACCOUNT DATA. 08770O TTCODE 2 08780O SAPRFX 10 08790O SAPRIMZ 19 08800O 57 20 '-' 08810O SADASHZ 23 08820O GLDESC 65 08830O GLSC 69 08840O SAOPER 75 08850O SASDAT 87 ' - - ' 08860O SAEDAT 97 ' - - ' 08870O GLCMP K 112 08880O GLCMM K 126 08890O*------------------------------------------------------------------- 08900O E 73 08910O* PUT MESSAGE. 08920O BIT,28 1 08930O 8 '8030001' 08940O 96 13 '*****' 08950O N96 13 ' ' 08960O MGTEXT 48 08970O BIT,28 130 08980O 131 'K' 08990O 96 BIT,8 132 09000O******************************************************************** ÐÐ09010OCAMAST EADD 81 09020O* ADD NEW CHART ACCOUNTS RECORD. 09030O PAKEY 9 09040O SAKEY 18 09050O SAOPER 25 09060O SASDAT 31 09070O SAEDAT 37 09080O 40 'A' 09090O*------------------------------------------------------------------- 09100O E 82 09110O* REWRITE CHART ACCOUNTS MAST. 09120O SAOPER 25 09130O SASDAT 31 09140O SAEDAT 37 09150O CASTAT 40 09160O******************************************************************** 09170OCRTFILE E 85 09180O 73 'Q003GL' 09190O PAKEY 89 09200O SAKEY 98 09210O CRTLIN 105 09220O TTCODE 106 09230O******************************************************************** 09240OGLMAST E 81 09250O OR 82 ÐÐ09260O OR 85 09270O* REWRITE GL MAST. 09280O GLBALF 63P 09290O GLA 135P 09300O GLCMP 141P 09310O GLCMM 147P 09320O GLNOSA 159P 09330O NEWLL 162 ** NUL ARRAY 009340 009350** A8 ARRAY 009360 009370** NUM ARRAY 009380002 PAR PRIME 009390003 PAR DASH 009400006 SUB PRIME 009410007 SUB DASH 009420009 START DATE 009430010 STOP DATE 009440** DUN ARRAY 009450 009460** MES ARRAY 009470---MESSAGE NOT ON FILE--- 009480** LOC ARRAY 009490003 1 PARENT PREFIX 009500ÐÐ009 2 PARENT PRIME 009510017 3 PARENT DASH 009520002 4 TRAN CODE 009530009 5 SUB PREFIX 009540015 6 SUB PRIME 009550023 7 SUB DASH 009560075 8 SUB OPERATOR 009570082 9 START DATE 009580092 10 STOP DATE 009590** LEV ARRAY 09600 09610** A9 ARRAY 009620 009630/* 09640_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(–6‘ –?X003JN P120282120282(èÈÐ00010H Q003JN00020F* LIST JOB MASTERS. (X003JN) 00030F* REV 4/25/80 10:00 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FJOBFILE IS F 48 7AI 1 DISK 00060FMGFILE IC F 80R DISK 00070FTERM75 O F 75 5 00080E******************************************************************** 00090E A6 1 6 1 00100E NUL 1 75 1 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 01 00140I 1 33 BIT 00150I******************************************************************** 00160IJOBFILE JN 02 1 CN 00170I* RECORD CODE 1A 00180I* N = JOB NAME RECORD 00190I 1 1 JNREC 00200I* JOB NAME 6A 00210I 2 7 JNJOB 00220I* JOB DESCRIPTION 35A 00230I 8 42 JNDESC 00240I* RECORD STATUS 1A 00250I 48 48 JNSTAT ÐÐ00260I*----------------------------------------------------------------- 00270I GG 03 00280I******************************************************************** 00290IMGFILE MG 00300I* MESSAGE FILE 00310I* TEXT 35A 00320I 1 35 MGTEXT 00330I* LINE-2 35A 00340I 36 70 MGLIN2 61 00350I* PROG NAME 5A 00360I 71 75 MGPROG 00370C******************************************************************** 00380C* INITIALIZE, CLEAR SCREEN 00390C 02 JNSTAT COMP 'D' 54 00400C 02 54 SETOF 02 00410C N02 GOTO END 00420C 79 GOTO START 00430C SETON 79 00440C MOVE BIT,1 NUL 00450C MOVE BIT,1 A6 00460C MOVE BIT,2 A6,2 00470C MOVE ' ' BLK35 35 00480C EXITFQTOPF CLEAR SCREEN 00490C SETON 70 00500C EXCPT ÐÐ00510C SETOF 70 00520C*------------------------------------------------------------------- 00530C START TAG 00540C* BYPASS NON-DEPT/JOB OR DELETED RECORDS 00550C N02 GOTO END 00560C COUNT COMP 55 54 54 00570C N54 GOTO NOHALT 00580C SETON 71 00590C EXCPT PAUSE. 00600C SETOF 71 00610C MOVE ' ' W2A 2 00620C MOVEAA6 W6A 6 00630C EXSR SR102 00640C MOVELW2A W1A 1 00650C W1A COMP '\' 54 00660C N54 MOVE W2A W1A 00670C N54 W1A COMP '\' 54 00680C Z-ADD0 COUNT 00690C N54 GOTO NOHALT 00700C SETON LR 00710C*------------------------------------------------------------------- 00720C NOHALT TAG 00730C 1 ADD COUNT COUNT 50 00740C*------------------------------------------------------------------- 00750C END TAG ÐÐ00760CLR SETON 72 00770CLR EXCPT 00780CLR EXSR SR102 00790CLR MOVEL'QQDP01' PROG 8 00800CLR EXITFCHAIN 00810CLR RLABL PROG 00820C******************************************************************** 00830CSR SR102 BEGSR 00840C* READ CRT. 00850CSR MOVEAA6 W6A 00860CSR EXITFXCREAD 00870CSR RLABL W2A 00880CSR RLABL W6A 00890CSR ENDSR 00900O******************************************************************** 00910OTERM75 E 70 00920O* CLEAR SCREEN 00930O BIT,28 1 00940O 2 '8' 00950O 8 '001055' 00960O 24 'LIST JOB MASTERS' 00970O BIT,11 75 00980O*------------------------------------------------------------------- 00990O D 02 01000O* LIST JOBS ÐÐ01010O JNJOB 6 01020O JNDESC 50 01030O*------------------------------------------------------------------- 01040O E 71 01050O* PAUSE. 01060O NUL 75 01070O 12 'CONTINUED...' 01080O 19 ' ' 01090O*------------------------------------------------------------------- 01100O E 72 01110O NUL 75 01120O BIT,11 1 01130O BIT,14 2 01140O 19 'PRESS "CR" FOR MENU' 01150O 21 ' ' ** A6 ARRAY 001160 001170** NUL ARRAY 001180 001190/* 001200_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(^6Ñ ^’X003JQ P120282120282(èÈÐ00010H Q003JQ00020F* DISPLAY JOB QUEUE - JOB NAME SEQ - DATAGRAPHIX. (X003JQ) 00030F* DISPLAYS ALL QUEUED JOBS. ******** EDP ONLY ********* 00040F* REVISED 11/26/79 4:50 PM. 00050FBITTAB IP F 33 DISK 00060FJQJOB UD F 11L10AI 1 DISK 00070FJQMAST UC F 96R 4AI 1 DISK 00080FBJMAST IC F 106R 6AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FMENUDEPTIT F 25 EDISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E MENUDEPT TABDEP 1 10 5 0 TABDN 16 00140E NUL 1 132 1 00150E A6 6 6 1 00160E A8 8 8 1 A 00170E BIT 33 1 00180E BJD 6 4 00190I******************************************************************** 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************** 00230IJQJOB JJ 00240I* JOB NAME - ALT-KEY FILE. 00250I* KEY AREA. ÐÐ00260I* JOB NAME 6A 00270I 1 6 JJNAME 00280I* JOB NO. 4N 00290I 7 100JJJOB 00300I* RECORD STATUS 1A 00310I 11 11 JJSTAT 00320I******************************************************************** 00330IBJMAST BJ 00340I* BATCH JOB MAST. 00350I* JOB NAME 6A 00360I 1 6 BJNAME 00370I* DESCRIPTION 40A 00380I 7 46 BJDESC 00390I* PRINTER 1A 00400I* D = DIABLO 00410I* S = SYSTEM PRINTER 00420I* T = DATAGRAPHIX 00430I* C = CONSOLE 00440I 47 47 BJPRTR 00450I* PAPER 25A 00460I 48 72 BJPAP 00470I* COPIES 1N 00480I 73 730BJCOPY 00490I* DISTRIBUTION 4A X 6 00500I 74 97 BJD ÐÐ00510I* UPDATE CODE 1A 00520I* Y = SHARABLE 00530I* N = NOT SHARABLE 00540I* BLK = NO DISK UPDATE 00550I 98 98 BJUPD 00560I* TYPE CODE 1A 00570I* P = PROGRAM (MAINLINE OR CALLED BY PROC) 00580I* U = UTILITY (ONLY) 00590I* Z = JOB STREAM 00600I* M = MENU 00610I* C = CALLED PROGRAM 00620I 99 99 BJTYPE 00630I* RECORD STATUS 1A 00640I 106 106 BJSTAT 00650I******************************************************************** 00660IMGFILE MG 00670I 1 35 MGTEXT 00680I******************************************************************** 00690IJQMAST JQ 00700I* JOB QUEUE MASTER. 00710I* JOB NUMB 4N 00720I 1 40JQNUMB 00730I* DEVICE 2A 00740I* COL-1,DEVICE CODE 00750I* Y = SHARED ÐÐ00760I* N = NON-SHARABLE 00770I* COL-2,DEVICE CODE 00780I* S = SYST PRINTER 00790I* D = DIABLO PRINTER 00800I* T = TERMINAL 00810I* C = CONSOLE 00820I 5 6 JQDEV 00830I* DEPT # 5N 00840I 7 110JQDEPT 00850I* JOB NAME 6A 00860I 12 17 JQJOB 00870I* PRINTER 1A 00880I 18 18 JQPRTR 00890I* PAPER 25A 00900I 19 43 JQPAP 00910I* COPIES REQUESTED 1N 00920I 44 440JQCOPY 00930I* REQUESTED BY 12A 00940I 45 56 JQRBY 00950I* REQUEST DATE 6N 00960I 57 620JQRDAT 00970I* REQUEST TIME 6N 00980I 63 680JQRTIM 00990I* NEED BY DATE 6N 01000I 69 740JQNDAT ÐÐ01010I* NEED BY TIME 6N 01020I 75 800JQNTIM 01030I* DATE COMPLETED 6N 01040I 81 860JQCDAT 01050I* TIME COMPLETED 6N 01060I 87 920JQCTIM 01070I* RECORD STATUS 1A 01080I 96 96 JQSTAT 01090C******************************************************************** 01100C* INITIALIZE. 01110C EXSR SR101 INIT. 01120C H9 GOTO ENDJOB 01130C SETON 71 01140C EXCPT PUT HEADINGS 01150C SETOF 71 01160C Z-ADD5 LINENO 30 SCREEN LINE 01170C*------------------------------------------------------------------- 01180C START TAG 01190C SETOF 54 01200C READ JQJOB 54 READ JOB QUE. 01210C 54 GOTO TAG100 END FILE. 01220C JJSTAT COMP 'D' 54 01230C 54 GOTO START DELETED. 01240C JJJOB CHAINJQMAST 54 01250C N54 JQSTAT COMP 'D' 54 ÐÐ01260C 54 SETON 83 01270C 54 EXCPT DELETE JQJOB. 01280C 54 SETOF 83 01290C 54 GOTO START 01300C JQJOB CHAINBJMAST 54 01310C N54 BJSTAT COMP 'D' 54 01320C 54 SETON 84 01330C 54 EXCPT DEL JQJOB/MAST. 01340C 54 SETOF 84 01350C 54 GOTO START 01360C JQDEPT LOKUPTABDEP TABDN 54 GET DEPT NAME 01370C 54 MOVE TABDN DEPNAM 16 01380C N54 MOVE BLK35 DEPNAM 01390C SETON 72 01400C EXCPT DISPLAY QUE. 01410C SETOF 72 01420C 2 ADD LINENO LINENO 30 01430C LINENO COMP 28 54 01440C N54 GOTO START NOT END PAGE. 01450C EXITFQEPAGE END PAGE MSG. 01460C EXSR SR75 READ. 01470C 98 GOTO GOODBY 01480C 94 GOTO MENU 01490C 93 GOTO NEWITM 01500C Z-ADD5 LINENO ÐÐ01510C SETON 71 01520C EXCPT PUT HEADINGS 01530C SETOF 71 01540C GOTO START 01550C*------------------------------------------------------------------- 01560C TAG100 TAG 01570C EXITFQEFILE END FILE MSG. 01580C EXSR SR75 READ. 01590C 98 GOTO GOODBY 01600C 94 GOTO MENU 01610C 93 GOTO NEWITM 01620C*------------------------------------------------------------------- 01630C NEWITM TAG 01640C MOVEL'Q003JQ' PROG 8 01650C GOTO END 01660C*------------------------------------------------------------------- 01670C MENU TAG 01680C MOVEL'QQDP01' PROG 01690C GOTO END 01700C*------------------------------------------------------------------- 01710C GOODBY TAG 01720C MOVEL'GOODBY' PROG 01730C GOTO END 01740C*------------------------------------------------------------------- 01750C END TAG ÐÐ01760C PROG COMP BLK8 54 01770C N54 GOTO ENDJOB 01780C EXITFCHAIN 01790C RLABL PROG 01800C*------------------------------------------------------------------- 01810C ENDJOB TAG 01820C******************************************************************** 01830CSR SR73 BEGSR 01840C* PUT MESSAGE. 01850CSR M CHAINMGFILE 54 01860CSR SETON 73 01870CSR EXCPT PUT MSG. 01880CSR SETOF 73 01890CSR ENDSR 01900C******************************************************************* 01910CSR SR75 BEGSR 01920C* READ FROM TERMINAL 01930CSR SETOF 779096 01940CSR SETOF 939291 01950CSR SETOF 898887 01960CSR SETOF 8685 01970CSR MOVE BIT,5 A6,2 BUF LENGTH 01980CSR MOVEAA6 W6A 6 01990CSR MOVE BLK8 W8A 8 BUFFER 02000CSR EXITFQWREED READ TERM ÐÐ02010CSR RLABL W8A 02020CSR RLABL W6A 02030CSR MOVEAW8A A8 02040CSR MOVE BLK8 W8A 02050CSR Z-ADD1 W 30 02060CSR '\' LOKUPA8,W 90 FLAG ESC 02070CSRN90 GOTO T75B NOT ESC 02080CSR 1 ADD W W 02090CSR W COMP 8 54 02100CSR 54 GOTO T75A BAD ESC 02110CSR A8,W COMP 'G' 98 GOODBY 02120CSR A8,W COMP 'E' 94 MENU 02130CSR A8,W COMP 'N' 93 NEW ITEM 02140CSR A8,W COMP 'J' 92 JUMP 02150CSR A8,W COMP 'F' 91 SKIP FRWRD 02160CSR A8,W COMP 'B' 89 SKIP BKWRD 02170CSR A8,W COMP 'S' 88 SPACE FILL 02180CSR A8,W COMP 'H' 87 HOME 02190CSR A8,W COMP 'U' 86 UPDATE 02200CSR A8,W COMP 'R' 85 REPEAT 02210CSR 98 02220COR 94 02230COR 93 02240COR 92 02250COR 91 ÐÐ02260COR 89 02270COR 88 02280COR 87 02290COR 86 02300COR 85 GOTO END75 GOOD ESC 02310C*------------------------------------------------------------------ 02320CSR T75A TAG 02330C* FLAG BAD ESC INPUT 02340CSR Z-ADD318 M 50 96 FLAG ERROR 02350CSR GOTO END75 02360C*-------------------------------------------------------------------- 02370CSR T75B TAG 02380C* MOVE DATA 02390CSR Z-ADD1 W 02400CSR ' ' LOKUPA8,W 77 02410CSR 77 MOVEAA8,W W8A INPUT DATA 02420C*-------------------------------------------------------------------- 02430CSR END75 TAG 02440C* INIT PREV ERROR MSG. 02450CSR LSTERR COMP 0 54 02460CSR 54 MOVE BLK35 MGTEXT 02470CSR 54 EXSR SR73 BLANK MESSAGE 02480CSR Z-ADD0 LSTERR 50 02490CSR ENDSR 02500C*********************************************************************** ÐÐ02510CSR SR101 BEGSR 02520C* 1-TIME INITIALIZE 02530CSR MOVE BIT,1 NUL 02540CSR MOVE BIT,1 A6 02550C*R ***** Z-ADD FLIMIT 30 TOTAL NUMB FIELDS 02560CSR MOVE ' ' BLK8 8 02570C* DEFINE WORK FIELDS,ETC. 02580CSR MOVE ' ' BLK35 35 02590CSR ENDSR 02600O******************************************************************** 02610OTERM132 E 71 02620O* PUT HEADING. 02630O*------------------------------------------------------------------- 02640O E 71 02650O 70 'JOB QUEUE' 02660O*------------------------------------------------------------------- 02670O E 71 02680O 28 'JOB' 02690O 92 'NEED' 02700O 98 'DEV' 02710O*------------------------------------------------------------------- 02720O E 71 02730O 4 'JOB#' 02740O 9 'DEPT' 02750O 29 'NAME' ÐÐ02760O 79 'REQ-BY' 02770O 91 'BY' 02780O 99 'CODE' 02790O 112 'FORMS-REQ''D' 02800O 129 'COPY' 02810O*------------------------------------------------------------------- 02820O E 72 02830O* PUT DATA. 02840O JQNUMBZ 4 02850O JQDEPTZ 9 02860O DEPNAM 27 02870O U1 JQJOB 31 02880O BJDESC 73 02890O JQRBY 85 02900O JQNDATY 94 02910O JQDEV 98 02920O JQPAP 125 02930O JQCOPYZ 128 02940O*------------------------------------------------------------------- 02950O E 72 02960O JQNTIM 94 ' : : ' 02970O*------------------------------------------------------------------- 02980O E 73 02990O* PUT MSG. 03000O MGTEXT 35 ÐÐ03010O******************************************************************** 03020OJQJOB E 83 03030O OR 84 03040O 11 'D' 03050O******************************************************************** 03060OJQMAST E 84 03070O 96 'D' 03080O******************************************************************** ** NUL ARRAY 003090 003100** A6 ARRAY 003110 003120** A8 ARRAY 003130 003140/* 003150_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¼@~ ¼$X306EM P@@120282120282(èÈÐ00010H Q306EM00020F* PRINT PAYROLL REGISTER (X306EM) 00030F* REVISED 12-13-82 1:25 PM. 00040F* 00050FPYCURERNIP F 530 5AI 1 DISK 00060FPYDATRECIT F 80 EDISK 00070FPRINT O F 132 OF PRINTER 00080F************************************************************************ 00090E PYDATREC TABCOD 1 1 1 TABDTA 16 P/R DATE, RUN, CK# 00100E PYJ 5 1 O JOB STATUS CODES 00110E CTH 7 5 1 O CURR HOURS 00120E CTE 7 9 2 O CURR $ 00130E CTF 6 7 2 O CURR FED TAX 00140E CTS 6 7 2 O CURR ST TAX 00150E CDA 10 7 2 DEDT AMT 00160E YTH 7 5 1 YTD HRS 00170E YTE 7 9 2 YTD $ 00180E YTF 6 7 2 YTD FED TAX 00190E YTS 6 7 2 YTD ST TAX 00200E YDA 10 7 2 YTD DED 00210I******************************************************************* 00220IPYCURERNPY 00230I* CURRENT EARNINGS RECORD 00240I* CLOCK # 5N 00250I 1 50PYCLOKL1 ÐÐ00260I* DEPT 5N 00270I 6 100PYDEPT 00280I* JOB STATUS 1A X 5 00290I* 1 = ADMIN(A) OR FACTORY(F) 00300I* 2 = PERMANENT(P) OR TEMPORARY(T) 00310I* 3 = FULL TIME(F) OR PART TIME(P) 00320I* 4 = HOURLY(H) OR SALARY(S) 00330I* 5 = DIRECT(D) OR INDIRECT(I) 00340I 11 15 PYJ 00350I* COMPREHENSIVE INSURANCE CLASS 1A 00360I 16 16 PYCICA 00370I* NAME 00380I* 1ST 25A 00390I 17 41 PYFNAM 00400I* MIDDLE 25A 00410I 42 66 PYMNAM 00420I* LAST 30A 00430I 67 96 PYLNAM 00440I*-------PAYROLL YEAR-TO-DATE TOTALS------------------------------------- 00450I* HOURS ARRAY 5.1P X 7 00460I* 1 = REGULAR 00470I* 2 = PREMIUM 00480I* 3 = VACATION 00490I* 4 = SICK LEAVE 00500I* 5 = ABSENT ÐÐ00510I* 6 = OTHER 00520I* 7 = NOT USED 00530I P 114 134 YTH 00540I* EARNED DOLLARS 9.2P X 7 00550I* 1 = REGULAR 00560I* 2 = PREMIUM 00570I* 3 = VACATION 00580I* 4 = SICK LEAVE 00590I* 5 = BONUS 00600I* 6 = OTHER 00610I* 7 = NOT USED 00620I P 135 169 YTE 00630I* DEDUCTION TOTALS 00640I* FEDERAL TAX 7.2P X 6 00650I* 1 = WITHHOLDING 00660I* 2 = XTRA WITHHOLDING 00670I* 3 = REBATED (EIC) 00680I* 4 = FICA 00690I* 5 = NOT USED 00700I* 6 = NOT USED 00710I P 170 193 YTF 00720I* STATE TAX 7.2P X 6 00730I* 1 = WITHHOLDING 00740I* 2 = XTRA WITHHOLDING 00750I* 3 = REBATED (EIC) ÐÐ00760I* 4 = SDI 00770I* 5 = NOT USED 00780I* 6 = NOT USED 00790I P 194 217 YTS 00800I*-------PAYROLL TOTALS CURRENT PERIOD------------------------------- 00810I* HOURS ARRAY 5.1P X 7 00820I* 1 = REGULAR 00830I* 2 = PREMIUM 00840I* 3 = VACATION 00850I* 4 = SICK LEAVE 00860I* 5 = ABSENT 00870I* 6 = OTHER 00880I* 7 = NOT USED 00890I P 218 238 CTH 00900I* EARNED DOLLARS 9.2P X 7 00910I* 1 = REGULAR 00920I* 2 = PREMIUM 00930I* 3 = VACATION 00940I* 4 = SICK LEAVE 00950I* 5 = BONUS 00960I* 6 = OTHER 00970I* 7 = NOT USED 00980I P 239 273 CTE 00990I* DEDUCTION TOTALS 01000I* FEDERAL TAX 7.2P X 6 ÐÐ01010I* 1 = WITHHOLDING 01020I* 2 = XTRA WITHHOLDING 01030I* 3 = REBATED (EIC) 01040I* 4 = FICA 01050I* 5 = NOT USED 01060I* 6 = NOT USED 01070I P 274 297 CTF 01080I* STATE TAX 7.2P X 6 01090I* 1 = WITHHOLDING 01100I* 2 = XTRA WITHHOLDING 01110I* 3 = REBATED (EIC) 01120I* 4 = S.D.I. 01130I* 5 = NOT USED 01140I* 6 = NOT USED 01150I P 298 321 CTS 01160I*------------------------------------------------------------------- 01170I* TAX ERROR FLAG 'X' 01180I 322 322 PYERR 01190I* PERIOD ENDING DATE 6N 01200I 323 3280PYDATE 01210I* PAYROLL RUN # 2A 01220I 329 330 PYRUN 01230I* FLAG NO REBATE THIS CHECK '*' 01240I 331 331 PYNORB 01250I* HOLD PAY CHECK CODE 1A ÐÐ01260I 332 332 PYHOLD 01270I* PAY FREQUENCY 1A 01280I* W = WEEKLY 01290I* L = LOA 01300I* N = NO LABOR OR $ 01310I* T = TERMINATED 01320I 333 333 PYFRQ 01330I* DEDUCTION AMT 7.2P X 10 01340I P 424 463 CDA 01350I* DED YEAR TO DATE 7.2P X 10 01360I P 464 503 YDA 01370I*-------FEDERAL TAX CODES-------------------------------------------- 01380I* MARITAL STATUS 1A 01390I* M = MARRIED 01400I* S = SINGLE 01410I* H = HEAD OF HOUSEHOLD 01420I* X = EXEMPT 01430I 504 504 PYFTMS 01440I* NUMBER OF EXEMPTIONS 2N 01450I 505 5060PYFTNE 01460I* EXTRA EXEMPTIONS 2N 01470I 507 5080PYFXEX 01480I* XTRA WITHHOLDING CODE 1A (%,$) 01490I 509 509 PYFTXC 01500I* XTRA WITHHOLDING AMOUNT 4N ÐÐ01510I 510 5130PYFTXA 01520I* EIC CLAIM (1,2) 1N 01530I 514 5140PYFEIC 01540I*-------STATE TAX CODES------------------------------------------- 01550I* MARITAL STATUS 1A 01560I* M = MARRIED 01570I* S = SINGLE 01580I* H = HEAD OF HOUSEHOLD 01590I* X = EXEMPT 01600I 515 515 PYSTMS 01610I* NUMBER OF EXEMPTIONS 2N 01620I 516 5170PYSTNE 01630I* EXTRA EXEMPTIONS 2N 01640I 518 5190PYSXEX 01650I* XTRA WITHHOLDING CODE 1A 01660I 520 520 PYSTXC 01670I* XTRA WITHHOLDING AMOUNT 4N 01680I 521 5240PYSTXA 01690I* EICA CLAIM 1N 01700I 525 5250PYSEIC 01710I* EMP PAY RATE 5.3P 01720I P 526 5303PYRATE 01730I******************************************************************** 01740C L1 EXSR SR201 CLEAR WORK FIELDS 01750C N91 EXSR SR101 1 TIME GET P/E DATE ÐÐ01760C PYJ,1 COMP 'A' 58ADMIN BYPASS****** 01770C 58 SETON 90 *** 01780C 90 GOTO END 01790C EXSR SR90 CK HOLD, ERR FLAGS 01800C EXSR SR10 CUM CURR FIELDS 01810C EXSR SR30 CUM YTD AMTS 01820C EXSR SR20 CUM CURR TOTALS 01830C EXSR SR40 CUM YTD TOTALS 01840C*-------------------------------------------------------------------------01850C END TAG 01860C************************************************************************ 01870CSR SR10 BEGSR 01880C* MOVE DATA TO CURRENT AMOUNT FIELDS 01890CSR EXSR SR11 MOVE NAME 01900CSR XFOOTCTH TOTHRS 51 TOTAL HRS 01910CSR TOTHRS SUB CTH,5 TOTHRS TAKE OUT ABS 01920CSR TOTHRS SUB CTH,2 TOTHRS LESS OT 01930CSR XFOOTCTE GROSS 92 TOTAL $ 01940CSR Z-ADDCTF,1 FWT 72 FED W/H 01950CSR FWT ADD CTF,2 FWT ADD EXTRA W/H 01960CSR Z-ADDCTF,3 EIC 72 FED REBATE 01970CSR Z-ADDCTF,4 FICA 72 FICA 01980CSR Z-ADDCTS,1 SWT 72 STATE W/H 01990CSR SWT ADD CTS,2 SWT ADD EXTRA W/H 02000CSR Z-ADDCTS,4 SDI 72 STATE DISABILITY ÐÐ02010CSR XFOOTCDA DED 72 PERSONAL DEDT 02020CSR EXSR SR15 CALC NET 02030CSR 80 1 ADD CKS CKS INCREM CK# 02040CSR ENDSR 02050C**************************************************************************02060CSR SR11 BEGSR 02070C* GET INITIALS AND SHORTER LAST NAME 02080CSR MOVELPYFNAM W1A 1ST INITIAL 02090CSR MOVELW1A W2A 02100CSR MOVELPYMNAM W1A 2ND INITIAL 02110CSR MOVE W1A W2A INITIALS 02120CSR MOVELPYLNAM W15A LAST NAME 02130CSR ENDSR 02140C**************************************************************************02150CSR SR15 BEGSR 02160C* CALCULATE NET AMOUNT 02170CSR XFOOTCTF TOTFD TOT FED TAX 02180CSR TOTFD SUB CTF,3 TOTFD LESS REBATE 02190CSR XFOOTCTS TOTST TOT STATE TAX 02200CSR TOTST SUB CTS,3 TOTST LESS REBATE (NOT USED02210CSR GROSS SUB TOTFD NET GROSS LESS FED TAX 02220CSR NET SUB TOTST NET LESS STATE TAX 02230CSR NET SUB DED NET LESS DEDUCTIONS 02240CSR NET ADD EIC NET 545658 ADD REBATE = 02250CSR 56 SETON 98 MINUS, NO CK ÐÐ02260CSR 54 SETON 80 NET > ZERO 02270CSR 98 SETOF 80 NO CK # 02280CSR 58 SETOF 98 ZERO, NO ERR 02290CSR ENDSR 02300C**************************************************************************02310CSR SR20 BEGSR 02320C* CUM FIELDS TO FINAL TOTALS (CURRENT) 02330CSR GROSS ADD CURGRS CURGRS 92 FINAL CURR GROSS 02340CSR SWT ADD CSWT CSWT 72 " STATE W/H 02350CSR SDI ADD CSDI CSDI 72 " STATE DIS 02360CSR FWT ADD CFWT CFWT 72 " FED W/H 02370CSR FICA ADD CFICA CFICA 72 " FICA 02380CSR EIC ADD CEIC CEIC 72 " FED REBATE 02390CSR DED ADD CDED CDED 72 " PERS DEDT 02400CSR NET ADD CNET CNET 92 FINAL NET 02410CSR ENDSR 02420C************************************************************************ 02430CSR SR30 BEGSR 02440C* ADD CURRENT TO YTD AMTS 02450CSR CTE ADD YTE YTE YTD EARN $ 02460CSR CTF ADD YTF YTF YTD FED TAX 02470CSR CTS ADD YTS YTS YTD ST TAX 02480CSR CDA ADD YDA YDA YTD DED 02490C* SELECT YTD AMTS TO PRINT FIELDS 02500CSR XFOOTYTE YGROSS 92 YTD GROSS ÐÐ02510CSR Z-ADDYTF,1 YFWT 72 YTD FED W/H 02520CSR YFWT ADD YTF,2 YFWT ADD EXTRA W/H 02530CSR Z-ADDYTF,3 YEIC 72 YTD EIC 02540CSR Z-ADDYTF,4 YFICA 72 YTD FICA 02550CSR Z-ADDYTS,1 YSWT 72 YTD STATE W/H 02560CSR YSWT ADD YTS,2 YSWT ADD EXTRA W/H 02570CSR Z-ADDYTS,4 YSDI 72 YTD SDI 02580CSR XFOOTYDA YDED 72 YTD DED 02590CSR EXSR SR35 CALC YTD NET 02600CSR ENDSR 02610C*********************************************************************** 02620CSR SR35 BEGSR 02630C* CALCULATE YTD NET 02640CSR XFOOTYTF TOTFD YTD FED TOT 02650CSR TOTFD SUB YTF,3 TOTFD LESS REBATE 02660CSR XFOOTYTS TOTST YTD ST TOT 02670CSR TOTST SUB YTS,3 TOTST 02680CSR YGROSS SUB TOTFD YNET YTD GROSS LESS FED 02690CSR YNET SUB TOTST YNET LESS STATE TAX 02700CSR YNET SUB YDED YNET LESS PERS DED 02710CSR YNET ADD YEIC YNET PLUS REBATES 02720CSR ENDSR 02730C************************************************************************ 02740CSR SR40 BEGSR 02750C* CUM YTD FIELDS TO FINAL YTD TOTALS ÐÐ02760CSR YGROSS ADD YTDGRS YTDGRS 102 FINAL YTD GROSS 02770CSR YSWT ADD FSWT FSWT 82 " STATE W/H 02780CSR YSDI ADD FSDI FSDI 82 " STATE DIS INS 02790CSR YFWT ADD FFWT FFWT 82 " FED W/H 02800CSR YFICA ADD FFICA FFICA 82 " FICA 02810CSR YEIC ADD FEIC FEIC 82 " EIC 02820CSR YDED ADD FDED FDED 82 " PERS DED 02830CSR YNET ADD FNET FNET 102 " FINAL NET 02840CSR ENDSR 02850C**************************************************************************02860CSR SR90 BEGSR 02870C* CHECK FOR HOLD PAYCHECK, ERROR FLAG BYPASS 02880CSR PYHOLD COMP ' ' 58 02890CSRN58 SETON 98 HOLD CK 02900CSR PYERR COMP ' ' 58 02910CSRN58 SETON 98 ERROR 02920CSR ENDSR 02930C**************************************************************************02940CSR SR101 BEGSR 02950C* 1 TIME MOVE PERIOD ENDING DATE TO PRINT, GET BEGINNING CK# 02960CSR SETON 9195 ONE TIME, 1ST PAGE 02970CSR 'P' LOKUPTABCOD 58 02980CSR MOVE TABDTA CK# 80 1ST CK # 02990CSR CK# SUB 1 CKS 80 LESS ONE 03000CSR MOVE PYDATE W4A 4 MMDD ÐÐ03010CSR MOVELPYDATE W2A YY 03020CSR MOVELW4A PEDATE 60 PERIOD ENDING DATE 03030CSR MOVE W2A PEDATE MMDDYY 03040CSR MOVELPYRUN W1A 03050CSR W1A COMP 'S' 99SUPPL # 03060CSR ENDSR 03070C************************************************************************* 03080CSR SR201 BEGSR 03090C* INIT EARNINGS WORK FIELDS 03100CSR SETOF 90 ADMIN BYPASS 03110CSR SETOF 959880SKIP HOLD PAY ? 03120CSR MOVE ' ' W1A 1 03130CSR MOVE ' ' W2A 2 03140CSR MOVE ' ' W15A 15 03150CSR Z-ADD0 TOTST 72 TOT STATE TAX 03160CSR Z-ADD0 TOTFD 72 TOT FED TAX 03170CSR Z-ADD0 NET 92 NET AMT 03180CSR Z-ADD0 YNET 92 03190CSR ENDSR 03200O******************************************************************* 03210OPRINT D 203 95 03220O OR OF 03230O UDATE 8 ' - - ' 03240O 63 'PAYROLL REGISTER' 03250O 99 PYRUN 80 ÐÐ03260O 99 79 '- SUPPLEMENT ' 03270O 109 'PERIOD ENDING' 03280O PEDATE 118 ' - - ' 03290O PAGE Z 132 03300O 129 'PAGE' 03310O*-------------------------------------------------------------------------03320O D 12 95 03330O OR OFNLR 03340O 10 'EMP # DEPT' 03350O 19 'NAME' 03360O 33 'EX' 03370O 43 'RATE' 03380O 50 'HOURS' 03390O 64 'GROSS' 03400O 72 'SWT' 03410O 80 'SDI' 03420O 88 'FWT' 03430O 96 'FICA' 03440O 104 'EIC' 03450O 112 'DEDT' 03460O 124 'NET PAY' 03470O 132 'CHECK #' 03480O*--------------------------------------------------------------------- 03490O TF 1 L1N90 03500O PYCLOK 5 ' 0 ' ÐÐ03510O PYDEPTZ 10 03520O W2A 14 03530O W15A 30 03540O PYFTNE 32 '0 ' 03550O PYFTMS 33 03560O PYFXEXZ 35 03570O PYRATE3 44 03580O TOTHRS3B 50 03590O GROSS 1B 64 03600O SWT 3B 72 03610O SDI 3B 80 03620O FWT 3B 88 03630O FICA 3B 96 03640O EIC 3B 104 03650O DED 3B 112 03660O NET J 125 03670O 80 CKS Z 132 03680O 98 132 '********' 03690O*----------------------------------------------------------------------- 03700O TF 2 L1N90 03710O 52 'YTD:' 03720O YGROSS1B 64 03730O YSWT 3B 72 03740O YSDI 3B 80 03750O YFWT 3B 88 ÐÐ03760O YFICA 3B 96 03770O YEIC 3B 104 03780O YDED 3B 112 03790O*-------------------------------------------------------------------------03800O TF22 LR 03810O 64 'CURRENT TOTALS' 03820O 124 'YEAR TO DATE TOTALS' 03830O*-------------------------------------------------------------------------03840O TF 1 LR 03850O CURGRSJ 65 03860O 87 'GROSS EARNINGS' 03870O YTDGRSJ 125 03880O TF 1 LR 03890O CSWT J 65 03900O 90 'STATE WITHHOLDING' 03910O FSWT J 125 03920O TF 1 LR 03930O CSDI J 65 03940O 94 'STATE DISABILITY INS.' 03950O FSDI J 125 03960O TF 1 LR 03970O CFWT J 65 03980O 92 'FEDERAL WITHHOLDING' 03990O FFWT J 125 04000O TF 1 LR ÐÐ04010O CFICA J 65 04020O 95 'SOCIAL SECURITY (FICA)' 04030O FFICA J 125 04040O TF 1 LR 04050O CEIC J 65 04060O 93 'EARNED INCOME CREDIT' 04070O FEIC J 125 04080O TF 1 LR 04090O CDED J 65 04100O 92 'PERSONAL DEDUCTIONS' 04110O FDED J 125 04120O TF 1 LR 04130O CNET J 65 04140O 90 'TOTAL NET PAYROLL' 04150O FNET J 125 /* 04160_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(x8‰ xHX003LD P120282120282(èÈÐ00010H Q003LD00020F* DAILY LABOR - DATA ENTRY. (X003LD) 00030F* REVISED 4/29/81 12:10 PM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FCRTFILE IC F 256R DISK 00060FKPMAST ID F 64L10AI 1 DISK 00070FKPDEPT ID F 13L12AI 1 DISK 00080FKPNAME UC F 352R 6AI 1 DISK 00090FKPCONT UC F 48R10AI 1 DISK A 00100FKPLABOR UC F 192R14AI 1 DISK A 00110FKPTABLE ID F 23L22AI 1 DISK 00120FMGFILE IC F 80R DISK 00130FTERM132 O F 132 5 00140E******************************************************************** 00150E JOB 1 30 6 FRM 1 JOB # 00160E KPS 1 30 1 SPEC INSTR 00170E KPN 1 30 12 NAME 00180E KPT 1 30 1 TYPE 00190E KPE 1 30 1 EDIT 00200E KPD 1 30 1 0 DEC PLACES 00210E COL 1 30 3 0A COLUMN 00220E SIZ 1 30 3 0 SIZE 00230E KPB 1 30 1 0A BATCH TOT # 00240E A15 15 15 1 A 00250E A6 6 6 1 A ÐÐ00260E A132 1 132 1 A 00270E ERR 1 5 5 0 00280E OPT 30 30 1 00290E POS 1 132 1 00300E KTN 1 30 18 TABLE NAMES 00310E KTO 1 30 3 A TABLE OPER 00320E SAV 1 132 1 00330E KPL 3 6 TABLE NAMES 00340E KPO 3 1 A OPERATORS 00350E BIT 256 1 00360E KCB 5 11 3 BAT TOTALS 00370I******************************************************************** 00380IBITHEX BT 00390I 1 256 BIT 00400I******************************************************************** 00410IMGFILE MG 00420I 1 35 MGTEXT 00430I******************************************************************** 00440IKPLABOR KE 00450I* KEY PUNCH DATA RECORD. 00460I* NOTE: SPACE ALLOWED EA FIELD MUST BE EDITED SIZE. 00470I 22 153 RECORD 00480I 192 192 KESTAT 00490I******************************************************************** 00500IKPTABLE KT ÐÐ00510I 1 6 KTNAME 00520I 7 21 KTVAL 00530I 23 23 KTSTAT 00540I**************************************************************** 00550IKPCONT KC 00560I* JOB # 6A 00570I 1 6 KCJOB 00580I* BATCH # 3N 00590I 8 100KCBAT 00600I* BATCH TOTALS 11.3P X 5 00610I P 11 40 KCB 00620I* RECORD COUNT 5P 00630I P 41 430KCREC 00640I* DEPT# 5P 00650I P 45 470KCDEPT 00660I* RECORD STATUS 1A 00670I 48 48 KCSTAT 00680I************************************************************** 00690ICRTFILE CR 00700I 1 50CREMPL 00710I 14 180CRDEPT 00720I 68 73 CRRET 00730I 74 79 CRMENU 00740I******************************************************************** 00750IKPMAST KP ÐÐ00760I* KEYPUNCH MASTER. 00770I* KEY AREA. 00780I* JOB # 6A 00790I 1 6 KPJOB 00800I* FORMAT CODE 1A 00810I 7 7 KPFRMT 00820I* SEQ NO. 3N 00830I 8 100KPSEQ 00840I* FIELD TYPE 1A 00850I* A = ALPHA N = NUMERIC 00860I 11 11 KPTYPE 00870I* START COLUMN 3P 00880I P 12 130KPCOL 00890I* FIELD SIZE 3P 00900I P 14 150KPSIZE 00910I* SPEC INSTR. 1A 00920I* D = DUP S = SKIP 00930I 16 16 KPSPEC 00940I* EDIT CODE 1A 00950I* (Z,2,K,Y) 00960I 17 17 KPEDIT 00970I* DECIMAL PLACES 1N 00980I 18 180KPDEC 00990I* SUB-TOTAL FIELD # 1N 01000I 19 190KPTOT ÐÐ01010I* FIELD NAME 12A 01020I 20 31 KPNAME 01030I* OPTION CODE 1A 01040I* M = MANDATORY 01050I 32 32 KPOPTN 01060I* TABLE AREA. 01070I* TABLE NAMES 6A X 3 01080I 33 50 KPL 01090I* OPERATORS 1A X 3 (>,<,=) 01100I 51 53 KPO 01110I* RECORD STATUS 1A 01120I 64 64 KPSTAT 01130I******************************************************************** 01140IKPDEPT KD 01150I* KEYPUNCH DEPT MENU RECORD. 01160I* KEY AREA. 01170I* DEPT # 5N 01180I 1 50KDDEPT 01190I* JOB # 6A 01200I 6 11 KDJOB 01210I* FORMAT CODE 1A 01220I 12 12 KDFRMT 01230I* RECORD STATUS 1A 01240I 13 13 KDSTAT 01250I******************************************************************** ÐÐ01260IKPNAME KN 01270I* KEYPUNCH JOB MASTER. 01280I* JOB # 6A 01290I 1 6 KNJOB 01300I* TITLE 60A 01310I 7 66 KNTITL 01320I* HEADING-LINE 1 132A 01330I 67 198 KNHL1 01340I* HEADING-LINE 2 132A 01350I 199 330 KNHL2 01360I* LAST BATCH NO. 5P 01370I P 331 3330KNLBAT 01380I* FORMAT CODE 1A (H,V) 01390I 334 334 KNFRMT 01400I* LINK-TO PROG NAME 8A 01410I 335 342 KNLINK 01420I* RECORD STATUS 1A 01430I 352 352 KNSTAT 01440C******************************************************************** 01450C START TAG 01460C* INITIALIZE. 01470C EXSR SR210 SETOFFS 01480C EXSR SR101 INIT. 01490C* DISPLAY K.P. MENU. 01500C EXSR SR102 DISPLAY KP MENU ÐÐ01510C*------------------------------------------------------------------- 01520C TAG10 TAG 01530C* REQUEST SELECTION. GET MASTER. 01540C EXSR SR210 SETOFFS 01550C EXSR SR103 RQST SELECT. 01560C 92 GOTO START BKWD ESC 01570C 98 GOTO GOODBY SIGN-OFF. 01580C 94 GOTO MENU BACK TO ITOS 01590C 93 GOTO NEWITM NEW ITEM. 01600C N77 GOTO TAG10 NO INPUT DATA 01610C*------------------------------------------------------------------- 01620C TAG20 TAG 01630C* DISPLAY K.P. LAYOUT. LOAD ARRAYS. 01640C EXSR SR68 CLEAR SCREEN 01650C EXSR SR210 SETOFFS 01660C EXSR SR104 PUT LAYOUT. 01670C* REQUEST SPECIAL INSTRUCTIONS (DUP,SKIP). 01680C EXSR SR111 RQST SPEC INSTR 01690C 92 GOTO TAG20 01700C 98 GOTO GOODBY SIGN-OFF 01710C 94 GOTO MENU MENU 01720C 93 GOTO TAG20 NEW ITEM 01730C*------------------------------------------------------------------- 01740C TAG40 TAG 01750C* REQUEST BATCH #. ÐÐ01760C EXSR SR210 01770C EXSR SR106 01780C 92 GOTO TAG20 01790C 98 GOTO GOODBY 01800C 94 GOTO MENU 01810C 93 GOTO NEWITM 01820C* CLEAR SCREEN. PUT HEADINGS. 01830C EXSR SR68 CLEAR SCREEN 01840C SETON 65 01850C EXSR SR107 PUT HEADING 01860C SETOF 65 01870C MOVE BLK132 LAST 132 INIT LAST LINE 01880C*------------------------------------------------------------------- 01890C TAG50 TAG 01900C* REQUEST RECORD #. 01910C EXSR SR210 SETOFFS 01920C EXSR SR109 RQST REC # 01930C 92 GOTO TAG40 01940C 98 GOTO GOODBY 01950C 94 GOTO MENU 01960C 93 GOTO NEWITM 01970C RECNO SUB 1 RECNO 50 01980C SETOF 38 01990C*------------------------------------------------------------------- 02000C TAG60 TAG ÐÐ02010C* ACCEPT INPUT. 02020C EXSR SR210 SETOFFS 02030C EXSR SR108 INPUT DATA 02040C 98 GOTO GOODBY SIGN-OFF 02050C 94 GOTO START MENU 02060C 93 GOTO TAG50 DISPLAY LAYOUT 02070C SETON 38 02080C GOTO TAG60 02090C*------------------------------------------------------------------- 02100C GOODBY TAG 02110C MOVEL'GOODBY' CRRET 02120C GOTO END 02130C*------------------------------------------------------------------- 02140C NEWITM TAG 02150C MOVEL'Q003LD' CRRET 02160C GOTO END 02170C*------------------------------------------------------------------- 02180C MENU TAG 02190C MOVELCRMENU CRRET 02200C GOTO END 02210C*------------------------------------------------------------------- 02220C END TAG 02230C 83 EXSR SR82 02240C SETOF 54 02250C MOVELKNLINK PROG 8 ÐÐ02260C 20 PROG COMP BLK8 54 02270C N54 MOVELCRRET PROG 02280C EXITFCHAIN 02290C RLABL PROG 02300C******************************************************************** 02310CSR SR68 BEGSR 02320C* CLEAR SCREEN. 02330CSR EXITFQTOPF CLEAR SCREEN. 02340CSR ENDSR 02350C*************************************************************** 02360CSR SR70 BEGSR 02370C* REWRITE INPUT LINE 02380CSR SETON 32 02390CSR EXCPT PUT TITLE LINE 02400CSR SETOF 32 02410CSR MOVELLINENO W6A 02420CSR MOVE '001' W6A 02430CSR EXITFQXYPOS POSITION CURSOR 02440CSR RLABL W6A 02450CSR EXITFQMOVUP 02460CSR SETON 70 02470CSR EXCPT 02480CSR SETOF 70 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR73 BEGSR 02520C* PUT MSG. 02530CSR M CHAINMGFILE 54 02540CSR SETON 73 02550CSR EXCPT 02560CSR SETOF 73 02570CSR 96 Z-ADDM LSTERR 50 02580CSR ENDSR 02590C******************************************************************* 02600CSR SR75 BEGSR 02610C* READ 6-BYTES FROM TERMINAL. 02620CSR EXSR SR210 02630CSR MOVE BIT,4 BUFLGT 02640CSR MOVE BLK6 W6A 6 02650CSR MOVE BIT,28 A15,1 02660CSR MOVE '8' A15,2 02670CSR MOVEA'002045' A15,3 02680CSR MOVE BIT,8 A15,9 02690CSR MOVEAA15,1 W9A 9 02700CSR EXITFQPREED READ. 02710CSR RLABL W9A XY-POS 02720CSR RLABL W6A BUFFER 02730CSR RLABL BUFLGT BUF LGTH 02740CSR MOVEAW6A A6 02750CSR MOVE BLK6 W6A ÐÐ02760CSR Z-ADD1 W 30 02770CSR '\' LOKUPA6,W 90 02780CSRN90 GOTO T75B NOT ESC 02790CSR 1 ADD W W 02800CSR W COMP 6 54 02810CSR 54 GOTO T75A 02820CSR A6,W COMP 'G' 98 02830CSR A6,W COMP 'E' 94 02840CSR A6,W COMP 'N' 93 02850CSR A6,W COMP 'B' 92 02860C* 02870C* 02880CSR GOTO END75 02890C*------------------------------------------------------------------- 02900CSR T75A TAG 02910C* FLAG BAD ESC. 02920CSR Z-ADD318 M 50 96 FLAG ERROR. 02930CSR EXSR SR73 PUT MSG 02940CSR GOTO SR75 02950C*------------------------------------------------------------------- 02960CSR T75B TAG 02970C* MOVE DATA. 02980CSR Z-ADD1 W 02990CSR ' ' LOKUPA6,W 77 03000CSR 77 MOVEAA6 W6A ÐÐ03010CSR EXSR SR76 CLEAR MSG 03020CSR END75 ENDSR 03030C******************************************************************** 03040CSR SR76 BEGSR 03050C* CLEAR MSG. 03060CSR LSTERR COMP 0 54 03070CSR 54 Z-ADD0 LSTERR 03080CSR 54 MOVE BLK132 MGTEXT 03090CSR 54 SETON 73 03100CSR 54 EXCPT BLK MSG 03110CSR SETOF 73 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR82 BEGSR 03150C* UPDATE KPCONT. 03160CSR SETON 82 03170CSR EXCPT UPDATE KPCONE 03180CSR SETOF 8283 03190CSR ENDSR 03200C******************************************************************** 03210CSR SR101 BEGSR 03220C* INITIALIZE. 03230CSR MOVELBIT,1 BUFLGT 2 03240CSR EXSR SR68 CLEAR SCREEN 03250CSR MOVE ' ' BLK18 18 ÐÐ03260CSR MOVE ' ' BLK132132 03270CSR MOVE ' ' BLK6 6 03280CSR MOVE ' ' BLK7 7 03290CSR MOVE ' ' BLK8 8 03300CSR MOVE ' ' BLK15 15 03310CSR MOVE ' ' W8A 8 03320CSR MOVE ' ' W2A 2 03330CSR Z-ADD0 W1N 10 03340CSR Z-ADD0 W2N 20 03350CSR EXITFPGMINX GET PORT# 03360CSR RLABL W8A 03370CSR RLABL W2N 03380CSR RLABL W1N 03390CSR RLABL W2A 03400CSR MOVE W2A PORT 20 03410CSR PORT COMP 0 54 03420CSRN54 Z-ADD25 PORT 03430CSR PORT CHAINCRTFILE H9 03440CSR MOVELUDATE W4N 40 03450CSR MOVE UDATE W2N 03460CSR MOVELW2N TODAY 60 03470CSR MOVE W4N TODAY 03480CSR END101 ENDSR 03490C******************************************************************** 03500CSR SR102 BEGSR ÐÐ03510C* PUT DEPT MENU. 03520CSR MOVE BLK7 JOB 03530CSR Z-ADD0 J 30 03540CSR SETON 71 03550CSR EXCPT PUT HEADING 03560CSR SETOF 71 03570CSR MOVELCRDEPT W11A 11 03580CSR MOVE BLK6 W11A 03590CSR MOVELW11A W12A 12 03600CSR W12A SETLLKPDEPT 03610C*------------------------------------------------------------------- 03620CSR T102A TAG 03630CSR SETOF 54 03640CSR READ KPDEPT 54 03650CSR 54 GOTO END102 END OF FILE. 03660CSR KDDEPT COMP CRDEPT 54 03670CSRN54 GOTO END102 DONE. 03680CSR KDSTAT COMP 'D' 54 03690CSR 54 GOTO T102A DELETED. 03700CSR 1 ADD J J 03710CSR MOVE KDJOB JOB,J SAVE JOB. 03720CSR MOVE KDFRMT FRM,J AND FORMAT. 03730CSR KDJOB CHAINKPNAME H8 03740CSR H8 GOTO END102 PROG ERROR 03750CSR SETON 72 ÐÐ03760CSR EXCPT PUT MENU 03770CSR SETOF 72 03780CSR GOTO T102A 03790CSR END102 ENDSR 03800C******************************************************************** 03810CSR SR103 BEGSR 03820C* REQUEST SELECTION. 03830C*------------------------------------------------------------------- 03840CSR T103A TAG 03850CSR SETON 74 03860CSR EXCPT RQST MSG. 03870CSR SETOF 74 03880CSR EXSR SR75 READ. 03890CSRN77 GOTO END103 NO DATA OR ESC. 03900CSR EXSR SR202 R. JUSTIFY. 03910CSR MOVE W6A W3N 30 03920CSR W3N COMP 0 54 03930CSR 54 W3N COMP J 5454 03940CSRN54 SETON 75 03950CSRN54 EXCPT PUT ERR MSG 03960CSRN54 SETOF 75 03970CSRN54 GOTO T103A 03980CSR Z-ADDW3N J 03990CSR MOVE JOB,J JOBNO 6 04000CSR MOVE FRM,J FORMAT 1 ÐÐ04010CSR END103 ENDSR 04020C******************************************************************** 04030CSR SR104 BEGSR 04040C* DISPLAY K.P. LAYOUT. 04050CSR EXSR SR201 INIT AR'S. 04060CSR SETON 76 04070CSR EXCPT PUT HEADING 04080CSR SETOF 76 04090CSR MOVE ' ' POS 04100CSR MOVELJOBNO W7AA 7 04110CSR MOVE FORMAT W7AA 04120CSR MOVELW7AA W10A 10 04130CSR MOVE '000' W10A 04140CSR W10A SETLLKPMAST 04150CSR Z-ADD0 P 30 04160C*------------------------------------------------------------------- 04170CSR T104A TAG 04180CSR SETOF 54 04190CSR READ KPMAST 54 GET KPMAST 04200CSR 54 GOTO END104 END FILE. 04210CSR MOVELKPJOB W7A 7 04220CSR MOVE KPFRMT W7A 04230CSR W7A COMP W7AA 54 04240CSRN54 GOTO END104 WRONG JOB. 04250CSR KPSTAT COMP 'D' 54 ÐÐ04260CSR 54 GOTO T104A DELETED. 04270CSR 1 ADD P P 04280CSR MOVE KPSPEC KPS,P SPEC INSTR 04290CSR MOVE KPNAME KPN,P FIELD NAME 04300CSR MOVE KPTYPE KPT,P FIELD TYPE 04310CSR MOVE KPEDIT KPE,P EDIT CODE 04320CSR MOVE KPDEC KPD,P DEC PLACES 04330CSR MOVE KPCOL COL,P START COL 04340CSR MOVE KPSIZE SIZ,P FIELD SIZE 04350CSR MOVE KPTOT KPB,P SUB-TOT # 04360CSR MOVE KPOPTN OPT,P OPTION CODE 04370CSR MOVEAKPL KTN,P TAB NAME 04380CSR MOVEAKPO KTO,P TAB OP 04390CSR KTN,P COMP BLK18 54 04400CSRN54 OPT,P COMP 'M' 54 04410CSR KPS,P COMP 'S' 55 04420CSR 54 55 MOVE ' ' KPS,P 04430CSR MOVE ' ' W3A 3 04440CSR Z-ADDCOL,P X 30 04450CSR P COMP 9 54 04460CSR P COMP 99 55 04470CSR Z-ADD1 W2N 04480CSR 54 Z-ADD2 W2N 04490CSR 55 Z-ADD3 W2N 04500CSR MOVE 'Z' W1A ÐÐ04510CSR EXIT SUBRED 04520CSR RLABL P 04530CSR RLABL W1A 04540CSR RLABL W3A 04550CSR RLABL W2N 04560CSR MOVEAW3A POS,X 04570CSR OPT,P COMP 'D' 54 04580CSR OPT,P COMP 'S' 55 04590CSR OPT,P COMP 'B' 56 04600CSR SETON 78 04610CSR EXCPT PUT FIELD DATA 04620CSR SETOF 78 04630CSR GOTO T104A 04640CSR END104 ENDSR 04650C******************************************************************** 04660CSR SR105 BEGSR 04670C* REQUEST SPECIAL INSTRUCT. 04680C*------------------------------------------------------------------- 04690CSR T105A TAG 04700CSR SETON 35 04710CSR EXCPT PUT REQUEST 04720CSR SETOF 35 04730CSR EXSR SR75 READ. 04740CSRN77 GOTO END105 04750CSR MOVEAW6A A6 ÐÐ04760CSR Z-ADD1 X 30 04770CSR ',' LOKUPA6,X 54 04780CSRN54 GOTO T105T ERROR. 04790CSR MOVEAA6,X W2A 2 04800CSR MOVE W2A W1A 1 04810CSR MOVEABLK6 A6,X 04820CSR MOVE BLK6 W4A 4 04830CSR MOVEAA6,1 W4A 04840CSR MOVE BLK6 W6A 6 04850CSR MOVE W4A W6A 04860CSR EXSR SR202 R. JUSTIFY 04870CSR MOVE W6A P 04880CSR P COMP 0 54 04890CSR 54 P COMP 30 5454 04900CSRN54 GOTO T105T ERROR 04910CSR 22 MOVE W1A OPT,P 04920CSR 21 MOVE W1A KPS,P SPEC INSTR 04930CSR P ADD 5 W3N 04940CSR MOVELW3N W6A 04950CSR MOVE '029' W6A 04960CSR EXITFQXYPOS POSITION CURSOR 04970CSR RLABL W6A 04980CSR MOVE BIT,3 BUFLGT 04990CSR MOVELKPS,P W2A 2 05000CSR MOVE ' ' W2A ÐÐ05010CSR MOVELW2A W4A 4 05020CSR MOVELOPT,P W2A 05030CSR MOVE ' ' W2A 05040CSR MOVE W2A W4A 05050CSR EXITFQWRITE PUT SPEC INSTR 05060CSR RLABL W4A 05070CSR RLABL BUFLGT 05080CSR GOTO T105A 05090C*------------------------------------------------------------------- 05100CSR T105T TAG 05110C* FLAG ERROR. 05120CSR SETON 75 05130CSR EXCPT 05140CSR SETOF 75 05150CSR GOTO T105A 05160C*------------------------------------------------------------------- 05170CSR END105 TAG 05180CSR SETOF 2122 05190CSR ENDSR 05200C******************************************************************** 05210CSR SR106 BEGSR 05220C* REQUEST BATCH #. 05230CSR 83 EXSR SR82 UPDATE KPCONT 05240CSR SETON 36 05250CSR EXCPT RQST BATCH # ÐÐ05260CSR SETOF 36 05270CSR EXSR SR75 READ 05280CSR 90 GOTO END106 ESC 05290CSR JOBNO CHAINKPNAME H7 05300CSR H7 GOTO END106 05310CSR 77 EXSR SR202 R. JUSTIFY 05320CSR 77 MOVE W6A BATCH 30 05330CSR 77 BATCH COMP 0 54 05340CSR 77N54 SETOF 77 05350CSRN77 1 ADD KNLBAT BATCH 05360CSR BATCH COMP KNLBAT 54 05370CSR 54 Z-ADDBATCH KNLBAT 05380CSR 83 EXSR SR82 UPDATE KPCONT 05390CSR MOVELKNJOB KEYKC 10 05400CSR MOVE BATCH KEYKC 05410CSR KEYKC CHAINKPCONT 60 05420CSR 60 Z-ADD0 KCREC 05430CSR SETON 81 05440CSR EXCPT UPDATE BATCH # 05450CSR SETOF 81 05460CSR KEYKC CHAINKPCONT 54 05470CSRN54 SETON 83 05480CSR END106 ENDSR 05490C******************************************************************** 05500CSR SR107 BEGSR ÐÐ05510C* CLEAR SCREEN. PUT INPUT HEADINGS. 05520CSR SETON 33 05530CSR EXCPT PUT HEADING 05540CSR SETOF 33 05550CSR Z-ADD6 LINENO 30 05560CSR ENDSR 05570C******************************************************************** 05580CSR SR108 BEGSR 05590C* ACCEPT INPUT DATA. 05600CSR MOVE BLK132 WORK 132 05610CSR 50 1 ADD RECNO RECNO 05620CSR 50 Z-ADDRECNO NXTREC 05630CSRN50 1 ADD KCREC NXTREC 50 NEXT RECORD # 05640CSR MOVELKNJOB W14A 14 05650CSR MOVELBATCH W8A 05660CSR MOVE NXTREC W8A 05670CSR MOVE W8A W14A 05680CSR W14A CHAINKPLABOR 79 05690CSRN79 KESTAT COMP 'D' 54 05700CSR 79 05710CORN79 54 MOVE BLK132 RECORD 05720CSR 79 05730CORN79 54 MOVE ' ' KESTAT 05740CSR 79 05750CORN79 54 Z-ADD0 ERR ÐÐ05760CSRN79N54 EXSR SR110 MOVE/EDIT DATA 05770CSR Z-ADD0 P 30 05780C*------------------------------------------------------------------- 05790CSR T108A TAG 05800C* GET NEXT FIELD 05810CSR MOVELBIT,1 ITC 2 05820CSR MOVE BIT,3 ITC 05830CSR EXSR SR210 ESC SET-OFFS 05840CSR P COMP 0 54 05850CSRN54 Z-ADD0 P 05860CSR 1 ADD P P 05870CSR P COMP 30 54 05880CSR 54 GOTO T108B DONE 05890CSR COL,P COMP 0 54 05900CSRN54 GOTO T108B DONE 05910C* PROCESS SKIP/DUP FIELDS. 05920CSR MOVE BLK132 W132A 132 05930CSRN38 EXSR SR70 DISPLAY DATA 05940CSRN38 GOTO T108A1 1ST RECORD 05950CSR KPS,P COMP 'S' 54 05960CSR 54 GOTO T108A SKIP FIELD 05970CSR KPS,P COMP 'D' 56 DUP FIELD 05980CSRN56 KPS,P COMP 'B' 56 SKIP & DUP 05990CSRN56 EXSR SR70 DISPLAY 06000CSRN56 GOTO T108A1 NOT DUP FIELD ÐÐ06010CSR EXSR SR208 DUP DATA 06020CSR EXSR SR211 MOVE DATA 06030CSR EXSR SR207 EDIT 06040CSR EXSR SR70 DISPLAY 06050CSR KPS,P COMP 'B' 54 06060CSR 54 GOTO T108A2 DUP & SKIP 06070C*------------------------------------------------------------------- 06080CSR T108A1 TAG 06090C* READ TERMINAL. 06100CSR EXSR SR203 CHK FOR DUP FIELD 06110CSR 54 MOVEAW132A SAV SAVE DUPED DATA 06120CSR 54 MOVE BLK132 W132A 06130CSR MOVELLINENO W6A 6 06140CSR 1 ADD COL,P W3N 30 06150CSR MOVE W3N W6A 06160CSR 1 ADD SIZ,P X 30 BUF LGTH 06170CSR KPE,P COMP 'K' 54 06180CSR 54 1 ADD X X 06190CSR X COMP 5 54 54 06200CSRN54 Z-ADD5 X MIN BUF SIZE 06210CSR MOVE BIT,X BUFLGT 2 BUFFER LENGTH 06220CSR EXITFQR132P READ,POS CURSOR 06230CSR RLABL W6A XY-POS 06240CSR RLABL W132A BUFFER 06250CSR RLABL BUFLGT BUF LGTH ÐÐ06260CSR RLABL ITC RET CODE 06270CSR EXSR SR76 BLANK MSG 06280C*------------------------------------------------------------------- 06290CSR T108A2 TAG 06300C* SAVE DUP OR INPUT DATA. 06310CSR MOVEAW132A A132 06320CSR MOVE BLK132 W132A 06330CSR Z-ADD1 W 30 06340CSR '\' LOKUPA132,W 90 CHECK FOR ESC 06350CSR 90 EXSR SR70 PUT DATA LINE 06360CSR 90 GOTO T108C ESC INPUT 06370CSR Z-ADD1 W 06380CSR ' ' LOKUPA132,W 77 06390CSRN77 EXSR SR203 CHECK FOR DUP FIELD 06400CSRN77 54 MOVEASAV A132 06410CSRN77 54 SETON 77 06420CSR OPT,P COMP 'M' 54 06430CSR 54N77 GOTO T108A1 NO MANDATORY INPUT 06440CSR EXSR SR205 CHK RETURN CODE 06450CSR 55N77 GOTO T108B LINE FEED 06460CSRN77 GOTO T108A CAR RETURN 06470CSR MOVEAA132,W W132A 06480C*------------------------------------------------------------------- 06490CSR T108A3 TAG 06500CSR EXSR SR210 ESC SET-OFFS ÐÐ06510C* SAVE INPUT DATA - EDIT & PUT TO SCREEN. 06520CSR EXSR SR211 MOVE DATA 06530CSR EXSR SR207 EDIT 06540CSR EXSR SR70 REWRITE SCREEN 06550CSR EXSR SR205 FLAG RET CODE 06560CSR 54 GOTO T108A CAR RET. 06570C*------------------------------------------------------------------- 06580CSR T108B TAG 06590C* CHECK MANDATORY/TABLE FIELDS 06600CSR EXSR SR210 SETOFFS 06610CSR EXSR SR212 VERIFY DATA 06620CSR 96 X SUB 1 P 06630CSR 96 GOTO T108A 06640C*------------------------------------------------------------------- 06650CSR T108BA TAG 06660C* OUTPUT DATA RECORD TO KPLABOR FILE 06670CSR 1 ADD LINENO LINENO 30 SCREEN LINE 06680CSR NXTREC COMP KCREC 54 06690CSR 54 Z-ADDNXTREC KCREC 06700CSR SETON 8020 06710CSR EXCPT OUTPUT KPLABOR 06720CSR SETOF 80 06730CSR EXSR SR213 CUM BAT TOT 06740CSR Z-ADD0 P 06750CSR MOVE RECORD LAST 132 ÐÐ06760CSR MOVE BLK132 RECORD 06770CSR MOVE BLK132 WORK 132 06780CSR LINENO COMP 29 54 54 06790CSR 54 EXSR SR107 PUT HEADINGS 06800CSR GOTO END108 DONE 06810C*------------------------------------------------------------------- 06820CSR T108C TAG 06830C* ESCAPE ROUTINE. 06840CSR 1 ADD W W 06850CSR W COMP 132 54 06860CSR 54 GOTO T108T ERROR 06870CSR A132,W COMP 'B' 92 SKIP BKWD 06880CSR A132,W COMP 'G' 98 SIGN-OFF 06890CSR A132,W COMP 'N' 93 NEW ITEM 06900CSR A132,W COMP 'E' 94 MENU 06910CSR A132,W COMP 'S' 89 SPACE FILL 06920CSR A132,W COMP 'J' 91 JUMP 06930CSR A132,W COMP 'U' 95 UPDATE 06940CSR A132,W COMP 'D' 99 DELETE 06950CSR 99 MOVE 'D' KESTAT 06960CSR 99 GOTO T108BA 06970CSR 95 GOTO T108B UPDATE 06980CSRN92 GOTO T108E NOT BKWD TAB 06990CSR P SUB 2 P 54 07000CSRN54 Z-ADD0 P ÐÐ07010CSR GOTO T108A 07020C*------------------------------------------------------------------- 07030CSR T108E TAG 07040CSR 89 GOTO T108A3 SPACE FILL 07050CSR 91 GOTO T108G JUMP 07060CSRN98N94N93 GOTO T108T ERROR 07070CSR GOTO END108 07080C*------------------------------------------------------------------- 07090CSR T108G TAG 07100C* JUMP ROUTINE. 07110CSR 1 ADD W W 07120CSR W COMP 132 54 07130CSR 54 GOTO T108T ERROR 07140CSR MOVE ' ' W3A 3 07150CSR MOVEAA132,W W3A 07160CSR EXSR SR216 MOVE BLK15->W15A 07170CSR MOVE W3A W15A 07180CSR EXSR SR215 R.ADJUST 07190CSR MOVE W15A P 07200CSR P SUB 1 P 07210CSR GOTO T108A 07220C*------------------------------------------------------------------- 07230CSR T108T TAG 07240C* FLAG ESCAPE CODE ERROR. 07250CSR Z-ADD318 M 96 ÐÐ07260CSR EXSR SR73 PUT MSG 07270CSR P SUB 1 P 07280CSR GOTO T108A 07290CSR END108 ENDSR 07300C******************************************************************** 07310CSR SR109 BEGSR 07320C* REQUEST RECORD #. 07330CSR Z-ADD0 RECNO 07340CSR SETON 37 07350CSR EXCPT PROMPT 07360CSR SETOF 3750 07370CSR EXSR SR75 READ 07380CSR 90 GOTO END109 07390CSR EXSR SR202 R. ADJUST 07400CSR MOVE W6A RECNO 50 07410CSR RECNO COMP 0 50 07420CSR END109 ENDSR 07430C************************************************************* 07440CSR SR110 BEGSR 07450C* MOVE RECORD TO WORK 07460CSR Z-ADD1 P 07470CSR SETON 39 07480C*------------------------------------------------------------ 07490CSR T110A TAG 07500CSR 000 LOKUPCOL,P 54 ÐÐ07510CSRN54 GOTO END110 07520CSR EXSR SR207 EDIT/MOVE 07530CSR 1 ADD P P 07540CSR P COMP 30 54 07550CSRN54 GOTO T110A 07560C*----------------------------------------------------------- 07570CSR END110 TAG 07580CSR SETOF 39 07590CSR ENDSR 07600C******************************************************************** 07610CSR SR111 BEGSR 07620C* REQUEST SPEC INSTR. 07630CSR SETON 21 07640CSR EXSR SR105 07650CSR 90 GOTO END111 07660C* REQUEST OPTION. 07670CSR SETON 22 07680CSR EXSR SR105 07690CSR 92 GOTO SR111 07700CSR END111 ENDSR 07710C******************************************************************** 07720CSR SR201 BEGSR 07730C* INIT KP LAYOUT ARRAYS. 07740CSR MOVE ' ' KPS SPEC INSTR 07750CSR MOVE BLK15 KPN FIELD NAME ÐÐ07760CSR MOVE ' ' KPT TYPE 07770CSR MOVE ' ' KPE EDIT CODES 07780CSR Z-ADD0 KPD DEC PLACES 07790CSR Z-ADD0 COL START COL 07800CSR Z-ADD0 SIZ FIELD SIZE 07810CSR Z-ADD0 KPB BATCH TOTALS 07820CSR MOVE ' ' OPT OPTION CODES 07830CSR MOVE BLK18 KTN TABLE NAMES 07840CSR MOVE ' ' KTO TABLE OPERATORS 07850CSR MOVE ' ' KPL TABLE NAMES-FILE 07860CSR MOVE ' ' KPO TABLE OPER-FILE 07870CSR ENDSR 07880C******************************************************************** 07890CSR SR202 BEGSR 07900C* R. JUSTIFY 6-BYTES. 07910CSR EXSR SR216 MOVE BLK15->W15A 07920CSR MOVE W6A W15A 07930CSR EXSR SR215 R.ADJUST 07940CSR MOVE W15A W6A 6 07950CSR ENDSR 07960C************************************************************** 07970CSR SR203 BEGSR 07980C* CHECK FOR DUP FIELD INSTR 07990CSR KPS,P COMP 'D' 54 08000CSRN54 KPS,P COMP 'B' 54 ÐÐ08010CSR ENDSR 08020C******************************************************************** 08030CSR SR205 BEGSR 08040C* CLASSIFY RETURN CODE. 08050CSR MOVE ITC W1A RETURN CODE 08060CSR W1A COMP BIT,3 54 CAR RET 08070CSR W1A COMP BIT,4 55 LINE FEED 08080CSR ENDSR 08090C******************************************************************** 08100CSR SR207 BEGSR 08110C* EDIT INPUT FIELD - SET-UP WORK FIELD FOR SCREEN OUTPUT 08120C* BRANCH IF ALPHA FIELD. 08130CSR KPT,P COMP 'A' 54 08140CSR 54 GOTO T207H ALPHA FIELD 08150C* INIT NUMERIC WORK FIELDS 08160CSR Z-ADD0 W11N 110 08170CSR Z-ADD0 W11D1 08180CSR Z-ADD0 W11D2 08190CSR Z-ADD0 W11D3 08200C* MOVE INPUT DATA(N39) OR FILE DATA(39) TO WORK FIELD W15A 08210CSRN39 MOVELW132A W15A 15 08220CSR 39 EXSR SR216 MOVE BLK15->W15A 08230CSR 39 Z-ADDCOL,P SS 08240CSR 39 Z-ADDSIZ,P N 08250CSR 39 Z-ADD1 TS ÐÐ08260CSR 39 EXSR SR214 MOV REC TO W15A 08270CSR EXSR SR215 R. JUSTIFY. 08280CSRN39 EXSR SR209 MOV NUM TO RECORD 08290C* BRANCH IF NO EDIT CODE 08300CSR KPE,P COMP ' ' 54 08310CSR 54 GOTO T207H NO EDIT CODE. 08320C* BRANCH IF Y-EDIT CODE 08330CSR KPE,P COMP 'Y' 54 08340CSR 54 GOTO T207J Y-EDIT CODE 08350C* BRANCH ON NUMB OF DEC PLACES 08360CSR KPD,P COMP 0 54 08370CSR KPD,P COMP 1 55 08380CSR KPD,P COMP 2 56 08390CSR KPD,P COMP 3 57 08400CSR 55 MOVE W15A W11D1 111 08410CSR 56 MOVE W15A W11D2 112 08420CSR 57 MOVE W15A W11D3 113 08430CSR MOVE W15A W11N DEFAULT 08440CSR MOVE KPE,P W1A 1 08450CSR EXSR SR216 MOVE BLK15->W15A 08460CSR Z-ADD15 W2N 20 08470CSR 55 GOTO T207C 08480CSR 56 GOTO T207E 08490CSR 57 GOTO T207F 08500C* NOTE: DEFAULT FALLS THRU ÐÐ08510C*------------------------------------------------------------------- 08520CSR T207B TAG 08530CSR EXIT SUBRED 08540CSR RLABL W11N 08550CSR RLABL W1A 08560CSR RLABL W15A 08570CSR RLABL W2N 08580CSR GOTO T207M 08590C*------------------------------------------------------------------- 08600CSR T207C TAG 08610CSR EXIT SUBRED 08620CSR RLABL W11D1 08630CSR RLABL W1A 08640CSR RLABL W15A 08650CSR RLABL W2N 08660CSR GOTO T207M 08670C*------------------------------------------------------------------- 08680CSR T207E TAG 08690CSR EXIT SUBRED 08700CSR RLABL W11D2 08710CSR RLABL W1A 08720CSR RLABL W15A 08730CSR RLABL W2N 08740CSR GOTO T207M 08750C*------------------------------------------------------------------- ÐÐ08760CSR T207F TAG 08770CSR EXIT SUBRED 08780CSR RLABL W11D3 08790CSR RLABL W1A 08800CSR RLABL W15A 08810CSR RLABL W2N 08820CSR GOTO T207M 08830C*------------------------------------------------------------------- 08840CSR T207H TAG 08850C* MOVE NUMERIC (NO EDIT) OR ALPHA FROM RECORD TO WORK. 08860CSR Z-ADDSIZ,P NUMB 08870CSR EXSR SR302 MOVE BLKS TO WORK 08880CSR Z-ADDSIZ,P N 30 08890CSR Z-ADDCOL,P SS 08900CSR Z-ADDCOL,P TS 08910CSR EXIT SUBRMV 08920CSR RLABL RECORD SOURCE 08930CSR RLABL SS SOURCE START 08940CSR RLABL WORK TARGET 08950CSR RLABL TS TARGET START 08960CSR RLABL N NUMB CHAR 08970CSR GOTO END207 08980C*------------------------------------------------------------ 08990CSR T207J TAG 09000C* DO Y-EDIT CODE ÐÐ09010CSR MOVE KPE,P W1A 1 09020CSR MOVE W15A W10N 100 09030CSR Z-ADD10 W2N 09040CSR EXSR SR216 MOVE BLK15->W15A 09050CSR MOVE BLK15 W10A 10 09060CSR EXIT SUBRED EDIT 09070CSR RLABL W10N 09080CSR RLABL W1A EDIT CODE 09090CSR RLABL W10A RESULT 09100CSR RLABL W2N END POSITION 09110CSR MOVE W10A W15A 09120C*------------------------------------------------------------ 09130CSR T207M TAG 09140C* MOVE EDITED NUMERIC TO WORK. 09150C* COMPUTE EDITED SIZE. 09160CSR Z-ADD1 X 30 09170CSR MOVEAW15A A15 09180C*-------------------------------------------------------------- 09190CSR T207P TAG 09200CSR KPE,P COMP 'Y' 55 09210CSR 55 '0' LOKUPA15,X 54 09220CSRN55 '.' LOKUPA15,X 54 54 09230CSRN54N89 GOTO END207 09240CSRN54 Z-ADD1 X 09250CSR Z-ADDX SS ÐÐ09260CSR 15 SUB X N 09270CSR 1 ADD N N 09280CSR EXSR SR301 COMPUTE TS 09290CSR EXIT SUBRMV MOVE EDIT FIELD 09300CSR RLABL W15A SOURCE 09310CSR RLABL SS SOURCE START 09320CSR RLABL WORK TARGET 09330CSR RLABL TS TARGET START 09340CSR RLABL N NUMB CHAR 09350CSR END207 ENDSR 09360C******************************************************************** 09370CSR SR208 BEGSR 09380C* DUP DATA FROM PREV LINE. 09390CSR Z-ADDCOL,P SS 09400CSR Z-ADDSIZ,P N 09410CSR Z-ADD1 TS 09420CSR EXIT SUBRMV MOVE DATA 09430CSR RLABL LAST SOURCE 09440CSR RLABL SS SOURCE START 09450CSR RLABL W132A TARGET 09460CSR RLABL TS TARGET START 09470CSR RLABL N NUMB CHAR 09480CSR ENDSR 09490C************************************************************* 09500CSR SR209 BEGSR ÐÐ09510C* MOVE NUMERIC TO RECORD 09520CSR Z-ADDCOL,P TS 30 09530CSR 15 SUB SIZ,P SS 30 09540CSR 1 ADD SS SS 09550CSR Z-ADDSIZ,P N 30 09560CSR EXIT SUBRMV MOVE NUMERIC 09570CSR RLABL W15A 15 SOURCE 09580CSR RLABL SS SOURCE START 09590CSR RLABL RECORD TARGET 09600CSR RLABL TS TARGET START 09610CSR RLABL N NUMB OF CHAR 09620CSR ENDSR 09630C******************************************************************** 09640CSR SR210 BEGSR 09650C* SET-OFF ESC FLAGS. 09660CSR SETOF 899091 09670CSR SETOF 929394 09680CSR SETOF 987796 09690CSR SETOF 9995 09700CSR ENDSR 09710C******************************************************************** 09720CSR SR211 BEGSR 09730C* SAVE INPUT DATA - EDIT & PUT TO SCREEN. 09740CSR Z-ADD1 SS 30 09750CSR Z-ADDCOL,P TS 30 ÐÐ09760CSR Z-ADDSIZ,P N 30 09770CSR EXIT SUBRMV MOVE DATA 09780CSR RLABL W132A SOURCE DATA 09790CSR RLABL SS SOURCE START 09800CSR RLABL RECORD TARGET 09810CSR RLABL TS TARGET START 09820CSR RLABL N NUMB CHAR 09830CSR ENDSR 09840C******************************************************************** 09850CSR SR212 BEGSR 09860C* VERIFY MANDATORY AND TABLE DATA. 09870CSR Z-ADD1 X 30 09880C*------------------------------------------------------------------- 09890CSR T212A TAG 09900CSR EXSR SR216 BLK15-->W15A 09910CSR 000 LOKUPCOL,X 54 09920CSRN54 GOTO END212 09930CSR Z-ADDCOL,X SS 09940CSR Z-ADDSIZ,X N 09950CSR Z-ADD1 TS 09960CSR EXSR SR214 MOVE RECORD->W15A 09970CSR KPT,X COMP 'N' 54 09980CSR 54 EXSR SR215 R. ADJUST 09990CSR 54 MOVE W15A W15N 150 10000CSR 54 MOVE W15N W15A ÐÐ10010C* CHECK MANDATORY SPEC 10020CSR OPT,X COMP 'M' 54 10030CSRN54 GOTO T212B 10040CSR KPT,X COMP 'A' 54 10050CSR 54 W15A COMP BLK15 55 10060CSRN54 W15N COMP 0 55 10070CSRN55 GOTO T212F ERROR 10080C*------------------------------------------------------------------ 10090CSR T212B TAG 10100C* CHECK TABLES 10110CSR KTN,X COMP BLK18 54 10120CSRN54 GOTO T212L NO TABLES 10130CSR MOVEAKTO,X KPO 10140CSR MOVEAKTN,X KPL 10150CSR Z-ADD1 K 30 10160C*------------------------------------------------------------------- 10170CSR T212C TAG 10180CSR ' ' LOKUPKPO,K 54 10190CSRN54 GOTO T212L 10200CSR MOVE BLK18 W21A 21 10210CSR MOVELKPL,K W21A 10220CSR KPO,K COMP '<' 54 10230CSRN54 MOVE W15A W21A 10240CSR W21A SETLLKPTABLE 10250C*------------------------------------------------------------------- ÐÐ10260CSR T212D TAG 10270CSR SETOF 54 10280CSR READ KPTABLE 54 10290CSR 54 GOTO T212F 10300CSR KTNAME COMP KPL,K 54 10310CSRN54 GOTO T212F 10320CSR KTSTAT COMP 'D' 54 10330CSR 54 GOTO T212D DELETED 10340CSR KPT,X COMP 'N' 54 10350CSR 54 MOVE KTVAL NUM15 150 10360CSR 54 NUM15 COMP W15N 414243 10370CSRN54 KTVAL COMP W15A 414243 10380CSR KPO,K COMP '>' 44 10390CSR KPO,K COMP '<' 45 10400CSR KPO,K COMP '=' 46 10410CSR 41 44 GOTO T212E OK 10420CSR 41 45 GOTO T212F ERROR 10430CSR 41 46 GOTO T212F ERROR 10440CSR 42 44 GOTO T212D READ NEXT TABLE 10450CSR 42 45 GOTO T212E OK 10460CSR 42 46 GOTO T212D READ NEXT TABLE 10470CSR 43 44 GOTO T212D READ NEXT TABLE 10480CSR 43 45 GOTO T212F ERROR 10490CSR 43 46 GOTO T212E OK 10500C*-------------------------------------------------------------- ÐÐ10510CSR T212E TAG 10520C* LAST TABLE OK, GET NEXT TABLE. 10530CSR 1 ADD K K 10540CSR K COMP 3 54 10550CSRN54 GOTO T212C GET NEXT TABLE 10560CSR GOTO T212L GET NEXT DATA FIELD 10570C*------------------------------------------------------------------- 10580CSR T212F TAG 10590C* FLAG ERROR. 10600CSR EXSR SR900 10610CSR GOTO END212 10620C*------------------------------------------------------------------- 10630CSR T212L TAG 10640C* SET-UP NEXT DATA FIELD 10650CSR 1 ADD X X 10660CSR X COMP 30 54 10670CSRN54 GOTO T212A GET NEXT DATA FIELD 10680CSR END212 ENDSR 10690C******************************************************************** 10700CSR SR213 BEGSR 10710C* CUM BATCH TOTALS. 10720CSR Z-ADD1 P 10730C*------------------------------------------------------------------- 10740CSR T213A TAG 10750CSR 0 LOKUPKPB,P 54 ÐÐ10760CSRN54 GOTO END213 10770CSR Z-ADDCOL,P SS 10780CSR Z-ADD1 TS 10790CSR Z-ADDSIZ,P N 10800CSR EXSR SR216 MOVE BLK15->W15A 10810CSR EXSR SR214 MOVE RECORD->W15A 10820CSR EXSR SR215 R.ADJUST 10830CSR MOVE W15A W15N 10840CSR Z-ADDKPB,P X 10850CSRN99 W15N ADD KCB,X KCB,X 10860CSR 99 KCB,X SUB W15N KCB,X 10870CSR 1 ADD P P 10880CSR P COMP 30 54 10890CSRN54 GOTO T213A 10900CSR END213 ENDSR 10910C************************************************************* 10920CSR SR214 BEGSR 10930C* COMMON MOVE ROUTINE 10940CSR MOVE BLK15 W15A 10950CSR EXIT SUBRMV MOVE DATA 10960CSR RLABL RECORD SOURCE 10970CSR RLABL SS SOURCE START 10980CSR RLABL W15A TARGET 10990CSR RLABL TS TARGET START 11000CSR RLABL N NUMB OF CHAR ÐÐ11010CSR ENDSR 11020C************************************************************ 11030CSR SR215 BEGSR 11040C* R.ADJUST 11050CSR Z-ADD15 W2N 20 11060CSR EXIT SUBRAJ R.ADJUST 11070CSR RLABL W2N SIZE 11080CSR RLABL W15A RESULT 11090CSR ENDSR 11100C************************************************************** 11110CSR SR216 BEGSR 11120C* UTILITY MOVE 11130CSR MOVE BLK15 W15A 15 11140CSR ENDSR 11150C***************************************************************** 11160CSR SR217 BEGSR 11170C* UTILITY COMPARE 11180CSR P COMP 30 54 11190CSR ENDSR 11200C******************************************************************** 11210CSR SR301 BEGSR 11220C* COMPUTE TS(TARGET START) FOR NUMERIC DISPLAY FIELD 11230CSR KPE,P COMP '2' 54 11240CSRN54 KPE,P COMP 'K' 54 11250CSRN54 GOTO T301B ÐÐ11260CSR SIZ,P SUB KPD,P WHOLE 30 11270CSR WHOLE DIV 3 XTRA 30 11280CSR XTRA ADD WHOLE WHOLE WHOLE # SIZE 11290CSR KPD,P COMP 0 54 11300CSR 54 1 ADD KPD,P XTRA 11310CSRN54 Z-ADDKPD,P XTRA DEC SIZE 11320CSR KPE,P COMP 'K' 54 11330CSR 54 1 ADD XTRA XTRA MINUS SIGN 11340CSR N SUB XTRA W3N 30 ACTUAL WHOLE# 11350CSR WHOLE SUB W3N W3N 11360CSR COL,P ADD W3N TS 54 11370CSRN54 Z-ADD1 TS START POS 11380CSR XTRA ADD WHOLE NUMB 30 11390CSR EXSR SR302 BLKS TO WORK 11400CSR GOTO END301 11410C*------------------------------------------------------------------- 11420CSR T301B TAG 11430C* DO Y-EDIT CODE 11440CSR KPE,P COMP 'Y' 54 11450CSRN54 GOTO T301D NOT Y-EDIT 11460CSR SIZ,P DIV 2 XTRA 11470CSR XTRA SUB 1 XTRA 54 11480CSRN54 Z-ADD0 XTRA 11490CSR SIZ,P ADD XTRA W3N 11500CSR COL,P ADD W3N TS ÐÐ11510CSR TS SUB N TS 54 11520CSRN54 Z-ADD1 TS 11530CSR SIZ,P ADD XTRA NUMB 11540CSR EXSR SR302 BLKS TO WORK 11550CSR GOTO END301 11560C*----------------------------------------------------------------- 11570CSR T301D TAG 11580C* EDIT CODE OTHER THAN 2,K,Y. 11590CSR SIZ,P SUB N W3N 11600CSR COL,P ADD W3N TS 11610CSR Z-ADDSIZ,P NUMB 11620CSR EXSR SR302 BLKS TO WORK 11630CSR END301 ENDSR 11640C************************************************************** 11650CSR SR302 BEGSR 11660C* BLANK CUR FIELD IN WORK 11670CSR Z-ADD1 W3N 11680CSR Z-ADDCOL,P T 30 11690CSR EXIT SUBRMV MOVE BLANKS 11700CSR RLABL BLK132 SOURCE 11710CSR RLABL W3N SOURCE START 11720CSR RLABL WORK TARGET 11730CSR RLABL T TARGET START 11740CSR RLABL NUMB NUMB CHAR 11750CSR ENDSR ÐÐ11760C*************************************************************** 11770CSR SR900 BEGSR 11780C* FLAG INVALID DATA ERROR 11790CSR SETON 85 11800CSR EXCPT 11810CSR SETOF 85 11820CSR Z-ADD436 M 50 96 11830CSR EXSR SR73 FLAG ERROR 11840CSR ENDSR 11850O******************************************************************** 11860OKPLABOR EADD 80 79 11870O KNJOB 6 11880O BATCH 9 11890O NXTREC 14 11900O CREMPL 19 11910O PORT 21 11920O RECORD 153 11930O ERR 168P 11940O 192 ' ' 11950O*------------------------------------------------------------------- 11960O E 80N79 11970O CREMPL 19 11980O PORT 21 11990O RECORD 153 12000O ERR 168P ÐÐ12010O KESTAT 192 12020O******************************************************************** 12030OKPCONT EADD 81 60 12040O KEYKC 10 12050O KCB 40P 12060O KCREC 43P 12070O CRDEPT 47P 12080O 48 ' ' 12090O*------------------------------------------------------------------- 12100O E 82 12110O OR 81N60 12120O KCB 40P 12130O KCREC 43P 12140O CRDEPT 47P 12150O 48 ' ' 12160O**************************************************************** 12170OKPNAME E 81 12180O KNLBAT 333P 12190O******************************************************************** 12200OTERM132 E 71 12210O* PUT HEADING. 12220O 65 BIT,28 1 12230O 65 8 '8001001' 12240O 78 'DATA ENTRY MENU' 12250O*------------------------------------------------------------------- ÐÐ12260O E 71 12270O 1 ' ' 12280O*------------------------------------------------------------------- 12290O E 71 12300O 1 ' ' 12310O*------------------------------------------------------------------- 12320O E 71 12330O 7 'JOB-NO.' 12340O 18 'JOB-NAME' 12350O 78 'FORMAT' 12360O*------------------------------------------------------------------- 12370O E 72 12380O J Z 5 12390O KNTITL 70 12400O KDFRMT 75 12410O*------------------------------------------------------------------- 12420O E 74 12430O BIT,28 1 12440O 8 '8002001' 12450O 24 'ENTER SELECTION:' 12460O*------------------------------------------------------------------- 12470O E 76 12480O BIT,28 1 12490O 8 '8001001' 12500O 78 'DATA ENTRY FORMAT' ÐÐ12510O*------------------------------------------------------------------- 12520O E 76 12530O 1 ' ' 12540O*------------------------------------------------------------------- 12550O E 76 12560O 1 ' ' 12570O*------------------------------------------------------------------- 12580O E 76 12590O 9 'FIELD-NO.' 12600O 21 'FIELD-NAME' 12610O 41 'SPECIAL-INSTR' 12620O*------------------------------------------------------------------- 12630O E 76 12640O 1 ' ' 12650O*------------------------------------------------------------------- 12660O E 78 12670O KPNAME 26 12680O KPS,P 29 12690O OPT,P 31 12700O P Z 6 12710O*------------------------------------------------------------------- 12720O E 35 12730O BIT,28 1 12740O 8 '8002001' 12750O 21 28 'ENTER SPECIAL INSTR:' ÐÐ12760O 22 32 'ENTER OPTION CODE (O,M):' 12770O*------------------------------------------------------------------- 12780O E 75 12790O BIT,28 1 12800O 8 '8002065' 12810O 25 'INVALID SELECTION' 12820O*------------------------------------------------------------------- 12830O E 36 12840O OR 81 12850O BIT,28 1 12860O 8 '8002001' 12870O 24 'ENTER BATCH NO:' 12880O BATCH Z 29 12890O*------------------------------------------------------------------- 12900O E 37 12910O BIT,28 1 12920O 8 '8002001' 12930O 23 'ENTER RECORD #:' 12940O*------------------------------------------------------------------- 12950O E 73 12960O BIT,28 1 12970O 8 '8002001' 12980O 96 13 '*****' 12990O N96 13 ' ' 13000O MGTEXT 50 ÐÐ13010O 96 60 'E R R O R' 13020O N96 60 ' ' 13030O BIT,8 132 13040O*------------------------------------------------------------------- 13050O E 33 13060O OR 32 13070O BIT,28 1 13080O 8 '8001001' 13090O KNTITL 103 13100O 111 'BATCH=' 13110O BATCH Z 114 13120O 120 'REC=' 13130O NXTRECZ 125 13140O*------------------------------------------------------------------- 13150O E 33 13160O 1 ' ' 13170O*------------------------------------------------------------------- 13180O E 33 13190O POS 132 13200O*------------------------------------------------------------------- 13210O E 33 13220O KNHL1 132 13230O*------------------------------------------------------------------- 13240O E 33 13250O KNHL2 132 ÐÐ13260O*------------------------------------------------------------------- 13270O E 33 13280O 1 ' ' 13290O*--------------------------------------------------------------- 13300O E 70 13310O* REWRITE INPUT DATA 13320O WORK 132 13330O*------------------------------------------------------------------- ** JOB ARRAY 013340 013350** KPS ARRAY 013360 013370** KPN ARRAY 013380 013390** KPT ARRAY 013400 013410** KPE ARRAY 013420 013430** KPD ARRAY 013440 013450** COL ARRAY 013460 013470** SIZ ARRAY 013480 013490** KPB ARRAY 013500ÐÐ 013510** A15 ARRAY 013520 013530** A6 ARRAY 013540 013550** A132 ARRAY 013560 013570** ERR ARRAY 013580 013590** POS ARRAY 013600 013610** OPT ARRAY 013620 013630** KTN ARRAY 013640 013650** KTO ARRAY 013660 013670** SAV ARRAY 013680 013690/* 013700_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(2:Ò 2X003PC P120282120282(èÈÐ00010H Q003PC00020F* GEN COST CANDIDATE FILE FROM UNPROC GUIDE RECORDS. (X003PC) 00030F* REVISED 9/12/80 12:20 PM. 00040FPCGUIDE UP F 11 10AI 1 DISK 00050FPCCAND O F 10 DISK 00060FTERM80 O F 80 5 00070I******************************************************************** 00080IPCGUIDE PG 03 11 C 00090I 1 100PGPN 00100I GG 04 00110C******************************************************************** 00120C N79 TIME TIME 60 00130C N79 SETON 80 00140C N79 EXCPT 00150C N79 SETOF 80 00160C N79 SETON 79 00170C 03 MOVEL'Q001PC' PROG 8 00180C 03 1 ADD COUNT COUNT 40 00190C 03 COUNT COMP 2500 LR LR 00200CLR PROG COMP ' ' 54 00210CLRN54 MOVEL'Q004PC' PROG 00220CLR EXITFCHAIN 00230CLR RLABL PROG 00240O******************************************************************** 00250OTERM80 E 80 ÐÐ00260O 11 'START 003PC' 00270O TIME 25 00280O******************************************************************** 00290OPCCAND D 03 00300O PGPN 10 00310O******************************************************************** 00320OPCGUIDE D 03 00330O 11 'C' /* 000340_‚ ÐÐ_‚_‚0O 11 'START 003PC' 00270O TIME 25 00280O******************************************************************** 00290OPCCAND D 03 00300O PGPN 10 00310O******************************************************************** 00320OPCGUIDE D 03 00330O 11 'C' /* 000340_‚ ÐÈ( :è  NX008PO P¼999999120282(èÈÐ00010H Q008PO00020F* DISPLAY PO BY VENDOR NAME (X008PO) 00030F* REVISED 8-01-82 11:35 AM. 00040FBITPAR IP F 90 DISK 00050FVMMAST IC F 384R 5AI 1 DISK 00060FPOITEM ID F 384L 9AI 1 DISK 00070FVMALT ID F 26L25AI 1 DISK 00080FPOVKEY ID F 16L11AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FCRTFILE UC F 256R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E NUL 1 132 1 00140E A20 20 20 1 A 00150E RCD 1 26 7 0A 00160E DIV 1 132 1 00170E LNK 1 7 6 A 00180E PID 26 6 0 00190E PIQ 26 7 0A 00200E BIT 33 1 00210E PAR 25 1 00220E TST 25 1 00230E CALL 7 6 00240I******************************************************************** 00250IBITPAR BT ÐÐ00260I 1 33 BIT 00270I 34 58 PAR 00280I 59 83 TST 00290I******************************************************************** 00300IMGFILE MG 00310I 1 35 MGTEXT 00320I******************************************************************** 00330IVMALT VA 00340I 1 20 VASORT 00350I 21 250VAVEND 00360I 26 26 VASTAT 00370I 1 25 VAKEY 00380I******************************************************************** 00390IVMMAST VM 00400I 26 60 VMNAME 00410I 384 384 VMSTAT 00420I******************************************************************** 00430IPOITEM PI 00440I* PURCHASE ORDER ITEM RECORD. 00450I* KEY AREA. 00460I* PO # 6N 00470I 1 6 PIPO 00480I* PO ITEM 3N 00490I 7 90PIITEM 00500I 1 9 PIKEY ÐÐ00510I* DYNAIR PART # 10N 00520I 10 190PIPN 00530I* VENDOR PART # 15A 00540I 20 34 PIVPN 00550I* DESCRIPTION 29A 00560I 35 63 PIDESC 00570I* NON-INVENTORY DESCRIPTION 70A 00580I 10 79 PINDES 00590I* DATE LAST RECEIPT 6N 00600I 80 850PIDLR 00610I* QTY RECEIVED 7P 00620I P 86 890PIQRCD 00630I* QTY TO STK,SCRAP,RTV 7P 00640I P 90 930PIQSTK 00650I* PRICE CODE 1A 00660I* L = LOT 00670I* N = NO CHARGE 00680I 94 94 PILOT 00690I* PRICE 9.3P 00700I P 95 993PI$PRC 00710I* WORK ORDER # 9A 00720I 100 108 PIWO 00730I 100 105 PIWOP 00740I 106 1080PIWOD 00750I* VENDOR # 5P (FROM POMAST) ÐÐ00760I P 109 1110PIVEND 00770I* LAST RCVG LOG # USED 2N 00780I 112 1130PILLOG 00790I* SCHEDULE DATES 6N X 26 (Y,M,D) 00800I 114 269 PID 00810I* SCHED QTYS 7P X 26 00820I P 270 373 PIQ 00830I* RECORD STATUS 1A 00840I 384 384 PISTAT 00850I******************************************************************** 00860IPOVKEY PV 00870I 1 50PVVEND 00880I 6 11 PVPO 00890I 1 11 PVKEY 00900I 16 16 PVSTAT 00910I******************************************************************** 00920ICRTFILE CR 00930I* 1 50CREMPL 00940I* 6 13 CRUSER 00950I* 14 180CRDEPT 00960I 19 26 CRJOB 00970I 27 27 CRSHUT 00980I 28 330CRTIME 00990I 34 370CRDATE 01000I 38 79 CALL ÐÐ01010C******************************************************************** 01020C* INITIALIZE 1-TIME. 01030C EXSR SR101 INIT 01040C EXSR SR105 CLEAR PAGE 01050C MOVE ' ' BLK6 6 STUPIDITY 01060C*------------------------------------------------------------------- 01070C START TAG 01080C* REQUEST VENDOR NAME. 01090C EXSR SR102 RQST VEND # 01100C 90 GOTO ESCAPE 01110C*------------------------------------------------------------------- 01120C TAG10 TAG 01130C* REQUEST PO #. 01140C EXSR SR103 RQST PO # 01150C 92 GOTO START 01160C 90 GOTO ESCAPE 01170C*------------------------------------------------------------------- 01180C TAG20 TAG 01190C* DISPLAY PO ITEMS. 01200C EXSR SR104 DISPLAY PO ITEMS 01210C 92 GOTO TAG10 01220C 90 GOTO ESCAPE 01230C 77 MOVE W20A TNAME 01240C 77 GOTO TAG10 01250C*------------------------------------------------------------------- ÐÐ01260C ESCAPE TAG 01270C 98 GOTO GOODBY 01280C 94 GOTO MENU 01290C 93 GOTO NEWITM 01300C GOTO START 01310C*------------------------------------------------------------------- 01320C NEWITM TAG 01330C MOVEL'Q008PO' PROG 8 01340C GOTO END 01350C*------------------------------------------------------------------- 01360C GOODBY TAG 01370C MOVEL'GOODBY' PROG 01380C GOTO END 01390C*------------------------------------------------------------------- 01400C MENU TAG 01410C EXSR SR96 GET CRTFILE 01420C Z-ADD1 W 01430C BLK6 LOKUPLNK,W 54 01440C N54 MOVEL'CONTU' PROG 8 01450C 54 MOVELLNK,W PROG 01460C 54 MOVE BLK6 LNK,W 01470C EXSR SR97 UPD CRTFILE 01480C EXSR SR98 >>>>>>>>>> 01490C*------------------------------------------------------------------- 01500C END TAG ÐÐ01510C EXSR SR96 GET CRTFILE 01520C EXSR SR97 UPD CRTFILE 01530C EXSR SR98 >>>>>>>>>> 01540C*------------------------------------------------------------------- 01550C ENDJOB TAG 01560C MOVEL'ENDJOB' PROG 01570C EXSR SR98 >>>>>>>>>> 01580C********************************************************************* 01590CSR SR68 BEGSR 01600CSR EXITFZLF LINE FEED 01610CSR 1 ADD COUNT COUNT 01620CSR ENDSR 01630C********************************************************************** 01640CSR SR69 BEGSR 01650CSR 50 EXITFZPUTXY 01660CSR RLABL RPGLIN 01670CSR RLABL RPGCOL 01680CSRN50 EXITFZMOVXY MOVE CURSOR 01690CSR RLABL RPGLIN 01700CSR RLABL RPGCOL 01710CSR ENDSR 01720C******************************************************************** 01730CSR SR70 BEGSR 01740CSR 50 EXITFZISTAT CLEAR STATUS 01750CSR 50 EXITFZESCH CLEAR SCREEN ÐÐ01760CSRN50 EXITFZCPAGE CLEAR SCREEN 01770CSR ENDSR 01780C********************************************************************* 01790CSR SR72 BEGSR 01800C* PUT DATA TO TERMINAL 01810CSR SETON 72 01820CSR EXCPT PUT DATA 01830CSR SETOF 72 01840CSR SETON 4041 01850CSR 1 ADD COUNT COUNT 01860CSR ENDSR 01870C*********************************************************************** 01880CSR SR73 BEGSR 01890C* PUT ERROR MESSAGE TO TERMINAL 01900CSR SETON 73 01910CSR EXCPT PUT MSG 01920CSR SETOF 73 01930CSR 1 ADD COUNT COUNT 01940CSR ENDSR 01950C******************************************************************* 01960CSR SR74 BEGSR 01970C* PROMPT/READ 01980CSR EXSR SR89 GET MSG 01990CSR EXSR SR73 PUT PROMPT 02000CSR EXSR SR75 READ ÐÐ02010CSR ENDSR 02020C****************************************************************** 02030CSR SR75 BEGSR 02040C* READ FROM TERMINAL 02050CSR SETOF 779096 02060CSR SETOF 939288 02070CSR MOVE BLK20 W20A 20 BUFFER 02080CSR EXITFZR20 READ FROM TERMINAL 02090CSR RLABL W20A READ BUFFER 02100CSR MOVEAW20A A20 INPUT DATA ARRAY 02110CSR MOVE BLK20 W20A INIT INPUT ARRAY 02120CSR Z-ADD1 W 30 02130CSR '\' LOKUPA20,W 90 FLAG ESC 02140CSRN90 GOTO T75B NOT ESC 02150CSR 1 ADD W W 02160CSR W COMP 20 54 02170CSR 54 GOTO T75A BAD ESC 02180CSR A20,W COMP 'G' 98 GOODBY 02190CSR A20,W COMP 'E' 94 MENU 02200CSR A20,W COMP 'N' 93 NEW ITEM 02210CSR A20,W COMP 'B' 92 SKIP BKWRD 02220CSR A20,W COMP 'S' 88 SPACE FILL 02230CSR 88 SETOF 90 02240CSR 88 SETON 77 02250CSR 98 ÐÐ02260COR 94 02270COR 93 02280COR 92 02290COR 88 GOTO END75 GOOD ESC 02300C*------------------------------------------------------------------ 02310CSR T75A TAG 02320C* FLAG BAD ESC INPUT 02330CSR Z-ADD318 M 96 FLAG ERROR 02340CSR GOTO END75 02350C*-------------------------------------------------------------------- 02360CSR T75B TAG 02370C* MOVE DATA 02380CSR Z-ADD1 W 02390CSR ' ' LOKUPA20,W 77 02400CSR 77 MOVEAA20,W W20A INPUT DATA 02410CSR END75 ENDSR 02420C******************************************************************** 02430CSR SR76 BEGSR 02440C* PUT SCHEDULE LINE. 02450CSR SETON 76 02460CSR EXCPT PUT SCHED 02470CSR SETOF 76 02480CSR 1 ADD COUNT COUNT 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR81 BEGSR 02520C* END PAGE MSG. 02530CSR SETON 81 02540CSR EXCPT PUT END PAGE 02550CSR SETOF 81 02560CSR ENDSR 02570C********************************************************************** 02580CSR SR89 BEGSR 02590C* GET MESSAGE MASTER 02600CSR M CHAINMGFILE 54 02610CSR 54 MOVE BLK35 MGTEXT 02620CSR 54 MOVELM MGTEXT 02630CSR 54 MOVE '????????'MGTEXT 02640CSR ENDSR 02650C******************************************************************** 02660CSR SR96 BEGSR 02670CSR # CHAINCRTFILE H9 GET CRTFILE 02680CSR H9 GOTO ENDJOB 02690CSR ENDSR 02700C******************************************************************** 02710CSR SR97 BEGSR 02720C* UPDATE CRTFILE. EXIT PROGRAM. 02730CSR TIME CRTIME 02740CSR MOVELUDATE CRDATE 02750CSR SETON 97 ÐÐ02760CSR EXCPT UPDATE CRTFILE 02770CSR SETOF 97 02780CSR ENDSR 02790C******************************************************************** 02800CSR SR98 BEGSR 02810CSR EXSR SR70 CLEAR SCREEN 02820CSR EXITFCHAIN >>>>>>>>>> 02830CSR RLABL PROG 02840CSR ENDSR 02850C******************************************************************** 02860CSR SR101 BEGSR 02870C* 1-TIME INITIALIZE 02880CSR MOVE BIT,1 NUL 02890CSR MOVE '-' DIV 02900CSR MOVE ' ' BLK20 20 02910C* GET PORT # AND CRTFILE 02920CSR MOVE ' ' W2A 2 02930CSR EXITFZGMINX GET PORT # 02940CSR RLABL W2A 02950CSR MOVE W2A # 20 PORT NO. 02960CSR # COMP 0 54 02970CSRN54 Z-ADD25 # DEFAULT 02980CSR EXSR SR96 GET CRTFILE 02990CSR MOVE CALL LNK 02991CSR MOVE 'Q008PO 'PROG ÐÐ03000CSR PAR,# COMP '1' 50 03010CSR TST,# COMP 'S' 56 03020CSR 56 MOVE 'SHUTDOWN'PROG 03030CSR EXSR SR97 >>>>>>>>>> 03040CSR 56 EXSR SR98 >>>>>>>>>>>>>>>>>> 03041CSR MOVE ' 'PROG 03050C* DEFINE WORK FIELDS,ETC. 03060CSR MOVE ' ' RPGLIN 4 03070CSR MOVE ' ' RPGCOL 4 03080CSR MOVE ' ' BLK35 35 03090CSR MOVE ' ' BLK8 8 03100CSR Z-ADD0 ZERO7 70 03110CSR ENDSR 03120C******************************************************************** 03130CSR SR102 BEGSR 03140C* REQUEST VENDOR NAME. 03150CSR MOVE BLK20 TNAME 03160CSR Z-ADD544 M 50 03170CSR EXSR SR74 PROMPT/READ 03180CSR 90 GOTO END102 ESC 03190CSR 77 MOVE W20A TNAME 20 VENDOR NAME 03200CSR END102 ENDSR 03210C******************************************************************** 03220CSR SR103 BEGSR 03230C* REQUEST PO #. ÐÐ03240CSR Z-ADD514 M 03250CSR EXSR SR74 PROMPT/READ 03260CSR 90 GOTO END103 ESC 03270CSR 77 EXSR SR211 BUILD PO # 03280CSR END103 ENDSR 03290C******************************************************************** 03300CSR SR104 BEGSR 03310C* DISPLAY PO'S BY VENDOR NAME. 03320CSR SETOF 41 03330CSR MOVE BLK35 W25A 25 03340CSR MOVELTNAME W25A 03350CSR MOVE '00001' W25A 03360CSR W25A SETLLVMALT 03370CSR MOVE BLK35 LASTVA 25 03380C*------------------------------------------------------------------- 03390CSR T104A TAG 03400CSR SETOF 54 03410CSR READ VMALT 54 03420CSR 54 GOTO END104 03430CSR VAKEY COMP LASTVA 54 03440CSRN54 GOTO END104 03450CSR MOVE VAKEY LASTVA 03460CSR VASTAT COMP 'D' 54 03470CSR 54 GOTO T104A 03480CSR Z-ADDVAVEND TVEND 50 ÐÐ03490CSR MOVELTVEND W11A 11 03500CSR MOVE TPO W11A 03510CSR W11A SETLLPOVKEY 03520CSR MOVE BLK35 LASTPV 11 03530C*------------------------------------------------------------------- 03540CSR T104E TAG 03550CSR SETOF 54 03560CSR READ POVKEY 54 03570CSR 54 GOTO T104A 03580CSR PVKEY COMP LASTPV 54 03590CSRN54 GOTO T104A 03600CSR MOVE PVKEY LASTPV 03610CSR PVVEND COMP VAVEND 54 03620CSRN54 GOTO T104A 03630CSR PVSTAT COMP 'D' 54 03640CSR 54 GOTO T104E 03650CSR MOVELPVPO W9A 9 03660CSR MOVE ' ' W9A 03670CSR W9A SETLLPOITEM 03680CSR MOVE BLK35 LASTPO 9 03690CSR Z-ADD0 LSTVEN 03700C*------------------------------------------------------------------- 03710CSR T104G TAG 03720CSR SETOF 54 40 03730CSR READ POITEM 54 ÐÐ03740CSR 54 GOTO T104L 03750CSR PIPO COMP PVPO 54 03760CSRN54 GOTO T104L 03770CSR PISTAT COMP 'D' 54 03780CSR 54 GOTO T104G 03790CSR PIWOP COMP ' 12100' 70 03800CSRN70 PIWOP COMP ' 14100' 70 03810CSRN70 PIWOP COMP ' 14600' 70 03820CSR EXSR SR252 ALLOC RCPTS TO SCHD 03830CSR Z-ADD1 S 30 03840CSR ZERO7 LOKUPPIQ,S 54 03850CSRN54 Z-ADD1 S 03860CSRN54 ZERO7 LOKUPRCD,S 54 03870CSRN54 Z-ADD1 S 03880CSR PIVEND COMP LSTVEN 54 03890CSR PIVEND CHAINVMMAST H9 03900CSR H9 EXITFZLFCR 03910CSR H9 EXCPT 03920CSR H9 GOTO ENDJOB 03930CSR 41 03940CORN54 1 ADD COUNT COUNT 03950CSRN54 1 ADD COUNT COUNT 03960CSRN41 03970CORN54 SETON 71 03980CSRN54 SETON 69 ÐÐ03990CSR 71 EXCPT 04000CSR SETOF 6971 04010CSR EXSR SR72 DISPLAY ITEM 04020CSR Z-ADDPIVEND LSTVEN 50 04030CSRN50 COUNT COMP 28 54 54 04040CSR 50 COUNT COMP 23 54 54 04050CSRN54 GOTO T104H 04060CSR EXSR SR81 END PAGE 04070CSR EXSR SR75 READ 04080CSRN90 EXSR SR105 CLEAR PAGE 04090CSR 90 GOTO END104 04100CSR 77 GOTO END104 NEW VENDOR 04110C*------------------------------------------------------------------- 04120CSR T104H TAG 04130CSR ZERO7 LOKUPPIQ,S 54 04140CSRN54 Z-ADD1 S 04150CSRN54 ZERO7 LOKUPRCD,S 54 04160CSRN54 GOTO T104G 04170CSR EXSR SR76 DISPLAY SCHED 04180CSR 50 COUNT COMP 23 54 54 04190CSRN50 COUNT COMP 28 54 54 04200CSRN54 GOTO T104H 04210CSR EXSR SR81 END PAGE 04220CSR EXSR SR75 READ 04230CSRN90 EXSR SR105 CLEAR PAGE ÐÐ04240CSR 90 GOTO END104 04250CSR 77 GOTO END104 NEW VENDOR 04260CSR GOTO T104H 04270C*------------------------------------------------------------------- 04280CSR T104L TAG 04290CSR EXSR SR68 LF 04300CSR GOTO T104E 04310CSR END104 ENDSR 04320C******************************************************************** 04330CSR SR105 BEGSR 04340C* CLEAR PAGE 04350CSR EXSR SR70 CLEAR PAGE 04360CSR Z-ADD4 COUNT 30 04370CSR SETON 75 04380CSR EXCPT PUT HDG 04390CSR SETOF 75 04400CSR ENDSR 04410C****************************************************************** 04420CSR SR211 BEGSR 04430C* BUILD PO #. 04440CSR MOVEAW20A A20 04450CSR A20,1 COMP '0' 54 54 04460CSRN54 GOTO T211A NON-NUMERIC INPUT 04470CSR MOVEAA20,1 W5A 5 04480CSR Z-ADD5 W2N 20 ÐÐ04490CSR EXIT SUBRAJ R.J. 04500CSR RLABL W2N 04510CSR RLABL W5A 04520CSR MOVEL' ' TPO 6 04530CSR MOVE W5A TPO 04540CSR GOTO END211 04550C*------------------------------------------------------------------- 04560CSR T211A TAG 04570CSR MOVELW20A TPO 04580CSR MOVE TPO W5A 04590CSR Z-ADD5 W2N 04600CSR EXIT SUBRAJ R.J. 04610CSR RLABL W2N 04620CSR RLABL W5A 04630CSR MOVE W5A TPO 04640CSR END211 ENDSR 04650C******************************************************************** 04660CSR SR252 BEGSR 04670C* APPLY RECPTS TO SCHEDULE. 04680CSR Z-ADD0 RCD 04690CSR Z-ADD1 A 30 04700CSR Z-ADDPIQRCD SAVQTY 70 04710C*------------------------------------------------------------------- 04720CSR T252A TAG 04730CSR ZERO7 LOKUPPIQ,A 54 ÐÐ04740CSRN54 GOTO T252C 04750CSR Z-ADDPIQ,A W7N 70 04760CSR SETOF 57 04770CSR SAVQTY COMP W7N 545556 04780CSR 54 Z-ADDW7N RCD,A 04790CSR 54 SAVQTY SUB W7N SAVQTY 57 04800CSR 54 Z-ADD0 W7N 04810CSR 55 Z-ADDSAVQTY RCD,A 04820CSR 55 W7N SUB SAVQTY W7N 04830CSR 55 Z-ADD0 SAVQTY 57 04840CSR 56 Z-ADDSAVQTY RCD,A 04850CSR 56 Z-ADD0 SAVQTY 57 04860CSR 56 Z-ADD0 W7N 04870CSR 57 1 ADD A A 04880CSR 57 A COMP 26 54 04890CSR 57 GOTO T252A 04900CSR GOTO END252 04910C*------------------------------------------------------------------- 04920CSR T252C TAG 04930CSR Z-ADD1 A 04940CSR ZERO7 LOKUPPIQ,A 54 04950CSR 54 Z-ADDSAVQTY RCD,A 04960CSR END252 ENDSR 04970O******************************************************************** 04980OTERM132 E 73 ÐÐ04990O NUL 132 05000O MGTEXT 35 05010O BIT,8 36 05020O*------------------------------------------------------------------- 05030O E 75 05040O NUL 132 05050O BIT,28 1 05060O N50 8 '8091001' 05070O 50 10 '[001 ]001' 05080O 50 BIT,28 6 05090O*------------------------------------------------------------------- 05100O E 75 05110O BIT,28 1 05120O 2 'K' 05130O 21 'DYNAIR' 05140O 35 'VENDOR' 05150O 114 'DUE' 05160O 125 'SCHED' 05170O 132 'QTY' 05180O*------------------------------------------------------------------- 05190O E 75 05200O 4 'P.O.' 05210O 10 'ITEM' 05220O 20 'PART-NO.' 05230O 34 'PART-NO.' ÐÐ05240O 54 'DESCRIPTION' 05250O 93 'PRICE' 05260O 102 'ACCOUNT' 05270O 113 'DATE' 05280O 122 'QTY' 05290O 132 'RECVD' 05300O*------------------------------------------------------------------- 05310O E 75 05320O DIV 132 05330O*------------------------------------------------------------------- 05340O E 72 05350O PIPO 6 05360O 7 '-' 05370O PIITEM 10 05380O 70 PIPN 23 ' - - ' 05390O 70 PIVPN 39 05400O 70 PIDESC 72 05410O N70 PINDES 81 05420O PI$PRC2 93 05430O PILOT 94 05440O PIWOP 100 05450O 101 '-' 05460O PIWOD 104 05470O PID,S YB 113 05480O PIQ,S 2B 122 ÐÐ05490O RCD,S KB 132 05500O*------------------------------------------------------------------- 05510O E 76 05520O PID,S YB 113 05530O PIQ,S 2B 122 05540O RCD,S KB 132 05550O*------------------------------------------------------------------- 05560O E 81 05570O NUL 132 05580O 14 'END OF PAGE...' 05590O 38 'ENTER VENDOR NAME,RETURN' 05600O 54 ', OR ESC CODE: ' 05610O*--------------------------------------------------------------- 05620O E 71 05630O DIV 132 05640O*----------------------------------------------------------------- 05650O E 69 05660O VMNAME 45 05670O PVVENDZ 5 05680O E H9 05690O VAVEND 5 05700O PVVEND 15 05710O PVPO 25 05720O PIPO 35 05730O PIITEM 40 ÐÐ05740O PIVEND 50 05750O******************************************************************** 05760OCRTFILE E 97 05770O PROG 26 05780O CRTIME 33 05790O CRDATE 37 05800O LNK 79 05810O********************************************************************* ** NUL ARRAY 05820 05830** A20 ARRAY 05840 05850** RCD ARRAY 05860 05870** DIV 05880 05890** LNK ARRAY 05900 05910/* 05920_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Š<7 ŠX023GL P120282120282(èÈÐ00010H Q023GL00020F* LIST CHART OF ACCOUNTS, PARENTS ONLY - INDENTED. (X023GL) 00030F* REVISED 7-29-81 9:45 AM. * * * D I A B L O * * * 00040FGLGUIDE IP AF 9 DISK 00050FCAMAST ID F 40L18AI 1 DISK 00060FGLMAST IC F 165R 9AI 1 DISK 00070FCRTFILE UC F 256R DISK 00080F**************************************************************** 00090E NUL 1 132 1 NULL CHAR 00100E A8 8 8 1 A INPUT DATA ARRAY 00110E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00120E DUN 13 13 1 A EDIT CMPLT FLAG 00130E MES 1 1 30 00140E LEV 1 20 18 00150E DASH 1 1 43 00160E A24 24 24 1 00170E BIT 256 1 SCREEN CONTR. CHAR 00180E GLA 12 11 2 00190E REC 132 1 A 00200I******************************************************************* 00210IGLGUIDE GL 01 00220I 1 9 GKEY 00230I******************************************************************** 00240ICRTFILE CR 00250I 81 212 REC ÐÐ00260I******************************************************************** 00270IGLMAST GL 00280I* ACCOUNT MASTER. 00290I* KEY AREA 00300I* ACCOUNT # 9A 00310I 1 9 GLKEY 00320I 1 1 GLPRFX 00330I 2 60GLPRIM 00340I 7 90GLDASH 00350I* ACCOUNT GROUP 4A 00360I 14 17 GLGRUP 00370I* ACCOUNT DESCRIPTION 40A 00380I 18 57 GLDESC 00390I* BALANCE FORWARD AMOUNT 11.2P 00400I P 58 632GLBALF 00410I* ACTUAL $ 11.2P X 12 00420I P 64 135 GLA 00430I* CURRENT MONTH-PLUS 11.2P 00440I P 136 1412GLCMP 00450I* CURRENT MONTH-MINUS 11.2P 00460I P 142 1472GLCMM 00470I* SOURCE CODE 1A 00480I* S = SUB-ACCOUNT ONLY, 00490I* MAY NOT BE PARENT 00500I 148 148 GLSC ÐÐ00510I* BALANCE FORWARD CODE 2A 00520I* 1ST COL 00530I* 1 = ZERO BAL AT START NEW YR 00540I* 2 = CARRY PREV YR FRWD 00550I* 2ND COL 00560I* A = ZERO BAL AT START NEW MO 00570I* B = CARRY PREV MO FRWD 00580I 149 150 GLBFC 00590I* NUMB OF SUB-ACCOUNTS 5P 00600I P 157 1590GLNOSA 00610I* LOW LEVEL CODE 3N 00620I 160 1620GLLL 00630I* FILLER 00640I* RECORD STATUS 1A 00650I 165 165 GLSTAT 00660I******************************************************************** 00670ICAMAST CA 00680I* CHART OF ACCOUNTS. 00690I* KEY AREA. 00700I* PARENT ACCOUNT 9A 00710I 1 9 CAPAR 00720I* SUB-ACCOUNT 9A 00730I 10 18 CASUB 00740I* OPERATOR 1A 00750I* S = SUBTRACT ÐÐ00760I* A = ADD 00770I 25 25 CAOPER 00780I* EFFECTIVITY 00790I* START DATE 6N (YMD) 00800I 26 310CASDAT 00810I* END DATE 6N (YMD) 00820I 32 370CAEDAT 00830I* FILLER 00840I* RECORD STATUS 1A 00850I 40 40 CASTAT 00860C******************************************************************** 00870C* INITIALIZE 00880C N79 EXSR SR101 1-TIME INIT 00890C Z-ADD0 LASTL 30 00900C MOVE GKEY W9A 9 00910C EXSR SR80 GET GLMAST 00920C 60 GOTO END 00930C MOVE GLDESC PADESC 40 00940C MOVE GLSC PASC 1 00950C EXSR SR106 PRINT 00960C*---------------------------------------------------------------- 00970C END TAG 00980C SETOF 0102 00990CLR EXSR SR70 TOP FORM 01000CLR EXSR SR70 TOP FORM ÐÐ01010C******************************************************************** 01020CSR SR68 BEGSR 01030CSR EXITFQCLF LINE FEED 01040CSR 1 ADD COUNT COUNT 30 01050CSR ENDSR 01060C******************************************************************** 01070CSR SR69 BEGSR 01080C* PRINT. 01090CSR PORT CHAINCRTFILE H9 01100CSR H9 GOTO END 01110CSR MOVE ' ' REC 01120CSR EXCPT 01130CSR PORT CHAINCRTFILE H9 01140CSR H9 GOTO END 01150CSR SETOF 414243 01160CSR SETOF 457274 01170CSR ' ' LOKUPREC 54 01180CSRN54 GOTO END69 01190CSR EXSR SR68 LF 01200CSR MOVEAREC W148A 148 01210CSR EXITFZD148 01220CSR RLABL W148A 01230CSR END69 ENDSR 01240C***************************************************************** 01250CSR SR70 BEGSR ÐÐ01260C* CLEAR TERM SCREEN. 01270CSR EXITFZTFORM CLEAR SCREEN 01280CSR 1 ADD EGAP EGAP 40 01290CSR Z-ADD0 COUNT 01300CSR ENDSR 01310C********************************************************************** 01320CSR SR71 BEGSR 01330C* PUT HEADINGS TO TERMINAL 01340CSR EXSR SR70 TOP FORM 01350CSR MOVELGKEY W9A 01360CSR EXSR SR80 GET TOP GLMAST 01370CSR EXSR SR204 SET-UP ACTNO 01380CSR SETON 41 01390CSR EXSR SR69 PRINT HEADING 01400CSR SETON 42 01410CSR EXSR SR69 PRINT HEADING 01420CSR SETON 43 01430CSR EXSR SR69 PRINT HEADING 01440CSR EXSR SR68 LF 01450CSR 78 SETON 45 01460CSR 78 EXSR SR69 PRINT TOP ACCOUNT 01470CSR ENDSR 01480C********************************************************************* 01490CSR SR72 BEGSR 01500C* PUT DATA TO TERMINAL ÐÐ01510CSR MOVE CASUB W9A 01520CSR EXSR SR80 GET GLMAST 01530CSR GLNOSA COMP 0 54 01540CSRN54 GOTO END72 NOT PARENT 01550CSR LASTL COMP 0 54 01560CSR 54 LASTL COMP L 54 01570CSR 54 EXSR SR68 LF 01580CSR EXSR SR203 FLAG LEVEL 01590CSR EXSR SR204 BUILD ACCT # 01600CSR SETON 7278 01610CSR EXSR SR69 PRINT DATA 01620CSR Z-ADDL LASTL 30 01630CSR COUNT COMP 53 54 54 01640CSRN54 GOTO END72 01650CSR EXSR SR71 PUT HEADING 01660CSR END72 ENDSR 01670C********************************************************************** 01680CSR SR80 BEGSR 01690C* GET MASTER RECORD 01700CSR W9A CHAINGLMAST 60 GET MASTER 01710CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 01720CSR ENDSR 01730C*********************************************************************** 01740CSR SR101 BEGSR 01750C* 1-TIME INITIALIZE ÐÐ01760CSR SETON 79 01770CSR MOVE BIT,1 NUL 01780CSR MOVE '08' W2A 2 01790CSR EXITFZVMI VERTICAL SPACING 01800CSR RLABL W2A 01810CSR MOVE '15' W2A 01820CSR EXITFZHMI HORIZ SPACING 01830CSR RLABL W2A 01840CSR MOVEANUL NUL92 92 01850CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 01860CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 01870CSR MOVE ' ' BLK8 8 1 01880C* GET PORT/CRTFILE. 1 01890CSR MOVE ' 'W8A 8 1 01900CSR Z-ADD0 W2N 20 01910CSR Z-ADD0 W1N 10 01920CSR MOVE ' ' W2A 01930CSR EXITFPGMINX GET PORT 01940CSR RLABL W8A 01950CSR RLABL W2N 01960CSR RLABL W1N 01970CSR RLABL W2A 01980CSR MOVE W2A PORT 20 01990CSR PORT COMP 0 54 02000CSRN54 Z-ADD25 PORT ÐÐ02010CSR EXSR SR71 PUT HEADING 02020C* DEFINE WORK FIELDS,ETC. 02030CSR MOVE ' ' BLK35 35 02040CSR MOVE ' ' BLK9 9 02050CSR MOVE ' ' BLK18 18 02060CSR ENDSR 02070C**************************************************************** 02080CSR SR106 BEGSR 02090C* DISPLAY CHART OF ACCOUNTS 02100CSR SETOF 78 02110CSR EXSR SR68 LF 02120CSR COUNT COMP 53 54 54 02130CSR 54 EXSR SR71 NEW PAGE 02140CSR Z-ADD1 L 30 02150CSR EXSR SR203 FLAG LEVEL 02160CSR EXSR SR204 BUILD ACTNO 02170CSR SETON 74 02180CSR EXSR SR69 PUT LEVEL-1 02190CSR MOVE BLK18 LEV 02200CSR Z-ADD3 L 02210CSR MOVELGKEY LEV,2 02220C*------------------------------------------------------------------- 02230CSR T106A TAG 02240C* GET SAVED LOWER LEVEL SUB-ACCOUNTS, IF ANY. 02250CSR L SUB 1 L 54 INDENT LEVEL ÐÐ02260CSRN54 GOTO END106 02270CSR LEV,L COMP BLK18 54 02280CSRN54 GOTO T106A NONE THIS LEVEL 02290CSR MOVELLEV,L W18A 18 02300CSR MOVELLEV,L CURACT 9 MACH ACNT # 02310CSR MOVE BLK18 LEV,L 02320C*------------------------------------------------------------------- 02330CSR T106B TAG 02340CSR W18A SETLLCAMAST 02350C*------------------------------------------------------------------- 02360CSR T106C TAG 02370C* READ CHART ACCOUNTS FILE. 02380CSR SETOF 54 02390CSR READ CAMAST 54 02400CSR 54 GOTO T106A END FILE 02410CSR CAPAR COMP CURACT 54 02420CSRN54 GOTO T106A END ASSY 02430CSR CASTAT COMP 'D' 54 02440CSR 54 GOTO T106C DELETED 02450C* DISPLAY LINE ENTRY. 02460CSR EXSR SR72 PUT DATA 02470C* BRANCH IF NOT PARENT. 02480CSR GLNOSA COMP 0 54 02490CSRN54 GOTO T106C NOT PARENT 02500C*------------------------------------------------------------------- ÐÐ02510CSR T106D TAG 02520C* SAVE CUR ACCT + 1 AND CHASE NEXT LOWER INDENT. 02530CSR MOVE CASUB W9A 02540CSR MOVE CASUB W3N 30 02550CSR 1 ADD W3N W3N 02560CSR MOVE W3N W9A 02570CSR MOVE W9A LEV,L 02580CSR MOVELCURACT LEV,L SAVE PAR/SUB 02590CSR MOVE CASUB CURACT 02600CSR MOVELCASUB W18A 02610CSR MOVE BLK9 W18A 02620CSR 1 ADD L L NEW INDENT LEV 02630CSR GOTO T106B CHASE DOWN 02640CSR END106 ENDSR 02650C****************************************************************** 02660CSR SR203 BEGSR 02670C* IDENTIFY INDENTURE LEVEL 02680CSR L COMP 1 2121 02690CSR L COMP 2 22 02700CSR L COMP 3 23 02710CSR L COMP 4 24 02720CSR L COMP 5 25 02730CSR L COMP 6 26 02740CSR L COMP 7 27 02750CSR L COMP 8 28 ÐÐ02760CSR L COMP 9 29 02770CSR L COMP 10 30 02780CSR L COMP 11 31 31 02790CSR 21 Z-ADD1 L 02800CSR ENDSR 02810C******************************************************************** 02820CSR SR204 BEGSR 02830C* BUILD ACTNO FIELD FOR OUTPUT. 02840CSR MOVEAGLPRFX A24 02850CSR GLPRFX COMP ' ' 54 02860CSRN54 MOVEA'_' A24,1 02870CSR MOVE GLPRIM W5A 5 02880CSR MOVEAW5A A24,2 02890CSR MOVE '-' A24,7 02900CSR MOVE GLDASH W3A 3 02910CSR MOVEAW3A A24,8 02920CSR MOVEAA24 ACTNO 10 02930CSR GLCMP SUB GLCMM CURNET 112 02940CSR ENDSR 02950O******************************************************************** 02960OCRTFILE E 41 02970O* PUT HEADING - PARENT ACCOUNT. 02980O REC 212 02990O UDATE Y 8 03000O 208 'PAGE' ÐÐ03010O EGAP Z 212 03020O 142 'INDENTED CHART OF' 03030O 166 'ACCOUNTS - PARENTS ONLY' 03040O*------------------------------------------------------------------- 03050O E 42 03060O* PUT HEADING - SUB-ACCOUNT. 03070O REC 212 03080O 99 'ACCOUNT NO.' 03090O 171 'TYPE' 03100O 177 'OPER' 03110O 194 'EFFECTIVITY' 03120O 211 'CUR-MO.' 03130O*------------------------------------------------------------------- 03140O E 43 03150O REC 212 03160O 81 '1' 03170O 84 '2' 03180O 87 '3' 03190O 90 '4' 03200O 93 '5' 03210O 96 '6' 03220O 99 '7' 03230O 102 '8' 03240O 105 '9' 03250O 109 '10' ÐÐ03260O 112 '11' 03270O 140 '<--------------' 03280O 151 'DESCRIPTION' 03290O 165 '------------->' 03300O 171 'CODE' 03310O 177 'CODE' 03320O 187 'START' 03330O 195 'STOP' 03340O 211 'NET-BAL' 03350O*------------------------------------------------------------------- 03360O E 72 03370O* SUB-ACCOUNT DATA. 03380O REC 212 03390O DASH 123 03400O 21 ACTNO 93 03410O 22 ACTNO 96 03420O 23 ACTNO 99 03430O 24 ACTNO 102 03440O 25 ACTNO 105 03450O 26 ACTNO 108 03460O 27 ACTNO 111 03470O 28 ACTNO 114 03480O 29 ACTNO 117 03490O 30 ACTNO 120 03500O 31 ACTNO 123 ÐÐ03510O GLDESC 165 03520O GLSC 170 03530O CAOPER 175 03540O CURNETK 212 03550O CASDAT 188 ' - - ' 03560O CAEDAT 198 ' - - ' 03570O*------------------------------------------------------------------- 03580O E 74 03590O OR 45 78 03600O REC 212 03610O DASH 123 03620O ACTNO 93 03630O 78 45 101 'CONT''D' 03640O PADESC 165 03650O PASC 169 03660O CURNETK 212 ** NUL ARRAY 003670 003680** A8 ARRAY 003690 003700** NUM ARRAY 003710002 PAR PRIME 003720003 PAR DASH 003730** DUN ARRAY 003740 003750ÐÐ** MES ARRAY 003760---MESSAGE NOT ON FILE--- 003770** LEV ARRAY 03780 03790** DASH ARRAY 03800. . . . . . . . . . . . . . . 003810** A24 ARRAY 003820 003830/* 003840_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(„=G „wX003PJ P120282120282(èÈÐ00010H Q003PJ00020F* PRINT ENGINEERING WORK ORDER STATUS. (X003PJ) 00030F* REVISED 8/05/81 4:15 PM. 00040FMGFILE IC F 80R DISK 00050FPJMAST IP F 170 12AI 1 DISK 00060FDEPTNAMEIT F 80 EDISK 00070FPRINT O F 132 OF PRINTER 00080F**************************************************************** 00090E DEPTNAME TABDEP 1 55 5 0ATABNAM 20 00100E DEP 1 60 3 0A 00110E BHR 1 60 6 0 00120E AHR 1 60 6 0 00130E BL$ 1 60 7 0 00140E AL$ 1 60 7 0 00150E BM$ 1 60 7 0 00160E AM$ 1 60 7 0 00170E PA$ 2 9 2 00180E PB$ 2 7 0 00190E PC$ 2 9 2 00200I******************************************************************* 00210IMGFILE MG 00220I* MESSAGE FILE. 00230I 1 35 MGTEXT 00240I******************************************************************** 00250IPJMAST PJ 01 170NCD ÐÐ00260I* PROJECT WORK ORDER. 00270I* TEMPORARY WORK ORDER FIELDS: 00280I* PRIME 4A 00290I 1 4 PJPRIML3 00300I 5 60PJDASHL2 00310I 10 120PJDEPTL1 00320I* WORK ORDER NO. 00330I* 1 9 PJORD 00340I* PRIME 6A 00350I* 1 6 PJPRIML3 00360I* DASH 3N 00370I* 7 90PJDASHL2 00380I* DEPT 3N 00390I* 10 120PJDEPTL1 00400I* ACCOUNT 5N 00410I 13 170PJACNT 00420I* MODEL 12A 00430I 18 29 PJMODL 00440I* DESCRIPTION 40A 00450I 30 69 PJDESC 00460I* SCHEDULE. 00470I* START DATE 6N 00480I 70 750PJBSD 00490I* COMPLETION DATE 6N 00500I 76 810PJBCD ÐÐ00510I* BUDGET - LABOR HRS 7P 00520I P 82 850PJBLH 00530I* BUDGET - LABOR $ 7P 00540I P 86 89 PB$,1 00550I* BUDGET - MATERIAL $ 7P 00560I P 90 93 PB$,2 00570I* ACTUAL. 00580I* START DATE 6N 00590I 94 990PJASD 00600I* COMPLETION DATE 6N 00610I 100 1050PJACD 00620I* LABOR HRS 7.1P 00630I P 106 1091PJALH 00640I* LABOR $ 9.2P 00650I P 110 114 PA$,1 00660I* MATERIAL $ 9.2P 00670I P 115 119 PA$,2 00680I* STATUS. 00690I* LABOR - % COMPLETE 3.2P 00700I P 120 1212PJLPCT 00710I* MATERIAL - % COMPLETE 3.2P 00720I P 122 1232PJMPCT 00730I* CURRENT MONTH - ACTUAL. 00740I* LABOR HRS 7.1P 00750I P 124 1271PJCLH ÐÐ00760I* LABOR $ 9.2P 00770I P 128 132 PC$,1 00780I* MATERIAL $ 9.2P 00790I P 133 137 PC$,2 00800I* RECORD STATUS 1A 00810I 170 170 PJSTAT 00820I*------------------------------------------------------------------- 00830I GG 02 00840C******************************************************************** 00850C Z-ADD0 ZERO3 30 STUPIDITY 00860C L2 SETOF 70 00870C L3 SETOF 71 00880C N01 GOTO END 00890C PJACD COMP 0 54 00900C 54 SETOF 01 00910C 54 GOTO END 00920C N69 EXSR SR101 00930C PJCLH ADD PJALH PJALH 00940C PC$ ADD PA$ PA$ 00950C PJBLH ADD L2BHR L2BHR 71H 00960C PJALH ADD L2AHR L2AHR 70H 00970C PB$,1 ADD L2BL$ L2BL$ 70H 00980C PA$,1 ADD L2AL$ L2AL$ 70H 00990C PB$,2 ADD L2BM$ L2BM$ 70H 01000C PA$,2 ADD L2AM$ L2AM$ 70H ÐÐ01010C SETON 70 01020C 78 SETON 79 01030C SETON 78 01040C EXSR SR102 01050C*------------------------------------------------------------------- 01060C END TAG 01070CL2 70 L2BHR ADD L3BHR L3BHR 71H 01080CL2 70 L2AHR ADD L3AHR L3AHR 70H 01090CL2 70 L2BL$ ADD L3BL$ L3BL$ 70H 01100CL2 70 L2AL$ ADD L3AL$ L3AL$ 70H 01110CL2 70 L2BM$ ADD L3BM$ L3BM$ 70H 01120CL2 70 L2AM$ ADD L3AM$ L3AM$ 70H 01130CL2 70 SETON 71 01140CL2 70 SETON 83 01150CL2 70 EXCPT DASH TOTALS 01160CL2 70 SETOF 83 01170CL3 71 SETON 84 01180CL3 71 EXCPT JOB TOTALS 01190CL3 71 SETOF 84 01200CLR XFOOTBHR BUDHR 70 01210CLR XFOOTAHR ACTHR 70 01220CLR XFOOTBL$ BUDL$ 80 01230CLR XFOOTAL$ ACTL$ 80 01240CLR XFOOTBM$ BUDM$ 80 01250CLR XFOOTAM$ ACTM$ 80 ÐÐ01260CLR SETON OF85 01270CLR Z-ADD1 X 30 01280C*------------------------------------------------------------------- 01290CLR LR1 TAG 01300CLR ZERO3 LOKUPDEP,X 54 01310CLRN54 GOTO ENDLR 01320CLR DEP,X COMP 999 54 01330CLR 54 GOTO ENDLR 01340CLR Z-ADDDEP,X W5N 50 01350CLR W5N LOKUPTABDEP TABNAM 54 01360CLR 54 MOVE TABNAM DEPNAM 17 01370CLRN54 MOVE BLK20 DEPNAM 01380CLR SETON 81 01390CLR EXCPT 01400CLR SETOF 81 01410CLR SETON 82 01420CLR GOTO LR1 01430C*------------------------------------------------------------------- 01440CLR ENDLR TAG 01450CLR SETON 80 01460CLR EXCPT TOTALS 01470CLR SETOF 80 01480C******************************************************************** 01490CSR SR101 BEGSR 01500C* SET-UP DEP ARRAYS. ÐÐ01510CSR SETON 69 01520CSR Z-ADD999 DEP 01530CSR Z-ADD0 X 30 01540CSR Z-ADD1 W5N 50 01550C*------------------------------------------------------------------- 01560CSR T101A TAG 01570CSR W5N LOKUPTABDEP 54 54 01580CSRN54 GOTO T101B 01590CSR 1 ADD X X 01600CSR Z-ADDTABDEP DEP,X 01610CSR 1 ADD TABDEP W5N 01620CSR GOTO T101A 01630C*------------------------------------------------------------------- 01640CSR T101B TAG 01650C* DEFINE WORK FIELDS. 01660CSR Z-ADD0 BHR 01670CSR Z-ADD0 AHR 01680CSR Z-ADD0 BL$ 01690CSR Z-ADD0 AL$ 01700CSR Z-ADD0 BM$ 01710CSR Z-ADD0 AM$ 01720CSR Z-ADD0 ZERO3 30 01730CSR MOVE ' ' BLK20 20 01740CSR ENDSR 01750C******************************************************************** ÐÐ01760CSR SR102 BEGSR 01770CSR Z-ADD1 X 01780CSR PJDEPT LOKUPDEP,X 54 01790CSRN54 GOTO T102B 01800C*------------------------------------------------------------------- 01810CSR T102A TAG 01820CSR PJBLH ADD BHR,X BHR,X H 01830CSR PJALH ADD AHR,X AHR,X H 01840CSR PB$,1 ADD BL$,X BL$,X H 01850CSR PA$,1 ADD AL$,X AL$,X H 01860CSR PB$,2 ADD BM$,X BM$,X H 01870CSR PA$,2 ADD AM$,X AM$,X H 01880CSR GOTO END102 01890C*------------------------------------------------------------------- 01900CSR T102B TAG 01910CSR Z-ADD1 X 01920CSR 999 LOKUPDEP,X 54 01930CSR Z-ADDPJDEPT DEP,X 01940CSR GOTO T102A 01950CSR END102 ENDSR 01960O******************************************************************** 01970OPRINT H 201 L3 01980O OR OF 01990O OR 01N79 02000O UDATE 8 ' - - ' ÐÐ02010O 59 'E N G I N E E R I N G' 02020O 69 'W O R K' 02030O 81 'O R D E R' 02040O 95 'S T A T U S' 02050O 118 'PAGE' 02060O PAGE Z 123 02070O*------------------------------------------------------------------- 02080O H 2 81N82 02090O 73 'DEPARTMENT TOTALS' 02100O*------------------------------------------------------------------- 02110O H 2 L3 02120O OR OF 02130O OR 01N79 02140O N85 3 'EWO' 02150O N85 17 'MODEL' 02160O N85 37 'DESCRIPTION' 02170O*------------------------------------------------------------------- 02180O D 2 L3 02190O OR OF 02200O OR 01N79 02210O N85 PJPRIM 6 02220O N85 PJMODL 24 02230O N85 PJDESC 66 02240O*------------------------------------------------------------------- 02250O D 1 L3 ÐÐ02260O OR OF 02270O OR 01N79 02280O N85 17 '- - - - - - - - -' 02290O N85 25 'T A S K' 02300O N85 45 '- - - - - - - - - -' 02310O*------------------------------------------------------------------- 02320O D 1 L3 02330O OR OF 02340O OR 01N79 02350O N85 14 '*---' 02360O N85 22 'SCHEDULE' 02370O N85 26 '---*' 02380O N85 34 '*----' 02390O N85 40 'ACTUAL' 02400O N85 46 '-----*' 02410O 59 '*---' 02420O 70 'LABOR HOURS' 02430O 75 '----*' 02440O N85 85 'PERCENT' 02450O 92 '*--' 02460O 102 'LABOR COST' 02470O 105 '--*' 02480O 112 '*--' 02490O 121 'MATL COST' 02500O 125 '---*' ÐÐ02510O*------------------------------------------------------------------- 02520O D 2 L3 02530O OR OF 02540O OR 01N79 02550O N85 8 'DASH-NO.' 02560O N85 15 'START' 02570O N85 26 'COMPLETE' 02580O N85 34 'START' 02590O N85 46 'COMPLETE' 02600O 53 'DEPT' 02610O 63 'BUDGET' 02620O 75 'ACTUAL' 02630O N85 86 'COMPLETE' 02640O 95 'BUDGET' 02650O 105 'ACTUAL' 02660O 115 'BUDGET' 02670O 125 'ACTUAL' 02680O*------------------------------------------------------------------- 02690O D 1 01 02700O PA$,2 K 126 02710O PB$,2 2 115 02720O PA$,1 K 106 02730O PB$,1 2 95 02740O PJMPCTZ 87 02750O PJLPCTZ 83 ÐÐ02760O PJALH K 75 02770O PJBLH 2 63 02780O PJDEPTZ 52 02790O PJACD 46 ' - - ' 02800O PJASD 36 ' - - ' 02810O PJBCD 26 ' - - ' 02820O PJBSD 16 ' - - ' 02830O PJDASH 4 '- ' 02840O*------------------------------------------------------------------- 02850O E 11 83 02860O 46 'T O T A L' 02870O L2AM$ KB 126 02880O L2BM$ 2B 115 02890O L2AL$ KB 106 02900O L2BL$ 2B 95 02910O L2AHR KB 75 02920O L2BHR 2B 63 02930O 52 '----->' 02940O*----------------------------------------------------------------- 02950O E 1 83NL3 02960O 1 ' ' 02970O*------------------------------------------------------------------- 02980O E 1 84 02990O 46 'J O B T O T A L' 03000O L3AM$ KB 126 ÐÐ03010O L3BM$ 2B 115 03020O L3AL$ KB 106 03030O L3BL$ 2B 95 03040O L3AHR KB 75 03050O L3BHR 2B 63 03060O 52 '----->' 03070O*------------------------------------------------------------------- 03080O EF 1 81 03090O AM$,X KB 126 03100O BM$,X 2B 115 03110O AL$,X KB 106 03120O BL$,X 2B 95 03130O AHR,X KB 75 03140O BHR,X 2B 63 03150O DEP,X ZB 52 03160O DEPNAM 45 03170O*------------------------------------------------------------------- 03180O E 11 80 03190O ACTM$ K 126 03200O BUDM$ 2 115 03210O ACTL$ K 106 03220O BUDL$ 2 95 03230O ACTHR K 75 03240O BUDHR 2 63 03250O 52 'TOTALS---->' ÐÐ** DEP ARRAY 003260 003270** BHR ARRAY 003280 003290** AHR ARRAY 003300 003310** BL$ ARRAY 003320 003330** AL$ ARRAY 003340 003350** BM$ ARRAY 003360 003370** AM$ ARRAY 003380 003390/* 003400_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(>¿ §X021GL P120282120282(èÈÐ00010H Q021GL00020F* PRINT CHART OF ACCOUNTS- INDENTED. (X021GL) SYSTEM PRINTER 00030F* REVISED 7-28-81 4:35 PM. 00040F* PARENT ACCOUNTS ONLY DG REL006 OK 00050F* NOTE: MUST BE RUN FROM PROCEDURE Z021GL. 00060FGLGUIDE IP AF 9 DISK 00070FGLWU IS AF 19 18AI 1 DISK 00080FCAMAST ID F 40L18AI 1 DISK 00090FGLMAST IC F 165R 9AI 1 DISK 00100FPRINT O F 132 OF LPRINTER 00110FTERM70 O F 70 5 00120F**************************************************************** 00130E LEV 1 20 18 00140E DASH 1 1 43 00150E DOTS 1 43 1 00160E A24 24 24 1 00170E GLA 12 11 2 00180L******************************************************************** 00190LPRINT 88FL 80OL 00200I******************************************************************** 00210IGLGUIDE GG 01 00220I 1 9 GGACT L1M1 00230I 2 60GGPRIM 70 00240I******************************************************************** 00250IGLWU GW 02 19NCD ÐÐ00260I 1 9 GWSUB L1M1 00270I 10 18 GWPAR 00280I 19 19 GWSTAT 00290I WG 03 00300I******************************************************************** 00310IGLMAST GL 00320I* ACCOUNT MASTER. 00330I* KEY AREA 00340I* ACCOUNT # 9A 00350I 1 9 GLKEY 00360I 1 1 GLPRFX 00370I 2 60GLPRIM 00380I 7 90GLDASH 00390I* ACCOUNT GROUP 4A 00400I 14 17 GLGRUP 00410I* ACCOUNT DESCRIPTION 40A 00420I 18 57 GLDESC 00430I* BALANCE FORWARD AMOUNT 11.2P 00440I P 58 632GLBALF 00450I* ACTUAL $ 11.2P X 12 00460I P 64 135 GLA 00470I* CURRENT MONTH-PLUS 11.2P 00480I P 136 1412GLCMP 00490I* CURRENT MONTH-MINUS 11.2P 00500I P 142 1472GLCMM ÐÐ00510I* SOURCE CODE 1A 00520I* S = SUB-ACCOUNT ONLY, 00530I* MAY NOT BE PARENT 00540I 148 148 GLSC 00550I* BALANCE FORWARD CODE 2A 00560I* 1ST COL 00570I* 1 = ZERO BAL AT START NEW YR 00580I* 2 = CARRY PREV YR FRWD 00590I* 2ND COL 00600I* A = ZERO BAL AT START NEW MO 00610I* B = CARRY PREV MO FRWD 00620I 149 150 GLBFC 00630I* NUMB OF SUB-ACCOUNTS 5P 00640I P 157 1590GLNOSA 00650I* LOW LEVEL CODE 3N 00660I 160 1620GLLL 00670I* FILLER 00680I* RECORD STATUS 1A 00690I 165 165 GLSTAT 00700I******************************************************************** 00710ICAMAST CA 00720I* CHART OF ACCOUNTS. 00730I* KEY AREA. 00740I* PARENT ACCOUNT 9A 00750I 1 9 CAPAR ÐÐ00760I* SUB-ACCOUNT 9A 00770I 10 18 CASUB 00780I* OPERATOR 1A 00790I* S = SUBTRACT 00800I* A = ADD 00810I 25 25 CAOPER 00820I* EFFECTIVITY 00830I* START DATE 6N (YMD) 00840I 26 310CASDAT 00850I* END DATE 6N (YMD) 00860I 32 370CAEDAT 00870I* FILLER 00880I* RECORD STATUS 1A 00890I 40 40 CASTAT 00900C******************************************************************** 00910C N79 EXSR SR101 INIT. 00920C MR 00930CORN70 00940CORN01 GOTO END 00950C EXSR SR106 00960C*------------------------------------------------------------------- 00970C END TAG 00980C******************************************************************** 00990CSR SR71 BEGSR 01000C* PUT HEADINGS TO TERMINAL ÐÐ01010CSR 1 ADD EGAP EGAP 40 01020CSR MOVELGGACT W9A 01030CSR EXSR SR80 GET TOP GLMAST 01040CSR EXSR SR204 SET-UP ACTNO 01050CSR SETON 71 01060CSR EXCPT PUT HEADINGS 01070CSR SETOF 71 01080CSR Z-ADD12 COUNT 30 01090CSR ENDSR 01100C********************************************************************* 01110CSR SR72 BEGSR 01120C* PUT DATA TO TERMINAL 01130CSR MOVE CASUB W9A 01140CSR EXSR SR80 GET GLMAST 01150CSR GLNOSA COMP 0 54 01160CSRN54 GOTO T72B NOT PARENT 01170CSR 1 ADD COUNT COUNT 30 LINE COUNT 01180CSR EXSR SR203 FLAG LEVEL 01190CSR EXSR SR204 BUILD ACCT # 01200CSR SETON 7278 01210CSR EXCPT PUT DATA 01220CSR SETOF 72 01230C*--------------------------------------------------------- 01240CSR T72B TAG 01250CSR COUNT COMP 80 54 54 ÐÐ01260CSRN54 GOTO END72 01270CSR EXSR SR71 PUT HEADING 01280CSR END72 ENDSR 01290C********************************************************************** 01300CSR SR80 BEGSR 01310C* GET MASTER RECORD 01320CSR W9A CHAINGLMAST 60 GET MASTER 01330CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 01340CSR ENDSR 01350C*********************************************************************** 01360CSR SR101 BEGSR 01370C* 1-TIME INITIALIZE 01380CSR SETON 79 01390CSR MOVE ' ' BLK8 8 01400C* DEFINE WORK FIELDS,ETC. 01410CSR MOVE ' ' BLK35 35 01420CSR MOVE ' ' BLK9 9 01430CSR MOVE ' ' BLK18 18 01440CSR MOVE BLK18 BLK43 43 01450CSR SETON 38 01460CSR EXCPT 01470CSR SETOF 38 01480CSR EXITFQPAUSE 01490CSR ENDSR 01500C**************************************************************** ÐÐ01510CSR SR106 BEGSR 01520C* DISPLAY CHART OF ACCOUNTS 01530CSR SETOF 78 01540CSR MOVE GGACT W9A 9 01550CSR EXSR SR80 GET GLMAST 01560CSR MOVE GLDESC PADESC 40 01570CSR MOVE GLSC PASC 1 01580CSRN77 EXSR SR71 PUT HEADING 01590CSR 77 SETON 76 01600CSR 77 EXCPT SKIP 3 LINES 01610CSR 77 EXCPT 01620CSR 77 SETOF 76 01630CSR 2 ADD COUNT COUNT 01640CSR Z-ADD1 L 30 01650CSR EXSR SR203 FLAG LEVEL 01660CSR EXSR SR204 BUILD ACTNO 01670CSR SETON 7477 01680CSR EXCPT PUT LEVEL-1 01690CSR SETOF 74 01700CSR 1 ADD COUNT COUNT 01710CSR MOVE BLK18 LEV 01720CSR Z-ADD3 L 01730CSR MOVELGGACT LEV,2 01740C*------------------------------------------------------------------- 01750CSR T106A TAG ÐÐ01760C* GET SAVED LOWER LEVEL SUB-ACCOUNTS, IF ANY. 01770CSR L SUB 1 L 54 INDENT LEVEL 01780CSRN54 GOTO T106R 01790CSR LEV,L COMP BLK18 54 01800CSRN54 GOTO T106A NONE THIS LEVEL 01810CSR MOVELLEV,L W18A 18 01820CSR MOVELLEV,L CURACT 9 MACH ACNT # 01830CSR MOVE BLK18 LEV,L 01840C*------------------------------------------------------------------- 01850CSR T106B TAG 01860CSR W18A SETLLCAMAST 01870C*------------------------------------------------------------------- 01880CSR T106C TAG 01890C* READ CHART ACCOUNTS FILE. 01900CSR SETOF 54 01910CSR READ CAMAST 54 01920CSR 54 GOTO T106A END FILE 01930CSR CAPAR COMP CURACT 54 01940CSRN54 GOTO T106A END ASSY 01950CSR CASTAT COMP 'D' 54 01960CSR 54 GOTO T106C DELETED 01970C* DISPLAY LINE ENTRY, IF PARENT. 01980CSR EXSR SR72 PUT DATA 01990C* BRANCH IF NOT PARENT. 02000CSR GLNOSA COMP 0 54 ÐÐ02010CSRN54 GOTO T106C NOT PARENT 02020C*------------------------------------------------------------------- 02030CSR T106D TAG 02040C* SAVE CUR ACCT + 1 AND CHASE NEXT LOWER INDENT. 02050CSR MOVE CASUB W9A 02060CSR MOVE CASUB W3N 30 02070CSR 1 ADD W3N W3N 02080CSR MOVE W3N W9A 02090CSR MOVE W9A LEV,L 02100CSR MOVELCURACT LEV,L SAVE PAR/SUB 02110CSR MOVE CASUB CURACT 02120CSR MOVELCASUB W18A 02130CSR MOVE BLK9 W18A 02140CSR 1 ADD L L NEW INDENT LEV 02150CSR SETON 75 02160CSR EXCPT 02170CSR SETOF 75 02180CSR 1 ADD COUNT COUNT 02190CSR GOTO T106B CHASE DOWN 02200C*------------------------------------------------------------------- 02210CSR T106R TAG 02220CSR END106 ENDSR 02230C******************************************************************** 02240CSR SR203 BEGSR 02250C* FLAG INDENTURE LEVEL. ÐÐ02260CSR MOVEADASH DOTS 02270CSR L COMP 1 2121 02280CSR L COMP 2 22 02290CSR L COMP 3 23 02300CSR L COMP 4 24 02310CSR L COMP 5 25 02320CSR L COMP 6 26 02330CSR L COMP 7 27 02340CSR L COMP 8 28 02350CSR L COMP 9 29 02360CSR L COMP 10 30 02370CSR L COMP 11 31 31 02380CSR 21 Z-ADD1 L 02390CSR 3 MULT L X 30 02400CSR X SUB 2 X 02410CSR X COMP 43 54 02420CSR 54 GOTO END203 02430CSR MOVEABLK43 DOTS,X 02440CSR MOVEADOTS W43A 43 02450CSR END203 ENDSR 02460C******************************************************************** 02470CSR SR204 BEGSR 02480C* BUILD ACTNO FIELD FOR OUTPUT. 02490CSR MOVEAGLPRFX A24 02500CSR GLPRFX COMP ' ' 54 ÐÐ02510CSRN54 MOVEA'_' A24,1 02520CSR MOVE GLPRIM W5A 5 02530CSR MOVEAW5A A24,2 02540CSR MOVE '-' A24,7 02550CSR MOVE GLDASH W3A 3 02560CSR MOVEAW3A A24,8 02570CSR MOVEAA24 ACTNO 10 02580CSR GLCMP SUB GLCMM CURNET 112 02590CSR ENDSR 02600O******************************************************************** 02610OPRINT E 101 71 02620O* PUT HEADING. 02630O UDATE Y 8 02640O 127 'PAGE' 02650O EGAP Z 132 02660O 52 'INDENTED CHART OF' 02670O 61 'ACCOUNTS' 02680O 84 '- PARENT ACCOUNTS ONLY' 02690O*------------------------------------------------------------------- 02700O E 71 02710O 19 'ACCOUNT NO.' 02720O 90 'TYPE' 02730O 95 'OPER' 02740O 99 'GRP' 02750O 114 'EFFECTIVITY' ÐÐ02760O 131 'CUR-MO.' 02770O*------------------------------------------------------------------- 02780O E 71 02790O* 02800O 1 '1' 02810O 4 '2' 02820O 7 '3' 02830O 10 '4' 02840O 13 '5' 02850O 16 '6' 02860O 19 '7' 02870O 22 '8' 02880O 25 '9' 02890O 29 '10' 02900O 32 '11' 02910O 60 '<--------------' 02920O 71 'DESCRIPTION' 02930O 85 '------------->' 02940O 90 'CODE' 02950O 95 'CODE' 02960O 100 'CODE' 02970O 108 'START' 02980O 115 'STOP' 02990O 131 'NET-BAL' 03000O*------------------------------------------------------------------- ÐÐ03010O E 71 03020O DASH 43 03030O*---------------------------------------------------------------- 03040O E 71 03050O 1 ' ' 03060O*------------------------------------------------------------------- 03070O E 72 03080O* SUB-ACCOUNT DATA. 03090O DASH 43 03100O 21 ACTNO 13 03110O 22 ACTNO 16 03120O 23 ACTNO 19 03130O 24 ACTNO 22 03140O 25 ACTNO 25 03150O 26 ACTNO 28 03160O 27 ACTNO 31 03170O 28 ACTNO 34 03180O 29 ACTNO 37 03190O 30 ACTNO 40 03200O 31 ACTNO 43 03210O GLDESC 85 03220O GLSC 88 03230O CAOPER 93 03240O GLGRUP 100 03250O CURNETK 132 ÐÐ03260O CASDAT 109 ' - - ' 03270O CAEDAT 118 ' - - ' 03280O*------------------------------------------------------------------- 03290O E 74 03300O OR 71 78 03310O DASH 43 03320O ACTNO 13 03330O 78 71 21 'CONT''D' 03340O PADESC 85 03350O PASC 89 03360O CURNETK 132 03370O*------------------------------------------------------------------- 03380O E 75 03390O W43A 43 03400O*------------------------------------------------------------------- 03410O E 76 03420O 1 ' ' 03430O******************************************************************** 03440OTERM70 E 38 03450O 24 'SET PRINTER 8-LPI ' ** LEV ARRAY 03460 03470** DASH ARRAY 03480. . . . . . . . . . . . . . . 003490** DOTS ARRAY 003500ÐÐ 003510** A24 ARRAY 003520 003530/* 003540_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(& ù &æX306SF Pˆ¦060683060683(èÈÐ00010H Q306SF00020F* PRINT SUMMARY OF P/O & B/O STATUS BY SELECTED VENDOR (TABLE) 00030F* REVISED 6/07/83 10:10 AM. 00040FPOTPO IP F 11 DISK 00050FPOFILE IS F 44R I DISK 00060FPOADRT IR F 3 3IT EDISK 00070FVMMAST IC F 384R 5AI 1 DISK 00080FPRINT O F 132 OF PRINTER 00090E********************************************************************** 00100E POADRT POFILE 00110E TABRAT 1 5 3 1ATABCLS 1 RATINGS CLASS 00120E VMC 4 20 COMMENTS 00130E POS 10 6 0 P/O STATUS - ALL 00140E PO7 10 6 0 " " - TYPE 7 00150E PO8 10 6 0 " " - TYPE 8,9 00160E BOS 4 6 0 B/O STATUS - ALL 00170E BO7 4 6 0 " " - TYPE 7 00180E BO8 4 6 0 " " - TYPE 8,9 00190E PPO 10 3 0 PERCENTAGES, P/O ARRAYS00200E PBO 4 3 0 PERCENTAGES, B/O ARRAYS00210I********************************************************************** 00220IPOTPO TO 09 00230I 1 50TOVEND 00240I* TOTAL P/O 6N 00250I 6 110TOTPO ÐÐ00260I********************************************************************* 00270IPOFILE PO 10 17 C1 18 C0 00280I OR 17 C3 18 C0 00290I* PURCHASE ORDERS (10, 30) 00300I* PART NO. 10N 00310I 1 100POPN 00320I* DUE DATE (YMD) 00330I 11 160PODUE 00340I* REC TYPE 00350I* 10=REC P/O 00360I* 30=P/O 00370I 17 18 POREC 00380I 20 200PODEP 00390I* TOTAL QTY P/O, ITEM 7N 00400I 30 360POQTY 00410I* P/O DESIGNATION 2A 00420I 37 38 POBUY 00430I* VENDOR # 5N 00440I 39 430POVENDL1 00450I* C=P/O COMMOTTED 00460I 44 44 POABO 00470I******************************************************************** 00480IVMMAST VM 00490I 6 25 VMSORT 00500I* REMARKS 20 X 4 ÐÐ00510I 258 337 VMC 00520I* DEL STATUS 00530I 384 384 VMSTAT 00540I******************************************************************** 00550C EXSR SR101 INIT IND 00560C 09 Z-ADDTOTPO TPO 60 SAVE TOTAL P/O 00570C 09 GOTO END 00580C L1 EXSR SR60 SELECT VENDOR 00590C N60 GOTO END 00600C EXSR SR01 PROCESS P/O 00610C*-------------------------------------------------------------------- 00620C END TAG 00630CL1 60 EXSR SR30 CALC %, PRINT 00640C********************************************************************* 00650CSR SR01 BEGSR 00660C* CLASSIFY P/O 00670CSR POABO COMP 'C' 31 00680CSR POREC COMP '10' 11REC P/O 00690CSRN11 PODUE COMP CURDAT 131213P/D 00700CSR POBUY COMP 'CB' 71P/O BUYER 00710CSRN71 SETON 81 OTHER 00720CSR EXSR SR10 ADD TO ARRAYS 00730CSR EXSR SR20 ADD TO B/O 00740CSR ENDSR 00750C********************************************************************** ÐÐ00760CSR SR10 BEGSR 00770C* ADD TO CORRECT P/O ARRAY SLOTS 00780CSR Z-ADD1 X 30 00790CSR EXSR SR11 ADD TO TOTAL 00800CSR 12 00810COR 13 31 Z-ADD2 X 00820CSR 12 00830COR 13 31 EXSR SR11 ADD TO EXPEDITE 00840CSR 31N11 Z-ADD3 X 00850CSR 31N11 EXSR SR11 ADD TO EXP B.O. 00860CSR 12 Z-ADD4 X 00870CSR 12 EXSR SR11 ADD TO P/D 00880CSR 12 31 Z-ADD5 X 00890CSR 12 31 EXSR SR11 ADD TO P/D W/ B/O 00900CSR 12N31 Z-ADD6 X 00910CSR 12N31 EXSR SR11 ADD TO P/D, NO B/O 00920CSR 11 Z-ADD7 X 00930CSR 11 EXSR SR11 ADD TO RECEIVED 00940CSR 11 31 Z-ADD8 X 00950CSR 11 31 EXSR SR11 ADD TO REC, B/O 00960CSR 11N31 Z-ADD9 X 00970CSR 11N31 EXSR SR11 ADD TO REC, NBO 00980CSR 13N31 Z-ADD10 X 00990CSR 13N31 EXSR SR11 ADD TO NO EFFECT 01000CSR ENDSR ÐÐ01010C******************************************************************** 01020CSR SR11 BEGSR 01030C* CUM TO P/O ARRAYS 01040CSR 1 ADD POS,X POS,X P/O ALL 01050CSR 71 1 ADD PO7,X PO7,X P/O, 7'S 01060CSR 81 1 ADD PO8,X PO8,X P/O, 8&9 01070CSR ENDSR 01080C******************************************************************** 01090CSR SR20 BEGSR 01100C* SET UP B/O ARRAY ELEMENT 01110CSR 31 Z-ADD1 X 01120CSR 31 EXSR SR21 ADD TO TOTAL 01130CSR 31 13 Z-ADD2 X 01140CSR 31 13 EXSR SR21 ADD TO EXPEDITE 01150CSR 31 12 Z-ADD3 X 01160CSR 31 12 EXSR SR21 ADD TO P/D 01170CSR 31 11 Z-ADD4 X 01180CSR 31 11 EXSR SR21 ADD TO REC. 01190CSR ENDSR 01200C********************************************************************** 01210CSR SR21 BEGSR 01220C* CUM TO B/O ARRAYS 01230CSR 1 ADD BOS,X BOS,X B/O ALL 01240CSR 71 1 ADD BO7,X BO7,X B/O, 7'S 01250CSR 81 1 ADD BO8,X BO8,X B/O, 8&9 ÐÐ01260CSR ENDSR 01270C********************************************************************* 01280CSR SR30 BEGSR 01290C* CALC PERCENTAGES, PRINT 01300CSR Z-ADD100 PPO,1 TOTAL 01310CSR Z-ADD2 X 01320C*--------------------------------------------------------------------- 01330CSR T30A TAG 01340CSR POS,X DIV POS,1 FACT 32H 01350CSR EXSR SR31 ADD TO % ARRAY 01360CSRN54 GOTO T30A 01370CSR SETON 80 01380CSR EXSR SR40 SAVE FOR RATE 01390CSR SETON 8182 01400CSR EXCPT PRINT P/O STATUS 01410CSR SETOF 808182 01420CSR Z-ADD100 PBO,1 TOTAL 01430CSR Z-ADD2 X 01440C*--------------------------------------------------------------------- 01450CSR T30B TAG 01460CSR BOS,X DIV BOS,1 FACT 32H 01470CSR EXSR SR32 ADD TO B/O % 01480CSRN54 GOTO T30B 01490CSR SETON 83 01500CSR EXSR SR41 GET RATE, CLASS ÐÐ01510CSR SETON 8485 01520CSR EXCPT PRINT BO VS PO 01530CSR SETOF 838485 01540CSR Z-ADD2 X 01550C*----------------------------------------------------------------------- 01560CSR T30C TAG 01570CSR PO7,X DIV PO7,1 FACT 32H 01580CSR EXSR SR31 ADD TO P/O % 01590CSRN54 GOTO T30C 01600CSR SETON 86 01610CSR EXSR SR40 SAVE FOR RATE 01620CSR SETON 8182 01630CSR EXCPT PRINT PO, 7'S 01640CSR SETOF 868182 01650CSR Z-ADD2 X 01660C*-------------------------------------------------------------------- 01670CSR T30D TAG 01680CSR BO7,X DIV BO7,1 FACT 32H 01690CSR EXSR SR32 ADD TO B/O % 01700CSRN54 GOTO T30D 01710CSR SETON 87 01720CSR EXSR SR41 GET RATE, CLASS 01730CSR SETON 8485 01740CSR EXCPT PRINT BO/PO 7 01750CSR SETOF 878485 ÐÐ01760CSR Z-ADD2 X 01770C*---------------------------------------------------------------------- 01780CSR T30E TAG 01790CSR PO8,X DIV PO8,1 FACT 32H 01800CSR EXSR SR31 ADD TO P/O % 01810CSRN54 GOTO T30E 01820CSR SETON 88 01830CSR EXSR SR40 SAVE FOR RATE 01840CSR SETON 8182 01850CSR EXCPT PRINT PO, 8 01860CSR SETOF 888182 01870CSR Z-ADD2 X 01880C*----------------------------------------------------------------------- 01890CSR T30F TAG 01900CSR BO8,X DIV BO8,1 FACT 32H 01910CSR EXSR SR32 ADD TO B/O % 01920CSRN54 GOTO T30F 01930CSR SETON 89 01940CSR EXSR SR41 GET RATE, CLASS 01950CSR SETON 8485 01960CSR EXCPT PRINT BO/PO, 8 01970CSR SETOF 898485 01980CSR ENDSR 01990C************************************************************************ 02000CSR SR31 BEGSR ÐÐ02010C* ADD TO P/O PERCENTAGE ARRAY 02020CSR FACT MULT 100 PPO,X 02030CSR 1 ADD X X 02040CSR X COMP 10 54 FINISHED 02050CSR ENDSR 02060C************************************************************************ 02070CSR SR32 BEGSR 02080C* ADD TO B/O PERCEDNTAGE ARRAY 02090CSR FACT MULT 100 PBO,X 02100CSR 1 ADD X X 02110CSR X COMP 4 54 02120CSR ENDSR 02130C********************************************************************** 02140CSR SR40 BEGSR 02150C* SAVE P/O PERCENTAGE FOR RATING 02160CSR Z-ADD1000 POPERC 40 02170CSR Z-ADD5 S 30 02180C*------------------------------------------------------------------ 02190CSR T40A TAG 02200CSR EXSR SR201 CLASS ARRAY 02210CSR PPO,S MULT 2 W3N 30 02220CSR POPERC SUB W3N POPERC 02230CSR S COMP 6 56 02240CSR 56 1 ADD S S 02250CSR 56 GOTO T40A ÐÐ02260CSR Z-ADD8 S 02270C*------------------------------------------------------------------- 02280CSR T40B TAG 02290CSR EXSR SR201 CLASS ARRAY 02300CSR POPERC ADD PPO,S POPERC 02310CSR S COMP 9 56 02320CSR 56 1 ADD S S 02330CSR 56 GOTO T40B 02340CSR EXSR SR200 TEST OVER 100% 02350CSR ENDSR 02360C********************************************************************* 02370CSR SR41 BEGSR 02380C* CALC RATE, GET CLASS 02390CSR Z-ADD2 S 02400CSR PBO,S COMP 0 58 02410CSR 58 EXSR SR45 02420CSR POPERC SUB PBO,S POPERC 02430CSR Z-ADD3 S 02440CSR PBO,S COMP 0 58 02450CSR 58 EXSR SR45 02460CSR PBO,S MULT 2 W3N 02470CSR POPERC SUB W3N POPERC 02480CSR Z-ADD4 S 02490CSR PBO,S COMP 0 58 02500CSR 58 EXSR SR45 ÐÐ02510CSR POPERC ADD PBO,S POPERC 02520CSR EXSR SR200 02530CSR EXSR SR201 TEST EXP, B/O 02540CSR 50 POPERC SUB 50 POPERC 02550CSR POPERC DIV 100 RAT1 75H 02560CSR EXSR SR43 02570CSR 54 W6N DIV TPO WD5 55H 02580CSR WD5 MULT 4 WD5 02590CSR RAT1 ADD WD5 RATE 31H 02600CSR RATE COMP 10 54 02610CSR 54 Z-ADD10 RATE 02620CSR RATE LOKUPTABRAT TABCLS 58 58 02630CSR 58 MOVE TABCLS CLASS 1 02640CSR SETOF 50 02650CSR ENDSR 02660C******************************************************************** 02670CSR SR43 BEGSR 02680CSR SETOF 54 02690CSR 83 Z-ADDPOS,1 W6N 60 54 02700CSR 87 Z-ADDPO7,1 W6N 54 02710CSR 89 Z-ADDPO8,1 W6N 54 02720CSR Z-ADD0 WD5 55 02730CSR ENDSR 02740C******************************************************************** 02750CSR SR45 BEGSR ÐÐ02760CSR 83 BOS,S COMP 0 54 02770CSR 87 BO7,S COMP 0 54 02780CSR 89 BO8,S COMP 0 54 02790CSR 54 Z-ADD1 PBO,S 02800CSR ENDSR 02810C********************************************************************* 02820CSR SR48 BEGSR 02830C* TEST FOR 0%, ADD 1 IF QUANTITY 02840CSR PPO,S COMP 0 54 02850CSR 54 GOTO END48 02860CSR W6N COMP 0 54 02870CSR 54 Z-ADD1 PPO,S 02880CSR END48 ENDSR 02890C********************************************************************** 02900CSR SR49 BEGSR 02910C* TEST FOR EXPEDITE OR B/O 02920CSR BOS,1 COMP 0 54 02930CSRN54 POS,2 COMP 0 54 02940CSR 54 SETON 50 02950CSR ENDSR 02960C****************************************************************** 02970CSR SR60 BEGSR 02980CSR SETOF 60 02990CSR Z-ADD0 POS 03000CSR Z-ADD0 PO7 CLEAR ARRAYS ÐÐ03010CSR Z-ADD0 PO8 03020CSR MOVE POVEND W5A 5 03030CSR W5A CHAINVMMAST 70 03040CSRN70 VMSTAT COMP 'D' 70 03050CSR 70 GOTO END60 03060CSR MOVELVMC,4 W1A 1 03070CSR W1A COMP 'A' 58 03080CSR 58 SETON 60 03090CSR 60 MOVE VMSORT VENDNM 20 03100CSR END60 ENDSR 03110C******************************************************************** 03120CSR SR79 BEGSR 03130C* TEST FOR EXPEDITE, B/O, CB 03140CSR BO7,1 COMP 0 54 03150CSRN54 PO7,2 COMP 0 54 03160CSR 54 SETON 50 03170CSR ENDSR 03180C******************************************************************* 03190CSR SR89 BEGSR 03200C* TEST FOR EXPEDITE, B/O, TM 03210CSR BO8,1 COMP 0 54 03220CSRN54 PO8,2 COMP 0 54 03230CSR 54 SETON 50 03240CSR ENDSR 03250C********************************************************************* ÐÐ03260CSR SR101 BEGSR 03270C* INIT INDICATORS 03280CSR SETOF 111213 03290CSR SETOF 317181 03300CSR MOVE ' ' W1A 1 03310CSR MOVE ' ' W5A 5 03320CSR 99 GOTO END101 03330CSR MOVELUDATE MMDD 40 03340CSR MOVE UDATE YY 20 03350CSR MOVE MMDD CURDAT 60 03360CSR MOVELYY CURDAT 03370CSR SETON 99 1 TIME 03380CSR END101 ENDSR 03390C******************************************************************** 03400CSR SR200 BEGSR 03410C* TEST FOR OVER 100%, REDUCE 03420CSR POPERC COMP 1000 54 03430CSR 54 Z-ADD1000 POPERC 03440CSR ENDSR 03450C********************************************************************* 03460CSR SR201 BEGSR 03470C* CLASSIFY ARRAY TYPES 03480CSR 80 Z-ADDPOS,S W6N 60 03490CSR 86 Z-ADDPO7,S W6N 03500CSR 88 Z-ADDPO8,S W6N ÐÐ03510CSR 80 03520COR 86 03530COR 88 EXSR SR48 03540CSR 83 EXSR SR49 03550CSR 87 EXSR SR79 03560CSR 89 EXSR SR89 03570CSR ENDSR 03580C******************************************************************** 03590OPRINT H 01 1P 03600O OR OF 03610O UDATE 8 ' - - ' 03620O PAGE Z 132 03630O 128 'PAGE' 03640O*----------------------------------------------------------------------- 03650O E 2 80 03660O 49 'P.O. STATUS' 03670O 51 '-' 03680O VENDNM 72 03690O E 22 83 03700O 53 'B.O. VS P.O. STATUS' 03710O 55 '-' 03720O VENDNM 76 03730O E 22 86 03740O 51 'P.O. STATUS (CB)' 03750O 53 '-' ÐÐ03760O VENDNM 74 03770O E 22 87 03780O 50 'B.O. VS P.O. STATUS' 03790O 55 '(CB)' 03800O 57 '-' 03810O VENDNM 78 03820O E 22 88 03830O 50 'P.O. STATUS (TM)' 03840O 52 '-' 03850O VENDNM 73 03860O E 22 89 03870O 50 'B.O. VS P.O. STATUS' 03880O 55 '(TM)' 03890O 57 '-' 03900O VENDNM 78 03910O*--------------------------------------------------------------------- 03920O E 1 81 03930O 18 'TOTAL OPEN' 03940O 26 'TOTAL' 03950O 38 'EXPEDITE' 03960O 46 'TOTAL' 03970O 58 'PAST DUE' 03980O 68 'PAST DUE' 03990O 78 'TOTAL PO' 04000O 88 'RECEIVED' ÐÐ04010O 98 'RECEIVED' 04020O 110 'TOTAL OPEN' 04030O*--------------------------------------------------------------------- 04040O E 2 81 04050O 16 'ORDERS' 04060O 28 'EXPEDITE' 04070O 36 'B.O.' 04080O 48 'PAST DUE' 04090O 57 'W/ B.O.' 04100O 65 'NBO' 04110O 78 'RECEIVED' 04120O 88 'W/ B.O.' 04130O 95 'NBO' 04140O 110 'ORDERS N/E' 04150O*------------------------------------------------------------------------ 04160O E 2 84 04170O 18 'TOTAL B.O.' 04180O 28 'EXPEDITE' 04190O 38 'PAST DUE' 04200O 48 'RECEIVED' 04210O*--------------------------------------------------------------------- 04220O E 2 80 04230O POS,1 Z 16 04240O POS,2 Z 26 04250O POS,3 Z 36 ÐÐ04260O POS,4 Z 46 04270O POS,5 Z 56 04280O POS,6 Z 66 04290O POS,7 Z 76 04300O POS,8 Z 86 04310O POS,9 Z 96 04320O POS,10Z 106 04330O*----------------------------------------------------------------------- 04340O E 2 83 04350O BOS,1 ZB 16 04360O BOS,2 ZB 26 04370O BOS,3 ZB 36 04380O BOS,4 ZB 46 04390O*----------------------------------------------------------------------- 04400O E 2 86 04410O PO7,1 Z 16 04420O PO7,2 Z 26 04430O PO7,3 Z 36 04440O PO7,4 Z 46 04450O PO7,5 Z 56 04460O PO7,6 Z 66 04470O PO7,7 Z 76 04480O PO7,8 Z 86 04490O PO7,9 Z 96 04500O PO7,10Z 106 ÐÐ04510O*-------------------------------------------------------------------- 04520O E 2 87 04530O BO7,1 ZB 16 04540O BO7,2 ZB 26 04550O BO7,3 ZB 36 04560O BO7,4 ZB 46 04570O*------------------------------------------------------------------- 04580O E 2 88 04590O PO8,1 Z 16 04600O PO8,2 Z 26 04610O PO8,3 Z 36 04620O PO8,4 Z 46 04630O PO8,5 Z 56 04640O PO8,6 Z 66 04650O PO8,7 Z 76 04660O PO8,8 Z 86 04670O PO8,9 Z 96 04680O PO8,10Z 106 04690O*------------------------------------------------------------------- 04700O E 2 89 04710O BO8,1 ZB 16 04720O BO8,2 ZB 26 04730O BO8,3 ZB 36 04740O BO8,4 ZB 46 04750O*--------------------------------------------------------------------- ÐÐ04760O E 2 82 04770O 9 '%' 04780O PPO,1 Z 16 04790O PPO,2 ZB 26 04800O PPO,3 ZB 36 04810O PPO,4 ZB 46 04820O PPO,5 ZB 56 04830O PPO,6 ZB 66 04840O PPO,7 ZB 76 04850O PPO,8 ZB 86 04860O PPO,9 ZB 96 04870O PPO,10ZB 106 04880O*---------------------------------------------------------------------- 04890O E 2 85 04900O 9 '%' 04910O PBO,1 Z 16 04920O PBO,2 ZB 26 04930O PBO,3 ZB 36 04940O PBO,4 ZB 46 04950O 91 'RATING =' 04960O RATE 2B 96 04970O 108 'CLASS =' 04980O CLASS B 110 04990O************************************************************************* ** RATINGS CLASS 05000ÐÐ049E 05010074D 05020084C 05030095B 05040100A 05050/* 05060_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(RPè RcX003QM Pî120282120282(èÈÐ00010H Q003QM00020F* REQUEST INPUT DATA FOR QMMAST. (X003QM) 00030F* REVISED 7/15/81 10:30 AM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FQMMAST UC F 160R 8AI 1 DISK 00080FCRT512 UC F 512R DISK 00090FSLMNAME IT F 80 EDISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E SLMNAME TABSLM 1 15 3 TABSLN 20 SALESMAN 00130E TABPRD 1 18 2 TABPRN 20 PRODUCT CODE 00140E TABSYS 1 2 1 TABSYN 20 SYST CODE 00150E TABSTC 1 6 1 TABSTN 10 STATUS WORD 00160E TABRES 1 5 1 TABREN 20 REASON LOST 00170E NUL 1 132 1 NULL CHAR 00180E A6 6 6 1 CALL READ PARAM. 00190E A20 20 20 1 A INPUT DATA ARRAY 00200E NUM 1 10 3 0 NUMERIC FIELD NO.'S 00210E DUN 22 22 1 A EDIT CMPLT FLAG 00220E INT 22 22 1 INIT FLAG. 00230E MES 1 1 30 00240E HED 1 22 36 HEADINGS. 00250E* ÐÐ00260E* 00270E CRD 6 7 0 DATE ARRAY 00280E BIT 33 1 SCREEN CONTR. CHAR 00290E CALL 5 6 CALL STACK 00300E* 00310E* 00320I******************************************************************* 00330IBITTAB BT 00340I 1 33 BIT 00350I******************************************************************* 00360IMGFILE MG 00370I* MESSAGE FILE. 00380I 1 35 MGTEXT 00390I******************************************************************** 00400IQMMAST QM 00410I* QUOTE MASTER. 00420I* QUOTE # 5A 00430I* 1 5 QMQOTE 00440I* ITEM # 3N 00450I* 6 80QMITEM 00460I* CUSTOMER NAME 20A 00470I* 9 28 QMNAME 00480I* CUSTOMER RFQ # 20A 00490I* 29 48 QMRFQ 00500I* RFQ ITEM # 4A ÐÐ00510I* 49 52 QMRFQI 00520I* CONTACT 20A 00530I* 53 72 QMCONT 00540I* ASSIGNED TO (SALESMAN) 3A 00550I* 73 75 QMSLSM 00560I* DATE ARRAY 7P X 6 00570I* 1 = RECEIVED 00580I* 2 = DUE 00590I* 3 = SENT 00600I* 4 = EXPECTED AWARD 00610I* 5 = FOLLOW-UP 00620I* 6 = EXPIRES 00630I* P 76 99 QMD 00640I* PRODUCT CLASS 2A 00650I* 100 101 QMPCLS 00660I* SYSTEM CODE 1A 00670I* 102 102 QMSYST 00680I* FILLER 103 103 FFFFFF 00690I* QUOTE AMOUNT 7P ($) 00700I* P 104 1070QMAMT 00710I* DELIVERY PROMISED (DAYS ARO) 3P 00720I* P 108 1090QMDEL 00730I* STATUS 1A 00740I* E = ENTERED 00750I* N = NO BID ÐÐ00760I* B = BID 00770I* P = PENDING 00780I* L = LOST 00790I* W = WON 00800I* C = CANCELLED 00810I* 110 110 QMSCOD 00820I* PROBABILITY OF AWARD 3.2P 00830I* P 111 1122QMPROB 00840I* WON/LOST REASON 1A 00850I* 113 113 QMREAS 00860I* REMARKS 40A 00870I* 114 153 QMREM 00880I* RECORD STATUS 1A 00890I 160 160 QMSTAT 00900I******************************************************************** 00910ICRT512 CR 00920I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00930I* STD AREA - SAME FOR ALL PROGRAMS. 00940I* EMPLOYEE # 5N 00950I 1 50CREMPL 00960I* USER CODE 8A 00970I 6 13 CRUSER 00980I* DEPT # 5N 00990I 14 180CRDEPT 01000I* JOB NAME 8A (JOB LOADED BY MENU) ÐÐ01010I 19 26 CRJOB 01020I* SHUTDOWN FLAG 1A 01030I* BLANK = NO SHUTDOWN 01040I 27 27 CRSHUT 01050I* TIME STARTED 6N 01060I 28 330CRTIME 01070I* DATE STARTED 6N 01080I 34 370CRDATE 01090I* CALL STACK 5 X 6A 01100I 38 67 CALL 01110I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 01120I 68 73 CRRET 01130I* MENU NAME 6A 01140I 74 79 CRMENU 01150I*------------------------------------------------------------------- 01160I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 01170I* CRT512 QMMAST FIELDS. 01180I* QUOTE # 5A 01190I 80 84 CRQOTE 01200I* ITEM # 3N 01210I 85 870CRITEM 01220I* CUSTOMER NAME 20A 01230I 88 107 CRNAME 01240I* CUSTOMER RFQ # 20A 01250I 108 127 CRRFQ ÐÐ01260I* RFQ ITEM # 4A 01270I 128 131 CRRFQI 01280I* CONTACT 20A 01290I 132 151 CRCONT 01300I* ASSIGNED TO (SALESMAN) 3A 01310I 152 154 CRSLSM 01320I* DATE ARRAY 7P X 6 01330I* (SEE CODES QMMAST) 01340I P 155 178 CRD 01350I* PRODUCT CLASS 2A 01360I 179 180 CRPCLS 01370I* SYSTEM CODE 1A 01380I 181 181 CRSYST 01390I* FILLER 182 182 FFFFFF 01400I* QUOTE AMOUNT 7P ($) 01410I P 183 1860CRAMT 01420I* DELIVERY PROMISED (DAYS ARO) 3P 01430I P 187 1880CRDEL 01440I* STATUS 1A 01450I* (SEE CODES QMMAST) 01460I 189 189 CRSCOD 01470I* PROBABILITY OF AWARD 3.2P 01480I P 190 1912CRPROB 01490I* WON/LOST REASON 1A 01500I 192 192 CRREAS ÐÐ01510I* REMARKS 40A 01520I 193 232 CRREM 01530I* 01540I* TRAN CODE 1A 01550I 233 233 CRTRAN 01560I* ORIGINAL CUST NAME 20A 01570I 234 253 CROCUS 01580I* ORIGINAL SALESMAN 3A 01590I 254 256 CROSLS 01600I* ORIGINAL FOLLOW-UP DATE 7P 01610I P 257 2600CROFU 01620C******************************************************************** 01630C* INITIALIZE 01640C EXSR SR101 1-TIME INIT 01650C*------------------------------------------------------------------ 01660C START TAG 01670C* SET-UP 1ST FIELD NO. 01680C Z-ADD4 F 30 FIELD # 01690C MOVE BLK5 KEY 5 01700C MOVE ' ' DUN 01710C MOVE ' ' INT 01720C GOTO READ 01730C*------------------------------------------------------------------ 01740C NEXT TAG 01750C* SET-UP NEXT FIELD NO. ÐÐ01760C 1 ADD F F FIELD # 01770C*----------------------------------------------------------------- 01780C READ TAG 01790C* READ DATA FROM TERMINAL. 01800C SETOF 9096 01810C EXSR SR102 VALIDATE FIELD # 01820C 55 GOTO UPDATE DONE 01830C EXSR SR201 IDENTIFY-F 01840C 06 GOTO NEXT 01850C SETON 69 01860C EXSR SR72 PROMPT 01870C SETOF 69 01880C EXSR SR75 READ TERMINAL 01890C 98 GOTO GOODBY GOODBY 01900C 94 GOTO MENU MENU REQUEST 01910C N77N88 EXSR SR104 EDIT INPUT FIELD 01920C 96 ERROR 01930CORN77N88 EXSR SR72 REWRITE INPUT DATA 01940C 93 GOTO NEWITM NEW ITEM 01950C 92 GOTO JUMP FIELD JUMP REQST 01960C 91 GOTO NEXT SKIP FORWARD 01970C 89 F SUB 1 F SKIP BACKWARD 01980C 89 GOTO READ " " 01990C 88 SETOF 90 SPACE FILL 02000C 88 SETON 77 " " ÐÐ02010C 87 GOTO START 02020C 86 GOTO UPDATE UPDATE 02030C 85 GOTO READ REPEAT 02040C 96 GOTO ERROR ERROR 02050C N77 GOTO NEXT NO DATA INPUT 02060C*------------------------------------------------------------------ 02070C PROCES TAG 02080C* PROCESS INPUT DATA 02090C EXSR SR103 MOVE DATA 02100C N96 EXSR SR104 EDIT DATA 02110C EXSR SR72 REWRITE DATA 02120C 96 GOTO ERROR ERROR 02130C GOTO NEXT 02140C*------------------------------------------------------------------ 02150C UPDATE TAG 02160C* UPDATE DATA BASE. 02170C EXSR SR105 FINAL EDIT 02180C 96 GOTO ERROR ERROR 02190C MOVEL'Q004QM' PROG 8 02200C GOTO END 02210C*------------------------------------------------------------------- 02220C JUMP TAG 02230C* SET-UP JUMP TO REQUESTED FIELD 02240C 1 ADD W W 30 02250C W COMP 20 54 ÐÐ02260C 54 Z-ADD318 M 50 96 FLAG ERROR 02270C 54 GOTO ERROR BAD ESC 02280C MOVE '000' W3A 3 02290C MOVEAA20,W W3A 02300C Z-ADD3 W2N 20 02310C EXIT SUBRAJ R. JUSTIFY 02320C RLABL W2N 02330C RLABL W3A 02340C MOVE W3A F NEW FIELD # 02350C GOTO READ 02360C*-------------------------------------------------------------------- 02370C ERROR TAG 02380C EXSR SR102 VALIDATE FIELD # 02390C EXSR SR89 GET MSG 02400C EXSR SR73 PUT MSG 02410C GOTO READ 02420C*------------------------------------------------------------------ 02430C NEWITM TAG 02440C* SET-UP LINK FOR NEW ITEM 02450C MOVEL'Q001QM' PROG 8 02460C GOTO END 02470C*------------------------------------------------------------------- 02480C MENU TAG 02490C* SET-UP LINK TO MENU 02500C MOVEL'QQQM01' PROG ÐÐ02510C GOTO END 02520C*-------------------------------------------------------------------- 02530C GOODBY TAG 02540C* LINK TO SIGN-OFF 02550C MOVEL'GOODBY' PROG 02560C GOTO END 02570C*------------------------------------------------------------------- 02580C END TAG 02590C PROG COMP BLK8 54 02600C N54 MOVEL'Q002QM' PROG DEFAULT. 02610C EXSR SR97 UPDATE CRT512 02620C EXSR SR203 CLASSIFY TRAN. 02630C N60 CRITEM COMP 0 60 ZERO ITEM UPDATE 02640C 94N60 02650COR 93N60 02660COR 98N60 EXSR SR120 DELETE ZERO ITEM 02670C EXITFCHAIN LINK TO NEXT PROG 02680C RLABL PROG 02690C********************************************************************* 02700C*R SR1 BEGSR 02710C* EDIT TRAN CODE. 02720C*R EXSR SR203 CLASSIFY TRAN. 02730C*RN60N61N62 Z-ADD300 M 96 FLAG ERROR. 02740C*R ENDSR 02750C******************************************************************** ÐÐ02760C*R SR2 BEGSR 02770C* EDIT QUOTE #. 02780C*R CRQOTE COMP BLK5 54 02790C*RN54 Z-ADD46 M 96 FLAG ERROR. 02800C*R ENDSR 02810C******************************************************************* 02820C*R SR3 BEGSR 02830C* EDIT QUOTE ITEM. 02840C*R EXSR SR1 EDIT TRAN CODE. 02850C*R 96 Z-ADD1 F 02860C*R 96 GOTO END3 ERROR. 02870C*R EXSR SR106 GET MASTER. 02880C*R END3 ENDSR 02890C******************************************************************** 02900CSR SR4 BEGSR 02910C* EDIT CUST NAME. 02920CSR CRITEM COMP 0 54 02930CSRN54 GOTO END4 02940CSR CRNAME COMP BLK20 54 02950CSRN54 Z-ADD48 M 96 FLAG ERROR. 02960CSR END4 ENDSR 02970C******************************************************************** 02980CSR SR8 BEGSR 02990C* EDIT SALESMAN. 03000CSR CRITEM COMP 0 55 ÐÐ03010CSR 55 GOTO END8 03020CSR CRSLSM COMP ' ' 54 03030CSRN54 Z-ADD613 M 96 FLAG ERROR 03040CSRN54 GOTO END8 03050CSR CRSLSM LOKUPTABSLM TABSLN 54 03060CSRN54 Z-ADD65 M 96 FLAG ERROR. 03070CSR 54 MOVE TABSLN SLMNAM 20 03080CSRN54 MOVE BLK20 SLMNAM 03090CSR END8 ENDSR 03100C******************************************************************** 03110CSR SR9 BEGSR 03120C* EDIT DATE RECD. 03130CSR CRD,1 COMP 0 54 03140CSRN54 Z-ADDTODAY CRD,1 DEFAULT. 03150CSR ENDSR 03160C********************************************************************* 03170CSR SR72 BEGSR 03180C* PUT DATA TO TERMINAL 03190CSR 2 ADD F W3N 30 03200CSR F COMP 9 54 54 03210CSR 54 2 ADD W3N W3N 03220CSR F COMP 15 54 54 03230CSR 54 1 ADD W3N W3N 03240CSR MOVE W3N LINE 3 03250CSR SETON 72 ÐÐ03260CSR EXCPT PUT DATA 03270CSR SETOF 72 03280CSR ENDSR 03290C*********************************************************************** 03300CSR SR73 BEGSR 03310C* PUT ERROR MESSAGE TO TERMINAL 03320CSR SETON 73 03330CSR EXCPT PUT MSG 03340CSR SETOF 73 03350CSR Z-ADDM LSTERR 50 03360CSR ENDSR 03370C******************************************************************* 03380CSR SR75 BEGSR 03390C* READ FROM TERMINAL 03400CSR SETOF 779096 03410CSR SETOF 939291 03420CSR SETOF 8988 03430CSR SETOF 878685 03440CSR MOVE BIT,11 A6,2 BUF LENGTH 03450CSR MOVEAA6 W6A 6 03460CSR MOVE BLK20 W20A 20 BUFFER 03470CSR EXITFQWREED READ TERM 03480CSR RLABL W20A 03490CSR RLABL W6A 03500CSR MOVEAW20A A20,1 ÐÐ03510CSR MOVE BLK20 W20A 03520CSR Z-ADD1 W 30 03530CSR '\' LOKUPA20,W 90 FLAG ESC 03540CSRN90 GOTO T75B NOT ESC 03550CSR 1 ADD W W 03560CSR W COMP 20 54 03570CSR 54 GOTO T75A BAD ESC 03580CSR A20,W COMP 'G' 98 GOODBY 03590CSR A20,W COMP 'E' 94 MENU 03600CSR A20,W COMP 'N' 93 NEW ITEM 03610CSR A20,W COMP 'J' 92 JUMP 03620CSR A20,W COMP 'F' 91 SKIP FRWRD 03630CSR A20,W COMP 'B' 89 SKIP BKWRD 03640CSR A20,W COMP 'S' 88 SPACE FILL 03650CSR A20,W COMP 'H' 87 HOME 03660CSR A20,W COMP 'U' 86 UPDATE 03670CSR A20,W COMP 'R' 85 REPEAT 03680CSR 98 03690COR 94 03700COR 93 03710COR 92 03720COR 91 03730COR 89 03740COR 88 03750COR 87 ÐÐ03760COR 86 03770COR 85 GOTO END75 GOOD ESC 03780C*------------------------------------------------------------------ 03790CSR T75A TAG 03800C* FLAG BAD ESC INPUT 03810CSR Z-ADD318 M 96 FLAG ERROR 03820CSR GOTO END75 03830C*-------------------------------------------------------------------- 03840CSR T75B TAG 03850C* MOVE DATA 03860CSR Z-ADD1 W 03870CSR ' ' LOKUPA20,W 77 03880CSR 77 MOVEAA20,W W20A INPUT DATA 03890C*-------------------------------------------------------------------- 03900CSR END75 TAG 03910C* INIT PREV ERROR MSG. 03920CSR LSTERR COMP 0 54 03930CSR 54 MOVE BLK35 MGTEXT 03940CSR 54 EXSR SR73 BLANK MESSAGE 03950CSR Z-ADD0 LSTERR 50 03960CSR ENDSR 03970C********************************************************************** 03980CSR SR80 BEGSR 03990C* GET MASTER RECORD 04000CSR MOVELCRQOTE W8A 8 ÐÐ04010CSR MOVE CRITEM W8A 04020CSR SETOF 61 04030CSR W8A CHAINQMMAST 60 GET MASTER 04040CSRN60 QMSTAT COMP 'D' 61 FLAG DELETE 04050CSR ENDSR 04060C******************************************************************** 04070CSR SR89 BEGSR 04080C* GET MESSAGE MASTER 04090CSR M CHAINMGFILE 54 04100CSR 54 MOVE BLK35 MGTEXT 04110CSR 54 MOVELM MGTEXT 04120CSR 54 MOVE MES,1 MGTEXT 04130CSR ENDSR 04140C******************************************************************** 04150CSR SR97 BEGSR 04160C* UPDATE CRT512 . 04170CSR SETON 97 04180CSR EXCPT UPDATE CRT512 . 04190CSR SETOF 97 04200CSR ENDSR 04210C*********************************************************************** 04220CSR SR101 BEGSR 04230C* 1-TIME INITIALIZE 04240CSR MOVE BIT,1 NUL 04250CSR MOVE BIT,1 A6 ÐÐ04260CSR Z-ADD22 FLIMIT 30 TOTAL NUMB FIELDS 04270CSR MOVE ' ' BLK20 20 04280C* GET PORT # AND CRT512 04290CSR MOVE ' ' W8A 8 04300CSR Z-ADD0 W2N 20 04310CSR Z-ADD0 W1N 10 04320CSR MOVE ' ' W2A 2 04330CSR EXITFPGMINX GET PORT # 04340CSR RLABL W8A 04350CSR RLABL W2N 04360CSR RLABL W1N 04370CSR RLABL W2A 04380CSR MOVE W2A PORT 20 PORT NO. 04390CSR PORT COMP 0 54 04400CSRN54 Z-ADD25 PORT DEFAULT 04410CSR PORT CHAINCRT512 H9 04420C* DEFINE WORK FIELDS,ETC. 04430CSR MOVE ' ' BLK35 35 04440CSR MOVE ' ' BLK15 15 04450CSR MOVE ' ' BLK8 8 04460CSR MOVE ' ' BLK5 5 04470C* 04480CSR MOVELUDATE W4N 40 04490CSR MOVE UDATE W2N 20 04500CSR MOVE W4N TODAY 60 ÐÐ04510CSR MOVELW2N TODAY 04520C* 04530CSR ENDSR 04540C********************************************************************** 04550CSR SR102 BEGSR 04560C* VALIDATE FIELD NO. 04570CSR F COMP 3 54 04580CSRN54 Z-ADD4 F 04590CSR F COMP FLIMIT 55 04600CSR 55 Z-ADD4 F 04610CSR ENDSR 04620C******************************************************************** 04630CSR SR103 BEGSR 04640C* MOVE INPUT DATA 04650CSR EXSR SR201 IDENTIFY-F 04660CSR EXSR SR202 R. JUSTIFY 04670CSR F COMP 10 54 04680CSR 54 GOTO T103A 04690CSR 04 MOVELW20A CRNAME CUST NAME. 04700CSR 05 MOVELW20A CRRFQ RFQ #. 04710CSR 06 MOVELW20A CRRFQI RFQ ITEM. 04720CSR 07 MOVE W20A CRCONT CONTACT. 04730CSR 08 MOVELW20A CRSLSM SALESMAN. 04740CSR 09 MOVE W10A CRD,1 DATE RECD. 04750CSR 10 MOVE W10A CRD,2 DATE DUE. ÐÐ04760CSR GOTO T103B 04770C*---------------------------------------------------------------- 04780CSR T103A TAG 04790CSR 11 MOVE W10A CRD,3 DATE SENT. 04800CSR 12 MOVE W10A CRD,4 DATE EXPECTED. 04810CSR 13 MOVE W10A CRD,5 FOLLOW-UP. 04820CSR 14 MOVE W10A CRD,6 EXPIRE DATE. 04830CSR 15 MOVELW20A CRPCLS PROD CLASS. 04840CSR 16 MOVELW20A CRSYST SYSTEM CODE. 04850CSR 17 MOVE W10A CRAMT AMOUNT. 04860CSR 18 MOVE W10A CRDEL DAYS ARO. 04870CSR 19 MOVELW20A CRSCOD STATUS CODE. 04880CSR 20 MOVELW20A CRREM REMARKS. 04890CSR 21 MOVELW20A CRREAS REASON. 04900CSR 22 MOVE W10A CRPROB PROBABILITY. 04910CSR 15 CRPCLS LOKUPTABPRD TABPRN 54 04920CSR 15 54 MOVE TABPRN PRDNAM 20 04930CSR 15N54 MOVE BLK35 PRDNAM 04940CSR 16 CRSYST LOKUPTABSYS TABSYN 54 04950CSR 16 54 MOVE TABSYN SYSNAM 20 04960CSR 16N54 MOVE BLK35 SYSNAM 04970CSR 21 CRREAS LOKUPTABRES TABREN 54 04980CSR 21 54 MOVE TABREN RESNAM 20 04990CSR 21N54 MOVE BLK35 RESNAM 05000CSR 19 CRSCOD LOKUPTABSTC TABSTN 54 ÐÐ05010CSR 19 54 MOVE TABSTN STCNAM 10 05020CSR 19N54 MOVE BLK35 STCNAM 05030C*---------------------------------------------------------------- 05040CSR T103B TAG 05050CSR MOVE ' ' DUN,F EDIT FLAG. 05060CSR ENDSR 05070C******************************************************************** 05080CSR SR104 BEGSR 05090C* EDIT INPUT DATA 05100CSR SETOF 96 05110CSR 04 EXSR SR4 05120CSR 08 EXSR SR8 05130CSR 09 EXSR SR9 05140CSR 96 MOVE ' ' DUN,F EDIT FLAG 05150CSRN96 MOVE 'X' DUN,F 05160CSR ENDSR 05170C*********************************************************************** 05180CSR SR105 BEGSR 05190C* FINAL EDIT 05200CSR SETOF 96 05210CSR SETON 79 FINAL EDIT FLAG 05220CSR Z-ADD1 F 05230C*-------------------------------------------------------------------- 05240CSR T105A TAG 05250CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD ÐÐ05260CSRN54 GOTO END105 05270CSR EXSR SR201 IDENTIFY-F 05280CSR EXSR SR104 EDIT 05290CSRN96 GOTO T105A 05300C*-------------------------------------------------------------------- 05310CSR END105 TAG 05320CSR SETOF 79 05330CSR ENDSR 05340C******************************************************************** 05350CSR SR106 BEGSR 05360C* UPDATE DATA BASE. 05370CSR EXSR SR203 CLASSIFY TRAN 05380CSR 60 GOTO T106A ADD TRAN 05390CSR 61 GOTO T106D CHANGE TRAN 05400CSR 62 GOTO T106F DELETE TRAN 05410C* FLAG BAD TRAN CODE 05420CSR Z-ADD300 M 96 FLAG ERROR 05430CSR Z-ADD1 F FIELD # 05440CSR GOTO END106 05450C*------------------------------------------------------------------- 05460CSR T106A TAG 05470C* ADD TRANSACTION 05480CSR EXSR SR80 GET MASTER 05490CSR 60 GOTO END106 NOT ON FILE 05500CSR 61 GOTO END106 DELETED MASTER ÐÐ05510C* FLAG DUPLICATE ADD ERROR 05520CSR CRITEM COMP 0 54 05530CSR 54 GOTO END106 05540CSR Z-ADD301 M 96 FLAG ERROR 05550CSR Z-ADD1 F FIELD # 05560CSR GOTO END106 05570C*---------------------------------------------------------------------- 05580CSR T106D TAG 05590C* CHANGE TRANSACTION. 05600CSR EXSR SR80 GET MASTER 05610CSRN60N61 GOTO END106 GOT IT 05620C* FLAG NO MASTER ERROR 05630CSR CRITEM COMP 0 54 05640CSR 54 GOTO END106 05650CSR Z-ADD302 M 96 FLAG ERROR 05660CSR Z-ADD1 F FIELD # 05670CSR GOTO END106 05680C*----------------------------------------------------------------------- 05690CSR T106F TAG 05700C* DELETE TRANSACTION 05710CSR EXSR SR80 GET MASTER 05720CSRN60N61 GOTO END106 GOT IT 05730C* FLAG NO MASTER ERROR 05740CSR Z-ADD302 M 96 FLAG ERROR 05750CSR Z-ADD1 F FIELD # ÐÐ05760CSR GOTO END106 05770CSR END106 ENDSR 05780C******************************************************************** 05790CSR SR120 BEGSR 05800C* DELETE ZERO ITEM MAST. 05810CSR MOVELCRQOTE W8A 05820CSR MOVE '000' W8A 05830CSR W8A CHAINQMMAST 54 GET QMMAST. 05840CSR 54 GOTO END120 NO HIT. 05850CSR SETON 83 05860CSR EXCPT DELETE ZERO ITEM 05870CSR SETOF 83 05880CSR END120 ENDSR 05890C************************************************************************ 05900CSR SR201 BEGSR 05910C* IDENTIFY FIELD NO. 05920CSR SETOF 040506 05930CSR SETOF 070809 05940CSR SETOF 101112 05950CSR SETOF 131415 05960CSR SETOF 161718 05970CSR SETOF 192021 05980CSR SETOF 22 05990CSR F COMP 10 54 06000CSR 54 GOTO T201A ÐÐ06010CSR F COMP 4 04 06020CSR F COMP 5 05 06030CSR F COMP 6 06 06040CSR F COMP 7 07 06050CSR F COMP 8 08 06060CSR F COMP 9 09 06070CSR F COMP 10 10 06080CSR GOTO END201 06090C*------------------------------------------------------------------- 06100CSR T201A TAG 06110CSR F COMP 11 11 06120CSR F COMP 12 12 06130CSR F COMP 13 13 06140CSR F COMP 14 14 06150CSR F COMP 15 15 06160CSR F COMP 16 16 06170CSR F COMP 17 17 06180CSR F COMP 18 18 06190CSR F COMP 19 19 06200CSR F COMP 20 20 06210CSR F COMP 21 21 06220CSR F COMP 22 22 06230CSR END201 ENDSR 06240C********************************************************************** 06250CSR SR202 BEGSR ÐÐ06260C* RIGHT JUSTIFY 06270CSR F LOKUPNUM 54 06280CSRN54 GOTO END202 NOT NUMERIC FIELD 06290CSR Z-ADD15 W2N 20 06300CSR MOVELW20A W10A 10 06310CSR EXIT SUBRAJ R. JUSTIFY 06320CSR RLABL W2N 06330CSR RLABL W10A 06340CSR END202 ENDSR 06350C*********************************************************************** 06360CSR SR203 BEGSR 06370C* CLASSIFY TRAN CODE 06380CSR CRTRAN COMP 'A' 60 ADD 06390CSR CRTRAN COMP 'C' 61 CHANGE 06400CSR CRTRAN COMP 'D' 62 DELETE 06410CSR ENDSR 06420O******************************************************************** 06430OTERM132 E 72 06440O BIT,28 1 06450O 2 '8' 06460O LINE 5 06470O 8 '001' 06480O HED,F 44 06490O 04 CRNAME 66 06500O 05 CRRFQ 66 ÐÐ06510O* 06 CRRFQI 50 06520O 07 CRCONT 66 06530O 08 CRSLSM 49 06540O 08 SLMNAM B 72 06550O 09 CRD,1 55 ' - - ' 06560O 10 CRD,2 55 ' - - ' 06570O 11 CRD,3 55 ' - - ' 06580O 12 CRD,4 55 ' - - ' 06590O 13 CRD,5 55 ' - - ' 06600O 14 CRD,6 55 ' - - ' 06610O 15 CRPCLS 48 06620O 15 PRDNAM B 71 06630O 16 CRSYST 47 06640O 16 SYSNAM B 70 06650O 17 CRAMT 57 ' , , $0' 06660O 18 CRDEL Z 49 06670O 18 60 'DAYS ARO' 06680O 19 CRSCOD 47 06690O 19 STCNAM B 60 06700O 22 CRPROBZ 50 06710O 22 51 '%' 06720O 20 CRREM 86 06730O 21 CRREAS 47 06740O 21 RESNAM B 70 06750O 69 BIT,28 124 ÐÐ06760O 69 125 '8' 06770O 69 LINE 128 06780O 69 131 '039' 06790O 69 BIT,8 132 06800O*------------------------------------------------------------------- 06810O E 73 06820O BIT,28 1 06830O 8 '8030001' 06840O MGTEXT 43 06850O BIT,28 128 06860O 129 'K' 06870O 96 BIT,8 130 06880O 96 BIT,8 131 06890O 96 BIT,8 132 06900O******************************************************************** 06910OCRT512 E 97 06920O CRQOTE 84 06930O CRITEM 87 06940O CRNAME 107 06950O CRRFQ 127 06960O CRRFQI 131 06970O CRCONT 151 06980O CRSLSM 154 06990O CRD 178P 07000O CRPCLS 180 ÐÐ07010O CRSYST 181 07020O CRAMT 186P 07030O CRDEL 188P 07040O CRSCOD 189 07050O CRPROB 191P 07060O CRREAS 192 07070O CRREM 232 07080O CRTRAN 233 07090O CROCUS 253 07100O CROSLS 256 07110O CROFU 260P 07120O***************************************************************** 07130OQMMAST E 83 07140O 160 'D' ** TABPRD/TABPRN - PROD CLASS 00715011MINI SERIES 00716012SERIES 1500 00717021SERIES 1000 00718022SERIES 3000 00719023SERIES 5900 00720024SERIES 5300 00721041SERIES X 00722042SERIES 10 00723051SERIES 5100 00724052SERIES 1400 007250ÐÐ53SERIES 8100 007260541400/8100 CONTROLS 00727055SYSTEM 21 00728059OTHER SYSTEMS 00729060RF EQUIPMENT 00730070EQUA-DYNE EQUIPMENT 00731090MISC. EQUIPMENT 00732099SKY 515 007330** TABSYS/TABSYN - SYST CODE 007340SSYSTEM 007350NNON-SYSTEM 007360** TABSTC/TABSTN - STATUS CODE 007370EENTERED 007380NNO BID 007390PPENDING 007400LLOST 007410WWON 007420CCANCELLED 007430** TABRES/TABREN - REASON LOST 0074401PRICE 0074502DELIVERY 0074603SPECIFICATIONS 0074704OTHER 0074805NOT KNOWN 007490** NUL ARRAY 007500ÐÐ 007510** A6 ARRAY 007520 007530** A40 ARRAY 007540 007550** NUM ARRAY 007560003 007570009 007580010 007590011 007600012 007610013 007620014 007630017 007640018 007650022 007660** DUN ARRAY 007670 007680** INT ARRAY 007690 007700** MES ARRAY 007710---MESSAGE NOT ON FILE--- 007720** HED ARRAY 007730 (1) TRANSACTION CODE - - - - - - - 007740 (2) QUOTE NUMBER - - - - - - - - - 007750ÐÐ (3) QUOTE ITEM - - - - - - - - - - 007760 (4) CUSTOMER NAME- - - - - - - - - 007770 (5) CUSTOMER RFQ # - - - - - - - - 007780 (6) CUSTOMER RFQ ITEM- - - - - - - 007790 (7) CUSTOMER CONTACT - - - - - - - 007800 (8) SALESMAN - - - - - - - - - - - 007810 (9) RECEIVED - - - - - - - - - - - 007820(10) DUE- - - - - - - - - - - - - - 007830(11) SENT - - - - - - - - - - - - - 007840(12) AWARD EXPECTED - - - - - - - - 007850(13) FOLLOW-UP- - - - - - - - - - - 007860(14) EXPIRES- - - - - - - - - - - - 007870(15) PRODUCT CLASS- - - - - - - - - 007880(16) SYSTEM CODE- - - - - - - - - - 007890(17) AMOUNT - - - - - - - - - - - - 007900(18) DELIVERY PROMISE ARO - - - - - 007910(19) STATUS CODE- - - - - - - - - - 007920(20) REMARKS- - - - - - - - - - - - 007930(21) REASON LOST- - - - - - - - - - 007940(22) PROBABILITY OF AWARD - - - - - 007950/* 007960_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(zò ÝX043BM P„è999999120282(èÈÐ00010H Q043BM00020F* REPLACE COMPONENT, PHASE-1. (PHASE-2=Q044BM) (X043BM) 00030F* CHASE WHERE-USED, UPDATE BMMAST. 00040F* REVISED 2-23-83 10:05 AM. 00050F* MENU: MQBM01 00060FBITTAB IP F 33 DISK 00070FBMWU UD F 21L20AI 1 DISK 00080FBMMAST UC F 86R20AI 1 DISK A 00090FTERMFILEUC F 256R 8AI 1 DISK A 00100FPMMST2 IC F 674R12AI 1 DISK 00110FBMTRAN O F 80 DISK A 00120FTERM132 O F 132 5 00130FCRTFILE UC F 256R DISK 00140E******************************************************************** 00150E NUL 1 132 1 00160E A14 14 14 1 A 00170E AR 24 24 2 00180E LF 30 30 2 00190E LEV 1 20 20 A 00200E BIT 33 1 00210E TAR 12 20 A 00220I******************************************************************** 00230IBITTAB BT 00240I 1 33 BIT 00250I******************************************************************** ÐÐ00260ICRTFILE CR 00270I 68 73 CRRET 00280I 74 79 CRMENU 00290I******************************************************************** 00300IBMWU BW 00310I 1 20 BWKEY 00320I 1 100BWCPN 00330I 11 200BWAPN 00340I 21 21 BWSTAT 00350I******************************************************************** 00360ITERMFILETF 00370I* ASSY/COMPONENT PART #'S 12 X 20A 00380I 9 248 TAR 00390I******************************************************************** 00400IBMMAST BM 00410I 1 100BMAPN 00420I 11 200BMCPN 00430I 21 86 BMREC 00440I P 28 310BMQTY 00450I 36 37 BMISSU 00460I 86 86 BMSTAT 00470I******************************************************************** 00480IPMMST2 PM 00490I 31 59 PMDESC 00500I 70 71 PMECHG ÐÐ00510I 674 674 PMSTAT 00520C******************************************************************** 00530C* INITIALIZE 1-TIME. 00540C EXSR SR101 INIT 00550C Z-ADD0 TCOUNT 40 00560C*------------------------------------------------------------------- 00570C START TAG 00580C* REQUEST COMPONENT PART #. 00590C SETON 71 00600C EXCPT PROMPT 00610C SETOF 71 00620C EXSR SR75 READ 00630C 90 GOTO ESCAPE ESC 00640C N77 GOTO START NO INPUT 00650C Z-ADD14 W2N 20 00660C EXIT SUBRAJ R.J. 00670C RLABL W2N 00680C RLABL W14A 00690C MOVE W14A TPN 100 REPLACE THIS PART # 00700C*------------------------------------------------------------ 00710C TAG10 TAG 00720C* REQUEST REPLACE BY PART NO. 00730C SETON 72 00740C EXCPT PROMPT 00750C SETOF 72 ÐÐ00760C EXSR SR75 READ 00770C 92 GOTO START SKIP BACK 00780C 90 GOTO ESCAPE OTHER ESC 00790C N77 GOTO TAG10 NO INPUT MADE 00800C Z-ADD14 W2N 00810C EXIT SUBRAJ RJ 00820C RLABL W2N 00830C RLABL W14A 00840C MOVE W14A BYPN 100 REPLACE BY PART # 00850C MOVELBYPN W12A 12 00860C MOVE ' ' W12A 00870C W12A CHAINPMMST2 60 00880C N60 PMSTAT COMP 'D' 60 00890C 60 SETON 74 00900C 60 EXCPT FLAG ERROR 00910C 60 SETOF 74 00920C 60 GOTO TAG10 00930C MOVE ZERO10 W20A 00940C MOVELTPN W20A 20 00950C W20A SETLLBMWU 00960C MOVE BLK20 LASTBW 20 00970C SETOF 4057 00980C*------------------------------------------------------------------- 00990C TAG20 TAG 01000C* CHASE WHERE-USED. ÐÐ01010C SETOF 54 01020C READ BMWU 54 01030C 54 GOTO TAG30 END OF FILE 01040C BWKEY COMP LASTBW 54 01050C N54 GOTO TAG30 01060C MOVE BWKEY LASTBW 20 01070C BWCPN COMP TPN 54 01080C N54 GOTO TAG30 WRONG CPN 01090C BWSTAT COMP 'D' 54 01100C 54 GOTO TAG20 DELETED 01110C EXSR SR104 CHECK GUZINTA 01120C 57 GOTO TAG20 GUZINTA ITSELF 01130C SETON 81 01140C EXCPT DELETE WHERE-USED 01150C SETOF 81 01160C MOVELBWAPN KEYBM 20 01170C MOVE BWCPN KEYBM 01180C KEYBM CHAINBMMAST 54 01190C N54 BMSTAT COMP 'D' 54 01200C 54 GOTO TAG20 01210C Z-ADDBMQTY QTYBM 70 01220C EXSR SR103 GET BMTRAN OUTPUT 01230C SETON 82 01240C EXCPT DELETE BMMAST 01250C SETOF 82 ÐÐ01260C MOVE BYPN KEYBM 01270C MOVE BMREC W66A 66 01280C EXSR SR102 UPDATE TERMFILE 01290C KEYBM CHAINBMMAST 60 01300C N60 BMSTAT COMP 'D' 61 01310C N60N61 BMQTY ADD QTYBM TOTQTY 70 01320C SETON 83 01330C EXCPT ADD BMMAST 01340C SETOF 83 01350C SETON 40 01360C GOTO TAG20 01370C*----------------------------------------------------------------- 01380C TAG30 TAG 01390C* FLAG NO BILL MATERIAL FOUND 01400C 57 01410COR 40 GOTO START 01420C SETON 75 01430C EXCPT FLAG ERROR 01440C SETOF 75 01450C GOTO START 01460C*------------------------------------------------------------------- 01470C ESCAPE TAG 01480C 98 MOVE 'GOODBY' CRRET 01490C 94 MOVE CRMENU CRRET 01500C 91 ÐÐ01510COR 93 MOVE 'Q043BM' CRRET 01520C 98 01530COR 94 GOTO END 01540C GOTO START 01550C*------------------------------------------------------------------- 01560C END TAG 01570C Z COMP 0 85 01580C 85 EXCPT REWRITE TERMFILE 01590C SETOF 85 01600C 70 MOVEL'Q044BM' PROG 8 01610C N70 MOVELCRRET PROG 01620C PROG COMP BLK8 54 01630C N54 MOVELCRMENU PROG 8 01640C SETON 97 01650C EXCPT UPDATE CRTFILE 01660C SETOF 97 01670C EXITFCHAIN 01680C RLABL PROG 01690C*------------------------------------------------------------------- 01700C ENDJOB TAG 01710C******************************************************************** 01720CSR SR75 BEGSR 01730C* READ CRT. 01740CSR SETOF 907791 01750CSR SETOF 969293 ÐÐ01760CSR MOVE BIT,8 BUFLGT 2 01770CSR MOVE BLK14 W14A 14 01780CSR EXITFQBELL RING BELL 01790CSR EXITFQWREED READ 01800CSR RLABL W14A 01810CSR RLABL BUFLGT 01820CSR MOVEAW14A A14 01830CSR MOVE BLK14 W14A 01840CSR Z-ADD1 W 30 01850CSR '\' LOKUPA14,W 90 01860CSRN90 GOTO T75B 01870CSR 1 ADD W W 01880CSR W COMP 14 54 01890CSR 54 GOTO T75A 01900CSR A14,W COMP 'G' 98 01910CSR A14,W COMP 'E' 94 01920CSR A14,W COMP 'N' 91 01930CSR A14,W COMP 'B' 92 01940CSRN91 A14,W COMP 'D' 91 01950CSR A14,W COMP 'U' 93 01960CSR 91 01970COR 92 01980COR 93 01990COR 94 02000COR 98 GOTO END75 ÐÐ02010C*------------------------------------------------------------------- 02020CSR T75A TAG 02030CSR SETON 73 02040CSR EXCPT BAD ESC MSG 02050CSR SETOF 73 02060CSR GOTO SR75 02070C*------------------------------------------------------------------- 02080CSR T75B TAG 02090CSR Z-ADD1 W 02100CSR ' ' LOKUPA14,W 77 02110CSR 77 MOVEAA14,W W14A 02120CSR END75 ENDSR 02130C******************************************************************** 02140CSR SR101 BEGSR 02150C* 1-TIME INIT. 02160CSR MOVE BIT,1 NUL 02170CSR MOVELBIT,1 BUFLGT 2 02180CSR MOVELBIT,28 AR 02190CSR MOVE 'L' AR 02200CSR MOVELBIT,11 LF 02210CSR MOVE BIT,1 LF 02220CSR SETON 76 02230CSR EXCPT CLEAR PAGE 02240CSR SETOF 76 02250CSR MOVE ' ' W2A 2 ÐÐ02260CSR EXITFZGMINX GET PORT # 02270CSR RLABL W2A 02280CSR MOVE W2A PORT 20 02290CSR PORT COMP 0 54 02300CSRN54 Z-ADD25 PORT 02310CSR PORT CHAINCRTFILE H8 02320CSR H8 GOTO ENDJOB 02330CSR Z-ADD0 ZERO10 100 02340CSR MOVE ' ' BLK8 8 02350CSR MOVE ' ' BLK20 20 02360CSR MOVE ' ' BLK14 14 02370CSR ENDSR 02380C******************************************************************** 02390CSR SR102 BEGSR 02400C* UPDATE TERMFILE. 02410CSR 41 GOTO T102E FILE IS ACTIVE 02420CSR 1 ADD TCOUNT TCOUNT 40 02430CSR MOVELPORT KEY 8 02440CSR MOVEL'RC' W6A 6 02450CSR MOVE TCOUNT W6A 02460CSR MOVE W6A KEY 02470C*------------------------------------------------------------------- 02480CSR T102A TAG 02490CSR KEY CHAINTERMFILE 54 02500CSR 54 GOTO T102B ÐÐ02510CSR BLK20 LOKUPTAR 54 02520CSR 54 GOTO SR102 02530CSR GOTO T102C 02540C*------------------------------------------------------------------- 02550CSR T102B TAG 02560CSR MOVE BLK20 TAR 02570CSR SETON 84 02580CSR EXCPT ADD TERMFILE 02590CSR SETOF 84 02600CSR GOTO T102A 02610C*------------------------------------------------------------------- 02620CSR T102C TAG 02630CSR Z-ADD0 Z 30 02640CSR SETON 41 02650C*------------------------------------------------------------------- 02660CSR T102E TAG 02670CSR 1 ADD Z Z 02680CSR Z COMP 12 54 02690CSR 54 SETON 85 02700CSR 54 EXCPT REWRITE TERMFILE 02710CSR 54 SETOF 8541 02720CSR 54 GOTO SR102 02730CSR MOVE BWKEY TAR,Z 02740CSR MOVELBYPN TAR,Z 02750CSR SETON 70 ÐÐ02760CSR ENDSR 02770C************************************************************* 02780CSR SR103 BEGSR 02790C* SAVE DATA FOR BMTRAN OUTPUT 02800CSR TIME TIME 60 02810CSR BMAPN COMP LSTASY 54 02820CSR 54 GOTO T103C SAVE ASSY AS BEFORE 02830CSR MOVELBMAPN W12A 12 02840CSR MOVE ' ' W12A 02850CSR W12A CHAINPMMST2 H5 02860CSR H5 GOTO ENDJOB 02870CSR Z-ADDBMAPN LSTASY 100 02880CSR MOVELPMECHG ASYCHG 2 02890CSR MOVELPMDESC DESC14 14 02900C*------------------------------------------------------------------- 02910CSR T103C TAG 02920C* GET ASSY PART MAST DATA 02930CSR MOVELBMCPN W12A 02940CSR MOVE ' ' W12A 02950CSR W12A CHAINPMMST2 H6 02960CSR H6 GOTO ENDJOB 02970CSR Z-ADDBMCPN OLDCPN 100 02980CSR Z-ADDBMQTY OLDQTY 40 02990CSR MOVELPMDESC OLDDES 7 03000CSR MOVELBYPN W12A ÐÐ03010CSR MOVE ' ' W12A 03020CSR W12A CHAINPMMST2 H7 03030CSR H7 GOTO ENDJOB 03040CSR MOVELPMDESC DESC7 7 03050CSR ENDSR 03060C******************************************************************* 03070CSR SR104 BEGSR 03080C* CHECK GUZINTA. 03090CSR SETOF 57 03100CSR BWAPN COMP BYPN 57 03110CSR MOVE BWKEY SAVBW 20 SAVE CUR WU KEY 03120CSR 57 GOTO T104D GUZINTA ITSELF 03130CSR Z-ADDBWAPN APN 100 ASSY PART NO. 03140CSR Z-ADD3 L 30 03150CSR MOVE BLK20 LEV 03160CSR MOVELBWAPN LEV,2 03170C*---------------------------------------------------------------- 03180CSR T104A TAG 03190C* GET SAVED LOWER LEVELS, IF ANY 03200CSR L SUB 1 L 54 03210CSRN54 GOTO T104Z BOT LEVEL 03220CSR LEV,L COMP BLK20 54 03230CSRN54 GOTO T104A EMPTY BUCKET 03240CSR MOVE LEV,L W20A 20 03250CSR MOVELLEV,L CURCPN 100 ÐÐ03260CSR MOVE BLK20 LEV,L 03270C*----------------------------------------------------------------- 03280CSR T104B TAG 03290CSR W20A SETLLBMWU 03300C*------------------------------------------------------------------ 03310CSR T104C TAG 03320CSR SETOF 54 03330CSR READ BMWU 54 GET WHERE-USED 03340CSR 54 GOTO T104A END OF FILE 03350CSR BWCPN COMP CURCPN 54 03360CSRN54 GOTO T104A WRONG COMPONENT 03370CSR BWSTAT COMP 'D' 54 03380CSR 54 GOTO T104C DELETED WHERE-USED 03390CSR BWAPN COMP BYPN 54 03400CSRN54 GOTO T104E DOESNT GOINTA ITSELF 03410C*------------------------------------------------------------------- 03420CSR T104D TAG 03430C* FLAG THIS RECORD NOT REPLACED 03440CSR MOVE SAVBW W10N 03450CSR SETON 5778 03460CSR EXCPT FLAG ERROR 03470CSR SETOF 78 03480CSR GOTO T104Z 03490C*--------------------------------------------------------------- 03500CSR T104E TAG ÐÐ03510C* SET-UP TO CHECK NEXT HIGHER LEVEL (SAVE THIS LEVEL) 03520CSR MOVELBWCPN LEV,L 03530CSR 1 ADD BWAPN W10N 100 03540CSR MOVE W10N LEV,L 03550CSR MOVE BWAPN CURCPN 03560CSR MOVELBWAPN W20A 03570CSR MOVE ZERO10 W20A 03580CSR 1 ADD L L 03590CSR GOTO T104B 03600C*---------------------------------------------------------- 03610CSR T104Z TAG 03620CSR MOVE SAVBW W20A 03630CSR W20A SETLLBMWU 03640CSR READ BMWU 54 03650CSR ENDSR 03660O*************************************************************** 03670OTERM132 E 71 03680O 1 ' ' 03690O E 71 03700O NUL 132 03710O 24 'ENTER PART# TO BE REPLAC' 03720O 28 'ED ' 03730O E 72 03740O NUL 132 03750O 24 'ENTER REPLACE-BY PART# ' ÐÐ03760O 28 ' ' 03770O E 73 03780O NUL 132 03790O 24 'INVALID ESC CODE ' 03800O BIT,28 25 03810O 26 'K' 03820O BIT,14 40 03830O AR 115 03840O*----------------------------------------------------------------- 03850O E 74 03860O 24 'PART MASTER NOT ON FILE-' 03870O 48 ' REJECTED ' 03880O*-------------------------------------------------------------- 03890O E 83N40 03900O 1 ' ' 03910O E 83N40 03920O 24 'ASSEMBLY REPLACED IN ' 03930O E 83 03940O BWAPN 18 ' - - ' 03950O*--------------------------------------------------------------- 03960O E 75 03970O 24 'NO COMPONENT RECORDS FOU' 03980O 48 'ND.... ' 03990O*----------------------------------------------------------------- 04000O E 76 ÐÐ04010O* CLEAR PAGE 04020O NUL 132 04030O BIT,28 1 04040O 8 '8120001' 04050O LF 88 04060O BIT,28 120 04070O 128 '8091001' 04080O*-------------------------------------------------------------- 04090O E 78 04100O 24 'GUZINTA ITSELF... NOT RE' 04110O 48 'PLACED IN THIS ASSEMBLY ' 04120O W10N 62 ' - - ' 04130O*------------------------------------------------------------------- 04140O E 97 U1 04150O PROG 8 04160O********************************************************************* 04170OBMWU E 81 04180O 21 'D' 04190O********************************************************************* 04200OBMTRAN EADD 82 04210O BMAPN 10 04220O ASYCHG 12 04230O DESC14 26 04240O OLDQTY 30 04250O OLDCPN 40 ÐÐ04260O OLDDES 47 04270O UDATE 70 04280O TIME 76 04290O 79 'DEL' 04300O 80 '1' 04310O*------------------------------------------------------------------ 04320O EADD 83 60 04330O OR 83 61 04340O BMAPN 10 04350O ASYCHG 12 04360O DESC14 26 04370O OLDQTY 30 04380O BYPN 40 04390O DESC7 47 04400O UDATE 70 04410O TIME 76 04420O 79 'ADD' 04430O 80 '1' 04440O********************************************************************* 04450OBMMAST E 82 04460O* DELETE REPLACED COMPONENT 04470O BMQTY 31P 04480O 86 'D' 04490O*------------------------------------------------------------------- 04500O EADD 83 60 ÐÐ04510O* ADD REPLACED BY COMPONENT 04520O BWAPN 10 04530O BYPN 20 04540O W66A 86 04550O QTYBM 31P 04560O 86 'A' 04570O*----------------------------------------------------------------- 04580O E 83N60 04590O W66A 86 04600O N61 TOTQTY 31P 04610O 61 QTYBM 31P 04620O 86 'A' 04630O******************************************************************** 04640OTERMFILEEADD 84 04650O KEY 8 04660O TAR 248 04670O*------------------------------------------------------------------- 04680O E 85 04690O TAR 248 04700O******************************************************************** 04710OCRTFILE E 97 04720O CRRET 73 04730O******************************************************************** ** NUL ARRAY 04740 04750ÐÐ** A14 ARRAY 04760 04770** AR ARRAY 04780 04790** LF ARRAY 04800 04810** LEV ARRAY 04820 04830/* 04840_‚ ÐÐ ÐÐ _‚_‚ ÐÈ(RRw RcX018WM P999999120282(èÈÐ00010H Q018WM00020F* DISPLAY SCHEDULE RECORDS, DUE DATE SEQ. (X018WM)) 00030F* REVISED 8/10/82 9:40 AM. 00040F* MENU: MQNS01 00050FBITPAR IP F 90 DISK 00060FSFMAST IC F 128R29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FALTKEY ID F 32L29AI 1 DISK 00100FCRTFILE UC F 256R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E NUL 1 132 1 00140E A29 29 29 1 00150E A8 8 8 1 A 00160E A9 9 9 1 00170E A20 20 20 1 A 00180E MES 1 1 30 00190E LNK 1 7 6 A 00200E BIT 33 1 00210E PAR 25 1 00220E TST 25 1 00230E CALL 7 6 00240E**** PM$ 7 9 3 MFG $ FILE 00250E PLT 8 3 0 LEAD TIMES ÐÐ00260I******************************************************************** 00270IBITPAR BT 00280I 1 33 BIT 00290I 34 58 PAR 00300I 59 83 TST 00310I******************************************************************** 00320ICRTFILE CR 00330I 1 50CREMPL 00340I 6 13 CRUSER 00350I 14 180CRDEPT 00360I 19 26 CRJOB 00370I 27 27 CRSHUT 00380I 28 330CRTIME 00390I 34 370CRDATE 00400I 38 79 CALL 00410I******************************************************************** 00420ISFMAST SF 00430I* SCHEDULE MASTER. 00440I* COMMON FIELDS. 00450I* KEY AREA. 00460I 1 29 SFKEY 00470I* PART NO. 10N 00480I 1 100SFPN 00490I* DATE DUE 6N (YMD) 00500I 11 160SFDUE ÐÐ00510I* RECORD CODE 2N 00520I* 10 = RECEIVED PO 00530I* 20 = REL WO 00540I* 30 = PURCHASE ORDER 00550I* 40 = PLAN WO 00560I* 50 = PURCHASE REQ 00570I* 60 = SALES ORDER-BACKLOG 00580I* 70 = REL REQUIREMENT 00590I* 80 = PLAN REQUIREMENT 00600I* 90 = RUN RELEASE 00610I 17 180SFREC 00620I* ORDER NO. 00630I 19 29 SFORD 00640I* PREFIX 1A 00650I 19 19 SFPRFX 00660I* PRIME 6A 00670I 19 24 SFPRIM 00680I* ITEM 3N 00690I 25 270SFITEM 00700I* RECEIVING LOG # 2N 00710I 28 290SFRLOG 00720I* QUANTITY 7P 00730I P 30 330SFQTY 00740I* QTY COMPLETE 7P 00750I P 34 370SFQTYC ÐÐ00760I* DATE LAST TRAN 6N (YMD) 00770I 38 430SFDLT 00780I* CUST #/DEPT #/VEND # 5P 00790I P 44 460SFCUST 00800I* PLAN/REL REQMTS. 00810I* NEXT ASSY PART # 10N 00820I 47 560SFNAPN 00830I* QTY PER ASSY 7P 00840I P 57 600SFQPA 00850I* ISSUE CODE 2A 00860I 61 62 SFISSU 00870I* PULL # 3P 00880I P 63 640SFPULL 00890I* ASSY REVISION 2A 00900I 65 66 SFREV 00910I* ASSY WO QTY 7P 00920I P 67 700SFQTYA 00930I* BACKORDER FLAG 1A 00940I 105 105 SFBOF 00950I* SALES ORDERS 00960I* CUST P.O. 20A 00970I 71 90 SFCPO 00980I* UNIT PRICE 9.3P 00990I P 91 953SFPRIC 01000I* BACKORDER FLAG -- SEE ABOVE ÐÐ01010I* PURCH ORDERS 01020I* VENDOR NAME 20A 01030I* SEE SFCPO UNDER SALES ORDERS. 01040I* UNIT PRICE 9.3P 01050I* SEE SFPRIC UNDER SALES ORDERS. 01060I* WORK ORDERS 01070I* DEPT NAME 20A 01080I* SEE SFCPO UNDER SALES ORDERS. 01090I* OPER SEQ # 3P 01100I P 96 970SFSEQ 01110I* START DATE 6N 01120I 98 1030SFSTRT 01130I* PULL # 3P 01140I* SEE PLAN/REL REQMTS. 01150I* REVISION 2A 01160I* SEE PLAN/REL REQMTS. 01170I* AVAIL BAL 7P 01180I P 124 1270SFAVQ 01190I* RECORD STATUS 1A 01200I 128 128 SFSTAT 01210I******************************************************************** 01220IPMMST2 PM 01230I 31 59 PMDESC 01240I 674 674 PMSTAT 01250I******************************************************************** ÐÐ01260IMGFILE MG 01270I 1 35 MGTEXT 01280I******************************************************************** 01290IALTKEY AK 21 1 CA 01300I OR 22 1 CB 01310I OR 25 1 CE 01320I OR 26 1 CF 01330I* ALTERNATE KEY FILE FOR SFMAST. 01340I* COL-1 DEFINITIONS 01350I* A = ORDER ALT KEY FILE 01360I* B = DUE DATE ALT KEY FILE 01370I* E = START DATE ALT KEY FILE 01380I* COL-2 DEFINITIONS. 01390I* 1 = RECD PO 01400I* 3 = PO 01410I* 5 = PUR REQ 01420I* 6 = SALES ORDER 01430I* 7 = REL REQMT 01440I* 8 = PLAN REQMT 01450I* 9 = FORECAST 01460I* W = WORK ORDER (PLAN OR RELEASED) 01470I* COMMON FIELDS. 01480I* RECORD CODE (SEE ABOVE) 2A 01490I 1 2 AKREC 01500I* RECORD STATUS 1A ÐÐ01510I 32 32 AKSTAT 01520I* NON-COMMON FIELDS. 01530I*-------------------------------------------------------------------- 01540I* ORDER ALTKEY - RQMTS ONLY - 01550I* KEY AREA 01560I* ORDER # 11A 01570I 3 13 AKORD 21 01580I* PART # 10N 01590I 14 230AKPN 21 01600I* DUE DATE 6N 01610I 24 290AKDUE 21 01620I*------------------------------------------------------------------- 01630I* DUE DATE ALT-KEY - 01640I* KEY AREA. 01650I* DUE DATE 6N 01660I 3 80AKDUE 22 01670I* ORDER NO. 11A 01680I 9 19 AKORD 22 01690I* PREFIX 1A 01700I 9 9 AKPRFX 22 01710I* PRIME 5N 01720I 10 140AKPRIM 22 01730I* ITEM 3N 01740I 15 170AKITEM 22 01750I* RECEIVING LOG # 2N ÐÐ01760I 18 190AKRLOG 22 01770I* PART NO. 10N 01780I 20 290AKPN 22 01790I*------------------------------------------------------------------- 01800I* CUSTOMER ALT-KEY - 01810I* KEY AREA. 01820I* CUSTOMER 5N 01830I 3 70AKCUST 23 01840I* ORDER NO. 11A 01850I 8 18 AKORD 23 01860I* PREFIX 1A 01870I 8 8 AKPRFX 23 01880I* PRIME 5N 01890I 9 130AKPRIM 23 01900I* ITEM 3N 01910I 14 160AKITEM 23 01920I* RECEIVING LOG NO 2N 01930I 17 180AKRLOG 23 01940I*------------------------------------------------------------------- 01950I* START DATE ALT-KEY - 01960I* KEY AREA. 01970I* START DATE 6N 01980I 3 80AKSTRD 25 01990I* PART NO. 10N 02000I 9 180AKPN 25 ÐÐ02010I* ORDER NO. 11A 02020I 19 29 AKORD 25 02030I* PREFIX 1A 02040I 19 19 AKPRFX 25 02050I* PRIME 5N 02060I 20 240AKPRIM 25 02070I* ITEM 3N 02080I 25 270AKITEM 25 02090I* RECEIVING LOG NO 2N 02100I 28 290AKRLOG 25 02110C******************************************************************** 02120C* INITIALIZE 1-TIME. 02130C EXSR SR101 02140C MOVE ' ' BLK6 6 02150C EXSR SR70 NEW PAGE 02160C*------------------------------------------------------------------- 02170C START TAG 02180C* REQUEST STARTING DUE DATE. 02190C MOVE ' ' RECORD 2 02200C Z-ADD0 DUEDAT 60 02210C EXSR SR102 REQUEST DUE DATE 02220C 92 GOTO START 02230C*------------------------------------------------------------------- 02240C TAG10 TAG 02250C* REQUEST RECORD TYPE. ÐÐ02260C EXSR SR103 REQUEST RECORD TYPE 02270C 92 GOTO START 02280C MOVE ' ' A29 02290C MOVEL'B' MATCH 2 02300C MOVELRECORD W1A 1 02310C MOVE W1A MATCH 02320C MOVEAMATCH A29,1 02330C MOVE DUEDAT W6A 6 02340C MOVEAW6A A29,3 02350C MOVEAA29 W29A 29 02360C W29A SETLLALTKEY 02370C EXSR SR71 PUT HEADING 02380C*------------------------------------------------------------------- 02390C TAG20 TAG 02400C* GET NEXT DUE DATE ALTKEY. 02410C SETOF 54 02420C READ ALTKEY 54 02430C 54 GOTO START 02440C AKREC COMP MATCH 54 02450C N54 GOTO START 02460C AKSTAT COMP 'D' 54 02470C 54 GOTO TAG20 02480C AKDUE COMP DUEDAT 54 54 02490C N54 GOTO START 02500C MOVE ' ' A29 ÐÐ02510C MOVE AKPN W10A 10 02520C MOVEAW10A A29,1 02530C MOVE AKDUE W6A 02540C MOVEAW6A A29,11 02550C MOVE AKREC A29,17 02560C MOVE '0' A29,18 02570C MOVEAAKORD A29,19 02580C MOVEAA29 W29A 02590C W29A CHAINSFMAST 54 02600C N54 SFSTAT COMP 'D' 54 02610C N54 SFSTAT COMP 'R' 54 02620C 54 GOTO TAG20 02630C SFQTY SUB SFQTYC QTYBAL 70 54 02640C N54 GOTO TAG20 02650C EXSR SR72 PUT DATA 02660C N50 COUNT COMP 28 54 54 02670C 50 COUNT COMP 23 54 54 02680C N54 GOTO TAG20 02690C EXSR SR74 END PAGE MSG 02700C EXSR SR69 LF 02710C EXSR SR69 LF 02720C EXSR SR75 READ 02730C 92 GOTO TAG10 02740C EXSR SR71 PUT HEADING 02750C GOTO TAG20 ÐÐ02760C*------------------------------------------------------------------- 02770C NEWITM TAG 02780C MOVEL'Q018WM' PROG 8 02790C GOTO END 02800C*------------------------------------------------------------------- 02810C MENU TAG 02820C EXSR SR96 GET CRTFILE 02830C Z-ADD1 W 02840C BLK6 LOKUPLNK,W 54 02850C 54 MOVELLNK,W PROG 02860C 54 MOVE BLK6 LNK,W 02870C N54 MOVEL'CONTU' PROG 02880C EXSR SR97 UPD CRTFILE 02890C EXSR SR98 >>>>>>>>>> 02900C*------------------------------------------------------------------- 02910C GOODBY TAG 02920C MOVEL'GOODBY' PROG 02930C GOTO END 02940C*------------------------------------------------------------------- 02950C END TAG 02960C EXSR SR96 GET CRTFILE 02970C EXSR SR97 UPD CRTFILE 02980C EXSR SR98 >>>>>>>>>> 02990C*--------------------------------------------------------------- 03000C ENDJOB TAG ÐÐ03010C MOVEL'ENDJOB' PROG 03020C EXSR SR98 >>>>>>>>>> 03030C******************************************************************** 03040CSR SR68 BEGSR 03050C* POSITION CURSOR. 03060CSR 50 EXITFZPUTXY 03070CSR RLABL RPGLIN 03080CSR RLABL RPGCOL 03090CSRN50 EXITFZMOVXY 03100CSR RLABL RPGLIN 03110CSR RLABL RPGCOL 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR69 BEGSR 03150C* LINE FEED/ CR. 03160CSR EXITFZLFCR 03170CSR ENDSR 03180C******************************************************************** 03190CSR SR70 BEGSR 03200C* CLEAR SCREEN. 03210CSR 50 EXITFZESCH CLEAR SCREEN 03220CSRN50 EXITFZCPAGE CLEAR SCREEN 03230CSRN50 MOVEL'091' RPGLIN 03240CSRN50 MOVEL'001' RPGCOL 03250CSRN50 EXSR SR68 MOVE CURSOR ÐÐ03260CSR ENDSR 03270C******************************************************************** 03280CSR SR71 BEGSR 03290C* PUT HEADING. 03300CSR EXSR SR70 03310CSR SETON 71 03320CSR EXCPT 03330CSR SETOF 71 03340CSR Z-ADD6 COUNT 30 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR72 BEGSR 03380C* PUT DATA. 03390CSR MOVELSFPN W12A 12 03400CSR EXSR SR80 GET PMMST2 03410CSR 60 GOTO END72 03420CSR EXSR SR105 CLASSIFY SFMAST 03430CSR 1 ADD COUNT COUNT 03440CSR SETOF 70 03450CSR 01 03460COR 06 SETON 70 03470CSR SETON 72 03480CSR EXCPT 03490CSR SETOF 72 03500CSR END72 ENDSR ÐÐ03510C******************************************************************** 03520CSR SR73 BEGSR 03530C* PUT MSG. 03540CSR SETON 73 03550CSR EXCPT 03560CSR SETOF 73 03570CSR 1 ADD COUNT COUNT 03580CSR ENDSR 03590C******************************************************************** 03600CSR SR74 BEGSR 03610C* END PAGE MSG. 03620CSR SETON 74 03630CSR EXCPT END PAGE MSG 03640CSR SETOF 74 03650CSR ENDSR 03660C******************************************************************** 03670CSR SR75 BEGSR 03680C* READ TERMINAL. 03690CSR 50 MOVEL'023' RPGLIN 4 03700CSRN50 MOVEL'119' RPGLIN 03710CSR MOVEL'038' RPGCOL 4 03720CSR EXSR SR120 SETOFFS 03730CSR MOVE BLK20 W20A 20 INPUT BUF 03740CSR EXITFZR20 READ CRT 03750CSR RLABL W20A ÐÐ03760CSR MOVEAW20A A20 03770CSR MOVE BLK20 W20A 03780CSR Z-ADD1 W 30 03790CSR '\' LOKUPA20,W 90 03800CSRN90 GOTO T75C 03810CSR 1 ADD W W 03820CSR W COMP 20 54 03830CSR 54 GOTO T75B 03840CSR A20,W COMP 'E' 94 MENU 03850CSR A20,W COMP 'G' 98 GOODBY 03860CSR A20,W COMP 'N' 92 NEW ITEM 03870CSR A20,W COMP 'S' 95 SPACE FILL 03880CSR 95 SETOF 90 03890CSR 95 SETON 77 03900CSR 94 GOTO MENU 03910CSR 98 GOTO GOODBY 03920CSR 92 GOTO NEWITM 03930CSR 95 GOTO END75 03940C*------------------------------------------------------------------- 03950CSR T75B TAG 03960CSR Z-ADD318 M 50 03970CSR EXSR SR73 PUT MSG 03980CSR GOTO SR75 03990C*------------------------------------------------------------------- 04000CSR T75C TAG ÐÐ04010CSR Z-ADD1 W 30 04020CSR ' ' LOKUPA20,W 77 04030CSR 77 MOVEAA20,W W20A 04040CSR END75 ENDSR 04050C******************************************************************** 04060CSR SR76 BEGSR 04070C* PROMPT/READ. 04080CSR EXSR SR89 GET MSG 04090CSR EXSR SR69 LF/CR 04100CSR EXSR SR73 PUT MSG 04110CSR EXSR SR75 READ 04120CSR ENDSR 04130C******************************************************************** 04140CSR SR77 BEGSR 04150C* END PAGE MSG. 04160CSR Z-ADD34 M 04170CSR EXSR SR89 GET MSG 04180CSR EXSR SR73 PUT MSG 04190CSR ENDSR 04200C******************************************************************** 04210CSR SR80 BEGSR 04220C* GET PART MAST. 04230CSR MOVE ' ' W12A 04240CSR W12A CHAINPMMST2 60 04250CSRN60 PMSTAT COMP 'D' 60 ÐÐ04260CSR ENDSR 04270C******************************************************************** 04280CSR SR89 BEGSR 04290C* GET MESSAGE MASTER. 04300CSR M CHAINMGFILE 54 04310CSR 54 MOVE BLK35 MGTEXT 04320CSR 54 MOVELM MGTEXT 04330CSR 54 MOVE MES,1 MGTEXT 04340CSR ENDSR 04350C******************************************************************** 04360CSR SR96 BEGSR 04370CSR # CHAINCRTFILE H9 GET CRTFILE 04380CSR H9 GOTO ENDJOB 04390CSR ENDSR 04400C******************************************************************** 04410CSR SR97 BEGSR 04420C* UPDATE CRTFILE. EXIT PROGRAM. 04430CSR TIME CRTIME 04440CSR MOVELUDATE CRDATE 04450CSR SETON 97 04460CSR EXCPT UPDATE CRTFILE 04470CSR SETOF 97 04480CSR ENDSR 04490C******************************************************************** 04500CSR SR98 BEGSR ÐÐ04510CSR EXSR SR70 CLEAR SCREEN 04520CSR EXITFCHAIN >>>>>>>>>> 04530CSR RLABL PROG 04540CSR ENDSR 04550C******************************************************************** 04560CSR SR101 BEGSR 04570C* 1-TIME INIT. 04580CSR MOVE BIT,1 NUL 04590CSR MOVE ' ' BLK8 8 04600CSR MOVE ' ' BLK20 20 04610CSR MOVE ' ' BLK35 35 04620C* GET PORT # AND CRTFILE. 04630CSR MOVE ' ' BLK6 6 04640CSR MOVE ' ' W2A 2 04650CSR EXITFZGMINX GET PORT # 04660CSR RLABL W2A 04670CSR MOVE W2A # 20 # NO. 04680CSR # COMP 0 54 04690CSRN54 Z-ADD25 # DEFAULT 04700CSR EXSR SR96 GET CRTFILE 04710CSR MOVE CALL LNK 04711CSR MOVE 'Q018WM 'PROG 04720CSR PAR,# COMP '1' 50 04730CSR TST,# COMP 'S' 54 04740CSR 54 MOVE 'SHUTDOWN'PROG 8 ÐÐ04750CSR EXSR SR97 UPD CRTFILE 04760CSR 54 EXSR SR98 >>>>>>>>>> 04761CSR MOVE ' 'PROG 04770CSR ENDSR 04780C******************************************************************** 04790CSR SR102 BEGSR 04800C* REQUEST DUE DATE. 04810CSR SETON 76 04820CSR EXCPT BLANK LINE 04830CSR SETOF 76 04840CSR Z-ADD486 M 50 04850CSR EXSR SR76 PROMPT/READ 04860CSR 90 04870CORN77 GOTO END102 04880CSR EXSR SR104 R.J. 04890CSR MOVE W8A DUEDAT 60 04900CSR MOVELDUEDAT W2N 20 04910CSR W2N COMP 12 54 04920CSR 54 GOTO END102 04930CSR MOVELDUEDAT W4N 40 04940CSR MOVE DUEDAT W2N 04950CSR MOVE W4N DUEDAT 04960CSR MOVELW2N DUEDAT 04970CSR END102 ENDSR 04980C******************************************************************** ÐÐ04990CSR SR103 BEGSR 05000C* REQUEST RECORD CODE. 05010CSR SETON 78 05020CSR EXCPT PUT MENU SELECTIONS 05030CSR SETOF 78 05040CSR Z-ADD533 M 05050CSR EXSR SR76 PROMPT/READ 05060CSR 90 05070CORN77 GOTO END103 05080CSR EXSR SR104 R.J. 05090CSR MOVE W8A W2N 20 05100CSR 10 MULT W2N W2N 05110CSR MOVE W2N RECORD 2 05120CSR END103 ENDSR 05130C******************************************************************** 05140CSR SR104 BEGSR 05150C* R.J. 05160CSR Z-ADD8 W2N 20 05170CSR MOVELW20A W8A 8 05180CSR EXIT SUBRAJ 05190CSR RLABL W2N 05200CSR RLABL W8A 05210CSR ENDSR 05220C******************************************************************** 05230CSR SR105 BEGSR ÐÐ05240C* CLASSIFY SFMAST. 05250CSR SETOF 1314 05260CSR SFREC COMP 10 01 RECD-PO 05270CSR SFREC COMP 20 02 REL-WO 05280CSR SFREC COMP 30 03 PO 05290CSR SFREC COMP 40 04 PLAN-WO 05300CSR SFREC COMP 50 05 PUR-REQ 05310CSR SFREC COMP 60 06 SALES-ORD 05320CSR SFREC COMP 70 07 REL-RQMT 05330CSR SFREC COMP 80 08 PLAN-RQMT 05340CSR SFREC COMP 90 09 FORECAST 05350CSR 07 05360COR 08 SETON 13 RQMT 05370CSR 02 05380COR 04 SETON 14 WO 05390CSR ENDSR 05400C******************************************************************** 05410CSR SR120 BEGSR 05420C* UTILITY SET-OFFS. 05430CSR SETOF 967790 05440CSR SETOF 91 05450CSR SETOF 949598 05460CSR ENDSR 05470O******************************************************************** 05480OTERM132 E 71 ÐÐ05490O BIT,28 1 05500O N50 8 '8091001' 05510O N50 BIT,1 9 05520O N50 BIT,1 10 05530O 50 10 '[001 ]001' 05540O 50 BIT,28 6 05550O UDATE Y 18 05560O 53 'S C H E D U L E' 05570O 69 'R E C O R D S' 05580O 75 'B Y' 05590O 83 'D U E' 05600O 93 'D A T E' 05610O*------------------------------------------------------------------- 05620O E 71 05630O 95 'VENDOR-NAME' 05640O 103 'QTY' 05650O*------------------------------------------------------------------- 05660O E 71 05670O 95 'CUSTOMER-PO' 05680O 103 'PER' 05690O 113 'VEND-NO.' 05700O 121 'OPEN' 05710O 132 'AVAIL' 05720O*------------------------------------------------------------------- 05730O E 71 ÐÐ05740O 8 'DUE-DATE' 05750O 18 'PART-NO.' 05760O 35 'DESCRIPTION' 05770O 61 'RECORD' 05780O 77 'ORDER-NO.' 05790O 93 'NEXT-ASSY' 05800O 103 'ASY' 05810O 113 'CUST-NO.' 05820O 120 'QTY' 05830O 131 'BAL' 05840O*------------------------------------------------------------------- 05850O E 71 05860O 1 ' ' 05870O*------------------------------------------------------------------- 05880O E 72 05890O SFDUE 8 ' - - ' 05900O SFPN 22 ' - - ' 05910O PMDESC 53 05920O 01 62 'RECD-PO' 05930O 02 61 'REL-WO' 05940O 03 62 'PUR-ORD' 05950O 04 62 'PLAN-WO' 05960O 05 62 'PUR-REQ' 05970O 06 66 'SALES-ORDER' 05980O 07 64 'REL-REQMT' ÐÐ05990O 08 65 'PLAN-REQMT' 06000O 09 66 'RUN-RELEASE' 06010O SFPRIM 74 06020O 75 '-' 06030O SFITEM 78 06040O 70 79 '-' 06050O 70 SFRLOG 81 06060O 02 SFSTRT 91 ' - - ' 06070O N13 SFCPO 103 06080O 07 SFNAPN 94 ' - - ' 06090O 08 SFNAPN 94 ' - - ' 06100O 07 SFQPA 2 104 06110O 08 SFQPA 2 104 06120O SFCUSTZ 110 06130O QTYBAL2 121 06140O SFAVQ K 132 06150O*------------------------------------------------------------------- 06160O E 73 06170O NUL 132 06180O MGTEXT 35 06190O 38 ' ' 06200O*------------------------------------------------------------------- 06210O E 74 06220O 14 '...END OF PAGE' 06230O*----------------------------------------------------------------- ÐÐ06240O E 78 06250O 29 ' 1 = RECEIVED P.O. ' 06260O 63 ' 6 = SALES ORDER ' 06270O E 78 06280O 29 ' 2 = RELEASED WORK ORDER' 06290O 63 ' 7 = RELEASED REQUIREMEN' 06300O 64 'T' 06310O E 78 06320O 29 ' 3 = PURCHASE ORDER ' 06330O 63 ' 8 = PLANNED REQUIREMENT' 06340O E 78 06350O 29 ' 4 = PLANNED WORK ORDER ' 06360O 63 ' 9 = RUN RELEASE ' 06370O E 78 06380O 29 ' 5 = PURCHASE REQUISITIO' 06390O 30 'N' 06400O E 78 06410O 1 ' ' 06420O******************************************************************** 06430OCRTFILE E 97 06440O PROG 26 06450O CRTIME 33 06460O CRDATE 37 06470O LNK 79 ** NUL ARRAY 006480ÐÐ 06490** A29 ARRAY 06500 006510** A8 ARRAY 006520 006530** A9 ARRAY 006540 006550** A20 ARRAY 006560 006570** MES ARRAY 006580---MESSAGE NOT ON FILE--- 006590** LNK ARRAY 006600 06610/* 06620_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dRô d*X003DC P* 050383050383(èÈÐ00010H Q003DC00020F* OUTPUT POMAST TO DISK80 FOR FLOPPY CONVERSION TO DEC 00030F* REVISED 5-05-83 11:00 AM. 00040FPOMAST IP F 128 6AI 1 DISK 00050FDISK80 O F 80 DISK 00060E******************************************************************** 00070IPOMAST PO 10 128NCD 00080I* PURCHASE ORDER MASTER RECORD. 00090I* P.O. # 6A (KEY) 00100I 1 6 POPO 00110I* VENDOR # 5N 00120I 7 110POVEND 00130I* DELIVER TO 12A 00140I 12 23 POBY 00150I* ORDER TYPE 1A 00160I* Y = CONFIRMATION 00170I 24 24 POTYPE 00180I* WORK ORDER/ACCOUNT 9A 00190I 27 35 POWO 00200I 27 32 POWOP 00210I 33 350POWOD 00220I* FILLER 36 41 FFFFFF 00230I* INSPECTION CODE 3A 00240I 42 44 POINSP 00250I* ORDER DATE 6N ÐÐ00260I 45 500PODORD 00270I* SHIP VIA 10A 00280I 51 60 POVIA 00290I* ORDER ATTENTION OF 10A 00300I 61 70 POATT 00310I* TERMS 8A 00320I 71 78 POTERM 00330I* FOB 1A 00340I 79 79 POFOB 00350I* RESALE 1A 00360I 80 80 PORSAL 00370I* CONTRACT NO. 12A 00380I 81 92 POCNTR 00390I* PRIORITY 15A 00400I 93 107 POPRTY 00410I* CONFIRMATION REQD 1A 00420I 108 108 POCONF 00430I* DATE CLOSED 6N 00440I 109 1140PODCLS 00450I* BUYER CODE 2A 00460I 115 116 POBUYR 00470I* CERTS REQD (Y,N) 1A 00480I 117 117 POCERT 00490I* LAST ITEM # USED 3P 00500I P 118 1190POLITM ÐÐ00510I* RECORD STATUS 1A 00520I 128 128 POSTAT 00530I*-------------------------------------------------------------------- 00540I ZZ 11 00550I******************************************************************** 00560ODISK80 D 10 00570O 3 'PO1' 00580O POPO 9 00590O POVEND 14 00600O POBY 26 00610O POTYPE 27 00620O POWO 36 00630O POINSP 39 00640O PODORD 45 00650O POVIA 55 00660O POATT 65 00670O POTERM 73 00680O*---------------------------------------------------------------------- 00690O D 10 00700O 3 'PO2' 00710O POPO 9 00720O POFOB 10 00730O PORSAL 11 00740O POCNTR 23 00750O POCONF 39 ÐÐ00760O PODCLS 45 00770O POBUYR 47 00780O POCERT 48 00790O POLITM 51 00800O*********************************************************************** /* 00810_‚ ÐÐ_‚_‚0O PODCLS 45 00770O POBUYR 47 00780O POCERT 48 00790O POLITM 51 00800O*********************************************************************** /* 00810_‚ ÐÈ(„VK „wX027WM P999999120282(èÈÐ00010H Q027WM00020F* EXPLODE PLANNED WORK ORDER REQUIREMENTS. (X027WM) 00030F* REVISED 10/29/81 10:45 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060FTERMFILEUC F 256R 8AI 1 DISK 00070FWMMAST IC F 470R 6AI 1 DISK 00080FBMMAST ID F 86L20AI 1 DISK 00090FPMMST2 UC F 674R12AI 1 DISK 00100FSFMAST UC F 128R29AI 1 DISK A 00110FALTKEY UC F 32R29AI 1 DISK A 00120FCALENDARIC F 22R 7AI 1 DISK 00130E******************************************************************** 00140E LEV 1 20 20 A 00150E QTY 1 20 7 0 00160E A29 29 29 1 00170E WA$ 6 11 3 00180E WMD 26 6 0A 00190E WMQ 26 7 0A 00200E WLT 26 3 0 00210E MHR 12 7 3 00220E MDP 12 3 0 00230E PLT 8 3 0 LEAD TIMES 00240E BIT 33 1 00250E TWO 40 6 A ÐÐ00260I******************************************************************** 00270IBITTAB BT 01 00280I 1 33 BIT 00290I******************************************************************** 00300ICRTFILE CR 00310I 68 73 CRRET 00320I 74 79 CRMENU 00330I******************************************************************* 00340ITERMFILETF 00350I* TERMINAL # 2N 00360I 1 20TFTERM 00370I* JOB CODE 2A (EW) 00380I 3 4 TFCODE 00390I* SEQ # 4N 00400I 5 80TFSEQ 00410I* WORK ORDER #'S 40 X 6A 00420I 9 248 TWO 00430I******************************************************************** 00440ICALENDARCA 20 1 CC 00450I* CALENDAR DATE RECORD. 00460I 2 70CACAL 00470I 14 170CAMDAY 00480I 18 200CAWK 00490I 21 220CADOW 00500I*------------------------------------------------------------------- ÐÐ00510I CB 21 1 CM 00520I* MFG DATE RECORD. 00530I 4 70CAMDAY 00540I 8 130CACAL 00550I 18 200CAWK 00560I 21 220CADOW 00570I*------------------------------------------------------------------- 00580I GG 02 00590I******************************************************************** 00600IWMMAST WM 00610I* WORK ORDER MASTER. 00620I* WORK ORDER # 6A 00630I 1 6 WMWO 00640I* DESCRIPTION 40A 00650I 7 46 WMDESC 00660I 7 26 WM20 00670I* COST ARRAY (ACTUAL $) 11.3P X 6 00680I* 1 = LABOR 00690I* 2 = LABOR BURDEN 00700I* 3 = MATERIAL 00710I* 4 = MATERIAL BURDEN 00720I* 5 = NOT USED 00730I* 6 = NOT USED 00740I P 47 82 WA$ 00750I* TRANSFERRED TO STORES $ 11.3P ÐÐ00760I P 83 883WMSTK$ 00770I* VARIANCE TAKEN $ 11.3P 00780I P 89 943WMVAR$ 00790I* QTY RECEIVED 7P 00800I P 95 980WMQRCD 00810I* SCHEDULE. 00820I* DATES 6N X 26 00830I 99 254 WMD 00840I* QTYS 7P X 26 00850I P 255 358 WMQ 00860I* LEAD TIMES 3P X 26 00870I P 359 410 WLT 00880I* CLOSE DATE 6N 00890I 411 4160WMCLOS 00900I* QTY RELEASED 7P 00910I P 417 4200WMQREL 00920I* PART NO. 10N 00930I 422 4310WMPN 00940I* DRAWING REV. 2A 00950I 432 433 WMREV 00960I* UPDATE COUNTER 3P 00970I* INCREMENTED BY 1 EACH TIME 00980I* RECORD UPDATED BY Q009WM. 00990I P 434 4350WMCHG 01000I* ALTERNATE BILL OF MATERIAL 10N ÐÐ01010I 444 4530WMABM 01020I* RECORD STATUS 1A 01030I 470 470 WMSTAT 01040I******************************************************************** 01050ISFMAST SF 01060I* SCHEDULE MASTER. 01070I* COMMON FIELDS. 01080I* KEY AREA. 01090I* PART NO. 10N 01100I* 1 100SFPN 01110I* DATE DUE 6N (YMD) 01120I* 11 160SFDUE 01130I* RECORD CODE 2N 01140I* 10 = RECEIVED PO 01150I* 20 = REL WO 01160I* 30 = PURCHASE ORDER 01170I* 40 = PLAN WO 01180I* 50 = PURCHASE REQ 01190I* 60 = SALES ORDER-BACKLOG 01200I* 70 = REL REQUIREMENT 01210I* 80 = PLAN REQUIREMENT 01220I* 90 = FORECAST 01230I* 17 180SFREC 01240I* ORDER NO. 01250I* 19 29 SFORD ÐÐ01260I* PREFIX 1A 01270I* 19 19 SFPRFX 01280I* PRIME 6A 01290I* 19 24 SFPRIM 01300I* DASH 3N 01310I* 25 270SFDASH 01320I* RECEIVING LOG # 2N 01330I* 28 290SFRLOG 01340I* QUANTITY 7P 01350I P 30 330SFQTY 01360I* QUANTITY COMPLETE 7P 01370I P 34 370SFQTYC 01380I* DATE LAST TRAN 6N (YMD) 01390I* 38 430SFDLT 01400I* CUST #/DEPT #/VEND # 5P 01410I* P 44 460SFCUST 01420I* VARIABLE AREA. 01430I* PLAN/REL REQMTS 01440I* NEXT ASSY PART # 10N 01450I* 47 560SFNAPN 01460I* QTY PER ASSY 7P 01470I* P 57 600SFQPA 01480I* ISSUE CODE 2A 01490I* 61 62 SFISSU 01500I* PULL # 3P ÐÐ01510I* P 63 640SFPULL 01520I* ASSY REVISION 2A 01530I* 65 66 SFREV 01540I* ASSY WO QTY 7P 01550I* P 67 700SFQTYA 01560I* SALES ORDERS. 01570I* CUST P.O. 20A 01580I* 71 90 SFCPO 01590I* UNIT PRICE 9.3P 01600I* P 91 953SFPRIC 01610I* PURCH ORDERS 01620I* VENDOR NAME 20A 01630I* SEE SFCPO UNDER SALES ORDERS. 01640I* UNIT PRICE 9.3P 01650I* SEE SFPRIC UNDER SALES ORDERS. 01660I* WORK ORDERS. 01670I* DEPT NAME 20A 01680I* SEE SFCPO UNDER SALES ORDERS. 01690I* OPER SEQ # 3P 01700I* P 96 970SFSEQ 01710I* START DATE 6N 01720I* 98 1030SFSTRT 01730I* PULL # 3P 01740I* SEE PLAN/REL REQMTS. 01750I* REVISION 2A ÐÐ01760I* SEE PLAN/REL REQMTS. 01770I* AVAIL STOCK BAL 7P 01780I* P 120 1230SFSAVQ 01790I* AVAIL BAL 7P 01800I* P 124 1270SFAVQ 01810I* RECORD STATUS 1A 01820I 128 128 SFSTAT 01830I******************************************************************** 01840IALTKEY AK 21 1 CA 01850I OR 22 1 CB 01860I OR 25 1 CE 01870I OR 26 1 CF 01880I OR 27 01890I* ALTERNATE KEY FILE FOR SFMAST. 01900I* 21 = ORDER ALT KEY FILE 01910I* 22 = DUE DATE ALT KEY FILE 01920I* 25 = START DATE ALT KEY FILE 01930I* 26 = SECONDARY PROCESSING FILE 01940I* COL-2 DEFINITIONS. 01950I* 1 = RECD PO 01960I* 3 = PO 01970I* 5 = PUR REQ 01980I* 6 = SALES ORDER 01990I* 7 = REL REQMT 02000I* 8 = PLAN REQMT ÐÐ02010I* 9 = FORECAST 02020I* W = WORK ORDER 02030I* COMMON FIELDS. 02040I* RECORD CODE (SEE ABOVE) 2A 02050I* 1 2 AKREC 02060I* RECORD STATUS 1A 02070I* 32 32 AKSTAT 02080I* NON-COMMON FIELDS. 02090I*------------------------------------------------------------------- 02100I* REQUIREMEMT ORDER ALT-KEY - 02110I* KEY AREA. 02120I* ORDER 9A 02130I 3 11 AKORD 21 02140I 3 8 AKWO 02150I* PART # 10A 02160I 14 23 AKPN 21 02170I* DUE DATE 6A 02180I 24 29 AKDUE 21 02190I*------------------------------------------------------------------- 02200I* DUE DATE ALT-KEY - 02210I* KEY AREA. 02220I* DUE DATE 6N 02230I* 3 80AKDUE 22 02240I* ORDER NO. 11A 02250I* 9 19 AKORD 22 ÐÐ02260I* PREFIX 1A 02270I* 9 9 AKPRFX 22 02280I* PRIME 5N 02290I* 10 140AKPRIM 22 02300I* DASH 3N 02310I* 15 170AKITEM 22 02320I* RECEIVNG LOG # 02330I* 18 190AKRLOG 22 02340I* PART NO. 10N 02350I* 20 290AKPN 22 02360I*------------------------------------------------------------------- 02370I* START DATE ALT-KEY - 02380I* KEY AREA. 02390I* START DATE 6N 02400I* 3 80AKSTRD 25 02410I* PART NO. 10N 02420I* 9 180AKPN 25 02430I* ORDER NO. 11A 02440I* 19 29 AKORD 25 02450I* PREFIX 1A 02460I* 19 19 AKPRFX 25 02470I* PRIME 5N 02480I* 20 240AKPRIM 25 02490I* DASH 3N 02500I* 25 270AKITEM 25 ÐÐ02510I* RECEIVING LOG 2N 02520I* 28 290AKRLOG 25 02530I******************************************************************** 02540IPMMST2 PM 02550I* PART MASTER RECORD. 02560I* KEY AREA 02570I* PART NO. 10N 02580I 1 100PMPN 02590I* NUMB OF COMPONENTS 3P 02600I P 13 140PMNOBM 02610I* MODEL NAME 12A 02620I 19 30 PMMODL 02630I* DESCRIPTION 29A 02640I 31 59 PMDESC 02650I* CUR CHG LEVEL 2A 02660I 70 71 PMECHG 02670I* ISSUE CODE 2A 02680I 97 98 PMISSU 02690I* LEAD TIMES 3P X 8 02700I P 113 128 PLT 02710I* CALCULATED DATA. 02720I* CURRENT BALANCES. 02730I* ON HAND STOCK 7P 02740I* REQUIRED QTYS. 02750I* FORECAST BAL 7P ÐÐ02760I* ALLOCATIONS 7P 02770I P 319 3220PMALB 02780I* REL REQS 7P 02790I P 323 3260PMRLB 02800I* MFG ROUTING HRS 12 X 7.3P 02810I P 543 590 MHR 02820I P 591 614 MDP 02830I* RECORD STATUS 1A 02840I* D = DELETED 02850I 674 674 PMSTAT 02860I******************************************************************** 02870IBMMAST BM 02880I* BILL OF MATERIAL RECORD 02890I* KEY AREA 02900I* ASSY PART NO. 10N 02910I 1 10 BMAPN 02920I* COMPONENT PART # 10N 02930I 11 20 BMCPN 02940I* ITEM NO. 3N 02950I 25 270BMITNO 02960I* QTY PER ASSY 7P 02970I P 28 310BMQTY 02980I* FILLER 32 33 FFFFFF 02990I* SCRAP ALLOW .2N 03000I 34 352BMSCRP ÐÐ03010I* ISSUE CODE 2A 03020I* PT = PULL TIME 03030I* OR = ON REQUEST 03040I* BI = BULK ISSUE 03050I* AR = AS REQUIRED 03060I* RA = REF ASSY 03070I* TD = TRAV DOC 03080I* SD = SHIP DOC 03090I* RD = REF DOC 03100I* VS = VENDOR SUPPLIED 03110I 36 37 BMISSU 03120I* EFFECTIVITY. 03130I* BEGIN CHANGE LEVEL 2A 03140I 38 39 BMBCHG 03150I* ENDING CHANGE LEVEL 2A 03160I 40 41 BMECHG 03170I* BEGIN ECN # 5A 03180I 42 46 BMBECN 03190I* ENDING ECN # 5A 03200I 47 51 BMEECN 03210I* DISPOSITION CODE 1A 03220I* U = USE UP OLD STYLE 03230I* N = NOW (IMMEDIATE) 03240I 52 52 BMDISP 03250I* FILLER 5A 53 57 FFFFFF ÐÐ03260I* ROUTING. 03270I* OPER NO. 5P 03280I P 58 600BMOPER 03290I* DEPT NO. 5P 03300I P 61 630BMDEPT 03310I* WORK CENTER NO. 3P 03320I P 64 650BMWC 03330I* COMPONENT OPER REFERENCE INFO 10A 03340I 66 75 BMREF 03350I* FILLER 10A 76 85 FFFFFF 03360I* 03370I* RECORD STATUS 1A 03380I* D = DELETED 03390I 86 86 BMSTAT 03400C******************************************************************** 03410C* INITIALIZE 03420C U1 SETON 8081 03430C U1 EXCPT 03440C SETOF 8081 03450C EXSR SR101 INIT 1-TIME 03460C Z-ADD0 ZERO7 70 STUPIDITY 03470C MOVE ' ' BLK6 6 STUPIDITY 03480C Z-ADD0 TCOUNT 40 03490C Z-ADD1 W 30 03500C*----------------------------------------------------------------- ÐÐ03510C START TAG 03520C 1 ADD TCOUNT TCOUNT 40 03530C MOVELPORT KEYTF 8 03540C MOVEL'EW' W6A 6 03550C MOVE TCOUNT W6A 03560C MOVE W6A KEYTF 03570C KEYTF CHAINTERMFILE 54 03580C 54 SETOF 42 03590C 54 GOTO END 03600C SETON 42 03610C*------------------------------------------------------------------ 03620C TAG10 TAG 03630C BLK6 LOKUPTWO,W 54 03640C N54 Z-ADD1 W 03650C N54 EXSR SR87 REWRITE TERMFILE 03660C N54 GOTO START 03670C MOVE TWO,W CRWO 6 03680C MOVE BLK6 TWO,W 03690C*---------------------------------------------------------------- 03700C TAG15 TAG 03710C CRWO CHAINWMMAST H8 03720C H8 GOTO ENDJOB 03730C WMSTAT COMP 'D' 54 03740C 54 GOTO TAG10 03750C ZERO7 LOKUPWMQ 54 ÐÐ03760C N54 GOTO TAG10 03770C MOVELWMPN W12A 12 03780C EXSR SR81 GET PART MAST 03790C 60 GOTO TAG10 03800C XFOOTPLT ALT 50 ASSY LT 03810C* SET-UP INITIAL BILL MATERIAL READ 03820C Z-ADD1 QTY,2 03830C Z-ADD3 L 20 INDENTURE LEVEL 03840C MOVE BLK20 LEV 03850C WMABM COMP 0 54 03860C 54 MOVELWMABM LEV,2 03870C N54 MOVELWMPN LEV,2 03880C*----------------------------------------------------------------- 03890C TAG20 TAG 03900C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 03910C L SUB 1 L 54 INDENT LEVEL 03920C N54 GOTO TAG10 BOTTOM INDENT 03930C LEV,L COMP BLK20 54 03940C N54 GOTO TAG20 NONE THIS LEVEL 03950C MOVE LEV,L W20A 20 03960C MOVELLEV,L CURASY 10 MATCH PART # 03970C MOVE BLK20 LEV,L 03980C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 03990C*------------------------------------------------------------------ 04000C TAG30 TAG ÐÐ04010C* SET-UP NEXT READ 04020C W20A SETLLBMMAST 04030C*--------------------------------------------------------------- 04040C TAG40 TAG 04050C* GET NEXT COMPONENT. 04060C SETOF 54 04070C READ BMMAST 54GET COMPONENT 04080C 54 GOTO TAG20 END OF FILE 04090C BMAPN COMP CURASY 54 04100C N54 GOTO TAG20 WRONG ASSY 04110C BMSTAT COMP 'D' 54 04120C 54 GOTO TAG40 DELETED RECORD 04130C* DISPLAY COMPONENT DATA 04140C EXSR SR72 DISPLAY DATA 04150C* BRANCH IF NOT REF ASSY 04160C PMNOBM COMP 0 54 04170C 54 BMISSU COMP 'RA' 54 04180C N54 GOTO TAG40 NOT REF ASSY 04190C* SAVE CUR LEVEL ASSY/COMPONENT PART # 04200C* SET-UP CHAIN TO NEXT LOWER LEVEL. 04210C MOVELBMAPN LEV,L 04220C MOVE BMCPN W10N 100 04230C 1 ADD W10N W10N 04240C MOVE W10N LEV,L 04250C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER ÐÐ04260C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 04270C MOVE BMCPN CURASY 04280C MOVELBMCPN W20A 04290C MOVE ZERO10 W20A 04300C 1 ADD L L INDENT LEVEL 04310C GOTO TAG30 04320C*----------------------------------------------------------------- 04330C END TAG 04340C* LINK TO NEXT PROG 04350C MOVELCRRET PROG 8 04360C 42 EXSR SR87 REWRITE TERMFILE 04370C EXITFCHAIN 04380C RLABL PROG 04390C*------------------------------------------------------------------ 04400C ENDJOB TAG 04410C******************************************************************** 04420CSR SR72 BEGSR 04430C* OUTPUT SFMAST/ALTKEY RQMT REC. 04440CSR MOVELBMCPN W12A COMP PN 04450CSR MOVE ' ' W12A 12 04460CSR EXSR SR81 GET PMMST2 04470CSR PMMODL COMP BLK12 54 04480CSR 54 MOVE BLK35 PMDESC 04490CSR 54 MOVELPMMODL PMDESC 04500CSR BMISSU COMP ' ' 54 ÐÐ04510CSRN54 MOVE PMISSU BMISSU 04520CSR BMISSU COMP 'PT' 54 04530CSRN54 BMISSU COMP 'OR' 54 04540CSRN54 BMISSU COMP 'BI' 54 04550CSRN54 GOTO END72 04560CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 04570CSR BMISSU COMP 'RA' 54 04580CSR 54 GOTO END72 REF ASSY 04590CSR EXSR SR74 OUTPUT PLAN REQ 04600CSR SETON 41 04610CSR EXSR SR74 OUTPUT REL REQ 04620CSR SETOF 41 04630CSR SETON 86 04640CSR EXCPT UPDATE PMMST2 04650CSR SETOF 86 04660CSR END72 ENDSR 04670C******************************************************************** 04680CSR SR74 BEGSR 04690CSR Z-ADD1 X 30 04700C*------------------------------------------------------------------- 04710CSR T74A TAG 04720CSR ZERO7 LOKUPWMQ,X 54 04730CSRN54 GOTO END74 04740CSR Z-ADDWMD,X W6N 60 04750CSR EXSR SR500 COMPUTE START ÐÐ04760CSR MOVEABMCPN A29 04770CSR MOVEASTART A29,11 04780CSR MOVEA'80' A29,17 04790CSR MOVEAWMWO A29,19 04800CSR MOVEA'00000' A29,25 04810CSR MOVEAA29 W29A 04820CSR WMQ,X MULT EXTQTY EXTEXT 70 04830CSR W29A CHAINSFMAST 60 04840CSRN60 SFSTAT COMP 'D' 61 04850CSR 60 04860COR 61 Z-ADD0 SFQTY 04870CSR Z-ADD0 SFQTYC 04880CSR EXTEXT ADD SFQTY SFQTY 04890CSR SFQTY SUB EXTQTY DIF 70 04900CSR DIF ADD PMALB PMALB 04910CSR EXTEXT DIV WMQ,X QTYPER 70 04920CSR SETON 84 04930CSR EXCPT ADD SFMAST 04940CSR SETOF 84 04950CSR MOVE A29,17 REC 1 04960CSR MOVE 'A' A29,1 04970CSR MOVE REC A29,2 04980CSR MOVEAWMWO A29,3 04990CSR MOVEA'00000' A29,9 05000CSR MOVEABMCPN A29,14 ÐÐ05010CSR MOVEASTART A29,24 05020CSR MOVEAA29 W29A 29 05030CSR EXSR SR83 GET AK-ORDER 05040CSR EXSR SR82 ADD AK-ORDER 05050CSR MOVE 'B' A29,1 05060CSR MOVE REC A29,2 05070CSR MOVEASTART A29,3 05080CSR MOVEAWMWO A29,9 05090CSR MOVEA'00000' A29,15 05100CSR MOVEABMCPN A29,20 05110CSR MOVEAA29 W29A 05120CSR EXSR SR83 GET AK-DUE 05130CSR EXSR SR82 ADD AK-DUE 05140CSR 1 ADD X X 05150CSR X COMP 26 54 05160CSRN54 GOTO T74A 05170CSR END74 ENDSR 05180C******************************************************************** 05190CSR SR81 BEGSR 05200C* GET PART MAST. 05210CSR SETOF 61 05220CSR W12A CHAINPMMST2 60 GET PMMST. 05230CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 05240CSR ENDSR 05250C******************************************************************** ÐÐ05260CSR SR82 BEGSR 05270C* UPDATE ALTKEY. 05280CSR SETON 82 05290CSR EXCPT 05300CSR SETOF 82 05310CSR ENDSR 05320C******************************************************************** 05330CSR SR83 BEGSR 05340C* GET ALTKEY. 05350CSR W29A CHAINALTKEY 60 05360CSR ENDSR 05370C******************************************************************** 05380CSR SR84 BEGSR 05390C* GET CALENDAR 05400CSR W7A CHAINCALENDAR 60 GET CALENDAR 05410CSR ENDSR 05420C***************************************************************** 05430CSR SR87 BEGSR 05440C* REWRITE TERMFILE 05450CSR SETON 87 05460CSR EXCPT REWRITE TERMFILE 05470CSR SETOF 8742 05480CSR ENDSR 05490C******************************************************************** 05500CSR SR101 BEGSR ÐÐ05510C* INITIALIZE (1-TIME). 05520CSR MOVE ' ' BLK35 35 05530CSR MOVE ' ' BLK12 12 05540CSR MOVE ' ' BLK20 20 05550CSR MOVE ' ' BLK8 8 05560CSR Z-ADD0 ZERO5 50 05570CSR Z-ADD0 ZERO10 100 05580CSR MOVELUDATE W4N 40 05590CSR MOVE UDATE W2N 20 05600CSR MOVELW2N TODAY 60 05610CSR MOVE W4N TODAY 05620C* GET PORT # AND CRTFILE. 05630CSR MOVE ' ' W8A 8 05640CSR Z-ADD0 W2N 20 05650CSR Z-ADD0 W1N 10 05660CSR MOVE ' ' W2A 2 05670CSR EXITFPGMINX GET PORT # 05680CSR RLABL W8A 05690CSR RLABL W2N 05700CSR RLABL W1N 05710CSR RLABL W2A 05720CSR MOVE W2A PORT 20 PORT NO. 05730CSR PORT COMP 0 54 05740CSRN54 Z-ADD25 PORT DEFAULT 05750CSR PORT CHAINCRTFILE H9 ÐÐ05760CSR ENDSR 05770C******************************************************************** 05780CSR SR500 BEGSR 05790C* USE LEAD TIME TO COMPUTE START DATE. 05800CSR MOVEL'C' W7A 7 05810CSR MOVE W6N W7A 05820CSR EXSR SR84 GET CALENDAR 05830CSR 60 GOTO T500Z 05840CSR Z-ADDWLT,X LEAD 30 55 05850CSRN55 Z-ADDALT LEAD 05860CSR CAMDAY SUB LEAD W6U 60 54 05870CSRN54 Z-ADD1 W6U 05880CSR MOVE BLK8 W7A 05890CSR MOVEL'M' W7A 05900CSR MOVE W6U W7A 05910CSR EXSR SR84 GET CALENDAR 05920CSR 60 GOTO T500Z 05930CSR MOVE CACAL START 6 05940CSR GOTO END500 05950C*------------------------------------------------------------------- 05960CSR T500Z TAG 05970CSR MOVE TODAY START 05980CSR END500 ENDSR 05990O******************************************************************** 06000OSFMAST EADD 84 60 ÐÐ06010O W29A 29 06020O SFQTY 33P 06030O SFQTYC 37P 06040O TODAY 43 06050O ZERO5 46P 06060O WMPN 56 06070O QTYPER 60P 06080O BMISSU 62 06090O WMREV 66 06100O WMQ,X 70P 06110O ZERO7 123P 06120O ZERO7 127P 06130O 128 'A' 06140O*------------------------------------------------------------------- 06150O E 84N60 06160O SFQTY 33P 06170O SFQTYC 37P 06180O TODAY 43 06190O ZERO5 46P 06200O WMPN 56 06210O QTYPER 60P 06220O BMISSU 62 06230O WMREV 66 06240O WMQ,X 70P 06250O ZERO7 123P ÐÐ06260O ZERO7 127P 06270O 128 'A' 06280O******************************************************************** 06290OALTKEY EADD 82 60 06300O W29A 29 06310O 32 'A' 06320O*------------------------------------------------------------------- 06330O E 82N60 06340O 32 'A' 06350O******************************************************************** 06360OPMMST2 E 86 06370O PMNOBM 14P 06380O PLT 128P 06390O PMALB 322P 06400O PMRLB 326P 06410O MHR 590P 06420O MDP 614P 06430O******************************************************************* 06440OTERMFILEE 87 06450O TWO 248 06460O******************************************************************** ** LEV ARRAY 06470 06480** QTY ARRAY 06490 06500ÐÐ** A29 ARRAY 06510 06520/* 06530_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ÂWà ¼X003UJ P120282120282(èÈÐ00010H Q003UJ00020F* DISPLAY UJMAST - DEPT SEQ. (X003UJ) DG REL006 OK 00030F* REVISED 11/26/79 5:10 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FUJMAST ID F 12L11AI 1 DISK 00070FBJMAST IC F 106R 6AI 1 DISK 00080FMENUDEPTIT F 25 EDISK 00090FTERM132 O F 132 5 00100F**************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A6 6 6 1 CALL READ PARAM. 00130E A8 8 8 1 A INPUT DATA ARRAY 00140E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00150E DUN 1 1 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E LOC 1 1 3 XY-POSITION 00180E MENUDEPT TABDEP 1 10 5 0 TABDN 20 DEPT #/NAME 00190E* 00200E* 00210E BIT 256 1 SCREEN CONTR. CHAR 00220E CALL 5 6 CALL STACK 00230E BJD 6 4 REPORT DISTR. 00240E* 00250I******************************************************************* ÐÐ00260IBITHEX BT 00270I 1 256 BIT 00280I******************************************************************* 00290IMGFILE MG 00300I* MESSAGE FILE. 00310I 1 35 MGTEXT 00320I******************************************************************** 00330IUJMAST UJ 00340I* USER JOB MENU. 00350I* DEPT 5N 00360I 1 50UJDEPT 00370I* JOB NAME 6A 00380I 6 11 UJNAME 00390I* RECORD STATUS 1A 00400I 12 12 UJSTAT 00410I******************************************************************** 00420IBJMAST BJ 00430I* BATCH JOB MAST. 00440I* JOB NAME 6A 00450I 1 6 BJNAME 00460I* DESCRIPTION 40A 00470I 7 46 BJDESC 00480I* PRINTER 1A 00490I* D = DIABLO 00500I* S = SYSTEM PRINTER ÐÐ00510I* T = DATAGRAPHIX 00520I* C = CONSOLE 00530I 47 47 BJPRTR 00540I* PAPER 25A 00550I 48 72 BJPAP 00560I* COPIES 1N 00570I 73 730BJCOPY 00580I* DISTRIBUTION 4A X 6 00590I 74 97 BJD 00600I* UPDATE CODE 1A 00610I* Y = SHARABLE 00620I* N = NOT SHARABLE 00630I* BLK = NO DISK UPDATE 00640I 98 98 BJUPD 00650I* TYPE CODE 1A 00660I* P = PROGRAM (MAINLINE OR CALLED BY PROC) 00670I* U = UTILITY (ONLY) 00680I* Z = JOB STREAM 00690I* M = MENU 00700I* C = CALLED PROGRAM 00710I 99 99 BJTYPE 00720I* RECORD STATUS 1A 00730I 106 106 BJSTAT 00740C******************************************************************** 00750C* INITIALIZE ÐÐ00760C EXSR SR101 1-TIME INIT 00770C*------------------------------------------------------------------ 00780C START TAG 00790C* SET-UP 1ST FIELD NO. 00800C MOVE ' ' DUN 00810C Z-ADD1 F 30 FIELD # 00820C Z-ADD0 CRDEPT 50 DEPT # 00830C MOVE BLK40 DEPNAM 20 00840C MOVE BLK40 JOBNAM 40 00850C EXSR SR71 00860C GOTO READ 00870C*------------------------------------------------------------------ 00880C NEXT TAG 00890C* SET-UP NEXT FIELD NO. 00900C 1 ADD F F FIELD # 00910C*----------------------------------------------------------------- 00920C READ TAG 00930C* READ DATA FROM TERMINAL. 00940C SETOF 9096 00950C EXSR SR102 VALIDATE FIELD # 00960C 55 GOTO UPDATE DONE 00970C EXSR SR201 IDENTIFY-F 00980C SETON 72 00990C EXCPT PROMPT 01000C SETOF 72 ÐÐ01010C EXITFQCCR CR ONLY 01020C MOVELBIT,1 W2A 2 01030C MOVE BIT,12 W2A 01040C EXITFQMOVR MOVE CURSOR 01050C RLABL W2A 01060C EXSR SR75 READ TERMINAL 01070C*--------------------------------------------------------------- 01080C ESCAPE TAG 01090C 98 GOTO GOODBY GOODBY 01100C 94 GOTO MENU MENU REQUEST 01110C N77N88 EXSR SR104 EDIT INPUT FIELD 01120C 93 GOTO NEWITM NEW ITEM 01130C 92 GOTO JUMP FIELD JUMP REQST 01140C 91 GOTO NEXT SKIP FORWARD 01150C 89 F SUB 1 F SKIP BACKWARD 01160C 89 GOTO READ " " 01170C 88 SETOF 90 SPACE FILL 01180C 88 SETON 77 " " 01190C 87 GOTO START 01200C 86 GOTO UPDATE UPDATE 01210C 85 GOTO READ REPEAT 01220C 96 GOTO ERROR ERROR 01230C 90 Z-ADD318 M 96 FLAG ERROR 01240C 90 GOTO ERROR 01250C N77 GOTO NEXT NO DATA INPUT ÐÐ01260C*------------------------------------------------------------------ 01270C PROCES TAG 01280C* PROCESS INPUT DATA 01290C EXSR SR103 MOVE DATA 01300C N96 EXSR SR104 EDIT DATA 01310C EXITFQMOVUP BUMP CURSOR UP 01320C SETON 72 01330C EXCPT REWRITE DATA 01340C SETOF 72 01350C 96 GOTO ERROR ERROR 01360C GOTO NEXT 01370C*------------------------------------------------------------------ 01380C UPDATE TAG 01390C* UPDATE DATA BASE. 01400C EXSR SR106 UPDATE 01410C 90 GOTO ESCAPE 01420C GOTO START 01430C*------------------------------------------------------------------- 01440C JUMP TAG 01450C* SET-UP JUMP TO REQUESTED FIELD 01460C 1 ADD W W 30 01470C W COMP 8 54 01480C 54 Z-ADD318 M 50 96 FLAG ERROR 01490C 54 GOTO ERROR BAD ESC 01500C MOVE '000' W3A 3 ÐÐ01510C MOVEAA8,W W3A 01520C Z-ADD3 W2N 20 01530C EXIT SUBRAJ R. JUSTIFY 01540C RLABL W2N 01550C RLABL W3A 01560C MOVE W3A F NEW FIELD # 01570C GOTO READ 01580C*-------------------------------------------------------------------- 01590C ERROR TAG 01600C EXSR SR102 VALIDATE FIELD # 01610C EXSR SR89 GET MSG 01620C EXSR SR73 PUT MSG 01630C GOTO READ 01640C*------------------------------------------------------------------ 01650C NEWITM TAG 01660C* SET-UP LINK FOR NEW ITEM 01670C GOTO START 01680C*------------------------------------------------------------------- 01690C MENU TAG 01700C* SET-UP LINK TO MENU 01710C MOVEL'QQDP01' PROG 8 01720C GOTO END 01730C*-------------------------------------------------------------------- 01740C GOODBY TAG 01750C* LINK TO SIGN-OFF ÐÐ01760C MOVEL'GOODBY' PROG 01770C GOTO END 01780C*------------------------------------------------------------------- 01790C END TAG 01800C* LINK TO MENU OR SIGN-OFF 01810C PROG COMP BLK8 54 01820C N54 MOVEL'QQDP01' PROG 01830C EXITFCHAIN LINK NEXT PROG 01840C RLABL PROG 01850C******************************************************************* 01860CSR SR1 BEGSR 01870C* EDIT DEPT. 01880CSR UJDEPT LOKUPTABDEP TABDN 54 01890CSRN54 MOVE BLK35 DEPNAM 01900CSR 54 MOVE TABDN DEPNAM 01910CSR END1 ENDSR 01920C********************************************************************* 01930CSR SR3 BEGSR 01940C* GET JOB NAME. 01950CSR UJNAME CHAINBJMAST 60 GET BJMAST 01960CSRN60 BJSTAT COMP 'D' 60 01970CSR 60 MOVE BLK40 JOBNAM 40 JOB NAME 01980CSRN60 MOVE BJDESC JOBNAM 01990CSR END3 ENDSR 02000C********************************************************************** ÐÐ02010CSR SR71 BEGSR 02020C* PUT HEADINGS TO TERMINAL 02030CSR SETON 71 02040CSR EXCPT PUT HEADINGS 02050CSR SETOF 71 02060CSR Z-ADD4 LINENO 02070CSR ENDSR 02080C*********************************************************************** 02090CSR SR73 BEGSR 02100C* PUT ERROR MESSAGE TO TERMINAL 02110CSR SETON 73 02120CSR EXCPT PUT MSG 02130CSR SETOF 73 02140CSR Z-ADDM LSTERR 50 02150CSR EXITFQMOVUP MOVE CURSOR. 02160CSR ENDSR 02170C******************************************************************* 02180CSR SR75 BEGSR 02190C* READ FROM TERMINAL 02200CSR SETOF 779096 02210CSR SETOF 939291 02220CSR SETOF 898887 02230CSR SETOF 8685 02240CSR MOVE BIT,5 A6,2 BUF LENGTH 02250CSR MOVEAA6 W6A 6 ÐÐ02260CSR MOVE BLK8 W8A 8 BUFFER 02270CSR EXITFQWREED READ TERM 02280CSR RLABL W8A 02290CSR RLABL W6A 02300CSR MOVEAW8A A8 02310CSR MOVE BLK8 W8A 02320CSR Z-ADD1 W 30 02330CSR '\' LOKUPA8,W 90 FLAG ESC 02340CSRN90 GOTO T75B NOT ESC 02350CSR 1 ADD W W 02360CSR W COMP 8 54 02370CSR 54 GOTO T75A BAD ESC 02380CSR A8,W COMP 'G' 98 GOODBY 02390CSR A8,W COMP 'E' 94 MENU 02400CSR A8,W COMP 'N' 93 NEW ITEM 02410CSR A8,W COMP 'J' 92 JUMP 02420CSR A8,W COMP 'F' 91 SKIP FRWRD 02430CSR A8,W COMP 'B' 89 SKIP BKWRD 02440CSR A8,W COMP 'S' 88 SPACE FILL 02450CSR A8,W COMP 'H' 87 HOME 02460CSR A8,W COMP 'U' 86 UPDATE 02470CSR A8,W COMP 'R' 85 REPEAT 02480CSR 98 02490COR 94 02500COR 93 ÐÐ02510COR 92 02520COR 91 02530COR 89 02540COR 88 02550COR 87 02560COR 86 02570COR 85 GOTO END75 GOOD ESC 02580C*------------------------------------------------------------------ 02590CSR T75A TAG 02600C* FLAG BAD ESC INPUT 02610CSR Z-ADD318 M 96 FLAG ERROR 02620CSR GOTO END75 02630C*-------------------------------------------------------------------- 02640CSR T75B TAG 02650C* MOVE DATA 02660CSR Z-ADD1 W 02670CSR ' ' LOKUPA8,W 77 02680CSR 77 MOVEAA8,W W8A INPUT DATA 02690C*-------------------------------------------------------------------- 02700CSR END75 TAG 02710C* INIT PREV ERROR MSG. 02720CSR LSTERR COMP 0 54 02730CSR 54 MOVE BLK35 MGTEXT 02740CSR 54 EXSR SR73 BLANK MESSAGE 02750CSR Z-ADD0 LSTERR 50 ÐÐ02760CSR ENDSR 02770C********************************************************************** 02780CSR SR89 BEGSR 02790C* GET MESSAGE MASTER 02800CSR M CHAINMGFILE 54 02810CSR 54 MOVE BLK35 MGTEXT 02820CSR 54 MOVELM MGTEXT 02830CSR 54 MOVE MES,1 MGTEXT 02840CSR ENDSR 02850C******************************************************************** 02860CSR SR101 BEGSR 02870C* 1-TIME INITIALIZE 02880CSR MOVE BIT,1 NUL 02890CSR MOVE BIT,1 A6 02900CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02910CSR MOVE ' ' BLK8 8 02920C* DEFINE WORK FIELDS,ETC. 02930CSR MOVE ' ' BLK35 35 02940CSR MOVE ' ' BLK6 6 02950CSR MOVE ' ' BLK40 40 02960CSR Z-ADD0 ZERO5 50 02970C* 02980C* 02990CSR ENDSR 03000C********************************************************************** ÐÐ03010CSR SR102 BEGSR 03020C* VALIDATE FIELD NO. 03030CSR F COMP 0 54 03040CSRN54 Z-ADD1 F 03050CSR F COMP FLIMIT 55 03060CSR 55 Z-ADD1 F 03070CSR ENDSR 03080C******************************************************************** 03090CSR SR103 BEGSR 03100C* MOVE INPUT DATA 03110CSR EXSR SR201 IDENTIFY-F 03120CSR EXSR SR202 R. JUSTIFY 03130CSR 01 MOVE W8A CRDEPT 50 DEPT #. 03140CSR MOVE ' ' DUN,F EDIT FLAG 03150CSR ENDSR 03160C******************************************************************** 03170CSR SR104 BEGSR 03180C* EDIT INPUT DATA 03190CSR 96 MOVE ' ' DUN,F EDIT FLAG 03200CSRN96 MOVE 'X' DUN,F 03210CSR ENDSR 03220C******************************************************************** 03230CSR SR106 BEGSR 03240C* DISPLAY UJMAST FILE - DEPT SEQ. 03250CSR T106A TAG ÐÐ03260CSR CRDEPT COMP 840 80 03270CSR 80 MOVELZERO5 W11A 11 03280CSRN80 MOVELCRDEPT W11A 11 03290CSR W11A SETLLUJMAST 03300C*-------------------------------------------------------------- 03310CSR T106B TAG 03320CSR SETOF 54 03330CSR READ UJMAST 54 03340CSR 54 GOTO T106T END OF FILE 03350CSR UJSTAT COMP 'D' 54 03360CSR 54 GOTO T106B DELETED 03370CSR EXSR SR1 GET DEPT NAME 03380CSR EXSR SR3 GET JOB NAME 03390CSR SETON 72 03400CSR EXCPT PUT DATA 03410CSR SETOF 72 03420CSR LINENO ADD 1 LINENO 30 SCREEN LINE 03430CSR LINENO COMP 28 54 54 03440CSRN54 GOTO T106B NOT END PAGE 03450CSR EXITFQEPAGE END PAGE MSG 03460CSR EXSR SR75 READ 03470CSR 90 GOTO END106 ESCAPE 03480CSR EXSR SR71 PUT HEADINGS 03490CSR 77 EXSR SR103 MOVE INPUT DATA 03500CSR 77 GOTO T106A SET LOW LIMIT ÐÐ03510CSR GOTO T106B GET NEXT RECORD 03520C*------------------------------------------------------------------- 03530CSR T106T TAG 03540C* END FILE MESSAGE 03550CSR EXITFQEFILE END FILE MSG 03560CSR END106 ENDSR 03570C************************************************************************ 03580CSR SR201 BEGSR 03590C* IDENTIFY FIELD NO. 03600CSR F COMP 1 01 03610CSR ENDSR 03620C********************************************************************** 03630CSR SR202 BEGSR 03640C* RIGHT JUSTIFY 03650CSR F LOKUPNUM 54 03660CSRN54 GOTO END202 NOT NUMERIC FIELD 03670CSR Z-ADD8 W2N 20 03680CSR EXIT SUBRAJ R. JUSTIFY 03690CSR RLABL W2N 03700CSR RLABL W8A 03710CSR END202 ENDSR 03720O******************************************************************** 03730OTERM132 E 71 03740O* PUT HEADING. 03750O E 71 ÐÐ03760O 15 'DEPT' 03770O 44 'JOB' 03780O*------------------------------------------------------------------- 03790O E 71 03800O*------------------------------------------------------------------- 03810O E 72 03820O* PUT DATA. 03830O UJDEPTZB 15 03840O DEPNAM B 38 03850O 80 UJNAME B 46 03860O JOBNAM B 88 03870O*------------------------------------------------------------------- 03880O E 73 03890O* PUT MESSAGE. 03900O NUL 132 03910O MGTEXT 35 03920O 37 ' ' ** NUL ARRAY 003930 003940** A6 ARRAY 003950 003960** A8 ARRAY 003970 003980** NUM ARRAY 003990001 004000ÐÐ** DUN ARRAY 004010 004020** MES ARRAY 004030---MESSAGE NOT ON FILE--- 004040** LOC ARRAY 004050011 1 DEPT# 004060/* 004070_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¯X€ ¯IX003XP P120282120282(èÈÐ00010H Q003XP00020F* EXPLODE REQUIREMENTS. (X003XP) DG REL006 OK 00030F* REVISED 1/18/81 1:55 PM. 00040F* 00050FBITTAB IP F 33 DISK 00060FXPMAST ID F 99L22AI 1 DISK 00070FXPCONT UC F 128R DISK 00080FPMMST2 ID F 674R12AI 1 DISK 00090FBMMAST ID F 86L20AI 1 DISK 00100FREQMTOUTO F 33 DISK 00110FTERM80 O F 80 5 00120E******************************************************************** 00130E A22 22 22 1 00140E BIT 33 1 SCREEN CONTR. CHAR 00150E XPQ 18 7 0A REQMTS 00160E XCD 18 6 0A DATES 00170I******************************************************************** 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************** 00210IXPMAST EX 00220I* EXPLOSION MASTER. 00230I* KEY AREA. 00240I* LOW LEVEL CODE 2N 00250I 1 20XPLL ÐÐ00260I* COMPONENT PART # 10N 00270I 3 120XPCPN 00280I* TOP ASSY PN 10N 00290I 13 220XPAPN 00300I* REQMTS 7P X 18 00310I P 23 94 XPQ 00320I* RECORD STATUS 1A 00330I 99 99 XPSTAT 00340I******************************************************************** 00350IXPCONT EC 00360I* EXPLOSION CONTROL MAST. 00370I* DATES 6N X 18 00380I 1 108 XCD 00390I* CUR INDENT LEVEL 2N 00400I 127 1280XCCIL 00410I******************************************************************** 00420IPMMST2 PM 00430I 1 100PMPN 00440I P 13 140PMNOC 00450I* LOW LEVEL CODE 2N 00460I 430 4310PMLL 00470I 674 674 PMSTAT 00480I******************************************************************** 00490IBMMAST BM 00500I 1 100BMAPN ÐÐ00510I 11 200BMCPN 00520I P 28 310BMQTY 00530I 86 86 BMSTAT 00540C******************************************************************** 00550C* INITIALIZE, GET XPCONT FILE, ADD 1 TO CURRENT INDENT #. 00560C EXSR SR101 INIT 00570C Z-ADD0 ZERO7 70 STUPIDITY 00580C H9 GOTO END 00590C*------------------------------------------------------------------- 00600C START TAG 00610C* SET-UP 1ST READ CURRENT INDENT LEVEL. 00620C MOVE XCCIL W2A 2 00630C MOVEAW2A A22,1 00640C MOVE ZERO10 W10A 10 00650C MOVEAW10A A22,3 00660C MOVEAW10A A22,13 00670C MOVEAA22 W22A 22 00680C W22A SETLLXPMAST 00690C*------------------------------------------------------------------- 00700C TAG10 TAG 00710C* GET NEXT EXPLOSION MASTER. 00720C SETOF 54 00730C READ XPMAST 54 00740C 54 GOTO END 00750C XPLL COMP XCCIL 54 ÐÐ00760C N54 GOTO END 00770C XPCPN COMP LASTPN 54 00780C N54 GOTO END 00790C Z-ADDXPCPN LASTPN 100 00800C XPSTAT COMP 'D' 54 00810C 54 GOTO TAG10 00820C MOVELXPCPN W20A 20 00830C MOVE ZERO10 W20A 00840C W20A SETLLBMMAST SET-UP BM READ 00850C*------------------------------------------------------------------- 00860C TAG20 TAG 00870C* GET BILL OF MATERIAL. 00880C SETOF 54 00890C READ BMMAST 54 00900C 54 GOTO TAG10 00910C BMAPN COMP XPCPN 54 00920C N54 GOTO TAG10 00930C BMSTAT COMP 'D' 54 00940C 54 GOTO TAG20 00950C Z-ADD1 X 30 00960C EXSR SR80 GET BMCPN PMMST2 00970C*------------------------------------------------------------------- 00980C TAG30 TAG 00990C* EXPLODE REQUIREMENTS. 01000C ZERO7 LOKUPXPQ,X 54 ÐÐ01010C N54 GOTO TAG20 01020C PMNOC COMP 0 97 FLAG ASSY 01030C BMQTY MULT XPQ,X XPTQTY 70 54 01040C 54 SETON 7298 01050C 54 EXCPT REQMTOUT 01060C 54 SETOF 72 01070C 1 ADD X X 01080C X COMP 18 54 01090C N54 GOTO TAG30 01100C GOTO TAG20 01110C*------------------------------------------------------------------- 01120C END TAG 01130C SETON 84 01140C EXCPT 01150C SETOF 84 01160C MOVEL'Q004XP' PROG 8 01170C N98 XCCIL COMP 20 98 LESS THAN 01180C 98 EXITFCHAIN 01190C RLABL PROG 01200C******************************************************************** 01210CSR SR80 BEGSR 01220C* GET COMPONENT PMMST2 01230CSR MOVELBMCPN W12A 12 01240CSR MOVE ' ' W12A 01250CSR W12A CHAINPMMST2 60 ÐÐ01260CSRN60 PMSTAT COMP 'D' 60 01270CSR ENDSR 01280C******************************************************************** 01290CSR SR101 BEGSR 01300C* INIT 01310CSR Z-ADD1 RRN 50 01320CSR RRN CHAINXPCONT 54 GET CONTROL MAST 01330CSR 1 ADD XCCIL XCCIL CUR INDENT LEVEL 01340CSR Z-ADD0 ZERO7 70 01350CSR Z-ADD0 ZERO10 100 01360CSR ENDSR 01370O******************************************************************** 01380OREQMTOUTE 72 01390O PMLL 2 01400O PMPN 12 01410O XPAPN 22 01420O XCD,X 28 01430O XPTQTY 32P 01440O 97 33 'A' 01450O************************************************************* 01460OTERM80 E 72 01470O XPLL 2 01480O XPCPN 15 ' - - ' 01490O PMPN 30 ' - - ' 01500O******************************************************************** ÐÐ01510OXPCONT E 84 01520O XCCIL 128 ** A22 ARRAY 001530 001540/* 001550_‚ ÐÐ_‚_‚0OXPCONT E 84 01520O XCCIL 128 ** A22 ARRAY 001530 001540/* 001550_‚ ÐÈ(^XÊ ^’X004CF P120282120282(èÈÐ00010H Q004CF00020F* DISPLAY CFMAST SEQ FROM INPUT KEY FORWARD. (X004CF) 00030F* REVISED 6/05/80 3:10 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FCFMAST ID F 370L15AI 1 DISK 00070FTERM132 O F 132 5 00080FMGFILE IC F 80R DISK 00090E******************************************************************** 00100E NUL 1 132 1 00110E A6 1 6 1 00120E A16 16 16 1 A 00130E NA4 5 5 6 00140E NB4 5 5 4 0 00150E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00160E BIT 33 1 00170E CFA 8 35 00180E CFN 5 3 00190E CFC 5 3 0 00200E NAC 24 1 00210I******************************************************************** 00220IBITTAB BT 00230I 1 33 BIT 00240I******************************************************************** 00250IMGFILE MG ÐÐ00260I 1 35 MGTEXT 00270I 36 70 MGLIN2 00280I 71 75 MGPROG 00290I******************************************************************** 00300ICFMAST CF 00310I* CATALOG HOLDER (MAIL LIST) MASTER. 00320I* KEY AREA. 00330I* NAME KEY 15A 00340I 1 15 CFKEY 00350I* ADDRESS LINES 35A X 8 00360I 16 295 CFA 00370I* STATE CODE 2A 00380I 296 297 CFSTCD 00390I* ZIP 9P 00400I P 298 3020CFZIP 00410I* CATALOGS. 00420I* NAME 3A X 5 00430I 303 317 CFN 00440I* COPIES 3P X 5 00450I P 318 327 CFC 00460I* SELECTOR CODES 24 X 1A 1 00470I 328 351 NAC 00480I* TELEPHONE # 12A 00490I 352 363 CFTEL 00500I* DATE LAST TRAN 6N (YMD) ÐÐ00510I 364 3690CFDLT 00520I* RECORD STATUS 1A 00530I 370 370 CFSTAT 00540C******************************************************************** 00550C* INITIALIZE - 1 TIME. 00560C EXSR SR101 INIT. 00570C*------------------------------------------------------------------- 00580C START TAG 00590C* REQUEST STARTING KEY FIELD. 00600C Z-ADD273 M 00610C EXSR SR73 PUT MSG. 00620C EXSR SR75 READ. 00630C 94 GOTO END EXIT. 00640C 93 GOTO START NEW ITEM. 00650C MOVELW16A W15A 15 00660C W15A SETLLCFMAST 00670C* PUT HEADING. 00680C Z-ADD0 COUNT2 30 00690C SETON 82 00700C EXCPT 00710C SETOF 82 00720C*------------------------------------------------------------------- 00730C READ TAG 00740C* GET NEXT MASTER. 00750C SETOF 807172 ÐÐ00760C SETOF 739693 00770C READ CFMAST 80 00780C 80 GOTO ENDFIL 00790C CFSTAT COMP 'D' 54 00800C 54 GOTO READ DELETED CFMAST. 00810C MOVE CFN NA4 00820C Z-ADDCFC NB4 00830C CFSTCD COMP ' ' 54 00840C 54 CFSTCD LOKUPTABSC TABSCN 54 00850C 54 MOVE TABSCN W25A 25 00860C N54 MOVE BLK35 W25A 00870C SETON 81 00880C EXCPT 00890C SETOF 81 00900C 1 ADD COUNT2 COUNT2 00910C COUNT2 COMP 3 54 00920C N54 GOTO READ 00930C*------------------------------------------------------------------- 00940C ENDPAG TAG 00950C* END PAGE MESSAGE. 00960C Z-ADD320 M 50 00970C EXSR SR73 PUT MSG. 00980C EXSR SR75 READ. 00990C 94 GOTO END 01000C 93 GOTO START ÐÐ01010C Z-ADD0 COUNT2 30 01020C SETON 82 01030C EXCPT 01040C SETOF 82 01050C GOTO READ 01060C*------------------------------------------------------------------- 01070C ENDFIL TAG 01080C* PUT END FILE MESSAGE. 01090C Z-ADD317 M 01100C EXSR SR73 01110C GOTO START 01120C*------------------------------------------------------------------- 01130C END TAG 01140C SETON LR 01150C MOVEL'Q070DP' PROG 8 01160C EXITFCHAIN 01170C RLABL PROG 01180C******************************************************************** 01190CSR SR73 BEGSR 01200C* PUT MSG. 01210CSR EXSR SR89 GET MSG. 01220CSR SETON 73 01230CSR EXCPT PUT MSG. 01240CSR SETOF 73 01250CSR ENDSR ÐÐ01260C******************************************************************** 01270CSR SR75 BEGSR 01280C* READ CRT. 01290CSR SETOF 9377 01300CSR SETOF 909496 01310CSR MOVE BIT,7 A6,2 01320CSR MOVEAA6 W6A 6 01330CSR MOVE BLK16 W16A 16 01340CSR EXITFXCREAD READ. 01350CSR RLABL W16A 01360CSR RLABL W6A 01370CSR MOVEAW16A A16 01380CSR MOVE BLK16 W16A 01390CSR Z-ADD1 W 20 01400CSR '\' LOKUPA16,W 90 01410CSR 90 W ADD 1 W 01420CSR 90 A16,W COMP 'N' 93 01430CSR 90N93 SETON 94 01440CSR 90 GOTO END75 01450CSR Z-ADD1 W 01460CSR ' ' LOKUPA16,W 77 01470CSR 77 MOVEAA16,W W16A 01480CSR END75 ENDSR 01490C******************************************************************** 01500CSR SR89 BEGSR ÐÐ01510C* GET MSG. 01520CSR M CHAINMGFILE 60 01530CSR ENDSR 01540C******************************************************************** 01550CSR SR101 BEGSR 01560C* INITIALIZE 1-TIME. 01570CSR MOVE BIT,1 A6 01580CSR MOVE BIT,1 NUL 01590CSR MOVE ' ' BLK16 16 01600CSR MOVE ' ' BLK35 35 01610CSR EXITFQTOPF CLEAR SCREEN. 01620CSR ENDSR 01630O******************************************************************** 01640OTERM132 E 82 01650O E 82 01660O E 82 01670O E 82 01680O E 82 01690O E 82 01700O E 82 01710O* PUT HEADINGS. 01720O 56 'MAILING LIST DISPLAY' 01730O 79 '- KEY FIELD SEQUENCE' 01740O E 82 01750O* PUT HEADINGS. ÐÐ01760O 10 'KEY FIELD' 01770O 47 'N A M E A N D A D D ' 01780O 54 'R E S S' 01790O 92 'S E L E C T O R C O D ' 01800O 95 'E S' 01810O 123 'MAILER CODES' 01820O*------------------------------------------------------------------- 01830O E 81 01840O*------------------------------------------------------------------- 01850O E 81 01860O* PUT DATA. 01870O CFKEY 15 01880O 22 'NAME' 01890O CFA,1 66 01900O NAC 94 01910O NA4 131 01920O*------------------------------------------------------------------- 01930O E 81 01940O 23 'TITLE' 01950O CFA,2 66 01960O NB4 Z 131 01970O*------------------------------------------------------------------- 01980O E 81 01990O 25 'COMPANY' 02000O CFA,3 66 ÐÐ02010O*------------------------------------------------------------------- 02020O E 81 02030O 25 'COMPANY' 02040O CFA,4 66 02050O*------------------------------------------------------------------- 02060O E 81 02070O 25 'ADDRESS' 02080O CFA,5 66 02090O*------------------------------------------------------------------- 02100O E 81 02110O 25 'ADDRESS' 02120O CFA,6 66 02130O 79 'TELEPHONE:' 02140O CFTEL 92 02150O 112 'LAST UPDATED:' 02160O CFDLT Y 122 02170O*------------------------------------------------------------------- 02180O E 81 02190O 22 'CITY' 02200O CFA,7 66 02210O 74 'STATE' 02220O 79 ':' 02230O CFSTCD 82 02240O W25A 104 02250O 112 'ZIP:' ÐÐ02260O CFZIP Z 122 02270O*------------------------------------------------------------------- 02280O E 81 02290O 30 'FOREIGN CTRY' 02300O CFA,8 66 02310O*------------------------------------------------------------------- 02320O E 73 02330O* PUT ERROR MESSAGE. 02340O NUL 132 02350O BIT,11 1 02360O MGTEXT 36 02370O 38 ' ' 02380O BIT,8 39 02390O BIT,8 40 ** NUL ARRAY 002400 002410** A6 ARRAY 002420 002430** A16 ARRAY 002440 002450** NA4 ARRAY 002460 002470** NB4 ARRAY 002480 002490** TABSC/TABSCN --- STATE CODES/NAMES 002500ÐÐ 002510ALALABAMA 002520AKALASKA 002530AZARIZONA 002540ARARKANSAS 002550ASAMERICAN SAMOA 002560CACALIFORNIA 002570CZCANAL ZONE 002580COCOLORADO 002590CTCONNECTICUT 002600DEDELAWARE 002610DCDISTRICT OF COLUMBIA 002620FLFLORIDA 002630GAGEORGIA 002640GUGUAM 002650HIHAWAII 002660IDIDAHO 002670ILILLINOIS 002680ININDIANA 002690IAIOWA 002700KSKANSAS 002710KYKENTUCKY 002720LALOUISIANA 002730MEMAINE 002740MDMARYLAND 002750ÐÐMAMASSACHUSETTS 002760MIMICHIGAN 002770MNMINNESOTA 002780MSMISSISSIPPI 002790MOMISSOURI 002800MTMONTANA 002810NENEBRASKA 002820NVNEVADA 002830NHNEW HAMPSHIRE 002840NJNEW JERSEY 002850NMNEW MEXICO 002860NYNEW YORK 002870NCNORTH CAROLINA 002880NDNORTH DAKOTA 002890OHOHIO 002900OKOKLAHOMA 002910OROREGON 002920PAPENNSYLVANIA 002930PRPUERTO RICO 002940RIRHODE ISLAND 002950SCSOUTH CAROLINA 002960SCSOUTH DAKOTA 002970TNTENNESSEE 002980TTTRUST TERRITORIES 002990TXTEXAS 003000ÐÐUTUTAH 003010VTVERMONT 003020VAVIRGINIA 003030VIVIRGIN ISLANDS 003040WAWASHINGTON 003050WVWEST VIRGINIA 003060WIWISCONSIN 003070WYWYOMING 003080/* 003090_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(wY] wX004CM P f120282120282(èÈÐ00010H Q004CM00020F* UPDATE CMMAST FILE. (X004CM) 00030F* REVISED 6-25-81 3:35 PM. DG-REL006 OK. 00040F* * * * NOTE * * * 00050F* SEE SR204 - TEMPORARILY BYPASSES CHECKING FOR ACTIVITY. 00060FBITTAB IP F 33 DISK 00070FMGFILE IC F 80R DISK 00080FCR2FILE IC F 672R DISK 00090FCMMAST UC F 576R 5AI 1 DISK A 00100FCMBTAFILUC F 352R 5AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E MES 1 1 30 00140E CRA 7 35 00150E CRB 10 9 2 00160E CRS 10 9 2 00170E CRAR 4 9 2 00180E CRD 5 7 0 00190E CRM 3 3 MAILER CODE 00200E CRC 3 2 0 NUMB COPIES 00210E BIT 33 1 SCREEN CONTR. CHAR 00220E CALL 5 6 CALL STACK 00230I******************************************************************* 00240IBITTAB BT 00250I 1 33 BIT ÐÐ00260I******************************************************************* 00270IMGFILE MG 00280I* MESSAGE FILE. 00290I 1 35 MGTEXT 00300I****************************************************************** 00310ICR2FILE CR 00320I* CR2FILE CMMAST FIELDS. 00330I* CUSTOMER NO. 5N 00340I 1 50CRCUST 00350I* SORT (ALT) KEY 20A 00360I 6 25 CRSORT 00370I* ADDRESS 35A X 7 00380I 26 270 CRA 00390I* STATE CODE 2A 00400I 271 272 CRSTCD 00410I* ZIP CODE 9P 00420I P 273 2770CRZIP 00430I* PHONE NO. 15A 00440I 278 292 CRPHON 00450I* CONTACT NAME 35A 00460I 293 327 CRCONT 00470I* REMARKS 35A 00480I 328 362 CRREM 00490I* CUSTOMER CLASS 2A 00500I 363 364 CRCLAS ÐÐ00510I* TERRITORY CODE 3A 00520I 365 367 CRTER 00530I* CREDIT LIMIT 7P 00540I P 368 3710CRCRLM 00550I* PAYMENT TERMS 8A 00560I 372 379 CRTERM 00570I* NUMBER OF INVOICE COPIES 1N 00580I 380 3800CRINV 00590I* SHIPPING METHOD 20A 00600I 381 400 CRSHIP 00610I* CURRENT BACKLOG 9.2P X 10 00620I P 401 450 CRB 00630I* LAST 12-MOS SHIPMENTS 9.2P X 10 00640I P 451 500 CRS 00650I* CURRENT RECEIVABLES 9.2P X 4 00660I P 501 520 CRAR 00670I* TAX CODE 1A 00680I 521 521 CRTAX 00690I* STD DISCOUNT 3.2P 00700I P 522 5232CRDISC 00710I* EXPORT CODE 1A 00720I 524 524 CREXPT 00730I* DATE HISTORY 7P X 5 00740I P 525 544 CRD 00750I* GEOGRAPHIC CODE 5A ÐÐ00760I 545 549 CRGEO 00770I* HOLD CODE 1A 00780I 550 550 CRHOLD 00790I* MAILING CODES. 00800I* MAILER CODES 3 X 3A 00810I 551 559 CRM 00820I* NUMB OF COPIES 3 X 2N 00830I 560 565 CRC 00840I* POINTERS. 00850I* CREDIT CHANGES 5P 00860I P 573 5750CRFCC 00870I* PREV SORT CODE 20A 00880I 577 596 CROSRT 00890I* START PROG 6A 00900I 666 671 CRPROG 00910I* TRANSACTION CODE 1A 00920I 672 672 CRTRAN 00930I******************************************************************** 00940ICMMAST CM 00950I* CUSTOMER MASTER. 00960I* RECORD STATUS 1A 00970I 576 576 CMSTAT 00980I********************************************************************** 00990ICMBTAFILCB 01000I 352 352 CBSTAT ÐÐ01010C******************************************************************** 01020C* INITIALIZE 01030C EXSR SR101 1-TIME INIT 01040C*------------------------------------------------------------------ 01050C UPDATE TAG 01060C* UPDATE DATA BASE. 01070C EXSR SR106 UPDATE 01080C 96 GOTO ERROR ERROR 01090C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01100C CRPROG COMP 'Q001CM' 54 01110C N54 MOVEL'Q006CM' PROG 01120C 54 MOVELCRPROG PROG 8 01130C EXSR SR203 CLASSIFY TRAN. 01140C CRSORT COMP CROSRT 54 SORT CODE. 01150C CRSORT COMP BLK20 55 SORT CODE. 01160C 60 55 01170COR 62 55 01180COR 61N54 MOVEL'Q005CM' PROG 01190C GOTO END 01200C*------------------------------------------------------------------- 01210C ERROR TAG 01220C EXSR SR89 01230C EXSR SR73 01240C MOVEL'Q003CM' PROG 01250C*------------------------------------------------------------------- ÐÐ01260C END TAG 01270CLR PROG COMP BLK8 54 01280CLRN54 MOVEL'Q070DP' PROG 01290CLR EXITFCHAIN LINK TO NEXT PROG 01300CLR RLABL PROG 01310C********************************************************************* 01320CSR SR73 BEGSR 01330C* PUT ERROR MESSAGE TO TERMINAL 01340CSR SETON 73 01350CSR EXCPT PUT MSG 01360CSR SETOF 73 01370CSR Z-ADDM LSTERR 50 01380CSR ENDSR 01390C********************************************************************** 01400CSR SR80 BEGSR 01410C* GET MASTER RECORD 01420CSR SETOF 61 01430CSR CRCUST CHAINCMMAST 60 GET MASTER 01440CSRN60 CMSTAT COMP 'D' 61 FLAG DELETE 01450CSR ENDSR 01460C********************************************************************** 01470CSR SR81 BEGSR 01480C* ADD NEW MASTER TO FILE 01490CSR SETON 81 01500CSR EXCPT ADD MASTER ÐÐ01510CSR SETOF 81 01520CSR ENDSR 01530C*********************************************************************** 01540CSR SR82 BEGSR 01550C* REWRITE MASTER 01560CSR SETON 82 01570CSR EXCPT REWRITE MASTER 01580CSR SETOF 82 01590CSR ENDSR 01600C********************************************************************** 01610CSR SR89 BEGSR 01620C* GET MESSAGE MASTER 01630CSR M CHAINMGFILE 54 01640CSR 54 MOVE BLK35 MGTEXT 01650CSR 54 MOVELM MGTEXT 01660CSR 54 MOVE MES,1 MGTEXT 01670CSR ENDSR 01680C*********************************************************************** 01690CSR SR101 BEGSR 01700C* 1-TIME INITIALIZE 01710C* GET PORT # AND CR2FILE 01720CSR MOVE ' ' W8A 8 01730CSR Z-ADD0 W2N 20 01740CSR Z-ADD0 W1N 10 01750CSR MOVE ' ' W2A 2 ÐÐ01760CSR EXITFPGMINX GET PORT # 01770CSR RLABL W8A 01780CSR RLABL W2N 01790CSR RLABL W1N 01800CSR RLABL W2A 01810CSR MOVE W2A PORT 20 PORT NO. 01820CSR PORT COMP 0 54 01830CSRN54 Z-ADD25 PORT DEFAULT 01840CSR PORT CHAINCR2FILE H9 01850C* DEFINE WORK FIELDS,ETC. 01860CSR MOVE ' ' BLK35 35 01870CSR MOVE ' ' BLK8 8 01880CSR MOVE ' ' BLK20 20 01890CSR ENDSR 01900C******************************************************************** 01910CSR SR106 BEGSR 01920C* UPDATE DATA BASE. 01930CSR EXSR SR203 CLASSIFY TRAN 01940CSR 60 GOTO T106A ADD TRAN 01950CSR 61 GOTO T106D CHANGE TRAN 01960CSR 62 GOTO T106F DELETE TRAN 01970C* FLAG BAD TRAN CODE 01980CSR Z-ADD300 M 50 96 FLAG ERROR 01990CSR Z-ADD1 F 30 FIELD # 02000CSR GOTO END106 ÐÐ02010C*------------------------------------------------------------------- 02020CSR T106A TAG 02030C* ADD TRANSACTION 02040CSR EXSR SR80 GET MASTER 02050CSR 60 GOTO T106B NOT ON FILE 02060CSR 61 GOTO T106C DELETED MASTER 02070C* FLAG DUPLICATE ADD ERROR 02080CSR Z-ADD301 M 96 FLAG ERROR 02090CSR Z-ADD1 F FIELD # 02100CSR GOTO END106 02110C*--------------------------------------------------------------------- 02120CSR T106B TAG 02130C* ADD-- MAST NOT ON FILE 02140CSR EXSR SR81 ADD NEW MASTER 02150CSR GOTO END106 02160C*--------------------------------------------------------------------- 02170CSR T106C TAG 02180C* ADD-- MAST IS DELETED 02190CSR MOVE 'A' CMSTAT RECORD STATUS 02200CSR EXSR SR82 REWRITE MAST 02210CSR GOTO END106 02220C*---------------------------------------------------------------------- 02230CSR T106D TAG 02240C* CHANGE TRANSACTION. 02250CSR EXSR SR80 GET MASTER ÐÐ02260CSRN60N61 GOTO T106E GOT IT 02270C* FLAG NO MASTER ERROR 02280CSR Z-ADD302 M 96 FLAG ERROR 02290CSR Z-ADD1 F FIELD # 02300CSR GOTO END106 02310C*----------------------------------------------------------------------- 02320CSR T106E TAG 02330C* REWRITE MASTER 02340CSR EXSR SR82 REWRITE MAST 02350CSR GOTO END106 02360C*----------------------------------------------------------------------- 02370CSR T106F TAG 02380C* DELETE TRANSACTION 02390CSR EXSR SR80 GET MASTER 02400CSRN60N61 GOTO T106G GOT IT 02410C* FLAG NO MASTER ERROR 02420CSR Z-ADD302 M 96 FLAG ERROR 02430CSR Z-ADD1 F FIELD # 02440CSR GOTO END106 02450C*----------------------------------------------------------------------- 02460CSR T106G TAG 02470C* DELETE MASTER. 02480CSR EXSR SR204 CHECK FOR ACTIVITY 02490CSR 96 Z-ADD1 F FIELD # 02500CSR 96 GOTO END106 ERROR ÐÐ02510CSR MOVE 'D' CMSTAT RECORD STATUS 02520CSR EXSR SR82 REWRITE MASTER 02530CSR CRCUST CHAINCMBTAFIL 54 02540CSRN54 SETON 83 02550CSRN54 EXCPT DELETE BILL TO 02560CSR SETOF 83 02570CSR END106 ENDSR 02580C*********************************************************************** 02590CSR SR203 BEGSR 02600C* CLASSIFY TRAN CODE 02610CSR CRTRAN COMP 'A' 60 ADD 02620CSR CRTRAN COMP 'C' 61 CHANGE 02630CSR CRTRAN COMP 'D' 62 DELETE 02640CSR ENDSR 02650C******************************************************************** 02660CSR SR204 BEGSR 02670C* CHECK FOR ACTIVITY. 02680C* * * * BYPASS TEMPORARILY * * * * * 02690CSR GOTO END204 02700CSR XFOOTCRB W7N 70 54 02710CSRN54 XFOOTCRAR W7N 54 02720CSR 54 Z-ADD29 M 96 FLAG ERROR. 02730CSR END204 ENDSR 02740O******************************************************************** 02750OCMMAST EADD 81 ÐÐ02760O* ADD CMMAST. 02770O CRCUST 5 02780O CRSORT 25 02790O CRA 270 02800O CRSTCD 272 02810O CRZIP 277P 02820O CRPHON 292 02830O CRCONT 327 02840O CRREM 362 02850O CRCLAS 364 02860O CRTER 367 02870O CRCRLM 371P 02880O CRTERM 379 02890O CRINV 380 02900O CRSHIP 400 02910O CRB 450P 02920O CRS 500P 02930O CRAR 520P 02940O CRTAX 521 02950O CRDISC 523P 02960O CREXPT 524 02970O CRD 544P 02980O CRGEO 549 02990O CRHOLD 550 03000O CRM 559 ÐÐ03010O CRC 565 03020O CRFCC 575P 03030O 576 'A' 03040O*------------------------------------------------------------------- 03050O E 82 03060O* REWRITE CMMAST. 03070O CRSORT 25 03080O CRA 270 03090O CRSTCD 272 03100O CRZIP 277P 03110O CRPHON 292 03120O CRCONT 327 03130O CRREM 362 03140O CRCLAS 364 03150O CRTER 367 03160O CRCRLM 371P 03170O CRTERM 379 03180O CRINV 380 03190O CRSHIP 400 03200O CRB 450P 03210O CRS 500P 03220O CRAR 520P 03230O CRTAX 521 03240O CRDISC 523P 03250O CREXPT 524 ÐÐ03260O CRD 544P 03270O CRGEO 549 03280O CRHOLD 550 03290O CRM 559 03300O CRC 565 03310O CRFCC 575P 03320O CMSTAT 576 03330O********************************************************************** 03340OCMBTAFILE 83 03350O 352 'D' 03360O******************************************************************** 03370OTERM132 E 73 03380O BIT,28 1 03390O 8 '8030080' 03400O MGTEXT 43 03410O BIT,8 131 03420O BIT,8 132 ** MES ARRAY 003430---MESSAGE NOT ON FILE--- 003440/* 003450_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È8# ÈTX005EJ PÜ@120282120282(èÈÐ00010H Q005EJ00020F* DEPT HEAD ONLY-DISPLAY ALL EMPLOYEE 'EJ' IN DEPT. (X005EJ) 00030F* REVISED 2/23/83 9:40 AM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FEMPLFILEID F 64L14AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FCRTFILE IC F 256R DISK 00090FTERM75 O F 75 5 00100E******************************************************************** 00110E A6 1 6 1 00120E NUL 1 75 1 00130E BIT 33 1 00140I******************************************************************** 00150IBITTAB BT 00160I 1 33 BIT 00170I******************************************************************** 00180IEMPLFILEEE 00190I* RECORD CODE 1A 00200I* J = EMPLOYEE/JOB 00210I 1 1 EJREC 00220I* EMPLOYEE # 5N 00230I 2 60EJEMPL 00240I* SEQUENCE # 3N 00250I 7 90EJSEQ ÐÐ00260I* DESCRIPTION 35A 00270I 15 49 EJDESC 00280I* JOB CODE 6A 00290I 50 55 EJJOB 00300I* DEPT # 5N 00310I 56 600EJDEPT 00320I* RECORD STATUS 1A 00330I 64 64 EJSTAT 00340I******************************************************************** 00350ICRTFILE CR 00360I 1 50CREMPL 00370I 6 13 CRUSER 00380I 14 180CRDEPT 00390I******************************************************************** 00400IMGFILE MG 00410I* MESSAGE FILE 00420I* TEXT 35A 00430I 1 35 MGTEXT 00440I* LINE-2 35A 00450I 36 70 MGLIN2 61 00460I* PROG NAME 5A 00470I 71 75 MGPROG 00480C******************************************************************** 00490C* INITIALIZE, CLEAR SCREEN 00500C 79 GOTO START ÐÐ00510C SETON 79 00520C MOVE ' ' W2A 2 00530C EXITFZGMINX 00540C RLABL W2A 00550C MOVE W2A PORT 20 00560C PORT CHAINCRTFILE H9 00570C H9 GOTO END 00580C CRDEPT COMP 840 89 00590C MOVE BIT,1 NUL 00600C MOVE BIT,1 A6 00610C MOVE BIT,2 A6,2 00620C MOVE ' ' BLK35 35 00630C EXITFQTOPF CLEAR SCREEN 00640C SETON 70 00650C EXCPT 00660C SETOF 70 00670C* SET-UP 1ST READ. 00680C MOVE BLK35 W14A 14 00690C MOVEL'J' W6A 00700C MOVE '00000' W6A 00710C MOVELW6A W14A 00720C W14A SETLLEMPLFILE 00730C*------------------------------------------------------------------- 00740C START TAG 00750C* GET NEXT EMPLOYEE RECORD. ÐÐ00760C SETOF 54 00770C READ EMPLFILE 54 00780C 54 SETON LR 00790C 54 GOTO END 00800C EJREC COMP 'J' 54 00810C N54 SETON LR 00820C N54 GOTO END 00830C EJDEPT COMP CRDEPT 54 00840C N54 GOTO START 00850C EJSTAT COMP 'D' 54 00860C 54 GOTO START 00870C COUNT COMP 28 54 54 00880C N54 GOTO NOHALT 00890C SETON 71 00900C EXCPT PAUSE. 00910C SETOF 71 00920C MOVE ' ' W2A 2 00930C MOVEAA6 W6A 6 00940C EXITFXCREAD 00950C RLABL W2A 00960C RLABL W6A 00970C Z-ADD0 COUNT 00980C MOVELW2A W1A 1 00990C W1A COMP '\' 54 01000C N54 MOVE W2A W1A ÐÐ01010C N54 W1A COMP '\' 54 01020C N54 GOTO NOHALT 01030C SETON LR 01040C*------------------------------------------------------------------- 01050C NOHALT TAG 01060C 1 ADD COUNT COUNT 50 01070C*------------------------------------------------------------------- 01080C END TAG 01090C NLR SETON 73 01100C NLR EXCPT 01110C SETOF 73 01120C NLR GOTO START 01130CLR SETON 72 01140CLR EXCPT 01150CLR SETOF 72 01160CLR MOVEAA6 W6A 01170CLR EXITFXCREAD 01180CLR RLABL W2A 01190CLR RLABL W6A 01200CLR MOVEL'QQDP02' PROG 8 01210CLR EXITFCHAIN 01220CLR RLABL PROG 01230O******************************************************************** 01240OTERM75 E 70 01250O* PUT HEADING. ÐÐ01260O BIT,28 1 01270O 2 '8' 01280O 8 '001055' 01290O 34 'LIST DEPT USERS MENUS ' 01300O BIT,11 35 01310O*------------------------------------------------------------------- 01320O E 73 01330O* LIST EMPLOYEES. 01340O EJEMPLZ 5 01350O EJSEQ Z 12 01360O EJDESC 50 01370O 89 EJJOB 65 01380O*------------------------------------------------------------------- 01390O E 71 01400O* PAUSE. 01410O NUL 75 01420O 12 'CONTINUED...' 01430O 14 ' ' 01440O*------------------------------------------------------------------- 01450O E 72 01460O NUL 75 01470O BIT,11 1 01480O 20 'PRESS "CR" FOR MENU' 01490O 22 ' ' ** A6 ARRAY 001500ÐÐ 001510** NUL ARRAY 001520 001530/* 001540_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Ze  X004DP P120282120282(èÈÐ00010H Q004DP00020F* REMOVE DEBUG STATEMENTS FROM PROGRAM 00030FEDPIN IP F 80 80 DISK 00040FEDPOUT O F 80 80 DISK 00050E REC 80 1 00060IEDPIN EI 01 00070I 1 80 REC 00080C REC,6 COMP 'C' 54 00090C N54 GOTO END 00100C MOVEAREC,28 W5A 5 00110C W5A COMP 'DEBUG' 54 00120C 54 SETOF 01 00130C MOVEAREC,1 W2A 2 00140C W2A COMP '/*' 54 00150C 54 SETON LR 00160C END TAG 00170OEDPOUT D 01 00180O REC 80 /* 000190_‚ _‚_‚ ÐÈ(ú7¹ úiX004DJ PÂ&120282120282(èÈÐ00010H Q004DJ00020F* DISPLAY JOBS BY DEPARTMENT (DEPT ONLY). (X004DJ) 00030F* REVISED 2/23/83 9:35 AM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FDEPTFILEID F 32L12AI 1 DISK 00060FJOBFILE IC F 48R 7AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FCRTFILE IC F 256R DISK 00090FTERM75 O F 75 5 00100E******************************************************************** 00110E A6 1 6 1 00120E NUL 1 75 1 00130E BIT 33 1 00140I******************************************************************** 00150IBITTAB BT 00160I 1 33 BIT 00170I******************************************************************** 00180IDEPTFILEDJ 00190I* RECORD CODE 1A 00200I 1 1 DJREC 00210I* DEPT # 5N 00220I 2 60DJDEPT 00230I* SEQ # 3N 00240I 7 90DJSEQ 00250I* JOB CODE 6A ÐÐ00260I 13 18 DJJOB 00270I* RECORD STATUS 1A 00280I 32 32 DJSTAT 00290I******************************************************************** 00300ICRTFILE CR 00310I 1 5 CREMPL 00320I 6 13 CRUSER 00330I 14 180CRDEPT 00340I******************************************************************** 00350IJOBFILE JN 00360I* RECORD CODE 1A 00370I* N = JOB NAME RECORD 00380I 1 1 JNREC 00390I* JOB NAME 6A 00400I 2 7 JNJOB 00410I* JOB DESCRIPTION 35A 00420I 8 42 JNDESC 00430I* RECORD STATUS 1A 00440I 48 48 JNSTAT 00450I******************************************************************** 00460IMGFILE MG 00470I* MESSAGE FILE 00480I* TEXT 35A 00490I 1 35 MGTEXT 00500I* LINE-2 35A ÐÐ00510I 36 70 MGLIN2 61 00520I* PROG NAME 5A 00530I 71 75 MGPROG 00540C******************************************************************** 00550C* INITIALIZE, CLEAR SCREEN 00560C 79 GOTO START 00570C SETON 79 00580C MOVE ' ' W2A 2 00590C EXITFZGMINX 00600C RLABL W2A 00610C MOVE W2A PORT 20 00620C PORT CHAINCRTFILE H9 00630C H9 GOTO END 00640C CRDEPT COMP 840 89 DP DEPT NO. 00650C MOVE BIT,1 NUL 00660C MOVE BIT,1 A6 00670C MOVE BIT,2 A6,2 00680C MOVE ' ' BLK14 14 00690C MOVE ' ' BLK35 35 00700C EXITFQTOPF CLEAR CRT 00710C SETON 70 00720C EXCPT 00730C SETOF 70 00740C EXSR SR104 SET-UP 1ST READ 00750C*------------------------------------------------------------------- ÐÐ00760C START TAG 00770C* GET NEXT DEPT RECORD. 00780C SETOF 54 00790C READ DEPTFILE 54 00800C 54 SETON LR 00810C 54 GOTO END 00820C DJREC COMP 'J' 54 00830C N54 SETON LR 00840C N54 GOTO END 00850C DJDEPT COMP CRDEPT 54 00860C N54 SETON LR 00870C N54 GOTO END 00880C DJSTAT COMP 'D' 54 00890C 54 GOTO START 00900C* GET JOB MASTER. 00910C MOVEL'N' W7A 7 00920C MOVE DJJOB W7A 00930C W7A CHAINJOBFILE 60 00940C SETOF 61 00950C 60 MOVE BLK35 JNDESC 00960C N60 JNSTAT COMP 'D' 61 00970C COUNT COMP 55 54 54 00980C N54 GOTO NOHALT 00990C SETON 71 01000C EXCPT PAUSE. ÐÐ01010C SETOF 71 01020C MOVE ' ' W2A 2 01030C EXSR SR102 READ CRT 01040C MOVELW2A W1A 1 01050C W1A COMP '\' 54 01060C N54 MOVE W2A W1A 01070C N54 W1A COMP '\' 54 01080C N54 GOTO NOHALT 01090C SETON LR 01100C*------------------------------------------------------------------- 01110C NOHALT TAG 01120C 1 ADD COUNT COUNT 50 01130C*------------------------------------------------------------------- 01140C END TAG 01150C NLR SETON 73 01160C NLR EXCPT 01170C SETOF 73 01180C NLR GOTO START 01190CLR SETON 72 01200CLR EXCPT 01210CLR EXSR SR102 01220CLR MOVEL'QQDP02' PROG 8 01230CLR EXITFCHAIN 01240CLR RLABL PROG 01250C******************************************************************** ÐÐ01260CSR SR102 BEGSR 01270C* READ CRT. 01280CSR MOVEAA6 W6A 6 01290CSR EXITFXCREAD 01300CSR RLABL W2A 01310CSR RLABL W6A 01320CSR Z-ADD0 COUNT 01330CSR ENDSR 01340C******************************************************************** 01350CSR SR104 BEGSR 01360C* SET-UP 1ST READ - DEPTFILE. 01370CSR MOVE BLK14 W12A 12 01380CSR MOVEL'J' W6A 01390CSR MOVE CRDEPT W6A 01400CSR MOVELW6A W12A 01410CSR W12A SETLLDEPTFILE 01420CSR ENDSR 01430C******************************************************************** 01440OTERM75 E 70 01450O* CLEAR SCREEN 01460O BIT,28 1 01470O 2 '8' 01480O 8 '001055' 01490O 31 'LIST JOBS BY DEPARTMENT' 01500O BIT,11 75 ÐÐ01510O*------------------------------------------------------------------- 01520O E 73 01530O* LIST JOBS 01540O DJDEPTZ 5 01550O DJSEQ Z 13 01560O 89 DJJOB 60 01570O JNDESC 51 01580O 60 75 'NO MAST' 01590O 61 75 'DELETED' 01600O*------------------------------------------------------------------- 01610O E 71 01620O* PAUSE. 01630O NUL 75 01640O 12 'CONTINUED...' 01650O 14 ' ' 01660O*------------------------------------------------------------------- 01670O E 72 01680O NUL 75 01690O BIT,14 1 01700O BIT,11 2 01710O 19 'PRESS "CR" FOR MENU' 01720O 21 ' ' ** A6 ARRAY 001730 001740** NUL ARRAY 001750ÐÐ 001760/* 001770_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ôZÄ ôÑX004EG P120282120282(èÈÐ00010H Q004EG00020F* LIST JOB SCHEDULE BY WEEKS - BALANCE PLUS/MINUS. (X004EG) 00030F* REVISED 6/11/80 5:15 PM. *** D I A B L O *** 00040FBITTAB IP F 33 DISK 00050FEGTABLE IS F 1202 DISK 00060FMDAYWE IC F 9R DISK 00070FCRTFILE UC F 256R DISK 00080E********************************************************************* 00090E MWE 1 90 4 0A WEEK END DATES 00100E HED 1 90 1 WEEK NOS. 00110E REQ 1 90 4 0 HRS REQD. 00120E HRS 1 90 3 0 MANHOURS 00130E LIN 1 90 1 PRINT LINE 00140E TEN 10 10 1 00150E M1 60 1 A MAN 00160E N1 60 12 NAME 00170E M3 300 1 A MAN 00180E B3 300 4 0 START 00190E J3 300 1 JOB 00200E S3 300 1 SKILL 00210E E3 300 4 0 STOP 00220E H3 300 4 0 HRS 00230E P3 300 2 2 % 00240E J4 100 1 A JOB 00250E D4 100 12 DESCR ÐÐ00260E W4 100 6 WO # 00270E J5 300 1 A JOB 00280E B5 300 4 0 START 00290E S5 300 1 SKILL 00300E H5 300 4 0 HRS 00310E E5 300 4 0 STOP 00320E P5 300 2 2 % 00330E S6 60 1 A SKILL 00340E T6 60 12 TITLE 00350E REC 132 1 00370E* ARRAY STRUCTURE. 00380E* * M1+* * * * * * 1. MAN - M,N 00390E* * * N1 * * * * * 1.1 NAME - M,N 00400E*------------------------------------------------------------------- 00410E* * M3+* * * * * * 3. MAN - M,S,J,B,H,E 00420E* * * B3+* * * * * 3.1 START-M,S,J,B,H,E 00430E* * * * J3+* * * * 3.2 JOB -M,S,J,B,H,E 00440E* * * * * S3+* * * 3.3 SKILL-M,S,J,B,H,E 00450E* * * * * * E3 * * 3.4 STOP -M,S,J,B,H,E 00460E* * * * * * * H3 * 3.5 HRS -M,S,J,B,H,E 00470E* * * * * * * * P3 3.6 % -M,S,J,B,H,E 00480E*------------------------------------------------------------------- 00490E* * J4+* * * * * * 4. JOB -J,D,W 00500E* * * W4 * * * * * 4.1 NUMB -J,D,W 00510E* * * * D4 * * * * 4.2 DESCR-J,D,W ÐÐ00520E*------------------------------------------------------------------- 00530E* * J5+* * * * * * 5. JOB -J,S,H,B,P,E 00540E* * * B5+* * * * * 5.1 START-J,S,H,B,P,E 00550E* * * * S5+* * * * 5.2 SKILL-J,S,H,B,P,E 00560E* * * * * E5 * * * 5.3 STOP -J,S,H,B,P,E 00570E* * * * * * H5 * * 5.4 HRS -J,S,H,B,P,E 00580E* * * * * * * P5 * 5.5 % -J,S,H,B,P,E 00590E*------------------------------------------------------------------- 00600E* * S6+* * * * * * 6. SKILL-S,T 00610E* * * T6 * * * * * 6.1 TITLE-S,T 00620E*------------------------------------------------------------------- 00630E* + INDICATES CONTROL FIELDS IN ARRAY GROUP 00640E* M = MAN CODE 00650E* N = MAN NAME 00660E* S = SKILL 00670E* J = JOB CODE 00680E* B = START DATE 00690E* H = HRS AVAIL/REQD 00700E* P = PER CENT CMPLT 00710E* T = SKILL TITLE 00720E* D = JOB DESCRIPTION 00730E* W = JOB # 00740E* E = STOP DATE 00750I********************************************************************* 00760IBITTAB BT ÐÐ00770I 1 1 BIT 00780I**************************************************************** 00790IMDAYWE WE 00800I 1 40W4N 00810I******************************************************************** 00820ICRTFILE CR 00830I 81 212 REC 00840I*************************************************************** 00850IEGTABLE EA 01 1 C0 2 C1 00860I* MAN-CODE/MAN-NAME 1A X 60 00870I 3 62 M1 01 00880I EC 02 1 C0 2 C2 00890I* MAN-NAME/MAN-NAME 12A X 60 00900I 3 722 N1 02 00910I ED 03 1 C0 2 C3 00920I* MAN-CODE/MAN-SCHED 1A X 300 00930I 3 302 M3 03 00940I EE 04 1 C0 2 C4 00950I* START-DATE/MAN-SCHED 4NX300 00960I 31202 B3 04 00970I EF 05 1 C0 2 C5 00980I* JOB-CODE/MAN-SCHED 1A X 300 00990I 3 302 J3 05 01000I EG 06 1 C0 2 C6 01010I* SKILL-CODE/MAN-SCHED 1AX300 ÐÐ01020I 3 302 S3 06 01030I EH 07 1 C0 2 C7 01040I* STOP-DATE/MAN-SCHED 4NX300 01050I 31202 E3 07 01060I EI 08 1 C0 2 C8 01070I* HOURS/MAN-SCHED 4NX300 01080I 31202 H3 08 01090I EJ 09 1 C0 2 C9 01100I* % COMPLETE/MAN-SCHED .2NX300 01110I 3 602 P3 09 01120I EK 10 1 C1 2 C0 01130I* JOB-CODE/JOB-DESCR 1AX100 01140I 3 102 J4 10 01150I EL 11 1 C1 2 C1 01160I* JOB-DESCR/JOB-DESCR 12X100 01170I 31202 D4 11 01180I EM 12 1 C1 2 C2 01190I* JOB#/JOB-DESDR 6AX100 01200I 3 602 W4 12 01210I EN 13 1 C1 2 C3 01220I* JOB-CODE/JOB-SCHED 1A X 300 01230I 3 302 J5 13 01240I EO 14 1 C1 2 C4 01250I* START-DATE/JOB-SCHED 4N X 300 01260I 31202 B5 14 ÐÐ01270I EP 15 1 C1 2 C5 01280I* SKILL-CODE/JOB-SCHED 1A X 300 01290I 3 302 S5 15 01300I EQ 16 1 C1 2 C6 01310I* HOURS/JOB-SCHED 4NX300 01320I 31202 H5 16 01330I ER 17 1 C1 2 C7 01340I* STOP-DATE/JOB-SCHED 4NX300 01350I 31202 E5 17 01360I ES 18 1 C1 2 C8 01370I* % COMPLETE/JOB-SCHED .2NX300 01380I 3 602 P5 18 01390I ET 19 1 C1 2 C9 01400I* SKILL-CODE/SKILL-TITLE 1AX60 01410I 3 62 S6 19 01420I EU 20 1 C2 2 C0 01430I* SKILL-TITLE/SKILL-TITLE 12AX60 01440I 3 722 T6 20 01450I*---------------------------------------------------------------- 01460I GG 24 01470C******************************************************************** 01480C* INITIALIZE - 1-TIME. 01490C N79 EXSR SR101 INIT 01500C H9 GOTO END 01510C N20 GOTO END ÐÐ01520C*------------------------------------------------------------------- 01530C START TAG 01540C* GET NEXT JOB. 01550C 1 ADD W W 30 01560C W COMP 100 54 01570C 54 GOTO END END J4 TABLE 01580C J4,W COMP BIT 54 01590C N54 GOTO START NOT ACTIVE 01600C Z-ADD1 J 30 01610C*------------------------------------------------------------------- 01620C TAG10 TAG 01630C J4,W LOKUPJ5,J 54 GET SCHED 01640C N54 GOTO START GET NEXT JOB 01650C* BUILD JOB PRINT LINE & REQD HRS. 01660C EXSR SR102 BUILD JOB 01670C EXSR SR72 PRINT JOB 01680C Z-ADD1 M 30 01690C*------------------------------------------------------------------- 01700C TAG30 TAG 01710C* GET MAN. 01720C J5,J LOKUPJ3,M 54 01730C N54 GOTO TAG40 MEN DONE 01740C S3,M COMP S5,J 54 01750C N54 GOTO TAG40 WRONG TASK 01760C* BUILD MAN HOURS. NET JOB HOURS. PRINT MAN. ÐÐ01770C EXSR SR103 PRINT MAN 01780C*------------------------------------------------------------------- 01790C TAG40 TAG 01800C 1 ADD M M 01810C M COMP 300 54 01820C N54 GOTO TAG30 GET NEXT MAN 01830C*------------------------------------------------------------------- 01840C TAG50 TAG 01850C 1 ADD J J 01860C J COMP 300 54 01870C N54 GOTO TAG10 GET NEXT SCHED 01880C GOTO START GET NEXT JOB 01890C*------------------------------------------------------------------- 01900C END TAG 01910C******************************************************************** 01920CSR SR69 BEGSR 01930C* PUT DATA TO DIABLO. 01940CSR PORT CHAINCRTFILE H9 01950CSR H9 GOTO T69A 01960CSR MOVE ' ' REC 01970CSR EXCPT UPDATE CRTFILE 01980CSR PORT CHAINCRTFILE H9 01990CSR H9 GOTO T69A 02000CSR MOVEAREC W132A 132 02010CSR EXITFZD132 PUT DIABLO ÐÐ02020CSR RLABL W132A 02030C*------------------------------------------------------------------- 02040CSR T69A TAG 02050CSR SETOF 727571 02060CSR SETOF 414243 02070CSR SETOF 74 02080CSR END69 ENDSR 02090C******************************************************************** 02100CSR SR71 BEGSR 02110C* PUT HEADING. 02120CSR LINENO COMP 66 54 54 02130CSRN54 GOTO END71 02140CSR EXSR SR203 TOP FORM 02150CSR SETON 7141 02160CSR EXSR SR69 02170CSR SETON 7142 02180CSR EXSR SR69 02190CSR SETON 7143 02200CSR EXSR SR69 02210CSR Z-ADD5 LINENO 02220CSR EXSR SR202 LF/CR 02230CSR END71 ENDSR 02240C******************************************************************** 02250CSR SR72 BEGSR 02260CSR EXSR SR71 PRINT HEADING ÐÐ02270CSR Z-ADD1 X 02280CSR S5,J LOKUPS6,X 54 02290CSR 54 MOVE T6,X TITLE 12 02300CSRN54 MOVE BLK12 TITLE 02310CSRN54 MOVELJ TITLE 02320CSR SETON 72 02330CSR EXSR SR69 PRINT JOB LINE 02340CSR ENDSR 02350C******************************************************************** 02360CSR SR74 BEGSR 02370C* PRINT JOB. 02380CSR EXSR SR71 PRINT HEADING 02390CSR Z-ADD1 X 30 02400CSR M3,M LOKUPM1,X 54 02410CSR 54 MOVE N1,X NAME 12 02420CSRN54 MOVE BLK12 NAME 02430CSRN54 MOVELM NAME 02440CSR Z-ADD1 X 02450CSR S3,M LOKUPS6,X 54 02460CSR 54 MOVE T6,X TITLE 12 02470CSRN54 MOVE BLK12 TITLE 02480CSRN54 MOVELM TITLE 02490CSR SETON 74 02500CSR EXSR SR69 PRINT MAN LINE 02510CSR ENDSR ÐÐ02520C******************************************************************** 02530CSR SR101 BEGSR 02540C* INIT 1-TIME 02550CSR SETON 79 02560CSR MOVE ' ' BLK12 12 02570CSR MOVE ' ' W8A 8 02580CSR Z-ADD0 W2N 20 02590CSR Z-ADD0 W1N 10 02600CSR MOVE ' ' W2A 2 02610CSR EXITFPGMINX 02620CSR RLABL W8A 02630CSR RLABL W2N 02640CSR RLABL W1N 02650CSR RLABL W2A 02660CSR MOVE W2A PORT 20 02670CSR PORT CHAINCRTFILE H9 02680CSR H9 GOTO END101 02690CSR MOVE ' ' REC 02700CSR SETON 76 02710CSR EXCPT INIT CRTFILE 02720CSR SETOF 76 02730CSR Z-ADD0 W2N 02740C*---------------------------------------------------------- 02750CSR T101A TAG 02760CSR W2N CHAINMDAYWE 54 ÐÐ02770CSR 54 GOTO T101B 02780CSR W4N COMP 88 54 54 02790CSRN54 GOTO T101A 02800CSR 1 ADD X X 02810CSR Z-ADDW4N MWE,X 02820CSR X COMP 90 54 54 02830CSRN54 GOTO T101A 02840C*--------------------------------------------------------- 02850CSR T101B TAG 02860CSR Z-ADD80 LINENO 30 02870CSR EXITFQBELL 02880CSR EXITFQBELL 02890CSR EXITFQBELL 02900CSR EXITFQPAUSE 02910CSR EXSR SR71 1ST PAGE HDG 02920CSR END101 ENDSR 02930C******************************************************************** 02940CSR SR102 BEGSR 02950C* BUILD JOB HOURS ARRAY. 02960CSR MOVE ' ' LIN PRINT ARRAY 02970CSR Z-ADD1 B 30 02980CSR Z-ADD1 E 30 02990CSR Z-ADD0 REQ 03000CSR B5,J LOKUPMWE,B 54 54 GET START DATE 03010CSRN54 Z-ADD90 B START INDEX ÐÐ03020CSR E5,J LOKUPMWE,E 54 54 GET STOP DATE 03030CSRN54 Z-ADD90 E 03040CSR E SUB B NOPER 30 54 NUMB PER 03050CSRN54 Z-ADD1 NOPER 03060CSR E5,J SUB B5,J NODAYS 40 54 NUMB DAYS 03070CSRN54 Z-ADD1 NODAYS 03080CSR H5,J MULT NODAYS TOTHRS 50H54 03090CSRN54 Z-ADD1 TOTHRS 03100CSR TOTHRS DIV NOPER PERHRS 40H54 HRS EA PERIOD 03110CSRN54 Z-ADD1 PERHRS 03120CSR Z-ADDPERHRS REQ,B 1ST PER HRS 03130CSR TOTHRS MULT P5,J DONE 50H COMPLETED HRS 03140C*------------------------------------------------------------------- 03150CSR T102A TAG 03160CSR REQ,B COMP DONE 545556 NET CMPLTD HRS 03170CSR 54 REQ,B SUB DONE REQ,B 57 58 03180CSR 54 Z-ADD0 DONE 03190CSR 55 DONE SUB REQ,B DONE 03200CSR 55 Z-ADD0 REQ,B 57 58 03210CSR 56 Z-ADD0 REQ,B 57 58 03220CSR 56 Z-ADD0 DONE 03230CSR 57 MOVE '+' LIN,B 03240CSRN57 MOVE '-' LIN,B 03250CSR 58 MOVE ' ' LIN,B 03260CSR 1 ADD B B ÐÐ03270CSR B COMP E 54 03280CSRN54 Z-ADDPERHRS REQ,B 03290CSRN54 GOTO T102A 03300CSR ENDSR 03310C******************************************************************** 03320CSR SR103 BEGSR 03330C* BUILD MAN HOURS. NET JOB. PRINT MAN. 03340CSR EXSR SR205 BUILD MAN HRS 03350CSR EXSR SR74 PRINT MAN 03360CSR EXSR SR206 NET HRS 03370CSR ENDSR 03380C******************************************************************** 03390CSR SR202 BEGSR 03400C* LINE FEED/CAR RET. 03410CSR EXITFQCLFCR 03420CSR 1 ADD LINENO LINENO 30 03430CSR ENDSR 03440C******************************************************************** 03450CSR SR203 BEGSR 03460C* TOP OF FORM. 03470CSR EXITFZTFORM TOP FORM 03480CSR ENDSR 03490C******************************************************************** 03500CSR SR205 BEGSR 03510C* BUILD MAN HOURS ARRAY. ÐÐ03520CSR MOVE ' ' LIN PRINT ARRAY 03530CSR Z-ADD0 HRS HOURS ARRAY 03540CSR Z-ADD1 B 30 START INDEX 03550CSR Z-ADD1 E 30 STOP INDEX 03560CSR B3,M LOKUPMWE,B 54 54 GET START DATE 03570CSRN54 Z-ADD90 B 03580CSR E3,M LOKUPMWE,E 54 54 GET STOP DATE 03590CSRN54 Z-ADD90 E 03600CSR E SUB B NOPER 54 NUMB PERIODS 03610CSRN54 Z-ADD1 NOPER 03620CSR E3,M SUB B3,M NODAYS 54 NUMB DAYS 03630CSRN54 Z-ADD1 NODAYS 03640CSR H3,M MULT NODAYS TOTHRS H54 TOTAL HOURS 03650CSRN54 Z-ADD1 TOTHRS 03660CSR TOTHRS DIV NOPER PERHRS H54 HOURS EA PERIOD 03670CSRN54 Z-ADD1 PERHRS 03680CSR P3,M MULT TOTHRS DONE H COMPLETED HRS 03690CSR Z-ADDPERHRS HRS,B 1ST PER HRS 03700C*------------------------------------------------------------------- 03710CSR T205A TAG 03720CSR HRS,B COMP DONE 545556 NET CMPLTD HRS 03730CSR 54 HRS,B SUB DONE HRS,B 57 58 03740CSR 54 Z-ADD0 DONE 03750CSR 55 DONE SUB HRS,B DONE 03760CSR 55 Z-ADD0 HRS,B 57 58 ÐÐ03770CSR 56 Z-ADD0 HRS,B 57 58 03780CSR 56 Z-ADD0 DONE 03790CSR 57 MOVE '+' LIN,B 03800CSRN57 MOVE '-' LIN,B 03810CSR 58 MOVE ' ' LIN,B 03820CSR 1 ADD B B 03830CSR B COMP E 54 03840CSRN54 Z-ADDPERHRS HRS,B 03850CSRN54 GOTO T205A 03860CSR ENDSR 03870C******************************************************************** 03880CSR SR206 BEGSR 03890C* GET MAN HRS/JOB HRS. 03900CSR Z-ADD1 B START INDEX 03910CSR MOVE ' ' LIN 03920C*------------------------------------------------------------------- 03930CSR T206A TAG 03940CSR REQ,B COMP 0 54 03950CSRN54 HRS,B COMP 0 54 03960CSRN54 GOTO T206B NO HRS 03970CSR REQ,B COMP HRS,B 545556 03980CSR 54 REQ,B SUB HRS,B REQ,B 03990CSR 54 Z-ADD0 HRS,B 04000CSR 55 HRS,B SUB REQ,B HRS,B 04010CSR 55 Z-ADD0 REQ,B ÐÐ04020CSR 56 Z-ADD0 REQ,B 04030CSR 56 Z-ADD0 HRS,B 04040CSR 54 MOVE '+' LIN,B 04050CSR 55 MOVE '-' LIN,B 04060C*------------------------------------------------------------------- 04070CSR T206B TAG 04080CSR 1 ADD B B 04090CSR B COMP 90 54 04100CSRN54 GOTO T206A 04110CSR ENDSR 04120O******************************************************************** 04130OCRTFILE E 71 41 04140O* HEADING-1. 04150O REC 212 04160O 127 'J O B' 04170O 145 'O V E R V I E W' 04180O*------------------------------------------------------------------- 04190O E 71 42 04200O* HEADING-2. 04210O REC 212 04220O 97 'JOB-DESCR' 04230O 126 '1' 04240O 136 '2' 04250O 146 '3' 04260O 156 '4' ÐÐ04270O 166 '5' 04280O 176 '6' 04290O 186 '7' 04300O 196 '8' 04310O 206 '9' 04320O*------------------------------------------------------------------- 04330O E 71 43 04340O* HEADING-3. 04350O REC 212 04360O 84 'JOB#' 04370O 99 'OR MAN-NAME' 04380O 106 'TASK' 04390O TEN 126 04400O TEN 136 04410O TEN 146 04420O TEN 156 04430O TEN 166 04440O TEN 176 04450O TEN 186 04460O TEN 196 04470O TEN 206 04480O*------------------------------------------------------------------- 04490O E 72 04500O* JOB DATA. 04510O REC 212 ÐÐ04520O W4,W 86 04530O D4,W 100 04540O TITLE 114 04550O LIN 212 04560O*------------------------------------------------------------------- 04570O E 74 04580O* MAN DATA. 04590O REC 212 04600O NAME 86 04610O TITLE 100 04620O LIN 212 04630O*------------------------------------------------------------------- 04640O E 75 04650O* BALANCE LINE. 04660O REC 212 04670O 109 'BALANCE' 04680O LIN 212 04690O*------------------------------------------------------------------- 04700O E 76 04710O REC 212 ** MWE ARRAY 004720 004730** HED ARRAY 004740 004750** REQ ARRAY 004760ÐÐ 004770** HRS ARRAY 004780 004790** LIN ARRAY 004800 004810** TEN ARRAY 0048201234567890 004830/* 004840_‚ ÐÐ_‚_‚ 004770** HRS ARRAY 004780 004790** LIN ARRAY 004800 004810** TEN ARRAY 0048201234567890 004830/* 004840_‚ ÐÈ(È[– ÈTX004EJ P120282120282(èÈÐ00010H Q004EJ00020F* USER ONLY DISPLAY JOB MENU.(X004EJ) 00030F* REVISED 3-10-81 4:30 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FEMPLFILEID F 64L14AI 1 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FTERM75 O F 75 5 00090E******************************************************************** 00100E NUL 1 75 1 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160IEMPLFILEEE 00170I* RECORD CODE 1A 00180I* J = EMPLOYEE/JOB 00190I 1 1 EJREC 00200I* EMPLOYEE # 5N 00210I 2 60EJEMPL 00220I* SEQUENCE # 3N 00230I 7 90EJSEQ 00240I* DESCRIPTION 35A 00250I 15 49 EJDESC ÐÐ00260I* JOB CODE 6A 00270I 50 55 EJJOB 00280I* RECORD STATUS 1A 00290I 64 64 EJSTAT 00300I******************************************************************** 00310ICRTFILE CR 00320I 1 5 CREMPL 00330I 6 13 CRUSER 00340I 14 180CRDEPT 00350I******************************************************************** 00360IMGFILE MG 00370I* MESSAGE FILE 00380I* TEXT 35A 00390I 1 35 MGTEXT 00400I* LINE-2 35A 00410I 36 70 MGLIN2 61 00420I* PROG NAME 5A 00430I 71 75 MGPROG 00440C******************************************************************** 00450C* INITIALIZE, CLEAR SCREEN 00460C 79 GOTO START 00470C SETON 79 00480C MOVE BLK35 W8A 8 00490C Z-ADD0 W2N 20 00500C Z-ADD0 W1N 10 ÐÐ00510C MOVE ' ' W2A 2 00520C EXITFPGMINX 00530C RLABL W8A 00540C RLABL W2N 00550C RLABL W1N 00560C RLABL W2A 00570C MOVE W2A PORT 20 00580C PORT COMP 0 54 00590C N54 Z-ADD25 PORT 00600C PORT CHAINCRTFILE H9 00610C H9 GOTO END 00620C CRDEPT COMP 840 89 DP DEPT NO. 00630C MOVE BIT,1 NUL 00640C MOVELBIT,1 BUFLGT 2 00650C MOVE BIT,2 BUFLGT 00660C MOVE ' ' BLK35 35 00670C EXITFQTOPF CLEAR CRT 00680C SETON 70 00690C EXCPT 00700C SETOF 70 00710C* SET-UP 1ST READ. 00720C MOVE BLK35 W14A 14 00730C MOVEL'J' W6A 6 00740C MOVE CREMPL W6A 00750C MOVELW6A W14A ÐÐ00760C W14A SETLLEMPLFILE 00770C*------------------------------------------------------------------- 00780C START TAG 00790C* GET NEXT EMPLOYEE RECORD. 00800C SETOF 54 00810C READ EMPLFILE 54 00820C 54 SETON LR 00830C 54 GOTO END 00840C EJREC COMP 'J' 54 00850C N54 SETON LR 00860C N54 GOTO END 00870C MOVE EJEMPL W5A 5 00880C W5A COMP CREMPL 54 00890C N54 SETON LR 00900C N54 GOTO END 00910C EJSTAT COMP 'D' 54 00920C 54 GOTO START 00930C COUNT COMP 28 54 54 00940C N54 GOTO NOHALT 00950C SETON 71 00960C EXCPT PAUSE. 00970C SETOF 71 00980C MOVE ' ' W2A 2 00990C EXITFQWREED READ TERM 01000C RLABL W2A ÐÐ01010C RLABL BUFLGT 01020C Z-ADD2 COUNT 01030C MOVELW2A W1A 1 01040C W1A COMP '\' 54 01050C N54 MOVE W2A W1A 01060C N54 W1A COMP '\' 54 01070C N54 GOTO NOHALT 01080C SETON LR 01090C*------------------------------------------------------------------- 01100C NOHALT TAG 01110C 1 ADD COUNT COUNT 50 01120C*------------------------------------------------------------------- 01130C END TAG 01140C NLR SETON 73 01150C NLR EXCPT 01160C SETOF 73 01170C NLR GOTO START 01180CLR SETON 72 01190CLR EXCPT 01200CLR SETOF 72 01210CLR MOVE ' ' W2A 01220CLR EXITFQWREED READ TERM 01230CLR RLABL W2A 01240CLR RLABL BUFLGT 01250CLR MOVEL'QQDP03' PROG 8 ÐÐ01260CLR EXITFCHAIN 01270CLR RLABL PROG 01280O******************************************************************** 01290OTERM75 E 70 01300O* PUT HEADING. 01310O BIT,28 1 01320O 2 '8' 01330O 8 '001055' 01340O 26 'LIST EMPLOYEE MENU' 01350O BIT,11 75 01360O*------------------------------------------------------------------- 01370O E 73 01380O* LIST EMPLOYEES. 01390O EJEMPLZ 5 01400O EJSEQ Z 12 01410O EJDESC 50 01420O 89 EJJOB 65 01430O*------------------------------------------------------------------- 01440O E 71 01450O* PAUSE. 01460O NUL 75 01470O 12 'CONTINUED...' 01480O 14 ' ' 01490O*------------------------------------------------------------------- 01500O E 72 ÐÐ01510O NUL 75 01520O BIT,11 1 01530O 20 'PRESS "CR" FOR MENU' 01540O 22 ' ' ** NUL ARRAY 001550 001560/* 001570_‚ ÐÐ ÐÐ_‚_‚ ÐÈ([ë  ZEG026 Pú999999120282(èÈÐ * ZEG026 - PRINT MFR/DYNAIR PART NO. LIST 00010INPUT=ZEG026 00020UTIL 00030DEFINE,FN=MFRPNEG,VL=D1,TYPE=S,LR=40,NR=16000 00040EX 00050 * CREATE CROSS-REF FILE. 00060Q025EG 00070INPUT=ZEG026 00080DSORT 00090FN=MFRPNEG, 00100F2=EGADRT, ,D1 00110OP=ADDR,F,A 00120KF=A,1,20,A,21,14 00130SL=I 00140 * NOTE: THE PROGRAM Q026EG REQUIRES STARTING PN AND PAGE INPUT 00150 * IF SWITCH-3 IS ON. 00160 * 00170 * PRINT MFR/DYNAIR PART NO. LIST 00180Q026EG 00190INPUT=ZEG026 00200UTIL 00210DELETE,FN=MFRPNEG 00220DELETE,FN=EGADRT 00230EX 00240 * END ZEG026 00250ÐÐ_‚_‚EG026 - PRINT MFR/DYNAIR PART NO. LIST 00010INPUT=ZEG026 00020UTIL 00030DEFINE,FN=MFRPNEG,VL=D1,TYPE=S,LR=40,NR=16000 00040EX 00050 * CREATE CROSS-REF FILE. 00060Q025EG 00070INPUT=ZEG026 00080DSORT 00090FN=MFRPNEG, 00100F2=EGADRT, ,D1 00110OP=ADDR,F,A 00120KF=A,1,20,A,21,14 00130SL=I 00140 * NOTE: THE PROGRAM Q026EG REQUIRES STARTING PN AND PAGE INPUT 00150 * IF SWITCH-3 IS ON. 00160 * 00170 * PRINT MFR/DYNAIR PART NO. LIST 00180Q026EG 00190INPUT=ZEG026 00200UTIL 00210DELETE,FN=MFRPNEG 00220DELETE,FN=EGADRT 00230EX 00240 * END ZEG026 00250ÐÈ(ý[÷ ý?X220SF P999999120282(èÈÐ00010H Q220SF00020F* LIST SCHEDULE FILE (SFMAST) (ALL) (X220SF) **** D I A B L O **** 00030F* REVISED 4/19/82 2:00 PM. 00040F* NOTE : MOST CHANGES MADE TO THIS PROGRAM SHOULD ALSO BE MADE TO X102SF.00050F* 00060FSFMAST IP F 128 29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FCRTFILE UC F 256R DISK 00090FMGFILE IC F 80R DISK 00100FCALENDARIC F 22R 7AI 1 DISK 00110FCMMAST IC F 576R 5AI 1 DISK 00120E******************************************************************** 00130E TABSC 1 6 2 TABSCN 15 00140E PM$ 7 9 3 MFG $ FILE 00150E PLT 8 3 0 LEAD TIMES 00160E REC 132 1 00170I********************************************************************** 00180ICRTFILE CR 00190I 68 73 CRRET 00200I 74 79 CRMENU 00210I 81 212 REC 00220I******************************************************************** 00230ISFMAST SF 28 128NCD 00240I* SCHEDULE MASTER. 00250I* COMMON FIELDS. ÐÐ00260I* KEY AREA. 00270I 1 29 SFKEY 00280I* PART NO. 10N 00290I 1 100SFPN L4 00300I* DATE DUE 6N (YMD) 00310I 11 160SFDUE L3 00320I* RECORD CODE 2N 00330I* 10 = RECEIVED PO 00340I* 20 = REL WO 00350I* 30 = PURCHASE ORDER 00360I* 40 = PLAN WO 00370I* 50 = PURCHASE REQ 00380I* 60 = SALES ORDER-BACKLOG 00390I* 70 = REL REQUIREMENT 00400I* 80 = PLAN REQUIREMENT 00410I* 90 = RUN RELEASE 00420I 17 180SFREC L2 00430I* ORDER NO. 00440I 19 29 SFORD L1 00450I* PREFIX 1A 00460I 19 19 SFPRFX 00470I* PRIME 5N 00480I 19 24 SFPRIM 00490I* DASH 3N 00500I 25 270SFDASH ÐÐ00510I* RECEIVING LOG 2N 00520I 28 290SFRLOG 00530I* QUANTITY 7P 00540I P 30 330SFQTY 00550I* QTY COMPLETE 7P 00560I P 34 370SFQTYC 00570I* DATE LAST TRAN 6N (YMD) 00580I 38 430SFDLT 00590I* CUST #/DEPT #/VEND # 5P 00600I P 44 460SFCUST 00610I* VARIABLE AREA. 00620I* PLAN/REL REQMTS 00630I* NEXT ASSY PART # 10N 00640I 47 560SFNAPN 00650I* QTY PER ASSY 7P 00660I P 57 600SFQPA 00670I* ISSUE CODE 2A 00680I 61 62 SFISSU 00690I* PULL # 3P 00700I P 63 640SFPULL 00710I* ASSY REVISION 2A 00720I 65 66 SFREV 00730I* ASSY WO QTY 7P 00740I 67 700SFQTYA 00750I* SALES ORDERS ÐÐ00760I* PRICE CODE 1A 00770I* SEE WORK ORDERS. 00780I* CUST P.O. 20A 00790I 71 90 SFCPO 00800I* UNIT PRICE 9.3P 00810I P 91 953SFPRIC 00820I* PURCH ORDERS 00830I* PRICE CODE 1A 00840I* SEE WORK ORDERS. 00850I* VENDOR NAME 20A 00860I* SEE SFCPO UNDER SALES ORDERS. 00870I* UNIT PRICE 9.3P 00880I* SEE SFPRIC UNDER SALES ORDERS. 00890I* PACKING SLIP 9A 00900I* 96 104 SFPKGS 00910I* WORK ORDERS 00920I* DEPT NAME 20A 00930I* SEE SFCPO UNDER SALES ORDERS. 00940I* OPER SEQ # 3P 00950I P 96 970SFSEQ 00960I* START DATE 6N 00970I 98 1030SFSTRT 00980I* PULL # 3P 00990I* SEE PLAN/REL REQMTS. 01000I* PRICE CODE 1A ÐÐ01010I 105 105 SFPCOD 01020I* BACKORDER FLAG 1A (B=BO) 01030I 106 106 SFBOF 01040I* REVISION 2A 01050I* SEE PLAN/REL REQMTS. 01060I* RECORD STATUS 1A 01070I 128 128 SFSTAT 01080I*------------------------------------------------------------------- 01090I GG 29 01100I* GARBAGE 01110I******************************************************************** 01120IPMMST2 PM 01130I 1 100PMPN 01140I 15 180PMPL 01150I 19 30 PMMODL 01160I 31 59 PMDESC 01170I 70 71 PMECHG 01180I 94 95 PMSC 01190I P 113 128 PLT 01200I P 163 1660PMSSTK 01210I P 245 279 PM$ 01220I P 311 3140PMOHB 01230I P 489 4933PMOSUC 01240I 674 674 PMSTAT 01250I******************************************************************** ÐÐ01260IMGFILE MG 01270I 1 35 MGTEXT 01280I******************************************************************** 01290ICALENDARCA 20 1 CC 01300I* CALENDAR DATE RECORD. 01310I 2 30CAYR 01320I 4 50CAMO 01330I 6 70CADAY 01340I 14 170CAMDAY 01350I 18 200CAWK 01360I 21 220CADOW 01370I*------------------------------------------------------------------- 01380I CB 21 1 CM 01390I* MFG DATE RECORD. 01400I 4 70CAMDAY 01410I 8 90CAYR 01420I 10 110CAMO 01430I 12 130CADAY 01440I 18 200CAWK 01450I 21 220CADOW 01460I*------------------------------------------------------------------- 01470I GG 22 01480I******************************************************************** 01490ICMMAST CM 01500I* CUSTOMER MASTER ÐÐ01510I* CUST NAME 35A 01520I 26 60 CMNAME 01530C******************************************************************** 01540C* INITIALIZE. 01550C N69 EXSR SR101 INIT 01560C N28 GOTO END DELETED 01570C L4 Z-ADD0 AVAIL 70 OVERALL AVAIL BAL 01580C L4 SETOF 68 ACTIVITY FLAG 01590C L4 Z-ADD0 SAVAIL 70 AVAIL STOCK BAL 01600C SFQTY SUB SFQTYC QTYBAL 70 28 01610C N28 GOTO END COMPLETED RECORD 01620C N68 EXSR SR102 DISPLAY PART MASTER 01630C 30 SETOF 28 01640C 30 GOTO END NOT ON FILE 01650C EXSR SR103 CLASSIFY SFMAST 01660C 13 Z-ADDSFQPA QPA5 50 QTY PER ASSY (CRT) 01670C 06 SFCUST CHAINCMMAST 54 GET CUSTOMER MAST 01680C 06N54 MOVELCMNAME SFCPO CUST NAME 01690C EXSR SR72 PUT DATA 01700C SETON 68 ACTIVITY FLAG 01710C*------------------------------------------------------------------- 01720C END TAG 01730C* PUT TOTALS. 01740CL4 68 AVAIL COMP 0 55 LESS THAN 01750CL4 68 SETON 76 ÐÐ01760CL4 68 EXSR SR79 PRINT TOTALS 01770C*------------------------------------------------------------------- 01780CLR ENDJOB TAG 01790CLR EXSR SR68 TOP FORM 01800C******************************************************************** 01810CSR SR67 BEGSR 01820CSR EXITFQCLF LF 01830CSR 1 ADD COUNT COUNT 30 01840CSR ENDSR 01850C******************************************************************* 01860CSR SR68 BEGSR 01870CSR EXITFZTFORM TOP OF FORM 01880CSR Z-ADD1 COUNT 01890CSR ENDSR 01900C****************************************************************** 01910CSR SR69 BEGSR 01920C* CHECK END PAGE 01930CSR 1 ADD COUNT W3N 30 01940CSR XTRA ADD W3N W3N 01950CSR Z-ADD0 XTRA 30 01960CSR W3N COMP 80 54 54 01970CSRN54 GOTO END69 01980CSR EXSR SR71 PUT HEADINGS 01990CSR 68 EXSR SR74 PUT PART MASTER 02000CSR 68 SETON 48 ÐÐ02010CSR 68 EXSR SR79 PRINT CONT'D LINE 02020CSR END69 ENDSR 02030C******************************************************************** 02040CSR SR71 BEGSR 02050C* PUT HEADING. 02060CSR EXSR SR68 TOP OF FORM 02070CSR SETON 41 02080CSR EXSR SR79 HDG-1 02090CSR EXSR SR67 LF 02100CSR SETON 42 02110CSR EXSR SR79 HDG-2 02120CSR SETON 43 02130CSR EXSR SR79 HDG,3 02140CSR SETON 44 02150CSR EXSR SR79 HDG-4 02160CSR EXSR SR67 LF 02170CSR ENDSR 02180C******************************************************************** 02190CSR SR72 BEGSR 02200C* PUT DATA LINE. 02210CSR 10 QTYBAL ADD ORDBAL ORDBAL 70 02220CSR 11 QTYBAL ADD REQBAL REQBAL 70 02230CSR 10 Z-ADDQTYBAL QTYORD 70 02240CSR 11 Z-ADDQTYBAL QTYREQ 70 02250CSR ORDBAL ADD STKQTY AVAIL 70 ÐÐ02260CSR AVAIL SUB REQBAL AVAIL 02270CSR SAVAIL SUB REQBAL SAVAIL 02280CSR EXSR SR204 DATES/$ 02290CSR EXSR SR69 CHECK END PAGE 02300CSR SFDASH COMP 0 56 02310CSR SETON 72 02320CSR EXSR SR79 PUT DATA 02330CSR EXSR SR104 COMPUTE EXCEPTIONS 02340CSR END72 ENDSR 02350C******************************************************************** 02360CSR SR73 BEGSR 02370C* PUT MESSAGE. 02380CSR M CHAINMGFILE 54 02390CSR 54 MOVE BLK35 MGTEXT 02400CSR 54 MOVEL'??????' MGTEXT 02410CSR SETON 73 02420CSR EXSR SR79 PUT MSG 02430CSR SETOF 96 02440CSR EXSR SR69 CHECK END PAGE 02450CSR ENDSR 02460C******************************************************************** 02470CSR SR74 BEGSR 02480C* PUT PART MAST LINE. 02490CSR SETON 74 02500CSR EXSR SR79 PUT PMMST2 TO CRT ÐÐ02510CSR ENDSR 02520C******************************************************************** 02530CSR SR79 BEGSR 02540C* PRINT ROUTINE. 02550CSR EXSR SR81 GET CRTFILE 02560CSR 54 GOTO ENDJOB ERROR 02570CSR MOVE ' ' REC 02580CSR EXCPT UPDATE CRTFILE 02590CSR SETOF 414243 02600CSR SETOF 447471 02610CSR SETOF 4748 02620CSR SETOF 767273 02630CSR SETOF 81 02640CSR 89 GOTO END79 02650CSR EXSR SR67 LF 02660CSR EXSR SR81 GET CRTFILE 02670CSR MOVEAREC W148A 148 02680CSR EXITFZD148 PRINT 02690CSR RLABL W148A 02700C*------------------------------------------------------------------ 02710CSR END79 TAG 02720CSR SETOF 89 02730CSR ENDSR 02740C******************************************************************** 02750CSR SR81 BEGSR ÐÐ02760CSR PORT CHAINCRTFILE 54 02770CSR ENDSR 02780C******************************************************************** 02790CSR SR101 BEGSR 02800C* 1-TIME INITIALIZE. 02810CSR SETON 69 02820CSR TIME TIME 60 02830CSR EXITFQLF8 SET 8LPI 02840CSR MOVE ' ' BLK35 35 02850CSR MOVE ' ' BLK12 12 02860CSR Z-ADDUDATE W6N 60 02870CSR EXSR SR205 02880CSR Z-ADDCAMDAY TODAY 40 CUR MDAY DATE 02890CSR Z-ADDW6N CURCAL 60 CUR CAL DATE 02900CSR MOVE ' 'W8A 8 02910CSR Z-ADD0 W2N 20 02920CSR Z-ADD0 W1N 10 02930CSR MOVE ' ' W2A 2 02940CSR EXITFPGMINX GET PORT# 02950CSR RLABL W8A 02960CSR RLABL W2N 02970CSR RLABL W1N 02980CSR RLABL W2A 02990CSR MOVE W2A PORT 20 03000CSR PORT COMP 0 54 ÐÐ03010CSRN54 Z-ADD25 PORT 03020CSR SETON 81 03030CSR EXSR SR79 SET PRINTER MSG 03040CSR EXITFQPAUSE PAUSE 03050CSR MOVE ' ' BLK29 29 03060CSR EXSR SR71 PUT HEADING 03070CSR ENDSR 03080C******************************************************************** 03090CSR SR102 BEGSR 03100C* DISPLAY PART MASTER. 03110CSR Z-ADD0 AVAIL 03120CSR Z-ADD0 ORDBAL 03130CSR Z-ADD0 REQBAL 03140CSR MOVE BLK12 SCNAME 15 03150CSR MOVELSFPN W12A 12 03160CSR MOVE ' ' W12A 03170CSR W12A CHAINPMMST2 30 03180CSRN30 PMSTAT COMP 'D' 30 03190CSR 30 GOTO END102 03200CSR PMMODL COMP BLK12 54 03210CSR 54 MOVEL'MODEL' W18A 18 03220CSR 54 MOVE PMMODL W18A 03230CSR 54 MOVE BLK35 PMDESC 03240CSR 54 MOVELW18A PMDESC 03250CSR PMSC LOKUPTABSC TABSCN 54 ÐÐ03260CSR 54 MOVE TABSCN SCNAME 03270CSR Z-ADDPMOHB STKQTY 70 54 03280CSRN54 Z-ADD0 STKQTY 03290CSR Z-ADDSTKQTY BOSTK 70 STK FOR BACKORDERS 03300CSR Z-ADDSTKQTY AVAIL OVERALL AVAIL BAL 03310CSR Z-ADDAVAIL SAVAIL 70 AVAIL STOCK BAL 03320CSR XFOOTPLT LEAD 30 03330CSR EXSR SR203 CALC COST 03340CSR Z-ADD3 XTRA 03350CSR AVAIL COMP 0 55 LESS THAN 03360CSR 55 1 ADD XTRA XTRA 03370CSR EXSR SR69 CHK END PAGE 03380CSR EXSR SR67 LF 03390CSR EXSR SR74 PUT PART MASTER 03400CSR 68 SETON 48 03410CSR 68 EXSR SR79 PUT CONTD LINE 03420CSR PMSSTK COMP 0 54 03430CSRN54 GOTO T102Z 03440CSR Z-ADDPMSSTK REQBAL 03450CSR AVAIL SUB PMSSTK AVAIL 03460CSR Z-ADDAVAIL SAVAIL 03470CSR SETON 47 03480CSR EXSR SR79 PUT SAFETY STOCK 03490CSR GOTO T102Z 03500C*------------------------------------------------------------------- ÐÐ03510CSR T102Z TAG 03520CSR PMOHB COMP 0 54 54 03530CSRN54 Z-ADD630 M 50 96 03540CSRN54 EXSR SR73 FLAG NEG ON HAND 03550CSR END102 ENDSR 03560C******************************************************************** 03570CSR SR103 BEGSR 03580C* CLASSIFY SFMAST RECORD. 03590CSR SETOF 101112 03600CSR SETOF 131415 03610CSR SETOF 161718 03620CSR SFREC COMP 10 01 RPO 03630CSR SFREC COMP 20 02 RWO 03640CSR SFREC COMP 30 03 PO 03650CSR SFREC COMP 40 04 PWO 03660CSR SFREC COMP 50 05 PURREQ 03670CSR SFREC COMP 60 06 SO 03680CSR SFREC COMP 70 07 RREQ 03690CSR SFREC COMP 80 08 PREQ 03700CSR SFREC COMP 90 09 FORECAST 03710CSR 01 03720COR 02 03730COR 03 03740COR 04 03750COR 05 SETON 10 ORDER ÐÐ03760CSRN10 SETON 11 REQMT 03770C* FLAG PROD REQMTS. 03780CSR 07 REL REQ 03790COR 08 SETON 13 PLN REQ 03800C* FLAG PUR ORD. 03810CSR 01 RPO 03820COR 03 PO 03830COR 05 SETON 12 PUR REQ 03840C* FLAG WO. 03850CSR 02 REL WO 03860COR 04 SETON 14 PLN WO 03870C* FLAG USES CPO FIELD. 03880CSR 02 REL WO 03890COR 12 PO'S 03900COR 06 SETON 15 SO'S 03910C* FLAG USES PRICE FIELD. 03920CSR 15N14 SETON 16 03930C* FLAG WORK ORDER OR WO/REQMT. 03940CSR 13 REQUIREMENT 03950COR 14 SETON 17 WORK ORDER 03960CSR 01 RPO 03970COR 06 SETON 18 USES LOG # 03980CSR ENDSR 03990C******************************************************************** 04000CSR SR104 BEGSR ÐÐ04010C* PUT EXCEPTION MESSAGES. 04020CSR TODAY COMP MDUE 54 04030CSR 01 RECD PO 04040COR 04 PLAN WO 04050COR 08 PLANNED REQMT 04060CORN54 GOTO T104A NOT PAST DUE 04070CSRN09 Z-ADD518 M 96 04080CSR 96 EXSR SR73 FLAG PAST DUE 04090CSR 09 Z-ADD520 M 96 04100CSR 09 EXSR SR73 FLAG NOT SOLD 04110C*------------------------------------------------------------------- 04120CSR T104A TAG 04130CSRN04N08 GOTO T104B NOT PLN WO 04140CSR 04 CURCAL COMP SFSTRT 54 04150CSR 08 CURCAL COMP SFDUE 54 04160CSRN54 GOTO T104B START DATE OK 04170CSR Z-ADD521 M 04180CSR EXSR SR73 FLAG NOT REL 04190C*------------------------------------------------------------------- 04200CSR T104B TAG 04210CSRN05 GOTO T104C NOT PUR REQ 04220CSR TODAY ADD LEAD W4N 40 04230CSR W4N COMP SFDUE 54 04240CSRN54 GOTO T104C LT OK 04250CSR Z-ADD522 M FLAG NOT ENOUGH ÐÐ04260CSR EXSR SR73 LEAD TIME. 04270C*------------------------------------------------------------------- 04280CSR T104C TAG 04290CSRN05 GOTO T104D NOT PUR REQ 04300CSR TODAY SUB SFDLT DIF 40 04310CSR DIF COMP 5 54 04320CSRN54 GOTO T104D 04330CSR 05 Z-ADD524 M FLAG NOT PLACED 04340CSR EXSR SR73 04350C*------------------------------------------------------------------- 04360CSR T104D TAG 04370CSRN06 GOTO END104 04380CSR SFQTYC COMP 0 54 04390CSR 54 MOVE 'B' SFBOF 04400CSRN54 SFBOF COMP 'B' 54 04410CSRN54 GOTO END104 04420CSR Z-ADD565 M FLAG BACKORDER 04430CSR EXSR SR73 04440CSR BOSTK COMP 0 54 04450CSR 54 Z-ADD519 M 96 04460CSR 54 EXSR SR73 FLAG NOT ISSUED 04470CSR BOSTK SUB QTYREQ BOSTK 04480CSR END104 ENDSR 04490C******************************************************************** 04500CSR SR202 BEGSR ÐÐ04510C* R. ADJUST. 04520CSR Z-ADD12 W2N 20 04530CSR EXIT SUBRAJ R. ADJUST 04540CSR RLABL W2N 04550CSR RLABL W12A 04560CSR ENDSR 04570C******************************************************************** 04580CSR SR203 BEGSR 04590C* CALC PART MAST COST, EXTEND BY ON HAND, IF ANY. 04600CSR XFOOTPM$ TOTCST 93 04610CSR PMOHB MULT TOTCST TOTCST 54 04620CSRN54 XFOOTPM$ TOTCST 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR204 BEGSR 04660C* CONVERT CAL DATES TO MDAYS. 04670CSR Z-ADDSFDUE W6N 04680CSR EXSR SR205 04690CSR Z-ADDCAMDAY MDUE 40 DUE DATE 04700C* CALC LINE ITEM COST. 04710CSR ENDSR 04720C******************************************************************** 04730CSR SR205 BEGSR 04740C* GET MDAYS. 04750CSR MOVELW6N W2N ÐÐ04760CSR W2N COMP 12 54 04770CSR 54 GOTO T205A 04780CSR MOVELW6N W4N 04790CSR MOVE W6N W2N 04800CSR MOVELW2N W6N 04810CSR MOVE W4N W6N 04820C*------------------------------------------------------------------- 04830CSR T205A TAG 04840CSR MOVEL'C' W7A 7 04850CSR MOVE W6N W7A 04860CSR W7A CHAINCALENDAR 54 04870CSR ENDSR 04880O******************************************************************** 04890OCRTFILE E 41 04900O REC 212 04910O 134 'I N V E N T O R Y' 04920O 148 'S T A T U S' 04930O 154 'B Y' 04940O 170 'P A R T N O.' 04950O UDATE Y 88 04960O TODAY 95 04970O TIME 106 ' : : ' 04980O 207 'PAGE' 04990O PAGE Z 212 05000O*------------------------------------------------------------------- ÐÐ05010O E 42 05020O REC 212 05030O 126 'VENDOR' 05040O*------------------------------------------------------------------- 05050O E 43 05060O REC 212 05070O 128 'CUSTOMER' 05080O 155 'COST/PRICE' 05090O 170 'QUANTITY' 05100O 180 'QUANTITY' 05110O 191 'QUANTITY' 05120O 201 'SCHEDULE' 05130O 211 'AVAILABLE' 05140O*------------------------------------------------------------------- 05150O E 44 05160O REC 212 05170O 88 'PART-NO.' 05180O 105 'DESCRIPTION' 05190O 118 'ORDER-NO.' 05200O 140 'ASSY PART-NO,QTY-PER' 05210O 159 'REV,START-DATE' 05220O 169 'ON-HAND' 05230O 180 'ON-ORDER' 05240O 191 'REQUIRED' 05250O 199 'DATE' ÐÐ05260O 210 'BALANCE' 05270O*------------------------------------------------------------------- 05280O E 74 05290O REC 212 05300O PMPN 92 ' - - ' 05310O PMDESC 123 05320O SCNAME 135 05330O PMECHG 149 05340O PMOSUC2 160 05350O PMOHB J 171 05360O AVAIL J 212 05370O*------------------------------------------------------------------- 05380O E 47 05390O REC 212 05400O 106 'SAFETY STOCK' 05410O PMSSTKJ 191 05420O AVAIL J 212 05430O*------------------------------------------------------------------ 05440O E 48 05450O REC 212 05460O 92 '...CONT''D' 05470O*------------------------------------------------------------------- 05480O E 72 05490O REC 212 05500O 01 101 'RECD-PO' ÐÐ05510O 02 100 'REL-WO' 05520O 03 103 'PUR-ORDER' 05530O 04 101 'PLAN-WO' 05540O 05 103 'PURCH-REQ' 05550O 06 105 'SALES-ORDER' 05560O 07 103 'BACKORDER' 05570O 08 104 'PLAN-REQMT' 05580O 09 102 'FORECAST' 05590O N09 SFPRIM 112 05600O N09 113 '-' 05610O N09 SFDASH 116 05620O 18 117 '-' 05630O 18 SFRLOG 119 05640O N13 SFCUSTZ 125 05650O 13 SFNAPN 132 ' - - ' 05660O 17 SFREV 149 05670O 13 QPA5 Z 139 05680O 13 SFISSU 142 05690O 15 SFCPO 140 05700O 14 SFSTRT 159 ' - - ' 05710O 16 SFPRIC2 160 05720O 16 SFPCOD 161 05730O 01 SFDLT 149 ' - - ' 05740O QTYORDKB 181 05750O QTYREQKB 191 ÐÐ05760O SFDUE 201 ' - - ' 05770O AVAIL J 212 05780O*-------------------------------------------------------------- 05790O E 76 05800O* PUT PART NUMBER TOTALS 05810O REC 212 05820O 55 110 '*** TO BE ORDERED ***' 05830O 160 'TOTALS.....' 05840O PMOHB J 171 05850O ORDBALJB 181 05860O REQBALJB 191 05870O AVAIL J 212 05880O*------------------------------------------------------------------- 05890O E 73 05900O REC 212 05910O 97 '...' 05920O MGTEXT 134 05930O*--------------------------------------------------------------------- 05940O E 71 05950O REC 212 05960O 97 'ENTER TERMINAL #' 05970O*------------------------------------------------------------- 05980O E 81 05990O REC 212 06000O 104 '15-PITCH FONT,SET TO 12 ' ÐÐ06010O 128 'CHAR PER INCH, SET TOP ' 06020O 152 'OF FORM ' 06030O******************************************************************* 06040O*FMAST E 72 06050O* SFQTY 33P 06060O* SFQTYC 37P 06070O* SFCUST 46P 06080O* SFQPA 60P 06090O* SFPULL 64P 06100O* SFPRIC 95P 06110O* SFSEQ 97P 06120O* SFBOF 106 06130O* SAVAIL 123P 06140O* AVAIL 127P 06150O******************************************************************** ** TABSC/TABSCN SOURCE CODES/NAMES 006160MAMFG-ASSY 006170PAPURCH-ASSY 006180MPMFG-PART 006190PPPURCH-PART 006200RSRAW-STOCK 006210RDREF-DOCUMENT 006220/* 006230_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ _‚_‚ ÐÈ( ]7 XR4 P999999120282(èÈÐ SUBROUTINE ZR4 (IBUF) 00010C RING BELL. READ 4-CHAR FROM TERMINAL. 00020 INTEGER IBUF (2) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 4 00070 ITC = 0 00080 IA = $0700 00090 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00100 RETURN 00110 END 00120_‚_‚ _‚_‚ ÐÈ(Š]= ŠX004GL P120282120282(èÈÐ00010H Q004GL00020F* REPORT WRITER SPEC UPDATE. (X004GL) 00030F* REVISED 3-03-80 11:00 AM. 00040F* FIELD SUBSTITUTIONS-------- 00050F* A40 = INPUT DATA ARRAY NAME (SR75) 00060F* 00070F* 1 = 1ST UPDATABLE FIELD NO. 00080F* 00090F* 40 = LGTH OF A40ARRAY 00100F* 00110F* ## = BIT ELEMENT FOR 40 00120F* 00130F* #QN = NEW ITEM PROG NAME 00140F* 00150F* #QQ = MENU PROG NAME 00160F* 00170F* BLK40= BLK FIELD FOR READ BUFFER 00180F* 00190F* W40A = READ BUFFER FIELD NAME 00200F* 00210F* 10 = LAST UPDATABLE FIELD # 00220F* 00230F* 6 = NUMBER OF NUMERIC FIELDS 00240F* 00250FBITTAB IP F 33 DISK ÐÐ00260FMGFILE IC F 80R DISK 00270FGLRWSPECUC F 66R 9AI 3 DISK A 00280FGLRWMASTIC F 128R 5AI 3 DISK 00290F* 00300FTERM132 O F 132 5 00310F**************************************************************** 00320E NUL 1 132 1 NULL CHAR 00330E A40 40 40 1 A INPUT DATA ARRAY 00340E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00350E DUN 1 10 1 A EDIT CMPLT FLAG 00360E MES 1 1 30 00370E LOC 1 10 3 0 00380E* 00390E* 00400E* 00410E BIT 33 1 SCREEN CONTR. CHAR 00420E* 00430E* 00440I******************************************************************* 00450IBITTAB BT 00460I 1 33 BIT 00470I******************************************************************* 00480IMGFILE MG 00490I* MESSAGE FILE. 00500I 1 35 MGTEXT ÐÐ00510I****************************************************************** 00520IGLRWSPECGW 01 10 CS 00530I* GEN LEDGER REPORT WRITER SPEC - SUB-TOTAL RECORD. 00540I OR 02 10 CA 00550I* ACCOUNT RECORD. 00560I* KEY AREA. 00570I* REPORT # 5N 00580I 3 70GWREP 00590I* SEQ # 4N 00600I 8 110GWSEQ 00610I* TYPE 1A (RECORD ID) (S) 00620I 12 12 GWTYPE 00630I* ACCOUNT # 11A 00640I 13 23 GWACNT 00650I* SUB-TOTAL # 2N (1-10) 00660I 24 250GWSTOT 00670I* TITLE 40A 00680I 26 65 GWTITL 00690I* LEVEL 2N 00700I 66 670GWLEV 00710I* RECORD STATUS 1A 00720I 68 68 GWSTAT 00730I******************************************************************** 00740IGLRWMASTGM 00750I* GEN LEDGER REPORT WRITER SPEC MASTER. ÐÐ00760I* KEY AREA. 00770I* REPORT NO. 5N 00780I 3 70GMNO 00790I* REPORT TITLE 60A 00800I 8 67 GMTITL 00810I* REQUESTED BY 35A 00820I 68 92 GMRQBY 00830I* DATE REQUESTED 6N 00840I 93 980GMRQDT 00850I* DATE LAST RUN 6N 00860I 99 1040GMDLR 00870I* FILLER 00880I* RECORD STATUS 1A 00890I 128 128 GMSTAT 00900C******************************************************************** 00910C* INITIALIZE 00920C EXSR SR101 1-TIME INIT 00930C*------------------------------------------------------------------ 00940C START TAG 00950C* SET-UP 1ST FIELD NO. 00960C MOVE ' ' DUN INIT EDIT ARRAY 00970C Z-ADD1 F 30 FIELD # 00980C GOTO READ 00990C*------------------------------------------------------------------ 01000C NEXT TAG ÐÐ01010C* SET-UP NEXT FIELD NO. 01020C 1 ADD F F FIELD # 01030C*----------------------------------------------------------------- 01040C READ TAG 01050C* READ DATA FROM TERMINAL. 01060C SETOF 9096 01070C EXSR SR102 VALIDATE FIELD # 01080C 55 GOTO UPDATE DONE 01090C EXSR SR201 IDENTIFY-F 01100C SETON 69 01110C EXSR SR72 PROMPT 01120C SETOF 69 01130C EXSR SR75 READ TERMINAL 01140C 98 GOTO GOODBY GOODBY 01150C 94 GOTO MENU MENU REQUEST 01160C N77N88 EXSR SR104 EDIT INPUT FIELD 01170C 96 ERROR 01180CORN77N88 EXSR SR72 REWRITE INPUT DATA 01190C 93 GOTO NEWITM NEW ITEM 01200C 92 GOTO JUMP FIELD JUMP REQST 01210C 91 GOTO NEXT SKIP FORWARD 01220C 89 F SUB 1 F SKIP BACKWARD 01230C 89 GOTO READ " " 01240C 88 SETOF 90 SPACE FILL 01250C 88 SETON 77 " " ÐÐ01260C 87 GOTO START 01270C 86 GOTO UPDATE UPDATE 01280C 85 GOTO READ REPEAT 01290C 96 GOTO ERROR ERROR 01300C N77 GOTO NEXT NO DATA INPUT 01310C*------------------------------------------------------------------ 01320C PROCES TAG 01330C* PROCESS INPUT DATA 01340C EXSR SR103 MOVE DATA 01350C N96 EXSR SR104 EDIT DATA 01360C EXSR SR72 REWRITE DATA 01370C 96 GOTO ERROR ERROR 01380C GOTO NEXT 01390C*------------------------------------------------------------------ 01400C UPDATE TAG 01410C* UPDATE DATA BASE. 01420C EXSR SR105 FINAL EDIT 01430C 96 GOTO ERROR ERROR 01440C EXSR SR106 UPDATE 01450C 96 GOTO ERROR ERROR 01460C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01470C EXSR SR107 SETUP LINKAGE 01480C 96 GOTO ERROR ERROR 01490C GOTO END 01500C*------------------------------------------------------------------- ÐÐ01510C JUMP TAG 01520C* SET-UP JUMP TO REQUESTED FIELD 01530C 1 ADD W W 30 01540C W COMP 40 54 01550C 54 Z-ADD318 M 50 96 FLAG ERROR 01560C 54 GOTO ERROR BAD ESC 01570C MOVE ' ' W3A 3 01580C MOVEAA40,W W3A 01590C Z-ADD3 W2N 20 01600C EXIT SUBRAJ R. JUSTIFY 01610C RLABL W2N 01620C RLABL W3A 01630C MOVE W3A F NEW FIELD # 01640C GOTO READ 01650C*-------------------------------------------------------------------- 01660C ERROR TAG 01670C EXSR SR102 VALIDATE FIELD # 01680C EXSR SR89 GET MSG 01690C EXSR SR73 PUT MSG 01700C GOTO READ 01710C*------------------------------------------------------------------ 01720C NEWITM TAG 01730C* SET-UP LINK FOR NEW ITEM 01740C MOVEL'Q004GL' PROG 8 01750C GOTO END ÐÐ01760C*------------------------------------------------------------------- 01770C MENU TAG 01780C* SET-UP LINK TO MENU 01790C MOVEL'QQGL01' PROG 01800C GOTO END 01810C*-------------------------------------------------------------------- 01820C GOODBY TAG 01830C* LINK TO SIGN-OFF 01840C MOVEL'GOODBY' PROG 01850C GOTO END 01860C*------------------------------------------------------------------- 01870C END TAG 01880C EXSR SR97 UPDATE CRTFILE 01890C EXITFCHAIN LINK TO NEXT PROG 01900C RLABL PROG 01910C********************************************************************* 01920CSR SR1 BEGSR 01930C* EDIT TRAN CODE. 01940CSR EXSR SR203 CLASSIFY TRAN. 01950CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 01960CSR ENDSR 01970C******************************************************************* 01980CSR SR2 BEGSR 01990C* EDIT REPORT #. 02000CSR TREP COMP 0 54 ÐÐ02010CSRN54 Z-ADD M 96 FLAG ERROR. 02020CSR ENDSR 02030C***************************************************************** 02040CSR SR70 BEGSR 02050C* CLEAR TERM SCREEN. 02060CSR SETON 70 02070CSR EXCPT CLEAR SCREEN 02080CSR SETOF 70 02090CSR ENDSR 02100C********************************************************************** 02110CSR SR71 BEGSR 02120C* PUT HEADINGS TO TERMINAL 02130CSR SETON 71 02140CSR EXCPT PUT HEADINGS 02150CSR SETOF 71 02160CSR ENDSR 02170C********************************************************************* 02180CSR SR72 BEGSR 02190C* PUT DATA TO TERMINAL 02200CSR SETON 72 02210CSR EXCPT PUT DATA 02220CSR SETOF 72 02230CSR ENDSR 02240C*********************************************************************** 02250CSR SR73 BEGSR ÐÐ02260C* PUT ERROR MESSAGE TO TERMINAL 02270CSR SETON 73 02280CSR EXCPT PUT MSG 02290CSR SETOF 73 02300CSR Z-ADDM LSTERR 50 02310CSR ENDSR 02320C******************************************************************* 02330CSR SR75 BEGSR 02340C* READ FROM TERMINAL 02350CSR SETOF 779096 02360CSR SETOF 939291 02370CSR SETOF 898887 02380CSR SETOF 8685 02390CSR MOVE BIT,21 BUFLGT 2 READ BUFFER LGTH 02400CSR MOVE BLK40 W40A BUFFER 02410CSR EXITFQWREED READ FROM TERMINAL 02420CSR RLABL W40A READ BUFFER 02430CSR RLABL BUFLGT READ BUFFER LGTH 02440CSR MOVEAW40A A40 INPUT DATA ARRAY 02450CSR MOVE BLK40 W40A INIT INPUT ARRAY 02460CSR Z-ADD1 W 30 02470CSR '\' LOKUPA40,W 90 FLAG ESC 02480CSRN90 GOTO T75B NOT ESC 02490CSR 1 ADD W W 02500CSR W COMP 40 54 ÐÐ02510CSR 54 GOTO T75A BAD ESC 02520CSR A40,W COMP 'G' 98 GOODBY 02530CSR A40,W COMP 'E' 94 MENU 02540CSR A40,W COMP 'N' 93 NEW ITEM 02550CSR A40,W COMP 'J' 92 JUMP 02560CSR A40,W COMP 'F' 91 SKIP FRWRD 02570CSR A40,W COMP 'B' 89 SKIP BKWRD 02580CSR A40,W COMP 'S' 88 SPACE FILL 02590CSR A40,W COMP 'H' 87 HOME 02600CSR A40,W COMP 'U' 86 UPDATE 02610CSR A40,W COMP 'R' 85 REPEAT 02620CSR 98 02630COR 94 02640COR 93 02650COR 92 02660COR 91 02670COR 89 02680COR 88 02690COR 87 02700COR 86 02710COR 85 GOTO END75 GOOD ESC 02720C*------------------------------------------------------------------ 02730CSR T75A TAG 02740C* FLAG BAD ESC INPUT 02750CSR Z-ADD318 M 96 FLAG ERROR ÐÐ02760CSR GOTO END75 02770C*-------------------------------------------------------------------- 02780CSR T75B TAG 02790C* MOVE DATA 02800CSR Z-ADD1 W 02810CSR ' ' LOKUPA40,W 77 02820CSR 77 MOVEAA40,W W40A INPUT DATA 02830C*-------------------------------------------------------------------- 02840CSR END75 TAG 02850C* INIT PREV ERROR MSG. 02860CSR LSTERR COMP 0 54 02870CSR 54 MOVE BLK35 MGTEXT 02880CSR 54 EXSR SR73 BLANK MESSAGE 02890CSR Z-ADD0 LSTERR 50 02900CSR ENDSR 02910C********************************************************************** 02920CSR SR80 BEGSR 02930C* GET MASTER RECORD 02940CSR SETOF 61 02950CSR CHAIN 60 GET MASTER 02960CSRN60 COMP 'D' 61 FLAG DELETE 02970CSR ENDSR 02980C********************************************************************** 02990CSR SR81 BEGSR 03000C* ADD NEW MASTER TO FILE ÐÐ03010CSR SETON 81 03020CSR EXCPT ADD MASTER 03030CSR SETOF 81 03040CSR ENDSR 03050C*********************************************************************** 03060CSR SR82 BEGSR 03070C* REWRITE MASTER 03080CSR SETON 82 03090CSR EXCPT REWRITE MASTER 03100CSR SETOF 82 03110CSR ENDSR 03120C********************************************************************** 03130CSR SR89 BEGSR 03140C* GET MESSAGE MASTER 03150CSR M CHAINMGFILE 54 03160CSR 54 MOVE BLK35 MGTEXT 03170CSR 54 MOVELM MGTEXT 03180CSR 54 MOVE MES,1 MGTEXT 03190CSR ENDSR 03200C*********************************************************************** 03210CSR SR101 BEGSR 03220C* 1-TIME INITIALIZE 03230CSR MOVE BIT,1 NUL 03240CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03250CSR Z-ADD10 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ03260CSR MOVE ' ' BLK40 40 03270C* DEFINE WORK FIELDS,ETC. 03280CSR MOVE ' ' BLK35 35 03290C* 03300C* 03310C* 03320C* 03330C* 03340CSR ENDSR 03350C********************************************************************** 03360CSR SR102 BEGSR 03370C* VALIDATE FIELD NO. 03380CSR F COMP 0 54 03390CSRN54 Z-ADD1 F 03400CSR F COMP FLIMIT 55 03410CSR 55 Z-ADD1 F 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR103 BEGSR 03450C* MOVE INPUT DATA 03460CSR EXSR SR201 IDENTIFY-F 03470CSR EXSR SR202 R. JUSTIFY 03480CSR 01 MOVELW40A TTCODE 1 TRAN CODE 03490CSR 02 MOVE W6A TREP 50 REPORT # 03500CSR 03 MOVE W6A TSEQ 40 SEQ # ÐÐ03510CSR 04 MOVELW40A TTYPE 1 TYPE CODE 03520CSR 05 MOVELW40A TPRFX 2 ACCT PREFIX 03530CSR 06 MOVE W6A TPRIM 60 ACCT PRIME 03540CSR 07 MOVE W6A TDASH 30 ACCT DASH 03550CSR 08 MOVE W6A TSTOT 20 SUB-TOT # 03560CSR 09 MOVE W40A TTITL 40 TITLE 03570CSR 10 MOVE W6A TLEV 20 # OF LEVELS 03580CSR MOVE ' ' DUN,F EDIT FLAG 03590CSR ENDSR 03600C******************************************************************** 03610CSR SR104 BEGSR 03620C* EDIT INPUT DATA 03630CSR 01 EXSR SR1 03640CSR 02 EXSR SR2 03650CSR 03 EXSR SR3 03660CSR 04 EXSR SR4 03670CSR 05 EXSR SR5 03680CSR 06 EXSR SR6 03690CSR 07 EXSR SR7 03700CSR 08 EXSR SR8 03710CSR 09 EXSR SR9 03720CSR 10 EXSR SR10 03730CSR 96 MOVE ' ' DUN,F EDIT FLAG 03740CSRN96 MOVE 'X' DUN,F 03750CSR ENDSR ÐÐ03760C*********************************************************************** 03770CSR SR105 BEGSR 03780C* FINAL EDIT 03790CSR SETON 79 FINAL EDIT FLAG 03800CSR Z-ADD1 F 96 03810C*-------------------------------------------------------------------- 03820CSR T105A TAG 03830CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03840CSRN54 GOTO END105 03850CSR EXSR SR201 IDENTIFY-F 03860CSR EXSR SR104 EDIT 03870CSRN96 GOTO T105A 03880C*-------------------------------------------------------------------- 03890CSR END105 TAG 03900CSR SETOF 79 03910CSR ENDSR 03920C******************************************************************** 03930CSR SR106 BEGSR 03940C* UPDATE DATA BASE. 03950CSR EXSR SR203 CLASSIFY TRAN 03960CSR 60 GOTO T106A ADD TRAN 03970CSR 61 GOTO T106D CHANGE TRAN 03980CSR 62 GOTO T106F DELETE TRAN 03990C* FLAG BAD TRAN CODE 04000CSR Z-ADD300 M 96 FLAG ERROR ÐÐ04010CSR Z-ADD1 F FIELD # 04020CSR GOTO END106 04030C*------------------------------------------------------------------- 04040CSR T106A TAG 04050C* ADD TRANSACTION 04060CSR EXSR SR80 GET MASTER 04070CSR 60 GOTO T106B NOT ON FILE 04080CSR 61 GOTO T106C DELETED MASTER 04090C* FLAG DUPLICATE ADD ERROR 04100CSR Z-ADD301 M 96 FLAG ERROR 04110CSR Z-ADD1 F FIELD # 04120CSR GOTO END106 04130C*--------------------------------------------------------------------- 04140CSR T106B TAG 04150C* ADD-- MAST NOT ON FILE 04160CSR EXSR SR81 ADD NEW MASTER 04170CSR GOTO END106 04180C*--------------------------------------------------------------------- 04190CSR T106C TAG 04200C* ADD-- MAST IS DELETED 04210CSR MOVE 'A' GWSTAT RECORD STATUS 04220CSR EXSR SR82 REWRITE MAST 04230CSR GOTO END106 04240C*---------------------------------------------------------------------- 04250CSR T106D TAG ÐÐ04260C* CHANGE TRANSACTION. 04270CSR EXSR SR80 GET MASTER 04280CSRN60N61 GOTO T106E GOT IT 04290C* FLAG NO MASTER ERROR 04300CSR Z-ADD302 M 96 FLAG ERROR 04310CSR Z-ADD1 F FIELD # 04320CSR GOTO END106 04330C*----------------------------------------------------------------------- 04340CSR T106E TAG 04350C* REWRITE MASTER 04360CSR EXSR SR82 REWRITE MAST 04370CSR GOTO END106 04380C*----------------------------------------------------------------------- 04390CSR T106F TAG 04400C* DELETE TRANSACTION 04410CSR EXSR SR80 GET MASTER 04420CSRN60N61 GOTO T106G GOT IT 04430C* FLAG NO MASTER ERROR 04440CSR Z-ADD302 M 96 FLAG ERROR 04450CSR Z-ADD1 F FIELD # 04460CSR GOTO END106 04470C*----------------------------------------------------------------------- 04480CSR T106G TAG 04490C* DELETE MASTER. 04500CSR EXSR SR204 CHECK FOR ACTIVITY ÐÐ04510CSR 96 Z-ADD1 F FIELD # 04520CSR 96 GOTO END106 ERROR 04530CSR MOVE 'D' GWSTAT RECORD STATUS 04540CSR EXSR SR82 REWRITE MASTER 04550CSR END106 ENDSR 04560C************************************************************************ 04570CSR SR201 BEGSR 04580C* IDENTIFY FIELD NO. 04590CSR F COMP 1 01 04600CSR F COMP 2 02 04610CSR F COMP 3 03 04620CSR F COMP 4 04 04630CSR F COMP 5 05 04640CSR F COMP 6 06 04650CSR F COMP 7 07 04660CSR F COMP 8 08 04670CSR F COMP 9 09 04680CSR F COMP 10 10 04690CSR ENDSR 04700C********************************************************************** 04710CSR SR202 BEGSR 04720C* RIGHT JUSTIFY 04730CSR F LOKUPNUM 54 04740CSRN54 GOTO END202 NOT NUMERIC FIELD 04750CSR Z-ADD15 W2N 20 ÐÐ04760CSR MOVELW40A W15A 15 04770CSR EXIT SUBRAJ R. JUSTIFY 04780CSR RLABL W2N 04790CSR RLABL W15A 04800CSR END202 ENDSR 04810C*********************************************************************** 04820CSR SR203 BEGSR 04830C* CLASSIFY TRAN CODE 04840CSR CRTRAN COMP 'A' 60 ADD 04850CSR CRTRAN COMP 'C' 61 CHANGE 04860CSR CRTRAN COMP 'D' 62 DELETE 04870CSR ENDSR 04880O******************************************************************** 04890OTERM132 E 70 04900O* CLEAR TERMINAL. 04910O NUL 132 04920O BIT,13 1 04930O*------------------------------------------------------------------- 04940O E 71 04950O* PUT HEADING. 04960O 4 'TRAN' 04970O 51 'ACCOUNT NO.' 04980O 120 'NUMB OF' 04990O*------------------------------------------------------------------- 05000O E 71 ÐÐ05010O 4 'CODE' 05020O 13 'REPORT#' 05030O 18 'SEQ' 05040O 24 'TYPE' 05050O 44 'PREFIX' 05060O 51 'PRIME' 05070O 58 'DASH' 05080O 69 'SUB-TOTAL' 05090O 76 'TITLE' 05100O 119 'LEVELS' 05110O*------------------------------------------------------------------- 05120O E 72 05130O* PUT DATA. 05140O TTCODE 2 05150O TREP Z 13 05160O TSEQ Z 18 05170O TTYPE 22 05180O TPRFX 42 05190O TPRIM Z 52 05200O TDASH Z 57 05210O TSTOT Z 65 05220O TTITL 111 05230O TLEV Z 117 05240O TYPNAM 36 05250O*-------------------------------------------------------------------- ÐÐ05260O E 73 05270O* PUT MESSAGE. 05280O 96 9 'E R R O R' 05290O N96 9 ' ' 05300O MGTEXT B 50 05310O BIT,28 130 05320O 131 'K' 05330O BIT,8 132 05340O******************************************************************** 05350OGLRWSPECEADD 81 05360O TREP 7 05370O TSEQ 11 05380O TTYPE 12 05390O TKEY 23 05400O TSTOT 25 05410O TTITL 65 05420O TLEV 67 05430O 68 'A' 05440O*------------------------------------------------------------------- 05450O E 82 05460O TTYPE 12 05470O TKEY 23 05480O TSTOT 25 05490O TTITL 65 05500O TLEV 67 ÐÐ05510O GWSTAT 68 ** NUL ARRAY 005520 005530** #A ARRAY 005540 005550** NUM ARRAY 005560002 REPORT # 005570003 SEQ # 005580006 PRIME 005590007 DASH 005600008 TOT # 005610010 LEVEL # 005620** DUN ARRAY 005630 005640** MES ARRAY 005650---MESSAGE NOT ON FILE--- 005660** LOC ARRAY 005670002 1 TRAN CODE 005680009 2 REPORT # 005690016 3 SEQ # 005700022 4 TYPE CODE 005710041 5 ACCT PREFIX 005720047 6 ACCT PRIME 005730055 7 ACCT DASH 005740064 8 SUB-TOT # 005750ÐÐ072 9 TITLE 005760116 10 LEVEL CODE 005770/* 005780_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(^M §X004JQ P120282120282(èÈÐ00010H Q004JQ00020F* DISPLAY JOB QUEUE - DEPT SEQ - DATAGRAPHIX. (X004JQ) 00030F* DISPLAYS JOB QUEUE FOR THE SIGNED-ON DEPT. 00040F* REVISED 11/26/79 5:05 PM. 00050FBITTAB IP F 33 DISK 00060FJQDEPT UD F 10L 9AI 1 DISK 00070FJQMAST UC F 96R 4AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090FMGFILE IC F 80R DISK 00100FBJMAST IC F 106R 6AI 1 DISK 00110FMENUDEPTIT F 25 DISK 00120FTERM132 O F 132 5 00130E******************************************************************** 00140E MENUDEPT TABDEP 1 10 5 0 TABDN 16 DEPT NAMES 00150E NUL 1 132 1 00160E A6 6 6 1 00170E A8 8 8 1 A 00180E BIT 33 1 00190E CALL 5 6 00200I******************************************************************** 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************** 00240IMGFILE MG 00250I 1 35 MGTEXT ÐÐ00260I******************************************************************** 00270IBJMAST BJ 00280I 7 46 BJDESC 00290I 106 106 BJSTAT 00300I******************************************************************** 00310IJQDEPT JP 00320I* JOB QUEUE DEPT ALT-KEY. 00330I* KEY AREA. 00340I* DEPT # 5N 00350I 1 50JPDEPT 00360I* JOB # 4N 00370I 6 90JPJOB 00380I* RECORD STATUS 1A 00390I 10 10 JPSTAT 00400I******************************************************************** 00410IJQMAST JQ 00420I* JOB QUEUE MASTER. 00430I* JOB NUMB 4N 00440I 1 40JQNUMB 00450I* DEVICE 2A 00460I* COL-1,DEVICE CODE 00470I* Y = SHARED 00480I* N = NON-SHARABLE 00490I* COL-2,DEVICE CODE 00500I* S = SYST PRINTER ÐÐ00510I* D = DIABLO PRINTER 00520I* T = TERMINAL 00530I* C = CONSOLE 00540I 5 6 JQDEV 00550I* DEPT # 5N 00560I 7 110JQDEPT 00570I* JOB NAME 6A 00580I 12 17 JQJOB 00590I* PRINTER 1A 00600I 18 18 JQPRTR 00610I* PAPER 25A 00620I 19 43 JQPAP 00630I* COPIES REQUESTED 1N 00640I 44 440JQCOPY 00650I* REQUESTED BY 12A 00660I 45 56 JQRBY 00670I* REQUEST DATE 6N 00680I 57 620JQRDAT 00690I* REQUEST TIME 6N 00700I 63 680JQRTIM 00710I* NEED BY DATE 6N 00720I 69 740JQNDAT 00730I* NEED BY TIME 6N 00740I 75 800JQNTIM 00750I* DATE COMPLETED 6N ÐÐ00760I 81 860JQCDAT 00770I* TIME COMPLETED 6N 00780I 87 920JQCTIM 00790I* RECORD STATUS 1A 00800I 96 96 JQSTAT 00810I****************************************************************** 00820ICRTFILE CR 00830I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00840I* STD AREA - SAME FOR ALL PROGRAMS. 00850I* EMPLOYEE # 5N 00860I 1 50CREMPL 00870I* USER CODE 8A 00880I 6 13 CRUSER 00890I* DEPT # 5N 00900I 14 180CRDEPT 00910I* JOB NAME 8A (JOB LOADED BY MENU) 00920I 19 26 CRJOB 00930I* SHUTDOWN FLAG 1A 00940I* BLANK = NO SHUTDOWN 00950I 27 27 CRSHUT 00960I* TIME STARTED 6N 00970I 28 330CRTIME 00980I* DATE STARTED 4N 00990I 34 370CRDATE 01000I* CALL STACK 5 X 6A ÐÐ01010I 38 67 CALL 01020I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 01030I 68 73 CRRET 01040I* MENU NAME 6A 01050I 74 79 CRMENU 01060C******************************************************************** 01070C* INITIALIZE. 01080C EXSR SR101 INIT. 01090C H9 GOTO ENDJOB 01100C*------------------------------------------------------------------- 01110C START TAG 01120C EXSR SR71 PUT HEADINGS. 01130C CRDEPT COMP 840 54 01140C 54 MOVELZERO5 W9A 9 01150C N54 MOVELCRDEPT W9A 9 01160C W9A SETLLJQDEPT 01170C*------------------------------------------------------------------- 01180C TAG100 TAG 01190C SETOF 54 01200C READ JQDEPT 54 01210C 54 GOTO TAG200 DONE 01220C CRDEPT COMP JPDEPT 54 01230C N54 CRDEPT COMP 840 54 01240C N54 GOTO TAG200 DONE 01250C JPSTAT COMP 'D' 54 ÐÐ01260C 54 GOTO TAG100 DELETED. 01270C JPJOB CHAINJQMAST 60 01280C 60 GOTO TAG100 01290C JQSTAT COMP 'D' 55 01300C 55 SETON 84 01310C EXCPT DELETE JQDEPT. 01320C 55 SETOF 84 01330C 55 GOTO TAG100 01340C JPDEPT LOKUPTABDEP TABDN 54 GET DEPT NAMES 01350C 54 MOVE TABDN DEPNAM 16 01360C N54 MOVE BLK35 DEPNAM 01370C JQJOB CHAINBJMAST 54 01380C N54 BJSTAT COMP 'D' 54 01390C 54 SETON 83 01400C 54 EXCPT DEL JQDEPT/MAST 01410C 54 SETOF 83 01420C 54 GOTO TAG100 01430C SETON 72 01440C EXCPT DISPLAY QUE. 01450C SETOF 72 01460C 2 ADD LINENO LINENO 30 01470C LINENO COMP 25 54 01480C N54 GOTO TAG100 01490C EXITFQEPAGE END PAGE MSG. 01500C EXSR SR75 READ. ÐÐ01510C 98 GOTO GOODBY 01520C 94 GOTO MENU 01530C 93 GOTO START 01540C EXSR SR71 PUT HEADINGS. 01550C GOTO TAG100 01560C*------------------------------------------------------------------- 01570C TAG200 TAG 01580C EXITFQEFILE END FILE MSG. 01590C EXSR SR75 READ 01600C 98 GOTO GOODBY 01610C 94 GOTO MENU 01620C 93 GOTO START 01630C GOTO START 01640C*------------------------------------------------------------------- 01650C MENU TAG 01660C MOVELCRMENU PROG 8 01670C GOTO END 01680C*------------------------------------------------------------------- 01690C GOODBY TAG 01700C MOVEL'GOODBY' PROG 01710C*------------------------------------------------------------------- 01720C END TAG 01730C EXITFCHAIN 01740C RLABL PROG 01750C*------------------------------------------------------------------- ÐÐ01760C ENDJOB TAG 01770C******************************************************************** 01780CSR SR71 BEGSR 01790C* PUT HEADINGS TO TERM. 01800CSR SETON 71 01810CSR EXCPT PUT HEADING. 01820CSR SETOF 71 01830CSR Z-ADD3 LINENO 01840CSR ENDSR 01850C******************************************************************** 01860CSR SR72 BEGSR 01870C* PUT DATA TO TERM. 01880CSR SETON 72 01890CSR EXCPT PUT DATA. 01900CSR SETOF 72 01910CSR ENDSR 01920C******************************************************************** 01930CSR SR73 BEGSR 01940C* PUT MESSAGE. 01950CSR M CHAINMGFILE 54 01960CSRN54 SETON 73 01970CSR EXCPT PUT MSG. 01980CSR SETOF 73 01990CSR ENDSR 02000C******************************************************************* ÐÐ02010CSR SR75 BEGSR 02020C* READ FROM TERMINAL 02030CSR SETOF 779096 02040CSR SETOF 939291 02050CSR SETOF 898887 02060CSR SETOF 8685 02070CSR MOVE BIT,5 A6,2 BUF LENGTH 02080CSR MOVEAA6 W6A 6 02090CSR MOVE BLK8 W8A 8 BUFFER 02100CSR EXITFQWREED READ TERM 02110CSR RLABL W8A 02120CSR RLABL W6A 02130CSR MOVEAW8A A8 02140CSR MOVE BLK8 W8A 02150CSR Z-ADD1 W 30 02160CSR '\' LOKUPA8,W 90 FLAG ESC 02170CSRN90 GOTO T75B NOT ESC 02180CSR 1 ADD W W 02190CSR W COMP 8 54 02200CSR 54 GOTO T75A BAD ESC 02210CSR A8,W COMP 'G' 98 GOODBY 02220CSR A8,W COMP 'E' 94 MENU 02230CSR A8,W COMP 'N' 93 NEW ITEM 02240CSR A8,W COMP 'J' 92 JUMP 02250CSR A8,W COMP 'F' 91 SKIP FRWRD ÐÐ02260CSR A8,W COMP 'B' 89 SKIP BKWRD 02270CSR A8,W COMP 'S' 88 SPACE FILL 02280CSR A8,W COMP 'H' 87 HOME 02290CSR A8,W COMP 'U' 86 UPDATE 02300CSR A8,W COMP 'R' 85 REPEAT 02310CSR 98 02320COR 94 02330COR 93 02340COR 92 02350COR 91 02360COR 89 02370COR 88 02380COR 87 02390COR 86 02400COR 85 GOTO END75 GOOD ESC 02410C*------------------------------------------------------------------ 02420CSR T75A TAG 02430C* FLAG BAD ESC INPUT 02440CSR Z-ADD318 M 50 96 FLAG ERROR 02450CSR GOTO END75 02460C*-------------------------------------------------------------------- 02470CSR T75B TAG 02480C* MOVE DATA 02490CSR Z-ADD1 W 02500CSR ' ' LOKUPA8,W 77 ÐÐ02510CSR 77 MOVEAA8,W W8A INPUT DATA 02520C*-------------------------------------------------------------------- 02530CSR END75 TAG 02540C* INIT PREV ERROR MSG. 02550CSR LSTERR COMP 0 54 02560CSR 54 MOVE BLK35 MGTEXT 02570CSR 54 EXSR SR73 BLANK MESSAGE 02580CSR Z-ADD0 LSTERR 50 02590CSR ENDSR 02600C*********************************************************************** 02610CSR SR101 BEGSR 02620C* 1-TIME INITIALIZE 02630CSR MOVE BIT,1 NUL 02640CSR MOVE BIT,1 A6 02650CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02660CSR MOVE ' ' BLK8 8 02670C* GET PORT # AND CRTFILE 02680CSR MOVE ' ' W8A 8 02690CSR Z-ADD0 W2N 20 02700CSR Z-ADD0 W1N 10 02710CSR MOVE ' ' W2A 2 02720CSR EXITFPGMINX GET PORT # 02730CSR RLABL W8A 02740CSR RLABL W2N 02750CSR RLABL W1N ÐÐ02760CSR RLABL W2A 02770CSR MOVE W2A PORT 20 PORT NO. 02780CSR PORT COMP 0 54 02790CSRN54 Z-ADD25 PORT DEFAULT 02800CSR PORT CHAINCRTFILE H9 02810C* DEFINE WORK FIELDS,ETC. 02820CSR MOVE ' ' BLK35 35 02830CSR Z-ADD0 ZERO5 50 02840CSR ENDSR 02850O******************************************************************** 02860OTERM132 E 71 02870O* PUT HEADING. 02880O*------------------------------------------------------------------- 02890O E 71 02900O 65 'DEPARTMENT' 02910O CRDEPTZ 71 02920O 81 'JOB QUEUE' 02930O*------------------------------------------------------------------- 02940O E 71 02950O 28 'JOB' 02960O 92 'NEED' 02970O 98 'DEV' 02980O*------------------------------------------------------------------- 02990O E 71 03000O 9 'DEPT' ÐÐ03010O 4 'JOB#' 03020O 29 'NAME' 03030O 79 'REQ-BY' 03040O 91 'BY' 03050O 99 'CODE' 03060O 112 'FORMS-REQ''D' 03070O 129 'COPY' 03080O*------------------------------------------------------------------- 03090O E 72 03100O* PUT DATA. 03110O JQNUMBZ 4 03120O JPDEPTZ 9 03130O DEPNAM 27 03140O U1 JQJOB 31 03150O BJDESC 73 03160O JQRBY 85 03170O JQNDATY 94 03180O JQDEV 98 03190O JQPAP 125 03200O JQCOPYZ 128 03210O*------------------------------------------------------------------- 03220O E 72 03230O JQNTIM 94 ' : : ' 03240O*------------------------------------------------------------------- 03250O E 73 ÐÐ03260O* PUT MSG. 03270O MGTEXT 35 03280O******************************************************************** 03290OJQDEPT E 84 03300O OR 83 03310O 10 'D' 03320O******************************************************************** 03330OJQMAST E 83 03340O 96 'D' ** NUL ARRAY 003350 003360** A6 ARRAY 003370 003380** A8 ARRAY 003390 003400/* 003410_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼^õ ¼$X004KP P120282120282(èÈÐ00010H Q004KP00020F* UPDATE KPNAME MASTER. (X004KP) 00030F* REVISED 9-19-80 2:45 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FKPNAME UC F 352R 6AI 1 DISK A 00070FKPMAST ID F 64L10AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090F* 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A132 1 132 1 A INPUT DATA ARRAY 00140E DUN 1 7 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E BIT 256 1 SCREEN CONTR. CHAR 00170E* 00180E* 00190I******************************************************************* 00200IBITHEX BT 00210I 1 256 BIT 00220I******************************************************************* 00230IMGFILE MG 00240I* MESSAGE FILE. 00250I 1 35 MGTEXT ÐÐ00260I******************************************************************** 00270ICRTFILE CR 00280I 1 50CREMPL 00290I 6 13 CRUSER 00300I 14 18 CRDEPT 00310I 19 26 CRJOB 00320I 27 27 CRSHUT 00330I 28 330CRTIMI 00340I 34 370CRDATE 00350I 38 67 CALL 00360I 68 73 CRRET 00370I 74 79 CRMENU 00380I******************************************************************** 00390IKPNAME KN 00400I* KEYPUNCH JOB MAST. 00410I* JOB # 6A 00420I 1 6 KNJOB 00430I* TITLE 60A 00440I 7 66 KNTITL 00450I* HEADING-LINE 2 132A 00460I 67 198 KNHL2 00470I* HEADING-LINE 3 132A 00480I 199 330 KNHL3 00490I* LAST BATCH NO. 5P 00500I P 331 3330KNLBAT ÐÐ00510I* FORMAT CODE 1A 00520I 334 334 KNFRMT 00530I* LINK-TO PROG NAME 8A 00540I 335 342 KNLINK 00550I* RECORD STATUS 1A 00560I 352 352 KNSTAT 00570I************************************************************ 00580IKPMAST KP 00590I 1 6 KPJOB 00600I 64 64 KPSTAT 00610C******************************************************************** 00620C* INITIALIZE 00630C EXSR SR101 1-TIME INIT 00640C*------------------------------------------------------------------ 00650C START TAG 00660C* SET-UP 1ST FIELD NO. 00670C EXSR SR70 PUT DIVIDER 00680C MOVE BLK6 JOBNO 6 00690C EXSR SR205 INIT MASTER 00700C MOVE ' ' DUN INIT EDIT ARRAY 00710C EXSR SR206 FIELD # 00720C GOTO READ 00730C*------------------------------------------------------------------ 00740C NEXT TAG 00750C* SET-UP NEXT FIELD NO. ÐÐ00760C 1 ADD F F FIELD # 00770C*----------------------------------------------------------------- 00780C READ TAG 00790C* READ DATA FROM TERMINAL. 00800C SETOF 9096 00810C F COMP 6 54 00820C 54 GOTO NEXT 00830C EXSR SR102 VALIDATE FIELD # 00840C 55 GOTO UPDATE DONE 00850C F COMP 2 54 00860C 54 CRTRAN COMP 'D' 54 00870C 54 GOTO UPDATE 00880C EXSR SR201 IDENTIFY-F 00890C SETON 69 00900C EXSR SR72 PROMPT 00910C SETOF 69 00920C EXSR SR75 READ TERMINAL 00930C*------------------------------------------------------------------- 00940C ESCAPE TAG 00950C 98 GOTO GOODBY GOODBY 00960C 94 GOTO MENU MENU REQUEST 00970C N77N88 EXSR SR104 EDIT INPUT FIELD 00980C 96 ERROR 00990CORN77N88 EXSR SR72 REWRITE INPUT DATA 01000C N77 EXITFQCLFCR LF/CR ÐÐ01010C 93 GOTO NEWITM NEW ITEM 01020C 91 GOTO NEXT SKIP FORWARD 01030C 89 F SUB 1 F SKIP BACKWARD 01040C 89 F COMP 6 54 01050C 89 54 F SUB 1 F 01060C 89 GOTO READ " " 01070C 88 SETOF 90 SPACE FILL 01080C 88 SETON 77 " " 01090C 87 GOTO START 01100C 86 GOTO UPDATE UPDATE 01110C 85 GOTO READ REPEAT 01120C 96 GOTO ERROR ERROR 01130C N77 GOTO NEXT NO DATA INPUT 01140C*------------------------------------------------------------------ 01150C PROCES TAG 01160C* PROCESS INPUT DATA 01170C EXSR SR103 MOVE DATA 01180C N96 EXSR SR104 EDIT DATA 01190C EXSR SR72 REWRITE DATA 01200C 96 GOTO ERROR ERROR 01210C EXITFQCLFCR LF/CR 01220C GOTO NEXT 01230C*------------------------------------------------------------------ 01240C UPDATE TAG 01250C* UPDATE DATA BASE. ÐÐ01260C EXSR SR105 FINAL EDIT 01270C 96 GOTO ERROR ERROR 01280C EXSR SR106 UPDATE 01290C 96 GOTO ERROR ERROR 01300C GOTO START 01310C*-------------------------------------------------------------------- 01320C ERROR TAG 01330C EXSR SR102 VALIDATE FIELD # 01340C EXSR SR89 GET MSG 01350C EXSR SR73 PUT MSG 01360C EXITFQCLFCR LF/CR 01370C EXITFQCLF LINE FEED ONLY 01380C GOTO READ 01390C*------------------------------------------------------------------ 01400C NEWITM TAG 01410C* SET-UP LINK FOR NEW ITEM 01420C MOVEL'Q004KP' PROG 8 01430C GOTO END 01440C*------------------------------------------------------------------- 01450C MENU TAG 01460C* SET-UP LINK TO MENU 01470C MOVEL'Q070DP' PROG 01480C GOTO END 01490C*-------------------------------------------------------------------- 01500C GOODBY TAG ÐÐ01510C* LINK TO SIGN-OFF 01520C MOVEL'GOODBY' PROG 01530C GOTO END 01540C*------------------------------------------------------------------- 01550C END TAG 01560C EXITFCHAIN LINK TO NEXT PROG 01570C RLABL PROG 01580C********************************************************************* 01590CSR SR1 BEGSR 01600C* EDIT TRAN CODE. 01610CSR EXSR SR203 CLASSIFY TRAN. 01620CSRN60N61N62 Z-ADD300 M 50 96 FLAG ERROR. 01630CSR ENDSR 01640C******************************************************************* 01650CSR SR2 BEGSR 01660C* EDIT JOB #. 01670CSR JOBNO COMP BLK6 54 01680CSRN54 Z-ADD342 M 96 FLAG ERROR. 01690CSRN54 ERROR. 01700COR 79 GOTO END2 FINAL EDIT. 01710CSR SETON 40 01720CSR EXSR SR106 GET MASTER. 01730CSR SETOF 40 01740CSR END2 ENDSR 01750C********************************************************************* ÐÐ01760CSR SR3 BEGSR 01770C* EDIT TITLE. 01780CSR KNTITL COMP BLK60 54 01790CSRN54 Z-ADD352 M 96 FLAG ERROR. 01800CSR ENDSR 01810C********************************************************************** 01820CSR SR4 BEGSR 01830C* EDIT HEADER LINE-2. 01840CSR KNHL2 COMP BLK132 54 01850CSRN54 Z-ADD353 M 96 FLAG ERROR. 01860CSR ENDSR 01870C******************************************************************* 01880CSR SR6 BEGSR 01890C* EDIT FORMAT CODE. 01900CSR KNFRMT COMP 'H' 54 HORIZONTAL 01910CSRN54 KNFRMT COMP 'V' 54 VERTICAL 01920CSRN54 Z-ADD258 M 96 FLAG ERROR. 01930CSR ENDSR 01940C***************************************************************** 01950CSR SR20 BEGSR 01960C* STALL FOR TIME (SR72) 01970CSR Z-ADD0 STALL 30 01980C*-------------------------------------------------------------- 01990CSR T20A TAG 02000CSR 1 ADD STALL STALL ÐÐ02010CSR STALL COMP 10 54 02020CSRN54 GOTO T20A 02030CSR ENDSR 02040C******************************************************************* 02050CSR SR70 BEGSR 02060C* PUT DIVIDER 02070CSR MOVE '-' NUL 02080CSR SETON 70 02090CSR EXCPT PUT DIVIDER 02100CSR SETOF 70 02110CSR MOVE BIT,1 NUL 02120CSR ENDSR 02130C********************************************************************* 02140CSR SR72 BEGSR 02150C* PUT DATA TO TERMINAL 02160CSR EXITFQMOVUP BUMP CURSOR UP 02170CSR SETON 72 02180CSR EXCPT PUT DATA 02190CSR SETOF 72 02200CSR 04 02210COR 05 EXSR SR20 STALL FOR TIME 02220CSR 04 SETON 19 02230CSR 05 SETON 20 02240CSR 04 02250COR 05 EXCPT ÐÐ02260CSR SETOF 1920 02270CSRN69 GOTO END72 NOT PROMPT 02280CSR EXITFQCCR CAR RET ONLY 02290CSRN03N04N05 MOVE BIT,22 BUFLGT 02300CSRN03N04N05 EXITFQMOVR MOVE CURSOR RIGHT 02310CSR RLABL BUFLGT 02320CSR EXITFQBELL RING BELL 02330CSR END72 ENDSR 02340C*********************************************************************** 02350CSR SR73 BEGSR 02360C* PUT ERROR MESSAGE TO TERMINAL 02370CSR SETON 73 02380CSR EXCPT PUT MSG 02390CSR SETOF 73 02400CSR ENDSR 02410C******************************************************************* 02420CSR SR75 BEGSR 02430C* READ FROM TERMINAL 02440CSR SETOF 779096 02450CSR SETOF 939291 02460CSR SETOF 898887 02470CSR SETOF 8685 02480CSR MOVE BIT,67 BUFLGT 2 READ BUFFER LGTH 02490CSR 04 02500COR 05 EXSR SR77 ÐÐ02510CSRN04N05 MOVE BLK132 W132A 132 BUFFER 02520CSR EXITFQR132 READ FROM TERMINAL 02530CSR RLABL W132A READ BUFFER 02540CSR RLABL BUFLGT READ BUFFER LGTH 02550CSR MOVEAW132A A132 INPUT DATA ARRAY 02560CSR MOVE BLK132 W132A INIT INPUT ARRAY 02570CSR Z-ADD1 W 30 02580CSR '\' LOKUPA132,W 90 FLAG ESC 02590CSRN90 GOTO T75B NOT ESC 02600CSR 1 ADD W W 02610CSR W COMP 132 54 02620CSR 54 GOTO T75A BAD ESC 02630CSR A132,W COMP 'G' 98 GOODBY 02640CSR A132,W COMP 'E' 94 MENU 02650CSR A132,W COMP 'N' 93 NEW ITEM 02660CSR A132,W COMP 'F' 91 SKIP FRWRD 02670CSR A132,W COMP 'B' 89 SKIP BKWRD 02680CSR A132,W COMP 'S' 88 SPACE FILL 02690CSR A132,W COMP 'H' 87 HOME 02700CSR A132,W COMP 'U' 86 UPDATE 02710CSR A132,W COMP 'R' 85 REPEAT 02720CSR 98 02730COR 94 02740COR 93 02750COR 91 ÐÐ02760COR 89 02770COR 88 02780COR 87 02790COR 86 02800COR 85 GOTO END75 GOOD ESC 02810C*------------------------------------------------------------------ 02820CSR T75A TAG 02830C* FLAG BAD ESC INPUT 02840CSR Z-ADD318 M 96 FLAG ERROR 02850CSR GOTO END75 02860C*-------------------------------------------------------------------- 02870CSR T75B TAG 02880C* MOVE DATA 02890CSR 04 02900COR 05 EXSR SR76 02910CSR Z-ADD1 W 02920CSR ' ' LOKUPA132,W 77 02930CSR 04 02940COR 05 Z-ADD1 W 02950CSR 77 MOVEAA132,W W132A INPUT DATA 02960C*-------------------------------------------------------------------- 02970CSR END75 ENDSR 02980C********************************************************************** 02990CSR SR76 BEGSR 03000C* MOVE INPUT DATA FOR HEADING LINES ÐÐ03010CSR Z-ADD0 W 03020C* 03030C*------------------------------------------------------------- 03040CSR T76A TAG 03050CSR 1 ADD W W 03060CSR W COMP 132 54 03070CSR 54 GOTO END76 03080CSR A132,W COMP BIT,10 54 03090CSRN54 MOVE ' ' A132,W 03100CSR GOTO T76A 03110CSR END76 ENDSR 03120C*************************************************************** 03130CSR SR77 BEGSR 03140C* SET-UP READ DATA, HEADING LINES 03150CSR 04 MOVEAKNHL2 A132 03160CSR 05 MOVEAKNHL3 A132 03170CSR Z-ADD1 W 03180C*-------------------------------------------------------------- 03190CSR T77A TAG 03200CSR ' ' LOKUPA132,W 54 03210CSR 54 MOVE BIT,10 A132,W 03220CSR 54 GOTO T77A 03230CSR MOVEAA132 W132A 03240CSR ENDSR 03250C***************************************************************** ÐÐ03260CSR SR80 BEGSR 03270C* GET MASTER RECORD 03280CSR SETOF 6160 03290CSRN40 GOTO T80A NOT SR2 03300CSR JOBNO CHAINKPNAME 60 GET MASTER 03310CSRN60 KNSTAT COMP 'D' 61 FLAG DELETE 03320CSR MOVE 'A' IOSW 1 I/O SWITCH 03330CSR 60 MOVE 'N' IOSW NOT ON FILE 03340CSR 61 MOVE 'D' IOSW DELETED 03350CSR 60 03360COR 61 EXSR SR205 INIT MAST. 03370CSR GOTO END80 03380C*------------------------------------------------------------------- 03390CSR T80A TAG 03400CSR IOSW COMP 'N' 60 NOT ON FILE 03410CSR IOSW COMP 'D' 61 DELETED 03420CSR END80 ENDSR 03430C********************************************************************** 03440CSR SR81 BEGSR 03450C* ADD NEW MASTER TO FILE 03460CSR SETON 81 03470CSR EXCPT ADD MASTER 03480CSR SETOF 81 03490CSR ENDSR 03500C*********************************************************************** ÐÐ03510CSR SR82 BEGSR 03520C* REWRITE MASTER 03530CSR SETON 82 03540CSR EXCPT REWRITE MASTER 03550CSR SETOF 82 03560CSR ENDSR 03570C********************************************************************** 03580CSR SR89 BEGSR 03590C* GET MESSAGE MASTER 03600CSR M CHAINMGFILE 54 03610CSR 54 MOVE BLK35 MGTEXT 03620CSR 54 MOVELM MGTEXT 03630CSR 54 MOVE MES,1 MGTEXT 03640CSR ENDSR 03650C*********************************************************************** 03660CSR SR101 BEGSR 03670C* 1-TIME INITIALIZE 03680C* PUT TAB-STOPS TO DATAGRAPHIX 03690CSR Z-ADD0 W 03700C*--------------------------------------------------------- 03710CSR T101A TAG 03720CSR 1 ADD W W 03730CSR W COMP 129 54 03740CSR 54 GOTO T101B 03750CSR MOVE BIT,28 A132,W ESC CODE ÐÐ03760CSR 1 ADD W W 03770CSR MOVE '1' A132,W NUMB-1 03780CSR 1 ADD W W 03790CSR MOVE ' ' A132,W SPACE 03800CSR 1 ADD W W 03810CSR MOVE BIT,1 A132,W NULL 03820CSR GOTO T101A 03830C*------------------------------------------------------------ 03840CSR T101B TAG 03850CSR SETON 74 03860CSR EXCPT PUT TAB STOPS 03870CSR EXCPT 03880CSR EXCPT 03890CSR EXCPT 03900CSR SETOF 74 03910CSR MOVELBIT,1 BUFLGT 2 READ BUF LGTH 03920CSR Z-ADD7 FLIMIT 30 NUMB OF INPUT FIELDS 03930CSR MOVE ' ' BLK132132 03940C* DEFINE WORK FIELDS,ETC. 03950CSR MOVE ' ' BLK35 35 03960CSR Z-ADD0 ZERO5 50 03970CSR MOVE ' ' BLK60 60 03980CSR MOVE ' ' BLK6 6 03990C* 04000C* ÐÐ04010CSR ENDSR 04020C********************************************************************** 04030CSR SR102 BEGSR 04040C* VALIDATE FIELD NO. 04050CSR F COMP 0 54 04060CSRN54 EXSR SR206 04070CSR F COMP FLIMIT 55 04080CSR 55 EXSR SR206 04090CSR ENDSR 04100C******************************************************************** 04110CSR SR103 BEGSR 04120C* MOVE INPUT DATA 04130CSR EXSR SR201 IDENTIFY-F 04140CSR 01 MOVELW132A CRTRAN 1 TRAN CODE. 04150CSR 02 MOVELW132A JOBNO 6 JOB #. 04160CSR 03 MOVELW132A KNTITL TITLE. 04170CSR 04 MOVELW132A KNHL2 HEADER LINE-2. 04180CSR 05 MOVELW132A KNHL3 HEADER LINE-3. 04190CSR 06 MOVELW132A KNFRMT FORMAT CODE. 04200CSR 07 MOVELW132A KNLINK LINK JOB. 04210CSR MOVE ' ' DUN,F EDIT FLAG 04220CSR ENDSR 04230C******************************************************************** 04240CSR SR104 BEGSR 04250C* EDIT INPUT DATA ÐÐ04260CSR 01 EXSR SR1 04270CSR 02 EXSR SR2 04280CSR 03 EXSR SR3 04290CSR 04 EXSR SR4 04300C*R 06 ***** EXSR SR6 04310CSR 96 MOVE ' ' DUN,F EDIT FLAG 04320CSRN96 MOVE 'X' DUN,F 04330CSR ENDSR 04340C*********************************************************************** 04350CSR SR105 BEGSR 04360C* FINAL EDIT 04370CSR SETON 79 FINAL EDIT FLAG 04380CSR EXSR SR206 04390C*-------------------------------------------------------------------- 04400CSR T105A TAG 04410CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04420CSRN54 GOTO END105 04430CSR EXSR SR201 IDENTIFY-F 04440CSR EXSR SR104 EDIT 04450CSRN96 GOTO T105A 04460C*-------------------------------------------------------------------- 04470CSR END105 TAG 04480CSR SETOF 79 04490CSR ENDSR 04500C******************************************************************** ÐÐ04510CSR SR106 BEGSR 04520C* UPDATE DATA BASE. 04530CSR EXSR SR203 CLASSIFY TRAN 04540CSR 60 GOTO T106A ADD TRAN 04550CSR 61 GOTO T106D CHANGE TRAN 04560CSR 62 GOTO T106F DELETE TRAN 04570C* FLAG BAD TRAN CODE 04580CSR Z-ADD300 M 96 FLAG ERROR 04590CSR EXSR SR206 FIELD # 04600CSR GOTO END106 04610C*------------------------------------------------------------------- 04620CSR T106A TAG 04630C* ADD TRANSACTION 04640CSR EXSR SR80 GET MASTER 04650CSR 60 GOTO T106B NOT ON FILE 04660CSR 61 GOTO T106C DELETED MASTER 04670C* FLAG DUPLICATE ADD ERROR 04680CSR Z-ADD301 M 96 FLAG ERROR 04690CSR EXSR SR206 FIELD # 04700CSR GOTO END106 04710C*--------------------------------------------------------------------- 04720CSR T106B TAG 04730C* ADD-- MAST NOT ON FILE 04740CSRN40 EXSR SR81 ADD NEW MASTER 04750CSR GOTO END106 ÐÐ04760C*--------------------------------------------------------------------- 04770CSR T106C TAG 04780C* ADD-- MAST IS DELETED 04790CSR MOVE 'A' KNSTAT RECORD STATUS 04800CSRN40 EXSR SR82 REWRITE MAST 04810CSR GOTO END106 04820C*---------------------------------------------------------------------- 04830CSR T106D TAG 04840C* CHANGE TRANSACTION. 04850CSR EXSR SR80 GET MASTER 04860CSRN60N61 GOTO T106E GOT IT 04870C* FLAG NO MASTER ERROR 04880CSR Z-ADD302 M 96 FLAG ERROR 04890CSR EXSR SR206 FIELD # 04900CSR GOTO END106 04910C*----------------------------------------------------------------------- 04920CSR T106E TAG 04930C* REWRITE MASTER 04940CSRN40 EXSR SR82 REWRITE MAST 04950CSR GOTO END106 04960C*----------------------------------------------------------------------- 04970CSR T106F TAG 04980C* DELETE TRANSACTION 04990CSR EXSR SR80 GET MASTER 05000CSRN60N61 GOTO T106G GOT IT ÐÐ05010C* FLAG NO MASTER ERROR 05020CSR Z-ADD302 M 96 FLAG ERROR 05030CSR EXSR SR206 FIELD # 05040CSR GOTO END106 05050C*----------------------------------------------------------------------- 05060CSR T106G TAG 05070C* DELETE MASTER. 05080CSR EXSR SR204 CHECK FOR ACTIVITY 05090CSR 96 EXSR SR206 FIELD # 05100CSR 96 GOTO END106 ERROR 05110CSR MOVE 'D' KNSTAT RECORD STATUS 05120CSRN40 EXSR SR82 REWRITE MASTER 05130CSR END106 ENDSR 05140C************************************************************************ 05150CSR SR201 BEGSR 05160C* IDENTIFY FIELD NO. 05170CSR F COMP 1 01 05180CSR F COMP 2 02 05190CSR F COMP 3 03 05200CSR F COMP 4 04 05210CSR F COMP 5 05 05220CSR F COMP 6 06 05230CSR F COMP 7 07 05240CSR ENDSR 05250C*********************************************************************** ÐÐ05260CSR SR203 BEGSR 05270C* CLASSIFY TRAN CODE 05280CSR CRTRAN COMP 'A' 60 ADD 05290CSR CRTRAN COMP 'C' 61 CHANGE 05300CSR CRTRAN COMP 'D' 62 DELETE 05310CSR MOVE ' ' TRNNAM 6 05320CSR 60 MOVE 'ADD ' TRNNAM 05330CSR 61 MOVE 'CHANGE' TRNNAM 05340CSR 62 MOVE 'DELETE' TRNNAM 05350CSR ENDSR 05360C******************************************************************* 05370CSR SR204 BEGSR 05380C* CHECK FOR ACTIVE KPMAST 05390CSR MOVELJOBNO W10A 10 05400CSR MOVE ' ' W10A 05410CSR W10A SETLLKPMAST 05420C*---------------------------------------------------------------- 05430CSR T204A TAG 05440CSR SETOF 54 05450CSR READ KPMAST 54 05460CSR 54 GOTO END204 05470CSR KPJOB COMP JOBNO 54 05480CSRN54 GOTO END204 05490CSR KPSTAT COMP 'D' 54 05500CSR 54 GOTO T204A ÐÐ05510CSR Z-ADD29 M 96 FLAG ERROR 05520CSR END204 ENDSR 05530C***************************************************************** 05540CSR SR205 BEGSR 05550C* INITIALIZE MASTER 05560CSR MOVE BLK6 KNJOB 05570CSR MOVE BLK60 KNTITL 05580CSR MOVE BLK132 KNHL2 05590CSR MOVE BLK132 KNHL3 05600CSR Z-ADD0 KNLBAT 05610CSR MOVE ' ' KNFRMT 05620CSR MOVE ' ' KNSTAT 05630CSR ENDSR 05640C***************************************************************** 05650CSR SR206 BEGSR 05660C* INIT FIELD # 05670CSR Z-ADD1 F 30 FIELD # 05680CSR ENDSR 05690O******************************************************************** 05700OTERM132 E 72 01 05710O 69 NUL 132 05720O 17 'TRAN CODE (A,C,D)' 05730O 20 ': ' 05740O CRTRAN 21 05750O 23 ' ' ÐÐ05760O TRNNAM 29 05770O*------------------------------------------------------------------- 05780O E 72 02 05790O 69 NUL 132 05800O 17 'JOB NO. ' 05810O 20 ': ' 05820O JOBNO 26 05830O*------------------------------------------------------------------- 05840O E 72 03 69 05850O NUL 132 05860O 17 'TITLE ' 05870O 20 ': ' 05880O E 72 03 05890O KNTITL 60 05900O*------------------------------------------------------------------- 05910O E 72 04 69 05920O AND N19 05930O NUL 132 05940O 17 'HEADER LINE-2 ' 05950O 20 ': ' 05960O E 19 05970O KNHL2 132 05980O*------------------------------------------------------------------- 05990O E 72 05 69 06000O AND N20 ÐÐ06010O NUL 132 06020O 17 'HEADER LINE-3 ' 06030O 20 ': ' 06040O E 20 06050O KNHL3 132 06060O*------------------------------------------------------------------- 06070O E 72 06 06080O 69 NUL 132 06090O 17 'FORMAT CODE (H,V)' 06100O 20 ': ' 06110O KNFRMT 21 06120O*------------------------------------------------------------------- 06130O E 72 07 06140O 69 NUL 132 06150O 20 'LINK-JOB-NO : ' 06160O KNLINK 28 06170O*--------------------------------------------------------- 06180O E 74 06190O A132 132 06200O*------------------------------------------------------------------- 06210O E 73 06220O 96 9 'E R R O R' 06230O N96 BLK132 132 06240O MGTEXT B 47 06250O BIT,28 130 ÐÐ06260O 131 'K' 06270O 96 BIT,8 132 06280O*--------------------------------------------------------- 06290O E 70 06300O* PUT DIVIDER 06310O NUL 132 06320O BIT,11 131 06330O BIT,14 132 06340O******************************************************************** 06350OKPNAME EADD 81 06360O JOBNO 6 06370O KNTITL 66 06380O KNHL2 198 06390O KNHL3 330 06400O ZERO5 333P 06410O KNFRMT 334 06420O KNLINK 342 06430O 352 'A' 06440O*------------------------------------------------------------------- 06450O E 82 06460O KNTITL 66 06470O KNHL2 198 06480O KNHL3 330 06490O KNLBAT 333P 06500O KNFRMT 334 ÐÐ06510O KNLINK 342 06520O KNSTAT 352 ** NUL ARRAY 006530 006540** A132 ARRAY 006550 006560** DUN ARRAY 006570 006580** MES ARRAY 006590---MESSAGE NOT ON FILE--- 006600/* 006610_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(2` 2X004PC P120282120282(èÈÐ00010H Q004PC00020F* REFORMAT GUIDE WITH LOW LEVEL CODE 1ST. (X004PC) 00030F* REVISED 3/31/81 3:45 PM. 00040FPCGUIDE IP F 11 10AI 1 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FPCGUIDE2O F 13 12AI 1 DISK U 00070FTERM80 O F 80 5 00080I******************************************************************** 00090IPCGUIDE PG 01 11 CC 00100I 1 100PGPN 00110I GG 02 00120I******************************************************************** 00130IPMMST2 PM 00140I P 13 140PMNOBM 00150I 430 4310PMLL 00160C******************************************************************** 00170C N79 TIME TIME 60 00180C N79 SETON 80 00190C N79 EXCPT 00200C N79 SETOF 80 00210C N79 SETON 79 00220C N01 GOTO END 00230C MOVELPGPN W12A 12 00240C MOVE ' ' W12A 00250C W12A CHAINPMMST2 54 ÐÐ00260C 54 SETOF 01 00270C N01 GOTO END 00280C PMNOBM COMP 0 01 00290C N01 GOTO END 00300C PMLL COMP 0 54 00310C N54 Z-ADD1 PMLL 00320C 100 SUB PMLL CALCLL 20 00330C*------------------------------------------------------------------- 00340C END TAG 00350CLR MOVEL'Q002PC' PROG 8 00360CLR EXITFCHAIN 00370CLR RLABL PROG 00380O******************************************************************** 00390OTERM80 E 80 00400O 11 'START 004PC' 00410O TIME 25 00420O******************************************************************** 00430OPCGUIDE2D 01 00440O CALCLL 2 00450O PGPN 12 /* 000460_‚ ÐÐ_‚_‚0C 54 SETOF 01 00270C N01 GOTO END 00280C PMNOBM COMP 0 01 00290C N01 GOTO END 00300C PMLL COMP 0 54 00310C N54 Z-ADD1 PMLL 00320C 100 SUB PMLL CALCLL 20 00330C*------------------------------------------------------------------- 00340C END TAG 00350CLR MOVEL'Q002PC' PROG 8 00360CLR EXITFCHAIN 00370CLR RLABL PROG 00380O******************************************************************** 00390OTERM80 E 80 00400O 11 'START 004PC' 00410O TIME 25 00420O******************************************************************** 00430OPCGUIDE2D 01 00440O CALCLL 2 00450O PGPN 12 /* 000460_‚ ÐÈ(„`0 „wX010PO P!¶999999120282(èÈÐ00010H Q010PO00020F* DISPLAY PURCHASE ORDER. (X010PO) *** D A T A G R A P H I X *** 00030F* REVISED 8/02/82 1:45 PM. 00040FBITPAR IP F 90 DISK 00050FPOMAST IC F 128R 6AI 1 DISK 00060FPOITEM ID F 384L 9AI 1 DISK 00070FPXMAST ID F 88L13AI 1 DISK 00080FPXFILE IC F 86R DISK 00090FCRTFILE UC F 256R DISK 00100FPJMAST IC F 170R12AI 1 DISK 00110FGLMAST IC F 165R 9AI 1 DISK 00120FMGFILE IC F 80R DISK 00130FVMMAST IC F 384R 5AI 1 DISK 00140FTERM132 O F 132 5 00150E******************************************************************** 00160E TABFOB 1 2 1 TABFN 11 FOB DESCRIPTION 00170E NUL 1 132 1 NULL CHAR 00180E RCD 1 24 7 0A 00190E OPN 1 24 7 0 00200E A14 14 14 1 A 00210E PTR 12000 5 0A 00220E DOT 10 10 1 00230E DIT 1 66 2 00240E LNK 1 7 6 A 00250E BIT 33 1 ÐÐ00260E CALL 7 6 00270E PAR 25 1 00280E TST 25 1 00290E PID 26 6 0A SCHED DATES 00300E PIQ 26 7 0A SCHED QTYS 00310E PXT 70 1 00320E SMP 25 5 0A 00330I******************************************************************** 00340IBITPAR BT 00350I 1 33 BIT 00360I 34 58 PAR 00370I 59 83 TST 00380I******************************************************************** 00390IMGFILE MG 00400I 1 35 MGTEXT 00410I******************************************************************** 00420IPOMAST PO 00430I* PURCHASE ORDER MASTER RECORD. 00440I* P.O. # 6A (KEY) 00450I 1 6 POPO 00460I* VENDOR # 5N 00470I 7 110POVEND 00480I* DELIVER TO 12A 00490I 12 23 POBY 00500I* ORDER TYPE 1A ÐÐ00510I* Y = CONFIRMATION 00520I 24 24 POTYPE 00530I* WORK ORDER/ACCOUNT 9A 00540I 27 35 POWO 00550I 27 32 POWOP 00560I 33 350POWOD 00570I* FILLER 36 41 FFFFFF 00580I* INSPECTION CODE 3A 00590I 42 44 POINSP 00600I* ORDER DATE 6N 00610I 45 500PODORD 00620I* SHIP VIA 10A 00630I 51 60 POVIA 00640I* ORDER ATTENTION OF 10A 00650I 61 70 POATT 00660I* TERMS 8A 00670I 71 78 POTERM 00680I* FOB 1A 00690I 79 79 POFOB 00700I* RESALE 1A 00710I 80 80 PORSAL 00720I* CONTRACT NO. 12A 00730I 81 92 POCNTR 00740I* PRIORITY 15A 00750I 93 107 POPRTY ÐÐ00760I* CONFIRMATION REQD 1A 00770I 108 108 POCONF 00780I* DATE CLOSED 6N 00790I 109 1140PODCLS 00800I* BUYER CODE 2A 00810I 115 116 POBUYR 00820I* CERTS REQD (Y,N) 1A 00830I 117 117 POCERT 00840I* LAST ITEM # USED 3P 00850I P 118 1190POLITM 00860I* RECORD STATUS 1A 00870I 128 128 POSTAT 00880I******************************************************************** 00890IPOITEM PI 00900I* PURCHASE ORDER ITEM RECORD. 00910I* KEY AREA. 00920I* PO # 6A 00930I 1 6 PIPO 00940I* PO ITEM 3N 00950I 7 90PIITEM 00960I 1 9 PIKEY 00970I* DYNAIR PART # 10N 00980I 10 190PIPN 00990I* VENDOR PART # 15A 01000I 20 34 PIVPN ÐÐ01010I* DESCRIPTION 29A 01020I 35 63 PIDESC 01030I* NON-INVENTORY DESCRIPTION 70A 01040I 10 79 PINDES 01050I* DATE LAST RECEIPT 6N 01060I 80 850PIDLR 01070I* QTY RECEIVED 7P 01080I P 86 890PIQRCD 01090I* QTY TO STK,SCRAP,RTV 7P 01100I P 90 930PIQSTK 01110I* PRICE CODE 1A 01120I* L = LOT 01130I* N = NO CHARGE 01140I 94 94 PILOT 01150I* PRICE 9.3P 01160I P 95 993PI$PRC 01170I* WORK ORDER # 9A 01180I 100 108 PIWO 01190I 100 105 PIWOP 01200I 106 1080PIWOD 01210I* VENDOR 5P (FROM POMAST) 01220I P 109 1110PIVEND 01230I* LAST RCVG LOG # USED 2N 01240I 112 1130PILLOG 01250I* SCHEDULE DATES 6N X 26 (Y,M,D) ÐÐ01260I 114 269 PID 01270I* SCHED QTYS 7P X 26 01280I P 270 373 PIQ 01290I* RECORD STATUS 1A 01300I 384 384 PISTAT 01310I****************************************************************** 01320ICRTFILE CR 01330I 28 330CRTIME 01340I 34 370CRDATE 01350I 38 79 CALL 01360I 82 87 CRPO 01370I 88 90 CRITEM 01380I********************************************************************* 01390IPJMAST PJ 01400I 30 69 PJNAME 01410I********************************************************************* 01420IGLMAST GL 01430I 18 57 PJNAME 01440I******************************************************************** 01450IPXMAST SM 01460I* SALES TEXT MASTER. 01470I* SALES ORDER 6A 01480I 1 6 SPPO 01490I* SALES ITEM 3N 01500I 7 90SPITEM ÐÐ01510I 1 9 SPKEY 01520I* SUB-ITEM 2N 01530I 10 110SPSUB 01540I* RECORD # 2N 01550I 12 130SPREC 01560I* POINTERS 5P X 25 01570I P 14 88 SMP 01580I******************************************************************** 01590IPXFILE PX 01600I* SALES ORDER TEXT DATA. 01610I* SALES ORDER 6A 01620I 1 6 PXORD 01630I* SALES ITEM 3N 01640I 7 90PXITEM 01650I* SUB-ITEM 2N 01660I 10 110PXSUB 01670I* TEXT 1A X 70 01680I 12 81 PXT 01690I* RECORD TYPE 1A 01700I* BLANK = TEXT H = HEADING 01710I* T = TEXT F = FOOTNOTE 01720I 82 82 PXTYPE 01730I* HEADING/FOOTNOTE LINE # 1N 01740I 83 83 PXHLIN 01750I* SPACE BEFORE PRINT CODE 1A ÐÐ01760I 84 84 PXSPAC 01770I* RECORD STATUS 1A 01780I 86 86 PXSTAT 01790I******************************************************************** 01800IVMMAST VM 01810I 1 50VMVEND 01820I 26 60 VMNAME 01830I 384 384 VMSTAT 01840C******************************************************************** 01850C* INIT 1-TIME. 01860C EXSR SR101 INIT 01870C*------------------------------------------------------------------- 01880C BEGIN TAG 01890C EXSR SR102 NEW PAGE 01900C Z-ADD0 ZERO5 50 STUPIDITY 01910C SETOF 46 01920C N45 CALL,6 COMP 'Q003PO' 46 01930C N46N45 CALL,6 COMP 'Q009PI' 46 01940C SETON 45 01950C N46 EXSR SR72 RQST ORDER # 01960C 98 GOTO GOODBY 01970C 94 GOTO MENU 01980C 93 GOTO NEWITM 01990C 46 MOVELCRPO TPO 02000C MOVE ' ' TPO ÐÐ02010C*------------------------------------------------------------------- 02020C CONTU TAG 02030C TPO SETLLPOITEM 02040C MOVE BLK14 POPO 02050C MOVE BLK14 LASTPI 9 02060C*------------------------------------------------------------------- 02070C START TAG 02080C SETOF 5442 02090C READ POITEM 54 02100C 54 GOTO TAG900 02110C PIKEY COMP LASTPI 54 02120C N54 GOTO TAG900 02130C SETOF 44 02140C MOVE PIKEY LASTPI 02150C PISTAT COMP 'D' 54 02160C 54 GOTO START 02170C PIPO COMP POPO 54 02180C 54 GOTO TAG10 02190C EXSR SR74 PUT POMAST 02200C SETON 80 02210C EXCPT PAUSE MSG 02220C SETOF 80 02230C EXSR SR75 READ 02240C 98 GOTO GOODBY 02250C 94 GOTO MENU ÐÐ02260C 93 GOTO NEWITM 02270C 60 MOVE BLK14 POPO 02280C 60 GOTO START 02290C 77 GOTO CONTU 02300C*------------------------------------------------------------------- 02310C TAG10 TAG 02320C PIWOP COMP ' 14100' 70 02330C N70 PIWOP COMP ' 12100' 70 02340C N70 PIWOP COMP ' 14600' 70 02350C EXSR SR252 COMPUTE SCHED 02360C EXSR SR76 PUT POITEM 02370C SETON 42 02380C MOVELPIKEY W11A 11 02390C MOVE '00' W11A 02400C MOVELW11A W13A 13 02410C MOVE ' ' W13A 02420C W13A SETLLPXMAST SET-UP 1ST TEXT READ 02430C Z-ADD0 P 40 02440C Z-ADD0 PTR 02450C*------------------------------------------------------------------- 02460C TAG20 TAG 02470C* GET NEXT TEXT MAST. 02480C SETOF 54 02490C READ PXMAST 54 02500C 54 GOTO TAG50 EOF ÐÐ02510C SPPO COMP PIPO 54 02520C N54 GOTO TAG50 02530C SPITEM COMP PIITEM 54 02540C 54 GOTO TAG25 02550C GOTO TAG50 02560C*------------------------------------------------------------------- 02570C TAG25 TAG 02580C Z-ADD1 X 30 02590C*------------------------------------------------------------------- 02600C TAG30 TAG 02610C ZERO5 LOKUPSMP,X 54 02620C N54 GOTO TAG20 02630C 1 ADD P P 02640C Z-ADDSMP,X PTR,P 02650C Z-ADD0 SMP,X 02660C GOTO TAG30 02670C*------------------------------------------------------------------- 02680C TAG50 TAG 02690C Z-ADD1 P 02700C*------------------------------------------------------------------- 02710C TAG60 TAG 02720C ZERO5 LOKUPPTR,P 54 02730C N54 GOTO TAG900 02740C PTR,P CHAINPXFILE 60 02750C 60 GOTO TAG70 ÐÐ02760C 42 PXITEM COMP PIITEM 54 02770C 42N54 EXSR SR40 PUT SCHEDULE 02780C EXSR SR78 DISPLAY TEXT 02790C*------------------------------------------------------------------- 02800C TAG70 TAG 02810C 1 ADD P P 02820C P COMP 2000 54 02830C 54 GOTO TAG900 02840C GOTO TAG60 02850C*------------------------------------------------------------------- 02860C TAG900 TAG 02870C 42 EXSR SR40 PUT ITEM SCHED 02880C EXSR SR71 DIVIDER 02890C EXSR SR72 ITEM # PROMPT 02900C 93 GOTO NEWITM 02910C 94 GOTO MENU 02920C 98 GOTO GOODBY 02930C 77 GOTO CONTU 02940C 42 GOTO START 02950C GOTO BEGIN 02960C*------------------------------------------------------------------- 02970C NEWITM TAG 02980C MOVEL'Q010PO' PROG 8 02990C GOTO END 03000C*------------------------------------------------------------------- ÐÐ03010C MENU TAG 03020C EXSR SR96 GET CRTFILE 03030C Z-ADD1 W 03040C ' ' LOKUPLNK,W 54 03050C 54 MOVELLNK,W PROG 03060C 54 MOVE ' ' LNK,W 03070C N54 MOVEL'CONTU' PROG 03080C EXSR SR97 UPD CRTFILE 03090C EXSR SR98 >>>>>>>>>> 03100C*------------------------------------------------------------------- 03110C GOODBY TAG 03120C MOVEL'GOODBY' PROG 03130C*------------------------------------------------------------------- 03140C END TAG 03150C EXSR SR96 GET CRTFILE 03160C EXSR SR97 UPD CRTFILE 03170C EXSR SR98 >>>>>>>>>> 03180C*------------------------------------------------------------------- 03190C ENDJOB TAG 03200C MOVEL'ENDJOB' PROG 03210C EXSR SR98 >>>>>>>>>> 03220C******************************************************************** 03230CSR SR40 BEGSR 03240C* PUT SCHEDULE DATA 03250CSR Z-ADD0 A 30 ÐÐ03260CSR SETOF 43 03270C*------------------------------------------------------------ 03280CSR T40A TAG 03290CSR 1 ADD A A 03300CSR A COMP 8 54 03310CSR 54 GOTO END40 03320CSR PIQ,A COMP 0 54 03330CSRN54 RCD,A COMP 0 54 03340CSR 8 ADD A B 30 03350CSR 8 ADD B C 30 03360CSRN54 PIQ,B COMP 0 54 03370CSRN54 RCD,B COMP 0 54 03380CSRN54 PIQ,C COMP 0 54 03390CSRN54 RCD,C COMP 0 54 03400CSRN54 GOTO T40A 03410CSR SETON 40 03420CSR EXCPT PUT SCHED LINE 03430CSR SETOF 40 03440CSR SETON 43 03450CSR GOTO T40A 03460C* PUT SCHEDULE TOTALS 03470CSR END40 ENDSR 03480C******************************************************************** 03490CSR SR68 BEGSR 03500CSR EXITFZLF LINE FEED ÐÐ03510CSR ENDSR 03520C******************************************************************** 03530CSR SR69 BEGSR 03540CSR 50 EXITFZPUTXY 03550CSR RLABL RPGLIN 03560CSR RLABL RPGCOL 03570CSRN50 EXITFZMOVXY POSITION CURSOR 03580CSR RLABL RPGLIN 03590CSR RLABL RPGCOL 03600CSR ENDSR 03610C****************************************************************** 03620CSR SR71 BEGSR 03630C* PUT DIVIDER 03640CSR SETON 71 03650CSR EXCPT PUT DIVIDER 03660CSR SETOF 71 03670CSR ENDSR 03680C******************************************************************** 03690CSR SR72 BEGSR 03700C* PROMPT. 03710CSR EXSR SR68 LF 03720CSR SETON 72 03730CSR EXCPT PROMPT 03740CSR SETOF 72 03750CSR EXSR SR75 READ ÐÐ03760CSRN98N94N93 EXSR SR212 BUILD ORDER # 03770CSR SETON 81 03780CSR EXCPT 03790CSR SETOF 81 03800CSR ENDSR 03810C******************************************************************** 03820CSR SR73 BEGSR 03830C* PUT MSG. 03840CSR SETON 73 03850CSR EXCPT PUT MGTEXT 03860CSR SETOF 73 03870CSR ENDSR 03880C******************************************************************** 03890CSR SR74 BEGSR 03900CSR 50 EXITFZESCH 03910CSRN50 EXITFZCPAGE 03920C* GET PO MASTER 03930CSR PIPO CHAINPOMAST 60 03940CSR 60 GOTO END74 03950CSR POSTAT COMP 'D' 60 03960CSR 60 GOTO END74 03970C* PUT P.O. MAST DATA. 03980CSR LASTVM COMP POVEND 55 03990CSRN55 POVEND CHAINVMMAST 54 04000CSR 54N55 MOVE BLK35 VMNAME ÐÐ04010CSR Z-ADDPOVEND LASTVM 50 04020CSR EXSR SR203 MASTER TABLE LOKUPS 04030CSR POWOD COMP 0 55 04040CSR POTYPE COMP 'Y' 56 04050CSR SETON 74 04060CSR EXCPT PUT POMAST 04070CSR SETOF 74 04080CSR EXSR SR68 LF 04090CSR END74 ENDSR 04100C******************************************************************** 04110CSR SR75 BEGSR 04120C* READ FROM TERMINAL 04130CSR SETOF 779096 04140CSR SETOF 93 04150CSR MOVE BLK14 W14A 14 BUFFER 04160CSR EXITFZR14 READ FROM TERMINAL 04170CSR RLABL W14A READ BUFFER 04180CSR MOVEAW14A A14 INPUT DATA ARRAY 04190CSR MOVE BLK14 W14A INIT INPUT ARRAY 04200CSR Z-ADD1 W 30 04210CSR '\' LOKUPA14,W 90 FLAG ESC 04220CSRN90 GOTO T75B NOT ESC 04230CSR 1 ADD W W 04240CSR W COMP 14 54 04250CSR 54 GOTO T75A BAD ESC ÐÐ04260CSR A14,W COMP 'G' 98 GOODBY 04270CSR A14,W COMP 'E' 94 MENU 04280CSR A14,W COMP 'N' 93 NEW ITEM 04290CSR 98 04300COR 94 04310COR 93 GOTO END75 GOOD ESC 04320C*------------------------------------------------------------------ 04330CSR T75A TAG 04340C* FLAG BAD ESC INPUT 04350CSR Z-ADD318 M 50 96 FLAG ERROR 04360CSR EXSR SR89 GET MSG 04370CSR EXSR SR73 PUT MSG 04380CSR GOTO SR75 04390C*-------------------------------------------------------------------- 04400CSR T75B TAG 04410C* MOVE DATA 04420CSR Z-ADD1 W 04430CSR ' ' LOKUPA14,W 77 04440CSR 77 MOVEAA14,W W14A INPUT DATA 04450CSR GOTO END75 04460CSR END75 ENDSR 04470C******************************************************************** 04480CSR SR76 BEGSR 04490C* PUT PO ITEM DATA. 04500CSR 50 EXITFZESCH ÐÐ04510CSR SETON 7644 04520CSR EXCPT 04530CSR SETOF 76 04540CSR ENDSR 04550C******************************************************************** 04560CSR SR78 BEGSR 04570C* PUT TEXT DATA. 04580CSR SETON 78 04590CSR EXCPT 04600CSR SETOF 78 04610CSR ENDSR 04620C******************************************************************** 04630CSR SR89 BEGSR 04640C* GET MESSAGE RECORD 04650CSR M CHAINMGFILE 54 04660CSR 54 MOVE BLK35 MGTEXT 04670CSR 54 MOVELM MGTEXT 04680CSR 54 MOVE '????????'MGTEXT 04690CSR ENDSR 04700C******************************************************************** 04710CSR SR96 BEGSR 04720CSR # CHAINCRTFILE H9 GET CRTFILE 04730CSR H9 GOTO ENDJOB 04740CSR ENDSR 04750C******************************************************************** ÐÐ04760CSR SR97 BEGSR 04770C* UPDATE CRTILFE. EXIT PROGRAM. 04780CSR TIME CRTIME 04790CSR MOVELUDATE CRDATE 04800CSR SETON 97 04810CSR EXCPT UPDATE CRTFILE 04820CSR SETOF 97 04830CSR ENDSR 04840C******************************************************************** 04850CSR SR98 BEGSR 04860CSR EXSR SR102 CLEAR SCREEN 04870CSR EXITFCHAIN >>>>>>>>>> 04880CSR RLABL PROG 04890CSR ENDSR 04900C******************************************************************** 04910CSR SR101 BEGSR 04920C* 1-TIME INITIALIZE 04930CSR MOVE BIT,1 NUL 04940CSR MOVEL'-' DIT 04950CSR MOVE ' ' BLK14 14 04960C* GET PORT # AND CRTFILE 04970CSR Z-ADD0 W2N 20 04980CSR MOVE ' ' W2A 2 04990CSR EXITFZGMINX GET PORT # 05000CSR RLABL W2A ÐÐ05010CSR MOVE W2A # 20 PORT NO. 05020CSR # COMP 0 54 05030CSRN54 Z-ADD25 # DEFAULT 05040CSR EXSR SR96 GET CRTFILE 05050CSR MOVE CALL LNK 05051CSR MOVE 'Q010PO 'PROG 05060CSR PAR,# COMP '1' 50 05070CSR TST,# COMP 'S' 56 05080CSR 56 MOVE 'SHUTDOWN'PROG 05090CSR EXSR SR97 UPD CRTFILE 05100CSR 56 EXSR SR98 >>>>>>>>>>> 05101CSR MOVE ' 'PROG 05110C* DEFINE WORK FIELDS,ETC. 05120CSR MOVE ' ' BLK35 35 05130CSR MOVELUDATE W4N 40 05140CSR MOVE UDATE W2N 20 05150CSR MOVELW2N TODAY 60 05160CSR MOVE W4N TODAY 05170CSR Z-ADD0 ZERO7 70 05180CSR Z-ADD0 ZERO6 60 05190CSR MOVE ' ' BLK8 8 05200CSR ENDSR 05210C******************************************************************** 05220CSR SR102 BEGSR 05230CSRN50 EXITFZCPAGE NEW PAGE ÐÐ05240CSR 50 EXITFZISTAT 05250CSR 50 EXITFZESCH 05260CSRN50 MOVEL'091' RPGLIN 4 05270CSRN50 MOVEL'001' RPGCOL 4 05280CSRN50 EXSR SR69 MOVE CURSOR 05290CSR ENDSR 05300C******************************************************************** 05310CSR SR202 BEGSR 05320C* RIGHT ADJUST. 05330CSR Z-ADD14 W2N 05340CSR EXIT SUBRAJ R.J. 05350CSR RLABL W2N 05360CSR RLABL W14A 05370CSR ENDSR 05380C******************************************************************** 05390CSR SR203 BEGSR 05400C* POMAST TABLE LOKUPS. 05410CSR PORSAL COMP 'Y' 54 05420CSR 54 MOVEL'YES 'RSLNAM 8 05430CSRN54 MOVEL' 'RSLNAM 05440CSR POCONF COMP 'Y' 54 05450CSR 54 MOVE 'YES' CNFNAM 3 CONFIRM REQD 05460CSRN54 MOVE 'NO ' CNFNAM 05470CSR POCERT COMP 'Y' 54 05480CSR 54 MOVE 'YES' CERNAM 3 CERTS REQD ÐÐ05490CSRN54 MOVE 'NO ' CERNAM 05500CSR POFOB LOKUPTABFOB TABFN 54 05510CSR 54 MOVE TABFN FOBNAM 11 05520CSRN54 MOVE BLK14 FOBNAM 05530CSR ENDSR 05540C******************************************************************** 05550CSR SR212 BEGSR 05560C* BUILD PURCH ORDER # 05570CSR MOVEAW14A A14 05580CSR Z-ADD1 W 05590CSR '-' LOKUPA14,W 54 05600CSRN54 Z-ADD7 W 05610CSR MOVEAA14,W W4A 4 05620CSR 54 MOVEL' ' W4A 05630CSR Z-ADD4 W2N 05640CSR EXIT SUBRAJ RJ 05650CSR RLABL W2N 05660CSR RLABL W4A 05670CSR MOVE W4A TPOD 30 WORK ORDER DASH 05680CSR MOVEABLK14 A14,W 05690CSR A14,1 COMP '0' 54 54 05700CSR 54 MOVEAA14,1 W5A 05710CSR 54 MOVEL' ' TPOP 05720CSRN54 MOVEAA14 TPOP 6 05730CSRN54 MOVE TPOP W5A 5 ÐÐ05740CSR Z-ADD5 W2N 05750CSR EXIT SUBRAJ RJ 05760CSR RLABL W2N 05770CSR RLABL W5A 05780CSR MOVE W5A TPOP WORK ORDER PRIME 05790CSR MOVELTPOP TPO 05800CSR MOVE TPOD TPO 9 05810CSR ENDSR 05820C******************************************************************** 05830CSR SR252 BEGSR 05840C* APPLY RCPTS TO SCHEDULE. 05850CSR Z-ADD0 RCD 05860CSR Z-ADD1 A 30 05870CSR Z-ADDPIQRCD SAVQTY 70 05880C*------------------------------------------------------------------- 05890CSR T252A TAG 05900CSR ZERO7 LOKUPPIQ,A 54 05910CSRN54 GOTO T252C 05920CSR Z-ADDPIQ,A W7N 70 05930CSR SETOF 57 05940CSR SAVQTY COMP W7N 545556 05950CSR 54 Z-ADDW7N RCD,A 05960CSR 54 SAVQTY SUB W7N SAVQTY 57 05970CSR 54 Z-ADD0 W7N 05980CSR 55 Z-ADDSAVQTY RCD,A ÐÐ05990CSR 55 W7N SUB SAVQTY W7N 06000CSR 55 Z-ADD0 SAVQTY 57 06010CSR 56 Z-ADDSAVQTY RCD,A 06020CSR 56 Z-ADD0 SAVQTY 57 06030CSR 56 Z-ADD0 W7N 06040CSR 57 1 ADD A A 06050CSR 57 A COMP 24 54 06060CSR 57 GOTO T252A 06070CSR GOTO END252 06080C*------------------------------------------------------------------- 06090CSR T252C TAG 06100CSR Z-ADD1 A 06110CSR ZERO7 LOKUPPIQ,A 54 06120CSR 54 Z-ADDSAVQTY RCD,A 06130C*------------------------------------------------------------------- 06140CSR END252 TAG 06150CSR PIQ SUB RCD OPN 06160CSR XFOOTPIQ TOTPIQ 70 06170CSR XFOOTOPN TOTOPN 70 06180CSR ENDSR 06190O******************************************************************** 06200OTERM132 E 74 06210O OR 76 06220O BIT,28 1 06230O N50 8 '8091001' ÐÐ06240O N50 BIT,1 9 06250O N50 BIT,1 10 06260O 50 10 '[001 ]001' 06270O 50 BIT,28 6 06280O 64 'P U R C H A S E' 06290O 77 'O R D E R' 06300O 88 'D A T A' 06310O*------------------------------------------------------------------- 06320O E 74 06330O 79 'M A S T E R - R E C O ' 06340O 82 'R D' 06350O*------------------------------------------------------------------- 06360O E 76 06370O 78 'I T E M - R E C O R D ' 06380O*------------------------------------------------------------------- 06390O E 74 06400O 26 ':' 06410O 24 'PURCHASE ORDER NO ' 06420O POPO 34 06430O 88 ':' 06440O 78 'VENDOR NO.' 06450O POVENDZ 95 06460O VMNAME 132 06470O*------------------------------------------------------------------- 06480O E 74 ÐÐ06490O 26 ':' 06500O 16 'DELIVER TO' 06510O POBY 40 06520O 88 ':' 06530O 82 'ORDER/ACCOUNT#' 06540O POWOP 96 06550O 55 POWOD 101 06560O 55 97 '-' 06570O E 74 06580O 26 ':' 06590O 19 'CONFIRMING PO' 06600O POTYPE 29 06610O 56 49 'CONFIRMING PO ONLY' 06620O 88 ':' 06630O 83 'INSPECTION CODE' 06640O POINSP 93 06650O*------------------------------------------------------------------- 06660O E 74 06670O 26 ':' 06680O 18 'DATE ORDERED' 06690O PODORD 36 ' - - ' 06700O 88 ':' 06710O 82 'ORDER ATT''N OF' 06720O POATT 100 06730O*------------------------------------------------------------------- ÐÐ06740O E 74 06750O 26 ':' 06760O 11 'TERMS' 06770O POTERM 36 06780O 88 ':' 06790O 71 'FOB' 06800O POFOB 91 06810O FOBNAM 105 06820O*------------------------------------------------------------------- 06830O E 74 06840O 26 ':' 06850O 12 'RESALE' 06860O PORSAL 29 06870O RSLNAM 39 06880O 88 ':' 06890O 76 'CONTRACT' 06900O POCNTR 102 06910O*------------------------------------------------------------------- 06920O E 74 06930O 26 ':' 06940O 14 'PRIORITY' 06950O POPRTY 43 06960O 88 ':' 06970O 86 'CONFIRMATION REQD ' 06980O POCONF 91 ÐÐ06990O CNFNAM 101 07000O*------------------------------------------------------------------- 07010O E 74 07020O 26 ':' 07030O 17 'CERTS REQ''D' 07040O POCERT 29 07050O CERNAM 39 07060O 88 ':' 07070O 76 'SHIP VIA' 07080O POVIA 100 07090O*------------------------------------------------------------------ 07100O E 74 07110O 24 'LAST ITEM NO. USED' 07120O 26 ':' 07130O POLITMZ 31 07140O 88 ':' 07150O 78 'BUYER CODE' 07160O POBUYR 92 07170O*------------------------------------------------------------------- 07180O E 80 07190O NUL 132 07200O BIT,11 1 07210O BIT,12 2 07220O 11 '...PAUSE ' 07230O*------------------------------------------------------------------ ÐÐ07240O E 72 07250O NUL 132 07260O 15 'ENTER PO-ITEM #' 07270O*------------------------------------------------------------------- 07280O E 81 07290O 16 'PO # ENTERED IS:' 07300O TPOP 24 07310O 25 '-' 07320O TPOD 28 07330O*------------------------------------------------------------------- 07340O E 76 07350O 26 ':' 07360O 15 'PO-ITEM #' 07370O PIPO 34 07380O 35 '-' 07390O PIITEMZ 38 07400O*------------------------------------------------------------------- 07410O E 76 07420O 26 ':' 07430O 21 'ORDER/ACCOUNT #' 07440O PIWOP 34 07450O 55 35 '-' 07460O 55 PIWOD 38 07470O PJNAME 80 07480O*------------------------------------------------------------------- ÐÐ07490O E 76 07500O 26 ':' 07510O 12 'PART #' 07520O 70 PIPN 40 ' - - ' 07530O*------------------------------------------------------------------- 07540O E 76 07550O 26 ':' 07560O 19 'VENDOR PART #' 07570O 70 PIVPN 43 07580O*------------------------------------------------------------------- 07590O E 76 07600O 26 ':' 07610O 22 'PRICE-CODE (L,N)' 07620O PILOT 29 07630O*------------------------------------------------------------------- 07640O E 76 07650O 26 ':' 07660O 11 'PRICE' 07670O PI$PRC2 41 07680O*--------------------------------------------------------------- 07690O E 76 07700O 14 'TOTAL ORDERED:' 07710O TOTPIQ2 24 07720O 53 'TOTAL RECEIVED:' 07730O PIQRCD2 63 ÐÐ07740O 92 'TOTAL STOCKED:' 07750O PIQSTK2 102 07760O 121 'BAL OPEN:' 07770O TOTOPNK 132 07780O*----------------------------------------------------------------- 07790O E 76 07800O 26 ':' 07810O 22 'ITEM DESCRIPTION' 07820O N70 PINDES 98 07830O 70 PIDESC 57 07840O*---------------------------------------------------------------------- 07850O E 78 07860O P Z 24 07870O PXT 98 07880O PXTYPE 105 07890O PXHLIN 106 07900O PXSPAC 107 07910O PXORD 115 07920O 116 '-' 07930O PXITEM 119 07940O*------------------------------------------------------------------- 07950O E 40N43 07960O DOT 10 07970O DOT 20 07980O DOT 30 ÐÐ07990O DOT 36 08000O 57 'SCHEDULE DATES & QTYS' 08010O DOT 67 08020O DOT 77 08030O DOT 87 08040O DOT 95 08050O*------------------------------------------------------------------- 08060O E 40N43 08070O 16 'QTY' 08080O 27 'QTY' 08090O 39 'QTY' 08100O 41 '*' 08110O 59 'QTY' 08120O 70 'QTY' 08130O 82 'QTY' 08140O 84 '*' 08150O 102 'QTY' 08160O 113 'QTY' 08170O 125 'QTY' 08180O*------------------------------------------------------------------- 08190O E 40N43 08200O* SCHEDULE HEADING 08210O 8 'DUE-DATE' 08220O 19 'SCHEDULED' 08230O 29 'RECEIVED' ÐÐ08240O 39 'OPEN' 08250O 41 '*' 08260O 51 'DUE-DATE' 08270O 62 'SCHEDULED' 08280O 72 'RECEIVED' 08290O 82 'OPEN' 08300O 84 '*' 08310O 94 'DUE-DATE' 08320O 105 'SCHEDULED' 08330O 115 'RECEIVED' 08340O 125 'OPEN' 08350O*-------------------------------------------------------------- 08360O E 40 08370O* PUT SCHEDULE DATA 08380O PID,A B 8 ' - - ' 08390O PIQ,A 2B 19 08400O RCD,A 2B 29 08410O OPN,A KB 40 08420O 41 '*' 08430O PID,B B 51 ' - - ' 08440O PIQ,B 2B 62 08450O RCD,B 2B 72 08460O OPN,B KB 83 08470O PID,C B 94 ' - - ' 08480O PIQ,C 2B 105 ÐÐ08490O RCD,C 2B 115 08500O OPN,C KB 126 08510O 84 '*' 08520O*------------------------------------------------------------------- 08530O E 71 08540O DIT 132 08550O****************************************************************** 08560OCRTFILE E 97 08570O PROG 26 08580O CRTIME 33 08590O CRDATE 37 08600O CALL 79 08610O 87 ' ' 08620O****************************************************************** ** TABFOB/TABFN - FOB DESCRIPTIONS 08630DDESTINATION 08640FFACTORY 08650** NUL ARRAY 08660 08670** RCD ARRAY 08680 08690** OPN ARRAY 08700 08710** A14 ARRAY 08720 08730ÐÐ** PTR ARRAY 08740 08750** DOT ARRAY 08760. . . . . 08770** DIT ARRAY 08780 08790** LNK ARRAY 08800 08810/* 08820_‚ ÐÐ_‚_‚PTR ARRAY 08740 08750** DOT ARRAY 08760. . . . . 08770** DIT ARRAY 08780 08790** LNK ARRAY 08800 08810/* 08820_‚ ÐÈ(2a¨ 2X004PX P120282120282(èÈÐ00010H Q004PX00020F********************************************************************** 00030F* CREATE PXPTR FILE (SEE X003PX) 00040F* REVISED 7-15-81 9:45 AM. 00050FBITTAB IP F 33 DISK 00060FPXCONT O F 16 DISK 00070FPXPTR O F 1 DISK 00080I******************************************************************** 00090IBITTAB BT 01 00100I 1 33 BIT 00110C******************************************************************** 00120C SETON 85 00130C EXCPT PUT OUT SCCONT 00140C SETOF 85 00150C*------------------------------------------------------------------- 00160C START TAG 00170C SETON 86 00180C EXCPT 00190C SETOF 86 00200C GOTO START 00210O******************************************************************** 00220OPXPTR E 86 00230O 1 'X' 00240O***************************************************************** 00250OPXCONT E 85 ÐÐ00260O 7 '0000000' /* 00270_‚ ÐÐ_‚_‚0O 7 '0000000' /* 00270_‚ ÐÈ(a¾ §X004QM P`120282120282(èÈÐ00010H Q004QM00020F* UPDATE QUOTE MASTER. (X004QM). CALLED BY X003QM. 00030F* REVISED 4/25/80 10:45 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FQMMAST UC F 160R 8AI 1 DISK A 00070FCRT512 UC F 512R DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A6 6 6 1 CALL READ PARAM. 00120E A40 40 40 1 A INPUT DATA ARRAY 00130E NUM 1 9 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 40 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E CRD 6 7 0 DATE ARRAY 00170E BIT 33 1 SCREEN CONTR. CHAR 00180E CALL 5 6 CALL STACK 00190E* 00200E* 00210I******************************************************************* 00220IBITTAB BT 00230I 1 33 BIT 00240I******************************************************************* 00250IMGFILE MG ÐÐ00260I* MESSAGE FILE. 00270I 1 35 MGTEXT 00280I******************************************************************** 00290IQMMAST QM 00300I* QUOTE MASTER. 00310I* QUOTE # 5A 00320I* 1 5 QMQOTE 00330I* ITEM # 3N 00340I 6 80QMITEM 00350I* CUSTOMER NAME 20A 00360I* 9 28 QMNAME 00370I* CUSTOMER RFQ # 20A 00380I* 29 48 QMRFQ 00390I* RFQ ITEM # 4A 00400I* 49 52 QMRFQI 00410I* CONTACT 20A 00420I* 53 72 QMCONT 00430I* ASSIGNED TO (SALESMAN) 3A 00440I* 73 75 QMSLSM 00450I* DATE ARRAY 7P X 6 00460I* 1 = RECEIVED 00470I* 2 = DUE 00480I* 3 = SENT 00490I* 4 = EXPECTED AWARD 00500I* 5 = FOLLOW-UP ÐÐ00510I* 6 = NOT USED 00520I* P 76 99 QMD 00530I* PRODUCT CLASS 2A 00540I* 100 101 QMPCLS 00550I* SYSTEM CODE 1A 00560I* 102 102 QMSYST 00570I* FILLER 103 103 FFFFFF 00580I* QUOTE AMOUNT 7P ($) 00590I* P 104 1070QMAMT 00600I* DELIVERY PROMISED (DAYS ARO) 3P 00610I* P 108 1090QMDEL 00620I* STATUS 1A 00630I* E = ENTERED 00640I* N = NO BID 00650I* B = BID 00660I* P = PENDING 00670I* L = LOST 00680I* W = WON 00690I* C = CANCELLED 00700I* 110 110 QMSCOD 00710I* PROBABILITY OF AWARD 3.2P 00720I* P 111 1122QMPROB 00730I* WON/LOST REASON 1A 00740I* 113 113 QMREAS 00750I* REMARKS 40A ÐÐ00760I* 114 153 QMREM 00770I* RECORD STATUS 1A 00780I 160 160 QMSTAT 00790I******************************************************************** 00800ICRT512 CR 00810I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00820I* STD AREA - SAME FOR ALL PROGRAMS. 00830I* EMPLOYEE # 5N 00840I 1 50CREMPL 00850I* USER CODE 8A 00860I 6 13 CRUSER 00870I* DEPT # 5N 00880I 14 180CRDEPT 00890I* JOB NAME 8A (JOB LOADED BY MENU) 00900I 19 26 CRJOB 00910I* SHUTDOWN FLAG 1A 00920I* BLANK = NO SHUTDOWN 00930I 27 27 CRSHUT 00940I* TIME STARTED 6N 00950I 28 330CRTIME 00960I* DATE STARTED 6N 00970I 34 370CRDATE 00980I* CALL STACK 5 X 6A 00990I 38 67 CALL 01000I* RETURN TO PROG NAME (FOR PROG LOADER) 6A ÐÐ01010I 68 73 CRRET 01020I* MENU NAME 6A 01030I 74 79 CRMENU 01040I*------------------------------------------------------------------- 01050I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 01060I* CRT512 QMMAST FIELDS. 01070I* QUOTE # 5A 01080I 80 84 CRQOTE 01090I* ITEM # 3N 01100I 85 870CRITEM 01110I* CUSTOMER NAME 20A 01120I 88 107 CRNAME 01130I* CUSTOMER RFQ # 20A 01140I 108 127 CRRFQ 01150I* RFQ ITEM # 4A 01160I 128 131 CRRFQI 01170I* CONTACT 20A 01180I 132 151 CRCONT 01190I* ASSIGNED TO (SALESMAN) 3A 01200I 152 154 CRSLSM 01210I* DATE ARRAY 7P X 6 01220I* (SEE CODES QMMAST) 01230I P 155 178 CRD 01240I* PRODUCT CLASS 2A 01250I 179 180 CRPCLS ÐÐ01260I* SYSTEM CODE 1A 01270I 181 181 CRSYST 01280I* FILLER 182 182 FFFFFF 01290I* QUOTE AMOUNT 7P ($) 01300I P 183 1860CRAMT 01310I* DELIVERY PROMISED (DAYS ARO) 3P 01320I P 187 1880CRDEL 01330I* STATUS 1A 01340I* (SEE CODES QMMAST) 01350I 189 189 CRSCOD 01360I* PROBABILITY OF AWARD 3.2P 01370I P 190 1912CRPROB 01380I* WON/LOST REASON 1A 01390I 192 192 CRREAS 01400I* REMARKS 40A 01410I 193 232 CRREM 01420I* 01430I* TRAN CODE 1A 01440I 233 233 CRTRAN 01450I* ORIGINAL CUST NAME 20A 01460I 234 253 CROCUS 01470I* ORIGINAL SALESMAN 3A 01480I 254 256 CROSLS 01490I* ORIGINAL FOLLOW-UP DATE 7P 01500I P 257 2600CROFU ÐÐ01510I* LAST ZERO ITEM UPDATE 5A 01520I 261 265 CRLQI 01530C******************************************************************** 01540C* INITIALIZE. 01550C EXSR SR101 INIT. 01560C* UPDATE. 01570C EXSR SR106 UPDATE. 01580C 96 GOTO ERROR ERROR. 01590C* SET-UP LINKAGE. 01600C* IF CRITEM NOT = ZERO---> ALL GO TO Q010QM. 01610C* IF CRITEM IS = ZERO---> CHANGE TRAN GOES TO Q010QM. 01620C* ALL OTHERS GO TO Q002QM. 01630C MOVEL'Q010QM' PROG 8 UPDATE FROM QMCONT 01640C CRITEM COMP 0 54 01650C 54 CRTRAN COMP 'C' 55 01660C 54N55 MOVEL'Q002QM' PROG 01670C MOVE 'Q001QM' CRRET 01680C GOTO END 01690C*------------------------------------------------------------------- 01700C ERROR TAG 01710C* PUT ERROR MESSAGE. 01720C EXSR SR89 GET MESSAGE. 01730C EXSR SR73 PUT MESSAGE. 01740C MOVEL'Q003QM' PROG 01750C*------------------------------------------------------------------- ÐÐ01760C END TAG 01770C SETON LR 01780C PROG COMP BLK8 54 01790C N54 MOVEL'Q001QM' PROG 01800C EXITFCHAIN 01810C RLABL PROG 01820C*********************************************************************** 01830CSR SR73 BEGSR 01840C* PUT ERROR MESSAGE TO TERMINAL 01850CSR SETON 73 01860CSR EXCPT PUT MSG 01870CSR SETOF 73 01880CSR ENDSR 01890C********************************************************************** 01900CSR SR80 BEGSR 01910C* GET MASTER RECORD 01920CSR MOVELCRQOTE W8A 8 01930CSR MOVE CRITEM W8A 01940CSR SETOF 61 01950CSR W8A CHAINQMMAST 60 GET MASTER 01960CSRN60 QMSTAT COMP 'D' 61 FLAG DELETE 01970CSR ENDSR 01980C********************************************************************** 01990CSR SR81 BEGSR 02000C* ADD NEW MASTER TO FILE ÐÐ02010CSR CRITEM COMP 0 71 02020CSR 71 MOVE CRQOTE CRLQI 02030CSR SETON 81 02040CSR EXCPT ADD MASTER 02050CSR SETOF 81 02060CSR ENDSR 02070C*********************************************************************** 02080CSR SR82 BEGSR 02090C* REWRITE MASTER 02100CSR CRITEM COMP 0 71 02110CSR 71 MOVE CRQOTE CRLQI 02120CSR SETON 82 02130CSR EXCPT REWRITE MASTER 02140CSR SETOF 82 02150CSR ENDSR 02160C******************************************************************** 02170CSR SR89 BEGSR 02180C* GET MESSAGE MASTER 02190CSR M CHAINMGFILE 54 02200CSR 54 MOVE BLK35 MGTEXT 02210CSR 54 MOVELM MGTEXT 02220CSR 54 MOVE MES,1 MGTEXT 02230CSR ENDSR 02240C*********************************************************************** 02250CSR SR101 BEGSR ÐÐ02260C* 1-TIME INITIALIZE 02270C* GET PORT # AND CRT512 02280CSR MOVE ' ' W8A 8 02290CSR Z-ADD0 W2N 20 02300CSR Z-ADD0 W1N 10 02310CSR MOVE ' ' W2A 2 02320CSR EXITFPGMINX GET PORT # 02330CSR RLABL W8A 02340CSR RLABL W2N 02350CSR RLABL W1N 02360CSR RLABL W2A 02370CSR MOVE W2A PORT 20 PORT NO. 02380CSR PORT COMP 0 54 02390CSRN54 Z-ADD25 PORT DEFAULT 02400CSR PORT CHAINCRT512 H9 02410C* DEFINE WORK FIELDS,ETC. 02420CSR MOVE ' ' BLK35 35 02430CSR MOVE ' ' BLK5 5 02440CSR MOVE ' ' BLK40 40 02450CSR MOVE ' ' BLK8 8 02460CSR ENDSR 02470C******************************************************************** 02480CSR SR106 BEGSR 02490C* UPDATE DATA BASE. 02500CSR EXSR SR203 CLASSIFY TRAN ÐÐ02510CSR 60 GOTO T106A ADD TRAN 02520CSR 61 GOTO T106D CHANGE TRAN 02530CSR 62 GOTO T106F DELETE TRAN 02540C* FLAG BAD TRAN CODE 02550CSR Z-ADD300 M 50 96 FLAG ERROR 02560CSR GOTO END106 02570C*------------------------------------------------------------------- 02580CSR T106A TAG 02590C* ADD TRANSACTION 02600CSR EXSR SR80 GET MASTER 02610CSR 60 GOTO T106B NOT ON FILE 02620CSR 61 GOTO T106C DELETED MASTER 02630C* FLAG DUPLICATE ADD ERROR 02640CSR CRITEM COMP 0 54 02650CSR 54 GOTO T106C 02660CSR Z-ADD301 M 96 FLAG ERROR 02670CSR GOTO END106 02680C*--------------------------------------------------------------------- 02690CSR T106B TAG 02700C* ADD-- MAST NOT ON FILE 02710CSR EXSR SR81 ADD NEW MAST. 02720CSR GOTO END106 02730C*--------------------------------------------------------------------- 02740CSR T106C TAG 02750C* ADD-- MAST IS DELETED ÐÐ02760CSR MOVE 'A' QMSTAT RECORD STATUS 02770CSR EXSR SR82 REWRITE MAST. 02780CSR GOTO END106 02790C*---------------------------------------------------------------------- 02800CSR T106D TAG 02810C* CHANGE TRANSACTION. 02820CSR EXSR SR80 GET MASTER 02830CSRN60N61 GOTO T106E GOT IT 02840C* FLAG NO MASTER ERROR 02850CSR CRITEM COMP 0 54 02860CSR 54 GOTO T106A 02870CSR Z-ADD302 M 96 FLAG ERROR 02880CSR GOTO END106 02890C*----------------------------------------------------------------------- 02900CSR T106E TAG 02910C* REWRITE MASTER 02920CSR EXSR SR82 02930CSR GOTO END106 02940C*----------------------------------------------------------------------- 02950CSR T106F TAG 02960C* DELETE TRANSACTION 02970CSR EXSR SR80 GET MASTER 02980CSRN60N61 GOTO T106G GOT IT 02990C* FLAG NO MASTER ERROR 03000CSR Z-ADD302 M 96 FLAG ERROR ÐÐ03010CSR GOTO END106 03020C*----------------------------------------------------------------------- 03030CSR T106G TAG 03040C* DELETE MASTER. 03050CSR MOVE 'D' QMSTAT RECORD STATUS 03060CSR EXSR SR82 REWRITE MASTER. 03070CSR END106 ENDSR 03080C*********************************************************************** 03090CSR SR203 BEGSR 03100C* CLASSIFY TRAN CODE 03110CSR CRTRAN COMP 'A' 60 ADD 03120CSR CRTRAN COMP 'C' 61 CHANGE 03130CSR CRTRAN COMP 'D' 62 DELETE 03140CSR ENDSR 03150O******************************************************************** 03160OTERM132 E 73 03170O* PUT MESSAGE. 03180O BIT,28 1 03190O 8 '8030001' 03200O MGTEXT 43 03210O******************************************************************** 03220OQMMAST EADD 81 03230O* ADD NEW MASTER. 03240O CRQOTE 5 03250O CRITEM 8 ÐÐ03260O CRNAME 28 03270O CRRFQ 48 03280O CRRFQI 52 03290O CRCONT 72 03300O CRSLSM 75 03310O CRD 99P 03320O CRPCLS 101 03330O CRSYST 102 03340O CRAMT 107P 03350O CRDEL 109P 03360O CRSCOD 110 03370O CRPROB 112P 03380O CRREAS 113 03390O CRREM 153 03400O 160 'A' 03410O*------------------------------------------------------------------- 03420O E 82 03430O* REWRITE MASTER. 03440O CRNAME 28 03450O CRRFQ 48 03460O CRRFQI 52 03470O CRCONT 72 03480O CRSLSM 75 03490O CRD 99P 03500O CRPCLS 101 ÐÐ03510O CRSYST 102 03520O CRAMT 107P 03530O CRDEL 109P 03540O CRSCOD 110 03550O CRPROB 112P 03560O CRREAS 113 03570O CRREM 153 03580O QMSTAT 160 03590O******************************************************************** 03600OCRT512 E 81 71 03610O OR 82 71 03620O CRD 178P 03630O CRAMT 186P 03640O CRDEL 188P 03650O CRPROB 191P 03660O CROFU 260P 03670O CRLQI 265 ** NUL ARRAY 003680 003690** A6 ARRAY 003700 003710** A40 ARRAY 003720 003730** NUM ARRAY 003740003 003750ÐÐ009 003760010 003770011 003780012 003790013 003800016 003810017 003820021 003830** DUN ARRAY 003840 003850** MES ARRAY 003860---MESSAGE NOT ON FILE--- 003870/* 003880_‚ ÐÐ_‚_‚ 003760010 003770011 003780012 003790013 003800016 003810017 003820021 003830** DUN ARRAY 003840 003850** MES ARRAY 003860---MESSAGE NOT ON FILE--- 003870/* 003880_‚ ÐÈ(úbf úiX008RM P120282120282(èÈÐ00010H Q008RM00020F* ROUTING TEXT DELETE PROGRAM. (X008RM) DG REL006 OK 00030F* CALLED BY Q004RM ON DELETE TRANS 00040F* REVISED 2/01/80 3:40 PM. 00050FBITTAB IP F 33 DISK 00060FCRTFILE IC F 256R DISK 00070FREXTPTR UD F 25L21AI 1 DISK 00080FREXTFILEUC F 90R DISK 00090FREXTCONTUC F 16R DISK 00100FMGFILE IC F 80R DISK 00110I******************************************************************* 00120IBITTAB BT 00130I 1 33 BIT 00140I********************************************************************* 00150IMGFILE MG 00160I 1 35 MGTEXT 00170I********************************************************************** 00180IREXTCONTTC 00190I* TEXT CONTROL FILE 00200I* LAST USED RRN 7P 00210I 1 70TCLUTX 00220I* LAST DELETED RRN 7P 00230I 8 140TCLDTX 00240I********************************************************************** 00250ICRTFILE CR ÐÐ00260I* MENU FIELDS 1 33 XXXXXX 00270I* CURRENT JOB 6A 00280I 21 26 CRJOB 00290I* CALLED BY PROG 6A 00300I 68 73 CRRET 00310I* CALL STACK 6A X 5 00320I 38 67 CALL 00330I* MENU NAME 6A 00340I 74 79 CRMENU 00350I*------------------------------------------------------------------- 00360I* PART # 12A 00370I 80 91 CRPN 00380I* OPER SEQ 3N 00390I 92 940CRSEQ 00400I******************************************************************** 00410IREXTPTR TP 00420I* TEXT POINTER FILE. 00430I* TEXT KEY 15A 00440I 1 15 TPKEY 00450I* LINE # 6N 00460I 16 210TPLINE 00470I* POINTER 7P 00480I P 22 250TPPTR 61 00490I******************************************************************** 00500IREXTFILETX ÐÐ00510I* REXTFILE RECORD. 00520I* KEY 15A 00530I 1 15 TXKEY 00540I* LINE # 6N 00550I 16 210TXLINE 00560I* TEXT 1A X 60 00570I 22 81 TXT 00580I* BACKWARD PTR (DELETE) 7P 00590I P 82 850TXBPTR 00600I* RECORD STATUS 1A 00610I 90 90 TXSTAT 00620C******************************************************************** 00630C* INITIALIZE. 00640C EXSR SR101 INIT. 00650C H9 GOTO ENDJOB PROG ERROR. 00660C MOVELCRPN CRKEY 15 00670C MOVE CRSEQ CRKEY 00680C Z-ADD1 CRFLIN 60 00690C Z-ADD999999 CRELIN 60 00700C*------------------------------------------------------------------- 00710C START TAG 00720C* SET-UP 1ST READ. 00730C SETOF 606162 00740C MOVELCRKEY W21A 21 00750C MOVE CRFLIN W6A 6 ÐÐ00760C MOVE W6A W21A 00770C W21A SETLLREXTPTR 00780C*------------------------------------------------------------------- 00790C TAG20 TAG 00800C SETOF 54 00810C READ REXTPTR 54 00820C 54 GOTO END 00830C 61 GOTO TAG20 00840C TPKEY COMP CRKEY 54 00850C N54 GOTO END 00860C TPLINE COMP CRELIN 54 00870C 54 GOTO END 00880C Z-ADD1 RRN 70 00890C RRN CHAINREXTCONT H7 00900C H7 GOTO ENDJOB PROG ERROR. 00910C TPPTR CHAINREXTFILE H8 00920C H8 GOTO ENDJOB 00930C Z-ADDTCLDTX TXBPTR 00940C Z-ADDTPPTR TCLDTX 00950C Z-ADD0 TPPTR 00960C SETON 81 00970C EXCPT DELETE TEXT 00980C SETOF 81 00990C GOTO TAG20 01000C*------------------------------------------------------------------- ÐÐ01010C NEWITM TAG 01020C MOVEL'Q001RM' PROG 8 01030C GOTO END 01040C*------------------------------------------------------------------- 01050C MENU TAG 01060C MOVEL'QQRM01' PROG 01070C GOTO END 01080C*------------------------------------------------------------------- 01090C GOODBY TAG 01100C MOVEL'GOODBY' PROG 01110C*------------------------------------------------------------------- 01120C END TAG 01130C PROG COMP BLK8 54 01140C N54 MOVEL'Q001RM' PROG 01150C EXITFCHAIN 01160C RLABL PROG 01170C*------------------------------------------------------------------- 01180C ENDJOB TAG 01190C******************************************************************** 01200CSR SR84 BEGSR 01210C* GET TEXT FILE. 01220CSR RRN CHAINREXTFILE 62 01230CSR 62 SETON H8 01240CSR ENDSR 01250C*********************************************************************** ÐÐ01260CSR SR101 BEGSR 01270C* 1-TIME INITIALIZE 01280CSR MOVE ' ' W2A 2 01290CSR EXITFZGMINX GET PORT # 01300CSR RLABL W2A 01310CSR MOVE W2A PORT 20 01320CSR PORT CHAINCRTFILE H9 01330CSR H9 GOTO END101 PROG ERROR 01340C* DEFINE WORK FIELDS. 01350CSR MOVE ' ' BLK8 8 01360CSR MOVE ' ' BLK6 6 01370CSR MOVE ' ' BLK10 10 01380CSR Z-ADD0 ZERO7 70 01390CSR MOVE ' ' BLK35 35 01400CSR MOVE ' ' BLK20 20 01410CSR MOVE ' ' BLK66 66 01420CSR END101 ENDSR 01430O****************************************************************** 01440OREXTFILEE 81 01450O* DELETE TEXT RECORD 01460O TXBPTR 85P 01470O 90 'D' 01480O******************************************************************* 01490OREXTPTR E 81 01500O* REMOVE TEXT POINTER ÐÐ01510O ZERO7 25P 01520O***************************************************************** 01530OREXTCONTE 81 01540O TCLUTX 7 01550O TCLDTX 14 /* 001560_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(LBJ LËX103EM P()š999999120282(èÈÐ00010H Q103EM00020F* EMPLOYEE MASTER UPDATE - INSURANCE DEDUCTION. (X103EM) 00030F* REVISED 9-27-82 1:55 PM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FEMMAST UC F 1536R 5AI 1 DISK 00080FWCMAST IC F 960R 8AI 1 DISK 00090FEFMAST IC F 90R28AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A14 14 14 1 A INPUT DATA ARRAY 00140E COL 1 9 3 0 X-Y POSITIONS 00150E A39 39 39 1 MGTEXT ARRAY 00160E NUM 1 5 3 0 NUMERIC FIELD NO.'S 00170E DUN 1 9 1 A EDIT CMPLT FLAG 00180E MES 1 1 30 00190E LNK 1 7 6 A 00200E DOT 17 17 2 00210E TABDED 1 20 2 TABDN 25 00220E MAN 45 45 1 00230E BIT 33 1 00240E PAR 25 1 00250E TST 25 1 ÐÐ00260E CALL 7 6 CALL STACK 00270E PRT 20 2 DEDUCTION TYPE 00280E PRB 20 6 0 DEDUCTION BEGIN DATE 00290E PRS 20 6 0 DEDUCTION STOP DATE 00300E DAT 20 12 0 START/STOP DATE 00310E PRC 20 1 DEDUCTION AMOUNT CODE 00320E PRA 20 7 2 DEDUCTION AMOUNT $ 00330E PRY 20 7 2 DEDUCTION AMOUNT YTD 00340E PRN 20 14 DEDUCTION ACCOUNT # 00350I******************************************************************* 00360IBITPAR BT 00370I 1 33 BIT 00380I 34 58 PAR 00390I 59 83 TST 00400I******************************************************************* 00410IMGFILE MG 00420I* MESSAGE FILE. 00430I 1 35 MGTEXT 00440I****************************************************************** 00450ICRTFILE CR 00460I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00470I* EMPLOYEE # 5N 00480I 1 50CREMPL 00490I* TERMINAL USER CODE 00500I 6 13 CRUSER ÐÐ00510I* DEPT # 5N 00520I 14 180CRDEPT 00530I* JOB NAME 8A (JOB LOADED BY MENU) 00540I* 19 26 CRJOB 00550I* SHUTDOWN FLAG 1A 00560I* BLANK = NO SHUTDOWN 00570I 27 27 CRSHUT 00580I* TIME STARTED 6N 00590I 28 330CRTIME 00600I* DATE STARTED 4N 00610I 34 370CRDATE 00620I* CALL STACK 7 X 6A 00630I 38 79 CALL 00640I******************************************************************** 00650IEMMAST EM 00660I* EMPLOYEE MASTER 00670I* CLOCK # 5N 00680I 1 50EMCLOK 00690I*-------PERSONAL DATA------------------------------------------------ 00700I* NAME 00710I* 1ST 25A 00720I 7 31 EMFNAM 00730I* MIDDLE 25A 00740I 32 56 EMMNAM 00750I* LAST 30A ÐÐ00760I 57 86 EMLNAM 00770I* ADDRESS 00780I* STREET 35A X 2 00790I 87 156 EMS 00800I* CITY 25A 00810I 157 181 EMCITY 00820I* STATE 2A 00830I 182 183 EMSTCD 00840I* ZIP 9P 00850I P 184 1880EMZIP 00860I* TELEPHONE 15A 00870I 189 203 EMPHON 00880I* NOTIFY IN EMERGENCY 25A X 2 00890I 204 253 EME 00900I* EEO CODE 1A X 8 00910I 254 261 EEO 00920I* BIRTH DATE 6N (YMD) 00930I 262 2670EMBIRD 00940I* EDUCATION 30A 00950I 268 297 EMEDUC 00960I* SPOUSE NAME 30A 00970I 298 327 EMSNAM 00980I* SPOUSE BIRTH DATE 6N (YMD) 00990I 328 3330EMSBIR 01000I*-------JOB STATUS---------------------------------------------------- ÐÐ01010I* FILLER 2A 334 335 FFFFFF 01020I* 01030I* DEPT 5P 01040I P 336 3380EMDEPT 01050I* WORK CENTER 3P 01060I P 339 3400EMWC 01070I* JOB NAME 28A 01080I 341 368 EMJOB 01090I* TERMINATION DATE 6N 01100I 510 5150EMDATT 01110I*-------PAYROLL DEDUCTIONS------------------------------------------ 01120I* 01130I* TYPE CODE 2A X 20 01140I 752 791 PRT 01150I* START DATE 6N X 20 01160I 792 911 PRB 01170I* STOP DATE 6N X 20 01180I 9121031 PRS 01190I 7921031 DAT 01200I* AMOUNT CODE (%,$) 1A X 20 01210I 10321051 PRC 01220I* AMOUNT 7.2P X 20 01230I P10521131 PRA 01240I* YTD $ TOTAL 7.2P X 20 01250I P11321211 PRY ÐÐ01260I* ACCOUNT NO. 14A X 20 01270I 12121491 PRN 01280I* LEAVE OF ABSENCE FIELDS - 1492 THRU 1505 01290I* DEDUCTION PROTEXT SWITCH 1A 01300I* L = LOCKED 01310I 15341534 EMDPS 01320I* RECORD STATUS 1A 01330I 15361536 EMSTAT 01340I******************************************************************** 01350IWCMAST WC 01360I 960 960 WCSTAT 01370I******************************************************************* 01380IEFMAST EF 01390I* JOB NAME FILE 01400I* JOB CODE 8A 01410I* 1 8 EFCODE 01420I* JOB NAME 20A 01430I 9 28 EFNAME 01440I* RECORD STATUS 1A 01450I 90 90 EFSTAT 01460C******************************************************************** 01470C* INITIALIZE 01480C EXSR SR101 1-TIME INIT 01490C MOVE ' ' BLK6 6 STUPIDITY 01500C*------------------------------------------------------------------ ÐÐ01510C START TAG 01520C* SET-UP 1ST FIELD NO. 01530C EXSR SR66 INIT A39 01540C MOVE ' ' DUN INIT EDIT ARRAY 01550C Z-ADD1 F 30 FIELD # 01560C EXSR SR205 INIT MAST 01570C MOVE ' ' TPRT 2 STUPIDITY 01580C Z-ADD0 TCLOCK 01590C EXSR SR206 INIT INPUT 01600C EXSR SR70 NEW PAGE 01610C GOTO READ 01620C*------------------------------------------------------------------ 01630C NEXT TAG 01640C EXSR SR66 INIT A39 01650C 1 ADD F F FIELD # 01660C*----------------------------------------------------------------- 01670C READ TAG 01680C* READ DATA FROM TERMINAL. 01690C SETOF 909677 01700C EXSR SR102 VALIDATE FIELD # 01710C 55 GOTO PUT 01720C F COMP 1 54 01730C DUN,1 COMP ' ' 55 01740C 54N55 Z-ADD1 F 01750C EXSR SR201 IDENTIFY-F ÐÐ01760C EXSR SR203 CLASSIFY TRAN 01770C 62 F COMP 4 54 01780C 62 54 GOTO DELETE 01790C SETON 69 01800C N01 EXSR SR72 PROMPT 01810C SETOF 69 01820C EXSR SR75 READ TERMINAL 01830C*------------------------------------------------------------------- 01840C ESCAPE TAG 01850C 90N88 EXSR SR72 DISPLAY INPUT DATA 01860C 95 GOTO SORT 01870C 93 GOTO START NEW ITEM 01880C 92 GOTO JUMP FIELD JUMP REQST 01890C 89 F SUB 1 F SKIP BACKWARD 01900C 89 F COMP 1 54 01910C 89N54 Z-ADD2 F 01920C 89 GOTO READ " " 01930C 88 SETOF 90 SPACE FILL 01940C 88 SETON 77 " " 01950C 87 GOTO PUT 01960C 86 GOTO UPDATE UPDATE 01970C 85 GOTO READ REPEAT 01980C 96 GOTO ERROR ERROR 01990C 77 EXSR SR103 MOVE DATA 02000C*------------------------------------------------------------------- ÐÐ02010C EDIT TAG 02020C N96 EXSR SR104 EDIT DATA 02030C EXSR SR72 REWRITE DATA 02040C 96 GOTO ERROR ERROR 02050C 77 02060COR 90 GOTO ESCAPE 02070C GOTO NEXT 02080C*------------------------------------------------------------------- 02090C PUT TAG 02100C EXSR SR105 FINAL EDIT 02110C 96 GOTO ERROR 02120C EXSR SR107 STORE/DISPLAY 02130C Z-ADD2 F 02140C EXSR SR206 INIT INPUT 02150C GOTO READ 02160C*------------------------------------------------------------------- 02170C DELETE TAG 02180C EXSR SR105 FINAL EDIT 02190C 96 GOTO ERROR 02200C MOVE ' ' PRT,X 02210C Z-ADD0 PRB,X 02220C Z-ADD0 PRS,X 02230C MOVE ' ' PRC,X 02240C Z-ADD0 PRA,X 02250C Z-ADD0 PRY,X ÐÐ02260C MOVE BLK14 PRN,X 02270C EXSR SR206 02280C EXSR SR74 DISPLAY LINE 02290C EXSR SR206 INIT INPUT 02300C Z-ADD2 F 02310C GOTO READ 02320C*------------------------------------------------------------------- 02330C UPDATE TAG 02340C* UPDATE DATA BASE. 02350C EXSR SR106 UPDATE 02360C 96 GOTO ERROR ERROR 02370C GOTO START 02380C*------------------------------------------------------------------- 02390C JUMP TAG 02400C* SET-UP JUMP TO REQUESTED FIELD 02410C 1 ADD W W 30 02420C W COMP 40 54 02430C 54 Z-ADD318 M 50 96 FLAG ERROR 02440C 54 GOTO ERROR BAD ESC 02450C MOVE ' ' W3A 3 02460C MOVEAA14,W W3A 02470C Z-ADD3 W2N 20 02480C EXIT SUBRAJ R. JUSTIFY 02490C RLABL W2N 02500C RLABL W3A ÐÐ02510C MOVE W3A F NEW FIELD # 02520C F COMP 1 54 02530C N54 Z-ADD2 F 02540C GOTO READ 02550C*------------------------------------------------------------------- 02560C SORT TAG 02570C EXSR SR110 SORT ARRAYS 02580C EXSR SR206 INIT INPUT 02590C Z-ADD2 F 02600C GOTO READ 02610C*-------------------------------------------------------------------- 02620C ERROR TAG 02630C EXSR SR102 VALIDATE FIELD # 02640C EXSR SR89 GET MSG 02650C EXSR SR73 PUT MSG 02660C GOTO READ 02670C*-------------------------------------------------------------------- 02680C NEWITM TAG 02690C MOVEL'Q103EM' PROG 8 02700C GOTO END 02710C*------------------------------------------------------------------- 02720C MENU TAG 02730C* SET-UP LINK TO MENU 02740C EXSR SR96 GET CRTFILE 02750C Z-ADD1 W ÐÐ02760C BLK6 LOKUPLNK,W 54 02770C 54 MOVELLNK,W PROG 8 02780C 54 MOVE BLK6 LNK,W 02790C N54 MOVEL'CONTU 'PROG 02800C EXSR SR97 UPDATE CRTFILE 02810C EXSR SR98 >>>>>>>>>>>>> 02820C*-------------------------------------------------------------------- 02830C GOODBY TAG 02840C* LINK TO SIGN-OFF 02850C MOVEL'GOODBY' PROG 02860C*---------------------------------------------------------------- 02870C END TAG 02880C EXSR SR96 GET CRTFILE 02890C EXSR SR97 REWRITE CRTFILE 02900C EXSR SR98 >>>>>>>>>>> 02910C*------------------------------------------------------------------- 02920C ENDJOB TAG 02930C MOVEL'ENDJOB' PROG 02940C EXSR SR98 >>>>>>>>>>>>>>>> 02950C******************************************************************** 02960CSR SR1 BEGSR 02970C* EDIT CLOCK #. 02980CSR TCLOCK COMP 0 54 02990CSRN54 Z-ADD400 M 96 FLAG ERROR 03000CSRN54 GOTO END1 ÐÐ03010CSR EXSR SR80 GET EMMAST 03020CSRN30N31 GOTO T1C GOT IT 03030CSR Z-ADD5 M 96 FLAG ERROR 03040CSR EXSR SR205 INIT EMMAST 03050CSR GOTO END1 03060C*------------------------------------------------------------------- 03070CSR T1C TAG 03080C* IS ON FILE. 03090CSR MOVE ' ' MAN 03100CSR MOVEAEMFNAM MAN 03110CSR EXSR SR111 03120CSR EMMNAM COMP BLK25 54 03130CSR 54 MOVEAEMMNAM MAN,X 03140CSR EXSR SR111 03150CSR MOVEAEMLNAM MAN,X 03160CSR EMDATT COMP 0 43 03170CSR SETON 71 03180CSR EXCPT 03190CSR SETOF 7143 03200CSR EMDPS COMP 'L' 54 03210CSR 54 Z-ADD706 M 96 FLAG ERROR 03220CSR EXSR SR75 03230CSRN90N77 EXSR SR71 PUT SCREEN 03240CSR END1 ENDSR 03250C******************************************************************** ÐÐ03260CSR SR2 BEGSR 03270C* EDIT INDEX (LINE) #. 03280CSR TLINE COMP 0 54 GT 03290CSR 54 TLINE COMP 20 5454 LT/EQ 03300CSRN54 Z-ADD277 M 96 FLAG ERROR 03310CSR 96 EXSR SR207 INIT INPUT 03320CSRN96 EXSR SR108 MOVE FILE TO INPUT 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR3 BEGSR 03360C* EDIT TRAN CODE. 03370CSR EXSR SR203 CLASSIFY TRAN 03380CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 03390CSR ENDSR 03400C******************************************************************** 03410CSR SR4 BEGSR 03420C* EDIT TYPE CODE. 03430CSR TPRT LOKUPTABDED TABDN 54 03440CSR MOVE BLK35 NAME 03450CSR 54 MOVE TABDN NAME 25 03460CSRN54 Z-ADD615 M 96 FLAG ERROR 03470CSRN54 GOTO END4 03480CSR Z-ADD1 D 30 03490C*------------------------------------------------------------------ 03500CSR T4A TAG ÐÐ03510CSR TPRT LOKUPPRT,D 54 03520CSRN54 GOTO END4 03530CSR D COMP TLINE 54 03540CSRN54 Z-ADD279 M 96 FLAG DUPLIC ERROR 03550CSRN54 GOTO END4 03560CSR 1 ADD D D 03570CSR D COMP 20 54 03580CSRN54 GOTO T4A 03590CSR END4 ENDSR 03600C******************************************************************** 03610CSR SR5 BEGSR 03620C* EDIT START DATE 03630CSR Z-ADDTPRB W6N 60 03640CSR EXSR SR208 03650CSR Z-ADDW6N TPRB 03660CSR ENDSR 03670C******************************************************************** 03680CSR SR6 BEGSR 03690C* EDIT STOP DATE 03700CSR Z-ADDTPRS W6N 03710CSR EXSR SR208 03720CSR Z-ADDW6N TPRS 03730CSR TPRS COMP 0 54 03740CSR 54 TPRS COMP TPRB 55 03750CSR 54N55 Z-ADD390 M 96 FLAG ERROR ÐÐ03760CSR ENDSR 03770C******************************************************************* 03780CSR SR7 BEGSR 03790C* EDIT AMOUNT CODE 03800CSR TPRC COMP '%' 54 03810CSRN54 MOVE '$' TPRC 03820CSR ENDSR 03830C******************************************************************** 03840CSR SR66 BEGSR 03850CSR MOVEABLK35 A39,3 INIT A39 03860CSR ENDSR 03870C******************************************************************** 03880CSR SR67 BEGSR 03890CSR EXITFZCR 03900CSR ENDSR 03910C***************************************************************** 03920CSR SR68 BEGSR 03930CSR EXITFZLF LINE FEED 03940CSR ENDSR 03950C**************************************************************** 03960CSR SR69 BEGSR 03970CSR 50 EXITFZPUTXY MOVE CURSOR 03980CSR RLABL RPGLIN 03990CSR RLABL RPGCOL 04000CSRN50 EXITFZMOVXY MOVE CURSOR ÐÐ04010CSR RLABL RPGLIN 04020CSR RLABL RPGCOL 04030CSR ENDSR 04040C***************************************************************** 04050CSR SR70 BEGSR 04060C* CLEAR TERM SCREEN. 04070CSR 50 EXITFZISTAT INIT STATUS LINE 04080CSR 50 EXITFZESCH CLEAR SCREEN 04090CSRN50 EXITFZCPAGE CLEAR SCREEN 04100CSRN50 MOVEL'091' RPGLIN 04110CSRN50 MOVEL'001' RPGCOL 04120CSRN50 EXSR SR69 MOVE CURSOR 04130CSR SETON 70 04140CSRN51 EXCPT PUT HDG 1ST LINE 04150CSR SETOF 70 04160CSR ENDSR 04170C********************************************************************** 04180CSR SR71 BEGSR 04190C* PUT HEADINGS TO TERMINAL 04200CSR SETON 76 04210CSR EXCPT PUT HEADINGS 04220CSR SETOF 7643 04230CSR Z-ADD1 X 04240C*------------------------------------------------------------------- 04250CSR T71A TAG ÐÐ04260CSR EXSR SR74 04270CSR 1 ADD X X 04280CSR X COMP 20 54 04290CSRN54 GOTO T71A 04300CSR END71 ENDSR 04310C********************************************************************* 04320CSR SR72 BEGSR 04330C* PUT INPUT LINE TO TERMINAL 04340CSR 50 MOVEL'022' RPGLIN 4 04350CSRN50 MOVEL'117' RPGLIN 04360CSR MOVEL'001' RPGCOL 4 04370CSR EXSR SR69 MOVE CURSOR 04380CSR SETON 72 04390CSR EXCPT PUT INPUT 04400CSR SETOF 72 04410CSR ENDSR 04420C******************************************************************** 04430CSR SR73 BEGSR 04440C* PUT MESSAGE. 04450CSR 50 MOVEL'023' RPGLIN 04460CSRN50 MOVEL'119' RPGLIN 04470CSR MOVEL'001' RPGCOL 04480CSR EXSR SR69 MOVE CURSOR 04490CSR SETON 73 04500CSR EXCPT PUT MSG ÐÐ04510CSR SETOF 73 04520CSR Z-ADD1 ERRFLG 30 04530CSR ENDSR 04540C******************************************************************** 04550CSR SR74 BEGSR 04560C* DISPLAY DEDUCTION LINE. 04570CSR PRT,X LOKUPTABDED TABDN 54 04580CSR MOVE BLK35 NAME 04590CSR 54 MOVE TABDN NAME 04600CSR PRC,X COMP '%' 51 04610CSR PRC,X COMP '$' 52 04620CSR 51 MOVE PRA,X W7N 70 04630CSR 1 ADD X W3N 30 04640CSRN50 90 ADD W3N W3N 04650CSR MOVELW3N RPGLIN 04660CSR MOVEL'001' RPGCOL 04670CSR EXSR SR69 MOVE CURSOR 04680CSR SETON 74 04690CSR EXCPT DISPLAY DATA 04700CSR SETOF 74 04710CSR MOVE BLK35 NAME 04720CSR ENDSR 04730C******************************************************************* 04740CSR SR75 BEGSR 04750C* READ FROM TERMINAL ÐÐ04760CSR SETOF 779096 04770CSR SETOF 939295 04780CSR SETOF 898887 04790CSR SETOF 8685 04800CSR EXSR SR66 INIT A39 04810CSR MOVE BLK14 W14A 14 BUFFER 04820CSR 50 MOVEL'023' RPGLIN 04830CSRN50 MOVEL'118' RPGLIN 04840CSR MOVELCOL,F RPGCOL 4 04850CSR 01 50 MOVEL'001' RPGLIN 04860CSR 01N50 MOVEL'091' RPGLIN 04870CSR EXSR SR69 MOVE CURSOR 04880CSR EXITFZR14 READ FROM TERMINAL 04890CSR RLABL W14A READ BUFFER 04900CSR MOVEAW14A A14 INPUT DATA ARRAY 04910CSR MOVE BLK14 W14A INIT INPUT ARRAY 04920CSR Z-ADD1 W 30 04930CSR '\' LOKUPA14,W 90 FLAG ESC 04940CSRN90 GOTO T75B NOT ESC 04950CSR 1 ADD W W 04960CSR W COMP 40 54 04970CSR 54 GOTO T75A BAD ESC 04980CSR A14,W COMP 'G' 98 GOODBY 04990CSR A14,W COMP 'E' 94 MENU 05000CSR A14,W COMP 'N' 93 NEW ITEM ÐÐ05010CSR A14,W COMP 'J' 92 JUMP 05020CSR A14,W COMP 'B' 89 SKIP BKWRD 05030CSR A14,W COMP 'S' 88 SPACE FILL 05040CSR A14,W COMP 'D' 87 DONE 05050CSR A14,W COMP 'U' 86 UPDATE 05060CSR A14,W COMP 'R' 85 REPEAT 05070CSR A14,W COMP '@' 95 RESEQ 05080CSR 98 GOTO GOODBY 05090CSR 94 GOTO MENU 05100CSR 93 GOTO NEWITM 05110CSR 92 05120COR 89 05130COR 88 05140COR 86 05150COR 85 GOTO END75 GOOD ESC 05160C*------------------------------------------------------------------ 05170CSR T75A TAG 05180C* FLAG BAD ESC INPUT 05190CSR Z-ADD318 M 96 FLAG ERROR 05200CSR GOTO END75 05210C*-------------------------------------------------------------------- 05220CSR T75B TAG 05230C* MOVE DATA 05240CSR Z-ADD1 W 05250CSR ' ' LOKUPA14,W 77 ÐÐ05260CSR 77 MOVEAA14,W W14A INPUT DATA 05270C*-------------------------------------------------------------------- 05280CSR END75 TAG 05290C* INIT PREV ERROR MSG. 05300CSR MOVEABLK35 A39,3 05310CSR ERRFLG COMP 0 54 05320CSR 54 Z-ADD0 ERRFLG 05330CSR 54 EXSR SR73 05340CSR ENDSR 05350C********************************************************************** 05360CSR SR80 BEGSR 05370C* GET MASTER RECORD 05380CSR SETOF 31 05390CSR TCLOCK CHAINEMMAST 30 GET MASTER 05400CSRN30 EMSTAT COMP 'D' 31 FLAG DELETE 05410CSR 30 05420COR 31 EXSR SR205 INIT MASTER 05430CSR EXSR SR207 SAVE MASTER 05440CSR ENDSR 05450C*********************************************************************** 05460CSR SR82 BEGSR 05470C* REWRITE MASTER 05480CSR SETON 82 05490CSR EXCPT REWRITE MASTER 05500CSR SETOF 82 ÐÐ05510CSR ENDSR 05520C******************************************************************** 05530CSR SR89 BEGSR 05540C* GET MESSAGE MASTER 05550CSR M CHAINMGFILE 54 05560CSR 54 MOVE BLK35 MGTEXT 05570CSR 54 MOVELM MGTEXT 05580CSR 54 MOVE MES,1 MGTEXT 05590CSR MOVEAMGTEXT A39,3 05600CSR ENDSR 05610C******************************************************************** 05620CSR SR96 BEGSR 05630CSR # CHAINCRTFILE H9 GET CRTFILE 05640CSR H9 GOTO ENDJOB 05650CSR ENDSR 05660C****************************************************************** 05670CSR SR97 BEGSR 05680C* UPDATE CRTFILE. EXIT PROGRAM. 05690CSR TIME CRTIME 05700CSR MOVELUDATE CRDATE 05710CSR SETON 97 05720CSR EXCPT UPDATE CRTFILE 05730CSR SETOF 97 05740CSR ENDSR 05750C******************************************************************** ÐÐ05760CSR SR98 BEGSR 05770CSR SETON 51 05780CSR EXSR SR70 CLEAR SCREEN 05790CSR EXITFCHAIN >>>>>>>>>> 05800CSR RLABL PROG 05810CSR ENDSR 05820C******************************************************************** 05830CSR SR99 BEGSR 05840C* STORE THIS PROG AS RETURN TO PROG. 05850CSR EXSR SR96 GET CRTFILE 05860CSR Z-ADD8 W 05870C*------------------------------------------------------------------- 05880CSR T99A TAG 05890CSR W SUB 1 W 54 05900CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 05910CSR LNK,W COMP BLK6 54 05920CSRN54 GOTO T99A 05930CSR MOVELRETURN LNK,W 05940CSR EXSR SR97 UPDATE CRTFILE 05950CSR EXSR SR98 >>>>>>>>>>>>>> 05960CSR END99 ENDSR 05970C*********************************************************************** 05980CSR SR101 BEGSR 05990C* 1-TIME INITIALIZE 06000CSR MOVE BIT,1 NUL ÐÐ06010CSR MOVE ' ' A39 06020CSR MOVE BIT,28 A39,1 06030CSR MOVE 'D' A39,2 06040CSR MOVE BIT,28 A39,38 06050CSR MOVE 'E' A39,39 06060CSR Z-ADD9 FLIMIT 30 TOTAL NUMB FIELDS 06070CSR MOVE ' ' BLK14 14 06080CSR Z-ADD17 X 30 06090CSR MOVE '-' DOT 06100CSR MOVEL'>' DOT,X 06110CSR MOVE ' ' DOT,X 06120C* GET PORT # AND CRTFILE 06130CSR MOVE ' ' W2A 2 06140CSR EXITFZGMINX GET PORT # 06150CSR RLABL W2A 06160CSR MOVE W2A # 20 PORT NO. 06170CSR # COMP 0 54 06180CSRN54 Z-ADD25 # DEFAULT 06190CSR EXSR SR96 GET CRTFILE 06200CSR MOVE CALL LNK 06210CSR MOVE 'Q103EM 'PROG 06220CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 06230CSR TST,# COMP 'S' 56 06240CSRN56 CRSHUT COMP 'S' 56 06250CSR 56 MOVE 'S' CRSHUT SHUTDOWN ÐÐ06260CSR 56 MOVE 'SHUTDOWN'PROG 06270CSR EXSR SR97 UPDATE CRTFILE 06280CSR 56 EXSR SR98 >>>>>>>>>>>>> 06290C* DEFINE WORK FIELDS,ETC. 06300CSR MOVE BLK8 RETURN 8 06310CSR MOVE ' ' BLK35 35 06320CSR MOVE ' ' BLK28 28 06330CSR MOVE ' ' BLK25 25 06340CSR MOVE ' ' BLK30 30 06350CSR MOVE ' ' BLK20 20 06360CSR MOVE ' ' BLK8 8 06370CSR MOVE ' ' BLK15 15 06380CSR MOVE ' ' BLK6 6 06390CSR ENDSR 06400C********************************************************************** 06410CSR SR102 BEGSR 06420C* VALIDATE FIELD NO. 06430CSR F COMP 0 54 06440CSRN54 Z-ADD2 F 06450CSR F COMP FLIMIT 55 06460CSR 55 Z-ADD2 F 06470CSR ENDSR 06480C******************************************************************** 06490CSR SR103 BEGSR 06500C* MOVE INPUT DATA ÐÐ06510CSR EXSR SR201 IDENTIFY-F 06520CSR EXSR SR202 RIGHT ADJUST 06530CSR 01 MOVE W10A TCLOCK 50 CLOCK # 06540CSR 02 MOVE W10A TLINE 30 INDEX 06550CSR 03 MOVELW14A TRAN 1 TRAN CODE 06560CSR 04 MOVELW14A TPRT 2 TYPE CODE 06570CSR 05 MOVE W10A TPRB 60 START DATE 06580CSR 06 MOVE W10A TPRS 60 STOP DATE 06590CSR 07 MOVELW14A TPRC 1 AMT CODE 06600CSR 08 MOVE W10A TPRA 72 AMT $ 06610CSR 09 MOVELW14A TPRN 14 ACCOUNT 06620CSR MOVE ' ' DUN,F EDIT FLAG 06630CSR ENDSR 06640C******************************************************************** 06650CSR SR104 BEGSR 06660C* EDIT INPUT DATA 06670CSR SETOF 9077 06680CSR EXSR SR203 CLASSIFY TRAN 06690CSR 01 EXSR SR1 06700CSR 02 EXSR SR2 06710CSR 03 EXSR SR3 06720CSR 04N62 EXSR SR4 06730CSR 05N62 EXSR SR5 06740CSR 06N62 EXSR SR6 06750CSR 07N62 EXSR SR7 ÐÐ06760CSR 96 MOVE ' ' DUN,F EDIT FLAG 06770CSRN96 MOVE 'X' DUN,F 06780CSR ENDSR 06790C*********************************************************************** 06800CSR SR105 BEGSR 06810C* FINAL EDIT 06820CSR SETOF 77 06830CSR SETON 79 FINAL EDIT FLAG 06840CSR Z-ADD1 F 96 06850C*-------------------------------------------------------------------- 06860CSR T105A TAG 06870CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06880CSRN54 GOTO END105 06890CSR EXSR SR201 IDENTIFY-F 06900CSR EXSR SR104 EDIT 06910CSRN96 GOTO T105A 06920C*-------------------------------------------------------------------- 06930CSR END105 TAG 06940CSR SETOF 79 06950CSR ENDSR 06960C******************************************************************** 06970CSR SR106 BEGSR 06980C* UPDATE DATA BASE. 06990CSRN30N31 GOTO T106E GOT IT 07000C* FLAG NO MASTER ERROR ÐÐ07010CSR Z-ADD302 M 96 FLAG ERROR 07020CSR Z-ADD1 F FIELD # 07030CSR GOTO END106 07040C*----------------------------------------------------------------------- 07050CSR T106E TAG 07060C* REWRITE MASTER 07070CSR EXSR SR82 REWRITE MAST 07080CSR END106 ENDSR 07090C******************************************************************** 07100CSR SR107 BEGSR 07110C* STORE DATA IN ARRAYS AND DISPLAY. 07120CSR EXSR SR109 MOVE DATA 07130CSR EXSR SR74 DISPLAY 07140CSR ENDSR 07150C******************************************************************** 07160CSR SR108 BEGSR 07170C* MOVE FILE DATA TO INPUT FIELDS. 07180CSRN49 Z-ADDTLINE X 07190CSRN49 Z-ADDEMCLOK TCLOCK 07200CSR MOVE PRT,X TPRT 07210CSR Z-ADDPRB,X TPRB 07220CSR Z-ADDPRS,X TPRS 07230CSR MOVE PRC,X TPRC 07240CSR Z-ADDPRA,X TPRA 07250CSR MOVE PRN,X TPRN ÐÐ07260CSRN49 EXSR SR72 PUT INPUT LINE 07270CSR ENDSR 07280C******************************************************************** 07290CSR SR109 BEGSR 07300C* MOVE INPUT DATA TO FILE 07310CSRN49 Z-ADDTLINE X 07320CSR MOVE TPRT PRT,X 07330CSR Z-ADDTPRB PRB,X 07340CSR Z-ADDTPRS PRS,X 07350CSR MOVE TPRC PRC,X 07360CSR Z-ADDTPRA PRA,X 07370CSR MOVE TPRN PRN,X 07380CSRN49 MOVELPRB,X DAT,X 07390CSRN49 MOVE PRS,X DAT,X 07400CSRN49 EXSR SR74 07410CSR ENDSR 07420C******************************************************************** 07430CSR SR110 BEGSR 07440C* SORT ROUTINE 07450CSR SETON 49 07460CSR Z-ADD0 C 30 07470C*------------------------------------------------------------------- 07480CSR T110C TAG 07490CSR 1 ADD C C 07500CSR C COMP 20 54 54 ÐÐ07510CSR 54 GOTO END110 07520CSR Z-ADDC H 30 07530C*-------------------------------------------------------------- 07540CSR T110D TAG 07550CSR MOVELPRT,C C8 8 07560CSR MOVE PRB,C C8 07570C*------------------------------------------------------------------- 07580CSR T110E TAG 07590CSR 1 ADD H H 07600CSR H COMP 20 54 07610CSR 54 GOTO T110C 07620CSR PRT,H COMP ' ' 54 07630CSRN54 GOTO T110E 07640CSR MOVELPRT,H H8 8 07650CSR MOVE PRB,H H8 07660CSR C8 COMP H8 54 07670CSR PRT,C COMP ' ' 55 07680CSRN54N55 GOTO T110E 07690C*------------------------------------------------------------------- 07700CSR T110G TAG 07710CSR Z-ADDC X 30 07720CSR EXSR SR108 HOLD FROM DATA 07730CSR Z-ADDPRY,C YTD 72 07740CSR MOVE PRT,H PRT,C 07750CSR Z-ADDPRB,H PRB,C ÐÐ07760CSR Z-ADDPRS,H PRS,C 07770CSR MOVE PRC,H PRC,C 07780CSR Z-ADDPRA,H PRA,C 07790CSR Z-ADDPRY,H PRY,C 07800CSR MOVE PRN,H PRN,C 07810CSR Z-ADDH X 30 07820CSR EXSR SR109 MOVE TO DATA 07830CSR Z-ADDYTD PRY,H 07840CSR GOTO T110D 07850C*------------------------------------------------------------------- 07860CSR END110 TAG 07870CSR MOVELPRB DAT 07880CSR MOVE PRS DAT 07890CSR EXSR SR71 07900CSR EXSR SR206 07910CSR SETOF 49 07920CSR ENDSR 07930C******************************************************************** 07940CSR SR111 BEGSR 07950C** FIND MOVE POINT FOR MAN'S NAME (SR1) 07960CSR Z-ADD46 X 30 07970C*------------------------------------------------------------------- 07980CSR T111A TAG 07990CSR X SUB 1 X 54 08000CSRN54 Z-ADD1 X ÐÐ08010CSRN54 GOTO END111 08020CSR MAN,X COMP ' ' 54 08030CSRN54 GOTO T111A 08040CSR 2 ADD X X 08050CSR X COMP 45 54 08060CSR 54 Z-ADD45 X 08070CSR END111 ENDSR 08080C******************************************************************** 08090CSR SR201 BEGSR 08100C* IDENTIFY FIELD NO. 08110CSR F COMP 1 01 08120CSR F COMP 2 02 08130CSR F COMP 3 03 08140CSR F COMP 4 04 08150CSR F COMP 5 05 08160CSR F COMP 6 06 08170CSR F COMP 7 07 08180CSR F COMP 8 08 08190CSR F COMP 9 09 08200CSR ENDSR 08210C********************************************************************** 08220CSR SR202 BEGSR 08230C* RIGHT JUSTIFY 08240CSR F LOKUPNUM 54 08250CSRN54 GOTO END202 NOT NUMERIC FIELD ÐÐ08260CSR Z-ADD10 W2N 20 08270CSR MOVELW14A W10A 10 08280CSR EXIT SUBRAJ R. JUSTIFY 08290CSR RLABL W2N 08300CSR RLABL W10A 08310CSR END202 ENDSR 08320C******************************************************************** 08330CSR SR203 BEGSR 08340C* CLASSIFY TRAN CODE. 08350CSR TRAN COMP 'A' 60 ADD 08360CSR TRAN COMP 'C' 61 CHG 08370CSR TRAN COMP 'D' 62 DEL 08380CSR ENDSR 08390C******************************************************************** 08400CSR SR205 BEGSR 08410C* INIT EMMAST FIELDS. 08420CSR Z-ADD0 EMCLOK 08430CSR MOVE BLK35 EMFNAM 08440CSR MOVE BLK35 EMMNAM 08450CSR MOVE BLK35 EMLNAM 08460CSR MOVE ' ' EMS 08470CSR MOVE BLK35 EMCITY 08480CSR MOVE ' ' EMSTCD 08490CSR Z-ADD0 EMZIP 08500CSR MOVE BLK15 EMPHON ÐÐ08510CSR MOVE ' ' EME 08520CSR MOVE ' ' EEO 08530CSR Z-ADD0 EMBIRD 08540CSR MOVE BLK35 EMEDUC 08550CSR MOVE BLK35 EMSNAM 08560CSR Z-ADD0 EMSBIR 08570CSR Z-ADD0 EMDEPT 08580CSR Z-ADD0 EMWC 08590CSR MOVE BLK35 EMJOB 08600CSR MOVE ' ' PRT 08610CSR Z-ADD0 PRB 08620CSR Z-ADD0 PRS 08630CSR MOVE ' ' PRC 08640CSR Z-ADD0 PRA 08650CSR Z-ADD0 PRY 08660CSR MOVE ' ' PRN 08670CSR MOVE ' ' EMSTAT 08680CSR MOVE BLK35 NAME 08690CSR MOVE ' ' MAN 08700CSR ENDSR 08710C****************************************************************** 08720CSR SR206 BEGSR 08730C* INIT INPUT ONLY FIELDS 08740CSR Z-ADD0 TLINE LINE # 08750CSR MOVE ' ' TRAN TRAN CODE ÐÐ08760CSR MOVE ' ' TPRT TYPE CODE 08770CSR Z-ADD0 TPRB START DATE 08780CSR Z-ADD0 TPRS STOP DATE 08790CSR MOVE ' ' TPRC AMT CODE 08800CSR Z-ADD0 TPRA AMT $ 08810CSR MOVE BLK14 TPRN ACCOUNT 08820CSR MOVE BLK35 NAME 08830CSR ENDSR 08840C****************************************************************** 08850CSR SR207 BEGSR 08860C* SAVE MASTER "OLD" FIELDS 08870CSR ENDSR 08880C******************************************************************** 08890CSR SR208 BEGSR 08900C* DATE EDIT ROUTINE. SEE SR5 & SR6. 08910CSR MOVELW6N W2N 08920CSR W2N COMP 12 54 08930CSRN54 MOVELW6N W4N 40 08940CSRN54 MOVE W6N W2N 08950CSRN54 MOVELW2N W6N 08960CSRN54 MOVE W4N W6N 08970CSR W6N COMP 0 54 08980CSRN54 GOTO END208 08990CSR MOVELW6N W2N 09000CSR W2N COMP 60 54 GT ÐÐ09010CSR 54 W2N COMP 90 54 LT 09020CSRN54 Z-ADD390 M 96 FLAG ERROR 09030CSR MOVE W6N W4N 09040CSR MOVELW4N W2N 09050CSR W2N COMP 0 54 GT 09060CSR 54 W2N COMP 12 5454 LE 09070CSRN54 Z-ADD390 M 96 FLAG ERROR 09080CSR MOVE W4N W2N 09090CSR W2N COMP 0 54 GT 09100CSR 54 W2N COMP 31 5454 LE 09110CSRN54 Z-ADD390 M 96 FLAG ERROR 09120CSR END208 ENDSR 09130O******************************************************************** 09140OTERM132 E 70 09150O OR 71 09160O BIT,28 1 09170O N50 8 '8091001' 09180O N50 BIT,1 9 09190O N50 BIT,1 10 09200O 50 10 '[001 ]001' 09210O 50 BIT,28 6 09220O DOT 44 09230O 25 '(1) CLOCK NO.' 09240O TCLOCKZ 51 09250O MAN 97 ÐÐ09260O 71 105 'PAUSE' 09270O 43 50 BIT,28 110 09280O 43 50 111 'D' 09290O 43 121 'TERMINATED' 09300O 43 EMDATTY 130 09310O 43 50 BIT,28 131 09320O 43 50 132 'E' 09330O N71 A39 132 09340O*------------------------------------------------------------------- 09350O E 76 09360O BIT,28 1 09370O N50 8 '8091001' 09380O N50 BIT,1 9 09390O N50 BIT,1 10 09400O 50 10 '[001 ]001' 09410O 50 BIT,28 6 09420O 33 'LINE' 09430O 39 'TRAN' 09440O 46 'TYPE' 09450O 81 'START' 09460O 90 'STOP' 09470O 100 'CODE' 09480O*------------------------------------------------------------------- 09490O E 76 09500O 22 'NO.' ÐÐ09510O 29 'CODE' 09520O 36 'CODE' 09530O 49 'DESCRIPTION' 09540O 70 'DATE' 09550O 80 'DATE' 09560O 91 '% OR $' 09570O 102 'AMOUNT' 09580O 115 'ACCOUNT-NO.' 09590O 132 'YEAR-TO-DATE' 09600O*------------------------------------------------------------------- 09610O E 74 09620O X Z 22 09630O PRT,X 35 09640O NAME 62 09650O PRB,X 73 ' - - ' 09660O PRS,X 83 ' - - ' 09670O PRC,X 88 09680O 52 PRA,X 2 102 09690O 51 W7N Z 102 09700O 52 93 '$' 09710O 51 103 '%' 09720O PRN,X 118 09730O PRY,X 2 132 09740O*------------------------------------------------------------------- 09750O E 72 ÐÐ09760O TLINE Z 22 09770O TRAN 28 09780O TPRT 35 09790O NAME 62 09800O TPRB 73 ' - - ' 09810O TPRS 83 ' - - ' 09820O TPRC 88 09830O TPRA 2 102 09840O TPRN 118 09850O 16 'ENTER DATA HERE:' 09860O*------------------------------------------------------------------ 09870O E 73 09880O A39 39 09890O BIT,28 131 09900O 132 'K' 09910O**************************************************************** 09920OCRTFILE E 97 09930O PROG 26 09940O CRTIME 33 09950O CRDATE 37 09960O LNK 79 09970O******************************************************************** 09980OEMMAST E 82 09990O EMFNAM 31 10000O EMMNAM 56 ÐÐ10010O EMLNAM 86 10020O EMS 156 10030O EMCITY 181 10040O EMSTCD 183 10050O EMZIP 188P 10060O EMPHON 203 10070O EME 253 10080O EEO 261 10090O EMBIRD 267 10100O EMEDUC 297 10110O EMSNAM 327 10120O EMSBIR 333 10130O EMDEPT 338P 10140O EMWC 340P 10150O EMJOB 368 10160O PRT 791 10170O PRB 911 10180O PRS 1031 10190O PRC 1051 10200O PRA 1131P 10210O PRY 1211P 10220O PRN 1491 10230O EMSTAT 1536 ** NUL ARRAY 010240 10250ÐÐ** A14 ARRAY 10260 10270** COL ARRAY 10280039 1 CLOCK 10290021 2 LINE 10300029 3 TRAN 10310035 4 TYPE 10320069 5 START 10330079 6 STOP 10340089 7 AMT CODE 10350095 8 AMOUNT 10360106 9 ACCOUNT 10370** A39 ARRAY 10380 10390** NUM ARRAY 010400001 CLOCK 10410002 LINE 10420005 START 10430006 STOP 10440008 AMOUNT 10450** DUN ARRAY 10460 010470** MES ARRAY 010480---MESSAGE NOT ON FILE--- 010490** LNK ARRAY 010500ÐÐ 10510** DOT ARRAY 10520 10530** TABDED/TABDN 10540A1ADVANCE 10550I1LONG-TERM DISABILITY 10560I2MAJOR MEDICAL 10570I3DENTAL-LIBERTY MUTUAL 10580I4DENTAL-BLUE CROSS 10590S1SAVINGS 10600U1CREDIT UNION 10610W1UNITED WAY 10620. 10630. 10640. 10650. 10660. 10670. 10680. 10690. 10700. 10710. 10720. 10730. 10740** MAN ARRAY 10750ÐÐ 10760/* 10770_‚ ÐÐ_‚_‚ 10760/* 10770_‚ ÐÈ(°dœ °ôX002PJ P999999120282(èÈÐ00260E PC$ 2 9 2 ACTUAL $ CUR MO 00270E BIT 33 1 SCREEN CONTR. CHAR 00280E CALL 7 6 00290E PT$ 2 9 2 TRSFR $ 00300I******************************************************************* 00310IBITPAR BT 00320I 1 33 BIT 00330I 34 58 PAR 00340I 59 83 TST 00350I******************************************************************** 00360ICRTFILE CR 00370I 1 50CREMPL 00380I 6 13 CRUSER 00390I 14 180CRDEPT 00400I 19 26 CRJOB 00410I 27 27 CRSHUT 00420I 28 330CRTIME 00430I 34 370CRDATE 00440I 38 79 CALL 00450I******************************************************************** 00460IMGFILE MG 00470I* MESSAGE FILE. 00480I 1 35 MGTEXT 00490I******************************************************************** 00500IPJMAST PJ ÐÐ00510I* PROJECT WORK ORDER. 00520I* WORK ORDER NO. 00530I 1 9 PJWO 00540I* PRIME 6A 00550I 1 6 PJWOP 00560I* DASH 3N 00570I 7 90PJWOD 00580I* DEPT 3N 00590I 10 120PJDEPT 00600I* ACCOUNT 5N 00610I 13 170PJACNT 00620I* MODEL 12A 00630I 18 29 PJMODL 00640I* DESCRIPTION 40A 00650I 30 69 PJDESC 00660I* SCHEDULE. 00670I* START DATE 6N 00680I 70 750PJBSD 00690I* COMPLETION DATE 6N 00700I 76 810PJBCD 00710I* BUDGET - LABOR HRS 7P 00720I P 82 850PJBLH 00730I* BUDGET - LABOR $ 7P 00740I P 86 89 PB$,1 00750I* BUDGET - MATERIAL $ 7P ÐÐ00760I P 90 93 PB$,2 00770I* ACTUAL. 00780I* START DATE 6N 00790I 94 990PJASD 00800I* COMPLETION DATE 6N 00810I 100 1050PJACD 00820I* LABOR HRS 7.1P 00830I P 106 1091PJALH 00840I* LABOR $ 9.2P 00850I P 110 114 PA$,1 00860I* MATERIAL $ 9.2P 00870I P 115 119 PA$,2 00880I* STATUS. 00890I* LABOR - % COMPLETE 3.2P 00900I P 120 1212PJLPCT 00910I* MATERIAL - % COMPLETE 3.2P 00920I P 122 1232PJMPCT 00930I* CURRENT MONTH - ACTUAL. 00940I* LABOR HRS 7.1P 00950I P 124 1271PJCLH 00960I* LABOR $ 9.2P 00970I P 128 132 PC$,1 00980I* MATERIAL $ 9.2P 00990I P 133 137 PC$,2 01000I* TRANSFER $ 2 X 9.2P ÐÐ01010I P 138 147 PT$ 01020I* RECORD STATUS 1A 01030I 170 170 PJSTAT 01040C******************************************************************** 01050C* INITIALIZE 01060C EXSR SR101 1-TIME INIT 01070C MOVE ' ' BLK6 6 01080C*------------------------------------------------------------------ 01090C START TAG 01100C* SET-UP 1ST FIELD NO. 01110C EXITFQTOPF TOP OF FORM 01120C Z-ADD0 TBSD 01130C Z-ADD0 TBCD 01140C Z-ADD0 TBLH 01150C Z-ADD0 TB$ 01160C Z-ADD0 TASD 01170C Z-ADD0 TACD 01180C Z-ADD0 THRVAR 01190C Z-ADD0 VAR 01200C Z-ADD0 TLPCT 01210C******** Z-ADD0 TMPCT 01220C Z-ADD0 TDEPT 01230C MOVE BLK35 TMODL 01240C MOVE BLK40 TDESC 01250C MOVE BLK35 DEPNAM ÐÐ01260C EXSR SR205 INIT FILE FIELDS 01270C EXSR SR70 PUT HEADINGS 01280C SETOF 2928 01290C MOVE ' ' DUN INIT EDIT ARRAY 01300C Z-ADD1 F 30 FIELD # 01310C GOTO READ 01320C*------------------------------------------------------------------ 01330C NEXT TAG 01340C* SET-UP NEXT FIELD NO. 01350C 1 ADD F F FIELD # 01360C*----------------------------------------------------------------- 01370C READ TAG 01380C* READ DATA FROM TERMINAL. 01390C SETOF 909677 01400C EXSR SR102 VALIDATE FIELD # 01410C 55 GOTO UPDATE DONE 01420C EXSR SR201 IDENTIFY-F 01430C 13 01440COR 14 01450COR 15 01460COR 16 01470COR 17 01480COR 19 GOTO NEXT BYPASS FIELDS 01490C SETON 69 01500C EXSR SR72 PROMPT ÐÐ01510C SETOF 69 01520C EXSR SR75 READ TERMINAL 01530C N77N88 EXSR SR104 EDIT INPUT FIELD 01540C 96 ERROR 01550CORN77N88 EXSR SR72 REWRITE INPUT DATA 01560C 92 GOTO JUMP FIELD JUMP REQST 01570C 89 F SUB 1 F SKIP BACKWARD 01580C 89 GOTO READ " " 01590C 88 SETOF 90 SPACE FILL 01600C 88 SETON 77 " " 01610C 86 GOTO UPDATE UPDATE 01620C 85 GOTO READ REPEAT 01630C 96 GOTO ERROR ERROR 01640C N77 GOTO EDIT NO DATA INPUT 01650C*------------------------------------------------------------------ 01660C PROCES TAG 01670C* PROCESS INPUT DATA 01680C EXSR SR103 MOVE DATA 01690C*------------------------------------------------------------------- 01700C EDIT TAG 01710C N96 EXSR SR104 EDIT DATA 01720C EXSR SR72 REWRITE DATA 01730C 96 GOTO ERROR ERROR 01740C GOTO NEXT 01750C*------------------------------------------------------------------ ÐÐ01760C UPDATE TAG 01770C* UPDATE DATA BASE. 01780C EXSR SR105 FINAL EDIT 01790C 96 GOTO ERROR ERROR 01800C EXSR SR106 UPDATE 01810C 96 GOTO ERROR ERROR 01820C GOTO START 01830C*------------------------------------------------------------------- 01840C JUMP TAG 01850C* SET-UP JUMP TO REQUESTED FIELD 01860C 1 ADD W W 30 01870C W COMP 40 54 01880C 54 Z-ADD318 M 50 96 FLAG ERROR 01890C 54 GOTO ERROR BAD ESC 01900C MOVE ' ' W3A 3 01910C MOVEAA40,W W3A 01920C Z-ADD3 W2N 20 01930C EXIT SUBRAJ R. JUSTIFY 01940C RLABL W2N 01950C RLABL W3A 01960C MOVE W3A F NEW FIELD # 01970C GOTO READ 01980C*-------------------------------------------------------------------- 01990C ERROR TAG 02000C EXSR SR102 VALIDATE FIELD # ÐÐ02010C EXSR SR89 GET MSG 02020C EXSR SR73 PUT MSG 02030C GOTO READ 02040C*------------------------------------------------------------------ 02050C NEWITM TAG 02060C* SET-UP LINK FOR NEW ITEM 02070C MOVEL'Q002PJ' PROG 8 02080C GOTO END 02090C*------------------------------------------------------------------- 02100C MENU TAG 02110C* SET-UP LINK TO MENU 02120C EXSR SR96 GET CRTFILE 02130C Z-ADD1 W 02140C BLK6 LOKUPLNK,W 54 02150C 54 MOVELLNK,W PROG 02160C 54 MOVE BLK6 LNK,W 02170C N54 MOVEL'CONTU' PROG 02180C EXSR SR97 UPD CRTFILE 02190C EXSR SR98 >>>>>>>>>> 02200C*-------------------------------------------------------------------- 02210C GOODBY TAG 02220C* LINK TO SIGN-OFF 02230C MOVEL'GOODBY' PROG 02240C GOTO END 02250C*------------------------------------------------------------------- ÐÐ02260C END TAG 02270C EXSR SR96 GET CRTFILE 02280C EXSR SR97 UPD CRTFILE 02290C EXSR SR98 >>>>>>>>>> 02300C*------------------------------------------------------------------- 02310C ENDJOB TAG 02320C MOVEL'ENDJOB 'PROG 02330C EXSR SR98 >>>>>>>>>> 02340C********************************************************************* 02350CSR SR1 BEGSR 02360C* EDIT TRAN CODE. 02370CSR EXSR SR203 CLASSIFY TRAN 02380CSRN60N61N62 Z-ADD199 M 96 FLAG ERROR 02390CSR ENDSR 02400C******************************************************************* 02410CSR SR2 BEGSR 02420C* EDIT WORK ORDER. 02430CSR TWOP COMP ' ' 54 02440CSRN54 Z-ADD341 M 96 FLAG ERROR 02450CSR ENDSR 02460C********************************************************************** 02470CSR SR3 BEGSR 02480C* EDIT DEPT #. 02490CSR MOVE BLK35 DEPNAM 17 02500CSR TDEPT COMP 0 55 ÐÐ02510CSRN55 TDEPT COMP 1 54 02520CSR 54 02530CORN55 GOTO T3B 02540CSR Z-ADDTDEPT W5N 50 02550CSR W5N LOKUPTABDEP TABNAM 56 02560CSRN56 Z-ADD304 M 96 FLAG ERROR 02570CSRN56 GOTO END3 02580CSR MOVE TABNAM DEPNAM 02590C*------------------------------------------------------------------- 02600CSR T3B TAG 02610CSR MOVELTWO KEYPJ 12 02620CSR MOVE TDEPT KEYPJ 02630CSR EXSR SR80 GET PJMAST 02640CSR EXSR SR203 CLASSIFY TRAN 02650CSR EXSR SR71 PUT SCREEN 02660CSR 60N28N29 Z-ADD301 M 96 DUPLICATE ADD-REJ 02670CSRN60 28 02680CORN60 29 Z-ADD5 M 96 NOT ON FILE-REJ 02690CSR END3 ENDSR 02700C*********************************************************************** 02710CSR SR5 BEGSR 02720C* EDIT DESCRIPTION. 02730CSR TDESC COMP BLK40 54 02740CSRN54 Z-ADD310 M 96 FLAG ERROR 02750CSR ENDSR ÐÐ02760C******************************************************************* 02770CSR SR50 BEGSR 02780C* LABOR VARIANCE UPDATE. 02790CSR PJALH ADD PJCLH TOTHR 71 TOTAL HRS 02800CSR TBLH SUB TOTHR THRVAR 71 HRS VARIANCE 02810CSR PA$ ADD PC$ TOT TOTAL ACTUAL $$$$ 02820CSR TB$ SUB TOT VAR VARIANCE $$$ 02830CSR ENDSR 02840C***************************************************************** 02850CSR SR68 BEGSR 02860C* RING BELL 02870CSR EXITFQBELL 02880CSR ENDSR 02890C***************************************************************** 02900CSR SR69 BEGSR 02910C* POSITION CURSOR. 02920CSR 50 EXITFZPUTXY 02930CSR RLABL RPGLIN 02940CSR RLABL RPGCOL 02950CSRN50 EXITFZMOVXY 02960CSR RLABL RPGLIN 02970CSR RLABL RPGCOL 02980CSR ENDSR 02990C********************************************************************** 03000CSR SR70 BEGSR ÐÐ03010C* CLEAR PAGE. 03020CSR 50 EXITFZISTAT 03030CSR 50 EXITFZESCH 03040CSRN50 EXITFZCPAGE 03050CSRN50 MOVEL'091' RPGLIN 03060CSRN50 MOVEL'001' RPGCOL 03070CSR EXSR SR69 POSITION CURSOR 03080CSR ENDSR 03090C******************************************************************** 03100CSR SR71 BEGSR 03110C* PUT HEADING. 03120CSR SETON 71 03130CSR EXCPT PUT HEADINGS 03140CSR SETOF 71 03150CSR ENDSR 03160C********************************************************************* 03170CSR SR72 BEGSR 03180C* PUT DATA TO TERMINAL 03190CSR EXSR SR50 CALC $ VAR & TOTALS 03200CSR EXSR SR203 03210CSR MOVELLOC,F W3N 30 03220CSR W3N SUB 1 W3N 03230CSR 50 W3N SUB 90 W3N 03240CSR MOVELW3N RPGLIN 4 03250CSR MOVEL'001' RPGCOL 4 ÐÐ03260CSR EXSR SR69 POSITION CURSOR 03270CSR SETON 72 03280CSR EXCPT PUT DATA 03290CSR SETOF 72 03300CSR ENDSR 03310C*********************************************************************** 03320CSR SR73 BEGSR 03330C* PUT ERROR MESSAGE TO TERMINAL 03340CSR 50 MOVEL'023' RPGLIN 03350CSRN50 MOVEL'118' RPGLIN 03360CSR MOVEL'001' RPGCOL 03370CSR EXSR SR69 POSITION CURSOR 03380CSR SETON 73 03390CSR EXCPT PUT MSG 03400CSR SETOF 73 03410CSR Z-ADDM LSTERR 50 03420CSR ENDSR 03430C******************************************************************* 03440CSR SR75 BEGSR 03450C* READ FROM TERMINAL 03460CSR SETOF 779096 03470CSR SETOF 9392 03480CSR SETOF 8988 03490CSR SETOF 8685 03500CSR MOVE BLK40 W40A 40 BUFFER ÐÐ03510CSR MOVELLOC,F W3N 03520CSR 50 W3N SUB 90 W3N 03530CSR MOVELW3N RPGLIN 03540CSR MOVE LOC,F W3N 03550CSR MOVELW3N RPGCOL 03560CSR EXSR SR69 POSITION CURSOR 03570CSR EXITFZR40 READ FROM TERMINAL 03580CSR RLABL W40A READ BUFFER 03590CSR MOVEAW40A A40 INPUT DATA ARRAY 03600CSR MOVE BLK40 W40A INIT INPUT ARRAY 03610CSR Z-ADD1 W 30 03620CSR '\' LOKUPA40,W 90 FLAG ESC 03630CSRN90 GOTO T75B NOT ESC 03640CSR 1 ADD W W 03650CSR W COMP 40 54 03660CSR 54 GOTO T75A BAD ESC 03670CSR A40,W COMP 'G' 98 GOODBY 03680CSR A40,W COMP 'E' 94 MENU 03690CSR A40,W COMP 'N' 93 NEW ITEM 03700CSR A40,W COMP 'J' 92 JUMP 03710CSR A40,W COMP 'B' 89 SKIP BKWRD 03720CSR A40,W COMP 'S' 88 SPACE FILL 03730CSR A40,W COMP 'U' 86 UPDATE 03740CSR A40,W COMP 'R' 85 REPEAT 03750CSR 98 GOTO GOODBY ÐÐ03760CSR 94 GOTO MENU 03770CSR 93 GOTO NEWITM 03780CSR 92 03790COR 89 03800COR 88 03810COR 86 03820COR 85 GOTO END75 GOOD ESC 03830C*------------------------------------------------------------------ 03840CSR T75A TAG 03850C* FLAG BAD ESC INPUT 03860CSR Z-ADD318 M 96 FLAG ERROR 03870CSR GOTO END75 03880C*-------------------------------------------------------------------- 03890CSR T75B TAG 03900C* MOVE DATA 03910CSR Z-ADD1 W 03920CSR ' ' LOKUPA40,W 77 03930CSR 77 MOVEAA40,W W40A INPUT DATA 03940C*-------------------------------------------------------------------- 03950CSR END75 TAG 03960C* INIT PREV ERROR MSG. 03970CSR LSTERR COMP 0 54 03980CSR 54 MOVE BLK35 MGTEXT 03990CSR 54 EXSR SR73 BLANK MESSAGE 04000CSR Z-ADD0 LSTERR 50 ÐÐ04010CSR ENDSR 04020C********************************************************************** 04030CSR SR80 BEGSR 04040C* GET MASTER RECORD 04050CSR SETOF 29 04060CSR KEYPJ CHAINPJMAST 28 GET MASTER 04070CSRN28 PJSTAT COMP 'D' 29 FLAG DELETE 04080CSR 28 04090COR 29 EXSR SR205 INIT PJMAST 04100CSRN28N29 EXSR SR206 MOVE FILE DATA 04110CSR ENDSR 04120C********************************************************************** 04130CSR SR81 BEGSR 04140C* ADD NEW MASTER TO FILE 04150CSR SETON 81 04160CSR EXCPT ADD MASTER 04170CSR SETOF 81 04180CSR ENDSR 04190C*********************************************************************** 04200CSR SR82 BEGSR 04210C* REWRITE MASTER 04220CSR SETON 82 04230CSR EXCPT REWRITE MASTER 04240CSR SETOF 82 04250CSR ENDSR ÐÐ04260C********************************************************************** 04270CSR SR89 BEGSR 04280C* GET MESSAGE MASTER 04290CSR M CHAINMGFILE 54 04300CSR 54 MOVE BLK35 MGTEXT 04310CSR 54 MOVELM MGTEXT 04320CSR 54 MOVE MES,1 MGTEXT 04330CSR ENDSR 04340C******************************************************************** 04350CSR SR96 BEGSR 04360CSR # CHAINCRTFILE H9 GET CRTFILE 04370CSR H9 GOTO ENDJOB 04380CSR ENDSR 04390C******************************************************************** 04400CSR SR97 BEGSR 04410C* UPDATE CRTFILE. EXIT PROGRAM. 04420CSR TIME CRTIME 04430CSR MOVELUDATE CRDATE 04440CSR SETON 97 04450CSR EXCPT UPD CRTFILE 04460CSR SETOF 97 04470CSR ENDSR 04480C******************************************************************** 04490CSR SR98 BEGSR 04500CSR EXSR SR70 CLEAR SCREEN ÐÐ04510CSR EXITFCHAIN >>>>>>>>>> 04520CSR RLABL PROG 04530CSR ENDSR 04540C******************************************************************** 04550CSR SR101 BEGSR 04560C* 1-TIME INITIALIZE 04570CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04580CSR Z-ADD19 FLIMIT 30 TOTAL NUMB FIELDS 04590CSR MOVE ' ' BLK40 40 04600CSR MOVE ' ' BLK35 35 04610CSR MOVE ' ' BLK12 12 04620C* GET PORT # AND CRTFILE. 04630CSR MOVE ' ' W2A 2 04640CSR EXITFZGMINX GET PORT # 04650CSR RLABL W2A 04660CSR MOVE W2A # 30 PORT NO. 04670CSR # COMP 0 54 04680CSRN54 Z-ADD25 # DEFAULT 04690CSR EXSR SR96 GET CRTFILE 04700CSR MOVE CALL LNK 04710CSR PAR,# COMP '1' 50 04720CSR TST,# COMP 'S' 54 04730CSR 54 MOVE 'SHUTDOWN'PROG 04740CSR EXSR SR97 UPD CRTFILE 04750CSR 54 EXSR SR98 >>>>>>>>>> ÐÐ04751CSR MOVE ' 'PROG 04760CSR ENDSR 04770C********************************************************************** 04780CSR SR102 BEGSR 04790C* VALIDATE FIELD NO. 04800CSR F COMP 0 54 04810CSRN54 Z-ADD1 F 04820CSR F COMP FLIMIT 55 04830CSR 55 Z-ADD1 F 04840CSR 55 GOTO END102 04850CSR F COMP 4 54 04860CSR 54 EXSR SR203 CLASSIFY TRAN 04870CSR 54 62 SETON 55 04880CSR END102 ENDSR 04890C******************************************************************** 04900CSR SR103 BEGSR 04910C* MOVE INPUT DATA 04920CSR EXSR SR201 IDENTIFY-F 04930CSR EXSR SR202 R. JUSTIFY 04940CSR 01 MOVELW40A TTCODE 1 TRAN CODE 04950CSR 02 EXSR SR207 BUILD ORDER # 04960CSR 03 MOVE W15A TDEPT 30 DEPT # 04970CSR 04 MOVELW40A TMODL 12 MODEL # 04980CSR 05 MOVELW40A TDESC 40 PROJECT DESCR 04990CSR 06 MOVE W15A TBSD 60 SCHED START ÐÐ05000CSR 07 MOVE W15A TBCD 60 SCHED CMPLTN 05010CSR 08 MOVE W15A TBLH 70 BUDGET HRS 05020CSR 09 MOVE W15A TB$,1 BUDGET LAB $ 05030CSR 10 MOVE W15A TB$,2 BUDGET MATL $ 05040CSR 11 MOVE W15A TASD 60 ACTUAL START 05050CSR 12 MOVE W15A TACD 60 ACTUAL CMPLTN 05060CSR 18 MOVE W15A TLPCT 32 LAB PCT CMPLT 05070C*R 19 ********* MOVE W15A TMPCT 32 MAT PCT CMPLT 05080CSR MOVE ' ' DUN,F EDIT FLAG 05090CSR ENDSR 05100C******************************************************************** 05110CSR SR104 BEGSR 05120C* EDIT INPUT DATA 05130CSR 01 EXSR SR1 05140CSR 02 EXSR SR2 05150CSR 03N79 EXSR SR3 05160CSR 05 EXSR SR5 05170CSR 96 MOVE ' ' DUN,F EDIT FLAG 05180CSRN96 MOVE 'X' DUN,F 05190CSR ENDSR 05200C*********************************************************************** 05210CSR SR105 BEGSR 05220C* FINAL EDIT 05230CSR SETOF 7796 05240CSR SETON 79 FINAL EDIT FLAG ÐÐ05250CSR Z-ADD1 F 96 05260C*-------------------------------------------------------------------- 05270CSR T105A TAG 05280CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05290CSRN54 GOTO END105 05300CSR EXSR SR201 IDENTIFY-F 05310CSR EXSR SR104 EDIT 05320CSRN96 GOTO T105A 05330C*-------------------------------------------------------------------- 05340CSR END105 TAG 05350CSR SETOF 79 05360CSR ENDSR 05370C******************************************************************** 05380CSR SR106 BEGSR 05390C* UPDATE DATA BASE. 05400CSR EXSR SR203 CLASSIFY TRAN 05410CSR 60 GOTO T106A ADD TRAN 05420CSR 61 GOTO T106D CHANGE TRAN 05430CSR 62 GOTO T106F DELETE TRAN 05440C* FLAG BAD TRAN CODE 05450CSR Z-ADD300 M 96 FLAG ERROR 05460CSR Z-ADD1 F FIELD # 05470CSR GOTO END106 05480C*------------------------------------------------------------------- 05490CSR T106A TAG ÐÐ05500C* ADD TRANSACTION 05510CSR 28 GOTO T106B NOT ON FILE 05520CSR 29 GOTO T106C DELETED MASTER 05530C* FLAG DUPLICATE ADD ERROR 05540CSR Z-ADD301 M 96 FLAG ERROR 05550CSR Z-ADD1 F FIELD # 05560CSR GOTO END106 05570C*--------------------------------------------------------------------- 05580CSR T106B TAG 05590C* ADD-- MAST NOT ON FILE 05600CSR EXSR SR81 ADD NEW MASTER 05610CSR GOTO END106 05620C*--------------------------------------------------------------------- 05630CSR T106C TAG 05640C* ADD-- MAST IS DELETED 05650CSR MOVE 'A' PJSTAT RECORD STATUS 05660CSR EXSR SR82 REWRITE MAST 05670CSR GOTO END106 05680C*---------------------------------------------------------------------- 05690CSR T106D TAG 05700C* CHANGE TRANSACTION. 05710CSRN29N28 GOTO T106E GOT IT 05720C* FLAG NO MASTER ERROR 05730CSR Z-ADD302 M 96 FLAG ERROR 05740CSR Z-ADD1 F FIELD # ÐÐ05750CSR GOTO END106 05760C*----------------------------------------------------------------------- 05770CSR T106E TAG 05780C* REWRITE MASTER 05790CSR EXSR SR82 REWRITE MAST 05800CSR GOTO END106 05810C*----------------------------------------------------------------------- 05820CSR T106F TAG 05830C* DELETE TRANSACTION 05840CSRN29N28 GOTO T106G GOT IT 05850C* FLAG NO MASTER ERROR 05860CSR Z-ADD302 M 96 FLAG ERROR 05870CSR Z-ADD1 F FIELD # 05880CSR GOTO END106 05890C*----------------------------------------------------------------------- 05900CSR T106G TAG 05910C* DELETE MASTER. 05920CSR MOVE 'D' PJSTAT RECORD STATUS 05930CSR EXSR SR82 REWRITE MASTER 05940CSR END106 ENDSR 05950C************************************************************************ 05960CSR SR201 BEGSR 05970C* IDENTIFY FIELD NO. 05980CSR F COMP 1 01 05990CSR F COMP 2 02 ÐÐ06000CSR F COMP 3 03 06010CSR F COMP 4 04 06020CSR F COMP 5 05 06030CSR F COMP 6 06 06040CSR F COMP 7 07 06050CSR F COMP 8 08 06060CSR F COMP 9 09 06070CSR F COMP 10 10 06080CSR F COMP 11 11 06090CSR F COMP 12 12 06100CSR F COMP 13 13 06110CSR F COMP 14 14 06120CSR F COMP 15 15 06130CSR F COMP 16 16 06140CSR F COMP 17 17 06150CSR F COMP 18 18 06160CSR F COMP 19 19 06170CSR ENDSR 06180C********************************************************************** 06190CSR SR202 BEGSR 06200C* RIGHT JUSTIFY 06210CSR F LOKUPNUM 54 06220CSRN54 GOTO END202 NOT NUMERIC FIELD 06230CSR Z-ADD15 W2N 20 06240CSR MOVELW40A W15A 15 ÐÐ06250CSR EXIT SUBRAJ R. JUSTIFY 06260CSR RLABL W2N 06270CSR RLABL W15A 06280CSR END202 ENDSR 06290C*********************************************************************** 06300CSR SR203 BEGSR 06310C* CLASSIFY TRAN CODE 06320CSR TTCODE COMP 'A' 60 ADD 06330CSR TTCODE COMP 'C' 61 CHANGE 06340CSR TTCODE COMP 'D' 62 DELETE 06350CSR ENDSR 06360C**************************************************************************06370CSR SR205 BEGSR 06380C* INIT PJMAST NON-KEY FIELDS. 06390CSR Z-ADD0 PJACNT 06400CSR MOVE BLK40 PJMODL 06410CSR MOVE BLK40 PJDESC 06420CSR Z-ADD0 PJBSD 06430CSR Z-ADD0 PJBCD 06440CSR Z-ADD0 PJBLH 06450CSR Z-ADD0 PB$ 06460CSR Z-ADD0 PA$ 06470CSR Z-ADD0 PJASD 06480CSR Z-ADD0 PJACD 06490CSR Z-ADD0 PJALH ÐÐ06500CSR Z-ADD0 PJLPCT 06510CSR Z-ADD0 PJMPCT 06520CSR Z-ADD0 PJCLH 06530CSR Z-ADD0 PC$,1 06540CSR Z-ADD0 PC$,2 06550CSR MOVE ' ' PJSTAT 06560CSR Z-ADD0 PT$ 06570CSR ENDSR 06580C******************************************************************** 06590CSR SR206 BEGSR 06600C* MOVE FILE DATA TO INPUT FIELDS. 06610CSR TMODL COMP BLK12 54 06620CSRN54 MOVE PJMODL TMODL MODEL # 06630CSR TDESC COMP BLK40 54 06640CSRN54 MOVE PJDESC TDESC DESCRIPTION 06650CSR TBSD COMP 0 54 06660CSRN54 Z-ADDPJBSD TBSD SCHED START 06670CSR TBCD COMP 0 54 06680CSRN54 Z-ADDPJBCD TBCD SCHED CMPLTN 06690CSR TBLH COMP 0 54 06700CSRN54 Z-ADDPJBLH TBLH BUDGET HRS 06710CSR TB$,1 COMP 0 54 06720CSRN54 Z-ADDPB$,1 TB$,1 BUDGET LAB $ 06730CSR TB$,2 COMP 0 54 06740CSRN54 Z-ADDPB$,2 TB$,2 BUDGET MATL $ ÐÐ06750CSR TASD COMP 0 54 06760CSRN54 Z-ADDPJASD TASD ACTUAL START 06770CSR TACD COMP 0 54 06780CSRN54 Z-ADDPJACD TACD ACTUAL CMPLTN 06790CSR TLPCT COMP 0 54 06800CSRN54 Z-ADDPJLPCT TLPCT LAB PCT CMPLT 06810C*R **** TMPCT COMP 0 54 06820C*RN54 ** Z-ADDPJMPCT TMPCT MAT PCT CMPLT 06830CSR ENDSR 06840C******************************************************************** 06850CSR SR207 BEGSR 06860C* BUILD WORK ORDER NO. 06870CSR MOVEAW40A A40 06880CSR Z-ADD1 W 06890CSR '-' LOKUPA40,W 54 06900CSRN54 Z-ADD7 W 06910CSR MOVEAA40,W W4A 4 06920CSR 54 MOVEL' ' W4A 06930CSR Z-ADD4 W2N 06940CSR EXIT SUBRAJ RJ 06950CSR RLABL W2N 06960CSR RLABL W4A 06970CSR MOVE W4A TWOD 30 WORK ORDER DASH 06980CSR MOVEABLK40 A40,W 06990CSR A40,1 COMP '0' 54 54 ÐÐ07000CSR 54 MOVEAA40,1 W5A 5 07010CSR 54 MOVEL' ' TWOP 6 07020CSRN54 MOVEAA40 TWOP 07030CSRN54 MOVE TWOP W5A 07040CSR Z-ADD5 W2N 07050CSR EXIT SUBRAJ RJ 07060CSR RLABL W2N 07070CSR RLABL W5A 07080CSR MOVE W5A TWOP WORK ORDER PRIME 07090CSR MOVELTWOP TWO WORK ORDER NO. 07100CSR MOVE TWOD TWO 9 07110CSR MOVELTWOP PREFIX 1 07120CSR MOVE TWOP PJWOP 07130CSR Z-ADDTWOD PJWOD 07140CSR MOVE TWO PJWO 07150CSR ENDSR 07160O******************************************************************** 07170OPJMAST EADD 81 07180O TWOP 6 07190O TWOD 9 07200O TDEPT 12 07210O PJACNT 17 07220O TMODL 29 07230O TDESC 69 07240O TBSD 75 ÐÐ07250O TBCD 81 07260O TBLH 85P 07270O TB$ 93P 07280O TASD 99 07290O TACD 105 07300O PJALH 109P 07310O PA$ 119P 07320O TLPCT 121P 07330O****** TMPCT 123P 07340O PJCLH 127P 07350O PC$ 137P 07360O PT$ 147P 07370O 170 'A' 07380O*------------------------------------------------------------------- 07390O E 82 07400O PJACNT 17 07410O TMODL 29 07420O TDESC 69 07430O TBSD 75 07440O TBCD 81 07450O TBLH 85P 07460O TB$ 93P 07470O TASD 99 07480O TACD 105 07490O PJALH 109P ÐÐ07500O PA$ 119P 07510O TLPCT 121P 07520O******** TMPCT 123P 07530O PJCLH 127P 07540O PC$ 137P 07550O PT$ 147P 07560O PJSTAT 170 07570O******************************************************************** 07580OTERM132 E 71 07590O BIT,28 1 07600O N50 8 '8091001' 07610O N50 BIT,1 9 07620O N50 BIT,1 10 07630O 50 10 '[001 ]001' 07640O 50 BIT,28 6 07650O UDATE Y 18 07660O 64 'PROJECT WORK ORDER' 07670O 66 '-' 07680O 84 'ACCOUNTING UPDATE' 07690O*------------------------------------------------------------------- 07700O E 71 07710O OR 72 01 07720O 15 '(1) TRAN CODE' 07730O 19 ':' 07740O TTCODE 22 ÐÐ07750O 60 27 'ADD' 07760O 61 30 'CHANGE' 07770O 62 30 'DELETE' 07780O*------------------------------------------------------------------- 07790O E 71 07800O OR 72 02 07810O 18 '(2) ORDER-NUMBER' 07820O 19 ':' 07830O TWOP 27 07840O 28 '-' 07850O TWOD 31 07860O*------------------------------------------------------------------- 07870O E 71 07880O OR 72 03 07890O 16 '(3) DEPARTMENT' 07900O 19 ':' 07910O TDEPT Z 24 07920O DEPNAM 44 07930O*------------------------------------------------------------------- 07940O E 71 07950O OR 72 04 07960O 19 '(4) MODEL-NUMBER:' 07970O TMODL 33 07980O*------------------------------------------------------------------- 07990O E 71 ÐÐ08000O OR 72 05 08010O 19 '(5) DESCRIPTION :' 08020O TDESC 61 08030O*------------------------------------------------------------------- 08040O E 71 08050O 25 'START' 08060O 43 'COMPLETE' 08070O 61 'LABOR' 08080O 80 'LABOR' 08090O 104 'MATERIAL' 08100O*------------------------------------------------------------------- 08110O E 71 08120O 24 'DATE' 08130O 41 'DATE' 08140O 60 'HRS' 08150O 78 '$' 08160O 100 '$' 08170O*------------------------------------------------------------------- 08180O E 71 08190O OR 72 06 08200O OR 72 07 08210O OR 72 08 08220O OR 72 09 08230O OR 72 10 08240O 6 'BUDGET' ÐÐ08250O 11 ':' 08260O 16 '(6)' 08270O TBSD 25 ' - - ' 08280O 34 '(7)' 08290O TBCD 43 ' - - ' 08300O 52 '(8)' 08310O TBLH 2 62 08320O 74 '(9)' 08330O TB$,1 2 84 08340O 98 '(10)' 08350O TB$,2 2 108 08360O*------------------------------------------------------------------ 08370O E 71 08380O 6 'ACTUAL' 08390O*----------------------------------------------------------------- 08400O E 71 08410O OR 72 11 08420O OR 72 12 08430O 9 'SCHEDULE' 08440O 11 ':' 08450O 16 '(11)' 08460O TASD 25 ' - - ' 08470O 34 '(12)' 08480O TACD 43 ' - - ' 08490O E 71 ÐÐ08500O 9 'BAL-FRWD' 08510O 11 ':' 08520O PJALH J 65 08530O PA$,1 J 88 08540O PA$,2 J 112 08550O*------------------------------------------------------------------- 08560O E 71 08570O OR 72 13 08580O OR 72 14 08590O OR 72 15 08600O 11 'CUR-MONTH:' 08610O****** 52 '(13)' 08620O PJCLH J 65 08630O****** 74 '(14)' 08640O PC$,1 J 88 08650O****** 98 '(15)' 08660O PC$,2 J 112 08670O*-------------------------------------------------------------- 08680O E 71 08690O 6 'TOTAL' 08700O 11 ':' 08710O TOTHR J 65 08720O TOT,1 J 88 08730O TOT,2 J 112 08740O*------------------------------------------------------------------- ÐÐ08750O E 71 08760O 8 'VARIANCE' 08770O 11 ':' 08780O THRVARJ 65 08790O VAR,1 J 88 08800O VAR,2 J 112 08810O*------------------------------------------------------------------- 08820O E 71 08830O OR 72 18 08840O OR 72 19 08850O 19 '% COMPLETE (LABOR)' 08860O 20 ':' 08870O 26 '(18)' 08880O TLPCT Z 32 08890O 34 '%' 08900O****** 98 '(19)' 08910O****** TMPCT Z 102 08920O****** 103 '%' 08930O*------------------------------------------------------------------- 08940O E 71 08950O 20 'TRANSFERRED-BAL FWD:' 08960O PT$,1 K 36 08970O*------------------------------------------------------------------- 08980O E 71 08990O 20 'CUR-MO:' ÐÐ09000O PT$,2 K 36 09010O*------------------------------------------------------------------- 09020O E 73 09030O MGTEXT 35 09040O 96 47 '**********' 09050O******************************************************************** 09060OCRTFILE E 97 09070O PROG 26 09080O CRTIME 33 09090O CRDATE 37 09100O LNK 79 09110O* ** A40 ARRAY 009120 009130** LOC ARRAY 009140092023 1 009150093023 2 009160094023 3 009170095023 4 009180096023 5 009190099019 6 009200099037 7 009210099055 8 009220099077 9 009230099101 10 009240ÐÐ101019 11 009250101037 12 009260102057 13 NOT USED 009270102077 14 NOT USED 009280102101 15 NOT USED 009290102077 16 NOT USED 009300103101 17 NOT USED 009310106031 18 009320107033 19 NOT USED 009330** NUM ARRAY 009340003 009350006 009360007 009370008 009380009 009390010 009400011 009410012 009420013 009430014 009440015 009450016 009460017 009470018 009480019 009490ÐÐ** DUN ARRAY 009500 009510** MES ARRAY 009520---MESSAGE NOT ON FILE--- 009530** TB$ ARRAY 009540 009550** VAR ARRAY 009560 009570** TOT ARRAY 009580 009590** LNK ARRAY 009600 09610/* 09620_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2f‘ 2X004TX P120282120282(èÈÐ00010H Q004TX00020F* CREATE TXPTR FILE (SEE X003TX) 00030FTXPTR UP F 2 DISK 00040ITXPTR TP 01 00050I 1 1 TPPTR 00060OTXPTR D 01 00070O 1 'X' /* 00080_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(f§ §X004UJ P120282120282(èÈÐ00010H Q004UJ00020F* DISPLAY UJMAST - JOB SEQ. (X004UJ) ***** EDP ONLY ***** 00030F* REVISED 11/26/79 5:10 PM. DG REL006 OK 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FUJKEY UD F 12L11AI 1 DISK 00070FBJMAST IC F 106R 6AI 1 DISK 00080FMENUDEPTIT F 25 EDISK 00090FTERM132 O F 132 5 00100F**************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A6 6 6 1 CALL READ PARAM. 00130E A8 8 8 1 A INPUT DATA ARRAY 00140E MES 1 1 30 00150E MENUDEPT TABDEP 1 10 5 0 TABDN 20 DEPT #/NAME 00160E BIT 256 1 SCREEN CONTR. CHAR 00170E CALL 5 6 CALL STACK 00180E BJD 6 4 REPORT DISTR. 00190E* 00200I******************************************************************* 00210IBITHEX BT 00220I 1 256 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I******************************************************************** 00280IUJKEY JU 00290I* UJMAST ALT-KEY FILE. 00300I* JOB NAME 6A 00310I 1 6 JUNAME 00320I* DEPT 5N 00330I 7 110JUDEPT 00340I* RECORD STATUS 1A 00350I 12 12 JUSTAT 00360I******************************************************************** 00370IBJMAST BJ 00380I* BATCH JOB MAST. 00390I* JOB NAME 6A 00400I 1 6 BJNAME 00410I* DESCRIPTION 40A 00420I 7 46 BJDESC 00430I* PRINTER 1A 00440I* D = DIABLO 00450I* S = SYSTEM PRINTER 00460I* T = DATAGRAPHIX 00470I* C = CONSOLE 00480I 47 47 BJPRTR 00490I* PAPER 25A 00500I 48 72 BJPAP ÐÐ00510I* COPIES 1N 00520I 73 730BJCOPY 00530I* DISTRIBUTION 4A X 6 00540I 74 97 BJD 00550I* UPDATE CODE 1A 00560I* Y = SHARABLE 00570I* N = NOT SHARABLE 00580I* BLK = NO DISK UPDATE 00590I 98 98 BJUPD 00600I* TYPE CODE 1A 00610I* P = PROGRAM (MAINLINE OR CALLED BY PROC) 00620I* U = UTILITY (ONLY) 00630I* Z = JOB STREAM 00640I* M = MENU 00650I* C = CALLED PROGRAM 00660I 99 99 BJTYPE 00670I* RECORD STATUS 1A 00680I 106 106 BJSTAT 00690C******************************************************************** 00700C* INITIALIZE 00710C EXSR SR101 1-TIME INIT 00720C Z-ADD28 LINENO 30 TRIGGER HEADING 00730C*------------------------------------------------------------------ 00740C START TAG 00750C* SET-UP 1ST FIELD NO. ÐÐ00760C Z-ADD1 F 30 FIELD # 00770C Z-ADD0 CRDEPT 50 DEPT # 00780C EXSR SR71 00790C GOTO READ 00800C*------------------------------------------------------------------ 00810C NEXT TAG 00820C* SET-UP NEXT FIELD NO. 00830C 1 ADD F F FIELD # 00840C*----------------------------------------------------------------- 00850C READ TAG 00860C* READ DATA FROM TERMINAL. 00870C SETOF 9096 00880C EXSR SR102 VALIDATE FIELD # 00890C 55 GOTO UPDATE DONE 00900C EXSR SR201 IDENTIFY-F 00910C SETON 72 00920C EXCPT PROMPT 00930C SETOF 7272 00940C EXITFQCCR CR ONLY 00950C MOVELBIT,1 W2A 2 00960C MOVE BIT,42 W2A 00970C EXITFQMOVR MOVE CURSOR 00980C RLABL W2A 00990C EXSR SR75 READ TERMINAL 01000C*--------------------------------------------------------------- ÐÐ01010C ESCAPE TAG 01020C 98 GOTO GOODBY GOODBY 01030C 94 GOTO MENU MENU REQUEST 01040C 93 GOTO NEWITM NEW ITEM 01050C 92 GOTO JUMP FIELD JUMP REQST 01060C 91 GOTO NEXT SKIP FORWARD 01070C 89 F SUB 1 F SKIP BACKWARD 01080C 89 GOTO READ " " 01090C 88 SETOF 90 SPACE FILL 01100C 88 SETON 77 " " 01110C 87 GOTO START 01120C 86 GOTO UPDATE UPDATE 01130C 85 GOTO READ REPEAT 01140C 96 GOTO ERROR ERROR 01150C 90 Z-ADD318 M 96 FLAG ERROR 01160C 90 GOTO ERROR 01170C N77 GOTO NEXT NO DATA INPUT 01180C*------------------------------------------------------------------ 01190C PROCES TAG 01200C* PROCESS INPUT DATA 01210C EXSR SR103 MOVE DATA 01220C GOTO NEXT 01230C*------------------------------------------------------------------ 01240C UPDATE TAG 01250C* UPDATE DATA BASE. ÐÐ01260C EXSR SR106 UPDATE 01270C 90 GOTO ESCAPE 01280C GOTO START 01290C*------------------------------------------------------------------- 01300C JUMP TAG 01310C* SET-UP JUMP TO REQUESTED FIELD 01320C 1 ADD W W 30 01330C W COMP 8 54 01340C 54 Z-ADD318 M 50 96 FLAG ERROR 01350C 54 GOTO ERROR BAD ESC 01360C MOVE '000' W3A 3 01370C MOVEAA8,W W3A 01380C Z-ADD3 W2N 20 01390C EXIT SUBRAJ R. JUSTIFY 01400C RLABL W2N 01410C RLABL W3A 01420C MOVE W3A F NEW FIELD # 01430C GOTO READ 01440C*-------------------------------------------------------------------- 01450C ERROR TAG 01460C EXSR SR102 VALIDATE FIELD # 01470C EXSR SR89 GET MSG 01480C EXSR SR73 PUT MSG 01490C GOTO READ 01500C*------------------------------------------------------------------ ÐÐ01510C NEWITM TAG 01520C* SET-UP LINK FOR NEW ITEM 01530C GOTO START 01540C*------------------------------------------------------------------- 01550C MENU TAG 01560C* SET-UP LINK TO MENU 01570C MOVEL'QQDP01' PROG 8 01580C GOTO END 01590C*-------------------------------------------------------------------- 01600C GOODBY TAG 01610C* LINK TO SIGN-OFF 01620C MOVEL'GOODBY' PROG 01630C GOTO END 01640C*------------------------------------------------------------------- 01650C END TAG 01660C* LINK TO MENU OR SIGN-OFF 01670C PROG COMP BLK8 54 01680C N54 MOVEL'QQDP01' PROG 01690C EXITFCHAIN LINK NEXT PROG 01700C RLABL PROG 01710C******************************************************************* 01720CSR SR1 BEGSR 01730C* GET DEPT. 01740CSR JUDEPT LOKUPTABDEP TABDN 54 01750CSRN54 MOVE BLK35 DEPNAM 20 ÐÐ01760CSR 54 MOVE TABDN DEPNAM 01770C* GET JOB NAME. 01780CSR JUNAME CHAINBJMAST 60 01790CSRN60 BJSTAT COMP 'D' 60 01800CSR 60 MOVE BLK40 JOBNAM 40 JOB NAME 01810CSRN60 MOVE BJDESC JOBNAM 01820CSR 60 SETON 84 01830CSR 60 EXCPT DELETE UJKEY. 01840CSR SETOF 84 01850CSR END1 ENDSR 01860C********************************************************************** 01870CSR SR71 BEGSR 01880C* PUT HEADINGS TO TERMINAL 01890CSR SETON 71 01900CSR EXCPT PUT HEADINGS 01910CSR SETOF 71 01920CSR Z-ADD4 LINENO 01930CSR ENDSR 01940C*********************************************************************** 01950CSR SR73 BEGSR 01960C* PUT ERROR MESSAGE TO TERMINAL 01970CSR SETON 73 01980CSR EXCPT PUT MSG 01990CSR SETOF 73 02000CSR Z-ADDM LSTERR 50 ÐÐ02010CSR EXITFQMOVUP MOVE CURSOR. 02020CSR ENDSR 02030C******************************************************************* 02040CSR SR75 BEGSR 02050C* READ FROM TERMINAL 02060CSR SETOF 779096 02070CSR SETOF 939291 02080CSR SETOF 898887 02090CSR SETOF 8685 02100CSR MOVE BIT,5 A6,2 BUF LENGTH 02110CSR MOVEAA6 W6A 6 02120CSR MOVE BLK8 W8A 8 BUFFER 02130CSR EXITFQWREED READ TERM 02140CSR RLABL W8A 02150CSR RLABL W6A 02160CSR MOVEAW8A A8 02170CSR MOVE BLK8 W8A 02180CSR Z-ADD1 W 30 02190CSR '\' LOKUPA8,W 90 FLAG ESC 02200CSRN90 GOTO T75B NOT ESC 02210CSR 1 ADD W W 02220CSR W COMP 8 54 02230CSR 54 GOTO T75A BAD ESC 02240CSR A8,W COMP 'G' 98 GOODBY 02250CSR A8,W COMP 'E' 94 MENU ÐÐ02260CSR A8,W COMP 'N' 93 NEW ITEM 02270CSR A8,W COMP 'J' 92 JUMP 02280CSR A8,W COMP 'F' 91 SKIP FRWRD 02290CSR A8,W COMP 'B' 89 SKIP BKWRD 02300CSR A8,W COMP 'S' 88 SPACE FILL 02310CSR A8,W COMP 'H' 87 HOME 02320CSR A8,W COMP 'U' 86 UPDATE 02330CSR A8,W COMP 'R' 85 REPEAT 02340CSR 98 02350COR 94 02360COR 93 02370COR 92 02380COR 91 02390COR 89 02400COR 88 02410COR 87 02420COR 86 02430COR 85 GOTO END75 GOOD ESC 02440C*------------------------------------------------------------------ 02450CSR T75A TAG 02460C* FLAG BAD ESC INPUT 02470CSR Z-ADD318 M 96 FLAG ERROR 02480CSR GOTO END75 02490C*-------------------------------------------------------------------- 02500CSR T75B TAG ÐÐ02510C* MOVE DATA 02520CSR Z-ADD1 W 02530CSR ' ' LOKUPA8,W 77 02540CSR 77 MOVEAA8,W W8A INPUT DATA 02550C*-------------------------------------------------------------------- 02560CSR END75 TAG 02570C* INIT PREV ERROR MSG. 02580CSR LSTERR COMP 0 54 02590CSR 54 MOVE BLK35 MGTEXT 02600CSR 54 EXSR SR73 BLANK MESSAGE 02610CSR Z-ADD0 LSTERR 50 02620CSR ENDSR 02630C********************************************************************** 02640CSR SR89 BEGSR 02650C* GET MESSAGE MASTER 02660CSR M CHAINMGFILE 54 02670CSR 54 MOVE BLK35 MGTEXT 02680CSR 54 MOVELM MGTEXT 02690CSR 54 MOVE MES,1 MGTEXT 02700CSR ENDSR 02710C******************************************************************** 02720CSR SR101 BEGSR 02730C* 1-TIME INITIALIZE 02740CSR MOVE BIT,1 NUL 02750CSR MOVE BIT,1 A6 ÐÐ02760CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02770CSR MOVE ' ' BLK8 8 02780C* DEFINE WORK FIELDS,ETC. 02790CSR MOVE ' ' BLK35 35 02800CSR MOVE ' ' BLK6 6 02810CSR MOVE ' ' BLK40 40 02820C* 02830C* 02840C* 02850CSR ENDSR 02860C********************************************************************** 02870CSR SR102 BEGSR 02880C* VALIDATE FIELD NO. 02890CSR F COMP 0 54 02900CSRN54 Z-ADD1 F 02910CSR F COMP FLIMIT 55 02920CSR 55 Z-ADD1 F 02930CSR ENDSR 02940C******************************************************************** 02950CSR SR103 BEGSR 02960C* MOVE INPUT DATA 02970CSR EXSR SR201 IDENTIFY-F 02980CSR 01 MOVELW8A CRNAME 6 JOB NAME 02990CSR ENDSR 03000C******************************************************************** ÐÐ03010CSR SR106 BEGSR 03020C* DISPLAY UJMAST FILE - JOB SEQ. 03030CSR T106A TAG 03040CSR MOVELCRNAME W11A 11 03050CSR W11A SETLLUJKEY 03060C*-------------------------------------------------------------- 03070CSR T106B TAG 03080CSR SETOF 54 03090CSR READ UJKEY 54 03100CSR 54 GOTO T106T END OF FILE 03110CSR JUSTAT COMP 'D' 54 03120CSR 54 GOTO T106B DELETED 03130CSR EXSR SR1 TABLE LOOK-UPS 03140CSR SETON 72 03150CSR EXCPT PUT DATA 03160CSR SETOF 72 03170CSR LINENO ADD 1 LINENO 30 SCREEN LINE 03180CSR LINENO COMP 28 54 54 03190CSRN54 GOTO T106B NOT END PAGE 03200CSR EXITFQEPAGE END PAGE MSG 03210CSR EXSR SR75 READ 03220CSR 90 GOTO END106 ESCAPE 03230CSR EXSR SR71 PUT HEADINGS 03240CSR 77 EXSR SR103 MOVE DATA 03250CSR 77 GOTO T106A START NEW DEPT ÐÐ03260CSR GOTO T106B GET NEXT RECORD 03270C*------------------------------------------------------------------- 03280CSR T106T TAG 03290C* END FILE MESSAGE 03300CSR EXITFQEFILE END FILE MSG 03310CSR END106 ENDSR 03320C************************************************************************ 03330CSR SR201 BEGSR 03340C* IDENTIFY FIELD NO. 03350CSR F COMP 1 01 03360CSR ENDSR 03370O******************************************************************** 03380OTERM132 E 71 03390O* PUT HEADING. 03400O E 71 03410O 15 'DEPT' 03420O 44 'JOB' 03430O*------------------------------------------------------------------- 03440O E 71 03450O*------------------------------------------------------------------- 03460O E 72 03470O* PUT DATA. 03480O JUDEPTZB 15 03490O DEPNAM B 38 03500O JUNAME B 46 ÐÐ03510O JOBNAM B 88 03520O*------------------------------------------------------------------- 03530O E 73 03540O* PUT MESSAGE. 03550O NUL 132 03560O MGTEXT 35 03570O 37 ' ' 03580O******************************************************************** 03590OUJKEY E 84 03600O 12 'D' ** NUL ARRAY 003610 003620** A6 ARRAY 003630 003640** A8 ARRAY 003650 003660** MES ARRAY 003670---MESSAGE NOT ON FILE--- 003680/* 003690_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(gO  XGETX P999999120282(èÈÐ SUBROUTINE ZGETX (REQBUF,IREC,IKEY,IERROR,IDEL) 00010* GET NEXT RECORD - INDEXED. 00020*----------------------------------------------------------------------- 00030* REQBUF = FILE MGR REQUEST BUFFER 00040* IREC = DATA BUFFER 00050* IKEY = KEY VALUE 00060* IERROR = ERROR FLAG, ASCII HEX CHAR 00070* IDEL = FILE MFG DELETED RECORD CODE 00080*----------------------------------------------------------------------- 00090 INTEGER IERROR (2) 00100 INTEGER REQBUF (24) 00110 DO 10 I=1, 2 00120 10 IERROR(I) = $2020 00130 IDEL = $5F82 00140 ISTAT = 0 00150 CALL GETS (REQBUF,IREC,IKEY,ISTAT) 00160 IF (ISTAT.GE.$8000) CALL HEXASC (ISTAT, IERROR) 00170 IF (ISTAT.NE.$81) GO TO 900 00180 DO 20 I=1, 2 00190 20 IERROR(I) = $4545 00200 900 CONTINUE 00210 RETURN 00220 END 00230_‚ ÐÐ_‚_‚ SUBROUTINE ZGETX (REQBUF,IREC,IKEY,IERROR,IDEL) 00010* GET NEXT RECORD - INDEXED. 00020*----------------------------------------------------------------------- 00030* REQBUF = FILE MGR REQUEST BUFFER 00040* IREC = DATA BUFFER 00050* IKEY = KEY VALUE 00060* IERROR = ERROR FLAG, ASCII HEX CHAR 00070* IDEL = FILE MFG DELETED RECORD CODE 00080*----------------------------------------------------------------------- 00090 INTEGER IERROR (2) 00100 INTEGER REQBUF (24) 00110 DO 10 I=1, 2 00120 10 IERROR(I) = $2020 00130 IDEL = $5F82 00140 ISTAT = 0 00150 CALL GETS (REQBUF,IREC,IKEY,ISTAT) 00160 IF (ISTAT.GE.$8000) CALL HEXASC (ISTAT, IERROR) 00170 IF (ISTAT.NE.$81) GO TO 900 00180 DO 20 I=1, 2 00190 20 IERROR(I) = $4545 00200 900 CONTINUE 00210 RETURN 00220 END 00230_‚ ÐÈ(dg[ d*X004XP P120282120282(èÈÐ00010H Q004XP00020F* ADD EXPLODED REQMTS TO EXMAST. (X004XP) DG REL006 OK 00030F* REVISED 2/20/80 10:00 AM. 00040FXPCONT IP F 128 DISK 00050FREQMTOUTIS F 33 DISK 00060FXPMAST UC F 99R22AI 1 DISK A 00070E******************************************************************** 00080E XPQ 18 7 0A REQMTS 00090E XCD 18 6 0A DATES 00100I******************************************************************** 00110IREQMTOUTRQ 01 00120I 1 20RQLL 00130I 3 120RQCPN 00140I 13 220RQAPN 00150I 23 280RQDATE 00160I P 29 320RQQTY 00170I 33 33 RQSTAT 00180I****************************************************************** 00190IXPMAST XP 00200I* EXPLOSION MASTER. 00210I* KEY AREA. 00220I* LOW LEVEL CODE 2N 00230I 1 20XPLL 00240I* COMPONENT PART # 10N 00250I 3 120XPCPN ÐÐ00260I* TOP ASSY PN 10N 00270I 13 220XPAPN 00280I* REQMTS 7P X 18 00290I P 23 94 XPQ 00300I* RECORD STATUS 1A 00310I 99 99 XPSTAT 00320I****************************************************************** 00330IXPCONT XC 02 00340I* EXPLOSION CONTROL MAST. 00350I* DATES 6N X 18 00360I 1 108 XCD 00370I* CUR INDENT LEVEL 2N 00380I 127 1280XCCIL 00390C******************************************************************** 00400C 02 GOTO END 00410C MOVELRQLL W22A 22 00420C MOVELRQCPN W20A 20 00430C MOVE RQAPN W20A 00440C MOVE W20A W22A 00450C W22A CHAINXPMAST 60 00460C 60 Z-ADD0 XPQ 00470C Z-ADD1 X 30 00480C RQDATE LOKUPXCD,X 54 54 00490C N54 Z-ADD18 X 00500C RQQTY ADD XPQ,X XPQ,X ÐÐ00510C*------------------------------------------------------------------- 00520C END TAG 00530CLR MOVEL'Q003XP' PROG 8 00540CLR EXITFCHAIN 00550CLR RLABL PROG 00560O******************************************************************** 00570OXPMAST DADD 01 60 00580O RQLL 2 00590O RQCPN 12 00600O RQAPN 22 00610O XPQ 94P 00620O RQSTAT 99 00630O*------------------------------------------------------------------- 00640O D 01N60 00650O XPQ 94P /* 000660_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(úg† úiX005CF P120282120282(èÈÐ00010H Q005CF00020F* PRINT CFMAST SEQUENTIALLY BY KEY. (X005CF) 00030F* REVISED 8/01/80 3:20 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FCFMAST ID F 370L15AI 1 DISK 00070FPRINT O F 132 OF PRINTER 00080E******************************************************************** 00090E NA4 5 5 6 00100E NB4 5 5 4 0 00110E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00120E A6 6 6 1 00130E BIT 33 1 00140E CFA 8 35 00150E CFN 5 3 00160E CFC 5 3 0 00170E NAC 24 1 00180I******************************************************************** 00190IBITTAB BT 02 00200I 1 33 BIT 00210I******************************************************************** 00220ICFMAST CF 01 00230I* CATALOG HOLDER (MAIL LIST) MASTER. 00240I* KEY AREA. 00250I* NAME KEY 15A ÐÐ00260I 1 15 CFKEY 00270I* ADDRESS LINES 35A X 8 00280I 16 295 CFA 00290I* STATE CODE 2A 00300I 296 297 CFSTCD 00310I* ZIP 9P 00320I P 298 3020CFZIP 00330I* CATALOGS. 00340I* NAME 3A X 5 00350I 303 317 CFN 00360I* COPIES 3P X 5 00370I P 318 327 CFC 00380I* SELECTOR CODES 24 X 1A 1 00390I 328 351 NAC 00400I* TELEPHONE # 12A 00410I 352 363 CFTEL 00420I* DATE LAST TRAN 6N (YMD) 00430I 364 3690CFDLT 00440I* RECORD STATUS 1A 00450I 370 370 CFSTAT 00460C******************************************************************** 00470C* INITIALIZE - 1 TIME. 00480C N79 EXSR SR101 INIT. 00490C*------------------------------------------------------------------- 00500C MOVELKEY W15A 15 ÐÐ00510C W15A SETLLCFMAST 00520C*------------------------------------------------------------------- 00530C TAG10 TAG 00540C SETOF 54 00550C READ CFMAST 54 00560C 54 GOTO END 00570C CFSTAT COMP 'D' 54 00580C 54 GOTO TAG10 00590C MOVE CFKEY LKEY 15 00600C CFSTCD COMP ' ' 54 00610C 54 CFSTCD LOKUPTABSC 54 00620C 'E' LOKUPNAC 55 00630C CFA,8 COMP BLK35 57 00640C 57 54 00650COR 57N55 SETON 65 00660C MOVE CFN NA4 00670C Z-ADDCFC NB4 00680C CFSTCD COMP ' ' 54 00690C 54 CFSTCD LOKUPTABSC TABSCN 54 00700C 54 MOVE TABSCN W25A 25 00710C N54 MOVE BLK35 W25A 00720C SETON 80 00730C EXCPT 00740C SETOF 80 00750C GOTO TAG10 READ AGAIN ÐÐ00760C*------------------------------------------------------------------- 00770C END TAG 00780C******************************************************************** 00790CSR SR101 BEGSR 00800C* INITIALIZE 1-TIME. 00810CSR SETON 79 00820CSR MOVE BIT,1 A6 00830CSR MOVE BIT,9 A6,2 00840CSR MOVEAA6 W6A 6 00850CSR MOVE BLK16 KEY 16 00860CSR EXITFQCLFCR 00870CSR EXITFQBELL 00880CSR EXITFQWREED 00890CSR RLABL KEY 00900CSR RLABL W6A 00910CSR MOVE ' ' BLK16 16 00920CSR MOVE ' ' BLK35 35 00930CSR MOVE ' ' BLK15 15 00940CSR ENDSR 00950O******************************************************************** 00960OPRINT H 201 1P 00970O OR OF 00980O* PUT HEADINGS. 00990O UDATE Y 8 01000O 56 'MAILING LIST DISPLAY' ÐÐ01010O 79 '- KEY FIELD SEQUENCE' 01020O 127 'PAGE' 01030O PAGE Z 132 01040O H 2 1P 01050O OR OF 01060O* PUT HEADINGS. 01070O 10 'KEY FIELD' 01080O 47 'N A M E A N D A D D ' 01090O 54 'R E S S' 01100O 92 'S E L E C T O R C O D ' 01110O 95 'E S' 01120O 123 'MAILER CODES' 01130O*------------------------------------------------------------------- 01140O EF21 80 01150O* PUT DATA. 01160O CFKEY 15 01170O 22 'NAME' 01180O CFA,1 66 01190O NAC 94 01200O NA4 131 01210O*------------------------------------------------------------------- 01220O EF 1 80 01230O 23 'TITLE' 01240O CFA,2 66 01250O NB4 Z 131 ÐÐ01260O*------------------------------------------------------------------- 01270O EF 1 80 01280O 25 'COMPANY' 01290O CFA,3 66 01300O*------------------------------------------------------------------- 01310O EF 1 80 01320O 25 'COMPANY' 01330O CFA,4 66 01340O*------------------------------------------------------------------- 01350O EF 1 80 01360O 25 'ADDRESS' 01370O CFA,5 66 01380O*------------------------------------------------------------------- 01390O EF 1 80 01400O 25 'ADDRESS' 01410O CFA,6 66 01420O 79 'TELEPHONE:' 01430O CFTEL 92 01440O 112 'LAST UPDATED:' 01450O CFDLT Y 122 01460O*------------------------------------------------------------------- 01470O EF 1 80 01480O 22 'CITY' 01490O CFA,7 66 01500O 74 'STATE' ÐÐ01510O 79 ':' 01520O CFSTCD 82 01530O W25A 104 01540O 112 'ZIP:' 01550O CFZIP Z 122 01560O*------------------------------------------------------------------- 01570O EF 1 80 01580O 30 'FOREIGN CTRY' 01590O CFA,8 66 01600O*------------------------------------------------------------------- 01610O*** EF 1 80 65 01620O*** 19 '*** INVALID COUNTRY' ** NA4 ARRAY 001630 001640** NB4 ARRAY 001650 001660** TABSC/TABSCN --- STATE CODES/NAMES 001670 001680ALALABAMA 001690AKALASKA 001700AZARIZONA 001710ARARKANSAS 001720ASAMERICAN SAMOA 001730CACALIFORNIA 001740CZCANAL ZONE 001750ÐÐCOCOLORADO 001760CTCONNECTICUT 001770DEDELAWARE 001780DCDISTRICT OF COLUMBIA 001790FLFLORIDA 001800GAGEORGIA 001810GUGUAM 001820HIHAWAII 001830IDIDAHO 001840ILILLINOIS 001850ININDIANA 001860IAIOWA 001870KSKANSAS 001880KYKENTUCKY 001890LALOUISIANA 001900MEMAINE 001910MDMARYLAND 001920MAMASSACHUSETTS 001930MIMICHIGAN 001940MNMINNESOTA 001950MSMISSISSIPPI 001960MOMISSOURI 001970MTMONTANA 001980NENEBRASKA 001990NVNEVADA 002000ÐÐNHNEW HAMPSHIRE 002010NJNEW JERSEY 002020NMNEW MEXICO 002030NYNEW YORK 002040NCNORTH CAROLINA 002050NDNORTH DAKOTA 002060OHOHIO 002070OKOKLAHOMA 002080OROREGON 002090PAPENNSYLVANIA 002100PRPUERTO RICO 002110RIRHODE ISLAND 002120SCSOUTH CAROLINA 002130SDSOUTH DAKOTA 002140TNTENNESSEE 002150TTTRUST TERRITORIES 002160TXTEXAS 002170UTUTAH 002180VTVERMONT 002190VAVIRGINIA 002200VIVIRGIN ISLANDS 002210WAWASHINGTON 002220WVWEST VIRGINIA 002230WIWISCONSIN 002240WYWYOMING 002250ÐÐ** A6 ARRAY 002260 002270/* 002280_‚ ÐÐ_‚_‚A6 ARRAY 002260 002270/* 002280_‚ ÐÈ(úgð úiX005CM Pò120282120282(èÈÐ00010H Q005CM00020F* UPDATE CM ALT-KEY FILE. (X005CM) 00030F* REVISED 6-25-81 3:30 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCR2FILE IC F 672R DISK 00070FCMKEY UC F 26R25AI 1 DISK A 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E MES 1 1 30 00110E CRA 7 35 00120E CRB 10 9 2 00130E CRS 10 9 2 00140E CRAR 4 9 2 00150E CRD 5 7 0 00160E CRM 3 3 00170E CRC 3 3 0 00180E BIT 33 1 SCREEN CONTR. CHAR 00190E CALL 5 6 CALL STACK 00200I******************************************************************* 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I****************************************************************** 00280ICR2FILE CR 00290I* CR2FILE CMMAST FIELDS. 00300I* CUSTOMER NO. 5N 00310I 1 50CRCUST 00320I* SORT (ALT) KEY 20A 00330I 6 25 CRSORT 00340I* ADDRESS 35A X 7 00350I 26 270 CRA 00360I* STATE CODE 2A 00370I 271 272 CRSTCD 00380I* ZIP CODE 9P 00390I P 273 2770CRZIP 00400I* PHONE NO. 15A 00410I 278 292 CRPHON 00420I* CONTACT NAME 35A 00430I 293 327 CRCONT 00440I* REMARKS 35A 00450I 328 362 CRREM 00460I* CUSTOMER CLASS 2A 00470I 363 364 CRCLAS 00480I* SALESMAN 3A 00490I 365 367 CRSLSM 00500I* CREDIT LIMIT 7P ÐÐ00510I P 368 3710CRCRLM 00520I* PAYMENT TERMS 8A 00530I 372 379 CRTERM 00540I* NUMBER OF INVOICE COPIES 1N 00550I 380 3800CRINV 00560I* SHIPPING METHOD 20A 00570I 381 400 CRSHIP 00580I* CURRENT BACKLOG 9.2P X 10 00590I P 401 450 CRB 00600I* LAST 12-MOS SHIPMENTS 9.2P X 10 00610I P 451 500 CRS 00620I* CURRENT RECEIVABLES 9.2P X 4 00630I P 501 520 CRAR 00640I* TAX CODE 1A 00650I 521 521 CRTAX 00660I* STD DISCOUNT 3.2P 00670I P 522 5232CRDISC 00680I* EXPORT CODE 1A 00690I 524 524 CREXPT 00700I* DATE HISTORY 7P X 5 00710I P 525 544 CRD 00720I* LOCATION CODE 5A 00730I 545 549 CRLOC 00740I* HOLD CODE 1A 00750I 550 550 CRHOLD ÐÐ00760I* MAILING CODES. 00770I* MAILER CODES 3 X 3A 00780I 551 559 CRM 00790I* NUMB OF COPIES 3 X 2N 00800I 560 565 CRC 00810I* POINTERS. 00820I* CREDIT CHANGES 5P 00830I P 573 5750CRFCC 00840I* PREV SORT CODE 20A 00850I 577 596 CROSRT 00860I* START PROG 6A 00870I 666 671 CRPROG 00880I* TRANSACTION CODE 1A 00890I 672 672 CRTRAN 00900I******************************************************************** 00910ICMKEY CA 00920I* CUSTOMER MASTER ALT-KEY. 00930I* SORT CODE 20A 00940I 1 20 CASORT 00950I* CUST NO. 5N 00960I 21 250CACUST 00970I* RECORD STATUS 1A 00980I 26 26 CASTAT 00990C******************************************************************** 01000C* INITIALIZE ÐÐ01010C EXSR SR101 1-TIME INIT 01020C*------------------------------------------------------------------ 01030C UPDATE TAG 01040C* UPDATE DATA BASE. 01050C EXSR SR106 UPDATE 01060C 96 GOTO ERROR ERROR 01070C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01080C CRPROG COMP 'Q001CM' 54 01090C N54 MOVEL'Q006CM' PROG 01100C 54 MOVELCRPROG PROG 8 01110C GOTO END 01120C*------------------------------------------------------------------- 01130C ERROR TAG 01140C EXSR SR89 01150C EXSR SR73 01160C MOVEL'Q003CM' PROG 01170C*------------------------------------------------------------------- 01180C END TAG 01190CLR PROG COMP BLK8 54 01200CLRN54 MOVEL'Q070DP' PROG 01210CLR EXITFCHAIN LINK TO NEXT PROG 01220CLR RLABL PROG 01230C********************************************************************* 01240CSR SR73 BEGSR 01250C* PUT ERROR MESSAGE TO TERMINAL ÐÐ01260CSR SETON 73 01270CSR EXCPT PUT MSG 01280CSR SETOF 73 01290CSR Z-ADD0 M 50 01300CSR Z-ADDM LSTERR 50 01310CSR ENDSR 01320C********************************************************************** 01330CSR SR80 BEGSR 01340C* GET ALT-KEY RECORD. 01350CSR SETOF 61 01360CSR MOVELW20A W25A 25 01370CSR MOVE CRCUST W25A 01380CSR W25A CHAINCMKEY 60 GET MASTER 01390CSRN60 CASTAT COMP 'D' 61 FLAG DELETE 01400CSR ENDSR 01410C********************************************************************** 01420CSR SR81 BEGSR 01430C* ADD NEW MASTER TO FILE 01440CSR SETON 81 01450CSR EXCPT ADD MASTER 01460CSR SETOF 81 01470CSR ENDSR 01480C*********************************************************************** 01490CSR SR82 BEGSR 01500C* REWRITE MASTER ÐÐ01510CSR SETON 82 01520CSR EXCPT REWRITE MASTER 01530CSR SETOF 82 01540CSR ENDSR 01550C********************************************************************** 01560CSR SR89 BEGSR 01570C* GET MESSAGE MASTER 01580CSR M CHAINMGFILE 54 01590CSR 54 MOVE BLK35 MGTEXT 01600CSR 54 MOVELM MGTEXT 01610CSR 54 MOVE MES,1 MGTEXT 01620CSR ENDSR 01630C*********************************************************************** 01640CSR SR101 BEGSR 01650C* 1-TIME INITIALIZE 01660C* GET PORT # AND CR2FILE 01670CSR MOVE ' ' W8A 8 01680CSR Z-ADD0 W2N 20 01690CSR Z-ADD0 W1N 10 01700CSR MOVE ' ' W2A 2 01710CSR EXITFPGMINX GET PORT # 01720CSR RLABL W8A 01730CSR RLABL W2N 01740CSR RLABL W1N 01750CSR RLABL W2A ÐÐ01760CSR MOVE W2A PORT 20 PORT NO. 01770CSR PORT COMP 0 54 01780CSRN54 Z-ADD25 PORT DEFAULT 01790CSR PORT CHAINCR2FILE H9 01800C* DEFINE WORK FIELDS,ETC. 01810CSR MOVE ' ' BLK35 35 01820CSR MOVE ' ' BLK8 8 01830CSR ENDSR 01840C******************************************************************** 01850CSR SR106 BEGSR 01860C* UPDATE CMKEY FILE. 01870C* DELETE OLD SORT-KEY. 01880CSR MOVELCROSRT W20A 20 01890CSR EXSR SR80 GET CMKEY. 01900CSR 60 01910COR 61 GOTO T106A 01920CSR MOVE 'D' CASTAT RECORD STATUS. 01930CSR EXSR SR82 REWRITE CMKEY. 01940C*------------------------------------------------------------------- 01950CSR T106A TAG 01960C* BYPASS DELETES. 01970CSR EXSR SR203 CLASSIFY TRAN. 01980CSR 62 GOTO END106 01990C* ADD NEW SORT-KEY. 02000CSR MOVELCRSORT W20A ÐÐ02010CSR EXSR SR80 GET CMKEY. 02020CSR MOVE 'A' CASTAT 02030CSR 60 EXSR SR81 ADD NEW CMKEY. 02040CSRN60 EXSR SR82 REWRITE CMKEY. 02050CSR END106 ENDSR 02060C*********************************************************************** 02070CSR SR203 BEGSR 02080C* CLASSIFY TRAN CODE 02090CSR CRTRAN COMP 'A' 60 ADD 02100CSR CRTRAN COMP 'C' 61 CHANGE 02110CSR CRTRAN COMP 'D' 62 DELETE 02120CSR ENDSR 02130O******************************************************************** 02140OCMKEY EADD 81 02150O* ADD CMKEY. 02160O W25A 25 02170O 26 'A' 02180O*------------------------------------------------------------------- 02190O E 82 02200O* REWRITE CMKEY. 02210O CASTAT 26 02220O******************************************************************** 02230OTERM132 E 73 02240O BIT,28 1 02250O 8 '8030080' ÐÐ02260O MGTEXT 43 02270O BIT,8 131 02280O BIT,8 132 ** MES ARRAY 002290---MESSAGE NOT ON FILE--- 002300/* 002310_‚ ÐÐ_‚_‚0O MGTEXT 43 02270O BIT,8 131 02280O BIT,8 132 ** MES ARRAY 002290---MESSAGE NOT ON FILE--- 002300/* 002310_‚ ÐÈ(2hZ 2X005DP P120282120282(èÈÐ00010H Q005DP00020F* INITIALIZE 1ST PART OF DISKETTE ONLY. (X005DP) 00030F* CREATED 4/12/79 5:30 PM. 00040FBITHEX IP F 256 DISK 00050FFLOPPY O F 122 17 00060F KEBCDIC 00070FTERMO O F 5 5 00080E BIT 256 1 00090IBITHEX BT 00100I 1 256 BIT 00110C SETOF 74 00120C MOVE ' ' BIT 00130C MOVEABIT REC 122 00140C START TAG 00150C 1 ADD COUNT COUNT 40 00160C COUNT COMP 35 54 00170C 54 SETON LR 00180C COUNT COMP 18 74 74 00190C LR GOTO END 00200C EXCPT 00210C GOTO START 00220C END TAG 00230OFLOPPY E 00240O REC 122 00250O 74 2 '/*' ÐÐ00260OTERMO E 00270O COUNT Z 5 /* 000280_‚ ÐÐ_‚_‚0OTERMO E 00270O COUNT Z 5 /* 000280_‚ ÐÈ(Šhp ŠX005EG P6120282120282(èÈÐ00010H Q005EG00020F* DISPLAY JOB SCHEDULE IN DETAIL. (X005EG) 00030F* REVISED 5/22/80 6:35 PM. 00040FBITTAB IP F 33 DISK 00050FEGTABLE IC F 1202R DISK 00060FMGFILE IC F 80R DISK 00070FTERM132 O F 132 5 00080E********************************************************************* 00090E M1 60 60 1 A MAN 00100E N1 1 60 12 NAME 00110E M3 1 300 1 A MAN 00120E B3 1 300 4 START 00130E J3 1 300 1 JOB 00140E S3 1 300 1 SKILL 00150E E3 1 300 4 STOP 00160E H3 1 300 4 HRS 00170E P3 1 300 2 % 00180E J4 1 100 1 A JOB 00190E D4 1 100 12 DESCR 00200E W4 1 100 6 WO # 00210E J5 1 300 1 A JOB 00220E B5 1 300 4 START 00230E S5 1 300 1 SKILL 00240E H5 1 300 4 HRS 00250E E5 1 300 4 STOP ÐÐ00260E P5 1 300 2 % 00270E S6 1 60 1 A SKILL 00280E T6 60 60 12 TITLE 00290E A12 12 12 1 A 00300E CAL 1 20 4 0 00310E BAL 1 20 4 0 00320E GOT 1 20 4 0 00330E MHR 1 20 4 0 00340E REQ 1 20 4 0 00350E BIT 33 1 00360E REC 1200 1 00370E* ARRAY STRUCTURE. 00380E* * M1+* * * * * * 1. MAN - M,N 00390E* * * N1 * * * * * 1.1 NAME - M,N 00400E*------------------------------------------------------------------- 00410E* * M3+* * * * * * 3. MAN - M,S,J,B,H,E 00420E* * * B3+* * * * * 3.1 START-M,S,J,B,H,E 00430E* * * * J3+* * * * 3.2 JOB -M,S,J,B,H,E 00440E* * * * * S3+* * * 3.3 SKILL-M,S,J,B,H,E 00450E* * * * * * E3 * * 3.4 STOP -M,S,J,B,H,E 00460E* * * * * * * H3 * 3.5 HRS -M,S,J,B,H,E 00470E* * * * * * * * P3 3.6 % -M,S,J,B,H,E 00480E*------------------------------------------------------------------- 00490E* * J4+* * * * * * 4. JOB -J,D,W 00500E* * * W4 * * * * * 4.1 NUMB -J,D,W ÐÐ00510E* * * * D4 * * * * 4.2 DESCR-J,D,W 00520E*------------------------------------------------------------------- 00530E* * J5+* * * * * * 5. JOB -J,S,H,B,P,E 00540E* * * B5+* * * * * 5.1 START-J,S,H,B,P,E 00550E* * * * S5+* * * * 5.2 SKILL-J,S,H,B,P,E 00560E* * * * * E5 * * * 5.3 STOP -J,S,H,B,P,E 00570E* * * * * * H5 * * 5.4 HRS -J,S,H,B,P,E 00580E* * * * * * * P5 * 5.5 % -J,S,H,B,P,E 00590E*------------------------------------------------------------------- 00600E* * S6+* * * * * * 6. SKILL-S,T 00610E* * * T6 * * * * * 6.1 TITLE-S,T 00620E*------------------------------------------------------------------- 00630E* + INDICATES CONTROL FIELDS IN ARRAY GROUP 00640E* M = MAN CODE 00650E* N = MAN NAME 00660E* S = SKILL 00670E* J = JOB CODE 00680E* B = START DATE 00690E* H = HRS AVAIL/REQD 00700E* P = PER CENT CMPLT 00710E* T = SKILL TITLE 00720E* D = JOB DESCRIPTION 00730E* W = JOB # 00740E* E = STOP DATE 00750I********************************************************************* ÐÐ00760IBITTAB BT 00770I 1 33 BIT 00780I******************************************************************** 00790IEGTABLE EG 00800I 1 20EGNO 00810I 31202 REC 00820I******************************************************************** 00830IMGFILE MG 00840I 1 35 MGTEXT 00850C******************************************************************** 00860C* INITIALIZE - 1-TIME. 00870C EXSR SR101 INIT 00880C*------------------------------------------------------------------- 00890C START TAG 00900C* REQUEST JOB #. 00910C EXSR SR102 REQUEST JOB 00920C 90 GOTO MENU 00930C*------------------------------------------------------------------ 00940C TAG10 TAG 00950C* DISPLAY TASKS. 00960C EXSR SR103 LIST TASK 00970C*------------------------------------------------------------------- 00980C TAG20 TAG 00990C* REQUEST TASK. 01000C EXSR SR104 REQUEST TASK ÐÐ01010C 89 GOTO START 01020C 90 GOTO MENU 01030C*------------------------------------------------------------------- 01040C TAG30 TAG 01050C* REQUEST START DATE. 01060C EXSR SR105 GET START DATE 01070C 89 GOTO TAG20 01080C 90 GOTO MENU 01090C*------------------------------------------------------------------- 01100C TAG40 TAG 01110C* DISPLAY SCHEDULE. 01120C EXSR SR106 01130C 89 GOTO TAG30 01140C 90 GOTO MENU 01150C GOTO TAG10 01160C*------------------------------------------------------------------- 01170C MENU TAG 01180C MOVEL'QQEG02' PROG 8 01190C*------------------------------------------------------------------- 01200C END TAG 01210C EXITFCHAIN 01220C RLABL PROG 01230C*------------------------------------------------------------------- 01240C ENDJOB TAG 01250C******************************************************************** ÐÐ01260CSR SR73 BEGSR 01270C* PUT MSG. 01280CSR SETON 73 01290CSR EXCPT 01300CSR SETOF 73 01310CSR ENDSR 01320C******************************************************************* 01330CSR SR75 BEGSR 01340C* READ FROM TERMINAL 01350CSR SETOF 779096 01360CSR SETOF 939291 01370CSR SETOF 898887 01380CSR SETOF 8685 01390CSR MOVE BIT,7 BUFLGT 2 READ BUFFER LGTH 01400CSR MOVE BLK12 W12A 12 BUFFER 01410CSR EXITFQWREED READ FROM TERMINAL 01420CSR RLABL W12A READ BUFFER 01430CSR RLABL BUFLGT READ BUFFER LGTH 01440CSR MOVEAW12A A12 INPUT DATA ARRAY 01450CSR MOVE BLK12 W12A INIT INPUT ARRAY 01460CSR Z-ADD1 W 30 01470CSR '\' LOKUPA12,W 90 FLAG ESC 01480CSRN90 GOTO T75B NOT ESC 01490CSR 1 ADD W W 01500CSR W COMP 12 54 ÐÐ01510CSR 54 GOTO T75A BAD ESC 01520CSR A12,W COMP 'G' 98 GOODBY 01530CSR A12,W COMP 'E' 94 MENU 01540CSR A12,W COMP 'N' 93 NEW ITEM 01550CSR A12,W COMP 'J' 92 JUMP 01560CSR A12,W COMP 'F' 91 SKIP FRWRD 01570CSR A12,W COMP 'B' 89 SKIP BKWRD 01580CSR A12,W COMP 'S' 88 SPACE FILL 01590CSR A12,W COMP 'H' 87 HOME 01600CSR A12,W COMP 'U' 86 UPDATE 01610CSR A12,W COMP 'R' 85 REPEAT 01620CSR 98 01630COR 94 01640COR 93 01650COR 92 01660COR 91 01670COR 89 01680COR 88 01690COR 87 01700COR 86 01710COR 85 GOTO END75 GOOD ESC 01720C*------------------------------------------------------------------ 01730CSR T75A TAG 01740C* FLAG BAD ESC INPUT 01750CSR Z-ADD318 M 96 FLAG ERROR ÐÐ01760CSR GOTO END75 01770C*-------------------------------------------------------------------- 01780CSR T75B TAG 01790C* MOVE DATA 01800CSR Z-ADD1 W 01810CSR ' ' LOKUPA12,W 77 01820CSR 77 MOVEAA12,W W12A INPUT DATA 01830C*-------------------------------------------------------------------- 01840CSR END75 TAG 01850C* INIT PREV ERROR MSG. 01860CSR LSTERR COMP 0 54 01870CSR 54 MOVE BLK35 MGTEXT 01880CSR 54 EXSR SR73 BLANK MESSAGE 01890CSR Z-ADD0 LSTERR 50 01900CSR ENDSR 01910C******************************************************************** 01920CSR SR89 BEGSR 01930C* GET MESSAGE MAST. 01940CSR M CHAINMGFILE 54 01950CSR 54 MOVE BLK35 MGTEXT 01960CSR 54 MOVEL'NO-MSG' MGTEXT 01970CSR ENDSR 01980C******************************************************************** 01990CSR SR101 BEGSR 02000C* 1-TIME INITIALIZE. ÐÐ02010C* GET EGTABLE. 02020CSR Z-ADD0 W2N 20 02030C*------------------------------------------------------------------- 02040CSR T101A TAG 02050CSR 1 ADD W2N W2N 02060CSR EXSR SR201 CLASSIFY RECORD # 02070CSR 21 GOTO T101B 02080CSR W2N CHAINEGTABLE H8 02090CSR H8 GOTO END101 02100CSR 01 MOVEAREC M1 02110CSR 02 MOVEAREC N1 02120CSR 03 MOVEAREC M3 02130CSR 04 MOVEAREC B3 02140CSR 05 MOVEAREC J3 02150CSR 06 MOVEAREC S3 02160CSR 07 MOVEAREC E3 02170CSR 08 MOVEAREC H3 02180CSR 09 MOVEAREC P3 02190CSR 10 MOVEAREC J4 02200CSR 11 MOVEAREC D4 02210CSR 12 MOVEAREC W4 02220CSR 13 MOVEAREC J5 02230CSR 14 MOVEAREC B5 02240CSR 15 MOVEAREC S5 02250CSR 16 MOVEAREC H5 ÐÐ02260CSR 17 MOVEAREC E5 02270CSR 18 MOVEAREC P5 02280CSR 19 MOVEAREC S6 02290CSR 20 MOVEAREC T6 02300CSR GOTO T101A 02310C*------------------------------------------------------------------- 02320CSR T101B TAG 02330CSR MOVE ' ' BLK8 8 02340CSR MOVE ' ' BLK35 35 02350CSR MOVE ' ' BLK12 12 02360CSR END101 ENDSR 02370C******************************************************************** 02380CSR SR102 BEGSR 02390C* REQUEST JOB #. 02400CSR Z-ADD249 M 50 02410CSR EXSR SR89 GET MSG 02420CSR EXSR SR73 PROMPT 02430CSR EXSR SR75 READ 02440CSR 90 GOTO END102 02450CSR 77 GOTO T102A INPUT MADE 02460CSR Z-ADD435 M FLAG ERROR 02470CSR EXSR SR73 PUT MSG 02480CSR GOTO SR102 02490C*------------------------------------------------------------------- 02500CSR T102A TAG ÐÐ02510CSR MOVELW12A JOBNO 6 JOB # 02520CSR Z-ADD1 W 02530CSR JOBNO LOKUPW4,W 54 02540CSR 54 MOVE J4 JOBCOD 1 JOB CODE 02550CSR 54 GOTO END102 02560CSR Z-ADD5 M FLAG ERROR 02570CSR EXSR SR73 PUT MSG 02580CSR GOTO SR102 02590CSR END102 ENDSR 02600C******************************************************************** 02610CSR SR103 BEGSR 02620C* DISPLAY JOB TASKS. 02630CSR Z-ADD1 J 30 02640C*------------------------------------------------------------------- 02650CSR T103A TAG 02660CSR J4,W LOKUPJ5,J 54 02670CSRN54 GOTO END103 02680CSR Z-ADD1 S 30 02690CSR S5,J LOKUPS6,S 54 02700CSR MOVE T6,S TITLE 12 02710CSR SETON 72 02720CSR EXCPT DISPLAY TASK 02730CSR SETOF 72 02740CSR 1 ADD J J 02750CSR J COMP 300 54 ÐÐ02760CSRN54 GOTO T103A 02770CSR END103 ENDSR 02780C******************************************************************** 02790CSR SR104 BEGSR 02800C* REQUEST TASK. 02810CSR Z-ADD429 M 02820CSR EXSR SR73 PROMPT 02830CSR EXSR SR75 READ 02840CSR 90 GOTO END104 ESC INPUT 02850CSRN77 Z-ADD435 M 02860CSRN77 EXSR SR73 FLAG ERROR 02870CSRN77 GOTO SR104 02880CSR Z-ADD1 S 02890CSR MOVE W12A TITLE 12 02900CSR TITLE LOKUPT6,S 54 CHECK TASK MAST 02910CSR 54 GOTO T104A GOT IT 02920CSR Z-ADD5 M 02930CSR EXSR SR73 FLAG ERROR 02940CSR GOTO SR104 02950C*------------------------------------------------------------------- 02960CSR T104A TAG 02970CSR S5,J COMP S6,S 54 FIND TASK 02980CSR 54 GOTO END104 GOT IT 02990CSR 1 ADD J J 03000CSR J COMP 300 54 ÐÐ03010CSRN54 GOTO T104A LOOK AGAIN 03020CSR Z-ADD5 M 03030CSR EXSR SR73 FLAG ERROR 03040CSR GOTO SR104 03050CSR END104 ENDSR 03060C******************************************************************** 03070CSR SR105 BEGSR 03080C* REQUEST START DATE. 03090CSR Z-ADD430 M 03100CSR EXSR SR73 PROMPT 03110CSR EXSR SR75 READ 03120CSR EXSR SR203 R. ADJUST 03130CSR MOVE W12A START 4 03140CSR ENDSR 03150C******************************************************************** 03160CSR SR106 BEGSR 03170C* DISPLAY JOB FROM INPUT START DATE FORWARD. 03180CSR Z-ADD1 J 30 03190CSR Z-ADD0 REQ 03200C*------------------------------------------------------------------- 03210CSR T106A TAG 03220CSR JOBCOD LOKUPJ5,J 54 03230CSRN54 GOTO END106 NO MORE JOBS 03240CSR B5,J COMP START 54 54 CHECK START DATE 03250CSR 54 GOTO T106C GOT IT ÐÐ03260C*------------------------------------------------------------------- 03270CSR T106B TAG 03280CSR 1 ADD J J 03290CSR J COMP 300 54 03300CSRN54 GOTO T106A TRY AGAIN 03310CSR GOTO END106 NO MORE JOBS 03320C*------------------------------------------------------------------- 03330CSR T106C TAG 03340CSR MOVE B5,J W4N 40 03350CSR W4N COMP CAL,20 545556 03360CSR MOVE E5,J W4N 03370CSR W4N COMP CAL,1 575859 03380CSRN55N56 03390CORN57N58 GOTO T106B BEYOND CALENDAR 03400CSR Z-ADD0 C 30 03410C*------------------------------------------------------------------- 03420CSR T106D TAG 03430CSR 1 ADD C C 03440CSR C COMP 20 54 03450CSR 54 GOTO T106B BEYOND CALENDAR 03460CSR MOVE B5,J W4N 03470CSR CAL,C COMP W4N 54 54 03480CSRN54 GOTO T106D BEFORE START DATE 03490CSR MOVE E5,J W4N 03500CSR W4N COMP CAL,C 54 54 ÐÐ03510CSRN54 GOTO T106B BEYOND END DATE 03520CSR MOVE H5,J HOURS 40 03530CSR HOURS ADD REQ,C REQ,C HRS REQD 03540CSR GOTO T106D 03550CSR END106 ENDSR 03560C******************************************************************** 03570CSR SR201 BEGSR 03580C* CLASSIFY RECORD #. 03590CSR EGNO COMP 1 01 03600CSR EGNO COMP 2 02 03610CSR EGNO COMP 3 03 03620CSR EGNO COMP 4 04 03630CSR EGNO COMP 5 05 03640CSR EGNO COMP 6 06 03650CSR EGNO COMP 7 07 03660CSR EGNO COMP 8 08 03670CSR EGNO COMP 9 09 03680CSR EGNO COMP 10 10 03690CSR EGNO COMP 11 11 03700CSR EGNO COMP 12 12 03710CSR EGNO COMP 13 13 03720CSR EGNO COMP 14 14 03730CSR EGNO COMP 15 15 03740CSR EGNO COMP 16 16 03750CSR EGNO COMP 17 17 ÐÐ03760CSR EGNO COMP 18 18 03770CSR EGNO COMP 19 19 03780CSR EGNO COMP 20 21 20 03790CSR ENDSR 03800C******************************************************************** 03810CSR SR203 BEGSR 03820C* R. ADJUST. 03830CSR Z-ADD12 W2N 20 03840CSR EXIT SUBRAJ R. ADJUST 03850CSR RLABL W2N 03860CSR RLABL W12A 03870CSR ENDSR 03880O******************************************************************** 03890OTERM132 E 71 03900O*------------------------------------------------------------------- 03910O E 71 03920O 72 'JOB SCHEDULE' 03930O*------------------------------------------------------------------- 03940O E 71 03950O 6 'MAN OR' 03960O*------------------------------------------------------------------- 03970O E 71 03980O 34 'DESCRIPTION' 03990O*------------------------------------------------------------------- 04000O E 71 ÐÐ04010O 5 'JOB #' 04020O 30 'OR TASK' 04030O CAL,1 Z 37 04040O CAL,2 Z 42 04050O CAL,3 Z 47 04060O CAL,4 Z 52 04070O CAL,5 Z 57 04080O CAL,6 Z 62 04090O CAL,7 Z 67 04100O CAL,8 Z 72 04110O CAL,9 Z 77 04120O CAL,10Z 82 04130O CAL,11Z 87 04140O CAL,12Z 92 04150O CAL,13Z 97 04160O CAL,14Z 102 04170O CAL,15Z 107 04180O CAL,16Z 112 04190O CAL,17Z 117 04200O CAL,18Z 122 04210O CAL,19Z 127 04220O CAL,20Z 132 04230O*------------------------------------------------------------------- 04240O E 71 04250O*------------------------------------------------------------------- ÐÐ04260O E 72 04270O JOBNO 6 04280O D4,W 20 04290O T6,S 34 04300O MHR,1 K 37 04310O MHR,2 K 42 04320O MHR,3 K 47 04330O MHR,4 K 52 04340O MHR,5 K 57 04350O MHR,6 K 62 04360O MHR,7 K 67 04370O MHR,8 K 72 04380O MHR,9 K 77 04390O MHR,10K 82 04400O MHR,11K 87 04410O MHR,12K 92 04420O MHR,13K 97 04430O MHR,14K 102 04440O MHR,15K 107 04450O MHR,16K 112 04460O MHR,17K 117 04470O MHR,18K 122 04480O MHR,19K 127 04490O MHR,20K 132 04500O*------------------------------------------------------------------- ÐÐ04510O E 74 04520O 12 'TOTAL-REQ''D' 04530O REQ,1 K 37 04540O REQ,2 K 42 04550O REQ,3 K 47 04560O REQ,4 K 52 04570O REQ,5 K 57 04580O REQ,6 K 62 04590O REQ,7 K 67 04600O REQ,8 K 72 04610O REQ,9 K 77 04620O REQ,10K 82 04630O REQ,11K 87 04640O REQ,12K 92 04650O REQ,13K 97 04660O REQ,14K 102 04670O REQ,15K 107 04680O REQ,16K 112 04690O REQ,17K 117 04700O REQ,18K 122 04710O REQ,19K 127 04720O REQ,20K 132 04730O*------------------------------------------------------------------- 04740O E 76 04750O M1,M 6 ÐÐ04760O T6,S 34 04770O MHR,1 K 37 04780O MHR,2 K 42 04790O MHR,3 K 47 04800O MHR,4 K 52 04810O MHR,5 K 57 04820O MHR,6 K 62 04830O MHR,7 K 67 04840O MHR,8 K 72 04850O MHR,9 K 77 04860O MHR,10K 82 04870O MHR,11K 87 04880O MHR,12K 92 04890O MHR,13K 97 04900O MHR,14K 102 04910O MHR,15K 107 04920O MHR,16K 112 04930O MHR,17K 117 04940O MHR,18K 122 04950O MHR,19K 127 04960O MHR,20K 132 04970O*------------------------------------------------------------------- 04980O E 78 04990O 13 'TOTAL MAN HRS' 05000O GOT,1 K 37 ÐÐ05010O GOT,2 K 42 05020O GOT,3 K 47 05030O GOT,4 K 52 05040O GOT,5 K 57 05050O GOT,6 K 62 05060O GOT,7 K 67 05070O GOT,8 K 72 05080O GOT,9 K 77 05090O GOT,10K 82 05100O GOT,11K 87 05110O GOT,12K 92 05120O GOT,13K 97 05130O GOT,14K 102 05140O GOT,15K 107 05150O GOT,16K 112 05160O GOT,17K 117 05170O GOT,18K 122 05180O GOT,19K 127 05190O GOT,20K 132 05200O*------------------------------------------------------------------- 05210O E 79 05220O 7 'BALANCE' 05230O BAL,1 K 37 05240O BAL,2 K 42 05250O BAL,3 K 47 ÐÐ05260O BAL,4 K 52 05270O BAL,5 K 57 05280O BAL,6 K 62 05290O BAL,7 K 67 05300O BAL,8 K 72 05310O BAL,9 K 77 05320O BAL,10K 82 05330O BAL,11K 87 05340O BAL,12K 92 05350O BAL,13K 97 05360O BAL,14K 102 05370O BAL,15K 107 05380O BAL,16K 112 05390O BAL,17K 117 05400O BAL,18K 122 05410O BAL,19K 127 05420O BAL,20K 132 ** M1 ARRAY 005430 005440** N1 ARRAY 005450 005460** M3 ARRAY 005470 005480** B3 ARRAY 005490 005500ÐÐ** J3 ARRAY 005510 005520** S3 ARRAY 005530 005540** E3 ARRAY 005550 005560** H3 ARRAY 005570 005580** P3 ARRAY 005590 005600** J4 ARRAY 005610 005620** D4 ARRAY 005630 005640** W4 ARRAY 005650 005660** J5 ARRAY 005670 005680** B5 ARRAY 005690 005700** S5 ARRAY 005710 005720** H5 ARRAY 005730 005740** E5 ARRAY 005750ÐÐ 005760** P5 ARRAY 005770 005780** S6 ARRAY 005790 005800** T6 ARRAY 005810 005820** A12 ARRAY 005830 005840** CAL ARRAY 005850 005860** BAL ARRAY 005870 005880** GOT ARRAY 005890 005900** MHR ARRAY 005910 005920** REQ ARRAY 005930 005940/* 005950_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(XbÐ XúX002EJ Ph120282120282(èÈÐ00010H Q002EJ00020F* UPDATE EMPLOYEE FILE - EMPLOYEE/JOB RECORD. (X002EJ) 00030F* REV 2/25/83 9:45 AM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FCRTFILE IC F 256R DISK 00070FEMPLFILEUC F 64R14AI 1 DISK A 00080FDEPTFILEIC F 32R12AI 1 DISK 00090FJOBFILE IC F 48R 7AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FTERM76 O F 76 5 00120E******************************************************************** 00130E NUL 1 76 1 00140E A6 1 6 1 00150E A36 1 36 1 A 00160E BIT 33 1 00170I******************************************************************** 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************** 00210ICRTFILE CR 00220I 1 5 CREMPL 00230I 6 13 CRUSER 00240I******************************************************************** 00250IEMPLFILEEE 54 1 CE ÐÐ00260I* RECORD CODE 2A 00270I* E = EMPLOYEE/USER CROSS-REF 00280I* U = USER/EMPLOYEE CROSS-REF 00290I* J = EMPLOYEE/JOB 00300I 1 1 EEREC 00310I* EMPLOYEE # 5N 00320I 2 60EEEMPL 00330I* USER-ID 8A 00340I 15 22 EEUSER 00350I* EMPLOYEE NAME 20A 00360I 23 42 EENAME 00370I* EMPLOYEE DEPT # 5N 00380I 43 470EEDEPT 00390I* RECORD STATUS 1A 00400I 64 64 EESTAT 00410I*------------------------------------------------------------------- 00420I EU 54 1 CU 00430I 1 1 EUREC 00440I 2 9 EUUSER 00450I 15 190EUEMPL 00460I 64 64 EUSTAT 00470I*------------------------------------------------------------------- 00480I EJ 54 1 CJ 00490I 1 1 EJREC 00500I 2 60EJEMPL ÐÐ00510I 7 90EJSEQ 00520I 15 49 EJDESC 00530I 50 55 EJJOB 00540I 56 600EJDEPT 00550I 64 64 EJSTAT 00560I*------------------------------------------------------------------- 00570I XX 54 00580I******************************************************************** 00590IDEPTFILEDH 54 1 CH 00600I* RECORD CODE 1A 00610I* H = DEPT HEAD RECORD 00620I* J = DEPT JOB RECORD 00630I 1 1 DHREC 00640I* DEPT # 5N 00650I 2 60DHDEPT 00660I* DEPT HEAD EMPLOYEE # 5N 00670I 7 110DHEMP 00680I* RECORD STATUS 1A 00690I 32 32 DHSTAT 00700I*------------------------------------------------------------------- 00710I DJ 54 1 CJ 00720I* RECORD CODE 1A 00730I 1 1 DJREC 00740I* DEPT # 5N 00750I 2 60DJDEPT ÐÐ00760I* SEQ # 3N 00770I 7 90DJSEQ 00780I* JOB CODE 6A 00790I 13 18 DJJOB 00800I* RECORD STATUS 1A 00810I 32 32 DJSTAT 00820I*------------------------------------------------------------------- 00830I XX 54 00840I******************************************************************** 00850IJOBFILE JN 54 1 CN 00860I* RECORD CODE 1A 00870I* N = JOB NAME RECORD 00880I* C = JOB CODE RECORD 00890I 1 1 JNREC 00900I* JOB NAME 6A 00910I 2 7 JNJOB 00920I* JOB DESCRIPTION 35A 00930I 8 42 JNDESC 00940I* RECORD STATUS 1A 00950I 48 48 JNSTAT 00960I*------------------------------------------------------------------- 00970I XX 54 00980I******************************************************************** 00990IMGFILE MG 01000I* MESSAGE FILE ÐÐ01010I* TEXT 35A 01020I 1 35 MGTEXT 01030I* LINE-2 35A 01040I 36 70 MGLIN2 61 01050I* PROG NAME 5A 01060I 71 75 MGPROG 01070C******************************************************************** 01080C START TAG 01090C* INITIALIZE - CLEAR - PUT HEADINGS. 01100C EXSR SR101 INIT. 01110C*------------------------------------------------------------------- 01120C CONTU TAG 01130C* READ DATA FROM CRT. 01140C SETOF 949677 01150C 1 ADD F F 30 FIELD #. 01160C F COMP 4 54 01170C 54 GOTO UPDATE 01180C EXSR SR75 READ,ETC. 01190C 94 'H' LOKUPA36 54 01200C 94 54 GOTO START 01210C 94 GOTO END EXIT. 01220C N77 GOTO EDIT NO INPUT. 01230C EXSR SR102 IDENTIFY-F. 01240C 61 MOVELW36A TTCODE 1 TRAN CODE. 01250C 62 MOVE W15A EMPLOY 50 EMPLOY #. ÐÐ01260C 63 MOVE W15A SEQ 30 SEQ #. 01270C 64 MOVE W15A NEWSEQ 30 MENU SEQ # 01280C*-------------------------------------------------------------------- 01290C EDIT TAG 01300C 62 EXSR SR108 VERIFY EMPLOYEE 01310C 96 EXSR SR72 REWRITE DATA 01320C 96 GOTO ERROR ERROR. 01330C EXSR SR102 IDENTIFY-F. 01340C 63 EXSR SR109 VERIFY JOB #. 01350C EXSR SR72 REWRITE DATA 01360C 96 GOTO ERROR 01370C GOTO CONTU 01380C*------------------------------------------------------------------- 01390C UPDATE TAG 01400C EXSR SR103 CLASSIFY TRAN. 01410C 60 GOTO ADD ADD TRAN. 01420C 61 GOTO CHANGE CHANGE TRAN. 01430C 62 GOTO DELETE DELETE TRAN. 01440C* FLAG INVALID TRANS CODE. 01450C Z-ADD1 F 01460C Z-ADD300 M 50 96 MSG #. 01470C GOTO ERROR 01480C*------------------------------------------------------------------- 01490C ADD TAG 01500C* ADD TRANS. ÐÐ01510C EXSR SR80 GET MAST. 01520C 60 GOTO NOFILE NOT ON FILE. 01530C 61 GOTO DELFIL DELETED. 01540C* FLAG DUPLICATE ADD. 01550C Z-ADD1 F 01560C Z-ADD301 M 96 01570C GOTO ERROR 01580C*------------------------------------------------------------------- 01590C NOFILE TAG 01600C* ADD--- NOT ON FILE. 01610C EXSR SR104 INIT MAST. 01620C EXSR SR105 MOVE DATA. 01630C EXSR SR106 EDIT. 01640C 96 GOTO ERROR ERROR. 01650C MOVE EMPLOY EJEMPL EMPLOYEE #. 01660C EXSR SR81 ADD NEW MAST. 01670C GOTO START 01680C*------------------------------------------------------------------- 01690C DELFIL TAG 01700C* ADD--- DELETED MAST. 01710C EXSR SR105 MOVE DATA. 01720C EXSR SR106 EDIT. 01730C 96 GOTO ERROR ERROR. 01740C MOVE 'A' EJSTAT RECORD STATUS. 01750C EXSR SR82 REWRITE MAST. ÐÐ01760C GOTO START 01770C*------------------------------------------------------------------- 01780C CHANGE TAG 01790C* CHANGE TRANS. 01800C EXSR SR80 GET MAST. 01810C N60N61 GOTO CHGOK 01820C* FLAG NO MAST ERROR. 01830C Z-ADD1 F 01840C Z-ADD302 M 96 01850C GOTO ERROR ERROR 01860C*------------------------------------------------------------------- 01870C CHGOK TAG 01880C EXSR SR105 MOVE DATA. 01890C EXSR SR106 EDIT. 01900C 96 GOTO ERROR ERROR. 01910C EXSR SR82 REWRITE MAST. 01920C GOTO START 01930C*------------------------------------------------------------------- 01940C DELETE TAG 01950C* DELETE TRANS. 01960C EXSR SR80 GET MAST. 01970C N60N61 GOTO DELOK GOT IT. 01980C* FLAG NO MAST ERROR. 01990C Z-ADD1 F 02000C Z-ADD302 M 96 MSG #. ÐÐ02010C GOTO ERROR ERROR. 02020C*------------------------------------------------------------------- 02030C DELOK TAG 02040C MOVE 'D' EJSTAT RECORD STATUS. 02050C EXSR SR82 REWRITE MAST. 02060C GOTO START 02070C*------------------------------------------------------------------- 02080C ERROR TAG 02090C EXSR SR89 GET MGFILE. 02100C EXSR SR73 PUT MSG. 02110C F SUB 1 F 02120C GOTO CONTU 02130C*------------------------------------------------------------------- 02140C END TAG 02150C EXSR SR70 CLEAR CRT. 02160C MOVEL'QQDP02' PROG 8 02170C EXITFCHAIN 02180C RLABL PROG 02190C******************************************************************** 02200CSR SR70 BEGSR 02210C* CLEAR CRT. PUT TITLE. 02220CSR EXITFQTOPF CLEAR CRT 02230CSR SETON 70 02240CSR EXCPT PUT HEADING 02250CSR SETOF 70 ÐÐ02260CSR ENDSR 02270C******************************************************************** 02280CSR SR72 BEGSR 02290C* PUT PROMPT TO CRT. 02300CSR EXSR SR102 IDENTIFY-F. 02310CSR SETON 72 02320CSR EXCPT PROMPT. 02330CSR SETOF 72 02340CSR ENDSR 02350C******************************************************************** 02360CSR SR73 BEGSR 02370C* PUT ERR MESSAGE. 02380CSR EXSR SR89 GET MSG. 02390CSR EXSR SR74 PUT MSG. 02400CSR ENDSR 02410C******************************************************************** 02420CSR SR74 BEGSR 02430C* PUT MSG. 02440CSR EXSR SR102 IDENTIFY-F. 02450CSR SETON 74 02460CSR EXCPT PUT MSG. 02470CSR SETOF 74 02480CSR ENDSR 02490C******************************************************************** 02500CSR SR75 BEGSR ÐÐ02510C* READ FROM CRT. 02520CSR SETOF 949677 02530CSR MOVE BIT,12 A6,2 02540CSR MOVEAA6 W6A 6 02550CSR MOVE BLK36 W15A 02560CSR MOVE BLK36 W36A 36 02570CSR EXSR SR72 PROMPT. 02580CSR EXITFXCREAD READ CRT. 02590CSR RLABL W36A BUF. 02600CSR RLABL W6A BUF LGTH. 02610CSR MOVEAW36A A36 02620CSR MOVE BLK36 W36A 02630CSR '\' LOKUPA36 94 02640CSR 94 GOTO END75 EXIT. 02650CSR Z-ADD1 W 30 02660CSR ' ' LOKUPA36,W 77 02670CSRN77 GOTO END75 02680CSR MOVEAA36,W W36A 02690CSR F COMP 1 54 02700CSR 54 GOTO END75 NOT NUMERIC. 02710CSR MOVELW36A W15A 15 02720CSR Z-ADD15 W2N 20 02730CSR EXIT SUBRAJ RIGHT ADJUST. 02740CSR RLABL W2N 02750CSR RLABL W15A ÐÐ02760CSR MOVE W15A W15N 150 02770CSR MOVE 'Z' EDIT 1 02780CSR EXIT SUBRED 02790CSR RLABL W15N 02800CSR RLABL EDIT 02810CSR RLABL W15A 02820CSR RLABL W2N 02830C*------------------------------------------------------------------- 02840CSR END75 TAG 02850CSR MOVE BLK35 MGTEXT 02860CSR EXSR SR74 PUT MSG. 02870CSR ENDSR 02880C******************************************************************** 02890CSR SR80 BEGSR 02900C* GET EMPL/JOB MAST. 02910CSR SETOF 6061 02920CSR MOVE ' ' A36 02930CSR MOVE 'J' A36,1 02940CSR MOVELEMPLOY W8N 80 02950CSR MOVE NEWSEQ W8N 02960CSR MOVE W8N W8A 8 02970CSR MOVEAW8A A36,2 02980CSR MOVEAA36,1 W14A 14 02990CSR W14A CHAINEMPLFILE 60 03000CSRN60 EJSTAT COMP 'D' 61 ÐÐ03010CSR ENDSR 03020C******************************************************************** 03030CSR SR81 BEGSR 03040C* ADD NEW MAST. 03050CSR SETON 81 03060CSR EXCPT ADD MAST. 03070CSR SETOF 81 03080CSR ENDSR 03090C******************************************************************** 03100CSR SR82 BEGSR 03110C* REWRITE MAST. 03120CSR SETON 82 03130CSR EXCPT REWRITE MAST. 03140CSR SETOF 82 03150CSR ENDSR 03160C******************************************************************** 03170CSR SR89 BEGSR 03180C* GET MGFILE. 03190CSR M CHAINMGFILE 60 03200CSR 60 MOVE BLK35 MGTEXT 03210CSR 60 MOVELM MGTEXT 03220CSR 60 MOVE 'NO-FILE' MGTEXT 03230CSR ENDSR 03240C******************************************************************** 03250CSR SR101 BEGSR ÐÐ03260C* INITIALIZE. 03270CSR Z-ADD0 F 03280CSR MOVE BIT,1 NUL 03290CSR MOVE BIT,1 A6 03300CSR SETON 80 03310CSR EXSR SR70 CLEAR CRT. 03320CSR SETOF 80 03330CSR EXSR SR107 GET CRTFILE. 03340CSR MOVE ' ' BLK35 35 03350CSR MOVE ' ' BLK6 6 03360CSR MOVE ' ' BLK14 14 03370CSR MOVE ' ' BLK36 36 03380CSR ENDSR 03390C******************************************************************** 03400CSR SR102 BEGSR 03410C* IDENTIFY FIELD #. 03420CSR F COMP 1 61 TRANS CODE. 03430CSR F COMP 2 62 EMPLOYEE #. 03440CSR F COMP 3 63 SEQ #. 03450CSR F COMP 4 64 MENU SEQ # 03460CSR ENDSR 03470C******************************************************************** 03480CSR SR103 BEGSR 03490C* CLASSIFY TRANS CODE. 03500CSR TTCODE COMP 'A' 60 ADD ÐÐ03510CSR TTCODE COMP 'C' 61 CHANGE 03520CSR TTCODE COMP 'D' 62 DELETE 03530CSR ENDSR 03540C******************************************************************** 03550CSR SR104 BEGSR 03560C* INIT MAST. 03570CSR MOVE 'J' EJREC 03580CSR Z-ADD0 EJEMPL 03590CSR MOVE BLK6 EJJOB 03600CSR MOVE BLK35 EJDESC 03610CSR Z-ADD0 EJSEQ 03620CSR MOVE 'A' EJSTAT 03630CSR ENDSR 03640C******************************************************************** 03650CSR SR105 BEGSR 03660C* MOVE DATA. 03670CSR TTCODE COMP 'A' 55 03680CSR 55 MOVE 'J' EJREC 03690CSR 55 EMPLOY COMP 0 54 03700CSR 55 54 Z-ADDEMPLOY EJEMPL 03710CSR JOB COMP BLK6 54 03720CSR 54 MOVE JOB EJJOB 03730CSR DESCR COMP BLK35 54 03740CSR 54 MOVE DESCR EJDESC 03750CSR NEWSEQ COMP 0 54 ÐÐ03760CSR 54 55 Z-ADDNEWSEQ EJSEQ 03770CSR Z-ADDDEPT EJDEPT 03780CSR ENDSR 03790C******************************************************************** 03800CSR SR106 BEGSR 03810C* EDIT MASTER. 03820CSR Z-ADD1 F 03830CSR EJREC COMP 'J' 54 03840CSRN54 Z-ADD303 M 50 96 MSG #. 03850CSRN54 GOTO END106 03860CSR Z-ADD2 F 03870CSR EJEMPL COMP 0 54 03880CSRN54 Z-ADD308 M 96 03890CSRN54 GOTO END106 03900CSR Z-ADD5 F 03910CSR EJJOB COMP BLK6 54 03920CSRN54 Z-ADD309 M 96 03930CSRN54 GOTO END106 03940CSR Z-ADD4 F 03950CSR EJDESC COMP BLK35 54 03960CSRN54 Z-ADD310 M 96 03970CSRN54 GOTO END106 03980CSR Z-ADD3 F 03990CSR EJSEQ COMP 0 54 04000CSRN54 Z-ADD305 M 96 ÐÐ04010CSRN54 GOTO END106 04020CSR END106 ENDSR 04030C******************************************************************** 04040CSR SR107 BEGSR 04050C* GET CRT FILE. 04060CSR MOVE ' ' W2A 2 04070CSR EXITFZGMINX 04080CSR RLABL W2A 04090CSR MOVE W2A PORT 20 04100CSR PORT CHAINCRTFILE 04110CSR ENDSR 04120C******************************************************************** 04130CSR SR108 BEGSR 04140C* VERIFY EMPLOYEE. 04150CSR EMPLOY COMP 0 54 04160CSRN54 Z-ADD308 M 96 04170CSRN54 GOTO END108 04180CSR MOVE ' ' A36 04190CSR MOVE 'E' A36,1 04200CSR MOVE EMPLOY W5A 5 04210CSR MOVEAW5A A36,2 04220CSR MOVEAA36 W14A 14 04230CSR W14A CHAINEMPLFILE 60 04240CSR SETOF 61 04250CSRN60 EESTAT COMP 'D' 61 ÐÐ04260CSRN60N61 GOTO T108A 04270CSR EXSR SR103 CLASSIFY TRAN. 04280CSR 62 GOTO T108A DELETE. 04290CSR Z-ADD308 M 96 04300CSR GOTO END108 04310C*------------------------------------------------------------------- 04320CSR T108A TAG 04330CSR Z-ADDEEDEPT DEPT 50 04340CSR CREMPL COMP '95857' 54 04350CSR 54 GOTO END108 04360CSR MOVE EEDEPT W5A 04370CSR MOVE 'H' A36,1 04380CSR MOVEAW5A A36,2 04390CSR MOVEACREMPL A36,7 04400CSR MOVE ' ' A36,12 04410CSR MOVEAA36,1 W12A 12 04420CSR SETOF 61 04430CSR W12A CHAINDEPTFILE 60 04440CSRN60 DHSTAT COMP 'D' 61 04450CSRN60N61 GOTO END108 04460CSR Z-ADD304 M 96 04470CSR END108 ENDSR 04480C******************************************************************** 04490CSR SR109 BEGSR 04500C* VERIFY JOB #. ÐÐ04510CSR MOVE ' ' A36 04520CSR MOVE 'J' A36,1 04530CSR MOVE EEDEPT W5A 5 04540CSR MOVEAW5A A36,2 04550CSR MOVE SEQ W3A 3 04560CSR MOVEAW3A A36,7 04570CSR MOVEAA36 W12A 04580CSR SETOF 61 04590CSR W12A CHAINDEPTFILE 60 04600CSRN60 DJSTAT COMP 'D' 61 04610CSRN60N61 GOTO T109A 04620CSR EXSR SR103 CLASSIFY TRAN. 04630CSR 62 GOTO T109A DELETE TRAN. 04640CSR Z-ADD309 M 96 FLAG ERROR 04650CSR GOTO END109 04660C*------------------------------------------------------------------- 04670CSR T109A TAG 04680CSR MOVE DJJOB JOB 6 04690CSR MOVEL'N' W7A 7 04700CSR MOVE JOB W7A 04710CSR SETOF 61 04720CSR W7A CHAINJOBFILE 60 04730CSRN60 JNSTAT COMP 'D' 61 04740CSRN60N61 MOVE JNDESC DESCR 35 04750CSRN60N61 GOTO END109 ÐÐ04760CSR EXSR SR103 CLASSIFY TRAN. 04770CSR 62 GOTO END109 04780CSR Z-ADD309 M 96 04790CSR END109 ENDSR 04800O******************************************************************** 04810OTERM76 E 70 04820O* CLEAR CRT. 04830O 80 BIT,28 1 04840O 80 2 '8' 04850O 80 8 '001050' 04860O 80 27 'EMPLOYEE/JOB UPDATE' 04870O*------------------------------------------------------------------- 04880O E 72 04890O* PROMPT. 04900O NUL 76 04910O BIT,28 1 04920O 2 '8' 04930O 61 5 '003' 04940O 62 5 '005' 04950O 63 5 '007' 04960O 64 5 '009' 04970O 8 '001' 04980O 61 32 'ENTER TRAN CODE (A,C,D) ' 04990O 62 32 'ENTER EMPLOYEE # ' 05000O 63 32 'ENTER DEPT JOB SEQ # ' ÐÐ05010O 64 32 'ENTER MENU SEQ # ' 05020O 33 ' ' 05030O 61 TTCODE 34 05040O 62 EMPLOYZ 38 05050O 63 SEQ Z 36 05060O 64 NEWSEQZ 68 05070O BIT,28 69 05080O 70 '8' 05090O 61 73 '003' 05100O 62 73 '005' 05110O 63 73 '007' 05120O 64 73 '009' 05130O 76 '026' 05140O*------------------------------------------------------------------- 05150O E 74 05160O* ERR MESSAGE. 05170O NUL 76 05180O BIT,28 1 05190O 2 '8' 05200O 8 '013090' 05210O MGTEXT 43 05220O 96 BIT,8 44 05230O******************************************************************** 05240OEMPLFILEEADD 81 05250O* ADD NEW MAST. ÐÐ05260O 1 'J' 05270O EJEMPL 6 05280O EJSEQ 9 05290O EJDESC 49 05300O EJJOB 55 05310O EJDEPT 60 05320O 64 'A' 05330O*------------------------------------------------------------------- 05340O E 82 05350O* REWRITE MAST. 05360O EJDESC 49 05370O EJJOB 55 05380O EJDEPT 60 05390O EJSTAT 64 ** NUL ARRAY 005400 005410** A6 ARRAY 005420 005430** A36 ARRAY 005440 005450/* 005460_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(LiÕ LËX012WO P999999120282(èÈÐ00010H Q012WO00020F* UPDATE BACKORDER REQUIREMENTS-ADD,CHG,DEL. (X012WO) 00030F* REVISED 10-12-82 4:30 PM. 00040F* NOTE: DOES NOT UPDATE PULL FILE REQUIREMENTS. 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FBOMAST UC F 80R19AI 1 DISK A 00090FALTDUE UC F 32R29AI 1 DISK A 00100FALTPN UC F 32R29AI 1 DISK A 00110FWOMAST IC F 228R 9AI 1 DISK 00120FGLMAST IC F 165R 9AI 1 DISK 00130FPMMST2 UC F 674R12AI 1 DISK 00140FCALENDARIC F 22R 7AI 1 DISK 00150FBMMAST IC F 86R20AI 1 DISK 00160FTERM132 O F 132 5 00170FPRODWO IT F 80 EDISK 00180F**************************************************************** 00190E PRODWO TABPWO 1 4 1 TABWON 20 00200E NUL 1 132 1 NULL CHAR 00210E A20 20 20 1 A INPUT DATA ARRAY 00220E NUM 1 5 3 0 NUMERIC FIELD NO.'S 00230E DUN 1 8 1 A EDIT CMPLT FLAG 00240E MES 1 1 30 00250E DOT 33 33 1 DIVIDER ÐÐ00260E A29 29 29 1 WORK ARRAY 00270E AR 29 29 1 WORK ARRAY 00280E TABISS 1 9 2 TABICN 15 00290E A39 39 39 1 00300E LNK 1 7 6 A 00310E CALL 7 6 00320E PAR 25 1 00330E TST 25 1 00340E PLT 8 3 0 00350E BIT 33 1 SCREEN CONTR. CHAR 00360I******************************************************************* 00370IBITPAR BT 00380I 1 33 BIT 00390I 34 58 PAR 00400I 59 83 TST 00410I******************************************************************* 00420IMGFILE MG 00430I* MESSAGE FILE. 00440I 1 35 MGTEXT 00450I******************************************************************** 00460ICALENDARCA 20 1 CC 00470I 2 70CACAL 00480I 14 170CAMDAY 00490I*----------------------------------------------------------------- 00500I CB 21 1 CM ÐÐ00510I 4 70CAMDAY 00520I 8 130CACAL 00530I*------------------------------------------------------------------ 00540I CG 02 00550I****************************************************************** 00560ICRTFILE CR 00570I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00580I* EMPLOYEE # 5N 00590I* 1 50CREMPL 00600I* USER CODE 8A 00610I* 6 13 CRUSER 00620I* DEPT # 5N 00630I* 14 180CRDEPT 00640I* JOB NAME 8A (JOB LOADED BY MENU) 00650I* 19 26 CRJOB 00660I* SHUTDOWN FLAG 1A 00670I* BLANK = NO SHUTDOWN 00680I 27 27 CRSHUT 00690I* TIME STARTED 6N 00700I 28 330CRTIME 00710I* DATE STARTED 4N 00720I 34 370CRDATE 00730I* CALL STACK 7 X 6A 00740I 38 79 CALL 00750I******************************************************************** ÐÐ00760IBOMAST BO 00770I* BACKORDER MASTER. 00780I* ORDER NO. 9A 00790I 1 6 BOWOP 00800I 7 90BOWOD 00810I 1 9 BOWO 00820I* PART NO. 10N 00830I 10 190BOPN 00840I* FILLER 2A 20 21 FFFFFF 00850I* QTY REQD 7P 00860I P 22 250BOQTYR 00870I* QTY ISSUED 7P 00880I P 26 290BOQTYC 00890I* DATE REQD 6N (YMD) 00900I 30 350BODUE 00910I* DATE LAST ISSUE 6N (YMD) 00920I 36 410BODLT 00930I* DELIVER TO 15A 00940I 42 56 BODEL 00950I* ASSY PART NO. 10N 00960I 57 660BONAPN 00970I* QTY PER ASSY 7P 00980I P 67 700BOQPA 00990I* RECORD STATUS 1A 01000I 80 80 BOSTAT ÐÐ01010I******************************************************************** 01020IALTDUE AD 01030I* ALT KEY - DUE DATE. 01040I* RECORD CODE 2A (70) 1 2 ADREC 01050I* DUE DATE 6N (YMD) 3 80ADDUE 01060I* ORDER # 9A 9 17 ADWO 01070I* FILLER (ZEROS) 2A 18 19 FFFFFF 01080I* PART # 10N 20 290ADPN 01090I* RECORD STATUS 1A 01100I 32 32 ADSTAT 01110I******************************************************************** 01120IALTPN AP 01130I* ALT KEY - PART #. 01140I* PART # 10N 1 100APPN 01150I* DUE DATE 6N (YMD) 11 160APDUE 01160I* RECORD CODE 2A (70) 17 18 APREC 01170I* ORDER # 9A 19 27 APWO 01180I* FILLER (ZEROS) 2A 28 29 FFFFFF 01190I* RECORD STATUS 1A 01200I 32 32 APSTAT 01210I******************************************************************** 01220IPMMST2 PM 01230I 1 100PMPN 01240I P 13 140PMNOBM 01250I 15 180PMPL ÐÐ01260I 19 30 PMMODL 01270I 31 59 PMDESC 01280I 70 71 PMECHG 01290I 94 95 PMSC 01300I P 113 128 PLT 01310I P 311 3140PMOHB 01320I P 319 3220PMALB 01330I P 323 3260PMRLB 01340I 674 674 PMSTAT 01350I******************************************************************** 01360IBMMAST BM 01370I P 28 310BMQTY 01380I 36 37 BMISSU 01390I 86 86 BMSTAT 01400I******************************************************************** 01410IGLMAST GL 01420I 18 57 GLNAME 01430I 164 164 GLSTAT 01440I******************************************************************** 01450IWOMAST WO 01460I 1 6 WOWOP 01470I 10 190WOPN 01480I 114 148 WODESC 01490I 149 160 WOMODL 01500I 183 1880WOCLOS ÐÐ01510I 228 228 WOSTAT 01520C******************************************************************** 01530C* INITIALIZE 01540C EXSR SR101 1-TIME INIT 01550C MOVE ' ' BLK6 6 STUPIDITY 01560C*------------------------------------------------------------------ 01570C START TAG 01580C* SET-UP 1ST FIELD NO. 01590C* * * * * MOVE ' ' TRAN 01600C Z-ADD0 TPN 01610C* * * * * MOVE BLK35 TWO 01620C* * * * * MOVE BLK8 TWOP 01630C* * * * * Z-ADD0 TWOD 01640C EXSR SR205 INIT BOMAST 01650C Z-ADD0 PMOHB 01660C Z-ADD0 STKBAL 70 01670C MOVE BLK35 PMDESC 01680C MOVE BLK35 TRNNAM 01690C MOVE BLK35 MGTEXT 01700C MOVE BLK35 ASYDES 01710C MOVE BLK35 CDESC 01720C EXSR SR70 CLEAR PAGE 4 01730C EXSR SR71 PUT HEADINGS 01740C MOVE ' ' DUN INIT EDIT ARRAY 01750C Z-ADD1 F 30 FIELD # ÐÐ01760C GOTO READ 01770C*------------------------------------------------------------------ 01780C NEXT TAG 01790C* SET-UP NEXT FIELD NO. 01800C 1 ADD F F FIELD # 01810C EXSR SR66 INIT A39 01820C*----------------------------------------------------------------- 01830C READ TAG 01840C* READ DATA FROM TERMINAL. 01850C SETOF 909677 01860C EXSR SR102 VALIDATE FIELD # 01870C 55 GOTO UPDATE DONE 01880C EXSR SR201 IDENTIFY-F 01890C EXSR SR203 CLASSIFY TRAN 01900C F COMP 4 54 01910C 62 54 GOTO UPDATE 01920C 06N70 01930COR 07N70 GOTO EDIT NOT PROD WO NO. 01940C SETON 69 01950C EXSR SR72 PROMPT 01960C SETOF 69 01970C EXSR SR75 READ TERMINAL 02000C 90 EXSR SR72 REWRITE INPUT DATA 02010C 93 GOTO NEWITM NEW ITEM 02020C 92 GOTO JUMP FIELD JUMP REQST ÐÐ02030C 89 F SUB 1 F SKIP BACKWARD 02040C 89 GOTO READ " " 02050C 88 SETOF 90 SPACE FILL 02060C 88 SETON 77 " " 02070C 86 GOTO UPDATE UPDATE 02080C 96 GOTO ERROR ERROR 02090C N77 GOTO EDIT NO DATA INPUT 02100C*------------------------------------------------------------------ 02110C PROCES TAG 02120C* PROCESS INPUT DATA 02130C EXSR SR103 MOVE DATA 02140C*------------------------------------------------------------------- 02150C EDIT TAG 02160C N96 EXSR SR104 EDIT DATA 02170C EXSR SR72 REWRITE DATA 02180C 96 GOTO ERROR ERROR 02190C GOTO NEXT 02200C*------------------------------------------------------------------ 02210C UPDATE TAG 02220C* UPDATE DATA BASE. 02230C EXSR SR105 FINAL EDIT 02240C 96 GOTO ERROR ERROR 02250C EXSR SR106 UPDATE 02260C 96 GOTO ERROR ERROR 02270C GOTO START ÐÐ02280C*------------------------------------------------------------------- 02290C JUMP TAG 02300C* SET-UP JUMP TO REQUESTED FIELD 02310C 1 ADD W W 30 02320C W COMP 20 54 02330C 54 Z-ADD318 M 50 96 FLAG ERROR 02340C 54 GOTO ERROR BAD ESC 02350C MOVE ' ' W3A 3 02360C MOVEAA20,W W3A 02370C Z-ADD3 W2N 20 02380C EXIT SUBRAJ R. JUSTIFY 02390C RLABL W2N 02400C RLABL W3A 02410C MOVE W3A F NEW FIELD # 02420C GOTO READ 02430C*-------------------------------------------------------------------- 02440C ERROR TAG 02450C EXSR SR102 VALIDATE FIELD # 02460C EXSR SR89 GET MSG 02470C GOTO READ 02480C*------------------------------------------------------------------ 02490C NEWITM TAG 02500C* SET-UP LINK FOR NEW ITEM 02510C MOVEL'Q012WO 'PROG 8 02520C GOTO END ÐÐ02530C*------------------------------------------------------------------- 02540C MENU TAG 02550C* SET-UP LINK TO MENU 02560C EXSR SR96 GET CRTFILE 02570C Z-ADD1 W 02580C BLK6 LOKUPLNK,W 54 02590C 54 MOVELLNK,W PROG 02600C 54 MOVE BLK6 LNK,W 02610C N54 MOVEL'CONTU 'PROG 02620C EXSR SR97 UPDATE CRTFILE 02630C EXSR SR98 >>>>>>>>>>>>>>>> 02640C*-------------------------------------------------------------------- 02650C GOODBY TAG 02660C* LINK TO SIGN-OFF 02670C MOVEL'GOODBY 'PROG 02680C GOTO END 02690C*------------------------------------------------------------------- 02700C END TAG 02710C EXSR SR96 GET CRTFILE 02720C EXSR SR97 UPDATE CRTFILE 02730C EXSR SR98 >>>>>>>>>>>>>>>> 02740C*-------------------------------------------------------------- 02750C ENDJOB TAG 02760C MOVEL'ENDJOB 'PROG 02770C EXSR SR98 >>>>>>>>>> ÐÐ02780C****************************************************************** 02790CSR SR1 BEGSR 02800C* EDIT TRAN CODE 02810CSR EXSR SR203 CLASSIFY TRAN 02820CSRN60N61N62 Z-ADD300 M 50 96 FLAG ERROR 02830CSR ENDSR 02840C****************************************************************** 02850CSR SR2 BEGSR 02860C* EDIT WORK ORDER NO. 02870CSR MOVE BLK35 WODESC 02880CSR MOVE BLK15 WMODL 02890CSR Z-ADD0 WOPN 02900CSR MOVE TWOP W5N 50 02910CSR W5N COMP 0 54 02920CSRN54 Z-ADD618 M 96 FLAG ERROR 02930CSRN54 GOTO END2 02940CSR TWO CHAINWOMAST 60 GET WOMAST 02950CSRN60 WOSTAT COMP 'D' 60 02960CSRN60 GOTO T2C GOT IT 02970CSR TWO CHAINGLMAST 60 GET GLMAST 02980CSRN60 GLSTAT COMP 'D' 60 02990CSRN60 MOVELGLNAME WODESC 03000CSRN60 GOTO END2 GOT IT 03010C*R * * * * * * * * * Z-ADD664 M 96 FLAG ERROR 03020CSR GOTO END2 ÐÐ03030C*------------------------------------------------------------------- 03040CSR T2C TAG 03050CSR MOVELWOPN W12A 03060CSR EXSR SR83 GET WO PART MAST 03070CSR 60 Z-ADD291 M 96 FLAG ERROR 03080CSR 60 GOTO END2 03090CSR MOVE PMMODL WMODL 12 03100CSR END2 ENDSR 03110C********************************************************************* 03120CSR SR3 BEGSR 03130C* EDIT PART NO. 03140CSR MOVE BLK35 CDESC 29 03150CSR TPN COMP 0 54 03160CSRN54 Z-ADD299 M 96 FLAG ERROR 03170CSRN54 GOTO END3 03180CSR MOVELTPN W12A 12 03190CSR EXSR SR83 GET PART MASTER 03200CSR 60 Z-ADD291 M 96 NOT ON FILE 03210CSR 60 GOTO END3 03220CSR MOVE PMDESC CDESC 03230CSR Z-ADDPMOHB STKBAL 70 03240CSR MOVELTWO W19A 19 03250CSR MOVE TPN W19A 03260CSR EXSR SR80 GET BOMAST 03270CSRN30N31 GOTO T3C GOT IT ÐÐ03280C* NOT ON FILE CONDITION 03290CSR EXSR SR203 CLASSIFY TRAN 03300CSRN60 Z-ADD302 M 96 FLAG NOT ON FILE 03310CSR EXSR SR205 INIT BOMAST 03320CSR GOTO END3 03330C*------------------------------------------------------------------- 03340CSR T3C TAG 03350C* IS ON FILE CONDITION 03360CSR EXSR SR203 CLASSIFY TRAN 03370CSR 60 Z-ADD301 M 96 FLAG DUPLICATE 03380CSR BONAPN COMP 0 54 03390CSRN54 Z-ADDWOPN BONAPN 03400CSR EXSR SR71 PUT DATA 03410CSR END3 ENDSR 03420C***************************************************************** 03430CSR SR4 BEGSR 03440C* EDIT QTY 03450CSR BOQTYR COMP 0 54 03460CSRN54 Z-ADD184 M 96 FLAG ERROR 03470CSR ENDSR 03480C**************************************************************** 03490CSR SR5 BEGSR 03500C* EDIT DUE DATE 03510CSR Z-ADDBODUE W6N 60 03520CSR EXSR SR207 GET CALENDAR ÐÐ03530CSR 60 Z-ADD390 M 96 FLAG ERROR 03540CSR 60 GOTO END5 03550CSR Z-ADDW6N BODUE EDITED DUE DATE 03560CSR END5 ENDSR 03570C**************************************************************** 03580CSR SR6 BEGSR 03590C* EDIT ASSY PART NO. 03600CSR MOVE BLK35 ASYDES 29 03610CSR BONAPN COMP 0 54 03620CSRN54 Z-ADDWOPN BONAPN 03630CSR BONAPN COMP 0 54 03640CSRN54 GOTO END6 03650CSR MOVELBONAPN W20A 20 03660CSR MOVE TPN W20A 03670CSR W20A CHAINBMMAST 54 03680CSRN54 BMSTAT COMP 'D' 54 03690CSR 54 GOTO T6A 03700CSR Z-ADDBMQTY BOQPA 03710CSR Z-ADD7 W3N 03720CSR EXSR SR213 DISPLAY BOQPA 03730CSR MOVE 'X' DUN,7 03740C*------------------------------------------------------------------- 03750CSR T6A TAG 03760CSR MOVELBONAPN W12A 03770CSR EXSR SR83 GET PART MASTER ÐÐ03780CSRN60 MOVE PMDESC ASYDES 03790CSR MOVELTPN W12A 03800CSR EXSR SR83 GET PART MAST 03810CSR END6 ENDSR 03820C*************************************************************** 03830CSR SR66 BEGSR 03840CSR MOVEABLK35 A39,3 INIT A39 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR68 BEGSR 03880CSR EXITFZLF LINE FEED 03890CSR ENDSR 03900C*************************************************************** 03910CSR SR69 BEGSR 03920CSR 50 EXITFZPUTXY MOVE CUSOR 03930CSR RLABL RPGLIN 03940CSR RLABL RPGCOL 03950CSRN50 EXITFZMOVXY MOVE CURSOR 03960CSR RLABL RPGLIN 03970CSR RLABL RPGCOL 03980CSR ENDSR 03990C****************************************************************** 04000CSR SR70 BEGSR 04010C* CLEAR PAGE 04020CSR EXSR SR66 INIT A39 ÐÐ04030CSR 50 EXITFZISTAT CLEAR STATUS 04040CSR 50 EXITFZESCH CLEAR SCREEN 04050CSRN50 EXITFZCPAGE CLEAR SCREEN 04060CSR ENDSR 04070C********************************************************************** 04080CSR SR71 BEGSR 04090C* PUT HEADINGS TO TERMINAL 04100CSR MOVELMGTEXT W30A 30 04110CSR TWOD COMP 0 56 04120CSR SETON 71 04130CSR EXCPT PUT HEADINGS 04140CSR SETOF 71 04150CSR ENDSR 04160C********************************************************************* 04170CSR SR72 BEGSR 04180C* PUT DATA TO TERMINAL 04190CSR 02 MOVELMGTEXT W30A 04200CSR TWOD COMP 0 56 04210CSR F COMP 4 54 04220CSR 54 92 ADD F W3N 04230CSRN54 91 ADD F W3N 30 04240CSR 50 W3N SUB 90 W3N 04250CSR F COMP 2 54 04260CSR 54 1 ADD W3N W3N 04270CSR MOVELW3N RPGLIN 4 ÐÐ04280CSR MOVEL'001' RPGCOL 4 04290CSR EXSR SR69 MOVE CURSOR 04300CSR SETON 72 04310CSR EXCPT PUT DATA 04320CSR SETOF 72 04330CSR ENDSR 04340C******************************************************************* 04350CSR SR75 BEGSR 04360C* READ FROM TERMINAL 04370CSR SETOF 779096 04380CSR SETOF 9392 04390CSR SETOF 898886 04400CSR MOVE BLK20 W20A 20 BUFFER 04410CSR F COMP 4 54 04420CSR 54 93 ADD F W3N 04430CSRN54 92 ADD F W3N 30 04440CSR 50 W3N SUB 90 W3N 04450CSR F COMP 2 54 04460CSR 54 1 ADD W3N W3N 04470CSR MOVELW3N RPGLIN 04480CSR MOVEL'036' RPGCOL 04490CSR EXSR SR69 MOVE CURSOR 04500CSR EXITFZR20 READ FROM TERMINAL 04510CSR RLABL W20A READ BUFFER 04520CSR MOVEAW20A A20 INPUT DATA ARRAY ÐÐ04530CSR MOVE BLK20 W20A INIT INPUT ARRAY 04540CSR Z-ADD1 W 30 04550CSR '\' LOKUPA20,W 90 FLAG ESC 04560CSRN90 GOTO T75B NOT ESC 04570CSR 1 ADD W W 04580CSR W COMP 20 54 04590CSR 54 GOTO T75A BAD ESC 04600CSR A20,W COMP 'G' 98 GOODBY 04610CSR A20,W COMP 'E' 94 MENU 04620CSR A20,W COMP 'N' 93 NEW ITEM 04630CSR A20,W COMP 'J' 92 JUMP 04640CSR A20,W COMP 'B' 89 SKIP BKWRD 04650CSR A20,W COMP 'S' 88 SPACE FILL 04660CSR A20,W COMP 'U' 86 UPDATE 04670CSR 98 GOTO GOODBY 04680CSR 94 GOTO MENU 04690CSR 93 GOTO NEWITM 04700CSR 92 04710COR 89 04720COR 88 04730COR 86 GOTO END75 GOOD ESC 04740C*------------------------------------------------------------------ 04750CSR T75A TAG 04760C* FLAG BAD ESC INPUT 04770CSR Z-ADD318 M 96 FLAG ERROR ÐÐ04780CSR GOTO END75 04790C*-------------------------------------------------------------------- 04800CSR T75B TAG 04810C* MOVE DATA 04820CSR Z-ADD1 W 04830CSR ' ' LOKUPA20,W 77 04840CSR 77 MOVEAA20,W W20A INPUT DATA 04850C*-------------------------------------------------------------------- 04860CSR END75 TAG 04870C* INIT PREV ERROR MSG. 04880CSR EXSR SR66 INIT A39 04890CSR ENDSR 04900C********************************************************************** 04910CSR SR80 BEGSR 04920C* GET BACKORDER MASTER 04930CSR SETOF 31 04940CSR W19A CHAINBOMAST 30 GET MASTER 04950CSRN30 BOSTAT COMP 'D' 31 FLAG DELETE 04960CSR Z-ADD0 OLDQTY 70 04970CSR MOVE ZERO6 OLDDUE 6 04980CSR 30 04990COR 31 GOTO END80 05000CSR BOQTYR SUB BOQTYC OLDQTY 54 05010CSRN54 Z-ADD0 OLDQTY 05020CSR MOVE BODUE OLDDUE ÐÐ05030CSR EXSR SR6 GET ASSY DATA 05040CSR END80 ENDSR 05050C********************************************************************** 05060CSR SR81 BEGSR 05070C* ADD NEW MASTER TO FILE 05080CSR SETON 81 05090CSR EXCPT ADD REQUIREMENT 05100CSR SETOF 81 05110CSR ENDSR 05120C*********************************************************************** 05130CSR SR82 BEGSR 05140C* REWRITE BOMAST REQUIREMENT 05150CSR SETON 82 05160CSR EXCPT REWRITE REQUIREMENT 05170CSR SETOF 82 05180CSR ENDSR 05190C****************************************************************** 05200CSR SR83 BEGSR 05210C* GET PART MASTER 05220CSR MOVE ' ' W12A 12 05230CSR W12A CHAINPMMST2 60 GET PART MASTER 05240CSRN60 PMSTAT COMP 'D' 60 05250CSR ENDSR 05260C****************************************************************** 05270CSR SR84 BEGSR ÐÐ05280C* UPDATE PART MASTER 05290CSR SETON 84 05300CSR 70 EXCPT UPDATE PART MASTER 05310CSR SETOF 84 05320CSR ENDSR 05330C********************************************************************** 05340CSR SR89 BEGSR 05350C* GET MESSAGE MASTER 05360CSR M CHAINMGFILE 54 05370CSR 54 MOVE BLK35 MGTEXT 05380CSR 54 MOVELM MGTEXT 05390CSR 54 MOVE MES,3 MGTEXT 05400CSR MOVELMGTEXT A39,3 05410CSR ENDSR 05420C************************************************************** 05430CSR SR96 BEGSR 05440CSR # CHAINCRTFILE H9 05450CSR H9 GOTO ENDJOB 05460CSR ENDSR 05470C*************************************************************** 05480CSR SR97 BEGSR 05490CSR TIME CRTIME 05500CSR MOVELUDATE CRDATE 05510CSR SETON 97 05520CSR EXCPT UPDATE CRTFILE ÐÐ05530CSR SETOF 97 05540CSR ENDSR 05550C***************************************************************** 05560CSR SR98 BEGSR 05570CSR EXSR SR70 CLEAR CRT 05580CSR EXITFCHAIN >>>>>>>>>>>>>>>>> 05590CSR RLABL PROG 05600CSR ENDSR 05610C****************************************************************** 05620CSR SR101 BEGSR 05630C* 1-TIME INITIALIZE 05640CSR MOVE BIT,1 NUL 05650CSR EXSR SR66 INIT A39FER LGTH 05660CSR MOVE BIT,28 A39,1 05670CSR MOVE 'D' A39,2 05680CSR MOVE BIT,28 A39,38 05690CSR MOVE 'E' A39,39 BLINK CODE 05700CSR Z-ADD8 FLIMIT 30 TOTAL NUMB FIELDS 05710CSR MOVE ' ' BLK20 20 05720C* GET PORT # AND CRTFILE 05730CSR MOVE ' ' W2A 2 05740CSR EXITFZGMINX GET PORT # 05750CSR RLABL W2A 05760CSR MOVE W2A # 20 PORT NO. 05770CSR # COMP 0 54 ÐÐ05780CSRN54 Z-ADD25 # DEFAULT 05790CSR EXSR SR96 GET CRTFILE 05800CSR MOVE CALL LNK 05810CSR MOVEL'Q012WO 'PROG 05820CSR PAR,# COMP '1' 50 05830CSR TST,# COMP 'S' 54 05840CSR 54 MOVE 'SHUTDOWN'PROG 05850CSR EXSR SR97 UPDATE CRTFILE 05860CSR 54 EXSR SR98 >>>>>>>>>>>>>>>>> 05870CSR MOVE ' 'PROG 05880C* DEFINE WORK FIELDS,ETC. 05890CSR Z-ADDUDATE W6N 05900CSR EXSR SR207 GET CALENDAR 05910CSR Z-ADDW6N TODAY 60 05920CSR MOVE ' ' BLK35 35 05930CSR MOVE ' ' BLK8 8 05940CSR Z-ADD0 ZERO5 50 05950CSR Z-ADD0 ZERO7 70 05960CSR Z-ADD0 ZERO3 30 05970CSR Z-ADD0 ZERO6 60 05980CSR MOVE ' ' BLK15 15 05990CSR ENDSR 06000C********************************************************************** 06010CSR SR102 BEGSR 06020C* VALIDATE FIELD NO. ÐÐ06030CSR F COMP 0 54 06040CSRN54 Z-ADD1 F 06050CSR F COMP FLIMIT 55 06060CSR 55 Z-ADD1 F 06070CSR ENDSR 06080C******************************************************************** 06090CSR SR103 BEGSR 06100C* MOVE INPUT DATA 06110CSR EXSR SR201 IDENTIFY-F 06120CSR EXSR SR202 R. JUSTIFY 06130CSR 01 MOVELW20A TRAN 1 TRAN CODE 06140CSR 02 EXSR SR211 BUILD WO # 06150CSR 03 MOVE W10A TPN 100 PART # 06160CSR 04 MOVE W10A BOQTYR QTY REQD 06170CSR 05 MOVE W10A BODUE DATE DUE 06180CSR 06 MOVE W10A BONAPN NEXT ASSY 06190CSR 07 MOVE W10A BOQPA QTY PER ASSY 06200CSR 08 MOVELW20A BODEL DELIVER TO 06210CSR MOVE ' ' DUN,F EDIT FLAG 06220CSR ENDSR 06230C******************************************************************** 06240CSR SR104 BEGSR 06250C* EDIT INPUT DATA 06260CSR 01 EXSR SR1 06270CSR 02 EXSR SR2 ÐÐ06280CSR 03 EXSR SR3 06290CSR 04 EXSR SR4 06300CSR 05 EXSR SR5 06310CSR 06 70 EXSR SR6 06320CSR 96 MOVE ' ' DUN,F EDIT FLAG 06330CSRN96 MOVE 'X' DUN,F 06340CSR ENDSR 06350C*********************************************************************** 06360CSR SR105 BEGSR 06370C* FINAL EDIT 06380CSR SETOF 77 06390CSR SETON 79 FINAL EDIT FLAG 06400CSR Z-ADD1 F 96 06410C*-------------------------------------------------------------------- 06420CSR T105A TAG 06430CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06440CSRN54 GOTO END105 06450CSR EXSR SR201 IDENTIFY-F 06460CSR EXSR SR104 EDIT 06470CSRN96 GOTO T105A 06480C*-------------------------------------------------------------------- 06490CSR END105 TAG 06500CSR SETOF 79 06510CSR ENDSR 06520C******************************************************************** ÐÐ06530CSR SR106 BEGSR 06540C* UPDATE DATA BASE. 06550CSR EXSR SR203 CLASSIFY TRAN 06560CSR 60 GOTO T106A ADD TRAN 06570CSR 61 GOTO T106D CHANGE TRAN 06580CSR 62 GOTO T106F DELETE TRAN 06590C* FLAG BAD TRAN CODE 06600CSR Z-ADD300 M 96 FLAG ERROR 06610CSR Z-ADD1 F FIELD # 06620CSR GOTO END106 06630C*------------------------------------------------------------------- 06640CSR T106A TAG 06650C* ADD TRANSACTION 06660CSR 30 GOTO T106B NOT ON FILE 06670CSR 31 GOTO T106C DELETED RQMT 06680C* FLAG DUPLICATE ADD ERROR 06690CSR Z-ADD301 M 96 FLAG ERROR 06700CSR Z-ADD1 F FIELD # 06710CSR GOTO END106 06720C*--------------------------------------------------------------------- 06730CSR T106B TAG 06740C* ADD-- RQMT NOT ON FILE 06750CSR MOVE 'A' BOSTAT 06760CSR EXSR SR81 ADD NEW RQMT 06770CSR EXSR SR212 UPDATE PART MAST ÐÐ06780CSR EXSR SR208 ADD ALT KEYS 06790CSR GOTO END106 06800C*--------------------------------------------------------------------- 06810CSR T106C TAG 06820C* ADD-- RQMT IS DELETED 06830CSR MOVE 'A' BOSTAT RECORD STATUS 06840CSR EXSR SR82 REWRITE RQMT 06850CSR EXSR SR212 UPDATE PART MAST 06860CSR EXSR SR208 ADD ALT KEYS 06870CSR GOTO END106 06880C*---------------------------------------------------------------------- 06890CSR T106D TAG 06900C* CHANGE TRANSACTION. 06910CSRN30N31 GOTO T106E GOT IT 06920C* FLAG NO RQMT ERROR 06930CSR Z-ADD302 M 96 FLAG ERROR 06940CSR Z-ADD1 F FIELD # 06950CSR GOTO END106 06960C*----------------------------------------------------------------------- 06970CSR T106E TAG 06980C* REWRITE RQMT 06990CSR EXSR SR82 REWRITE RQMT 07000CSR EXSR SR212 UPDATE PART MAST 07010CSR EXSR SR209 DELETE ALT KEYS 07020CSR EXSR SR208 ADD ALT KEYS ÐÐ07030CSR GOTO END106 07040C*----------------------------------------------------------------------- 07050CSR T106F TAG 07060C* DELETE TRANSACTION 07070CSRN30N31 GOTO T106G GOT IT 07080C* FLAG NO RQMT ERROR 07090CSR Z-ADD302 M 96 FLAG ERROR 07100CSR Z-ADD1 F FIELD # 07110CSR GOTO END106 07120C*----------------------------------------------------------------------- 07130CSR T106G TAG 07140C* DELETE RQMT . 07150CSR MOVE 'D' BOSTAT RECORD STATUS 07160CSR EXSR SR82 REWRITE RQMT 07170CSR EXSR SR212 UPDATE PART MAST 07180CSR EXSR SR209 DELETE ALT KEYS 07190CSR END106 ENDSR 07200C************************************************************************ 07210CSR SR201 BEGSR 07220C* IDENTIFY FIELD NO. 07230CSR F COMP 1 01 07240CSR F COMP 2 02 07250CSR F COMP 3 03 07260CSR F COMP 4 04 07270CSR F COMP 5 05 ÐÐ07280CSR F COMP 6 06 07290CSR F COMP 7 07 07300CSR F COMP 8 08 07310CSR ENDSR 07320C********************************************************************** 07330CSR SR202 BEGSR 07340C* RIGHT JUSTIFY 07350CSR F LOKUPNUM 54 07360CSRN54 GOTO END202 NOT NUMERIC FIELD 07370CSR Z-ADD10 W2N 20 07380CSR MOVELW20A W10A 10 07390CSR EXIT SUBRAJ R. JUSTIFY 07400CSR RLABL W2N 07410CSR RLABL W10A 07420CSR END202 ENDSR 07430C*********************************************************************** 07440CSR SR203 BEGSR 07450C* CLASSIFY TRAN CODE 07460CSR TRAN COMP 'A' 60 ADD 07470CSR TRAN COMP 'C' 61 CHANGE 07480CSR TRAN COMP 'D' 62 DELETE 07490CSR MOVE ' ' TRNNAM 6 07500CSR 60 MOVEL'ADD' TRNNAM 07510CSR 61 MOVEL'CHANGE' TRNNAM 07520CSR 62 MOVEL'DELETE' TRNNAM ÐÐ07530CSR ENDSR 07540C******************************************************************** 07550CSR SR205 BEGSR 07560C* INIT BOMAST FIELDS. 07570CSR MOVE BLK20 BOWO 07580CSR MOVE ' ' BOWOP 07590CSR Z-ADD0 BOWOD 07600CSR Z-ADD0 BOQTYR 07610CSR Z-ADD0 BOQTYC 07620CSR Z-ADD0 BODUE 07630CSR Z-ADD0 BODLT 07640CSR Z-ADD0 BONAPN 07650CSR Z-ADD0 BOQPA 07660CSR MOVE BLK35 BODEL 07670CSR MOVE ' ' BOSTAT 07680CSR ENDSR 07690C******************************************************************** 07700CSR SR207 BEGSR 07710C* GET CALENDAR FILE BY CAL DATE 07720CSR MOVELW6N W2N 07730CSR W2N COMP 12 54 07740CSRN54 MOVELW6N W4N 40 07750CSRN54 MOVE W6N W2N 07760CSRN54 MOVELW2N W6N 07770CSRN54 MOVE W4N W6N ÐÐ07780CSR MOVE W6N W7A 7 07790CSR MOVEL'C' W7A 07800CSR W7A CHAINCALENDAR 60 07810CSR ENDSR 07820C****************************************************************** 07830CSR SR208 BEGSR 07840C* ADD ALT KEYS 07850CSR MOVE BODUE DUEDAT 6 07860CSR MOVE TPN PARTNO 10 07870CSR MOVE 'A' STAT 1 07880CSR EXSR SR210 ADD ALT KEYS 07890CSR ENDSR 07900C*************************************************************** 07910CSR SR209 BEGSR 07920C* DELETE ALT KEYS 07930CSR MOVE OLDDUE DUEDAT 07940CSR MOVE TPN PARTNO 07950CSR MOVE 'D' STAT 07960CSR EXSR SR210 DELETE ALT KEYS 07970CSR ENDSR 07980C*************************************************************** 07990CSR SR210 BEGSR 08000C* UPDATE ALT KEYS 08010CSR MOVE ' ' A29 08020CSR MOVEAPARTNO A29 ÐÐ08030CSR MOVEADUEDAT A29,11 08040CSR MOVEA'70' A29,17 08050CSR MOVEATWO A29,19 08060CSR MOVEA'00' A29,28 08070CSR MOVEAA29 W29A 29 08080CSR W29A CHAINALTPN 60 08090CSR SETON 40 08100CSR EXCPT UPDATE ALTPN 08110CSR SETOF 40 08120CSR MOVE ' ' A29 08130CSR MOVEA'70' A29,1 08140CSR MOVEADUEDAT A29,3 08150CSR MOVEATWO A29,9 08160CSR MOVEA'00' A29,18 08170CSR MOVE TPN W10A 10 08180CSR MOVEAW10A A29,20 08190CSR MOVEAA29 W29A 08200CSR W29A CHAINALTDUE 60 08210CSR SETON 41 08220CSR EXCPT UPDATE ALTDUE 08230CSR SETOF 41 08240CSR ENDSR 08250C******************************************************************** 08260CSR SR211 BEGSR 08270C* BUILD WORK ORDER. ÐÐ08280CSR MOVEAW20A A20 08290CSR Z-ADD1 W 08300CSR '-' LOKUPA20,W 54 08310CSRN54 Z-ADD7 W 08320CSR MOVEAA20,W W4A 4 08330CSR 54 MOVEL' ' W4A 08340CSR Z-ADD4 W2N 08350CSR EXIT SUBRAJ RJ 08360CSR RLABL W2N 08370CSR RLABL W4A 08380CSR MOVE W4A TWOD 30 WORK ORDER DASH 08390CSR MOVEABLK20 A20,W 08400CSR A20,1 COMP '0' 54 54 08410CSR 54 MOVEAA20,1 W5A 5 08420CSR 54 MOVEL' ' TWOP 6 WORK ORDER PRIME 08430CSRN54 MOVEAA20,1 TWOP 08440CSRN54 MOVE TWOP W5A 08450CSR Z-ADD5 W2N 08460CSR EXIT SUBRAJ RJ 08470CSR RLABL W2N 08480CSR RLABL W5A 08490CSR MOVE W5A TWOP 08500CSR MOVELTWOP TWO 9 WORK ORDER PRIM/DASH 08510CSR MOVE TWOD TWO 08520CSR MOVE TWO BOWO ÐÐ08530CSR MOVE TWOP BOWOP 08540CSR Z-ADDTWOD BOWOD 08550CSR MOVELTWOP PREFIX 1 08560CSR PREFIX LOKUPTABPWO TABWON 70 FLAG PROD WO. 08570CSR ENDSR 08580C******************************************************************** 08590CSR SR212 BEGSR 08600C* UPDATE PART MAST REQMT TOTALS 08610CSRN70 GOTO END212 NOT INV ITEM 08620CSR MOVELTPN W12A 08630CSR EXSR SR83 GET PART MASTER 08640CSR EXSR SR203 CLASSIFY TRAN 08650CSR BOQTYR SUB BOQTYC W7N 70 54 08660CSRN54 Z-ADD0 W7N 08670CSR 60 ADD/REL 08680COR 61 W7N ADD PMRLB PMRLB CHG/REL 08690CSR 61 CHG/REL 08700COR 62 PMRLB SUB OLDQTY PMRLB DEL/REL 08710CSR EXSR SR84 UPDATE PART MAST 08720CSR END212 ENDSR 08730C******************************************************************** 08740CSR SR213 BEGSR 08750C* DISPLAY SPECIFIED FIELD. 08760CSR Z-ADDF SAVEF 30 08770CSR Z-ADDW3N F ÐÐ08780CSR EXSR SR201 IDENTIFY-F 08790CSR EXSR SR72 DISPLAY 08800CSR Z-ADDSAVEF F 08810CSR EXSR SR201 RE-ID-F 08820CSR ENDSR 08830C******************************************************************** 08840OTERM132 E 71 08850O BIT,28 1 08860O N50 8 '8091001' 08870O N50 BIT,1 9 08880O N50 BIT,1 10 08890O 50 10 '[001 ]001' 08900O 50 BIT,28 6 08910O 84 'BACKORDER ADD, CHANG' 08920O 93 'E, DELETE' 08930O UDATE Y 18 08940O*------------------------------------------------------------------- 08950O E 71 08960O 1 ' ' 08970O*------------------------------------------------------------------- 08980O E 71 08990O OR 72 01 09000O DOT 33 09010O 23 '(1) TRAN-CODE (A,D,C)' 09020O TRAN 36 ÐÐ09030O TRNNAM 53 09040O A39 132 09050O*------------------------------------------------------------------- 09060O E 71 09070O OR 72 02 09080O DOT 33 09090O 16 '(2) WORK-ORDER' 09100O TWOP 41 09110O 56 42 '-' 09120O 56 TWOD 45 09130O WOPN 58 ' - - ' 09140O WODESC 93 09150O WMODL 106 09160O A39 132 09170O*------------------------------------------------------------------- 09180O E 71 09190O OR 72 02 09200O WODESC 93 09210O WOMODL 106 09220O*------------------------------------------------------------------- 09230O E 71 09240O OR 72 03 09250O DOT 33 09260O 17 '(3) PART-NUMBER' 09270O TPN 47 ' - - ' ÐÐ09280O CDESC 78 09290O 85 'STOCK=' 09300O STKBALK 95 09310O A39 132 09320O*------------------------------------------------------------------- 09330O E 71 09340O OR 72 04 09350O DOT 33 09360O 18 '(4) QTY-REQUIRED' 09370O BOQTYR2 44 09380O A39 132 09390O*------------------------------------------------------------------- 09400O E 71 09410O 33 ':' 09420O 21 'QUANTITY ISSUED' 09430O BOQTYC2 44 09440O*------------------------------------------------------------------- 09450O E 71 09460O OR 72 05 09470O DOT 33 09480O 4 '(5)' 09490O 14 'DUE DATE' 09500O BODUE 43 ' - - ' 09510O A39 132 09520O*----------------------------------------------------------------- ÐÐ09530O E 71 09540O OR 72 06 09550O DOT 33 09560O 4 '(6)' 09570O 24 'NEXT ASSY PART NO.' 09580O BONAPN 47 ' - - ' 09590O ASYDES 79 09600O A39 132 09610O*------------------------------------------------------------------- 09620O E 71 09630O OR 72 07 09640O DOT 33 09650O 4 '(7)' 09660O 18 'QTY PER ASSY' 09670O BOQPA 2 44 09680O A39 132 09690O*------------------------------------------------------------------- 09700O E 71 09710O OR 72 08 09720O DOT 33 09730O 16 '(8) DELIVER TO' 09740O BODEL 50 09750O******************************************************************** 09760OBOMAST EADD 81 09770O W19A 19 ÐÐ09780O BOQTYR 25P 09790O BOQTYC 29P 09800O BODUE 35 09810O TODAY 41 09820O BODEL 56 09830O BONAPN 66 09840O BOQPA 70P 09850O 80 'A' 09860O*----------------------------------------------------------------- 09870O E 82 09880O BOQTYR 25P 09890O BOQTYC 29P 09900O BODUE 35 09910O TODAY 41 09920O BODEL 56 09930O BONAPN 66 09940O BOQPA 70P 09950O BOSTAT 80 09960O********************************************************************* 09970OALTPN EADD 40 60 09980O W29A 29 09990O STAT 32 10000O*------------------------------------------------------------------- 10010O E 40N60 10020O STAT 32 ÐÐ10030O********************************************************************* 10040OALTDUE EADD 41 60 10050O W29A 29 10060O STAT 32 10070O*--------------------------------------------------------------------- 10080O E 41N60 10090O STAT 32 10100O********************************************************************** 10110OPMMST2 E 84 10120O PMNOBM 14P 10130O PLT 128P 10140O PMOHB 314P 10150O PMALB 322P 10160O PMRLB 326P 10170O************************************************************** 10180OCRTFILE E 97 10190O PROG 26 10200O CRTIME 33 10210O CRDATE 37 10220O LNK 79 10230O*************************************************************** ** NUL ARRAY 010240 010250** A20 ARRAY 010260 010270ÐÐ** NUM ARRAY 010280003 PART # 010290004 QTY 10300005 DUE 10310006 NEXT ASSY 10320007 QTY PER 10330** DUN ARRAY 010340 010350** MES ARRAY 010360---MESSAGE NOT ON FILE--- 010370** DOT ARRAY 10380 - - - - - - - - - - - --> 10390** A29 ARRAY 010400 10410** AR ARRAY 10420 10430** TABISS/TABICN - ISSUE CODES 10440PTPULL TIME 10450ORON REQUEST 10460BIBULK ISSUE 10470ARAS REQD 10480VSVENDOR SUPPLIED 10490SDSHIP DOCUMENT 10500TDTRAV DOCUMENT 10510RDREF DOC ONLY 10520ÐÐRAREF ASSY 10530** A39 ARRAY 10540 10550** LNK 10560 10570/* 10580_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¼k¡ ¼$X006WO P999999120282(èÈÐ00010H Q006WO00020F* DISPLAY WOMAST FILE- PART NO. SEQ. (X006WO) 00030F* REVISED 10-20-82 2:35 PM. 132-1 00040FBITPAR IP F 90 DISK 00050FWOMAST IC F 228R 9AI 1 DISK 00060FALTPN ID F 32L29AI 1 DISK 00070FCRTFILE UC F 256R DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FPRODWO IT F 80 EDISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E PRODWO TABPRX 1 4 1 TABPD 35 WORK ORDER PREFIXES 00130E NUL 1 132 1 NULL CHAR 00140E A20 20 20 1 A INPUT DATA ARRAY 00150E DOT 32 32 1 00160E LNK 1 7 6 A 00170E CALL 7 6 00180E BIT 33 1 SCREEN CONTR. CHAR 00190E PAR 25 1 00200E TST 25 1 00210E PLT 8 3 0 00220I******************************************************************* 00230IBITPAR BT 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I 34 58 PAR 00280I****************************************************************** 00290ICRTFILE CR 00300I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00310I* EMPLOYEE # 5N 00320I 1 50CREMPL 00330I* USER CODE 8A 00340I 6 13 CRUSER 00350I* DEPT # 5N 00360I 14 180CRDEPT 00370I* JOB NAME 8A (JOB LOADED BY MENU) 00380I 19 26 CRJOB 00390I* SHUTDOWN FLAG 1A 00400I* BLANK = NO SHUTDOWN 00410I 27 27 CRSHUT 00420I* TIME STARTED 6N 00430I 28 330CRTIME 00440I* DATE STARTED 4N 00450I 34 370CRDATE 00460I* CALL STACK 7 X 6A 00470I 38 79 CALL 00480I******************************************************************** 00490IWOMAST WO 00500I* WORK ORDER MASTER. ÐÐ00510I* WORK ORDER NO. 00520I 1 9 WOWO 00530I* PRIME 6A 00540I 1 1 PREFIX 00550I 1 6 WOWOP 00560I* DASH 3N 00570I 7 90WOWOD 00580I* PART NO. 10N 00590I 10 190WOPN 00600I* TOP ASSY PN 10N 00610I 20 290WOTAPN 00620I* RUN NO. 3N 00630I 30 320WORUN 00640I* PROD LINE 4N 00650I 33 360WOPL 00660I* SCHED QTY 7P 00670I P 37 400WOQTYS 00680I* FILLER 4A 41 44 FFFFFF 00690I* COMPLETED QTY 7P 00700I P 45 480WOQTYC 00710I* START DATE 6N (YMD) 00720I 49 540WOSTRT 00730I* DUE DATE 6N (YMD) 00740I 55 600WODUE 00750I* DATE ENTERED 6N (YMD) ÐÐ00760I 61 660WODATE 00770I* DATE LAST REL 6N (YMD) 00780I 67 720WODLTR 00790I* DATE LAST COMPLETION 6N (YMD) 00800I 73 780WODLTC 00810I* DATE LAST LABOR 6N (YMD) 00820I 79 840WODLTL 00830I* DATE LAST MATL CHARGE 6N (YMD) 00840I 85 900WODLTM 00850I* LABOR HRS CHARGED 7.1P 00860I P 91 941WOLABH 00870I* LABOR $ CHARGED 9.3P 00880I P 95 993WOLAB$ 00890I* MATL $ CHARGED 9.3P 00900I P 100 1043WOMAT$ 00910I* QTY TRSF 7P 00920I P 105 1080WOQTYT 00930I* AMOUNT TRANSFERRED 9.3P 00940I P 109 1133WO$T 00950I* REMARKS 35A 00960I 114 148 WODESC 00970I* MODEL NO. 12A 00980I 149 160 WOMODL 00990I* FAB CODE 2A 01000I 161 162 WOFAB ÐÐ01010I* ALTERNATE BILL OF MATERIAL PART NO. 10N 01020I 163 1720WOABM 01030I* ALTERNATE ROUTING PART NO. 10N 01040I 173 1820WOARPN 01050I* DATE CLOSED 6N (YMD) 01060I 183 1880WOCLOS 01070I* BUDGET/STANDARD 01080I* LABOR HRS 7P 01090I P 189 1920WOBLHR 01100I* LABOR $ 9.3P 01110I P 193 1973WOBL$ 01120I* MATERIAL $ 11.3P 01130I P 198 2033WOBM$ 01140I* LABOR BURDEN CHARGED 9.3P 01150I P 204 2083WOBUR$ 01160I* LABOR BURDEN BUDGET 9.3P 01170I P 209 2133WOLB$ 01180I* RECORD STATUS 1A 01190I 228 228 WOSTAT 01200I******************************************************************* 01210IALTPN AP 01220I* ALTERNATE KEY - PART NO. 01230I 1 29 APKEY 01240I* PART NO. 10N 01250I 1 100APPN ÐÐ01260I* DUE DATE 6N 01270I* 11 160APDUE 01280I* RECORD CODE 2A 01290I 17 18 APREC 01300I* ORDER NO. 11A 01310I 19 29 APORD 01320I* RECORD STAT 1A 01330I 32 32 APSTAT 01340I********************************************************************* 01350IPMMST2 PM 01360I* PART MASTER 01370I* MODEL NO. 12A 01380I 19 30 PMMODL 01390I* DESCRIPTION 29A 01400I 31 59 PMDESC 01410I* LEAD TIME 8 X 3P 01420I P 113 128 PLT 01430I 674 674 PMSTAT 01440C******************************************************************** 01450C* 1-TIME INIT 01460C EXSR SR101 INIT 01470C MOVE ' ' BLK6 6 01480C EXSR SR70 NEW PAGE 01490C N50 MOVEL'091' RPGLIN 4 01500C 50 MOVE '001' RPGLIN ÐÐ01510C MOVEL'001' RPGCOL 4 01520C EXSR SR69 MOVE CURSOR 01530C*------------------------------------------------------------- 01540C START TAG 01550C* REQUEST WORK ORDER 01560C EXSR SR68 LF 01570C SETON 72 01580C EXCPT PROMPT 01590C SETOF 72 01600C EXSR SR75 READ CRT 01610C*-------------------------------------------------------------- 01620C TAG5 TAG 01630C* SET-UP 1ST DISPLAY 01640C Z-ADD10 W2N 20 01650C MOVELW20A W10A 10 01660C EXIT SUBRAJ RJ 01670C RLABL W2N 01680C RLABL W10A 01690C MOVE BLK35 W29A 29 01700C MOVELW10A W29A 29 01710C MOVE BLK35 LSTKEY 29 01720C W29A SETLLALTPN 01730C EXSR SR70 NEW PAGE 01740C Z-ADD0 LASTPN 42 01750C Z-ADD0 COUNT 30 ÐÐ01760C*--------------------------------------------------------------- 01770C TAG10 TAG 01780C SETOF 54 01790C READ ALTPN 54 GET WORK ORDER 01800C 54 GOTO TAG200 END FILE 01810C APKEY COMP LSTKEY 54 01820C N54 GOTO TAG200 END FILE(WRAPAROUND)01830C MOVE APKEY LSTKEY 01840C APPN COMP LASTPN 54 01850C 54 GOTO TAG20 NOT NEW PART NO. 01860C LASTPN COMP 0 54 01870C N54 Z-ADDAPPN LASTPN 01880C N54 GOTO TAG20 1ST PART NO. 01890C N42 SETON 74 01900C N42 EXCPT NO WO ON FILE MSG 01910C SETOF 7442 01920C Z-ADDAPPN LASTPN 100 01930C 2 ADD COUNT COUNT 01940C COUNT COMP 26 54 54 01950C N54 GOTO TAG20 01960C SETON 76 END PAGE MSG 01970C EXCPT 01980C SETOF 76 01990C EXSR SR75 READ 02000C 77 GOTO TAG5 ÐÐ02010C Z-ADD0 COUNT 30 02020C EXSR SR70 NEW PAGE 02030C*----------------------------------------------------------------- 02040C TAG20 TAG 02050C APREC COMP '20' 55 02060C N55 GOTO TAG10 NOT WORK ORDER 02070C APSTAT COMP 'D' 54 02080C 54 GOTO TAG10 DELETED 02090C MOVELAPORD W9A 9 02100C W9A CHAINWOMAST 60 02110C N60 WOSTAT COMP 'D' 60 02120C 60 GOTO TAG10 02130C EXSR SR301 CLASSIFY WO PREFIX 02140C 40 EXSR SR302 EDIT PART NO. 02150C 40 EXSR SR303 EDIT TOP ASSY 02160C 40 EXSR SR304 EDIT ALT PN 02170C WOWOD COMP 0 55 02180C EXSR SR71 PUT DATA 02190C*------------------------------------------------------------------ 02200C TAG100 TAG 02210C EXSR SR75 READ CRT 02220C N77 EXSR SR70 NEW PAGE 02230C N77 GOTO TAG10 GET NEXT WO 02240C GOTO TAG5 SET-UP NEW WO 02250C*----------------------------------------------------------------- ÐÐ02260C TAG200 TAG 02270C* END FILE MESSAGE 02280C SETON 73 02290C EXCPT END FILE MSG 02300C SETOF 73 02310C GOTO TAG100 02320C*------------------------------------------------------------------ 02330C NEWITM TAG 02340C* SET-UP LINK FOR NEW ITEM 02350C MOVEL'Q006WO' PROG 8 02360C GOTO END 02370C*------------------------------------------------------------------- 02380C MENU TAG 02390C* SET-UP LINK TO MENU 02400C EXSR SR96 GET CRTFILE 02410C Z-ADD1 W 02420C BLK6 LOKUPLNK,W 54 02430C 54 MOVELLNK,W PROG 02440C 54 MOVE BLK6 LNK,W 02450C N54 MOVEL'CONTU' PROG 02460C EXSR SR97 UPD CRTFILE 02470C EXSR SR98 >>>>>>>>>> 02480C*-------------------------------------------------------------------- 02490C GOODBY TAG 02500C* LINK TO SIGN-OFF ÐÐ02510C MOVEL'GOODBY' PROG 02520C GOTO END 02530C*------------------------------------------------------------------- 02540C END TAG 02550C EXSR SR96 GET CRTFILE 02560C EXSR SR97 UPD CRTFILE 02570C EXSR SR98 >>>>>>>>>> 02580C*------------------------------------------------------------------- 02590C ENDJOB TAG 02600C MOVEL'ENDJOB 'PROG 02610C EXSR SR98 >>>>>>>>>> 02620C***************************************************************** 02630CSR SR67 BEGSR 02640CSR EXITFQBELL RING BELL 02650CSR ENDSR 02660C******************************************************************** 02670CSR SR68 BEGSR 02680CSR EXITFZLF LINE FEED 02690CSR ENDSR 02700C**************************************************************** 02710CSR SR69 BEGSR 02720CSRN50 EXITFZMOVXY MOVE CURSOR 02730CSR RLABL RPGLIN 02740CSR RLABL RPGCOL 02750CSR 50 EXITFZPUTXY ÐÐ02760CSR RLABL RPGLIN 02770CSR RLABL RPGCOL 02780CSR ENDSR 02790C***************************************************************** 02800CSR SR70 BEGSR 02810C* CLEAR TERM SCREEN. 02820CSR 50 EXITFZESCH CLEAR SCREEN 02830CSRN50 EXITFZCPAGE CLEAR SCREEN 02840CSR ENDSR 02850C********************************************************************** 02860CSR SR71 BEGSR 02870C* PUT HEADINGS TO TERMINAL 02880CSR SETON 717642 02890CSR EXCPT PUT HEADINGS 02900CSR SETOF 7176 02910CSR ENDSR 02920C********************************************************************* 02930CSR SR72 BEGSR 02940C* PUT DATA TO TERMINAL 02950CSR SETON 72 02960CSR EXCPT PUT DATA 02970CSR SETOF 72 02980CSR ENDSR 02990C******************************************************************* 03000CSR SR75 BEGSR ÐÐ03010C* READ FROM TERMINAL 03020CSR SETOF 779096 03030CSR SETOF 93 03040CSR MOVE BLK20 W20A 20 BUFFER 03050CSR EXITFZR20 READ FROM TERMINAL 03060CSR RLABL W20A READ BUFFER 03070CSR MOVEAW20A A20 INPUT DATA ARRAY 03080CSR MOVE BLK20 W20A INIT INPUT ARRAY 03090CSR Z-ADD1 W 30 03100CSR '\' LOKUPA20,W 90 FLAG ESC 03110CSRN90 GOTO T75B NOT ESC 03120CSR 1 ADD W W 03130CSR W COMP 20 54 03140CSR 54 GOTO T75A BAD ESC 03150CSR A20,W COMP 'G' 98 GOODBY 03160CSR A20,W COMP 'E' 94 MENU 03170CSR A20,W COMP 'N' 93 NEW ITEM 03180CSRN93 A20,W COMP 'D' 93 03190CSRN93 A20,W COMP 'B' 93 03200CSR 98 GOTO GOODBY 03210CSR 94 GOTO MENU 03220CSR 93 GOTO NEWITM 03230C*------------------------------------------------------------------ 03240CSR T75A TAG 03250C* BAD ESC INPUT DEFAULT. ÐÐ03260CSR GOTO SR75 03270C*-------------------------------------------------------------------- 03280CSR T75B TAG 03290C* MOVE DATA 03300CSR Z-ADD1 W 03310CSR ' ' LOKUPA20,W 77 03320CSR 77 MOVEAA20,W W20A INPUT DATA 03330CSR END75 ENDSR 03340C********************************************************************* 03350CSR SR83 BEGSR 03360C* GET PART MAST. 03370CSR MOVE ' ' W12A 03380CSR W12A CHAINPMMST2 60 03390CSRN60 PMSTAT COMP 'D' 60 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR96 BEGSR 03430CSR # CHAINCRTFILE H9 GET CRTFILE 03440CSR H9 GOTO ENDJOB 03450CSR ENDSR 03460C******************************************************************** 03470CSR SR97 BEGSR 03480C* UPDATE CRTFILE. EXIT PROGRAM. 03490CSR TIME CRTIME 03500CSR MOVELUDATE CRDATE ÐÐ03510CSR SETON 97 03520CSR EXCPT UPD CRTFILE 03530CSR SETOF 97 03540CSR ENDSR 03550C******************************************************************** 03560CSR SR98 BEGSR 03570CSR EXSR SR70 CLEAR SCREEN 03580CSR EXITFCHAIN >>>>>>>>>> 03590CSR RLABL PROG 03600CSR ENDSR 03610C******************************************************************** 03620CSR SR101 BEGSR 03630C* 1-TIME INITIALIZE 03640CSR MOVE BIT,1 NUL 03650CSR MOVE ' ' BLK20 20 03660C* GET PORT # AND CRTFILE 03670CSR MOVE ' ' W2A 2 03680CSR EXITFZGMINX GET PORT # 03690CSR RLABL W2A 03700CSR MOVE W2A # 20 PORT NO. 03710CSR # COMP 0 54 03720CSRN54 Z-ADD25 # DEFAULT 03730CSR EXSR SR96 03740CSR MOVE CALL LNK 03750CSR MOVE 'Q006WO 'PROG ÐÐ03760CSR PAR,# COMP '1' 50 03770CSR TST,# COMP 'S' 54 03780CSR 54 MOVE 'SHUTDOWN'PROG 03790CSR EXSR SR97 UPD CRTFILE 03800CSR 54 EXSR SR98 >>>>>>>>>> 03810CSR MOVE BLK20 PROG 03820C* DEFINE WORK FIELDS,ETC. 03830CSR MOVELUDATE W4N 40 03840CSR MOVE UDATE W2N 03850CSR MOVELW2N TODAY 60 03860CSR MOVE W4N TODAY 03870CSR MOVE ' ' BLK35 35 03880CSR MOVE ' ' BLK6 6 03890CSR ENDSR 03900C******************************************************************** 03910CSR SR301 BEGSR 03920C* CLASSIFY WO-PREFIX (40=INVENTORY ITEM). 03930CSR PREFIX LOKUPTABPRX TABPD 40 03940CSR 40 MOVELTABPD WOTYPE 36 03950CSRN40 MOVE BLK35 WOTYPE 03960CSRN40 MOVELBLK35 WOTYPE 03970CSR ENDSR 03980C******************************************************************** 03990CSR SR302 BEGSR 04000C* GET WORK ORDER PART MASTER. ÐÐ04010CSR MOVE BLK35 DESCWO 04020CSR MOVE BLK35 MODLWO 04030CSRN40 GOTO END302 04040CSR WOPN COMP 0 55 04050CSRN55 GOTO END302 04060CSR MOVELWOPN W12A 12 04070CSR EXSR SR83 GET PART MASTER 04080CSR 60 GOTO END302 04090CSR MOVE PMDESC DESCWO 29 SAVE DESCRIPTION 04100CSR MOVE PMMODL MODLWO 12 SAVE MODEL NO. 04110CSR XFOOTPLT LEAD 40 04120CSR END302 ENDSR 04130C******************************************************************** 04140CSR SR303 BEGSR 04150C* GET TOP ASSY PART MASTER. 04160CSR MOVE BLK35 TADESC 04170CSR MOVE BLK35 TAMODL 04180CSRN40 GOTO END303 NOT INVENTORY ITEM 04190CSR WOTAPN COMP 0 54 04200CSRN54 GOTO END303 NOT INPUT 04210CSR MOVELWOTAPN W12A 04220CSR EXSR SR83 GET PART MASTER 04230CSRN60 MOVE PMDESC TADESC 29 04240CSRN60 MOVE PMMODL TAMODL 12 04250CSR END303 ENDSR ÐÐ04260C******************************************************************** 04270CSR SR304 BEGSR 04280CSR MOVE BLK35 ABMDES 04290CSR MOVE BLK35 ARPDES 04300C* GET ALT BM PART MASTER. 04310CSR WOABM COMP 0 54 04320CSRN54 GOTO T304C 04330CSR MOVELWOABM W12A 04340CSR EXSR SR83 GET PART MAST 04350CSRN60 MOVE PMDESC ABMDES 29 04360C*------------------------------------------------------------------- 04370CSR T304C TAG 04380C* GET ALT ROUTING PART MASTER. 04390CSR WOARPN COMP 0 54 04400CSRN54 GOTO END304 04410CSR MOVELWOARPN W12A 04420CSR EXSR SR83 GET PART MAST 04430CSRN60 MOVE PMDESC ARPDES 29 04440CSR END304 ENDSR 04450O******************************************************************** 04460OTERM132 E 71 04470O BIT,28 1 04480O N50 8 '8091001' 04490O N50 BIT,1 9 04500O N50 BIT,1 10 ÐÐ04510O 50 10 '[001 ]001' 04520O 50 BIT,28 6 04530O UDATE 18 ' - - ' 04540O 50 'W O R K' 04550O 62 'O R D E R' 04560O 78 'D I S P L A Y' 04570O 102 ' - PART NO. SEQUENCE ' 04580O*------------------------------------------------------------------- 04590O E 71 04600O 115 'E R R O R S' 04610O*------------------------------------------------------------------- 04620O E 71 04630O 23 ' WORK ORDER PRIME/' 04640O 27 'DASH' 04650O WOWOP 40 04660O 55 41 '-' 04670O 55 WOWOD 44 04680O WOTYPE 83 04690O*------------------------------------------------------------------- 04700O E 71 04710O 14 ' PART NO.' 04720O WOPN 46 ' - - ' 04730O DESCWO 77 04740O 84 'MODEL:' 04750O MODLWO 97 ÐÐ04760O*------------------------------------------------------------------- 04770O E 71 04780O 23 ' TOP ASSY PART NO.' 04790O 84 'MODEL:' 04800O WOTAPN 46 ' - - ' 04810O TADESC 77 04820O TAMODL 97 04830O*----------------------------------------------------------------- 04840O E 71 04850O 22 ' TOP ASSY RUN NO.' 04860O WORUN Z 36 04870O*----------------------------------------------------------------- 04880O E 71 04890O 25 ' QUANTITY SCHEDULED ' 04900O WOQTYS2 43 04910O*---------------------------------------------------------------- 04920O E 71 04930O 14 ' DUE DATE' 04940O WODUE 42 ' - - ' 04950O*------------------------------------------------------------------- 04960O E 71 04970O 16 ' START DATE' 04980O WOSTRT 42 ' - - ' 04990O*--------------------------------------------------------------------- 05000O E 71 ÐÐ05010O 13 ' REMARKS' 05020O WODESC 69 05030O*----------------------------------------------------------------- 05040O E 71 05050O 15 ' MODEL NO.' 05060O WOMODL 46 05070O*----------------------------------------------------------------- 05080O E 71 05090O 20 ' ALTERNATE BILL' 05100O 29 'MATERIAL' 05110O WOABM 46 ' - - ' 05120O ABMDES 77 05130O*-------------------------------------------------------------------- 05140O E 71 05150O 24 ' ALTERNATE ROUTING ' 05160O WOARPN 46 ' - - ' 05170O ARPDES 77 05180O*------------------------------------------------------------------- 05190O E 71 05200O 28 'LABOR-HRS' 05210O 49 'LABOR-$' 05220O 72 'MATERIAL-$' 05230O 93 'BURDEN-$' 05240O*------------------------------------------------------------------- 05250O E 71 ÐÐ05260O 12 'B U D G E T:' 05270O WOBLHRK 28 05280O WOBL$ K 49 05290O WOBM$ K 72 05300O WOLB$ K 93 05310O*------------------------------------------------------------------- 05320O E 71 05330O 12 'A C T U A L:' 05340O WOLABHK 28 05350O WOLAB$K 49 05360O WOMAT$K 72 05370O WOBUR$K 96 05380O*------------------------------------------------------------------- 05390O E 71 05400O 18 'QUANTITY COMPLETED' 05410O 32 ':' 05420O WOQTYC2 43 05430O 85 'DATE ENTERED' 05440O 98 ':' 05450O WODATE 108 ' - - ' 05460O*----------------------------------------------------------------- 05470O E 71 05480O 11 'DATE CLOSED' 05490O 32 ':' 05500O WOCLOS 42 ' - - ' ÐÐ05510O 90 'DATE RELEASED ' 05520O 98 ':' 05530O WODLTR 108 ' - - ' 05540O*------------------------------------------------------------------- 05550O E 71 05560O 20 'DATE LAST COMPLETION' 05570O 32 ':' 05580O WODLTC 42 ' - - ' 05590O 88 'DATE LAST LABOR' 05600O 98 ':' 05610O WODLTL 108 ' - - ' 05620O*------------------------------------------------------------------- 05630O E 71 05640O 21 'DATE LAST STOCK ISSUE' 05650O 32 ':' 05660O WODLTM 42 ' - - ' 05670O*----------------------------------------------------------------- 05680O E 71 05690O 13 'PRODUCT CLASS' 05700O 32 ':' 05710O WOPL Z 38 05720O 81 'FAB CODE' 05730O 98 ':' 05740O WOFAB 102 05750O*----------------------------------------------------------------- ÐÐ05760O E 76 05770O NUL 132 05780O BIT,11 2 05790O BIT,14 3 05800O 27 'ENTER RETURN, NEW PART #' 05810O 51 ', OR \ESC CODE..........' 05820O*----------------------------------------------------------------- 05830O E 73 05840O OR 72 05850O NUL 132 05860O BIT,11 1 05870O 72 24 'ENTER PART NUMBER.......' 05880O 73 24 'END OF FILE.............' 05890O*--------------------------------------------------------------- 05900O E 74 05910O 1 ' ' 05920O*------------------------------------------------------------------- 05930O E 74 05940O LASTPN B 12 ' - - ' 05950O 38 'NO WORK ORDERS ON FILE ' 05960O***************************************************************** 05970OCRTFILE E 97 05980O PROG 26 05990O CRTIME 33 06000O CRDATE 37 ÐÐ06010O LNK 79 06020O********************************************************************** ** NUL ARRAY 006030 006040** A20 ARRAY 006050 006060** DOT ARRAY 06070 - - - - - - - - - - - -> 06080** LNK ARRAY 06090 06100/* 06110_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼lÆ ¼$X005WO P999999120282(èÈÐ00010H Q005WO00020F* DISPLAY WOMAST FILE - START DATE SEQ. (X005WO) 00030F* REVISED 10-20-82 4:00 PM. 00040FBITPAR IP F 90 DISK 00050FWOMAST IC F 228R 9AI 1 DISK 00060FALTSTARTID F 16L15AI 1 DISK 00070FCRTFILE UC F 256R DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FPRODWO IT F 80 EDISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E PRODWO TABPRX 1 4 1 TABPD 35 WORK ORDER PREFIXES 00130E NUL 1 132 1 NULL CHAR 00140E A20 20 20 1 A INPUT DATA ARRAY 00150E DOT 32 32 1 00160E LNK 1 7 6 A 00170E CALL 7 6 00180E TST 25 1 00190E BIT 33 1 00200E PAR 25 1 00210E PLT 8 3 0 00220I******************************************************************** 00230IBITPAR BT 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I******************************************************************** 00280ICRTFILE CR 00290I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PART # (PORT=RRN) 00300I* EMPLOYEE # 5N 00310I 1 50CREMPL 00320I* USER CODE 8A 00330I 6 13 CRUSER 00340I* DEPT # 5N 00350I 14 180CRDEPT 00360I* JOB NAME 8A (JOB LOADED BY MENU) 00370I 19 26 CRJOB 00380I* SHUTDOWN FLAG 1A 00390I* BLANK = NO SHUTDOWN 00400I 27 27 CRSHUT 00410I* TIME STARTED 6N 00420I 28 330CRTIME 00430I* DATE STARTED 4N 00440I 34 370CRDATE 00450I* CALL STACK 7 X 6A 00460I 38 79 CALL 00470I******************************************************************** 00480IWOMAST WO 00490I* WORK ORDER MASTER. 00500I* WORK ORDER NO. ÐÐ00510I 1 9 WOWO 00520I* PRIME 6A 00530I 1 1 PREFIX 00540I 1 6 WOWOP 00550I* DASH 3N 00560I 7 90WOWOD 00570I* PART NO. 10N 00580I 10 190WOPN 00590I* TOP ASSY PN 10N 00600I 20 290WOTAPN 00610I* RUN NO. 3N 00620I 30 320WORUN 00630I* PROD LINE 4N 00640I 33 360WOPL 00650I* SCHED QTY 7P 00660I P 37 400WOQTYS 00670I* FILLER 4A 41 44 FFFFFF 00680I* COMPLETED QTY 7P 00690I P 45 480WOQTYC 00700I* START DATE 6N (YMD) 00710I 49 540WOSTRT 00720I* DUE DATE 6N (YMD) 00730I 55 600WODUE 00740I* DATE ENTERED 6N (YMD) 00750I 61 660WODATE ÐÐ00760I* DATE LAST REL 6N (YMD) 00770I 67 720WODLTR 00780I* DATE LAST COMPLETION 6N (YMD) 00790I 73 780WODLTC 00800I* DATE LAST LABOR 6N (YMD) 00810I 79 840WODLTL 00820I* DATE LAST MATL CHARGE 6N (YMD) 00830I 85 900WODLTM 00840I* LABOR HRS CHARGED 7.1P 00850I P 91 941WOLABH 00860I* LABOR $ CHARGED 9.3P 00870I P 95 993WOLAB$ 00880I* MATL $ CHARGED 9.3P 00890I P 100 1043WOMAT$ 00900I* QTY TRSF 7P 00910I P 105 1080WOQTYT 00920I* AMOUNT TRANSFERRED 9.3P 00930I P 109 1133WO$T 00940I* REMARKS 35A 00950I 114 148 WODESC 00960I* MODEL 12A 00970I 149 160 WOMODL 00980I* FAB CODE 2A 00990I 161 162 WOFAB 01000I* ALTERNATE BILL OF MATERIAL PART NO. 10N ÐÐ01010I 163 1720WOABM 01020I* ALTERNATE ROUTING PART NO. 10N 01030I 173 1820WOARPN 01040I* DATE CLOSED 6N (YMD) 01050I 183 1880WOCLOS 01060I* BUDGET/STANDARD 01070I* LABOR HRS 7P 01080I P 189 1920WOBLHR 01090I* LABOR $ 9.3P 01100I P 193 1973WOBL$ 01110I* MATERIAL $ 11.3P 01120I P 198 2033WOBM$ 01130I* LABOR BURDEN CHARGED 9.3P 01140I P 204 2083WOBUR$ 01150I* LABOR BURDEN BUDGET 9.3P 01160I P 209 2133WOLB$ 01170I* RECORD STATUS 1A 01180I 228 228 WOSTAT 01190I******************************************************************* 01200IALTSTARTAS 01210I* ALTERNATE KEY - START DATE 01220I 1 15 ASKEY 01230I* START DATE 6N (YMD) 01240I 1 60ASSTRT 01250I* WORK ORDER NO. 9A ÐÐ01260I 7 15 ASWO 01270I* RECORD STATUS 1A 01280I 16 16 ASSTAT 01290I********************************************************************* 01300IPMMST2 PM 01310I* PART MASTER 01320I* MODEL NO. 12A 01330I 19 30 PMMODL 01340I* DESCRIPTION 29A 01350I 31 59 PMDESC 01360I* LEAD TIME 8 X 3P 01370I P 113 128 PLT 01380I 674 674 PMSTAT 01390C******************************************************************** 01400C* 1-TIME INIT 01410C EXSR SR101 INIT 01420C MOVE ' ' BLK6 6 01430C EXSR SR70 NEW PAGE 01440C N50 MOVEL'091' RPGLIN 4 01450C 50 MOVE '001' RPGLIN 01460C MOVEL'001' RPGCOL 4 01470C EXSR SR69 MOVE CURSOR 01480C*------------------------------------------------------------- 01490C START TAG 01500C* REQUEST WORK ORDER ÐÐ01510C EXSR SR68 LF 01520C SETON 72 01530C EXCPT PROMPT 01540C SETOF 72 01550C EXSR SR75 READ CRT 01560C*-------------------------------------------------------------- 01570C TAG5 TAG 01580C* SET-UP 1ST DISPLAY 01590C MOVELW20A W8A 8 01600C Z-ADD8 W2N 20 01610C EXIT SUBRAJ RJ 01620C RLABL W2N 01630C RLABL W8A 01640C MOVE W8A W6A 6 01650C MOVELW6A W2N 01660C W2N COMP 12 54 01670C N54 MOVELW6A W4A 4 01680C N54 MOVE W6A W2N 01690C N54 MOVELW2N W6A 01700C N54 MOVE W4A W6A 01710C MOVELW6A W15A 15 01720C MOVE BLK35 LSTKEY 15 01730C W15A SETLLALTSTART 01740C EXSR SR70 NEW PAGE 01750C*--------------------------------------------------------------- ÐÐ01760C TAG10 TAG 01770C SETOF 54 01780C READ ALTSTART 54 GET WORK ORDER 01790C 54 GOTO TAG200 END FILE 01800C ASKEY COMP LSTKEY 54 01810C N54 GOTO TAG200 END FILE(WRAPAROUND)01820C MOVE ASKEY LSTKEY 01830C ASSTAT COMP 'D' 54 01840C 54 GOTO TAG10 DELETED 01850C ASWO CHAINWOMAST 60 01860C N60 WOSTAT COMP 'D' 60 01870C 60 GOTO TAG10 01880C EXSR SR301 CLASSIFY WO PREFIX 01890C 40 EXSR SR302 EDIT PART NO. 01900C 40 EXSR SR303 EDIT TOP ASSY 01910C 40 EXSR SR304 EDIT ALT PN 01920C WOWOD COMP 0 55 01930C EXSR SR71 PUT DATA 01940C*------------------------------------------------------------------ 01950C TAG100 TAG 01960C EXSR SR75 READ CRT 01970C N77 EXSR SR70 NEW PAGE 01980C N77 GOTO TAG10 GET NEXT WO 01990C GOTO TAG5 SET-UP NEW WO 02000C*----------------------------------------------------------------- ÐÐ02010C TAG200 TAG 02020C* END FILE MESSAGE 02030C SETON 73 02040C EXCPT END FILE MSG 02050C SETOF 73 02060C GOTO TAG100 02070C*------------------------------------------------------------------ 02080C NEWITM TAG 02090C* SET-UP LINK FOR NEW ITEM 02100C MOVEL'Q005WO' PROG 8 02110C GOTO END 02120C*------------------------------------------------------------------- 02130C MENU TAG 02140C* SET-UP LINK TO MENU 02150C EXSR SR96 02160C Z-ADD1 W 02170C BLK6 LOKUPLNK,W 54 >>>>>>>>>> 02180C 54 MOVELLNK,W PROG 02190C 54 MOVE BLK6 LNK,W 02200C N54 MOVEL'CONTU' PROG 02210C EXSR SR97 02220C EXSR SR98 02230C*-------------------------------------------------------------------- 02240C GOODBY TAG 02250C* LINK TO SIGN-OFF ÐÐ02260C MOVEL'GOODBY' PROG 02270C GOTO END 02280C*------------------------------------------------------------------- 02290C END TAG 02300C EXSR SR96 02310C EXSR SR97 02320C EXSR SR98 02330C*------------------------------------------------------------------- 02340C ENDJOB TAG 02350C MOVEL'ENDJOB 'PROG 02360C EXSR SR98 02370C***************************************************************** 02380CSR SR67 BEGSR 02390CSR EXITFQBELL RING BELL 02400CSR ENDSR 02410C******************************************************************** 02420CSR SR68 BEGSR 02430CSR EXITFZLF LINE FEED 02440CSR ENDSR 02450C**************************************************************** 02460CSR SR69 BEGSR 02470CSRN50 EXITFZMOVXY MOVE CURSOR 02480CSR RLABL RPGLIN 02490CSR RLABL RPGCOL 02500CSR 50 EXITFZPUTXY ÐÐ02510CSR RLABL RPGLIN 02520CSR RLABL RPGCOL 02530CSR ENDSR 02540C***************************************************************** 02550CSR SR70 BEGSR 02560C* CLEAR TERM SCREEN. 02570CSR 50 EXITFZESCH CLEAR SCREEN 02580CSRN50 EXITFZCPAGE CLEAR SCREEN 02590CSR ENDSR 02600C********************************************************************** 02610CSR SR71 BEGSR 02620C* PUT HEADINGS TO TERMINAL 02630CSR SETON 71 02640CSR EXCPT PUT HEADINGS 02650CSR SETOF 71 02660CSR ENDSR 02670C********************************************************************* 02680CSR SR72 BEGSR 02690C* PUT DATA TO TERMINAL 02700CSR SETON 72 02710CSR EXCPT PUT DATA 02720CSR SETOF 72 02730CSR ENDSR 02740C******************************************************************* 02750CSR SR75 BEGSR ÐÐ02760C* READ FROM TERMINAL 02770CSR SETOF 779096 02780CSR SETOF 93 02790CSR MOVE BLK20 W20A 20 BUFFER 02800CSR EXITFZR20 READ FROM TERMINAL 02810CSR RLABL W20A READ BUFFER 02820CSR MOVEAW20A A20 INPUT DATA ARRAY 02830CSR MOVE BLK20 W20A INIT INPUT ARRAY 02840CSR Z-ADD1 W 30 02850CSR '\' LOKUPA20,W 90 FLAG ESC 02860CSRN90 GOTO T75B NOT ESC 02870CSR 1 ADD W W 02880CSR W COMP 20 54 02890CSR 54 GOTO T75A BAD ESC 02900CSR A20,W COMP 'G' 98 GOODBY 02910CSR A20,W COMP 'E' 94 MENU 02920CSR A20,W COMP 'N' 93 NEW ITEM 02930CSRN93 A20,W COMP 'D' 93 DONE 02940CSRN93 A20,W COMP 'B' 93 SKIP BACK 02950CSR 98 GOTO GOODBY 02960CSR 94 GOTO MENU 02970CSR 93 GOTO NEWITM 02980C*------------------------------------------------------------------ 02990CSR T75A TAG 03000C* BAD ESC INPUT DEFAULT. ÐÐ03010CSR GOTO SR75 03020C*-------------------------------------------------------------------- 03030CSR T75B TAG 03040C* MOVE DATA 03050CSR Z-ADD1 W 03060CSR ' ' LOKUPA20,W 77 03070CSR 77 MOVEAA20,W W20A INPUT DATA 03080CSR END75 ENDSR 03090C********************************************************************* 03100CSR SR83 BEGSR 03110C* GET PART MAST. 03120CSR MOVE ' ' W12A 03130CSR W12A CHAINPMMST2 60 03140CSRN60 PMSTAT COMP 'D' 60 03150CSR ENDSR 03160C******************************************************************** 03170CSR SR96 BEGSR 03180CSR # CHAINCRTFILE H9 GET CRTFILE 03190CSR H9 GOTO ENDJOB 03200CSR ENDSR 03210C******************************************************************** 03220CSR SR97 BEGSR 03230C* UPDATE CRTFILE. EXIT PROGRAM. 03240CSR TIME CRTIME 03250CSR MOVELUDATE CRDATE ÐÐ03260CSR SETON 97 03270CSR EXCPT UPD CRTFILE 03280CSR SETOF 97 03290CSR ENDSR 03300C******************************************************************** 03310CSR SR98 BEGSR 03320CSR EXSR SR70 CLEAR SCREEN 03330CSR EXITFCHAIN >>>>>>>>>> 03340CSR RLABL PROG 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR101 BEGSR 03380C* 1-TIME INITIALIZE 03390CSR MOVE BIT,1 NUL 03400CSR MOVE ' ' BLK20 20 03410C* GET PORT # AND CRTFILE 03420CSR MOVE ' ' W2A 2 03430CSR EXITFZGMINX GET PORT # 03440CSR RLABL W2A 03450CSR MOVE W2A # 20 PORT NO. 03460CSR # COMP 0 54 03470CSRN54 Z-ADD25 # DEFAULT 03480CSR EXSR SR96 03490CSR MOVE CALL LNK 03500CSR MOVE 'Q005WO 'PROG ÐÐ03510CSR PAR,# COMP '1' 50 03520CSR TST,# COMP 'S' 54 03530CSR 54 MOVE 'SHUTDOWN'PROG 03540CSR EXSR SR97 03550CSR 54 EXSR SR98 03560CSR MOVE BLK20 PROG 03570C* DEFINE WORK FIELDS,ETC. 03580CSR MOVELUDATE W4N 40 03590CSR MOVE UDATE W2N 03600CSR MOVELW2N TODAY 60 03610CSR MOVE W4N TODAY 03620CSR MOVE ' ' BLK35 35 03630CSR MOVE ' ' BLK6 6 03640CSR ENDSR 03650C******************************************************************** 03660CSR SR301 BEGSR 03670C* CLASSIFY WO-PREFIX (40=INVENTORY ITEM). 03680CSR PREFIX LOKUPTABPRX TABPD 40 03690CSR 40 MOVELTABPD WOTYPE 36 03700CSRN40 MOVE BLK35 WOTYPE 03710CSRN40 MOVELBLK35 WOTYPE 03720CSR ENDSR 03730C******************************************************************** 03740CSR SR302 BEGSR 03750C* GET WORK ORDER PART MASTER. ÐÐ03760CSR MOVE BLK35 DESCWO 03770CSR MOVE BLK35 MODLWO 03780CSRN40 GOTO END302 03790CSR WOPN COMP 0 55 03800CSRN55 GOTO END302 03810CSR MOVELWOPN W12A 12 03820CSR EXSR SR83 GET PART MASTER 03830CSR 60 GOTO END302 03840CSR MOVE PMDESC DESCWO 29 SAVE DESCRIPTION 03850CSR MOVE PMMODL MODLWO 12 SAVE MODEL NO. 03860CSR XFOOTPLT LEAD 40 03870CSR END302 ENDSR 03880C******************************************************************** 03890CSR SR303 BEGSR 03900C* GET TOP ASSY PART MASTER. 03910CSR MOVE BLK35 TADESC 03920CSR MOVE BLK35 TAMODL 03930CSRN40 GOTO END303 NOT INVENTORY ITEM 03940CSR WOTAPN COMP 0 54 03950CSRN54 GOTO END303 NOT INPUT 03960CSR MOVELWOTAPN W12A 03970CSR EXSR SR83 GET PART MASTER 03980CSRN60 MOVE PMDESC TADESC 29 03990CSRN60 MOVE PMMODL TAMODL 12 04000CSR END303 ENDSR ÐÐ04010C******************************************************************** 04020CSR SR304 BEGSR 04030CSR MOVE BLK35 ABMDES 04040CSR MOVE BLK35 ARPDES 04050C* GET ALT BM PART MASTER. 04060CSR WOABM COMP 0 54 04070CSRN54 GOTO T304C 04080CSR MOVELWOABM W12A 04090CSR EXSR SR83 GET PART MAST 04100CSRN60 MOVE PMDESC ABMDES 29 04110C*------------------------------------------------------------------- 04120CSR T304C TAG 04130C* GET ALT ROUTING PART MASTER. 04140CSR WOARPN COMP 0 54 04150CSRN54 GOTO END304 04160CSR MOVELWOARPN W12A 04170CSR EXSR SR83 GET PART MAST 04180CSRN60 MOVE PMDESC ARPDES 29 04190CSR END304 ENDSR 04200O******************************************************************** 04210OTERM132 E 71 04220O BIT,28 1 04230O N50 8 '8091001' 04240O N50 BIT,1 9 04250O N50 BIT,1 10 ÐÐ04260O 50 10 '[001 ]001' 04270O 50 BIT,28 6 04280O UDATE 18 ' - - ' 04290O 50 'W O R K' 04300O 62 'O R D E R' 04310O 78 'D I S P L A Y' 04320O 102 ' - START DATE SEQUENCE' 04330O*------------------------------------------------------------------- 04340O E 71 04350O 115 'E R R O R S' 04360O*------------------------------------------------------------------- 04370O E 71 04380O 23 ' WORK ORDER PRIME/' 04390O 27 'DASH' 04400O WOWOP 40 04410O 55 41 '-' 04420O 55 WOWOD 44 04430O WOTYPE 83 04440O*------------------------------------------------------------------- 04450O E 71 04460O 14 ' PART NO.' 04470O WOPN 46 ' - - ' 04480O DESCWO 77 04490O 84 'MODEL:' 04500O MODLWO 97 ÐÐ04510O*------------------------------------------------------------------- 04520O E 71 04530O 23 ' TOP ASSY PART NO.' 04540O 84 'MODEL:' 04550O WOTAPN 46 ' - - ' 04560O TADESC 77 04570O TAMODL 97 04580O*----------------------------------------------------------------- 04590O E 71 04600O 22 ' TOP ASSY RUN NO.' 04610O WORUN Z 36 04620O*----------------------------------------------------------------- 04630O E 71 04640O 25 ' QUANTITY SCHEDULED ' 04650O WOQTYS2 43 04660O*---------------------------------------------------------------- 04670O E 71 04680O 14 ' DUE DATE' 04690O WODUE 42 ' - - ' 04700O*------------------------------------------------------------------- 04710O E 71 04720O 16 ' START DATE' 04730O WOSTRT 42 ' - - ' 04740O*--------------------------------------------------------------------- 04750O E 71 ÐÐ04760O 13 ' REMARKS' 04770O WODESC 69 04780O*----------------------------------------------------------------- 04790O E 71 04800O 15 ' MODEL NO.' 04810O WOMODL 46 04820O*----------------------------------------------------------------- 04830O E 71 04840O 20 ' ALTERNATE BILL' 04850O 29 'MATERIAL' 04860O WOABM 46 ' - - ' 04870O ABMDES 77 04880O*-------------------------------------------------------------------- 04890O E 71 04900O 24 ' ALTERNATE ROUTING ' 04910O WOARPN 46 ' - - ' 04920O ARPDES 77 04930O*------------------------------------------------------------------- 04940O E 71 04950O 28 'LABOR-HRS' 04960O 49 'LABOR-$' 04970O 72 'MATERIAL-$' 04980O 93 'BURDEN-$' 04990O*------------------------------------------------------------------- 05000O E 71 ÐÐ05010O 12 'B U D G E T:' 05020O WOBLHRK 28 05030O WOBL$ K 49 05040O WOBM$ K 72 05050O WOLB$ K 93 05060O*------------------------------------------------------------------- 05070O E 71 05080O 12 'A C T U A L:' 05090O WOLABHK 28 05100O WOLAB$K 49 05110O WOMAT$K 72 05120O WOBUR$K 93 05130O*------------------------------------------------------------------- 05140O E 71 05150O 18 'QUANTITY COMPLETED' 05160O 32 ':' 05170O WOQTYC2 43 05180O 85 'DATE ENTERED' 05190O 98 ':' 05200O WODATE 108 ' - - ' 05210O*----------------------------------------------------------------- 05220O E 71 05230O 11 'DATE CLOSED' 05240O 32 ':' 05250O WOCLOS 42 ' - - ' ÐÐ05260O 90 'DATE RELEASED ' 05270O 98 ':' 05280O WODLTR 108 ' - - ' 05290O*-------------------------------------------------------------------- 05300O E 71 05310O 20 'DATE LAST COMPLETION' 05320O 32 ':' 05330O WODLTC 42 ' - - ' 05340O 88 'DATE LAST LABOR' 05350O 98 ':' 05360O WODLTL 108 ' - - ' 05370O*--------------------------------------------------------------------- 05380O E 71 05390O 21 'DATE LAST STOCK ISSUE' 05400O 32 ':' 05410O WODLTM 42 ' - - ' 05420O*----------------------------------------------------------------- 05430O E 71 05440O 13 'PRODUCT CLASS' 05450O 32 ':' 05460O WOPL Z 38 05470O 81 'FAB CODE' 05480O 98 ':' 05490O WOFAB 102 05500O*----------------------------------------------------------------- ÐÐ05510O E 71 05520O NUL 132 05530O BIT,11 2 05540O BIT,14 3 05550O 27 'ENTER RETURN, NEW START ' 05560O 51 'DATE, OR \ESC CODE......' 05570O*----------------------------------------------------------------- 05580O E 73 05590O OR 72 05600O NUL 132 05610O BIT,11 1 05620O 72 24 'ENTER START DATE........' 05630O 73 24 'END OF FILE.............' 05640O******************************************************************* 05650OCRTFILE E 97 05660O PROG 26 05670O CRTIME 33 05680O CRDATE 37 05690O LNK 79 05700O********************************************************************** ** NUL ARRAY 005710 005720** A20 ARRAY 005730 005740** DOT ARRAY 05750ÐÐ - - - - - - - - - - - -> 05760** LNK ARRAY 05770 05780/* 05790_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ômë ôÑX005GL P120282120282(èÈÐ00020H Q005GL00040F* LIST GEN LEDGER REPORT WRITER SPECS. (X005GL) 00060F* REVISED 3-03-80 12:30 PM. 00080F* FIELD SUBSTITUTIONS-------- 00100F* A40 = INPUT DATA ARRAY NAME (SR75) 00120F* 00140F* 1 = 1ST UPDATABLE FIELD NO. 00160F* 00180F* 40 = LGTH OF A40ARRAY 00200F* 00220F* ## = BIT ELEMENT FOR 40 00240F* 00260F* #QN = NEW ITEM PROG NAME 00280F* 00300F* #QQ = MENU PROG NAME 00320F* 00340F* BLK40= BLK FIELD FOR READ BUFFER 00360F* 00380F* W40A = READ BUFFER FIELD NAME 00400F* 00420F* 10 = LAST UPDATABLE FIELD # 00440F* 00460F* 6 = NUMBER OF NUMERIC FIELDS 00480F* 00500FBITTAB IP F 33 DISK ÐÐ00520FMGFILE IC F 80R DISK 00540FGLRWSPECUC F 66R 9AI 3 DISK A 00560FGLRWMASTIC F 128R 5AI 3 DISK 00580F* 00600FTERM132 O F 132 5 00620F**************************************************************** 00640E NUL 1 132 1 NULL CHAR 00660E A40 40 40 1 A INPUT DATA ARRAY 00680E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00700E DUN 1 10 1 A EDIT CMPLT FLAG 00720E MES 1 1 30 00740E LOC 1 10 3 0 00760E* 00780E* 00800E* 00820E BIT 33 1 SCREEN CONTR. CHAR 00840E* 00860E* 00880I******************************************************************* 00900IBITTAB BT 00920I 1 33 BIT 00940I******************************************************************* 00960IMGFILE MG 00980I* MESSAGE FILE. 01000I 1 35 MGTEXT ÐÐ01020I****************************************************************** 01040IGLRWSPECGW 01 10 CS 01060I* GEN LEDGER REPORT WRITER SPEC - SUB-TOTAL RECORD. 01080I OR 02 10 CA 01100I* ACCOUNT RECORD. 01120I* KEY AREA. 01140I* REPORT # 5N 01160I 3 70GWREP 01180I* SEQ # 4N 01200I 8 110GWSEQ 01220I* TYPE 1A (RECORD ID) (S) 01240I 12 12 GWTYPE 01260I* ACCOUNT # 11A 01280I 13 23 GWACNT 01300I* SUB-TOTAL # 2N (1-10) 01320I 24 250GWSTOT 01340I* TITLE 40A 01360I 26 65 GWTITL 01380I* LEVEL 2N 01400I 66 670GWLEV 01420I* RECORD STATUS 1A 01440I 68 68 GWSTAT 01460I******************************************************************** 01480IGLRWMASTGM 01500I* GEN LEDGER REPORT WRITER SPEC MASTER. ÐÐ01520I* KEY AREA. 01540I* REPORT NO. 5N 01560I 3 70GMNO 01580I* REPORT TITLE 60A 01600I 8 67 GMTITL 01620I* REQUESTED BY 35A 01640I 68 92 GMRQBY 01660I* DATE REQUESTED 6N 01680I 93 980GMRQDT 01700I* DATE LAST RUN 6N 01720I 99 1040GMDLR 01740I* FILLER 01760I* RECORD STATUS 1A 01780I 128 128 GMSTAT 01800C******************************************************************** 01820C* INITIALIZE 01840C EXSR SR101 1-TIME INIT 01860C*------------------------------------------------------------------ 01880C START TAG 01900C* SET-UP 1ST FIELD NO. 01920C SETOF 96 01940C Z-ADD1 F 30 FIELD # 01960C GOTO READ 01980C*------------------------------------------------------------------ 02000C NEXT TAG ÐÐ02020C* SET-UP NEXT FIELD NO. 02040C 1 ADD F F FIELD # 02060C*----------------------------------------------------------------- 02080C READ TAG 02100C* READ DATA FROM TERMINAL. 02120C EXSR SR102 VALIDATE FIELD # 02140C 55 GOTO UPDATE DONE 02160C EXSR SR201 IDENTIFY-F 02180C SETON 69 02200C EXSR SR72 PROMPT 02220C SETOF 69 02240C EXSR SR75 READ TERMINAL 02260C 98 GOTO GOODBY GOODBY 02280C 94 GOTO MENU MENU REQUEST 02300C N77 EXSR SR104 EDIT INPUT FIELD 02320C 93 GOTO NEWITM NEW ITEM 02340C 96 GOTO ERROR ERROR 02360C N77 GOTO NEXT NO DATA INPUT 02380C*------------------------------------------------------------------ 02400C PROCES TAG 02420C* PROCESS INPUT DATA 02440C EXSR SR103 MOVE DATA 02460C N96 EXSR SR104 EDIT DATA 02480C 96 GOTO ERROR ERROR 02500C GOTO NEXT ÐÐ02520C*------------------------------------------------------------------ 02540C UPDATE TAG 02560C* UPDATE DATA BASE. 02580C EXSR SR105 FINAL EDIT 02600C 96 GOTO ERROR ERROR 02620C EXSR SR106 UPDATE 02640C 96 GOTO ERROR ERROR 02660C 94 GOTO MENU RET TO MENU. 02680C 98 GOTO GOODBY SIGN-OFF. 02700C GOTO START 02720C*------------------------------------------------------------------- 02740C JUMP TAG 02760C* SET-UP JUMP TO REQUESTED FIELD 02780C 1 ADD W W 30 02800C W COMP 10 54 02820C 54 Z-ADD318 M 50 96 FLAG ERROR 02840C 54 GOTO ERROR BAD ESC 02860C MOVE '000' W3A 3 02880C MOVEAA10,W W3A 02900C Z-ADD3 W2N 20 02920C EXIT SUBRAJ R. JUSTIFY 02940C RLABL W2N 02960C RLABL W3A 02980C MOVE W3A F NEW FIELD # 03000C GOTO READ ÐÐ03020C*-------------------------------------------------------------------- 03040C ERROR TAG 03060C EXSR SR102 VALIDATE FIELD # 03080C EXSR SR89 GET MSG 03100C EXSR SR73 PUT MSG 03120C GOTO READ 03140C*------------------------------------------------------------------ 03160C NEWITM TAG 03180C* SET-UP LINK FOR NEW ITEM 03200C GOTO START 03220C*------------------------------------------------------------------- 03240C MENU TAG 03260C* SET-UP LINK TO MENU 03280C MOVEL'QQQM02' PROG 8 03300C GOTO END 03320C*-------------------------------------------------------------------- 03340C GOODBY TAG 03360C* LINK TO SIGN-OFF 03380C MOVEL'GOODBY' PROG 03400C GOTO END 03420C*------------------------------------------------------------------- 03440C END TAG 03460C PROG COMP BLK8 54 03480C N54 MOVEL'QQQM02' PROG 8 03500C EXITFCHAIN LINK TO NEXT PROG ÐÐ03520C RLABL PROG 03540C********************************************************************* 03560CSR SR72 BEGSR 03580C* PUT DATA TO TERMINAL 03600CSR SETON 72 03620CSR EXCPT PUT DATA 03640CSR SETOF 72 03660CSR ENDSR 03680C*********************************************************************** 03700CSR SR73 BEGSR 03720C* PUT ERROR MESSAGE TO TERMINAL 03740CSR SETON 73 03760CSR EXCPT PUT MSG 03780CSR SETOF 73 03800CSR Z-ADDM LSTERR 50 03820CSR ENDSR 03840C******************************************************************* 03860CSR SR75 BEGSR 03880C* READ FROM TERMINAL 03900CSR SETOF 779096 03920CSR SETOF 939291 03940CSR SETOF 8988 03960CSR MOVE BIT,6 A6,2 BUF LENGTH 03980CSR MOVEAA6 W6A 6 04000CSR MOVE BLK10 W10A 10 BUFFER ÐÐ04020CSR EXITFXCREAD READ TERM 04040CSR RLABL W10A 04060CSR RLABL W6A 04080CSR MOVEAW10A A10 04100CSR MOVE BLK10 W10A 04120CSR Z-ADD1 W 30 04140CSR '\' LOKUPA10,W 90 FLAG ESC 04160CSRN90 GOTO T75B NOT ESC 04180CSR 1 ADD W W 04200CSR W COMP 10 54 04220CSR 54 GOTO T75A BAD ESC 04240CSR A10,W COMP 'G' 98 GOODBY 04260CSR A10,W COMP 'E' 94 MENU 04280CSR A10,W COMP 'N' 93 NEW ITEM 04300CSR 98 04320COR 94 04340COR 93 GOTO END75 04360C*------------------------------------------------------------------ 04380CSR T75A TAG 04400C* FLAG BAD ESC INPUT 04420CSR Z-ADD318 M 96 FLAG ERROR 04440CSR GOTO END75 04460C*-------------------------------------------------------------------- 04480CSR T75B TAG 04500C* MOVE DATA ÐÐ04520CSR Z-ADD1 W 04540CSR ' ' LOKUPA10,W 77 04560CSR 77 MOVEAA10,W W10A INPUT DATA 04580C*-------------------------------------------------------------------- 04600CSR END75 TAG 04620C* INIT PREV ERROR MSG. 04640CSR LSTERR COMP 0 54 04660CSR 54 MOVE BLK35 MGTEXT 04680CSR 54 EXSR SR73 BLANK MESSAGE 04700CSR Z-ADD0 LSTERR 50 04720CSR ENDSR 04740C********************************************************************** 04760CSR SR89 BEGSR 04780C* GET MESSAGE MASTER 04800CSR M CHAINMGFILE 54 04820CSR 54 MOVE BLK35 MGTEXT 04840CSR 54 MOVELM MGTEXT 04860CSR 54 MOVE MES,1 MGTEXT 04880CSR ENDSR 04900C*********************************************************************** 04920CSR SR101 BEGSR 04940C* 1-TIME INITIALIZE 04960CSR MOVE BIT,1 NUL 04980CSR MOVE BIT,1 A6 05000CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ05020CSR MOVE ' ' BLK10 10 05040C* DEFINE WORK FIELDS,ETC. 05060CSR MOVE ' ' BLK35 35 05080CSR MOVE ' ' BLK8 8 05100CSR MOVE ' ' BLK5 5 05120CSR MOVE ' ' BLK20 20 05140C* 05160C* 05180CSR ENDSR 05200C********************************************************************** 05220CSR SR102 BEGSR 05240C* VALIDATE FIELD NO. 05260CSR F COMP 0 54 05280CSRN54 Z-ADD1 F 05300CSR F COMP FLIMIT 55 05320CSR 55 Z-ADD1 F 05340CSR ENDSR 05360C******************************************************************** 05380CSR SR103 BEGSR 05400C* MOVE INPUT DATA 05420CSR EXSR SR201 IDENTIFY-F 05440CSR EXSR SR202 R. JUSTIFY 05460CSR 01 MOVELW10A TQOTE 5 QUOTE # 05480CSR 02 MOVE W10A TITEM 30 ITEM 05500CSR MOVE ' ' DUN,F EDIT FLAG ÐÐ05520CSR ENDSR 05540C******************************************************************** 05560CSR SR104 BEGSR 05580C* EDIT INPUT DATA 05600CSR 96 MOVE ' ' DUN,F EDIT FLAG 05620CSRN96 MOVE 'X' DUN,F 05640CSR ENDSR 05660C*********************************************************************** 05680CSR SR105 BEGSR 05700C* FINAL EDIT 05720CSR SETON 79 FINAL EDIT FLAG 05740CSR Z-ADD1 F 96 05760C*-------------------------------------------------------------------- 05780CSR T105A TAG 05800CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05820CSRN54 GOTO END105 05840CSR EXSR SR201 IDENTIFY-F 05860CSR EXSR SR104 EDIT 05880CSRN96 GOTO T105A 05900C*-------------------------------------------------------------------- 05920CSR END105 TAG 05940CSR SETOF 79 05960CSR ENDSR 05980C******************************************************************** 06000CSR SR106 BEGSR ÐÐ06020C* DISPLAY QMMAST RECORD. 06040CSR MOVELTQOTE W8A 8 06060CSR MOVE TITEM W8A 06080CSR W8A SETLLQMMAST 06100CSR Z-ADD0 COUNT 30 06120CSR SETOF 74 06140C*------------------------------------------------------------------- 06160CSR T106A TAG 06180CSR SETOF 54 06200CSR READ QMMAST 54 06220CSR 54 GOTO T106B END OF FILE. 06240CSR QMSTAT COMP 'D' 54 06260CSRN54 QMITEM COMP 0 54 06280CSR 54 GOTO T106A 06300CSR EXSR SR205 TABLE LOKUPS. 06320CSR SETON 76 06340CSR EXCPT DISPLAY QMMAST 06360CSR SETOF 76 06380CSR SETON 74 06400CSR 1 ADD COUNT COUNT 06420CSR COUNT COMP 2 54 06440CSRN54 GOTO T106A 06460CSR Z-ADD34 M 06480CSR GOTO T106C 06500C*------------------------------------------------------------------- ÐÐ06520CSR T106B TAG 06540C* DISPLAY END PAGE/FILE MSG. 06560CSR Z-ADD317 M 06580C*----------------------------------------------------------------- 06600CSR T106C TAG 06620CSR EXSR SR89 GET END MSG. 06640CSR EXSR SR73 END PAGE MSG. 06660CSR EXSR SR75 06680CSR 94 EXIT. 06700COR 98 GOODBY. 06720COR 93 GOTO END106 NEW ITEM. 06740CSR Z-ADD0 COUNT 74 06760CSR M COMP 317 54 06780CSRN54 GOTO T106A 06800CSR END106 ENDSR 06820C************************************************************************ 06840CSR SR201 BEGSR 06860C* IDENTIFY FIELD NO. 06880CSR F COMP 1 01 06900CSR F COMP 2 02 06920CSR ENDSR 06940C********************************************************************** 06960CSR SR202 BEGSR 06980C* RIGHT JUSTIFY 07000CSR F COMP 2 54 ÐÐ07020CSRN54 GOTO END202 NOT NUMERIC FIELD 07040CSR Z-ADD10 W2N 20 07060CSR EXIT SUBRAJ R. JUSTIFY 07080CSR RLABL W2N 07100CSR RLABL W10A 07120CSR END202 ENDSR 07140C******************************************************************** 07160CSR SR205 BEGSR 07180C* GET CODE DESCRIPTIONS. 07200CSR QMPCLS LOKUPTABPRD TABPRN 54 PRODUCT NAME 07220CSR 54 MOVE TABPRN PRDNAM 20 07240CSRN54 MOVE BLK20 PRDNAM 07260CSR QMSYST LOKUPTABSYS TABSYN 54 SYSTEM NAME 07280CSR 54 MOVE TABSYN SYSNAM 20 07300CSRN54 MOVE BLK20 SYSNAM 07320CSR QMREAS LOKUPTABRES TABREN 54 REASON NAME 07340CSR 54 MOVE TABREN RESNAM 20 07360CSRN54 MOVE BLK20 RESNAM 07380CSR QMSCOD LOKUPTABSTC TABSTN 54 STATUS NAME 07400CSR 54 MOVE TABSTN STCNAM 10 07420CSRN54 MOVE BLK20 STCNAM 07440CSR ENDSR 07460O******************************************************************** 07480OTERM132 E 70 07500O* CLEAR TERMINAL. ÐÐ07520O NUL 132 07540O BIT,13 1 07560O*------------------------------------------------------------------- 07580O E 71 07600O* PUT HEADING. 07620O 4 'TRAN' 07640O 51 'ACCOUNT NO.' 07660O 120 'NUMB OF' 07680O*------------------------------------------------------------------- 07700O E 71 07720O 4 'CODE' 07740O 13 'REPORT#' 07760O 18 'SEQ' 07780O 24 'TYPE' 07800O 44 'PREFIX' 07820O 51 'PRIME' 07840O 58 'DASH' 07860O 69 'SUB-TOTAL' 07880O 76 'TITLE' 07900O 119 'LEVELS' 07920O*------------------------------------------------------------------- 07940O E 72 07960O* PUT DATA. 07980O TTCODE 2 08000O TREP Z 13 ÐÐ08020O TSEQ Z 18 08040O TTYPE 22 08060O TPRFX 42 08080O TPRIM Z 52 08100O TDASH Z 57 08120O TSTOT Z 65 08140O TTITL 111 08160O TLEV Z 117 08180O TYPNAM 36 08200O*-------------------------------------------------------------------- 08220O E 73 08240O* PUT MESSAGE. 08260O 96 9 'E R R O R' 08280O N96 9 ' ' 08300O MGTEXT B 50 08320O BIT,28 130 08340O 131 'K' 08360O BIT,8 132 ** NUL ARRAY 008380 008400** #A ARRAY 008420 008440** NUM ARRAY 008460002 REPORT # 008480003 SEQ # 008500ÐÐ006 PRIME 008520007 DASH 008540008 TOT # 008560010 LEVEL # 008580** DUN ARRAY 008600 008620** MES ARRAY 008640---MESSAGE NOT ON FILE--- 008660** LOC ARRAY 008680002 1 TRAN CODE 008700009 2 REPORT # 008720016 3 SEQ # 008740022 4 TYPE CODE 008760041 5 ACCT PREFIX 008780047 6 ACCT PRIME 008800055 7 ACCT DASH 008820064 8 SUB-TOT # 008840072 9 TITLE 008860116 10 LEVEL CODE 008880/* 008900_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(n½ §X005JQ P120282120282(èÈÐ00010H Q005JQ00020F* DISPLAY REMOTE PRINTER JOB QUEUE (DIABLO) (X005JQ) 00030F* AND REQUEST SELECTION. 00040F* REVISED 4/14/80 3:45 PM. 00050FBITHEX IP F 256 DISK 00060FJQDEVICEUD F 8L 6AI 1 DISK 00070FJQMAST UC F 96R 4AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090FMGFILE IC F 80R DISK 00100FBJMAST IC F 106R 6AI 1 DISK 00110FMENUDEPTIT F 25 EDISK 00120FDIABLO38O F 38 5 00130FDIABLO O F 132 5 00140E******************************************************************** 00150E NUL 1 132 1 00160E A6 6 6 1 00170E A8 8 8 1 A 00180E JOB 1 100 4 0 PRG 6 00190E MENUDEPT TABDEP 1 10 5 0 TABDN 20 00200E BIT 256 1 00210E CALL 5 6 00220I******************************************************************** 00230IBITHEX BT 00240I 1 256 BIT 00250I*************************************************************** ÐÐ00260ICRTFILE CR 00270I 14 180CRDEPT 00280I******************************************************************** 00290IMGFILE MG 00300I 1 35 MGTEXT 00310I******************************************************************** 00320IBJMAST BJ 00330I 7 46 BJDESC 00340I 106 106 BJSTAT 00350I******************************************************************** 00360IJQDEVICEJD 00370I* JOB QUEUE DEVICE ALT-KEY. 00380I* KEY AREA. 00390I* DEVICE CODE 2N 00400I 1 2 JDDEV 00410I* JOB # 4N 00420I 3 60JDJOB 00430I* RECORD STATUS 1A 00440I 8 8 JDSTAT 00450I******************************************************************** 00460IJQMAST JQ 00470I* JOB QUEUE MASTER. 00480I* JOB NUMB 4N 00490I 1 40JQNUMB 00500I* DEVICE 2A ÐÐ00510I* COL-2,DEVICE CODE 00520I* Y = SHARED 00530I* N = NON-SHARABLE 00540I* COL-1,DEVICE CODE 00550I* S = SYST PRINTER 00560I* D = DIABLO PRINTER 00570I* T = TERMINAL 00580I* C = CONSOLE 00590I 5 6 JQDEV 00600I* DEPT # 5N 00610I 7 110JQDEPT 00620I* JOB NAME 6A 00630I 12 17 JQJOB 00640I* PRINTER 1A 00650I 18 18 JQPRTR 00660I* PAPER 25A 00670I 19 43 JQPAP 00680I* COPIES REQUESTED 1N 00690I 44 440JQCOPY 00700I* REQUESTED BY 12A 00710I 45 56 JQRBY 00720I* REQUEST DATE 6N 00730I 57 620JQRDAT 00740I* REQUEST TIME 6N 00750I 63 680JQRTIM ÐÐ00760I* NEED BY DATE 6N 00770I 69 740JQNDAT 00780I* NEED BY TIME 6N 00790I 75 800JQNTIM 00800I* DATE COMPLETED 6N 00810I 81 860JQCDAT 00820I* TIME COMPLETED 6N 00830I 87 920JQCTIM 00840I* RECORD STATUS 1A 00850I 96 96 JQSTAT 00860C******************************************************************** 00870C* INITIALIZE. 00880C EXSR SR101 INIT. 00890C H9 GOTO ENDJOB 00900C*------------------------------------------------------------------- 00910C START TAG 00920C MOVEL'D' DEVKEY 6 00930C DEVKEY SETLLJQDEVICE 00940C SETOF 75 00950C*------------------------------------------------------------------- 00960C TAG100 TAG 00970C SETOF 54 00980C READ JQDEVICE 54 00990C 54 GOTO SELECT 01000C MOVELJDDEV W1A 1 ÐÐ01010C W1A COMP 'D' 54 01020C N54 GOTO SELECT WRONG DEVICE. 01030C JDSTAT COMP 'D' 54 01040C 54 GOTO TAG100 DELETED. 01050C JDJOB CHAINJQMAST 55 01060C N55 JQSTAT COMP 'D' 55 01070C 55 SETON 83 01080C 55 EXCPT DELETE JQDEVICE 01090C 55 SETOF 83 01100C 55 GOTO TAG100 01110C CRDEPT COMP JQDEPT 54 01120C N54 CRDEPT COMP 840 54 01130C N54 GOTO TAG100 01140C JQJOB CHAINBJMAST 55 01150C N55 BJSTAT COMP 'D' 55 01160C 55 SETON 84 01170C 55 EXCPT DEL JQMAST/DEVICE 01180C 55 SETOF 84 01190C 55 GOTO TAG100 01200C JQDEPT LOKUPTABDEP TABDN 54 01210C 54 MOVE TABDN DEPNAM 20 01220C N54 MOVE BLK20 DEPNAM 01230C 1 ADD J J 40 01240C MOVE JQNUMB JOB,J 01250C MOVE JQJOB PRG,J ÐÐ01260C N75 EXSR SR70 PUT HEADING 01270C EXSR SR72 DISPLAY QUE MENU 01280C GOTO TAG100 01290C*------------------------------------------------------------------- 01300C SELECT TAG 01310C EXITFQCLFCR LF/CR 01320C* PUT NO JOBS MESSAGE 01330C N75 SETON 76 01340C N75 EXCPT NO JOBS MSG 01350C N75 SETOF 76 01360C N75 EXITFQCLFCR LF/CR 01370C N75 GOTO GOODBY 01380C* GET SELECTION NUMBER. 01390C SETOF 96 01400C Z-ADD249 M 50 ENTER JOB NUMBER 01410C SETON 69 01420C EXSR SR73 PROMPT. 01430C SETOF 69 01440C EXITFQCLF 01450C EXITFQCLF 01460C EXITFQCLF 01470C EXSR SR75 READ. 01480C 98 GOTO GOODBY 01490C 94 01500COR 93 GOTO MENU ÐÐ01510C Z-ADD8 W2N 20 01520C EXIT SUBRAJ R. JUSTIFY. 01530C RLABL W2N 01540C RLABL W8A 8 01550C MOVE W8A SELNO 40 01560C SELNO COMP 0 55 01570C N55 Z-ADD309 M 96 01580C N55 EXSR SR73 FLAG ERROR. 01590C N55 GOTO SELECT 01600C Z-ADD1 X 40 01610C SELNO LOKUPJOB,X 55 GET JOB# 01620C N55 Z-ADD309 M 96 FLAG ERROR 01630C N55 GOTO SELECT 01640C JOB,X CHAINJQMAST 55 01650C 55 Z-ADD309 M 96 FLAG ERROR. 01660C 55 GOTO SELECT 01670C MOVE JQNUMB DEVKEY 01680C DEVKEY SETLLJQDEVICE 01690C READ JQDEVICE H7 01700C H7 GOTO ENDJOB 01710C SETON 84 DELETE JQDEVICE 01720C EXCPT DELETE JQMAST. 01730C SETOF 84 01740C MOVELPRG,X PROG 8 01750C EXITFQPAUSE ÐÐ01760C GOTO END 01770C*------------------------------------------------------------------- 01780C MENU TAG 01790C MOVEL'HELLO' PROG 8 01800C GOTO END 01810C*------------------------------------------------------------------- 01820C GOODBY TAG 01830C MOVEL'GOODBY' PROG 01840C*------------------------------------------------------------------- 01850C END TAG 01860C EXITFCHAIN 01870C RLABL PROG 01880C*------------------------------------------------------------------- 01890C ENDJOB TAG 01900C******************************************************************** 01910CSR SR70 BEGSR 01920C* PUT HEADINGS TO TERM. 01930CSR EXITFQCLFCR LF/CR 01940CSR SETON 42 01950CSR EXSR SR71 HEADING-2. 01960CSR SETON 44 01970CSR EXSR SR71 HEADING-4. 01980CSR EXITFQCLFCR LF/CR 01990CSR ENDSR 02000C****************************************************************** ÐÐ02010CSR SR71 BEGSR 02020C* PUT HEADINGS 02030CSR SETON 71 02040CSR EXCPT PUT HEADINGS 02050CSR SETOF 414243 02060CSR SETOF 4445 02070CSR SETOF 71 02080CSR ENDSR 02090C******************************************************************** 02100CSR SR72 BEGSR 02110C* PUT DATA TO TERM. 02120CSR SETON 7275 02130CSR EXCPT PUT DATA. 02140CSR SETOF 72 02150CSR SETON 74 02160CSR EXCPT 2ND DATA LINE. 02170CSR SETOF 74 02180CSR ENDSR 02190C******************************************************************** 02200CSR SR73 BEGSR 02210C* PUT MESSAGE. 02220CSR M CHAINMGFILE 54 02230CSRN54 SETON 73 02240CSR EXCPT PUT MSG. 02250CSR SETOF 73 ÐÐ02260CSR ENDSR 02270C******************************************************************* 02280CSR SR75 BEGSR 02290C* READ FROM TERMINAL 02300CSR SETOF 779096 02310CSR SETOF 939291 02320CSR SETOF 898887 02330CSR SETOF 8685 02340CSR MOVE BIT,5 A6,2 BUF LENGTH 02350CSR MOVEAA6 W6A 6 02360CSR MOVE BLK8 W8A 8 BUFFER 02370CSR EXITFQWREED READ TERM 02380CSR RLABL W8A 02390CSR RLABL W6A 02400CSR MOVEAW8A A8 02410CSR MOVE BLK8 W8A 02420CSR Z-ADD1 W 30 02430CSR '\' LOKUPA8,W 90 FLAG ESC 02440CSRN90 GOTO T75B NOT ESC 02450CSR 1 ADD W W 02460CSR W COMP 8 54 02470CSR 54 GOTO T75A BAD ESC 02480CSR A8,W COMP 'G' 98 GOODBY 02490CSR A8,W COMP 'E' 94 MENU 02500CSR A8,W COMP 'N' 93 NEW ITEM ÐÐ02510CSR A8,W COMP 'J' 92 JUMP 02520CSR A8,W COMP 'F' 91 SKIP FRWRD 02530CSR A8,W COMP 'B' 89 SKIP BKWRD 02540CSR A8,W COMP 'S' 88 SPACE FILL 02550CSR A8,W COMP 'H' 87 HOME 02560CSR A8,W COMP 'U' 86 UPDATE 02570CSR A8,W COMP 'R' 85 REPEAT 02580CSR 98 02590COR 94 02600COR 93 02610COR 92 02620COR 91 02630COR 89 02640COR 88 02650COR 87 02660COR 86 02670COR 85 GOTO END75 GOOD ESC 02680C*------------------------------------------------------------------ 02690CSR T75A TAG 02700C* FLAG BAD ESC INPUT 02710CSR Z-ADD318 M 50 96 FLAG ERROR 02720CSR GOTO END75 02730C*-------------------------------------------------------------------- 02740CSR T75B TAG 02750C* MOVE DATA ÐÐ02760CSR Z-ADD1 W 02770CSR ' ' LOKUPA8,W 77 02780CSR 77 MOVEAA8,W W8A INPUT DATA 02790C*-------------------------------------------------------------------- 02800CSR END75 ENDSR 02810C*********************************************************************** 02820CSR SR101 BEGSR 02830C* 1-TIME INITIALIZE 02840CSR MOVE BIT,1 NUL 02850CSR MOVEANUL NUL50 50 02860CSR MOVEANUL NUL25 25 02870CSR MOVE BIT,1 A6 02880CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02890CSR MOVE ' ' BLK8 8 02900C* GET PORT # 02910CSR MOVE ' ' W8A 8 02920CSR MOVE ' ' W1A 1 02930CSR MOVE ' ' W2A 2 02940CSR Z-ADD0 W1N 10 02950CSR Z-ADD0 W2N 20 02960CSR EXITFPGMINX 02970CSR RLABL W8A 02980CSR RLABL W2N 02990CSR RLABL W1N 03000CSR RLABL W2A ÐÐ03010CSR MOVE W2A PORT 20 03020CSR PORT COMP 0 54 03030CSRN54 Z-ADD25 PORT 03040CSR PORT CHAINCRTFILE H9 03050CSR H9 GOTO END101 03060C* DEFINE WORK FIELDS,ETC. 03070CSR MOVE ' ' BLK35 35 03080CSR MOVE ' ' BLK40 40 03090CSR MOVE ' ' BLK20 20 03100CSR END101 ENDSR 03110O******************************************************************** 03120OJQMAST E 84 03130O 96 'D' 03140O******************************************************************** 03150OJQDEVICEE 84 03160O OR 83 03170O 8 'D' 03180O******************************************************************** 03190ODIABLO E 71 44 03200O 4 'JOB#' 03210O 22 'JOB NAME' 03220O 62 'REQUEST-BY' 03230O 73 'NEED-BY' 03240O 77 'DEV' 03250O 93 'FORMS-REQ''D' ÐÐ03260O 110 'COPY' 03270O 122 'DEPARTMENT' 03280O*------------------------------------------------------------------- 03290O E 72 03300O* PUT MENU. 03310O JQNUMBZ 4 03320O U1 JQJOB 12 03330O BJDESC 54 03340O JQRBY 64 03350O JQNDATY 74 03360O JQDEV 77 03370O JQPAP 104 03380O JQCOPYZ 109 03390O DEPNAM 132 03400O**************************************************************** 03410ODIABLO38E 71 42 03420O* PUT TITLE 03430O NUL25 25 03440O NUL25 38 03450O BIT,28 1 03460O BIT,10 2 03470O BIT,71 3 03480O 38 'JOB QUEUE' 03490O*--------------------------------------------------------------------- 03500O E 74 ÐÐ03510O* PUT REQUESTED COMPL TIME 03520O NUL25 25 03530O NUL25 38 03540O BIT,28 1 03550O BIT,10 2 03560O BIT,68 3 03570O JQNTIM 38 ' : : ' 03580O*------------------------------------------------------------------ 03590O E 73 03600O* PUT MSG. 03610O MGTEXT 35 03620O 69 BIT,8 38 03630O*------------------------------------------------------------------ 03640O E 76 03650O* NO JOBS ON FILE MSG 03660O 20 'ALL JOBS COMPLETED' ** NUL ARRAY 003670 003680** A6 ARRAY 003690 003700** A8 ARRAY 003710 003720** JOB/PRG ARRAY 003730 003740/* 003750ÐÐ_‚ ÐÐ_‚_‚ ÐÈ(Šoe ŠX005KP P120282120282(èÈÐ00010H Q005KP00020F* UPDATE KPDEPT MASTER. (X005KP) 00030F* REVISED 7-23-80 11:35 AM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FKPDEPT UC F 13R12AI 1 DISK A 00070FKPNAME IC F 352R 6AI 1 DISK 00080FMENUDEPTIT F 25 EDISK 00090FTERM132 O F 132 5 00100F******************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A6 6 6 1 A INPUT DATA ARRAY 00130E A9 9 9 1 00140E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00150E DUN 1 4 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E LOC 1 4 3 0 COL # 00180E MENUDEPT TABDEP 1 10 5 0 TABDN 20 DEPT #/NAME 00190E DASH 1 132 1 DIVIDER 00200E* 00210E BIT 33 1 SCREEN CONTR. CHAR 00220E CALL 5 6 CALL STACK 00230E* 00240E* 00250I******************************************************************** ÐÐ00260IBITTAB BT 00270I 1 33 BIT 00280I******************************************************************** 00290IMGFILE MG 00300I* MESSAGE FILE. 00310I 1 35 MGTEXT 00320I******************************************************************** 00330IKPDEPT KD 00340I* KEYPUNCH DEPT MENU RECORD. 00350I* KEY AREA. 00360I* DEPT # 5N 00370I 1 50KDDEPT 00380I* JOB # 6A 00390I 6 11 KDJOB 00400I* FORMAT CODE 1A 00410I 12 12 KDFRMT 00420I* RECORD STATUS 1A 00430I 13 13 KDSTAT 00440I******************************************************************** 00450IKPNAME KN 00460I* KEYPUNCH JOB MASTER. 00470I* JOB # 6A 00480I 1 6 KNJOB 00490I* TITLE 60A 00500I 7 66 KNTITL ÐÐ00510I* HEADING-LINE 1 132A 00520I 67 198 KNHL1 00530I* HEADING-LINE 2 132A 00540I 199 330 KNHL2 00550I* LAST BATCH NO. 5P 00560I P 331 3330KNLBAT 00570I* FORMAT CODE 1A (H,V) 00580I 334 334 KNFRMT 00590I* LINK-TO PROG NAME 8A 00600I 335 342 KNLINK 00610I* RECORD STATUS 1A 00620I 352 352 KNSTAT 00630C******************************************************************** 00640C* INITIALIZE 00650C Z-ADD0 DEPTNO 50 STUPIDITY 00660C EXSR SR101 1-TIME INIT 00670C EXSR SR71 PUT HEADING 00680C*------------------------------------------------------------------ 00690C START TAG 00700C* SET-UP 1ST FIELD NO. 00710C MOVE BLK6 JOBNO 00720C MOVE ' ' FORMAT 00730C MOVE BLK60 KNTITL 00740C MOVE ' ' DUN INIT EDIT ARRAY 00750C Z-ADD1 F 30 FIELD # ÐÐ00760C GOTO READ 00770C*------------------------------------------------------------------ 00780C NEXT TAG 00790C* SET-UP NEXT FIELD NO. 00800C 1 ADD F F FIELD # 00810C*----------------------------------------------------------------- 00820C READ TAG 00830C* READ DATA FROM TERMINAL. 00840C SETOF 9096 00850C EXSR SR102 VALIDATE FIELD # 00860C 55 GOTO UPDATE DONE 00870C EXSR SR201 IDENTIFY-F 00880C SETON 69 00890C EXSR SR72 PROMPT 00900C SETOF 69 00910C EXSR SR75 READ TERMINAL 00920C 98 GOTO GOODBY GOODBY 00930C 94 GOTO MENU MENU REQUEST 00940C N77N88 EXSR SR104 EDIT INPUT FIELD 00950C 96 ERROR 00960CORN77N88 EXSR SR72 REWRITE INPUT DATA 00970C 93 GOTO NEWITM NEW ITEM 00980C 92 GOTO JUMP FIELD JUMP REQST 00990C 91 GOTO NEXT SKIP FORWARD 01000C 89 F SUB 1 F SKIP BACKWARD ÐÐ01010C 89 GOTO READ " " 01020C 88 SETOF 90 SPACE FILL 01030C 88 SETON 77 " " 01040C 87 GOTO START 01050C 86 GOTO UPDATE UPDATE 01060C 85 GOTO READ REPEAT 01070C 96 GOTO ERROR ERROR 01080C N77 GOTO NEXT NO DATA INPUT 01090C*------------------------------------------------------------------ 01100C PROCES TAG 01110C* PROCESS INPUT DATA 01120C EXSR SR103 MOVE DATA 01130C N96 EXSR SR104 EDIT DATA 01140C EXSR SR72 REWRITE DATA 01150C 96 GOTO ERROR ERROR 01160C GOTO NEXT 01170C*------------------------------------------------------------------ 01180C UPDATE TAG 01190C* UPDATE DATA BASE. 01200C EXSR SR105 FINAL EDIT 01210C 96 GOTO ERROR ERROR 01220C EXSR SR106 UPDATE 01230C 96 GOTO ERROR ERROR 01240C MOVE BLK6 JOBNO 01250C MOVE ' ' FORMAT ÐÐ01260C MOVE ' ' DUN 01270C Z-ADD2 F 01280C 1 ADD COUNT COUNT 30 01290C COUNT COMP 28 54 01300C 54 EXSR SR71 PUT HEADING 01310C GOTO READ 01320C*------------------------------------------------------------------- 01330C JUMP TAG 01340C* SET-UP JUMP TO REQUESTED FIELD 01350C 1 ADD W W 30 01360C W COMP 6 54 01370C 54 Z-ADD318 M 50 96 FLAG ERROR 01380C 54 GOTO ERROR BAD ESC 01390C MOVE ' ' W3A 3 01400C MOVEAA6,W W3A 01410C Z-ADD3 W2N 20 01420C EXIT SUBRAJ R. JUSTIFY 01430C RLABL W2N 01440C RLABL W3A 01450C MOVE W3A F NEW FIELD # 01460C GOTO READ 01470C*-------------------------------------------------------------------- 01480C ERROR TAG 01490C EXSR SR102 VALIDATE FIELD # 01500C EXSR SR89 GET MSG ÐÐ01510C EXSR SR73 PUT MSG 01520C GOTO READ 01530C*------------------------------------------------------------------ 01540C NEWITM TAG 01550C* SET-UP LINK FOR NEW ITEM 01560C MOVEL'Q005KP' PROG 8 01570C GOTO END 01580C*------------------------------------------------------------------- 01590C MENU TAG 01600C* SET-UP LINK TO MENU 01610C MOVEL'Q070DP' PROG 01620C GOTO END 01630C*-------------------------------------------------------------------- 01640C GOODBY TAG 01650C* LINK TO SIGN-OFF 01660C MOVEL'GOODBY' PROG 01670C GOTO END 01680C*------------------------------------------------------------------- 01690C END TAG 01700C EXITFCHAIN LINK TO NEXT PROG 01710C RLABL PROG 01720C********************************************************************* 01730CSR SR1 BEGSR 01740C* EDIT DEPT NO. 01750CSR DEPTNO COMP 0 54 ÐÐ01760CSRN54 Z-ADD232 M 96 FLAG ERROR. 01770CSR 54 DEPTNO LOKUPTABDEP TABDN 55 01780CSR 54N55 Z-ADD304 M 96 FLAG ERROR. 01790CSR 54N55 MOVE TABDN DEPNAM 20 DEPT NAME. 01800CSRN54 01810CORN55 MOVE BLK35 DEPNAM 01820CSR ENDSR 01830C******************************************************************** 01840CSR SR2 BEGSR 01850C* EDIT TRAN CODE. 01860CSR EXSR SR203 CLASSIFY TRAN. 01870CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 01880CSR ENDSR 01890C********************************************************************* 01900CSR SR3 BEGSR 01910C* EDIT JOB NO. 01920CSR JOBNO COMP BLK6 54 01930CSRN54 Z-ADD342 M 96 FLAG ERROR. 01940CSRN54 GOTO END3 01950CSR JOBNO CHAINKPNAME 54 01960CSR 54 Z-ADD252 M 96 FLAG ERROR. 01970CSR END3 ENDSR 01980C********************************************************************** 01990CSR SR4 BEGSR 02000C* EDIT FORMAT CODE. ÐÐ02010CSR MOVELJOBNO W7A 7 02020CSR MOVE FORMAT W7A 02030CSR W7A CHAINKPNAME 54 02040CSRN54 KNSTAT COMP 'D' 54 02050CSR 54 Z-ADD355 M 96 FLAG ERROR. 02060CSR 54 MOVELBLK35 KNTITL 02070CSR 54 MOVE BLK35 KNTITL 02080CSR ENDSR 02090C*********************************************************************** 02100CSR SR5 BEGSR 02110C* EDIT 02120C* 02130C* 02140C** 02150C* 02160C* 02170C* 02180CSR ENDSR 02190C******************************************************************** 02200CSR SR70 BEGSR 02210C* CLEAR TERM SCREEN. 02220CSR EXITFQTOPF CLEAR SCREEN 02230CSR ENDSR 02240C********************************************************************** 02250CSR SR71 BEGSR ÐÐ02260C* PUT HEADINGS TO TERMINAL 02270CSR SETON 71 02280CSR EXCPT PUT HEADINGS 02290CSR SETOF 71 02300CSR Z-ADD4 COUNT 30 02310CSR ENDSR 02320C********************************************************************* 02330CSR SR72 BEGSR 02340C* PUT DATA TO TERMINAL 02350CSR COUNT SUB 1 W3N 02360CSR MOVELW3N W6A 02370CSR MOVE '001' W6A 02380CSR EXITFQXYPOS 02390CSR RLABL W6A 02400CSR SETON 72 02410CSR EXCPT PUT DATA 02420CSR SETOF 72 02430CSR ENDSR 02440C*********************************************************************** 02450CSR SR73 BEGSR 02460C* PUT ERROR MESSAGE TO TERMINAL 02470CSR SETON 73 02480CSR EXCPT PUT MSG 02490CSR SETOF 73 02500CSR Z-ADDM LSTERR 50 ÐÐ02510CSR ENDSR 02520C******************************************************************** 02530CSR SR75 BEGSR 02540C* READ FROM TERMINAL 02550CSR SETOF 779096 02560CSR SETOF 939291 02570CSR SETOF 898887 02580CSR SETOF 8685 02590CSR 1 ADD LOC,F W3N 30 02600CSR MOVELCOUNT W6A 6 02610CSR MOVE W3N W6A 02620CSR MOVE BIT,28 A9,1 02630CSR MOVE '8' A9,2 02640CSR MOVEAW6A A9,3 02650CSR MOVE BIT,8 A9,9 02660CSR MOVEAA9 W9A 9 02670CSR MOVE BIT,4 BUFLGT 2 READ BUFFER LGTH 02680CSR MOVE BLK6 W6A BUFFER 02690CSR EXITFQPREED READ FROM TERMINAL 02700CSR RLABL W9A 02710CSR RLABL W6A READ BUFFER 02720CSR RLABL BUFLGT READ BUFFER LGTH 02730CSR MOVEAW6A A6 INPUT DATA ARRAY 02740CSR MOVE BLK6 W6A INIT INPUT ARRAY 02750CSR Z-ADD1 W 30 ÐÐ02760CSR '\' LOKUPA6,W 90 FLAG ESC 02770CSRN90 GOTO T75B NOT ESC 02780CSR 1 ADD W W 02790CSR W COMP 6 54 02800CSR 54 GOTO T75A BAD ESC 02810CSR A6,W COMP 'G' 98 GOODBY 02820CSR A6,W COMP 'E' 94 MENU 02830CSR A6,W COMP 'N' 93 NEW ITEM 02840CSR A6,W COMP 'J' 92 JUMP 02850CSR A6,W COMP 'F' 91 SKIP FRWRD 02860CSR A6,W COMP 'B' 89 SKIP BKWRD 02870CSR A6,W COMP 'S' 88 SPACE FILL 02880CSR A6,W COMP 'H' 87 HOME 02890CSR A6,W COMP 'U' 86 UPDATE 02900CSR A6,W COMP 'R' 85 REPEAT 02910CSR 98 02920COR 94 02930COR 93 02940COR 92 02950COR 91 02960COR 89 02970COR 88 02980COR 87 02990COR 86 03000COR 85 GOTO END75 GOOD ESC ÐÐ03010C*------------------------------------------------------------------ 03020CSR T75A TAG 03030C* FLAG BAD ESC INPUT 03040CSR Z-ADD318 M 96 FLAG ERROR 03050CSR GOTO END75 03060C*-------------------------------------------------------------------- 03070CSR T75B TAG 03080C* MOVE DATA 03090CSR Z-ADD1 W 03100CSR ' ' LOKUPA6,W 77 03110CSR 77 MOVEAA6,W W6A INPUT DATA 03120C*-------------------------------------------------------------------- 03130CSR END75 TAG 03140C* INIT PREV ERROR MSG. 03150CSR 54 MOVE BLK35 MGTEXT 03160CSR 54 EXSR SR73 BLANK MESSAGE 03170CSR Z-ADD0 LSTERR 50 03180CSR ENDSR 03190C********************************************************************** 03200CSR SR80 BEGSR 03210C* GET MASTER RECORD 03220CSR SETOF 61 03230CSR MOVELDEPTNO W12A 12 03240CSR MOVELJOBNO W7A 7 03250CSR MOVE FORMAT W7A ÐÐ03260CSR MOVE W7A W12A 03270CSR W12A CHAINKPDEPT 60 GET MASTER 03280CSRN60 KDSTAT COMP 'D' 61 FLAG DELETE 03290CSR ENDSR 03300C********************************************************************** 03310CSR SR81 BEGSR 03320C* ADD NEW MASTER TO FILE 03330CSR SETON 81 03340CSR EXCPT ADD MASTER 03350CSR SETOF 81 03360CSR ENDSR 03370C*********************************************************************** 03380CSR SR82 BEGSR 03390C* REWRITE MASTER 03400CSR SETON 82 03410CSR EXCPT REWRITE MASTER 03420CSR SETOF 82 03430CSR ENDSR 03440C********************************************************************** 03450CSR SR89 BEGSR 03460C* GET MESSAGE MASTER 03470CSR M CHAINMGFILE 54 03480CSR 54 MOVE BLK35 MGTEXT 03490CSR 54 MOVELM MGTEXT 03500CSR 54 MOVE MES,1 MGTEXT ÐÐ03510CSR ENDSR 03520C*********************************************************************** 03530CSR SR101 BEGSR 03540C* 1-TIME INITIALIZE 03550CSR MOVE BIT,1 NUL 03560CSR EXSR SR70 CLEAR SCREEN. 03570CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03580CSR Z-ADD4 FLIMIT 30 TOTAL NUMB FIELDS 03590CSR MOVE ' ' BLK6 6 03600C* DEFINE WORK FIELDS,ETC. 03610CSR MOVE ' ' BLK35 35 03620CSR MOVE '-' DASH 03630CSR MOVE ' ' BLK60 60 03640C* 03650C* 03660C* 03670CSR ENDSR 03680C********************************************************************** 03690CSR SR102 BEGSR 03700C* VALIDATE FIELD NO. 03710CSR F COMP 0 54 03720CSRN54 Z-ADD1 F 03730CSR F COMP FLIMIT 55 03740CSR 55 Z-ADD1 F 03750CSR ENDSR ÐÐ03760C******************************************************************** 03770CSR SR103 BEGSR 03780C* MOVE INPUT DATA 03790CSR EXSR SR201 IDENTIFY-F 03800CSR EXSR SR202 R. JUSTIFY 03810CSR 01 MOVE W6A DEPTNO 50 DEPT #. 03820CSR 02 MOVELW6A CRTRAN 1 TRAN CODE. 03830CSR 03 MOVELW6A JOBNO 6 JOB #. 03840CSR 04 MOVELW6A FORMAT 1 FORMAT CODE 03850CSR MOVE ' ' DUN,F EDIT FLAG 03860CSR ENDSR 03870C******************************************************************** 03880CSR SR104 BEGSR 03890C* EDIT INPUT DATA 03900CSR 01 EXSR SR1 03910CSR 02 EXSR SR2 03920CSR 03 EXSR SR3 03930CSR 04 EXSR SR4 03940CSR 96 MOVE ' ' DUN,F EDIT FLAG 03950CSRN96 MOVE 'X' DUN,F 03960CSR ENDSR 03970C*********************************************************************** 03980CSR SR105 BEGSR 03990C* FINAL EDIT 04000CSR SETON 79 FINAL EDIT FLAG ÐÐ04010CSR Z-ADD1 F 96 04020C*-------------------------------------------------------------------- 04030CSR T105A TAG 04040CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04050CSRN54 GOTO END105 04060CSR EXSR SR201 IDENTIFY-F 04070CSR EXSR SR104 EDIT 04080CSRN96 GOTO T105A 04090C*-------------------------------------------------------------------- 04100CSR END105 TAG 04110CSR SETOF 79 04120CSR ENDSR 04130C******************************************************************** 04140CSR SR106 BEGSR 04150C* UPDATE DATA BASE. 04160CSR EXSR SR203 CLASSIFY TRAN 04170CSR 60 GOTO T106A ADD TRAN 04180CSR 61 GOTO T106D CHANGE TRAN 04190CSR 62 GOTO T106F DELETE TRAN 04200C* FLAG BAD TRAN CODE 04210CSR Z-ADD300 M 96 FLAG ERROR 04220CSR Z-ADD1 F FIELD # 04230CSR GOTO END106 04240C*------------------------------------------------------------------- 04250CSR T106A TAG ÐÐ04260C* ADD TRANSACTION 04270CSR EXSR SR80 GET MASTER 04280CSR 60 GOTO T106B NOT ON FILE 04290CSR 61 GOTO T106C DELETED MASTER 04300C* FLAG DUPLICATE ADD ERROR 04310CSR Z-ADD301 M 96 FLAG ERROR 04320CSR Z-ADD1 F FIELD # 04330CSR GOTO END106 04340C*--------------------------------------------------------------------- 04350CSR T106B TAG 04360C* ADD-- MAST NOT ON FILE 04370CSR EXSR SR81 ADD NEW MASTER 04380CSR GOTO END106 04390C*--------------------------------------------------------------------- 04400CSR T106C TAG 04410C* ADD-- MAST IS DELETED 04420CSR MOVE 'A' KDSTAT RECORD STATUS 04430CSR EXSR SR82 REWRITE MAST 04440CSR GOTO END106 04450C*---------------------------------------------------------------------- 04460CSR T106D TAG 04470C* CHANGE TRANSACTION. 04480CSR EXSR SR80 GET MASTER 04490CSRN60N61 GOTO T106E GOT IT 04500C* FLAG NO MASTER ERROR ÐÐ04510CSR Z-ADD302 M 96 FLAG ERROR 04520CSR Z-ADD1 F FIELD # 04530CSR GOTO END106 04540C*----------------------------------------------------------------------- 04550CSR T106E TAG 04560C* REWRITE MASTER 04570CSR EXSR SR82 REWRITE MAST 04580CSR GOTO END106 04590C*----------------------------------------------------------------------- 04600CSR T106F TAG 04610C* DELETE TRANSACTION 04620CSR EXSR SR80 GET MASTER 04630CSRN60N61 GOTO T106G GOT IT 04640C* FLAG NO MASTER ERROR 04650CSR Z-ADD302 M 96 FLAG ERROR 04660CSR Z-ADD1 F FIELD # 04670CSR GOTO END106 04680C*----------------------------------------------------------------------- 04690CSR T106G TAG 04700C* DELETE MASTER. 04710CSR 96 GOTO END106 ERROR 04720CSR MOVE 'D' KDSTAT RECORD STATUS 04730CSR EXSR SR82 REWRITE MASTER 04740CSR END106 ENDSR 04750C************************************************************************ ÐÐ04760CSR SR201 BEGSR 04770C* IDENTIFY FIELD NO. 04780CSR F COMP 1 01 04790CSR F COMP 2 02 04800CSR F COMP 3 03 04810CSR F COMP 4 04 04820CSR ENDSR 04830C********************************************************************** 04840CSR SR202 BEGSR 04850C* RIGHT JUSTIFY 04860CSR F LOKUPNUM 54 04870CSRN54 GOTO END202 NOT NUMERIC FIELD 04880CSR Z-ADD6 W2N 20 04890CSR EXIT SUBRAJ R. JUSTIFY 04900CSR RLABL W2N 04910CSR RLABL W6A 04920CSR END202 ENDSR 04930C*********************************************************************** 04940CSR SR203 BEGSR 04950C* CLASSIFY TRAN CODE 04960CSR CRTRAN COMP 'A' 60 ADD 04970CSR CRTRAN COMP 'C' 61 CHANGE 04980CSR CRTRAN COMP 'D' 62 DELETE 04990CSR MOVE BLK35 TRNNAM 6 TRANS NAME 05000CSR 60 MOVEL'ADD' TRNNAM ÐÐ05010CSR 61 MOVEL'CHANGE' TRNNAM 05020CSR 62 MOVEL'DELETE' TRNNAM 05030CSR ENDSR 05040C**************************************************************************05050CSR SR206 BEGSR 05060C* ADJUST LINE NO. 05070CSR SETON 75 05080CSR EXCPT PUT BLANK LINE 05090CSR EXCPT 05100CSR SETOF 75 05110CSR EXITFQMOVUP 05120CSR EXITFQMOVUP 05130CSR Z-ADD119 LINENO 30 05140CSR ENDSR 05150O******************************************************************** 05160OKPDEPT EADD 81 05170O DEPTNO 5 05180O JOBNO 11 05190O FORMAT 12 05200O 13 'A' 05210O*------------------------------------------------------------------- 05220O E 82 05230O KDSTAT 13 05240O******************************************************************** 05250OTERM132 E 71 ÐÐ05260O BIT,28 1 05270O 8 '8001001' 05280O 128 'DEPT DATA ENTRY JOB UPDA' 05290O 130 'TE' 05300O*------------------------------------------------------------------- 05310O E 71 05320O OR 75 05330O*------------------------------------------------------------------- 05340O E 71 05350O 4 'DEPT' 05360O 11 'TRAN' 05370O 23 'JOB' 05380O 34 'FORMAT' 05390O*------------------------------------------------------------------- 05400O E 72 05410O DEPTNOZ 5 05420O CRTRAN 10 05430O TRNNAM 18 05440O JOBNO 26 05450O FORMAT 32 05460O DEPNAM 55 05470O KNTITL 120 05480O*------------------------------------------------------------------- 05490O E 72 05500O DASH 132 ÐÐ05510O BIT,28 131 05520O 132 'K' 05530O*------------------------------------------------------------------- 05540O E 73 05550O BIT,11 1 05560O 96 10 'E R R O R' 05570O N96 10 ' ' 05580O MGTEXT 49 05590O BIT,28 128 05600O 129 'K' 05610O BIT,28 130 05620O 131 'K' 05630O BIT,8 132 ** NUL ARRAY 005640 005650** A6 ARRAY 005660 005670** A9 ARRAY 005680 005690** NUM ARRAY 005700001 005710** DUN ARRAY 005720 005730** MES ARRAY 005740---MESSAGE NOT ON FILE--- 005750ÐÐ** LOC ARRAY 005760001 1 DEPT 005770010 2 TRAN 005780021 3 JOB 005790032 4 FORMAT 005800** DASH ARRAY 005810 005820/* 005830_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Xpu XúX005PC P120282120282(èÈÐ00010H Q005PC00020F* UPDATE PROD COST CANDIDATE FILE. (X005PC) 00030F* REVISED 3-31-81 3:55 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FPCCAND O F 10 DISK A 00080FPMMST2 IC F 674R12AI 1 DISK 00090FTERM132 O F 132 5 00100F**************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A16 16 16 1 A INPUT DATA ARRAY 00130E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 2 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E BIT 33 1 SCREEN CONTR. CHAR 00170E CALL 5 6 CALL STACK 00180I******************************************************************* 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************* 00220IMGFILE MG 00230I* MESSAGE FILE. 00240I 1 35 MGTEXT 00250I**************************************************************** ÐÐ00260IPMMST2 PM 00270I 1 100PMPN 00280I 19 30 PMMODL 00290I 31 59 PMDESC 00300I****************************************************************** 00310ICRTFILE CR 00320I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00330I* STD AREA - SAME FOR ALL PROGRAMS. 00340I* EMPLOYEE # 5N 00350I 1 50CREMPL 00360I* USER CODE 8A 00370I 6 13 CRUSER 00380I* DEPT # 5N 00390I 14 180CRDEPT 00400I* JOB NAME 8A (JOB LOADED BY MENU) 00410I 19 26 CRJOB 00420I* SHUTDOWN FLAG 1A 00430I* BLANK = NO SHUTDOWN 00440I 27 27 CRSHUT 00450I* TIME STARTED 6N 00460I 28 330CRTIME 00470I* DATE STARTED 4N 00480I 34 370CRDATE 00490I* CALL STACK 5 X 6A 00500I 38 67 CALL ÐÐ00510I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00520I 68 73 CRRET 00530I* MENU NAME 6A 00540I 74 79 CRMENU 00550C******************************************************************** 00560C* INITIALIZE 00570C EXSR SR101 1-TIME INIT 00580C*------------------------------------------------------------------ 00590C START TAG 00600C* SET-UP 1ST FIELD NO. 00610C Z-ADD0 TPN 00620C MOVE ' ' DUN INIT EDIT ARRAY 00630C Z-ADD1 F 30 FIELD # 00640C GOTO READ 00650C*------------------------------------------------------------------ 00660C NEXT TAG 00670C* SET-UP NEXT FIELD NO. 00680C 1 ADD F F FIELD # 00690C*----------------------------------------------------------------- 00700C READ TAG 00710C* READ DATA FROM TERMINAL. 00720C SETOF 909677 00730C EXSR SR102 VALIDATE FIELD # 00740C 55 GOTO UPDATE DONE 00750C EXSR SR201 IDENTIFY-F ÐÐ00760C SETON 69 00770C EXSR SR72 PROMPT 00780C SETOF 69 00790C EXSR SR75 READ TERMINAL 00800C 98 GOTO GOODBY GOODBY 00810C 94 GOTO MENU MENU REQUEST 00820C N77N88 EXSR SR104 EDIT INPUT FIELD 00830C 96 ERROR 00840CORN77N88 EXSR SR72 REWRITE INPUT DATA 00850C 93 GOTO NEWITM NEW ITEM 00860C 92 GOTO JUMP FIELD JUMP REQST 00870C 89 F SUB 1 F SKIP BACKWARD 00880C 89 GOTO READ " " 00890C 88 SETOF 90 SPACE FILL 00900C 88 SETON 77 " " 00910C 87 GOTO START 00920C 86 GOTO UPDATE UPDATE 00930C 85 GOTO READ REPEAT 00940C 96 GOTO ERROR ERROR 00950C N77 GOTO EDIT NO DATA INPUT 00960C*------------------------------------------------------------------ 00970C PROCES TAG 00980C* PROCESS INPUT DATA 00990C EXSR SR103 MOVE DATA 01000C*------------------------------------------------------------------- ÐÐ01010C EDIT TAG 01020C N96 EXSR SR104 EDIT DATA 01030C EXSR SR72 REWRITE DATA 01040C 96 GOTO ERROR ERROR 01050C GOTO NEXT 01060C*------------------------------------------------------------------ 01070C UPDATE TAG 01080C* UPDATE DATA BASE. 01090C EXSR SR105 FINAL EDIT 01100C 96 GOTO ERROR ERROR 01110C EXSR SR106 UPDATE 01120C 96 GOTO ERROR ERROR 01130C MOVE '120001' W6A 6 01140C EXITFQXYPOS 01150C RLABL W6A ERROR 01160C EXITFQCLF LINE FEED 01170C 1 ADD COUNT COUNT 01180C COUNT COMP 28 54 01190C 54 EXSR SR71 PUT HEADING 01200C GOTO START 01210C*------------------------------------------------------------------- 01220C JUMP TAG 01230C* SET-UP JUMP TO REQUESTED FIELD 01240C 1 ADD W W 30 01250C W COMP 16 54 ÐÐ01260C 54 Z-ADD318 M 50 96 FLAG ERROR 01270C 54 GOTO ERROR BAD ESC 01280C MOVE ' ' W3A 3 01290C MOVEAA16,W W3A 01300C Z-ADD3 W2N 20 01310C EXIT SUBRAJ R. JUSTIFY 01320C RLABL W2N 01330C RLABL W3A 01340C MOVE W3A F NEW FIELD # 01350C GOTO READ 01360C*-------------------------------------------------------------------- 01370C ERROR TAG 01380C EXSR SR102 VALIDATE FIELD # 01390C EXSR SR89 GET MSG 01400C EXSR SR73 PUT MSG 01410C GOTO READ 01420C*------------------------------------------------------------------ 01430C NEWITM TAG 01440C* SET-UP LINK FOR NEW ITEM 01450C MOVEL'Q005PC' PROG 8 01460C GOTO END 01470C*------------------------------------------------------------------- 01480C MENU TAG 01490C* SET-UP LINK TO MENU 01500C MOVEL'QQ01PC' PROG ÐÐ01510C GOTO END 01520C*-------------------------------------------------------------------- 01530C GOODBY TAG 01540C* LINK TO SIGN-OFF 01550C MOVEL'GOODBY' PROG 01560C GOTO END 01570C*------------------------------------------------------------------- 01580C END TAG 01590C PROG COMP BLK8 54 01600C N54 MOVELCRMENU PROG 01610C EXITFCHAIN LINK TO NEXT PROG 01620C RLABL PROG 01630C******************************************************************* 01640CSR SR1 BEGSR 01650C* EDIT PART #. 01660CSR TPN COMP 0 54 01670CSRN54 Z-ADD299 M 96 FLAG ERROR 01680CSRN54 GOTO END1 01690CSR MOVELTPN PN12 12 01700CSR PN12 CHAINPMMST2 60 01710CSR 60 Z-ADD291 M 96 FLAG ERROR 01720CSR END1 ENDSR 01730C***************************************************************** 01740CSR SR70 BEGSR 01750C* CLEAR TERM SCREEN. ÐÐ01760CSR MOVE '119001' W6A 6 01770CSR EXITFQXYPOS 01780CSR RLABL W6A 01790CSR ENDSR 01800C********************************************************************** 01810CSR SR71 BEGSR 01820C* PUT HEADINGS TO TERMINAL 01830CSR SETON 71 01840CSR EXCPT PUT HEADINGS 01850CSR SETOF 71 01860CSR Z-ADD3 COUNT 30 01870CSR ENDSR 01880C********************************************************************* 01890CSR SR72 BEGSR 01900C* PUT DATA TO TERMINAL 01910CSR MOVE '118001' W6A 01920CSR EXITFQXYPOS 01930CSR RLABL W6A 01940CSR SETON 72 01950CSR EXCPT PUT DATA 01960CSR SETOF 72 01970CSR ENDSR 01980C*********************************************************************** 01990CSR SR73 BEGSR 02000C* PUT ERROR MESSAGE TO TERMINAL ÐÐ02010CSR MOVE '119001' W6A 02020CSR EXITFQXYPOS 02030CSR RLABL W6A 02040CSR SETON 73 02050CSR EXCPT PUT MSG 02060CSR SETOF 73 02070CSR Z-ADDM LSTERR 50 02080CSR ENDSR 02090C******************************************************************* 02100CSR SR75 BEGSR 02110C* READ FROM TERMINAL 02120CSR SETOF 779096 02130CSR SETOF 9392 02140CSR SETOF 898887 02150CSR SETOF 8685 02160CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 02170CSR 01 MOVE '119002' W6A 02180CSR 02 MOVE '119008' W6A 02190CSR EXITFQXYPOS 02200CSR RLABL W6A 02210CSR MOVE BLK16 W16A 16 BUFFER 02220CSR EXITFQBELL RING BELL 02230CSR EXITFQWREED READ FROM TERMINAL 02240CSR RLABL W16A READ BUFFER 02250CSR RLABL BUFLGT READ BUFFER LGTH ÐÐ02260CSR MOVEAW16A A16 INPUT DATA ARRAY 02270CSR MOVE BLK16 W16A INIT INPUT ARRAY 02280CSR Z-ADD1 W 30 02290CSR '\' LOKUPA16,W 90 FLAG ESC 02300CSRN90 GOTO T75B NOT ESC 02310CSR 1 ADD W W 02320CSR W COMP 16 54 02330CSR 54 GOTO T75A BAD ESC 02340CSR A16,W COMP 'G' 98 GOODBY 02350CSR A16,W COMP 'E' 94 MENU 02360CSR A16,W COMP 'N' 93 NEW ITEM 02370CSR A16,W COMP 'J' 92 JUMP 02380CSR A16,W COMP 'B' 89 SKIP BKWRD 02390CSR A16,W COMP 'S' 88 SPACE FILL 02400CSR A16,W COMP 'H' 87 HOME 02410CSR A16,W COMP 'U' 86 UPDATE 02420CSR A16,W COMP 'R' 85 REPEAT 02430CSR 98 02440COR 94 02450COR 93 02460COR 92 02470COR 89 02480COR 88 02490COR 87 02500COR 86 ÐÐ02510COR 85 GOTO END75 GOOD ESC 02520C*------------------------------------------------------------------ 02530CSR T75A TAG 02540C* FLAG BAD ESC INPUT 02550CSR Z-ADD318 M 96 FLAG ERROR 02560CSR GOTO END75 02570C*-------------------------------------------------------------------- 02580CSR T75B TAG 02590C* MOVE DATA 02600CSR Z-ADD1 W 02610CSR ' ' LOKUPA16,W 77 02620CSR 77 MOVEAA16,W W16A INPUT DATA 02630C*-------------------------------------------------------------------- 02640CSR END75 TAG 02650C* INIT PREV ERROR MSG. 02660CSR LSTERR COMP 0 54 02670CSR 54 MOVE BLK35 MGTEXT 02680CSR 54 EXSR SR73 BLANK MESSAGE 02690CSR Z-ADD0 LSTERR 50 02700CSR ENDSR 02710C********************************************************************** 02720CSR SR81 BEGSR 02730C* ADD NEW MASTER TO FILE 02740CSR SETON 81 02750CSR EXCPT ADD MASTER ÐÐ02760CSR SETOF 81 02770CSR ENDSR 02780C********************************************************************** 02790CSR SR89 BEGSR 02800C* GET MESSAGE MASTER 02810CSR M CHAINMGFILE 54 02820CSR 54 MOVE BLK35 MGTEXT 02830CSR 54 MOVELM MGTEXT 02840CSR 54 MOVE MES,1 MGTEXT 02850CSR ENDSR 02860C*********************************************************************** 02870CSR SR101 BEGSR 02880C* 1-TIME INITIALIZE 02890CSR MOVE BIT,1 NUL 02900CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 02910CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02920CSR MOVE ' ' BLK16 16 02930C* GET PORT # AND CRTFILE 02940CSR MOVE ' ' W8A 8 02950CSR Z-ADD0 W2N 20 02960CSR Z-ADD0 W1N 10 02970CSR MOVE ' ' W2A 2 02980CSR EXITFPGMINX GET PORT # 02990CSR RLABL W8A 03000CSR RLABL W2N ÐÐ03010CSR RLABL W1N 03020CSR RLABL W2A 03030CSR MOVE W2A PORT 20 PORT NO. 03040CSR PORT COMP 0 54 03050CSRN54 Z-ADD25 PORT DEFAULT 03060CSR PORT CHAINCRTFILE H9 03070C* DEFINE WORK FIELDS,ETC. 03080CSR MOVE ' ' BLK35 35 03090CSR MOVE ' ' BLK8 8 03100CSR MOVE '120001' W6A 6 03110CSR EXITFQXYPOS POSITION CURSOR 03120CSR RLABL W6A 03130CSR EXSR SR71 PUT HEADING 03140CSR ENDSR 03150C********************************************************************** 03160CSR SR102 BEGSR 03170C* VALIDATE FIELD NO. 03180CSR F COMP 0 54 03190CSRN54 Z-ADD1 F 03200CSR F COMP FLIMIT 55 03210CSR 55 Z-ADD1 F 03220CSR ENDSR 03230C******************************************************************** 03240CSR SR103 BEGSR 03250C* MOVE INPUT DATA ÐÐ03260CSR EXSR SR201 IDENTIFY-F 03270CSR EXSR SR202 R. JUSTIFY 03280CSR 01 MOVE W10A TPN 100 PART # 03290CSR MOVE ' ' DUN,F EDIT FLAG 03300CSR ENDSR 03310C******************************************************************** 03320CSR SR104 BEGSR 03330C* EDIT INPUT DATA 03340CSR 01 EXSR SR1 03350CSR 96 MOVE ' ' DUN,F EDIT FLAG 03360CSRN96 MOVE 'X' DUN,F 03370CSR ENDSR 03380C*********************************************************************** 03390CSR SR105 BEGSR 03400C* FINAL EDIT 03410CSR SETOF 77 03420CSR SETON 79 FINAL EDIT FLAG 03430CSR Z-ADD1 F 96 03440C*-------------------------------------------------------------------- 03450CSR T105A TAG 03460CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03470CSRN54 GOTO END105 03480CSR EXSR SR201 IDENTIFY-F 03490CSR EXSR SR104 EDIT 03500CSRN96 GOTO T105A ÐÐ03510C*-------------------------------------------------------------------- 03520CSR END105 TAG 03530CSR SETOF 79 03540CSR ENDSR 03550C******************************************************************** 03560CSR SR106 BEGSR 03570C* UPDATE DATA BASE. 03580CSR EXSR SR81 ADD RECORD 03590CSR END106 ENDSR 03600C************************************************************************ 03610CSR SR201 BEGSR 03620C* IDENTIFY FIELD NO. 03630CSR F COMP 1 01 03640CSR ENDSR 03650C********************************************************************** 03660CSR SR202 BEGSR 03670C* RIGHT JUSTIFY 03680CSR F LOKUPNUM 54 03690CSRN54 GOTO END202 NOT NUMERIC FIELD 03700CSR Z-ADD10 W2N 20 03710CSR MOVELW16A W10A 10 03720CSR EXIT SUBRAJ R. JUSTIFY 03730CSR RLABL W2N 03740CSR RLABL W10A 03750CSR END202 ENDSR ÐÐ03760O******************************************************************** 03770OPCCAND EADD 81 03780O TPN 10 03790O******************************************************************** 03800OTERM132 E 72 03810O TPN 12 ' - - ' 03820O PMDESC B 43 03830O PMMODL B 57 03840O*------------------------------------------------------------------- 03850O E 73 03860O 96 5 '*****' 03870O N96 5 ' ' 03880O MGTEXT 43 03890O 96 55 'E R R O R' 03900O N96 55 ' ' 03910O BIT,28 130 03920O 131 'K' 03930O 96 BIT,8 132 03940O*--------------------------------------------------------------- 03950O E 71 03960O 1 ' ' 03970O E 71 03980O 15 'PART NO. ' 03990O 25 'DESCRIPTION' 04000O 50 'MODEL' ÐÐ04010O E 71 04020O 1 ' ' 04030O E 71 04040O 1 ' ' ** NUL ARRAY 004050 004060** A16 ARRAY 004070 004080** NUM ARRAY 004090001 004100** DUN ARRAY 004110 004120** MES ARRAY 004130---MESSAGE NOT ON FILE--- 004140/* 004150_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(qp §X005PE P120282120282(èÈÐ00010H Q005PE00020F* LIST DYNAIR/MFR PART # CROSS-REF. (X005PE) 00030F* REVISED 4/25/80 5:25 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FPEMAST ID F 45L17AI 1 DISK 00090FESMAST IC F 55R12AI 1 DISK 00100FESTEXT ID F 64L20AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E A6 6 6 1 CALL READ PARAM. 00140E A12 12 12 1 A INPUT DATA ARRAY 00150E A9 9 9 1 A 00160E MES 1 1 30 00170E NUL 1 132 1 00180E BIT 33 1 SCREEN CONTR. CHAR 00190I******************************************************************* 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************* 00230IMGFILE MG 00240I* MESSAGE FILE. 00250I 1 35 MGTEXT ÐÐ00260I****************************************************************** 00270ICRTFILE CR 00280I* MENU FIELDS 1 33 XXXXXX 00290I* CURRENT JOB 6A 00300I 21 26 CRJOB 00310I* CALLED BY PROG 6A 00320I 68 73 CRRET 00330I* CALL STACK 6A X 5 00340I 38 67 CALL 00350I*------------------------------------------------------------------- 00360I* PASSED DATA FIELDS 00370I* TRAN CODE 1A 00380I 80 80 CRTRAN 00390I* PART # 12A 00400I 81 92 CRPN 00410I* DESCRIPTION 35A 00420I 93 127 CRDESC 00430I* ENG STD CODE 4A 00440I 128 131 CRSTD 00450I* INSPECT CODE 3A 00460I 132 134 CRINSP 00470I* TEXT 40A 00480I 143 182 CRTEXT 00490I* FROM LINE # 8.5N 00500I 135 1425CRLINE ÐÐ00510I* MFR CODE 5A 00520I 207 211 CRMFG 00530I* MFR PART # 24A (FROM) 00540I 183 206 CRMPN 00550I* MFR PART # 24A (THRU) 00560I 224 247 CRTMPN 00570I* THRU LINE # 8.5N 00580I 248 2555CRTHRU 00590I********************************************************************* 00600IPEMAST PE 00610I* ENG STD - DYNAIR PART/MFG PART # CROSS REF FILE. 00620I* DYNAIR PART # 12A (KEY) 00630I 1 12 PEPN 00640I* MFR CODE 5A 00650I 13 17 PEMFG 00660I* MFR PART # 24A 00670I 18 41 PEMPN 00680I 13 41 PEEPKY 00690I* RECORD STATUS 1A 00700I 45 45 PESTAT 00710I******************************************************************** 00720IESMAST ES 00730I* ENGR STD MAST. 00740I* DYNAIR PART # 12A 00750I 1 12 ESPN ÐÐ00760I* PART DESCRIPTION 35A 00770I 13 47 ESDESC 00780I* ENG STD CODE 4A 00790I 48 51 ESSTD 00800I* INSPECT CODE 3A 00810I 52 54 ESINSP 00820I* RECORD STATUS 1A 00830I 55 55 ESSTAT 00840I******************************************************************** 00850IESTEXT EX 00860I 1 12 EXPN 00870I 21 60 EXTEXT 00880I 64 64 EXSTAT 00890C******************************************************************** 00900C* INITIALIZE. 00910C EXSR SR101 1-TIME INIT. 00920C* CLEAR SCREEN 00930C EXITFQTOPF CLEAR SCREEN 00940C*------------------------------------------------------------------- 00950C BEGIN TAG 00960C* SET-UP 1ST READ. 00970C MOVE BLK12 W17A 17 00980C MOVELCRPN W17A 00990C Z-ADD2 COUNT 30 01000C W17A SETLLPEMAST ÐÐ01010C*------------------------------------------------------------------- 01020C START TAG 01030C* READ NEXT TEXT. 01040C SETOF 81 01050C READ PEMAST 81 01060C 81 GOTO ENDITM END OF FILE. 01070C PESTAT COMP 'D' 54 01080C 54 GOTO START 01090C MOVELPEPN NUMPN 100 01100C PEPN COMP LSTPN 78 01110C* GET ESMAST. 01120C N78 EXSR SR76 GET ESMAST. 01130C MOVE PEPN LSTPN 12 01140C N78 EXSR SR102 DISPLAY TEXT. 01150C SETON 72 01160C EXCPT DISPLAY DATA. 01170C SETOF 72 01180C N74 1 ADD COUNT COUNT 01190C SETON 74 HEADING FLAG. 01200C 1 ADD COUNT COUNT 30 01210C COUNT COMP 26 54 01220C N54 GOTO START 01230C Z-ADD34 M 50 01240C EXSR SR73 FLAG END PAGE. 01250C EXSR SR75 READ. ÐÐ01260C 98 GOTO GOODBY 01270C 94 GOTO MENU 01280C 93 MOVEL'Q059DP' PROG 8 01290C 93 GOTO END 01300C 86 GOTO ENDITM DONE. 01310C 85 GOTO BEGIN REPEAT. 01320C Z-ADD2 COUNT 01330C SETOF 74 01340C GOTO START 01350C*------------------------------------------------------------------- 01360C ENDITM TAG 01370C Z-ADD35 M 01380C EXSR SR73 END ITEM MSG. 01390C EXITFXPAUSE 01400C SETON 76 01410C EXCPT HOME CURSOR. 01420C SETOF 76 01430C MOVEL'Q059DP' PROG 01440C GOTO END 01450C*------------------------------------------------------------------- 01460C GOODBY TAG 01470C MOVEL'GOODBY' PROG 01480C GOTO END 01490C*------------------------------------------------------------------- 01500C MENU TAG ÐÐ01510C MOVEL'Q070DP' PROG 01520C*------------------------------------------------------------------- 01530C END TAG 01540C EXITFCHAIN 01550C RLABL PROG 01560C*********************************************************************** 01570CSR SR73 BEGSR 01580C* PUT ERROR MESSAGE TO TERMINAL 01590CSR EXSR SR89 GET MSG. 01600CSR SETON 73 01610CSR EXCPT PUT MSG 01620CSR SETOF 73 01630CSR Z-ADDM LSTERR 50 01640CSR ENDSR 01650C******************************************************************* 01660CSR SR75 BEGSR 01670C* READ FROM TERMINAL 01680CSR SETOF 779096 01690CSR SETOF 939291 01700CSR SETOF 898887 01710CSR SETOF 8685 01720CSR MOVE BIT,7 A6,2 BUF LENGTH 01730CSR MOVEAA6 W6A 6 01740CSR MOVE BLK12 W12A 12 BUFFER 01750CSR EXITFXCREAD READ TERM ÐÐ01760CSR RLABL W12A 01770CSR RLABL W6A 01780CSR MOVEAW12A A12 01790CSR MOVE BLK12 W12A 01800CSR Z-ADD1 W 30 01810CSR '\' LOKUPA12,W 90 FLAG ESC 01820CSRN90 GOTO T75B NOT ESC 01830CSR 1 ADD W W 01840CSR W COMP 12 54 01850CSR 54 GOTO T75A BAD ESC 01860CSR A12,W COMP 'G' 98 GOODBY 01870CSR A12,W COMP 'E' 94 MENU 01880CSR A12,W COMP 'N' 93 NEW ITEM 01890CSR A12,W COMP 'J' 92 JUMP 01900CSR A12,W COMP 'F' 91 SKIP FRWRD 01910CSR A12,W COMP 'B' 89 SKIP BKWRD 01920CSR A12,W COMP 'S' 88 SPACE FILL 01930CSR A12,W COMP 'H' 87 HOME 01940CSR A12,W COMP 'D' 86 DONE. 01950CSR A12,W COMP 'R' 85 REPEAT 01960CSR 98 01970COR 94 01980COR 93 01990COR 92 02000COR 91 ÐÐ02010COR 89 02020COR 88 02030COR 86 02040COR 85 02050COR 87 GOTO END75 GOOD ESC 02060C*------------------------------------------------------------------ 02070CSR T75A TAG 02080C* FLAG BAD ESC INPUT 02090CSR Z-ADD318 M 96 FLAG ERROR 02100CSR GOTO END75 02110C*-------------------------------------------------------------------- 02120CSR T75B TAG 02130C* MOVE DATA 02140CSR Z-ADD1 W 02150CSR ' ' LOKUPA12,W 77 02160CSR 77 MOVEAA12,W W12A INPUT DATA 02170C*-------------------------------------------------------------------- 02180CSR END75 ENDSR 02190C******************************************************************** 02200CSR SR76 BEGSR 02210C* GET ESMAST. 02220CSR SETOF 61 02230CSR PEPN CHAINESMAST 60 02240CSRN60 ESSTAT COMP 'D' 60 02250CSR MOVELPEPN NUMPN 100 ÐÐ02260CSR SETON 75 02270CSR EXCPT DISPLAY ESMAST. 02280CSR SETOF 75 02290CSR SETON 74 02300CSR 2 ADD COUNT COUNT 02310CSR ENDSR 02320C********************************************************************** 02330CSR SR89 BEGSR 02340C* GET MESSAGE MASTER 02350CSR M CHAINMGFILE 54 02360CSR 54 MOVE BLK35 MGTEXT 02370CSR 54 MOVELM MGTEXT 02380CSR 54 MOVE MES,1 MGTEXT 02390CSR ENDSR 02400C*********************************************************************** 02410CSR SR101 BEGSR 02420C* 1-TIME INITIALIZE 02430CSR MOVE BIT,1 A6 02440CSR MOVE BIT,1 NUL 02450CSR MOVE ' ' BLK12 12 02460C* GET PORT # AND CRTFILE 02470CSR MOVE ' ' W8A 8 02480CSR Z-ADD0 W2N 20 02490CSR Z-ADD0 W1N 10 02500CSR MOVE ' ' W2A 2 ÐÐ02510CSR EXITFPGMINX GET PORT # 02520CSR RLABL W8A 02530CSR RLABL W2N 02540CSR RLABL W1N 02550CSR RLABL W2A 02560CSR MOVE W2A PORT 20 PORT NO. 02570CSR PORT COMP 0 54 02580CSRN54 Z-ADD25 PORT DEFAULT 02590CSR PORT CHAINCRTFILE H9 02600C* DEFINE WORK FIELDS,ETC. 02610CSR MOVE ' ' BLK35 35 02620CSR ENDSR 02630C******************************************************************** 02640CSR SR102 BEGSR 02650C* DISPLAY TEXT. 02660CSR MOVELPEPN W20A 20 02670CSR W20A SETLLESTEXT 02680C*------------------------------------------------------------------- 02690CSR T102A TAG 02700CSR SETOF 81 02710CSR READ ESTEXT 81 02720CSR 81 GOTO END102 02730CSR EXSTAT COMP 'D' 54 02740CSR 54 GOTO T102A 02750CSR EXPN COMP ESPN 54 ÐÐ02760CSRN54 GOTO END102 02770CSR SETON 71 02780CSR EXCPT 02790CSR SETOF 71 02800CSRN74 1 ADD COUNT COUNT 02810CSR SETON 74 02820CSR 1 ADD COUNT COUNT 02830CSR GOTO T102A 02840CSR END102 ENDSR 02850O******************************************************************** 02860OTERM132 E 72N74 02870O OR 75N74 02880O OR 71N74 02890O*------------------------------------------------------------------- 02900O E 75N74 02910O OR 72N74 02920O OR 71N74 02930O* PUT HEADINGS. 02940O 6 'DYNAIR' 02950O 19 'TRAN' 02960O 26 'MFR' 02970O 72 'STD' 02980O 81 'INSPECT' 02990O*------------------------------------------------------------------- 03000O E 75N74 ÐÐ03010O OR 72N74 03020O OR 71N74 03030O 8 'PART-NO.' 03040O 19 'CODE' 03050O 27 'CODE' 03060O 56 'MFR PART-NUMBER---------' 03070O 72 'CODE' 03080O 80 'CODE' 03090O*------------------------------------------------------------------- 03100O E 75 03110O OR 72N74 03120O OR 71N74 03130O*------------------------------------------------------------------- 03140O E 75 03150O NUMPN 12 ' - - ' 03160O N60 ESDESC 67 03170O N60 ESSTD 73 03180O N60 ESINSP 78 03190O*------------------------------------------------------------------- 03200O E 72 03210O* PUT DATA. 03220O 60 NUMPN 12 ' - - ' 03230O PEMFG 28 03240O PEMPN 56 03250O*------------------------------------------------------------------- ÐÐ03260O E 71 03270O* OUTPUT TEXT LINE. 03280O EXTEXT 72 03290O*------------------------------------------------------------------- 03300O E 73 03310O* PUT MESSAGE. 03320O MGTEXT 35 03330O 96 BIT,8 36 03340O 96 BIT,8 37 03350O*------------------------------------------------------------------- 03360O E 76 03370O* HOME CURSOR. 03380O NUL 132 03390O BIT,28 1 03400O 2 'T' ** A6 ARRAY 003410 003420** A12 ARRAY 003430 003440** A9 ARRAY 003450 003460** MES ARRAY 003470---MESSAGE NOT ON FILE--- 003480** NUL ARRAY 003490 003500ÐÐ/* 003510_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(r ‚X005PJ P120282120282(èÈÐ00010H Q005PJ00020F* PROJECT WORK ORDER -ENGINEERING UPDATE. (X005PJ) 00030F* REVISED 8/05/81 4:00 PM. 00040F* MENU: MQPJ01 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FPJMAST UC F 170R12AI 1 DISK A 00080FDEPTNAMEIT F 80 EDISK 00090FCRTFILE IC F 256R DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E DEPTNAME TABDEP 1 55 5 0 TABNAM 20 00130E A40 40 40 1 A INPUT DATA ARRAY 00140E LOC 1 19 6 XY-POS 00150E NUM 1 15 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 19 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E TB$ 1 2 7 0 BUDGET $ 00190E VAR 1 2 9 2 VAR $ - CUR MO 00200E TOT 1 2 9 2 ACTUAL $ TOTALS 00210E PA$ 2 9 2 ACTUAL $ - PRIOR 00220E PB$ 2 7 0 BUDGET $ 00230E PC$ 2 9 2 ACTUAL $ CUR MO 00240E BIT 33 1 SCREEN CONTR. CHAR 00250E CALL 5 6 ÐÐ00260E PT$ 2 9 2 TRSFR $ 00270I******************************************************************* 00280IBITTAB BT 00290I 1 33 BIT 00300I******************************************************************** 00310ICRTFILE CR 00320I 1 50CREMPL 00330I 6 13 CRUSER 00340I 14 180CRDEPT 00350I 19 26 CRJOB 00360I 27 27 CRSHUT 00370I 28 330CRTIME 00380I 38 67 CALL 00390I 68 73 CRRET 00400I 74 79 CRMENU 00410I******************************************************************** 00420IMGFILE MG 00430I* MESSAGE FILE. 00440I 1 35 MGTEXT 00450I******************************************************************** 00460IPJMAST PJ 00470I* PROJECT WORK ORDER. 00480I* WORK ORDER NO. 00490I 1 9 PJORD 00500I* PRIME 6A ÐÐ00510I 1 6 PJPRIM 00520I* DASH 3N 00530I 7 90PJDASH 00540I* DEPT 3N 00550I 10 120PJDEPT 00560I* ACCOUNT 5N 00570I 13 170PJACNT 00580I* MODEL 12A 00590I 18 29 PJMODL 00600I* DESCRIPTION 40A 00610I 30 69 PJDESC 00620I* SCHEDULE. 00630I* START DATE 6N 00640I 70 750PJBSD 00650I* COMPLETION DATE 6N 00660I 76 810PJBCD 00670I* BUDGET - LABOR HRS 7P 00680I P 82 850PJBLH 00690I* BUDGET - LABOR $ 7P 00700I P 86 89 PB$,1 00710I* BUDGET - MATERIAL $ 7P 00720I P 90 93 PB$,2 00730I* ACTUAL. 00740I* START DATE 6N 00750I 94 990PJASD ÐÐ00760I* COMPLETION DATE 6N 00770I 100 1050PJACD 00780I* LABOR HRS 7.1P 00790I P 106 1091PJALH 00800I* LABOR $ 9.2P 00810I P 110 114 PA$,1 00820I* MATERIAL $ 9.2P 00830I P 115 119 PA$,2 00840I* STATUS. 00850I* LABOR - % COMPLETE 3.2P 00860I P 120 1212PJLPCT 00870I* MATERIAL - % COMPLETE 3.2P 00880I P 122 1232PJMPCT 00890I* CURRENT MONTH - ACTUAL. 00900I* LABOR HRS 7.1P 00910I P 124 1271PJCLH 00920I* LABOR $ 9.2P 00930I P 128 132 PC$,1 00940I* MATERIAL $ 9.2P 00950I P 133 137 PC$,2 00960I* TRANSFER $ 2 X 9.2P 00970I P 138 147 PT$ 00980I* RECORD STATUS 1A 00990I 170 170 PJSTAT 01000C******************************************************************** ÐÐ01010C* INITIALIZE 01020C EXSR SR101 1-TIME INIT 01030C*------------------------------------------------------------------ 01040C START TAG 01050C* SET-UP 1ST FIELD NO. 01060C EXITFQTOPF TOP OF FORM 01070C Z-ADD0 TBSD 01080C Z-ADD0 TBCD 01090C Z-ADD0 TBLH 01100C Z-ADD0 TB$ 01110C Z-ADD0 TASD 01120C Z-ADD0 TACD 01130C Z-ADD0 THRVAR 01140C Z-ADD0 VAR 01150C Z-ADD0 TLPCT 01160C******** Z-ADD0 TMPCT 01170C Z-ADD0 TDEPT 01180C MOVE BLK35 DEPNAM 01190C EXSR SR205 INIT FILE FIELDS 01200C EXSR SR71 PUT HEADINGS 01210C SETOF 2928 01220C MOVE ' ' DUN INIT EDIT ARRAY 01230C Z-ADD1 F 30 FIELD # 01240C GOTO READ 01250C*------------------------------------------------------------------ ÐÐ01260C NEXT TAG 01270C* SET-UP NEXT FIELD NO. 01280C 1 ADD F F FIELD # 01290C*----------------------------------------------------------------- 01300C READ TAG 01310C* READ DATA FROM TERMINAL. 01320C SETOF 909677 01330C EXSR SR102 VALIDATE FIELD # 01340C 55 GOTO UPDATE DONE 01350C EXSR SR201 IDENTIFY-F 01360C 01 MOVE 'C' TTCODE 01370C F COMP 6 54 54 01380C 54 F COMP 17 5454 01390C N54 F COMP 19 54 01400C 54 GOTO NEXT BYPASS FIELD 01410C SETON 69 01420C EXSR SR72 PROMPT 01430C SETOF 69 01440C 01 GOTO EDIT TRAN CODE 01450C EXSR SR75 READ TERMINAL 01460C 98 GOTO GOODBY GOODBY 01470C 94 GOTO MENU MENU REQUEST 01480C N77N88 EXSR SR104 EDIT INPUT FIELD 01490C 96 ERROR 01500CORN77N88 EXSR SR72 REWRITE INPUT DATA ÐÐ01510C 93 GOTO NEWITM NEW ITEM 01520C 92 GOTO JUMP FIELD JUMP REQST 01530C 91 GOTO NEXT SKIP FORWARD 01540C 89 F SUB 1 F SKIP BACKWARD 01550C 89 GOTO READ " " 01560C 88 SETOF 90 SPACE FILL 01570C 88 SETON 77 " " 01580C 87 GOTO START 01590C 86 GOTO UPDATE UPDATE 01600C 85 GOTO READ REPEAT 01610C 96 GOTO ERROR ERROR 01620C N77 GOTO EDIT NO DATA INPUT 01630C*------------------------------------------------------------------ 01640C PROCES TAG 01650C* PROCESS INPUT DATA 01660C EXSR SR103 MOVE DATA 01670C*------------------------------------------------------------------- 01680C EDIT TAG 01690C N96 EXSR SR104 EDIT DATA 01700C EXSR SR72 REWRITE DATA 01710C 96 GOTO ERROR ERROR 01720C GOTO NEXT 01730C*------------------------------------------------------------------ 01740C UPDATE TAG 01750C* UPDATE DATA BASE. ÐÐ01760C EXSR SR105 FINAL EDIT 01770C 96 GOTO ERROR ERROR 01780C EXSR SR106 UPDATE 01790C 96 GOTO ERROR ERROR 01800C GOTO START 01810C*------------------------------------------------------------------- 01820C JUMP TAG 01830C* SET-UP JUMP TO REQUESTED FIELD 01840C 1 ADD W W 30 01850C W COMP 40 54 01860C 54 Z-ADD318 M 50 96 FLAG ERROR 01870C 54 GOTO ERROR BAD ESC 01880C MOVE ' ' W3A 3 01890C MOVEAA40,W W3A 01900C Z-ADD3 W2N 20 01910C EXIT SUBRAJ R. JUSTIFY 01920C RLABL W2N 01930C RLABL W3A 01940C MOVE W3A F NEW FIELD # 01950C GOTO READ 01960C*-------------------------------------------------------------------- 01970C ERROR TAG 01980C EXSR SR102 VALIDATE FIELD # 01990C EXSR SR89 GET MSG 02000C EXSR SR73 PUT MSG ÐÐ02010C GOTO READ 02020C*------------------------------------------------------------------ 02030C NEWITM TAG 02040C* SET-UP LINK FOR NEW ITEM 02050C MOVEL'Q005PJ' PROG 8 02060C GOTO END 02070C*------------------------------------------------------------------- 02080C MENU TAG 02090C* SET-UP LINK TO MENU 02100C MOVELCRMENU PROG 02110C GOTO END 02120C*-------------------------------------------------------------------- 02130C GOODBY TAG 02140C* LINK TO SIGN-OFF 02150C MOVEL'GOODBY' PROG 02160C GOTO END 02170C*------------------------------------------------------------------- 02180C END TAG 02190C EXITFCHAIN LINK TO NEXT PROG 02200C RLABL PROG 02210C********************************************************************* 02220CSR SR1 BEGSR 02230C* EDIT TRAN CODE. 02240CSR EXSR SR203 CLASSIFY TRAN 02250CSRN60N61N62 Z-ADD199 M 96 FLAG ERROR ÐÐ02260CSR ENDSR 02270C******************************************************************* 02280CSR SR2 BEGSR 02290C* EDIT WORK ORDER. 02300CSR TPRIM COMP ' ' 54 02310CSRN54 Z-ADD341 M 96 FLAG ERROR 02320CSR ENDSR 02330C********************************************************************** 02340CSR SR3 BEGSR 02350C* EDIT DEPT #. 02360CSR MOVE BLK35 DEPNAM 17 02370CSR TDEPT COMP 0 55 02380CSRN55 TDEPT COMP 1 54 02390CSR 54 02400CORN55 GOTO T3B 02410CSR Z-ADDTDEPT W5N 50 02420CSR W5N LOKUPTABDEP TABNAM 56 02430CSRN56 Z-ADD304 M 96 FLAG ERROR 02440CSRN56 GOTO END3 02450CSR MOVE TABNAM DEPNAM 02460C*------------------------------------------------------------------- 02470CSR T3B TAG 02480CSR SETOF 55 02490CSR EXSR SR203 CLASSIFY TRAN 02500CSR MOVELTORD KEYPJ 12 ÐÐ02510CSR MOVE TDEPT KEYPJ 02520CSR EXSR SR80 GET PJMAST 02530CSR 60 NO HIT 02540COR 61 SETON 55 DELETED 02550CSRN55 EXSR SR71 PUT DATA 02560CSR 60N55 Z-ADD301 M 96 DUPLICATE ADD-REJ 02570CSR 55 61 02580COR 55 62 Z-ADD5 M 96 NOT ON FILE-REJ 02590CSR END3 ENDSR 02600C*********************************************************************** 02610CSR SR5 BEGSR 02620C* EDIT DESCRIPTION. 02630CSR TDESC COMP BLK40 54 02640CSRN54 Z-ADD7 M FLAG WARNING 02650CSR EXSR SR73 02660CSR ENDSR 02670C******************************************************************* 02680CSR SR50 BEGSR 02690C* LABOR VARIANCE UPDATE. 02700CSR PJALH ADD PJCLH TOTHR 71 TOTAL HRS 02710CSR TBLH SUB TOTHR THRVAR 71 HRS VARIANCE 02720CSR PA$ ADD PC$ TOT TOTAL ACTUAL $$$$ 02730CSR TB$ SUB TOT VAR VARIANCE $$$ 02740CSR ENDSR 02750C***************************************************************** ÐÐ02760CSR SR68 BEGSR 02770C* RING BELL 02780CSR EXITFQBELL 02790CSR ENDSR 02800C***************************************************************** 02810CSR SR69 BEGSR 02820C* POSITION CURSOR. 02830CSR EXITFQXYPOS 02840CSR RLABL W6A 02850CSR ENDSR 02860C********************************************************************** 02870CSR SR71 BEGSR 02880C* PUT HEADINGS TO TERMINAL 02890CSR EXSR SR50 CALC $ VAR & TOT 02900CSR EXSR SR203 02910CSR MOVE '001001' W6A 02920CSR EXSR SR69 POSITION CURSOR 02930CSR SETON 71 02940CSR EXCPT PUT HEADINGS 02950CSR SETOF 71 02960CSR ENDSR 02970C********************************************************************* 02980CSR SR72 BEGSR 02990C* PUT DATA TO TERMINAL 03000CSR EXSR SR50 CALC $ VAR & TOTALS ÐÐ03010CSR EXSR SR203 03020CSR MOVELLOC,F W3N 30 03030CSR W3N SUB 1 W3N 03040CSR MOVELW3N W6A 03050CSR MOVE '001' W6A 03060CSR EXSR SR69 POSITION CURSOR 03070CSR SETON 72 03080CSR EXCPT PUT DATA 03090CSR SETOF 72 03100CSR ENDSR 03110C*********************************************************************** 03120CSR SR73 BEGSR 03130C* PUT ERROR MESSAGE TO TERMINAL 03140CSR MOVE '027001' W6A 6 03150CSR EXSR SR69 POSITION CURSOR 03160CSR SETON 73 03170CSR EXCPT PUT MSG 03180CSR SETOF 73 03190CSR Z-ADDM LSTERR 50 03200CSR ENDSR 03210C******************************************************************* 03220CSR SR75 BEGSR 03230C* READ FROM TERMINAL 03240CSR SETOF 779096 03250CSR SETOF 939291 ÐÐ03260CSR SETOF 898887 03270CSR SETOF 8685 03280CSR MOVE BIT,21 BUFLGT 2 READ BUFFER LGTH 03290CSR MOVE BLK40 W40A 40 BUFFER 03300CSR MOVE LOC,F W6A 03310CSR EXSR SR69 POSITION CURSOR 03320CSR EXSR SR68 RING BELL 03330CSR EXITFQWREED READ FROM TERMINAL 03340CSR RLABL W40A READ BUFFER 03350CSR RLABL BUFLGT READ BUFFER LGTH 03360CSR MOVEAW40A A40 INPUT DATA ARRAY 03370CSR MOVE BLK40 W40A INIT INPUT ARRAY 03380CSR Z-ADD1 W 30 03390CSR '\' LOKUPA40,W 90 FLAG ESC 03400CSRN90 GOTO T75B NOT ESC 03410CSR 1 ADD W W 03420CSR W COMP 40 54 03430CSR 54 GOTO T75A BAD ESC 03440CSR A40,W COMP 'G' 98 GOODBY 03450CSR A40,W COMP 'E' 94 MENU 03460CSR A40,W COMP 'N' 93 NEW ITEM 03470CSR A40,W COMP 'J' 92 JUMP 03480CSR A40,W COMP 'F' 91 SKIP FRWRD 03490CSR A40,W COMP 'B' 89 SKIP BKWRD 03500CSR A40,W COMP 'S' 88 SPACE FILL ÐÐ03510CSR A40,W COMP 'H' 87 HOME 03520CSR A40,W COMP 'U' 86 UPDATE 03530CSR A40,W COMP 'R' 85 REPEAT 03540CSR 98 03550COR 94 03560COR 93 03570COR 92 03580COR 91 03590COR 89 03600COR 88 03610COR 87 03620COR 86 03630COR 85 GOTO END75 GOOD ESC 03640C*------------------------------------------------------------------ 03650CSR T75A TAG 03660C* FLAG BAD ESC INPUT 03670CSR Z-ADD318 M 96 FLAG ERROR 03680CSR GOTO END75 03690C*-------------------------------------------------------------------- 03700CSR T75B TAG 03710C* MOVE DATA 03720CSR Z-ADD1 W 03730CSR ' ' LOKUPA40,W 77 03740CSR 77 MOVEAA40,W W40A INPUT DATA 03750C*-------------------------------------------------------------------- ÐÐ03760CSR END75 TAG 03770C* INIT PREV ERROR MSG. 03780CSR LSTERR COMP 0 54 03790CSR 54 MOVE BLK35 MGTEXT 03800CSR 54 EXSR SR73 BLANK MESSAGE 03810CSR Z-ADD0 LSTERR 50 03820CSR ENDSR 03830C********************************************************************** 03840CSR SR80 BEGSR 03850C* GET MASTER RECORD 03860CSR SETOF 612928 03870CSR KEYPJ CHAINPJMAST 60 GET MASTER 03880CSRN60 PJSTAT COMP 'D' 61 FLAG DELETE 03890CSR 60 SETON 29 03900CSR 61 SETON 28 03910CSR 60 03920COR 61 EXSR SR205 INIT PJMAST 03930CSRN60N61 EXSR SR206 MOVE FILE DATA 03940CSR ENDSR 03950C********************************************************************** 03960CSR SR81 BEGSR 03970C* ADD NEW MASTER TO FILE 03980CSR SETON 81 03990CSR EXCPT ADD MASTER 04000CSR SETOF 81 ÐÐ04010CSR ENDSR 04020C*********************************************************************** 04030CSR SR82 BEGSR 04040C* REWRITE MASTER 04050CSR SETON 82 04060CSR EXCPT REWRITE MASTER 04070CSR SETOF 82 04080CSR ENDSR 04090C********************************************************************** 04100CSR SR89 BEGSR 04110C* GET MESSAGE MASTER 04120CSR M CHAINMGFILE 54 04130CSR 54 MOVE BLK35 MGTEXT 04140CSR 54 MOVELM MGTEXT 04150CSR 54 MOVE MES,1 MGTEXT 04160CSR ENDSR 04170C*********************************************************************** 04180CSR SR101 BEGSR 04190C* 1-TIME INITIALIZE 04200CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04210CSR Z-ADD19 FLIMIT 30 TOTAL NUMB FIELDS 04220CSR MOVE ' ' BLK40 40 04230CSR MOVE ' ' BLK35 35 04240CSR MOVE ' ' BLK12 12 04250C* GET PORT # AND CRTFILE. ÐÐ04260CSR MOVE ' ' W8A 8 04270CSR Z-ADD0 W2N 20 04280CSR Z-ADD0 W1N 10 04290CSR MOVE ' ' W2A 2 04300CSR EXITFPGMINX GET PORT # 04310CSR RLABL W8A 04320CSR RLABL W2N 04330CSR RLABL W1N 04340CSR RLABL W2A 04350CSR MOVE W2A PORT 20 PORT NO. 04360CSR PORT COMP 0 54 04370CSRN54 Z-ADD25 PORT DEFAULT 04380CSR PORT CHAINCRTFILE H9 04390CSR ENDSR 04400C********************************************************************** 04410CSR SR102 BEGSR 04420C* VALIDATE FIELD NO. 04430CSR F COMP 0 54 04440CSRN54 Z-ADD1 F 04450CSR F COMP FLIMIT 55 04460CSR 55 Z-ADD1 F 04470CSR ENDSR 04480C******************************************************************** 04490CSR SR103 BEGSR 04500C* MOVE INPUT DATA ÐÐ04510CSR EXSR SR201 IDENTIFY-F 04520CSR EXSR SR202 R. JUSTIFY 04530CSR 01 MOVELW40A TTCODE 1 TRAN CODE 04540CSR 02 EXSR SR207 BUILD ORDER # 04550CSR 03 MOVE W10A TDEPT 30 DEPT # 04560CSR 04 MOVELW40A TMODL 12 MODEL # 04570CSR 05 MOVELW40A TDESC 40 PROJECT DESCR 04580CSR 06 MOVE W10A TBSD 60 SCHED START 04590CSR 07 MOVE W10A TBCD 60 SCHED CMPLTN 04600CSR 08 MOVE W10A TBLH 70 BUDGET HRS 04610CSR 09 MOVE W10A TB$,1 BUDGET LAB $ 04620CSR 10 MOVE W10A TB$,2 BUDGET MATL $ 04630CSR 11 MOVE W10A TASD 60 ACTUAL START 04640CSR 12 MOVE W10A TACD 60 ACTUAL CMPLTN 04650CSR 18 MOVE W10A TLPCT 32 LAB PCT CMPLT 04660C*R 19 ********* MOVE W10A TMPCT 32 MAT PCT CMPLT 04670CSR MOVE ' ' DUN,F EDIT FLAG 04680CSR ENDSR 04690C******************************************************************** 04700CSR SR104 BEGSR 04710C* EDIT INPUT DATA 04720CSR 01 EXSR SR1 04730CSR 02 EXSR SR2 04740CSR 03N79 EXSR SR3 04750CSR 05 EXSR SR5 ÐÐ04760CSR 96 MOVE ' ' DUN,F EDIT FLAG 04770CSRN96 MOVE 'X' DUN,F 04780CSR ENDSR 04790C*********************************************************************** 04800CSR SR105 BEGSR 04810C* FINAL EDIT 04820CSR SETOF 7796 04830CSR SETON 79 FINAL EDIT FLAG 04840CSR Z-ADD1 F 96 04850C*-------------------------------------------------------------------- 04860CSR T105A TAG 04870CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04880CSRN54 GOTO END105 04890CSR EXSR SR201 IDENTIFY-F 04900CSR EXSR SR104 EDIT 04910CSRN96 GOTO T105A 04920C*-------------------------------------------------------------------- 04930CSR END105 TAG 04940CSR SETOF 79 04950CSR ENDSR 04960C******************************************************************** 04970CSR SR106 BEGSR 04980C* UPDATE DATA BASE. 04990CSR EXSR SR203 CLASSIFY TRAN 05000CSR 60 GOTO T106A ADD TRAN ÐÐ05010CSR 61 GOTO T106D CHANGE TRAN 05020CSR 62 GOTO T106F DELETE TRAN 05030C* FLAG BAD TRAN CODE 05040CSR Z-ADD300 M 96 FLAG ERROR 05050CSR Z-ADD1 F FIELD # 05060CSR GOTO END106 05070C*------------------------------------------------------------------- 05080CSR T106A TAG 05090C* ADD TRANSACTION 05100CSR 29 GOTO T106B NOT ON FILE 05110CSR 28 GOTO T106C DELETED MASTER 05120C* FLAG DUPLICATE ADD ERROR 05130CSR Z-ADD301 M 96 FLAG ERROR 05140CSR Z-ADD1 F FIELD # 05150CSR GOTO END106 05160C*--------------------------------------------------------------------- 05170CSR T106B TAG 05180C* ADD-- MAST NOT ON FILE 05190CSR EXSR SR81 ADD NEW MASTER 05200CSR GOTO END106 05210C*--------------------------------------------------------------------- 05220CSR T106C TAG 05230C* ADD-- MAST IS DELETED 05240CSR MOVE 'A' PJSTAT RECORD STATUS 05250CSR EXSR SR82 REWRITE MAST ÐÐ05260CSR GOTO END106 05270C*---------------------------------------------------------------------- 05280CSR T106D TAG 05290C* CHANGE TRANSACTION. 05300CSRN29N28 GOTO T106E GOT IT 05310C* FLAG NO MASTER ERROR 05320CSR Z-ADD302 M 96 FLAG ERROR 05330CSR Z-ADD1 F FIELD # 05340CSR GOTO END106 05350C*----------------------------------------------------------------------- 05360CSR T106E TAG 05370C* REWRITE MASTER 05380CSR EXSR SR82 REWRITE MAST 05390CSR GOTO END106 05400C*----------------------------------------------------------------------- 05410CSR T106F TAG 05420C* DELETE TRANSACTION 05430CSRN29N28 GOTO T106G GOT IT 05440C* FLAG NO MASTER ERROR 05450CSR Z-ADD302 M 96 FLAG ERROR 05460CSR Z-ADD1 F FIELD # 05470CSR GOTO END106 05480C*----------------------------------------------------------------------- 05490CSR T106G TAG 05500C* DELETE MASTER. ÐÐ05510CSR MOVE 'D' PJSTAT RECORD STATUS 05520CSR EXSR SR82 REWRITE MASTER 05530CSR END106 ENDSR 05540C************************************************************************ 05550CSR SR201 BEGSR 05560C* IDENTIFY FIELD NO. 05570CSR F COMP 1 01 05580CSR F COMP 2 02 05590CSR F COMP 3 03 05600CSR F COMP 4 04 05610CSR F COMP 5 05 05620CSR F COMP 6 06 05630CSR F COMP 7 07 05640CSR F COMP 8 08 05650CSR F COMP 9 09 05660CSR F COMP 10 10 05670CSR F COMP 11 11 05680CSR F COMP 12 12 05690CSR F COMP 13 13 05700CSR F COMP 14 14 05710CSR F COMP 15 15 05720CSR F COMP 16 16 05730CSR F COMP 17 17 05740CSR F COMP 18 18 05750CSR F COMP 19 19 ÐÐ05760CSR ENDSR 05770C********************************************************************** 05780CSR SR202 BEGSR 05790C* RIGHT JUSTIFY 05800CSR F LOKUPNUM 54 05810CSRN54 GOTO END202 NOT NUMERIC FIELD 05820CSR Z-ADD10 W2N 20 05830CSR MOVELW40A W10A 10 05840CSR EXIT SUBRAJ R. JUSTIFY 05850CSR RLABL W2N 05860CSR RLABL W10A 05870CSR END202 ENDSR 05880C*********************************************************************** 05890CSR SR203 BEGSR 05900C* CLASSIFY TRAN CODE 05910CSR TTCODE COMP 'A' 60 ADD 05920CSR TTCODE COMP 'C' 61 CHANGE 05930CSR TTCODE COMP 'D' 62 DELETE 05940CSR ENDSR 05950C**************************************************************************05960CSR SR205 BEGSR 05970C* INIT PJMAST NON-KEY FIELDS. 05980CSR Z-ADD0 PJACNT 05990CSR MOVE BLK40 PJMODL 06000CSR MOVE BLK40 PJDESC ÐÐ06010CSR Z-ADD0 PJBSD 06020CSR Z-ADD0 PJBCD 06030CSR Z-ADD0 PJBLH 06040CSR Z-ADD0 PB$ 06050CSR Z-ADD0 PA$ 06060CSR Z-ADD0 PJASD 06070CSR Z-ADD0 PJACD 06080CSR Z-ADD0 PJALH 06090CSR Z-ADD0 PJLPCT 06100CSR Z-ADD0 PJMPCT 06110CSR Z-ADD0 PJCLH 06120CSR Z-ADD0 PC$,1 06130CSR Z-ADD0 PC$,2 06140CSR MOVE ' ' PJSTAT 06150CSR Z-ADD0 PT$ 06160CSR ENDSR 06170C******************************************************************** 06180CSR SR206 BEGSR 06190C* MOVE FILE DATA TO INPUT FIELDS. 06200CSR TMODL COMP BLK12 54 06210CSRN54 MOVE PJMODL TMODL MODEL # 06220CSR TDESC COMP BLK40 54 06230CSRN54 MOVE PJDESC TDESC DESCRIPTION 06240CSR TBSD COMP 0 54 06250CSRN54 Z-ADDPJBSD TBSD SCHED START ÐÐ06260CSR TBCD COMP 0 54 06270CSRN54 Z-ADDPJBCD TBCD SCHED CMPLTN 06280CSR TBLH COMP 0 54 06290CSRN54 Z-ADDPJBLH TBLH BUDGET HRS 06300CSR TB$,1 COMP 0 54 06310CSRN54 Z-ADDPB$,1 TB$,1 BUDGET LAB $ 06320CSR TB$,2 COMP 0 54 06330CSRN54 Z-ADDPB$,2 TB$,2 BUDGET MATL $ 06340CSR TASD COMP 0 54 06350CSRN54 Z-ADDPJASD TASD ACTUAL START 06360CSR TACD COMP 0 54 06370CSRN54 Z-ADDPJACD TACD ACTUAL CMPLTN 06380CSR TLPCT COMP 0 54 06390CSRN54 Z-ADDPJLPCT TLPCT LAB PCT CMPLT 06400C*R **** TMPCT COMP 0 54 06410C*RN54 ** Z-ADDPJMPCT TMPCT MAT PCT CMPLT 06420CSR ENDSR 06430C******************************************************************* 06440CSR SR207 BEGSR 06450C* BUILD ORDER #. 06460CSR MOVEAW40A A40,1 06470CSR Z-ADD1 X 30 06480CSR '-' LOKUPA40,X 55 06490CSR 55 MOVEAA40,X W4A 4 DASH 06500CSR 55 MOVEABLK40 A40,X ÐÐ06510CSRN55 MOVEAA40,7 W4A DASH 06520CSR MOVEAA40 TPRIM 6 PRIME 06530CSR MOVE TPRIM W5A 5 06540CSR Z-ADD5 W2N 06550CSR EXIT SUBRAJ R.J. 06560CSR RLABL W2N 06570CSR RLABL W5A 06580CSR MOVE W5A TPRIM PRIME 06590CSR MOVELTPRIM TORD 9 ORDER 06600CSR Z-ADD4 W2N 06610CSR EXIT SUBRAJ R.J. 06620CSR RLABL W2N 06630CSR RLABL W4A 06640CSR MOVE W4A TDASH 30 06650CSR MOVE TDASH TORD ORDER 06660CSR ENDSR 06670O******************************************************************** 06680OPJMAST EADD 81 06690O TPRIM 6 06700O TDASH 9 06710O TDEPT 12 06720O PJACNT 17 06730O TMODL 29 06740O TDESC 69 06750O TBSD 75 ÐÐ06760O TBCD 81 06770O TBLH 85P 06780O TB$ 93P 06790O TASD 99 06800O TACD 105 06810O PJALH 109P 06820O PA$ 119P 06830O TLPCT 121P 06840O****** TMPCT 123P 06850O PJCLH 127P 06860O PC$ 137P 06870O PT$ 147P 06880O 170 'A' 06890O*------------------------------------------------------------------- 06900O E 82 06910O PJACNT 17 06920O TMODL 29 06930O TDESC 69 06940O TBSD 75 06950O TBCD 81 06960O TBLH 85P 06970O TB$ 93P 06980O TASD 99 06990O TACD 105 07000O PJALH 109P ÐÐ07010O PA$ 119P 07020O TLPCT 121P 07030O******** TMPCT 123P 07040O PJCLH 127P 07050O PC$ 137P 07060O PT$ 147P 07070O PJSTAT 170 07080O******************************************************************** 07090OTERM132 E 71 07100O UDATE Y 8 07110O 54 'PROJECT WORK ORDER' 07120O 56 '-' 07130O 74 'ENGINEERING UPDATE' 07140O*------------------------------------------------------------------- 07150O E 71 07160O 1 ' ' 07170O*------------------------------------------------------------------- 07180O E 71 07190O OR 72 01 07200O 15 '(1) TRAN CODE' 07210O 19 ':' 07220O TTCODE 22 07230O 60 27 'ADD' 07240O 61 30 'CHANGE' 07250O 62 30 'DELETE' ÐÐ07260O*------------------------------------------------------------------- 07270O E 71 07280O OR 72 02 07290O 18 '(2) ORDER-NUMBER' 07300O 19 ':' 07310O TPRIM 27 07320O 28 '-' 07330O TDASH 31 07340O*------------------------------------------------------------------- 07350O E 71 07360O OR 72 03 07370O 16 '(3) DEPARTMENT' 07380O 19 ':' 07390O TDEPT Z 24 07400O DEPNAM 44 07410O*------------------------------------------------------------------- 07420O E 71 07430O OR 72 04 07440O 19 '(4) MODEL-NUMBER:' 07450O TMODL 33 07460O*------------------------------------------------------------------- 07470O E 71 07480O OR 72 05 07490O 19 '(5) DESCRIPTION :' 07500O TDESC 61 ÐÐ07510O*------------------------------------------------------------------- 07520O E 71 07530O 1 ' ' 07540O*------------------------------------------------------------------- 07550O E 71 07560O 25 'START' 07570O 43 'COMPLETE' 07580O 61 'LABOR' 07590O 80 'LABOR' 07600O 104 'MATERIAL' 07610O*------------------------------------------------------------------- 07620O E 71 07630O 24 'DATE' 07640O 41 'DATE' 07650O 60 'HRS' 07660O 78 '$' 07670O 100 '$' 07680O*------------------------------------------------------------------- 07690O E 71 07700O 1 ' ' 07710O*------------------------------------------------------------------- 07720O E 71 07730O OR 72 06 07740O OR 72 07 07750O OR 72 08 ÐÐ07760O OR 72 09 07770O OR 72 10 07780O 6 'BUDGET' 07790O 11 ':' 07800O 16 '(6)' 07810O TBSD 25 ' - - ' 07820O 34 '(7)' 07830O TBCD 43 ' - - ' 07840O 52 '(8)' 07850O TBLH 2 62 07860O 74 '(9)' 07870O TB$,1 2 84 07880O 98 '(10)' 07890O TB$,2 2 108 07900O*----------------------------------------------------------------- 07910O E 71 07920O 1 ' ' 07930O*------------------------------------------------------------------ 07940O E 71 07950O 6 'ACTUAL' 07960O*----------------------------------------------------------------- 07970O E 71 07980O OR 72 11 07990O OR 72 12 08000O 9 'SCHEDULE' ÐÐ08010O 11 ':' 08020O 16 '(11)' 08030O TASD 25 ' - - ' 08040O 34 '(12)' 08050O TACD 43 ' - - ' 08060O E 71 08070O 9 'BAL-FRWD' 08080O 11 ':' 08090O PJALH J 65 08100O PA$,1 J 88 08110O PA$,2 J 112 08120O*------------------------------------------------------------------- 08130O E 71 08140O OR 72 13 08150O OR 72 14 08160O OR 72 15 08170O 11 'CUR-MONTH:' 08180O****** 52 '(13)' 08190O PJCLH J 65 08200O****** 74 '(14)' 08210O PC$,1 J 88 08220O****** 98 '(15)' 08230O PC$,2 J 112 08240O*-------------------------------------------------------------- 08250O E 71 ÐÐ08260O 6 'TOTAL' 08270O 11 ':' 08280O TOTHR J 65 08290O TOT,1 J 88 08300O TOT,2 J 112 08310O*------------------------------------------------------------------- 08320O E 71 08330O 1 ' ' 08340O*------------------------------------------------------------------- 08350O E 71 08360O 8 'VARIANCE' 08370O 11 ':' 08380O THRVARJ 65 08390O VAR,1 J 88 08400O VAR,2 J 112 08410O*------------------------------------------------------------------- 08420O E 71 08430O 1 ' ' 08440O*------------------------------------------------------------------- 08450O E 71 08460O OR 72 18 08470O OR 72 19 08480O 19 '% COMPLETE (LABOR)' 08490O 20 ':' 08500O 26 '(18)' ÐÐ08510O TLPCT Z 32 08520O 34 '%' 08530O****** 98 '(19)' 08540O****** TMPCT Z 102 08550O****** 103 '%' 08560O*------------------------------------------------------------------- 08570O E 71 08580O 1 ' ' 08590O*------------------------------------------------------------------- 08600O E 73 08610O MGTEXT 35 08620O 96 47 '**********' 08630O* ** A40 ARRAY 008640 008650** LOC ARRAY 008660004023 1 008670005023 2 008680006023 3 008690007023 4 008700008023 5 008710013019 6 008720013037 7 008730013055 8 008740013077 9 008750ÐÐ013101 10 008760016019 11 008770016037 12 008780017057 13 NOT USED 008790018077 14 NOT USED 008800018101 15 NOT USED 008810021077 16 NOT USED 008820021101 17 NOT USED 008830023031 18 008840023033 19 NOT USED 008850** NUM ARRAY 008860003 008870006 008880007 008890008 008900009 008910010 008920011 008930012 008940013 008950014 008960015 008970016 008980017 008990018 009000ÐÐ019 009010** DUN ARRAY 009020 009030** MES ARRAY 009040---MESSAGE NOT ON FILE--- 009050** TB$ ARRAY 009060 009070** VAR ARRAY 009080 009090** TOT ARRAY 009100 009110/* 009120_‚ ÐÐ_‚_‚ 009010** DUN ARRAY 009020 009030** MES ARRAY 009040---MESSAGE NOT ON FILE--- 009050** TB$ ARRAY 009060 009070** VAR ARRAY 009080 009090** TOT ARRAY 009100 009110/* 009120_‚ ÐÈ(Üs› ÜqX032BM P'( 999999120282(èÈÐ00010H Q032BM00020F* INDENTED/COSTED BILL MATERIAL LIST (X032BM) 00030F* REVISED 12/10/82 10:45 AM. *** D I A B L O *** 00040F* SWITCH-1 CONDITIONS WHERE-USED OUTPUT 00050F* SWITCH-2 CONDITIONS INDENTED PARTS LIST OUTPUT 00060F* SWITCH-3 BYPASSES PRINTING OF NON-ASSYS (SC NOT 'M') 00070F* WITH NO LABOR-- THEY ARE INCLUDED IN TOTALS. 00080FBITHEX IP F 256 DISK 00090FCRTFILE UC F 256R DISK 00100FSUSPENSEUD F 128L29AI 1 DISK 00110FPMMST2 IC F 674R12AI 1 DISK 00120FBMMAST ID F 86L20AI 1 DISK 00130FMGFILE IC F 80R DISK 00140FPURCHWU O F 132 DISK U1 00150FLABRATE IT F 80 EDISK 00160FEMPLFILEIC F 64R14AI 1 DISK 00170FMENUDEPTIT F 25 EDISK 00180FACDEPT IT F 80 EDISK 00190E******************************************************************** 00200E LABRATE TABDEP 1 11 5 0 TABRAT 9 LABOR RATES 00210E MENUDEPT TABDPT 1 10 5 0 TABNAM 20 DEPT NAMES 00220E ACDEPT TAB1 1 25 3 0 TAB2 3 0 ACCT DEPT CONV. 00230E A12 12 12 1 A INPUT ARRAY. 00240E LEV 1 20 20 NEXT RRN AT EA LEVEL 00250E QTY 1 20 7 0 QTY MULTIPLIER ÐÐ00260E A29 29 29 1 00270E DOL 1 20 10 3 00280E DASH 1 41 3 00290E MC 1 1 15 00300E DEP 1 25 3 0A 00310E HRS 1 25 7 3 00320E TOT 1 25 7 3 00330E HRA 1 20 5 3 00340E HRT 1 20 5 3 00350E HRQ 1 20 5 3 00360E BIT 256 1 BITHEX. 00370E APN 8 10 0A 00380E QAR 8 3 0 00390E REC 168 1 00400E MHR 12 7 3 MFG HRS, PMMST2 00410E MDP 12 3 0A MFG DEPTS,PMMST2 00420I******************************************************************** 00430IBITHEX BT 00440I 1 256 BIT 00450I******************************************************************** 00460ICRTFILE CR 00470I* EMPLOYEE # 5N 00480I 1 50CREMPL 00490I* DEPT # 5N 00500I 14 180CRDEPT ÐÐ00510I 81 248 REC 00520I******************************************************************** 00530IEMPLFILEEE 00540I 23 42 EENAME 00550I******************************************************************** 00560ISUSPENSESP 00570I* SUSPENSE FILE (CONTAINS ASSY PART NO'S.) 00580I* KEY AREA. 00590I* TERMINAL # 2N (NOT USED) 00600I* 1 2 00610I* RECORD CODE 2A (CP) 00620I 3 4 SPREC 00630I* RECORD COUNTER 3N 00640I 5 70SPCNTR 00650I* REQUESTING DEPT 5N 00660I 8 120SPDEPT 00670I* EMPLOYEE # 5A 00680I 13 17 SPEMPL 00690I* FILLER 18 29 FFFFFF 00700I* ASSY PART # 10N X 8 00710I 30 109 APN 00720I* QTY MULTIPLIER 3P X 8 00730I P 110 125 QAR 00740I* RECORD STATUS 1A 00750I 128 128 SPSTAT ÐÐ00760I******************************************************************** 00770IPMMST2 PM 00780I* PART MASTER RECORD. 00790I* KEY AREA 00800I* PART NO. 12A 00810I 1 12 PMPN 00820I* NUMB OF COMPONENTS 3P 00830I P 13 140PMNOBM 00840I* PROD LINE 4N 00850I 15 180PMPL 00860I* MODEL NAME 12A 00870I 19 30 PMMODL 00880I* DESCRIPTION 29A 00890I 31 59 PMDESC 00900I* COMMODITY CODE 9P 00910I P 60 640PMCC 00920I* ENG CHANGE STATUS. 00930I* CUR CHG LEVEL 2A 00940I 70 71 PMECHG 00950I* CUR CHG DATE 6N 00960I 72 770PMDCHG 00970I* LAST ECN NO. 5A 00980I 65 69 PMECN 00990I* DRAWING INFO 01000I* DWG SIZE 1A ÐÐ01010I 82 82 PMSIZ 01020I* DWG CLASS 1A 01030I* D = DYNAIR DWG 01040I* V = VENDOR DWG 01050I 83 83 PMDCLS 01060I* STANDARD CODE 1A 01070I 84 84 PMSTDC 01080I* DWG REL CODE 1A 01090I* E = ENG ONLY 01100I* M = REL TO MFG 01110I* P = PROTOTYPE 01120I 78 78 PMDREL 01130I* UNIT MEAS 2A 01140I* EA = EACH OC = OUNCE 01150I* ST = SET TC = TROY OUNCE 01160I* IN = INCH LB = POUND 01170I* FT = FEET PT = PINT 01180I* YD = YARD QT = QUART 01190I* SI = SQ.INCH GL = GALLON 01200I* SF = SQ.FEET DR = DRUM 01210I* SY = SQ.YARD 01220I 85 86 PMUM 01230I* SOURCE CODE 2A 01240I* MA = MFG ASSY 01250I* MP = MFG PART ÐÐ01260I* PA = PURCH ASSY 01270I* PP = PURCH PART 01280I* RS = RAW STOCK 01290I* RD = REF DOCUMENT 01300I 94 95 PMSC 01310I* PROVISIONING CODE 1A 01320I* A = FORECAST,NO VALUE ADDED 01330I* B = FORECAST,VALUE ADDED 01340I* C = FRCST-BUILD TO ORDER 01350I* D = NON-FRCST-BUILD TO ORDER 01360I* E = CUSTOM 01370I* Y = OBSOLETE,REPAIRABLE 01380I* Z = OBSOLETE,NOT REPAIRABLE 01390I 96 96 PMPROV 01400I* ISSUE CODE 2A 01410I* PT = PULL TIME 01420I* OR = ON REQUEST 01430I* BI = BULK ISSUE 01440I* AR = AS REQUIRED 01450I* VS = VENDOR SUPPLIED 01460I* SD = SHIPPING DOCUMENT 01470I* TD = TRAV DOCUMENT 01480I* RD = REF DOCUMENT 01490I* RA = REF ASSY 01500I 97 98 PMISSU ÐÐ01510I* DELIVER TO DEPT 5P 01520I P 99 1010PMDEL 01530I* RESPONSIBILITY CODES 01540I* ENGR CODE 2A 01550I 102 103 PMEGR 01560I* PLANNER CODE 2A 01570I 104 105 PMPLNR 01580I* BUYER CODE 2A 01590I 106 107 PMBUYR 01600I* SALESMAN CODE 2A 01610I 108 109 PMSLSM 01620I* INVENTORY ACCOUNT 5P 01630I P 110 1120PMACNT 01640I* MFG UNIT COST 9.3P 01650I P 615 6193PMTCST 01660I* MFG ROUTING HRS 12X7.3P 01670I P 543 590 MHR 01680I* MFG ROUTING DEPTS 12 X 3P 01690I P 591 614 MDP 01700I* FAB CODE 2A 01710I 487 488 PMFABC 01720I* RECORD STATUS 1A 01730I* D = DELETED 01740I 674 674 PMSTAT 01750I******************************************************************** ÐÐ01760IBMMAST BM 01770I* BILL OF MATERIAL RECORD 01780I* KEY AREA 01790I* ASSY PART NO. 10N 01800I 1 100BMAPN 01810I* COMPONENT PART # 10N 01820I 11 200BMCPN 01830I* ITEM NO. 3N 01840I 25 270BMITNO 01850I* QTY PER ASSY 7P 01860I P 28 310BMQTY 01870I* SCRAP ALLOW .2N 01880I 34 352BMSCRP 01890I* ISSUE CODE 2A 01900I* PT = PULL TIME 01910I* OR = ON REQUEST 01920I* BI = BULK ISSUE 01930I* AR = AS REQUIRED 01940I* RA = REF ASSY 01950I* TD = TRAV DOC 01960I* SD = SHIP DOC 01970I* RD = REF DOC 01980I* VS = VENDOR SUPPLIED 01990I 36 37 BMISSU 02000I* EFFECTIVITY. ÐÐ02010I* BEGIN CHANGE LEVEL 2A 02020I 38 39 BMBCHG 02030I* ENDING CHANGE LEVEL 2A 02040I 40 41 BMECHG 02050I* BEGIN ECN # 5A 02060I 42 46 BMBECN 02070I* ENDING ECN # 5A 02080I 47 51 BMEECN 02090I* DISPOSITION CODE 1A 02100I* U = USE UP OLD STYLE 02110I* N = NOW (IMMEDIATE) 02120I 52 52 BMDISP 02130I* FILLER 5A 53 57 FFFFFF 02140I* ROUTING. 02150I* OPER NO. 5P 02160I P 58 600BMOPER 02170I* DEPT NO. 5P 02180I P 61 630BMDEPT 02190I* WORK CENTER NO. 3P 02200I P 64 650BMWC 02210I* COMPONENT OPER REFERENCE INFO 10A 02220I 66 75 BMREF 02230I* FILLER 10A 76 85 FFFFFF 02240I* 02250I* RECORD STATUS 1A ÐÐ02260I* D = DELETED 02270I 86 86 BMSTAT 02280I******************************************************************** 02290IMGFILE MG 02300I* MESSAGE FILE. 02310I* TEXT 35A 02320I 1 35 MGTEXT 02330I* LINE-2 35A 02340I 36 70 MGLIN2 02350I* PROG NAME 5A 02360I 71 75 MGPROG 02370C******************************************************************** 02380C* INITIALIZE 02390C EXSR SR101 INIT 02400C H9 GOTO ENDJOB PROG ERROR 02410C Z-ADD0 ZERO10 100 STUPIDITY 02420C Z-ADD0 TTCOST 103 02430C*---------------------------------------------------------------- 02440C START TAG 02450C* GET NEXT SUSPENSE RECORD. 02460C MOVE ' ' A29 02470C MOVEA'CP' A29,3 02480C MOVEAA29 W29A 29 02490C*------------------------------------------------------------------- 02500C TAG5 TAG ÐÐ02510C W29A SETLLSUSPENSE 02520C*------------------------------------------------------------------- 02530C TAG6 TAG 02540C Z-ADD0 EGAP 40 PAGE # 02550C Z-ADD0 DOL 02560C Z-ADD0 HRS 02570C Z-ADD0 HRA 02580C Z-ADD0 HRT 02590C Z-ADD0 HRQ 02600C Z-ADD0 TCOST 103 02610C Z-ADD0 LABMAT 103 02620C SETOF 54 02630C READ SUSPENSE 54 02640C 54 GOTO ENDJOB END OF FILE 02650C SPREC COMP 'CP' 54 02660C N54 GOTO ENDJOB WRONG REC CODE 02670C SPSTAT COMP 'D' 54 02680C 54 GOTO TAG6 PREV PROCESSED 02690C ZERO10 LOKUPAPN 54 02700C N54 GOTO TAG7 NO ASSY PART # 02710C EXSR SR77 TITLE PAGE 02720C*------------------------------------------------------------------- 02730C TAG7 TAG 02740C* GET NEXT ASSY PART # IN SUSPENSE RECORD. 02750C Z-ADD1 C 30 ÐÐ02760C ZERO10 LOKUPAPN,C 54 02770C N54 EXSR SR78 UPDATE SUSPENSE 02780C N54 GOTO TAG6 GET NEXT RECKORD 02790C Z-ADDAPN,C ASSYPN 100 NEW TOP ASSY 02800C Z-ADD0 APN,C 02810C QAR,C COMP 0 54 02820C N54 Z-ADD1 QAR,C EXTEND BY QTY 02830C MOVE BLK12 W12A 02840C MOVELASSYPN W12A 02850C EXSR SR81 GET PMMST. 02860C N60 GOTO TAG10 GOT IT 02870C Z-ADD302 M 96 FLAG ERROR 02880C EXSR SR73 PUT MSG 02890C GOTO TAG7 02900C*-------------------------------------------------------------------- 02910C TAG10 TAG 02920C* FLAG NO COMPONENTS ON FILE 02930C PMNOBM COMP 0 55 02940C N55 Z-ADD316 M 50 02950C N55 EXSR SR73 PUT ERR MSG 02960C N55 GOTO TAG7 02970C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02980C Z-ADDPMAHRS HRA,1 02990C Z-ADDPMTHRS HRT,1 03000C Z-ADDPMQHRS HRQ,1 ÐÐ03010C Z-ADDPMAHRS HOURS 73 54 03020C 54 Z-ADDPMADEP DEPT 30 03030C 54 EXSR SR203 CUM HRS 03040C Z-ADDPMTHRS HOURS 54 03050C 54 Z-ADDPMTDEP DEPT 03060C 54 EXSR SR203 CUM HRS 03070C Z-ADDPMQHRS HOURS 54 03080C 54 Z-ADDPMQDEP DEPT 03090C 54 EXSR SR203 CUM HRS 03100C Z-ADDQAR,C QTY,2 QTY MULTIPLIER 03110C SETON 89 03120C EXSR SR71 PUT HEADING 03130C SETOF 89 03140C* SET-UP INITIAL BILL MATERIAL READ 03150C Z-ADD3 L 20 INDENTURE LEVEL 03160C MOVE BLK20 LEV 03170C MOVELASSYPN LEV,2 03180C*----------------------------------------------------------------- 03190C TAG20 TAG 03200C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 03210C L SUB 1 L 54 INDENT LEVEL 03220C N54 GOTO ENDASY BOTTOM INDENT 03230C LEV,L COMP BLK20 54 03240C N54 GOTO TAG20 NONE THIS LEVEL 03250C MOVE LEV,L W20A 20 ÐÐ03260C MOVELLEV,L CURASY 100 MATCH PART # 03270C MOVE BLK20 LEV,L 03280C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 03290C*------------------------------------------------------------------ 03300C TAG30 TAG 03310C* SET-UP NEXT READ 03320C W20A SETLLBMMAST 03330C*--------------------------------------------------------------- 03340C TAG40 TAG 03350C* GET NEXT COMPONENT. 03360C SETOF 30 03370C READ BMMAST 30GET COMPONENT 03380C 30 GOTO ENDLEV END OF FILE 03390C BMAPN COMP CURASY 30 03400C N30 GOTO ENDLEV WRONG ASSY 03410C BMSTAT COMP 'D' 54 03420C 54 GOTO TAG40 DELETED RECORD 03430C* DISPLAY COMPONENT DATA 03440C EXSR SR72 DISPLAY DATA 03450C* BRANCH IF NOT ASSY 03460C PMNOBM COMP 0 30 03470C EXSR SR68 CHECK END PAGE 03480C N30 GOTO TAG40 NOT ASSY 03490C*------------------------------------------------------------------ 03500C TAG50 TAG ÐÐ03510C* SAVE CUR LEVEL ASSY/COMPONENT PART # 03520C MOVELBMAPN LEV,L 03530C 1 ADD BMCPN W10N 100 03540C MOVE W10N LEV,L 03550C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 03560C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 03570C MOVE BMCPN CURASY 03580C MOVELBMCPN W20A 03590C MOVE ZERO10 W20A 03600C 1 ADD L L INDENT LEVEL 03610C GOTO TAG30 03620C*-------------------------------------------------------- 03630C ENDLEV TAG 03640C Z-ADDL SAVEL 30 03650C EXSR SR202 03660C L SUB 1 L 03670C EXSR SR80 ASSY MATL TOTAL 03680C Z-ADDSAVEL L 03690C EXSR SR68 CHECK END PAGE 03700C GOTO TAG20 03710C*------------------------------------------------------------------ 03720C ENDASY TAG 03730C* END OF ASSY PROMPT 03740C EXSR SR76 END ASSY PROMPT 03750C GOTO TAG7 ÐÐ03760C*------------------------------------------------------------------ 03770C ENDJOB TAG 03780C Z-ADDTTCOST LABMAT 03790C Z-ADDTOT HRS 03800C EXSR SR201 LF 03810C EXSR SR201 LF 03820C SETON 85 GRAND TOT LEG 03830C EXSR SR69 03840C EXSR SR201 LF 03850C SETON 86 FINAL MAT COST 03860C EXSR SR69 03870C EXSR SR201 LF 03880C EXSR SR213 LABOR TOTALS 03890C U2 EXSR SR67 TOP FORM 03900C******************************************************************** 03910CSR SR67 BEGSR 03920C* TOP OF FORM. 03930CSR EXITFZTFORM 03940CSR Z-ADD4 COUNT 30 LINE COUNT 03950CSR 1 ADD EGAP EGAP 40 PAGE # 03960CSR ENDSR 03970C******************************************************************** 03980CSR SR68 BEGSR 03990C* CHECK FOR END OF PAGE 04000CSR COUNT COMP 70 54 54 ÐÐ04010CSR 54 EXSR SR71 PUT HEADINGS 04020CSR END68 ENDSR 04030C******************************************************************** 04040CSR SR69 BEGSR 04050C* PUT DATA TO DIABLO. 04060CSR EXSR SR201 LF 04070CSR PORT CHAINCRTFILE H9 04080CSR H9 GOTO END69 04090CSR MOVE ' ' REC 04100CSR EXCPT UPDATE CRTFILE 04110CSR PORT CHAINCRTFILE H9 04120CSR H9 GOTO END69 04130CSR U2 MOVEAREC W180A 180 04140CSR U2 EXITFZD180 PUT DIABLO 04150CSR RLABL W180A 04160C*------------------------------------------------------------------- 04170CSR END69 TAG 04180CSR SETOF 727587 04190CSR SETOF 414243 04200CSR SETOF 737185 04210CSR SETOF 798084 04220CSR SETOF 828386 04230CSR SETOF 77 04240CSR ENDSR 04250C******************************************************************** ÐÐ04260CSR SR71 BEGSR 04270C* CLEAR CRT. PUT HEADINGS. 04280CSR MOVELASSYPN W12A 12 04290CSR MOVE ' ' W12A 04300CSR EXSR SR81 GET TOP-ASSY PMMST2 04310CSR MOVE PMDESC TOPDES 29 04320CSR MOVE PMMODL TOPMOD 12 04330CSR EXSR SR67 TOP OF FORM 04340CSR SETON 41 04350CSR EXSR SR69 PUT HEADING 04360CSR SETON 42 04370CSR EXSR SR69 PUT HEADING 04380CSR SETON 43 04390CSR EXSR SR69 PUT HEADING 04400CSR EXSR SR201 LINE FEED 04410CSR SETON 75 04420CSR EXSR SR69 PUT TOP ASSY 04430CSR END71 ENDSR 04440C******************************************************************** 04450CSR SR72 BEGSR 04460C* DISPLAY COMPONENT DATA LINE TO CRT. 04470CSR MOVE BLK12 W12A 04480CSR MOVELBMCPN W12A COMP PN 04490CSR EXSR SR81 GET PMMST2 04500CSR EXSR SR202 IDENTIFY LEVEL ÐÐ04510CSR BMISSU COMP ' ' 55 04520CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 04530CSR EXSR SR102 COMPUTE COSTS 04540C* CUM CURRENT ITEM HOURS AT CURRENT INDENT LEVEL 04550C* AND PUT ITEM TO DIABLO. 04560CSRNU3 SETON 33 NO SWITCH-3 04570CSR U3 PMNOBM COMP 0 33 COMPONENTS=YES 04580CSRN33 U3 PMAHRS COMP 0 33 ASSY HRS 04590CSRN33 U3 PMTHRS COMP 0 33 TEST HRS 04600CSRN33 U3 PMQHRS COMP 0 33 Q.C. HRS 04610CSRN33 U3 MOVELPMSC W1A 1 04620CSRN33 U3 W1A COMP 'M' 33MFG PART 04630CSR 33 SETON 72 04640CSR 33 EXSR SR69 PUT DATA. 04650CSR Z-ADDL X 30 SAVE IND LEVEL 04660CSR Z-ADDL A 30 SAVE IND LEVEL 04670CSR PMNOBM COMP 0 32 COMPONENTS=YES 04680CSR 33 SETON 31 04690CSR 33N59 EXSR SR103 CUM HRS IF NOT KMP 04700CSR SETOF 31 04710C*------------------------------------------------------------- 04720CSR T72A TAG 04730C* CUM CURRENT ITEM COST/HRS AT ALL HIGHER LEVELS. 04740CSR X SUB 1 X 54 04750CSRN54 GOTO END72 ÐÐ04760CSR LEV,X COMP BLK20 54 04770CSRN54 GOTO T72A 04780CSR 58 COST ADD DOL,X DOL,X CUM MATL COST 04790CSR Z-ADDX A 30 04800CSR 33N59 EXSR SR103 CUM HRS IF NOT MP 04810CSR GOTO T72A 04820C*--------------------------------------------------------------- 04830CSR END72 TAG 04840CSR SETOF 3132 04850CSR Z-ADD0 AHRS 04860CSR Z-ADD0 THRS 04870CSR Z-ADD0 QHRS 04880CSR ENDSR 04890C******************************************************************** 04900CSR SR73 BEGSR 04910C* PUT MESSAGE TO DIABLO 04920CSR EXSR SR89 04930CSR 54 MOVELM MGTEXT 04940CSR U2 EXSR SR201 LF 04950CSR SETON 73 04960CSR EXSR SR69 PUT MSG. 04970CSR SETOF 73 04980CSR U2 EXSR SR201 LF 04990CSR END73 ENDSR 05000C******************************************************************** ÐÐ05010CSR SR76 BEGSR 05020C* END OF ASSY PROMPT/READ. 05030CSR EXSR SR67 TOP FORM 05040CSR EXSR SR201 LINE FEED 05050CSR SETON 41 05060CSR EXSR SR69 PUT PAGE HEADING 05070CSR U2 EXSR SR201 LF 05080CSR U2 EXSR SR201 LF 05090CSR Z-ADDTCOST LABMAT 05100CSR SETON 79 05110CSR EXSR SR69 TOT MATL COST 05120CSR SETOF 79 05130CSR U2 EXSR SR201 LF 05140CSR U2 EXSR SR201 LF 05150CSR EXSR SR213 PRT HRS TOT 05160CSR Z-ADD317 M 05170CSR EXSR SR73 PUT MSG. 05180CSR END76 ENDSR 05190C******************************************************************** 05200CSR SR77 BEGSR 05210C* PRINT TITLE PAGE. 05220CSR EXSR SR67 TOP FORM 05230CSR MOVE ' ' A29 05240CSR MOVE 'E' A29,1 05250CSR MOVEASPEMPL A29,2 ÐÐ05260CSR MOVEAA29 W14A 14 05270CSR W14A CHAINEMPLFILE 60 05280CSR 60 GOTO END77 05290CSR SPDEPT LOKUPTABDPT TABNAM 54 05300CSR MOVELTABNAM DEPNAM 20 05310CSR SETON 77 05320CSR EXSR SR69 PRINT 05330CSR END77 ENDSR 05340C******************************************************************** 05350CSR SR78 BEGSR 05360C* UPDATE SUSPENSE FILE. 05370CSR SETON 78 05380CSR EXCPT 05390CSR SETOF 78 05400CSR ENDSR 05410C******************************************************************** 05420CSR SR80 BEGSR 05430C* PUT MATL COST FOR ASSY. 05440CSR Z-ADD403 M 05450CSR EXSR SR89 05460CSR MOVEAMGTEXT MC 05470CSRNU2 Z-ADD0 DOL,L 05480CSRNU2 Z-ADD0 HRA,L 05490CSRNU2 Z-ADD0 HRT,L 05500CSRNU2 Z-ADD0 HRQ,L ÐÐ05510CSR U2 L COMP 2 54 05520CSR U2 54 HRA,L ADD HRA,1 HRA,1 05530CSR U2 54 HRT,L ADD HRT,1 HRT,1 05540CSR U2 54 HRQ,L ADD HRQ,1 HRQ,1 05550CSR U2 54 DOL,L ADD DOL,1 DOL,1 05560CSR U2 SETON 80 05570CSR U2 EXSR SR69 ASSY MATL COST 05580CSR U2 EXSR SR201 LF 05590CSR END80 ENDSR 05600C******************************************************************** 05610CSR SR81 BEGSR 05620C* GET PART MAST. 05630CSR SETOF 61 05640CSR W12A CHAINPMMST2 60 GET PMMST. 05650CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 05660CSR Z-ADD0 PMTDEP 30 05670CSR Z-ADD0 PMTHRS 73 05680CSR Z-ADD0 PMQDEP 30 05690CSR Z-ADD0 PMQHRS 73 05700CSR Z-ADD0 PMADEP 30 05710CSR Z-ADD0 PMAHRS 73 05720CSR 60 05730COR 61 GOTO END81 05740CSR Z-ADD1 E 30 05750C*------------------------------------------------------------------- ÐÐ05760CSR T81A TAG 05770CSR 000 LOKUPMDP,E 54 05780CSR 54 MHR,E COMP 0 54 05790CSRN54 GOTO END81 05800CSR MDP,E LOKUPTAB1 TAB2 54 05810CSRN54 GOTO T81C 05820CSR TAB2 COMP 420 54 05830CSR TAB2 COMP 440 55 05840CSR TAB2 COMP 460 56 05850CSR 54 MHR,E ADD PMAHRS PMAHRS 05860CSR 54 Z-ADD420 PMADEP 05870CSR 55 MHR,E ADD PMTHRS PMTHRS 05880CSR 55 Z-ADD440 PMTDEP 05890CSR 56 MHR,E ADD PMQHRS PMQHRS 05900CSR 56 Z-ADD460 PMQDEP 05910C*------------------------------------------------------------------- 05920CSR T81C TAG 05930CSR 1 ADD E E 05940CSR E COMP 12 54 05950CSRN54 GOTO T81A 05960CSR END81 ENDSR 05970C******************************************************************** 05980CSR SR89 BEGSR 05990C* GET MGFILE. 06000CSR M CHAINMGFILE 54 GET MGFILE. ÐÐ06010CSR 54 MOVE BLK35 MGTEXT 06020CSR 54 MOVELM MGTEXT 06030CSR 54 MOVE 'NO MSG' MGTEXT 06040CSR ENDSR 06050C******************************************************************** 06060CSR SR101 BEGSR 06070C* INITIALIZE (1-TIME). 06080CSR MOVE '-' DASH 06090CSR MOVE ' ' BLK35 35 06100CSR MOVE ' ' BLK12 12 06110CSR MOVE ' ' BLK20 20 06120CSR Z-ADD0 ZERO3 30 06130CSR Z-ADD0 DEP 06140CSR Z-ADD0 HRS 06150CSR Z-ADD0 HRA 06160CSR Z-ADD0 HRT 06170CSR Z-ADD0 HRQ 06180CSR Z-ADD999 DEP,25 06190CSR MOVE BLK20 LEV 06200CSR Z-ADD0 DOL 06210CSR Z-ADD0 ZERO10 100 06220C* SET-UP 15-PITCH. 06230CSR MOVE '15' W2A 2 06240CSR EXITFZHMI HORIZ SPACING 06250CSR RLABL W2A ÐÐ06260CSR MOVE '10' W2A 06270CSR EXITFZVMI VERTICAL SPACING 06280CSR RLABL W2A 06290C* GET PORT # AND CRTFILE. 06300CSR MOVE ' ' W8A 8 06310CSR Z-ADD0 W2N 20 06320CSR Z-ADD0 W1N 10 06330CSR MOVE ' ' W2A 2 06340CSR EXITFPGMINX GET PORT #. 06350CSR RLABL W8A 06360CSR RLABL W2N 06370CSR RLABL W1N 06380CSR RLABL W2A 06390CSR MOVE W2A PORT 20 PORT NO. 06400CSR PORT COMP 0 54 06410CSRN54 Z-ADD25 PORT DEFAULT 06420CSR PORT CHAINCRTFILE H9 06430CSR H9 GOTO END101 06440CSR MOVE ' ' REC 06450CSR SETON 71 06460CSR EXCPT 06470CSR SETOF 71 06480CSR END101 ENDSR 06490C******************************************************************** 06500CSR SR102 BEGSR ÐÐ06510C* COMPUTE HRS/COSTS. 06520CSR MOVELPMSC W1A 06530CSR W1A COMP 'P' 58 06540CSR PMSC COMP 'MP' 59 06550CSR 59 SETON 58 06560CSR 58 EXTQTY MULT PMTCST COST 93H ITEM COST,MATL 06570C* EXTEND ASSY LABOR TOTALS - HOURS. 06580CSR EXTQTY MULT PMAHRS AHRS 53H ASSY 06590CSR EXTQTY MULT PMTHRS THRS 53H TEST 06600CSR EXTQTY MULT PMQHRS QHRS 53H Q.C. 06610C* MATL COST TOTALS. 06620CSR 58 COST ADD TCOST TCOST 103 ASSY MATL COST 06630CSR 58 COST ADD TTCOST TTCOST 103 GRAND TOT MATL $ 06640C* CUM ASSY TOTALS LABOR HRS. 06650CSRN59 AHRS ADD TOTAHR TOTAHR 53 ASSY 06660CSRN59 THRS ADD TOTTHR TOTTHR 53 TEST 06670CSRN59 QHRS ADD TOTQHR TOTQHR 53 Q.C. 06680CSR ENDSR 06690C******************************************************************** 06700CSR SR103 BEGSR 06710C* CUM HOURS. 06720CSR PMADEP COMP 0 54 06730CSR 54 31 32 06740COR 54N31 AHRS ADD HRA,A HRA,A 06750CSR 54 31 Z-ADDPMADEP DEPT 30 ÐÐ06760CSR 54 31 Z-ADDAHRS HOURS 73 06770CSR 54 31 EXSR SR203 06780CSR PMTDEP COMP 0 54 06790CSR 54 31 32 06800COR 54N31 THRS ADD HRT,A HRT,A 06810CSR 54 31 Z-ADDPMTDEP DEPT 06820CSR 54 31 Z-ADDTHRS HOURS 06830CSR 54 31 EXSR SR203 06840CSR PMQDEP COMP 0 54 06850CSR 54 31 32 06860COR 54N31 QHRS ADD HRQ,A HRQ,A 06870CSR 54 31 Z-ADDPMQDEP DEPT 06880CSR 54 31 Z-ADDQHRS HOURS 06890CSR 54 31 EXSR SR203 06900CSR SETOF 31 06910CSR ENDSR 06920C*************************************************************** 06930CSR SR201 BEGSR 06940C* LINE FEED 06950CSR U2 EXITFQCLF LF ONLY 06960CSR U2 1 ADD COUNT COUNT 30 LINE COUNTER 06970CSR ENDSR 06980C************************************************************ 06990CSR SR202 BEGSR 07000C* IDENTIFY INDENTURE LEVEL. ÐÐ07010CSR L COMP 1 0101 07020CSR L COMP 2 02 07030CSR L COMP 3 03 07040CSR L COMP 4 04 07050CSR L COMP 5 05 07060CSR L COMP 6 06 07070CSR L COMP 7 07 07 07080CSR 01 Z-ADD1 L 07090CSR ENDSR 07100C******************************************************************** 07110CSR SR203 BEGSR 07120C* SAVE HOURS. 07130CSR Z-ADD1 H 30 07140CSR DEPT COMP 0 54 07150CSRN54 Z-ADD999 DEPT 07160CSR DEPT LOKUPDEP,H 54 07170CSRN54 ZERO3 LOKUPDEP,H 54 07180CSRN54 Z-ADD999 DEPT 07190CSRN54 GOTO SR203 07200CSR Z-ADDDEPT DEP,H 07210CSR HOURS ADD HRS,H HRS,H 07220CSR ENDSR 07230C******************************************************************** 07240CSR SR212 BEGSR 07250C* SORT DEPTS FOR HRS OUTPUT. ÐÐ07260CSR Z-ADD0 Z 30 07270C*------------------------------------------------------------------- 07280CSR T212A TAG 07290CSR 1 ADD Z Z 07300CSR Z COMP 25 54 07310CSR 54 GOTO END212 07320CSR Z-ADDZ Y 30 07330CSR SETOF 56 07340C*------------------------------------------------------------------- 07350CSR T212B TAG 07360CSR 1 ADD Y Y 07370CSR Y COMP 25 54 07380CSR 54 56 GOTO T212A 07390CSR 54 GOTO END212 07400CSR DEP,Y COMP 0 54 07410CSRN54 GOTO T212B 07420CSR SETON 56 07430CSR DEP,Z COMP DEP,Y 54 07440CSRN54 DEP,Z COMP 0 55 07450CSRN54N55 GOTO T212B 07460CSR Z-ADDDEP,Z DEPT 07470CSR Z-ADDHRS,Z HOURS 07480CSR Z-ADDTOT,Z TOTTOT 73 07490CSR Z-ADDDEP,Y DEP,Z 07500CSR Z-ADDHRS,Y HRS,Z ÐÐ07510CSR Z-ADDTOT,Y TOT,Z 07520CSR Z-ADDDEPT DEP,Y 07530CSR Z-ADDHOURS HRS,Y 07540CSR Z-ADDTOTTOT TOT,Y 07550CSR GOTO T212B 07560CSR END212 ENDSR 07570C******************************************************************** 07580CSR SR213 BEGSR 07590C* PRINT HOURS TOTALS BY DEPT. 07600CSR EXSR SR201 LF 07610CSR HRS ADD TOT TOT 07620CSR EXSR SR212 SORT DEPT 07630CSR SETON 83 07640CSR EXSR SR69 HRS HDG 07650CSR U2 EXSR SR201 LF 07660CSR Z-ADD1 H 07670C*------------------------------------------------------------------- 07680CSR T213A TAG 07690CSR ZERO3 LOKUPDEP,H 54 07700CSRN54 GOTO T213C 07710CSR Z-ADDDEP,H W5N 50 07720CSR W5N LOKUPTABDEP TABRAT 54 07730CSRN54 Z-ADD0 EXT$ 07740CSRN54 GOTO T213B 07750CSR MOVELTABRAT RATE 52 ÐÐ07760CSR HRS,H MULT RATE EXT$ 103H 07770CSR MOVE TABRAT BURD 42 07780CSR BURD MULT EXT$ W10D3 103H 07790CSR W10D3 ADD EXT$ EXT$ 07800CSR EXT$ ADD TOTLAB TOTLAB 103 07810CSR HRS,H ADD TOTHRS TOTHRS 103 07820C*------------------------------------------------------------------- 07830CSR T213B TAG 07840CSR SETON 84 07850CSR EXSR SR69 PUT HRS 07860CSR 1 ADD H H 07870CSR H COMP 25 54 07880CSRN54 GOTO T213A 07890C*------------------------------------------------------------------- 07900CSR T213C TAG 07910CSR EXSR SR201 LF 07920CSR TOTLAB ADD LABMAT LABMAT 07930CSR SETON 82 07940CSR EXSR SR69 HRS TOTAL 07950CSR EXSR SR201 LF 07960CSR SETON 87 07970CSR EXSR SR69 LAB + MAT $ 07980CSR ENDSR 07990O******************************************************************** 08000OCRTFILE E 72 ÐÐ08010O* DATA LINE. 08020O REC 248 08030O 109 '. . . . . . .' 08040O 02 109 ' ' 08050O 03 109 ' ' 08060O L Z 82 08070O BMITNOZ 88 08080O 01 BMCPN 102 ' - - ' 08090O 02 BMCPN 105 ' - - ' 08100O 03 BMCPN 108 ' - - ' 08110O 04 BMCPN 111 ' - - ' 08120O 05 BMCPN 114 ' - - ' 08130O 06 BMCPN 117 ' - - ' 08140O 07 BMCPN 120 ' - - ' 08150O PMDESC 151 08160O PMTCST2 152 08170O BMQTY 2 162 08180O PMUM 166 08190O PMSC 172 08200O PMISSU 178 08210O 55 BMISSU 178 08220O PMPROV 183 08230O EXTQTY2 195 08240O PMFABC 199 08250O 58 COST 2 212 ÐÐ08260O QHRS 2 248 08270O PMQDEPZ 242 08280O THRS 2 238 08290O PMTDEPZ 229 08300O AHRS 2 225 08310O PMADEPZ 216 08320O*------------------------------------------------------------------- 08330O E 75 08340O* PUT TOP ASSY LINE. 08350O REC 248 08360O 82 '1' 08370O ASSYPN 102 ' - - ' 08380O N89 109 'CONT''D' 08390O PMDESC 151 08400O PMTCST2 152 08410O QAR,C 2 162 08420O PMUM 166 08430O PMISSU 178 08440O PMSC 172 08450O PMPROV 183 08460O QAR,C 2 195 08470O PMFABC 199 08480O PMQHRS2 248 08490O PMQDEPZ 242 08500O PMTHRS2 238 ÐÐ08510O PMTDEPZ 229 08520O PMAHRS2 225 08530O PMADEPZ 216 08540O*------------------------------------------------------------------- 08550O E 73 08560O* PUT ERROR MESSAGE. 08570O REC 248 08580O MGTEXT 115 08590O 117 ' ' 08600O 96 BIT,8 212 08610O*------------------------------------------------------------------- 08620O E 41 08630O* CLEAR SCREEN - LINE-1. 08640O REC 248 08650O 127 'INDENTED ASSY COST' 08660O U3 142 '-MFG PARTS ONLY' 08670O 150 'ASSY=' 08680O ASSYPN 162 ' - - ' 08690O 170 'DESCR:' 08700O TOPDES 200 08710O 210 'MODEL:' 08720O TOPMOD 223 08730O UDATE Y 88 08740O EGAP Z 248 08750O 244 'PAGE' ÐÐ08760O*------------------------------------------------------------------- 08770O E 42 08780O* HEADING, LINE-2. 08790O REC 248 08800O 106 '--------------INDENTURE' 08810O 120 '--------------' 08820O 152 'UNIT' 08830O 162 'QUANTITY' 08840O 174 'SOURCE' 08850O 180 'ISSUE' 08860O 185 'PROV' 08870O 195 'EXTENDED' 08880O 200 'FAB' 08890O 212 'MATERIAL' 08900O 223 'ASSY' 08910O 236 'TEST' 08920O 246 'Q.C.' 08930O*------------------------------------------------------------------- 08940O E 43 08950O* HEADING, LINE-3. 08960O REC 248 08970O 83 'LEV' 08980O 88 'ITEM' 08990O 109 '1 2 3 4 5 6 7' 09000O 112 '-UP' ÐÐ09010O 133 'DESCRIPTION' 09020O 152 'COST' 09030O 162 'PER-ASSY' 09040O 166 'UM' 09050O 173 'CODE' 09060O 179 'CODE' 09070O 185 'CODE' 09080O 195 'QUANTITY' 09090O 201 'CODE' 09100O 210 'COST' 09110O 216 'DEP' 09120O 225 'HRS' 09130O 229 'DEP' 09140O 238 'HRS' 09150O 242 'DEP' 09160O 248 'HRS' 09170O*------------------------------------------------------------------- 09180O E 71 09190O REC 248 09200O*------------------------------------------------------------------- 09210O E 80 09220O REC 248 09230O L Z 82 09240O DASH 212 09250O 109 '. . . . . . .' ÐÐ09260O 01 MC 102 09270O 02 MC 105 09280O 03 MC 108 09290O 04 MC 111 09300O 05 MC 114 09310O 06 MC 117 09320O 07 MC 120 09330O DOL,L 2B 211 09340O HRA,L 2B 223 09350O HRT,L 2B 235 09360O HRQ,L 2B 247 09370O 212 '*' 09380O 224 '*' 09390O 236 '*' 09400O 248 '*' 09410O*------------------------------------------------------------------- 09420O E 79 09430O OR 86 09440O REC 248 09450O 102 'TOTAL MATERIAL COST...' 09460O 79 TCOST 2 119 09470O 86 TTCOST2 119 09480O E 83 09490O REC 248 09500O 84 'DEPT' ÐÐ09510O 92 'HOURS' 09520O 105 'EXTENDED' 09530O E 84 09540O REC 248 09550O DEP,H Z 83 09560O HRS,H 1 92 09570O EXT$ 1 105 09580O E 82 09590O REC 248 09600O 89 'TOTAL....' 09610O TOTLAB1B 106 09620O TOTHRS1B 93 09630O*------------------------------------------------------------------- 09640O E 85 09650O REC 248 09660O 103 'G R A N D T O T A L S' 09670O*------------------------------------------------------------ 09680O E 87 09690O REC 248 09700O 98 'LABOR + MATERIAL =' 09710O LABMAT2 119 09720O*------------------------------------------------------------------- 09730O E 77 09740O REC 248 09750O EENAME 226 ÐÐ09760O DEPNAM 248 09770O******************************************************************** 09780OSUSPENSEE 78 09790O APN 109 09800O QAR 125P 09810O 128 'D' 09820O****************************************************************** 09830OPURCHWU E 72 58 U1 09840O L Z 3 09850O BMITNOZ 10 09860O BMCPN 25 ' - - ' 09870O BMAPN 40 ' - - ' 09880O PMDESC 71 09890O PMTCST2 72 09900O BMQTY 2 82 09910O PMUM 86 09920O PMSC 92 09930O PMISSU 98 09940O 55 BMISSU 98 09950O PMPROV 103 09960O EXTQTY2 115 09970O PMFABC 119 09980O 58 COST 2 132 ** A12 ARRAY 009990 010000ÐÐ** LEV ARRAY 010010 010020** QTY ARRAY 010030 010040** A29 ARRAY 010050 010060** DOL ARRAY 010070 010080** DASH ARRAY 010090 010100** MC ARRAY 010110 010120** DEP ARRAY 010130 010140** HRS ARRAY 010150 010160** TOT ARRAY 010170 010180** HRA ARRAY 010190 010200** HRT ARRAY 010210 010220** HRQ ARRAY 010230 010240/* 010250ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¤v ¤ÅX032PM P;°>b120282120282(èÈÐ00010H Q032PM00020F* DISPLAY PMMST2 FILE. (X032PM) 00030F* REVISED 12-10-82 3:00 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FPMMST2 ID F 674L12AI 1 DISK 00090FPMPROD2 ID F 15L14AI 1 DISK 00100FPMMODEL2ID F 23L22AI 1 DISK 00110FPMDESCR2ID F 42L29AI 1 DISK 00120FMCNCR2 ID F 16L 5AI 1 DISK 00130FLABRATE IT F 80 EDISK 00140FTERM132 O F 132 5 00150F**************************************************************** 00160E A30 30 30 1 A INPUT DATA ARRAY 00170E TOT 1 3 9 3 COST TOTALS 00180E TABACT 1 5 5 0 TABACN 15 ACCOUNT NAMES 00190E TABRC 1 4 1 TABRCN 15 DWG REL CODES 00200E TABISS 1 9 2 TABICN 15 ISSUE CODES 00210E TABSC 1 6 2 TABSCN 15 SOURCE CODES 00220E TABUM 1 15 2 TABUMN 15 UNITS OF MEAS 00230E TABPV 1 7 1 TABPVN 22 PROVISION CODES 00240E LABRATE TABDEP 1 11 5 0 TABRAT 9 LABOR DEPT/RATES 00250E DIF 1 7 9 3 STD/MFG $ VAR ÐÐ00260E VAR 1 6 7 2 STD/MFG HR VAR 00270E DASH 54 54 1 00280E DIV 1 1 37 00290E AST 1 132 1 00300E MXT 1 12 9 3 00310E AXT 1 3 9 3 00320E LNK 1 7 6 A 00330E CALL 7 6 00340E PAR 25 1 00350E TST 25 1 00360E PM$ 7 9 3 MFG $ FILE 00370E PA$ 7 9 3 STD $ FILE 00380E PLT 8 3 0 LEAD TIMES 00390E PHZ 5 3 0 HORIZON M-DAYS 00400E PMM 6 7 0 MIN/MAX CODES 00410E ADP 3 3 0 00420E AHR 3 7 3 00430E MHR 12 7 3A 00440E MDP 12 3 0 00450E BIT 33 1 SCREEN CONTR. CHAR 00460I******************************************************************* 00470IBITPAR BT 00480I 1 33 BIT 00490I 34 58 PAR 00500I 59 83 TST ÐÐ00510I******************************************************************* 00520IMGFILE MG 00530I* MESSAGE FILE. 00540I 1 35 MGTEXT 00550I****************************************************************** 00560ICRTFILE CR 00570I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00580I 28 330CRTIME 00590I 34 370CRDATE 00600I 38 79 CALL 00610I******************************************************************** 00620IPMMST2 PM 00630I* PART MASTER RECORD (XPMMST) 00640I* KEY AREA 00650I* PART NO. 10N 00660I 1 100PMPN 00670I* NUMB OF COMPONENTS 3P 00680I P 13 140PMNOBM 00690I* PROD LINE 4N 00700I 15 180PMPL 00710I* MODEL NAME 12A 00720I 19 30 PMMODL 00730I* DESCRIPTION 29A 00740I 31 59 PMDESC 00750I* COMMODITY CODE 9P ÐÐ00760I P 60 640PMCC 00770I* ENG CHANGE STATUS. 00780I* LAST ECN # 5A 00790I 65 69 PMECN 00800I* CUR CHG LEVEL 2A 00810I 70 71 PMECHG 00820I* CUR CHG DATE 6N 00830I 72 770PMDCHG 00840I* RELEASE STATUS 1A 00850I* E = ENG ONLY 00860I* M = REL TO MFG 00870I* P = PROTOTYPE 00880I* X = PRE-RELEASE 00890I 78 78 PMRELS 00900I* INSPECT CODE 3A 00910I 79 81 PMINSP 00920I* DRAWING INFO. 00930I* DWG SIZE 1A 00940I 82 82 PMSIZ 00950I* DWG CLASS 1A 00960I* D = DYNAIR DWG 00970I* V = VENDOR DWG 00980I 83 83 PMDCLS 00990I* STANDARD CODE 1A 01000I 84 84 PMSTDC ÐÐ01010I* UNIT MEAS 2A 01020I* EA = EACH OZ = OUNCE 01030I* ST = SET TC = TROY OUNCE 01040I* IN = INCH LB = POUND 01050I* FT = FEET PT = PINT 01060I* YD = YARD QT = QUART 01070I* SI = SQ.INCH GL = GALLON 01080I* SF = SQ.FEET DR = DRUM 01090I* SY = SQ.YARD 01100I 85 86 PMUM 01110I***** UNIT MEAS CONVERSION. 01120I***** UM MULTIPLIER 7.2P 01130I***** P 87 902PMUMM 01140I***** UM CONVERTER 1A 01150I***** M = MULTIPLY 01160I***** D = DIVIDE 01170I***** 91 91 PMUMC 01180I***** SET/DRUM UM 2A 01190I***** 92 93 PMUMUM 01200I* SOURCE CODE 2A 01210I* MA = MFG ASSY 01220I* MP = MFG PART 01230I* PA = PURCH ASSY 01240I* PP = PURCH PART 01250I* RS = RAW STOCK ÐÐ01260I 94 95 PMSC 01270I* PROVISIONING CODE 1A 01280I* A = FORECAST,NO VALUE ADDED 01290I* B = FORECAST,VALUE ADDED 01300I* C = FRCST-BUILD TO ORDER 01310I* D = NON-FRCST-BUILD TO ORDER 01320I* E = CUSTOM 01330I* Y = OBSOLETE,REPAIRABLE 01340I* Z = OBSOLETE,NOT REPAIRABLE 01350I 96 96 PMPROV 01360I* ISSUE CODE 2A 01370I* PT = PULL TIME 01380I* OR = ON REQUEST 01390I* BI = BULK ISSUE 01400I* AR = AS REQUIRED 01410I* VS = VENDOR SUPPLIED 01420I* SD = SHIPPING DOCUMENT 01430I* TD = TRAV DOCUMENT 01440I* RD = REF DOCUMENT 01450I* RA = REF ASSY 01460I 97 98 PMISSU 01470I* DELIVER TO DEPT 5P 01480I P 99 1010PMDEL 01490I* RESPONSIBILITY CODES 01500I* ENGR CODE 2A ÐÐ01510I 102 103 PMEGR 01520I* PLANNER CODE 2A 01530I 104 105 PMPLNR 01540I* BUYER CODE 2A 01550I 106 107 PMBUYR 01560I* SALESMAN CODE 2A 01570I 108 109 PMSLSM 01580I* INVENTORY ACCOUNT 5P 01590I P 110 1120PMACNT 01600I* LEAD TIMES 3P X 8 01610I* MFG BUCKET PURCH 01620I* 01630I* SCHED 1 SCHED 01640I* KIT 2 PLACE PO 01650I* VENDOR 3 VENDOR 01660I* PRODUCTION 4 01670I* INSPECT/TEST 5 INSPECT 01680I* STOCK 6 STOCK 01690I* 7 01700I* CUM 8 01710I P 113 128 PLT 01720I* ORDER POLICY CODES. 01730I* HORIZON M-DAYS 3P X 5 01740I* 1 = SALES ORDERS 01750I* 2 = PROD REQMTS-REL ÐÐ01760I* 3 = PROD REQMTS-PLAN 01770I* 4 = FORECAST 01780I* 5 = SAFETY STOCK 01790I P 129 138 PHZ 01800I* MIN/MAX CODES. 01810I* ARRAY 7P X 6 01820I* 1 = MIN ORDER SPAN 01830I* 2 = MIN ORDER QTY 01840I* 3 = MIN ORDER $$$ 01850I* 4 = MAX ORDER SPAN 01860I* 5 = MAX ORDER QTY 01870I* 6 = MAX STOCK $$$ 01880I P 139 162 PMM 01890I* SAFETY STOCK 7P 01900I P 163 1660PMSSTK 01910I* ROUNDING FACTOR 5P 01920I P 167 1690PMRNDF 01930I* EOQ CODE 2A 01940I 170 171 PMEOQ 01950I* EOQ PARAMETER 2A 01960I 172 173 PMEOQP 01970I* EXCEPTION REPORT CRITERIA. 01980I* ALLOWABLE SURPLUS QTY 7P 01990I P 174 1770PMSQTY 02000I* ALLOWABLE SURPLUS % 5.2P ÐÐ02010I P 178 1802PMSPCT 02020I* ALLOWABLE SURPLUS SPAN 3P 02030I P 181 1820PMSSP 02040I* ALLOWABLE SHORTAGE SPAN 3P 02050I P 183 1840PMSHSP 02060I* STANDARD COSTS 9.3P X 7 02070I* ADDED COSTS 02080I* 1 = LABOR 02090I* 2 = LABOR BURDEN 02100I* 3 = MATERIAL 02110I* 4 = MATERIAL BURDEN 02120I* 5 = OUTSIDE PROC 02130I* CUM COSTS 02140I* 6 = LABOR 02150I* 7 = MATERIAL 02160I P 185 219 PA$ 02170I* STANDARD LABOR HOURS. 02180I* STD LOT SIZE 7P 02190I P 220 2230PMSLOT 02200I* STD SET-UP HRS 9.3P 02210I P 224 2283PMSSUH 02220I* STD RUN HRS 9.3P 02230I P 229 2333PMSRH 02240I* STD COST DATE 6N 02250I 234 2390PMSDAT ÐÐ02260I* STD COST CODE 1A 02270I* E = ESTIMATED 02280I* H = HISTORICAL 02290I* X = ACCOUNTING 02300I 240 240 PMSCCD 02310I* AVER LABOR **** 7.2P 02320I P 241 2442PMOSAL 02330I* CURRENT COSTS 9.3P X 7 02340I* ADDED COSTS 02350I* 1 = LABOR 02360I* 2 = LABOR BURDEN 02370I* 3 = MATERIAL 02380I* 4 = MATERIAL BURDEN 02390I* 5 = OUTSIDE PROC 02400I* CUM COSTS 02410I* 6 = LABOR 02420I* 7 = MATERIAL 02430I P 245 279 PM$ 02440I* CURRENT LABOR HOURS. 02450I* CUR LOT SIZE 7P 02460I P 280 2830PMCLOT 02470I* CUR SET-UP HRS 9.3P 02480I P 284 2883PMCSUH 02490I* CUR RUN HRS 9.3P 02500I P 289 2933PMCRH ÐÐ02510I* CUR COST DATE 6N 02520I 294 2990PMCDAT 02530I* CUR COST CODE 1A 02540I* E = ESTIMATED 02550I* H = HISTORICAL 02560I* X = ACCOUNTING 02570I 300 300 PMCCCD 02580I* PREV MO STK BAL **** 7P 02590I P 301 3040PMPMSB 02600I* DATE LAST TRAN 6N 02610I 305 3100PMDLT 02620I* CALCULATED DATA. 02630I* CURRENT BALANCES. 02640I* ON HAND STOCK 7P 02650I P 311 3140PMOHB 02660I* REQUIRED QTYS. 02670I* FORECAST BAL 7P 02680I P 315 3180PMFRCB 02690I* ALLOCATIONS 7P 02700I P 319 3220PMALB 02710I* REL REQS 7P 02720I P 323 3260PMRLB 02730I* SALES BACKLOG 7P 02740I P 327 3300PMSOB 02750I* QUOTES 7P ÐÐ02760I P 331 3340PMQTB 02770I* BACKORDERS 7P 02780I P 335 3380PMBOB 02790I* ON ORDER BALANCES. 02800I* PURCHASE REQS 7P 02810I P 339 3420PMPRB 02820I* PURCH ORDERS 7P 02830I P 343 3460PMPOB 02840I* RECD P.O. 7P 02850I P 347 3500PMRPOB 02860I* OPEN WORK ORDER 7P 02870I P 351 3540PMPWOB 02880I* REL WORK ORDER 7P 02890I P 355 3580PMRWOB 02900I* PAST USAGE. 02910I* PLANNED USAGE QTYS. 02920I* SHIPPED QTYS 7P 02930I P 359 3620PMPSHP 02940I* ISSUE QTYS 7P 02950I P 363 3660PMPISS 02960I* RECEIPT QTYS 7P 02970I P 367 3700PMPRCT 02980I* SCRAP QTYS 7P 02990I P 371 3740PMPSCR 03000I* UNPLANNED USAGE QTYS. ÐÐ03010I* SHIPPED QTYS 7P 03020I P 375 3780PMUSHP 03030I* ISSUE QTYS 7P 03040I P 379 3820PMUISS 03050I* RECEIPT QTYS 7P 03060I P 383 3860PMURCT 03070I* SCRAP QTYS 7P 03080I P 387 3900PMUSCR 03090I* CUST RET $ 7P 03100I P 391 3940PMUCRT 03110I* PLANNED USAGE FREQ. 03120I* SHIPPED 5P 03130I P 395 3970PMFSHP 03140I* ISSUE 5P 03150I P 398 4000PMFISS 03160I* RECEIPT 5P 03170I P 401 4030PMFRCT 03180I* SCRAP 5P 03190I P 404 4060PMFSCR 03200I* UNPLANNED USAGE FREQ. 03210I* SHIPPED 5P 03220I P 407 4090PMQSHP 03230I* ISSUE 5P 03240I P 410 4120PMQISS 03250I* RECEIPT 5P ÐÐ03260I P 413 4150PMQRCT 03270I* SCRAP 5P 03280I P 416 4180PMQSCR 03290I* CUST RET 5P 03300I P 419 4210PMQCRT 03310I* BACKORDER FREQ 5P 03320I P 422 4240PMFBO 03330I* USAGE RATIO .7P 03340I P 425 4287PMRATO 03350I* INVENTORY CLASS 1A 03360I 429 429 PMINVC 03370I* LOW LEVEL CODE 2N 03380I 430 4310PMLL 03390I* PHYSICAL INVENTORY. 03400I* CYCLE INV FREQ 3P 03410I P 432 4330PMFCYC 03420I* DATE LAST CYCLE 6N 03430I 434 4390PMDLCI 03440I* ADJ FREQ 3P 03450I P 440 4410PMFADJ 03460I* ADJ NET VALUE $ 9.2P 03470I P 442 4462PMVADJ 03480I* LAST SALE INFO. 03490I* LAST SALE DATE 6N 03500I 447 4520PMDLS ÐÐ03510I* LAST SALE QTY 7P 03520I P 453 4560PMLSQ 03530I* LAST SALE PRICE 9.3P 03540I P 457 4613PMLSP 03550I* LAST BUY INFO. 03560I* LAST BUY DATE 6N 03570I 462 4670PMDLB 03580I* LAST BUY QTY 7P 03590I P 468 4710PMLBQ 03600I* LAST BUY PRICE 9.3P 03610I P 472 4763PMLBP 03620I* DATE LAST STK TRANS 6N 03630I 477 4820PMDLST 03640I* OLD STYLE PART MASTER FIELDS. HRS=ACCOUNTING STD HRS 03650I* AVER LABOR 7.2P P 241 2442PMOSAL 03660I* PREV MO STK BAL 7P P 301 3040PMPMSB 03670I* DEVALUED CODE 1A 03680I 483 483 PMDVAL 03690I*** LOT QTY 5P 03700I*** P 484 4860PMOSLQ 03710I* FAB CODE 2A 03720I 487 488 PMFABC 03730I* STD UNIT COST 9.3P 03740I P 489 4933PMOSUC 03750I*** LEAD TIME 3P ÐÐ03760I*** P 494 4950PMOSLT 03770I* OLD STYLE MCN 5A 03780I 496 500 PMMCN 03790I* SPARES CODE 1A 03800I 501 501 PMSPAR 03810I* GSA PRICE 9.2P 03820I P 502 5062PMGSA 03830I* SET-UP PRICE 9.2P 03840I P 507 5112PMSUPR 03850I* LIST PRICE 9.2P 03860I P 512 5162PMLPR 03870I* PMDESCR FILE KEY CODE 3P 03880I P 517 5180PMPDKC 03890I* LAST PRICE UPDATE DATE 6N 03900I 519 5240PMLPUD 03910I* ACCOUNTING ROUTING HRS 3 X 7.3P 03920I P 525 536 AHR 03930I* ACCOUNTING ROUTING DEPT 3 X 3P 03940I P 537 542 ADP 03950I* MFG ROUTING HRS 12 X 7.3P 03960I P 543 590 MHR 03970I* MFG ROUTING DEPT 12 X 3P 03980I P 591 614 MDP 03990I* STD UNIT COST- MFG 9.3P 04000I P 615 6193PMTCST ÐÐ04010I* DELETE CANDIDATE FLAG 1A (*) 04020I 620 620 PMDELC 04030I* STOCK LOCATION 6A 04040I 621 626 PMSLOC 04050I* RECORD STATUS 1A 04060I* D = DELETED 04070I 674 674 PMSTAT 04080I******************************************************************** 04090IPMDESCR2PD 04100I* KEY AREA - DESCRIPTION ALT-KEY. 04110I* SHORT DESCR 26A 04120I* 1 26 PDDESC 04130I* KEY CODE 3N (PMFCNT) 04140I* 27 290PDKCOD 04150I* PART NO. 10N 04160I 30 390PDPN 04170I* CONTROL KEY 3P 04180I P 40 410PDCONT 04190I* RECORD STATUS 1A 04200I 42 42 PDSTAT 04210I******************************************************************** 04220IPMMODEL2PL 04230I* KEY AREA - MODEL ALT-KEY. 04240I* MODEL 12A 04250I* 1 12 PLMODL ÐÐ04260I* PART NO. 10N 04270I 13 220PLPN 04280I* RECORD STATUS 1A 04290I 23 23 PLSTAT 04300I******************************************************************** 04310IPMPROD2 PR 04320I* KEY AREA - PROD LINE ALT-KEY. 04330I* PROD CLASS 4N 04340I* 1 40PRPL 04350I* PART NO. 10N 04360I 5 140PRPN 04370I* RECORD STATUS 1A 04380I 15 15 PRSTAT 04390I**************************************************************** 04400IMCNCR2 MC 04410I* MCN CROSS REF FILE 04420I 1 5 MCMCN 04430I 6 150MCPN 04440I 16 16 MCSTAT 04450C******************************************************************** 04460C* INITIALIZE. 04470C EXSR SR101 04480C Z-ADD0 ZERO7 70 STUPIDITY 04490C MOVE ' ' BLK6 6 STUPIDITY 04500C*------------------------------------------------------------------- ÐÐ04510C START TAG 04520C* GET PART #, MODEL, PROD CLASS, MCN, OR DESCRIPTION SELECTION. 04530C SETOF 414243 04540C SETOF 447790 04550C EXSR SR102 04560C 90 GOTO START 04570C* CLASSIFY TYPE OF INPUT. 04580C EXSR SR201 CLASSIFY SELECTION 04590C*-------------------------------------------------------------------- 04600C TAG5 TAG 04610C* SET-UP 1ST READ. 04620C EXSR SR103 SETLL 04630C*------------------------------------------------------------------- 04640C TAG10 TAG 04650C* READ NEXT RECORD. 04660C SETOF 54 04670C EXSR SR201 CLASSIFY SELECTION 04680C Z-ADD0 MHR 04690C Z-ADD0 AHR 04700C Z-ADD0 MDP 04710C Z-ADD0 ADP 04720C Z-ADD0 MXT 04730C Z-ADD0 AXT 04740C EXSR SR104 READ 04750C 54 GOTO ENDFIL ÐÐ04760C* CHECK FOR DELETED RECORD. 04770C EXSR SR105 CHK STAT=D 04780C 54 GOTO TAG10 04790C* IF ALT-KEY, GET PMMST. 04800C 42 MOD SEQ 04810COR 43 PROD SEQ 04820COR 44 DESCR SEQ 04830COR 45 EXSR SR106 MCN SEQ 04840C 54 GOTO TAG10 NO HIT 04850C* DISPLAY PMMST. 04860C EXSR SR107 TAB LOKUPS 04870C EXSR SR108 COMPUTE COST 04880C EXSR SR71 PUT DATA 04890C EXSR SR68 PROMPT 04900C EXSR SR69 LFCR 04910C EXSR SR75 READ 04920C 77 EXSR SR109 MOVE DATA 04930C N90N77 GOTO TAG10 CR ONLY INPUT 04940C 77 GOTO TAG5 NEW INPUT 04950C GOTO START LOCAL MENU 04960C*------------------------------------------------------------------- 04970C ENDFIL TAG 04980C Z-ADD327 M 50 04990C EXSR SR73 PUT MSG 05000C GOTO START ÐÐ05010C*------------------------------------------------------------------- 05020C MENU TAG 05030C EXSR SR96 GET CRTFILE 05040C Z-ADD1 W 05050C BLK6 LOKUPLNK,W 54 05060C 54 MOVELLNK,W PROG 8 05070C 54 MOVE BLK6 LNK,W 05080C N54 MOVEL'CONTU 'PROG 05090C EXSR SR97 UPD CRTFILE 05100C EXSR SR98 >>>>>>>>>> 05110C*------------------------------------------------------------------- 05120C NEWITM TAG 05130C MOVEL'Q032PM 'PROG 05140C GOTO END 05150C*------------------------------------------------------------------- 05160C GOODBY TAG 05170C MOVEL'GOODBY 'PROG 05180C*------------------------------------------------------------------- 05190C END TAG 05200C EXSR SR96 GET CRTFILE 05210C EXSR SR97 UPD CRTFILE 05220C EXSR SR98 >>>>>>>>>> 05230C*------------------------------------------------------------------- 05240C ENDJOB TAG 05250C MOVEL'ENDJOB 'PROG ÐÐ05260C EXSR SR98 >>>>>>>>>> 05270C******************************************************************** 05280CSR SR68 BEGSR 05290C* PROMPT. 05300CSR SETON 68 05310CSR EXCPT 05320CSR SETOF 68 05330CSR ENDSR 05340C**************************************************************** 05350CSR SR69 BEGSR 05360C* LINE FEED/CAR RETURN 05370CSR EXITFQCLFCR LINE FEED/CR 05380CSR ENDSR 05390C*************************************************************** 05400CSR SR70 BEGSR 05410C* POSITION CURSOR 05420CSR EXITFQXYPOS POSITION CURSOR 05430CSR RLABL W6A 05440CSR ENDSR 05450C********************************************************************** 05460CSR SR71 BEGSR 05470C* PUT HEADINGS TO TERMINAL 05480CSR PMDELC COMP '*' 70 DELETE CANDIDATE 05490CSR SETON 71 05500CSR EXCPT PUT HEADINGS ÐÐ05510CSR SETOF 71 05520CSR ENDSR 05530C*********************************************************************** 05540CSR SR73 BEGSR 05550C* PUT ERROR MESSAGE TO TERMINAL 05560CSR EXSR SR89 GET MSG FILE 05570CSR SETON 73 05580CSR EXCPT PUT MSG 05590CSR SETOF 73 05600CSR ENDSR 05610C******************************************************************* 05620CSR SR75 BEGSR 05630C* READ FROM TERMINAL 05640CSR SETOF 779096 05650CSR SETOF 93 05660CSR SETOF 898887 05670CSR MOVE BLK30 W30A 30 BUFFER 05680CSR EXITFZR30 READ FROM TERMINAL 05690CSR RLABL W30A READ BUFFER 05700CSR MOVEAW30A A30 INPUT DATA ARRAY 05710CSR MOVE BLK30 W30A INIT INPUT ARRAY 05720CSR Z-ADD1 W 30 05730CSR '\' LOKUPA30,W 90 FLAG ESC 05740CSRN90 GOTO T75B NOT ESC 05750CSR 1 ADD W W ÐÐ05760CSR W COMP 30 54 05770CSR 54 GOTO T75A BAD ESC 05780CSR A30,W COMP 'G' 98 GOODBY 05790CSR A30,W COMP 'E' 94 MENU 05800CSR A30,W COMP 'N' 93 NEW ITEM 05810CSRN93 A30,W COMP 'B' 89 SKIP BKWRD 05820CSRN93 A30,W COMP 'H' 87 HOME 05830CSR 98 GOTO GOODBY 05840CSR 94 GOTO MENU 05850CSR 93 GOTO NEWITM 05860C*------------------------------------------------------------------ 05870CSR T75A TAG 05880C* FLAG BAD ESC INPUT 05890CSR Z-ADD318 M 96 FLAG ERROR 05900CSR GOTO END75 05910C*-------------------------------------------------------------------- 05920CSR T75B TAG 05930C* MOVE DATA 05940CSR Z-ADD1 W 05950CSR ' ' LOKUPA30,W 77 05960CSR 77 MOVEAA30,W W30A INPUT DATA 05970CSR END75 ENDSR 05980C********************************************************************** 05990CSR SR89 BEGSR 06000C* GET MESSAGE MASTER ÐÐ06010CSR M CHAINMGFILE 54 06020CSR 54 MOVE BLK35 MGTEXT 06030CSR 54 MOVELM MGTEXT 06040CSR ENDSR 06050C******************************************************************** 06060CSR SR96 BEGSR 06070CSR # CHAINCRTFILE H9 GET CRTFILE 06080CSR H9 GOTO ENDJOB 06090CSR ENDSR 06100C******************************************************************** 06110CSR SR97 BEGSR 06120C* UPDATE CRTFILE. EXIT PROGRAM. 06130CSR TIME CRTIME 06140CSR MOVELUDATE CRDATE 06150CSR SETON 97 06160CSR EXCPT UPD CRTFILE 06170CSR SETOF 97 06180CSR ENDSR 06190C******************************************************************** 06200CSR SR98 BEGSR 06210CSR EXITFCHAIN >>>>>>>>>> 06220CSR RLABL PROG 06230CSR ENDSR 06240C******************************************************************** 06250CSR SR101 BEGSR ÐÐ06260C* 1-TIME INITIALIZE 06270CSR MOVE '*' AST 06280CSR MOVE ' ' BLK30 30 06290CSR MOVE '120001' W6A 06300CSR EXSR SR70 POSITION CURSOR 06310C* GET PORT # AND CRTFILE 06320CSR MOVE ' ' W2A 2 06330CSR EXITFZGMINX GET PORT # 06340CSR RLABL W2A 06350CSR MOVE W2A # 20 PORT NO. 06360CSR # COMP 0 54 06370CSRN54 Z-ADD25 # DEFAULT 06380CSR EXSR SR96 GET CRTFILE 06390CSR MOVE CALL LNK 06400CSR MOVE 'Q032PM 'PROG 06410CSR TST,# COMP 'S' 54 06420CSR EXSR SR97 UPD CRTFILE 06430CSR 54 EXSR SR98 >>>>>>>>>> 06431CSR MOVE ' 'PROG 06440C* DEFINE WORK FIELDS,ETC. 06450CSR MOVE ' ' BLK35 35 06460CSR ENDSR 06470C******************************************************************** 06480CSR SR102 BEGSR 06490C* PUT MENU. ÐÐ06500CSR SETON 72 06510CSR EXCPT PUT MENU 06520CSR SETOF 72 06530C* REQUEST SELECTION. 06540CSR Z-ADD426 M 06550CSR EXSR SR73 PROMPT 06560CSR EXSR SR69 LF 06570CSR MOVE '120001' W6A 6 06580CSR EXSR SR70 POSITION CURSOR 06590CSR EXSR SR75 READ 06600CSR 90 GOTO END102 ESC 06610CSR MOVELW30A W10A 10 06620CSR EXSR SR202 06630CSR MOVE W10A SELECT 30 06640CSR EXSR SR201 CLASSIFY SELECTION 06650CSR SETOF 55 06660CSR 41 06670COR 42 06680COR 43 06690COR 44 06700COR 45 SETON 55 06710CSRN55 Z-ADD241 M 06720CSRN55 EXSR SR73 FLAG ERROR 06730CSRN55 GOTO SR102 06740CSR 41 Z-ADD298 M ENTER PART # ÐÐ06750CSR 42 Z-ADD297 M ENTER MODEL 06760CSR 43 Z-ADD295 M ENTER PROD CLASS 06770CSR 44 Z-ADD296 M ENTER DESCRIPTION 06780CSR 45 Z-ADD274 M ENTER MCN 06790CSR EXSR SR73 PROMPT 06800CSR EXSR SR69 LF 06810CSR MOVE '120001' W6A 06820CSR EXSR SR70 POSITION CURSOR 06830CSR EXSR SR75 READ 06840CSR 90 GOTO END102 06850CSR EXSR SR109 MOVE DATA 06860CSR END102 ENDSR 06870C******************************************************************** 06880CSR SR103 BEGSR 06890C* SET READ LOW LIMIT. 06900CSR 41 MOVELPARTNO LLPN 12 06910CSR 42 MOVELMODEL LLMODL 22 06920CSR 43 MOVELPROD LLPROD 14 06930CSR 44 MOVELDESCR LLDESC 06940CSR 44 MOVE ' ' LLDESC 29 06950CSR 45 MOVE MCNNO LLMCN 5 06960CSR 41 LLPN SETLLPMMST2 06970CSR 42 LLMODL SETLLPMMODEL2 06980CSR 43 LLPROD SETLLPMPROD2 06990CSR 44 LLDESC SETLLPMDESCR2 ÐÐ07000CSR 45 LLMCN SETLLMCNCR2 07010CSR ENDSR 07020C******************************************************************** 07030CSR SR104 BEGSR 07040C* READ FILE. 07050CSR SETOF 54 07060CSR 41 READ PMMST2 54 07070CSR 42 READ PMMODEL2 54 07080CSR 43 READ PMPROD2 54 07090CSR 44 READ PMDESCR2 54 07100CSR 45 READ MCNCR2 54 07110CSR ENDSR 07120C******************************************************************** 07130CSR SR105 BEGSR 07140C* CHECK FOR DELETED RECORD. 07150CSR SETOF 54 07160CSR 41 PMSTAT COMP 'D' 54 07170CSR 42 PLSTAT COMP 'D' 54 07180CSR 43 PRSTAT COMP 'D' 54 07190CSR 44 PDSTAT COMP 'D' 54 07200CSR 44N54 PDSTAT COMP 'M' 54 07210CSR 45 MCSTAT COMP 'D' 54 07220CSR ENDSR 07230C******************************************************************** 07240CSR SR106 BEGSR ÐÐ07250C* GET PMMST. 07260CSR 42 MOVELPLPN LLPN 07270CSR 43 MOVELPRPN LLPN 07280CSR 44 MOVELPDPN LLPN 07290CSR 45 MOVELMCPN LLPN 07300CSR LLPN SETLLPMMST2 07310CSR SETOF 54 07320CSR READ PMMST2 54 07330CSRN54 PMSTAT COMP 'D' 54 07340CSR ENDSR 07350C******************************************************************** 07360CSR SR107 BEGSR 07370C* GET CODE FIELD NAMES. 07380CSR PMACNT LOKUPTABACT TABACN 54 07390CSR 54 MOVE TABACN ACNAME 15 ACCOUNT NAME 07400CSR PMPROV LOKUPTABPV TABPVN 54 07410CSR 54 MOVE TABPVN PRVNAM 22 PROV CODE 07420CSR PMSC LOKUPTABSC TABSCN 54 07430CSR 54 MOVE TABSCN SCNAME 15 SOURCE CODE 07440CSR PMISSU LOKUPTABISS TABICN 54 07450CSR 54 MOVE TABICN ICNAME 15 ISSUE CODE 07460CSR PMUM LOKUPTABUM TABUMN 54 07470CSR 54 MOVE TABUMN UMNAME 15 UNIT MEAS 07480CSR PMRELS LOKUPTABRC TABRCN 54 07490CSR 54 MOVE TABRCN RELNAM 15 DWG REL STAT ÐÐ07500CSR PMPRB ADD PMPOB TOTORD 70 TOT ORD 07510CSR PMRPOB ADD TOTORD TOTORD 07520CSR PMPWOB ADD TOTORD TOTORD 07530CSR PMRWOB ADD TOTORD TOTORD 07540CSR PMFRCB ADD PMALB TOTREQ 70 TOTREQ 07550CSR PMRLB ADD TOTREQ TOTREQ 07560CSR PMQTB ADD TOTREQ TOTREQ 07570CSR XFOOTPLT LTTOT 30 07580CSR MOVELPMSC W1A 1 07590CSR W1A COMP 'M' 54 07600CSR 54 LTTOT SUB PLT,8 LTTOT 07610CSR ENDSR 07620C******************************************************************** 07630CSR SR108 BEGSR 07640C* COMPUTE COST TOTALS. 07650CSR PMCLOT COMP 0 54 07660CSRN54 Z-ADD50 PMCLOT LOT SIZE DEFAULT 07670CSR Z-ADD0 X 30 07680CSR Z-ADD0 MXT 07690CSR Z-ADD0 PM$,1 07700CSR Z-ADD0 PM$,2 07710C*--------------------------------------------------------------------- 07720CSR T108A TAG 07730CSR 1 ADD X X 07740CSR X COMP 12 54 ÐÐ07750CSR 54 GOTO T108C 07760CSR Z-ADDMDP,X W5N 50 DEPT NO 07770CSR Z-ADDMHR,X HOURS 93 54 HRS REQD 07780CSRN54 GOTO T108B 07790CSR EXSR SR401 COMPUTE ADDED LABOR 07800CSR LABOR ADD PM$,1 PM$,1 DIRECT LABOR 07810CSR BURD ADD PM$,2 PM$,2 ADDED BURDEN 07820CSR LABOR ADD BURD MXT,X HRS EXTENDED 07830C*------------------------------------------------------------------- 07840CSR T108B TAG 07850CSR X COMP 3 54 07860CSR 54 GOTO T108A 07870CSR Z-ADDADP,X W5N 07880CSR Z-ADDAHR,X HOURS 07890CSR EXSR SR401 07900CSR BURD ADD LABOR AXT,X 07910CSR GOTO T108A 07920C*------------------------------------------------------------ 07930CSR T108C TAG 07940CSR XFOOTMHR MFGHRS 83 07950CSR XFOOTMXT MFGVAL 93 07960CSR XFOOTAHR ACTHRS 83 07970CSR XFOOTAXT ACTVAL 93 07980CSR ENDSR 07990C******************************************************************** ÐÐ08000CSR SR109 BEGSR 08010C* MOVE INPUT DATA. 08020CSR 41 08030COR 43 08040COR 45 MOVELW30A W10A 10 08050CSR 41 08060COR 43 EXSR SR202 R. ADJUST 08070CSR 41 MOVE W10A PARTNO 100 08080CSR 42 MOVELW30A MODEL 12 08090CSR 43 MOVE W10A PROD 40 08100CSR 44 MOVELW30A DESCR 26 08110CSR 45 MOVELW30A MCNNO 5 08120CSR ENDSR 08130C******************************************************************** 08140CSR SR201 BEGSR 08150C* CLASSIFY SELECTION. 08160CSR SELECT COMP 1 41 PART # 08170CSR SELECT COMP 2 42 MODEL 08180CSR SELECT COMP 3 43 PROD 08190CSR SELECT COMP 4 44 DESCR 08200CSR SELECT COMP 5 45 MCN 08210CSR ENDSR 08220C********************************************************************** 08230CSR SR202 BEGSR 08240C* RIGHT JUSTIFY ÐÐ08250CSR Z-ADD10 W2N 20 08260CSR EXIT SUBRAJ R. JUSTIFY 08270CSR RLABL W2N 08280CSR RLABL W10A 08290CSR END202 ENDSR 08300C******************************************************************** 08310CSR SR401 BEGSR 08320C* UTILITY - COMPUTE ADDED LABOR. 08330CSR W5N LOKUPTABDEP TABRAT 54 08340CSRN54 GOTO T401A BAD DEPT 08350CSR MOVELTABRAT RATE 52 08360CSR MOVE TABRAT PCT 42 08370CSR HOURS MULT RATE LABOR 93H 08380CSR PCT MULT LABOR BURD 93H 08390CSR GOTO END401 08400C*------------------------------------------------------------------- 08410CSR T401A TAG 08420C* FLAG ERROR, BAD DEPT. 08430CSR HOURS COMP 0 54 08440CSR Z-ADD0 LABOR 08450CSR Z-ADD0 BURD 08460CSR 54 Z-ADD383 M 96 FLAG ERROR 08470CSR END401 ENDSR 08480O******************************************************************** 08490OTERM132 E 71 ÐÐ08500O* PUT HEADING. 08510O 53 'P A R T' 08520O 67 'M A S T E R' 08530O 83 'D I S P L A Y' 08540O 91 'NO. 1' 08550O*------------------------------------------------------------------- 08560O E 71 08570O 14 'P A R T' 08580O 30 'C H A R A C T' 08590O 46 'E R I S T I C S' 08600O 55 '*' 08610O 81 'C O S T' 08620O 95 'I N F O R M' 08630O 105 'A T I O N' 08640O*------------------------------------------------------------------- 08650O E 71 08660O 70 24 '*** DELETE CANDIDATE ***' 08670O 55 '*' 08680O 70 'ADDED COST ($)' 08690O***** 91 'MANUFACTURING' 08700O***** 111 'ACCOUNTING' 08710O***** 129 'DIFFERENCE' 08720O*------------------------------------------------------------------- 08730O E 71 08740O 16 '(2) PART NUMBER' ÐÐ08750O 23 ':' 08760O PMPN 36 ' - - ' 08770O 55 '*' 08780O 63 '..LABOR' 08790O*------------------------------------------------------------------- 08800O E 71 08810O 16 '(3) DESCRIPTION' 08820O 23 ':' 08830O PMDESC 53 08840O 55 '*' 08850O 66 '....DIRECT' 08860O PM$,1 2 91 08870O******* PA$,1 2 112 08880O******* DIF,1 K 129 08890O*------------------------------------------------------------------- 08900O E 71 08910O 16 '(4) ACCOUNT NO.' 08920O PMACNTZ 29 08930O 23 ':' 08940O ACNAME 46 08950O 55 '*' 08960O 66 '....BURDEN' 08970O PM$,2 2 91 08980O******** PA$,2 2 112 08990O******** DIF,2 K 129 ÐÐ09000O*------------------------------------------------------------------- 09010O E 71 09020O 14 '(5) MODEL NO.' 09030O 23 ':' 09040O PMMODL 36 09050O 55 '*' 09060O 66 '..MATERIAL' 09070O*------------------------------------------------------------------- 09080O E 71 09090O 15 '(6) PROD-CLASS' 09100O 23 ':' 09110O PMPL Z 28 09120O 55 '*' 09130O 76 '....PURCH-COMPONENTS' 09140O PM$,3 2 91 09150O******** PA$,3 2 112 09160O******** DIF,3 K 129 09170O*------------------------------------------------------------------- 09180O E 71 09190O 22 '(7) PROVISIONING CODE' 09200O 23 ':' 09210O PMPROV 25 09220O PRVNAM 49 09230O 55 '*' 09240O 75 '....MATERIAL BURDEN' ÐÐ09250O PM$,4 2 91 09260O********* PA$,4 2 112 09270O********* DIF,4 K 129 09280O*------------------------------------------------------------------- 09290O E 71 09300O 16 '(8) SOURCE-CODE' 09310O 23 ':' 09320O PMSC 26 09330O SCNAME 42 09340O 55 '*' 09350O 72 '....VENDOR-COSTS' 09360O PM$,5 2 91 09370O******** PA$,5 2 112 09380O******** DIF,5 K 129 09390O*------------------------------------------------------------------- 09400O E 71 09410O 15 '(9) ISSUE-CODE' 09420O 23 ':' 09430O PMISSU 26 09440O ICNAME 42 09450O 55 '*' 09460O 80 'CUM-COSTS (LOWER-INDENT)' 09470O*------------------------------------------------------------------- 09480O E 71 09490O 13 '(10) FAB-CODE' ÐÐ09500O 23 ':' 09510O PMFABC 26 09520O 55 '*' 09530O 63 '..LABOR' 09540O PM$,6 2 91 09550O******** PA$,6 2 112 09560O******** DIF,6 K 129 09570O*------------------------------------------------------------------- 09580O E 71 09590O 17 '(11) UNIT-MEASURE' 09600O 23 ':' 09610O PMUM 26 09620O UMNAME 42 09630O 55 '*' 09640O 66 '..MATERIAL' 09650O PM$,7 2 91 09660O********** PA$,7 2 112 09670O********** DIF,7 K 129 09680O*------------------------------------------------------------------- 09690O E 71 09700O 17 '(12) DRAWING-SIZE' 09710O 23 ':' 09720O PMSIZ 26 09730O 55 '*' 09740O 69 'STANDARD COST' ÐÐ09750O 79 '(21)' 09760O PMTCST2 91 09770O PMOSUC2 112 09780O*------------------------------------------------------------------- 09790O E 71 09800O 19 '(13) REVISION-LEVEL' 09810O PMECHG 26 09820O 23 ':' 09830O 55 '*' 09840O 72 'DATE ESTABLISHED' 09850O 79 '(22)' 09860O PMCDAT 91 ' - - ' 09870O PMSDAT 109 ' - - ' 09880O*------------------------------------------------------------------- 09890O E 71 09900O 16 '(14) LAST ECN #' 09910O 23 ':' 09920O PMECN 29 09930O 55 '*' 09940O 74 'METHOD ESTABLISHED' 09950O 79 '(23)' 09960O PMCCCD 84 09970O PMSCCD 105 09980O****** METHM 100 09990O****** METHA 121 ÐÐ10000O*------------------------------------------------------------------- 10010O E 71 10020O 19 '(15) LAST ECN DATE' 10030O 23 ':' 10040O PMDCHG 31 ' - - ' 10050O 55 '*' 10060O 79 'STANDARD LOT SIZE (24)' 10070O PMCLOT2 88 10080O PMSLOT2 106 10090O*------------------------------------------------------------------- 10100O E 71 10110O 20 '(16) DWG REL STATUS' 10120O 23 ':' 10130O PMRELS 25 10140O RELNAM 42 10150O 55 '*' 10160O 66 'DEPARTMENT' 10170O 81 'HRS-REQUIRED' 10180O 93 'AMOUNT' 10190O 122 'A C C O U N T I N G' 10200O*------------------------------------------------------------------- 10210O E 71 10220O 12 '(17) M.C.N.' 10230O 23 ':' 10240O PMMCN 29 ÐÐ10250O 55 '*' 10260O 60 '(25)' 10270O MDP,1 Z 64 10280O 73 '(26)' 10290O MHR,1 2 82 10300O MXT,1 2 93 10310O 110 'DEPARTMENT' 10320O 121 'HRS-REQD' 10330O 132 'VALUE' 10340O*------------------------------------------------------------------- 10350O E 71 10360O 12 'SALES-PRICE:' 10370O PMLPUD 21 ' - - ' 10380O 55 '*' 10390O 60 '(27)' 10400O MDP,2 Z 64 10410O 73 '(28)' 10420O MHR,2 2 82 10430O MXT,2 2 93 10440O ADP,1 Z 106 10450O AHR,1 2 121 10460O AXT,1 2 132 10470O*------------------------------------------------------------------- 10480O E 71 10490O 15 '(18) LIST-PRICE' ÐÐ10500O 23 ':' 10510O PMLPR 2 35 10520O 55 '*' 10530O 60 '(29)' 10540O MDP,3 Z 64 10550O 73 '(30)' 10560O MHR,3 2 82 10570O MXT,3 2 93 10580O ADP,2 Z 106 10590O AHR,2 2 121 10600O AXT,2 2 132 10610O*------------------------------------------------------------------- 10620O E 71 10630O 14 '(19) GSA PRICE' 10640O 23 ':' 10650O PMGSA 2 35 10660O 55 '*' 10670O 60 '(31)' 10680O MDP,4 Z 64 10690O 73 '(32)' 10700O MHR,4 2 82 10710O MXT,4 2 93 10720O ADP,3 Z 106 10730O AHR,3 2 121 10740O AXT,3 2 132 ÐÐ10750O*------------------------------------------------------------------- 10760O E 71 10770O 18 '(20) SET-UP CHARGE' 10780O 23 ':' 10790O PMSUPR2 35 10800O 55 '*' 10810O 60 '(33)' 10820O MDP,5 Z 64 10830O 73 '(34)' 10840O MHR,5 2 82 10850O MXT,5 2 93 10860O*------------------------------------------------------------------- 10870O E 71 10880O DASH 54 10890O 55 '*' 10900O 60 '(35)' 10910O MDP,6 Z 64 10920O 73 '(36)' 10930O MHR,6 2 82 10940O MXT,6 2 93 10950O 110 'TOTAL ACTG HRS:' 10960O ACTHRS2 121 10970O ACTVAL2 132 10980O*------------------------------------------------------------------- 10990O E 71 ÐÐ11000O 15 'QTY-ON-HAND :' 11010O PMOHB K 25 11020O 27 '*' 11030O 43 'LOW-LEVEL-CODE :' 11040O PMLL Z 46 11050O 55 '*' 11060O 60 '(37)' 11070O MDP,7 Z 64 11080O 73 '(38)' 11090O MHR,7 2 82 11100O MXT,7 2 93 11110O 109 'TOTAL MFG HRS:' 11120O MFGHRS2 121 11130O MFGVAL2 132 11140O*------------------------------------------------------------------- 11150O E 71 11160O 15 'QTY-ON-ORDER :' 11170O TOTORDK 26 11180O 27 '*' 11190O 42 'NUMB-COMPONENTS' 11200O 43 ':' 11210O PMNOBM2 51 11220O 55 '*' 11230O 60 '(39)' 11240O MDP,8 Z 64 ÐÐ11250O 73 '(40)' 11260O MHR,8 2 82 11270O MXT,8 2 93 11280O*------------------------------------------------------------------- 11290O E 71 11300O 15 'QTY-REQD-PROD :' 11310O TOTREQ2 25 11320O 27 '*' 11330O 36 'COMMODITY' 11340O 43 ':' 11350O PMCC Z 54 11360O 55 '*' 11370O 60 '(41)' 11380O MDP,9 Z 64 11390O 73 '(42)' 11400O MHR,9 2 82 11410O MXT,9 2 93 11420O*------------------------------------------------------------------- 11430O E 71 11440O 15 'QTY-REQD-SALES:' 11450O PMSOB 2 25 11460O 27 '*' 11470O 36 'INSP CODE' 11480O 43 ':' 11490O PMINSP 48 ÐÐ11500O 55 '*' 11510O 60 '(43)' 11520O MDP,10Z 64 11530O 73 '(44)' 11540O MHR,102 82 11550O MXT,102 93 11560O*------------------------------------------------------------- 11570O E 71 11580O 15 'STOCK-LOCATION:' 11590O PMSLOC 22 11600O 27 '*' 11610O 43 'CYCLE INV FREQ :' 11620O PMFCYCZ 48 11630O 55 '*' 11640O 60 '(45)' 11650O MDP,11Z 64 11660O 73 '(46)' 11670O MHR,112 82 11680O MXT,112 93 11690O*------------------------------------------------------------------- 11700O E 71 11710O 16 'INVENTORY CLASS:' 11720O PMINVC 18 11730O 27 '*' 11740O 44 'LAST CYCLE COUNT:' ÐÐ11750O PMDLCI 53 ' - - ' 11760O 55 '*' 11770O 60 '(47)' 11780O MDP,12Z 64 11790O 73 '(48)' 11800O MHR,122 82 11810O MXT,122 93 11820O*------------------------------------------------------------------- 11830O E 73 11840O 96 55 'E R R O R ' 11850O N96 55 ' ' 11860O MGTEXT 35 11870O BIT,8 132 11880O*-------------------------------------------------------------- 11890O E 71 11900O 1 ' ' 11910O*------------------------------------------------------------------- 11920O E 71 11930O* PUT HEADING. 11940O 50 'O R D E R' 11950O 64 'P O L I C Y' 11960O 81 'D I S P L A Y' 11970O*------------------------------------------------------------------- 11980O E 71 11990O 11 'PART-NUMBER' ÐÐ12000O 25 'DESCRIPTION' 12010O 50 'MODEL' 12020O 63 'PROD' 12030O 76 'SOURCE-CODE' 12040O 92 'ISSUE-CODE' 12050O 107 'FAB-CODE' 12060O 121 'PROV-CODE' 12070O*------------------------------------------------------------------- 12080O E 71 12090O*------------------------------------------------------------------- 12100O E 71 12110O PMPN 12 ' - - ' 12120O PMDESC 43 12130O PMMODL 57 12140O PMPL Z 63 12150O PMSC 67 12160O SCNAME B 80 12170O PMISSU 84 12180O ICNAME B 97 12190O PMFABC 101 12200O PMPROV 108 12210O PRVNAM B 132 12220O*------------------------------------------------------------------- 12230O E 71 12240O DIV 37 ÐÐ12250O 39 '--' 12260O DIV 76 12270O 77 '*' 12280O DIV 114 12290O DIV 132 12300O*------------------------------------------------------------------- 12310O E 71 12320O 70 24 '*** DELETE CANDIDATE ***' 12330O*------------------------------------------------------------------- 12340O E 71 12350O 33 'O R D E R' 12360O 47 'P O L I C Y' 12370O 77 '*' 12380O 100 'S T A T U S' 12390O 116 '/ H I S T O R Y' 12400O*------------------------------------------------------------------- 12410O E 71 12420O 10 'LEAD-TIMES' 12430O 19 '(M-DAYS)' 12440O 38 '*' 12450O 58 'LOT-SIZING-CRITERIA' 12460O 77 '*' 12470O 86 'ACTIVITY' 12480O 110 'CURRENT-BALANCE' 12490O 120 'USAGE' ÐÐ12500O 132 'FREQUENCY' 12510O*------------------------------------------------------------------- 12520O E 71 12530O 19 '(2) PROD CONTROL' 12540O 24 ':' 12550O PLT,1 Z 28 12560O 60 '(20) MIN ORDER SPAN' 12570O 64 ':' 12580O 38 '*' 12590O PMM,1 2 74 12600O 77 '*' 12610O 93 'ON-HAND-STOCK' 12620O 99 ':' 12630O PMOHB K 110 12640O*---------------------------------------------------------------- 12650O E 71 12660O 17 '(3) PURCHASING' 12670O 24 ':' 12680O PLT,2 Z 28 12690O 38 '*' 12700O 45 '(21)' 12710O 59 'MIN ORDER QTY' 12720O 64 ':' 12730O PMM,2 2 74 12740O 77 '*' ÐÐ12750O 91 'PURCH REQ''S' 12760O 99 ':' 12770O PMPRB K 110 12780O*--------------------------------------------------------------- 12790O E 71 12800O 13 '(4) VENDOR' 12810O 24 ':' 12820O PLT,3 Z 28 12830O 38 '*' 12840O 45 '(22)' 12850O 57 'MIN ORD $$$' 12860O 64 ':' 12870O PMM,3 2 74 12880O 77 '*' 12890O 92 'PURCH-ORDERS' 12900O 99 ':' 12910O PMPOB K 110 12920O*------------------------------------------------------------------- 12930O E 71 12940O 24 '(5) STORES, PULL KIT:' 12950O PLT,4 Z 28 12960O 38 '*' 12970O 60 '(23) MAX ORDER SPAN' 12980O 64 ':' 12990O PMM,4 2 74 ÐÐ13000O 77 '*' 13010O 93 'RECEIVED-P.O.' 13020O 99 ':' 13030O PMRPOBK 110 13040O*------------------------------------------------------------------- 13050O E 71 13060O 21 '(6) SHOP, FAB/ASSY' 13070O 24 ':' 13080O PLT,5 Z 28 13090O 38 '*' 13100O 45 '(24)' 13110O 59 'MAX ORDER QTY' 13120O 64 ':' 13130O PMM,5 2 74 13140O 77 '*' 13150O 91 'WORK ORDERS' 13160O 99 ':' 13170O***** TOTWOBKB 110 13180O*------------------------------------------------------------------- 13190O E 71 13200O 19 '(7) INSPECT/TEST' 13210O 24 ':' 13220O PLT,6 Z 28 13230O 38 '*' 13240O 45 '(25)' ÐÐ13250O 59 'MAX ORDER $$$' 13260O 64 ':' 13270O PMM,6 2 74 13280O 77 '*' 13290O 92 'SALES ORDERS' 13300O 99 ':' 13310O PMSOB K 110 13320O*------------------------------------------------------------------- 13330O E 71 13340O 24 '(8) STORES, PUT AWAY:' 13350O PLT,7 Z 28 13360O 38 '*' 13370O 45 '(26)' 13380O 62 'SAFETY STOCK QTY' 13390O 64 ':' 13400O PMSSTK2 74 13410O 77 '*' 13420O 94 'PROD-REQMT,REL' 13430O 99 ':' 13440O PMRLB K 110 13450O*------------------------------------------------------------------- 13460O E 71 13470O 18 '(9) CUM LEAD ' 13480O 24 ':' 13490O PLT,8 Z 28 ÐÐ13500O 38 '*' 13510O 45 '(27)' 13520O 64 ':' 13530O 77 '*' 13540O 98 'PROD-REQMT,PLANNED' 13550O 99 ':' 13560O PMALB K 110 13570O*------------------------------------------------------------------- 13580O E 71 13590O 38 '*' 13600O 61 '(28) ROUNDING FACTOR' 13610O 64 ':' 13620O PMRNDF2 74 13630O 77 '*' 13640O 88 'FORECAST' 13650O PMFRCBK 110 13660O 99 ':' 13670O*------------------------------------------------------------------- 13680O E 71 13690O 24 'TOTAL LEAD TIME:' 13700O LTTOT ZB 28 13710O 38 '*' 13720O 45 '(29)' 13730O 57 'E.O.Q. CODE' 13740O 64 ':' ÐÐ13750O PMEOQ 67 13760O 77 '*' 13770O 90 'BACKORDERS' 13780O 99 ':' 13790O PMBOB K 110 13800O*------------------------------------------------------------------- 13810O E 71 13820O DIV 37 13830O 38 '*' 13840O 45 '(30)' 13850O 62 'E.O.Q. PARAMETER' 13860O 64 ':' 13870O PMEOQP 67 13880O 77 '*' 13890O 93 'AVAILABLE-BAL' 13900O 99 ':' 13910O*** *** *** AVAIL K 110 13920O*------------------------------------------------------------------- 13930O E 71 13940O 16 'PLANNING HORIZON' 13950O 31 'BY REQUIREMENT' 13960O 36 'TYPE' 13970O 38 '*' 13980O 39 '-' 13990O DIV 76 ÐÐ14000O 77 '*' 14010O 96 'CUSTOMER RETURNS' 14020O 99 ':' 14030O PMUCRTK 122 14040O PMQCRTK 131 14050O*------------------------------------------------------------------- 14060O E 71 14070O 19 '(12) SALES ORDERS' 14080O 24 ':' 14090O PHZ,1 Z 28 14100O 38 '*' 14110O 55 'EXCEPTION-REPORT' 14120O 64 'CRITERIA' 14130O 77 '*' 14140O 85 'SCRAP' 14150O 99 ':' 14160O PMUSCRK 122 14170O PMQSCRK 131 14180O*------------------------------------------------------------------- 14190O E 71 14200O 22 '(13) PROD-REQMT, REL' 14210O 24 ':' 14220O PHZ,2 Z 28 14230O 38 '*' 14240O 45 '(35)' ÐÐ14250O 61 'MAX SURPLUS QTY' 14260O 64 ':' 14270O PMSQTY2 74 14280O 77 '*' 14290O 95 'UNPLANNED-USAGE' 14300O 99 ':' 14310O PMUISSK 122 14320O PMQISSK 131 14330O*------------------------------------------------------------------- 14340O E 71 14350O 23 '(14) PROD-REQMT, PLAN' 14360O 24 ':' 14370O PHZ,3 Z 28 14380O 38 '*' 14390O 59 '(36) MAX-SURPLUS %' 14400O 64 ':' 14410O PMSPCTZ 74 14420O 75 '%' 14430O 77 '*' 14440O 93 'PLANNED-USAGE' 14450O 99 ':' 14460O PMPISSK 122 14470O PMFISSK 131 14480O*------------------------------------------------------------------- 14490O E 71 ÐÐ14500O 15 '(15) FORECAST' 14510O 24 ':' 14520O PHZ,4 Z 28 14530O 38 '*' 14540O 45 '(37)' 14550O 62 'MAX-SURPLUS-SPAN' 14560O 64 ':' 14570O PMSSP 2 74 14580O 77 '*' 14590O 89 'SHIPMENTS' 14600O 99 ':' 14610O PMPSHPK 122 14620O PMFSHPK 131 14630O*------------------------------------------------------------------- 14640O E 71 14650O 19 '(16) SAFETY-STOCK' 14660O 24 ':' 14670O PHZ,5 Z 28 14680O 38 '*' 14690O 45 '(38)' 14700O 63 'MAX-SHORTAGE-SPAN' 14710O 64 ':' 14720O PMSHSP2 74 14730O 77 '*' 14740O 96 'PLANNED-RECEIPTS' ÐÐ14750O 99 ':' 14760O PMPRCTK 122 14770O PMFRCTK 131 14780O*------------------------------------------------------------------- 14790O E 71 14800O 38 '*' 14810O 77 '*' 14820O*------------------------------------------------------------------- 14830O E 71 14840O 38 '*' 14850O 77 '*' 14860O 123 '* CURRENT-REV :' 14870O PMECHG 126 14880O*------------------------------------------------------------------- 14890O E 71 14900O 38 '*' 14910O 77 '*' 14920O 98 'NUMB OF COMPONENTS' 14930O 99 ':' 14940O PMNOBMZ 106 14950O 118 '* DWG-SIZE' 14960O 123 ':' 14970O PMSIZ 125 14980O*--------------------------------------------------------------- 14990O E 71 ÐÐ15000O AST 132 15010O*------------------------------------------------------------------- 15020O E 68 15030O 15 'ENTER NEXT ITEM' 15040O 37 'OR CARRIAGE RETURN TO' 15050O 43 'CONTU' 15060O BIT,8 132 15070O*------------------------------------------------------------------- 15080O E 72 15090O AST 132 15100O E 72 15110O 10 'ACCESS BY:' 15120O E 72 15130O 12 '(1) PART #' 15140O E 72 15150O 13 '(2) MODEL #' 15160O E 72 15170O 16 '(3) PROD CLASS' 15180O E 72 15190O 17 '(4) DESCRIPTION' 15200O E 72 15210O 17 '(5) MCN NO. ' 15220O******************************************************************** 15230OCRTFILE E 97 15240O PROG 26 ÐÐ15250O CRTIME 33 15260O CRDATE 37 15270O LNK 79 ** A30 ARRAY 015280 015290** TOT ARRAY - COST TOTALS 015300 015310** TABACT/TABACN - ACCOUNT NAMES 01532012100FINISHED GOODS 01533014100DETAIL PARTS 01534014600SLOW-MOVING 015350** TABRC/TABRCN - DWG REL CODES 015360EENG USE ONLY 015370MREL FOR MFG 015380PPROTOTYPE 015390XPRE-RELEASE 015400** TABISS/TABICN - ISSUE CODES 015410PTPULL TIME 015420ORON REQUEST 015430BIBULK ISSUE 015440ARAS REQD 015450VSVENDOR SUPL 015460SDSHIPPING DOC 015470TDTRAVELER DOC 015480RDREF DOC ONLY 015490ÐÐRAREF ASSY/PART 015500** TABSC/TABSCN - SOURCE CODES 015510MAMFG ASSY 015520MPMFG PART 015530PAPURCH ASSY 015540PPPURCH PART 015550RDREF DOC ONLY 015560RSRAW STOCK 015570** TABUM/TABUMN - UNITS MEASURE 015580EAEACH 015590STSET 015600ININCH 015610FTFOOT 015620YDYARD 015630SISQ INCH 015640SFSQ FOOT 015650SYSQ YARD 015660OZOUNCE 015670TCTROY OZ 015680LBPOUND 015690PTPINT 015700QTQUART 015710GLGALLON 015720DRDRUM 015730** TABPV/TABPVN - PROVISIONING CODES/NAMES 015740ÐÐAFRCST-NO VAL ADDED 015750BFRCST-VAL ADDED 015760CFRCST-BUILD TO ORD 015770DNON-FRCST-BUILD TO ORD 015780ECUSTOM 015790YOBSLETE-REPAIRABLE 015800ZOBSLETE-NO REPAIR 015810** DIF ARRAY - STD LESS CUR $ COST INPUT 015820 015830** VAR ARRAY - STD LESS MFG HRS INPUT 015840 015850** DASH ARRAY 015860 015870** DIV ARRAY 15880------------------------------------- 015890** AST ARRAY 015900** MXT ARRAY 015910 015920** AXT ARRAY 015930 015940** LNK ARRAY 015950 15960/* 15970_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(xÓ X005TX P120282120282(èÈÐ00010H Q005TX00020F* TEXT PRINTER. (X005TX) 00030F* REVISED 6/15/81 10:15 AM. 00040F* SWITCH-1 SUPPRESSES DIABLO OUTPUT & OUTPUTS CONTENTS AND INDEX 00050F* SWITCH-2 PRINTS LINE CONTROL AT RIGHT-HAND MARGIN, AND 00060F* PROCEDURE NAME AT HEADING LINE-1. 00070F* SWITCH-3 PRINTS COVER PAGE. 00080F* SWITCH-4 SUPRESSES 'CONTD'. 00090F* CONTROL-D WILL CAUSE HALT AT THE FRONT OF THE FIRST FORWARD PRINT LINE.00100FBITHEX IP F 256 DISK 00110FTXNAME US F 80 DISK 00120FTXMAST ID F 86L10AI 1 DISK 00130FTXFILE IC F 92R DISK 00140FMGFILE IC F 80R DISK 00150E******************************************************************** 00160E AR 1 148 1 A OUTPUT ARRAY 00170E NAM 1 10 8 A STACK-NAME 00180E SP 1 10 4 0 LINE # STACK 00190E PTR 12000 5 0A 00200E MES 1 1 35 ERROR MSG 00210E HDG 1 9132 A HEADING ARRAY 00220E HSP 9 9 1 HEADING SPACE CODE 00230E HX 9 9 5 0 HDG TEXT LINE 00240E HT 9 9 1 HDG TYPE 00250E HL 9 9 1 0 HDG LINE# ÐÐ00260E HC 9 9 2 0 HDG COUNT 00270E SHD 1 9132 SAVE HDG 00280E SHS 9 9 1 SAVE HSP 00290E SHX 9 9 5 0 SAVE HX 00300E SHT 9 9 1 SAVE HT 00310E SHL 9 9 1 0 SAVE HL 00320E HN 1 9 8 HDG NAMES 00330E SHN 1 9 8 SAVE HN 00340E SHC 9 9 2 0 SAVE HC 00350E FTN 1 9132 A FOOTNOTE ARRAY 00360E FX 9 9 5 0 00370E FT 9 9 1 00380E FL 9 9 1 0 00390E FN 1 9 8 00400E RA 1 148 1 A WORK ARRAY 00410E DEL 1 5 8 A DELAYED PRINT NAMES 00420E DPL 1 5 1 0 DELAYED PRINT LINE 00430E BIT 256 1 BITHEX FILE 00440E REC 132 1 TXFILE 00450E TMP 25 5 0A 00460E TXT 80 1 00470I******************************************************************** 00480IBITHEX BT 01 00490I 1 256 BIT 00500I******************************************************************** ÐÐ00510ITXNAME IP 02 80NCD 00520I* TEXT NAME 8A 00530I 1 8 IPNAME 00540I* REQUESTED BY 12A 00550I 13 24 IPREQ 00560I* DEPT 12A 00570I 29 40 IPDEPT 00580I* START LINE # 5N 00590I 45 490IPBEG 00600I* END LINE # 5N 00610I 54 580IPEND 00620I* LINES PER PAGE 3N 00630I 63 650IPLINE 00640I* CHAR PER IN (PITCH) 2N 00650I 67 680IPCPI 00660I* LINES PER INCH 2N 00670I 69 700IPLPI 00680I* RECORD STATUS 1A 00690I 80 80 IPSTAT 00700I*------------------------------------------------------------------- 00710I GG 03 00720I******************************************************************** 00730IMGFILE MG 00740I 1 60 MGTEXT 00750I******************************************************************** ÐÐ00760ITXMAST SM 00770I* TEXT MASTER RECORD 00780I* TEXT NAME 00790I* NAME 8A 00800I 1 8 TMNAME 00810I* PAGE # 2N 00820I 9 100TMPAGE 00830I* POINTERS 5P X 25 00840I P 11 85 TMP 00850I******************************************************************** 00860ITXFILE TX 00870I* SALES ORDER TEXT DATA. 00880I* TEXT 80 X 1A 00890I 1 80 TXT 00900I* TEXT NAME 8A 00910I 81 88 TXNAME 00920I* RECORD TYPE 1A 00930I* BLANK = TEXT H = HEADING 00940I* T = TEXT F = FOOTNOTE 00950I 89 89 TXTYPE 00960I* HEADING/FOOTNOTE LINE # 1N 00970I 90 900TXHLIN 00980I* SPACE BEFORE PRINT CODE 1A 00990I 91 91 TXSPAC 01000I* RECORD STATUS 1A ÐÐ01010I 92 92 TXSTAT 01020C******************************************************************** 01030C* INITIALIZE. 01040C 02 IPNAME COMP BLK8 02 01050C N02 GOTO ENDJOB 01060C Z-ADD0 ZERO4 40 STUPIDITY 01070C Z-ADD0 ZERO5 50 STUPIDITY 01080C MOVE ' ' BLK8 8 STUPIDITY 01090C MOVE BLK8 DEL INIT 01100C EXSR SR101 INIT. 01110C* SET-UP 1ST PRINT LINE. 01120C Z-ADDIPBEG P 01130C P SUB 1 P 01140C*------------------------------------------------------------------- 01150C START TAG 01160C* GET NEXT LINE. 01170C 1 ADD P P 01180C P COMP 2000 54 01190C N54 P COMP IPEND 54 01200C 54 GOTO END 01210C PTR,P COMP 0 54 01220C N54 GOTO START 01230C* GET TXFILE RECORD. 01240C Z-ADDPTR,P RRN 50 01250C EXSR SR82 GET TXFILE ÐÐ01260C N60 GOTO TAG30 GOT IT 01270C EXSR SR902 FLAG ERROR 01280C GOTO START 01290C*------------------------------------------------------------------- 01300C TAG30 TAG 01310C* BRANCH ON RECORD TYPE. 01320C TXTYPE COMP 'L' 54 01330C TXTYPE COMP 'X' 55 01340C TXTYPE COMP 'C' 56 01350C 54 GOTO TAG40 LINKAGE 01360C 55 GOTO TAG50 INDEX 01370C 56 GOTO TAG60 CONTENTS 01380C* PROCESS TEXT RECORD. 01390C EXSR SR102 PRINT TEXT 01400C 69 GOTO START DELAYED PRINT 01410C GOTO START 01420C*------------------------------------------------------------------- 01430C TAG40 TAG 01440C* PROCESS LINKAGE RECORD. 01450C U2 EXSR SR205 PRINT LINK STMT 01460C REC,1 COMP '*' 54 01470C 54 GOTO TAG45 DELAYED PRINT 01480C 1 ADD P P LINE BYPASS 01490C EXSR SR103 PROCESS LINKAGE 01500C EXSR SR405 INIT HEADINGS ÐÐ01510C GOTO START LINK & PRINT 01520C*------------------------------------------------------------------- 01530C TAG45 TAG 01540C* PROC DELAYED PRINT LINKAGE. 01550C EXSR SR107 01560C GOTO START 01570C*------------------------------------------------------------------- 01580C TAG50 TAG 01590C* PROCESS INDEX RECORD. 01600C U1 EXSR SR104 PROCESS INDEX 01610C GOTO START 01620C*------------------------------------------------------------------- 01630C TAG60 TAG 01640C* PROCESS CONTENTS RECORD. 01650C U1 EXSR SR105 PROCESS CONTENTS 01660C GOTO START 01670C*------------------------------------------------------------- 01680C TAG100 TAG 01690C* RECOVER FROM DELAYED PRINT, IF JUST CONCLUDED 01700C SETOF 7380 DEL PRT FLAG 01710C N70 GOTO TAG120 DEL PRT NOT ACTIVE 01720C* IF NO MORE DELAYED PRINT, RESTART HEADINGS 01730C BLK8 LOKUPDEL 54 01740C 54 GOTO TAG110 MORE DEL PRT 01750C SETON 72 RESUME HDG FLAG ÐÐ01760C EXSR SR403 RESTORE HEADINGS 01770C Z-ADDLSTHDG HPEND HDG START LINE 01780C EXSR SR203 PRT HEADING 01790C SETOF 72 01800C GOTO TAG120 POP STACK 01810C*------------------------------------------------------------------ 01820C TAG110 TAG 01830C* SET-UP NEXT DELAYED PRINT IN SERIES 01840C EXSR SR310 SETUP DEL PRT 01850C GOTO START 01860C*----------------------------------------------------------------- 01870C TAG120 TAG 01880C* POP CALL STACK 01890C Z-ADD1 N 40 01900C BLK8 LOKUPNAM,N 54 01910C N54 GOTO END 01920C NAM,N CHAINTXMAST 60 01930C 60 EXSR SR206 CLEAR STACK 01940C 60 GOTO END 01950C SETOF 7071 01960C MOVE NAM,N IPNAME 01970C Z-ADDSP,N P LINE # 01980C EXSR SR206 CLEAR STACK 01990C GOTO START START AGAIN 02000C*------------------------------------------------------------------- ÐÐ02010C END TAG 02020C* LAST PAGE 02030C SETOF 80 02040C N70 SETON 71 02050C EXSR SR310 GET DELAYED PRINT 02060C 69 GOTO START GOT IT 02070C SETOF 73 02080C EXSR SR302 FINAL FOOTNOTES 02090C*------------------------------------------------------------------- 02100C ENDJOB TAG 02110CLR EXSR SR68 TOP FORM 02120C******************************************************************** 02130CSR SR65 BEGSR 02140C* SPACE-3. 02150CSR EXSR SR66 02160CSR EXSR SR67 02170CSR ENDSR 02180C******************************************************************** 02190CSR SR66 BEGSR 02200C* SPACE-2. 02210CSR EXSR SR67 02220CSR EXSR SR67 02230CSR ENDSR 02240C******************************************************************** 02250CSR SR67 BEGSR ÐÐ02260C* LINE SPACE. 02270CSRNU1 EXITFQCLF LINE FEED ONLY 02280CSR 1 ADD LINENO LINENO 02290CSR ENDSR 02300C******************************************************************** 02310CSR SR68 BEGSR 02320C* TOP OF FORM. 02330CSRNU1 EXITFZTFORM 02340CSR Z-ADD1 LINENO 02350CSR 1 ADD EGAP EGAP 40 PAGE # 02360CSR Z-ADD5 W2N 02370CSR MOVE '2' W1A 02380CSR MOVE BLK6 PAGNO 5 02390CSR EXIT SUBRED EDIT PAGE # 02400CSR RLABL EGAP SOURCE 02410CSR RLABL W1A EDIT CODE 02420CSR RLABL PAGNO RESULT 02430CSR RLABL W2N END POS 02440CSR SETON 40 02450CSR ENDSR 02460C******************************************************************** 02470CSR SR69 BEGSR 02480C* PUT TO DIABLO. 02490CSRN40 EXSR SR68 TOP FORM 02500CSRNU1 EXITFZD148 PUT DIABLO ÐÐ02510CSR RLABL W148A 02520CSR ENDSR 02530C******************************************************************** 02540CSR SR70 BEGSR 02550C* PUT DIABLO. 02560CSR EXSR SR401 FIND NON-BLK 02570CSRN54 GOTO END70 02580CSR EXSR SR67 LF 02590C* DO HEADING LINE 1 FIX 02600CSRN40 EXSR SR68 TOP FORM 02610CSR 78 H COMP 1 54 02620CSR 78 54 MOVEA'PAGE' AR,124 02630CSR 78 54 MOVEAPAGNO AR,128 02640CSR 78 54 MOVEATODAY AR,11 02650CSR 78 54 U2 MOVEASAVIPN AR,1 02660CSRNU1 77 EXSR SR311 SUBSCRIPTS 02670CSR EXSR SR308 BOLD PRINT 02680CSR EXSR SR309 UNDERLINE 02690CSR MOVEAAR W148A 148 02700CSR EXSR SR69 PUT DIABLO 02710CSR 78NU4 EXSR SR312 PUT CONTD 02720CSR MOVE ' ' AR 02730CSR END70 ENDSR 02740C******************************************************************** 02750CSR SR82 BEGSR ÐÐ02760C* GET TXFILE. 02770CSR RRN CHAINTXFILE 60 02780CSR ENDSR 02790C******************************************************************** 02800CSR SR101 BEGSR 02810C* INITIALIZE. 02820C*------------------------------------------------------------------- 02830C* PRINT COVER PAGE. 02840CSR SETON 40 02850CSR SETOF 707173 DEL PRT FLAGS 02860CSR SETOF 74 HDG DONE FLAG 02870CSR Z-ADD0 LINK 40 02880CSR MOVE ' ' AR 02890CSR MOVE IPNAME SAVIPN 8 02900CSR IPBEG COMP 0 54 02910CSRN54 Z-ADD1 IPBEG 02920CSR IPEND COMP 0 54 02930CSRN54 Z-ADD1 IPEND 02940CSR IPEND COMP 2000 5454 02950CSRN54 Z-ADD2000 IPEND 02960CSR IPEND COMP IPBEG 54 54 02970CSRN54 Z-ADDIPEND IPBEG 02980C* SET CHAR PER IN. 02990CSR EXSR SR207 CLASSIFY CPI 03000CSRN55N56N57 Z-ADD15 IPCPI ÐÐ03010CSR EXSR SR207 CLASSIFY CPI 03020CSR 55 MOVE '06' W2A 2 6-LPI 03030CSR 56 MOVE '08' W2A 8-LPI 03040CSR 57 MOVE '10' W2A 10-LPI 03050CSRNU1 EXITFZVMI SET VERTICAL SPAC 03060CSR RLABL W2A 03070CSR 55 MOVE '10' W2A 03080CSR 56 MOVE '12' W2A 03090CSR 57 MOVE '15' W2A 03100CSRNU1 EXITFZHMI SET HORIZ SPACING 03110CSR RLABL W2A 03120CSR IPLINE COMP 0 54 03130CSR 55N54 Z-ADD60 IPLINE LINES PER PAGE 03140CSR 56N54 Z-ADD70 IPLINE 03150CSR 57N54 Z-ADD70 IPLINE 03160CSR 55N54 Z-ADD6 IPLPI LINES PER IN 03170CSR 56N54 Z-ADD7 IPLPI 03180CSR 57N54 Z-ADD7 IPLPI 03190CSR U3 EXSR SR68 TOP OF FORM 03200CSR U3 EXSR SR65 SPACE DOWN 03210CSR U3 EXSR SR65 SPACE DOWN 03220CSR U3 MOVE ' ' AR 03230CSR U3 MOVEASAVIPN AR,1 03240CSR U3 MOVEAMES,1 W35A 35 03250CSR U3 MOVEAW35A AR,11 ÐÐ03260CSR U3 MOVEAIPREQ AR,24 03270CSR U3 MOVEAIPDEPT AR,38 03280CSR U3 MOVEA'CPI=' AR,60 03290CSR U3 MOVE IPCPI W2A 03300CSR U3 MOVEAW2A AR,64 03310CSR U3 MOVEA'LPP=' AR,68 03320CSR U3 MOVE IPLINE W4A 4 03330CSR U3 MOVEAW4A AR,72 03340CSR U3 MOVEA'LPI=' AR,78 03350CSR U3 MOVE IPLPI W2A 03360CSR U3 MOVEAW2A AR,82 03370CSR U3 EXSR SR70 PRINT COVER PAGE 03380CSRNU1 U3 EXITFQPAUSE 03390CSR SETOF 40 03400CSR Z-ADD0 EGAP 03410CSR MOVE 'Y' W1A 1 03420CSR MOVE BLK8 TODAY 8 03430CSR Z-ADD8 W2N 20 03440CSR EXIT SUBRED DATE EDIT 03450CSR RLABL UDATE SOURCE 03460CSR RLABL W1A EDIT CODE 03470CSR RLABL TODAY RESULT 03480CSR RLABL W2N END POS 03490CSR EXSR SR108 LOAD PTR ARRAY 03500C*------------------------------------------------------------------- ÐÐ03510C* DEFINE WORK FIELDS. 03520CSR MOVE '(' AR,1 ( 03530CSR MOVE BIT,100 AR,2 C 03540CSR MOVE BIT,112 AR,3 O 03550CSR MOVE BIT,111 AR,4 N 03560CSR MOVE BIT,117 AR,5 T 03570CSR MOVE BIT,40 AR,6 APOSTROPHE 03580CSR MOVE BIT,101 AR,7 S 03590CSR MOVE ')' AR,8 ) 03600CSR MOVEAAR,1 CONTD 8 03610CSR MOVE ' ' BLK148148 03620CSR MOVE ' ' BLK6 6 03630CSR MOVE ' ' BLK12 12 03640CSR MOVE BLK8 NAM 03650CSR MOVE ' ' BLK8 8 03660CSR Z-ADD0 SP 03670CSR MOVE BLK148 HDG 03680CSR MOVE BLK148 FTN 03690CSR MOVE ' ' HSP 03700CSR MOVEABLK148 RA 03710CSR MOVE BLK8 DEL 03720CSR Z-ADD0 DPL 03730CSR Z-ADD0 HC 03740CSR Z-ADD0 SHC 03750CSR ENDSR ÐÐ03760C******************************************************************** 03770CSR SR102 BEGSR 03780C* PROCESS HEADING/TEXT/FOOTNOTE. 03790CSR TXTYPE COMP 'H' 54 FLAG HEADING 03800CSRN54 GOTO T102B NOT HEADING 03810C* SAVE HEADING LINE #. 03820CSR EXSR SR202 LINE# DEFAULT 03830CSR HPEND COMP 0 55 03840CSR TXHLIN COMP HPEND 54 03850CSR 55 03860CORN54 Z-ADDTXHLIN HPEND 10 HDG PEND FLAG 03870CSR Z-ADDTXHLIN X 40 03880CSR MOVEAREC HDG,X 03890CSR MOVE TXSPAC HSP,X 03900CSR Z-ADD0 HC,X 03910CSR HSP,X COMP 'S' 54 03920CSR 54 MOVE BLK8 DEL 03930CSR 54 Z-ADD0 DPL 03940CSR U2 Z-ADDP HX,X TEXT LINE # 03950CSR U2 MOVE TXTYPE HT,X TYPE 03960CSR U2 Z-ADDX HL,X HDG LINE # 03970CSR U2 MOVE TMNAME HN,X TEXT NAME 03980C*------------------------------------------------------------------- 03990CSR T102A TAG 04000C* INIT LOWER HEADING LINES. ÐÐ04010CSR 1 ADD X X 04020CSR X COMP 9 54 04030CSR 54 GOTO END102 04040CSR MOVE BLK148 HDG,X 04050CSR MOVE ' ' HSP,X 04060CSR U2 Z-ADD0 HX,X 04070CSR U2 Z-ADD0 HL,X 04080CSR U2 MOVE ' ' HT,X 04090CSR U2 MOVE BLK8 HN,X 04100CSR GOTO T102A 04110C*------------------------------------------------------------------- 04120CSR T102B TAG 04130C* PROCESS FOOTNOTE. 04140CSR TXTYPE COMP 'F' 54 04150CSRN54 GOTO T102C NOT FOOTNOTE 04160CSR EXSR SR202 LINE # DEFAULT 04170CSR Z-ADDTXHLIN X 04180CSR MOVEAREC FTN,X 04190CSR U2 Z-ADDP FX,X TEXT LINE # 04200CSR U2 MOVE TXHLIN FL,X FTN LINE # 04210CSR U2 MOVE TXTYPE FT,X TYPE 04220CSR U2 MOVE TMNAME FN,X TEXT NAME 04230CSR GOTO END102 04240C*------------------------------------------------------------------- 04250CSR T102C TAG ÐÐ04260C* PROCESS TEXT. 04270CSR EXSR SR405 INIT HEADINGS 04280C* BRANCH IF HEADING-PEND FLAG NOT SET. 04290CSR HPEND COMP 0 54 04300CSRN54 GOTO T102D 04310CSR EXSR SR203 PRINT HEADING 04320C*------------------------------------------------------------------- 04330CSR T102D TAG 04340C* SET 59-ON IF INSUFFICIENT ROOM TO PRINT TEXT. 04350CSR SETOF 59 04360CSR EXSR SR204 CHECK SPACE 04370CSR 59 Z-ADD1 HPEND 04380CSR 59N70 SETON 76 OVERFLOW FLAG 04390CSR 59 EXSR SR203 PRINT ALL HEAD 04400CSR SETOF 76 04410CSRN69 EXSR SR205 PRINT TEXT 04420CSR END102 ENDSR 04430C******************************************************************** 04440CSR SR103 BEGSR 04450C* PUSH DOWN CALL STACK. 04460CSR Z-ADD10 Y 40 04470C*------------------------------------------------------------------- 04480CSR T103A TAG 04490CSR Y SUB 1 Y 54 04500CSRN54 GOTO T103B ÐÐ04510CSR 1 ADD Y Z 40 04520CSR MOVE NAM,Y NAM,Z 04530CSR Z-ADDSP,Y SP,Z 04540CSR GOTO T103A 04550C*------------------------------------------------------------------- 04560CSR T103B TAG 04570CSR MOVE TMNAME NAM,1 TEXT-NAME 04580CSR P SUB 1 SP,1 P-INDEX 04590CSR MOVEAREC IPNAME 04600CSR 1 ADD LINK LINK 04610CSR ENDSR 04620C******************************************************************** 04630CSR SR104 BEGSR 04640C* PROCESS INDEX RECORD. 04650CSR SETON 83 04660CSR U1 EXCPT PUT INDEX 04670CSR SETOF 83 04680CSR ENDSR 04690C******************************************************************** 04700CSR SR105 BEGSR 04710C* PROCESS CONTENTS RECORD. 04720CSR SETON 84 04730CSR U1 EXCPT PUT CONTENTS 04740CSR SETOF 84 04750CSR ENDSR ÐÐ04760C******************************************************************** 04770CSR SR106 BEGSR 04780C* CENTER TEXT BETWEEN CARROTS. 04790CSR Z-ADD1 Z 40 04800CSR BIT,95 LOKUPAR,Z 54 FIND CARROT 04810CSRN54 GOTO END106 NO CARROT 04820CSR Z-ADDZ FZ 30 SAVE 1ST CARROT 04830CSR MOVE ' ' AR,FZ BLANK CARROT 04840CSR BIT,95 LOKUPAR,Z 54 FIND NEXT CARROT 04850CSRN54 Z-ADD132 LZ 30 2ND CARROT DEFAULT 04860CSR 54 Z-ADDZ LZ 2ND CARROT FOUND 04870CSR 54 MOVE ' ' AR,Z INIT 2ND CARROT 04880CSR Z-ADDFZ Z 04890CSR ' ' LOKUPAR,Z 54 FIND 1ST CHAR 04900CSRN54 GOTO END106 NO CHARS 04910CSR Z-ADDZ FC 30 1ST CHAR INDEX 04920CSR 1 ADD LZ Z 04930C*------------------------------------------------------------------ 04940CSR T106A TAG 04950CSR Z SUB 1 Z 54 04960CSRN54 GOTO END106 DUMB 04970CSR AR,Z COMP ' ' 54 04980CSRN54 GOTO T106A 04990CSR Z-ADDZ LC 30 LAST CHAR INDEX 05000CSR LC SUB FC NC 30 ÐÐ05010CSR 1 ADD NC NC NUMB OF CHAR 05020CSR LZ SUB FZ W3N 30 NUMB COL SPACE 05030CSR 1 ADD W3N W3N 05040CSR W3N SUB NC W3N 05050CSR W3N DIV 2 W3N 54 OFFSET FROM FZ 05060CSRN54 Z-ADD1 W3N 05070CSR MOVE ' ' RA INIT WORK ARRAY 05080CSR FZ ADD W3N CT 30 COPY TO INDEX 05090CSR CT SUB 1 CT 05100CSR FC SUB 1 Z COPY FROM INDEX 05110C*----------------------------------------------------------------- 05120CSR T106B TAG 05130CSR 1 ADD Z Z 05140CSR Z COMP LC 54 05150CSR 54 GOTO T106C COPY DONE 05160CSR 1 ADD CT CT 05170CSR MOVE AR,Z RA,CT 05180CSR MOVE ' ' AR,Z 05190CSR GOTO T106B 05200C*----------------------------------------------------------------- 05210CSR T106C TAG 05220CSR Z-ADD1 Z 05230C*---------------------------------------------------------------- 05240CSR T106D TAG 05250CSR ' ' LOKUPRA,Z 54 ÐÐ05260CSRN54 GOTO SR106 05270CSR MOVE RA,Z AR,Z 05280CSR MOVE ' ' RA,Z 05290CSR GOTO T106D 05300CSR END106 ENDSR 05310C******************************************************************** 05320CSR SR107 BEGSR 05330C* STORE DELAYED PRINT LINK NAME. 05340CSR 73 GOTO END107 DEL PRT ACTIVE 05350CSR Z-ADD1 S 40 05360CSR BLK8 LOKUPDEL,S 54 05370CSRN54 GOTO END107 OUT OF SPACE 05380CSR MOVEAREC,2 W8A 8 05390CSR MOVE W8A DEL,S LINK NAME 05400CSR Z-ADDTXHLIN DPL,S HDG LINE # 05410CSR END107 ENDSR 05420C******************************************************************** 05430CSR SR108 BEGSR 05440C* LOAD PTRS. 05450CSR Z-ADD0 P 40 05460CSR MOVELIPNAME W10A 10 05470CSR MOVE ' ' W10A 05480CSR W10A SETLLTXMAST 05490CSR Z-ADD0 PTR 05500C*------------------------------------------------------------------- ÐÐ05510CSR T108A TAG 05520CSR SETOF 54 05530CSR READ TXMAST 54 05540CSR 54 GOTO END108 05550CSR TMNAME COMP IPNAME 54 05560CSRN54 GOTO END108 05570CSR Z-ADD1 X 40 05580C*------------------------------------------------------------------- 05590CSR T108B TAG 05600CSR ZERO5 LOKUPTMP,X 54 05610CSRN54 GOTO T108A 05620CSR 1 ADD P P 05630CSR Z-ADDTMP,X PTR,P 05640CSR Z-ADD0 TMP,X 05650CSR GOTO T108B 05660CSR END108 ENDSR 05670C******************************************************************** 05680CSR SR202 BEGSR 05690C* LINE # DEFAULT. 05700CSR TXHLIN COMP 0 54 05710CSR 54 TXHLIN COMP 9 5454 05720CSRN54 Z-ADD9 TXHLIN 05730CSR ENDSR 05740C******************************************************************** 05750CSR SR203 BEGSR ÐÐ05760C* PRINT HEADINGS. 05770CSR SETON 78 05780CSR MOVE ' ' AR 05790C* COUNT LINES TO BE PRINTED. 05800CSR SETOF 596974 05810CSR EXSR SR307 COUNT HEADING 05820CSR 59 GOTO T203A 05830CSR EXSR SR306 COUNT TEXT 05840CSR 59 GOTO T203A 05850CSR EXSR SR305 COUNT FOOTNOTES 05860CSR 59 GOTO T203A 05870CSR LINENO ADD TCOUNT LCOUNT 05880CSR HCOUNT ADD LCOUNT LCOUNT 05890CSR FCOUNT ADD LCOUNT LCOUNT 05900CSR FCOUNT COMP 0 54 05910CSR 54 2 ADD LCOUNT LCOUNT 05920CSR 8 ADD LCOUNT LCOUNT 05930CSR LCOUNT COMP IPLINE 59 05940CSR 59 GOTO T203A 05950CSR GOTO T203B 05960C*------------------------------------------------------------------- 05970CSR T203A TAG 05980CSR SETOF 78 05990CSR EXSR SR302 PRINT FOOTNOTES 06000CSR SETON 78 ÐÐ06010CSR Z-ADD1 HPEND 06020CSR SETON 76 OVERFLOW FLAG 06030CSR SETOF 40 06040C*------------------------------------------------------------------- 06050CSR T203B TAG 06060CSR HPEND SUB 1 H 30 54 54 06070CSRN54 Z-ADD0 H 06080CSR Z-ADD0 HLDHDG 10 06090CSR SETOF 58 06100CSR 70 GOTO T203C DEL HDG FLAG 06110CSR Z-ADD1 S 06120CSR BLK8 LOKUPDEL,S 54 06130CSR 54 Z-ADDDPL,S HLDHDG 06140C*------------------------------------------------------------------- 06150CSR T203C TAG 06160CSR 1 ADD H H 06170CSR H COMP 9 54 06180CSR 54 58 SETON 74 HDG DONE FLAG 06190CSR 54 GOTO T203D 06200CSR MOVE HDG,H W132A 132 06210CSR MOVEAW132A AR 06220CSR EXSR SR401 54=NOT BLK 06230CSRN54 GOTO T203C 06240CSR 76 HLDHDG COMP 0 54 06250CSR 54 76 H COMP HLDHDG 54 54 ÐÐ06260CSR 54 76 GOTO T203D 06270CSRN58 72 HSP,H COMP '2' 54 54 06280CSRN58 72N54 EXSR SR66 SPACE 2 06290CSR MOVE HSP,H W1A 1 06300CSR EXSR SR303 PERFORM SPACING 06310CSR SETON 58 06320CSR EXSR SR106 CENTER LINE 06330CSR U2 MOVE HX,H W5A 06340CSR U2 MOVEAW5A AR,133 06350CSR U2 MOVE HT,H AR,138 06360CSR U2 MOVE HL,H AR,139 06370CSR U2 MOVE HSP,H AR,140 06380CSR U2 MOVEAHN,H AR,141 06390CSR 1 ADD HC,H HC,H PRINT COUNT 06400CSR EXSR SR70 PRT HEADING 06410CSR GOTO T203C 06420C*------------------------------------------------------------------- 06430CSR T203D TAG 06440CSR Z-ADD0 HPEND 06450C* SET-UP DELAYED PRINT. 06460CSR SETOF 78 06470CSR 76N71 EXSR SR310 SET-UP DEL PRT 06480CSR SETOF 76 OVERFLOW FLAG 06490CSR ENDSR 06500C******************************************************************** ÐÐ06510CSR SR204 BEGSR 06520C* CHECK SPACE BEFORE PRINTING TEXT. 06530CSR Z-ADDLINENO LCOUNT 30 06540CSR EXSR SR306 COUNT TXT LINE USAGE 06550CSR 59 GOTO END204 06560CSR TCOUNT ADD LCOUNT LCOUNT 06570CSR EXSR SR305 COUNT FOOTNOTES 06580CSR FCOUNT ADD LCOUNT LCOUNT 06590CSR FCOUNT COMP 0 54 06600CSR 54 2 ADD LCOUNT LCOUNT 06610CSR 5 ADD LCOUNT LCOUNT 06620CSR LCOUNT COMP IPLINE 54 06630CSR 54 SETON 59 06640CSR END204 ENDSR 06650C******************************************************************** 06660CSR SR205 BEGSR 06670C* PRINT TEXT. 06680CSR MOVE ' ' AR 06690CSR MOVE TXSPAC W1A 06700CSR TXTYPE COMP 'L' 54 06710CSRN54 EXSR SR303 PERFORM SPACING 06720CSR MOVEAREC AR 06730CSR EXSR SR106 CENTER LINE 06740CSR U2 MOVE P W5A 5 06750CSR U2 MOVEAW5A AR,133 ÐÐ06760CSR U2 MOVE TXTYPE AR,138 06770CSR U2 MOVE TXHLIN AR,139 06780CSR U2 MOVE TXSPAC AR,140 06790CSR U2 MOVEATMNAME AR,141 06800CSR SETON 77 06810CSR EXSR SR70 PRINT TEXT 06820CSR SETOF 77 06830CSR ENDSR 06840C******************************************************************** 06850CSR SR206 BEGSR 06860C* POP CALL STACK. 06870CSR Z-ADD1 S 06880C*------------------------------------------------------------------- 06890CSR T206A TAG 06900CSR 1 ADD S S 06910CSR S COMP 10 54 06920CSR 54 GOTO END206 06930CSR S SUB 1 X 06940CSR MOVE NAM,S NAM,X 06950CSR Z-ADDSP,S SP,X 06960CSR MOVE BLK8 NAM,S 06970CSR Z-ADD0 SP,S 06980CSR GOTO T206A 06990CSR END206 ENDSR 07000C******************************************************************** ÐÐ07010CSR SR207 BEGSR 07020C* CLASSIFY CHAR PER INCH. 07030CSR IPCPI COMP 10 55 07040CSR IPCPI COMP 12 56 07050CSR IPCPI COMP 15 57 07060CSR ENDSR 07070C******************************************************************** 07080CSR SR302 BEGSR 07090C* PRINT FOOTNOTES. 07100CSR SETON 75 FOOTNOTE FLAG 07110CSR EXSR SR305 COUNT FOOTNOTES 07120CSR FCOUNT COMP 0 54 07130CSRN54 GOTO END302 NO FOOTNOTES 07140CSR IPLINE SUB FCOUNT V 40 07150CSR 1 ADD V V 07160CSR MOVELBIT,V W2A 2 1ST FOOTNOTE LINE 07170CSR MOVE BIT,1 W2A 07180CSRNU1 EXITFZVTAB VERT TAB 07190CSR RLABL W2A 07200CSR Z-ADDV LINENO 40 07210CSR Z-ADD0 X 07220C*------------------------------------------------------------------- 07230CSR T302A TAG 07240CSR 1 ADD X X 07250CSR X COMP 9 54 ÐÐ07260CSR 54 GOTO END302 07270CSR MOVE FTN,X W132A 07280CSR MOVEAW132A AR 07290CSR EXSR SR401 54=NOT BLK 07300CSRN54 GOTO T302A EMPTY 07310CSR U2 MOVE FX,X W5A 07320CSR U2 MOVEAW5A AR,133 07330CSR U2 MOVE FT,X AR,138 07340CSR U2 MOVE FL,X AR,139 07350CSR U2 MOVEAFN,X AR,141 07360CSR EXSR SR70 PRINT FOOTNOTE 07370CSR MOVE BLK148 FTN,X 07380CSR U2 Z-ADD0 FX,X 07390CSR U2 Z-ADD0 FL,X 07400CSR U2 MOVE ' ' FT,X 07410CSR U2 MOVE BLK8 FN,X 07420CSR GOTO T302A 07430CSR END302 TAG 07440CSR SETOF 75 FOOTNOTE FLAG 07450CSR ENDSR 07460C******************************************************************** 07470CSR SR303 BEGSR 07480C* PERFORM SPACING. 07490CSR W1A COMP 'S' 53 07500CSR W1A COMP '1' 55 ÐÐ07510CSR W1A COMP '2' 56 07520CSR W1A COMP '3' 57 07530CSR 53 EXSR SR68 TOP FORM 07540CSR 55 EXSR SR67 SPACE-1 07550CSR 56 EXSR SR66 SPACE-2 07560CSR 57 EXSR SR65 SPACE-3 07570CSRN74 HDG JUST DONE FLAG 07580COR 78N58 HDG IN PROC FLAG 07590COR 53 TOP OF FORM FLAG 07600COR 56 SPACE-2 FLAG 07610COR 57 GOTO END303 SPACE-3 FLAG 07620CSR 55 EXSR SR67 SPACE-1 07630CSRN55 EXSR SR66 SPACE-2 07640CSR END303 TAG 07650CSR SETOF 74 HDG DONE FLAG 07660CSR ENDSR 07670C******************************************************************** 07680CSR SR305 BEGSR 07690C* COUNT FOOTNOTES. 07700CSR Z-ADD0 FCOUNT 30 07710CSR Z-ADD1 X 07720C*------------------------------------------------------------------- 07730CSR T305A TAG 07740CSR MOVE FTN,X W132A 07750CSR MOVEAW132A AR ÐÐ07760CSR EXSR SR401 54=NOT BLK 07770CSR 54 1 ADD FCOUNT FCOUNT 07780CSR 1 ADD X X 07790CSR X COMP 9 54 07800CSRN54 GOTO T305A 07810CSR ENDSR 07820C******************************************************************** 07830CSR SR306 BEGSR 07840C* COUNT LINE USAGE BY CURRENT TEXT LINE. 07850CSR TXSPAC COMP 'S' 54 FLAG TOP FORM 07860CSR 54 SETON 59 07870CSR 59 GOTO END306 07880CSR MOVE TXSPAC W1N 10 07890CSR Z-ADDW1N TCOUNT 30 07900CSR 1 ADD TCOUNT TCOUNT 07910CSR END306 ENDSR 07920C******************************************************************** 07930CSR SR307 BEGSR 07940C* COUNT HEADING LINES. 07950CSR Z-ADD0 HCOUNT 30 07960CSR HPEND SUB 1 Z 54 07970CSRN54 Z-ADD0 Z 07980C*------------------------------------------------------------------- 07990CSR T307A TAG 08000CSR 1 ADD Z Z ÐÐ08010CSR Z COMP 9 54 08020CSR 54 GOTO END307 08030CSR HSP,Z COMP 'S' 54 08040CSR 54 SETON 59 08050CSR 59 GOTO END307 08060CSR MOVE HDG,Z W132A 08070CSR MOVEAW132A AR 08080CSR EXSR SR401 54=NOT BLK 08090CSRN54 GOTO T307A 08100CSR MOVE HSP,Z W1N 10 08110CSR W1N ADD HCOUNT HCOUNT 08120CSR 1 ADD HCOUNT HCOUNT 08130CSR GOTO T307A 08140CSR END307 ENDSR 08150C******************************************************************** 08160CSR SR308 BEGSR 08170C* BOLD PRINT. 08180CSR Z-ADD1 L 40 08190CSR MOVE ' ' RA 08200CSR SETOF 55 08210CSR 78 Z-ADD0 L 08220CSR 78 GOTO T308B HEADING LINE 08230C*------------------------------------------------------------------- 08240CSR T308A TAG 08250CSR BIT,97 LOKUPAR,L 54 ÐÐ08260CSRN54 GOTO T308M 08270CSR MOVE ' ' AR,L 08280C*------------------------------------------------------------------- 08290CSR T308B TAG 08300CSR 1 ADD L L 08310CSR L COMP 132 54 08320CSR 54 GOTO T308M 08330CSR AR,L COMP BIT,97 54 08340CSR 54 MOVE ' ' AR,L 08350CSR 54 GOTO T308A 08360CSR MOVE AR,L RA,L 08370CSR SETON 55 08380CSR GOTO T308B 08390C*------------------------------------------------------------------- 08400CSR T308M TAG 08410CSRN55 GOTO END308 08420CSR MOVEARA W148A 08430CSR EXSR SR69 BOLD PRINT 08440CSRN81 MOVEARA W148A 08450CSRN81 EXSR SR69 BOLD PRINT 08460CSR END308 ENDSR 08470C******************************************************************** 08480CSR SR309 BEGSR 08490C* UNDERLINE. 08500CSR Z-ADD1 L ÐÐ08510CSR MOVE ' ' RA 08520CSR SETOF 55 08530C*------------------------------------------------------------------- 08540CSR T309A TAG 08550CSR BIT,96 LOKUPAR,L 54 08560CSRN54 GOTO T309M 08570CSR MOVE BIT,97 AR,L SETUP BOLD PRINT 08580CSR 78 MOVE ' ' AR,L 08590C*------------------------------------------------------------------- 08600CSR T309B TAG 08610CSR 1 ADD L L 08620CSR L COMP 132 54 08630CSR 54 GOTO T309M 08640CSR AR,L COMP BIT,96 54 08650CSR 54 MOVE BIT,97 AR,L SETUP BOLD PRINT 08660CSR 78 54 MOVE ' ' AR,L 08670CSR 54 1 ADD L L 08680CSR 54 L COMP 132 56 08690CSR 54 56 GOTO T309M 08700CSR 54 GOTO T309A 08710CSR MOVE BIT,96 RA,L 08720CSR SETON 55 08730CSR GOTO T309B 08740C*------------------------------------------------------------------- 08750CSR T309M TAG ÐÐ08760CSRN55 GOTO END309 08770CSR MOVEARA W148A 08780CSR EXSR SR69 08790CSR SETON 61 08800CSRN78 EXSR SR308 BOLD PRINT 08810CSR SETOF 81 08820CSR END309 ENDSR 08830C******************************************************************** 08840CSR SR310 BEGSR 08850C* SET-UP DELAYED PRINT. 08860CSRN70 Z-ADD0 LSTHDG 10 08870CSR Z-ADD1 S 08880CSR BLK8 LOKUPDEL,S 69 08890CSRN69 GOTO END310 08900CSR MOVE DEL,S W8A 8 08910CSR Z-ADDDPL,S LSTHDG 10 08920CSR MOVEAW8A REC,1 08930CSR MOVE BLK8 DEL,S 08940CSR Z-ADD0 DPL,S 08950CSRN70N71 EXSR SR103 PUSH STACK 08960CSRN70N71 EXSR SR402 SAVE HEADINGS 08970CSR 71 END TEXT FLAG 08980COR 70 MOVEAREC IPNAME DEL PRT FLAG 08990CSR EXSR SR404 INIT HEADINGS 09000CSR SETON 7073 DEL PRT FLAG ÐÐ09010CSR END310 ENDSR 09020C******************************************************************** 09030CSR SR311 BEGSR 09040C* PRINT SUBSCRIPT. 09050CSR MOVE ' ' RA 09060CSR SETOF 55 09070CSR Z-ADD1 L 09080C*------------------------------------------------------------------- 09090CSR T311A TAG 09100CSR BIT,127 LOKUPAR,L 54 09110CSRN54 GOTO T311B 09120CSR SETON 55 09130CSR MOVE ' ' AR,L 09140CSR L SUB 1 L 54 09150CSRN54 GOTO T311A 09160CSR MOVE AR,L RA,L 09170CSR MOVE ' ' AR,L 09180CSR GOTO T311A 09190C*------------------------------------------------------------------- 09200CSR T311B TAG 09210CSRN55 GOTO END311 09220CSR EXITFZNHLF NEG HALF LF 09230CSR MOVEARA W148A 09240CSR EXSR SR69 PRINT SUBSCRIPT 09250CSR EXITFZPHLF POS HALF LF ÐÐ09260CSR END311 ENDSR 09270C******************************************************************** 09280CSR SR312 BEGSR 09290C* PUT CONTD NOTATION ON HEADING. 09300CSR H COMP 2 54 09310CSRN54 GOTO END312 NOT LINE 2 09320CSR Z-ADD0 W3N 09330CSR HC,H COMP 1 54 09340CSRN54 GOTO END312 1ST TIME 09350CSR Z-ADD1 X 09360C*------------------------------------------------------------------- 09370CSR T312A TAG 09380CSR ' ' LOKUPAR,X 54 09390CSRN54 GOTO T312B 09400CSR X COMP 132 54 09410CSRN54 Z-ADDX W3N 09420CSR MOVE ' ' AR,X 09430CSR GOTO T312A 09440C*------------------------------------------------------------------- 09450CSR T312B TAG 09460CSR Z-ADDW3N X 54 09470CSRN54 GOTO END312 09480CSR 2 ADD X X 09490CSR X COMP 132 54 09500CSRN54 MOVEACONTD AR,X ÐÐ09510CSRN54 MOVEAAR W148A 09520CSRN54 EXSR SR69 PUT CONT'D 09530CSR END312 ENDSR 09540C******************************************************************** 09550CSR SR401 BEGSR 09560C* CHECK FOR NON-BLK LINE 09570CSR ' ' LOKUPAR 54 NON-BLK 09580CSRN54 BIT,97 LOKUPAR 54 BOLD 09590CSRN54 BIT,96 LOKUPAR 54 UNDERLINE 09600CSR ENDSR 09610C************************************************************** 09620CSR SR402 BEGSR 09630C* SAVE HEADINGS 09640CSR Z-ADDLSTHDG SAVLHD 20 09650CSR MOVE HDG SHD 09660CSR MOVE HSP SHS 09670CSR MOVE HX SHX 09680CSR MOVE HT SHT 09690CSR MOVE HL SHL 09700CSR MOVE HN SHN 09710CSR Z-ADDHC SHC 09720CSR ENDSR 09730C************************************************************** 09740CSR SR403 BEGSR 09750C* RESTORE HEADINGS ÐÐ09760CSR MOVE SHD HDG 09770CSR MOVE SHS HSP 09780CSR MOVE SHX HX 09790CSR MOVE SHT HT 09800CSR MOVE SHL HL 09810CSR MOVE SHN HN 09820CSR SAVLHD COMP 0 54 09830CSRN54 GOTO END403 09840CSR Z-ADD0 X 09850C*------------------------------------------------------------------- 09860CSR T403A TAG 09870CSR 1 ADD X X 09880CSR X COMP SAVLHD 55 55 09890CSRN55 HC,X SUB SHC,X W3N 54 09900CSR 54N55 W3N ADD SHC,X HC,X 09910CSR 55 Z-ADDSHC,X HC,X 09920CSR X COMP 9 54 09930CSRN54 GOTO T403A 09940CSR END403 ENDSR 09950C********************************************************************* 09960CSR SR404 BEGSR 09970C* INIT HEADING 09980CSR LSTHDG SUB 1 X 54 54 09990CSRN54 GOTO END404 10000C*----------------------------------------------------------------- ÐÐ10010CSR T404A TAG 10020CSR 1 ADD X X 10030CSR X COMP 9 54 10040CSR 54 GOTO END404 10050CSR MOVE BLK148 HDG,X 10060CSR Z-ADD0 HC,X 10070CSR GOTO T404A 10080CSR END404 ENDSR 10090C***************************************************************** 10100CSR SR405 BEGSR 10110C* INIT HDGS FOR TEXT/LINK STMT 10120CSR TXHLIN COMP 0 54 10130CSR 54 Z-ADDTXHLIN LSTHDG 10140CSR 54 EXSR SR404 INIT HEADING 10150CSR ENDSR 10160C***************************************************************** 10170CSR SR800 BEGSR 10180C* GET MGFILE. 10190CSR M CHAINMGFILE 54 10200CSR ENDSR 10210C******************************************************************** 10220CSR SR900 BEGSR 10230C* FLAG REQUESTED TEXT NOT ON FILE. 10240CSR Z-ADD148 M 50 10250CSR EXSR SR999 ÐÐ10260CSR ENDSR 10270C******************************************************************** 10280CSR SR901 BEGSR 10290C* FLAG PROGRAM ERROR (NO HIT,TXPTR). 10300CSR Z-ADD100 M 10310CSR EXSR SR999 10320CSR ENDSR 10330C******************************************************************** 10340CSR SR902 BEGSR 10350C* FLAG PROGRAM ERROR (NO HIT,TXFILE). 10360CSR Z-ADD101 M 10370CSR EXSR SR999 10380CSR ENDSR 10390C******************************************************************** 10400CSR SR999 BEGSR 10410C* PRINT MSG. 10420CSR MOVE ' ' AR 10430CSR EXSR SR800 GET MGFILE 10440CSR MOVEAMGTEXT AR 10450CSR EXSR SR70 PRINT MSG 10460CSR ENDSR 10470O******************************************************************** 10480OTXNAME D 02NU1 10490O 80 'D' ** AR ARRAY 010500ÐÐ 010510** NAM ARRAY 010520 010530** SP ARRAY 10540 10550** PTR ARRAY 010560 010570** MES 010580REQUESTED BY 010590** HDG ARRAY 010600 010610** HSP ARRAY 010620 010630** HX ARRAY 010640 010650** HT ARRAY 010660 010670** HL ARRAY 010680 010690** HC ARRAY 010700 010710** SHD ARRAY 010720 010730** SHS ARRAY 010740 010750ÐÐ** SHX ARRAY 010760 010770** SHT ARRAY 010780 010790** SHL ARRAY 010800 010810** HN ARRAY 010820 010830** SHN ARRAY 010840 010850** SHC ARRAY 010860 010870** FTN ARRAY 010880 010890** FX ARRAY 010900 010910** FT ARRAY 010920 010930** FL ARRAY 010940 010950** FN ARRAY 010960 010970** RA ARRAY 010980 010990** DEL ARRAY 011000ÐÐ 011010** DPL ARRAY 011020 011030/* 011040_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( P€  NX006PI P&ž999999120282(èÈÐ00010H Q006PI00020F* REDUCE RECEIVED QTY POITEM RECORTD. (X006PI) 00030F* REVISED 12-08-82 3:00 PM. 00040FBITPAR IP F 90 DISK 00050FPOITEM UC F 384R 9AI 1 DISK 00060FCRTFILE UC F 256R DISK 00070FMGFILE IC F 80R DISK 00080FTERM132 O F 132 5 00090E***************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A12 12 12 1 A 00120E A9 9 9 1 00130E RCD 1 26 7 0A RECEIVED QTYS 00140E OPN 1 26 7 0A OPEN QTYS 00150E LNK 1 7 6 A 00160E CALL 7 6 00170E BIT 33 1 SCREEN CONTR. CHAR 00180E PAR 25 1 00190E TST 25 1 00200E PID 26 6 0A POITEM SCHED DATES 00210E PIQ 26 7 0A POITEM SCHED QTYS 00220I******************************************************************** 00230IBITPAR BT 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I****************************************************************** 00280ICRTFILE CR 00290I 28 330CRTIME 00300I 34 370CRDATE 00310I 38 79 CALL 00320I******************************************************************** 00330IMGFILE MG 00340I 1 35 MGTEXT 00350I******************************************************************** 00360IPOITEM PI 00370I* PURCHASE ORDER ITEM RECORD. 00380I* KEY AREA. 00390I* PO # 6N 00400I 1 60PIPO 00410I* PO ITEM 3N 00420I* * * * * * 7 90PIITEM 00430I* DYNAIR PART # 10N 00440I 10 190PIPN 00450I* VENDOR PART # 15A 00460I 20 34 PIVPN 00470I* DESCRIPTION 29A 00480I 35 63 PIDESC 00490I* NON-INVENTORY DESCRIPTION 70A 00500I 10 79 PINDES ÐÐ00510I* DATE LAST RECEIPT 6N 00520I 80 850PIDLR 00530I* QTY RECEIVED 7P 00540I P 86 890PIQRCD 00550I* QTY TO STK,SCRAP,RTV 7P 00560I P 90 930PIQSTK 00570I* PRICE CODE 1A 00580I* L = LOT 00590I* N = NO CHARGE 00600I 94 94 PILOT 00610I* PRICE 9.3P 00620I P 95 993PI$PRC 00630I* WORK ORDER # 9A 00640I 100 108 PIWO 00650I 100 105 PIWOP 00660I 106 1080PIWOD 00670I* VENDOR # 5P (FROM POMAST) 00680I P 109 1110PIVEND 00690I* LAST RCVG LOG # USED 2N 00700I 112 1130PILLOG 00710I* SCHEDULE DATES 6N X 26 (Y,M,D) 00720I 114 269 PID 00730I* SCHED QTYS 7P X 26 00740I P 270 373 PIQ 00750I* RECORD STATUS 1A ÐÐ00760I 384 384 PISTAT 00770C******************************************************************** 00780C* INIT 00790C EXSR SR101 00800C MOVE ' ' BLK6 6 00810C*------------------------------------------------------------------- 00820C START TAG 00830C* REQUEST PO-ITEM # 00840C EXSR SR70 NEW PAGE 00850C*------------------------------------------------------------------- 00860C CONTU TAG 00870C SETON 46 00880C EXCPT PO# PROMPT 00890C SETOF 46 00900C EXSR SR75 READ CRT 00910C 92 GOTO START 00920C 90 GOTO END 00930C EXSR SR212 BUILD PO 00940C TPO CHAINPOITEM 60 00950C N60 PISTAT COMP 'D' 60 00960C N60 GOTO TAG10 00970C Z-ADD5 M 50 00980C EXSR SR89 GET MSG 00990C SETON 61 01000C EXCPT ERROR MESSAGE ÐÐ01010C SETOF 61 01020C GOTO CONTU 01030C*------------------------------------------------------------------- 01040C TAG10 TAG 01050C* CHECK ACCOUNT # 01060C* PUT SCREEN 01070C EXSR SR71 01080C* REQUEST QTY RECEIVED 01090C SETON 80 01100C EXCPT QTY PROMPT 01110C SETOF 80 01120C EXSR SR75 READ CRT 01130C 92 GOTO START 01140C Z-ADD12 W2N 20 01150C EXIT SUBRAJ R.J. 01160C RLABL W2N 01170C RLABL W12A 01180C MOVE W12A TQTY 70 01190C Z-ADDTQTY PIQRCD 01200C SETON 82 01210C EXCPT UPDATE QTY RECVD 01220C SETOF 82 01230C EXSR SR71 PUT SCREEN 01240C GOTO START 01250C*------------------------------------------------------------------- ÐÐ01260C NEWITM TAG 01270C MOVEL'Q006PI' PROG 8 01280C GOTO END 01290C*------------------------------------------------------------------- 01300C GOODBY TAG 01310C MOVEL'GOODBY' PROG 01320C GOTO END 01330C*------------------------------------------------------------------- 01340C MENU TAG 01350C EXSR SR96 GET CRTFILE 01360C Z-ADD1 W 01370C BLK6 LOKUPLNK,W 54 01380C 54 MOVELLNK,W PROG 8 01390C 54 MOVE BLK6 LNK,W 01400C N54 MOVEL'CONTU 'PROG 01410C EXSR SR97 UPD CRTFILE 01420C EXSR SR98 >>>>>>>>>> 01430C*------------------------------------------------------------------- 01440C END TAG 01450C EXSR SR96 GET CRTFILE 01460C EXSR SR97 UPD CRTFILE 01470C EXSR SR98 >>>>>>>>>> 01480C*------------------------------------------------------------------- 01490C ENDJOB TAG 01500C MOVEL'ENDJOB 'PROG ÐÐ01510C EXSR SR98 01520C******************************************************************** 01530CSR SR69 BEGSR 01540C* MOVE CURSOR 01550CSR 50 EXITFZPUTXY 01560CSR RLABL RPGLIN 01570CSR RLABL RPGCOL 01580CSRN50 EXITFZMOVXY 01590CSR RLABL RPGLIN 01600CSR RLABL RPGCOL 01610CSR ENDSR 01620C******************************************************************** 01630CSR SR70 BEGSR 01640C* NEW SCREEN 01650CSR 50 EXITFZISTAT 01660CSR 50 EXITFZESCH 01670CSRN50 EXITFZCPAGE 01680CSR SETON 70 01690CSRN51 EXCPT 01700CSR SETOF 70 01710CSR ENDSR 01720C******************************************************************** 01730CSR SR71 BEGSR 01740C* PUT DATA SCREEN 01750CSR EXSR SR204 CLASSIFY P.O. ÐÐ01760CSR EXSR SR252 ALLOCATE RECEIPTS 01770CSR SETON 71 01780CSR EXCPT PUT DATA 01790CSR SETOF 71 01800CSR EXSR SR253 PUT SCHEDULE 01810CSR ENDSR 01820C******************************************************************** 01830CSR SR73 BEGSR 01840C* PUT MESSAGE 01850CSR SETON 7379 01860CSR EXCPT 01870CSR SETOF 73 01880CSR ENDSR 01890C******************************************************************* 01900CSR SR75 BEGSR 01910C* READ FROM TERMINAL 01920CSR SETOF 779096 01930CSR SETOF 92 01940CSR MOVE BLK12 W12A 12 BUFFER 01950CSR EXITFZR12 READ FROM TERMINAL 01960CSR RLABL W12A READ BUFFER 01970CSR MOVEAW12A A12 INPUT DATA ARRAY 01980CSR MOVE BLK12 W12A INIT INPUT ARRAY 01990CSR Z-ADD1 W 30 02000CSR '\' LOKUPA12,W 90 FLAG ESC ÐÐ02010CSRN90 GOTO T75B NOT ESC 02020CSR 1 ADD W W 02030CSR W COMP 70 54 02040CSR 54 GOTO T75A BAD ESC 02050CSR A12,W COMP 'G' 98 GOODBY 02060CSR A12,W COMP 'E' 94 MENU 02070CSR A12,W COMP 'N' 93 NEW ITEM 02080CSR A12,W COMP 'B' 92 SKIP BKWRD 02090CSR 98 GOTO GOODBY 02100CSR 94 GOTO MENU 02110CSR 93 GOTO NEWITM 02120CSR 92 GOTO END75 GOOD ESC 02130C*------------------------------------------------------------------ 02140CSR T75A TAG 02150C* FLAG BAD ESC INPUT 02160CSR Z-ADD318 M 96 FLAG ERROR 02170CSR EXSR SR89 GET MSG 02180CSR EXSR SR73 PUT MSG 02190CSR GOTO SR75 02200C*-------------------------------------------------------------------- 02210CSR T75B TAG 02220C* MOVE DATA 02230CSR Z-ADD1 W 02240CSR ' ' LOKUPA12,W 77 02250CSR 77 MOVEAA12,W W12A INPUT DATA ÐÐ02260C*------------------------------------------------------------------- 02270CSR END75 TAG 02280CSR 79 MOVE BLK35 MGTEXT 02290CSR 79 EXSR SR73 BLANK MESSAGE 02300CSR SETOF 79 02310CSR ENDSR 02320C******************************************************************** 02330CSR SR76 BEGSR 02340C* PUT SCHED DATA 02350CSR SETON 76 02360CSR EXCPT PUT SCHED 02370CSR SETOF 76 02380CSR ENDSR 02390C******************************************************************** 02400CSR SR89 BEGSR 02410C* GET MESSAGE 02420CSR M CHAINMGFILE 02430CSR SETON 79 02440CSR ENDSR 02450C******************************************************************** 02460CSR SR96 BEGSR 02470CSR # CHAINCRTFILE H9 GET CRTFILE 02480CSR H9 GOTO ENDJOB 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR97 BEGSR 02520C* UPDATE CRTFILE. EXIT PROGRAM. 02530CSR TIME CRTIME 02540CSR MOVELUDATE CRDATE 02550CSR SETON 97 02560CSR EXCPT UPD CRTFILE 02570CSR SETOF 97 02580CSR ENDSR 02590C******************************************************************** 02600CSR SR98 BEGSR 02610CSR SETON 51 02620CSR EXSR SR70 CLEAR SCREEN 02630CSR EXITFCHAIN >>>>>>>>>> 02640CSR RLABL PROG 02650CSR ENDSR 02660C******************************************************************** 02670CSR SR101 BEGSR 02680C* 1-TIME INITIALIZE 02690CSR MOVE BIT,1 NUL 02700CSR MOVE ' ' BLK12 12 02710C* GET PORT # AND CRTFILE 02720CSR MOVE ' ' W2A 2 02730CSR EXITFZGMINX GET PORT # 02740CSR RLABL W2A 02750CSR MOVE W2A # 20 PORT NO. ÐÐ02760CSR # COMP 0 54 02770CSRN54 Z-ADD25 # DEFAULT 02780CSR EXSR SR96 GET CRTFILE 02790CSR MOVE CALL LNK 02800CSR MOVEL'Q006PI 'PROG 02810CSR PAR,# COMP '1' 50 02820CSR TST,# COMP 'S' 54 02830CSR 54 MOVE 'SHUTDOWN'PROG 8 02840CSR EXSR SR97 UPD CRTFILE 02850CSR 54 EXSR SR98 >>>>>>>>>> 02860CSR MOVE ' 'PROG 02870C* DEFINE WORK FIELDS,ETC. 02880CSR MOVE ' ' BLK35 35 02890CSR Z-ADD0 ZERO6 60 02900CSR Z-ADD0 ZERO7 70 02910CSR MOVE ' ' BLK12 12 02920CSR MOVE ' ' W6A 6 02930CSR MOVE ' ' RPGLIN 4 02940CSR MOVE ' ' RPGCOL 4 02950CSR MOVE ' ' BLK70 70 02960CSR MOVE ' ' BLK29 29 02970CSR Z-ADD0 F 30 02980CSR ENDSR 02990C******************************************************************** 03000CSR SR204 BEGSR ÐÐ03010C* CLASSIFY ACCOUNT. 03020CSR PIWOP COMP ' 14100' 70 03030CSRN70 PIWOP COMP ' 12100' 70 03040CSRN70 PIWOP COMP ' 14600' 70 03050CSRN70 Z-ADD0 PIPN 03060CSRN70 MOVE BLK35 PIVPN 03070CSR 70 MOVE BLK70 PINDES 03080CSR ENDSR 03090C******************************************************************** 03100CSR SR212 BEGSR 03110C* BUILD PURCH ORD # 03120CSR MOVEAW12A A12 03130CSR Z-ADD1 W 03140CSR '-' LOKUPA12,W 54 03150CSRN54 Z-ADD7 W 03160CSR MOVEAA12,W W4A 4 03170CSR 54 MOVEL' ' W4A 03180CSR Z-ADD4 W2N 03190CSR EXIT SUBRAJ RJ 03200CSR RLABL W2N 03210CSR RLABL W4A 03220CSR MOVE W4A TPOD 30 PURCH ORD DASH 03230CSR MOVEABLK12 A12,W 03240CSR A12,1 COMP '0' 54 54 03250CSR 54 MOVEAA12,1 W5A ÐÐ03260CSR 54 MOVEL' ' TPOP 03270CSRN54 MOVEAA12 TPOP 6 03280CSRN54 MOVE TPOP W5A 5 03290CSR Z-ADD5 W2N 03300CSR EXIT SUBRAJ RJ 03310CSR RLABL W2N 03320CSR RLABL W5A 03330CSR MOVE W5A TPOP PURCH ORD PRIME 03340CSR MOVELTPOP TPO 9 03350CSR MOVE TPOD TPO 03360CSR ENDSR 03370C******************************************************************** 03380CSR SR252 BEGSR 03390C* APPLY RCPTS TO SCHEDULE. 03400CSR Z-ADD0 RCD 03410CSR Z-ADD1 A 30 03420CSR Z-ADDPIQRCD SAVQTY 70 03430C*------------------------------------------------------------------- 03440CSR T252A TAG 03450CSR ZERO7 LOKUPPIQ,A 54 03460CSRN54 GOTO T252C 03470CSR Z-ADDPIQ,A W7N 70 03480CSR SETOF 57 03490CSR SAVQTY COMP W7N 545556 03500CSR 54 Z-ADDW7N RCD,A ÐÐ03510CSR 54 SAVQTY SUB W7N SAVQTY 57 03520CSR 54 Z-ADD0 W7N 03530CSR 55 Z-ADDSAVQTY RCD,A 03540CSR 55 W7N SUB SAVQTY W7N 03550CSR 55 Z-ADD0 SAVQTY 57 03560CSR 56 Z-ADDSAVQTY RCD,A 03570CSR 56 Z-ADD0 SAVQTY 57 03580CSR 56 Z-ADD0 W7N 03590CSR 57 1 ADD A A 03600CSR 57 A COMP 26 54 03610CSR 57 GOTO T252A 03620CSR GOTO END252 03630C*------------------------------------------------------------------- 03640CSR T252C TAG 03650CSR Z-ADD1 A 03660CSR ZERO7 LOKUPPIQ,A 54 03670CSR 54 Z-ADDSAVQTY RCD,A 03680CSR END252 ENDSR 03690C******************************************************************** 03700CSR SR253 BEGSR 03710C* DISPLAY SCHEDULE. 03720CSR Z-ADD0 S 30 03730CSR PIQ SUB RCD OPN OPEN PO QTYS 03740C* PUT SCHEDULE HEADING. 03750CSR 40 GOTO T253A ÐÐ03760CSR SETON 7540 03770CSR EXCPT PUT SCHED HEADING 03780CSR SETOF 75 03790C*------------------------------------------------------------------- 03800CSR T253A TAG 03810CSR 1 ADD S S 03820CSR S COMP 13 54 03830CSR 54 GOTO T253C 03840CSR PIQ,S COMP 0 54 03850CSRN54 RCD,S COMP 0 54 03860CSR 13 ADD S Y 30 03870CSRN54 PIQ,Y COMP 0 54 03880CSRN54 RCD,Y COMP 0 54 03890CSRN54 GOTO T253A 03900CSR EXSR SR76 PUT SCHEDULE 03910CSR GOTO T253A 03920C*------------------------------------------------------------------- 03930CSR T253C TAG 03940C* PUT TOTALS. 03950CSR XFOOTPIQ TOTPIQ 80 03960CSR XFOOTRCD TOTRCD 80 03970CSR TOTPIQ SUB TOTRCD TOTOPN 80 03980CSR SETON 74 03990CSR EXCPT PUT TOTALS 04000CSR SETOF 74 ÐÐ04010CSR ENDSR 04020O************************************************************** 04030OTERM132 E 70 04040O* PUT HEADINGS 04050O BIT,28 1 04060O N50 8 '8091001' 04070O N50 BIT,1 9 04080O N50 BIT,1 10 04090O 50 10 '[001 ]001' 04100O 50 BIT,28 6 04110O 79 'PURCHASE ORDER' 04120O 102 'RECEIVED QTY CHANGE' 04130O UDATE Y 18 04140O*------------------------------------------------------------------- 04150O E 70 04160O NUL 132 04170O*------------------------------------------------------------------- 04180O E 71 04190O NUL 132 04200O BIT,28 1 04210O N50 8 '8093001' 04220O 50 10 '[003 ]001' 04230O 50 BIT,28 6 04240O*------------------------------------------------------------------- 04250O E 71 ÐÐ04260O 17 'ITEM NUMBER' 04270O TPOP 34 04280O 35 '-' 04290O TPOD 38 04300O MGTEXT 132 04310O*------------------------------------------------------------------- 04320O E 71 04330O 21 'ORDER/ACCOUNT #' 04340O PIWOP 34 04350O 55 35 '-' 04360O 55 PIWOD 38 04370O MGTEXT 132 04380O*------------------------------------------------------------------- 04390O E 71 04400O 19 'VENDOR PART #' 04410O PIVPN 43 04420O MGTEXT 132 04430O*------------------------------------------------------------------- 04440O E 71 04450O 22 'ITEM DESCRIPTION' 04460O PINDES 98 04470O MGTEXT 132 04480O*------------------------------------------------------------------- 04490O E 71 04500O 22 'PRICE-CODE (L,N)' ÐÐ04510O PILOT 29 04520O*------------------------------------------------------------------- 04530O E 71 04540O 11 'PRICE' 04550O PI$PRC2 41 04560O MGTEXT 132 04570O*-------------------------------------------------------------- 04580O E 71 04590O 12 'QTY RECEIVED' 04600O 26 ':' 04610O PIQRCD2 37 04620O*-------------------------------------------------------------- 04630O E 71 04640O 1 ' ' 04650O*------------------------------------------------------------------- 04660O E 71 04670O 76 'SCHEDULE DATES & QTYS' 04680O*----------------------------------------------------------------- 04690O E 75 04700O* SCHEDULE HEADING 04710O 8 'DUE-DATE' 04720O 19 'SCHED-QTY' 04730O 30 'QTY-RECVD' 04740O 41 'QTY-OPEN' 04750O 62 'DUE-DATE' ÐÐ04760O 73 'SCHED-QTY' 04770O 85 'QTY-RECVD' 04780O 95 'QTY-OPEN' 04790O*-------------------------------------------------------------- 04800O E 76 04810O* PUT SCHEDULE DATA 04820O PID,S 8 ' - - ' 04830O PIQ,S 2 19 04840O RCD,S 2 30 04850O OPN,S K 41 04860O PID,Y 62 ' - - ' 04870O PIQ,Y 2 73 04880O RCD,Y 2 85 04890O OPN,Y K 96 04900O*--------------------------------------------------------------------- 04910O E 46 04920O NUL 132 04930O BIT,28 1 04940O N50 8 '8093001' 04950O N50 BIT,1 9 04960O N50 BIT,1 10 04970O 50 10 '[003 ]001' 04980O 50 BIT,28 6 04990O 102 ' ENTER PO-ITEM :' 05000O*-------------------------------------------------------------------- ÐÐ05010O E 73 05020O OR 78 05030O OR 61 05040O* PUT MESSAGE. 05050O NUL 132 05060O N61 BIT,28 1 05070O N61N50 8 '8104001' 05080O N61N50 BIT,1 9 05090O N61N50 BIT,1 10 05100O N61 50 10 '[014 ]001' 05110O N61 50 BIT,28 6 05120O 61 MGTEXT 45 05130O 73 MGTEXT 45 05140O 78 34 'INVENTORY ITEM-REJECT' 05150O BIT,8 132 05160O*------------------------------------------------------------------- 05170O E 74 05180O* PUT SCHED TOTALS. 05190O NUL 132 05200O BIT,28 1 05210O N50 8 '8119056' 05220O N50 BIT,1 9 05230O N50 BIT,1 10 05240O 50 10 '[024 ]056' 05250O 50 BIT,28 6 ÐÐ05260O 18 'TOTALS ' 05270O TOTPIQ2 28 05280O 29 ' ' 05290O TOTRCD2 39 05300O 40 ' ' 05310O TOTOPNK 51 05320O BIT,28 131 05330O 132 'K' 05340O*------------------------------------------------------------------- 05350O E 80 05360O NUL 132 05370O BIT,28 1 05380O N50 8 '8101001' 05390O N50 BIT,1 9 05400O N50 BIT,1 10 05410O 50 10 '[010 ]001' 05420O 50 BIT,28 6 05430O 34 'ENTER QTY RECEIVED ' 05440O******************************************************************** 05450OPOITEM E 82 05460O PIPN 19 05470O PIVPN 34 05480O 70 PIDESC 63 05490O N70 PINDES 79 05500O PIDLR 85 ÐÐ05510O PIQRCD 89P 05520O PIQSTK 93P 05530O PILOT 94 05540O PI$PRC 99P 05550O PIWO 108 05560O PIVEND 111P 05570O PILLOG 113 05580O PID 269 05590O PIQ 373P 05600O PISTAT 384 05610O******************************************************************** 05620OCRTFILE E 97 05630O PROG 26 05640O CRTIME 33 05650O CRDATE 37 05660O LNK 79 ** NUL ARRAY 005670 005680** A12 ARRAY 05690 05700** A9 ARRAY 005710 005720** RCD ARRAY 05730 05740** OPN ARRAY 05750ÐÐ 05760** LNK ARRAY 005770 05780/* 05790_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(|A  X005XP P120282120282(èÈÐ00010H Q005XP00020F* GEN XPGUIDE FILE FOR NET EXPLOSION- Q008XP. (X005XP) 00030F* REVISED 7/02/80 3:50 PM. 00040FXPMAST IP F 99 22AI 1 DISK 00050FXPGUIDE O F 16 DISK 00060E******************************************************************** 00070E XPQ 18 7 0A 00080I******************************************************************** 00090IXPMAST XP 01 00100I 3 120XPCPN L1 00110I P 23 94 XPQ 00120C******************************************************************** 00130C Z-ADD0 ZERO6 60 00140C Z-ADD0 ZERO7 70 00150C ZERO7 LOKUPXPQ 01 00160O******************************************************************** 00170OXPGUIDE D 01 L1 00180O XPCPN 10 00190O ZERO6 16 /* 000200_‚_‚ ÐÈ( |K  NX006CF P|120282120282(èÈÐ00010H Q006CF00020F* INPUT ADDRESS SELECTION CRITERIA. (X006CF) DG REL006 OK 00030F* REVISED 6/06/80 9:15 AM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCFSELECTUC F 900R DISK 00070FTERM132 O F 132 5 00080F**************************************************************** 00090E NUL 1 50 1 NULL CHAR 00100E A6 6 6 1 CALL READ PARAM. 00110E A10 10 10 1 00120E A36 36 36 1 A INPUT DATA ARRAY 00130E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 23 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E SEL 11 11 3 00170E WRK 11 11 2 00180E LOC 1 23 3 0 00190E TABSTC 1 58 2 STATE CODES 00200E SET 9 1 0 00210E FZIP 9 9 0 00220E TZIP 9 9 0 00230E NZIP 9 1 00240E STC 9 2 00250E NST 9 1 ÐÐ00260E FC 9 35 00270E NFC 9 1 00280E MC1 9 3 00290E NM1 9 1 00300E MC2 9 3 00310E NM2 9 1 00320E SC 9 33 00330E BIT 33 1 SCREEN CONTR. CHAR 00340E CALL 5 6 CALL STACK 00350I******************************************************************* 00360IBITTAB BT 00370I 1 33 BIT 00380I******************************************************************** 00390ICFSELECTCS 00400I 1 9 SET 00410I 10 90 FZIP 00420I 91 171 TZIP 00430I 172 180 NZIP 00440I 181 198 STC 00450I 199 207 NST 00460I 208 522 FC 00470I 523 531 NFC 00480I 532 558 MC1 00490I 559 567 NM1 00500I 568 594 MC2 ÐÐ00510I 595 603 NM2 00520I 604 900 SC 00530I******************************************************************** 00540IMGFILE MG 00550I* MESSAGE FILE. 00560I 1 35 MGTEXT 00570C******************************************************************** 00580C* INITIALIZE 00590C EXSR SR101 1-TIME INIT 00600C H8 GOTO ENDJOB 00610C*------------------------------------------------------------------ 00620C START TAG 00630C* SET-UP 1ST FIELD NO. 00640C Z-ADD1 S 30 LINE # - 6 00650C Z-ADD1 F 30 FIELD # 00660C MOVE ' ' SEL 00670C GOTO READ 00680C*------------------------------------------------------------------ 00690C NEXT TAG 00700C* SET-UP NEXT FIELD NO. 00710C 1 ADD F F FIELD # 00720C*----------------------------------------------------------------- 00730C READ TAG 00740C* READ DATA FROM TERMINAL. 00750C SETOF 9096 ÐÐ00760C F COMP 0 54 00770C N54 Z-ADD1 F 00780C F COMP 23 54 00790C 54 Z-ADD1 F 00800C 54 1 ADD S S 00810C S COMP 9 54 00820C 54 GOTO START 00830C EXSR SR201 IDENTIFY-F 00840C SETON 69 00850C EXSR SR72 PROMPT 00860C SETOF 69 00870C EXSR SR75 READ TERMINAL 00880C 98 GOTO GOODBY GOODBY 00890C 94 GOTO MENU MENU REQUEST 00900C N77N88 EXSR SR104 EDIT INPUT FIELD 00910C 96 ERROR 00920CORN77N88 EXSR SR72 REWRITE INPUT DATA 00930C 93 GOTO NEWITM NEW ITEM 00940C 92 GOTO JUMP FIELD JUMP REQST 00950C 91 GOTO NEXT SKIP FORWARD 00960C 89 F SUB 1 F SKIP BACKWARD 00970C 89 GOTO READ " " 00980C 88 SETOF 90 SPACE FILL 00990C 88 SETON 77 " " 01000C 87 GOTO START ÐÐ01010C 86 GOTO UPDATE UPDATE 01020C 85 GOTO READ REPEAT 01030C 84 MOVE ' ' SEL INIT SEL CODE. 01040C 84 Z-ADD1 F DONE 01050C 84 1 ADD S S 01060C 84 GOTO READ 01070C 96 GOTO ERROR ERROR 01080C N77 GOTO NEXT NO DATA INPUT 01090C*------------------------------------------------------------------ 01100C PROCES TAG 01110C* PROCESS INPUT DATA 01120C EXSR SR103 MOVE DATA 01130C N96 EXSR SR104 EDIT DATA 01140C EXSR SR72 REWRITE DATA 01150C 96 GOTO ERROR ERROR 01160C GOTO NEXT 01170C*------------------------------------------------------------------ 01180C UPDATE TAG 01190C* UPDATE DATA BASE. 01200C Z-ADD0 S 01210C*------------------------------------------------------------------- 01220C CONTU TAG 01230C 1 ADD S S 01240C EXSR SR105 FINAL EDIT 01250C 96 GOTO ERROR ERROR ÐÐ01260C S COMP 9 54 01270C N54 GOTO CONTU 01280C EXSR SR106 UPDATE 01290C 96 GOTO ERROR ERROR 01300C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01310C GOTO MENU UPDATE FINISHED 01320C*------------------------------------------------------------------- 01330C JUMP TAG 01340C* SET-UP JUMP TO REQUESTED FIELD 01350C 1 ADD W W 30 01360C W COMP 23 54 01370C 54 Z-ADD318 M 50 96 FLAG ERROR 01380C 54 GOTO ERROR BAD ESC 01390C MOVE '000' W3A 3 01400C MOVEAA36,W W3A 01410C Z-ADD3 W2N 20 01420C EXIT SUBRAJ R. JUSTIFY 01430C RLABL W2N 01440C RLABL W3A 01450C MOVE W3A F NEW FIELD # 01460C GOTO READ 01470C*-------------------------------------------------------------------- 01480C ERROR TAG 01490C EXSR SR102 VALIDATE FIELD # 01500C EXSR SR89 GET MSG ÐÐ01510C EXSR SR73 PUT MSG 01520C GOTO READ 01530C*------------------------------------------------------------------ 01540C NEWITM TAG 01550C* SET-UP LINK FOR NEW ITEM 01560C MOVEL'Q006CF' PROG 8 01570C GOTO END 01580C*------------------------------------------------------------------- 01590C MENU TAG 01600C* SET-UP LINK TO MENU 01610C MOVEL'Q070DP' PROG 01620C GOTO END 01630C*-------------------------------------------------------------------- 01640C GOODBY TAG 01650C* LINK TO SIGN-OFF 01660C MOVEL'GOODBY' PROG 01670C GOTO END 01680C*------------------------------------------------------------------- 01690C END TAG 01700C PROG COMP BLK8 54 01710C N54 GOTO MENU 01720C EXSR SR97 UPDATE CRTFILE 01730C EXITFCHAIN LINK TO NEXT PROG 01740C RLABL PROG 01750C*------------------------------------------------------------------- ÐÐ01760C ENDJOB TAG 01770C********************************************************************* 01780CSR SR1 BEGSR 01790C* EDIT SET NO. 01800CSR SETNO COMP 0 54 01810CSR 54 SETNO COMP 9 5454 01820CSRN54 Z-ADD222 M 96 FLAG ERROR 01830CSRN54 GOTO END1 01840CSR Z-ADDSETNO S 30 01850CSR Z-ADDSETNO SET,S 01860CSR END1 ENDSR 01870C******************************************************************* 01880CSR SR2 BEGSR 01890C* EDIT FROM ZIP CODE. 01900CSR TZIP,S COMP 0 54 01910CSR 54 TZIP,S COMP FZIP,S 55 55 01920CSR 54N55 Z-ADD223 M 96 FLAG ERROR 01930CSR ENDSR 01940C********************************************************************* 01950CSR SR3 BEGSR 01960C* EDIT THRU ZIP. 01970CSR EXSR SR2 01980CSR ENDSR 01990C********************************************************************* 02000CSR SR5 BEGSR ÐÐ02010C* EDIT STATE CODE. 02020CSR STC,S COMP ' ' 54 02030CSRN54 GOTO END5 02040CSR STC,S LOKUPTABSTC 54 02050CSRN54 Z-ADD130 M 96 FLAG ERROR 02060CSR END5 ENDSR 02070C********************************************************************** 02080CSR SR10 BEGSR 02090C* MAILER-1 NOT FLAG EDIT. 02100CSR NM1,S COMP ' ' 54 02110CSRN54 GOTO END10 02120CSR MC1,S COMP ' ' 54 02130CSRN54 Z-ADD225 M 96 FLAG ERROR. 02140CSR END10 ENDSR 02150C******************************************************************** 02160CSR SR12 BEGSR 02170C* MAILER-2 NOT FLAG EDIT. 02180CSR NM2,S COMP ' ' 54 02190CSRN54 GOTO END12 02200CSR MC2,S COMP ' ' 54 02210CSRN54 Z-ADD226 M 96 FLAG ERROR. 02220CSR END12 ENDSR 02230C******************************************************************** 02240CSR SR35 BEGSR 02250C* FINAL EDIT - SELECTOR CODE NOTS. ÐÐ02260CSR Z-ADD1 X 30 02270C*------------------------------------------------------------------- 02280CSR T35A TAG 02290CSR MOVEASC,X SEL 02300CSR MOVE SEL WRK 02310CSR Z-ADD1 A 30 02320C*------------------------------------------------------------------- 02330CSR T35B TAG 02340CSR MOVE WRK,A W1A 1 02350CSR W1A COMP ' ' 54 02360CSRN54 GOTO T35C 02370CSR MOVELWRK,A W1A 02380CSR W1A COMP ' ' 54 02390CSRN54 Z-ADD227 M 96 FLAG ERROR 02400CSRN54 GOTO END35 02410C*------------------------------------------------------------------- 02420CSR T35C TAG 02430CSR 1 ADD A A 02440CSR A COMP 11 54 02450CSRN54 GOTO T35B 02460C*------------------------------------------------------------------- 02470CSR T35D TAG 02480CSR 1 ADD X X 02490CSR X COMP 9 54 02500CSRN54 GOTO T35A ÐÐ02510CSR END35 ENDSR 02520C***************************************************************** 02530CSR SR70 BEGSR 02540C* CLEAR TERM SCREEN. 02550CSR EXITFQTOPF CLEAR SCREEN 02560CSR SETON 71 02570CSR EXCPT PUT HEADINGS 02580CSR SETOF 71 02590CSR ENDSR 02600C********************************************************************* 02610CSR SR72 BEGSR 02620C* PUT DATA TO TERM. 02630CSR 6 ADD S W3N 30 02640CSR MOVE W3N W3A 3 LINE #. 02650CSR MOVE BIT,28 A10,1 ESC. 02660CSR MOVE '8' A10,2 XY-CODE. 02670CSR MOVEAW3A A10,3 LINE #. 02680CSR MOVEA'001' A10,6 COL #. 02690CSR MOVE BIT,28 A10,9 NUL. 02700CSR MOVE 'K' A10,10 NUL. 02710CSR MOVEAA10 W10A 10 02720CSR MOVE BIT,6 A6,2 02730CSR MOVEAA6 W6A 6 02740CSR EXITFQWRITE X-Y-POS WRITE 02750CSR RLABL W10A ÐÐ02760CSR RLABL W6A 02770CSR SETON 72 02780CSR EXCPT WRITE DATA. 02790CSR SETOF 72 02800CSRN69 GOTO END72 NOT PROMPT 02810CSR 1 ADD LOC,F W3N 30 02820CSR MOVE W3N W3A 3 02830CSR MOVEAW3A A10,6 02840CSR MOVE BIT,8 A10,9 02850CSR MOVE BIT,1 A10,10 02860CSR MOVEAA10 W10A 10 02870CSR MOVE BIT,6 A6,2 02880CSR MOVEAA6 W6A 02890CSR EXITFQWRITE X-Y-POS READ 02900CSR RLABL W10A 02910CSR RLABL W6A 02920CSR END72 ENDSR 02930C*********************************************************************** 02940CSR SR73 BEGSR 02950C* PUT ERROR MESSAGE TO TERMINAL 02960CSR SETON 73 02970CSR EXCPT PUT MSG 02980CSR SETOF 73 02990CSR Z-ADDM LSTERR 50 03000CSR ENDSR ÐÐ03010C******************************************************************* 03020CSR SR75 BEGSR 03030C* READ FROM TERMINAL 03040CSR SETOF 779096 03050CSR SETOF 939291 03060CSR SETOF 898887 03070CSR SETOF 868584 03080CSR MOVE BIT,19 A6,2 BUF LENGTH 03090CSR MOVEAA6 W6A 6 03100CSR MOVE BLK36 W36A 36 BUFFER 03110CSR EXITFQWREED READ TERM 03120CSR RLABL W36A 03130CSR RLABL W6A 03140CSR MOVEAW36A A36 03150CSR MOVE BLK36 W36A 03160CSR Z-ADD1 W 30 03170CSR '\' LOKUPA36,W 90 FLAG ESC 03180CSRN90 GOTO T75B NOT ESC 03190CSR 1 ADD W W 03200CSR W COMP 36 54 03210CSR 54 GOTO T75A BAD ESC 03220CSR A36,W COMP 'G' 98 GOODBY 03230CSR A36,W COMP 'E' 94 MENU 03240CSR A36,W COMP 'N' 93 NEW ITEM 03250CSR A36,W COMP 'J' 92 JUMP ÐÐ03260CSR A36,W COMP 'F' 91 SKIP FRWRD 03270CSR A36,W COMP 'B' 89 SKIP BKWRD 03280CSR A36,W COMP 'S' 88 SPACE FILL 03290CSR A36,W COMP 'H' 87 HOME 03300CSR A36,W COMP 'U' 86 UPDATE 03310CSR A36,W COMP 'R' 85 REPEAT 03320CSR A36,W COMP 'D' 84 DONE 03330CSR 98 03340COR 94 03350COR 93 03360COR 92 03370COR 91 03380COR 89 03390COR 88 03400COR 87 03410COR 86 03420COR 84 03430COR 85 GOTO END75 GOOD ESC 03440C*------------------------------------------------------------------ 03450CSR T75A TAG 03460C* FLAG BAD ESC INPUT 03470CSR Z-ADD318 M 96 FLAG ERROR 03480CSR GOTO END75 03490C*-------------------------------------------------------------------- 03500CSR T75B TAG ÐÐ03510C* MOVE DATA 03520CSR Z-ADD1 W 03530CSR ' ' LOKUPA36,W 77 03540CSR 77 MOVEAA36,W W36A INPUT DATA 03550C*-------------------------------------------------------------------- 03560CSR END75 TAG 03570C* INIT PREV ERROR MSG. 03580CSR LSTERR COMP 0 54 03590CSR 54 MOVE BLK35 MGTEXT 03600CSR 54 EXSR SR73 BLANK MESSAGE 03610CSR Z-ADD0 LSTERR 50 03620CSR ENDSR 03630C********************************************************************** 03640CSR SR89 BEGSR 03650C* GET MESSAGE MASTER 03660CSR M CHAINMGFILE 54 03670CSR 54 MOVE BLK35 MGTEXT 03680CSR 54 MOVELM MGTEXT 03690CSR 54 MOVE MES,1 MGTEXT 03700CSR ENDSR 03710C****************************************************************** 03720CSR SR97 BEGSR 03730C* UPDATE CRTFILE. 03740CSR SETON 97 03750CSR EXCPT UPDATE CRTFILE ÐÐ03760CSR SETOF 97 03770CSR ENDSR 03780C*********************************************************************** 03790CSR SR101 BEGSR 03800C* 1-TIME INITIALIZE 03810CSR MOVE BIT,1 NUL 03820CSR MOVE BIT,1 A6 03830CSR Z-ADD23 FLIMIT 30 TOTAL NUMB FIELDS 03840CSR MOVE ' ' BLK36 36 03850CSR MOVE ' ' BLK8 8 03860CSR EXSR SR70 PUT HEADINGS 03870C* GET SELECTOR FILE. 03880CSR Z-ADD1 W5N 50 03890CSR W5N CHAINCFSELECT H8 03900CSR H8 GOTO END101 03910CSR Z-ADD0 S 03920CSR Z-ADD0 SET 03930CSR Z-ADD0 FZIP 03940CSR Z-ADD0 TZIP 03950CSR MOVE ' ' NZIP 03960CSR MOVE ' ' STC 03970CSR MOVE ' ' NST 03980CSR MOVE BLK36 FC 03990CSR MOVE ' ' NFC 04000CSR MOVE ' ' MC1 ÐÐ04010CSR MOVE ' ' NM1 04020CSR MOVE ' ' MC2 04030CSR MOVE ' ' NM2 04040CSR MOVE BLK36 SC 04050C*------------------------------------------------------------------- 04060CSR T101A TAG 04070CSR 1 ADD S S 04080CSR S COMP 9 54 04090CSR 54 GOTO END101 04100CSR SETON 72 04110CSR EXCPT 04120CSR SETOF 72 04130CSR GOTO T101A 04140C*------------------------------------------------------------------- 04150CSR END101 TAG 04160C* DEFINE WORK FIELDS,ETC. 04170CSR MOVE ' ' BLK35 35 04180CSR ENDSR 04190C********************************************************************** 04200CSR SR102 BEGSR 04210C* VALIDATE FIELD NO. 04220CSR F COMP 0 54 04230CSRN54 Z-ADD1 F 04240CSR F COMP FLIMIT 55 04250CSR 55 1 ADD S S ÐÐ04260CSR 55 Z-ADD1 F 04270CSR S COMP 9 55 04280CSR ENDSR 04290C******************************************************************** 04300CSR SR103 BEGSR 04310C* MOVE INPUT DATA 04320CSR EXSR SR201 IDENTIFY-F 04330CSR EXSR SR202 R. JUSTIFY 04340CSR 01 MOVE W10A SETNO 10 04350CSR 02 MOVE W10A FZIP,S 04360CSR 03 MOVE W10A TZIP,S 04370CSR 04 MOVELW36A NZIP,S 04380CSR 05 MOVELW36A STC,S 04390CSR 06 MOVELW36A NST,S 04400CSR 07 MOVELW36A FC,S 04410CSR 08 MOVELW36A NFC,S 04420CSR 09 MOVELW36A MC1,S 04430CSR 10 MOVELW36A NM1,S 04440CSR 11 MOVELW36A MC2,S 04450CSR 12 MOVELW36A NM2,S 04460CSR MOVELW36A W2A 2 04470CSR 13 MOVE W2A SEL,1 04480CSR 14 MOVE W2A SEL,2 04490CSR 15 MOVE W2A SEL,3 04500CSR 16 MOVE W2A SEL,4 ÐÐ04510CSR 17 MOVE W2A SEL,5 04520CSR 18 MOVE W2A SEL,6 04530CSR 19 MOVE W2A SEL,7 04540CSR 20 MOVE W2A SEL,8 04550CSR 21 MOVE W2A SEL,9 04560CSR 22 MOVE W2A SEL,10 04570CSR 23 MOVE W2A SEL,11 04580CSR F COMP 13 54 54 04590CSR 54 F COMP 23 5454 04600CSR 54 MOVEL' ' SEL 04610CSR 54 MOVEASEL SC,S 04620CSR MOVE ' ' DUN,F EDIT FLAG 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR104 BEGSR 04660C* EDIT INPUT DATA 04670CSR 01 EXSR SR1 04680CSR 02 EXSR SR2 04690CSR 03 EXSR SR3 04700CSR 05 EXSR SR5 04710CSR 10 EXSR SR10 04720CSR 12 EXSR SR12 04730CSR 96 MOVE ' ' DUN,F EDIT FLAG 04740CSRN96 MOVE 'X' DUN,F 04750CSR ENDSR ÐÐ04760C*********************************************************************** 04770CSR SR105 BEGSR 04780C* FINAL EDIT 04790CSR SETON 79 FINAL EDIT FLAG 04800CSR Z-ADD1 F 96 04810C*-------------------------------------------------------------------- 04820CSR T105A TAG 04830CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04840CSRN54 GOTO END105 04850CSR EXSR SR201 IDENTIFY-F 04860CSR EXSR SR104 EDIT 04870CSRN96 GOTO T105A 04880C*-------------------------------------------------------------------- 04890CSR END105 TAG 04900CSRN96 EXSR SR35 FINAL EDIT. 04910CSR SETOF 79 04920CSR ENDSR 04930C******************************************************************** 04940CSR SR106 BEGSR 04950C* OUTPUT CFSELECT RECORD. 04960CSR SETON 83 04970CSR EXCPT PUTOUT CFSELECT 04980CSR SETOF 83 04990CSR ENDSR 05000C************************************************************************ ÐÐ05010CSR SR201 BEGSR 05020C* IDENTIFY FIELD NO. 05030CSR F COMP 11 54 05040CSR 54 GOTO T201A 05050CSR SETOF 121314 05060CSR SETOF 151617 05070CSR SETOF 181920 05080CSR SETOF 212223 05090CSR F COMP 1 01 05100CSR F COMP 2 02 05110CSR F COMP 3 03 05120CSR F COMP 4 04 05130CSR F COMP 5 05 05140CSR F COMP 6 06 05150CSR F COMP 7 07 05160CSR F COMP 8 08 05170CSR F COMP 9 09 05180CSR F COMP 10 10 05190CSR F COMP 11 11 05200CSR GOTO END201 05210C*----------------------------------------------------------------- 05220CSR T201A TAG 05230CSR SETOF 010203 05240CSR SETOF 040506 05250CSR SETOF 070809 ÐÐ05260CSR SETOF 1011 05270CSR F COMP 12 12 05280CSR F COMP 13 13 05290CSR F COMP 14 14 05300CSR F COMP 15 15 05310CSR F COMP 16 16 05320CSR F COMP 17 17 05330CSR F COMP 18 18 05340CSR F COMP 19 19 05350CSR F COMP 20 20 05360CSR F COMP 21 21 05370CSR F COMP 22 22 05380CSR F COMP 23 23 05390CSR END201 ENDSR 05400C********************************************************************** 05410CSR SR202 BEGSR 05420C* RIGHT JUSTIFY 05430CSR F LOKUPNUM 54 05440CSRN54 GOTO END202 NOT NUMERIC FIELD 05450CSR Z-ADD10 W2N 20 05460CSR MOVELW36A W10A 10 05470CSR EXIT SUBRAJ R. JUSTIFY 05480CSR RLABL W2N 05490CSR RLABL W10A 05500CSR END202 ENDSR ÐÐ05510O******************************************************************** 05520OCFSELECTE 83 05530O SET 9 05540O FZIP 90 05550O TZIP 171 05560O NZIP 180 05570O STC 198 05580O NST 207 05590O FC 522 05600O NFC 531 05610O MC1 558 05620O NM1 567 05630O MC2 594 05640O NM2 603 05650O SC 900 05660O******************************************************************** 05670OTERM132 E 70 05680O* CLEAR SCREEN (1-TIME ONLY) 05690O 68 'MAILING LIST SELECTION' 05700O 74 'INPUT' 05710O*------------------------------------------------------------------- 05720O E 71 05730O* PUT HEADINGS. 05740O 18 '*-----Z I P ' 05750O 31 'C O D E-----*' ÐÐ05760O 42 '---STATE---' 05770O 43 '*' 05780O 56 '-------------' 05790O 71 'FOREIGN COUNTRY' 05800O 83 '------------' 05810O 100 '*--MAILER CODES-*' 05820O 118 '---S E L E C T O R' 05830O 132 'C O D E S--' 05840O*------------------------------------------------------------------- 05850O E 71 05860O 5 'SET *' 05870O 31 'NOT *' 05880O 43 'NOT *' 05890O 84 'NOT *' 05900O 91 'NOT' 05910O 100 'NOT*' 05920O*------------------------------------------------------------------- 05930O E 71 05940O 5 'NO. *' 05950O 14 'FROM' 05960O 24 'THRU' 05970O 29 'FLAG' 05980O 43 '* CODE FLAG*' 05990O 61 'COUNTRY STATE/NAME' 06000O 78 '.................' ÐÐ06010O 84 'FLAG*' 06020O 99 'COD FLG COD FLG' 06030O 114 '*CN CN CN CN CN' 06040O 132 'CN CN CN CN CN CN' 06050O*------------------------------------------------------------------- 06060O E 71 06070O 2 '1' 06080O 5 '*' 06090O 13 '2' 06100O 23 '3' 06110O 28 '4' 06120O 31 '*' 06130O 34 '5' 06140O 40 '6' 06150O 43 '*' 06160O 44 '7' 06170O 82 '8' 06180O 84 '*' 06190O 86 '9' 06200O 90 '10' 06210O 94 '11' 06220O 98 '12' 06230O 100 '*' 06240O 102 '13' 06250O 105 '14' ÐÐ06260O 108 '15' 06270O 111 '16' 06280O 114 '17' 06290O 117 '18' 06300O 120 '19' 06310O 123 '20' 06320O 126 '21' 06330O 129 '22' 06340O 132 '23' 06350O*------------------------------------------------------------------- 06360O E 71 06370O 5 '*' 06380O 31 '*' 06390O 43 '*' 06400O 84 '*' 06410O 88 '*' 06420O 91 '*' 06430O 96 '*' 06440O 100 '*' 06450O*------------------------------------------------------------------- 06460O E 72 06470O* PUT DATA TO SCREEN. 06480O SET,S Z 2 06490O FZIP,SZ 14 06500O TZIP,SZ 24 ÐÐ06510O NZIP,S 28 06520O STC,S 35 06530O NST,S 40 06540O FC,S 78 06550O NFC,S 82 06560O SC,S 132 06570O MC1,S 87 06580O NM1,S 90 06590O MC2,S 95 06600O NM2,S 98 06610O 5 '*' 06620O 31 '*' 06630O 43 '*' 06640O 84 '*' 06650O 88 '*' 06660O 91 '*' 06670O 96 '*' 06680O 100 '*' 06690O*------------------------------------------------------------------- 06700O E 73 06710O* PUT ERROR MSG. 06720O BIT,28 1 06730O 8 '8020001' 06740O 96 13 '*****' 06750O MGTEXT 48 ÐÐ06760O 96 53 '*****' 06770O 96 BIT,8 132 ** NUL ARRAY 006780 006790** A6 ARRAY 006800 006810** A10 ARRAY 006820 006830** A36 ARRAY 006840 006850** NUM ARRAY 006860001 SET # 006870002 FROM ZIP 006880003 THRU ZIP 006890** DUN ARRAY 006900 006910** MES ARRAY 006920---MESSAGE NOT ON FILE--- 006930** SEL ARRAY 006940 006950** WRK ARRAY 006960 006970** LOC ARRAY 006980002 1 06990007 2 07000ÐÐ017 3 07010028 4 07020034 5 07030040 6 07040044 7 07050082 8 07060085 9 07070089 10 07080092 11 07090097 12 07100101 13 07110104 14 07120107 15 07130110 16 07140113 17 07150116 18 07160119 19 07170122 20 07180125 21 07190128 22 07200131 23 07210** TABSTC - STATE CODES 07220 007230AL 007240AK 007250ÐÐAZ 007260AR 007270AS 007280CA 007290CZ 007300CO 007310CT 007320DE 007330DC 007340FL 007350GA 007360GU 007370HI 007380ID 007390IL 007400IN 007410IA 007420KS 007430KY 007440LA 007450ME 007460MD 007470MA 007480MI 007490MN 007500ÐÐMS 007510MO 007520MT 007530NE 007540NV 007550NH 007560NJ 007570NM 007580NY 007590NC 007600ND 007610OH 007620OK 007630OR 007640PA 007650PR 007660RI 007670SC 007680SD 007690TN 007700TT 007710TX 007720UT 007730VT 007740VA 007750ÐÐVI 007760WA 007770WV 007780WI 007790WY 007800/* 007810_‚ ÐÐ_‚_‚ 007760WA 007770WV 007780WI 007790WY 007800/* 007810_‚ ÐÈ(î}š î9X006CM P120282120282(èÈÐ00010H Q006CM00020F* UPDATE CUSTOMER BILL-TO ADDRESS. (X006CM) 00030F* REVISED 1-06-81 10:15 AM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCR2FILE UC F 672R DISK 00070FCMBTAFILUC F 352R 5AI 1 DISK A 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E TABSTC 1 58 2 TABSCN 20 STATE NAMES. 00110E NUL 1 132 1 NULL CHAR 00120E A6 6 6 1 CALL READ PARAM. 00130E A36 36 36 1 A INPUT DATA ARRAY 00140E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00150E DUN 28 28 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E HED 1 14 35 00180E CRAR 4 9 2 00190E CRA 7 35 A ADDRESS 00200E CRB 10 9 2 00210E CRS 10 9 2 00220E CRD 5 7 0 00230E CRM 3 3 00240E CRC 3 2 0 00250E CBA 7 35 BILL-TO ADDRESS ÐÐ00260E BIT 33 1 SCREEN CONTR. CHAR 00270E CALL 5 6 CALL STACK 00280I******************************************************************* 00290IBITTAB BT 00300I 1 33 BIT 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I****************************************************************** 00360ICR2FILE CR 00370I* CUSTOMER NO. 5N 00380I 1 50CRCUST 00390I* SORT KEY 20A 00400I 6 25 CRSORT 00410I* ADDRESS 35A X 7 00420I 26 270 CRA 00430I* STATE CODE 2A 00440I 271 272 CRSTCD 00450I* ZIP CODE 9P 00460I P 273 2770CRZIP 00470I* PHONE NO. 15A 00480I 278 292 CRPHON 00490I* CONTACT NAME 35A 00500I 293 327 CRCONT ÐÐ00510I* REMARKS 35A 00520I 328 362 CRREM 00530I* CUSTOMER CLASS 2A 00540I 363 364 CRCLAS 00550I* TERRITORY CODE 3A 00560I 365 367 CRTER 00570I* CREDIT LIMIT 7P 00580I P 368 3710CRCRLM 00590I* PAYMENT TERMS 8A 00600I 372 379 CRTERM 00610I* NUMBER OF INVOICE COPIES 1N 00620I 380 380 CRINV 00630I* SHIPPING METHOD 20A 00640I 381 400 CRSHIP 00650I* CURRENT BACKLOG 9.2P X 10 00660I P 401 450 CRB 00670I* LAST 12-MOS SHIPMENTS 9.2P X 10 00680I P 451 500 CRS 00690I* CURRENT RECEIVABLES 9.2P X 4 00700I P 501 520 CRAR 00710I* TAX CODE 1A 00720I 521 521 CRTAX 00730I* STD DISCOUNT 3.2P 00740I P 522 5232CRDISC 00750I* EXPORT CODE 1A ÐÐ00760I 524 524 CREXPT 00770I* DATE HISTORY 7P X 5 00780I P 525 544 CRD 00790I* GEOGRAPHIC CODE 5A 00800I 545 549 CRGEO 00810I* HOLD CODE 1A 00820I 550 550 CRHOLD 00830I* MAILING CODES. 00840I* MAILER CODES 3 X 3A 00850I 551 559 CRM 00860I* NUMB OF COPIES 3 X 2N 00870I 560 565 CRC 00880I* POINTERS. 00890I* CREDIT CHANGES 5P 00900I P 573 5750CRFCC 00910I* PREVIOUS SORT KEY 20A 00920I 577 596 CROSRT 00930I* START PROG NAME 6A 00940I 666 671 CRPROG 00950I* TRANSACTION CODE 1A 00960I 672 672 CRTRAN 00970I******************************************************************** 00980ICMBTAFILCB 00990I* CUSTOMER BILL TO ADDRESS FILE. 01000I* CUST # 5N ÐÐ01010I 1 50CBCUST 01020I* ADDRESS 35A X 7 01030I 6 250 CBA 01040I* STATE CODE 2A 01050I 251 252 CBSTCD 01060I* ZIP CODE 9P 01070I P 253 2570CBZIP 01080I* CONTACT 35A 01090I 258 292 CBCONT 01100I* TELEPHONE 15A 01110I 293 307 CBPHON 01120I* REMARKS 35A 01130I 308 342 CBREM 01140I* RECORD STATUS 1A 01150I 352 352 CBSTAT 01160C******************************************************************** 01170C* INITIALIZE 01180C EXSR SR101 1-TIME INIT 01190C* PUT BILL-TO SCREEN. 01200C EXSR SR71 PUT SCREEN. 01210C EXSR SR203 CLASSIFY TRAN. 01220C 62 83 NOT ON FILE. 01230COR 62 84 MOVELCRPROG PROG 8 01240C 62 83 01250COR 62 84 GOTO END ÐÐ01260C 62 CRPROG COMP 'Q001CM' 54 01270C 62 54 GOTO UPDATE 01280C*------------------------------------------------------------------ 01290C START TAG 01300C* SET-UP 1ST FIELD NO. 01310C Z-ADD3 F 30 FIELD # 01320C GOTO READ 01330C*------------------------------------------------------------------ 01340C NEXT TAG 01350C* SET-UP NEXT FIELD NO. 01360C 1 ADD F F FIELD # 01370C*----------------------------------------------------------------- 01380C READ TAG 01390C* READ DATA FROM TERMINAL. 01400C SETOF 9096 01410C EXSR SR102 VALIDATE FIELD # 01420C 55 GOTO UPDATE DONE 01430C EXSR SR203 CLASSIFY TRAN. 01440C 62 F COMP 3 54 01450C 62 54 GOTO UPDATE 01460C EXSR SR201 IDENTIFY-F 01470C SETON 69 01480C EXSR SR72 PROMPT 01490C SETOF 69 01500C EXSR SR75 READ TERMINAL ÐÐ01510C 98 GOTO GOODBY GOODBY 01520C 94 GOTO MENU MENU REQUEST 01530C N77N88 EXSR SR104 EDIT INPUT FIELD 01540C 96 ERROR 01550CORN77N88 EXSR SR72 REWRITE INPUT DATA 01560C 93 GOTO NEWITM NEW ITEM 01570C 92 GOTO JUMP FIELD JUMP REQST 01580C 91 GOTO NEXT SKIP FORWARD 01590C 89 F SUB 1 F SKIP BACKWARD 01600C 89 GOTO READ " " 01610C 88 SETOF 90 SPACE FILL 01620C 88 SETON 77 " " 01630C 87 GOTO START 01640C 86 GOTO UPDATE UPDATE 01650C 85 GOTO READ REPEAT 01660C 96 GOTO ERROR ERROR 01670C N77 GOTO NEXT NO DATA INPUT 01680C*------------------------------------------------------------------ 01690C PROCES TAG 01700C* PROCESS INPUT DATA 01710C EXSR SR103 MOVE DATA 01720C N96 EXSR SR104 EDIT DATA 01730C EXSR SR72 REWRITE DATA 01740C 96 GOTO ERROR ERROR 01750C GOTO NEXT ÐÐ01760C*------------------------------------------------------------------ 01770C UPDATE TAG 01780C* UPDATE DATA BASE. 01790C EXSR SR105 FINAL EDIT 01800C 96 GOTO ERROR ERROR 01810C EXSR SR106 UPDATE. 01820C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01830C MOVELCRPROG PROG 8 01840C GOTO END 01850C*------------------------------------------------------------------- 01860C JUMP TAG 01870C* SET-UP JUMP TO REQUESTED FIELD 01880C 1 ADD W W 30 01890C W COMP 36 54 01900C 54 Z-ADD318 M 50 96 FLAG ERROR 01910C 54 GOTO ERROR BAD ESC 01920C MOVE '000' W3A 3 01930C MOVEAA36,W W3A 01940C Z-ADD3 W2N 20 01950C EXIT SUBRAJ R. JUSTIFY 01960C RLABL W2N 01970C RLABL W3A 01980C MOVE W3A F NEW FIELD # 01990C GOTO READ 02000C*-------------------------------------------------------------------- ÐÐ02010C ERROR TAG 02020C EXSR SR102 VALIDATE FIELD # 02030C EXSR SR89 GET MSG 02040C EXSR SR73 PUT MSG 02050C GOTO READ 02060C*------------------------------------------------------------------ 02070C NEWITM TAG 02080C* SET-UP LINK FOR NEW ITEM 02090C MOVELCRPROG PROG 8 02100C GOTO END 02110C*------------------------------------------------------------------- 02120C MENU TAG 02130C* SET-UP LINK TO MENU 02140C MOVEL'Q070DP' PROG 02150C GOTO END 02160C*-------------------------------------------------------------------- 02170C GOODBY TAG 02180C* LINK TO SIGN-OFF 02190C MOVEL'GOODBY' PROG 02200C GOTO END 02210C*------------------------------------------------------------------- 02220C END TAG 02230C EXSR SR97 UPDATE CR2FILE 02240C PROG COMP BLK8 54 02250C N54 MOVEL'Q070DP' PROG ÐÐ02260C EXITFCHAIN LINK TO NEXT PROG 02270C RLABL PROG 02280C********************************************************************* 02290CSR SR3 BEGSR 02300C* EDIT ADDRESS. 02310CSR MOVE ' ' BLK35 35 STUPIDITY 02320CSR BLK35 LOKUPCRA 54 02330CSRN54 Z-ADD117 M 96 FLAG ERROR. 02340CSR ENDSR 02350C******************************************************************** 02360CSR SR10 BEGSR 02370C* EDIT STATE CODE. 02380CSR CRSTCD COMP ' ' 54 02390CSRN54 GOTO T10A 02400CSR CRSTCD LOKUPTABSTC 54 02410CSRN54 Z-ADD130 M 96 FLAG ERROR. 02420CSR GOTO END10 02430C*------------------------------------------------------------------- 02440CSR T10A TAG 02450C* STATE CODE IS BLANK. 02460CSR CRA,7 COMP BLK35 54 02470CSRN54 Z-ADD132 M 96 FLAG ERROR. 02480CSR END10 ENDSR 02490C******************************************************************** 02500CSR SR71 BEGSR ÐÐ02510C* PUT BILL-TO SCREEN. 02520C* GET BILL-TO RECORD, IF ANY. 02530CSR EXSR SR84 GET BILL-TO. 02540CSR 83 02550COR 84 GOTO T71A 02560C* SAVE DATA. 02570CSR MOVE CBA CRA 02580CSR MOVE CBSTCD CRSTCD 02590CSR Z-ADDCBZIP CRZIP 02600CSR MOVE CBCONT CRCONT 02610CSR MOVE CBPHON CRPHON 02620CSR MOVE CBREM CRREM 02630C*------------------------------------------------------------------- 02640CSR T71A TAG 02650CSR Z-ADD0 F 30 02660C*------------------------------------------------------------------- 02670CSR T71B TAG 02680C* PUT DATA TO SCREEN. 02690CSR 1 ADD F F 02700CSR F COMP 14 54 02710CSR 54 GOTO END71 02720CSR EXSR SR201 IDENTIFY-F. 02730CSR EXSR SR72 PUT SCREEN. 02740CSR GOTO T71B 02750CSR END71 ENDSR ÐÐ02760C******************************************************************** 02770CSR SR72 BEGSR 02780C* PUT DATA TO TERMINAL 02790CSR 31 ADD F W3N 30 02800CSR MOVE W3N LINE 3 LINE # 02810CSR SETON 72 02820CSR EXCPT PUT DATA 02830CSR SETOF 72 02840CSR ENDSR 02850C*********************************************************************** 02860CSR SR73 BEGSR 02870C* PUT ERROR MESSAGE TO TERMINAL 02880CSR SETON 73 02890CSR EXCPT PUT MSG 02900CSR SETOF 73 02910CSR Z-ADDM LSTERR 50 02920CSR ENDSR 02930C******************************************************************* 02940CSR SR75 BEGSR 02950C* READ FROM TERMINAL 02960CSR SETOF 779096 02970CSR SETOF 939291 02980CSR SETOF 898887 02990CSR SETOF 8685 03000CSR MOVE BIT,19 A6,2 BUF LENGTH ÐÐ03010CSR MOVEAA6 W6A 6 03020CSR MOVE BLK36 W36A 36 BUFFER 03030CSR EXITFXCREAD READ TERM 03040CSR RLABL W36A 03050CSR RLABL W6A 03060CSR MOVEAW36A A36 03070CSR MOVE BLK36 W36A 03080CSR Z-ADD1 W 30 03090CSR '\' LOKUPA36,W 90 FLAG ESC 03100CSRN90 GOTO T75B NOT ESC 03110CSR 1 ADD W W 03120CSR W COMP 36 54 03130CSR 54 GOTO T75A BAD ESC 03140CSR A36,W COMP 'G' 98 GOODBY 03150CSR A36,W COMP 'E' 94 MENU 03160CSR A36,W COMP 'N' 93 NEW ITEM 03170CSR A36,W COMP 'J' 92 JUMP 03180CSR A36,W COMP 'F' 91 SKIP FRWRD 03190CSR A36,W COMP 'B' 89 SKIP BKWRD 03200CSR A36,W COMP 'S' 88 SPACE FILL 03210CSR A36,W COMP 'H' 87 HOME 03220CSR A36,W COMP 'U' 86 UPDATE 03230CSR A36,W COMP 'R' 85 REPEAT 03240CSR 98 03250COR 94 ÐÐ03260COR 93 03270COR 92 03280COR 91 03290COR 89 03300COR 88 03310COR 87 03320COR 86 03330COR 85 GOTO END75 GOOD ESC 03340C*------------------------------------------------------------------ 03350CSR T75A TAG 03360C* FLAG BAD ESC INPUT 03370CSR Z-ADD318 M 96 FLAG ERROR 03380CSR GOTO END75 03390C*-------------------------------------------------------------------- 03400CSR T75B TAG 03410C* MOVE DATA 03420CSR Z-ADD1 W 03430CSR ' ' LOKUPA36,W 77 03440CSR 77 MOVEAA36,W W36A INPUT DATA 03450C*-------------------------------------------------------------------- 03460CSR END75 TAG 03470C* INIT PREV ERROR MSG. 03480CSR LSTERR COMP 0 54 03490CSR 54 MOVE BLK35 MGTEXT 03500CSR 54 EXSR SR73 BLANK MESSAGE ÐÐ03510CSR Z-ADD0 LSTERR 50 03520CSR ENDSR 03530C********************************************************************** 03540CSR SR81 BEGSR 03550C* REWRITE CMBTAFIL. 03560CSR SETON 81 03570CSR EXCPT 03580CSR SETOF 81 03590CSR ENDSR 03600C******************************************************************** 03610CSR SR84 BEGSR 03620C* GET CMBTAFIL. 03630CSR SETOF 84 03640CSR CRCUST CHAINCMBTAFIL 83 03650CSRN83 CBSTAT COMP 'D' 84 03660CSR ENDSR 03670C********************************************************************** 03680CSR SR89 BEGSR 03690C* GET MESSAGE MASTER 03700CSR M CHAINMGFILE 54 03710CSR 54 MOVE BLK35 MGTEXT 03720CSR 54 MOVELM MGTEXT 03730CSR 54 MOVE MES,1 MGTEXT 03740CSR ENDSR 03750C****************************************************************** ÐÐ03760CSR SR97 BEGSR 03770C* UPDATE CR2FILE. 03780CSR SETON 97 03790CSR EXCPT UPDATE CR2FILE 03800CSR SETOF 97 03810CSR ENDSR 03820C*********************************************************************** 03830CSR SR101 BEGSR 03840C* 1-TIME INITIALIZE 03850CSR MOVE BIT,1 NUL 03860CSR MOVE BIT,1 A6 03870CSR Z-ADD14 FLIMIT 30 TOTAL NUMB FIELDS 03880CSR EXSR SR73 POSITION SCREEN 03890CSR MOVE ' ' BLK36 36 03900C* GET PORT # AND CR2FILE 03910CSR MOVE ' ' W8A 8 03920CSR Z-ADD0 W2N 20 03930CSR Z-ADD0 W1N 10 03940CSR MOVE ' ' W2A 2 03950CSR EXITFPGMINX GET PORT # 03960CSR RLABL W8A 03970CSR RLABL W2N 03980CSR RLABL W1N 03990CSR RLABL W2A 04000CSR MOVE W2A PORT 20 PORT NO. ÐÐ04010CSR PORT COMP 0 54 04020CSRN54 Z-ADD25 PORT DEFAULT 04030CSR PORT CHAINCR2FILE H9 04040CSR H9 GOTO END101 04050CSR XFOOTCRB TOTBKL 92 TOTAL BACKLOG. 04060CSR XFOOTCRS TOTSHP 92 TOTAL SHIPPED. 04070CSR XFOOTCRAR TOTAR 92 04080C* DEFINE WORK FIELDS,ETC. 04090CSR MOVE ' ' BLK6 6 04100CSR MOVE ' ' BLK8 8 04110CSR MOVE ' ' BLK20 20 04120CSR MOVE ' ' BLK35 35 04130CSR END101 ENDSR 04140C********************************************************************** 04150CSR SR102 BEGSR 04160C* VALIDATE FIELD NO. 04170CSR F COMP 2 54 04180CSRN54 Z-ADD3 F 04190CSR F COMP FLIMIT 55 04200CSR 55 Z-ADD3 F 04210CSR ENDSR 04220C******************************************************************** 04230CSR SR103 BEGSR 04240C* MOVE INPUT DATA 04250CSR EXSR SR201 IDENTIFY-F ÐÐ04260CSR EXSR SR202 R. JUSTIFY 04270CSR 03 MOVELW36A CRA,1 ADDRESS ARRAY 04280CSR 04 MOVELW36A CRA,2 04290CSR 05 MOVELW36A CRA,3 04300CSR 06 MOVELW36A CRA,4 04310CSR 07 MOVELW36A CRA,5 04320CSR 08 MOVELW36A CRA,6 04330CSR 09 MOVELW36A CRA,7 04340CSR 10 MOVELW36A CRSTCD STATE CODE. 04350CSR 11 MOVE W15A CRZIP ZIP CODE. 04360CSR 12 MOVELW36A CRCONT CONTACT. 04370CSR 13 MOVELW36A CRPHON PHONE #. 04380CSR 14 MOVELW36A CRREM REMARKS. 04390C* GET FIELD DESCRIPTORS. 04400CSR 10 CRSTCD LOKUPTABSTC TABSCN 54 04410CSR 10 54 MOVE TABSCN STCNAM STATE NAME. 04420CSR 10N54 MOVE BLK20 STCNAM 20 04430CSR MOVE ' ' DUN,F EDIT FLAG. 04440CSR ENDSR 04450C******************************************************************** 04460CSR SR104 BEGSR 04470C* EDIT INPUT DATA 04480CSR 03 EXSR SR3 04490CSR 10 EXSR SR10 04500CSR 96 MOVE ' ' DUN,F EDIT FLAG ÐÐ04510CSRN96 MOVE 'X' DUN,F 04520CSR ENDSR 04530C*********************************************************************** 04540CSR SR105 BEGSR 04550C* FINAL EDIT 04560CSR SETON 79 FINAL EDIT FLAG 04570CSR Z-ADD1 F 04580C*-------------------------------------------------------------------- 04590CSR T105A TAG 04600CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04610CSRN54 GOTO END105 04620CSR EXSR SR201 IDENTIFY-F 04630CSR EXSR SR104 EDIT 04640CSR EXSR SR203 CLASSIFY TRAN. 04650CSR 62 F COMP 3 54 54 04660CSR 62 54 GOTO END105 04670CSRN96 GOTO T105A 04680C*-------------------------------------------------------------------- 04690CSR END105 TAG 04700CSR SETOF 79 04710CSR ENDSR 04720C******************************************************************** 04730CSR SR106 BEGSR 04740C* UPDATE BILL-TO ADDRESS FILE. 04750CSR EXSR SR203 CLASSIFY TRAN ÐÐ04760CSR 60 GOTO T106A ADD TRAN 04770CSR 61 GOTO T106B CHANGE TRAN 04780CSR 62 GOTO T106C DELETE TRAN 04790C* FLAG BAD TRAN CODE 04800CSR Z-ADD300 M 96 FLAG ERROR 04810CSR GOTO END106 04820C*------------------------------------------------------------------- 04830CSR T106A TAG 04840C* ADD TRANSACTION 04850CSR EXSR SR84 GET CMBTAFIL. 04860CSR MOVE 'A' CBSTAT 04870CSR EXSR SR81 REWRITE CMBTA. 04880CSR GOTO END106 04890C*--------------------------------------------------------------------- 04900CSR T106B TAG 04910C* CHANGE TRANSACTION. 04920CSRN54 GOTO T106A NO BILL-TO EXISTS 04930CSR EXSR SR84 GET CMBTA. 04940CSR EXSR SR81 REWRITE CMBTA. 04950CSR GOTO END106 04960C*---------------------------------------------------------------------- 04970CSR T106C TAG 04980C* DELETE TRANSACTION. 04990CSRN54 GOTO END106 05000CSR EXSR SR84 GET CMBTA. ÐÐ05010CSR MOVE 'D' CBSTAT RECORD CODE. 05020CSR EXSR SR81 REWRITE CMBTA. 05030CSR END106 ENDSR 05040C************************************************************************ 05050CSR SR201 BEGSR 05060C* IDENTIFY FIELD NO. 05070CSR F COMP 1 01 05080CSR F COMP 2 02 05090CSR F COMP 3 03 05100CSR F COMP 4 04 05110CSR F COMP 5 05 05120CSR F COMP 6 06 05130CSR F COMP 7 07 05140CSR F COMP 8 08 05150CSR F COMP 9 09 05160CSR F COMP 10 10 05170CSR F COMP 11 11 05180CSR F COMP 12 12 05190CSR F COMP 13 13 05200CSR F COMP 14 14 05210CSR END201 ENDSR 05220C********************************************************************** 05230CSR SR202 BEGSR 05240C* RIGHT JUSTIFY 05250CSR F LOKUPNUM 54 ÐÐ05260CSRN54 GOTO END202 NOT NUMERIC FIELD 05270CSR Z-ADD15 W2N 20 05280CSR MOVELW36A W15A 15 05290CSR EXIT SUBRAJ R. JUSTIFY 05300CSR RLABL W2N 05310CSR RLABL W15A 05320CSR END202 ENDSR 05330C*********************************************************************** 05340CSR SR203 BEGSR 05350C* CLASSIFY TRAN CODE 05360CSR CRTRAN COMP 'A' 60 ADD 05370CSR CRTRAN COMP 'C' 61 CHANGE 05380CSR CRTRAN COMP 'D' 62 DELETE 05390CSR ENDSR 05400C******************************************************************** 05410CSR SR204 BEGSR 05420C* FLAG ACTIVE ITEM ERROR. 05430CSR TOTBKL COMP 0 54 05440CSRN54 TOTAR COMP 0 54 05450CSR 54 Z-ADD29 M 96 FLAG ERROR. 05460CSR ENDSR 05470O******************************************************************** 05480OCR2FILE E 97 05490O CRCUST 5 05500O CRSORT 25 ÐÐ05510O CRA 270 05520O CRSTCD 272 05530O CRZIP 277P 05540O CRPHON 292 05550O CRCONT 327 05560O CRREM 362 05570O CRCLAS 364 05580O CRTER 367 05590O CRCRLM 371P 05600O CRTERM 379 05610O CRINV 380 05620O CRSHIP 400 05630O CRB 450P 05640O CRS 500P 05650O CRTAX 521 05660O CRAR 520P 05670O CRDISC 523P 05680O CREXPT 524 05690O CRD 544P 05700O CRGEO 549 05710O CRHOLD 550 05720O CRM 559 05730O CRC 565 05740O CRFCC 575P 05750O CRTRAN 672 ÐÐ05760O******************************************************************** 05770OTERM132 E 72 01 05780O BIT,28 1 05790O 8 '8031001' 05800O 70 'BILL-TO-ADDRESS' 05810O 83 89 '-NOT ON FILE *****' 05820O 84 89 '-NOT ON FILE *****' 05830O*------------------------------------------------------------------- 05840O E 72 05850O BIT,28 1 05860O 2 '8' 05870O LINE 5 05880O 8 '001' 05890O HED,F 43 05900O 01 CRTRAN 46 05910O 02 CRCUSTZ 50 05920O 03 CRA,1 80 05930O 04 CRA,2 80 05940O 05 CRA,3 80 05950O 06 CRA,4 80 05960O 07 CRA,5 80 05970O 08 CRA,6 80 05980O 09 CRA,7 80 05990O 10 CRSTCD 47 06000O 10 STCNAM 70 ÐÐ06010O 11 CRZIP Z 54 06020O 12 CRCONT 80 06030O 13 CRPHON 60 06040O 14 CRREM 80 06050O 69 BIT,28 124 06060O 69 125 '8' 06070O 69 LINE 128 06080O 69 131 '038' 06090O 69 BIT,8 132 06100O*------------------------------------------------------------------ 06110O E 73 06120O* PUT MSG. 06130O BIT,28 1 06140O 8 '8060001' 06150O MGTEXT 43 06160O 96 BIT,8 129 06170O 96 BIT,8 130 06180O BIT,28 131 06190O 132 'K' 06200O******************************************************************** 06210OCMBTAFILEADD 81 83 06220O CRCUST 5 06230O CRA 250 06240O CRSTCD 252 06250O CRZIP 257P ÐÐ06260O CRCONT 292 06270O CRPHON 307 06280O CRREM 342 06290O 352 'A' 06300O*------------------------------------------------------------------- 06310O E 81N83 06320O CRA 250 06330O CRSTCD 252 06340O CRZIP 257P 06350O CRCONT 292 06360O CRPHON 307 06370O CRREM 342 06380O CBSTAT 352 ** TABSTC/TABSCN - STATE NAMES 006390 006400ALALABAMA 006410AKALASKA 006420AZARIZONA 006430ARARKANSAS 006440ASAMERICAN SAMOA 006450CACALIFORNIA 006460CZCANAL ZONE 006470COCOLORADO 006480CTCONNECTICUT 006490DEDELAWARE 006500ÐÐDCDISTRICT OF COLUMBIA 006510FLFLORIDA 006520GAGEORGIA 006530GUGUAM 006540HIHAWAII 006550IDIDAHO 006560ILILLINOIS 006570ININDIANA 006580IAIOWA 006590KSKANSAS 006600KYKENTUCKY 006610LALOUISIANA 006620MEMAINE 006630MDMARYLAND 006640MAMASSACHUSETTS 006650MIMICHIGAN 006660MNMINNESOTA 006670MSMISSISSIPPI 006680MOMISSOURI 006690MTMONTANA 006700NENEBRASKA 006710NVNEVADA 006720NHNEW HAMPSHIRE 006730NJNEW JERSEY 006740NMMEW MEXICO 006750ÐÐNYNEW YORK 006760NCNORTH CAROLINA 006770NDNORTH DAKOTA 006780OHOHIO 006790OKOKLAHOMA 006800OROREGON 006810PAPENNSYLVANIA 006820PRPUERTO RICO 006830RIRHODE ISLAND 006840SCSOUTH CAROLINA 006850SDSOUTH DAKOTA 006860TNTENNESSEE 006870TTTRUST TERRITORIES 006880TXTEXAS 006890UTUTAH 006900VTVERMONT 006910VAVIRGINIA 006920VIVIRGIN ISLANDS 006930WAWASHINGTON 006940WVWEST VIRGINIA 006950WIWISCONSIN 006960WYWYOMING 006970** NUL ARRAY 006980 006990** A6 ARRAY 007000ÐÐ 007010** A36 ARRAY 007020 007030** NUM ARRAY 007040011 007050** DUN ARRAY 007060 007070** MES ARRAY 007080---MESSAGE NOT ON FILE--- 007090** HED ARRAY 007100 (1) TRANSACTION CODE- - - - - - - 007110 (2) CUSTOMER NO.- - - - - - - - - 007120 (3) COMPANY NAME- - - - - - - - - 007130 (4) COMPANY NAME- - - - - - - - - 007140 (5) ADDRESS-1 - - - - - - - - - - 007150 (6) ADDRESS-2 - - - - - - - - - - 007160 (7) LINE-5- - - - - - - - - - - - 007170 (8) CITY- - - - - - - - - - - - - 007180 (9) FOREIGN COUNTRY - - - - - - - 007190(10) STATE CODE- - - - - - - - - - 007200(11) ZIP CODE- - - - - - - - - - - 007210(12) CONTACT - - - - - - - - - - - 007220(13) TELEPHONE - - - - - - - - - - 007230(14) REMARKS - - - - - - - - - - - 007240/* 007250ÐÐ_‚ ÐÐ_‚_‚ ÐÈ(–~Ô –?X006DP P120282120282(èÈÐ00010H Q006DP00020F* DISPLAY HEX CHAR. (X006DP) 00030F* REVISED 4/18/79 3:20 PM. 00040FBITHEX IP F 256 DISK 00050FPMMST ID F 576L12AI 1 DISK 00060FTERMO O F 132 5 00070E******************************************************************** 00080E A6 6 6 1 00090E HEX 1 256 2 00100E NUM 1 576 3 00110E WK 8 8 1 00120E AH 1 576 2 00130E AB 1 576 8 00140E H1 16 16 1 00160E BIT 256 1 00170E REC 576 1 00180I******************************************************************** 00190IBITHEX BT 01 00200I 1 256 BIT 00210I******************************************************************** 00220IPMMST PM 02 00230I 1 576 REC 00240C******************************************************************** 00250C EXSR SR101 00260C Z-ADD0 X 30 ÐÐ00270C*------------------------------------------------------------------- 00280C START TAG 00290C MOVE BIT,1 A6 00300C MOVE BIT,7 A6,2 00310C MOVEAA6 W6A 6 00320C MOVE ' ' BLK12 12 00330C MOVE BLK12 W12A 12 00340C EXITFXCREAD 00350C RLABL W12A 00360C RLABL W6A 00370C W12A SETLLPMMST 00380C READ PMMST LR 00390C LR GOTO ENDLR 00400C*------------------------------------------------------------------- 00410C CONTU TAG 00420C 1 ADD X X 00430C X COMP 576 54 00440C 54 GOTO END 00450C Z-ADD1 H 30 00460C REC,X LOKUPBIT,H 88 00470C N88 MOVE 'XX' AH,X 00490C SETOF 505152 00500C SETOF 535455 00510C SETOF 5657 00520C MOVE '0' WK ÐÐ00530C TESTB'0' REC,X 50 00540C 50 MOVE '1' WK,1 00550C TESTB'1' REC,X 51 00560C 51 MOVE '1' WK,2 00570C TESTB'2' REC,X 52 00580C 52 MOVE '1' WK,3 00590C TESTB'3' REC,X 53 00600C 53 MOVE '1' WK,4 00610C TESTB'4' REC,X 54 00620C 54 MOVE '1' WK,5 00630C TESTB'5' REC,X 55 00640C 55 MOVE '1' WK,6 00650C TESTB'6' REC,X 56 00660C 56 MOVE '1' WK,7 00670C TESTB'7' REC,X 57 00680C 57 MOVE '1' WK,8 00690C MOVEAWK AB,X 00691C N88 MOVE 'XXX' NUM,X 00700C 88 MOVE H NUM,X 00710C 88 MOVE HEX,H AH,X 00720C GOTO CONTU 00730C*------------------------------------------------------------------- 00740C END TAG 00750C Z-ADD0 X 30 00760C*------------------------------------------------------------------- ÐÐ00770C LR10 TAG 00780C 1 ADD X X 00790C 1 ADD COUNT COUNT 30 00800C COUNT COMP 56 54 00810C 54 EXITFXPAUSE 00820C 54 Z-ADD1 COUNT 00830C SETON 80 00840C EXCPT 00850C SETOF 80 00860C X COMP 576 54 00870C N54 GOTO LR10 00880C*------------------------------------------------------------------- 00890C ENDLR TAG 00900C EXITFXPAUSE 00910C MOVE ' ' NUM 00920C MOVE ' ' AH 00930C MOVE ' ' BLK8 8 00940C MOVE BLK8 AB 00950C Z-ADD0 X 00960C GOTO START 00970C******************************************************************** 00980CSR SR101 BEGSR 00990CSR Z-ADD0 A 30 01000CSR Z-ADD0 T 30 01010C*------------------------------------------------------------------- ÐÐ01020CSR T101A TAG 01030CSR 1 ADD A A 01040CSR A COMP 16 54 01050CSR 54 GOTO END101 01060C*------------------------------------------------------------------- 01070CSR T101B TAG 01080CSR Z-ADD0 B 30 01090C*------------------------------------------------------------------- 01100CSR T101C TAG 01110CSR 1 ADD B B 01120CSR B COMP 16 54 01130CSR 54 GOTO T101A 01140CSR 1 ADD T T 01150CSR MOVELH1,A HEX,T 01160CSR MOVE H1,B HEX,T 01170CSR GOTO T101C 01180CSR END101 ENDSR 01190O******************************************************************** 01200OTERMO E 80 01210O X Z 3 01220O REC,X 6 01230O NUM,X 11 01240O AH,X 16 01250O AB,X 28 01260O E 81 ÐÐ01270O 5 'ERROR' 01280O REC,X 10 01290O X 15 ** A6 ARRAY 001300 001310** HEX ARRAY 001320 001330** NUM ARRAY 001340 001350** WK ARRAY 001360 001370** AH ARRAY 001380 001390** AB ARRAY 001400 001410** H1 ARRAY 0014200123456789ABCDEF 001430/* 001460_‚ ÐÐ_‚_‚0O 5 'ERROR' 01280O REC,X 10 01290O X 15 ** A6 ARRAY 001300 001310** HEX ARRAY 001320 001330** NUM ARRAY 001340 001350** WK ARRAY 001360 001370** AH ARRAY 001380 001390** AB ARRAY 001400 001410** H1 ARRAY 0014200123456789ABCDEF 001430/* 001460_‚ ÐÈ(  X006EG P120282120282(èÈÐ00010H Q006EG00020F* RESEQUENCE ENG TABLE RECORDS. (X006EG) 00030F* REVISED 4/30/80 6:10 PM. 00040FEGTABLE UP F 1202 DISK 00050I******************************************************************** 00060IEGTABLE EG 01 00070C******************************************************************** 00080C N69 Z-ADD0 SEQ 20 69 00090C 1 ADD SEQ SEQ 00100O******************************************************************** 00110OEGTABLE D 01 00120O SEQ 2 /* 000130_‚ _‚_‚ ÐÈ(& &æX009VM P999999120282(èÈÐ00010H Q009VM00020F* VENDOR PAY-TO MASTER DISPLAY, SORT KEY SEQ. (X009VM) 00030F* REVISED 8-18-82 4:55 PM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FVMPTVMSTIC F 384R 5AI 1 DISK 00080FVMPALT ID F 26L25AI 1 DISK 00090FSTNAME IT F 80 EDISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E STNAME TABSTC 1 58 2 TABSTN 20 STATE CODES/NAMES 00130E NUL 1 132 1 NULL CHAR 00140E A36 36 36 1 A INPUT DATA ARRAY 00150E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 1 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E LNK 1 7 6 A 00190E PAR 25 1 00200E TST 25 1 00210E BIT 33 1 SCREEN CONTR. CHAR 00220E CALL 7 6 CALL STACK 00230E VP 4 9 2 00240E VA 6 35 00250E VC 4 20 ÐÐ00260I******************************************************************* 00270IBITPAR BT 00280I 1 33 BIT 00290I 34 58 PAR 00300I 59 83 TST 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I****************************************************************** 00360ICRTFILE CR 00370I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00380I* STD AREA - SAME FOR ALL PROGRAMS. 00390I* EMPLOYEE # 5N 00400I 1 50CREMPL 00410I* USER CODE 8A 00420I 6 13 CRUSER 00430I* DEPT # 5N 00440I 14 180CRDEPT 00450I* JOB NAME 8A (JOB LOADED BY MENU) 00460I 19 26 CRJOB 00470I* SHUTDOWN FLAG 1A 00480I* BLANK = NO SHUTDOWN 00490I 27 27 CRSHUT 00500I* TIME STARTED 6N ÐÐ00510I 28 330CRTIME 00520I* DATE STARTED 4N 00530I 34 370CRDATE 00540I* CALL STACK 7 X 6A 00550I 38 79 CALL 00560I******************************************************************** 00570IVMPTVMSTVM 00580I* VENDOR MASTER. 00590I* VENDOR NO. (KEY) 5N 00600I 1 50VMVEND 00610I* SORT KEY 20A 00620I 6 25 VMSORT 00630I* ADDRESS 35A X 6 00640I 26 235 VA 00650I* STATE CODE 2A 00660I 236 237 VMSTCD 00670I* ZIP CODE 9P 00680I P 238 2420VMZIP 00690I* PHONE 15A 00700I 243 257 VMPHON 00710I* CONTACTS/REMARKS 20A X 4 00720I 258 337 VC 00730I* VENDOR TYPE 5A 00740I 338 342 VMTYPE 00750I* PAYABLES BALANCE 9.2P X 4 ÐÐ00760I* 1 = PAST DUE 00770I* 2 = 30-60 DAYS 00780I* 3 = 60-90 DAYS 00790I* 4 = BEYOND 00800I P 343 362 VP 00810I* PAYMENT TERMS 8A 00820I 363 370 VMTERM 00830I* FILLER 374 383 FFFFFF 00840I* RECORD STATUS 1A 00850I 384 384 VMSTAT 00860I******************************************************************** 00870IVMPALT VA 00880I* VENDOR PAY-TO MAST ALT KEY FILE. 00890I* SORT KEY 20A 00900I 1 20 VASORT 00910I* VENDOR # 5N 00920I 21 250VAVEND 00930I* RECORD STATUS 1A 00940I 26 26 VASTAT 00950C******************************************************************** 00960C* INITIALIZE 00970C EXSR SR101 1-TIME INIT 00980C MOVE ' ' BLK6 6 00990C*------------------------------------------------------------------ 01000C START TAG ÐÐ01010C* SET-UP 1ST FIELD NO. 01020C MOVE BLK20 TSORT 01030C MOVE ' ' DUN INIT EDIT ARRAY 01040C EXSR SR70 CLEAR PAGE 01050C N50 MOVEL'091' RPGLIN 4 01060C N50 MOVEL'001' RPGCOL 4 01070C N50 EXSR SR69 01080C SETOF 2021 01090C Z-ADD1 F 30 FIELD # 01100C GOTO READ 01110C*------------------------------------------------------------------ 01120C NEXT TAG 01130C* SET-UP NEXT FIELD NO. 01140C 1 ADD F F FIELD # 01150C*----------------------------------------------------------------- 01160C READ TAG 01170C* READ DATA FROM TERMINAL. 01180C SETOF 909677 01190C SETOF 939185 01200C EXSR SR102 VALIDATE FIELD # 01210C 55 GOTO UPDATE DONE 01220C EXSR SR201 IDENTIFY-F 01230C SETON 69 01240C EXSR SR72 PROMPT 01250C SETOF 69 ÐÐ01260C EXSR SR75 READ TERMINAL 01270C*------------------------------------------------------------------- 01280C ESCAPE TAG 01290C 91 GOTO START DONE 01300C 85 GOTO READ REPEAT 01310C N77 GOTO EDIT NO DATA INPUT 01320C*------------------------------------------------------------------ 01330C PROCES TAG 01340C* PROCESS INPUT DATA 01350C EXSR SR103 MOVE DATA 01360C*------------------------------------------------------------------- 01370C EDIT TAG 01380C*------------------------------------------------------------------ 01390C UPDATE TAG 01400C* UPDATE DATA BASE. 01410C* DISPLAY VENDORS. 01420C TSORT COMP BLK20 54 01430C N54 MOVE 'A' TSORT 01440C MOVELTSORT W25A 25 01450C W25A SETLLVMPALT 01460C EXITFQCLF LF 01470C*------------------------------------------------------------------- 01480C CONTU TAG 01490C SETOF 54 01500C READ VMPALT 54 ÐÐ01510C 54 GOTO START 01520C VASTAT COMP 'D' 54 01530C 54 GOTO CONTU 01540C VAVEND CHAINVMPTVMST 54 01550C N54 VMSTAT COMP 'D' 54 01560C 54 GOTO CONTU 01570C EXSR SR71 PUT VEND CRT 01580C EXITFQCLFCR CR/LF 01590C EXSR SR75 READ 01600C 90 GOTO ESCAPE ERROR 01610C 77 Z-ADD1 F 01620C 77 GOTO PROCES 01630C GOTO CONTU 01640C*------------------------------------------------------------------ 01650C NEWITM TAG 01660C* SET-UP LINK FOR NEW ITEM 01670C MOVEL'Q009VM' PROG 8 01680C GOTO END 01690C*------------------------------------------------------------------- 01700C MENU TAG 01710C* SET-UP LINK TO MENU 01720C EXSR SR96 GET CRTFILE 01730C Z-ADD1 W 01740C BLK6 LOKUPLNK,W 54 01750C 54 MOVELLNK,W PROG ÐÐ01760C 54 MOVE BLK6 LNK,W 01770C N54 MOVEL'CONTU' PROG 01780C EXSR SR97 UPD CRTFILE 01790C EXSR SR98 >>>>>>>>>> 01800C*-------------------------------------------------------------------- 01810C GOODBY TAG 01820C* LINK TO SIGN-OFF 01830C MOVEL'GOODBY' PROG 01840C GOTO END 01850C*------------------------------------------------------------------- 01860C END TAG 01870C EXSR SR96 GET CRTFILE 01880C EXSR SR97 UPD CRTFILE 01890C EXSR SR98 >>>>>>>>>> 01900C*------------------------------------------------------------------- 01910C ENDJOB TAG 01920C MOVEL'ENDJOB 'PROG 01930C EXSR SR98 >>>>>>>>>> 01940C******************************************************************** 01950CSR SR69 BEGSR 01960CSR 50 EXITFZPUTXY 01970CSR RLABL RPGLIN 01980CSR RLABL RPGCOL 01990CSRN50 EXITFZMOVXY 02000CSR RLABL RPGLIN ÐÐ02010CSR RLABL RPGCOL 02020CSR ENDSR 02030C******************************************************************** 02040CSR SR70 BEGSR 02050CSR 50 EXITFZISTAT 02060CSR 50 EXITFZESCH 02070CSRN50 EXITFZCPAGE 02080CSRN50 MOVEL'091' RPGLIN 02090CSRN50 MOVEL'001' RPGCOL 02100CSRN50 EXSR SR69 02110CSR ENDSR 02120C******************************************************************** 02130CSR SR71 BEGSR 02140C* CLEAR CRT PAGE. 02150CSRN50 EXITFZCPAGE CLEAR NEW PAGE 02160CSR 50 EXITFZISTAT 02170CSR 50 EXITFZESCH 02180C* PUT HEADINGS TO TERMINAL 02190CSR VMSTCD LOKUPTABSTC TABSTN 29 STATE CODE 02200CSR SETON 71 02210CSR EXCPT PUT HEADINGS 02220CSR SETOF 71 02230CSR ENDSR 02240C********************************************************************* 02250CSR SR72 BEGSR ÐÐ02260C* PUT DATA TO TERMINAL 02270CSR SETON 72 02280CSR EXCPT PUT DATA 02290CSR SETOF 72 02300CSR ENDSR 02310C******************************************************************* 02320CSR SR75 BEGSR 02330C* READ FROM TERMINAL 02340CSR SETOF 779096 02350CSR SETOF 9185 02360CSR MOVE BLK35 MGTEXT 02370CSR MOVE BLK36 W36A 36 BUFFER 02380CSR EXITFZR36 READ FROM TERMINAL 02390CSR RLABL W36A READ BUFFER 02400CSR MOVEAW36A A36 INPUT DATA ARRAY 02410CSR MOVE BLK36 W36A INIT INPUT ARRAY 02420CSR Z-ADD1 W 30 02430CSR '\' LOKUPA36,W 90 FLAG ESC 02440CSRN90 GOTO T75B NOT ESC 02450CSR 1 ADD W W 02460CSR W COMP 36 54 02470CSR 54 GOTO T75A BAD ESC 02480CSR A36,W COMP 'G' 98 GOODBY 02490CSR A36,W COMP 'E' 94 MENU 02500CSR A36,W COMP 'N' 93 NEW ITEM ÐÐ02510CSR A36,W COMP 'D' 91 DONE 02520CSR A36,W COMP 'R' 85 REPEAT 02530CSR 98 GOTO GOODBY 02540CSR 94 GOTO MENU 02550CSR 93 GOTO NEWITM 02560CSR 91 02570COR 85 GOTO END75 GOOD ESC 02580C*------------------------------------------------------------------ 02590CSR T75A TAG 02600C* FLAG BAD ESC INPUT 02610CSR Z-ADD318 M 30 96 FLAG ERROR 02620CSR GOTO END75 02630C*-------------------------------------------------------------------- 02640CSR T75B TAG 02650C* MOVE DATA 02660CSR Z-ADD1 W 02670CSR ' ' LOKUPA36,W 77 02680CSR 77 MOVEAA36,W W36A INPUT DATA 02690CSR END75 ENDSR 02700C********************************************************************** 02710CSR SR89 BEGSR 02720C* GET MESSAGE MASTER 02730CSR M CHAINMGFILE 54 02740CSR 54 MOVE BLK35 MGTEXT 02750CSR 54 MOVELM MGTEXT ÐÐ02760CSR 54 MOVE MES,1 MGTEXT 02770CSR ENDSR 02780C******************************************************************** 02790CSR SR96 BEGSR 02800CSR # CHAINCRTFILE H9 GET CRTFILE 02810CSR H9 GOTO ENDJOB 02820CSR ENDSR 02830C******************************************************************** 02840CSR SR97 BEGSR 02850C* UPDATE CRTFILE. EXIT PROGRAM. 02860CSR TIME CRTIME 02870CSR MOVELUDATE CRDATE 02880CSR SETON 97 02890CSR EXCPT UPDATE CRTFILE 02900CSR SETOF 97 02910CSR ENDSR 02920C******************************************************************** 02930CSR SR98 BEGSR 02940CSR EXSR SR70 CLEAR SCREEN 02950CSR EXITFCHAIN >>>>>>>>>> 02960CSR RLABL PROG 02970CSR ENDSR 02980C******************************************************************** 02990CSR SR101 BEGSR 03000C* 1-TIME INITIALIZE ÐÐ03010CSR MOVE BIT,1 NUL 03020CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 03030CSR MOVE ' ' BLK36 36 03040C* GET PORT # AND CRTFILE 03050CSR MOVE ' ' W2A 2 03060CSR EXITFZGMINX GET PORT # 03070CSR RLABL W2A 03080CSR MOVE W2A # 20 PORT NO. 03090CSR # COMP 0 54 03100CSRN54 Z-ADD25 # DEFAULT 03110CSR EXSR SR96 GET CRTFILE 03120CSR MOVE CALL LNK 03121CSR MOVE 'Q009VM 'PROG 03130CSR PAR,# COMP '1' 50 03140CSR TST,# COMP 'S' 54 03150CSR 54 MOVE 'SHUTDOWN'PROG 03160CSR EXSR SR97 UPD CRTFILE 03170CSR 54 EXSR SR98 >>>>>>>>>> 03171CSR MOVE ' 'PROG 03180C* DEFINE WORK FIELDS,ETC. 03190CSR MOVE ' ' BLK35 35 03200CSR Z-ADD0 ZERO9 90 03210CSR MOVE ' ' BLK20 20 03220CSR MOVE ' ' BLK8 8 03230CSR MOVE ' ' BLK15 15 ÐÐ03240CSR MOVE ' ' BLK25 25 03250CSR MOVE ' ' BLK35 35 03260CSR MOVE ' ' BLK6 6 03270CSR ENDSR 03280C********************************************************************** 03290CSR SR102 BEGSR 03300C* VALIDATE FIELD NO. 03310CSR F COMP 0 54 03320CSRN54 Z-ADD1 F 03330CSR F COMP FLIMIT 55 03340CSR 55 Z-ADD1 F 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR103 BEGSR 03380C* MOVE INPUT DATA 03390CSR EXSR SR201 IDENTIFY-F 03400CSR EXSR SR202 R. JUSTIFY 03410CSR 01 MOVELW36A TSORT 20 SORT CODE 03420CSR MOVE ' ' DUN,F EDIT FLAG 03430CSR ENDSR 03440C********************************************************************** 03450CSR SR201 BEGSR 03460C* IDENTIFY FIELD NO. 03470CSR F COMP 1 01 03480CSR ENDSR ÐÐ03490C********************************************************************** 03500CSR SR202 BEGSR 03510C* RIGHT JUSTIFY 03520CSR F LOKUPNUM 54 03530CSRN54 GOTO END202 NOT NUMERIC FIELD 03540CSR Z-ADD10 W2N 20 03550CSR MOVELW36A W10A 10 03560CSR EXIT SUBRAJ R. JUSTIFY 03570CSR RLABL W2N 03580CSR RLABL W10A 03590CSR END202 ENDSR 03600O******************************************************************** 03610OTERM132 E 71 03620O BIT,28 1 03630O N50 8 '8091001' 03640O N50 BIT,1 9 03650O N50 BIT,1 10 03660O 50 10 '[001 ]001' 03670O 50 BIT,28 6 03680O 85 'VENDOR PAY-TO MASTER ' 03690O 103 'DISPLAY - NAME SEQ' 03700O UDATE Y 18 03710O*------------------------------------------------------------------- 03720O E 71 03730O 1 ' ' ÐÐ03740O*------------------------------------------------------------------- 03750O E 71 03760O 16 'VENDOR NO. ' 03770O 31 ':' 03780O VMVENDZ 38 03790O*------------------------------------------------------------------- 03800O E 71 03810O 14 'SORT-KEY ' 03820O 31 ':' 03830O VMSORT 53 03840O*------------------------------------------------------------------- 03850O E 71 03860O 14 'VENDOR-ADDRESS' 03870O*------------------------------------------------------------------- 03880O E 71 03890O 15 ' NAME' 03900O 31 ':' 03910O VA,1 68 03920O*------------------------------------------------------------------- 03930O E 71 03940O 17 ' STREET' 03950O 31 ':' 03960O VA,2 68 03970O*------------------------------------------------------------------- 03980O E 71 ÐÐ03990O 17 ' STREET' 04000O 31 ':' 04010O VA,3 68 04020O*------------------------------------------------------------------- 04030O E 71 04040O 17 ' STREET' 04050O 31 ':' 04060O VA,4 68 04070O*------------------------------------------------------------------- 04080O E 71 04090O 15 ' CITY' 04100O 31 ':' 04110O VA,5 68 04120O*------------------------------------------------------------------- 04130O E 71 04140O 26 ' FOREIGN COUNTRY' 04150O 31 ':' 04160O VA,6 68 04170O*------------------------------------------------------------------- 04180O E 71 04190O 21 ' STATE-CODE' 04200O 31 ':' 04210O VMSTCD 35 04220O 29 TABSTN 62 04230O*------------------------------------------------------------------- ÐÐ04240O E 71 04250O 19 ' ZIP-CODE' 04260O 31 ':' 04270O VMZIP Z 42 04280O*------------------------------------------------------------------- 04290O E 71 04300O 20 ' TELEPHONE' 04310O 31 ':' 04320O VMPHON 48 04330O*------------------------------------------------------------------- 04340O E 71 04350O 8 'COMMENTS' 04360O*------------------------------------------------------------------- 04370O E 71 04380O 14 ' 1.' 04390O 31 ':' 04400O VC,1 53 04410O*------------------------------------------------------------------- 04420O E 71 04430O 14 ' 2.' 04440O 31 ':' 04450O VC,2 53 04460O*------------------------------------------------------------------- 04470O E 71 04480O 14 ' 3.' ÐÐ04490O 31 ':' 04500O VC,3 53 04510O*------------------------------------------------------------------- 04520O E 71 04530O 14 ' 4.' 04540O 31 ':' 04550O VC,4 53 04560O*------------------------------------------------------------------- 04570O E 71 04580O 17 'VENDOR-TYPE ' 04590O 31 ':' 04600O VMTYPE 38 04610O*------------------------------------------------------------------- 04620O E 71 04630O 18 'CREDIT-TERMS ' 04640O 31 ':' 04650O VMTERM 41 04660O*------------------------------------------------------------------- 04670O E 71 04680O 1 ' ' 04690O*------------------------------------------------------------------- 04700O E 71 04710O NUL 132 04720O 25 'ENTER SORT-KEY, RETURN, ' 04730O 36 'OR ESC CODE' ÐÐ04740O 39 ': ' 04750O*------------------------------------------------------------------- 04760O E 72 04770O NUL 132 04780O BIT,28 1 04790O N50 8 '8091001' 04800O N50 BIT,1 9 04810O N50 BIT,1 10 04820O 50 10 '[001 ]001' 04830O 50 BIT,28 6 04840O 24 'ENTER SORT KEY' 04850O 26 ' ' 04860O******************************************************************** 04870OCRTFILE E 97 04880O PROG 26 04890O CRTIME 33 04900O CRDATE 37 04910O LNK 79 04920O******************************************************************** ** NUL ARRAY 004930 004940** A36 ARRAY 004950 004960** NUM ARRAY 004970 004980ÐÐ** DUN ARRAY 004990 005000** MES ARRAY 005010---MESSAGE NOT ON FILE--- 005020** LNK ARRAY 005030 05040/* 05050_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(FTJ FX008DC P¨¨051683051683(èÈÐ00010H Q008DC00020F* OUTPT CUSTOMER BILL TO (5 RECS EA.) 00030F* REVISED 5-19-83 10:15 AM. 00040FCMBTAFILIP F 352 5AI 1 DISK 00050FDISK80 O F 80 DISK 00060E******************************************************************** 00070E CBA 7 35 00080I********************************************************************* 00090ICMBTAFILCB 01 352NCD 00100I* CUSTOMER BILL TO 00110I* CUSTOMER NO. 5N 00120I 1 50CBCUST 00130I* ADDRESS 35A X 7 00140I 6 250 CBA 00150I* STATE CODE 2A 00160I 251 252 CBSTCD 00170I* ZIP CODE 9P 00180I P 253 2570CBZIP 00190I* CONTACT 35A 00200I 258 292 CBCONT 00210I* TELEPHONE 9P 00220I 293 307 CBPHON 00230I* REMARKS 35A 00240I 308 342 CBREM 00250I* RECORD STATUS 1A ÐÐ00260I 352 352 CBSTAT 00270I GG 02 00280C********************************************************************** 00290C N01 GOTO END 00300C MOVE ' ' BLK35 35 00310C CBA,4 COMP BLK35 44 00320C CBA,6 COMP BLK35 45 00330C*--------------------------------------------------------------------- 00340C END TAG 00350O******************************************************************** 00360ODISK80 D 01 00370O 3 'CB1' 00380O CBCUST 8 00390O CBA,1 43 00400O CBSTCD 45 00410O CBZIP 54 00420O CBPHON 69 00430O*--------------------------------------------------------------------- 00440O D 01 00450O 3 'CB2' 00460O CBCUST 8 00470O CBCONT 43 00480O CBREM 78 00490O*---------------------------------------------------------------------- 00500O D 01 ÐÐ00510O 3 'CB3' 00520O CBCUST 8 00530O CBA,2 43 00540O CBA,3 78 00550O*------------------------------------------------------------------------ 00560O D 01N44 00570O 3 'CB4' 00580O CBCUST 8 00590O CBA,4 43 00600O CBA,5 78 00610O*---------------------------------------------------------------------- 00620O D 01N45 00630O 3 'CB5' 00640O CBCUST 8 00650O CBA,6 43 00660O CBA,7 78 00670O************************************************************************ /* 00680_‚ _‚_‚0O CBCUST 8 00470O CBCONT 43 00480O CBREM 78 00490O*---------------------------------------------------------------------- 00500O D 01 ÐÈ(^ô ^’X011CM PT120282120282(èÈÐ00010H Q011CM00020F* PRINT CUSTOMER MASTER FILE BY CUST CLASS. (X011CM) 00030F* REVISED 10/14/82 10:35 AM. 00040FCMMAST IP F 576R 5I DISK 00050FCMADRT IR F 300 3 3IT EDISK 00060FPRINT O F 132 OF PRINTER 00070E******************************************************************** 00080E CMADRT CMMAST 00090E TABSTC 1 58 2 TABSCN 20 STATE NAMES. 00100E TABCLC 1 17 2 TABCLN 20 CUST CLASS NAMES. 00110E TABTAX 1 5 1 TABTAN 20 TAX CODES. 00120E TABTER 1 5 3 TABTN 20 TERRITORY NAMES 00130E BIT 33 1 00140E CMA 7 35 00150E CMB 10 9 2 00160E CMS 10 9 2 00170E CMAR 4 9 2 00180E CMD 5 7 0 00190E CMM 3 3 00200E CMC 3 2 0 00210I********************************************************************* 00220ICMMAST CM 01 576NCD 00230I* CUSTOMER MASTER. 00240I* CUSTOMER NO. 5N 00250I 1 50CMCUST ÐÐ00260I* SORT (ALT) KEY 20A 00270I 6 25 CMSORT 00280I* ADDRESS 35A X 7 00290I 26 270 CMA 00300I* STATE CODE 2A 00310I 271 272 CMSTCD 00320I* ZIP CODE 9P 00330I P 273 2770CMZIP 00340I* PHONE NO. 15A 00350I 278 292 CMPHON 00360I* CONTACT NAME 35A 00370I 293 327 CMCONT 00380I* REMARKS 35A 00390I 328 362 CMREM 00400I* CUSTOMER CLASS 2A 00410I 363 364 CMCLAS 00420I* TERRITORY CODE 3A 00430I 365 367 CMTER 00440I* CREDIT LIMIT 7P 00450I P 368 3710CMCRLM 00460I* PAYMENT TERMS 8A 00470I 372 379 CMTERM 00480I* NUMBER OF INVOICE COPIES 1N 00490I 380 3800CMINV 00500I* SHIPPING METHOD 20A ÐÐ00510I 381 400 CMSHIP 00520I* CURRENT BACKLOG 9.2P X 10 00530I P 401 450 CMB 00540I* LAST 12-MOS SHIPMENTS 9.2P X 10 00550I P 451 500 CMS 00560I* CURRENT RECEIVABLES 9.2P X 4 00570I P 501 520 CMAR 00580I* TAX CODE 1A 00590I 521 521 CMTAX 00600I* STD DISCOUNT 3.2P 00610I P 522 5232CMDISC 00620I* EXPORT CODE 1A 00630I 524 524 CMEXPT 00640I* DATE HISTORY 7P X 5 00650I* 1 = DATE INPUT 00660I* 2 = DATE LAST ORDER 00670I* 3 = DATE LAST SHIPMENT 00680I* 4 = NOT USED 00690I* 5 = NOT USED 00700I P 525 544 CMD 00710I* GEOGRAPHIC CODE 5A 00720I 545 549 CMGEO 00730I* HOLD CODE 1A 00740I 550 550 CMHOLD 00750I* MAILING CODES. ÐÐ00760I* MAILER CODES 3 X 3A 00770I 551 559 CMM 00780I* NUMB OF COPIES 3 X 2N 00790I 560 565 CMC 00800I* POINTERS. 00810I* CREDIT CHANGES 5P 00820I P 575 5750CMFCC 00830I* RECORD STATUS 1A 00840I 576 576 CMSTAT 00850I GG 02 00860O******************************************************************** 00870OPRINT H 201 1P 00880O OR OF 00890O UDATE Y 8 00900O 65 'CUSTOMER MASTER LISTING' 00910O 79 'BY CUST CLASS' 00920O 127 'PAGE' 00930O PAGE Z 132 00940O*------------------------------------------------------------------- 00950O D 11 01 00960O 9 'CUST NO.:' 00970O CMCUSTZ 15 00980O 80 'SORT KEY :' 00990O CMSORT 101 01000O*------------------------------------------------------------------- ÐÐ01010O D 1 01 01020O 9 'CO. NAME:' 01030O CMA,1 45 01040O 80 'CLASS :' 01050O CMCLAS 83 01060O 101 'CR TERMS:' 01070O CMTERM 110 01080O*------------------------------------------------------------------- 01090O D 1 01 01100O 9 'CO. NAME:' 01110O CMA,2 45 01120O 80 'TAX CODE :' 01130O CMTAX 82 01140O 101 'CR LIMIT:' 01150O CMCRLM2 111 01160O*------------------------------------------------------------------- 01170O D 1 01 01180O 9 'ADDRESS :' 01190O CMA,3 45 01200O 80 'EXPORT :' 01210O CMEXPT 82 01220O 101 'SHIP VIA:' 01230O CMSHIP 122 01240O*------------------------------------------------------------------- 01250O D 1 01 ÐÐ01260O 9 'ADDRESS :' 01270O CMA,4 45 01280O 80 'GEO. CODE :' 01290O CMGEO 86 01300O 96 'TEL:' 01310O CMPHON 117 01320O*------------------------------------------------------------------- 01330O D 1 01 01340O 9 'ADDRESS :' 01350O CMA,5 45 01360O 50 'ST:' 01370O CMSTCD 53 01380O CMZIP Z 65 01390O 59 'ZIP:' 01400O 80 'CONTACT :' 01410O CMCONT 116 01420O*------------------------------------------------------------------- 01430O D 1 01 01440O 9 'CITY :' 01450O CMA,6 45 01460O 80 'CR HOLD :' 01470O CMHOLD 82 01480O 101 'NO. INV :' 01490O CMINV Z 104 01500O*------------------------------------------------------------------- ÐÐ01510O D 1 01 01520O 9 'COUNTRY :' 01530O CMA,7 45 01540O 80 'MAIL CODES:' 01550O CMM,1 84 01560O CMM,2 88 01570O CMM,3 92 01580O 101 '# COPIES:' 01590O CMC,1 Z 104 01600O CMC,2 Z 107 01610O CMC,3 Z 110 ** TABSTC/TABSCN - STATE CODES 001620 001630ALALABAMA 001640AKALASKA 001650AZARIZONA 001660ARARKANSAS 001670ASAMERICAN SAMOA 001680CACALIFORNIA 001690CZCANAL ZONE 001700COCOLORADO 001710CTCONNECTICUT 001720DEDELAWARE 001730DCDISTRICT OF COLUMBIA 001740FLFLORIDA 001750ÐÐGAGEORGIA 001760GUGUAM 001770HIHAWAII 001780IDIDAHO 001790ILILLINOIS 001800ININDIANA 001810IAIOWA 001820KSKANSAS 001830KYKENTUCKY 001840LALOUISIANA 001850MEMAINE 001860MDMARYLAND 001870MAMASSACHUSETTS 001880MIMICHIGAN 001890MNMINNESOTA 001900MSMISSISSIPPI 001910MOMISSOURI 001920MTMONTANA 001930NENEBRASKA 001940NVNEVADA 001950NHNEW HAMPSHIRE 001960NJNEW JERSEY 001970NMNEW MEXICO 001980NYNEW YORK 001990NCNORTH CAROLINA 002000ÐÐNDNORTH DAKOTA 002010OHOHIO 002020OKOKLAHOMA 002030OROREGON 002040PAPENNSYLVANIA 002050PRPUERTO RICO 002060RIRHODE ISLAND 002070SCSOUTH CAROLINA 002080SDSOUTH DAKOTA 002090TNTENNESSEE 002100TTTRUST TERRITORIES 002110TXTEXAS 002120UTUTAH 002130VTVERMONT 002140VAVIRGINIA 002150VIVIRGIN ISLANDS 002160WAWASHINGTON 002170WVWEST VIRGINIA 002180WIWISCONSIN 002190WYWYOMING 002200** TABCLC/TABCLN - CUST CLASS NAMES 00221010COMMERCIAL END USER 00222015U.S. GOVERNMENT 00223020GENERAL O.E.M. 00224021BROADCAST O.E.M. 02250ÐÐ30GENERAL LINE DEALER 00226031BROADCAST DEALER 00227033BROADCAST DLR,BRANCH 00228034GEN LINE DLR,BRANCH 00229035DESIGNATED PROD DLR 00230050SPECIAL 00231060AVIONICS END USER 00232065AVIONICS OEM 00233070AVIONICS DISTRIB 00234075AVIONICS REPAIR SHOP 00235090AVIONICS SPECIAL 00236098TO BE DELETED 00237099DISCONTINUED DLR 002380** TABTAX/TABTAN - TAX CODE RATES 0023901CA NON-TAXABLE,CARD 0024002CA NON-TAXABLE,NO CD 0024103NON-TAXABLE,US GOVT 0024204NON-TAXABLE,OTHER 0024305TAXABLE 002440** TABTER/TABTN - TERRITORY NAMES 002450 002460 002470 002480 002490 002500ÐÐ/* 002510_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(X‡ XúX006GL P120282120282(èÈÐ00010H Q006GL00020F* DISPLAY GEN LEDGER ACCT MASTER. (X006GL) D A T A G R A P H I X 00030F* REVISED 7-27-81 11:50 AM. DG-REL006 OK. 00040F* MENU: MQGL01, MQGL02 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FGLMAST ID F 165L 9AI 1 DISK 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A8 8 8 1 A INPUT DATA ARRAY 00120E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00130E DUN 1 3 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E AGL 1 12 9 0 00160E BIT 33 1 SCREEN CONTR. CHAR 00170E GLA 12 11 2 ACTUAL $ 00180I******************************************************************* 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************* 00220IMGFILE MG 00230I* MESSAGE FILE. 00240I 1 35 MGTEXT 00250I****************************************************************** ÐÐ00260IGLMAST GL 00270I* ACCOUNT MASTER. 00280I* KEY AREA 9A 00290I 1 9 GLKEY 00300I* ACCOUNT PREFIX 1A 00310I 1 1 GLPRFX 00320I* ACCOUNT PRIME 5N 00330I 2 60GLPRIM 00340I* ACCOUNT DASH 3N 00350I 7 90GLDASH 30 00360I* ACCOUNT GROUP 4A 00370I 14 17 GLGRUP 00380I* ACCOUNT DESCRIPTION 40A 00390I 18 57 GLDESC 00400I* BALANCE FORWARD AMOUNT 11.2P 00410I P 58 632GLBALF 00420I* ACTUAL $ 11.2P X 12 00430I P 64 135 GLA 00440I* CURRENT MONTH-PLUSES 11.2P 00450I P 136 1412GLCMP 00460I* CURRENT MONTH-MINUS 11.2P 00470I P 142 1472GLCMM 00480I* SOURCE CODE 1A 00490I* S = SUB-ACCOUNT ONLY, 00500I* MAY NOT BE PARENT ÐÐ00510I 148 148 GLSC 00520I* BALANCE FORWARD CODE 2A 00530I* 1ST COL 00540I* 1 = ZERO BAL AT START NEW YR 00550I* 2 = CARRY PREV YR FRWD 00560I* 2ND COL 00570I* A = ZERO BAL AT START NEW MO 00580I* B = CARRY PREV MO FRWD 00590I 149 149 GLYBFC 00600I 150 150 GLMBFC 00610I* NUMB OF SUB-ACCOUNTS 5P 00620I P 157 1590GLNOSA 00630I* LOW LEVEL CODE 3N 00640I 160 1620GLLL 00650I* FILLER 00660I* RECORD STATUS 1A 00670I 165 165 GLSTAT 00680C******************************************************************** 00690C* INITIALIZE 00700C EXSR SR101 1-TIME INIT 00710C*------------------------------------------------------------------ 00720C START TAG 00730C* SET-UP 1ST FIELD NO. 00740C SETOF 96 00750C Z-ADD1 F 30 FIELD # ÐÐ00760C GOTO READ 00770C*------------------------------------------------------------------ 00780C NEXT TAG 00790C* SET-UP NEXT FIELD NO. 00800C 1 ADD F F FIELD # 00810C*----------------------------------------------------------------- 00820C READ TAG 00830C* READ DATA FROM TERMINAL. 00840C EXSR SR102 VALIDATE FIELD # 00850C 55 GOTO UPDATE DONE 00860C EXSR SR201 IDENTIFY-F 00870C 01 GOTO NEXT 00880C 01 Z-ADD362 M 50 ENTER PREFIX 00890C 02 Z-ADD363 M ENTER PRIME 00900C 03 Z-ADD364 M ENTER DASH 00910C EXSR SR89 GET MSG FILE 00920C SETON 69 00930C EXSR SR73 PROMPT 00940C SETOF 69 00950C EXSR SR75 READ TERMINAL 00960C 98 GOTO GOODBY GOODBY 00970C 94 GOTO MENU MENU REQUEST 00980C 93 GOTO NEWITM NEW ITEM 00990C 96 GOTO ERROR ERROR 01000C*------------------------------------------------------------------ ÐÐ01010C PROCES TAG 01020C* PROCESS INPUT DATA 01030C EXSR SR103 MOVE DATA 01040C N96 EXSR SR104 EDIT DATA 01050C 96 GOTO ERROR ERROR 01060C GOTO NEXT 01070C*------------------------------------------------------------------ 01080C UPDATE TAG 01090C* UPDATE DATA BASE. 01100C EXSR SR105 FINAL EDIT 01110C 96 GOTO ERROR ERROR 01120C EXSR SR106 UPDATE 01130C 96 GOTO ERROR ERROR 01140C 94 GOTO MENU RET TO MENU. 01150C 98 GOTO GOODBY SIGN-OFF. 01160C GOTO START 01170C*------------------------------------------------------------------- 01180C JUMP TAG 01190C* SET-UP JUMP TO REQUESTED FIELD 01200C 1 ADD W W 30 01210C W COMP 10 54 01220C 54 Z-ADD318 M 50 96 FLAG ERROR 01230C 54 GOTO ERROR BAD ESC 01240C MOVE ' ' W3A 3 01250C MOVEAA8,W W3A ÐÐ01260C Z-ADD3 W2N 20 01270C EXIT SUBRAJ R. JUSTIFY 01280C RLABL W2N 01290C RLABL W3A 01300C MOVE W3A F NEW FIELD # 01310C GOTO READ 01320C*-------------------------------------------------------------------- 01330C ERROR TAG 01340C EXSR SR102 VALIDATE FIELD # 01350C EXSR SR89 GET MSG 01360C EXSR SR73 PUT MSG 01370C GOTO START 01380C*------------------------------------------------------------------ 01390C NEWITM TAG 01400C* SET-UP LINK FOR NEW ITEM 01410C GOTO START 01420C*------------------------------------------------------------------- 01430C MENU TAG 01440C* SET-UP LINK TO MENU 01450C MOVEL'QQGL02' PROG 8 01460C GOTO END 01470C*-------------------------------------------------------------------- 01480C GOODBY TAG 01490C* LINK TO SIGN-OFF 01500C MOVEL'GOODBY' PROG ÐÐ01510C GOTO END 01520C*------------------------------------------------------------------- 01530C END TAG 01540C PROG COMP BLK8 54 01550C N54 MOVEL'QQGL02' PROG 8 01560C EXITFCHAIN LINK TO NEXT PROG 01570C RLABL PROG 01580C******************************************************************** 01590CSR SR70 BEGSR 01600C* CLEAR CRT. 01610CSR EXITFQTOPF CLEAR CRT 01620CSR ENDSR 01630C******************************************************************** 01640CSR SR71 BEGSR 01650C* PUT HEADING. 01660CSR SETON 71 01670CSR EXCPT PUT HEADING 01680CSR SETOF 71 01690CSR Z-ADD6 COUNT 30 01700CSR ENDSR 01710C********************************************************************* 01720CSR SR72 BEGSR 01730C* PUT DATA TO TERMINAL 01740CSR MOVE GLA AGL 01750CSR SETON 72 ÐÐ01760CSR EXCPT PUT DATA 01770CSR SETOF 72 01780CSR ENDSR 01790C*********************************************************************** 01800CSR SR73 BEGSR 01810C* PUT ERROR MESSAGE TO TERMINAL 01820CSR SETON 73 01830CSR EXCPT PUT MSG 01840CSR SETOF 73 01850CSR Z-ADDM LSTERR 50 01860CSR ENDSR 01870C******************************************************************* 01880CSR SR75 BEGSR 01890C* READ FROM TERMINAL 01900CSR SETOF 779096 01910CSR SETOF 939291 01920CSR SETOF 8988 01930CSR MOVE BIT,5 BUFLGT BUF LENGTH 01940CSR MOVE BLK8 W8A 8 BUFFER 01950CSR EXITFQWREED READ TERM 01960CSR RLABL W8A 01970CSR RLABL BUFLGT 01980CSR MOVEAW8A A8 01990CSR MOVE BLK8 W8A 02000CSR Z-ADD1 W 30 ÐÐ02010CSR '\' LOKUPA8,W 90 FLAG ESC 02020CSRN90 GOTO T75B NOT ESC 02030CSR 1 ADD W W 02040CSR W COMP 10 54 02050CSR 54 GOTO T75A BAD ESC 02060CSR A8,W COMP 'G' 98 GOODBY 02070CSR A8,W COMP 'E' 94 MENU 02080CSR A8,W COMP 'N' 93 NEW ITEM 02090CSR 98 02100COR 94 02110COR 93 GOTO END75 02120C*------------------------------------------------------------------ 02130CSR T75A TAG 02140C* FLAG BAD ESC INPUT 02150CSR Z-ADD318 M 96 FLAG ERROR 02160CSR GOTO END75 02170C*-------------------------------------------------------------------- 02180CSR T75B TAG 02190C* MOVE DATA 02200CSR Z-ADD1 W 02210CSR ' ' LOKUPA8,W 77 02220CSR 77 MOVEAA8,W W8A INPUT DATA 02230CSR END75 ENDSR 02240C********************************************************************** 02250CSR SR89 BEGSR ÐÐ02260C* GET MESSAGE MASTER 02270CSR M CHAINMGFILE 54 02280CSR 54 MOVE BLK35 MGTEXT 02290CSR 54 MOVELM MGTEXT 02300CSR 54 MOVE MES,1 MGTEXT 02310CSR ENDSR 02320C*********************************************************************** 02330CSR SR101 BEGSR 02340C* 1-TIME INITIALIZE 02350CSR MOVE BIT,1 NUL 02360CSR MOVEANUL NUL83 83 02370CSR EXSR SR70 CLEAR CRT. 02380CSR MOVELBIT,1 BUFLGT 2 02390CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 02400C* DEFINE WORK FIELDS,ETC. 02410CSR MOVE ' ' BLK35 35 02420CSR MOVE ' ' BLK8 8 02430C* 02440C* 02450CSR ENDSR 02460C********************************************************************** 02470CSR SR102 BEGSR 02480C* VALIDATE FIELD NO. 02490CSR F COMP 0 54 02500CSRN54 Z-ADD1 F ÐÐ02510CSR F COMP FLIMIT 55 02520CSR 55 Z-ADD1 F 02530CSR ENDSR 02540C******************************************************************** 02550CSR SR103 BEGSR 02560C* MOVE INPUT DATA 02570CSR EXSR SR201 IDENTIFY-F 02580CSR EXSR SR202 R. JUSTIFY 02590CSR 01 MOVELW8A TPRFX 1 PREFIX# 02600CSR 02 MOVE W8A TPRIM 50 PRIME 02610CSR 03 MOVE W8A TDASH 30 DASH 02620CSR 03 MOVELTPRFX TKEY 9 02630CSR 03 MOVELTPRIM W8A 8 02640CSR 03 MOVE TDASH W8A 02650CSR 03 MOVE W8A TKEY 02660CSR MOVE ' ' DUN,F EDIT FLAG 02670CSR ENDSR 02680C******************************************************************** 02690CSR SR104 BEGSR 02700C* EDIT INPUT DATA 02710CSR 96 MOVE ' ' DUN,F EDIT FLAG 02720CSRN96 MOVE 'X' DUN,F 02730CSR ENDSR 02740C*********************************************************************** 02750CSR SR105 BEGSR ÐÐ02760C* FINAL EDIT 02770CSR SETON 79 FINAL EDIT FLAG 02780CSR Z-ADD1 F 96 02790C*-------------------------------------------------------------------- 02800CSR T105A TAG 02810CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 02820CSRN54 GOTO END105 02830CSR EXSR SR201 IDENTIFY-F 02840CSR EXSR SR104 EDIT 02850CSRN96 GOTO T105A 02860C*-------------------------------------------------------------------- 02870CSR END105 TAG 02880CSR SETOF 79 02890CSR ENDSR 02900C******************************************************************** 02910CSR SR106 BEGSR 02920C* DISPLAY GLMAST RECORD. 02930CSR MOVE BLK35 LASTGL 9 02940CSR TKEY SETLLGLMAST 02950CSR EXSR SR71 PUT HEADING. 02960CSR SETOF 74 02970C*------------------------------------------------------------------- 02980CSR T106A TAG 02990CSR SETOF 54 03000CSR READ GLMAST 54 ÐÐ03010CSR 54 GOTO T106B END OF FILE. 03020CSR GLSTAT COMP 'D' 54 03030CSR 54 GOTO T106A DELETED 03040CSR GLKEY COMP LASTGL 54 03050CSRN54 GOTO T106B STUPIDITY 03060CSR MOVE GLKEY LASTGL 03070CSR EXSR SR72 DISPLAY GLMAST 03080CSR SETON 74 03090CSR 1 ADD COUNT COUNT 03100CSR U1 1 ADD COUNT COUNT 03110CSR COUNT COMP 30 54 03120CSRN54 GOTO T106A 03130CSR Z-ADD34 M 03140CSR GOTO T106C 03150C*------------------------------------------------------------------- 03160CSR T106B TAG 03170C* DISPLAY END PAGE/FILE MSG. 03180CSR Z-ADD317 M 03190C*----------------------------------------------------------------- 03200CSR T106C TAG 03210CSR EXSR SR89 GET END MSG. 03220CSR EXSR SR73 END PAGE MSG. 03230CSR EXSR SR75 03240CSR 94 EXIT. 03250COR 98 GOODBY. ÐÐ03260COR 93 GOTO END106 NEW ITEM. 03270CSR M COMP 317 54 03280CSRN54 EXSR SR71 PUT HEADING. 03290CSRN54 GOTO T106A 03300CSR END106 ENDSR 03310C************************************************************************ 03320CSR SR201 BEGSR 03330C* IDENTIFY FIELD NO. 03340CSR F COMP 1 01 03350CSR F COMP 2 02 03360CSR F COMP 3 03 03370CSR ENDSR 03380C********************************************************************** 03390CSR SR202 BEGSR 03400C* RIGHT JUSTIFY 03410CSR F LOKUPNUM 54 03420CSRN54 GOTO END202 NOT NUMERIC FIELD 03430CSR Z-ADD8 W2N 20 03440CSR EXIT SUBRAJ R. JUSTIFY 03450CSR RLABL W2N 03460CSR RLABL W8A 03470CSR END202 ENDSR 03480O******************************************************************** 03490OTERM132 E 71 03500O* PUT HEADING. ÐÐ03510O 65 'ACCOUNT MASTER LIST' 03520O*-------------------------------------------------------------------- 03530O E 71 03540O 85 'YEARLY' 03550O 95 'MONTHLY' 03560O*-------------------------------------------------------------------- 03570O E 71 03580O 21 'ACCOUNT NO.' 03590O 86 'BAL-FWD' 03600O 95 'BAL-FWD' 03610O 122 '<----CUR MO.---->' 03620O 130 'NUMB' 03630O*------------------------------------------------------------------- 03640O E 71 03650O* * * * 12 'PREFIX' 03660O 18 'PRIME' 03670O 24 'DASH' 03680O 41 '<--------------' 03690O 52 'DESCRIPTION' 03700O 65 '------------>' 03710O 73 'GROUP' 03720O 79 'TYPE' 03730O 85 'CODE' 03740O 94 'CODE' 03750O 109 'PLUS' ÐÐ03760O 122 'MINUS' 03770O 132 'SUB-ACTS' 03780O*------------------------------------------------------------------- 03790O E 72 03800O* PUT DATA. 03810O GLPRFX 10 03820O GLPRIMZ 19 03830O 30 20 '-' 03840O GLDASHZ 23 03850O GLDESC 65 03860O GLGRUP 71 03870O GLSC 78 03880O GLYBFC 85 03890O GLMBFC 94 03900O GLCMP K 110 03910O GLCMM K 124 03920O GLNOSAZ 132 03930O*------------------------------------------------------------------- 03940O E 72 U1 03950O AGL 132 03960O*------------------------------------------------------------------- 03970O E 73 03980O NUL83 132 03990O 96 9 'E R R O R' 04000O N96 9 ' ' ÐÐ04010O MGTEXT 47 04020O BIT,8 132 ** NUL ARRAY 004030 004040** A8 ARRAY 004050 004060** NUM ARRAY 004070002 PRIME 004080003 DASH 004090** DUN ARRAY 004100 004110** MES ARRAY 004120---MESSAGE NOT ON FILE--- 004130** AGL ARRAY 04140 004150/* 004160_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(‚ §X006JQ P120282120282(èÈÐ00010H Q006JQ00020F* DISPLAY SYSTEM PRINTER JOB QUEUE ON CONSOLE.(X006JQ) 00030F* AND REQUEST SELECTION. 00040F* REVISED 2/15/80 3:00 PM. 00050FBITHEX IP F 256 DISK 00060FJQDEVICEUD F 8L 6AI 1 DISK 00070FJQMAST UC F 96R 4AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090FMGFILE IC F 80R DISK 00100FBJMAST IC F 106R 6AI 1 DISK 00110FMENUDEPTIT F 25 EDISK 00120FDIABLO38O F 38 5 00130FDIABLO O F 132 5 00140E******************************************************************** 00150E NUL 1 132 1 00160E A6 6 6 1 00170E A8 8 8 1 A 00180E JOB 1 100 4 0 PRG 6 00190E MENUDEPT TABDEP 1 10 5 0 TABDN 20 00200E BIT 256 1 00210E CALL 5 6 00220I******************************************************************** 00230IBITHEX BT 00240I 1 256 BIT 00250I*************************************************************** ÐÐ00260ICRTFILE CR 00270I 14 180CRDEPT 00280I******************************************************************** 00290IMGFILE MG 00300I 1 35 MGTEXT 00310I******************************************************************** 00320IBJMAST BJ 00330I 7 46 BJDESC 00340I 106 106 BJSTAT 00350I******************************************************************** 00360IJQDEVICEJD 00370I* JOB QUEUE DEVICE ALT-KEY. 00380I* KEY AREA. 00390I* DEVICE CODE 2N 00400I 1 2 JDDEV 00410I* JOB # 4N 00420I 3 60JDJOB 00430I* RECORD STATUS 1A 00440I 8 8 JDSTAT 00450I******************************************************************** 00460IJQMAST JQ 00470I* JOB QUEUE MASTER. 00480I* JOB NUMB 4N 00490I 1 40JQNUMB 00500I* DEVICE 2A ÐÐ00510I* COL-2,DEVICE CODE 00520I* Y = SHARED 00530I* N = NON-SHARABLE 00540I* COL-1,DEVICE CODE 00550I* S = SYST PRINTER 00560I* D = DIABLO PRINTER 00570I* T = TERMINAL 00580I* C = CONSOLE 00590I 5 6 JQDEV 00600I* DEPT # 5N 00610I 7 110JQDEPT 00620I* JOB NAME 6A 00630I 12 17 JQJOB 00640I* PRINTER 1A 00650I 18 18 JQPRTR 00660I* PAPER 25A 00670I 19 43 JQPAP 00680I* COPIES REQUESTED 1N 00690I 44 440JQCOPY 00700I* REQUESTED BY 12A 00710I 45 56 JQRBY 00720I* REQUEST DATE 6N 00730I 57 620JQRDAT 00740I* REQUEST TIME 6N 00750I 63 680JQRTIM ÐÐ00760I* NEED BY DATE 6N 00770I 69 740JQNDAT 00780I* NEED BY TIME 6N 00790I 75 800JQNTIM 00800I* DATE COMPLETED 6N 00810I 81 860JQCDAT 00820I* TIME COMPLETED 6N 00830I 87 920JQCTIM 00840I* RECORD STATUS 1A 00850I 96 96 JQSTAT 00860C******************************************************************** 00870C* INITIALIZE. 00880C EXSR SR101 INIT. 00890C H9 GOTO ENDJOB 00900C*------------------------------------------------------------------- 00910C START TAG 00920C MOVEL'D' DEVKEY 6 00930C DEVKEY SETLLJQDEVICE 00940C SETOF 75 00950C*------------------------------------------------------------------- 00960C TAG100 TAG 00970C SETOF 54 00980C READ JQDEVICE 54 00990C 54 GOTO SELECT 01000C MOVELJDDEV W1A 1 ÐÐ01010C W1A COMP 'D' 54 01020C N54 GOTO SELECT WRONG DEVICE. 01030C JDSTAT COMP 'D' 54 01040C 54 GOTO TAG100 DELETED. 01050C JDJOB CHAINJQMAST 55 01060C N55 JQSTAT COMP 'D' 55 01070C 55 SETON 83 01080C 55 EXCPT DELETE JQDEVICE 01090C 55 SETOF 83 01100C 55 GOTO TAG100 01110C CRDEPT COMP JQDEPT 54 01120C N54 GOTO TAG100 01130C JQJOB CHAINBJMAST 55 01140C N55 BJSTAT COMP 'D' 55 01150C 55 SETON 84 01160C 55 EXCPT DEL JQMAST/DEVICE 01170C 55 SETOF 84 01180C 55 GOTO TAG100 01190C JQDEPT LOKUPTABDEP TABDN 54 01200C 54 MOVE TABDN DEPNAM 20 01210C N54 MOVE BLK20 DEPNAM 01220C 1 ADD J J 40 01230C MOVE JQNUMB JOB,J 01240C MOVE JQJOB PRG,J 01250C N75 EXSR SR70 PUT HEADING ÐÐ01260C EXSR SR72 DISPLAY QUE MENU 01270C GOTO TAG100 01280C*------------------------------------------------------------------- 01290C SELECT TAG 01300C EXITFQCLFCR LF/CR 01310C* PUT NO JOBS MESSAGE 01320C N75 SETON 76 01330C N75 EXCPT NO JOBS MSG 01340C N75 SETOF 76 01350C N75 EXITFQCLFCR LF/CR 01360C N75 GOTO GOODBY 01370C* GET SELECTION NUMBER. 01380C SETOF 96 01390C Z-ADD249 M 50 ENTER JOB NUMBER 01400C SETON 69 01410C EXSR SR73 PROMPT. 01420C SETOF 69 01430C EXSR SR75 READ. 01440C 98 GOTO GOODBY 01450C 94 01460COR 93 GOTO MENU 01470C Z-ADD8 W2N 20 01480C EXIT SUBRAJ R. JUSTIFY. 01490C RLABL W2N 01500C RLABL W8A 8 ÐÐ01510C MOVE W8A SELNO 40 01520C SELNO COMP 0 55 01530C N55 Z-ADD309 M 96 01540C N55 EXSR SR73 FLAG ERROR. 01550C N55 GOTO SELECT 01560C Z-ADD1 X 40 01570C SELNO LOKUPJOB,X 55 GET JOB# 01580C N55 Z-ADD309 M 96 FLAG ERROR 01590C N55 GOTO SELECT 01600C JOB,X CHAINJQMAST 55 01610C 55 Z-ADD309 M 96 FLAG ERROR. 01620C 55 GOTO SELECT 01630C MOVE JQNUMB DEVKEY 01640C DEVKEY SETLLJQDEVICE 01650C READ JQDEVICE H7 01660C H7 GOTO ENDJOB 01670C SETON 84 DELETE JQDEVICE 01680C EXCPT DELETE JQMAST. 01690C SETOF 84 01700C MOVELPRG,X PROG 8 01710C EXITFQPAUSE 01720C GOTO END 01730C*------------------------------------------------------------------- 01740C MENU TAG 01750C MOVEL'HELLO' PROG 8 ÐÐ01760C GOTO END 01770C*------------------------------------------------------------------- 01780C GOODBY TAG 01790C MOVEL'GOODBY' PROG 01800C*------------------------------------------------------------------- 01810C END TAG 01820C EXITFCHAIN 01830C RLABL PROG 01840C*------------------------------------------------------------------- 01850C ENDJOB TAG 01860C******************************************************************** 01870CSR SR70 BEGSR 01880C* PUT HEADINGS TO TERM. 01890CSR EXITFQCLFCR LF/CR 01900CSR SETON 42 01910CSR EXSR SR71 HEADING-2. 01920CSR SETON 44 01930CSR EXSR SR71 HEADING-4. 01940CSR EXITFQCLFCR LF/CR 01950CSR ENDSR 01960C****************************************************************** 01970CSR SR71 BEGSR 01980C* PUT HEADINGS 01990CSR SETON 71 02000CSR EXCPT PUT HEADINGS ÐÐ02010CSR SETOF 414243 02020CSR SETOF 4445 02030CSR SETOF 71 02040CSR ENDSR 02050C******************************************************************** 02060CSR SR72 BEGSR 02070C* PUT DATA TO TERM. 02080CSR SETON 7275 02090CSR EXCPT PUT DATA. 02100CSR SETOF 72 02110CSR SETON 74 02120CSR EXCPT 2ND DATA LINE. 02130CSR SETOF 74 02140CSR ENDSR 02150C******************************************************************** 02160CSR SR73 BEGSR 02170C* PUT MESSAGE. 02180CSR M CHAINMGFILE 54 02190CSRN54 SETON 73 02200CSR EXCPT PUT MSG. 02210CSR SETOF 73 02220CSR ENDSR 02230C******************************************************************* 02240CSR SR75 BEGSR 02250C* READ FROM TERMINAL ÐÐ02260CSR SETOF 779096 02270CSR SETOF 939291 02280CSR SETOF 898887 02290CSR SETOF 8685 02300CSR MOVE BIT,5 A6,2 BUF LENGTH 02310CSR MOVEAA6 W6A 6 02320CSR MOVE BLK8 W8A 8 BUFFER 02330CSR EXITFQWREED READ TERM 02340CSR RLABL W8A 02350CSR RLABL W6A 02360CSR MOVEAW8A A8 02370CSR MOVE BLK8 W8A 02380CSR Z-ADD1 W 30 02390CSR '\' LOKUPA8,W 90 FLAG ESC 02400CSRN90 GOTO T75B NOT ESC 02410CSR 1 ADD W W 02420CSR W COMP 8 54 02430CSR 54 GOTO T75A BAD ESC 02440CSR A8,W COMP 'G' 98 GOODBY 02450CSR A8,W COMP 'E' 94 MENU 02460CSR A8,W COMP 'N' 93 NEW ITEM 02470CSR A8,W COMP 'J' 92 JUMP 02480CSR A8,W COMP 'F' 91 SKIP FRWRD 02490CSR A8,W COMP 'B' 89 SKIP BKWRD 02500CSR A8,W COMP 'S' 88 SPACE FILL ÐÐ02510CSR A8,W COMP 'H' 87 HOME 02520CSR A8,W COMP 'U' 86 UPDATE 02530CSR A8,W COMP 'R' 85 REPEAT 02540CSR 98 02550COR 94 02560COR 93 02570COR 92 02580COR 91 02590COR 89 02600COR 88 02610COR 87 02620COR 86 02630COR 85 GOTO END75 GOOD ESC 02640C*------------------------------------------------------------------ 02650CSR T75A TAG 02660C* FLAG BAD ESC INPUT 02670CSR Z-ADD318 M 50 96 FLAG ERROR 02680CSR GOTO END75 02690C*-------------------------------------------------------------------- 02700CSR T75B TAG 02710C* MOVE DATA 02720CSR Z-ADD1 W 02730CSR ' ' LOKUPA8,W 77 02740CSR 77 MOVEAA8,W W8A INPUT DATA 02750C*-------------------------------------------------------------------- ÐÐ02760CSR END75 ENDSR 02770C*********************************************************************** 02780CSR SR101 BEGSR 02790C* 1-TIME INITIALIZE 02800CSR MOVE BIT,1 NUL 02810CSR MOVEANUL NUL50 50 02820CSR MOVEANUL NUL25 25 02830CSR MOVE BIT,1 A6 02840CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02850CSR MOVE ' ' BLK8 8 02860C* GET PORT # 02870CSR MOVE ' ' W8A 8 02880CSR MOVE ' ' W1A 1 02890CSR MOVE ' ' W2A 2 02900CSR Z-ADD0 W1N 10 02910CSR Z-ADD0 W2N 20 02920CSR EXITFPGMINX 02930CSR RLABL W8A 02940CSR RLABL W2N 02950CSR RLABL W1N 02960CSR RLABL W2A 02970CSR MOVE W2A PORT 20 02980CSR PORT COMP 0 54 02990CSRN54 Z-ADD25 PORT 03000CSR PORT CHAINCRTFILE H9 ÐÐ03010CSR H9 GOTO END101 03020C* DEFINE WORK FIELDS,ETC. 03030CSR MOVE ' ' BLK35 35 03040CSR MOVE ' ' BLK40 40 03050CSR MOVE ' ' BLK20 20 03060CSR END101 ENDSR 03070O******************************************************************** 03080OJQMAST E 84 03090O 96 'D' 03100O******************************************************************** 03110OJQDEVICEE 84 03120O OR 83 03130O 8 'D' 03140O******************************************************************** 03150ODIABLO E 71 44 03160O 4 'JOB#' 03170O 22 'JOB NAME' 03180O 62 'REQUEST-BY' 03190O 73 'NEED-BY' 03200O 77 'DEV' 03210O 93 'FORMS-REQ''D' 03220O 110 'COPY' 03230O 122 'DEPARTMENT' 03240O*------------------------------------------------------------------- 03250O E 72 ÐÐ03260O* PUT MENU. 03270O JQNUMBZ 4 03280O U1 JQJOB 12 03290O BJDESC 54 03300O JQRBY 64 03310O JQNDATY 74 03320O JQDEV 77 03330O JQPAP 104 03340O JQCOPYZ 109 03350O DEPNAM 132 03360O**************************************************************** 03370ODIABLO38E 71 42 03380O* PUT TITLE 03390O NUL25 25 03400O NUL25 38 03410O BIT,28 1 03420O BIT,10 2 03430O BIT,71 3 03440O 38 'JOB QUEUE' 03450O*--------------------------------------------------------------------- 03460O E 74 03470O* PUT REQUESTED COMPL TIME 03480O NUL25 25 03490O NUL25 38 03500O BIT,28 1 ÐÐ03510O BIT,10 2 03520O BIT,68 3 03530O JQNTIM 38 ' : : ' 03540O*------------------------------------------------------------------ 03550O E 73 03560O* PUT MSG. 03570O MGTEXT 35 03580O 69 BIT,8 38 03590O*------------------------------------------------------------------ 03600O E 76 03610O* NO JOBS ON FILE MSG 03620O 20 'ALL JOBS COMPLETED' ** NUL ARRAY 003630 003640** A6 ARRAY 003650 003660** A8 ARRAY 003670 003680** JOB/PRG ARRAY 003690 003700/* 003710_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( *  NX006KP P120282120282(èÈÐ00010H Q006KP00020F* DISPLAY KP DATA FILE.. (X006KP) 00030F* REVISED 8-27-80 2:40 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FKPDATA ID F 192L14AI 1 DISK 00070FKPMAST ID F 64L10AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090FKPCONT ID F 48L10AI 1 DISK 00100FKPNAME IC F 352R 6AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A6 6 6 1 A INPUT DATA ARRAY 00150E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 3 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E NAM 1 30 12 A FIELD NAME 00190E COL 1 30 3 0A START COLUMN 00200E SIZ 1 30 3 0 FIELD LGTH 00210E KPD 1 30 1 0 DEC PLACES 00220E KPE 1 30 1 EDIT CODE 00230E TYP 1 30 1 FIELD TYPE(A,N) 00240E JOB 1 75 6 A 00250E BAT 1 75 3 0 ÐÐ00260E A15 15 15 1 A 00270E KCB 5 11 3 00280E KPL 3 6 00290E KPO 3 1 00300E CALL 5 6 00310E BIT 256 1 SCREEN CONTR. CHAR 00320E ERR 5 5 0A 00330E* 00340I******************************************************************* 00350IBITHEX BT 00360I 1 256 BIT 00370I******************************************************************** 00380ICRTFILE CR 00390I 1 50CREMPL 00400I 6 13 CRUSER 00410I 14 180CRDEPT 00420I 19 26 CRJOB 00430I 27 27 CRSHUT 00440I 28 330CRTIMI 00450I 34 370CRDATE 00460I 38 67 CALL 00470I 68 73 CRRET 00480I 74 79 CRMENU 00490I******************************************************************** 00500IKPCONT KC ÐÐ00510I* JOB # 6A 00520I 1 6 KCJOB 00530I* BATCH # 3N 00540I 8 100KCBAT 00550I* BATCH TOTALS 11.3P X 5 00560I P 11 40 KCB 00570I* RECORD COUNT 5P 00580I P 41 430KCREC 00590I* DEPT 5P 00600I P 45 470KCDEPT 00610I* RECORD STATUS 1A 00620I 48 48 KCSTAT 00630I******************************************************************** 00640IMGFILE MG 00650I* MESSAGE FILE. 00660I 1 35 MGTEXT 00670I****************************************************************** 00680IKPDATA KE 00690I* KEYPUNCH DATA RECORD. 00700I* KEY AREA. 00710I* JOB # 6A 00720I 1 6 KEJOB 00730I* BATCH # 3N 00740I 7 90KEBAT 00750I* LAST SERIAL NO. 5N ÐÐ00760I 10 140KELUSN 00770I* EMPLOYEE # 5N 00780I 15 190KEEMPL 00790I* PORT # 2N 00800I 20 210KEPORT 00810I* DATA LINE 132 X 1A 00820I 22 153 RECORD 00830I* ERROR ARRAY 5 X 5P 00840I P 154 168 ERR 00850I* FILLER 00860I* RECORD STATUS 1A 00870I 192 192 KESTAT 00880I******************************************************************** 00890IKPMAST KP 00900I* KEYPUNCH MASTER. 00910I* KEY AREA. 00920I* JOB # 6A 00930I 1 6 KPJOB 00940I* FORMAT CODE 1A 00950I 7 7 KPFRMT 00960I* SEQ NO. 3N 00970I 8 100KPSEQ 00980I* FIELD TYPE 1A 00990I* A = ALPHA N = NUMERIC 01000I 11 11 KPTYPE ÐÐ01010I* START COLUMN 3P 01020I P 12 130KPCOL 01030I* FIELD SIZE 3P 01040I P 14 150KPSIZE 01050I* SPEC INSTR 1A 01060I* D = DUP S = SKIP 01070I 16 16 KPSPEC 01080I* EDIT CODE 1A 01090I* (Z,2,K,Y) 01100I 17 17 KPEDIT 01110I* DECIMAL PLACES 1N 01120I 18 180KPDEC 01130I* SUB-TOTAL FIELD # 1N 01140I 19 190KPTOT 01150I* FIELD NAME 12A 01160I 20 31 KPNAME 01170I* OPTION CODE 1A 01180I* M = MANDATORY 01190I 32 32 KPOPTN 01200I* TABLE AREA. 01210I* TABLE NAMES 6A X 3 01220I 33 50 KPL 01230I* OPERATORS 1A X 3 (>,<,=) 01240I 51 53 KPO 01250I* RECORD STATUS 1A ÐÐ01260I 64 64 KPSTAT 01270I******************************************************************** 01280IKPNAME KN 01290I* KEYPUNCH JOB MASTER. 01300I* JOB # 6A 01310I 1 6 KNJOB 01320I* TITLE 60A 01330I 7 66 KNTITL 01340I* HEADING-LINE 1 132A 01350I 67 198 KNHL1 01360I* HEADING-LINE 2 132A 01370I 199 330 KNHL2 01380I* LAST BATCH NO. 5P 01390I P 331 3330KNLBAT 01400I* FORMAT CODE 1A (H,V) 01410I 334 334 KNFRMT 01420I* LINK-TO PROG NAME 8A 01430I 335 342 KNLINK 01440I* RECORD STATUS 1A 01450I 352 352 KNSTAT 01460C******************************************************************** 01470C* INITIALIZE. GET CRTFILE. 01480C EXSR SR101 1-TIME INIT 01490C H9 GOTO ENDJOB PROG ERROR 01500C*------------------------------------------------------------------- ÐÐ01510C BEGIN TAG 01520C* DISPLAY BATCHES CURRENTLY OPEN THIS DEPT. 01530C EXSR SR102 PUT MENU 01540C*------------------------------------------------------------------- 01550C START TAG 01560C* REQUEST SELECTION. 01570C EXSR SR103 REQST SELECTION 01580C 90 GOTO ESCAPE 01590C N77 GOTO NEWITM 01600C Z-ADDITEM J 30 54 01610C N54 Z-ADD1 J 01620C J COMP 75 54 01630C N54 GOTO TAG10 01640C Z-ADD241 M 50 96 01650C EXSR SR73 01660C GOTO START 01670C*------------------------------------------------------------------- 01680C TAG10 TAG 01690C MOVELJOB,J W14A 14 01700C MOVELBAT,J W8A 8 01710C MOVE '00000' W8A 01720C MOVE W8A W14A 01730C EXSR SR104 REQST REC NO 01740C 90 GOTO ESCAPE 01750C MOVE RECNO W14A ÐÐ01760C W14A SETLLKPDATA 01770C SETOF 68 01780C*-------------------------------------------------------------------- 01790C TAG20 TAG 01800C SETOF 54 01810C READ KPDATA 54 01820C 54 GOTO ENDJOB 01830C KEJOB COMP JOB,J 54 01840C 54 KEBAT COMP BAT,J 54 01850C N54 GOTO ENDJOB 01860C KESTAT COMP 'D' 54 01870C 54 GOTO TAG20 DELETED 01880C N68 EXSR SR80 GET KPMAST 01890C EXSR SR105 EDIT DATA 01900C EXSR SR72 PUT DATA 01910C COUNT COMP 28 54 54 01920C N54 GOTO TAG20 01930C Z-ADD320 M 01940C EXSR SR73 END PAGE MSG 01950C EXSR SR75 READ 01960C 90 GOTO ESCAPE 01970C EXSR SR71 PUT HEADING 01980C GOTO TAG20 01990C*------------------------------------------------------------------- 02000C ENDJOB TAG ÐÐ02010C Z-ADD327 M END OF FILE MSG 02020C EXSR SR73 PUT MSG 02030C EXSR SR75 READ 02040C 90 GOTO ESCAPE 02050C GOTO NEWITM 02060C*------------------------------------------------------------------- 02070C ESCAPE TAG 02080C 98 GOTO GOODBY 02090C 94 GOTO MENU 02100C 93 GOTO NEWITM 02110C*-------------------------------------------------------------------- 02120C ERROR TAG 02130C EXSR SR73 PUT MSG 02140C GOTO START 02150C*------------------------------------------------------------------ 02160C NEWITM TAG 02170C* SET-UP LINK FOR NEW ITEM 02180C MOVEL'Q006KP' PROG 8 02190C GOTO END 02200C*------------------------------------------------------------------- 02210C MENU TAG 02220C* SET-UP LINK TO MENU 02230C MOVELCRMENU PROG 02240C GOTO END 02250C*-------------------------------------------------------------------- ÐÐ02260C GOODBY TAG 02270C* LINK TO SIGN-OFF 02280C MOVEL'GOODBY' PROG 02290C GOTO END 02300C*------------------------------------------------------------------- 02310C END TAG 02320C EXITFCHAIN LINK TO NEXT PROG 02330C RLABL PROG 02340C***************************************************************** 02350CSR SR70 BEGSR 02360C* PUT MENU HEADING. 02370CSR Z-ADD3 COUNT 02380CSR SETON 70 02390CSR EXCPT CLEAR SCREEN 02400CSR SETOF 70 02410CSR ENDSR 02420C********************************************************************** 02430CSR SR71 BEGSR 02440C* PUT DATA HEADINGS TO TERMINAL. 02450CSR Z-ADD5 COUNT 30 02460CSR SETON 71 02470CSR EXCPT PUT HEADINGS 02480CSR SETOF 71 02490CSR ENDSR 02500C********************************************************************* ÐÐ02510CSR SR72 BEGSR 02520C* PUT DATA TO TERMINAL 02530CSR SETON 72 02540CSR EXCPT PUT DATA 02550CSR SETOF 72 02560CSR ENDSR 02570C*********************************************************************** 02580CSR SR73 BEGSR 02590C* PUT ERROR MESSAGE TO TERMINAL 02600CSR EXSR SR89 GET MGFILE 02610CSR SETON 73 02620CSR EXCPT PUT MSG 02630CSR SETOF 73 02640CSR ENDSR 02650C******************************************************************** 02660CSR SR74 BEGSR 02670C* PUT JOB MENU (ACTIVE BATCHES) LINE. 02680CSR SETON 74 02690CSR EXCPT PUT MENU LINE 02700CSR SETOF 74 02710CSR ENDSR 02720C******************************************************************* 02730CSR SR75 BEGSR 02740C* READ FROM TERMINAL 02750CSR SETOF 779096 ÐÐ02760CSR SETOF 939291 02770CSR MOVE BIT,4 BUFLGT 2 READ BUFFER LGTH 02780CSR MOVE BLK6 W6A 6 BUFFER 02790CSR EXITFQWREED READ FROM TERMINAL 02800CSR RLABL W6A READ BUFFER 02810CSR RLABL BUFLGT READ BUFFER LGTH 02820CSR MOVEAW6A A6 INPUT DATA ARRAY 02830CSR MOVE BLK6 W6A INIT INPUT ARRAY 02840CSR Z-ADD1 W 30 02850CSR '\' LOKUPA6,W 90 FLAG ESC 02860CSRN90 GOTO T75B NOT ESC 02870CSR 1 ADD W W 02880CSR W COMP 6 54 02890CSR 54 GOTO T75A BAD ESC 02900CSR A6,W COMP 'G' 98 GOODBY 02910CSR A6,W COMP 'E' 94 MENU 02920CSR A6,W COMP 'N' 93 NEW ITEM 02930CSR 98 02940COR 94 02950COR 93 GOTO END75 02960C*------------------------------------------------------------------ 02970CSR T75A TAG 02980C* FLAG BAD ESC INPUT 02990CSR Z-ADD318 M 96 FLAG ERROR 03000CSR GOTO END75 ÐÐ03010C*-------------------------------------------------------------------- 03020CSR T75B TAG 03030C* MOVE DATA 03040CSR Z-ADD1 W 03050CSR ' ' LOKUPA6,W 77 03060CSR 77 MOVEAA6,W W6A INPUT DATA 03070CSR END75 ENDSR 03080C******************************************************************** 03090CSR SR80 BEGSR 03100C* GET KPMAST (FIELD SPECS). 03110CSR MOVELJOB,J W10A 10 JOB # 03120CSR MOVE ' ' W10A 03130CSR SETON 68 03140CSR MOVE BLK12 NAM FIELD NAME 03150CSR Z-ADD0 KPD DEC PLACES 03160CSR Z-ADD0 SIZ FIELD SIZE 03170CSR MOVE ' ' KPE EDIT CODE 03180CSR Z-ADD0 COL START COL 03190CSR Z-ADD0 K 30 03200CSR W10A SETLLKPMAST 03210C*------------------------------------------------------------------- 03220CSR T80A TAG 03230CSR SETOF 54 03240CSR READ KPMAST 54 03250CSR 54 GOTO END80 ÐÐ03260CSR KPJOB COMP JOB,J 54 03270CSRN54 GOTO END80 03280CSR KPSTAT COMP 'D' 54 03290CSR 54 GOTO T80A 03300CSR 1 ADD K K 03310CSR Z-ADDKPDEC KPD,K 03320CSR MOVE KPNAME NAM,K 03330CSR Z-ADDKPSIZE SIZ,K 03340CSR MOVE KPEDIT KPE,K 03350CSR Z-ADDKPCOL COL,K 03360CSR MOVE KPTYPE TYP,K 03370CSR GOTO T80A 03380C*------------------------------------------------------------------- 03390CSR END80 TAG 03400CSR JOB,J CHAINKPNAME 54 03410CSR EXSR SR71 PUT HEADING 03420CSR ENDSR 03430C********************************************************************** 03440CSR SR89 BEGSR 03450C* GET MESSAGE MASTER 03460CSR M CHAINMGFILE 54 03470CSR 54 MOVE BLK35 MGTEXT 03480CSR 54 MOVELM MGTEXT 03490CSR 54 MOVE MES,1 MGTEXT 03500CSR ENDSR ÐÐ03510C*********************************************************************** 03520CSR SR101 BEGSR 03530C* 1-TIME INITIALIZE 03540CSR MOVE BIT,1 NUL 03550CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03560CSR MOVE ' ' BLK6 6 03570C* GET PORT # AND CRTFILE 03580CSR MOVE ' ' W8A 8 03590CSR Z-ADD0 W2N 20 03600CSR Z-ADD0 W1N 10 03610CSR MOVE ' ' W2A 2 03620CSR EXITFPGMINX GET PORT # 03630CSR RLABL W8A 03640CSR RLABL W2N 03650CSR RLABL W1N 03660CSR RLABL W2A 03670CSR MOVE W2A PORT 20 PORT NO. 03680CSR PORT COMP 0 54 03690CSRN54 Z-ADD25 PORT DEFAULT 03700CSR PORT CHAINCRTFILE H9 03710C* DEFINE WORK FIELDS,ETC. 03720CSR MOVE ' ' BLK35 35 03730CSR MOVE ' ' BLK15 15 03740CSR MOVE ' ' BLK12 12 03750CSR MOVE ' ' BLK60 60 ÐÐ03760CSR MOVE ' ' BLK132132 03770C* 03780C* 03790CSR ENDSR 03800C********************************************************************** 03810CSR SR102 BEGSR 03820C* PUT MENU. 03830CSR Z-ADD0 J 03840CSR MOVELBLK6 W10A 10 03850CSR MOVE '000' W10A 03860CSR W10A SETLLKPCONT 03870CSR EXSR SR70 PUT HEADING 03880CSR SETOF 40 03890CSR MOVE BLK12 FJOB 10 03900C*------------------------------------------------------------------ 03910CSR T102A TAG 03920CSR SETOF 54 03930CSR READ KPCONT 54 03940CSR 54 GOTO END102 03950CSR CRDEPT COMP 840 54 03960CSRN54 KCDEPT COMP CRDEPT 54 03970CSRN54 GOTO T102A 03980CSR KCSTAT COMP 'D' 54 03990CSR 54 GOTO T102A 04000CSR MOVELKCJOB W10A 10 ÐÐ04010CSR MOVE KCBAT W10A 04020CSR W10A COMP FJOB 54 04030CSR 54 GOTO END102 04040CSR 1 ADD J J 04050CSR MOVE KCJOB JOB,J 04060CSR Z-ADDKCBAT BAT,J 04070CSRN40 MOVELKCJOB FJOB 04080CSRN40 MOVE KCBAT FJOB 04090CSR SETON 40 04100CSR KCJOB CHAINKPNAME 54 04110CSR 54 MOVE BLK60 KNTITL 04120CSR EXSR SR74 PUT MENU 04130CSR 1 ADD COUNT COUNT 30 04140CSR COUNT COMP 28 54 54 04150CSRN54 GOTO T102A 04160CSR EXSR SR70 PUT HEADING 04170CSR GOTO T102A 04180CSR END102 ENDSR 04190C*********************************************************************** 04200CSR SR103 BEGSR 04210C* REQUEST SELECTION. 04220CSR Z-ADD480 M 79 FINAL EDIT FLAG 04230CSR EXSR SR73 PROMPT 04240CSR EXSR SR75 READ 04250CSR 90 GOTO END103 ÐÐ04260CSR EXSR SR202 R. ADJUST 04270CSR MOVE W6A ITEM 30 SELECTION # 04280CSR END103 ENDSR 04290C******************************************************************** 04300CSR SR104 BEGSR 04310C* REQUEST RECORD #. 04320CSR Z-ADD257 M 04330CSR EXSR SR73 PROMPT 04340CSR EXSR SR75 READ 04350CSR 90 GOTO END104 04360CSR EXSR SR202 R. ADJUST 04370CSR MOVE W6A RECNO 50 RECORD # 04380CSR END104 ENDSR 04390C**************************************************************************04400CSR SR105 BEGSR 04410C* EDIT DATA. 04420CSR Z-ADD1 P 30 04430C*------------------------------------------------------------------- 04440CSR T105A TAG 04450C* MOVE NEXT FIELD TO WORK FIELD W15A. 04460CSR 000 LOKUPCOL,P 54 04470CSRN54 GOTO END105 04480CSR Z-ADDCOL,P SS 30 04490CSR Z-ADDSIZ,P N 30 04500CSR MOVE BLK15 W15A 15 ÐÐ04510CSR Z-ADD1 TS 30 04520CSR EXIT SUBRMV MOVE DATA. 04530CSR RLABL RECORD SOURCE 04540CSR RLABL SS SOURCE START 04550CSR RLABL W15A TARGET 04560CSR RLABL TS TARGET START 04570CSR RLABL N NUMB CHAR 04580C* BRANCH IF ALPHA OR NON-EDITED. 04590CSR TYP,P COMP 'N' 54 04600CSR KPE,P COMP ' ' 55 04610CSRN54 NOT NUMERIC 04620COR 55 GOTO T105S NO EDIT CODE 04630CSR MOVE KPE,P W1A 1 EDIT CODE 04640C* RIGHT ADJUST NUMERIC FIELD. 04650CSR Z-ADD15 W2N 20 04660CSR EXIT SUBRAJ R.ADJUST 04670CSR RLABL W2N 04680CSR RLABL W15A 04690C* BRANCH ON NUMB DECIMAL PLACES. 04700CSR KPD,P COMP 0 54 04710CSR KPD,P COMP 1 55 04720CSR KPD,P COMP 2 56 04730CSR KPD,P COMP 3 57 04740CSR MOVE W15A W15N 150 04750CSR 55 MOVE W15A W15D1 151 ÐÐ04760CSR 56 MOVE W15A W15D2 152 04770CSR 57 MOVE W15A W15D3 153 04780C* BRANCH ON Y-EDIT CODE 04790CSR KPE,P COMP 'Y' 54 04800CSR 54 GOTO T105K Y-EDIT CODE 04810CSR MOVE BLK15 W15A 04820CSR 54 GOTO T105J 04830CSR 55 GOTO T105C 04840CSR 56 GOTO T105E 04850CSR 57 GOTO T105G 04860CSR GOTO T105J 04870C*------------------------------------------------------------------- 04880CSR T105C TAG 04890CSR EXIT SUBRED EDIT 1-PLACE 04900CSR RLABL W15D1 SOURCE 04910CSR RLABL W1A EDIT CODE 04920CSR RLABL W15A RESULT 04930CSR RLABL W2N END POS 04940CSR GOTO T105M 04950C*------------------------------------------------------------------ 04960CSR T105E TAG 04970CSR EXIT SUBRED EDIT 2-PLACES 04980CSR RLABL W15D2 04990CSR RLABL W1A 05000CSR RLABL W15A ÐÐ05010CSR RLABL W2N 05020CSR GOTO T105M 05030C*------------------------------------------------------------------- 05040CSR T105G TAG 05050CSR EXIT SUBRED EDIT 3-PLACES 05060CSR RLABL W15D3 05070CSR RLABL W1A 05080CSR RLABL W15A 05090CSR RLABL W2N 05100CSR GOTO T105M 05110C*------------------------------------------------------------------- 05120CSR T105J TAG 05130CSR EXIT SUBRED EDIT 0-PLACES 05140CSR RLABL W15N 05150CSR RLABL W1A 05160CSR RLABL W15A 05170CSR RLABL W2N 05180CSR GOTO T105M 05190C*------------------------------------------------------------ 05200CSR T105K TAG 05210C* EDIT Y-EDIT CODE 05220CSR MOVE KPE,P W1A 05230CSR MOVE W15A W10N 100 05240CSR Z-ADD10 W2N 05250CSR MOVE BLK15 W15A ÐÐ05260CSR MOVE BLK15 W10A 10 05270CSR EXIT SUBRED EDIT 05280CSR RLABL W10N SOURCE 05290CSR RLABL W1A EDIT CODE 05300CSR RLABL W10A TARGET 05310CSR RLABL W2N END POS 05320CSR MOVE W10A W15A 05330C*--------------------------------------------------------------- 05340CSR T105M TAG 05350C* MOVE NUMERIC DATA BACK 05360C* COMPUTE EDITED SIZE 05370CSR Z-ADD1 X 30 05380CSR MOVEAW15A A15 05390C*-------------------------------------------------------------- 05400CSR T105P TAG 05410CSR KPE,P COMP 'Y' 55 05420CSR 55 '0' LOKUPA15,X 54 05430CSRN55 '.' LOKUPA15,X 54 54 05440CSRN54 GOTO T105T 05450CSR Z-ADDX SS 05460CSR 15 SUB X N 05470CSR 1 ADD N N 05480CSR EXSR SR301 COMPUTE TS 05490CSR EXIT SUBRMV MOVE DATA 05500CSR RLABL W15A SOURCE ÐÐ05510CSR RLABL SS SOURCE START 05520CSR RLABL RECORD TARGET 05530CSR RLABL TS TARGET START 05540CSR RLABL N NUMB OF CHAR 05550CSR GOTO T105T 05560C*----------------------------------------------------------- 05570CSR T105S TAG 05580C* MOVE NON-NUMERIC DATA 05590CSR Z-ADDSIZ,P NUMB 30 05600CSR EXSR SR302 BLKS TO RECORD 05610CSR Z-ADDSIZ,P N 05620CSR Z-ADDCOL,P TS 05630CSR Z-ADD1 SS 05640CSR EXIT SUBRMV 05650CSR RLABL W15A SOURCE 05660CSR RLABL SS SOURCE START 05670CSR RLABL RECORD TARGET 05680CSR RLABL TS TARGET START 05690CSR RLABL N NUMB CHAR 05700CSR GOTO T105T 05710C*------------------------------------------------------------------- 05720CSR T105T TAG 05730CSR 1 ADD P P 05740CSR P COMP 30 54 05750CSRN54 GOTO T105A ÐÐ05760CSR END105 ENDSR 05770C******************************************************************** 05780CSR SR202 BEGSR 05790C* R. ADJUST. 05800CSR Z-ADD6 W2N 20 05810CSR EXIT SUBRAJ R. ADJUST 05820CSR RLABL W2N 05830CSR RLABL W6A 05840CSR ENDSR 05850C************************************************************* 05860CSR SR301 BEGSR 05870C* COMPUTE TS(TARGET START) FOR NUMERIC DISPLAY 05880CSR KPE,P COMP '2' 54 05890CSRN54 KPE,P COMP 'K' 54 05900CSRN54 GOTO T301B 05910CSR SIZ,P SUB KPD,P WHOLE 30 05920CSR WHOLE DIV 3 XTRA 30 05930CSR XTRA ADD WHOLE WHOLE WHOLE # SIZE 05940CSR KPD,P COMP 0 54 05950CSR 54 1 ADD KPD,P XTRA 05960CSRN54 Z-ADDKPD,P XTRA 05970CSR KPE,P COMP 'K' 54 05980CSR 54 1 ADD XTRA XTRA DEC SIZE 05990CSR N SUB XTRA W3N 30 ACTUAL WHOLE# 06000CSR WHOLE SUB W3N W3N ÐÐ06010CSR COL,P ADD W3N TS 54 06020CSRN54 Z-ADD1 TS TARGET START 06030CSR XTRA ADD WHOLE NUMB 06040CSR EXSR SR302 BLKS TO RECORD 06050CSR GOTO END301 06060C*------------------------------------------------------------- 06070CSR T301B TAG 06080C* DO Y-EDIT CODE 06090CSR KPE,P COMP 'Y' 54 06100CSRN54 GOTO T301D NOT Y-EDIT 06110CSR SIZ,P DIV 2 XTRA 06120CSR XTRA SUB 1 XTRA 54 06130CSRN54 Z-ADD1 XTRA 06140CSR SIZ,P ADD XTRA W3N 06150CSR COL,P ADD W3N TS 06160CSR TS SUB N TS 54 06170CSRN54 Z-ADD1 TS TARGET START 06180CSR SIZ,P ADD XTRA NUMB 06190CSR EXSR SR302 BLKS TO RECORD 06200CSR GOTO END301 06210C*------------------------------------------------------------ 06220CSR T301D TAG 06230C* EDIT CODE OTHER THAN 2,K,Y. 06240CSR SIZ,P SUB N W3N 06250CSR COL,P ADD W3N TS ÐÐ06260CSR Z-ADDSIZ,P NUMB 06270CSR EXSR SR302 BLKS TO RECORD 06280CSR END301 ENDSR 06290C*************************************************************** 06300CSR SR302 BEGSR 06310C* BLK CUR FIELD IN RECORD 06320CSR Z-ADD1 W3N 06330CSR Z-ADDCOL,P T 30 06340CSR EXIT SUBRMV MOVE BLKS 06350CSR RLABL BLK132 SOURCE 06360CSR RLABL W3N SOURCE START 06370CSR RLABL RECORD TARGET 06380CSR RLABL T TARGET START 06390CSR RLABL NUMB NUMB OF CHAR 06400CSR ENDSR 06410C**************************************************************** 06420OTERM132 E 70 06430O* MENU HEADING 06440O 4 'ITEM' 06450O 14 'JOB NAME' 06460O 23 'BATCH #' 06470O 36 'DESCRIPTION' 06480O*------------------------------------------------------------------- 06490O E 70 06500O 1 ' ' ÐÐ06510O*------------------------------------------------------------------- 06520O E 71 06530O* DATA HEADING. 06540O 3 'JOB' 06550O KEJOB 10 06560O KNTITL 74 06570O 83 'BATCH #' 06580O KEBAT Z 87 06590O*------------------------------------------------------------------- 06600O E 71 06610O KNHL1 132 06620O*------------------------------------------------------------------- 06630O E 71 06640O KNHL2 132 06650O*------------------------------------------------------------------- 06660O E 71 06670O 1 ' ' 06680O*------------------------------------------------------------------- 06690O E 74 06700O* MENU DATA. 06710O J Z 3 06720O KCJOB 12 06730O KCBAT Z 19 06740O KNTITL 85 06750O*------------------------------------------------------------------- ÐÐ06760O E 72 06770O* DATA. 06780O 1 '(' 06790O KELUSN2 7 06800O 8 ')' 06810O*------------------------------------------------------------------- 06820O E 72 06830O RECORD 132 06840O*------------------------------------------------------------------- 06850O E 73 06860O* MESSAGE. 06870O NUL 132 06880O MGTEXT 35 06890O BIT,8 35 ** NUL ARRAY 006900 006910** A6 ARRAY 006920 006930** NUM ARRAY 006940002 BATCH # 006950003 RECORD # 006960** DUN ARRAY 006970 006980** MES ARRAY 006990---MESSAGE NOT ON FILE--- 007000ÐÐ** NAM ARRAY 007010 007020** COL ARRAY 007030 007040** SIZ ARRAY 007050 007060** KPD ARRAY 007070 007080** KPE ARRAY 007090 007100** TYP ARRAY 007110 007120** JOB ARRAY 007130 007140** BAT ARRAY 007150 007160** A15 ARRAY 007170 007180/* 007190_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(y  X006PC P120282120282(èÈÐ00010H Q006PC00020F* GEN COST CANDIDATE FILE FOR ALL END USE PART NOS. (X006PC) 00030F* REVISED 3/31/81 3:55 PM. 00040FBMWU IP F 21 20AI 1 DISK 00050FPMMST2 IS F 674 12AI 1 DISK 00060FPCCAND O F 10 DISK 00070I******************************************************************** 00080IBMWU BW 01 21NCD 00090I 1 100BWPN L1M1 00100I BG 03 00110I******************************************************************** 00120IPMMST2 PM 02 674NCD 00130I 1 100PMPN L1M1 00140I PG 04 00150O******************************************************************** 00160OPCCAND D 02NMR 00170O PMPN 10 /* 000180_‚ ÐÐ _‚_‚0FPCCAND O F 10 DISK 00070I******************************************************************** 00080IBMWU BW 01 21NCD 00090I 1 100BWPN L1M1 00100I BG 03 00110I******************************************************************** 00120IPMMST2 PM 02 674NCD 00130I 1 100PMPN L1M1 00140I PG 04 00150O******************************************************************** 00160OPCCAND D 02NMR 00170O PMPN 10 /* 000180_‚ ÐÈ(–‡ –?X006PJ P120282120282(èÈÐ00010H Q006PJ00020F* CUM CUR MONTH HRS/$ WITH BAL FORWARD. (X006PJ) 00030F* REVISED 3/04/81 11:00 AM. 00040FBITTAB IP F 33 DISK 00050FTERM50 O F 50 5 00060FPJMAST UP F 170 12AI 1 DISK 00070F**************************************************************** 00080E PA$ 2 9 2 ACTUAL $ - PRIOR 00090E PC$ 2 9 2 ACTUAL $ CUR MO 00100E PT$ 2 9 2 TRSFR $ 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 02 00140I 1 33 BIT 00150I******************************************************************** 00160IPJMAST PJ 01 170NCD 00170I* PROJECT WORK ORDER. 00180I* ACTUAL CLOSE DATE 6N 00190I 100 1050PJACD 70 00200I* LABOR HRS 7.1P 00210I P 106 1091PJALH 00220I* LABOR $ 9.2P 00230I P 110 114 PA$,1 00240I* MATERIAL $ 9.2P 00250I P 115 119 PA$,2 ÐÐ00260I* CURRENT MONTH - ACTUAL. 00270I* LABOR HRS 7.1P 00280I P 124 1271PJCLH 00290I* LABOR $ 9.2P 00300I P 128 132 PC$,1 00310I* MATERIAL $ 9.2P 00320I P 133 137 PC$,2 00330I* TRSFR $ 2 X 9.2P 00340I P 138 147 PT$ 00350I* RECORD STATUS 1A 00360I 170 170 PJSTAT 00370I GG 02 00380C******************************************************************** 00390C 75 GOTO TAG10 00400C SETON 75 00410C SETON 80 00420C EXCPT 00430C SETOF 80 00440C MOVELBIT,1 BUFLGT 2 00450C MOVE BIT,2 BUFLGT 00460C MOVE ' ' W2A 2 00470C EXITFQWREED 00480C RLABL W2A 00490C RLABL BUFLGT 00500C MOVELW2A W1A 1 ÐÐ00510C W1A COMP 'N' 54 00520C N54 MOVE W2A W1A 00530C N54 W1A COMP 'N' 54 00540C 54 SETOF 75 00550C 54 SETON LR 00560C 54 00570COR 02 GOTO END 00580C*------------------------------------------------------------------- 00590C TAG10 TAG 00600C 01 70 SETOF 01 00610C 01 PJCLH ADD PJALH PJALH LABOR HRS 00620C 01 PC$ ADD PA$ PA$ ACTUAL LAB/MATL $ 00630C 01 PT$,2 ADD PT$,1 PT$,1 00640C 01 Z-ADD0 PJCLH 00650C 01 Z-ADD0 PC$ 00660C 01 Z-ADD0 PT$,2 00670C*------------------------------------------------------------------- 00680C END TAG 00690O******************************************************************** 00700OPJMAST D 01 00710O PJALH 109P 00720O PA$ 119P 00730O PJCLH 127P 00740O PC$ 137P 00750O PT$ 147P ÐÐ00760O******************************************************************** 00770OTERM50 E 80 00780O 24 'N O T E: THIS PROGRAM CU' 00790O 48 'MS CUR MONTH $ WITH BAL ' 00800O E 80 00810O 24 'FORWARD IN PROJ MASTER. ' 00820O 48 'CANCEL BY KEYING "N" IF ' 00830O E 80 00840O 24 'THIS IS NOT YOUR INTENT.' 00850O E 80 00860O 24 '* I M P O R T A N T * ' /* 000870_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(&Ç &æX006QM P120282120282(èÈÐ00010H Q006QM00020F* LIST QMMAST KEY SEQUENCE. (X006QM) 00030F* REVISED 7-14-81 4:40 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FQMMAST ID F 160L 8AI 1 DISK 00070FSLMNAME IT F 80 EDISK 00080FTERM21 O F 21 5 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E SLMNAME TABSLM 1 15 3 TABSLN 20 SALESMAN 00120E TABPRD 1 18 2 TABPRN 20 PRODUCT CODE 00130E TABSYS 1 2 1 TABSYN 20 SYST CODE 00140E TABSTC 1 6 1 TABSTN 10 STATUS WORD 00150E TABRES 1 5 1 TABREN 20 REASON LOST 00160E NUL 1 132 1 NULL CHAR 00170E A6 6 6 1 CALL READ PARAM. 00180E A10 10 10 1 A INPUT DATA ARRAY 00190E DUN 2 2 1 A EDIT CMPLT FLAG 00200E MES 1 1 30 00210E* 00220E* 00230E* 00240E QMD 6 7 0 DATE ARRAY 00250E BIT 33 1 SCREEN CONTR. CHAR ÐÐ00260E* 00270E* 00280I******************************************************************* 00290IBITTAB BT 00300I 1 33 BIT 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I****************************************************************** 00360IQMMAST QM 00370I* QUOTE MASTER. 00380I* QUOTE # 5A 00390I 1 5 QMQOTE 00400I* ITEM # 3N 00410I 6 80QMITEM 00420I* CUSTOMER NAME 20A 00430I 9 28 QMNAME 00440I* CUSTOMER RFQ # 20A 00450I 29 48 QMRFQ 00460I* RFQ ITEM # 4A 00470I 49 52 QMRFQI 00480I* CONTACT 20A 00490I 53 72 QMCONT 00500I* ASSIGNED TO (SALESMAN) 3A ÐÐ00510I 73 75 QMSLSM 00520I* DATE ARRAY 7P X 6 00530I* 1 = RECEIVED 00540I* 2 = DUE 00550I* 3 = SENT 00560I* 4 = EXPECTED AWARD 00570I* 5 = FOLLOW-UP 00580I* 6 = EXPIRES 00590I P 76 99 QMD 00600I* PRODUCT CLASS 2A 00610I 100 101 QMPCLS 00620I* SYSTEM CODE 1A 00630I 102 102 QMSYST 00640I* FILLER 103 103 FFFFFF 00650I* QUOTE AMOUNT 7P ($) 00660I P 104 1070QMAMT 00670I* DELIVERY PROMISED (DAYS ARO) 3P 00680I P 108 1090QMDEL 00690I* STATUS 1A 00700I* E = ENTERED 00710I* N = NO BID 00720I* B = BID 00730I* P = PENDING 00740I* L = LOST 00750I* W = WON ÐÐ00760I* C = CANCELLED 00770I 110 110 QMSCOD 00780I* PROBABILITY OF AWARD 3.2P 00790I P 111 1122QMPROB 00800I* WON/LOST REASON 1A 00810I 113 113 QMREAS 00820I* REMARKS 40A 00830I 114 153 QMREM 00840I* RECORD STATUS 1A 00850I 160 160 QMSTAT 00860C******************************************************************** 00870C* INITIALIZE 00880C EXSR SR101 1-TIME INIT 00890C*------------------------------------------------------------------ 00900C START TAG 00910C* SET-UP 1ST FIELD NO. 00920C SETOF 96 00930C Z-ADD1 F 30 FIELD # 00940C GOTO READ 00950C*------------------------------------------------------------------ 00960C NEXT TAG 00970C* SET-UP NEXT FIELD NO. 00980C 1 ADD F F FIELD # 00990C*----------------------------------------------------------------- 01000C READ TAG ÐÐ01010C* READ DATA FROM TERMINAL. 01020C EXSR SR102 VALIDATE FIELD # 01030C 55 GOTO UPDATE DONE 01040C EXSR SR201 IDENTIFY-F 01050C SETON 69 01060C EXSR SR72 PROMPT 01070C SETOF 69 01080C EXSR SR75 READ TERMINAL 01090C 98 GOTO GOODBY GOODBY 01100C 94 GOTO MENU MENU REQUEST 01110C N77 EXSR SR104 EDIT INPUT FIELD 01120C 93 GOTO NEWITM NEW ITEM 01130C 96 GOTO ERROR ERROR 01140C N77 GOTO NEXT NO DATA INPUT 01150C*------------------------------------------------------------------ 01160C PROCES TAG 01170C* PROCESS INPUT DATA 01180C EXSR SR103 MOVE DATA 01190C N96 EXSR SR104 EDIT DATA 01200C 96 GOTO ERROR ERROR 01210C GOTO NEXT 01220C*------------------------------------------------------------------ 01230C UPDATE TAG 01240C* UPDATE DATA BASE. 01250C EXSR SR105 FINAL EDIT ÐÐ01260C 96 GOTO ERROR ERROR 01270C EXSR SR106 UPDATE 01280C 96 GOTO ERROR ERROR 01290C 94 GOTO MENU RET TO MENU. 01300C 98 GOTO GOODBY SIGN-OFF. 01310C GOTO START 01320C*------------------------------------------------------------------- 01330C JUMP TAG 01340C* SET-UP JUMP TO REQUESTED FIELD 01350C 1 ADD W W 30 01360C W COMP 10 54 01370C 54 Z-ADD318 M 50 96 FLAG ERROR 01380C 54 GOTO ERROR BAD ESC 01390C MOVE '000' W3A 3 01400C MOVEAA10,W W3A 01410C Z-ADD3 W2N 20 01420C EXIT SUBRAJ R. JUSTIFY 01430C RLABL W2N 01440C RLABL W3A 01450C MOVE W3A F NEW FIELD # 01460C GOTO READ 01470C*-------------------------------------------------------------------- 01480C ERROR TAG 01490C EXSR SR102 VALIDATE FIELD # 01500C EXSR SR89 GET MSG ÐÐ01510C EXSR SR73 PUT MSG 01520C GOTO READ 01530C*------------------------------------------------------------------ 01540C NEWITM TAG 01550C* SET-UP LINK FOR NEW ITEM 01560C GOTO START 01570C*------------------------------------------------------------------- 01580C MENU TAG 01590C* SET-UP LINK TO MENU 01600C MOVEL'Q070DP' PROG 8 01610C GOTO END 01620C*-------------------------------------------------------------------- 01630C GOODBY TAG 01640C* LINK TO SIGN-OFF 01650C MOVEL'GOODBY' PROG 01660C GOTO END 01670C*------------------------------------------------------------------- 01680C END TAG 01690C PROG COMP BLK8 54 01700C N54 MOVEL'Q070DP' PROG 8 01710C EXITFCHAIN LINK TO NEXT PROG 01720C RLABL PROG 01730C********************************************************************* 01740CSR SR72 BEGSR 01750C* PUT DATA TO TERMINAL ÐÐ01760CSR 01 69 EXITFQTOPF CLEAR CRT 01770CSR SETON 72 01780CSR EXCPT PUT DATA 01790CSR SETOF 72 01800CSR ENDSR 01810C*********************************************************************** 01820CSR SR73 BEGSR 01830C* PUT ERROR MESSAGE TO TERMINAL 01840CSR SETON 73 01850CSR EXCPT PUT MSG 01860CSR SETOF 73 01870CSR Z-ADDM LSTERR 50 01880CSR ENDSR 01890C******************************************************************* 01900CSR SR75 BEGSR 01910C* READ FROM TERMINAL 01920CSR SETOF 779096 01930CSR SETOF 939291 01940CSR SETOF 8988 01950CSR MOVE BIT,6 A6,2 BUF LENGTH 01960CSR MOVEAA6 W6A 6 01970CSR MOVE BLK10 W10A 10 BUFFER 01980CSR EXITFXCREAD READ TERM 01990CSR RLABL W10A 02000CSR RLABL W6A ÐÐ02010CSR MOVEAW10A A10 02020CSR MOVE BLK10 W10A 02030CSR Z-ADD1 W 30 02040CSR '\' LOKUPA10,W 90 FLAG ESC 02050CSRN90 GOTO T75B NOT ESC 02060CSR 1 ADD W W 02070CSR W COMP 10 54 02080CSR 54 GOTO T75A BAD ESC 02090CSR A10,W COMP 'G' 98 GOODBY 02100CSR A10,W COMP 'E' 94 MENU 02110CSR A10,W COMP 'N' 93 NEW ITEM 02120CSR 98 02130COR 94 02140COR 93 GOTO END75 02150C*------------------------------------------------------------------ 02160CSR T75A TAG 02170C* FLAG BAD ESC INPUT 02180CSR Z-ADD318 M 96 FLAG ERROR 02190CSR GOTO END75 02200C*-------------------------------------------------------------------- 02210CSR T75B TAG 02220C* MOVE DATA 02230CSR Z-ADD1 W 02240CSR ' ' LOKUPA10,W 77 02250CSR 77 MOVEAA10,W W10A INPUT DATA ÐÐ02260C*-------------------------------------------------------------------- 02270CSR END75 TAG 02280C* INIT PREV ERROR MSG. 02290CSR LSTERR COMP 0 54 02300CSR 54 MOVE BLK35 MGTEXT 02310CSR 54 EXSR SR73 BLANK MESSAGE 02320CSR Z-ADD0 LSTERR 50 02330CSR ENDSR 02340C********************************************************************** 02350CSR SR89 BEGSR 02360C* GET MESSAGE MASTER 02370CSR M CHAINMGFILE 54 02380CSR 54 MOVE BLK35 MGTEXT 02390CSR 54 MOVELM MGTEXT 02400CSR 54 MOVE MES,1 MGTEXT 02410CSR ENDSR 02420C*********************************************************************** 02430CSR SR101 BEGSR 02440C* 1-TIME INITIALIZE 02450CSR MOVE BIT,1 NUL 02460CSR MOVE BIT,1 A6 02470CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS 02480CSR MOVE ' ' BLK10 10 02490C* DEFINE WORK FIELDS,ETC. 02500CSR MOVE ' ' BLK35 35 ÐÐ02510CSR MOVE ' ' BLK8 8 02520CSR MOVE ' ' BLK5 5 02530CSR MOVE ' ' BLK20 20 02540C* 02550C* 02560CSR ENDSR 02570C********************************************************************** 02580CSR SR102 BEGSR 02590C* VALIDATE FIELD NO. 02600CSR F COMP 0 54 02610CSRN54 Z-ADD1 F 02620CSR F COMP FLIMIT 55 02630CSR 55 Z-ADD1 F 02640CSR ENDSR 02650C******************************************************************** 02660CSR SR103 BEGSR 02670C* MOVE INPUT DATA 02680CSR EXSR SR201 IDENTIFY-F 02690CSR EXSR SR202 R. JUSTIFY 02700CSR 01 MOVELW10A TQOTE 5 QUOTE # 02710CSR 02 MOVE W10A TITEM 30 ITEM 02720CSR MOVE ' ' DUN,F EDIT FLAG 02730CSR ENDSR 02740C******************************************************************** 02750CSR SR104 BEGSR ÐÐ02760C* EDIT INPUT DATA 02770CSR 96 MOVE ' ' DUN,F EDIT FLAG 02780CSRN96 MOVE 'X' DUN,F 02790CSR ENDSR 02800C*********************************************************************** 02810CSR SR105 BEGSR 02820C* FINAL EDIT 02830CSR SETON 79 FINAL EDIT FLAG 02840CSR Z-ADD1 F 96 02850C*-------------------------------------------------------------------- 02860CSR T105A TAG 02870CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 02880CSRN54 GOTO END105 02890CSR EXSR SR201 IDENTIFY-F 02900CSR EXSR SR104 EDIT 02910CSRN96 GOTO T105A 02920C*-------------------------------------------------------------------- 02930CSR END105 TAG 02940CSR SETOF 79 02950CSR ENDSR 02960C******************************************************************** 02970CSR SR106 BEGSR 02980C* DISPLAY QMMAST RECORD. 02990CSR MOVELTQOTE W8A 8 03000CSR MOVE TITEM W8A ÐÐ03010CSR W8A SETLLQMMAST 03020CSR Z-ADD0 COUNT 30 03030CSR SETOF 74 03040C*------------------------------------------------------------------- 03050CSR T106A TAG 03060CSR SETOF 54 03070CSR READ QMMAST 54 03080CSR 54 GOTO T106B END OF FILE. 03090CSR QMSTAT COMP 'D' 54 03100CSRN54 QMITEM COMP 0 54 03110CSR 54 GOTO T106A 03120CSR EXSR SR205 TABLE LOKUPS. 03130CSR SETON 76 03140CSR EXCPT DISPLAY QMMAST 03150CSR SETOF 76 03160CSR SETON 74 03170CSR 1 ADD COUNT COUNT 03180CSR COUNT COMP 2 54 03190CSRN54 GOTO T106A 03200CSR Z-ADD34 M 03210CSR GOTO T106C 03220C*------------------------------------------------------------------- 03230CSR T106B TAG 03240C* DISPLAY END PAGE/FILE MSG. 03250CSR Z-ADD317 M ÐÐ03260C*----------------------------------------------------------------- 03270CSR T106C TAG 03280CSR EXSR SR89 GET END MSG. 03290CSR EXSR SR73 END PAGE MSG. 03300CSR EXSR SR75 03310CSR 94 EXIT. 03320COR 98 GOODBY. 03330COR 93 GOTO END106 NEW ITEM. 03340CSR Z-ADD0 COUNT 74 03350CSR M COMP 317 54 03360CSRN54 GOTO T106A 03370CSR END106 ENDSR 03380C************************************************************************ 03390CSR SR201 BEGSR 03400C* IDENTIFY FIELD NO. 03410CSR F COMP 1 01 03420CSR F COMP 2 02 03430CSR ENDSR 03440C********************************************************************** 03450CSR SR202 BEGSR 03460C* RIGHT JUSTIFY 03470CSR F COMP 2 54 03480CSRN54 GOTO END202 NOT NUMERIC FIELD 03490CSR Z-ADD10 W2N 20 03500CSR EXIT SUBRAJ R. JUSTIFY ÐÐ03510CSR RLABL W2N 03520CSR RLABL W10A 03530CSR END202 ENDSR 03540C******************************************************************** 03550CSR SR205 BEGSR 03560C* GET CODE DESCRIPTIONS. 03570CSR QMPCLS LOKUPTABPRD TABPRN 54 PRODUCT NAME 03580CSR 54 MOVE TABPRN PRDNAM 20 03590CSRN54 MOVE BLK20 PRDNAM 03600CSR QMSYST LOKUPTABSYS TABSYN 54 SYSTEM NAME 03610CSR 54 MOVE TABSYN SYSNAM 20 03620CSRN54 MOVE BLK20 SYSNAM 03630CSR QMREAS LOKUPTABRES TABREN 54 REASON NAME 03640CSR 54 MOVE TABREN RESNAM 20 03650CSRN54 MOVE BLK20 RESNAM 03660CSR QMSCOD LOKUPTABSTC TABSTN 54 STATUS NAME 03670CSR 54 MOVE TABSTN STCNAM 10 03680CSRN54 MOVE BLK20 STCNAM 03690CSR ENDSR 03700O******************************************************************** 03710OTERM132 E 76N74 03720O 55 'QUOTE INQUIRY - ' 03730O 70 'QUOTE # SEQUENCE' 03740O 102 'WON' 03750O*------------------------------------------------------------------- ÐÐ03760O E 76N74 03770O 5 'QUOTE' 03780O 10 'ITEM' 03790O 20 'CUSTOMER' 03800O 41 'CONTACT' 03810O 60 'SLSM' 03820O 66 'PROD' 03830O 71 'SYS' 03840O 83 'AMOUNT$' 03850O 91 'STATUS' 03860O 97 'PROB' 03870O 103 'LOST' 03880O 126 'SCHEDULE' 03890O*------------------------------------------------------------------- 03900O E 76 03910O*------------------------------------------------------------------- 03920O E 76 03930O QMQOTE 5 03940O QMITEMZ 9 03950O QMNAME 32 03960O QMCONT 54 03970O QMSLSM 59 03980O QMPCLS 66 03990O QMSYST 70 04000O QMAMT 83 ' , , $0' ÐÐ04010O QMSCOD 88 04020O QMPROBZ 96 04030O 97 '%' 04040O QMREAS 102 04050O 118 'REC''D' 04060O QMD,1 132 ' - - ' 04070O*------------------------------------------------------------------- 04080O E 76 04090O 17 'RFQ#:' 04100O QMRFQ 42 04110O 47 '-' 04120O QMRFQI 48 04130O PRDNAM 85 04140O STCNAM 97 04150O 116 'DUE' 04160O QMD,2 132 ' - - ' 04170O*------------------------------------------------------------------- 04180O E 76 04190O 20 'REMARKS:' 04200O QMREM 62 04210O RESNAM 107 04220O 117 'SENT' 04230O QMD,3 132 ' - - ' 04240O*------------------------------------------------------------------- 04250O E 76 ÐÐ04260O 118 'AWARD' 04270O QMD,4 132 ' - - ' 04280O*------------------------------------------------------------------- 04290O E 76 04300O 122 'FOLLOW-UP' 04310O QMD,5 132 ' - - ' 04320O*------------------------------------------------------------------- 04330O E 76 04340O 120 'EXPIRES' 04350O QMD,6 132 ' - - ' 04360O*------------------------------------------------------------------- 04370O E 76 04380O*------------------------------------------------------------------- 04390O E 73 04400O* PUT MSG. 04410O 96 5 '*****' 04420O MGTEXT 48 04430O 96 55 '*****' 04440O BIT,14 132 04450O******************************************************************** 04460OTERM21 E 72 01 04470O 19 'ENTER QUOTE NUMBER:' 04480O*------------------------------------------------------------------- 04490O E 72 02 04500O 13 'ENTER ITEM #:' ÐÐ** TABPRD/TABPRN - PROD CLASS 00451011MINI SERIES 00452012SERIES 1500 00453021SERIES 1000 00454022SERIES 3000 00455023SERIES 5900 00456024SERIES 5300 00457041SERIES X 00458042SERIES 10 00459051SERIES 5100 00460052SERIES 1400 00461053SERIES 8100 004620541400/8100 CONTROLS 00463055SYSTEM 21 00464059OTHER SYSTEMS 00465060RF EQUIPMENT 00466070EQUA-DYNE EQUIPMENT 00467090MISC. EQUIPMENT 00468099SKY 515 004690** TABSYS/TABSYN - SYST CODE 004700SSYSTEM 004710NNON-SYSTEM 004720** TABSTC/TABSTN - STATUS CODE 004730EENTERED 004740NNO BID 004750ÐÐPPENDING 004760LLOST 004770WWON 004780CCANCELLED 004790** TABRES/TABREN - REASON LOST 0048001PRICE 0048102DELIVERY 0048203SPECIFICATIONS 0048304OTHER 0048405NOT KNOWN 004850** NUL ARRAY 004860 004870** A6 ARRAY 004880 004890** A10 ARRAY 004900 004910** DUN ARRAY 004920 004930** MES ARRAY 004940---MESSAGE NOT ON FILE--- 004950/* 004960_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(X® XúX006RM P120282120282(èÈÐ00010H Q006RM00020F* WORK ORDER TRANSACTION INPUT/UPDATE PROGRAM (X006RM) 00030F* REVISED 10-14-82 11:20 AM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FWOINPUT UC F 32R27AI 1 DISK A 00070FPMMST2 IC F 674R12AI 1 DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A6 6 6 1 CALL READ PARAM. 00120E A10 10 10 1 A INPUT DATA ARRAY 00130E NUM 1 4 3 0 NUMERIC FIELD NO.'S 00140E DUN 6 6 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E LOC 1 6 3 0 00170E BIT 256 1 SCREEN CONTR. CHAR 00180E CALL 5 6 CALL STACK 00190I******************************************************************* 00200IBITHEX BT 00210I 1 256 BIT 00220I******************************************************************** 00230IWOINPUT WI 00240I* WORK ORDER INPUT TRANSACTION 00250I* PART # ÐÐ00260I 1 12 WIPN 00270I* DUE DATE 6N 00280I 13 180WIDUE 00290I* WORK ORDER # 6A 00300I 19 24 WIORD 00310I* SPLIT # 3N 00320I 25 270WISPLT 00330I* QTY 7P 00340I P 28 310WIQTY 00350I* RECORD STATUS 1A 00360I 32 32 WISTAT 00370I******************************************************************** 00380IPMMST2 PM 00390I 31 59 PMDESC 00400I 674 674 PMSTAT 00410I******************************************************************* 00420IMGFILE MG 00430I* MESSAGE FILE. 00440I 1 35 MGTEXT 00450C******************************************************************** 00460C* INITIALIZE 00470C EXSR SR101 1-TIME INIT 00480C MOVE ' ' BLK12 12 STUPIDITY 00490C MOVE BLK12 TPN 12 STUPIDITY 00500C*------------------------------------------------------------------ ÐÐ00510C START TAG 00520C* SET-UP 1ST FIELD NO. 00530C Z-ADD1 F 30 FIELD # 00540C EXITFQCLFCR LF/CR 00550C 1 ADD LINE LINE 30 00560C EXSR SR210 NEW PAGE SR 00570C Z-ADD0 TQTY WO QTY 00580C MOVE ' ' DUN 00590C GOTO READ 00600C*------------------------------------------------------------------ 00610C NEXT TAG 00620C* SET-UP NEXT FIELD NO. 00630C 1 ADD F F FIELD # 00640C*----------------------------------------------------------------- 00650C READ TAG 00660C* READ DATA FROM TERMINAL. 00670C SETOF 9096 00680C F COMP 5 54 00690C 54 GOTO NEXT 00700C EXSR SR102 VALIDATE FIELD # 00710C 55 GOTO UPDATE DONE 00720C EXSR SR201 IDENTIFY-F 00730C SETON 69 00740C EXSR SR72 PROMPT 00750C SETOF 69 ÐÐ00760C EXSR SR75 READ TERMINAL 00770C 98 GOTO GOODBY GOODBY 00780C 94 GOTO MENU MENU REQUEST 00790C N77N88 EXSR SR104 EDIT INPUT FIELD 00800C 96 ERROR 00810CORN77N88 EXSR SR72 REWRITE INPUT DATA 00820C 93 GOTO NEWITM NEW ITEM 00830C 92 GOTO JUMP FIELD JUMP REQST 00840C 91 GOTO NEXT SKIP FORWARD 00850C 89 F SUB 1 F SKIP BACKWARD 00860C 89 F COMP 5 54 00870C 89 54 Z-ADD4 F 00880C 89 GOTO READ " " 00890C 88 SETOF 90 SPACE FILL 00900C 88 SETON 77 " " 00910C 87 GOTO START 00920C 86 GOTO UPDATE UPDATE 00930C 85 GOTO READ REPEAT 00940C 96 GOTO ERROR ERROR 00950C N77 GOTO NEXT NO DATA INPUT 00960C*------------------------------------------------------------------ 00970C PROCES TAG 00980C* PROCESS INPUT DATA 00990C EXSR SR103 MOVE DATA 01000C N96 EXSR SR104 EDIT DATA ÐÐ01010C EXSR SR72 REWRITE DATA 01020C 96 GOTO ERROR ERROR 01030C GOTO NEXT 01040C*------------------------------------------------------------------ 01050C UPDATE TAG 01060C* UPDATE DATA BASE. 01070C EXSR SR105 FINAL EDIT 01080C 96 GOTO ERROR ERROR 01090C EXSR SR81 UPDATE WOINPUT 01100C GOTO START 01110C*------------------------------------------------------------------- 01120C JUMP TAG 01130C* SET-UP JUMP TO REQUESTED FIELD 01140C 1 ADD W W 30 01150C W COMP 10 54 01160C 54 Z-ADD318 M 50 96 FLAG ERROR 01170C 54 GOTO ERROR BAD ESC 01180C MOVE '000' W3A 3 01190C MOVEAA10,W W3A 01200C Z-ADD3 W2N 20 01210C EXIT SUBRAJ R. JUSTIFY 01220C RLABL W2N 01230C RLABL W3A 01240C MOVE W3A F NEW FIELD # 01250C GOTO READ ÐÐ01260C*-------------------------------------------------------------------- 01270C ERROR TAG 01280C EXSR SR102 VALIDATE FIELD # 01290C EXSR SR89 GET MSG 01300C EXSR SR73 PUT MSG 01310C GOTO READ 01320C*------------------------------------------------------------------ 01330C NEWITM TAG 01340C* SET-UP LINK FOR NEW ITEM 01350C MOVEL'Q006RM' PROG 8 01360C GOTO END 01370C*------------------------------------------------------------------- 01380C MENU TAG 01390C* SET-UP LINK TO MENU 01400C MOVEL'QQWO50' PROG 01410C GOTO END 01420C*-------------------------------------------------------------------- 01430C GOODBY TAG 01440C* LINK TO SIGN-OFF 01450C MOVEL'GOODBY' PROG 01460C GOTO END 01470C*------------------------------------------------------------------- 01480C END TAG 01490C EXITFCHAIN LINK TO NEXT PROG 01500C RLABL PROG ÐÐ01510C********************************************************************* 01520CSR SR1 BEGSR 01530C* EDIT TRAN CODE 01540CSR EXSR SR203 CLASSIFY TRAN 01550CSRN60N61N62 Z-ADD300 M 50 96 FLAG ERROR 01560CSR ENDSR 01570C******************************************************************* 01580CSR SR2 BEGSR 01590C* EDIT PART # 01600CSR MOVE BLK29 PMDESC 01610CSR TPN COMP BLK12 54 01620CSRN54 Z-ADD299 M 96 FLAG ERROR 01630CSRN54 GOTO END2 01640CSR MOVELTPN NUMPN 100 OUTPUT PN 01650CSR SETOF 61 01660CSR TPN CHAINPMMST2 60 GET PART MASTER 01670CSRN60N61 GOTO END2 GOT IT. 01680CSR Z-ADD291 M 96 FLAG ERROR 01690CSR END2 ENDSR 01700C********************************************************************* 01710CSR SR3 BEGSR 01720C* EDIT DUE DATE 01730CSR TDUE COMP 0 54 01740CSRN54 Z-ADD242 M 96 FLAG ERROR 01750CSR ENDSR ÐÐ01760C********************************************************************** 01770CSR SR4 BEGSR 01780C* EDIT WORK ORDER # 01790CSR TORD COMP BLK6 54 01800CSRN54 Z-ADD263 M 96 FLAG ERROR 01810CSR ENDSR 01820C*********************************************************************** 01830CSR SR5 BEGSR 01840C* EDIT SPLIT # 01850CSR EXSR SR106 GET MAST,ETC. 01860CSR ENDSR 01870C******************************************************************* 01880CSR SR6 BEGSR 01890C* EDIT QTY 01900CSR TQTY COMP 0 54 01910CSRN54 Z-ADD184 M 96 FLAG ERROR 01920CSR ENDSR 01930C********************************************************************** 01940CSR SR71 BEGSR 01950C* PUT HEADINGS TO TERMINAL 01960CSR SETON 71 01970CSR EXCPT PUT HEADINGS 01980CSR SETOF 71 01990CSR Z-ADD7 LINE 30 SCREEN LINE # 02000CSR ENDSR ÐÐ02010C********************************************************************* 02020CSR SR72 BEGSR 02030C* PUT DATA TO TERMINAL 02040CSR EXITFQMOVUP BUMP CURSOR UP 02050CSR SETON 72 02060CSR EXCPT PUT DATA 02070CSR SETOF 72 02080CSRN69 GOTO END72 NOT PROMPT 02090CSR EXITFQCCR CR ONLY 02100CSR 1 ADD LOC,F X 30 02110CSR MOVE BIT,X W2A 2 02120CSR MOVELBIT,1 W2A 02130CSR EXITFQMOVR BUMP CURSOR RIGHT 02140CSR RLABL W2A 02150CSR EXITFQBELL RING BELL 02160CSR END72 ENDSR 02170C*********************************************************************** 02180CSR SR73 BEGSR 02190C* PUT ERROR MESSAGE TO TERMINAL 02200CSR SETON 73 02210CSR EXCPT PUT MSG 02220CSR SETOF 73 02230CSR 96 Z-ADDM LSTERR 02240CSR EXSR SR210 NEW PAGE SR 02250CSRN54 EXITFQMOVUP MOVE CURSOR UP ÐÐ02260CSR ENDSR 02270C******************************************************************* 02280CSR SR75 BEGSR 02290C* READ FROM TERMINAL 02300CSR SETOF 779096 02310CSR SETOF 939291 02320CSR SETOF 898887 02330CSR SETOF 8685 02340CSR MOVE BIT,6 A6,2 BUF LENGTH 02350CSR MOVEAA6 W6A 6 02360CSR MOVE BLK10 W10A 10 BUFFER 02370CSR EXITFQWREED READ TERM 02380CSR RLABL W10A 02390CSR RLABL W6A 02400CSR MOVEAW10A A10 02410CSR MOVE BLK10 W10A 02420CSR Z-ADD1 W 30 02430CSR '\' LOKUPA10,W 90 FLAG ESC 02440CSRN90 GOTO T75B NOT ESC 02450CSR 1 ADD W W 02460CSR W COMP 10 54 02470CSR 54 GOTO T75A BAD ESC 02480CSR A10,W COMP 'G' 98 GOODBY 02490CSR A10,W COMP 'E' 94 MENU 02500CSR A10,W COMP 'N' 93 NEW ITEM ÐÐ02510CSR A10,W COMP 'J' 92 JUMP 02520CSR A10,W COMP 'F' 91 SKIP FRWRD 02530CSR A10,W COMP 'B' 89 SKIP BKWRD 02540CSR A10,W COMP 'S' 88 SPACE FILL 02550CSR A10,W COMP 'H' 87 HOME 02560CSR A10,W COMP 'U' 86 UPDATE 02570CSR A10,W COMP 'R' 85 REPEAT 02580CSR 98 02590COR 94 02600COR 93 02610COR 92 02620COR 91 02630COR 89 02640COR 88 02650COR 87 02660COR 86 02670COR 85 GOTO END75 GOOD ESC 02680C*------------------------------------------------------------------ 02690CSR T75A TAG 02700C* FLAG BAD ESC INPUT 02710CSR Z-ADD318 M 96 FLAG ERROR 02720CSR GOTO END75 02730C*-------------------------------------------------------------------- 02740CSR T75B TAG 02750C* MOVE DATA ÐÐ02760CSR Z-ADD1 W 02770CSR ' ' LOKUPA10,W 77 02780CSR 77 MOVEAA10,W W10A INPUT DATA 02790C*-------------------------------------------------------------------- 02800CSR END75 TAG 02810C* INIT PREV ERROR MSG. 02820CSR LSTERR COMP 0 54 02830CSR 54 MOVE BLK35 MGTEXT 02840CSR 54 EXSR SR73 BLANK MESSAGE 02850CSR Z-ADD0 LSTERR 50 02860CSR ENDSR 02870C********************************************************************** 02880CSR SR80 BEGSR 02890C* GET MASTER RECORD 02900CSR SETOF 6465 02910CSR MOVELTPN W27A 27 02920CSR MOVELTDUE W15A 15 02930CSR MOVELTORD W9A 9 02940CSR MOVE TSPLT W9A 02950CSR MOVE W9A W15A 02960CSR MOVE W15A W27A 02970CSR W27A CHAINWOINPUT 64 GET MASTER 02980CSRN64 WISTAT COMP 'D' 65 FLAG DELETE 02990CSRN64N65 TQTY COMP 0 54 03000CSRN64N65N54 Z-ADDWIQTY TQTY WO QTY ÐÐ03010CSR ENDSR 03020C********************************************************************** 03030CSR SR81 BEGSR 03040C* UPDATE WOINPUT FILE. 03050CSR SETON 81 03060CSR EXCPT UPDATE WOINPUT 03070CSR SETOF 81 03080CSR ENDSR 03090C********************************************************************** 03100CSR SR89 BEGSR 03110C* GET MESSAGE MASTER 03120CSR M CHAINMGFILE 54 03130CSR 54 MOVE BLK35 MGTEXT 03140CSR 54 MOVELM MGTEXT 03150CSR 54 MOVE MES,1 MGTEXT 03160CSR ENDSR 03170C*********************************************************************** 03180CSR SR101 BEGSR 03190C* 1-TIME INITIALIZE 03200CSR MOVE BIT,1 NUL 03210CSR MOVE BIT,1 A6 03220CSR Z-ADD6 FLIMIT 30 TOTAL NUMB FIELDS 03230CSR MOVE ' ' BLK10 10 03240C* DEFINE WORK FIELDS,ETC. 03250CSR MOVE ' ' BLK35 35 ÐÐ03260CSR MOVE ' ' BLK12 12 03270CSR MOVE ' ' BLK29 29 03280CSR MOVE ' ' BLK6 6 03290C* PUT 1ST HEADING 03300CSR EXSR SR71 PUT HEADING 03310C* 03320CSR ENDSR 03330C********************************************************************** 03340CSR SR102 BEGSR 03350C* VALIDATE FIELD NO. 03360CSR F COMP 0 54 03370CSRN54 Z-ADD1 F 03380CSR F COMP FLIMIT 55 03390CSR 55 Z-ADD1 F 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR103 BEGSR 03430C* MOVE INPUT DATA 03440CSR EXSR SR201 IDENTIFY-F 03450CSR EXSR SR202 R. JUSTIFY 03460CSR 01 MOVELW10A TTCODE 1 TRAN CODE 03470CSR 02 MOVELW10A TPN 12 PART # 03480CSR 03 MOVE W10A TDUE 60 DUE DATE 03490CSR 04 MOVELW10A TORD 6 WORK ORDER # 03500CSR 05 MOVE W10A TSPLT 30 SPLIT # ÐÐ03510CSR 06 MOVE W10A TQTY 70 QTY 03520CSR MOVE ' ' DUN,F EDIT FLAG 03530CSR 02 03540COR 03 03550COR 04 03560COR 05 MOVE ' ' DUN,5 03570CSR ENDSR 03580C******************************************************************** 03590CSR SR104 BEGSR 03600C* EDIT INPUT DATA 03610CSR 01 EXSR SR1 03620CSR 02 EXSR SR2 03630CSR 03 EXSR SR3 03640CSR 04 EXSR SR4 03650CSR 05 EXSR SR5 03660CSR 06 EXSR SR6 03670CSR 96 MOVE ' ' DUN,F EDIT FLAG 03680CSRN96 MOVE 'X' DUN,F 03690CSR ENDSR 03700C*********************************************************************** 03710CSR SR105 BEGSR 03720C* FINAL EDIT 03730CSR SETON 79 FINAL EDIT FLAG 03740CSR Z-ADD1 F 96 03750C*-------------------------------------------------------------------- ÐÐ03760CSR T105A TAG 03770CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03780CSRN54 GOTO END105 03790CSR EXSR SR201 IDENTIFY-F 03800CSR EXSR SR104 EDIT 03810CSRN96 GOTO T105A 03820C*-------------------------------------------------------------------- 03830CSR END105 TAG 03840CSR SETOF 79 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR106 BEGSR 03880C* EDIT DATA BASE. 03890CSR EXSR SR203 CLASSIFY TRAN 03900CSR 60 GOTO T106A ADD TRAN 03910CSR 61 GOTO T106D CHANGE TRAN 03920CSR 62 GOTO T106F DELETE TRAN 03930C* FLAG BAD TRAN CODE 03940CSR Z-ADD300 M 96 FLAG ERROR 03950CSR Z-ADD1 F FIELD # 03960CSR GOTO END106 03970C*------------------------------------------------------------------- 03980CSR T106A TAG 03990C* ADD TRANSACTION 04000CSR EXSR SR80 GET MASTER ÐÐ04010CSR 64 GOTO T106B NOT ON FILE 04020CSR 65 GOTO T106C DELETED MASTER 04030C* FLAG DUPLICATE ADD ERROR 04040CSR Z-ADD301 M 96 FLAG ERROR 04050CSR Z-ADD1 F FIELD # 04060CSR GOTO END106 04070C*--------------------------------------------------------------------- 04080CSR T106B TAG 04090C* ADD-- MAST NOT ON FILE 04100CSR GOTO END106 04110C*--------------------------------------------------------------------- 04120CSR T106C TAG 04130C* ADD-- MAST IS DELETED 04140CSR MOVE 'A' WISTAT RECORD STATUS 04150CSR GOTO END106 04160C*---------------------------------------------------------------------- 04170CSR T106D TAG 04180C* CHANGE TRANSACTION. 04190CSR EXSR SR80 GET MASTER 04200CSRN64N65 GOTO T106E GOT IT 04210C* FLAG NO MASTER ERROR 04220CSR Z-ADD302 M 96 FLAG ERROR 04230CSR Z-ADD1 F FIELD # 04240CSR GOTO END106 04250C*----------------------------------------------------------------------- ÐÐ04260CSR T106E TAG 04270C* REWRITE MASTER 04280CSR GOTO END106 04290C*----------------------------------------------------------------------- 04300CSR T106F TAG 04310C* DELETE TRANSACTION 04320CSR EXSR SR80 GET MASTER 04330CSRN64N65 GOTO T106G GOT IT 04340C* FLAG NO MASTER ERROR 04350CSR Z-ADD302 M 96 FLAG ERROR 04360CSR Z-ADD1 F FIELD # 04370CSR GOTO END106 04380C*----------------------------------------------------------------------- 04390CSR T106G TAG 04400C* DELETE MASTER. 04410CSR MOVE 'D' WISTAT RECORD STATUS 04420CSR END106 ENDSR 04430C************************************************************************ 04440CSR SR201 BEGSR 04450C* IDENTIFY FIELD NO. 04460CSR F COMP 1 01 04470CSR F COMP 2 02 04480CSR F COMP 3 03 04490CSR F COMP 4 04 04500CSR F COMP 5 05 ÐÐ04510CSR F COMP 6 06 04520CSR ENDSR 04530C********************************************************************** 04540CSR SR202 BEGSR 04550C* RIGHT JUSTIFY 04560CSR F LOKUPNUM 54 04570CSRN54 GOTO END202 NOT NUMERIC FIELD 04580CSR Z-ADD10 W2N 20 04590CSR EXIT SUBRAJ R. JUSTIFY 04600CSR RLABL W2N 04610CSR RLABL W10A 04620CSR END202 ENDSR 04630C*********************************************************************** 04640CSR SR203 BEGSR 04650C* CLASSIFY TRAN CODE 04660CSR TTCODE COMP 'A' 60 ADD 04670CSR TTCODE COMP 'C' 61 CHANGE 04680CSR TTCODE COMP 'D' 62 DELETE 04690CSR ENDSR 04700C****************************************************************** 04710CSR SR210 BEGSR 04720C* CHK END OF PAGE-- PUT HEADINGS 04730CSR LINE COMP 28 54 54 04740CSR 54 EXSR SR71 PUT HEADING 04750CSR ENDSR ÐÐ04760O****************************************************************** 04770OWOINPUT EADD 81 64 04780O W27A 27 04790O TQTY 31P 04800O 32 'A' 04810O*------------------------------------------------------------------- 04820O E 81N64 04830O TQTY 31P 04840O WISTAT 32 04850O******************************************************************** 04860OTERM132 E 71 04870O E 71 04880O 73 'WORK ORDER INPUT' 04890O E 71 04900O E 71 04910O 4 'TRAN' 04920O 14 'PART-NO.' 04930O 29 'DESCRIPTION' 04940O 57 'DATE-DUE' 04950O 71 'WORK-ORDER' 04960O 84 'QUANTITY' 04970O*---------------------------------------------------------------- 04980O E 71 04990O 3 '(1)' 05000O 12 '(2)' ÐÐ05010O 54 '(3)' 05020O 68 '(4)' 05030O 81 '(6)' 05040O E 71 05050O*---------------------------------------------------------------- 05060O E 72 05070O* PUT DATA 05080O TTCODE 2 05090O NUMPN 18 ' - - ' 05100O PMDESC 49 05110O TDUE 59 ' - - ' 05120O TORD 71 05130O TQTY 2 84 05140O*------------------------------------------------------------- 05150O E 73 05160O* PUT MESSAGE 05170O 96 5 '*****' 05180O N96 5 ' ' 05190O MGTEXT 40 05200O BIT,8 132 ** NUL ARRAY 005210 005220** A6 ARRAY 005230 005240** #A ARRAY 005250ÐÐ 005260** NUM ARRAY 005270002 005280003 005290005 005300006 005310** DUN ARRAY 005320 005330** MES ARRAY 005340---MESSAGE NOT ON FILE--- 005350** LOC ARRAY 005360002 1 TTCODE 005370007 2 TPN 005380052 3 TDUE 005390066 4 TORD 005400074 5 TSPLT 005410076 6 TQTY 005420/* 005430_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(k© kmX031WM P999999120282(èÈÐ00010H Q031WM00020F* WORK ORDER DISPLAY PROGRAM. (X031WM) 00030F* REVISED 1-12-82 2:45 PM. 00040F* 00050FBIT44 IP F 44 DISK 00060FWMMAST IC F 470R 6AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FCRTFILE IC F 256R DISK 00100FCALENDARIC F 22R 7AI 1 DISK 00110FPRODWO IT F 80 EDISK 00120FTERM132 O F 132 5 00130E***************************************************************** 00140E PRODWO TABPWO 1 4 1 PROD WO PREFIXES 00150E NUL 1 132 1 NULL CHAR 00160E A9 9 9 1 SR75 READ CRT BUF 00170E A40 40 40 1 A SR75 READ CRT BUF 00180E DUN 1 1 1 A EDIT VMPLT FLAG 00190E RCD 1 26 7 0 RECEIVED QTYS 00200E OPN 1 26 7 0 OPEN QTYS 00210E REL 1 26 7 0A RELEASED QTYS 00220E NR 1 26 7 0A NOT REL QTYS 00230E LN 1 3 10 LOT CODE NAMES 00240E NAM 1 1 15 NAME ARRAY 00250E BIT 44 1 SCREEN CONTR. CHAR ÐÐ00260E PLT 8 3 0 PART MAST LEAD TIMES 00270E WMD 26 6 0A 00280E WMQ 26 7 0A 00290E WLT 26 3 0 00300I******************************************************************** 00310IBIT44 BT 00320I 1 44 BIT 00330I****************************************************************** 00340ICRTFILE CR 00350I 68 73 CRRET 00360I 74 79 CRMENU 00370I****************************************************************** 00380IPMMST2 PM 00390I* PART NUMBER 10N 00400I 1 100PMPN 00410I* NUMB OF COMPONENTS 3P 00420I P 13 140PMNOBM 00430I* PART DESCRIPTION 29A 00440I 31 59 PMDESC 00450I* ENG CHANGE LEVEL 2A 00460I 70 71 PMECHG 00470I* DRAWING SIZE 1A 00480I 82 82 PMSIZE 00490I* SOURCE CODE 2A 00500I 94 95 PMSC ÐÐ00510I* LEAD TIMES 3P X 8 00520I P 113 128 PLT 00530I* ON-HAND BALANCE 7P 00540I P 311 3140PMOHB 00550I* PLAN WORK ORDER BAL 7P 00560I P 351 3540PMPWOB 00570I* RELEASED WORK ORDER BAL 7P 00580I P 355 3580PMRWOB 00590I* RECORD STATUS 1A 00600I 674 674 PMSTAT 00610I******************************************************************** 00620IMGFILE MG 00630I 1 35 MGTEXT 00640I******************************************************************** 00650ICALENDARCA 20 1 CC 00660I* CALENDAR DATE RECORD. 00670I 2 70CACAL 00680I 14 170CAMDAY 00690I 18 200CAWK 00700I 21 220CADOW 00710I*------------------------------------------------------------------- 00720I CB 21 1 CM 00730I* MFG DATE RECORD. 00740I 4 70CAMDAY 00750I 8 130CACAL ÐÐ00760I 18 200CAWK 00770I 21 220CADOW 00780I*------------------------------------------------------------------- 00790I GG 02 00800I******************************************************************** 00810IWMMAST WM 00820I* WORK ORDER MASTER. 00830I* WORK ORDER # 6A 00840I 1 6 WMWO 00850I* DESCRIPTION 40A 00860I 7 46 WMDESC 00870I 7 26 WM20 00880I* COST ARRAY (ACTUAL $) 11.3P X 6 00890I* 1 = LABOR 00900I* 2 = LABOR BURDEN 00910I* 3 = MATERIAL 00920I* 4 = MATERIAL BURDEN 00930I* 5 = NOT USED 00940I* 6 = NOT USED 00950I* * * * * P 47 82 WA$ 00960I* TRANSFERRED TO STORES $ 11.3P 00970I P 83 883WMSTK$ 00980I* VARIANCE TAKEN $ 11.3P 00990I P 89 943WMVAR$ 01000I* QTY RECEIVED 7P ÐÐ01010I P 95 980WMQRCD 01020I* SCHEDULE. 01030I* DATES 6N X 26 01040I 99 254 WMD 01050I* QTYS 7P X 26 01060I P 255 358 WMQ 01070I* LEAD TIMES 3P X 26 01080I P 359 410 WLT 01090I* CLOSE DATE 6N 01100I 411 4160WMCLOS 01110I* QTY RELEASED 7P 01120I P 417 4200WMQREL 01130I* PART NO. 10N 01140I 422 4310WMPN 01150I* DRAWING REV. 2A 01160I 432 433 WMREV 01170I* UPDATE COUNTER 3P 01180I* INCREMENTED BY 1 EACH TIME 01190I* RECORD UPDATED BY Q031WM. 01200I P 434 4350WMCHG 01210I* DATE LAST TRAN 6N 01220I 436 4410WMDLT 01230I* LAST PULL # 3P 01240I P 442 4430WMPULL 01250I* ALTERNATE BILL OF MATERIAL 10N ÐÐ01260I 444 4530WMABM 01270I* ALTERNATE ROUTING 10N 01280I 454 4630WMAR 01290I* RECORD STATUS 1A 01300I 470 470 WMSTAT 01310C******************************************************************** 01320C* INITIALIZE 01330C EXSR SR101 1-TIME INIT 01340C*------------------------------------------------------------------ 01350C START TAG 01360C* SET-UP 1ST FIELD NO. 01370C SETOF 6031 01380C MOVE ' ' DUN INIT EDIT ARRAY 01390C MOVE ' ' TWO 01400C EXSR SR205 INIT WM FIELDS 01410C Z-ADD1 F 30 FIELD # 01420C SETOF 70 01430C EXSR SR70 NEW PAGE 01440C EXSR SR71 PUT HEADING 01450C GOTO READ 01460C*------------------------------------------------------------------ 01470C NEXT TAG 01480C* SET-UP NEXT FIELD NO. 01490C 1 ADD F F FIELD # 01500C*----------------------------------------------------------------- ÐÐ01510C READ TAG 01520C* READ DATA FROM TERMINAL. 01530C DUN,1 COMP ' ' 54 01540C N54 Z-ADD1 F 01550C SETOF 909677 01560C SETOF 40 01570C EXSR SR102 VALIDATE FIELD # 01580C 55 GOTO UPDATE DONE 01590C EXSR SR201 IDENTIFY-F 01600C SETON 69 01610C EXSR SR72 PROMPT 01620C SETOF 69 01630C EXSR SR75 READ TERMINAL 01640C MOVE BLK35 MGTEXT MSG INIT 01650C*------------------------------------------------------------------- 01660C ESCAPE TAG 01670C 98 GOTO GOODBY GOODBY 01680C 94 GOTO MENU MENU REQUEST 01690C 93 GOTO NEWITM NEW ITEM 01700C 96 01710COR 90 EXSR SR72 DISPLAY DATA 01720C 96 EXSR SR89 GET MGFILE 01730C 96 GOTO READ ERROR 01740C N77 GOTO EDIT NO DATA INPUT 01750C*------------------------------------------------------------------ ÐÐ01760C PROCES TAG 01770C* PROCESS INPUT DATA 01780C EXSR SR103 MOVE DATA 01790C*------------------------------------------------------------------- 01800C EDIT TAG 01810C EXSR SR104 EDIT DATA 01820C N96 EXSR SR72 REWRITE DATA 01830C 96 EXSR SR89 GET MGFILE 01840C 96 GOTO READ ERROR 01850C GOTO NEXT 01860C*------------------------------------------------------------------ 01870C UPDATE TAG 01880C* UPDATE DATA BASE. 01890C EXSR SR106 UPDATE 01900C GOTO START 01910C*-------------------------------------------------------------------- 01920C ERROR TAG 01930C EXSR SR102 VALIDATE FIELD # 01940C EXSR SR89 GET MSG 01950C GOTO READ 01960C*------------------------------------------------------------------ 01970C NEWITM TAG 01980C* SET-UP LINK FOR NEW ITEM 01990C GOTO START 02000C*------------------------------------------------------------------- ÐÐ02010C MENU TAG 02020C* SET-UP LINK TO MENU 02030C MOVELCRMENU PROG 8 02040C GOTO END 02050C*-------------------------------------------------------------------- 02060C GOODBY TAG 02070C* LINK TO SIGN-OFF 02080C MOVEL'GOODBY' PROG 02090C GOTO END 02100C*------------------------------------------------------------------- 02110C END TAG 02120C PROG COMP BLK8 54 02130C N54 MOVELCRMENU PROG 02140C EXITFCHAIN LINK TO NEXT PROG 02150C RLABL PROG 02160C*------------------------------------------------------------------- 02170C ENDJOB TAG 02180C******************************************************************** 02190CSR SR1 BEGSR 02200C* EDIT WORK ORDER NO. 02210CSR MOVELTWO PREFIX 1 02220CSR PREFIX LOKUPTABPWO 70 FLAG INVENTORY ITEM 02230CSR MOVE TWO W5A 5 02240CSR Z-ADD5 W2N 02250CSR EXIT SUBRAJ R.J. ÐÐ02260CSR RLABL W2N 02270CSR RLABL W5A 02280CSR MOVE W5A TWO 02290CSR MOVE W5A W5N 50 02300CSR W5N COMP 0 54 02310CSRN54 Z-ADD618 M 50 96 FLAG ERROR 02320CSRN54 GOTO END1 02330CSR EXSR SR80 GET WMMAST 02340CSRN30N31 GOTO T1B GOT IT 02350C* WORK ORDER NOT ON FILE. 02360CSR Z-ADD302 M 96 FLAG ERROR 02370CSR EXSR SR205 INIT WMMAST 02380CSR GOTO END1 02390C*------------------------------------------------------------------- 02400CSR T1B TAG 02410C* WORK ORDER IS ON FILE. 02420CSR SETON 33 02430CSR EXSR SR252 ALLOC RELEASE QTYS 02440CSR SETOF 33 02450CSR SETON 32 02460CSR EXSR SR252 ALLOC RECEIPT QTYS 02470CSR SETOF 32 02480CSR END1 ENDSR 02490C******************************************************************** 02500CSR SR67 BEGSR ÐÐ02510C* MOVE CURSOR-UP 1-LINE. 02520CSR EXITFQMOVUP MOVE CURSOR UP 02530CSR ENDSR 02540C***************************************************************** 02550CSR SR69 BEGSR 02560C* POSITION CURSOR 02570CSR EXITFQXYPOS POSITION CURSOR 02580CSR RLABL W6A 02590CSR ENDSR 02600C******************************************************************** 02610CSR SR70 BEGSR 02620C* CLEAR NEW PAGE. 02630CSR EXITFZCPAGE CLEAR PAGE 4 02640CSR ENDSR 02650C********************************************************************** 02660CSR SR71 BEGSR 02670C* PUT HEADINGS TO TERMINAL 02680CSR SETON 71 02690CSR EXCPT PUT HEADINGS 02700CSR SETOF 71 02710CSR ENDSR 02720C********************************************************************* 02730CSR SR72 BEGSR 02740C* PUT DATA TO TERMINAL 02750CSR 70 WMREV COMP ' ' 55 ÐÐ02760CSR 91 ADD F W3N 30 02770CSR MOVELW3N W6A 6 02780CSR MOVE '001' W6A 02790CSR EXSR SR69 POSITION CURSOR 02800CSR SETON 72 02810CSR EXCPT PUT DATA 02820CSR SETOF 72 02830CSR ENDSR 02840C******************************************************************* 02850CSR SR75 BEGSR 02860C* READ FROM TERMINAL 02870CSR SETOF 779096 02880CSR SETOF 93 02890CSR MOVE BIT,36 BUFLGT 2 READ BUFFER LGTH 02900CSR MOVE BLK40 W40A 40 BUFFER 02910CSR MOVE BIT,28 A9,1 02920CSR MOVE '8' A9,2 02930CSR F ADD 92 W3N 30 02940CSR MOVE W3N W3A 3 02950CSR MOVEAW3A A9,3 02960CSR MOVEA'047' A9,6 02970CSR MOVE BIT,8 A9,9 02980CSR MOVEAA9 W9A 9 02990CSR EXITFQPREED READ FROM TERMINAL 03000CSR RLABL W9A ÐÐ03010CSR RLABL W40A READ BUFFER 03020CSR RLABL BUFLGT READ BUFFER LGTH 03030CSR MOVEAW40A A40 INPUT DATA ARRAY 03040CSR MOVE BLK40 W40A INIT INPUT ARRAY 03050CSR Z-ADD1 W 30 03060CSR '\' LOKUPA40,W 90 FLAG ESC 03070CSRN90 GOTO T75B NOT ESC 03080CSR 1 ADD W W 03090CSR W COMP 40 54 03100CSR 54 GOTO T75A BAD ESC 03110CSR A40,W COMP 'G' 98 GOODBY 03120CSR A40,W COMP 'E' 94 MENU 03130CSR A40,W COMP 'N' 93 NEW ITEM 03140CSRN93 A40,W COMP 'D' 93 DONE 03150CSR 98 03160COR 94 03170COR 93 GOTO END75 GOOD ESC 03180C*------------------------------------------------------------------ 03190CSR T75A TAG 03200C* FLAG BAD ESC INPUT 03210CSR Z-ADD318 M 96 FLAG ERROR 03220CSR GOTO END75 03230C*-------------------------------------------------------------------- 03240CSR T75B TAG 03250C* MOVE DATA ÐÐ03260CSR Z-ADD1 W 03270CSR ' ' LOKUPA40,W 77 03280CSR 77 MOVEAA40,W W40A INPUT DATA 03290CSR GOTO END75 03300C*------------------------------------------------------------------- 03310CSR END75 TAG 03320CSR MOVE BLK35 MGTEXT 03330CSR ENDSR 03340C*************************************************************** 03350CSR SR76 BEGSR 03360C* PUT SCHEDULE HEADINGS 03370CSR 40 GOTO T76B 03380CSR MOVE '104001' W6A 03390CSR EXSR SR69 MOVE CURSOR 03400CSR SETON 75 03410CSR EXCPT PUT SCHED HEADING 03420CSR SETOF 75 03430C*------------------------------------------------------------------- 03440CSR T76B TAG 03450C* PUT SCHEDULE DATA TO CRT 03460CSR S ADD 105 W3N 30 03470CSR W3N SUB 1 W3N 03480CSR MOVELW3N W6A 03490CSR MOVE '001' W6A X-Y POS 03500CSR EXSR SR69 PUT CURSOR ÐÐ03510CSR SETON 76 03520CSR EXCPT PUT SCHED DATA 03530CSR SETOF 76 03540CSR SETON 40 03550CSR ENDSR 03560C********************************************************************** 03570CSR SR80 BEGSR 03580C* GET WORK ORDER MASTER 03590CSR MOVE BLK35 PMDESC 03600CSR MOVE BLK35 ALTDES 29 03610CSR MOVE BLK35 ALTRTG 29 03620CSR SETOF 31 03630CSR TWO CHAINWMMAST 30 GET WO MAST 03640CSRN30 WMSTAT COMP 'D' 31 FLAG DELETE 03650CSR Z-ADD0 BEGWOB 70 BEGIN WO QTY TOTAL 03660CSR 30 03670COR 31 GOTO END80 03680CSR WMAR COMP 0 54 03690CSRN54 GOTO T80 NO ALT ROUTING 03700CSR MOVELWMAR W12A 03710CSR EXSR SR83 GET PART MAST 03720CSRN60 MOVE PMDESC ALTRTG 03730CSR MOVE BLK35 PMDESC 03740C*------------------------------------------------------------------- 03750CSR T80 TAG ÐÐ03760CSR WMABM COMP 0 54 03770CSRN54 GOTO T80A NO ALT BILL MATERIAL 03780CSR MOVELWMABM W12A 12 03790CSR EXSR SR83 GET PART MASTER 03800CSRN60 MOVE PMDESC ALTDES 03810CSR MOVE BLK35 PMDESC 03820C*---------------------------------------------------------------- 03830CSR T80A TAG 03840CSR MOVELWMPN W12A 03850CSR EXSR SR83 GET PART MASTER 03860CSR END80 ENDSR 03870C*************************************************************** 03880CSR SR83 BEGSR 03890C* GET PART MASTER 03900CSR MOVE ' ' W12A 12 03910CSR W12A CHAINPMMST2 60 GET PMMST2 03920CSRN60 PMSTAT COMP 'D' 60 FLAG DELETE 03930CSRN60 XFOOTPLT TOTLT 30 03940CSR ENDSR 03950C*************************************************************** 03960CSR SR84 BEGSR 03970C* GET CALENDAR 03980CSR W7A CHAINCALENDAR 60 GET CALENDAR 03990CSR ENDSR 04000C***************************************************************** ÐÐ04010CSR SR89 BEGSR 04020C* GET MESSAGE MASTER 04030CSR M CHAINMGFILE 54 04040CSR 54 MOVE BLK35 MGTEXT 04050CSR 54 MOVELM MGTEXT 04060CSR ENDSR 04070C*********************************************************************** 04080CSR SR101 BEGSR 04090C* 1-TIME INITIALIZE 04100CSR MOVE BIT,1 NUL 04110CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04120CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 04130CSR MOVE ' ' BLK40 40 04140CSR MOVE ' ' BLK29 29 04150CSR MOVE ' ' BLK6 6 04160C* GET PORT # AND CRTFILE 04170CSR MOVE ' ' W8A 8 04180CSR Z-ADD0 W2N 20 04190CSR Z-ADD0 W1N 10 04200CSR MOVE ' ' W2A 2 04210CSR EXITFPGMINX GET PORT # 04220CSR RLABL W8A 04230CSR RLABL W2N 04240CSR RLABL W1N 04250CSR RLABL W2A ÐÐ04260CSR MOVE W2A PORT 20 PORT NO. 04270CSR PORT COMP 0 54 04280CSRN54 Z-ADD25 PORT DEFAULT 04290CSR PORT CHAINCRTFILE H9 04300CSR H9 GOTO END101 PROG ERROR 04310C* DEFINE WORK FIELDS,ETC. 04320CSR MOVE ' ' BLK8 8 04330CSR MOVE ' ' BLK35 35 04340CSR Z-ADDUDATE W6N 60 04350CSR EXSR SR207 REVERSE DATE 04360CSR Z-ADDW6N TODAY 60 CUR DATE(YR,MO,DAY) 04370CSR Z-ADD0 ZERO7 70 04380CSR Z-ADD0 ZERO6 60 04390CSR Z-ADD0 ZERO5 50 04400CSR Z-ADD0 ZERO3 30 04410CSR END101 ENDSR 04420C********************************************************************** 04430CSR SR102 BEGSR 04440C* VALIDATE FIELD NO. 04450CSR F COMP 0 54 04460CSRN54 Z-ADD1 F 04470CSR F COMP FLIMIT 55 04480CSR 55 Z-ADD1 F 04490CSR ENDSR 04500C******************************************************************** ÐÐ04510CSR SR103 BEGSR 04520C* MOVE INPUT DATA 04530CSR EXSR SR201 IDENTIFY-F 04540CSR 01 MOVELW40A TWO 6 WORK ORDER # 04550CSR MOVE ' ' DUN,F 04560CSR ENDSR 04570C******************************************************************** 04580CSR SR104 BEGSR 04590C* EDIT INPUT DATA 04600CSR 01 EXSR SR1 04610CSR 96 MOVE ' ' DUN,F EDIT FLAG 04620CSRN96 MOVE 'X' DUN,F 04630CSR ENDSR 04640C***************************************************************** 04650CSR SR106 BEGSR 04660C* DISPLAY WORK ORDER MASTER 04670CSR EXSR SR71 DISPLAY DATA FIELDS 04680CSR EXSR SR253 DISPLAY SCHED 04690CSR ENDSR 04700C********************************************************************** 04710CSR SR201 BEGSR 04720C* IDENTIFY F 04730CSR F COMP 1 01 04740CSR ENDSR 04750C******************************************************************** ÐÐ04760CSR SR205 BEGSR 04770C* INIT W.O. MASTER. 04780CSR MOVE BLK6 WMWO 04790CSR MOVE BLK40 WMDESC 04800CSR Z-ADD0 WMSTK$ 04810CSR Z-ADD0 WMVAR$ 04820CSR Z-ADD0 WMQRCD 04830CSR Z-ADD0 WMD 04840CSR Z-ADD0 WMQ 04850CSR Z-ADD0 WMCLOS 04860CSR Z-ADD0 WMQREL 04870CSR Z-ADD0 WMPN 04880CSR Z-ADD0 WMABM 04890CSR Z-ADD0 WMCHG 04900CSR Z-ADD0 WMPULL 04910CSR MOVE ' ' WMSTAT 04920CSR Z-ADD0 RCD 04930CSR Z-ADD0 REL 04940CSR Z-ADD0 OPN 04950CSR Z-ADD0 WLT 04960CSR Z-ADD0 NR 04970CSR MOVE BLK35 ALTDES 04980CSR ENDSR 04990C******************************************************************** 05000CSR SR207 BEGSR ÐÐ05010C* REVERSE DATE FIELDS 05020CSR MOVELW6N W2N 20 05030CSR W2N COMP 12 54 05040CSR 54 GOTO T207B 05050CSR MOVELW6N W4N 40 05060CSR MOVE W6N W2N 05070CSR MOVELW2N W6N 05080CSR MOVE W4N W6N 05090C*------------------------------------------------------------------- 05100CSR T207B TAG 05110CSR MOVEL'C' W7A 7 05120CSR MOVE W6N W7A 05130CSR EXSR SR84 GET CALENDAR 05140CSR END207 ENDSR 05150C******************************************************************** 05160CSR SR252 BEGSR 05170C* APPLY RCPTS TO SCHEDULE. 05180CSR 32 Z-ADD0 RCD 05190CSR Z-ADD1 A 05200CSR 32 Z-ADDWMQRCD SAVQTY 70 05210CSR 33 Z-ADDWMQREL SAVQTY 05220CSR 33 Z-ADD0 REL 05230C*------------------------------------------------------------------- 05240CSR T252A TAG 05250CSR 33 ZERO7 LOKUPWMQ,A 54 ÐÐ05260CSR 32 ZERO7 LOKUPREL,A 54 05270CSRN54 GOTO T252C 05280CSR 33 Z-ADDWMQ,A W7N 70 05290CSR 32 Z-ADDREL,A W7N 05300CSR SETOF 57 05310CSR SAVQTY COMP W7N 545556 05320CSR 54 32 Z-ADDW7N RCD,A 05330CSR 54 33 Z-ADDW7N REL,A 05340CSR 54 SAVQTY SUB W7N SAVQTY 57 05350CSR 54 Z-ADD0 W7N 05360CSR 55 32 Z-ADDSAVQTY RCD,A 05370CSR 55 33 Z-ADDSAVQTY REL,A 05380CSR 55 W7N SUB SAVQTY W7N 05390CSR 55 Z-ADD0 SAVQTY 57 05400CSR 56 32 Z-ADDSAVQTY RCD,A 05410CSR 56 33 Z-ADDSAVQTY REL,A 05420CSR 56 Z-ADD0 SAVQTY 57 05430CSR 56 Z-ADD0 W7N 05440CSR 57 1 ADD A A 30 05450CSR 57 A COMP 26 54 05460CSR 57N54 GOTO T252A 05470CSR GOTO END252 05480C*------------------------------------------------------------------ 05490CSR T252C TAG 05500CSR Z-ADD1 A ÐÐ05510CSR 33 ZERO7 LOKUPWMQ,A 54 05520CSR 32 ZERO7 LOKUPREL,A 54 05530CSR 33 54 Z-ADDSAVQTY REL,A 05540CSR 32 54 Z-ADDSAVQTY RCD,A 05550CSR END252 ENDSR 05560C******************************************************************** 05570CSR SR253 BEGSR 05580C* DISPLAY SCHEDULE. 05590CSR SETOF 40 05600CSR Z-ADD0 S 30 05610CSR REL SUB RCD OPN OPEN PO QTYS 05620CSR WMQ SUB REL NR NOT REL QTYS 05630C*------------------------------------------------------------------- 05640CSR T253A TAG 05650CSR 1 ADD S S 05660CSR S COMP 13 54 05670CSR 54 GOTO T253C 05680CSR WMQ,S COMP 0 54 05690CSRN54 RCD,S COMP 0 54 05700CSRN54 REL,S COMP 0 54 05710CSRN54 NR,S COMP 0 54 05720CSR 13 ADD S Y 30 05730CSRN54 WMQ,Y COMP 0 54 05740CSRN54 RCD,Y COMP 0 54 05750CSRN54 REL,Y COMP 0 54 ÐÐ05760CSRN54 NR,Y COMP 0 54 05770CSRN54 GOTO T253A 05780CSR EXSR SR76 PUT SCHEDULE 05790CSR GOTO T253A 05800C*------------------------------------------------------------------- 05810CSR T253C TAG 05820C* PUT TOTALS. 05830CSR XFOOTWMQ TOTWMQ 70 05840CSR XFOOTRCD TOTRCD 70 05850CSR XFOOTREL TOTREL 70 05860CSR XFOOTNR TOTNR 70 05870CSR XFOOTOPN TOTOPN 70 05880CSR MOVE '118001' W6A 05890CSR EXSR SR69 MOVE CURSOR 05900CSR SETON 74 05910CSR EXCPT PUT TOTALS 05920CSR SETOF 74 05930CSR MOVELBIT,1 W2A 2 05940CSR MOVE BIT,4 W2A 05950CSR MOVE BLK6 W6A 05960CSR EXITFQWREED READ FOR PAUSE 05970CSR RLABL W6A 05980CSR RLABL W2A 05990CSR EXSR SR67 MOVE UP 06000CSR ENDSR ÐÐ06010C******************************************************************** 06020CSR SR500 BEGSR 06030C* USE LEAD TIME TO COMPUTE START DATE. 06040CSR MOVEL'C' W7A 06050CSR MOVE W6N W7A 06060CSR EXSR SR84 GET CALENDAR 06070CSR 60 GOTO T500Z 06080CSR Z-ADDWLT,S W3N 30 54 06090CSRN54 Z-ADDTOTLT W3N 06100CSR CAMDAY SUB W3N W6N 54 06110CSRN54 Z-ADD1 W6N 06120CSR MOVEL'M' W7A 06130CSR MOVE W6N W7A 06140CSR EXSR SR84 GET CALENDAR 06150CSR 60 GOTO T500Z 06160CSR Z-ADDCACAL START 60 06170CSR GOTO END500 06180C*------------------------------------------------------------------- 06190CSR T500Z TAG 06200CSR Z-ADDTODAY START 06210CSR END500 ENDSR 06220O******************************************************************** 06230OTERM132 E 71 06240O BIT,28 1 06250O 8 '8091001' ÐÐ06260O 85 'WORK ORDER MASTER DISPLA' 06270O 86 'Y' 06280O UDATE 16 ' - - ' 06290O*------------------------------------------------------------------- 06300O E 71 06310O 1 ' ' 06320O*------------------------------------------------------------------- 06330O E 71 06340O OR 72 01 06350O 43 ':' 06360O 18 ' (2) WORK ORDER #' 06370O TWO 51 06380O 70 75 'PRODUCTION WORK ORDER' 06390O MGTEXT 132 06400O*------------------------------------------------------------------- 06410O E 71 06420O 43 ':' 06430O 14 ' (3) PART NO.' 06440O 70 WMPN 57 ' - - ' 06450O 70 PMDESC 88 06460O 70 93 'LT=' 06470O 70 TOTLT Z 96 06480O MGTEXT 132 06490O*------------------------------------------------------------------- 06500O E 71 ÐÐ06510O 43 ':' 06520O 22 ' (4) DRAWING REVISION' 06530O WMREV 47 06540O 70N55 51 'LATEST' 06550O 78 'CURRENT REVISION:' 06560O PMECHG 81 06570O 94 'DWG-SIZE:' 06580O PMSIZE 96 06590O MGTEXT 132 06600O*------------------------------------------------------------------- 06610O E 71 06620O 43 ':' 06630O 17 ' (5) DESCRIPTION' 06640O WMDESC 85 06650O MGTEXT 132 06660O*------------------------------------------------------------------- 06670O E 71 06680O 43 ':' 06690O 18 '(6) ALTERNATE BI' 06700O 42 'LL OF MATERIAL PART # ' 06710O WMABM 57 ' - - ' 06720O ALTDES 88 06730O MGTEXT 132 06740O*------------------------------------------------------------------- 06750O E 71 ÐÐ06760O 43 ':' 06770O 23 ' (7) ALTERNATE ROUTING' 06780O WMAR 57 ' - - ' 06790O ALTRTG 88 06800O MGTEXT 132 06810O*------------------------------------------------------------------- 06820O E 71 06830O 12 'QTY RELEASED' 06840O 43 ':' 06850O WMQREL2 54 06860O*------------------------------------------------------------------- 06870O E 71 06880O 12 'QTY RECEIVED' 06890O 43 ':' 06900O WMQRCD2 54 06910O*------------------------------------------------------------------- 06920O E 71 06930O 11 'LAST PULL #' 06940O 43 ':' 06950O WMPULLZ 48 06960O*------------------------------------------------------------------- 06970O E 71 06980O 1 ' ' 06990O E 71 07000O 1 ' ' ÐÐ07010O E 71 07020O 1 ' ' 07030O*----------------------------------------------------------------- 07040O E 75 07050O* SCHEDULE HEADING 07060O 8 'DUE-DATE' 07070O 18 'SCHED-QTY' 07080O 28 'QTY-REL' 07090O 38 'QTY-RCD' 07100O 48 'NOT-RCD' 07110O 58 'NOT-REL' 07120O 62 'LT' 07130O 76 'DUE-DATE' 07140O 86 'SCHED-QTY' 07150O 96 'QTY-REL' 07160O 106 'QTY-RCD' 07170O 116 'NOT-RCD' 07180O 126 'NOT-REL' 07190O 130 'LT' 07200O*-------------------------------------------------------------- 07210O E 76 07220O* PUT SCHEDULE DATA 07230O WMD,S 8 ' - - ' 07240O WMQ,S 2 18 07250O REL,S K 28 ÐÐ07260O RCD,S K 38 07270O OPN,S K 48 07280O NR,S K 58 07290O WLT,S Z 62 07300O WMD,Y 76 ' - - ' 07310O WMQ,Y 2 86 07320O REL,Y K 96 07330O RCD,Y K 106 07340O OPN,Y K 116 07350O NR,Y K 126 07360O WLT,Y Z 130 07370O*------------------------------------------------------------------- 07380O E 74 07390O* PUT SCHED TOTALS. 07400O 76 'TOTALS ' 07410O TOTWMQ2 86 07420O TOTRELK 96 07430O TOTRCDK 106 07440O TOTOPNK 116 07450O TOTNR K 126 07460O*------------------------------------------------------------------ 07470O E 74 07480O 24 'PRESS RETURN TO CONTINUE' 07490O******************************************************************** ** NUL ARRAY 007500ÐÐ 007510** A9 ARRAY 07520 07530** A70 ARRAY 007540 007550** DUN ARRAY 007560 007570** RCD ARRAY 07580 07590** OPN ARRAY 07600 07610** REL ARRAY 07620 07630** NR ARRAY 07640 07650** LN ARRAY 07660LOT PRICE 07670NO CHARGE 07680UNIT PRICE 07690** NAM ARRAY 07700PROD WORK ORDER 07710/* 07720_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(   X006XP P120282120282(èÈÐ00010H Q006XP00020F* GET REQTRAN FILE DUE DATE FROM WOTRAN FILE DG REL006 OK 00030FWOTRAN IP F 80 DISK 00040FREQTRAN US F 80 DISK 00050FJOBSTARTUC F 12R 6AI 1 DISK A 00060IWOTRAN WO 01 00070I 3 8 ORDER 00080I 71 760DUEDAT 00090IREQTRAN RQ 02 00100I 21 26 ORDER 00110IJOBSTARTJS 00120I 7 12 JOBDAT 00130C N01 GOTO TAG20 NOT WO 00140C ORDER CHAINJOBSTART 60 00150C GOTO END 00160C*---------------------------------------------------------------- 00170C TAG20 TAG 00180C N02 GOTO END 00190C ORDER CHAINJOBSTART 61 00200C*---------------------------------------------------------------- 00210C END TAG 00220OJOBSTARTDADD 01 60 U1 00230O ORDER 6 00240O DUEDAT 12 00250OREQTRAN D 02N61 ÐÐ00260O JOBDAT 76 /* 000270_‚ _‚_‚0IWOTRAN WO 01 00070I 3 8 ORDER 00080I 71 760DUEDAT 00090IREQTRAN RQ 02 00100I 21 26 ORDER 00110IJOBSTARTJS 00120I 7 12 JOBDAT 00130C N01 GOTO TAG20 NOT WO 00140C ORDER CHAINJOBSTART 60 00150C GOTO END 00160C*---------------------------------------------------------------- 00170C TAG20 TAG 00180C N02 GOTO END 00190C ORDER CHAINJOBSTART 61 00200C*---------------------------------------------------------------- 00210C END TAG 00220OJOBSTARTDADD 01 60 U1 00230O ORDER 6 00240O DUEDAT 12 00250OREQTRAN D 02N61 ÐÈ(& % &æX007CF P120282120282(èÈÐ00010H Q007CF00020F* PRINT CFMAST SELECTIVELY- SET-UP BY X006CF. (X007CF) 00030F* REVISED 8/01/80 3:20 PM. DG-REL006 OK. 00040FCFSELECTIP F 900 900 DISK 00050FCFMAST IS F 370 15AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070E******************************************************************** 00080E NA4 5 5 6 00090E NB4 5 5 4 0 00100E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00110E ERR 1 9 1 VERTICAL ERRORS 00120E WK2 11 11 2 00130E WK3 11 11 3 00140E BIT 33 1 00150E CFA 8 35 00160E CFN 5 3 00170E CFC 5 3 0 00180E NAC 24 1 00190E SET 9 1 0A 00200E FZIP 9 9 0A 00210E TZIP 9 9 0A 00220E NZIP 9 1 A 00230E STC 9 2 A 00240E NST 9 1 A 00250E FC 9 35 A ÐÐ00260E NFC 9 1 A 00270E MC1 9 3 A 00280E NM1 9 1 A 00290E MC2 9 3 A 00300E NM2 9 1 A 00310E SC 9 33 A 00320I******************************************************************** 00330ICFSELECTCS 10 00340I* MAIL LIST SELECTOR RECORD. 00350I* SET # 1N X 9 00360I 1 9 SET 00370I* FROM ZIP 9N X 9 00380I 10 90 FZIP 00390I* THRU ZIP 9N X 9 00400I 91 171 TZIP 00410I* NOT ZIP 1A X 9 00420I 172 180 NZIP 00430I* STATE CODE 2A X 9 00440I 181 198 STC 00450I* NOT STATE 1A X 9 00460I 199 207 NST 00470I* FRGN CTRY 35A X 9 00480I 208 522 FC 00490I* NOT FRGN CTRY 1A X 9 00500I 523 531 NFC ÐÐ00510I* MAIL CODE-1 3A X 9 00520I 532 558 MC1 00530I* NOT MAIL CODE-1 1A X 9 00540I 559 567 NM1 00550I* MAIL CODE-2 3A X 9 00560I 568 594 MC2 00570I* NOT MAIL CODE-2 1A X 9 00580I 595 603 NM2 00590I* SELECTOR CODES 3A X 11 X 9 00600I* EA CODE=1 BYTE 00610I* NOT CODE= 1 BYTE 00620I* BOTH ARE R.J. IN 3-BYTE ELEMENT 00630I* (LEFTMOST BYTE IS BLANK) 00640I 604 900 SC 00650I******************************************************************** 00660ICFMAST CF 01 00670I* CATALOG HOLDER (MAIL LIST) MASTER. 00680I* KEY AREA. 00690I* NAME KEY 15A 00700I 1 15 CFKEY 00710I* ADDRESS LINES 35A X 8 00720I 16 295 CFA 00730I* STATE CODE 2A 00740I 296 297 CFSTCD 00750I* ZIP 9P ÐÐ00760I P 298 3020CFZIP 00770I* CATALOGS. 00780I* NAME 3A X 5 00790I 303 317 CFN 00800I* COPIES 3P X 5 00810I P 318 327 CFC 00820I* SELECTOR CODES 24 X 1A 1 00830I 328 351 NAC 00840I* TELEPHONE # 12A 00850I 352 363 CFTEL 00860I* DATE LAST UPDATE 6N (YMD) 00870I 364 3690CFDLT 00880I* RECORD STATUS 1A 00890I 370 370 CFSTAT 00900C******************************************************************** 00910C* INITIALIZE - 1 TIME. 00920C 10 EXSR SR101 INIT. 00930C 10 GOTO END 00940C*------------------------------------------------------------------- 00950C SETOF 65 00960C CFSTAT COMP 'D' 54 00970C 54 SETOF 01 00980C 54 GOTO END DELETED CFMAST. 00990C CFSTCD COMP ' ' 54 01000C 54 CFSTCD LOKUPTABSC 54 ÐÐ01010C 'E' LOKUPNAC 55 01020C CFA,8 COMP BLK35 57 01030C 57 54 01040COR 57N55 SETON 65 01050C MOVE CFN NA4 01060C Z-ADDCFC NB4 01070C CFSTCD COMP ' ' 54 01080C 54 CFSTCD LOKUPTABSC TABSCN 54 01090C 54 MOVELTABSCN W20A 20 01100C N54 MOVE BLK35 W20A 01110C* TEST RECORD. 01120C MOVE ' ' ERR 01130C 02 EXSR SR202 ZIP CODE. 01140C 03 EXSR SR203 STATE CODE. 01150C 04 EXSR SR204 FRGN CTRY. 01160C 05 EXSR SR205 MAILER CODE. 01170C 06 EXSR SR206 SELECTOR CODE. 01180C* CHECK TEST RESULTS. SET 01 OFF IF NOT A HIT. 01190C Z-ADD0 X 89 01200C*-------------------------------------------------------------- 01210C TAG100 TAG 01220C 1 ADD X X 01230C X COMP 9 54 01240C 54 SETOF 01 01250C 54 GOTO END DONE- ALL ERRORS ÐÐ01260C SET,X COMP 0 54 01270C N54 GOTO TAG100 NO TEST DATA 01280C ERR,X COMP ' ' 54 01290C N54 GOTO END GOT A HIT 01300C GOTO TAG100 TRY AGAIN 01310C*---------------------------------------------------------------- 01320C END TAG 01330C******************************************************************** 01340CSR SR101 BEGSR 01350C* INITIALIZE 1-TIME. 01360C* FLAG ZIP CODE. 01370CSR Z-ADD1 X 30 01380CSR EXSR SR102 01390CSR 54 01400COR 55 SETON 02 ZIP CODE. 01410C* FLAG STATE CODE. 01420CSR Z-ADD1 X 01430CSR EXSR SR103 01440CSR 54 01450COR 55 SETON 03 STATE CODE. 01460C* FLAG FOREIGN COUNTRY. 01470CSR Z-ADD1 X 01480CSR EXSR SR104 01490CSR 54 01500COR 55 SETON 04 FRGN CTRY. ÐÐ01510C* FLAG MAILER CODES. 01520CSR Z-ADD1 X 01530CSR EXSR SR105 01540CSR 54 01550COR 55 01560COR 56 01570COR 57 SETON 05 MAILER CODES. 01580C* FLAG SELECTOR CODES. 01590CSR Z-ADD1 X 01600CSR EXSR SR106 01610CSR 54 SETON 06 SELECTOR CODES. 01620C* DEFINE WORK FIELDS. 01630CSR 79 GOTO END101 01640CSR SETON 79 01650CSR Z-ADD0 ZERO9 90 01660CSR MOVE ' ' BLK33 33 01670CSR MOVE ' ' BLK16 16 01680CSR MOVE ' ' BLK35 35 01690CSR END101 ENDSR 01700C******************************************************************** 01710CSR SR102 BEGSR 01720C* FIND ZIP TEST DATA. 01730CSR Z-ADDX A 30 01740CSR Z-ADDX B 30 01750CSR ZERO9 LOKUPTZIP,A 54 ÐÐ01760CSR ' ' LOKUPNZIP,B 55 01770CSR 54 55 A COMP B 56 01780CSR 54 55 56 Z-ADDB X 01790CSR 54 55N56 Z-ADDA X 01800CSR 54N55 Z-ADDA X 01810CSRN54 55 Z-ADDB X 01820CSR ENDSR 01830C******************************************************************** 01840CSR SR103 BEGSR 01850C* FIND STATE CODE TEST DATA. 01860CSR Z-ADDX A 01870CSR Z-ADDX B 01880CSR ' ' LOKUPSTC,A 54 01890CSR ' ' LOKUPNST,B 55 01900CSR 54 55 A COMP B 56 01910CSR 54 55 56 Z-ADDB X 01920CSR 54 55N56 Z-ADDA X 01930CSR 54N55 Z-ADDA X 01940CSRN54 55 Z-ADDB X 01950CSR ENDSR 01960C******************************************************************** 01970CSR SR104 BEGSR 01980C* FIND FOR COUNTRY TEST DATA. 01990CSR Z-ADDX A 02000CSR Z-ADDX B ÐÐ02010CSR BLK35 LOKUPFC,A 54 02020CSR ' ' LOKUPNFC,B 55 02030CSR 54 55 A COMP B 56 02040CSR 54 55 56 Z-ADDB X 02050CSR 54 55N56 Z-ADDA X 02060CSR 54N55 Z-ADDA X 02070CSRN54 55 Z-ADDB X 02080CSR ENDSR 02090C******************************************************************** 02100CSR SR105 BEGSR 02110C* FIND MAILER TEST DATA. 02120CSR Z-ADDX A 02130CSR Z-ADDX B 02140CSR ' ' LOKUPMC1,A 54 02150CSR ' ' LOKUPNM1,B 55 02160CSR 54 55 A COMP B 58 02170CSR 54 55 58 Z-ADDB X 02180CSR 54 55N58 Z-ADDA X 02190CSR 54N55 Z-ADDA X 02200CSRN54 55 Z-ADDB X 02210CSR Z-ADDX A 02220CSR Z-ADDX B 02230CSR ' ' LOKUPMC2,A 56 02240CSR ' ' LOKUPNM2,B 57 02250CSR 56 57 A COMP B 58 ÐÐ02260CSR 56 57 58 Z-ADDB X 02270CSR 56 57N58 Z-ADDA X 02280CSR 56N57 Z-ADDA X 02290CSRN56 57 Z-ADDB X 02300CSR ENDSR 02310C******************************************************************** 02320CSR SR106 BEGSR 02330C* FIND SELECTOR CODE TEST DATA. 02340CSR BLK33 LOKUPSC,X 54 02350CSR ENDSR 02360C******************************************************************** 02370CSR SR202 BEGSR 02380C* TEST ZIP CODE. 02390CSR Z-ADD1 X 30 02400C*------------------------------------------------------------------- 02410CSR T202A TAG 02420CSR SETOF 99 02430CSR EXSR SR102 FIND ZIP. 02440CSRN54N55 GOTO END202 02450CSR CFZIP COMP FZIP,X 54 54 02460CSR 54 CFZIP COMP TZIP,X 5454 02470CSR NZIP,X COMP ' ' 55 02480CSRN54N55 02490COR 54 55 SETON 99 FAILURE. 02500CSR 99 MOVE 'E' ERR,X ÐÐ02510CSR EXSR SR301 UP-X. 02520CSRN54 GOTO T202A 02530CSR END202 ENDSR 02540C******************************************************************** 02550CSR SR203 BEGSR 02560C* TEST STATE CODE. 02570CSR Z-ADD1 X 02580C*------------------------------------------------------------------- 02590CSR T203A TAG 02600CSR SETOF 99 02610CSR EXSR SR103 FIND STATE CODE 02620CSRN54N55 GOTO END203 DONE. 02630CSR CFSTCD COMP STC,X 54 02640CSR NST,X COMP ' ' 55 02650CSR 54 55 02660CORN54N55 SETON 99 02670CSR 99 MOVE 'E' ERR,X 02680CSR EXSR SR301 UP-X. 02690CSRN54 GOTO T203A 02700CSR END203 ENDSR 02710C******************************************************************** 02720CSR SR204 BEGSR 02730C* TEST FRGN CTRY. 02740CSR Z-ADD1 X 02750C*------------------------------------------------------------------- ÐÐ02760CSR T204A TAG 02770CSR SETOF 99 02780CSR EXSR SR104 FIND CTRY. 02790CSRN54N55 GOTO END204 DONE. 02800CSR CFA,8 COMP FC,X 54 02810CSR NFC,X COMP ' ' 55 02820CSR 54 55 02830CORN54N55 SETON 99 02840CSR 99 MOVE 'E' ERR,X 02850CSR EXSR SR301 UP-X. 02860CSRN54 GOTO T204A 02870CSR END204 ENDSR 02880C******************************************************************** 02890CSR SR205 BEGSR 02900C* TEST MAIL CODES. 02910CSR Z-ADD1 X 02920C*------------------------------------------------------------------- 02930CSR T205A TAG 02940CSR SETOF 99 02950CSR EXSR SR105 FIND MAIL CODE. 02960CSRN54N55 GOTO T205B DONE 1ST PASS. 02970CSR MC1,X LOKUPCFN 54 02980CSR NM1,X COMP ' ' 55 02990CSR 54 55 03000CORN54N55 SETON 99 ÐÐ03010CSR 99 MOVE 'E' ERR,X 03020CSR EXSR SR301 UP-X. 03030CSRN54 GOTO T205A 03040C*------------------------------------------------------------------- 03050CSR T205B TAG 03060CSR Z-ADD1 X 03070C*------------------------------------------------------------------- 03080CSR T205C TAG 03090CSR SETOF 99 03100CSR EXSR SR105 FIND MAIL CODE. 03110CSRN56N57 GOTO END205 DONE 2ND PASS. 03120CSR MC2,X LOKUPCFN 54 03130CSR NM2,X COMP ' ' 55 03140CSR 54 55 03150CORN54N55 SETON 99 FAILURE. 03160CSR 99 MOVE 'E' ERR,X 03170CSR EXSR SR301 UP-X. 03180CSRN54 GOTO T205B 03190CSR END205 ENDSR 03200C******************************************************************** 03210CSR SR206 BEGSR 03220C* TEST SELECTOR CODES. 03230CSR Z-ADD0 S 30 03240C*------------------------------------------------------------------- 03250CSR T206A TAG ÐÐ03260CSR 1 ADD S S 03270CSR S COMP 9 54 03280CSR 54 GOTO END206 03290CSR SET,S COMP 0 54 03300CSRN54 GOTO T206A 03310CSR SC,S COMP BLK33 54 03320CSRN54 GOTO T206A 03330CSR MOVEASC,S WK3 03340CSR MOVE WK3 WK2 03350CSR Z-ADD0 X 03360C*------------------------------------------------------------------- 03370CSR T206B TAG 03380CSR SETOF 99 03390CSR 1 ADD X X 03400CSR X COMP 11 54 03410CSR 54 GOTO T206A 03420CSR WK2,X COMP ' ' 54 03430CSRN54 GOTO T206B 03440CSR MOVELWK2,X W1A 1 SELECTOR CODE. 03450CSR W1A LOKUPNAC 54 03460CSR MOVE WK2,X W1A NOT FLAG. 03470CSR W1A COMP ' ' 55 03480CSR 54 55 03490CORN54N55 SETON 99 03500CSR 99 MOVE 'E' ERR,S ÐÐ03510CSR 99 GOTO T206A 03520CSR GOTO T206B 03530CSR END206 ENDSR 03540C******************************************************************** 03550CSR SR301 BEGSR 03560C* INCREASE INDEX. 03570CSR 1 ADD X X 03580CSR X COMP 9 54 03590CSR ENDSR 03600O******************************************************************** 03610OPRINT H 201 1P 03620O OR OF 03630O* PUT HEADINGS. 03640O UDATE Y 8 03650O 72 'MAILING LIST DISPLAY' 03660O 127 'PAGE' 03670O PAGE Z 132 03680O H 2 1P 03690O OR OF 03700O* PUT HEADINGS. 03710O 10 'KEY FIELD' 03720O 47 'N A M E A N D A D D ' 03730O 54 'R E S S' 03740O 92 'S E L E C T O R C O D ' 03750O 95 'E S' ÐÐ03760O 123 'MAILER CODES' 03770O*------------------------------------------------------------------- 03780O D 21 01 03790O* PUT DATA. 03800O CFKEY 15 03810O 22 'NAME' 03820O CFA,1 66 03830O NAC 94 03840O NA4 131 03850O*------------------------------------------------------------------- 03860O D 1 01 03870O 23 'TITLE' 03880O CFA,2 66 03890O NB4 Z 131 03900O*------------------------------------------------------------------- 03910O D 1 01 03920O 25 'COMPANY' 03930O CFA,3 66 03940O*------------------------------------------------------------------- 03950O D 1 01 03960O 25 'COMPANY' 03970O CFA,4 66 03980O*------------------------------------------------------------------- 03990O D 1 01 04000O 25 'ADDRESS' ÐÐ04010O CFA,5 66 04020O*------------------------------------------------------------------- 04030O D 1 01 04040O 25 'ADDRESS' 04050O CFA,6 66 04060O 79 'TELEPHONE:' 04070O CFTEL 92 04080O 110 'LAST UPDATED:' 04090O CFDLT Y 118 04100O*------------------------------------------------------------------- 04110O D 1 01 04120O 22 'CITY' 04130O CFA,7 66 04140O 74 'STATE' 04150O 79 ':' 04160O CFSTCD 82 04170O W20A 109 04180O 115 'ZIP:' 04190O CFZIP Z 126 04200O*------------------------------------------------------------------- 04210O D 1 01 04220O 30 'FOREIGN CTRY' 04230O CFA,8 66 04240O*------------------------------------------------------------------- 04250O D 1 01 65 ÐÐ04260O 19 '*** INVALID COUNTRY' ** NA4 ARRAY 004270 004280** NB4 ARRAY 004290 004300** TABSC/TABSCN --- STATE CODES/NAMES 004310 004320ALALABAMA 004330AKALASKA 004340AZARIZONA 004350ARARKANSAS 004360ASAMERICAN SAMOA 004370CACALIFORNIA 004380CZCANAL ZONE 004390COCOLORADO 004400CTCONNECTICUT 004410DEDELAWARE 004420DCDISTRICT OF COLUMBIA 004430FLFLORIDA 004440GAGEORGIA 004450GUGUAM 004460HIHAWAII 004470IDIDAHO 004480ILILLINOIS 004490ININDIANA 004500ÐÐIAIOWA 004510KSKANSAS 004520KYKENTUCKY 004530LALOUISIANA 004540MEMAINE 004550MDMARYLAND 004560MAMASSACHUSETTS 004570MIMICHIGAN 004580MNMINNESOTA 004590MSMISSISSIPPI 004600MOMISSOURI 004610MTMONTANA 004620NENEBRASKA 004630NVNEVADA 004640NHNEW HAMPSHIRE 004650NJNEW JERSEY 004660NMNEW MEXICO 004670NYNEW YORK 004680NCNORTH CAROLINA 004690NDNORTH DAKOTA 004700OHOHIO 004710OKOKLAHOMA 004720OROREGON 004730PAPENNSYLVANIA 004740PRPUERTO RICO 004750ÐÐRIRHODE ISLAND 004760SCSOUTH CAROLINA 004770SDSOUTH DAKOTA 004780TNTENNESSEE 004790TTTRUST TERRITORIES 004800TXTEXAS 004810UTUTAH 004820VTVERMONT 004830VAVIRGINIA 004840VIVIRGIN ISLANDS 004850WAWASHINGTON 004860WVWEST VIRGINIA 004870WIWISCONSIN 004880WYWYOMING 004890** ERR ARRAY 004900 004910** WK2 ARRAY 004920 004930** WK3 ARRAY 004940 004950/* 004960_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(– –?X007CM P120282120282(èÈÐ00010H Q007CM00020F* INITIALIZE CR2FILE. (X007CM) 00030F* ACCOUNTING CUST MAST UPDATE START PROG. 00040F* REVISED 1/07/81 10:15 AM. DG-REL006 OK. 00050FBITTAB IP F 33 DISK 00060FCR2FILE UC F 672R DISK 00070E******************************************************************** 00080E BIT 33 1 SCREEN CONTR. CHAR 00090E CALL 5 6 CALL STACK 00100I******************************************************************* 00110IBITTAB BT 01 00120I 1 33 BIT 00130I******************************************************************** 00140ICR2FILE CR 00150I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00160I* STD AREA - SAME FOR ALL PROGRAMS. 00170I* CALL STACK 5 X 6A 00180I 38 67 CALL 00190I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00200I 68 73 CRRET 00210C******************************************************************** 00220C* INITIALIZE 00230C EXSR SR101 1-TIME INIT 00240C MOVE BLK6 CALL 00250C MOVE BLK6 CRRET ÐÐ00260C NH9 SETON 80 00270C NH9 EXCPT UPDATE CR2FILE. 00280C SETOF 80 00290CLR MOVEL'Q002CM' PROG 8 00300CLR EXITFCHAIN 00310CLR RLABL PROG 00320C*********************************************************************** 00330CSR SR101 BEGSR 00340C* 1-TIME INITIALIZE 00350C* GET PORT # AND CR2FILE 00360CSR MOVE ' ' W8A 8 00370CSR Z-ADD0 W2N 20 00380CSR Z-ADD0 W1N 10 00390CSR MOVE ' ' W2A 2 00400CSR EXITFPGMINX GET PORT # 00410CSR RLABL W8A 00420CSR RLABL W2N 00430CSR RLABL W1N 00440CSR RLABL W2A 00450CSR MOVE W2A PORT 20 PORT NO. 00460CSR PORT COMP 0 54 00470CSRN54 Z-ADD25 PORT DEFAULT 00480CSR PORT CHAINCR2FILE H9 00490C* DEFINE WORK FIELDS,ETC. 00500CSR MOVE ' ' BLK35 35 ÐÐ00510CSR MOVE ' ' BLK5 5 00520CSR MOVE ' ' BLK6 6 00530CSR Z-ADD0 ZERO5 50 00540CSR MOVE ' ' BLK20 20 00550CSR MOVE ' ' BLK11 11 00560CSR MOVE ' ' BLK15 15 00570CSR MOVE ' ' BLK21 21 00580CSR MOVE ' ' BLK3 3 00590CSR Z-ADD0 ZERO7 70 00600CSR Z-ADD0 ZERO1 10 00610CSR MOVE ' ' BLK1 1 00620CSR MOVE ' ' BLK2 2 00630CSR Z-ADD0 ZERO9 90 00640CSR Z-ADD0 ZERO3 30 00650CSR MOVE ' ' BLK8 8 00660CSR ENDSR 00670O******************************************************************** 00680OCR2FILE E 80 00690O ZERO5 5 00700O BLK20 25 00710O BLK35 60 00720O BLK35 95 00730O BLK35 130 00740O BLK35 165 00750O BLK35 200 ÐÐ00760O BLK35 235 00770O BLK35 270 00780O BLK2 272 00790O ZERO9 277P 00800O BLK35 307 00810O BLK35 342 00820O BLK35 367 00830O ZERO7 371P 00840O BLK8 379 00850O ZERO1 380 00860O BLK20 400 00870O ZERO9 405P 00880O ZERO9 410P 00890O ZERO9 415P 00900O ZERO9 420P 00910O ZERO9 425P 00920O ZERO9 430P 00930O ZERO9 435P 00940O ZERO9 440P 00950O ZERO9 445P 00960O ZERO9 450P 00970O ZERO9 455P 00980O ZERO9 460P 00990O ZERO9 465P 01000O ZERO9 470P ÐÐ01010O ZERO9 475P 01020O ZERO9 480P 01030O ZERO9 485P 01040O ZERO9 490P 01050O ZERO9 495P 01060O ZERO9 500P 01070O ZERO9 505P 01080O ZERO9 510P 01090O ZERO9 515P 01100O ZERO9 520P 01110O BLK1 521 01120O ZERO3 523P 01130O BLK1 524 01140O ZERO7 528P 01150O ZERO7 532P 01160O ZERO7 536P 01170O ZERO7 540P 01180O ZERO7 544P 01190O BLK5 549 01200O BLK1 550 01210O BLK8 558 01220O 559 ' ' 01230O BLK6 565 01240O BLK6 571 01250O 572 ' ' ÐÐ01260O ZERO5 575P 01270O BLK21 596 01280O 671 'Q007CM' 01290O BLK1 672 /* 001300_‚ ÐÐ_‚_‚0O ZERO5 575P 01270O BLK21 596 01280O 671 'Q007CM' 01290O BLK1 672 /* 001300_‚ ÐÈ( L §X007JQ P120282120282(èÈÐ00010H Q007JQ00020F* DISPLAY PRINTER JOB QUEUE FOR DELETION (X007JQ) 00030F* AND REQUEST SELECTION. 00040F* REVISED 2/15/80 3:05 PM. 00050FBITHEX IP F 256 DISK 00060FJQDEVICEUD F 8L 6AI 1 DISK 00070FJQMAST UC F 96R 4AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090FMGFILE IC F 80R DISK 00100FBJMAST IC F 106R 6AI 1 DISK 00110FMENUDEPTIT F 25 EDISK 00120FDIABLO38O F 38 5 00130FDIABLO O F 132 5 00140E******************************************************************** 00150E NUL 1 132 1 00160E A6 6 6 1 00170E A8 8 8 1 A 00180E JOB 1 100 4 0 PRG 6 00190E MENUDEPT TABDEP 1 10 5 0 TABDN 20 00200E BIT 256 1 00210E CALL 5 6 00220I******************************************************************** 00230IBITHEX BT 00240I 1 256 BIT 00250I*************************************************************** ÐÐ00260ICRTFILE CR 00270I 14 180CRDEPT 00280I******************************************************************** 00290IMGFILE MG 00300I 1 35 MGTEXT 00310I******************************************************************** 00320IBJMAST BJ 00330I 7 46 BJDESC 00340I 106 106 BJSTAT 00350I******************************************************************** 00360IJQDEVICEJD 00370I* JOB QUEUE DEVICE ALT-KEY. 00380I* KEY AREA. 00390I* DEVICE CODE 2N 00400I 1 2 JDDEV 00410I* JOB # 4N 00420I 3 60JDJOB 00430I* RECORD STATUS 1A 00440I 8 8 JDSTAT 00450I******************************************************************** 00460IJQMAST JQ 00470I* JOB QUEUE MASTER. 00480I* JOB NUMB 4N 00490I 1 40JQNUMB 00500I* DEVICE 2A ÐÐ00510I* COL-2,DEVICE CODE 00520I* Y = SHARED 00530I* N = NON-SHARABLE 00540I* COL-1,DEVICE CODE 00550I* S = SYST PRINTER 00560I* D = DIABLO PRINTER 00570I* T = TERMINAL 00580I* C = CONSOLE 00590I 5 6 JQDEV 00600I* DEPT # 5N 00610I 7 110JQDEPT 00620I* JOB NAME 6A 00630I 12 17 JQJOB 00640I* PRINTER 1A 00650I 18 18 JQPRTR 00660I* PAPER 25A 00670I 19 43 JQPAP 00680I* COPIES REQUESTED 1N 00690I 44 440JQCOPY 00700I* REQUESTED BY 12A 00710I 45 56 JQRBY 00720I* REQUEST DATE 6N 00730I 57 620JQRDAT 00740I* REQUEST TIME 6N 00750I 63 680JQRTIM ÐÐ00760I* NEED BY DATE 6N 00770I 69 740JQNDAT 00780I* NEED BY TIME 6N 00790I 75 800JQNTIM 00800I* DATE COMPLETED 6N 00810I 81 860JQCDAT 00820I* TIME COMPLETED 6N 00830I 87 920JQCTIM 00840I* RECORD STATUS 1A 00850I 96 96 JQSTAT 00860C******************************************************************** 00870C* INITIALIZE. 00880C EXSR SR101 INIT. 00890C H9 GOTO ENDJOB 00900C*------------------------------------------------------------------- 00910C START TAG 00920C MOVEL'D' DEVKEY 6 00930C DEVKEY SETLLJQDEVICE 00940C SETOF 75 00950C*------------------------------------------------------------------- 00960C TAG100 TAG 00970C SETOF 54 00980C READ JQDEVICE 54 00990C 54 GOTO SELECT 01000C MOVELJDDEV W1A 1 ÐÐ01010C W1A COMP 'D' 54 01020C N54 GOTO SELECT WRONG DEVICE. 01030C JDSTAT COMP 'D' 54 01040C 54 GOTO TAG100 DELETED. 01050C JDJOB CHAINJQMAST 55 01060C N55 JQSTAT COMP 'D' 55 01070C 55 SETON 83 01080C 55 EXCPT DELETE JQDEVICE 01090C 55 SETOF 83 01100C 55 GOTO TAG100 01110C CRDEPT COMP JQDEPT 54 01120C N54 GOTO TAG100 01130C JQJOB CHAINBJMAST 55 01140C N55 BJSTAT COMP 'D' 55 01150C 55 SETON 84 01160C 55 EXCPT DEL JQMAST/DEVICE 01170C 55 SETOF 84 01180C 55 GOTO TAG100 01190C JQDEPT LOKUPTABDEP TABDN 54 01200C 54 MOVE TABDN DEPNAM 20 01210C N54 MOVE BLK20 DEPNAM 01220C 1 ADD J J 40 01230C MOVE JQNUMB JOB,J 01240C MOVE JQJOB PRG,J 01250C N75 EXSR SR70 PUT HEADING ÐÐ01260C EXSR SR72 DISPLAY QUE MENU 01270C GOTO TAG100 01280C*------------------------------------------------------------------- 01290C SELECT TAG 01300C EXITFQCLFCR LF/CR 01310C* PUT NO JOBS MESSAGE 01320C N75 SETON 76 01330C N75 EXCPT NO JOBS MSG 01340C N75 SETOF 76 01350C N75 EXITFQCLFCR LF/CR 01360C N75 GOTO GOODBY 01370C* GET SELECTION NUMBER. 01380C SETOF 96 01390C Z-ADD249 M 50 ENTER JOB NUMBER 01400C SETON 69 01410C EXSR SR73 PROMPT. 01420C SETOF 69 01430C EXSR SR75 READ. 01440C 98 GOTO GOODBY 01450C 94 01460COR 93 GOTO MENU 01470C Z-ADD8 W2N 20 01480C EXIT SUBRAJ R. JUSTIFY. 01490C RLABL W2N 01500C RLABL W8A 8 ÐÐ01510C MOVE W8A SELNO 40 01520C SELNO COMP 0 55 01530C N55 Z-ADD309 M 96 01540C N55 EXSR SR73 FLAG ERROR. 01550C N55 GOTO SELECT 01560C Z-ADD1 X 40 01570C SELNO LOKUPJOB,X 55 GET JOB# 01580C N55 Z-ADD309 M 96 FLAG ERROR 01590C N55 GOTO SELECT 01600C JOB,X CHAINJQMAST 55 01610C 55 Z-ADD309 M 96 FLAG ERROR. 01620C 55 GOTO SELECT 01630C MOVE JQNUMB DEVKEY 01640C DEVKEY SETLLJQDEVICE 01650C READ JQDEVICE H7 01660C H7 GOTO ENDJOB 01670C SETON 84 DELETE JQDEVICE 01680C EXCPT DELETE JQMAST. 01690C SETOF 84 01700C MOVELPRG,X PROG 8 01710C EXITFQPAUSE 01720C GOTO END 01730C*------------------------------------------------------------------- 01740C MENU TAG 01750C MOVEL'HELLO' PROG 8 ÐÐ01760C GOTO END 01770C*------------------------------------------------------------------- 01780C GOODBY TAG 01790C MOVEL'GOODBY' PROG 01800C*------------------------------------------------------------------- 01810C END TAG 01820C EXITFCHAIN 01830C RLABL PROG 01840C*------------------------------------------------------------------- 01850C ENDJOB TAG 01860C******************************************************************** 01870CSR SR70 BEGSR 01880C* PUT HEADINGS TO TERM. 01890CSR EXITFQCLFCR LF/CR 01900CSR SETON 42 01910CSR EXSR SR71 HEADING-2. 01920CSR SETON 44 01930CSR EXSR SR71 HEADING-4. 01940CSR EXITFQCLFCR LF/CR 01950CSR ENDSR 01960C****************************************************************** 01970CSR SR71 BEGSR 01980C* PUT HEADINGS 01990CSR SETON 71 02000CSR EXCPT PUT HEADINGS ÐÐ02010CSR SETOF 414243 02020CSR SETOF 4445 02030CSR SETOF 71 02040CSR ENDSR 02050C******************************************************************** 02060CSR SR72 BEGSR 02070C* PUT DATA TO TERM. 02080CSR SETON 7275 02090CSR EXCPT PUT DATA. 02100CSR SETOF 72 02110CSR SETON 74 02120CSR EXCPT 2ND DATA LINE. 02130CSR SETOF 74 02140CSR ENDSR 02150C******************************************************************** 02160CSR SR73 BEGSR 02170C* PUT MESSAGE. 02180CSR M CHAINMGFILE 54 02190CSRN54 SETON 73 02200CSR EXCPT PUT MSG. 02210CSR SETOF 73 02220CSR ENDSR 02230C******************************************************************* 02240CSR SR75 BEGSR 02250C* READ FROM TERMINAL ÐÐ02260CSR SETOF 779096 02270CSR SETOF 939291 02280CSR SETOF 898887 02290CSR SETOF 8685 02300CSR MOVE BIT,5 A6,2 BUF LENGTH 02310CSR MOVEAA6 W6A 6 02320CSR MOVE BLK8 W8A 8 BUFFER 02330CSR EXITFQWREED READ TERM 02340CSR RLABL W8A 02350CSR RLABL W6A 02360CSR MOVEAW8A A8 02370CSR MOVE BLK8 W8A 02380CSR Z-ADD1 W 30 02390CSR '\' LOKUPA8,W 90 FLAG ESC 02400CSRN90 GOTO T75B NOT ESC 02410CSR 1 ADD W W 02420CSR W COMP 8 54 02430CSR 54 GOTO T75A BAD ESC 02440CSR A8,W COMP 'G' 98 GOODBY 02450CSR A8,W COMP 'E' 94 MENU 02460CSR A8,W COMP 'N' 93 NEW ITEM 02470CSR A8,W COMP 'J' 92 JUMP 02480CSR A8,W COMP 'F' 91 SKIP FRWRD 02490CSR A8,W COMP 'B' 89 SKIP BKWRD 02500CSR A8,W COMP 'S' 88 SPACE FILL ÐÐ02510CSR A8,W COMP 'H' 87 HOME 02520CSR A8,W COMP 'U' 86 UPDATE 02530CSR A8,W COMP 'R' 85 REPEAT 02540CSR 98 02550COR 94 02560COR 93 02570COR 92 02580COR 91 02590COR 89 02600COR 88 02610COR 87 02620COR 86 02630COR 85 GOTO END75 GOOD ESC 02640C*------------------------------------------------------------------ 02650CSR T75A TAG 02660C* FLAG BAD ESC INPUT 02670CSR Z-ADD318 M 50 96 FLAG ERROR 02680CSR GOTO END75 02690C*-------------------------------------------------------------------- 02700CSR T75B TAG 02710C* MOVE DATA 02720CSR Z-ADD1 W 02730CSR ' ' LOKUPA8,W 77 02740CSR 77 MOVEAA8,W W8A INPUT DATA 02750C*-------------------------------------------------------------------- ÐÐ02760CSR END75 ENDSR 02770C*********************************************************************** 02780CSR SR101 BEGSR 02790C* 1-TIME INITIALIZE 02800CSR MOVE BIT,1 NUL 02810CSR MOVEANUL NUL50 50 02820CSR MOVEANUL NUL25 25 02830CSR MOVE BIT,1 A6 02840CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02850CSR MOVE ' ' BLK8 8 02860C* GET PORT # 02870CSR MOVE ' ' W8A 8 02880CSR MOVE ' ' W1A 1 02890CSR MOVE ' ' W2A 2 02900CSR Z-ADD0 W1N 10 02910CSR Z-ADD0 W2N 20 02920CSR EXITFPGMINX 02930CSR RLABL W8A 02940CSR RLABL W2N 02950CSR RLABL W1N 02960CSR RLABL W2A 02970CSR MOVE W2A PORT 20 02980CSR PORT COMP 0 54 02990CSRN54 Z-ADD25 PORT 03000CSR PORT CHAINCRTFILE H9 ÐÐ03010CSR H9 GOTO END101 03020C* DEFINE WORK FIELDS,ETC. 03030CSR MOVE ' ' BLK35 35 03040CSR MOVE ' ' BLK40 40 03050CSR MOVE ' ' BLK20 20 03060CSR END101 ENDSR 03070O******************************************************************** 03080OJQMAST E 84 03090O 96 'D' 03100O******************************************************************** 03110OJQDEVICEE 84 03120O OR 83 03130O 8 'D' 03140O******************************************************************** 03150ODIABLO E 71 44 03160O 4 'JOB#' 03170O 22 'JOB NAME' 03180O 62 'REQUEST-BY' 03190O 73 'NEED-BY' 03200O 77 'DEV' 03210O 93 'FORMS-REQ''D' 03220O 110 'COPY' 03230O 122 'DEPARTMENT' 03240O*------------------------------------------------------------------- 03250O E 72 ÐÐ03260O* PUT MENU. 03270O JQNUMBZ 4 03280O U1 JQJOB 12 03290O BJDESC 54 03300O JQRBY 64 03310O JQNDATY 74 03320O JQDEV 77 03330O JQPAP 104 03340O JQCOPYZ 109 03350O DEPNAM 132 03360O**************************************************************** 03370ODIABLO38E 71 42 03380O* PUT TITLE 03390O NUL25 25 03400O NUL25 38 03410O BIT,28 1 03420O BIT,10 2 03430O BIT,71 3 03440O 38 'JOB QUEUE' 03450O*--------------------------------------------------------------------- 03460O E 74 03470O* PUT REQUESTED COMPL TIME 03480O NUL25 25 03490O NUL25 38 03500O BIT,28 1 ÐÐ03510O BIT,10 2 03520O BIT,68 3 03530O JQNTIM 38 ' : : ' 03540O*------------------------------------------------------------------ 03550O E 73 03560O* PUT MSG. 03570O MGTEXT 35 03580O 69 BIT,8 38 03590O*------------------------------------------------------------------ 03600O E 76 03610O* NO JOBS ON FILE MSG 03620O 20 'ALL JOBS COMPLETED' ** NUL ARRAY 003630 003640** A6 ARRAY 003650 003660** A8 ARRAY 003670 003680** JOB/PRG ARRAY 003690 003700/* 003710_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(  ô  NX007KP P120282120282(èÈÐ00010H Q007KP00020F* UPDATE KEYPUNCH TABLE FILE. (X007KP) 00030F* REVISED 7-23-80 11:50 AM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FKPTABLE UC F 23R22AI 1 DISK A 00070FCRTFILE IC F 256R DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A16 16 16 1 A INPUT DATA ARRAY 00120E DUN 1 3 1 A EDIT CMPLT FLAG 00130E MES 1 1 30 00140E BIT 33 1 SCREEN CONTR. CHAR 00150E CALL 5 6 CALL STACK 00160E* 00170E* 00180I******************************************************************* 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************* 00220IMGFILE MG 00230I* MESSAGE FILE. 00240I 1 35 MGTEXT 00250I******************************************************************** ÐÐ00260ICRTFILE CR 00270I 1 50CREMPL 00280I 6 13 CRUSER 00290I 14 18 CRDEPT 00300I 19 26 CRJOB 00310I 27 27 CRSHUT 00320I 28 330CRTIMI 00330I 34 370CRDATE 00340I 38 67 CALL 00350I 68 73 CRRET 00360I 74 79 CRMENU 00370I******************************************************************** 00380IKPTABLE KT 00390I* KEY PUNCH TABLE FILE. 00400I* KEY AREA. 00410I* NAME 6A 00420I 1 6 KTNAME 00430I* TABLE VALUE 15A 00440I 7 21 KTVAL 00450I* RECORD STATUS 1A 00460I 23 23 KTSTAT 00470C******************************************************************** 00480C* INITIALIZE 00490C EXSR SR101 1-TIME INIT 00500C*------------------------------------------------------------------ ÐÐ00510C START TAG 00520C* SET-UP 1ST FIELD NO. 00530C MOVE ' ' DUN INIT EDIT ARRAY 00540C Z-ADD1 F 30 FIELD # 00550C MOVE BLK6 TNAME 6 00560C MOVE ' ' CRTRAN 1 00570C MOVE BLK15 TVAL 15 00580C GOTO READ 00590C*------------------------------------------------------------------ 00600C NEXT TAG 00610C* SET-UP NEXT FIELD NO. 00620C 1 ADD F F FIELD # 00630C*----------------------------------------------------------------- 00640C READ TAG 00650C* READ DATA FROM TERMINAL. 00660C SETOF 909677 00670C EXSR SR102 VALIDATE FIELD # 00680C 55 GOTO UPDATE DONE 00690C EXSR SR201 IDENTIFY-F 00700C SETON 69 00710C EXSR SR72 PROMPT 00720C SETOF 69 00730C EXSR SR75 READ TERMINAL 00740C 98 GOTO GOODBY GOODBY 00750C 94 GOTO MENU MENU REQUEST ÐÐ00760C N77N88 EXSR SR104 EDIT INPUT FIELD 00770C 96 ERROR 00780CORN77N88 EXSR SR72 REWRITE INPUT DATA 00790C 93 GOTO NEWITM NEW ITEM 00800C 92 GOTO JUMP FIELD JUMP REQST 00810C 91 GOTO NEXT SKIP FORWARD 00820C 89 F SUB 1 F SKIP BACKWARD 00830C 89 GOTO READ " " 00840C 88 SETOF 90 SPACE FILL 00850C 88 SETON 77 " " 00860C 87 GOTO START 00870C 86 GOTO UPDATE UPDATE 00880C 85 GOTO READ REPEAT 00890C 96 GOTO ERROR ERROR 00900C N77 GOTO EDIT NO DATA INPUT 00910C*------------------------------------------------------------------ 00920C PROCES TAG 00930C* PROCESS INPUT DATA 00940C EXSR SR103 MOVE DATA 00950C*------------------------------------------------------------------- 00960C EDIT TAG 00970C N96 EXSR SR104 EDIT DATA 00980C EXSR SR72 REWRITE DATA 00990C 96 GOTO ERROR ERROR 01000C GOTO NEXT ÐÐ01010C*------------------------------------------------------------------ 01020C UPDATE TAG 01030C* UPDATE DATA BASE. 01040C EXSR SR105 FINAL EDIT 01050C 96 GOTO ERROR ERROR 01060C EXSR SR106 UPDATE 01070C 96 GOTO ERROR ERROR 01080C GOTO START 01090C*------------------------------------------------------------------- 01100C JUMP TAG 01110C* SET-UP JUMP TO REQUESTED FIELD 01120C 1 ADD W W 30 01130C W COMP 16 54 01140C 54 Z-ADD318 M 50 96 FLAG ERROR 01150C 54 GOTO ERROR BAD ESC 01160C MOVE ' ' W3A 3 01170C MOVEAA16,W W3A 01180C Z-ADD3 W2N 20 01190C EXIT SUBRAJ R. JUSTIFY 01200C RLABL W2N 01210C RLABL W3A 01220C MOVE W3A F NEW FIELD # 01230C GOTO READ 01240C*-------------------------------------------------------------------- 01250C ERROR TAG ÐÐ01260C EXSR SR102 VALIDATE FIELD # 01270C EXSR SR89 GET MSG 01280C EXSR SR73 PUT MSG 01290C GOTO READ 01300C*------------------------------------------------------------------ 01310C NEWITM TAG 01320C* SET-UP LINK FOR NEW ITEM 01330C MOVEL'Q007KP' PROG 8 01340C GOTO END 01350C*------------------------------------------------------------------- 01360C MENU TAG 01370C* SET-UP LINK TO MENU 01380C MOVEL'Q070DP' PROG 01390C GOTO END 01400C*-------------------------------------------------------------------- 01410C GOODBY TAG 01420C* LINK TO SIGN-OFF 01430C MOVEL'GOODBY' PROG 01440C GOTO END 01450C*------------------------------------------------------------------- 01460C END TAG 01470C EXITFCHAIN LINK TO NEXT PROG 01480C RLABL PROG 01490C********************************************************************* 01500CSR SR1 BEGSR ÐÐ01510C* EDIT TRAN CODE. 01520CSR EXSR SR203 CLASSIFY TRAN 01530CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 01540CSR ENDSR 01550C******************************************************************* 01560CSR SR3 BEGSR 01570C* EDIT NAME AND VALUE. 01580CSR TNAME COMP BLK6 54 01590CSRN54 Z-ADD469 M 96 FLAG ERROR 01600CSRN54 GOTO END3 01610CSR SETON 40 01620CSR EXSR SR106 GET MAST 01630CSR SETOF 40 01640CSR 96 GOTO END3 01650CSR END3 ENDSR 01660C***************************************************************** 01670CSR SR70 BEGSR 01680C* CLEAR TERM SCREEN. 01690CSR SETON 70 01700CSR EXCPT CLEAR SCREEN 01710CSR SETOF 70 01720CSR ENDSR 01730C********************************************************************** 01740CSR SR71 BEGSR 01750C* PUT HEADINGS TO TERMINAL ÐÐ01760CSR SETON 71 01770CSR EXCPT PUT HEADINGS 01780CSR SETOF 71 01790CSR ENDSR 01800C********************************************************************* 01810CSR SR72 BEGSR 01820C* PUT DATA TO TERMINAL 01830CSRN69 EXITFQMOVUP 01840CSR SETON 72 01850CSR EXCPT PUT DATA 01860CSR SETOF 72 01870CSR ENDSR 01880C*********************************************************************** 01890CSR SR73 BEGSR 01900C* PUT ERROR MESSAGE TO TERMINAL 01910CSR SETON 73 01920CSR EXCPT PUT MSG 01930CSR SETOF 73 01940CSR Z-ADDM LSTERR 50 01950CSR ENDSR 01960C******************************************************************** 01970CSR SR74 BEGSR 01980C* POSITION CURSOR. 01990CSR EXITFQXYPOS 02000CSR RLABL W6A ÐÐ02010CSR ENDSR 02020C******************************************************************* 02030CSR SR75 BEGSR 02040C* READ FROM TERMINAL 02050CSR SETOF 779096 02060CSR SETOF 939291 02070CSR SETOF 898887 02080CSR SETOF 8685 02090CSR MOVE '120026' W6A 6 02100CSR EXSR SR74 POSITION CURSOR 02110CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 02120CSR MOVE BLK16 W16A 16 BUFFER 02130CSR EXITFQWREED READ FROM TERMINAL 02140CSR RLABL W16A READ BUFFER 02150CSR RLABL BUFLGT READ BUFFER LGTH 02160CSR MOVEAW16A A16 INPUT DATA ARRAY 02170CSR MOVE BLK16 W16A INIT INPUT ARRAY 02180CSR Z-ADD1 W 30 02190CSR '\' LOKUPA16,W 90 FLAG ESC 02200CSRN90 GOTO T75B NOT ESC 02210CSR 1 ADD W W 02220CSR W COMP 16 54 02230CSR 54 GOTO T75A BAD ESC 02240CSR A16,W COMP 'G' 98 GOODBY 02250CSR A16,W COMP 'E' 94 MENU ÐÐ02260CSR A16,W COMP 'N' 93 NEW ITEM 02270CSR A16,W COMP 'J' 92 JUMP 02280CSR A16,W COMP 'F' 91 SKIP FRWRD 02290CSR A16,W COMP 'B' 89 SKIP BKWRD 02300CSR A16,W COMP 'S' 88 SPACE FILL 02310CSR A16,W COMP 'H' 87 HOME 02320CSR A16,W COMP 'U' 86 UPDATE 02330CSR A16,W COMP 'R' 85 REPEAT 02340CSR 98 02350COR 94 02360COR 93 02370COR 92 02380COR 91 02390COR 89 02400COR 88 02410COR 87 02420COR 86 02430COR 85 GOTO END75 GOOD ESC 02440C*------------------------------------------------------------------ 02450CSR T75A TAG 02460C* FLAG BAD ESC INPUT 02470CSR Z-ADD318 M 96 FLAG ERROR 02480CSR GOTO END75 02490C*-------------------------------------------------------------------- 02500CSR T75B TAG ÐÐ02510C* MOVE DATA 02520CSR Z-ADD1 W 02530CSR ' ' LOKUPA16,W 77 02540CSR 77 MOVEAA16,W W16A INPUT DATA 02550C*-------------------------------------------------------------------- 02560CSR END75 TAG 02570C* INIT PREV ERROR MSG. 02580CSR LSTERR COMP 0 54 02590CSR 54 MOVE BLK35 MGTEXT 02600CSR 54 EXSR SR73 BLANK MESSAGE 02610CSR Z-ADD0 LSTERR 50 02620CSR ENDSR 02630C********************************************************************** 02640CSR SR80 BEGSR 02650C* GET MASTER RECORD 02660CSR SETOF 61 02670CSR MOVELTNAME W21A 21 02680CSR MOVE TVAL W21A 02690CSR MOVELW21A W22A 22 02700CSR W22A CHAINKPTABLE 60 GET MASTER 02710CSRN60 KTSTAT COMP 'D' 61 FLAG DELETE 02720CSR ENDSR 02730C********************************************************************** 02740CSR SR81 BEGSR 02750C* ADD NEW MASTER TO FILE ÐÐ02760CSR SETON 81 02770CSR EXCPT ADD MASTER 02780CSR SETOF 81 02790CSR ENDSR 02800C*********************************************************************** 02810CSR SR82 BEGSR 02820C* REWRITE MASTER 02830CSR SETON 82 02840CSR EXCPT REWRITE MASTER 02850CSR SETOF 82 02860CSR ENDSR 02870C********************************************************************** 02880CSR SR89 BEGSR 02890C* GET MESSAGE MASTER 02900CSR M CHAINMGFILE 54 02910CSR 54 MOVE BLK35 MGTEXT 02920CSR 54 MOVELM MGTEXT 02930CSR 54 MOVE MES,1 MGTEXT 02940CSR ENDSR 02950C*********************************************************************** 02960CSR SR101 BEGSR 02970C* 1-TIME INITIALIZE 02980CSR MOVE BIT,1 NUL 02990CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03000CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ03010CSR MOVE ' ' BLK16 16 03020CSR MOVE '120001' W6A 03030CSR EXSR SR74 POSITION CURSOR 03040C* DEFINE WORK FIELDS,ETC. 03050CSR MOVE ' ' BLK35 35 03060CSR MOVE ' ' BLK6 6 03070CSR MOVE ' ' BLK15 15 03080C* 03090C* 03100CSR ENDSR 03110C********************************************************************** 03120CSR SR102 BEGSR 03130C* VALIDATE FIELD NO. 03140CSR F COMP 0 54 03150CSRN54 Z-ADD1 F 03160CSR F COMP FLIMIT 55 03170CSR 55 Z-ADD1 F 03180CSR ENDSR 03190C******************************************************************** 03200CSR SR103 BEGSR 03210C* MOVE INPUT DATA 03220CSR EXSR SR201 IDENTIFY-F 03230CSR 01 MOVELW16A CRTRAN 1 TRAN CODE 03240CSR 02 MOVELW16A TNAME TABLE NAME 03250CSR 03 MOVELW16A TVAL TABLE VALUE ÐÐ03260CSR MOVE ' ' DUN,F EDIT FLAG 03270CSR ENDSR 03280C******************************************************************** 03290CSR SR104 BEGSR 03300C* EDIT INPUT DATA 03310CSR 01 EXSR SR1 03320CSR 03 EXSR SR3 03330CSR 96 MOVE ' ' DUN,F EDIT FLAG 03340CSRN96 MOVE 'X' DUN,F 03350CSR ENDSR 03360C*********************************************************************** 03370CSR SR105 BEGSR 03380C* FINAL EDIT 03390CSR SETOF 77 03400CSR SETON 79 FINAL EDIT FLAG 03410CSR Z-ADD1 F 96 03420C*-------------------------------------------------------------------- 03430CSR T105A TAG 03440CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03450CSRN54 GOTO END105 03460CSR EXSR SR201 IDENTIFY-F 03470CSR EXSR SR104 EDIT 03480CSRN96 GOTO T105A 03490C*-------------------------------------------------------------------- 03500CSR END105 TAG ÐÐ03510CSR SETOF 79 03520CSR ENDSR 03530C******************************************************************** 03540CSR SR106 BEGSR 03550C* UPDATE DATA BASE. 03560CSR EXSR SR203 CLASSIFY TRAN 03570CSR 60 GOTO T106A ADD TRAN 03580CSR 61 GOTO T106D CHANGE TRAN 03590CSR 62 GOTO T106F DELETE TRAN 03600C* FLAG BAD TRAN CODE 03610CSR Z-ADD300 M 96 FLAG ERROR 03620CSR Z-ADD1 F FIELD # 03630CSR GOTO END106 03640C*------------------------------------------------------------------- 03650CSR T106A TAG 03660C* ADD TRANSACTION 03670CSR EXSR SR80 GET MASTER 03680CSR 60 GOTO T106B NOT ON FILE 03690CSR 61 GOTO T106C DELETED MASTER 03700C* FLAG DUPLICATE ADD ERROR 03710CSR Z-ADD301 M 96 FLAG ERROR 03720CSR Z-ADD1 F FIELD # 03730CSR GOTO END106 03740C*--------------------------------------------------------------------- 03750CSR T106B TAG ÐÐ03760C* ADD-- MAST NOT ON FILE 03770CSRN40 EXSR SR81 ADD NEW MASTER 03780CSR GOTO END106 03790C*--------------------------------------------------------------------- 03800CSR T106C TAG 03810C* ADD-- MAST IS DELETED 03820CSR MOVE 'A' KTSTAT RECORD STATUS 03830CSRN40 EXSR SR82 REWRITE MAST 03840CSR GOTO END106 03850C*---------------------------------------------------------------------- 03860CSR T106D TAG 03870C* CHANGE TRANSACTION. 03880CSR EXSR SR80 GET MASTER 03890CSRN60N61 GOTO T106E GOT IT 03900C* FLAG NO MASTER ERROR 03910CSR Z-ADD302 M 96 FLAG ERROR 03920CSR Z-ADD1 F FIELD # 03930CSR GOTO END106 03940C*----------------------------------------------------------------------- 03950CSR T106E TAG 03960C* REWRITE MASTER 03970CSRN40 EXSR SR82 REWRITE MAST 03980CSR GOTO END106 03990C*----------------------------------------------------------------------- 04000CSR T106F TAG ÐÐ04010C* DELETE TRANSACTION 04020CSR EXSR SR80 GET MASTER 04030CSRN60N61 GOTO T106G GOT IT 04040C* FLAG NO MASTER ERROR 04050CSR Z-ADD302 M 96 FLAG ERROR 04060CSR Z-ADD1 F FIELD # 04070CSR GOTO END106 04080C*----------------------------------------------------------------------- 04090CSR T106G TAG 04100C* DELETE MASTER. 04110CSR 96 GOTO END106 ERROR 04120CSR MOVE 'D' KTSTAT RECORD STATUS 04130CSRN40 EXSR SR82 REWRITE MASTER 04140CSR END106 ENDSR 04150C************************************************************************ 04160CSR SR201 BEGSR 04170C* IDENTIFY FIELD NO. 04180CSR F COMP 1 01 04190CSR F COMP 2 02 04200CSR F COMP 3 03 04210CSR ENDSR 04220C*********************************************************************** 04230CSR SR203 BEGSR 04240C* CLASSIFY TRAN CODE 04250CSR CRTRAN COMP 'A' 60 ADD ÐÐ04260CSR CRTRAN COMP 'C' 61 CHANGE 04270CSR CRTRAN COMP 'D' 62 DELETE 04280CSR ENDSR 04290O******************************************************************** 04300OKPTABLE EADD 81 04310O TNAME 6 04320O TVAL 21 04330O 23 'A' 04340O*------------------------------------------------------------------- 04350O E 82 04360O KTSTAT 23 04370O******************************************************************** 04380OTERM132 E 72 01 04390O 24 'ENTER TRAN CODE(A,C,D): ' 04400O CRTRAN 26 04410O*------------------------------------------------------------------- 04420O E 72 02 04430O 24 'ENTER TABLE NAME : ' 04440O TNAME 32 04450O*------------------------------------------------------------------- 04460O E 72 03 04470O 24 'ENTER TABLE DATA : ' 04480O TVAL 41 04490O*------------------------------------------------------------------- 04500O E 73 ÐÐ04510O MGTEXT 60 ** NUL ARRAY 004520 004530** A16 ARRAY 004540 004550** DUN ARRAY 004560 004570** MES ARRAY 004580---MESSAGE NOT ON FILE--- 004590/* 004600_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ú C úiX007PC P120282120282(èÈÐ00010H Q007PC00020F* GEN PROD COST GUIDE FILE FROM WHERE-USED. (X007PC) 00030F* REV 9/12/80 12:15 PM. DG-REL006 OK. 00040FPCCAND IP F 10 DISK 00050FPCGUIDE UC F 11R10AI 1 DISK A 00060FBMWU ID F 21L20AI 1 DISK 00070FTERM80 O F 80 5 00080I******************************************************************** 00090IPCCAND PC 01 00100I* PART # 10N 00110I 1 100PCPN 00120I******************************************************************** 00130IPCGUIDE PG 00140I* PART # 10N 00150I 1 100PGPN 00160I* RECORD STATUS 1A 00170I 11 11 PGSTAT 00180I**************************************************************** 00190IBMWU BW 00200I 1 100BWCPN 00210I 11 200BWAPN 00220I 21 21 BWSTAT 00230C******************************************************************** 00240C* INITIALIZE 00250C N49 EXSR SR101 INIT ÐÐ00260C N01 GOTO END 00270C MOVELPCPN W20A 20 00280C MOVE ZERO10 W20A 00290C*------------------------------------------------------------------ 00300C TAG30 TAG 00310C* SET-UP NEXT READ 00320C W20A SETLLBMWU 00330C*--------------------------------------------------------------- 00340C TAG40 TAG 00350C* GET NEXT ASSY. 00360C SETOF 5468 00370C READ BMWU 54GET COMPONENT 00380C 54 GOTO END END OF FILE 00390C BWCPN COMP PCPN 54 00400C N54 GOTO END WRONG COMPONENT 00410C BWSTAT COMP 'D' 54 00420C 54 GOTO TAG40 DELETED RECORD 00430C* ADD TO GUIDE FILE. 00440C EXSR SR72 UPDATE PCGUIDE 00450C GOTO TAG40 GET NEXT COMPONENT 00460C*------------------------------------------------------------------ 00470C END TAG 00480CLR MOVEL'Q003PC' PROG 8 00490CLR EXITFCHAIN 00500CLR RLABL PROG ÐÐ00510C******************************************************************** 00520CSR SR72 BEGSR 00530C* UPDATE PCGUIDE. 00540CSR BWAPN CHAINPCGUIDE 68 00550CSR 68 SETON 72 00560CSR 68 EXCPT 00570CSR 68 SETOF 72 00580CSR ENDSR 00590C******************************************************************** 00600CSR SR101 BEGSR 00610C* INITIALIZE (1-TIME). 00620CSR SETON 49 00630CSR MOVE ' ' BLK35 35 00640CSR MOVE ' ' BLK12 12 00650CSR MOVE ' ' BLK20 20 00660CSR Z-ADD0 ZERO10 100 00670CSR TIME TIME 60 00680CSR SETON 80 00690CSR EXCPT 00700CSR SETOF 80 00710CSR ENDSR 00720O******************************************************************** 00730OTERM80 E 80 00740O 11 'START 007PC' 00750O TIME 25 ÐÐ00760O PCPN 45 ' - - ' 00770O******************************************************************** 00780OPCGUIDE EADD 72 68 00790O BWAPN 10 00800O 11 ' ' /* 000810_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(& ­ &æX007QM P120282120282(èÈÐ00010H Q007QM00020F* LIST QMMAST - SALESMAN SEQ. (X007QM) 00030F* REVISED 7/14/81 4:45 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FQMMAST IC F 160R 8AI 1 DISK 00070FQSKEY ID F 18L17AI 1 DISK 00080FSLMNAME IT F 80 EDISK 00090FTERM24 O F 24 5 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E SLMNAME TABSLM 1 15 3 TABSLN 20 SALESMAN 00130E TABPRD 1 18 2 TABPRN 20 PRODUCT CODE 00140E TABSYS 1 2 1 TABSYN 20 SYST CODE 00150E TABSTC 1 6 1 TABSTN 10 STATUS WORD 00160E TABRES 1 5 1 TABREN 20 REASON LOST 00170E NUL 1 132 1 NULL CHAR 00180E A6 6 6 1 CALL READ PARAM. 00190E A10 10 10 1 A INPUT DATA ARRAY 00200E DUN 2 2 1 A EDIT CMPLT FLAG 00210E MES 1 1 30 00220E* 00230E* 00240E* 00250E QMD 6 7 0 DATE ARRAY ÐÐ00260E BIT 33 1 SCREEN CONTR. CHAR 00270E* 00280E* 00290I******************************************************************* 00300IBITTAB BT 00310I 1 33 BIT 00320I******************************************************************* 00330IMGFILE MG 00340I* MESSAGE FILE. 00350I 1 35 MGTEXT 00360I********************************************************************** 00370IQSKEY QS 00380I* SALESMAN ALT-KEY FILE FOR QMMAST (KEY= 1-17) 00390I* SALESMAN 3A 00400I 1 3 QSSLSM 00410I* DATE DUE 6N 00420I 4 90QSDUE 00430I* QUOTE # 5A 00440I 10 14 QSQOTE 00450I* QUOTE ITEM # 3N 00460I 15 170QSITEM 00470I* RECORD STATUS 1A 00480I 18 18 QSSTAT 00490I************************************************************************ 00500IQMMAST QM ÐÐ00510I* QUOTE MASTER. 00520I* QUOTE # 5A 00530I 1 5 QMQOTE 00540I* ITEM # 3N 00550I 6 80QMITEM 00560I* CUSTOMER NAME 20A 00570I 9 28 QMNAME 00580I* CUSTOMER RFQ # 20A 00590I 29 48 QMRFQ 00600I* RFQ ITEM # 4A 00610I 49 52 QMRFQI 00620I* CONTACT 20A 00630I 53 72 QMCONT 00640I* ASSIGNED TO (SALESMAN) 3A 00650I 73 75 QMSLSM 00660I* DATE ARRAY 7P X 6 00670I* 1 = RECEIVED 00680I* 2 = DUE 00690I* 3 = SENT 00700I* 4 = EXPECTED AWARD 00710I* 5 = FOLLOW-UP 00720I* 6 = EXPIRES 00730I P 76 99 QMD 00740I* PRODUCT CLASS 2A 00750I 100 101 QMPCLS ÐÐ00760I* SYSTEM CODE 1A 00770I 102 102 QMSYST 00780I* FILLER 103 103 FFFFFF 00790I* QUOTE AMOUNT 7P ($) 00800I P 104 1070QMAMT 00810I* DELIVERY PROMISED (DAYS ARO) 3P 00820I P 108 1090QMDEL 00830I* STATUS 1A 00840I* E = ENTERED 00850I* N = NO BID 00860I* B = BID 00870I* P = PENDING 00880I* L = LOST 00890I* W = WON 00900I* C = CANCELLED 00910I 110 110 QMSCOD 00920I* PROBABILITY OF AWARD 3.2P 00930I P 111 1122QMPROB 00940I* WON/LOST REASON 1A 00950I 113 113 QMREAS 00960I* REMARKS 40A 00970I 114 153 QMREM 00980I* RECORD STATUS 1A 00990I 160 160 QMSTAT 01000C******************************************************************** ÐÐ01010C* INITIALIZE 01020C EXSR SR101 1-TIME INIT 01030C*------------------------------------------------------------------ 01040C START TAG 01050C* SET-UP 1ST FIELD NO. 01060C SETOF 96 01070C Z-ADD1 F 30 FIELD # 01080C GOTO READ 01090C*------------------------------------------------------------------ 01100C NEXT TAG 01110C* SET-UP NEXT FIELD NO. 01120C 1 ADD F F FIELD # 01130C*----------------------------------------------------------------- 01140C READ TAG 01150C* READ DATA FROM TERMINAL. 01160C EXSR SR102 VALIDATE FIELD # 01170C 55 GOTO UPDATE DONE 01180C EXSR SR201 IDENTIFY-F 01190C SETON 69 01200C EXSR SR72 PROMPT 01210C SETOF 69 01220C EXSR SR75 READ TERMINAL 01230C 98 GOTO GOODBY GOODBY 01240C 94 GOTO MENU MENU REQUEST 01250C N77 EXSR SR104 EDIT INPUT FIELD ÐÐ01260C 93 GOTO NEWITM NEW ITEM 01270C 96 GOTO ERROR ERROR 01280C N77 GOTO NEXT NO DATA INPUT 01290C*------------------------------------------------------------------ 01300C PROCES TAG 01310C* PROCESS INPUT DATA 01320C EXSR SR103 MOVE DATA 01330C N96 EXSR SR104 EDIT DATA 01340C 96 GOTO ERROR ERROR 01350C GOTO NEXT 01360C*------------------------------------------------------------------ 01370C UPDATE TAG 01380C* UPDATE DATA BASE. 01390C EXSR SR105 FINAL EDIT 01400C 96 GOTO ERROR ERROR 01410C EXSR SR106 UPDATE 01420C 96 GOTO ERROR ERROR 01430C 94 GOTO MENU RET TO MENU. 01440C 98 GOTO GOODBY SIGN-OFF. 01450C GOTO START 01460C*------------------------------------------------------------------- 01470C JUMP TAG 01480C* SET-UP JUMP TO REQUESTED FIELD 01490C 1 ADD W W 30 01500C W COMP 10 54 ÐÐ01510C 54 Z-ADD318 M 50 96 FLAG ERROR 01520C 54 GOTO ERROR BAD ESC 01530C MOVE '000' W3A 3 01540C MOVEAA10,W W3A 01550C Z-ADD3 W2N 20 01560C EXIT SUBRAJ R. JUSTIFY 01570C RLABL W2N 01580C RLABL W3A 01590C MOVE W3A F NEW FIELD # 01600C GOTO READ 01610C*-------------------------------------------------------------------- 01620C ERROR TAG 01630C EXSR SR102 VALIDATE FIELD # 01640C EXSR SR89 GET MSG 01650C EXSR SR73 PUT MSG 01660C GOTO READ 01670C*------------------------------------------------------------------ 01680C NEWITM TAG 01690C* SET-UP LINK FOR NEW ITEM 01700C GOTO START 01710C*------------------------------------------------------------------- 01720C MENU TAG 01730C* SET-UP LINK TO MENU 01740C MOVEL'Q070DP' PROG 8 01750C GOTO END ÐÐ01760C*-------------------------------------------------------------------- 01770C GOODBY TAG 01780C* LINK TO SIGN-OFF 01790C MOVEL'GOODBY' PROG 01800C GOTO END 01810C*------------------------------------------------------------------- 01820C END TAG 01830C PROG COMP BLK8 54 01840C N54 MOVEL'Q070DP' PROG 8 01850C EXITFCHAIN LINK TO NEXT PROG 01860C RLABL PROG 01870C********************************************************************* 01880CSR SR72 BEGSR 01890C* PUT DATA TO TERMINAL 01900CSR 01 69 EXITFQTOPF CLEAR CRT 01910CSR SETON 72 01920CSR EXCPT PUT DATA 01930CSR SETOF 72 01940CSR ENDSR 01950C*********************************************************************** 01960CSR SR73 BEGSR 01970C* PUT ERROR MESSAGE TO TERMINAL 01980CSR SETON 73 01990CSR EXCPT PUT MSG 02000CSR SETOF 73 ÐÐ02010CSR Z-ADDM LSTERR 50 02020CSR ENDSR 02030C******************************************************************* 02040CSR SR75 BEGSR 02050C* READ FROM TERMINAL 02060CSR SETOF 779096 02070CSR SETOF 939291 02080CSR SETOF 8988 02090CSR MOVE BIT,6 A6,2 BUF LENGTH 02100CSR MOVEAA6 W6A 6 02110CSR MOVE BLK10 W10A 10 BUFFER 02120CSR EXITFXCREAD READ TERM 02130CSR RLABL W10A 02140CSR RLABL W6A 02150CSR MOVEAW10A A10 02160CSR MOVE BLK10 W10A 02170CSR Z-ADD1 W 30 02180CSR '\' LOKUPA10,W 90 FLAG ESC 02190CSRN90 GOTO T75B NOT ESC 02200CSR 1 ADD W W 02210CSR W COMP 10 54 02220CSR 54 GOTO T75A BAD ESC 02230CSR A10,W COMP 'G' 98 GOODBY 02240CSR A10,W COMP 'E' 94 MENU 02250CSR A10,W COMP 'N' 93 NEW ITEM ÐÐ02260CSR 98 02270COR 94 02280COR 93 GOTO END75 02290C*------------------------------------------------------------------ 02300CSR T75A TAG 02310C* FLAG BAD ESC INPUT 02320CSR Z-ADD318 M 96 FLAG ERROR 02330CSR GOTO END75 02340C*-------------------------------------------------------------------- 02350CSR T75B TAG 02360C* MOVE DATA 02370CSR Z-ADD1 W 02380CSR ' ' LOKUPA10,W 77 02390CSR 77 MOVEAA10,W W10A INPUT DATA 02400C*-------------------------------------------------------------------- 02410CSR END75 TAG 02420C* INIT PREV ERROR MSG. 02430CSR LSTERR COMP 0 54 02440CSR 54 MOVE BLK35 MGTEXT 02450CSR 54 EXSR SR73 BLANK MESSAGE 02460CSR Z-ADD0 LSTERR 50 02470CSR ENDSR 02480C********************************************************************** 02490CSR SR89 BEGSR 02500C* GET MESSAGE MASTER ÐÐ02510CSR M CHAINMGFILE 54 02520CSR 54 MOVE BLK35 MGTEXT 02530CSR 54 MOVELM MGTEXT 02540CSR 54 MOVE MES,1 MGTEXT 02550CSR ENDSR 02560C*********************************************************************** 02570CSR SR101 BEGSR 02580C* 1-TIME INITIALIZE 02590CSR MOVE BIT,1 NUL 02600CSR MOVE BIT,1 A6 02610CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02620CSR MOVE ' ' BLK10 10 02630C* DEFINE WORK FIELDS,ETC. 02640CSR MOVE ' ' BLK35 35 02650CSR MOVE ' ' BLK8 8 02660CSR MOVE ' ' BLK5 5 02670CSR MOVE ' ' BLK20 20 02680C* 02690C* 02700CSR ENDSR 02710C********************************************************************** 02720CSR SR102 BEGSR 02730C* VALIDATE FIELD NO. 02740CSR F COMP 0 54 02750CSRN54 Z-ADD1 F ÐÐ02760CSR F COMP FLIMIT 55 02770CSR 55 Z-ADD1 F 02780CSR ENDSR 02790C******************************************************************** 02800CSR SR103 BEGSR 02810C* MOVE INPUT DATA 02820CSR EXSR SR201 IDENTIFY-F 02830CSR 01 MOVELW10A TSLSM 3 SALESMAN CODE 02840CSR MOVE ' ' DUN,F EDIT FLAG 02850CSR ENDSR 02860C******************************************************************** 02870CSR SR104 BEGSR 02880C* EDIT INPUT DATA 02890CSR 96 MOVE ' ' DUN,F EDIT FLAG 02900CSRN96 MOVE 'X' DUN,F 02910CSR ENDSR 02920C*********************************************************************** 02930CSR SR105 BEGSR 02940C* FINAL EDIT 02950CSR SETON 79 FINAL EDIT FLAG 02960CSR Z-ADD1 F 96 02970C*-------------------------------------------------------------------- 02980CSR T105A TAG 02990CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03000CSRN54 GOTO END105 ÐÐ03010CSR EXSR SR201 IDENTIFY-F 03020CSR EXSR SR104 EDIT 03030CSRN96 GOTO T105A 03040C*-------------------------------------------------------------------- 03050CSR END105 TAG 03060CSR SETOF 79 03070CSR ENDSR 03080C******************************************************************** 03090CSR SR106 BEGSR 03100C* DISPLAY QMMAST RECORD. 03110CSR MOVE BLK35 W17A 17 03120CSR MOVELTSLSM W17A 03130CSR W17A SETLLQSKEY 03140CSR Z-ADD0 COUNT 30 03150CSR SETOF 74 03160C*------------------------------------------------------------------- 03170CSR T106A TAG 03180CSR SETOF 54 03190CSR READ QSKEY 54 03200CSR 54 GOTO T106B END OF FILE. 03210CSR QSSTAT COMP 'D' 54 03220CSR 54 GOTO T106A 03230CSR TSLSM COMP QSSLSM 54 03240CSRN54 GOTO T106B WRONG SALESMAN 03250CSR MOVELQSQOTE W8A 8 ÐÐ03260CSR MOVE QSITEM W8A 03270CSR W8A CHAINQMMAST 54 03280CSR 54 GOTO T106A 03290CSR QMSTAT COMP 'D' 54 03300CSRN54 QMITEM COMP 0 54 03310CSR 54 GOTO T106A 03320CSR EXSR SR205 TABLE LOKUPS. 03330CSR SETON 76 03340CSR EXCPT DISPLAY QMMAST 03350CSR SETOF 76 03360CSR SETON 74 03370CSR 1 ADD COUNT COUNT 03380CSR COUNT COMP 2 54 03390CSRN54 GOTO T106A 03400CSR Z-ADD34 M 03410CSR GOTO T106C 03420C*------------------------------------------------------------------- 03430CSR T106B TAG 03440C* DISPLAY END PAGE/FILE MSG. 03450CSR Z-ADD317 M 03460C*----------------------------------------------------------------- 03470CSR T106C TAG 03480CSR EXSR SR89 GET END MSG. 03490CSR EXSR SR73 END PAGE/FILE MSG 03500CSR EXSR SR75 ÐÐ03510CSR 94 EXIT. 03520COR 98 GOODBY. 03530COR 93 GOTO END106 NEW ITEM. 03540CSR Z-ADD0 COUNT 74 03550CSR M COMP 317 54 03560CSRN54 GOTO T106A 03570CSR END106 ENDSR 03580C************************************************************************ 03590CSR SR201 BEGSR 03600C* IDENTIFY FIELD NO. 03610CSR F COMP 1 01 03620CSR ENDSR 03630C******************************************************************** 03640CSR SR205 BEGSR 03650C* GET CODE DESCRIPTIONS. 03660CSR QMPCLS LOKUPTABPRD TABPRN 54 PRODUCT NAME 03670CSR 54 MOVE TABPRN PRDNAM 20 03680CSRN54 MOVE BLK20 PRDNAM 03690CSR QMSYST LOKUPTABSYS TABSYN 54 SYSTEM NAME 03700CSR 54 MOVE TABSYN SYSNAM 20 03710CSRN54 MOVE BLK20 SYSNAM 03720CSR QMREAS LOKUPTABRES TABREN 54 REASON NAME 03730CSR 54 MOVE TABREN RESNAM 20 03740CSRN54 MOVE BLK20 RESNAM 03750CSR QMSCOD LOKUPTABSTC TABSTN 54 STATUS NAME ÐÐ03760CSR 54 MOVE TABSTN STCNAM 10 03770CSRN54 MOVE BLK20 STCNAM 03780CSR ENDSR 03790O******************************************************************** 03800OTERM132 E 76N74 03810O 55 'QUOTE INQUIRY - ' 03820O 71 'SALESMAN SEQUENCE' 03830O 102 'WON' 03840O*------------------------------------------------------------------- 03850O E 76N74 03860O 5 'QUOTE' 03870O 10 'ITEM' 03880O 20 'CUSTOMER' 03890O 41 'CONTACT' 03900O 60 'SLSM' 03910O 66 'PROD' 03920O 71 'SYS' 03930O 83 'AMOUNT$' 03940O 91 'STATUS' 03950O 97 'PROB' 03960O 103 'LOST' 03970O 126 'SCHEDULE' 03980O*------------------------------------------------------------------- 03990O E 76 04000O*------------------------------------------------------------------- ÐÐ04010O E 76 04020O QMQOTE 5 04030O QMITEMZ 9 04040O QMNAME 32 04050O QMCONT 54 04060O QMSLSM 59 04070O QMPCLS 66 04080O QMSYST 70 04090O QMAMT 83 ' , , $0' 04100O QMSCOD 88 04110O QMPROBZ 96 04120O 97 '%' 04130O QMREAS 102 04140O 118 'REC''D' 04150O QMD,1 132 ' - - ' 04160O*------------------------------------------------------------------- 04170O E 76 04180O 17 'RFQ#:' 04190O QMRFQ 42 04200O 47 '-' 04210O QMRFQI 48 04220O PRDNAM 85 04230O STCNAM 97 04240O 116 'DUE' 04250O QMD,2 132 ' - - ' ÐÐ04260O*------------------------------------------------------------------- 04270O E 76 04280O 20 'REMARKS:' 04290O QMREM 62 04300O RESNAM 107 04310O 117 'SENT' 04320O QMD,3 132 ' - - ' 04330O*------------------------------------------------------------------- 04340O E 76 04350O 118 'AWARD' 04360O QMD,4 132 ' - - ' 04370O*------------------------------------------------------------------- 04380O E 76 04390O 122 'FOLLOW-UP' 04400O QMD,5 132 ' - - ' 04410O*------------------------------------------------------------------- 04420O E 76 04430O 120 'EXPIRES' 04440O QMD,6 132 ' - - ' 04450O*------------------------------------------------------------------- 04460O E 76 04470O*------------------------------------------------------------------- 04480O E 73 04490O* PUT MSG. 04500O 96 5 '*****' ÐÐ04510O MGTEXT 48 04520O 96 55 '*****' 04530O BIT,14 132 04540O******************************************************************** 04550OTERM24 E 72 01 04560O 24 'ENTER SALESMAN CODE: ' ** TABPRD/TABPRN - PROD CLASS 00457011MINI SERIES 00458012SERIES 1500 00459021SERIES 1000 00460022SERIES 3000 00461023SERIES 5900 00462024SERIES 5300 00463041SERIES X 00464042SERIES 10 00465051SERIES 5100 00466052SERIES 1400 00467053SERIES 8100 004680541400/8100 CONTROLS 00469055SYSTEM 21 00470059OTHER SYSTEMS 00471060RF EQUIPMENT 00472070EQUA-DYNE EQUIPMENT 00473090MISC. EQUIPMENT 00474099SKY 515 004750ÐÐ** TABSYS/TABSYN - SYST CODE 004760SSYSTEM 004770NNON-SYSTEM 004780** TABSTC/TABSTN - STATUS CODE 004790EENTERED 004800NNO BID 004810PPENDING 004820LLOST 004830WWON 004840CCANCELLED 004850** TABRES/TABREN - REASON LOST 0048601PRICE 0048702DELIVERY 0048803SPECIFICATIONS 0048904OTHER 0049005NOT KNOWN 004910** NUL ARRAY 004920 004930** A6 ARRAY 004940 004950** A10 ARRAY 004960 004970** DUN ARRAY 004980 004990** MES ARRAY 005000ÐÐ---MESSAGE NOT ON FILE--- 005010/* 005020_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(” ¼X007RM P120282120282(èÈÐ00010H Q007RM00020F* DISPLAY WORK ORDER INPUT FILE (X007RM) DG REL006 OK 00030F* REVISED 11/29/79 5:05 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FWOINPUT ID F 32L27AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FCRTFILE IC F 256R DISK 00090FTERM132 O F 132 5 00100F**************************************************************** 00110E NUL 1 72 1 NULL CHAR 00120E A6 6 6 1 CALL READ PARAM. 00130E A12 12 12 1 A INPUT DATA ARRAY 00140E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00150E DUN 9 9 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E* 00180E* 00190E BIT 256 1 SCREEN CONTR. CHAR 00200E* 00210E* 00220I******************************************************************* 00230IBITHEX BT 00240I 1 256 BIT 00250I********************************************************************* ÐÐ00260ICRTFILE CR 00270I 74 79 CRMENU 00280I******************************************************************** 00290IWOINPUT WI 00300I* WORK ORDER INPUT TRANSACTION. 00310I* PART # 12A 00320I 1 12 WIPN 00330I* DUE DATE 6N 00340I 13 180WIDUE 00350I* WORK ORDER # 6A 00360I 19 24 WIORD 00370I* SPLIT # 3N 00380I 25 270WISPLT 00390I* QTY 7P 00400I P 28 310WIQTY 00410I* RECORD STATUS 1A 00420I 32 32 WISTAT 00430I******************************************************************** 00440IPMMST2 PM 00450I 31 59 PMDESC 00460I 674 674 PMSTAT 00470I******************************************************************** 00480IMGFILE MG 00490I* MESSAGE FILE. 00500I 1 35 MGTEXT ÐÐ00510C******************************************************************** 00520C* INITIALIZE 00530C EXSR SR101 1-TIME INIT 00540C MOVE ' ' TTCODE 1 STUPIDITY. 00550C*------------------------------------------------------------------ 00560C START TAG 00570C* SET-UP 1ST FIELD NO. 00580C Z-ADD1 F 30 FIELD # 00590C MOVE ' ' DUN 00600C Z-ADD0 TPN 100 TRAN PART # 00610C GOTO READ 00620C*------------------------------------------------------------------ 00630C NEXT TAG 00640C* SET-UP NEXT FIELD NO. 00650C 1 ADD F F FIELD # 00660C*----------------------------------------------------------------- 00670C READ TAG 00680C* READ DATA FROM TERMINAL. 00690C SETOF 9096 00700C EXSR SR102 VALIDATE FIELD # 00710C 55 GOTO UPDATE DONE 00720C EXSR SR201 IDENTIFY-F 00730C Z-ADD298 M 50 ENTER PART # MSG 00740C SETON 69 00750C EXSR SR89 GET MSG. ÐÐ00760C EXSR SR73 PROMPT 00770C SETOF 69 00780C EXSR SR75 READ TERMINAL 00790C*------------------------------------------------------------------- 00800C ESCAPE TAG 00810C 98 GOTO GOODBY GOODBY 00820C 94 GOTO MENU MENU REQUEST 00830C N77N88 EXSR SR104 EDIT INPUT FIELD 00840C 93 GOTO NEWITM NEW ITEM 00850C 92 GOTO JUMP FIELD JUMP REQST 00860C 91 GOTO NEXT SKIP FORWARD 00870C 89 F SUB 1 F SKIP BACKWARD 00880C 89 GOTO READ " " 00890C 88 SETOF 90 SPACE FILL 00900C 88 SETON 77 " " 00910C 87 GOTO START 00920C 86 GOTO UPDATE UPDATE 00930C 85 GOTO READ REPEAT 00940C 96 GOTO ERROR ERROR 00950C 90 Z-ADD318 M 96 00960C 90 GOTO ERROR 00970C N77 GOTO NEXT NO DATA INPUT 00980C*------------------------------------------------------------------ 00990C PROCES TAG 01000C* PROCESS INPUT DATA ÐÐ01010C EXSR SR103 MOVE DATA 01020C N96 EXSR SR104 EDIT DATA 01030C 96 GOTO ERROR ERROR 01040C GOTO NEXT 01050C*------------------------------------------------------------------ 01060C UPDATE TAG 01070C* UPDATE DATA BASE. 01080C EXSR SR105 FINAL EDIT 01090C 96 GOTO ERROR ERROR 01100C EXSR SR106 UPDATE 01110C 96 GOTO ERROR ERROR 01120C 90 GOTO ESCAPE 01130C GOTO START 01140C*------------------------------------------------------------------- 01150C JUMP TAG 01160C* SET-UP JUMP TO REQUESTED FIELD 01170C 1 ADD W W 30 01180C W COMP 30 54 01190C 54 Z-ADD318 M 50 96 FLAG ERROR 01200C 54 GOTO ERROR BAD ESC 01210C MOVE '000' W3A 3 01220C MOVEAA12,W W3A 01230C Z-ADD3 W2N 20 01240C EXIT SUBRAJ R. JUSTIFY 01250C RLABL W2N ÐÐ01260C RLABL W3A 01270C MOVE W3A F NEW FIELD # 01280C GOTO READ 01290C*-------------------------------------------------------------------- 01300C ERROR TAG 01310C EXSR SR102 VALIDATE FIELD # 01320C EXSR SR89 GET MSG 01330C EXSR SR73 PUT MSG 01340C GOTO READ 01350C*------------------------------------------------------------------ 01360C NEWITM TAG 01370C* SET-UP LINK FOR NEW ITEM 01380C GOTO START 01390C GOTO END 01400C*------------------------------------------------------------------- 01410C MENU TAG 01420C* SET-UP LINK TO MENU 01430C MOVELCRMENU PROG 8 01440C GOTO END 01450C*-------------------------------------------------------------------- 01460C GOODBY TAG 01470C* LINK TO SIGN-OFF 01480C MOVEL'GOODBY' PROG 01490C GOTO END 01500C*------------------------------------------------------------------- ÐÐ01510C END TAG 01520C EXITFCHAIN LINK TO NEXT PROG 01530C RLABL PROG 01540C******************************************************************** 01550CSR SR71 BEGSR 01560C* PUT HEADINGS. 01570CSR SETON 71 01580CSR EXCPT PUT HEADINGS. 01590CSR SETOF 71 01600CSR Z-ADD6 COUNT 01610CSR ENDSR 01620C*********************************************************************** 01630CSR SR73 BEGSR 01640C* PUT ERROR MESSAGE TO TERMINAL 01650CSR SETON 73 01660CSR EXCPT PUT MSG 01670CSR SETOF 73 01680CSR 69 MOVELBIT,1 W2A 2 01690CSR 69 MOVE BIT,44 W2A 01700CSR 69 EXITFQCCR 01710CSR 69 EXITFQMOVR 01720CSR RLABL W2A 01730CSR ENDSR 01740C******************************************************************** 01750CSR SR74 BEGSR ÐÐ01760C* PUT FILE DATA TO TERMINAL. 01770CSR MOVELWIPN NUMPN 100 OUTPUT PART # 01780CSR SETON 74 01790CSR EXCPT 01800CSR SETOF 74 01810CSR 1 ADD COUNT COUNT 30 01820CSR ENDSR 01830C******************************************************************* 01840CSR SR75 BEGSR 01850C* READ FROM TERMINAL 01860CSR SETOF 779096 01870CSR SETOF 939291 01880CSR SETOF 898887 01890CSR SETOF 8685 01900CSR MOVE BIT,7 A6,2 BUF LENGTH 01910CSR MOVEAA6 W6A 6 01920CSR MOVE BLK12 W12A 12 BUFFER 01930CSR EXITFQWREED READ TERM 01940CSR RLABL W12A 01950CSR RLABL W6A 01960CSR MOVEAW12A A12 01970CSR MOVE BLK12 W12A 01980CSR Z-ADD1 W 30 01990CSR '\' LOKUPA12,W 90 FLAG ESC 02000CSRN90 GOTO T75B NOT ESC ÐÐ02010CSR 1 ADD W W 02020CSR W COMP 30 54 02030CSR 54 GOTO T75A BAD ESC 02040CSR A12,W COMP 'G' 98 GOODBY 02050CSR A12,W COMP 'E' 94 MENU 02060CSR A12,W COMP 'N' 93 NEW ITEM 02070CSR A12,W COMP 'J' 92 JUMP 02080CSR A12,W COMP 'F' 91 SKIP FRWRD 02090CSR A12,W COMP 'B' 89 SKIP BKWRD 02100CSR A12,W COMP 'S' 88 SPACE FILL 02110CSR A12,W COMP 'H' 87 HOME 02120CSR A12,W COMP 'U' 86 UPDATE 02130CSR A12,W COMP 'R' 85 REPEAT 02140CSR 98 02150COR 94 02160COR 93 02170COR 92 02180COR 91 02190COR 89 02200COR 88 02210COR 87 02220COR 86 02230COR 85 GOTO END75 GOOD ESC 02240C*------------------------------------------------------------------ 02250CSR T75A TAG ÐÐ02260C* FLAG BAD ESC INPUT 02270CSR Z-ADD318 M 96 FLAG ERROR 02280CSR GOTO END75 02290C*-------------------------------------------------------------------- 02300CSR T75B TAG 02310C* MOVE DATA 02320CSR Z-ADD1 W 02330CSR ' ' LOKUPA12,W 77 02340CSR 77 MOVEAA12,W W12A INPUT DATA 02350C*-------------------------------------------------------------------- 02360CSR END75 ENDSR 02370C********************************************************************** 02380CSR SR89 BEGSR 02390C* GET MESSAGE MASTER 02400CSR M CHAINMGFILE 54 02410CSR 54 MOVE BLK35 MGTEXT 02420CSR 54 MOVELM MGTEXT 02430CSR 54 MOVE MES,1 MGTEXT 02440CSR ENDSR 02450C*********************************************************************** 02460CSR SR101 BEGSR 02470C* 1-TIME INITIALIZE 02480CSR MOVE BIT,1 NUL 02490CSR MOVE BIT,1 A6 02500CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ02510C* GET CRTFILE 02520CSR Z-ADD0 W1N 10 02530CSR Z-ADD0 W2N 20 02540CSR MOVE ' ' W2A 2 02550CSR MOVE ' ' W8A 8 02560CSR EXITFPGMINX GET PORT # 02570CSR RLABL W8A 02580CSR RLABL W2N 02590CSR RLABL W1N 02600CSR RLABL W2A 02610CSR MOVE W2A PORT 20 02620CSR PORT COMP 0 54 02630CSRN54 Z-ADD25 PORT 02640CSR PORT CHAINCRTFILE H9 02650CSR H9 GOTO END101 02660C* DEFINE WORK FIELDS, ETC. 02670CSR MOVE ' ' BLK35 35 02680CSR MOVE ' ' BLK12 12 02690CSR END101 ENDSR 02700C********************************************************************** 02710CSR SR102 BEGSR 02720C* VALIDATE FIELD NO. 02730CSR F COMP 0 54 02740CSRN54 Z-ADD1 F 02750CSR F COMP FLIMIT 55 ÐÐ02760CSR 55 Z-ADD1 F 02770CSR ENDSR 02780C******************************************************************** 02790CSR SR103 BEGSR 02800C* MOVE INPUT DATA 02810CSR EXSR SR201 IDENTIFY-F 02820CSR EXSR SR202 R. JUSTIFY 02830CSR 01 MOVE W12A TPN 100 PART #. 02840CSR MOVE ' ' DUN,F EDIT FLAG 02850CSR ENDSR 02860C******************************************************************** 02870CSR SR104 BEGSR 02880C* EDIT INPUT DATA 02890CSR 96 MOVE ' ' DUN,F EDIT FLAG 02900CSRN96 MOVE 'X' DUN,F 02910CSR ENDSR 02920C*********************************************************************** 02930CSR SR105 BEGSR 02940C* FINAL EDIT 02950CSR SETON 79 FINAL EDIT FLAG 02960CSR Z-ADD1 F 96 02970C*-------------------------------------------------------------------- 02980CSR T105A TAG 02990CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03000CSRN54 GOTO END105 ÐÐ03010CSR EXSR SR201 IDENTIFY-F 03020CSR EXSR SR104 EDIT 03030CSRN96 GOTO T105A 03040C*-------------------------------------------------------------------- 03050CSR END105 TAG 03060CSR SETOF 79 03070CSR ENDSR 03080C******************************************************************** 03090CSR SR106 BEGSR 03100C* DISPLAY FILE DATA. 03110CSR EXSR SR71 PUT HEADING. 03120C*------------------------------------------------------------------- 03130CSR T106A TAG 03140CSR MOVELTPN W12A 12 03150CSR MOVE ' ' W12A 03160CSR W12A SETLLWOINPUT 03170C*------------------------------------------------------------------- 03180CSR T106B TAG 03190CSR SETOF 54 03200CSR READ WOINPUT 54 READ. 03210CSR 54 GOTO T106T END FILE. 03220CSR WISTAT COMP 'D' 54 03230CSR 54 GOTO T106B DELETED. 03240CSR EXSR SR74 PUT DATA. 03250CSR COUNT COMP 28 54 ÐÐ03260CSRN54 GOTO T106B 03270CSR EXITFQEPAGE END PAGE MSG. 03280CSR EXSR SR75 READ. 03290CSR 90 GOTO END106 ESCAPE. 03300CSR EXSR SR71 PUT HEADING. 03310CSR 77 Z-ADD1 F 03320CSR 77 EXSR SR103 03330CSR 77 GOTO T106A SET NEW LIMIT. 03340CSR GOTO T106B CONTINUE. 03350C*------------------------------------------------------------------- 03360CSR T106T TAG 03370CSR EXITFQEFILE END FILE MSG. 03380CSR EXSR SR75 READ. 03390CSR 90 ESCAPE. 03400CORN77 GOTO END106 NO DATA INPUT. 03410CSR Z-ADD1 F 03420CSR EXSR SR103 03430CSR EXSR SR71 PUT HEADING. 03440CSR GOTO T106A 03450CSR END106 ENDSR 03460C************************************************************************ 03470CSR SR201 BEGSR 03480C* IDENTIFY FIELD NO. 03490CSR F COMP 1 01 03500CSR ENDSR ÐÐ03510C********************************************************************** 03520CSR SR202 BEGSR 03530C* RIGHT JUSTIFY 03540CSR F LOKUPNUM 54 03550CSRN54 GOTO END202 NOT NUMERIC FIELD 03560CSR Z-ADD12 W2N 20 03570CSR MOVELW12A W12A 12 03580CSR EXIT SUBRAJ R. JUSTIFY 03590CSR RLABL W2N 03600CSR RLABL W12A 03610CSR END202 ENDSR 03620O******************************************************************** 03630OTERM132 E 71 03640O E 71 03650O 73 'WORK ORDER INPUT' 03660O E 71 03670O E 71 03680O 4 'TRAN' 03690O 14 'PART-NO.' 03700O 29 'DESCRIPTION' 03710O 57 'DATE-DUE' 03720O 71 'WORK-ORDER' 03730O 84 'QUANTITY' 03740O E 71 03750O*------------------------------------------------------------------- ÐÐ03760O E 74 03770O NUMPN 18 ' - - ' 03780O PMDESC 49 03790O WIDUE 59 ' - - ' 03800O WIORD 71 03810O WIQTY 2 84 03820O*------------------------------------------------------------------- 03830O E 73 03840O 96 5 '*****' 03850O N96 5 ' ' 03860O MGTEXT 40 ** NUL ARRAY 003870 003880** A6 ARRAY 003890 003900** A12 ARRAY 003910 003920** NUM ARRAY 003930001 003940** DUN ARRAY 003950 003960** MES ARRAY 003970MESSAGE NOT ON FILE 003980/* 003990_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(RQ RcX007SM P120282120282(èÈÐ00010H Q007SM00020F* PRINT SALES ORDERS (DIABLO). (X007SM) 00030F* REVISED 6-10-81 9:15 AM. 00040FSMMAST UP F 448 6AI 1 DISK 00050FSIMAST ID F 192L11AI 1 DISK 00060FCMMAST IC F 576R 5AI 1 DISK 00070FSXMAST IC F 88R13AI 1 DISK 00080FSXFILE IC F 86R DISK 00090FCRTFILE UC F 256R DISK 00100FCMBTAFILIC F 352R 5AI 1 DISK 00110E******************************************************************** 00120E SMA 8 35 SMMAST ADDRESS 00130E SMD 9 7 0 SMMAST DATES 00140E SM$ 2 9 2 SMMAST $ 00150E SIQ 6 7 0 SIMAST QTYS 00160E SI$ 2 9 2 SIMAST $ 00170E SID 7 7 0 SIMAST DATES 00180E CMA 7 35 A CMMAST ADDRESS 00190E CMB 10 9 2 CUR BACKLOG 00200E CMAR 4 9 2 CUR RECEIVABLES 00210E CALL 5 6 CALL STACK 00220E SMP 25 5 0A 00230E SXT 70 1 A SXFILE TEXT 00240E PRT 96 1 A DIABLO OUTPUT 00250I******************************************************************** ÐÐ00260ICRTFILE CR 00270I 1 50CREMPL 00280I 6 13 CRUSER 00290I 14 18 CRDEPT 00300I 19 26 CRJOB 00310I 27 27 CRSHUT 00320I 28 330CRTIMI 00330I 34 370CRDATE 00340I 38 67 CALL 00350I 68 73 CRRET 00360I 74 79 CRMENU 00370I 81 176 PRT 00380I****************************************************************** 00390ISMMAST SM 01 448NCD 440 CP 00400I* SALES ORDER MASTER. 00410I* SALES ORDER NO. 6A 00420I 1 6 SMORD 00430I* CUSTOMER NO. 5P 00440I P 7 90SMCUST 00450I* REPRESENTATIVE # 5P 00460I P 10 120SMREP 00470I* REP TYPE 1A 00480I* G = GSA 00490I* W = WARRANTY REPLACEMENT 00500I* B = GSA WARRANTY REPLACEMENT ÐÐ00510I 13 13 SMREPT 00520I* CUSTOMER P.O.# 20A 00530I 14 33 SMCPO 00540I* CUSTOMER CLASS 2A 00550I 34 35 SMCCLS 00560I* GEOGRAPHIC CODE 5A 00570I 36 40 SMGEO 00580I* TERRITORY CODE 3A 00590I 41 43 SMTER 00600I* DISCOUNT % 3.2P 00610I P 44 452SMDISC 00620I* TAX CODE 1A 00630I 46 46 SMTAX 00640I* FOB 1A 00650I* D = DESTINATION 00660I* F = FACTORY 00670I 47 47 SMFOB 00680I* CREDIT TERMS 8A 00690I 48 55 SMTERM 00700I* SHIPPING INSTR 15A 00710I 56 70 SMSHIP 00720I* SALES CONTACT 35A 00730I 71 105 SMCONT 00740I* SHIP-TO ADDRESS 35A X 8 00750I 106 385 SMA ÐÐ00760I* HOLD CODE-CREDIT 1A 00770I 386 386 SMHCC 00780I* HOLD CODE-CUST REQST 1A 00790I 387 387 SMHCR 00800I* PARTIAL SHIPMENT OK CODE 1A (Y,N) 00810I 388 388 SMPOK 00820I* DATE HISTORY 7P X 9 00830I* 1 = DATE BOOKED 00840I* 2 = REQUESTED SHIP DATE 00850I* 3 = PROMISED SHIP DATE 00860I* 4 = LAST ACTUAL SHIP DATE 00870I* 5 = DATE LAST TRAN 00880I* 6 = DATE CLOSED 00890I* 7 = HOLD DATE-CREDIT 00900I* 8 = HOLD DATE-CUST 00910I* 9 = NOT USED 00920I P 389 424 SMD 00930I* NUMB OF INVOICE COPIES 1N 00940I 425 4250SMINVN 00950I* DOLLAR AMTS 9.2P X 2 00960I* 1 = ORDER VALUE 00970I* 2 = VALUE BILLED 00980I P 426 435 SM$ 00990I* LAST USED GROUP 2N 01000I 436 4370SMLUG ÐÐ01010I* SHIP METHOD 1A 01020I* P = PRE-PAID 01030I* C = COLLECT 01040I 438 438 SMSMET 01050I* EXPORT CODE 1A 01060I 439 439 SMEXPT 01070I* PRINT FLAG 1A 01080I 440 440 SMPFLG 01090I* FILLER 441 445 FFFFFF 01100I* LAST ITEM # USED 3P 01110I P 446 4470SMLITM 01120I* RECORD STATUS 1A 01130I 448 448 SMSTAT 01140I*------------------------------------------------------------------- 01150I GG 02 01160I****************************************************************** 01170ISIMAST SI 01180I* SALES ITEM RECORD. 01190I* KEY AREA 1-11. 01200I* SALES ORDER 6A 01210I 1 6 SIORD 01220I* ITEM # 3N 01230I 7 90SIITEM 01240I* SUB-ITEM # 2N 01250I 10 110SISUB ÐÐ01260I* GROUP CODE 2N 01270I 12 130SIGRUP 01280I* FORMAT CODE 1A 01290I* N = NON-INVENTORY 01300I* NOT N= INVENTORY 01310I 14 14 SITYPE 01320I* CUSTOMER PO ITEM # 5A 01330I 15 19 SICPOI 01340I* NON-INVENTORY DESCRIPTION 70A 01350I 20 89 SINDES 01360I* PART # 10N 01370I 20 290SIPN 01380I* DESCRIPTION 29A 01390I 30 58 SIDESC 01400I* UNIT MEASURE 2A 01410I 59 60 SIUM 01420I* MODEL 12A 01430I 61 72 SIMODL 01440I* LOT CHARGE CODE 1A 01450I* L = LOT PRICE 01460I* N = NO CHARGE 01470I* G = GSA PRICE 01480I* OTHER = LIST PRICE 01490I 90 90 SILOT 01500I* PRICING METHOD 1A ÐÐ01510I* A = AUTOMATIC 01520I* M = MANUAL INPUT 01530I 91 91 SIPMET 01540I* DISCOUNT % 3.2P 01550I P 92 932SIDISC 01560I* HOLD CODE-CREDIT 1A 01570I 94 94 SICHLD 01580I* HOLD CODE-CUSTOMER 1A 01590I 95 95 SIMHLD 01600I* QTYS 7P X 6 01610I* 1 = QTY ORDERED 01620I* 3 = ISSUED FROM STOCK 01630I* 4 = SHIPPED 01640I* 5 = SCRAPPED 01650I* 6 = RET TO STOCK 01660I P 96 119 SIQ 01670I* PRICES 9.2P X 2 01680I* 1 = UNIT/LOT PRICE 01690I* 2 = SET-UP CHARGE 01700I P 120 129 SI$ 01710I* DATE HISTORY 7P X 7 01720I* 1 = REQUESTED SHIP DATE 01730I* 2 = PROMISED SHIP DATE 01740I* 3 = DATE ORDER ENTERED 01750I* 4 = LAST STOCK ISSUE ÐÐ01760I* 5 = LAST SHIPMENT 01770I* 6 = LAST SCRAP 01780I* 7 = LAST RET STOCK 01790I P 130 157 SID 01800I* PRODUCT LINE 4N 01810I 158 1610SIPL 01820I* PARTIAL SHIPMENT OK FLAG 1A 01830I 162 162 SIPRTL 01840I* FILLER 163 191 FFFFFF 01850I* RECORD STATUS 1A 01860I 192 192 SISTAT 01870I******************************************************************** 01880ISXMAST SX 01890I* SALES TEXT MASTER. 01900I* SALES ORDER 6A 01910I 1 6 SPORD 01920I* SALES ITEM 3N 01930I 7 90SPITEM 01940I* SUB-ITEM 2N 01950I 10 110SPSUB 01960I* RECORD # 2N 01970I 12 130SPREC 01980I* POINTERS 5P X 25 01990I P 14 88 SMP 02000I******************************************************************** ÐÐ02010ICMMAST CM 02020I* CUSTOMER MASTER. 02030I* CUSTOMER NO. 5N 02040I 1 50CMCUST 02050I* SORT (ALT) KEY 20A 02060I* 6 25 CMSORT 02070I* ADDRESS 35A X 7 02080I 26 270 CMA 02090I* STATE CODE 2A 02100I 271 272 CMSTCD 02110I* ZIP CODE 9P 02120I P 273 2770CMZIP 02130I* PHONE NO. 15A 02140I* 278 292 CMPHON 02150I* CONTACT NAME 35A 02160I 293 327 CMCONT 02170I* REMARKS 35A 02180I 328 362 CMREM 02190I* CUSTOMER CLASS 2A 02200I* 363 364 CMCLAS 02210I* TERRITORY CODE 3A 02220I* 365 367 CMTER 02230I* CREDIT LIMIT 7P 02240I* P 368 3710CMCRLM 02250I* PAYMENT TERMS 8A ÐÐ02260I* 372 379 CMTERM 02270I* NUMBER OF INVOICE COPIES 1N 02280I* 380 3800CMINV 02290I* SHIPPING METHOD 20A 02300I* 381 400 CMSHIP 02310I* CURRENT BACKLOG 9.2P X 10 02320I* P 401 450 CMB 02330I* LAST 12-MOS SHIPMENTS 9.2P X 10 02340I* P 451 500 CMS 02350I* CURRENT RECEIVABLES 9.2P X 4 02360I* P 501 520 CMAR 02370I* TAX CODE 1A 02380I* 521 521 CMTAX 02390I* STD DISCOUNT 3.2P 02400I* P 522 5232CMDISC 02410I* EXPORT CODE 1A 02420I* 524 524 CMEXPT 02430I* DATE HISTORY 7P X 5 02440I* 1 = DATE INPUT 02450I* 2 = DATE LAST ORDER 02460I* 3 = DATE LAST SHIPMENT 02470I* 4 = NOT USED 02480I* 5 = NOT USED 02490I* P 525 544 CMD 02500I* GEOGRAPHIC CODE 5A ÐÐ02510I* 545 549 CMGEO 02520I* HOLD CODE 1A 02530I* 550 550 CMHOLD 02540I* POINTERS. 02550I* CREDIT CHANGES 5P 02560I* P 573 5750CMFCC 02570I* RECORD STATUS 1A 02580I 576 576 CMSTAT 02590I******************************************************************** 02600ICMBTAFILCB 02610I* CUSTOMER BILL TO ADDRESS FILE. 02620I* CUST # 5N 02630I************* 1 50CBCUST 02640I* ADDRESS 35A X 7 02650I 6 250 CMA 02660I* STATE CODE 2A 02670I 251 252 CBSTCD 02680I* ZIP CODE 9P 02690I P 253 2570CBZIP 02700I* CONTACT 35A 02710I* 258 292 CBCONT 02720I* TELEPHONE 15A 02730I* 293 307 CBPHON 02740I* REMARKS 35A 02750I* 308 342 CBREM ÐÐ02760I* RECORD STATUS 1A 02770I* 352 352 CBSTAT 02780I******************************************************************* 02790ISXFILE SF 02800I* SALES ORDER TEXT DATA 02810I* SALES ORDER PRIME 6A 02820I 1 6 SXPRIM 02830I* SALES ITEM 3N 02840I 7 90SXITEM 02850I* SUB ITEM 2N 02860I 10 110SXSUB 02870I* TEXT 70 X 1A 02880I 12 81 SXT 02890I* TEXT TYPE 1A 02900I* BLK OR T = TEXT 02910I* F = FOOTNOTE 02920I* H = HEADING 02930I 82 82 SXTYPE 02940I* HEADING/FOOTNOTE LINE # 1N 02950I 83 830SXHLIN 02960I* SPACE BEFORE PRINT 1A 02970I 84 84 SXSPAC 02980I* RECORD STATUS 1A 02990I 86 86 SXSTAT 03000C*************************************************************** ÐÐ03010C* INITIALIZE 03020C N79 Z-ADD0 ZERO5 50 STUPIDITY 03030C N79 EXSR SR101 INIT 03040C* BYPASS DELETED OR NO PRINT FLAG SALES ORDER MASTERS 03050C N01 GOTO END 03060C MOVELSMORD W11A 11 03070C MOVE BLK5 W11A 03080C W11A SETLLSIMAST LOW LIMIT FOR ITEMS 03090C SETOF 78 03100C Z-ADD0 EGAP 20 03110C*--------------------------------------------------------------- 03120C TAG10 TAG 03130C SETOF 54 03140C READ SIMAST 54GET ITEM MASTER 03150C 54 GOTO TAG400 END OF FILE 03160C SIORD COMP SMORD 54 03170C N54 GOTO TAG400 END OF ORDER 03180C SISTAT COMP 'D' 54 03190C 54 GOTO TAG10 DELETED ITEM 03200C N78 EXSR SR102 PRINT MASTER DATA 03210C SETON 78 03220C SITYPE COMP 'I' 51 INV ITEM 03230C EXSR SR103 PRINT ITEM DATA 03240C MOVELSIITEM W5A 5 03250C MOVE SISUB W5A ÐÐ03260C MOVE W5A W11A 03270C MOVELW11A W13A 13 03280C MOVE '00' W13A 03290C W13A SETLLSXMAST 03300C*-------------------------------------------------------------------- 03310C TAG20 TAG 03320C SETOF 54 03330C READ SXMAST 54 03340C 54 GOTO TAG10 END OF FILE 03350C SPORD COMP SMORD 54 03360C 54 SPITEM COMP SIITEM 54 03370C N54 GOTO TAG10 END OF ITEM 03380C Z-ADD1 T 30 03390C*------------------------------------------------------------------ 03400C TAG30 TAG 03410C ZERO5 LOKUPSMP,T 54 03420C N54 GOTO TAG20 END OF TEXT 03430C SMP,T CHAINSXFILE H7 03440C H7 GOTO ENDJOB 03450C EXSR SR104 PRINT TEXT 03460C 1 ADD T T 03470C T COMP 25 54 03480C N54 GOTO TAG30 03490C GOTO TAG20 END OF TEXT 03500C*----------------------------------------------------------------- ÐÐ03510C TAG400 TAG 03520C 78 EXSR SR105 PRINT TOTALS 03530C*---------------------------------------------------------------- 03540C END TAG 03550C SETOF 78 03560C*--------------------------------------------------------------------- 03570C ENDJOB TAG 03580C********************************************************************** 03590CSR SR66 BEGSR 03600CSR EXITFZTFORM TOP OF FORM 03610CSR 1 ADD EGAP EGAP 20 03620CSR ENDSR 03630C********************************************************************** 03640CSR SR67 BEGSR 03650CSR EXITFQCLF LINE FEED 03660CSR ENDSR 03670C******************************************************************** 03680CSR SR69 BEGSR 03690C* PRINT 1-LINE 03700CSR PORT CHAINCRTFILE H9 03710CSR H9 GOTO ENDJOB 03720CSR MOVE ' ' PRT 03730CSR EXCPT 03740CSR PORT CHAINCRTFILE H9 03750CSR ' ' LOKUPPRT 54 ÐÐ03760CSRN54 GOTO END69 03770CSR SETOF 212223 03780CSR SETOF 242526 03790CSR SETOF 272829 03800CSR SETOF 303132 03810CSR SETOF 3334 03820CSR SETOF 717273 03830CSR MOVEAPRT W148A 148 03840CSR EXITFZD148 DIABLO PRINT 03850CSR RLABL W148A 03860CSR END69 ENDSR 03870C********************************************************************* 03880CSR SR101 BEGSR 03890C* 1-TIME INIT. 03900CSR SETON 79 03910CSR MOVE ' 'W8A 8 03920CSR Z-ADD0 W2N 20 03930CSR Z-ADD0 W1N 10 03940CSR MOVE ' ' W2A 2 03950CSR EXITFPGMINX 03960CSR RLABL W8A 03970CSR RLABL W2N 03980CSR RLABL W1N 03990CSR RLABL W2A 04000CSR MOVE W2A PORT 20 ÐÐ04010CSR PORT COMP 0 54 04020CSRN54 Z-ADD25 PORT 04030CSR Z-ADD0 ZERO5 50 04040CSR MOVE ' ' BLK5 5 04050CSR ENDSR 04060C******************************************************************** 04070CSR SR102 BEGSR 04080C* PRINT SALES MASTER RECORD. 04090CSR EXSR SR66 TOP OF FORM 04100CSR EXSR SR67 LF 04110CSR EXSR SR67 LF 04120CSR SETON 21 04130CSR EXSR SR69 PAGE ' ORDER # 04140CSR EXSR SR67 LF 04150CSR SETON 22 04160CSR EXSR SR69 MISCL CODES 04170CSR SETON 23 04180CSR EXSR SR69 ADDRESS LINES 04190CSR EXSR SR69 MISCL CODES 04200CSR EXSR SR67 LF 04210CSR EXSR SR67 LF 04220CSR SETON 28 04230CSR END102 ENDSR 04240C******************************************************************** 04250CSR SR103 BEGSR ÐÐ04260C* PRINT SALES ITEM DATA 04270CSR SETON 28 04280CSR EXSR SR69 PRINT 04290CSR SI$,2 COMP 0 29 04300CSR 29 EXSR SR69 PRINT SETUP $ 04310CSR ENDSR 04320C******************************************************************* 04330CSR SR104 BEGSR 04340C* PRINT TEXT LINE 04350CSR EXSR SR201 LINE SPACING 04360CSR SETON 30 04370CSR EXSR SR69 PRINT TEXT 04380CSR ENDSR 04390C******************************************************************* 04400CSR SR105 BEGSR 04410C* PRINT TOTALS 04420CSR SETON 31 04430CSR EXSR SR69 PRINT PAGE TOTALS 04440CSR SETON 32 04450CSR EXSR SR69 PRINT TAX DATA 04460CSR SETON 33 04470CSR EXSR SR69 PRINT SUB-TOTAL 04480CSR SETON 34 04490CSR EXSR SR69 PRINT FINAL TOTAL 04500CSR ENDSR ÐÐ04510C******************************************************************** 04520CSR SR201 BEGSR 04530C* LINE SPACING. 04540CSR EXSR SR301 CLASSIFY SPACE CODE 04550CSR EXSR SR67 LF 04560CSR 62 04570COR 63 EXSR SR67 LF 04580CSR 63 EXSR SR67 LF 04590CSR 64 EXSR SR66 NEW PAGE 04600CSR ENDSR 04610C******************************************************************* 04620CSR SR301 BEGSR 04630C* CLASSIFY SPACING. 04640CSR SXSPAC COMP ' ' 61 04650CSRN61 SXSPAC COMP '1' 61 04660CSR SXSPAC COMP '2' 62 04670CSR SXSPAC COMP '3' 63 04680CSR SXSPAC COMP 'S' 64 04690CSR ENDSR 04700C******************************************************************* 04710C* 04720C* 04730C* 04740C* 04750C* ÐÐ04760C* 04770C* 04780C* 04790C* 04800C* 04810C* 04820C* 04830O******************************************************************** 04840OCRTFILE E 71 21 04850O PRT 212 04860O EGAP Z 133 04870O SMORD 176 04880O*------------------------------------------------------------------- 04890O E 71 22 04900O PRT 212 04910O 23 SMA 125 04920O 24 CMA 176 04930O*------------------------------------------------------------------- 04940O E 71 27 04950O PRT 212 04960O SMD,1 86 ' - - ' 04970O SMCPO 112 04980O SMD,2 121 ' - - ' 04990O SMTERM 132 05000O SMSHIP 150 ÐÐ05010O* * * * FOBNAM 153 05020O* * * * PP 157 05030O* * * * COL 161 05040O*------------------------------------------------------------------- 05050O E 71 28 05060O PRT 212 05070O SIITEM 83 05080O SIQ,1 2 90 05090O N51 SINDES 161 05100O 51 SIMODL 105 05110O 51 SIDESC 140 05120O 51 SID,2 149 ' - - ' 05130O 51 SIQ,4 2 156 05140O* * * * 51 QTYBAL2 162 05150O SI$,1 2 176 05160O*------------------------------------------------------------------- 05170O E 71 29 05180O PRT 212 05190O 140 'SET-UP CHARGE' 05200O SI$,2 2 176 05210O*------------------------------------------------------------------- 05220O E 71 30 05230O PRT 212 05240O SXT 161 05250O*------------------------------------------------------------------- ÐÐ05260O E 71 31 05270O PRT 212 05280O* * * * PAGTOT2 176 05290O*------------------------------------------------------------------- 05300O E 71 32 05310O PRT 212 05320O* * * * TAXYES 149 05330O* * * * TAXNO 154 05340O* * * * SUBTAX2 176 05350O*------------------------------------------------------------------- 05360O E 71 33 05370O PRT 212 05380O* * * * SUB$3 2 176 05390O*------------------------------------------------------------------- 05400O E 71 34 05410O PRT 212 05420O* * * * SUBTOT2 176 05430O******************************************************************** 05440OSMMAST D 01 05450O SMCUST 9P 05460O SMREP 12P 05470O SMDISC 45P 05480O SMD 424P 05490O SM$ 435P 05500O SMLITM 447P ÐÐ05510O 440 ' ' /* 05520_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ȵ ÈTX007XP P120282120282(èÈÐ00010H Q007XP00020F* REVERSE MMDDYY DUE DATE TO YYMMDD DG REL006 OK 00030F* REVISED 7/01/80 1:30 PM. 00040FWOTRAN UP F 80 DISK U1 00050FPOTRAN US F 80 DISK U3 00051FREQTRAN US F 80 DISK U2 00052FPRINT O F 132 OF PRINTER U5 00080I******************************************************************** 00090IWOTRAN WO 01 1 CW 2 CO 00100I* WORK ORDER TRANSACTION. 00110I* JOB # 6A 00120I 3 8 WOJOB 00130I* ACCOUNT # 5N 00140I 9 130WOACNT 00150I* PART # 10N 00160I 14 230PN 00170I* DESCRIPTION 8A 00180I 25 32 WODESC 00190I* TOP ASSY WO 6N 00200I 33 380WOTAWO 00210I* CODE 1A (M=THIS IS TOP W/O) 00220I 39 39 WOCODE 00230I* TOP MCN 5N 00240I 40 440WOTMCN 00250I* END ITEM SCHED DATE 5N (MMDDY) ÐÐ00260I 45 490WOEISD 00270I* QTY 7N 00280I 50 560WOQTY 00290I* K-CODE (MAT'L ISSUED) 00300I 57 57 WOKODE 00310I* LOT # 2N 00320I 58 590WOLOT 00330I* MODEL 10A 00340I 60 69 WOMODL 00350I* START DATE 6N (YYMMDD) 00360I 71 760DUEDAT 00370I GG 07 00380I******************************************************************** 00390IREQTRAN RT 02 1 CR 2 CQ 56 C4 00400I* BACKORDER RECORD. 00410I OR 03 1 CR 2 CQ 56 C5 00420I* ALLOCATION RECORD. 00430I OR 02 1 CR 2 CQ 56 C6 00440I* BACKORDER RECORD. 00450I* PART # 10N 00460I 3 120PN 00470I* DESCRIPTION 8A 00480I 13 19 RTDESC 00490I* JOB # 6A 00500I 21 26 RTJOB ÐÐ00510I* LOT # 3A (LXX) 00520I 27 29 RTLOT 00530I* TRANS DATE 5N (MMDDY) 00540I 31 350RTDATE 00550I* MCN # 5A 00560I 37 41 RTMCN 00570I* FAB CODE 2A 00580I 52 53 RTFABC 00590I* CARD CODE 1A 00600I* 4,6=BACKORDER 00610I* 5=ALLOCATION 00620I 56 56 RTCARD 00630I* QTY 6N 00640I 62 670RTQTY 00650I* START DATE 6N (FROM W/O) 00660I 71 760DUEDAT 00670I* INV TYPE 1A 00680I* 1 = F/G 00690I* 2 = DETAIL 00700I* 3 = S/A'S 00710I 79 79 RTINVC 00720I GG 07 00730I******************************************************************** 00740IPOTRAN PO 04 1 CP 2 CO 00750I* PURCH ORD TRANSACTION. ÐÐ00760I* PART # 10N 00770I 3 120PN 00780I* DESCRIPTION 7A 00790I 13 19 PODESC 00800I* P.O. # 5N 00810I 22 260POPON 00820I* DUE DATE 6N (YYMMDD) 00830I 30 350DUEDAT 00840I* VENDOR # 5N 00850I 37 410POVEND 00860I* VENDOR NAME 10A 00870I 42 51 POVNAM 00880I* MO/DAY DUE 4N (MMDD) 00890I 52 550POMODU 00900I* PO CODE 2A ('P-O') 00910I 56 58 POPCOD 00920I* P-CODE 1A (P=FAB PER PRINT) 00930I 59 59 POPOCD 00940I* ITEM 2A 00950I 60 61 POITEM 00960I* QTY 6N 00970I 62 670POQTY 00980I* PRICE 9.5N 00990I 69 765POPRIC 01000I* INV CODE 2A ('14') ÐÐ01010I 78 79 POINVC 01020I GG 07 01030C Z-ADDDUEDAT OLDDAT 60 01040C DUEDAT COMP 0 54 01050C N54 Z-ADDUDATE DUEDAT 01060C N04 GOTO TAG100 01070C MOVE DUEDAT W5N 50 01080C MOVE W5N W1N 10 01090C MOVELW5N W4N 40 01100C MOVE W4N DUEDAT 01110C W1N COMP 0 50 01120C W1N COMP 8 48 01130C W1N COMP 9 49 01140C W1N COMP 1 51 01150C W1N COMP 2 52 01160C W1N COMP 3 53 01170C 50 Z-ADD80 W2N 20 01180C 48 Z-ADD78 W2N 01190C 49 Z-ADD79 W2N 01200C 51 Z-ADD81 W2N 01210C 52 Z-ADD82 W2N 01220C 53 Z-ADD83 W2N 01230C W2N COMP 0 54 01240C N54 Z-ADD99 W2N 01250C MOVELW2N DUEDAT ÐÐ01260C W4N COMP 0 54 01270C N54 Z-ADD9999 W4N 01280C N54 MOVELW4N DUEDAT 01290C GOTO END 01300C*----------------------------------------------------------------- 01310C TAG100 TAG 01320C MOVELDUEDAT W2N 20 01330C W2N COMP 12 54 01340C 54 GOTO END 01350C MOVELDUEDAT W4N 01360C MOVE DUEDAT W2N 01370C MOVE W4N DUEDAT 01380C MOVELW2N DUEDAT 01390C*---------------------------------------------------------------- 01400C END TAG 01410OWOTRAN D 01 U1 01420O DUEDAT 76 01430OREQTRAN D 02 U2 01440O OR 03 U2 01450O DUEDAT 76 01460OPOTRAN D 04 U3 01470O DUEDAT 35 01480OPRINT D 01 U1 01490O OR 02 U2 01500O OR 03 U2 ÐÐ01510O OR 04 U3 01520O 01 2 'WO' 01530O 02 2 'BO' 01540O 03 2 'AL' 01550O 04 2 'PO' 01560O OLDDATY 15 01570O DUEDATY 35 /* 001580_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(  XLESS1 P999999120282(èÈÐ SUBROUTINE ZLESS1 (IBUF) 00010* DECREASE VALUE OF INTEGER BY 1 BINARY 00020 IBUF = IBUF-1 00030 RETURN 00040 END 00050_‚ _‚_‚ ÐÈ(X XúX004PJ P120282120282(èÈÐ00010H Q004PJ00020F* DISPLAY PROJECT FILE BY EWO #. (X004PJ) 00030F* REVISED 8-05-81 4:15 PM. 00040F* MENU: MQPJ01, MQPJ02 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FPJMAST ID F 170L12AI 1 DISK 00090FDEPTNAMEIT F 80 EDISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E DEPTNAME TABDEP 1 55 5 0 TABNAM 20 00130E NUL 1 132 1 NULL CHAR 00140E A12 12 12 1 A INPUT DATA ARRAY 00150E DUN 1 1 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E DASH 66 66 1 DIVIDER 00180E VAR 1 2 9 2 00190E TOT 1 3 9 2 00200E* 00210E* 00220E* 00230E BIT 33 1 SCREEN CONTR. CHAR 00240E CALL 5 6 CALL STACK 00250E PA$ 2 9 2 ÐÐ00260E PB$ 2 7 0 00270E PC$ 2 9 2 00280E PT$ 2 9 2 00290I******************************************************************* 00300IBITTAB BT 00310I 1 33 BIT 00320I******************************************************************* 00330IMGFILE MG 00340I* MESSAGE FILE. 00350I 1 35 MGTEXT 00360I****************************************************************** 00370ICRTFILE CR 00380I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00390I* STD AREA - SAME FOR ALL PROGRAMS. 00400I* EMPLOYEE # 5N 00410I 1 50CREMPL 00420I* USER CODE 8A 00430I 6 13 CRUSER 00440I* DEPT # 5N 00450I 14 180CRDEPT 00460I* JOB NAME 8A (JOB LOADED BY MENU) 00470I 19 26 CRJOB 00480I* SHUTDOWN FLAG 1A 00490I* BLANK = NO SHUTDOWN 00500I 27 27 CRSHUT ÐÐ00510I* TIME STARTED 6N 00520I 28 330CRTIME 00530I* DATE STARTED 4N 00540I 34 370CRDATE 00550I* CALL STACK 5 X 6A 00560I 38 67 CALL 00570I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00580I 68 73 CRRET 00590I* MENU NAME 6A 00600I 74 79 CRMENU 00610I******************************************************************** 00620IPJMAST PJ 00630I* PROJECT WORK ORDER. 00640I* WORK ORDER NO. 00650I 1 9 PJORD 00660I* PRIME 6A 00670I 1 6 PJPRIM 00680I* DASH 3N 00690I 7 90PJDASH 00700I* DEPT 3N 00710I 10 120PJDEPT 00720I* ACCOUNT 5N 00730I 13 170PJACNT 00740I* MODEL 12A 00750I 18 29 PJMODL ÐÐ00760I* DESCRIPTION 40A 00770I 30 69 PJDESC 00780I* SCHEDULE. 00790I* START DATE 6N 00800I 70 750PJBSD 00810I* COMPLETION DATE 6N 00820I 76 810PJBCD 00830I* BUDGET - LABOR HRS 7P 00840I P 82 850PJBLH 00850I* BUDGET - LABOR $ 7P 00860I P 86 89 PB$,1 00870I* BUDGET - MATERIAL $ 7P 00880I P 90 93 PB$,2 00890I* ACTUAL. 00900I* START DATE 6N 00910I 94 990PJASD 00920I* COMPLETION DATE 6N 00930I 100 1050PJACD 00940I* LABOR HRS 7.1P 00950I P 106 1091PJALH 00960I* LABOR $ 9.2P 00970I P 110 114 PA$,1 00980I* MATERIAL $ 9.2P 00990I P 115 119 PA$,2 01000I* STATUS. ÐÐ01010I* LABOR - % COMPLETE 3.2P 01020I P 120 1212PJLPCT 01030I* MATERIAL - % COMPLETE 3.2P 01040I P 122 1232PJMPCT 01050I* CURRENT MONTH - ACTUAL. 01060I* LABOR HRS 7.1P 01070I P 124 1271PJCLH 01080I* LABOR $ 9.2P 01090I P 128 132 PC$,1 01100I* MATERIAL $ 9.2P 01110I P 133 137 PC$,2 01120I* TRANSFER $ 2 X 9.2P 01130I P 138 147 PT$ 01140I* RECORD STATUS 1A 01150I 170 170 PJSTAT 01160C******************************************************************** 01170C* INITIALIZE 01180C EXSR SR101 1-TIME INIT 01190C*------------------------------------------------------------------ 01200C START TAG 01210C* SET-UP 1ST FIELD NO. 01220C MOVE ' ' DUN INIT EDIT ARRAY 01230C Z-ADD1 F 30 FIELD # 01240C GOTO READ 01250C*------------------------------------------------------------------ ÐÐ01260C NEXT TAG 01270C* SET-UP NEXT FIELD NO. 01280C 1 ADD F F FIELD # 01290C*----------------------------------------------------------------- 01300C READ TAG 01310C* READ DATA FROM TERMINAL. 01320C SETOF 909677 01330C EXSR SR102 VALIDATE FIELD # 01340C 55 GOTO UPDATE DONE 01350C EXSR SR201 IDENTIFY-F 01360C EXSR SR70 PROMPT 01370C EXSR SR75 READ TERMINAL 01380C 98 GOTO GOODBY GOODBY 01390C 94 GOTO MENU MENU REQUEST 01400C 93 GOTO NEWITM NEW ITEM 01410C 87 GOTO START 01420C 85 GOTO READ REPEAT 01430C 96 GOTO ERROR ERROR 01440C*------------------------------------------------------------------ 01450C UPDATE TAG 01460C* UPDATE DATA BASE. 01470C EXSR SR103 01480C EXSR SR106 UPDATE 01490C 96 GOTO ERROR ERROR 01500C GOTO START ÐÐ01510C*------------------------------------------------------------------- 01520C JUMP TAG 01530C* SET-UP JUMP TO REQUESTED FIELD 01540C 1 ADD W W 30 01550C W COMP 12 54 01560C 54 Z-ADD318 M 50 96 FLAG ERROR 01570C 54 GOTO ERROR BAD ESC 01580C MOVE ' ' W3A 3 01590C MOVEAA12,W W3A 01600C Z-ADD3 W2N 20 01610C EXIT SUBRAJ R. JUSTIFY 01620C RLABL W2N 01630C RLABL W3A 01640C MOVE W3A F NEW FIELD # 01650C GOTO READ 01660C*-------------------------------------------------------------------- 01670C ERROR TAG 01680C EXSR SR102 VALIDATE FIELD # 01690C EXSR SR89 GET MSG 01700C EXSR SR73 PUT MSG 01710C GOTO READ 01720C*------------------------------------------------------------------ 01730C NEWITM TAG 01740C* SET-UP LINK FOR NEW ITEM 01750C MOVEL'Q004PJ' PROG 8 ÐÐ01760C GOTO END 01770C*------------------------------------------------------------------- 01780C MENU TAG 01790C* SET-UP LINK TO MENU 01800C MOVELCRMENU PROG 01810C GOTO END 01820C*-------------------------------------------------------------------- 01830C GOODBY TAG 01840C* LINK TO SIGN-OFF 01850C MOVEL'GOODBY' PROG 01860C GOTO END 01870C*------------------------------------------------------------------- 01880C END TAG 01890C EXITFCHAIN LINK TO NEXT PROG 01900C RLABL PROG 01910C******************************************************************** 01920CSR SR70 BEGSR 01930C* ENTER EWO # PROMPT 01940CSR SETON 70 01950CSR EXCPT PROMPT 01960CSR SETOF 70 01970CSR 1 ADD COUNT COUNT 30 01980CSR ENDSR 01990C********************************************************************** 02000CSR SR71 BEGSR ÐÐ02010C* PUT HEADINGS TO TERMINAL 02020CSR SETON 71 02030CSR EXCPT PUT HEADINGS 02040CSR SETOF 71 02050CSR Z-ADD5 COUNT 30 02060CSR ENDSR 02070C********************************************************************* 02080CSR SR72 BEGSR 02090C* PUT DATA TO TERMINAL 02100CSR Z-ADDPJDEPT W5N 50 02110CSR W5N LOKUPTABDEP TABNAM 54 02120CSR 54 MOVE TABNAM DEPNAM 17 02130CSR PC$ ADD PA$ PA$ 02140CSR PB$ SUB PA$ VAR 02150CSR XFOOTPB$ TOT,1 02160CSR XFOOTPA$ TOT,2 02170CSR XFOOTVAR TOT,3 02180CSR PJALH ADD PJCLH PJALH 02190CSR PJBLH SUB PJALH HRSVAR 71 02200CSR 7 ADD COUNT COUNT 02210CSR SETON 72 02220CSR EXCPT PUT DATA 02230CSR SETOF 72 02240CSR ENDSR 02250C*********************************************************************** ÐÐ02260CSR SR73 BEGSR 02270C* PUT ERROR MESSAGE TO TERMINAL 02280CSR SETON 73 02290CSR EXCPT PUT MSG 02300CSR SETOF 73 02310CSR 1 ADD COUNT COUNT 02320CSR Z-ADDM LSTERR 50 02330CSR ENDSR 02340C******************************************************************* 02350CSR SR75 BEGSR 02360C* READ FROM TERMINAL 02370CSR SETOF 779096 02380CSR SETOF 93 02390CSR SETOF 87 02400CSR MOVE BIT,7 BUFLGT 2 READ BUFFER LGTH 02410CSR MOVE BLK12 W12A 12 BUFFER 02420CSR EXITFQWREED READ FROM TERMINAL 02430CSR RLABL W12A READ BUFFER 02440CSR RLABL BUFLGT READ BUFFER LGTH 02450CSR MOVEAW12A A12 INPUT DATA ARRAY 02460CSR MOVE BLK12 W12A INIT INPUT ARRAY 02470CSR Z-ADD1 W 30 02480CSR '\' LOKUPA12,W 90 FLAG ESC 02490CSRN90 GOTO T75B NOT ESC 02500CSR 1 ADD W W ÐÐ02510CSR W COMP 12 54 02520CSR 54 GOTO T75A BAD ESC 02530CSR A12,W COMP 'G' 98 GOODBY 02540CSR A12,W COMP 'E' 94 MENU 02550CSR A12,W COMP 'N' 93 NEW ITEM 02560CSR A12,W COMP 'J' 92 JUMP 02570CSR A12,W COMP 'F' 91 SKIP FRWRD 02580CSR A12,W COMP 'B' 89 SKIP BKWRD 02590CSR A12,W COMP 'S' 88 SPACE FILL 02600CSR A12,W COMP 'H' 87 HOME 02610CSR A12,W COMP 'U' 86 UPDATE 02620CSR A12,W COMP 'R' 85 REPEAT 02630CSR 98 02640COR 94 02650COR 93 02660COR 87 02670COR 85 GOTO END75 GOOD ESC 02680C*------------------------------------------------------------------ 02690CSR T75A TAG 02700C* FLAG BAD ESC INPUT 02710CSR Z-ADD318 M 96 FLAG ERROR 02720CSR GOTO END75 02730C*-------------------------------------------------------------------- 02740CSR T75B TAG 02750C* MOVE DATA ÐÐ02760CSR Z-ADD1 W 02770CSR ' ' LOKUPA12,W 77 02780CSR 77 MOVEAA12,W W12A INPUT DATA 02790C*-------------------------------------------------------------------- 02800CSR END75 TAG 02810C* INIT PREV ERROR MSG. 02820CSR LSTERR COMP 0 54 02830CSR 54 MOVE BLK35 MGTEXT 02840CSR 54 EXSR SR73 BLANK MESSAGE 02850CSR Z-ADD0 LSTERR 50 02860CSR ENDSR 02870C********************************************************************** 02880CSR SR89 BEGSR 02890C* GET MESSAGE MASTER 02900CSR M CHAINMGFILE 54 02910CSR 54 MOVE BLK35 MGTEXT 02920CSR 54 MOVELM MGTEXT 02930CSR 54 MOVE MES,1 MGTEXT 02940CSR ENDSR 02950C*********************************************************************** 02960CSR SR101 BEGSR 02970C* 1-TIME INITIALIZE 02980CSR MOVE BIT,1 NUL 02990CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03000CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ03010CSR MOVE ' ' BLK12 12 03020C* GET PORT # AND CRTFILE 03030CSR MOVE ' ' W8A 8 03040CSR Z-ADD0 W2N 20 03050CSR Z-ADD0 W1N 10 03060CSR MOVE ' ' W2A 2 03070CSR EXITFPGMINX GET PORT # 03080CSR RLABL W8A 03090CSR RLABL W2N 03100CSR RLABL W1N 03110CSR RLABL W2A 03120CSR MOVE W2A PORT 20 PORT NO. 03130CSR PORT COMP 0 54 03140CSRN54 Z-ADD25 PORT DEFAULT 03150CSR PORT CHAINCRTFILE H9 03160CSR CRDEPT COMP 810 10 FLAG ACTG DEPT 03170CSRN10 CRDEPT COMP 840 10 FLAG EDP DEPT 03180C* DEFINE WORK FIELDS,ETC. 03190CSR MOVE ' ' BLK35 35 03200CSR MOVE '-' DASH 03210C* 03220C* 03230C* 03240C* 03250CSR ENDSR ÐÐ03260C********************************************************************** 03270CSR SR102 BEGSR 03280C* VALIDATE FIELD NO. 03290CSR F COMP 0 54 03300CSRN54 Z-ADD1 F 03310CSR F COMP FLIMIT 55 03320CSR 55 Z-ADD1 F 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR103 BEGSR 03360C* MOVE INPUT DATA 03370CSR EXSR SR201 IDENTIFY-F 03380CSR 01 MOVELW12A TORD 6 03390C* 03400CSR MOVE ' ' DUN,F EDIT FLAG 03410CSR ENDSR 03420C******************************************************************** 03430CSR SR106 BEGSR 03440C* DISPLAY PROJECTS. 03450CSR MOVELTORD W12A 03460CSR MOVE '000000' W12A 03470CSR W12A SETLLPJMAST 03480CSR EXSR SR71 PUT HEADING 03490C*------------------------------------------------------------------- 03500CSR T106A TAG ÐÐ03510CSR SETOF 54 03520CSR READ PJMAST 54 03530CSR 54 GOTO T106M END FILE 03540CSR PJSTAT COMP 'D' 54 03550CSR 54 GOTO T106A DELETED 03560CSR PT$,1 ADD PT$,2 PT$,1 03570CSR EXSR SR72 PUT DATA 03580CSR COUNT COMP 21 54 03590CSRN54 GOTO T106A 03600CSR Z-ADD34 M 03610C*------------------------------------------------------------------- 03620CSR T106E TAG 03630CSR EXSR SR89 GET MSG 03640CSR SETON 75 03650CSR EXCPT PUT BLANK LINES 03660CSR SETOF 75 03670CSR EXSR SR73 END PAGE 03680CSR EXSR SR75 READ 03690CSR 98 GOTO GOODBY 03700CSR 94 GOTO MENU 03710CSR 90 GOTO END106 03720CSR 77 EXSR SR103 03730CSR 77 GOTO SR106 03740CSR EXSR SR71 03750CSR GOTO T106A ÐÐ03760C*------------------------------------------------------------------- 03770CSR T106M TAG 03780CSR Z-ADD327 M 03790CSR GOTO T106E 03800CSR END106 ENDSR 03810C******************************************************************** 03820CSR SR201 BEGSR 03830C* IDENTIFY FIELD NO. 03840CSR F COMP 1 01 03850CSR ENDSR 03860O******************************************************************** 03870OTERM132 E 71 03880O UDATE 8 ' - - ' 03890O 59 'E N G I N E E R I N G' 03900O 69 'W O R K' 03910O 81 'O R D E R' 03920O 95 'S T A T U S' 03930O*------------------------------------------------------------------- 03940O E 71 03950O DASH 66 03960O 1 '*' 03970O 66 '*' 03980O 35 'T A S K' 03990O 84 'LABOR' 04000O 101 'LABOR' ÐÐ04010O 115 'MATERIAL' 04020O 129 'TOTAL' 04030O*------------------------------------------------------------------- 04040O E 71 04050O 5 'EWO #' 04060O 84 'HOURS' 04070O 99 '$' 04080O 112 '$' 04090O 127 '$' 04100O*------------------------------------------------------------------- 04110O E 71 04120O 1 ' ' 04130O*------------------------------------------------------------------- 04140O E 72 04150O 1 ' ' 04160O*------------------------------------------------------------------- 04170O E 72 04180O PJPRIM 6 04190O PJDASH 10 04200O 7 '-' 04210O 16 'DEPT' 04220O 24 ':' 04230O PJDEPTZ 28 04240O DEPNAM B 46 04250O 72 'BUDGET:' ÐÐ04260O PJBLH J 84 04270O PB$,1 J 98 04280O PB$,2 J 112 04290O TOT,1 J 129 04300O*------------------------------------------------------------------- 04310O E 72 04320O 17 'MODEL' 04330O 24 ':' 04340O PJMODL 37 04350O 72 'ACTUAL:' 04360O PJALH J 87 04370O PA$,1 J 101 04380O PA$,2 J 115 04390O TOT,2 J 129 04400O*------------------------------------------------------------------- 04410O E 72 04420O 24 'DESCRIPTION:' 04430O PJDESC 65 04440O 68 'DIF' 04450O 72 ':' 04460O HRSVARJ 87 04470O VAR,1 J 101 04480O VAR,2 J 115 04490O TOT,3 J 129 04500O*------------------------------------------------------------------- ÐÐ04510O E 72 04520O 24 'START DATE :' 04530O 32 'SCHED:' 04540O PJBSD 41 ' - - ' 04550O 50 'ACTUAL:' 04560O PJASD 59 ' - - ' 04570O*------------------------------------------------------------------- 04580O E 72 04590O 24 'DATE CMPLT :' 04600O 32 'SCHED:' 04610O PJBCD 41 ' - - ' 04620O 50 'ACTUAL:' 04630O PJACD 59 ' - - ' 04640O*------------------------------------------------------------------- 04650O E 72 04660O 24 '% CMPLT :' 04670O PJLPCTZ 29 04680O*------------------------------------------------------------------- 04690O E 72 04700O 10 24 'TRANSFERRED:' 04710O 10 PT$,1 J 37 04720O*------------------------------------------------------------------- 04730O E 70 04740O* PROMPT 04750O NUL 132 ÐÐ04760O 13 'ENTER EWO # ' 04770O*------------------------------------------------------------------ 04780O E 73 04790O NUL 132 04800O MGTEXT 35 04810O*---------------------------------------------------------------- 04820O E 75 04830O* BLANK LINE 04840O 1 ' ' 04850O********************************************************************* ** NUL ARRAY 004860 004870** A12 ARRAY 004880 004890** DUN ARRAY 004900 004910** MES ARRAY 004920---MESSAGE NOT ON FILE--- 004930** DASH ARRAY 004940 004950** VAR ARRAY 004960 004970** TOT ARRAY 004980 004990/* 005000ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(& &æX008GL P120282120282(èÈÐ00010H Q008GL00020F* DISPLAY ACCT WHERE-USED - SINGLE LEVEL. (X008GL) D A T A G R A P H I X 00030F* REVISED 7-29-81 10:05 AM. DG-REL006 OK. 00031F* MENU: MQGL01, MQGL02 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FCAMAST IC F 40R18AI 1 DISK 00070FGLWU ID F 19L18AI 1 DISK 00080FGLMAST IC F 165R 9AI 1 DISK 00090FTERM132 O F 132 5 00100F**************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A8 8 8 1 A INPUT DATA ARRAY 00130E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00140E DUN 13 13 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E LEV 1 20 18 00170E BIT 256 1 SCREEN CONTR. CHAR 00180E GLA 12 11 2 00190I******************************************************************* 00200IBITHEX BT 00210I 1 256 BIT 00220I******************************************************************* 00230IMGFILE MG 00240I* MESSAGE FILE. ÐÐ00250I 1 35 MGTEXT 00260I******************************************************************** 00270IGLWU GW 00280I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00290I* KEY AREA. 00300I* SUB-ACCOUNT 9A 00310I 1 9 GWSUB 00320I* PARENT ACCOUNT 9A 00330I 10 18 GWPAR 00340I* RECORD STATUS 1A 00350I 19 19 GWSTAT 00360I******************************************************************** 00370IGLMAST GL 00380I* ACCOUNT MASTER. 00390I* KEY AREA. 00400I* ACCOUNT # 9A 00410I 1 9 GLKEY 00420I 1 1 GLPRFX 00430I 2 60GLPRIM 00440I 7 90GLDASH 30 00450I* ACCOUNT GROUP 4A 00460I 14 17 GLGRUP 00470I* ACCOUNT DESCRIPTION 40A 00480I 18 57 GLDESC 00490I* BALANCE FORWARD AMOUNT 11.2P ÐÐ00500I P 58 632GLBALF 00510I* ACTUAL $ 11.2P X 12 00520I P 64 135 GLA 00530I* CURRENT MONTH-PLUS 11.2P 00540I P 136 1412GLCMP 00550I* CURRENT MONTH-MINUS 11.2P 00560I P 142 1472GLCMM 00570I* SOURCE CODE 1A 00580I* S = SUB-ACCOUNT ONLY, 00590I* MAY NOT BE PARENT 00600I 148 148 GLSC 00610I* BALANCE FORWARD CODE 2A 00620I* 1ST COL 00630I* 1 = ZERO BAL AT START NEW YR 00640I* 2 = CARRY PREV YR FRWD 00650I* 2ND COL 00660I* A = ZERO BAL AT START NEW MO 00670I* B = CARRY PREV MO FRWD 00680I 149 150 GLBFC 00690I* NUMB OF SUB-ACCOUNTS 5P 00700I P 157 1590GLNOSA 00710I* LOW LEVEL CODE 3N 00720I 160 1620GLLL 00730I* FILLER 00740I* RECORD STATUS 1A ÐÐ00750I 165 165 GLSTAT 00760I******************************************************************** 00770ICAMAST CA 00780I* CHART OF ACCOUNTS. 00790I* KEY AREA. 00800I* PARENT ACCOUNT 9A 00810I 1 9 CAPAR 00820I* SUB-ACCOUNT 9A 00830I 10 18 CASUB 00840I* OPERATOR 1A 00850I* S = SUBTRACT 00860I* A = ADD 00870I 25 25 CAOPER 00880I* EFFECTIVITY 00890I* START DATE 6N (YMD) 00900I 26 310CASDAT 00910I* END DATE 6N (YMD) 00920I 32 370CAEDAT 00930I* FILLER 00940I* RECORD STATUS 1A 00950I 40 40 CASTAT 00960C******************************************************************** 00970C* INITIALIZE 00980C EXSR SR101 1-TIME INIT 00990C*------------------------------------------------------------------ ÐÐ01000C START TAG 01010C* SET-UP 1ST FIELD NO. 01020C MOVE ' ' DUN INIT EDIT ARRAY 01030C Z-ADD1 F 30 FIELD # 01040C GOTO READ 01050C*------------------------------------------------------------------ 01060C NEXT TAG 01070C* SET-UP NEXT FIELD NO. 01080C 1 ADD F F FIELD # 01090C*----------------------------------------------------------------- 01100C READ TAG 01110C* READ DATA FROM TERMINAL. 01120C SETOF 9096 01130C EXSR SR102 VALIDATE FIELD # 01140C 55 GOTO UPDATE DONE 01150C EXSR SR201 IDENTIFY-F 01160C 01 GOTO NEXT 01170C 01 Z-ADD362 M 50 ENTER PREFIX 01180C 02 Z-ADD363 M ENTER PRIME 01190C 03 Z-ADD364 M ENTER DASH 01200C EXSR SR89 GET MSG. 01210C SETON 69 01220C EXSR SR73 PROMPT 01230C SETOF 69 01240C EXSR SR75 READ TERMINAL ÐÐ01250C*---------------------------------------------------------- 01260C ESCAPE TAG 01270C 98 GOTO GOODBY GOODBY 01280C 94 GOTO MENU MENU REQUEST 01290C N77N88 EXSR SR104 EDIT INPUT FIELD 01300C 93 GOTO NEWITM NEW ITEM 01310C 92 GOTO JUMP FIELD JUMP REQST 01320C 91 GOTO NEXT SKIP FORWARD 01330C 89 F SUB 1 F SKIP BACKWARD 01340C 89 EXSR SR201 01350C 89 01 Z-ADD2 F 01360C 89 GOTO READ " " 01370C 88 SETOF 90 SPACE FILL 01380C 88 SETON 77 " " 01390C 87 GOTO START 01400C 86 GOTO UPDATE UPDATE 01410C 85 GOTO READ REPEAT 01420C 96 GOTO ERROR ERROR 01430C*------------------------------------------------------------------ 01440C PROCES TAG 01450C* PROCESS INPUT DATA 01460C EXSR SR103 MOVE DATA 01470C N96 EXSR SR104 EDIT DATA 01480C 96 GOTO ERROR ERROR 01490C GOTO NEXT ÐÐ01500C*------------------------------------------------------------------ 01510C UPDATE TAG 01520C* UPDATE DATA BASE. 01530C EXSR SR105 FINAL EDIT 01540C 96 GOTO ERROR ERROR 01550C EXSR SR106 UPDATE 01560C 96 GOTO ERROR ERROR 01570C 90 GOTO ESCAPE 01580C GOTO START 01590C*------------------------------------------------------------------- 01600C JUMP TAG 01610C* SET-UP JUMP TO REQUESTED FIELD 01620C 1 ADD W W 30 01630C W COMP 8 54 01640C 54 Z-ADD318 M 50 96 FLAG ERROR 01650C 54 GOTO ERROR BAD ESC 01660C MOVE ' ' W3A 3 01670C MOVEAA8,W W3A 01680C Z-ADD3 W2N 20 01690C EXIT SUBRAJ R. JUSTIFY 01700C RLABL W2N 01710C RLABL W3A 01720C MOVE W3A F NEW FIELD # 01730C GOTO READ 01740C*-------------------------------------------------------------------- ÐÐ01750C ERROR TAG 01760C EXSR SR102 VALIDATE FIELD # 01770C EXSR SR89 GET MSG 01780C EXSR SR73 PUT MSG 01790C GOTO START 01800C*------------------------------------------------------------------ 01810C NEWITM TAG 01820C* SET-UP LINK FOR NEW ITEM 01830C GOTO START 01840C*------------------------------------------------------------------- 01850C MENU TAG 01860C* SET-UP LINK TO MENU 01870C MOVEL'QQGL02' PROG 8 01880C GOTO END 01890C*-------------------------------------------------------------------- 01900C GOODBY TAG 01910C* LINK TO SIGN-OFF 01920C MOVEL'GOODBY' PROG 01930C GOTO END 01940C*------------------------------------------------------------------- 01950C END TAG 01960C EXITFCHAIN LINK TO NEXT PROG 01970C RLABL PROG 01980C********************************************************************* 01990CSR SR3 BEGSR ÐÐ02000C* EDIT INPUT ACCOUNT NO. 02010CSR MOVE TKEY W9A 9 02020CSR EXSR SR80 GET GLMAST 02030C*R 60 *** Z-ADD302 M 96 FLAG ERROR 02040C*R 60 *** GOTO END3 02050CSR MOVE GLPRFX PAPRFX 1 02060CSR Z-ADDGLPRIM PAPRIM 50 02070CSR Z-ADDGLDASH PADASH 30 02080CSR MOVE GLDESC PADESC 40 02090CSR MOVE GLSC PASC 1 02100CSR END3 ENDSR 02110C***************************************************************** 02120CSR SR70 BEGSR 02130C* CLEAR TERM SCREEN. 02140CSR EXITFQTOPF CLEAR SCREEN 02150CSR ENDSR 02160C********************************************************************** 02170CSR SR71 BEGSR 02180C* PUT HEADINGS TO TERMINAL 02190CSR SETON 71 02200CSR EXCPT PUT HEADINGS 02210CSR SETOF 71 02220CSR Z-ADD8 LINENO 30 02230CSR ENDSR 02240C********************************************************************* ÐÐ02250CSR SR72 BEGSR 02260C* PUT DATA TO TERMINAL 02270CSR 1 ADD LINENO LINENO 30 02280CSR LINENO COMP 31 54 02290CSRN54 GOTO T72A NOT END PAGE 02300CSR EXITFQEPAGE 02310CSR EXSR SR75 READ 02320CSR 90 GOTO END72 ESC INPUT 02330CSR EXSR SR71 PUT HEADING 02340C*--------------------------------------------------------------- 02350CSR T72A TAG 02360CSR SETON 72 02370CSR EXCPT 02380CSR SETOF 72 02390CSR END72 ENDSR 02400C*********************************************************************** 02410CSR SR73 BEGSR 02420C* PUT ERROR MESSAGE TO TERMINAL 02430CSR SETON 73 02440CSR EXCPT PUT MSG 02450CSR SETOF 73 02460CSR Z-ADDM LSTERR 50 02470CSR ENDSR 02480C******************************************************************* 02490CSR SR75 BEGSR ÐÐ02500C* READ FROM TERMINAL 02510CSR SETOF 779096 02520CSR SETOF 939291 02530CSR SETOF 898887 02540CSR SETOF 8685 02550CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 02560CSR MOVE BLK8 W8A 8 BUFFER 02570CSR EXITFQWREED READ FROM TERMINAL 02580CSR RLABL W8A READ BUFFER 02590CSR RLABL BUFLGT READ BUFFER LGTH 02600CSR MOVEAW8A A8 INPUT DATA ARRAY 02610CSR MOVE BLK8 W8A INIT INPUT ARRAY 02620CSR Z-ADD1 W 30 02630CSR '\' LOKUPA8,W 90 FLAG ESC 02640CSRN90 GOTO T75B NOT ESC 02650CSR 1 ADD W W 02660CSR W COMP 8 54 02670CSR 54 GOTO T75A BAD ESC 02680CSR A8,W COMP 'G' 98 GOODBY 02690CSR A8,W COMP 'E' 94 MENU 02700CSR A8,W COMP 'N' 93 NEW ITEM 02710CSR A8,W COMP 'J' 92 JUMP 02720CSR A8,W COMP 'F' 91 SKIP FRWRD 02730CSR A8,W COMP 'B' 89 SKIP BKWRD 02740CSR A8,W COMP 'S' 88 SPACE FILL ÐÐ02750CSR A8,W COMP 'H' 87 HOME 02760CSR A8,W COMP 'U' 86 UPDATE 02770CSR A8,W COMP 'R' 85 REPEAT 02780CSR 98 02790COR 94 02800COR 93 02810COR 92 02820COR 91 02830COR 89 02840COR 88 02850COR 87 02860COR 86 02870COR 85 GOTO END75 GOOD ESC 02880C*------------------------------------------------------------------ 02890CSR T75A TAG 02900C* FLAG BAD ESC INPUT 02910CSR Z-ADD318 M 96 FLAG ERROR 02920CSR GOTO END75 02930C*-------------------------------------------------------------------- 02940CSR T75B TAG 02950C* MOVE DATA 02960CSR Z-ADD1 W 02970CSR ' ' LOKUPA8,W 77 02980CSR 77 MOVEAA8,W W8A INPUT DATA 02990CSR END75 ENDSR ÐÐ03000C********************************************************************** 03010CSR SR80 BEGSR 03020C* GET MASTER RECORD 03030CSR W9A CHAINGLMAST 60 GET MASTER 03040CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 03050CSR ENDSR 03060C********************************************************************** 03070CSR SR89 BEGSR 03080C* GET MESSAGE MASTER 03090CSR M CHAINMGFILE 54 03100CSR 54 MOVE BLK35 MGTEXT 03110CSR 54 MOVELM MGTEXT 03120CSR 54 MOVE MES,1 MGTEXT 03130CSR ENDSR 03140C*********************************************************************** 03150CSR SR101 BEGSR 03160C* 1-TIME INITIALIZE 03170CSR MOVE BIT,1 NUL 03180CSR MOVEANUL NUL92 92 03190CSR EXSR SR70 CLEAR SCREEN. 03200CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03210CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03220CSR MOVE ' ' BLK8 8 03230C* DEFINE WORK FIELDS,ETC. 03240CSR MOVE ' ' BLK35 35 ÐÐ03250CSR MOVE ' ' BLK8 8 03260CSR ENDSR 03270C********************************************************************** 03280CSR SR102 BEGSR 03290C* VALIDATE FIELD NO. 03300CSR F COMP 0 54 03310CSRN54 Z-ADD1 F 03320CSR F COMP FLIMIT 55 03330CSR 55 Z-ADD1 F 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR103 BEGSR 03370C* MOVE INPUT DATA 03380CSR EXSR SR201 IDENTIFY-F 03390CSR EXSR SR202 R. JUSTIFY 03400CSR 01 MOVELW8A TPRFX 1 ACCOUNT PREFIX 03410CSR 02 MOVE W8A TPRIM 50 ACCOUNT PRIME 03420CSR 03 MOVE W8A TDASH 30 ACCOUNT DASH 03430CSR 03 MOVELTPRFX TKEY 9 03440CSR 03 MOVELTPRIM W8A 8 03450CSR 03 MOVE TDASH W8A 03460CSR 03 MOVE W8A TKEY 03470CSR MOVE ' ' DUN,F EDIT FLAG 03480CSR ENDSR 03490C******************************************************************** ÐÐ03500CSR SR104 BEGSR 03510C* EDIT INPUT DATA 03520CSR 03 EXSR SR3 EDIT INPUT. 03530CSR 96 MOVE ' ' DUN,F EDIT FLAG 03540CSRN96 MOVE 'X' DUN,F 03550CSR ENDSR 03560C*********************************************************************** 03570CSR SR105 BEGSR 03580C* FINAL EDIT 03590CSR SETON 79 FINAL EDIT FLAG 03600CSR Z-ADD1 F 96 03610C*-------------------------------------------------------------------- 03620CSR T105A TAG 03630CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03640CSRN54 GOTO END105 03650CSR EXSR SR201 IDENTIFY-F 03660CSR EXSR SR104 EDIT 03670CSRN96 GOTO T105A 03680C*-------------------------------------------------------------------- 03690CSR END105 TAG 03700CSR SETOF 79 03710CSR ENDSR 03720C******************************************************************** 03730CSR SR106 BEGSR 03740C* DISPLAY INDENTED CHART OF ACCOUNTS ÐÐ03750CSR MOVELTKEY W18A 18 03760CSR W18A SETLLGLWU 03770CSR EXSR SR71 PUT HEADING 03780C*--------------------------------------------------------------- 03790CSR T106A TAG 03800CSR SETOF 54 03810CSR READ GLWU 54 03820CSR 54 GOTO T106P 03830CSR GWSUB COMP TKEY 54 03840CSRN54 GOTO T106P END OF STRUCTURE 03850CSR GWSTAT COMP 'D' 54 03860CSR 54 GOTO T106A DELETED 03870CSR MOVE GWPAR W9A 03880CSR EXSR SR80 GET GLMAST 03890CSR MOVELGWPAR W18A 18 03900CSR MOVE GWSUB W18A 03910CSR W18A CHAINCAMAST 54 03920CSR 54 GOTO T106A 03930CSR EXSR SR72 PUT DATA 03940CSRN90 GOTO T106A GET NEXT RECORD 03950CSR GOTO END106 03960C*-------------------------------------------------------------- 03970CSR T106P TAG 03980C* END ITEM MESSAGE 03990CSR EXITFQEITEM ÐÐ04000CSR END106 ENDSR 04010C************************************************************************ 04020CSR SR201 BEGSR 04030C* IDENTIFY FIELD NO. 04040CSR F COMP 1 01 04050CSR F COMP 2 02 04060CSR F COMP 3 03 04070CSR ENDSR 04080C********************************************************************** 04090CSR SR202 BEGSR 04100C* RIGHT JUSTIFY 04110CSR F LOKUPNUM 54 04120CSRN54 GOTO END202 NOT NUMERIC FIELD 04130CSR Z-ADD8 W2N 20 04140CSR EXIT SUBRAJ R. JUSTIFY 04150CSR RLABL W2N 04160CSR RLABL W8A 04170CSR END202 ENDSR 04180O******************************************************************** 04190OTERM132 E 71 04200O* PUT HEADING - SUB-ACCOUNT. 04210O 72 'ACCOUNT WHERE-USED' 04220O*------------------------------------------------------------------- 04230O E 71 04240O 15 'SUB-ACCOUNT' ÐÐ04250O 66 'TYPE' 04260O*------------------------------------------------------------------- 04270O E 71 04280O* * * * 6 'PREFIX' 04290O 13 'PRIME' 04300O 20 'DASH' 04310O 35 '<--------------' 04320O 46 'DESCRIPTION' 04330O 60 '------------->' 04340O 66 'CODE' 04350O*------------------------------------------------------------------- 04360O E 71 04370O* PARENT ACCOUNT DATA. 04380O PAPRFX 4 04390O PAPRIMZ 14 04400O PADASHZ 19 04410O PADESC 60 04420O PASC 64 04430O*------------------------------------------------------------------- 04440O E 71 04450O* PUT HEADING - PARENT ACCOUNT. 04460O 24 'PARENT-ACCOUNT' 04470O 71 'TYPE' 04480O 77 'OPER' 04490O 94 'EFFECTIVITY' ÐÐ04500O 118 'CURRENT MONTH' 04510O*------------------------------------------------------------------- 04520O E 71 04530O* * * * 12 'PREFIX' 04540O 19 'PRIME' 04550O 25 'DASH' 04560O 40 '<--------------' 04570O 51 'DESCRIPTION' 04580O 65 '------------->' 04590O 71 'CODE' 04600O 77 'CODE' 04610O 87 'START' 04620O 95 'STOP' 04630O 112 'PLUS' 04640O 126 'MINUS' 04650O*------------------------------------------------------------------- 04660O E 72 04670O* SUB-ACCOUNT DATA. 04680O GLPRFX 10 04690O GLPRIMZ 20 04700O 30 21 '-' 04710O GLDASHZ 24 04720O GLDESC 65 04730O GLSC 69 04740O CAOPER 75 ÐÐ04750O CASDAT 87 ' - - ' 04760O CAEDAT 97 ' - - ' 04770O GLCMP K 112 04780O GLCMM K 125 04790O*------------------------------------------------------------------- 04800O E 73 04810O* PUT MESSAGE. 04820O NUL92 132 04830O 96 5 '*****' 04840O N96 5 ' ' 04850O MGTEXT 40 04860O BIT,8 132 ** NUL ARRAY 004870 004880** A8 ARRAY 004890 004900** NUM ARRAY 004910002 PAR PRIME 004920003 PAR DASH 004930** DUN ARRAY 004940 004950** MES ARRAY 004960---MESSAGE NOT ON FILE--- 004970** LEV ARRAY 04980 04990ÐÐ/* 05000_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¼3Ù ¼$X119BM PÖÖ999999120382(èÈÐ00010H Q119BM00020F* PRINT SUMMARY PARTS LIST. (X119BM) 00030F* REVISED 8/12/82 5:25 PM. 00040FSUMPLSRTIP F 38 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070I******************************************************************** 00080ISUMPLSRTSP 01 00090I 1 100TCPN L3 00100I 11 200TAPN L1 00110I 21 300TTPN L2 00120I P 31 340TQTYP 00130I P 35 380TQTYE 00140I******************************************************************** 00150IPMMST2 PM 00160I* PART MASTER RECORD (XPMMST) 00170I* KEY AREA 00180I* PART NO. 12A 00190I 1 12 PMPN 00200I* PROD LINE 4N 00210I 15 180PMPL 00220I* MODEL NAME 12A 00230I 19 30 PMMODL 00240I* DESCRIPTION 29A 00250I 31 59 PMDESC ÐÐ00260I* COMMODITY CODE 9P 00270I P 60 640PMCC 00280I* ENG CHANGE STATUS. 00290I* CUR CHG LEVEL 2A 00300I 70 71 PMECHG 00310I* CUR CHG DATE 6N 00320I 72 770PMDCHG 00330I* LAST ECN NO. 5A 00340I 65 69 PMECN 00350I* DRAWING INFO 00360I* DWG SIZE 1A 00370I 82 82 PMSIZ 00380I* DWG CLASS 1A 00390I* D = DYNAIR DWG 00400I* V = VENDOR DWG 00410I 83 83 PMDCLS 00420I* STANDARD CODE 1A 00430I 84 84 PMSTDC 00440I* DWG REL CODE 1A 00450I* E = ENG ONLY 00460I* M = REL TO MFG 00470I* P = PROTOTYPE 00480I 78 78 PMDREL 00490I* UNIT MEAS 2A 00500I* EA = EACH OC = OUNCE ÐÐ00510I* ST = SET TC = TROY OUNCE 00520I* IN = INCH LB = POUND 00530I* FT = FEET PT = PINT 00540I* YD = YARD QT = QUART 00550I* SI = SQ.INCH GL = GALLON 00560I* SF = SQ.FEET DR = DRUM 00570I* SY = SQ.YARD 00580I 85 86 PMUM 00590I* SOURCE CODE 2A 00600I* MA = MFG ASSY 00610I* MP = MFG PART 00620I* PA = PURCH ASSY 00630I* PP = PURCH PART 00640I* RS = RAW STOCK 00650I 94 95 PMSC 00660I* PROVISIONING CODE 1A 00670I* A = FORECAST,NO VALUE ADDED 00680I* B = FORECAST,VALUE ADDED 00690I* C = BUILD TO ORDER (B) 00700I* D = BUILD TO ORDER (NOT B) 00710I* E = CUSTOM 00720I* Y = OBSOLETE,REPAIRABLE 00730I* Z = OBSOLETE,NOT REPAIRABLE 00740I 96 96 PMPROV 00750I* ISSUE CODE 2A ÐÐ00760I* PT = PULL TIME 00770I* OR = ON REQUEST 00780I* BI = BULK ISSUE 00790I* AR = AS REQUIRED 00800I* VS = VENDOR SUPPLIED 00810I* SD = SHIPPING DOCUMENT 00820I* TD = TRAV DOCUMENT 00830I* RD = REF DOCUMENT 00840I* RA = REF ASSY 00850I 97 98 PMISSU 00860I* DELIVER TO DEPT 5P 00870I P 99 1010PMDEL 00880I* RESPONSIBILITY CODES 00890I* ENGR CODE 2A 00900I 102 103 PMEGR 00910I* PLANNER CODE 2A 00920I 104 105 PMPLNR 00930I* BUYER CODE 2A 00940I 106 107 PMBUYR 00950I* SALESMAN CODE 2A 00960I 108 109 PMSLSM 00970I* INVENTORY ACCOUNT 5P 00980I P 110 1120PMACNT 00990I* OLD STYLE PART MASTER FIELDS. 01000I* FAB CODE 2A ÐÐ01010I 487 488 PMFABC 01020I* STD UNIT COST 9.3P 01030I P 489 4933PMOSUC 01040I* RECORD STATUS 1A 01050I* D = DELETED 01060I 674 674 PMSTAT 01070C******************************************************************** 01080C SETOF 909377 01090C SETOF 9676 01100C L1 SETOF 85 01110C L3 SETOF 86 01120C L3 Z-ADD0 TOTQTY TOTAL PER COMPONENT 01130C L2 Z-ADD0 TOPQTY TOTAL PER TOP 01140C L1 Z-ADD0 QTYPER TOTAL PER NEXT ASSY 01150C L3 SETOF 73 01160C L2 SETOF 72 01170C L1 SETOF 71 01180C L3 MOVELTCPN W12A 12 01190C L3 EXSR SR80 GET PMMST2 01200C L3 60 SETON 73 01210C 73 GOTO END 01220C L3 MOVE PMDESC CDESCR 29 01230C L2 MOVELTAPN W12A 01240C L2 EXSR SR80 01250C L2 60 SETON 72 ÐÐ01260C 72 GOTO END 01270C L2 MOVE PMDESC ADESCR 29 01280C TQTYE ADD TOTQTY TOTQTY 70 TOTAL PER COMPONENT 01290C TQTYE ADD TOPQTY TOPQTY 70 TOTAL PER TOP 01300C TQTYE ADD QTYPER QTYPER 70 TOTAL PER NEXT ASSY 01310C SETON 8586 01320C*----------------------------------------------------------- 01330C END TAG 01340C 73 01350COR 72 01360COR 71 SETOF 01 01370C**************************************************************** 01380CSR SR80 BEGSR 01390C* GET PART MASTER 01400CSR MOVE ' ' W12A 12 01410CSR W12A CHAINPMMST2 60 01420CSR ENDSR 01430O********************************************************************* 01440OPRINT H 203 1P 01450O OR OF 01460O UDATE 8 ' - - ' 01470O 70 'SUMMARY PARTS LIST' 01480O 127 'PAGE' 01490O PAGE Z 132 01500O*-------------------------------------------------------------------- ÐÐ01510O H 1 1P 01520O OR OF 01530O 12 'COMPONENT' 01540O 62 'NEXT-ASSY' 01550O 98 'TOP ASSY' 01560O 113 'N/A QTY ' 01570O 127 'TOP QTY ' 01580O*------------------------------------------------------------------- 01590O TF 1 L1 85 01600O* PRINT SUSPENSE RECORD DATA. 01610O TCPN 12 ' - - ' 01620O CDESCR 43 01630O TAPN 57 ' - - ' 01640O ADESCR 88 01650O TTPN 102 ' - - ' 01660O QTYPER2B 113 01670O L2 TOPQTY2B 125 01680O*----------------------------------------------------------------- 01690O TF 1 L3 01700O TOTQTY2B 125 01710O 132 'TOTAL' 01720O TF 1 L2 01730O 1 ' ' 01740O******************************************************************* /* 01750ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ô0 ôÑX302EM P~j120282120282(èÈÐ00010H Q302EM00020F* APPLY TAXES TO CURRENT EARNINGS (X302EM) 00030F* REVISED 12-07-82 1:25 PM. 00040F* 00050FPYCURERNUP F 530 5AI 1 DISK 00060FPYTAXTABID F 75L 9AI 1 DISK 00070F**************************************************************** 00080E PYJ 5 1 O JOB STATUS CODES 00090E YTH 7 5 1 O YTD HOURS 00100E YTE 7 9 2 O YTD $ 00110E YTF 6 7 2 O YTD FED TAX $ 00120E YTS 6 7 2 O YTD ST TAX $ 00130E CTH 7 5 1 O CURR HOURS 00140E CTE 7 9 2 O CURR $ 00150E CTF 6 7 2 O CURR FED TAX 00160E CTS 6 7 2 O CURR ST TAX 00170E TXA 11 6 2 TAX BY # EXEMPT 00180I******************************************************************* 00190IPYCURERNPY 00200I* CURRENT EARNINGS RECORD 00210I* CLOCK # 5N - KEY 00220I 1 50PYCLOK 00230I* DEPT 5N 00240I 6 100PYDEPT 00250I* JOB STATUS 1A X 5 ÐÐ00260I* 1 = ADMIN(A) OR FACTORY(F) 00270I* 2 = PERMANENT(P) OR TEMPORARY(T) 00280I* 3 = FULL TIME(F) OR PART TIME(P) 00290I* 4 = HOURLY(H) OR SALARY(S) 00300I* 5 = DIRECT(D) OR INDIRECT(I) 00310I 11 15 PYJ 00320I* COMPREHENSIVE INSURANCE CLASS 1A 00330I 16 16 PYCICA 00340I* NAME 00350I* 1ST 25A 00360I 17 41 PYFNAM 00370I* MIDDLE 25A 00380I 42 66 PYMNAM 00390I* LAST 30A 00400I 67 96 PYLNAM 00410I* SOCIAL SECURITY NO. 14A 00420I 97 110 PYSS 00430I*-------PAYROLL YEAR-TO-DATE TOTALS--------------------------------- 00440I* HOURS ARRAY 5.1P X 7 00450I* 1 = REGULAR 00460I* 2 = PREMIUM 00470I* 3 = VACATION 00480I* 4 = SICK LEAVE 00490I* 5 = ABSENT 00500I* 6 = OTHER ÐÐ00510I* 7 = NOT USED 00520I P 114 134 YTH 00530I* EARNED DOLLARS 9.2P X 7 00540I* 1 = REGULAR 00550I* 2 = PREMIUM 00560I* 3 = VACATION 00570I* 4 = SICK LEAVE 00580I* 5 = BONUS 00590I* 6 = OTHER 00600I* 7 = NOT USED 00610I P 135 169 YTE 00620I* DEDUCTION TOTALS 00630I* FEDERAL TAX 7.2P X 6 00640I* 1 = WITHHOLDING 00650I* 2 = XTRA WITHHOLDING 00660I* 3 = REBATED (EIC) 00670I* 4 = FICA 00680I* 5 = NOT USED 00690I* 6 = NOT USED 00700I P 170 193 YTF 00710I* STATE TAX 7.2P X 6 00720I* 1 = WITHHOLDING 00730I* 2 = XTRA WITHHOLDING 00740I* 3 = REBATED (EIC) 00750I* 4 = S.D.I. ÐÐ00760I* 5 = NOT USED 00770I* 6 = NOT USED 00780I P 194 217 YTS 00790I*-------PAYROLL TOTALS CURRENT PERIOD------------------------------- 00800I* HOURS ARRAY 5.1P X 7 00810I* 1 = REGULAR 00820I* 2 = PREMIUM 00830I* 3 = VACATION 00840I* 4 = SICK LEAVE 00850I* 5 = ABSENT 00860I* 6 = OTHER 00870I* 7 = NOT USED 00880I P 218 238 CTH 00890I* EARNED DOLLARS 9.2P X 7 00900I* 1 = REGULAR 00910I* 2 = PREMIUM 00920I* 3 = VACATION 00930I* 4 = SICK LEAVE 00940I* 5 = BONUS 00950I* 6 = OTHER 00960I* 7 = NOT USED 00970I P 239 273 CTE 00980I* DEDUCTION TOTALS 00990I* FEDERAL TAX 7.2P X 6 01000I* 1 = WITHHOLDING ÐÐ01010I* 2 = XTRA WITHHOLDING 01020I* 3 = REBATED (EIC) 01030I* 4 = FICA 01040I* 5 = NOT USED 01050I* 6 = NOT USED 01060I P 274 297 CTF 01070I* STATE TAX 7.2P X 6 01080I* 1 = WITHHOLDING 01090I* 2 = XTRA WITHHOLDING 01100I* 3 = REBATED (EIC) 01110I* 4 = S.D.I. 01120I* 5 = NOT USED 01130I* 6 = NOT USED 01140I P 298 321 CTS 01150I*------------------------------------------------------------------- 01160I* FLAG 'X' NOT IN TAX TABLE 01170I 322 322 PYERR 01180I* PERIOD ENDING DATE 6N 01190I 323 3280PEDATE 01200I* PAYROLL RUN # 2A 01210I 329 330 PYRUN 01220I* NO REBATE THIS CHECK 1A 01230I 331 331 PYNORB 01240I* HOLD PAY CHECK CODE 1A 01250I 332 332 PYHOLD ÐÐ01260I* PAY FREQUENCY 1A 01270I* W = WEEKLY 01280I* L = LOA, NO LABOR OR $ 01290I* T = TERMINATED 01300I 333 333 PYFRQ 01310I*-------FEDERAL TAX CODES-------------------------------------------- 01320I* MARITAL STATUS 1A 01330I* M = MARRIED 01340I* S = SINGLE 01350I* H = HEAD OF HOUSEHOLD 01360I* X = EXEMPT 01370I 504 504 PYFTMS 01380I* NUMBER OF EXEMPTIONS 2N 01390I 505 5060PYFTNE 01400I* EXTRA EXEMPTIONS 2N 01410I 507 5080PYFXEX 01420I* XTRA WITHHOLDING CODE 1A (%,$) 01430I 509 509 PYFTXC 01440I* XTRA WITHHOLDING AMOUNT 4N 01450I 510 5130PYFTXA 01460I* EIC CLAIM (1,2) 1N 01470I 514 5140PYFEIC 01480I*-------STATE TAX CODES------------------------------------------- 01490I* MARITAL STATUS 1A 01500I* M = MARRIED ÐÐ01510I* S = SINGLE 01520I* H = HEAD OF HOUSEHOLD 01530I* X = EXEMPT 01540I 515 515 PYSTMS 01550I* NUMBER OF EXEMPTIONS 2N 01560I 516 5170PYSTNE 01570I* EXTRA EXEMPTIONS 2N 01580I 518 5190PYSXEX 01590I* XTRA WITHHOLDING CODE 1A 01600I 520 520 PYSTXC 01610I* XTRA WITHHOLDING AMOUNT 4N 01620I 521 5240PYSTXA 01630I* EICA CLAIM 1N 01640I 525 5250PYSEIC 01650I******************************************************************** 01660IPYTAXTABTX 01670I* KEY- 3A CODE + 5.0 MAX AMT + 1A CODE (M) MAX REC 01680I* 1. TYPE- F = FEDERAL TAX 01690I* R = REBATE (EIC - FED) 01700I* S = STATE 01710I* 2. TAX STATUS- S = SINGLE 01720I* M = MARRIED 01730I* H = HEAD OF HOUSEHOLD (STATE) 01740I* A = ADDITIONAL ITEMIZED ALLOWANCE 01750I* 3. PAY PERIOD- W = WEEKLY ÐÐ01760I* B = BIWEEKLY (NOT USED) 01770I* S = SEMIMONTHLY (NOT USED) 01780I* A = ANNUAL (NOT USED) 01790I* D = DAILY (NOT USED) 01800I* CURRENT TYPE IN TABLE: 01810I* FMW 01820I* FSW 01830I* RMW 01840I* RSW 01850I* SAW 01860I* SHW 01870I* SMW 01880I* SSW 01890I 1 3 TXTYP 01900I* TAXABLE INCOME BRACKET MAX 6.0 01910I 4 80TXIMAX 01920I* CODE 1A "M" FOR MAX RECORD 01930I* INDICATES TABLE MAX AMT IN TXA,1 01940I* PERCENTAGE OF OVER IN TXA,2 01950I 9 9 MAXCOD 01960I* TAX ARRAY 6.2 X 11 01970I* #EXEMPT + 1 = INDEX 01980I 10 75 TXA 01990C********************************************************************* 02000C* INITIALIZE ÐÐ02010C N99 EXSR SR101 SET RATES, LIMITS<<<<02020C EXSR SR201 CLEAR WORK FIELDS 02030C PYJ,1 COMP 'A' 58ADMIN (TIL ADD P/R) 02040C 58 SETON 90 BYPASS TAX " " 02050C XFOOTCTE GROSS 58TOTAL EARNINGS 02060C 58 MOVE 'N' PYFRQ NO LABOR, EARNINGS 02070C 58 SETON 90 BYPASS TAX 02080C 90 GOTO BYPASS 02090C*-------FEDERAL TAX-------------------------------------------------- 02100C* FICA 02110C XFOOTYTE YTDGRS YTD GROSS 02120C YTDGRS COMP FICGLM 56 NOT OVER LIMIT 02130C 56 EXSR SR20 APPLY FICA 02140C* FWT 02150C PYFTMS COMP 'X' 58EXEMPT FROM FED 02160C 58 GOTO ADFED CK ADDITIONAL FED 02170C Z-ADDGROSS TAXABL TAXABLE GROSS 02180C* EXSR SR50 ROUND FOR TABLE 02190C Z-ADDPYFTNE W2N NO. EXEMPTIONS 02200C PYFXEX COMP 0 58EXTRA EXEMPT 02210C N58 EXSR SR21 FED NOT USED<<<<< 02220C* XTRA EXEMPTIONS 02230C PYFTNE COMP 10 54 OVER 10 EXEMPT 02240C 54 EXSR SR30 CALC EXTRA EXEMPT 02250C EXSR SR35 GET TAX TABLE ÐÐ02260C ADFED TAG 02270C* ADDITIONAL WITHHOLDING (CAN BE USED W/EXEMPT FOR CORRECTIONS) 02280C PYFTXC COMP ' ' 58NO EXTRA 02290C N58 EXSR SR22 EXTRA W/H 02300C* EIC REBATE 02310C PYFEIC COMP 0 58NO EIC 02320C N58 EXSR SR23 CALC EIC 02330C*-------STATE TAX----------------------------------------------------- 02340C* SDI 02350C YTDGRS COMP SDIGLM 56 UNDER GROSS LIMIT 02360C 56 EXSR SR40 APPLY SDI 02370C* SWT 02380C PYSTMS COMP 'X' 58EXEMPT STATE TAX 02390C 58 GOTO ADDST CK ADDITIONAL STATE 02400C Z-ADDGROSS TAXBL2 TAXABLE GROSS 02410C EXSR SR50 ROUND FOR TABLE 02420C Z-ADDPYSTNE W2N NO. EXEMPT 02430C* EXTRA EXEMPT 02440C PYSXEX COMP 0 58NO. EXTRA 02450C N58 EXSR SR41 CALC ITEMIZED 02460C EXSR SR45 GET TAX TABLE 02470C ADDST TAG 02480C* ADDITIONAL WITHHOLDING (CAN BE USED W/EXEMPT FOR CORRECTIONS) 02490C PYSTXC COMP ' ' 58NO ADDITIONAL 02500C N58 EXSR SR42 CALC ADDITIONAL ÐÐ02510C* EIC---NOT USED AT PRESENT 02520C PYSEIC COMP 0 58NO EIC 02530C N58 EXSR SR43 IF USED 02540C*----------------------------------------------------------------------- 02550C BYPASS TAG 02560C* UPDATE CURRENT EARNINGS WITH TAX APPLIED 02570C EXSR SR80 UPDATE CUREARN 02580C*------------------------------------------------------------------------ 02590C END TAG 02600C************************************************************************* 02610CSR SR20 BEGSR 02620C* COMPUTE FICA 02630CSR Z-ADD4 X FICA INDEX 02640CSR GROSS MULT FICRAT CTF,X H FICA AMT 02650CSR YTF,X ADD CTF,X WTAX2 PLUS YTD 02660CSR WTAX2 SUB FICTLM WTAX1 54 54OVER LIMIT 02670CSR 54 CTF,X SUB WTAX1 WTAX2 EXCESS 02680CSR 54 Z-ADDWTAX2 CTF,X BACK TO LIMIT 02690CSR ENDSR 02700C*********************************************************************** 02710CSR SR21 BEGSR 02720C* IF ALLOWANCE FOR XTRA EXEMPTIONS IS ADDED TO FEDERAL TAX 02730C* PUT IN THIS SUBROUTINE 02740CSR ENDSR 02750C************************************************************************* ÐÐ02760CSR SR22 BEGSR 02770C* ADDITIONAL WITHHOLDING - FEDERAL 02780CSR PYFTXC COMP '$' 58DOLLAR AMT 02790CSR 58 Z-ADDPYFTXA CTF,2 ADD TO TAX ARRAY 02800CSR PYFTXC COMP '%' 58PERCENT 02810CSR 58 MOVE PYFTXA PERCNT 02820CSR 58 CTF,1 MULT PERCNT CTF,2 H OF TAX 02830CSR ENDSR 02840C*********************************************************************** 02850CSR SR23 BEGSR 02860C* SET UP SEARCH FOR EIC TAX REBATE TABLE 02870CSR Z-ADDGROSS TAXABL TAXABLE GROSS 02880C*R EXSR SR50 ROUND FOR TABLE 02890CSR MOVEL'R' W3A REBATE 02900CSR PYFEIC COMP 2 5658NO. OF CLAIMS 02910CSR 58 MOVEL'M' W2A MAR-2 CLAIMS 02920CSR 56 MOVEL'S' W2A 1 CLAIM 02930CSR MOVE PYFRQ W2A WEEKLY 02940CSR MOVE W2A W3A 02950CSR MOVELW3A W8A 02960CSR MOVE TAXABL W8A GROSS AMT 02970CSR MOVELW8A W9A 02980CSR Z-ADD1 X EIC TAX INDEX 02990CSR Z-ADD3 T TAX ARRAY INDEX 03000CSR EXSR SR60 GET REBATE ÐÐ03010CSR 58 MOVE '*' PYNORB CK PRINT NO EIC 03020CSR ENDSR 03030C************************************************************************ 03040CSR SR30 BEGSR 03050C* REDUCE TAXABLE AMOUNT FOR OVER 10 EXEMPTIONS 03060CSR PYFTNE SUB 10 W2N OVER TEN 03070CSR W2N MULT FWTENW WTAX2 ADD W/H RATE 03080CSR GROSS SUB WTAX2 WTAX1 BREAK 03090CSR Z-ADDWTAX1 TAXABL LOWER TAXABLE 03100C*R EXSR SR50 ROUND FOR TABLE 03110CSR Z-ADD10 W2N LOKUP 10 03120CSR ENDSR 03130C************************************************************************* 03140CSR SR35 BEGSR 03150C* SET UP SEARCH FOR FEDERAL TAX TABLE 03160CSR MOVE TAXABL W8A TAXABLE AMT 03170CSR MOVEL'F' W3A FEDERAL 03180CSR MOVELPYFTMS W2A MAR/SINGLE 03190CSR MOVE PYFRQ W2A WEEKLY 03200CSR MOVE W2A W3A 03210CSR MOVELW3A W8A 03220CSR MOVELW8A W9A 03230CSR W2N ADD 1 X TAX TAB INDEX 03240CSR Z-ADD1 T TAX ARRAY INDEX 03250CSR EXSR SR60 GET FWT ÐÐ03260CSR 58 EXSR SR61 ADD OVER TABLE 03270CSR ENDSR 03280C************************************************************************ 03290CSR SR40 BEGSR 03300C* APPLY SDI 03310CSR Z-ADD4 X TAX INDEX 03320CSR GROSS MULT SDIRAT CTS,X H TAKE % OF GROSS 03330CSR YTS,X ADD CTS,X WTAX2 ADD YTD 03340CSR WTAX2 SUB SDITLM WTAX1 54 54CK OVER SDI LIMIT 03350CSR 54 CTS,X SUB WTAX1 WTAX2 BACK TO LIMIT 03360CSR 54 Z-ADDWTAX2 CTS,X 03370CSR ENDSR 03380C************************************************************************* 03390CSR SR41 BEGSR 03400C* CREATE KEY FOR ITEMIZED DEDUCTION ALLOWANCE TABLE 03410CSR MOVE ZEROS W8A ZERO AMT 03420CSR MOVEL'S' W3A STATE 03430CSR MOVE PYFRQ W2A WEEKLY 03440CSR MOVEL'A' W2A ALLOWANCE 03450CSR MOVE W2A W3A 03460CSR MOVELW3A W8A 03470CSR MOVELW8A W9A 03480CSR Z-ADDPYSXEX X NO. XTRA EXEMPT 03490CSR EXSR SR70 GET DEDUCTION TAB 03500CSR GROSS SUB TXA,X TAXBL2 REDUCE TAXABLE ÐÐ03510CSR EXSR SR50 ROUND FOR TABLE 03520CSR PYSTNE SUB PYSXEX W2N " " NO. EXEMPT 03530CSR ENDSR 03540C********************************************************************* 03550CSR SR42 BEGSR 03560C* XTRA DEDUCTIONS - ADDITIONAL WITHHOLDING 03570CSR PYSTXC COMP '$' 58DOLLAR AMT 03580CSR 58 Z-ADDPYSTXA CTS,2 ADD TO SWT 03590CSR PYSTXC COMP '%' 58 03600CSR 58 MOVE PYSTXA PERCNT 03610CSR 58 CTS,1 MULT PERCNT CTS,2 H TAKE % SWT 03620CSR ENDSR 03630C************************************************************************ 03640CSR SR43 BEGSR 03650C* STATE EIC NOT USED AT THIS TIME 03660C* 03670CSR ENDSR 03680C************************************************************************ 03690CSR SR45 BEGSR 03700C* SET UP KEY FOR SWT TABLE 03710CSR MOVE TAXABL W8A TAXABLE AMT 03720CSR MOVEL'S' W3A STATE 03730CSR MOVE PYFRQ W2A WEEKLY 03740CSR MOVELPYSTMS W2A MAR/SINGLE 03750CSR MOVE W2A W3A ÐÐ03760CSR MOVELW3A W8A 03770CSR MOVELW8A W9A 03780CSR W2N ADD 1 X TAX TAB INDEX 03790CSR Z-ADD1 T SWT AMT INDEX 03800CSR EXSR SR70 FIND TABLE 03810CSR Z-ADDTXA,X CTS,T ADD TO SWT 03820CSR 58 EXSR SR71 REDUCE OVER LIMIT 03830CSR ENDSR 03840C*********************************************************************** 03850CSR SR50 BEGSR 03860C* INCREASE ROUND IF OVER DOLLAR AMT (STATE) 03870CSR MOVELTAXBL2 TAXABL WHOLE DOLLARS 03880CSR MOVE TAXBL2 W2N CENTS 03890CSR W2N COMP 0 58NO CENTS 03900CSRN58 1 ADD TAXABL TAXABL ADD $1 IF CENTS 03910CSR ENDSR 03920C**************************************************************************03930CSR SR60 BEGSR 03940C* FIND TAX TABLE, FEDERAL 03950CSR W9A SETLLPYTAXTAB SET START TABLE 03960C*---------------------------------------------------------------------- 03970CSR T60A TAG 03980CSR READ PYTAXTAB 95 03990CSR W3A COMP TXTYP 91RIGHT TABLE 04000CSRN91 EXSR SR90 FLAG ERR ÐÐ04010CSR TXIMAX COMP TAXABL 58OVER LINE LIMIT 04020CSR 58 GOTO T60A 04030CSR TXIMAX COMP TAXLIM 58 04040CSR Z-ADDTXA,X CTF,T ADD TAX TO ARRAY 04050CSR ENDSR 04060C**************************************************************************04070CSR SR61 BEGSR 04080C* OVER TABLE ADDITION TO FED TAX 04090CSR READ PYTAXTAB 58GET MAX RECORD 04100CSR MAXCOD COMP 'M' 58GOT IT? 04110CSRN58 EXSR SR90 NOT MAX REC 04120CSRN58 GOTO END61 04130CSR TAXABL SUB TXA,1 WTAX1 DIFFERENCE 04140CSR TXA,2 MULT WTAX1 WTAX2 H % OF OVER 04150CSR WTAX2 ADD CTF,T CTF,T ADD TO TAX 04160CSR END61 ENDSR 04170C********************************************************************** 04180CSR SR70 BEGSR 04190C* FIND CORRECT STATE TAX TABLE 04200CSR W9A SETLLPYTAXTAB GET TAB, TAX BRACKET 04210CSR READ PYTAXTAB 95 04220CSR W3A COMP TXTYP 91RIGHT TABLE 04230CSRN91 EXSR SR90 FLAG ERR 04240CSR TXIMAX COMP TAXLIM 58OVER TAB LIMIT 04250CSR ENDSR ÐÐ04260C*********************************************************************** 04270CSR SR71 BEGSR 04280C* ADD PERCENTAGE OF OVER TABLE AMOUNT TO STATE TAX 04290CSR READ PYTAXTAB 58GET MAX RECORD 04300CSR MAXCOD COMP 'M' 58GOT IT? 04310CSRN58 EXSR SR90 ERR NOT MAX 04320CSRN58 GOTO END71 04330CSR TAXABL SUB TXA,1 WTAX1 OVER LIMIT AMT 04340CSR TXA,2 MULT WTAX1 WTAX2 H EXTEND BY % 04350CSR WTAX2 ADD CTS,T CTS,T ADD TO SWT 04360CSR END71 ENDSR 04370C*********************************************************************** 04380CSR SR80 BEGSR 04390C* UPDATE TAXES, CURRENT 04400CSR SETON 80 04410CSR EXCPT OUTPUT ALL PACKED 04420CSR SETOF 80 04430CSR ENDSR 04440C************************************************************************ 04450CSR SR90 BEGSR 04460C* FLAG TAX TABLE ERROR IN CURRENT EARNINGS RECORD 04470CSR MOVE 'X' PYERR ERR FLAG FOR PROO 04480CSR ENDSR 04490C************************************************************************ 04500CSR SR101 BEGSR ÐÐ04510C* 1-TIME INITIALIZE, SET RATES, LIMITS 04520CSR Z-ADD0 ZEROS 50 04530CSR SETON 99 04540C* FEDERAL TAX LIMITS, RATES 04550CSR Z-ADD32400 FICGLM 92 FICA GROSS LIMIT 04560CSR Z-ADD.067 FICRAT 44 FICA TAX RATE 04570CSR Z-ADD2170.80 FICTLM 72 FICA TAX LIMIT 04580CSR Z-ADD19.23 FWTENW 72 OVER 10 EXEMPT DED 04590C* STATE TAX LIMITS, RATES 04600CSR Z-ADD17000 SDIGLM 92 SDI GROSS LIMIT 04610CSR Z-ADD.008 SDIRAT 44 SDI TAX RATE 04620CSR Z-ADD136.00 SDITLM 72 SDI TAX LIMIT 04630C* TABLE LIMITS 04640CSR Z-ADD99999 TAXLIM 50 LAST BRACKET 04650CSR ENDSR 04660C********************************************************************** 04670CSR SR201 BEGSR 04680C* INIT PAYROLL WORK FIELDS 04690CSR SETOF 9095 ADMIN BYPASS 04700CSR Z-ADD0 T 30 PYCURERN INDEX 04710CSR Z-ADD0 X 30 TAX TABLE INDEX 04720CSR MOVE ' ' W3A 3 04730CSR MOVE ' ' W2A 2 04740CSR MOVE ' ' W8A 8 04750CSR MOVE ' ' W9A 9 ÐÐ04760CSR MOVE ' ' PYERR CLEAR ERR FLAG 04770CSR Z-ADD0 W2N 20 04780CSR Z-ADD0 GROSS 92 04790CSR Z-ADD0 YTDGRS 92 YTD GROSS 04800CSR Z-ADD0 TAXABL 50 AMT FOR TABLE SEARCH 04810CSR Z-ADD0 TAXBL2 72 TAXABLE GROSS 04820CSR Z-ADD0 WTAX1 72 TAX WORK FIELDS 04830CSR Z-ADD0 WTAX2 72 " " " 04840CSR Z-ADD0 PERCNT 22 OVER TAX TABLE % 04850CSR ENDSR 04860O******************************************************************* 04870OPYCURERNE 80 04880O YTH 134P 04890O YTE 169P 04900O YTF 193P 04910O YTS 217P 04920O CTH 238P 04930O CTE 273P 04940O CTF 297P 04950O CTS 321P 04960O PYERR 322 04970O PYNORB 331 04980O PYFRQ 333 /* 04990_‚ ÐÐ_‚_‚0CSR MOVE ' ' PYERR CLEAR ERR FLAG 04770CSR Z-ADD0 W2N 20 04780CSR Z-ADD0 GROSS 92 04790CSR Z-ADD0 YTDGRS 92 YTD GROSS 04800CSR Z-ADD0 TAXABL 50 AMT FOR TABLE SEARCH 04810CSR Z-ADD0 TAXBL2 72 TAXABLE GROSS 04820CSR Z-ADD0 WTAX1 72 TAX WORK FIELDS 04830CSR Z-ADD0 WTAX2 72 " " " 04840CSR Z-ADD0 PERCNT 22 OVER TAX TABLE % 04850CSR ENDSR 04860O******************************************************************* 04870OPYCURERNE 80 04880O YTH 134P 04890O YTE 169P 04900O YTF 193P 04910O YTS 217P 04920O CTH 238P 04930O CTE 273P 04940O CTF 297P 04950O CTS 321P 04960O PYERR 322 04970O PYNORB 331 04980O PYFRQ 333 /* 04990_‚ ÐÈ(&; &æX008QM P120282120282(èÈÐ00010H Q008QM00020F* LIST QMMAST - CUSTOMER SEQ (X008QM) 00030F* REVISED 7/14/81 5:00 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FQMMAST IC F 160R 8AI 1 DISK 00070FQCKEY ID F 29L28AI 1 DISK 00080FSLMNAME IT F 80 EDISK 00090FTERM22 O F 22 5 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E SLMNAME TABSLM 1 15 3 TABSLN 20 SALESMAN 00130E TABPRD 1 18 2 TABPRN 20 PRODUCT CODE 00140E TABSYS 1 2 1 TABSYN 20 SYST CODE 00150E TABSTC 1 6 1 TABSTN 10 STATUS WORD 00160E TABRES 1 5 1 TABREN 20 REASON LOST 00170E NUL 1 132 1 NULL CHAR 00180E A6 6 6 1 CALL READ PARAM. 00190E A20 20 20 1 A INPUT DATA ARRAY 00200E DUN 2 2 1 A EDIT CMPLT FLAG 00210E MES 1 1 30 00220E* 00230E* 00240E* 00250E QMD 6 7 0 DATE ARRAY ÐÐ00260E BIT 33 1 SCREEN CONTR. CHAR 00270E* 00280E* 00290I******************************************************************* 00300IBITTAB BT 00310I 1 33 BIT 00320I******************************************************************* 00330IMGFILE MG 00340I* MESSAGE FILE. 00350I 1 35 MGTEXT 00360I********************************************************************** 00370IQCKEY QC 00380I* CUSTOMER ALT-KEY FILE FOR QMMAST 00390I* CUSTOMER NAME 20A 00400I 1 20 QCNAME 00410I* QUOTE # 5A 00420I 21 25 QCQOTE 00430I* QUOTE ITEM # 3N 00440I 26 280QCITEM 00450I* RECORD STATUS 1A 00460I 29 29 QCSTAT 00470I************************************************************************ 00480IQMMAST QM 00490I* QUOTE MASTER. 00500I* QUOTE # 5A ÐÐ00510I 1 5 QMQOTE 00520I* ITEM # 3N 00530I 6 80QMITEM 00540I* CUSTOMER NAME 20A 00550I 9 28 QMNAME 00560I* CUSTOMER RFQ # 20A 00570I 29 48 QMRFQ 00580I* RFQ ITEM # 4A 00590I 49 52 QMRFQI 00600I* CONTACT 20A 00610I 53 72 QMCONT 00620I* ASSIGNED TO (SALESMAN) 3A 00630I 73 75 QMSLSM 00640I* DATE ARRAY 7P X 6 00650I* 1 = RECEIVED 00660I* 2 = DUE 00670I* 3 = SENT 00680I* 4 = EXPECTED AWARD 00690I* 5 = FOLLOW-UP 00700I* 6 = EXPIRES 00710I P 76 99 QMD 00720I* PRODUCT CLASS 2A 00730I 100 101 QMPCLS 00740I* SYSTEM CODE 1A 00750I 102 102 QMSYST ÐÐ00760I* FILLER 103 103 FFFFFF 00770I* QUOTE AMOUNT 7P ($) 00780I P 104 1070QMAMT 00790I* DELIVERY PROMISED (DAYS ARO) 3P 00800I P 108 1090QMDEL 00810I* STATUS 1A 00820I* E = ENTERED 00830I* N = NO BID 00840I* B = BID 00850I* P = PENDING 00860I* L = LOST 00870I* W = WON 00880I* C = CANCELLED 00890I 110 110 QMSCOD 00900I* PROBABILITY OF AWARD 3.2P 00910I P 111 1122QMPROB 00920I* WON/LOST REASON 1A 00930I 113 113 QMREAS 00940I* REMARKS 40A 00950I 114 153 QMREM 00960I* RECORD STATUS 1A 00970I 160 160 QMSTAT 00980C******************************************************************** 00990C* INITIALIZE 01000C EXSR SR101 1-TIME INIT ÐÐ01010C*------------------------------------------------------------------ 01020C START TAG 01030C* SET-UP 1ST FIELD NO. 01040C SETOF 96 01050C Z-ADD1 F 30 FIELD # 01060C GOTO READ 01070C*------------------------------------------------------------------ 01080C NEXT TAG 01090C* SET-UP NEXT FIELD NO. 01100C 1 ADD F F FIELD # 01110C*----------------------------------------------------------------- 01120C READ TAG 01130C* READ DATA FROM TERMINAL. 01140C EXSR SR102 VALIDATE FIELD # 01150C 55 GOTO UPDATE DONE 01160C EXSR SR201 IDENTIFY-F 01170C SETON 69 01180C EXSR SR72 PROMPT 01190C SETOF 69 01200C EXSR SR75 READ TERMINAL 01210C 98 GOTO GOODBY GOODBY 01220C 94 GOTO MENU MENU REQUEST 01230C N77 EXSR SR104 EDIT INPUT FIELD 01240C 93 GOTO NEWITM NEW ITEM 01250C 96 GOTO ERROR ERROR ÐÐ01260C N77 GOTO NEXT NO DATA INPUT 01270C*------------------------------------------------------------------ 01280C PROCES TAG 01290C* PROCESS INPUT DATA 01300C EXSR SR103 MOVE DATA 01310C N96 EXSR SR104 EDIT DATA 01320C 96 GOTO ERROR ERROR 01330C GOTO NEXT 01340C*------------------------------------------------------------------ 01350C UPDATE TAG 01360C* UPDATE DATA BASE. 01370C EXSR SR105 FINAL EDIT 01380C 96 GOTO ERROR ERROR 01390C EXSR SR106 UPDATE 01400C 96 GOTO ERROR ERROR 01410C 94 GOTO MENU RET TO MENU. 01420C 98 GOTO GOODBY SIGN-OFF. 01430C GOTO START 01440C*------------------------------------------------------------------- 01450C JUMP TAG 01460C* SET-UP JUMP TO REQUESTED FIELD 01470C 1 ADD W W 30 01480C W COMP 20 54 01490C 54 Z-ADD318 M 50 96 FLAG ERROR 01500C 54 GOTO ERROR BAD ESC ÐÐ01510C MOVE '000' W3A 3 01520C MOVEAA20,W W3A 01530C Z-ADD3 W2N 20 01540C EXIT SUBRAJ R. JUSTIFY 01550C RLABL W2N 01560C RLABL W3A 01570C MOVE W3A F NEW FIELD # 01580C GOTO READ 01590C*-------------------------------------------------------------------- 01600C ERROR TAG 01610C EXSR SR102 VALIDATE FIELD # 01620C EXSR SR89 GET MSG 01630C EXSR SR73 PUT MSG 01640C GOTO READ 01650C*------------------------------------------------------------------ 01660C NEWITM TAG 01670C* SET-UP LINK FOR NEW ITEM 01680C GOTO START 01690C*------------------------------------------------------------------- 01700C MENU TAG 01710C* SET-UP LINK TO MENU 01720C MOVEL'Q070DP' PROG 8 01730C GOTO END 01740C*-------------------------------------------------------------------- 01750C GOODBY TAG ÐÐ01760C* LINK TO SIGN-OFF 01770C MOVEL'GOODBY' PROG 01780C GOTO END 01790C*------------------------------------------------------------------- 01800C END TAG 01810C PROG COMP BLK8 54 01820C N54 MOVEL'Q070DP' PROG 8 01830C EXITFCHAIN LINK TO NEXT PROG 01840C RLABL PROG 01850C********************************************************************* 01860CSR SR72 BEGSR 01870C* PUT DATA TO TERMINAL 01880CSR 01 69 EXITFQTOPF CLEAR SCREEN 01890CSR SETON 72 01900CSR EXCPT PUT DATA 01910CSR SETOF 72 01920CSR ENDSR 01930C*********************************************************************** 01940CSR SR73 BEGSR 01950C* PUT ERROR MESSAGE TO TERMINAL 01960CSR SETON 73 01970CSR EXCPT PUT MSG 01980CSR SETOF 73 01990CSR Z-ADDM LSTERR 50 02000CSR ENDSR ÐÐ02010C******************************************************************* 02020CSR SR75 BEGSR 02030C* READ FROM TERMINAL 02040CSR SETOF 779096 02050CSR SETOF 939291 02060CSR SETOF 8988 02070CSR MOVE BIT,11 A6,2 BUF LENGTH 02080CSR MOVEAA6 W6A 6 02090CSR MOVE BLK20 W20A 20 BUFFER 02100CSR EXITFXCREAD READ TERM 02110CSR RLABL W20A 02120CSR RLABL W6A 02130CSR MOVEAW20A A20 02140CSR MOVE BLK20 W20A 02150CSR Z-ADD1 W 30 02160CSR '\' LOKUPA20,W 90 FLAG ESC 02170CSRN90 GOTO T75B NOT ESC 02180CSR 1 ADD W W 02190CSR W COMP 20 54 02200CSR 54 GOTO T75A BAD ESC 02210CSR A20,W COMP 'G' 98 GOODBY 02220CSR A20,W COMP 'E' 94 MENU 02230CSR A20,W COMP 'N' 93 NEW ITEM 02240CSR 98 02250COR 94 ÐÐ02260COR 93 GOTO END75 02270C*------------------------------------------------------------------ 02280CSR T75A TAG 02290C* FLAG BAD ESC INPUT 02300CSR Z-ADD318 M 96 FLAG ERROR 02310CSR GOTO END75 02320C*-------------------------------------------------------------------- 02330CSR T75B TAG 02340C* MOVE DATA 02350CSR Z-ADD1 W 02360CSR ' ' LOKUPA20,W 77 02370CSR 77 MOVEAA20,W W20A INPUT DATA 02380C*-------------------------------------------------------------------- 02390CSR END75 TAG 02400C* INIT PREV ERROR MSG. 02410CSR LSTERR COMP 0 54 02420CSR 54 MOVE BLK35 MGTEXT 02430CSR 54 EXSR SR73 BLANK MESSAGE 02440CSR Z-ADD0 LSTERR 50 02450CSR ENDSR 02460C********************************************************************** 02470CSR SR89 BEGSR 02480C* GET MESSAGE MASTER 02490CSR M CHAINMGFILE 54 02500CSR 54 MOVE BLK35 MGTEXT ÐÐ02510CSR 54 MOVELM MGTEXT 02520CSR 54 MOVE MES,1 MGTEXT 02530CSR ENDSR 02540C*********************************************************************** 02550CSR SR101 BEGSR 02560C* 1-TIME INITIALIZE 02570CSR MOVE BIT,1 NUL 02580CSR MOVE BIT,1 A6 02590CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02600CSR MOVE ' ' BLK20 20 02610C* DEFINE WORK FIELDS,ETC. 02620CSR MOVE ' ' BLK35 35 02630CSR MOVE ' ' BLK8 8 02640CSR MOVE ' ' BLK5 5 02650CSR MOVE ' ' BLK20 20 02660C* 02670C* 02680CSR ENDSR 02690C********************************************************************** 02700CSR SR102 BEGSR 02710C* VALIDATE FIELD NO. 02720CSR F COMP 0 54 02730CSRN54 Z-ADD1 F 02740CSR F COMP FLIMIT 55 02750CSR 55 Z-ADD1 F ÐÐ02760CSR ENDSR 02770C******************************************************************** 02780CSR SR103 BEGSR 02790C* MOVE INPUT DATA 02800CSR EXSR SR201 IDENTIFY-F 02810CSR 01 MOVELW20A TNAME 20 CUSTOMER CODE 02820CSR MOVE ' ' DUN,F EDIT FLAG 02830CSR ENDSR 02840C******************************************************************** 02850CSR SR104 BEGSR 02860C* EDIT INPUT DATA 02870CSR 96 MOVE ' ' DUN,F EDIT FLAG 02880CSRN96 MOVE 'X' DUN,F 02890CSR ENDSR 02900C*********************************************************************** 02910CSR SR105 BEGSR 02920C* FINAL EDIT 02930CSR SETON 79 FINAL EDIT FLAG 02940CSR Z-ADD1 F 96 02950C*-------------------------------------------------------------------- 02960CSR T105A TAG 02970CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 02980CSRN54 GOTO END105 02990CSR EXSR SR201 IDENTIFY-F 03000CSR EXSR SR104 EDIT ÐÐ03010CSRN96 GOTO T105A 03020C*-------------------------------------------------------------------- 03030CSR END105 TAG 03040CSR SETOF 79 03050CSR ENDSR 03060C******************************************************************** 03070CSR SR106 BEGSR 03080C* DISPLAY QMMAST RECORD. 03090CSR MOVE BLK35 W28A 28 03100CSR MOVELTNAME W28A 03110CSR W28A SETLLQCKEY 03120CSR Z-ADD0 COUNT 30 03130CSR SETOF 74 03140C*------------------------------------------------------------------- 03150CSR T106A TAG 03160CSR SETOF 54 03170CSR READ QCKEY 54 03180CSR 54 GOTO T106B END OF FILE. 03190CSR QCSTAT COMP 'D' 54 03200CSR 54 GOTO T106A 03210CSR TNAME COMP QCNAME 54 03220CSRN54 GOTO T106B WRONG CUSTOMER 03230CSR MOVELQCQOTE W8A 8 03240CSR MOVE QCITEM W8A 03250CSR W8A CHAINQMMAST 54 ÐÐ03260CSR 54 GOTO T106A 03270CSRN54 QMSTAT COMP 'D' 54 03280CSRN54 QMITEM COMP 0 54 03290CSR 54 GOTO T106A 03300CSR QMQOTE COMP QCQOTE 54 03310CSRN54 GOTO T106A 03320CSR EXSR SR205 TABLE LOKUPS. 03330CSR SETON 76 03340CSR EXCPT DISPLAY QMMAST 03350CSR SETOF 76 03360CSR SETON 74 03370CSR 1 ADD COUNT COUNT 03380CSR COUNT COMP 2 54 03390CSRN54 GOTO T106A 03400CSR Z-ADD34 M 03410CSR GOTO T106C 03420C*------------------------------------------------------------------- 03430CSR T106B TAG 03440C* DISPLAY END PAGE/FILE MSG. 03450CSR Z-ADD317 M 03460C*----------------------------------------------------------------- 03470CSR T106C TAG 03480CSR EXSR SR89 GET END MSG. 03490CSR EXSR SR73 END PAGE/FILE MSG 03500CSR EXSR SR75 ÐÐ03510CSR 94 EXIT. 03520COR 98 GOODBY. 03530COR 93 GOTO END106 NEW ITEM. 03540CSR Z-ADD0 COUNT 74 03550CSR M COMP 317 54 03560CSRN54 GOTO T106A 03570CSR END106 ENDSR 03580C************************************************************************ 03590CSR SR201 BEGSR 03600C* IDENTIFY FIELD NO. 03610CSR F COMP 1 01 03620CSR ENDSR 03630C******************************************************************** 03640CSR SR205 BEGSR 03650C* GET CODE DESCRIPTIONS. 03660CSR QMPCLS LOKUPTABPRD TABPRN 54 PRODUCT NAME 03670CSR 54 MOVE TABPRN PRDNAM 20 03680CSRN54 MOVE BLK20 PRDNAM 03690CSR QMSYST LOKUPTABSYS TABSYN 54 SYSTEM NAME 03700CSR 54 MOVE TABSYN SYSNAM 20 03710CSRN54 MOVE BLK20 SYSNAM 03720CSR QMREAS LOKUPTABRES TABREN 54 REASON NAME 03730CSR 54 MOVE TABREN RESNAM 20 03740CSRN54 MOVE BLK20 RESNAM 03750CSR QMSCOD LOKUPTABSTC TABSTN 54 STATUS NAME ÐÐ03760CSR 54 MOVE TABSTN STCNAM 10 03770CSRN54 MOVE BLK20 STCNAM 03780CSR ENDSR 03790O******************************************************************** 03800OTERM132 E 76N74 03810O 55 'QUOTE INQUIRY - ' 03820O 71 'CUSTOMER SEQUENCE' 03830O 102 'WON' 03840O*------------------------------------------------------------------- 03850O E 76N74 03860O 5 'QUOTE' 03870O 10 'ITEM' 03880O 20 'CUSTOMER' 03890O 41 'CONTACT' 03900O 60 'SLSM' 03910O 66 'PROD' 03920O 71 'SYS' 03930O 83 'AMOUNT$' 03940O 91 'STATUS' 03950O 97 'PROB' 03960O 103 'LOST' 03970O 126 'SCHEDULE' 03980O*------------------------------------------------------------------- 03990O E 76 04000O*------------------------------------------------------------------- ÐÐ04010O E 76 04020O QMQOTE 5 04030O QMITEMZ 9 04040O QMNAME 32 04050O QMCONT 54 04060O QMSLSM 59 04070O QMPCLS 66 04080O QMSYST 70 04090O QMAMT 83 ' , , $0' 04100O QMSCOD 88 04110O QMPROBZ 96 04120O 97 '%' 04130O QMREAS 102 04140O 118 'REC''D' 04150O QMD,1 132 ' - - ' 04160O*------------------------------------------------------------------- 04170O E 76 04180O 17 'RFQ#:' 04190O QMRFQ 42 04200O 47 '-' 04210O QMRFQI 48 04220O PRDNAM 85 04230O STCNAM 97 04240O 116 'DUE' 04250O QMD,2 132 ' - - ' ÐÐ04260O*------------------------------------------------------------------- 04270O E 76 04280O 20 'REMARKS:' 04290O QMREM 62 04300O RESNAM 107 04310O 117 'SENT' 04320O QMD,3 132 ' - - ' 04330O*------------------------------------------------------------------- 04340O E 76 04350O 118 'AWARD' 04360O QMD,4 132 ' - - ' 04370O*------------------------------------------------------------------- 04380O E 76 04390O 122 'FOLLOW-UP' 04400O QMD,5 132 ' - - ' 04410O*------------------------------------------------------------------- 04420O E 76 04430O 120 'EXPIRES' 04440O QMD,6 132 ' - - ' 04450O*------------------------------------------------------------------- 04460O E 76 04470O*------------------------------------------------------------------- 04480O E 73 04490O* PUT MSG. 04500O 96 5 '*****' ÐÐ04510O MGTEXT 48 04520O 96 55 '*****' 04530O BIT,14 132 04540O******************************************************************** 04550OTERM22 E 72 01 04560O 22 'ENTER CUSTOMER CODE: ' ** TABPRD/TABPRN - PROD CLASS 00457011MINI SERIES 00458012SERIES 1500 00459021SERIES 1000 00460022SERIES 3000 00461023SERIES 5900 00462024SERIES 5300 00463041SERIES X 00464042SERIES 10 00465051SERIES 5100 00466052SERIES 1400 00467053SERIES 8100 004680541400/8100 CONTROLS 00469055SYSTEM 21 00470059OTHER SYSTEMS 00471060RF EQUIPMENT 00472070EQUA-DYNE EQUIPMENT 00473090MISC. EQUIPMENT 00474099SKY 515 004750ÐÐ** TABSYS/TABSYN - SYST CODE 004760SSYSTEM 004770NNON-SYSTEM 004780** TABSTC/TABSTN - STATUS CODE 004790EENTERED 004800NNO BID 004810PPENDING 004820LLOST 004830WWON 004840CCANCELLED 004850** TABRES/TABREN - REASON LOST 0048601PRICE 0048702DELIVERY 0048803SPECIFICATIONS 0048904OTHER 0049005NOT KNOWN 004910** NUL ARRAY 004920 004930** A6 ARRAY 004940 004950** A20 ARRAY 004960 004970** DUN ARRAY 004980 004990** MES ARRAY 005000ÐÐ---MESSAGE NOT ON FILE--- 005010/* 005020_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(ú" úiXQWC01 P999999120282(èÈÐ00010H QQWC0100020F* W/C MENU DISPLAY/SELECT PROGRAM. (XQWC01) 00030F* REVISED 10/01/81 11:20 AM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMQWC01 IS F 80 DISK 00070FCRTFILE UC F 256R DISK 00080FDPJOBCONUC F 24R 6AI 1 DISK 00090FTERM50 O F 50 5 00100E******************************************************************** 00110E NUL 1 50 1 00120E PRG 1 75 6 00130E A6 1 6 1 00140E A4 1 4 1 A 00150E BIT 33 1 00160I******************************************************************** 00170IBITTAB BT 01 00180I 1 33 BIT 00190I******************************************************************** 00200IMQWC01 MU 02 00210I* MENU FILE 00220I 1 35 MTEXT 00230I 58 600MSEQ 00240I 65 70 MPROG 70 00250I 76 800MLINE ÐÐ00260I********************************************************************* 00270ICRTFILE CR 00280I 19 26 CRJOB 00290I 27 27 CRSHUT 00300I 28 330CRTIMI 00310I******************************************************************** 00320IDPJOBCONDP 00330I* JOB CONTROL FILE. 00340I* JOB NAME 6A (KEY) 00350I 1 6 DPJOB 00360I* TIME 6N 00370I 7 120DPTIME 00380I* DATE 6N 00390I 13 180DPDATE 00400I* BUSY FLAG 1A 00410I 19 19 DPFLAG 00420I* RECORD STATUS 1A 00430I 24 24 DPSTAT 00440C******************************************************************** 00450C* BYPASS BITTAB. 00460C 01 EXSR SR101 GET CRTFILE 00470C 86 GOTO ENDJOB SHUT DOWN 00480C 01 GOTO END 00490C* BYPASS END OF FILE. 00500C MOVELMTEXT W2A 2 ÐÐ00510C W2A COMP '/*' 54 00520C 54 SETON LR 00530C 54 GOTO END 00540C Z-ADDMSEQ X 30 00550C X COMP 75 54 00560C 54 SETOF 02 00570C 54 SETON LR 00580C 54 GOTO END 00590C 70 GOTO CONTU 00600C MOVE MPROG PRG,X 00610C*------------------------------------------------------------------ 00620C CONTU TAG 00630C MLINE COMP 1 54 00640C MLINE COMP 26 55 00650C MLINE COMP 51 56 00660C 54 00670COR 55 00680COR 56 Z-ADD2 LN 30 00690C 54 Z-ADD1 CN 30 00700C 55 Z-ADD44 CN 00710C 56 Z-ADD90 CN 00720C 1 ADD LN LN 00730C MOVE CN CA 3 00740C MOVE LN LA 3 00750C*------------------------------------------------------------------- ÐÐ00760C END TAG 00770C 02N84 EXITFQTOPF CLEAR SCREEN 00780C 02 SETON 85 00790CL0 85 SETON 84 00800C*------------------------------------------------------------------- 00810CLR MOVE ' ' BLK8 8 00820CLR START TAG 00830CLR SETON 82 00840CLR EXCPT 00850CLR SETOF 82 00860CLR MOVE BIT,1 A6 00870CLR MOVE BIT,3 A6,2 00880CLR MOVEAA6 W6A 6 00890CLR MOVE ' ' W4A 4 00900CLR EXITFXCREAD 00910CLR RLABL W4A 00920CLR RLABL W6A 00930CLR Z-ADD4 W2N 20 00940CLR MOVEAW4A A4 00950CLR '\' LOKUPA4 94 00960CLR '\' LOKUPA4 90 00970CLR 90 'E' LOKUPA4 94 00980CLR 90 'G' LOKUPA4 98 00990CLR 90 'M' LOKUPA4 93 01000CLR 98 MOVEL'GOODBY' PROG ÐÐ01010CLR 93 MOVEL'CONTU' PROG 01020CLR 90N93 01030CANN98 SETON 94 01040CLR 94 MOVE BLK8 PROG 01050CLR 94 MOVEL'CONTU' PROG 01060CLR 90 GOTO ENDJOB 01070CLR EXIT SUBRAJ 01080CLR RLABL W2N 01090CLR RLABL W4A 01100CLR MOVE W4A W3N 30 01110CLR W3N COMP 0 54 01120CLR W3N COMP 75 55 01130CLRN54 01140COR 55 GOTO LRERR 01150CLR Z-ADDW3N X 01160CLR MOVE BLK8 PROG 01170CLR MOVELPRG,X PROG 8 01180CLR MOVE PRG,X W6A 01190CLR SETOF 61 01200CLR W6A CHAINDPJOBCON 60 01210CLRN60 DPSTAT COMP 'D' 61 01220CLR 60 01230COR 61 GOTO ENDJOB 01240CLR DPFLAG COMP ' ' 54 01250CLR 54 MOVEL'CANTRUN' PROG 8 ÐÐ01260CLR 54 GOTO ENDJOB 01270CLR SETON 88 01280CLR EXCPT UPDATE DPJOBCON 01290CLR SETOF 88 01300CLR GOTO ENDJOB 01310C*------------------------------------------------------------------- 01320CLR LRERR TAG 01330CLR SETON 83 01340CLR EXCPT 01350CLR SETOF 83 01360CLR GOTO START 01370C*------------------------------------------------------------------- 01380CLR ENDJOB TAG 01390CLR PROG COMP BLK8 54 01400CLRN54N86 GOTO LRERR 01410CLR TIME TIMEIN TIME OUT 01420CLR 86 MOVE 'SHUTDOWN'PROG 01430CLR MOVE PROG JOB 01440CLR PORT CHAINCRTFILE 54 01450CLR SETON 87 01460CLR EXCPT UPDATE CRTFILE 01470CLR SETOF 87 01480CLR EXITFQTOPF CLEAR SCREEN 01490CLR EXITFCHAIN 01500CLR RLABL PROG ÐÐ01510C******************************************************************** 01520CSR SR101 BEGSR 01530C* GET CRTFILE 01540CSR MOVE ' ' BLK33 33 01550CSR MOVE ' ' BLK8 8 01560CSR MOVE ' ' W2A 2 01570CSR EXITFZGMINX GET PORT # 01580CSR RLABL W2A 01590CSR MOVE W2A PORT 20 01600CSR PORT COMP 0 54 01610CSRN54 Z-ADD25 PORT 01620CSR PORT CHAINCRTFILE H9 01630CSR H9 GOTO END101 01640CSR CRSHUT COMP ' ' 86 FLAG SHUTDOWN 01650CSR 86 MOVE 'SHUTDOWN'PROG 01660CSR TIME TIMEIN 60 TIME IN 01670CSR MOVE BLK8 PROG 8 01680CSR MOVEL'QQWC01' PROG 01690CSR MOVE PROG JOB 8 01700CSR SETON 87 01710CSR EXCPT UPDATE CRTFILE 01720CSR SETOF 87 01730CSR END101 ENDSR 01740C********************************************************************** 01750ODPJOBCONE 88 ÐÐ01760O 19 'X' 01770O******************************************************************** 01780OTERM50 D 02NLR 01790O BIT,28 1 01800O 2 '8' 01810O LA 5 01820O CA 8 01830O N70 X Z 11 01840O MTEXT 48 01850O*------------------------------------------------------------------- 01860O E 82 01870O NUL 50 01880O BIT,28 1 01890O 2 '8' 01900O 8 '001001' 01910O 25 'ENTER SELECTION #' 01920O BIT,28 26 01930O 27 '8' 01940O 33 '001019' 01950O BIT,8 50 01960O*------------------------------------------------------------------- 01970O E 83 01980O NUL 50 01990O BIT,28 1 02000O 2 '8' ÐÐ02010O 8 '001060' 02020O 33 'INVALID SELECTION' 02030O*------------------------------------------------------------------- 02040O E 89 02050O NUL 50 02060O BIT,13 1 02070O******************************************************************** 02080OCRTFILE E 87 02090O JOB 26 02100O TIMEIN 33 02110O 86 BLK33 33 02120O 86 27 'X' 02130O UDATE 37 02140O 73 'QQWC01' 02150O 79 'QQWC01' ** NUL ARRAY 002160 002170** PRG ARRAY 002180 002190** A6 ARRAY 002200 002210** A4 ARRAY 002220 002230/* 002240_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È;® ÈTX006DC Pð050483050483(èÈÐ00010H Q006DC00020F* OUTPUT EGR STD PARTS W/ TEXT & MFR PART NOS. 00030F* LAST REVISED 3-09-84 9:15 AM. 00040F* 00050FPNSEL IP F 80 DISK 00060FEGMAST ID F 100L10AI 1 DISK 00070FEGTEXT IC F 60R DISK 00080FEGMFRPN IC F 40R DISK 00090FMFRNAME IC F 32R 5AI 1 DISK 00100FEGPART O F 80 DISK 00110F**************************************************************** 00120E EGT 10 5 0A 00130E EGM 15 5 0A 00140I******************************************************************** 00150IPNSEL PN 01 00160I* BEGINNING ENGR P/N 10N 00170I 1 100BEGPN 00180I* NEXT TEXT RECORD NO. (CONT) 2N 00190I 11 120TSTART 00200I* NEXT MFR RECORD NO. (CONT) 2N 00210I 13 140MSTART 00220I*********************************************************************** 00230IEGMAST EG 00240I* ENGR STD MASTER 00250I* PART NO. 10N ÐÐ00260I 1 100EGPN 00270I* STANDARDS CODE 6A 00280I 11 16 EGSTD 00290I* INSPECTION CODE 5A 00300I 17 21 EGINSP 00310I* TEXT RRN'S 5P X 10 00320I P 22 51 EGT 00330I* PART NO. CROSS-REF RRN'S 5P X 15 00340I P 52 96 EGM 00350I* RECORD STATUS 1A 00360I 100 100 EGSTAT 00370I*********************************************************** 00380IEGTEXT ET 00390I* TEXT FILE 00400I* PART NO. 00410I 1 100ETPN 00420I* LINE NO. 2N 00430I 11 120ETLINE 00440I* TEXT 45A 00450I 13 57 ETTEXT 00460I* RECORD STATUS 1A 00470I 60 60 ETSTAT 00480I****************************************************************** 00490IEGMFRPN EP 00500I* ENG STD DYNAIR/MFR PART-NO CROSS REF. ÐÐ00510I* MFR CODE 5A 00520I 1 5 EPMFR 00530I* MFR PART NO. 24A 00540I 6 29 EPMPN 00550I* DYNAIR PART NO. 10N 00560I 30 39 EPPN 00570I* RECORD STATUS 1A 00580I 40 40 EPSTAT 00590I************************************************************* 00600IMFRNAME MF 00610I* MANUFACTURER CODE 5A 00620I 1 5 MFRCOD 00630I* MANUFACTURER NAME 25A 00640I 6 30 MFRDES 00650I*********************************************************************** 00660C Z-ADD0 ZERO5 50 00670C Z-ADD0 LASTPN 00680C 01 BEGPN SETLLEGMAST 00690C*-------------------------------------------------------------------- 00700C START TAG 00710C Z-ADD0 TCTR 20 TEXT REC NO 00720C Z-ADD0 MCTR 20 MFR REC NO 00730C SETOF 353654 00740C READ EGMAST 54 GET EGMAST 00750C 54 GOTO END EOF ÐÐ00760C EGPN COMP LASTPN 54 00770C N54 GOTO END 00780C Z-ADDEGPN LASTPN 100 00790C EGSTAT COMP 'D' 54 00800C 54 GOTO START DELETED 00810C Z-ADD1 T 30 00820C Z-ADD1 M 30 00830C*-------------------------------------------------------------------- 00840C TAG10 TAG 00850C 35 GOTO TAG20 00860C ZERO5 LOKUPEGT,T 54 00870C N54 SETON 35 00880C N54 GOTO TAG20 00890C Z-ADDEGT,T RRN 50 00900C Z-ADD0 EGT,T 00910C RRN CHAINEGTEXT 35 00920C N35 ETSTAT COMP 'D' 58 00930C N35N58 EXSR SR41 OUTPUT TEXT REC 00940C N35 GOTO TAG10 GET NEXT 00950C*----------------------------------------------------------------- 00960C TAG20 TAG 00970C 36 GOTO TAG30 00980C ZERO5 LOKUPEGM,M 54 00990C N54 SETON 36 01000C N54 GOTO TAG30 ÐÐ01010C Z-ADDEGM,M RRN 01020C Z-ADD0 EGM,M 01030C RRN CHAINEGMFRPN 36 01040C N36 EPSTAT COMP 'D' 58 01050C N36N58 EXSR SR42 01060C N36 GOTO TAG20 01070C*-------------------------------------------------------------------- 01080C TAG30 TAG 01090C SETON 3050 FINISHED W/1ST 01100C GOTO START 01110C*--------------------------------------------------------------- 01120C END TAG 01130C******************************************************************** 01140CSR SR41 BEGSR 01150CSR 1 ADD TCTR TCTR TEXT REC NO 01160CSRN50 TCTR COMP TSTART 54 1ST TEXT CONT 01170CSRN50N54 GOTO END41 01180CSR SETON 4150 01190CSR EXCPT OUTPUT REC 01200CSR SETOF 41 01210CSR END41 ENDSR 01220C********************************************************************* 01230CSR SR42 BEGSR 01240C* PUT DATA 01250CSR EPMFR CHAINMFRNAME 54 GET MFR NAME ÐÐ01260CSRN54 MOVE MFRDES MFRNAM 25 01270CSR 1 ADD MCTR MCTR MFR REC NO. 01280CSRN30 MCTR COMP MSTART 54 1ST MFR CONT 01290CSRN30N54 GOTO END42 01300CSR SETON 4230 01310CSR EXCPT PUT DATA 01320CSR SETOF 42 01330CSR END42 ENDSR 01340C***************************************************************** 01350OEGPART E 41 01360O 2 'ET' 01370O TCTR 4 01380O EGPN 14 01390O EGSTD 20 01400O EGINSP 25 01410O ETLINE 27 01420O ETTEXT 72 01430O*-------------------------------------------------------------------- 01440O E 42 01450O 2 'EM' 01460O MCTR 4 01470O EGPN 14 01480O EGSTD 20 01490O EGINSP 25 01500O EPMFR 30 ÐÐ01510O MFRNAM B 55 01520O EPMPN 79 01530O*********************************************************************** /* 01540_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(X4 XúX008XP P120282120282(èÈÐ00010H 1 Q008XP00020F* PRINT EXPLOSION RESULTS, INV STATUS SUMMARY. (X008XP) DG REL006 OK 00030F* REVISED 1/18/81 2:00 PM. 00040FWOTRAN IS AF 80R I DISK 00050FXPGUIDE IP AF 16R I DISK 00060FPOTRAN IS AF 80R I DISK 00070FREQTRAN IS AF 80R I DISK 00080FXPMAST ID F 99L22AI 1 DISK 00090FWOADRT IR F 3 3IT EDISK 00100FXGADRT IR F 3 3IT EDISK 00110FRQADRT IR F 3 3IT EDISK 00120FPOADRT IR F 3 3IT EDISK 00130FPMMST2 IC F 674R12AI 1 DISK 00140FXPCONT IC F 128R DISK 00150FMCNCR2 IC F 16R 5AI 1 DISK 00160FXPSTART IT F 10 EDISK 00170FPRINT O F 132 OF PRINTER 00180E******************************************************************** 00190E WOADRT WOTRAN 00200E RQADRT REQTRAN 00210E POADRT POTRAN 00220E XGADRT XPGUIDE 00230E XPSTART BEG 1 1 10 0 00240E MSG 1 2 35 00250E REQ 1 250 7 0A ÐÐ00260E MOD 1 250 12 00270E APN 1 250 10 0 00280E WRK 1 250 9 0A 00290E WA 1 250 9 0A 00300E WB 1 250 9 0A 00310E XCD 18 6 0A SCHED DATES 00320E XPQ 18 7 0A FORECAST QTYS 00330I********************************************************* 00340IXPGUIDE XG 08 00350I 1 100PN L1M2 00360I 11 160DUEDAT M1 00370I******************************************************************** 00380IXPMAST XP 06 00390I* EXPLOSION MASTER. 00400I* KEY AREA. 00410I* LOW LEVEL CODE 2N 00420I 1 20XPLL 00430I* COMPONENT PART # 10N 00440I 3 120XPCPN 00450I* TOP ASSY PN 10N 00460I 13 220XPAPN 00470I* REQMTS 7P X 18 00480I P 23 94 XPQ 00490I* RECORD STATUS 1A 00500I 99 99 XPSTAT ÐÐ00510I***************************************************************** 00520IMCNCR2 MC 00530I 6 150MCPN 00540I******************************************************************** 00550IXPCONT XC 00560I* EXPLOSION CONTROL MASTER. 00570I* DATES 6N X 18 00580I 1 108 XCD 00590I* CUR INDEX LEVEL 2N 00600I 127 1280XCCIL 00610I******************************************************************** 00620IWOTRAN WO 01 1 CW 2 CO 00630I* WORK ORDER TRANSACTION. 00640I* JOB # 6A 00650I 3 8 WOJOB 00660I* ACCOUNT # 5N 00670I 9 130WOACNT 00680I* PART # 10N 00690I 14 230PN L1M2 00700I* DESCRIPTION 8A 00710I 25 32 WODESC 00720I* TOP ASSY WO 6N 00730I 33 380WOTAWO 00740I* CODE 1A (M=THIS IS TOP W/O) 00750I 39 39 WOCODE ÐÐ00760I* TOP MCN 5N 00770I 40 440WOTMCN 00780I* END ITEM SCHED DATE 5N (MMDDY) 00790I 45 490WOEISD 00800I* QTY 7N 00810I 50 560WOQTY 00820I* K-CODE (MAT'L ISSUED) 00830I 57 57 WOKODE 00840I* LOT # 2N 00850I 58 590WOLOT 30 00860I* MODEL 10A 00870I 60 69 WOMODL 00880I* START DATE 6N (YYMMDD) 00890I 71 760DUEDAT M1 00900I GG 07 00910I******************************************************************** 00920IREQTRAN RT 02 1 CR 2 CQ 56 C4 00930I* BACKORDER RECORD. 00940I OR 03 1 CR 2 CQ 56 C5 00950I* ALLOCATION RECORD. 00960I OR 02 1 CR 2 CQ 56 C6 00970I* BACKORDER RECORD. 00980I* PART # 10N 00990I 3 120PN L1M2 01000I* DESCRIPTION 8A ÐÐ01010I 13 19 RTDESC 01020I* JOB # 6A 01030I 21 26 RTJOB 01040I* LOT # 3A (LXX) 01050I 27 29 RTLOT 01060I* TRANS DATE 5N (MMDDY) 01070I 31 350RTDATE 01080I* MCN # 5A 01090I 37 41 RTMCN 01100I* FAB CODE 2A 01110I 52 53 RTFABC 01120I* CARD CODE 1A 01130I* 4,6=BACKORDER 01140I* 5=ALLOCATION 01150I 56 56 RTCARD 01160I* QTY 6N 01170I 62 670RTQTY 01180I* START DATE 6N (FROM W/O) 01190I 71 760DUEDAT M1 01200I* INV TYPE 1A 01210I* 1 = F/G 01220I* 2 = DETAIL 01230I* 3 = S/A'S 01240I 79 79 RTINVC 01250I GG 07 ÐÐ01260I******************************************************************** 01270IPOTRAN PO 04 1 CP 2 CO 01280I* PURCH ORD TRANSACTION. 01290I* PART # 10N 01300I 3 120PN L1M2 01310I* DESCRIPTION 7A 01320I 13 19 PODESC 01330I* P.O. # 5N 01340I 22 260POPON 01350I* DUE DATE 6N (YYMMDD) 01360I 30 350DUEDAT M1 01370I* VENDOR # 5N 01380I 37 410POVEND 01390I* VENDOR NAME 10A 01400I 42 51 POVNAM 01410I* MO/DAY DUE 4N (MMDD) 01420I 52 550POMODU 01430I* PO CODE 2A ('P-O') 01440I 56 58 POPCOD 01450I* P-CODE 1A (P=FAB PER PRINT) 01460I 59 59 POPOCD 01470I* ITEM 2A 01480I 60 61 POITEM 01490I* QTY 6N 01500I 62 670POQTY ÐÐ01510I* PRICE 9.5N 01520I 69 765POPRIC 01530I* INV CODE 2A ('14') 01540I 78 79 POINVC 01550I GG 07 01560I******************************************************************** 01570IPMMST2 PM 01580I 1 100PMPN 01590I 19 30 PMMODL 01600I 31 59 PMDESC 01610I 94 95 PMSC 01620I P 311 3140PMOHB 01630I 430 4310PMLL 01640I 487 488 PMFAB 01650I P 615 6193PMTCST 01660I 674 674 PMSTAT 01670C******************************************************************** 01680C* INITIALIZE. 01690C 07 GOTO END GARBAGE 01700C EXSR SR101 INIT. 01710C Z-ADD0 ZERO7 70 STUPIDITY 01720C Z-ADD0 ZERO6 60 STUPIDITY 01730C Z-ADD0 ZERO9 90 STUPIDITY 01740C 08 GOTO END XP GUIDE FILE 01750C 65 ÐÐ01760COR H9 GOTO END 01770C* PROCESS. 01780C 01 EXSR SR103 WO. 01790C 02 EXSR SR104 B/O. 01800C 03 EXSR SR105 ALLOC. 01810C 04 EXSR SR106 PO. 01820C*------------------------------------------------------------------- 01830C END TAG 01840C 65 SETOF 010203 01850C 65 SETOF 04 01860C* PRINT REMAINING EXPLOSION, IF ANY. 01870CL1 80 Z-ADD999999999 W9N 90 01880CL1 80 EXSR SR107 DO FORECAST 01890C******************************************************************** 01900CSR SR73 BEGSR 01910C* PUT MSG. 01920CSR SETON 73 01930CSR EXCPT 01940CSR SETOF 73 01950CSR ENDSR 01960C******************************************************************** 01970CSR SR80 BEGSR 01980C* GET PART MASTER. 01990CSR W12A CHAINPMMST2 60 02000CSRN60 PMSTAT COMP 'D' 60 ÐÐ02010CSR ENDSR 02020C******************************************************************** 02030CSR SR81 BEGSR 02040C* GET PART MAST VIA MCN. 02050CSR MCN CHAINMCNCR2 54 02060CSR 54 GOTO T81A 02070CSR MOVELMCPN W12A 02080CSR EXSR SR80 GET PMMST2 02090CSRN60 MOVE PMPN TAPN 100 02100CSRN60 MOVE PMMODL TAMODL 12 02110CSRN60 GOTO END81 02120C*------------------------------------------------------------------- 02130CSR T81A TAG 02140CSR MOVE ZERO10 TAPN 02150CSR MOVE BLK12 TAMODL 02160CSR END81 ENDSR 02170C******************************************************************** 02180CSR SR101 BEGSR 02190C* INITIALIZE. 02200CSRN79 EXSR SR201 1-TIME ONLY. 02210CSR L1 EXSR SR202 NEW PART #. 02220CSRN08N07N65 EXSR SR203 EVERY-TIME. 02230CSR ENDSR 02240C******************************************************************** 02250CSR SR103 BEGSR ÐÐ02260C* PROCESS WORK ORDERS. 02270CSR MOVE WOTMCN MCN 02280CSR EXSR SR81 GET MCN/PMMST2 02290CSR WOQTY ADD ORDQTY ORDQTY 02300CSR ORDQTY SUB REQQTY AVAIL 02310CSR WOQTY MULT COST EXTCST 02320CSR ENDSR 02330C******************************************************************** 02340CSR SR104 BEGSR 02350C* PROCESS BACKORDERS. 02360CSR EXSR SR105 02370CSR ENDSR 02380C******************************************************************** 02390CSR SR105 BEGSR 02400C* PROCESS ALLOCATIONS. 02410CSR RTLOT COMP '000' 30 02420CSR MOVE RTMCN MCN 5 02430CSR EXSR SR81 GET MCN/PMMST2 02440CSR RTQTY ADD REQQTY REQQTY 70 02450CSR ORDQTY SUB REQQTY AVAIL 02460CSR RTQTY MULT COST EXTCST 02470CSR ENDSR 02480C******************************************************************** 02490CSR SR106 BEGSR 02500C* PROCESS PURCHASE ORDERS. ÐÐ02510CSR POITEM COMP '00' 30 02520CSR POQTY ADD ORDQTY ORDQTY 02530CSR POQTY MULT POPRIC EXTCST 54 02540CSRN54 POQTY MULT COST EXTCST 02550CSR ORDQTY SUB REQQTY AVAIL 02560CSR ENDSR 02570C******************************************************************** 02580CSR SR107 BEGSR 02590C* PRINT REMAINING FORECAST. 02600CSR Z-ADD1 P 30 02610C*------------------------------------------------------------------- 02620CSR T107A TAG 02630CSR ZERO9 LOKUPWRK,P 54 GET NEXT DATE 02640CSRN54 GOTO END107 02650CSR WRK,P COMP W9N 54 54 02660CSR 54 GOTO END107 02670CSR MOVELWRK,P DATE 60 PRINT DUE DATE 02680CSR MOVE WRK,P A 30 2NDARY INDEX 02690CSR REQ,A MULT COST EXTCST 02700CSR REQ,A ADD REQQTY REQQTY 02710CSR ORDQTY SUB REQQTY AVAIL 02720CSR SETON 81 02730CSR EXCPT 02740CSR SETOF 81 02750CSR Z-ADD0 WRK,P ÐÐ02760CSR GOTO T107A 02770CSR END107 ENDSR 02780C******************************************************************** 02790CSR SR201 BEGSR 02800C* 1-TIME INIT. 02810CSR Z-ADD0 XPQ 02820CSR Z-ADD0 AVAIL 02830CSR Z-ADD0 REQ 02840CSR Z-ADD0 APN 02850CSR MOVE BLK12 MOD 02860CSR SETON 79 02870CSR Z-ADD1 W5N 50 02880CSR W5N CHAINXPCONT H9 02890CSR Z-ADD0 ZERO10 100 02900CSR Z-ADD0 ZERO7 70 02910CSR MOVE ' ' BLK12 12 02920CSR Z-ADD0 ZERO6 60 02930CSR Z-ADD0 ZERO9 90 02940CSR ENDSR 02950C******************************************************************** 02960CSR SR202 BEGSR 02970C* NEW PART # INIT. 02980CSR SETOF 658056 02990CSR PN COMP BEG,1 54 03000CSRN54 SETON 65 ÐÐ03010CSR 65 GOTO END202 03020CSR Z-ADD0 AVAIL 70 03030CSR MOVELPN W12A 12 03040CSR MOVE ' ' W12A 03050CSR EXSR SR80 GET PMMST. 03060CSR 60 SETON 65 03070CSRN60 MOVELPMSC W1A 1 03080CSRN60 W1A COMP 'P' 54 03090CSRN60N54 U7 SETON 65 03100CSRN60 54NU7 SETON 65 03110CSR 65 GOTO END202 BYPASS THIS PART# 03120CSR SETON 80 ACTIVITY FLAG 03130CSR Z-ADD0 L 30 03140CSR Z-ADD999999999 WRK INIT DATES 03150CSR Z-ADDPMTCST COST 93 03160CSR PMOHB MULT PMTCST EXTCST 92 03170CSR PMOHB ADD ORDQTY ORDQTY 70 03180CSR SETON 82 03190CSR EXCPT PRINT PART MAST 03200CSR SETOF 82 03210C* GET XPMAST AND PRINT. 03220CSR Z-ADD0 P 30 03230CSR MOVELPMLL W22A 22 03240CSR MOVELPN W20A 20 03250CSR MOVE ZERO10 W20A ÐÐ03260CSR MOVE W20A W22A 03270CSR W22A SETLLXPMAST 03280CSR SETOF 56 03290C*------------------------------------------------------------------- 03300CSR T202A TAG 03310CSR SETOF 54 03320CSR READ XPMAST 54 03330CSR 54 GOTO END202 03340CSR XPCPN COMP PN 54 03350CSRN54 GOTO END202 03360CSR MOVELXPAPN W12A 03370CSR EXSR SR80 GET ASSY PMMST2 03380CSR 60 Z-ADD0 TAPN 03390CSR 60 MOVE BLK12 TAMODL 03400CSRN60 Z-ADDPMPN TAPN 03410CSRN60 MOVE PMMODL TAMODL 03420CSR Z-ADD1 X 30 03430C*----------------------------------------------------------- 03440CSR T202B TAG 03450CSR ZERO7 LOKUPXPQ,X 54 03460CSRN54 GOTO T202A 03470CSR 1 ADD P P 03480CSR P COMP 250 55 03490CSR 55 Z-ADD2 M 30 03500CSR 55 EXSR SR73 PUT ERROR MSG ÐÐ03510CSR 55 GOTO END202 03520CSR Z-ADDXPQ,X REQ,P QTY 03530CSR Z-ADDXPAPN APN,P TOP PN 03540CSR MOVELXCD,X WRK,P DATE REQD 03550CSR MOVE P WRK,P SAVE INDEX 03560CSR MOVE TAMODL MOD,P TOP MODEL 03570CSR SETON 56 03580CSR Z-ADD0 XPQ,X 03590CSR GOTO T202B 03600CSR END202 TAG 03610CSR 56 U8 'BEFORE' DEBUGPRINT WRK 03620CSR 56 U8 SETON 61 03630CSRN56 U8 SETOF 61 03640CSR 56N65 EXSR SR204 SORT REQMTS 03650CSR 61 U8 'AFTER' DEBUGPRINT WRK 03660CSR ENDSR 03670C******************************************************************** 03680CSR SR203 BEGSR 03690C* EVERY-TIME INIT. 03700CSR Z-ADD0 W9N 90 03710CSR MOVELDUEDAT W9N 90 03720CSR MOVE '000' W9N 03730CSR EXSR SR107 PRINT REQMTS 03740CSR END203 ENDSR 03750C****************************************************************** ÐÐ03760CSR SR204 BEGSR 03770C* SORT FORECAST REQMTS IN REQ 03780C*------------------------------------------------------------- 03790CSR T204A TAG 03800CSR Z-ADD0 X 30 03810CSR Z-ADD0 SAVEX 30 03820CSR Z-ADD0 P 30 03830CSR Z-ADD1 A 30 03840CSR Z-ADD1 B 30 03850CSR Z-ADD0 WA 1ST STRING 03860CSR Z-ADD0 WB 2ND STRING 03870CSR SETOF 535758 03880C*-------------------------------------------------------------- 03890CSR T204B TAG 03900CSR 1 ADD X X 03910CSR X COMP 250 54 03920CSRN54 WRK,X COMP 999999999 54 03930CSR 54 53 GOTO T204E 03940CSR 54 GOTO END204 03950C*--------------------------------------------------------------- 03960CSR T204C TAG 03970CSR WRK,X COMP WA,A 54 54 03980CSRN54 GOTO T204D 03990CSR 57 1 ADD A A 04000CSR Z-ADDWRK,X WA,A 57 ÐÐ04010CSR GOTO T204B 04020C*------------------------------------------------------------- 04030CSR T204D TAG 04040CSR WRK,X COMP WB,B 54 54 04050CSRN54 GOTO T204E 04060CSR 58 1 ADD B B 04070CSR SETON 53 04080CSR Z-ADDWRK,X WB,B 58 04090CSR GOTO T204B 04100C*------------------------------------------------------------- 04110CSR T204E TAG 04120CSR X SUB 1 X 04130CSR Z-ADDSAVEX P 04140CSR Z-ADDX SAVEX 04150CSR Z-ADD1 A 04160CSR Z-ADD1 B 04170C*------------------------------------------------------------- 04180CSR T204F TAG 04190CSR Z-ADD1 A 04200CSR Z-ADD1 B 04210CSR ZERO9 LOKUPWA,A 57 04220CSR ZERO9 LOKUPWB,B 58 04230CSRN57N58 GOTO T204J 04240CSRN58 57 GOTO T204G 04250CSRN57 58 GOTO T204H ÐÐ04260CSR 1 ADD P P 04270CSR WA,A COMP WB,B 54 04280CSR 54 Z-ADDWB,B WRK,P 04290CSR 54 Z-ADD0 WB,B 04300CSRN54 Z-ADDWA,A WRK,P 04310CSRN54 Z-ADD0 WA,A 04320CSR GOTO T204F 04330C*---------------------------------------------------------- 04340CSR T204G TAG 04350CSR 1 ADD P P 04360CSR Z-ADDWA,A WRK,P 04370CSR Z-ADD0 WA,A 04380CSR GOTO T204F 04390C*----------------------------------------------------------- 04400CSR T204H TAG 04410CSR 1 ADD P P 04420CSR Z-ADDWB,B WRK,P 04430CSR Z-ADD0 WB,B 04440CSR GOTO T204F 04450C*------------------------------------------------------------ 04460CSR T204J TAG 04470CSR Z-ADDP SAVEX 04480CSR 1 ADD P P 04490CSR P COMP 250 54 04500CSRN54 WRK,P COMP 999999999 54 ÐÐ04510CSR 54 GOTO T204A START OVER 04520CSR Z-ADDSAVEX X 04530CSR Z-ADD1 A 04540CSR Z-ADD1 B 04550CSR SETOF 5758 04560CSR GOTO T204B CONTU 04570CSR END204 ENDSR 04580O*********************************************************** 04590OPRINT H 101 1P 04600O OR OF 04610O 73 'INVENTORY STATUS REPORT' 04620O U7 85 '-PURCHASED' 04630O NU7 85 '-MFG PARTS' 04640O UDATE Y 8 04650O 127 'PAGE' 04660O PAGE Z 132 04670O*--------------------------------------------------------------- 04680O H 1 1P 04690O OR OF 04700O 41 'USING ASSY' 04710O 86 'UNIT OR' 04720O*---------------------------------------------------------------- 04730O H 1 1P 04740O OR OF 04750O 30 'T/A-WO' ÐÐ04760O 39 'WO-DESCR' 04770O 69 'SOURCE-FAB' 04780O 87 'EXTENDED' 04790O 96 'ON-HAND' 04800O 117 'SCHEDULE' 04810O 128 'AVAILABLE' 04820O*------------------------------------------------------------------- 04830O H 2 1P 04840O OR OF 04850O 8 'PART-NO.' 04860O 25 'DESCRIPTION' 04870O 42 'VENDOR-NAME' 04880O 54 'MODEL-NO.' 04890O 68 'ORDER-LOT' 04900O 76 'VENDOR' 04910O 84 'COST' 04920O 97 'ON-ORDER' 04930O 107 'REQUIRED' 04940O 115 'DATE' 04950O 127 'BALANCE' 04960O*------------------------------------------------------------------- 04970O EF11 82 04980O PN 12 ' - - ' 04990O PMDESC 43 05000O PMOHB J 97 ÐÐ05010O PMMODL 57 05020O PMTCST3 88 05030O PMSC 61 05040O 62 '-' 05050O PMFAB 64 05060O PMOHB K 128 05070O*------------------------------------------------------------------- 05080O D 1 01N65 05090O 22 'WORK-ORD' 05100O WODESC 41 05110O WOTAWO B 30 05120O TAMODL B 57 05130O WOJOB 65 05140O 30 66 '-' 05150O 30 WOLOT Z 68 05160O EXTCST2B 87 05170O WOQTY K 97 05180O DUEDATY 117 05190O AVAIL K 128 05200O*------------------------------------------------------------------- 05210O D 1 02N65 05220O OR 03 05230O 02 24 'BACKORDER' 05240O 03 24 'ALLOCATION' 05250O TAPN B 43 ' - - ' ÐÐ05260O TAMODL B 57 05270O RTJOB 65 05280O 30 66 '-' 05290O 30 RTLOT 69 05300O EXTCSTKB 88 05310O RTQTY K 107 05320O DUEDATY 117 05330O AVAIL K 128 05340O*------------------------------------------------------------------- 05350O D 1 04N65 05360O 23 'PURCH-ORD' 05370O POVNAM 41 05380O POPON Z 65 05390O 30 66 '-' 05400O 30 POITEM 68 05410O POVENDZ 76 05420O EXTCST2B 87 05430O POQTY K 97 05440O DUEDATY 117 05450O AVAIL K 128 05460O*------------------------------------------------------------------- 05470O T 11 L1 80 05480O 17 'TOTALS' 05490O ORDQTYKB 97 05500O REQQTYKB 107 ÐÐ05510O*------------------------------------------------------------------- 05520O EF 1 81 05530O 22 'FORECAST' 05540O APN,A B 43 ' - - ' 05550O MOD,A B 57 05560O EXTCST2 87 05570O REQ,A KB 107 05580O DATE Y 117 05590O AVAIL K 128 05600O*------------------------------------------------------------------- 05610O E 73 05620O MSG,M 35 05630O 45 '*********' ** MSG ARRAY 005640PART MASTER NOT ON FILE 005650FORECAST NOT SHOWN COMPLETE 005660** REQ ARRAY 005670 005680** MOD ARRAY 005690 005700** APN ARRAY 005710 005720** WRK ARRAY 005730 005740** WA ARRAY 005750ÐÐ 005760** WB ARRAY 005770 005780 005790/* 005800_‚ ÐÐ_‚_‚ 005760** WB ARRAY 005770 005780 005790/* 005800_‚ ÐÈ(x/ x2X005WM P999999120282(èÈÐ00010H Q005WM00020F* WORK ORDER MAINTENANCE PROGRAM. (X005WM) 00030F* REVISED 11-04-81 11:35 AM. 00040F* READS WMUPDATE SEQUENTIALLY AND CALLS 00050F* PROGRAM TO PERFORM 2NDARY UPDATES. 00060FBITTAB IP F 33 DISK 00070FWMSTART UC F 16R DISK 00080FWMUPDATEUC F 16R DISK 00090FCRTFILE UC F 256R DISK 00100FTERM50 O F 50 5 U1 00110FWMPROG IT F 80 EDISK 00120E******************************************************************** 00130E WMPROG TABTRN 1 20 2 TABPRG 6 00140I******************************************************************** 00150IBITTAB BT 00160I 1 33 BIT 00170I******************************************************************** 00180IWMSTART WS 01 00190I* LAST PROCESSED RRN. 00200I 1 50WSRRN 00210I******************************************************************** 00220IWMUPDATEWU 00230I 1 20WUPORT 00240I 3 8 WUWO 00250I 9 10 WUTRAN ÐÐ00260I 11 11 WURFLG 00270I 16 16 WUSTAT 00280I******************************************************************** 00290ICRTFILE CR 00300I 74 79 CRMENU 00310I 81 86 CRWO 00320I 87 88 CRTRAN 00330C******************************************************************** 00340C MOVE ' ' W8A 8 00350C Z-ADD0 W2N 20 00360C Z-ADD0 W1N 10 00370C MOVE ' ' W2A 2 00380C EXITFPGMINX 00390C RLABL W8A 00400C RLABL W2N 00410C RLABL W1N 00420C RLABL W2A 00430C MOVE W2A PORT 20 PORT # 00440C PORT COMP 0 54 00450C N54 Z-ADD25 PORT DEFAULT 00460C PORT CHAINCRTFILE H9 00470C H9 GOTO ENDJOB 00480C PORT CHAINWMSTART H8 GET STARTING RRN 00490C H8 GOTO ENDJOB 00500C*------------------------------------------------------------------- ÐÐ00510C START TAG 00520C 1 ADD WSRRN WSRRN 00530C WSRRN CHAINWMUPDATE 54 ADJUST START RRN 00540C N54 GOTO TAG10 00550C MOVELCRMENU PROG 00560C GOTO LINK END OF FILE 00570C*------------------------------------------------------------------- 00580C TAG10 TAG 00590C WUSTAT COMP 'D' 54 00600C 54 GOTO START PREV PROCESSED 00610C WUPORT COMP PORT 54 USER 00620C N54 PORT COMP 25 54 EDP 00630C N54 PORT COMP 7 54 EDP 00640C N54 PORT COMP 6 54 EDP 00650C N54 PORT COMP 8 54 EDP 00660C N54 GOTO START 00670C WUTRAN LOKUPTABTRN TABPRG 54 00680C N54 SETON 80 00690C N54 EXCPT UPDATE CRTFILE 00700C N54 SETOF 80 00710C N54 GOTO START BYPASS 00720C MOVELTABPRG PROG 8 00730C SETON 8081 00740C EXCPT UPD CRTFILE/WMSTART 00750C SETOF 8081 ÐÐ00760C*------------------------------------------------------------------- 00770C LINK TAG 00780C PROG COMP ' ' 54 00790C N54 MOVELCRMENU PROG 00800C EXITFCHAIN 00810C RLABL PROG 00820C*------------------------------------------------------------------- 00830C ENDJOB TAG 00840O******************************************************************** 00850OWMSTART E 81 00860O WSRRN 5 00870O******************************************************************** 00880OWMUPDATEE 80 00890O 16 'D' 00900O******************************************************************** 00910OTERM50 E 80 00920O 6 'Q005WM' 00930O PROG 20 00940O WSRRN Z 27 00950O PORT Z 32 00960O******************************************************************** 00970OCRTFILE E 80 00980O 73 'Q005WM' 00990O WUWO 86 01000O WUTRAN 88 ÐÐ01010O WUPORT 90 01020O WURFLG 91 /* 01030_‚ _‚_‚0O******************************************************************** 00970OCRTFILE E 80 00980O 73 'Q005WM' 00990O WUWO 86 01000O WUTRAN 88 ÐÈ(^b ^’X113DP P999999120282(èÈÐ00010H Q113DP00020F* DISPLAY PROGRAM WHERE-USED FILE 00030F* REVISED 3-10-82 3:45 PM. 00040FBITTAB IP F 33 DISK 00050FTERM78 O F 78 5 00060E******************************************************************** 00070E A16 16 16 1 A 00080E NUL 1 78 1 00090E A18 18 18 1 00100E BIT 33 1 00110I******************************************************************* 00120IBITTAB BT 00130I 1 33 BIT 00140C****************************************************************** 00150C*INITIALIZE 1-TIME 00160C EXSR SR101 INIT 00170C*---------------------------------------------------------------- 00180C START TAG 00190C* REQUEST TYPE. (F-SPEC,E-SPEC,CALL, OR BY PROG) 00200C EXITFQCLF 00210C SETON 84 00220C EXCPT PROMPT 00230C SETOF 84 00240C EXSR SR102 REQUEST TYPE 00250C 90 GOTO END ÐÐ00260C MOVELW16A TYPE 1 00270C TYPE COMP 'E' 41 00280C TYPE COMP 'X' 42 00290C TYPE COMP 'F' 43 00300C TYPE COMP 'M' 44 00310C TYPE COMP 'P' 45 00320C*----------------------------------------------------------------- 00330C TAG10 TAG 00340C* REQUEST DATA 00350C SETON 83 00360C EXCPT PROMPT 00370C SETOF 83 00380C Z-ADD0 COUNT 00390C EXSR SR103 REQUEST DATA 00400C 91 GOTO START 00410C 90 GOTO END 00420C TYPE COMP 'P' 54 00430C 54 GOTO TAG100 GET BY PROGRAM 00440C*-------------------------------------------------------------------- 00450C TAG15 TAG 00460C EXSR SR104 SET LOW LEVEL 00470C EXITFQCLF LF 00480C*------------------------------------------------------------------ 00490C TAG20 TAG 00500C SETOF 75 ÐÐ00510C EXSR SR105 GET NEXT REC 00520C W4A COMP '8000' 58 58 00530C 75 SETON 82 00540C 75 EXCPT END FILE MSG 00550C SETOF 82 00560C 75 GOTO TAG10 00570C 1 ADD COUNT COUNT 30 00580C COUNT COMP 20 54 00590C N54 GOTO TAG20 00600C Z-ADD0 COUNT 00610C W4A COMP '8000' 58 58 00620C SETON 81 00630C EXCPT END PAGE MSG 00640C SETOF 81 00650C EXSR SR102 READ 00660C 91 GOTO TAG10 00670C 90 GOTO END 00680C 77 MOVELW16A NAME 00690C 77 GOTO TAG15 00700C GOTO TAG20 00710C*------------------------------------------------------------------ 00720C TAG100 TAG 00730C EXSR SR106 SET LOW LEVEL 00740C EXITFQCLF LF 00750C*------------------------------------------------------------------- ÐÐ00760C TAG110 TAG 00770C SETOF 75 00780C EXSR SR107 GET NEXT REC 00790C W4A COMP '8000' 58 58 00800C 75 SETON 82 00810C 75 EXCPT END FILE MSG 00820C SETOF 82 00830C 75 GOTO TAG10 00840C 1 ADD COUNT COUNT 00850C COUNT COMP 20 54 00860C N54 GOTO TAG110 NOT END PAGE 00870C Z-ADD0 COUNT 00880C W4A COMP '8000' 58 58 00890C SETON 81 00900C EXCPT END PAGE MSG 00910C SETOF 81 00920C EXSR SR102 READ CRT 00930C 91 GOTO TAG10 00940C 90 GOTO END 00950C 77 MOVELW16A NAME 00960C 77 GOTO TAG100 00970C GOTO TAG110 00980C*------------------------------------------------------------------ 00990C END TAG 01000C***************************************************************** ÐÐ01010CSR SR101 BEGSR 01020C* 1-TIME INIT 01030CSR MOVE BIT,1 NUL 01040CSR MOVE ' ' BLK18 18 01050CSR MOVELBIT,1 BUFLGT 2 01060CSR MOVE ' ' BLK16 16 01070CSR MOVE ' ' W4A 4 01080CSR MOVE ' ' DELCOD 2 01090CSR MOVE ' ' FILBUF 48 01100CSR MOVEL'PROGWU 'FILNAM 8 01110CSR ENDSR 01120C****************************************************************** 01130CSR SR102 BEGSR 01140C* REQUEST TYPE OF SEARCH 01150CSR SETOF 779091 01160CSR MOVE ' ' A16 01170CSR MOVEAA16 W16A 16 01180CSR MOVE BIT,9 BUFLGT 01190CSR EXITFQWREED READ CRT 01200CSR RLABL W16A 01210CSR RLABL BUFLGT 01220CSR MOVEAW16A A16 01230CSR MOVE BLK16 W16A 01240CSR Z-ADD1 W 30 01250CSR '\' LOKUPA16,W 54 ÐÐ01260CSR 54 1 ADD W W 01270CSR 54 A16,W COMP 'E' 90 01280CSR 54 A16,W COMP 'B' 91 01290CSR 91 01300COR 90 GOTO END102 ESCAPE 01310CSR 54 GOTO SR102 01320CSR Z-ADD1 W 01330CSR ' ' LOKUPA16,W 77 01340CSRN77 Z-ADD1 W 01350CSR 77 MOVEAA16,W W16A 01360CSR END102 ENDSR 01370C******************************************************************* 01380CSR SR103 BEGSR 01390C* REQUEST DATA 01400CSR EXSR SR102 01410CSR 90 GOTO END103 01420CSR MOVELW16A NAME 8 01430CSR 44 Z-ADD8 W2N 20 01440CSR 44 EXIT SUBRAJ RJ 01450CSR RLABL W2N 01460CSR RLABL NAME 01470CSR END103 ENDSR 01480C***************************************************************** 01490CSR SR104 BEGSR 01500CSR EXSR SR200 OPEN RANDOM ÐÐ01510CSR MOVE BLK18 W18A 01520CSR MOVELTYPE W9A 9 01530CSR MOVE NAME W9A 01540CSR MOVE BLK18 KEY1 18 01550CSR MOVELW9A KEY1 01560CSR EXITFZRX READ RANDOM 01570CSR RLABL FILBUF REQUEST BUFFER 01580CSR RLABL W18A DATA BUFFER 01590CSR RLABL KEY1 KEY1 01600CSR RLABL W4A ERROR FLAG 01610CSR RLABL DELCOD DELETE CODE 01620CSR MOVEAW18A A18 01630CSR MOVE A18,1 SPEC 1 01640CSR MOVEAA18,2 KEY 8 01650CSR MOVE A18,10 MODE 1 01660CSR MOVEAA18,11 PROG 8 01670CSR W4A COMP '8000' 75 01680CSR ENDSR 01690C**************************************************************** 01700CSR SR105 BEGSR 01710C* GET RECORD, DISPLAY 01720CSR EXITFZGETX GET NEXT RECORD 01730CSR RLABL FILBUF 01740CSR RLABL W18A 01750CSR RLABL KEY1 ÐÐ01760CSR RLABL W4A 01770CSR RLABL DELCOD 01780CSR MOVELW18A W2A 2 01790CSR W2A COMP DELCOD 54 01800CSR 54 GOTO SR105 DELETED RECORD 01810CSR W4A COMP '8000' 75 75FLAG END FILE 01820CSR 75 GOTO END105 END OF FILE 01830CSR MOVEAW18A A18 01840CSR MOVE A18,1 SPEC 1 01850CSR MOVEAA18,2 KEY 8 01860CSR MOVE A18,10 MODE 1 01870CSR MOVEAA18,11 PROG 8 01880CSR 44 MOVE KEY W8N 80 01890CSR W4A COMP '8000' 58 58 01900CSR SETON 80 01910CSR EXCPT PUT DATA 01920CSR SETOF 80 01930CSR END105 ENDSR 01940C********************************************************************* 01950CSR SR106 BEGSR 01960C* SET LOW-LEVEL FOR KEY #2 READ. 01970CSR EXSR SR201 OPEN 01980CSR MOVE BLK18 W18A 18 01990CSR MOVE NAME KEY2 8 02000CSR EXITFZRX READ RANDOM ÐÐ02010CSR RLABL FILBUF 02020CSR RLABL W18A 02030CSR RLABL KEY2 02040CSR RLABL W4A 02050CSR RLABL W2A 02060CSR W4A COMP '8000' 75 FLAG END FILE 02070CSR MOVEAW18A A18 02080CSR MOVE A18,1 SPEC 02090CSR MOVEAA18,2 KEY 02100CSR MOVE A18,10 MODE 02110CSR MOVEAA18,11 PROG 02120CSR ENDSR 02130C******************************************************************** 02140CSR SR107 BEGSR 02150C* READ PROGWU SEQ - KEY #2. 02160CSR Z-ADD2 W6N 60 02170CSR MOVE BLK18 W18A 18 02180CSR EXITFZGETX 02190CSR RLABL FILBUF 02200CSR RLABL W18A 02210CSR RLABL KEY2 02220CSR RLABL W4A 02230CSR RLABL DELCOD 02240CSR MOVELW18A W2A 02250CSR W2A COMP DELCOD 54 ÐÐ02260CSR 54 GOTO SR107 DELETED RECORD 02270CSR W4A COMP '8000' 75 FLAG END FILE 02280CSR 75 GOTO END107 02290CSR MOVEAW18A A18 02300CSR MOVE A18,1 SPEC 02310CSR MOVEAA18,2 KEY 02320CSR MOVE A18,10 MODE 02330CSR MOVEAA18,11 PROG 02340CSR W4A COMP '8000' 58 58 02350CSR SETON 80 02360CSR EXCPT PUT DATA 02370CSR SETOF 80 02380CSR END107 ENDSR 02390C******************************************************************** 02400CSR SR200 BEGSR 02410C* OPEN FILE FOR KEY #1. 02420CSR OPNFLG COMP '1' 54 02430CSR 54 GOTO END200 02440CSR EXSR SR300 CLOSE FILE 02450CSR Z-ADD1 W6N 02460CSR EXSR SR301 OPEN #1 KEY 02470CSR MOVE '1' OPNFLG 1 02480CSR END200 ENDSR 02490C******************************************************************** 02500CSR SR201 BEGSR ÐÐ02510C* OPEN FILE FOR #2 KEY. 02520CSR OPNFLG COMP '2' 54 02530CSR 54 GOTO END201 02540CSR EXSR SR300 CLOSE FILE 02550CSR Z-ADD2 W6N 02560CSR EXSR SR301 OPEN #2 KEY 02570CSR MOVE '2' OPNFLG 02580CSR END201 ENDSR 02590C******************************************************************** 02600CSR SR300 BEGSR 02610C* CLOSE FILE. 02620CSR EXITFZCF CLOSE FILE 02630CSR RLABL FILBUF 02640CSR RLABL W4A 02650CSR ENDSR 02660C******************************************************************** 02670CSR SR301 BEGSR 02680C* OPEN FILE. 02690CSR MOVE W6N W6A 6 02700CSR EXITFZOF OPEN FILE 02710CSR RLABL FILBUF 02720CSR RLABL FILNAM 02730CSR RLABL W6A 02740CSR RLABL W4A 02750CSR W4A COMP '8000' 85 ÐÐ02760CSR 85 EXCPT 02770CSR SETOF 85 02780CSR ENDSR 02790C******************************************************************** 02800OTERM78 E 80 02810O SPEC 1 02820O KEY 20 02830O 44 W8N 2 20 02840O MODE 30 02850O PROG 40 02860O 58 W4A 78 02870O*------------------------------------------------------------------ 02880O E 85 02890O 5 'OPEN' 02900O W6A 15 02910O W4A 78 02920O*----------------------------------------------------------------- 02930O E 81 02940O NUL 78 02950O 24 'END OF PAGE.............' 02960O 58 W4A 78 02970O*----------------------------------------------------------------- 02980O E 82 02990O NUL 78 03000O 24 'END OF FILE. . . . . . .' ÐÐ03010O 58 W4A 78 03020O*------------------------------------------------------------------ 03030O E 83 03040O NUL 78 03050O 24 'ENTER SEARCH DATA. . . ' 03060O*------------------------------------------------------------------ 03070O E 84 03080O NUL 78 03090O 24 'ENTER TYPE OF SEARCH (E,' 03100O 48 ' F, X, M, OR P . . . . ' 03110O***************************************************************** ** A16 ARRAY 03120 03130** NUL ARRAY 03140 03150** A18 ARRAY 03160 03170/* 03180_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Èõ ÈTX009DP P120282120282(èÈÐ00010H Q009DP00020F* DISPLAY HEX CHAR. (X009DP) 00030F* REVISED 4/18/79 3:20 PM. 00040FBITHEX IP F 256 DISK 00050FPMTRANO ID F 80 DISK 00060FTERMO O F 132 5 00070E******************************************************************** 00080E A6 6 6 1 00090E HEX 1 256 2 00100E NUM 1 80 3 00110E WK 8 8 1 00120E AH 1 80 2 00130E AB 1 80 8 00140E H1 16 16 1 00150E BIT 256 1 00160E REC 80 1 00170I******************************************************************** 00180IBITHEX BT 01 00190I 1 256 BIT 00200I******************************************************************** 00210IPMTRANO PM 02 00220I 1 12 RPN 00230I 1 80 REC 00240C******************************************************************** 00250C EXSR SR101 ÐÐ00260C Z-ADD0 X 30 00270C*------------------------------------------------------------------- 00280C START TAG 00290C MOVE BIT,1 A6 00300C MOVE BIT,7 A6,2 00310C MOVEAA6 W6A 6 00320C MOVE ' ' BLK12 12 00330C MOVE BLK12 W12A 12 00340C EXITFXCREAD 00350C RLABL W12A 00360C RLABL W6A 00370C*------------------------------------------------------------------- 00380C READ TAG 00390C READ PMTRANO LR 00400C LR GOTO ENDLR 00410C RPN COMP W12A 54 00420C N54 GOTO READ 00430C*------------------------------------------------------------------- 00440C CONTU TAG 00450C 1 ADD X X 00460C X COMP 80 54 00470C 54 GOTO END 00480C Z-ADD1 H 30 00490C REC,X LOKUPBIT,H 88 00500C N88 MOVE 'XX' AH,X ÐÐ00510C SETOF 505152 00520C SETOF 535455 00530C SETOF 5657 00540C MOVE '0' WK 00550C TESTB'0' REC,X 50 00560C 50 MOVE '1' WK,1 00570C TESTB'1' REC,X 51 00580C 51 MOVE '1' WK,2 00590C TESTB'2' REC,X 52 00600C 52 MOVE '1' WK,3 00610C TESTB'3' REC,X 53 00620C 53 MOVE '1' WK,4 00630C TESTB'4' REC,X 54 00640C 54 MOVE '1' WK,5 00650C TESTB'5' REC,X 55 00660C 55 MOVE '1' WK,6 00670C TESTB'6' REC,X 56 00680C 56 MOVE '1' WK,7 00690C TESTB'7' REC,X 57 00700C 57 MOVE '1' WK,8 00710C MOVEAWK AB,X 00720C N88 MOVE 'XXX' NUM,X 00730C 88 MOVE H NUM,X 00740C 88 MOVE HEX,H AH,X 00750C GOTO CONTU ÐÐ00760C*------------------------------------------------------------------- 00770C END TAG 00780C Z-ADD0 X 30 00790C*------------------------------------------------------------------- 00800C LR10 TAG 00810C 1 ADD X X 00820C 1 ADD COUNT COUNT 30 00830C COUNT COMP 56 54 00840C 54 EXITFXPAUSE 00850C 54 Z-ADD1 COUNT 00860C SETON 80 00870C EXCPT 00880C SETOF 80 00890C X COMP 80 54 00900C N54 GOTO LR10 00910C*------------------------------------------------------------------- 00920C ENDLR TAG 00930C EXITFXPAUSE 00940C MOVE ' ' NUM 00950C MOVE ' ' AH 00960C MOVE ' ' BLK8 8 00970C MOVE BLK8 AB 00980C Z-ADD0 X 00990C GOTO START 01000C******************************************************************** ÐÐ01010CSR SR101 BEGSR 01020CSR Z-ADD0 A 30 01030CSR Z-ADD0 T 30 01040C*------------------------------------------------------------------- 01050CSR T101A TAG 01060CSR 1 ADD A A 01070CSR A COMP 16 54 01080CSR 54 GOTO END101 01090C*------------------------------------------------------------------- 01100CSR T101B TAG 01110CSR Z-ADD0 B 30 01120C*------------------------------------------------------------------- 01130CSR T101C TAG 01140CSR 1 ADD B B 01150CSR B COMP 16 54 01160CSR 54 GOTO T101A 01170CSR 1 ADD T T 01180CSR MOVELH1,A HEX,T 01190CSR MOVE H1,B HEX,T 01200CSR GOTO T101C 01210CSR END101 ENDSR 01220O******************************************************************** 01230OTERMO E 80 01240O X Z 3 01250O REC,X 6 ÐÐ01260O NUM,X 11 01270O AH,X 16 01280O AB,X 28 ** A6 ARRAY 001290 001300** HEX ARRAY 001310 001320** NUM ARRAY 001330 001340** WK ARRAY 001350 001360** AH ARRAY 001370 001380** AB ARRAY 001390 001400** H1 ARRAY 0014100123456789ABCDEF 001420/* 001430_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(^J ^’X111BM P Ö999999120282(èÈÐ00010H Q111BM00020F* INPUT SPLTRAN (SUMMARY PARTS LIST) TRAN FROM CRT. (X111BM) 00030F* REVISED 8/17/82 4:45 PM. 00040FBITPAR IP F 90 DISK 00050FCRTFILE UC F 256R DISK 00060FSPLTRAN O F 32 32 DISK A 00070FPMMST2 IC F 674R12AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FTERM44 O F 44 5 00100FTERM72 O F 72 5 00110E******************************************************************** 00120E A12 12 12 1 A 00130E NUL 40 40 1 00140E LNK 1 7 6 A 00150E CALL 7 6 00160E PAR 25 1 00170E TST 25 1 00180E BIT 33 1 00190I******************************************************************** 00200IBITPAR BT 00210I 1 33 BIT 00220I 34 58 PAR 00230I 59 83 TST 00240I***************************************************************** 00250ICRTFILE CR ÐÐ00260I 28 330CRTIME 00270I 34 370CRDATE 00280I 38 79 CALL 00290I******************************************************************** 00300IPMMST2 PM 00310I* PART NO. 10N 00320I 1 100PMPN 00330I* NUMB OF COMPONENTS 3P 00340I P 13 140PMNOBM 00350I* PROD LINE 4N 00360I 15 180PMPL 00370I* MODEL NAME 12A 00380I 19 30 PMMODL 00390I* DESCRIPTION 29A 00400I 31 59 PMDESC 00410I* COMMODITY CODE 9P 00420I P 60 640PMCC 00430I* ENG CHANGE STATUS. 00440I* CUR CHG LEVEL 2A 00450I 70 71 PMECHG 00460I* CUR CHG DATE 6N 00470I 72 770PMDCHG 00480I* LAST ECN NO. 5A 00490I 65 69 PMECN 00500I* DRAWING INFO ÐÐ00510I* DWG SIZE 1A 00520I 82 82 PMSIZ 00530I* DWG CLASS 1A 00540I* D = DYNAIR DWG 00550I* V = VENDOR DWG 00560I 83 83 PMDCLS 00570I* STANDARD CODE 1A 00580I 84 84 PMSTDC 00590I* DWG REL CODE 1A 00600I* E = ENG ONLY 00610I* M = REL TO MFG 00620I* P = PROTOTYPE 00630I 78 78 PMDREL 00640I* UNIT MEAS 2A 00650I* EA = EACH OC = OUNCE 00660I* ST = SET TC = TROY OUNCE 00670I* IN = INCH LB = POUND 00680I* FT = FEET PT = PINT 00690I* YD = YARD QT = QUART 00700I* SI = SQ.INCH GL = GALLON 00710I* SF = SQ.FEET DR = DRUM 00720I* SY = SQ.YARD 00730I 85 86 PMUM 00740I* SOURCE CODE 2A 00750I* MA = MFG ASSY ÐÐ00760I* MP = MFG PART 00770I* PA = PURCH ASSY 00780I* PP = PURCH PART 00790I* RS = RAW STOCK 00800I 94 95 PMSC 00810I* PROVISIONING CODE 1A 00820I* A = FORECAST,NO VALUE ADDED 00830I* B = FORECAST,VALUE ADDED 00840I* C = BUILD TO ORDER (B) 00850I* D = BUILD TO ORDER (NOT B) 00860I* E = CUSTOM 00870I* Y = OBSOLETE,REPAIRABLE 00880I* Z = OBSOLETE,NOT REPAIRABLE 00890I 96 96 PMPROV 00900I* ISSUE CODE 2A 00910I* PT = PULL TIME 00920I* OR = ON REQUEST 00930I* BI = BULK ISSUE 00940I* AR = AS REQUIRED 00950I* VS = VENDOR SUPPLIED 00960I* SD = SHIPPING DOCUMENT 00970I* TD = TRAV DOCUMENT 00980I* RD = REF DOCUMENT 00990I* RA = REF ASSY 01000I 97 98 PMISSU ÐÐ01010I* DELIVER TO DEPT 5P 01020I P 99 1010PMDEL 01030I* RESPONSIBILITY CODES 01040I* ENGR CODE 2A 01050I 102 103 PMEGR 01060I* PLANNER CODE 2A 01070I 104 105 PMPLNR 01080I* BUYER CODE 2A 01090I 106 107 PMBUYR 01100I* SALESMAN CODE 2A 01110I 108 109 PMSLSM 01120I* INVENTORY ACCOUNT 5P 01130I P 110 1120PMACNT 01140I* RECORD STATUS 1A 01150I* D = DELETED 01160I 674 674 PMSTAT 01170I******************************************************************** 01180IMGFILE MG 01190I* MESSAGE FILE. 01200I* TEXT 35A 01210I 1 35 MGTEXT 01220I* LINE-2 35A 01230I 36 70 MGLIN2 01240I* PROG NAME 5A 01250I 71 75 MGPROG ÐÐ01260C******************************************************************** 01270C* INITIALIZE. GET LU#. CLEAR SCREEN. 01280C EXSR SR101 INIT. 01290C*------------------------------------------------------------------- 01300C START TAG 01310C* REQUEST PART #. 01320C EXSR SR71 PROMPT. 01330C EXSR SR72 READ. 01340C 94 GOTO END EXIT. 01350C W12A COMP BLK12 54 01360C N54 Z-ADD299 M 50 01370C N54 GOTO ERROR ERROR. 01380C SETOF 61 01390C MOVELW12A W10A 10 01400C Z-ADD10 W2N 20 01410C EXIT SUBRAJ 01420C RLABL W2N 01430C RLABL W10A 01440C MOVELW10A W12A 01450C MOVE ' ' W12A 01460C W12A CHAINPMMST2 60 GET PMMST. 01470C N60 PMSTAT COMP 'D' 61 FLAG DELETE. 01480C N60N61 GOTO CONTU GOT MAST. 01490C* FLAG NO MAST ERROR. 01500C Z-ADD302 M ÐÐ01510C GOTO ERROR ERROR. 01520C*------------------------------------------------------------------- 01530C CONTU TAG 01540C* FLAG ERROR IF NO COMPONENTS ON FILE. 01550C PMNOBM COMP 0 54 01560C N54 Z-ADD316 M 01570C N54 GOTO ERROR 01580C* REQUEST QTY MULTIPLIER. 01590C SETON 70 01600C EXCPT PROMPT 01610C SETOF 70 01620C EXSR SR72 READ 01630C 94 GOTO START 01640C Z-ADD12 W2N 01650C EXIT SUBRAJ 01660C RLABL W2N 01670C RLABL W12A 01680C MOVE W12A TQTY 50 01690C TQTY COMP 0 54 01700C N54 Z-ADD1 TQTY 01710C SETON 81 01720C EXCPT ADD SPLTRAN. 01730C SETOF 81 01740C GOTO START GET NEXT READ. 01750C*------------------------------------------------------------------- ÐÐ01760C ERROR TAG 01770C* PUT ERROR MSG. 01780C EXSR SR89 GET MSG. 01790C EXSR SR73 PUT MSG. 01800C GOTO START 01810C*------------------------------------------------------------------- 01820C END TAG 01830C SETON 82 01840C EXCPT 01850C*------------------------------------------------------------------- 01860C ENDJOB TAG 01870C******************************************************************** 01880CSR SR71 BEGSR 01890C* PUT PROMPT. 01900CSR SETON 71 01910CSR EXCPT PUT PROMPT. 01920CSR SETOF 71 01930CSR ENDSR 01940C******************************************************************** 01950CSR SR72 BEGSR 01960C* READ CRT. 01970CSR SETOF 7794 01980CSR MOVE BIT,7 BUFLGT 2 01990CSR MOVE BLK12 W12A 12 02000CSR EXITFQWREED ÐÐ02010CSR RLABL W12A BUF. 02020CSR RLABL BUFLGT BUF LGTH. 02030CSR MOVEAW12A A12 02040CSR '\' LOKUPA12 94 02050CSR 94 GOTO END72 02060CSR MOVE BLK12 W12A 02070CSR Z-ADD1 W 20 02080CSR ' ' LOKUPA12,W 77 02090CSR 77 MOVEAA12 W12A 02100CSR END72 ENDSR 02110C******************************************************************** 02120CSR SR73 BEGSR 02130C* PUT ERR MSG. 02140CSR SETON 73 02150CSR EXCPT 02160CSR SETOF 73 02170CSR ENDSR 02180C******************************************************************** 02190CSR SR89 BEGSR 02200C* GET MGFILE. 02210CSR M CHAINMGFILE 54 GET MGFILE. 02220CSR 54 MOVE BLK35 MGTEXT 02230CSR 54 MOVELM MGTEXT 02240CSR 54 MOVE 'NO MSG' MGTEXT 02250CSR ENDSR ÐÐ02260C******************************************************************** 02270CSR SR96 BEGSR 02280CSR # CHAINCRTFILE H9 02290CSR H9 GOTO END 02300CSR ENDSR 02310C****************************************************************** 02320CSR SR97 BEGSR 02330CSR TIME CRTIME 02340CSR MOVELUDATE CRDATE 02350CSR SETON 97 02360CSR EXCPT 02370CSR SETOF 97 UPDATE CRTFILE 02380CSR ENDSR 02390C******************************************************************** 02400CSR SR98 BEGSR 02410CSR EXITFCHAIN 02420CSR RLABL PROG 02430CSR ENDSR 02440C****************************************************************** 02450CSR SR101 BEGSR 02460C* INITIALIZE (1-TIME). 02470CSR MOVE BIT,1 NUL 02480CSR MOVELBIT,1 BUFLGT 2 02490CSR MOVE ' ' W2A 2 02500CSR EXITFZGMINX GET LU# ÐÐ02510CSR RLABL W2A 02520CSR MOVE W2A # 20 02530CSR # COMP 0 54 02540CSRN54 Z-ADD25 # 02550CSR EXSR SR96 GET CRTFILE 02560CSR PAR,# COMP '1' 50 02570CSR 50 SETON 74 02580CSR 50 EXCPT 02590CSR 50 SETOF 74 02600CSR 50 MOVE 'S' TST,# 02610CSR TST,# COMP 'S' 54 02620CSR 54 GOTO ENDJOB 02630CSR MOVE CALL LNK 02640CSR MOVE 'Q111BM 'PROG 8 02650CSR EXSR SR97 UPDATE CRTFILE 02660CSR MOVE ' ' BLK12 12 02670CSR MOVE ' ' BLK35 35 02680CSR ENDSR 02690O******************************************************************** 02700OTERM44 E 71 02710O* PUT PROMPT. 02720O 38 'ENTER ASSY PART #' 02730O*------------------------------------------------------------------- 02740O E 70 02750O* PROMPT ÐÐ02760O 41 'ENTER QTY MULTIPLIER' 02770O*------------------------------------------------------------------- 02780O E 73 02790O* PUT ERROR MSG. 02800O 4 '***' 02810O MGTEXT 40 02820O*------------------------------------------------------------- 02830OTERM72 E 82 02840O 24 'DISPLAY WILL BE READY IN' 02850O 48 ' A FEW MINUTES ' 02860O*------------------------------------------------------------------- 02870O E 74 02880O 24 'THIS JOB SHOULD NOT BE R' 02890O 48 'UN ON THIS TYPE TERMINAL' 02900O******************************************************************** 02910OSPLTRAN EADD 81 02920O # 2 02930O 4 'SP' 02940O PMPN 14 02950O TQTY 19 02960O****************************************************************** 02970OCRTFILE E 97 02980O CRDATE 33 02990O CRTIME 37 03000O LNK 79 ÐÐ03010O PROG 26 03020O******************************************************************* ** A12 ARRAY 003030 003040** NUL ARRAY 003050 003060** LNK 003070 03080/* 03090_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( Ý  NX009GL P120282120282(èÈÐ00010H Q009GL00020F* LIST CHART OF ACCOUNTS - INDENTED. (X009GL) D A T A G R A P H I X 00030F* REVISED 7-29-81 10:05 AM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FCAMAST ID F 40L18AI 1 DISK 00070FGLMAST IC F 165R 9AI 1 DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A8 8 8 1 A INPUT DATA ARRAY 00120E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00130E DUN 13 13 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E LEV 1 20 18 00160E DASH 1 1 43 00170E A24 24 24 1 00180E BIT 256 1 SCREEN CONTR. CHAR 00190E GLA 12 11 2 00200I******************************************************************* 00210IBITHEX BT 00220I 1 256 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I******************************************************************** 00280IGLMAST GL 00290I* ACCOUNT MASTER. 00300I* KEY AREA 00310I* ACCOUNT # 9A 00320I 1 9 GLKEY 00330I 1 1 GLPRFX 00340I 2 60GLPRIM 00350I 7 90GLDASH 00360I* ACCOUNT GROUP 4A 00370I 14 17 GLGRUP 00380I* ACCOUNT DESCRIPTION 40A 00390I 18 57 GLDESC 00400I* BALANCE FORWARD AMOUNT 11.2P 00410I P 58 632GLBALF 00420I* ACTUAL $ 11.2P X 12 00430I P 64 135 GLA 00440I* CURRENT MONTH-PLUS 11.2P 00450I P 136 1412GLCMP 00460I* CURRENT MONTH-MINUS 11.2P 00470I P 142 1472GLCMM 00480I* SOURCE CODE 1A 00490I* S = SUB-ACCOUNT ONLY, 00500I* MAY NOT BE PARENT ÐÐ00510I 148 148 GLSC 00520I* BALANCE FORWARD CODE 2A 00530I* 1ST COL 00540I* 1 = ZERO BAL AT START NEW YR 00550I* 2 = CARRY PREV YR FRWD 00560I* 2ND COL 00570I* A = ZERO BAL AT START NEW MO 00580I* B = CARRY PREV MO FRWD 00590I 149 150 GLBFC 00600I* NUMB OF SUB-ACCOUNTS 5P 00610I P 157 1590GLNOSA 00620I* LOW LEVEL CODE 3N 00630I 160 1620GLLL 00640I* FILLER 00650I* RECORD STATUS 1A 00660I 165 165 GLSTAT 00670I******************************************************************** 00680ICAMAST CA 00690I* CHART OF ACCOUNTS. 00700I* KEY AREA. 00710I* PARENT ACCOUNT 9A 00720I 1 9 CAPAR 00730I* SUB-ACCOUNT 9A 00740I 10 18 CASUB 00750I* OPERATOR 1A ÐÐ00760I* S = SUBTRACT 00770I* A = ADD 00780I 25 25 CAOPER 00790I* EFFECTIVITY 00800I* START DATE 6N (YMD) 00810I 26 310CASDAT 00820I* END DATE 6N (YMD) 00830I 32 370CAEDAT 00840I* FILLER 00850I* RECORD STATUS 1A 00860I 40 40 CASTAT 00870C******************************************************************** 00880C* INITIALIZE 00890C EXSR SR101 1-TIME INIT 00900C*------------------------------------------------------------------ 00910C START TAG 00920C* SET-UP 1ST FIELD NO. 00930C MOVE ' ' DUN INIT EDIT ARRAY 00940C Z-ADD1 F 30 FIELD # 00950C GOTO READ 00960C*------------------------------------------------------------------ 00970C NEXT TAG 00980C* SET-UP NEXT FIELD NO. 00990C 1 ADD F F FIELD # 01000C*----------------------------------------------------------------- ÐÐ01010C READ TAG 01020C* READ DATA FROM TERMINAL. 01030C SETOF 9096 01040C EXSR SR102 VALIDATE FIELD # 01050C 55 GOTO UPDATE DONE 01060C EXSR SR201 IDENTIFY-F 01070C 01 Z-ADD362 M 50 ENTER PREFIX 01080C 02 Z-ADD363 M ENTER PRIME 01090C 03 Z-ADD364 M ENTER DASH 01100C EXSR SR89 GET MSG 01110C SETON 69 01120C EXSR SR73 PROMPT 01130C SETOF 69 01140C EXSR SR75 READ TERMINAL 01150C 98 GOTO GOODBY GOODBY 01160C 94 GOTO MENU MENU REQUEST 01170C 93 GOTO NEWITM NEW ITEM 01180C 92 GOTO JUMP FIELD JUMP REQST 01190C 91 GOTO NEXT SKIP FORWARD 01200C 89 F SUB 1 F SKIP BACKWARD 01210C 89 GOTO READ " " 01220C 88 SETOF 90 SPACE FILL 01230C 88 SETON 77 " " 01240C 87 GOTO START 01250C 86 GOTO UPDATE UPDATE ÐÐ01260C 85 GOTO READ REPEAT 01270C 96 GOTO ERROR ERROR 01280C*------------------------------------------------------------------ 01290C PROCES TAG 01300C* PROCESS INPUT DATA 01310C EXSR SR103 MOVE DATA 01320C N96 EXSR SR104 EDIT DATA 01330C 96 GOTO ERROR ERROR 01340C GOTO NEXT 01350C*------------------------------------------------------------------ 01360C UPDATE TAG 01370C* UPDATE DATA BASE. 01380C EXSR SR106 UPDATE 01390C 96 GOTO ERROR ERROR 01400C GOTO START 01410C*------------------------------------------------------------------- 01420C JUMP TAG 01430C* SET-UP JUMP TO REQUESTED FIELD 01440C 1 ADD W W 30 01450C W COMP 8 54 01460C 54 Z-ADD318 M 50 96 FLAG ERROR 01470C 54 GOTO ERROR BAD ESC 01480C MOVE ' ' W3A 3 01490C MOVEAA8,W W3A 01500C Z-ADD3 W2N 20 ÐÐ01510C EXIT SUBRAJ R. JUSTIFY 01520C RLABL W2N 01530C RLABL W3A 01540C MOVE W3A F NEW FIELD # 01550C GOTO READ 01560C*-------------------------------------------------------------------- 01570C ERROR TAG 01580C EXSR SR102 VALIDATE FIELD # 01590C EXSR SR89 GET MSG 01600C EXSR SR73 PUT MSG 01610C GOTO START 01620C*------------------------------------------------------------------ 01630C NEWITM TAG 01640C* SET-UP LINK FOR NEW ITEM 01650C MOVEL'Q016GL' PROG 8 01660C GOTO END 01670C*------------------------------------------------------------------- 01680C MENU TAG 01690C* SET-UP LINK TO MENU 01700C MOVEL'QQGL02' PROG 01710C GOTO END 01720C*-------------------------------------------------------------------- 01730C GOODBY TAG 01740C* LINK TO SIGN-OFF 01750C MOVEL'GOODBY' PROG ÐÐ01760C GOTO END 01770C*------------------------------------------------------------------- 01780C END TAG 01790C EXITFCHAIN LINK TO NEXT PROG 01800C RLABL PROG 01810C******************************************************************** 01820CSR SR3 BEGSR 01830C* EDIT INPUT. 01840CSR MOVE TKEY W9A 9 01850CSR EXSR SR80 GET GLMAST 01860CSR 60 Z-ADD302 M 96 FLAG ERROR 01870CSR 60 GOTO END3 01880CSR MOVE GLDESC PADESC 40 01890CSR MOVE GLSC PASC 1 01900CSR END3 ENDSR 01910C***************************************************************** 01920CSR SR70 BEGSR 01930C* CLEAR TERM SCREEN. 01940CSR EXITFQTOPF CLEAR SCREEN 01950CSR ENDSR 01960C********************************************************************** 01970CSR SR71 BEGSR 01980C* PUT HEADINGS TO TERMINAL 01990CSR MOVELTKEY W9A 02000CSR EXSR SR80 GET TOP GLMAST ÐÐ02010CSR EXSR SR204 SET-UP ACTNO 02020CSR SETON 71 02030CSR EXCPT PUT HEADINGS 02040CSR SETOF 71 02050CSR Z-ADD6 COUNT 30 02060CSR ENDSR 02070C********************************************************************* 02080CSR SR72 BEGSR 02090C* PUT DATA TO TERMINAL 02100CSR MOVE CASUB W9A 02110CSR EXSR SR80 GET GLMAST 02120CSR 1 ADD COUNT COUNT 30 02130CSR EXSR SR203 FLAG LEVEL 02140CSR EXSR SR204 BUILD ACCT # 02150CSR SETON 7278 02160CSR EXCPT PUT DATA 02170CSR SETOF 72 02180CSR COUNT COMP 30 54 54 02190CSRN54 GOTO END72 02200CSR EXITFQEPAGE END PAGE MSG 02210CSR EXSR SR75 02220CSRN90 EXSR SR71 PUT HEADING 02230CSR END72 ENDSR 02240C*********************************************************************** 02250CSR SR73 BEGSR ÐÐ02260C* PUT ERROR MESSAGE TO TERMINAL 02270CSR SETON 73 02280CSR EXCPT PUT MSG 02290CSR SETOF 73 02300CSR Z-ADDM LSTERR 50 02310CSR ENDSR 02320C******************************************************************* 02330CSR SR75 BEGSR 02340C* READ FROM TERMINAL 02350CSR SETOF 779096 02360CSR SETOF 939291 02370CSR SETOF 898887 02380CSR SETOF 8685 02390CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 02400CSR MOVE BLK8 W8A 8 BUFFER 02410CSR EXITFQWREED READ FROM TERMINAL 02420CSR RLABL W8A READ BUFFER 02430CSR RLABL BUFLGT READ BUFFER LGTH 02440CSR MOVEAW8A A8 INPUT DATA ARRAY 02450CSR MOVE BLK8 W8A INIT INPUT ARRAY 02460CSR Z-ADD1 W 30 02470CSR '\' LOKUPA8,W 90 FLAG ESC 02480CSRN90 GOTO T75B NOT ESC 02490CSR 1 ADD W W 02500CSR W COMP 8 54 ÐÐ02510CSR 54 GOTO T75A BAD ESC 02520CSR A8,W COMP 'G' 98 GOODBY 02530CSR A8,W COMP 'E' 94 MENU 02540CSR A8,W COMP 'N' 93 NEW ITEM 02550CSR A8,W COMP 'J' 92 JUMP 02560CSR A8,W COMP 'F' 91 SKIP FRWRD 02570CSR A8,W COMP 'B' 89 SKIP BKWRD 02580CSR A8,W COMP 'S' 88 SPACE FILL 02590CSR A8,W COMP 'H' 87 HOME 02600CSR A8,W COMP 'U' 86 UPDATE 02610CSR A8,W COMP 'R' 85 REPEAT 02620CSR 98 02630COR 94 02640COR 93 02650COR 92 02660COR 91 02670COR 89 02680COR 88 02690COR 87 02700COR 86 02710COR 85 GOTO END75 GOOD ESC 02720C*------------------------------------------------------------------ 02730CSR T75A TAG 02740C* FLAG BAD ESC INPUT 02750CSR Z-ADD318 M 96 FLAG ERROR ÐÐ02760CSR GOTO END75 02770C*-------------------------------------------------------------------- 02780CSR T75B TAG 02790C* MOVE DATA 02800CSR Z-ADD1 W 02810CSR ' ' LOKUPA8,W 77 02820CSR 77 MOVEAA8,W W8A INPUT DATA 02830CSR END75 ENDSR 02840C******************************************************************** 02850CSR SR76 BEGSR 02860C* END-ACCOUNT MSG. 02870CSR EXITFQEITEM END ITEM 02880CSR EXSR SR75 READ 02890CSR ENDSR 02900C********************************************************************** 02910CSR SR80 BEGSR 02920C* GET MASTER RECORD 02930CSR SETOF 61 02940CSR W9A CHAINGLMAST 60 GET MASTER 02950CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 02960CSR ENDSR 02970C********************************************************************** 02980CSR SR89 BEGSR 02990C* GET MESSAGE MASTER 03000CSR M CHAINMGFILE 54 ÐÐ03010CSR 54 MOVE BLK35 MGTEXT 03020CSR 54 MOVELM MGTEXT 03030CSR 54 MOVE MES,1 MGTEXT 03040CSR ENDSR 03050C*********************************************************************** 03060CSR SR101 BEGSR 03070C* 1-TIME INITIALIZE 03080CSR MOVE BIT,1 NUL 03090CSR MOVEANUL NUL92 92 03100CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03110CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03120CSR MOVE ' ' BLK8 8 03130C* DEFINE WORK FIELDS,ETC. 03140CSR MOVE ' ' BLK35 35 03150CSR MOVE ' ' BLK9 9 03160CSR MOVE ' ' BLK18 18 03170CSR ENDSR 03180C********************************************************************** 03190CSR SR102 BEGSR 03200C* VALIDATE FIELD NO. 03210CSR F COMP 0 54 03220CSRN54 Z-ADD1 F 03230CSR F COMP FLIMIT 55 03240CSR 55 Z-ADD1 F 03250CSR ENDSR ÐÐ03260C******************************************************************** 03270CSR SR103 BEGSR 03280C* MOVE INPUT DATA 03290CSR EXSR SR201 IDENTIFY-F 03300CSR EXSR SR202 R. JUSTIFY 03310CSR 01 MOVELW8A TPRFX 1 ACCOUNT PREFIX 03320CSR 02 MOVE W8A TPRIM 50 ACCOUNT PRIME 03330CSR 03 MOVE W8A TDASH 30 ACCOUNT DASH 03340CSR 03 MOVELTPRFX TKEY 9 03350CSR 03 MOVELTPRIM W8A 8 03360CSR 03 MOVE TDASH W8A 03370CSR 03 MOVE W8A TKEY 03380CSR MOVE ' ' DUN,F EDIT FLAG 03390CSR ENDSR 03400C******************************************************************** 03410CSR SR104 BEGSR 03420C* EDIT INPUT DATA 03430CSR 03 EXSR SR3 03440CSR 96 MOVE ' ' DUN,F EDIT FLAG 03450CSRN96 MOVE 'X' DUN,F 03460CSR ENDSR 03470C**************************************************************** 03480CSR SR106 BEGSR 03490C* DISPLAY CHART OF ACCOUNTS 03500CSR SETOF 78 ÐÐ03510CSR EXSR SR71 PUT HEADING 03520CSR Z-ADD1 L 30 03530CSR EXSR SR203 FLAG LEVEL 03540CSR EXSR SR204 BUILD ACTNO 03550CSR SETON 74 03560CSR EXCPT PUT LEVEL-1 03570CSR SETOF 74 03580CSR MOVE BLK18 LEV 03590CSR Z-ADD3 L 03600CSR MOVELTKEY LEV,2 03610C*------------------------------------------------------------------- 03620CSR T106A TAG 03630C* GET SAVED LOWER LEVEL SUB-ACCOUNTS, IF ANY. 03640CSR L SUB 1 L 54 INDENT LEVEL 03650CSRN54 GOTO T106R 03660CSR LEV,L COMP BLK18 54 03670CSRN54 GOTO T106A NONE THIS LEVEL 03680CSR MOVELLEV,L W18A 18 03690CSR MOVELLEV,L CURACT 9 MACH ACNT # 03700CSR MOVE BLK18 LEV,L 03710C*------------------------------------------------------------------- 03720CSR T106B TAG 03730CSR W18A SETLLCAMAST 03740C*------------------------------------------------------------------- 03750CSR T106C TAG ÐÐ03760C* READ CHART ACCOUNTS FILE. 03770CSR SETOF 54 03780CSR READ CAMAST 54 03790CSR 54 GOTO T106A END FILE 03800CSR CAPAR COMP CURACT 54 03810CSRN54 GOTO T106A END ASSY 03820CSR CASTAT COMP 'D' 54 03830CSR 54 GOTO T106C DELETED 03840C* DISPLAY LINE ENTRY. 03850CSR EXSR SR72 PUT DATA 03860CSR 90 GOTO END106 ESCAPE 03870C* BRANCH IF NOT PARENT. 03880CSR GLNOSA COMP 0 54 03890CSRN54 GOTO T106C NOT PARENT 03900C*------------------------------------------------------------------- 03910CSR T106D TAG 03920C* SAVE CUR ACCT + 1 AND CHASE NEXT LOWER INDENT. 03930CSR MOVE CASUB W9A 03940CSR MOVE CASUB W3N 30 03950CSR 1 ADD W3N W3N 03960CSR MOVE W3N W9A 03970CSR MOVE W9A LEV,L 03980CSR MOVELCURACT LEV,L SAVE PAR/SUB 03990CSR MOVE CASUB CURACT 04000CSR MOVELCASUB W18A ÐÐ04010CSR MOVE BLK9 W18A 04020CSR 1 ADD L L NEW INDENT LEV 04030CSR GOTO T106B CHASE DOWN 04040C*------------------------------------------------------------------- 04050CSR T106R TAG 04060C* END ACCOUNT MSG. 04070CSR EXSR SR76 END ACCT MSG. 04080CSR END106 ENDSR 04090C************************************************************************ 04100CSR SR201 BEGSR 04110C* IDENTIFY FIELD NO. 04120CSR F COMP 1 01 04130CSR F COMP 2 02 04140CSR F COMP 3 03 04150CSR ENDSR 04160C********************************************************************** 04170CSR SR202 BEGSR 04180C* RIGHT JUSTIFY 04190CSR F LOKUPNUM 54 04200CSRN54 GOTO END202 NOT NUMERIC FIELD 04210CSR Z-ADD8 W2N 20 04220CSR EXIT SUBRAJ R. JUSTIFY 04230CSR RLABL W2N 04240CSR RLABL W8A 04250CSR END202 ENDSR ÐÐ04260C******************************************************************** 04270CSR SR203 BEGSR 04280C* FLAG INDENTURE LEVEL. 04290CSR L COMP 1 2121 04300CSR L COMP 2 22 04310CSR L COMP 3 23 04320CSR L COMP 4 24 04330CSR L COMP 5 25 04340CSR L COMP 6 26 04350CSR L COMP 7 27 04360CSR L COMP 8 28 04370CSR L COMP 9 29 04380CSR L COMP 10 30 04390CSR L COMP 11 31 31 04400CSR 21 Z-ADD1 L 04410CSR ENDSR 04420C******************************************************************** 04430CSR SR204 BEGSR 04440C* BUILD ACTNO FIELD FOR OUTPUT. 04450CSR MOVEAGLPRFX A24 04460CSR GLPRFX COMP ' ' 54 04470CSRN54 MOVEA'_' A24,1 04480CSR MOVE GLPRIM W5A 5 04490CSR MOVEAW5A A24,2 04500CSR MOVE '-' A24,7 ÐÐ04510CSR MOVE GLDASH W3A 3 04520CSR MOVEAW3A A24,8 04530CSR MOVEAA24 ACTNO 10 04540CSR GLCMP SUB GLCMM CURNET 112 04550CSR ENDSR 04560O******************************************************************** 04570OTERM132 E 71 04580O* PUT HEADING - PARENT ACCOUNT. 04590O 62 'INDENTED CHART OF' 04600O 71 'ACCOUNTS' 04610O*------------------------------------------------------------------- 04620O E 71 04630O* PUT HEADING - SUB-ACCOUNT. 04640O 19 'ACCOUNT NO.' 04650O 91 'TYPE' 04660O 97 'OPER' 04670O 114 'EFFECTIVITY' 04680O 131 'CUR-MO.' 04690O*------------------------------------------------------------------- 04700O E 71 04710O* 04720O 1 '1' 04730O 4 '2' 04740O 7 '3' 04750O 10 '4' ÐÐ04760O 13 '5' 04770O 16 '6' 04780O 19 '7' 04790O 22 '8' 04800O 25 '9' 04810O 29 '10' 04820O 32 '11' 04830O 60 '<--------------' 04840O 71 'DESCRIPTION' 04850O 85 '------------->' 04860O 91 'CODE' 04870O 97 'CODE' 04880O 107 'START' 04890O 115 'STOP' 04900O 131 'NET-BAL' 04910O*------------------------------------------------------------------- 04920O E 71 04930O DASH 43 04940O*------------------------------------------------------------------- 04950O E 72 04960O* SUB-ACCOUNT DATA. 04970O DASH 43 04980O 21 ACTNO 13 04990O 22 ACTNO 16 05000O 23 ACTNO 19 ÐÐ05010O 24 ACTNO 22 05020O 25 ACTNO 25 05030O 26 ACTNO 28 05040O 27 ACTNO 31 05050O 28 ACTNO 34 05060O 29 ACTNO 37 05070O 30 ACTNO 40 05080O 31 ACTNO 43 05090O GLDESC 85 05100O GLSC 90 05110O CAOPER 95 05120O CURNETK 132 05130O CASDAT 108 ' - - ' 05140O CAEDAT 118 ' - - ' 05150O*------------------------------------------------------------------- 05160O E 74 05170O OR 71 78 05180O DASH 43 05190O ACTNO 13 05200O 78 71 21 'CONT''D' 05210O PADESC 85 05220O PASC 89 05230O CURNETK 132 05240O*------------------------------------------------------------------- 05250O E 73 ÐÐ05260O* PUT MESSAGE. 05270O NUL92 132 05280O 96 5 '*****' 05290O N96 5 ' ' 05300O MGTEXT 40 05310O BIT,8 132 ** NUL ARRAY 005320 005330** A8 ARRAY 05340 05350** NUM ARRAY 005360002 PAR PRIME 005370003 PAR DASH 005380** DUN ARRAY 005390 005400** MES ARRAY 005410---MESSAGE NOT ON FILE--- 005420** LEV ARRAY 05430 05440** DASH ARRAY 05450. . . . . . . . . . . . . . . 005460** A24 ARRAY 005470 005480/* 005490_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(K, K X009PC P120282120282(èÈÐ00010H Q009PC00020F* MOVE OLD STYLE UNIT COST TO VEND COST - CONVERSION ONLY 00030F* REVISED 3/31/81 4:30 PM. 00040FPMMST2 UP F 674 12AI 1 DISK 00050E******************************************************************** 00060E PM$ 7 9 3 00070I******************************************************************** 00080IPMMST2 PM 01 00090I P 13 140PMNOBM 00100I 94 95 PMSC 00110I P 245 279 PM$ 00120I P 489 4933PMOSUC 00130I 674 674 PMSTAT 00140C******************************************************************** 00150C PMSTAT COMP 'D' 54 00160C 54 SETOF 01 00170C 54 GOTO END 00180C MOVELPMSC W1A 1 00190C W1A COMP 'P' 54 00200C 54 Z-ADDPMOSUC PM$,5 00210C*------------------------------------------------------------------- 00220C END TAG 00230O******************************************************************** 00240OPMMST2 D 01 00250O PMNOBM 14P ÐÐ00260O PM$ 279P 00270O PMOSUC 493P /* 000280_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(lM lX113EM P999999120282(èÈÐ00010H Q113EM00020F* EMPLOYEE MASTER UPDATE - REHIRE. (X113EM) 00030F* REVISED 10-15-82 3:25 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FEMMAST UC F 1536R 5AI 1 DISK 00090FWCMAST IC F 960R 8AI 1 DISK 00100FEFMAST IC F 90R28AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A40 40 40 1 A INPUT DATA ARRAY 00150E LIN 1 36 3 0 COL 3 0 X-Y POSITIONS 00160E A39 39 39 1 MGTEXT ARRAY 00170E NUM 1 23 3 0 NUMERIC FIELD NO.'S 00180E DUN 1 36 1 A EDIT CMPLT FLAG 00190E MES 1 1 30 00200E LNK 1 7 6 A 00210E DOTS 17 17 2 00220E EJN 1 5 9 NAMES FOR EMJ AR 00230E TABPUM 1 6 1 TABPUN 13 00240E ENJ 1 10 9 JOB STATUS NAMES 00250E CAL 1 12 2 0 NO. OF DAYS PER MO ÐÐ00260E BIT 33 1 00270E PAR 25 1 00280E TST 25 1 00290E CALL 7 6 CALL STACK 00300E EMS 2 35 STREET ADDRESS 00310E EME 2 25 NOTIFY EMERGENCY 00320E EEO 8 1 EEO CODE 00330E EMJ 5 1 JOB STATUS CODES 00340E HPD 7 3 1A HOURS PER DAY 00350E STD 7 4 0 START TIMES 00360E EMC 5 5 0 PTR00370E PTH 7 5 1 PAYROLL HRS YTD 00380E PTE 7 9 2 PAYROLL EARNED $ YTD 00390E PTF 6 7 2 FED TAX $ TOTALS 00400E PTS 6 7 2 STATE TAX $ TOTALS 00410E PRT 20 2 DEDUCTION TYPE 00420E PRB 20 6 0 DEDUCTION BEGIN DATE 00430E PRS 20 6 0 DEDUCTION STOP DATE 00440E PRC 20 1 DEDUCTION AMOUNT CODE 00450E PRA 20 7 2 DEDUCTION AMOUNT $ 00460E PRY 20 7 2 DEDUCTION AMOUNT YTD 00470E PRN 20 14 DEDUCTION ACCOUNT # 00480I******************************************************************* 00490IBITPAR BT 00500I 1 33 BIT ÐÐ00510I 34 58 PAR 00520I 59 83 TST 00530I******************************************************************* 00540IMGFILE MG 00550I* MESSAGE FILE. 00560I 1 35 MGTEXT 00570I****************************************************************** 00580ICRTFILE CR 00590I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00600I* EMPLOYEE # 5N 00610I 1 50CREMPL 00620I* TERMINAL USER CODE 00630I 6 13 CRUSER 00640I* DEPT # 5N 00650I 14 180CRDEPT 00660I* JOB NAME 8A (JOB LOADED BY MENU) 00670I* 19 26 CRJOB 00680I* SHUTDOWN FLAG 1A 00690I* BLANK = NO SHUTDOWN 00700I 27 27 CRSHUT 00710I* TIME STARTED 6N 00720I 28 330CRTIME 00730I* DATE STARTED 4N 00740I 34 370CRDATE 00750I* CALL STACK 7 X 6A ÐÐ00760I 38 79 CALL 00770I******************************************************************** 00780IEMMAST EM 00790I* EMPLOYEE MASTER 00800I* CLOCK # 5N 00810I 1 50EMCLOK 00820I*-------PERSONAL DATA------------------------------------------------ 00830I* NAME 00840I* 1ST 25A 00850I 7 31 EMFNAM 00860I* MIDDLE 25A 00870I 32 56 EMMNAM 00880I* LAST 30A 00890I 57 86 EMLNAM 00900I* ADDRESS 00910I* STREET 35A X 2 00920I 87 156 EMS 00930I* CITY 25A 00940I 157 181 EMCITY 00950I* STATE 2A 00960I 182 183 EMSTCD 00970I* ZIP 9P 00980I P 184 1880EMZIP 00990I* TELEPHONE 15A 01000I 189 203 EMPHON ÐÐ01010I* NOTIFY IN EMERGENCY 25A X 2 01020I 204 253 EME 01030I* EEO CODE 1A X 8 01040I 254 261 EEO 01050I* BIRTH DATE 6N (YMD) 01060I 262 2670EMBIRD 01070I* EDUCATION 30A 01080I 268 297 EMEDUC 01090I* SPOUSE NAME 30A 01100I 298 327 EMSNAM 01110I* SPOUSE BIRTH DATE 6N (YMD) 01120I 328 3330EMSBIR 01130I*-------JOB STATUS---------------------------------------------------- 01140I* FILLER 2A 334 335 FFFFFF 01150I* 01160I* DEPT 5P 01170I P 336 3380EMDEPT 01180I* WORK CENTER 3P 01190I P 339 3400EMWC 01200I* JOB NAME 28A 01210I 341 368 EMJOB 01220I* JOB STATUS 1A X 5 01230I* 1 = ADMIN(A) OR FACTORY(F) 01240I* 2 = PERMANENT(P) OR TEMPORARY(T) 01250I* 3 = FULL TIME(F) OR PART TIME(P) ÐÐ01260I* 4 = HOURLY(H) OR SALARY(S) 01270I* 5 = DIRECT(D) OR INDIRECT(I) 01280I 370 374 EMJ 01290I* PAY RATE 9.3P 01300I P 375 3793EMRATE 01310I* PAY UNIT 1A 01320I* H = HOURLY 01330I* D = DAILY 01340I* W = WEEKLY 01350I* M = MONTHLY 01360I* S = SEMI-MONTHLY 01370I* A = ANNUALLY (YR) 01380I 380 380 EMPUM 01390I* PAY FREQUENCY 1A 01400I* W = WEEKLY 01410I* S = SEMI-MONTHLY 01420I* M = MONTHLY 01430I 381 381 EMPFRQ 01440I* HOLD PAYCHECK CODE 1A 01450I 382 382 EMHOLD 01460I* WORK SHIFT DATA 01470I* HOURS PER DAY 3.1P X 7 01480I P 383 396 HPD 01490I* START TIMES 4B X 7 01500I B 397 410 STD ÐÐ01510I* HOURS PER WEEK 5.1P 01520I P 411 4131EMHPW 01530I* CURRENT PERIOD PAYROLL TOTALS 01540I* HRS WORKED 5.1P 01550I P 414 4161EMCPHW 01560I* O.T. HRS WORKED 5.1P 01570I P 417 4191EMCPOW 01580I* O.T. AUTHORIZED 5.1P 01590I P 420 4221EMCPOA 01600I* REVIEW DATA 01610I* LAST REVIEW DATE 6N 01620I 458 4630EMLRD 01630I* LAST REVIEW TYPE 1A 01640I 464 464 EMLRT 01650I* LAST PAY INCREASE DATE 6N 01660I 465 4700EMLRP 01670I* LAST PAY INCREASE AMOUNT 5.2P 01680I P 471 4732EMLPA 01690I* NEXT SCHED REVIEW DATA 6N 01700I 476 4810EMNSRD 01710I* NEXT SCHED REVIEW COMMENT 15A 01720I 482 496 EMNSRR 01730I* REVIEW FREQUENCY 1N (MOS) 01740I 497 4970EMRFRQ 01750I* DATE HIRED 6N ÐÐ01760I 498 5030EMHIRD 01770I* ADDITIONAL SENIORITY ALLOWED 01780I* YEARS 2N 01790I 504 5050EMASYR 01800I* MONTHS 2N 01810I 506 5070EMASMO 01820I* DAYS 2N 01830I 508 5090EMASDY 01840I* TERMINATION DATA 01850I* DATE 6N 01860I 510 5150EMDATT 01870I* REASON CODE 2A 01880I 516 517 EMTREA 01890I* COMMENTS PRTS 5P X 5 01900I P 518 532 EMC 01910I* REHIRE ELIGIBILITY CODE 1A 01920I 533 533 EMREH 01930I*-------VACATION---------------------------------------------------- 01940I* CLASS CODE 1A 01950I 534 534 EMVCC 01960I* EARNED HOURS 9.6P 01970I P 535 5396EMVEH 01980I* HOURS TAKEN 5.1P 01990I P 540 5421EMVHT 02000I* LAST DATE PAID IN LIEU OF 6N ÐÐ02010I 543 5480EMVLDP 02020I* SCHEDULED LEAVE DATE 6N 02030I 549 5540EMVSLD 02040I* ACTUAL LEAVE DATE 6N 02050I 555 5600EMVALD 02060I* SCHEDULED RETURN DATE 6N 02070I 561 5660EMVSRD 02080I* ACTUAL RETURN DATE 6N 02090I 567 5720EMVARD 02100I*-------SICK LEAVE-------------------------------------------------- 02110I* EARNED HOURS 9.6P 02120I P 573 5776EMSLEH 02130I* HOURS TAKEN 5.1P 02140I P 578 5801EMSLHT 02150I* LAST DATE PAID IN LIEU OF 6N 02160I 581 5860EMSLDP 02170I* SCHEDULED LEAVE DATE 6N 02180I 587 5920EMSLSL 02190I* ACTUAL LEAVE DATE 6N 02200I 593 5980EMSLAL 02210I* SCHEDULED RETURN DATE 6N 02220I 599 6040EMSLSR 02230I* ACTUAL RETURN DATE 6N 02240I 605 6100EMSLAR 02250I*-------FEDERAL TAX CODES-------------------------------------------- ÐÐ02260I* MARITAL STATUS 1A 02270I* M = MARRIED 02280I* S = SINGLE 02290I* H = HEAD OF HOUSEHOLD 02300I* X = EXEMPT 02310I 611 611 EMFTMS 02320I* NUMBER OF EXEMPTIONS 2N 02330I 612 6130EMFTNE 02340I* EXTRA EXEMPTIONS 2N 02350I 614 6150EMFXEX 02360I* XTRA WITHHOLDING CODE 1A (%,$) 02370I 616 616 EMFTXC 02380I* XTRA WITHHOLDING AMOUNT 4N 02390I 617 6200EMFTXA 02400I* SOCIAL SECURITY NO. 14A 02410I 621 634 EMSS 02420I* COMPREHENSIVE INSURANCE CLASS 1A 02430I 635 635 EMCICA 02440I* EIC CLAIM (1,2) 1N 02450I 636 6360EMFEIC 02460I*-------STATE TAX CODES------------------------------------------- 02470I* MARITAL STATUS 1A 02480I* M = MARRIED 02490I* S = SINGLE 02500I* H = HEAD OF HOUSEHOLD ÐÐ02510I* X = EXEMPT 02520I 637 637 EMSTMS 02530I* NUMBER OF EXEMPTIONS 2N 02540I 638 6390EMSTNE 02550I* EXTRA EXEMPTIONS 2N 02560I 640 6410EMSXEX 02570I* XTRA WITHHOLDING CODE 1A 02580I 642 642 EMSTXC 02590I* XTRA WITHHOLDING AMOUNT 4N 02600I 643 6460EMSTXA 02610I* EICA CLAIM 1N 02620I 647 6470EMSEIC 02630I*-------PAYROLL TOTALS YEAR TO DATE ------------------------------- 02640I* HOURS ARRAY 5.1P X 7 02650I* 1 = REGULAR 02660I* 2 = PREMIUM 02670I* 3 = VACATION 02680I* 4 = SICK LEAVE 02690I* 5 = ABSENT 02700I* 6 = OTHER 02710I* 7 = NOT USED 02720I P 648 668 PTH 02730I* EARNED DOLLARS 9.2P X 7 02740I* 1 = REGULAR 02750I* 2 = PREMIUM ÐÐ02760I* 3 = VACATION 02770I* 4 = SICK LEAVE 02780I* 5 = BONUS 02790I* 6 = OTHER 02800I* 7 = NOT USED 02810I P 669 703 PTE 02820I* DEDUCTION TOTALS 02830I* FEDERAL TAX 7.2P X 6 02840I* 1 = WITHHOLDING 02850I* 2 = XTRA WITHHOLDING 02860I* 3 = REBATED 02870I* 4 = FICA 02880I* 5 = EIC 02890I* 6 = NOT USED 02900I P 704 727 PTF 02910I* STATE TAX 7.2P X 6 02920I* 1 = WITHHOLDING 02930I* 2 = XTRA WITHHOLDIG 02940I* 3 = REBATED 02950I* 4 = S.D.I. 02960I* 5 = EIC 02970I* 6 = NOT USED 02980I P 728 751 PTS 02990I*-------PAYROLL DEDUCTIONS------------------------------------------ 03000I* ÐÐ03010I* TYPE CODE 2A X 20 03020I 752 791 PRT 03030I* START DATE 6N X 20 03040I 792 911 PRB 03050I* STOP DATE 6N X 20 03060I 9121031 PRS 03070I* AMOUNT CODE (%,$) 1A X 20 03080I 10321051 PRC 03090I* AMOUNT 7.2P X 20 03100I P10521131 PRA 03110I* YTD $ TOTAL 7.2P X 20 03120I P11321211 PRY 03130I* ACCOUNT NO. 14A X 20 03140I 12121491 PRN 03150I*-------LEAVE OF ABSENCE-------------------------------------------- 03160I* LEAVE DATE 6N 03170I 149214970EMLOAL 03180I* RETURN DATE 6N 03190I 149815030EMLOAR 03200I* DAYS TAKEN 3P 03210I P150415050EMLOAT 03220I* PAYROLL FLAG 1A 03230I 15351535 EMFLAG 03240I* RECORD STATUS 1A 03250I 15361536 EMSTAT ÐÐ03260I******************************************************************** 03270IWCMAST WC 03280I 9 37 WCNAME 03290I 960 960 WCSTAT 03300I******************************************************************* 03310IEFMAST EF 03320I* JOB NAME FILE 03330I* JOB CODE 8A 03340I* 1 8 EFCODE 03350I* JOB NAME 20A 03360I 9 28 EFNAME 03370I* RECORD STATUS 1A 03380I 90 90 EFSTAT 03390C******************************************************************** 03400C* INITIALIZE 03410C EXSR SR101 1-TIME INIT 03420C MOVE ' ' BLK6 6 STUPIDITY 03430C*------------------------------------------------------------------ 03440C START TAG 03450C* SET-UP 1ST FIELD NO. 03460C EXSR SR66 INIT A39 03470C MOVE ' ' DUN INIT EDIT ARRAY 03480C Z-ADD1 F 30 FIELD # 03490C EXSR SR205 INIT MAST 03500C EXSR SR206 INIT INPUT ÐÐ03510C EXSR SR70 NEW PAGE 03520C GOTO READ 03530C*------------------------------------------------------------------ 03540C NEXT TAG 03550C EXSR SR66 INIT A39 03560C 1 ADD F F FIELD # 03570C*----------------------------------------------------------------- 03580C READ TAG 03590C* READ DATA FROM TERMINAL. 03600C SETOF 909677 03610C SETOF 95 03620C EXSR SR102 VALIDATE FIELD # 03630C 55 GOTO UPDATE DONE 03640C EXSR SR201 IDENTIFY-F 03650C 01 GOTO NEXT 03660C 18N78 03670COR 25N78 03680COR 32 EXSR SR66 INIT A39 03690C SETOF 78 03700C SETON 69 03710C EXSR SR72 PROMPT 03720C SETOF 69 03730C EXSR SR75 READ TERMINAL 03740C 90N88 EXSR SR72 DISPLAY INPUT DATA 03750C 93 GOTO START NEW ITEM ÐÐ03760C 92 GOTO JUMP FIELD JUMP REQST 03770C 89 F SUB 1 F SKIP BACKWARD 03780C 89 EXSR SR201 03790C 89 32 Z-ADD31 F 03800C 89 GOTO READ " " 03810C 88 SETOF 90 SPACE FILL 03820C 88 SETON 77 " " 03830C 86 GOTO UPDATE UPDATE 03840C 85 GOTO READ REPEAT 03850C 96 GOTO ERROR ERROR 03860C 77 EXSR SR103 MOVE DATA 03870C*------------------------------------------------------------------- 03880C EDIT TAG 03890C EXSR SR104 EDIT DATA 03900C N95N96 EXSR SR72 REWRITE DATA 03910C N95N96 GOTO NEXT 03920C GOTO ERROR ERROR 03930C* 03940C*------------------------------------------------------------------ 03950C UPDATE TAG 03960C* UPDATE DATA BASE. 03970C EXSR SR105 FINAL EDIT 03980C 96 GOTO ERROR ERROR 03990C EXSR SR106 UPDATE 04000C 96 GOTO ERROR ERROR ÐÐ04010C 1 ADD COUNT COUNT 30 04020C GOTO START 04030C*------------------------------------------------------------------- 04040C JUMP TAG 04050C* SET-UP JUMP TO REQUESTED FIELD 04060C 1 ADD W W 30 04070C W COMP 40 54 04080C 54 Z-ADD318 M 50 96 FLAG ERROR 04090C 54 GOTO ERROR BAD ESC 04100C MOVE ' ' W3A 3 04110C MOVEAA40,W W3A 04120C Z-ADD3 W2N 20 04130C EXIT SUBRAJ R. JUSTIFY 04140C RLABL W2N 04150C RLABL W3A 04160C MOVE W3A F NEW FIELD # 04170C EXSR SR201 04180C 32 Z-ADD31 F 04190C GOTO READ 04200C*-------------------------------------------------------------------- 04210C ERROR TAG 04220C N95N96 GOTO READ 04230C SETON 78 04240C EXSR SR89 GET MESSAGE 04250C 95 EXSR SR72 DISPLAY DATA/MSG ÐÐ04260C 95 GOTO NEXT 04270C GOTO READ 04280C* 04290C* 04300C*-------------------------------------------------------------------- 04310C NEWITM TAG 04320C MOVEL'Q113EM' PROG 8 04330C GOTO END 04340C*------------------------------------------------------------------- 04350C MENU TAG 04360C* SET-UP LINK TO MENU 04370C EXSR SR96 GET CRTFILE 04380C Z-ADD1 W 04390C BLK6 LOKUPLNK,W 54 04400C 54 MOVELLNK,W PROG 8 04410C 54 MOVE BLK6 LNK,W 04420C N54 MOVEL'CONTU 'PROG 04430C EXSR SR97 UPDATE CRTFILE 04440C EXSR SR98 >>>>>>>>>>>>> 04450C*-------------------------------------------------------------------- 04460C GOODBY TAG 04470C* LINK TO SIGN-OFF 04480C MOVEL'GOODBY' PROG 04490C*---------------------------------------------------------------- 04500C END TAG ÐÐ04510C EXSR SR96 GET CRTFILE 04520C EXSR SR97 REWRITE CRTFILE 04530C EXSR SR98 >>>>>>>>>>> 04540C*------------------------------------------------------------------- 04550C ENDJOB TAG 04560C MOVEL'ENDJOB' PROG 04570C EXSR SR98 >>>>>>>>>>>>>>>> 04580C******************************************************************** 04590CSR SR2 BEGSR 04600C* EDIT CLOCK #. 04610CSR SETOF 95 04620CSR SETON 68 04630CSR TCLOCK COMP 0 54 04640CSRN54 Z-ADD400 M 96 FLAG ERROR 04650CSRN54 GOTO END2 04660CSR EXSR SR80 GET EMMAST 04670CSRN40N41 GOTO T2C GOT IT 04680CSR EXSR SR205 INIT EMMAST 04690CSR Z-ADD5 M 96 FLAG ERROR 04700CSR GOTO END2 04710C*------------------------------------------------------------------- 04720CSR T2C TAG 04730C* IS ON FILE. 04740CSR EMDATT COMP 0 54 04750CSRN54 Z-ADD700 M 96 FLAG ERROR(NOT TERM) ÐÐ04760CSRN54 GOTO END2 04770CSR Z-ADDEMDATT TERDAT 60 04780CSR EXSR SR212 CALC LGTH EMPLOY 04790CSR EXSR SR211 INIT TERMIN FIELDS 04800CSR EXSR SR66 INIT A39 04810CSR Z-ADDF SAVEF 30 SAVE FIELD NO. 04820CSR EXSR SR7 EDIT WORK CENTER 04830CSRN96 EXSR SR9 EDIT ADMIN/FACTORY 04840CSRN96 EXSR SR10 EDIT PERM/TEMP 04850CSRN96 EXSR SR11 EDIT FULL/PART TIME 04860CSRN96 EXSR SR12 EDIT HOURLY/SALARY 04870CSRN96 EXSR SR13 EDIT DIRECT/INDIRECT 04880CSRN96 EXSR SR14 04890CSRN96 EXSR SR15 04900CSRN96 EXSR SR16 04910CSR SETON 42 04920CSR EXSR SR71 PUT SCREEN 04930CSR SETOF 42 04940CSRN95N96 GOTO END2 NO ERRS/WARNINGS 04950CSR EXSR SR201 CLASSIFY SUBST F 04960CSR EXSR SR89 GET MESSAGE 04970CSR EXSR SR72 PUT ERROR MESSAGE 04980CSR Z-ADDSAVEF F RESTORE F 04990CSR EXSR SR201 CLASSIFY F 05000CSR SETOF 9596 ÐÐ05010C*------------------------------------------------------------------- 05020CSR END2 TAG 05030CSR SETOF 68 05040CSR ENDSR 05050C******************************************************************** 05060CSR SR3 BEGSR 05070C* EDIT 1ST NAME. 05080CSR EMFNAM COMP BLK25 54 05090CSRN54 Z-ADD371 M FLAG WARNING 05100CSRN54 EXSR SR89 GET MSG 05110CSR ENDSR 05120C******************************************************************** 05130CSR SR5 BEGSR 05140C* EDIT LAST NAME. 05150CSR EMLNAM COMP BLK30 54 05160CSRN54 Z-ADD224 M 96 FLAG ERROR 05170CSR ENDSR 05180C******************************************************************** 05190CSR SR6 BEGSR 05200C* EDIT DEPT. 05210CSR EMDEPT COMP 0 54 05220CSRN54 Z-ADD552 M 96 FLAG ERROR 05230CSR ENDSR 05240C******************************************************************** 05250CSR SR7 BEGSR ÐÐ05260C* EDIT WORK CENTER. 05270CSR SETOF 55 05280CSR 96 SETON 55 05290CSR MOVE BLK35 WCNAME 05300CSR MOVELEMDEPT W8A 8 05310CSR MOVE EMWC W8A 05320CSR W8A CHAINWCMAST 60 05330CSRN60 WCSTAT COMP 'D' 60 05340CSR 60N68 Z-ADD304 M 96 FLAG ERROR 05350CSR 96N55N68 Z-ADD7 F 05360CSR ENDSR 05370C******************************************************************* 05380CSR SR8 BEGSR 05390C* EDIT JOB NAME 05400CSR EMJOB COMP BLK28 54 05410CSRN54 GOTO END8 05420CSR EMJOB CHAINEFMAST 54 05430CSRN54 EFSTAT COMP 'D' 54 05440CSR 54N68 Z-ADD384 M FLAG WARNING 05450CSR 54N68 EXSR SR89 05460CSR END8 ENDSR 05470C******************************************************************* 05480CSR SR9 BEGSR 05490C* EDIT ADMIN/FACTORY. 05500CSR EXSR SR51 ÐÐ05510CSRN55N56 Z-ADD615 M 96 FLAG ERROR 05520CSRN55N56 Z-ADD9 F 05530CSR ENDSR 05540C******************************************************************** 05550CSR SR10 BEGSR 05560C* EDIT PERM/TEMP. 05570CSR SETOF 52 05580CSR EXSR SR52 05590CSRN55N56 SETON 52 05600CSR 52 MOVE 'P' EMJ,2 DEFAULT 05610CSR 52 Z-ADD693 M 95 FLAG WARNING 05620CSR 52 Z-ADD10 F 05630CSR 52 EXSR SR52 05640CSR ENDSR 05650C******************************************************************** 05660CSR SR11 BEGSR 05670C* EDIT FULL/PART TIME. 05680CSR SETOF 52 05690CSR EXSR SR53 05700CSRN55N56 SETON 52 05710CSR 52 MOVE 'F' EMJ,3 DEFAULT 05720CSR 52 Z-ADD693 M 95 FLAG WARNING 05730CSR 52 Z-ADD11 F 05740CSR 52 EXSR SR53 05750CSR ENDSR ÐÐ05760C******************************************************************** 05770CSR SR12 BEGSR 05780C* EDIT HOURLY/SALARY. 05790CSR SETOF 52 05800CSR EXSR SR54 05810CSRN55N56 SETON 52 05820CSR 52 MOVE 'H' EMJ,4 DEFAULT 05830CSR 52 Z-ADD693 M 95 FLAG WARNING 05840CSR 52 Z-ADD12 F 05850CSR 52 EXSR SR54 05860CSR ENDSR 05870C******************************************************************** 05880CSR SR13 BEGSR 05890C* EDIT DIRECT/INDIRECT. 05900CSR SETOF 52 05910CSR EXSR SR55 05920CSRN55N56 SETON 52 05930CSR 52 EMJ,1 COMP 'A' 54 05940CSR 52 54 MOVE 'I' EMJ,5 INDIRECT 05950CSR 52N54 MOVE 'D' EMJ,5 DIRECT 05960CSR 52 Z-ADD693 M 95 FLAG DEFAULT 05970CSR 52 Z-ADD13 F 05980CSR 52 EXSR SR55 05990CSR ENDSR 06000C****************************************************************** ÐÐ06010CSR SR14 BEGSR 06020C* EDIT PAY RATE 06030CSR EMRATE COMP 0 54 06040CSR 54 EMRATE COMP 250000 54 LT 06050CSRN54N68 Z-ADD387 M 96 FLAG ERROR 06060CSRN54N68 Z-ADD14 F 06070CSR ENDSR 06080C***************************************************************** 06090CSR SR15 BEGSR 06100C* EDIT PAY UNIT 06110CSR MOVE BLK20 NAMEMP 13 06120CSR EMPUM LOKUPTABPUM TABPUN 54 06130CSR 54 MOVE TABPUN NAMEMP 06140CSRN54N68 Z-ADD26 M 96 FLAG ERROR 06150CSRN54N68 Z-ADD15 F 06160CSR ENDSR 06170C************************************************************* 06180CSR SR16 BEGSR 06190C* EDIT PAY FREQUENCY CODE 06200CSR MOVE BLK20 NAMEPF 9 06210CSR EMPFRQ COMP 'W' 54 06220CSR EMPFRQ COMP 'S' 55 06230CSR EMPFRQ COMP 'M' 56 06240CSRN68 06250CANN54N55N56 Z-ADD615 M 96 FLAG ERROR ÐÐ06260CSRN68 55N56 06270CANN54N55N56 Z-ADD16 F 06280CSR 54 MOVEL'WEEKLY' NAMEPF 06290CSR 55 MOVEL'SEMI-MON'NAMEPF 06300CSR 56 MOVEL'MONTHLY' NAMEPF 06310CSR ENDSR 06320C******************************************************************** 06330CSR SR18 BEGSR 06340C* EDIT HRS PER DAY 06350CSR EXSR SR208 EDIT HRS PER DAY 06360CSR END18 ENDSR 06370C******************************************************************** 06380CSR SR25 BEGSR 06390C* EDIT START TIME. 06400CSR EXSR SR209 EDIT START TIME 06410CSR END25 ENDSR 06420C************************************************************** 06430CSR SR32 BEGSR 06440C* EDIT HRS PER WEEK 06450CSR XFOOTHPD EMHPW 54 COMPUTE HRS PER WEEK 06460CSRN54 Z-ADD694 M 96 FLAG ERROR 06470CSRN96 EMHPW COMP 40 54 06480CSRN96 54 Z-ADD695 M FLAG WARNING 06490CSRN96 54 EXSR SR89 06500C*---------------------------------------------------------------- ÐÐ06510CSR END32 TAG 06520CSR 96 Z-ADD18 F 06530CSR 96 EXSR SR201 REIDENTIFY F 06540CSR ENDSR 06550C********************************************************************** 06560CSR SR33 BEGSR 06570C* EDIT START DATE 06580CSR EMHIRD COMP 0 54 06590CSRN54 Z-ADD380 M 96 FLAG ERROR 06600CSRN54 GOTO END33 06610CSR MOVELEMHIRD W2N 06620CSR W2N COMP 12 54 06630CSRN54 MOVELEMHIRD W4N 40 06640CSRN54 MOVE EMHIRD W2N 06650CSRN54 MOVELW2N EMHIRD 06660CSRN54 MOVE W4N EMHIRD 06670CSR MOVELEMHIRD YR 20 06680CSR MOVE EMHIRD W4N 06690CSR MOVELW4N MO 20 06700CSR MOVE W4N DAY 20 06710CSR MOVE UDATE W2N 06720CSR YR COMP 60 54 06730CSR 54 YR COMP W2N 5454 06740CSR 54 MO COMP 0 54 06750CSR 54 MO COMP 12 5454 ÐÐ06760CSR 54 DAY COMP 0 54 06770CSR 54 DAY COMP 31 5454 06780CSRN54 Z-ADD380 M 96 FLAG ERROR 06790CSRN54 GOTO END33 06800CSR EMDATT COMP 0 54 06810CSRN54 GOTO END33 06820CSR EMDATT COMP EMHIRD 54 54 06830CSRN54 Z-ADD380 M 96 FLAG ERROR 06840CSR END33 ENDSR 06850C******************************************************************** 06860CSR SR50 BEGSR 06870C* GENERAL EDIT - JOB STATUS CODES. 06880CSR EXSR SR51 06890CSR EXSR SR52 06900CSR EXSR SR53 06910CSR EXSR SR54 06920CSR EXSR SR55 06930CSR ENDSR 06940C******************************************************************** 06950CSR SR51 BEGSR 06960C* ADMIN/FACTORY. 06970CSR EMJ,1 COMP 'A' 55 06980CSR EMJ,1 COMP 'F' 56 06990CSR MOVE BLK35 EJN,1 07000CSR 55 MOVELENJ,1 EJN,1 ADMIN ÐÐ07010CSR 56 MOVELENJ,2 EJN,1 FACTORY 07020CSR ENDSR 07030C******************************************************************** 07040CSR SR52 BEGSR 07050CSR EMJ,2 COMP 'P' 55 07060CSR EMJ,2 COMP 'T' 56 07070CSR MOVE BLK35 EJN,2 07080CSR 55 MOVELENJ,3 EJN,2 PERMANENT 07090CSR 56 MOVELENJ,4 EJN,2 TEMPORARY 07100CSR ENDSR 07110C******************************************************************** 07120CSR SR53 BEGSR 07130C* FULL/PART TIME. 07140CSR EMJ,3 COMP 'F' 55 07150CSR EMJ,3 COMP 'P' 56 07160CSR MOVE BLK35 EJN,3 07170CSR 55 MOVELENJ,5 EJN,3 FULL TIME 07180CSR 56 MOVELENJ,6 EJN,3 PART TIME 07190CSR ENDSR 07200C************************************************************************ 07210CSR SR54 BEGSR 07220CSR EMJ,4 COMP 'S' 55 07230CSR EMJ,4 COMP 'H' 56 07240CSR MOVE BLK35 EJN,4 SALARY 07250CSR 55 MOVELENJ,7 EJN,4 HOURLY ÐÐ07260CSR 56 MOVELENJ,8 EJN,4 07270CSR ENDSR 07280C************************************************************************ 07290CSR SR55 BEGSR 07300CSR EMJ,5 COMP 'I' 55 07310CSR EMJ,5 COMP 'D' 56 07320CSR MOVE BLK35 EJN,5 07330CSR 55 MOVELENJ,9 EJN,5 INDIRECT 07340CSR 56 MOVELENJ,10 EJN,5 DIRECT 07350CSR ENDSR 07360C************************************************************************ 07370CSR SR66 BEGSR 07380CSR MOVEABLK35 A39,3 INIT A39 07390CSR ENDSR 07400C******************************************************************** 07410CSR SR67 BEGSR 07420CSR EXITFZCR 07430CSR ENDSR 07440C***************************************************************** 07450CSR SR68 BEGSR 07460CSR EXITFZLF LINE FEED 07470CSR ENDSR 07480C**************************************************************** 07490CSR SR69 BEGSR 07500CSR 50 EXITFZPUTXY MOVE CURSOR ÐÐ07510CSR RLABL RPGLIN 07520CSR RLABL RPGCOL 07530CSRN50 EXITFZMOVXY MOVE CURSOR 07540CSR RLABL RPGLIN 07550CSR RLABL RPGCOL 07560CSR ENDSR 07570C***************************************************************** 07580CSR SR70 BEGSR 07590C* CLEAR TERM SCREEN. 07600CSR TERDAT COMP 0 43 07610CSR 50 EXITFZISTAT INIT STATUS LINE 07620CSR 50 EXITFZESCH CLEAR SCREEN 07630CSRN50 EXITFZCPAGE CLEAR SCREEN 07640CSRN50 MOVEL'091' RPGLIN 07650CSRN50 MOVEL'001' RPGCOL 07660CSRN50 EXSR SR69 MOVE CURSOR 07670CSR Z-ADD91 COUNT 30 07680CSR SETON 70 07690CSRN51 EXCPT PUT HDG 1ST LINE 07700CSR SETOF 7043 07710CSR ENDSR 07720C********************************************************************** 07730CSR SR71 BEGSR 07740C* PUT HEADINGS TO TERMINAL 07750CSR 42 TERDAT COMP 0 43 ÐÐ07760CSR SETON 71 07770CSR EXCPT PUT HEADINGS 07780CSR SETOF 7143 07790CSR Z-ADD91 COUNT 07800CSR ENDSR 07810C********************************************************************* 07820CSR SR72 BEGSR 07830C* PUT DATA TO TERMINAL 07840CSR LIN,F SUB 1 W3N 30 07850CSRN50 90 ADD W3N W3N 30 07860CSR MOVELW3N RPGLIN 4 07870CSR MOVEL'001' RPGCOL 4 07880CSR EXSR SR69 MOVE CURSOR 07890CSR SETON 72 07900CSR EXCPT PUT DATA 07910CSR SETOF 72 07920CSR ENDSR 07930C**************************************************************** 07940CSR SR74 BEGSR 07950C* PUT WARNING MESSAGE 07960CSR EXSR SR89 GET MESSAGE 07970CSR EXSR SR72 PUT MESSAGE 07980CSR ENDSR 07990C******************************************************************* 08000CSR SR75 BEGSR ÐÐ08010C* READ FROM TERMINAL 08020CSR SETOF 779096 08030CSR SETOF 9392 08040CSR SETOF 8988 08050CSR SETOF 8685 08060CSR EXSR SR66 INIT A39 08070CSR MOVE BLK40 W40A 40 BUFFER 08080CSR Z-ADDLIN,F W3N 30 08090CSRN50 90 ADD W3N W3N 30 08100CSR MOVELW3N RPGLIN 4 08110CSR MOVELCOL,F RPGCOL 4 08120CSR EXSR SR69 MOVE CURSOR 08130CSR EXITFZR40 READ FROM TERMINAL 08140CSR RLABL W40A READ BUFFER 08150CSR MOVEAW40A A40 INPUT DATA ARRAY 08160CSR MOVE BLK40 W40A INIT INPUT ARRAY 08170CSR Z-ADD1 W 30 08180CSR '\' LOKUPA40,W 90 FLAG ESC 08190CSRN90 GOTO T75B NOT ESC 08200CSR 1 ADD W W 08210CSR W COMP 40 54 08220CSR 54 GOTO T75A BAD ESC 08230CSR A40,W COMP 'G' 98 GOODBY 08240CSR A40,W COMP 'E' 94 MENU 08250CSR A40,W COMP 'N' 93 NEW ITEM ÐÐ08260CSR A40,W COMP 'J' 92 JUMP 08270CSR A40,W COMP 'B' 89 SKIP BKWRD 08280CSR A40,W COMP 'S' 88 SPACE FILL 08290CSR A40,W COMP 'U' 86 UPDATE 08300CSR A40,W COMP 'R' 85 REPEAT 08310CSR 98 GOTO GOODBY 08320CSR 94 GOTO MENU 08330CSR 93 GOTO NEWITM 08340CSR 92 08350COR 89 08360COR 88 08370COR 86 08380COR 85 GOTO END75 GOOD ESC 08390C*------------------------------------------------------------------ 08400CSR T75A TAG 08410C* FLAG BAD ESC INPUT 08420CSR Z-ADD318 M 96 FLAG ERROR 08430CSR GOTO END75 08440C*-------------------------------------------------------------------- 08450CSR T75B TAG 08460C* MOVE DATA 08470CSR Z-ADD1 W 08480CSR ' ' LOKUPA40,W 77 08490CSR 77 MOVEAA40,W W40A INPUT DATA 08500C*-------------------------------------------------------------------- ÐÐ08510CSR END75 TAG 08520C* INIT PREV ERROR MSG. 08530CSR EXSR SR66 08540CSR ENDSR 08550C********************************************************************** 08560CSR SR80 BEGSR 08570C* GET MASTER RECORD 08580CSR SETOF 41 08590CSR TCLOCK CHAINEMMAST 40 GET MASTER 08600CSRN40 EMSTAT COMP 'D' 41 FLAG DELETE 08610CSR 40 08620COR 41 EXSR SR205 INIT MASTER 08630CSR EXSR SR207 SAVE MASTER 08640CSR ENDSR 08650C*********************************************************************** 08660CSR SR82 BEGSR 08670C* REWRITE MASTER 08680CSR SETON 82 08690CSR EXCPT REWRITE MASTER 08700CSR SETOF 82 08710CSR ENDSR 08720C********************************************************************** 08730CSR SR89 BEGSR 08740C* GET MESSAGE MASTER 08750CSR M CHAINMGFILE 54 ÐÐ08760CSR 54 MOVE BLK35 MGTEXT 08770CSR 54 MOVELM MGTEXT 08780CSR 54 MOVE MES,1 MGTEXT 08790CSR MOVEAMGTEXT A39,3 08800CSR ENDSR 08810C******************************************************************** 08820CSR SR96 BEGSR 08830CSR # CHAINCRTFILE H9 GET CRTFILE 08840CSR H9 GOTO ENDJOB 08850CSR ENDSR 08860C****************************************************************** 08870CSR SR97 BEGSR 08880C* UPDATE CRTFILE. EXIT PROGRAM. 08890CSR TIME CRTIME 08900CSR MOVELUDATE CRDATE 08910CSR SETON 97 08920CSR EXCPT UPDATE CRTFILE 08930CSR SETOF 97 08940CSR ENDSR 08950C*********************************************************************** 08960CSR SR98 BEGSR 08970CSR EXSR SR205 08980CSR SETON 51 08990CSR EXSR SR70 CLEAR SCREEN 09000CSR EXITFCHAIN >>>>>>>>>> ÐÐ09010CSR RLABL PROG 09020CSR ENDSR 09030C******************************************************************** 09040CSR SR99 BEGSR 09050C* STORE THIS PROG AS RETURN TO PROG. 09060CSR EXSR SR96 GET CRTFILE 09070CSR Z-ADD8 W 09080C*------------------------------------------------------------------- 09090CSR T99A TAG 09100CSR W SUB 1 W 54 09110CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 09120CSR LNK,W COMP BLK6 54 09130CSRN54 GOTO T99A 09140CSR MOVELRETURN LNK,W 09150CSR EXSR SR97 UPDATE CRTFILE 09160CSR EXSR SR98 >>>>>>>>>>>>>> 09170CSR END99 ENDSR 09180C*********************************************************************** 09190CSR SR101 BEGSR 09200C* 1-TIME INITIALIZE 09210CSR MOVE BIT,1 NUL 09220CSR MOVE ' ' A39 09230CSR MOVE BIT,28 A39,1 09240CSR MOVE 'D' A39,2 09250CSR MOVE BIT,28 A39,38 ÐÐ09260CSR MOVE 'E' A39,39 09270CSR Z-ADD36 FLIMIT 30 TOTAL NUMB FIELDS 09280CSR MOVE ' ' BLK40 40 09290CSR Z-ADD17 X 30 09300CSR MOVE '-' DOTS 09310CSR MOVEL'>' DOTS,X 09320CSR MOVE ' ' DOTS,X 09330C* GET PORT # AND CRTFILE 09340CSR MOVE ' ' W2A 2 09350CSR EXITFZGMINX GET PORT # 09360CSR RLABL W2A 09370CSR MOVE W2A # 20 PORT NO. 09380CSR # COMP 0 54 09390CSRN54 Z-ADD25 # DEFAULT 09400CSR EXSR SR96 GET CRTFILE 09410CSR MOVE CALL LNK 09420CSR MOVE 'Q113EM 'PROG 09430CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 09440CSR TST,# COMP 'S' 56 09450CSRN56 CRSHUT COMP 'S' 56 09460CSR 56 MOVE 'S' CRSHUT SHUTDOWN 09470CSR 56 MOVE 'SHUTDOWN'PROG 09480CSR EXSR SR97 UPDATE CRTFILE 09490CSR 56 EXSR SR98 >>>>>>>>>>>>> 09500C* DEFINE WORK FIELDS,ETC. ÐÐ09510CSR MOVE BLK8 RETURN 8 09520CSR MOVE ' ' BLK35 35 09530CSR MOVE ' ' BLK28 28 09540CSR MOVE ' ' BLK25 25 09550CSR MOVE ' ' BLK30 30 09560CSR MOVE ' ' BLK20 20 09570CSR MOVE ' ' BLK8 8 09580CSR MOVE ' ' BLK15 15 09590CSR MOVE ' ' BLK6 6 09600CSR ENDSR 09610C********************************************************************** 09620CSR SR102 BEGSR 09630C* VALIDATE FIELD NO. 09640CSR F COMP 0 54 09650CSRN54 Z-ADD1 F 09660CSR F COMP FLIMIT 55 09670CSR 55 Z-ADD1 F 09680CSR ENDSR 09690C******************************************************************** 09700CSR SR103 BEGSR 09710C* MOVE INPUT DATA 09720CSR EXSR SR201 IDENTIFY-F 09730CSR EXSR SR202 RIGHT ADJUST 09740CSR 02 MOVE W15A TCLOCK 50 CLOCK # 09750CSR 03 MOVELW40A EMFNAM 1ST NAME ÐÐ09760CSR 04 MOVELW40A EMMNAM MIDDLE NAME 09770CSR 05 MOVELW40A EMLNAM LAST NAME 09780CSR 06 MOVE W15A EMDEPT DEPT # 09790CSR 07 MOVE W15A EMWC WORK CENTER 09800CSR 08 MOVELW40A EMJOB JOB NAME 09810CSR 09 MOVELW40A EMJ,1 ADMIN/FACTORY 09820CSR 10 MOVELW40A EMJ,2 PERM/TEMP 09830CSR 11 MOVELW40A EMJ,3 FULL/PART TIME 09840CSR 12 MOVELW40A EMJ,4 HOURLY/SALARY 09850CSR 13 MOVELW40A EMJ,5 DIRECT/INDIRECT 09860CSR 14 MOVE W15A EMRATE PAY RATE 09870CSR 15 MOVELW40A EMPUM PAY UNIT MEAS 09880CSR 16 MOVELW40A EMPFRQ PAY FREQUENCY 09890CSR 17 MOVELW40A EMHOLD HOLD PAY CHECK FLAG 09900CSR 18 MOVE W15A HPD,1 HRS PER DAY-SUN 09910CSR 19 MOVE W15A HPD,2 MON 09920CSR 20 MOVE W15A HPD,3 TUES 09930CSR 21 MOVE W15A HPD,4 WED 09940CSR 22 MOVE W15A HPD,5 THURS 09950CSR 23 MOVE W15A HPD,6 FRI 09960CSR 24 MOVE W15A HPD,7 SAT 09970CSR 25 MOVE W15A STD,1 SUN 09980CSR 26 MOVE W15A STD,2 MON 09990CSR 27 MOVE W15A STD,3 TUES 10000CSR 28 MOVE W15A STD,4 WED ÐÐ10010CSR 29 MOVE W15A STD,5 THUR 10020CSR 30 MOVE W15A STD,6 FRI 10030CSR 31 MOVE W15A STD,7 SAT 10040CSR 32 MOVE W15A EMHPW HRS PER WEEK 10050CSR 33 MOVE W15A EMHIRD DATE HIRED 10060CSR 34 MOVE W15A EMASYR ADD. SENIORITY-YRS 10070CSR 35 MOVE W15A EMASMO ADD. SENIORITY-MOS 10080CSR 36 MOVE W15A EMASDY ADD. SENIORITY-DAYS 10090CSR MOVE ' ' DUN,F EDIT FLAG 10100CSR ENDSR 10110C******************************************************************** 10120CSR SR104 BEGSR 10130C* EDIT INPUT DATA 10140CSR 02 EXSR SR2 10150CSR 03 EXSR SR3 10160CSR 05 EXSR SR5 10170CSR 06 EXSR SR6 10180CSR 07 EXSR SR7 10190CSR 08 EXSR SR8 10200CSR 09 EXSR SR9 10210CSR 10 EXSR SR10 10220CSR 11 EXSR SR11 10230CSR 12 EXSR SR12 10240CSR 13 EXSR SR13 10250CSR 14 EXSR SR14 ÐÐ10260CSR 15 EXSR SR15 10270CSR 16 EXSR SR16 10280CSR 18 EXSR SR18 10290CSR 19 EXSR SR18 10300CSR 20 EXSR SR18 10310CSR 21 EXSR SR18 10320CSR 22 EXSR SR18 10330CSR 23 EXSR SR18 10340CSR 24 EXSR SR18 10350CSR 25 EXSR SR25 10360CSR 26 EXSR SR25 10370CSR 27 EXSR SR25 10380CSR 28 EXSR SR25 10390CSR 29 EXSR SR25 10400CSR 30 EXSR SR25 10410CSR 31 EXSR SR25 10420CSR 32 EXSR SR32 10430CSR 33 EXSR SR33 10440CSR 96 MOVE ' ' DUN,F EDIT FLAG 10450CSRN96 MOVE 'X' DUN,F 10460CSR ENDSR 10470C*********************************************************************** 10480CSR SR105 BEGSR 10490C* FINAL EDIT 10500CSR SETOF 77 ÐÐ10510CSR SETON 79 FINAL EDIT FLAG 10520CSR Z-ADD1 F 96 10530C*-------------------------------------------------------------------- 10540CSR T105A TAG 10550CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 10560CSRN54 GOTO END105 10570CSR EXSR SR201 IDENTIFY-F 10580CSR EXSR SR104 EDIT 10590CSRN96 GOTO T105A 10600C*-------------------------------------------------------------------- 10610CSR END105 TAG 10620CSR SETOF 79 10630CSR ENDSR 10640C******************************************************************** 10650CSR SR106 BEGSR 10660C* UPDATE DATA BASE. 10670CSRN40N41 GOTO T106E GOT IT 10680C* FLAG NO MASTER ERROR 10690CSR Z-ADD302 M 96 FLAG ERROR 10700CSR Z-ADD1 F FIELD # 10710CSR GOTO END106 10720C*----------------------------------------------------------------------- 10730CSR T106E TAG 10740C* REWRITE MASTER 10750CSR EXSR SR82 REWRITE MAST ÐÐ10760CSR END106 ENDSR 10770C************************************************************************ 10780CSR SR201 BEGSR 10790C* IDENTIFY FIELD NO. 10800CSR SETOF 545556 10810CSR F COMP 30 54 >30 10820CSRN54 F COMP 20 55 >20 10830CSRN54N55 F COMP 10 56 >10 10840CSR 56 GOTO T201A 10850CSR 55 GOTO T201B 10860CSR 54 GOTO T201C 10870CSR EXSR SR302 SETOF 11-20 10880CSR EXSR SR303 SETOF 21-30 10890CSR EXSR SR304 SETOF 31-36 10900CSR F COMP 1 01 10910CSR F COMP 2 02 10920CSR F COMP 3 03 10930CSR F COMP 4 04 10940CSR F COMP 5 05 10950CSR F COMP 6 06 10960CSR F COMP 7 07 10970CSR F COMP 8 08 10980CSR F COMP 9 09 10990CSR F COMP 10 10 11000CSR GOTO END201 ÐÐ11010C*--------------------------------------------------------------- 11020CSR T201A TAG 11030CSR EXSR SR301 SETOF 1-10 11040CSR EXSR SR303 SETOF 21-30 11050CSR EXSR SR304 SETOF 31-40 11060CSR F COMP 11 11 11070CSR F COMP 12 12 11080CSR F COMP 13 13 11090CSR F COMP 14 14 11100CSR F COMP 15 15 11110CSR F COMP 16 16 11120CSR F COMP 17 17 11130CSR F COMP 18 18 11140CSR F COMP 19 19 11150CSR F COMP 20 20 11160CSR GOTO END201 11170C*--------------------------------------------------------------------- 11180CSR T201B TAG 11190CSR EXSR SR301 SETOF 1-10 11200CSR EXSR SR302 SETOF 11-20 11210CSR EXSR SR304 SETOF 31-40 11220CSR F COMP 21 21 11230CSR F COMP 22 22 11240CSR F COMP 23 23 11250CSR F COMP 24 24 ÐÐ11260CSR F COMP 25 25 11270CSR F COMP 26 26 11280CSR F COMP 27 27 11290CSR F COMP 28 28 11300CSR F COMP 29 29 11310CSR F COMP 30 30 11320CSR GOTO END201 11330C*--------------------------------------------------------------------- 11340CSR T201C TAG 11350CSR EXSR SR301 SETOF 1-10 11360CSR EXSR SR302 SETOF 11-20 11370CSR EXSR SR303 SETOF 21-30 11380CSR F COMP 31 31 11390CSR F COMP 32 32 11400CSR F COMP 33 33 11410CSR F COMP 34 34 11420CSR F COMP 35 35 11430CSR F COMP 36 36 11440CSR END201 ENDSR 11450C********************************************************************** 11460CSR SR202 BEGSR 11470C* RIGHT JUSTIFY 11480CSR F LOKUPNUM 54 11490CSRN54 GOTO END202 NOT NUMERIC FIELD 11500CSR Z-ADD15 W2N 20 ÐÐ11510CSR MOVELW40A W15A 15 11520CSR EXIT SUBRAJ R. JUSTIFY 11530CSR RLABL W2N 11540CSR RLABL W15A 11550CSR END202 ENDSR 11560C******************************************************************** 11570CSR SR205 BEGSR 11580C* INIT EMMAST FIELDS. 11590CSR Z-ADD0 EMCLOK 11600CSR MOVE BLK35 EMFNAM 11610CSR MOVE BLK35 EMMNAM 11620CSR MOVE BLK35 EMLNAM 11630CSR MOVE ' ' EMS 11640CSR MOVE BLK35 EMCITY 11650CSR MOVE ' ' EMSTCD 11660CSR Z-ADD0 EMZIP 11670CSR MOVE BLK15 EMPHON 11680CSR MOVE ' ' EME 11690CSR MOVE ' ' EEO 11700CSR Z-ADD0 EMBIRD 11710CSR MOVE BLK35 EMEDUC 11720CSR MOVE BLK35 EMSNAM 11730CSR Z-ADD0 EMSBIR 11740CSR Z-ADD0 EMDEPT 11750CSR Z-ADD0 EMWC ÐÐ11760CSR MOVE BLK35 EMJOB 11770CSR MOVE ' ' EMJ 11780CSR Z-ADD0 EMRATE 11790CSR MOVE ' ' EMPUM 11800CSR MOVE ' ' EMPFRQ 11810CSR MOVE ' ' EMHOLD 11820CSR Z-ADD0 HPD 11830CSR Z-ADD0 STD 11840CSR Z-ADD0 EMHPW 11850CSR Z-ADD0 EMLRD 11860CSR MOVE ' ' EMLRT 11870CSR Z-ADD0 EMLRP 11880CSR Z-ADD0 EMLPA 11890CSR Z-ADD0 EMNSRD 11900CSR MOVE BLK15 EMNSRR 11910CSR Z-ADD0 EMRFRQ 11920CSR Z-ADD0 EMHIRD 11930CSR Z-ADD0 EMASYR 11940CSR Z-ADD0 EMASMO 11950CSR Z-ADD0 EMASDY 11960CSR EXSR SR211 INIT TERM FIELDS 11970CSR MOVE ' ' EMVCC 11980CSR Z-ADD0 EMVEH 11990CSR Z-ADD0 EMVHT 12000CSR Z-ADD0 EMVLDP ÐÐ12010CSR Z-ADD0 EMVSLD 12020CSR Z-ADD0 EMVALD 12030CSR Z-ADD0 EMVSRD 12040CSR Z-ADD0 EMVARD 12050CSR Z-ADD0 EMSLEH 12060CSR Z-ADD0 EMSLHT 12070CSR Z-ADD0 EMSLDP 12080CSR Z-ADD0 EMSLSL 12090CSR Z-ADD0 EMSLAL 12100CSR Z-ADD0 EMSLSR 12110CSR Z-ADD0 EMSLAR 12120CSR MOVE ' ' EMFTMS 12130CSR Z-ADD0 EMFTNE 12140CSR Z-ADD0 EMFXEX 12150CSR MOVE ' ' EMFTXC 12160CSR Z-ADD0 EMFTXA 12170CSR MOVE BLK15 EMSS 12180CSR MOVE ' ' EMCICA 12190CSR Z-ADD0 EMFEIC 12200CSR MOVE ' ' EMSTMS 12210CSR Z-ADD0 EMSTNE 12220CSR Z-ADD0 EMSXEX 12230CSR MOVE ' ' EMSTXC 12240CSR Z-ADD0 EMFTXA 12250CSR Z-ADD0 EMSEIC ÐÐ12260CSR Z-ADD0 PTH 12270CSR Z-ADD0 PTE 12280CSR Z-ADD0 PTF 12290CSR Z-ADD0 PTS 12300CSR MOVE ' ' PRT 12310CSR Z-ADD0 PRB 12320CSR Z-ADD0 PRS 12330CSR MOVE ' ' PRC 12340CSR Z-ADD0 PRA 12350CSR Z-ADD0 PRY 12360CSR MOVE ' ' PRN 12370CSR Z-ADD0 EMLOAL 12380CSR Z-ADD0 EMLOAR 12390CSR Z-ADD0 EMLOAT 12400CSR MOVE ' ' EMFLAG 12410CSR MOVE ' ' EMSTAT 12420CSR MOVE BLK35 WCNAME 12430CSR MOVE BLK35 EJN 12440CSR MOVE BLK35 NAMEMP 12450CSR MOVE BLK35 NAMEPF 12460CSR Z-ADD0 TERDAT 12470CSR ENDSR 12480C****************************************************************** 12490CSR SR206 BEGSR 12500C* INIT INPUT ONLY FIELDS ÐÐ12510CSR Z-ADD0 TCLOCK CLOCK # 12520CSR SETOF 4041 12530CSR ENDSR 12540C****************************************************************** 12550CSR SR207 BEGSR 12560C* SAVE MASTER "OLD" FIELDS 12570CSR ENDSR 12580C**************************************************************** 12590CSR SR208 BEGSR 12600C* EDIT HRS PER DAY 12610CSR Z-ADD16 W3D1 31 12620CSR Z-ADD1 X 12630CSR W3D1 LOKUPHPD,X 54 12640CSR 54 Z-ADD694 M 96 FLAG ERROR 12650CSR 54 17 ADD X F 12660CSR 54 GOTO END208 12670CSR Z-ADD10 W3D1 12680CSR W3D1 LOKUPHPD 54 12690CSR 54 Z-ADD695 M 95 12700CSR 54 EXSR SR89 FLAG WARNING 12710CSR END208 ENDSR 12720C****************************************************************** 12730CSR SR209 BEGSR 12740C* EDIT START TIMES 12750CSR Z-ADD1 X ÐÐ12760C*------------------------------------------------------------------ 12770CSR T209A TAG 12780CSR MOVELSTD,X HRS 20 12790CSR MOVE STD,X MINUTE 20 12800CSR HRS COMP 0 54 12810CSR HRS COMP 24 55 12820CSR MINUTE COMP 0 56 12830CSR MINUTE COMP 60 57 12840CSR 55 12850COR 57 Z-ADD695 M 95 12860CSR 55 12870COR 57 EXSR SR89 FLAG WARNING 12880CSR 55 12890COR 57 GOTO END209 12900CSR 1 ADD X X 12910CSR X COMP 7 54 12920CSRN54 GOTO T209A 12930CSR END209 ENDSR 12940C******************************************************************** 12950CSR SR211 BEGSR 12960C* INITIALIZE TERMINATION DATE 12970CSR Z-ADD0 EMDATT 12980CSR MOVE ' ' EMTREA 12990CSR Z-ADD0 EMC 13000CSR MOVE ' ' EMREH ÐÐ13010CSR Z-ADD0 EMHIRD 13020CSR ENDSR 13030C******************************************************************** 13040CSR SR212 BEGSR 13050C* CALCULATE LENGTH OF EMPLOYMENT 13060CSR Z-ADDEMDATT W6N 60 13070CSR MOVELW6N CYR 20 13080CSR MOVE W6N W4N 40 13090CSR MOVELW4N CMO 20 13100CSR MOVE W4N CDAY 20 13110C*------------------------------------------------------------------- 13120C* SET-UP HIRE DATE 13130CSR MOVELEMHIRD HYR 20 13140CSR MOVE EMHIRD W4N 13150CSR MOVELW4N HMO 20 13160CSR MOVE W4N HDAY 20 13170C*------------------------------------------------------------------- 13180C* CALCULATE LENGTH OF SERVICE 13190CSR HDAY COMP CDAY 54 13200CSRN54 GOTO T212B 13210CSR Z-ADDHMO X 30 54 13220CSRN54 Z-ADD1 X 13230CSR X COMP 12 54 13240CSR 54 Z-ADD12 X 13250CSR CMO SUB 1 CMO 54 ÐÐ13260CSRN54 Z-ADD12 CMO 13270CSRN54 CYR SUB 1 CYR 13280CSR CAL,X ADD CDAY CDAY 13290C*------------------------------------------------------------------- 13300CSR T212B TAG 13310CSR HMO COMP CMO 54 13320CSRN54 GOTO T212E 13330CSR 12 ADD CMO CMO 13340CSR CYR SUB 1 CYR 13350C*------------------------------------------------------------------- 13360CSR T212E TAG 13370CSR CYR SUB HYR DYR 20 13380CSR CMO SUB HMO DMO 20 13390CSR CDAY SUB HDAY DDAY 20 13400CSR EMASYR ADD DYR DYR 13410CSR EMASMO ADD DMO DMO 13420CSR EMASDY ADD DDAY DDAY 13430CSR DDAY COMP 30 54 13440CSR 54 1 ADD DMO DMO 13450CSR 54 DDAY SUB 30 DDAY 13460CSR DMO COMP 12 54 13470CSR 54 DMO SUB 12 DMO 13480CSR 54 1 ADD DYR DYR 13490CSR Z-ADDDYR EMASYR 13500CSR Z-ADDDMO EMASMO ÐÐ13510CSR Z-ADDDDAY EMASDY 13520CSR ENDSR 13530C******************************************************************** 13540CSR SR301 BEGSR 13550CSR SETOF 010203 13560CSR SETOF 040506 13570CSR SETOF 070809 13580CSR SETOF 10 13590CSR ENDSR 13600C******************************************************************** 13610CSR SR302 BEGSR 13620CSR SETOF 111213 13630CSR SETOF 141516 13640CSR SETOF 171819 13650CSR SETOF 20 13660CSR ENDSR 13670C****************************************************************** 13680CSR SR303 BEGSR 13690CSR SETOF 212223 13700CSR SETOF 242526 13710CSR SETOF 272829 13720CSR SETOF 30 13730CSR ENDSR 13740C****************************************************************** 13750CSR SR304 BEGSR ÐÐ13760CSR SETOF 313233 13770CSR SETOF 343536 13780CSR ENDSR 13790O******************************************************************** 13800OTERM132 E 70 13810O OR 71 13820O BIT,28 1 13830O N50 8 '8091001' 13840O N50 BIT,1 9 13850O N50 BIT,1 10 13860O 50 10 '[001 ]001' 13870O 50 BIT,28 6 13880O UDATE 18 ' - - ' 13890O 53 'E M P L O Y E E' 13900O 68 'M A S T E R' 13910O 82 'R E H I R E' 13920O 97 'U P D A T E' 13930O 43 50 BIT,28 110 13940O 43 50 111 'D' 13950O 43 121 'TERMINATED' 13960O 43 TERDATY 130 13970O 43 50 BIT,28 131 13980O 43 50 132 'E' 13990O*----------------------------------------------------------------- 14000O E 70 ÐÐ14010O OR 71 14020O OR 72 01 14030O 1 ' ' 14040O*------------------------------------------------------------------ 14050O E 70 14060O OR 71 14070O OR 72 02 14080O DOTS 34 14090O 15 '(2) CLOCK NO.' 14100O TCLOCKZ 40 14110O A39 132 14120O*----------------------------------------------------------------- 14130O E 71 14140O OR 72 03 14150O DOTS 34 14160O 14 '(3) 1ST NAME' 14170O EMFNAM 60 14180O A39 132 14190O*------------------------------------------------------------------ 14200O E 71 14210O OR 72 04 14220O DOTS 34 14230O 17 '(4) MIDDLE NAME' 14240O EMMNAM 60 14250O*------------------------------------------------------------------- ÐÐ14260O E 71 14270O OR 72 05 14280O DOTS 34 14290O 15 '(5) LAST NAME' 14300O EMLNAM 65 14310O A39 132 14320O*---------------------------------------------------------------- 14330O E 71 14340O OR 72 06 14350O DOTS 34 14360O 20 '(6) DEPARTMENT NO.' 14370O EMDEPTZ 40 14380O A39 132 14390O*---------------------------------------------------------------- 14400O E 71 14410O OR 72 07 14420O DOTS 34 14430O 17 '(7) WORK CENTER' 14440O EMWC Z 40 14450O WCNAME 70 14460O A39 132 14470O*----------------------------------------------------------------- 14480O E 71 14490O OR 72 08 14500O DOTS 34 ÐÐ14510O 14 '(8) JOB NAME' 14520O EMJOB 63 14530O A39 132 14540O*----------------------------------------------------------------- 14550O E 71 14560O OR 72 09 14570O DOTS 34 14580O 19 '(9) ADMIN/FACTORY' 14590O 31 '(A,F)' 14600O EMJ,1 36 14610O EJN,1 47 14620O A39 132 14630O*-------------------------------------------------------------------- 14640O E 71 14650O OR 72 10 14660O DOTS 34 14670O 24 '(10) PERMANENT/TEMPORAR' 14680O 25 'Y' 14690O 31 '(P,T)' 14700O EMJ,2 36 14710O EJN,2 47 14720O A39 132 14730O*--------------------------------------------------------------------- 14740O E 71 14750O OR 72 11 ÐÐ14760O DOTS 34 14770O 20 '(11) FULL/PART TIME' 14780O 31 '(F,P)' 14790O EMJ,3 36 14800O A39 132 14810O EJN,3 47 14820O*-------------------------------------------------------------------- 14830O E 71 14840O OR 72 12 14850O DOTS 34 14860O 19 '(12) HOURLY/SALARY' 14870O 31 '(H,S)' 14880O EMJ,4 36 14890O EJN,4 47 14900O A39 132 14910O*---------------------------------------------------------------- 14920O E 71 14930O OR 72 13 14940O DOTS 34 14950O 21 '(13) DIRECT/INDIRECT' 14960O 31 '(D,I)' 14970O EMJ,5 36 14980O EJN,5 47 14990O A39 132 15000O*-------------------------------------------------------------- ÐÐ15010O E 71 15020O OR 72 14 15030O DOTS 34 15040O 16 '(14) PAY RATE $' 15050O EMRATE2 46 15060O A39 132 15070O*-------------------------------------------------------------- 15080O E 71 15090O OR 72 15 15100O DOTS 34 15110O 24 '(15) PAY UNIT (H,D,W,M,' 15120O 28 'S,A)' 15130O EMPUM 36 15140O NAMEMP 51 15150O A39 132 15160O*------------------------------------------------------------------ 15170O E 71 15180O OR 72 16 15190O DOTS 34 15200O 24 '(16) PAY FREQUENCY (W,S' 15210O 27 ',M)' 15220O EMPFRQ 36 15230O NAMEPF 47 15240O A39 132 15250O*-------------------------------------------------------------- ÐÐ15260O E 71 15270O OR 72 17 15280O DOTS 34 15290O 24 '(17) HOLD PAY CHECK FLA' 15300O 25 'G' 15310O EMHOLD 36 15320O A39 132 15330O*-------------------------------------------------------------- 15340O E 71 15350O 40 'S' 15360O 46 'M' 15370O 52 'T' 15380O 58 'W' 15390O 64 'T' 15400O 70 'F' 15410O 76 'S' 15420O*--------------------------------------------------------------- 15430O E 71 15440O OR 72 18 15450O OR 72 19 15460O OR 72 20 15470O OR 72 21 15480O OR 72 22 15490O OR 72 23 15500O OR 72 24 ÐÐ15510O DOTS 34 15520O 19 '(18) HOURS PER DAY' 15530O HPD,1 2 42 15540O HPD,2 2 48 15550O HPD,3 2 54 15560O HPD,4 2 60 15570O HPD,5 2 66 15580O HPD,6 2 72 15590O HPD,7 2 78 15600O A39 132 15610O*---------------------------------------------------------------- 15620O E 71 15630O OR 72 25 15640O OR 72 26 15650O OR 72 27 15660O OR 72 28 15670O OR 72 29 15680O OR 72 30 15690O OR 72 31 15700O DOTS 34 15710O 23 '(25) START TIME EA DAY' 15720O STD,1 42 ' : ' 15730O STD,2 48 ' : ' 15740O STD,3 54 ' : ' 15750O STD,4 60 ' : ' ÐÐ15760O STD,5 66 ' : ' 15770O STD,6 72 ' : ' 15780O STD,7 78 ' : ' 15790O A39 132 15800O*-------------------------------------------------------------- 15810O E 71 15820O OR 72 32 15830O DOTS 34 15840O 20 '(32) HOURS PER WEEK' 15850O EMHPW 2 41 15860O 78 'ADDITIONAL SENIORITY' 15870O A39 132 15880O*-------------------------------------------------------------- 15890O E 71 15900O OR 72 33 15910O DOTS 34 15920O 16 '(33) DATE HIRED' 15930O EMHIRD 43 ' - - ' 15940O 57 '(34) YRS:' 15950O EMASYRZ 60 15960O 72 '(35) MOS:' 15970O EMASMOZ 75 15980O 88 '(36) DAYS:' 15990O EMASDYZ 91 16000O A39 132 ÐÐ16010O**************************************************************** 16020OCRTFILE E 97 16030O PROG 26 16040O CRTIME 33 16050O CRDATE 37 16060O LNK 79 16070O******************************************************************** 16080OEMMAST E 82 16090O EMFNAM 31 16100O EMMNAM 56 16110O EMLNAM 86 16120O EMS 156 16130O EMCITY 181 16140O EMSTCD 183 16150O EMZIP 188P 16160O EMPHON 203 16170O EME 253 16180O EEO 261 16190O EMBIRD 267 16200O EMEDUC 297 16210O EMSNAM 327 16220O EMSBIR 333 16230O EMDEPT 338P 16240O EMWC 340P 16250O EMJOB 368 ÐÐ16260O EMJ 374 16270O EMRATE 379P 16280O EMPUM 380 16290O EMPFRQ 381 16300O EMHOLD 382 16310O HPD 396P 16320O STD 410B 16330O EMHPW 413P 16340O EMCPHW 416P 16350O EMCPOW 419P 16360O EMCPOA 422P 16370O EMLRD 463 16380O EMLRT 464 16390O EMLRP 470 16400O EMLPA 473P 16410O EMNSRD 481 16420O EMNSRR 496 16430O EMRFRQ 497 16440O EMHIRD 503 16450O EMASYR 505 16460O EMASMO 507 16470O EMASDY 509 16480O EMDATT 515 16490O EMTREA 517 16500O EMC 532P ÐÐ16510O EMREH 533 16520O EMVCC 534 16530O EMVEH 539P 16540O EMVHT 542P 16550O EMVLDP 548 16560O EMVSLD 554 16570O EMVALD 560 16580O EMVSRD 566 16590O EMVARD 572 16600O EMSLEH 577P 16610O EMSLHT 580P 16620O EMSLDP 586 16630O EMSLSL 592 16640O EMSLAL 598 16650O EMSLSR 604 16660O EMSLAR 610 16670O EMFTMS 611 16680O EMFTNE 613 16690O EMFXEX 615 16700O EMFTXC 616 16710O EMFTXA 620 16720O EMSS 634 16730O EMCICA 635 16740O EMFEIC 636 16750O EMSTMS 637 ÐÐ16760O EMSTNE 639 16770O EMSXEX 641 16780O EMSTXC 642 16790O EMSTXA 646 16800O EMSEIC 647 16810O PTH 668P 16820O PTE 703P 16830O PTF 727P 16840O PTS 751P 16850O PRT 791 16860O PRB 911 16870O PRS 1031 16880O PRC 1051 16890O PRA 1131P 16900O PRY 1211P 16910O PRN 1491 16920O EMLOAL 1497 16930O EMLOAR 1503 16940O EMLOAT 1505P 16950O EMFLAG 1535 16960O EMSTAT 1536 ** NUL ARRAY 016970 16980** A40 ARRAY 16990 17000ÐÐ** LIN/COL ARRAYS 17010002037 1 TRAN (NOT USED) 17020003037 2 CLOCK 17030004037 3 1ST NAME 17040005037 4 MID. NAME 17050006037 5 LAST NAME 17060007037 6 DEPT 17070008037 7 WC 17080009037 8 JOB NAME 17090010037 9 A/F 17100011037 10 P/T 17110012037 11 F/P 17120013037 12 H/S 17130014037 13 D/I 17140015037 14 PAY 17150016037 15 PAY UNIT 17160017037 16 PAY FREQ 17170018037 17 HOLD PAY FLAG 17180020040 18 HRS PER DAY 17190020046 19 17200020052 20 17210020058 21 17220020064 22 17230020069 23 17240020075 24 17250ÐÐ021040 25 START TIMES 17260021046 26 17270021052 27 17280021058 28 17290021064 29 17300021070 30 17310021076 31 17320022037 32 HRS PER WEEK 17330023037 33 DATE HIRED 17340023060 34 XTRA SEN. YRS 17350023075 35 XTRA SEN. MOS 17360023091 36 XTRA SEN. DAYS 17370** A39 ARRAY 17380 17390** NUM ARRAY 017400002 CLOCK 1 17410006 DEPT 2 17420007 WC 3 17430014 PAY RATE 4 17440018 HPD,1 5 17450019 HPD,2 6 17460020 HPD,3 7 17470021 HPD,4 8 17480022 HPD,5 9 17490023 HPD,6 10 017500ÐÐ024 HPD,7 1 17510025 STD,1 2 17520026 STD,2 3 17530027 STD,3 4 17540028 STD,4 5 17550029 STD,5 6 17560030 STD,6 7 17570031 STD,7 8 17580032 HRS PER WK 9 17590033 HIRE DATE 20 017600034 XTRA SEN 1 17610035 XTRA SEN 2 17620036 XTRA SEN 3 17630** DUN ARRAY 17640 017650** MES ARRAY 017660---MESSAGE NOT ON FILE--- 017670** LNK ARRAY 017680 17690** DOTS ARRAY 17700 17710** EJN ARRAY 17720 17730** TABPUM/TABPUN 17740HHOURLY 17750ÐÐDDAILY 17760WWEEKLY 17770MMONTHLY 17780SSEMI-MONTHLY 17790AANNUALLY (YR) 17800** ENJ ARRAY 17810ADMIN 17820FACTORY 17830PERMANENT 17840TEMPORARY 17850FULL TIME 17860PART TIME 17870SALARY 17880HOURLY 17890INDIRECT 17900DIRECT 17910** CAL ARRAY 1792031 JAN 1793028 FEB 1794031 MAR 1795030 ARPIL 1796031 MAY 1797030 JUNE 1798031 JULY 1799031 AUG 18000ÐÐ30 SEP 1801031 OCT 1802030 NOV 1803031 DEC 18040/* 18050_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(f X001AP P999999120282(èÈÐ00010H Q001AP00020F* APVCLEAR FILE ADD,CHG,DEL UPDATE. (X001AP) 00030F* REVISED 10-08-81 2:55 PM. 00040FBIT44 IP F 44 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FAPVCLEARUC F 192R21AI 1 DISK A 00080FPOITEM IC F 384R 9AI 1 DISK 00090FVMMAST IC F 384R 5AI 1 DISK 00100FPMMST2 IC F 674R12AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A70 70 70 1 A INPUT DATA ARRAY 00150E NUM 1 9 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 16 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E DOT 33 33 1 DIVIDER 00190E RCD 1 26 7 0 00200E OPN 1 26 7 0 00210E PID 26 6 0 00220E PIQ 26 7 0A 00230E BIT 44 1 SCREEN CONTR. CHAR 00240E CALL 5 6 CALL STACK 00250E PA$ 7 9 3 ÐÐ00260E AHR 3 7 3 00270E ADP 3 3 0 00280I******************************************************************* 00290IBIT44 BT 00300I 1 44 BIT 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I****************************************************************** 00360ICRTFILE CR 00370I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00380I* STD AREA - SAME FOR ALL PROGRAMS. 00390I* EMPLOYEE # 5N 00400I 1 50CREMPL 00410I* USER CODE 8A 00420I 6 13 CRUSER 00430I* DEPT # 5N 00440I 14 180CRDEPT 00450I* JOB NAME 8A (JOB LOADED BY MENU) 00460I 19 26 CRJOB 00470I* SHUTDOWN FLAG 1A 00480I* BLANK = NO SHUTDOWN 00490I 27 27 CRSHUT 00500I* TIME STARTED 6N ÐÐ00510I 28 330CRTIME 00520I* DATE STARTED 4N 00530I 34 370CRDATE 00540I* CALL STACK 5 X 6A 00550I 38 67 CALL 00560I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00570I 68 73 CRRET 00580I* MENU NAME 6A 00590I 74 79 CRMENU 00600I******************************************************************** 00610IAPVCLEARVC 00620I* ACCOUNTS PAYABLE INVOICE CLEARING FILE. 00630I* KEY AREA. 00640I* PO # 9A 00650I 1 9 VCPO 00660I* PRIME 6A 00670I 1 6 VCPOP 00680I* ITEM 3N 00690I 7 90VCPOD 00700I* INVOICE 12A 00710I 10 21 VCINV 00720I* VENDOR NO. 5P 00730I P 22 240VCVEND 00740I* WORK ORDER/ACCOUNT 9A 00750I 25 33 VCWO ÐÐ00760I* PRIME 6A 00770I 25 30 VCWOP 00780I* DASH 3N 00790I 31 330VCWOD 00800I* DYNAIR PART # 10N 00810I 34 430VCPN 00820I* VENDOR PART # 15A 00830I 44 58 VCVPN 00840I* PART DESCRIPTION 29A 00850I 59 87 VCDESC 00860I* P.O. DESCRIPTION 70A 00870I 34 103 VCNDES 00880I* DATE INPUT 6N 00890I 104 1090VCDLT 00900I* QTY BILLED 7P 00910I P 110 1130VCQBIL 00920I* UNIT PRICE 11.4P 00930I P 114 1194VC$BIL 00940I* EXTENDED AMOUNT 11.4P 00950I P 120 1254VCXBIL 00960I* DISCOUNT DATE 6N 00970I 126 1310VCDDIS 00980I* DISCOUNT % .3P 00990I P 132 1333VCDPCT 01000I* SCHED PAY DATE 6N ÐÐ01010I 134 1390VCDPAY 01020I* MATCH QTY 7P 01030I P 140 1430VCQMAT 01040I* MATCH AMOUNT 11.4P 01050I P 144 1494VC$MAT 01060I* STD COST. 01070I* BILLED 9.3P 01080I P 150 1543VCBSTD 01090I* RECEIVED 9.3P 01100I P 155 1593VCRSTD 01110I* TRANSFERRED TO A.P. 11.4P 01120I P 160 1654VC$TRS 01130I* VARIANCE TAKEN 9.3P 01140I P 166 1703VC$VAR 01150I* PRICE CODE 1A 01160I 171 171 VCPCOD 01170I* RECORD STATUS 1A 01180I 192 192 VCSTAT 01190I******************************************************************** 01200IPOITEM PI 01210I* PURCHASE ORDER ITEM RECORD. 01220I* KEY AREA. 01230I* PO # 6N 01240I 1 60PIPO 01250I* PO ITEM 3N ÐÐ01260I* * * * * * 7 90PIITEM 01270I* DYNAIR PART # 10N 01280I 10 190PIPN 01290I* VENDOR PART # 15A 01300I 20 34 PIVPN 01310I* DESCRIPTION 29A 01320I 35 63 PIDESC 01330I* NON-INVENTORY DESCRIPTION 70A 01340I 10 79 PINDES 01350I* DATE LAST RECEIPT 6N 01360I 80 850PIDLR 01370I* QTY RECEIVED 7P 01380I P 86 890PIQRCD 01390I* QTY TO STK,SCRAP,RTV 7P 01400I P 90 930PIQSTK 01410I* PRICE CODE 1A 01420I* L = LOT 01430I* N = NO CHARGE 01440I 94 94 PILOT 01450I* PRICE 9.3P 01460I P 95 993PI$PRC 01470I* WORK ORDER # 9A 01480I 100 108 PIWO 01490I 100 105 PIWOP 01500I 106 1080PIWOD ÐÐ01510I* VENDOR # 5P (FROM POMAST) 01520I P 109 1110PIVEND 01530I* LAST RCVG LOG # USED 2N 01540I 112 1130PILLOG 01550I* SCHEDULE DATES 6N X 26 (Y,M,D) 01560I 114 269 PID 01570I* SCHED QTYS 7P X 26 01580I P 270 373 PIQ 01590I* RECORD STATUS 1A 01600I 384 384 PISTAT 01610I******************************************************************** 01620IVMMAST VM 01630I 26 60 VMNAME 01640I******************************************************************** 01650IPMMST2 PM 01660I 31 59 PMDESC 01670I P 185 219 PA$ 01680I P 220 2230PMSLOT 01690I P 224 2283PMSSUH 01700I P 229 2333PMSRH 01710I 234 2390PMSDAT 01720I 240 240 PMSCCD 01730I P 241 2442PMOSAL 01740I P 489 4933PMOSUC 01750I P 525 536 AHR ÐÐ01760I P 537 542 ADP 01770I 674 674 PMSTAT 01780C******************************************************************** 01790C* INITIALIZE 01800C EXSR SR101 1-TIME INIT 01810C*------------------------------------------------------------------ 01820C START TAG 01830C* SET-UP 1ST FIELD NO. 01840C EXSR SR70 CLEAR PAGE 01850C EXSR SR71 PUT HEADING 01860C MOVE ' ' DUN INIT EDIT ARRAY 01870C Z-ADD1 F 30 FIELD # 01880C GOTO READ 01890C*------------------------------------------------------------------ 01900C NEXT TAG 01910C* SET-UP NEXT FIELD NO. 01920C 1 ADD F F FIELD # 01930C*----------------------------------------------------------------- 01940C READ TAG 01950C* READ DATA FROM TERMINAL. 01960C SETOF 909677 01970C EXSR SR102 VALIDATE FIELD # 01980C 55 GOTO UPDATE DONE 01990C Z-ADD1 W 02000C EXSR SR207 CHECK TRAN CODE ÐÐ02010C Z-ADD10 W 02020C EXSR SR207 CHECK PRICE CODE 02030C EXSR SR201 IDENTIFY-F 02040C 05 02050COR 07 02060COR 10 02070COR 12 02080COR 13 GOTO EDIT PO ITEM FIELDS 02090C SETON 69 02100C EXSR SR72 PROMPT 02110C SETOF 69 02120C EXSR SR75 READ TERMINAL 02130C 98 GOTO GOODBY GOODBY 02140C 94 GOTO MENU MENU REQUEST 02150C 90 EXSR SR72 REWRITE INPUT DATA 02160C 93 GOTO NEWITM NEW ITEM 02170C 92 GOTO JUMP FIELD JUMP REQST 02180C 91 GOTO NEXT SKIP FORWARD 02190C 89 F SUB 1 F SKIP BACKWARD 02200C 89 GOTO READ " " 02210C 88 SETOF 90 SPACE FILL 02220C 88 SETON 77 " " 02230C 87 GOTO START 02240C 86 GOTO UPDATE UPDATE 02250C 85 GOTO READ REPEAT ÐÐ02260C 96 GOTO ERROR ERROR 02270C N77 GOTO EDIT NO DATA INPUT 02280C*------------------------------------------------------------------ 02290C PROCES TAG 02300C* PROCESS INPUT DATA 02310C EXSR SR103 MOVE DATA 02320C*------------------------------------------------------------------- 02330C EDIT TAG 02340C N96 EXSR SR104 EDIT DATA 02350C EXSR SR72 REWRITE DATA 02360C 96 GOTO ERROR ERROR 02370C GOTO NEXT 02380C*------------------------------------------------------------------ 02390C UPDATE TAG 02400C* UPDATE DATA BASE. 02410C EXSR SR105 FINAL EDIT 02420C 96 GOTO ERROR ERROR 02430C EXSR SR106 UPDATE 02440C 96 GOTO ERROR ERROR 02450C GOTO NEWITM 02460C*------------------------------------------------------------------- 02470C JUMP TAG 02480C* SET-UP JUMP TO REQUESTED FIELD 02490C 1 ADD W W 30 02500C W COMP 70 54 ÐÐ02510C 54 Z-ADD318 M 50 96 FLAG ERROR 02520C 54 GOTO ERROR BAD ESC 02530C MOVE ' ' W3A 3 02540C MOVEAA70,W W3A 02550C Z-ADD3 W2N 20 02560C EXIT SUBRAJ R. JUSTIFY 02570C RLABL W2N 02580C RLABL W3A 02590C MOVE W3A F NEW FIELD # 02600C GOTO READ 02610C*-------------------------------------------------------------------- 02620C ERROR TAG 02630C EXSR SR89 GET MSG 02640C GOTO READ 02650C*------------------------------------------------------------------ 02660C NEWITM TAG 02670C* SET-UP LINK FOR NEW ITEM 02680C MOVEL'Q001AP' PROG 8 02690C GOTO END 02700C*------------------------------------------------------------------- 02710C MENU TAG 02720C* SET-UP LINK TO MENU 02730C MOVELCRMENU PROG 02740C GOTO END 02750C*-------------------------------------------------------------------- ÐÐ02760C GOODBY TAG 02770C* LINK TO SIGN-OFF 02780C MOVEL'GOODBY' PROG 02790C GOTO END 02800C*------------------------------------------------------------------- 02810C END TAG 02820C EXSR SR97 UPDATE CRTFILE 02830C EXITFCHAIN LINK TO NEXT PROG 02840C RLABL PROG 02850C********************************************************************* 02860CSR SR1 BEGSR 02870C* EDIT TRAN CODE. 02880CSR EXSR SR203 CLASSIFY TRAN 02890CSRN60N61N62 Z-ADD300 M 50 96 FLAG ERROR 02900CSR ENDSR 02910C******************************************************************* 02920CSR SR2 BEGSR 02930C* EDIT PO PRIME. 02940CSR MOVE TPOP W5N 50 02950CSR W5N COMP 0 54 02960CSRN54 Z-ADD621 M 96 FLAG ERROR 02970CSR ENDSR 02980C********************************************************************* 02990CSR SR3 BEGSR 03000C* EDIT PO ITEM. ÐÐ03010CSR SETOF 70 03020CSR MOVELTPOP TPO 9 03030CSR MOVE TPOD TPO 03040CSR TPOD COMP 0 54 03050CSRN54 Z-ADD47 M 96 FLAG ERROR 03060CSRN54 GOTO END3 03070CSR TPO CHAINPOITEM 60 GET POITEM 03080CSRN60 PISTAT COMP 'D' 60 03090CSR 60 Z-ADD502 M 96 FLAG ERROR 03100CSR 60 GOTO END3 03110CSR PIWOP COMP ' 12100' 70 03120CSRN70 PIWOP COMP ' 14100' 70 03130CSRN70 PIWOP COMP ' 14600' 70 03140CSR EXSR SR203 CLASSIFY TRAN 03150CSRN60 GOTO END3 NOT ADD 03160C* PICK UP DATA FROM POITEM FILE 03170CSR Z-ADDPIVEND VCVEND 03180CSR MOVE PIWOP VCWOP 03190CSR Z-ADDPIWOD VCWOD 03200CSR MOVE PIWO VCWO 03210CSR 70 Z-ADDPIPN VCPN 03220CSR 70 MOVE PIVPN VCVPN 03230CSR 70 MOVE PIDESC VCDESC 03240CSRN70 MOVE PINDES VCNDES 03250CSR MOVE PILOT VCPCOD PRICE CODE ÐÐ03260CSR Z-ADDPI$PRC VC$BIL UNIT PRICE 03270C* EDIT DATA PICKED UP FROM PO ITEM 03280CSR EXSR SR5 EDIT VEND 03290CSR 70N96 EXSR SR7 EDIT PART # 03300CSRN96 EXSR SR10 EDIT PRICE CODE 03310CSRN96 EXSR SR12 EDIT UNIT COST 03320CSRN96 EXSR SR13 EDIT EXTENDED COST 03330CSR EXSR SR71 DISPLAY 03340CSR GOTO END3 03350CSR END3 ENDSR 03360C********************************************************************** 03370CSR SR4 BEGSR 03380C* EDIT INVOICE #. 03390CSR TINV COMP BLK12 54 03400CSRN54 Z-ADD622 M 96 FLAG ERROR 03410CSRN54 GOTO END4 03420CSR EXSR SR80 GET APVCLEAR 03430CSR 30 NOT ON FILE 03440COR 31 GOTO T4B DELETED 03450CSR EXSR SR203 CLASSIFY TRAN 03460CSR 60 Z-ADD301 M 96 FLAG DUPLICATE 03470CSR GOTO END4 03480C*------------------------------------------------------------------- 03490CSR T4B TAG 03500C* NO ACTIVE AP REC. ÐÐ03510CSR EXSR SR203 CLASSIFY TRAN 03520CSRN60 Z-ADD623 M 96 FLAG NO MATCH 03530CSR END4 ENDSR 03540C*********************************************************************** 03550CSR SR5 BEGSR 03560C* EDIT VENDOR #. 03570CSR VCVEND CHAINVMMAST 60 03580CSR 60 Z-ADD504 M 96 FLAG ERROR 03590CSR ENDSR 03600C*********************************************************************** 03610CSR SR7 BEGSR 03620C* EDIT PART #. 03630CSR MOVELVCPN W12A 12 03640CSR MOVE ' ' W12A 03650CSR W12A CHAINPMMST2 60 03660CSRN60 PMSTAT COMP 'D' 60 03670CSR 60 Z-ADD291 M 96 03680CSR ENDSR 03690C******************************************************************** 03700CSR SR10 BEGSR 03710C* EDIT PRICE CODE. 03720CSR VCPCOD COMP 'U' 41 03730CSR VCPCOD COMP 'L' 42 03740CSR VCPCOD COMP 'N' 43 03750CSRN41N42N43 Z-ADD624 M 96 FLAG ERROR ÐÐ03760CSR 96 Z-ADD11 F 03770CSR ENDSR 03780C******************************************************************** 03790CSR SR11 BEGSR 03800C* EDIT QTY BILLED. 03810CSR 41 VCQBIL COMP 0 54 03820CSR 41N54 Z-ADD184 M 96 FLAG ERROR 03830CSR 96 Z-ADD11 F 03840CSR ENDSR 03850C******************************************************************** 03860CSR SR12 BEGSR 03870C* EDIT UNIT COST BILLED. 03880CSRN41 Z-ADD0 VC$BIL 03890CSRN41 GOTO END12 03900CSR DUN,11 COMP ' ' 54 03910CSRN54 EXSR SR11 EDIT PRICE CODE 03920CSR 96 Z-ADD11 F 03930CSR 96 GOTO END12 03940CSR VC$BIL COMP 0 54 03950CSRN54 Z-ADD625 M 96 FLAG ERROR 03960CSRN54 GOTO END12 03970CSR VCQBIL MULT VC$BIL VCXBIL EXT $ 03980CSR END12 ENDSR 03990C******************************************************************** 04000CSR SR13 BEGSR ÐÐ04010C* EDIT XTEND $ BILLED. 04020CSR 42 VCXBIL COMP 0 54 04030CSR 42N54 Z-ADD625 M 96 FLAG ERROR 04040CSRN96 DUN,11 COMP 'B' 54 04050CSRN96N54 EXSR SR11 EDIT PRICE CODE 04060CSR 96 GOTO END13 04070CSR 42 VCXBIL DIV VCQBIL VC$BIL CALC UNIT COST 04080CSR END13 ENDSR 04090C******************************************************************** 04100CSR SR68 BEGSR 04110CSR EXITFQCLF LF 04120CSR ENDSR 04130C************************************************************** 04140CSR SR69 BEGSR 04150CSR EXITFQXYPOS POSITION CURSOR 04160CSR RLABL W6A 04170CSR ENDSR 04180C******************************************************************** 04190CSR SR70 BEGSR 04200C* CLEAR PAGE. 04210CSR MOVE '120001' W6A 04220CSR EXSR SR69 MOVE CURSOR 04230CSR EXSR SR68 LF 04240CSR Z-ADD1 X 30 04250C*------------------------------------------------------------------- ÐÐ04260CSR T70A TAG 04270CSR EXSR SR68 LF 04280CSR 1 ADD X X 04290CSR X COMP 30 54 04300CSRN54 GOTO T70A 04310CSR ENDSR 04320C******************************************************************** 04330CSR SR71 BEGSR 04340C* PUT HEADINGS TO TERMINAL 04350CSR SETON 71 04360CSR EXCPT PUT HEADINGS 04370CSR SETOF 71 04380CSR ENDSR 04390C********************************************************************* 04400CSR SR72 BEGSR 04410C* PUT DATA TO TERMINAL 04420CSR 91 ADD F W3N 30 04430CSR MOVELW3N W6A 04440CSR MOVE '001' W6A 04450CSR EXSR SR69 MOVE CURSOR 04460CSR SETON 72 04470CSR EXCPT PUT DATA 04480CSR SETOF 72 04490CSR ENDSR 04500C******************************************************************* ÐÐ04510CSR SR75 BEGSR 04520C* READ FROM TERMINAL 04530CSR SETOF 779096 04540CSR SETOF 939291 04550CSR SETOF 898887 04560CSR SETOF 8685 04570CSR MOVE BIT,36 BUFLGT 2 READ BUFFER LGTH 04580CSR MOVE BLK70 W70A 70 BUFFER 04590CSR 92 ADD F W3N 04600CSR MOVELW3N W6A 04610CSR MOVE '037' W6A 04620CSR EXSR SR69 MOVE CURSOR 04630CSR EXITFQBELL RING BELL 04640CSR EXITFQWREED READ FROM TERMINAL 04650CSR RLABL W70A READ BUFFER 04660CSR RLABL BUFLGT READ BUFFER LGTH 04670CSR MOVEAW70A A70 INPUT DATA ARRAY 04680CSR MOVE BLK70 W70A INIT INPUT ARRAY 04690CSR Z-ADD1 W 30 04700CSR '\' LOKUPA70,W 90 FLAG ESC 04710CSRN90 GOTO T75B NOT ESC 04720CSR 1 ADD W W 04730CSR W COMP 70 54 04740CSR 54 GOTO T75A BAD ESC 04750CSR A70,W COMP 'G' 98 GOODBY ÐÐ04760CSR A70,W COMP 'E' 94 MENU 04770CSR A70,W COMP 'N' 93 NEW ITEM 04780CSR A70,W COMP 'J' 92 JUMP 04790CSR A70,W COMP 'F' 91 SKIP FRWRD 04800CSR A70,W COMP 'B' 89 SKIP BKWRD 04810CSR A70,W COMP 'S' 88 SPACE FILL 04820CSR A70,W COMP 'H' 87 HOME 04830CSR A70,W COMP 'U' 86 UPDATE 04840CSR A70,W COMP 'R' 85 REPEAT 04850CSR 98 04860COR 94 04870COR 93 04880COR 92 04890COR 91 04900COR 89 04910COR 88 04920COR 87 04930COR 86 04940COR 85 GOTO END75 GOOD ESC 04950C*------------------------------------------------------------------ 04960CSR T75A TAG 04970C* FLAG BAD ESC INPUT 04980CSR Z-ADD318 M 96 FLAG ERROR 04990CSR GOTO END75 05000C*-------------------------------------------------------------------- ÐÐ05010CSR T75B TAG 05020C* MOVE DATA 05030CSR Z-ADD1 W 05040CSR ' ' LOKUPA70,W 77 05050CSR 77 MOVEAA70,W W70A INPUT DATA 05060C*-------------------------------------------------------------------- 05070CSR END75 TAG 05080C* INIT PREV ERROR MSG. 05090CSR MOVE BLK35 MGTEXT 05100CSR ENDSR 05110C******************************************************************** 05120CSR SR76 BEGSR 05130C* PUT SCHEDULE HEADING 05140CSR 40 GOTO T76B 05150CSR MOVE '104001' W6A 6 05160CSR EXSR SR69 MOVE CURSOR 05170CSR SETON 75 05180CSR EXCPT PUT SCHED HEADING 05190CSR SETON 75 05200C*--------------------------------------------------------------------- 05210CSR T76B TAG 05220C* PUT SCHEDULE DATA TO CRT 05230CSR S ADD 105 W3N 30 05240CSR S COMP 13 54 05250CSR 54 W3N SUB 13 W3N ÐÐ05260CSR 54 MOVE '060' W6A 05270CSRN54 MOVE '001' W6A 05280CSR W3N SUB 1 W3N 05290CSR MOVELW3N W6A 05300CSR EXSR SR69 MOVE CURSOR 05310CSR SETON 76 05320CSR EXCPT PUT DATA 05330CSR SETOF 76 05340CSR SETON 40 05350CSR ENDSR 05360C****************************************************************** 05370CSR SR80 BEGSR 05380C* GET MASTER RECORD 05390CSR SETOF 31 05400CSR MOVELTPOP TPO 9 05410CSR MOVE TPOD TPO 05420CSR MOVELTPO W21A 21 05430CSR MOVE TINV W21A 05440CSR W21A CHAINAPVCLEAR 30 GET MASTER 05450CSRN30 VCSTAT COMP 'D' 31 FLAG DELETE 05460CSR ENDSR 05470C********************************************************************** 05480CSR SR81 BEGSR 05490C* ADD NEW MASTER TO FILE 05500CSR SETON 81 ÐÐ05510CSR EXCPT ADD MASTER 05520CSR SETOF 81 05530CSR ENDSR 05540C******************************************************************** 05550CSR SR82 BEGSR 05560C* REWRITE MASTER. 05570CSR SETON 82 05580CSR EXCPT REWRITE MASTER 05590CSR SETOF 82 05600CSR ENDSR 05610C******************************************************************** 05620CSR SR89 BEGSR 05630C* GET MESSAGE MASTER. 05640CSR M CHAINMGFILE 54 05650CSR 54 MOVE BLK35 MGTEXT 05660CSR 54 MOVELM MGTEXT 05670CSR 54 MOVE MES,1 MGTEXT 05680CSR ENDSR 05690C******************************************************************** 05700CSR SR97 BEGSR 05710C* UPDATE CRTFILE. 05720CSR SETON 97 05730CSR EXCPT UPDATE CRTFILE 05740CSR SETOF 97 05750CSR ENDSR ÐÐ05760C*********************************************************************** 05770CSR SR101 BEGSR 05780C* 1-TIME INITIALIZE 05790CSR MOVE BIT,1 NUL 05800CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05810CSR Z-ADD16 FLIMIT 30 TOTAL NUMB FIELDS 05820CSR MOVE ' ' BLK70 70 05830C* GET PORT # AND CRTFILE 05840CSR MOVE ' ' W8A 8 05850CSR Z-ADD0 W2N 20 05860CSR Z-ADD0 W1N 10 05870CSR MOVE ' ' W2A 2 05880CSR EXITFPGMINX GET PORT # 05890CSR RLABL W8A 05900CSR RLABL W2N 05910CSR RLABL W1N 05920CSR RLABL W2A 05930CSR MOVE W2A PORT 20 PORT NO. 05940CSR PORT COMP 0 54 05950CSRN54 Z-ADD25 PORT DEFAULT 05960CSR PORT CHAINCRTFILE H9 05970C* DEFINE WORK FIELDS,ETC. 05980CSR MOVE ' ' BLK35 35 05990CSR MOVE ' ' BLK12 12 06000CSR MOVE ' ' BLK15 15 ÐÐ06010CSR Z-ADD0 ZERO7 70 06020CSR ENDSR 06030C********************************************************************** 06040CSR SR102 BEGSR 06050C* VALIDATE FIELD NO. 06060CSR F COMP 0 54 06070CSRN54 Z-ADD1 F 06080CSR F COMP FLIMIT 55 06090CSR 55 Z-ADD1 F 06100CSR ENDSR 06110C******************************************************************** 06120CSR SR103 BEGSR 06130C* MOVE INPUT DATA 06140CSR EXSR SR201 IDENTIFY-F 06150CSR EXSR SR202 R. JUSTIFY 06160CSR 01 MOVELW70A TRAN 1 TRAN CODE 06170CSR 02 EXSR SR211 PO PRIME 06180CSR 03 MOVE W10A TPOD 30 PO DASH 06190CSR 04 MOVELW70A TINV 12 INVOICE 06200CSR 05 MOVE W10A VCVEND VENDOR 06210CSR 06 EXSR SR210 WO PRIME 06220CSR 07 70 MOVE W10A VCPN PART # 06230CSR 08 70 MOVELW70A VCVPN VEND PART # 06240CSR 09N70 MOVELW70A VCNDES NON-INV DESCR 06250CSR 09 70 MOVELW70A VCDESC INV DESCR ÐÐ06260CSR 10 MOVELW70A VCPCOD PRICE CODE 06270CSR 11 MOVE W10A VCQBIL QTY BILLED 06280CSR 12 MOVE W10A VC$BIL UNIT PRICE 06290CSR 13 MOVE W10A VCXBIL LOT PRICE 06300CSR 14 MOVE W10A VCDDIS DISCOUNT DATE 06310CSR 15 MOVE W10A VCDPCT DISCOUNT PCT 06320CSR 16 MOVE W10A VCDPAY PAYMENT DATE 06330CSR MOVE ' ' DUN,F EDIT FLAG 06340CSR ENDSR 06350C******************************************************************** 06360CSR SR104 BEGSR 06370C* EDIT INPUT DATA 06380CSR 01 EXSR SR1 06390CSR 02 EXSR SR2 06400CSR 03 EXSR SR3 06410CSR 04 EXSR SR4 06420CSR 05 DUN,5 COMP ' ' 54 06430CSR 05N54 EXSR SR5 06440CSR 07 70 DUN,7 COMP ' ' 54 06450CSR 07 70N54 EXSR SR7 06460CSR 10 EXSR SR10 06470CSR 11 EXSR SR11 06480CSR 12 EXSR SR12 06490CSR 13 EXSR SR13 06500CSR 96 MOVE ' ' DUN,F EDIT FLAG ÐÐ06510CSRN96 MOVE 'X' DUN,F 06520CSR ENDSR 06530C*********************************************************************** 06540CSR SR105 BEGSR 06550C* FINAL EDIT 06560CSR SETOF 77 06570CSR SETON 79 FINAL EDIT FLAG 06580CSR Z-ADD1 F 96 06590C*-------------------------------------------------------------------- 06600CSR T105A TAG 06610CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06620CSRN54 GOTO END105 06630CSR EXSR SR201 IDENTIFY-F 06640CSR EXSR SR104 EDIT 06650CSRN96 GOTO T105A 06660C*-------------------------------------------------------------------- 06670CSR END105 TAG 06680CSR SETOF 79 06690CSR ENDSR 06700C******************************************************************** 06710CSR SR106 BEGSR 06720C* UPDATE DATA BASE. 06730CSR EXSR SR203 CLASSIFY TRAN 06740CSR 60 GOTO T106A ADD TRAN 06750CSR 61 GOTO T106D CHANGE TRAN ÐÐ06760CSR 62 GOTO T106F DELETE TRAN 06770C* FLAG BAD TRAN CODE 06780CSR Z-ADD300 M 96 FLAG ERROR 06790CSR Z-ADD1 F FIELD # 06800CSR GOTO END106 06810C*------------------------------------------------------------------- 06820CSR T106A TAG 06830C* ADD TRANSACTION 06840CSR 30 GOTO T106B NOT ON FILE 06850CSR 31 GOTO T106C DELETED MASTER 06860C* FLAG DUPLICATE ADD ERROR 06870CSR Z-ADD301 M 96 FLAG ERROR 06880CSR Z-ADD1 F FIELD # 06890CSR GOTO END106 06900C*--------------------------------------------------------------------- 06910CSR T106B TAG 06920C* ADD-- MAST NOT ON FILE 06930CSR EXSR SR81 ADD NEW MASTER 06940CSR GOTO END106 06950C*--------------------------------------------------------------------- 06960CSR T106C TAG 06970C* ADD-- MAST IS DELETED 06980CSR MOVE 'A' VCSTAT RECORD STATUS 06990CSR EXSR SR82 REWRITE MAST 07000CSR GOTO END106 ÐÐ07010C*---------------------------------------------------------------------- 07020CSR T106D TAG 07030C* CHANGE TRANSACTION. 07040CSRN30N31 GOTO T106E GOT IT 07050C* FLAG NO MASTER ERROR 07060CSR Z-ADD302 M 96 FLAG ERROR 07070CSR Z-ADD1 F FIELD # 07080CSR GOTO END106 07090C*----------------------------------------------------------------------- 07100CSR T106E TAG 07110C* REWRITE MASTER 07120CSR EXSR SR82 REWRITE MAST 07130CSR GOTO END106 07140C*----------------------------------------------------------------------- 07150CSR T106F TAG 07160C* DELETE TRANSACTION 07170CSRN30N31 GOTO T106G GOT IT 07180C* FLAG NO MASTER ERROR 07190CSR Z-ADD302 M 96 FLAG ERROR 07200CSR Z-ADD1 F FIELD # 07210CSR GOTO END106 07220C*----------------------------------------------------------------------- 07230CSR T106G TAG 07240C* DELETE MASTER. 07250CSR EXSR SR204 CHECK FOR ACTIVITY ÐÐ07260CSR 96 Z-ADD1 F FIELD # 07270CSR 96 GOTO END106 ERROR 07280CSR MOVE 'D' VCSTAT RECORD STATUS 07290CSR EXSR SR82 REWRITE MASTER 07300CSR END106 ENDSR 07310C************************************************************************ 07320CSR SR201 BEGSR 07330C* IDENTIFY FIELD NO. 07340CSR F COMP 1 01 07350CSR F COMP 2 02 07360CSR F COMP 3 03 07370CSR F COMP 4 04 07380CSR F COMP 5 05 07390CSR F COMP 6 06 07400CSR F COMP 7 07 07410CSR F COMP 8 08 07420CSR F COMP 9 09 07430CSR F COMP 10 10 07440CSR F COMP 11 11 07450CSR F COMP 12 12 07460CSR F COMP 13 13 07470CSR F COMP 14 14 07480CSR F COMP 15 15 07490CSR F COMP 16 16 07500CSR ENDSR ÐÐ07510C********************************************************************** 07520CSR SR202 BEGSR 07530C* RIGHT JUSTIFY 07540CSR F LOKUPNUM 54 07550CSRN54 GOTO END202 NOT NUMERIC FIELD 07560CSR Z-ADD10 W2N 20 07570CSR MOVELW70A W10A 10 07580CSR EXIT SUBRAJ R. JUSTIFY 07590CSR RLABL W2N 07600CSR RLABL W10A 07610CSR END202 ENDSR 07620C*********************************************************************** 07630CSR SR203 BEGSR 07640C* CLASSIFY TRAN CODE 07650CSR TRAN COMP 'A' 60 ADD 07660CSR TRAN COMP 'C' 61 CHANGE 07670CSR TRAN COMP 'D' 62 DELETE 07680CSR MOVE BLK12 TRNNAM 6 07690CSR 60 MOVEL'ADD' TRNNAM 07700CSR 61 MOVEL'CHANGE' TRNNAM 07710CSR 62 MOVEL'DELETE' TRNNAM 07720CSR ENDSR 07730C******************************************************************** 07740CSR SR204 BEGSR 07750C* CHECK FOR ACTIVITY. ÐÐ07760CSR VCQMAT COMP 0 54 07770CSRN54 VC$MAT COMP 0 54 07780CSRN54 VC$TRS COMP 0 54 07790CSRN54 VC$VAR COMP 0 54 07800CSR 54 Z-ADD29 M 96 FLAG ERROR 07810CSR ENDSR 07820C**************************************************************************07830CSR SR205 BEGSR 07840C* INIT APVCLEAR FIELDS. 07850CSR MOVE BLK12 VCPO 07860CSR MOVE BLK12 VCPOP 07870CSR Z-ADD0 VCPOD 07880CSR MOVE BLK15 VCINV 07890CSR Z-ADD0 VCVEND 07900CSR MOVE BLK12 VCWO 07910CSR MOVE BLK12 VCWOP 07920CSR Z-ADD0 VCPN 07930CSR MOVE BLK15 VCVPN 07940CSR MOVE BLK35 VCDESC 07950CSR MOVE BLK70 VCNDES 07960CSR Z-ADD0 VCDLT 07970CSR Z-ADD0 VCQBIL 07980CSR Z-ADD0 VC$BIL 07990CSR Z-ADD0 VCXBIL 08000CSR Z-ADD0 VCDDIS ÐÐ08010CSR Z-ADD0 VCDPCT 08020CSR Z-ADD0 VCDPAY 08030CSR Z-ADD0 VCQMAT 08040CSR Z-ADD0 VC$MAT 08050CSR Z-ADD0 VCBSTD 08060CSR Z-ADD0 VCRSTD 08070CSR Z-ADD0 VC$TRS 08080CSR Z-ADD0 VC$VAR 08090CSR MOVE ' ' VCPCOD 08100CSR MOVE ' ' VCSTAT 08110CSR ENDSR 08120C******************************************************************** 08130CSR SR207 BEGSR 08140C* CHECK FOR ILLEGAL FIELD BYPASS. 08150CSR F COMP W 54 08160CSR 54 DUN,W COMP ' ' 55 08170CSR 54N55 Z-ADDW F 08180CSR ENDSR 08190C******************************************************************** 08200CSR SR208 BEGSR 08210C* DISPLAY SELECTED VENDOR. 08220CSR Z-ADDF SAVEF 30 08230CSR Z-ADDW3N F 08240CSR EXSR SR201 IDENTIFY-F 08250CSR EXSR SR72 DISPLAY ÐÐ08260CSR Z-ADDSAVEF F 08270CSR EXSR SR201 08280CSR ENDSR 08290C******************************************************************** 08300CSR SR210 BEGSR 08310C* BUILD WORK ORDER #. 08320CSR 88 MOVE BLK70 W70A 08330CSR MOVEAW70A A70 08340CSR Z-ADD1 W 08350CSR '-' LOKUPA70,W 54 08360CSRN54 Z-ADD7 W 08370CSR MOVEAA70,W W4A 4 08380CSR 54 MOVEL' ' W4A 08390CSR Z-ADD4 W2N 08400CSR EXIT SUBRAJ R.J. 08410CSR RLABL W2N 08420CSR RLABL W4A 08430CSR MOVE W4A VCWOD 30 WO DASH 08440CSR MOVEABLK70 A70,W 08450CSR A70,1 COMP '0' 54 54 08460CSR 54 MOVEAA70,1 W5A 5 08470CSR 54 MOVEL' ' VCWOP 6 08480CSRN54 MOVEAA70 VCWOP 08490CSRN54 MOVE VCWOP W5A 08500CSR Z-ADD5 W2N ÐÐ08510CSR EXIT SUBRAJ R.J. 08520CSR RLABL W2N 08530CSR RLABL W5A 08540CSR MOVE W5A VCWOP 08550CSR ENDSR 08560C******************************************************************** 08570CSR SR211 BEGSR 08580C* BUILD PO #. 08590CSR MOVEAW70A A70 08600CSR A70,1 COMP '0' 54 54 08610CSRN54 GOTO T211A NON-NUMERIC INPUT 08620CSR MOVEAA70,1 W5A 08630CSR Z-ADD5 W2N 08640CSR EXIT SUBRAJ RJ 08650CSR RLABL W2N 08660CSR RLABL W5A 08670CSR MOVEL' ' TPOP 6 08680CSR MOVE W5A TPOP 08690CSR GOTO END211 08700C*------------------------------------------------------------------- 08710CSR T211A TAG 08720CSR MOVELW70A TPOP 08730CSR MOVE TPOP W5A 08740CSR Z-ADD5 W2N 08750CSR EXIT SUBRAJ R.J. ÐÐ08760CSR RLABL W2N 08770CSR RLABL W5A 08780CSR MOVE W5A TPOP 08790CSR END211 ENDSR 08800C******************************************************************** 08810CSR SR252 BEGSR 08820C* APPLY RCPTS TO SCHEDULE. 08830CSR Z-ADD0 RCD 08840CSR Z-ADD1 A 30 08850CSR Z-ADDPIQRCD SAVQTY 70 08860C*------------------------------------------------------------------- 08870CSR T252A TAG 08880CSR ZERO7 LOKUPPIQ,A 54 08890CSRN54 GOTO T252C 08900CSR Z-ADDPIQ,A W7N 70 08910CSR SETOF 57 08920CSR SAVQTY COMP W7N 545556 08930CSR 54 Z-ADDW7N RCD,A 08940CSR 54 SAVQTY SUB W7N SAVQTY 57 08950CSR 54 Z-ADD0 W7N 08960CSR 55 Z-ADDSAVQTY RCD,A 08970CSR 55 W7N SUB SAVQTY W7N 08980CSR 55 Z-ADD0 SAVQTY 57 08990CSR 56 Z-ADDSAVQTY RCD,A 09000CSR 56 Z-ADD0 SAVQTY 57 ÐÐ09010CSR 56 Z-ADD0 W7N 09020CSR 57 1 ADD A A 09030CSR 57 A COMP 26 54 09040CSR 57 GOTO T252A 09050CSR GOTO END252 09060C*------------------------------------------------------------------- 09070CSR T252C TAG 09080CSR Z-ADD1 A 09090CSR ZERO7 LOKUPPIQ,A 54 09100CSR 54 Z-ADDSAVQTY RCD,A 09110CSR END252 ENDSR 09120C******************************************************************** 09130CSR SR253 BEGSR 09140C* DISPLAY SCHEDULE 09150CSR Z-ADD0 S 30 09160CSR PIQ SUB RCD OPN 09170CSR SETOF 40 09180CSR MOVE BLK35 MGTEXT 09190C*------------------------------------------------------------------ 09200CSR T253A TAG 09210CSR 1 ADD S S 09220CSR S COMP 13 54 09230CSR 54 GOTO T253C 09240CSR PIQ,S COMP 0 54 09250CSRN54 RCD,S COMP 0 54 ÐÐ09260CSR 13 ADD S Y 30 09270CSRN54 PIQ,Y COMP 0 54 09280CSRN54 RCD,Y COMP 0 54 09290CSRN54 GOTO T253A 09300CSR EXSR SR76 PUT SCHEDULE 09310CSR GOTO T253A 09320C*------------------------------------------------------------------- 09330CSR T253C TAG 09340C* PUT TOTALS. 09350CSR XFOOTPIQ TOTPIQ 80 09360CSR XFOOTRCD TOTRCD 80 09370CSR TOTPIQ SUB TOTRCD TOTOPN 80 09380CSR SETON 74 09390CSR EXCPT PUT TOTALS 09400CSR SETOF 74 09410CSR ENDSR 09420O******************************************************************** 09430OTERM132 E 71 09440O BIT,28 1 09450O 8 '8091001' 09460O 74 'ACCOUNTS PAYABLE' 09470O 90 '- INVOICE INPUT' 09480O UDATE 18 ' - - ' 09490O*------------------------------------------------------------------- 09500O E 71 ÐÐ09510O 1 ' ' 09520O*------------------------------------------------------------------- 09530O E 71 09540O OR 72 01 09550O DOT 33 09560O 4 '(1)' 09570O 23 'TRAN CODE (A,C,D)' 09580O TRAN 36 09590O TRNNAM 44 09600O MGTEXT 132 09610O*------------------------------------------------------------------- 09620O E 71 09630O OR 72 02 09640O DOT 33 09650O 4 '(2)' 09660O 22 'PURCHASE ORDER #' 09670O TPOP 41 09680O MGTEXT 132 09690O*------------------------------------------------------------------ 09700O E 71 09710O OR 72 03 09720O DOT 33 09730O 4 '(3)' 09740O 17 'P.O. ITEM #' 09750O TPOD Z 38 ÐÐ09760O MGTEXT 132 09770O*------------------------------------------------------------------- 09780O E 71 09790O OR 72 04 09800O DOT 33 09810O 4 '(4)' 09820O 15 'INVOICE #' 09830O TINV 47 09840O MGTEXT 132 09850O*------------------------------------------------------------------- 09860O E 71 09870O OR 72 05 09880O DOT 33 09890O 4 '(5)' 09900O 14 'VENDOR #' 09910O VCVENDZ 40 09920O VMNAME 77 09930O MGTEXT 132 09940O*------------------------------------------------------------------- 09950O E 71 09960O OR 72 06 09970O DOT 33 09980O 4 '(6)' 09990O 24 'WORK ORDER/ACCOUNT' 10000O VCWOP 41 ÐÐ10010O 42 '-' 10020O VCWOD 45 10030O MGTEXT 132 10040O*------------------------------------------------------------------- 10050O E 71 10060O OR 72 07 10070O DOT 33 10080O 4 '(7)' 10090O 19 'DYNAIR PART #' 10100O 70 VCPN 45 ' - - ' 10110O MGTEXT 132 10120O*------------------------------------------------------------------- 10130O E 71 10140O OR 72 08 10150O DOT 33 10160O 4 '(8)' 10170O 19 'VENDOR PART #' 10180O 70 VCVPN 50 10190O MGTEXT 132 10200O*------------------------------------------------------------------- 10210O E 71 10220O OR 72 09 10230O DOT 33 10240O 4 '(9)' 10250O 17 'DESCRIPTION' ÐÐ10260O 70 VCDESC 64 10270O N70 VCNDES 105 10280O*------------------------------------------------------------------- 10290O E 71 10300O OR 72 10 10310O DOT 33 10320O 4 '(10)' 10330O 24 'PRICE CODE (U,L,N)' 10340O VCPCOD 36 10350O* * * * * PCNAM 40 10360O MGTEXT 132 10370O*------------------------------------------------------------------- 10380O E 71 10390O OR 72 11 10400O DOT 33 10410O 4 '(11)' 10420O 21 'QUANTITY BILLED' 10430O VCQBIL2 44 10440O MGTEXT 132 10450O*------------------------------------------------------------------- 10460O E 71 10470O OR 72 12 10480O DOT 33 10490O 4 '(12)' 10500O 16 'UNIT PRICE' ÐÐ10510O VC$BIL2 47 10520O MGTEXT 132 10530O*------------------------------------------------------------------- 10540O E 71 10550O OR 72 13 10560O DOT 33 10570O 4 '(13)' 10580O 20 'EXTENDED PRICE' 10590O VCXBIL2 47 10600O MGTEXT 132 10610O*------------------------------------------------------------------- 10620O E 71 10630O OR 72 14 10640O DOT 33 10650O 4 '(14)' 10660O 19 'DISCOUNT DATE' 10670O VCDDIS 43 ' - - ' 10680O MGTEXT 132 10690O*------------------------------------------------------------------- 10700O E 71 10710O OR 72 15 10720O DOT 33 10730O 4 '(15)' 10740O 16 'DISCOUNT %' 10750O VCDPCTZ 38 ÐÐ10760O MGTEXT 132 10770O*------------------------------------------------------------------- 10780O E 71 10790O OR 72 16 10800O DOT 33 10810O 4 '(16)' 10820O 24 'SCHEDULED PAY DATE' 10830O VCDPAY 43 ' - - ' 10840O MGTEXT 132 10850O*--------------------------------------------------------------- 10860O E 75 10870O* SCHEDULE HEADINGS 10880O 8 'DUE-DATE' 10890O 19 'SCHED-QTY' 10900O 30 'QTY-RECVD' 10910O 41 'QTY-OPEN' 10920O 62 'DUE-DATE' 10930O 73 'SCHED-QTY' 10940O 85 'QTY-RECVD' 10950O 95 'QTY-OPEN' 10960O*------------------------------------------------------------------ 10970O E 76 10980O* SCHEDULE DATA 10990O PID,S 8 ' - - ' 11000O PIQ,S 2 19 ÐÐ11010O RCD,S 2 30 11020O OPN,S K 41 11030O PID,Y 62 ' - - ' 11040O RCD,Y 2 85 11050O OPN,Y K 96 11060O MGTEXT 132 11070O*------------------------------------------------------------------ 11080O E 74 11090O* PUT SCHEDULE TOTALS 11100O NUL 132 11110O BIT,28 1 11120O 8 '8120056' 11130O 16 'TOTALS' 11140O TOTPIQ2 26 11150O 27 ' ' 11160O TOTRCD2 37 11170O 38 ' ' 11180O TOTOPNK 49 11190O BIT,28 131 11200O 132 'K' 11210O******************************************************************** 11220OAPVCLEAREADD 81 11230O TPO 9 11240O TINV 21 11250O VCVEND 24P ÐÐ11260O VCWO 33 11270O VCPN 43 11280O VCVPN 58 11290O VCDESC 87 11300O VCNDES 103 11310O VCDLT 109 11320O VCQBIL 113P 11330O VC$BIL 119P 11340O VCXBIL 125P 11350O VCDDIS 131 11360O VCDPCT 133P 11370O VCDPAY 139 11380O VCQMAT 143P 11390O VC$MAT 149P 11400O VCBSTD 154P 11410O VCRSTD 159P 11420O VC$TRS 165P 11430O VC$VAR 170P 11440O VCPCOD 171 11450O 192 'A' 11460O*------------------------------------------------------------------- 11470O E 82 11480O VCVEND 24P 11490O VCWO 33 11500O VCPN 43 ÐÐ11510O VCVPN 58 11520O VCDESC 87 11530O VCNDES 103 11540O VCDLT 109 11550O VCQBIL 113P 11560O VC$BIL 119P 11570O VCXBIL 125P 11580O VCDDIS 131 11590O VCDPCT 133P 11600O VCDPAY 139 11610O VCQMAT 143P 11620O VC$MAT 149P 11630O VCBSTD 154P 11640O VCRSTD 159P 11650O VC$TRS 165P 11660O VC$VAR 170P 11670O VCPCOD 171 11680O VCSTAT 192 11690O* ** NUL ARRAY 011700 011710** A70 ARRAY 011720 011730** NUM ARRAY 011740003 PO DASH 011750ÐÐ005 VENDOR 11760007 PART # 11770011 QTY BILLED 11780012 $ BILLED 11790013 XTENDED $ BILLED 11800014 DISCOUNT DATE 11810015 DISCOUNT % 11820016 PAY DATE 11830** DUN ARRAY 011840 011850** MES ARRAY 011860---MESSAGE NOT ON FILE--- 011870** DOT ARRAY 011880 - - - - - - - - - - - --> 11890** RCD ARRAY 11900 11910** OPN ARRAY 11920 11930/* 11940_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(&… &æX009QM P120282120282(èÈÐ00010H Q009QM00020F* LIST QMMAST - FOLLOW-UP SEQ (X009QM) 00030F* REVISED 7/14/81 5:00 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FQMMAST IC F 160R 8AI 1 DISK 00070FQFKEY ID F 15L14AI 1 DISK 00080FSLMNAME IT F 80 EDISK 00090FTERM22 O F 22 5 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E SLMNAME TABSLM 1 15 3 TABSLN 20 SALESMAN 00130E TABPRD 1 18 2 TABPRN 20 PRODUCT CODE 00140E TABSYS 1 2 1 TABSYN 20 SYST CODE 00150E TABSTC 1 6 1 TABSTN 10 STATUS WORD 00160E TABRES 1 5 1 TABREN 20 REASON LOST 00170E NUL 1 132 1 NULL CHAR 00180E A6 6 6 1 CALL READ PARAM. 00190E A10 10 10 1 A INPUT DATA ARRAY 00200E DUN 2 2 1 A EDIT CMPLT FLAG 00210E MES 1 1 30 00220E* 00230E* 00240E* 00250E QMD 6 7 0 DATE ARRAY ÐÐ00260E BIT 33 1 SCREEN CONTR. CHAR 00270E* 00280E* 00290I******************************************************************* 00300IBITTAB BT 00310I 1 33 BIT 00320I******************************************************************* 00330IMGFILE MG 00340I* MESSAGE FILE. 00350I 1 35 MGTEXT 00360I********************************************************************** 00370IQFKEY QF 00380I* FOLLOW-UP DATE ALT KEY FILE FOR QMMAST (KEY = 1-14) 00390I* FOLLOW-UPD DATE 6A (YRMODAY) 00400I 1 60QFFU 00410I* QUOTE # 5A 00420I 7 11 QFQOTE 00430I* QUOTE ITEM # 3N 00440I 12 140QFITEM 00450I* RECORD STATUS 1A 00460I 15 15 QFSTAT 00470I************************************************************************ 00480IQMMAST QM 00490I* QUOTE MASTER. 00500I* QUOTE # 5A ÐÐ00510I 1 5 QMQOTE 00520I* ITEM # 3N 00530I 6 80QMITEM 00540I* CUSTOMER NAME 20A 00550I 9 28 QMNAME 00560I* CUSTOMER RFQ # 20A 00570I 29 48 QMRFQ 00580I* RFQ ITEM # 4A 00590I 49 52 QMRFQI 00600I* CONTACT 20A 00610I 53 72 QMCONT 00620I* ASSIGNED TO (SALESMAN) 3A 00630I 73 75 QMSLSM 00640I* DATE ARRAY 7P X 6 00650I* 1 = RECEIVED 00660I* 2 = DUE 00670I* 3 = SENT 00680I* 4 = EXPECTED AWARD 00690I* 5 = FOLLOW-UP 00700I* 6 = EXPIRES 00710I P 76 99 QMD 00720I* PRODUCT CLASS 2A 00730I 100 101 QMPCLS 00740I* SYSTEM CODE 1A 00750I 102 102 QMSYST ÐÐ00760I* FILLER 103 103 FFFFFF 00770I* QUOTE AMOUNT 7P ($) 00780I P 104 1070QMAMT 00790I* DELIVERY PROMISED (DAYS ARO) 3P 00800I P 108 1090QMDEL 00810I* STATUS 1A 00820I* E = ENTERED 00830I* N = NO BID 00840I* B = BID 00850I* P = PENDING 00860I* L = LOST 00870I* W = WON 00880I* C = CANCELLED 00890I 110 110 QMSCOD 00900I* PROBABILITY OF AWARD 3.2P 00910I P 111 1122QMPROB 00920I* WON/LOST REASON 1A 00930I 113 113 QMREAS 00940I* REMARKS 40A 00950I 114 153 QMREM 00960I* RECORD STATUS 1A 00970I 160 160 QMSTAT 00980C******************************************************************** 00990C* INITIALIZE 01000C EXSR SR101 1-TIME INIT ÐÐ01010C*------------------------------------------------------------------ 01020C START TAG 01030C* SET-UP 1ST FIELD NO. 01040C SETOF 96 01050C Z-ADD1 F 30 FIELD # 01060C GOTO READ 01070C*------------------------------------------------------------------ 01080C NEXT TAG 01090C* SET-UP NEXT FIELD NO. 01100C 1 ADD F F FIELD # 01110C*----------------------------------------------------------------- 01120C READ TAG 01130C* READ DATA FROM TERMINAL. 01140C EXSR SR102 VALIDATE FIELD # 01150C 55 GOTO UPDATE DONE 01160C EXSR SR201 IDENTIFY-F 01170C SETON 69 01180C EXSR SR72 PROMPT 01190C SETOF 69 01200C EXSR SR75 READ TERMINAL 01210C 98 GOTO GOODBY GOODBY 01220C 94 GOTO MENU MENU REQUEST 01230C N77 EXSR SR104 EDIT INPUT FIELD 01240C 93 GOTO NEWITM NEW ITEM 01250C 96 GOTO ERROR ERROR ÐÐ01260C N77 GOTO NEXT NO DATA INPUT 01270C*------------------------------------------------------------------ 01280C PROCES TAG 01290C* PROCESS INPUT DATA 01300C EXSR SR103 MOVE DATA 01310C N96 EXSR SR104 EDIT DATA 01320C 96 GOTO ERROR ERROR 01330C GOTO NEXT 01340C*------------------------------------------------------------------ 01350C UPDATE TAG 01360C* UPDATE DATA BASE. 01370C EXSR SR105 FINAL EDIT 01380C 96 GOTO ERROR ERROR 01390C EXSR SR106 UPDATE 01400C 96 GOTO ERROR ERROR 01410C 94 GOTO MENU RET TO MENU. 01420C 98 GOTO GOODBY SIGN-OFF. 01430C GOTO START 01440C*------------------------------------------------------------------- 01450C JUMP TAG 01460C* SET-UP JUMP TO REQUESTED FIELD 01470C 1 ADD W W 30 01480C W COMP 10 54 01490C 54 Z-ADD318 M 50 96 FLAG ERROR 01500C 54 GOTO ERROR BAD ESC ÐÐ01510C MOVE '000' W3A 3 01520C MOVEAA10,W W3A 01530C Z-ADD3 W2N 20 01540C EXIT SUBRAJ R. JUSTIFY 01550C RLABL W2N 01560C RLABL W3A 01570C MOVE W3A F NEW FIELD # 01580C GOTO READ 01590C*-------------------------------------------------------------------- 01600C ERROR TAG 01610C EXSR SR102 VALIDATE FIELD # 01620C EXSR SR89 GET MSG 01630C EXSR SR73 PUT MSG 01640C GOTO READ 01650C*------------------------------------------------------------------ 01660C NEWITM TAG 01670C* SET-UP LINK FOR NEW ITEM 01680C GOTO START 01690C*------------------------------------------------------------------- 01700C MENU TAG 01710C* SET-UP LINK TO MENU 01720C MOVEL'Q070DP' PROG 8 01730C GOTO END 01740C*-------------------------------------------------------------------- 01750C GOODBY TAG ÐÐ01760C* LINK TO SIGN-OFF 01770C MOVEL'GOODBY' PROG 01780C GOTO END 01790C*------------------------------------------------------------------- 01800C END TAG 01810C PROG COMP BLK8 54 01820C N54 MOVEL'Q070DP' PROG 8 01830C EXITFCHAIN LINK TO NEXT PROG 01840C RLABL PROG 01850C********************************************************************* 01860CSR SR72 BEGSR 01870C* PUT DATA TO TERMINAL 01880CSR 01 69 EXITFQTOPF CLEAR SCREEN 01890CSR SETON 72 01900CSR EXCPT PUT DATA 01910CSR SETOF 72 01920CSR ENDSR 01930C*********************************************************************** 01940CSR SR73 BEGSR 01950C* PUT ERROR MESSAGE TO TERMINAL 01960CSR SETON 73 01970CSR EXCPT PUT MSG 01980CSR SETOF 73 01990CSR Z-ADDM LSTERR 50 02000CSR ENDSR ÐÐ02010C******************************************************************* 02020CSR SR75 BEGSR 02030C* READ FROM TERMINAL 02040CSR SETOF 779096 02050CSR SETOF 939291 02060CSR SETOF 8988 02070CSR MOVE BIT,6 A6,2 BUF LENGTH 02080CSR MOVEAA6 W6A 6 02090CSR MOVE BLK10 W10A 10 BUFFER 02100CSR EXITFXCREAD READ TERM 02110CSR RLABL W10A 02120CSR RLABL W6A 02130CSR MOVEAW10A A10 02140CSR MOVE BLK10 W10A 02150CSR Z-ADD1 W 30 02160CSR '\' LOKUPA10,W 90 FLAG ESC 02170CSRN90 GOTO T75B NOT ESC 02180CSR 1 ADD W W 02190CSR W COMP 10 54 02200CSR 54 GOTO T75A BAD ESC 02210CSR A10,W COMP 'G' 98 GOODBY 02220CSR A10,W COMP 'E' 94 MENU 02230CSR A10,W COMP 'N' 93 NEW ITEM 02240CSR 98 02250COR 94 ÐÐ02260COR 93 GOTO END75 02270C*------------------------------------------------------------------ 02280CSR T75A TAG 02290C* FLAG BAD ESC INPUT 02300CSR Z-ADD318 M 96 FLAG ERROR 02310CSR GOTO END75 02320C*-------------------------------------------------------------------- 02330CSR T75B TAG 02340C* MOVE DATA 02350CSR Z-ADD1 W 02360CSR ' ' LOKUPA10,W 77 02370CSR 77 MOVEAA10,W W10A INPUT DATA 02380C*-------------------------------------------------------------------- 02390CSR END75 TAG 02400C* INIT PREV ERROR MSG. 02410CSR LSTERR COMP 0 54 02420CSR 54 MOVE BLK35 MGTEXT 02430CSR 54 EXSR SR73 BLANK MESSAGE 02440CSR Z-ADD0 LSTERR 50 02450CSR ENDSR 02460C********************************************************************** 02470CSR SR89 BEGSR 02480C* GET MESSAGE MASTER 02490CSR M CHAINMGFILE 54 02500CSR 54 MOVE BLK35 MGTEXT ÐÐ02510CSR 54 MOVELM MGTEXT 02520CSR 54 MOVE MES,1 MGTEXT 02530CSR ENDSR 02540C*********************************************************************** 02550CSR SR101 BEGSR 02560C* 1-TIME INITIALIZE 02570CSR MOVE BIT,1 NUL 02580CSR MOVE BIT,1 A6 02590CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02600CSR MOVE ' ' BLK10 10 02610C* DEFINE WORK FIELDS,ETC. 02620CSR MOVE ' ' BLK35 35 02630CSR MOVE ' ' BLK8 8 02640CSR MOVE ' ' BLK5 5 02650CSR MOVE ' ' BLK20 20 02660C* 02670C* 02680CSR ENDSR 02690C********************************************************************** 02700CSR SR102 BEGSR 02710C* VALIDATE FIELD NO. 02720CSR F COMP 0 54 02730CSRN54 Z-ADD1 F 02740CSR F COMP FLIMIT 55 02750CSR 55 Z-ADD1 F ÐÐ02760CSR ENDSR 02770C******************************************************************** 02780CSR SR103 BEGSR 02790C* MOVE INPUT DATA 02800CSR EXSR SR201 IDENTIFY-F 02810CSR Z-ADD10 W2N 20 SALESMAN CODE 02820CSR EXIT SUBRAJ R. JUSTIFY 02830CSR RLABL W2N 02840CSR RLABL W10A 02850CSR MOVE W10A TFUDAT 60 02860CSR MOVE ' ' DUN,F EDIT FLAG 02870CSR ENDSR 02880C******************************************************************** 02890CSR SR104 BEGSR 02900C* EDIT INPUT DATA 02910CSR 96 MOVE ' ' DUN,F EDIT FLAG 02920CSRN96 MOVE 'X' DUN,F 02930CSR ENDSR 02940C*********************************************************************** 02950CSR SR105 BEGSR 02960C* FINAL EDIT 02970CSR SETON 79 FINAL EDIT FLAG 02980CSR Z-ADD1 F 96 02990C*-------------------------------------------------------------------- 03000CSR T105A TAG ÐÐ03010CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03020CSRN54 GOTO END105 03030CSR EXSR SR201 IDENTIFY-F 03040CSR EXSR SR104 EDIT 03050CSRN96 GOTO T105A 03060C*-------------------------------------------------------------------- 03070CSR END105 TAG 03080CSR SETOF 79 03090CSR ENDSR 03100C******************************************************************** 03110CSR SR106 BEGSR 03120C* DISPLAY QMMAST RECORD. 03130CSR MOVE BLK35 W14A 14 03140CSR MOVELTFUDAT W14A 03150CSR W14A SETLLQFKEY 03160CSR Z-ADD0 COUNT 30 03170CSR SETOF 74 03180C*------------------------------------------------------------------- 03190CSR T106A TAG 03200CSR SETOF 54 03210CSR READ QFKEY 54 03220CSR 54 GOTO T106B END OF FILE. 03230CSR QFSTAT COMP 'D' 54 03240CSR 54 GOTO T106A 03250CSR MOVELQFQOTE W8A 8 ÐÐ03260CSR MOVE QFITEM W8A 03270CSR W8A CHAINQMMAST 54 03280CSRN54 QMSTAT COMP 'D' 54 03290CSRN54 QMITEM COMP 0 54 03300CSR 54 GOTO T106A 03310CSR EXSR SR205 TABLE LOKUPS. 03320CSR SETON 76 03330CSR EXCPT DISPLAY QMMAST 03340CSR SETOF 76 03350CSR SETON 74 03360CSR 1 ADD COUNT COUNT 03370CSR COUNT COMP 2 54 03380CSRN54 GOTO T106A 03390CSR Z-ADD34 M 03400CSR GOTO T106C 03410C*------------------------------------------------------------------- 03420CSR T106B TAG 03430C* DISPLAY END PAGE/FILE MSG. 03440CSR Z-ADD317 M 03450C*----------------------------------------------------------------- 03460CSR T106C TAG 03470CSR EXSR SR89 GET END MSG. 03480CSR EXSR SR73 END PAGE MSG. 03490CSR EXSR SR75 03500CSR 94 EXIT. ÐÐ03510COR 98 GOODBY. 03520COR 93 GOTO END106 NEW ITEM. 03530CSR Z-ADD0 COUNT 74 03540CSR M COMP 317 54 03550CSRN54 GOTO T106A 03560CSR END106 ENDSR 03570C************************************************************************ 03580CSR SR201 BEGSR 03590C* IDENTIFY FIELD NO. 03600CSR F COMP 1 01 03610CSR ENDSR 03620C******************************************************************** 03630CSR SR205 BEGSR 03640C* GET CODE DESCRIPTIONS. 03650CSR QMPCLS LOKUPTABPRD TABPRN 54 PRODUCT NAME 03660CSR 54 MOVE TABPRN PRDNAM 20 03670CSRN54 MOVE BLK20 PRDNAM 03680CSR QMSYST LOKUPTABSYS TABSYN 54 SYSTEM NAME 03690CSR 54 MOVE TABSYN SYSNAM 20 03700CSRN54 MOVE BLK20 SYSNAM 03710CSR QMREAS LOKUPTABRES TABREN 54 REASON NAME 03720CSR 54 MOVE TABREN RESNAM 20 03730CSRN54 MOVE BLK20 RESNAM 03740CSR QMSCOD LOKUPTABSTC TABSTN 54 STATUS NAME 03750CSR 54 MOVE TABSTN STCNAM 10 ÐÐ03760CSRN54 MOVE BLK20 STCNAM 03770CSR ENDSR 03780O******************************************************************** 03790OTERM132 E 76N74 03800O 55 'QUOTE INQUIRY - ' 03810O 72 'FOLLOW-UP SEQUENCE' 03820O 102 'WON' 03830O*------------------------------------------------------------------- 03840O E 76N74 03850O 5 'QUOTE' 03860O 10 'ITEM' 03870O 20 'CUSTOMER' 03880O 41 'CONTACT' 03890O 60 'SLSM' 03900O 66 'PROD' 03910O 71 'SYS' 03920O 83 'AMOUNT$' 03930O 91 'STATUS' 03940O 97 'PROB' 03950O 103 'LOST' 03960O 126 'SCHEDULE' 03970O*------------------------------------------------------------------- 03980O E 76 03990O*------------------------------------------------------------------- 04000O E 76 ÐÐ04010O QMQOTE 5 04020O QMITEMZ 9 04030O QMNAME 32 04040O QMCONT 54 04050O QMSLSM 59 04060O QMPCLS 66 04070O QMSYST 70 04080O QMAMT 83 ' , , $0' 04090O QMSCOD 88 04100O QMPROBZ 96 04110O 97 '%' 04120O QMREAS 102 04130O 118 'REC''D' 04140O QMD,1 132 ' - - ' 04150O*------------------------------------------------------------------- 04160O E 76 04170O 17 'RFQ#:' 04180O QMRFQ 42 04190O 47 '-' 04200O QMRFQI 48 04210O PRDNAM 85 04220O STCNAM 97 04230O 116 'DUE' 04240O QMD,2 132 ' - - ' 04250O*------------------------------------------------------------------- ÐÐ04260O E 76 04270O 20 'REMARKS:' 04280O QMREM 62 04290O RESNAM 107 04300O 117 'SENT' 04310O QMD,3 132 ' - - ' 04320O*------------------------------------------------------------------- 04330O E 76 04340O 118 'AWARD' 04350O QMD,4 132 ' - - ' 04360O*------------------------------------------------------------------- 04370O E 76 04380O 122 'FOLLOW-UP' 04390O QMD,5 132 ' - - ' 04400O*------------------------------------------------------------------- 04410O E 76 04420O 120 'EXPIRES' 04430O QMD,6 132 ' - - ' 04440O*------------------------------------------------------------------- 04450O E 76 04460O*------------------------------------------------------------------- 04470O E 73 04480O* PUT MSG. 04490O 96 5 '*****' 04500O MGTEXT 48 ÐÐ04510O 96 55 '*****' 04520O BIT,14 132 04530O******************************************************************** 04540OTERM22 E 72 01 04550O 22 'ENTER DATE :' ** TABPRD/TABPRN - PROD CLASS 00456011MINI SERIES 00457012SERIES 1500 00458021SERIES 1000 00459022SERIES 3000 00460023SERIES 5900 00461024SERIES 5300 00462041SERIES X 00463042SERIES 10 00464051SERIES 5100 00465052SERIES 1400 00466053SERIES 8100 004670541400/8100 CONTROLS 00468055SYSTEM 21 00469059OTHER SYSTEMS 00470060RF EQUIPMENT 00471070EQUA-DYNE EQUIPMENT 00472090MISC. EQUIPMENT 00473099SKY 515 004740** TABSYS/TABSYN - SYST CODE 004750ÐÐSSYSTEM 004760NNON-SYSTEM 004770** TABSTC/TABSTN - STATUS CODE 004780EENTERED 004790NNO BID 004800PPENDING 004810LLOST 004820WWON 004830CCANCELLED 004840** TABRES/TABREN - REASON LOST 0048501PRICE 0048602DELIVERY 0048703SPECIFICATIONS 0048804OTHER 0048905NOT KNOWN 004900** NUL ARRAY 004910 004920** A6 ARRAY 004930 004940** A10 ARRAY 004950 004960** DUN ARRAY 004970 004980** MES ARRAY 004990---MESSAGE NOT ON FILE--- 005000ÐÐ/* 005010_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(ŠSÛ ŠX122PM PÞÞ072783072783(èÈÐ00010H Q122PM00020F* LIST DATA ENTRY SHEETS FOR P/M - START P/N, PAGE IN PNSEL (TEXT) 00030F* REVISED 07-27-83 11:45 AM. 00040FPNSEL IP F 80 DISK 00050FPMMST2 ID F 674L12AI 1 DISK 00060FLABORAT IT F 80 EDISK 00070FPRINT O F 132 PRINTER 00080F**************************************************************** 00090E LABORAT TABDEP 1 13 5 0 TABRAT 9 00100E PM$ 7 9 3 MFG $ FILE 00110E PA$ 7 9 3 STD $ FILE 00120E PLT 8 3 0 LEAD TIMES 00130E PHZ 5 3 0 HORIZON M-DAYS 00140E PMM 6 7 0 MIN/MAX CODES 00150E AHR 3 7 3 ACCT ROUT HRS 00160E ADP 3 3 0 ACCT ROUT DEPT 00170E MHR 12 7 3A MFG ROUT HRS 00180E MDP 12 3 0A MFG ROUT DEPT 00190I******************************************************************* 00200IPNSEL PN 20 00210I 1 100PN 00220I* STARTING PAGE LESS 1 00230I 11 140PG 00240I************************************************************************ 00250IPMMST2 PM ÐÐ00260I* PART MASTER RECORD. 00270I* KEY AREA 00280I* PART NO. 10N 00290I 1 100PMPN 00300I 2 50PN2 00310I* NUMB OF COMPONENTS 3P 00320I P 13 140PMNOBM 00330I* PROD LINE 4N 00340I 15 180PMPL 00350I* MODEL NAME 12A 00360I 19 30 PMMODL 00370I* DESCRIPTION 29A 00380I 31 59 PMDESC 00390I* COMMODITY CODE 9P 00400I P 60 640PMCC 00410I* ENG CHANGE STATUS. 00420I* LAST ECN # 5A 00430I 65 69 PMECN 00440I* CUR CHG LEVEL 2A 00450I 70 71 PMECHG 00460I* CUR CHG DATE 6N 00470I 72 770PMDCHG 00480I* RELEASE STATUS 1A 00490I* E = ENG ONLY 00500I* M = REL TO MFG ÐÐ00510I* P = PROTOTYPE 00520I* X = PRE-RELEASE 00530I 78 78 PMRELS 00540I* INSPECT CODE 3A 00550I 79 81 PMINSP 00560I* DRAWING INFO. 00570I* DWG SIZE 1A 00580I 82 82 PMSIZ 00590I* DWG CLASS 1A 00600I* D = DYNAIR DWG 00610I* V = VENDOR DWG 00620I 83 83 PMDCLS 00630I* STANDARD CODE 1A 00640I 84 84 PMSTDC 00650I* UNIT MEAS 2A 00660I* EA = EACH OZ = OUNCE 00670I* ST = SET TC = TROY OUNCE 00680I* IN = INCH LB = POUND 00690I* FT = FEET PT = PINT 00700I* YD = YARD QT = QUART 00710I* SI = SQ.INCH GL = GALLON 00720I* SF = SQ.FEET DR = DRUM 00730I* SY = SQ.YARD PR = PAIR 00740I 85 86 PMUM 00750I***** UNIT MEAS CONVERSION. ÐÐ00760I***** UM MULTIPLIER 7.2P 00770I***** P 87 902PMUMM 00780I***** UM CONVERTER 1A 00790I***** M = MULTIPLY 00800I***** D = DIVIDE 00810I***** 91 91 PMUMC 00820I***** SET/DRUM UM 2A 00830I***** 92 93 PMUMUM 00840I* SOURCE CODE 2A 00850I* MA = MFG ASSY 00860I* MP = MFG PART 00870I* PA = PURCH ASSY 00880I* PP = PURCH PART 00890I* RS = RAW STOCK 00900I* RD = REF DOCUMENT 00910I 94 95 PMSC 00920I* PROVISIONING CODE 1A 00930I* A = FORECAST,NO VALUE ADDED 00940I* B = FORECAST,VALUE ADDED 00950I* C = FRCST-BUILD TO ORDER 00960I* D = NON-FRCST-BUILD TO ORDER 00970I* E = CUSTOM 00980I* Y = OBSOLETE,REPAIRABLE 00990I* Z = OBSOLETE,NOT REPAIRABLE 01000I 96 96 PMPROV ÐÐ01010I* ISSUE CODE 2A 01020I* PT = PULL TIME 01030I* OR = ON REQUEST 01040I* BI = BULK ISSUE 01050I* AR = AS REQUIRED 01060I* VS = VENDOR SUPPLIED 01070I* SD = SHIPPING DOCUMENT 01080I* TD = TRAV DOCUMENT 01090I* RD = REF DOCUMENT 01100I* RA = REF ASSY 01110I 97 98 PMISSU 01120I* DELIVER TO DEPT 5P 01130I P 99 1010PMDEL 01140I* RESPONSIBILITY CODES 01150I* ENGR CODE 2A 01160I 102 103 PMEGR 01170I* PLANNER CODE 2A 01180I 104 105 PMPLNR 01190I* BUYER CODE 2A 01200I 106 107 PMBUYR 01210I* SALESMAN CODE 2A 01220I 108 109 PMSLSM 01230I* INVENTORY ACCOUNT 5P 01240I P 110 1120PMACNT 01250I* LEAD TIMES 3P X 8 ÐÐ01260I* MFG BUCKET PURCH 01270I* 01280I* SCHED 1 SCHED 01290I* KIT 2 PLACE PO 01300I* VENDOR 3 VENDOR 01310I* PRODUCTION 4 01320I* INSPECT/TEST 5 INSPECT 01330I* STOCK 6 STOCK 01340I* 7 01350I* CUM 01360I P 113 128 PLT 01370I* ORDER POLICY CODES. 01380I* HORIZON M-DAYS 3P X 5 01390I* 1 = SALES ORDERS 01400I* 2 = PROD REQMTS-REL 01410I* 3 = PROD REQMTS-PLAN 01420I* 4 = FORECAST 01430I* 5 = SAFETY STOCK 01440I P 129 138 PHZ 01450I* MIN/MAX CODES. 01460I* ARRAY 7P X 6 01470I* 1 = MIN ORDER SPAN 01480I* 2 = MIN ORDER QTY 01490I* 3 = MIN ORDER $ 01500I* 4 = MAX ORDER SPAN ÐÐ01510I* 5 = MAX ORDER QTY 01520I* 6 = MAX STOCK $ 01530I P 139 162 PMM 01540I* MINIMUM STOCK QTY (SAFETY STOCK) 7P 01550I P 163 1660PMSSTK 01560I* ROUNDING FACTOR 5P 01570I P 167 1690PMRNDF 01580I* EOQ CODE 2A 01590I 170 171 PMEOQ 01600I* EOQ PARAMETER 2A 01610I 172 173 PMEOQP 01620I* EXCEPTION REPORT CRITERIA. 01630I* ALLOWABLE SURPLUS QTY 7P 01640I P 174 1770PMSQTY 01650I* ALLOWABLE SURPLUS % 5.2P 01660I P 178 1802PMSPCT 01670I* ALLOWABLE SURPLUS SPAN 3P 01680I P 181 1820PMSSP 01690I* ALLOWABLE SHORTAGE SPAN 3P 01700I P 183 1840PMSHSP 01710I*------------------------------------------------------------------- 01720I* STANDARD COSTS 9.3P X 7 01730I* ADDED COSTS 01740I* 1 = LABOR 01750I* 2 = LABOR BURDEN ÐÐ01760I* 3 = MATERIAL 01770I* 4 = MATERIAL BURDEN 01780I* 5 = OUTSIDE PROC 01790I* CUM COSTS 01800I* 6 = LABOR 01810I* 7 = MATERIAL 01820I P 185 219 PA$ 01830I* STANDARD LABOR HOURS. 01840I* STD LOT SIZE 7P 01850I P 220 2230PMSLOT 01860I* STD SET-UP HRS 9.3P 01870I P 224 2283PMSSUH 01880I* STD RUN HRS 9.3P 01890I P 229 2333PMSRH 01900I* STD COST DATE 6N 01910I 234 2390PMSDAT 01920I* STD COST CODE 1A 01930I* E = ESTIMATED 01940I* H = HISTORICAL 01950I* X = ACCOUNTING 01960I 240 240 PMSCCD 01970I* AVER LABOR **** 7.2P 01980I P 241 2442PMOSAL 01990I*------------------------------------------------------------------- 02000I* CURRENT COSTS 9.3P X 7 ÐÐ02010I* ADDED COSTS 02020I* 1 = LABOR 02030I* 2 = LABOR BURDEN 02040I* 3 = MATERIAL 02050I* 4 = MATERIAL BURDEN 02060I* 5 = OUTSIDE PROC 02070I* CUM COSTS 02080I* 6 = LABOR 02090I* 7 = MATERIAL 02100I P 245 279 PM$ 02110I* CURRENT LABOR HOURS. 02120I* CUR LOT SIZE 7P 02130I P 280 2830PMCLOT 02140I* CUR SET-UP HRS 9.3P 02150I P 284 2883PMCSUH 02160I* CUR RUN HRS 9.3P 02170I P 289 2933PMCRH 02180I* CUR COST DATE 6N 02190I 294 2990PMCDAT 02200I* CUR COST CODE 1A 02210I* E = ESTIMATED 02220I* H = HISTORICAL 02230I* X = ACCOUNTING 02240I 300 300 PMCCCD 02250I* PREV MO STK BAL **** 7P ÐÐ02260I P 301 3040PMPMSB 02270I* DATE LAST TRAN 6N 02280I 305 3100PMDLT 02290I* CALCULATED DATA. 02300I* CURRENT BALANCES. 02310I* ON HAND STOCK 7P 02320I P 311 3140PMOHB 02330I* REQUIRED QTYS. 02340I* FORECAST BAL 7P 02350I P 315 3180PMFRCB 02360I* ALLOCATIONS 7P 02370I P 319 3220PMALB 02380I* REL REQS 7P 02390I P 323 3260PMRLB 02400I* SALES BACKLOG 7P 02410I P 327 3300PMSOB 02420I* QUOTES 7P 02430I P 331 3340PMQTB 02440I* BACKORDERS 7P 02450I P 335 3380PMBOB 02460I* ON ORDER BALANCES. 02470I* PURCHASE REQS 7P 02480I P 339 3420PMPRB 02490I* PURCH ORDERS 7P 02500I P 343 3460PMPOB ÐÐ02510I* RECD P.O. 7P 02520I P 347 3500PMRPOB 02530I* OPEN WORK ORDER 7P 02540I P 351 3540PMPWOB 02550I* REL WORK ORDER 7P 02560I P 355 3580PMRWOB 02570I* PAST USAGE. 02580I* PLANNED USAGE QTYS. 02590I* SHIPPED QTYS 7P 02600I P 359 3620PMPSHP 02610I* ISSUE QTYS 7P 02620I P 363 3660PMPISS 02630I* RECEIPT QTYS 7P 02640I P 367 3700PMPRCT 02650I* SCRAP QTYS 7P 02660I P 371 3740PMPSCR 02670I* UNPLANNED USAGE QTYS. 02680I* SHIPPED QTYS 7P 02690I P 375 3780PMUSHP 02700I* ISSUE QTYS 7P 02710I P 379 3820PMUISS 02720I* RECEIPT QTYS 7P 02730I P 383 3860PMURCT 02740I* SCRAP QTYS 7P 02750I P 387 3900PMUSCR ÐÐ02760I* CUST RET $ 7P 02770I P 391 3940PMUCRT 02780I* PLANNED USAGE FREQ. 02790I* SHIPPED 5P 02800I P 395 3970PMFSHP 02810I* ISSUE 5P 02820I P 398 4000PMFISS 02830I* RECEIPT 5P 02840I P 401 4030PMFRCT 02850I* SCRAP 5P 02860I P 404 4060PMFSCR 02870I* UNPLANNED USAGE FREQ. 02880I* SHIPPED 5P 02890I P 407 4090PMQSHP 02900I* ISSUE 5P 02910I P 410 4120PMQISS 02920I* RECEIPT 5P 02930I P 413 4150PMQRCT 02940I* SCRAP 5P 02950I P 416 4180PMQSCR 02960I* CUST RET 5P 02970I P 419 4210PMQCRT 02980I* BACKORDER FREQ 5P 02990I P 422 4240PMFBO 03000I* USAGE RATIO .7P ÐÐ03010I P 425 4287PMRATO 03020I* INVENTORY CLASS 1A 03030I 429 429 PMINVC 03040I* LOW LEVEL CODE 2N 03050I 430 4310PMLL 03060I* PHYSICAL INVENTORY. 03070I* CYCLE INV FREQ 3P 03080I P 432 4330PMFCYC 03090I* DATE LAST CYCLE 6N 03100I 434 4390PMDLCI 03110I* ADJ FREQ 3P 03120I P 440 4410PMFADJ 03130I* ADJ NET VALUE $ 9.2P 03140I P 442 4462PMVADJ 03150I* LAST SALE INFO. 03160I* LAST SALE DATE 6N 03170I 447 4520PMDLS 03180I* LAST SALE QTY 7P 03190I P 453 4560PMLSQ 03200I* LAST SALE PRICE 9.3P 03210I P 457 4613PMLSP 03220I* LAST BUY INFO. 03230I* LAST BUY DATE 6N 03240I 462 4670PMDLB 03250I* LAST BUY QTY 7P ÐÐ03260I P 468 4710PMLBQ 03270I* LAST BUY PRICE 9.3P 03280I P 472 4763PMLBP 03290I* DATE LAST STK TRANS 6N 03300I 477 4820PMDLST 03310I* OLD STYLE PART MASTER FIELDS. HRS=ACCOUNTING STD HRS 03320I* AVER LABOR 7.2P P 241 2442PMOSAL 03330I* PREV MO STK BAL 7P P 301 3040PMPMSB 03340I* DEVALUED CODE 1A 03350I 483 483 PMDVAL 03360I*** LOT QTY 5P 03370I*** P 484 4860PMOSLQ 03380I* FAB CODE 2A 03390I 487 488 PMFABC 03400I* STD UNIT COST 9.3P 03410I P 489 4933PMOSUC 03420I*** LEAD TIME 3P 03430I*** P 494 4950PMOSLT 03440I* OLD STYLE MCN 5A 03450I 496 500 PMMCN 03460I* SPARES CODE 1A 03470I 501 501 PMSPAR 03480I* GSA PRICE 9.2P 03490I P 502 5062PMGSA 03500I* SET-UP PRICE 9.2P ÐÐ03510I P 507 5112PMSUPR 03520I* LIST PRICE 9.2P 03530I P 512 5162PMLPR 03540I* PMDESCR FILE KEY CODE 3P 03550I P 517 5180PMPDKC 03560I* LAST PRICE UPDATE DATE 6N 03570I 519 5240PMLPUD 03580I* ACCOUNTING ROUTING HRS 3 X 7.3P 03590I P 525 536 AHR 03600I* ACCOUNTING ROUTING DEPT 3 X 3P 03610I P 537 542 ADP 03620I* MFG ROUTING HRS 12 X 7.3P 03630I P 543 590 MHR 03640I* MFG ROUTING DEPT 12 X 3P 03650I P 591 614 MDP 03660I* STD UNIT COST- MFG 9.3P 03670I P 615 6193PMTCST 03680I* TO BE DELETED FLAG 1A 03690I* * = DELETE CANDIDATE 03700I 620 620 PMDELC 03710I* STOCK LOCATION 6A 03720I 621 626 PMSLOC 03730I* ROUTING POINTER 5P 03740I P 627 6290PMRTGP 03750I* RECORD STATUS 1A ÐÐ03760I* D = DELETED 03770I 674 674 PMSTAT 03780I*------------------------------------------------------------------- 03790I GG 02 03800C******************************************************************* 03810C* INITIALIZE 03820C 20 EXSR SR101 1-TIME INIT 03830C*---------------------------------------------------------------------- 03840C TAG10 TAG 03850C READ PMMST2 98 03860C 98 GOTO END 03870C PMSTAT COMP 'D' 58 03880C 58 GOTO TAG10 03890C SETOF 032450 03900C SETOF 607080 03910C SETOF 515458 03920C PMINVC COMP ' ' 58 03930C 58 SETON 24 TYPE 'D' 03940C PMPROV COMP ' ' 58 03950C N58 SETON 03 END ITEM 03960C Z-ADDPMACNT W5N 50 03970C W5N COMP 14600 70S/A 03980C W5N COMP 12100 80F/G 03990C W5N COMP 14100 51DET 04000C 51 PMSC COMP 'PP' 50P/P ÐÐ04010C 51 PMSC COMP 'MP' 60M/P 04020C 50 EXSR SR50 04030C EXSR SR200 COST 04040C SETON 01 04050C EXCPT PRINT SHEET 04060C SETOF 01 04070C GOTO TAG10 04080C*-------------------------------------------------------------------- 04090C END TAG 04100C********************************************************************* 04110CSR SR50 BEGSR 04120CSR Z-ADDPMCC W9N 90 54 04130CSR 54 MOVELW9N CMD 40 04140CSRN54 MOVE PN2 CMD 04150CSR PLT,4 DIV 4 MWKS 41H 04160CSR MWKS MULT 7 CDYS 40H 04170CSR CDYS ADD 14 CDYS 04180CSR ENDSR 04190C****************************************************************** 04200CSR SR101 BEGSR 04210CSR Z-ADD0 ZERO3 30 04220CSR Z-ADDPG EGAP 40 04230CSR MOVE ' ' W12A 12 04240CSR MOVELPN W12A 04250CSR W12A SETLLPMMST2 ÐÐ04260CSR MOVE '_ _ _ _ 'W4A 8 04270CSR MOVELW4A W8A 16 04280CSR MOVE W4A W8A 04290CSR MOVELW8A W7A 14 04300CSR MOVELW7A W5A 10 04310CSR MOVELW4A W3A 6 04320CSR MOVE '__' W2A 2 04330CSR MOVELW8A W16A 32 04340CSR MOVE W8A W16A 04350CSR MOVELW16A W19A 38 04360CSR MOVE W3A W19A 04370CSR MOVELW16A W35A 70 04380CSR MOVE W19A W35A 04390CSR ENDSR 04400C********************************************************************** 04410CSR SR200 BEGSR 04420CSR 1 ADD EGAP EGAP 04430CSR Z-ADDPMOSUC MCM 82H 04440CSR Z-ADD1 X 30 04450C*-------------------------------------------------------------------- 04460CSR T200A TAG 04470CSR ZERO3 LOKUPMDP,X 54 04480CSRN54 GOTO T200C 04490CSR Z-ADDMDP,X W5N 50 04500CSR W5N LOKUPTABDEP TABRAT 54 ÐÐ04510CSRN54 GOTO T200B 04520CSR MOVELTABRAT RATE 52 04530CSR MOVE TABRAT PCT 42 04540CSR RATE MULT MHR,X W8N 82H 04550CSR W8N ADD MCL MCL 82 04560CSR W8N MULT PCT O8N 82H 04570CSR O8N ADD MCO MCO 82 04580C*-------------------------------------------------------------------- 04590CSR T200B TAG 04600CSR 1 ADD X X 04610CSR X COMP 12 54 04620CSRN54 GOTO T200A 04630CSR 50 GOTO END200 04640C*--------------------------------------------------------------------- 04650CSR T200C TAG 04660CSR MCL ADD MCO W8N 04670CSR MCM SUB W8N MCM 04680CSR END200 ENDSR 04690C********************************************************************** 04700OPRINT E 201 01 04710O UDATE Y 8 04720O 51 'ITEM MASTER DATA' 04730O EGAP Z 83 04740O 78 'PAGE' 04750O*---------------------------------------------------------------------- ÐÐ04760O E 2 01 04770O 5 'ITEM:' 04780O PMPN 19 '0 - - ' 04790O E 1 01 04800O 5 'DESC:' 04810O PMDESC 36 04820O E 1 01 04830O W35A 73 04840O E 1 01 04850O W35A 73 04860O E 2 01 04870O W35A 73 04880O E 2 01 04890O 10 'CATALOG #:' 04900O 03 PMMODL 33 04910O E 2 01 04920O 18 'PHYSICAL LOCATION:' 04930O W3A 26 04940O E 2 01 04950O 10 'ITEM TYPE:' 04960O 70 15 'S/A' 04970O 80 15 'F/G' 04980O 50 15 'P/P' 04990O 60 15 'M/P' 05000O 61 'AVG COST:' ÐÐ05010O E 2 01 05020O 14 'PRODUCT CLASS:' 05030O PMPL Z 19 05040O 65 'CUR MFG COST:' 05050O E 2 01 05060O 13 'PRODUCT LINE:' 05070O 65 'FREIGHT COST:' 05080O E 2 01 05090O 6 'REF 1:' 05100O CMD B 12 '0 ' 05110O 63 'OTHER COST:' 05120O E 2 01 05130O 6 'REF 2:' 05140O 66 'ACCT STD COST:' 05150O PMOSUC2 77 05160O E 2 01 05170O 13 'PRODUCT HOLD:' 05180O 65 'OLD STD COST:' 05190O E 2 01 05200O 6 'REF 3:' 05210O 67 'STD WT/UNIT:(N)' 05220O W8A 84 05230O E 2 01 05240O 8 'PRI U/M:' 05250O PMUM 13 ÐÐ05260O 64 'AVG WT/UNIT:' 05270O E 2 01 05280O 11 'ALT U/M:(A)' 05290O W2A 13 05300O 64 'UNITS/BATCH:' 05310O E 2 01 05320O 16 'CNVT ALT/STD:(N)' 05330O W8A 34 05340O 61 'ABC CODE:' 05350O PMINVC 65 05360O 24 65 'D' 05370O E 12 01 05380O 7 'VENDOR:' 05390O 65 'SCRAP FACTOR:' 05400O E 2 01 05410O 15 'LEAD TIME CODE:' 05420O 50 19 'P' 05430O N50 19 'M' 05440O 68 'REL BY BATCH: N' 05450O E 2 01 05460O 17 'LEAD TIME MFG:(N)' 05470O W5A 28 05480O 63 'REVISION #:' 05490O PMECHG 68 05500O E 2 01 ÐÐ05510O 13 'LEAD TIME-PO:' 05520O CDYS ZB 19 05530O 69 'REORD SETUP COST:' 05540O E 2 01 05550O 14 'REORDER PT:(N)' 05560O W8A 32 05570O 72 'CYCLE COUNT CODE:(A)' 05580O W3A 80 05590O E 2 01 05600O 16 'MULTIPLE QTY:(N)' 05610O W5A 28 05620O 60 'PLANNER:' 05630O 70 64 'RC' 05640O 60 65 'DN1' 05650O 50 65 'DN2' 05660O 80 64 'RS' 05670O E 2 01 05680O 19 'STD REORDER QTY:(N)' 05690O W8A 36 05700O 66 'PAPERWORK IND:' 05710O 70 69 'B' 05720O 80 69 'B' 05730O E 2 01 05740O 16 'SAFETY STOCK:(N)' 05750O W7A 32 ÐÐ05760O 69 'EST ANNUAL USAGE:' 05770O PMFRCBZ 76 05780O E 2 01 05790O 19 'INV POLICY CODE: M' 05800O 63 'AVG DEMAND:' 05810O E 1 01 05820O 25 'ACCT COST:' 05830O 41 'MFG COST:' 05840O W2A 71 05850O 82 'R DUVALIAN' 05860O E 1 01 05870O W2A 71 05880O 80 'R SPANOS' 05890O E 1 01 05900O 13 'ADD-ON LABOR:' 05910O MCL LB 26 05920O W2A 71 05930O 79 'J MORSE' 05940O E 1 01 05950O W2A 71 05960O 82 'D HITCHCOX' 05970O E 1 01 05980O 16 'ADD-ON MATERIAL:' 05990O MCM LB 26 06000O W2A 71 ÐÐ06010O 84 'H GRUENSTERN' 06020O E 1 01 06030O W2A 71 06040O 79 'T VOLTZ' 06050O E 01 06060O 16 'ADD-ON OVERHEAD:' 06070O MCO LB 26 06080O W2A 71 06090O 82 'D STRASSEL' 06100O*********************************************************************** /* 06110_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(X — XúX014RM P120282120282(èÈÐ00010H Q014RM00020F* PRINT ROUTING SELECTIVELY BY PART#, OPER (DIABLO). (X014RM) 00030F* REVISED 10-08-81 4:45 PM. 00040FBITHEX IP F 256 DISK 00050FCRTFILE UC F 256R DISK 00060FRMMAST IS F 140 15AI 1 DISK 00070FREXTPTR ID F 25L21AI 1 DISK 00080FREXTFILEIC F 90R DISK 00090FPMMST2 IC F 674R12AI 1 DISK 00100F**************************************************************** 00110E MES 1 1 30 00120E TABTRN 1 3 1 TABNAM 6 TRAN NAMES 00130E TABMET 1 2 1 TABMN 12 METHOD NAMES 00140E* 00150E TXT 60 1 A 00160E REC 132 1 00170I******************************************************************* 00180IBITHEX BT 00190I******************************************************************** 00200ICRTFILE CR 00210I 81 212 REC 00220I******************************************************************** 00230IRMMAST RM 01 140NCD 00240I* ROUTING MASTER. 00250I* KEY AREA. ÐÐ00260I* PART # 12A 00270I 1 12 RMPN L1 00280I* OPER SEQ # 3N 00290I 13 150RMSEQ 00300I* OPER GROUP CODE 2A 00310I 16 17 RMGRUP 00320I* OVERLAP % .2N 00330I 18 192RMOVLP 00340I* OPER CODE 5A 00350I 20 24 RMOPER 00360I* OPER DEPT. 00370I* DEPT # 5P 00380I P 25 270RMDEPT 00390I* WORK CENTER 3P 00400I P 28 290RMWC 00410I* OPER DESCRIPTION 40A 00420I 30 69 RMDESC 00430I* LABOR STDS. 00440I* ACCOUNTING STD. 00450I* DATE ADOPTED 7P 00460I P 70 730RMADAT 00470I* SET-UP 9.3P 00480I P 74 783RMASU 00490I* RUN 9.3P 00500I P 79 833RMARUN ÐÐ00510I* MIN CHARGE 7.2P 00520I P 84 872RMAMIN 00530I* STD LOT SIZE 7P 00540I P 88 910RMALOT 00550I* REVISED STDS. 00560I* DATE LAST REVISED 7P 00570I P 92 950RMRDAT 00580I* SET-UP 9.3P 00590I P 96 1003RMRSU 00600I* RUN 9.3P 00610I P 101 1053RMRRUN 00620I* MIN. CHARGE 7.2P 00630I P 106 1092RMRMIN 00640I* STD LOT SIZE 7P 00650I P 110 1130RMRLOT 00660I* METHOD ESTAB 1A 00670I 114 114 RMMETH 00680I* JOB SKILL 5A 00690I 115 119 RMSKIL 00700I* PERFORM FACTOR. 00710I* ACTUAL 5.2P 00720I P 120 1222RMPER 00730I* ASSIGNED 5.2P 00740I P 123 1252RMPER2 00750I* NUMB LOTS RUN 5P ÐÐ00760I P 126 1280RMLRUN 00770I* NUMB UNITS RUN 5P 00780I P 129 1310RMQRUN 00790I* FILLER 132 139 FFFFFF 00800I* RECORD STATUS 1A 00810I 140 140 RMSTAT 00820I GG 02 00830I******************************************************************** 00840IREXTPTR TP 00850I* TEXT POINTER FILE. 00860I* PART # 12A 00870I 1 12 TPPN 00880I* OPER SEQ # 3N 00890I 13 150TPSEQ 00900I* LINE # 6N 00910I 16 210TPLINE 00920I* POINTER 7P 00930I P 22 250TPPTR 00940I******************************************************************** 00950IREXTFILETX 00960I* REXTFILE RECORD. 00970I* PART # 12A 00980I 1 12 TXPN 00990I* OPER SEQ # EN 01000I 13 150TXSEQ ÐÐ01010I* LINE # 6N 01020I 16 210TXLINE 01030I* TEXT 1A X 60 01040I 22 81 TXT 01050I* BACKWARD PTR (DELETE) 7P 01060I P 82 850TXBPTR 01070I* RECORD STATUS 1A 01080I 90 90 TXSTAT 01090I******************************************************************** 01100IPMMST2 PM 01110I 1 12 PMPN 01120I 15 180PMPROD 01130I 19 30 PMMODL 01140I 31 59 PMDESC 01150I 94 95 PMSC 01160I 487 488 PMFAB 01170I 674 674 PMSTAT 01180C******************************************************************** 01190C* INITIALIZE 01200C N80 Z-ADD100 LINENO 80 01210C Z-ADD0 ZERO10 100 STUPIDITY 01220C EXITFQLF8 01230C EXSR SR101 1-TIME INIT 01240C L1 SETOF 79 01250C N01 GOTO END ÐÐ01260C* DISPLAY ROUTING. 01270C 01 EXSR SR106 DISPLAY. 01280C*------------------------------------------------------------------- 01290C END TAG 01300CLR EXITFQLF6 01310C******************************************************************** 01320CSR SR69 BEGSR 01330C* PUT DATA TO DIABLO. 01340CSR EXSR SR205 LF 01350CSR PORT CHAINCRTFILE H9 01360CSR H9 GOTO END69 01370CSR MOVE ' ' REC 01380CSR EXCPT UPDATE CRTFILE 01390CSR PORT CHAINCRTFILE H9 01400CSR H9 GOTO END69 01410CSR MOVEAREC W148A 148 01420CSR EXITFZD148 PUT DIABLO 01430CSR RLABL W148A 01440CSR 1 ADD LINENO LINENO 30 01450C*------------------------------------------------------------------- 01460CSR END69 TAG 01470CSR SETOF 717275 01480CSR SETOF 414243 01490CSR SETOF 444577 01500CSR SETOF 47 ÐÐ01510CSR ENDSR 01520C******************************************************************** 01530CSR SR70 BEGSR 01540C* PUT DIVIDER. 01550CSR LINENO COMP 75 54 01560CSR 54 EXSR SR71 PUT HEADING 01570CSR EXSR SR205 LF 01580CSR EXSR SR205 LF 01590CSR SETON 47 01600CSR EXSR SR69 PUT PART# 01610CSR ENDSR 01620C******************************************************************** 01630CSR SR71 BEGSR 01640C* PUT HEADINGS TO CRTFILE. 01650CSR Z-ADD0 X 30 01660C*------------------------------------------------------------------- 01670CSR T71A TAG 01680CSR 1 ADD X X 01690CSR X COMP 5 54 01700CSR 54 GOTO T71B 01710CSR X COMP 3 54 01720CSR 54 GOTO T71A 01730CSR X COMP 1 41 01740CSR X COMP 2 42 01750CSR X COMP 3 43 ÐÐ01760CSR X COMP 4 44 01770CSR X COMP 5 45 01780CSR 41 EXSR SR204 TOP OF PAGE 01790CSR 42 EXSR SR205 LINE FEED 01800CSR EXSR SR69 HEADING PUT 01810CSR GOTO T71A 01820C*------------------------------------------------------------------- 01830CSR T71B TAG 01840CSR EXSR SR205 LINE FEED 01850CSR SETOF 414243 01860CSR SETOF 4445 01870CSR ENDSR 01880C********************************************************************* 01890CSR SR72 BEGSR 01900C* PUT OPER TO TERMINAL 01910CSRN79 EXSR SR70 PUT DIVIDER 01920CSR MOVELPMPN NUMPN 100 01930CSR RMWC COMP 0 54 01940CSR SETON 7279 01950CSR EXSR SR69 PUT DATA 01960CSR SETOF 72 01970CSR ENDSR 01980C******************************************************************** 01990CSR SR74 BEGSR 02000C* PUT TEXT TO TERM. ÐÐ02010CSRN79 EXSR SR70 PUT DIVIDER 02020CSR SETON 7479 02030CSR EXSR SR69 02040CSR SETOF 74 02050CSR ENDSR 02060C*********************************************************************** 02070CSR SR101 BEGSR 02080C* 1-TIME INITIALIZE 02090CSR MOVE ' ' BLK12 12 02100C* GET CRTFILE. 02110CSR MOVE ' ' W8A 8 02120CSR Z-ADD0 W2N 20 02130CSR Z-ADD0 W1N 10 02140CSR MOVE ' ' W2A 2 02150CSR EXITFPGMINX GET PORT #. 02160CSR RLABL W8A 02170CSR RLABL W2N 02180CSR RLABL W1N 02190CSR RLABL W2A 02200CSR MOVE W2A PORT 20 02210CSR PORT COMP 0 54 02220CSRN54 Z-ADD25 PORT 02230CSR PORT CHAINCRTFILE H9 02240CSR H9 GOTO END101 02250C* DEFINE WORK FIELDS,ETC. ÐÐ02260CSR MOVE ' ' BLK35 35 02270CSR MOVE ' ' BLK40 40 02280CSR MOVE ' ' BLK8 8 02290CSR Z-ADD0 ZERO10 100 02300CSR END101 ENDSR 02310C******************************************************************** 02320CSR SR106 BEGSR 02330C* DISPLAY ROUTING. 02340CSR EXSR SR205 LF 02350C*------------------------------------------------------------------- 02360CSR T106A TAG 02370CSR RMPN CHAINPMMST2 60 02380CSRN60 PMSTAT COMP 'D' 60 02390CSR 60 Z-ADD291 M 50 96 FLAG ERROR. 02400CSR 60 GOTO END106 02410CSR MOVELPMPN NUMPN 100 02420CSR RMSTAT COMP 'D' 54 02430CSR 54 GOTO END106 DELETED. 02440CSR EXSR SR72 PUT DATA. 02450CSR LINENO COMP 80 78 02460CSR 78 EXSR SR71 NEW PAGE 02470CSR SETOF 78 02480C*------------------------------------------------------------------- 02490CSR T106D TAG 02500CSR EXSR SR203 DISPLAY TEXT. ÐÐ02510CSR END106 ENDSR 02520C******************************************************************** 02530CSR SR203 BEGSR 02540C* DISPLAY TEXT (IF ANY) FOR LAST OPER DISPLAYED. 02550CSR MOVELRMPN W15A 15 02560CSR MOVE RMSEQ W15A 02570CSR MOVELW15A W21A 21 02580CSR MOVE '000000' W21A 21 02590CSR W21A SETLLREXTPTR 02600C*------------------------------------------------------------------- 02610CSR T203A TAG 02620CSR SETOF 54 02630CSR READ REXTPTR 54 02640CSR 54 GOTO END203 02650CSR TPPN COMP RMPN 54 02660CSR 54 TPSEQ COMP RMSEQ 54 02670CSRN54 GOTO END203 02680CSR TPPTR COMP 0 54 02690CSRN54 GOTO T203A 02700CSR TPPTR CHAINREXTFILE 02710CSR EXSR SR74 DISPLAY TEXT. 02720CSR LINENO COMP 80 54 54 02730CSR 54 EXSR SR71 NEW PAGE 02740CSR GOTO T203A 02750CSR END203 ENDSR ÐÐ02760C******************************************************************** 02770CSR SR204 BEGSR 02780C* TOP OF FORM. 02790CSR EXITFZTFORM TOP FORM 02800CSR Z-ADD5 LINENO 30 02810CSR ENDSR 02820C******************************************************************** 02830CSR SR205 BEGSR 02840C* LINE FEED/CAR RET. 02850CSR EXITFQCLF 02860CSR 1 ADD LINENO LINENO 02870CSR ENDSR 02880O******************************************************************** 02890OCRTFILE E 41 02900O* PUT DATA AND HEADINGS. 02910O REC 212 02920O 151 'ROUTING OPERATION INQUIR' 02930O 152 'Y' 02940O*------------------------------------------------------------------- 02950O E 42 02960O REC 212 02970O 131 'SOURCE' 02980O 136 'FAB' 02990O 91 'PART-NUMBER' 03000O 105 'DESCRIPTION' ÐÐ03010O 148 'MODEL-NO.' 03020O 162 'PROD-LINE' 03030O*------------------------------------------------------------------- 03040O E 47 03050O REC 212 03060O NUMPN 92 ' - - ' 03070O PMDESC 123 03080O PMSC 129 03090O PMFAB 136 03100O PMMODL 151 03110O PMPRODZ 164 03120O*------------------------------------------------------------------- 03130O E 44 03140O REC 212 03150O 85 'OPER' 03160O 92 'OVLAP' 03170O 98 'OPER' 03180O 170 'LABOR HOURS' 03190O 183 'LOT' 03200O 195 'MIN-VEND' 03210O 201 'CHG' 03220O 206 'M' 03230O 212 'PERF' 03240O*------------------------------------------------------------------- 03250O E 45 ÐÐ03260O REC 212 03270O 83 'SEQ' 03280O 87 'GRP' 03290O 92 '%' 03300O 98 'CODE' 03310O 106 'DEPT-' 03320O 109 'WC' 03330O 122 'DESCRIPTION' 03340O 162 'SET-UP' 03350O 173 'RUN' 03360O 184 'SIZE' 03370O 194 'CHARGE' 03380O 202 'DATE' 03390O 206 'C' 03400O 212 'CODE' 03410O*------------------------------------------------------------------- 03420O E 72 03430O REC 212 03440O RMSEQ Z 83 03450O RMGRUP 87 03460O RMOVLPZ 91 03470O 92 '%' 03480O RMOPER 98 03490O RMDEPTZ 105 03500O 54 106 '-' ÐÐ03510O 54 RMWC 109 03520O RMDESC 151 03530O RMRSU 2 162 03540O RMRRUN2 173 03550O RMRLOT2 184 03560O RMRMIN2 194 03570O RMRDAT 204 ' - - ' 03580O RMPER22 212 03590O RMMETH 206 03600O*-------------------------------------------------------------- 03610O E 74 03620O* PUT TEXT LINE 03630O REC 212 03640O TXT 171 03650O TPLINEZ 109 ** MES ARRAY 003660---MESSAGE NOT ON FILE--- 003670** TABTRN/TABNAM 003680AADD 003690CCHANGE 003700DDELETE 003710** TABMET/TABMN 003720EESTIMATED 003730HHISTORICAL 003740/* 003750ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( !’ XR50 P999999120282(èÈÐ SUBROUTINE ZR50 (IBUF) 00010C RING BELL. READ 50-CHAR FROM TERMINAL. 00020 INTEGER IBUF (25) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 50 00070 ITC = 0 00080 IA = $0700 00090 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00100 RETURN 00110 END 00120_‚_‚ ÐÈ(Â!˜ ¼X009XP P120282120282(èÈÐ00010H Q009XP00020F* PRINT EXPLOSION RESULTS. (X009XP) DG REL006 OK 00030F* REVISED 1/18/81 2:10 PM. 00040FWOTRAN IP AF 80R I DISK U2 00050FPOTRAN IS AF 80R I DISK U3 00060FREQTRAN IS AF 80R I DISK U4 00070FXPMAST IS AF 99R I DISK U5 00080FXPADRT IR F 3 3IT EDISK U5 00090FWOADRT IR F 3 3IT EDISK U2 00100FRQADRT IR F 3 3IT EDISK U4 00110FPOADRT IR F 3 3IT EDISK U3 00120FPMMST2 IC F 674R12AI 1 DISK 00130FXPCONT IC F 128R DISK 00140FPRINT O F 132 OF PRINTER 00150E******************************************************************** 00160E XPADRT XPMAST 00170E WOADRT WOTRAN 00180E RQADRT REQTRAN 00190E POADRT POTRAN 00200E* PART # ARRAYS: 00210E ORD 1 18 6 0 ORDERS 00220E REQ 1 18 6 0 REQMTS 00230E AVL 1 18 6 0 AVAIL 00240E TBO 1 18 6 0 TO BE ORD 00250E SUR 1 18 6 0 SURPLUS ÐÐ00260E WEK 1 18 6 0A NET REQMTS 00270E WRD 1 18 6 0A NET ORDERS 00280E CUM 1 18 6 0A CUM AVAIL 00290E DAT 1 18 6 0 DATE HEADING 00300E* FINAL TOTALS: 00310E TORD 1 18 6 0 ORDERS 00320E TREQ 1 18 6 0 REQMTS 00330E TAVL 1 18 6 0 AVAIL 00340E TTBO 1 18 6 0 TO BE ORD 00350E TSUR 1 18 6 0 SURPLUS 00360E TCUM 1 18 6 0 CUM AVAIL 00370E WRK 1 18 6 0 WORK ARRAY 00380E XCD 18 6 0A SCHED DATES 00390E XPQ 18 7 0A FORECAST QTYS 00400I******************************************************************** 00410IXPMAST XP 06 00420I* EXPLOSION MASTER. 00430I* KEY AREA. 00440I* LOW LEVEL CODE 2N 00450I 1 20XPLL 00460I* COMPONENT PART # 10N 00470I 3 120PN L1M1 00480I* TOP ASSY PN 10N 00490I 13 220XPAPN 00500I* REQMTS 7P X 18 ÐÐ00510I P 23 94 XPQ 00520I* RECORD STATUS 1A 00530I 99 99 XPSTAT 00540I******************************************************************** 00550IXPCONT XC 00560I* EXPLOSION CONTROL MASTER. 00570I* DATES 6N X 18 00580I 1 108 XCD 00590I* CUR INDEX LEVEL 2N 00600I 127 1280XCCIL 00610I******************************************************************** 00620IWOTRAN WO 01 1 CW 2 CO 00630I* WORK ORDER TRANSACTION. 00640I* JOB # 6A 00650I 3 8 WOJOB 00660I* ACCOUNT # 5N 00670I 9 130WOACNT 00680I* PART # 10N 00690I 14 230PN L1M1 00700I* DESCRIPTION 8A 00710I 25 32 WODESC 00720I* TOP ASSY WO 6N 00730I 33 380WOTAWO 00740I* CODE 1A (M=THIS IS TOP W/O) 00750I 39 39 WOCODE ÐÐ00760I* TOP MCN 5N 00770I 40 440WOTMCN 00780I* END ITEM SCHED DATE 5N (MMDDY) 00790I 45 490WOEISD 00800I* QTY 7N 00810I 50 560WOQTY 00820I* K-CODE (MAT'L ISSUED) 00830I 57 57 WOKODE 00840I* LOT # 2N 00850I 58 590WOLOT 00860I* MODEL 10A 00870I 60 69 WOMODL 00880I* START DATE 6N (YYMMDD) 00890I 71 760DUEDAT 00900I GG 07 00910I******************************************************************** 00920IREQTRAN RT 02 1 CR 2 CQ 56 C4 00930I* BACKORDER RECORD. 00940I OR 03 1 CR 2 CQ 56 C5 00950I* ALLOCATION RECORD. 00960I OR 02 1 CR 2 CQ 56 C6 00970I* BACKORDER RECORD. 00980I* PART # 10N 00990I 3 120PN L1M1 01000I* DESCRIPTION 8A ÐÐ01010I 13 19 RTDESC 01020I* JOB # 6A 01030I 21 26 RTJOB 01040I* LOT # 3A (LXX) 01050I 27 29 RTLOT 01060I* TRANS DATE 5N (MMDDY) 01070I 31 350RTDATE 01080I* MCN # 5A 01090I 37 41 RTMCN 01100I* FAB CODE 2A 01110I 52 53 RTFABC 01120I* CARD CODE 1A 01130I* 4,6=BACKORDER 01140I* 5=ALLOCATION 01150I 56 56 RTCARD 01160I* QTY 6N 01170I 62 670RTQTY 01180I* START DATE 6N (FROM W/O) 01190I 71 760DUEDAT 01200I* INV TYPE 1A 01210I* 1 = F/G 01220I* 2 = DETAIL 01230I* 3 = S/A'S 01240I 79 79 RTINVC 01250I GG 07 ÐÐ01260I******************************************************************** 01270IPOTRAN PO 04 1 CP 2 CO 01280I* PURCH ORD TRANSACTION. 01290I* PART # 10N 01300I 3 120PN L1M1 01310I* DESCRIPTION 7A 01320I 13 19 PODESC 01330I* P.O. # 5N 01340I 22 260POPON 01350I* DUE DATE 6N (YYMMDD) 01360I 30 350DUEDAT 01370I* VENDOR # 5N 01380I 37 410POVEND 01390I* VENDOR NAME 10A 01400I 42 51 POVNAM 01410I* MO/DAY DUE 4N (MMDD) 01420I 52 550POMODU 01430I* PO CODE 2A ('P-O') 01440I 56 58 POPCOD 01450I* P-CODE 1A (P=FAB PER PRINT) 01460I 59 59 POPOCD 01470I* ITEM 2A 01480I 60 61 POITEM 01490I* QTY 6N 01500I 62 670POQTY ÐÐ01510I* PRICE 9.5N 01520I 69 765POPRIC 01530I* INV CODE 2A ('14') 01540I 78 79 POINVC 01550I GG 07 01560I******************************************************************** 01570IPMMST2 PM 01580I 31 59 PMDESC 01590I 94 95 PMSC 01600I P 311 3140PMOHB 01610I P 615 6193PMTCST 01620I 674 674 PMSTAT 01630C******************************************************************** 01640C* INITIALIZE. 01650C EXSR SR101 INIT. 01660C Z-ADD0 ZERO6 60 STUPIDITY. 01670C 65 01680COR H9 GOTO END 01690C* CUM TOTALS. 01700C SETON 80 01710C 82 SETON 81 01720C SETON 82 01730C 01 01740COR 04 EXSR SR102 CUM ORDERS. 01750C 02 ÐÐ01760COR 03 EXSR SR103 CUM REQMTS. 01770C 06 EXSR SR104 CUM FORECAST. 01780C*------------------------------------------------------------------- 01790C END TAG 01800C* PRINT PART # TOTALS. 01810CL1 80 EXSR SR105 01820C* PRINT FINAL TOTALS. 01830C******************************************************************** 01840CSR SR101 BEGSR 01850C* INITIALIZE. 01860CSRN79 EXSR SR201 1-TIME ONLY. 01870CSR EXSR SR202 EVERYTIME. 01880CSR L1 EXSR SR203 NEW PART #. 01890CSR ENDSR 01900C******************************************************************** 01910CSR SR102 BEGSR 01920C* CUM ORDERS. 01930CSR Z-ADD1 X 30 01940CSR DUEDAT LOKUPXCD,X 54 54 01950CSRN54 Z-ADD18 X 01960CSR 01 RTQTY ADD ORD,X ORD,X 01970CSR 04 POQTY ADD ORD,X ORD,X 01980CSR ENDSR 01990C******************************************************************** 02000CSR SR103 BEGSR ÐÐ02010C* CUM REQMTS. 02020CSR Z-ADD1 X 02030CSR DUEDAT LOKUPXCD,X 54 54 02040CSRN54 Z-ADD18 X 02050CSR RTQTY ADD REQ,X REQ,X 02060CSR ENDSR 02070C******************************************************************** 02080CSR SR104 BEGSR 02090C* CUM FORECAST. 02100CSR XPQ ADD REQ REQ 02110CSR XFOOTXPQ TOTEXP 60 02120CSR ENDSR 02130C******************************************************************** 02140CSR SR105 BEGSR 02150C* CUM PART # TOTALS. 02160C* AVAIL BAL. 02170CSR PMOHB ADD ORD,1 ORD,1 02180CSR ORD SUB REQ AVL AVAIL BAL. 02190CSR Z-ADD0 A 30 02200CSR Z-ADD1 X 30 02210CSR Z-ADD0 WRK 02220CSR Z-ADDAVL,1 WRK,1 02230C*------------------------------------------------------------------- 02240CSR T105A TAG 02250CSR 1 ADD X X ÐÐ02260CSR X COMP 18 54 02270CSR 54 GOTO T105B 02280CSR 1 ADD A A 02290CSR AVL,X ADD WRK,A WRK,X 02300CSR GOTO T105A 02310C*------------------------------------------------------------------- 02320CSR T105B TAG 02330C* TO BE ORD/SURPLUS. 02340CSR Z-ADDWRK CUM 02350CSR Z-ADD0 SUR SURPLUS 02360CSR Z-ADD0 TBO TO BE ORD 02370CSR Z-ADDREQ WEK REQMTS 02380CSR Z-ADDORD WRD ORDERS 02390CSR SETOF 7071 02400CSR Z-ADD1 R 30 ORDER INDEX 02410CSR Z-ADD1 E 30 REQMT INDEX 02420C*------------------------------------------------------------------- 02430CSR T105C TAG 02440CSR ZERO6 LOKUPWEK,E 70 GET REQMT 02450CSR ZERO6 LOKUPWRD,R 71 GET ORDER 02460CSRN70 GOTO T105E NO REQMTS 02470CSRN71 GOTO T105F NO ORDERS 02480C*------------------------------------------------------------------- 02490CSR T105D TAG 02500CSR WRD,R COMP WEK,E 545556 ÐÐ02510CSR 54 WRD,R SUB WEK,E WRD,R 71 02520CSR 54 Z-ADD0 WEK,E 70 02530CSR 55 WEK,E SUB WRD,R WEK,E 70 02540CSR 55 Z-ADD0 WRD,R 71 02550CSR 56 Z-ADD0 WRD,R 71 02560CSR 56 Z-ADD0 WEK,E 70 02570CSR GOTO T105C 02580C*------------------------------------------------------------------- 02590CSR T105E TAG 02600CSR Z-ADDWRD SUR SURPLUS 02610CSR GOTO T105H 02620C*------------------------------------------------------------------- 02630CSR T105F TAG 02640CSR Z-ADDWEK TBO TO BE ORD 02650C*------------------------------------------------------------------- 02660CSR T105H TAG 02670C* CUM FINAL TOTALS. 02680CSR U1 ORD MULT PMTCST ORD H 02690CSR U1 REQ MULT PMTCST REQ H 02700CSR U1 AVL MULT PMTCST AVL H 02710CSR U1 TBO MULT PMTCST TBO H 02720CSR U1 SUR MULT PMTCST SUR H 02730CSR U1 CUM MULT PMTCST CUM H 02740CSR U1 PMOHB MULT PMTCST PMOHB H 02750CSR ORD DIV 10 WRK H ÐÐ02760CSR WRK ADD TORD TORD ORDERS 02770CSR REQ DIV 10 WRK H 02780CSR WRK ADD TREQ TREQ REQMT 02790CSR AVL DIV 10 WRK H 02800CSR WRK ADD TAVL TAVL AVAIL 02810CSR TBO DIV 10 WRK H 02820CSR WRK ADD TTBO TTBO TO BE ORD 02830CSR SUR DIV 10 WRK H 02840CSR WRK ADD TSUR TSUR SURPLUS 02850CSR CUM DIV 10 WRK H 02860CSR WRK ADD TCUM TCUM 02870CSR ENDSR 02880C******************************************************************** 02890CSR SR201 BEGSR 02900C* 1-TIME INIT. 02910CSR SETON 79 02920CSR Z-ADD1 W5N 50 02930CSR W5N CHAINXPCONT H9 02940CSR H9 GOTO END201 02950CSR Z-ADDXCD DAT DATE HEADING 02960CSR MOVEL'00' DAT 02970CSR Z-ADD0 ZERO6 60 02980CSR END201 ENDSR 02990C******************************************************************** 03000CSR SR202 BEGSR ÐÐ03010C* EVERY-TIME INIT. 03020C* 03030C* 03040C* 03050CSR ENDSR 03060C******************************************************************** 03070CSR SR203 BEGSR 03080C* L1-NEW PN INIT. 03090CSR MOVELPN W12A 12 03100CSR MOVE ' ' W12A 03110CSR W12A CHAINPMMST2 65 03120CSRN65 PMSTAT COMP 'D' 65 03130CSRN65 MOVELPMSC W1A 1 03140CSRN65 W1A COMP 'P' 54 03150CSRN65N54 U7 SETON 65 03160CSRN65 54NU7 SETON 65 03170CSR SETOF 80 03180CSR ENDSR 03190O******************************************************************** 03200OPRINT D 201 80N81 03210O OR OF 03220O 70 'NET EXPLOSION' 03230O NU1 77 'PIECES' 03240O U1 78 'DOLLARS' 03250O U7 88 'PURCHASED' ÐÐ03260O NU7 88 'MFG PARTS' 03270O UDATE Y 8 03280O 127 'PAGE' 03290O PAGE 132 03300O*------------------------------------------------------------------- 03310O D 2 80N81 03320O OR OF 03330O DAT 132 ' - ' 03340O*------------------------------------------------------------------- 03350O TF11 L1 80 03360O PN 12 ' - - ' 03370O PMDESC B 44 03380O 51 'COST=' 03390O PMTCST2 64 03400O 72 'STOCK=' 03410O PMOHB K 82 03420O*------------------------------------------------------------------- 03430O TF 1 L1 80 03440O 5 'ORDER' 03450O ORD B 132 ' 0 -' 03460O*------------------------------------------------------------------- 03470O TF 1 L1 80 03480O 5 'REQ''D' 03490O REQ B 132 ' 0 -' 03500O*------------------------------------------------------------------- ÐÐ03510O TF 1 L1 80 03520O 5 'AVAIL' 03530O AVL B 132 ' 0 -' 03540O*------------------------------------------------------------------- 03550O TF 1 L1 80 03560O 3 'CUM' 03570O CUM B 132 ' 0 -' 03580O*------------------------------------------------------------------- 03590O TF 1 L1 80 03600O 5 'TBORD' 03610O TBO B 132 ' 0 -' 03620O*------------------------------------------------------------------- 03630O TF 1 L1 80 03640O 5 'SURPL' 03650O SUR B 132 ' 0 -' 03660O*------------------------------------------------------------------- 03670O T 2101 LR 03680O 14 'FINAL TOTALS--' 03690O*------------------------------------------------------------------- 03700O TF 1 LR 03710O 5 'ORDER' 03720O TORD 132 ' 0 -' 03730O*------------------------------------------------------------------- 03740O TF 1 LR 03750O 5 'REQ''D' ÐÐ03760O TREQ 132 ' 0 -' 03770O*------------------------------------------------------------------- 03780O TF 1 LR 03790O 5 'AVAIL' 03800O TAVL 132 ' 0 -' 03810O*------------------------------------------------------------------- 03820O TF 1 LR 03830O 3 'CUM' 03840O TCUM 132 ' 0 -' 03850O*------------------------------------------------------------------- 03860O TF 1 LR 03870O 5 'TBORD' 03880O TTBO 132 ' 0 -' 03890O*------------------------------------------------------------------- 03900O TF 1 LR 03910O 5 'SURPL' 03920O TSUR 132 ' 0 -' ** ORD ARRAY 003930 003940** REQ ARRAY 003950 003960** AVL ARRAY 003970 003980** TBO ARRAY 003990 004000ÐÐ** SUR ARRAY 004010 004020** WEK ARRAY 004030 004040** WRD ARRAY 004050 004060** CUM ARRAY 004070 004080** DAT ARRAY 004090 004100** TORD ARRAY 004110 004120** TREQ ARRAY 004130 004140** TAVL ARRAY 004150 004160** TTBO ARRAY 004170 004180** TSUR ARRAY 004190 004200** TCUM ARRAY 004210 004220** WRK ARRAY 004230 004240/* 004250ÐÐ_‚ ÐÐ_‚_‚ ÐÈ(à"U àÈX010CF PB120282120282(èÈÐ00010H Q010CF00020F* GEN CFKEYOUT FILE FOR CFMAST PRINT BY COMPANY, SELECTIVELY. (X010CF) 00030F* SWITCH-1 ON SELECTS ALL ACTIVE CFMAST FOR OUTPUT TO CFKEYOUT FILE 00040F* REVISED 4/25/80 11:15 PM. DG-REL006 OK. 00050FCFSELECTIP F 900 900 DISK 00060FCFMAST IS F 370 15AI 1 DISK 00070FCFKEYOUTO F 59 59 DISK 00080E******************************************************************** 00090E NA4 5 5 6 00100E NB4 5 5 4 0 00110E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00120E ERR 1 9 1 VERTICAL ERRORS 00130E WK2 11 11 2 00140E WK3 11 11 3 00150E BIT 33 1 00160E CFA 8 35 00170E CFN 5 3 00180E CFC 5 3 0 00190E NAC 24 1 00200E SET 9 1 0A 00210E FZIP 9 9 0A 00220E TZIP 9 9 0A 00230E NZIP 9 1 A 00240E STC 9 2 A 00250E NST 9 1 A ÐÐ00260E FC 9 35 A 00270E NFC 9 1 A 00280E MC1 9 3 A 00290E NM1 9 1 A 00300E MC2 9 3 A 00310E NM2 9 1 A 00320E SC 9 33 A 00330I******************************************************************** 00340ICFSELECTCS 10 00350I* MAIL LIST SELECTOR RECORD. 00360I* SET # 1N X 9 00370I 1 9 SET 00380I* FROM ZIP 9N X 9 00390I 10 90 FZIP 00400I* THRU ZIP 9N X 9 00410I 91 171 TZIP 00420I* NOT ZIP 1A X 9 00430I 172 180 NZIP 00440I* STATE CODE 2A X 9 00450I 181 198 STC 00460I* NOT STATE 1A X 9 00470I 199 207 NST 00480I* FRGN CTRY 35A X 9 00490I 208 522 FC 00500I* NOT FRGN CTRY 1A X 9 ÐÐ00510I 523 531 NFC 00520I* MAIL CODE-1 3A X 9 00530I 532 558 MC1 00540I* NOT MAIL CODE-1 1A X 9 00550I 559 567 NM1 00560I* MAIL CODE-2 3A X 9 00570I 568 594 MC2 00580I* NOT MAIL CODE-2 1A X 9 00590I 595 603 NM2 00600I* SELECTOR CODES 3A X 11 X 9 00610I* EA CODE=1 BYTE 00620I* NOT CODE= 1 BYTE 00630I* BOTH ARE R.J. IN 3-BYTE ELEMENT 00640I* (LEFTMOST BYTE IS BLANK) 00650I 604 900 SC 00660I******************************************************************** 00670ICFMAST CF 01 00680I* CATALOG HOLDER (MAIL LIST) MASTER. 00690I* KEY AREA. 00700I* NAME KEY 15A 00710I 1 15 CFKEY 00720I* ADDRESS LINES 35A X 8 00730I 16 295 CFA 00740I* STATE CODE 2A 00750I 296 297 CFSTCD ÐÐ00760I* ZIP 9P 00770I P 298 3020CFZIP 00780I* CATALOGS. 00790I* NAME 3A X 5 00800I 303 317 CFN 00810I* COPIES 3P X 5 00820I P 318 327 CFC 00830I* SELECTOR CODES 24 X 1A 1 00840I 328 351 NAC 00850I* TELEPHONE # 12A 00860I 352 363 CFTEL 00870I* DATE LAST UPDATE 6N (YMD) 00880I 364 3690CFDLT 00890I* RECORD STATUS 1A 00900I 370 370 CFSTAT 00910C******************************************************************** 00920C* INITIALIZE - 1 TIME. 00930C 10 EXSR SR101 INIT. 00940C 10 GOTO END 00950C*------------------------------------------------------------------- 00960C SETOF 65 00970C CFSTAT COMP 'D' 54 00980C 54 SETOF 01 00990C 54 GOTO END DELETED CFMAST. 01000C U1 GOTO END ÐÐ01010C MOVE CFN NA4 01020C Z-ADDCFC NB4 01030C CFSTCD COMP ' ' 54 01040C 54 CFSTCD LOKUPTABSC TABSCN 54 01050C 54 MOVELTABSCN W20A 20 01060C N54 MOVE BLK35 W20A 01070C* TEST RECORD. 01080C MOVE ' ' ERR 01090C 02 EXSR SR202 ZIP CODE. 01100C 03 EXSR SR203 STATE CODE. 01110C 04 EXSR SR204 FRGN CTRY. 01120C 05 EXSR SR205 MAILER CODE. 01130C 06 EXSR SR206 SELECTOR CODE. 01140C* CHECK TEST RESULTS. SET 01 OFF IF NOT A HIT. 01150C Z-ADD0 X 01160C*-------------------------------------------------------------- 01170C TAG100 TAG 01180C 1 ADD X X 01190C X COMP 9 54 01200C 54 SETOF 01 01210C 54 GOTO END DONE- ALL ERRORS 01220C SET,X COMP 0 54 01230C N54 GOTO TAG100 NO TEST DATA 01240C ERR,X COMP ' ' 54 01250C N54 GOTO END GOT A HIT ÐÐ01260C GOTO TAG100 TRY AGAIN 01270C*---------------------------------------------------------------- 01280C END TAG 01290C******************************************************************** 01300CSR SR101 BEGSR 01310C* INITIALIZE 1-TIME. 01320C* FLAG ZIP CODE. 01330CSR U1 GOTO T101A SEE F-SPECS 01340CSR Z-ADD1 X 30 01350CSR EXSR SR102 01360CSR 54 01370COR 55 SETON 02 ZIP CODE. 01380C* FLAG STATE CODE. 01390CSR Z-ADD1 X 01400CSR EXSR SR103 01410CSR 54 01420COR 55 SETON 03 STATE CODE. 01430C* FLAG FOREIGN COUNTRY. 01440CSR Z-ADD1 X 01450CSR EXSR SR104 01460CSR 54 01470COR 55 SETON 04 FRGN CTRY. 01480C* FLAG MAILER CODES. 01490CSR Z-ADD1 X 01500CSR EXSR SR105 ÐÐ01510C*------------------------------------------------------------------ 01520CSR T101A TAG 01530C* DEFINE WORK FIELDS 01540CSR 54 01550COR 55 01560COR 56 01570COR 57 SETON 05 MAILER CODES. 01580C* FLAG SELECTOR CODES. 01590CSR Z-ADD1 X 01600CSR EXSR SR106 01610CSR 54 SETON 06 SELECTOR CODES. 01620C* DEFINE WORK FIELDS. 01630CSR 79 GOTO END101 01640CSR SETON 79 01650CSR Z-ADD0 ZERO9 90 01660CSR MOVE ' ' BLK33 33 01670CSR MOVE ' ' BLK16 16 01680CSR MOVE ' ' BLK35 35 01690CSR END101 ENDSR 01700C******************************************************************** 01710CSR SR102 BEGSR 01720C* FIND ZIP TEST DATA. 01730CSR Z-ADDX A 30 01740CSR Z-ADDX B 30 01750CSR ZERO9 LOKUPTZIP,A 54 ÐÐ01760CSR ' ' LOKUPNZIP,B 55 01770CSR 54 55 A COMP B 56 01780CSR 54 55 56 Z-ADDB X 01790CSR 54 55N56 Z-ADDA X 01800CSR 54N55 Z-ADDA X 01810CSRN54 55 Z-ADDB X 01820CSR ENDSR 01830C******************************************************************** 01840CSR SR103 BEGSR 01850C* FIND STATE CODE TEST DATA. 01860CSR Z-ADDX A 01870CSR Z-ADDX B 01880CSR ' ' LOKUPSTC,A 54 01890CSR ' ' LOKUPNST,B 55 01900CSR 54 55 A COMP B 56 01910CSR 54 55 56 Z-ADDB X 01920CSR 54 55N56 Z-ADDA X 01930CSR 54N55 Z-ADDA X 01940CSRN54 55 Z-ADDB X 01950CSR ENDSR 01960C******************************************************************** 01970CSR SR104 BEGSR 01980C* FIND FOR COUNTRY TEST DATA. 01990CSR Z-ADDX A 02000CSR Z-ADDX B ÐÐ02010CSR BLK35 LOKUPFC,A 54 02020CSR ' ' LOKUPNFC,B 55 02030CSR 54 55 A COMP B 56 02040CSR 54 55 56 Z-ADDB X 02050CSR 54 55N56 Z-ADDA X 02060CSR 54N55 Z-ADDA X 02070CSRN54 55 Z-ADDB X 02080CSR ENDSR 02090C******************************************************************** 02100CSR SR105 BEGSR 02110C* FIND MAILER TEST DATA. 02120CSR Z-ADDX A 02130CSR Z-ADDX B 02140CSR ' ' LOKUPMC1,A 54 02150CSR ' ' LOKUPNM1,B 55 02160CSR 54 55 A COMP B 58 02170CSR 54 55 58 Z-ADDB X 02180CSR 54 55N58 Z-ADDA X 02190CSR 54N55 Z-ADDA X 02200CSRN54 55 Z-ADDB X 02210CSR Z-ADDX A 02220CSR Z-ADDX B 02230CSR ' ' LOKUPMC2,A 56 02240CSR ' ' LOKUPNM2,B 57 02250CSR 56 57 A COMP B 58 ÐÐ02260CSR 56 57 58 Z-ADDB X 02270CSR 56 57N58 Z-ADDA X 02280CSR 56N57 Z-ADDA X 02290CSRN56 57 Z-ADDB X 02300CSR ENDSR 02310C******************************************************************** 02320CSR SR106 BEGSR 02330C* FIND SELECTOR CODE TEST DATA. 02340CSR BLK33 LOKUPSC,X 54 02350CSR ENDSR 02360C******************************************************************** 02370CSR SR202 BEGSR 02380C* TEST ZIP CODE. 02390CSR Z-ADD1 X 30 02400C*------------------------------------------------------------------- 02410CSR T202A TAG 02420CSR SETOF 99 02430CSR EXSR SR102 FIND ZIP. 02440CSRN54N55 GOTO END202 02450CSR CFZIP COMP FZIP,X 54 54 02460CSR 54 CFZIP COMP TZIP,X 5454 02470CSR NZIP,X COMP ' ' 55 02480CSRN54N55 02490COR 54 55 SETON 99 FAILURE. 02500CSR 99 MOVE 'E' ERR,X ÐÐ02510CSR EXSR SR301 UP-X. 02520CSRN54 GOTO T202A 02530CSR END202 ENDSR 02540C******************************************************************** 02550CSR SR203 BEGSR 02560C* TEST STATE CODE. 02570CSR Z-ADD1 X 02580C*------------------------------------------------------------------- 02590CSR T203A TAG 02600CSR SETOF 99 02610CSR EXSR SR103 FIND STATE CODE 02620CSRN54N55 GOTO END203 DONE. 02630CSR CFSTCD COMP STC,X 54 02640CSR NST,X COMP ' ' 55 02650CSR 54 55 02660CORN54N55 SETON 99 02670CSR 99 MOVE 'E' ERR,X 02680CSR EXSR SR301 UP-X. 02690CSRN54 GOTO T203A 02700CSR END203 ENDSR 02710C******************************************************************** 02720CSR SR204 BEGSR 02730C* TEST FRGN CTRY. 02740CSR Z-ADD1 X 02750C*------------------------------------------------------------------- ÐÐ02760CSR T204A TAG 02770CSR SETOF 99 02780CSR EXSR SR104 FIND CTRY. 02790CSRN54N55 GOTO END204 DONE. 02800CSR CFA,8 COMP FC,X 54 02810CSR NFC,X COMP ' ' 55 02820CSR 54 55 02830CORN54N55 SETON 99 02840CSR 99 MOVE 'E' ERR,X 02850CSR EXSR SR301 UP-X. 02860CSRN54 GOTO T204A 02870CSR END204 ENDSR 02880C******************************************************************** 02890CSR SR205 BEGSR 02900C* TEST MAIL CODES. 02910CSR Z-ADD1 X 02920C*------------------------------------------------------------------- 02930CSR T205A TAG 02940CSR SETOF 99 02950CSR EXSR SR105 FIND MAIL CODE. 02960CSRN54N55 GOTO T205B DONE 1ST PASS. 02970CSR MC1,X LOKUPCFN 54 02980CSR NM1,X COMP ' ' 55 02990CSR 54 55 03000CORN54N55 SETON 99 ÐÐ03010CSR 99 MOVE 'E' ERR,X 03020CSR EXSR SR301 UP-X. 03030CSRN54 GOTO T205A 03040C*------------------------------------------------------------------- 03050CSR T205B TAG 03060CSR Z-ADD1 X 03070C*------------------------------------------------------------------- 03080CSR T205C TAG 03090CSR SETOF 99 03100CSR EXSR SR105 FIND MAIL CODE. 03110CSRN56N57 GOTO END205 DONE 2ND PASS. 03120CSR MC2,X LOKUPCFN 54 03130CSR NM2,X COMP ' ' 55 03140CSR 54 55 03150CORN54N55 SETON 99 FAILURE. 03160CSR 99 MOVE 'E' ERR,X 03170CSR EXSR SR301 UP-X. 03180CSRN54 GOTO T205B 03190CSR END205 ENDSR 03200C******************************************************************** 03210CSR SR206 BEGSR 03220C* TEST SELECTOR CODES. 03230CSR Z-ADD0 S 30 03240C*------------------------------------------------------------------- 03250CSR T206A TAG ÐÐ03260CSR 1 ADD S S 03270CSR S COMP 9 54 03280CSR 54 GOTO END206 03290CSR SET,S COMP 0 54 03300CSRN54 GOTO T206A 03310CSR SC,S COMP BLK33 54 03320CSRN54 GOTO T206A 03330CSR MOVEASC,S WK3 03340CSR MOVE WK3 WK2 03350CSR Z-ADD0 X 03360C*------------------------------------------------------------------- 03370CSR T206B TAG 03380CSR SETOF 99 03390CSR 1 ADD X X 03400CSR X COMP 11 54 03410CSR 54 GOTO T206A 03420CSR WK2,X COMP ' ' 54 03430CSRN54 GOTO T206B 03440CSR MOVELWK2,X W1A 1 SELECTOR CODE. 03450CSR W1A LOKUPNAC 54 03460CSR MOVE WK2,X W1A NOT FLAG. 03470CSR W1A COMP ' ' 55 03480CSR 54 55 03490CORN54N55 SETON 99 03500CSR 99 MOVE 'E' ERR,S ÐÐ03510CSR 99 GOTO T206A 03520CSR GOTO T206B 03530CSR END206 ENDSR 03540C******************************************************************** 03550CSR SR301 BEGSR 03560C* INCREASE INDEX. 03570CSR 1 ADD X X 03580CSR X COMP 9 54 03590CSR ENDSR 03600O******************************************************************** 03610OCFKEYOUTD 01 03620O CFA,3 35 03630O CFKEY 50 03640O CFZIP 59 ** NA4 ARRAY 003650 003660** NB4 ARRAY 003670 003680** TABSC/TABSCN --- STATE CODES/NAMES 003690 003700ALALABAMA 003710AKALASKA 003720AZARIZONA 003730ARARKANSAS 003740ASAMERICAN SAMOA 003750ÐÐCACALIFORNIA 003760CZCANAL ZONE 003770COCOLORADO 003780CTCONNECTICUT 003790DEDELAWARE 003800DCDISTRICT OF COLUMBIA 003810FLFLORIDA 003820GAGEORGIA 003830GUGUAM 003840HIHAWAII 003850IDIDAHO 003860ILILLINOIS 003870ININDIANA 003880IAIOWA 003890KSKANSAS 003900KYKENTUCKY 003910LALOUISIANA 003920MEMAINE 003930MDMARYLAND 003940MAMASSACHUSETTS 003950MIMICHIGAN 003960MNMINNESOTA 003970MSMISSISSIPPI 003980MOMISSOURI 003990MTMONTANA 004000ÐÐNENEBRASKA 004010NVNEVADA 004020NHNEW HAMPSHIRE 004030NJNEW JERSEY 004040NMNEW MEXICO 004050NYNEW YORK 004060NCNORTH CAROLINA 004070NDNORTH DAKOTA 004080OHOHIO 004090OKOKLAHOMA 004100OROREGON 004110PAPENNSYLVANIA 004120PRPUERTO RICO 004130RIRHODE ISLAND 004140SCSOUTH CAROLINA 004150SDSOUTH DAKOTA 004160TNTENNESSEE 004170TTTRUST TERRITORIES 004180TXTEXAS 004190UTUTAH 004200VTVERMONT 004210VAVIRGINIA 004220VIVIRGIN ISLANDS 004230WAWASHINGTON 004240WVWEST VIRGINIA 004250ÐÐWIWISCONSIN 004260WYWYOMING 004270** ERR ARRAY 004280 004290** WK2 ARRAY 004300 004310** WK3 ARRAY 004320 004330/* 004340_‚ ÐÐ ÐÐ _‚_‚ ÐÈ(ô# ôÑX012CM P ø120282120282(èÈÐ00010H Q012CM00020F* PRINT CUSTOMER MAST LABELS BY SELECTED CUST CLASS, EXPORT CODES.(X012CM)00030F* REVISED 10/14/82 10:10 AM. 00040F* 00050F* SWITCH-2 CONDITIONS PRINTING MAILER,CLASS,EXPORT CODES 1ST LINE 00060F* SWITCH-1 CONDITIONS MATCH/BYPASS PRIOR TO SPECIFIED CUST # 00070F* 00080FBITTAB IP F 33 DISK 00090FCMSELECTIS F 128 DISK 00100FCMMAST IS F 576R 5I DISK 00110FCMADRT IR F 300 3 3IT EDISK 00120FPRINT O F 132 LPRINTER 00130FTERM80 O F 80 5 00140E******************************************************************** 00150E CMADRT CMMAST 00160E TABSTC 1 58 2 TABSCN 20 STATE NAMES. 00170E TABCLC 1 17 2 TABCLN 20 CUST CLASS NAMES. 00180E TABTAX 1 5 1 TABTAN 20 TAX CODES. 00190E TABTER 1 5 3 TABTN 20 TERRITORY NAMES 00200E A36 36 36 1 A 00210E BIT 33 1 00220E CMA 7 35 A 00230E CMB 10 9 2 00240E CMS 10 9 2 00250E CMAR 4 9 2 ÐÐ00260E CMD 5 7 0 00270E CMM 3 3 00280E CMC 3 2 0 00290E CLN 8 1 CLASS NOT 00300E CLC 8 2 A CLASS CODE 00310E CEN 8 1 EXPORT NOT 00320E CEC 8 1 A EXPORT CODE 00330L***************************************************************** 00340LPRINT 88FL 88OL 00350I******************************************************************** 00360IBITTAB BT 00370I 1 33 BIT 00380I******************************************************************** 00390ICMSELECTCS 01 00400I* SELECTION CODES RECORD. 00410I* CLASS CODES. 00420I 1 1 CLN,1 00430I 3 4 CLC,1 00440I 6 6 CLN,2 00450I 8 9 CLC,2 00460I 11 11 CLN,3 00470I 13 14 CLC,3 00480I 16 16 CLN,4 00490I 18 19 CLC,4 00500I 21 21 CLN,5 ÐÐ00510I 23 24 CLC,5 00520I 26 26 CLN,6 00530I 28 29 CLC,6 00540I 31 31 CLN,7 00550I 33 34 CLC,7 00560I 36 36 CLN,8 00570I 38 39 CLC,8 00580I* EXPORT CODES. 00590I 41 41 CEN,1 00600I 43 43 CEC,1 00610I 45 45 CEN,2 00620I 47 47 CEC,2 00630I 49 49 CEN,3 00640I 51 51 CEC,3 00650I 53 53 CEN,4 00660I 55 55 CEC,4 00670I 57 57 CEN,5 00680I 59 59 CEC,5 00690I 61 61 CEN,6 00700I 63 63 CEC,6 00710I 65 65 CEN,7 00720I 67 67 CEC,7 00730I 69 69 CEN,8 00740I 71 71 CEC,8 00750I******************************************************************** ÐÐ00760ICMMAST CM 02 576NCD 00770I* CUSTOMER MASTER. 00780I* CUSTOMER NO. 5N 00790I 1 50CMCUST 00800I* SORT (ALT) KEY 20A 00810I 6 25 CMSORT 00820I* ADDRESS 35A X 7 00830I 26 270 CMA 00840I* STATE CODE 2A 00850I 271 272 CMSTCD 00860I* ZIP CODE 9P 00870I P 273 2770CMZIP 00880I* PHONE NO. 15A 00890I 278 292 CMPHON 00900I* CONTACT NAME 35A 00910I 293 327 CMCONT 00920I* REMARKS 35A 00930I 328 362 CMREM 00940I* CUSTOMER CLASS 2A 00950I 363 364 CMCLAS 00960I* TERRITORY CODE 3A 00970I 365 367 CMTER 00980I* CREDIT LIMIT 7P 00990I P 368 3710CMCRLM 01000I* PAYMENT TERMS 8A ÐÐ01010I 372 379 CMTERM 01020I* NUMBER OF INVOICE COPIES 1N 01030I 380 3800CMINV 01040I* SHIPPING METHOD 20A 01050I 381 400 CMSHIP 01060I* CURRENT BACKLOG 9.2P X 10 01070I P 401 450 CMB 01080I* LAST 12-MOS SHIPMENTS 9.2P X 10 01090I P 451 500 CMS 01100I* CURRENT RECEIVABLES 9.2P X 4 01110I P 501 520 CMAR 01120I* TAX CODE 1A 01130I 521 521 CMTAX 01140I* STD DISCOUNT 3.2P 01150I P 522 5232CMDISC 01160I* EXPORT CODE 1A 01170I 524 524 CMEXPT 01180I* DATE HISTORY 7P X 5 01190I* 1 = DATE INPUT 01200I* 2 = DATE LAST ORDER 01210I* 3 = DATE LAST SHIPMENT 01220I* 4 = NOT USED 01230I* 5 = NOT USED 01240I P 525 544 CMD 01250I* GEOGRAPHIC CODE 5A ÐÐ01260I 545 549 CMGEO 01270I* HOLD CODE 1A 01280I 550 550 CMHOLD 01290I* MAILING CODES. 01300I* MAILER CODES 3 X 3A 01310I 551 559 CMM 01320I* NUMB OF COPIES 3 X 2N 01330I 560 565 CMC 01340I* POINTERS. 01350I* CREDIT CHANGES 5P 01360I P 575 5750CMFCC 01370I* RECORD STATUS 1A 01380I 576 576 CMSTAT 01390I GG 03 01400C******************************************************************** 01410C N79 EXSR SR101 01420C N02 GOTO END 01430C U1 CMCUST COMP BEGKEY 54 54 01440C U1N54 SETOF 02 01450C U1N54 GOTO END 01460C Z-ADD0 X 30 01470C SETOF 98 01480C*------------------------------------------------------------------- 01490C START TAG 01500C SETOF 99 ÐÐ01510C 1 ADD X X 01520C X COMP 8 54 01530C 54 GOTO END 01540C CMCLAS COMP ' ' 55 CUST CLASS EXISTS 01550C CMCLAS COMP CLC,X 56 CUST = SELECT 01560C CLC,X COMP ' ' 57 SEL CLAS EXISTS 01570C CLN,X COMP ' ' 58 NOT NOT ON 01580C 57 58 GOTO START 01590C 56N58 SETON 99 = 01600C 58N57N56 SETON 99 NOT = 01610C 99 GOTO START 01620C CMEXPT COMP ' ' 55 01630C CMEXPT COMP CEC,X 56 01640C CEC,X COMP ' ' 57 01650C CEN,X COMP ' ' 58 01660C 57 58 99 GOTO START 01670C 57 58 SETON 98 01680C 57 58 GOTO END 01690C 56N58 01700COR 58N57N56 SETON 99 01710C 99 GOTO START 01720C SETON 98 01730C*------------------------------------------------------------------- 01740C END TAG 01750C N98 SETOF 02 ÐÐ01760C 02 EXSR SR102 01770C******************************************************************** 01780CSR SR101 BEGSR 01790CSR SETON 79 01800CSR MOVE ' ' BLK35 35 01810CSR MOVE ' ' BLK36 36 01820CSR U1 SETON 85 01830CSR U1 EXCPT REQUEST CUST # 01840CSR U1 SETOF 85 01850CSR MOVELBIT,1 BUFLGT 2 01860CSR U1 MOVE BIT,4 BUFLGT 01870CSR U1 MOVE ' ' W6A 6 01880CSR U1 EXITFQWREED READ BEG KEY 01890CSR RLABL W6A 01900CSR RLABL BUFLGT 01910CSR U1 Z-ADD6 W2N 20 01920CSR U1 EXIT SUBRAJ R.J. 01930CSR RLABL W2N 01940CSR RLABL W6A 01950CSR U1 MOVE W6A BEGKEY 50 01960C*------------------------------------------------------------------ 01970CSR T101A TAG 01980CSR SETON 81 01990CSR EXCPT 02000CSR EXCPT ÐÐ02010CSR EXCPT 02020CSR EXCPT 02030CSR EXCPT 02040CSR EXCPT 02050CSR EXCPT 02060CSR EXCPT 02070CSR EXCPT 02080CSR EXCPT 02090CSR EXCPT 02100CSR SETOF 81 02110CSR SETON 84 02120CSR EXCPT 02130CSR SETOF 84 02140CSR 1 ADD COUNT COUNT 02150CSR COUNT COMP 4 54 54 02160CSRN54 GOTO T101A 02170CSR SETON 83 02180CSR EXCPT SET PRINTER MSG 02190CSR SETOF 83 02200CSR MOVE BIT,3 BUFLGT 02210CSR MOVE ' ' W4A 4 02220CSR EXITFQWREED READ CRT 02230CSR RLABL W4A 02240CSR RLABL BUFLGT 02250CSR MOVE ' ' A36 ÐÐ02260CSR MOVEAW4A A36 02270CSR Z-ADD1 X 02280CSR ' ' LOKUPA36,X 54 02290CSRN54 GOTO T101A 02300CSR MOVEAA36,X W2A 2 02310CSR W2A COMP 'OK' 54 02320CSRN54 Z-ADD0 COUNT 02330CSRN54 GOTO T101A 02340CSR END101 ENDSR 02350C******************************************************************** 02360CSR SR102 BEGSR 02370C* PRINT LABEL. 02380CSR Z-ADD0 COUNT 02390CSR U2 Z-ADD3 COUNT 02400CSR U2 SETOF 56 02410CSR U2 SETON 8155 02420CSR U2 EXCPT PRINT CODES 1ST LINE 02430CSR U2 SETON 56 02440CSR U2 EXCPT PRINT 2ND LINE 02450CSR U2 SETOF 5556 02460CSR U2 EXCPT PRINT SPACES 02470CSR U2 SETOF 81 02480CSR Z-ADD1 X 02490C*------------------------------------------------------------------- 02500CSR T102A TAG ÐÐ02510CSR BLK35 LOKUPCMA,X 54 02520CSRN54 GOTO END102 02530CSR MOVELCMA,X W36A 36 02540CSR X COMP 6 54 02550CSR 54 EXSR SR103 02560CSR SETON 80 02570CSR EXCPT 02580CSR SETOF 80 02590C*** MOVELW36A W132A 132 02600C*** EXITFQPRITE 02610C*** RLABL W132A 02620CSR 1 ADD COUNT COUNT 30 02630CSR MOVE BLK35 CMA,X 02640CSR GOTO T102A 02650C*------------------------------------------------------------------- 02660CSR END102 TAG 02670CSR 1 ADD COUNT COUNT 02680CSR SETOF 55 02690CSR COUNT COMP 12 54 02700CSR 54 GOTO EXT102 02710CSR SETON 81 02720CSR EXCPT 02730CSR SETOF 81 02740C**** MOVELW36A W132A 132 02750C**** EXITFQPRITE ÐÐ02760C**** RLABL W132A 02770CSR GOTO END102 02780CSR EXT102 ENDSR 02790C******************************************************************** 02800CSR SR103 BEGSR 02810C* BUILD CITY/STATE/ZIP LINE. 02820CSR MOVE ' ' A36 02830CSR MOVEACMA,X A36,1 02840CSR Z-ADD37 A 30 02850C*------------------------------------------------------------------- 02860CSR T103A TAG 02870CSR A SUB 1 A 54 02880CSRN54 GOTO END103 02890CSR A36,A COMP ' ' 54 02900CSRN54 GOTO T103A 02910CSR 1 ADD A A 02920CSR A COMP 36 54 02930CSR 54 GOTO END103 02940CSR MOVE ',' A36,A 02950CSR 2 ADD A A 02960CSR A COMP 36 54 02970CSR 54 GOTO END103 02980CSR CMSTCD COMP ' ' 54 02990CSR 54 MOVEACMSTCD A36,A 03000CSR 3 ADD A A ÐÐ03010CSR A COMP 36 54 03020CSR CMZIP COMP 0 55 03030CSRN54 55 MOVE CMZIP W5A 5 1 03040CSRN54 55 MOVEAW5A A36,A 03050CSR MOVEAA36 W36A 03060CSR END103 ENDSR 03070O******************************************************************** 03080OPRINT E 1 80 03090O W36A B 36 03100O*------------------------------------------------------------------- 03110O E 1 81 03120O BLK36 36 03130O U2N55 BLK36 36 03140O U2 55N56CMCLAS 20 03150O U2 55N56CMEXPT 24 03160O U2 55N56CMM,1 28 03170O U2 55N56CMM,2 32 03180O U2 55N56CMM,3 36 03190O U2 55 56CMC,1 Z 28 03200O U2 55 56CMC,2 Z 32 03210O U2 55 56CMC,3 Z 36 03220O*--------------------------------------------------------------- 03230O E 84 03240O 74 'XXXXXXXXXXXXXXXXXXXXXXXX' 03250O****************************************************************** ÐÐ03260OTERM80 E 83 03270O 24 'ADJUST LABELS IN PRINTER' 03280O E 1 83 03290O 24 'SET PRINTER 8-LPI ' 03300O E 85 03310O U1 24 'ENTER STARTING CUST # ' ** TABSTC/TABSCN - STATE CODES 003320 003330ALALABAMA 003340AKALASKA 003350AZARIZONA 003360ARARKANSAS 003370ASAMERICAN SAMOA 003380CACALIFORNIA 003390CZCANAL ZONE 003400COCOLORADO 003410CTCONNECTICUT 003420DEDELAWARE 003430DCDISTRICT OF COLUMBIA 003440FLFLORIDA 003450GAGEORGIA 003460GUGUAM 003470HIHAWAII 003480IDIDAHO 003490ILILLINOIS 003500ÐÐININDIANA 003510IAIOWA 003520KSKANSAS 003530KYKENTUCKY 003540LALOUISIANA 003550MEMAINE 003560MDMARYLAND 003570MAMASSACHUSETTS 003580MIMICHIGAN 003590MNMINNESOTA 003600MSMISSISSIPPI 003610MOMISSOURI 003620MTMONTANA 003630NENEBRASKA 003640NVNEVADA 003650NHNEW HAMPSHIRE 003660NJNEW JERSEY 003670NMNEW MEXICO 003680NYNEW YORK 003690NCNORTH CAROLINA 003700NDNORTH DAKOTA 003710OHOHIO 003720OKOKLAHOMA 003730OROREGON 003740PAPENNSYLVANIA 003750ÐÐPRPUERTO RICO 003760RIRHODE ISLAND 003770SCSOUTH CAROLINA 003780SDSOUTH DAKOTA 003790TNTENNESSEE 003800TTTRUST TERRITORIES 003810TXTEXAS 003820UTUTAH 003830VTVERMONT 003840VAVIRGINIA 003850VIVIRGIN ISLANDS 003860WAWASHINGTON 003870WVWEST VIRGINIA 003880WIWISCONSIN 003890WYWYOMING 003900** TABCLC/TABCLN - CUST CLASS NAMES 00391010COMMERCIAL END USER 00392015U.S. GOVERNMENT 00393020GENERAL O.E.M. 00394021BROADCAST O.E.M. 0395030GENERAL LINE DEALER 00396031BROADCAST DEALER 00397033BROADCAST DLR,BRANCH 00398034GEN LINE DLR,BRANCH 00399035DESIGNATED PROD DLR 004000ÐÐ50SPECIAL 00401060AVIONICS END USER 00402065AVIONICS OEM 00403070AVIONICS DISTRIB 00404075AVIONICS REPAIR SHOP 00405090AVIONICS SPECIAL 00406098TO BE DELETED 00407099DISCONTINUED DLR 004080** TABTAX/TABTAN - TAX CODE RATES 0040901CA NON-TAXABLE,CARD 0041002CA NON-TAXABLE,NO CD 0041103NON-TAXABLE,US GOVT 0041204NON-TAXABLE,OTHER 0041305TAXABLE 004140** TABTER/TABTN - TERRITORY NAMES 004150 004160 004170 004180 004190 004200** A36 ARRAY 004210 004220/* 004230_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–#ð –?X010DP P120282120282(èÈÐ00010H Q010DP00020F* DISPLAY HEX CHAR. (X010DP) 00030F* REVISED 4/18/79 3:20 PM. 00040FBITHEX IP F 256 DISK 00050FTERMO O F 132 5 00060E******************************************************************** 00070E HEX 1 256 2 00080E NUM 1 256 3 00090E WK 8 8 1 00100E AH 1 256 2 00110E AB 1 256 8 00120E H1 16 16 1 00130E BIT 256 1 00140E REC 256 1 00150I******************************************************************** 00160IBITHEX BT 01 00170I 1 256 REC 00180I 1 256 BIT 00190C******************************************************************** 00200C EXSR SR101 00210C Z-ADD0 X 30 00220C*------------------------------------------------------------------- 00230C START TAG 00240C 1 ADD X X 00250C X COMP 256 54 ÐÐ00260C 54 GOTO END 00270C Z-ADD1 H 30 00280C REC,X LOKUPBIT,H 88 00290C N88 MOVE 'XX' AH,X 00300C SETOF 505152 00310C SETOF 535455 00320C SETOF 5657 00330C MOVE '0' WK 00340C TESTB'0' REC,X 50 00350C 50 MOVE '1' WK,1 00360C TESTB'1' REC,X 51 00370C 51 MOVE '1' WK,2 00380C TESTB'2' REC,X 52 00390C 52 MOVE '1' WK,3 00400C TESTB'3' REC,X 53 00410C 53 MOVE '1' WK,4 00420C TESTB'4' REC,X 54 00430C 54 MOVE '1' WK,5 00440C TESTB'5' REC,X 55 00450C 55 MOVE '1' WK,6 00460C TESTB'6' REC,X 56 00470C 56 MOVE '1' WK,7 00480C TESTB'7' REC,X 57 00490C 57 MOVE '1' WK,8 00500C MOVEAWK AB,X ÐÐ00510C N88 MOVE 'XXX' NUM,X 00520C 88 MOVE H NUM,X 00530C 88 MOVE HEX,H AH,X 00540C GOTO START 00550C*------------------------------------------------------------------- 00560C END TAG 00570C Z-ADD0 X 30 00580C*------------------------------------------------------------------- 00590C LR10 TAG 00600C 1 ADD X X 00610C 1 ADD COUNT COUNT 30 00620C COUNT COMP 56 54 00630C 54 EXITFXPAUSE 00640C 54 Z-ADD1 COUNT 00650C X COMP 33 69 00660C 69 X COMP 128 68 00670C SETON 80 00680C EXCPT 00690C SETOF 80 00700C X COMP 256 54 00710C N54 GOTO LR10 00720C*------------------------------------------------------------------- 00730C ENDLR TAG 00740C EXITFXPAUSE 00750C MOVE ' ' NUM ÐÐ00760C MOVE ' ' AH 00770C MOVE ' ' BLK8 8 00780C MOVE BLK8 AB 00790C Z-ADD0 X 00800C GOTO START 00810C******************************************************************** 00820CSR SR101 BEGSR 00830CSR Z-ADD0 A 30 00840CSR Z-ADD0 T 30 00850C*------------------------------------------------------------------- 00860CSR T101A TAG 00870CSR 1 ADD A A 00880CSR A COMP 16 54 00890CSR 54 GOTO END101 00900C*------------------------------------------------------------------- 00910CSR T101B TAG 00920CSR Z-ADD0 B 30 00930C*------------------------------------------------------------------- 00940CSR T101C TAG 00950CSR 1 ADD B B 00960CSR B COMP 16 54 00970CSR 54 GOTO T101A 00980CSR 1 ADD T T 00990CSR MOVELH1,A HEX,T 01000CSR MOVE H1,B HEX,T ÐÐ01010CSR GOTO T101C 01020CSR END101 ENDSR 01030O******************************************************************** 01040OTERMO E 80 01050O X Z 3 01060O 69N68 REC,X 6 01070O NUM,X 11 01080O AH,X 16 01090O AB,X 28 ** HEX ARRAY 001100 001110** NUM ARRAY 001120 001130** WK ARRAY 001140 001150** AH ARRAY 001160 001170** AB ARRAY 001180 001190** H1 ARRAY 0012000123456789ABCDEF 001210/* 001220_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(–$0 –?X010EE P120282120282(èÈÐ00010H Q010EE00020F* UPDATE 'EJ' DEPT # FROM 'EE' RECORD. CALLED BY Q002EE 00030F* AT END OF JOB. (X010EE) 00040F* REVISED 8-27-79 2:00 PM. 00050F* 00060FBITTAB IP F 33 DISK 00070FEMPLFILEUD F 64L14AI 1 DISK 00080E******************************************************************** 00090E BIT 33 1 00100I******************************************************************** 00110IBITTAB BT 00120I 1 33 BIT 00130I******************************************************************** 00140IEMPLFILEEE 01 1 CE 00150I* RECORD CODE 2A 00160I* E = EMPLOYEE/USER CROSS-REF 00170I* U = USER/EMPLOYEE CROSS-REF 00180I* J = EMPLOYEE/JOB 00190I 1 1 EEREC 00200I 1 1 DREC 00210I* EMPLOYEE # 5N 00220I 2 60EEEMPL 00230I* USER-ID 8A 00240I 15 22 EEUSER 00250I* EMPLOYEE NAME 20A ÐÐ00260I 23 42 EENAME 00270I* EMPLOYEE DEPT # 5N 00280I 43 470EEDEPT 00290I* RECORD STATUS 1A 00300I 64 64 EESTAT 00310I*------------------------------------------------------------------- 00320I EU 02 1 CU 00330I 1 1 EUREC 00340I 1 1 DREC 00350I 2 9 EUUSER 00360I 15 190EUEMPL 00370I 64 64 EUSTAT 00380I*------------------------------------------------------------------- 00390I EJ 03 1 CJ 00400I 1 1 EJREC 00410I 1 1 DREC 00420I 2 60EJEMPL 00430I 7 90EJSEQ 00440I 15 49 EJDESC 00450I 50 55 EJJOB 00460I 56 600EJDEPT 00470I 64 64 EJSTAT 00480I*----------------------------------------------------------------- 00490I EG 10 00500I 1 1 DREC ÐÐ00510C******************************************************************** 00520C START TAG 00530C* GET NEXT 'EE' RECORD. 00540C 1 ADD EMPLOY EMPLOY 50 00550C MOVEL'E' W6A 6 00560C MOVE EMPLOY W6A 00570C MOVELW6A W14A 14 00580C W14A SETLLEMPLFILE 00590C SETOF 54 00600C READ EMPLFILE 54 00610C 54 GOTO END END OF FILE. 00620C DREC COMP 'E' 54 00630C N54 GOTO END 00640C Z-ADDEEEMPL EMPLOY 00650C MOVE EESTAT STAT 1 00660C Z-ADDEEDEPT DEPT 50 DEPT #. 00670C* SET-UP 'EJ' RECORD READ. 00680C MOVEL'J' W6A 00690C MOVE EMPLOY W6A 00700C MOVELW6A W14A 00710C W14A SETLLEMPLFILE 00720C*------------------------------------------------------------------- 00730C CONTU TAG 00740C SETOF 54 00750C READ EMPLFILE 54 ÐÐ00760C 54 GOTO START 00770C DREC COMP 'J' 54 00780C 54 EJEMPL COMP EMPLOY 54 00790C N54 GOTO START 00800C Z-ADDDEPT EJDEPT 00810C EJSTAT COMP 'D' 54 00820C N54 MOVE STAT EJSTAT 00830C SETON 80 00840C EXCPT REWRT 'EJ' REC. 00850C SETOF 80 00860C GOTO CONTU 00870C*------------------------------------------------------------------- 00880C END TAG 00890C SETON LR 00900C MOVEL'QQDP02' PROG 8 00910C EXITFCHAIN 00920C RLABL PROG 00930O******************************************************************** 00940OEMPLFILEE 80 00950O EJDEPT 60 00960O EJSTAT 64 /* 000970_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼$p ¼$X004WO P999999120282(èÈÐ00010H Q004WO00020F* DISPLAY WOMAST FILE- DUE DATE SEQ. (X004WO) 00030F* REVISED 10-20-82 3:45 PM. 132-1 00040FBITPAR IP F 90 DISK 00050FWOMAST IC F 228R 9AI 1 DISK 00060FALTDUE ID F 32L29AI 1 DISK 00070FCRTFILE UC F 256R DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FPRODWO IT F 80 EDISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E PRODWO TABPRX 1 4 1 TABPD 35 WORK ORDER PREFIXES 00130E NUL 1 132 1 NULL CHAR 00140E A20 20 20 1 A INPUT DATA ARRAY 00150E DOT 1 66 2 00160E LNK 1 7 6 A 00170E CALL 7 6 00180E TST 25 1 00190E BIT 33 1 SCREEN CONTR. CHAR 00200E PAR 25 1 00210E PLT 8 3 0 00220I******************************************************************* 00230IBITPAR BT 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I****************************************************************** 00280ICRTFILE CR 00290I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00300I* EMPLOYEE # 5N 00310I 1 50CREMPL 00320I* USER CODE 8A 00330I 6 13 CRUSER 00340I* DEPT # 5N 00350I 14 180CRDEPT 00360I* JOB NAME 8A (JOB LOADED BY MENU) 00370I 19 26 CRJOB 00380I* SHUTDOWN FLAG 1A 00390I* BLANK = NO SHUTDOWN 00400I 27 27 CRSHUT 00410I* TIME STARTED 6N 00420I 28 330CRTIME 00430I* DATE STARTED 4N 00440I 34 370CRDATE 00450I* CALL STACK 7 X 6A 00460I 38 79 CALL 00470I******************************************************************** 00480IWOMAST WO 00490I* WORK ORDER MASTER. 00500I* WORK ORDER NO. ÐÐ00510I 1 9 WOWO 00520I* PRIME 6A 00530I 1 1 PREFIX 00540I 1 6 WOWOP 00550I* DASH 3N 00560I 7 90WOWOD 00570I* PART NO. 10N 00580I 10 190WOPN 00590I* TOP ASSY PN 10N 00600I 20 290WOTAPN 00610I* RUN NO. 3N 00620I 30 320WORUN 00630I* PROD LINE 4N 00640I 33 360WOPL 00650I* SCHED QTY 7P 00660I P 37 400WOQTYS 00670I* FILLER 41 44 FFFFFF 00680I* COMPLETED QTY 7P 00690I P 45 480WOQTYC 00700I* START DATE 6N (YMD) 00710I 49 540WOSTRT 00720I* DUE DATE 6N (YMD) 00730I 55 600WODUE 00740I* DATE ENTERED 6N (YMD) 00750I 61 660WODATE ÐÐ00760I* DATE LAST REL 6N (YMD) 00770I 67 720WODLTR 00780I* DATE LAST COMPLETION 6N (YMD) 00790I 73 780WODLTC 00800I* DATE LAST LABOR 6N (YMD) 00810I 79 840WODLTL 00820I* DATE LAST MATL CHARGE 6N (YMD) 00830I 85 900WODLTM 00840I* LABOR HRS CHARGED 7.1P 00850I P 91 941WOLABH 00860I* LABOR $ CHARGED 9.3P 00870I P 95 993WOLAB$ 00880I* MATL $ CHARGED 9.3P 00890I P 100 1043WOMAT$ 00900I* QTY TRSF 7P 00910I P 105 1080WOQTYT 00920I* AMOUNT TRANSFERRED 9.3P 00930I P 109 1133WO$T 00940I* REMARKS 35A 00950I 114 148 WODESC 00960I* MODEL NO. 12A 00970I 149 160 WOMODL 00980I* FAB CODE 2A 00990I 161 162 WOFAB 01000I* ALTERNATE BILL OF MATERIAL PART NO. 10N ÐÐ01010I 163 1720WOABM 01020I* ALTERNATE ROUTING PART NO. 10N 01030I 173 1820WOARPN 01040I* DATE CLOSED 6N (YMD) 01050I 183 1880WOCLOS 01060I* BUDGET/STANDARD 01070I* LABOR HRS 7P 01080I P 189 1920WOBLHR 01090I* LABOR $ 9.3P 01100I P 193 1973WOBL$ 01110I* MATERIAL $ 11.3P 01120I P 198 2033WOBM$ 01130I* LABOR BURDEN CHARGED 9.3P 01140I P 204 2083WOBUR$ 01150I* LABOR BURDEN BUDGET 9.3P 01160I P 209 2133WOLB$ 01170I* RECORD STATUS 1A 01180I 228 228 WOSTAT 01190I******************************************************************* 01200IALTDUE AD 01210I* ALTERNATE KEY - DUE DATE 01220I 1 29 ADKEY 01230I* RECORD CODE 2A 01240I 1 2 ADREC 01250I* DUE DATE 6N (YMD) ÐÐ01260I 3 80ADDUE 01270I* ORDER NO. 11A 01280I 9 19 ADORD 01290I* PART # 10N (REQUIREMENTS ONLY) 01300I 20 290ADPN 01310I* RECORD STATUS 1A 01320I 32 32 ADSTAT 01330I********************************************************************* 01340IPMMST2 PM 01350I* PART MASTER 01360I* MODEL NO. 12A 01370I 19 30 PMMODL 01380I* DESCRIPTION 29A 01390I 31 59 PMDESC 01400I* LEAD TIME 8 X 3P 01410I P 113 128 PLT 01420I 674 674 PMSTAT 01430C******************************************************************** 01440C* 1-TIME INIT 01450C EXSR SR101 INIT 01460C MOVE ' ' BLK6 6 01470C EXSR SR70 CLEAR PAGE 01480C N50 MOVEL'091' RPGLIN 4 01490C 50 MOVE '001' RPGLIN 01500C MOVEL'001' RPGCOL 4 ÐÐ01510C EXSR SR69 MOVE CURSOR 01520C*------------------------------------------------------------- 01530C START TAG 01540C* REQUEST WORK ORDER 01550C EXSR SR68 LF 01560C SETON 72 01570C EXCPT PROMPT 01580C SETOF 72 01590C EXSR SR75 READ CRT 01600C*-------------------------------------------------------------- 01610C TAG5 TAG 01620C* SET-UP 1ST DISPLAY 01630C MOVELW20A W15A 15 01640C Z-ADD15 W2N 20 01650C EXIT SUBRAJ RJ 01660C RLABL W2N 01670C RLABL W15A 01680C MOVE W15A TDUE 60 DUE DATE 01690C MOVELTDUE W2N 01700C W2N COMP 12 54 01710C N54 MOVELTDUE W4N 40 01720C N54 MOVE TDUE W2N 01730C N54 MOVELW2N TDUE 01740C N54 MOVE W4N TDUE 01750C MOVE TDUE W8A 8 ÐÐ01760C MOVEL'20' W8A 01770C MOVELW8A W29A 29 01780C MOVE BLK35 LSTKEY 29 01790C W29A SETLLALTDUE 01800C EXSR SR70 NEW PAGE 01810C*--------------------------------------------------------------- 01820C TAG10 TAG 01830C SETOF 54 01840C READ ALTDUE 54 GET ALT KEY 01850C 54 GOTO TAG200 END FILE 01860C ADKEY COMP LSTKEY 54 01870C N54 GOTO TAG200 END FILE(WRAPAROUND)01880C MOVE ADKEY LSTKEY 01890C ADREC COMP '20' 54 01900C N54 GOTO TAG200 01910C ADSTAT COMP 'D' 54 01920C 54 GOTO TAG10 DELETED 01930C MOVELADORD W9A 9 01940C W9A CHAINWOMAST 60 01950C N60 WOSTAT COMP 'D' 60 01960C 60 GOTO TAG10 01970C EXSR SR301 CLASSIFY WO PREFIX 01980C 40 EXSR SR302 EDIT PART NO. 01990C 40 EXSR SR303 EDIT TOP ASSY 02000C 40 EXSR SR304 EDIT ALT PN ÐÐ02010C WOWOD COMP 0 55 02020C EXSR SR71 PUT DATA 02030C*------------------------------------------------------------------ 02040C TAG100 TAG 02050C EXSR SR75 READ CRT 02060C N77 EXSR SR70 NEW PAGE 02070C N77 GOTO TAG10 GET NEXT WO 02080C GOTO TAG5 SET-UP NEW WO 02090C*----------------------------------------------------------------- 02100C TAG200 TAG 02110C* END FILE MESSAGE 02120C SETON 73 02130C EXCPT END FILE MSG 02140C SETOF 73 02150C GOTO TAG100 02160C*------------------------------------------------------------------ 02170C NEWITM TAG 02180C* SET-UP LINK FOR NEW ITEM 02190C MOVEL'Q004WO' PROG 8 02200C GOTO END 02210C*------------------------------------------------------------------- 02220C MENU TAG 02230C* SET-UP LINK TO MENU 02240C EXSR SR96 02250C Z-ADD1 W ÐÐ02260C BLK6 LOKUPLNK,W 54 >>>>>>>>>> 02270C 54 MOVELLNK,W PROG 02280C 54 MOVE BLK6 LNK,W 02290C N54 MOVEL'CONTU' PROG 02300C EXSR SR97 02310C EXSR SR98 02320C*-------------------------------------------------------------------- 02330C GOODBY TAG 02340C* LINK TO SIGN-OFF 02350C MOVEL'GOODBY' PROG 02360C GOTO END 02370C*------------------------------------------------------------------- 02380C END TAG 02390C EXSR SR96 02400C EXSR SR97 02410C EXSR SR98 02420C*------------------------------------------------------------------- 02430C ENDJOB TAG 02440C MOVEL'ENDJOB 'PROG 02450C EXSR SR98 02460C***************************************************************** 02470CSR SR67 BEGSR 02480CSR EXITFQBELL RING BELL 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR68 BEGSR 02520CSR EXITFZLF LINE FEED 02530CSR ENDSR 02540C**************************************************************** 02550CSR SR69 BEGSR 02560CSRN50 EXITFZMOVXY MOVE CURSOR 02570CSR RLABL RPGLIN 02580CSR RLABL RPGCOL 02590CSR 50 EXITFZPUTXY 02600CSR RLABL RPGLIN 02610CSR RLABL RPGCOL 02620CSR ENDSR 02630C***************************************************************** 02640CSR SR70 BEGSR 02650C* CLEAR TERM SCREEN. 02660CSR 50 EXITFZESCH CLEAR SCREEN 02670CSRN50 EXITFZCPAGE CLEAR SCREEN 02680CSR ENDSR 02690C********************************************************************** 02700CSR SR71 BEGSR 02710C* PUT HEADINGS TO TERMINAL 02720CSR SETON 71 02730CSR EXCPT PUT HEADINGS 02740CSR SETOF 71 02750CSR ENDSR ÐÐ02760C********************************************************************* 02770CSR SR72 BEGSR 02780C* PUT DATA TO TERMINAL 02790CSR SETON 72 02800CSR EXCPT PUT DATA 02810CSR SETOF 72 02820CSR ENDSR 02830C******************************************************************* 02840CSR SR75 BEGSR 02850C* READ FROM TERMINAL 02860CSR SETOF 779096 02870CSR SETOF 93 02880CSR MOVE BLK20 W20A 20 BUFFER 02890CSR EXITFZR20 READ FROM TERMINAL 02900CSR RLABL W20A READ BUFFER 02910CSR MOVEAW20A A20 INPUT DATA ARRAY 02920CSR MOVE BLK20 W20A INIT INPUT ARRAY 02930CSR Z-ADD1 W 30 02940CSR '\' LOKUPA20,W 90 FLAG ESC 02950CSRN90 GOTO T75B NOT ESC 02960CSR 1 ADD W W 02970CSR W COMP 20 54 02980CSR 54 GOTO T75A BAD ESC 02990CSR A20,W COMP 'G' 98 GOODBY 03000CSR A20,W COMP 'E' 94 MENU ÐÐ03010CSR A20,W COMP 'B' 93 SKIP BACK 03020CSRN93 A20,W COMP 'N' 93 NEW ITEM 03030CSRN93 A20,W COMP 'D' 93 DONE 03040CSR 98 GOTO GOODBY 03050CSR 94 GOTO MENU 03060CSR 93 GOTO NEWITM 03070C*------------------------------------------------------------------ 03080CSR T75A TAG 03090C* BAD ESC INPUT DEFAULT. 03100CSR GOTO SR75 03110C*-------------------------------------------------------------------- 03120CSR T75B TAG 03130C* MOVE DATA 03140CSR Z-ADD1 W 03150CSR ' ' LOKUPA20,W 77 03160CSR 77 MOVEAA20,W W20A INPUT DATA 03170CSR END75 ENDSR 03180C********************************************************************* 03190CSR SR83 BEGSR 03200C* GET PART MAST. 03210CSR MOVE ' ' W12A 03220CSR W12A CHAINPMMST2 60 03230CSRN60 PMSTAT COMP 'D' 60 03240CSR ENDSR 03250C******************************************************************** ÐÐ03260CSR SR96 BEGSR 03270CSR # CHAINCRTFILE H9 GET CRTFILE 03280CSR H9 GOTO ENDJOB 03290CSR ENDSR 03300C******************************************************************** 03310CSR SR97 BEGSR 03320C* UPDATE CRTFILE. EXIT PROGRAM. 03330CSR TIME CRTIME 03340CSR MOVELUDATE CRDATE 03350CSR SETON 97 03360CSR EXCPT UPD CRTFILE 03370CSR SETOF 97 03380CSR ENDSR 03390C******************************************************************** 03400CSR SR98 BEGSR 03410CSR EXSR SR70 CLEAR SCREEN 03420CSR EXITFCHAIN >>>>>>>>>> 03430CSR RLABL PROG 03440CSR ENDSR 03450C******************************************************************** 03460CSR SR101 BEGSR 03470C* 1-TIME INITIALIZE 03480CSR MOVE BIT,1 NUL 03490CSR MOVE '- ' DOT 03500CSR EXITFZISTAT ÐÐ03510CSR MOVE ' ' BLK20 20 03520C* GET PORT # AND CRTFILE 03530CSR MOVE ' ' W2A 2 03540CSR EXITFZGMINX GET PORT # 03550CSR RLABL W2A 03560CSR MOVE W2A # 20 PORT NO. 03570CSR # COMP 0 54 03580CSRN54 Z-ADD25 # DEFAULT 03590CSR EXSR SR96 03600CSR MOVE CALL LNK 03610CSR PAR,# COMP '1' 50 03620CSR TST,# COMP 'S' 54 03630CSR 54 MOVE 'SHUTDOWN'PROG 03640CSR EXSR SR97 03650CSR 54 EXSR SR98 03660C* DEFINE WORK FIELDS,ETC. 03670CSR MOVELUDATE W4N 40 03680CSR MOVE UDATE W2N 03690CSR MOVELW2N TODAY 60 03700CSR MOVE W4N TODAY 03710CSR MOVE ' ' BLK35 35 03720CSR MOVE ' ' BLK6 6 03730CSR ENDSR 03740C******************************************************************** 03750CSR SR301 BEGSR ÐÐ03760C* CLASSIFY WO-PREFIX (40=INVENTORY ITEM). 03770CSR PREFIX LOKUPTABPRX TABPD 40 03780CSR 40 MOVELTABPD WOTYPE 36 03790CSRN40 MOVE BLK35 WOTYPE 03800CSRN40 MOVELBLK35 WOTYPE 03810CSR ENDSR 03820C******************************************************************** 03830CSR SR302 BEGSR 03840C* GET WORK ORDER PART MASTER. 03850CSR MOVE BLK35 DESCWO 03860CSR MOVE BLK35 MODLWO 03870CSRN40 GOTO END302 03880CSR WOPN COMP 0 55 03890CSRN55 GOTO END302 03900CSR MOVELWOPN W12A 12 03910CSR EXSR SR83 GET PART MASTER 03920CSR 60 GOTO END302 03930CSR MOVE PMDESC DESCWO 29 SAVE DESCRIPTION 03940CSR MOVE PMMODL MODLWO 12 SAVE MODEL NO. 03950CSR XFOOTPLT LEAD 40 03960CSR END302 ENDSR 03970C******************************************************************** 03980CSR SR303 BEGSR 03990C* GET TOP ASSY PART MASTER. 04000CSR MOVE BLK35 TADESC ÐÐ04010CSR MOVE BLK35 TAMODL 04020CSRN40 GOTO END303 NOT INVENTORY ITEM 04030CSR WOTAPN COMP 0 54 04040CSRN54 GOTO END303 NOT INPUT 04050CSR MOVELWOTAPN W12A 04060CSR EXSR SR83 GET PART MASTER 04070CSRN60 MOVE PMDESC TADESC 29 04080CSRN60 MOVE PMMODL TAMODL 12 04090CSR END303 ENDSR 04100C******************************************************************** 04110CSR SR304 BEGSR 04120CSR MOVE BLK35 ABMDES 04130CSR MOVE BLK35 ARPDES 04140C* GET ALT BM PART MASTER. 04150CSR WOABM COMP 0 54 04160CSRN54 GOTO T304C 04170CSR MOVELWOABM W12A 04180CSR EXSR SR83 GET PART MAST 04190CSRN60 MOVE PMDESC ABMDES 29 04200C*------------------------------------------------------------------- 04210CSR T304C TAG 04220C* GET ALT ROUTING PART MASTER. 04230CSR WOARPN COMP 0 54 04240CSRN54 GOTO END304 04250CSR MOVELWOARPN W12A ÐÐ04260CSR EXSR SR83 GET PART MAST 04270CSRN60 MOVE PMDESC ARPDES 29 04280CSR END304 ENDSR 04290O******************************************************************** 04300OTERM132 E 71 04310O BIT,28 1 04320O N50 8 '8091001' 04330O N50 BIT,1 9 04340O N50 BIT,1 10 04350O 50 10 '[001 ]001' 04360O 50 BIT,28 6 04370O UDATE 18 ' - - ' 04380O 50 'W O R K' 04390O 62 'O R D E R' 04400O 78 'D I S P L A Y' 04410O 102 ' - DUE DATE SEQUENCE' 04420O*------------------------------------------------------------------- 04430O E 71 04440O 115 'E R R O R S' 04450O*------------------------------------------------------------------- 04460O E 71 04470O 23 ' WORK ORDER PRIME/' 04480O 27 'DASH' 04490O WOWOP 40 04500O 55 41 '-' ÐÐ04510O 55 WOWOD 44 04520O WOTYPE 83 04530O*------------------------------------------------------------------- 04540O E 71 04550O 14 ' PART NO.' 04560O WOPN 46 ' - - ' 04570O DESCWO 77 04580O 84 'MODEL:' 04590O MODLWO 97 04600O*------------------------------------------------------------------- 04610O E 71 04620O 23 ' TOP ASSY PART NO.' 04630O 84 'MODEL:' 04640O WOTAPN 46 ' - - ' 04650O TADESC 77 04660O TAMODL 97 04670O*----------------------------------------------------------------- 04680O E 71 04690O 22 ' TOP ASSY RUN NO.' 04700O WORUN Z 36 04710O*----------------------------------------------------------------- 04720O E 71 04730O 25 ' QUANTITY SCHEDULED ' 04740O WOQTYS2 43 04750O*---------------------------------------------------------------- ÐÐ04760O E 71 04770O 14 ' DUE DATE' 04780O WODUE 42 ' - - ' 04790O*------------------------------------------------------------------- 04800O E 71 04810O 16 ' START DATE' 04820O WOSTRT 42 ' - - ' 04830O*--------------------------------------------------------------------- 04840O E 71 04850O 13 ' REMARKS' 04860O WODESC 69 04870O*----------------------------------------------------------------- 04880O E 71 04890O 15 ' MODEL NO.' 04900O WOMODL 46 04910O*----------------------------------------------------------------- 04920O E 71 04930O 20 ' ALTERNATE BILL' 04940O 29 'MATERIAL' 04950O WOABM 46 ' - - ' 04960O ABMDES 77 04970O*-------------------------------------------------------------------- 04980O E 71 04990O 24 ' ALTERNATE ROUTING ' 05000O WOARPN 46 ' - - ' ÐÐ05010O ARPDES 77 05020O*------------------------------------------------------------------- 05030O E 71 05040O 28 'LABOR-HRS' 05050O 49 'LABOR-$' 05060O 72 'MATERIAL-$' 05070O 93 'BURDEN-$' 05080O*------------------------------------------------------------------- 05090O E 71 05100O 12 'B U D G E T:' 05110O WOBLHRK 28 05120O WOBL$ K 49 05130O WOBM$ K 72 05140O WOLB$ K 93 05150O*------------------------------------------------------------------- 05160O E 71 05170O 12 'A C T U A L:' 05180O WOLABHK 28 05190O WOLAB$K 49 05200O WOMAT$K 72 05210O WOBUR$K 93 05220O*------------------------------------------------------------------- 05230O E 71 05240O 18 'QUANTITY COMPLETED' 05250O 32 ':' ÐÐ05260O WOQTYC2 43 05270O 85 'DATE ENTERED' 05280O 98 ':' 05290O WODATE 108 ' - - ' 05300O*----------------------------------------------------------------- 05310O E 71 05320O 11 'DATE CLOSED' 05330O 32 ':' 05340O WOCLOS 42 ' - - ' 05350O 90 'DATE RELEASED ' 05360O 98 ':' 05370O WODLTR 108 ' - - ' 05380O*-------------------------------------------------------------------- 05390O E 71 05400O 20 'DATE LAST COMPLETION' 05410O 32 ':' 05420O WODLTC 42 ' - - ' 05430O 88 'DATE LAST LABOR' 05440O 98 ':' 05450O WODLTL 108 ' - - ' 05460O*------------------------------------------------------------------- 05470O E 71 05480O 21 'DATE LAST STOCK ISSUE' 05490O 32 ':' 05500O WODLTM 42 ' - - ' ÐÐ05510O*----------------------------------------------------------------- 05520O E 71 05530O 13 'PRODUCT CLASS' 05540O 32 ':' 05550O WOPL Z 38 05560O 81 'FAB CODE' 05570O 98 ':' 05580O WOFAB 102 05590O*----------------------------------------------------------------- 05600O E 71 05610O NUL 132 05620O BIT,11 2 05630O BIT,14 3 05640O 27 'ENTER NEW DUE DATE, RETU' 05650O 51 'RN, OR \ESC CODE........' 05660O*----------------------------------------------------------------- 05670O E 73 05680O OR 72 05690O NUL 132 05700O BIT,11 1 05710O 72 24 'ENTER DUE DATE..........' 05720O 73 24 'END OF FILE.............' 05730O******************************************************************* 05740OCRTFILE E 97 05750O PROG 26 ÐÐ05760O CRTIME 33 05770O CRDATE 37 05780O LNK 79 05790O********************************************************************** ** NUL ARRAY 005800 005810** A20 ARRAY 005820 005830** DOT ARRAY 05840 - - - - - - - - - - - -> 05850** LNK ARRAY 05860 05870/* 05880_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(X%• XúX010GL P120282120282(èÈÐ00010H Q010GL00020F* DISPLAY ACCT INDENTED WHERE-USED. (X010GL) D A T A G R A P H I X 00030F* REVISED 7-29-81 10:10 AM. DG-REL006 OK. 00040F* MENU: MQGL01, MQGL02 00050FBITHEX IP F 256 DISK 00060FMGFILE IC F 80R DISK 00070FCAMAST IC F 40R18AI 1 DISK 00080FGLMAST IC F 165R 9AI 1 DISK 00090FGLWU ID F 19L18AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A8 8 8 1 A INPUT DATA ARRAY 00140E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00150E DUN 13 13 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E LEV 1 20 18 00180E DASH 1 1 43 00190E A24 24 24 1 00200E BIT 256 1 SCREEN CONTR. CHAR 00210E GLA 12 11 2 00220I******************************************************************* 00230IBITHEX BT 00240I 1 256 BIT 00250I******************************************************************* ÐÐ00260IMGFILE MG 00270I* MESSAGE FILE. 00280I 1 35 MGTEXT 00290I******************************************************************** 00300IGLMAST GL 00310I* ACCOUNT MASTER. 00320I* KEY AREA 00330I* ACCOUNT # 9A 00340I 1 9 GLKEY 00350I 1 1 GLPRFX 00360I 2 60GLPRIM 00370I 7 90GLDASH 00380I* ACCOUNT GROUP 4A 00390I 14 17 GLGRUP 00400I* ACCOUNT DESCRIPTION 40A 00410I 18 57 GLDESC 00420I* BALANCE FORWARD AMOUNT 11.2P 00430I P 58 632GLBALF 00440I* ACTUAL $ 11.2P X 12 00450I P 64 135 GLA 00460I* CURRENT MONTH-PLUS 11.2P 00470I P 136 1412GLCMP 00480I* CURRENT MONTH-MINUS 11.2P 00490I P 142 1472GLCMM 00500I* SOURCE CODE 1A ÐÐ00510I* S = SUB-ACCOUNT ONLY, 00520I* MAY NOT BE PARENT 00530I 148 148 GLSC 00540I* BALANCE FORWARD CODE 2A 00550I* 1ST COL 00560I* 1 = ZERO BAL AT START NEW YR 00570I* 2 = CARRY PREV YR FRWD 00580I* 2ND COL 00590I* A = ZERO BAL AT START NEW MO 00600I* B = CARRY PREV MO FRWD 00610I 149 150 GLBFC 00620I* NUMB OF SUB-ACCOUNTS 5P 00630I P 157 1590GLNOSA 00640I* LOW LEVEL CODE 3N 00650I 160 1620GLLL 00660I* FILLER 00670I* RECORD STATUS 1A 00680I 165 165 GLSTAT 00690I******************************************************************** 00700IGLWU GW 00710I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00720I* KEY AREA. 00730I* SUB-ACCOUNT 9A 00740I 1 9 GWSUB 00750I* PARENT ACCOUNT 9A ÐÐ00760I 10 18 GWPAR 00770I* RECORD STATUS 1A 00780I 19 19 GWSTAT 00790I******************************************************************** 00800ICAMAST CA 00810I* CHART OF ACCOUNTS. 00820I* KEY AREA. 00830I* PARENT ACCOUNT 9A 00840I 1 9 CAPAR 00850I* SUB-ACCOUNT 9A 00860I 10 18 CASUB 00870I* OPERATOR 1A 00880I* S = SUBTRACT 00890I* A = ADD 00900I 25 25 CAOPER 00910I* EFFECTIVITY 00920I* START DATE 6N (YMD) 00930I 26 310CASDAT 00940I* END DATE 6N (YMD) 00950I 32 370CAEDAT 00960I* FILLER 00970I* RECORD STATUS 1A 00980I 40 40 CASTAT 00990C******************************************************************** 01000C* INITIALIZE ÐÐ01010C EXSR SR101 1-TIME INIT 01020C*------------------------------------------------------------------ 01030C START TAG 01040C* SET-UP 1ST FIELD NO. 01050C MOVE ' ' DUN INIT EDIT ARRAY 01060C Z-ADD1 F 30 FIELD # 01070C GOTO READ 01080C*------------------------------------------------------------------ 01090C NEXT TAG 01100C* SET-UP NEXT FIELD NO. 01110C 1 ADD F F FIELD # 01120C*----------------------------------------------------------------- 01130C READ TAG 01140C* READ DATA FROM TERMINAL. 01150C SETOF 9096 01160C EXSR SR102 VALIDATE FIELD # 01170C 55 GOTO UPDATE DONE 01180C EXSR SR201 IDENTIFY-F 01190C 01 GOTO NEXT 01200C 01 Z-ADD362 M 50 ENTER PREFIX 01210C 02 Z-ADD363 M ENTER PRIME 01220C 03 Z-ADD364 M ENTER DASH 01230C EXSR SR89 GET MSG 01240C SETON 69 01250C EXSR SR73 PROMPT ÐÐ01260C SETOF 69 01270C EXSR SR75 READ TERMINAL 01280C 98 GOTO GOODBY GOODBY 01290C 94 GOTO MENU MENU REQUEST 01300C 93 GOTO NEWITM NEW ITEM 01310C 92 GOTO JUMP FIELD JUMP REQST 01320C 91 GOTO NEXT SKIP FORWARD 01330C 89 F SUB 1 F SKIP BACKWARD 01340C 89 EXSR SR201 01350C 89 01 Z-ADD2 F 01360C 89 GOTO READ " " 01370C 88 SETOF 90 SPACE FILL 01380C 88 SETON 77 " " 01390C 87 GOTO START 01400C 86 GOTO UPDATE UPDATE 01410C 85 GOTO READ REPEAT 01420C 96 GOTO ERROR ERROR 01430C*------------------------------------------------------------------ 01440C PROCES TAG 01450C* PROCESS INPUT DATA 01460C EXSR SR103 MOVE DATA 01470C N96 EXSR SR104 EDIT DATA 01480C 96 GOTO ERROR ERROR 01490C GOTO NEXT 01500C*------------------------------------------------------------------ ÐÐ01510C UPDATE TAG 01520C* UPDATE DATA BASE. 01530C EXSR SR106 UPDATE 01540C 96 GOTO ERROR ERROR 01550C GOTO START 01560C*------------------------------------------------------------------- 01570C JUMP TAG 01580C* SET-UP JUMP TO REQUESTED FIELD 01590C 1 ADD W W 30 01600C W COMP 8 54 01610C 54 Z-ADD318 M 50 96 FLAG ERROR 01620C 54 GOTO ERROR BAD ESC 01630C MOVE ' ' W3A 3 01640C MOVEAA8,W W3A 01650C Z-ADD3 W2N 20 01660C EXIT SUBRAJ R. JUSTIFY 01670C RLABL W2N 01680C RLABL W3A 01690C MOVE W3A F NEW FIELD # 01700C GOTO READ 01710C*-------------------------------------------------------------------- 01720C ERROR TAG 01730C EXSR SR102 VALIDATE FIELD # 01740C EXSR SR89 GET MSG 01750C EXSR SR73 PUT MSG ÐÐ01760C GOTO START 01770C*------------------------------------------------------------------ 01780C NEWITM TAG 01790C* SET-UP LINK FOR NEW ITEM 01800C MOVEL'Q010GL' PROG 8 01810C GOTO END 01820C*------------------------------------------------------------------- 01830C MENU TAG 01840C* SET-UP LINK TO MENU 01850C MOVEL'QQGL02' PROG 01860C GOTO END 01870C*-------------------------------------------------------------------- 01880C GOODBY TAG 01890C* LINK TO SIGN-OFF 01900C MOVEL'GOODBY' PROG 01910C GOTO END 01920C*------------------------------------------------------------------- 01930C END TAG 01940C EXITFCHAIN LINK TO NEXT PROG 01950C RLABL PROG 01960C******************************************************************** 01970CSR SR3 BEGSR 01980C* EDIT INPUT. 01990CSR MOVE TKEY W9A 9 02000CSR EXSR SR80 GET GLMAST ÐÐ02010CSR 60 Z-ADD302 M 96 FLAG ERROR 02020CSR 60 GOTO END3 02030CSR MOVE GLDESC PADESC 40 02040CSR MOVE GLSC PASC 1 02050CSR END3 ENDSR 02060C***************************************************************** 02070CSR SR70 BEGSR 02080C* CLEAR TERM SCREEN. 02090CSR EXITFQTOPF CLEAR SCREEN 02100CSR ENDSR 02110C********************************************************************** 02120CSR SR71 BEGSR 02130C* PUT HEADINGS TO TERMINAL 02140CSR MOVELTKEY W9A 02150CSR EXSR SR80 GET TOP GLMAST 02160CSR EXSR SR204 SET-UP ACTNO 02170CSR SETON 71 02180CSR EXCPT PUT HEADINGS 02190CSR SETOF 71 02200CSR Z-ADD6 COUNT 30 02210CSR ENDSR 02220C********************************************************************* 02230CSR SR72 BEGSR 02240C* PUT DATA TO TERMINAL 02250CSR 1 ADD COUNT COUNT 30 ÐÐ02260CSR MOVE CAPAR W9A 02270CSR EXSR SR80 GET GLMAST 02280CSR EXSR SR203 FLAG LEVEL 02290CSR EXSR SR204 BUILD ACCT # 02300CSR SETON 7278 02310CSR EXCPT PUT DATA 02320CSR SETOF 72 02330CSR COUNT COMP 30 54 54 02340CSRN54 GOTO END72 02350CSR EXITFQEPAGE END PAGE MSG 02360CSR EXSR SR75 02370CSRN90 EXSR SR71 PUT HEADING 02380CSR END72 ENDSR 02390C*********************************************************************** 02400CSR SR73 BEGSR 02410C* PUT ERROR MESSAGE TO TERMINAL 02420CSR SETON 73 02430CSR EXCPT PUT MSG 02440CSR SETOF 73 02450CSR Z-ADDM LSTERR 50 02460CSR ENDSR 02470C******************************************************************* 02480CSR SR75 BEGSR 02490C* READ FROM TERMINAL 02500CSR SETOF 779096 ÐÐ02510CSR SETOF 939291 02520CSR SETOF 898887 02530CSR SETOF 8685 02540CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 02550CSR MOVE BLK8 W8A 8 BUFFER 02560CSR EXITFQWREED READ FROM TERMINAL 02570CSR RLABL W8A READ BUFFER 02580CSR RLABL BUFLGT READ BUFFER LGTH 02590CSR MOVEAW8A A8 INPUT DATA ARRAY 02600CSR MOVE BLK8 W8A INIT INPUT ARRAY 02610CSR Z-ADD1 W 30 02620CSR '\' LOKUPA8,W 90 FLAG ESC 02630CSRN90 GOTO T75B NOT ESC 02640CSR 1 ADD W W 02650CSR W COMP 8 54 02660CSR 54 GOTO T75A BAD ESC 02670CSR A8,W COMP 'G' 98 GOODBY 02680CSR A8,W COMP 'E' 94 MENU 02690CSR A8,W COMP 'N' 93 NEW ITEM 02700CSR A8,W COMP 'J' 92 JUMP 02710CSR A8,W COMP 'F' 91 SKIP FRWRD 02720CSR A8,W COMP 'B' 89 SKIP BKWRD 02730CSR A8,W COMP 'S' 88 SPACE FILL 02740CSR A8,W COMP 'H' 87 HOME 02750CSR A8,W COMP 'U' 86 UPDATE ÐÐ02760CSR A8,W COMP 'R' 85 REPEAT 02770CSR 98 02780COR 94 02790COR 93 02800COR 92 02810COR 91 02820COR 89 02830COR 88 02840COR 87 02850COR 86 02860COR 85 GOTO END75 GOOD ESC 02870C*------------------------------------------------------------------ 02880CSR T75A TAG 02890C* FLAG BAD ESC INPUT 02900CSR Z-ADD318 M 96 FLAG ERROR 02910CSR GOTO END75 02920C*-------------------------------------------------------------------- 02930CSR T75B TAG 02940C* MOVE DATA 02950CSR Z-ADD1 W 02960CSR ' ' LOKUPA8,W 77 02970CSR 77 MOVEAA8,W W8A INPUT DATA 02980CSR END75 ENDSR 02990C******************************************************************** 03000CSR SR76 BEGSR ÐÐ03010C* END-ACCOUNT MSG. 03020CSR EXITFQEITEM END ITEM 03030CSR EXSR SR75 READ 03040CSR ENDSR 03050C********************************************************************** 03060CSR SR80 BEGSR 03070C* GET MASTER RECORD 03080CSR SETOF 61 03090CSR W9A CHAINGLMAST 60 GET MASTER 03100CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 03110CSR ENDSR 03120C********************************************************************** 03130CSR SR81 BEGSR 03140C* ADD NEW MASTER TO FILE 03150CSR SETON 81 03160CSR EXCPT ADD MASTER 03170CSR SETOF 81 03180CSR ENDSR 03190C*********************************************************************** 03200CSR SR82 BEGSR 03210C* REWRITE MASTER 03220CSR SETON 82 03230CSR EXCPT REWRITE MASTER 03240CSR SETOF 82 03250CSR ENDSR ÐÐ03260C********************************************************************** 03270CSR SR89 BEGSR 03280C* GET MESSAGE MASTER 03290CSR M CHAINMGFILE 54 03300CSR 54 MOVE BLK35 MGTEXT 03310CSR 54 MOVELM MGTEXT 03320CSR 54 MOVE MES,1 MGTEXT 03330CSR ENDSR 03340C*********************************************************************** 03350CSR SR101 BEGSR 03360C* 1-TIME INITIALIZE 03370CSR MOVE BIT,1 NUL 03380CSR MOVEANUL NUL92 92 03390CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03400CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03410CSR MOVE ' ' BLK8 8 03420C* DEFINE WORK FIELDS,ETC. 03430CSR MOVE ' ' BLK35 35 03440CSR MOVE ' ' BLK9 9 03450CSR MOVE ' ' BLK18 18 03460CSR ENDSR 03470C********************************************************************** 03480CSR SR102 BEGSR 03490C* VALIDATE FIELD NO. 03500CSR F COMP 0 54 ÐÐ03510CSRN54 Z-ADD1 F 03520CSR F COMP FLIMIT 55 03530CSR 55 Z-ADD1 F 03540CSR ENDSR 03550C******************************************************************** 03560CSR SR103 BEGSR 03570C* MOVE INPUT DATA 03580CSR EXSR SR201 IDENTIFY-F 03590CSR EXSR SR202 R. JUSTIFY 03600CSR 01 MOVELW8A TPRFX 1 ACCOUNT PREFIX 03610CSR 02 MOVE W8A TPRIM 50 ACCOUNT PRIME 03620CSR 03 MOVE W8A TDASH 30 ACCOUNT DASH 03630CSR 03 MOVELTPRFX TKEY 9 03640CSR 03 MOVELTPRIM W8A 8 03650CSR 03 MOVE TDASH W8A 03660CSR 03 MOVE W8A TKEY 03670CSR MOVE ' ' DUN,F EDIT FLAG 03680CSR ENDSR 03690C******************************************************************** 03700CSR SR104 BEGSR 03710C* EDIT INPUT DATA 03720CSR 03 EXSR SR3 03730CSR 96 MOVE ' ' DUN,F EDIT FLAG 03740CSRN96 MOVE 'X' DUN,F 03750CSR ENDSR ÐÐ03760C**************************************************************** 03770CSR SR106 BEGSR 03780C* DISPLAY CHART OF ACCOUNTS 03790CSR SETOF 78 03800CSR EXSR SR71 PUT HEADING 03810CSR Z-ADD1 L 30 03820CSR EXSR SR203 FLAG LEVEL 03830CSR EXSR SR204 BUILD ACTNO 03840CSR SETON 74 03850CSR EXCPT PUT LEVEL-1 03860CSR SETOF 74 03870CSR MOVE BLK18 LEV 03880CSR Z-ADD3 L 03890CSR MOVELTKEY LEV,2 03900C*------------------------------------------------------------------- 03910CSR T106A TAG 03920C* GET SAVED LOWER LEVEL SUB-ACCOUNTS, IF ANY. 03930CSR L SUB 1 L 54 INDENT LEVEL 03940CSRN54 GOTO T106R 03950CSR LEV,L COMP BLK18 54 03960CSRN54 GOTO T106A NONE THIS LEVEL 03970CSR MOVELLEV,L W18A 18 03980CSR MOVELLEV,L CURACT 9 MACH ACNT # 03990CSR MOVE BLK18 LEV,L 04000C*------------------------------------------------------------------- ÐÐ04010CSR T106B TAG 04020CSR W18A SETLLGLWU 04030C*------------------------------------------------------------------- 04040CSR T106C TAG 04050C* READ CHART ACCOUNTS FILE. 04060CSR SETOF 54 04070CSR READ GLWU 54 04080CSR 54 GOTO T106A END FILE 04090CSR GWSUB COMP CURACT 54 04100CSRN54 GOTO T106A END ASSY 04110CSR GWSTAT COMP 'D' 54 04120CSR 54 GOTO T106C DELETED 04130C* DISPLAY LINE ENTRY. 04140CSR MOVELGWPAR W18A 18 04150CSR MOVE GWSUB W18A 04160CSR W18A CHAINCAMAST 54 04170CSR 54 GOTO T106C 04180CSR EXSR SR72 PUT DATA 04190CSR 90 GOTO END106 ESCAPE 04200C*------------------------------------------------------------------- 04210CSR T106D TAG 04220C* SAVE CUR ACCT + 1 AND CHASE NEXT LOWER INDENT. 04230CSR MOVE CAPAR W9A 04240CSR MOVE CAPAR W3N 30 04250CSR 1 ADD W3N W3N ÐÐ04260CSR MOVE W3N W9A 04270CSR MOVE W9A LEV,L 04280CSR MOVELCURACT LEV,L SAVE PAR/SUB 04290CSR MOVE CAPAR CURACT 04300CSR MOVELCAPAR W18A 04310CSR MOVE BLK9 W18A 04320CSR 1 ADD L L NEW INDENT LEV 04330CSR GOTO T106B CHASE DOWN 04340C*------------------------------------------------------------------- 04350CSR T106R TAG 04360C* END ACCOUNT MSG. 04370CSR EXSR SR76 END ACCT MSG. 04380CSR END106 ENDSR 04390C************************************************************************ 04400CSR SR201 BEGSR 04410C* IDENTIFY FIELD NO. 04420CSR F COMP 1 01 04430CSR F COMP 2 02 04440CSR F COMP 3 03 04450CSR ENDSR 04460C********************************************************************** 04470CSR SR202 BEGSR 04480C* RIGHT JUSTIFY 04490CSR F LOKUPNUM 54 04500CSRN54 GOTO END202 NOT NUMERIC FIELD ÐÐ04510CSR Z-ADD8 W2N 20 04520CSR EXIT SUBRAJ R. JUSTIFY 04530CSR RLABL W2N 04540CSR RLABL W8A 04550CSR END202 ENDSR 04560C******************************************************************** 04570CSR SR203 BEGSR 04580C* FLAG INDENTURE LEVEL. 04590CSR L COMP 1 2121 04600CSR L COMP 2 22 04610CSR L COMP 3 23 04620CSR L COMP 4 24 04630CSR L COMP 5 25 04640CSR L COMP 6 26 04650CSR L COMP 7 27 04660CSR L COMP 8 28 04670CSR L COMP 9 29 04680CSR L COMP 10 30 04690CSR L COMP 11 31 31 04700CSR 21 Z-ADD1 L 04710CSR ENDSR 04720C******************************************************************** 04730CSR SR204 BEGSR 04740C* BUILD ACTNO FIELD FOR OUTPUT. 04750CSR MOVEAGLPRFX A24 ÐÐ04760CSR GLPRFX COMP ' ' 54 04770CSRN54 MOVEA'_' A24,1 04780CSR MOVE GLPRIM W5A 5 04790CSR MOVEAW5A A24,2 04800CSR MOVE '-' A24,7 04810CSR MOVE GLDASH W3A 3 04820CSR MOVEAW3A A24,8 04830CSR MOVEAA24 ACTNO 10 04840CSR GLCMP SUB GLCMM CURNET 112 04850CSR ENDSR 04860O******************************************************************** 04870OTERM132 E 71 04880O* PUT HEADING. 04890O 66 'INDENTED ACCOUNT' 04900O 77 'WHERE-USED' 04910O*------------------------------------------------------------------- 04920O E 71 04930O* PUT HEADING. 04940O 19 'ACCOUNT NO.' 04950O 91 'TYPE' 04960O 97 'OPER' 04970O 114 'EFFECTIVITY' 04980O 131 'CUR-MO.' 04990O*------------------------------------------------------------------- 05000O E 71 ÐÐ05010O* 05020O 1 '1' 05030O 4 '2' 05040O 7 '3' 05050O 10 '4' 05060O 13 '5' 05070O 16 '6' 05080O 19 '7' 05090O 22 '8' 05100O 25 '9' 05110O 29 '10' 05120O 32 '11' 05130O 60 '<--------------' 05140O 71 'DESCRIPTION' 05150O 85 '------------->' 05160O 91 'CODE' 05170O 97 'CODE' 05180O 107 'START' 05190O 115 'STOP' 05200O 131 'NET-BAL' 05210O*------------------------------------------------------------------- 05220O E 71 05230O DASH 43 05240O*------------------------------------------------------------------- 05250O E 72 ÐÐ05260O* SUB-ACCOUNT DATA. 05270O DASH 43 05280O 21 ACTNO 13 05290O 22 ACTNO 16 05300O 23 ACTNO 19 05310O 24 ACTNO 22 05320O 25 ACTNO 25 05330O 26 ACTNO 28 05340O 27 ACTNO 31 05350O 28 ACTNO 34 05360O 29 ACTNO 37 05370O 30 ACTNO 40 05380O 31 ACTNO 43 05390O GLDESC 85 05400O GLSC 90 05410O CAOPER 95 05420O CURNETK 132 05430O CASDAT 108 ' - - ' 05440O CAEDAT 118 ' - - ' 05450O*------------------------------------------------------------------- 05460O E 74 05470O OR 71 78 05480O DASH 43 05490O ACTNO 13 05500O 78 71 21 'CONT''D' ÐÐ05510O PADESC 85 05520O PASC 89 05530O CURNETK 132 05540O*------------------------------------------------------------------- 05550O E 73 05560O* PUT MESSAGE. 05570O NUL92 132 05580O 96 5 '*****' 05590O N96 5 ' ' 05600O MGTEXT 40 05610O BIT,8 132 ** NUL ARRAY 005620 005630** A8 ARRAY 005640 005650** NUM ARRAY 005660002 PAR PRIME 005670003 PAR DASH 005680** DUN ARRAY 005690 005700** MES ARRAY 005710---MESSAGE NOT ON FILE--- 005720** LEV ARRAY 05730 05740** DASH ARRAY 05750ÐÐ. . . . . . . . . . . . . . . 005760** A24 ARRAY 005770 005780/* 005790_‚ ÐÐ_‚_‚ . . . . . . . . . . . . . 005760** A24 ARRAY 005770 005780/* 005790_‚ ÐÈ(ô& ôÑX010PC P120282120282(èÈÐ00010H Q010PC00020F* PRINT ASSY COST. (X010PC) 00030F* REV 3/31/81 4:40 PM. DG-REL006 OK. 00040F* SWITCH-1 BYPASSES NON-ASSYS. 00050FINP010PCIP F 10 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FBMMAST ID F 86L20AI 1 DISK 00080FCRTFILE UC F 256R DISK 00090E******************************************************************** 00100E D1 53 53 1 00110E D2 17 17 1 00120E PM$ 7 9 3 MFG $ FILE 00130E REC 180 1 00140I******************************************************************** 00150IINP010PCPG 01 00160I 1 100PGPN 00170I******************************************************************** 00180IPMMST2 PM 00190I* PART MASTER RECORD 00200I* KEY AREA 00210I* PART NO. 10N 00220I 1 100PMPN 00230I* PROD LINE 4N 00240I 15 180PMPL 00250I* MODEL NAME 12A ÐÐ00260I 19 30 PMMODL 00270I* DESCRIPTION 29A 00280I 31 59 PMDESC 00290I* NUMB OF COMPONENTS 3P 00300I P 13 140PMNOBM 00310I* SOURCE CODE 2A 00320I 94 95 PMSC 00330I* ISSUE CODE 2A 00340I 97 98 PMISSU 00350I* CURRENT COSTS 9.3P X 7 00360I* ADDED COSTS 00370I* 1 = LABOR 00380I* 2 = LABOR BURDEN 00390I* 3 = MATERIAL 00400I* 4 = MATERIAL BURDEN 00410I* 5 = OUTSIDE BURDEN 00420I* CUM COSTS 00430I* 6 = LABOR 00440I* 7 = MATERIAL 00450I P 245 279 PM$ 00460I* FAB CODE 2A 00470I 487 488 PMFABC 00480I* RECORD STATUS 1A 00490I 674 674 PMSTAT 00500I******************************************************************** ÐÐ00510ICRTFILE CR 00520I 77 256 REC 00530I******************************************************************** 00540IBMMAST BM 00550I* BILL OF MATERIAL RECORD (XBMREC) 00560I* KEY AREA 00570I* ASSY PART NO. 10N 00580I 1 100BMAPN 00590I* COMPONENT PART NO. 10N 00600I 11 200BMCPN 00610I* ITEM NO. 3N 00620I 25 270BMITNO 00630I* QTY PER ASSY 7P 00640I P 28 310BMQTY 00650I* SCRAP ALLOW .2N 00660I 34 352BMSCRP 00670I* ISSUE CODE 2A 00680I* PT = PULL TIME 00690I* OR = ON REQUEST 00700I* BI = BULK ISSUE 00710I* AR = AS REQUIRED 00720I* RA = REF ASSY 00730I* TD = TRAV DOC 00740I* SD = SHIP DOC 00750I* RD = REF DOC ÐÐ00760I* VS = VENDOR SUPPLIED 00770I 36 37 BMISSU 00780I* EFFECTIVITY. 00790I* BEGIN CHANGE LEVEL 2A 00800I 38 39 BMBCHG 00810I* ENDING CHANGE LEVEL 2A 00820I 40 41 BMECHG 00830I* BEGIN ECN # 5A 00840I 42 46 BMBECN 00850I* ENDING ECN # 5A 00860I 47 51 BMEECN 00870I* DISPOSITION CODE 1A 00880I* U = USE UP OLD STYLE 00890I* N = NOW (IMMEDIATE) 00900I 52 52 BMDISP 00910I* FILLER 5A 53 57 FFFFFF 00920I* ROUTING. 00930I* OPER NO. 5P 00940I P 58 600BMOPER 00950I* DEPT NO. 5P 00960I P 61 630BMDEPT 00970I* WORK CENTER NO. 3P 00980I P 64 650BMWC 00990I* COMPONENT OPER REFERENCE INFO 10A 01000I 66 75 BMREF ÐÐ01010I* FILLER 76 85 FFFFFF 01020I* 01030I* RECORD STATUS 1A 01040I* D = DELETED 01050I 86 86 BMSTAT 01060C******************************************************************** 01070C* INITIALIZE (1-TIME). 01080C N01 GOTO END 01090C N79 EXSR SR101 INIT. 01100C H9 GOTO END 01110C* GET ASSY PART MAST. 01120C MOVELPGPN W12A 12 01130C Z-ADD1 BMQTY 01140C EXSR SR81 GET ASSY PMMST 01150C 60 GOTO END 01160C EXSR SR201 LF 01170C EXSR SR201 LF 01180C* PUT ASSY LINE 01190C SETON 80 01200C EXSR SR69 PUT ASSY LINE 01210C* SET-UP BM READ. 01220C MOVELPGPN W20A 20 01230C MOVE ZERO10 W20A 01240C*--------------------------------------------------------------- 01250C SETLIM TAG ÐÐ01260C W20A SETLLBMMAST 01270C*------------------------------------------------------------------- 01280C CHASE TAG 01290C* GET NEXT BILL MATL RECORD. 01300C SETOF 54 01310C READ BMMAST 54 GET BMMAST. 01320C 54 GOTO ENDASY PROG ERROR. 01330C BMAPN COMP PGPN 54 01340C N54 GOTO ENDASY 01350C BMSTAT COMP 'D' 54 01360C 54 GOTO CHASE 01370C* GET COMPONENT PART MASTER. 01380C MOVE BLK12 W12A 01390C MOVELBMCPN W12A 01400C EXSR SR81 GET PMMST 01410C 60 GOTO END ERROR 01420C U1 PMNOBM COMP 0 54 01430C U1N54 GOTO CHASE NON-ASSY 01440C SETON 80 01450C EXSR SR69 PUT COMPONENT LINE 01460C EXSR SR68 CHECK END PAGE 01470C GOTO CHASE 01480C*------------------------------------------------------------------- 01490C ENDASY TAG 01500C*------------------------------------------------------------------- ÐÐ01510C END TAG 01520C*------------------------------------------------------------------- 01530C ENDJOB TAG 01540CLR EXSR SR67 TOP FORM 01550C******************************************************************** 01560CSR SR67 BEGSR 01570C* TOP OF FORM. 01580CSR EXITFZTFORM 01590CSR Z-ADD4 COUNT 30 LINE COUNT 01600CSR 1 ADD EGAP EGAP 40 PAGE # 01610CSR ENDSR 01620C******************************************************************** 01630CSR SR68 BEGSR 01640C* CHECK FOR END OF PAGE. 01650CSR COUNT COMP 70 54 54 01660CSR 54 EXSR SR71 PUT HEADINGS 01670CSR END68 ENDSR 01680C******************************************************************** 01690CSR SR69 BEGSR 01700C* PUT DATA TO DIABLO. 01710CSR EXSR SR201 LF 01720CSR PORT CHAINCRTFILE H9 01730CSR H9 GOTO END69 01740CSR MOVE ' ' REC 01750CSR EXCPT UPDATE CRTFILE ÐÐ01760CSR PORT CHAINCRTFILE H9 01770CSR H9 GOTO END69 01780CSR MOVEAREC W180A 180 01790CSR EXITFZD180 PUT DIABLO 01800CSR RLABL W180A 01810C*------------------------------------------------------------------- 01820CSR END69 TAG 01830CSR SETOF 804142 01840CSR SETOF 43 01850CSR ENDSR 01860C******************************************************************** 01870CSR SR71 BEGSR 01880C* CLEAR CRT. PUT HEADINGS. 01890CSR EXSR SR67 TOP OF FORM 01900CSR SETON 41 01910CSR EXSR SR69 PUT HEADING 01920CSR SETON 42 01930CSR EXSR SR69 PUT HEADING 01940CSR SETON 43 01950CSR EXSR SR69 PUT HEADING 01960CSR EXSR SR201 LINE FEED 01970CSR END71 ENDSR 01980C******************************************************************** 01990CSR SR81 BEGSR 02000C* GET PART MAST. ÐÐ02010CSR MOVE ' ' W12A 02020CSR W12A CHAINPMMST2 60 02030CSRN60 PMSTAT COMP 'D' 60 02040CSRN60 BMQTY MULT PM$ PM$ H 02050CSRN60 XFOOTPM$ TOTCST 103 TOTAL COST 02060CSR ENDSR 02070C******************************************************************** 02080CSR SR101 BEGSR 02090C* 1-TIME INITIALIZE. 02100C* SET SPACING ON DIABLO 02110CSR MOVE '15' W2A 2 02120CSR EXITFZHMI HORIZONTAL 02130CSR RLABL W2A 02140CSR MOVE '10' W2A 02150CSR EXITFZVMI VERTICAL 02160CSR RLABL W2A 02170C* GET PORT # AND CRTFILE. 02180CSR MOVE ' ' W8A 8 02190CSR Z-ADD0 W2N 20 02200CSR Z-ADD0 W1N 10 02210CSR MOVE ' ' W2A 2 02220CSR EXITFPGMINX GET PORT # 02230CSR RLABL W8A 02240CSR RLABL W2N 02250CSR RLABL W1N ÐÐ02260CSR RLABL W2A 02270CSR MOVE W2A PORT 20 PORT NO. 02280CSR PORT COMP 0 54 02290CSRN54 Z-ADD25 PORT DEFAULT 02300CSR PORT CHAINCRTFILE H9 02310CSR H9 GOTO END101 02320CSR MOVE '-' D1 02330CSR MOVE '-' D2 02340CSR SETON 79 02350CSR MOVE ' ' BLK12 12 02360CSR MOVE ' ' BLK35 35 02370CSR Z-ADD0 ZERO10 100 02380CSR EXSR SR71 TOP FORM 02390CSR END101 ENDSR 02400C******************************************************************** 02410CSR SR201 BEGSR 02420C* LINE FEED. 02430CSR EXITFQCLF LINE FEED 02440CSR 1 ADD COUNT COUNT 30 02450CSR ENDSR 02460O******************************************************************** 02470OCRTFILE E 41 02480O REC 256 02490O UDATE Y 84 02500O 160 'SINGLE LEVEL ASSEMBLY' ÐÐ02510O 168 'LISTING' 02520O 251 'PAGE' 02530O EGAP Z 256 02540O*------------------------------------------------------------------- 02550O E 42 02560O REC 256 02570O 134 'PROD' 02580O 141 'SOURCE' 02590O 147 'ISSUE' 02600O 151 'FAB' 02610O 161 'QTY' 02620O D1 221 02630O D2 245 02640O 197 'ADDED' 02650O 238 'CUM' 02660O 168 '*' 02670O 221 '*' 02680O 229 '*' 02690O 245 '*' 02700O 256 'TOTAL' 02710O*------------------------------------------------------------------- 02720O E 43 02730O REC 256 02740O 88 'PART-NO.' 02750O 100 'DESCRIPTION' ÐÐ02760O 125 'MODEL' 02770O 135 'CLASS' 02780O 140 'CODE' 02790O 146 'CODE' 02800O 152 'CODE' 02810O 161 'REQ''D' 02820O 173 'LABOR' 02830O 185 'BURDEN' 02840O 197 'MATERIAL' 02850O 209 'MATL-BURD' 02860O 221 'VENDOR-COST' 02870O 233 'LABOR' 02880O 245 'MATERIAL' 02890O 255 'COST' 02900O*------------------------------------------------------------------- 02910O E 80 02920O REC 256 02930O PMPN 88 ' - - ' 02940O PMDESC 118 02950O PMMODL 131 02960O PMPL Z 135 02970O PMSC 139 02980O PMISSU 145 02990O PMFABC 152 03000O BMQTY 2 161 ÐÐ03010O PM$,1 2 173 03020O PM$,2 2 185 03030O PM$,3 2 197 03040O PM$,4 2 209 03050O PM$,5 2 221 03060O PM$,6 2 233 03070O PM$,7 2 245 03080O TOTCST2 256 ** D1 ARRAY 003090 003100** D2 ARRAY 003110 003120/* 003130_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È'b ÈTX010PE P120282120282(èÈÐ00010H Q010PE00020F* CALLED MODULE. DELETE DYNAIR/MFG PART # RECORDS. (X010PE) 00030F* INPUT IS DYNAIR PART # VIA CRTFILE. ALL PEMAST RECORDS FOR 00040F* INPUT DYNAIR PART # ARE DELETED ALONG WITH THE CORRESPONDING 00050F* EPMAST RECORD. RETURNS TO Q059DP PROG LOADER. 00060F* REVISED 4-25-80 5:30 PM. DG-REL006 OK. 00070F* FIELD SUBSTITUTIONS-------- 00080FBITTAB IP F 33 DISK 00090FCRTFILE IC F 256R DISK 00100FPEMAST UD F 45L17AI 1 DISK 00110FEPMAST UC F 45R29AI 1 DISK 00120F* 00130F**************************************************************** 00140E MES 1 1 30 00150E BIT 33 1 SCREEN CONTR. CHAR 00160I******************************************************************* 00170IBITTAB BT 00180I 1 33 BIT 00190I****************************************************************** 00200ICRTFILE CR 00210I*------------------------------------------------------------------- 00220I* PASSED DATA FIELDS 00230I* FROM PART # 00240I 81 92 CRPN 00250I* THRU PART # ÐÐ00260I 212 223 CRTPN 00270I********************************************************************** 00280IPEMAST PE 00290I* ENG STD - DYNAIR PART/MFG PART CROSS REF FILE. 00300I* DYNAIR PART # 12A (KEY) 00310I 1 12 PEPN 00320I* MFG CODE 5A 00330I 13 17 PEMFG 00340I* MFG PART # 24A 00350I 18 41 PEMPN 00360I 13 41 PEEPKY 00370I* RECORD STATUS 1A 00380I 45 45 PESTAT 00390I******************************************************************** 00400IEPMAST EP 00410I* ENG STD - MFG PART #/DYNAIR PART # CROSS REF. 00420I* KEY AREA 00430I* MFG CODE 5N 00440I 1 50EPMFG 00450I* MFG PN 24A 00460I 6 29 EPMPN 00470I* DYNAIR PART # 12A 00480I 30 41 EPPN 00490I* RECORD STATUS 1A 00500I 45 45 EPSTAT ÐÐ00510C******************************************************************** 00520C* INITIALIZE. SET-UP 1ST READ. 00530C EXSR SR101 1-TIME INIT. 00540C MOVE BLK35 W17A 17 00550C MOVELCRPN W17A 00560C W17A SETLLPEMAST 00570C SETOF 79 00580C*------------------------------------------------------------------- 00590C START TAG 00600C SETOF 80 00610C READ PEMAST 80 READ PEMAST. 00620C 80 GOTO END END OF FILE. 00630C PEPN COMP CRPN 54 54 00640C 54 PEPN COMP CRTPN 5454 00650C N54 GOTO END NOT SAME PART# 00660C PESTAT COMP 'D' 54 00670C 54 GOTO START DELETED RECORD 00680C MOVE 'D' PESTAT RECORD STATUS. 00690C EXSR SR81 REWRITE PEMAST. 00700C SETOF 61 00710C PEEPKY CHAINEPMAST 60 GET EPMAST. 00720C N60 EPSTAT COMP 'D' 61 FLAG DELETE. 00730C MOVE 'D' EPSTAT RECORD STATUS. 00740C N60N61 EXSR SR82 REWRITE EPMAST 00750C SETON 79 ÐÐ00760C GOTO START 00770C*------------------------------------------------------------------- 00780C END TAG 00790C MOVEL'Q059DP' PROG 8 00800C EXITFCHAIN 00810C RLABL PROG 00820C******************************************************************** 00830CSR SR81 BEGSR 00840C* WRITE DELETE CODE TO PEMAST. 00850CSR SETON 81 00860CSR EXCPT DELETE PEMAST. 00870CSR SETOF 81 00880CSR ENDSR 00890C******************************************************************** 00900CSR SR82 BEGSR 00910C* WRITE DELETE CODE TO EPMAST. 00920CSR SETON 82 00930CSR EXCPT DELETE EPMAST. 00940CSR SETOF 82 00950CSR ENDSR 00960C*********************************************************************** 00970CSR SR101 BEGSR 00980C* 1-TIME INITIALIZE 00990C* GET PORT # AND CRTFILE 01000CSR MOVE ' ' W8A 8 ÐÐ01010CSR Z-ADD0 W2N 20 01020CSR Z-ADD0 W1N 10 01030CSR MOVE ' ' W2A 2 01040CSR EXITFPGMINX GET PORT # 01050CSR RLABL W8A 01060CSR RLABL W2N 01070CSR RLABL W1N 01080CSR RLABL W2A 01090CSR MOVE W2A PORT 20 PORT NO. 01100CSR PORT COMP 0 54 01110CSRN54 Z-ADD25 PORT DEFAULT 01120CSR PORT CHAINCRTFILE H9 01130C* DEFINE WORK FIELDS,ETC. 01140CSR MOVE ' ' BLK35 35 01150CSR ENDSR 01160O******************************************************************** 01170OPEMAST E 81 01180O* WRITE DELETE FLAG. 01190O 45 'D' 01200O******************************************************************** 01210OEPMAST E 82 01220O* WRITE DELETE FLAG. 01230O 45 'D' ** MES ARRAY 001240---NOT ON FILE--- 001250ÐÐ/* 001260_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È'· ÈTX010PM P120282120282(èÈÐ00010H Q010PM00020F* UPDATE DESC ALT-KEY CODE IN PART MAST. (X010PM) 00030F* REVISED 2/10/81 2:45 PM. 00040FPMDESCR2IP F 42 29AI 1 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060I******************************************************************** 00070IPMDESCR2PD 01 42NCD 42NCM 00080I 27 290PDCNT 00090I 30 390PDPN 00100I GG 02 00110I******************************************************************** 00120IPMMST2 PM 03 00130I 1 100PMPN 00140I P 517 5180PMPDKC 00150C******************************************************************** 00160C 01 MOVELPDPN W12A 12 00170C 01 W12A CHAINPMMST2 60 00180C 60 SETOF 01 00190O******************************************************************** 00200OPMMST2 D 01 00210O PDCNT 518P /* 000220_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(F=§ FX031BM P999999030383(èÈÐ00010H Q031BM00020F* PUT DELETE CANDIDATES TO FLOPPY TO PRINT Q028BM REPORT ON 00030F* UNIVAC. (X031BM) 00040F* 01-24-80 5:40 PM. 00050FPMMST IP F 576 12AI 1 DISK 00060FFLOPPY O F 122 17 00070F KEBCDIC 00080FTERM20 O F 20 5 00090E EOF 1 61 2 00100IPMMST PM 01 00110I 1 100PMPN 00120I 24 35 PMMODL 00130I 36 36 USFLAG 00140I 48 76 PMDESC 00150I P 130 1320PMACNT 00160I P 347 3500PMOHB 00170I P 519 5222PMCOST 00171I 551 555 PMMCN 00180I 576 576 PMSTAT 00190C 49 GOTO BEGIN 00200C SETON 49 00210C MOVE ' ' EOF 00220C Z-ADD0 COUNT 50 00230C START TAG 00240C 1 ADD COUNT COUNT ÐÐ00250C COUNT COMP 17 54 00260C 54 GOTO BEGIN 00270C SETON 71 00280C EXCPT 00290C SETOF 71 00300C GOTO START 00310C BEGIN TAG 00320C PMSTAT COMP 'D' 54 FLAG DELETE 00330C N54 USFLAG COMP ' ' 54 FLAG NO USAGE 00340C 54 SETOF 01 00350C 01 1 ADD COUNT COUNT 50 00360CLR MOVEL'/' EOF 00370CLR MOVE '*' EOF 00380CLR SETON 70 00390CLR EXCPT 00400CLR SETOF 70 00410CLR CONTU TAG 00420CLR 1 ADD COUNT COUNT 00430CLR SETON 71 00440CLR EXCPT 00450CLR SETOF 71 00460CLR GOTO CONTU 00470OFLOPPY D 01 00480O PMPN 10 00490O PMACNT 15 ÐÐ00491O PMMCN 20 00500O E 70 00510O 2 '?*' 00520O E 71 00530O EOF 122 00540O******************************************************************** 00550OTERM20 D 01 00560O PMPN 12 ' - - ' 00570O COUNT Z 20 00580O E 70 00590O OR 71 00600O COUNT Z 20 ** EOF 000610 000620/* 000630_‚ _‚_‚0CLR SETOF 71 00460CLR GOTO CONTU 00470OFLOPPY D 01 00480O PMPN 10 00490O PMACNT 15 ÐÈ(ô( ôÑX010QM P120282120282(èÈÐ00010H Q010QM00020F* UPDATE QMMAST FROM QMCONT. (X010QM) 00030F* REVISED 4/25/80 11:00 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FQMMAST UD F 160L 8AI 1 DISK 00080FQSKEY UC F 18R17AI 1 DISK A 00090FQCKEY UC F 29R28AI 1 DISK A 00100FQFKEY UC F 15R14AI 1 DISK A 00110FCRT512 IC F 512R DISK 00120E******************************************************************** 00130E BIT 33 1 SCREEN CONTR. CHAR 00140E CALL 5 6 CALL STACK 00150E QMD 6 7 0 DATE ARRAY 00160E CRD 6 7 0 00170I******************************************************************* 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************* 00210IMGFILE MG 00220I* MESSAGE FILE. 00230I 1 35 MGTEXT 00240I******************************************************************** 00250IQMMAST QM ÐÐ00260I* QUOTE MASTER. 00270I* QUOTE # 5A 00280I 1 5 QMQOTE 00290I* ITEM # 3N 00300I 6 80QMITEM 00310I* CUSTOMER NAME 20A 00320I 9 28 QMNAME 00330I* CUSTOMER RFQ # 20A 00340I 29 48 QMRFQ 00350I* RFQ ITEM # 4A 00360I 49 52 QMRFQI 00370I* CONTACT 20A 00380I 53 72 QMCONT 00390I* ASSIGNED TO (SALESMAN) 3A 00400I 73 75 QMSLSM 00410I* DATE ARRAY 7P X 6 00420I* 1 = RECEIVED 00430I* 2 = DUE 00440I* 3 = SENT 00450I* 4 = EXPECTED AWARD 00460I* 5 = FOLLOW-UP 00470I* 6 = NOT USED 00480I P 76 99 QMD 00490I* PRODUCT CLASS 2A 00500I 100 101 QMPCLS ÐÐ00510I* SYSTEM CODE 1A 00520I 102 102 QMSYST 00530I* FILLER 103 103 FFFFFF 00540I* QUOTE AMOUNT 7P ($) 00550I P 104 1070QMAMT 00560I* DELIVERY PROMISED (DAYS ARO) 3P 00570I P 108 1090QMDEL 00580I* STATUS 1A 00590I* E = ENTERED 00600I* N = NO BID 00610I* B = BID 00620I* P = PENDING 00630I* L = LOST 00640I* W = WON 00650I* C = CANCELLED 00660I 110 110 QMSCOD 00670I* PROBABILITY OF AWARD 3.2P 00680I P 111 1122QMPROB 00690I* WON/LOST REASON 1A 00700I 113 113 QMREAS 00710I* REMARKS 40A 00720I 114 153 QMREM 00730I* RECORD STATUS 1A 00740I 160 160 QMSTAT 00750I******************************************************************** ÐÐ00760ICRT512 CR 00770I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00780I* STD AREA - SAME FOR ALL PROGRAMS. 00790I* EMPLOYEE # 5N 00800I 1 50CREMPL 00810I* USER CODE 8A 00820I 6 13 CRUSER 00830I* DEPT # 5N 00840I 14 180CRDEPT 00850I* JOB NAME 8A (JOB LOADED BY MENU) 00860I 19 26 CRJOB 00870I* SHUTDOWN FLAG 1A 00880I* BLANK = NO SHUTDOWN 00890I 27 27 CRSHUT 00900I* TIME STARTED 6N 00910I 28 330CRTIME 00920I* DATE STARTED 6N 00930I 34 370CRDATE 00940I* CALL STACK 5 X 6A 00950I 38 67 CALL 00960I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00970I 68 73 CRRET 00980I* MENU NAME 6A 00990I 74 79 CRMENU 01000I*------------------------------------------------------------------- ÐÐ01010I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 01020I* CRT512 QMMAST FIELDS. 01030I* QUOTE # 5A 01040I 80 84 CRQOTE 01050I* ITEM # 3N 01060I 85 870CRITEM 01070I* CUSTOMER NAME 20A 01080I 88 107 CRNAME 01090I* CUSTOMER RFQ # 20A 01100I 108 127 CRRFQ 01110I* RFQ ITEM # 4A 01120I 128 131 CRRFQI 01130I* CONTACT 20A 01140I 132 151 CRCONT 01150I* ASSIGNED TO (SALESMAN) 3A 01160I 152 154 CRSLSM 01170I* DATE ARRAY 7P X 6 01180I* (SEE CODES QMMAST) 01190I P 155 178 CRD 01200I* PRODUCT CLASS 2A 01210I 179 180 CRPCLS 01220I* SYSTEM CODE 1A 01230I 181 181 CRSYST 01240I* FILLER 182 182 FFFFFF 01250I* QUOTE AMOUNT 7P ($) ÐÐ01260I P 183 1860CRAMT 01270I* DELIVERY PROMISED (DAYS ARO) 3P 01280I P 187 1880CRDEL 01290I* STATUS 1A 01300I* (SEE CODES QMMAST) 01310I 189 189 CRSCOD 01320I* PROBABILITY OF AWARD 3.2P 01330I P 190 1912CRPROB 01340I* WON/LOST REASON 1A 01350I 192 192 CRREAS 01360I* REMARKS 40A 01370I 193 232 CRREM 01380I* TRAN CODE 1A 01390I 233 233 CRTRAN 01400I* ORIGINAL CUST NAME 20A 01410I 234 253 CROCUS 01420I* ORIGINAL SALESMAN 3A 01430I 254 256 CROSLS 01440I* ORIGINAL FOLLOW-UP DATE 7P 01450I P 257 2600CROFU 01460I* LAST ZERO ITEM QUOTE # 5A 01470I 261 265 CRLQI 01480I******************************************************************** 01490IQSKEY QS 01500I* QUOTE SALESMAN ALT KEY FILE ÐÐ01510I* SALESMAN 3A 01520I 1 3 QSSLSM 01530I* DATE DUE 6N 01540I 4 90QSDUE 01550I* QUOTE # 5A 01560I 10 14 QSQOTE 01570I* QUOTE ITEM # 3N 01580I 15 170QSITEM 01590I* RECORD STATUS 1A 01600I 18 18 QSSTAT 01610I******************************************************************** 01620IQCKEY QC 01630I* QUOTE CUSTOMER ALT KEY 01640I* CUSTOMER NAME 20A 01650I 1 20 QCNAME 01660I* QUOTE # 5A 01670I 21 25 QCQOTE 01680I* QUOTE ITEM # 3N 01690I 26 280QCITEM 01700I* RECORD STATUS 1A 01710I 29 29 QCSTAT 01720I******************************************************************** 01730IQFKEY QF 01740I* QUOTE FOLLOW-UP ALT KEY 01750I* FOLLOW-UP DATE 6N (YYMMDD) ÐÐ01760I 1 60QFFU 01770I* QUOTE # 5A 01780I 7 11 QFQOTE 01790I* QUOTE ITEM # 3N 01800I 12 140QFITEM 01810I* RECORD STATUS 1A 01820I 15 15 QFSTAT 01830C******************************************************************** 01840C* SIGNIFICANT INDICATORS 01850C* 40 ---> CRITEM = QMITEM (NEITHER ARE ZERO) 01860C* 41 ---> QMSTAT = D 01870C* 42 ---> CRITEM = 0 01880C* 43 ---> CRTRAN = A 01890C* 44 ---> CRTRAN = C 01900C* 45 ---> CRTRAN = D 01910C* 46 ---> QMITEM = 0 01920C EXSR SR101 INITIALIZE. 01930C H9 GOTO END 01940C CRITEM COMP 0 42 01950C CRTRAN COMP 'A' 43 01960C CRTRAN COMP 'C' 44 01970C CRTRAN COMP 'D' 45 01980C MOVELCRQOTE W8A 8 01990C MOVE CRITEM W8A 02000C W8A SETLLQMMAST ÐÐ02010C*------------------------------------------------------------------- 02020C TAG10 TAG 02030C* GET NEXT QMMAST. BYPASS DELETES AND ITEM=0. 02040C SETOF 404146 02050C SETOF 54 02060C READ QMMAST 54 02070C 54 GOTO END END OF FILE 02080C QMITEM COMP 0 46 02090C CRITEM COMP QMITEM 40 02100C QMSTAT COMP 'D' 41 02110C* SEE IF STILL CORRECT QUOTE NO. 02120C CRQOTE COMP QMQOTE 54 02130C N54 GOTO END DONE 02140C 46 GOTO TAG10 QMITEM = 0 02150C* BYPASS DELETED MASTER NOT UPDATED THIS TRIP. 02160C 41N40 GOTO TAG10 PREV DELETED 02170C 41 GOTO TAG20 THIS MAST DELETED 02180C* BYPASS IF CRITEM = 0 AND NOT CHANGE TRANS, 02190C* -OR- 02200C* CRITEM NOT = 0 AND NOT ADD TRANS 02210C 42N44 02220CORN42N53 GOTO TAG20 02230C* SUBSTITUTE OLD FIELDS IF CRITEM = 0 02240C 42 MOVE QMNAME CROCUS CUST NAME 02250C 42 MOVE QMSLSM CROSLS SALESMAN ÐÐ02260C 42 Z-ADDQMD,5 CROFU FOLLOW-UP DATE 02270C* MOVE CRITEM=0 DATA TO QMMAST 02280C CRNAME COMP BLK20 54 02290C 54 MOVE CRNAME QMNAME 02300C CRRFQ COMP BLK20 54 02310C 54 MOVE CRRFQ QMRFQ 02320C CRRFQI COMP ' ' 54 02330C 54 MOVE CRRFQI QMRFQI 02340C CRCONT COMP BLK20 54 02350C 54 MOVE CRCONT QMCONT 02360C CRSLSM COMP ' ' 54 02370C 54 MOVE CRSLSM QMSLSM 02380C CRD,2 COMP 0 54 02390C 54 Z-ADDCRD,2 QMD,2 02400C CRD,3 COMP 0 54 02410C 54 Z-ADDCRD,3 QMD,3 02420C CRD,4 COMP 0 54 02430C 54 Z-ADDCRD,4 QMD,4 02440C CRD,5 COMP 0 54 02450C 54 Z-ADDCRD,5 QMD,5 02460C CRPCLS COMP ' ' 54 02470C 54 MOVE CRPCLS QMPCLS 02480C CRSYST COMP ' ' 54 02490C 54 MOVE CRSYST QMSYST 02500C CRAMT COMP 0 54 ÐÐ02510C 54 Z-ADDCRAMT QMAMT 02520C CRDEL COMP 0 54 02530C 54 Z-ADDCRDEL QMDEL 02540C CRSCOD COMP ' ' 54 02550C 54 MOVE CRSCOD QMSCOD 02560C QMPROB COMP 0 54 02570C 54 Z-ADDCRPROB QMPROB 02580C CRREAS COMP ' ' 54 02590C 54 MOVE CRREAS QMREAS 02600C CRREM COMP BLK40 54 02610C 54 MOVE CRREM QMREM 02620C SETON 81 02630C EXCPT UPDATE QMMAST 02640C SETOF 81 02650C*------------------------------------------------------------- 02660C TAG20 TAG 02670C* UPDATE ALT-KEYS IF--- 02680C* CRITEM = 0 AND THIS IS CHANGE TRANS 02690C* -OR- 02700C* CRITEM NOT=0, BUT IS = TO CURRENT QMMAST RECORD 02710C 42 44 02720CORN42 40 GOTO TAG30 02730C GOTO TAG10 02740C*---------------------------------------------------------------- 02750C TAG30 TAG ÐÐ02760C EXSR SR102 ALT-SLSM KEY. 02770C EXSR SR103 ALT-CUST KEY. 02780C EXSR SR104 ALT-FU KEY. 02790C GOTO TAG10 02800C*------------------------------------------------------------------- 02810C END TAG 02820C MOVEL'Q001QM' PROG 8 02830C CRTRAN COMP 'A' 54 02840C CRQOTE COMP CRLQI 55 02850C 54 55 MOVEL'Q002QM' PROG 02860C EXITFCHAIN 02870C RLABL PROG 02880C******************************************************************** 02890CSR SR82 BEGSR 02900C* REWRITE QSKEY FILE. 02910CSR SETON 82 02920CSR EXCPT 02930CSR SETOF 82 02940CSR ENDSR 02950C******************************************************************** 02960CSR SR83 BEGSR 02970C* ADD NEW QSKEY RECORD. 02980CSR SETON 83 02990CSR EXCPT 03000CSR SETOF 83 ÐÐ03010CSR ENDSR 03020C******************************************************************** 03030CSR SR84 BEGSR 03040C* REWRITE QCKEY FILE. 03050CSR SETON 84 03060CSR EXCPT 03070CSR SETOF 84 03080CSR ENDSR 03090C******************************************************************** 03100CSR SR85 BEGSR 03110C* ADD NEW QCKEY RECORD. 03120CSR SETON 85 03130CSR EXCPT 03140CSR SETOF 85 03150CSR ENDSR 03160C******************************************************************** 03170CSR SR86 BEGSR 03180C* REWRITE QFKEY FILE. 03190CSR SETON 86 03200CSR EXCPT 03210CSR SETOF 86 03220CSR ENDSR 03230C******************************************************************** 03240CSR SR87 BEGSR 03250C* ADD NEW QFKEY RECORD. ÐÐ03260CSR SETON 87 03270CSR EXCPT 03280CSR SETOF 87 03290CSR ENDSR 03300C******************************************************************** 03310CSR SR101 BEGSR 03320C* 1-TIME INITIALIZE 03330CSR MOVE ' ' BLK40 40 03340C* GET PORT # AND CRT512 03350CSR MOVE ' ' W8A 8 03360CSR Z-ADD0 W2N 20 03370CSR Z-ADD0 W1N 10 03380CSR MOVE ' ' W2A 2 03390CSR EXITFPGMINX GET PORT # 03400CSR RLABL W8A 03410CSR RLABL W2N 03420CSR RLABL W1N 03430CSR RLABL W2A 03440CSR MOVE W2A PORT 20 PORT NO. 03450CSR PORT COMP 0 54 03460CSRN54 Z-ADD25 PORT DEFAULT 03470CSR PORT CHAINCRT512 H9 03480C* DEFINE WORK FIELDS,ETC. 03490CSR MOVE ' ' BLK35 35 03500CSR MOVE ' ' BLK5 5 ÐÐ03510CSR MOVE ' ' BLK8 8 03520CSR MOVE ' ' BLK20 20 03530CSR ENDSR 03540C******************************************************************** 03550CSR SR102 BEGSR 03560C* UPDATE SALESMAN ALT-KEY. 03570C* DELETE OLD KEY 03580CSR MOVELCROSLS W9A 9 03590CSR MOVE CROFU DATE6 60 03600CSR MOVE DATE6 W9A 03610CSR MOVELW9A W17A 17 03620CSR MOVELQMQOTE W8A 8 03630CSR MOVE QMITEM W8A 03640CSR MOVE W8A W17A 03650CSRN43 W17A CHAINQSKEY 54 03660CSRN54N43 MOVE 'D' QSSTAT 03670CSRN54N43 EXSR SR82 03680C*---------------------------------------------------------------- 03690CSR T102A TAG 03700C* ADD NEW KEY 03710CSR 45 GOTO END102 DELETE TRANS 03720CSR MOVELQMSLSM W9A 03730CSR MOVE QMD,5 DATE6 03740CSR MOVE DATE6 W9A 03750CSR MOVELW9A W17A ÐÐ03760CSR W17A CHAINQSKEY 54 03770CSR MOVE 'A' QSSTAT 03780CSR 54 EXSR SR83 03790CSRN54 EXSR SR82 03800CSR END102 ENDSR 03810C******************************************************************** 03820CSR SR103 BEGSR 03830C* UPDATE CUSTOMER ALT-KEY. 03840C* DELETE OLD KEY 03850CSR MOVELCROCUS W28A 28 03860CSR MOVELQMQOTE W8A 03870CSR MOVE QMITEM W8A 03880CSR MOVE W8A W28A 03890CSRN43 W28A CHAINQCKEY 54 03900CSRN54N43 MOVE 'D' QCSTAT 03910CSRN54N43 EXSR SR84 03920C*-------------------------------------------------------------- 03930CSR T103A TAG 03940C* ADD NEW KEY 03950CSR 45 GOTO END103 DELETE TRANS 03960CSR MOVELQMNAME W28A 03970CSR W28A CHAINQCKEY 54 03980CSR MOVE 'A' QCSTAT 03990CSR 54 EXSR SR85 04000CSRN54 EXSR SR84 ÐÐ04010CSR END103 ENDSR 04020C******************************************************************** 04030CSR SR104 BEGSR 04040C* UPDATE FOLLOW-UP ALT-KEY. 04050C* DELETE OLD KEY 04060CSR MOVE CROFU DATE6 60 04070CSR MOVELDATE6 W14A 14 04080CSR MOVELQMQOTE W8A 04090CSR MOVE QMITEM W8A 04100CSR MOVE W8A W14A 04110CSRN43 W17A CHAINQFKEY 54 04120CSRN54N43 MOVE 'D' QFSTAT 04130CSRN54N43 EXSR SR86 04140C*------------------------------------------------------------------- 04150CSR T104A TAG 04160C* ADD NEW KEY 04170CSR 45 GOTO END104 DELETE TRANS 04180CSR MOVE QMD,5 DATE6 04190CSR MOVELDATE6 W14A 04200CSR W14A CHAINQFKEY 54 04210CSR MOVE 'A' QFSTAT 04220CSR 54 EXSR SR87 04230CSRN54 EXSR SR86 04240CSR END104 ENDSR 04250O******************************************************************** ÐÐ04260OQMMAST E 81 04270O QMITEM 8 04280O QMNAME 28 04290O QMRFQ 48 04300O QMRFQI 52 04310O QMCONT 72 04320O QMSLSM 75 04330O QMD 99P 04340O QMPCLS 101 04350O QMSYST 102 04360O QMAMT 107P 04370O QMDEL 109P 04380O QMSCOD 110 04390O QMPROB 112P 04400O QMREAS 113 04410O QMREM 153 04420O QMSTAT 160 04430O******************************************************************** 04440OQSKEY EADD 83 04450O W17A 17 04460O 18 'A' 04470O*------------------------------------------------------------------- 04480O E 82 04490O QSSTAT 18 04500O******************************************************************** ÐÐ04510OQFKEY EADD 87 04520O W14A 14 04530O 15 'A' 04540O*------------------------------------------------------------------- 04550O E 86 04560O QFSTAT 15 04570O******************************************************************** 04580OQCKEY EADD 85 04590O W28A 28 04600O 29 'A' 04610O*------------------------------------------------------------------- 04620O E 84 04630O QCSTAT 29 /* 004640_‚ ÐÐ ÐÐ_‚_‚ ÐÈ((à ‚X038WM P999999120282(èÈÐ00010H Q038WM00020F* UPDATE WOOPER FROM MOVE TICKET, (X038WM) 00030F* REVISED 1-11-82 4:50 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FWOOPER UC F 64R20AI 1 DISK A 00080FWOOPALT UC F 21R20AI 1 DISK A 00090FWOOPSEQ UC F 21R12AI 1 DISK A 00100FWCMAST IC F 960R 8AI 1 DISK 00110FWMMAST IC F 470R 6AI 1 DISK 00120FPMMST2 IC F 674R12AI 1 DISK 00130FTERM132 O F 132 5 00140F**************************************************************** 00150E NUL 1 132 1 NULL CHAR 00160E A14 14 14 1 A INPUT DATA ARRAY 00170E LOC 1 8 3 FIELD STARTING COL # 00180E A9 9 9 1 EXITF QPREED PAR. 00190E NUM 1 7 3 0 NUMERIC FIELD NO.'S 00200E DUN 8 8 1 A EDIT CMPLT FLAG 00210E MES 1 1 30 00220E DOT 19 19 1 00230E* 00240E BIT 33 1 SCREEN CONTR. CHAR 00250E CALL 5 6 CALL STACK ÐÐ00260E WMD 26 6 0 00270E WMQ 26 7 0A 00280E WLT 26 3 0 00290I******************************************************************* 00300IBITTAB BT 00310I 1 33 BIT 00320I******************************************************************* 00330IMGFILE MG 00340I* MESSAGE FILE. 00350I 1 35 MGTEXT 00360I****************************************************************** 00370ICRTFILE CR 00380I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00390I* EMPLOYEE # 5N 00400I 1 50CREMPL 00410I* USER CODE 8A 00420I 6 13 CRUSER 00430I* DEPT # 5N 00440I 14 180CRDEPT 00450I* JOB NAME 8A (JOB LOADED BY MENU) 00460I 19 26 CRJOB 00470I* SHUTDOWN FLAG 1A 00480I* BLANK = NO SHUTDOWN 00490I 27 27 CRSHUT 00500I* TIME STARTED 6N ÐÐ00510I 28 330CRTIME 00520I* DATE STARTED 4N 00530I 34 370CRDATE 00540I* CALL STACK 5 X 6A 00550I 38 67 CALL 00560I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00570I 68 73 CRRET 00580I* MENU NAME 6A 00590I 74 79 CRMENU 00600I******************************************************************** 00610IWOOPER WP 00620I* WORK ORDER OPER RECORD. 00630I* WORK ORDER # 9A 00640I 1 9 WPORD 00650I* PRIME 6A 00660I 1 6 WPWOP 00670I* DASH 3N 00680I 7 90WPWOD 00690I* OPER SEQ # 3N 00700I 10 120WPSEQ 00710I 1 12 WPKEY 00720I* DEPT # 5N 00730I 13 170WPDEPT 00740I* WORK CENTER 3N 00750I 18 200WPWC ÐÐ00760I* STD HRS - PER UNIT 00770I* SET-UP 9.3P 00780I P 25 293WPSSUH 00790I* RUN 9.3P 00800I P 30 343WPSRUN 00810I* ACTUAL HRS - TOTALS 00820I* SET-UP 7.1P 00830I P 35 381WPASUH 00840I* RUN 7.1P 00850I P 39 421WPARUN 00860I* QTY MOVED-IN 7P 00870I P 43 460WPQIN 00880I* QTY MOVED-OUT 7P 00890I P 47 500WPQOUT 00900I* DATE LAST TRAN 6N 00910I 58 630WPDLT 00920I* RECORD STATUS 1A 00930I 64 64 WPSTAT 00940I********************************************************************* 00950IWOOPALT WA 00960I 21 21 WASTAT 00970I***************************************************************** 00980IWOOPSEQ WS 00990I 13 170WSDEPT 01000I 18 200WSWC ÐÐ01010I 21 21 WSSTAT 01020I******************************************************************** 01030IWMMAST WM 01040I* WORK ORDER MASTER 01050I* WORK ORDER NO. 6A 01060I 1 6 WMWOP 01070I* DESCRIPTION 40A 01080I 7 46 WMDESC 01090I* QTY RECVD 7P 01100I P 95 980WMQRCD 01110I* SCHED CMPLTN DATES 6N X 26 01120I 99 2540WMD 01130I* SCHED QTYS 7P X 26 01140I P 255 358 WMQ 01150I* LEAD TIMES 3P X 26 01160I P 359 410 WLT 01170I* QTY RELEASED 7P 01180I P 417 4200WMQREL 01190I* PART NUMBER 10N 01200I 422 4310WMPN 01210I 470 470 WMSTAT 01220I********************************************************************** 01230IWCMAST WC 01240I* WORK CENTER MASTER 01250I* WORK CENTER NAME 29A ÐÐ01260I 9 37 WCDESC 01270I 960 960 WCSTAT 01280I**************************************************************** 01290IPMMST2 PM 01300I 19 30 PMMODL 01310C******************************************************************** 01320C* INITIALIZE 01330C EXSR SR101 1-TIME INIT 01340C*------------------------------------------------------------------ 01350C START TAG 01360C* SET-UP 1ST FIELD NO. 01370C MOVE ' ' DUN INIT EDIT ARRAY 01380C Z-ADD1 F 30 FIELD # 01390C EXSR SR205 INIT WOOPER 01400C EXSR SR206 INIT INPUT FIELDS 01410C SETOF 303132 01420C SETOF 333435 01430C SETOF 3637 01440C GOTO READ 01450C*------------------------------------------------------------------ 01460C NEXT TAG 01470C* SET-UP NEXT FIELD NO. 01480C 1 ADD F F FIELD # 01490C*----------------------------------------------------------------- 01500C READ TAG ÐÐ01510C* READ DATA FROM TERMINAL. 01520C SETOF 909677 01530C EXSR SR102 VALIDATE FIELD # 01540C 55 GOTO UPDATE DONE 01550C EXSR SR201 IDENTIFY-F 01560C SETON 69 01570C EXSR SR72 PROMPT 01580C SETOF 69 01590C 36 SEQOUT COMP 0 54 01600C 54 03 36 01610COR 54 04 36 GOTO EDIT BYPASS DEPT/WC 01620C 37 SEQIN COMP 0 54 01630C 54 06 37 01640COR 54 07 37 GOTO EDIT BYPASS DEPT/WC 01650C EXSR SR75 READ TERMINAL 01660C 98 GOTO GOODBY GOODBY 01670C 94 GOTO MENU MENU REQUEST 01680C 90 EXSR SR72 DISPLAY INPUT DATA 01690C 93 GOTO NEWITM NEW ITEM 01700C 92 GOTO JUMP FIELD JUMP REQST 01710C 91 GOTO NEXT SKIP FORWARD 01720C 89 F SUB 1 F SKIP BACKWARD 01730C 89 GOTO READ " " 01740C 88 SETOF 90 SPACE FILL 01750C 88 SETON 77 " " ÐÐ01760C 87 GOTO START 01770C 86 GOTO UPDATE UPDATE 01780C 85 GOTO READ REPEAT 01790C 96 GOTO ERROR ERROR 01800C N77 GOTO EDIT NO DATA INPUT 01810C*------------------------------------------------------------------ 01820C PROCES TAG 01830C* PROCESS INPUT DATA 01840C EXSR SR103 MOVE DATA 01850C*------------------------------------------------------------------- 01860C EDIT TAG 01870C N96 EXSR SR104 EDIT DATA 01880C EXSR SR72 REWRITE DATA 01890C 96 GOTO ERROR ERROR 01900C GOTO NEXT 01910C*------------------------------------------------------------------ 01920C UPDATE TAG 01930C* UPDATE DATA BASE. 01940C EXSR SR105 FINAL EDIT 01950C 96 GOTO ERROR ERROR 01960C EXSR SR106 UPDATE 01970C 96 GOTO ERROR ERROR 01980C 1 ADD COUNT COUNT 30 01990C COUNT COMP 119 54 54 02000C 54 EXSR SR71 PUT HEADING ÐÐ02010C GOTO START 02020C*------------------------------------------------------------------- 02030C JUMP TAG 02040C* SET-UP JUMP TO REQUESTED FIELD 02050C 1 ADD W W 30 02060C W COMP 14 54 02070C 54 Z-ADD318 M 50 96 FLAG ERROR 02080C 54 GOTO ERROR BAD ESC 02090C MOVE ' ' W3A 3 02100C MOVEAA14,W W3A 02110C Z-ADD3 W2N 20 02120C EXIT SUBRAJ R. JUSTIFY 02130C RLABL W2N 02140C RLABL W3A 02150C MOVE W3A F NEW FIELD # 02160C GOTO READ 02170C*-------------------------------------------------------------------- 02180C ERROR TAG 02190C EXSR SR102 VALIDATE FIELD # 02200C EXSR SR89 GET MSG 02210C EXSR SR73 PUT MSG 02220C GOTO READ 02230C*------------------------------------------------------------------ 02240C NEWITM TAG 02250C* SET-UP LINK FOR NEW ITEM ÐÐ02260C GOTO START 02270C*------------------------------------------------------------------- 02280C MENU TAG 02290C* SET-UP LINK TO MENU 02300C MOVELCRMENU PROG 8 02310C GOTO END 02320C*-------------------------------------------------------------------- 02330C GOODBY TAG 02340C* LINK TO SIGN-OFF 02350C MOVEL'GOODBY' PROG 02360C GOTO END 02370C*------------------------------------------------------------------- 02380C END TAG 02390C PROG COMP BLK8 54 02400C N54 MOVELCRMENU PROG 02410C EXITFCHAIN 02420C RLABL PROG 02430C***************************************************************** 02440CSR SR1 BEGSR 02450C* EDIT WORK ORDER NO. 02460CSR TWOP CHAINWMMAST 54 02470CSR 54 EXSR SR209 INIT WO DESCR 02480CSR MOVE WMDESC DESC40 40 02490CSR ENDSR 02500C****************************************************************** ÐÐ02510CSR SR2 BEGSR 02520C* EDIT FROM SEQ # 02530CSR SETOF 36 02540CSR SEQOUT COMP 0 54 02550CSRN54 GOTO END2 02560CSR MOVELTWO W12A 12 02570CSR MOVE SEQOUT W12A 02580CSR W12A CHAINWOOPSEQ 54 02590CSRN54 WSSTAT COMP 'D' 54 02600CSR 54 GOTO END2 02610CSR SETON 36 02620CSR Z-ADDWSDEPT DEPOUT 02630CSR Z-ADDWSWC WCOUT 02640CSR END2 ENDSR 02650C***************************************************************** 02660CSR SR4 BEGSR 02670C* EDIT WORK CENTER FROM 02680CSR SETOF 303132 02690CSR MOVELTWO W20A 20 02700CSR MOVELSEQOUT W11A 11 02710CSR MOVELDEPOUT W8A 8 02720CSR MOVE WCOUT W8A 02730CSR MOVE W8A W11A 02740CSR MOVE W11A W20A 02750CSR MOVE W20A SAVOUT 20 ÐÐ02760CSR EXSR SR80 GET WOOPER 02770CSR 60 SETON 30 NOT ON FILE 02780CSR 61 SETON 31 DELETED 02790CSR 30 02800COR 31 EXSR SR205 INIT WOOPER 02810CSR SEQOUT COMP 0 32 02820CSRN32 DEPOUT COMP 0 32 02830CSRN32 WCOUT COMP 0 32 02840CSRN32 GOTO END4 NO FROM DATA INPUT 02850CSR 30 02860COR 31 Z-ADD637 M 96 FLAG ERROR 02870CSR 96 GOTO END4 02880CSR DEPOUT COMP 0 54 02890CSRN54 GOTO END4 02900CSR EXSR SR83 GET WCMAST 02910CSR 60 Z-ADD628 M 96 FLAG ERROR 02920CSR END4 ENDSR 02930C******************************************************************** 02940CSR SR5 BEGSR 02950C* EDIT TO SEQ # 02960CSR SETOF 37 02970CSR SEQIN COMP 0 54 02980CSRN54 GOTO END5 02990CSR MOVELTWO W12A 03000CSR MOVE SEQIN W12A ÐÐ03010CSR W12A CHAINWOOPSEQ 54 03020CSRN54 WSSTAT COMP 'D' 54 03030CSR 54 GOTO END5 03040CSR SETON 37 03050CSR Z-ADDWSDEPT DEPIN 03060CSR Z-ADDWSWC WCIN 03070CSR END5 ENDSR 03080C**************************************************************** 03090CSR SR7 BEGSR 03100C* EDIT WORK CENTER TO 03110CSR SETOF 333435 03120CSR MOVELTWO W20A 03130CSR MOVELSEQIN W11A 03140CSR MOVELDEPIN W8A 03150CSR MOVE WCIN W8A 03160CSR MOVE W8A W11A 03170CSR MOVE W11A W20A 03180CSR MOVE W20A SAVIN 20 03190CSR EXSR SR80 GET WOOPER 03200CSR 60 SETON 33 03210CSR 61 SETON 34 03220CSR 33 03230COR 34 EXSR SR205 INIT WOOPER 03240CSR SEQIN COMP 0 35 03250CSRN35 DEPIN COMP 0 35 ÐÐ03260CSRN35 WCIN COMP 0 35 03270CSRN35 GOTO END7 03280CSR EXSR SR83 GET WORK CENTER MAST 03290CSR 60 Z-ADD628 M 96 FLAG ERROR 03300CSR END7 ENDSR 03310C*************************************************************** 03320CSR SR8 BEGSR 03330C* EDIT QTY MOVED 03340CSR QTY COMP 0 5454 03350CSRN54 Z-ADD184 M 96 FLAG ERROR 03360CSR ENDSR 03370C******************************************************************* 03380CSR SR68 BEGSR 03390CSR EXITFQCLF LINE FEED 03400CSR ENDSR 03410C**************************************************************** 03420CSR SR69 BEGSR 03430CSR EXITFQXYPOS MOVE CURSOR 03440CSR RLABL W6A 03450CSR ENDSR 03460C***************************************************************** 03470CSR SR70 BEGSR 03480C* CLEAR TERM SCREEN. 03490CSR EXITFZCPAGE CLEAR SCREEN 03500CSR Z-ADD91 COUNT 30 ÐÐ03510CSR ENDSR 03520C********************************************************************** 03530CSR SR71 BEGSR 03540C* PUT HEADINGS TO TERMINAL 03550CSR EXSR SR70 CLEAR PAGE 4 03560CSR SETON 71 03570CSR EXCPT PUT HEADINGS 03580CSR SETOF 71 03590CSR Z-ADD98 COUNT 03600CSR ENDSR 03610C********************************************************************* 03620CSR SR72 BEGSR 03630C* PUT DATA TO TERMINAL 03640CSR TWOD COMP 0 55 03650CSR COUNT SUB 1 W3N 30 03660CSR MOVELW3N W6A 6 03670CSR MOVE '001' W6A 03680CSR EXSR SR69 MOVE CURSOR 03690CSR SETON 72 03700CSR EXCPT PUT DATA 03710CSR SETOF 72 03720CSR ENDSR 03730C*********************************************************************** 03740CSR SR73 BEGSR 03750C* PUT ERROR MESSAGE TO TERMINAL ÐÐ03760CSR EXSR SR72 03770CSR SETON 73 03780CSR EXCPT PUT MSG 03790CSR SETOF 73 03800CSR MGTEXT COMP BLK35 54 03810CSR 54 1 ADD LSTERR LSTERR 03820CSR ENDSR 03830C******************************************************************* 03840CSR SR75 BEGSR 03850C* READ FROM TERMINAL 03860CSR SETOF 779096 03870CSR SETOF 939291 03880CSR SETOF 898887 03890CSR SETOF 8685 03900CSR MOVE BIT,8 BUFLGT 2 READ BUFFER LGTH 03910CSR MOVE BLK14 W14A 14 BUFFER 03920CSR MOVE BIT,28 A9,1 03930CSR MOVE '8' A9,2 03940CSR MOVE COUNT W3A 3 03950CSR MOVEAW3A A9,3 03960CSR MOVEALOC,F A9,6 03970CSR MOVE BIT,8 A9,9 03980CSR MOVEAA9 W9A 9 03990CSR EXITFQPREED READ FROM TERMINAL 04000CSR RLABL W9A STARTING POSITION ÐÐ04010CSR RLABL W14A READ BUFFER 04020CSR RLABL BUFLGT READ BUFFER LGTH 04030CSR MOVEAW14A A14 INPUT DATA ARRAY 04040CSR MOVE BLK14 W14A INIT INPUT ARRAY 04050CSR Z-ADD1 W 30 04060CSR '\' LOKUPA14,W 90 FLAG ESC 04070CSRN90 GOTO T75B NOT ESC 04080CSR 1 ADD W W 04090CSR W COMP 14 54 04100CSR 54 GOTO T75A BAD ESC 04110CSR A14,W COMP 'G' 98 GOODBY 04120CSR A14,W COMP 'E' 94 MENU 04130CSR A14,W COMP 'N' 93 NEW ITEM 04140CSR A14,W COMP 'J' 92 JUMP 04150CSR A14,W COMP 'F' 91 SKIP FRWRD 04160CSR A14,W COMP 'B' 89 SKIP BKWRD 04170CSR A14,W COMP 'S' 88 SPACE FILL 04180CSR A14,W COMP 'H' 87 HOME 04190CSR A14,W COMP 'U' 86 UPDATE 04200CSR A14,W COMP 'R' 85 REPEAT 04210CSR 98 04220COR 94 04230COR 93 04240COR 92 04250COR 91 ÐÐ04260COR 89 04270COR 88 04280COR 87 04290COR 86 04300COR 85 GOTO END75 GOOD ESC 04310C*------------------------------------------------------------------ 04320CSR T75A TAG 04330C* FLAG BAD ESC INPUT 04340CSR Z-ADD318 M 96 FLAG ERROR 04350CSR GOTO END75 04360C*-------------------------------------------------------------------- 04370CSR T75B TAG 04380C* MOVE DATA 04390CSR Z-ADD1 W 04400CSR ' ' LOKUPA14,W 77 04410CSR 77 MOVEAA14,W W14A INPUT DATA 04420C*-------------------------------------------------------------------- 04430CSR END75 TAG 04440C* INIT PREV ERROR MSG. 04450CSR LSTERR COMP 0 54 04460CSR 54 MOVE BLK35 MGTEXT 04470CSR 54 EXSR SR73 BLANK MESSAGE 04480CSR Z-ADD0 LSTERR 50 04490CSR ENDSR 04500C********************************************************************** ÐÐ04510CSR SR80 BEGSR 04520C* GET WOOPER RECORD 04530CSR SETOF 61 04540CSR W20A CHAINWOOPER 60 GET WOOPER FILE 04550CSRN30 WPSTAT COMP 'D' 61 FLAG DELETE 04560CSR ENDSR 04570C********************************************************************** 04580CSR SR81 BEGSR 04590C* UPDATE FROM WOOPER. 04600CSR SETON 81 04610CSR EXCPT UPD FROM WOOPER 04620CSR SETOF 81 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR82 BEGSR 04660C* UPDATE TO WOOPER. 04670CSR SETON 82 04680CSR EXCPT UPD TO WOOPER 04690CSR SETOF 82 04700CSR MOVELW20A W12A 12 04710CSR MOVE W20A W8A 8 04720CSR MOVELW8A W20A 04730CSR MOVE W12A W20A 04740CSR W20A CHAINWOOPALT 60 04750CSR SETON 84 ÐÐ04760CSR EXCPT ADD ALT KEY 04770CSR SETOF 84 04780CSR SEQIN COMP 0 54 04790CSRN54 GOTO END82 04800CSR MOVELTWO W12A 12 04810CSR MOVE SEQIN W12A 04820CSR W12A CHAINWOOPSEQ 60 04830CSR SETON 80 04840CSR EXCPT ADD WOOPSEQ 04850CSR SETOF 80 04860CSR END82 ENDSR 04870C****************************************************************** 04880CSR SR83 BEGSR 04890C* GET WORK CENTER MASTER 04900CSR W8A CHAINWCMAST 60 04910CSRN60 WCSTAT COMP 'D' 60 04920CSRN60 MOVE BLK35 DESC40 40 04930CSRN60 MOVELWCDESC DESC40 04940CSR ENDSR 04950C********************************************************************** 04960CSR SR89 BEGSR 04970C* GET MESSAGE MASTER 04980CSR M CHAINMGFILE 54 04990CSR 54 MOVE BLK35 MGTEXT 05000CSR 54 MOVELM MGTEXT ÐÐ05010CSR 54 MOVE MES,1 MGTEXT 05020CSR ENDSR 05030C*********************************************************************** 05040CSR SR101 BEGSR 05050C* 1-TIME INITIALIZE 05060CSR MOVE BIT,1 NUL 05070CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05080CSR Z-ADD8 FLIMIT 30 TOTAL NUMB FIELDS 05090CSR MOVE ' ' BLK14 14 05100CSR MOVE ' ' BLK8 8 05110CSR MOVELUDATE W4N 40 05120CSR MOVE UDATE W2N 05130CSR MOVELW2N TODAY 60 05140CSR MOVE W4N TODAY 05150C* GET PORT # AND CRTFILE 05160CSR MOVE ' ' W8A 8 05170CSR Z-ADD0 W2N 20 05180CSR Z-ADD0 W1N 10 05190CSR MOVE ' ' W2A 2 05200CSR EXITFPGMINX GET PORT # 05210CSR RLABL W8A 05220CSR RLABL W2N 05230CSR RLABL W1N 05240CSR RLABL W2A 05250CSR MOVE W2A PORT 20 PORT NO. ÐÐ05260CSR PORT COMP 0 54 05270CSRN54 Z-ADD25 PORT DEFAULT 05280CSR PORT CHAINCRTFILE H9 05290C* DEFINE WORK FIELDS,ETC. 05300CSR MOVE ' ' BLK35 35 05310CSR EXSR SR71 PUT HEADINGS 05320C* 05330C* 05340C* 05350C* 05360CSR ENDSR 05370C********************************************************************** 05380CSR SR102 BEGSR 05390C* VALIDATE FIELD NO. 05400CSR F COMP 0 54 05410CSRN54 Z-ADD1 F 05420CSR F COMP FLIMIT 55 05430CSR 55 Z-ADD1 F 05440CSR ENDSR 05450C******************************************************************** 05460CSR SR103 BEGSR 05470C* MOVE INPUT DATA 05480CSR EXSR SR201 IDENTIFY-F 05490CSR EXSR SR202 R. JUSTIFY 05500CSR 01 EXSR SR210 BUILD WO # ÐÐ05510CSR 02 MOVE W10A SEQOUT 30 05520CSR 03 MOVE W10A DEPOUT 50 05530CSR 04 MOVE W10A WCOUT 30 05540CSR 05 MOVE W10A SEQIN 30 05550CSR 06 MOVE W10A DEPIN 50 05560CSR 07 MOVE W10A WCIN 30 05570CSR 08 MOVE W10A QTY 70 05580CSR MOVE ' ' DUN,F EDIT FLAG 05590CSR ENDSR 05600C******************************************************************** 05610CSR SR104 BEGSR 05620C* EDIT INPUT DATA 05630CSR 01 EXSR SR1 05640CSR 02 EXSR SR2 05650CSR 04 EXSR SR4 05660CSR 05 EXSR SR5 05670CSR 07 EXSR SR7 05680CSR 08 EXSR SR8 05690CSR 96 MOVE ' ' DUN,F EDIT FLAG 05700CSRN96 MOVE 'X' DUN,F 05710CSR ENDSR 05720C*********************************************************************** 05730CSR SR105 BEGSR 05740C* FINAL EDIT 05750CSR SETOF 77 ÐÐ05760CSR SETON 79 FINAL EDIT FLAG 05770CSR Z-ADD1 F 96 05780C*-------------------------------------------------------------------- 05790CSR T105A TAG 05800CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05810CSRN54 GOTO END105 05820CSR EXSR SR201 IDENTIFY-F 05830CSR EXSR SR104 EDIT 05840CSRN96 GOTO T105A 05850C*-------------------------------------------------------------------- 05860CSR END105 TAG 05870C* FLAG BOTH FROM AND TO DATA MISSING 05880CSRN32N35N96 Z-ADD2 F RESET FIELD NO. 05890CSRN32N35N96 Z-ADD615 M 96 FLAG ERROR 05900CSR SETOF 79 05910CSR ENDSR 05920C******************************************************************** 05930CSR SR106 BEGSR 05940C* UPDATE. 05950CSRN32 GOTO T106C NO FROM WC INPUT MADE05960CSR MOVE SAVOUT W20A 05970CSR EXSR SR80 GET WOOPER 05980CSR 60 NOT ON FILE 05990COR 61 EXSR SR205 DELETED 06000CSR QTY ADD WPQOUT WPQOUT ÐÐ06010CSR EXSR SR81 UPDATE WOOPER 06020C* * * * * * * * EXSR SR40 UPDATE WCMAST 06030C*----------------------------------------------------------------- 06040CSR T106C TAG 06050CSRN35 GOTO END106 NO TO WC INPUT MADE 06060CSR MOVE SAVIN W20A 06070CSR EXSR SR80 GET WOOPER 06080CSR 60 06090COR 61 EXSR SR205 INIT WOOPER 06100CSR QTY ADD WPQIN WPQIN QTY MOVED IN 06110CSR EXSR SR82 UPDATE WOOPER 06120C* * * * * * * * EXSR SR41 UPDATE WCMAST 06130CSR END106 ENDSR 06140C************************************************************************ 06150CSR SR201 BEGSR 06160C* IDENTIFY FIELD NO. 06170CSR F COMP 1 01 06180CSR F COMP 2 02 06190CSR F COMP 3 03 06200CSR F COMP 4 04 06210CSR F COMP 5 05 06220CSR F COMP 6 06 06230CSR F COMP 7 07 06240CSR F COMP 8 08 06250CSR ENDSR ÐÐ06260C********************************************************************** 06270CSR SR202 BEGSR 06280C* RIGHT JUSTIFY 06290CSR F LOKUPNUM 54 06300CSRN54 GOTO END202 NOT NUMERIC FIELD 06310CSR Z-ADD15 W2N 20 06320CSR MOVELW14A W10A 10 06330CSR EXIT SUBRAJ R. JUSTIFY 06340CSR RLABL W2N 06350CSR RLABL W10A 06360CSR END202 ENDSR 06370C******************************************************************* 06380CSR SR205 BEGSR 06390C* INIT WOOPER 06400CSR MOVE BLK35 WPORD 06410CSR MOVE BLK8 WPWOP 06420CSR Z-ADD0 WPWOD 06430CSR Z-ADD0 WPSEQ 06440CSR MOVE BLK35 WPKEY 06450CSR Z-ADD0 WPDEPT 06460CSR Z-ADD0 WPWC 06470CSR Z-ADD0 WPSSUH 06480CSR Z-ADD0 WPSRUN 06490CSR Z-ADD0 WPASUH 06500CSR Z-ADD0 WPARUN ÐÐ06510CSR Z-ADD0 WPQIN 06520CSR Z-ADD0 WPQOUT 06530CSR Z-ADDTODAY WPDLT ****06540CSR MOVE ' ' WPSTAT 06550CSR ENDSR 06560C******************************************************************** 06570CSR SR206 BEGSR 06580C* INIT INPUT FIELDS. 06590CSR EXSR SR209 INIT WMMAST 06600CSR MOVE BLK8 TWOP 06610CSR Z-ADD0 TWOD 06620CSR MOVE BLK14 TWO 06630CSR MOVE BLK14 PMMODL 06640CSR Z-ADD0 SEQOUT 06650CSR Z-ADD0 DEPOUT 06660CSR Z-ADD0 WCOUT 06670CSR Z-ADD0 SEQIN 06680CSR Z-ADD0 DEPIN 06690CSR Z-ADD0 WCIN 06700CSR Z-ADD0 QTY 06710CSR MOVE BLK35 SAVOUT 06720CSR MOVE BLK35 SAVIN 06730CSR MOVELBLK35 DESC40 06740CSR MOVE BLK8 DESC40 06750CSR ENDSR ÐÐ06760C******************************************************************* 06770CSR SR209 BEGSR 06780C* INIT WMMAST 06790CSR MOVELBLK35 WMDESC 06800CSR MOVE BLK8 WMDESC 06810CSR Z-ADD0 WMPN 06820CSR ENDSR 06830C******************************************************************** 06840CSR SR210 BEGSR 06850C* BUILD WORK ORDER. 06860CSR MOVE ' ' A14 06870CSR MOVEAW14A A14 06880CSR Z-ADD1 W 06890CSR '-' LOKUPA14,W 54 06900CSR MOVE ' ' W4A 4 06910CSR 54 MOVEAA14,W W4A 06920CSR 54 MOVEL' ' W4A 06930CSR 54 MOVEABLK14 A14,W 06940CSR Z-ADD4 W2N 06950CSR EXIT SUBRAJ R.J. 06960CSR RLABL W2N 06970CSR RLABL W4A 06980CSR MOVE W4A TWOD 30 WORK ORDER DASH 06990CSR Z-ADD1 W 07000CSR ' ' LOKUPA14,W 54 ÐÐ07010CSRN54 Z-ADD1 W 07020CSR A14,W COMP '0' 54 54 07030CSRN54 MOVEAA14,W TWOP 6 07040CSRN54 MOVE TWOP W5A 5 07050CSR 54 MOVEAA14,W W5A 07060CSR 54 MOVEL' ' TWOP 07070CSR Z-ADD5 W2N 07080CSR EXIT SUBRAJ R.J. 07090CSR RLABL W2N 07100CSR RLABL W5A 07110CSR MOVE W5A TWOP 07120CSR MOVELTWOP TWO 9 07130CSR MOVE TWOD TWO 07140CSR MOVELTWOP PREFIX 1 07150CSR END210 ENDSR 07160O******************************************************************** 07170OTERM132 E 71 07180O BIT,28 1 07190O 8 '8091001' 07200O UDATE 16 ' - - ' 07210O 80 'INPUT MOVE TICKETS' 07220O*------------------------------------------------------------------- 07230O E 71 07240O 1 ' ' 07250O*------------------------------------------------------------------- ÐÐ07260O E 71 07270O DOT 101 07280O DOT 122 07290O 96 ' FROM ' 07300O 116 ' TO ' 07310O*------------------------------------------------------------------- 07320O E 71 07330O 87 'OPER' 07340O 101 'WORK' 07350O 108 'OPER' 07360O 122 'WORK' 07370O*------------------------------------------------------------------- 07380O E 71 07390O 10 'WORK-ORDER' 07400O 23 'DESCRIPTION' 07410O 60 'MODEL' 07420O 75 'PART #' 07430O 87 'SEQ#' 07440O 93 'DEPT' 07450O 102 'CENTER' 07460O 108 'SEQ#' 07470O 114 'DEPT' 07480O 123 'CENTER' 07490O 132 'QUANTITY' 07500O*------------------------------------------------------------------- ÐÐ07510O E 71 07520O 3 '(1)' 07530O 86 '(2)' 07540O 92 '(3)' 07550O 100 '(4)' 07560O 107 '(5)' 07570O 113 '(6)' 07580O 121 '(7)' 07590O 126 '(8)' 07600O*------------------------------------------------------------------- 07610O E 71 07620O 1 ' ' 07630O*------------------------------------------------------------------- 07640O E 72 07650O TWOP 6 07660O 55 7 '-' 07670O 55 TWOD 10 07680O DESC40 52 07690O PMMODL 67 07700O WMPN 79 ' - - ' 07710O SEQOUTZ 86 07720O DEPOUTZ 94 07730O WCOUT Z 100 07740O SEQIN Z 107 07750O DEPIN Z 115 ÐÐ07760O WCIN Z 121 07770O QTY K 132 07780O*------------------------------------------------------------------- 07790O E 73 07800O NUL 132 07810O MGTEXT 35 07820O******************************************************************** 07830OWOOPER EADD 82 33 07840O* 'TO' WOOPER OPER. 07850O TWO 9 07860O SEQIN 12 07870O DEPIN 17 07880O WCIN 20 07890O WPSSUH 29P 07900O WPSRUN 34P 07910O WPASUH 38P 07920O WPARUN 42P 07930O WPQIN 46P 07940O WPQOUT 50P 07950O TODAY 63 07960O 64 'A' 07970O*--------------------------------------------------------------- 07980O E 82N33 07990O OR 81N30 08000O* FROM OPERATION (81) OR REWRITE TO OPER (82) ÐÐ08010O WPSSUH 29P 08020O WPSRUN 34P 08030O WPASUH 38P 08040O WPARUN 42P 08050O WPQIN 46P 08060O WPQOUT 50P 08070O TODAY 63 08080O 64 'A' 08090O****************************************************************** 08100OWOOPALT EADD 84 60 08110O W20A 20 08120O 21 'A' 08130O*----------------------------------------------------------------- 08140O E 84N60 08150O 21 'A' 08160O******************************************************************** 08170OWOOPSEQ EADD 80 60 08180O W12A 12 08190O DEPIN 17 08200O WCIN 20 08210O 21 'A' 08220O*------------------------------------------------------------------ 08230O E 80N60 08240O DEPIN 17 08250O WCIN 20 ÐÐ08260O 21 'A' 08270O******************************************************************** ** NUL ARRAY 008280 008290** A14 ARRAY 008300 008310** LOC ARRAY 08320001 1 WO # 08330085 2 FROM SEQ 08340091 3 FROM DEPT 08350099 4 FROM WC 08360106 5 TO SEQ 08370112 6 TO DEPT 08380120 7 TO WC 08390125 8 QTY 08400** A9 ARRAY 08410 08420** NUM ARRAY 008430002 FROM SEQ NO. 08440003 FROM DEPT. 08450004 FROM WC 08460005 TO SEQ NO. 08470006 TO DEPT 08480007 TO WC 08490008 QTY MOVED 08500ÐÐ** DUN ARRAY 008510 008520** MES ARRAY 008530---MESSAGE NOT ON FILE--- 008540** DOT ARRAY 008550<-----------------> 08560/* 08570_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Z*c Z&X010SF P120282120282(èÈÐ00010H Q010SF00020F* PROGRAM LOADER FOR SCHEDULE STREAM. 00030F* REVISED 7/05/79 9:00 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060E******************************************************************** 00070E BIT 33 1 00080E CALL 5 6 A 00090I******************************************************************** 00100IBITTAB BT 01 00110I 1 33 BIT 00120I******************************************************************** 00130ICRTFILE CR 00140I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00150I* STD AREA - SAME FOR ALL PROGRAMS. 00160I* EMPLOYEE # 5N 00170I 1 50CREMPL 00180I* USER CODE 8A 00190I 6 13 CRUSER 00200I* DEPT # 5N 00210I 14 180CRDEPT 00220I* JOB NAME 8A (JOB LOAD BY MENU) 00230I 19 26 CRJOB 00240I* SHUTDOWN FLAG 1A 00250I* BLANK = NO SHUTDOWN ÐÐ00260I 27 27 CRSHUT 00270I* TIME STARTED 6N 00280I 28 330CRTIME 00290I* DATE STARTED 4N 00300I 34 370CRDATE 00310I* CALL STACK 5 X 6A 00320I 38 67 CALL 00330I* RET TO PROG NAME (FOR PROG LOADER) 6A 00340I 68 73 CRRET 00350I* MENU NAME 6A 00360I 74 79 CRMENU 00370I*------------------------------------------------------------------- 00380I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 00390C******************************************************************** 00400C MOVE ' ' BLK8 8 00410C MOVE ' ' BLK6 6 00420C MOVE ' ' W8A 8 00430C Z-ADD0 W2N 20 00440C Z-ADD0 W1N 10 00450C MOVE ' ' W2A 2 00460C* GET PORT #. CHAIN TO CRTFILE. 00470C EXITFPGMINX 00480C RLABL W8A 00490C RLABL W2N 00500C RLABL W1N ÐÐ00510C RLABL W2A 00520C MOVE W2A PORT 20 00530C PORT COMP 0 54 00540C N54 Z-ADD25 PORT 00550C PORT CHAINCRTFILE H9 00560C Z-ADD1 X 30 00570C BLK6 LOKUPCALL,X 54 00580C 54 MOVELCALL,X PROG 8 00590C 54 MOVE BLK6 CALL,X 00600C 54 GOTO END 00610C MOVEL'Q207SF' PROG 00620C*----------------------------------------------------------------- 00630C END TAG 00640C* NOTE--- CRTFILE UPDATED AT DETAIL OUTPUT TIME. 00650CLR EXITFCHAIN 00660CLR RLABL PROG 00670O******************************************************************** 00680OCRTFILE D 01NH9 00690O CALL 67 /* 000700_‚ ÐÐ _‚_‚0CLR RLABL PROG 00670O******************************************************************** 00680OCRTFILE D 01NH9 00690O CALL 67 /* 000700_‚ ÐÈ(*Š  X010XP P120282120282(èÈÐ00010H Q010XP00020F* COPY 122-BYTE DISKETT FILE TO 80-COL WOTRAN FILE (U1) (X010XP) 00030F* REQTRAN FILE (U2) DG REL006 OK 00040F* POTRAN FILE (U3) 00050F* DISK80 OUTPUT FILE MUST BE RENAMED AS ONE OF THE ABOVE AFTER 00060F* THIS PROG IS RUN. 00070F* REVISED 2/16/80 12:10 PM. 00080FFLOPPY IP F 122 17 00090F KEBCDIC 00100FDISK80 O F 80 80 DISK A 00110IFLOPPY FL 01 00120I 1 2 EOF 00130I 1 80 REC 70 00140C EOF COMP '/*' 54 00150C 54 SETON LR 00160ODISK80 DADD 01N54N70 00170O REC 80 00180O U1 2 'WO' 00190O U2 2 'RQ' 00200O U3 2 'PO' /* 000210_‚ ÐÐ _‚_‚0F* THIS PROG IS RUN. 00070F* REVISED 2/16/80 12:10 PM. 00080FFLOPPY IP F 122 17 00090F KEBCDIC 00100FDISK80 O F 80 80 DISK A 00110IFLOPPY FL 01 00120I 1 2 EOF 00130I 1 80 REC 70 00140C EOF COMP '/*' 54 00150C 54 SETON LR 00160ODISK80 DADD 01N54N70 00170O REC 80 00180O U1 2 'WO' 00190O U2 2 'RQ' 00200O U3 2 'PO' /* 000210_‚ ÐÈ(,*˜ ,}X011CF P120282120282(èÈÐ00010H Q011CF00020F* PRINT LABELS, SELECTED, CO. NAME SEQ (X011CF) 00030F* REVISED 4/25/80 11:20 PM. DG-REL006 OK. 00040FCFKEYOUTIP F 59 59R I DISK 00050FCFADRT IR F 300 3 3IT EDISK 00060FCFMAST IC F 370R15AI 1 DISK 00070FPRINT O F 50 OF PRINTER 00080E******************************************************************** 00090E CFADRT CFKEYOUT 00100E NA4 5 5 6 00110E NB4 5 5 4 0 00120E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00130E SEL 38 38 1 00140E WRK 38 38 1 A 00150E CSZ 38 38 1 A 00160E BIT 33 1 00170E CFA 8 35 A 00180E CFN 5 3 A 00190E CFC 5 3 0 00200E NAC 24 1 00210I******************************************************************** 00220ICFKEYOUTCK 00230I 36 50 CKKEY 00240I 51 590CKZIP 00250I******************************************************************** ÐÐ00260ICFMAST CF 01 00270I* CATALOG HOLDER (MAIL LIST) MASTER. 00280I* KEY AREA. 00290I* NAME KEY 15A 00300I 1 15 CFKEY 00310I* ADDRESS LINES 35A X 8 00320I 16 295 CFA 00330I* STATE CODE 2A 00340I 296 297 CFSTCD 00350I* ZIP 9P 00360I P 298 3020CFZIP 00370I* CATALOGS. 00380I* NAME 3A X 5 00390I 303 317 CFN 00400I* COPIES 3P X 5 00410I P 318 327 CFC 00420I* SELECTOR CODES 24 X 1A 1 00430I 328 351 NAC 00440I* TELEPHONE # 12A 00450I 352 363 CFTEL 00460I* DATE LAST TRAN 6N (YMD) 00470I 364 3690CFDLT 00480I* RECORD STATUS 1A 00490I 370 370 CFSTAT 00500C******************************************************************** ÐÐ00510C* INITIALIZE - 1 TIME. 00520C EXSR SR101 INIT. 00530C*------------------------------------------------------------------- 00540C CKKEY CHAINCFMAST 54 00550C CFSTAT COMP 'D' 54 00560C 54 SETOF 01 00570C 54 GOTO END DELETED CFMAST. 00580C EXSR SR102 00590C*------------------------------------------------------------------- 00600C END TAG 00610C******************************************************************** 00620CSR SR101 BEGSR 00630C* INITIALIZE 1-TIME. 00640CSR MOVE ' ' BLK16 16 00650CSR MOVE ' ' BLK35 35 00660CSR 78 GOTO END101 00670C*--------------------------------------------------------------- 00680CSR T101A TAG 00690CSR SETON 78 00700CSR SETON 84 00710CSR EXCPT 00720CSR EXCPT 00730CSR EXCPT 00740CSR EXCPT 00750CSR EXCPT ÐÐ00760CSR EXCPT 00770CSR EXCPT 00780CSR EXCPT 00790CSR SETOF 84 00800CSR MOVE ' ' W6A 6 00810CSR EXITFQREED6 READ CRT 6-BYTES 00820CSR RLABL W6A 00830CSR W6A COMP ' ' 54 00840CSRN54 GOTO T101A ALL BLANKS-REPEAT 00850CSR END101 ENDSR 00860C******************************************************************** 00870CSR SR102 BEGSR 00880C* WRITE LABEL. 00890CSR Z-ADD0 COUNT 30 00900C*R *** EXSR SR201 PUT SELECTOR. 00910CSR Z-ADD1 L 30 00920CSR SETOF 75 00930C*------------------------------------------------------------------- 00940CSR T102A TAG 00950CSR BLK35 LOKUPCFA,L 54 00960CSRN54 GOTO T102W 00970CSR 'D' LOKUPNAC 54 FLAG DOMESTIC 00980CSR L COMP 7 55 FLAG LINE 7 00990CSRN54 NOT DOMESTIC 01000CORN55 GOTO T102B NOT LINE 7 ÐÐ01010CSR EXSR SR202 PUT CITY/STATE. 01020CSR GOTO T102W 01030C*------------------------------------------------------------------- 01040CSR T102B TAG 01050CSR SETON 81 01060CSR EXCPT PUT NORMAL LINE 01070CSR SETOF 81 01080CSR SETON 75 01090CSR 1 ADD COUNT COUNT 01100CSR MOVE BLK35 CFA,L 01110CSR GOTO T102A GET NEXT LINE 01120C*------------------------------------------------------------------- 01130CSR T102W TAG 01140C* PUT OUT SPACE LINES. 01150CSR COUNT COMP 8 54 01160CSR 54 GOTO END102 01170CSR SETON 83 01180CSR EXCPT 01190CSR SETOF 83 01200CSR 1 ADD COUNT COUNT 01210CSR GOTO T102W 01220CSR END102 ENDSR 01230C******************************************************************** 01240CSR SR201 BEGSR 01250C* BUILD SEL-ARRAY. ÐÐ01260CSR MOVE ' ' WRK 01270CSR Z-ADD1 A 30 01280CSR Z-ADD1 B 30 01290C*------------------------------------------------------------------- 01300CSR T201A TAG 01310C* MOVE SELECTOR CODES. 01320CSR MOVEANAC WRK 01330CSR ' ' LOKUPWRK,B 54 01340C*------------------------------------------------------------------- 01350CSR T201B TAG 01360CSR ' ' LOKUPCFN,A 54 01370CSRN54 GOTO T201C 01380CSR MOVE ',' WRK,B 01390CSR 1 ADD B B 01400CSR B COMP 38 54 01410CSR 54 GOTO T201C 01420CSR MOVE CFN,A W5A 5 01430CSR MOVEAW5A WRK,B 01440CSR 6 ADD B B 01450CSR B COMP 38 54 01460CSR 54 GOTO T201C 01470CSR MOVE '-' WRK,B 01480CSR 1 ADD B B 01490CSR B COMP 38 54 01500CSR 54 MOVE CFC,A W3A 3 ÐÐ01510CSR MOVEAW3A WRK,B 01520CSR MOVE ' ' CFN,A 01530CSR 1 ADD B B 01540CSR B COMP 38 54 01550CSR 54 GOTO T201C 01560CSR GOTO T201B 01570C*------------------------------------------------------------------- 01580CSR T201C TAG 01590CSR Z-ADD1 A 01600CSR MOVE ' ' SEL 01610CSR ' ' LOKUPWRK,A 54 01620CSR 38 SUB A A 01630CSR 1 ADD A A 54 01640CSR 54 A COMP 38 5454 01650CSRN54 Z-ADD1 A 01660CSR MOVEAWRK SEL,A 01670CSR ENDSR 01680C******************************************************************** 01690CSR SR202 BEGSR 01700C* PUT CITY/STATE/ZIP. 01710CSR MOVE ' ' CSZ INIT CITY LINE 01720CSR MOVEACFA,7 CSZ CITY NAME 01730CSR EXSR SR301 FIND END CITY 01740CSRN55 GOTO T202E NO BLKS LEFT 01750CSR MOVE ',' CSZ,A COMMA ÐÐ01760CSR 2 ADD A A 30 01770CSR A COMP 38 54 01780CSR 54 GOTO T202E NO BLKS LEFT 01790CSR MOVEACFSTCD CSZ,A STATE CODE 01800CSR 4 ADD A A 01810CSR A COMP 38 54 01820CSR 54 GOTO T202E NO BLKS LEFT 01830CSR MOVE CFZIP W5A 5 01840CSR MOVEAW5A CSZ,A ZIP CODE 01850C*------------------------------------------------------------------- 01860CSR T202E TAG 01870CSR SETON 82 01880CSR EXCPT 01890CSR SETOF 82 01900CSR 1 ADD COUNT COUNT PUT CITY/STATE. 01910CSR ENDSR 01920C***************************************************************** 01930CSR SR301 BEGSR 01940C* FIND END OF CITY + 1 01950CSR SETOF 55 01960CSR Z-ADD0 W3N 30 01970CSR Z-ADD1 A 01980C*------------------------------------------------------------------- 01990CSR T301A TAG 02000CSR ' ' LOKUPCSZ,A 54 ÐÐ02010CSRN54 1 ADD W3N A 02020CSRN54 GOTO T301B 02030CSR Z-ADDA W3N 02040CSR 1 ADD A A 02050CSR A COMP 38 54 02060CSR 54 GOTO END301 02070CSR GOTO T301A 02080C*-------------------------------------------------------------- 02090CSR T301B TAG 02100CSR A COMP 38 54 02110CSRN54 SETON 55 02120CSR END301 ENDSR 02130C****************************************************************** 02140OPRINT E 1 81 02150O******* 75 SEL 39 02160O CFA,L 36 02170O E 1 82 02180O CSZ 39 02190O E 1 83 02200O E 1 84 02210O 24 'XXXXXXXXXXXXXXXXXXXXXXXX' ** NA4 ARRAY 002220 002230** NB4 ARRAY 002240 002250ÐÐ** TABSC/TABSCN --- STATE CODES/NAMES 002260 002270ALALABAMA 002280AKALASKA 002290AZARIZONA 002300ARARKANSAS 002310ASAMERICAN SAMOA 002320CACALIFORNIA 002330CZCANAL ZONE 002340COCOLORADO 002350CTCONNECTICUT 002360DEDELAWARE 002370DCDISTRICT OF COLUMBIA 002380FLFLORIDA 002390GAGEORGIA 002400GUGUAM 002410HIHAWAII 002420IDIDAHO 002430ILILLINOIS 002440ININDIANA 002450IAIOWA 002460KSKANSAS 002470KYKENTUCKY 002480LALOUISIANA 002490MEMAINE 002500ÐÐMDMARYLAND 002510MAMASSACHUSETTS 002520MIMICHIGAN 002530MNMINNESOTA 002540MSMISSISSIPPI 002550MOMISSOURI 002560MTMONTANA 002570NENEBRASKA 002580NVNEVADA 002590NHNEW HAMPSHIRE 002600NJNEW JERSEY 002610NMNEW MEXICO 002620NYNEW YORK 002630NCNORTH CAROLINA 002640NDNORTH DAKOTA 002650OHOHIO 002660OKOKLAHOMA 002670OROREGON 002680PAPENNSYLVANIA 002690PRPUERTO RICO 002700RIRHODE ISLAND 002710SCSOUTH CAROLINA 002720SDSOUTH DAKOTA 002730TNTENNESSEE 002740TTTRUST TERRITORIES 002750ÐÐTXTEXAS 002760UTUTAH 002770VTVERMONT 002780VAVIRGINIA 002790VIVIRGIN ISLANDS 002800WAWASHINGTON 002810WVWEST VIRGINIA 002820WIWISCONSIN 002830WYWYOMING 002840** SEL ARRAY 002850 002860** WRK ARRAY 002870 002880** CSZ ARRAY 002890 002900/* 002910_‚ ÐÐ_‚_‚XAS 002760UTUTAH 002770VTVERMONT 002780VAVIRGINIA 002790VIVIRGIN ISLANDS 002800WAWASHINGTON 002810WVWEST VIRGINIA 002820WIWISCONSIN 002830WYWYOMING 002840** SEL ARRAY 002850 002860** WRK ARRAY 002870 002880** CSZ ARRAY 002890 002900/* 002910_‚ ÐÈ(Š+ ŠX009CM P120282120282(èÈÐ00010H Q009CM00020F* LIST CMMAST - CUSTOMER SEQ. (X009CM) 00030F* REVISED 3-22-82 3:00 PM. DG-REL006 OK. 00040F* MENU: MQCM01, MQCM02, MQCM03 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCMMAST ID F 576L 5AI 1 DISK 00080FCMBTAFILIC F 352R 5AI 1 DISK 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E TABSTC 1 58 2 TABSCN 20 STATE NAMES. 00120E TABCLC 1 17 2 TABCLN 20 CUST CLASS NAMES. 00130E TABTAX 1 5 1 TABTAN 20 TAX CODES. 00140E TABTER 1 5 3 TABTN 20 TERRITORY NAMES 00150E NUL 1 132 1 NULL CHAR 00160E A20 20 20 1 A INPUT DATA ARRAY 00170E DUN 2 2 1 A EDIT CMPLT FLAG 00180E MES 1 1 30 00190E CMA 7 35 00200E CMB 10 9 2 00210E CMS 10 9 2 00220E CMAR 4 9 2 00230E CMD 5 7 0 00240E CMM 3 3 00250E CMC 3 2 0 ÐÐ00260E CBA 7 35 BILL-TO ADDRESS 00270E BIT 33 1 SCREEN CONTR. CHAR 00280I******************************************************************** 00290IBITTAB BT 00300I 1 33 BIT 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I********************************************************************* 00360ICMMAST CM 00370I* CUSTOMER MASTER. 00380I* CUSTOMER NO. 5N 00390I 1 50CMCUST 00400I* SORT (ALT) KEY 20A 00410I 6 25 CMSORT 00420I* ADDRESS 35A X 7 00430I 26 270 CMA 00440I* STATE CODE 2A 00450I 271 272 CMSTCD 00460I* ZIP CODE 9P 00470I P 273 2770CMZIP 00480I* PHONE NO. 15A 00490I 278 292 CMPHON 00500I* CONTACT NAME 35A ÐÐ00510I 293 327 CMCONT 00520I* REMARKS 35A 00530I 328 362 CMREM 00540I* CUSTOMER CLASS 2A 00550I 363 364 CMCLAS 00560I* TERRITORY CODE 3A 00570I 365 367 CMTER 00580I* CREDIT LIMIT 7P 00590I P 368 3710CMCRLM 00600I* PAYMENT TERMS 8A 00610I 372 379 CMTERM 00620I* NUMBER OF INVOICE COPIES 1N 00630I 380 380 CMINV 00640I* SHIPPING METHOD 20A 00650I 381 400 CMSHIP 00660I* CURRENT BACKLOG 9.2P X 10 00670I P 401 450 CMB 00680I* LAST 12-MOS SHIPMENTS 9.2P X 10 00690I P 451 500 CMS 00700I* CURRENT RECEIVABLES 9.2P X 4 00710I P 501 520 CMAR 00720I* TAX CODE 1A 00730I 521 521 CMTAX 00740I* STD DISCOUNT 3.2P 00750I P 522 5232CMDISC ÐÐ00760I* EXPORT CODE 1A 00770I 524 524 CMEXPT 00780I* DATE HISTORY 7P X 5 00790I* 1 = DATE INPUT 00800I* 2 = DATE LAST ORDER 00810I* 3 = DATE LAST SHIPMENT 00820I* 4 = NOT USED 00830I* 5 = NOT USED 00840I P 525 544 CMD 00850I* GEOGRAPHIC CODE 5A 00860I 545 549 CMGEO 00870I* HOLD CODE 1A 00880I 550 550 CMHOLD 00890I* MAILER CODES. 00900I* MAILER CODES 3 X 3A 00910I 551 559 CMM 00920I* NUMB OF COPIES 3 X 2N 00930I 560 565 CMC 00940I* POINTERS. 00950I* CREDIT CHANGES 5P 00960I P 575 5750CMFCC 00970I* RECORD STATUS 1A 00980I 576 576 CMSTAT 00990I******************************************************************** 01000ICMBTAFILCB ÐÐ01010I* CUSTOMER BILL-TO ADDRESS FILE. 01020I* CUST # 5N 01030I 1 50CBCUST 01040I* ADDRESS 35A X 7 01050I 6 250 CBA 01060I* STATE CODE 2A 01070I 251 252 CBSTCD 01080I* ZIP CODE 9P 01090I P 253 2570CBZIP 01100I* CONTACT 35A 01110I 258 292 CBCONT 01120I* TELEPHONE 15A 01130I 293 307 CBPHON 01140I* REMARKS 35A 01150I 308 342 CBREM 01160I* RECORD STATUS 1A 01170I 352 352 CBSTAT 01180C******************************************************************** 01190C* INITIALIZE 01200C EXSR SR101 1-TIME INIT 01210C EXSR SR70 CLEAR SCREEN. 01220C*------------------------------------------------------------------ 01230C START TAG 01240C* SET-UP 1ST FIELD NO. 01250C SETOF 96 ÐÐ01260C Z-ADD1 F 30 FIELD # 01270C GOTO READ 01280C*------------------------------------------------------------------ 01290C NEXT TAG 01300C* SET-UP NEXT FIELD NO. 01310C 1 ADD F F FIELD # 01320C*----------------------------------------------------------------- 01330C READ TAG 01340C* READ DATA FROM TERMINAL. 01350C EXSR SR102 VALIDATE FIELD # 01360C 55 GOTO UPDATE DONE 01370C EXSR SR201 IDENTIFY-F 01380C SETON 69 01390C EXSR SR71 PROMPT 01400C SETOF 69 01410C EXSR SR75 READ TERMINAL 01420C 98 GOTO GOODBY GOODBY 01430C 94 GOTO MENU MENU REQUEST 01440C N77 EXSR SR104 EDIT INPUT FIELD 01450C 93 GOTO NEWITM NEW ITEM 01460C 96 GOTO ERROR ERROR 01470C N77 GOTO NEXT NO DATA INPUT 01480C*------------------------------------------------------------------ 01490C PROCES TAG 01500C* PROCESS INPUT DATA ÐÐ01510C EXSR SR103 MOVE DATA 01520C N96 EXSR SR104 EDIT DATA 01530C 96 GOTO ERROR ERROR 01540C GOTO NEXT 01550C*------------------------------------------------------------------ 01560C UPDATE TAG 01570C* UPDATE DATA BASE. 01580C EXSR SR105 FINAL EDIT 01590C 96 GOTO ERROR ERROR 01600C EXSR SR106 UPDATE 01610C 96 GOTO ERROR ERROR 01620C 94 GOTO MENU RET TO MENU. 01630C 98 GOTO GOODBY SIGN-OFF. 01640C GOTO START 01650C*------------------------------------------------------------------- 01660C JUMP TAG 01670C* SET-UP JUMP TO REQUESTED FIELD 01680C 1 ADD W W 30 01690C W COMP 20 54 01700C 54 Z-ADD318 M 50 96 FLAG ERROR 01710C 54 GOTO ERROR BAD ESC 01720C MOVE '000' W3A 3 01730C MOVEAA20,W W3A 01740C Z-ADD3 W2N 20 01750C EXIT SUBRAJ R. JUSTIFY ÐÐ01760C RLABL W2N 01770C RLABL W3A 01780C MOVE W3A F NEW FIELD # 01790C GOTO READ 01800C*-------------------------------------------------------------------- 01810C ERROR TAG 01820C EXSR SR102 VALIDATE FIELD # 01830C EXSR SR89 GET MSG 01840C EXSR SR73 PUT MSG 01850C GOTO READ 01860C*------------------------------------------------------------------ 01870C NEWITM TAG 01880C* SET-UP LINK FOR NEW ITEM 01890C GOTO START 01900C*------------------------------------------------------------------- 01910C MENU TAG 01920C* SET-UP LINK TO MENU 01930C MOVEL'Q070DP' PROG 8 01940C GOTO END 01950C*-------------------------------------------------------------------- 01960C GOODBY TAG 01970C* LINK TO SIGN-OFF 01980C MOVEL'GOODBY' PROG 01990C GOTO END 02000C*------------------------------------------------------------------- ÐÐ02010C END TAG 02020C PROG COMP BLK8 54 02030C N54 MOVEL'Q070DP' PROG 8 02040C EXITFCHAIN LINK TO NEXT PROG 02050C RLABL PROG 02060C******************************************************************** 02070CSR SR70 BEGSR 02080C* CLEAR CRT. 02090CSR EXITFQTOPF CLEAR PAGE 4 02100CSR ENDSR 02110C******************************************************************** 02120CSR SR71 BEGSR 02130C* PUT PROMPT. 02140CSR SETON 71 02150CSR EXCPT 02160CSR SETOF 71 02170CSR ENDSR 02180C********************************************************************* 02190CSR SR72 BEGSR 02200C* PUT DATA TO TERMINAL 02210CSR SETON 72 02220CSR EXCPT PUT DATA 02230CSR SETOF 72 02240CSR ENDSR 02250C*********************************************************************** ÐÐ02260CSR SR73 BEGSR 02270C* PUT ERROR MESSAGE TO TERMINAL 02280CSR SETON 73 02290CSR EXCPT PUT MSG 02300CSR SETOF 73 02310CSR Z-ADDM LSTERR 50 02320CSR ENDSR 02330C******************************************************************* 02340CSR SR75 BEGSR 02350C* READ FROM TERMINAL 02360CSR SETOF 779096 02370CSR SETOF 939291 02380CSR SETOF 8988 02390CSR MOVE BIT,11 BUFLGT BUF LENGTH 02400CSR EXITFQBELL RING BELL 02410CSR MOVE BLK20 W20A 20 BUFFER 02420CSR EXITFQWREED READ TERM 02430CSR RLABL W20A 02440CSR RLABL BUFLGT 02450CSR MOVEAW20A A20 02460CSR MOVE BLK20 W20A 02470CSR Z-ADD1 W 30 02480CSR '\' LOKUPA20,W 90 FLAG ESC 02490CSRN90 GOTO T75B NOT ESC 02500CSR 1 ADD W W ÐÐ02510CSR W COMP 20 54 02520CSR 54 GOTO T75A BAD ESC 02530CSR A20,W COMP 'G' 98 GOODBY 02540CSR A20,W COMP 'E' 94 MENU 02550CSR A20,W COMP 'N' 93 NEW ITEM 02560CSR 98 02570COR 94 02580COR 93 GOTO END75 02590C*------------------------------------------------------------------ 02600CSR T75A TAG 02610C* FLAG BAD ESC INPUT 02620CSR Z-ADD318 M 96 FLAG ERROR 02630CSR GOTO END75 02640C*-------------------------------------------------------------------- 02650CSR T75B TAG 02660C* MOVE DATA 02670CSR Z-ADD1 W 02680CSR ' ' LOKUPA20,W 77 02690CSR 77 MOVEAA20,W W20A INPUT DATA 02700C*-------------------------------------------------------------------- 02710CSR END75 TAG 02720C* INIT PREV ERROR MSG. 02730CSR LSTERR COMP 0 54 02740CSR 54 MOVE BLK35 MGTEXT 02750CSR 54 EXSR SR73 BLANK MESSAGE ÐÐ02760CSR Z-ADD0 LSTERR 50 02770CSR ENDSR 02780C********************************************************************** 02790CSR SR89 BEGSR 02800C* GET MESSAGE MASTER 02810CSR M CHAINMGFILE 54 02820CSR 54 MOVE BLK35 MGTEXT 02830CSR 54 MOVELM MGTEXT 02840CSR 54 MOVE MES,1 MGTEXT 02850CSR ENDSR 02860C*********************************************************************** 02870CSR SR101 BEGSR 02880C* 1-TIME INITIALIZE 02890CSR MOVE BIT,1 NUL 02900CSR MOVELBIT,1 BUFLGT 2 02910CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02920C* DEFINE WORK FIELDS,ETC. 02930CSR MOVE ' ' BLK35 35 02940CSR MOVE ' ' BLK8 8 02950CSR MOVE ' ' BLK5 5 02960CSR MOVE ' ' BLK20 20 02970C* 02980C* 02990CSR ENDSR 03000C********************************************************************** ÐÐ03010CSR SR102 BEGSR 03020C* VALIDATE FIELD NO. 03030CSR F COMP 0 54 03040CSRN54 Z-ADD1 F 03050CSR F COMP FLIMIT 55 03060CSR 55 Z-ADD1 F 03070CSR ENDSR 03080C******************************************************************** 03090CSR SR103 BEGSR 03100C* MOVE INPUT DATA 03110CSR EXSR SR201 IDENTIFY-F 03120CSR MOVELW20A TCUST 5 CUST # 03130CSR Z-ADD5 W2N 20 03140CSR EXIT SUBRAJ RIGHT JUSTIFY 03150CSR RLABL W2N 03160CSR RLABL TCUST 03170CSR MOVE ' ' DUN,F EDIT FLAG 03180CSR ENDSR 03190C******************************************************************** 03200CSR SR104 BEGSR 03210C* EDIT INPUT DATA 03220CSR 96 MOVE ' ' DUN,F EDIT FLAG 03230CSRN96 MOVE 'X' DUN,F 03240CSR ENDSR 03250C*********************************************************************** ÐÐ03260CSR SR105 BEGSR 03270C* FINAL EDIT 03280CSR SETON 79 FINAL EDIT FLAG 03290CSR Z-ADD1 F 96 03300C*-------------------------------------------------------------------- 03310CSR T105A TAG 03320CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03330CSRN54 GOTO END105 03340CSR EXSR SR201 IDENTIFY-F 03350CSR EXSR SR104 EDIT 03360CSRN96 GOTO T105A 03370C*-------------------------------------------------------------------- 03380CSR END105 TAG 03390CSR SETOF 79 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR106 BEGSR 03430C* DISPLAY CMMAST RECORD. 03440CSR TCUST SETLLCMMAST 03450CSR Z-ADD0 COUNT 30 03460CSR SETOF 74 03470C*------------------------------------------------------------------- 03480CSR T106A TAG 03490CSR SETOF 54 03500CSR READ CMMAST 54 ÐÐ03510CSR 54 GOTO T106B END OF FILE. 03520CSR CMSTAT COMP 'D' 54 03530CSR 54 GOTO T106A 03540CSR CMCUST CHAINCMBTAFIL 54 GET BILL TO FILE 03550CSR EXSR SR205 TABLE LOKUPS. 03560CSR SETON 72 03570CSR EXCPT DISPLAY CMMAST 03580CSR SETOF 72 03590CSR SETON 74 03600CSR 1 ADD COUNT COUNT 03610CSR COUNT COMP 2 54 54 03620CSRN54 GOTO T106A 03630CSR Z-ADD34 M 03640CSR GOTO T106C 03650C*------------------------------------------------------------------- 03660CSR T106B TAG 03670C* DISPLAY END PAGE/FILE MSG. 03680CSR Z-ADD317 M 03690C*----------------------------------------------------------------- 03700CSR T106C TAG 03710CSR EXSR SR89 GET END MSG. 03720CSR M COMP 317 54 03730CSR EXSR SR73 END PAGE MSG. 03740CSR 54 GOTO END106 END OF FILE 03750CSR EXSR SR75 ÐÐ03760CSR 94 EXIT. 03770COR 98 GOODBY. 03780COR 93 GOTO END106 NEW ITEM. 03790CSR Z-ADD0 COUNT 74 03800CSR GOTO T106A 03810CSR END106 ENDSR 03820C************************************************************************ 03830CSR SR201 BEGSR 03840C* IDENTIFY FIELD NO. 03850CSR F COMP 1 01 03860CSR ENDSR 03870C******************************************************************** 03880CSR SR205 BEGSR 03890C* GET CODE DESCRIPTIONS. 03900CSR CMSTCD LOKUPTABSTC TABSCN 54 03910CSR 54 MOVE TABSCN STCNAM 20 03920CSRN54 MOVE BLK20 STCNAM 03930CSR CMCLAS LOKUPTABCLC TABCLN 54 03940CSR 54 MOVE TABCLN CLSNAM 20 03950CSRN54 MOVE BLK20 CLSNAM 03960CSR CMTAX LOKUPTABTAX TABTAN 54 03970CSR 54 MOVE TABTAN TAXNAM 20 03980CSRN54 MOVE BLK20 TAXNAM 03990CSR CMTER LOKUPTABTER TABTN 54 04000CSR 54 MOVE TABTN TERNAM 20 ÐÐ04010CSRN54 MOVE BLK20 TERNAM 04020CSR CBSTCD LOKUPTABSTC TABSCN 54 04030CSR 54 MOVELTABSCN BSTNAM 20 04040CSRN54 MOVE BLK20 BSTNAM 04050CSR ENDSR 04060O******************************************************************** 04070OTERM132 E 71 04080O* REQUEST SORT KEY 04090O NUL 132 04100O 19 'ENTER CUSTOMER #: ' 04110O*------------------------------------------------------------------- 04120O E 72N74 04130O 31 'S O L D T O' 04140O 72 'B I L L T O' 04150O 107 'C O D E S' 04160O*------------------------------------------------------------------- 04170O E 72 04180O*------------------------------------------------------------------- 04190O E 72 04200O*------------------------------------------------------------------- 04210O E 72 04220O 9 'NUMB/SORT' 04230O CMCUSTZ 17 04240O CMSORT 39 04250O*------------------------------------------------------------------- ÐÐ04260O E 72 04270O 10 'COMP NAME:' 04280O CMA,1 B 47 04290O CBA,1 B 85 04300O 99 'CUST-CLASS' 04310O 103 ':' 04320O CMCLAS 107 04330O CLSNAM 130 04340O*------------------------------------------------------------------- 04350O E 72 04360O 10 'COMP NAME:' 04370O CMA,2 B 47 04380O CBA,2 B 85 04390O 98 'TERRITORY' 04400O 103 ':' 04410O CMTER 108 04420O TERNAM 130 04430O*------------------------------------------------------------------- 04440O E 72 04450O 10 'ADDRESS-1:' 04460O CMA,3 B 47 04470O CBA,3 B 85 04480O 97 'SHIP-VIA' 04490O 103 ':' 04500O CMSHIP 125 ÐÐ04510O*------------------------------------------------------------------- 04520O E 72 04530O 10 'ADDRESS-2:' 04540O CMA,4 B 47 04550O CBA,4 B 85 04560O 97 'TAX-CODE' 04570O 103 ':' 04580O CMTAX 106 04590O TAXNAM 130 04600O*------------------------------------------------------------------- 04610O E 72 04620O 6 'LINE-5' 04630O 10 ':' 04640O CMA,5 B 47 04650O CBA,5 B 85 04660O 95 'EXPORT' 04670O 103 ':' 04680O CMEXPT 106 04690O*------------------------------------------------------------------- 04700O E 72 04710O 4 'CITY' 04720O 10 ':' 04730O CMA,6 B 47 04740O CBA,6 B 85 04750O 97 'GEO-CODE' ÐÐ04760O 103 ':' 04770O CMGEO 110 04780O*------------------------------------------------------------------- 04790O E 72 04800O 10 'FRGN CTRY:' 04810O CMA,7 B 47 04820O CBA,7 B 85 04830O 97 'DISCOUNT' 04840O 103 ':' 04850O CMDISCZ 109 04860O*------------------------------------------------------------------- 04870O E 72 04880O 10 'STATE/ZIP:' 04890O CMSTCD 14 04900O STCNAM 36 04910O CMZIP Z 47 04920O CBSTCD B 52 04930O BSTNAM B 74 04940O CBZIP ZB 85 04950O 94 'TERMS' 04960O 103 ':' 04970O CMTERM 113 04980O*------------------------------------------------------------------- 04990O E 72 05000O 10 'TELEPHONE:' ÐÐ05010O CMPHON 27 05020O CBPHON B 65 05030O 103 'CREDIT-LIMIT :' 05040O CMCRLM2 114 05050O*------------------------------------------------------------------- 05060O E 72 05070O 10 'REMARKS :' 05080O CMREM 47 05090O CBREM B 85 05100O 98 'HOLD-CODE' 05110O 103 ':' 05120O CMHOLD 106 05130O*------------------------------------------------------------------- 05140O E 72 05150O 103 'MAILER-CODES :' 05160O CMM,1 108 05170O CMM,2 116 05180O CMM,3 124 05190O*------------------------------------------------------------------- 05200O E 72 05210O 103 'NUMB-COPIES :' 05220O CMC,1 Z 108 05230O CMC,2 Z 116 05240O CMC,3 Z 124 05250O*------------------------------------------------------------------- ÐÐ05260O E 73 05270O 96 5 '*****' 05280O MGTEXT 43 05290O 96 50 '*****' 05300O 96 BIT,8 132 ** TABSTC/TABSCN - STATE CODES 005310 005320ALALABAMA 005330AKALASKA 005340AZARIZONA 005350ARARKANSAS 005360ASAMERICAN SAMOA 005370CACALIFORNIA 005380CZCANAL ZONE 005390COCOLORADO 005400CTCONNECTICUT 005410DEDELAWARE 005420DCDISTRICT OF COLUMBIA 005430FLFLORIDA 005440GAGEORGIA 005450GUGUAM 005460HIHAWAII 005470IDIDAHO 005480ILILLINOIS 005490ININDIANA 005500ÐÐIAIOWA 005510KSKANSAS 005520KYKENTUCKY 005530LALOUISIANA 005540MEMAINE 005550MDMARYLAND 005560MAMASSACHUSETTS 005570MIMICHIGAN 005580MNMINNESOTA 005590MSMISSISSIPPI 005600MOMISSOURI 005610MTMONTANA 005620NENEBRASKA 005630NVNEVADA 005640NHNEW HAMPSHIRE 005650NJNEW JERSEY 005660NMNEW MEXICO 005670NYNEW YORK 005680NCNORTH CAROLINA 005690NDNORTH DAKOTA 005700OHOHIO 005710OKOKLAHOMA 005720OROREGON 005730PAPENNSYLVANIA 005740PRPUERTO RICO 005750ÐÐRIRHODE ISLAND 005760SCSOUTH CAROLINA 005770SDSOUTH DAKOTA 005780TNTENNESSEE 005790TTTRUST TERRITORIES 005800TXTEXAS 005810UTUTAH 005820VTVERMONT 005830VAVIRGINIA 005840VIVIRGIN ISLANDS 005850WAWASHINGTON 005860WVWEST VIRGINIA 005870WIWISCONSIN 005880WYWYOMING 005890** TABCLC/TABCLN - CUST CLASS NAMES 00590010COMMERCIAL END USER 00591015U.S. GOVERNMENT 00592020GENERAL O.E.M. 00593021BROADCAST O.E.M. 0594030GENERAL LINE DEALER 00595031BROADCAST DEALER 00596033BROADCAST DLR,BRANCH 00597034GEN LINE DLR,BRANCH 00598035DESIGNATED PROD DLR 00599050SPECIAL 006000ÐÐ60AVIONICS END USER 00601065AVIONICS OEM 00602070AVIONICS DISTRIB 00603075AVIONICS REPAIR SHOP 00604090AVIONICS SPECIAL 00605098TO BE DELETED 00606099DISCONTINUED DLR 006070** TABTAX/TABTAN - TAX CODE RATES 0060801CA NON-TAXABLE,CARD 0060902CA NON-TAXABLE,NO CD 0061003NON-TAXABLE,US GOVT 0061104NON-TAXABLE,OTHER 0061205TAXABLE 006130** TABTER/TABTN - TERRITORY NAMES 006140 006150 006160 006170 006180 006190** NUL ARRAY 006200 006210** A20 ARRAY 006220 006230** DUN ARRAY 006240 006250ÐÐ** MES ARRAY 006260---MESSAGE NOT ON FILE--- 006270/* 006280_‚ ÐÐ_‚_‚MES ARRAY 006260---MESSAGE NOT ON FILE--- 006270/* 006280_‚ ÐÈ(^,& ^’XCONTU P ´999999120282(èÈÐ00010H CONTU 00020F* DISPLAY PREV SELECTED MENU. (XCONTU) 00030F* REVISED 7/21/82 4:40 PM. DG-132-1 OK 00040F* 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070FEMPLFILEID F 64L14AI 1 DISK 00080FTERM52 O F 52 5 00090E******************************************************************** 00100E NUL 1 50 1 00110E A6 1 6 1 00120E PRG 1 84 6 00130E SEL 1 84 3 0 00140E A4 1 4 1 00150E BIT 33 1 00160E PAR 25 1 00170E TST 25 1 00180E CALL 7 6 00190I******************************************************************** 00200IBITPAR BT 00210I 1 33 BIT 00220I 34 58 PAR 00230I 59 83 TST 00240I******************************************************************** 00250ICRTFILE CR ÐÐ00260I 1 5 CREMPL 00270I 6 13 CRUSER 00280I 14 180CRDEPT 00290I 19 26 CRJOB 00300I 27 27 CRSHUT 00310I 28 330CRTIME 00320I 34 370CRDATE 00330I 38 79 CALL 00340I******************************************************************** 00350IEMPLFILEEE 00360I* RECORD CODE 2A 00370I* J = EMPLOYEE/JOB CROSS-REF 00380I 1 1 EREC 00390I* EMPLOYEE # 5N 00400I 2 60EJEMPL 00410I* SEQUENCE # 3N 00420I 7 90EJSEQ 00430I* DESCRIPTION 35A 00440I 15 49 EJDESC 00450I* JOB CODE 6A 00460I 50 55 EJJOB 00470I* RECORD STATUS 1A 00480I 64 64 EJSTAT 00490I*------------------------------------------------------------------- 00500I GG 10 ÐÐ00510I* GARBAGE RECORD. 00520I 1 1 EREC 00530C******************************************************************** 00540C* INITIALIZE - CLEAR SCREEN. 00550C EXSR SR101 INIT. 00560C 86 SHUT DOWN 00570COR H9 GOTO ENDJOB PROG ERROR. 00580C CREMPL COMP BLK6 54 00590C N54 MOVE 'HELLO 'PROG NO ACTIVE USER. 00600C N54 GOTO ENDJOB 00610C* SET-UP 1ST MENU READ. 00620C MOVEL'J' W6A 6 00630C MOVE CREMPL W6A 00640C MOVELW6A W14A 14 00650C W14A SETLLEMPLFILE 00660C*------------------------------------------------------------------- 00670C MENU TAG 00680C* DISPLAY MENU. 00690C SETOF 78 00700C READ EMPLFILE 78 00710C 78 GOTO SELECT 00720C EREC COMP 'J' 54 00730C N54 GOTO SELECT NOT JOB REC. 00740C EJSTAT COMP 'D' 54 00750C 54 GOTO MENU DELETED. ÐÐ00760C MOVE CREMPL W5N 50 00770C EJEMPL COMP W5N 54 00780C N54 GOTO SELECT NOT THIS EMPLY. 00790C 1 ADD P P 30 00800C P COMP 150 54 00810C 54 GOTO SELECT 00820C P COMP 1 55 00830C P COMP 23 56 00840C P COMP 46 57 00850C 56 SETOF 55 00860C 57 SETOF 5655 00870C 1 ADD P LN 30 00880C 56 LN SUB 23 LN 00890C 57 LN SUB 46 LN 00900C 55 Z-ADD1 CN 30 00910C 56 Z-ADD47 CN 00920C 57 Z-ADD93 CN 00930C MOVE LN LA 3 00940C MOVE CN CA 3 00950C MOVE EJJOB PRG,P 00960C MOVE BLK8 JOB 8 00970C MOVELEJJOB JOB 00980C Z-ADDEJSEQ SEL,P 00990C Z-ADDP E 30 01000C P COMP 23 54 ÐÐ01010C N54 P COMP 46 54 01020C N54 P COMP 69 54 01030C SETON 71 01040C EXCPT PUT MENU. 01050C SETOF 71 01060C P COMP 69 54 01070C N54 GOTO MENU 01080C*------------------------------------------------------------------- 01090C SELECT TAG 01100C* REQUEST SELECTION. 01110C SETON 72 01120C EXCPT RQST SELECTION. 01130C SETOF 72 01140C MOVE BIT,3 A6,2 01150C MOVEAA6 W6A 6 01160C MOVE ' ' W4A 4 01170C EXITFXCREAD READ SELECTION. 01180C RLABL W4A BUFFER. 01190C RLABL W6A BUF LGTH. 01200C MOVEAW4A A4 01210C '\' LOKUPA4 90 01220C 90 'E' LOKUPA4 94 EXIT 01230C 90 'G' LOKUPA4 98 GOODBY 01240C 90 MOVE BLK8 PROG 8 PROG NAME 01250C 98 MOVEL'GOODBY' PROG GOODBY ÐÐ01260C 90N98 SETON 94 01270C 94 MOVEL'HELLO ' PROG RET TO SIGN ON 01280C 90 GOTO ENDJOB 01290C Z-ADD4 W2N 20 01300C EXIT SUBRAJ R.J. 01310C RLABL W2N 01320C RLABL W4A 01330C MOVE W4A SELECT 30 01340C SELECT COMP 0 54 01350C 54 SELECT COMP E 5454 01360C N54 GOTO SELECT INVALID. 01370C Z-ADDSELECT P 01380C PRG,P COMP BLK6 54 01390C N54 GOTO SELECT 01400C SETON LR 01410C MOVE BLK8 PROG 01420C MOVELPRG,P PROG 8 01430C*------------------------------------------------------------------- 01440C ENDJOB TAG 01450C # CHAINCRTFILE H9 01460C N86 CRSHUT COMP ' ' 86 FLAG SHUTDOWN 01470C TIME CRTIME TIME IN 01480C 86 MOVE 'SHUTDOWN'PROG 01490C MOVE PROG JOB 01500C MOVELUDATE CRDATE ÐÐ01510C MOVE BLK6 CALL 01520C MOVE 'CONTU ' CALL,7 01530C SETON 85 01540C EXCPT UPDATE CRTFILE 01550C SETOF 85 01560C N50 EXITFQTOPF CLEAR SCREEN 01570C 50 EXITFZESCH CLEAR SCREEN 01580CLRNH9 EXITFCHAIN LINK PROG 01590CLR RLABL PROG 01600C******************************************************************** 01610CSR SR70 BEGSR 01620C* CLEAR SCREEN. 01630CSRN50 EXITFQTOPF CLEAR SCREEN 01640CSR 50 EXITFZESCH CLEAR SCREEN 01650CSR SETON 70 01660CSR EXCPT CLEAR CRT. 01670CSR SETOF 70 01680CSR ENDSR 01690C******************************************************************** 01700CSR SR80 BEGSR 01710C* GET CRTFILE. 01720CSR MOVE BLK8 W8A 8 01730CSR Z-ADD0 W2N 20 01740CSR Z-ADD0 W1N 10 01750CSR MOVE ' ' W2A 2 ÐÐ01760CSR EXITFZGMINX 01770CSR RLABL W2A 01780CSR MOVE W2A # 20 01790CSR # COMP 0 54 01800CSRN54 Z-ADD25 # MASTER TERMINAL 01810CSR PAR,# COMP '1' 50 01820CSR TST,# COMP 'S' 87 01830CSR 87 SETON 86 01840CSR 87 GOTO ENDJOB 01850CSR 50 EXITFZISTAT CLEAR STATUS LINE 01860CSR 50 EXITFZESCH CLEAR SCREEN 01870CSR # CHAINCRTFILE H9 01880CSR H9 GOTO END80 ERROR 01890CSR Z-ADDUDATE CRDATE 01900CSR MOVE BLK6 CALL 01910CSR CRSHUT COMP ' ' 86 FLAG SHUTDOWN 01920CSR MOVE BLK8 PROG 01930CSR MOVEL'CONTU' PROG 01940CSR MOVE PROG JOB 01950CSR TIME CRTIME TIME IN 01960CSR MOVELUDATE CRDATE 01970CSR SETON 84 01980CSR EXCPT UPDATE CRTFILE 01990CSR SETOF 84 02000CSR END80 ENDSR ÐÐ02010C******************************************************************** 02020CSR SR101 BEGSR 02030C* INITIALIZE. 02040CSR MOVE BIT,1 NUL 02050CSR MOVE BIT,1 A6 02060CSR EXSR SR80 GET CRTFILE 02070CSR EXSR SR70 CLEAR CRT. 02080CSR MOVE ' ' BLK6 6 02090CSR MOVE ' ' BLK8 8 02100CSR MOVE ' ' BLK33 33 02110CSR ENDSR 02120O******************************************************************** 02130OCRTFILE E 84 02140O OR 85 02150O 86 BLK33 33 02160O 86N87 27 'X' 02170O JOB 26 02180O CRTIME 33 02190O CRDATE 37 02200O CALL 79 02210O 79 'CONTU ' 02220O******************************************************************** 02230OTERM52 E 70 02240O* CLEAR CRT. 02250O BIT,28 20 ÐÐ02260O N50 21 '8' 02270O N50 27 '001060' 02280O 50 21 '[' 02290O 50 24 '001' 02300O 50 BIT,28 25 02310O 50 29 '060' 02320O 50 26 ']' 02330O 38 'YOUR MENU' 02340O BIT,11 39 02350O BIT,11 40 02360O*------------------------------------------------------------------- 02370O E 71 02380O* PUT MENU. 02390O NUL 50 02400O BIT,28 1 02410O N50 2 '8' 02420O N50 LA 5 02430O N50 CA 8 02440O 50 2 '[' 02450O 50 LA 5 02460O 50 BIT,28 6 02470O 50 CA 10 02480O 50 7 ']' 02490O P Z 13 02500O 15 ' ' ÐÐ02510O EJDESC 50 02520O 54 BIT,28 51 02530O 54 52 'K' 02540O*------------------------------------------------------------------- 02550O E 72 02560O* REQUEST SELECTION. 02570O NUL 50 02580O BIT,28 1 02590O N50 2 '8' 02600O N50 8 '001001' 02610O 50 2 '[' 02620O 50 5 '001' 02630O 50 BIT,28 6 02640O 50 10 '001' 02650O 50 7 ']' 02660O 27 'ENTER SELECTION #' 02670O 29 ' ' 02680O BIT,8 49 02690O*------------------------------------------------------------------- 02700O E 85 86 02710O OR 84 86 02720O 23 'SYSTEM IS NOT AVAILABLE' 02730O 36 'AT THIS TIME' ** NUL ARRAY 002740 002750ÐÐ** A6 ARRAY 002760 002770** PRG ARRAY 002780 002790** SEL ARRAY 002800 002810** A4 ARRAY 002820 002830/* 002840_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( ,¹  NX011GL P120282120282(èÈÐ00010H Q011GL00020F* GENERAL LEDGER REPORT WRITER. (X011GL) 00030F* REVISED 3-10-80 10:40 AM. 00040F* 00050FBITHEX IP F 256 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FGLRWSPECID F 68L 9AI 3 DISK 00090FGLRWMASTIC F 128R 5AI 3 DISK 00100FGLMAST IC F 165R11AI 3 DISK 00110FCAMAST IC F 40R22AI 3 DISK 00120FTERM132 O F 132 5 00130F**************************************************************** 00140E NUL 1 132 1 NULL CHAR 00150E A8 8 8 1 A INPUT DATA ARRAY 00160E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00170E DUN 1 2 1 A EDIT CMPLT FLAG 00180E MES 1 1 30 00190E* 00200E* 00210E* 00220E* 00230E BIT 256 1 SCREEN CONTR. CHAR 00240E CALL 5 6 CALL STACK 00250E GLA 1 12 11 2 ÐÐ00260E* 00270I******************************************************************* 00280IBITHEX BT 00290I 1 256 BIT 00300I******************************************************************* 00310IMGFILE MG 00320I* MESSAGE FILE. 00330I 1 35 MGTEXT 00340I****************************************************************** 00350ICRTFILE CR 00360I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00370I* STD AREA - SAME FOR ALL PROGRAMS. 00380I* EMPLOYEE # 5N 00390I 1 50CREMPL 00400I* USER CODE 8A 00410I 6 13 CRUSER 00420I* DEPT # 5N 00430I 14 180CRDEPT 00440I* JOB NAME 8A (JOB LOADED BY MENU) 00450I 19 26 CRJOB 00460I* SHUTDOWN FLAG 1A 00470I* BLANK = NO SHUTDOWN 00480I 27 27 CRSHUT 00490I* TIME STARTED 6N 00500I 28 330CRTIME ÐÐ00510I* DATE STARTED 4N 00520I 34 370CRDATE 00530I* CALL STACK 5 X 6A 00540I 38 67 CALL 00550I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00560I 68 73 CRRET 00570I* MENU NAME 6A 00580I 74 79 CRMENU 00590I****************************************************************** 00600IGLRWSPECGW 01 10 CS 00610I* GEN LEDGER REPORT WRITER SPEC - SUB-TOTAL RECORD. 00620I OR 02 10 CA 00630I* ACCOUNT RECORD. 00640I* KEY AREA. 00650I* REPORT # 5N 00660I 3 70GWREP 00670I* SEQ # 4N 00680I 8 110GWSEQ 00690I* TYPE 1A (RECORD ID) (S) 00700I 12 12 GWTYPE 00710I* ACCOUNT # 11A 00720I 13 23 GWACNT 00730I* SUB-TOTAL # 2N (1-10) 00740I 24 250GWSTOT 00750I* TITLE 40A ÐÐ00760I 26 65 GWTITL 00770I* LEVEL 2N 00780I 66 670GWLEV 00790I* RECORD STATUS 1A 00800I 68 68 GWSTAT 00810I******************************************************************** 00820IGLRWMASTGM 00830I* GEN LEDGER REPORT WRITER SPEC MASTER. 00840I* KEY AREA. 00850I* REPORT NO. 5N 00860I 3 70GMNO 00870I* REPORT TITLE 60A 00880I 8 67 GMTITL 00890I* REQUESTED BY 35A 00900I 68 92 GMRQBY 00910I* DATE REQUESTED 6N 00920I 93 980GMRQDT 00930I* DATE LAST RUN 6N 00940I 99 1040GMDLR 00950I* FILLER 00960I* RECORD STATUS 1A 00970I 128 128 GMSTAT 00980I****************************************************************** 00990IGLMAST GL 01000I* ACCOUNT MASTER. ÐÐ01010I* KEY AREA. 01020I 3 13 GLKEY 01030I* ACCOUNT PREFIX 2A 01040I 3 4 GLPRFX 01050I* ACCOUNT PRIME 6N 01060I 5 100GLPRIM 01070I* ACCOUNT DASH 3N 01080I 11 130GLDASH 01090I* ACCOUNT GROUP 4A 01100I 14 17 GLGRUP 01110I* ACCOUNT DESCRIPTION 40A 01120I 18 57 GLDESC 01130I* BALANCE FORWARD AMOUNT 11.2P 01140I P 58 632GLBALF 01150I* ACTUAL $ 11.2P X 12 01160I P 64 135 GLA 01170I* CURRENT MONTH-PLUSES 11.2P 01180I P 136 1412GLCMP 01190I* CURRENT MONTH-MINUS 11.2P 01200I P 142 1472GLCMM 01210I* SOURCE CODE 1A 01220I* S = SUB-ACCOUNT ONLY, 01230I* MAY NOT BE PARENT 01240I 148 148 GLSC 01250I* BALANCE FORWARD CODE 2A ÐÐ01260I* 1ST COL 01270I* 1 = ZERO BAL AT START NEW YR 01280I* 2 = CARRY PREV YR FRWD 01290I* 2ND COL 01300I* A = ZERO BAL AT START NEW MO 01310I* B = CARRY PREV MO FRWD 01320I 149 150 GLBFC 01330I* NUMB OF SUB-ACCOUNTS 5P 01340I P 157 1590GLNOSA 01350I* LOW LEVEL CODE 3N 01360I 160 1620GLLL 01370I* FILLER 01380I* RECORD STATUS 1A 01390I 165 165 GLSTAT 01400I******************************************************************* 01410ICAMAST CA 01420I* CHART OF ACCOUNTS. 01430I* KEY AREA. 01440I* PARENT ACCOUNT 11A 01450I 3 13 CAPAR 01460I* SUB-ACCOUNT 11A 01470I 14 24 CASUB 01480I* OPERATOR 1A 01490I* S = SUBTRACT 01500I* A = ADD ÐÐ01510I 25 25 CAOPER 01520I* EFFECTIVITY 01530I* START DATE 6N (YMD) 01540I 26 310CASDAT 01550I* END DATE 6N (YMD) 01560I 32 370CAEDAT 01570I* FILLER 01580I* RECORD STATUS 1A 01590I 40 40 CASTAT 01600C******************************************************************** 01610C* INITIALIZE 01620C EXSR SR101 1-TIME INIT 01630C*------------------------------------------------------------------ 01640C START TAG 01650C* SET-UP 1ST FIELD NO. 01660C MOVE ' ' DUN INIT EDIT ARRAY 01670C Z-ADD1 F 30 FIELD # 01680C GOTO READ 01690C*------------------------------------------------------------------ 01700C NEXT TAG 01710C* SET-UP NEXT FIELD NO. 01720C 1 ADD F F FIELD # 01730C*----------------------------------------------------------------- 01740C READ TAG 01750C* READ DATA FROM TERMINAL. ÐÐ01760C SETOF 9096 01770C EXSR SR102 VALIDATE FIELD # 01780C 55 GOTO UPDATE DONE 01790C EXSR SR201 IDENTIFY-F 01800C SETON 69 01810C EXSR SR72 PROMPT 01820C SETOF 69 01830C EXSR SR75 READ TERMINAL 01840C 98 GOTO GOODBY GOODBY 01850C 94 GOTO MENU MENU REQUEST 01860C N77N88 EXSR SR104 EDIT INPUT FIELD 01870C 96 ERROR 01880CORN77N88 EXSR SR72 REWRITE INPUT DATA 01890C 93 GOTO NEWITM NEW ITEM 01900C 92 GOTO JUMP FIELD JUMP REQST 01910C 91 GOTO NEXT SKIP FORWARD 01920C 89 F SUB 1 F SKIP BACKWARD 01930C 89 GOTO READ " " 01940C 88 SETOF 90 SPACE FILL 01950C 88 SETON 77 " " 01960C 87 GOTO START 01970C 86 GOTO UPDATE UPDATE 01980C 85 GOTO READ REPEAT 01990C 96 GOTO ERROR ERROR 02000C N77 GOTO NEXT NO DATA INPUT ÐÐ02010C*------------------------------------------------------------------ 02020C PROCES TAG 02030C* PROCESS INPUT DATA 02040C EXSR SR103 MOVE DATA 02050C N96 EXSR SR104 EDIT DATA 02060C EXSR SR72 REWRITE DATA 02070C 96 GOTO ERROR ERROR 02080C GOTO NEXT 02090C*------------------------------------------------------------------ 02100C UPDATE TAG 02110C* UPDATE DATA BASE. 02120C EXSR SR105 FINAL EDIT 02130C 96 GOTO ERROR ERROR 02140C EXSR SR106 UPDATE 02150C 96 GOTO ERROR ERROR 02160C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 02170C EXSR SR107 SETUP LINKAGE 02180C 96 GOTO ERROR ERROR 02190C GOTO END 02200C*------------------------------------------------------------------- 02210C JUMP TAG 02220C* SET-UP JUMP TO REQUESTED FIELD 02230C 1 ADD W W 30 02240C W COMP 8 54 02250C 54 Z-ADD318 M 50 96 FLAG ERROR ÐÐ02260C 54 GOTO ERROR BAD ESC 02270C MOVE ' ' W3A 3 02280C MOVEAA8,W W3A 02290C Z-ADD3 W2N 20 02300C EXIT SUBRAJ R. JUSTIFY 02310C RLABL W2N 02320C RLABL W3A 02330C MOVE W3A F NEW FIELD # 02340C GOTO READ 02350C*-------------------------------------------------------------------- 02360C ERROR TAG 02370C EXSR SR102 VALIDATE FIELD # 02380C EXSR SR89 GET MSG 02390C EXSR SR73 PUT MSG 02400C GOTO READ 02410C*------------------------------------------------------------------ 02420C NEWITM TAG 02430C* SET-UP LINK FOR NEW ITEM 02440C MOVEL'Q011GL' PROG 8 02450C GOTO END 02460C*------------------------------------------------------------------- 02470C MENU TAG 02480C* SET-UP LINK TO MENU 02490C MOVEL'#QQ ' PROG 02500C GOTO END ÐÐ02510C*-------------------------------------------------------------------- 02520C GOODBY TAG 02530C* LINK TO SIGN-OFF 02540C MOVEL'GOODBY' PROG 02550C GOTO END 02560C*------------------------------------------------------------------- 02570C END TAG 02580C EXSR SR97 UPDATE CRTFILE 02590C EXITFCHAIN LINK TO NEXT PROG 02600C RLABL PROG 02610C********************************************************************* 02620CSR SR1 BEGSR 02630C* EDIT 02640C* 02650C* 02660C* 02670C* 02680C* 02690CSR ENDSR 02700C******************************************************************* 02710CSR SR2 BEGSR 02720C* EDIT 02730C* 02740C* 02750C* ÐÐ02760C* 02770C* 02780C* 02790C* 02800C* 02810CSR ENDSR 02820C********************************************************************* 02830CSR SR3 BEGSR 02840C* EDIT 02850C* 02860C* 02870C* 02880C* 02890C* 02900C* 02910C* 02920CSR ENDSR 02930C********************************************************************** 02940CSR SR4 BEGSR 02950C* EDIT 02960C* 02970C* 02980C** 02990C* 03000C* ÐÐ03010C* 03020C* 03030CSR ENDSR 03040C*********************************************************************** 03050CSR SR5 BEGSR 03060C* EDIT 03070C* 03080C* 03090C** 03100C* 03110C* 03120C* 03130CSR ENDSR 03140C******************************************************************* 03150C* 03160C* 03170C* 03180C* 03190C* 03200C* 03210C* 03220C* 03230C* 03240C* 03250C* ÐÐ03260C* 03270C* 03280C* 03290C* 03300C* 03310C* 03320C* 03330C* 03340C***************************************************************** 03350CSR SR70 BEGSR 03360C* CLEAR TERM SCREEN. 03370CSR SETON 70 03380CSR EXCPT CLEAR SCREEN 03390CSR SETOF 70 03400CSR ENDSR 03410C********************************************************************** 03420CSR SR71 BEGSR 03430C* PUT HEADINGS TO TERMINAL 03440CSR SETON 71 03450CSR EXCPT PUT HEADINGS 03460CSR SETOF 71 03470CSR ENDSR 03480C********************************************************************* 03490CSR SR72 BEGSR 03500C* PUT DATA TO TERMINAL ÐÐ03510CSR SETON 72 03520CSR EXCPT PUT DATA 03530CSR SETOF 72 03540CSR ENDSR 03550C*********************************************************************** 03560CSR SR73 BEGSR 03570C* PUT ERROR MESSAGE TO TERMINAL 03580CSR SETON 73 03590CSR EXCPT PUT MSG 03600CSR SETOF 73 03610CSR Z-ADDM LSTERR 50 03620CSR ENDSR 03630C******************************************************************* 03640CSR SR75 BEGSR 03650C* READ FROM TERMINAL 03660CSR SETOF 779096 03670CSR SETOF 939291 03680CSR SETOF 898887 03690CSR SETOF 8685 03700CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 03710CSR MOVE BLK8 W8A BUFFER 03720CSR EXITFQWREED READ FROM TERMINAL 03730CSR RLABL W8A READ BUFFER 03740CSR RLABL BUFLGT READ BUFFER LGTH 03750CSR MOVEAW8A A8 INPUT DATA ARRAY ÐÐ03760CSR MOVE BLK8 W8A INIT INPUT ARRAY 03770CSR Z-ADD1 W 30 03780CSR '\' LOKUPA8,W 90 FLAG ESC 03790CSRN90 GOTO T75B NOT ESC 03800CSR 1 ADD W W 03810CSR W COMP 8 54 03820CSR 54 GOTO T75A BAD ESC 03830CSR A8,W COMP 'G' 98 GOODBY 03840CSR A8,W COMP 'E' 94 MENU 03850CSR A8,W COMP 'N' 93 NEW ITEM 03860CSR A8,W COMP 'J' 92 JUMP 03870CSR A8,W COMP 'F' 91 SKIP FRWRD 03880CSR A8,W COMP 'B' 89 SKIP BKWRD 03890CSR A8,W COMP 'S' 88 SPACE FILL 03900CSR A8,W COMP 'H' 87 HOME 03910CSR A8,W COMP 'U' 86 UPDATE 03920CSR A8,W COMP 'R' 85 REPEAT 03930CSR 98 03940COR 94 03950COR 93 03960COR 92 03970COR 91 03980COR 89 03990COR 88 04000COR 87 ÐÐ04010COR 86 04020COR 85 GOTO END75 GOOD ESC 04030C*------------------------------------------------------------------ 04040CSR T75A TAG 04050C* FLAG BAD ESC INPUT 04060CSR Z-ADD318 M 96 FLAG ERROR 04070CSR GOTO END75 04080C*-------------------------------------------------------------------- 04090CSR T75B TAG 04100C* MOVE DATA 04110CSR Z-ADD1 W 04120CSR ' ' LOKUPA8,W 77 04130CSR 77 MOVEAA8,W W8A INPUT DATA 04140C*-------------------------------------------------------------------- 04150CSR END75 TAG 04160C* INIT PREV ERROR MSG. 04170CSR LSTERR COMP 0 54 04180CSR 54 MOVE BLK35 MGTEXT 04190CSR 54 EXSR SR73 BLANK MESSAGE 04200CSR Z-ADD0 LSTERR 50 04210CSR ENDSR 04220C********************************************************************** 04230CSR SR80 BEGSR 04240C* GET MASTER RECORD 04250CSR SETOF 61 ÐÐ04260CSR CHAIN 60 GET MASTER 04270CSRN60 COMP 'D' 61 FLAG DELETE 04280CSR ENDSR 04290C********************************************************************** 04300CSR SR81 BEGSR 04310C* ADD NEW MASTER TO FILE 04320CSR SETON 81 04330CSR EXCPT ADD MASTER 04340CSR SETOF 81 04350CSR ENDSR 04360C*********************************************************************** 04370CSR SR82 BEGSR 04380C* REWRITE MASTER 04390CSR SETON 82 04400CSR EXCPT REWRITE MASTER 04410CSR SETOF 82 04420CSR ENDSR 04430C********************************************************************** 04440CSR SR89 BEGSR 04450C* GET MESSAGE MASTER 04460CSR M CHAINMGFILE 54 04470CSR 54 MOVE BLK35 MGTEXT 04480CSR 54 MOVELM MGTEXT 04490CSR 54 MOVE MES,1 MGTEXT 04500CSR ENDSR ÐÐ04510C****************************************************************** 04520CSR SR97 BEGSR 04530C* UPDATE CRTFILE. 04540CSR SETON 97 04550CSR EXCPT UPDATE CRTFILE 04560CSR SETOF 97 04570CSR ENDSR 04580C******************************************************************** 04590C* 04600C* 04610C* 04620C* 04630C* 04640C* 04650C* 04660C* 04670C* 04680C* 04690C* 04700C*********************************************************************** 04710CSR SR101 BEGSR 04720C* 1-TIME INITIALIZE 04730CSR MOVE BIT,1 NUL 04740CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04750CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ04760CSR MOVE ' ' BLK8 8 04770C* GET PORT # AND CRTFILE 04780CSR MOVE ' ' W8A 8 04790CSR Z-ADD0 W2N 20 04800CSR Z-ADD0 W1N 10 04810CSR MOVE ' ' W2A 2 04820CSR EXITFPGMINX GET PORT # 04830CSR RLABL W8A 04840CSR RLABL W2N 04850CSR RLABL W1N 04860CSR RLABL W2A 04870CSR MOVE W2A PORT 20 PORT NO. 04880CSR PORT COMP 0 54 04890CSRN54 Z-ADD25 PORT DEFAULT 04900CSR PORT CHAINCRTFILE H9 04910C* DEFINE WORK FIELDS,ETC. 04920CSR MOVE ' ' BLK35 35 04930C* 04940C* 04950C* 04960C* 04970C* 04980CSR ENDSR 04990C********************************************************************** 05000CSR SR102 BEGSR ÐÐ05010C* VALIDATE FIELD NO. 05020CSR F COMP 0 54 05030CSRN54 Z-ADD1 F 05040CSR F COMP FLIMIT 55 05050CSR 55 Z-ADD1 F 05060CSR ENDSR 05070C******************************************************************** 05080CSR SR103 BEGSR 05090C* MOVE INPUT DATA 05100CSR EXSR SR201 IDENTIFY-F 05110CSR EXSR SR202 R. JUSTIFY 05120CSR 01 MOVE W8A TREP 50 REPORT # 05130CSR 02 MOVE W8A TPER 20 NUMB OF PERIODS 05140CSR MOVE ' ' DUN,F EDIT FLAG 05150CSR ENDSR 05160C******************************************************************** 05170CSR SR104 BEGSR 05180C* EDIT INPUT DATA 05190CSR 01 EXSR SR1 05200CSR 96 MOVE ' ' DUN,F EDIT FLAG 05210CSRN96 MOVE 'X' DUN,F 05220CSR ENDSR 05230C*********************************************************************** 05240CSR SR105 BEGSR 05250C* FINAL EDIT ÐÐ05260CSR SETON 79 FINAL EDIT FLAG 05270CSR Z-ADD1 F 96 05280C*-------------------------------------------------------------------- 05290CSR T105A TAG 05300CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05310CSRN54 GOTO END105 05320CSR EXSR SR201 IDENTIFY-F 05330CSR EXSR SR104 EDIT 05340CSRN96 GOTO T105A 05350C*-------------------------------------------------------------------- 05360CSR END105 TAG 05370CSR SETOF 79 05380CSR ENDSR 05390C******************************************************************** 05400CSR SR106 BEGSR 05410C* DISPLAY DATA. 05420C* DISPLAY TITLE. 05430CSR TREP CHAINGLRWMAST 60 05440CSR 60 Z-ADD365 M 96 FLAG ERROR 05450CSR 60 GOTO END106 05460CSR EXSR SR76 DISPLAY TITLE 05470CSR MOVELTREP W9A 9 05480CSR MOVE '0000' W9A 05490CSR W9A SETLLGLRWSPEC 05500C*------------------------------------------------------------------- ÐÐ05510CSR T106A TAG 05520C* READ SPEC FILE. 05530CSR SETOF 540102 05540CSR READGLRWSPEC 54 05550CSR 54 GOTO END106 05560CSR GWREP COMP TREP 54 05570CSRN54 GOTO END106 05580CSR GWSTAT COMP 'D' 54 05590CSR 54 GOTO T106A 05600CSR 01 GOTO T106M SUB-TOTAL RECORD 05610C* PROCESS ACCOUNT RECORD. 05620CSR GWPRSW COMP 'B' 54 05630CSR 54 EXSR SR84 PRINT ACCOUNT 05640CSR GWLEV COMP 0 54 05650CSR 54 EXSR SR85 PRINT LOWER LEVEL 05660CSR GWPRSW COMP 'A' 54 05670CSR 54 EXSR SR84 PRINT ACCOUNT 05680CSR GOTO T106A 05690C*------------------------------------------------------------------ 05700CSR T106B TAG 05710C* PRINT SUB-TOTAL. 05720CSR EXSR SR86 05730CSR GOTO T106A 05740CSR END106 ENDSR 05750C************************************************************************ ÐÐ05760CSR SR201 BEGSR 05770C* IDENTIFY FIELD NO. 05780CSR F COMP 1 01 05790CSR F COMP 2 02 05800CSR ENDSR 05810C********************************************************************** 05820CSR SR202 BEGSR 05830C* RIGHT JUSTIFY 05840CSR F LOKUPNUM 54 05850CSRN54 GOTO END202 NOT NUMERIC FIELD 05860CSR Z-ADD8 W2N 20 05870CSR EXIT SUBRAJ R. JUSTIFY 05880CSR RLABL W2N 05890CSR RLABL W8A 05900CSR END202 ENDSR 05910C**************************************************************************05920C* 05930C* 05940C* 05950C* 05960C* 05970C* 05980C* 05990C* 06000C* ÐÐ06010C* 06020C* 06030C* 06040C* 06050C* 06060C* 06070C* 06080C* 06090C* 06100C* 06110C* 06120C* 06130C* 06140C* 06150C* 06160C* 06170C* 06180C* 06190C* 06200C* 06210C* 06220C* 06230C* 06240C* 06250OTERM132 E ÐÐ06260O* 06270O* 06280O* 06290O* 06300O* 06310O* 06320O* 06330O* 06340O* 06350O* 06360O* 06370O* 06380O* 06390O* 06400O* 06410O* 06420O* 06430O* 06440O* 06450O* 06460O* 06470O* 06480O* 06490O* 06500O* ÐÐ06510O* 06520O* 06530O* 06540O* 06550O* 06560O* 06570O* 06580O* 06590O* 06600O* 06610O* 06620O* 06630O* ** NUL ARRAY 006640 006650** A8 ARRAY 006660 006670** NUM ARRAY 006680 006690** DUN ARRAY 006700 006710** MES ARRAY 006720---MESSAGE NOT ON FILE--- 006730/* 006740_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(X. XúX011PC P120282120282(èÈÐ00010H Q011PC00020F* INDENTED COST LIST --- DIABLO. (X011PC) 00030F* REV 3/31/81 4:50 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FINP011PCIS F 10 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST ID F 86L20AI 1 DISK 00090FCRTFILE UC F 256R DISK 00100E******************************************************************** 00110E NUL 50 50 1 NULL CHAR. 00120E N20 20 20 1 NULL CHAR. 00130E A6 6 6 1 00140E A12 12 12 1 A INPUT ARRAY. 00150E LEV 1 20 20 NEXT RRN AT EA LEVEL 00160E QTY 1 20 7 0 QTY MULTIPLIER 00170E REC 180 1 00180E PM$ 7 9 3 MFG COSTS 00190E BIT 33 1 BITTAB. 00200I******************************************************************** 00210IINP011PCPD 01 00220I 1 10 ASSYPN 00230I******************************************************************** 00240IBITTAB BT 02 00250I 1 33 BIT ÐÐ00260I******************************************************************** 00270ICRTFILE CR 00280I 77 256 REC 00290I******************************************************************** 00300IPMMST2 PM 00310I* PART MASTER RECORD 00320I* KEY AREA 00330I* PART NO. 10N 00340I 1 100PMPN 00350I* NUMB OF COMPONENTS 3P 00360I P 13 140PMNOBM 00370I* PROD LINE 4N 00380I 15 180PMPL 00390I* MODEL NAME 12A 00400I 19 30 PMMODL 00410I* DESCRIPTION 29A 00420I 31 59 PMDESC 00430I* COMMODITY CODE 9P 00440I P 60 640PMCC 00450I* ENG CHANGE STATUS. 00460I* LAST ECN NO. 5A 00470I 65 69 PMECN 00480I* CUR CHG LEVEL 2A 00490I 70 71 PMECHG 00500I* CUR CHG DATE 6N ÐÐ00510I 72 770PMDCHG 00520I* DRAWING INFO 00530I* DWG REL CODE 1A 00540I 78 78 PMRELS 00550I* DWG SIZE 1A 00560I 82 82 PMSIZ 00570I* DWG CLASS 1A 00580I* D = DYNAIR DWG 00590I* V = VENDOR DWG 00600I 83 83 PMDCLS 00610I* STANDARD CODE 1A 00620I 84 84 PMSTDC 00630I* UNIT MEAS 2A 00640I* EA = EACH OC = OUNCE 00650I* ST = SET TC = TROY OUNCE 00660I* IN = INCH LB = POUND 00670I* FT = FEET PT = PINT 00680I* YD = YARD QT = QUART 00690I* SI = SQ.INCH GL = GALLON 00700I* SF = SQ.FEET DR = DRUM 00710I* SY = SQ.YARD 00720I 85 86 PMUM 00730I* SOURCE CODE 2A 00740I* MA = MFG ASSY 00750I* MP = MFG PART ÐÐ00760I* PA = PURCH ASSY 00770I* PP = PURCH PART 00780I* RS = RAW STOCK 00790I* RD = REF DOC ONLY 00800I 97 98 PMSC 00810I* PROVISIONING CODE 1A 00820I* A = FORECAST,NO VALUE ADDED 00830I* B = FORECAST,VALUE ADDED 00840I* C = BUILD TO ORDER (B) 00850I* D = BUILD TO ORDER (NOT B) 00860I* E = CUSTOM 00870I* Y = OBSOLETE,REPAIRABLE 00880I* Z = OBSOLETE,NOT REPAIRABLE 00890I 96 96 PMPROV 00900I* ISSUE CODE 2A 00910I* PT = PULL TIME 00920I* OR = ON REQUEST 00930I* BI = BULK ISSUE 00940I* AR = AS REQUIRED 00950I* VS = VENDOR SUPPLIED 00960I* SD = SHIPPING DOCUMENT 00970I* TD = TRAV DOCUMENT 00980I* RD = REF DOC ONLY 00990I* RA = REF ASSY 01000I 97 98 PMISSU ÐÐ01010I* DELIVER TO DEPT 5P 01020I P 99 1010PMDEL 01030I* RESPONSIBILITY CODES 01040I* ENGR CODE 2A 01050I 102 103 PMEGR 01060I* PLANNER CODE 2A 01070I 104 105 PMPLNR 01080I* BUYER CODE 2A 01090I 106 107 PMBUYR 01100I* SALESMAN CODE 2A 01110I 108 109 PMSLSM 01120I* INVENTORY ACCOUNT 5P 01130I P 110 1120PMACNT 01140I* MFG COST ARRAY 7 X 9.3P 01150I P 245 279 PM$ 01160I* FAB CODE 2A 01170I 487 488 PMFABC 01180I* RECORD STATUS 1A 01190I* D = DELETED 01200I 674 674 PMSTAT 01210I******************************************************************** 01220IBMMAST BM 01230I* BILL OF MATERIAL RECORD 01240I* KEY AREA 01250I* ASSY PART NO. 10N ÐÐ01260I 1 100BMAPN 01270I* COMPONENT PART # 10N 01280I 11 200BMCPN 01290I* ITEM NO. 3N 01300I 25 270BMITNO 01310I* QTY PER ASSY 7P 01320I P 28 310BMQTY 01330I* SCRAP ALLOW .2N 01340I 34 352BMSCRP 01350I* ISSUE CODE 2A 01360I* PT = PULL TIME 01370I* OR = ON REQUEST 01380I* BI = BULK ISSUE 01390I* AR = AS REQUIRED 01400I* RA = REF ASSY 01410I* TD = TRAV DOC 01420I* SD = SHIP DOC 01430I* RD = REF DOC 01440I* VS = VENDOR SUPPLIED 01450I 36 37 BMISSU 01460I* EFFECTIVITY. 01470I* BEGIN CHANGE LEVEL 2A 01480I 38 39 BMBCHG 01490I* ENDING CHANGE LEVEL 2A 01500I 40 41 BMECHG ÐÐ01510I* BEGIN ECN # 5A 01520I 42 46 BMBECN 01530I* ENDING ECN # 5A 01540I 47 51 BMEECN 01550I* DISPOSITION CODE 1A 01560I* U = USE UP OLD STYLE 01570I* N = NOW (IMMEDIATE) 01580I 52 52 BMDISP 01590I* FILLER 5A 53 57 FFFFFF 01600I* ROUTING. 01610I* OPER NO. 5P 01620I P 58 600BMOPER 01630I* DEPT NO. 5P 01640I P 61 630BMDEPT 01650I* WORK CENTER NO. 3P 01660I P 64 650BMWC 01670I* COMPONENT OPER REFERENCE INFO 10A 01680I 66 75 BMREF 01690I* FILLER 10A 76 85 FFFFFF 01700I* 01710I* RECORD STATUS 1A 01720I* D = DELETED 01730I 86 86 BMSTAT 01740C******************************************************************** 01750C* INITIALIZE ÐÐ01760C 02 EXSR SR101 INIT 01770C N01 GOTO END 01780C*---------------------------------------------------------------- 01790C START TAG 01800C* GET ASSY PART NO FROM TERMINAL 01810C MOVELASSYPN W12A 12 01820C MOVELW12A TAPN 100 TOP ASSY PN 01830C EXSR SR81 GET PMMST2 01840C 60 GOTO END NOT ON FILE 01850C*-------------------------------------------------------------------- 01860C TAG10 TAG 01870C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 01880C Z-ADD1 QTY,2 QTY MULTIPLIER 01890C PM$,1 ADD PM$,2 ADDCST 01900C PM$,3 ADD ADDCST ADDCST 01910C PM$,4 ADD ADDCST ADDCST 01920C PM$,5 ADD ADDCST ADDCST 01930C PM$,6 ADD PM$,7 CUMCST 01940C CUMCST ADD ADDCST TOTCST 01950C SETON 89 01960C EXSR SR71 PUT HEADING 01970C SETOF 89 01980C* SET-UP INITIAL BILL MATERIAL READ 01990C Z-ADD3 L 20 INDENTURE LEVEL 02000C MOVE BLK20 LEV ÐÐ02010C MOVELTAPN LEV,2 02020C*----------------------------------------------------------------- 02030C TAG20 TAG 02040C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02050C L SUB 1 L 54 INDENT LEVEL 02060C N54 GOTO ENDASY BOTTOM INDENT 02070C LEV,L COMP BLK20 54 02080C N54 GOTO TAG20 NONE THIS LEVEL 02090C MOVE LEV,L W20A 20 02100C MOVELLEV,L CURASY 100 MATCH PART # 02110C MOVE BLK20 LEV,L 02120C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02130C*------------------------------------------------------------------ 02140C TAG30 TAG 02150C* SET-UP NEXT READ 02160C W20A SETLLBMMAST 02170C*--------------------------------------------------------------- 02180C TAG40 TAG 02190C* GET NEXT COMPONENT. 02200C SETOF 54 02210C READ BMMAST 54GET COMPONENT 02220C 54 GOTO TAG20 END OF FILE 02230C BMAPN COMP CURASY 54 02240C N54 GOTO TAG20 WRONG ASSY 02250C BMSTAT COMP 'D' 54 ÐÐ02260C 54 GOTO TAG40 DELETED RECORD 02270C* DISPLAY COMPONENT DATA 02280C EXSR SR72 DISPLAY DATA 02290C* BRANCH IF NOT ASSY 02300C PMNOBM COMP 0 54 02310C N54 GOTO TAG40 NOT ASSY 02320C*------------------------------------------------------------------ 02330C TAG50 TAG 02340C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02350C MOVELBMAPN LEV,L 02360C 1 ADD BMCPN W10N 100 02370C MOVE W10N LEV,L 02380C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02390C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02400C MOVE BMCPN CURASY 02410C MOVELBMCPN W20A 02420C MOVE ZERO10 W20A 02430C 1 ADD L L INDENT LEVEL 02440C GOTO TAG30 02450C*------------------------------------------------------------------ 02460C ENDASY TAG 02470C* END OF ASSY PROMPT 02480C GOTO START 02490C*----------------------------------------------------------------- 02500C END TAG ÐÐ02510C*------------------------------------------------------------------- 02520C ENDJOB TAG 02530C******************************************************************** 02540CSR SR67 BEGSR 02550C* TOP OF FORM. 02560CSR EXITFZTFORM 02570CSR Z-ADD4 COUNT 30 LINE COUNT 02580CSR 1 ADD EGAP EGAP 40 PAGE # 02590CSR ENDSR 02600C******************************************************************** 02610CSR SR69 BEGSR 02620C* PUT DATA TO DIABLO. 02630CSR EXSR SR201 LF 02640CSR PORT CHAINCRTFILE H9 02650CSR H9 GOTO END69 02660CSR MOVE ' ' REC 02670CSR EXCPT UPDATE CRTFILE 02680CSR PORT CHAINCRTFILE H9 02690CSR H9 GOTO END69 02700CSR MOVEAREC W180A 180 02710CSR EXITFZD180 PUT DIABLO 02720CSR RLABL W180A 02730C*------------------------------------------------------------------ 02740CSR END69 TAG 02750CSR SETOF 7244 ÐÐ02760CSR SETOF 414243 02770CSR ENDSR 02780C******************************************************************** 02790CSR SR71 BEGSR 02800C* CLEAR CRT. PUT HEADINGS. 02810CSR Z-ADD6 COUNT 30 LINE COUNT 02820CSR MOVELTAPN W12A 12 02830CSR MOVE ' ' W12A 02840CSR EXSR SR67 TOP FORM 02850CSR EXSR SR81 GET TOP-ASSY PMMST2 02860CSR SETON 41 02870CSR EXSR SR69 PUT HEADING 02880CSR EXSR SR201 LF 02890CSR SETON 42 02900CSR EXSR SR69 PUT HEADING 02910CSR SETON 43 02920CSR EXSR SR69 PUT HEADING 02930CSR EXSR SR201 LF 02940CSR SETON 44 02950CSR EXSR SR69 PUT HEADING 02960CSR ENDSR 02970C******************************************************************** 02980CSR SR72 BEGSR 02990C* DISPLAY DATA LINE TO CRT. 03000CSR 1 ADD COUNT COUNT ÐÐ03010CSR MOVE BLK12 W12A 03020CSR MOVELBMCPN W12A COMP PN 03030CSR EXSR SR81 GET PMMST2 03040CSR U1 PMNOBM COMP 0 54 03050CSR U1N54 GOTO END72 NOT ASSY 03060CSR L COMP 1 0101 03070CSR L COMP 2 02 03080CSR L COMP 3 03 03090CSR L COMP 4 04 03100CSR L COMP 5 05 03110CSR L COMP 6 06 03120CSR L COMP 7 07 07 03130CSR 01 Z-ADD1 L 03140CSR BMISSU COMP ' ' 55 03150CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03160CSR EXTQTY MULT PM$ PM$ H 03170CSR PM$,1 ADD PM$,2 ADDCST 103 03180CSR PM$,3 ADD ADDCST ADDCST 03190CSR PM$,4 ADD ADDCST ADDCST 03200CSR PM$,5 ADD ADDCST ADDCST 03210CSR PM$,6 ADD PM$,7 CUMCST 103 03220CSR ADDCST ADD CUMCST TOTCST 103 03230CSR SETON 72 03240CSR EXSR SR69 PUT DATA. 03250CSR COUNT COMP 70 54 54 ÐÐ03260CSRN54 GOTO END72 NOT END PAGE 03270CSR EXSR SR71 PUT HEADINGS 03280CSR END72 ENDSR 03290C******************************************************************** 03300CSR SR81 BEGSR 03310C* GET PART MAST. 03320CSR SETOF 61 03330CSR W12A CHAINPMMST2 60 GET PMMST2 03340CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR101 BEGSR 03380C* INITIALIZE (1-TIME). 03390C* SET SPACING ON DIABLO. 03400CSR MOVE '15' W2A 2 03410CSR EXITFZHMI HORIZONTAL 03420CSR RLABL W2A 03430CSR MOVE '10' W2A 03440CSR EXITFZVMI VERTICAL 03450CSR RLABL W2A 03460C* GET PORT # AND CRTFILE. 03470CSR MOVE ' ' W8A 8 03480CSR Z-ADD0 W2N 20 03490CSR Z-ADD0 W1N 10 03500CSR MOVE ' ' W2A 2 ÐÐ03510CSR EXITFPGMINX GET PORT # 03520CSR RLABL W8A 03530CSR RLABL W2N 03540CSR RLABL W1N 03550CSR RLABL W2A 03560CSR MOVE W2A PORT 20 PORT NO. 03570CSR PORT COMP 0 54 03580CSRN54 Z-ADD25 PORT DEFAULT 03590CSR PORT CHAINCRTFILE H9 03600CSR H9 GOTO END101 03610CSR MOVE BIT,1 N20 03620CSR MOVE BIT,1 A6 03630CSR MOVE BIT,1 NUL INIT NULL CHAR. 03640CSR MOVE ' ' BLK35 35 03650CSR MOVE ' ' BLK12 12 03660CSR MOVE ' ' BLK20 20 03670CSR Z-ADD0 ZERO10 100 03680CSR END101 ENDSR 03690C******************************************************************** 03700CSR SR201 BEGSR 03710C* LINE FEED. 03720CSR 1 ADD COUNT COUNT 03730CSR EXITFQCLF 03740CSR ENDSR 03750O******************************************************************** ÐÐ03760OCRTFILE E 72 03770O* DATA LINE. 03780O REC 256 03790O 87 '.' 03800O 90 '.' 03810O 93 '.' 03820O 96 '.' 03830O 99 '.' 03840O 102 '.' 03850O 105 '.' 03860O 02 105 ' ' 03870O 03 105 ' ' 03880O L Z 78 03890O BMITNOZ 84 03900O 01 BMCPN 98 ' - - ' 03910O 02 BMCPN 101 ' - - ' 03920O 03 BMCPN 104 ' - - ' 03930O 04 BMCPN 107 ' - - ' 03940O 05 BMCPN 110 ' - - ' 03950O 06 BMCPN 113 ' - - ' 03960O 07 BMCPN 116 ' - - ' 03970O PMDESC 147 03980O BMQTY 2 158 03990O PMUM 162 04000O PMSC 168 ÐÐ04010O PMISSU 174 04020O 55 BMISSU 174 04030O PMPROV 179 04040O EXTQTY2 191 04050O PMSTDC 195 04060O PMFABC 201 04070O ADDCST2 214 04080O CUMCST2 227 04090O TOTCST2 241 04100O*------------------------------------------------------------------- 04110O E 44 04120O* PUT TOP ASSY LINE. 04130O REC 256 04140O 78 '1' 04150O TAPN 98 ' - - ' 04160O N89 105 'CONT''D' 04170O PMDESC 147 04180O 158 '1' 04190O PMUM 162 04200O PMISSU 174 04210O PMSC 168 04220O PMPROV 179 04230O 191 '1' 04240O PMSTDC 195 04250O PMFABC 201 ÐÐ04260O*------------------------------------------------------------------- 04270O E 41 04280O* CLEAR SCREEN - LINE-1. 04290O REC 256 04300O 147 'INDENTED PARTS LIST' 04310O 155 'ASSY=' 04320O TAPN 167 ' - - ' 04330O*------------------------------------------------------------------- 04340O E 42 04350O* HEADING, LINE-2. 04360O REC 256 04370O 103 '--------------INDENTURE' 04380O 117 '--------------' 04390O 158 'QUANTITY' 04400O 170 'SOURCE' 04410O 176 'ISSUE' 04420O 181 'PROV' 04430O 191 'EXTENDED' 04440O 196 'STD' 04450O 202 'FAB' 04460O*------------------------------------------------------------------- 04470O E 43 04480O* HEADING, LINE-3. 04490O REC 256 04500O 79 'LEV' ÐÐ04510O 84 'ITEM' 04520O 106 '1 2 3 4 5 6 7' 04530O 109 '-UP' 04540O 129 'DESCRIPTION' 04550O 158 'PER-ASSY' 04560O 162 'UM' 04570O 169 'CODE' 04580O 175 'CODE' 04590O 181 'CODE' 04600O 191 'QUANTITY' 04610O 197 'CODE' 04620O 203 'CODE' 04630O 214 'ADDED-COST' 04640O 227 'CUM-COST' 04650O 241 'TOTAL-COST' ** NUL ARRAY 004660 004670** N20 ARRAY 004680 004690** A6 ARRAY 004700 004710** A12 ARRAY 004720 004730** LEV ARRAY 004740 004750ÐÐ** QTY ARRAY 004760 004770/* 004780_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È/ ÈTX018RM P999999120282(èÈÐ00010H Q018RM00020F* GEN RMWCNOS FILE FOR LIST WORK CENTERS BY PART (Q019RM). (X018RM) 00030F* REVISED 11-11-81 3:00 PM. 00040FPMMST2 IP AF 674 12AI 1 DISK 00050FRMMAST IS AF 140 15AI 1 DISK 00060FWCMAST IS F 960 8AI 1 DISK 00070FRMWCNOS O F 920 DISK 00080E******************************************************************** 00090E DEP 1 115 8 A 00100E ADP 3 3 0A 00110E MDP 12 3 0A 00120I******************************************************************** 00130IPMMST2 PM 02 674NCD 00140I 1 100PMPN L1M1 00150I 31 59 PMDESC 00160I P 537 542 ADP 00170I P 591 614 MDP 00180I GG 05 00190I******************************************************************** 00200IRMMAST RM 03 140NCD 00210I 1 100RMPN L1M1 00220I P 25 270RMDEPT 00230I P 28 290RMWC 00240I 30 69 RMDESC 00250I RG 06 ÐÐ00260I******************************************************************** 00270IWCMAST WC 01 960NCD 00280I 1 50WCDEPT 00290I 6 80WCWC 00300I WG 04 00310C******************************************************************** 00320C* INIT 1-TIME. 00330C N79 EXSR SR101 INIT 00340C N79 MOVE ' ' BLK8 8 STUPIDITY 00350C N79 Z-ADD0 ZERO3 30 STUPIDITY 00360C N79 SETON 79 00370C* BRANCH ON RECORD CODE. 00380C 01 GOTO TAG100 WCMAST 00390C 02 GOTO TAG200 PMMST2 00400C 03 GOTO TAG300 RMMAST 00410C GOTO END 00420C*------------------------------------------------------------------- 00430C TAG100 TAG 00440C* WORK CENTER. 00450C MOVELWCDEPT W8A 8 00460C MOVE WCWC W8A 00470C W8A LOKUPDEP 54 00480C 54 GOTO END 00490C Z-ADD1 W 30 00500C BLK8 LOKUPDEP,W 54 ÐÐ00510C N54 SETON H9 00520C N54 GOTO END 00530C MOVE W8A DEP,W 00540C GOTO END 00550C*------------------------------------------------------------------- 00560C TAG200 TAG 00570C* PART MAST. 00580C MOVE BLK8 W8A 00590C Z-ADD0 W3N 30 00600C Z-ADD1 X 30 00610C*------------------------------------------------------------------- 00620C TAG210 TAG 00630C ZERO3 LOKUPADP,X 54 00640C N54 Z-ADD1 X 00650C N54 GOTO TAG230 00660C Z-ADDADP,X W5N 50 00670C EXSR SR103 LOAD DEP & USE 00680C Z-ADD0 ADP,X 00690C GOTO TAG210 00700C*------------------------------------------------------------------- 00710C TAG230 TAG 00720C ZERO3 LOKUPMDP,X 54 00730C N54 GOTO END 00740C Z-ADDMDP,X W5N 00750C EXSR SR103 LOAD DEP & USE ÐÐ00760C Z-ADD0 MDP,X 00770C GOTO TAG230 00780C*------------------------------------------------------------------- 00790C TAG300 TAG 00800C* ROUTING OPER. 00810C Z-ADDRMDEPT W5N 00820C Z-ADDRMWC W3N 30 00830C EXSR SR103 LOAD DEP & USE 00840C GOTO END 00850C*------------------------------------------------------------------- 00860C END TAG 00870CLR EXSR SR102 SORT DEP ARRAY 00880C******************************************************************** 00890CSR SR101 BEGSR 00900C* 1-TIME INIT. 00910CSR MOVE ' ' BLK8 8 00920CSR MOVE BLK8 DEP 00930CSR Z-ADD0 ADP 00940CSR Z-ADD0 MDP 00950CSR END101 ENDSR 00960C******************************************************************** 00970CSR SR102 BEGSR 00980C* SORT ARRAYS. 00990CSR SETON 78 01000CSR Z-ADD0 A 30 ÐÐ01010CSR Z-ADD0 B 30 01020C*------------------------------------------------------------------- 01030CSR T102A TAG 01040CSR 1 ADD A A 01050CSR A COMP 115 54 54 01060CSRN54 DEP,A COMP BLK8 54 01070CSR 54 GOTO END102 01080CSR Z-ADDA B 01090C*------------------------------------------------------------------- 01100CSR T102B TAG 01110CSR 1 ADD B B 01120CSR B COMP 115 54 01130CSRN54 DEP,B COMP BLK8 54 01140CSR 54 GOTO T102A 01150CSR DEP,A COMP DEP,B 54 01160CSRN54 GOTO T102B 01170CSR MOVE DEP,A DEPA 8 01180CSR MOVE DEP,B DEP,A 01190CSR MOVE DEPA DEP,B 01200CSR GOTO T102B 01210CSR END102 ENDSR 01220C******************************************************************** 01230CSR SR103 BEGSR 01240C* LOAD DEP ARRAY. 01250CSR MOVELW5N W8A 8 ÐÐ01260CSR MOVE W3N W8A 01270CSR Z-ADD1 W 01280CSR W8A LOKUPDEP,W 54 01290CSR 54 GOTO END103 01300CSR Z-ADD1 W 01310CSR BLK8 LOKUPDEP,W 54 01320CSRN54 GOTO END103 01330CSR MOVE W8A DEP,W 01340CSR END103 ENDSR 01350O*********************************************************************** 01360ORMWCNOS T LR 01370O DEP 920 01380O********************************************************************** ** DEP ARRAY 01390 01400/* 01410_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(,/X ,}X011QM P120282120282(èÈÐ00010H Q011QM00020F* QUOTE STATUS REPORT. (X011QM) 00030F* REVISED 3/31/81 10:45 AM. 00040F* 00050FBITHEX IP F 256 DISK 00060FQMMAST IS F 160 160 8AI 1 DISK 00070FQMHIST UC F 192R26AI 1 DISK A 00080FDIABLO O F 80 5 00090E******************************************************************** 00100E A26 26 26 1 00110E BIT 256 1 SCREEN CONTR. CHAR 00120E QMD 6 7 0 CALL STACK 00130E QH$ 20 7 0 00140E QHF 20 3 0 00150E QHR 20 2 A 00160I******************************************************************* 00170IBITHEX BT 00180I 1 256 BIT 00190I******************************************************************** 00200IQMMAST QM 00210I* QUOTE MASTER. 00220I* QUOTE # 5A 00230I 1 5 QMQOTE 00240I* ITEM # 3N 00250I 6 80QMITEM ÐÐ00260I* CUSTOMER NAME 20A 00270I 9 28 QMNAME 00280I* CUSTOMER RFQ # 20A 00290I 29 48 QMRFQ 00300I* RFQ ITEM # 4A 00310I 49 52 QMRFQI 00320I* CONTACT 20A 00330I 53 72 QMCONT 00340I* ASSIGNED TO (SALESMAN) 3A 00350I 73 75 QMSLSM 00360I* DATE ARRAY 7P X 6 00370I* 1 = RECEIVED 00380I* 2 = DUE 00390I* 3 = SENT 00400I* 4 = EXPECTED AWARD 00410I* 5 = FOLLOW-UP 00420I* 6 = NOT USED 00430I P 76 99 QMD 00440I* PRODUCT CLASS 2A 00450I 100 101 QMPCLS 00460I* SYSTEM CODE 1A 00470I 102 102 QMSYST 00480I* FILLER 103 103 FFFFFF 00490I* QUOTE AMOUNT 7P ($) 00500I P 104 1070QMAMT ÐÐ00510I* DELIVERY PROMISED (DAYS ARO) 3P 00520I P 108 1090QMDEL 00530I* STATUS 1A 00540I* E = ENTERED 00550I* N = NO BID 00560I* B = BID 00570I* P = PENDING 00580I* L = LOST 00590I* W = WON 00600I* C = CANCELLED 00610I 110 110 QMSCOD 00620I* PROBABILITY OF AWARD 3.2P 00630I P 111 1122QMPROB 00640I* WON/LOST REASON 1A 00650I 113 113 QMREAS 00660I* REMARKS 40A 00670I 114 153 QMREM 00680I* RECORD STATUS 1A 00690I 160 160 QMSTAT 00700I******************************************************************** 00710IQMHIST QH 00720I* QUOTE HISTORY FILE. 00730I* KEY AREA. 00740I* PRODUCT CLASS 2A 00750I 1 2 QHCLAS ÐÐ00760I* DATE CLOSED (YR-MO) 4N 00770I 3 60QHDAT 00780I 3 40QHYR 00790I 5 60QHMO 00800I* CUSTOMER NAME 20A 00810I 7 26 QHNAME 00820I* HISTORY ARRAYS - 20 ELEMENTS EA 00830I* STATUS CODE/REASON 2A X 20 00840I 27 46 QHR 00850I* FREQUENCY 3P X 20 00860I P 47 86 QHF 00870I* $ AMOUNT 7P X 20 00880I P 87 166 QH$ 00890I* FILLER 167 192 FFFFFF 00900C******************************************************************** 00910C* INITIALIZE. 00920C N79 EXSR SR101 INIT 1-TIME. 00930C EXSR SR102 INIT ALWAYS. 00940C* BYPASS DELETES. 00950C QMSTAT COMP 'D' 54 00960C 54 SETOF 01 00970C 54 GOTO END DELETED. 00980C* BRANCH IF PREV CLOSED. 00990C QMSTAT COMP 'P' 54 01000C 54 GOTO TAG100 ÐÐ01010C* CLASSIFY STATUS CODES. 01020C EXSR SR103 CLASSIFY STATUS 01030C* CLASSIFY REASON CODES, IF CLOSE OUT. 01040C 70 EXSR SR104 CLASSIFY REASON 01050C* UPDATE HISTORY, IF CLOSE OUT. 01060C 70 EXSR SR105 UPDATE HIST FILE 01070C*------------------------------------------------------------------- 01080C TAG100 TAG 01090C* PRINT STATUS REPORT (DIABLO). 01100C EXSR SR106 PRINT. 01110C*------------------------------------------------------------------- 01120C END TAG 01130C******************************************************************** 01140CSR SR101 BEGSR 01150C* 1-TIME INIT. 01160CSR SETON 79 01170CSR MOVE UDATE W4N 40 01180CSR MOVELW4N MO 20 01190CSR MOVE W4N YR 20 01200CSR MOVELYR YRMO 4 01210CSR MOVE MO YRMO 01220CSR EXSR SR202 PRINT HEADING. 01230CSR ENDSR 01240C******************************************************************** 01250CSR SR102 BEGSR ÐÐ01260C* EVERY-TIME INIT. 01270CSR SETOF 70 01280C* 01290C* 01300C* 01310CSR ENDSR 01320C******************************************************************** 01330CSR SR103 BEGSR 01340C* CLASSIFY STATUS CODES. 01350CSR QMSCOD COMP 'E' 41 ENTERED. 01360CSR QMSCOD COMP 'N' 42 NO BID. 01370CSR QMSCOD COMP 'B' 43 BID. 01380CSR QMSCOD COMP 'P' 44 PENDING. 01390CSR QMSCOD COMP 'L' 45 LOST. 01400CSR QMSCOD COMP 'W' 46 WON. 01410CSR QMSCOD COMP 'C' 47 CANCELLED. 01420CSR SETOF 70 01430CSR 42 01440COR 45 01450COR 46 01460COR 47 SETON 70 CLOSE-OUT FLAG. 01470CSR ENDSR 01480C******************************************************************** 01490CSR SR104 BEGSR 01500C* CLASSIFY REASON. ÐÐ01510CSR QMREAS COMP '1' 31 PRICE. 01520CSR QMREAS COMP '2' 32 DELIVERY. 01530CSR QMREAS COMP '3' 33 SPECS. 01540CSR QMREAS COMP '4' 34 OTHER. 01550CSR ENDSR 01560C******************************************************************** 01570CSR SR105 BEGSR 01580C* UPDATE HISTORY FILE. 01590CSR MOVEAQMPCLS A26 01600CSR MOVEAYRMO A26,3 01610CSR MOVEAQMNAME A26,7 01620CSR MOVEAA26 W26A 26 01630CSR W26A CHAINQMHIST 78 01640CSR 78 EXSR SR201 INIT HIST. 01650CSR MOVELQMSCOD W2A 2 01660CSR MOVE QMREAS W2A 01670CSR Z-ADD1 X 30 01680CW W2A LOKUPQHR,X 54 01690CSRN54 Z-ADD1 X 01700CSRN54 ' ' LOKUPQHR,X 54 01710CSR MOVE W2A QHR,X STATUS/REASON. 01720CSR 1 ADD QHF,X QHF,X FREQ. 01730CSR QMAMT ADD QH$,X QH$,X AMOUNT. 01740CSR SETON 81 01750CSR EXCPT UPD HIST AND QM ÐÐ01760CSR SETOF 81 01770CSR ENDSR 01780C******************************************************************** 01790CSR SR106 BEGSR 01800C* PRINT STATUS REPORT ON DIABLO. 01810CSR LINENO COMP 55 54 01820CSR 54 EXSR SR202 PRINT HEADING. 01830CSR EXSR SR203 PRINT LINE. 01840CSR ENDSR 01850C******************************************************************** 01860CSR SR201 BEGSR 01870C* INIT QUOTE HIST FILE. 01880CSR MOVE ' ' QHR 01890CSR Z-ADD0 QHF 01900CSR Z-ADD0 QH$ 01910CSR ENDSR 01920C******************************************************************** 01930CSR SR202 BEGSR 01940C* PRINT HEADING. 01950CSR EXITFQTFORM TOP FORM. 01960CSR EXITFQMOVUP 01970CSR SETON 71 01980CSR EXCPT PRINT HEADING. 01990CSR SETOF 71 02000CSR EXITFQCLFCR LF/CR ÐÐ02010CSR Z-ADD2 LINENO 30 02020CSR ENDSR 02030C******************************************************************** 02040CSR SR203 BEGSR 02050C* PRINT LINE. 02060CSR EXITFQCLF LF ONLY. 02070CSR SETON 72 02080CSR EXCPT PRINT DATA. 02090CSR SETOF 72 02100CSR ENDSR 02110O******************************************************************** 02120OQMHIST EADD 81 78 02130O QMPCLS 2 02140O YRMO 6 02150O QMNAME 26 02160O QHR 46 02170O QHF 86P 02180O QH$ 166P 02190O*------------------------------------------------------------------- 02200O QHR 46 02210O QHF 86P 02220O QH$ 166P ** A26 ARRAY 002230 002240/* 002250ÐÐ_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d/Ö d*X901PI Pè999999120282(èÈÐ00010H Q901PI00020F* P. O. ITEM - DELETE INACTIVE RECORDS (X901PI) 00030F* REVISED 9/16/82 11:00 AM. 00040FPOMAST IP F 128 6AI 1 DISK 00050FOLDPI IS F 384 9AI 1 DISK 00060FPOITEM O F 384 9AI 1 DISK 00070E***************************************************************** 00080E PID 26 6 0A POITEM SCHED DATES 00090E PIQ 26 7 0A POITEM SCHED QTYS 00100I******************************************************************** 00110IPOMAST PO 01 128NCD 00120I* PURCHASE ORDER MASTER RECORD. 00130I* P.O. # 6A (KEY) 00140I 1 6 POPO L1M1 00150I* VENDOR # 5N 00160I 7 110POVEND 70 00170I* WORK ORDER/ACCOUNT 9A 00180I 27 35 POWO 00190I* DATE LAST RCPT 6N 00200I 80 850PIDLR 00210I GG 03 00220I******************************************************************** 00230IOLDPI OP 02 384NCD 00240I* PURCHASE ORDER ITEM RECORD. 00250I 1 256 RECA ÐÐ00260I 257 384 RECB 00270I* PO# 6A 00280I 1 6 PIPO L1M1 00290I* DATE LAST RECEIPT 6N 00300I 80 850PIDLR 00310I* QTY RECEIVED 7P 00320I P 86 890PIQRCD 00330I* QTY TO STK,SCRAP,RTV 7P 00340I P 90 930PIQSTK 00350I* WORK ORDER # 9A 00360I 100 108 PIWO 00370I 100 105 PIWOP 00380I 106 1080PIWOD 00390I* VENDOR 5P 00400I P 109 1110PIVEND 00410I* SCHEDULE DATES 6N X 26 (Y,M,D) 00420I 114 269 PID 00430I* SCHED QTYS 7P X 26 00440I P 270 373 PIQ 00450I PG 03 00460C N02 GOTO END 00470C XFOOTPIQ W7N 70 79 00480C PIWOP COMP ' 12100' 80 00490C N80 PIWOP COMP ' 14100' 80 00500C N80 PIWOP COMP ' 14600' 80 ÐÐ00510C N79 GOTO END 00520C N80 GOTO TAG10 00530C W7N SUB PIQRCD NOTRCD 70 54 00540C 54 GOTO END 00550C PIQRCD SUB PIQSTK NOTSTK 70 54 00560C 54 GOTO END 00570C EXSR SR102 00580C N60 GOTO END 00590C SETOF 02 00600C GOTO END 00610C*--------------------------------------------------------------- 00620C TAG10 TAG 00630C EXSR SR102 00640C N60 GOTO END 00650C W7N SUB PIQRCD NOTRCD 54 00660C N54 SETOF 02 00670C*------------------------------------------------------------------- 00680C END TAG 00690C******************************************************************** 00700CSR SR102 BEGSR 00710C* COMPUTE DEAD TIME 00720CSR MOVELUDATE W4N 40 00730CSR MOVE W4N CDAY 20 00740CSR MOVELW4N CMOS 20 00750CSR MOVE UDATE CYRS 20 ÐÐ00760CSR 12 MULT CYRS CURDAY 60 00770CSR 30 MULT CMOS W6N 60 00780CSR W6N ADD CURDAY CURDAY 00790CSR CDAY ADD CURDAY CURDAY 00800CSR MOVELPIDLR CYRS 00810CSR MOVE PIDLR W4N 00820CSR MOVELW4N CMOS 00830CSR MOVE W4N CDAY 00840CSR 12 MULT CYRS RCDDAY 60 00850CSR 30 MULT CMOS W6N 00860CSR W6N ADD RCDDAY RCDDAY 00870CSR CDAY ADD RCDDAY RCDDAY 00880CSR CURDAY SUB RCDDAY W6N 00890CSR W6N COMP 30 60 60 00900CSR ENDSR 00910O****************************************************************** 00920OPOITEM D 02 MR 00930O RECA 256 00940O RECB 384 00950O PIQRCD 89P 00960O PIQSTK 93P 00970O PIVEND 111P 00980O 70 POVEND 111P 00990O PIQ 373P /* 01000ÐÐ_‚_‚0CSR 12 MULT CYRS CURDAY 60 00770CSR 30 MULT CMOS W6N 60 00780CSR W6N ADD CURDAY CURDAY 00790CSR CDAY ADD CURDAY CURDAY 00800CSR MOVELPIDLR CYRS 00810CSR MOVE PIDLR W4N 00820CSR MOVELW4N CMOS 00830CSR MOVE W4N CDAY 00840CSR 12 MULT CYRS RCDDAY 60 00850CSR 30 MULT CMOS W6N 00860CSR W6N ADD RCDDAY RCDDAY 00870CSR CDAY ADD RCDDAY RCDDAY 00880CSR CURDAY SUB RCDDAY W6N 00890CSR W6N COMP 30 60 60 00900CSR ENDSR 00910O****************************************************************** 00920OPOITEM D 02 MR 00930O RECA 256 00940O RECB 384 00950O PIQRCD 89P 00960O PIQSTK 93P 00970O PIVEND 111P 00980O 70 POVEND 111P 00990O PIQ 373P /* 01000ÐÈ(È0 ÈTX309EM P¢¢120282120282(èÈÐ00010H Q309EM00020F* UPDATE EMPLOYEE MASTER DEDUCTIONS TAKEN IN PAYROLL 00030F* REVISED 12-03-82 10:30 A.M. 00040F* 00050FPYDEDFILIP F 124 DISK 00060FEMMAST2 UC F 1536R 5AI 1 DISK 00070FTERM80 O F 80 5 00080F********************************************************************* 00090E PRT 20 2 DED TYPE 00100E PRY 20 7 2 DED YTD 00110E*********************************************************************** 00120IPYDEDFILDD 00130I* EMP NP. 5N 00140I 1 50DDEMP 00150I* TYPE 2A 00160I 6 7 DDTYP 00170I* CURR AMT 7.2P 00180I P 9 122DDAMT 00190I* YTD AMT 7.2P 00200I P 13 162DDYTD 00210I* MASTER ELEMENT # 2N 00220I 115 1160SAVELM 00230I* CODE NOT TAKEN (X) 1A 00240I 123 123 DDABS 00250I*********************************************************************** ÐÐ00260IEMMAST2 EM 00270I* TYPE CODE 2A X 20 00280I 752 791 PRT 00290I* YTD AMT 7.2P X 20 00300I P11321211 PRY 00310I* LOCK (TAKEN FOR PAYROLL) 'L' 00320I 15341534 EMDEDL 00330I* RECORD STATUS 1A 00340I 15361536 EMSTAT 00350I************************************************************************ 00360C EXSR SR30 GET MASTER 00370C EXSR SR40 CK REC OK 00380C EXSR SR80 UPDATE DED YTD 00390C************************************************************************ 00400CSR SR30 BEGSR 00410CSR DDEMP CHAINEMMAST2 91 GET EMP MASTER 00420CSRN91 EMSTAT COMP 'D' 91DELETED 00430CSR 91 EXSR SR90 ERR MSG - ABORT 00440CSR MOVE ' ' EMDEDL REMOVE LOCK 00450CSR ENDSR 00460C************************************************************************ 00470CSR SR40 BEGSR 00480CSR Z-ADDSAVELM X 30 MASTER ARRAY ELEM 00490CSR DDTYP COMP PRT,X 58TYPE SAME? 00500CSRN58 SETON 92 ERR ÐÐ00510CSRN58 EXSR SR90 MSG - ABORT 00520CSR PRY,X COMP DDYTD 9292 OLD YTD SAME? 00530CSR 92 EXSR SR90 ERR MSG, ABORT 00540CSR DDABS COMP ' ' 58DED TAKEN? 00550CSR 58 DDAMT ADD PRY,X PRY,X ADD TO YTD 00560CSR ENDSR 00570C*********************************************************************** 00580CSR SR80 BEGSR 00590C* UPDATE MASTER WITH NEW DEDUCTION YTD 00600CSR SETON 80 00610CSR EXCPT 00620CSR SETOF 80 00630CSR ENDSR 00640C************************************************************************ 00650CSR SR90 BEGSR 00660C* PUT ERROR MESSAGES TO SCREEN AND ABORT 00670CSR SETON 90 00680CSR EXCPT 00690CSR SETON H1 00700CSR ENDSR 00710C*********************************************************************** 00720OEMMAST2 E 80 00730O PRY 1211P 00740O EMDEDL 1534 00750O************************************************************************ ÐÐ00760OTERM80 E 90 00770O 7 'EMP NO:' 00780O DDEMP Z 12 00790O 91 33 'MASTER NOT ON FILE' 00800O 92 38 'DEDUCTION ARRAY ELEMENT' 00810O 92 48 'NOT EQUAL' 00820O E 90 92 00830O 15 'TYPE' 00840O 28 'YTD' 00850O E 90 92 00860O 7 'MASTER:' 00870O PRT,X 15 00880O PRY,X J 29 00890O E 90 92 00900O 7 'UPDATE:' 00910O DDTYP 15 00920O DDYTD J 29 /* 00930_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–0V –?X011XP P120282120282(èÈÐ00010H Q011XP00020F* SELECT ONLY WORK ORDERS,PUR ORDERS,REQMTS THAT MATCH PMMST2 DGREL006 OK 00030F* REVISED 1/18/81 2:30 PM. 00040FDISK80 IP F 80 DISK 00050FXPDISK80O F 80 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070I******************************************************************** 00080IPMMST2 PM 00090I 674 674 PMSTAT 00100I******************************************************************** 00110IDISK80 WO 01 1 CW 2 CO 00120I* WORK ORDER TRANSACTION. 00130I 1 80 REC 00140I* JOB # 6A 00150I 3 8 WOJOB 00160I* ACCOUNT # 5N 00170I 9 130WOACNT 00180I* PART # 10N 00190I 14 230PN 00200I* DESCRIPTION 8A 00210I 25 32 WODESC 00220I* TOP ASSY WO 6N 00230I 33 380WOTAWO 00240I* CODE 1A (M=THIS IS TOP W/O) 00250I 39 39 WOCODE ÐÐ00260I* TOP MCN 5N 00270I 40 440WOTMCN 00280I* END ITEM SCHED DATE 5N (MMDDY) 00290I 45 490WOEISD 00300I* QTY 7N 00310I 50 560WOQTY 00320I* K-CODE (MAT'L ISSUED) 00330I 57 57 WOKODE 00340I* LOT # 2N 00350I 58 590WOLOT 00360I* MODEL 10A 00370I 60 69 WOMODL 00380I* START DATE 6N (YYMMDD) 00390I 71 760DUEDAT 00400I*------------------------------------------------------------------- 00410I RT 02 1 CR 2 CQ 56 C4 00420I* BACKORDER RECORD. 00430I OR 03 1 CR 2 CQ 56 C5 00440I* ALLOCATION RECORD. 00450I OR 02 1 CR 2 CQ 56 C6 00460I* BACKORDER RECORD. 00470I 1 80 REC 00480I* PART # 10N 00490I 3 120PN 00500I* DESCRIPTION 8A ÐÐ00510I 13 19 RTDESC 00520I* JOB # 6A 00530I 21 26 RTJOB 00540I* LOT # 3A (LXX) 00550I 27 29 RTLOT 00560I* TRANS DATE 5N (MMDDY) 00570I 31 350RTDATE 00580I* MCN # 5A 00590I 37 41 RTMCN 00600I* FAB CODE 2A 00610I 52 53 RTFABC 00620I* CARD CODE 1A 00630I* 4,6=BACKORDER 00640I* 5=ALLOCATION 00650I 56 56 RTCARD 00660I* QTY 6N 00670I 62 670RTQTY 00680I* START DATE 6N (FROM W/O) 00690I 71 760DUEDAT 00700I* INV TYPE 1A 00710I* 1 = F/G 00720I* 2 = DETAIL 00730I* 3 = S/A'S 00740I 79 79 RTINVC 00750I*------------------------------------------------------------------- ÐÐ00760I PO 04 1 CP 2 CO 00770I* PURCH ORD TRANSACTION. 00780I* PART # 10N 00790I 1 80 REC 00800I 3 120PN 00810I* DESCRIPTION 7A 00820I 13 19 PODESC 00830I* P.O. # 5N 00840I 22 260POPON 00850I* DUE DATE 6N (YYMMDD) 00860I 30 350DUEDAT 00870I* VENDOR # 5N 00880I 37 410POVEND 00890I* VENDOR NAME 10A 00900I 42 51 POVNAM 00910I* MO/DAY DUE 4N (MMDD) 00920I 52 550POMODU 00930I* PO CODE 2A ('P-O') 00940I 56 58 POPCOD 00950I* P-CODE 1A (P=FAB PER PRINT) 00960I 59 59 POPOCD 00970I* ITEM 2A 00980I 60 61 POITEM 00990I* QTY 6N 01000I 62 670POQTY ÐÐ01010I* PRICE 9.5N 01020I 69 765POPRIC 01030I* INV CODE 2A ('14') 01040I 78 79 POINVC 01050I*------------------------------------------------------------------- 01060I GG 07 01070C******************************************************************** 01080C 07 GOTO END 01090C MOVELPN W12A 12 01100C W12A CHAINPMMST2 07 01110C N07 PMSTAT COMP 'D' 07 01120C END TAG 01130O******************************************************************** 01140OXPDISK80D N07 01150O REC 80 /* 001160_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Š0– ŠX106BM P999999120282(èÈÐ00010H Q106BM00020F* INDENTED WHERE-USED - COMPLETE. (X106BM) 00030F* REV 8/10/82 5:30 PM. 00040F* MENU: MQBM02 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMWU ID F 21L20AI 1 DISK 00090FBMMAST IC F 86R20AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E NUL 50 50 1 NULL CHAR. 00140E N20 20 20 1 NULL CHAR. 00150E A12 12 12 1 A INPUT ARRAY. 00160E LEV 1 20 20 NEXT RRN AT EA LEVEL 00170E QTY 1 20 7 0 00180E DASH 1 122 1 00190E LNK 1 7 6 A 00200E CALL 7 6 00210E PAR 25 1 00220E TST 25 1 00230E BIT 33 1 BITTAB. 00240I******************************************************************** 00250IBITPAR BT ÐÐ00260I 1 33 BIT 00270I 34 58 PAR 00280I 59 83 TST 00290I******************************************************************** 00300ICRTFILE CR 00310I 28 330CRTIME 00320I 34 370CRDATE 00330I 38 79 CALL 00340I**************************************************************** 00350IBMWU BW 00360I 1 100BWCPN 00370I 11 200BWAPN 00380I 21 21 BWSTAT 00390I******************************************************************** 00400IPMMST2 PM 00410I* PART MASTER RECORD (XPMMST) 00420I* KEY AREA 00430I* PART NO. 12A 00440I 1 12 PMPN 00450I* PROD LINE 4N 00460I 15 180PMPL 00470I* MODEL NAME 12A 00480I 19 30 PMMODL 00490I* DESCRIPTION 29A 00500I 31 59 PMDESC ÐÐ00510I* COMMODITY CODE 9P 00520I P 60 640PMCC 00530I* ENG CHANGE STATUS. 00540I* CUR CHG LEVEL 2A 00550I 70 71 PMECHG 00560I* CUR CHG DATE 6N 00570I 72 770PMDCHG 00580I* LAST ECN NO. 5A 00590I 65 69 PMECN 00600I* DRAWING INFO 00610I* DWG SIZE 1A 00620I 82 82 PMSIZ 00630I* DWG CLASS 1A 00640I* D = DYNAIR DWG 00650I* V = VENDOR DWG 00660I 83 83 PMDCLS 00670I* STANDARD CODE 1A 00680I 84 84 PMSTDC 00690I* DWG REL CODE 1A 00700I* E = ENG ONLY 00710I* M = REL TO MFG 00720I* P = PROTOTYPE 00730I 78 78 PMDREL 00740I* UNIT MEAS 2A 00750I* EA = EACH OC = OUNCE ÐÐ00760I* ST = SET TC = TROY OUNCE 00770I* IN = INCH LB = POUND 00780I* FT = FEET PT = PINT 00790I* YD = YARD QT = QUART 00800I* SI = SQ.INCH GL = GALLON 00810I* SF = SQ.FEET DR = DRUM 00820I* SY = SQ.YARD 00830I 85 86 PMUM 00840I* SOURCE CODE 2A 00850I* MA = MFG ASSY 00860I* MP = MFG PART 00870I* PA = PURCH ASSY 00880I* PP = PURCH PART 00890I* RS = RAW STOCK 00900I 94 95 PMSC 00910I* PROVISIONING CODE 1A 00920I* A = FORECAST,NO VALUE ADDED 00930I* B = FORECAST,VALUE ADDED 00940I* C = BUILD TO ORDER (B) 00950I* D = BUILD TO ORDER (NOT B) 00960I* E = CUSTOM 00970I* Y = OBSOLETE,REPAIRABLE 00980I* Z = OBSOLETE,NOT REPAIRABLE 00990I 96 96 PMPROV 01000I* ISSUE CODE 2A ÐÐ01010I* PT = PULL TIME 01020I* OR = ON REQUEST 01030I* BI = BULK ISSUE 01040I* AR = AS REQUIRED 01050I* VS = VENDOR SUPPLIED 01060I* SD = SHIPPING DOCUMENT 01070I* TD = TRAV DOCUMENT 01080I* RD = REF DOCUMENT 01090I* RA = REF ASSY 01100I 97 98 PMISSU 01110I* DELIVER TO DEPT 5P 01120I P 99 1010PMDEL 01130I* RESPONSIBILITY CODES 01140I* ENGR CODE 2A 01150I 102 103 PMEGR 01160I* PLANNER CODE 2A 01170I 104 105 PMPLNR 01180I* BUYER CODE 2A 01190I 106 107 PMBUYR 01200I* SALESMAN CODE 2A 01210I 108 109 PMSLSM 01220I* INVENTORY ACCOUNT 5P 01230I P 110 1120PMACNT 01240I* FAB CODE 2A 01250I 487 488 PMFABC ÐÐ01260I* RECORD STATUS 1A 01270I* D = DELETED 01280I 674 674 PMSTAT 01290I******************************************************************** 01300IBMMAST BM 01310I* BILL OF MATERIAL RECORD 01320I* KEY AREA 01330I* ASSY PART NO. 10N 01340I 1 100BMAPN 01350I* COMPONENT PART # 10N 01360I 11 200BMCPN 01370I* ITEM NO. 3N 01380I 25 270BMITNO 01390I* QTY PER ASSY 7P 01400I P 28 310BMQTY 01410I* SCRAP ALLOW .2N 01420I 34 352BMSCRP 01430I* ISSUE CODE 2A 01440I* PT = PULL TIME 01450I* OR = ON REQUEST 01460I* BI = BULK ISSUE 01470I* AR = AS REQUIRED 01480I* RA = REF ASSY 01490I* TD = TRAV DOC 01500I* SD = SHIP DOC ÐÐ01510I* RD = REF DOC 01520I* VS = VENDOR SUPPLIED 01530I 36 37 BMISSU 01540I* EFFECTIVITY. 01550I* BEGIN CHANGE LEVEL 2A 01560I 38 39 BMBCHG 01570I* ENDING CHANGE LEVEL 2A 01580I 40 41 BMECHG 01590I* BEGIN ECN # 5A 01600I 42 46 BMBECN 01610I* ENDING ECN # 5A 01620I 47 51 BMEECN 01630I* DISPOSITION CODE 1A 01640I* U = USE UP OLD STYLE 01650I* N = NOW (IMMEDIATE) 01660I 52 52 BMDISP 01670I* FILLER 5A 53 57 FFFFFF 01680I* ROUTING. 01690I* OPER NO. 5P 01700I P 58 600BMOPER 01710I* DEPT NO. 5P 01720I P 61 630BMDEPT 01730I* WORK CENTER NO. 3P 01740I P 64 650BMWC 01750I* COMPONENT OPER REFERENCE INFO 10A ÐÐ01760I 66 75 BMREF 01770I* FILLER 10A 76 85 FFFFFF 01780I* 01790I* RECORD STATUS 1A 01800I* D = DELETED 01810I 86 86 BMSTAT 01820I******************************************************************** 01830IMGFILE MG 01840I* MESSAGE FILE. 01850I* TEXT 35A 01860I 1 35 MGTEXT 01870I* LINE-2 35A 01880I 36 70 MGLIN2 01890I* PROG NAME 5A 01900I 71 75 MGPROG 01910C******************************************************************** 01920C* INITIALIZE 01930C EXSR SR101 INIT 01940C MOVE ' ' BLK6 6 01950C EXSR SR70 CLEAR SCREEN 01960C*---------------------------------------------------------------- 01970C START TAG 01980C* GET ASSY PART NO FROM TERMINAL 01990C SETOF 79 02000C Z-ADD0 LASTL 30 ÐÐ02010C SETOF 9693 02020C Z-ADD188 M 50 MSG # 02030C EXSR SR73 PROMPT 02040C EXSR SR75 READ 02050C 96 GOTO START ERROR 02060C 93 GOTO START NEW ITEM REQST 02070C N77 GOTO START NO INPUT 02080C Z-ADD12 W2N 20 02090C EXIT SUBRAJ R. JUSITFY 02100C RLABL W2N 02110C RLABL W12A 02120C MOVE W12A TCPN 100 COMPONENT PN 02130C MOVE BLK12 W12A 02140C MOVELTCPN W12A 02150C EXSR SR81 GET PMMST2 02160C N60 GOTO TAG10 GOT IT 02170C Z-ADD302 M 96 FLAG ERROR 02180C EXSR SR73 PUT MSG 02190C GOTO START 02200C*-------------------------------------------------------------------- 02210C TAG10 TAG 02220C* PUT HEADING. DISPLAY COMPONENT DATA LINE. 02230C Z-ADD1 QTY,2 02240C SETON 89 02250C EXSR SR71 PUT HEADING ÐÐ02260C SETOF 89 02270C* SET-UP INITIAL BILL MATERIAL READ 02280C Z-ADD3 L 20 INDENTURE LEVEL 02290C MOVE BLK20 LEV 02300C MOVELTCPN LEV,2 02310C*----------------------------------------------------------------- 02320C TAG20 TAG 02330C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02340C L SUB 1 L 54 INDENT LEVEL 02350C N54 GOTO ENDASY BOTTOM INDENT 02360C LEV,L COMP BLK20 54 02370C N54 GOTO TAG20 NONE THIS LEVEL 02380C 79 SETON 78 02390C SETON 79 02400C MOVE LEV,L W20A 20 02410C MOVELLEV,L CURASY 100 MATCH PART # 02420C MOVE BLK20 LEV,L 02430C Z-ADDQTY,L CUMQTY 70 02440C*------------------------------------------------------------------ 02450C TAG30 TAG 02460C* SET-UP NEXT READ 02470C W20A SETLLBMWU 02480C*--------------------------------------------------------------- 02490C TAG40 TAG 02500C* GET NEXT COMPONENT. ÐÐ02510C SETOF 54 02520C READ BMWU 54GET COMPONENT 02530C 54 GOTO TAG20 END OF FILE 02540C BWCPN COMP CURASY 54 02550C N54 GOTO TAG20 WRONG COMPONENT 02560C BWSTAT COMP 'D' 54 02570C 54 GOTO TAG40 DELETED RECORD 02580C* DISPLAY COMPONENT DATA 02590C EXSR SR72 DISPLAY DATA 02600C 93 GOTO START 02610C*------------------------------------------------------------------ 02620C TAG50 TAG 02630C* SAVE CUR LEVEL COMP/ASSEMBLY PART # 02640C MOVELBWCPN LEV,L 02650C 1 ADD BWAPN W10N 100 02660C MOVE W10N LEV,L 02670C Z-ADDCUMQTY QTY,L 02680C Z-ADDEXTQTY CUMQTY 02690C MOVE BWAPN CURASY 02700C MOVELBWAPN W20A 02710C MOVE ZERO10 W20A 02720C 1 ADD L L INDENT LEVEL 02730C GOTO TAG30 02740C*------------------------------------------------------------------ 02750C ENDASY TAG ÐÐ02760C* END OF ASSY PROMPT 02770C EXSR SR76 END ASSY PROMPT 02780C GOTO START 02790C*----------------------------------------------------------------- 02800C MENU TAG 02810C* SET RETURN TO MENU LINKAGE 02820C EXSR SR96 GET CRTFILE 02830C Z-ADD1 W 02840C BLK6 LOKUPLNK,W 54 02850C 54 MOVELLNK,W PROG 02860C 54 MOVE BLK6 LNK,W 02870C N54 MOVEL'CONTU' PROG 8 02880C EXSR SR97 UPD CRTFILE 02890C EXSR SR98 >>>>>>>>>> 02900C*----------------------------------------------------------------- 02910C GOODBY TAG 02920C* SET ABORT LINKAGE 02930C MOVEL'GOODBY' PROG 02940C GOTO END 02950C*----------------------------------------------------------------- 02960C END TAG 02970C* LINK TO NEXT PROG 02980C EXSR SR96 GET CRTFILE 02990C EXSR SR97 UPD CRTFILE 03000C EXSR SR98 >>>>>>>>>> ÐÐ03010C*------------------------------------------------------------------ 03020C ENDJOB TAG 03030C MOVEL'ENDJOB 'PROG 03040C EXSR SR98 >>>>>>>>>> 03050C******************************************************************** 03060CSR SR70 BEGSR 03070CSR 50 EXITFZISTAT 03080CSR 50 EXITFZESCH 03090CSRN50 EXITFZCPAGE 03100CSRN50 MOVEL'091' RPGLIN 4 03110CSRN50 MOVEL'001' RPGCOL 4 03120CSRN50 EXITFZMOVXY 03130CSR RLABL RPGLIN 03140CSR RLABL RPGCOL 03150CSR ENDSR 03160C******************************************************************** 03170CSR SR71 BEGSR 03180C* CLEAR CRT. PUT HEADINGS. 03190CSR EXSR SR70 CLEAR SCREEN 03200CSR Z-ADD4 COUNT 30 LINE COUNT 03210CSR MOVELTCPN W12A 03220CSR MOVE ' ' W12A 03230CSR EXSR SR81 GET COMPONENT PMMST2 03240CSR SETON 71 03250CSR EXCPT PUT HEADING ÐÐ03260CSR SETOF 71 03270CSR PMMODL COMP BLK12 54 03280CSR 54 MOVE BLK35 PMDESC 03290CSR 54 MOVELPMMODL PMDESC 03300CSR 54 MOVE '***' PMDESC 03310CSR SETON 75 03320CSR EXCPT PUT COMPONENT DATA 03330CSR SETOF 75 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR72 BEGSR 03370C* DISPLAY DATA LINE TO CRT. 03380CSR 1 ADD COUNT COUNT CRT LINE COUNT 03390CSR MOVELBWAPN W20A 03400CSR MOVE BWCPN W20A 03410CSR W20A CHAINBMMAST H7 03420CSR H7 GOTO END72 03430CSR MOVE BLK12 W12A 03440CSR MOVELBMAPN W12A ASSY PN 03450CSR EXSR SR81 GET PMMST2 03460CSR PMMODL COMP BLK12 54 03470CSR 54 MOVE BLK35 PMDESC 03480CSR 54 MOVELPMMODL PMDESC 03490CSR 54 MOVE '***' PMDESC 03500CSR L COMP 1 0101 ÐÐ03510CSR L COMP 2 02 03520CSR L COMP 3 03 03530CSR L COMP 4 04 03540CSR L COMP 5 05 03550CSR L COMP 6 06 03560CSR L COMP 7 07 07 03570CSR 01 Z-ADD1 L 03580CSR BMISSU COMP ' ' 55 03590CSR CUMQTY MULT BMQTY EXTQTY 70 03600CSR Z-ADDL LASTL 30 03610CSR 78 1 ADD COUNT COUNT 03620CSR 78 SETON 76 03630CSR 78 EXCPT PUT DASH 03640CSR SETOF 7678 03650CSR SETON 72 03660CSR EXCPT PUT DATA. 03670CSR SETOF 72 03680CSR 50 COUNT COMP 23 54 54 03690CSRN50 COUNT COMP 28 54 54 03700CSRN54 GOTO END72 NOT END PAGE 03710CSR EXITFQEPAGE END PAGE MSG 03720CSR EXSR SR75 READ 03730CSR 93 GOTO END72 03740CSR EXSR SR71 PUT HEADINGS 03750CSR END72 ENDSR ÐÐ03760C******************************************************************** 03770CSR SR73 BEGSR 03780C* PUT PROMPT TO CRT. 03790CSR EXSR SR89 03800CSR 54 MOVELM MGTEXT 03810CSR 2 ADD COUNT COUNT 03820CSR SETON 73 03830CSR EXCPT PUT PROMPT. 03840CSR SETOF 73 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR75 BEGSR 03880C* READ CRT. 03890CSR T75 TAG 03900CSR SETOF 909493 03910CSR SETOF 7796 03920CSR MOVE BLK12 W12A 12 03930CSR EXITFZR12 READ CRT 03940CSR RLABL W12A 03950CSR MOVEAW12A A12 03960CSR MOVE BLK12 W12A 03970CSR Z-ADD1 W 20 03980CSR '\' LOKUPA12,W 90 03990CSRN90 GOTO T75A NOT ESC. 04000CSR 1 ADD W W ÐÐ04010CSR W COMP 12 54 04020CSR 54 GOTO T75C BAD ESC. 04030CSR A12,W COMP 'E' 94 EXIT. 04040CSR A12,W COMP 'N' 93 NEW ASSY. 04050CSR A12,W COMP 'G' 98 GOODBY 04060CSR 98 GOTO GOODBY 04070CSR 94 GOTO MENU 04080CSR 93 GOTO END75 04090CSR GOTO T75C 04100C*------------------------------------------------------------------- 04110CSR T75A TAG 04120CSR Z-ADD1 W 04130CSR ' ' LOKUPA12,W 77 04140CSR 77 MOVEAA12,W W12A INPUT DATA. 04150CSR GOTO END75 04160C*------------------------------------------------------------------- 04170CSR T75C TAG 04180C* FLAG BAD ESCAPE. 04190CSR Z-ADD318 M 96 04200CSR EXSR SR73 FLAG ERROR. 04210CSR GOTO T75 04220CSR END75 ENDSR 04230C******************************************************************** 04240CSR SR76 BEGSR 04250C* END OF WHERE-USED PROMPT/READ. ÐÐ04260CSR SETON 76 04270CSR EXCPT PUT DASHES 04280CSR SETOF 7679 04290CSR 1 ADD COUNT COUNT 04300CSR Z-ADD317 M 04310CSR EXSR SR73 PUT MSG. 04320CSR EXSR SR75 04330CSR ENDSR 04340C******************************************************************** 04350CSR SR81 BEGSR 04360C* GET PART MAST. 04370CSR W12A CHAINPMMST2 60 GET PMMST. 04380CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE. 04390CSR ENDSR 04400C******************************************************************** 04410CSR SR89 BEGSR 04420C* GET MGFILE. 04430CSR M CHAINMGFILE 54 GET MGFILE. 04440CSR 54 MOVE BLK35 MGTEXT 04450CSR 54 MOVELM MGTEXT 04460CSR 54 MOVE 'NO MSG' MGTEXT 04470CSR ENDSR 04480C******************************************************************* 04490CSR SR96 BEGSR 04500CSR # CHAINCRTFILE H9 GET CRTFILE ÐÐ04510CSR H9 GOTO ENDJOB 04520CSR ENDSR 04530C******************************************************************** 04540CSR SR97 BEGSR 04550C* UPDATE CRTFILE. EXIT PROGRAM. 04560CSR TIME CRTIME 04570CSR MOVELUDATE CRDATE 04580CSR SETON 97 04590CSR EXCPT UPD CRTFILE 04600CSR SETOF 97 04610CSR ENDSR 04620C******************************************************************** 04630CSR SR98 BEGSR 04640CSR EXSR SR70 CLEAR SCREEN 04650CSR EXITFCHAIN >>>>>>>>>> 04660CSR RLABL PROG 04670CSR ENDSR 04680C******************************************************************** 04690CSR SR101 BEGSR 04700C* INITIALIZE (1-TIME). 04710CSR MOVE BIT,1 N20 04720CSR MOVE BIT,1 NUL INIT NULL CHAR. 04730CSR MOVE '-' DASH 04740CSR MOVE ' ' W2A 2 04750CSR EXITFZGMINX ÐÐ04760CSR RLABL W2A 04770CSR MOVE W2A # 20 04780CSR # COMP 0 54 04790CSRN54 Z-ADD25 # 04800CSR EXSR SR96 GET CRTFILE 04810CSR MOVE 'Q106BM 'PROG 04820CSR MOVE CALL LNK 04830CSR PAR,# COMP '1' 50 04840CSR TST,# COMP 'S' 54 04850CSR 54 MOVE 'SHUTDOWN'PROG 04860CSR EXSR SR97 UPD CRTFILE 04870CSR 54 EXSR SR98 >>>>>>>>>> 04871CSR MOVE ' 'PROG 04880CSR MOVE ' ' BLK35 35 04890CSR MOVE ' ' BLK12 12 04900CSR MOVE ' ' BLK20 20 04910CSR Z-ADD0 ZERO10 100 04920CSR ENDSR 04930O******************************************************************** 04940OTERM132 E 72 04950O* ASSY DATA LINE. 04960O 11 '.' 04970O 14 '.' 04980O 17 '.' 04990O 20 '.' ÐÐ05000O 23 '.' 05010O 26 '.' 05020O 29 '.' 05030O 02 29 ' ' 05040O 03 29 ' ' 05050O L Z 2 05060O BMITNOZ 8 05070O 01 BMAPN 22 ' - - ' 05080O 02 BMAPN 25 ' - - ' 05090O 03 BMAPN 28 ' - - ' 05100O 04 BMAPN 31 ' - - ' 05110O 05 BMAPN 34 ' - - ' 05120O 06 BMAPN 37 ' - - ' 05130O 07 BMAPN 40 ' - - ' 05140O PMDESC 71 05150O BMQTY 2 82 05160O PMUM 86 05170O PMSC 92 05180O PMISSU 98 05190O 55 BMISSU 98 05200O PMPROV 103 05210O EXTQTY2 115 05220O PMSTDC 119 05230O PMFABC 125 05240O*------------------------------------------------------------------- ÐÐ05250O E 76 05260O DASH 132 05270O*------------------------------------------------------------------- 05280O E 75 05290O* PUT COMPONENT LINE. 05300O 2 '1' 05310O TCPN 22 ' - - ' 05320O N89 29 'CONT''D' 05330O PMDESC 71 05340O PMUM 86 05350O PMISSU 98 05360O PMSC 92 05370O PMPROV 103 05380O PMSTDC 119 05390O PMFABC 125 05400O*------------------------------------------------------------------- 05410O E 73 05420O* PUT ERROR MESSAGE. 05430O NUL 50 05440O NUL 100 05450O NUL 132 05460O MGTEXT 35 05470O 37 ' ' 05480O 96 BIT,8 132 05490O*------------------------------------------------------------------- ÐÐ05500O E 71 05510O* CLEAR SCREEN - LINE-1. 05520O BIT,28 1 05530O N50 8 '8091001' 05540O N50 BIT,1 9 05550O N50 BIT,1 10 05560O 50 10 '[001 ]001' 05570O 50 BIT,28 6 05580O UDATE 18 ' - - ' 05590O 81 'INDENTED WHERE-USED' 05600O 94 'COMPONENT=' 05610O TCPN 106 ' - - ' 05620O*------------------------------------------------------------------- 05630O E 71 05640O* HEADING, LINE-2. 05650O 26 '--------------INDENTURE' 05660O 40 '--------------' 05670O 82 'QUANTITY' 05680O 94 'SOURCE' 05690O 100 'ISSUE' 05700O 105 'PROV' 05710O 115 'EXTENDED' 05720O 120 'STD' 05730O 126 'FAB' 05740O*------------------------------------------------------------------- ÐÐ05750O E 71 05760O* HEADING, LINE-3. 05770O 3 'LEV' 05780O 8 'ITEM' 05790O 29 '1 2 3 4 5 6 7' 05800O 32 '-UP' 05810O 53 'DESCRIPTION' 05820O 82 'PER-ASSY' 05830O 86 'UM' 05840O 93 'CODE' 05850O 99 'CODE' 05860O 105 'CODE' 05870O 115 'QUANTITY' 05880O 121 'CODE' 05890O 127 'CODE' 05900O E 71 05910O* HEADING, LINE-4 (BLANK). 05920O 1 ' ' 05930O******************************************************************** 05940OCRTFILE E 97 05950O PROG 26 05960O CRTIME 33 05970O CRDATE 37 05980O LNK 79 ** NUL ARRAY 005990ÐÐ 006000** N20 ARRAY 006010 006020** A12 ARRAY 006030 006040** LEV ARRAY 006050 006060** QTY ARRAY 006070 006080** DASH ARRAY 006090 006100** LNK ARRAY 006110 06120/* 06130_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Èh× ÈTX012CD Ppz061583061583(èÈÐ00010H Q012CD00020F* LIST MANUFACTURERS BY THEIR VENDOR SUPPLIERS 00030F* REVISED 04-16-84 11:00 AM 00040FVNDTXT IP F 80 DISK 00050FVMMAST IC F 384R 5AI 1 DISK 00060FMFRNAME IC F 32R 5AI 1 DISK 00070FPRINT O F 132 OF PRINTER 00080E******************************************************************** 00090IVNDTXT MF 00100I* VND CODE 5N 00110I 1 50VEND L1 00120I* MFR CODE 5A 00130I 6 10 CDMFR 00140I************************************************************************ 00150IVMMAST VM 00160I* VENDOR NO. KEY 5N 00170I 1 50VMVEND 00180I* VENDOR NAME 20A 00190I 6 25 VMSORT 00200I********************************************************************** 00210IMFRNAME MF 00220I* MFR CODE 5A 00230I 1 5 MFRCOD 00240I* MFR NAME 25A 00250I 6 30 MFRNAM ÐÐ00260I************************************************************************ 00270C N99 EXSR SR10 00280C L1 EXSR SR30 00290C EXSR SR20 GET MFR,VEND 00300C*-------------------------------------------------------------------- 00310C END TAG 00320C******************************************************************* 00330CSR SR10 BEGSR 00340C* INIT 00350CSR SETON 99 1 TIME 00360CSR Z-ADD0 ZERO5 50 00370CSR MOVE ' ' W5A 5 00380CSR ENDSR 00390C********************************************************************** 00400CSR SR20 BEGSR 00410CSR MOVE CDMFR W5A 00420CSR W5A CHAINMFRNAME 54 00430CSRN54 SETON 31 00440CSR SETON 60 00450CSR EXCPT MFR LINE 00460CSR SETOF 3160 00470CSR ENDSR 00480C******************************************************************* 00490CSR SR30 BEGSR 00500C* GET VENDORS ÐÐ00510CSR MOVE VEND W5A 5 00520CSR W5A CHAINVMMAST 54 00530CSRN54 SETON 41 00540CSR SETON 61 00550CSR EXCPT SPACE 00560CSR SETOF 61 00570CSR SETON 70 00580CSR EXCPT LIST VENDOR 00590CSR SETOF 4170 00600CSR ENDSR 00610C******************************************************************** 00620OPRINT H 203 1P 00630O OR OF 00640O UDATE 8 ' - - ' 00650O 45 'VENDORS WITH THEIR' 00660O 59 'MANUFACTURERS' 00670O PAGE Z 132 00680O 128 'PAGE' 00690O*--------------------------------------------------------------------- 00700O H 2 1P 00710O OR OF 00720O 24 'CODE' 00730O 34 'VENDORS' 00740O 58 'CODE' 00750O 74 'MANUFACTURERS' ÐÐ00760O*-------------------------------------------------------------------- 00770O E 1 61 00780O 1 ' ' 00790O*-------------------------------------------------------------------- 00800O EF 60 00810O 31 MFRNAM B 86 00820O CDMFR 59 00830O N31 61 '***' 00840O*--------------------------------------------------------------------- 00850O EF 1 70 00860O 41 VMSORT B 47 00870O VEND Z 24 /* 00880_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ô29 ôÑX013CM P X120282120282(èÈÐ00010H Q013CM00020F* PRINT CUSTOMER MAST LABELS BY SELECTED CUST CLASS, EXPORT CODES.(X013CM)00030F* REVISED 3/22/82 3:25 PM. *** D I A B L O *** 00040F* 00050F* SWITCH-2 CONDITIONS PRINTING MAILER,CLASS,EXPORT CODES 1ST LINE 00060F* SWITCH-1 CONDITIONS MATCH/BYPASS PRIOR TO SPECIFIED CUST # 00070F* 00080FBITTAB IP F 33 DISK 00090FCMSELECTIS F 128 DISK 00100FCMMAST IS F 576R 5I 1 DISK 00110FCMADRT IR F 300 3 3IT EDISK 00120FTERM50 O F 50 5 00130E******************************************************************** 00140E CMADRT CMMAST 00150E TABSTC 1 58 2 TABSCN 20 STATE NAMES. 00160E TABCLC 1 17 2 TABCLN 20 CUST CLASS NAMES. 00170E TABTAX 1 5 1 TABTAN 20 TAX CODES. 00180E TABTER 1 5 3 TABTN 20 TERRITORY NAMES 00190E A36 36 36 1 A 00200E NUL 1 50 1 00210E BIT 33 1 00220E CMA 7 35 A 00230E CMB 10 9 2 00240E CMS 10 9 2 00250E CMAR 4 9 2 ÐÐ00260E CMD 5 7 0 00270E CMM 3 3 00280E CMC 3 2 0 00290E CLN 8 1 CLASS NOT 00300E CLC 8 2 A CLASS CODE 00310E CEN 8 1 EXPORT NOT 00320E CEC 8 1 A EXPORT CODE 00330I******************************************************************** 00340IBITTAB BT 00350I 1 33 BIT 00360I******************************************************************** 00370ICMSELECTCS 01 00380I* SELECTION CODES RECORD. 00390I* CLASS CODES. 00400I 1 1 CLN,1 00410I 3 4 CLC,1 00420I 6 6 CLN,2 00430I 8 9 CLC,2 00440I 11 11 CLN,3 00450I 13 14 CLC,3 00460I 16 16 CLN,4 00470I 18 19 CLC,4 00480I 21 21 CLN,5 00490I 23 24 CLC,5 00500I 26 26 CLN,6 ÐÐ00510I 28 29 CLC,6 00520I 31 31 CLN,7 00530I 33 34 CLC,7 00540I 36 36 CLN,8 00550I 38 39 CLC,8 00560I* EXPORT CODES. 00570I 41 41 CEN,1 00580I 43 43 CEC,1 00590I 45 45 CEN,2 00600I 47 47 CEC,2 00610I 49 49 CEN,3 00620I 51 51 CEC,3 00630I 53 53 CEN,4 00640I 55 55 CEC,4 00650I 57 57 CEN,5 00660I 59 59 CEC,5 00670I 61 61 CEN,6 00680I 63 63 CEC,6 00690I 65 65 CEN,7 00700I 67 67 CEC,7 00710I 69 69 CEN,8 00720I 71 71 CEC,8 00730I******************************************************************** 00740ICMMAST CM 02 576NCD 00750I* CUSTOMER MASTER. ÐÐ00760I* CUSTOMER NO. 5N 00770I 1 50CMCUST 00780I* SORT (ALT) KEY 20A 00790I 6 25 CMSORT 00800I* ADDRESS 35A X 7 00810I 26 270 CMA 00820I* STATE CODE 2A 00830I 271 272 CMSTCD 00840I* ZIP CODE 9P 00850I P 273 2770CMZIP 00860I* PHONE NO. 15A 00870I 278 292 CMPHON 00880I* CONTACT NAME 35A 00890I 293 327 CMCONT 00900I* REMARKS 35A 00910I 328 362 CMREM 00920I* CUSTOMER CLASS 2A 00930I 363 364 CMCLAS 00940I* TERRITORY CODE 3A 00950I 365 367 CMTER 00960I* CREDIT LIMIT 7P 00970I P 368 3710CMCRLM 00980I* PAYMENT TERMS 8A 00990I 372 379 CMTERM 01000I* NUMBER OF INVOICE COPIES 1N ÐÐ01010I 380 3800CMINV 01020I* SHIPPING METHOD 20A 01030I 381 400 CMSHIP 01040I* CURRENT BACKLOG 9.2P X 10 01050I P 401 450 CMB 01060I* LAST 12-MOS SHIPMENTS 9.2P X 10 01070I P 451 500 CMS 01080I* CURRENT RECEIVABLES 9.2P X 4 01090I P 501 520 CMAR 01100I* TAX CODE 1A 01110I 521 521 CMTAX 01120I* STD DISCOUNT 3.2P 01130I P 522 5232CMDISC 01140I* EXPORT CODE 1A 01150I 524 524 CMEXPT 01160I* DATE HISTORY 7P X 5 01170I* 1 = DATE INPUT 01180I* 2 = DATE LAST ORDER 01190I* 3 = DATE LAST SHIPMENT 01200I* 4 = NOT USED 01210I* 5 = NOT USED 01220I P 525 544 CMD 01230I* GEOGRAPHIC CODE 5A 01240I 545 549 CMGEO 01250I* HOLD CODE 1A ÐÐ01260I 550 550 CMHOLD 01270I* MAILING CODES. 01280I* MAILER CODES 3 X 3A 01290I 551 559 CMM 01300I* NUMB OF COPIES 3 X 2N 01310I 560 565 CMC 01320I* POINTERS. 01330I* CREDIT CHANGES 5P 01340I P 575 5750CMFCC 01350I* RECORD STATUS 1A 01360I 576 576 CMSTAT 01370I GG 03 01380C******************************************************************** 01390C N79 EXSR SR101 01400C N02 GOTO END 01410C U1 CMCUST COMP BEGKEY 54 01420C U1 54 SETON 90 01430C U1N90 GOTO END 01440C Z-ADD0 X 30 01450C SETOF 98 01460C*------------------------------------------------------------------- 01470C START TAG 01480C SETOF 99 01490C 1 ADD X X 01500C X COMP 8 54 ÐÐ01510C 54 GOTO END 01520C CMCLAS COMP ' ' 55 CUST CLASS EXISTS 01530C CMCLAS COMP CLC,X 56 CUST = SELECT 01540C CLC,X COMP ' ' 57 SEL CLAS EXISTS 01550C CLN,X COMP ' ' 58 NOT NOT ON 01560C 57 58 GOTO START 01570C 56N58 SETON 99 = 01580C 58N57N56 SETON 99 NOT = 01590C 99 GOTO START 01600C CMEXPT COMP ' ' 55 01610C CMEXPT COMP CEC,X 56 01620C CEC,X COMP ' ' 57 01630C CEN,X COMP ' ' 58 01640C 57 58 99 GOTO START 01650C 57 58 SETON 98 01660C 57 58 GOTO END 01670C 56N58 01680COR 58N57N56 SETON 99 01690C 99 GOTO START 01700C SETON 98 01710C*------------------------------------------------------------------- 01720C END TAG 01730C N98 SETOF 02 01740C 02 EXSR SR102 01750C******************************************************************** ÐÐ01760CSR SR101 BEGSR 01770CSR MOVELBIT,1 BUFLGT 2 01780CSR EXITFQLF8 SET DIABLO 8-LPI 01790CSR SETON 79 01800CSR MOVE BIT,1 NUL 01810CSR MOVE ' ' BLK35 35 01820CSR MOVE ' ' BLK36 36 01830CSR U1 SETON 85 01840CSR U1 EXCPT REQUEST CUST # 01850CSR U1 SETOF 85 01860CSR U1 MOVE BIT,4 BUFLGT 01870CSR U1 MOVE ' ' W6A 6 01880CSR U1 EXITFQWREED READ BEG KEY 01890CSR RLABL W6A 01900CSR RLABL BUFLGT 01910CSR U1 Z-ADD6 W2N 20 01920CSR U1 EXIT SUBRAJ R.J. 01930CSR RLABL W2N 01940CSR RLABL W6A 01950CSR U1 MOVE W6A BEGKEY 50 01960C*------------------------------------------------------------------ 01970CSR T101A TAG 01980CSR SETON 84 01990CSR COUNT COMP 8 54 02000CSR 54 EXITFQCLF LINE FEED ÐÐ02010CSRN54 EXCPT 02020CSR SETOF 84 02030CSR 1 ADD COUNT COUNT 02040CSR COUNT COMP 12 54 54 02050CSRN54 GOTO T101A 02060CSR MOVE BIT,3 BUFLGT 02070CSR MOVE ' ' W4A 4 02080CSR EXITFQWREED READ CRT 02090CSR RLABL W4A 02100CSR RLABL BUFLGT 02110CSR MOVE ' ' A36 02120CSR MOVEAW4A A36 02130CSR Z-ADD1 X 02140CSR ' ' LOKUPA36,X 54 02150CSRN54 Z-ADD0 COUNT 02160CSRN54 GOTO T101A 02170CSR MOVEAA36,X W2A 2 02180CSR W2A COMP 'OK' 54 02190CSRN54 Z-ADD0 COUNT 02200CSRN54 GOTO T101A 02210CSR END101 ENDSR 02220C******************************************************************** 02230CSR SR102 BEGSR 02240C* PRINT LABEL. 02250CSR Z-ADD0 COUNT ÐÐ02260CSR U2 Z-ADD3 COUNT 02270CSR U2 SETON 8155 02280CSR U2 EXCPT PRINT CODES 1ST LINE 02290CSR U2 SETOF 55 02300CSR U2 EXCPT PRINT 2ND LINE 02310CSR U2 EXCPT PRINT SPACES 02320CSR U2 SETOF 81 02330CSR Z-ADD1 X 02340C*------------------------------------------------------------------- 02350CSR T102A TAG 02360CSR BLK35 LOKUPCMA,X 54 02370CSRN54 GOTO END102 02380CSR MOVELCMA,X W36A 36 02390CSR X COMP 6 54 02400CSR 54 EXSR SR103 02410CSR SETON 80 02420CSR EXCPT 02430CSR SETOF 80 02440C*** MOVELW36A W132A 132 02450C*** EXITFQPRITE 02460C*** RLABL W132A 02470CSR 1 ADD COUNT COUNT 30 02480CSR MOVE BLK35 CMA,X 02490CSR GOTO T102A 02500C*------------------------------------------------------------------- ÐÐ02510CSR END102 TAG 02520CSR 1 ADD COUNT COUNT 02530CSR SETOF 55 02540CSR COUNT COMP 12 54 02550CSR 54 GOTO EXT102 02560CSR EXITFQCLF LF 02570C**** MOVELW36A W132A 132 02580C**** EXITFQPRITE 02590C**** RLABL W132A 02600CSR GOTO END102 02610CSR EXT102 ENDSR 02620C******************************************************************** 02630CSR SR103 BEGSR 02640C* BUILD CITY/STATE/ZIP LINE. 02650CSR MOVE ' ' A36 02660CSR MOVEACMA,X A36,1 02670CSR Z-ADD37 A 30 02680C*------------------------------------------------------------------- 02690CSR T103A TAG 02700CSR A SUB 1 A 54 02710CSRN54 GOTO END103 02720CSR A36,A COMP ' ' 54 02730CSRN54 GOTO T103A 02740CSR 1 ADD A A 02750CSR A COMP 36 54 ÐÐ02760CSR 54 GOTO END103 02770CSR MOVE ',' A36,A 02780CSR 2 ADD A A 02790CSR A COMP 36 54 02800CSR 54 GOTO END103 02810CSR CMSTCD COMP ' ' 54 02820CSR 54 MOVEACMSTCD A36,A 02830CSR 3 ADD A A 02840CSR A COMP 36 54 02850CSR CMZIP COMP 0 55 02860CSRN54 55 MOVE CMZIP W5A 5 1 02870CSRN54 55 MOVEAW5A A36,A 02880CSR MOVEAA36 W36A 02890CSR END103 ENDSR 02900O******************************************************************** 02910OTERM50 E 80 02920O NUL 50 02930O W36A B 36 02940O*------------------------------------------------------------------- 02950O E 81 U2 55 02960O NUL 50 02970O CMCLAS B 2 02980O CMEXPT B 4 02990O CMM,1 B 28 03000O CMM,2 B 32 ÐÐ03010O CMM,3 B 36 03020O*------------------------------------------------------------------- 03030O E 81 U2N55 03040O NUL 50 03050O CMC,1 ZB 28 03060O CMC,2 ZB 32 03070O CMC,3 ZB 36 03080O*--------------------------------------------------------------- 03090O E 84 03100O NUL 50 03110O 24 'XXXXXXXXXXXXXXXXXXXXXXXX' 03120O*------------------------------------------------------------------- 03130O E 85 U1 03140O NUL 50 03150O 24 'ENTER STARTING CUST # ' ** TABSTC/TABSCN - STATE CODES 003160 003170ALALABAMA 003180AKALASKA 003190AZARIZONA 003200ARARKANSAS 003210ASAMERICAN SAMOA 003220CACALIFORNIA 003230CZCANAL ZONE 003240COCOLORADO 003250ÐÐCTCONNECTICUT 003260DEDELAWARE 003270DCDISTRICT OF COLUMBIA 003280FLFLORIDA 003290GAGEORGIA 003300GUGUAM 003310HIHAWAII 003320IDIDAHO 003330ILILLINOIS 003340ININDIANA 003350IAIOWA 003360KSKANSAS 003370KYKENTUCKY 003380LALOUISIANA 003390MEMAINE 003400MDMARYLAND 003410MAMASSACHUSETTS 003420MIMICHIGAN 003430MNMINNESOTA 003440MSMISSISSIPPI 003450MOMISSOURI 003460MTMONTANA 003470NENEBRASKA 003480NVNEVADA 003490NHNEW HAMPSHIRE 003500ÐÐNJNEW JERSEY 003510NMNEW MEXICO 003520NYNEW YORK 003530NCNORTH CAROLINA 003540NDNORTH DAKOTA 003550OHOHIO 003560OKOKLAHOMA 003570OROREGON 003580PAPENNSYLVANIA 003590PRPUERTO RICO 003600RIRHODE ISLAND 003610SCSOUTH CAROLINA 003620SDSOUTH DAKOTA 003630TNTENNESSEE 003640TTTRUST TERRITORIES 003650TXTEXAS 003660UTUTAH 003670VTVERMONT 003680VAVIRGINIA 003690VIVIRGIN ISLANDS 003700WAWASHINGTON 003710WVWEST VIRGINIA 003720WIWISCONSIN 003730WYWYOMING 003740** TABCLC/TABCLN - CUST CLASS NAMES 003750ÐÐ10COMMERCIAL END USER 00376015U.S. GOVERNMENT 00377020GENERAL O.E.M. 00378021BROADCAST O.E.M. 0379030GENERAL LINE DEALER 00380031BROADCAST DEALER 00381033BROADCAST DLR,BRANCH 00382034GEN LINE DLR,BRANCH 00383035DESIGNATED PROD DLR 00384050SPECIAL 00385060AVIONICS END USER 00386065AVIONICS OEM 00387070AVIONICS DISTRIB 00388075AVIONICS REPAIR SHOP 00389090AVIONICS SPECIAL 00390098TO BE DELETED 00391099DISCONTINUED DLR 003920** TABTAX/TABTAN - TAX CODE RATES 0039301CA NON-TAXABLE,CARD 0039402CA NON-TAXABLE,NO CD 0039503NON-TAXABLE,US GOVT 0039604NON-TAXABLE,OTHER 0039705TAXABLE 003980** TABTER/TABTN - TERRITORY NAMES 003990 004000ÐÐ 004010 004020 004030 004040** A36 ARRAY 004050 004060** NUL ARRAY 004070 004080/* 004090_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(3  X012DP P120282120282(èÈÐ00010H Q012DP00020F* WRITE CRT CLEAR CODE TO COL-3,1ST RECORD,TEXT FILE. (X012DP) 00030F* REVISED 05/07/79 6:28 PM. 00040F* 00050FBITTAB IP F 33 DISK 00060FTEXTFILEUC F 80R DISK 00070E******************************************************************** 00080E BIT 33 1 00081E REC 80 1 00090I******************************************************************** 00100IBITTAB BT 00110I 1 33 BIT 00120I******************************************************************** 00130ITEXTFILETX 00140I 1 80 REC 00150C******************************************************************** 00160C 80 GOTO END 00170C MOVE BIT,1 REC 00180C Z-ADD1 RRN 50 00190C RRN CHAINTEXTFILE H9 00200C H9 GOTO END 00210C SETON 80 00220C EXCPT 00230C*------------------------------------------------------------------- 00240C END TAG ÐÐ00250O******************************************************************** 00260OTEXTFILEE 80 00270O REC 80 00271O 1 ' ' 00280O 2 '*' _‚_‚0FTEXTFILEUC F 80R DISK 00070E******************************************************************** 00080E BIT 33 1 00081E REC 80 1 00090I******************************************************************** 00100IBITTAB BT 00110I 1 33 BIT 00120I******************************************************************** 00130ITEXTFILETX 00140I 1 80 REC 00150C******************************************************************** 00160C 80 GOTO END 00170C MOVE BIT,1 REC 00180C Z-ADD1 RRN 50 00190C RRN CHAINTEXTFILE H9 00200C H9 GOTO END 00210C SETON 80 00220C EXCPT 00230C*------------------------------------------------------------------- 00240C END TAG ÐÈ(X3 XúX012GL P120282120282(èÈÐ00010H Q012GL00020F* DISPLAY CHART OF ACCTS-SINGLE LEVEL. (X012GL) D A T A G R A P H I X 00030F* REVISED 7-27-81 3:15 PM. DG-REL006 OK. 00040F* MENU: MQGL01, MQGL02 00050FBITHEX IP F 256 DISK 00060FMGFILE IC F 80R DISK 00070FCAMAST ID F 40L18AI 1 DISK 00080FGLWU ID F 19L18AI 1 DISK 00090FGLMAST IC F 165R 9AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A8 8 8 1 A INPUT DATA ARRAY 00140E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00150E DUN 13 13 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E LEV 1 20 18 00180E BIT 256 1 SCREEN CONTR. CHAR 00190E GLA 12 11 2 00200I******************************************************************* 00210IBITHEX BT 00220I 1 256 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I******************************************************************** 00280IGLWU GW 00290I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00300I* KEY AREA. 00310I* SUB-ACCOUNT 9A 00320I 1 9 GWSUB 00330I* PARENT ACCOUNT 9A 00340I 10 18 GWPAR 00350I* RECORD STATUS 1A 00360I 19 19 GWSTAT 00370I******************************************************************** 00380IGLMAST GL 00390I* ACCOUNT MASTER. 00400I* KEY AREA 00410I* ACCOUNT # 9A 00420I 1 9 GLKEY 00430I 1 1 GLPRFX 00440I 2 60GLPRIM 00450I 7 90GLDASH 30 00460I* ACCOUNT GROUP 4A 00470I 14 17 GLGRUP 00480I* ACCOUNT DESCRIPTION 40A 00490I 18 57 GLDESC 00500I* BALANCE FORWARD AMOUNT 11.2P ÐÐ00510I P 58 632GLBALF 00520I* ACTUAL $ 11.2P X 12 00530I P 64 135 GLA 00540I* CURRENT MONTH-PLUS 11.2P 00550I P 136 1412GLCMP 00560I* CURRENT MONTH-MINUS 11.2P 00570I P 142 1472GLCMM 00580I* SOURCE CODE 1A 00590I* S = SUB-ACCOUNT ONLY, 00600I* MAY NOT BE PARENT 00610I 148 148 GLSC 00620I* BALANCE FORWARD CODE 2A 00630I* 1ST COL 00640I* 1 = ZERO BAL AT START NEW YR 00650I* 2 = CARRY PREV YR FRWD 00660I* 2ND COL 00670I* A = ZERO BAL AT START NEW MO 00680I* B = CARRY PREV MO FRWD 00690I 149 150 GLBFC 00700I* NUMB OF SUB-ACCOUNTS 5P 00710I P 157 1590GLNOSA 00720I* LOW LEVEL CODE 3N 00730I 160 1620GLLL 00740I* FILLER 00750I* RECORD STATUS 1A ÐÐ00760I 165 165 GLSTAT 00770I******************************************************************** 00780ICAMAST CA 00790I* CHART OF ACCOUNTS. 00800I* KEY AREA. 00810I* PARENT ACCOUNT 9A 00820I 1 9 CAPAR 00830I* SUB-ACCOUNT 9A 00840I 10 18 CASUB 00850I* OPERATOR 1A 00860I* S = SUBTRACT 00870I* A = ADD 00880I 25 25 CAOPER 00890I* EFFECTIVITY 00900I* START DATE 6N (YMD) 00910I 26 310CASDAT 00920I* END DATE 6N (YMD) 00930I 32 370CAEDAT 00940I* FILLER 00950I* RECORD STATUS 1A 00960I 40 40 CASTAT 00970C******************************************************************** 00980C* INITIALIZE 00990C EXSR SR101 1-TIME INIT 01000C*------------------------------------------------------------------ ÐÐ01010C START TAG 01020C* SET-UP 1ST FIELD NO. 01030C MOVE ' ' DUN INIT EDIT ARRAY 01040C Z-ADD1 F 30 FIELD # 01050C GOTO READ 01060C*------------------------------------------------------------------ 01070C NEXT TAG 01080C* SET-UP NEXT FIELD NO. 01090C 1 ADD F F FIELD # 01100C*----------------------------------------------------------------- 01110C READ TAG 01120C* READ DATA FROM TERMINAL. 01130C SETOF 9096 01140C EXSR SR102 VALIDATE FIELD # 01150C 55 GOTO UPDATE DONE 01160C EXSR SR201 IDENTIFY-F 01170C 01 GOTO NEXT 01180C 01 Z-ADD362 M 50 ENTER PREFIX 01190C 02 Z-ADD363 M ENTER PRIME 01200C 03 Z-ADD364 M ENTER DASH 01210C EXSR SR89 GET MSG. 01220C SETON 69 01230C EXSR SR73 PROMPT 01240C SETOF 69 01250C EXSR SR75 READ TERMINAL ÐÐ01260C*---------------------------------------------------------- 01270C ESCAPE TAG 01280C 98 GOTO GOODBY GOODBY 01290C 94 GOTO MENU MENU REQUEST 01300C N77N88 EXSR SR104 EDIT INPUT FIELD 01310C 93 GOTO NEWITM NEW ITEM 01320C 92 GOTO JUMP FIELD JUMP REQST 01330C 91 GOTO NEXT SKIP FORWARD 01340C 89 F SUB 1 F SKIP BACKWARD 01350C 89 EXSR SR201 01360C 89 01 Z-ADD2 F 01370C 89 GOTO READ " " 01380C 88 SETOF 90 SPACE FILL 01390C 88 SETON 77 " " 01400C 87 GOTO START 01410C 86 GOTO UPDATE UPDATE 01420C 85 GOTO READ REPEAT 01430C 96 GOTO ERROR ERROR 01440C*------------------------------------------------------------------ 01450C PROCES TAG 01460C* PROCESS INPUT DATA 01470C EXSR SR103 MOVE DATA 01480C N96 EXSR SR104 EDIT DATA 01490C 96 GOTO ERROR ERROR 01500C GOTO NEXT ÐÐ01510C*------------------------------------------------------------------ 01520C UPDATE TAG 01530C* UPDATE DATA BASE. 01540C EXSR SR105 FINAL EDIT 01550C 96 GOTO ERROR ERROR 01560C EXSR SR106 UPDATE 01570C 96 GOTO ERROR ERROR 01580C 90 GOTO ESCAPE 01590C GOTO START 01600C*------------------------------------------------------------------- 01610C JUMP TAG 01620C* SET-UP JUMP TO REQUESTED FIELD 01630C 1 ADD W W 30 01640C W COMP 8 54 01650C 54 Z-ADD318 M 50 96 FLAG ERROR 01660C 54 GOTO ERROR BAD ESC 01670C MOVE ' ' W3A 3 01680C MOVEAA8,W W3A 01690C Z-ADD3 W2N 20 01700C EXIT SUBRAJ R. JUSTIFY 01710C RLABL W2N 01720C RLABL W3A 01730C MOVE W3A F NEW FIELD # 01740C GOTO READ 01750C*-------------------------------------------------------------------- ÐÐ01760C ERROR TAG 01770C EXSR SR102 VALIDATE FIELD # 01780C EXSR SR89 GET MSG 01790C EXSR SR73 PUT MSG 01800C GOTO START 01810C*------------------------------------------------------------------ 01820C NEWITM TAG 01830C* SET-UP LINK FOR NEW ITEM 01840C MOVEL'Q012GL' PROG 8 01850C GOTO END 01860C*------------------------------------------------------------------- 01870C MENU TAG 01880C* SET-UP LINK TO MENU 01890C MOVEL'QQGL02' PROG 01900C GOTO END 01910C*-------------------------------------------------------------------- 01920C GOODBY TAG 01930C* LINK TO SIGN-OFF 01940C MOVEL'GOODBY' PROG 01950C GOTO END 01960C*------------------------------------------------------------------- 01970C END TAG 01980C EXITFCHAIN LINK TO NEXT PROG 01990C RLABL PROG 02000C********************************************************************* ÐÐ02010CSR SR3 BEGSR 02020C* EDIT INPUT ACCOUNT NO. 02030CSR MOVE TKEY W9A 9 02040CSR EXSR SR80 GET GLMAST 02050C*R 60 *** Z-ADD302 M 96 FLAG ERROR 02060C*R 60 *** GOTO END3 02070CSR MOVE GLPRFX PAPRFX 1 02080CSR Z-ADDGLPRIM PAPRIM 50 02090CSR Z-ADDGLDASH PADASH 30 02100CSR MOVE GLDESC PADESC 40 02110CSR MOVE GLSC PASC 1 02120CSR END3 ENDSR 02130C***************************************************************** 02140CSR SR70 BEGSR 02150C* CLEAR TERM SCREEN. 02160CSR EXITFQTOPF CLEAR SCREEN 02170CSR ENDSR 02180C********************************************************************** 02190CSR SR71 BEGSR 02200C* PUT HEADINGS TO TERMINAL 02210CSR SETON 71 02220CSR EXCPT PUT HEADINGS 02230CSR SETOF 71 02240CSR Z-ADD8 LINENO 30 02250CSR ENDSR ÐÐ02260C********************************************************************* 02270CSR SR72 BEGSR 02280C* PUT DATA TO TERMINAL 02290CSR 1 ADD LINENO LINENO 30 02300CSR LINENO COMP 31 54 02310CSRN54 GOTO T72A NOT END PAGE 02320CSR EXITFQEPAGE 02330CSR EXSR SR75 READ 02340CSR 90 GOTO END72 ESC INPUT 02350CSR EXSR SR71 PUT HEADING 02360C*--------------------------------------------------------------- 02370CSR T72A TAG 02380CSR SETON 72 02390CSR EXCPT 02400CSR SETOF 72 02410CSR END72 ENDSR 02420C*********************************************************************** 02430CSR SR73 BEGSR 02440C* PUT ERROR MESSAGE TO TERMINAL 02450CSR SETON 73 02460CSR EXCPT PUT MSG 02470CSR SETOF 73 02480CSR Z-ADDM LSTERR 50 02490CSR ENDSR 02500C******************************************************************* ÐÐ02510CSR SR75 BEGSR 02520C* READ FROM TERMINAL 02530CSR SETOF 779096 02540CSR SETOF 939291 02550CSR SETOF 898887 02560CSR SETOF 8685 02570CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 02580CSR MOVE BLK8 W8A 8 BUFFER 02590CSR EXITFQWREED READ FROM TERMINAL 02600CSR RLABL W8A READ BUFFER 02610CSR RLABL BUFLGT READ BUFFER LGTH 02620CSR MOVEAW8A A8 INPUT DATA ARRAY 02630CSR MOVE BLK8 W8A INIT INPUT ARRAY 02640CSR Z-ADD1 W 30 02650CSR '\' LOKUPA8,W 90 FLAG ESC 02660CSRN90 GOTO T75B NOT ESC 02670CSR 1 ADD W W 02680CSR W COMP 8 54 02690CSR 54 GOTO T75A BAD ESC 02700CSR A8,W COMP 'G' 98 GOODBY 02710CSR A8,W COMP 'E' 94 MENU 02720CSR A8,W COMP 'N' 93 NEW ITEM 02730CSR A8,W COMP 'J' 92 JUMP 02740CSR A8,W COMP 'F' 91 SKIP FRWRD 02750CSR A8,W COMP 'B' 89 SKIP BKWRD ÐÐ02760CSR A8,W COMP 'S' 88 SPACE FILL 02770CSR A8,W COMP 'H' 87 HOME 02780CSR A8,W COMP 'U' 86 UPDATE 02790CSR A8,W COMP 'R' 85 REPEAT 02800CSR 98 02810COR 94 02820COR 93 02830COR 92 02840COR 91 02850COR 89 02860COR 88 02870COR 87 02880COR 86 02890COR 85 GOTO END75 GOOD ESC 02900C*------------------------------------------------------------------ 02910CSR T75A TAG 02920C* FLAG BAD ESC INPUT 02930CSR Z-ADD318 M 96 FLAG ERROR 02940CSR GOTO END75 02950C*-------------------------------------------------------------------- 02960CSR T75B TAG 02970C* MOVE DATA 02980CSR Z-ADD1 W 02990CSR ' ' LOKUPA8,W 77 03000CSR 77 MOVEAA8,W W8A INPUT DATA ÐÐ03010CSR END75 ENDSR 03020C********************************************************************** 03030CSR SR80 BEGSR 03040C* GET MASTER RECORD 03050CSR W9A CHAINGLMAST 60 GET MASTER 03060CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 03070CSR ENDSR 03080C********************************************************************** 03090CSR SR89 BEGSR 03100C* GET MESSAGE MASTER 03110CSR M CHAINMGFILE 54 03120CSR 54 MOVE BLK35 MGTEXT 03130CSR 54 MOVELM MGTEXT 03140CSR 54 MOVE MES,1 MGTEXT 03150CSR ENDSR 03160C*********************************************************************** 03170CSR SR101 BEGSR 03180C* 1-TIME INITIALIZE 03190CSR MOVE BIT,1 NUL 03200CSR MOVEANUL NUL92 92 03210CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03220CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03230CSR MOVE ' ' BLK8 8 03240C* DEFINE WORK FIELDS,ETC. 03250CSR MOVE ' ' BLK35 35 ÐÐ03260CSR MOVE ' ' BLK8 8 03270CSR ENDSR 03280C********************************************************************** 03290CSR SR102 BEGSR 03300C* VALIDATE FIELD NO. 03310CSR F COMP 0 54 03320CSRN54 Z-ADD1 F 03330CSR F COMP FLIMIT 55 03340CSR 55 Z-ADD1 F 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR103 BEGSR 03380C* MOVE INPUT DATA 03390CSR EXSR SR201 IDENTIFY-F 03400CSR EXSR SR202 R. JUSTIFY 03410CSR 01 MOVELW8A TPRFX 1 ACCOUNT PREFIX 03420CSR 02 MOVE W8A TPRIM 50 ACCOUNT PRIME 03430CSR 03 MOVE W8A TDASH 30 ACCOUNT DASH 03440CSR 03 MOVELTPRFX TKEY 9 03450CSR 03 MOVELTPRIM W8A 8 03460CSR 03 MOVE TDASH W8A 03470CSR 03 MOVE W8A TKEY 03480CSR MOVE ' ' DUN,F EDIT FLAG 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR104 BEGSR 03520C* EDIT INPUT DATA 03530CSR 03 EXSR SR3 EDIT INPUT. 03540CSR 96 MOVE ' ' DUN,F EDIT FLAG 03550CSRN96 MOVE 'X' DUN,F 03560CSR ENDSR 03570C*********************************************************************** 03580CSR SR105 BEGSR 03590C* FINAL EDIT 03600CSR SETON 79 FINAL EDIT FLAG 03610CSR Z-ADD1 F 96 03620C*-------------------------------------------------------------------- 03630CSR T105A TAG 03640CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03650CSRN54 GOTO END105 03660CSR EXSR SR201 IDENTIFY-F 03670CSR EXSR SR104 EDIT 03680CSRN96 GOTO T105A 03690C*-------------------------------------------------------------------- 03700CSR END105 TAG 03710CSR SETOF 79 03720CSR ENDSR 03730C******************************************************************** 03740CSR SR106 BEGSR 03750C* DISPLAY CHART OF ACCOUNTS. ÐÐ03760CSR MOVELTKEY W18A 18 03770CSR W18A SETLLCAMAST 03780CSR EXSR SR71 PUT HEADING 03790C*--------------------------------------------------------------- 03800CSR T106A TAG 03810CSR SETOF 54 03820CSR READ CAMAST 54 03830CSR 54 GOTO T106P 03840CSR CAPAR COMP TKEY 54 03850CSRN54 GOTO T106P END OF STRUCTURE 03860CSR CASTAT COMP 'D' 54 03870CSR 54 GOTO T106A DELETED 03880CSR MOVE CASUB W9A 03890CSR EXSR SR80 GET GLMAST 03900CSR EXSR SR72 PUT DATA 03910CSRN90 GOTO T106A GET NEXT RECORD 03920CSR GOTO END106 03930C*-------------------------------------------------------------- 03940CSR T106P TAG 03950C* END ITEM MESSAGE 03960CSR EXITFQEITEM 03970CSR END106 ENDSR 03980C************************************************************************ 03990CSR SR201 BEGSR 04000C* IDENTIFY FIELD NO. ÐÐ04010CSR F COMP 1 01 04020CSR F COMP 2 02 04030CSR F COMP 3 03 04040CSR ENDSR 04050C********************************************************************** 04060CSR SR202 BEGSR 04070C* RIGHT JUSTIFY 04080CSR F LOKUPNUM 54 04090CSRN54 GOTO END202 NOT NUMERIC FIELD 04100CSR Z-ADD8 W2N 20 04110CSR EXIT SUBRAJ R. JUSTIFY 04120CSR RLABL W2N 04130CSR RLABL W8A 04140CSR END202 ENDSR 04150O******************************************************************** 04160OTERM132 E 71 04170O* PUT HEADING - PARENT ACCOUNT. 04180O 66 'CHART OF ACCOUNTS' 04190O 80 '- SINGLE LEVEL' 04200O*------------------------------------------------------------------- 04210O E 71 04220O 17 'PARENT ACCOUNT' 04230O 66 'TYPE' 04240O*------------------------------------------------------------------- 04250O E 71 ÐÐ04260O* * * * 6 'PREFIX' 04270O 13 'PRIME' 04280O 20 'DASH' 04290O 35 '<--------------' 04300O 46 'DESCRIPTION' 04310O 60 '------------->' 04320O 66 'CODE' 04330O*------------------------------------------------------------------- 04340O E 71 04350O* PARENT ACCOUNT DATA. 04360O PAPRFX 4 04370O PAPRIMZ 14 04380O PADASHZ 19 04390O PADESC 60 04400O PASC 64 04410O*------------------------------------------------------------------- 04420O E 71 04430O* PUT HEADING - SUB-ACCOUNT. 04440O 22 'SUB ACCOUNT' 04450O 71 'TYPE' 04460O 77 'OPER' 04470O 94 'EFFECTIVITY' 04480O 123 'CURRENT MONTH' 04490O*------------------------------------------------------------------- 04500O E 71 ÐÐ04510O* * * * 12 'PREFIX' 04520O 19 'PRIME' 04530O 25 'DASH' 04540O 40 '<--------------' 04550O 51 'DESCRIPTION' 04560O 65 '------------->' 04570O 71 'CODE' 04580O 77 'CODE' 04590O 87 'START' 04600O 95 'STOP' 04610O 112 'PLUS' 04620O 126 'MINUS' 04630O*------------------------------------------------------------------- 04640O E 72 04650O* SUB-ACCOUNT DATA. 04660O GLPRFX 10 04670O GLPRIMZ 20 04680O 30 21 '-' 04690O GLDASHZ 24 04700O GLDESC 65 04710O GLSC 69 04720O CAOPER 75 04730O CASDAT 87 ' - - ' 04740O CAEDAT 97 ' - - ' 04750O GLCMP K 112 ÐÐ04760O GLCMM K 125 04770O*------------------------------------------------------------------- 04780O E 73 04790O* PUT MESSAGE. 04800O NUL92 132 04810O 96 5 '*****' 04820O N96 5 ' ' 04830O MGTEXT 40 04840O BIT,8 132 ** NUL ARRAY 004850 004860** A8 ARRAY 004870 004880** NUM ARRAY 004890002 PAR PRIME 004900003 PAR DASH 004910** DUN ARRAY 004920 004930** MES ARRAY 004940---MESSAGE NOT ON FILE--- 004950** LEV ARRAY 04960 04970/* 04980_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d4 d*X012PC P120282120282(èÈÐ00010H Q012PC00020F* ADOPT OLD STYLE UNIT COST AS NEW LABOR/MATERIAL COST 00030FPMMST2 UP F 576 12AI 1 DISK 00040E PA$ 7 9 3 00050E PM$ 7 9 3 00060IPMMST2 PM 01 576NCD 00070I P 215 249 PA$ 00080I P 280 314 PM$ 00090I P 544 5483PMOSUC 00100I GG 02 00110C N01 GOTO END 00120C Z-ADD0 PA$ 00130C Z-ADDPMOSUC PA$,3 00140C END TAG 00150OPMMST2 D 01 00160O PA$ 249P 00170O PM$ 314P 00180O PMOSUC 548P /* 000190_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(24? 2X012PM P120282120282(èÈÐ00010H Q012PM00020F* INITIALIZE PMDES FIELD IN PART MAST. (X012PM) 00030F* REVISED 2/10/81 1:40 PM. 00040F* RUN AS PART OF Z009PM. 00050FPMMST2 UP F 674 12AI 1 DISK 00060I******************************************************************** 00070IPMMST2 PM 01 00080I P 517 5180PMDES 00090C******************************************************************** 00100C Z-ADD0 PMDES 00110O******************************************************************** 00120OPMMST2 D 01 00130O PMDES 518P /* 000140_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È4U ÈTX012QM P120282120282(èÈÐ00010H Q012QM00020F* PRINT REASON LOST REPORT. SUMMARIZED BY PROD LINE. (X012QM) 00030F* REVISED 3/31/81 10:50 AM. 00040FBITHEX IP F 256 DISK 00050FQMHIST IS F 186 26AI 1 DISK 00060FSUSPENSEUC 128R29AI 1 DISK A 00070FDIABLO O F 80 5 00080E******************************************************************** 00090E BIT 256 1 00100E QHR 20 2 00110E QHF 20 3 0 00120E QH$ 20 7 0 00130E SF 12 3 0 00140E S$ 12 9 2 00150I******************************************************************** 00160IBITHEX BT 00170I 1 256 BIT 00180I******************************************************************** 00190IQMHIST QH 00200I* QUOTE HISTORY FILE. 00210I* KEY AREA. 00220I* PRODUCT CLASS 2A 00230I 1 2 QHCLAS 00240I* DATE CLOSED (YR-MO) 4N 00250I 3 60QHDAT ÐÐ00260I 3 40QHYR 00270I 5 60QHMO 00280I* CUSTOMER NAME 20A 00290I 7 26 QHNAME 00300I* HISTORY ARRAYS - 20 ELEMENTS EA 00310I* STATUS CODE/REASON 2A X 20 00320I 27 46 QHR 00330I* FREQUENCY 3P X 20 00340I P 47 86 QHF 00350I* $ AMOUNT 7P X 20 00360I P 87 166 QH$ 00370I* FILLER 167 192 FFFFFF 00380I******************************************************************** 00390ISUSPENSESP 00400I* SUMMARIZED OUTPUT. 00410I* KEY AREA. 00420I 1 29 SPKEY 00430I* PRODUCT LINE RECORD 00440I* 1-2 = TERM # 00450I* 3-6 = RECORD CODE (QMRP) 00460I* 7-8 = PROD CLASS 00470I* 9-9 = STATUS CODE 00480I* CUSTOMER RECORD - STATUS 00490I* 1-2 = TERM # 00500I* 3-6 = RECORD CODE (QMRC) ÐÐ00510I* 7-26 = CUST NAME 00520I* 27-27 = STATUS CODE 00530I* CUSTOMER RECORD - REASON LOST 00540I* 1-2 = TERM # 00550I* 3-6 = RECORD CODE (QMCL) 00560I* 7-26 = CUST NAME 00570I* 27-27 = REASON LOST 00580I* STATUS RECORD 00590I* 1-2 = TERM # 00600I* 3-6 = RECORD CODE (QMRS) 00610I* 7-7 = STATUS CODE 00620I* REASON LOST RECORD 00630I* 1-2 = TERM # 00640I* 3-6 = RECORD CODE (QMRL) 00650I* 7-7 = REASON 00660I* DATA AREA. 00670I* FREQUENCY 3P X 12 00680I P 30 53 SF 00690I* AMOUNT 9.2P X 12 00700I P 54 113 S$ 00710I* RECORD STATUS 1A 00720I 128 128 SPSTAT 00730C******************************************************************** 00740C* INITIALIZE. 00750C N79 EXSR SR101 1-TIME ONLY. ÐÐ00760C L1 EXSR SR102 NEW P.L. 00770CSR EXSR SR103 EVERY-TIME. 00780C* BYPASS WRONG MONTH. 00790C QHDAT COMP YRMO 54 00800C N54 GOTO END 00810C* SUMMARIZE REPORT TOTALS. 00820C EXSR SR104 REPORT TOTALS. 00830C*------------------------------------------------------------------- 00840C END TAG 00850C* UPDATE SUSPENSE FILES. 00860C EXSR SR105 PROD LINE. 00870C EXSR SR106 CUST-STATUS 00880C EXSR SR107 CUST-LOST 00890C EXSR SR108 OVERALL-STATUS 00900C EXSR SR109 REASON LOST 00910C* PRINT REPORT FINAL TOTALS. 00920CLR EXSR SR110 REPT FINAL TOT /* 000930_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(X4ª XúX012RM P120282120282(èÈÐ00010H Q012RM00020F* UPDATE ROUTING OPERATION CODE FILE. (X012RM) 00030F* REVISED 10-20-80 2:15 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FOPDESCR UC F 47R 5AI 1 DISK A 00070FTERM132 O F 132 5 00080F**************************************************************** 00090E NUL 1 132 1 NULL CHAR 00100E A40 40 40 1 A INPUT DATA ARRAY 00110E DUN 1 3 1 A EDIT CMPLT FLAG 00120E MES 1 1 30 00130E LOC 1 3 3 0 CRT COL # 00140E BIT 33 1 SCREEN CONTR. CHAR 00150E CALL 5 6 CALL STACK 00160E* 00170E* 00180I******************************************************************* 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************* 00220IMGFILE MG 00230I* MESSAGE FILE. 00240I 1 35 MGTEXT 00250I******************************************************************** ÐÐ00260IOPDESCR OP 00270I* OPER CODE 5A 00280I 1 5 OPCODE 00290I* OPER DESCR 40A 00300I 7 46 OPDESC 00310I* RECORD STATUS 1A 00320I 47 47 OPSTAT 00330C******************************************************************** 00340C* INITIALIZE 00350C EXSR SR101 1-TIME INIT 00360C EXSR SR71 PUT HEADINGS 00370C*------------------------------------------------------------------ 00380C START TAG 00390C* SET-UP 1ST FIELD NO. 00400C EXSR SR207 INIT UPDATE DATA 00410C MOVE ' ' DUN INIT EDIT ARRAY 00420C Z-ADD1 F 30 FIELD # 00430C GOTO READ 00440C*------------------------------------------------------------------ 00450C NEXT TAG 00460C* SET-UP NEXT FIELD NO. 00470C 1 ADD F F FIELD # 00480C*----------------------------------------------------------------- 00490C READ TAG 00500C* READ DATA FROM TERMINAL. ÐÐ00510C SETOF 9096 00520C EXSR SR102 VALIDATE FIELD # 00530C 55 GOTO UPDATE DONE 00540C EXSR SR201 IDENTIFY-F 00550C EXSR SR203 CLASSIFY TRAN 00560C 62 03 GOTO UPDATE DELETE TRAN 00570C SETON 69 00580C EXSR SR72 PROMPT 00590C SETOF 69 00600C EXSR SR75 READ TERMINAL 00610C 98 GOTO GOODBY GOODBY 00620C 94 GOTO MENU MENU REQUEST 00630C N77N88 EXSR SR104 EDIT INPUT FIELD 00640C 96 ERROR 00650CORN77N88 EXSR SR72 REWRITE INPUT DATA 00660C 93 GOTO NEWITM NEW ITEM 00670C 92 GOTO JUMP FIELD JUMP REQST 00680C 91 GOTO NEXT SKIP FORWARD 00690C 89 F SUB 1 F SKIP BACKWARD 00700C 89 GOTO READ " " 00710C 88 SETOF 90 SPACE FILL 00720C 88 SETON 77 " " 00730C 87 GOTO START 00740C 86 GOTO UPDATE UPDATE 00750C 85 GOTO READ REPEAT ÐÐ00760C 96 GOTO ERROR ERROR 00770C N77 GOTO NEXT NO DATA INPUT 00780C*------------------------------------------------------------------ 00790C PROCES TAG 00800C* PROCESS INPUT DATA 00810C EXSR SR103 MOVE DATA 00820C N96 EXSR SR104 EDIT DATA 00830C EXSR SR72 REWRITE DATA 00840C 96 GOTO ERROR ERROR 00850C GOTO NEXT 00860C*------------------------------------------------------------------ 00870C UPDATE TAG 00880C* UPDATE DATA BASE. 00890C EXSR SR105 FINAL EDIT 00900C 96 GOTO ERROR ERROR 00910C EXSR SR106 UPDATE 00920C 96 GOTO ERROR ERROR 00930C 1 ADD COUNT COUNT 30 PAGE LINE #. 00940C 1 ADD LINENO LINENO 30 CRT LINE #. 00950C COUNT COMP 22 54 54 00960C 54 EXSR SR71 PUT HEADINGS. 00970C LINENO COMP 119 54 54 00980C 54 Z-ADD119 LINENO 00990C 54 EXSR SR76 ROLL SCREEN. 01000C GOTO START ÐÐ01010C*------------------------------------------------------------------- 01020C JUMP TAG 01030C* SET-UP JUMP TO REQUESTED FIELD 01040C 1 ADD W W 30 01050C W COMP 40 54 01060C 54 Z-ADD318 M 50 96 FLAG ERROR 01070C 54 GOTO ERROR BAD ESC 01080C MOVE '000' W3A 3 01090C MOVEAA40,W W3A 01100C Z-ADD3 W2N 20 01110C EXIT SUBRAJ R. JUSTIFY 01120C RLABL W2N 01130C RLABL W3A 01140C MOVE W3A F NEW FIELD # 01150C GOTO READ 01160C*-------------------------------------------------------------------- 01170C ERROR TAG 01180C EXSR SR102 VALIDATE FIELD # 01190C EXSR SR89 GET MSG 01200C EXSR SR73 PUT MSG 01210C GOTO READ 01220C*------------------------------------------------------------------ 01230C NEWITM TAG 01240C* SET-UP LINK FOR NEW ITEM 01250C MOVEL'Q012RM' PROG 8 ÐÐ01260C GOTO END 01270C*------------------------------------------------------------------- 01280C MENU TAG 01290C* SET-UP LINK TO MENU 01300C MOVEL'QQRM01' PROG 01310C GOTO END 01320C*-------------------------------------------------------------------- 01330C GOODBY TAG 01340C* LINK TO SIGN-OFF 01350C MOVEL'GOODBY' PROG 01360C GOTO END 01370C*------------------------------------------------------------------- 01380C END TAG 01390C PROG COMP BLK8 54 01400C N54 MOVEL'Q012RM' PROG 01410C EXITFCHAIN LINK TO NEXT PROG 01420C RLABL PROG 01430C********************************************************************* 01440CSR SR1 BEGSR 01450C* EDIT TRAN CODE. 01460CSR EXSR SR203 CLASSIFY TRAN. 01470CSRN60N61N62 Z-ADD302 M 96 FLAG ERROR. 01480CSR ENDSR 01490C******************************************************************* 01500CSR SR2 BEGSR ÐÐ01510C* EDIT OPER CODE. 01520CSR CRCODE COMP BLK5 54 01530CSRN54 Z-ADD329 M 96 FLAG ERROR. 01540CSR 79 GOTO END2 01550CSR SETON 40 01560CSR EXSR SR106 01570CSR SETOF 40 01580CSR IOSW COMP ' ' 57 01590CSR 57 EXSR SR205 MOVE FILE DATA. 01600CSRN57 EXSR SR206 INIT FILE DATA. 01610CSR END2 ENDSR 01620C********************************************************************* 01630CSR SR3 BEGSR 01640C* EDIT DESCRIPTION. 01650CSR CRDESC COMP BLK40 54 01660CSRN54 Z-ADD310 M 96 FLAG ERROR. 01670CSR ENDSR 01680C***************************************************************** 01690CSR SR70 BEGSR 01700C* CLEAR TERM SCREEN. 01710CSR EXITFQTOPF TOP FORM 01720CSR ENDSR 01730C********************************************************************** 01740CSR SR71 BEGSR 01750C* PUT HEADINGS TO TERMINAL ÐÐ01760CSR Z-ADD6 COUNT 01770CSR 6 ADD LINENO LINENO 01780CSR SETON 71 01790CSR EXCPT PUT HEADINGS 01800CSR SETOF 7170 01810CSR ENDSR 01820C********************************************************************* 01830CSR SR72 BEGSR 01840C* PUT DATA TO TERMINAL 01850CSR MOVELLINENO W6A 01860CSR MOVE '001' W6A 01870CSR EXITFQXYPOS POSITION CURSOR. 01880CSR RLABL W6A 01890CSR EXITFQMOVUP BUMP CURSOR UP. 01900CSR SETON 72 01910CSR EXCPT PUT DATA 01920CSR SETOF 72 01930CSR END72 ENDSR 01940C*********************************************************************** 01950CSR SR73 BEGSR 01960C* PUT ERROR MESSAGE TO TERMINAL 01970CSR SETON 73 01980CSR EXCPT PUT MSG 01990CSR SETOF 73 02000CSR Z-ADDM LSTERR 50 ÐÐ02010CSR ENDSR 02020C******************************************************************* 02030CSR SR75 BEGSR 02040C* READ FROM TERMINAL 02050CSR SETOF 779096 02060CSR SETOF 939291 02070CSR SETOF 898887 02080CSR SETOF 8685 02090CSR 1 ADD LOC,F W3N 30 02100CSR MOVE W3N W6A 6 02110CSR MOVELLINENO W6A 02120CSR MOVELBIT,28 W2A 2 02130CSR MOVE '8' W2A 02140CSR MOVELW2A W8A 8 02150CSR MOVE W6A W8A 02160CSR MOVELW8A W9A 9 02170CSR MOVE BIT,8 W9A 02180CSR MOVE BIT,21 BUFLGT 2 READ BUFFER LGTH 02190CSR MOVE BLK40 W40A 40 BUFFER 02200CSR EXITFQPREED READ FROM TERMINAL 02210CSR RLABL W9A 02220CSR RLABL W40A READ BUFFER 02230CSR RLABL BUFLGT READ BUFFER LGTH 02240CSR MOVEAW40A A40 INPUT DATA ARRAY 02250CSR MOVE BLK40 W40A INIT INPUT ARRAY ÐÐ02260CSR Z-ADD1 W 30 02270CSR '\' LOKUPA40,W 90 FLAG ESC 02280CSRN90 GOTO T75B NOT ESC 02290CSR 1 ADD W W 02300CSR W COMP 40 54 02310CSR 54 GOTO T75A BAD ESC 02320CSR A40,W COMP 'G' 98 GOODBY 02330CSR A40,W COMP 'E' 94 MENU 02340CSR A40,W COMP 'N' 93 NEW ITEM 02350CSR A40,W COMP 'J' 92 JUMP 02360CSR A40,W COMP 'F' 91 SKIP FRWRD 02370CSR A40,W COMP 'B' 89 SKIP BKWRD 02380CSR A40,W COMP 'S' 88 SPACE FILL 02390CSR A40,W COMP 'H' 87 HOME 02400CSR A40,W COMP 'U' 86 UPDATE 02410CSR A40,W COMP 'R' 85 REPEAT 02420CSR 98 02430COR 94 02440COR 93 02450COR 92 02460COR 91 02470COR 89 02480COR 88 02490COR 87 02500COR 86 ÐÐ02510COR 85 GOTO END75 GOOD ESC 02520C*------------------------------------------------------------------ 02530CSR T75A TAG 02540C* FLAG BAD ESC INPUT 02550CSR Z-ADD318 M 96 FLAG ERROR 02560CSR GOTO END75 02570C*-------------------------------------------------------------------- 02580CSR T75B TAG 02590C* MOVE DATA 02600CSR Z-ADD1 W 02610CSR ' ' LOKUPA40,W 77 02620CSR 77 MOVEAA40,W W40A INPUT DATA 02630C*-------------------------------------------------------------------- 02640CSR END75 TAG 02650C* INIT PREV ERROR MSG. 02660CSR LSTERR COMP 0 54 02670CSR 54 MOVE BLK35 MGTEXT 02680CSR 54 EXSR SR73 BLANK MESSAGE 02690CSR Z-ADD0 LSTERR 50 02700CSR ENDSR 02710C******************************************************************** 02720CSR SR76 BEGSR 02730C* ROLL SCREEN. 02740CSR SETON 76 02750CSR EXCPT ÐÐ02760CSR SETOF 76 02770CSR ENDSR 02780C********************************************************************** 02790CSR SR80 BEGSR 02800C* GET MASTER RECORD 02810CSR MOVE ' ' IOSW 1 02820CSR SETOF 61 02830CSR CRCODE CHAINOPDESCR 60 GET MASTER 02840CSRN60 OPSTAT COMP 'D' 61 FLAG DELETE 02850CSR 60 MOVE 'N' IOSW 02860CSR 61 MOVE 'D' IOSW 02870CSR ENDSR 02880C********************************************************************** 02890CSR SR81 BEGSR 02900C* ADD NEW MASTER TO FILE 02910CSR SETON 81 02920CSR EXCPT ADD MASTER 02930CSR SETOF 81 02940CSR ENDSR 02950C*********************************************************************** 02960CSR SR82 BEGSR 02970C* REWRITE MASTER 02980CSR SETON 82 02990CSR EXCPT REWRITE MASTER 03000CSR SETOF 82 ÐÐ03010CSR ENDSR 03020C********************************************************************** 03030CSR SR89 BEGSR 03040C* GET MESSAGE MASTER 03050CSR M CHAINMGFILE 54 03060CSR 54 MOVE BLK35 MGTEXT 03070CSR 54 MOVELM MGTEXT 03080CSR 54 MOVE MES,1 MGTEXT 03090CSR ENDSR 03100C*********************************************************************** 03110CSR SR101 BEGSR 03120C* 1-TIME INITIALIZE 03130CSR SETON 70 CLEAR SCREEN. 03140CSR MOVE BIT,1 NUL 03150CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03160CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03170CSR MOVE ' ' BLK40 40 03180C* DEFINE WORK FIELDS,ETC. 03190CSR MOVE ' ' BLK35 35 03200CSR MOVE ' ' BLK8 8 03210CSR MOVE ' ' BLK5 5 03220C* 03230C* 03240C* 03250CSR ENDSR ÐÐ03260C********************************************************************** 03270CSR SR102 BEGSR 03280C* VALIDATE FIELD NO. 03290CSR F COMP 0 54 03300CSRN54 Z-ADD1 F 03310CSR F COMP FLIMIT 55 03320CSR 55 Z-ADD3 F 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR103 BEGSR 03360C* MOVE INPUT DATA 03370CSR EXSR SR201 IDENTIFY-F 03380CSR 01 MOVELW40A CRTRAN 1 TRAN CODE. 03390CSR 02 MOVELW40A CRCODE 5 OPER CODE. 03400CSR 03 MOVELW40A CRDESC 40 DESCRIPTION. 03410CSR MOVE ' ' DUN,F EDIT FLAG 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR104 BEGSR 03450C* EDIT INPUT DATA 03460CSR 01 EXSR SR1 03470CSR 02 EXSR SR2 03480CSR 03 EXSR SR3 03490CSR 96 MOVE ' ' DUN,F EDIT FLAG 03500CSRN96 MOVE 'X' DUN,F ÐÐ03510CSR ENDSR 03520C*********************************************************************** 03530CSR SR105 BEGSR 03540C* FINAL EDIT 03550CSR SETON 79 FINAL EDIT FLAG 03560CSR Z-ADD1 F 96 03570C*-------------------------------------------------------------------- 03580CSR T105A TAG 03590CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03600CSRN54 GOTO END105 03610CSR EXSR SR201 IDENTIFY-F 03620CSR EXSR SR104 EDIT 03630CSRN96 GOTO T105A 03640C*-------------------------------------------------------------------- 03650CSR END105 TAG 03660CSR SETOF 79 03670CSR ENDSR 03680C******************************************************************** 03690CSR SR106 BEGSR 03700C* UPDATE DATA BASE. 03710CSR EXSR SR203 CLASSIFY TRAN 03720CSR 60 GOTO T106A ADD TRAN 03730CSR 61 GOTO T106D CHANGE TRAN 03740CSR 62 GOTO T106F DELETE TRAN 03750C* FLAG BAD TRAN CODE ÐÐ03760CSR Z-ADD300 M 96 FLAG ERROR 03770CSR Z-ADD1 F FIELD # 03780CSR GOTO END106 03790C*------------------------------------------------------------------- 03800CSR T106A TAG 03810C* ADD TRANSACTION 03820CSR EXSR SR80 GET MASTER 03830CSR 60 GOTO T106B NOT ON FILE 03840CSR 61 GOTO T106C DELETED MASTER 03850C* FLAG DUPLICATE ADD ERROR 03860CSR Z-ADD301 M 96 FLAG ERROR 03870CSR Z-ADD1 F FIELD # 03880CSR GOTO END106 03890C*--------------------------------------------------------------------- 03900CSR T106B TAG 03910C* ADD-- MAST NOT ON FILE 03920CSRN40 EXSR SR81 ADD NEW MASTER 03930CSR GOTO END106 03940C*--------------------------------------------------------------------- 03950CSR T106C TAG 03960C* ADD-- MAST IS DELETED 03970CSR MOVE 'A' OPSTAT RECORD STATUS 03980CSRN40 EXSR SR82 REWRITE MAST 03990CSR GOTO END106 04000C*---------------------------------------------------------------------- ÐÐ04010CSR T106D TAG 04020C* CHANGE TRANSACTION. 04030CSR EXSR SR80 GET MASTER 04040CSRN60N61 GOTO T106E GOT IT 04050C* FLAG NO MASTER ERROR 04060CSR Z-ADD302 M 96 FLAG ERROR 04070CSR Z-ADD1 F FIELD # 04080CSR GOTO END106 04090C*----------------------------------------------------------------------- 04100CSR T106E TAG 04110C* REWRITE MASTER 04120CSRN40 EXSR SR82 REWRITE MAST 04130CSR GOTO END106 04140C*----------------------------------------------------------------------- 04150CSR T106F TAG 04160C* DELETE TRANSACTION 04170CSR EXSR SR80 GET MASTER 04180CSRN60N61 GOTO T106G GOT IT 04190C* FLAG NO MASTER ERROR 04200CSR Z-ADD302 M 96 FLAG ERROR 04210CSR Z-ADD1 F FIELD # 04220CSR GOTO END106 04230C*----------------------------------------------------------------------- 04240CSR T106G TAG 04250C* DELETE MASTER. ÐÐ04260CSR MOVE 'D' OPSTAT RECORD STATUS 04270CSRN40 EXSR SR82 REWRITE MASTER 04280CSR END106 ENDSR 04290C************************************************************************ 04300CSR SR201 BEGSR 04310C* IDENTIFY FIELD NO. 04320CSR F COMP 1 01 04330CSR F COMP 2 02 04340CSR F COMP 3 03 04350CSR ENDSR 04360C*********************************************************************** 04370CSR SR203 BEGSR 04380C* CLASSIFY TRAN CODE 04390CSR CRTRAN COMP 'A' 60 ADD 04400CSR CRTRAN COMP 'C' 61 CHANGE 04410CSR CRTRAN COMP 'D' 62 DELETE 04420CSR ENDSR 04430C**************************************************************************04440CSR SR205 BEGSR 04450C* MOVE FILE DATA TO 'CR' FIELDS. 04460CSR OPCODE COMP BLK5 54 04470CSR 54 MOVE OPCODE CRCODE OPER CODE. 04480CSR OPDESC COMP BLK40 54 04490CSR 54 MOVE OPDESC CRDESC 04500CSR ENDSR ÐÐ04510C******************************************************************** 04520CSR SR206 BEGSR 04530C* INIT FILE DATA. 04540CSR MOVE BLK5 OPCODE 04550CSR MOVE BLK40 OPDESC 04560CSR MOVE ' ' OPSTAT 04570CSR ENDSR 04580C********************************************************************* 04590CSR SR207 BEGSR 04600C* INIT UPDATE DATA. 04610CSR MOVE BLK5 CRCODE 04620CSR MOVE BLK40 CRDESC 04630CSR ENDSR 04640O******************************************************************** 04650OTERM132 E 71 04660O* PUT HEADING. 04670O BIT,28 1 04680O 2 'K' 04690O 75 'OPERATION CODE UPDATE' 04700O*------------------------------------------------------------------- 04710O E 71 04720O 3 '(1)' 04730O 10 '(2)' 04740O 38 '(3)' 04750O*------------------------------------------------------------------- ÐÐ04760O E 71 04770O 4 'TRAN' 04780O 15 'OPERATION' 04790O*------------------------------------------------------------------- 04800O E 71 04810O 4 'CODE' 04820O 12 'CODE' 04830O 28 'DESCRIPTION' 04840O*------------------------------------------------------------------- 04850O E 71 04860O*------------------------------------------------------------------- 04870O E 72 04880O CRTRAN 2 04890O CRCODE 12 04900O CRDESC 57 04910O*------------------------------------------------------------------- 04920O E 73 04930O 96 5 '*****' 04940O N96 5 ' ' 04950O MGTEXT 41 04960O 96 53 'E R R O R' 04970O N96 53 ' ' 04980O BIT,28 131 04990O 132 'K' 05000O*------------------------------------------------------------------- ÐÐ05010O E 76 05020O* ROLL SCREEN. 05030O NUL 132 05040O BIT,28 1 05050O 8 '8120001' 05060O*------------------------------------------------------------------- 05070O E 76 05080O******************************************************************** 05090OOPDESCR EADD 81 05100O CRCODE 5 05110O CRDESC 46 05120O 47 'A' 05130O*------------------------------------------------------------------ 05140O E 82 05150O CRDESC 46 05160O OPSTAT 47 ** NUL ARRAY 005170 005180** A40 ARRAY 005190 005200** DUN ARRAY 005210 005220** MES ARRAY 005230---MESSAGE NOT ON FILE--- 005240** LOC ARRAY 005250ÐÐ002 1 TRAN CODE 005260008 2 OPER CODE 005270018 3 DESCRIPTION 005280/* 005290_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Â5¥ ¼X012RX P120282120282(èÈÐ00010H Q012RX00020F* TEXT COPY PROGRAM. (X012RX) 00030F* REVISED 10/29/79 4:30 PM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060FREXTPTR ID F 25L21AI 1 DISK 00070FTEXTCOPYO F 400 DISK 00080FMGFILE IC F 80R DISK 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E NUL 50 50 1 00120E A6 6 6 1 00130E A20 20 20 1 A 00140E A44 44 44 1 00150E SAV 1 100 7 0A 00160E BIT 33 1 00170E CALL 5 6 00180E CTX 60 1 A 00190I******************************************************************* 00200IBITTAB BT 00210I 1 33 BIT 00220I********************************************************************* 00230IMGFILE MG 00240I 1 35 MGTEXT 00250I******************************************************************** ÐÐ00260ICRTFILE CR 00270I* MENU FIELDS 1 33 XXXXXX 00280I* CURRENT JOB 6A 00290I 21 26 CRJOB 00300I* CALLED BY PROG 6A 00310I 68 73 CRRET 00320I* CALL STACK 6A X 3 00330I 38 67 CALL 00340I* MENU NAME 6A 00350I 74 79 CRMENU 00360I*------------------------------------------------------------------- 00370I* PART # 12A 00380I 80 91 CRPN 00390I* OPER SEQ # 3N 00400I 92 940CRSEQ 00410I* TEXT WORK AREA 1A X 60 00420I 95 154 CTX 00430I* CUR INSTR 1A 00440I 215 215 CRTRAN 00450I* COPY FROM PN 12A 00460I 216 227 CRFPN 00470I* COPY FROM SEQ 3P 00480I P 228 2290CRFSEQ 00490I* COPY THRU SEQ 3P 00500I P 230 2310CRESEQ ÐÐ00510I* COPY TO SEQ 3P 00520I P 232 2330CRTSEQ 00530I* CURRENT LINE # 7P 00540I P 246 2490CRCLIN 00550I* LINE INCREMENT 3P 00560I P 250 2510CRINCR 00570I******************************************************************** 00580IREXTPTR TP 00590I* TEXT POINTER FILE. 00600I* TEXT NAME 6A 00610I 1 15 TPKEY 00620I 1 12 TPPN 00630I 13 150TPSEQ 00640I* LINE # 6N 00650I 16 210TPLINE 00660I* POINTER 7P 00670I P 25 250TPPTR 61 00680C******************************************************************** 00690C* INITIALIZE. 00700C EXSR SR101 INIT. 00710C H9 GOTO ENDJOB PROG ERROR. 00720C 96 MOVEL'Q002RX' PROG 8 TEXT NOT ON FILE 00730C 96 GOTO END 00740C Z-ADD0 ZERO7 70 STUPIDITY 00750C*------------------------------------------------------------------- ÐÐ00760C START TAG 00770C* PROMPT/READ: FROM PN, FROM SEQ, THRU SEQ. 00780C SETOF 606162 00790C EXSR SR102 PROMPT/READ. 00800C 96 GOTO START ERROR. 00810C 98 GOTO GOODBY 00820C 94 GOTO MENU 00830C 93 GOTO NEWITM 00840C 92 GOTO START 00850C*------------------------------------------------------------------- 00860C TAG20 TAG 00870C* PROMPT/READ: COPY TO LINE, INCREMENT. 00880C EXSR SR103 GET COPY-TO DATA 00890C 96 GOTO START 00900C 98 GOTO GOODBY 00910C 94 GOTO MENU 00920C 93 GOTO NEWITM 00930C 92 GOTO START 00940C SETOF 78 00950C*------------------------------------------------------------------- 00960C TAG30 TAG 00970C* COLLECT COPY-FROM PTRS. 00980C SETOF 55 00990C MOVELCRFPN W21A 21 01000C MOVELCRFSEQ W9A 9 ÐÐ01010C MOVE '000001' W9A 01020C MOVELW9A W21A 01030C W21A SETLLREXTPTR 01040C Z-ADD0 S 30 01050C Z-ADD0 SAV 01060C SETOF 78 01070C*------------------------------------------------------------------- 01080C TAG40 TAG 01090C SETOF 54 01100C READ REXTPTR 54 01110C 54 GOTO TAG45 EOF. 01120C CRFPN COMP TPPN 54 01130C N54 GOTO TAG45 WRONG NAME. 01140C TPSEQ COMP ESEQ 54 01150C 54 GOTO TAG45 PAST END. 01160C 61 GOTO TAG40 INACTIVE 01170C 1 ADD S S 01180C Z-ADDTPPTR SAV,S 01190C S COMP 100 54 54 01200C 1 ADD TPLINE CRFSEQ 01210C N54 GOTO TAG40 01220C SETON 55 01230C*------------------------------------------------------------------ 01240C TAG45 TAG 01250C ZERO7 LOKUPSAV 54 ÐÐ01260C N54 GOTO TAG50 NO PTRS SAVED 01270C* PUT OUT COPY RECORD. 01280C SETON 8178 01290C EXCPT 01300C SETOF 81 01310C 55 GOTO TAG30 01320C*------------------------------------------------------------------- 01330C TAG50 TAG 01340C N78 Z-ADD173 M 96 01350C N78 EXSR SR999 FLAG ERROR. 01360C N78 GOTO START 01370C MOVEL'Q031RX' PROG 8 01380C GOTO END 01390C*------------------------------------------------------------------- 01400C NEWITM TAG 01410C MOVEL'Q002RX' PROG 01420C GOTO END 01430C*------------------------------------------------------------------- 01440C MENU TAG 01450C GOTO ENDJOB 01460C*------------------------------------------------------------------- 01470C GOODBY TAG 01480C MOVEL'GOODBY' PROG 01490C*------------------------------------------------------------------- 01500C END TAG ÐÐ01510C PROG COMP BLK8 54 01520C N54 MOVEL'Q002RX' PROG 01530C EXSR SR97 UPDATE CRTFILE. 01540C EXITFCHAIN 01550C RLABL PROG 01560C*------------------------------------------------------------------- 01570C ENDJOB TAG 01580C******************************************************************** 01590CSR SR73 BEGSR 01600C* PUT MESSAGE TO TERMINAL. 01610CSR SETON 73 01620CSR EXCPT PUT MSG. 01630CSR SETOF 73 01640CSR ENDSR 01650C******************************************************************** 01660CSR SR75 BEGSR 01670C* READ 20-BYTES FROM SCREEN. 01680CSR SETOF 969098 01690CSR SETOF 949392 01700CSR SETOF 77 01710CSR MOVE ' ' W2A 01720CSR MOVE BLK20 W20A 20 01730CSR EXITFQCR20 READ TERMINAL. 01740CSR RLABL W20A 01750CSR RLABL W2A ÐÐ01760CSR MOVE W2A W1A 1 01770CSR W1A COMP BIT,4 54 LF RETURN. 01780CSR 54 EXITFQMOVUP 01790CSR MOVEAW20A A20 01800CSR MOVE BLK20 W20A 01810CSR Z-ADD1 W 30 01820CSR '\' LOKUPA20,W 90 01830CSRN90 GOTO T75B NO ESCAPE. 01840CSR 1 ADD W W 01850CSR W COMP 20 54 01860CSR 54 GOTO T75A BAD ESC. 01870CSR A20,W COMP 'G' 98 GOODBY. 01880CSR A20,W COMP 'E' 94 MENU. 01890CSR A20,W COMP 'N' 93 NEW ITEM. 01900CSR A20,W COMP 'D' 92 DONE. 01910CSR 98 01920COR 94 01930COR 93 01940COR 92 GOTO END75 01950C*------------------------------------------------------------------- 01960CSR T75A TAG 01970C* FLAG BAD ESC CODE. 01980CSR Z-ADD318 M 50 96 FLAG ERROR. 01990CSR EXSR SR999 02000CSR GOTO END75 ÐÐ02010C*------------------------------------------------------------------- 02020CSR T75B TAG 02030CSR Z-ADD1 W 02040CSR ' ' LOKUPA20,W 77 02050CSR 77 MOVEAA20,W W20A 02060CSR END75 ENDSR 02070C******************************************************************** 02080CSR SR77 BEGSR 02090C* CHK FOR CONTROL-D INTERRUPT. 02100CSR MOVE ' ' W2A 2 02110CSR EXITFQSTOP 02120CSR RLABL W2A 02130CSR W2A COMP ' ' 54 02140CSR ENDSR 02150C******************************************************************** 02160CSR SR89 BEGSR 02170C* GET MESSAGE MAST. 02180CSR M CHAINMGFILE 54 02190CSR ENDSR 02200C******************************************************************** 02210CSR SR97 BEGSR 02220C* UPDATE CRTFILE. 02230CSR SETON 97 02240CSR EXCPT UPDATE CRTFILE. 02250CSR SETOF 97 ÐÐ02260CSR ENDSR 02270C*********************************************************************** 02280CSR SR101 BEGSR 02290C* 1-TIME INITIALIZE 02300CSR MOVE BIT,1 NUL 02310CSR MOVE BIT,1 A6 02320CSR MOVE ' ' W8A 8 02330CSR Z-ADD0 W2N 20 02340CSR Z-ADD0 W1N 10 02350CSR MOVE ' ' W2A 2 02360CSR EXITFPGMINX GET PORT # 02370CSR RLABL W8A 02380CSR RLABL W2N 02390CSR RLABL W1N 02400CSR RLABL W2A 02410CSR MOVE W2A PORT 20 02420CSR PORT CHAINCRTFILE H9 02430CSR H9 GOTO END101 PROG ERROR 02440C* DEFINE WORK FIELDS. 02450CSR MOVE ' ' BLK8 8 02460CSR MOVE ' ' BLK6 6 02470CSR MOVE ' ' BLK10 10 02480CSR Z-ADD0 ZERO7 70 02490CSR MOVE ' ' BLK35 35 02500CSR MOVE ' ' BLK20 20 ÐÐ02510CSR MOVE ' ' BLK66 66 02520CSR MOVE ' ' BLK12 12 02530CSR END101 ENDSR 02540C******************************************************************* 02550CSR SR102 BEGSR 02560C* PROMPT/READ: FROM TEXT, FROM LINE #, ENDING LINE #. 02570C*------------------------------------------------------------------- 02580CSR T102A TAG 02590CSR MOVE BLK12 CRFPN 02600CSR Z-ADD0 CRFSEQ 02610CSR Z-ADD0 CRESEQ 02620CSR SETOF 96 02630CSR Z-ADD207 M MSG # 02640CSR EXSR SR89 GET MSG 02650CSR EXSR SR73 PROMPT. 02660CSR EXSR SR75 READ. 02670CSR 96 GOTO T102A 02680CSR 98 GOODBY 02690COR 94 MENU 02700COR 93 NEW ITEM 02710COR 92 GOTO END102 DONE 02720CSR MOVEAW20A A20 02730CSR Z-ADD1 W 30 02740CSR Z-ADD1 X 30 02750CSR ' ' LOKUPA20,W 54 ÐÐ02760CSR ',' LOKUPA20,X 55 02770CSR 55 MOVEABLK20 A20,X 02780CSR MOVEAA20,W W10A 10 02790CSR Z-ADD10 W2N 20 02800CSR EXIT SUBRAJ R. JUSTIFY 02810CSR RLABL W2N 02820CSR RLABL W10A 02830CSR MOVELW10A CRFPN COPY FROM PN 02840CSR MOVEAW20A A20,1 02850CSR Z-ADD1 X 02860CSR ',' LOKUPA20,X 55 02870CSRN55 GOTO T102B 02880CSR 1 ADD X W 02890CSR W COMP 20 54 02900CSR 54 GOTO T102B 02910CSR Z-ADDW S 30 02920CSR Z-ADDW X 02930CSR ',' LOKUPA20,X 55 02940CSR 55 MOVEABLK20 A20,X 02950CSR MOVEAA20,W W6A 6 02960CSR EXSR SR202 R. JUSTIFY. 02970CSR MOVE W6A CRFSEQ COPY FROM LINE# 02980CSR MOVEAW20A A20 02990CSR MOVE BLK8 W7A 03000CSR Z-ADDS W ÐÐ03010CSR ',' LOKUPA20,W 55 03020CSR 55 MOVEAA20,W W7A 7 03030CSR MOVE W7A W6A 03040CSR EXSR SR202 R. JUSTIFY. 03050CSR MOVE W6A CRESEQ COPY THRU LINE# 03060C*------------------------------------------------------------------- 03070CSR T102B TAG 03080CSR CRESEQ COMP 0 55 03090CSR 55 CRESEQ COMP CRFSEQ 55 55 03100CSRN55 Z-ADD171 M 96 03110CSRN55 EXSR SR999 FLAG ERROR. 03120CSR CRFPN COMP BLK12 55 03130CSRN55 Z-ADD208 M 96 FLAG ERROR. 03140CSRN55 EXSR SR999 03150CSR 96 GOTO T102A ERROR. 03160CSR Z-ADDCRFSEQ FSEQ 30 03170CSR Z-ADDCRESEQ ESEQ 30 03180CSR END102 ENDSR 03190C******************************************************************** 03200CSR SR103 BEGSR 03210C* PROMPT/READ: COPY TO LINE, INCREMENT. 03220CSR Z-ADD0 CRTSEQ 03230CSR Z-ADD0 CRINCR 03240CSR SETOF 96 03250C*------------------------------------------------------------------- ÐÐ03260CSR T103A TAG 03270CSR Z-ADD209 M 03280CSR EXSR SR89 GET MSG. 03290CSR EXSR SR73 PUT MSG. 03300CSR EXSR SR75 READ. 03310CSR 96 ERROR. 03320COR 98 03330COR 94 03340COR 93 03350COR 92 GOTO END103 03360CSR MOVEAW20A A20 03370CSR Z-ADD1 W 03380CSR ',' LOKUPA20,W 54 03390CSRN54 GOTO T103B 03400CSR MOVEAA20,W W6A 6 03410CSR EXSR SR202 R. JUSTIFY. 03420CSR MOVE W6A CRINCR INCREMENT #. 03430CSR MOVEABLK20 A20,W 03440C*------------------------------------------------------------------- 03450CSR T103B TAG 03460CSR Z-ADD1 W 03470CSR ' ' LOKUPA20,W 54 03480CSRN54 GOTO T103C 03490CSR MOVEAA20,W W6A 03500CSR EXSR SR202 R. JUSTIFY. ÐÐ03510CSR MOVE W6A CRTSEQ COPY TO LINE# 03520C*------------------------------------------------------------------- 03530CSR T103C TAG 03540CSR CRINCR COMP 0 54 03550CSRN54 Z-ADD2 CRINCR DEFAULT. 03560CSR CRTSEQ COMP 0 55 03570CSRN55 Z-ADD210 M 96 03580CSRN55 EXSR SR999 FLAG ERROR. 03590CSRN55 GOTO T103A 03600CSR END103 ENDSR 03610C******************************************************************** 03620CSR SR202 BEGSR 03630C* RIGHT JUSTIFY. 03640CSR Z-ADD6 W2N 20 03650CSR EXIT SUBRAJ R. JUSTIFY. 03660CSR RLABL W2N 03670CSR RLABL W6A 03680CSR ENDSR 03690C********************************************************************* 03700CSR SR999 BEGSR 03710C* PUT ERR MSG TO TERM. 03720CSR EXSR SR89 GET MESSAGE 03730CSR EXSR SR73 PUT MSG 03740CSR ENDSR 03750O********************************************************************* ÐÐ03760OCRTFILE E 97 03770O CTX 154 03780O CRTRAN 215 03790O CRFPN 227 03800O CRFSEQ 229P 03810O CRESEQ 231P 03820O CRTSEQ 233P 03830O CRTSEQ 239P 03840O CRCLIN 249P 03850O CRINCR 251P 03860O******************************************************************** 03870OTEXTCOPYE 81 03880O SAV B 400P 03890O******************************************************************** 03900OTERM132 E 73 03910O* PUT MESSAGE TO TERMINAL 03920O NUL 93 03930O NUL 132 03940O MGTEXT 40 03950O 96 5 '*****' ** NUL ARRAY 003960 003970** A6 ARRAY 003980 003990** A20 ARRAY 004000ÐÐ 004010** A44 ARRAY 004020 004030** SAV ARRAY 004040 004050/* 004060_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(6b X012XP P120282120282(èÈÐ00010H Q012XP00020F* INITIALIZE EXPLOSION CONTROL RECORD LOW LEVEL CODE DG REL006 OK 00030FXPCONT UP F 128 DISK 00040IXPCONT XC 01 00050I 127 1280XCLL 00060C 01 Z-ADD0 XCLL 00070OXPCONT D 01 00080O XCLL 128 /* 000090_‚ _‚_‚ ÐÈ(,6j ,}X013CF P120282120282(èÈÐ00010H Q013CF00020F* PRINT LABELS, SELECTED, KEY SEQUENCE. (X013CF) 00030F* REVISED 4/25/80 11:30 PM. DG-REL006 OK. 00040FCFKEYOUTIP F 59 59 DISK 00050FCFMAST IC F 370R15AI 1 DISK 00060FPRINT O F 50 PRINTER 00070E******************************************************************** 00080E NA4 5 5 6 00090E NB4 5 5 4 0 00100E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00110E SEL 38 38 1 00120E WRK 38 38 1 A 00130E CSZ 38 38 1 A 00140E BIT 33 1 00150E CFA 8 35 A 00160E CFN 5 3 A 00170E CFC 5 3 0 00180E NAC 24 1 00190I******************************************************************** 00200ICFKEYOUTCK 00210I 36 50 CKKEY 00220I 51 590CKZIP 00230I******************************************************************** 00240ICFMAST CF 01 00250I* CATALOG HOLDER (MAIL LIST) MASTER. ÐÐ00260I* KEY AREA. 00270I* NAME KEY 15A 00280I 1 15 CFKEY 00290I* ADDRESS LINES 35A X 8 00300I 16 295 CFA 00310I* STATE CODE 2A 00320I 296 297 CFSTCD 00330I* ZIP 9P 00340I P 298 3020CFZIP 00350I* CATALOGS. 00360I* NAME 3A X 5 00370I 303 317 CFN 00380I* COPIES 3P X 5 00390I P 318 327 CFC 00400I* SELECTOR CODES 24 X 1A 1 00410I 328 351 NAC 00420I* TELEPHONE # 12A 00430I 352 363 CFTEL 00440I* DATE LAST TRAN 6N (YMD) 00450I 364 3690CFDLT 00460I* RECORD STATUS 1A 00470I 370 370 CFSTAT 00480C******************************************************************** 00490C* INITIALIZE - 1 TIME. 00500C EXSR SR101 INIT. ÐÐ00510C*------------------------------------------------------------------- 00520C CKKEY CHAINCFMAST 54 00530C CFSTAT COMP 'D' 54 00540C 54 SETOF 01 00550C 54 GOTO END DELETED CFMAST. 00560C EXSR SR102 00570C*------------------------------------------------------------------- 00580C END TAG 00590C******************************************************************** 00600CSR SR101 BEGSR 00610C* INITIALIZE 1-TIME. 00620CSR MOVE ' ' BLK16 16 00630CSR MOVE ' ' BLK35 35 00640CSR 78 GOTO END101 00650C*--------------------------------------------------------------- 00660CSR T101A TAG 00670CSR SETON 78 00680CSR SETON 84 00690CSR EXCPT 00700CSR EXCPT 00710CSR EXCPT 00720CSR EXCPT 00730CSR EXCPT 00740CSR EXCPT 00750CSR EXCPT ÐÐ00760CSR EXCPT 00770CSR SETOF 84 00780CSR SETON 83 00790CSR EXCPT 00800CSR SETOF 83 00810CSR MOVE ' ' W6A 6 00820CSR EXITFQREED6 READ CRT 6-BYTES 00830CSR RLABL W6A 00840CSR W6A COMP ' ' 54 00850CSRN54 GOTO T101A ALL BLANKS-REPEAT 00860CSR END101 ENDSR 00870C******************************************************************** 00880CSR SR102 BEGSR 00890C* WRITE LABEL. 00900CSR Z-ADD0 COUNT 30 00910C*R *** EXSR SR201 PUT SELECTOR. 00920CSR Z-ADD1 L 30 00930CSR SETOF 75 00940C*------------------------------------------------------------------- 00950CSR T102A TAG 00960CSR BLK35 LOKUPCFA,L 54 00970CSRN54 GOTO T102W 00980CSR 'D' LOKUPNAC 54 FLAG DOMESTIC 00990CSR L COMP 7 55 FLAG LINE 7 01000CSRN54 NOT DOMESTIC ÐÐ01010CORN55 GOTO T102B NOT LINE 7 01020CSR EXSR SR202 PUT CITY/STATE. 01030CSR GOTO T102W 01040C*------------------------------------------------------------------- 01050CSR T102B TAG 01060CSR SETON 81 01070CSR EXCPT PUT NORMAL LINE 01080CSR SETOF 81 01090CSR SETON 75 01100CSR 1 ADD COUNT COUNT 01110CSR MOVE BLK35 CFA,L 01120CSR GOTO T102A GET NEXT LINE 01130C*------------------------------------------------------------------- 01140CSR T102W TAG 01150C* PUT OUT SPACE LINES. 01160CSR COUNT COMP 8 54 01170CSR 54 GOTO END102 01180CSR SETON 83 01190CSR EXCPT 01200CSR SETOF 83 01210CSR 1 ADD COUNT COUNT 01220CSR GOTO T102W 01230CSR END102 ENDSR 01240C******************************************************************** 01250CSR SR201 BEGSR ÐÐ01260C* BUILD SEL-ARRAY. 01270CSR MOVE ' ' WRK 01280CSR Z-ADD1 A 30 01290CSR Z-ADD1 B 30 01300C*------------------------------------------------------------------- 01310CSR T201A TAG 01320C* MOVE SELECTOR CODES. 01330CSR MOVEANAC WRK 01340CSR ' ' LOKUPWRK,B 54 01350C*------------------------------------------------------------------- 01360CSR T201B TAG 01370CSR ' ' LOKUPCFN,A 54 01380CSRN54 GOTO T201C 01390CSR MOVE ',' WRK,B 01400CSR 1 ADD B B 01410CSR B COMP 38 54 01420CSR 54 GOTO T201C 01430CSR MOVE CFN,A W5A 5 01440CSR MOVEAW5A WRK,B 01450CSR 6 ADD B B 01460CSR B COMP 38 54 01470CSR 54 GOTO T201C 01480CSR MOVE '-' WRK,B 01490CSR 1 ADD B B 01500CSR B COMP 38 54 ÐÐ01510CSR 54 MOVE CFC,A W3A 3 01520CSR MOVEAW3A WRK,B 01530CSR MOVE ' ' CFN,A 01540CSR 1 ADD B B 01550CSR B COMP 38 54 01560CSR 54 GOTO T201C 01570CSR GOTO T201B 01580C*------------------------------------------------------------------- 01590CSR T201C TAG 01600CSR Z-ADD1 A 01610CSR MOVE ' ' SEL 01620CSR ' ' LOKUPWRK,A 54 01630CSR 38 SUB A A 01640CSR 1 ADD A A 54 01650CSR 54 A COMP 38 5454 01660CSRN54 Z-ADD1 A 01670CSR MOVEAWRK SEL,A 01680CSR ENDSR 01690C******************************************************************** 01700CSR SR202 BEGSR 01710C* PUT CITY/STATE/ZIP. 01720CSR MOVE ' ' CSZ INIT CITY LINE 01730CSR MOVEACFA,7 CSZ CITY NAME 01740CSR EXSR SR301 FIND END CITY 01750CSRN55 GOTO T202E NO BLKS LEFT ÐÐ01760CSR MOVE ',' CSZ,A COMMA 01770CSR 2 ADD A A 30 01780CSR A COMP 38 54 01790CSR 54 GOTO T202E NO BLKS LEFT 01800CSR MOVEACFSTCD CSZ,A STATE CODE 01810CSR 4 ADD A A 01820CSR A COMP 38 54 01830CSR 54 GOTO T202E NO BLKS LEFT 01840CSR MOVE CFZIP W5A 5 01850CSR MOVEAW5A CSZ,A ZIP CODE 01860C*------------------------------------------------------------------- 01870CSR T202E TAG 01880CSR SETON 82 01890CSR EXCPT 01900CSR SETOF 82 01910CSR 1 ADD COUNT COUNT PUT CITY/STATE. 01920CSR ENDSR 01930C***************************************************************** 01940CSR SR301 BEGSR 01950C* FIND END OF CITY + 1 01960CSR SETOF 55 01970CSR Z-ADD0 W3N 30 01980CSR Z-ADD1 A 01990C*------------------------------------------------------------------- 02000CSR T301A TAG ÐÐ02010CSR ' ' LOKUPCSZ,A 54 02020CSRN54 1 ADD W3N A 02030CSRN54 GOTO T301B 02040CSR Z-ADDA W3N 02050CSR 1 ADD A A 02060CSR A COMP 38 54 02070CSR 54 GOTO END301 02080CSR GOTO T301A 02090C*-------------------------------------------------------------- 02100CSR T301B TAG 02110CSR A COMP 38 54 02120CSRN54 SETON 55 02130CSR END301 ENDSR 02140C****************************************************************** 02150OPRINT E 1 81 02160O******* 75 SEL 39 02170O CFA,L 36 02180O E 1 82 02190O CSZ 39 02200O E 1 83 02210O E 1 84 02220O 24 'XXXXXXXXXXXXXXXXXXXXXXXX' ** NA4 ARRAY 002230 002240** NB4 ARRAY 002250ÐÐ 002260** TABSC/TABSCN --- STATE CODES/NAMES 002270 002280ALALABAMA 002290AKALASKA 002300AZARIZONA 002310ARARKANSAS 002320ASAMERICAN SAMOA 002330CACALIFORNIA 002340CZCANAL ZONE 002350COCOLORADO 002360CTCONNECTICUT 002370DEDELAWARE 002380DCDISTRICT OF COLUMBIA 002390FLFLORIDA 002400GAGEORGIA 002410GUGUAM 002420HIHAWAII 002430IDIDAHO 002440ILILLINOIS 002450ININDIANA 002460IAIOWA 002470KSKANSAS 002480KYKENTUCKY 002490LALOUISIANA 002500ÐÐMEMAINE 002510MDMARYLAND 002520MAMASSACHUSETTS 002530MIMICHIGAN 002540MNMINNESOTA 002550MSMISSISSIPPI 002560MOMISSOURI 002570MTMONTANA 002580NENEBRASKA 002590NVNEVADA 002600NHNEW HAMPSHIRE 002610NJNEW JERSEY 002620NMNEW MEXICO 002630NYNEW YORK 002640NCNORTH CAROLINA 002650NDNORTH DAKOTA 002660OHOHIO 002670OKOKLAHOMA 002680OROREGON 002690PAPENNSYLVANIA 002700PRPUERTO RICO 002710RIRHODE ISLAND 002720SCSOUTH CAROLINA 002730SDSOUTH DAKOTA 002740TNTENNESSEE 002750ÐÐTTTRUST TERRITORIES 002760TXTEXAS 002770UTUTAH 002780VTVERMONT 002790VAVIRGINIA 002800VIVIRGIN ISLANDS 002810WAWASHINGTON 002820WVWEST VIRGINIA 002830WIWISCONSIN 002840WYWYOMING 002850** SEL ARRAY 002860 002870** WRK ARRAY 002880 002890** CSZ ARRAY 002900 002910/* 002920_‚ ÐÐ_‚_‚UST TERRITORIES 002760TXTEXAS 002770UTUTAH 002780VTVERMONT 002790VAVIRGINIA 002800VIVIRGIN ISLANDS 002810WAWASHINGTON 002820WVWEST VIRGINIA 002830WIWISCONSIN 002840WYWYOMING 002850** SEL ARRAY 002860 002870** WRK ARRAY 002880 002890** CSZ ARRAY 002900 002910/* 002920_‚ ÐÈ(l6è lX109EM P999999120282(èÈÐ00010H Q109EM00020F* EMPLOYEE MASTER UPDATE - VACATION, SICK LEAVE (X109EM) 00030F* REVISED 10-04-82 10:30 AM. 00040F* 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FEMMAST UC F 1536R 5AI 1 DISK 00090FWCMAST IC F 960R 8AI 1 DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A40 40 40 1 A INPUT DATA ARRAY 00140E A39 39 39 1 MGTEXT ARRAY 00150E NUM 1 18 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 19 1 A EDIT CMPLT FLAG 00170E MES 1 1 30 00180E LNK 1 7 6 A 00190E DOTS 17 17 2 00200E MAN 45 45 1 00210E CAL 1 12 2 0 00220E DASH 1 66 2 00230E BIT 33 1 00240E PAR 25 1 00250E TST 25 1 ÐÐ00260E CALL 7 6 CALL STACK 00270E EMJ 5 1 00280I******************************************************************* 00290IBITPAR BT 00300I 1 33 BIT 00310I 34 58 PAR 00320I 59 83 TST 00330I******************************************************************* 00340IMGFILE MG 00350I* MESSAGE FILE. 00360I 1 35 MGTEXT 00370I****************************************************************** 00380ICRTFILE CR 00390I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00400I* EMPLOYEE # 5N 00410I 1 50CREMPL 00420I* TERMINAL USER CODE 00430I 6 13 CRUSER 00440I* DEPT # 5N 00450I 14 180CRDEPT 00460I* JOB NAME 8A (JOB LOADED BY MENU) 00470I* 19 26 CRJOB 00480I* SHUTDOWN FLAG 1A 00490I* BLANK = NO SHUTDOWN 00500I 27 27 CRSHUT ÐÐ00510I* TIME STARTED 6N 00520I 28 330CRTIME 00530I* DATE STARTED 4N 00540I 34 370CRDATE 00550I* CALL STACK 7 X 6A 00560I 38 79 CALL 00570I******************************************************************** 00580IEMMAST EM 00590I* EMPLOYEE MASTER 00600I* CLOCK # 5N 00610I 1 50EMCLOK 00620I*-------PERSONAL DATA------------------------------------------------ 00630I* NAME 00640I* 1ST 25A 00650I 7 31 EMFNAM 00660I* MIDDLE 25A 00670I 32 56 EMMNAM 00680I* LAST 30A 00690I 57 86 EMLNAM 00700I* DEPT 5P 00710I P 336 3380EMDEPT 00720I* WORK CENTER 3P 00730I P 339 3400EMWC 00740I* JOB NAME 28A 00750I* 341 368 EMJOB ÐÐ00760I* JOB STATUS ARRAY 5 X 1A 00770I* 2 = PERM (P) OR TEMP (T) 00780I* 3 = FULL (F) OR PART-TIME (P) 00790I 370 374 EMJ 00800I* HIRE DATE 6N 00810I 498 5030EMHIRD 00820I* ADDITIONAL SENIORITY 00830I 504 5050EMASYR 00840I 506 5070EMASMO 00850I 508 5090EMASDY 00860I* TERMINATION DATA 00870I* DATE 6N 00880I 510 5150EMDATT 00890I* REASON CODE 2A 00900I* 516 517 EMTREA 00910I*-------VACATION---------------------------------------------------- 00920I* CLASS CODE 1A 00930I* 1 = NO VACATION (TEMPORARY) 00940I* 2 = 1/2 ACCRUAL (PART-TIME) 00950I* 3 = 80-HR EARNINGS (90 DAY-5 YR) 00960I* 4 = 120-HR EARNINGS (MORE THAN 5 YR) 00970I 534 534 EMVCC 00980I* EARNED HOURS 9.6P 00990I P 535 5396EMVEH 01000I* HOURS TAKEN 5.1P ÐÐ01010I P 540 5421EMVHT 01020I* LAST DATE PAID IN LIEU OF 6N 01030I 543 5480EMVLDP 01040I* SCHEDULED LEAVE DATE 6N 01050I 549 5540EMVSLD 01060I* ACTUAL LEAVE DATE 6N 01070I 555 5600EMVALD 01080I* SCHEDULED RETURN DATE 6N 01090I 561 5660EMVSRD 01100I* ACTUAL RETURN DATE 6N 01110I 567 5720EMVARD 01120I*-------SICK LEAVE-------------------------------------------------- 01130I* EARNED HOURS 9.6P 01140I P 573 5776EMSLEH 01150I* HOURS TAKEN 5.1P 01160I P 578 5801EMSLHT 01170I* LAST DATE PAID IN LIEU OF 6N 01180I 581 5860EMSLDP 01190I* SCHEDULED LEAVE DATE 6N 01200I 587 5920EMSLSL 01210I* ACTUAL LEAVE DATE 6N 01220I 593 5980EMSLAL 01230I* SCHEDULED RETURN DATE 6N 01240I 599 6040EMSLSR 01250I* ACTUAL RETURN DATE 6N ÐÐ01260I 605 6100EMSLAR 01270I*-------PAYROLL TOTALS YEAR TO DATE ------------------------------- 01280I* EARNED DOLLARS 9.2P X 7 01290I* 1 = REGULAR 01300I* 2 = PREMIUM 01310I* 3 = VACATION 01320I* 4 = SICK LEAVE 01330I* 5 = BONUS 01340I* 6 = OTHER 01350I* 7 = NOT USED 01360I* P 669 703 PTE 01370I*-------LEAVE OF ABSENCE-------------------------------------------- 01380I* LEAVE DATE 6N 01390I 149214970EMLOAL 01400I* RETURN DATE 6N 01410I 149815030EMLOAR 01420I* DAYS TAKEN 3P 01430I P150415050EMLOAT 01440I* RECORD STATUS 1A 01450I 15361536 EMSTAT 01460I******************************************************************** 01470IWCMAST WC 01480I 9 37 WCNAME 01490I 960 960 WCSTAT 01500C******************************************************************** ÐÐ01510C* INITIALIZE 01520C EXSR SR101 1-TIME INIT 01530C MOVE ' ' BLK6 6 STUPIDITY 01540C*------------------------------------------------------------------ 01550C START TAG 01560C* SET-UP 1ST FIELD NO. 01570C EXSR SR66 INIT A39 01580C MOVE ' ' DUN INIT EDIT ARRAY 01590C Z-ADD1 F 30 FIELD # 01600C EXSR SR205 INIT MAST 01610C EXSR SR206 INIT INPUT 01620C EXSR SR70 NEW PAGE 01630C GOTO READ 01640C*------------------------------------------------------------------ 01650C NEXT TAG 01660C EXSR SR66 INIT A39 01670C 1 ADD F F FIELD # 01680C*----------------------------------------------------------------- 01690C READ TAG 01700C* READ DATA FROM TERMINAL. 01710C SETOF 909677 01720C SETOF 95 01730C EXSR SR102 VALIDATE FIELD # 01740C 55 GOTO UPDATE DONE 01750C EXSR SR201 IDENTIFY-F ÐÐ01760C 02 GOTO NEXT 01770C SETON 69 01780C EXSR SR72 PROMPT 01790C SETOF 69 01800C EXSR SR75 READ TERMINAL 01810C 90N88 EXSR SR72 DISPLAY INPUT DATA 01820C 93 GOTO START NEW ITEM 01830C 92 GOTO JUMP FIELD JUMP REQST 01840C 89 F SUB 1 F SKIP BACKWARD 01850C 89 GOTO READ " " 01860C 88 SETOF 90 SPACE FILL 01870C 88 SETON 77 " " 01880C 86 GOTO UPDATE UPDATE 01890C 85 GOTO READ REPEAT 01900C 96 GOTO ERROR ERROR 01910C 77 EXSR SR103 MOVE DATA 01920C*------------------------------------------------------------------- 01930C EDIT TAG 01940C EXSR SR104 EDIT DATA 01950C N95N96 EXSR SR72 REWRITE DATA 01960C N95N96 GOTO NEXT 01970C GOTO ERROR ERROR 01980C*------------------------------------------------------------------ 01990C UPDATE TAG 02000C* UPDATE DATA BASE. ÐÐ02010C EXSR SR105 FINAL EDIT 02020C 96 GOTO ERROR ERROR 02030C EXSR SR106 UPDATE 02040C 96 GOTO ERROR ERROR 02050C 1 ADD COUNT COUNT 30 02060C GOTO START 02070C*------------------------------------------------------------------- 02080C JUMP TAG 02090C* SET-UP JUMP TO REQUESTED FIELD 02100C 1 ADD W W 30 02110C W COMP 40 54 02120C 54 Z-ADD318 M 50 96 FLAG ERROR 02130C 54 GOTO ERROR BAD ESC 02140C MOVE ' ' W3A 3 02150C MOVEAA40,W W3A 02160C Z-ADD3 W2N 20 02170C EXIT SUBRAJ R. JUSTIFY 02180C RLABL W2N 02190C RLABL W3A 02200C MOVE W3A F NEW FIELD # 02210C GOTO READ 02220C*-------------------------------------------------------------------- 02230C ERROR TAG 02240C N95N96 GOTO READ 02250C EXSR SR89 GET MESSAGE ÐÐ02260C 95 EXSR SR72 DISPLAY DATA/MSG 02270C 96 GOTO READ 02280C GOTO NEXT 02290C*-------------------------------------------------------------------- 02300C NEWITM TAG 02310C MOVEL'Q109EM' PROG 8 02320C GOTO END 02330C*------------------------------------------------------------------- 02340C MENU TAG 02350C* SET-UP LINK TO MENU 02360C EXSR SR96 GET CRTFILE 02370C Z-ADD1 W 02380C BLK6 LOKUPLNK,W 54 02390C 54 MOVELLNK,W PROG 8 02400C 54 MOVE BLK6 LNK,W 02410C N54 MOVEL'CONTU 'PROG 02420C EXSR SR97 UPDATE CRTFILE 02430C EXSR SR98 >>>>>>>>>>>>> 02440C*-------------------------------------------------------------------- 02450C GOODBY TAG 02460C* LINK TO SIGN-OFF 02470C MOVEL'GOODBY' PROG 02480C*---------------------------------------------------------------- 02490C END TAG 02500C EXSR SR96 GET CRTFILE ÐÐ02510C EXSR SR97 REWRITE CRTFILE 02520C EXSR SR98 >>>>>>>>>>> 02530C*------------------------------------------------------------------- 02540C ENDJOB TAG 02550C MOVEL'ENDJOB' PROG 02560C EXSR SR98 >>>>>>>>>>>>>>>> 02570C******************************************************************** 02580CSR SR1 BEGSR 02590C* EDIT CLOCK #. 02600CSR TCLOCK COMP 0 54 02610CSRN54 Z-ADD400 M 96 FLAG ERROR 02620CSRN54 GOTO END1 02630CSR EXSR SR80 GET EMMAST 02640CSRN30N31 GOTO T1C GOT IT 02650CSR Z-ADD5 M 96 FLAG ERROR 02660CSR GOTO END1 02670C*------------------------------------------------------------------- 02680CSR T1C TAG 02690C* IS ON FILE. 02700CSR EXSR SR207 CALC LGTH EMPLOY 02710CSR EXSR SR107 BUILD NAME 02720CSR EXSR SR4 CALC VACATION 02730CSR EXSR SR11 CALC SICK LEAVE 02740CSR SETOF 55 02750CSR EMWC COMP 0 55 ÐÐ02760CSR MOVELEMDEPT W8A 8 02770CSR MOVE EMWC W8A 02780CSR W8A CHAINWCMAST 54 02790CSR 54 MOVE BLK35 WCNAME 02800CSR EMDATT COMP 0 43 02810CSR EXSR SR71 PUT SCREEN 02820CSR END1 ENDSR 02830C******************************************************************** 02840CSR SR4 BEGSR 02850C* EDIT HRS TAKEN-VAC. 02860CSR EMVHT COMP EMVEH 54 02870CSR 54 Z-ADD696 M 95 WARNING 02880CSR EMVEH SUB EMVHT VDIF 96H 02890CSR ENDSR 02900C******************************************************************** 02910CSR SR5 BEGSR 02920C* LAST DATE PD (IN LIEU OF) 02930CSR Z-ADDEMVLDP W6N 60 02940CSR EXSR SR210 DATE ROUTINE 02950CSR Z-ADDW6N EMVLDP 02960CSR ENDSR 02970C******************************************************************** 02980CSR SR6 BEGSR 02990C* SCHED LEAVE DATE - VAC. 03000CSR Z-ADDEMVSLD W6N ÐÐ03010CSR EXSR SR210 DATE ROUTINE 03020CSR Z-ADDW6N EMVSLD 03030CSR ENDSR 03040C******************************************************************** 03050CSR SR7 BEGSR 03060C* ACTUAL LEAVE DATE-VAC. 03070CSR Z-ADDEMVALD W6N 03080CSR EXSR SR210 DATE ROUTINE 03090CSR Z-ADDW6N EMVALD 03100CSR ENDSR 03110C******************************************************************** 03120CSR SR8 BEGSR 03130C* SCHED RETURN DATE - VAC. 03140CSR Z-ADDEMVSRD W6N 03150CSR EXSR SR210 DATE ROUTINE 03160CSR Z-ADDW6N EMVSRD 03170CSR EMVSLD COMP EMVSRD 54 03180CSR 54 Z-ADD390 M 96 FLAG ERROR 03190CSR ENDSR 03200C********************************************************************* 03210CSR SR9 BEGSR 03220C* ACTUAL RETURN DATE-VAC. 03230CSR Z-ADDEMVARD W6N 03240CSR EXSR SR210 DATE ROUTINE 03250CSR Z-ADDW6N EMVARD ÐÐ03260CSR EMVALD COMP EMVARD 54 03270CSR 54 Z-ADD390 M 96 FLAG ERROR 03280CSR ENDSR 03290C******************************************************************** 03300CSR SR11 BEGSR 03310C* HRS TAKEN - SICK LEAVE. 03320CSR EMSLHT COMP EMSLEH 54 03330CSR 54 Z-ADD696 M 95 WARNING 03340CSR EMSLEH SUB EMSLHT SDIF 96H 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR12 BEGSR 03380C* LAST DATE PAID - SICK LEAVE 03390CSR Z-ADDEMSLDP W6N 03400CSR EXSR SR210 DATE ROUTINE 03410CSR Z-ADDW6N EMSLDP 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR13 BEGSR 03450C* SCHED LEAVE DATE - SICK LEAVE. 03460CSR Z-ADDEMSLSL W6N 03470CSR EXSR SR210 DATE ROUTINE 03480CSR Z-ADDW6N EMSLSL 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR14 BEGSR 03520C* ACTUAL LEAVE DATE - SICK LEAVE 03530CSR Z-ADDEMSLAL W6N 03540CSR EXSR SR210 DATE ROUTINE 03550CSR Z-ADDW6N EMSLAL 03560CSR ENDSR 03570C******************************************************************** 03580CSR SR15 BEGSR 03590C* SCHED RETURN DATE - SICK LEAVE 03600CSR Z-ADDEMSLSR W6N 03610CSR EXSR SR210 DATE ROUTINE 03620CSR Z-ADDW6N EMSLSR 03630CSR EMSLAL COMP EMSLSR 54 03640CSR 54 Z-ADD390 M 96 FLAG ERROR 03650CSR ENDSR 03660C******************************************************************** 03670CSR SR16 BEGSR 03680C* ACTUAL RETURN DATE - SICK LEAVE 03690CSR Z-ADDEMSLAR W6N 03700CSR EXSR SR210 DATE ROUTINE 03710CSR Z-ADDW6N EMSLAR 03720CSR EMSLAL COMP EMSLAR 54 03730CSR 54 Z-ADD390 M 96 FLAG ERROR 03740CSR ENDSR 03750C******************************************************************** ÐÐ03760CSR SR17 BEGSR 03770C* LEAVE DATE - LEAVE OF ABSENCE. 03780CSR Z-ADDEMLOAL W6N 03790CSR EXSR SR210 DATE ROUTINE 03800CSR Z-ADDW6N EMLOAL 03810CSR ENDSR 03820C******************************************************************** 03830CSR SR18 BEGSR 03840C* RETURN DATE - LEAVE OF ABSENCE 03850CSR Z-ADDEMLOAR W6N 03860CSR EXSR SR210 DATE ROUTINE 03870CSR Z-ADDW6N EMLOAR 03880CSR EMLOAL COMP EMLOAR 54 03890CSR 54 Z-ADD390 M 96 FLAG ERROR 03900CSR ENDSR 03910C******************************************************************** 03920CSR SR25 BEGSR 03930C* GENERAL EDIT - VACATION HRS. 03940CSR EMVEH SUB EMVHT W9D6 96H54 54 03950CSR 54 GOTO T25C 03960C* FLAG ILLOGICAL HOURS. 03970CSR Z-ADD696 M WARNING 03980CSR Z-ADD3 F 03990CSR EXSR SR74 PUT WARNING 04000C*------------------------------------------------------------------- ÐÐ04010CSR T25C TAG 04020CSR EMJ,2 COMP 'T' 56 TEMPORARY 04030CSR EMJ,3 COMP 'P' 57 PART-TIME 04040CSR MONTHS COMP 3 58 04050CSR MONTHS COMP 60 59 04060CSR 59 Z-ADD160 LIMIT 96 GT 5 YR 04070CSRN59 Z-ADD120 LIMIT LT 5 YR 04080CSRN58 Z-ADD0 LIMIT LT 90 DAYS 04090CSR 57 Z-ADD60 LIMIT PART-TIME 04100CSR 56 Z-ADD0 LIMIT TEMPORARY 04110CSR EMVEH COMP LIMIT 54 04120CSR 54 Z-ADD697 M WARNING 04130CSR 54 Z-ADD3 F 04140CSR 54 EXSR SR74 PUT WARNING 04150CSR ENDSR 04160C******************************************************************** 04170CSR SR65 BEGSR 04180C* COMPUTE LINE # 04190CSR Z-ADDF W3N 30 04200CSR F COMP 1 54 04210CSR 54 1 ADD W3N W3N 04220CSR F COMP 2 54 04230CSR 54 1 ADD W3N W3N 04240CSR F COMP 9 54 04250CSR 54 1 ADD W3N W3N ÐÐ04260CSR F COMP 16 54 04270CSR 54 1 ADD W3N W3N 04280CSRN50 90 ADD W3N W3N 04290CSR ENDSR 04300C******************************************************************** 04310CSR SR66 BEGSR 04320CSR MOVEABLK35 A39,3 INIT A39 04330CSR ENDSR 04340C******************************************************************** 04350CSR SR67 BEGSR 04360CSR EXITFZCR 04370CSR ENDSR 04380C***************************************************************** 04390CSR SR68 BEGSR 04400CSR EXITFZLF LINE FEED 04410CSR ENDSR 04420C**************************************************************** 04430CSR SR69 BEGSR 04440CSR 50 EXITFZPUTXY MOVE CURSOR 04450CSR RLABL RPGLIN 04460CSR RLABL RPGCOL 04470CSRN50 EXITFZMOVXY MOVE CURSOR 04480CSR RLABL RPGLIN 04490CSR RLABL RPGCOL 04500CSR ENDSR ÐÐ04510C***************************************************************** 04520CSR SR70 BEGSR 04530C* CLEAR TERM SCREEN. 04540CSR 50 EXITFZISTAT INIT STATUS LINE 04550CSR 50 EXITFZESCH CLEAR SCREEN 04560CSRN50 EXITFZCPAGE CLEAR SCREEN 04570CSRN50 MOVEL'091' RPGLIN 04580CSRN50 MOVEL'001' RPGCOL 04590CSRN50 EXSR SR69 MOVE CURSOR 04600CSR Z-ADD91 COUNT 30 04610CSR SETON 70 04620CSRN51 EXCPT PUT HDG 1ST LINE 04630CSR SETOF 70 04640CSR ENDSR 04650C********************************************************************** 04660CSR SR71 BEGSR 04670C* PUT HEADINGS TO TERMINAL 04680CSR EXSR SR208 FULL/PART 04690CSR EMWC COMP 0 55 04700CSR SETON 71 04710CSR EXCPT PUT HEADINGS 04720CSR SETOF 7143 04730CSR Z-ADD91 COUNT 04740CSR ENDSR 04750C********************************************************************* ÐÐ04760CSR SR72 BEGSR 04770C* PUT DATA TO TERMINAL 04780CSR EXSR SR208 FULL/PART 04790CSR EXSR SR65 COMPUTE LINE # 04800CSR MOVELW3N RPGLIN 4 04810CSR MOVEL'001' RPGCOL 4 04820CSR EXSR SR69 MOVE CURSOR 04830CSR SETON 72 04840CSR EXCPT PUT DATA 04850CSR SETOF 72 04860CSR ENDSR 04870C**************************************************************** 04880CSR SR74 BEGSR 04890C* PUT WARNING MESSAGE 04900CSR EXSR SR201 CLASSIFY-F 04910CSR EXSR SR89 GET MESSAGE 04920CSR EXSR SR72 PUT MESSAGE 04930CSR ENDSR 04940C******************************************************************* 04950CSR SR75 BEGSR 04960C* READ FROM TERMINAL 04970CSR SETOF 779096 04980CSR SETOF 9392 04990CSR SETOF 8988 05000CSR SETOF 8685 ÐÐ05010CSR EXSR SR66 INIT A39 05020CSR MOVE BLK40 W40A 40 BUFFER 05030CSR EXSR SR65 COMPUTE LINE # 05040CSR 1 ADD W3N W3N 05050CSR MOVELW3N RPGLIN 4 05060CSR MOVEL'044' RPGCOL 4 05070CSR EXSR SR69 MOVE CURSOR 05080CSR EXITFZR40 READ FROM TERMINAL 05090CSR RLABL W40A READ BUFFER 05100CSR MOVEAW40A A40 INPUT DATA ARRAY 05110CSR MOVE BLK40 W40A INIT INPUT ARRAY 05120CSR Z-ADD1 W 30 05130CSR '\' LOKUPA40,W 90 FLAG ESC 05140CSRN90 GOTO T75B NOT ESC 05150CSR 1 ADD W W 05160CSR W COMP 40 54 05170CSR 54 GOTO T75A BAD ESC 05180CSR A40,W COMP 'G' 98 GOODBY 05190CSR A40,W COMP 'E' 94 MENU 05200CSR A40,W COMP 'N' 93 NEW ITEM 05210CSR A40,W COMP 'J' 92 JUMP 05220CSR A40,W COMP 'B' 89 SKIP BKWRD 05230CSR A40,W COMP 'S' 88 SPACE FILL 05240CSR A40,W COMP 'U' 86 UPDATE 05250CSR A40,W COMP 'R' 85 REPEAT ÐÐ05260CSR 98 GOTO GOODBY 05270CSR 94 GOTO MENU 05280CSR 93 GOTO NEWITM 05290CSR 92 05300COR 89 05310COR 88 05320COR 86 05330COR 85 GOTO END75 GOOD ESC 05340C*------------------------------------------------------------------ 05350CSR T75A TAG 05360C* FLAG BAD ESC INPUT 05370CSR Z-ADD318 M 96 FLAG ERROR 05380CSR GOTO END75 05390C*-------------------------------------------------------------------- 05400CSR T75B TAG 05410C* MOVE DATA 05420CSR Z-ADD1 W 05430CSR ' ' LOKUPA40,W 77 05440CSR 77 MOVEAA40,W W40A INPUT DATA 05450C*-------------------------------------------------------------------- 05460CSR END75 TAG 05470C* INIT PREV ERROR MSG. 05480CSR EXSR SR66 05490CSR ENDSR 05500C********************************************************************** ÐÐ05510CSR SR80 BEGSR 05520C* GET MASTER RECORD 05530CSR SETOF 31 05540CSR TCLOCK CHAINEMMAST 30 GET MASTER 05550CSRN30 EMSTAT COMP 'D' 31 FLAG DELETE 05560CSR 30 05570COR 31 EXSR SR205 INIT MASTER 05580CSR ENDSR 05590C*********************************************************************** 05600CSR SR82 BEGSR 05610C* REWRITE MASTER 05620CSR SETON 82 05630CSR EXCPT REWRITE MASTER 05640CSR SETOF 82 05650CSR ENDSR 05660C********************************************************************** 05670CSR SR89 BEGSR 05680C* GET MESSAGE MASTER 05690CSR M CHAINMGFILE 54 05700CSR 54 MOVE BLK35 MGTEXT 05710CSR 54 MOVELM MGTEXT 05720CSR 54 MOVE MES,1 MGTEXT 05730CSR MOVEAMGTEXT A39,3 05740CSR ENDSR 05750C******************************************************************** ÐÐ05760CSR SR96 BEGSR 05770CSR # CHAINCRTFILE H9 GET CRTFILE 05780CSR H9 GOTO ENDJOB 05790CSR ENDSR 05800C****************************************************************** 05810CSR SR97 BEGSR 05820C* UPDATE CRTFILE. EXIT PROGRAM. 05830CSR TIME CRTIME 05840CSR MOVELUDATE CRDATE 05850CSR SETON 97 05860CSR EXCPT UPDATE CRTFILE 05870CSR SETOF 97 05880CSR ENDSR 05890C******************************************************************** 05900CSR SR98 BEGSR 05910CSR SETON 51 05920CSR EXSR SR70 CLEAR SCREEN 05930CSR EXITFCHAIN >>>>>>>>>> 05940CSR RLABL PROG 05950CSR ENDSR 05960C******************************************************************** 05970CSR SR99 BEGSR 05980C* STORE THIS PROG AS RETURN TO PROG. 05990CSR EXSR SR96 GET CRTFILE 06000CSR Z-ADD8 W ÐÐ06010C*------------------------------------------------------------------- 06020CSR T99A TAG 06030CSR W SUB 1 W 54 06040CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 06050CSR LNK,W COMP BLK6 54 06060CSRN54 GOTO T99A 06070CSR MOVELRETURN LNK,W 06080CSR EXSR SR97 UPDATE CRTFILE 06090CSR EXSR SR98 >>>>>>>>>>>>>> 06100CSR END99 ENDSR 06110C*********************************************************************** 06120CSR SR101 BEGSR 06130C* 1-TIME INITIALIZE 06140CSR MOVE BIT,1 NUL 06150CSR MOVE ' ' A39 06160CSR MOVE BIT,28 A39,1 06170CSR MOVE 'D' A39,2 06180CSR MOVE BIT,28 A39,38 06190CSR MOVE 'E' A39,39 06200CSR Z-ADD19 FLIMIT 30 TOTAL NUMB FIELDS 06210CSR MOVE ' ' BLK40 40 06220CSR Z-ADD17 X 30 06230CSR MOVE '-' DOTS 06240CSR MOVEL'>' DOTS,X 06250CSR MOVE ' ' DOTS,X ÐÐ06260CSR MOVE '- ' DASH 06270C* GET PORT # AND CRTFILE 06280CSR MOVE ' ' W2A 2 06290CSR EXITFZGMINX GET PORT # 06300CSR RLABL W2A 06310CSR MOVE W2A # 20 PORT NO. 06320CSR # COMP 0 54 06330CSRN54 Z-ADD25 # DEFAULT 06340CSR EXSR SR96 GET CRTFILE 06350CSR MOVE CALL LNK 06360CSR MOVE 'Q109EM 'PROG 06370CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 06380CSR TST,# COMP 'S' 56 06390CSRN56 CRSHUT COMP 'S' 56 06400CSR 56 MOVE 'S' CRSHUT SHUTDOWN 06410CSR 56 MOVE 'SHUTDOWN'PROG 06420CSR EXSR SR97 UPDATE CRTFILE 06430CSR 56 EXSR SR98 >>>>>>>>>>>>> 06440C* DEFINE WORK FIELDS,ETC. 06450CSR MOVE BLK8 RETURN 8 06460CSR MOVE ' ' BLK35 35 06470CSR MOVE ' ' BLK28 28 06480CSR MOVE ' ' BLK25 25 06490CSR MOVE ' ' BLK30 30 06500CSR MOVE ' ' BLK20 20 ÐÐ06510CSR MOVE ' ' BLK8 8 06520CSR MOVE ' ' BLK15 15 06530CSR MOVE ' ' BLK6 6 06540CSR ENDSR 06550C********************************************************************** 06560CSR SR102 BEGSR 06570C* VALIDATE FIELD NO. 06580CSR F COMP 0 54 06590CSRN54 Z-ADD1 F 06600CSR F COMP FLIMIT 55 06610CSR 55 Z-ADD1 F 06620CSR ENDSR 06630C******************************************************************** 06640CSR SR103 BEGSR 06650C* MOVE INPUT DATA 06660CSR EXSR SR201 IDENTIFY-F 06670CSR EXSR SR202 RIGHT ADJUST 06680CSR 01 MOVE W15A TCLOCK 50 CLOCK # 06690CSR 02 MOVELW40A EMVCC CLASS CODE 06700CSR 03 MOVE W15A EMVEH VAC-EARNED HRS 06710CSR 04 MOVE W15A EMVHT VAC-HRS TAKEN 06720CSR 05 MOVE W15A EMVLDP VAC-LAST DATE PD 06730CSR 06 MOVE W15A EMVSLD VAC-SCHED LV DATE 06740CSR 07 MOVE W15A EMVALD VAC-ACTUAL LV DATE 06750CSR 08 MOVE W15A EMVSRD VAC-SCHED RET DATE ÐÐ06760CSR 09 MOVE W15A EMVARD VAC-ACTUAL RET DATE 06770CSR 10 MOVE W15A EMSLEH S/L-EARNED HRS 06780CSR 11 MOVE W15A EMSLHT S/L-HRS TAKEN 06790CSR 12 MOVE W15A EMSLDP S/L-LAST DATE PD 06800CSR 13 MOVE W15A EMSLSL S/L-SCHED LV DATE 06810CSR 14 MOVE W15A EMSLAL S/L-ACTUAL LV DATE 06820CSR 15 MOVE W15A EMSLSR S/L-SCHED RET DATE 06830CSR 16 MOVE W15A EMSLAR S/L-ACTUAL RET DATE 06840CSR 17 MOVE W15A EMLOAL LOA-LEAVE DATE 06850CSR 18 MOVE W15A EMLOAR LOA-RET DATE 06860CSR 19 MOVE W15A EMLOAT LOA-DAYS TAKEN 06870CSR MOVE ' ' DUN,F EDIT FLAG 06880CSR ENDSR 06890C******************************************************************** 06900CSR SR104 BEGSR 06910C* EDIT INPUT DATA 06920CSR 01 EXSR SR1 06930CSR 03 06940COR 04 EXSR SR4 06950CSR 04 EXSR SR25 06960CSR 05 EXSR SR5 06970CSR 06 EXSR SR6 06980CSR 07 EXSR SR7 06990CSR 08 EXSR SR8 07000CSR 09 EXSR SR9 ÐÐ07010CSR 11 EXSR SR11 07020CSR 12 EXSR SR12 07030CSR 13 EXSR SR13 07040CSR 14 EXSR SR14 07050CSR 15 EXSR SR15 07060CSR 16 EXSR SR16 07070CSR 17 EXSR SR17 07080CSR 18 EXSR SR18 07090CSR 96 MOVE ' ' DUN,F EDIT FLAG 07100CSRN96 MOVE 'X' DUN,F 07110CSR ENDSR 07120C*********************************************************************** 07130CSR SR105 BEGSR 07140C* FINAL EDIT 07150CSR SETOF 77 07160CSR SETON 79 FINAL EDIT FLAG 07170CSR Z-ADD1 F 96 07180C*-------------------------------------------------------------------- 07190CSR T105A TAG 07200CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 07210CSRN54 GOTO END105 07220CSR EXSR SR201 IDENTIFY-F 07230CSR EXSR SR104 EDIT 07240CSRN96 GOTO T105A 07250C*-------------------------------------------------------------------- ÐÐ07260CSR END105 TAG 07270CSR EXSR SR25 GENERAL EDIT 07280CSR SETOF 79 07290CSR ENDSR 07300C******************************************************************** 07310CSR SR106 BEGSR 07320C* UPDATE DATA BASE. 07330CSRN30N31 GOTO T106E GOT IT 07340C* FLAG NO MASTER ERROR 07350CSR Z-ADD302 M 96 FLAG ERROR 07360CSR Z-ADD1 F FIELD # 07370CSR GOTO END106 07380C*----------------------------------------------------------------------- 07390CSR T106E TAG 07400C* REWRITE MASTER 07410CSR EXSR SR82 REWRITE MAST 07420CSR END106 ENDSR 07430C******************************************************************** 07440CSR SR107 BEGSR 07450C* BUILD NAME. 07460CSR SETOF 5758 07470CSR MOVE ' ' MAN 07480CSR MOVEAEMFNAM MAN 07490CSR Z-ADD46 X 30 07500C*------------------------------------------------------------------- ÐÐ07510CSR T107A TAG 07520CSR X SUB 1 X 54 07530CSRN54 GOTO END107 07540CSR MAN,X COMP ' ' 54 07550CSRN54 GOTO T107A 07560CSR 2 ADD X X 07570CSR X COMP 45 54 07580CSR 54 GOTO END107 07590CSRN57 MOVEAEMMNAM MAN,X 07600CSR 57 MOVEAEMLNAM MAN,X 07610CSR 57 SETON 58 07620CSR SETON 57 07630CSRN58 Z-ADD46 X 07640CSRN58 GOTO T107A 07650CSR END107 ENDSR 07660C************************************************************************ 07670CSR SR201 BEGSR 07680C* IDENTIFY FIELD NO. 07690CSR F COMP 1 01 07700CSR F COMP 2 02 07710CSR F COMP 3 03 07720CSR F COMP 4 04 07730CSR F COMP 5 05 07740CSR F COMP 6 06 07750CSR F COMP 7 07 ÐÐ07760CSR F COMP 8 08 07770CSR F COMP 9 09 07780CSR F COMP 10 10 07790CSR F COMP 11 11 07800CSR F COMP 12 12 07810CSR F COMP 13 13 07820CSR F COMP 14 14 07830CSR F COMP 15 15 07840CSR F COMP 16 16 07850CSR F COMP 17 17 07860CSR F COMP 18 18 07870CSR F COMP 19 19 07880CSR END201 ENDSR 07890C********************************************************************** 07900CSR SR202 BEGSR 07910C* RIGHT JUSTIFY 07920CSR F LOKUPNUM 54 07930CSRN54 GOTO END202 NOT NUMERIC FIELD 07940CSR Z-ADD15 W2N 20 07950CSR MOVELW40A W15A 15 07960CSR EXIT SUBRAJ R. JUSTIFY 07970CSR RLABL W2N 07980CSR RLABL W15A 07990CSR END202 ENDSR 08000C******************************************************************** ÐÐ08010CSR SR205 BEGSR 08020C* INIT EMMAST FIELDS. 08030CSR Z-ADD0 EMCLOK 08040CSR MOVE BLK25 EMFNAM 08050CSR MOVE BLK25 EMMNAM 08060CSR MOVE BLK35 EMLNAM 08070CSR Z-ADD0 EMDEPT 08080CSR Z-ADD0 EMWC 08090CSR MOVE ' ' EMJ 08100CSR Z-ADD0 EMHIRD 08110CSR Z-ADD0 EMASYR 08120CSR Z-ADD0 EMASMO 08130CSR Z-ADD0 EMASDY 08140CSR MOVE ' ' EMVCC 08150CSR Z-ADD0 EMVEH 08160CSR Z-ADD0 EMVHT 08170CSR Z-ADD0 EMVLDP 08180CSR Z-ADD0 EMVSLD 08190CSR Z-ADD0 EMVALD 08200CSR Z-ADD0 EMVSRD 08210CSR Z-ADD0 EMVARD 08220CSR Z-ADD0 EMSLEH 08230CSR Z-ADD0 EMSLHT 08240CSR Z-ADD0 EMSLDP 08250CSR Z-ADD0 EMSLSL ÐÐ08260CSR Z-ADD0 EMSLAL 08270CSR Z-ADD0 EMSLSR 08280CSR Z-ADD0 EMSLAR 08290CSR Z-ADD0 EMLOAL 08300CSR Z-ADD0 EMLOAR 08310CSR MOVE ' ' MAN 08320CSR Z-ADD0 EMLOAT 08330CSR MOVE BLK35 WCNAME 08340CSR ENDSR 08350C******************************************************************** 08360CSR SR206 BEGSR 08370C* INIT INPUT ONLY FIELDS 08380CSR Z-ADD0 TCLOCK CLOCK # 08390CSR SETOF 3031 08400CSR ENDSR 08410C******************************************************************** 08420CSR SR207 BEGSR 08430C* CALCULATE LENGTH OF EMPLOYMENT 08440C* SET-UP CURRENT OR TERMINATION DATE 08450CSR Z-ADDUDATE W6N 08460CSR EXSR SR210 DATE ROUTINE 08470CSR EMDATT COMP 0 54 08480CSR 54 Z-ADDEMDATT W6N 08490CSR MOVELW6N CYR 20 08500CSR MOVE W6N W4N 40 ÐÐ08510CSR MOVELW4N CMO 20 08520CSR MOVE W4N CDAY 20 08530C*------------------------------------------------------------------- 08540C* SET-UP HIRE DATE 08550CSR MOVELEMHIRD HYR 20 08560CSR MOVE EMHIRD W4N 08570CSR MOVELW4N HMO 20 08580CSR MOVE W4N HDAY 20 08590C*------------------------------------------------------------------- 08600C* CALCULATE LENGTH OF SERVICE 08610CSR HDAY COMP CDAY 54 08620CSRN54 GOTO T207B 08630CSR Z-ADDHMO X 30 54 08640CSRN54 Z-ADD1 X 08650CSR X COMP 12 54 08660CSR 54 Z-ADD12 X 08670CSR CMO SUB 1 CMO 54 08680CSRN54 Z-ADD12 CMO 08690CSRN54 CYR SUB 1 CYR 08700CSR CAL,X ADD CDAY CDAY 08710C*------------------------------------------------------------------- 08720CSR T207B TAG 08730CSR HMO COMP CMO 54 08740CSRN54 GOTO T207E 08750CSR 12 ADD CMO CMO ÐÐ08760CSR CYR SUB 1 CYR 08770C*------------------------------------------------------------------- 08780CSR T207E TAG 08790CSR CYR SUB HYR DYR 20 08800CSR CMO SUB HMO DMO 20 08810CSR CDAY SUB HDAY DDAY 20 08820CSR EMASYR ADD DYR DYR 08830CSR EMASMO ADD DMO DMO 08840CSR EMASDY ADD DDAY DDAY 08850CSR DDAY COMP 30 54 08860CSR 54 1 ADD DMO DMO 08870CSR 54 DDAY SUB 30 DDAY 08880CSR DMO COMP 12 54 08890CSR 54 DMO SUB 12 DMO 08900CSR 54 1 ADD DYR DYR 08910CSR 12 MULT DYR MONTHS 60 08920CSR DMO ADD MONTHS MONTHS 08930CSR MONTHS SUB 1 MONTHS 08940CSR ENDSR 08950C******************************************************************** 08960CSR SR208 BEGSR 08970C* FULL/PART TIME. 08980CSR EMJ,3 COMP 'F' 52 08990CSR EMJ,3 COMP 'P' 53 09000CSR EMJ,2 COMP 'P' 48 PERMANENT ÐÐ09010CSR EMJ,2 COMP 'T' 49 TEMPORARY 09020CSR ENDSR 09030C******************************************************************** 09040CSR SR210 BEGSR 09050C* EDIT DATE ROUTINE. 09060CSR MOVELW6N W2N 20 09070CSR W2N COMP 12 54 09080CSRN54 MOVELW6N W4N 40 09090CSRN54 MOVE W6N W2N 09100CSRN54 MOVELW2N W6N 09110CSRN54 MOVE W4N W6N 09120CSR W6N COMP 0 54 09130CSRN54 GOTO END210 09140CSR MOVE W6N W4N 09150CSR MOVELW4N W2N 09160CSR W2N COMP 0 54 GT 09170CSR 54 W2N COMP 12 5454LE 09180CSRN54 Z-ADD390 M 96 FLAG ERROR 09190CSR MOVE W4N W2N 09200CSR W2N COMP 0 54 GT 09210CSR 54 W2N COMP 31 5454LE 09220CSRN54 Z-ADD390 M 96 FLAG ERROR 09230CSR END210 ENDSR 09240O******************************************************************** 09250OTERM132 E 70 ÐÐ09260O OR 71 09270O BIT,28 1 09280O N50 8 '8091001' 09290O N50 BIT,1 9 09300O N50 BIT,1 10 09310O 50 10 '[001 ]001' 09320O 50 BIT,28 6 09330O UDATE 18 ' - - ' 09340O 45 'E M P L O Y E E' 09350O 60 'M A S T E R' 09360O 64 '-' 09370O 82 'V A C A T I O N' 09380O 87 ' / ' 09390O 107 'S I C K L E A V E' 09400O 43 50 BIT,28 110 09410O 43 50 111 'D' 09420O 43 121 'TERMINATED' 09430O 43 EMDATTY 130 09440O 43 50 BIT,28 131 09450O 43 50 132 'E' 09460O*------------------------------------------------------------------ 09470O E 70 09480O OR 71 09490O OR 72 01 09500O DOTS 40 ÐÐ09510O 15 '(1) CLOCK NO.' 09520O TCLOCKZ 47 09530O MAN 94 09540O A39 132 09550O*------------------------------------------------------------------- 09560O E 70 09570O OR 71 09580O 50 'DEPT-W/C:' 09590O EMDEPTZ 57 09600O 55 58 '-' 09610O 55 EMWC 61 09620O WCNAME 92 09630O*------------------------------------------------------------------- 09640O E 71 09650O OR 72 02 09660O 46 'CLASS' 09670O 50 ':' 09680O EMVCC 52 09690O 52 57 'FULL' 09700O 53 57 'PART' 09710O 62 'TIME' 09720O 64 '/' 09730O 48 74 'PERMANENT' 09740O 49 74 'TEMPORARY' 09750O 96 'LGTH SERVICE:' ÐÐ09760O 101 'YRS:' 09770O DYR Z 104 09780O 111 'MOS:' 09790O DMO Z 114 09800O 122 'DAYS:' 09810O DDAY Z 125 09820O*------------------------------------------------------------------- 09830O E 71 09840O DASH 132 09850O 15 'V A C A T I O N' 09860O*------------------------------------------------------------------- 09870O E 71 09880O OR 72 03 09890O DOTS 40 09900O 18 '(3) EARNED HOURS' 09910O EMVEH 2 53 09920O A39 132 09930O*------------------------------------------------------------------- 09940O E 71 09950O OR 72 04 09960O DOTS 40 09970O 17 '(4) HOURS TAKEN' 09980O EMVHT 2 48 09990O VDIF K 69 10000O 78 'NOT TAKEN' ÐÐ10010O A39 132 10020O*------------------------------------------------------------------- 10030O E 71 10040O OR 72 05 10050O DOTS 40 10060O 20 '(5) LAST DATE PAID' 10070O EMVLDP 50 ' - - ' 10080O A39 132 10090O*------------------------------------------------------------------- 10100O E 71 10110O OR 72 06 10120O DOTS 40 10130O 22 '(6) SCHED LEAVE DATE' 10140O EMVSLD 50 ' - - ' 10150O A39 132 10160O*------------------------------------------------------------------- 10170O E 71 10180O OR 72 07 10190O DOTS 40 10200O 23 '(7) ACTUAL LEAVE DATE' 10210O EMVALD 50 ' - - ' 10220O A39 132 10230O*------------------------------------------------------------------- 10240O E 71 10250O OR 72 08 ÐÐ10260O DOTS 40 10270O 23 '(8) SCHED RETURN DATE' 10280O EMVSRD 50 ' - - ' 10290O A39 132 10300O*------------------------------------------------------------------- 10310O E 71 10320O OR 72 09 10330O DOTS 40 10340O 24 '(9) ACTUAL RETURN DATE' 10350O EMVARD 50 ' - - ' 10360O A39 132 10370O*------------------------------------------------------------------- 10380O E 71 10390O DASH 132 10400O 19 'S I C K L E A V E' 10410O*------------------------------------------------------------------- 10420O E 71 10430O OR 72 10 10440O DOTS 40 10450O 18 '(10) EARNED HOURS' 10460O EMSLEH2 53 10470O A39 132 10480O*------------------------------------------------------------------ 10490O E 71 10500O OR 72 11 ÐÐ10510O DOTS 40 10520O 17 '(11) HOURS TAKEN' 10530O EMSLHT2 48 10540O SDIF K 69 10550O 78 'NOT TAKEN' 10560O A39 132 10570O*------------------------------------------------------------------- 10580O E 71 10590O OR 72 12 10600O DOTS 40 10610O 20 '(12) LAST DATE PAID' 10620O EMSLDP 50 ' - - ' 10630O A39 132 10640O*------------------------------------------------------------------- 10650O E 71 10660O OR 72 13 10670O DOTS 40 10680O 22 '(13) SCHED LEAVE DATE' 10690O EMSLSL 50 ' - - ' 10700O A39 132 10710O*------------------------------------------------------------------- 10720O E 71 10730O OR 72 14 10740O DOTS 40 10750O 23 '(14) ACTUAL LEAVE DATE' ÐÐ10760O EMSLAL 50 ' - - ' 10770O A39 132 10780O*------------------------------------------------------------------- 10790O E 71 10800O OR 72 15 10810O DOTS 40 10820O 23 '(15) SCHED RETURN DATE' 10830O EMSLSR 50 ' - - ' 10840O A39 132 10850O*------------------------------------------------------------------- 10860O E 71 10870O OR 72 16 10880O DOTS 40 10890O 24 '(16) ACTUAL RETURN DATE' 10900O EMSLAR 50 ' - - ' 10910O A39 132 10920O*------------------------------------------------------------------- 10930O E 71 10940O DASH 132 10950O 24 'L E A V E O F A B S ' 10960O 31 'E N C E' 10970O*------------------------------------------------------------------- 10980O E 71 10990O OR 72 17 11000O DOTS 40 ÐÐ11010O 16 '(17) LEAVE DATE' 11020O EMLOAL 50 ' - - ' 11030O A39 132 11040O*------------------------------------------------------------------- 11050O E 71 11060O OR 72 18 11070O DOTS 40 11080O 17 '(18) RETURN DATE' 11090O EMLOAR 50 ' - - ' 11100O A39 132 11110O*------------------------------------------------------------------- 11120O E 71 11130O OR 72 19 11140O DOTS 40 11150O 16 '(19) DAYS TAKEN' 11160O EMLOATZ 45 11170O A39 132 11180O**************************************************************** 11190OCRTFILE E 97 11200O PROG 26 11210O CRTIME 33 11220O CRDATE 37 11230O LNK 79 11240O******************************************************************** 11250OEMMAST E 82 ÐÐ11260O EMFNAM 31 11270O EMMNAM 56 11280O EMLNAM 86 11290O* EMS 156 11300O* EMCITY 181 11310O* EMSTCD 183 11320O* EMZIP 188P 11330O* EMPHON 203 11340O* EME 253 11350O* EEO 261 11360O* EMBIRD 267 11370O* EMEDUC 297 11380O* EMSNAM 327 11390O* EMSBIR 333 11400O EMDEPT 338P 11410O EMWC 340P 11420O* EMJOB 368 11430O* EMJ 374 11440O* EMRATE 379P 11450O* EMLRD 463 11460O* EMLRT 464 11470O* EMLRP 470 11480O* EMLPA 473P 11490O* EMNSRD 481 11500O* EMNSRR 496 ÐÐ11510O* EMRFRQ 497 11520O* EMHIRD 503 11530O* EMASYR 505 11540O* EMASMO 507 11550O* EMASDY 509 11560O* EMDATT 515 11570O* EMTREA 517 11580O* EMREH 533 11590O EMVCC 534 11600O EMVEH 539P 11610O EMVHT 542P 11620O EMVLDP 548 11630O EMVSLD 554 11640O EMVALD 560 11650O EMVSRD 566 11660O EMVARD 572 11670O EMSLEH 577P 11680O EMSLHT 580P 11690O EMSLDP 586 11700O EMSLSL 592 11710O EMSLAL 598 11720O EMSLSR 604 11730O EMSLAR 610 11740O* EMFTMS 611 11750O* EMFTNE 613 ÐÐ11760O* EMFXEX 615 11770O* EMFTXC 616 11780O* EMFTXA 620 11790O* EMSS 634 11800O* EMCICA 635 11810O* EMFEIC 636 11820O* EMSTMS 637 11830O* EMSTNE 639 11840O* EMSXEX 641 11850O* EMSTXC 642 11860O* EMSTXA 646 11870O* EMSEIC 647 11880O* PTE 703P 11890O* PTF 727P 11900O* PTS 751P 11910O* PRT 791 11920O* PRB 911 11930O* PRS 1031 11940O* PRC 1051 11950O* PRA 1131P 11960O* PRY 1211P 11970O* PRN 1491 11980O EMLOAL 1497 11990O EMLOAR 1503 12000O EMLOAT 1505P ÐÐ12010O EMSTAT 1536 ** NUL ARRAY 012020 12030** A40 ARRAY 12040 12050** A39 ARRAY 12060 12070** NUM ARRAY 12080001 CLOCK 12090003 VAC-EARNED HRS 12100004 VAC-HRS TAKEN 12110005 VAC-LAST DATE PD 12120006 VAC-SCHED LV DATE 12130007 VAC-ACT LV DATE 12140008 VAC-SCHED RET DATE 12150009 VAC-ACT RET DATE 12160010 S/L-EARNED HRS 12170011 S/L-HRS TAKEN 12180012 S/L-LAST DATE PD 12190013 S/L-SCHED LV DATE 12200014 S/L-ACT LV DATE 12210015 S/L-SCHED RET DATE 12220016 S/L-ACT RET DATE 12230017 LOA-LEAVE DATE 12240018 LOA-RET DATE 12250ÐÐ019 LOA-DAYS TAKEN 12260** DUN ARRAY 12270 012280** MES ARRAY 012290---MESSAGE NOT ON FILE--- 012300** LNK ARRAY 012310 12320** DOTS ARRAY 12330 12340** MAN ARRAY 12350 12360** CAL ARRAY 1237031 1 1238028 2 1239031 3 1240030 4 1241031 5 1242030 6 1243031 7 1244031 8 1245030 9 1246031 10 1247030 11 1248031 12 12490** DASH 12500ÐÐ 12510/* 12520_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( : X013DP P120282120282(èÈÐ00010H Q013DP00020F* REMOVE SHUTDOWN FLAG FROM CRTFILE 00030FCRTFILE UP F 256 DISK 00040ICRTFILE CR 01 00050I 27 27 CRSHUT 00060OCRTFILE D 01 00070O 27 ' ' /* 000080_‚ _‚_‚ ÐÈ(:  X013GL P120282120282(èÈÐ00010H Q013GL00020F* ESTABLISH NUMBER OF SUB-ACCOUNTS FOR EACH GLMAST RECORD. (X013GL) 00030F* REVISED 7-27-81 5:00 PM. 00040FCAMAST IP AF 40 18AI 1 DISK 00050FGLMAST US AF 165 9AI 1 DISK 00060FPRINT O F 132 PRINTER 00070I******************************************************************** 00080ICAMAST CA 01 00090I 1 9 CAPAR L1M1 00100I 10 18 CASUB 00110I 40 40 CASTAT 00120I******************************************************************** 00130IGLMAST GL 02 00140I 1 9 GLACT L1M1 00150C******************************************************************** 00160C 01 CASTAT COMP 'D' 54 00170C 54 SETOF 01 00180C L1 Z-ADD0 COUNT 50 00190C 01 1 ADD COUNT COUNT 00200O******************************************************************** 00210OGLMAST D 02 00220O COUNT 159P 00230O******************************************************************** 00240OPRINT D 01NMR 00250O CAPAR 35 ÐÐ00260O CASUB 50 /* 000270_‚ _‚_‚0FPRINT O F 132 PRINTER 00070I******************************************************************** 00080ICAMAST CA 01 00090I 1 9 CAPAR L1M1 00100I 10 18 CASUB 00110I 40 40 CASTAT 00120I******************************************************************** 00130IGLMAST GL 02 00140I 1 9 GLACT L1M1 00150C******************************************************************** 00160C 01 CASTAT COMP 'D' 54 00170C 54 SETOF 01 00180C L1 Z-ADD0 COUNT 50 00190C 01 1 ADD COUNT COUNT 00200O******************************************************************** 00210OGLMAST D 02 00220O COUNT 159P 00230O******************************************************************** 00240OPRINT D 01NMR 00250O CAPAR 35 ÐÈ(2: 2X013PM P120282120282(èÈÐ00010H Q013PM00020F* INITIALIZE ON HAND BAL IN PART MASTER ***D A N G E R***** 00030FPMMST2 UP F 674 12AI 1 DISK 00040FTERM80 O F 80 5 00050IPMMST2 PM 01 00060I P 311 3140PMOHB 00070C 80 GOTO CONTU 00080C SETON 80 00090C EXCPT 00100C EXITFQPAUSE 00110C EXITFQPAUSE 00120C CONTU TAG 00130C Z-ADD0 PMOHB 00140OPMMST2 D 01 00150O PMOHB 314P 00160OTERM80 E 80 00170O 24 'D A N G E R ' 00180O 48 'THIS PROG ZEROS OUT THE ' 00190O 72 'ON HAND BALANCE ********' 00200O E 80 00210O 24 'CANCEL WITH CONTROL-A ' 00220O 48 'IF YOU DO NOT KNOW WHAT' 00230O 72 'YOU ARE DOING *********' /* 000240_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(w:+ wX013QM P120282120282(èÈÐ00010H Q013QM00020F* PRINT (DIABLO) PENDING QUOTES BY PRODUCT. (X013QM) 00030F* REVISED 7/16/81 2:15 PM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FQMMAST IS F 160R I DISK 00060FQMADRT IR F 300 3 3IT EDISK 00070FSLMNAME IT F 80 EDISK 00080FCRTFILE UC F 256R DISK 00090E******************************************************************** 00100E QMADRT QMMAST 00110E SLMNAME TABSLS 1 15 3 TABNAM 20 SALESMEN 00120E TABSTC 1 6 1 TABSTN 10 STATUS NAME 00130E TABPRD 1 18 2 TABPRN 20 PRODUCT CODES 00140E L2T 1 1 25 00150E LRT 1 1 25 00160E HED 1 8 66 00170E REC 132 1 00180E BIT 256 1 SCREEN CONTR. CHAR 00190E QMD 6 7 0 CALL STACK 00200I******************************************************************* 00210IBITHEX BT 01 00220I 1 256 BIT 00230I******************************************************************** 00240ICRTFILE CR 00250I 125 256 REC ÐÐ00260I******************************************************************** 00270IQMMAST QM 02 160NCD 110NCL 110NCW 00280I AND 110NCC 00290I* QUOTE MASTER. 00300I* QUOTE # 5A 00310I 1 5 QMQOTEL1 00320I* ITEM # 3N 00330I 6 80QMITEM 00340I* CUSTOMER NAME 20A 00350I 9 28 QMNAME 00360I* CUSTOMER RFQ # 20A 00370I 29 48 QMRFQ 00380I* RFQ ITEM # 4A 00390I 49 52 QMRFQI 00400I* CONTACT 20A 00410I 53 72 QMCONT 00420I* ASSIGNED TO (SALESMAN) 3A 00430I 73 75 QMSLSM 00440I* DATE ARRAY 7P X 6 00450I* 1 = RECEIVED 00460I* 2 = DUE 00470I* 3 = SENT 00480I* 4 = EXPECTED AWARD 00490I* 5 = FOLLOW-UP 00500I* 6 = NOT USED ÐÐ00510I P 76 99 QMD 00520I* PRODUCT CLASS 2A 00530I 100 101 QMPCLSL2 00540I* SYSTEM CODE 1A 00550I 102 102 QMSYST 00560I* FILLER 103 103 FFFFFF 00570I* QUOTE AMOUNT 7P ($) 00580I P 104 1070QMAMT 00590I* DELIVERY PROMISED (DAYS ARO) 3P 00600I P 108 1090QMDEL 00610I* STATUS 1A 00620I* E = ENTERED 00630I* N = NO BID 00640I* B = BID 00650I* P = PENDING 00660I* L = LOST 00670I* W = WON 00680I* C = CANCELLED 00690I 110 110 QMSCOD 00700I* PROBABILITY OF AWARD 3.2P 00710I P 111 1122QMPROB 00720I* WON/LOST REASON 1A 00730I 113 113 QMREAS 00740I* REMARKS 40A 00750I 114 153 QMREM ÐÐ00760I* RECORD STATUS 1A 00770I 160 160 QMSTAT 00780I GG 03 00790I* GARBAGE RECORD. 00800C******************************************************************** 00810C* INITIALIZE/TOP OF FORM. 00820C EXSR SR101 INIT. 00830C* BYPASS BITHEX FILE. 00840C N02 GOTO END 00850C* BYPASS QM DELETES, STATUS = NOT 'P'. 00860C QMSTAT COMP 'D' 55 00870C QMSCOD COMP 'P' 54 00880C 55 00890CORN54 SETOF 02 00900C N02 GOTO END 00910C* CUM $ TOTALS. 00920C QMAMT ADD QTOT QTOT 80 $ AMOUNT. 00930C QMAMT ADD GTOT GTOT 110 GRAND TOTAL. 00940C QMAMT ADD PTOT PTOT 90 PRODUCT TOTAL. 00950C* GET PRODUCT NAME. 00960C QMPCLS LOKUPTABPRD TABPRN 78 00970C* PRINT LINE. 00980C EXSR SR102 PUT LINE. 00990C*------------------------------------------------------------------- 01000C END TAG ÐÐ01010CL2 82 EXSR SR66 LF 01020CL2 82 SETON 70 01030CL2 82 EXSR SR69 PRINT 01040CLR EXSR SR66 LF 01050CLR SETON 74 01060CLR EXSR SR69 01070CLR EXSR SR67 01080C*------------------------------------------------------------------- 01090CLR ENDJOB TAG 01100C******************************************************************** 01110CSR SR66 BEGSR 01120CSR EXITFQCLF LF 01130CSR 1 ADD COUNT COUNT 30 01140CSR ENDSR 01150C******************************************************************** 01160CSR SR67 BEGSR 01170CSR EXITFZTFORM TOP FORM 01180CSR 1 ADD EGAP EGAP 40 01190CSR Z-ADD0 COUNT 01200CSR ENDSR 01210C******************************************************************** 01220CSR SR69 BEGSR 01230C* PRINT. 01240CSR EXSR SR66 LF 01250CSR PORT CHAINCRTFILE H9 ÐÐ01260CSR H9 GOTO ENDJOB 01270CSR MOVE ' ' REC 01280CSR EXCPT 01290CSR SETOF 74 01300CSR SETOF 407270 01310CSR PORT CHAINCRTFILE 54 01320CSR MOVEAREC W148A 148 01330CSR EXITFZD148 PRINT 01340CSR RLABL W148A 01350CSR ENDSR 01360C******************************************************************** 01370CSR SR101 BEGSR 01380C* INITIALIZE. 01390CSR SETOF 80 ACTIVE ITEM FLAG. 01400CSR L1 SETOF 81 ACTIVE QUOTE FLAG. 01410CSR L2 SETOF 82 ACTIVE PROD FLAG. 01420CSR L2 Z-ADD0 PTOT 01430CSR 79 GOTO END101 01440CSR SETON 79 01450CSR Z-ADD0 ZERO5 50 01460CSR MOVE ' ' BLK15 15 01470CSR MOVE ' ' BLK8 8 01480CSR MOVE ' ' BLK20 20 01490CSR MOVE ' ' BLK148148 01500C* GET CRTFILE. ÐÐ01510CSR MOVE BLK8 W8A 8 01520CSR Z-ADD0 W1N 10 01530CSR Z-ADD0 W2N 20 01540CSR MOVE ' ' W2A 2 01550CSR EXITFPGMINX GET PORT #. 01560CSR RLABL W8A 01570CSR RLABL W2N 01580CSR RLABL W1N 01590CSR RLABL W2A 01600CSR MOVE W2A PORT 20 01610CSR PORT COMP 0 54 01620CSRN54 Z-ADD25 PORT 01630CSR Z-ADD65 COUNT 01640CSR MOVELBIT,99 LASTPC 01650CSR END101 ENDSR 01660C******************************************************************** 01670CSR SR102 BEGSR 01680C* BUILD QUOTE ITEM PRINT LINE. 01690CSR COUNT COMP 60 54 54 01700CSR QMPCLS COMP LASTPC 55 01710CSRN55 01720COR 54 EXSR SR103 01730CSR QMPROB COMP 0 56 01740CSR QMSCOD LOKUPTABSTC TABSTN 57 01750CSR QMSLSM LOKUPTABSLS TABNAM 58 ÐÐ01760CSR SETON 72 01770CSR EXSR SR69 PRINT 01780CSR MOVE QMPCLS LASTPC 2 01790CSR SETON 82 01800CSR END102 ENDSR 01810C******************************************************************** 01820CSR SR103 BEGSR 01830C* PUT HEADINGS. 01840CSR EXSR SR67 TOP FORM 01850CSR Z-ADD0 X 30 01860C*------------------------------------------------------------------- 01870CSR T103A TAG 01880CSR 1 ADD X X 01890CSR X COMP 4 54 01900CSR 54 GOTO END103 01910CSR 2 MULT X H2 30 01920CSR H2 SUB 1 H1 30 01930CSR X COMP 1 41 01940CSR X COMP 2 42 01950CSR X COMP 3 43 01960CSR X COMP 4 44 01970CSR SETON 40 01980CSR EXSR SR69 PRINT. 01990CSR 41 02000COR 42 ÐÐ02010COR 44 EXSR SR66 LF 02020CSR SETOF 414243 02030CSR SETOF 44 02040CSR GOTO T103A 02050CSR END103 ENDSR 02060O******************************************************************** 02070OCRTFILE E 72 02080O REC 256 02090O QMNAME 144 02100O QMQOTE 151 02110O QMITEM 155 02120O 152 '-' 02130O QMAMT 2 166 02140O QMPROBZ 170 02150O 56 171 '%' 02160O N56 171 ' ' 02170O QMD,4 195 ' - - ' 02180O QMDEL Z 182 02190O QMD,3 205 ' - - ' 02200O QMSCOD 209 02210O 57 TABSTN 223 02220O 58 TABNAM 256 02230O*------------------------------------------------------------------- 02240O E 40 02250O REC 256 ÐÐ02260O HED,H1 190 02270O HED,H2 256 02280O 41 UDATE 132 ' - - ' 02290O 41 EGAP Z 255 02300O 42 QMPCLS 135 02310O 42 78 TABPRN 157 02320O*------------------------------------------------------------------- 02330O E 70 02340O REC 256 02350O L2T,1 149 02360O PTOT 2B 167 02370O*------------------------------------------------------------------- 02380O E 74 02390O REC 256 02400O LRT,1 149 02410O GTOT 2B 167 02420O*------------------------------------------------------------------- ** TABSTC/TABSTN - STATUS NAMES 002430EENTERED 002440NNO BID 002450PPENDING 002460LLOST 002470WWON 002480CCANCELLED 002490** TABPRD/TABPRN - PRODUCT CODE NAMES 002500ÐÐ11MINI SERIES 00251012SERIES 1500 00252021SERIES 1000 00253022SERIES 3000 00254023SERIES 5900 00255024SERIES 5300 00256041SERIES X 00257042SERIES 10 00258051SERIES 5100 00259052SERIES 1400 00260053SERIES 8100 002610541400/8100 CONTROLS 00262055SYSTEM 21 00263059OTHER SYSTEMS 00264060RF EQUIPMENT 00265070EQUA-DYNE EQUIPMENT 00266090MISC. EQUIPMENT 00267099SKY 515 002680** L2T ARRAY 002690TOTAL AMOUNT. . . . . . . 002700** LRT ARRAY 002710GRAND TOTAL . . . . . . . 002720** HED ARRAY 002730 PENDING QUOTES BY PRODUCT 002740 PAGE 002750ÐÐPRODUCT : 002760 002770CUSTOMER DYNAIR QUOTE PROB OF PROMISED EX 002780PECTED DATE STATUS 002790 NAME QUOTE AMOUNT AWARD DAYS-ARO 002800DATE SENT CODE PREP BY: 002810/* 002820_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(^:É ^’X013RM P š120282120282(èÈÐ00010H Q013RM00020F* LIST ROUTING OPERATION CODE FILE. (X013RM) 00030F* REVISED 4-26-80 2:45 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FOPDESCR ID F 47L 5AI 1 DISK 00070FTERM132 O F 132 5 00080F**************************************************************** 00090E NUL 1 132 1 NULL CHAR 00100E A6 6 6 1 A INPUT DATA ARRAY 00110E DUN 1 3 1 A EDIT CMPLT FLAG 00120E MES 1 1 30 00130E BIT 33 1 SCREEN CONTR. CHAR 00140E CALL 5 6 CALL STACK 00150E* 00160E* 00170I******************************************************************* 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************* 00210IMGFILE MG 00220I* MESSAGE FILE. 00230I 1 35 MGTEXT 00240I******************************************************************** 00250IOPDESCR OP ÐÐ00260I* OPER CODE 5A 00270I 1 5 OPCODE 00280I* OPER DESCR 40A 00290I 7 46 OPDESC 00300I* RECORD STATUS 1A 00310I 47 47 OPSTAT 00320C******************************************************************** 00330C* INITIALIZE 00340C EXSR SR101 1-TIME INIT 00350C*------------------------------------------------------------------ 00360C START TAG 00370C* SET-UP 1ST FIELD NO. 00380C MOVE ' ' DUN INIT EDIT ARRAY 00390C MOVE BLK5 CRCODE 5 00400C EXSR SR71 PUT HEADING 00410C Z-ADD1 F 30 FIELD # 00420C*----------------------------------------------------------------- 00430C READ TAG 00440C* READ DATA FROM TERMINAL. 00450C SETOF 9096 00460C EXSR SR102 VALIDATE FIELD # 00470C 55 GOTO UPDATE DONE 00480C EXSR SR201 IDENTIFY-F 00490C Z-ADD340 M 50 MSG #. 00500C EXSR SR89 GET MSG. ÐÐ00510C EXSR SR73 PROMPT 00520C EXSR SR75 READ TERMINAL 00530C*------------------------------------------------------------------- 00540C ESCAPE TAG 00550C 98 GOTO GOODBY GOODBY 00560C 94 GOTO MENU MENU REQUEST 00570C 96 ERROR 00580CORN77N88 EXSR SR72 REWRITE INPUT DATA 00590C 93 GOTO NEWITM NEW ITEM 00600C 87 GOTO START 00610C 86 GOTO UPDATE UPDATE 00620C 85 GOTO READ REPEAT 00630C 90 Z-ADD318 M 96 FLAG ERROR. 00640C 96 GOTO ERROR ERROR 00650C N77 GOTO UPDATE NO DATA INPUT 00660C*------------------------------------------------------------------ 00670C PROCES TAG 00680C* PROCESS INPUT DATA 00690C EXSR SR103 MOVE DATA 00700C*------------------------------------------------------------------ 00710C UPDATE TAG 00720C* DISPLAY DATA BASE. 00730C EXSR SR106 UPDATE 00740C 90 GOTO ESCAPE 00750C GOTO START ÐÐ00760C*-------------------------------------------------------------------- 00770C ERROR TAG 00780C EXSR SR102 VALIDATE FIELD # 00790C EXSR SR89 GET MSG 00800C EXSR SR73 PUT MSG 00810C GOTO READ 00820C*------------------------------------------------------------------ 00830C NEWITM TAG 00840C* SET-UP LINK FOR NEW ITEM 00850C MOVEL'Q013RM' PROG 8 00860C GOTO END 00870C*------------------------------------------------------------------- 00880C MENU TAG 00890C* SET-UP LINK TO MENU 00900C MOVEL'QQRM02' PROG 00910C GOTO END 00920C*-------------------------------------------------------------------- 00930C GOODBY TAG 00940C* LINK TO SIGN-OFF 00950C MOVEL'GOODBY' PROG 00960C GOTO END 00970C*------------------------------------------------------------------- 00980C END TAG 00990C PROG COMP BLK8 54 01000C N54 MOVEL'Q013RM' PROG ÐÐ01010C EXITFCHAIN LINK TO NEXT PROG 01020C RLABL PROG 01030C********************************************************************** 01040CSR SR71 BEGSR 01050C* PUT HEADINGS TO TERMINAL 01060CSR Z-ADD6 LINENO 01070CSR SETON 71 01080CSR EXCPT PUT HEADINGS 01090CSR SETOF 71 01100CSR ENDSR 01110C********************************************************************* 01120CSR SR72 BEGSR 01130C* PUT DATA TO TERMINAL 01140CSR 1 ADD LINENO LINENO 30 01150CSR SETON 72 01160CSR EXCPT PUT DATA 01170CSR SETOF 72 01180CSR END72 ENDSR 01190C*********************************************************************** 01200CSR SR73 BEGSR 01210C* PUT ERROR MESSAGE TO TERMINAL 01220CSR SETON 73 01230CSR EXCPT PUT MSG 01240CSR SETOF 73 01250CSR 1 ADD LINENO LINENO ÐÐ01260CSR Z-ADDM LSTERR 50 01270CSR ENDSR 01280C******************************************************************* 01290CSR SR75 BEGSR 01300C* READ FROM TERMINAL 01310CSR SETOF 779096 01320CSR SETOF 939291 01330CSR SETOF 898887 01340CSR SETOF 8685 01350CSR MOVE BIT,4 BUFLGT 2 READ BUFFER LGTH 01360CSR MOVE BLK6 W6A 6 BUFFER 01370CSR EXITFQWREED READ FROM TERMINAL 01380CSR RLABL W6A READ BUFFER 01390CSR RLABL BUFLGT READ BUFFER LGTH 01400CSR MOVEAW6A A6 INPUT DATA ARRAY 01410CSR MOVE BLK6 W6A INIT INPUT ARRAY 01420CSR Z-ADD1 W 30 01430CSR '\' LOKUPA6,W 90 FLAG ESC 01440CSRN90 GOTO T75B NOT ESC 01450CSR 1 ADD W W 01460CSR W COMP 40 54 01470CSR 54 GOTO T75A BAD ESC 01480CSR A6,W COMP 'G' 98 GOODBY 01490CSR A6,W COMP 'E' 94 MENU 01500CSR A6,W COMP 'N' 93 NEW ITEM ÐÐ01510CSR A6,W COMP 'J' 92 JUMP 01520CSR A6,W COMP 'F' 91 SKIP FRWRD 01530CSR A6,W COMP 'B' 89 SKIP BKWRD 01540CSR A6,W COMP 'S' 88 SPACE FILL 01550CSR A6,W COMP 'H' 87 HOME 01560CSR A6,W COMP 'U' 86 UPDATE 01570CSR A6,W COMP 'R' 85 REPEAT 01580CSR 98 01590COR 94 01600COR 93 01610COR 92 01620COR 91 01630COR 89 01640COR 88 01650COR 87 01660COR 86 01670COR 85 GOTO END75 GOOD ESC 01680C*------------------------------------------------------------------ 01690CSR T75A TAG 01700C* FLAG BAD ESC INPUT 01710CSR Z-ADD318 M 96 FLAG ERROR 01720CSR GOTO END75 01730C*-------------------------------------------------------------------- 01740CSR T75B TAG 01750C* MOVE DATA ÐÐ01760CSR Z-ADD1 W 01770CSR ' ' LOKUPA6,W 77 01780CSR 77 MOVEAA6,W W6A INPUT DATA 01790C*-------------------------------------------------------------------- 01800CSR END75 TAG 01810C* INIT PREV ERROR MSG. 01820CSR LSTERR COMP 0 54 01830CSR 54 MOVE BLK35 MGTEXT 01840CSR 54 EXSR SR73 BLANK MESSAGE 01850CSR Z-ADD0 LSTERR 50 01860CSR ENDSR 01870C******************************************************************** 01880CSR SR76 BEGSR 01890C* PUT BLANK LINE. 01900CSR SETON 76 01910CSR EXCPT 01920CSR SETOF 76 01930CSR ENDSR 01940C********************************************************************** 01950CSR SR89 BEGSR 01960C* GET MESSAGE MASTER 01970CSR M CHAINMGFILE 54 01980CSR 54 MOVE BLK35 MGTEXT 01990CSR 54 MOVELM MGTEXT 02000CSR 54 MOVE MES,1 MGTEXT ÐÐ02010CSR ENDSR 02020C*********************************************************************** 02030CSR SR101 BEGSR 02040C* 1-TIME INITIALIZE 02050CSR SETON 70 CLEAR SCREEN. 02060CSR MOVE BIT,1 NUL 02070CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 02080CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02090CSR MOVE ' ' BLK40 40 02100C* DEFINE WORK FIELDS,ETC. 02110CSR MOVE ' ' BLK35 35 02120CSR MOVE ' ' BLK8 8 02130CSR MOVE ' ' BLK5 5 02140CSR MOVE ' ' BLK6 6 02150C* 02160C* 02170CSR ENDSR 02180C********************************************************************** 02190CSR SR102 BEGSR 02200C* VALIDATE FIELD NO. 02210CSR F COMP 0 54 02220CSRN54 Z-ADD1 F 02230CSR F COMP FLIMIT 55 02240CSR 55 Z-ADD1 F 02250CSR ENDSR ÐÐ02260C******************************************************************** 02270CSR SR103 BEGSR 02280C* MOVE INPUT DATA 02290CSR EXSR SR201 IDENTIFY-F 02300CSR 01 MOVELW6A CRCODE 5 OPER CODE. 02310CSR MOVE ' ' DUN,F EDIT FLAG 02320CSR ENDSR 02330C******************************************************************** 02340CSR SR106 BEGSR 02350C* DISPLAY DATA 02360CSR CRCODE SETLLOPDESCR 02370C*------------------------------------------------------------------- 02380CSR T106A TAG 02390CSR SETOF 54 02400CSR READ OPDESCR 54 02410CSR 54 GOTO T106C END OF FILE. 02420CSR CRCODE COMP OPCODE 54 02430CSR 54 GOTO T106C 02440CSR OPSTAT COMP 'D' 54 02450CSR 54 GOTO T106A DELETED. 02460CSR 1 ADD LINENO LINENO 02470CSR LINENO COMP 31 54 02480CSR 54 GOTO T106B END OF PAGE. 02490CSR SETON 72 02500CSR EXCPT PUT DATA. ÐÐ02510CSR SETOF 72 02520CSR GOTO T106A 02530C*------------------------------------------------------------------- 02540CSR T106B TAG 02550CSR EXITFQEPAGE END PAGE MSG. 02560CSR EXSR SR75 READ. 02570CSR 90 GOTO END106 02580CSR EXSR SR71 HEADINGS. 02590CSR GOTO T106A 02600C*------------------------------------------------------------------- 02610CSR T106C TAG 02620CSR EXITFQEFILE END FILE MSG. 02630CSR EXSR SR76 02640CSR END106 ENDSR 02650C************************************************************************ 02660CSR SR201 BEGSR 02670C* IDENTIFY FIELD NO. 02680CSR F COMP 1 01 02690CSR ENDSR 02700O******************************************************************** 02710OTERM132 E 71 02720O* PUT HEADING. 02730O 75 'OPERATION CODE DISPLAY' 02740O*------------------------------------------------------------------- 02750O E 71 ÐÐ02760O 15 'OPERATION' 02770O*------------------------------------------------------------------- 02780O E 71 02790O 12 'CODE' 02800O 28 'DESCRIPTION' 02810O*------------------------------------------------------------------- 02820O E 71 02830O*------------------------------------------------------------------- 02840O E 72 02850O OPCODE 12 02860O OPDESC 57 02870O*------------------------------------------------------------------- 02880O E 73 02890O NUL 132 02900O 96 5 '*****' 02910O N96 5 ' ' 02920O MGTEXT 41 02930O 96 53 'E R R O R' 02940O N96 53 ' ' 02950O*------------------------------------------------------------------- 02960O E 76 ** NUL ARRAY 002970 002980** A40 ARRAY 002990 003000ÐÐ** DUN ARRAY 003010 003020** MES ARRAY 003030---MESSAGE NOT ON FILE--- 003040/* 003050_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(x;\ xHX029WO P999999120282(èÈÐ00010H Q029WO00020F* DISPLAY INVENTORY STATUS BY PART #/MODEL #. (X029WO) 00030F* REVISED 11-04-82 3:45 PM. 00040F* NOTE: MOST CHGS TO THIS PRG SHOULD ALSO BE MADE TO DIABLO VERSION. 00050FBITPAR IP F 90 DISK 00060FALTPN ID F 32L29AI 1 DISK 00070FREMARKS ID F 90L29AI 1 DISK 00080FPMMODEL2ID F 23L22AI 1 DISK 00090FBOMAST IC F 80R19AI 1 DISK 00100FPPITEM IC F 400R 9AI 1 DISK 00110FWOMAST IC F 228R 9AI 1 DISK 00120FWOPULL IC F 64R19AI 1 DISK 00130FSOMAST IC F 128R11AI 1 DISK 00140FPMMST2 IC F 674R12AI 1 DISK 00150FCRTFILE UC F 256R DISK 00160FMGFILE IC F 80R DISK 00170FCALENDARIC F 22R 7AI 1 DISK 00180FTERM132 O F 132 5 00190E******************************************************************** 00200E A12 12 12 1 A 00210E NUL 1 66 2 00220E ERR 1 10 5 0A 00230E LNK 1 7 6 A 00240E SWO 1 30 11 A 00250E CALL 7 6 ÐÐ00260E BIT 33 1 00270E PAR 25 1 00280E TST 25 1 00290E PID 26 6 0 00300E PIQ 26 7 0A 00310I******************************************************************** 00320IBITPAR BP 00330I 1 33 BIT 00340I 34 58 PAR 00350I 59 83 TST 00360I********************************************************************** 00370ICRTFILE CR 00380I 28 330CRTIME 00390I 34 370CRDATE 00400I 38 79 CALL 00410I******************************************************************** 00420IPMMODEL2PD 00430I 1 22 PDKEY 00440I* 1 12 PDMODL 00450I 13 220PDPN 00460I 23 23 PDSTAT 00470I******************************************************************** 00480IALTPN AP 00490I 1 29 APKEY 00500I 1 100APPN ÐÐ00510I 11 160APDUE 00520I 17 180APREC 00530I 19 29 AP11 00540I* 19 19 AP1 00550I* 19 24 AP6 00560I* 25 270AP3 00570I* 28 290AP2 00580I 19 27 AP9 00590I*................................................................ 00600I* FORECAST ONLY 00610I* QTY REQD 7N 00620I 19 250APQTY 00630I*.................................................................. 00640I 32 32 APSTAT 00650I******************************************************************** 00660IBOMAST BO 00670I* BACKORDER MASTER. 00680I* ORDER NO. 9A 00690I 1 6 ORDP 00700I 7 90ORDD 00710I* 1 9 ORD 00720I* PART NO. 10N 00730I* 10 190BOPN 00740I* FILLER 2A 20 21 FFFFFF 00750I* QTY REQD 7P ÐÐ00760I P 22 250BOQTYR 00770I* QTY ISSUED 7P 00780I P 26 290BOQTYC 00790I* DATE REQD 6N (YMD) 00800I* 30 350BODUE 00810I* DATE LAST ISSUE 6N (YMD) 00820I 36 410BODLT 00830I* DELIVER TO 15A 00840I* 42 56 BODEL 00850I* ASSY PART NO. 10N 00860I* 57 660NAPN 00870I* QTY PER ASSY 7P 00880I* P 67 700QPA 00890I* RECORD STATUS 1A 00900I 80 80 BOSTAT 00910I******************************************************************** 00920IPPITEM PI 00930I* PURCHASE ORDER ITEM RECORD. 00940I* KEY AREA. 00950I* PO # 6N 00960I 1 6 ORDP 00970I* PO ITEM 3N 00980I 7 90ORDD 00990I* DYNAIR PART # 10N 01000I* 10 190PIPN ÐÐ01010I* VENDOR PART # 15A 01020I* 20 34 PIVPN 01030I* DESCRIPTION 29A 01040I* 35 63 PIDESC 01050I* NON-INVENTORY DESCRIPTION 70A 01060I* 10 79 PINDES 01070I* DATE LAST RECEIPT 6N 01080I 80 850PIDLR 01090I* QTY RECEIVED 7P 01100I P 86 890PIQRCD 01110I* QTY TO STK,SCRAP,RTV 7P 01120I P 90 930PIQSTK 01130I* PRICE CODE 1A 01140I* L = LOT 01150I* N = NO CHARGE 01160I* 94 94 PILOT 01170I* PRICE 9.3P 01180I P 95 993PIPRIC 01190I* WORK ORDER # 9A 01200I* 100 108 PIWO 01210I* 100 105 PIWOP 01220I* 106 1080PIWOD 01230I* VENDOR # 5P (FROM PPMAST) 01240I P 109 1110VENDOR 01250I* LAST RCVG LOG # USED 2N ÐÐ01260I* 112 1130PILLOG 01270I* SCHEDULE DATES 6N X 26 (Y,M,D) 01280I 114 269 PID 01290I* SCHED QTYS 7P X 26 01300I P 270 373 PIQ 01310I 374 393 NAME 01320I* RECORD STATUS 1A 01330I 400 400 PISTAT 01340I******************************************************************** 01350IWOMAST WO 01360I* WORK ORDER MASTER. 01370I* WORK ORDER NO. 01380I* 1 9 ORD 01390I* PRIME 6A 01400I* 1 1 PREFIX 01410I 1 6 ORDP 01420I* DASH 3N 01430I 7 90ORDD 01440I* PART NO. 10N 01450I* 10 190WOPN 01460I* TOP ASSY PN 10N 01470I* 20 290WOTAPN 01480I* RUN NO. 3N 01490I* 30 320WORUN 01500I* PROD LINE 4N ÐÐ01510I* 33 360WOPL 01520I* SCHED QTY 7P 01530I P 37 400WOQTYS 01540I* COMPLETED QTY 7P 01550I P 45 480WOQTYC 01560I* START DATE 6N (YMD) 01570I 49 540WOSTRT 01580I* DUE DATE 6N (YMD) 01590I* 55 600WODUE 01600I* DATE ENTERED 6N (YMD) 01610I 61 660WODATE 01620I* DATE RELEASED 6N (YMD) 01630I 67 720WODLTR 01640I* DATE LAST COMPLETION 6N (YMD) 01650I 73 780WODLTC 01660I* DATE LAST LABOR 6N (YMD) 01670I 79 840WODLTL 01680I* DATE LAST MATL CHARGE 6N (YMD) 01690I 85 900WODLTM 01700I* LABOR HRS CHARGED 7.1P 01710I* P 91 941WOLABH 01720I* LABOR $ CHARGED 9.3P 01730I* P 95 993WOLAB$ 01740I* MATL $ CHARGED 9.3P 01750I* P 100 1043WOMAT$ ÐÐ01760I* QTY TRSF 7P 01770I* P 105 1080WOQTYT 01780I* AMOUNT TRANSFERRED 9.3P 01790I* P 109 1133WO$T 01800I* REMARKS 35A 01810I* 114 148 WODESC 01820I* MODEL 12A 01830I* 149 160 WOMODL 01840I* FAB CODE 2A 01850I* 161 162 WOFAB 01860I* ALTERNATE BILL OF MATERIAL PART NO. 10N 01870I* 163 1720WOABM 01880I* ALTERNATE ROUTING PART NO. 10N 01890I* 173 1820WOARPN 01900I* DATE CLOSED 6N (YMD) 01910I* 183 1880WOCLOS 01920I* RECORD STATUS 1A 01930I 228 228 WOSTAT 01940I******************************************************************** 01950IWOPULL WP 01960I* WORK ORDER PULL FILE. 01970I* KEY AREA. 01980I* WORK ORDER 9A 01990I* 1 9 ORD 02000I 1 6 ORDP ÐÐ02010I 7 90ORDD 02020I* COMPONENT PART # 10N 02030I* 10 190WPCPN 02040I* WORK ORDER PART # 02050I* 20 290NAPN 02060I* QTY REQD 7P 02070I P 30 330WPQTYR 02080I* STOCK LOCATION 6A 02090I* 34 39 WPSLOC 02100I* QTY ISSUED 7P 02110I P 40 430WPQTYC 02120I* QTY B/O 7P 02130I* P 44 470WPQTYB 02140I* QTY PER ASSY 7P 02150I* P 48 510QPA 02160I* DATE LAST TRAN 6N 02170I 52 570WPDLT 02180I* RECORD STATUS 1A 02190I 64 64 WPSTAT 02200I******************************************************************** 02210ISOMAST SO 02220I* SALES ORDER MASTER 02230I* SALES ORDER (KEY) 11A 02240I* PRIME 6A (1A+5N) 02250I 1 6 ORDP ÐÐ02260I* ITEM 3N 02270I 7 90ORDD 02280I* INCLUDES DASH # 2N 02290I 10 110ORDDD 02300I* CUSTOMER NO. 5P 02310I P 12 140VENDOR 02320I* CUSTOMER NAME (SORT CODE) 20A 02330I 15 34 NAME 02340I* MODEL NO. 12A (IF STD PROD) 02350I* 35 46 SOMODL 02360I* PART NO. 10N (IF STD PROD) 02370I* 47 560SOPN 02380I* DESCRIPTION (NON-STD PROD)29A 02390I* 35 63 SODESC 02400I* QUANTITY REQUIRED 7P (BEFORE SHPMTS) 02410I P 64 670SOQTYR 02420I* QTY SHIPPED 7P 02430I P 68 710SOQTYS 02440I* FORECAST UPDATE QTY 7P 02450I* P 72 750SOQTYF 02460I* DATE BOOKED 6N (Y,M,D) 02470I 76 810SOBOOK 02480I* DUE DATE 6N (Y,M,D) 02490I* 82 870SODUE 02500I* ORIGIN CODE 3A ÐÐ02510I* 88 90 SOORGN 02520I* PROD CLASS 4N 02530I* 91 940SOPC 02540I* CUSTOMER CLASS 2A 02550I* 95 96 SOCC 02560I* TERMS 1A 02570I* 97 97 SOTERM 02580I* UNIT PRICE 9.2P 02590I P 98 1022SOPRIC 02600I* DISCOUNT PERCENT .2N 02610I* 103 1042SODISC 02620I* DATE LAST SHIPMENT 6N (YMD) 02630I 105 1100SODLS 02640I* DATE LAST STOCK ISSUE 6N (YMD) 02650I 111 1160SODLK 02660I* QTY ISSUED FROM STOCK 7P 02670I* P 117 1200SOQTYK 02680I* PRODUCT CODE 1A 02690I* Y = STD PRODUCT 02700I* 121 121 SOPCOD 02710I* PRICE CODE 1A 02720I* N = NO CHARGE 02730I* L = LOT CHARGE 02740I* G = GSA 02750I* DEFAULT = UNIT COST ÐÐ02760I* 122 122 SOPRCD 02770I* BACKORDER FLAG 1A (B) 02780I* 123 123 SOBOF 02790I* RECORD STATUS 1A 02800I 128 128 SOSTAT 02810I******************************************************************** 02820IPMMST2 PM 02830I 1 100PMPN 02840I* 15 180PMPL 02850I 19 30 PMMODL 02860I 31 59 PMDESC 02870I* 70 71 PMECHG 02880I* 94 95 PMSC 02890I 94 94 PMSC1 02900I P 163 1660PMSSTK 02910I P 311 3140PMOHB 02920I P 489 4933PMOSUC 02930I 674 674 PMSTAT 02940I******************************************************************** 02950IMGFILE MG 02960I 1 60 MGTEXT 02970I******************************************************************** 02980ICALENDARCA 02990I* CALENDAR DATE RECORD. 03000I* 2 30CCYR ÐÐ03010I* 4 50CCMO 03020I* 6 70CCDAY 03030I 14 170CCMDAY 03040I* 18 200CCWK 03050I* 21 220CCDOW 03060I*---------------------------------------------------------------- 03070I* MFG DATE RECORD. 03080I* 4 70CAMDAY 03090I* 8 90CAYR 03100I* 10 110CAMO 03110I* 12 130CADAY 03120I* 18 200CAWK 03130I* 21 220CADOW 03140I******************************************************************** 03150IREMARKS RK 03160I 1 29 RKKEY 03170I 1 100RKPN 03180I* 11 160RKDUE 03190I 17 180RKREC 03200I 19 27 RKWO 03210I* 28 290RKLINE 03220I 30 89 RKTEXT 03230I 90 90 RKSTAT 03240C******************************************************************** 03250C* INITIALIZE. ÐÐ03260C* 03270C EXSR SR101 INIT 03280C MOVE ' ' BLK6 6 03290C*------------------------------------------------------------------- 03300C START TAG 03310C* REQUEST SELECTION 03320C MOVE BLK11 SWO 03330C EXSR SR71 PUT HEADING 03340C EXSR SR102 REQUEST SELECTION 03350C 90 GOTO START SKIP BACK 03360C*----------------------------------------------------------------- 03370C TAG10 TAG 03380C* REQUEST MODEL/PART NO. 03390C EXSR SR103 REQUEST MODEL/PN 03400C 90 GOTO START SKIP BACK 03410C SETOF 77 03420C*------------------------------------------------------------------- 03430C TAG20 TAG 03440C* SET ALT KEY LOW LIMIT 03450C EXSR SR205 SETUP INPUT FIELDS 03460C EXSR SR104 SETLL 03470C Z-ADD0 LASTPN 03480C Z-ADD0 PMPN 03490C SETOF 44 03500C N77 EXSR SR71 PUT HEADINGS ÐÐ03510C*------------------------------------------------------------- 03520C TAG25 TAG 03530C 22 EXSR SR112 READ PMMODEL2 03540C 22 44 EXSR SR107 DISPLAY TOTALS 03550C 22 44 GOTO TAG10 END PMMODEL2 FILE 03560C SETOF 424344 03570C*------------------------------------------------------------------- 03580C TAG30 TAG 03590C* READ NEXT RECORD 03600C SETOF 40 03610C Z-ADD0 ERR 03620C EXSR SR105 READ 03630C 90 GOTO TAG10 SKIP BACK 03640C 77 GOTO TAG20 NEW INPUT 03650C N40 22 GOTO TAG25 READ NEXT PMMODEL2 03660C N40 EXSR SR107 DISPLAY TOTALS 03670C N40 GOTO TAG10 GET NEXT PN INPUT 03680C*------------------------------------------------------------------ 03690C TAG40 TAG 03700C* CHECK FOR NEW PART NO. 03710C EXSR SR106 NEW PART NO.??? 03720C 55 GOTO TAG50 NOT NEW 03730C EXSR SR107 DISPLAY TOTALS 03740C 90 GOTO TAG10 SKIP BACK 03750C 77 GOTO TAG20 NEW INPUT ÐÐ03760C EXSR SR108 DISPLAY PART MAST. 03770C 60 GOTO TAG30 NO PART MASTER 03780C 90 GOTO TAG10 SKIP BACK 03790C 77 GOTO TAG20 NEW INPUT 03800C*------------------------------------------------------------------ 03810C TAG50 TAG 03820C* DISPLAY RECORD 03830C EXSR SR109 DISPLAY DATA 03840C 90 GOTO TAG10 03850C 77 GOTO TAG20 03860C EXSR SR113 DISPLAY EXCEPTIONS 03870C 90 GOTO TAG10 SKIP BACK 03880C 77 GOTO TAG20 NEW INPUT 03890C*----------------------------------------------------------------- 03900C TAG60 TAG 03910C* CHECK END OF PAGE 03920C EXSR SR111 CHECK END PAGE 03930C 90 GOTO TAG10 SKIP BACK 03940C 77 GOTO TAG20 NEW INPUT 03950C GOTO TAG30 DO NEXT READ 03960C*----------------------------------------------------------------- 03970C NEWITM TAG 03980C GOTO START 03990C*----------------------------------------------------------------- 04000C MENU TAG ÐÐ04010C EXSR SR96 GET CRTFILE 04020C Z-ADD1 W 04030C BLK6 LOKUPLNK,W 54 04040C 54 MOVELLNK,W PROG 8 04050C 54 MOVE BLK6 LNK,W 04060C N54 MOVEL'CONTU' PROG 04070C EXSR SR97 UPDATE CRTFILE 04080C EXSR SR98 >>>>>>>>>>>>>>>>> 04090C*--------------------------------------------------------------------- 04100C GOODBY TAG 04110C MOVEL'GOODBY' PROG 04120C GOTO END 04130C*------------------------------------------------------------------ 04140C END TAG 04150C EXSR SR96 GET CRTFILE 04160C EXSR SR97 REWRITE CRTFILE 04170C EXSR SR98 >>>>>>>>>>>>>>>>> 04180C*------------------------------------------------------------------- 04190C ENDJOB TAG 04200C MOVE 'ENDJOB 'PROG 04210C EXSR SR98 >>>>>>>>>>>>>>>>> 04220C* 04230C****************************************************************** 04240CSR SR2 BEGSR 04250C* GET WORK ORDER MASTER ÐÐ04260CSR AP9 CHAINWOMAST 54 04270CSRN54 WOSTAT COMP 'D' 54 04280CSR 54 GOTO END2 04290CSR WOQTYS SUB WOQTYC QTYORD 70 40 04300CSRN40 GOTO END2 04310CSR Z-ADDWODATE DLT 60 04320CSR WODLTR COMP DLT 54 04330CSR 54 Z-ADDWODLTR DLT 04340CSR WODLTC COMP DLT 54 04350CSR 54 Z-ADDWODLTC DLT 04360CSR WODLTL COMP DLT 54 04370CSR 54 Z-ADDWODLTL DLT 04380CSR WODLTM COMP DLT 54 04390CSR 54 Z-ADDWODLTM DLT 04400CSR END2 ENDSR 04410C******************************************************************** 04420CSR SR3 BEGSR 04430C* GET POITEM RECORD 04440CSR AP9 CHAINPPITEM 54 04450CSRN54 PISTAT COMP 'D' 54 04460CSR 54 GOTO END3 04470CSR EXSR SR253 ALLOCATE RECEIPT QTYS04480CSR Z-ADD1 X 30 04490CSR APDUE LOKUPPID,X 54 04500CSR Z-ADDPIQ,X QTYORD 40 ÐÐ04510CSRN40 GOTO END3 04520CSR Z-ADDPIDLR DLT 04530CSR SETON 42 04540CSR END3 ENDSR 04550C******************************************************************* 04560CSR SR6 BEGSR 04570C* GET SALES ORDER 04580CSR AP11 CHAINSOMAST 54 04590CSRN54 SOSTAT COMP 'D' 54 04600CSR 54 GOTO END6 04610CSR SOQTYR SUB SOQTYS QTYREQ 70 40 04620CSRN40 GOTO END6 04630CSR Z-ADDSOBOOK DLT 04640CSR SODLS COMP DLT 54 04650CSR 54 Z-ADDSODLS DLT 04660CSR SODLK COMP DLT 54 04670CSR 54 Z-ADDSODLK DLT 04680CSR END6 ENDSR 04690C******************************************************************** 04700CSR SR7 BEGSR 04710C* GET BACKORDER MASTER 04720CSR MOVELAP9 W19A 19 04730CSR MOVE APPN W19A 04740CSR W19A CHAINBOMAST 54 04750CSRN54 BOSTAT COMP 'D' 54 ÐÐ04760CSR 54 GOTO END7 04770CSR BOQTYR SUB BOQTYC QTYREQ 40 04780CSRN40 GOTO END7 04790CSR Z-ADDBODLT DLT 04800CSR SETON 43 04810CSR END7 ENDSR 04820C****************************************************************** 04830CSR SR8 BEGSR 04840C* GET PULL FILE RECORD 04850CSR MOVELAP9 W19A 04860CSR MOVE APPN W19A 04870CSR W19A CHAINWOPULL 54 04880CSRN54 WPSTAT COMP 'D' 54 04890CSR 54 GOTO END8 04900CSR WPQTYR SUB WPQTYC QTYREQ 40 04910CSRN40 GOTO END8 04920CSR Z-ADDWPDLT DLT 04930CSR END8 ENDSR 04940C***************************************************************** 04950CSR SR9 BEGSR 04960C* GET FORECAST 04970CSR Z-ADDAPQTY QTYREQ 40 04980CSR Z-ADD0 DLT 04990CSRN40 GOTO END9 05000CSR MOVELAPDUE W4N ÐÐ05010CSR W4N COMP LSTFUP 54 05020CSRN54 Z-ADD0 UPDFOR 05030CSRN54 Z-ADD0 LSTFUP 40 05040CSR QTYREQ COMP UPDFOR 54 05050CSR 54 QTYREQ SUB UPDFOR QTYREQ 40 05060CSR 54 Z-ADD0 UPDFOR 05070CSRN54 UPDFOR SUB QTYREQ UPDFOR 05080CSRN54 Z-ADD0 QTYREQ 40 05090CSR END9 ENDSR 05100C* 05110C******************************************************************* 05120CSR SR30 BEGSR 05130C* COMPUTE AVAIL BALANCE 05140CSR 10 QTYORD ADD ORDBAL ORDBAL 70 05150CSR 11 QTYREQ ADD REQBAL REQBAL 70 05160CSR 11N09 EXSR SR204 INCRS FRCST UPD QTY 05170CSR PMOHB COMP 0 54 05180CSR 54 Z-ADDPMOHB AVAIL 70 05190CSRN54 Z-ADD0 AVAIL 05200CSR ORDBAL ADD AVAIL AVAIL 05210CSR AVAIL SUB REQBAL AVAIL 05220CSR ENDSR 05230C********************************************************************* 05240CSR SR31 BEGSR 05250C* SHORTAGE EXCEPTION ÐÐ05260CSR AVAIL COMP -1 54 05270CSRN54 Z-ADD682 M 50 05280CSRN54 EXSR SR114 STORE ERROR 05290CSR ENDSR 05300C******************************************************************* 05310CSR SR32 BEGSR 05320C* FLAG BELOW SAFETY STOCK 05330CSR PMSSTK COMP 0 54 05340CSR 54 PMSSTK COMP AVAIL 54 05350CSR 54 Z-ADD688 M 05360CSR 54 EXSR SR114 STORE ERROR # 05370CSR ENDSR 05380C******************************************************************* 05390CSR SR33 BEGSR 05400C* FLAG PAST DUE 05410CSR TODAY COMP APDUE 54 05420CSR 54 Z-ADD518 M 05430CSR 54 EXSR SR114 STORE ERROR # 05440CSR ENDSR 05450C******************************************************************* 05460CSR SR34 BEGSR 05470C* FLAG CURRENT ORDER REQD FOR PREV BO 05480CSR CUMBO COMP 0 54 05490CSR 54 Z-ADD689 M 05500CSR 54 EXSR SR114 STORE ERROR # ÐÐ05510CSR ENDSR 05520C******************************************************************* 05530CSR SR35 BEGSR 05540C* FLAG PREV ORD REQD THIS BO 05550CSR CUMORD COMP 0 54 05560CSR 54 Z-ADD690 M 05570CSR 54 EXSR SR114 STORE ERROR # 05580CSR ENDSR 05590C********************************************************************** 05600CSR SR36 BEGSR 05610C* FLAG WORK ORDER NOT RELEASED. 05620CSR TODAY COMP WOSTRT 54 05630CSR 54 WODLTR COMP 0 55 05640CSR 54N55 Z-ADD673 M 05650CSR 54N55 EXSR SR114 STORE ERROR # 05660CSR ENDSR 05670C***************************************************************** 05680CSR SR37 BEGSR 05690C* FLAG ACTIVE BO AND RECEIVED PO 05700CSR 42 43 Z-ADD678 M 05710CSR 42 43 EXSR SR114 STORE ERROR # 05720CSR ENDSR 05730C**************************************************************** 05740CSR SR38 BEGSR 05750C* FLAG BACKORDER WITH STOCK ÐÐ05760CSR CUMSTK COMP 0 54 05770CSR 54 Z-ADD679 M 50 05780CSR 54 EXSR SR114 STORE ERROR # 05790CSR ENDSR 05800C***************************************************************** 05810CSR SR39 BEGSR 05820C* FLAG TO BE ORDERED 05830CSR AVAIL SUB PMSSTK W7N 70 54 LESS THAN 05840CSR 10 54 Z-ADD666 M MFG 05850CSR 11 54 Z-ADD665 M MFG 05860CSR 54 EXSR SR114 STORE ERROR # 05870CSR ENDSR 05880C****************************************************************** 05890CSR SR60 BEGSR 05900C* CLEAR CRT 05910CSRN50 EXITFZCPAGE DG-132-A 05920CSRN50 MOVEL'091' RPGLIN 4 05930CSRN50 MOVEL'001' RPGCOL 4 05940CSRN50 EXSR SR69 MOVE CURSOR 05950CSR 50 EXSR SR65 INIT STATUS 05960CSR 50 EXITFZESCH DG-132-1 05970CSR ENDSR 05980C**************************************************************** 05990CSR SR62 BEGSR 06000CSR EXITFZESTAT ENTER STATUS MODE ÐÐ06010CSR ENDSR 06020C*************************************************************** 06030CSR SR63 BEGSR 06040CSR EXITFZXSTAT EXIT STATUS MODE 06050CSR ENDSR 06060C******************************************************************** 06070CSR SR65 BEGSR 06080C* INIT STATUS LINE DG-132-1 CRT. 06090CSR 50 EXITFZISTAT INIT STATUS LINE 06100CSR ENDSR 06110C******************************************************************** 06120CSR SR66 BEGSR 06130CSR EXSR SR67 CR 06140CSR EXSR SR68 LF 06150CSR ENDSR 06160C******************************************************************** 06170CSR SR67 BEGSR 06180CSR EXITFZCR CR 06190CSR ENDSR 06200C******************************************************************** 06210CSR SR68 BEGSR 06220CSR EXITFZLF LF 06230CSR ENDSR 06240C******************************************************************* 06250CSR SR69 BEGSR ÐÐ06260CSR 50 EXITFZPUTXY MOVE CURSOR 06270CSR RLABL RPGLIN 06280CSR RLABL RPGCOL 06290CSRN50 EXITFZMOVXY MOVE CURSOR 06300CSR RLABL RPGLIN 06310CSR RLABL RPGCOL 06320CSR END69 ENDSR 06330C******************************************************************* 06340CSR SR71 BEGSR 06350C* PUT HEADINGS. 06360CSR EXSR SR60 CLEAR TERMINALS 06370CSR SETON 71 06380CSR EXCPT PUT HEADING 06390CSR SETOF 71 06400CSR Z-ADD3 LINENO 30 06410CSR ENDSR 06420C******************************************************************** 06430CSR SR72 BEGSR 06440C* DISPLAY DATA LINE 06450CSR Z-ADD0 E 06460CSR EXSR SR110 COMPUTE EXCEPTIONS 06470CSR 1 ADD E XTRA 06480CSR EXSR SR111 CHECK LINE # 06490CSR 77 06500COR 90 GOTO END72 ÐÐ06510CSR 1 ADD LINENO LINENO 06520CSR ORDD COMP 0 55 06530CSR ORDDD COMP 0 56 06540CSR SETON 72 06550CSR EXCPT DISPLAY DATA LINE 06560CSR SETOF 72 06570CSR Z-ADDAPPN LASTPN 100 06580CSR EXSR SR206 DISPLAY REMARKS 06590CSR END72 ENDSR 06600C******************************************************************** 06610CSR SR73 BEGSR 06620C* PUT MESSAGE 06630CSR EXSR SR89 GET MESSAGE FILE 06640CSR 54 MOVE '9' NUL 06650CSR 54 MOVEANUL MGTEXT 06660CSR 54 MOVE BIT2 NUL 06670CSR SETON 73 06680CSR EXCPT 06690CSR SETOF 73 06700CSR 1 ADD LINENO LINENO 06710CSR ENDSR 06720C******************************************************************** 06730CSR SR75 BEGSR 06740C* READ CRT. 06750CSR SETOF 779092 ÐÐ06760CSR MOVE BLK12 W12A 12 06770CSR EXITFZR12 READ TERMINAL 06780CSR RLABL W12A 06790CSR MOVEAW12A A12 06800CSR MOVE BLK12 W12A 06810CSR Z-ADD1 W 30 06820CSR '\' LOKUPA12,W 90 CHECK ESC 06830CSRN90 GOTO T75B 06840CSR 1 ADD W W 06850CSR W COMP 12 54 06860CSR 54 GOTO T75A 06870CSR A12,W COMP 'G' 98 GOODBY 06880CSR A12,W COMP 'N' 93 NEW ITEM 06890CSR A12,W COMP 'E' 94 EXIT 06900CSR A12,W COMP 'B' 92 SKIP BACK 06910CSR 93 GOTO NEWITM 06920CSR 94 GOTO MENU 06930CSR 98 GOTO GOODBY 06940CSR 92 GOTO END75 06950C*------------------------------------------------------------------- 06960CSR T75A TAG 06970CSR Z-ADD318 M 50 FLAG ERROR 06980CSR EXSR SR73 PUT MSG 06990CSR GOTO SR75 07000C*------------------------------------------------------------------- ÐÐ07010CSR T75B TAG 07020CSR Z-ADD1 W 07030CSR ' ' LOKUPA12,W 77 07040CSR 77 MOVEAA12,W W12A 07050C*----------------------------------------------------------------- 07060CSR END75 TAG 07070CSR EXSR SR65 INIT STATUS LINE 07080CSR ENDSR 07090C********************************************************************* 07100CSR SR76 BEGSR 07110C* PUT BLINKING MESSAGE. 07120CSR EXITFZDIM 07130CSR 50 EXITFZBLINK 07140CSR SETON 76 07150CSR EXSR SR73 07160CSR SETOF 76 07170CSR EXITFZBRITE 07180CSR 50 EXITFZBLUNK 07190CSR ENDSR 07200C******************************************************************** 07210CSR SR80 BEGSR 07220C* GET CALENDAR CAL DATE RECORD 07230CSR MOVEL'C' W7A 7 07240CSR MOVE W6N W7A 07250CSR EXSR SR82 GET CALDENDAR ÐÐ07260CSR ENDSR 07270C******************************************************************** 07280CSR SR81 BEGSR 07290C* GET CALENDAR MDAY RECORD 07300CSR MOVEL'M' W7A 07310CSR MOVE W6N W7A 07320CSR EXSR SR82 GET CALENDAR 07330CSR ENDSR 07340C******************************************************************** 07350CSR SR82 BEGSR 07360C* GET CALENDAR 07370CSR W7A CHAINCALENDAR 54 07380CSR ENDSR 07390C******************************************************************** 07400CSR SR89 BEGSR 07410CSR M CHAINMGFILE 54 GET MESSAGE FILE 07420CSR ENDSR 07430C******************************************************************** 07440CSR SR96 BEGSR 07450CSR # CHAINCRTFILE H9 GET CRTFILE 07460CSR H9 GOTO ENDJOB 07470CSR ENDSR 07480C******************************************************************** 07490CSR SR97 BEGSR 07500C* UPDATE CRTFILE. EXIT PROGRAM. ÐÐ07510CSR TIME CRTIME 07520CSR MOVELUDATE CRDATE 07530CSR SETON 97 07540CSR EXCPT UPD CRTFILE 07550CSR SETOF 97 07560CSR ENDSR 07570C******************************************************************** 07580CSR SR98 BEGSR 07590CSR EXSR SR60 CLEAR SCREEN 07600CSR EXITFCHAIN >>>>>>>>>> 07610CSR RLABL PROG 07620CSR ENDSR 07630C******************************************************************** 07640CSR SR101 BEGSR 07650C* 1-TIME INITIALIZE. 07660CSR MOVE BIT,1 BIT2 2 07670CSR MOVELBIT,1 BIT2 07680CSR MOVE BIT2 NUL 07690CSR Z-ADD0 ERR 07700CSR MOVE ' ' BLK35 35 07710CSR MOVE ' ' BLK12 12 07720CSR Z-ADDUDATE W6N 60 07730CSR MOVELUDATE W4N 40 07740CSR MOVE UDATE W2N 07750CSR MOVELW2N TODAY 60 ÐÐ07760CSR MOVE W4N TODAY CUR CAL DATE 07770CSR Z-ADDTODAY W6N 60 07780CSR EXSR SR80 GET CALENDAR 07790CSR Z-ADDCCMDAY CURMDY 40 CURRENT M-DAY 07800CSR Z-ADD0 ZERO7 70 07810CSR MOVE ' ' W2A 2 07820CSR EXITFZGMINX GET PORT# 07830CSR RLABL W2A 07840CSR MOVE W2A # 20 07850CSR # COMP 0 54 07860CSRN54 Z-ADD25 # 07870CSR EXSR SR96 GET CRTFILE 07880CSR MOVE CALL LNK 07890CSR MOVE 'Q029WO 'PROG 07900CSR PAR,# COMP '1' 50 07910CSR TST,# COMP 'S' 54 07920CSR 54 MOVE 'SHUTDOWN'PROG 07930CSR EXSR SR97 UPD CRTFILE 07940CSR 54 EXSR SR98 >>>>>>>>>> 07950CSRN50 Z-ADD28 BOTLIN 30 07960CSR 50 Z-ADD23 BOTLIN 07970CSR 50 EXSR SR65 INIT STATUS LINE 07980CSR Z-ADD0 ZERO5 50 07990CSR MOVE ' ' BLK11 11 08000CSR ENDSR ÐÐ08010C******************************************************************** 08020CSR SR102 BEGSR 08030C* REQUEST SELECTION #. 08040CSR SETOF 9077 08050CSR SETOF 2122 08060CSR SETON 74 08070CSR EXCPT PROMPT 08080CSR SETOF 74 08090CSR 4 ADD LINENO LINENO 08100CSR Z-ADD3 XTRA 08110CSR EXSR SR111 CHECK END PAGE 08120CSR 77 08130COR 90 GOTO END102 08140CSR EXSR SR75 READ 08150CSR MOVELW12A SEL 10 08160CSR SEL COMP 1 21 PART SEQ 08170CSR SEL COMP 2 22 MODEL SEQ 08180CSR 21 08190COR 22 GOTO END102 08200CSR Z-ADD241 M 08210CSR EXSR SR76 FLAG ERROR 08220CSR GOTO SR102 08230CSR END102 ENDSR 08240C******************************************************************** 08250CSR SR103 BEGSR ÐÐ08260C* REQUEST PART OR MODEL INPUT. 08270CSR SETOF 9077 08280CSR Z-ADD1 XTRA 08290CSR EXSR SR111 CHECK END PAGE 08300CSR 77 08310COR 90 GOTO END103 08320CSR SETON 79 08330CSR EXCPT PROMPT 08340CSR SETOF 79 08350CSR EXSR SR75 READ CRT 08360CSR END103 ENDSR 08370C******************************************************************** 08380CSR SR104 BEGSR 08390C* SET FILE LOW LIMITS 08400CSR MOVE BLK35 LASTAP 29 08410CSR MOVE BLK35 LASTPD 29 08420CSR 21 MOVE BLK35 W29A 29 08430CSR 21 MOVELTPN W29A 08440CSR 21 W29A SETLLALTPN 08450CSR 22 MOVE BLK35 W22A 22 08460CSR 22 MOVELTMODL W22A 08470CSR 22 W22A SETLLPMMODEL2 08480CSR 22 Z-ADD0 PDPN 08490CSR ENDSR 08500C******************************************************************** ÐÐ08510CSR SR105 BEGSR 08520C* READ NEXT RECORD. 08530CSR SETOF 409077 08540CSR SETOF 54 08550CSR READ ALTPN 54 08560CSR 54 GOTO END105 08570CSR APKEY COMP LASTAP 54 08580CSRN54 GOTO END105 08590CSR 22 APPN COMP PDPN 54 08600CSR 22N54 GOTO END105 08610CSR APSTAT COMP 'D' 54 08620CSR 54 GOTO SR105 08630CSR EXSR SR201 CLASSIFY RECORD 08640CSR EXSR SR203 GET RECORD 08650CSRN40 GOTO SR105 08660CSR END105 ENDSR 08670C********************************************************************* 08680CSR SR106 BEGSR 08690C* SEE IF NEW PART NO. HAS BEEN READ. 08700CSR SETOF 7790 08710CSR APPN COMP LASTPN 55 08720CSR ENDSR 08730C***************************************************************** 08740CSR SR107 BEGSR 08750C* PUT PART NO. QTY TOTALS ÐÐ08760CSR SETOF 7790 08770CSR Z-ADD0 E 08780CSR PMPN COMP 0 54 08790CSRN54 GOTO END107 NO PART# ACTIVE 08800CSR EXSR SR39 FLAG TO BE ORDERED 08810CSR EXSR SR37 FLAG RECD PO W/BO 08820CSR 1 ADD E XTRA 08830CSR EXSR SR111 CHECK END PAGE 08840CSR 77 08850COR 90 GOTO END107 08860CSR EXSR SR113 DISPLAY EXCEPTIONS 08870CSR SETON 78 08880CSR EXCPT DISPLAY TOTALS 08890CSR SETOF 78 08900CSR 1 ADD LINENO LINENO 08910CSR Z-ADD0 PMPN 08920CSR END107 ENDSR 08930C****************************************************************** 08940CSR SR108 BEGSR 08950C* DISPLAY PART MASTER 08960CSR SETOF 7790 08970CSR MOVE BLK11 SWO 08980CSR 24 GOTO T108E PAGE OVERFLOW 08990CSR Z-ADD0 ORDBAL 09000CSR Z-ADD0 REQBAL ÐÐ09010CSR Z-ADD0 AVAIL 09020CSR Z-ADD0 CUMORD 09030CSR Z-ADD0 CUMREQ 09040CSR Z-ADD0 RCDQTY 09050CSR Z-ADD0 CUMRCD 09060CSR Z-ADD0 CUMBO 09070CSR Z-ADD0 CUMSTK 09080CSR Z-ADD0 UPDFOR 09090CSR Z-ADD0 LSTFUP 09100CSR SETOF 4243 09110CSR MOVELAPPN W12A 12 09120CSR MOVE ' ' W12A 09130CSR W12A CHAINPMMST2 60 09140CSRN60 PMSTAT COMP 'D' 60 09150CSR 60 GOTO END108 BAD PART NO. 09160CSR PMSC1 COMP 'P' 55 09170CSR Z-ADD3 XTRA 30 09180CSR EXSR SR111 CHECK END PAGE 09190CSR 90 09200COR 77 GOTO END108 09210C*----------------------------------------------------------------- 09220CSR T108C TAG 09230CSR Z-ADDPMOHB AVAIL 70 54 09240CSRN54 Z-ADD0 AVAIL 09250CSR MOVE '- ' NUL ÐÐ09260C*------------------------------------------------------------------- 09270CSR T108E TAG 09280CSR SETON 70 09290CSR EXCPT DISPLAY PART MAST 09300CSR SETOF 70 09310CSRN24 Z-ADDPMPN LASTPN 09320CSR MOVE BIT2 NUL 09330CSR 1 ADD LINENO LINENO 09340CSRN24 1 ADD LINENO LINENO 09350CSR 24 GOTO END108 09360CSR PMOHB COMP 0 55 CHECK NEG ON HAND 09370CSR 55 Z-ADD680 M 09380CSR 55 EXSR SR76 PUT NEG ON HAND MSG 09390CSR Z-ADD1 XTRA 09400CSR EXSR SR111 CHECK END PAGE 09410CSR 77 09420COR 90 GOTO END108 09430CSR PMSSTK COMP 0 54 09440CSR 54 SETON 75 09450CSR 54 EXCPT SAFETY STOCK 09460CSR SETOF 75 09470CSR 54 1 ADD LINENO LINENO 09480CSR 54 EXSR SR32 FLAG SAFETY STOCK 09490CSR END108 ENDSR 09500C************************************************************************ ÐÐ09510CSR SR109 BEGSR 09520C* DISPLAY DATA LINE 09530CSR SETOF 7790 09540CSR EXSR SR30 COMPUTE AVAIL BAL 09550CSR EXSR SR72 PUT DATA 09560CSR END109 ENDSR 09570C******************************************************************** 09580CSR SR110 BEGSR 09590C* COMPUTE EXCEPTIONS 09600CSR SETOF 7790 09610CSR 10 QTYORD ADD CUMORD CUMORD 70 09620CSR 11 QTYREQ ADD CUMREQ CUMREQ 70 09630CSR 07 QTYREQ ADD CUMBO CUMBO 70 09640CSR 03 PIQRCD SUB PIQSTK RCDQTY 70 54 09650CSR 03N54 Z-ADD0 RCDQTY 09660CSR 03 RCDQTY ADD CUMRCD CUMRCD 70 09670CSR EXSR SR31 SHORTAGE 09680CSR EXSR SR32 SAFETY STOCK 09690CSR EXSR SR33 PAST DUE 09700CSR 10 EXSR SR34 ORDER WITH B/O 09710CSR 07 EXSR SR35 BO WITH PRIOR ORD 09720CSR 02 EXSR SR36 WO NOT REL 09730CSR 70 EXSR SR38 BO WITH STOCK 09740CSR 11 CUMSTK SUB QTYREQ CUMSTK 70 09750CSR 11 CUMRCD SUB QTYREQ CUMRCD ÐÐ09760CSR 10 CUMREQ SUB QTYORD CUMREQ 09770CSR 11 CUMORD SUB QTYREQ CUMORD 09780CSR ENDSR 09790C*********************************************************************** 09800CSR SR111 BEGSR 09810C* CHECK END OF PAGE 09820CSR SETOF 7790 09830CSR XTRA ADD LINENO W3N 30 09840CSR 1 ADD W3N W3N 09850CSR W3N COMP BOTLIN 54 54 09860CSRN54 GOTO END111 09870CSR SETON 24 09880CSR Z-ADD691 M 09890CSR EXSR SR89 GET MGFILE 09900CSR 50 MOVE '024 ' RPGLIN 4 09910CSR 50 MOVE '001 ' RPGCOL 4 CLASSIFY TERMINAL 09920CSR 50 EXITFZATTN END PAGE MESSAGE 09930CSR RLABL MGTEXT 09940CSR RLABL RPGLIN 09950CSR RLABL RPGCOL 09960CSR 50 EXSR SR63 EXIT STATUS MODE 09970CSRN50 EXSR SR73 PUT END PAGE MSG 09980CSR EXSR SR75 09990CSRN90 EXSR SR71 PUT HEADING 10000CSR 90 ÐÐ10010COR 77 GOTO END111 10020CSR PMPN COMP 0 54 10030CSR 54 PMPN COMP LASTPN 54 10040CSR 54 EXSR SR108 DISPLAY PART MAST 10050C*------------------------------------------------------------------ 10060CSR END111 TAG 10070CSR SETOF 24 10080CSR Z-ADD0 XTRA 10090CSR ENDSR 10100C********************************************************************* 10110CSR SR112 BEGSR 10120C* READ NEXT PMMODEL2 ALTKEY FOR MODEL SEQUENCE. 10130CSR SETOF 44 10140CSR READ PMMODEL2 44 10150CSR 44 GOTO END112 10160CSR PDKEY COMP LASTPD 54 10170CSRN54 SETON 44 10180CSRN54 GOTO END112 10190CSR MOVE PDKEY LASTPD 10200CSR PDSTAT COMP 'D' 54 10210CSR 54 GOTO SR112 10220CSR MOVE BLK35 LASTAP 10230CSR MOVE BLK35 W29A 10240CSR MOVELPDPN W29A 10250CSR W29A SETLLALTPN ÐÐ10260CSR END112 ENDSR 10270C******************************************************************** 10280CSR SR113 BEGSR 10290C* DISPLAY STORED ERROR MESSAGES. 10300CSR Z-ADD1 E 10310C*------------------------------------------------------------------- 10320CSR T113A TAG 10330CSR ZERO5 LOKUPERR,E 54 10340CSRN54 GOTO END113 10350CSR Z-ADD1 XTRA 10360CSR EXSR SR111 CHECK END PAGE 10370CSR Z-ADDERR,E M 10380CSR EXSR SR76 PUT ERR MSG 10390CSR Z-ADD0 ERR,E 10400CSR GOTO T113A 10410CSR END113 ENDSR 10420C******************************************************************** 10430CSR SR114 BEGSR 10440C* STORE EXCEPION ERR MSG # FOR LATER DISPLAY. 10450CSR 1 ADD E E 30 10460CSR E COMP 10 54 10470CSR 54 Z-ADD10 E 10480CSRN54 Z-ADDM ERR,E 10490CSR ENDSR 10500C******************************************************************** ÐÐ10510CSR SR201 BEGSR 10520C* CLASSIFY ALTPN RECORD 10530CSR SETOF 1011 10540CSR APREC COMP 20 02 WORK ORDER 10550CSR APREC COMP 30 03 PUR ORDER 10560CSR APREC COMP 50 05 PUR REQ 10570CSR APREC COMP 60 06 SALES ORD 10580CSR APREC COMP 70 07 BACKORDER 10590CSR APREC COMP 80 08 PULL FILE 10600CSR APREC COMP 90 09 FORECAST 10610CSR 02 10620COR 03 10630COR 05 SETON 10 ORDER 10640CSRN10 SETON 11 REQUIREMENT 10650CSR ENDSR 10660C******************************************************************* 10670CSR SR202 BEGSR 10680C* RIGHT JUSTIFY 10690CSR Z-ADD12 W2N 20 10700CSR EXIT SUBRAJ RJ 10710CSR RLABL W2N 10720CSR RLABL W12A 10730CSR ENDSR 10740C***************************************************************** 10750CSR SR203 BEGSR ÐÐ10760C* GET MASTER RECORD FOR CURRENT ALTPN RECORD 10770CSR SETOF 40 10780CSR 02 EXSR SR2 GET WORK ORDER MAST 10790CSR 03 EXSR SR3 GET PO MAST 10800CSR 06 EXSR SR6 GET SALES ORDER 10810CSR 07 EXSR SR7 GET BACK ORDER 10820CSR 08 EXSR SR8 GET PULL FILE 10830CSR 09 EXSR SR9 GET FORECAST 10840CSR ENDSR 10850C****************************************************************** 10860CSR SR204 BEGSR 10870C* CALCULATE FORECAST UPDATE QTY 10880CSR MOVELAPDUE W4N 40 10890CSR W4N COMP LSTFUP 54 10900CSR 54 QTYREQ ADD UPDFOR UPDFOR 70 10910CSRN54 Z-ADDQTYREQ UPDFOR 10920CSR ENDSR 10930C******************************************************************** 10940CSR SR205 BEGSR 10950C* R. ADJUST PN INPUT. 10960CSR 21 EXSR SR202 R.J. 10970CSR 21 MOVE W12A TPN 100 10980CSR 22 MOVELW12A TMODL 12 10990CSR ENDSR 11000C******************************************************************** ÐÐ11010CSR SR206 BEGSR 11020C* PUT REMARKS 11030CSR MOVELAP9 W9A 9 11040CSR MOVELAPREC W11A 11 11050CSR MOVE W9A W11A 11060CSR W11A LOKUPSWO 54 11070CSR 54 GOTO END206 11080CSR MOVELAPPN W16A 16 11090CSR MOVE '000000' W16A 11100CSR MOVELAPREC W13A 13 11110CSR MOVE AP9 W13A 11120CSR MOVE '00' W13A 11130CSR MOVELW16A W29A 29 11140CSR MOVE W13A W29A 11150CSR W29A SETLLREMARKS 11160CSR MOVE BLK35 LASTRK 29 11170C*------------------------------------------------------------------- 11180CSR T206C TAG 11190CSR SETOF 54 11200CSR READ REMARKS 54 11210CSR 54 GOTO END206 11220CSR RKKEY COMP LASTRK 54 11230CSRN54 GOTO END206 11240CSR MOVE RKKEY LASTRK 11250CSR RKPN COMP APPN 54 ÐÐ11260CSR 54 RKREC COMP APREC 54 11270CSR 54 MOVELAP9 W9A 11280CSR 54 RKWO COMP W9A 54 11290CSRN54 GOTO END206 11300CSR RKSTAT COMP 'D' 54 11310CSR 54 GOTO T206C 11320CSR MOVELRKREC W11A 11330CSR MOVE RKWO W11A 11340CSR Z-ADD1 X 11350CSR W11A LOKUPSWO,X 54 11360CSR 54 GOTO T206E 11370CSR Z-ADD1 X 30 11380CSR BLK11 LOKUPSWO,X 54 11390CSR 54 MOVE W11A SWO,X 11400C*------------------------------------------------------------------- 11410CSR T206E TAG 11420CSR 1 ADD LINENO LINENO 11430CSR EXSR SR111 CHECK LINE # 11440CSR EXITFZDIM START DIM 11450CSR SETON 68 11460CSR EXCPT PUT REMARKS 11470CSR SETOF 68 11480CSR EXITFZBRITE STOP DIM 11490CSR GOTO T206C 11500CSR END206 ENDSR ÐÐ11510C******************************************************************** 11520CSR SR253 BEGSR 11530C* ALLOCATE PO RECEIPTS TO PO SCHED 11540CSR Z-ADD1 X 30 11550C*------------------------------------------------------------------ 11560CSR T253C TAG 11570CSR ZERO7 LOKUPPIQ,X 54 11580CSRN54 GOTO END253 11590CSR PIQ,X COMP PIQRCD 54 11600CSR 54 PIQ,X SUB PIQRCD PIQ,X 11610CSR 54 Z-ADD0 PIQRCD 11620CSRN54 PIQRCD SUB PIQ,X PIQRCD 11630CSRN54 Z-ADD0 PIQ,X 11640CSR PIQRCD COMP 0 54 11650CSR 54 GOTO T253C 11660CSR END253 ENDSR 11670O*************************************************************** 11680OTERM132 E 71 11690O N50 8 '8091001' 11700O BIT,28 1 11710O N50 BIT,1 9 11720O N50 BIT,1 10 11730O 50 10 '[001 ]001' 11740O 50 BIT,28 6 11750O 64 'I N V E N T O R Y' ÐÐ11760O 78 'S T A T U S' 11770O 84 'B Y' 11780O 100 'P A R T N O.' 11790O UDATE Y 18 11800O*-------------------------------------------------------------- 11810O E 71 11820O 8 'PART-NO.' 11830O 26 'MODEL-NO.' 11840O 35 'TRAN' 11850O 46 'START' 11860O 56 'VENDOR' 11870O 101 'ON-HAND' 11880O 113 'REQUIRED' 11890O 119 'DUE' 11900O 132 'AVAILABLE' 11910O*--------------------------------------------------------------- 11920O E 71 11930O 11 'RECORD' 11940O 26 'ORDER NO.' 11950O 35 'DATE' 11960O 45 'DATE' 11970O 58 'CUSTOMER' 11980O 66 'NAME' 11990O 91 'PRICE' 12000O 102 'ON-ORDER' ÐÐ12010O 113 'QUANTITY' 12020O 120 'DATE' 12030O 131 'BALANCE' 12040O*------------------------------------------------------------------ 12050O E 70N24 12060O* PUT DIVIDER 12070O NUL 132 12080O*----------------------------------------------------------------- 12090O E 70 12100O PMPN 12 ' - - ' 12110O PMMODL 29 12120O 55 37 '(PURCH)' 12130O PMDESC 77 12140O N24 PMOSUC2 91 12150O N24 PMOHB J 103 12160O N24 AVAIL J 132 12170O 24 103 '......C O N T I N U E D ' 12180O*------------------------------------------------------------------ 12190O E 75 12200O 17 'SAFETY STOCK' 12210O PMSSTK2 113 12220O 103 '[' 12230O 114 ']' 12240O AVAIL K 132 12250O*-------------------------------------------------------------------------ÐÐ12260O E 72 12270O 02 15 'WORK ORDER' 12280O 03 16 'PURCH ORDER' 12290O 05 14 'PURCH REQ' 12300O 06 16 'SALES ORDER' 12310O 07 14 'BACKORDER' 12320O 08 13 'KIT PULL' 12330O 09 13 'FORECAST' 12340O N09 ORDP 23 12350O 55N09 24 '-' 12360O 55N09 ORDD 27 12370O 56N09 28 '-' 12380O 56N09 ORDDD 30 12390O DLT 39 ' - - ' 12400O 02 WOSTRT 48 ' - - ' 12410O VENDORZB 55 12420O NAME B 77 12430O 03 PIPRIC2 91 12440O 06 SOPRIC2 91 12450O 10 QTYORD2 102 12460O 11 QTYREQ2 113 12470O AVAIL J 132 12480O APDUE 123 ' - - ' 12490O*-------------------------------------------------------------------- 12500O E 78 ÐÐ12510O 77 'TOTALS..................' 12520O ORDBAL1 102 12530O REQBAL1 113 12540O AVAIL J 132 12550O*------------------------------------------------------------------- 12560O E 73 12570O N76 NUL 132 12580O N76 MGTEXT 60 12590O 76 MGTEXT 70 12600O*------------------------------------------------------------------- 12610O E 74 12620O 24 '1. PART NO. SEQUENCE ' 12630O E 74 12640O 24 '2. MODEL NO. SEQUENCE ' 12650O E 74 12660O 1 ' ' 12670O E 74 12680O OR 79 12690O NUL 132 12700O 74 16 'ENTER SELECTION:' 12710O 79 21 13 'ENTER PART #:' 12720O 79 22 14 'ENTER MODEL #:' 12730O 19 ' ' 12740O*------------------------------------------------------------------- 12750O E 68 ÐÐ12760O RKTEXT 91 12761O 30 '*' 12762O 93 '*' 12770O******************************************************************** 12780OCRTFILE E 97 12790O PROG 26 12800O CRTIME 33 12810O CRDATE 37 12820O CALL 79 12830O******************************************************************** ** A12 ARRAY 012840 012850** NUL ARRAY 012860 012870** ERR ARRAY 12880 12890** LNK ARRAY 12900 12910** SWO ARRAY 12920 12930/* 12940_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(=¥ XR14 P999999120282(èÈÐ SUBROUTINE ZR14 (IBUF) 00010C RING BELL. READ 14-CHAR FROM TERMINAL. 00020 INTEGER IBUF (7) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 14 00070 ITC = 0 00080 IA = $0700 00090 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00100 RETURN 00110 END 00120_‚ _‚_‚ ÐÈ(R=­ RcX003RM P¬<999999120282(èÈÐ00010H Q003RM00020F* INTERACTIVE UPDATE - RMMAST FILE. (CALLED BY Q002RM). (X003RM) 00030F* REVISED 3/25/83 3:40 PM. DG-REL006 OK. 00040F* N O T E: U7 PUTS PROG NAME TO CRT. 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FOPDESCR IC F 47R 5AI 1 DISK 00090FWCMAST IC F 960R 8AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A40 40 40 1 A INPUT DATA ARRAY 00140E NUM 1 9 3 0 NUMERIC FIELD NO.'S 00150E DUN 14 14 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E TABTRN 1 3 1 TABNAM 6 TRAN NAMES 00180E TABMET 1 2 1 TABMN 12 METHOD NAMES 00190E LOC 1 14 6 XY-POS 00200E BIT 33 1 SCREEN CONTR. CHAR 00210E CALL 5 6 CALL STACK 00220I******************************************************************* 00230IBITTAB BT 00240I 1 33 BIT 00250I******************************************************************* ÐÐ00260IMGFILE MG 00270I* MESSAGE FILE. 00280I 1 35 MGTEXT 00290I****************************************************************** 00300ICRTFILE CR 00310I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00320I* STD AREA - SAME FOR ALL PROGRAMS. 00330I* EMPLOYEE # 5N 00340I 1 50CREMPL 00350I* USER CODE 8A 00360I 6 13 CRUSER 00370I* DEPT # 5N 00380I 14 180CRDEPT 00390I* JOB NAME 8A (JOB LOADED BY MENU) 00400I 19 26 CRJOB 00410I* SHUTDOWN FLAG 1A 00420I* BLANK = NO SHUTDOWN 00430I 27 27 CRSHUT 00440I* TIME STARTED 6N 00450I 28 330CRTIME 00460I* DATE STARTED 4N 00470I 34 370CRDATE 00480I* CALL STACK 5 X 6A 00490I 38 67 CALL 00500I* RETURN TO PROG NAME (FOR PROG LOADER) 6A ÐÐ00510I 68 73 CRRET 00520I* MENU NAME 6A 00530I 74 79 CRMENU 00540I*------------------------------------------------------------------- 00550I* PROGRAM AREA - ROUTING FIELDS. 00560I* KEY AREA. 00570I* PART # 12A 00580I 80 91 CRPN 00590I* OPER SEQ # 3N 00600I 92 940CRSEQ 00610I* OPER GROUP CODE 2A 00620I 95 96 CRGRUP 00630I* OVERLAP % .2N 00640I 97 982CROVLP 00650I* OPER CODE 5A 00660I 99 103 CROPER 00670I* OPER DEPT. 00680I* DEPT # 5P 00690I P 104 1060CRDEPT 00700I* WORK CENTER 3P 00710I P 107 1080CRWC 00720I* OPER DESCRIPTION 40A 00730I 109 148 CRDESC 00740I* LABOR STDS. 00750I* ACCOUNTING STD. ÐÐ00760I* DATE ADOPTED 7P 00770I P 149 1520CRADAT 00780I* SET-UP 9.3P 00790I P 153 1573CRASU 00800I* RUN 9.3P 00810I P 158 1623CRARUN 00820I* MIN CHARGE 7.2P 00830I P 163 1662CRAMIN 00840I* STD LOT SIZE 7P 00850I P 167 1700CRALOT 00860I* REVISED STDS. 00870I* DATE LAST REVISED 7P 00880I P 171 1740CRRDAT 00890I* SET-UP 9.3P 00900I P 175 1793CRRSU 00910I* RUN 9.3P 00920I P 180 1843CRRRUN 00930I* MIN. CHARGE 7.2P 00940I P 185 1882CRRMIN 00950I* STD LOT SIZE 7P 00960I P 189 1920CRRLOT 00970I* METHOD ESTAB 1A 00980I 193 193 CRMETH 00990I* JOB SKILL 5A 01000I 194 198 CRSKIL ÐÐ01010I* PERFORM FACTOR. 01020I* ACTUAL 5.2P 01030I P 199 2012CRPER 01040I* ASSIGNED 5.2P 01050I P 202 2042CRPER2 01060I* NUMB LOTS RUN 5P 01070I P 205 2070CRLRUN 01080I* NUMB UNITS RUN 5P 01090I P 208 2100CRQRUN 01100I* TRAN CODE 1A 01110I 256 256 CRTRAN 01120I******************************************************************** 01130IOPDESCR OP 01140I* OPER CODE 5A 01150I 1 5 OPCODE 01160I* OPER DESCR 40A 01170I 7 46 OPDESC 01180I* RECORD STATUS 1A 01190I 47 47 OPSTAT 01200I******************************************************************** 01210IWCMAST WC 01220I* WORK CENTER MASTER. 01230I* NAME 29A 01240I 9 37 WCNAME 01250I* SET-UP RATE 5.2P ÐÐ01260I P 47 492WCLRAT 01270I* RUN RATE 5.2P 01280I P 50 522WCRRAT 01290I* BURDEN RATE 5.2P 01300I P 53 552WCBRAT 01310I 960 960 WCSTAT 01320C******************************************************************** 01330C* INITIALIZE 01340C EXSR SR101 1-TIME INIT 01350C 96 GOTO ERROR 01360C*------------------------------------------------------------------ 01370C START TAG 01380C* SET-UP 1ST FIELD NO. 01390C Z-ADD1 F 30 FIELD # 01400C GOTO READ 01410C MOVE BLK40 OPDESC 01420C*------------------------------------------------------------------ 01430C NEXT TAG 01440C* SET-UP NEXT FIELD NO. 01450C 1 ADD F F FIELD # 01460C*----------------------------------------------------------------- 01470C READ TAG 01480C* READ DATA FROM TERMINAL. 01490C SETOF 9096 01500C EXSR SR102 VALIDATE FIELD # ÐÐ01510C 55 GOTO UPDATE DONE 01520C EXSR SR203 CLASSIFY TRAN 01530C F COMP 1 54 01540C 62 54 GOTO UPDATE 01550C DUN,3 COMP ' ' 54 01560C F COMP 3 55 01570C 54 55 EXSR SR3 01580C EXSR SR201 IDENTIFY-F 01590C SETON 69 01600C EXSR SR72 PROMPT 01610C SETOF 69 01620C EXSR SR75 READ TERMINAL 01630C 98 GOTO GOODBY GOODBY 01640C 94 GOTO MENU MENU REQUEST 01650C 90 EXSR SR72 REWRITE INPUT DATA 01660C 93 GOTO NEWITM NEW ITEM 01670C 92 GOTO JUMP FIELD JUMP REQST 01680C 91 GOTO NEXT SKIP FORWARD 01690C 89 F SUB 1 F SKIP BACKWARD 01700C 89 GOTO READ " " 01710C 88 SETOF 90 SPACE FILL 01720C 88 SETON 77 " " 01730C 87 GOTO START 01740C 86 GOTO UPDATE UPDATE 01750C 85 GOTO READ REPEAT ÐÐ01760C 96 GOTO ERROR ERROR 01770C N77 GOTO EDIT NO DATA INPUT 01780C*------------------------------------------------------------------ 01790C PROCES TAG 01800C* PROCESS INPUT DATA 01810C EXSR SR103 MOVE DATA 01820C*------------------------------------------------------------------- 01830C EDIT TAG 01840C EXSR SR203 CLASSIFY TRAN 01850C N96N62 EXSR SR104 EDIT DATA 01860C EXSR SR72 REWRITE DATA 01870C 96 GOTO ERROR ERROR 01880C GOTO NEXT 01890C*------------------------------------------------------------------ 01900C UPDATE TAG 01910C* UPDATE DATA BASE. 01920C EXSR SR203 CLASSIFY TRAN 01930C N62 EXSR SR105 FINAL EDIT 01940C 96 GOTO ERROR ERROR 01950C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01960C MOVEL'Q004RM' PROG 8 SETUP LINKAGE 01970C GOTO END 01980C*------------------------------------------------------------------- 01990C JUMP TAG 02000C* SET-UP JUMP TO REQUESTED FIELD ÐÐ02010C 1 ADD W W 30 02020C W COMP 40 54 02030C 54 Z-ADD318 M 50 96 FLAG ERROR 02040C 54 GOTO ERROR BAD ESC 02050C MOVE '000' W3A 3 02060C MOVEAA40,W W3A 02070C Z-ADD3 W2N 20 02080C EXIT SUBRAJ R. JUSTIFY 02090C RLABL W2N 02100C RLABL W3A 02110C MOVE W3A F NEW FIELD # 02120C GOTO READ 02130C*-------------------------------------------------------------------- 02140C ERROR TAG 02150C EXSR SR89 GET MSG 02160C GOTO READ 02170C*------------------------------------------------------------------ 02180C NEWITM TAG 02190C* SET-UP LINK FOR NEW ITEM 02200C MOVEL'Q001RM' PROG 8 02210C GOTO END 02220C*------------------------------------------------------------------- 02230C MENU TAG 02240C* SET-UP LINK TO MENU 02250C MOVEL'QQRM01' PROG ÐÐ02260C GOTO END 02270C*-------------------------------------------------------------------- 02280C GOODBY TAG 02290C* LINK TO SIGN-OFF 02300C MOVEL'GOODBY' PROG 02310C GOTO END 02320C*------------------------------------------------------------------- 02330C END TAG 02340C PROG COMP BLK8 54 02350C N54 MOVEL'Q001RM' PROG 02360C EXSR SR97 UPDATE CRTFILE 02370C EXITFCHAIN LINK TO NEXT PROG 02380C RLABL PROG 02390C******************************************************************** 02400CSR SR3 BEGSR 02410C* DEFAULT ROUTING OPER DESCR. 02420CSR CROPER COMP BLK5 54 02430CSRN54 GOTO END3 02440CSR CRDESC COMP BLK40 54 02450CSR 54 GOTO END3 02460CSR CROPER CHAINOPDESCR 54 02470CSRN54 OPSTAT COMP 'D' 54 02480CSR 54 GOTO END3 02490CSR MOVE OPDESC CRDESC 02500CSR MOVELCROPER W4A 4 ÐÐ02510C**** W4A COMP '8888' 54 02520C****4 GOTO END3 02530C**** CRDEPT COMP 0 54 02540C****4 GOTO END3 02550C**** Z-ADD470 CRDEPT PROD CONTROL 02560C**** Z-ADD3 CRWC MATL HANDLING 02570CSR END3 ENDSR 02580C******************************************************************** 02590CSR SR5 BEGSR 02600C* EDIT DEPT/WORK CENTER. 02610CSR MOVELCRDEPT W8A 8 02620CSR MOVE CRWC W8A 02630CSR W8A CHAINWCMAST 54 02640CSRN54 WCSTAT COMP 'D' 54 02650CSR 54 Z-ADD628 M 96 FLAG ERROR. 02660CSR 54 MOVE BLK35 WCNAME 02670CSR ENDSR 02680C******************************************************************** 02690CSR SR6 BEGSR 02700C* EDIT DESCRIPTION. 02710CSR CRDESC COMP BLK40 54 02720CSRN54 MOVE OPDESC CRDESC 02730CSR ENDSR 02740C******************************************************************** 02750CSR SR50 BEGSR ÐÐ02760C* FINAL EDIT. 02770C* FLAG INVALID OVERLAP PCT. 02780CSR CRGRUP COMP ' ' 54 02790CSR CROVLP COMP 0 55 02800CSR 55N54 Z-ADD233 M 96 FLAG ERROR. 02810C* FLAG INVALID SET-UP/STD LOT. 02820CSR CRRSU COMP 0 54 02830CSR CRRLOT COMP 0 55 02840CSR 54N55 Z-ADD234 M 96 FLAG ERROR. 02850CSR 54N55 Z-ADD9 F 02860CSR CRRDAT COMP 0 54 02870CSRN54 Z-ADDUDATE CRRDAT 02880CSR ENDSR 02890C********************************************************************* 02900CSR SR69 BEGSR 02910C* MOVE CURSOR 02920CSR EXITFQXYPOS MOVE CUROSR 02930CSR RLABL W6A 02940CSR ENDSR 02950C******************************************************************** 02960CSR SR72 BEGSR 02970C* PUT DATA TO TERMINAL 02980CSR MOVELLOC,F W3N 30 02990CSR W3N SUB 1 W3N 03000CSR MOVELW3N W6A 6 ÐÐ03010CSR MOVE '001' W6A 03020CSR EXSR SR69 MOVE CURSOR 03030CSR SETON 72 03040CSR EXCPT PUT DATA 03050CSR SETOF 72 03060CSRN69 GOTO END72 NOT PROMPT. 03070CSR END72 ENDSR 03080C*********************************************************************** 03090CSR SR73 BEGSR 03100C* PUT ERROR MESSAGE TO TERMINAL 03110CSR SETON 73 03120CSR EXCPT PUT MSG 03130CSR SETOF 73 03140CSR Z-ADDM LSTERR 50 03150CSR ENDSR 03160C******************************************************************* 03170CSR SR75 BEGSR 03180C* READ FROM TERMINAL 03190CSR SETOF 779096 03200CSR SETOF 939291 03210CSR SETOF 898887 03220CSR SETOF 8685 03230CSR MOVE BLK35 MGTEXT 03240CSR MOVE LOC,F W6A 03250CSR EXSR SR69 MOVE CURSOR ÐÐ03260CSR MOVE BLK40 W40A 40 BUFFER 03270CSR EXITFZR40 READ TERM 03280CSR RLABL W40A 03290CSR MOVEAW40A A40 03300CSR MOVE BLK40 W40A 03310CSR Z-ADD1 W 30 03320CSR '\' LOKUPA40,W 90 FLAG ESC 03330CSRN90 GOTO T75B NOT ESC 03340CSR 1 ADD W W 03350CSR W COMP 40 54 03360CSR 54 GOTO T75A BAD ESC 03370CSR A40,W COMP 'G' 98 GOODBY 03380CSR A40,W COMP 'E' 94 MENU 03390CSR A40,W COMP 'N' 93 NEW ITEM 03400CSR A40,W COMP 'J' 92 JUMP 03410CSR A40,W COMP 'F' 91 SKIP FRWRD 03420CSR A40,W COMP 'B' 89 SKIP BKWRD 03430CSR A40,W COMP 'S' 88 SPACE FILL 03440CSR A40,W COMP 'H' 87 HOME 03450CSR A40,W COMP 'U' 86 UPDATE 03460CSR A40,W COMP 'R' 85 REPEAT 03470CSR 98 03480COR 94 03490COR 93 03500COR 92 ÐÐ03510COR 91 03520COR 89 03530COR 88 03540COR 87 03550COR 86 03560COR 85 GOTO END75 GOOD ESC 03570C*------------------------------------------------------------------ 03580CSR T75A TAG 03590C* FLAG BAD ESC INPUT 03600CSR Z-ADD318 M 96 FLAG ERROR 03610CSR GOTO END75 03620C*-------------------------------------------------------------------- 03630CSR T75B TAG 03640C* MOVE DATA 03650CSR Z-ADD1 W 03660CSR ' ' LOKUPA40,W 77 03670CSR 77 MOVEAA40,W W40A INPUT DATA 03680C*-------------------------------------------------------------------- 03690CSR END75 TAG 03700C* INIT PREV ERROR MSG. 03710CSR LSTERR COMP 0 54 03720CSR 54 MOVE BLK35 MGTEXT 03730CSR 54 EXSR SR73 BLANK MESSAGE 03740CSR Z-ADD0 LSTERR 50 03750CSR ENDSR ÐÐ03760C********************************************************************** 03770CSR SR89 BEGSR 03780C* GET MESSAGE MASTER 03790CSR M CHAINMGFILE 54 03800CSR 54 MOVE BLK35 MGTEXT 03810CSR 54 MOVELM MGTEXT 03820CSR 54 MOVE MES,1 MGTEXT 03830CSR ENDSR 03840C****************************************************************** 03850CSR SR97 BEGSR 03860C* UPDATE CRTFILE. 03870CSR 78 EXSR SR112 ADOPT ACTG COSTS 03880CSR SETON 97 03890CSR EXCPT UPDATE CRTFILE 03900CSR SETOF 97 03910CSR ENDSR 03920C*********************************************************************** 03930CSR SR101 BEGSR 03940C* 1-TIME INITIALIZE 03950CSR MOVE BIT,1 NUL 03960CSR Z-ADD14 FLIMIT 30 TOTAL NUMB FIELDS 03970C* GET PORT #, CRTFILE. 03980CSR U7 MOVE 'Q003RM' W6A 6 03990CSR U7 EXITFZW6 04000CSR RLABL W6A ÐÐ04010CSR MOVE ' ' W2A 2 04020CSR EXITFZGMINX GET PORT # 04030CSR RLABL W2A 04040CSR MOVE W2A PORT 20 PORT # 04050CSR PORT COMP 0 54 04060CSRN54 Z-ADD25 PORT 04070CSR PORT CHAINCRTFILE H9 GET CRTFILE 04080CSR H9 GOTO END101 PROG ERROR 04090CSR EXSR SR203 04100CSR 62 GOTO T101A 04110CSR CRTRAN COMP 'A' 58 04120CSR 58 GOTO T101A 04130CSR EXSR SR5 EDIT WORK CENTER 04140CSR EXSR SR6 EDIT DESCRIPTION 04150CSR EXSR SR113 COMPUTE COSTS 04160CSRN96 EXSR SR114 METHOD NAME. 04170CSR 96 Z-ADD1 F 04180C*------------------------------------------------------------------- 04190CSR T101A TAG 04200C* DEFINE WORK FIELDS,ETC. 04210CSR MOVE ' ' BLK35 35 04220CSR MOVE ' ' BLK40 40 04230CSR MOVE ' ' BLK8 8 04240CSR MOVE ' ' BLK5 5 04250CSR END101 ENDSR ÐÐ04260C********************************************************************** 04270CSR SR102 BEGSR 04280C* VALIDATE FIELD NO. 04290CSR F COMP 0 54 04300CSRN54 Z-ADD1 F 04310CSR F COMP FLIMIT 55 04320CSR 55 Z-ADD1 F 04330CSR ENDSR 04340C******************************************************************** 04350CSR SR103 BEGSR 04360C* MOVE INPUT DATA 04370CSR EXSR SR201 IDENTIFY-F 04380CSR EXSR SR202 R. JUSTIFY 04390CSR 01 MOVELW40A CRGRUP OPER GROUP. 04400CSR 02 MOVE W15A CROVLP OVERLAP %. 04410CSR 03 MOVELW40A CROPER OPER CODE. 04420CSR 04 MOVE W15A CRDEPT DEPT. 04430CSR 05 MOVE W15A CRWC WORK CENTER. 04440CSR 06 MOVELW40A CRDESC DESCR. 04450CSR 07 MOVE W15A CRRSU SET-UP HRS. 04460CSR 08 MOVE W15A CRRRUN RUN HRS. 04470CSR 09 MOVE W15A CRRLOT STD LOT QTY. 04480CSR 10 MOVE W15A CRRMIN MIN. CHARGE. 04490CSR 11 MOVE W15A CRRDAT DATE REVISED. 04500CSR 12 MOVELW40A CRMETH METHOD CODE. ÐÐ04510CSR 13 MOVELW40A CRSKIL JOB SKILL. 04520CSR 14 MOVE W15A CRPER2 PERF. FACTOR. 04530CSR MOVE ' ' DUN,F EDIT FLAG 04540CSR ENDSR 04550C******************************************************************** 04560CSR SR104 BEGSR 04570C* EDIT INPUT DATA 04580CSR 03 EXSR SR3 04590CSR 05 EXSR SR5 04600CSR 06 EXSR SR6 04610C* COMPUTE COSTS 04620CSR 04 DEPT 04630COR 05 WC 04640COR 07 SU HRS 04650COR 08 RUN HRS 04660COR 09 LOT SIZE 04670COR 10 EXSR SR113 MIN CHARGE 04680CSR 12 EXSR SR114 METHOD NAME 04690CSR 96 MOVE ' ' DUN,F EDIT FLAG 04700CSRN96 MOVE 'X' DUN,F 04710CSR ENDSR 04720C*********************************************************************** 04730CSR SR105 BEGSR 04740C* FINAL EDIT 04750CSR SETON 79 FINAL EDIT FLAG ÐÐ04760CSR Z-ADD1 F 96 04770C*-------------------------------------------------------------------- 04780CSR T105A TAG 04790CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04800CSRN54 GOTO END105 04810CSR EXSR SR201 IDENTIFY-F 04820CSR EXSR SR104 EDIT 04830CSRN96 GOTO T105A 04840C*-------------------------------------------------------------------- 04850CSR END105 TAG 04860CSR EXSR SR50 FINAL EDIT. 04870CSR SETOF 79 04880CSR ENDSR 04890C******************************************************************** 04900CSR SR110 BEGSR 04910C* COMPUTE LAB $. 04920CSR DUN,5 COMP ' ' 54 04930CSRN54 MOVELCRDEPT W8A 8 04940CSRN54 MOVE CRWC W8A 04950CSRN54 W8A CHAINWCMAST 55 04960CSRN54N55 WCSTAT COMP 'D' 55 04970CSRN54 55 Z-ADD628 M 96 FLAG ERROR 04980CSRN54 55 GOTO END110 04990CSR WCBRAT MULT WCLRAT W5D2 52 05000CSR W5D2 ADD WCLRAT SURAT 52 SET-UP RATE ÐÐ05010CSR WCBRAT MULT WCRRAT W5D2 05020CSR W5D2 ADD WCRRAT RUNRAT 52 RUN RATE 05030CSR SURAT MULT CRRSU MFGDOL 92 05040CSR MFGDOL DIV CRRLOT MFGDOL UNIT SET-UP $ 05050CSR RUNRAT MULT CRRRUN W9D2 92 UNIT RUN $ 05060CSR W9D2 ADD MFGDOL MFGDOL MFG COST 05070CSR SURAT MULT CRASU ACTDOL 92 05080CSR ACTDOL DIV CRALOT ACTDOL UNIT SET-UP $ 05090CSR RUNRAT MULT CRARUN W9D2 RUN $ 05100CSR W9D2 ADD ACTDOL ACTDOL ACTG COST 05110CSR Z-ADDCRRSU MFGHRS 93 05120CSR Z-ADDCRASU ACTHRS 93 05130CSR CRRRUN ADD MFGHRS MFGHRS 05140CSR CRARUN ADD ACTHRS ACTHRS 05150CSR END110 ENDSR 05160C******************************************************************** 05170CSR SR112 BEGSR 05180C* ADOPT MFG COSTS AS ACCOUNTING COSTS. 05190CSR EXSR SR203 CLASSIFY TRAN 05200CSR CRASU COMP 0 54 05210CSR 60 05220CORN54 Z-ADDCRRSU CRASU SETUP HRS 05230CSR CRARUN COMP 0 54 05240CSR 60 05250CORN54 Z-ADDCRRRUN CRARUN RUN HRS ÐÐ05260CSR CRAMIN COMP 0 54 05270CSR 60 05280CORN54 Z-ADDCRRMIN CRAMIN MIN CHARGE 05290CSR CRALOT COMP 0 54 05300CSR 60 05310CORN54 Z-ADDCRRLOT CRALOT STD LOT SIZE 05320CSR CRADAT COMP 0 54 05330CSR 60 05340CORN54 Z-ADDUDATE CRADAT DATE ADOPTED 05350CSR ENDSR 05360C******************************************************************** 05370CSR SR113 BEGSR 05380C* COMPUTE COSTS - REVISE DATE. 05390CSR EXSR SR112 05400CSR EXSR SR110 05410CSR Z-ADDUDATE CRRDAT 05420CSR ENDSR 05430C******************************************************************** 05440CSR SR114 BEGSR 05450C* GET METHOD NAME. 05460CSR CRMETH LOKUPTABMET TABMN 54 05470CSR 54 MOVE TABMN METHOD 12 05480CSRN54 MOVE BLK35 METHOD 05490CSR ENDSR 05500C****************************************************************** ÐÐ05510CSR SR201 BEGSR 05520C* IDENTIFY FIELD NO. 05530CSR F COMP 1 01 05540CSR F COMP 2 02 05550CSR F COMP 3 03 05560CSR F COMP 4 04 05570CSR F COMP 5 05 05580CSR F COMP 6 06 05590CSR F COMP 7 07 05600CSR F COMP 8 08 05610CSR F COMP 9 09 05620CSR F COMP 10 10 05630CSR F COMP 11 11 05640CSR F COMP 12 12 05650CSR F COMP 13 13 05660CSR F COMP 14 14 05670CSR ENDSR 05680C******************************************************************** 05690CSR SR202 BEGSR 05700C* RIGHT JUSTIFY 05710CSR F LOKUPNUM 54 05720CSRN54 GOTO END202 NOT NUMERIC FIELD 05730CSR Z-ADD15 W2N 20 05740CSR MOVELW40A W15A 15 05750CSR EXIT SUBRAJ R. JUSTIFY ÐÐ05760CSR RLABL W2N 05770CSR RLABL W15A 05780CSR END202 ENDSR 05790C*********************************************************************** 05800CSR SR203 BEGSR 05810C* CLASSIFY TRAN CODE 05820CSR CRTRAN COMP 'A' 60 ADD 05830CSR CRTRAN COMP 'C' 61 CHANGE 05840CSR CRTRAN COMP 'D' 62 DELETE 05850CSR CRTRAN LOKUPTABTRN TABNAM 54 05860CSR 54 MOVE TABNAM TRNNAM 6 05870CSRN54 MOVE BLK8 TRNNAM 05880CSR ENDSR 05890O******************************************************************** 05900OTERM132 E 72 01 05910O 16 ' (1) OPER GROUP' 05920O CRGRUP 29 05930O MGTEXT 132 05940O*------------------------------------------------------------------- 05950O E 72 02 05960O 19 ' (2) OPER-OVERLAP%' 05970O CROVLP2 29 05980O MGTEXT 132 05990O*------------------------------------------------------------------- 06000O E 72 03 ÐÐ06010O 19 ' (3) STD-OPER-CODE' 06020O CROPER 31 06030O MGTEXT 132 06040O*------------------------------------------------------------------- 06050O E 72 04 06060O 16 ' (4) DEPARTMENT' 06070O CRDEPTZ 31 06080O MGTEXT 132 06090O*------------------------------------------------------------------- 06100O E 72 05 06110O 17 ' (5) WORK-CENTER' 06120O CRWC Z 29 06130O WCNAME 60 06140O MGTEXT 132 06150O*------------------------------------------------------------------- 06160O E 72 06 06170O 17 ' (6) DESCRIPTION' 06180O CRDESC 66 06190O MGTEXT 132 06200O*------------------------------------------------------------------- 06210O E 72 07 06220O 18 ' (7) SET-UP HOURS' 06230O CRRSU 2 35 06240O CRASU 2 56 06250O MGTEXT 132 ÐÐ06260O*------------------------------------------------------------------- 06270O E 72 08 06280O 15 ' (8) RUN-HOURS' 06290O CRRRUN2 35 06300O CRARUN2 56 06310O MGTEXT 132 06320O*------------------------------------------------------------------- 06330O E 72 09 06340O 18 ' (9) STD-LOT-SIZE' 06350O CRRLOT2 35 06360O CRALOT2 56 06370O MGTEXT 132 06380O*------------------------------------------------------------------- 06390O E 72 10 06400O 20 '(10) MINIMUM-CHARGE' 06410O CRRMIN2 35 06420O CRAMIN2 56 06430O MGTEXT 132 06440O*------------------------------------------------------------------- 06450O E 72 11 06460O 18 '(11) DATE-REVISED' 06470O CRRDAT 35 ' - - ' 06480O CRADAT 56 ' - - ' 06490O MGTEXT 132 06500O*------------------------------------------------------------------- ÐÐ06510O E 72 12 06520O 18 '(12) METHOD-ESTAB' 06530O CRMETH 27 06540O METHOD 41 06550O MGTEXT 132 06560O*------------------------------------------------------------------- 06570O E 72 13 06580O 15 '(13) JOB SKILL' 06590O CRSKIL 31 06600O MGTEXT 132 06610O*------------------------------------------------------------------- 06620O E 72 14 06630O 14 '(14) ASSIGNED' 06640O CRPER22 32 06650O MGTEXT 132 06660O*------------------------------------------------------------------- 06670O E 72 04 06680O OR 72 07 06690O OR 72 08 06700O OR 72 09 06710O BIT,28 1 06720O 2 '8' 06730O 5 '118' 06740O 8 '001' 06750O 22 'HOURS' ÐÐ06760O MFGHRS2 41 06770O ACTHRS2 64 06780O*------------------------------------------------------------------- 06790O E 72 04 06800O OR 72 07 06810O OR 72 08 06820O OR 72 09 06830O BIT,28 1 06840O 2 '8' 06850O 5 '119' 06860O 8 '001' 06870O 24 'DOLLARS' 06880O MFGDOL2 41 06890O ACTDOL2 64 06900O BIT,28 131 06910O 132 'K' 06920O*------------------------------------------------------------------- 06930O E 73 06940O* PUT MESSAGE. 06950O NUL 132 06960O BIT,28 1 06970O 2 '8' 06980O 5 '120' 06990O 8 '001' 07000O MGTEXT 48 ÐÐ07010O 50 ' ' 07020O 96 13 '*****' 07030O N96 13 ' ' 07040O BIT,28 130 07050O 131 'K' 07060O BIT,8 132 07070O******************************************************************** 07080OCRTFILE E 97 07090O CRPN 91 07100O CRSEQ 94 07110O CRGRUP 96 07120O CROVLP 98 07130O CROPER 103 07140O CRDEPT 106P 07150O CRWC 108P 07160O CRDESC 148 07170O CRADAT 152P 07180O CRASU 157P 07190O CRARUN 162P 07200O CRAMIN 166P 07210O CRALOT 170P 07220O CRRDAT 174P 07230O CRRSU 179P 07240O CRRRUN 184P 07250O CRRMIN 188P ÐÐ07260O CRRLOT 192P 07270O CRMETH 193 07280O CRSKIL 198 07290O CRPER 201P 07300O CRPER2 204P 07310O CRLRUN 207P 07320O CRQRUN 210P 07330O CRTRAN 256 ** NUL ARRAY 007340 007350** A12 ARRAY 007360 007370** NUM ARRAY 007380002 007390004 007400005 007410007 007420008 007430009 007440010 007450011 007460014 007470** DUN ARRAY 007480 007490** MES ARRAY 007500ÐÐ---MESSAGE NOT ON FILE--- 007510** TABTRN/TABNAM 007520AADD 007530CCHANGE 007540DDELETE 007550** TABMET/TABMN 007560EESTIMATED 007570HHISTORICAL 007580** LOC ARRAY 007590098027 1 007600099027 2 07610100027 3 07620101027 4 07630102027 5 07640103027 6 07650104027 7 07660105027 8 07670106027 9 07680107027 10 007690108027 11 07700109027 12 07710110027 13 07720113027 14 07730/* 007740_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(? §X014CF P120282120282(èÈÐ00010H Q014CF00020F* PRINT LABELS, SELECTED, KEY SEQUENCE (DIABLO). (X014CF) 00030F* REVISED 5/16/80 2:50 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FCFKEYOUTIS F 59 59 DISK 00060FCFMAST IC F 370R15AI 1 DISK 00070E******************************************************************** 00080E NA4 5 5 6 00090E NB4 5 5 4 0 00100E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00110E SEL 38 38 1 00120E WRK 38 38 1 A 00130E CSZ 38 38 1 A 00140E XS 1 1 39 00150E MSG 1 1 35 00160E A3 3 3 5 00170E BIT 33 1 00180E CFA 8 35 A 00190E CFN 5 3 A 00200E CFC 5 3 0 00210E NAC 24 1 00220I******************************************************************** 00230IBITTAB BT 02 00240I 1 33 BIT 00250I******************************************************************** ÐÐ00260ICFKEYOUTCK 00270I 36 50 CKKEY 00280I 51 590CKZIP 00290I******************************************************************** 00300ICFMAST CF 01 00310I* CATALOG HOLDER (MAIL LIST) MASTER. 00320I* KEY AREA. 00330I* NAME KEY 15A 00340I 1 15 CFKEY 00350I* ADDRESS LINES 35A X 8 00360I 16 295 CFA 00370I* STATE CODE 2A 00380I 296 297 CFSTCD 00390I* ZIP 9P 00400I P 298 3020CFZIP 00410I* CATALOGS. 00420I* NAME 3A X 5 00430I 303 317 CFN 00440I* COPIES 3P X 5 00450I P 318 327 CFC 00460I* SELECTOR CODES 24 X 1A 1 00470I 328 351 NAC 00480I* TELEPHONE # 12A 00490I 352 363 CFTEL 00500I* DATE LAST TRAN 6N (YMD) ÐÐ00510I 364 3690CFDLT 00520I* RECORD STATUS 1A 00530I 370 370 CFSTAT 00540C******************************************************************** 00550C* INITIALIZE - 1 TIME. 00560C EXSR SR101 INIT. 00570C 02 GOTO END 00580C CKKEY COMP BEGKEY 54 54 00590C N54 GOTO END 00600C*------------------------------------------------------------------- 00610C CKKEY CHAINCFMAST 54 00620C CFSTAT COMP 'D' 54 00630C 54 SETOF 01 00640C 54 GOTO END DELETED CFMAST. 00650C EXSR SR102 00660C*------------------------------------------------------------------- 00670C END TAG 00680CLR EXSR SR303 LF 00690CLR EXSR SR303 LF 00700CLR EXSR SR303 LF 00710CLR EXSR SR303 LF 00720CLR EXSR SR303 LF 00730CLR EXSR SR303 LF 00740CLR EXSR SR303 LF 00750CLR EXSR SR303 LF ÐÐ00760CLR EXSR SR303 LF 00770CLR EXSR SR303 LF 00780CLR EXSR SR303 LF 00790CLR EXITFQLF6 SET 6-LPI 00800C******************************************************************** 00810CSR SR101 BEGSR 00820C* INITIALIZE 1-TIME. 00830CSR EXITFQLF8 SET 8-LPI 00840CSR MOVE ' ' BLK16 16 00850CSR MOVE ' ' BLK35 35 00860CSR MOVE ' ' BLK60 60 00870CSR MOVE ' ' BLK25 25 00880CSR MOVE ' ' BLK22 22 00890CSR 78 GOTO END101 00900C*--------------------------------------------------------------- 00910CSR T101A TAG 00920C* WRITE X'S TO POSITION LABELS BY. 00930CSR SETON 78 00940CSR MOVEAXS W60A 60 00950CSR MOVE BLK22 W60A 00960CSR EXSR SR302 00970CSR EXSR SR302 00980CSR EXSR SR302 00990CSR EXSR SR302 01000CSR EXSR SR302 ÐÐ01010CSR EXSR SR302 01020CSR EXSR SR302 01030CSR EXSR SR302 01040CSR EXSR SR302 01050CSR EXSR SR302 01060CSR EXSR SR302 01070CSR EXSR SR303 LF/CR 01080CSR EXSR SR303 LF/CR 01090CSR MOVE ' ' W6A 6 01100CSR EXITFQREED6 READ CRT 6-BYTES 01110CSR RLABL W6A 01120CSR W6A COMP ' ' 54 01130CSRN54 GOTO T101A ALL BLANKS-REPEAT 01140C* GET STARTING KEY. 01150CSR MOVE BLK60 W60A 60 01160CSR MOVEAMSG W60A 01170CSR MOVE BLK25 W60A 01180CSR EXSR SR302 01190CSR MOVELBIT,1 BUFLGT 2 BUFFER LGTH. 01200CSR MOVE BIT,9 BUFLGT 01210CSR MOVE BLK60 W60A 01220CSR EXITFQWREED 01230CSR RLABL W60A 01240CSR RLABL BUFLGT 01250CSR MOVELW60A BEGKEY 15 ÐÐ01260CSR EXSR SR303 LF/CR 01270CSR EXSR SR303 01280CSR EXSR SR303 01290CSR EXSR SR303 01300CSR EXSR SR303 01310CSR EXSR SR303 01320CSR EXSR SR303 01330CSR EXSR SR303 01340CSR EXSR SR303 01350CSR END101 ENDSR 01360C******************************************************************** 01370CSR SR102 BEGSR 01380C* WRITE LABEL. 01390CSR Z-ADD0 COUNT 30 01400CSR EXSR SR201 PUT MAILER CODES 01410CSR Z-ADD1 L 30 01420CSR SETOF 75 01430C*------------------------------------------------------------------- 01440CSR T102A TAG 01450CSR BLK35 LOKUPCFA,L 54 01460CSRN54 GOTO T102W 01470CSR CFSTCD COMP ' ' 54 FLAG DOMESTIC 01480CSR L COMP 7 55 FLAG LINE 7 01490CSRN54 NOT DOMESTIC 01500CORN55 GOTO T102B NOT LINE 7 ÐÐ01510CSR EXSR SR202 PUT CITY/STATE. 01520CSR GOTO T102W 01530C*------------------------------------------------------------------- 01540CSR T102B TAG 01550CSR MOVE BLK60 W60A 01560CSR MOVEACFA,L W60A 01570CSR MOVE BLK25 W60A 01580CSR EXSR SR302 PUT NORMAL LINE 01590CSR SETON 75 01600CSR 1 ADD COUNT COUNT 01610CSR MOVE BLK35 CFA,L 01620CSR GOTO T102A GET NEXT LINE 01630C*------------------------------------------------------------------- 01640CSR T102W TAG 01650C* PUT OUT SPACE LINES. 01660CSR COUNT COMP 11 54 01670CSR 54 GOTO END102 01680CSR EXSR SR303 LF/CR 01690CSR 1 ADD COUNT COUNT 01700CSR GOTO T102W 01710CSR END102 ENDSR 01720C******************************************************************** 01730CSR SR201 BEGSR 01740C* PUT MAILER CODES. 01750CSR MOVE BLK60 W60A 60 ÐÐ01760CSR MOVEACFN W15A 15 01770CSR MOVE W15A W44A 44 01780CSR MOVELW44A W60A 01790CSR EXSR SR302 PUT MAILER 01800CSR 3 ADD COUNT COUNT 01810C* PUT COPIES. 01820CSR Z-ADD3 W2N 20 01830CSR Z-ADD0 C 30 01840C*------------------------------------------------------------------- 01850CSR T201A TAG 01860CSR 1 ADD C C 01870CSR C COMP 3 54 01880CSR 54 GOTO T201B 01890CSR MOVE CFC,C W3N 30 01900CSR MOVE 'Z' ECODE 1 01910CSR MOVE ' ' W3A 3 01920CSR EXIT SUBRED 01930CSR RLABL W3N 01940CSR RLABL ECODE 01950CSR RLABL W3A 01960CSR RLABL W2N 01970CSR MOVELW3A A3,C 01980CSR GOTO T201A 01990C*------------------------------------------------------------------- 02000CSR T201B TAG ÐÐ02010CSR MOVE BLK60 W60A 02020CSR MOVEAA3 W15A 02030CSR MOVE W15A W44A 02040CSR MOVELW44A W60A 02050CSR EXSR SR302 02060CSR EXSR SR303 LF/CR 02070CSR ENDSR 02080C******************************************************************** 02090CSR SR202 BEGSR 02100C* PUT CITY/STATE/ZIP. 02110CSR MOVE ' ' CSZ INIT CITY LINE 02120CSR MOVEACFA,7 CSZ CITY NAME 02130CSR EXSR SR301 FIND END CITY 02140CSRN55 GOTO T202E NO BLKS LEFT 02150CSR MOVE ',' CSZ,A COMMA 02160CSR 2 ADD A A 30 02170CSR A COMP 38 54 02180CSR 54 GOTO T202E NO BLKS LEFT 02190CSR MOVEACFSTCD CSZ,A STATE CODE 02200CSR 4 ADD A A 02210CSR A COMP 38 54 02220CSR 54 GOTO T202E NO BLKS LEFT 02230CSR MOVE CFZIP W5A 5 02240CSR MOVEAW5A CSZ,A ZIP CODE 02250C*------------------------------------------------------------------- ÐÐ02260CSR T202E TAG 02270CSR MOVE BLK60 W60A 02280CSR MOVEACSZ W60A 02290CSR MOVE BLK22 W60A 02300CSR EXSR SR302 02310CSR 1 ADD COUNT COUNT PUT CITY/STATE. 02320CSR ENDSR 02330C***************************************************************** 02340CSR SR301 BEGSR 02350C* FIND END OF CITY + 1 02360CSR SETOF 55 02370CSR Z-ADD0 W3N 30 02380CSR Z-ADD1 A 02390C*------------------------------------------------------------------- 02400CSR T301A TAG 02410CSR ' ' LOKUPCSZ,A 54 02420CSRN54 1 ADD W3N A 02430CSRN54 GOTO T301B 02440CSR Z-ADDA W3N 02450CSR 1 ADD A A 02460CSR A COMP 38 54 02470CSR 54 GOTO END301 02480CSR GOTO T301A 02490C*-------------------------------------------------------------- 02500CSR T301B TAG ÐÐ02510CSR A COMP 38 54 02520CSRN54 SETON 55 02530CSR END301 ENDSR 02540C******************************************************************** 02550CSR SR302 BEGSR 02560CSR EXSR SR303 LF/CF 02570CSR EXITFQTW60 02580CSR RLABL W60A 02590CSR ENDSR 02600C******************************************************************** 02610CSR SR303 BEGSR 02620C* LF/CR. 02630CSR EXITFQCLFCR LF/CR. 02640CSR ENDSR ** NA4 ARRAY 002650 002660** NB4 ARRAY 002670 002680** TABSC/TABSCN --- STATE CODES/NAMES 002690 002700ALALABAMA 002710AKALASKA 002720AZARIZONA 002730ARARKANSAS 002740ASAMERICAN SAMOA 002750ÐÐCACALIFORNIA 002760CZCANAL ZONE 002770COCOLORADO 002780CTCONNECTICUT 002790DEDELAWARE 002800DCDISTRICT OF COLUMBIA 002810FLFLORIDA 002820GAGEORGIA 002830GUGUAM 002840HIHAWAII 002850IDIDAHO 002860ILILLINOIS 002870ININDIANA 002880IAIOWA 002890KSKANSAS 002900KYKENTUCKY 002910LALOUISIANA 002920MEMAINE 002930MDMARYLAND 002940MAMASSACHUSETTS 002950MIMICHIGAN 002960MNMINNESOTA 002970MSMISSISSIPPI 002980MOMISSOURI 002990MTMONTANA 003000ÐÐNENEBRASKA 003010NVNEVADA 003020NHNEW HAMPSHIRE 003030NJNEW JERSEY 003040NMNEW MEXICO 003050NYNEW YORK 003060NCNORTH CAROLINA 003070NDNORTH DAKOTA 003080OHOHIO 003090OKOKLAHOMA 003100OROREGON 003110PAPENNSYLVANIA 003120PRPUERTO RICO 003130RIRHODE ISLAND 003140SCSOUTH CAROLINA 003150SDSOUTH DAKOTA 003160TNTENNESSEE 003170TTTRUST TERRITORIES 003180TXTEXAS 003190UTUTAH 003200VTVERMONT 003210VAVIRGINIA 003220VIVIRGIN ISLANDS 003230WAWASHINGTON 003240WVWEST VIRGINIA 003250ÐÐWIWISCONSIN 003260WYWYOMING 003270** SEL ARRAY 003280 003290** WRK ARRAY 003300 003310** CSZ ARRAY 003320 003330** XS ARRAY 003340XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 003350** MSG ARRAY 003360ENTER STARTING KEY: 003370** A3 ARRAY 003380 003390/* 003400_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼?¹ ¼$X016WO P999999120282(èÈÐ00010H Q016WO00020F* DISPLAY REQUIREMENTS FOR SPECIFIED WORK ORDER. (X016WO) 00030F* REVISED 10/25/82 3:35 PM. 00040FBITPAR IP F 90 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FMGFILE IC F 80R DISK 00070FWOMAST IC F 228R 9AI 1 DISK 00080FBOMAST ID F 80L19AI 1 DISK 00090FWOPULL ID F 64L19AI 1 DISK 00100FCRTFILE IC F 256R DISK 00110FPRODWO IT F 80 EDISK 00120FTERM132 O F 132 5 00130E******************************************************************** 00140E PRODWO TABPWO 1 4 1 PROD WO PREFIXES 00150E NUL 1 132 1 00160E A14 14 14 1 A 00170E A29 29 29 1 00180E LNK 1 7 6 A 00190E BIT 33 1 00200E PAR 25 1 00210E TST 25 1 00220E CALL 7 6 00230I**************************************************************** 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************** 00290ICRTFILE CR 00300I 1 50CREMPL 00310I 6 13 CRUSER 00320I 14 180CRDEPT 00330I 19 26 CRJOB 00340I 27 27 CRSHUT 00350I 28 330CRTIME 00360I 34 370CRDATE 00370I 38 79 CALL 00380I 74 79 CRMENU 00390I******************************************************************** 00400IMGFILE MG 00410I 1 35 MGTEXT 00420I******************************************************************** 00430IWOMAST WO 00440I* WORK ORDER MASTER. 00450I* WORK ORDER NO. 00460I 1 9 WOWO 00470I* PRIME 6A 00480I 1 1 PREFIX 00490I 1 6 WOWOP 00500I* DASH 3N ÐÐ00510I 7 90WOWOD 00520I* PART NO. 10N 00530I 10 190WOPN 00540I* TOP ASSY PN 10N 00550I 20 290WOTAPN 00560I* RUN NO. 3N 00570I 30 320WORUN 00580I* PROD LINE 4N 00590I 33 360WOPL 00600I* SCHED QTY 7P 00610I P 37 400WOQTYS 00620I* COMPLETED QTY 7P 00630I P 45 480WOQTYC 00640I* START DATE 6N (YMD) 00650I 49 540WOSTRT 00660I* DUE DATE 6N (YMD) 00670I 55 600WODUE 00680I* DATE ENTERED 6N (YMD) 00690I 61 660WODATE 00700I* DATE LAST REL 6N (YMD) 00710I 67 720WODLTR 00720I* DATE LAST COMPLETION 6N (YMD) 00730I 73 780WODLTC 00740I* DATE LAST LABOR 6N (YMD) 00750I 79 840WODLTL ÐÐ00760I* DATE LAST MATL CHARGE 6N (YMD) 00770I 85 900WODLTM 00780I* LABOR HRS CHARGED 7.1P 00790I P 91 941WOLABH 00800I* LABOR $ CHARGED 9.3P 00810I P 95 993WOLAB$ 00820I* MATL $ CHARGED 9.3P 00830I P 100 1043WOMAT$ 00840I* QTY TRSF 7P 00850I P 105 1080WOQTYT 00860I* AMOUNT TRANSFERRED 9.3P 00870I P 109 1133WO$T 00880I* REMARKS 35A 00890I 114 148 WODESC 00900I* MODEL NO. 12A 00910I 149 160 WOMODL 00920I* FAB CODE 2A 00930I 161 162 WOFAB 00940I* ALTERNATE BILL OF MATERIAL PART NO. 10N 00950I 163 1720WOABM 00960I* ALTERNATE ROUTING PART NO. 10N 00970I 173 1820WOARPN 00980I* DATE CLOSED 6N (YMD) 00990I 183 1880WOCLOS 01000I* RECORD STATUS 1A ÐÐ01010I 228 228 WOSTAT 01020I******************************************************************** 01030IWOPULL WP 01040I* WORK ORDER PULL FILE. 01050I* KEY AREA. 01060I* WORK ORDER 9A 01070I 1 9 WPWO 01080I 1 6 WPWOP 01090I 7 90WPWOD 01100I* COMPONENT PART # 10N 01110I 10 190WPCPN 01120I* WORK ORDER PART # 10N 01130I 20 290WPWPN 01140I* QTY REQD 7P 01150I P 30 330WPQTYR 01160I* STOCK LOCATION 6A 01170I 34 39 WPSLOC 01180I* QTY ISSUED 7P 01190I P 40 430WPQTYC 01200I* QTY B/O 7P 01210I P 44 470WPQTYB 01220I* QTY PER ASSY 7P 01230I P 48 510WPQPA 01240I* RECORD STATUS 1A 01250I 64 64 WPSTAT ÐÐ01260I******************************************************************** 01270IBOMAST BO 01280I* BACKORDER MASTER. 01290I* ORDER NO. 9A 01300I 1 9 BOKEY 01310I 1 6 BOWOP 01320I 7 90BOWOD 01330I 1 9 BOWO 01340I* PART NO. 10N 01350I 10 190BOPN 01360I* FILLER 2A 20 21 FFFFFF 01370I* QTY REQD 7P 01380I P 22 250BOQTYR 01390I* QTY ISSUED 7P 01400I P 26 290BOQTYC 01410I* DATE REQD 6N (YMD) 01420I 30 350BODUE 01430I* DATE LAST ISSUE 6N (YMD) 01440I 36 410BODLT 01450I* DELIVER TO 15A 01460I 42 56 BODEL 01470I* ASSY PART NO. 10N 01480I 57 660BONAPN 01490I* QTY PER ASSY 7P 01500I P 67 700BOQPA ÐÐ01510I* RECORD STATUS 1A 01520I 80 80 BOSTAT 01530I******************************************************************** 01540IPMMST2 PM 01550I 1 100PMPN 01560I* 15 180PMPL 01570I 19 30 PMMODL 01580I 31 59 PMDESC 01590I* 70 71 PMECHG 01600I 94 95 PMSC 01610I 97 98 PMISSU 01620I* ON HAND BAL 01630I P 311 3140PMOHB 01640I* REL REQS 7P 01650I* P 323 3260PMRLB 01660I* PURCH REQ BAL 7P 01670I* P 339 3420PMPRB 01680I* PO BAL 01690I* P 343 3460PMPOB 01700I* PLAN REQMT BAL 01710I* P 319 3220PMALB 01720I* FAB CODE 2A 01730I 487 488 PMFAB 01740I 674 674 PMSTAT 01750C******************************************************************** ÐÐ01760C* 1-TIME INITIALIZE. 01770C EXSR SR101 INIT. 01780C MOVE ' ' PREFIX 1 STUPIDITY 01790C MOVE ' ' BLK6 6 SAME 01800C*------------------------------------------------------------------- 01810C RETURN TAG 01820C EXSR SR70 NEW PAGE 01830C*------------------------------------------------------------------- 01840C START TAG 01850C* REQUEST WORK-ORDER PRIME. 01860C Z-ADD0 WOPN 01870C MOVE BLK35 WODESC 01880C MOVE BLK35 WOMODL 01890C MOVE ' ' WOFAB 01900C SETOF 7879 01910C SETOF 6968 PROD WO FLAG 01920C Z-ADD516 M 50 01930C EXSR SR74 PROMPT/READ 01940C 92 GOTO START ESC BKWD 01950C N77 GOTO TAG20 NO INPUT 01960C*------------------------------------------------------------------- 01970C TAG5 TAG 01980C SETOF 6840 01990C EXSR SR210 BUILD WO # 02000C PREFIX LOKUPTABPWO 69 PROD WO FLAG ÐÐ02010C*------------------------------------------------------------------- 02020C TAG20 TAG 02030C* GET WO WOMAST/PMMST2/BOMAST. 02040C Z-ADD0 WOQTYS 02050C Z-ADD0 WOQTYC 02060C Z-ADD0 WOQTYS 02070C TWO CHAINWOMAST 68 02080C N68 WOSTAT COMP 'D' 68 02090C N68 WOCLOS COMP 0 68 02100C N68 WOQTYS SUB WOQTYC WOBAL 70 54 02110C N68N54 Z-ADD0 WOBAL 02120C*------------------------------------------------------------------- 02130C TAG30 TAG 02140C 69 MOVELWOPN W12A 12 02150C 69 EXSR SR81 GET PMMST2 02160C 69 68 EXSR SR103 SAVE WO DATA 02170C SETOF 787940 02180C*------------------------------------------------------------------- 02190C TAG35 TAG 02200C* CHASE WOPULL ORDER KEYS AND GET REQUIREMENTS. 02210C MOVELTWO W19A 19 02220C MOVE BLK10 W19A 02230C W19A SETLLWOPULL 02240C*------------------------------------------------------------------- 02250C TAG40 TAG ÐÐ02260C* GET NEXT WOPULL RECORD. 02270C SETOF 54 02280C READ WOPULL 54 GET WOPULL 02290C 54 GOTO TAG70 END OF FILE 02300C WPWO COMP TWO 54 02310C N54 GOTO TAG70 END OF FILE 02320C WPSTAT COMP 'D' 54 02330C 54 GOTO TAG40 DELETED RECORD 02340C WPQTYR SUB WPQTYC QTYBAL 70 54 02350C N54 GOTO TAG40 INACTIVE 02360C MOVELWPCPN W12A 02370C EXSR SR81 GET PMMST2 02380C 60 GOTO TAG40 NO PMMST ON FILE 02390C N40 EXSR SR71 PUT HEADING 02400C SETON 72 02410C EXCPT DISPLAY 02420C SETOF 72 02430C SETON 40 02440C 1 ADD COUNT COUNT 02450C N50 COUNT COMP 28 54 54 02460C 50 COUNT COMP 23 54 54 02470C N54 GOTO TAG40 02480C EXSR SR76 END PAGE MSG 02490C 92 GOTO NEWITM 02500C EXSR SR71 PUT HEADING ÐÐ02510C 77 EXSR SR210 BUILD WO 02520C 77 GOTO TAG35 02530C GOTO TAG40 02540C*------------------------------------------------------------------- 02550C TAG70 TAG 02560C W19A SETLLBOMAST 02570C MOVE BLK35 LASTBO 02580C*------------------------------------------------------------------- 02590C TAG75 TAG 02600C SETOF 54 02610C READ BOMAST 54 02620C 54 GOTO TAG90 02630C BOKEY COMP LASTBO 54 02640C N54 GOTO TAG90 02650C MOVE BOKEY LASTBO 19 02660C BOWO COMP TWO 54 02670C N54 GOTO TAG90 02680C BOSTAT COMP 'D' 54 02690C 54 GOTO TAG75 02700C BOQTYR SUB BOQTYC QTYBAL 54 02710C N54 GOTO TAG75 02720C N40 EXSR SR71 PUT HEADING 02730C SETON 74 02740C EXCPT PUT COMPONENT 02750C SETOF 74 ÐÐ02760C SETON 40 02770C 1 ADD COUNT COUNT 02780C N50 COUNT COMP 28 54 54 02790C 50 COUNT COMP 23 54 54 02800C N54 GOTO TAG75 02810C EXSR SR76 END PAGE 02820C 92 GOTO NEWITM 02830C EXSR SR71 02840C GOTO TAG75 02850C*------------------------------------------------------------------- 02860C TAG90 TAG 02870C 1 ADD COUNT COUNT 02880C SETON 70 02890C EXCPT END REQMTS MSG 02900C SETOF 70 02910C EXSR SR75 READ CRT 02920C 92 GOTO NEWITM ESC 02930C 77 EXSR SR210 BUILD WO # 02940C 77 MOVELTWO W19A 02950C 77 GOTO TAG20 NEW WO INPUT 02960C GOTO RETURN 02970C*------------------------------------------------------------------- 02980C NEWITM TAG 02990C* SET-UP LINK FOR NEW ITEM 03000C MOVEL'Q016WO 'PROG 8 ÐÐ03010C GOTO END 03020C*------------------------------------------------------------------- 03030C MENU TAG 03040C* SET-UP LINK TO MENU 03050C EXSR SR96 GET CRTFILE 03060C Z-ADD1 W 03070C BLK6 LOKUPLNK,W 54 03080C 54 MOVELLNK,W PROG 8 03090C 54 MOVE BLK6 LNK,W 03100C N54 MOVEL'CONTU 'PROG 03110C EXSR SR97 UPDATE CRTFILE 03120C EXSR SR98 >>>>>>>>>> 03130C*------------------------------------------------------------------- 03140C GOODBY TAG 03150C* LINK TO SIGN-OFF 03160C MOVEL'GOODBY 'PROG 03170C*------------------------------------------------------------------- 03180C END TAG 03190C EXSR SR96 GET CRTFILE 03200C EXSR SR97 UPDATE CRTFILE 03210C EXSR SR98 >>>>>>>>>> 03220C*------------------------------------------------------------------- 03230C ENDJOB TAG 03240C MOVE 'ENDJOB 'PROG 03250C EXSR SR98 >>>>>>>>>> ÐÐ03260C******************************************************************** 03270CSR SR69 BEGSR 03280CSR 50 EXITFZPUTXY MOVE CURSOR 03290CSR RLABL RPGLIN 03300CSR RLABL RPGCOL 03310CSRN50 EXITFZMOVXY MOVE CURSOR 03320CSR RLABL RPGLIN 03330CSR RLABL RPGCOL 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR70 BEGSR 03370CSR 50 EXITFZESCH CLEAR CRT 03380CSRN50 EXITFZCPAGE CLEAR PAGE-4 03390CSR Z-ADD1 COUNT 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR71 BEGSR 03430C* PUT HEADINGS. 03440CSR EXSR SR70 NEW PAGE 03450CSR SETON 71 03460CSR EXCPT PUT HEADING 03470CSR SETOF 71 03480CSR Z-ADD12 COUNT 30 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR73 BEGSR 03520C* PUT MESSAGE TO CRT 03530CSR M CHAINMGFILE 54 03540CSR 54 MOVE BLK35 MGTEXT 03550CSR 54 MOVEL'??????' MGTEXT 03560CSR 1 ADD COUNT COUNT 03570CSRN50 91 ADD COUNT W3N 30 03580CSR 50 Z-ADDCOUNT W3N 03590CSR MOVELW3N RPGLIN 4 03600CSR MOVEL'001' RPGCOL 4 03610CSR EXSR SR69 MOVE CURSOR 03620CSR SETON 73 03630CSR EXCPT PUT MSG 03640CSR SETOF 73 03650CSR ENDSR 03660C********************************************************************* 03670CSR SR74 BEGSR 03680C* PROMPT/READ. 03690CSR EXSR SR73 PROMPT 03700CSR EXSR SR75 READ CRT 03710CSR ENDSR 03720C******************************************************************** 03730CSR SR75 BEGSR 03740C* READ CRT. 03750CSR SETOF 779092 ÐÐ03760CSR SETOF 939498 03770CSR MOVE BIT,8 BUFLGT 2 03780CSR MOVE BLK35 W14A 14 03790CSR EXITFQBELL RING BELL 03800CSR EXITFQWREED 03810CSR RLABL W14A 03820CSR RLABL BUFLGT 03830CSR MOVEAW14A A14 03840CSR MOVE BLK14 W14A 03850CSR Z-ADD1 W 30 03860CSR '\' LOKUPA14,W 90 03870CSRN90 GOTO T75B 03880CSR 1 ADD W W 03890CSR W COMP 14 54 03900CSR 54 GOTO T75A 03910CSR A14,W COMP 'B' 92 03920CSR A14,W COMP 'N' 93 03930CSR A14,W COMP 'E' 94 03940CSR A14,W COMP 'G' 98 03950CSR 92 GOTO END75 03960CSR 93 GOTO NEWITM 03970CSR 94 GOTO MENU 03980CSR 98 GOTO GOODBY 03990C*------------------------------------------------------------------- 04000CSR T75A TAG ÐÐ04010CSR Z-ADDM W5N 50 04020CSR Z-ADD318 M 04030CSR EXSR SR73 04040CSR Z-ADDW5N M 04050CSR GOTO SR75 04060C*------------------------------------------------------------------- 04070CSR T75B TAG 04080CSR Z-ADD1 W 04090CSR ' ' LOKUPA14,W 77 04100CSR 77 MOVEAA14,W W14A 04110CSR END75 ENDSR 04120C******************************************************************** 04130CSR SR76 BEGSR 04140C* END PAGE MSG 04150CSR 1 ADD COUNT COUNT 04160CSRN50 91 ADD COUNT W3N 30 04170CSR 50 Z-ADDCOUNT W3N 04180CSR MOVELW3N RPGLIN 4 04190CSR MOVEL'001' RPGCOL 4 04200CSR EXSR SR69 MOVE CURSOR 04210CSR SETON 76 04220CSR EXCPT PUT MSG 04230CSR SETOF 76 04240CSR ENDSR 04250C******************************************************************** ÐÐ04260CSR SR81 BEGSR 04270C* GET PART MAST. 04280CSR MOVE ' ' W12A 04290CSR W12A CHAINPMMST2 60 04300CSRN60 PMSTAT COMP 'D' 60 04310CSR ENDSR 04320C******************************************************************** 04330CSR SR96 BEGSR 04340CSR # CHAINCRTFILE H9 GET CRTFILE 04350CSR H9 GOTO ENDJOB 04360CSR ENDSR 04370C******************************************************************** 04380CSR SR97 BEGSR 04390CSR TIME CRTIME 04400CSR MOVELUDATE CRDATE 04410CSR SETON 97 04420CSR EXCPT UPDATE CRTFILE 04430CSR SETOF 97 04440CSR ENDSR 04450C******************************************************************** 04460CSR SR98 BEGSR 04470CSR EXSR SR70 CLEAR SCREEN 04480CSR EXITFCHAIN >>>>>>>>>> 04490CSR RLABL PROG 04500CSR ENDSR ÐÐ04510C******************************************************************** 04520CSR SR101 BEGSR 04530C* 1-TIME INIT. 04540CSR MOVE BIT,1 NUL 04550CSR MOVELBIT,1 BUFLGT 2 04560CSR MOVE ' ' BLK35 35 04570CSR MOVE ' ' BLK10 10 04580CSR MOVE ' ' BLK14 14 04590CSR MOVE ' ' BLK6 6 04600CSR MOVE ' ' W2A 2 04610CSR EXITFZGMINX 04620CSR RLABL W2A 04630CSR MOVE W2A # 20 04640CSR # COMP 0 54 04650CSRN54 Z-ADD25 # 04660CSR EXSR SR96 GET CRTFILE 04670CSR MOVE CALL LNK 04680CSR MOVE 'Q016WO 'PROG 04690CSR PAR,# COMP '1' 50 04700CSR TST,# COMP 'S' 54 04710CSRN54 CRSHUT COMP 'S' 54 04720CSR 54 MOVE 'S' CRSHUT 04730CSR 54 MOVE 'SHUTDOWN'PROG 04740CSR EXSR SR97 UPDATE CRTFILE 04750CSR 54 EXSR SR98 >>>>>>>>>> ÐÐ04760CSR ENDSR 04770C******************************************************************** 04780CSR SR102 BEGSR 04790C* RIGHT ADJUST. 04800CSR Z-ADD14 W2N 20 04810CSR EXIT SUBRAJ 04820CSR RLABL W2N 04830CSR RLABL W14A 04840CSR ENDSR 04850C******************************************************************** 04860CSR SR103 BEGSR 04870C* SAVE WORK ORDER DATA. 04880CSR MOVELPMDESC WODESC 04890CSR MOVE PMMODL WOMODL 04900CSR MOVE PMFAB WOFAB 04910CSR ENDSR 04920C******************************************************************** 04930CSR SR210 BEGSR 04940C* BUILD WO #. 04950CSR MOVEAW14A A14 04960CSR Z-ADD1 W 04970CSR '-' LOKUPA14,W 54 04980CSRN54 Z-ADD7 W 04990CSR MOVE ' ' W4A 4 05000CSR MOVEAA14,W W4A ÐÐ05010CSR MOVEL' ' W4A 05020CSR Z-ADD4 W2N 05030CSR EXIT SUBRAJ R.J. 05040CSR RLABL W2N 05050CSR RLABL W4A 05060CSR MOVE W4A TWOD 30 WO-DASH 05070CSR MOVEABLK14 A14,W 05080CSR Z-ADD1 W 05090CSR ' ' LOKUPA14,W 54 05100CSRN54 Z-ADD1 W 05110CSR A14,W COMP '0' 54 54 05120CSR 54 MOVEAA14,W W5A 5 05130CSR 54 MOVEL' ' TWOP 6 WO-PRIME 05140CSRN54 MOVEAA14,W TWOP 05150CSRN54 MOVE TWOP W5A 05160CSR Z-ADD5 W2N 05170CSR EXIT SUBRAJ R.J. 05180CSR RLABL W2N 05190CSR RLABL W5A 05200CSR MOVE W5A TWOP 05210CSR MOVELTWOP TWO 9 WO # 05220CSR MOVE TWOD TWO 05230CSR MOVELTWOP PREFIX 1 WO-PREFIX 05240CSR ENDSR 05250O******************************************************************** ÐÐ05260OTERM132 E 71 05270O BIT,28 1 05280O N50 8 '8091001' 05290O 50 5 '[001' 05300O 50 BIT,28 6 05310O 50 10 ']001' 05320O UDATE 18 ' - - ' 05330O 55 'D I S P L A Y' 05340O 65 'W O R K' 05350O 77 'O R D E R' 05360O 103 'R E Q U I R E M E N T S' 05370O*------------------------------------------------------------------- 05380O E 71 05390O 1 ' ' 05400O*------------------------------------------------------------------- 05410O E 71 05420O 4 'WORK' 05430O 19 'ASSY' 05440O 78 'FAB' 05450O 88 'SCHEDULE' 05460O 100 'IN-WORK' 05470O*------------------------------------------------------------------- 05480O E 71 05490O 5 'ORDER' 05500O 22 'PART-NO.' ÐÐ05510O 42 'DESCRIPTION' 05520O 67 'MODEL' 05530O 79 'CODE' 05540O 88 'QUANTITY' 05550O 101 'QUANTITY' 05560O*------------------------------------------------------------------- 05570O E 71 05580O 1 ' ' 05590O*------------------------------------------------------------------- 05600O E 71 05610O TWOP 6 05620O 7 '-' 05630O TWOD 10 05640O 69N68 WOPN 24 ' - - ' 05650O WODESC 60 05660O WOMODL 74 05670O PMFAB 78 05680O WOBAL 2 101 05690O WOQTYS2 88 05700O 68 60 'WORK ORDER NOT ON FILE' 05710O*------------------------------------------------------------------- 05720O E 71 05730O 1 ' ' 05740O*------------------------------------------------------------------- 05750O E 71 ÐÐ05760O 72 'C O M P O N E N T S' 05770O*------------------------------------------------------------------- 05780O E 71 05790O 1 ' ' 05800O*------------------------------------------------------------------- 05810O E 71 05820O 61 'SOURCE' 05830O 68 'ISSUE' 05840O 75 'FAB' 05850O 82 'QTY' 05860O 92 'QTY' 05870O 102 'DATE' 05880O 113 'ON-HAND' 05890O* * * * * 121 'AVAIL' 05900O* * * * * 132 'AVAIL' 05910O*------------------------------------------------------------------- 05920O E 71 05930O 8 'PART-NO.' 05940O 25 'DESCRIPTION' 05950O 51 'STATUS' 05960O 60 'CODE' 05970O 67 'CODE' 05980O 75 'CODE' 05990O 85 'PER-ASSY' 06000O 93 'REQD' ÐÐ06010O 101 'DUE' 06020O 113 'BALANCE' 06030O* * * * * 121 'STOCK' 06040O* * * * * 131 'BAL' 06050O*------------------------------------------------------------------- 06060O E 71 06070O 1 ' ' 06080O*------------------------------------------------------------------- 06090O E 72 06100O PMPN 12 ' - - ' 06110O PMDESC 43 06120O 53 'KIT PULL ' 06130O PMSC 60 06140O PMISSU 67 06150O PMFAB 75 06160O WPQPA J 85 06170O QTYBAL2 93 06180O WOSTRT 103 ' - - ' 06190O* * * * * SFAVQ J 132 06200O* * * * * SFSAVQJ 123 06210O PMOHB J 113 06220O*------------------------------------------------------------------- 06230O E 74 06240O PMPN 12 ' - - ' 06250O PMDESC 43 ÐÐ06260O 53 'BACKORDER' 06270O PMSC 60 06280O PMISSU 67 06290O PMFAB 75 06300O BOQPA 2 85 06310O QTYBAL2 93 06320O BODUE 103 ' - - ' 06330O PMOHB J 113 06340O*------------------------------------------------------------------- 06350O E 73 06360O NUL 132 06370O MGTEXT 35 06380O 37 ' ' 06390O*------------------------------------------------------------------- 06400O E 70 06410O NUL 132 06420O 24 'END OF REQUIREMENTS.....' 06430O 48 'ENTER RETURN, NEW WORK O' 06440O 72 'RDER #, OR \ESC CODE....' 06450O*------------------------------------------------------------------- 06460O E 76 06470O NUL 132 06480O 114 'END OF PAGE...' 06490O 40 'ENTER RETURN, NEW WORK O' 06500O 64 'RD #, OR \ESC CODE......' ÐÐ** NUL ARRAY 006510 006520** A14 ARRAY 006530 006540** A29 ARRAY 006550 006560** LNK ARRAY 006570 06580/* 06590_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( @Þ X014DP P120282120282(èÈÐ00010H Q014DP00020F* WRITE SHUTDOWN FLAG TO CRTFILE. (X014DP) 00030FCRTFILE UP F 256 DISK 00040ICRTFILE CR 01 00050I 27 27 CRSHUT 00060OCRTFILE D 01 00070O 27 'S' /* 000080_‚ _‚_‚ ÐÈ(#@ä #X014GL P120282120282(èÈÐ00010H Q014GL00020F* CREATE SOURCE CODE, OPER CODE, BAL FRWD CODES. (X014GL) 00030F* REVISED 7/27/81 5:00 PM. 00040FGLMAST UP F 165 9AI 1 DISK 00050FCAMAST US F 40 18AI 1 DISK 00060I******************************************************************** 00070IGLMAST GL 01 00080I 148 148 GLSC 00090I 149 150 GLBFC 00100I P 157 1590GLNOSA 00110I******************************************************************** 00120ICAMAST CA 02 00130I 25 25 CAOPER 00140C******************************************************************** 00150C 01 GLNOSA COMP 0 54 00160C 01 54 MOVE ' ' GLSC 00170C 01N54 MOVE 'S' GLSC 00180C 01 MOVE '1A' GLBFC 00190C 02 MOVE 'A' CAOPER 00200O******************************************************************** 00210OGLMAST D 01 00220O GLSC 148 00230O GLBFC 150 00240O GLNOSA 159P 00250O******************************************************************** ÐÐ00260OCAMAST D 02 00270O CAOPER 25 /* 000280_‚ _‚_‚0I******************************************************************** 00120ICAMAST CA 02 00130I 25 25 CAOPER 00140C******************************************************************** 00150C 01 GLNOSA COMP 0 54 00160C 01 54 MOVE ' ' GLSC 00170C 01N54 MOVE 'S' GLSC 00180C 01 MOVE '1A' GLBFC 00190C 02 MOVE 'A' CAOPER 00200O******************************************************************** 00210OGLMAST D 01 00220O GLSC 148 00230O GLBFC 150 00240O GLNOSA 159P 00250O******************************************************************** ÐÈ(Ü7p ÜqX036WO P02d999999120282(èÈÐ00010H Q036WO00020F* DISPLAY CUMULATIVE WORK HOURS FOR EMPLOYEE (X036WO) 00030F* REVISED 12-03-82 4:00 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FDLMAST ID F 850L12AI 1 DISK 00090FEMMAST IC F 1536R 5AI 1 DISK 00100FWCMAST IC F 960R 8AI 1 DISK 00110FCALENDARID F 22L 7AI 1 DISK 00120FTERM132 O F 132 5 00130F**************************************************************** 00140E NUL 1 132 1 NULL CHAR 00150E A10 10 10 1 A INPUT DATA ARRAY 00160E A39 39 39 1 MGTEXT ARRAY 00170E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00180E DUN 1 2 1 A EDIT CMPLT FLAG 00190E MES 1 1 30 00200E LNK 1 7 6 A 00210E MAN 45 45 1 EMPLOYEE NAME 00220E DAT 1 14 4 0 HEADING DATE 00230E DAY 1 14 3 HEADING DAY NAME 00240E AH 1 14 3 1 ASSIGNED HRS 00250E RH 1 14 3 1A REGULAR HRS ÐÐ00260E OT 1 14 3 1 OVERTIME HRS 00270E VH 1 14 3 1 VACATION HRS 00280E SL 1 14 3 1 SICK LEAVE 00290E PH 1 14 3 1 PAID HOLIDAY 00300E NP 1 14 3 1 NON-PAID HOL 00310E LA 1 14 3 1 LEAVE OF ABSENCE 00320E AB 1 14 3 1 ABSENT 00330E V$$ 1 14 5 2 VOUCHER AMT 00340E RMT 1 8 4 1 RIGHT MARGIN TOTALS 00350E BL1 1 14 4 1 BOT TOTALS, LEVEL 1 00360E CP 1 14 3 1 CALCULATED PREMIUM 00370E BL2 1 14 4 1 BOT TOTALS, LEVEL 2 00380E DOW 14 14 1 0 DAY OF WEEK 00390E NAM 1 7 3 DAY NAMES 00400E CA 1 14 3 1A CALC. ABSENT 00410E WK 1 14 3 1A WORK ARRAY 00420E BIT 33 1 00430E PAR 25 1 00440E TST 25 1 00450E CALL 7 6 CALL STACK 00460E DLP 20 8 0A HOME DEPT 00470E DL$ 20 9 3 PAY RATE 00480E DLC 20 1 INPUT CODE 00490E DLW 20 9 WORK ORDERS 00500E DLS 20 3 0 OPER SEQ NO. ÐÐ00510E DLD 20 8 0 DEPT WORKED 00520E DLH 20 3 1 HOURS WORKED 00530E DLR 20 2 REWORK CODES 00540E DLV 20 7 2 VOUCHER $ 00550E HPD 7 3 1 HOURS PER DAY 00560E EMJ 5 1 JOB STATUS 00570E* 00580I******************************************************************* 00590IBITPAR BT 00600I 1 33 BIT 00610I 34 58 PAR 00620I 59 83 TST 00630I******************************************************************* 00640IMGFILE MG 00650I* MESSAGE FILE. 00660I 1 35 MGTEXT 00670I****************************************************************** 00680ICRTFILE CR 00690I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00700I* EMPLOYEE # 5N 00710I* 1 50CREMPL 00720I* USER CODE 8A 00730I* 6 13 CRUSER 00740I* DEPT # 5N 00750I* 14 180CRDEPT ÐÐ00760I* JOB NAME 8A (JOB LOADED BY MENU) 00770I* 19 26 CRJOB 00780I* SHUTDOWN FLAG 1A 00790I* BLANK = NO SHUTDOWN 00800I 27 27 CRSHUT 00810I* TIME STARTED 6N 00820I 28 330CRTIME 00830I* DATE STARTED 4N 00840I 34 370CRDATE 00850I* CALL STACK 7 X 6A 00860I 38 79 CALL 00870I******************************************************************** 00880IDLMAST DL 00890I* EMPLOYEE TIME CARD RECORD 00900I 1 12 DLKEY 00910I* CLOCK NUMBER. 00920I 1 50DLCLOK 00930I* DATE WORKED 6N 00940I 6 110DLDATE 00950I* RECORD NO. 1N 00960I 12 120DLREC 00970I* TOTAL HRS WORKED 3.1P 00980I P 13 141DLTHRS 00990I* TIME-AND-ONE-HALF HRS 3.1P 01000I P 15 161DLHHRS ÐÐ01010I* DOUBLE-TIME HRS 3.1P 01020I P 17 181DLDHRS 01030I* HOME DEPT 8N X 20 01040I 19 178 DLP 01050I* PAY RATE 9.3P X 20 01060I P 179 278 DL$ 01070I* INPUT CODE 1A X 20 01080I* BLANK = JOB # INPUT 01090I* A = ABSENT 01100I* H = HOLIDAY - PAID 01110I* N = HOLIDAY - NOT PAID 01120I* L = LEAVE OF ABSENCE 01130I* S = SICK LEAVE 01140I* V = VACATION 01150I 279 298 DLC 01160I* WORK ORDER 9A X 20 01170I 299 478 DLW 01180I* OPER SEQ CODE (ROUTING) 3P X 20 01190I P 479 518 DLS 01200I* DEPARTMENT WORKED 8N X 20 01210I 519 678 DLD 01220I* HOURS WORKED 3.1P X 20 01230I P 679 718 DLH 01240I* REWORK CODE 2A X 20 01250I 719 758 DLR ÐÐ01260I* VOUCHER AMOUNT 7.2P X 20 01270I P 759 838 DLV 01280I* RECORD STATUS 1A 01290I 850 850 DLSTAT 01300I****************************************************************** 01310IEMMAST EM 01320I* EMPLOYEE MASTER 01330I 7 31 EMFNAM 01340I 32 56 EMMNAM 01350I 57 86 EMLNAM 01360I P 336 3380EMDEPT 01370I P 339 3400EMWC 01380I 370 374 EMJ 01390I P 375 3793EMRATE 01400I 380 380 EMPU 01410I P 383 396 HPD 01420I 510 5150EMDATT 01430I 15361536 EMSTAT 01440I******************************************************************** 01450IWCMAST WC 01460I 9 37 WCNAME 01470I******************************************************************* 01480ICALENDARCA 01490I* CALENDAR FILE 01500I 1 7 CAKEY ÐÐ01510I 2 70CADATE 01520I 22 220CADOW 01530C******************************************************************** 01540C* NOTE: INDICATORS 50 = DATAGRAPHIX 132-1 CRT 01550C* INITIALIZE 01560C EXSR SR101 1-TIME INIT 01570C MOVE ' ' BLK6 6 STUPIDITY 01580C MOVE ' ' BLK9 9 " " 01590C*------------------------------------------------------------------ 01600C START TAG 01610C* SET-UP 1ST FIELD NO. 01620C EXSR SR66 INIT A39 01630C Z-ADD0 TCLOK 50 01640C Z-ADD0 TDATE 60 01650C Z-ADD0 TREC 10 01660C MOVE 'X' DUN INIT EDIT ARRAY 01670C MOVEA' ' DUN,1 01680C Z-ADD1 F 30 FIELD # 01690C EXSR SR205 INIT MAST 01700C Z-ADD0 TCLOK 01710C MOVE ' ' MAN 01720C Z-ADD0 EMDEPT 01730C Z-ADD0 EMWC 01740C MOVE BLK35 WCNAME 01750C MOVE ' ' DAY ÐÐ01760C Z-ADD0 DAT 01770C Z-ADD0 AH 01780C Z-ADD0 DOW 01790C EXSR SR70 CLEAR SCREEN 01800C GOTO READ 01810C*--------------------------------------------------------------- 01820C NEXT TAG 01830C 1 ADD F F 01840C*----------------------------------------------------------------- 01850C READ TAG 01860C* READ DATA FROM TERMINAL. 01870C SETOF 909677 01880C F COMP 0 54 01890C N54 Z-ADD1 F 01900C F COMP FLIMIT 54 01910C 54 GOTO UPDATE 01920C EXSR SR201 IDENTIFY-F 01930C SETON 69 01940C EXSR SR72 PROMPT 01950C SETOF 69 01960C EXSR SR75 READ TERMINAL 01970C 96 GOTO ERROR ERROR 01980C 86 GOTO UPDATE 01990C 77 EXSR SR103 MOVE DATA 02000C*------------------------------------------------------------------- ÐÐ02010C EDIT TAG 02020C EXSR SR104 EDIT DATA 02030C EXSR SR72 REWRITE DATA 02040C 96 GOTO ERROR ERROR 02050C GOTO NEXT 02060C*----------------------------------------------------------------- 02070C UPDATE TAG 02080C* DISPLAY HOURS 02090C EXSR SR105 FINAL EDIT 02100C 96 GOTO ERROR ERROR 02110C EXSR SR106 DISPLAY HRS 02120C GOTO START 02130C*-------------------------------------------------------------------- 02140C ERROR TAG 02150C EXSR SR201 VALIDATE FIELD # 02160C EXSR SR89 GET MSG 02170C* * * * * EXSR SR73 PUT MSG 02180C GOTO READ 02190C*------------------------------------------------------------------ 02200C NEWITM TAG 02210C MOVEL'Q036WO' PROG 02220C GOTO END 02230C*------------------------------------------------------------------- 02240C MENU TAG 02250C* SET-UP LINK TO MENU ÐÐ02260C EXSR SR96 GET CRTFILE 02270C Z-ADD1 W 02280C BLK6 LOKUPLNK,W 54 02290C 54 MOVELLNK,W PROG 8 02300C 54 MOVE BLK6 LNK,W 02310C N54 MOVEL'CONTU 'PROG 02320C EXSR SR97 UPDATE CRTFILE 02330C EXSR SR98 >>>>>>>>>>>>> 02340C*-------------------------------------------------------------------- 02350C GOODBY TAG 02360C* LINK TO SIGN-OFF 02370C MOVEL'GOODBY' PROG 02380C*---------------------------------------------------------------- 02390C END TAG 02400C EXSR SR96 GET CRTFILE 02410C EXSR SR97 REWRITE CRTFILE 02420C EXSR SR98 >>>>>>>>>>> 02430C*------------------------------------------------------------------- 02440C ENDJOB TAG 02450C MOVEL'ENDJOB' PROG 02460C EXSR SR98 >>>>>>>>>>>>>>>> 02470C********************************************************************* 02480CSR SR1 BEGSR 02490C* EDIT CLOCK NO. 02500CSR TCLOK COMP 0 54 ÐÐ02510CSRN54 Z-ADD400 M 50 96 FLAG ERROR 02520CSRN54 GOTO END1 02530CSR EXSR SR85 GET EMMAST 02540CSR 60 Z-ADD699 M 50 96 FLAG ERROR 02550CSR 60 GOTO END1 02560CSR EXSR SR107 02570CSR MOVELEMDEPT W8A 8 02580CSR MOVE EMWC W8A 02590CSR W8A CHAINWCMAST 54 02600CSR 54 MOVE BLK35 WCNAME 02610CSR END1 ENDSR 02620C********************************************************************* 02630CSR SR2 BEGSR 02640C* EDIT DATE 02650CSR MOVELTDATE W2N 02660CSR W2N COMP 12 54 02670CSRN54 MOVELTDATE W4N 02680CSRN54 MOVE TDATE W2N 02690CSRN54 MOVELW2N TDATE 02700CSRN54 MOVE W4N TDATE 02710CSR ENDSR 02720C********************************************************************** 02730CSR SR61 BEGSR 02740CSR SETOF 404142 02750CSR SETOF 434445 ÐÐ02760CSR SETOF 46 02770CSR ENDSR 02780C********************************************************************* 02790CSR SR62 BEGSR 02800CSR EXITFZDIM SET DIM 02810CSR ENDSR 02820C****************************************************************** 02830CSR SR63 BEGSR 02840CSR EXITFZBRITE SET BRIGHT 02850CSR ENDSR 02860C****************************************************************** 02870CSR SR64 BEGSR 02880C* PUT DIM DATA 02890CSR EXSR SR62 SET DIM 02900CSR EXCPT PUT 02910CSR EXSR SR61 SETOFFS 02920CSR ENDSR 02930C****************************************************************** 02940CSR SR65 BEGSR 02950C* PUT BRITE DATA 02960CSR EXSR SR63 SET BRITE 02970CSR EXCPT PUT 02980CSR EXSR SR61 SETOFFS 02990CSR ENDSR 03000C******************************************************************** ÐÐ03010CSR SR66 BEGSR 03020CSR MOVEABLK35 A39,3 INIT A39 03030CSR ENDSR 03040C******************************************************************** 03050CSR SR67 BEGSR 03060CSR EXITFZCR 03070CSR ENDSR 03080C***************************************************************** 03090CSR SR68 BEGSR 03100CSR EXITFZLF LINE FEED 03110CSR ENDSR 03120C**************************************************************** 03130CSR SR69 BEGSR 03140CSR 50 EXITFZPUTXY MOVE CURSOR 03150CSR RLABL RPGLIN 03160CSR RLABL RPGCOL 03170CSRN50 EXITFZMOVXY MOVE CURSOR 03180CSR RLABL RPGLIN 03190CSR RLABL RPGCOL 03200CSR ENDSR 03210C***************************************************************** 03220CSR SR70 BEGSR 03230C* CLEAR TERM SCREEN. 03240CSR 50 EXITFZISTAT INIT STATUS LINE 03250CSR 50 EXITFZESCH CLEAR SCREEN ÐÐ03260CSRN50 EXITFZCPAGE CLEAR SCREEN 03270CSRN50 MOVEL'091' RPGLIN 03280CSRN50 MOVEL'001' RPGCOL 03290CSRN50 EXSR SR69 MOVE CURSOR 03300CSR ENDSR 03310C********************************************************************** 03320CSR SR71 BEGSR 03330C* PUT HEADINGS TO TERMINAL 03340CSR 'X' DEBUGPRINT X 03350CSR 'W' DEBUGPRINT W 03360CSR 'F' DEBUGPRINT F 03370CSR 'A' DEBUGPRINT A 03380CSR 'H' DEBUGPRINT H 03390CSR 'B' DEBUGPRINT B 03400CSR EXSR SR70 NEW PAGE 03410CSR SETON 71 03420CSR EXCPT PUT HEADINGS 03430CSR SETOF 71 03440CSR SETON 40 03450CSR EXSR SR64 PUT ASSIGN HRS-DIM 03460CSR SETON 41 03470CSR EXSR SR65 PUT REAL HRS-BRITE 03480CSR SETON 42 03490CSR EXSR SR64 PUT NP HOLIDAY-DIM 03500CSR SETON 43 ÐÐ03510CSR EXSR SR65 PUT LOA-BRITE 03520CSR SETON 44 03530CSR EXSR SR64 PUT $$-DIM 03540CSR SETON 45 03550CSR EXSR SR65 PUT INPUT OT-BRITE 03560CSR SETON 46 03570CSR EXSR SR65 PUT GRAND TOT-BRITE 03580CSR EXSR SR63 SET BRITE 03590CSR ENDSR 03600C********************************************************************* 03610CSR SR72 BEGSR 03620C* PUT DATA TO TERMINAL 03630CSR EMWC COMP 0 55 03640CSR 01 Z-ADD1 W3N 30 03650CSR 02 Z-ADD2 W3N 03660CSRN50 90 ADD W3N W3N 03670CSR MOVELW3N RPGLIN 4 03680CSR MOVEL'001' RPGCOL 4 03690CSR EXSR SR69 MOVE CURSOR 03700CSR SETON 72 03710CSR EXCPT PUT DATA 03720CSR SETOF 72 03730CSR ENDSR 03740C******************************************************************* 03750CSR SR75 BEGSR ÐÐ03760C* READ FROM TERMINAL 03770CSR SETOF 779096 03780CSR SETOF 9386 03790CSR EXSR SR66 INIT A39 03800CSR MOVE BLK10 W10A 10 BUFFER 03810CSR 01 Z-ADD2 W3N 03820CSR 02 Z-ADD3 W3N 03830CSRN50 90 ADD W3N W3N 03840CSR MOVELW3N RPGLIN 4 03850CSR MOVEL'019' RPGCOL 4 03860CSR EXSR SR69 MOVE CURSOR 03870CSR EXITFZR10 READ FROM TERMINAL 03880CSR RLABL W10A READ BUFFER 03890CSR MOVEAW10A A10 INPUT DATA ARRAY 03900CSR MOVE BLK10 W10A INIT INPUT ARRAY 03910CSR Z-ADD1 W 30 03920CSR '\' LOKUPA10,W 90 FLAG ESC 03930CSRN90 GOTO T75B NOT ESC 03940CSR 1 ADD W W 03950CSR W COMP 10 54 03960CSR 54 GOTO T75A BAD ESC 03970CSR A10,W COMP 'G' 98 GOODBY 03980CSR A10,W COMP 'E' 94 MENU 03990CSR A10,W COMP 'N' 93 NEW ITEM 04000CSR A10,W COMP 'U' 86 UPDATE ÐÐ04010CSR 98 GOTO GOODBY 04020CSR 94 GOTO MENU 04030CSR 93 GOTO NEWITM 04040CSR 86 GOTO END75 04050C*------------------------------------------------------------------ 04060CSR T75A TAG 04070C* FLAG BAD ESC INPUT 04080CSR Z-ADD318 M 96 FLAG ERROR 04090CSR GOTO END75 04100C*-------------------------------------------------------------------- 04110CSR T75B TAG 04120C* MOVE DATA 04130CSR Z-ADD1 W 04140CSR ' ' LOKUPA10,W 77 04150CSR 77 MOVEAA10,W W10A INPUT DATA 04160C*-------------------------------------------------------------------- 04170CSR END75 TAG 04180C* INIT PREV ERROR MSG. 04190CSR MOVEABLK35 A39,3 04200CSR ENDSR 04210C* 04220C* 04230C* 04240C* 04250C* ÐÐ04260C******************************************************************* 04270CSR SR85 BEGSR 04280CSR TCLOK CHAINEMMAST 60 GET EMPLOYEE MAST 04290CSRN60 EMSTAT COMP 'D' 60 04300CSR ENDSR 04310C********************************************************************** 04320CSR SR89 BEGSR 04330C* GET MESSAGE MASTER 04340CSR M CHAINMGFILE 54 04350CSR 54 MOVE BLK35 MGTEXT 04360CSR 54 MOVELM MGTEXT 04370CSR 54 MOVE MES,1 MGTEXT 04380CSR MOVEAMGTEXT A39,3 04390CSR ENDSR 04400C******************************************************************** 04410CSR SR96 BEGSR 04420CSR # CHAINCRTFILE H9 GET CRTFILE 04430CSR H9 GOTO ENDJOB 04440CSR ENDSR 04450C****************************************************************** 04460CSR SR97 BEGSR 04470C* UPDATE CRTFILE. EXIT PROGRAM. 04480CSR TIME CRTIME 04490CSR MOVELUDATE CRDATE 04500CSR SETON 97 ÐÐ04510CSR EXCPT UPDATE CRTFILE 04520CSR SETOF 97 04530CSR ENDSR 04540C******************************************************************** 04550CSR SR98 BEGSR 04560CSR SETON 51 SUPPRESS HDG FLAG 04570CSR EXSR SR70 CLEAR SCREEN 04580CSR EXITFCHAIN >>>>>>>>>> 04590CSR RLABL PROG 04600CSR ENDSR 04610C******************************************************************** 04620C*R SR99 BEGSR 04630C* STORE THIS PROG AS RETURN TO PROG. 04640C*R EXSR SR96 GET CRTFILE 04650C*R Z-ADD8 W 04660C*------------------------------------------------------------------- 04670C*R T99A TAG 04680C*R W SUB 1 W 54 04690C*RN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 04700C*R LNK,W COMP BLK6 54 04710C*RN54 GOTO T99A 04720C*R MOVELRETURN LNK,W 04730C*R EXSR SR97 UPDATE CRTFILE 04740C*R EXSR SR98 >>>>>>>>>>>>>> 04750C*R END99 ENDSR ÐÐ04760C*********************************************************************** 04770CSR SR101 BEGSR 04780C* 1-TIME INITIALIZE 04790CSR MOVE BIT,1 NUL 04800CSR MOVE ' ' A39 04810CSR MOVE BIT,28 A39,1 04820CSR MOVE 'D' A39,2 04830CSR MOVE BIT,28 A39,38 04840CSR MOVE 'E' A39,39 04850CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS 04860CSR Z-ADDUDATE W6N 60 04870CSR EXSR SR211 REVERSE DATE 04880CSR Z-ADDW6N TODAY 60 04890CSR MOVE '000' DUMWO 9 04900CSR MOVEL' 00000' DUMWO 04910C* GET PORT # AND CRTFILE 04920CSR MOVE ' ' W2A 2 04930CSR EXITFZGMINX GET PORT # 04940CSR RLABL W2A 04950CSR MOVE W2A # 20 PORT NO. 04960CSR # COMP 0 54 04970CSRN54 Z-ADD25 # DEFAULT 04980CSR EXSR SR96 GET CRTFILE 04990CSR MOVE CALL LNK 05000CSR MOVE 'Q036WO 'PROG ÐÐ05010CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 05020CSR TST,# COMP 'S' 56 05030CSRN56 CRSHUT COMP 'S' 56 05040CSR 56 MOVE 'S' CRSHUT SHUTDOWN 05050CSR 56 MOVE 'SHUTDOWN'PROG 05060CSR EXSR SR97 UPDATE CRTFILE 05070CSR 56 EXSR SR98 >>>>>>>>>>>>> 05080CSR MOVE ' 'PROG 05090C* DEFINE WORK FIELDS,ETC. 05100CSR MOVE ' ' BLK35 35 05110CSR MOVE ' ' BLK6 6 05120CSR MOVE ' ' BLK8 8 05130CSR MOVE ' ' BLK9 9 05140CSR MOVE ' ' BLK10 10 05150CSR Z-ADD0 Z3D1 31 05160C* 05170C* 05180CSR ENDSR 05190C******************************************************************** 05200CSR SR103 BEGSR 05210C* MOVE INPUT DATA 05220CSR EXSR SR201 IDENTIFY-F 05230CSR EXSR SR202 R. JUSTIFY 05240CSR 01 MOVE W10A TCLOK 50 CLOCK # 05250CSR 02 MOVE W10A TDATE 60 STARTING DATE ÐÐ05260CSR MOVE ' ' DUN,F 05270CSR ENDSR 05280C******************************************************************** 05290CSR SR104 BEGSR 05300C* EDIT INPUT DATA 05310CSR 01 EXSR SR1 05320CSR 02 EXSR SR2 05330CSR 96 MOVE ' ' DUN,F EDIT FLAG 05340CSRN96 MOVE 'X' DUN,F 05350CSR ENDSR 05360C*********************************************************************** 05370CSR SR105 BEGSR 05380C* FINAL EDIT 05390CSR SETOF 77 05400CSR SETON 79 FINAL EDIT FLAG 05410CSR Z-ADD1 F 96 05420C*-------------------------------------------------------------------- 05430CSR T105A TAG 05440CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05450CSRN54 GOTO END105 05460CSR EXSR SR201 IDENTIFY-F 05470CSR EXSR SR104 EDIT 05480CSRN96 GOTO T105A 05490C*-------------------------------------------------------------------- 05500CSR END105 TAG ÐÐ05510CSR SETOF 79 05520CSR ENDSR 05530C********************************************************************* 05540CSR SR106 BEGSR 05550C* DISPLAY CUMULATIVE HOURS 05560CSR EXSR SR207 SET-UP DATE HEADINGS 05570CSR Z-ADD1 A 30 DATE INDEX 05580CSR MOVELTCLOK W12A 12 05590CSR MOVELTDATE W7A 7 05600CSR MOVE ' ' W7A 05610CSR MOVE W7A W12A 05620CSR W12A SETLLDLMAST 05630CSR MOVE BLK35 LASTDL 12 05640CSR EXSR SR205 INIT CRT OUTPUT FIELD05650C*-------------------------------------------------------------------- 05660CSR T106C TAG 05670CSR SETOF 54 05680CSR READ DLMAST 54 GET DLMAST 05690CSR 54 GOTO T106M END FILE 05700CSR DLKEY COMP LASTDL 54 05710CSRN54 GOTO T106M END FILE 05720CSR MOVE DLKEY LASTDL 05730CSR DLCLOK COMP TCLOK 54 05740CSRN54 GOTO T106M WRONG EMPLOYEE 05750CSR MOVE DLDATE W4N 40 ÐÐ05760CSR Z-ADD1 A 30 05770CSR W4N LOKUPDAT,A 54 GET DATE COL 05780CSRN54 GOTO T106M WRONG DATE 05790CSR DLSTAT COMP 'D' 54 05800CSR 54 GOTO T106C DELETED 05810C* LOAD HOURS 05820CSR Z-ADD0 H 30 05830C*-------------------------------------------------------------------- 05840CSR T106G TAG 05850CSR 1 ADD H H 05860CSR H COMP 20 54 05870CSR 54 GOTO T106C 05880CSR DLH,H COMP 0 54 05890CSR 54 DLV,H COMP 0 54 05900CSR 54 GOTO T106G ZERO ENTRY 05910CSR EXSR SR208 CLASSIFY JOB # 05920CSR 20 DLH,H ADD RH,A RH,A REG HRS 05930CSR 21 DLH,H ADD OT,A OT,A O.T. HRS 05940CSR 22 DLH,H ADD VH,A VH,A VAC. HRS 05950CSR 23 DLH,H ADD SL,A SL,A S/LEAVE 05960CSR 24 DLH,H ADD NP,A NP,A NON-PD HOL 05970CSR 25 DLH,H ADD PH,A PH,A PD HOLIDAY 05980CSR 26 DLH,H ADD LA,A LA,A LEAVE OF ABSENCE 05990CSR 27 DLH,H ADD AB,A AB,A ABSENT 06000CSR DLV,H ADD V$$,A V$$,A VOUCH $ ÐÐ06010CSR GOTO T106G 06020C*-------------------------------------------------------------------- 06030CSR T106M TAG 06040C* CALC TOTALS AND DISPLAY 06050CSR EXSR SR209 CALC TOTALS 06060CSR EXSR SR210 CALC O.T. 06070CSR EXSR SR211 CALC ABSENT 06080CSR EXSR SR212 CALC TOTALS 06090CSR EXSR SR71 DISPLAY 06100CSR Z-ADD1 F 06110CSR EXSR SR201 06120CSR Z-ADD149 M 06130CSR EXSR SR89 06140CSR EXSR SR75 06150CSR END106 ENDSR 06160C********************************************************************* 06170CSR SR107 BEGSR 06180C* BUILD NAME. 06190CSR SETOF 5758 06200CSR MOVE ' ' MAN 06210CSR MOVEAEMFNAM MAN 06220CSR Z-ADD46 X 30 06230C*------------------------------------------------------------------- 06240CSR T107A TAG 06250CSR X SUB 1 X 54 ÐÐ06260CSRN54 GOTO END107 06270CSR MAN,X COMP ' ' 54 06280CSRN54 GOTO T107A 06290CSR 2 ADD X X 06300CSR X COMP 45 54 06310CSR 54 GOTO END107 06320CSRN57 MOVEAEMMNAM MAN,X 06330CSR 57 MOVEAEMLNAM MAN,X 06340CSR 57 SETON 58 06350CSR SETON 57 06360CSRN58 Z-ADD46 X 06370CSRN58 GOTO T107A 06380CSR END107 ENDSR 06390C********************************************************************* 06400CSR SR201 BEGSR 06410C* IDENTIFY-F 06420CSR F COMP 1 01 06430CSR F COMP 2 02 06440CSR ENDSR 06450C********************************************************************** 06460CSR SR202 BEGSR 06470C* RIGHT JUSTIFY 06480CSR F LOKUPNUM 54 06490CSRN54 GOTO END202 NOT NUMERIC FIELD 06500CSR Z-ADD10 W2N 20 ÐÐ06510CSR MOVELW10A W10A 10 06520CSR EXIT SUBRAJ R. JUSTIFY 06530CSR RLABL W2N 06540CSR RLABL W10A 06550CSR END202 ENDSR 06560C* 06570C* 06580C******************************************************************** 06590CSR SR205 BEGSR 06600C* INIT TERM OUTPUT FIELDS 06610CSR Z-ADD0 RH 06620CSR Z-ADD0 OT 06630CSR Z-ADD0 VH 06640CSR Z-ADD0 SL 06650CSR Z-ADD0 PH 06660CSR Z-ADD0 NP 06670CSR Z-ADD0 LA 06680CSR Z-ADD0 AB 06690CSR Z-ADD0 V$$ 06700CSR Z-ADD0 RMT 06710CSR Z-ADD0 BL1 06720CSR Z-ADD0 CP 06730CSR Z-ADD0 CA 06740CSR Z-ADD0 BL2 06750CSR Z-ADD0 DTOT 41 ÐÐ06760CSR Z-ADD0 CTOT 41 06770CSR Z-ADD0 CATOT 41 06780CSR Z-ADD0 TTOT 41 06790CSR Z-ADD0 V$TOT 52 06800CSR Z-ADD0 OVTOT 41 06810CSR ENDSR 06820C********************************************************************* 06830C* 06840C* 06850C* 06860C* 06870C********************************************************************* 06880CSR SR207 BEGSR 06890C* SET-UP DAY NAME 06900CSR Z-ADDTDATE W6N 60 06910CSR MOVE W6N W7A 7 06920CSR MOVEL'C' W7A 06930CSR Z-ADD0 DAT 06940CSR MOVE ' ' DAY 06950CSR Z-ADD0 DOW 06960CSR W7A SETLLCALENDAR 06970CSR Z-ADD1 A 30 06980C*-------------------------------------------------------------------- 06990CSR T207C TAG 07000CSR SETOF 54 ÐÐ07010CSR READ CALENDAR 54 07020CSR 54 GOTO END207 07030CSR CAKEY COMP W7A 54 54 07040CSRN54 GOTO END207 07050CSR MOVE CAKEY W7A 07060CSR Z-ADDCADOW DOW,A 07070CSR Z-ADDCADOW B 30 07080CSR MOVELNAM,B DAY,A 07090CSR MOVE HPD,B AH,A 07100CSR MOVE CADATE DAT,A 07110CSR 1 ADD A A 07120CSR A COMP 7 54 07130CSRN54 GOTO T207C 07140CSR END207 ENDSR 07150C******************************************************************** 07160CSR SR208 BEGSR 07170C* CLASSIFY JOB # 07180CSR SETOF 202122 07190CSR SETOF 232425 07200CSR SETOF 2627 07210CSR Z-ADDEMDEPT W3N 30 07220CSR MOVELW3N W5A 5 07230CSR MOVE '01' W5A 07240CSR MOVE W5A W6A 6 07250CSR MOVEL'Z' W6A ÐÐ07260CSR MOVELDLW,H TWOP 6 07270CSR MOVE DLW,H TWOD 30 07280CSR TWOP COMP W6A 21 O.T. 07290CSR 21 GOTO END208 07300CSR MOVE '04' W6A 07310CSR W6A COMP TWOP 22 VACATION 07320CSR 22 GOTO END208 07330CSR MOVE '03' W6A 07340CSR W6A COMP TWOP 23 SICK LEAVE 07350CSR 23 GOTO END208 07360CSR MOVE '32' W6A 07370CSR W6A COMP TWOP 24 NON-PD HOLIDAY 07380CSR 24 GOTO END208 07390CSR MOVE '05' W6A 07400CSR W6A COMP TWOP 25 PAID HOLIDAY 07410CSR 25 GOTO END208 07420CSR MOVE '31' W6A 07430CSR W6A COMP TWOP 26 LEAVE OF ABSENCE 07440CSR 26 GOTO END208 07450CSR MOVE '30' W6A 07460CSR W6A COMP TWOP 27 ABSENT 07470CSR 27 GOTO END208 07480CSR SETON 20 REGULAR HOURS 07490CSR END208 ENDSR 07500C******************************************************************** ÐÐ07510CSR SR209 BEGSR 07520C* CALCULATE TOTALS, PHASE-1 07530C* WEEK HOUR TOTALS 07540CSR RH ADD VH BL1 REG + VAC HRS 07550CSR SL ADD BL1 BL1 + SICK LEAVE 07560CSR PH ADD BL1 BL1 + PAID HOLIDAY 07570CSR NP ADD BL1 BL1 + NON-PAID HOLIDAY 07580CSR LA ADD BL1 BL1 + LEAVE OF ABSENCE 07590CSR AB ADD BL1 BL1 + ABSENT 07600CSR XFOOTBL1 DTOT 41 TOTAL WEEK 07610C* ACTUAL PAY HRS TOTAL. 07620CSR Z-ADDBL1 WK TOTAL WEEK 07630CSR WK SUB LA WK LESS LEAVE OF ABSENCE07640CSR WK SUB AB WK LESS ABSENT 07650CSR WK SUB NP WK LESS NO PAY HOLIDAY 07660CSR XFOOTWK WKTOT 41 07670CSR XFOOTAH RMT,1 ASSIGNED HRS TOTAL 07680CSR XFOOTRH RMT,2 REG HRS TOTAL 07690CSR XFOOTOT OVTOT 41 O.T. HRS TOTAL 07700CSR XFOOTVH RMT,3 VACATION HRS TOTAL 07710CSR XFOOTSL RMT,4 SICK LEAVE HRS TOTAL 07720CSR XFOOTPH RMT,5 PAID HOLIDAY TOTAL 07730CSR XFOOTNP RMT,6 NON-PAID HOLIDAY TOT 07740CSR XFOOTLA RMT,7 LEAVE OF ABSENCE TOT 07750CSR XFOOTAB RMT,8 ABSENT TOTAL ÐÐ07760CSR XFOOTV$$ V$TOT 52 VOUCHER $ TOTAL 07770CSR ENDSR 07780C******************************************************************** 07790CSR SR210 BEGSR 07800C* CALCULATE OVERTIME 07810CSR Z-ADD0 CP 07820CSR EMJ,1 COMP 'A' 30 ADMIN 07830CSR EMJ,2 COMP 'P' 31 PERM 07840CSR EMJ,3 COMP 'F' 32 FULL 07850CSR EMJ,4 COMP 'S' 33 SALARY 07860CSR EMJ,5 COMP 'I' 34 INDIRECT 07870C* COMPUTE DAILY OVERTIME 07880CSR Z-ADD1 X 07890C*------------------------------------------------------------------- 07900CSR T210B TAG 07910CSR Z3D1 LOKUPWK,X 54 GT 07920CSRN54 GOTO T210G 07930CSR WK,X COMP 10 35 10-HR DAY 07940CSRN35 WK,X SUB 8 TWK 41 54 07950CSR 35 WK,X SUB 10 TWK 54 07960CSRN54 GOTO T210D 07970CSR 35 TWK SUB 2 DBL 41 54 07980CSRN35 TWK SUB 4 DBL 54 07990CSR 54 TWK SUB DBL TWK 08000CSR 2 MULT DBL DBL ÐÐ08010CSR DBL ADD TWK TWK 08020CSR TWK SUB OT,X TWK 54 08030CSR 54 Z-ADDTWK CP,X 08040C* 08050C*------------------------------------------------------------------- 08060CSR T210D TAG 08070CSR 1 ADD X X 08080CSR X COMP 20 54 08090CSRN54 GOTO T210B 08100C*---------------------------------------------------------------- 08110CSR T210G TAG 08120C* COMPUTE OVERTIME FOR THE WEEK 08130CSR XFOOTCP CTOT 08140CSR XFOOTWK TWK 41 08150C* 08160C* 08170C* 08180CSR TWK SUB 40 TWK 54 PREMIUM TIME 08190CSRN54 Z-ADD0 TWK 08200CSR TWK SUB 8 DBL 54 08210CSR 54 Z-ADD8 TWK 08220CSRN54 Z-ADD0 DBL 08230CSR 2 MULT DBL DBL 08240CSR DBL ADD TWK TWK 08250CSR TWK SUB OVTOT TWK ÐÐ08260CSR TWK SUB CTOT TWK 54 08270CSRN54 Z-ADD0 TWK 08280CSR TWK ADD CP,14 CP,14 08290CSR XFOOTCP CTOT 08300CSR END210 ENDSR 08310C******************************************************************** 08320CSR SR211 BEGSR 08330C* CALCULATE ABSENT 08340CSR AH SUB BL1 CA 08350CSR CA SUB AB CA 08360CSR Z-ADD0 X 08370C*------------------------------------------------------------------- 08380CSR T211C TAG 08390CSR 1 ADD X X 08400CSR X COMP 14 54 08410CSR 54 GOTO T211E 08420CSR CA,X COMP 0 54 08430CSR 54 Z-ADD0 CA,X 08440CSR GOTO T211C 08450C*-------------------------------------------------------------- 08460CSR T211E TAG 08470CSR XFOOTCA CATOT 08480CSR ENDSR 08490C******************************************************************** 08500CSR SR212 BEGSR ÐÐ08510C* CALCULATE TOTALS 08520CSR BL1 ADD CA BL2 08530CSR CP ADD BL2 BL2 08540CSR OT ADD BL2 BL2 08550CSR XFOOTBL2 TTOT 08560CSR ENDSR 08570C******************************************************************* 08580CSR SR220 BEGSR 08590C* REVERSE DATE FIELD 08600CSR MOVELW6N W2N 08610CSR W2N COMP 12 54 08620CSRN54 MOVELW6N W4N 40 08630CSRN54 MOVE W6N W2N 08640CSRN54 MOVELW2N W6N 08650CSRN54 MOVE W4N W6N 08660CSR ENDSR 08670C***************************************************************** 08680C* 08690C* 08700C* 08710C* 08720O******************************************************************** 08730OTERM132 E 71 08740O* SEE SR71 TO SEE WHICH OUTPUT INDICATORS ARE BRITE AND WHICH ARE DIM. 08750O BIT,28 1 ÐÐ08760O N50 8 '8091001' 08770O N50 BIT,1 9 08780O N50 BIT,1 10 08790O 50 10 '[001 ]001' 08800O 50 BIT,28 6 08810O UDATE 18 ' - - ' 08820O 67 'CUMULATIVE' 08830O 76 'EMPLOYEE' 08840O 86 'TIME CARD' 08850O 92 'INPUT' 08860O*------------------------------------------------------------------- 08870O E 71 08880O OR 72 01 08890O 15 '(1) CLOCK NO.:' 08900O TCLOK Z 22 08910O MAN 73 08920O A39 132 08930O*------------------------------------------------------------------- 08940O E 71 08950O OR 72 02 08960O 15 '(2) BEG DATE :' 08970O TDATE 25 ' - - ' 08980O 34 'DEPT:' 08990O EMDEPTZ 41 09000O 55 42 '-' ÐÐ09010O 55 EMWC 45 09020O WCNAME 76 09030O A39 132 09040O*------------------------------------------------------------------- 09050O E 71 09060O DAY,1 25 09070O DAY,2 32 09080O DAY,3 39 09090O DAY,4 46 09100O DAY,5 53 09110O DAY,6 60 09120O DAY,7 67 09130O DAY,8 75 09140O DAY,9 82 09150O DAY,10 89 09160O DAY,11 96 09170O DAY,12 103 09180O DAY,13 110 09190O DAY,14 117 09200O 125 'TOTAL' 09210O*------------------------------------------------------------------- 09220O E 71 09230O DAT,1 26 ' - ' 09240O DAT,2 33 ' - ' 09250O DAT,3 40 ' - ' ÐÐ09260O DAT,4 47 ' - ' 09270O DAT,5 54 ' - ' 09280O DAT,6 61 ' - ' 09290O DAT,7 68 ' - ' 09300O DAT,8 76 ' - ' 09310O DAT,9 83 ' - ' 09320O DAT,10 90 ' - ' 09330O DAT,11 97 ' - ' 09340O DAT,12 104 ' - ' 09350O DAT,13 111 ' - ' 09360O DAT,14 118 ' - ' 09370O 125 'HOURS' 09380O*------------------------------------------------------------------- 09390O E 40 09400O 12 'ASSIGNED HRS' 09410O AH,1 K 26 09420O AH,2 K 33 09430O AH,3 K 40 09440O AH,4 K 47 09450O AH,5 K 54 09460O AH,6 K 61 09470O AH,7 K 68 09480O AH,8 K 76 09490O AH,9 K 83 09500O AH,10 K 90 ÐÐ09510O AH,11 K 97 09520O AH,12 K 104 09530O AH,13 K 111 09540O AH,14 K 118 09550O RMT,1 K 125 09560O*------------------------------------------------------------------- 09570O E 41 09580O 13 'REGULAR HOURS' 09590O RH,1 K 26 09600O RH,2 K 33 09610O RH,3 K 40 09620O RH,4 K 47 09630O RH,5 K 54 09640O RH,6 K 61 09650O RH,7 K 68 09660O RH,8 K 76 09670O RH,9 K 83 09680O RH,10 K 90 09690O RH,11 K 97 09700O RH,12 K 104 09710O RH,13 K 111 09720O RH,14 K 118 09730O RMT,2 K 125 09740O*------------------------------------------------------------------- 09750O E 41 ÐÐ09760O 8 'VACATION' 09770O VH,1 K 26 09780O VH,2 K 33 09790O VH,3 K 40 09800O VH,4 K 47 09810O VH,5 K 54 09820O VH,6 K 61 09830O VH,7 K 68 09840O VH,8 K 76 09850O VH,9 K 83 09860O VH,10 K 90 09870O VH,11 K 97 09880O VH,12 K 104 09890O VH,13 K 111 09900O VH,14 K 118 09910O RMT,3 K 125 09920O*------------------------------------------------------------------- 09930O E 41 09940O 10 'SICK LEAVE' 09950O SL,1 K 26 09960O SL,2 K 33 09970O SL,3 K 40 09980O SL,4 K 47 09990O SL,5 K 54 10000O SL,6 K 61 ÐÐ10010O SL,7 K 68 10020O SL,8 K 76 10030O SL,9 K 83 10040O SL,10 K 90 10050O SL,11 K 97 10060O SL,12 K 104 10070O SL,13 K 111 10080O SL,14 K 118 10090O RMT,4 K 125 10100O*------------------------------------------------------------------- 10110O E 41 10120O 12 'PAID HOLIDAY' 10130O PH,1 K 26 10140O PH,2 K 33 10150O PH,3 K 40 10160O PH,4 K 47 10170O PH,5 K 54 10180O PH,6 K 61 10190O PH,7 K 68 10200O PH,8 K 76 10210O PH,9 K 83 10220O PH,10 K 90 10230O PH,11 K 97 10240O PH,12 K 104 10250O PH,13 K 111 ÐÐ10260O PH,14 K 118 10270O RMT,5 K 125 10280O*------------------------------------------------------------------- 10290O E 42 10300O 16 'NON-PAID HOLIDAY' 10310O NP,1 K 26 10320O NP,2 K 33 10330O NP,3 K 40 10340O NP,4 K 47 10350O NP,5 K 54 10360O NP,6 K 61 10370O NP,7 K 68 10380O NP,8 K 76 10390O NP,9 K 83 10400O NP,10 K 90 10410O NP,11 K 97 10420O NP,12 K 104 10430O NP,13 K 111 10440O NP,14 K 118 10450O RMT,6 K 125 10460O*------------------------------------------------------------------- 10470O E 43 10480O 16 'LEAVE OF ABSENCE' 10490O LA,1 K 26 10500O LA,2 K 33 ÐÐ10510O LA,3 K 40 10520O LA,4 K 47 10530O LA,5 K 54 10540O LA,6 K 61 10550O LA,7 K 68 10560O LA,8 K 76 10570O LA,9 K 83 10580O LA,10 K 90 10590O LA,11 K 97 10600O LA,12 K 104 10610O LA,13 K 111 10620O LA,14 K 118 10630O RMT,7 K 125 10640O*------------------------------------------------------------------- 10650O E 43 10660O 6 'ABSENT' 10670O AB,1 K 26 10680O AB,2 K 33 10690O AB,3 K 40 10700O AB,4 K 47 10710O AB,5 K 54 10720O AB,6 K 61 10730O AB,7 K 68 10740O AB,8 K 76 10750O AB,9 K 83 ÐÐ10760O AB,10 K 90 10770O AB,11 K 97 10780O AB,12 K 104 10790O AB,13 K 111 10800O AB,14 K 118 10810O RMT,8 K 125 10820O*------------------------------------------------------------------- 10830O E 44 10840O 14 'VOUCHER AMOUNT' 10850O V$$,1 K 26 10860O V$$,2 K 33 10870O V$$,3 K 40 10880O V$$,4 K 47 10890O V$$,5 K 54 10900O V$$,6 K 61 10910O V$$,7 K 68 10920O V$$,8 K 76 10930O V$$,9 K 83 10940O V$$,10K 90 10950O V$$,11K 97 10960O V$$,12K 104 10970O V$$,13K 111 10980O V$$,14K 118 10990O V$TOT K 125 11000O*------------------------------------------------------------------- ÐÐ11010O E 44 11020O 1 ' ' 11030O*------------------------------------------------------------------- 11040O E 44 11050O 16 'DAY/WEEK TOTALS:' 11060O BL1,1 K 26 11070O BL1,2 K 33 11080O BL1,3 K 40 11090O BL1,4 K 47 11100O BL1,5 K 54 11110O BL1,6 K 61 11120O BL1,7 K 68 11130O BL1,8 K 76 11140O BL1,9 K 83 11150O BL1,10K 90 11160O BL1,11K 97 11170O BL1,12K 104 11180O BL1,13K 111 11190O BL1,14K 118 11200O DTOT K 125 11210O*------------------------------------------------------------------- 11220O E 45 11230O 12 'PAID TOTALS:' 11240O WK,1 K 26 11250O WK,2 K 33 ÐÐ11260O WK,3 K 40 11270O WK,4 K 47 11280O WK,5 K 54 11290O WK,6 K 61 11300O WK,7 K 68 11310O WK,8 K 76 11320O WK,9 K 83 11330O WK,10 K 90 11340O WK,11 K 97 11350O WK,12 K 104 11360O WK,13 K 111 11370O WK,14 K 118 11380O WKTOT K 125 11390O*------------------------------------------------------------------- 11400O E 45 11410O 1 ' ' 11420O*------------------------------------------------------------------- 11430O E 45 11440O 19 'INPUT OVERTIME HRS:' 11450O OT,1 K 26 11460O OT,2 K 33 11470O OT,3 K 40 11480O OT,4 K 47 11490O OT,5 K 54 11500O OT,6 K 61 ÐÐ11510O OT,7 K 68 11520O OT,8 K 76 11530O OT,9 K 83 11540O OT,10 K 90 11550O OT,11 K 97 11560O OT,12 K 104 11570O OT,13 K 111 11580O OT,14 K 118 11590O OVTOT K 125 11600O*---------------------------------------------------------------- 11610O E 45 11620O 1 ' ' 11630O*------------------------------------------------------------------- 11640O E 45 11650O 15 'CALCULATED O/T:' 11660O CP,1 K 26 11670O CP,2 K 33 11680O CP,3 K 40 11690O CP,4 K 47 11700O CP,5 K 54 11710O CP,6 K 61 11720O CP,7 K 68 11730O CP,8 K 76 11740O CP,9 K 83 11750O CP,10 K 90 ÐÐ11760O CP,11 K 97 11770O CP,12 K 104 11780O CP,13 K 111 11790O CP,14 K 118 11800O CTOT K 125 11810O*-------------------------------------------------------------------- 11820O E 45 11830O 15 'CALCULATED ABS:' 11840O CA,1 K 26 11850O CA,2 K 33 11860O CA,3 K 40 11870O CA,4 K 47 11880O CA,5 K 54 11890O CA,6 K 61 11900O CA,7 K 68 11910O CA,8 K 76 11920O CA,9 K 83 11930O CA,10 K 90 11940O CA,11 K 97 11950O CA,12 K 104 11960O CA,13 K 111 11970O CA,14 K 118 11980O CATOT K 125 11990O*------------------------------------------------------------------- 12000O E 45 ÐÐ12010O 1 ' ' 12020O*-------------------------------------------------------------------- 12030O E 46 12040O 16 'TOTAL HOURS :' 12050O BL2,1 K 26 12060O BL2,2 K 33 12070O BL2,3 K 40 12080O BL2,4 K 47 12090O BL2,5 K 54 12100O BL2,6 K 61 12110O BL2,7 K 68 12120O BL2,8 K 76 12130O BL2,9 K 83 12140O BL2,10K 90 12150O BL2,11K 97 12160O BL2,12K 104 12170O BL2,13K 111 12180O BL2,14K 118 12190O TTOT K 125 12200O 50 BIT,28 131 12210O 50 132 'K' 12220O******************************************************************** 12230OCRTFILE E 97 12240O PROG 26 12250O CRTIME 33 ÐÐ12260O CRDATE 37 12270O LNK 79 12280O******************************************************************** ** NUL ARRAY 012290 012300** A10 ARRAY 012310 012320** A39 ARRAY 12330 12340** NUM ARRAY 012350001 TCLOK 12360002 TDATE 12370** DUN ARRAY 012380 012390** MES ARRAY 012400---MESSAGE NOT ON FILE--- 012410** LNK ARRAY 012420 12430** MAN ARRAY 12440 12450** DAT ARRAY 12460 12470** DAY ARRAY 12480 12490** H1 ARRAY 12500ÐÐ 12510** R1 ARRAY 12520 12530** T1 ARRAY 12540 12550** V1 ARRAY 12560 12570** S1 ARRAY 12580 12590** P1 ARRAY 12600 12610** N1 ARRAY 12620 12630** L1 ARRAY 12640 12650** A1 ARRAY 12660 12670** V1$ ARRAY 12680 12690** WK1 ARRAY 12700 12710** DY1 ARRAY 12720 12730** C1 ARRAY 12740 12750ÐÐ** TT1 ARRAY 12760 12770** DOW ARRAY 12780 12790** NAM ARRAY 12800SAT 12810SUN 12820MON 12830TUE 12840WED 12850THU 12860FRI 12870** CA ARRAY 12880 12890** WK ARRAY 12900 12910/* 12920_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–J –?X015BM P120282120282(èÈÐ00010H Q015BM00020F* LIST BMMAST RECORDS WHERE ISSUE CODE IS NOT 'RD', 00030F* BUT COMPONENT PART MAST ISSUE = RD. (X015BM) 00040F* REVISED 3/06/81 4:00 PM. 00050FBMMAST IC F 86R20AI 1 DISK 00060FBMWU ID F 21L20AI 1 DISK 00070FPMMST2 IP F 674 12AI 1 DISK 00080FDIABLO O F 50 5 U1 00090FPRINT O F 50 PRINTER U2 00100I******************************************************************** 00110IBMMAST BM 00120I 1 100BMAPN 00130I 11 200BMCPN 00140I 36 37 BMISSU 00150I 86 86 BMSTAT 00160I GG 02 00170I******************************************************************** 00180IPMMST2 PM 03 674NCD 00190I 1 100PMPN 00200I 94 95 PMSC 00210I 97 98 PMISSU 00220I PG 04 00230I******************************************************************** 00240IBMWU BW 00250I 1 100BWCPN ÐÐ00260I 11 200BWAPN 00270I 21 21 BWSTAT 00280C******************************************************************** 00290C N03 GOTO END 00300C PMISSU COMP 'RD' 03 00310C N03 GOTO END 00320C MOVELPMPN W20A 20 00330C W20A SETLLBMWU 00340C SETOF 75 00350C*--------------------------------------------------------------- 00360C START TAG 00370C SETOF 54 00380C READ BMWU 54 00390C 54 GOTO END 00400C BWCPN COMP PMPN 54 00410C N54 GOTO END 00420C BWSTAT COMP 'D' 54 00430C 54 GOTO START 00440C MOVELBWAPN W20A 00450C MOVE BWCPN W20A 00460C W20A CHAINBMMAST 54 00470C N54 BMSTAT COMP 'D' 54 00480C 54 GOTO START 00490C SETOF 54 00500C BMISSU COMP 'RD' 54 ÐÐ00510C N54N75 PMSC COMP 'RD' 54 00520C N54 GOTO START 00530C N70 Z-ADD70 LINE 30 00540C SETON 70 00550C LINE COMP 60 71 71 00560C 71 U1 EXITFZTFORM TOP FORM 00570C 71 EXCPT 00580C 71 1 ADD EGAP EGAP 40 00590C 71 Z-ADD0 LINE 00600C SETOF 71 00610C 1 ADD LINE LINE 00620C SETON 7275 00630C EXCPT 00640C SETOF 72 00650C GOTO START 00660C*----------------------------------------------------------------- 00670C END TAG 00680O******************************************************************** 00690ODIABLO E 71 U1 00700O 46 'PAGE' 00710O EGAP Z 50 00720O 12 'ASSEMBLY' 00730O 26 'COMPONENT' 00740O 33 'BM/IC' 00750O 40 'PM/IC' ÐÐ00760O*--------------------------------------------------------------- 00770O E 71 00780O 1 ' ' 00790O*------------------------------------------------------------------- 00800O E 72 U1 00810O BMAPN 12 ' - - ' 00820O BMCPN 26 ' - - ' 00830O BMISSU 31 00840O PMISSU 38 00850O******************************************************************** 00860OPRINT E 301 71 U2 00870O 46 'PAGE' 00880O EGAP Z 50 00890O 12 'ASSEMBLY' 00900O 26 'COMPONENT' 00910O 33 'BM/IC' 00920O 40 'PM/IC' 00930O*------------------------------------------------------------------- 00940O E 1 72 U2 00950O BMAPN 12 ' - - ' 00960O BMCPN 26 ' - - ' 00970O BMISSU 31 00980O PMISSU 38 /* 000990_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(wJA wX015CF P Ä120282120282(èÈÐ00010H Q015CF00020F* PRINT IRON TEST PATTERN LABELS BY ZIP (DIABLO). (X015CF) 00030F* REVISED 8/08/80 10:50 AM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FCFKEYOUTIS F 59 59 DISK 00060FCFMAST IC F 370R15AI 1 DISK 00070E******************************************************************** 00080E NA4 5 5 6 00090E NB4 5 5 4 0 00100E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00110E SEL 38 38 1 00120E WRK 38 38 1 A 00130E CSZ 38 38 1 A 00140E XS 1 1 39 00150E MSG 1 1 35 00160E DUM 35 35 1 00170E BIT 33 1 00180E CFA 8 35 A 00190E CFN 5 3 A 00200E CFC 5 3 0 00210E NAC 24 1 00220I******************************************************************** 00230IBITTAB BT 02 00240I 1 33 BIT 00250I******************************************************************** ÐÐ00260ICFKEYOUTCK 00270I 36 50 CKKEY 00280I 51 590CKZIP 00290I******************************************************************** 00300ICFMAST CF 01 00310I* CATALOG HOLDER (MAIL LIST) MASTER. 00320I* KEY AREA. 00330I* NAME KEY 15A 00340I 1 15 CFKEY 00350I* ADDRESS LINES 35A X 8 00360I 16 295 CFA 00370I* STATE CODE 2A 00380I 296 297 CFSTCD 00390I* ZIP 9P 00400I P 298 3020CFZIP 00410I* CATALOGS. 00420I* NAME 3A X 5 00430I 303 317 CFN 00440I* COPIES 3P X 5 00450I P 318 327 CFC 00460I* SELECTOR CODES 24 X 1A 1 00470I 328 351 NAC 00480I* TELEPHONE # 12A 00490I 352 363 CFTEL 00500I* LAST TRAN DATE 6N (YMD) ÐÐ00510I 364 3690CFDLT 00520I* RECORD STATUS 1A 00530I 370 370 CFSTAT 00540C******************************************************************** 00550C* INITIALIZE - 1 TIME. 00560C EXSR SR101 INIT. 00570C 02 GOTO END 00580C CKZIP COMP BEGZIP 54 54 00590C N54 GOTO END 00600C*------------------------------------------------------------------- 00610C CKKEY CHAINCFMAST 54 00620C CFSTAT COMP 'D' 54 00630C 54 SETOF 01 00640C 54 GOTO END DELETED CFMAST. 00650C EXSR SR102 00660C*------------------------------------------------------------------- 00670C END TAG 00680CLR EXSR SR303 LF 00690CLR EXSR SR303 LF 00700CLR EXSR SR303 LF 00710CLR EXSR SR303 LF 00720CLR EXSR SR303 LF 00730CLR EXSR SR303 LF 00740CLR EXSR SR303 LF 00750CLR EXSR SR303 LF ÐÐ00760CLR EXSR SR303 LF 00770CLR EXSR SR303 00780CLR EXSR SR303 00790CLR EXITFQLF6 SET 6-LPI 00800C******************************************************************** 00810CSR SR101 BEGSR 00820C* INITIALIZE 1-TIME. 00830CSR EXITFQLF8 SET 8-LPI 00840CSR MOVE ' ' BLK16 16 00850CSR MOVE ' ' BLK35 35 00860CSR MOVE ' ' BLK60 60 00870CSR MOVE ' ' BLK25 25 00880CSR MOVE ' ' BLK22 22 00890CSR 78 GOTO END101 00900C*--------------------------------------------------------------- 00910CSR T101A TAG 00920C* WRITE X'S TO POSITION LABELS BY. 00930CSR SETON 78 00940CSR MOVEAXS W60A 60 00950CSR MOVE BLK22 W60A 00960CSR EXSR SR302 00970CSR EXSR SR302 00980CSR EXSR SR302 00990CSR EXSR SR302 01000CSR EXSR SR302 ÐÐ01010CSR EXSR SR302 01020CSR EXSR SR302 01030CSR EXSR SR302 01040CSR EXSR SR302 01050CSR EXSR SR302 01060CSR EXSR SR302 01070CSR EXSR SR303 LF/CR 01080CSR EXSR SR303 LF/CR 01090CSR MOVE ' ' W6A 6 01100CSR EXITFQREED6 READ CRT 6-BYTES 01110CSR RLABL W6A 01120CSR W6A COMP ' ' 54 01130CSRN54 GOTO T101A ALL BLANKS-REPEAT 01140C* GET STARTING ZIP. 01150CSR MOVE BLK60 W60A 60 01160CSR MOVEAMSG W60A 01170CSR MOVE BLK25 W60A 01180CSR EXSR SR302 01190CSR MOVELBIT,1 BUFLGT 2 BUFFER LGTH. 01200CSR MOVE BIT,5 BUFLGT 01210CSR MOVE BLK60 W60A 01220CSR EXITFQWREED 01230CSR RLABL W60A 01240CSR RLABL BUFLGT 01250CSR MOVELW60A W9A 9 ÐÐ01260CSR Z-ADD9 W2N 20 01270CSR EXIT SUBRAJ R. JUSTIFY 01280CSR RLABL W2N 01290CSR RLABL W9A 01300CSR MOVE W9A BEGZIP 90 01310CSR EXSR SR303 LF/CR 01320CSR EXSR SR303 01330CSR EXSR SR303 01340CSR EXSR SR303 01350CSR EXSR SR303 01360CSR EXSR SR303 01370CSR EXSR SR303 01380CSR EXSR SR303 01390CSR EXSR SR303 01400CSR EXSR SR303 01410CSR END101 ENDSR 01420C******************************************************************** 01430CSR SR102 BEGSR 01440C* WRITE LABEL. 01450CSR Z-ADD0 COUNT 30 01460CSR Z-ADD1 L 30 01470CSR SETOF 75 01480C*------------------------------------------------------------------- 01490CSR T102A TAG 01500CSR BLK35 LOKUPCFA,L 54 ÐÐ01510CSRN54 GOTO T102W 01520CSR CFSTCD COMP ' ' 54 FLAG DOMESTIC 01530CSR L COMP 7 55 FLAG LINE 7 01540CSRN54 NOT DOMESTIC 01550CORN55 GOTO T102B NOT LINE 7 01560CSR EXSR SR202 PUT CITY/STATE. 01570CSR GOTO T102W 01580C*------------------------------------------------------------------- 01590CSR T102B TAG 01600CSR MOVE BLK60 W60A 01610CSR L COMP 1 54 01620CSR 54 EXSR SR304 DO PREFIX. 01630CSR MOVEACFA,L W60A 01640CSR MOVE BLK25 W60A 01650CSR EXSR SR302 PUT NORMAL LINE 01660CSR SETON 75 01670CSR 1 ADD COUNT COUNT 01680CSR MOVE BLK35 CFA,L 01690CSR GOTO T102A GET NEXT LINE 01700C*------------------------------------------------------------------- 01710CSR T102W TAG 01720C* PUT OUT SPACE LINES. 01730CSR COUNT COMP 11 54 01740CSR 54 GOTO END102 01750CSR EXSR SR303 LF/CR ÐÐ01760CSR 1 ADD COUNT COUNT 01770CSR GOTO T102W 01780CSR END102 ENDSR 01790C******************************************************************** 01800CSR SR202 BEGSR 01810C* PUT CITY/STATE/ZIP. 01820CSR MOVE ' ' CSZ INIT CITY LINE 01830CSR MOVEACFA,7 CSZ CITY NAME 01840CSR EXSR SR301 FIND END CITY 01850CSRN55 GOTO T202E NO BLKS LEFT 01860CSR MOVE ',' CSZ,A COMMA 01870CSR 2 ADD A A 30 01880CSR A COMP 38 54 01890CSR 54 GOTO T202E NO BLKS LEFT 01900CSR MOVEACFSTCD CSZ,A STATE CODE 01910CSR 4 ADD A A 01920CSR A COMP 38 54 01930CSR 54 GOTO T202E NO BLKS LEFT 01940CSR MOVE CFZIP W5A 5 01950CSR MOVEAW5A CSZ,A ZIP CODE 01960C*------------------------------------------------------------------- 01970CSR T202E TAG 01980CSR MOVE BLK60 W60A 01990CSR MOVEACSZ W60A 02000CSR MOVE BLK22 W60A ÐÐ02010CSR EXSR SR302 02020CSR 1 ADD COUNT COUNT PUT CITY/STATE. 02030CSR ENDSR 02040C***************************************************************** 02050CSR SR301 BEGSR 02060C* FIND END OF CITY + 1 02070CSR SETOF 55 02080CSR Z-ADD0 W3N 30 02090CSR Z-ADD1 A 02100C*------------------------------------------------------------------- 02110CSR T301A TAG 02120CSR ' ' LOKUPCSZ,A 54 02130CSRN54 1 ADD W3N A 02140CSRN54 GOTO T301B 02150CSR Z-ADDA W3N 02160CSR 1 ADD A A 02170CSR A COMP 38 54 02180CSR 54 GOTO END301 02190CSR GOTO T301A 02200C*-------------------------------------------------------------- 02210CSR T301B TAG 02220CSR A COMP 38 54 02230CSRN54 SETON 55 02240CSR END301 ENDSR 02250C******************************************************************** ÐÐ02260CSR SR302 BEGSR 02270CSR MOVELW60A W132A 132 02280CSR EXITFZD132 02290CSR RLABL W132A 02300CSR ENDSR 02310C******************************************************************** 02320CSR SR303 BEGSR 02330C* LF/CR. 02340CSR EXITFQCLFCR LF/CR. 02350CSR ENDSR 02360C******************************************************************** 02370CSR SR304 BEGSR 02380C* SUBST. 'CMDR.' OR 'OFFICER' FOR MR. 02390CSR MOVE ' ' WRK 02400CSR '5' LOKUPNAC 57 CMDR. 02410CSR '6' LOKUPNAC 58 OFFICER 02420CSR MOVEACFA,1 DUM 02430CSR 57 MOVEA'CMDR.' WRK,1 02440CSR 58 MOVEA'OFFICER' WRK,1 02450CSR 57 MOVEADUM,4 WRK,6 02460CSR 58 MOVEADUM,4 WRK,8 02470CSR MOVEAWRK,1 W35A 35 02480CSR MOVEAW35A CFA,1 02490CSR ENDSR ** NA4 ARRAY 002500ÐÐ 002510** NB4 ARRAY 002520 002530** TABSC/TABSCN --- STATE CODES/NAMES 002540 002550ALALABAMA 002560AKALASKA 002570AZARIZONA 002580ARARKANSAS 002590ASAMERICAN SAMOA 002600CACALIFORNIA 002610CZCANAL ZONE 002620COCOLORADO 002630CTCONNECTICUT 002640DEDELAWARE 002650DCDISTRICT OF COLUMBIA 002660FLFLORIDA 002670GAGEORGIA 002680GUGUAM 002690HIHAWAII 002700IDIDAHO 002710ILILLINOIS 002720ININDIANA 002730IAIOWA 002740KSKANSAS 002750ÐÐKYKENTUCKY 002760LALOUISIANA 002770MEMAINE 002780MDMARYLAND 002790MAMASSACHUSETTS 002800MIMICHIGAN 002810MNMINNESOTA 002820MSMISSISSIPPI 002830MOMISSOURI 002840MTMONTANA 002850NENEBRASKA 002860NVNEVADA 002870NHNEW HAMPSHIRE 002880NJNEW JERSEY 002890NMNEW MEXICO 002900NYNEW YORK 002910NCNORTH CAROLINA 002920NDNORTH DAKOTA 002930OHOHIO 002940OKOKLAHOMA 002950OROREGON 002960PAPENNSYLVANIA 002970PRPUERTO RICO 002980RIRHODE ISLAND 002990SCSOUTH CAROLINA 003000ÐÐSDSOUTH DAKOTA 003010TNTENNESSEE 003020TTTRUST TERRITORIES 003030TXTEXAS 003040UTUTAH 003050VTVERMONT 003060VAVIRGINIA 003070VIVIRGIN ISLANDS 003080WAWASHINGTON 003090WVWEST VIRGINIA 003100WIWISCONSIN 003110WYWYOMING 003120** SEL ARRAY 003130 003140** WRK ARRAY 003150 003160** CSZ ARRAY 003170 003180** XS ARRAY 003190XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 003200** MSG ARRAY 003210ENTER STARTING ZIP: 003220** DUM ARRAY 003230 003240/* 003250ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(ôJß ôÑX110BM P4999999120282(èÈÐ00010H Q110BM00020F* DISPLAY SUMMARY PARTS LIST. (X110BM) 00030F* REVISED 8/12/82 5:25 PM. 00040FBITPAR IP F 90 DISK 00050FCRTFILE UC F 256R DISK 00060FSUMPLSRTIC F 38R DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FTERM132 O F 132 5 00090FMGFILE IC F 80R DISK 00100E******************************************************************** 00110E NULL 1 132 1 00120E A12 12 12 1 A 00130E A29 29 29 1 00140E DIV 1 132 1 00150E LNK 1 7 6 A 00160E CALL 7 6 00170E TST 25 1 00180E BIT 33 1 00190I******************************************************************** 00200IBITPAR BT 01 00210I 1 33 BIT 00220I 34 58 PAR 00230I 59 83 TST 00240I**************************************************************** 00250ICRTFILE CR ÐÐ00260I 28 330CRTIME 00270I 34 370CRDATE 00280I 38 79 CALL 00290I******************************************************************** 00300ISUMPLSRTSP 02 00310I 1 100TCPN 00320I 11 200TAPN 00330I 21 300TTPN 00340I P 31 340TQTYP 00350I P 35 380TQTYE 00360I******************************************************************** 00370IPMMST2 PM 00380I* PART MASTER RECORD (XPMMST) 00390I* KEY AREA 00400I* PART NO. 12A 00410I 1 12 PMPN 00420I* PROD LINE 4N 00430I 15 180PMPL 00440I* MODEL NAME 12A 00450I 19 30 PMMODL 00460I* DESCRIPTION 29A 00470I 31 59 PMDESC 00480I* COMMODITY CODE 9P 00490I P 60 640PMCC 00500I* ENG CHANGE STATUS. ÐÐ00510I* CUR CHG LEVEL 2A 00520I 70 71 PMECHG 00530I* CUR CHG DATE 6N 00540I 72 770PMDCHG 00550I* LAST ECN NO. 5A 00560I 65 69 PMECN 00570I* DRAWING INFO 00580I* DWG SIZE 1A 00590I 82 82 PMSIZ 00600I* DWG CLASS 1A 00610I* D = DYNAIR DWG 00620I* V = VENDOR DWG 00630I 83 83 PMDCLS 00640I* STANDARD CODE 1A 00650I 84 84 PMSTDC 00660I* DWG REL CODE 1A 00670I* E = ENG ONLY 00680I* M = REL TO MFG 00690I* P = PROTOTYPE 00700I 78 78 PMDREL 00710I* UNIT MEAS 2A 00720I* EA = EACH OC = OUNCE 00730I* ST = SET TC = TROY OUNCE 00740I* IN = INCH LB = POUND 00750I* FT = FEET PT = PINT ÐÐ00760I* YD = YARD QT = QUART 00770I* SI = SQ.INCH GL = GALLON 00780I* SF = SQ.FEET DR = DRUM 00790I* SY = SQ.YARD 00800I 85 86 PMUM 00810I* SOURCE CODE 2A 00820I* MA = MFG ASSY 00830I* MP = MFG PART 00840I* PA = PURCH ASSY 00850I* PP = PURCH PART 00860I* RS = RAW STOCK 00870I 94 95 PMSC 00880I* PROVISIONING CODE 1A 00890I* A = FORECAST,NO VALUE ADDED 00900I* B = FORECAST,VALUE ADDED 00910I* C = BUILD TO ORDER (B) 00920I* D = BUILD TO ORDER (NOT B) 00930I* E = CUSTOM 00940I* Y = OBSOLETE,REPAIRABLE 00950I* Z = OBSOLETE,NOT REPAIRABLE 00960I 96 96 PMPROV 00970I* ISSUE CODE 2A 00980I* PT = PULL TIME 00990I* OR = ON REQUEST 01000I* BI = BULK ISSUE ÐÐ01010I* AR = AS REQUIRED 01020I* VS = VENDOR SUPPLIED 01030I* SD = SHIPPING DOCUMENT 01040I* TD = TRAV DOCUMENT 01050I* RD = REF DOCUMENT 01060I* RA = REF ASSY 01070I 97 98 PMISSU 01080I* DELIVER TO DEPT 5P 01090I P 99 1010PMDEL 01100I* RESPONSIBILITY CODES 01110I* ENGR CODE 2A 01120I 102 103 PMEGR 01130I* PLANNER CODE 2A 01140I 104 105 PMPLNR 01150I* BUYER CODE 2A 01160I 106 107 PMBUYR 01170I* SALESMAN CODE 2A 01180I 108 109 PMSLSM 01190I* INVENTORY ACCOUNT 5P 01200I P 110 1120PMACNT 01210I* OLD STYLE PART MASTER FIELDS. 01220I* FAB CODE 2A 01230I 487 488 PMFABC 01240I* STD UNIT COST 9.3P 01250I P 489 4933PMOSUC ÐÐ01260I* RECORD STATUS 1A 01270I* D = DELETED 01280I 674 674 PMSTAT 01290I******************************************************************** 01300IMGFILE MG 01310I* MESSAGE FILE. 01320I* TEXT 35A 01330I 1 35 MGTEXT 01340I* LINE-2 35A 01350I 36 70 MGLIN2 01360I* PROG NAME 5A 01370I 71 75 MGPROG 01380C******************************************************************** 01390C* INITIALIZE 1-TIME. 01400C EXSR SR101 INIT. 01410C MOVE ' ' BLK6 6 01420C*------------------------------------------------------------------ 01430C START TAG 01440C SETOF 909377 01450C SETOF 9676 01460C Z-ADD0 TOTQTY 01470C EXSR SR71 PUT HEADING. 01480C SETON 93 01490C*---------------------------------------------------------------- 01500C CONTU TAG ÐÐ01510C SETOF 549799 01520C 93 1 ADD RRN RRN 50 54 01530C 92 RRN SUB 1 RRN 54 01540C N54 93 Z-ADD1 RRN 01550C N54 92 GOTO ENDFIL 01560C*------------------------------------------------------------------- 01570C READ TAG 01580C SETOF 9799 01590C RRN CHAINSUMPLSRT 54 01600C 54 GOTO ENDFIL 01610C TCPN COMP LSTCPN 55 01620C 55 GOTO READ5 01630C 76 SETON 74 01640C 76 EXCPT PRINT TOTALS 01650C SETOF 74 01660C 76 2 ADD COUNT COUNT 01670C 76 SETOF 76 01680C MOVELTCPN W12A 12 01690C EXSR SR80 GET PMMST2 01700C 60 GOTO CONTU 01710C MOVE PMDESC CDESCR 29 01720C*------------------------------------------------------------------- 01730C READ5 TAG 01740C TAPN COMP LSTAPN 55 01750C 55 GOTO READ10 ÐÐ01760C MOVELTAPN W12A 01770C EXSR SR80 01780C 60 GOTO CONTU 01790C MOVE PMDESC ADESCR 29 01800C*------------------------------------------------------------------- 01810C READ10 TAG 01820C TQTYE ADD TOTQTY TOTQTY 70 76 01830C Z-ADDTCPN LSTCPN 100 01840C Z-ADDTAPN LSTAPN 100 01850C SETON 81 01860C EXCPT DISPLAY DATA. 01870C SETOF 81 01880C SETON 75 01890C 1 ADD COUNT COUNT 30 01900C COUNT COMP 26 54 01910C N54 GOTO CONTU 01920C*------------------------------------------------------------------- 01930C ENDPAG TAG 01940C Z-ADD320 M 50 01950C 76 EXSR SR73 PUT MSG. 01960C 76 EXSR SR75 READ. 01970C 94 GOTO END 01980C EXSR SR71 PUT HEADINGS 01990C 97 02000COR 99 GOTO READ ÐÐ02010C GOTO CONTU 02020C*------------------------------------------------------------------- 02030C ENDFIL TAG 02040C 76 SETON 74 02050C 76 EXCPT 02060C SETOF 7674 02070C 2 ADD COUNT COUNT 02080C Z-ADD0 TOTQTY 02090C Z-ADD327 M 02100C EXSR SR73 PUT MSG. 02110C EXSR SR75 READ. 02120C 94 GOTO END 02130C 97 02140COR 99 GOTO READ 02150C GOTO CONTU 02160C*------------------------------------------------------------------- 02170C END TAG 02180C******************************************************************** 02190CSR SR71 BEGSR 02200C* PUT HEADING. 02210CSR SETON 71 02220CSR EXCPT PUT HEADING. 02230CSR SETOF 71 02240CSR Z-ADD4 COUNT 30 02250CSR ENDSR ÐÐ02260C******************************************************************** 02270CSR SR73 BEGSR 02280C* PUT MSG TO CRT. 02290CSR EXSR SR89 GET MSG. 02300CSR SETON 73 02310CSR EXCPT PUT MSG. 02320CSR SETOF 73 02330CSR ENDSR 02340C******************************************************************** 02350CSR SR75 BEGSR 02360C* READ CRT. 02370CSR SETOF 907791 02380CSR SETOF 969495 02390CSR SETOF 9799 02400CSR MOVE BLK12 W12A 12 02410CSR EXITFZR12 READ CRT. 02420CSR RLABL W12A BUFFER 02430CSR MOVEAW12A A12 02440CSR MOVE BLK12 W12A 02450CSR Z-ADD1 W 20 02460CSR '\' LOKUPA12,W 90 02470CSRN90 GOTO T75A NO ESCAPE. 02480CSR 1 ADD W W 02490CSR W COMP 12 55 02500CSR 55 Z-ADD318 M FLAG ERROR. ÐÐ02510CSR 55 GOTO SR75 BAD ESCAPE. 02520CSR A12,W COMP 'J' 91 JUMP 02530CSR A12,W COMP 'H' 95 HELP 02540CSR A12,W COMP 'G' 94 02550CSRN94 A12,W COMP 'E' 94 MENU 02560CSRN94 A12,2 COMP 'D' 94 DONE 02570CSRN95N91 A12,W COMP 'F' 93 PAGE FORWARD 02580CSRN95N91 A12,W COMP 'B' 92 PAGE BACKWARD 02590CSR A12,W COMP '1' 97 FRONT FILE 02600CSR A12,W COMP '2' 99 END OF FILE 02610CSR 97 02620COR 99 GOTO T75D 02630CSR 91 GOTO T75B JUMP 02640CSR 95 GOTO T75 02650CSR 94 EXIT. 02660COR 92 02670COR 93 GOTO END75 GOOD ESC CODES 02680C*------------------------------------------------------------------- 02690CSR T75 TAG 02700C* DISPLAY HELP COMMENTS 02710CSR 95 EXCPT 02720CSR 95 8 ADD COUNT COUNT 02730CSR 95 GOTO SR75 02740CSR Z-ADD318 M FLAG ERR. 02750CSR EXSR SR73 PUT MSG ÐÐ02760CSR GOTO SR75 BAD ESCAPE. 02770C*------------------------------------------------------------------- 02780CSR T75A TAG 02790CSR Z-ADD1 W 02800CSR ' ' LOKUPA12,W 77 02810CSR 77 MOVEAA12 W12A 02820CSR GOTO END75 02830C*------------------------------------------------------------------- 02840CSR T75B TAG 02850CSR MOVE BLK12 W10A 10 02860CSR 1 ADD W W 02870CSR W COMP 12 55 02880CSR 55 GOTO T75C 02890CSR A12,W COMP 'F' 56 02900CSR A12,W COMP 'B' 57 02910C*------------------------------------------------------------- 02920CSR T75C TAG 02930CSR 55 Z-ADD318 M 02940CSR 55 EXSR SR73 02950CSR 55 GOTO SR75 02960CSR 1 ADD W W 02970CSR W COMP 12 55 02980CSR 55 GOTO T75C 02990CSR MOVEAA12,W W10A 03000CSR EXSR SR102 R.J. ÐÐ03010CSR MOVE W10A W5N 50 03020CSR 57 RRN SUB W5N RRN 03030CSR 56 W5N ADD RRN RRN 03040CSR RRN COMP 0 54 LESS THAN 03050CSR 54 Z-ADD0 RRN 03060CSR GOTO END75 03070C*------------------------------------------------------------------- 03080CSR T75D TAG 03090CSR 97 SETOF 92 03100CSR 97 SETON 93 03110CSR 99 SETOF 93 03120CSR 99 SETON 92 03130CSR 97 Z-ADD1 RRN 03140CSR 97 GOTO END75 03150CSR Z-ADD50000 RRN 03160CSR Z-ADD50000 LASTRN 50 03170C*------------------------------------------------------------------- 03180CSR T75E TAG 03190CSR RRN CHAINSUMPLSRT 54 03200CSR 54 Z-ADDRRN LASTRN 03210CSR 54 RRN DIV 2 RRN 55 03220CSR 54 55 GOTO T75E 03230CSR 54 Z-ADDLASTRN RRN 03240CSR 54 GOTO T75F 03250CSR LASTRN SUB RRN DIF 50 ÐÐ03260CSR DIF DIV 2 DIF 03270CSR DIF COMP 3 54 03280CSRN54 Z-ADDLASTRN RRN 03290CSRN54 GOTO T75F 03300CSR DIF ADD RRN RRN 03310CSR GOTO T75E 03320C*------------------------------------------------------------------- 03330CSR T75F TAG 03340CSR RRN CHAINSUMPLSRT 54 03350CSRN54 GOTO END75 03360CSR RRN SUB 1 RRN 03370CSR GOTO T75F 03380CSR END75 ENDSR 03390C******************************************************************** 03400CSR SR80 BEGSR 03410C* GET PMMST. 03420CSR MOVE ' ' W12A 12 03430CSR W12A CHAINPMMST2 60 03440CSRN60 PMSTAT COMP 'D' 60 03450CSR ENDSR 03460C******************************************************************** 03470CSR SR89 BEGSR 03480C* GET MSG FILE. 03490CSR M CHAINMGFILE 54 03500CSR 54 MOVE '/' A29 ÐÐ03510CSR 54 MOVEAA29 MGTEXT 03520CSR 54 MOVELM MGTEXT 03530CSR ENDSR 03540C********************************************************************* 03550CSR SR101 BEGSR 03560C* INITIALIZE. 03570CSR MOVE '-' DIV 03580CSR MOVE BIT,1 NULL 03590CSR MOVE ' ' W2A 2 03600CSR EXITFZGMINX GET TERM # 03610CSR RLABL W2A 03620CSR MOVE W2A # 20 03630CSR # COMP 0 54 03640CSRN54 Z-ADD25 # 03650CSR # CHAINCRTFILE H9 03660CSR H9 GOTO END 03670CSR MOVE CALL LNK 03680CSR MOVE 'Q110BM 'PROG 8 03690CSR TST,# COMP 'S' 54 03700CSR SETON 97 03710CSR EXCPT UPDATE CRTFILE 03720CSR SETOF 97 03730CSR 54 GOTO END 03740CSR Z-ADD0 RRN 50 03750CSR Z-ADD0 COUNT ÐÐ03760CSR MOVE '120001' W6A 6 03770CSR EXITFQXYPOS POS CURSOR 03780CSR RLABL W6A 03790CSR SETON 95 03800CSR EXCPT HELP COMMENTS 03810CSR SETOF 95 03820CSR MOVE ' ' BLK12 12 03830CSR ENDSR 03840C******************************************************************** 03850CSR SR102 BEGSR 03860C* RIGHT ADJUST ROUTINE. 03870CSR Z-ADD10 W2N 20 03880CSR EXIT SUBRAJ 03890CSR RLABL W2N 03900CSR RLABL W10A 03910CSR ENDSR 03920O******************************************************************** 03930OTERM132 E 71 03940O DIV 132 03950O E 71 03960O* PUT HEADINGS 03970O 70 'SUMMARY PARTS LIST' 03980O 112 'QTY-PER' 03990O 125 'EXT' 04000O 132 'LINE' ÐÐ04010O*------------------------------------------------------------------- 04020O E 71 04030O 12 'COMPONENT' 04040O 62 'NEXT-ASSY' 04050O 98 'TOP-ASSY' 04060O 113 'NEXT-ASSY' 04070O 125 'QTY' 04080O 132 'NUMB' 04090O*------------------------------------------------------------------- 04100O E 71 04110O 1 ' ' 04120O*------------------------------------------------------------------- 04130O E 74 04140O TOTQTY2B 125 04150O 132 'TOTAL' 04160O E 74 04170O 1 ' ' 04180O*------------------------------------------------------------------- 04190O E 81 04200O* DISPLAY SUSPENSE RECORD DATA. 04210O TCPN 12 ' - - ' 04220O CDESCR 43 04230O TAPN 57 ' - - ' 04240O ADESCR 88 04250O TTPN 102 ' - - ' ÐÐ04260O TQTYP 2 113 04270O TQTYE 2 125 04280O RRN Z 132 04290O*------------------------------------------------------------------- 04300O E 73 04310O NULL 132 04320O MGTEXT 35 04330O 37 ' ' 04340O*------------------------------------------------------------------- 04350O E 95 04360O 27 '\H = HELP' 04370O E 95 04380O 36 '\B = LIST BACKWARD' 04390O E 95 04400O 35 '\F = LIST FORWARD' 04410O E 95 04420O 40 '\JF# = JUMP FRWD # LINES' 04430O E 95 04440O 40 '\JB# = JUMP BKWD # LINES' 04450O E 95 04460O 27 '\E = EXIT' 04470O E 95 04480O 22 '\1 =' 04490O 46 'LIST FROM FRONT OF FILE' 04500O E 95 ÐÐ04510O 22 '\2 =' 04520O 44 'LIST FROM END OF FILE' 04530O E 95 04540O 22 'RETURN =' 04550O 39 'CONTINUE LISTING' 04560O E 95 04570O BIT,28 1 04580O 8 '8120037' 04590O**************************************************************** 04600OCRTFILE E 97 04610O PROG 26 04620O CRTIME 33 04630O CRDATE 37 04640O LNK 79 04650O******************************************************************* ** NUL ARRAY 004660 004670** A12 ARRAY 004680 004690** A29 ARRAY 004700 004710** DIV ARRAY 004720 004730** LNK 04740 04750ÐÐ/* 04760_‚ ÐÐ_‚_‚ 04760_‚ ÐÈ(K±  XESCI P999999120282(èÈÐ SUBROUTINE ZESCI 00010* CLEAR LINES BELOW CURSOR - DATAGRAPHIX 00020 INTEGER IBUF (66) 00030 ILU=0 00040 IXY=-1 00050 N1=132 00060 N2=0 00070 ITC=0 00080 DO 10 I=1, 66 00090 10 IBUF(I) = $0000 00100 IBUF(1) = $1B49 00110 DO 20 I=1, 5 00120 CALL WTREAD (ILU,IXY,IBUF,N1,IXY,IBUF,N2,ITC) 00130 20 IBUF (1) = $0000 00140 RETURN 00150 END 00160_‚ ÐÐ_‚_‚ SUBROUTINE ZESCI 00010* CLEAR LINES BELOW CURSOR - DATAGRAPHIX 00020 INTEGER IBUF (66) 00030 ILU=0 00040 IXY=-1 00050 N1=132 00060 N2=0 00070 ITC=0 00080 DO 10 I=1, 66 00090 10 IBUF(I) = $0000 00100 IBUF(1) = $1B49 00110 DO 20 I=1, 5 00120 CALL WTREAD (ILU,IXY,IBUF,N1,IXY,IBUF,N2,ITC) 00130 20 IBUF (1) = $0000 00140 RETURN 00150 END 00160_‚ ÐÈ(ôK½ ôÑX025WM P999999120282(èÈÐ00010H Q025WM00020F* UPDATE SFMAST WITH WORK ORDER RECORDS GENERATED 00030F* BY Q019WM. THEN EXPLODE COMPONENT RQMTS. (X025WM) 00040F* REVISED 10-31-81 2:00 PM 00050FBITTAB IP F 33 DISK 00060FCALENDARIC F 22R 7AI 1 DISK 00070FWMMAST IC F 470R 6AI 1 DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FALTKEY O F 32 29AI 1 DISK A 00100FTERMFILEIC F 256R 8AI 1 DISK 00110FSFMAST O F 128 29AI 1 DISK A 00120E******************************************************************** 00130E BIT 33 1 00140E TWO 40 6 A 00150E WA$ 6 11 3 00160E WMQ 26 7 0A 00170E WMD 26 6 0 00180E WLT 26 3 0 00190E PLT 8 3 0 00200I******************************************************************** 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************** 00240IWMMAST WM 00250I* WORK ORDER MASTER. ÐÐ00260I* WORK ORDER # 6A 00270I 1 6 WMWO 00280I* DESCRIPTION 40A 00290I 7 46 WMDESC 00300I 7 26 WM20 00310I* COST ARRAY (ACTUAL $) 11.3P X 6 00320I* 1 = LABOR 00330I* 2 = LABOR BURDEN 00340I* 3 = MATERIAL 00350I* 4 = MATERIAL BURDEN 00360I* 5 = NOT USED 00370I* 6 = NOT USED 00380I P 47 82 WA$ 00390I* TRANSFERRED TO STORES $ 11.3P 00400I P 83 883WMSTK$ 00410I* VARIANCE TAKEN $ 11.3P 00420I P 89 943WMVAR$ 00430I* QTY RECEIVED 7P 00440I P 95 980WMQRCD 00450I* SCHEDULE. 00460I* DATES 6N X 26 00470I 99 254 WMD 00480I* QTYS 7P X 26 00490I P 255 358 WMQ 00500I* LEADTIMES 26 X 3P ÐÐ00510I P 359 410 WLT 00520I* CLOSE DATE 6N 00530I 411 4160WMCLOS 00540I* QTY RELEASED 7P 00550I P 417 4200WMQREL 00560I* PART NO. 10N 00570I 422 4310WMPN 00580I* DRAWING REV. 2A 00590I 432 433 WMREV 00600I* UPDATE COUNTER 3P 00610I* INCREMENTED BY 1 EACH TIME 00620I* RECORD UPDATED BY Q009WM. 00630I P 434 4350WMCHG 00640I* DATE LAST TRAN 6N 00650I 436 4410WMDLT 00660I* ALTERNATE BILL MATL 10N 00670I 444 4530WMABM 00680I* RECORD STATUS 1A 00690I 470 470 WMSTAT 00700I******************************************************************** 00710IPMMST2 PM 00720I P 113 128 PLT 00730I******************************************************************** 00740I*FMAST SF 00750I* SCHEDULE MASTER. ÐÐ00760I* COMMON FIELDS. 00770I* KEY AREA. 00780I* 1 29 SFKEY 00790I* PART NO. 10N 00800I* 1 100SFPN 00810I* DATE DUE 6N (YMD) 00820I* 11 160SFDUE 00830I* RECORD CODE 2N 00840I* 10 = RECEIVED PO 00850I* 20 = REL WO 00860I* 30 = PURCHASE ORDER 00870I* 40 = PLAN WO 00880I* 50 = PURCHASE REQ 00890I* 60 = SALES ORDER-BACKLOG 00900I* 70 = REL REQUIREMENT 00910I* 80 = PLAN REQUIREMENT 00920I* 90 = RUN RELEASE 00930I* 17 180SFREC 00940I* ORDER NO. 00950I* 19 29 SFORD 00960I* PREFIX 1A 00970I* 19 19 SFPRFX 00980I* PRIME 6A 00990I* 19 24 SFPRIM 01000I* ITEM 3N ÐÐ01010I* 25 270SFITEM 01020I* RECEIVING LOG # 2N 01030I* 28 290SFRLOG 01040I* QUANTITY 7P 01050I* P 30 330SFQTY 01060I* QTY COMPLETE 7P 01070I* P 34 370SFQTYC 01080I* DATE LAST TRAN 6N (YMD) 01090I* 38 430SFDLT 01100I* CUST #/DEPT #/VEND # 5P 01110I* P 44 460SFCUST 01120I* PLAN/REL REQMTS. 01130I* NEXT ASSY PART # 10N 01140I* 47 560SFNAPN 01150I* QTY PER ASSY 7P 01160I* P 57 600SFQPA 01170I* ISSUE CODE 2A 01180I* 61 62 SFISSU 01190I* PULL # 3P 01200I* P 63 640SFPULL 01210I* ASSY REVISION 2A 01220I* 65 66 SFREV 01230I* ASSY WO QTY 7P 01240I* P 67 700SFQTYA 01250I* BACKORDER FLAG ÐÐ01260I* 105 105 SFBOF 01270I* SALES ORDERS 01280I* CUST P.O. 20A 01290I* 71 90 SFCPO 01300I* UNIT PRICE 9.3P 01310I* P 91 953SFPRIC 01320I* BACKORDER FLAG 1A -- SEE ABOVE 01330I* PURCH ORDERS 01340I* VENDOR NAME 20A 01350I* SEE SFCPO UNDER SALES ORDERS. 01360I* UNIT PRICE 9.3P 01370I* SEE SFPRIC UNDER SALES ORDERS. 01380I* PACKING SLIP 9A 01390I* 96 104 SFPKGS 01400I* WORK ORDERS 01410I* DEPT NAME 20A 01420I* SEE SFCPO UNDER SALES ORDERS. 01430I* OPER SEQ # 3P 01440I* P 96 970SFSEQ 01450I* START DATE 6N 01460I* 98 1030SFSTRT 01470I* PULL # 3P 01480I* SEE PLAN/REL REQMTS. 01490I* REVISION 2A 01500I* SEE PLAN/REL REQMTS. ÐÐ01510I* AVAIL STOCK BAL 79 01520I* P 120 1230SFSAVQ 01530I* AVAIL QTY 7P 01540I* P 124 1270SFAVQ 01550I* RECORD STATUS 1A 01560I* 128 128 SFSTAT 01570I******************************************************************** 01580ICALENDARCA 20 1 CC 01590I* CALENDAR DATE RECORD. 01600I 2 30CAYR 01610I 4 50CAMO 01620I 6 70CADAY 01630I 2 70CACAL 01640I 14 170CAMDAY 01650I 18 200CAWK 01660I 21 220CADOW 01670I*------------------------------------------------------------------- 01680I CB 21 1 CM 01690I* MFG DATE RECORD. 01700I 4 70CAMDAY 01710I 8 90CAYR 01720I 10 110CAMO 01730I 12 130CADAY 01740I 8 130CACAL 01750I 18 200CAWK ÐÐ01760I 21 220CADOW 01770I*------------------------------------------------------------------- 01780I GG 03 01790I**************************************************************** 01800ITERMFILETF 01810I* WORK ORDER #'S 6A X 40 01820I 9 248 TWO 01830C******************************************************************** 01840C* INITIALIZE 1-TIME. 01850C N79 EXSR SR101 01860C MOVE ' ' BLK6 6 STUPIDITY 01870C Z-ADD0 ZERO7 70 STUPIDITY 01880C MOVELPORT KEY 8 01890C MOVEL'EW' W6A 6 01900C MOVE W6A KEY 01910C Z-ADD0 TCOUNT 40 01920C*------------------------------------------------------------------- 01930C START TAG 01940C 1 ADD TCOUNT TCOUNT 01950C MOVE TCOUNT KEY 01960C KEY CHAINTERMFILE 54 01970C 54 GOTO END 01980C Z-ADD1 T 30 01990C*------------------------------------------------------------------- 02000C TAG10 TAG ÐÐ02010C BLK6 LOKUPTWO,T 54 02020C N54 GOTO START 02030C TWO,T CHAINWMMAST 54 02040C MOVE BLK6 TWO,T 02050C 54 GOTO TAG10 02060C EXSR SR88 GET PART MAST 02070C Z-ADD1 W 30 02080C*------------------------------------------------------------------- 02090C TAG20 TAG 02100C ZERO7 LOKUPWMQ,W 54 02110C N54 GOTO TAG10 02120C EXSR SR83 UPDATE SFMAST 02130C EXSR SR84 UPDATE AK-ORD 02140C EXSR SR85 UPDATE AK-DUE 02150C EXSR SR86 UPDATE AK-START 02160C SETON 70 02170C 1 ADD W W 02180C W COMP 26 54 02190C N54 GOTO TAG20 02200C GOTO TAG10 02210C*------------------------------------------------------------------- 02220C END TAG 02230C 70 MOVEL'Q027WM' PROG 8 EXPLODE REQUIREMENTS 02240C N70 MOVEL'Q070DP' PROG RET TO MENU 02250C EXITFCHAIN ÐÐ02260C RLABL PROG 02270C******************************************************************** 02280CSR SR83 BEGSR 02290C* ADDSFMAST. 02300CSR EXSR SR201 CALC START DATE 02310CSR SETON 83 02320CSR EXCPT SFMAST 02330CSR SETOF 83 02340CSR ENDSR 02350C******************************************************************** 02360CSR SR84 BEGSR 02370C* ADD ALTKEY-ORDER. 02380CSR SETON 84 02390CSR EXCPT AK-ORDER 02400CSR SETOF 84 02410CSR ENDSR 02420C******************************************************************** 02430CSR SR85 BEGSR 02440C* ADD ALTKEY-DUE. 02450CSR SETON 85 02460CSR EXCPT AK-DUE 02470CSR SETOF 85 02480CSR ENDSR 02490C******************************************************************** 02500CSR SR86 BEGSR ÐÐ02510C* ADD ALTKEY-START. 02520CSR SETON 86 02530CSR EXCPT AK-START 02540CSR SETOF 86 02550CSR ENDSR 02560C******************************************************************** 02570CSR SR87 BEGSR 02580C* GET CALENDAR FILE. 02590CSR W7A CHAINCALENDAR 60 02600CSR ENDSR 02610C******************************************************************** 02620CSR SR88 BEGSR 02630C* GET PART MASTER. 02640CSR MOVELWMPN W12A 12 02650CSR MOVE ' ' W12A 02660CSR W12A CHAINPMMST2 54 02670CSR XFOOTPLT TOTLT 30 02680CSR ENDSR 02690C******************************************************************** 02700CSR SR101 BEGSR 02710C* 1-TIME INIT. 02720CSR SETON 79 02730CSR Z-ADD0 ZERO5 50 02740CSR Z-ADD0 ZERO3 30 02750CSR MOVE ' 'W8A 8 ÐÐ02760CSR Z-ADD0 W1N 10 02770CSR Z-ADD0 W2N 20 02780CSR MOVE ' ' W2A 2 02790CSR EXITFPGMINX 02800CSR RLABL W8A 02810CSR RLABL W1N 02820CSR RLABL W2N 02830CSR RLABL W2A 02840CSR MOVE W2A PORT 20 02850CSR PORT COMP 0 54 02860CSRN54 Z-ADD25 PORT 02870CSR MOVELUDATE W4N 40 02880CSR MOVE UDATE W2N 20 02890CSR MOVELW2N TODAY 60 02900CSR MOVE W4N TODAY 02910C* 02920CSR ENDSR 02930C* 02940C* 02950C* 02960C******************************************************************** 02970CSR SR201 BEGSR 02980C* CALCULATE START DATE. 02990CSR MOVE WMD,W W7A 7 03000CSR MOVEL'C' W7A ÐÐ03010CSR EXSR SR87 GET CALENDAR 03020CSR WLT,W COMP 0 54 03030CSRN54 Z-ADDTOTLT WLT,W 03040CSR CAMDAY SUB WLT,W W6N 60 54 03050CSRN54 Z-ADD1 W6N 03060CSR MOVE W6N W7A 03070CSR MOVEL'M' W7A 03080CSR EXSR SR87 GET CALENDAR 03090CSR 60 Z-ADDTODAY START 60 03100CSR Z-ADDCACAL START 03110CSR ENDSR 03120O******************************************************************** 03130OSFMAST EADD 83 03140O WMPN 10 03150O WMD,W 16 03160O 18 '40' 03170O WMWO 24 03180O 29 '00000' 03190O WMQ,W 33P 03200O ZERO7 37P 03210O TODAY 43 03220O ZERO5 46P 03230O ZERO3 97P 03240O START 103 03250O 128 'A' ÐÐ03260O******************************************************************** 03270OALTKEY EADD 84 03280O* ORDER KEY. 03290O 2 'A4' 03300O WMWO 8 03310O 13 '00000' 03320O WMPN 23 03330O WMD,W 29 03340O 32 'A' 03350O*------------------------------------------------------------------- 03360O EADD 85 03370O* 03380O 32 'B4' 03390O WMD,W 8 03400O WMWO 14 03410O 19 '00000' 03420O WMPN 29 03430O 32 'A' 03440O*------------------------------------------------------------------- 03450O EADD 86 03460O* 03470O 2 'E4' 03480O START 8 03490O WMPN 18 03500O WMWO 24 ÐÐ03510O 29 '00000' 03520O 32 'A' /* 03530_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(úL úiX045PM Pò120282120282(èÈÐ00010H Q045PM00020F* PUT PART #, FORECAST QTY,INV CLASS TO FLOPPY FOR UNIVAC. (X045PM) 00030F* REVISED 8-19-82 3:25 PM. 00040F* 00050F* NOTE: PRINT COND BY SWITCH-3 00060F* 00070FPMADRT IR F 4 3IT EDISK 00080FPMMST2 IP F 674R I DISK 00090FFLOPPY O F 122 17 U1 00100F KEBCDIC 00110FPRINT O F 132 PRINTER U3 00120FTERM70 O F 70 5 00130FABCOUT O F 12 DISK 00140E************************************************************************* 00150E PMADRT PMMST2 00160E AR 1 61 2 00170I*********************************************************************** 00180IPMMST2 PM 01 674NCD 00190I 1 100PMPN 00200I 31 59 PMDESC 00210I 94 94 PMSC 00220I P 315 3180PMFRCB 00230I 19 30 PMMODL 00240I P 425 4287PMRATO 00250I P 489 4933PMOSUC ÐÐ00260I GG 02 00270C*********************************************************************** 00280C COUNT COMP 0 54 00290C N54 GOTO TAG20 00300C MOVE ' ' AR 00310C Z-ADD17 TIMES 30 00320C EXSR SR102 00330C*------------------------------------------------------------------- 00340C TAG20 TAG 00350C 01 PMSC COMP 'P' 01 00360C 01 PMFRCB COMP 0 01 00370C N01 GOTO END 00380C PMOSUC MULT PMFRCB COST 102H 00390C PMRATO ADD CUMRAT CUMRAT 88 00400C CUMRAT COMP LSTRAT 54 00410C N54 Z-ADD.99999999 CUMRAT 00420C Z-ADDCUMRAT LSTRAT 88 00430C COST ADD CUMCST CUMCST 102 00440C 1 ADD RRN RRN 40 00450C MOVELCUMRAT W8N 80 00460C MOVE 'C' CLASS 00470C W8N COMP 80000001 74 LT 00480C W8N COMP 95000001 75 LT 00490C 74 MOVE 'A' CLASS 1 00500C 75N74 MOVE 'B' CLASS ÐÐ00510C 1 ADD COUNT COUNT 40 00520C Z-ADDPMFRCB W6N 60 00530C*------------------------------------------------------------------- 00540C END TAG 00550C COUNT COMP 1800 54 00560C 54 Z-ADD0 COUNT 00570C 54 Z-ADD1 TIMES 00580C 54 MOVE '?*' AR 00590C 54 EXSR SR102 00600C*-------------------------------------------------------------------- 00610CLR Z-ADD1 TIMES 00620CLR MOVE '?*' AR 00630CLR EXSR SR102 00640C***************************************************************** 00650CSR SR102 BEGSR 00660CSR Z-ADD0 DONE 30 00670C*----------------------------------------------------------------- 00680CSR T102A TAG 00690CSR SETON 84 00700CSR EXCPT PUT AR TO FLOPPY 00710CSR SETOF 84 00720CSR 1 ADD DONE DONE 00730CSR DONE COMP TIMES 54 54 00740CSRN54 GOTO T102A 00750CSR ENDSR ÐÐ00760O**************************************************************** 00770OTERM70 E 85 00780O 24 'MOUNT NEW FLOPPY DISK ' 00790O******************************************************************** 00800OFLOPPY D 01 00810O PMPN 10 00820O W6N 16 00830O CLASS 17 00840O 82 '1' 00850O*--------------------------------------------------------------------- 00860O E 84 00870O AR 122 00880O 82 '1' 00890O******************************************************************** 00900OABCOUT D 01 00910O PMPN 10 00920O CLASS 12 00930O********************************************************************* 00940OPRINT D 01 U3 00950O PMPN 12 ' - - ' 00960O PMRATO2 25 00970O CUMRAT2 45 00980O W8N 56 00990O CLASS 61 01000O****************************************************************** ÐÐ** AR ARRAY 01010 01020/* 01030_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ŠLù ŠX016BM P120282120282(èÈÐ00010H Q016BM00020F* INDENTED PARTS LIST - COMPLETE. (X016BM) 00030F* REVISED 4/07/81 3:25 PM. DG-REL006 OK. *** D I A B L O *** 00040FBITHEX IP F 256 DISK 00050FCRTFILE UC F 256R DISK 00060FSUSPENSEUD F 128L29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST ID F 86L20AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FEMPLFILEIC F 64R14AI 1 DISK 00110FMENUDEPTIT F 25 EDISK 00120E******************************************************************** 00130E MENUDEPT TABDEP 1 10 5 0 TABNAM 20 DEPT NAMES 00140E A12 12 12 1 A INPUT ARRAY. 00150E LEV 1 20 20 NEXT RRN AT EA LEVEL 00160E QTY 1 20 7 0 QTY MULTIPLIER 00170E A29 29 29 1 00180E BIT 256 1 BITHEX. 00190E APN 8 10 0A SUSPENSE FILE 00200E QAR 8 3 0 SUSPENSE FILE 00210E REC 132 1 00220E PLT 8 3 0 00230I******************************************************************** 00240IBITHEX BT 00250I 1 256 BIT ÐÐ00260I******************************************************************** 00270ICRTFILE CR 00280I* EMPLOYEE # 5N 00290I 1 50CREMPL 00300I* DEPT # 5N 00310I 14 180CRDEPT 00320I 81 212 REC 00330I******************************************************************** 00340IEMPLFILEEE 00350I 23 42 EENAME 00360I******************************************************************** 00370ISUSPENSESP 00380I* SUSPENSE FILE (CONTAINS ASSY PART NO'S.) 00390I* KEY AREA. 00400I* TERMINAL # 2N (NOT USED) 00410I* 1 2 00420I* RECORD CODE 2A (IP) 00430I 3 4 SPREC 00440I* RECORD COUNTER 3N 00450I 5 70SPCNTR 00460I* REQUESTED BY DEPT 5N 00470I 8 120SPDEPT 00480I* EMPLOYEE # 5A 00490I 13 17 SPEMPL 00500I* FILLER 18 29 FFFFFF ÐÐ00510I* ASSY PART # 10N X 8 00520I 30 109 APN 00530I* QTYS 3P X 8 00540I P 110 125 QAR 00550I* RECORD STATUS 1A 00560I 128 128 SPSTAT 00570I******************************************************************** 00580IPMMST2 PM 00590I* PART MASTER RECORD. 00600I* KEY AREA 00610I* PART NO. 12A 00620I 1 12 PMPN 00630I* NUMB OF COMPONENTS 3P 00640I P 13 140PMNOBM 00650I* PROD LINE 4N 00660I 15 180PMPL 00670I* MODEL NAME 12A 00680I 19 30 PMMODL 00690I* DESCRIPTION 29A 00700I 31 59 PMDESC 00710I* COMMODITY CODE 9P 00720I P 60 640PMCC 00730I* ENG CHANGE STATUS. 00740I* CUR CHG LEVEL 2A 00750I 70 71 PMECHG ÐÐ00760I* CUR CHG DATE 6N 00770I 72 770PMDCHG 00780I* LAST ECN NO. 5A 00790I 65 69 PMECN 00800I* DRAWING INFO 00810I* DWG SIZE 1A 00820I 82 82 PMSIZ 00830I* DWG CLASS 1A 00840I* D = DYNAIR DWG 00850I* V = VENDOR DWG 00860I 83 83 PMDCLS 00870I* STANDARD CODE 1A 00880I 84 84 PMSTDC 00890I* DWG REL CODE 1A 00900I* E = ENG ONLY 00910I* M = REL TO MFG 00920I* P = PROTOTYPE 00930I 78 78 PMDREL 00940I* UNIT MEAS 2A 00950I* EA = EACH OC = OUNCE 00960I* ST = SET TC = TROY OUNCE 00970I* IN = INCH LB = POUND 00980I* FT = FEET PT = PINT 00990I* YD = YARD QT = QUART 01000I* SI = SQ.INCH GL = GALLON ÐÐ01010I* SF = SQ.FEET DR = DRUM 01020I* SY = SQ.YARD 01030I 85 86 PMUM 01040I* SOURCE CODE 2A 01050I* MA = MFG ASSY 01060I* MP = MFG PART 01070I* PA = PURCH ASSY 01080I* PP = PURCH PART 01090I* RS = RAW STOCK 01100I 94 95 PMSC 01110I* PROVISIONING CODE 1A 01120I* A = FORECAST,NO VALUE ADDED 01130I* B = FORECAST,VALUE ADDED 01140I* C = BUILD TO ORDER (B) 01150I* D = BUILD TO ORDER (NOT B) 01160I* E = CUSTOM 01170I* Y = OBSOLETE,REPAIRABLE 01180I* Z = OBSOLETE,NOT REPAIRABLE 01190I 96 96 PMPROV 01200I* ISSUE CODE 2A 01210I* PT = PULL TIME 01220I* OR = ON REQUEST 01230I* BI = BULK ISSUE 01240I* AR = AS REQUIRED 01250I* VS = VENDOR SUPPLIED ÐÐ01260I* SD = SHIPPING DOCUMENT 01270I* TD = TRAV DOCUMENT 01280I* RD = REF DOCUMENT 01290I* RA = REF ASSY 01300I 97 98 PMISSU 01310I* DELIVER TO DEPT 5P 01320I P 99 1010PMDEL 01330I* RESPONSIBILITY CODES 01340I* ENGR CODE 2A 01350I 102 103 PMEGR 01360I* PLANNER CODE 2A 01370I 104 105 PMPLNR 01380I* BUYER CODE 2A 01390I 106 107 PMBUYR 01400I* SALESMAN CODE 2A 01410I 108 109 PMSLSM 01420I* INVENTORY ACCOUNT 5P 01430I P 110 1120PMACNT 01440I* LEAD TIMES 8 X 3P 01450I P 113 128 PLT 01460I* FAB CODE 2A 01470I 487 488 PMFABC 01480I* RECORD STATUS 1A 01490I* D = DELETED 01500I 674 674 PMSTAT ÐÐ01510I******************************************************************** 01520IBMMAST BM 01530I* BILL OF MATERIAL RECORD 01540I* KEY AREA 01550I* ASSY PART NO. 10N 01560I 1 100BMAPN 01570I* COMPONENT PART # 10N 01580I 11 200BMCPN 01590I* ITEM NO. 3N 01600I 25 270BMITNO 01610I* QTY PER ASSY 7P 01620I P 28 310BMQTY 01630I* SCRAP ALLOW .2N 01640I 34 352BMSCRP 01650I* ISSUE CODE 2A 01660I* PT = PULL TIME 01670I* OR = ON REQUEST 01680I* BI = BULK ISSUE 01690I* AR = AS REQUIRED 01700I* RA = REF ASSY 01710I* TD = TRAV DOC 01720I* SD = SHIP DOC 01730I* RD = REF DOC 01740I* VS = VENDOR SUPPLIED 01750I 36 37 BMISSU ÐÐ01760I* EFFECTIVITY. 01770I* BEGIN CHANGE LEVEL 2A 01780I 38 39 BMBCHG 01790I* ENDING CHANGE LEVEL 2A 01800I 40 41 BMECHG 01810I* BEGIN ECN # 5A 01820I 42 46 BMBECN 01830I* ENDING ECN # 5A 01840I 47 51 BMEECN 01850I* DISPOSITION CODE 1A 01860I* U = USE UP OLD STYLE 01870I* N = NOW (IMMEDIATE) 01880I 52 52 BMDISP 01890I* FILLER 5A 53 57 FFFFFF 01900I* ROUTING. 01910I* OPER NO. 5P 01920I P 58 600BMOPER 01930I* DEPT NO. 5P 01940I P 61 630BMDEPT 01950I* WORK CENTER NO. 3P 01960I P 64 650BMWC 01970I* COMPONENT OPER REFERENCE INFO 10A 01980I 66 75 BMREF 01990I* FILLER 10A 76 85 FFFFFF 02000I* ÐÐ02010I* RECORD STATUS 1A 02020I* D = DELETED 02030I 86 86 BMSTAT 02040I******************************************************************** 02050IMGFILE MG 02060I* MESSAGE FILE. 02070I* TEXT 35A 02080I 1 35 MGTEXT 02090I* LINE-2 35A 02100I 36 70 MGLIN2 02110I* PROG NAME 5A 02120I 71 75 MGPROG 02130C******************************************************************** 02140C* INITIALIZE 02150C EXSR SR101 INIT 02160C H9 GOTO ENDJOB PROG ERROR 02170C Z-ADD0 ZERO10 100 STUPIDITY 02180C*---------------------------------------------------------------- 02190C START TAG 02200C* GET ASSY PART NO FROM SUSPENSE. 02210C MOVE ' ' A29 02220C MOVEA'IP' A29,3 02230C MOVEAA29 W29A 29 02240C*------------------------------------------------------------------- 02250C TAG5 TAG ÐÐ02260C W29A SETLLSUSPENSE 02270C*------------------------------------------------------------------- 02280C TAG6 TAG 02290C SETOF 54 02300C READ SUSPENSE 54 02310C 54 GOTO ENDJOB 02320C SPREC COMP 'IP' 54 02330C N54 GOTO ENDJOB 02340C SPSTAT COMP 'D' 54 02350C 54 GOTO TAG6 02360C ZERO10 LOKUPAPN 54 02370C N54 GOTO TAG7 02380C EXSR SR77 TITLE PAGE 02390C*------------------------------------------------------------------- 02400C TAG7 TAG 02410C Z-ADD1 C 30 02420C ZERO10 LOKUPAPN,C 54 02430C N54 SETON 81 02440C N54 EXCPT UPDATE SUSPENSE 02450C N54 SETOF 81 02460C N54 GOTO TAG6 02470C Z-ADDAPN,C ASSYPN 100 02480C Z-ADD0 APN,C 02490C MOVE BLK12 W12A 02500C MOVELASSYPN W12A ÐÐ02510C EXSR SR81 GET PMMST. 02520C N60 GOTO TAG10 GOT IT 02530C Z-ADD302 M 96 FLAG ERROR 02540C EXSR SR73 PUT MSG 02550C GOTO TAG7 02560C*-------------------------------------------------------------------- 02570C TAG10 TAG 02580C* FLAG NO COMPONENTS ON FILE 02590C PMNOBM COMP 0 55 02600C N55 Z-ADD316 M 50 02610C N55 EXSR SR73 PUT ERR MSG 02620C N55 GOTO TAG7 02630C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02640C XFOOTPLT TPLT 40 02650C Z-ADDQAR,C QTY,2 QTY MULTIPLIER 02660C Z-ADD0 QAR,C 02670C Z-ADD0 EGAP 02680C SETON 89 02690C EXSR SR71 PUT HEADING 02700C SETOF 89 02710C* SET-UP INITIAL BILL MATERIAL READ 02720C Z-ADD3 L 20 INDENTURE LEVEL 02730C MOVE BLK20 LEV 02740C MOVELASSYPN LEV,2 02750C*----------------------------------------------------------------- ÐÐ02760C TAG20 TAG 02770C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02780C L SUB 1 L 54 INDENT LEVEL 02790C N54 GOTO ENDASY BOTTOM INDENT 02800C LEV,L COMP BLK20 54 02810C N54 GOTO TAG20 NONE THIS LEVEL 02820C MOVE LEV,L W20A 20 02830C MOVELLEV,L CURASY 100 MATCH PART # 02840C MOVE BLK20 LEV,L 02850C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02860C*------------------------------------------------------------------ 02870C TAG30 TAG 02880C* SET-UP NEXT READ 02890C W20A SETLLBMMAST 02900C*--------------------------------------------------------------- 02910C TAG40 TAG 02920C* GET NEXT COMPONENT. 02930C SETOF 54 02940C READ BMMAST 54GET COMPONENT 02950C 54 GOTO TAG20 END OF FILE 02960C BMAPN COMP CURASY 54 02970C N54 GOTO TAG20 WRONG ASSY 02980C BMSTAT COMP 'D' 54 02990C 54 GOTO TAG40 DELETED RECORD 03000C* DISPLAY COMPONENT DATA ÐÐ03010C EXSR SR72 DISPLAY DATA 03020C* BRANCH IF NOT ASSY 03030C PMNOBM COMP 0 54 03040C N54 GOTO TAG40 NOT ASSY 03050C*------------------------------------------------------------------ 03060C TAG50 TAG 03070C* SAVE CUR LEVEL ASSY/COMPONENT PART # 03080C MOVELBMAPN LEV,L 03090C 1 ADD BMCPN W10N 100 03100C MOVE W10N LEV,L 03110C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 03120C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 03130C MOVE BMCPN CURASY 03140C MOVELBMCPN W20A 03150C MOVE ZERO10 W20A 03160C 1 ADD L L INDENT LEVEL 03170C GOTO TAG30 03180C*------------------------------------------------------------------ 03190C ENDASY TAG 03200C* END OF ASSY PROMPT 03210C EXSR SR76 END ASSY PROMPT 03220C GOTO TAG7 03230C*----------------------------------------------------------------- 03240C END TAG 03250C GOTO TAG6 ÐÐ03260C*------------------------------------------------------------------ 03270C ENDJOB TAG 03280C EXSR SR68 TOP FORM 03290C EXSR SR68 TOP FORM 03300C******************************************************************** 03310CSR SR68 BEGSR 03320C* TOP OF FORM. 03330CSR EXITFQTOPF TOP FORM 03340CSR 1 ADD EGAP EGAP 40 03350CSR ENDSR 03360C******************************************************************** 03370CSR SR69 BEGSR 03380C* PUT DATA TO DIABLO. 03390CSR EXSR SR201 LF/CR 03400CSR PORT CHAINCRTFILE H9 03410CSR H9 GOTO END69 03420CSR MOVE ' ' REC 03430CSR EXCPT UPDATE CRTFILE 03440CSR PORT CHAINCRTFILE H9 03450CSR H9 GOTO END69 03460CSR MOVEAREC W148A 148 03470CSR EXITFZD148 PUT DIABLO 03480CSR RLABL W148A 03490CSR MOVELBIT,1 BUFLGT 2 03500CSR SETOF 717275 ÐÐ03510CSR SETOF 414243 03520CSR SETOF 767374 03530CSR SETOF 77 03540CSR END69 ENDSR 03550C******************************************************************** 03560CSR SR71 BEGSR 03570C* CLEAR CRT. PUT HEADINGS. 03580CSR MOVELASSYPN W12A 12 03590CSR MOVE ' ' W12A 03600CSR EXSR SR81 GET TOP-ASSY PMMST2 03610CSR EXSR SR68 TOP OF FORM 03620CSR SETON 41 03630CSR EXSR SR69 PUT HEADING 03640CSR SETON 42 03650CSR EXSR SR69 PUT HEADING 03660CSR SETON 43 03670CSR EXSR SR69 PUT HEADING 03680CSR EXSR SR201 LINE FEED 03690CSR SETON 75 03700CSR EXSR SR69 PUT TOP ASSY 03710CSR ENDSR 03720C******************************************************************** 03730CSR SR72 BEGSR 03740C* DISPLAY DATA LINE TO CRT. 03750CSR MOVE BLK12 W12A ÐÐ03760CSR MOVELBMCPN W12A COMP PN 03770CSR EXSR SR81 GET PMMST2 03780CSR L COMP 1 0101 03790CSR L COMP 2 02 03800CSR L COMP 3 03 03810CSR L COMP 4 04 03820CSR L COMP 5 05 03830CSR L COMP 6 06 03840CSR L COMP 7 07 07 03850CSR 01 Z-ADD1 L 03860CSR BMISSU COMP ' ' 55 03870CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03880CSR XFOOTPLT LEAD 40 03890CSR SETON 72 03900CSR EXSR SR69 PUT DATA. 03910CSR COUNT COMP 60 54 54 03920CSRN54 GOTO END72 NOT END PAGE 03930CSR EXSR SR71 PUT HEADINGS 03940CSR END72 ENDSR 03950C******************************************************************** 03960CSR SR73 BEGSR 03970C* PUT PROMPT TO CRT. 03980CSR EXSR SR89 03990CSR 54 MOVELM MGTEXT 04000CSR SETON 73 ÐÐ04010CSR EXSR SR69 PUT MSG. 04020CSR SETOF 73 04030CSR ENDSR 04040C******************************************************************** 04050CSR SR76 BEGSR 04060C* END OF ASSY PROMPT/READ. 04070CSR Z-ADD317 M 04080CSR EXSR SR73 PUT MSG. 04090CSR ENDSR 04100C******************************************************************** 04110CSR SR77 BEGSR 04120C* PRINT TITLE PAGE. 04130CSR EXITFQTOPF TOP FORM 04140CSR MOVE ' ' A29 04150CSR MOVE 'E' A29,1 04160CSR MOVEASPEMPL A29,2 04170CSR MOVEAA29 W14A 14 04180CSR W14A CHAINEMPLFILE 60 04190CSR 60 GOTO END77 04200CSR SPDEPT LOKUPTABDEP TABNAM 54 04210CSR MOVE TABNAM DEPNAM 17 04220CSR SETON 77 04230CSR EXSR SR69 PRINT 04240CSR END77 ENDSR 04250C******************************************************************** ÐÐ04260CSR SR81 BEGSR 04270C* GET PART MAST. 04280CSR SETOF 61 04290CSR W12A CHAINPMMST2 60 GET PMMST. 04300CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 04310CSR ENDSR 04320C******************************************************************** 04330CSR SR89 BEGSR 04340C* GET MGFILE. 04350CSR M CHAINMGFILE 54 GET MGFILE. 04360CSR 54 MOVE BLK35 MGTEXT 04370CSR 54 MOVELM MGTEXT 04380CSR 54 MOVE 'NO MSG' MGTEXT 04390CSR ENDSR 04400C******************************************************************** 04410CSR SR101 BEGSR 04420C* INITIALIZE (1-TIME). 04430CSR MOVE ' ' BLK35 35 04440CSR MOVE ' ' BLK12 12 04450CSR MOVE ' ' BLK20 20 04460CSR Z-ADD0 ZERO10 100 04470C* GET PORT # AND CRTFILE. 04480CSR MOVE ' ' W8A 8 04490CSR Z-ADD0 W2N 20 04500CSR Z-ADD0 W1N 10 ÐÐ04510CSR MOVE ' ' W2A 2 04520CSR EXITFPGMINX GET PORT #. 04530CSR RLABL W8A 04540CSR RLABL W2N 04550CSR RLABL W1N 04560CSR RLABL W2A 04570CSR MOVE W2A PORT 20 PORT NO. 04580CSR PORT COMP 0 54 04590CSRN54 Z-ADD25 PORT DEFAULT 04600CSR PORT CHAINCRTFILE H9 04610CSR H9 GOTO END101 04620CSR MOVE ' ' REC 04630CSR Z-ADD557 M 50 04640CSR EXSR SR73 MOUNT 15-PITCH MSG 04650CSR EXSR SR69 PAUSE 04660CSR Z-ADD558 M MOUNT 11X8-1/2 PAPER 04670CSR EXSR SR73 PUT MSG 04680CSR EXSR SR69 PAUSE 04690CSR MOVE '08' W2A 2 04700CSR EXITFZVMI SET VERTICAL SPACING 04710CSR RLABL W2A 04720CSR MOVE '15' W2A 04730CSR EXITFZHMI SET HORIZ SPACING 04740CSR RLABL W2A 04750CSR SETON 74 ÐÐ04760CSR EXCPT 04770CSR SETOF 74 04780CSR END101 ENDSR 04790C******************************************************************** 04800CSR SR201 BEGSR 04810C* LINE FEED/CAR RETURN. 04820CSR EXITFQCLF LF 04830CSR 1 ADD COUNT COUNT 30 04840CSR ENDSR 04850O******************************************************************** 04860OCRTFILE E 72 04870O* DATA LINE. 04880O REC 212 04890O 91 '.' 04900O 94 '.' 04910O 97 '.' 04920O 100 '.' 04930O 103 '.' 04940O 106 '.' 04950O 109 '.' 04960O 02 109 ' ' 04970O 03 109 ' ' 04980O L Z 82 04990O BMITNOZ 88 05000O 01 BMCPN 102 ' - - ' ÐÐ05010O 02 BMCPN 105 ' - - ' 05020O 03 BMCPN 108 ' - - ' 05030O 04 BMCPN 111 ' - - ' 05040O 05 BMCPN 114 ' - - ' 05050O 06 BMCPN 117 ' - - ' 05060O 07 BMCPN 120 ' - - ' 05070O PMDESC 151 05080O BMQTY 2 162 05090O PMUM 166 05100O PMSC 172 05110O PMISSU 178 05120O 55 BMISSU 178 05130O LEAD Z 185 05140O EXTQTY2 195 05150O PMSTDC 199 05160O PMFABC 205 05170O*------------------------------------------------------------------- 05180O E 75 05190O* PUT TOP ASSY LINE. 05200O REC 212 05210O 82 '1' 05220O ASSYPN 102 ' - - ' 05230O N89 109 'CONT''D' 05240O PMDESC 151 05250O 162 '1' ÐÐ05260O PMUM 166 05270O PMISSU 178 05280O PMSC 172 05290O TPLT Z 185 05300O 195 '1' 05310O PMSTDC 199 05320O PMFABC 205 05330O*------------------------------------------------------------------- 05340O E 73 05350O* PUT ERROR MESSAGE. 05360O REC 212 05370O MGTEXT 115 05380O 117 ' ' 05390O 96 BIT,8 212 05400O*------------------------------------------------------------------- 05410O E 41 05420O* CLEAR SCREEN - LINE-1. 05430O REC 212 05440O 151 'INDENTED PARTS LIST' 05450O 159 'ASSY=' 05460O ASSYPN 171 ' - - ' 05470O UDATE Y 88 05480O EGAP Z 212 05490O*------------------------------------------------------------------- 05500O E 42 ÐÐ05510O* HEADING, LINE-2. 05520O REC 212 05530O 106 '--------------INDENTURE' 05540O 120 '--------------' 05550O 162 'QUANTITY' 05560O 174 'SOURCE' 05570O 180 'ISSUE' 05580O 185 'LEAD' 05590O 195 'EXTENDED' 05600O 200 'STD' 05610O 206 'FAB' 05620O*------------------------------------------------------------------- 05630O E 43 05640O* HEADING, LINE-3. 05650O REC 212 05660O 83 'LEV' 05670O 88 'ITEM' 05680O 109 '1 2 3 4 5 6 7' 05690O 112 '-UP' 05700O 133 'DESCRIPTION' 05710O 162 'PER-ASSY' 05720O 166 'UM' 05730O 173 'CODE' 05740O 179 'CODE' 05750O 185 'TIME' ÐÐ05760O 195 'QUANTITY' 05770O 201 'CODE' 05780O 207 'CODE' 05790O*------------------------------------------------------------------- 05800O E 74 05810O REC 212 05820O*------------------------------------------------------------------- 05830O E 77 05840O REC 212 05850O EENAME 190 05860O DEPNAM 212 05870O******************************************************************** 05880OSUSPENSEE 81 05890O APN 109 05900O QAR 125P 05910O 128 'D' ** A12 ARRAY 005920 005930** LEV ARRAY 005940 005950** QTY ARRAY 005960 005970** A29 ARRAY 005980 005990/* 006000ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(^N ^’X016CF P120282120282(èÈÐ00010H Q016CF00020F* PRINT LABELS, SELECTED, BY ZIP CODE (DIABLO). (X016CF) 00030F* REVISED 2/29/80 10:15 AM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FCFKEYOUTIS F 59 59 DISK 00060FCFMAST IC F 370R15AI 1 DISK 00070E******************************************************************** 00080E NA4 5 5 6 00090E NB4 5 5 4 0 00100E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00110E SEL 38 38 1 00120E WRK 38 38 1 A 00130E CSZ 38 38 1 A 00140E XS 1 1 39 00150E MSG 1 1 35 00160E BIT 33 1 00170E CFA 8 35 A 00180E CFN 5 3 A 00190E CFC 5 3 0 00200E NAC 24 1 00210I******************************************************************** 00220IBITTAB BT 02 00230I 1 33 BIT 00240I******************************************************************** 00250ICFKEYOUTCK ÐÐ00260I 36 50 CKKEY 00270I 51 590CKZIP 00280I******************************************************************** 00290ICFMAST CF 01 00300I* CATALOG HOLDER (MAIL LIST) MASTER. 00310I* KEY AREA. 00320I* NAME KEY 15A 00330I 1 15 CFKEY 00340I* ADDRESS LINES 35A X 8 00350I 16 295 CFA 00360I* STATE CODE 2A 00370I 296 297 CFSTCD 00380I* ZIP 9P 00390I P 298 3020CFZIP 00400I* CATALOGS. 00410I* NAME 3A X 5 00420I 303 317 CFN 00430I* COPIES 3P X 5 00440I P 318 327 CFC 00450I* SELECTOR CODES 24 X 1A 1 00460I 328 351 NAC 00470I* TELEPHONE # 12A 00480I 352 363 CFTEL 00490I* DATE LAST TRAN 6N (YMD) 00500I 364 3690CFDLT ÐÐ00510I* RECORD STATUS 1A 00520I 370 370 CFSTAT 00530C******************************************************************** 00540C* INITIALIZE - 1 TIME. 00550C EXSR SR101 INIT. 00560C 02 GOTO END 00570C CKZIP COMP BEGZIP 54 54 00580C N54 GOTO END 00590C*------------------------------------------------------------------- 00600C CKKEY CHAINCFMAST 54 00610C CFSTAT COMP 'D' 54 00620C 54 SETOF 01 00630C 54 GOTO END DELETED CFMAST. 00640C EXSR SR102 00650C*------------------------------------------------------------------- 00660C END TAG 00670CLR EXSR SR303 LF 00680CLR EXSR SR303 LF 00690CLR EXSR SR303 LF 00700CLR EXSR SR303 LF 00710CLR EXSR SR303 LF 00720CLR EXSR SR303 LF 00730CLR EXSR SR303 LF 00740CLR EXSR SR303 LF 00750CLR EXSR SR303 LF ÐÐ00760CLR EXSR SR303 LF 00770CLR EXSR SR303 LF 00780CLR EXITFQLF6 SET 6-LPI 00790C******************************************************************** 00800CSR SR101 BEGSR 00810C* INITIALIZE 1-TIME. 00820CSR EXITFQLF8 SET 8-LPI 00830CSR MOVE ' ' BLK16 16 00840CSR MOVE ' ' BLK35 35 00850CSR MOVE ' ' BLK60 60 00860CSR MOVE ' ' BLK25 25 00870CSR MOVE ' ' BLK22 22 00880CSR 78 GOTO END101 00890C*--------------------------------------------------------------- 00900CSR T101A TAG 00910CSR SETON 78 00920CSR MOVEAXS W60A 60 00930CSR MOVE BLK22 W60A 00940CSR EXSR SR302 00950CSR EXSR SR302 00960CSR EXSR SR302 00970CSR EXSR SR302 00980CSR EXSR SR302 00990CSR EXSR SR302 01000CSR EXSR SR302 ÐÐ01010CSR EXSR SR302 01020CSR EXSR SR302 01030CSR EXSR SR302 01040CSR EXSR SR302 01050CSR EXSR SR303 LF/CR 01060CSR EXSR SR303 LF/CR 01070CSR MOVE ' ' W6A 6 01080CSR EXITFQREED6 READ CRT 6-BYTES 01090CSR RLABL W6A 01100CSR W6A COMP ' ' 54 01110CSRN54 GOTO T101A ALL BLANKS-REPEAT 01120C* GET STARTING ZIP. 01130CSR MOVE BLK60 W60A 60 01140CSR MOVEAMSG W60A 01150CSR MOVE BLK25 W60A 01160CSR EXSR SR302 01170CSR MOVELBIT,1 BUFLGT 2 BUFFER LGTH. 01180CSR MOVE BIT,5 BUFLGT 01190CSR MOVE BLK60 W60A 01200CSR EXITFQWREED 01210CSR RLABL W60A 01220CSR RLABL BUFLGT 01230CSR MOVELW60A W9A 9 01240CSR Z-ADD9 W2N 20 01250CSR EXIT SUBRAJ R. JUSTIFY ÐÐ01260CSR RLABL W2N 01270CSR RLABL W9A 01280CSR MOVE W9A BEGZIP 90 01290CSR EXSR SR303 LF/CR 01300CSR EXSR SR303 01310CSR EXSR SR303 01320CSR EXSR SR303 01330CSR EXSR SR303 01340CSR EXSR SR303 01350CSR EXSR SR303 01360CSR EXSR SR303 01370CSR EXSR SR303 01380CSR END101 ENDSR 01390C******************************************************************** 01400CSR SR102 BEGSR 01410C* WRITE LABEL. 01420CSR Z-ADD0 COUNT 30 01430CSR EXSR SR201 PUT SELECTOR. 01440CSR Z-ADD1 L 30 01450CSR SETOF 75 01460C*------------------------------------------------------------------- 01470CSR T102A TAG 01480CSR BLK35 LOKUPCFA,L 54 01490CSRN54 GOTO T102W 01500CSR CFSTCD COMP ' ' 54 FLAG DOMESTIC ÐÐ01510CSR L COMP 7 55 FLAG LINE 7 01520CSRN54 NOT DOMESTIC 01530CORN55 GOTO T102B NOT LINE 7 01540CSR EXSR SR202 PUT CITY/STATE. 01550CSR GOTO T102W 01560C*------------------------------------------------------------------- 01570CSR T102B TAG 01580CSR MOVE BLK60 W60A 01590CSR MOVEACFA,L W60A 01600CSR MOVE BLK25 W60A 01610CSR EXSR SR302 PUT NORMAL LINE 01620CSR SETON 75 01630CSR 1 ADD COUNT COUNT 01640CSR MOVE BLK35 CFA,L 01650CSR GOTO T102A GET NEXT LINE 01660C*------------------------------------------------------------------- 01670CSR T102W TAG 01680C* PUT OUT SPACE LINES. 01690CSR COUNT COMP 8 54 01700CSR 54 GOTO END102 01710CSR EXSR SR303 LF/CR 01720CSR 1 ADD COUNT COUNT 01730CSR GOTO T102W 01740CSR END102 ENDSR 01750C******************************************************************** ÐÐ01760CSR SR201 BEGSR 01770C* PUT MAILER CODES. 01780CSR MOVE BLK60 W60A 60 01790CSR MOVEACFN W15A 15 01800CSR MOVE W15A W44A 44 01810CSR MOVELW44A W60A 01820CSR EXSR SR302 PUT MAILER 01830CSR 2 ADD COUNT COUNT 01840CSR EXSR SR303 LF/CR 01850CSR ENDSR 01860C******************************************************************** 01870CSR SR202 BEGSR 01880C* PUT CITY/STATE/ZIP. 01890CSR MOVE ' ' CSZ INIT CITY LINE 01900CSR MOVEACFA,7 CSZ CITY NAME 01910CSR EXSR SR301 FIND END CITY 01920CSRN55 GOTO T202E NO BLKS LEFT 01930CSR MOVE ',' CSZ,A COMMA 01940CSR 2 ADD A A 30 01950CSR A COMP 38 54 01960CSR 54 GOTO T202E NO BLKS LEFT 01970CSR MOVEACFSTCD CSZ,A STATE CODE 01980CSR 4 ADD A A 01990CSR A COMP 38 54 02000CSR 54 GOTO T202E NO BLKS LEFT ÐÐ02010CSR MOVE CFZIP W5A 5 02020CSR MOVEAW5A CSZ,A ZIP CODE 02030C*------------------------------------------------------------------- 02040CSR T202E TAG 02050CSR MOVE BLK60 W60A 02060CSR MOVEACSZ W60A 02070CSR MOVE BLK22 W60A 02080CSR EXSR SR302 02090CSR 1 ADD COUNT COUNT PUT CITY/STATE. 02100CSR ENDSR 02110C***************************************************************** 02120CSR SR301 BEGSR 02130C* FIND END OF CITY + 1 02140CSR SETOF 55 02150CSR Z-ADD0 W3N 30 02160CSR Z-ADD1 A 02170C*------------------------------------------------------------------- 02180CSR T301A TAG 02190CSR ' ' LOKUPCSZ,A 54 02200CSRN54 1 ADD W3N A 02210CSRN54 GOTO T301B 02220CSR Z-ADDA W3N 02230CSR 1 ADD A A 02240CSR A COMP 38 54 02250CSR 54 GOTO END301 ÐÐ02260CSR GOTO T301A 02270C*-------------------------------------------------------------- 02280CSR T301B TAG 02290CSR A COMP 38 54 02300CSRN54 SETON 55 02310CSR END301 ENDSR 02320C******************************************************************** 02330CSR SR302 BEGSR 02340CSR EXSR SR303 LF/CF 02350CSR EXITFQTW60 02360CSR RLABL W60A 02370CSR ENDSR 02380C******************************************************************** 02390CSR SR303 BEGSR 02400C* LF/CR. 02410CSR EXITFQCLFCR LF/CR. 02420CSR ENDSR ** NA4 ARRAY 002430 002440** NB4 ARRAY 002450 002460** TABSC/TABSCN --- STATE CODES/NAMES 002470 002480ALALABAMA 002490AKALASKA 002500ÐÐAZARIZONA 002510ARARKANSAS 002520ASAMERICAN SAMOA 002530CACALIFORNIA 002540CZCANAL ZONE 002550COCOLORADO 002560CTCONNECTICUT 002570DEDELAWARE 002580DCDISTRICT OF COLUMBIA 002590FLFLORIDA 002600GAGEORGIA 002610GUGUAM 002620HIHAWAII 002630IDIDAHO 002640ILILLINOIS 002650ININDIANA 002660IAIOWA 002670KSKANSAS 002680KYKENTUCKY 002690LALOUISIANA 002700MEMAINE 002710MDMARYLAND 002720MAMASSACHUSETTS 002730MIMICHIGAN 002740MNMINNESOTA 002750ÐÐMSMISSISSIPPI 002760MOMISSOURI 002770MTMONTANA 002780NENEBRASKA 002790NVNEVADA 002800NHNEW HAMPSHIRE 002810NJNEW JERSEY 002820NMNEW MEXICO 002830NYNEW YORK 002840NCNORTH CAROLINA 002850NDNORTH DAKOTA 002860OHOHIO 002870OKOKLAHOMA 002880OROREGON 002890PAPENNSYLVANIA 002900PRPUERTO RICO 002910RIRHODE ISLAND 002920SCSOUTH CAROLINA 002930SDSOUTH DAKOTA 002940TNTENNESSEE 002950TTTRUST TERRITORIES 002960TXTEXAS 002970UTUTAH 002980VTVERMONT 002990VAVIRGINIA 003000ÐÐVIVIRGIN ISLANDS 003010WAWASHINGTON 003020WVWEST VIRGINIA 003030WIWISCONSIN 003040WYWYOMING 003050** SEL ARRAY 003060 003070** WRK ARRAY 003080 003090** CSZ ARRAY 003100 003110** XS ARRAY 003120XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 003130** MSG ARRAY 003140ENTER STARTING ZIP: 003150/* 003160_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( Nœ  NX015GL P120282120282(èÈÐ00010H Q015GL00020F* JOURNAL ENTRY UPDATE. (X015GL) 00030F* REVISED 7-28-81 4:10 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FGLMAST UC F 165R 9AI 1 DISK A 00070FCAMAST ID F 40L18AI 1 DISK 00080FGLWU ID F 19L18AI 1 DISK 00090FTERM132 O F 132 5 00100E******************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A40 40 40 1 A INPUT DATA ARRAY 00130E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 9 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E LOC 1 9 3 XY-POSITIONS 00170E BIT 33 1 SCREEN CONTR. CHAR 00180E CALL 5 6 CALL STACK 00190E GLA 12 11 2 ACTUAL $ 00200I******************************************************************* 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I****************************************************************** 00280IGLMAST GL 00290I* ACCOUNT MASTER. 00300I* KEY AREA. 00310I 1 9 GLKEY 00320I* ACCOUNT PREFIX 1A 00330I 1 1 GLPRFX 00340I* ACCOUNT PRIME 5N 00350I 2 60GLPRIM 00360I* ACCOUNT DASH 3N 00370I 7 90GLDASH 00380I* ACCOUNT GROUP 4A 00390I 14 17 GLGRUP 00400I* ACCOUNT DESCRIPTION 40A 00410I 18 57 GLDESC 00420I* BALANCE FORWARD AMOUNT 11.2P 00430I P 58 632GLBALF 00440I* ACTUAL $ 11.2P X 12 00450I P 64 135 GLA 00460I* CURRENT MONTH-PLUSES 11.2P 00470I P 136 1412GLCMP 00480I* CURRENT MONTH-MINUS 11.2P 00490I P 142 1472GLCMM 00500I* SOURCE CODE 1A ÐÐ00510I* S = SUB-ACCOUNT ONLY, 00520I* MAY NOT BE PARENT 00530I 148 148 GLSC 00540I* BALANCE FORWARD CODE 2A 00550I* 1ST COL 00560I* 1 = ZERO BAL AT START NEW YR 00570I* 2 = CARRY PREV YR FRWD 00580I* 2ND COL 00590I* A = ZERO BAL AT START NEW MO 00600I* B = CARRY PREV MO FRWD 00610I 149 150 GLBFC 00620I* NUMB OF SUB-ACCOUNTS 5P 00630I P 157 1590GLNOSA 00640I* LOW LEVEL CODE 3N 00650I 160 1620GLLL 00660I* FILLER 00670I* RECORD STATUS 1A 00680I 165 165 GLSTAT 00690I******************************************************************* 00700ICAMAST CA 00710I* CHART OF ACCOUNTS. 00720I* KEY AREA. 00730I* PARENT ACCOUNT 9A 00740I 1 9 CAPAR 00750I* SUB-ACCOUNT 9A ÐÐ00760I 10 18 CASUB 00770I* OPERATOR 1A 00780I* S = SUBTRACT 00790I* A = ADD 00800I 25 25 CAOPER 00810I* EFFECTIVITY 00820I* START DATE 6N (YMD) 00830I 26 310CASDAT 00840I* END DATE 6N (YMD) 00850I 32 370CAEDAT 00860I* FILLER 00870I* RECORD STATUS 1A 00880I 40 40 CASTAT 00890I******************************************************************** 00900IGLWU GW 00910I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00920I* KEY AREA. 00930I* SUB-ACCOUNT 9A 00940I 1 9 GWSUB 00950I* PARENT ACCOUNT 9A 00960I 10 18 GWPAR 00970I* RECORD STATUS 1A 00980I 19 19 GWSTAT 00990C******************************************************************** 01000C* INITIALIZE ÐÐ01010C EXSR SR101 1-TIME INIT 01020C*------------------------------------------------------------------ 01030C START TAG 01040C* SET-UP 1ST FIELD NO. 01050C EXSR SR205 INIT GLMAST FIELDS 01060C EXSR SR207 INIT TRAN FIELDS 01070C MOVE ' ' DUN INIT EDIT ARRAY 01080C Z-ADD1 F 30 FIELD # 01090C GOTO READ 01100C*------------------------------------------------------------------ 01110C NEXT TAG 01120C* SET-UP NEXT FIELD NO. 01130C 1 ADD F F FIELD # 01140C*----------------------------------------------------------------- 01150C READ TAG 01160C* READ DATA FROM TERMINAL. 01170C SETOF 9096 01180C EXSR SR102 VALIDATE FIELD # 01190C 55 GOTO UPDATE DONE 01200C EXSR SR201 IDENTIFY-F 01210C SETON 69 01220C EXSR SR72 PROMPT 01230C SETOF 69 01240C EXSR SR75 READ TERMINAL 01250C 98 GOTO GOODBY GOODBY ÐÐ01260C 94 GOTO MENU MENU REQUEST 01270C N77N88 EXSR SR104 EDIT INPUT FIELD 01280C 96 ERROR 01290CORN77N88 EXSR SR72 REWRITE INPUT DATA 01300C 93 GOTO NEWITM NEW ITEM 01310C 92 GOTO JUMP FIELD JUMP REQST 01320C 91 GOTO NEXT SKIP FORWARD 01330C 89 F SUB 1 F SKIP BACKWARD 01340C 89 GOTO READ " " 01350C 88 SETOF 90 SPACE FILL 01360C 88 SETON 77 " " 01370C 87 GOTO START 01380C 86 GOTO UPDATE UPDATE 01390C 85 GOTO READ REPEAT 01400C 96 GOTO ERROR ERROR 01410C 04N77 GOTO EDIT 01420C N77 GOTO NEXT NO DATA INPUT 01430C*------------------------------------------------------------------ 01440C PROCES TAG 01450C* PROCESS INPUT DATA 01460C EXSR SR103 MOVE DATA 01470C*------------------------------------------------------------------- 01480C EDIT TAG 01490C N96 EXSR SR104 EDIT DATA 01500C EXSR SR72 REWRITE DATA ÐÐ01510C 96 GOTO ERROR ERROR 01520C GOTO NEXT 01530C*------------------------------------------------------------------ 01540C UPDATE TAG 01550C* UPDATE DATA BASE. 01560C EXSR SR105 FINAL EDIT 01570C 96 GOTO ERROR ERROR 01580C EXSR SR106 UPDATE 01590C 96 GOTO ERROR ERROR 01600C 1 ADD LINE LINE 30 01610C GOTO START 01620C*------------------------------------------------------------------- 01630C JUMP TAG 01640C* SET-UP JUMP TO REQUESTED FIELD 01650C 1 ADD W W 30 01660C W COMP 40 54 01670C 54 Z-ADD318 M 50 96 FLAG ERROR 01680C 54 GOTO ERROR BAD ESC 01690C MOVE '000' W3A 3 01700C MOVEAA40,W W3A 01710C Z-ADD3 W2N 20 01720C EXIT SUBRAJ R. JUSTIFY 01730C RLABL W2N 01740C RLABL W3A 01750C MOVE W3A F NEW FIELD # ÐÐ01760C GOTO READ 01770C*-------------------------------------------------------------------- 01780C ERROR TAG 01790C EXSR SR102 VALIDATE FIELD # 01800C EXSR SR89 GET MSG 01810C EXSR SR73 PUT MSG 01820C GOTO READ 01830C*------------------------------------------------------------------ 01840C NEWITM TAG 01850C* SET-UP LINK FOR NEW ITEM 01860C GOTO START 01870C*------------------------------------------------------------------- 01880C MENU TAG 01890C* SET-UP LINK TO MENU 01900C MOVEL'QQGL01' PROG 8 01910C GOTO END 01920C*-------------------------------------------------------------------- 01930C GOODBY TAG 01940C* LINK TO SIGN-OFF 01950C MOVEL'GOODBY' PROG 01960C GOTO END 01970C*------------------------------------------------------------------- 01980C END TAG 01990C EXITFCHAIN LINK TO NEXT PROG 02000C RLABL PROG ÐÐ02010C********************************************************************* 02020CSR SR1 BEGSR 02030C* EDIT TRAN CODE. 02040CSR EXSR SR203 CLASSIFY TRAN. 02050CSRN60N61N62 Z-ADD302 M 96 FLAG ERROR. 02060CSR ENDSR 02070C******************************************************************** 02080CSR SR2 BEGSR 02090C* EDIT ACCOUNT PREFIX 02100CSRN79 MOVE ' ' IOTRAP 1 02110CSR ENDSR 02120C******************************************************************** 02130CSR SR3 BEGSR 02140C* EDIT ACCOUNT PRIME 02150CSRN79 MOVE ' ' IOTRAP 02160CSR TPRIM COMP 0 54 02170CSRN54 Z-ADD338 M 96 FLAG ERROR 02180CSR ENDSR 02190C*************************************************************** 02200CSR SR4 BEGSR 02210C* EDIT ACCOUNT DASH 02220CSR EXSR SR80 GET GLMAST 02230CSR SETOF 55 02240CSR 60 02250COR 61 SETON 55 ÐÐ02260CSR EXSR SR1 EDIT TRAN CODE 02270CSR 96 GOTO END4 ERROR 02280CSR 60N55 Z-ADD301 M 96 FLAG ERROR 02290CSR 61 55 02300COR 62 55 Z-ADD302 M 96 FLAG ERROR 02310CSR 55 EXSR SR205 INIT GLMAST 02320CSRN55 EXSR SR206 MOVE DATA 02330CSRN96 MOVE 'X' IOTRAP 02340CSR END4 ENDSR 02350C******************************************************************** 02360CSR SR5 BEGSR 02370C* EDIT DESCRIPTION. 02380CSR GLDESC COMP BLK40 54 02390CSRN54 Z-ADD310 M 96 FLAG ERROR. 02400CSR ENDSR 02410C******************************************************************** 02420CSR SR7 BEGSR 02430C* EDIT SOURCE CODE. 02440CSR GLSC COMP 'C' 54 COMPUTED. 02450CSRN54 GLSC COMP 'D' 54 DIRECT. 02460CSRN54 Z-ADD339 M 96 FLAG ERROR. 02470CSRN54 GOTO END7 02480C* FLAG ERROR IF SOURCE CODE=S AND USED AS A PARENT. 02490CSR TSC COMP 'S' 54 02500CSR 54 GLNOSA COMP 0 54 ÐÐ02510CSR 54 Z-ADD361 M 96 FLAG ERROR 02520CSR END7 ENDSR 02530C***************************************************************** 02540CSR SR9 BEGSR 02550C* EDIT BAL-FORWARD CODE 02560CSR TBFC COMP '1A' 54 02570CSRN54 TBFC COMP '1B' 54 02580CSRN54 TBFC COMP '2A' 54 02590CSRN54 TBFC COMP '3A' 54 02600CSRN54 Z-ADD357 M 96 FLAG ERROR 02610CSR ENDSR 02620C***************************************************************** 02630CSR SR70 BEGSR 02640C* CLEAR TERM SCREEN. 02650CSR SETON 70 02660CSR EXCPT CLEAR SCREEN 02670CSR SETOF 70 02680CSR ENDSR 02690C********************************************************************** 02700CSR SR71 BEGSR 02710C* PUT HEADINGS 02720CSR SETON 71 02730CSR EXCPT PUT HEADING 02740CSR SETOF 71 02750CSR Z-ADD6 LINE 30 ÐÐ02760CSR ENDSR 02770C********************************************************************* 02780CSR SR72 BEGSR 02790C* PUT DATA TO TERMINAL 02800CSR LINE COMP 28 54 02810CSR 54 EXSR SR71 PUT HEADING 02820CSR LINE SUB 1 W3N 30 54 02830CSRN54 Z-ADD1 W3N 02840CSR MOVELW3N XYPOS 6 02850CSR MOVE '001' XYPOS 02860CSR EXITFQXYPOS POSITION CURSOR 02870CSR RLABL XYPOS 02880CSR SETON 72 02890CSR EXCPT PUT DATA 02900CSR SETOF 72 02910CSR END72 ENDSR 02920C*********************************************************************** 02930CSR SR73 BEGSR 02940C* PUT ERROR MESSAGE TO TERMINAL 02950CSR SETON 73 02960CSR EXCPT PUT MSG 02970CSR SETOF 73 02980CSR Z-ADDM LSTERR 50 02990CSR ENDSR 03000C******************************************************************* ÐÐ03010CSR SR75 BEGSR 03020C* READ FROM TERMINAL 03030CSR SETOF 779096 03040CSR SETOF 939291 03050CSR SETOF 898887 03060CSR SETOF 8685 03070CSR MOVE BIT,21 BUFLGT 2 READ BUFFER LGTH 03080CSR MOVE BLK40 W40A 40 BUFFER 03090CSR MOVELLINE XYPOS 6 03100CSR MOVE LOC,F XYPOS 03110CSR EXITFQPREED READ FROM TERMINAL 03120CSR RLABL XYPOS 03130CSR RLABL W40A READ BUFFER 03140CSR RLABL BUFLGT READ BUFFER LGTH 03150CSR MOVEAW40A A40 INPUT DATA ARRAY 03160CSR MOVE BLK40 W40A INIT INPUT ARRAY 03170CSR Z-ADD1 W 30 03180CSR '\' LOKUPA40,W 90 FLAG ESC 03190CSRN90 GOTO T75B NOT ESC 03200CSR 1 ADD W W 03210CSR W COMP 40 54 03220CSR 54 GOTO T75A BAD ESC 03230CSR A40,W COMP 'G' 98 GOODBY 03240CSR A40,W COMP 'E' 94 MENU 03250CSR A40,W COMP 'N' 93 NEW ITEM ÐÐ03260CSR A40,W COMP 'J' 92 JUMP 03270CSR A40,W COMP 'F' 91 SKIP FRWRD 03280CSR A40,W COMP 'B' 89 SKIP BKWRD 03290CSR A40,W COMP 'S' 88 SPACE FILL 03300CSR A40,W COMP 'H' 87 HOME 03310CSR A40,W COMP 'U' 86 UPDATE 03320CSR A40,W COMP 'R' 85 REPEAT 03330CSR 98 03340COR 94 03350COR 93 03360COR 92 03370COR 91 03380COR 89 03390COR 88 03400COR 87 03410COR 86 03420COR 85 GOTO END75 GOOD ESC 03430C*------------------------------------------------------------------ 03440CSR T75A TAG 03450C* FLAG BAD ESC INPUT 03460CSR Z-ADD318 M 96 FLAG ERROR 03470CSR GOTO END75 03480C*-------------------------------------------------------------------- 03490CSR T75B TAG 03500C* MOVE DATA ÐÐ03510CSR Z-ADD1 W 03520CSR ' ' LOKUPA40,W 77 03530CSR 77 MOVEAA40,W W40A INPUT DATA 03540C*-------------------------------------------------------------------- 03550CSR END75 TAG 03560C* INIT PREV ERROR MSG. 03570CSR LSTERR COMP 0 54 03580CSR 54 MOVE BLK35 MGTEXT 03590CSR 54 EXSR SR73 BLANK MESSAGE 03600CSR Z-ADD0 LSTERR 50 03610CSR ENDSR 03620C********************************************************************** 03630CSR SR80 BEGSR 03640C* GET MASTER RECORD 03650CSR SETOF 61 03660CSR MOVELTPRFX TKEY 9 03670CSR MOVELTPRIM W8A 8 03680CSR MOVE TDASH W8A 03690CSR MOVE W8A TKEY 03700CSR TKEY CHAINGLMAST 60 GET MASTER 03710CSRN60 GLSTAT COMP 'D' 61 FLAG DELETE 03720CSR ENDSR 03730C********************************************************************** 03740CSR SR81 BEGSR 03750C* ADD NEW MASTER TO FILE ÐÐ03760CSR SETON 81 03770CSR EXCPT ADD MASTER 03780CSR SETOF 81 03790CSR ENDSR 03800C*********************************************************************** 03810CSR SR82 BEGSR 03820C* REWRITE MASTER 03830CSR SETON 82 03840CSR EXCPT REWRITE MASTER 03850CSR SETOF 82 03860CSR ENDSR 03870C********************************************************************** 03880CSR SR89 BEGSR 03890C* GET MESSAGE MASTER 03900CSR M CHAINMGFILE 54 03910CSR 54 MOVE BLK35 MGTEXT 03920CSR 54 MOVELM MGTEXT 03930CSR 54 MOVE MES,1 MGTEXT 03940CSR ENDSR 03950C******************************************************************** 03960CSR SR101 BEGSR 03970C* 1-TIME INITIALIZE 03980CSR MOVE BIT,1 NUL 03990CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04000CSR EXSR SR70 CLEAR SCREEN ÐÐ04010CSR EXSR SR71 PUT HEADING 04020CSR Z-ADD9 FLIMIT 30 TOTAL NUMB FIELDS 04030CSR MOVE ' ' BLK40 40 04040C* DEFINE WORK FIELDS,ETC. 04050CSR MOVE ' ' BLK35 35 04060CSR MOVE ' ' BLK6 6 04070CSR ENDSR 04080C********************************************************************** 04090CSR SR102 BEGSR 04100C* VALIDATE FIELD NO. 04110CSR F COMP 0 54 04120CSRN54 Z-ADD1 F 04130CSR F COMP FLIMIT 55 04140CSR 55 Z-ADD1 F 04150CSR ENDSR 04160C******************************************************************** 04170CSR SR103 BEGSR 04180C* MOVE INPUT DATA 04190CSR EXSR SR201 IDENTIFY-F 04200CSR EXSR SR202 R. JUSTIFY 04210CSR 01 MOVELW40A TTCODE 1 TRAN CODE. 04220CSR 02 MOVELW40A TPRFX 1 ACCOUNT PREFIX 04230CSR 03 MOVE W10A TPRIM 50 ACCOUNT PRIME 04240CSR 04 MOVE W10A TDASH 30 ACCOUNT DASH 04250CSR 05 MOVELW40A TDESC 40 DESCRIPTION. ÐÐ04260CSR 06 MOVELW40A TGRUP 1 ACCT GROUP.E. 04270CSR 07 MOVELW40A TSC 1 SOURCE CODE. 04280CSR 08 MOVELW40A TYBFC 1 YEARLY BAL FWD 04290CSR 08 MOVELTYBFC TBFC 2 04300CSR 09 MOVELW40A TMBFC 1 MONTHLY BAL FWD 04310CSR 09 MOVE TMBFC TBFC 04320CSR MOVE ' ' DUN,F EDIT FLAG 04330CSR ENDSR 04340C******************************************************************** 04350CSR SR104 BEGSR 04360C* EDIT INPUT DATA 04370CSR F COMP 4 54 04380CSR 54 IOTRAP COMP ' ' 55 04390CSR 54N55 EXSR SR4 EDIT KEY. 04400CSR 01 EXSR SR1 04410CSR 02 EXSR SR2 04420CSR 03 EXSR SR3 04430CSR 04N79 EXSR SR4 04440CSR 05 EXSR SR5 04450CSR 07 EXSR SR7 04460CSR 09 EXSR SR9 04470CSR 96 MOVE ' ' DUN,F EDIT FLAG 04480CSRN96 MOVE 'X' DUN,F 04490CSR ENDSR 04500C*********************************************************************** ÐÐ04510CSR SR105 BEGSR 04520C* FINAL EDIT 04530CSR SETON 79 FINAL EDIT FLAG 04540CSR Z-ADD1 F 96 04550C*-------------------------------------------------------------------- 04560CSR T105A TAG 04570CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04580CSRN54 GOTO END105 04590CSR EXSR SR201 IDENTIFY-F 04600CSR EXSR SR104 EDIT 04610CSRN96 GOTO T105A 04620C*-------------------------------------------------------------------- 04630CSR END105 TAG 04640CSR SETOF 79 04650CSR ENDSR 04660C******************************************************************** 04670CSR SR106 BEGSR 04680C* UPDATE DATA BASE. 04690CSR EXSR SR203 CLASSIFY TRAN 04700CSR 60 GOTO T106A ADD TRAN 04710CSR 61 GOTO T106D CHANGE TRAN 04720CSR 62 GOTO T106F DELETE TRAN 04730C* FLAG BAD TRAN CODE 04740CSR Z-ADD300 M 96 FLAG ERROR 04750CSR Z-ADD1 F FIELD # ÐÐ04760CSR GOTO END106 04770C*------------------------------------------------------------------- 04780CSR T106A TAG 04790C* ADD TRANSACTION 04800CSR EXSR SR80 GET MASTER 04810CSR 60 GOTO T106B NOT ON FILE 04820CSR 61 GOTO T106C DELETED MASTER 04830C* FLAG DUPLICATE ADD ERROR 04840CSR Z-ADD301 M 96 FLAG ERROR 04850CSR Z-ADD1 F FIELD # 04860CSR GOTO END106 04870C*--------------------------------------------------------------------- 04880CSR T106B TAG 04890C* ADD-- MAST NOT ON FILE 04900CSR EXSR SR81 ADD NEW MASTER 04910CSR GOTO END106 04920C*--------------------------------------------------------------------- 04930CSR T106C TAG 04940C* ADD-- MAST IS DELETED 04950CSR MOVE 'A' GLSTAT RECORD STATUS 04960CSR EXSR SR82 REWRITE MAST 04970CSR GOTO END106 04980C*---------------------------------------------------------------------- 04990CSR T106D TAG 05000C* CHANGE TRANSACTION. ÐÐ05010CSR EXSR SR80 GET MASTER 05020CSRN60N61 GOTO T106E GOT IT 05030C* FLAG NO MASTER ERROR 05040CSR Z-ADD302 M 96 FLAG ERROR 05050CSR Z-ADD1 F FIELD # 05060CSR GOTO END106 05070C*----------------------------------------------------------------------- 05080CSR T106E TAG 05090C* REWRITE MASTER 05100CSR EXSR SR82 REWRITE MAST 05110CSR GOTO END106 05120C*----------------------------------------------------------------------- 05130CSR T106F TAG 05140C* DELETE TRANSACTION 05150CSR EXSR SR80 GET MASTER 05160CSRN60N61 GOTO T106G GOT IT 05170C* FLAG NO MASTER ERROR 05180CSR Z-ADD302 M 96 FLAG ERROR 05190CSR Z-ADD1 F FIELD # 05200CSR GOTO END106 05210C*----------------------------------------------------------------------- 05220CSR T106G TAG 05230C* DELETE MASTER. 05240CSR EXSR SR204 CHECK FOR ACTIVITY 05250CSR 96 Z-ADD1 F FIELD # ÐÐ05260CSR 96 GOTO END106 ERROR 05270CSR MOVE 'D' GLSTAT RECORD STATUS 05280CSR EXSR SR82 REWRITE MASTER 05290CSR END106 ENDSR 05300C************************************************************************ 05310CSR SR201 BEGSR 05320CSR F COMP 1 01 05330CSR F COMP 2 02 05340CSR F COMP 3 03 05350CSR F COMP 4 04 05360CSR F COMP 5 05 05370CSR F COMP 6 06 05380CSR F COMP 7 07 05390CSR F COMP 8 08 05400CSR F COMP 9 09 05410CSR END201 ENDSR 05420C********************************************************************** 05430CSR SR202 BEGSR 05440C* RIGHT JUSTIFY 05450CSR F LOKUPNUM 54 05460CSRN54 GOTO END202 NOT NUMERIC FIELD 05470CSR Z-ADD10 W2N 20 05480CSR MOVELW40A W10A 10 05490CSR EXIT SUBRAJ R. JUSTIFY 05500CSR RLABL W2N ÐÐ05510CSR RLABL W10A 05520CSR END202 ENDSR 05530C*********************************************************************** 05540CSR SR203 BEGSR 05550C* CLASSIFY TRAN CODE 05560CSR TTCODE COMP 'A' 60 ADD 05570CSR TTCODE COMP 'C' 61 CHANGE 05580CSR TTCODE COMP 'D' 62 DELETE 05590CSR ENDSR 05600C**************************************************************** 05610CSR SR204 BEGSR 05620C* FLAG ERROR ON DELETE IF ACCOUNT IS ACTIVE 05630CSR GLNOSA COMP 0 54 05640CSRN54 XFOOTGLA W11D2 112 54 05650CSR 54 Z-ADD29 M 96 FLAG ERROR 05660CSR 54 GOTO END204 05670CSR MOVELTKEY W18A 18 05680CSR W18A SETLLGLWU 05690C*---------------------------------------------------------------- 05700CSR T204A TAG 05710CSR SETOF 54 05720CSR READ GLWU 54 READ WHERE-USED 05730CSR 54 GOTO END204 05740CSR GWSUB COMP TKEY 54 05750CSRN54 GOTO END204 ÐÐ05760CSR GWSTAT COMP 'D' 54 05770CSR 54 GOTO T204A DELETED RECORD 05780CSR Z-ADD29 M 96 FLAG ERROR 05790CSR END204 ENDSR 05800C**************************************************************************05810CSR SR205 BEGSR 05820C* INIT GLMAST. 05830CSR MOVE TPRFX GLPRFX ACCOUNT PREFIX 05840CSR Z-ADDTPRIM GLPRIM ACCOUNT PRIME 05850CSR Z-ADDTDASH GLDASH ACCOUNT DASH 05860CSR MOVE ' ' GLSC SOURCE CODE 05870CSR MOVE BLK40 GLDESC DESCRIPTION 05880CSR Z-ADD0 GLA ACTUAL $ 05890CSR Z-ADD0 GLCMP CUR-MO PLUS$ 05900CSR Z-ADD0 GLCMM CUR-MO MINUS$ 05910CSR Z-ADD0 GLNOSA NUMB OF SUBS 05920CSR Z-ADD0 GLLL LOW LEVEL CODE 05930CSR MOVE ' ' GLBFC BAL FORWARD CODE 05940CSR ENDSR 05950C*************************************************************** 05960CSR SR206 BEGSR 05970C* MOVE GLMAST TO TRAN FIELDS 05980CSR TDESC COMP BLK40 54 05990CSRN54 MOVE GLDESC TDESC DESCRIPTION 06000CSR TGRUP COMP ' ' 54 ÐÐ06010CSRN54 MOVE GLGRUP TGRUP GROUP CODE 06020CSR TSC COMP ' ' 54 06030CSRN54 MOVE GLSC TSC SOURCE CODE 06040CSR TBFC COMP ' ' 54 06050CSRN54 MOVE GLBFC TBFC BAL FRWRD CODE 06060CSR MOVELTBFC TYBFC 06070CSR MOVE TBFC TMBFC 06080CSR ENDSR 06090C**************************************************************** 06100CSR SR207 BEGSR 06110C* INIT TRAN FIELDS 06120CSR MOVE BLK40 TDESC 06130CSR MOVE ' ' TGRUP 06140CSR MOVE ' ' TSC 06150CSR MOVE ' ' TBFC 06160CSR MOVE ' ' TYBFC 06170CSR MOVE ' ' TMBFC 06180CSR MOVE ' ' TPRFX 06190CSR Z-ADD0 TPRIM 06200CSR Z-ADD0 TDASH 06210CSR MOVE BLK35 TKEY 06220CSR ENDSR 06230O******************************************************************** 06240OTERM132 E 70 06250O* CLEAR CRT. ÐÐ06260O NUL 132 06270O BIT,13 1 06280O*------------------------------------------------------------------- 06290O E 71 06300O* PUT HEADING. 06310O 70 'ACCOUNT MASTER UPDATE' 06320O*-------------------------------------------------------------------- 06330O E 71 06340O 80 'YEARLY' 06350O 89 'MONTHLY' 06360O*-------------------------------------------------------------------- 06370O E 71 06380O 21 'ACCOUNT NO.' 06390O 81 'BAL-FWD' 06400O 89 'BAL-FWD' 06410O*------------------------------------------------------------------- 06420O E 71 06430O 4 'CODE' 06440O 12 'PREFIX' 06450O 18 'PRIME' 06460O 24 'DASH' 06470O 41 '<--------------' 06480O 52 'DESCRIPTION' 06490O 65 '------------>' 06500O 73 'GROUP' ÐÐ06510O 79 'TYPE' 06520O 86 'CODE' 06530O 95 'CODE' 06540O*------------------------------------------------------------------- 06550O E 72 06560O* PUT DATA. 06570O TTCODE 2 06580O TPRFX 10 06590O TPRIM Z 19 06600O TDASH Z 23 06610O TDESC 65 06620O TGRUP 71 06630O TSC 78 06640O TYBFC 85 06650O TMBFC 94 06660O*------------------------------------------------------------------- 06670O E 73 06680O 96 9 'E R R O R' 06690O N96 9 ' ' 06700O MGTEXT 47 06710O BIT,28 130 06720O 131 'K' 06730O BIT,8 132 06740O******************************************************************** 06750OGLMAST EADD 81 ÐÐ06760O TKEY 9 06770O TGRUP 17 06780O TDESC 57 06790O GLBALF 63P 06800O GLA 135P 06810O GLCMP 141P 06820O GLCMM 147P 06830O TSC 148 06840O TBFC 150 06850O GLNOSA 159P 06860O GLLL 162 06870O 165 'A' 06880O*------------------------------------------------------------------- 06890O E 82 06900O TGRUP 17 06910O TDESC 57 06920O GLBALF 63P 06930O GLA 135P 06940O GLCMP 141P 06950O GLCMM 147P 06960O TSC 148 06970O TBFC 150 06980O GLNOSA 159P 06990O GLLL 162 07000O GLSTAT 165 ÐÐ** NUL ARRAY 007010 007020** A40 ARRAY 007030 007040** NUM ARRAY 007050003 PRIME 007060004 DASH 007070** DUN ARRAY 007080 007090** MES ARRAY 007100---MESSAGE NOT ON FILE--- 007110** LOC ARRAY 007120003 1 TRAN CODE 007130009 2 PREFIX 007140015 3 PRIME 007150022 4 DASH 007160027 5 DESCR 007170070 6 GROUP 007180079 7 SOURCE 007190085 8 BAL FWD - YEARLY 007200094 9 BAL FWD - MONTHLY 007210/* 07220_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2Oë 2X016QM P120282120282(èÈÐ00010H Q016QM00020F* GENERATE QM ALT-KEY FILES. (X016QM) 00030F* CREATED 1/02/80 11:40 AM. 00040FQMMAST IP F 160 8AI 1 DISK 00050FQSKEY O F 18 17AI 1 DISK A 00060FQCKEY O F 29 28AI 1 DISK A 00070FQFKEY O F 15 14AI 1 DISK A 00080E******************************************************************** 00090E QMD 6 7 0 00100I******************************************************************** 00110IQMMAST QM 01 160NCD 00120I 1 5 QMQOTE 00130I 6 8 QMITEM 00140I 9 28 QMNAME 00150I 73 75 QMSLSM 00160I P 76 99 QMD 00170I GG 02 00180C******************************************************************** 00190C 01 MOVE QMD,2 DUE 6 00200C 01 MOVE QMD,5 FOL 6 00210O******************************************************************** 00220OQSKEY DADD 01 00230O QMSLSM 3 00240O DUE 9 00250O QMQOTE 14 ÐÐ00260O QMITEM 17 00270O 18 'A' 00280O******************************************************************** 00290OQCKEY DADD 01 00300O QMNAME 20 00310O QMQOTE 25 00320O QMITEM 28 00330O 29 'A' 00340O******************************************************************** 00350OQFKEY DADD 01 00360O FOL 6 00370O QMQOTE 11 00380O QMITEM 14 00390O 15 'A' /* 000400_‚ ÐÐ_‚_‚0O QMITEM 17 00270O 18 'A' 00280O******************************************************************** 00290OQCKEY DADD 01 00300O QMNAME 20 00310O QMQOTE 25 00320O QMITEM 28 00330O 29 'A' 00340O******************************************************************** 00350OQFKEY DADD 01 00360O FOL 6 00370O QMQOTE 11 00380O QMITEM 14 00390O 15 'A' /* 000400_‚ ÐÈ(XP XúX015RM P‚120282120282(èÈÐ00010H Q015RM00020F* PRINT ROUTINGS, ALL - BY PART #, OPER #. (SYSTEM). (X015RM) 00030F* REVISED 10-01-81 2:45 PM. 00040FBITHEX IP F 256 DISK 00050FRMMAST IS F 140 15AI 1 DISK 00060FREXTPTR ID F 25L21AI 1 DISK 00070FREXTFILEIC F 90R DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FWCMAST IC F 960R 8AI 1 DISK 00100FTERM80 O F 80 5 00110FPRINT O F 132 PRINTER 00120F**************************************************************** 00130E MES 1 1 30 00140E TABTRN 1 3 1 TABNAM 6 TRAN NAMES 00150E TABMET 1 2 1 TABMN 12 METHOD NAMES 00160E DIV 1 1132 00170E REC 1 132 1 00180E* 00190E TXT 60 1 A 00200I******************************************************************* 00210IBITHEX BT 00220I******************************************************************** 00230IRMMAST RM 01 140NCD 00240I* ROUTING MASTER. 00250I* KEY AREA. ÐÐ00260I* PART # 12A 00270I 1 12 RMPN L1 00280I* OPER SEQ # 3N 00290I 13 150RMSEQ 00300I* OPER GROUP CODE 2A 00310I 16 17 RMGRUP 00320I* OVERLAP % .2N 00330I 18 192RMOVLP 00340I* OPER CODE 5A 00350I 20 24 RMOPER 00360I* OPER DEPT. 00370I* DEPT # 5P 00380I P 25 270RMDEPT 00390I* WORK CENTER 3P 00400I P 28 290RMWC 00410I* OPER DESCRIPTION 40A 00420I 30 69 RMDESC 00430I* LABOR STDS. 00440I* ACCOUNTING STD. 00450I* DATE ADOPTED 7P 00460I P 70 730RMADAT 00470I* SET-UP 9.3P 00480I P 74 783RMASU 00490I* RUN 9.3P 00500I P 79 833RMARUN ÐÐ00510I* MIN CHARGE 7.2P 00520I P 84 872RMAMIN 00530I* STD LOT SIZE 7P 00540I P 88 910RMALOT 00550I* REVISED STDS. 00560I* DATE LAST REVISED 7P 00570I P 92 950RMRDAT 00580I* SET-UP 9.3P 00590I P 96 1003RMRSU 00600I* RUN 9.3P 00610I P 101 1053RMRRUN 00620I* MIN. CHARGE 7.2P 00630I P 106 1092RMRMIN 00640I* STD LOT SIZE 7P 00650I P 110 1130RMRLOT 00660I* METHOD ESTAB 1A 00670I 114 114 RMMETH 00680I* JOB SKILL 5A 00690I 115 119 RMSKIL 00700I* PERFORM FACTOR. 00710I* ACTUAL 5.2P 00720I P 120 1222RMPER 00730I* ASSIGNED 5.2P 00740I P 123 1252RMPER2 00750I* NUMB LOTS RUN 5P ÐÐ00760I P 126 1280RMLRUN 00770I* NUMB UNITS RUN 5P 00780I P 129 1310RMQRUN 00790I* FILLER 132 139 FFFFFF 00800I* RECORD STATUS 1A 00810I 140 140 RMSTAT 00820I GG 02 00830I******************************************************************** 00840IREXTPTR TP 00850I* TEXT POINTER FILE. 00860I* PART # 12A 00870I 1 12 TPPN 00880I* OPER SEQ # 3N 00890I 13 150TPSEQ 00900I* LINE # 6N 00910I 16 210TPLINE 00920I* POINTER 7P 00930I P 22 250TPPTR 00940I******************************************************************** 00950IREXTFILETX 00960I* REXTFILE RECORD. 00970I* PART # 12A 00980I 1 12 TXPN 00990I* OPER SEQ # EN 01000I 13 150TXSEQ ÐÐ01010I* LINE # 6N 01020I 16 210TXLINE 01030I* TEXT 1A X 60 01040I 22 81 TXT 01050I* BACKWARD PTR (DELETE) 7P 01060I P 82 850TXBPTR 01070I* RECORD STATUS 1A 01080I 90 90 TXSTAT 01090I******************************************************************** 01100IPMMST2 PM 01110I 1 12 PMPN 01120I 15 180PMPROD 01130I 19 30 PMMODL 01140I 31 59 PMDESC 01150I 94 95 PMSC 01160I 487 488 PMFAB 01170I 674 674 PMSTAT 01180I******************************************************************** 01190IWCMAST WC 01200I* WORK CENTER MASTER. 01210I* NAME 29A 01220I 9 37 WCNAME 01230I* SET-UP RATE 5.2P 01240I P 47 492WCLRAT 01250I* RUN RATE 5.2P ÐÐ01260I P 50 522WCRRAT 01270I* BURDEN RATE 5.2P 01280I P 53 552WCBRAT 01290C******************************************************************** 01300C* INITIALIZE 01310C N80 Z-ADD100 LINENO 80 01320C Z-ADD0 ZERO10 100 STUPIDITY 01330C N88 EXSR SR101 1-TIME INIT 01340C L1 SETOF 79 01350C N01 GOTO END 01360C* DISPLAY ROUTING. 01370C 01 EXSR SR106 DISPLAY. 01380C*------------------------------------------------------------------- 01390C END TAG 01400C******************************************************************** 01410CSR SR69 BEGSR 01420C* PUT DATA TO PRINTER. 01430CSR SETON 81 01440CSR EXCPT 01450CSR SETOF 81 01460CSR 1 ADD LINENO LINENO 30 01470C*------------------------------------------------------------------- 01480CSR END69 TAG 01490CSR SETOF 717275 01500CSR SETOF 414243 ÐÐ01510CSR SETOF 444577 01520CSR SETOF 47 01530CSR ENDSR 01540C******************************************************************** 01550CSR SR70 BEGSR 01560C* PUT DIVIDER. 01570CSR LINENO COMP 57 54 01580CSR 54 EXSR SR71 PUT HEADING 01590CSR SETON 47 01600CSR EXSR SR69 PUT PART# 01610CSR 2 ADD LINENO LINENO 01620CSR ENDSR 01630C******************************************************************** 01640CSR SR71 BEGSR 01650C* PUT HEADINGS TO CRTFILE. 01660CSR Z-ADD0 X 30 01670C*------------------------------------------------------------------- 01680CSR T71A TAG 01690CSR 1 ADD X X 01700CSR X COMP 5 54 01710CSR 54 GOTO T71B 01720CSR X COMP 3 54 01730CSR 54 GOTO T71A 01740CSR X COMP 1 41 01750CSR X COMP 2 42 ÐÐ01760CSR X COMP 3 43 01770CSR X COMP 4 44 01780CSR X COMP 5 45 01790CSR 41 EXSR SR204 TOP OF PAGE 01800CSR 42 EXSR SR205 LINE FEED 01810CSR EXSR SR69 HEADING PUT 01820CSR GOTO T71A 01830C*------------------------------------------------------------------- 01840CSR T71B TAG 01850CSR EXSR SR205 LINE FEED 01860CSR SETOF 414243 01870CSR SETOF 4445 01880CSR ENDSR 01890C********************************************************************* 01900CSR SR72 BEGSR 01910C* PUT OPER TO TERMINAL 01920CSRN79 EXSR SR70 PUT DIVIDER 01930CSR EXSR SR110 COMPUTE COSTS. 01940CSR MOVELPMPN NUMPN 100 01950CSR RMWC COMP 0 54 01960CSR SETON 7279 01970CSR EXSR SR69 PUT DATA 01980CSR SETOF 72 01990CSR ENDSR 02000C******************************************************************** ÐÐ02010CSR SR74 BEGSR 02020C* PUT TEXT TO TERM. 02030CSRN79 EXSR SR70 PUT DIVIDER 02040CSR SETON 7479 02050CSR EXSR SR69 02060CSR SETOF 74 02070CSR ENDSR 02080C*********************************************************************** 02090CSR SR101 BEGSR 02100C* 1-TIME INITIALIZE 02110CSR MOVE '-' REC 02120CSR MOVEAREC DIV 02130CSR SETON 88 02140CSR MOVE ' ' BLK12 12 02150CSR MOVE ' ' W8A 8 02160CSR Z-ADD0 W2N 20 02170CSR Z-ADD0 W1N 10 02180CSR MOVE ' ' W2A 2 02190CSR SETON 84 02200CSR EXCPT 02210CSR SETOF 84 02220CSR EXITFQPAUSE 02230C* DEFINE WORK FIELDS,ETC. 02240CSR MOVE ' ' BLK35 35 02250CSR MOVE ' ' BLK40 40 ÐÐ02260CSR MOVE ' ' BLK8 8 02270CSR Z-ADD0 ZERO10 100 02280CSR END101 ENDSR 02290C******************************************************************** 02300CSR SR106 BEGSR 02310C* DISPLAY ROUTING. 02320CSR EXSR SR205 LF 02330C*------------------------------------------------------------------- 02340CSR T106A TAG 02350CSR RMPN CHAINPMMST2 60 02360CSRN60 PMSTAT COMP 'D' 60 02370CSR 60 Z-ADD291 M 50 96 FLAG ERROR. 02380CSR 60 GOTO END106 02390CSR MOVELPMPN NUMPN 100 02400CSR RMSTAT COMP 'D' 54 02410CSR 54 GOTO END106 DELETED. 02420CSR EXSR SR72 PUT DATA. 02430CSR LINENO COMP 60 78 02440CSR 78 EXSR SR71 NEW PAGE 02450CSR SETOF 78 02460C*------------------------------------------------------------------- 02470CSR T106D TAG 02480CSR EXSR SR203 DISPLAY TEXT. 02490CSR END106 ENDSR 02500C******************************************************************** ÐÐ02510CSR SR110 BEGSR 02520C* COMPUTE DOLLARS/TOTALS. 02530CSR MOVELRMDEPT W8A 8 02540CSR MOVE RMWC W8A 02550CSR W8A CHAINWCMAST 54 02560CSR 54 Z-ADD628 M 96 FLAG ERROR. 02570CSR 54 GOTO END110 02580CSR Z-ADDRMRSU MFGHRS 93 02590CSR WCLRAT MULT RMRSU MFGDOL 92H SET-UP $ LOT 02600CSR MFGDOL DIV RMRLOT MFGDOL H SET-UP $ UNIT 02610CSR RMRRUN MULT WCRRAT W9D2 92H RUN $ 02620CSR W9D2 ADD MFGDOL MFGDOL 02630CSR RMRRUN ADD MFGHRS MFGHRS 02640CSR Z-ADDRMASU ACTHRS 93 02650CSR WCLRAT MULT RMASU ACTDOL 92H SET-UP $ 02660CSR ACTDOL DIV RMALOT ACTDOL H 02670CSR RMARUN MULT WCRRAT W9D2 H RUN $ 02680CSR W9D2 ADD ACTDOL ACTDOL 02690CSR RMARUN ADD ACTHRS ACTHRS 02700CSR END110 ENDSR 02710C******************************************************************** 02720CSR SR203 BEGSR 02730C* DISPLAY TEXT (IF ANY) FOR LAST OPER DISPLAYED. 02740CSR MOVELRMPN W15A 15 02750CSR MOVE RMSEQ W15A ÐÐ02760CSR MOVELW15A W21A 21 02770CSR MOVE '000000' W21A 21 02780CSR W21A SETLLREXTPTR 02790C*------------------------------------------------------------------- 02800CSR T203A TAG 02810CSR SETOF 54 02820CSR READ REXTPTR 54 02830CSR 54 GOTO END203 02840CSR TPPN COMP RMPN 54 02850CSR 54 TPSEQ COMP RMSEQ 54 02860CSRN54 GOTO END203 02870CSR TPPTR COMP 0 54 02880CSRN54 GOTO T203A 02890CSR TPPTR CHAINREXTFILE 02900CSR EXSR SR74 DISPLAY TEXT. 02910CSR LINENO COMP 62 54 54 02920CSR 54 EXSR SR71 NEW PAGE 02930CSR GOTO T203A 02940CSR END203 ENDSR 02950C******************************************************************** 02960CSR SR204 BEGSR 02970C* TOP OF FORM. 02980CSR SETON 82 02990CSR EXCPT 03000CSR SETOF 82 ÐÐ03010CSR Z-ADD5 LINENO 30 03020CSR ENDSR 03030C******************************************************************** 03040CSR SR205 BEGSR 03050C* LINE FEED/CAR RET. 03060CSR SETON 83 03070CSR EXCPT 03080CSR SETOF 83 03090CSR 1 ADD LINENO LINENO 03100CSR ENDSR 03110O******************************************************************** 03120OPRINT E 41 81 03130O* PUT DATA AND HEADINGS. 03140O UDATE Y 8 03150O 76 'ROUTING OPERATION INQUIR' 03160O 77 'Y' 03170O 128 'PAGE' 03180O PAGE Z 132 03190O*------------------------------------------------------------------- 03200O E 42 81 03210O 51 'SOURCE' 03220O 56 'FAB' 03230O 11 'PART-NUMBER' 03240O 25 'DESCRIPTION' 03250O 68 'MODEL-NO.' ÐÐ03260O 82 'PROD-LINE' 03270O*------------------------------------------------------------- 03280O E 47 81 03290O DIV 132 03300O*------------------------------------------------------------------- 03310O E 47 81 03320O NUMPN 12 ' - - ' 03330O PMDESC 43 03340O PMSC 49 03350O PMFAB 56 03360O PMMODL 71 03370O PMPRODZ 84 03380O*------------------------------------------------------------------- 03390O E 44 81 03400O 5 'OPER' 03410O 12 'OVLAP' 03420O 18 'OPER' 03430O 90 'LABOR HOURS' 03440O 103 'LOT' 03450O 115 'MIN-VEND' 03460O 121 'CHG' 03470O 126 'M' 03480O 132 'PERF' 03490O*------------------------------------------------------------------- 03500O E 45 81 ÐÐ03510O 3 'SEQ' 03520O 7 'GRP' 03530O 12 '%' 03540O 18 'CODE' 03550O 26 'DEPT-' 03560O 29 'WC' 03570O 42 'DESCRIPTION' 03580O 82 'SET-UP' 03590O 93 'RUN' 03600O 104 'SIZE' 03610O 114 'CHARGE' 03620O 122 'DATE' 03630O 126 'C' 03640O 132 'CODE' 03650O*------------------------------------------------------------------- 03660O E 72 81 03670O RMSEQ Z 3 03680O RMGRUP 7 03690O RMOVLPZ 11 03700O 12 '%' 03710O RMOPER 18 03720O RMDEPTZ 25 03730O 54 26 '-' 03740O 54 RMWC 29 03750O RMDESC 71 ÐÐ03760O RMRSU 2 82 03770O RMRRUN2 93 03780O RMRLOT2 104 03790O RMRMIN2 114 03800O RMRDAT 124 ' - - ' 03810O RMPER22 132 03820O RMMETH 126 03830O*-------------------------------------------------------------- 03840O E 74 81 03850O* PUT TEXT LINE 03860O TXT 91 03870O TPLINEZ 29 03880O*------------------------------------------------------------------- 03890O E 0001 82 03900O 1 ' ' 03910O*------------------------------------------------------------------- 03920O E 1 83 03930O 1 ' ' 03940O******************************************************************** 03950OTERM80 E 84 03960O 18 'SET PRINTER 6-LPI' ** MES ARRAY 003970---MESSAGE NOT ON FILE--- 003980** TABTRN/TABNAM 003990AADD 004000ÐÐCCHANGE 004010DDELETE 004020** TABMET/TABMN 004030EESTIMATED 004040HHISTORICAL 004050** 004060 004070** 004080 004090/* 004100_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2ñ  ZCD048 P¾111083111083(èÈÐ * ZCD048 - OUTPUT BIDLST W/MFRPN, SORT VEND, MFRPN & LIST 00010INPUT=ZCD048 00020 * CREATE BIDLST 00030Q044CD 00040INPUT=ZCD048 00050UTIL 00060DEFINE,FN=BIDSRT,VL=D1,TY=S,LR=75,NR=388 00070EX 00080 * SORT TO PART NO. 00090INPUT=ZCD048 00100DSORT 00110FN=BIDLST, 00120F2=BIDSRT, ,D1 00130OP=TAG,F,E 00140KF=A,15,5,A,52,24 00150SL=I 00160 * LIST MFRPN BY VENDOR'S BID 00170 *48CD 00180 * END ZCD048 00190_‚ _‚_‚ ÐÈ(,Qz ,}X017BM P120282120282(èÈÐ00010H Q017BM00020F* FLAG PARTS USED BY ASSYS IN ENDITEM FILE (X017BM) 00030F* REV 1/24/80 11:55 AM. 00040F* 00050FENDITEM IP F 12 10AI 1 DISK 00060FPMMST UC F 576R12AI 1 DISK 00070FBMMAST ID F 86L20AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FPRINT O F 132 OF PRINTER 00100E******************************************************************** 00110E LEV 1 20 20 NEXT RRN AT EA LEVEL 00120I******************************************************************** 00130IENDITEM EF 01 00140I 1 100EFPN 00150I 11 11 EFFIL 00160I 12 12 EFSTAT 00170I******************************************************************** 00180IPMMST PM 00190I* PART MASTER RECORD (XPMMST) 00200I* KEY AREA 00210I* PART NO. 12A 00220I 1 12 PMPN 00230I* NUMB OF COMPONENTS 3P 00240I P 13 140PMNOBM 00250I* FILLER 1A 15 15 FFFFFF ÐÐ00260I* MODEL NAME 12A 00270I 24 35 PMMODL 00280I* USAGE FLAG 1A 00290I 36 36 USFLAG 00300I* DESCRIPTION 29A 00310I 48 76 PMDESC 00320I* RECORD STATUS 1A 00330I* D = DELETED 00340I 576 576 PMSTAT 00350I******************************************************************** 00360IBMMAST BM 00370I* BILL OF MATERIAL RECORD 00380I* KEY AREA 00390I* ASSY PART NO. 10N 00400I 1 100BMAPN 00410I* COMPONENT PART # 10N 00420I 11 200BMCPN 00430I* ITEM NO. 3N 00440I 25 270BMITNO 00450I* QTY PER ASSY 7P 00460I P 28 310BMQTY 00470I* SCRAP ALLOW .2N 00480I 34 352BMSCRP 00490I* ISSUE CODE 2A 00500I* PT = PULL TIME ÐÐ00510I* OR = ON REQUEST 00520I* BI = BULK ISSUE 00530I* AR = AS REQUIRED 00540I* RA = REF ASSY 00550I* TD = TRAV DOC 00560I* SD = SHIP DOC 00570I* RD = REF DOC 00580I* VS = VENDOR SUPPLIED 00590I 36 37 BMISSU 00600I* EFFECTIVITY. 00610I* BEGIN CHANGE LEVEL 2A 00620I 38 39 BMBCHG 00630I* ENDING CHANGE LEVEL 2A 00640I 40 41 BMECHG 00650I* BEGIN ECN # 5A 00660I 42 46 BMBECN 00670I* ENDING ECN # 5A 00680I 47 51 BMEECN 00690I* DISPOSITION CODE 1A 00700I* U = USE UP OLD STYLE 00710I* N = NOW (IMMEDIATE) 00720I 52 52 BMDISP 00730I* FILLER 5A 53 57 FFFFFF 00740I* ROUTING. 00750I* OPER NO. 5P ÐÐ00760I P 58 600BMOPER 00770I* DEPT NO. 5P 00780I P 61 630BMDEPT 00790I* WORK CENTER NO. 3P 00800I P 64 650BMWC 00810I* COMPONENT OPER REFERENCE INFO 10A 00820I 66 75 BMREF 00830I* FILLER 10A 76 85 FFFFFF 00840I* 00850I* RECORD STATUS 1A 00860I* D = DELETED 00870I 86 86 BMSTAT 00880I******************************************************************** 00890IMGFILE MG 00900I* MESSAGE FILE. 00910I* TEXT 35A 00920I 1 35 MGTEXT 00930I* LINE-2 35A 00940I 36 70 MGLIN2 00950I* PROG NAME 5A 00960I 71 75 MGPROG 00970C******************************************************************** 00980C* INITIALIZE 00990C N48 EXSR SR101 INIT 01000C EFSTAT COMP 'D' 54 ÐÐ01010C 54 SETOF 01 01020C 54 GOTO END 01030C MOVELEFPN W12A 12 01040C EXSR SR81 GET PMMST 01050C EXSR SR71 PRINT END ITEM 01060C EXSR SR72 UPDATE END-USE 01070C N60 GOTO TAG10 GOT IT 01080C Z-ADD302 M 50 96 FLAG ERROR 01090C EXSR SR73 PUT MSG 01100C GOTO END 01110C*-------------------------------------------------------------------- 01120C TAG10 TAG 01130C* FLAG NO COMPONENTS ON FILE 01140C PMNOBM COMP 0 55 01150C* SET-UP INITIAL BILL MATERIAL READ 01160C Z-ADD3 L 20 INDENTURE LEVEL 01170C MOVE BLK20 LEV 01180C MOVELEFPN LEV,2 01190C*----------------------------------------------------------------- 01200C TAG20 TAG 01210C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 01220C L SUB 1 L 54 INDENT LEVEL 01230C N54 GOTO END BOTTOM INDENT 01240C LEV,L COMP BLK20 54 01250C N54 GOTO TAG20 NONE THIS LEVEL ÐÐ01260C MOVE LEV,L W20A 20 01270C MOVELLEV,L CURASY 100 MATCH PART # 01280C MOVE BLK20 LEV,L 01290C*------------------------------------------------------------------ 01300C TAG30 TAG 01310C* SET-UP NEXT READ 01320C W20A SETLLBMMAST 01330C*--------------------------------------------------------------- 01340C TAG40 TAG 01350C* GET NEXT COMPONENT. 01360C SETOF 54 01370C READ BMMAST 54GET COMPONENT 01380C 54 GOTO TAG20 END OF FILE 01390C BMAPN COMP CURASY 54 01400C N54 GOTO TAG20 WRONG ASSY 01410C BMSTAT COMP 'D' 54 01420C 54 GOTO TAG40 DELETED RECORD 01430C* UPDATE COMPONENT USAGE FLAG 01440C MOVELBMCPN W12A 01450C EXSR SR81 GET COMPONENT PMMST 01460C N60 EXSR SR72 UPDATE COMPONENT 01470C* BRANCH IF NOT ASSY OR PREVIOUSLY FLAGGED. 01480C PMNOBM COMP 0 54 01490C N54 USFLAG COMP ' ' 54 USAGE FLAG 01500C N54 GOTO TAG40 NOT ASSY ÐÐ01510C*------------------------------------------------------------------ 01520C TAG50 TAG 01530C* SAVE CUR LEVEL ASSY/COMPONENT PART # 01540C MOVELBMAPN LEV,L 01550C 1 ADD BMCPN W10N 100 01560C MOVE W10N LEV,L 01570C MOVE BMCPN CURASY 01580C MOVELBMCPN W20A 01590C MOVE ZERO10 W20A 01600C 1 ADD L L INDENT LEVEL 01610C GOTO TAG30 01620C*----------------------------------------------------------------- 01630C END TAG 01640C SETOF 96 01650C**************************************************************** 01660CSR SR71 BEGSR 01670C* PRINT END USE ITEM 01680CSR SETON 71 01690CSR EXCPT 01700CSR SETOF 71 01710CSR ENDSR 01720C**************************************************************** 01730CSR SR72 BEGSR 01740C* PUT USAGE FLAG TO COMPONENT RECORD 01750CSR SETON 72 ÐÐ01760CSR EXCPT 01770CSR SETOF 72 01780CSR ENDSR 01790C******************************************************************** 01800CSR SR73 BEGSR 01810C* PUT PROMPT TO CRT. 01820CSR EXSR SR89 01830CSR 54 MOVELM MGTEXT 01840CSR SETON 73 01850CSR EXCPT PUT PROMPT. 01860CSR SETOF 73 01870CSR ENDSR 01880C******************************************************************** 01890CSR SR81 BEGSR 01900C* GET PART MAST. 01910CSR SETOF 61 01920CSR W12A CHAINPMMST 60 GET PMMST. 01930CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 01940CSR ENDSR 01950C******************************************************************** 01960CSR SR89 BEGSR 01970C* GET MGFILE. 01980CSR M CHAINMGFILE 54 GET MGFILE. 01990CSR 54 MOVE BLK35 MGTEXT 02000CSR 54 MOVELM MGTEXT ÐÐ02010CSR 54 MOVE 'NO MSG' MGTEXT 02020CSR ENDSR 02030C******************************************************************** 02040CSR SR101 BEGSR 02050C* INITIALIZE (1-TIME). 02060CSR Z-ADD0 PAGE OF 02070CSR SETON 48 02080CSR MOVE ' ' BLK35 35 02090CSR MOVE ' ' BLK12 12 02100CSR MOVE ' ' BLK20 20 02110CSR Z-ADD0 ZERO10 100 02120CSR ENDSR 02130O******************************************************************* 02140OPRINT H 201 OF 02150O 70 'END-ITEM DELETE CANDIDAT' 02160O 72 'ES' 02170O UDATE Y 8 02180O 115 'PAGE' 02190O PAGE Z 120 02200O*----------------------------------------------------------------- 02210O H 2 OF 02220O 11 'PART NUMBER' 02230O 23 'MODEL' 02240O 47 'DESCRIPTION' 02250O 82 'REMARKS' ÐÐ02260O*------------------------------------------------------------------ 02270O EF 1 71 02280O EFPN 12 ' - - ' 02290O N60 PMMODL 30 02300O N60 PMDESC 65 02310O*------------------------------------------------------------- 02320O E 1 73 02330O MGTEXT 110 02340O************************************************************* 02350OPMMST E 72 02360O PMNOBM 14P 02370O 36 'X' ** LEV ARRAY 002380 002390/* 002400_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(XR– XúX016GL P120282120282(èÈÐ00010H Q016GL00020F* DISPLAY CHART OF ACCOUNTS - INDENTED. (X016GL) D A T A G R A P H I X 00030F* REVISED 7-28-81 3:45 PM. DG-REL006 OK. 00040F* PARENT ACCOUNTS ONLY 00050F* MENU: MQGL01, MQGL02 00060FBITHEX IP F 256 DISK 00070FMGFILE IC F 80R DISK 00080FCAMAST ID F 40L18AI 1 DISK 00090FGLMAST IC F 165R 9AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A8 8 8 1 A INPUT DATA ARRAY 00140E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00150E DUN 13 13 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E LEV 1 20 18 00180E DASH 1 1 43 00190E A24 24 24 1 00200E BIT 256 1 SCREEN CONTR. CHAR 00210E GLA 12 11 2 00220E* 00230E* 00240I******************************************************************* 00250IBITHEX BT ÐÐ00260I 1 256 BIT 00270I******************************************************************* 00280IMGFILE MG 00290I* MESSAGE FILE. 00300I 1 35 MGTEXT 00310I******************************************************************** 00320IGLMAST GL 00330I* ACCOUNT MASTER. 00340I* KEY AREA 00350I* ACCOUNT # 9A 00360I 1 9 GLKEY 00370I 1 1 GLPRFX 00380I 2 60GLPRIM 00390I 7 90GLDASH 00400I* ACCOUNT GROUP 4A 00410I 14 17 GLGRUP 00420I* ACCOUNT DESCRIPTION 40A 00430I 18 57 GLDESC 00440I* BALANCE FORWARD AMOUNT 11.2P 00450I P 58 632GLBALF 00460I* ACTUAL $ 11.2P X 12 00470I P 64 135 GLA 00480I* CURRENT MONTH-PLUS 11.2P 00490I P 136 1412GLCMP 00500I* CURRENT MONTH-MINUS 11.2P ÐÐ00510I P 142 1472GLCMM 00520I* SOURCE CODE 1A 00530I* S = SUB-ACCOUNT ONLY, 00540I* MAY NOT BE PARENT 00550I 148 148 GLSC 00560I* BALANCE FORWARD CODE 2A 00570I* 1ST COL 00580I* 1 = ZERO BAL AT START NEW YR 00590I* 2 = CARRY PREV YR FRWD 00600I* 2ND COL 00610I* A = ZERO BAL AT START NEW MO 00620I* B = CARRY PREV MO FRWD 00630I 149 150 GLBFC 00640I* NUMB OF SUB-ACCOUNTS 5P 00650I P 157 1590GLNOSA 00660I* LOW LEVEL CODE 3N 00670I 160 1620GLLL 00680I* FILLER 00690I* RECORD STATUS 1A 00700I 165 165 GLSTAT 00710I******************************************************************** 00720ICAMAST CA 00730I* CHART OF ACCOUNTS. 00740I* KEY AREA. 00750I* PARENT ACCOUNT 9A ÐÐ00760I 1 9 CAPAR 00770I* SUB-ACCOUNT 9A 00780I 10 18 CASUB 00790I* OPERATOR 1A 00800I* S = SUBTRACT 00810I* A = ADD 00820I 25 25 CAOPER 00830I* EFFECTIVITY 00840I* START DATE 6N (YMD) 00850I 26 310CASDAT 00860I* END DATE 6N (YMD) 00870I 32 370CAEDAT 00880I* FILLER 00890I* RECORD STATUS 1A 00900I 40 40 CASTAT 00910C******************************************************************** 00920C* INITIALIZE 00930C EXSR SR101 1-TIME INIT 00940C*------------------------------------------------------------------ 00950C START TAG 00960C* SET-UP 1ST FIELD NO. 00970C MOVE ' ' DUN INIT EDIT ARRAY 00980C Z-ADD1 F 30 FIELD # 00990C GOTO READ 01000C*------------------------------------------------------------------ ÐÐ01010C NEXT TAG 01020C* SET-UP NEXT FIELD NO. 01030C 1 ADD F F FIELD # 01040C*----------------------------------------------------------------- 01050C READ TAG 01060C* READ DATA FROM TERMINAL. 01070C SETOF 9096 01080C EXSR SR102 VALIDATE FIELD # 01090C 55 GOTO UPDATE DONE 01100C EXSR SR201 IDENTIFY-F 01110C 01 GOTO NEXT 01120C 01 Z-ADD362 M 50 ENTER PREFIX 01130C 02 Z-ADD363 M ENTER PRIME 01140C 03 Z-ADD364 M ENTER DASH 01150C EXSR SR89 GET MSG 01160C SETON 69 01170C EXSR SR73 PROMPT 01180C SETOF 69 01190C EXSR SR75 READ TERMINAL 01200C 98 GOTO GOODBY GOODBY 01210C 94 GOTO MENU MENU REQUEST 01220C 93 GOTO NEWITM NEW ITEM 01230C 92 GOTO JUMP FIELD JUMP REQST 01240C 91 GOTO NEXT SKIP FORWARD 01250C 89 F SUB 1 F SKIP BACKWARD ÐÐ01260C 89 EXSR SR201 01270C 89 01 Z-ADD2 F 01280C 89 GOTO READ " " 01290C 88 SETOF 90 SPACE FILL 01300C 88 SETON 77 " " 01310C 87 GOTO START 01320C 86 GOTO UPDATE UPDATE 01330C 85 GOTO READ REPEAT 01340C 96 GOTO ERROR ERROR 01350C*------------------------------------------------------------------ 01360C PROCES TAG 01370C* PROCESS INPUT DATA 01380C EXSR SR103 MOVE DATA 01390C N96 EXSR SR104 EDIT DATA 01400C 96 GOTO ERROR ERROR 01410C GOTO NEXT 01420C*------------------------------------------------------------------ 01430C UPDATE TAG 01440C* UPDATE DATA BASE. 01450C EXSR SR106 UPDATE 01460C 96 GOTO ERROR ERROR 01470C GOTO START 01480C*------------------------------------------------------------------- 01490C JUMP TAG 01500C* SET-UP JUMP TO REQUESTED FIELD ÐÐ01510C 1 ADD W W 30 01520C W COMP 8 54 01530C 54 Z-ADD318 M 50 96 FLAG ERROR 01540C 54 GOTO ERROR BAD ESC 01550C MOVE ' ' W3A 3 01560C MOVEAA8,W W3A 01570C Z-ADD3 W2N 20 01580C EXIT SUBRAJ R. JUSTIFY 01590C RLABL W2N 01600C RLABL W3A 01610C MOVE W3A F NEW FIELD # 01620C GOTO READ 01630C*-------------------------------------------------------------------- 01640C ERROR TAG 01650C EXSR SR102 VALIDATE FIELD # 01660C EXSR SR89 GET MSG 01670C EXSR SR73 PUT MSG 01680C GOTO START 01690C*------------------------------------------------------------------ 01700C NEWITM TAG 01710C* SET-UP LINK FOR NEW ITEM 01720C MOVEL'Q016GL' PROG 8 01730C GOTO END 01740C*------------------------------------------------------------------- 01750C MENU TAG ÐÐ01760C* SET-UP LINK TO MENU 01770C MOVEL'QQGL02' PROG 01780C GOTO END 01790C*-------------------------------------------------------------------- 01800C GOODBY TAG 01810C* LINK TO SIGN-OFF 01820C MOVEL'GOODBY' PROG 01830C GOTO END 01840C*------------------------------------------------------------------- 01850C END TAG 01860C EXITFCHAIN LINK TO NEXT PROG 01870C RLABL PROG 01880C******************************************************************** 01890CSR SR3 BEGSR 01900C* EDIT INPUT. 01910CSR MOVE TKEY W9A 9 01920CSR EXSR SR80 GET GLMAST 01930CSR 60 Z-ADD302 M 96 FLAG ERROR 01940CSR 60 GOTO END3 01950CSR MOVE GLDESC PADESC 40 01960CSR MOVE GLSC PASC 1 01970CSR END3 ENDSR 01980C***************************************************************** 01990CSR SR70 BEGSR 02000C* CLEAR TERM SCREEN. ÐÐ02010CSR EXITFQTOPF CLEAR SCREEN 02020CSR ENDSR 02030C********************************************************************** 02040CSR SR71 BEGSR 02050C* PUT HEADINGS TO TERMINAL 02060CSR MOVELTKEY W9A 02070CSR EXSR SR80 GET TOP GLMAST 02080CSR EXSR SR204 SET-UP ACTNO 02090CSR SETON 71 02100CSR EXCPT PUT HEADINGS 02110CSR SETOF 71 02120CSR Z-ADD6 COUNT 30 02130CSR ENDSR 02140C********************************************************************* 02150CSR SR72 BEGSR 02160C* PUT DATA TO TERMINAL 02170CSR MOVE CASUB W9A 02180CSR EXSR SR80 GET GLMAST 02190CSR GLNOSA COMP 0 54 02200CSRN54 GOTO END72 NOT PARENT 02210CSR 1 ADD COUNT COUNT 30 02220CSR EXSR SR203 FLAG LEVEL 02230CSR EXSR SR204 BUILD ACCT # 02240CSR SETON 7278 02250CSR EXCPT PUT DATA ÐÐ02260CSR SETOF 72 02270CSR COUNT COMP 30 54 54 02280CSRN54 GOTO END72 02290CSR EXITFQEPAGE END PAGE MSG 02300CSR EXSR SR75 02310CSRN90 EXSR SR71 PUT HEADING 02320CSR END72 ENDSR 02330C*********************************************************************** 02340CSR SR73 BEGSR 02350C* PUT ERROR MESSAGE TO TERMINAL 02360CSR SETON 73 02370CSR EXCPT PUT MSG 02380CSR SETOF 73 02390CSR Z-ADDM LSTERR 50 02400CSR ENDSR 02410C******************************************************************* 02420CSR SR75 BEGSR 02430C* READ FROM TERMINAL 02440CSR SETOF 779096 02450CSR SETOF 939291 02460CSR SETOF 898887 02470CSR SETOF 8685 02480CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 02490CSR MOVE BLK8 W8A 8 BUFFER 02500CSR EXITFQWREED READ FROM TERMINAL ÐÐ02510CSR RLABL W8A READ BUFFER 02520CSR RLABL BUFLGT READ BUFFER LGTH 02530CSR MOVEAW8A A8 INPUT DATA ARRAY 02540CSR MOVE BLK8 W8A INIT INPUT ARRAY 02550CSR Z-ADD1 W 30 02560CSR '\' LOKUPA8,W 90 FLAG ESC 02570CSRN90 GOTO T75B NOT ESC 02580CSR 1 ADD W W 02590CSR W COMP 8 54 02600CSR 54 GOTO T75A BAD ESC 02610CSR A8,W COMP 'G' 98 GOODBY 02620CSR A8,W COMP 'E' 94 MENU 02630CSR A8,W COMP 'N' 93 NEW ITEM 02640CSR A8,W COMP 'J' 92 JUMP 02650CSR A8,W COMP 'F' 91 SKIP FRWRD 02660CSR A8,W COMP 'B' 89 SKIP BKWRD 02670CSR A8,W COMP 'S' 88 SPACE FILL 02680CSR A8,W COMP 'H' 87 HOME 02690CSR A8,W COMP 'U' 86 UPDATE 02700CSR A8,W COMP 'R' 85 REPEAT 02710CSR 98 02720COR 94 02730COR 93 02740COR 92 02750COR 91 ÐÐ02760COR 89 02770COR 88 02780COR 87 02790COR 86 02800COR 85 GOTO END75 GOOD ESC 02810C*------------------------------------------------------------------ 02820CSR T75A TAG 02830C* FLAG BAD ESC INPUT 02840CSR Z-ADD318 M 96 FLAG ERROR 02850CSR GOTO END75 02860C*-------------------------------------------------------------------- 02870CSR T75B TAG 02880C* MOVE DATA 02890CSR Z-ADD1 W 02900CSR ' ' LOKUPA8,W 77 02910CSR 77 MOVEAA8,W W8A INPUT DATA 02920CSR END75 ENDSR 02930C******************************************************************** 02940CSR SR76 BEGSR 02950C* END-ACCOUNT MSG. 02960CSR EXITFQEITEM END ITEM 02970CSR EXSR SR75 READ 02980CSR ENDSR 02990C********************************************************************** 03000CSR SR80 BEGSR ÐÐ03010C* GET MASTER RECORD 03020CSR SETOF 61 03030CSR W9A CHAINGLMAST 60 GET MASTER 03040CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 03050CSR ENDSR 03060C********************************************************************** 03070CSR SR89 BEGSR 03080C* GET MESSAGE MASTER 03090CSR M CHAINMGFILE 54 03100CSR 54 MOVE BLK35 MGTEXT 03110CSR 54 MOVELM MGTEXT 03120CSR 54 MOVE MES,1 MGTEXT 03130CSR ENDSR 03140C*********************************************************************** 03150CSR SR101 BEGSR 03160C* 1-TIME INITIALIZE 03170CSR MOVE BIT,1 NUL 03180CSR MOVEANUL NUL92 92 03190CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03200CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03210CSR MOVE ' ' BLK8 8 03220C* DEFINE WORK FIELDS,ETC. 03230CSR MOVE ' ' BLK35 35 03240CSR MOVE ' ' BLK9 9 03250CSR MOVE ' ' BLK18 18 ÐÐ03260CSR ENDSR 03270C********************************************************************** 03280CSR SR102 BEGSR 03290C* VALIDATE FIELD NO. 03300CSR F COMP 0 54 03310CSRN54 Z-ADD1 F 03320CSR F COMP FLIMIT 55 03330CSR 55 Z-ADD1 F 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR103 BEGSR 03370C* MOVE INPUT DATA 03380CSR EXSR SR201 IDENTIFY-F 03390CSR EXSR SR202 R. JUSTIFY 03400CSR 01 MOVELW8A TPRFX 1 ACCOUNT PREFIX 03410CSR 02 MOVE W8A TPRIM 50 ACCOUNT PRIME 03420CSR 03 MOVE W8A TDASH 30 ACCOUNT DASH 03430CSR 03 MOVELTPRFX TKEY 9 03440CSR 03 MOVELTPRIM W8A 8 03450CSR 03 MOVE TDASH W8A 03460CSR 03 MOVE W8A TKEY 03470CSR MOVE ' ' DUN,F EDIT FLAG 03480CSR ENDSR 03490C******************************************************************** 03500CSR SR104 BEGSR ÐÐ03510C* EDIT INPUT DATA 03520CSR 03 EXSR SR3 03530CSR 96 MOVE ' ' DUN,F EDIT FLAG 03540CSRN96 MOVE 'X' DUN,F 03550CSR ENDSR 03560C**************************************************************** 03570CSR SR106 BEGSR 03580C* DISPLAY CHART OF ACCOUNTS 03590CSR SETOF 78 03600CSR EXSR SR71 PUT HEADING 03610CSR Z-ADD1 L 30 03620CSR EXSR SR203 FLAG LEVEL 03630CSR EXSR SR204 BUILD ACTNO 03640CSR SETON 74 03650CSR EXCPT PUT LEVEL-1 03660CSR SETOF 74 03670CSR MOVE BLK18 LEV 03680CSR Z-ADD3 L 03690CSR MOVELTKEY LEV,2 03700C*------------------------------------------------------------------- 03710CSR T106A TAG 03720C* GET SAVED LOWER LEVEL SUB-ACCOUNTS, IF ANY. 03730CSR L SUB 1 L 54 INDENT LEVEL 03740CSRN54 GOTO T106R 03750CSR LEV,L COMP BLK18 54 ÐÐ03760CSRN54 GOTO T106A NONE THIS LEVEL 03770CSR MOVELLEV,L W18A 18 03780CSR MOVELLEV,L CURACT 9 MACH ACNT # 03790CSR MOVE BLK18 LEV,L 03800C*------------------------------------------------------------------- 03810CSR T106B TAG 03820CSR W18A SETLLCAMAST 03830C*------------------------------------------------------------------- 03840CSR T106C TAG 03850C* READ CHART ACCOUNTS FILE. 03860CSR SETOF 54 03870CSR READ CAMAST 54 03880CSR 54 GOTO T106A END FILE 03890CSR CAPAR COMP CURACT 54 03900CSRN54 GOTO T106A END ASSY 03910CSR CASTAT COMP 'D' 54 03920CSR 54 GOTO T106C DELETED 03930C* DISPLAY LINE ENTRY. 03940CSR EXSR SR72 PUT DATA 03950CSR 90 GOTO END106 ESCAPE 03960C* BRANCH IF NOT PARENT. 03970CSR GLNOSA COMP 0 54 03980CSRN54 GOTO T106C NOT PARENT 03990C*------------------------------------------------------------------- 04000CSR T106D TAG ÐÐ04010C* SAVE CUR ACCT + 1 AND CHASE NEXT LOWER INDENT. 04020CSR MOVE CASUB W9A 04030CSR MOVE CASUB W3N 30 04040CSR 1 ADD W3N W3N 04050CSR MOVE W3N W9A 04060CSR MOVE W9A LEV,L 04070CSR MOVELCURACT LEV,L SAVE PAR/SUB 04080CSR MOVE CASUB CURACT 04090CSR MOVELCASUB W18A 04100CSR MOVE BLK9 W18A 04110CSR 1 ADD L L NEW INDENT LEV 04120CSR GOTO T106B CHASE DOWN 04130C*------------------------------------------------------------------- 04140CSR T106R TAG 04150C* END ACCOUNT MSG. 04160CSR EXSR SR76 END ACCT MSG. 04170CSR END106 ENDSR 04180C************************************************************************ 04190CSR SR201 BEGSR 04200C* IDENTIFY FIELD NO. 04210CSR F COMP 1 01 04220CSR F COMP 2 02 04230CSR F COMP 3 03 04240CSR ENDSR 04250C********************************************************************** ÐÐ04260CSR SR202 BEGSR 04270C* RIGHT JUSTIFY 04280CSR F LOKUPNUM 54 04290CSRN54 GOTO END202 NOT NUMERIC FIELD 04300CSR Z-ADD8 W2N 20 04310CSR EXIT SUBRAJ R. JUSTIFY 04320CSR RLABL W2N 04330CSR RLABL W8A 04340CSR END202 ENDSR 04350C******************************************************************** 04360CSR SR203 BEGSR 04370C* FLAG INDENTURE LEVEL. 04380CSR L COMP 1 2121 04390CSR L COMP 2 22 04400CSR L COMP 3 23 04410CSR L COMP 4 24 04420CSR L COMP 5 25 04430CSR L COMP 6 26 04440CSR L COMP 7 27 04450CSR L COMP 8 28 04460CSR L COMP 9 29 04470CSR L COMP 10 30 04480CSR L COMP 11 31 31 04490CSR 21 Z-ADD1 L 04500CSR ENDSR ÐÐ04510C******************************************************************** 04520CSR SR204 BEGSR 04530C* BUILD ACTNO FIELD FOR OUTPUT. 04540CSR MOVEAGLPRFX A24 04550CSR GLPRFX COMP ' ' 54 04560CSRN54 MOVEA'_' A24,1 04570CSR MOVE GLPRIM W5A 5 04580CSR MOVEAW5A A24,2 04590CSR MOVE '-' A24,7 04600CSR MOVE GLDASH W3A 3 04610CSR MOVEAW3A A24,8 04620CSR MOVEAA24 ACTNO 10 04630CSR GLCMP SUB GLCMM CURNET 112 04640CSR ENDSR 04650O******************************************************************** 04660OTERM132 E 71 04670O* PUT HEADING - PARENT ACCOUNT. 04680O 62 'INDENTED CHART OF' 04690O 86 'ACCOUNTS - PARENTS ONLY' 04700O*------------------------------------------------------------------- 04710O E 71 04720O* PUT HEADING - SUB-ACCOUNT. 04730O 19 'ACCOUNT NO.' 04740O 91 'TYPE' 04750O 97 'OPER' ÐÐ04760O 114 'EFFECTIVITY' 04770O 131 'CUR-MO.' 04780O*------------------------------------------------------------------- 04790O E 71 04800O* 04810O 1 '1' 04820O 4 '2' 04830O 7 '3' 04840O 10 '4' 04850O 13 '5' 04860O 16 '6' 04870O 19 '7' 04880O 22 '8' 04890O 25 '9' 04900O 29 '10' 04910O 32 '11' 04920O 60 '<--------------' 04930O 71 'DESCRIPTION' 04940O 85 '------------->' 04950O 91 'CODE' 04960O 97 'CODE' 04970O 107 'START' 04980O 115 'STOP' 04990O 131 'NET-BAL' 05000O*------------------------------------------------------------------- ÐÐ05010O E 71 05020O DASH 43 05030O*------------------------------------------------------------------- 05040O E 72 05050O* SUB-ACCOUNT DATA. 05060O DASH 43 05070O 21 ACTNO 13 05080O 22 ACTNO 16 05090O 23 ACTNO 19 05100O 24 ACTNO 22 05110O 25 ACTNO 25 05120O 26 ACTNO 28 05130O 27 ACTNO 31 05140O 28 ACTNO 34 05150O 29 ACTNO 37 05160O 30 ACTNO 40 05170O 31 ACTNO 43 05180O GLDESC 85 05190O GLSC 90 05200O CAOPER 95 05210O CURNETK 132 05220O CASDAT 108 ' - - ' 05230O CAEDAT 118 ' - - ' 05240O*------------------------------------------------------------------- 05250O E 74 ÐÐ05260O OR 71 78 05270O DASH 43 05280O ACTNO 13 05290O 78 71 21 'CONT''D' 05300O PADESC 85 05310O PASC 89 05320O CURNETK 132 05330O*------------------------------------------------------------------- 05340O E 73 05350O* PUT MESSAGE. 05360O NUL92 132 05370O 96 5 '*****' 05380O N96 5 ' ' 05390O MGTEXT 40 05400O BIT,8 132 ** NUL ARRAY 005410 005420** A8 ARRAY 005430 005440** NUM ARRAY 005450002 PAR PRIME 005460003 PAR DASH 005470** DUN ARRAY 005480 005490** MES ARRAY 005500ÐÐ---MESSAGE NOT ON FILE--- 005510** LEV ARRAY 05520 05530** DASH ARRAY 05540. . . . . . . . . . . . . . . 005550** A24 ARRAY 005560 005570/* 005580_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(<S‘ <X017QM P120282120282(èÈÐ00010H Q017QM00020F* RE-ORG QMMAST AND ALT-KEY FILES. (X017QM) 00030F* REVISED 1/03/80 9:15 AM. 00040FQMMAST IP F 160 8AI 1 DISK 00050FQSKEY IS F 18 17AI 1 DISK 00060FQCKEY IS F 29 28AI 1 DISK 00070FQFKEY IS F 15 14AI 1 DISK 00080FQMREORG O F 160 8AI 1 DISK 00090FQSREORG O F 18 17AI 1 DISK 00100FQCREORG O F 29 28AI 1 DISK 00110FQFREORG O F 15 14AI 1 DISK 00120I******************************************************************** 00130IQMMAST QM 01 160NCD 00140I OR 05 00150I 1 160 RECQM 00160I******************************************************************** 00170IQSKEY QS 02 18NCD 00180I OR 05 00190I 1 18 RECQS 00200I******************************************************************** 00210IQCKEY QC 03 29NCD 00220I OR 05 00230I 1 29 RECQC 00240I******************************************************************** 00250IQFKEY QF 04 15NCD ÐÐ00260I OR 05 00270I 1 15 RECQF 00280O******************************************************************** 00290OQMREORG D 01 00300O RECQM 160 00310O******************************************************************** 00320OQSREORG D 02 00330O RECQS 18 00340O******************************************************************** 00350OQCREORG D 03 00360O RECQC 29 00370O******************************************************************** 00380OQFREORG D 04 00390O RECQF 15 /* 000400_‚ ÐÐ _‚_‚0O RECQC 29 00370O******************************************************************** 00380OQFREORG D 04 00390O RECQF 15 /* 000400_‚ ÐÈ(dS« d*X016XP P120282120282(èÈÐ00010H Q016XP00020F* COMPUTE USAGE TOTAL $. (X016XP) 00030F* REVISED 5/02/82 10:30 AM. 00040F*---------------------------------------------------------------- 00050F*----------------------------------------------------------------- 00060FXPMAST IP F 99 22AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FABCTOTALO F 16 DISK 00090E******************************************************************** 00100E XPQ 18 7 0 00110I******************************************************************** 00120IXPMAST XP 01 99NCD 00130I* PART # 10N 00140I 3 120XPCPN 00150I* REQMT QTY 7P X 18 00160I P 23 94 XPQ 00170I GG 02 00180I******************************************************************** 00190IPMMST2 PM 00200I 94 94 PMSC 00210I P 489 4933PMOSUC 00220C******************************************************************** 00230C N01 GOTO END 00240C MOVELXPCPN W4N 40 00250C MOVELXPCPN W12A 12 ÐÐ00260C W12A CHAINPMMST2 54 00270C 54 SETOF 01 00280C 54 GOTO END 00290C PMSC COMP 'P' 01 00300C N01 GOTO END 00310C XFOOTXPQ W7N 70 00320C PMOSUC MULT W7N W8D2 82H 00330C W8D2 ADD TOTAL TOTAL 102H 00340C*------------------------------------------------------------------- 00350C END TAG 00360O******************************************************************** 00370OABCTOTALT LR 00380O TOTAL 10 /* 00390_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(úSÖ úiX018CF P6120282120282(èÈÐ00010H Q018CF00020F* PRINT CFKEYOUT BY ZIP CDE,ADDROUT. (X018CF) 00030F* REVISED 12/23/80 1:00 PM. DG-REL006 OK. 00040F* SWITCH-8 USES CFSTART FILE FOR RE-START. 00050FCFSTART IP F 80 DISK 00060FCFKEYOUTIS F 59 59R I DISK 00070FCFADRT IR F 300 3 3IT EDISK 00080FCFMAST IC F 370R15AI 1 DISK 00090FPRINT O F 132 OF PRINTER 00100E******************************************************************** 00110E CFADRT CFKEYOUT 00120E NA4 5 5 6 00130E NB4 5 5 4 0 00140E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00150E BIT 33 1 00160E CFA 8 35 00170E CFN 5 3 00180E CFC 5 3 0 00190E NAC 24 1 00200I******************************************************************** 00210ICFKEYOUTCK 00220I 36 50 CKKEY 00230I 51 590CKZIP 00240I******************************************************************** 00250ICFSTART CS 02 ÐÐ00260I 1 15 CSKEY 00270I******************************************************************** 00280ICFMAST CF 01 00290I* CATALOG HOLDER (MAIL LIST) MASTER. 00300I* KEY AREA. 00310I* NAME KEY 15A 00320I 1 15 CFKEY 00330I* ADDRESS LINES 35A X 8 00340I 16 295 CFA 00350I* STATE CODE 2A 00360I 296 297 CFSTCD 00370I* ZIP 9P 00380I P 298 3020CFZIP 00390I* CATALOGS. 00400I* NAME 3A X 5 00410I 303 317 CFN 00420I* COPIES 3P X 5 00430I P 318 327 CFC 00440I* SELECTOR CODES 24 X 1A 1 00450I 328 351 NAC 00460I* TELEPHONE # 12A 00470I 352 363 CFTEL 00480I* DATE LAST TRAN 6N (YMD) 00490I 364 3690CFDLT 00500I* RECORD STATUS 1A ÐÐ00510I 370 370 CFSTAT 00520C******************************************************************** 00530C* INITIALIZE - 1 TIME. 00540C N79 EXSR SR101 INIT. 00550C*------------------------------------------------------------------- 00560C 02 GOTO END 00570C* BYPASS RECORDS PRIOR TO MATCH ON CKKEY. 00580C NU8 SETON 77 00590C 77 GOTO TAG10 00600C CKKEY COMP CSKEY 77 00610C N77 SETOF 01 00620C N77 GOTO END 00630C*------------------------------------------------------------------- 00640C TAG10 TAG 00650C CKKEY CHAINCFMAST 54 00660C SETOF 65 00670C CFSTAT COMP 'D' 54 00680C 54 SETOF 01 00690C 54 GOTO END DELETED CFMAST. 00700C CFSTCD COMP ' ' 54 00710C 54 CFSTCD LOKUPTABSC 54 00720C 'E' LOKUPNAC 55 00730C CFA,8 COMP BLK35 57 00740C 57 54 00750COR 57N55 SETON 65 ÐÐ00760C MOVE CFN NA4 00770C Z-ADDCFC NB4 00780C CFSTCD COMP ' ' 54 00790C 54 CFSTCD LOKUPTABSC TABSCN 54 00800C 54 MOVE TABSCN W25A 25 00810C N54 MOVE BLK35 W25A 00820C*------------------------------------------------------------------- 00830C END TAG 00840C******************************************************************** 00850CSR SR101 BEGSR 00860C* INITIALIZE 1-TIME. 00870CSR SETON 79 00880CSR MOVE ' ' BLK16 16 00890CSR MOVE ' ' BLK35 35 00900CSR ENDSR 00910O******************************************************************** 00920OPRINT H 201 1P 00930O OR OF 00940O* PUT HEADINGS. 00950O UDATE Y 8 00960O 55 'MAILING LIST REPORT' 00970O 76 '-ZIP CODE SEQUENCE' 00980O 127 'PAGE' 00990O PAGE Z 132 01000O H 2 1P ÐÐ01010O OR OF 01020O* PUT HEADINGS. 01030O 10 'KEY FIELD' 01040O 47 'N A M E A N D A D D ' 01050O 54 'R E S S' 01060O 92 'S E L E C T O R C O D ' 01070O 95 'E S' 01080O 123 'MAILER CODES' 01090O*------------------------------------------------------------------- 01100O D 21 01 01110O* PUT DATA. 01120O CFKEY 15 01130O 22 'NAME' 01140O CFA,1 66 01150O NAC 94 01160O NA4 131 01170O*------------------------------------------------------------------- 01180O D 1 01 01190O 23 'TITLE' 01200O CFA,2 66 01210O NB4 Z 131 01220O*------------------------------------------------------------------- 01230O D 1 01 01240O 25 'COMPANY' 01250O CFA,3 66 ÐÐ01260O*------------------------------------------------------------------- 01270O D 1 01 01280O 25 'COMPANY' 01290O CFA,4 66 01300O*------------------------------------------------------------------- 01310O D 1 01 01320O 25 'ADDRESS' 01330O CFA,5 66 01340O*------------------------------------------------------------------- 01350O D 1 01 01360O 25 'ADDRESS' 01370O CFA,6 66 01380O 79 'TELEPHONE:' 01390O CFTEL 92 01400O 110 'LAST UPDATED:' 01410O CFDLT Y 118 01420O*------------------------------------------------------------------- 01430O D 1 01 01440O 22 'CITY' 01450O CFA,7 66 01460O 74 'STATE' 01470O 79 ':' 01480O CFSTCD 82 01490O W25A 104 01500O 112 'ZIP:' ÐÐ01510O CFZIP Z 122 01520O*------------------------------------------------------------------- 01530O D 1 01 01540O 30 'FOREIGN CTRY' 01550O CFA,8 66 01560O*------------------------------------------------------------------- 01570O D 1 01 65 01580O 19 '*** INVALID COUNTRY' ** NA4 ARRAY 001590 001600** NB4 ARRAY 001610 001620** TABSC/TABSCN --- STATE CODES/NAMES 001630 001640ALALABAMA 001650AKALASKA 001660AZARIZONA 001670ARARKANSAS 001680ASAMERICAN SAMOA 001690CACALIFORNIA 001700CZCANAL ZONE 001710COCOLORADO 001720CTCONNECTICUT 001730DEDELAWARE 001740DCDISTRICT OF COLUMBIA 001750ÐÐFLFLORIDA 001760GAGEORGIA 001770GUGUAM 001780HIHAWAII 001790IDIDAHO 001800ILILLINOIS 001810ININDIANA 001820IAIOWA 001830KSKANSAS 001840KYKENTUCKY 001850LALOUISIANA 001860MEMAINE 001870MDMARYLAND 001880MAMASSACHUSETTS 001890MIMICHIGAN 001900MNMINNESOTA 001910MSMISSISSIPPI 001920MOMISSOURI 001930MTMONTANA 001940NENEBRASKA 001950NVNEVADA 001960NHNEW HAMPSHIRE 001970NJNEW JERSEY 001980NMNEW MEXICO 001990NYNEW YORK 002000ÐÐNCNORTH CAROLINA 002010NDNORTH DAKOTA 002020OHOHIO 002030OKOKLAHOMA 002040OROREGON 002050PAPENNSYLVANIA 002060PRPUERTO RICO 002070RIRHODE ISLAND 002080SCSOUTH CAROLINA 002090SDSOUTH DAKOTA 002100TNTENNESSEE 002110TTTRUST TERRITORIES 002120TXTEXAS 002130UTUTAH 002140VTVERMONT 002150VAVIRGINIA 002160VIVIRGIN ISLANDS 002170WAWASHINGTON 002180WVWEST VIRGINIA 002190WIWISCONSIN 002200WYWYOMING 002210/* 002220_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(KT@ K X018GL P120282120282(èÈÐ00010H Q018GL00020F* UPDATE WHERE-USED FILE. CALLED BY Q003GL. (X018GL) 00030F* REVISED 7/28/81 3:25 PM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060FGLWU UC F 19R18AI 1 DISK A 00070I******************************************************************** 00080IBITTAB BT 00090I 1 33 BIT 00100I******************************************************************** 00110ICRTFILE CR 00120I 81 89 CRPAR 00130I 90 98 CRSUB 00140I 103 1050CRTLIN 00150I 106 106 CRTRAN 00160I******************************************************************** 00170IGLWU GW 00180I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00190I* KEY AREA. 00200I* SUB-ACCOUNT 9A 00210I 1 9 GWSUB 00220I* PARENT ACCOUNT 9A 00230I 10 18 GWSUB 00240I* RECORD STATUS 1A 00250I 19 19 GWSTAT ÐÐ00260C******************************************************************** 00270C MOVE ' ' W8A 8 00280C Z-ADD0 W2N 20 00290C Z-ADD0 W1N 10 00300C MOVE ' ' W2A 2 00310C EXITFPGMINX 00320C RLABL W8A 00330C RLABL W2N 00340C RLABL W1N 00350C RLABL W2A 00360C MOVE W2A PORT 20 00370C PORT COMP 0 54 00380C N54 Z-ADD25 PORT 00390C PORT CHAINCRTFILE 00400C MOVELCRSUB W18A 18 00410C MOVE CRPAR W18A 00420C W18A CHAINGLWU 60 00430C SETON 80 00440C EXCPT UPDATE GLWU 00450C SETOF 80 00460C MOVEL'Q003GL' PROG 8 00470C EXITFCHAIN 00480C RLABL PROG 00490O******************************************************************** 00500OGLWU EADD 80 60 ÐÐ00510O W18A 18 00520O CRTRAN 19 00530O*------------------------------------------------------------------- 00540O E 80N60 00550O CRTRAN 19 /* 000560_‚ ÐÐ_‚_‚0O W18A 18 00520O CRTRAN 19 00530O*------------------------------------------------------------------- 00540O E 80N60 00550O CRTRAN 19 /* 000560_‚ ÐÈ(Ta XRED16 P999999120282(èÈÐ SUBROUTINE ZRED16 (IRPG) 00010* READ 16 BYTES FROM TERMINAL AND RETURN TO RPG PROG 00020 DIMENSION IRPG (8) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 16 00070 ITC = 0 00080 IBELL = $0700 00090 CALL WTREAD (ILU,IXY,IBELL,N1,IXY,IRPG,N2,ITC) 00100 RETURN 00110 END 00120_‚ _‚_‚ ÐÈ(Ti §X018QM P120282120282(èÈÐ00010H Q018QM00020F* PRINT P,E,C,W,L TYPE QUOTES BY PRODUCT. (X018QM) 00030F* REVISED 7/18/81 2:30 PM. DG-REL006 OK. *** D I A B L O *** 00040FBITHEX IP F 256 DISK 00050FQMMAST IS F 160R I DISK 00060FQMADRT IR F 300 3 3IT EDISK 00070FSLMNAME IT F 80 EDISK 00080FCRTFILE UC F 256R DISK 00090E******************************************************************** 00100E QMADRT QMMAST 00110E SLMNAME TABSLS 1 15 3 TABNAM 20 SALESMEN 00120E TABSTC 1 6 1 TABSTN 10 STATUS NAME 00130E TABPRD 1 18 2 TABPRN 20 PRODUCT CODES 00140E L2T 1 1 25 00150E LRT 1 1 25 00160E HED 1 8 66 00170E REC 132 1 00180E BIT 256 1 SCREEN CONTR. CHAR 00190E QMD 6 7 0 CALL STACK 00200I******************************************************************* 00210IBITHEX BT 01 00220I 1 256 BIT 00230I******************************************************************** 00240ICRTFILE CR 00250I 125 256 REC ÐÐ00260I******************************************************************** 00270IQMMAST QM 02 160NCD 00280I* QUOTE MASTER. 00290I* QUOTE # 5A 00300I 1 5 QMQOTEL1 00310I* ITEM # 3N 00320I 6 80QMITEM 00330I* CUSTOMER NAME 20A 00340I 9 28 QMNAME 00350I* CUSTOMER RFQ # 20A 00360I 29 48 QMRFQ 00370I* RFQ ITEM # 4A 00380I 49 52 QMRFQI 00390I* CONTACT 20A 00400I 53 72 QMCONT 00410I* ASSIGNED TO (SALESMAN) 3A 00420I 73 75 QMSLSM 00430I* DATE ARRAY 7P X 6 00440I* 1 = RECEIVED 00450I* 2 = DUE 00460I* 3 = SENT 00470I* 4 = EXPECTED AWARD 00480I* 5 = FOLLOW-UP 00490I* 6 = NOT USED 00500I P 76 99 QMD ÐÐ00510I* PRODUCT CLASS 2A 00520I 100 101 QMPCLSL2 00530I* SYSTEM CODE 1A 00540I 102 102 QMSYST 00550I* FILLER 103 103 FFFFFF 00560I* QUOTE AMOUNT 7P ($) 00570I P 104 1070QMAMT 00580I* DELIVERY PROMISED (DAYS ARO) 3P 00590I P 108 1090QMDEL 00600I* STATUS 1A 00610I* E = ENTERED 00620I* N = NO BID 00630I* B = BID 00640I* P = PENDING 00650I* L = LOST 00660I* W = WON 00670I* C = CANCELLED 00680I 110 110 QMSCOD 00690I* PROBABILITY OF AWARD 3.2P 00700I P 111 1122QMPROB 00710I* WON/LOST REASON 1A 00720I 113 113 QMREAS 00730I* REMARKS 40A 00740I 114 153 QMREM 00750I* RECORD STATUS 1A ÐÐ00760I 160 160 QMSTAT 00770I GG 03 00780I* GARBAGE RECORD. 00790C******************************************************************** 00800C* INITIALIZE/TOP OF FORM. 00810C EXSR SR101 INIT. 00820C* BYPASS BITHEX FILE. 00830C N02 GOTO END 00840C* BYPASS QM DELETES. 00850C QMSTAT COMP 'D' 55 00860C 55 SETOF 02 00870C N02 GOTO END 00880C* CUM $ TOTALS. 00890C QMAMT ADD QTOT QTOT 80 $ AMOUNT. 00900C QMAMT ADD GTOT GTOT 110 GRAND TOTAL. 00910C QMAMT ADD PTOT PTOT 90 PRODUCT TOTAL. 00920C* GET PRODUCT NAME. 00930C QMPCLS LOKUPTABPRD TABPRN 78 00940C* PRINT LINE. 00950C EXSR SR102 PUT LINE. 00960C*------------------------------------------------------------------- 00970C END TAG 00980CL2 82 EXSR SR66 LF 00990CL2 82 SETON 70 01000CL2 82 EXSR SR69 ÐÐ01010CLR EXSR SR66 LF 01020CLR SETON 74 01030CLR EXSR SR69 01040CLR EXSR SR67 TOP FORM. 01050C*------------------------------------------------------------------- 01060CLR ENDJOB TAG 01070C******************************************************************** 01080CSR SR66 BEGSR 01090CSR EXITFQCLF LF 01100CSR 1 ADD COUNT COUNT 30 01110CSR ENDSR 01120C******************************************************************** 01130CSR SR67 BEGSR 01140CSR EXITFZTFORM TOP FORM 01150CSR 1 ADD EGAP EGAP 40 01160CSR Z-ADD0 COUNT 01170CSR ENDSR 01180C******************************************************************** 01190CSR SR69 BEGSR 01200C* PRINT. 01210CSR EXSR SR66 LF 01220CSR PORT CHAINCRTFILE H9 01230CSR H9 GOTO ENDJOB 01240CSR MOVE ' ' REC 01250CSR EXCPT ÐÐ01260CSR SETOF 74 01270CSR SETOF 407270 01280CSR PORT CHAINCRTFILE 54 01290CSR MOVEAREC W148A 148 01300CSR EXITFZD148 PRINT 01310CSR RLABL W148A 01320CSR ENDSR 01330C******************************************************************** 01340CSR SR101 BEGSR 01350C* INITIALIZE. 01360CSR SETOF 80 ACTIVE ITEM FLAG. 01370CSR L1 SETOF 81 ACTIVE QUOTE FLAG. 01380CSR L2 SETOF 82 ACTIVE PROD FLAG. 01390CSR L2 Z-ADD0 PTOT 01400CSR 79 GOTO END101 01410CSR SETON 79 01420CSR Z-ADD0 ZERO5 50 01430CSR MOVE ' ' BLK15 15 01440CSR MOVE ' ' BLK8 8 01450CSR MOVE ' ' BLK20 20 01460CSR MOVE ' ' BLK148148 01470C* GET CRTFILE. 01480CSR MOVE BLK8 W8A 8 01490CSR Z-ADD0 W1N 10 01500CSR Z-ADD0 W2N 20 ÐÐ01510CSR MOVE ' ' W2A 2 01520CSR EXITFPGMINX GET PORT #. 01530CSR RLABL W8A 01540CSR RLABL W2N 01550CSR RLABL W1N 01560CSR RLABL W2A 01570CSR MOVE W2A PORT 20 01580CSR PORT COMP 0 54 01590CSRN54 Z-ADD25 PORT 01600CSR Z-ADD70 COUNT 01610CSR MOVELBIT,99 LASTPC 01620CSR END101 ENDSR 01630C******************************************************************** 01640CSR SR102 BEGSR 01650C* BUILD QUOTE ITEM PRINT LINE. 01660CSR COUNT COMP 60 54 54 01670CSR QMPCLS COMP LASTPC 55 01680CSRN55 01690COR 54 EXSR SR103 01700CSR QMPROB COMP 0 56 01710CSR QMSCOD LOKUPTABSTC TABSTN 57 01720CSR QMSLSM LOKUPTABSLS TABNAM 58 01730CSR SETON 72 01740CSR EXSR SR69 PRINT 01750CSR MOVE QMPCLS LASTPC 2 ÐÐ01760CSR SETON 82 01770CSR END102 ENDSR 01780C******************************************************************** 01790CSR SR103 BEGSR 01800C* PUT HEADINGS. 01810CSR EXSR SR67 TOP FORM 01820CSR Z-ADD0 X 30 01830C*------------------------------------------------------------------- 01840CSR T103A TAG 01850CSR 1 ADD X X 01860CSR X COMP 4 54 01870CSR 54 GOTO END103 01880CSR 2 MULT X H2 30 01890CSR H2 SUB 1 H1 30 01900CSR X COMP 1 41 01910CSR X COMP 2 42 01920CSR X COMP 3 43 01930CSR X COMP 4 44 01940CSR SETON 40 01950CSR EXSR SR69 PRINT 01960CSR 41 01970COR 42 01980COR 44 EXSR SR66 LF 01990CSR SETOF 414243 02000CSR SETOF 44 ÐÐ02010CSR GOTO T103A 02020CSR END103 ENDSR 02030O******************************************************************** 02040OCRTFILE E 72 02050O REC 256 02060O QMNAME 144 02070O QMQOTE 151 02080O QMITEM 155 02090O 152 '-' 02100O QMAMT 2 166 02110O QMPROBZ 170 02120O 56 171 '%' 02130O N56 171 ' ' 02140O QMD,4 195 ' - - ' 02150O QMDEL Z 182 02160O QMD,3 205 ' - - ' 02170O QMSCOD 209 02180O 57 TABSTN 223 02190O N57 BLK20 233 02200O 58 TABNAM 256 02210O N58 BLK20 256 02220O*------------------------------------------------------------------- 02230O E 40 02240O REC 256 02250O HED,H1 190 ÐÐ02260O HED,H2 256 02270O 41 UDATE 132 ' - - ' 02280O 41 EGAP Z 255 02290O 42 QMPCLS 135 02300O 42 78 TABPRN 157 02310O*------------------------------------------------------------------- 02320O E 70 02330O REC 256 02340O L2T,1 149 02350O PTOT 2B 167 02360O*------------------------------------------------------------------- 02370O E 74 02380O REC 256 02390O LRT,1 149 02400O GTOT 2 167 ** TABSTC/TABSTN - STATUS NAMES 002410EENTERED 002420NNO BID 002430PPENDING 002440LLOST 002450WWON 002460CCANCELLED 002470** TABPRD/TABPRN - PRODUCT CODE NAMES 00248011MINI SERIES 00249012SERIES 1500 002500ÐÐ21SERIES 1000 00251022SERIES 3000 00252023SERIES 5900 00253024SERIES 5300 00254041SERIES X 00255042SERIES 10 00256051SERIES 5100 00257052SERIES 1400 00258053SERIES 8100 002590541400/8100 CONTROLS 00260055SYSTEM 21 00261059OTHER SYSTEMS 00262060RF EQUIPMENT 00263070EQUA-DYNE EQUIPMENT 00264090MISC. EQUIPMENT 00265099SKY 515 002660** L2T ARRAY 002670TOTAL AMOUNT. . . . . . . 002680** LRT ARRAY 002690GRAND TOTAL . . . . . . . 002700** HED ARRAY 002710 QUOTES BY PRODUCT 002720 PAGE 002730PRODUCT : 002740 002750ÐÐCUSTOMER DYNAIR QUOTE PROB OF PROMISED EX 002760PECTED DATE STATUS 002770 NAME QUOTE AMOUNT AWARD DAYS-ARO 002780DATE SENT CODE PREP BY: 002790/* 002800_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ÈU ÈTX030WO P999999120282(èÈÐ00010H Q030WO00020F* WO-SERIES PROG LOADER 00030F* REVISED 8-24-82 4:30 PM. 00040FBITPAR IP F 90 DISK 00050FWOLUNO UC F 16R 2AI 1 DISK 00060FWOBATCH UC F 64R DISK 00070FCRTFILE UC F 256R DISK 00080FWOPROG IT F 80 EDISK 00090FTERM50 O F 50 5 00100E*------------------------------------------------------------------- 00110E LNK 1 7 6 A 00120E WOPROG TABCOD 1 25 2 TABPRG 6 00130E PAR 25 1 00140E TST 25 1 00150E CALL 7 6 00160I*------------------------------------------------------------------ 00170IBITPAR BP 00180I 1 33 BIT 00190I 34 58 PAR 00200I 59 83 TST 00210I****************************************************************** 00220IWOLUNO WU 00230I* WORK ORDER CONTROL RECORD 00240I* LAST PROCESSED WOBATCH RECORD 5N 00250I 8 120WULPB ÐÐ00260I**************************************************************** 00270IWOBATCH WB 00280I* WORK ORDER BATCH FILE 00290I* RECORD CODE 2A 00300I* RW = RELEASE WORK ORDER 00310I* DW = DELETE WORK ORDER 00320I* CW = CHANGE WORK ORDER 00330I 1 2 WBREC 00340I* WORK ORDER NO. 9A 00350I 3 11 WBWO 00360I* CURRENT QUANTITY 7P 00370I P 12 150WBQTY 00380I* CURRENT DUE DATE 6N 00390I 16 210WBDUE 00400I* CURRENT START DATE 6N 00410I 22 270WBSTRT 00420I* OLD QTY 7P 00430I P 28 310WBQTYO 00440I* OLD DUE DATE 6N 00450I 32 370WBDUEO 00460I* OLD START DATE 6N 00470I 38 430WBSDO 00480I* QTY COMPLETE 7P 00490I P 44 470WBQTYC 00500I* WO PART # 10N ÐÐ00510I 48 570WBPN 00520I* RECORD STATUS 1A 00530I 64 64 WBSTAT 00540I******************************************************************* 00550ICRTFILE CR 00560I* TERMINAL CONTROL FILE 00570I 28 330CRTIME 00580I 34 370CRDATE 00590I 38 79 CALL 00600I P 81 830RRN 00610C***************************************************************** 00620C SETON 70 00630C U1 EXCPT TERM50 MSG 00640C SETOF 70 00650C MOVE ' ' W2A 2 00660C EXITFZGMINX GET PORT NO. 00670C RLABL W2A 00680C MOVE W2A # 20 00690C # COMP 0 54 00700C N54 Z-ADD25 # PORT NO. 00710C EXSR SR96 GET CRTFILE 00720C MOVE CALL LNK 00730C MOVE 'Q030WO 'PROG 00740C PAR,# COMP '1' 50 00750C TST,# COMP 'S' 54 ÐÐ00760C 54 MOVE 'SHUTDOWN'PROG 8 00770C EXSR SR97 UPDATE CRTFILE 00780C 54 EXSR SR98 >>>>>>>>>>>>>>>>> 00790C MOVEL' 'PROG 00800C*------------------------------------------------------------------- 00810C START TAG 00820C MOVE '@ ' W2A 2 00830C W2A CHAINWOLUNO H6 GET WOLUNO 00840C H6 GOTO ENDJOB 00850C 1 ADD WULPB WULPB 00860C WULPB CHAINWOBATCH 54 GET WOBATCH 00870C N54 GOTO TAG15 00880C Z-ADD1 W 30 00890C ' ' LOKUPLNK,W 54 00900C 54 MOVELLNK,W PROG 00910C 54 MOVE ' ' LNK,W 00920C N54 MOVEL'CONTU' PROG 8 00930C EXSR SR96 GET CRTFILE 00940C EXSR SR97 UPDATE CRTFILE 00950C EXSR SR98 >>>>>>>>>>>>>>>> 00960C*------------------------------------------------------------- 00970C TAG15 TAG 00980C SETON 80 00990C EXCPT UPDATE WOLUNO 01000C SETOF 80 ÐÐ01010C WBSTAT COMP 'D' 54 01020C 54 GOTO START WOBATCH DELETED 01030C WBREC LOKUPTABCOD TABPRG 54 GET PROG NAME 01040C N54 SETON H8 01050C N54 GOTO ENDJOB 01060C MOVELTABPRG PROG 8 01070C EXSR SR99 >>>>>>>>>>>>>>>>>> 01080C*------------------------------------------------------------------ 01090C ENDJOB TAG 01100C MOVEL'ENDJOB' PROG 01110C EXSR SR98 >>>>>>>>>>>>>>>>>>> 01120C******************************************************************** 01130CSR SR96 BEGSR 01140CSR # CHAINCRTFILE H9 01150CSR H9 GOTO ENDJOB 01160CSR ENDSR 01170C******************************************************************** 01180CSR SR97 BEGSR 01190CSR TIME CRTIME 01200CSR MOVELUDATE CRDATE 01210CSR SETON 97 01220CSR EXCPT UPATE CRTFILE 01230CSR SETOF 97 01240CSR ENDSR 01250C********************************************************************* ÐÐ01260CSR SR98 BEGSR 01270CSR EXITFCHAIN >>>>>>>>>>>>>>>>> 01280CSR RLABL PROG 01290CSR ENDSR 01300C*************************************************************** 01310CSR SR99 BEGSR 01320C* STORE THIS PROG AS RETURN-TO PROG 01330CSR EXSR SR96 GET CRTFILE 01340CSR Z-ADD8 W 01350C*---------------------------------------------------------------- 01360CSR T99A TAG 01370CSR W SUB 1 W 54 01380CSRN54 GOTO ENDJOB 01390CSR LNK,W COMP ' ' 54 01400CSRN54 GOTO T99A 01410CSR MOVEL'Q030WO' LNK,W 01420CSR SETON 49 01430CSR EXSR SR97 UPATE CRTFILE 01440CSR EXSR SR98 >>>>>>>>>>>>>>> 01450CSR ENDSR 01460O**************************************************************** 01470OWOLUNO E 80 01480O WULPB 12 01490O******************************************************************* 01500OWOBATCH E 49 ÐÐ01510O WBQTY 15P 01520O WBQTYO 31P 01530O WBQTYC 47P 01540O 64 'D' 01550O******************************************************************* 01560OCRTFILE E 97 01570O PROG 26 01580O CRTIME 33 01590O CRDATE 37 01600O LNK 79 01610O WULPB 83P 01620O******************************************************************** 01630OTERM50 E 70 U1 01640O 6 'LOADER' 01650O******************************************************************** ** LNK 01660 01670/* 01680_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¼Uf ¼$X019BM P120282120282(èÈÐ00010H Q019BM00020F* PROCESS BILL OF MATERIAL FROM BMBATCH FILE - CALLED BY Q020BM. (X019BM) 00030F* REVISED 3/11/81 4:00 PM. 00040FBITHEX IP F 256 DISK 00050FBMBATCH UC F 98R DISK 00060FBMMAST UC F 86R20AI 1 DISK A 00070FBMWU ID F 21L20AI 1 DISK 00080FPMMST2 UC F 674R12AI 1 DISK 00090FBMTRAN O F 80 DISK A 00100F**************************************************************** 00110E TABISS 1 9 2 TABICN 15 00120E TABSC 1 6 2 TABSCN 12 00130E TABPC 1 7 1 TABPCN 15 00140E LEV 1 20 20 00150E* 00160E BIT 256 1 SCREEN CONTR. CHAR 00170E CALL 5 6 CALL STACK 00180E ERR 7 5 0A BMBATCH ERRORS. 00190E* 00200I******************************************************************* 00210IBITHEX BT 01 00220I 1 256 BIT 00230I******************************************************************** 00240IBMBATCH BH 02 00250I* BATCH BILL MATL TRANSACTIONS. ÐÐ00260I 1 100TAPN 00270I 11 200TCPN 00280I 25 270TITNO 00290I P 28 310TQTY 00300I 34 352TSCRP 00310I 36 37 TISSU 00320I 38 39 TBCHG 00330I 40 41 TECHG 00340I 42 46 TBECN 00350I 47 51 TEECN 00360I 52 52 TDISP 00370I 53 54 TAECHG 00380I 55 560TLL 00390I P 58 600TOPER 00400I P 61 630TDEPT 00410I P 64 650TWC 00420I 66 75 TREF 00430I P 76 96 ERR 00440I 97 97 TTCODE 00450I 98 98 TSTAT 00460I******************************************************************** 00470IBMWU BW 00480I* COMPONENT PART # 10N 00490I 1 100BWCPN 00500I* ASSY PART # 10N ÐÐ00510I 11 200BWAPN 00520I* RECORD STATUS 1A 00530I 21 21 BWSTAT 00540I******************************************************************** 00550IPMMST2 PM 00560I* PART MASTER RECORD 00570I* KEY AREA 00580I* PART NO. 12A 00590I 1 12 PMPN 00600I* NUMB OF COMPONENTS 3P 00610I P 13 140PMNOBM 00620I* PROD LINE 4N 00630I 15 180PMPL 00640I* MODEL NAME 12A 00650I 19 30 PMMODL 00660I* DESCRIPTION 29A 00670I 31 59 PMDESC 00680I* ENG CHANGE STATUS. 00690I* CUR CHG LEVEL 2A 00700I 70 71 PMECHG 00710I* LAST ECN NO. 5A 00720I 65 69 PMECN 00730I* DRAWING INFO 00740I* STANDARD CODE 1A 00750I 84 84 PMSTDC ÐÐ00760I* UNIT MEAS 2A 00770I* EA = EACH OC = OUNCE 00780I* ST = SET TC = TROY OUNCE 00790I* IN = INCH LB = POUND 00800I* FT = FEET PT = PINT 00810I* YD = YARD QT = QUART 00820I* SI = SQ.INCH GL = GALLON 00830I* SF = SQ.FEET DR = DRUM 00840I* SY = SQ.YARD 00850I 85 86 PMUM 00860I* SOURCE CODE 2A 00870I* MA = MFG ASSY 00880I* MP = MFG PART 00890I* PA = PURCH ASSY 00900I* PP = PURCH PART 00910I* RS = RAW STOCK 00920I 94 95 PMSC 00930I* PROVISIONING CODE 1A 00940I* A = FORECAST,NO VALUE ADDED 00950I* B = FORECAST,VALUE ADDED 00960I* C = BUILD TO ORDER (B) 00970I* D = BUILD TO ORDER (NOT B) 00980I* E = CUSTOM 00990I* Y = OBSOLETE,REPAIRABLE 01000I* Z = OBSOLETE,NOT REPAIRABLE ÐÐ01010I 96 96 PMPROV 01020I* ISSUE CODE 2A 01030I* PT = PULL TIME 01040I* OR = ON REQUEST 01050I* BI = BULK ISSUE 01060I* AR = AS REQUIRED 01070I* VS = VENDOR SUPPLIED 01080I* SD = SHIPPING DOCUMENT 01090I* TD = TRAV DOCUMENT 01100I* RD = REF DOCUMENT 01110I* RA = REF ASSY 01120I 97 98 PMISSU 01130I* LOW LEVEL CODE 2N 01140I 430 4310PMLL 01150I* RECORD STATUS 1A 01160I* D = DELETED 01170I 674 674 PMSTAT 01180I******************************************************************** 01190IBMMAST BM 01200I* BILL OF MATERIAL RECORD 01210I* KEY AREA 01220I* ASSY PART NO. 10N 01230I 1 100BMAPN 01240I* COMPONENT PART # 10N 01250I 11 200BMCPN ÐÐ01260I* ITEM NO. 3N 01270I 25 270BMITNO 01280I* QTY PER ASSY 7P 01290I P 28 310BMQTY 01300I* FILLER 32 33 FFFFFF 01310I* SCRAP ALLOW .2N 01320I 34 352BMSCRP 01330I* ISSUE CODE 2A 01340I* PT = PULL TIME 01350I* OR = ON REQUEST 01360I* BI = BULK ISSUE 01370I* AR = AS REQUIRED 01380I* RA = REF ASSY 01390I* TD = TRAV DOC 01400I* SD = SHIP DOC 01410I* RD = REF DOC 01420I* VS = VENDOR SUPPLIED 01430I 36 37 BMISSU 01440I* EFFECTIVITY. 01450I* BEGIN CHANGE LEVEL 2A 01460I 38 39 BMBCHG 01470I* ENDING CHANGE LEVEL 2A 01480I 40 41 BMECHG 01490I* BEGIN ECN # 5A 01500I 42 46 BMBECN ÐÐ01510I* ENDING ECN # 5A 01520I 47 51 BMEECN 01530I* DISPOSITION CODE 1A 01540I* U = USE UP OLD STYLE 01550I* N = NOW (IMMEDIATE) 01560I 52 52 BMDISP 01570I* FILLER 5A 53 57 FFFFFF 01580I* ROUTING. 01590I* OPER NO. 5P 01600I P 58 600BMOPER 01610I* DEPT NO. 5P 01620I P 61 630BMDEPT 01630I* WORK CENTER NO. 3P 01640I P 64 650BMWC 01650I* COMPONENT OPER REFERENCE INFO 10A 01660I 66 75 BMREF 01670I* FILLER 10A 76 85 FFFFFF 01680I* 01690I* RECORD STATUS 1A 01700I* D = DELETED 01710I 86 86 BMSTAT 01720C******************************************************************** 01730C* INITIALIZE - 1 TIME 01740C Z-ADD0 ZERO5 50 STUPIDITY 01750C EXSR SR101 INIT 1-TIME ÐÐ01760C*------------------------------------------------------------------- 01770C START TAG 01780C SETOF 9654 01790C 1 ADD RRN RRN 50 01800C RRN CHAINBMBATCH 54 01810C 54 GOTO ENDJOB END OF FILE. 01820C* BYPASS DELETED TRANS, AND DELETE ASSY TRANS. 01830C TTCODE COMP '#' 54 01840C N54 TSTAT COMP ' ' 54 01850C 54 GOTO START BYPASS 01860C* EDIT TRANSACTION 01870C EXSR SR104 EDIT 01880C 96 EXSR SR83 UPDATE BMBATCH 01890C 96 GOTO START ERROR 01900C* UPDATE BILL OF MATERIAL 01910C EXSR SR106 UPDATE 01920C EXSR SR83 UPDATE BMBATCH 01930C GOTO START 01940C*---------------------------------------------------------------- 01950C END TAG 01960C*------------------------------------------------------------------- 01970C ENDJOB TAG 01980C* LINK TO WHERE-USED UPDATE 01990CLR MOVEL'Q021BM' PROG 8 02000CLR EXITFCHAIN ÐÐ02010CLR RLABL PROG 02020C********************************************************************* 02030CSR SR1 BEGSR 02040C* EDIT TRAN CODE. 02050CSR EXSR SR203 CLASSIFY TRAN. 02060CSRN60N61N62 Z-ADD300 M 50 96 FLAG ERROR. 02070CSR 96 EXSR SR73 SAVE ERR NO. 02080CSR ENDSR 02090C******************************************************************* 02100CSR SR3 BEGSR 02110C* EDIT ASSY PART # 02120CSR TAPN COMP 0 54 02130CSRN54 Z-ADD290 M 96 FLAG ERROR 02140CSR 96 EXSR SR73 02150CSR 96 GOTO END3 02160CSR MOVELTAPN PNA 02170CSR EXSR SR84 GET PART MAST 02180CSRN60N61 MOVELPMDESC DESC14 14 SAVE DESCRIPTION 02190CSRN60N61 GOTO T3A 02200CSR Z-ADD178 M 96 FLAG ERROR 02210CSR EXSR SR73 02220CSR GOTO END3 02230C*------------------------------------------------------------- 02240CSR T3A TAG 02250C* EDIT COMPONENT PART # ÐÐ02260CSR TCPN COMP 0 54 02270CSRN54 Z-ADD181 M 96 FLAG ERROR. 02280CSRN54 EXSR SR73 02290CSR 96 GOTO END3 02300CSR MOVELTCPN PNA 12 02310CSR EXSR SR84 GET PART MAST. 02320CSRN60N61 GOTO T3B GOT IT. 02330CSR Z-ADD291 M 96 FLAG ERROR 02340CSR EXSR SR73 02350CSR GOTO END3 02360C*------------------------------------------------------------------- 02370CSR T3B TAG 02380C* SEE IF COMPONENT ADD WILL GOINTA ITSELF 02390CSR EXSR SR203 CLASSIFY TRAN 02400CSR 60 EXSR SR209 CHECK GUZINTA 02410CSR 96 GOTO END3 02420C* GET BILL MATERIAL RECORD 02430CSR EXSR SR80 GET BMMAST 02440CSRN60N61 EXSR SR206 MOV FILE TO TRAN 02450CSR PMLL COMP TLL 54 02460CSR 54 Z-ADDPMLL NEWLL 20 02470CSRN54 TLL ADD 1 NEWLL 02480CSR END3 ENDSR 02490C********************************************************************** 02500CSR SR4 BEGSR ÐÐ02510C* EDIT QTY. 02520C* --- SEE SR5. 02530CSR ENDSR 02540C*********************************************************************** 02550CSR SR5 BEGSR 02560C* EDIT ISSUE CODE. 02570CSR TISSU COMP ' ' 54 02580CSRN54 MOVE PMISSU TISSU DEFAULT. 02590CSR TISSU COMP ' ' 54 02600CSRN54 MOVE 'PT' TISSU DEFAULT 02610CSR TISSU LOKUPTABISS 54 02620CSRN54 Z-ADD183 M 96 02630CSRN54 EXSR SR73 02640CSR 96 GOTO END5 02650C*------------------------------------------------------------------- 02660CSR T5A TAG 02670C* CHECK MISSING QTY. 02680CSR TISSU COMP 'PT' 54 02690CSRN54 TISSU COMP 'OR' 54 02700CSRN54 TISSU COMP 'BI' 54 02710CSRN54 TISSU COMP 'RA' 54 02720CSR TQTY COMP 0 55 02730CSR 54N55 Z-ADD184 M 96 FLAG ERROR. 02740CSR 54N55 EXSR SR73 02750CSR END5 ENDSR ÐÐ02760C**************************************************************** 02770CSR SR11 BEGSR 02780C* EDIT BEGINNING CHANGE LEVEL 02790CSR EXSR SR203 CLASSIFY TRAN 02800CSRN60 GOTO END11 NOT ADD 02810CSR TBCHG COMP ' ' 54 02820CSRN54 MOVE TAECHG TBCHG DEFAULT 02830CSR END11 ENDSR 02840C***************************************************************** 02850CSR SR13 BEGSR 02860C* EDIT ENDING CHANGE LEVEL 02870CSR EXSR SR203 CLASSIFY TRAN 02880CSRN62 GOTO END13 NOT DELETE 02890CSR TECHG COMP ' ' 54 02900CSRN54 MOVE TAECHG TECHG DEFAULT 02910CSR END13 ENDSR 02920C******************************************************************** 02930CSR SR73 BEGSR 02940C* SAVE ERROR NO. 02950CSR Z-ADD1 X 30 02960CSR ZERO5 LOKUPERR,X 54 02970CSR 54 Z-ADDM ERR,X 02980CSR MOVE 'R' TSTAT 02990CSR ENDSR 03000C********************************************************************** ÐÐ03010CSR SR80 BEGSR 03020C* GET MASTER RECORD 03030CSR SETOF 61 03040CSR MOVELTAPN W20A 20 03050CSR MOVE TCPN W20A 03060CSR W20A CHAINBMMAST 60 GET MASTER 03070CSRN60 BMSTAT COMP 'D' 61 FLAG DELETE 03080CSR ENDSR 03090C********************************************************************** 03100CSR SR81 BEGSR 03110C* ADD NEW MASTER TO FILE 03120CSR EXSR SR88 PUT BMTRAN. 03130CSR SETON 81 03140CSR EXCPT ADD MASTER 03150CSR SETOF 81 03160CSR ENDSR 03170C*********************************************************************** 03180CSR SR82 BEGSR 03190C* REWRITE MASTER 03200CSR EXSR SR88 PUT BMTRAN. 03210CSR SETON 82 03220CSR EXCPT REWRITE MASTER 03230CSR SETOF 82 03240CSR ENDSR 03250C****************************************************************** ÐÐ03260CSR SR83 BEGSR 03270C* UPDATE BMBATCH FILE 03280CSR SETON 83 03290CSR EXCPT UPDATE BMBATCH 03300CSR SETOF 83 03310CSR ENDSR 03320C******************************************************************** 03330CSR SR84 BEGSR 03340C* GET PMMST. 03350CSR SETOF 61 03360CSR PNA CHAINPMMST2 60 03370CSRN60 PMSTAT COMP 'D' 61 03380CSR ENDSR 03390C******************************************************************** 03400CSR SR85 BEGSR 03410C* UPDATE ASSY PART MASTER 03420CSR SETON 85 03430CSR EXCPT UPD ASSY PMMST2 03440CSR SETOF 85 03450CSR ENDSR 03460C******************************************************************* 03470CSR SR88 BEGSR 03480C* PUT BMTRAN RECORD. 03490CSR SETON 90 03500CSR TSTAT COMP 'R' 54 ÐÐ03510CSRN54 MOVE 'W' TSTAT 03520CSR MOVE TISSU W1A 1 03530CSR W1A COMP 'D' 54 03540CSR 54 GOTO END88 03550CSR MOVELTISSU W1A 03560CSR W1A COMP 'R' 54 03570CSR 54 GOTO END88 03580CSR MOVELPMDESC DESC7 7 03590CSR Z-ADDTQTY QTY4 40 03600CSR TIME TIME 60 03610CSR EXSR SR203 03620CSR SETON 88 03630CSR EXCPT 03640CSR SETOF 88 03650CSR END88 ENDSR 03660C*********************************************************************** 03670CSR SR101 BEGSR 03680C* 1-TIME INITIALIZE 03690CSR MOVE ' ' BLK12 12 03700CSR MOVEL' ' BLK12 03710C* DEFINE WORK FIELDS,ETC. 03720CSR MOVE ' ' BLK35 35 03730CSR Z-ADD0 ZERO10 100 03740CSR Z-ADD0 ZERO3 30 03750CSR Z-ADD0 ZERO5 50 ÐÐ03760CSR MOVE ' ' BLK8 8 03770CSR MOVE ' ' BLK20 20 03780CSR MOVE ' ' BLK10 10 03790CSR MOVE ' ' BLK5 5 03800CSR ENDSR 03810C******************************************************************** 03820CSR SR104 BEGSR 03830C* EDIT INPUT DATA 03840CSR EXSR SR1 03850CSR EXSR SR3 03860CSR EXSR SR4 03870CSR EXSR SR5 03880CSR EXSR SR11 03890CSR EXSR SR13 03900CSR ENDSR 03910C******************************************************************** 03920CSR SR106 BEGSR 03930C* UPDATE DATA BASE. 03940CSR EXSR SR203 CLASSIFY TRAN 03950CSR 60 GOTO T106A ADD TRAN 03960CSR 61 GOTO T106D CHANGE TRAN 03970CSR 62 GOTO T106F DELETE TRAN 03980C* FLAG BAD TRAN CODE 03990CSR Z-ADD300 M 96 FLAG ERROR 04000CSR EXSR SR73 ÐÐ04010CSR GOTO END106 04020C*------------------------------------------------------------------- 04030CSR T106A TAG 04040C* ADD TRANSACTION 04050CSR EXSR SR80 GET MASTER 04060CSR 60 GOTO T106B NOT ON FILE 04070CSR 61 GOTO T106C DELETED MASTER 04080C* FLAG DUPLICATE ADD ERROR 04090CSR Z-ADD301 M 96 FLAG ERROR 04100CSR EXSR SR73 04110CSR GOTO END106 04120C*--------------------------------------------------------------------- 04130CSR T106B TAG 04140C* ADD-- MAST NOT ON FILE 04150CSR EXSR SR81 ADD NEW MASTER 04160CSR GOTO T106Z 04170C*--------------------------------------------------------------------- 04180CSR T106C TAG 04190C* ADD-- MAST IS DELETED 04200CSR MOVE 'A' BMSTAT RECORD STATUS 04210CSR EXSR SR82 REWRITE MAST 04220CSR GOTO T106Z 04230C*---------------------------------------------------------------------- 04240CSR T106D TAG 04250C* CHANGE TRANSACTION. ÐÐ04260CSR EXSR SR80 GET MASTER 04270CSRN60N61 GOTO T106E GOT IT 04280C* FLAG NO MASTER ERROR 04290CSR Z-ADD182 M 96 FLAG ERROR 04300CSR EXSR SR73 04310CSR GOTO END106 04320C*----------------------------------------------------------------------- 04330CSR T106E TAG 04340C* REWRITE MASTER 04350CSR EXSR SR82 REWRITE MAST 04360CSR GOTO END106 04370C*----------------------------------------------------------------------- 04380CSR T106F TAG 04390C* DELETE TRANSACTION 04400CSR EXSR SR80 GET MASTER 04410CSRN60N61 GOTO T106G GOT IT 04420C* FLAG NO MASTER ERROR 04430CSR Z-ADD182 M 96 FLAG ERROR 04440CSR EXSR SR73 04450CSR GOTO END106 04460C*----------------------------------------------------------------------- 04470CSR T106G TAG 04480C* DELETE MASTER. 04490CSR MOVE 'D' BMSTAT RECORD STATUS 04500CSR EXSR SR82 REWRITE MASTER ÐÐ04510C*------------------------------------------------------------- 04520CSR T106Z TAG 04530C* UPDATE ASSY PMMAST 04540CSR EXSR SR203 CLASSIFY TRAN 04550CSRN60N62 GOTO END106 NOT ADD 04560CSR MOVELTAPN PNA 04570CSR MOVE ' ' PNA 04580CSR EXSR SR84 GET PMMST2 04590CSR 60 1 ADD PMNOBM PMNOBM NUMB COMPONENTS 04600CSR 62 PMNOBM SUB 1 PMNOBM 04610CSR EXSR SR85 UPD ASSY PMMST2 04620CSR END106 ENDSR 04630C*********************************************************************** 04640CSR SR203 BEGSR 04650C* CLASSIFY TRAN CODE 04660CSR TTCODE COMP 'A' 60 ADD 04670CSR TTCODE COMP 'C' 61 CHANGE 04680CSR TTCODE COMP 'D' 62 DELETE 04690CSR ENDSR 04700C****************************************************************** 04710CSR SR206 BEGSR 04720C* MOVE BMMAST TO TRAN FIELDS 04730CSR TITNO COMP 0 54 04740CSRN54 Z-ADDBMITNO TITNO 04750CSR TQTY COMP 0 54 ÐÐ04760CSRN54 Z-ADDBMQTY TQTY 04770CSR TISSU COMP ' ' 54 04780CSRN54 MOVE BMISSU TISSU 04790CSR TSCRP COMP 0 54 04800CSRN54 Z-ADDBMSCRP TSCRP 04810CSR TOPER COMP 0 54 04820CSRN54 Z-ADDBMOPER TOPER 04830CSR TDEPT COMP 0 54 04840CSRN54 Z-ADDBMDEPT TDEPT 04850CSR TREF COMP BLK10 54 04860CSRN54 MOVE BMREF TREF 04870CSR TBECN COMP BLK5 54 04880CSRN54 MOVE BMBECN TBECN 04890CSR TBCHG COMP ' ' 54 04900CSRN54 MOVE BMBCHG TBCHG 04910CSR TEECN COMP BLK5 54 04920CSRN54 MOVE BMEECN TEECN 04930CSR TECHG COMP ' ' 54 04940CSRN54 MOVE BMECHG TECHG 04950CSR ENDSR 04960C************************************************************** 04970CSR SR209 BEGSR 04980C* CHECK TO SEE IF NEW COMPONENT GUZINTA ITSELF. 04990CSR TAPN COMP TCPN 54 05000CSR 54 Z-ADD204 M 96 FLAG ERROR. ÐÐ05010CSR 54 EXSR SR73 05020CSR 96 GOTO END209 05030CSR PMNOBM COMP 0 54 05040CSRN54 GOTO END209 NOT ASSY 05050CSR MOVE BLK20 LEV 05060CSR MOVELTAPN LEV,2 05070CSR Z-ADD3 L 30 05080C*------------------------------------------------------------------- 05090CSR T209A TAG 05100C* GET SAVED LOWER LEVEL, IF ANY. 05110CSR L SUB 1 L 54 INDENT LEVEL. 05120CSRN54 GOTO END209 BOT INDENT. 05130CSR LEV,L COMP BLK20 54 05140CSRN54 GOTO T209A NONE THIS LEVEL 05150CSR MOVE LEV,L W20A 20 05160CSR MOVELLEV,L CURASY 100 05170CSR MOVE BLK20 LEV,L 05180C*------------------------------------------------------------------ 05190CSR T209B TAG 05200CSR W20A SETLLBMWU 05210C*------------------------------------------------------------------- 05220CSR T209C TAG 05230CSR SETOF 54 05240CSR READ BMWU 54 05250CSR 54 GOTO END209 ÐÐ05260CSR BWCPN COMP CURASY 54 05270CSRN54 GOTO T209A 05280CSR BWSTAT COMP 'D' 54 05290CSR 54 GOTO T209C 05300CSR BWAPN COMP TCPN 54 05310CSR 54 Z-ADD204 M 96 FLAG ERROR. 05320CSR 54 EXSR SR73 05330CSR 96 GOTO END209 05340C* SAVE CUR LEVEL DATA. 05350CSR MOVELBWCPN LEV,L 05360CSR 1 ADD BWAPN W10N 100 05370CSR MOVE W10N LEV,L 05380CSR MOVE BWAPN CURASY 05390CSR MOVELBWAPN W20A 05400CSR MOVE ZERO10 W20A 05410CSR 1 ADD L L 05420CSR GOTO T209B 05430CSR END209 ENDSR 05440O******************************************************************** 05450OBMBATCH E 83 05460O TQTY 31P 05470O TOPER 60P 05480O TDEPT 63P 05490O TWC 65P 05500O ERR 96P ÐÐ05510O TSTAT 98 05520O******************************************************************** 05530OBMMAST EADD 81 05540O* ADD NEW BILL MATERIAL RECORD. 05550O TAPN 10 05560O TCPN 20 05570O TITNO 27 05580O TQTY 31P 05590O TSCRP 35 05600O TISSU 37 05610O TBCHG 39 05620O TECHG 41 05630O TBECN 46 05640O TEECN 51 05650O TOPER 60P 05660O TDEPT 63P 05670O ZERO3 65P 05680O TREF 75 05690O 86 'A' 05700O*------------------------------------------------------------------- 05710O E 82 05720O* REWRITE BILL MATERIAL MAST. 05730O TITNO 27 05740O TQTY 31P 05750O TSCRP 35 ÐÐ05760O TISSU 37 05770O TBCHG 39 05780O TECHG 41 05790O TBECN 46 05800O TEECN 51 05810O TOPER 60P 05820O TDEPT 63P 05830O ZERO3 65P 05840O TREF 75 05850O BMSTAT 86 05860O******************************************************************** 05870OBMTRAN EADD 88 05880O TAPN 10 05890O TAECHG 12 05900O DESC14 26 05910O QTY4 30 05920O TCPN 40 05930O DESC7 47 05940O UDATE 70 05950O TIME 76 05960O 60 79 'ADD' 05970O 62 79 'DEL' 05980O 61 79 'CHG' 05990O 80 '1' 06000O********************************************************************* ÐÐ06010OPMMST2 E 81 06020O OR 82 06030O* REWRITE PART MAST 06040O NEWLL 431 06050O PMNOBM 14P 06060O*---------------------------------------------------------------- 06070O E 85 06080O* UPDATE ASSY PART MASTER 06090O PMNOBM 14P ** TABISS/TABICN - ISSUE CODES 06100PTPULL TIME 06110ORON REQUEST 06120BIBULK ISSUE 06130ARAS REQD 06140VSVENDOR SUPPLIED 06150SDSHIP DOCUMENT 06160TDTRAV DOCUMENT 06170RDREF DOC ONLY 06180RAREF ASSY 06190** TABSC/TABSCN - SOURCE CODES 06200MAMFG ASSY 06210MPMFG PART 06220PAPURCH ASSY 06230PPPURCH PART 06240RDREF DOC ONLY 006250ÐÐRSRAW STOCK 06260** TABPC/TABPCN - PROVISIONING CODES 06270AFCST-NO VAL ADD 06280BFCST-VAL ADDED 06290CBUILD TO ORD-B 06300DBLD TO ORD-NOTB 06310ECUSTOM 06320YOBS-REPAIRABLE 06330ZOBS-NOT REPAIR 06340** LEV ARRAY 06350 06360/* 06370_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( V‹  NX024WO P999999120282(èÈÐ00010H Q024WO00020F* DISPLAY PULL SHEET FILE. (X024WO) 00030F* REVISED 9-24-82 11:55 AM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FWOPULL ID F 64L19AI 1 DISK 00080FWOMAST IC F 228R 9AI 1 DISK 00090FPMMST2 IC F 674R12AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A16 16 16 1 A INPUT DATA ARRAY 00140E NUM 1 1 3 0 00150E DUN 1 2 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E DIV 1 66 2 00180E LNK 1 7 6 A 00190E BIT 33 1 SCREEN CONTR. CHAR 00200E PAR 25 1 00210E TST 25 1 00220E CALL 7 6 00230I******************************************************************* 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************* 00290IMGFILE MG 00300I* MESSAGE FILE. 00310I 1 35 MGTEXT 00320I****************************************************************** 00330ICRTFILE CR 00340I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00350I* 00360I* EMPLOYEE # 5N 00370I 1 50CREMPL 00380I* USER CODE 8A 00390I 6 13 CRUSER 00400I* DEPT # 5N 00410I 14 180CRDEPT 00420I* JOB NAME 8A (JOB LOADED BY MENU) 00430I 19 26 CRJOB 00440I* SHUTDOWN FLAG 1A 00450I* BLANK = NO SHUTDOWN 00460I 27 27 CRSHUT 00470I* TIME STARTED 6N 00480I 28 330CRTIME 00490I* DATE STARTED 4N 00500I 34 370CRDATE ÐÐ00510I* RETURN STACK 7 X 6A 00520I 38 79 CALL 00530I******************************************************************** 00540IWOMAST WO 00550I* WORK ORDER MASTER 00560I 1 9 WOWO 00570I 10 190WOPN 00580I P 37 400WOQTYS 00590I P 45 480WOQTYC 00600I 49 540WOSTRT 00610I 55 600WODUE 00620I 228 228 WOSTAT 00630I******************************************************************** 00640IWOPULL WP 00650I* WORK ORDER PULL FILE. 00660I* KEY AREA. 00670I 1 19 WPKEY 00680I* WORK ORDER 9A 00690I 1 9 WPWO 00700I 1 6 WPWOP 00710I 7 90WPWOD 00720I* COMPONENT PART # 10N 00730I 10 190WPCPN 00740I* WORK ORDER PART # 00750I 20 290NAPN ÐÐ00760I* QTY REQD 7P 00770I P 30 330WPQTYR 00780I* STOCK LOCATION 6A 00790I 34 39 WPSLOC 00800I* QTY ISSUED 7P 00810I P 40 430WPQTYC 00820I* QTY B/O 7P 00830I P 44 470WPQTYB 00840I* QTY PER ASSY 7P 00850I P 48 510WPQPA 00860I* RECORD STATUS 1A 00870I 64 64 WPSTAT 00880I************************************************************** 00890IPMMST2 PM 00900I 19 30 PMMODL 00910I 31 59 PMDESC 00920I 621 626 PMSLOC 00930I P 311 3140PMOHB 00940I 674 674 PMSTAT 00950C******************************************************************* 00960C* INITILIZE 00970C EXSR SR101 1-TIME INIT 00980C MOVE ' ' BLK6 6 00990C EXSR SR70 CLEAR PAGE 01000C MOVE '091001' W6A 6 ÐÐ01010C EXSR SR69 MOVE CURSOR 01020C*------------------------------------------------------------------ 01030C START TAG 01040C* SET-UP 1ST FIELD NO. 01050C SETOF 70 01060C MOVE ' ' DUN INIT EDIT ARRAY 01070C Z-ADD1 F 30 FIELD # 01080C Z-ADD91 COUNT 01090C GOTO READ 01100C*------------------------------------------------------------------ 01110C NEXT TAG 01120C* SET-UP NEXT FIELD NO. 01130C 1 ADD F F FIELD # 01140C*----------------------------------------------------------------- 01150C READ TAG 01160C* READ DATA FROM TERMINAL. 01170C SETOF 909677 01180C EXSR SR102 VALIDATE FIELD # 01190C 55 GOTO UPDATE DONE 01200C EXSR SR201 IDENTIFY-F 01210C 01 Z-ADD516 M 50 ENTER WO# 01220C 02 Z-ADD298 M ENTER PART # 01230C 1 ADD COUNT COUNT 01240C SETON 69 01250C EXSR SR73 PROMPT ÐÐ01260C SETOF 69 01270C EXSR SR75 READ TERMINAL 01280C 96 GOTO ERROR ERROR 01290C N77 GOTO EDIT NO DATA INPUT 01300C*------------------------------------------------------------------ 01310C PROCES TAG 01320C* PROCESS INPUT DATA 01330C EXSR SR103 MOVE DATA 01340C*------------------------------------------------------------------- 01350C EDIT TAG 01360C N96 EXSR SR104 EDIT INPUT FIELD 01370C 96 GOTO ERROR ERROR 01380C GOTO NEXT 01390C*------------------------------------------------------------------ 01400C UPDATE TAG 01410C* UPDATE DATA BASE. 01420C EXSR SR105 FINAL EDIT 01430C 96 GOTO ERROR ERROR 01440C EXSR SR106 DISPLAY 01450C GOTO START 01460C*-------------------------------------------------------------------- 01470C ERROR TAG 01480C EXSR SR102 VALIDATE FIELD # 01490C EXSR SR89 GET MSG 01500C GOTO READ ÐÐ01510C*------------------------------------------------------------------ 01520C NEWITM TAG 01530C* SET-UP LINK FOR NEW ITEM 01540C MOVEL'Q024WO' PROG 8 01550C GOTO END EXIT PROG 01560C*------------------------------------------------------------------- 01570C MENU TAG 01580C EXSR SR96 GET CRTFILE 01590C Z-ADD1 W 01600C BLK6 LOKUPLNK,W 54 01610C 54 MOVELLNK,W PROG 8 01620C 54 MOVE BLK6 LNK,W 01630C N54 MOVEL'CONTU' PROG 01640C EXSR SR97 UPD CRTFILE 01650C EXSR SR98 >>>>>>>>>> 01660C*------------------------------------------------------------------- 01670C GOODBY TAG 01680C* LINK TO SIGN-OFF 01690C MOVEL'GOODBY' PROG 01700C GOTO END EXIT PROG 01710C*------------------------------------------------------------------- 01720C END TAG 01730C EXSR SR96 GET CRTFILE 01740C EXSR SR97 UPD CRTFILE 01750C EXSR SR98 >>>>>>>>>> ÐÐ01760C*------------------------------------------------------------------- 01770C ENDJOB TAG 01780C MOVEL'ENDJOB' PROG 01790C EXSR SR98 >>>>>>>>>> 01800C************************************************************* 01810CSR SR45 BEGSR 01820C* PUT PULL ITEM DATA 01830CSRN40 EXSR SR83 01840CSRN40N60 MOVELWOPN W12A 12 01850CSRN40N60 EXSR SR84 GET PART MAST 01860CSRN40N60 MOVE PMDESC DESCWO 29 01870CSRN40N60 MOVE PMMODL MODLWO 12 01880CSRN40N60 EXSR SR71 PUT HEADING 01890CSR WPQTYC ADD WPQTYB QTYDUN 70 01900CSR WPQTYR SUB QTYDUN QTYBO 70 54 01910CSRN54 Z-ADD0 QTYBO 01920CSR MOVELWPCPN W12A 01930CSR EXSR SR84 GET PART MASTER 01940CSR 60 GOTO END45 NO PART MASTER 01950CSR SETON 45 01960CSR EXCPT PUT ITEM DATA 01970CSR SETOF 45 01980CSR 3 ADD COUNT COUNT 01990CSR EXSR SR67 CHECK END PAGE 02000CSR END45 ENDSR ÐÐ02010C***************************************************************** 02020CSR SR67 BEGSR 02030C* CHECK END OF PAGE 02040CSR SETOF 7790 02050CSR 50 COUNT COMP 121 54 54 02060CSRN50 COUNT COMP 117 54 54 02070CSRN54 GOTO END67 02080CSR SETON 74 02090CSR EXCPT END PAGE MSG 02100CSR SETOF 74 02110CSR EXSR SR75 READ CRT 02120CSR 90 GOTO END67 02130CSR EXSR SR71 PUT HEADING 02140CSR END67 ENDSR 02150C**************************************************************** 02160CSR SR68 BEGSR 02170CSR SETON 76 02180CSR EXCPT PUT DIVIDER 02190CSR SETOF 76 02200CSR ENDSR 02210C*************************************************************** 02220CSR SR69 BEGSR 02230CSR 50 EXITFZPUTXY MOVE CURSOR 02240CSR RLABL RPGLIN 02250CSR RLABL RPGCOL ÐÐ02260CSRN50 EXITFZMOVXY MOVE CURSOR 02270CSR RLABL RPGLIN 02280CSR RLABL RPGCOL 02290CSR ENDSR 02300C***************************************************************** 02310CSR SR70 BEGSR 02320C* CLEAR TERM SCREEN. 02330CSR 50 EXITFZISTAT 02340CSR 50 EXITFZESCH 02350CSRN50 EXITFZCPAGE CLEAR PAGE 4 02360CSR Z-ADD91 COUNT 02370CSR ENDSR 02380C********************************************************************** 02390CSR SR71 BEGSR 02400C* PUT HEADINGS TO TERMINAL 02410CSR EXSR SR70 CLEAR PAGE 02420CSR SETON 71 02430CSR EXCPT PUT HEADINGS 02440CSR SETOF 71 02450CSR Z-ADD96 COUNT 30 02460CSR ENDSR 02470C****************************************************************** 02480CSR SR73 BEGSR 02490C* PUT PROMPT 02500CSR EXSR SR89 GET MSG ÐÐ02510CSR SETON 73 02520CSR EXCPT PUT MSG 02530CSR SETOF 73 02540CSR ENDSR 02550C*************************************************************** 02560CSR SR75 BEGSR 02570C* READ FROM TERMINAL 02580CSR SETOF 779096 02590CSR SETOF 93 02600CSR MOVE BLK16 W16A 16 BUFFER 02610CSR EXITFZR16 READ FROM TERMINAL 02620CSR RLABL W16A READ BUFFER 02630CSR MOVEAW16A A16 INPUT DATA ARRAY 02640CSR MOVE BLK16 W16A INIT INPUT ARRAY 02650CSR Z-ADD1 W 30 02660CSR '\' LOKUPA16,W 90 FLAG ESC 02670CSRN90 GOTO T75B NOT ESC 02680CSR 1 ADD W W 02690CSR W COMP 16 54 02700CSR 54 GOTO T75A BAD ESC 02710CSR A16,W COMP 'G' 98 GOODBY 02720CSR A16,W COMP 'E' 94 MENU 02730CSR A16,W COMP 'N' 93 NEW ITEM 02740CSRN93 A16,W COMP 'D' 93 DONE 02750CSR 98 GOTO GOODBY ÐÐ02760CSR 94 GOTO MENU 02770CSR 93 GOTO NEWITM 02780C*------------------------------------------------------------------ 02790CSR T75A TAG 02800C* FLAG BAD ESC INPUT 02810CSR GOTO END75 02820C*-------------------------------------------------------------------- 02830CSR T75B TAG 02840C* MOVE DATA 02850CSR Z-ADD1 W 02860CSR ' ' LOKUPA16,W 77 02870CSR 77 MOVEAA16,W W16A INPUT DATA 02880C*-------------------------------------------------------------------- 02890CSR END75 TAG 02900C* INIT PREV ERROR MSG. 02910CSR MOVE BLK35 MGTEXT 02920CSR ENDSR 02930C******************************************************************** 02940CSR SR83 BEGSR 02950C* GET WOMAST FILE. 02960CSR WPWO CHAINWOMAST 60 GET WOMAST 02970CSRN60 WOSTAT COMP 'D' 60 02980CSR WOQTYS SUB WOQTYC WOBAL 70 02990CSR ENDSR 03000C******************************************************************** ÐÐ03010CSR SR84 BEGSR 03020C* GET PART MAST. 03030CSR MOVE ' ' W12A 03040CSR W12A CHAINPMMST2 60 GET PMMST2 03050CSRN60 PMSTAT COMP 'D' 60 03060CSR ENDSR 03070C********************************************************************** 03080CSR SR89 BEGSR 03090C* GET MESSAGE MASTER 03100CSR M CHAINMGFILE 54 03110CSR 54 MOVE BLK35 MGTEXT 03120CSR 54 MOVELM MGTEXT 03130CSR 54 MOVE MES,1 MGTEXT 03140CSR ENDSR 03150C******************************************************************** 03160CSR SR96 BEGSR 03170CSR # CHAINCRTFILE H9 GET CRTFILE 03180CSR H9 GOTO ENDJOB 03190CSR ENDSR 03200C******************************************************************** 03210CSR SR97 BEGSR 03220C* UPDATE CRTFILE. EXIT PROGRAM. 03230CSR TIME CRTIME 03240CSR MOVELUDATE CRDATE 03250CSR SETON 97 ÐÐ03260CSR EXCPT UPDATE CRTFILE 03270CSR SETOF 97 03280CSR ENDSR 03290C******************************************************************** 03300CSR SR98 BEGSR 03310CSR EXSR SR70 CLEAR CRT 03320CSR EXITFCHAIN 03330CSR RLABL PROG 03340CSR ENDSR 03350C*********************************************************************** 03360CSR SR101 BEGSR 03370C* 1-TIME INITIALIZE 03380CSR MOVE BIT,1 NUL 03390CSR MOVEL'-' DIV 03400CSR MOVE '*' DIV,34 03410CSR MOVEL'*' DIV,41 03420CSR MOVE '*' DIV,47 03430CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS 03440CSR MOVE ' ' BLK16 16 03450C* GET PORT # AND CRTFILE 03460CSR MOVE ' ' W2A 2 03470CSR EXITFZGMINX GET PORT # 03480CSR RLABL W2A 03490CSR MOVE W2A # 20 PORT NO. 03500CSR # COMP 0 54 ÐÐ03510CSRN54 Z-ADD25 # DEFAULT 03520CSR EXSR SR96 GET CRTFILE 03530CSR MOVE CALL LNK 03540CSR PAR,# COMP '1' 50 03550CSR TST,# COMP 'S' 54 03560CSR 54 MOVE 'SHUTDOWN'PROG 8 03570CSR EXSR SR97 UPD CRTFILE 03580CSR 54 EXSR SR98 EXIT PROG 03590C* DEFINE WORK FIELDS,ETC. 03600CSR MOVE ' ' BLK35 35 03610CSR Z-ADD0 ZERO7 70 03620CSR MOVE ' ' BLK12 12 03630CSR MOVE ' ' RPGLIN 4 03640CSR MOVE ' ' RPGCOL 4 03650CSR ENDSR 03660C********************************************************************** 03670CSR SR102 BEGSR 03680C* VALIDATE FIELD NO. 03690CSR F COMP 0 54 03700CSRN54 Z-ADD1 F 03710CSR F COMP FLIMIT 55 03720CSR 55 Z-ADD1 F 03730CSR ENDSR 03740C******************************************************************** 03750CSR SR103 BEGSR ÐÐ03760C* MOVE INPUT DATA 03770CSR EXSR SR201 IDENTIFY-F 03780CSR EXSR SR202 R. JUSTIFY 03790CSR 01 EXSR SR210 BUILD WORK ORDER 03800CSR 02 MOVE W10A TPN 100 PART NUMBER 03810CSR MOVE ' ' DUN,F EDIT FLAG 03820CSR ENDSR 03830C******************************************************************** 03840CSR SR104 BEGSR 03850C* EDIT INPUT DATA 03860CSR 96 MOVE ' ' DUN,F EDIT FLAG 03870CSRN96 MOVE 'X' DUN,F 03880CSR ENDSR 03890C*********************************************************************** 03900CSR SR105 BEGSR 03910C* FINAL EDIT 03920CSR SETOF 77 03930CSR SETON 79 FINAL EDIT FLAG 03940CSR Z-ADD1 F 96 03950C*-------------------------------------------------------------------- 03960CSR T105A TAG 03970CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03980CSRN54 GOTO END105 03990CSR EXSR SR201 IDENTIFY-F 04000CSR EXSR SR104 EDIT ÐÐ04010CSRN96 GOTO T105A 04020C*-------------------------------------------------------------------- 04030CSR END105 TAG 04040CSR SETOF 79 04050CSR ENDSR 04060C******************************************************************** 04070CSR SR106 BEGSR 04080C* DISPLAY PULL FILE RECORDS 04090CSR MOVE BLK35 LASTWP 19 04100CSR MOVELTWO W19A 19 04110CSR MOVE TPN W19A 04120CSR W19A SETLLWOPULL 04130CSR SETOF 40 04140C*--------------------------------------------------------------------- 04150CSR T106F TAG 04160CSR SETOF 54 04170CSR READ WOPULL 54 GET WOPULL 04180CSR 54 GOTO T106J END OF FILE 04190CSR WPKEY COMP LASTWP 54 04200CSRN54 GOTO T106J WRAP-AROUND STUPIDITY04210CSR WPWO COMP TWO 54 04220CSRN54 GOTO T106J END OF PULL 04230CSR WPSTAT COMP 'D' 54 04240CSR 54 GOTO T106F DELETED RECORD 04250CSR EXSR SR45 PUT DATA ÐÐ04260CSR 90 GOTO END106 ESC CHAR 04270CSR SETON 40 04280CSR GOTO T106F GET NEXT ITEM 04290C*--------------------------------------------------------------------- 04300CSR T106J TAG 04310CSR SETON 75 END OF PULL MSG 04320CSR EXCPT 04330CSR SETOF 75 04340CSR END106 ENDSR 04350C************************************************************************ 04360CSR SR201 BEGSR 04370C* IDENTIFY FIELD NO. 04380CSR F COMP 1 01 04390CSR F COMP 2 02 04400CSR ENDSR 04410C********************************************************************** 04420CSR SR202 BEGSR 04430C* RIGHT JUSTIFY 04440CSR F LOKUPNUM 54 04450CSRN54 GOTO END202 NOT NUMERIC FIELD 04460CSR Z-ADD10 W2N 20 04470CSR MOVELW16A W10A 10 04480CSR EXIT SUBRAJ R. JUSTIFY 04490CSR RLABL W2N 04500CSR RLABL W10A ÐÐ04510CSR END202 ENDSR 04520C******************************************************************** 04530CSR SR210 BEGSR 04540C* BUILD WORK ORDER NO. 04550CSR MOVE ' ' A16 04560CSR MOVEAW16A A16 04570CSR Z-ADD1 W 04580CSR '-' LOKUPA16,W 54 04590CSRN54 Z-ADD7 W 04600CSR MOVE ' ' W4A 4 04610CSR MOVEAA16,W W4A 04620CSR 54 MOVEL' ' W4A 04630CSR MOVEABLK16 A16,W 04640CSR Z-ADD4 W2N 04650CSR EXIT SUBRAJ RJ 04660CSR RLABL W2N 04670CSR RLABL W4A 04680CSR MOVE W4A TWOD 30 WORK ORDER DASH 04690CSR Z-ADD1 W 04700CSR ' ' LOKUPA16,W 54 04710CSRN54 Z-ADD1 W 04720CSR A16,W COMP '0' 54 54 04730CSRN54 MOVEAA16,W TWOP 6 04740CSRN54 MOVE TWOP W5A 5 04750CSR 54 MOVEAA16,W W5A ÐÐ04760CSR 54 MOVEL' ' TWOP 04770CSR Z-ADD5 W2N 04780CSR EXIT SUBRAJ RJ 04790CSR RLABL W2N 04800CSR RLABL W5A 04810CSR MOVE W5A TWOP WORK ORDER PRIME 04820CSR MOVELTWOP TWO 9 04830CSR MOVE TWOD TWO WORK ORDER NO. 04840CSR MOVELTWOP PREFIX 1 WORK ORDER PREFIX 04850CSR ENDSR 04860O******************************************************************** 04870OTERM132 E 71 04880O BIT,28 1 04890O N50 8 '8091001' 04900O N50 BIT,1 9 04910O N50 BIT,1 10 04920O 50 10 '[001 ]001' 04930O 50 BIT,28 6 04940O UDATE 18 ' - - ' 04950O 87 'P U L L S H E E T' 04960O*--------------------------------------------------------------- 04970O E 71 04980O 11 'WORK ORDER:' 04990O WPWOP 19 05000O 55 20 '-' ÐÐ05010O 55 WPWOD 23 05020O 35 'ASSY-NO.' 05030O WOPN 49 ' - - ' 05040O DESCWO 80 05050O 90 'MODEL:' 05060O MODLWO 114 05070O*------------------------------------------------------------------- 05080O E 71 05090O 11 'START DATE:' 05100O WOSTRT 20 ' - - ' 05110O 34 'DUE-DATE:' 05120O WODUE 44 ' - - ' 05130O*------------------------------------------------------------------- 05140O E 71 05150O 11 'QTY-SCHED :' 05160O WOQTYS2 20 05170O 65 'QTY-COMPLETED:' 05180O WOQTYC2 74 05190O 93 'BAL-OPEN:' 05200O WOBAL K 103 05210O*------------------------------------------------------------------- 05220O E 71 05230O 1 ' ' 05240O*------------------------------------------------------------------- 05250O E 71 ÐÐ05260O 50 'STOCK' 05270O 56 'QTY' 05280O 65 'QTY' 05290O 68 '*' 05300O 79 'QUANTITY' 05310O 81 '*' 05320O 90 'QUANTITY' 05330O 94 '*' 05340O 104 'ON' 05350O*------------------------------------------------------------------- 05360O E 71 05370O 8 'PART-NO.' 05380O 25 'DESCRIPTION' 05390O 49 'LOC' 05400O 56 'PER' 05410O 66 'REQ''D' 05420O 68 '*' 05430O 78 'ISSUED' 05440O 81 '*' 05450O 92 'BACKORDERED' 05460O 94 '*' 05470O 105 'HAND' 05480O*------------------------------------------------------------------- 05490O E 45 05500O DIV 132 ÐÐ05510O*------------------------------------------------------------------- 05520O E 45 05530O* COMPONENT LINE. 05540O WPCPN 12 ' - - ' 05550O PMDESC 43 05560O WPSLOC 51 05570O WPQPA Z 56 05580O WPQTYR2 66 05590O 68 '*' 05600O WPQTYCK 79 05610O 81 '*' 05620O WPQTYBK 92 05630O 94 '*' 05640O PMOHB K 105 05650O*------------------------------------------------------------- 05660O E 74 05670O OR 75 05680O 68 '*' 05690O 81 '*' 05700O 94 '*' 05710O E 75 05720O NUL 132 05730O 24 'END OF PULL... ENTER \N' 05740O 48 ', \E, \G, OR RETURN ' 05750O E 74 ÐÐ05760O NUL 132 05770O 24 'END OF PAGE... ENTER \N' 05780O 48 ', \E, \G, OR RETURN ' 05790O E 73 05800O NUL 132 05810O 96 BIT,28 1 05820O 96 2 'D' 05830O MGTEXT 50 05840O 96 BIT,28 100 05850O 96 101 'E' 05860O*--------------------------------------------------------------- 05870O E 76 05880O DIV 132 05890O******************************************************************** 05900OCRTFILE E 97 05910O PROG 26 05920O CRTIME 33 05930O CRDATE 37 05940O LNK 79 05950O******************************************************************** ** NUL ARRAY 005960 005970** A16 ARRAY 005980 005990** NUM ARRAY 006000ÐÐ002 PART NO. 006010** DUN ARRAY 006020 006030** MES ARRAY 006040---MESSAGE NOT ON FILE--- 006050** DIV ARRAY 006060 06070** LNK ARRAY 06080 06090/* 06100_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(WÚ  X019GL P120282120282(èÈÐ00010H Q019GL00020F* CREATE G/L GUIDE FILE FOR TOP LEVEL ACCOUNTS ONLY. (X019GL) 00030F* REVISED 7/28/81 3:20 PM. 00040FGLMAST IP F 165 9AI 1 DISK 00050FGLGUIDE O F 9 DISK 00060I******************************************************************** 00070IGLMAST GL 01 165NCD 00080I 1 9 GLACNT 00090I P 157 1590GLNOSA 00100I GG 02 00110O******************************************************************** 00120OGLGUIDE D 01 00130O GLACNT 9 /* 000140_‚ _‚_‚ ÐÈ(ÂWä ¼XQMC01 P 999999120282(èÈÐ00010H QQMC0100020F* STOCKROOM UPDATE MENU. (XQMC01) 00030F* REVISED 8-11-82 4:00 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070E******************************************************************** 00080E PA 1 23 8 NA 50 PROGRAM #/NAMES 00090E PB 1 23 8 NB 50 PROGRAM #/NAMES 00100E NUL 1 132 1 NULL CHAR 00110E A4 4 4 1 A 00120E TITL 1 6 66 MENU TITLE,HEADINGS 00130E MSG 1 3 25 00140E SEL 1 46 8 00150E PRG 1 23 8 NAM 50 AWORK ARRAY 00160E LNK 1 7 6 A 00170E BIT 33 1 00180E PAR 25 1 00190E TST 25 1 00200E CALL 7 6 A 00210E REC 177 1 00220I******************************************************************** 00230IBITPAR BT 02 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I******************************************************************** 00280ICRTFILE CR 00290I 19 26 CRJOB 00300I 27 27 CRSHUT 00310I 28 330CRTIME 00320I 34 370CRDATE 00330I 38 79 CALL 00340I 80 256 REC 00350C******************************************************************** 00360C EXSR SR101 INIT 00370C EXSR SR102 DISPLAY MENU 00380C EXSR SR103 REQUEST SELECTION 00390C*------------------------------------------------------------------ 00400C NEWITM TAG 00410C MOVEL'QQMC01' PROG 8 00420C EXSR SR98 <<>> 00430C*------------------------------------------------------------------ 00440C MENU TAG 00450C EXSR SR97 <<>> 00460C*--------------------------------------------------------------------- 00470C GOODBY TAG 00480C MOVEL'GOODBY' PROG 8 00490C EXSR SR98 <<>> 00500C*----------------------------------------------------------------- ÐÐ00510C ENDJOB TAG <<>> 00520C MOVEL'ENDJOB 'PROG 00530C EXITFCHAIN 00540C RLABL PROG 00550C************************************************************************ 00560CSR SR68 BEGSR 00570CSR EXITFZLFCR LF/CR 00580CSR ENDSR 00590C***************************************************************** 00600CSR SR69 BEGSR 00610C* MOVE CURSOR 00620CSR 50 EXITFZPUTXY 00630CSR RLABL RPGLIN 00640CSR RLABL RPGCOL 00650CSRN50 EXITFZMOVXY 00660CSR RLABL RPGLIN 00670CSR RLABL RPGCOL 00680CSR ENDSR 00690C**************************************************************** 00700CSR SR70 BEGSR 00710CSR MOVELW66A OUTPUT 80 00720CSR EXITFZW80 WRITE 80-BYTES CRT 00730CSR RLABL OUTPUT 00740CSR ENDSR 00750C****************************************************************** ÐÐ00760CSR SR71 BEGSR 00770CSR MOVELREQST RPGLIN 00780CSR MOVEL'067' RPGCOL 00790CSR EXSR SR69 MOVE CURSOR 00800CSR 50 EXITFZBLINK START BLINK 00810CSR EXSR SR70 WRITE MESSAGE 00820CSR EXITFZBLUNK STOP BLINK 00830CSR ENDSR 00840C******************************************************************* 00850CSR SR72 BEGSR 00860CSR MOVE BLK66 W66A 00870CSR EXSR SR71 INIT MESSAGE 00880CSR ENDSR 00890C****************************************************************** 00900CSR SR75 BEGSR 00910C* READ CRT 00920CSR SETOF 7790 00930CSR MOVE BLK4 W4A 4 00940CSR EXITFZR4 READ CRT 00950CSR RLABL W4A 00960CSR MOVEAW4A A4 00970CSR MOVE BLK4 W4A 4 00980CSR Z-ADD1 W 30 00990CSR '\' LOKUPA4,W 90 01000CSRN90 GOTO T75C ÐÐ01010CSR 1 ADD W W 01020CSR W COMP 4 54 01030CSRN54 GOTO T75B 01040C*--------------------------------------------------------------- 01050CSR T75A TAG 01060C* FLAG BAD ESCAPE CODE 01070CSR MOVE BLK66 W66A 01080CSR MOVELMSG,3 W66A 01090CSR EXSR SR71 PUT ERROR MESSAGE 01100CSR GOTO SR75 01110C*-------------------------------------------------------------- 01120CSR T75B TAG 01130CSR A4,W COMP 'G' 98 01140CSR A4,W COMP 'E' 94 01150CSR A4,W COMP 'N' 93 01160CSR 98 GOTO GOODBY 01170CSR 94 GOTO MENU 01180CSR 93 GOTO NEWITM 01190CSR GOTO T75A BAD ESCAPE CODE 01200C*-------------------------------------------------------------------- 01210CSR T75C TAG 01220CSR Z-ADD1 W 01230CSR ' ' LOKUPA4,W 77 01240CSR 77 MOVEAA4,W W4A 01250CSR END75 TAG ÐÐ01260CSR EXSR SR72 INIT MESSAGE 01270CSR ENDSR 01280C******************************************************************** 01290CSR SR96 BEGSR 01300CSR # CHAINCRTFILE H9 GET CRTFILE 01310CSR H9 GOTO ENDJOB 01320CSR ENDSR 01330C***************************************************************** 01340CSR SR97 BEGSR 01350C* MENU REQUEST EXIT. 01360CSR Z-ADD1 W 30 01370CSR ' ' LOKUPLNK,W 54 01380CSRN54 MOVEL'CONTU' PROG 01390CSR 54 MOVELLNK,W PROG 8 01400CSR 54 MOVE ' ' LNK,W 01410CSR EXSR SR98 <<>> 01420CSR ENDSR 01430C***************************************************************** 01440CSR SR98 BEGSR 01450C* NORMAL EOJ - UPDATE CRTFILE AND LINK TO PROG PROGRAM. 01460CSR 50 EXITFZISTAT 01470CSR 50 EXITFZESCH 01480CSRN50 EXITFZCPAGE 01490CSR # CHAINCRTFILE H8 01500CSR H8 GOTO ENDJOB <<>> ÐÐ01510CSR MOVE LNK CALL 01520CSR MOVE ' ' REC 01530CSR MOVE PROG CRJOB 01540CSR MOVELUDATE CRDATE 01550CSR TIME CRTIME 01560CSR SETON 97 01570CSR EXCPT UPDATE CRTFILE 01580CSR SETOF 97 01590CSR EXITFCHAIN <<>> 01600CSR RLABL PROG 01610CSR ENDSR 01620C******************************************************************* 01630CSR SR99 BEGSR 01640C* PROGRAM SELECTED - LOAD THIS MENU AS RETURN-TO PROG 01650CSR Z-ADD8 W 01660C*----------------------------------------------------------------- 01670CSR T99A TAG 01680CSR W SUB 1 W 54 01690CSRN54 SETON H7 01700CSRN54 GOTO ENDJOB <<>> 01710CSR LNK,W COMP ' ' 54 01720CSRN54 GOTO T99A 01730CSR MOVEL'QQMC01' LNK,W 01740CSR EXSR SR98 <<>> 01750CSR ENDSR ÐÐ01760C******************************************************************* 01770C* 01780C* 01790C* 01800C* 01810C* 01820C* 01830C* 01840C********************************************************************** 01850CSR SR101 BEGSR 01860C* 1-TIME INIT 01870CSR MOVE BIT,1 NUL 01880CSR MOVEANUL OUTPUT 01890CSR MOVE ' ' W2A 2 01900CSR EXITFZGMINX GET TERMINAL # 01910CSR RLABL W2A 01920CSR MOVE W2A # 20 01930CSR # COMP 0 54 01940CSRN54 Z-ADD25 # 01950CSR # CHAINCRTFILE H9 01960CSR H9 GOTO ENDJOB <<>> 01970CSR MOVE CALL LNK 01980CSR PAR,# COMP '1' 50 01990CSR 50 EXITFZISTAT CLEAR STATUS LINE 02000CSR 50 EXITFZESCH CLEAR SCREEN ÐÐ02010CSRN50 EXITFZCPAGE CLEAR SCREEN 02020CSRN50 MOVEL'091' RPGLIN 4 02030CSRN50 MOVEL'001' RPGCOL 4 02040CSRN50 EXSR SR69 MOVE CURSOR 02050CSR TST,# COMP 'S' 54 02060CSRN54 CRSHUT COMP 'S' 54 02070CSR 54 MOVE 'SHUTDOWN'PROG 02080CSR 54 EXSR SR98 <<>> 02090CSR MOVE ' ' BLK50 50 02100CSR MOVE ' ' BLK66 66 02110CSR MOVE ' ' BLK132132 02120CSR MOVE ' ' BLK35 35 02130CSR MOVE ' ' BLK8 8 02140CSR MOVE ' ' BLK4 4 02150C* 02160C* 02170CSR MOVE ' ' REC 02180CSR MOVE 'QQMC01 'CRJOB 02190CSR TIME CRTIME 02200CSR MOVELUDATE CRDATE 02210CSR SETON 97 02220CSR EXCPT REWRITE CRTFILE 02230CSR SETOF 97 02240CSR ENDSR 02250C********************************************************************** ÐÐ02260CSR SR102 BEGSR 02270C* DISPLAY MENU 02280CSR Z-ADD-1 M 20 02290CSR Z-ADD1 REQST 30 02300CSR 50 Z-ADD0 W3N 30 02310CSRN50 Z-ADD90 W3N 02320C*--------------------------------------------------------------------- 02330CSR T102A TAG 02340CSR MOVE BLK132 W132A 132 02350CSR 2 ADD M M 20 02360CSR M COMP 5 54 02370CSR 54 GOTO T102C 02380CSR 1 ADD M A 20 02390CSR TITL,M COMP BLK66 54 02400CSR 54 MOVELTITL,M W132A 02410CSR TITL,A COMP BLK66 55 02420CSR 55 MOVE TITL,A W132A 02430CSRN54N55 GOTO T102A 02440CSR 1 ADD W3N W3N 02450CSR MOVELW3N RPGLIN 4 02460CSR MOVEL'001' RPGCOL 4 02470CSR EXSR SR69 MOVE CURSOR 02480CSR EXITFZW132 WRITE TITLE LINE 02490CSR RLABL W132A 02500CSR Z-ADDW3N REQST 30 ÐÐ02510CSR GOTO T102A 02520C*---------------------------------------------------------------- 02530CSR T102C TAG 02540CSR Z-ADD0 M 02550CSR Z-ADD0 S 20 02560CSR MOVE BLK8 SEL 02570CSR 1 ADD REQST REQST 02580CSR Z-ADDREQST W3N 30 02590CSR MOVE PA PRG 02600CSR MOVE NA NAM 02610CSR MOVEL'001' RPGCOL 02620CSR EXSR SR201 OUTPUT MENU 02630CSR MOVE PB PRG 02640CSR MOVE NB NAM 02650CSR MOVEL'067' RPGCOL 02660CSR Z-ADDREQST W3N 02670CSR EXSR SR201 OUTPUT MENU 02680CSR ENDSR 02690C******************************************************************** 02700CSR SR103 BEGSR 02710C* REQUEST SELECTION. 02720C*------------------------------------------------------------------- 02730CSR MOVEANUL W66A 66 02740CSR MOVELMSG,1 W66A 02750CSR MOVELREQST RPGLIN 4 ÐÐ02760CSR MOVEL'001' RPGCOL 4 02770CSR EXSR SR69 MOVE CURSOR 02780CSR EXSR SR70 WRITE PROMPT 02790CSR EXSR SR75 READ CRT 02800CSR Z-ADD4 W2N 20 02810CSR EXIT SUBRAJ RJ 02820CSR RLABL W2N 02830CSR RLABL W4A 02840CSR MOVE W4A S 20 02850CSR S COMP 0 54 02860CSR 54 S COMP 46 5454 02870CSR 54 SEL,S COMP BLK8 54 02880CSR 54 MOVELSEL,S PROG 8 02890CSR 54 EXSR SR99 <<>> 02900CSR MOVELBLK66 W66A 02910CSR MOVE MSG,2 W66A 02920CSR EXSR SR71 PUT MESSAGE 02930CSR GOTO SR103 REQUEST AGAIN 02940CSR ENDSR 02950C********************************************************************* 02960CSR SR201 BEGSR 02970C* DISPLAY PROGRAM SELECTIONS 02980CSR Z-ADD1 M 20 02990C*------------------------------------------------------------------ 03000CSR T201C TAG ÐÐ03010CSR BLK50 LOKUPNAM,M 54 03020CSRN54 GOTO END201 03030CSR 1 ADD W3N W3N 03040CSR MOVELW3N RPGLIN 03050C* 03060CSR PRG,M COMP BLK8 55 03070CSR 55 1 ADD S S 03080CSR 55 MOVE PRG,M SEL,S SAVE PROG NAME 03090CSR MOVEANUL W66A 03100CSR MOVE BLK66 W54A 54 03110CSR 55 MOVELS W54A 03120CSR 55 S COMP 9 54 03130CSR 55N54 MOVEL' ' W54A 03140CSR MOVE NAM,M W54A 03150CSR MOVELW54A W66A 03160CSR MOVE '. ' W66A 03170CSR EXSR SR69 MOVE CURSOR 03180CSR EXSR SR70 DISPLAY ENTRY 03190CSR MOVE BLK50 NAM,M 03200CSR GOTO T201C 03210CSR END201 ENDSR 03220C* 03230C* 03240C* 03250C* ÐÐ03260O*************************************************************** 03270OCRTFILE E 97 03280O CRJOB 26 03290O CRTIME 33 03300O CRDATE 37 03310O CALL 79 03320O REC 256 03330O******************************************************************** ** PA/NA ARRAY 03340Q005PI RECEIVED P.O.: TO STOCK 1 03350 RETURN TO VENDOR 2 03360 SCRAP 3 03370Q002WM BACKORDER REQUIREMENTS-- ADD,CHANGE,DELETE 4 03380Q015WM BACKORDER REQUIREMENTS-- STOCK ISSUE 5 03390 6 03400 7 03410 8 03420 9 03430 10 03440 11 03450 12 03460 13 03470 14 03480 15 03490 16 03500ÐÐ 37 03510 18 03520 19 03530 20 03540 21 03550 22 03560 23 03570** PB/NB ARRAY 03580Q102SF INVENTORY STATUS - BY PART NO. 1 03590Q016WM BACKORDERS - BY WORK ORDER NO. 2 03600Q018WM BACKORDERS - BY DUE DATE 3 03610 4 03620Q032WM STOCK ISSUES - BY WORK ORDER NO. 5 03630Q034WM STOCK ISSUES - BY PART NO. 6 03640 7 03650 8 03660 9 03670 10 03680 11 03690 12 03700 13 03710 14 03720 15 03730 16 03740 17 03750ÐÐ 18 03760 19 03770 20 03780 21 03790 22 03800 23 03810** NUL ARRAY 03820 03830** A4 ARRAY 03840 03850** TITL ARRAY (EA ELEMENT = 1/2 TITLE LINE) 03860 S T O C K R O O M U 03870P D A T E M E N U 03880<---------U P D A T E P R O G R A M S---------> 03890<--------D I S P L A Y P R O G R A M S--------> 03900 03910 03920** MSG ARRAY 03930ENTER SELECTION NO.: 03940INVALID... TRY AGAIN: 03950\ CODE INVALID.... TRY AGAIN: 03960** SEL ARRAY 03970 03980** PRG/NAM ARRAY 03990 04000ÐÐ** LNK ARRAY 04010 04020/* 04030_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(X¡  X020CF P120282120282(èÈÐ00010H Q020CF00020F* RE-ORG CFMAST. (X020CF) 00030F* REVISED 4/26/80 12:55 PM. DG-REL006 OK. 00040FCFMAST IP F 370 15AI 1 DISK 00050FNEWCF O F 370 15AI 1 DISK 00060I******************************************************************** 00070ICFMAST CF 01 370NCD 00080I 1 256 RECA 00090I 257 370 RECB 00100I GG 02 00110O******************************************************************** 00120ONEWCF D 01 00130O RECA 256 00140O RECB 370 /* 000150_‚ _‚_‚ ÐÈ(èX« è¡SV15WO P999999120282(èÈÐ00010H Q015WO00020F* INPUT TIME CARD LABOR HOURS. (X015WO) 00030F* REVISED 9-22-82 11:55 AM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FWOOPER UC F 64R12AI 1 DISK A 00080FWOOPALT UC F 21R20AI 1 DISK A 00090FDAYLABORO F 80 DISK A 00100FWOMAST IC F 192R 9AI 1 DISK 00110FPJMAST IC F 170R12AI 1 DISK 00120FGLMAST IC F 165R 9AI 1 DISK 00130FWCMAST IC F 960R 8AI 1 DISK 00140FEMMAST UC F 1536R 5AI 1 DISK 00150FTERM132 O F 132 5 00160F**************************************************************** 00170E NUL 1 132 1 NULL CHAR 00180E A14 14 14 1 A INPUT DATA ARRAY 00190E LOC 1 12 3 FIELD STARTING COL # 00200E A9 9 9 1 EXITF QPREED PAR. 00210E NUM 1 8 3 0 NUMERIC FIELD NO.'S 00220E DUN 1 12 1 A EDIT CMPLT FLAG 00230E MES 1 1 30 00240E TABWC 1 9 2 TABWCN 20 00250E LNK 1 7 6 A ÐÐ00260E BIT 33 1 SCREEN CONTR. CHAR 00270E PAR 25 1 00280E TST 25 1 00290E CALL 7 6 00300I******************************************************************* 00310IBITPAR BT 00320I 1 33 BIT 00330I 34 58 PAR 00340I 59 83 TST 00350I******************************************************************* 00360IMGFILE MG 00370I* MESSAGE FILE. 00380I 1 35 MGTEXT 00390I******************************************************************** 00400IWOOPER WP 00410I* WORK ORDER OPER RECORD. 00420I* WORK ORDER # 9A 00430I 1 9 WPORD 00440I* PRIME 6A 00450I 1 6 WPWOP 00460I* DASH 3N 00470I 7 90WPWOD 00480I* OPER SEQ # 3N 00490I 10 120WPSEQ 00500I 1 12 WPKEY ÐÐ00510I* DEPT # 5N 00520I 13 170WPDEPT 00530I* WORK CENTER 3N 00540I 18 200WPWC 00550I* STD HRS - PER UNIT 00560I* SET-UP 9.3P 00570I P 25 293WPSSUH 00580I* RUN 9.3P 00590I P 30 343WPSRUN 00600I* ACTUAL HRS - TOTALS 00610I* SET-UP 7.1P 00620I P 35 381WPASUH 00630I* RUN 7.1P 00640I P 39 421WPARUN 00650I* QTY MOVED-IN 7P 00660I P 43 460WPQIN 00670I* QTY MOVED-OUT 7P 00680I P 47 500WPQOUT 00690I* DATE LAST TRAN 6N 00700I 58 630WPDLT 00710I* RECORD STATUS 1A 00720I 64 64 WPSTAT 00730I******************************************************************** 00740IWOOPALT WA 00750I* WOOPER ALT KEY BY WC ÐÐ00760I 1 50WADEPT 00770I 6 80WAWC 00780I 9 17 WAWO 00790I 18 200WASEQ 00800I 21 21 WASTAT 00810I******************************************************************** 00820IWOMAST WO 00830I* WORK ORDER MASTER. 00840I* WORK ORDER NO. 00850I 1 9 WOWO 00860I* PRIME 6A 00870I 1 1 PREFIX 00880I 1 6 WOWOP 00890I* DASH 3N 00900I 7 90WOWOD 00910I* PART NO. 10N 00920I 10 190WOPN 00930I* TOP ASSY PN 10N 00940I 20 290WOTAPN 00950I* RUN NO. 3N 00960I 30 320WORUN 00970I* PROD LINE 4N 00980I 33 360WOPL 00990I* SCHED QTY 7P 01000I P 37 400WOQTYS ÐÐ01010I* RELEASED QTY 7P 01020I P 41 440WOQTYR 01030I* COMPLETED QTY 7P 01040I P 45 480WOQTYC 01050I* START DATE 6N (YMD) 01060I 49 540WOSTRT 01070I* DUE DATE 6N (YMD) 01080I 55 600WODUE 01090I* DATE ENTERED 6N (YMD) 01100I 61 660WODATE 01110I* DATE LAST REL 6N (YMD) 01120I 67 720WODLTR 01130I* DATE LAST COMPLETION 6N (YMD) 01140I 73 780WODLTC 01150I* DATE LAST LABOR 6N (YMD) 01160I 79 840WODLTL 01170I* DATE LAST MATL CHARGE 6N (YMD) 01180I 85 900WODLTM 01190I* LABOR HRS CHARGED 7.1P 01200I P 91 941WOLABH 01210I* LABOR $ CHARGED 9.3P 01220I P 95 993WOLAB$ 01230I* MATL $ CHARGED 9.3P 01240I P 100 1043WOMAT$ 01250I* QTY TRSF 7P ÐÐ01260I P 105 1080WOQTYT 01270I* AMOUNT TRANSFERRED 9.3P 01280I P 109 1133WO$T 01290I* REMARKS 35A 01300I 114 148 WODESC 01310I* MODEL 12A 01320I 149 160 WOMODL 01330I* FAB CODE 2A 01340I 161 162 WOFAB 01350I* ALTERNATE BILL OF MATERIAL PART NO. 10N 01360I 163 1720WOABM 01370I* ALTERNATE ROUTING PART NO. 10N 01380I 173 1820WOARPN 01390I* DATE CLOSED 6N (YMD) 01400I 183 1880WOCLOS 01410I* RECORD STATUS 1A 01420I 192 192 WOSTAT 01430I******************************************************************* 01440IPJMAST PJ 01450I 170 170 PJSTAT 01460I******************************************************************* 01470IGLMAST GL 01480I 165 165 GLSTAT 01490I********************************************************************** 01500IWCMAST WC ÐÐ01510I* WORK CENTER MASTER 01520I* WORK CENTER NAME 29A 01530I 9 37 WCDESC 01540I* LABOR RATE - SET-UP 5.2P 01550I P 47 492WCLRAT 01560I* LABOR RATE - RUN 5.2P 01570I P 50 522WCRRAT 01580I* LABOR RATE - BURDEN 5.2P 01590I P 53 552WCBRAT 01600I 960 960 WCSTAT 01610I******************************************************************** 01620IEMMAST EM 01630I* EMPLOYEE MAST 01640I 7 31 EMFNAM 01650I 32 56 EMMNAM 01660I 57 86 EMLNAM 01670I P 336 3380EMDEPT 01680I P 339 3400EMWC 01690I 370 374 EMJ 01700I P 375 3793EMRATE 01710I 380 380 EMPU 01720I 510 5150EMDATT 01730I 15361536 EMSTAT 01740I******************************************************************** 01750ICRTFILE CR ÐÐ01760I* EMPLOYEE # 5N 01770I 1 50CREMPL 01780I* USER CODE 8A 01790I 6 13 CRUSER 01800I* DEPT # 5N 01810I 14 180CRDEPT 01820I* JOB NAME 8A (JOB LOADED BY MENU) 01830I 19 26 CRJOB 01840I* SHUTDOWN FLAG 1A 01850I* BLANK = NO SHUTDOWN 01860I 27 27 CRSHUT 01870I* TIME STARTED 6N 01880I 28 330CRTIME 01890I* DATE STARTED 4N 01900I 34 370CRDATE 01910I* CALL STACK 7 X 6A 01920I 38 79 CALL 01930C******************************************************************** 01940C* INITIALIZE 01950C EXSR SR101 1-TIME INIT 01960C MOVE ' ' TCODE 2 STUPIDITY 01970C MOVE ' ' BLK6 6 " " 01980C*------------------------------------------------------------------ 01990C START TAG 02000C* SET-UP 1ST FIELD NO. ÐÐ02010C MOVE ' ' DUN INIT EDIT ARRAY 02020C EXSR SR205 INIT INPUT 02030C EXSR SR206 INIT WOOPER 02040C MOVE BLK35 WCDESC 02050C SETOF 303132 02060C SETOF 333435 02070C Z-ADD1 F 30 FIELD # 02080C GOTO READ 02090C*------------------------------------------------------------------ 02100C NEXT TAG 02110C* SET-UP NEXT FIELD NO. 02120C 1 ADD F F FIELD # 02130C*----------------------------------------------------------------- 02140C READ TAG 02150C* READ DATA FROM TERMINAL. 02160C SETOF 909677 02170C EXSR SR102 VALIDATE FIELD # 02180C 55 GOTO UPDATE DONE 02190C EXSR SR201 IDENTIFY-F 02200C SETON 69 02210C EXSR SR72 PROMPT 02220C SETOF 69 02230C 35 TSEQ COMP 0 54 02240C 54 04 35 02250COR 54 05 35 GOTO NEXT BYPASS DEPT/WC ÐÐ02260C EXSR SR75 READ TERMINAL 02270C 98 GOTO GOODBY GOODBY 02280C 94 GOTO MENU MENU REQUEST 02290C 90 EXSR SR72 DISPLAY INPUT DATA 02300C 93 GOTO NEWITM NEW ITEM 02310C 92 GOTO JUMP FIELD JUMP REQST 02320C 89 F SUB 1 F SKIP BACKWARD 02330C 89 GOTO READ " " 02340C 88 SETOF 90 SPACE FILL 02350C 88 SETON 77 " " 02360C 86 GOTO UPDATE UPDATE 02370C 85 GOTO READ REPEAT 02380C 96 GOTO ERROR ERROR 02390C N77 GOTO EDIT NO DATA INPUT 02400C*------------------------------------------------------------------ 02410C PROCES TAG 02420C* PROCESS INPUT DATA 02430C EXSR SR103 MOVE DATA 02440C*------------------------------------------------------------------- 02450C EDIT TAG 02460C N96 EXSR SR104 EDIT DATA 02470C EXSR SR72 REWRITE DATA 02480C 96 GOTO ERROR ERROR 02490C GOTO NEXT 02500C*------------------------------------------------------------------ ÐÐ02510C UPDATE TAG 02520C* UPDATE DATA BASE. 02530C EXSR SR105 FINAL EDIT 02540C 96 GOTO ERROR ERROR 02550C EXSR SR106 UPDATE 02560C 96 GOTO ERROR ERROR 02610C GOTO START 02620C*------------------------------------------------------------------- 02630C JUMP TAG 02640C* SET-UP JUMP TO REQUESTED FIELD 02650C 1 ADD W W 30 02660C W COMP 14 54 02670C 54 Z-ADD318 M 50 96 FLAG ERROR 02680C 54 GOTO ERROR BAD ESC 02690C MOVE ' ' W3A 3 02700C MOVEAA14,W W3A 02710C Z-ADD3 W2N 20 02720C EXIT SUBRAJ R. JUSTIFY 02730C RLABL W2N 02740C RLABL W3A 02750C MOVE W3A F NEW FIELD # 02760C GOTO READ 02770C*-------------------------------------------------------------------- 02780C ERROR TAG 02790C EXSR SR102 VALIDATE FIELD # ÐÐ02800C EXSR SR89 GET MSG 02820C GOTO READ 02830C*------------------------------------------------------------------ 02840C NEWITM TAG 02850C* SET-UP LINK FOR NEW ITEM 02860C MOVEL'Q015WO' PROG 8 02870C GOTO END 02880C*------------------------------------------------------------------- 02890C MENU TAG 02900C* SET-UP LINK TO MENU 02910C EXSR SR96 GET CRTFILE 02920C Z-ADD1 W 02930C BLK6 LOKUPLNK,W 54 02940C 54 MOVELLNK,W PROG 8 02950C 54 MOVE BLK6 LNK,W 02960C N54 MOVEL'CONTU' PROG 02970C EXSR SR97 UPDATE CRTFILE 02980C EXSR SR98 >>>>>>>>>>>>>>>> 02990C*-------------------------------------------------------------------- 03000C GOODBY TAG 03010C* LINK TO SIGN-OFF 03020C MOVEL'GOODBY' PROG 03030C GOTO END 03040C*------------------------------------------------------------------- 03050C END TAG ÐÐ03060C EXSR SR96 GET CRTFILE 03070C EXSR SR97 UPDATE CRTFILE 03080C EXSR SR98 >>>>>>>>>>>>>>>> 03090C*-------------------------------------------------------------- 03100C ENDJOB TAG 03110C MOVE 'ENDJOB 'PROG 03120C EXSR SR98 >>>>>>>>>>>>>>> 03130C******************************************************************** 03140CSR SR1 BEGSR 03150C* EDIT EMPLOYEE #. 03160CSR TEMPL COMP 0 54 03170CSRN54 Z-ADD531 M 96 FLAG ERROR 03180CSRN54 GOTO END1 03190CSR TEMPL CHAINEMMAST 54 03200CSRN54 EMSTAT COMP 'D' 54 03210CSR 54 Z-ADD699 M 96 FLAG ERROR 03220CSR 54 GOTO END1 03230CSR EMDATT COMP 0 54 03240CSR 54 Z-ADD370 M 96 FLAG ERROR 03250CSR 54 GOTO END1 03260CSR EMRATE COMP 0 54 03270CSRN54 Z-ADD386 M 96 FLAG ERROR 03280CSRN54 GOTO END1 03290CSR EMRATE MULT THRS REG$ 93H 03300CSR END1 ENDSR ÐÐ03310C******************************************************************** 03320CSR SR2 BEGSR 03330C* EDIT INPUT CODE. 03340CSR TINPUT COMP ' ' 54 03350CSR 54 MOVE 'R' TINPUT 03360CSR TINPUT COMP 'V' 34 VACATION 03370CSR TINPUT COMP 'S' 35 SICK LEAVE 03380CSR TINPUT COMP 'A' 36 ABSENT 03390CSR TINPUT COMP 'O' 37 1-1/2 PREM. 03400CSR TINPUT COMP 'D' 38 DOUBLE PREM 03410CSR TINPUT COMP 'R' 39 REGULAR 03420CSR TINPUT COMP 'L' 40 LEAVE OF ABSENCE 03430CSR TINPUT COMP 'H' 41 HOLIDAY - PAID 03440CSR TINPUT COMP 'N' 42 HOLIDAY - NO PAY 03450CSR TINPUT LOKUPTABINP TABIN2 54 03460CSRN54 Z-ADD615 M 96 FLAG ERROR 03470CSR MOVE BLK35 INPNAM 20 03480CSR 54 MOVE TABIN2 INPMAN 03490CSR 54 MOVELTABIN2 TWO 03500CSR 54 MOVELTWO TWOP 03510CSR 54 MOVE TWO TWOD 03520CSR 54 MOVELTWO PREFIX 03530CSR END2 ENDSR 03540C******************************************************************** 03550CSR SR3 BEGSR ÐÐ03560C* EDIT WORK ORDER NO. 03570CSR SETOF 323334 03580CSR TWO CHAINWOMAST 32 GET WMMAST 03590CSRN32 WOSTAT COMP 'D' 32 03600CSRN32 GOTO END3 GOT IT 03610CSR MOVELTWO W12A 12 03620CSR Z-ADDTDEPT W3N 30 03630CSR MOVE W3N W12A 03640CSR W12A CHAINPJMAST 33 GET PROJECT MAST 03650CSRN33 PJSTAT COMP 'D' 33 03660CSRN33 GOTO END3 GOT IT 03670CSR TWO CHAINGLMAST 34 03680CSRN34 GLSTAT COMP 'D' 34 03690C*--------------------------------------------------------------- 03700CSR END3 TAG 03710CSR 32 33 34 Z-ADD506 M 96 FLAG ERROR 03720CSR ENDSR 03730C********************************************************************* 03740CSR SR4 BEGSR 03750C* EDIT SEQ # 03760CSR SETOF 35 03770CSR TSEQ COMP 0 54 03780CSRN54 GOTO END4 03790CSR MOVELTWO W12A 12 03800CSR MOVE TSEQ W12A ÐÐ03810CSR 30 03820COR 31 EXSR SR206 INIT WOOPER 03830CSR 30 03840COR 31 GOTO END4 03850CSR SETON 35 03860CSR Z-ADDWPDEPT TDEPT 03870CSR Z-ADDWPWC TWC 03880CSR EXSR SR6 EDIT WORK CENTER 03890CSR END4 ENDSR 03900C******************************************************************** 03910CSR SR6 BEGSR 03920C* EDIT WORK CENTER. 03940CSR MOVELTDEPT W8A 8 03950CSR MOVE TWC W8A 03960CSR W8A CHAINWCMAST 60 GET WORK CENTER MAST 03970CSRN60 WCSTAT COMP 'D' 60 03980CSR 60 MOVE BLK35 WCDESC 03990CSR 60 Z-ADD646 M 96 FLAG ERROR 04000CSR ENDSR 04010C******************************************************************** 04020CSR SR11 BEGSR 04030C* EDIT WORK CODE. 04040CSR TCODE LOKUPTABWC TABWCN 54 04050CSRN54 Z-ADD385 M 96 FLAG ERROR 04060CSR ENDSR ÐÐ04070C***************************************************************** 04080CSR SR68 BEGSR 04090CSR EXITFQCLF LINE FEED 04100CSR ENDSR 04110C**************************************************************** 04120CSR SR69 BEGSR 04130CSR 50 EXITFZPUTXY MOVE CURSOR 04140CSR RLABL RPGLIN 04150CSR RLABL RPGCOL 04160CSRN50 EXITFZMOVXY MOVE CURSOR 04170CSR RLABL RPGLIN 04180CSR RLABL RPGCOL 04190CSR ENDSR 04200C***************************************************************** 04210CSR SR70 BEGSR 04220C* CLEAR TERM SCREEN. 04230CSRN50 EXITFZCPAGE CLEAR SCREEN 04240CSR 50 EXITFZISTAT 04250CSR 50 EXITFZESCH 04270CSR ENDSR 04280C********************************************************************** 04290CSR SR71 BEGSR 04300C* PUT HEADINGS TO TERMINAL 04310CSR EXSR SR70 CLEAR PAGE 4 04320CSR SETON 71 ÐÐ04330CSR EXCPT PUT HEADINGS 04340CSR SETOF 71 04360CSR ENDSR 04370C********************************************************************* 04380CSR SR72 BEGSR 04390C* PUT DATA TO TERMINAL 04400CSR TWOD COMP 0 55 04410CSR MGTEXT COMP BLK35 56 04420CSRN50 91 ADD F W3N 30 04430CSR 50 1 ADD F W3N 04440CSR MOVELW3N RPGLIN 4 04450CSR MOVEL'001' RPGCOL 4 04460CSR EXSR SR69 MOVE CURSOR 04470CSR SETON 72 04480CSR EXCPT PUT DATA 04490CSR SETOF 72 04500CSR ENDSR 04510C*********************************************************************** 04600CSR SR75 BEGSR 04610C* READ FROM TERMINAL 04620CSR EXSR SR66 INIT A39 04630CSR SETOF 779096 04640CSR SETOF 9392 04650CSR SETOF 8988 04660CSR SETOF 8685 ÐÐ04670CSR MOVE BLK14 W14A 14 BUFFER 04680CSRN50 92 ADD F W3N 04690CSR 50 2 ADD F W3N 04700CSR MOVELW3N RPGLIN 04710CSR MOVELLOC,F RPGCOL 04720CSR EXSR SR69 MOVE CURSOR 04730CSR EXITFZR14 READ FROM TERMINAL 04740CSR RLABL W14A READ BUFFER 04750CSR MOVEAW14A A14 INPUT DATA ARRAY 04760CSR MOVE BLK14 W14A INIT INPUT ARRAY 04770CSR Z-ADD1 W 30 04780CSR '\' LOKUPA14,W 90 FLAG ESC 04790CSRN90 GOTO T75B NOT ESC 04800CSR 1 ADD W W 04810CSR W COMP 14 54 04820CSR 54 GOTO T75A BAD ESC 04830CSR A14,W COMP 'G' 98 GOODBY 04840CSR A14,W COMP 'E' 94 MENU 04850CSR A14,W COMP 'N' 93 NEW ITEM 04860CSR A14,W COMP 'J' 92 JUMP 04870CSR A14,W COMP 'B' 89 SKIP BKWRD 04880CSR A14,W COMP 'S' 88 SPACE FILL 04890CSR A14,W COMP 'U' 86 UPDATE 04900CSR A14,W COMP 'R' 85 REPEAT 04910CSR 98 ÐÐ04920COR 94 04930COR 93 04940COR 92 04950COR 89 04960COR 88 04970COR 86 04980COR 85 GOTO END75 GOOD ESC 04990C*------------------------------------------------------------------ 05000CSR T75A TAG 05010C* FLAG BAD ESC INPUT 05020CSR Z-ADD318 M 96 FLAG ERROR 05030CSR GOTO END75 05040C*-------------------------------------------------------------------- 05050CSR T75B TAG 05060C* MOVE DATA 05070CSR Z-ADD1 W 05080CSR ' ' LOKUPA14,W 77 05090CSR 77 MOVEAA14,W W14A INPUT DATA 05100CSR END75 ENDSR 05110C********************************************************************** 05120CSR SR80 BEGSR 05130C* GET WOOPER RECORD. 05140CSR SETOF 31 05150CSR W12A CHAINWOOPER 30 GET MASTER 05160CSRN30 WPSTAT COMP 'D' 31 FLAG DELETE ÐÐ05170CSR ENDSR 05180C********************************************************************** 05190CSR SR81 BEGSR 05200C* UPDATE WOOPER. 05210CSR SETON 81 05220CSR EXCPT UPDATE WOOPER 05230CSR SETOF 81 05240CSR MOVELTDEPT W8A 8 05250CSR MOVE TWC W8A 05260CSR MOVELTWO W12A 12 05270CSR MOVE TSEQ W12A 05280CSR MOVELW8A W20A 20 05290CSR MOVE W12A W20A 05300CSR W20A CHAINWOOPALT 60 05310CSR SETON 80 05320CSR EXCPT ADD WOOPALT 05330CSR SETOF 80 05340CSR END81 ENDSR 05350C******************************************************************** 05360CSR SR83 BEGSR 05370C* OUTPUT DAYLABOR FILE. 05380CSR SETON 83 05390CSR EXCPT OUTPUT DAYLABOR 05400CSR SETOF 83 05410CSR ENDSR ÐÐ05420C****************************************************************** 05430CSR SR89 BEGSR 05440C* GET MESSAGE MASTER 05450CSR M CHAINMGFILE 54 05460CSR 54 MOVE BLK35 MGTEXT 05470CSR 54 MOVELM MGTEXT 05480CSR 54 MOVE MES,1 MGTEXT 05490CSR ENDSR 05500C******************************************************************* 05510CSR SR96 BEGSR 05520CSR # CHAINCRTFILE H9 GET CRTFILE 05530CSR H9 GOTO ENDJOB 05540CSR ENDSR 05550C****************************************************************** 05560CSR SR97 BEGSR 05570CSR TIME CRTIME 05580CSR MOVELUDATE CRDATE 05590CSR SETON 97 05600CSR EXCPT UPDATE CRTFILE 05610CSR SETOF 97 05620CSR ENDSR 05630C********************************************************************* 05640CSR SR98 BEGSR 05650CSR SETON 51 05660CSR EXSR SR70 CLEAR SCREEN ÐÐ05670CSR EXITFCHAIN >>>>>>>>>>>>> 05680CSR RLABL PROG 05690CSR ENDSR 05700C********************************************************************** 05710CSR SR101 BEGSR 05720C* 1-TIME INITIALIZE 05730CSR MOVE BIT,1 NUL 05740CSR Z-ADD12 FLIMIT 30 TOTAL NUMB FIELDS 05750CSR MOVE ' ' BLK14 14 05760CSR MOVELUDATE W4N 40 05770CSR MOVE UDATE W2N 20 05780CSR MOVELW2N TODAY 60 05790CSR MOVE W4N TODAY 05800C* GET PORT # AND CRTFILE 05810CSR MOVE ' ' W2A 2 05820CSR EXITFZGMINX GET PORT # 05830CSR RLABL W2A 05840CSR MOVE W2A # 20 # NO. 05850CSR # COMP 0 54 05860CSRN54 Z-ADD25 # DEFAULT 05870CSR EXSR SR96 GET CRTFILE 05880CSR MOVE CALL LNK 05890CSR MOVE 'Q015WO 'PROG 05900CSR PAR,# COMP '1' 50 FLAG 132-1 CRT 05910CSR TST,# COMP 'S' 54 ÐÐ05920CSRN54 CRSHUT COMP 'S' 54 05930CSR 54 MOVE 'S' CRSHUT 05940CSR 54 MOVE 'SHUTDOWN'PROG 05950CSR EXSR SR97 UPDATE CRTFILE 05960CSR 54 EXSR SR98 >>>>>>>>>>>>>>> 05970CSR EXSR SR71 PUT HEADING 05980C* DEFINE WORK FIELDS,ETC. 05990CSR MOVE ' ' BLK35 35 06000CSR MOVE ' ' BLK9 9 06010CSR ENDSR 06020C********************************************************************** 06030CSR SR102 BEGSR 06040C* VALIDATE FIELD NO. 06050CSR F COMP 0 54 06060CSRN54 Z-ADD1 F 06070CSR F COMP FLIMIT 55 06080CSR 55 Z-ADD1 F 06090CSR ENDSR 06100C******************************************************************** 06110CSR SR103 BEGSR 06120C* MOVE INPUT DATA 06130CSR EXSR SR201 IDENTIFY-F 06140CSR EXSR SR202 R. JUSTIFY 06150CSR 01 MOVE W10A TEMPL 50 EMPLOYEE NO. 06160CSR 02 MOVE ' ' TINPUT 1 INPUT CODE ÐÐ06170CSR 03 EXSR SR210 BUILD WORK ORDER 06180CSR 04 MOVE W10A TSEQ 30 OPER SEQ NO. 06190CSR 05 MOVE W10A TDEPT 50 DEPT NO. 06200CSR 06 MOVE W10A TWC 30 WORK CENTER NO. 06210CSR 07 MOVE W10A THRS 31 REGULAR HOURS 06220CSR 08 MOVE W10A TOTHRS 31 O.T. HRS 06230CSR 09 MOVE W10A T$ 72 $ AMT 06240CSR 10 MOVE W10A TDATE 60 DATE WORKED 06250CSR 11 MOVELW14A TCODE 2 REWORK CODE 06260CSR 12 MOVELW14A TECN 6 E.C.N. NO. 06270CSR MOVE ' ' DUN,F EDIT FLAG 06280CSR ENDSR 06290C******************************************************************** 06300CSR SR104 BEGSR 06310C* EDIT INPUT DATA 06320CSR 03 EXSR SR3 06330CSR 04 EXSR SR4 06340CSR 06 EXSR SR6 06350CSR 11 EXSR SR11 06360CSR 96 MOVE ' ' DUN,F EDIT FLAG 06370CSRN96 MOVE 'X' DUN,F 06380CSR ENDSR 06390C*********************************************************************** 06400CSR SR105 BEGSR 06410C* FINAL EDIT ÐÐ06420CSR SETOF 77 06430CSR SETON 79 FINAL EDIT FLAG 06440CSR Z-ADD1 F 96 06450C*-------------------------------------------------------------------- 06460CSR T105A TAG 06470CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 06480CSRN54 GOTO END105 06490CSR EXSR SR201 IDENTIFY-F 06500CSR EXSR SR104 EDIT 06510CSRN96 GOTO T105A 06520C*-------------------------------------------------------------------- 06530CSR END105 TAG 06540CSR SETOF 79 06550CSR ENDSR 06560C******************************************************************** 06570CSR SR106 BEGSR 06580C* UPDATE. 06590CSR TCODE COMP 'SJ' 54 06600CSR 54 THRS ADD WPASUH WPASUH SET-UP HRS 06610CSRN54 THRS ADD WPARUN WPARUN RUN HRS 06620CSR EXSR SR81 UPDATE WOOPER 06630CSR EXSR SR83 OUTPUT DAYLABOR 06640CSR END106 ENDSR 06650C******************************************************************** 06660CSR SR201 BEGSR ÐÐ06670C* IDENTIFY FIELD NO. 06680CSR F COMP 1 01 06690CSR F COMP 2 02 06700CSR F COMP 3 03 06710CSR F COMP 4 04 06720CSR F COMP 5 05 06730CSR F COMP 6 06 06740CSR F COMP 7 07 06750CSR F COMP 8 08 06760CSR F COMP 9 09 06770CSR F COMP 10 10 06780CSR F COMP 11 11 06790CSR F COMP 12 12 06800CSR ENDSR 06810C********************************************************************** 06820CSR SR202 BEGSR 06830C* RIGHT JUSTIFY 06840CSR F LOKUPNUM 54 06850CSRN54 GOTO END202 NOT NUMERIC FIELD 06860CSR Z-ADD10 W2N 20 06870CSR MOVELW14A W10A 10 06880CSR EXIT SUBRAJ R. JUSTIFY 06890CSR RLABL W2N 06900CSR RLABL W10A 06910CSR END202 ENDSR ÐÐ06920C******************************************************************** 06930CSR SR205 BEGSR 06940C* INITIALIZE INPUT FIELDS. 06950CSR Z-ADD0 TEMPL 06960CSR MOVE ' ' TINPUT 06970CSR Z-ADD0 TSEQ 06980CSR Z-ADD0 TDEPT 06990CSR Z-ADD0 TWC 07000CSR Z-ADD0 THRS 07010CSR Z-ADD0 TDATE 07020CSR MOVE ' ' TCODE 07030CSR MOVE BLK9 TECN 07040CSR MOVE BLK9 TWOP 07050CSR Z-ADD0 TWOD 07060CSR MOVE BLK9 TWO 07070CSR MOVE ' ' PREFIX 07080CSR Z-ADD0 TOTHRS 07090CSR Z-ADD0 REG$ 07100CSR Z-ADD0 OT$ 07110CSR Z-ADD0 T$ 07120CSR ENDSR 07130C****************************************************************** 07140CSR SR206 BEGSR 07150C* INIT WOOPER RECORD 07160CSR MOVE ' ' WPWOP ÐÐ07170CSR Z-ADD0 WPWOD 07180CSR MOVELWPWOP WPORD 07190CSR MOVE WPWOD WPORD 07200CSR MOVELWPORD WPKEY 07210CSR Z-ADD0 WPSEQ 07220CSR MOVE WPSEQ WPKEY 07230CSR Z-ADD0 WPDEPT 07240CSR Z-ADD0 WPWC 07250CSR Z-ADD0 WPSSUH 07260CSR Z-ADD0 WPSRUN 07270CSR Z-ADD0 WPASUH 07280CSR Z-ADD0 WPARUN 07290CSR Z-ADD0 WPQIN 07300CSR Z-ADD0 WPQOUT 07310CSR Z-ADDTODAY WPDLT 07320CSR MOVE 'A' WPSTAT 07330CSR ENDSR 07340C***************************************************************** 07350CSR SR210 BEGSR 07360C* BUILD WORK ORDER. 07370CSR MOVE ' ' A14 07380CSR MOVEAW14A A14 07390CSR Z-ADD1 W 07400CSR '-' LOKUPA14,W 54 07410CSR MOVE ' ' W4A 4 ÐÐ07420CSR 54 MOVEAA14,W W4A 07430CSR 54 MOVEL' ' W4A 07440CSR 54 MOVEABLK14 A14,W 07450CSR Z-ADD4 W2N 07460CSR EXIT SUBRAJ R.J. 07470CSR RLABL W2N 07480CSR RLABL W4A 07490CSR MOVE W4A TWOD 30 WORK ORDER DASH 07500CSR Z-ADD1 W 07510CSR ' ' LOKUPA14,W 54 07520CSRN54 Z-ADD1 W 07530CSR A14,W COMP '0' 54 54 07540CSRN54 MOVEAA14,W TWOP 6 07550CSRN54 MOVE TWOP W5A 5 07560CSR 54 MOVEAA14,W W5A 07570CSR 54 MOVEL' ' TWOP 07580CSR Z-ADD5 W2N 07590CSR EXIT SUBRAJ R.J. 07600CSR RLABL W2N 07610CSR RLABL W5A 07620CSR MOVE W5A TWOP 07630CSR MOVELTWOP TWO 9 07640CSR MOVE TWOD TWO 07650CSR MOVELTWOP PREFIX 1 07660CSR END210 ENDSR ÐÐ07670O******************************************************************** 07680OTERM132 E 71 07690O BIT,28 1 07700O N50 8 '8091001' 07710O N50 BIT,1 9 07720O N50 BIT,1 10 07730O 50 10 '[001 ]001' 07740O 50 BIT,28 6 07750O TODAY 18 ' - - ' 07760O 88 'EMPLOYEE TIME CARD INPUT' 07770O*--------------------------------------------------------------- 07780O E 71 07790O 1 ' ' 07800O*---------------------------------------------------------------- 07810O E 71 07820O OR 72 01 07830O DOT 35 07840O 24 '(1) CLOCK NO.' 07850O TEMPL Z 42 07860O MAN 88 07870O A39 132 07880O*------------------------------------------------------------------- 07890O E 71 07900O OR 72 02 07910O DOT 35 ÐÐ07920O 24 '(2) INPUT CODE' 07930O TINPUT 38 07940O INPNAM 59 07950O A39 132 07960O*------------------------------------------------------------------- 07970O E 71 07980O OR 72 03 07990O DOT 35 08000O 24 '(3) WORK-ORDER-NO.' 08010O TWOP 43 08020O 55 44 '-' 08030O 55 TWOD Z 47 08040O 45 WODESC 83 08050O 46 PJNAME 88 08060O 47 GLNAME 88 08070O A39 132 08080O*------------------------------------------------------------------- 08090O E 71 08100O OR 72 04 08110O DOT 35 08120O 24 '(4) OPER SEQ NO.' 08130O TSEQ Z 40 08140O A39 132 08150O*------------------------------------------------------------------- 08160O E 71 ÐÐ08170O OR 72 05 08180O DOT 35 08190O 24 '(5) DEPARTMENT' 08200O TDEPT Z 42 08210O A39 132 08220O*------------------------------------------------------------------ 08230O E 71 08240O OR 72 06 08250O DOT 35 08260O 24 '(6) WORK CENTER' 08270O TWC Z 40 08280O WCNAME 67 08290O A39 132 08300O*------------------------------------------------------------------- 08310O E 71 08320O OR 72 07 08330O DOT 35 08340O 24 '(7) REGULAR HOURS' 08350O THRS K 42 08360O REG$ K 55 08370O A39 132 08380O*------------------------------------------------------------------- 08390O E 71 08400O OR 72 08 08410O DOT 35 ÐÐ08420O 24 '(8) PREMIUM HOURS' 08430O TOTHRSK 42 08440O OT$ K 55 08450O A39 132 08460O*------------------------------------------------------------------- 08470O E 71 08480O OR 72 09 08490O DOT 35 08500O 24 '(9) VOUCHER AMOUNT' 08510O T$ K 47 08520O*------------------------------------------------------------------- 08530O E 71 08540O OR 72 10 08550O DOT 35 08560O 24 '(10) DATE WORKED' 08570O TDATE 45 ' - - ' 08580O A39 132 08590O*------------------------------------------------------------------- 08600O E 71 08610O OR 72 11 08620O DOT 35 08630O 24 '(11) REWORK CODE' 08640O TCODE 38 08650O CODNAM 59 08660O A39 132 ÐÐ08670O*------------------------------------------------------------------- 08680O E 71 08690O OR 72 12 08700O DOT 35 08710O 24 '(12) E.C.N.' 08720O TECN 43 08730O A39 132 08740O******************************************************************** 08750ODAYLABOREADD 83 08760O TEMPL 5 08770O TWO 14 08780O TSEQ 17 08790O TDEPT 22 08800O TWC 25 08810O EMDEPT 30 08820O EMWC 33 08830O THRS 35P 08840O TOTHRS 37P 08850O TDATE 43 08860O TCODE 45 08870O TECN 51 08880O EMRATE 56P 08890O REG$ 61P 08900O OT$ 66P 08910O T$ 70P ÐÐ08920O ZERO9 75P 08930O******************************************************************** 08940OWOOPER EADD 81 30 08950O TWO 9 08960O TSEQ 12 08970O TDEPT 17 08980O TWC 20 08990O WPSSUH 29P 09000O WPSRUN 34P 09010O WPASUH 38P 09020O WPARUN 42P 09030O WPQIN 46P 09040O WPQOUT 50P 09050O WPDLT 63 09060O 64 'A' 09070O*------------------------------------------------------------------- 09080O E 81N30 09090O WPSSUH 29P 09100O WPSRUN 34P 09110O WPASUH 38P 09120O WPARUN 42P 09130O WPQIN 46P 09140O WPQOUT 50P 09150O WPDLT 63 09160O 64 'A' ÐÐ09170O******************************************************************** 09180OWOOPALT EADD 80 60 09190O TDEPT 5 09200O TWC 8 09210O TWO 17 09220O TSEQ 20 09230O 21 'A' 09240O*------------------------------------------------------------------- 09250O E 80N60 09260O 21 'A' 09270O******************************************************************* 09280OCRTFILE E 97 09290O PROG 26 09300O CRTIME 33 09310O CRDATE 37 09320O LNK 79 09330O******************************************************************** ** NUL ARRAY 09340 009350** A14 ARRAY 009360 009370** LOC ARRAY 09380003 1 EMPLOYEE 09390013 2 INPUT CODE 09400091 3 WO NO. 09410ÐÐ031 4 OPER SEQ 09420038 5 DEPT 09430045 6 WC 09440054 7 HRS 09450055 8 OT HRS 09460065 9 $$$ 09470080 10 DATE 09480089 11 REWORK CODE 09490096 12 ECN 09500** A9 ARRAY 09510 09520** NUM ARRAY 009530001 EMPLOYEE 009540004 OPER SEQ 09550005 DEPT NO. 09560006 WORK CENTER 09570007 HRS 09580008 O.T. HRS 09590009 VOUCHER $ 09600010 DATE 09610** DUN ARRAY 009620 009630** MES ARRAY 009640---MESSAGE NOT ON FILE--- 009650** TABWC/TABWCN 009660ÐÐECENGINEERING CHANGE 09670PRPRODUCTION REWORK 09680RJRUN JOB 09690SJSET-UP JOB 09700 09710 09720 09730 09740 09750** LNK ARRAY 09760 09770** TABINP/TABIN2 0978000251E TABINP 1 10 1 TABIN2 20 00252E DOT 12 12 2 00253E A39 39 39 1 01441I 30 69 PJNAME 01471I 18 57 GLNAME 03291CSR EMRATE MULT TOTHRS OT$ 93H 03292CSR 37 1.5 MULT OT$ OT$ 03293CSR 38 2 MULT OT$ OT$ 03294CSR EXSR SR107 BUILD MAN NAME 04031CSR 54 MOVE TABWCN CODNAM 20 04061C******************************************************************** 04062CSR SR66 BEGSR 04063CSR MOVE ' ' A39 ÐÐ04064CSR ENDSR 04301CSR EXSR SR66 INIT A39 05741CSR MOVEL'-' DOT 05742CSR MOVE '>' DOT,12 06001CSR Z-ADD0 ZERO9 90 RREGULAR VVACATION SSICK LEAVE AABSENT WITHOUT LEAVE _‚_‚LNK ARRAY 09760 09770** TABINP/TABIN2 0978000251E TABINP 1 10 1 TABIN2 20 00252E DOT 12 12 2 00253E A39 39 39 1 01441I 30 69 PJNAME 01471I 18 57 GLNAME 03291CSR EMRATE MULT TOTHRS OT$ 93H 03292CSR 37 1.5 MULT OT$ OT$ 03293CSR 38 2 MULT OT$ OT$ 03294CSR EXSR SR107 BUILD MAN NAME 04031CSR 54 MOVE TABWCN CODNAM 20 04061C******************************************************************** 04062CSR SR66 BEGSR 04063CSR MOVE ' ' A39 ÐÈ(dZM d*X906SF P999999120282(èÈÐ00010H Q906SF00020F* WRITE POITEM RECORD TO DISK FILE (X906SF) 00030F* LAST REVISED 5-27-82 5:30 PM. 00040FBITTAB IP F 33 DISK 00050FPOITEM IC F 384R 9AI 1 DISK 00060FBVHPI O F 384 DISK A 00070I******************************************************************** 00080IBITTAB BT 00090I 1 33 BIT 00100I******************************************************************** 00110IPOITEM PI 00120I 1 256 REC1 00130I 256 384 REC2 00140C******************************************************************** 00150C MOVE ' ' BLK12 12 00160C MOVE BLK12 W12A 12 00170C EXITFZRED12 00180C RLABL W12A 00190C MOVELW12A W9A 9 00200C W9A CHAINPOITEM 54 00210C N54 EXCPT 00220O******************************************************************** 00230OBVHPI EADD 00240O REC1 256 00250O REC2 384 ÐÐ/* 00260_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(XZx XúX009WO P999999120282(èÈÐ00010H Q009WO00020F* DELETE OPER AND COMPONENT RECORDS FOR DELETED WORK ORDER. (X009WO) 00030F* REVISED 8-01-82 6:15 PM. 00040FBITPAR IP F 90 DISK 00050FWOBATCH IC F 64R DISK 00060FWOPULL UD F 64L19AI 1 DISK 00070FWOOPER UD F 64L20AI 1 DISK 00080FWOOPALT UC F 21R20AI 1 DISK 00090FBOMAST UD F 80L19AI 1 DISK 00100FALTPN UC F 32R29AI 1 DISK 00110FALTDUE UC F 32R29AI 1 DISK 00120FCRTFILE UC F 256R DISK 00130FPRODWO IT F 80 EDISK 00140FTERM50 O F 50 5 00150E******************************************************************** 00160E PRODWO TABPRX 1 4 1 TABPD 35 WO PREFIXES 00170E A29 29 29 1 00180E LNK 1 7 6 A 00190E PAR 25 1 00200E TST 25 1 00210E BIT 33 1 00220E CALL 7 6 00230I***************************************************************** 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 79 TST 00280I******************************************************************** 00290ICRTFILE CR 00300I 28 330CRTIME 00310I 34 370CRDATE 00320I 38 79 CALL 00330I P 81 830CRRRN 00340I******************************************************************** 00350IWOBATCH WB 00360I* WORK ORDER BATCH FILE. 00370I* WORK ORDER 9A 00380I 3 11 WBWO 00390I 22 27 WBSTRT 00400I*------------------------------------------------------------------- 00410I GG 02 00420I********************************************************************* 00430IWOPULL WL 00440I 1 19 WLKEY 00450I 1 9 WLWO 00460I 10 19 WLCPN 00470I 64 64 WLSTAT 00480I******************************************************************** 00490IWOOPER WP 00500I* WORK ORDER OPER FILE. ÐÐ00510I 1 9 WPWO 00520I 1 12 WPKEY 00530I 13 170WPDEPT 00540I 18 200WPWC 00550I******************************************************************** 00560IWOOPALT WA 00570I* WOOPER ALT KEY FILE. 00580I 9 17 WAWO 00590I******************************************************************** 00600IBOMAST BO 00610I* BACKORDER FILE (COMPONENTS). 00620I 1 19 BOKEY 00630I 1 9 BOWO 00640I 10 19 BOPN 00650I 30 35 BODUE 00660I 80 80 BOSTAT 00670I******************************************************************** 00680IALTPN AP 00690I* ALT PART # FILE (COMPONENTS). 00700I 32 32 APSTAT 00710I******************************************************************** 00720IALTDUE AD 00730I* ALT DUE DATE FILE (COMPONENTS). 00740I 32 32 ADSTAT 00750I******************************************************************** ÐÐ00760C N69 MOVE ' ' BLK6 6 00770C N69 EXSR SR101 1-TIME INIT 00780C EXSR SR102 CLASSIFY WO 00790C 40 EXSR SR103 DELETE OPER 00800C 40 EXSR SR104 DELETE PULL FILES 00810C EXSR SR105 DELETE COMPONENTS 00820C*------------------------------------------------------------------- 00830C END TAG 00840C EXSR SR96 GET CRTFILE 00850C Z-ADD1 W 30 00860C ' ' LOKUPLNK,W 54 00870C 54 MOVELLNK,W PROG 8 00880C 54 MOVE ' ' LNK,W 00890C N54 MOVEL'CONTU' PROG 00900C EXSR SR97 UPDATE CRTFILE 00910C EXSR SR98 >>>>>>>>>>>>> 00920C*----------------------------------------------------------------- 00930CLR ENDJOB TAG 00940CLR MOVEL'ENDJOB' PROG 00950CLR EXSR SR98 >>>>>>>>>> 00960C************************************************************** 00970CSR SR96 BEGSR 00980CSR # CHAINCRTFILE H9 00990CSR H9 GOTO ENDJOB 01000CSR ENDSR ÐÐ01010C************************************************************** 01020CSR SR97 BEGSR 01030CSR TIME CRTIME 01040CSR MOVELUDATE CRDATE 01050CSR SETON 97 01060CSR EXCPT UPDATE CRTFILE 01070CSR SETOF 97 01080CSR ENDSR 01090C**************************************************************** 01100CSR SR98 BEGSR 01110CSR EXITFCHAIN >>>>>>>>>>>>> 01120CSR RLABL PROG 01130CSR ENDSR 01140C******************************************************************** 01150CSR SR101 BEGSR 01160C* 1-TIME INIT. 01170CSR SETON 69 01180CSR SETON 70 01190CSR U1 EXCPT TERM50 MSG 01200CSR SETOF 70 01210CSR MOVE ' ' W2A 2 01220CSR MOVE ' ' BLK35 35 01230CSR MOVE ' ' BLK20 20 01240CSR EXITFZGMINX GET PORT # 01250CSR RLABL W2A ÐÐ01260CSR MOVE W2A # 20 01270CSR # COMP 0 54 01280CSRN54 Z-ADD25 # 01290CSR EXSR SR96 GET CRTFILE 01300CSR MOVE CALL LNK 01310CSR MOVE 'Q009WO 'PROG 01320CSR TST,# COMP 'S' 54 01330CSR 54 MOVE 'SHUTDOWN'PROG 01340CSR EXSR SR97 UPD CRTFILE 01350CSR 54 EXSR SR98 >>>>>>>>>>>>> 01360CSR MOVE ' 'PROG 01370CSR CRRRN CHAINWOBATCH H8 01380CSR H8 GOTO ENDJOB 01390CSR ENDSR 01400C******************************************************************** 01410CSR SR102 BEGSR 01420C* CLASSIFY WO - 40=PROD WO. 01430CSR MOVELWBWO W1A 1 01440CSR W1A LOKUPTABPRX 40 01450CSR ENDSR 01460C******************************************************************** 01470CSR SR103 BEGSR 01480C* DELETE WORK ORDER OPER. 01490CSR MOVE BLK35 W20A 20 01500CSR MOVELWBWO W12A 12 ÐÐ01510CSR MOVE ' ' W12A 01520CSR MOVELW12A W20A 01530CSR W20A SETLLWOOPER 01540CSR MOVE BLK35 LAST12 12 01550C*------------------------------------------------------------------- 01560CSR T103A TAG 01570CSR SETOF 54 01580CSR READ WOOPER 54 01590CSR 54 GOTO END103 END FILE 01600CSR WBWO COMP WPWO 54 01610CSR 54 WPKEY COMP LAST12 54 01620CSRN54 GOTO END103 01630CSR MOVE WPKEY LAST12 01640CSR SETON 80 01650CSR EXCPT DELETE WOOPER 01660CSR SETOF 80 01670CSR MOVELWPDEPT W8A 8 01680CSR MOVE WPWC W8A 01690CSR MOVELW8A W20A 01700CSR MOVE W12A W20A 01710CSR W20A CHAINWOOPALT 60 01720CSRN60 SETON 81 01730CSRN60 EXCPT DELETE WOOPALT 01740CSR SETOF 81 01750CSR GOTO T103A ÐÐ01760CSR END103 ENDSR 01770C******************************************************************** 01780CSR SR104 BEGSR 01790C* DELETE PULL FILES. 01800CSR MOVE BLK35 W19A 19 01810CSR MOVELWBWO W19A 01820CSR W19A SETLLWOPULL 01830CSR MOVE BLK35 LASTWL 19 01840C*------------------------------------------------------------------- 01850CSR T104A TAG 01860CSR SETOF 54 01870CSR READ WOPULL 54 01880CSR 54 GOTO END104 01890CSR WLWO COMP WBWO 54 01900CSR 54 WLKEY COMP LASTWL 54 01910CSRN54 GOTO END104 01920CSR MOVE WLKEY LASTWL 19 01930CSR SETON 82 01940CSR EXCPT 01950CSR SETOF 82 01960CSR MOVELWBWO ORDER 11 01970CSR MOVE '00' ORDER 01980CSR MOVE WLCPN PN 10 01990CSR MOVE WBSTRT DUE 6 02000CSR MOVE '80' REC 2 ÐÐ02010CSR EXSR SR106 DELETE ALT KEY 02020CSR GOTO T104A 02030CSR END104 ENDSR 02040C******************************************************************** 02050CSR SR105 BEGSR 02060C* DELETE WORK ORDER COMPONENT RECORDS. 02070CSR MOVE BLK20 LAST19 19 02080CSR MOVELWBWO W19A 19 02090CSR W19A SETLLBOMAST 02100C*------------------------------------------------------------------- 02110CSR T105A TAG 02120CSR SETOF 54 02130CSR READ BOMAST 54 02140CSR 54 GOTO END105 02150CSR BOKEY COMP LAST19 54 02160CSR 54 BOWO COMP WBWO 54 02170CSRN54 GOTO END105 02180CSR MOVE BOKEY LAST19 02190CSR SETON 83 02200CSR EXCPT DELETE BOMAST 02210CSR SETOF 83 02220CSR MOVE WBWO ORDER 02230CSR MOVE '00' ORDER 02240CSR MOVE BOPN PN 02250CSR MOVE BODUE DUE ÐÐ02260CSR MOVE '70' REC 02270CSR EXSR SR106 DELETE ALT KEY 02280CSR GOTO T105A 02290CSR END105 ENDSR 02300C********************************************************************* 02310CSR SR106 BEGSR 02320C* DELETE ALT KEYS 02330CSR MOVE ' ' A29 02340CSR MOVEAPN A29 02350CSR MOVEADUE A29,11 02360CSR MOVEAREC A29,17 02370CSR MOVEAORDER A29,19 02380CSR MOVEAA29 W29A 29 02390CSR W29A CHAINALTPN 60 02400CSRN60 SETON 84 02410CSRN60 EXCPT DELETE ALTPN 02420CSR SETOF 84 02430CSR MOVE ' ' A29 02440CSR MOVEAREC A29 02450CSR MOVEADUE A29,3 02460CSR MOVEAORDER A29,9 02470CSR MOVEAPN A29,20 02480CSR MOVEAA29 W29A 02490CSR W29A CHAINALTDUE 60 02500CSRN60 SETON 85 ÐÐ02510CSRN60 EXCPT DELETE ALTDUE 02520CSR SETOF 85 02530CSR ENDSR 02540O****************************************************************** 02550OCRTFILE E 97 02560O PROG 26 02570O CRTIME 33 02580O CRDATE 37 02590O LNK 79 02600O******************************************************************** 02610OWOOPER E 80 02620O 64 'D' 02630O******************************************************************** 02640OWOOPALT E 81 02650O 21 'D' 02660O******************************************************************** 02670OWOPULL E 82 02680O 64 'D' 02690O******************************************************************** 02700OBOMAST E 83 02710O 80 'D' 02720O******************************************************************** 02730OALTPN E 84 02740O 32 'D' 02750O******************************************************************** ÐÐ02760OALTDUE E 85 02770O 32 'D' 02780O******************************************************************** 02790OTERM50 E 70 U1 02800O 7 'DELETE' ** A29 ARRAY 02810 02820** LNK 02830 02840/* 02850_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ú[s úiX020GL P120282120282(èÈÐ00010H Q020GL00020F* PRINT CHART OF ACCOUNTS-SINGLE LEVEL. (X020GL) ** SYSTEM PRINTER ** 00030F* REVISED 7-28-81 4:15 PM. 00040FCAMAST ID F 40L18AI 1 DISK 00050FGLGUIDE IP F 9 DISK 00060FGLMAST IC F 165R 9AI 1 DISK 00070FPRINT O F 132 OF PRINTER 00080E******************************************************************** 00090E DASH 1 132 1 00100E LEV 1 20 18 00110E GLA 12 11 2 00120I******************************************************************** 00130IGLGUIDE GG 01 00140I 1 9 GGACT 00150I******************************************************************** 00160IGLMAST GL 00170I* ACCOUNT MASTER. 00180I* KEY AREA 00190I* ACCOUNT # 9A 00200I 1 9 GLKEY 00210I 1 1 GLPRFX 00220I 2 60GLPRIM 00230I 7 90GLDASH 30 00240I* ACCOUNT GROUP 4A 00250I 14 17 GLGRUP ÐÐ00260I* ACCOUNT DESCRIPTION 40A 00270I 18 57 GLDESC 00280I* BALANCE FORWARD AMOUNT 11.2P 00290I P 58 632GLBALF 00300I* ACTUAL $ 11.2P X 12 00310I P 64 135 GLA 00320I* CURRENT MONTH-PLUS 11.2P 00330I P 136 1412GLCMP 00340I* CURRENT MONTH-MINUS 11.2P 00350I P 142 1472GLCMM 00360I* SOURCE CODE 1A 00370I* S = SUB-ACCOUNT ONLY, 00380I* MAY NOT BE PARENT 00390I 148 148 GLSC 00400I* BALANCE FORWARD CODE 2A 00410I* 1ST COL 00420I* 1 = ZERO BAL AT START NEW YR 00430I* 2 = CARRY PREV YR FRWD 00440I* 2ND COL 00450I* A = ZERO BAL AT START NEW MO 00460I* B = CARRY PREV MO FRWD 00470I 149 150 GLBFC 00480I* NUMB OF SUB-ACCOUNTS 5P 00490I P 157 1590GLNOSA 00500I* LOW LEVEL CODE 3N ÐÐ00510I 160 1620GLLL 00520I* FILLER 00530I* RECORD STATUS 1A 00540I 165 165 GLSTAT 00550I******************************************************************** 00560ICAMAST CA 00570I* CHART OF ACCOUNTS. 00580I* KEY AREA. 00590I* PARENT ACCOUNT 9A 00600I 1 9 CAPAR 00610I* SUB-ACCOUNT 9A 00620I 10 18 CASUB 00630I* OPERATOR 1A 00640I* S = SUBTRACT 00650I* A = ADD 00660I 25 25 CAOPER 00670I* EFFECTIVITY 00680I* START DATE 6N (YMD) 00690I 26 310CASDAT 00700I* END DATE 6N (YMD) 00710I 32 370CAEDAT 00720I* FILLER 00730I* RECORD STATUS 1A 00740I 40 40 CASTAT 00750C******************************************************************** ÐÐ00760C N79 EXSR SR101 INIT. 00770C N01 GOTO END 00780C SETOF 78 00790C MOVE GGACT W9A 9 00800C EXSR SR80 GET GLMAST. 00810C GLNOSA COMP 0 01 00820C N01 GOTO END 00830C MOVE GLPRFX PAPRFX 1 00840C Z-ADDGLPRIM PAPRIM 50 00850C Z-ADDGLDASH PADASH 30 00860C MOVE GLDESC PADESC 40 00870C MOVE GLSC PASC 1 00880C SETON 71 00890C EXCPT PUT PARENT 00900C SETOF 71 00910C EXSR SR106 DISPLAY DATA. 00920C*------------------------------------------------------------------ 00930C END TAG 00940C********************************************************************* 00950CSR SR72 BEGSR 00960C* PUT DATA TO TERMINAL 00970CSR 1 ADD LINENO LINENO 30 00980CSR SETON 727877 00990CSR EXCPT 01000CSR SETOF 72 ÐÐ01010CSR END72 ENDSR 01020C******************************************************************** 01030CSR SR80 BEGSR 01040C* GET MASTER RECORD 01050CSR W9A CHAINGLMAST 60 GET MASTER 01060CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 01070CSR ENDSR 01080C*********************************************************************** 01090CSR SR101 BEGSR 01100C* 1-TIME INITIALIZE 01110C* DEFINE WORK FIELDS,ETC. 01120CSR SETON 79 01130CSR MOVE '-' DASH 01140CSR MOVEADASH W132A 132 01150CSR Z-ADD100 LINENO 01160CSR ENDSR 01170C******************************************************************** 01180CSR SR106 BEGSR 01190C* DISPLAY CHART OF ACCOUNTS. 01200CSR MOVELGGACT W18A 18 01210CSR W18A SETLLCAMAST 01220C*--------------------------------------------------------------- 01230CSR T106A TAG 01240CSR SETOF 54 01250CSR READ CAMAST 54 ÐÐ01260CSR 54 GOTO END106 01270CSR CAPAR COMP GGACT 54 01280CSRN54 GOTO END106 END OF STRUCTURE 01290CSR CASTAT COMP 'D' 54 01300CSR 54 GOTO T106A DELETED 01310CSR MOVE CASUB W9A 01320CSR EXSR SR80 GET GLMAST 01330CSR EXSR SR72 PUT DATA 01340CSR GOTO T106A GET NEXT RECORD 01350CSR END106 ENDSR 01360O******************************************************************** 01370OPRINT H 201 1P 01380O OR OF 01390O* PUT HEADING. 01400O 70 'CHART OF ACCOUNTS' 01410O 85 ' - SINGLE LEVEL' 01420O UDATE Y 8 01430O 127 'PAGE' 01440O PAGE Z 132 01450O*------------------------------------------------------------------- 01460O H 1 1P 01470O OR OF 01480O* PUT HEADING - SUB-ACCOUNT. 01490O 22 'SUB ACCOUNT' 01500O 71 'TYPE' ÐÐ01510O 77 'OPER' 01520O 94 'EFFECTIVITY' 01530O 123 'CURRENT MONTH' 01540O*------------------------------------------------------------------- 01550O H 3 1P 01560O OR OF 01570O 12 'PREFIX' 01580O 19 'PRIME' 01590O 25 'DASH' 01600O 40 '<--------------' 01610O 51 'DESCRIPTION' 01620O 65 '------------->' 01630O 71 'CODE' 01640O 77 'CODE' 01650O 87 'START' 01660O 95 'STOP' 01670O 112 'PLUS' 01680O 126 'MINUS' 01690O*-------------------------------------------------------------- 01700O H 1 OF 78 01710O* PARENT ACCOUNT DATA ON OVERFLOW 01720O PAPRFX 10 01730O PAPRIMZ 20 01740O 30 21 '-' 01750O PADASHZ 24 ÐÐ01760O PADESC 65 01770O 75 'C O N T''D' 01780O*------------------------------------------------------------------ 01790O EF11 71 01800O PAPRFX 10 01810O PAPRIMZ 20 01820O 30 21 '-' 01830O PADASHZ 24 01840O PADESC 65 01850O PASC 69 01860O*----------------------------------------------------------------- 01870O EF 1 72 01880O* SUB-ACCOUNT DATA. 01890O GLPRFX 10 01900O GLPRIMZ 20 01910O 30 21 '-' 01920O GLDASHZ 24 01930O GLDESC 65 01940O GLSC 69 01950O CAOPER 75 01960O CASDAT 87 ' - - ' 01970O CAEDAT 97 ' - - ' 01980O GLCMP K 112 01990O GLCMM K 125 ** DASH ARRAY 02000ÐÐ 002010** LEV ARRAY 002020 02030/* 02040_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Û[Ý ÛÆX020PE P120282120282(èÈÐ00010H Q020PE00020F* MAINLINE FOR PEMAST INQUIRY. (X020PE) 00030F* REVISED 4-25-70 7:50 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FTERM132 O F 132 5 00080F**************************************************************** 00090E NUL 1 50 1 NULL CHAR 00100E A6 6 6 1 CALL READ PARAM. 00110E A12 12 12 1 A INPUT DATA ARRAY 00120E DUN 1 1 1 A EDIT CMPLT FLAG 00130E MES 1 1 30 00140E* 00150E* 00160E* 00170E* 00180E BIT 33 1 SCREEN CONTR. CHAR 00190E CALL 5 6 CALL STACK 00200I******************************************************************* 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I****************************************************************** 00280ICRTFILE CR 00290I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00300I* STD AREA - SAME FOR ALL PROGRAMS. 00310I* EMPLOYEE # 5N 00320I 1 50CREMPL 00330I* USER CODE 8A 00340I 6 13 CRUSER 00350I* DEPT # 5N 00360I 14 180CRDEPT 00370I* JOB NAME 8A (JOB LOADED BY MENU) 00380I 19 26 CRJOB 00390I* SHUTDOWN FLAG 1A 00400I* BLANK = NO SHUTDOWN 00410I 27 27 CRSHUT 00420I* TIME STARTED 6N 00430I 28 330CRTIME 00440I* DATE STARTED 4N 00450I 34 370CRDATE 00460I* CALL STACK 5 X 6A 00470I 38 67 CALL 00480I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00490I 68 73 CRRET 00500I* MENU NAME 6A ÐÐ00510I 74 79 CRMENU 00520I*------------------------------------------------------------------- 00530I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 00540I* ENG STD SUB-SYSTEM FORMAT. 00550I* TRAN CODE 1A 00560I 80 80 CRTRAN 00570I* DYNAIR PART # (FROM) 12A 00580I 81 92 CRPN 00590I* DESCRIPTION 35A 00600I 93 127 CRDESC 00610I* ENG STD CODE 4A 00620I 128 131 CRSTD 00630I* INSPECTION CODE 3A 00640I 132 134 CRINSP 00650I* LINE # (FROM) 8.5N 00660I 135 1425CRLINE 00670I* TEXT 40A 00680I 143 182 CRTEXT 00690I* MFR PART # (FROM) 24A 00700I 183 206 CRMPN 00710I* MFR CODE 5A 00720I 207 211 CRMFG 00730I* DYNAIR PART # (THRU) 12A 00740I 212 223 CRTPN 00750I* MFR PART # (THRU) 24A ÐÐ00760I 224 247 CRTMPN 00770I* LINE # (THRU) 8.5N 00780I 248 255 CRTHRU 00790I* 00800I* 00810C******************************************************************** 00820C* INITIALIZE 00830C EXSR SR101 1-TIME INIT 00840C*------------------------------------------------------------------ 00850C START TAG 00860C* SET-UP 1ST FIELD NO. 00870C Z-ADD1 F 30 FIELD # 00880C SETON 71 00890C EXSR SR70 PUT HEADING. 00900C SETOF 71 00910C GOTO READ 00920C*------------------------------------------------------------------ 00930C NEXT TAG 00940C* SET-UP NEXT FIELD NO. 00950C 1 ADD F F FIELD # 00960C*----------------------------------------------------------------- 00970C READ TAG 00980C* READ DATA FROM TERMINAL. 00990C EXSR SR102 VALIDATE FIELD # 01000C 55 GOTO UPDATE DONE ÐÐ01010C EXSR SR201 IDENTIFY-F 01020C SETON 69 01030C EXSR SR72 PROMPT 01040C SETOF 69 01050C EXSR SR75 READ TERMINAL 01060C 98 GOTO GOODBY GOODBY 01070C 94 GOTO MENU MENU REQUEST 01080C N77 EXSR SR104 EDIT INPUT FIELD 01090C 96 ERROR 01100CORN77 EXSR SR72 REWRITE INPUT DATA 01110C 93 GOTO NEWITM NEW ITEM 01120C 92 GOTO JUMP FIELD JUMP REQST 01130C 91 GOTO NEXT SKIP FORWARD 01140C 89 F SUB 1 F SKIP BACKWARD 01150C 89 GOTO READ " " 01160C 88 SETOF 90 SPACE FILL 01170C 88 SETON 77 " " 01180C 87 GOTO START 01190C 86 GOTO UPDATE UPDATE 01200C 85 GOTO READ REPEAT 01210C 96 GOTO ERROR ERROR 01220C*------------------------------------------------------------------ 01230C PROCES TAG 01240C* PROCESS INPUT DATA 01250C EXSR SR103 MOVE DATA ÐÐ01260C N96 EXSR SR104 EDIT DATA 01270C EXSR SR72 REWRITE DATA 01280C 96 GOTO ERROR ERROR 01290C GOTO NEXT 01300C*------------------------------------------------------------------ 01310C UPDATE TAG 01320C* UPDATE DATA BASE. 01330C EXSR SR105 FINAL EDIT 01340C 96 GOTO ERROR ERROR 01350C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01360C EXSR SR107 01370C GOTO END 01380C*------------------------------------------------------------------- 01390C JUMP TAG 01400C* SET-UP JUMP TO REQUESTED FIELD 01410C 1 ADD W W 30 01420C W COMP 12 54 01430C 54 Z-ADD318 M 50 96 FLAG ERROR 01440C 54 GOTO ERROR BAD ESC 01450C MOVE '000' W3A 3 01460C MOVEAA12,W W3A 01470C Z-ADD3 W2N 20 01480C EXIT SUBRAJ R. JUSTIFY 01490C RLABL W2N 01500C RLABL W3A ÐÐ01510C MOVE W3A F NEW FIELD # 01520C GOTO READ 01530C*-------------------------------------------------------------------- 01540C ERROR TAG 01550C EXSR SR102 VALIDATE FIELD # 01560C EXSR SR89 GET MSG 01570C EXSR SR73 PUT MSG 01580C GOTO READ 01590C*------------------------------------------------------------------ 01600C NEWITM TAG 01610C* SET-UP LINK FOR NEW ITEM 01620C MOVEL'Q020PE' PROG 8 01630C GOTO END 01640C*------------------------------------------------------------------- 01650C MENU TAG 01660C* SET-UP LINK TO MENU 01670C MOVEL'QQES02' PROG 01680C GOTO END 01690C*-------------------------------------------------------------------- 01700C GOODBY TAG 01710C* LINK TO SIGN-OFF 01720C MOVEL'GOODBY' PROG 01730C GOTO END 01740C*------------------------------------------------------------------- 01750C END TAG ÐÐ01760C PROG COMP BLK8 54 01770C N54 MOVEL'QQES02' PROG 01780C EXSR SR97 UPDATE CRTFILE. 01790C EXITFCHAIN LINK TO NEXT PROG 01800C RLABL PROG 01810C***************************************************************** 01820CSR SR70 BEGSR 01830C* CLEAR TERM SCREEN. 01840CSR SETON 70 01850CSR EXCPT CLEAR SCREEN 01860CSR SETOF 70 01870CSR ENDSR 01880C********************************************************************** 01890CSR SR71 BEGSR 01900C* PUT HEADINGS TO TERMINAL 01910CSR SETON 71 01920CSR EXCPT PUT HEADINGS 01930CSR SETOF 71 01940CSR ENDSR 01950C********************************************************************* 01960CSR SR72 BEGSR 01970C* PUT DATA TO TERMINAL 01980CSR SETON 72 01990CSR EXCPT PUT DATA 02000CSR SETOF 72 ÐÐ02010CSR ENDSR 02020C*********************************************************************** 02030CSR SR73 BEGSR 02040C* PUT ERROR MESSAGE TO TERMINAL 02050CSR SETON 73 02060CSR EXCPT PUT MSG 02070CSR SETOF 73 02080CSR Z-ADDM LSTERR 50 02090CSR ENDSR 02100C******************************************************************* 02110CSR SR75 BEGSR 02120C* READ FROM TERMINAL 02130CSR SETOF 779096 02140CSR SETOF 939291 02150CSR SETOF 8988 02160CSR MOVE BIT,7 A6,2 BUF LENGTH 02170CSR MOVEAA6 W6A 6 02180CSR MOVE BLK12 W12A 12 BUFFER 02190CSR EXITFQWREED READ TERM 02200CSR RLABL W12A 02210CSR RLABL W6A 02220CSR MOVEAW12A A12 02230CSR MOVE BLK12 W12A 02240CSR Z-ADD1 W 30 02250CSR '\' LOKUPA12,W 90 FLAG ESC ÐÐ02260CSRN90 GOTO T75B NOT ESC 02270CSR 1 ADD W W 02280CSR W COMP 12 54 02290CSR 54 GOTO T75A BAD ESC 02300CSR A12,W COMP 'G' 98 GOODBY 02310CSR A12,W COMP 'E' 94 MENU 02320CSR A12,W COMP 'N' 93 NEW ITEM 02330CSR A12,W COMP 'J' 92 JUMP 02340CSR A12,W COMP 'F' 91 SKIP FRWRD 02350CSR A12,W COMP 'B' 89 SKIP BKWRD 02360CSR A12,W COMP 'S' 88 SPACE FILL 02370CSR A12,W COMP 'H' 87 HOME 02380CSR A12,W COMP 'U' 86 UPDATE 02390CSR A12,W COMP 'R' 85 REPEAT 02400CSR 98 02410COR 94 02420COR 93 02430COR 92 02440COR 91 02450COR 89 02460COR 88 02470COR 87 GOTO END75 GOOD ESC 02480C*------------------------------------------------------------------ 02490CSR T75A TAG 02500C* FLAG BAD ESC INPUT ÐÐ02510CSR Z-ADD318 M 96 FLAG ERROR 02520CSR GOTO END75 02530C*-------------------------------------------------------------------- 02540CSR T75B TAG 02550C* MOVE DATA 02560CSR Z-ADD1 W 02570CSR ' ' LOKUPA12,W 77 02580CSR 77 MOVEAA12,W W12A INPUT DATA 02590C*-------------------------------------------------------------------- 02600CSR END75 TAG 02610C* INIT PREV ERROR MSG. 02620CSR LSTERR COMP 0 54 02630CSR 54 MOVE BLK35 MGTEXT 02640CSR 54 EXSR SR73 BLANK MESSAGE 02650CSR Z-ADD0 LSTERR 50 02660CSR ENDSR 02670C********************************************************************** 02680CSR SR89 BEGSR 02690C* GET MESSAGE MASTER 02700CSR M CHAINMGFILE 54 02710CSR 54 MOVE BLK35 MGTEXT 02720CSR 54 MOVELM MGTEXT 02730CSR 54 MOVE MES,1 MGTEXT 02740CSR ENDSR 02750C****************************************************************** ÐÐ02760CSR SR97 BEGSR 02770C* UPDATE CRTFILE. 02780CSR SETON 97 02790CSR EXCPT UPDATE CRTFILE 02800CSR SETOF 97 02810CSR ENDSR 02820C*********************************************************************** 02830CSR SR101 BEGSR 02840C* 1-TIME INITIALIZE 02850CSR MOVE BIT,1 NUL 02860CSR MOVE BIT,1 A6 02870CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02880CSR MOVE ' ' BLK12 12 02890C* GET PORT # AND CRTFILE 02900CSR MOVE ' ' W8A 8 02910CSR Z-ADD0 W2N 20 02920CSR Z-ADD0 W1N 10 02930CSR MOVE ' ' W2A 2 02940CSR EXITFPGMINX GET PORT # 02950CSR RLABL W8A 02960CSR RLABL W2N 02970CSR RLABL W1N 02980CSR RLABL W2A 02990CSR MOVE W2A PORT 20 PORT NO. 03000CSR PORT COMP 0 54 ÐÐ03010CSRN54 Z-ADD25 PORT DEFAULT 03020CSR PORT CHAINCRTFILE H9 03030CSR MOVE BLK12 CRPN 03040CSR MOVE BLK12 CRTPN 03050C* DEFINE WORK FIELDS,ETC. 03060CSR MOVE ' ' BLK35 35 03070CSR MOVE ' ' BLK12 12 03080CSR MOVE ' ' BLK6 6 03090CSR MOVE ' ' BLK8 8 03100C* 03110C* 03120CSR ENDSR 03130C********************************************************************** 03140CSR SR102 BEGSR 03150C* VALIDATE FIELD NO. 03160CSR F COMP 1 54 03170CSRN54 Z-ADD1 F 03180CSR F COMP FLIMIT 55 03190CSR 55 Z-ADD1 F 03200CSR ENDSR 03210C******************************************************************** 03220CSR SR103 BEGSR 03230C* MOVE INPUT DATA 03240CSR EXSR SR201 IDENTIFY-F 03250CSR 01 MOVELW12A NUMPN 100 ÐÐ03260CSR 01 MOVELNUMPN CRPN 03270CSR MOVE ' ' DUN,F EDIT FLAG 03280CSR ENDSR 03290C******************************************************************** 03300CSR SR104 BEGSR 03310C* EDIT INPUT DATA 03320CSR 96 MOVE ' ' DUN,F EDIT FLAG 03330CSRN96 MOVE 'X' DUN,F 03340CSR ENDSR 03350C*********************************************************************** 03360CSR SR105 BEGSR 03370C* FINAL EDIT 03380CSR SETON 79 FINAL EDIT FLAG 03390CSR Z-ADD1 F 03400C*-------------------------------------------------------------------- 03410CSR T105A TAG 03420CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03430CSRN54 GOTO END105 03440CSR EXSR SR201 IDENTIFY-F 03450CSR EXSR SR104 EDIT 03460CSRN96 GOTO T105A 03470C*-------------------------------------------------------------------- 03480CSR END105 TAG 03490CSR SETOF 79 03500CSR ENDSR ÐÐ03510C******************************************************************** 03520CSR SR107 BEGSR 03530C* SET-UP LINKAGE. 03540CSR MOVEL'Q059DP' PROG 8 03550CSR MOVE BLK6 CALL 03560CSR MOVE 'Q020PE' CRRET 03570CSR MOVE 'Q005PE' CALL,1 03580CSR MOVE CRPN CRTPN 03590CSR MOVE 'L' CRTRAN 03600CSR ENDSR 03610C************************************************************************ 03620CSR SR201 BEGSR 03630C* IDENTIFY FIELD NO. 03640CSR SETOF 010203 03650CSR F COMP 1 01 03660CSR ENDSR 03670O******************************************************************** 03680OTERM132 E 71 03690O* PUT HEADINGS. 03700O NUL 50 03710O 70 BIT,28 1 03720O 70 2 'T' 03730O 56 'DYNAIR' 03740O 69 'TRAN' 03750O 76 'MFR' ÐÐ03760O*------------------------------------------------------------------- 03770O E 71 03780O 8 'PART-NO.' 03790O 19 'CODE' 03800O 27 'CODE' 03810O 56 'MFR PART-NUMBER---------' 03820O*------------------------------------------------------------------- 03830O E 71 03840O*------------------------------------------------------------------- 03850O E 72 03860O* PUT DATA. 03870O BIT,28 1 03880O 2 '8' 03890O 8 '004001' 03900O NUMPN 20 ' - - ' 03910O CRTRAN 25 03920O 69 BIT,28 124 03930O 69 125 '8' 03940O 69 128 '004' 03950O 69 01 131 '001' 03960O 69 02 131 '017' 03970O 69 BIT,8 132 03980O*------------------------------------------------------------------- 03990O E 73 04000O* PUT MESSAGE. ÐÐ04010O BIT,28 1 04020O 2 '8' 04030O 8 '005001' 04040O MGTEXT 43 04050O 96 BIT,8 44 04060O 96 BIT,8 45 04070O BIT,28 131 04080O 132 'K' 04090O******************************************************************** 04100OCRTFILE E 97 04110O CALL 67 04120O CRRET 73 04130O CRTRAN 80 04140O CRPN 92 04150O CRTPN 223 ** NUL ARRAY 004160 004170** A6 ARRAY 004180 004190** A12 ARRAY 004200 004210** DUN ARRAY 004220 004230** MES ARRAY 004240---MESSAGE NOT ON FILE--- 004250ÐÐ/* 004260_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(–\¤ –?X021BM P120282120282(èÈÐ00010H Q021BM00020F* UPDATE WHERE USED - CALLED BY Q019BM. (X021BM) 00030F* REVISED 12-05-79 9:15 AM. 00040FBITTAB IP F 33 DISK 00050FBMBATCH UC F 98R DISK 00060FBMWU UC F 21R20AI 1 DISK A 00070E**************************************************************** 00080E BIT 33 1 00090I****************************************************************** 00100IBITTAB BT 00110I 1 33 BIT 00120I****************************************************************** 00130IBMBATCH BB 00140I 1 100TAPN 00150I 11 200TCPN 00160I 97 97 TTCODE 00170I 98 98 TSTAT 00180I***************************************************************** 00190IBMWU BW 00200I 1 100BWCPN 00210I 11 200BWAPN 00220I 21 21 BWSTAT 00230C****************************************************************** 00240C SETOF 01 00250C START TAG ÐÐ00260C* GET BATCH TRANSACTION RECORD 00270C 1 ADD RRN RRN 50 00280C RRN CHAINBMBATCH 54 00290C 54 GOTO ENDJOB END OF FILE 00300C TTCODE COMP 'A' 56 ADD 00310C TTCODE COMP 'D' 55 DELETE ITEM 00320C TTCODE COMP '#' 54 DELETE ASSY 00330C 54 SETON 79 DEL ASSY FLAG 00340C 54 GOTO START 00350C TSTAT COMP 'W' 54 00360C N54 GOTO START 00370C 56 GOTO TAG10 ADD 00380C 55 GOTO TAG50 DELETE ITEM 00390C GOTO START NEITHER 00400C*------------------------------------------------------------------ 00410C TAG10 TAG 00420C SETON 01 00430C* PROCESS ADD 00440C EXSR SR80 GET BMWU 00450C EXSR SR81 ADD BMWU 00460C GOTO START 00470C*--------------------------------------------------------------- 00480C TAG50 TAG 00490C SETON 01 00500C* PROCESS DELETE ITEM ÐÐ00510C EXSR SR80 GET BMWU 00520C EXSR SR82 DELETE BMWU 00530C GOTO START 00540C*----------------------------------------------------------------- 00550C ENDJOB TAG 00560C MOVEL'QQBM01' PROG 8 MENU PROG 00570C 79 MOVEL'Q022BM' PROG DELETE ASSY PROG 00580C EXITFCHAIN LINK 00590C RLABL PROG 00600C***************************************************************** 00610CSR SR80 BEGSR 00620C* GET WHERE-USED FILE 00630CSR SETOF 61 00640CSR MOVELTCPN W20A 20 COMPONENT PN 00650CSR MOVE TAPN W20A ASSY PN 00660CSR W20A CHAINBMWU 60 GET WHERE-USED 00670CSRN60 BWSTAT COMP 'D' 61 FLAG DELETE 00680CSR ENDSR 00690C**************************************************************** 00700CSR SR81 BEGSR 00710C* ADD BMWU TO FILE 00720CSR SETON 81 00730CSR EXCPT ADD BMWU 00740CSR SETOF 81 00750CSR ENDSR ÐÐ00760C**************************************************************** 00770CSR SR82 BEGSR 00780C* DELETE BMWU 00790CSR SETON 82 00800CSR EXCPT DELETE BMWU 00810CSR SETOF 82 00820CSR ENDSR 00830C****************************************************************** 00840OBMWU EADD 81 60 00850O TCPN 10 00860O TAPN 20 00870O 21 'A' 00880O*--------------------------------------------------------------- 00890O E 81N60 00900O 21 'A' 00910O*--------------------------------------------------------------- 00920O E 82N60 00930O 21 'D' 00940O*************************************************************** 00950OBMBATCH E 81 00960O OR 82 00970O 98 'D' /* 000980_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È\ä ÈTX022CF P999999120282(èÈÐ00010H Q022CF00020F* INSERT CHAR IN SELECTOR CODE ARRAY. (Q022CF) 00030F* REVISED 1-18-82 5:50 PM. 00040F* NOTE--- H9 HALT WILL OCCUR IF U1,U2, AND U3 NOT ALL ON 00050FCFMAST UP F 370 15AI 1 DISK 00060E******************************************************************** 00070E SEL 24 1 00080I******************************************************************** 00090ICFMAST CF 01 00100I 328 351 SEL 00110C******************************************************************** 00120C SETOF 70 00130C NU1 00140CORNU2 00150CORNU3 SETON H9 00160C H9 SETOF 01 00170C H9 SETON LR 00180C H9 GOTO END 00190C MOVE 'I' CHAR 1 00200C CHAR LOKUPSEL 54 00210C 54 GOTO END 00220C MOVE 'G' MAT 1 00230C EXSR SR10 00240C N70 MOVE 'P' MAT 00250C N70 EXSR SR10 ÐÐ00260C N70 MOVE 'B' MAT 00270C N70 EXSR SR10 00280C N70 MOVE 'M' MAT 00290C N70 EXSR SR10 00300C N70 MOVE 'N' MAT 00310C N70 EXSR SR10 00320C 70 EXSR SR20 00330C*----------------------------------------------------------------- 00340C END TAG 00350C********************************************************************* 00360CSR SR10 BEGSR 00370CSR Z-ADD1 X 30 00380CSR MAT LOKUPSEL,X 70 00390CSR ENDSR 00400C********************************************************************** 00410CSR SR20 BEGSR 00420CSR Z-ADD1 X 30 00430CSR ' ' LOKUPSEL,X 54 00440CSR 54 MOVE CHAR SEL,X 00450CSR ENDSR 00460O******************************************************************** 00470OCFMAST D 01 70 00480O SEL 351 /* 000490_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( ]9 XR28 P999999120282(èÈÐ SUBROUTINE ZR28 (IBUF) 00010C RING BELL. READ 28-CHAR FROM TERMINAL. 00020 INTEGER IBUF (14) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 28 00070 ITC = 0 00080 IA = $0700 00090 CALL WTREAD(ILU,IXY,IA,N1,IXY,IBUF,N2,ITC) 00100 RETURN 00110 END 00120_‚_‚ ÐÈ(ôaÏ ôÑX129DP P6T999999012783(èÈÐ00010H Q129DP00020F* EVALUATE WEIGHTED RANKING. (X129DP) 00030F* REVISED 1-28-83 4:00 PM. 00040FRANKFILEIP F 80 DISK 00050FTERM75 O F 75 5 U1 00060FPRINT O F 75 PRINTER U2 00070E******************************************************************** 00080E AR 1 7 2 0 00090E TOT 1 7 3 0 00100E PUT 1 7 3 00110E RNK 7 1 A 00120E ALP 7 1 00130I******************************************************************** 00140IRANKFILERH 01 1 CH 00150I 2 75 HEAD 00160I RD 02 1 CD 00170I 2 75 HEAD 00180I 2 20 NAME 00190I 24 250WEIGHT 00200I 33 33 RNK,1 00210I 38 38 RNK,2 00220I 44 44 RNK,3 00230I 51 51 RNK,4 00240I 58 58 RNK,5 00250I 64 64 RNK,6 ÐÐ00260I 71 71 RNK,7 00270I 32 34 ALP,1 00280I 37 39 ALP,2 00290I 43 45 ALP,3 00300I 50 52 ALP,4 00310I 57 59 ALP,5 00320I 63 65 ALP,6 00330I 70 72 ALP,7 00340I RE 03 1 C/ 2 C* 00350I 1 2 EOF 00360I GG 04 00370C******************************************************************** 00380C 04 GOTO END 00390C 03 SETON LR 00400C 03 GOTO END 00410C N02 GOTO END 00420C 1 ADD N N 20 00430C Z-ADD1 X 30 00440C Z-ADD0 AR 00450C MOVE ' ' PUT 00460C*------------------------------------------------------------------- 00470C TAG10 TAG 00480C ' ' LOKUPRNK,X 54 00490C N54 GOTO END 00500C RNK,X COMP 'Y' 60 ÐÐ00510C RNK,X COMP 'N' 61 00520C RNK,X COMP '0' 62 62 00530C 62 RNK,X COMP '9' 6262 00540C 60 Z-ADDWEIGHT AR,X 00550C 62 MOVE RNK,X W1N 10 00560C 62 WEIGHT MULT W1N AR,X 54 00570C 62N54 Z-ADDW1N AR,X 00580C SETOF 64 00590C N60N61N62 SETON 64 00600C N64 MOVE 'Z' W1A 1 00610C N64 MOVE ' ' W2A 2 00620C N64 Z-ADD2 W2N 20 00630C N64 MOVE AR,X W2NN 20 00640C N64 EXIT SUBRED 00650C RLABL W2NN 00660C RLABL W1A 00670C RLABL W2A 00680C RLABL W2N 00690C N64 MOVELW2A PUT,X 00700C N64 W2NN ADD TOT,X TOT,X 00710C 64 MOVELALP,X PUT,X 00720C 1 ADD X X 00730C X COMP 7 54 00740C N54 GOTO TAG10 00750C*------------------------------------------------------------------- ÐÐ00760C END TAG 00770C 36 SETON 35 00780C 01 00790COR 02 SETON 36 00800C N35 EXITFZTFORM 00810CLR SETON 40 00820CLR EXCPT 00830CLR SETOF 40 00840CLR EXITFZTFORM 00850O******************************************************************** 00860OTERM75 D 01N35 00870O UDATE 8 ' - - ' 00880O 46 'EVALUATION' 00890O D 01 00900O OR 02 00910O HEAD 75 00920O 02 NAME 20 00930O 02 N Z 2 00940O 02 3 '.' 00950O 02 PUT,1 35 00960O 02 PUT,2 40 00970O 02 PUT,3 46 00980O 02 PUT,4 53 00990O 02 PUT,5 60 01000O 02 PUT,6 66 ÐÐ01010O 02 PUT,7 73 01020O 02 WEIGHTZ 25 01030O 02 21 '*' 01040O 30 '*' 01050O 36 '*' 01060O 41 '*' 01070O 48 '*' 01080O 54 '*' 01090O 62 '*' 01100O 67 '*' 01110O 74 '*' 01120O E 40 01130O 1 ' ' 01140O E 40 01150O TOT,1 Z 35 01160O TOT,2 Z 40 01170O TOT,3 Z 46 01180O TOT,4 Z 53 01190O TOT,5 Z 60 01200O TOT,6 Z 66 01210O TOT,7 Z 73 01220O******************************************************************** 01230OPRINT H 203 1P 01240O UDATE 8 ' - - ' 01250O 44 'EVALUATION' ÐÐ01260O D 1 01 01270O OR 02 01280O HEAD 75 01290O 02 NAME 20 01300O 02 N Z 2 01310O 02 3 '.' 01320O 02 PUT,1 35 01330O 02 PUT,2 40 01340O 02 PUT,3 46 01350O 02 PUT,4 53 01360O 02 PUT,5 60 01370O 02 PUT,6 66 01380O 02 PUT,7 73 01390O 02 WEIGHTZ 25 01400O 02 21 '*' 01410O 30 '*' 01420O 36 '*' 01430O 41 '*' 01440O 48 '*' 01450O 54 '*' 01460O 62 '*' 01470O 67 '*' 01480O 74 '*' 01490O E 1 40 01500O 1 ' ' ÐÐ01510O E 1 40 01520O TOT,1 Z 35 01530O TOT,2 Z 40 01540O TOT,3 Z 46 01550O TOT,4 Z 53 01560O TOT,5 Z 60 01570O TOT,6 Z 66 01580O TOT,7 Z 73 ** AR ARRAY 01590 01600** TOT 01610 01620** PUT ARRAY 01630 01640/* 01650_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d]” d*X033RX P120282120282(èÈÐ00010H Q033RX00020F* TEXT COPY INITIALIZE (X033RX) DG REL006 OK 00030F* REVISED 12/01/82 11:45 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060E******************************************************************** 00070E BIT 33 1 00080E CALL 5 6 00090E CTX 60 1 A 00100I******************************************************************* 00110IBITTAB BT 01 00120I 1 33 BIT 00130I******************************************************************** 00140ICRTFILE CR 00150I* MENU FIELDS 1 33 XXXXXX 00160I* CURRENT JOB 6A 00170I 21 26 CRJOB 00180I* CALLED BY PROG 6A 00190I 68 73 CRRET 00200I* CALL STACK 6A X 3 00210I 38 67 CALL 00220I* MENU NAME 6A 00230I 74 79 CRMENU 00240I*------------------------------------------------------------------- 00250I* PART # 12A ÐÐ00260I 80 91 CRPN 00270I* OPER SEQ # 3N 00280I 92 940CRSEQ 00290I* TEXT WORK AREA 1A X 60 00300I 95 154 CTX 00310I* CUR INSTR 1A 00320I 215 215 CRTRAN 00330I* COPY FROM PN 12A 00340I 216 227 CRFPN 00350I* COPY FROM SEQ 3P 00360I P 228 2290CRFSEQ 00370I* COPY THRU SEQ 3P 00380I P 230 2310CRESEQ 00390I* COPY TO SEQ 3P 00400I P 232 2330CRTSEQ 00410I* CURRENT LINE # 7P 00420I P 246 2490CRCLIN 00430I* LINE INCREMENT 3P 00440I P 250 2510CRINCR 00450C N01 GOTO END 00460C EXSR SR101 00470C EXSR SR97 00480C MOVEL'Q012RX' PROG 8 00490C EXITFCHAIN 00500C RLABL PROG ÐÐ00510C END TAG 00520C******************************************************************** 00530CSR SR97 BEGSR 00540C* UPDATE CRTFILE. 00550CSR SETON 97 00560CSR EXCPT UPDATE CRTFILE. 00570CSR SETOF 97 00580CSR ENDSR 00590C*********************************************************************** 00600CSR SR101 BEGSR 00610C* 1-TIME INITIALIZE 00620CSR MOVE ' ' W2A 2 00630CSR EXITFZGMINX GET PORT # 00640CSR RLABL W2A 00650CSR MOVE W2A PORT 20 00660CSR PORT CHAINCRTFILE H9 00670CSR H9 GOTO END PROG ERROR 00680C* DEFINE WORK FIELDS. 00690CSR Z-ADD0 ZERO3 30 00700CSR Z-ADD0 ZERO7 70 00710CSR END101 ENDSR 00720O****************************************************************** 00730OCRTFILE E 97 00740O CTX 154 00750O CTX 214 ÐÐ00760O 227 ' ' 00770O ZERO3 229P 00780O ZERO3 231P 00790O ZERO3 233P 00800O 245 ' ' 00810O ZERO7 249P 00820O ZERO3 251P 00830O 256 ' ' /* 000840_‚ ÐÐ_‚_‚0O 227 ' ' 00770O ZERO3 229P 00780O ZERO3 231P 00790O ZERO3 233P 00800O 245 ' ' 00810O ZERO7 249P 00820O ZERO3 251P 00830O 256 ' ' /* 000840_‚ ÐÈ(–]¿ –?X022BM P120282120282(èÈÐ00010H Q022BM00020F* DELETE ASSY, WHERE-USED - CALLED BY Q021BM. (X022BM) 00030F* REVISED 1/12/81 7:20 AM. 00040FBITTAB IP F 33 DISK 00050FBMBATCH UC F 98R DISK 00060FBMMAST UD F 86L20AI 1 DISK 00070FBMWU UC F 21R20AI 1 DISK 00080FPMMST2 UC F 674R12AI 1 DISK 00090FTERMO O F 35 5 00100E******************************************************************** 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160IBMBATCH BB 00170I 1 100TAPN 00180I 11 200TCPN 00190I 97 97 TTCODE 00200I 98 98 TSTAT 00210I******************************************************************** 00220IBMMAST BM 00230I 1 100BMAPN 00240I 11 200BMCPN 00250I 86 86 BMSTAT ÐÐ00260I******************************************************************** 00270IBMWU BW 00280I 1 100BWAPN 00290I 11 200BWCPN 00300I 21 21 BWSTAT 00310I******************************************************************** 00320IPMMST2 PM 00330I P 13 140PMNOBM 00340C******************************************************************** 00350C* INITIALIZE. 00360C EXSR SR101 INIT. 00370C*------------------------------------------------------------------- 00380C START TAG 00390C* SELECT TRANS TO BE PROCESSED. 00400C 1 ADD RRN RRN 50 00410C RRN CHAINBMBATCH 54 00420C 54 GOTO ENDJOB END FILE. 00430C TSTAT COMP ' ' 54 00440C 54 TTCODE COMP '#' 54 00450C N54 GOTO START 00460C MOVELTAPN W20A 20 00470C MOVE ZERO10 W20A 00480C W20A SETLLBMMAST 00490C*------------------------------------------------------------------- 00500C TAG10 TAG ÐÐ00510C* GET/UPDATE BMMAST/BMWU. 00520C SETOF 54 00530C READ BMMAST 54 00540C 54 GOTO TAG50 END FILE. 00550C BMAPN COMP TAPN 54 00560C N54 GOTO TAG50 DONE. 00570C BMSTAT COMP 'D' 54 00580C 54 GOTO TAG10 DELETED. 00590C MOVELBMCPN W20A 00600C MOVE BMAPN W20A 00610C W20A CHAINBMWU 65 00620C EXSR SR81 DELETE. 00630C GOTO TAG10 00640C*------------------------------------------------------------------- 00650C TAG50 TAG 00660C* UPDATE BMBATCH FILE. 00670C SETON 82 00680C EXCPT UPDATE BMBATCH. 00690C SETOF 82 00700C GOTO START 00710C*------------------------------------------------------------------- 00720C ENDJOB TAG 00730C MOVEL'QQBM01' PROG 8 00740C EXITFCHAIN 00750C RLABL PROG ÐÐ00760C******************************************************************** 00770CSR SR81 BEGSR 00780C* DELETE BMMAST/BMWU. 00790CSR MOVELBMAPN W12A 12 00800CSR W12A CHAINPMMST2 54 00810CSR 54 GOTO END81 00820CSR PMNOBM SUB 1 PMNOBM 00830CSR SETON 81 00840CSR EXCPT 00850CSR SETOF 81 00860CSR END81 ENDSR 00870C******************************************************************** 00880CSR SR101 BEGSR 00890C* INITIALIZE 1-TIME. 00900CSR Z-ADD0 ZERO10 100 00910CSR ENDSR 00920O******************************************************************** 00930OBMMAST E 81 00940O 86 'D' 00950O******************************************************************** 00960OBMWU E 81N65 00970O 21 'D' 00980O******************************************************************** 00990OBMBATCH E 82 01000O 98 'D' ÐÐ01010O******************************************************************** 01020OPMMST2 E 81 01030O PMNOBM 14P 01040O******************************************************************** 01050OTERMO T LR 01060O 15 'UPDATE COMPLETE' /* 001070_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(–]ÿ –?X022CG P120282120282(èÈÐ00010H Q022CG00020F* LOAD CGMAST FILE FROM PART MASTER FILE. (X022CG) 00030F* REVISED 5/08/81 11:35 AM. 00040FPMMST2 IP F 674 12AI 1 DISK 00050FCGMAST UC F 64R16AI 1 DISK A 00060I******************************************************************** 00070IPMMST2 PM 01 674NCD 00080I* PART # 10N 00090I 1 100PMPN 00100I* PROD LINE 4N 00110I 15 180PMPL 00120I* MODEL NAME 12A 00130I 19 30 PMMODL 00140I* DESCRIPTION 29A 00150I 31 59 PMDESC 00160I* PROV CODE 1A 00170I 96 96 PLPROV 00180I* GSA PRICE 9.2P 00190I P 502 5062PMGSA 00200I* SALES SET-UP CHARGE 9.2P 00210I P 507 5112PMSUPR 00220I* LIST PRICE 9.2P 00230I P 512 5162PMLPR 00240I* RECORD STATUS 1A 00250I 674 674 PMSTAT ÐÐ00260I GG 02 00270I******************************************************************** 00280ICGMAST CG 00290I 1 40CGPL 00300C******************************************************************** 00310C 01 PMMODL COMP BLK12 01 00320C N01 GOTO END 00330C MOVE '0' PMPL 00340C PMPL COMP 1210 54 54 00350C 54 PMPL COMP 1799 5454 00360C N54 SETOF 01 00370C N54 GOTO END 00380C N01 PMPL COMP 1210 01 01 00390C 01 PMPL COMP 1219 0101 00400C 01 MOVE 1219 PMPL 00410C 01 GOTO TAG10 00420C N01 PMPL COMP 1220 01 01 00430C 01 PMPL COMP 1229 0101 00440C 01 MOVE 1229 PMPL 00450C 01 GOTO TAG10 00460C N01 PMPL COMP 1230 01 01 00470C 01 PMPL COMP 1239 0101 00480C 01 MOVE 1239 PMPL 00490C 01 GOTO TAG10 00500C N01 PMPL COMP 1240 01 01 ÐÐ00510C 01 PMPL COMP 1249 0101 00520C 01 MOVE 1249 PMPL 00530C 01 GOTO TAG10 00540C N01 PMPL COMP 1410 01 01 00550C 01 PMPL COMP 1419 0101 00560C 01 GOTO TAG10 00570C N01 PMPL COMP 1420 01 01 00580C 01 PMPL COMP 1429 0101 00590C 01 MOVE 1429 PMPL 00600C 01 GOTO END 00610C N01 PMPL COMP 1510 01 01 00620C 01 PMPL COMP 1519 0101 00630C 01 MOVE 1519 PMPL 00640C 01 GOTO TAG10 00650C N01 PMPL COMP 1550 01 01 00660C 01 PMPL COMP 1569 0101 00670C 01 MOVE 1569 PMPL 00680C 01 GOTO TAG10 00690C N01 PMPL COMP 1570 01 01 00700C 01 PMPL COMP 1579 0101 00710C 01 GOTO TAG10 00720C N01 PMPL COMP 1600 01 01 00730C 01 PMPL COMP 1699 0101 00740C 01 MOVE 1699 PMPL 00750C 01 GOTO TAG10 ÐÐ00760C N01 PMPL COMP 1700 01 01 00770C 01 PMPL COMP 1799 0101 00780C 01 MOVE 1799 PMPL 00790C N01 GOTO END 00800C*------------------------------------------------------------------- 00810C TAG10 TAG 00820C MOVELPMPL W16A 16 00830C MOVE PMMODL W16A 00840C W16A CHAINCGMAST 60 00850C MOVELPMDESC W20A 20 00860C END TAG 00870CLR Z-ADD0 ZERO10 100 00880CLR MOVE ' ' BLK12 12 00890O******************************************************************** 00900OCGMAST DADD 01 60 00910O PMPL 4 00920O PMMODL 16 00930O PMPN 26 00940O W20A 48 00950O ZERO10 53P 00960O ZERO10 58P 00970O ZERO10 63P 00980O 64 'A' /* 000990_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( ^?  NX008WM P999999120282(èÈÐ00010H Q008WM00020F* REQUEST REL RQMTS RESCHED INFO. (X008WM) 00030F* REVISED 8-21-81 2:20 PM. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FALTKEY UD F 32L29AI 1 DISK 00090FTERMFILEUC F 256R 6AI 1 DISK 00100FTERM132 O F 132 5 00110F**************************************************************** 00120E NUL 1 132 1 NULL CHAR 00130E A10 10 10 1 A INPUT DATA ARRAY 00140E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00150E DUN 1 3 1 A EDIT CMPLT FLAG 00160E MES 1 1 30 00170E A29 29 29 1 00180E BIT 33 1 SCREEN CONTR. CHAR 00190E CALL 5 6 CALL STACK 00200I******************************************************************* 00210IBITTAB BT 00220I 1 33 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I****************************************************************** 00280ICRTFILE CR 00290I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00300I* STD AREA - SAME FOR ALL PROGRAMS. 00310I* EMPLOYEE # 5N 00320I 1 50CREMPL 00330I* USER CODE 8A 00340I 6 13 CRUSER 00350I* DEPT # 5N 00360I 14 180CRDEPT 00370I* JOB NAME 8A (JOB LOADED BY MENU) 00380I 19 26 CRJOB 00390I* SHUTDOWN FLAG 1A 00400I* BLANK = NO SHUTDOWN 00410I 27 27 CRSHUT 00420I* TIME STARTED 6N 00430I 28 330CRTIME 00440I* DATE STARTED 4N 00450I 34 370CRDATE 00460I* CALL STACK 5 X 6A 00470I 38 67 CALL 00480I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00490I 68 73 CRRET 00500I* MENU NAME 6A ÐÐ00510I 74 79 CRMENU 00520I******************************************************************** 00530IALTKEY AK 00540I 1 32 AKREC 00550I 1 2 AKCODE 00560I 3 80AKDUE 00570I 9 19 AKORD 00580I 20 290AKPN 00590I 32 32 AKSTAT 00600I******************************************************************** 00610ITERMFILETF 00620I 1 20TFPORT 00630I 3 60TFSEQ 00640I 7 38 TFREC 00650C******************************************************************** 00660C* INITIALIZE 00670C EXSR SR101 1-TIME INIT 00680C*------------------------------------------------------------------ 00690C START TAG 00700C* SET-UP 1ST FIELD NO. 00710C MOVE ' ' DUN INIT EDIT ARRAY 00720C Z-ADD1 F 30 FIELD # 00730C GOTO READ 00740C*------------------------------------------------------------------ 00750C NEXT TAG ÐÐ00760C* SET-UP NEXT FIELD NO. 00770C 1 ADD F F FIELD # 00780C*----------------------------------------------------------------- 00790C READ TAG 00800C* READ DATA FROM TERMINAL. 00810C SETOF 909677 00820C EXSR SR102 VALIDATE FIELD # 00830C 55 GOTO UPDATE DONE 00840C EXSR SR201 IDENTIFY-F 00850C SETON 69 00860C EXSR SR72 PROMPT 00870C SETOF 69 00880C EXSR SR75 READ TERMINAL 00890C 98 GOTO GOODBY GOODBY 00900C 94 GOTO MENU MENU REQUEST 00910C N77N88 EXSR SR104 EDIT INPUT FIELD 00920C 96 ERROR 00930CORN77N88 EXSR SR72 REWRITE INPUT DATA 00940C 93 GOTO NEWITM NEW ITEM 00950C 92 GOTO JUMP FIELD JUMP REQST 00960C 91 GOTO NEXT SKIP FORWARD 00970C 89 F SUB 1 F SKIP BACKWARD 00980C 89 GOTO READ " " 00990C 88 SETOF 90 SPACE FILL 01000C 88 SETON 77 " " ÐÐ01010C 87 GOTO START 01020C 86 GOTO UPDATE UPDATE 01030C 85 GOTO READ REPEAT 01040C 96 GOTO ERROR ERROR 01050C N77 GOTO EDIT NO DATA INPUT 01060C*------------------------------------------------------------------ 01070C PROCES TAG 01080C* PROCESS INPUT DATA 01090C EXSR SR103 MOVE DATA 01100C*------------------------------------------------------------------- 01110C EDIT TAG 01120C N96 EXSR SR104 EDIT DATA 01130C EXSR SR72 REWRITE DATA 01140C 96 GOTO ERROR ERROR 01150C GOTO NEXT 01160C*------------------------------------------------------------------ 01170C UPDATE TAG 01180C* UPDATE DATA BASE. 01190C EXSR SR105 FINAL EDIT 01200C 96 GOTO ERROR ERROR 01210C EXSR SR106 UPDATE 01220C 96 GOTO ERROR ERROR 01230C GOTO END 01240C*------------------------------------------------------------------- 01250C JUMP TAG ÐÐ01260C* SET-UP JUMP TO REQUESTED FIELD 01270C 1 ADD W W 30 01280C W COMP 10 54 01290C 54 Z-ADD318 M 50 96 FLAG ERROR 01300C 54 GOTO ERROR BAD ESC 01310C MOVE ' ' W3A 3 01320C MOVEAA10,W W3A 01330C Z-ADD3 W2N 20 01340C EXIT SUBRAJ R. JUSTIFY 01350C RLABL W2N 01360C RLABL W3A 01370C MOVE W3A F NEW FIELD # 01380C GOTO READ 01390C*-------------------------------------------------------------------- 01400C ERROR TAG 01410C EXSR SR102 VALIDATE FIELD # 01420C EXSR SR89 GET MSG 01430C EXSR SR73 PUT MSG 01440C GOTO READ 01450C*------------------------------------------------------------------ 01460C NEWITM TAG 01470C* SET-UP LINK FOR NEW ITEM 01480C MOVEL'Q008WM' PROG 8 01490C GOTO END 01500C*------------------------------------------------------------------- ÐÐ01510C MENU TAG 01520C* SET-UP LINK TO MENU 01530C MOVELCRMENU PROG 01540C GOTO END 01550C*-------------------------------------------------------------------- 01560C GOODBY TAG 01570C* LINK TO SIGN-OFF 01580C MOVEL'GOODBY' PROG 01590C GOTO END 01600C*------------------------------------------------------------------- 01610C END TAG 01620C EXSR SR97 UPDATE CRTFILE 01630C EXITFCHAIN LINK TO NEXT PROG 01640C RLABL PROG 01650C******************************************************************* 01660CSR SR2 BEGSR 01670C* EDIT 01680C* 01690C* 01700C* 01710C* 01720C* 01730C* 01740C* 01750C* ÐÐ01760CSR ENDSR 01770C********************************************************************* 01780CSR SR3 BEGSR 01790C* EDIT 01800C* 01810C* 01820C* 01830C* 01840C* 01850C* 01860C* 01870CSR ENDSR 01880C******************************************************************* 01890C* 01900C* 01910C* 01920C* 01930C* 01940C* 01950C* 01960C* 01970C* 01980C* 01990C* 02000C* ÐÐ02010C* 02020C* 02030C* 02040C* 02050C* 02060C* 02070C* 02080C***************************************************************** 02090CSR SR70 BEGSR 02100C* CLEAR TERM SCREEN. 02110CSR SETON 70 02120CSR EXCPT CLEAR SCREEN 02130CSR SETOF 70 02140CSR ENDSR 02150C********************************************************************** 02160CSR SR71 BEGSR 02170C* PUT HEADINGS TO TERMINAL 02180CSR SETON 71 02190CSR EXCPT PUT HEADINGS 02200CSR SETOF 71 02210CSR ENDSR 02220C********************************************************************* 02230CSR SR72 BEGSR 02240C* PUT DATA TO TERMINAL 02250CSR SETON 72 ÐÐ02260CSR EXCPT PUT DATA 02270CSR SETOF 72 02280CSR ENDSR 02290C*********************************************************************** 02300CSR SR73 BEGSR 02310C* PUT ERROR MESSAGE TO TERMINAL 02320CSR SETON 73 02330CSR EXCPT PUT MSG 02340CSR SETOF 73 02350CSR Z-ADDM LSTERR 50 02360CSR ENDSR 02370C******************************************************************* 02380CSR SR75 BEGSR 02390C* READ FROM TERMINAL 02400CSR SETOF 779096 02410CSR SETOF 939291 02420CSR SETOF 898887 02430CSR SETOF 8685 02440CSR MOVE BIT,6 BUFLGT 2 READ BUFFER LGTH 02450CSR MOVE BLK10 W10A 10 BUFFER 02460CSR EXITFQWREED READ FROM TERMINAL 02470CSR RLABL W10A READ BUFFER 02480CSR RLABL BUFLGT READ BUFFER LGTH 02490CSR MOVEAW10A A10 INPUT DATA ARRAY 02500CSR MOVE BLK10 W10A INIT INPUT ARRAY ÐÐ02510CSR Z-ADD1 W 30 02520CSR '\' LOKUPA10,W 90 FLAG ESC 02530CSRN90 GOTO T75B NOT ESC 02540CSR 1 ADD W W 02550CSR W COMP 10 54 02560CSR 54 GOTO T75A BAD ESC 02570CSR A10,W COMP 'G' 98 GOODBY 02580CSR A10,W COMP 'E' 94 MENU 02590CSR A10,W COMP 'N' 93 NEW ITEM 02600CSR A10,W COMP 'J' 92 JUMP 02610CSR A10,W COMP 'F' 91 SKIP FRWRD 02620CSR A10,W COMP 'B' 89 SKIP BKWRD 02630CSR A10,W COMP 'S' 88 SPACE FILL 02640CSR A10,W COMP 'H' 87 HOME 02650CSR A10,W COMP 'U' 86 UPDATE 02660CSR A10,W COMP 'R' 85 REPEAT 02670CSR 98 02680COR 94 02690COR 93 02700COR 92 02710COR 91 02720COR 89 02730COR 88 02740COR 87 02750COR 86 ÐÐ02760COR 85 GOTO END75 GOOD ESC 02770C*------------------------------------------------------------------ 02780CSR T75A TAG 02790C* FLAG BAD ESC INPUT 02800CSR Z-ADD318 M 96 FLAG ERROR 02810CSR GOTO END75 02820C*-------------------------------------------------------------------- 02830CSR T75B TAG 02840C* MOVE DATA 02850CSR Z-ADD1 W 02860CSR ' ' LOKUPA10,W 77 02870CSR 77 MOVEAA10,W W10A INPUT DATA 02880C*-------------------------------------------------------------------- 02890CSR END75 TAG 02900C* INIT PREV ERROR MSG. 02910CSR LSTERR COMP 0 54 02920CSR 54 MOVE BLK35 MGTEXT 02930CSR 54 EXSR SR73 BLANK MESSAGE 02940CSR Z-ADD0 LSTERR 50 02950CSR ENDSR 02960C********************************************************************** 02970CSR SR89 BEGSR 02980C* GET MESSAGE MASTER 02990CSR M CHAINMGFILE 54 03000CSR 54 MOVE BLK35 MGTEXT ÐÐ03010CSR 54 MOVELM MGTEXT 03020CSR 54 MOVE MES,1 MGTEXT 03030CSR ENDSR 03040C******************************************************************** 03050C* 03060C* 03070C* 03080C* 03090C* 03100C* 03110C* 03120C* 03130C* 03140C* 03150C* 03160C*********************************************************************** 03170CSR SR101 BEGSR 03180C* 1-TIME INITIALIZE 03190CSR MOVE BIT,1 NUL 03200CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03210CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03220CSR MOVE ' ' BLK10 10 03230C* GET PORT # AND CRTFILE 03240CSR MOVE ' ' W8A 8 03250CSR Z-ADD0 W2N 20 ÐÐ03260CSR Z-ADD0 W1N 10 03270CSR MOVE ' ' W2A 2 03280CSR EXITFPGMINX GET PORT # 03290CSR RLABL W8A 03300CSR RLABL W2N 03310CSR RLABL W1N 03320CSR RLABL W2A 03330CSR MOVE W2A PORT 20 PORT NO. 03340CSR PORT COMP 0 54 03350CSRN54 Z-ADD25 PORT DEFAULT 03360CSR PORT CHAINCRTFILE H9 03370C* DEFINE WORK FIELDS,ETC. 03380CSR MOVE ' ' BLK35 35 03390C* 03400C* 03410C* 03420C* 03430C* 03440CSR ENDSR 03450C********************************************************************** 03460CSR SR102 BEGSR 03470C* VALIDATE FIELD NO. 03480CSR F COMP 0 54 03490CSRN54 Z-ADD1 F 03500CSR F COMP FLIMIT 55 ÐÐ03510CSR 55 Z-ADD1 F 03520CSR ENDSR 03530C******************************************************************** 03540CSR SR103 BEGSR 03550C* MOVE INPUT DATA 03560CSR EXSR SR201 IDENTIFY-F 03570CSR EXSR SR202 R. JUSTIFY 03580CSR 01 EXSR SR210 BUILD WO # 03590CSR 02 MOVE W10A FRDATE 60 FROM DATE 03600CSR 03 MOVE W10A TODATE 60 TO DATE 03610CSR MOVE ' ' DUN,F EDIT FLAG 03620CSR ENDSR 03630C******************************************************************** 03640CSR SR104 BEGSR 03650C* EDIT INPUT DATA 03660CSR 02 EXSR SR2 03670CSR 03 EXSR SR3 03680CSR 96 MOVE ' ' DUN,F EDIT FLAG 03690CSRN96 MOVE 'X' DUN,F 03700CSR ENDSR 03710C*********************************************************************** 03720CSR SR105 BEGSR 03730C* FINAL EDIT 03740CSR SETOF 77 03750CSR SETON 79 FINAL EDIT FLAG ÐÐ03760CSR Z-ADD1 F 96 03770C*-------------------------------------------------------------------- 03780CSR T105A TAG 03790CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03800CSRN54 GOTO END105 03810CSR EXSR SR201 IDENTIFY-F 03820CSR EXSR SR104 EDIT 03830CSRN96 GOTO T105A 03840C*-------------------------------------------------------------------- 03850CSR END105 TAG 03860CSR SETOF 79 03870CSR ENDSR 03880C******************************************************************** 03890CSR SR106 BEGSR 03900C* COPY ITEMS TO BE RESCHED TO TERMFILE. 03910C* DELETE CURRENT AK-DUE ALTKEY RECORD. 03920C* 03930CSR MOVE FRDATE FROM 6 03940CSR MOVE ' ' A29 03950CSR MOVEA'B7' A29 03960CSR MOVEAFROM A29,3 03970CSR MOVEATWO A29,9 03980CSR MOVEAA29 W29A 29 03990CSR W29A SETLLALTKEY 04000C*------------------------------------------------------------------- ÐÐ04010CSR T106A TAG 04020CSR SETOF 54 04030CSR READ ALTKEY 54 GET AK-DUE 04040CSR 54 GOTO END106 EOF 04050CSR AKCODE COMP 'B7' 54 04060CSR 54 AKDUE COMP FRDATE 54 04070CSR 54 AKWO COMP TWO 54 04080CSR 54 AKPN COMP LSTPN 54 04090CSRN54 GOTO END106 04100CSR MOVE AKPN LSTPN 100 04110CSR AKSTAT COMP 'D' 54 04120CSR 54 GOTO T106A 04130CSR 1 ADD TCOUNT TCOUNT 40 04140CSR MOVELPORT TKEY 6 04150CSR MOVE TCOUNT TKEY 04160CSR TKEY CHAINTERMFILE 60 04170CSR SETON 80 04180CSR EXCPT COPY 04190CSR SETOF 80 04200CSR GOTO T106A 04210CSR END106 ENDSR 04220C************************************************************************ 04230CSR SR201 BEGSR 04240C* IDENTIFY FIELD NO. 04250CSR F COMP 1 01 ÐÐ04260CSR F COMP 2 02 04270CSR F COMP 3 03 04280CSR ENDSR 04290C********************************************************************** 04300CSR SR202 BEGSR 04310C* RIGHT JUSTIFY 04320CSR F LOKUPNUM 54 04330CSRN54 GOTO END202 NOT NUMERIC FIELD 04340CSR Z-ADD0 W2N 20 04350CSR EXIT SUBRAJ R. JUSTIFY 04360CSR RLABL W2N 04370CSR RLABL W10A 04380CSR END202 ENDSR 04390C**************************************************************************04400CSR SR210 BEGSR 04410C* BUILD WO #. 04420CSR MOVELW10A TWO 04430CSR MOVELL' ' W10A 04440CSR EXSR SR202 R.J. 04450CSR MOVE W10A W5A 04460CSR MOVE W5A TWO 04470CSR ENDSR 04480C******************************************************************** 04490C* 04500C* ÐÐ04510C* 04520C* 04530C* 04540C* 04550C* 04560C* 04570C* 04580C* 04590C* 04600C* 04610C* 04620C* 04630C* 04640C* 04650C* 04660C* 04670C* 04680O******************************************************************** 04690OTERMFILEEADD 80 60 04700O TKEY 6 04710O AKREC 38 04720O TODATE 44 04730O 256 'A' 04740O*------------------------------------------------------------------- 04750O E 80N60 ÐÐ04760O AKREC 38 04770O TODATE 44 04780O 256 'A' 04790O******************************************************************** 04800OALTKEY E 80 04810O 32 'D' 04820O******************************************************************** 04830OTERM132 E 71 04840O 63 'RELEASED REQUIREMENT' 04850O 80 'RESCHEDULE INPUT' 04860O*------------------------------------------------------------------- 04870O E 71 04880O 1 ' ' 04890O*------------------------------------------------------------------- 04900O E 71 04910O OR 72 01 04920O DOTS 33 04930O 18 '(1) WORK-ORDER #' 04940O TWO 41 04950O*------------------------------------------------------------------- 04960O E 71 04970O OR 72 02 04980O DOTS 33 04990O 22 '(2) CURRENT DUE DATE' 05000O FRDATE 43 ' - - ' ÐÐ05010O*------------------------------------------------------------------- 05020O E 71 05030O OR 72 03 05040O DOTS 33 05050O 18 '(3) NEW DUE DATE' 05060O TODATE 43 ' - - ' ** NUL ARRAY 005070 005080** A10 ARRAY 005090 005100** NUM ARRAY 005110 005120** DUN ARRAY 005130 005140** MES ARRAY 005150---MESSAGE NOT ON FILE--- 005160** A29 ARRAY 005170 05180/* 05190_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(&_Ž &æX023BM P120282120282(èÈÐ00010H Q023BM00020F* DISPLAY BMBATCH FILE. (X023BM) 00030F* REVISED 5-07-80 4:00 PM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE IC F 256R DISK 00070FBMBATCH IC F 98R DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A6 6 6 1 CALL READ PARAM. 00120E A4 4 4 1 A INPUT DATA ARRAY 00130E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 1 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E BIT 256 1 SCREEN CONTR. CHAR 00170E CALL 5 6 CALL STACK 00180E ERR 7 5 0A 00190E* 00200I******************************************************************* 00210IBITHEX BT 00220I 1 256 BIT 00230I******************************************************************* 00240IMGFILE MG 00250I* MESSAGE FILE. ÐÐ00260I 1 35 MGTEXT 00270I****************************************************************** 00280ICRTFILE CR 00290I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00300I* STD AREA - SAME FOR ALL PROGRAMS. 00310I* EMPLOYEE # 5N 00320I 1 50CREMPL 00330I* USER CODE 8A 00340I 6 13 CRUSER 00350I* DEPT # 5N 00360I 14 180CRDEPT 00370I* JOB NAME 8A (JOB LOADED BY MENU) 00380I 19 26 CRJOB 00390I* SHUTDOWN FLAG 1A 00400I* BLANK = NO SHUTDOWN 00410I 27 27 CRSHUT 00420I* TIME STARTED 6N 00430I 28 330CRTIME 00440I* DATE STARTED 4N 00450I 34 370CRDATE 00460I* CALL STACK 5 X 6A 00470I 38 67 CALL 00480I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00490I 68 73 CRRET 00500I* MENU NAME 6A ÐÐ00510I 74 79 CRMENU 00520I******************************************************************** 00530IBMBATCH BH 00540I* BATCH BILL MATL TRANSACTIONS. 00550I 1 100TAPN 00560I 11 200TCPN 00570I 25 270TITNO 00580I P 28 310TQTY 00590I 34 352TSCRP 00600I 36 37 TISSU 00610I 38 39 TBCHG 00620I 40 41 TECHG 00630I 42 46 TBECN 00640I 47 51 TEECN 00650I 52 52 TDISP 00660I 53 54 TAECHG 00670I 55 560TLL 00680I P 58 600TOPER 00690I P 61 630TDEPT 00700I P 64 650TWC 00710I 66 75 TREF 00720I P 76 96 ERR 00730I 97 97 TTCODE 00740I 98 98 TSTAT 00750C******************************************************************** ÐÐ00760C* INITIALIZE 00770C EXSR SR101 1-TIME INIT 00780C*------------------------------------------------------------------ 00790C START TAG 00800C* SET-UP 1ST FIELD NO. 00810C Z-ADD1 F 30 FIELD # 00820C GOTO READ 00830C*------------------------------------------------------------------ 00840C NEXT TAG 00850C* SET-UP NEXT FIELD NO. 00860C 1 ADD F F FIELD # 00870C*----------------------------------------------------------------- 00880C READ TAG 00890C* READ DATA FROM TERMINAL. 00900C SETOF 9096 00910C EXSR SR102 VALIDATE FIELD # 00920C 55 GOTO UPDATE DONE 00930C EXSR SR201 IDENTIFY-F 00940C Z-ADD257 M 50 00950C EXSR SR89 GET PROMPT MSG 00960C SETON 69 00970C EXSR SR73 PROMPT 00980C SETOF 69 00990C EXSR SR75 READ TERMINAL 01000C*------------------------------------------------------------------- ÐÐ01010C ESCAPE TAG 01020C 98 GOTO GOODBY GOODBY 01030C 94 GOTO MENU MENU REQUEST 01040C N77N88 EXSR SR104 EDIT INPUT FIELD 01050C 93 GOTO NEWITM NEW ITEM 01060C 92 GOTO JUMP FIELD JUMP REQST 01070C 91 GOTO NEXT SKIP FORWARD 01080C 89 F SUB 1 F SKIP BACKWARD 01090C 89 GOTO READ " " 01100C 88 SETOF 90 SPACE FILL 01110C 88 SETON 77 " " 01120C 87 GOTO START 01130C 86 GOTO UPDATE UPDATE 01140C 85 GOTO READ REPEAT 01150C 96 GOTO ERROR ERROR 01160C 90 Z-ADD318 M 96 01170C 90 GOTO ERROR 01180C N77 GOTO NEXT NO DATA INPUT 01190C*------------------------------------------------------------------ 01200C PROCES TAG 01210C* PROCESS INPUT DATA 01220C EXSR SR103 MOVE DATA 01230C N96 EXSR SR104 EDIT DATA 01240C 96 GOTO ERROR ERROR 01250C GOTO NEXT ÐÐ01260C*------------------------------------------------------------------ 01270C UPDATE TAG 01280C* UPDATE DATA BASE. 01290C EXSR SR105 FINAL EDIT 01300C 96 GOTO ERROR ERROR 01310C EXSR SR106 UPDATE 01320C 96 GOTO ERROR ERROR 01330C 90 GOTO ESCAPE 01340C GOTO START 01350C*------------------------------------------------------------------- 01360C JUMP TAG 01370C* SET-UP JUMP TO REQUESTED FIELD 01380C 1 ADD W W 30 01390C W COMP 4 54 01400C 54 Z-ADD318 M 50 96 FLAG ERROR 01410C 54 GOTO ERROR BAD ESC 01420C MOVE '000' W3A 3 01430C MOVEAA4,W W3A 01440C Z-ADD3 W2N 20 01450C EXIT SUBRAJ R. JUSTIFY 01460C RLABL W2N 01470C RLABL W3A 01480C MOVE W3A F NEW FIELD # 01490C GOTO READ 01500C*-------------------------------------------------------------------- ÐÐ01510C ERROR TAG 01520C EXSR SR102 VALIDATE FIELD # 01530C EXSR SR89 GET MSG 01540C EXSR SR73 PUT MSG 01550C GOTO READ 01560C*------------------------------------------------------------------ 01570C NEWITM TAG 01580C* SET-UP LINK FOR NEW ITEM 01590C MOVEL'Q023BM' PROG 8 01600C GOTO END 01610C*------------------------------------------------------------------- 01620C MENU TAG 01630C* SET-UP LINK TO MENU 01640C MOVELCRMENU PROG 01650C GOTO END 01660C*-------------------------------------------------------------------- 01670C GOODBY TAG 01680C* LINK TO SIGN-OFF 01690C MOVEL'GOODBY' PROG 01700C GOTO END 01710C*------------------------------------------------------------------- 01720C END TAG 01730C EXSR SR97 UPDATE CRTFILE 01740C EXITFCHAIN LINK TO NEXT PROG 01750C RLABL PROG ÐÐ01760C********************************************************************** 01770CSR SR71 BEGSR 01780C* PUT HEADINGS TO TERMINAL 01790CSR SETON 71 01800CSR EXCPT PUT HEADINGS 01810CSR SETOF 71 01820CSR Z-ADD5 COUNT 30 01830CSR ENDSR 01840C********************************************************************* 01850CSR SR72 BEGSR 01860C* PUT DATA TO TERMINAL 01870CSR SETON 72 01880CSR EXCPT PUT DATA 01890CSR SETOF 72 01900CSR 1 ADD COUNT COUNT 01910CSR ENDSR 01920C*********************************************************************** 01930CSR SR73 BEGSR 01940C* PUT ERROR MESSAGE TO TERMINAL 01950CSR SETON 73 01960CSR EXCPT PUT MSG 01970CSR SETOF 73 01980CSRN69 GOTO END73 NOT PROMPT 01990CSR EXITFQCCR CAR RETURN ONLY 02000CSR MOVE BIT,44 W2A 2 ÐÐ02010CSR MOVELBIT,1 W2A 02020CSR EXITFQMOVR MOVE CURSOR 02030CSR RLABL W2A 02040CSR END73 ENDSR 02050C******************************************************************* 02060CSR SR75 BEGSR 02070C* READ FROM TERMINAL 02080CSR SETOF 779096 02090CSR SETOF 939291 02100CSR SETOF 898887 02110CSR SETOF 8685 02120CSR MOVE BIT,3 A6,2 BUF LENGTH 02130CSR MOVEAA6 W6A 6 02140CSR MOVE BLK4 W4A 4 BUFFER 02150CSR EXITFQWREED READ TERM 02160CSR RLABL W4A 02170CSR RLABL W6A 02180CSR MOVEAW4A A4 02190CSR MOVE BLK4 W4A 02200CSR Z-ADD1 W 30 02210CSR '\' LOKUPA4,W 90 FLAG ESC 02220CSRN90 GOTO T75B NOT ESC 02230CSR 1 ADD W W 02240CSR W COMP 4 54 02250CSR 54 GOTO T75A BAD ESC ÐÐ02260CSR A4,W COMP 'G' 98 GOODBY 02270CSR A4,W COMP 'E' 94 MENU 02280CSR A4,W COMP 'N' 93 NEW ITEM 02290CSR A4,W COMP 'J' 92 JUMP 02300CSR A4,W COMP 'F' 91 SKIP FRWRD 02310CSR A4,W COMP 'B' 89 SKIP BKWRD 02320CSR A4,W COMP 'S' 88 SPACE FILL 02330CSR A4,W COMP 'H' 87 HOME 02340CSR A4,W COMP 'U' 86 UPDATE 02350CSR A4,W COMP 'R' 85 REPEAT 02360CSR 98 02370COR 94 02380COR 93 02390COR 92 02400COR 91 02410COR 89 02420COR 88 02430COR 87 02440COR 86 02450COR 85 GOTO END75 GOOD ESC 02460C*------------------------------------------------------------------ 02470CSR T75A TAG 02480C* FLAG BAD ESC INPUT 02490CSR Z-ADD318 M 96 FLAG ERROR 02500CSR GOTO END75 ÐÐ02510C*-------------------------------------------------------------------- 02520CSR T75B TAG 02530C* MOVE DATA 02540CSR Z-ADD1 W 02550CSR ' ' LOKUPA4,W 77 02560CSR 77 MOVEAA4,W W4A INPUT DATA 02570C*-------------------------------------------------------------------- 02580CSR END75 ENDSR 02590C********************************************************************** 02600CSR SR89 BEGSR 02610C* GET MESSAGE MASTER 02620CSR M CHAINMGFILE 54 02630CSR 54 MOVE BLK35 MGTEXT 02640CSR 54 MOVELM MGTEXT 02650CSR 54 MOVE MES,1 MGTEXT 02660CSR ENDSR 02670C****************************************************************** 02680CSR SR97 BEGSR 02690C* UPDATE CRTFILE. 02700CSR SETON 97 02710CSR EXCPT UPDATE CRTFILE 02720CSR SETOF 97 02730CSR ENDSR 02740C*********************************************************************** 02750CSR SR101 BEGSR ÐÐ02760C* 1-TIME INITIALIZE 02770CSR MOVE BIT,1 NUL 02780CSR MOVE BIT,1 A6 02790CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 02800CSR MOVE ' ' BLK4 4 02810C* GET PORT # AND CRTFILE 02820CSR MOVE ' ' W8A 8 02830CSR Z-ADD0 W2N 20 02840CSR Z-ADD0 W1N 10 02850CSR MOVE ' ' W2A 2 02860CSR EXITFPGMINX GET PORT # 02870CSR RLABL W8A 02880CSR RLABL W2N 02890CSR RLABL W1N 02900CSR RLABL W2A 02910CSR MOVE W2A PORT 20 PORT NO. 02920CSR PORT COMP 0 54 02930CSRN54 Z-ADD25 PORT DEFAULT 02940CSR PORT CHAINCRTFILE H9 02950C* DEFINE WORK FIELDS,ETC. 02960CSR MOVE ' ' BLK35 35 02970CSR Z-ADD0 ZERO5 50 02980CSR ENDSR 02990C********************************************************************** 03000CSR SR102 BEGSR ÐÐ03010C* VALIDATE FIELD NO. 03020CSR F COMP 0 54 03030CSRN54 Z-ADD1 F 03040CSR F COMP FLIMIT 55 03050CSR 55 Z-ADD1 F 03060CSR ENDSR 03070C******************************************************************** 03080CSR SR103 BEGSR 03090C* MOVE INPUT DATA 03100CSR EXSR SR201 IDENTIFY-F 03110CSR EXSR SR202 R. JUSTIFY 03120CSR 01 MOVE W4A TRRN 40 03130CSR MOVE ' ' DUN,F EDIT FLAG 03140CSR ENDSR 03150C******************************************************************** 03160CSR SR104 BEGSR 03170C* EDIT INPUT DATA 03180CSR 96 MOVE ' ' DUN,F EDIT FLAG 03190CSRN96 MOVE 'X' DUN,F 03200CSR ENDSR 03210C*********************************************************************** 03220CSR SR105 BEGSR 03230C* FINAL EDIT 03240CSR SETON 79 FINAL EDIT FLAG 03250CSR Z-ADD1 F 96 ÐÐ03260C*-------------------------------------------------------------------- 03270CSR T105A TAG 03280CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03290CSRN54 GOTO END105 03300CSR EXSR SR201 IDENTIFY-F 03310CSR EXSR SR104 EDIT 03320CSRN96 GOTO T105A 03330C*-------------------------------------------------------------------- 03340CSR END105 TAG 03350CSR SETOF 79 03360CSR ENDSR 03370C******************************************************************** 03380CSR SR106 BEGSR 03390C* DISPLAY TRAN FILE. 03400CSR EXSR SR71 PUT HEADING. 03410C*------------------------------------------------------------------- 03420CSR T106A TAG 03430CSR TRRN COMP 0 54 03440CSRN54 Z-ADD1 TRRN 03450CSR TRRN CHAINBMBATCH 54 03460CSR 54 GOTO T106T END OF FILE. 03470CSR EXSR SR206 CLASSIFY TRAN. 03480CSR EXSR SR72 DISPLAY TRAN. 03490CSR Z-ADD1 M 50 03500C*-------------------------------------------------------------- ÐÐ03510CSR T106B TAG 03520CSR ZERO5 LOKUPERR,M 54 FIND ERR MSG# 03530CSRN54 GOTO T106C NO MORE ERRS 03540CSR ERR,M CHAINMGFILE 54 03550CSR 54 Z-ADD0 ERR,M 03560CSR 54 GOTO T106B ERR NOT ON FILE 03570CSR SETON 73 03580CSR EXCPT PUT MSG 03590CSR SETOF 73 03600CSR 1 ADD COUNT COUNT 03610CSR Z-ADD0 ERR,M 03620CSR GOTO T106B 03630C*------------------------------------------------------------- 03640CSR T106C TAG 03650CSR COUNT COMP 28 54 03660CSRN54 1 ADD TRRN TRRN 03670CSRN54 GOTO T106A 03680CSR EXITFQEPAGE END PAGE MSG. 03690CSR EXSR SR75 READ. 03700CSR 90 GOTO END106 ESCAPE. 03710CSR EXSR SR71 PUT HEADING. 03720CSRN77 1 ADD TRRN TRRN 03730CSRN77 GOTO T106A 03740CSR EXSR SR103 MOVE NEW RRN. 03750CSR GOTO T106A ÐÐ03760C*------------------------------------------------------------------- 03770CSR T106T TAG 03780C* END OF FILE. 03790CSR EXITFQEFILE 03800CSR MOVEL'Q023BM' PROG 03810CSR EXITFCHAIN 03820CSR RLABL PROG 03830CSR END106 ENDSR 03840C************************************************************************ 03850CSR SR201 BEGSR 03860C* IDENTIFY FIELD NO. 03870CSR F COMP 1 01 03880CSR ENDSR 03890C********************************************************************** 03900CSR SR202 BEGSR 03910C* RIGHT JUSTIFY 03920CSR F LOKUPNUM 54 03930CSRN54 GOTO END202 NOT NUMERIC FIELD 03940CSR Z-ADD4 W2N 20 03950CSR EXIT SUBRAJ R. JUSTIFY 03960CSR RLABL W2N 03970CSR RLABL W4A 03980CSR END202 ENDSR 03990C******************************************************************** 04000CSR SR206 BEGSR ÐÐ04010C* CLASSIFY TRAN. 04020CSR TTCODE COMP 'A' 60 ADD. 04030CSR TTCODE COMP 'C' 61 CHANGE. 04040CSR TTCODE COMP 'D' 62 DELETE ITEM. 04050CSR TTCODE COMP '#' 63 DELETE ASSY. 04060C* 04070CSR TSTAT COMP 'D' 64 COMPLETED. 04080CSR TSTAT COMP 'R' 65 REJECT 04090CSR TSTAT COMP 'W' 66 IN PROCESS 04100CSR SETOF 67 04110CSRN64N65N66 SETON 67 NOT YET PROCESSED 04120CSR ENDSR 04130O******************************************************************** 04140OTERM132 E 71 04150O 74 'BILL MATERIAL BATCH TRAN' 04160O 82 'SACTIONS' 04170O*------------------------------------------------------------------- 04180O E 71 04190O*------------------------------------------------------------------- 04200O E 71 04210O 93 'STARTING' 04220O 105 'ENDING' 04230O 70 'ROUTING' 04240O 54 'ISSUE' 04250O*------------------------------------------------------------------- ÐÐ04260O E 71 04270O 8 'ASSEMBLY' 04280O 23 'COMPONENT' 04290O 31 'ITEM' 04300O 41 'QTY-PER' 04310O 49 'SCRAP %' 04320O 54 'CODE' 04330O 59 'OPER' 04340O 65 'DEPT' 04350O 70 'W.C.' 04360O 80 'REF-INFO' 04370O 87 'ECN' 04380O 95 'CHG' 04390O 100 'ECN' 04400O 107 'CHG' 04410O 114 'TRANS' 04420O 124 'STATUS' 04430O 132 'REC#' 04440O*------------------------------------------------------------------- 04450O E 72 04460O* PUT DATA. 04470O TAPN 12 ' - - ' 04480O TCPN 26 ' - - ' 04490O TITNO Z 31 04500O TQTY 1 42 ÐÐ04510O TSCRP Z 46 04520O TISSU 53 04530O TOPER Z 58 04540O TDEPT Z 65 04550O TWC Z 70 04560O TREF 82 04570O TBECN 89 04580O TBCHG 95 04590O TEECN 102 04600O TECHG 107 04610O 60 117 'ADD ITEM' 04620O 61 117 'CHG ITEM' 04630O 62 117 'DEL ITEM' 04640O 63 117 'DEL ASSY' 04650O 64 127 'PROCESSED' 04660O 65 126 'REJECTED' 04670O 66 125 'IN-PROC' 04680O 67 126 'NOT-PROC' 04690O TRRN Z 132 04700O*------------------------------------------------------------------- 04710O E 73 04720O* PUT MSG. 04730O 96 5 '*****' 04740O N96 5 ' ' 04750O MGTEXT 40 ÐÐ** NUL ARRAY 004760 004770** A6 ARRAY 004780 004790** A4 ARRAY 004800 004810** NUM ARRAY 004820001 004830** DUN ARRAY 004840 004850** MES ARRAY 004860---MESSAGE NOT ON FILE--- 004870/* 004880_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¤`u ¤ÅX020EG P6â999999120282(èÈÐ00010H Q020EG00020F* ENGINEERING STD UPDATE. (X020EG) 00030F* LAST REVISED 8-02-82 4 45 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FEGCONT UC F 40R DISK 00070FEGMAST UC F 100R10AI 1 DISK A 00080FEGTEXT UC F 60R DISK 00090FEGMFRPN UC F 40R DISK 00100FEGMFR UC F 21R20AI 1 DISK A 00110FEGRRN UC F 6R DISK 00120FMGFILE IC F 80R DISK 00130FCRTFILE UC F 256R DISK 00140FTERM132 O F 132 5 00150F**************************************************************** 00160E NUL 1 132 1 NULL CHAR 00170E VF 1 15 10 SEE SR72 00180E A5 5 5 2 SEE SR72 00190E N5 5 5 2 0 SEE SR72 00200E DASH 44 44 1 00210E A46 46 46 1 A INPUT DATA ARRAY 00220E LOC 1 69 6 IDX 3 0 CRT XY / T & P INDEXES 00230E* LOC: XY START POSITION FOR FIELD # "F". 00240E* IDX: 1ST DIGIT = 1: F = TS OR MS ARRAY ELEMENT 00250E* 1ST DIGIT = 2: F = TXT OR MFR ARRAY ELEMENT ÐÐ00260E* 1ST DIGIT = 3: F = MPN ARRAY ELEMENT 00270E* DIGITS 2 & 3: P OR T INDEX FOR AR'S TS,TXT,MS,MFR,MPN00280E A9 9 9 1 EXITF QPREED PAR. 00290E NUM 1 1 2 0 NUMERIC FIELD NO.'S 00300E DUN 1 69 1 A EDIT CMPLT FLAG 00310E MES 1 1 30 00320E MFR 1 15 5 MFR CODES 00330E MPN 1 15 24 MFR PART NO'S 00340E MS 1 15 1 A MFR INPUT TRAN CODES 00350E TXT 1 10 45 TEXT DESCRIPTIONS 00360E TS 1 10 1 A TEXT INPUT TRAN CODES 00370E ESC 1 7 40 ESC CODE DEFINITIONS 00380E OMF 1 15 5 00390E LNK 1 7 6 A 00400E BIT 33 1 SCREEN CONTR. CHAR 00410E PAR 25 1 00420E TST 25 1 00430E CALL 7 6 00440E EGT 10 5 0A 00450E EGM 15 5 0A 00460I******************************************************************* 00470IBITPAR BT 00480I 1 33 BIT 00490I 34 58 PAR 00500I 59 83 TST ÐÐ00510I******************************************************************* 00520IEGCONT EC 00530I* LAST USED TEXT DELETE RRN 5N 00540I 1 50GTXDEL 00550I* LAST USED TEXT GET NEXT AVAIL RRN 5N 00560I 6 100LUTEXT 00570I* LAST TEXT RESTORE RRN 5N 00580I 11 150DELTXT 00590I* LAST USED MFR DELETE RRN 5N 00600I 16 200GMFDEL 00610I* LAST USED MFR GET NEXT AVAIL RRN 5N 00620I 21 250LUMFR 00630I* LAST USED MFR RESTORE RRN 5N 00640I 26 300DELMFR 00650I********************************************************************* 00660IMGFILE MG 00670I* MESSAGE FILE. 00680I 1 35 MGTEXT 00690I******************************************************************** 00700ICRTFILE CR 00710I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00720I* STD AREA - SAME FOR ALL PROGRAMS. 00730I* EMPLOYEE # 5N 00740I* 1 50CREMPL 00750I* USER CODE 8A ÐÐ00760I* 6 13 CRUSER 00770I* DEPT # 5N 00780I* 14 180CRDEPT 00790I* JOB NAME 8A (JOB LOADED BY MENU) 00800I* 19 26 CRJOB 00810I* TIME 6N 00820I 28 330CRTIME 00830I* DATE 4N 00840I 34 370CRDATE 00850I* RETURN STACK 7 X 6A 00860I 38 79 CALL 00870I******************************************************************** 00880IEGMAST EG 00890I* ENGR STD MASTER 00900I* PART NO. 10N 00910I 1 100EGPN 00920I* STANDARDS CODE 6A 00930I 11 16 EGSTD 00940I* INSPECTION CODE 5A 00950I 17 21 EGINSP 00960I* TEXT RRN'S 5P X 10 00970I P 22 51 EGT 00980I* PART NO. CROSS-REF RRN'S 5P X 15 00990I P 52 96 EGM 01000I* RECORD STATUS 1A ÐÐ01010I 100 100 EGSTAT 01020I**************************************************************** 01030IEGRRN ER 01040I* RRN CONTROL FILE 01050I* AVAIL TEXT RRN'S 5P 01060I P 1 30TXTRRN 01070I* AVAIL MFRPN RRN'S 5P 01080I P 4 60MFRRRN 01090I*********************************************************** 01100IEGTEXT ET 01110I* TEXT FILE 01120I* PART NO. 01130I 1 100ETPN 01140I* LINE NO. 2N 01150I 11 120ETLINE 01160I* TEXT 45A 01170I 13 57 ETTEXT 01180I* RECORD STATUS 1A 01190I 60 60 ETSTAT 01200I****************************************************************** 01210IEGMFRPN EP 01220I* ENG STD DYNAIR/MFR PART-NO CROSS REF. 01230I* MFR CODE 5A 01240I 1 5 EPMFR 01250I* MFR PART NO. 24A ÐÐ01260I 6 29 EPMPN 01270I* DYNAIR PART NO. 10N 01280I 30 39 EPPN 01290I* RECORD STATUS 1A 01300I 40 40 EPSTAT 01310I***************************************************************** 01320IEGMFR EM 01330I* MFR PART NO. POINTER 01340I* MFR CODE 5A 01350I 1 5 EMMFR 01360I* EGMFRPN RRN POINTER 5N 01370I* DYNAIR PART NO. 10N 01380I 6 150EMPN 01390I* EGMAST EGM ARRAY RRN 5N 01400I 16 200EMPTR 01410I* RECORD STATUS 1A 01420I 21 21 EMSTAT 01430C******************************************************************* 01440C* INITIALIZE 01450C EXSR SR101 1-TIME INIT 01460C MOVE ' ' BLK6 6 01470C*------------------------------------------------------------------ 01480C START TAG 01490C* SET-UP 1ST FIELD NO. 01500C MOVE 'X' DUN INIT EDIT ARRAY ÐÐ01510C MOVEA' ' DUN 01520C Z-ADD1 F 20 FIELD # 01530C MOVE ' ' TS 01540C MOVE ' ' MS 01550C Z-ADD0 EGT 01560C Z-ADD0 EGM 01570C MOVE ' ' OMF 01580C EXSR SR70 NEW PAGE 01590C GOTO READ 01600C*------------------------------------------------------------------ 01610C NEXT TAG 01620C* SET-UP NEXT FIELD NO. 01630C 1 ADD F F FIELD # 01640C*----------------------------------------------------------------- 01650C READ TAG 01660C* READ DATA FROM TERMINAL. 01670C SETOF 909677 01680C EXSR SR102 VALIDATE FIELD # 01690C 55 GOTO UPDATE DONE 01700C EXSR SR72 PROMPT 01710C EXSR SR75 READ TERMINAL 01720C 98 GOTO GOODBY GOODBY 01730C 94 GOTO MENU MENU REQUEST 01740C 90 EXSR SR72 DISPLAY INPUT DATA 01750C 93 GOTO NEWITM NEW ITEM ÐÐ01760C 92 GOTO JUMP FIELD JUMP REQST 01770C 89 F SUB 1 F SKIP BACKWARD 01780C 89 GOTO READ " " 01790C 88 SETOF 90 SPACE FILL 01800C 88 SETON 77 " " 01810C 86 GOTO UPDATE UPDATE 01820C 85 GOTO READ REPEAT 01830C 87 GOTO RESEQ RESEQ AR'S 01840C 96 GOTO ERROR ERROR 01850C N77 GOTO EDIT NO DATA INPUT 01860C*------------------------------------------------------------------ 01870C PROCES TAG 01880C* PROCESS INPUT DATA 01890C EXSR SR103 MOVE DATA 01900C*------------------------------------------------------------------- 01910C EDIT TAG 01920C N96 EXSR SR104 EDIT DATA 01930C EXSR SR72 REWRITE DATA 01940C 96 GOTO ERROR ERROR 01950C GOTO NEXT 01960C*--------------------------------------------------------------- 01970C RESEQ TAG 01980C EXSR SR402 RESEQ TEXT AR'S 01990C EXSR SR403 RESEQ MFR AR'S 02000C SETON 32 ÐÐ02010C EXSR SR71 REPUT AR DATA 02020C SETOF 32 02030C 96 GOTO ERROR 02040C GOTO READ 02050C*------------------------------------------------------------------ 02060C UPDATE TAG 02070C* UPDATE DATA BASE. 02080C EXSR SR105 FINAL EDIT 02090C 96 GOTO ERROR ERROR 02100C EXSR SR106 UPDATE 02110C 96 GOTO ERROR ERROR 02120C GOTO START 02130C*------------------------------------------------------------------- 02140C JUMP TAG 02150C* SET-UP JUMP TO REQUESTED FIELD 02160C 1 ADD W W 20 02170C W COMP 46 54 02180C 54 Z-ADD318 M 50 96 FLAG ERROR 02190C 54 GOTO ERROR BAD ESC 02200C MOVE ' ' W2A 2 02210C MOVEAA46,W W2A 02220C Z-ADD2 W2N 20 02230C EXIT SUBRAJ R. JUSTIFY 02240C RLABL W2N 02250C RLABL W2A ÐÐ02260C MOVE W2A F NEW FIELD # 02270C GOTO READ 02280C*-------------------------------------------------------------------- 02290C ERROR TAG 02300C EXSR SR102 VALIDATE FIELD # 02310C EXSR SR89 GET MSG 02320C EXSR SR73 PUT MSG 02330C GOTO READ 02340C*------------------------------------------------------------------ 02350C NEWITM TAG 02360C* SET-UP LINK FOR NEW ITEM 02370C MOVEL'Q020EG' PROG 8 02380C GOTO END 02390C*------------------------------------------------------------------- 02400C MENU TAG 02410C* SET-UP LINK TO MENU 02420C EXSR SR96 GET CRTFILE 02430C Z-ADD1 W 02440C BLK6 LOKUPLNK,W 54 02450C 54 MOVELLNK,W PROG 02460C GOTO END 02470C 54 MOVE BLK6 LNK,W 02480C N54 MOVEL'CONTU' PROG 8 02490C EXSR SR97 GET CRTFILE 02500C EXSR SR98 >>>>>>>>>>>>>>>>> ÐÐ02510C*-------------------------------------------------------------------- 02520C GOODBY TAG 02530C* LINK TO SIGN-OFF 02540C MOVEL'GOODBY' PROG 02550C GOTO END 02560C*------------------------------------------------------------------- 02570C END TAG 02580C EXSR SR96 GET CRTFILE 02590C EXSR SR97 UPD CRTFILE 02600C EXSR SR98 >>>>>>>>>>>>>>>>> 02610C*------------------------------------------------------------------- 02620C BADRRN TAG 02630C SETON H8 02640C*------------------------------------------------------------------- 02650C ENDJOB TAG 02660C MOVEL'ENDJOB 'PROG 02670C EXSR SR98 >>>>>>>>>>>>>>>>>>> 02680C********************************************************************* 02690CSR SR1 BEGSR 02700C* EDIT TRAN CODE 02710CSR EXSR SR203 CLASSIFY TRAN 02720CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02730CSR ENDSR 02740C******************************************************************* 02750CSR SR2 BEGSR ÐÐ02760C* EDIT PART NO. 02770CSR TPN COMP 0 54 02780CSRN54 Z-ADD299 M 96 FLAG ERROR 02790CSRN54 GOTO END2 02800CSR EXSR SR80 GET EGMAST 02810CSRN30N31 GOTO T2C GOT IT 02820C* NOT ON FILE CONDITION 02830CSR EXSR SR203 CLASSIFY TRAN 02840CSR Z-ADD0 EGT 02850CSR Z-ADD0 EGM 02860CSRN60 Z-ADD5 M 96 FLAG NOT ON FILE ERR 02870CSR 60 EXSR SR71 PUT SCREEN 02880CSR GOTO END2 02890C*------------------------------------------------------------------ 02900CSR T2C TAG 02910C* IS ON FILE C0NDITION 02920CSR 31 Z-ADD0 EGT 02930CSR 31 Z-ADD0 EGM 02940CSR EXSR SR203 CLASSIFY TRAN 02950CSR 60 Z-ADD4 M 96 FLAG DUPLICATE ERR 02960CSR EXSR SR250 GET TEXT RECORDS 02970CSR EXSR SR260 GET MFR CROSS-REF 02980CSR EXSR SR71 PUT DATA 02990CSR END2 ENDSR 03000C********************************************************************* ÐÐ03010CSR SR10 BEGSR 03020C* EDIT TEXT TRAN CODE 03030CSR TS,T COMP ' ' 54 03040CSRN54 GOTO END10 NO TRAN CODE 03050CSR MOVE TS,T W1A 1 03060CSR EXSR SR220 CLASSIFY TRAN CODE 03070CSRN40N41N42 03080CANN43 Z-ADD685 M 96 FLAG ERROR 03090CSR 96 GOTO END10 ERROR 03100CSR EGT,T COMP 0 55 03110CSRN40N43N55 Z-ADD5 M 96 FLAG NOT ON FILE 03120CSR 40 55 EXSR SR400 SPREAD TEXT,FLG ERR 03130CSR END10 ENDSR 03140C************************************************************* 03150CSR SR12 BEGSR 03160C* EDIT MFR TRAN CODE 03170CSR MS,P COMP ' ' 54 03180CSRN54 GOTO END12 NO TRAN CODE INPUT 03190CSR MOVE MS,P W1A 03200CSR EXSR SR220 CLASSIFY TRAN CODE 03210CSRN40N41N42 03220CANN43 Z-ADD685 M 96 FLAG ERROR 03230CSR 96 GOTO END12 ERROR 03240CSR EGM,P COMP 0 55 03250CSRN40N43N55 Z-ADD5 M 96 FLAG NOT ON FILE ÐÐ03260CSR 40 55 EXSR SR401 SPREAD TEXT,FLG ERR 03270CSR END12 ENDSR 03280C********************************************************************** 03290CSR SR30 BEGSR 03300C* GET NEXT AVAIL TEXT RRN. 03310CSR Z-ADD0 COUNT 30 03320C*--------------------------------------------------------------- 03330CSR T30C TAG 03340CSR 1 ADD COUNT COUNT 03350CSR COUNT COMP 3 54 03360CSR 54 Z-ADD0 COUNT 03370CSR 54 GOTO T30G 03380CSR GTXDEL CHAINEGRRN 54 03390CSR 54 GOTO T30E 03400CSR TXTRRN COMP 0 54 03410CSR 54 GOTO T30M 03420C*--------------------------------------------------------------- 03430CSR T30E TAG 03440CSR GTXDEL SUB 1 GTXDEL 03450CSR GOTO T30C TRY AGAIN 03460C*------------------------------------------------------------------- 03470CSR T30G TAG 03480CSR 1 ADD COUNT COUNT 03490CSR COUNT COMP 100 54 03500CSR 54 GOTO BADRRN ÐÐ03510CSR LUTEXT CHAINEGRRN 54 GET EGRRN 03520CSR 54 GOTO T30K BAD CHAIN 03530CSR TXTRRN COMP 0 54 03540CSR 54 GOTO T30M GOT PTR 03550C*------------------------------------------------------------------- 03560CSR T30K TAG 03570CSR 1 ADD LUTEXT LUTEXT 03580CSR GOTO T30G TRY AGAIN 03590C*------------------------------------------------------------------- 03600CSR T30M TAG 03610CSR Z-ADDTXTRRN NXTTXT 50 NEXT AVAIL 03620CSR Z-ADD0 TXTRRN 03630CSR EXSR SR38 UPDATE EGRRN 03640CSR ENDSR 03650C******************************************************************** 03660CSR SR31 BEGSR 03670C* RESTORE TEXT RRN. 03680CSR Z-ADD1 COUNT 03690C*------------------------------------------------------------------- 03700CSR T31C TAG 03710CSR DELTXT CHAINEGRRN 54 GET EGRRN 03720CSR 54 GOTO T31E BAD CHAIN 03730CSR TXTRRN COMP 0 54 03740CSR 54 GOTO T31E PTR EXISTS 03750CSR Z-ADDEGT,T TXTRRN ÐÐ03760CSR Z-ADD0 EGT,T 03770CSR EXSR SR38 UPD EGRRN 03780CSR GOTO END31 03790C*------------------------------------------------------------------- 03800CSR T31E TAG 03810CSR 1 ADD COUNT COUNT 03820CSR COUNT COMP 100 54 03830CSR 54 GOTO BADRRN 03840CSR DELTXT SUB 1 DELTXT 03850CSR GOTO T31C 03860CSR END31 ENDSR 03870C******************************************************************** 03880CSR SR32 BEGSR 03890C* GET NEXT AVAIL MFR RRN. 03900CSR Z-ADD0 COUNT 30 03910C*------------------------------------------------------------------- 03920CSR T32C TAG 03930CSR 1 ADD COUNT COUNT 03940CSR COUNT COMP 3 54 03950CSR 54 Z-ADD0 COUNT 03960CSR 54 GOTO T32G 03970CSR GMFDEL CHAINEGRRN 54 GET EGRRN 03980CSR 54 GOTO T32E BAD CHAIN 03990CSR MFRRRN COMP 0 54 04000CSR 54 GOTO T32M HAVE PTR ÐÐ04010C*------------------------------------------------------------------- 04020CSR T32E TAG 04030CSR GMFDEL SUB 1 GMFDEL 04040CSR GOTO T32C 04050C*------------------------------------------------------------------- 04060CSR T32G TAG 04070CSR 1 ADD COUNT COUNT 04080CSR COUNT COMP 100 54 04090CSR 54 GOTO BADRRN 04100CSR LUMFR CHAINEGRRN 54 04110CSR 54 GOTO T32K 04120CSR MFRRRN COMP 0 54 04130CSR 54 GOTO T32M 04140C*------------------------------------------------------------------- 04150CSR T32K TAG 04160CSR 1 ADD LUMFR LUMFR 04170CSR GOTO T32G 04180C*------------------------------------------------------------------- 04190CSR T32M TAG 04200CSR Z-ADDMFRRRN NXTMFR 50 04210CSR Z-ADD0 MFRRRN 04220CSR EXSR SR38 04230CSR ENDSR 04240C******************************************************************** 04250CSR SR33 BEGSR ÐÐ04260C* RESTORE MFR RRN 04270CSR Z-ADD1 COUNT 04280C*------------------------------------------------------------------- 04290CSR T33C TAG 04300CSR DELMFR CHAINEGRRN 54 04310CSR 54 GOTO T33E 04320CSR MFRRRN COMP 0 54 04330CSR 54 GOTO T33E 04340CSR Z-ADDEGM,P MFRRRN 04350CSR Z-ADD0 EGM,P 04360CSR EXSR SR38 04370CSR GOTO END33 04380C*------------------------------------------------------------------- 04390CSR T33E TAG 04400CSR 1 ADD COUNT COUNT 04410CSR COUNT COMP 100 54 04420CSR 54 GOTO BADRRN 04430CSR DELMFR SUB 1 DELMFR 04440CSR GOTO T33C 04450CSR END33 ENDSR 04460C***************************************************************** 04470CSR SR38 BEGSR 04480C* REWRITE EGRRN FILE 04490CSR SETON 38 04500CSR EXCPT UPDATE EGRRN ÐÐ04510CSR SETOF 38 04520CSR ENDSR 04530C**************************************************************** 04540CSR SR68 BEGSR 04550CSR EXITFQCLF LINE FEED 04560CSR ENDSR 04570C**************************************************************** 04580CSR SR69 BEGSR 04590CSR EXITFQXYPOS MOVE CURSOR 04600CSR RLABL W6A 04610CSR ENDSR 04620C***************************************************************** 04630CSR SR70 BEGSR 04640C* CLEAR TERM SCREEN. PUT TOP PAGE HEADINGS 04650CSR EXITFZCPAGE CLEAR SCREEN 04660CSR SETON 70 04670CSR EXCPT TOP PAGE HDG 04680CSR SETOF 70 04690CSR ENDSR 04700C********************************************************************** 04710CSR SR71 BEGSR 04720C* PUT HEADINGS TO TERMINAL 04730CSRN32 SETON 71 04740CSRN32 EXCPT PUT HDG, 1ST HALF 04750CSR SETOF 71 ÐÐ04760CSR Z-ADDF SAVEF 20 04770CSR Z-ADD6 F 04780C*---------------------------------------------------------------- 04790CSR T71A TAG 04800CSR EXSR SR72 PUT DATA FIELDS 04810CSRN50 2 ADD F F 04820CSR 50 3 ADD F F 04830CSR F COMP 26 54 04840CSR 54 Z-ADD57 F 04850CSRN52 GOTO T71A 04860C*---------------------------------------------------------------- 04870CSR T71B TAG 04880CSRN32 SETON 74 04890CSRN32 EXCPT PUT HDG, 2ND HALF 04900CSR SETOF 74 04910CSR Z-ADDSAVEF F RESTORE ORIG F VALUE 04920CSR EXSR SR201 IDENTIFY-F 04930CSR ENDSR 04940C********************************************************************* 04950CSR SR72 BEGSR 04960C* PUT DATA TO TERMINAL 04970CSR EXSR SR201 IDENTIFY-F 04980CSR 51 MOVEAVF,P A5 04990CSR 51 MOVE A5 N5 DISPLAY FIELD #'S 05000CSR 51N53 EGT,T COMP 0 55 ÐÐ05010CSR 51 EGM,P COMP 0 56 05020CSR 51N53N55TS,T COMP ' ' 55 05030CSR 51N56 MS,P COMP ' ' 56 05040CSR SETON 72 05050CSR EXCPT PUT DATA 05060CSR SETOF 72 05070CSR ENDSR 05080C*********************************************************************** 05090CSR SR73 BEGSR 05100C* PUT ERROR MESSAGE TO TERMINAL 05110CSR SETON 73 05120CSR EXCPT PUT MSG 05130CSR SETOF 73 05131CSR Z-ADDM ERRFLG 50 05140CSR ENDSR 05150C******************************************************************* 05160CSR SR75 BEGSR 05170C* READ FROM TERMINAL 05180CSR SETOF 779096 05190CSR SETOF 9392 05200CSR SETOF 8988 05210CSR SETOF 858687 05220CSR 01 MOVE BIT,2 BUFLGT 2 TRAN CODE 05230CSR 02 MOVE BIT,6 BUFLGT PART NO. 05240CSR 03 MOVE BIT,4 BUFLGT STD CODE ÐÐ05250CSR 04 MOVE BIT,4 BUFLGT INSPECT CODE 05260CSR 51 44 MOVE BIT,3 BUFLGT ACTION CODE 05270CSR 51N53 45 MOVE BIT,24 BUFLGT TEXT DATA 05280CSR 50 45 MOVE BIT,4 BUFLGT MFR CODE 05290CSR 50 46 MOVE BIT,13 BUFLGT MFR PN 05300CSR MOVE BLK46 W46A 46 BUFFER 05310CSR MOVE BIT,28 A9,1 05320CSR MOVE '8' A9,2 05330CSR MOVEALOC,F A9,3 05340CSR MOVE BIT,8 A9,9 05350CSR MOVEAA9 W9A 9 05360CSR EXITFQPREED READ FROM TERMINAL 05370CSR RLABL W9A STARTING POSITION 05380CSR RLABL W46A READ BUFFER 05390CSR RLABL BUFLGT READ BUFFER LGTH 05400CSR MOVEAW46A A46 INPUT DATA ARRAY 05410CSR MOVE BLK46 W46A INIT INPUT ARRAY 05420CSR Z-ADD1 W 20 05430CSR '\' LOKUPA46,W 90 FLAG ESC 05440CSRN90 GOTO T75B NOT ESC 05450CSR 1 ADD W W 05460CSR W COMP 46 54 05470CSR 54 GOTO T75A BAD ESC 05480CSR A46,W COMP 'G' 98 GOODBY 05490CSR A46,W COMP 'E' 94 MENU ÐÐ05500CSR A46,W COMP 'N' 93 NEW ITEM 05510CSR A46,W COMP 'J' 92 JUMP 05520CSR A46,W COMP 'B' 89 SKIP BKWRD 05530CSR A46,W COMP 'S' 88 SPACE FILL 05540CSR A46,W COMP 'U' 86 UPDATE 05550CSR A46,W COMP 'R' 85 REPEAT 05560CSR A46,W COMP 'M' 87 RESEQ AR'S 05570CSR 98 05580COR 94 05590COR 93 05600COR 92 05610COR 89 05620COR 88 05630COR 87 05640COR 86 05650COR 85 GOTO END75 GOOD ESC 05660C*------------------------------------------------------------------ 05670CSR T75A TAG 05680C* FLAG BAD ESC INPUT 05690CSR Z-ADD318 M 96 FLAG ERROR 05700CSR GOTO EXIT75 05710C*-------------------------------------------------------------------- 05720CSR T75B TAG 05730C* MOVE DATA 05740CSR Z-ADD1 W ÐÐ05750CSR ' ' LOKUPA46,W 77 05760CSR 77 MOVEAA46,W W46A INPUT DATA 05770C*-------------------------------------------------------------------- 05780CSR END75 TAG 05790C* INIT PREV ERROR MSG. 05791CSR ERRFLG COMP 0 75 05810CSR 75 EXCPT INIT ERROR MSG 05820CSR SETOF 75 05830CSR EXIT75 ENDSR 05840C****************************************************************** 05850CSR SR78 BEGSR 05860C* UPDATE EGTEXT FILE 05870CSR SETON 78 05880CSR EXCPT UPDATE EGTEXT 05890CSR SETOF 78 05900CSR ENDSR 05910C********************************************************************** 05920CSR SR80 BEGSR 05930C* GET MASTER RECORD 05940CSR SETOF 31 05950CSR TPN CHAINEGMAST 30 GET MASTER 05960CSRN30 EGSTAT COMP 'D' 31 FLAG DELETE 05970CSR ENDSR 05980C********************************************************************** 05990CSR SR81 BEGSR ÐÐ06000C* ADD NEW MASTER TO FILE 06010CSR SETON 81 06020CSR EXCPT ADD EGMAST 06030CSR SETOF 81 06040CSR ENDSR 06050C*********************************************************************** 06060CSR SR82 BEGSR 06070C* REWRITE MASTER 06080CSR SETON 82 06090CSR EXCPT REWRITE EGMAST 06100CSR SETOF 82 06110CSR ENDSR 06120C************************************************************* 06130CSR SR83 BEGSR 06140C* UPDATE PART NO. CROSS REF EGMFR AND EGMFRPN. 06150CSR SETON 83 06160CSR EXCPT EGMFRPN 06170CSR SETOF 83 06180CSR MOVE MS,P W1A 06190CSR EXSR SR220 CLASSIFY ACTION CODE 06200CSR 40 GOTO T83C 06210CSR OMF,P COMP MFR,P 54 06220CSR 54 GOTO T83C 06230CSR MOVE OMF,P W5A 5 06240CSR MOVE 'D' W1A 1 ÐÐ06250CSR SETON 47 06260CSR EXSR SR84 DELETE EGMFR 06270CSR SETOF 47 06280C*------------------------------------------------------------------- 06290CSR T83C TAG 06300CSR MOVE EPSTAT W1A 06310CSR MOVE MFR,P W5A 06320CSR EXSR SR84 UPDATE EGMFR 06330CSR ENDSR 06340C******************************************************************** 06350CSR SR84 BEGSR 06360C* UPDATE EGMFR FILE. 06370CSR MOVELW5A W20A 20 06380CSR MOVELTPN W15A 15 06390CSR MOVE EGM,P W15A 06400CSR MOVE W15A W20A 06410CSR EXSR SR87 GET EGMFR 06420CSR 47 60 06430COR 42 60 06440COR 43 60 GOTO END84 06450CSR SETON 84 06460CSR EXCPT UPDATE EGMFR 06470CSR SETOF 84 06480CSR END84 ENDSR 06490C*************************************************************** ÐÐ06500CSR SR85 BEGSR 06510C* GET TEXT FILE 06520CSR RRN CHAINEGTEXT 60 GET EGTEXT 06530CSR ENDSR 06540C**************************************************************** 06550CSR SR86 BEGSR 06560C* GET PART NO. CROSS REF FILE 06570CSR RRN CHAINEGMFRPN 60 GET EGMFRPN FILE 06580CSR ENDSR 06590C************************************************************ 06600CSR SR87 BEGSR 06610C* GET MFR PTR FILE 06620CSR W20A CHAINEGMFR 60 GET EGMFR FILE 06630CSR ENDSR 06640C*************************************************************** 06650CSR SR89 BEGSR 06660C* GET MESSAGE MASTER 06670CSR M CHAINMGFILE 54 06680CSR 54 MOVE BLK35 MGTEXT 06690CSR 54 MOVELM MGTEXT 06700CSR 54 MOVE MES,1 MGTEXT 06710CSR ENDSR 06720C*************************************************************** 06730CSR SR96 BEGSR 06740CSR # CHAINCRTFILE H9 ÐÐ06750CSR H9 GOTO ENDJOB 06760CSR ENDSR 06770C***************************************************************** 06780CSR SR97 BEGSR 06790CSR TIME CRTIME 06800CSR MOVELUDATE CRDATE 06810CSR SETON 97 06820CSR EXCPT UPDATE CRTFILE 06830CSR SETOF 97 06840CSR ENDSR 06850C****************************************************************** 06860CSR SR98 BEGSR 06870CSR EXSR SR70 CLEAR CRT 06880CSR SETON 80 06890CSR EXCPT UPDATE EGCONT 06900CSR SETOF 80 06910CSR EXITFCHAIN 06920CSR RLABL PROG 06930CSR ENDSR 06940C****************************************************************** 06950CSR SR101 BEGSR 06960C* 1-TIME INITIALIZE 06970CSR MOVE BIT,1 NUL 06980CSR MOVEANUL NUL8 8 06990CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH ÐÐ07000CSR Z-ADD69 FLIMIT 20 TOTAL NUMB FIELDS 07010CSR Z-ADD1 W5N 50 07020CSR W5N CHAINEGCONT H5 07030CSR H5 GOTO ENDJOB 07040CSR SETON 99 GOT EGCONT FLAG 07050CSR MOVE ' ' BLK46 46 07060C* GET PORT # AND CRTFILE 07070CSR MOVE ' ' W2A 2 07080CSR EXITFZGMINX GET PORT # 07090CSR RLABL W2A 07100CSR MOVE W2A # 20 PORT NO. 07110CSR # COMP 0 54 07120CSRN54 Z-ADD25 # DEFAULT 07130CSR EXSR SR96 GET CRTFILE 07140CSR MOVE CALL LNK 07150CSR MOVE 'Q020EG 'PROG 07160CSR TST,# COMP 'S' 54 07170CSR 54 MOVE 'SHUTDOWN'PROG 07180CSR EXSR SR97 REWRITE CRTFILE 07190CSR 54 EXSR SR98 >>>>>>>>>>>>>>>>> 07191CSR MOVE ' 'PROG 07200C* DEFINE WORK FIELDS,ETC. 07210CSR MOVE ' ' BLK35 35 07220CSR Z-ADD0 ZERO5 50 07230CSR MOVE ' ' BLK45 45 ÐÐ07240CSR MOVE ' ' BLK24 24 07250CSR MOVE ' ' W6A 6 07260CSR ENDSR 07270C********************************************************************** 07280CSR SR102 BEGSR 07290C* VALIDATE FIELD NO. 07300CSR DUN,2 COMP ' ' 54 07310CSRN54 Z-ADD2 F 07320CSR DUN,1 COMP ' ' 54 07330CSRN54 Z-ADD1 F 07340CSR F COMP 0 54 07350CSRN54 Z-ADD1 F 07360CSR F COMP FLIMIT 55 07370CSR 55 Z-ADD1 F 07380CSR ENDSR 07390C******************************************************************** 07400CSR SR103 BEGSR 07410C* MOVE INPUT DATA 07420CSR EXSR SR201 IDENTIFY-F 07430CSR 02 EXSR SR202 R. JUSTIFY PART # 07440CSR F COMP 4 54 07450CSR 54 GOTO T103A NOT EGMAST FIELD 07460CSR 01 MOVELW46A TRAN 1 TRAN CODE 07470CSR 02 MOVE W15A TPN 100 PART NO. 07480CSR 03 MOVELW46A EGSTD STD CODE ÐÐ07490CSR 04 MOVELW46A EGINSP INSPECTION CODE 07500CSR GOTO END103 07510C*--------------------------------------------------------------- 07520CSR T103A TAG 07530C* MOVE TEXT DATA 07540CSR F COMP 24 54 07550CSR 54 GOTO T103B 07560CSR Z-ADDIDX,F T 20 07570CSR IDX,F COMP 200 54 54 07580CSRN54 MOVELW46A TS,T TEXT TRAN CODE 07590CSR 54 MOVELW46A TXT,T TEXT DATA 07600CSR GOTO END103 07610C*--------------------------------------------------------------------- 07620CSR T103B TAG 07630C* MOVE MFR CROSS REF DATA 07640CSR Z-ADDIDX,F P MFR INDEX 07650CSR MOVELIDX,F W1N 10 07660CSR W1N COMP 1 54 07670CSR W1N COMP 2 55 07680CSR W1N COMP 3 56 07690CSR 54 MOVELW46A MS,P MFR TRAN CODE 07700CSR 55 MOVELW46A MFR,P MFR CODE 07710CSR 56 MOVELW46A MPN,P MPN CODE 07720C*------------------------------------------------------------------- 07730CSR END103 TAG ÐÐ07740CSR MOVE ' ' DUN,F 07750CSR ENDSR 07760C******************************************************************** 07770CSR SR104 BEGSR 07780C* EDIT INPUT DATA 07790CSR EXSR SR201 IDENTIFY-F,P,T 07800CSR 01 EXSR SR1 07810CSR 02 EXSR SR2 07820CSR 51N50 44 EXSR SR10 EDIT TEXT TRAN 07830CSR 50 44 EXSR SR12 EDIT MFR TRAN 07840CSR 96 MOVE ' ' DUN,F FLAG NOT EDITED 07850CSRN96 MOVE 'X' DUN,F CLEAR EDIT FLAG 07860CSR ENDSR 07870C*********************************************************************** 07880CSR SR105 BEGSR 07890C* FINAL EDIT 07900CSR SETOF 77 07910CSR SETON 79 FINAL EDIT FLAG 07920CSR Z-ADD1 F 20 96 07930C*-------------------------------------------------------------------- 07940CSR T105A TAG 07950CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 07960CSRN54 GOTO END105 07970CSR EXSR SR104 EDIT 07980CSRN96 GOTO T105A ÐÐ07990C*----------------------------------------------------------------- 08000CSR END105 TAG 08010CSR SETOF 79 08020CSR ENDSR 08030C******************************************************************** 08040CSR SR106 BEGSR 08050C* UPDATE DATA BASE. 08060CSR EXSR SR203 CLASSIFY TRAN 08070CSR 60 ADD 08080COR 61 GOTO T106A CHANGE 08090CSR 62 GOTO T106E DELETE 08100CSR Z-ADD300 M 96 FLAG ERROR 08110CSR GOTO END106 08120C*------------------------------------------------------------- 08130CSR T106A TAG 08140C* PROCESS ADD OR CHANGE TRAN. 08150CSR EXSR SR230 UPDATE TEXT 08160CSR EXSR SR240 UPDATE MFR 08170CSR MOVE 'A' EGSTAT 08180CSR 30 EXSR SR81 ADD EGMAST 08190CSRN30 EXSR SR82 REWRITE EGMAST 08200CSR GOTO END106 08210C*--------------------------------------------------------------------- 08220CSR T106E TAG 08230C* PROCESS DELETE TRAN ÐÐ08240CSR Z-ADD1 T 08250CSR Z-ADD1 P 08260CSR EXSR SR353 DELETE ALL TEXT 08270CSR EXSR SR357 DELETE ALL MFR 08280CSR MOVE 'D' EGSTAT 08290CSRN30 EXSR SR82 DELETE EGMAST 08300CSR END106 ENDSR 08310C************************************************************************ 08320CSR SR201 BEGSR 08330C* IDENTIFY FIELD NO. 08340CSR SETOF 515053 08350CSR SETOF 444546 08360CSR F COMP 1 01 08370CSR F COMP 2 02 08380CSR F COMP 3 03 08390CSR F COMP 4 04 08400CSR F COMP FLIMIT 52 08410CSRN52 F COMP 54 53 08420CSRN52 F COMP 24 50 08430CSRN52 F COMP 4 51 08440CSR 51 MOVELIDX,F W1N 10 08450CSR 51 W1N COMP 1 44 08460CSR 51 W1N COMP 2 45 08470CSR 51 W1N COMP 3 46 08480CSRN51 Z-ADD1 T ÐÐ08490CSRN50 Z-ADD1 P 08500CSR 53 Z-ADD10 T 08510CSR 52 Z-ADD15 P 08520CSR 51N53 MOVE IDX,F T 08530CSR 51 MOVE IDX,F P 08540CSR ENDSR 08550C********************************************************************** 08560CSR SR202 BEGSR 08570C* RIGHT JUSTIFY 08580CSRN02 GOTO END202 NOT PART # 08590CSR Z-ADD15 W2N 20 08600CSR MOVELW46A W15A 15 08610CSR EXIT SUBRAJ R. JUSTIFY 08620CSR RLABL W2N 08630CSR RLABL W15A 08640CSR END202 ENDSR 08650C*********************************************************************** 08660CSR SR203 BEGSR 08670C* CLASSIFY TRAN CODE 08680CSR TRAN COMP 'A' 60 ADD 08690CSR TRAN COMP 'C' 61 CHANGE 08700CSR TRAN COMP 'D' 62 DELETE 08710CSR MOVE ' ' TRNNAM 6 08720CSR 60 MOVE 'ADD ' TRNNAM 08730CSR 61 MOVE 'CHANGE' TRNNAM ÐÐ08740CSR 62 MOVE 'DELETE' TRNNAM 08750CSR ENDSR 08760C******************************************************************* 08770CSR SR220 BEGSR 08780C* CLASSIFY TEXT/MFR TRAN CODE 08790CSR W1A COMP 'A' 40 ADD 08800CSR W1A COMP 'C' 41 CHANGE 08810CSR W1A COMP 'D' 42 DELETE ITEM 08820CSR W1A COMP '#' 43 DELETE ALL 08830CSR ENDSR 08840C****************************************************************** 08850CSR SR230 BEGSR 08860C* UPDATE TEXT RECORDS 08870CSR Z-ADD1 T 08880C*----------------------------------------------------------------- 08890CSR T230A TAG 08900CSR ' ' LOKUPTS,T 54 08910CSRN54 GOTO END230 08920CSR MOVE TS,T W1A 1 08930CSR EXSR SR220 CLASSIFY TRAN CODE 08940CSR 40 EXSR SR350 ADD TEXT 08950CSR 41 EXSR SR351 CHANGE TEXT 08960CSR 42 EXSR SR352 DELETE TEXT 08970CSR 43 EXSR SR353 DELETE ALL TEXT 08980CSR MOVE ' ' TS,T ÐÐ08990CSR GOTO T230A 09000CSR END230 ENDSR 09010C***************************************************************** 09020CSR SR240 BEGSR 09030C* UPDATE MFR ARRAYS 09040CSR Z-ADD1 P 09050C*------------------------------------------------------------- 09060CSR T240A TAG 09070CSR ' ' LOKUPMS,P 54 09080CSRN54 GOTO END240 09090CSR MOVE MS,P W1A 09100CSR EXSR SR220 CLASSIFY TRAN CODE 09110CSR 40 EXSR SR354 ADD MFR 09120CSR 41 EXSR SR355 CHANGE MFR 09130CSR 42 EXSR SR356 DELETE MFR 09140CSR 43 EXSR SR357 DELETE ALL MFR 09150CSR MOVE ' ' MS,P 09160CSR GOTO T240A 09170CSR END240 ENDSR 09180C****************************************************************** 09190CSR SR250 BEGSR 09200C* GET TEXT RECORDS - LOAD TEXT TXT SCREEN ARRAY 09210CSR Z-ADD1 T 20 09220CSR MOVE ' ' TS 09230C*------------------------------------------------------------------- ÐÐ09240CSR T250A TAG 09250CSR ZERO5 LOKUPEGT,T 54 GET TEXT RRN 09260CSRN54 GOTO END250 NO MORE PTRS 09270CSR Z-ADDEGT,T RRN 50 09280CSR EXSR SR85 GET EGTEXT FILE 09290CSR MOVE ETTEXT TXT,T TEXT 09300CSR 1 ADD T T 09310CSR T COMP 10 54 09320CSRN54 GOTO T250A 09330CSR END250 ENDSR 09340C********************************************************************* 09350CSR SR260 BEGSR 09360C* GET MFR CROSS REF FILES - LOAD TO SCREEN MFR,MPN ARRAYS 09370CSR Z-ADD1 P 20 09380CSR MOVE ' ' MS 09390C*-------------------------------------------------------------------- 09400CSR T260A TAG 09410CSR ZERO5 LOKUPEGM,P 54 GET EGMFRPN RRN 09420CSRN54 GOTO END260 09430CSR Z-ADDEGM,P RRN 09440CSR EXSR SR86 GET EGMFRPN FILE 09450CSR MOVE EPMFR MFR,P 09460CSR MOVE EPMPN MPN,P 09470CSR 1 ADD P P 09480CSR P COMP 15 54 ÐÐ09490CSRN54 GOTO T260A 09500C*------------------------------------------------------------------- 09510CSR END260 TAG 09520CSR MOVE MFR OMF SAVE MFR'S 09530CSR ENDSR 09540C******************************************************************* 09550CSR SR350 BEGSR 09560C* TEXT ADD SR. 09570CSR EXSR SR30 GET NEXT AVAIL RRN 09580CSR Z-ADDNXTTXT RRN 50 09590CSR Z-ADDNXTTXT EGT,T 09600CSR EXSR SR85 GET TEXT FILE 09610CSR MOVE TXT,T ETTEXT 09620CSR MOVE 'A' ETSTAT 09630CSR MOVE EGPN ETPN 09640CSR Z-ADDT ETLINE 09650CSR EXSR SR78 REWRITE EGTEXT 09660CSR END350 ENDSR 09670C******************************************************************* 09680CSR SR351 BEGSR 09690C* TEXT CHANGE SR. 09700CSR Z-ADDEGT,T RRN 54 09710CSR 54 GOTO T351A HAVE PTR 09720CSR EXSR SR30 GET NEXT AVAIL 09730CSR Z-ADDNXTTXT RRN ÐÐ09740CSR Z-ADDNXTTXT EGT,T 09750C*----------------------------------------------------------------- 09760CSR T351A TAG 09770CSR EXSR SR85 GET TEXT FILE 09780CSR Z-ADDEGPN ETPN 09790CSR Z-ADDT ETLINE 09800CSR MOVE TXT,T ETTEXT 09810CSR MOVE 'A' ETSTAT 09820CSR EXSR SR78 REWRITE EGTEXT 09830CSR END351 ENDSR 09840C****************************************************************** 09850CSR SR352 BEGSR 09860C* DELETE TEXT SR. 09870CSR Z-ADDEGT,T SAVPTR 50 09880CSR EXSR SR31 SALVAGE PTR 09890CSR Z-ADDSAVPTR RRN 54 09900CSRN54 GOTO END352 09910CSR EXSR SR85 GET EGTEXT FILE 09920CSR MOVE 'D' ETSTAT 09930CSR EXSR SR78 DELETE EGTEXT 09940CSR END352 ENDSR 09950C**************************************************************** 09960CSR SR353 BEGSR 09970C* DELETE ALL TEXT SR. 09980CSR Z-ADDT SAVET 20 SAVE CUR INDEX ÐÐ09990C*------------------------------------------------------------ 10000CSR T353A TAG 10010CSR EXSR SR352 DELETE TEXT 10020CSR ZERO5 LOKUPEGT,T 54 10030CSR 54 GOTO T353A GET NEXT TEXT 10040CSR Z-ADDSAVET T RESTORE INDEX 10050CSR ENDSR 10060C****************************************************************** 10070CSR SR354 BEGSR 10080C* ADD MFR SR. 10090CSR EXSR SR32 GET NEXT AVAIL RRN 10100CSR Z-ADDNXTMFR RRN 10110CSR Z-ADDNXTMFR EGM,P 10120CSR EXSR SR86 GET PART NO. FILE 10130CSR MOVE EGPN EPPN 10140CSR MOVE MFR,P EPMFR 10150CSR MOVE MPN,P EPMPN 10160CSR MOVE 'A' EPSTAT 10170CSR EXSR SR83 ADD NEW EGMFRPN 10180CSR END354 ENDSR 10190C***************************************************************** 10200CSR SR355 BEGSR 10210C* MFR CHANGE SR. 10220CSR Z-ADDEGM,P RRN 54 10230CSR 54 GOTO T355A HAVE PTR ÐÐ10240CSR EXSR SR32 GET NEXT AVAIL 10250CSR Z-ADDNXTMFR EGM,P 10260CSR Z-ADDNXTMFR RRN 10270C*--------------------------------------------------------------- 10280CSR T355A TAG 10290CSR EXSR SR86 GET EGMFRPN 10300CSR MOVE MFR,P EPMFR 10310CSR MOVE MPN,P EPMPN 10320CSR MOVE 'A' EPSTAT 10330CSR EXSR SR83 REWRITE EGMFRPN 10340CSR ENDSR 10350C****************************************************************** 10360CSR SR356 BEGSR 10370C* MFR DELETE SR. 10380CSR Z-ADDEGM,P SAVPTR 54 10390CSRN54 GOTO END356 NO PTR 10400CSR EXSR SR33 RESTORE PRT 10410CSR Z-ADDSAVPTR RRN 10420CSR EXSR SR86 GET EGMFRPN 10430CSR MOVE 'D' EPSTAT 10440CSR EXSR SR83 DELETE EGMFRPN 10450CSR END356 ENDSR 10460C******************************************************************* 10470CSR SR357 BEGSR 10480C* DELETE ALL MFR SR. ÐÐ10490CSR Z-ADDP SAVEP 20 10500C*----------------------------------------------------------- 10510CSR T357A TAG 10520CSR EXSR SR356 DELETE MFR 10530CSR ZERO5 LOKUPEGM,P 54 10540CSR 54 GOTO T357A 10550CSR Z-ADDSAVEP P 10560CSR ENDSR 10570C***************************************************************** 10580CSR SR400 BEGSR 10590C* SPREAD TEXT ARRAYS FOR INSERT 10600CSR SETOF 555657 10610CSR Z-ADDT A 20 10620C*------------------------------------------------------------- 10630CSR T400A TAG 10640CSR 1 ADD A A 10650CSR A COMP 10 54 10660CSR 54 GOTO T400Z 10670CSR Z-ADDA C 10680CSR EXSR SR503 SEE IF BLANK 10690CSR 54 GOTO T400A NOT BLANK 10700CSR Z-ADDA B 10710C*-------------------------------------------------------------- 10720CSR T400C TAG 10730CSR B SUB 1 B ÐÐ10740CSR B COMP T 57 10750CSR EXSR SR504 MOVE B'S TO A'S 10760CSR Z-ADDB C 10770CSR EXSR SR505 INIT B'S 10780CSR SETON 56 10790CSRN57 Z-ADDB A 10800CSRN57 GOTO T400C 10810C*-------------------------------------------------------------- 10820CSR T400Z TAG 10830CSR SETON 32 10840CSR 56 EXSR SR71 PUT SCREEN 10850CSR SETOF 32 10860CSRN57 Z-ADD684 M 96 FLAG ERROR 10870CSR ENDSR 10880C* 10890C******************************************************************* 10900CSR SR401 BEGSR 10910C* SPREAD MFR ARRAYS FOR INSERT 10920CSR SETOF 555657 10930CSR Z-ADDP A 10940C*--------------------------------------------------------------- 10950CSR T401A TAG 10960CSR 1 ADD A A 10970CSR A COMP 15 54 10980CSR 54 GOTO T401Z ÐÐ10990CSR Z-ADDA C 11000CSR EXSR SR500 SEE IF BLANK 11010CSR 54 GOTO T401A NOT BLANK 11020CSR Z-ADDA B 20 11030C*------------------------------------------------------------ 11040CSR T401C TAG 11050CSR B SUB 1 B 11060CSR B COMP P 57 11070CSR EXSR SR501 MOVE B TO A 11080CSR Z-ADDB C 11090CSR EXSR SR502 INIT B 11100CSR SETON 56 11110CSRN57 Z-ADDB A 11120CSRN57 GOTO T401C 11130C*--------------------------------------------------------------- 11140CSR T401Z TAG 11150CSR SETON 32 11160CSR 56 EXSR SR71 PUT SCREEN 11170CSR SETOF 32 11180CSRN57 Z-ADD684 M 96 FLAG NO ROOM ERROR 11190CSR ENDSR 11200C************************************************************** 11210CSR SR402 BEGSR 11220C* RESEQUENCE TEXT ARRAYS 11230CSR Z-ADD0 A 20 ÐÐ11240CSR SETOF 5657 11250C*-------------------------------------------------------------- 11260CSR T402A TAG 11270CSR 1 ADD A A 11280CSR A COMP 10 54 11290CSR 54 GOTO END402 11300CSR Z-ADDA C 11310CSR EXSR SR503 SEE IF EMPTY 11320CSR 54 GOTO T402A NOT EMPTY 11330CSR Z-ADDA B 20 11340C*----------------------------------------------------------- 11350CSR T402C TAG 11360CSR 1 ADD B B 11370CSR B COMP 10 54 11380CSR 54 GOTO END402 11390CSR Z-ADDB C 11400CSR EXSR SR503 SEE IF EMPTY 11410CSRN54 GOTO T402C IS EMPTY 11420CSR SETOF 55 11430CSR EXSR SR504 MOVE A TO B 11440CSR Z-ADDB C 11450CSR EXSR SR505 INIT B 11460CSR SETON 56 11470CSR GOTO T402A 11480CSR END402 ENDSR ÐÐ11490C************************************************************* 11500CSR SR403 BEGSR 11510C* RESEQUENCE MFR ARRAYS 11520CSR Z-ADD0 A 11530CSR SETOF 5657 11540CSR T403A TAG 11550CSR 1 ADD A A 11560CSR A COMP 15 54 11570CSR 54 GOTO END403 11580CSR Z-ADDA C 11590CSR EXSR SR500 SEE IF NON-BLANK 11600CSR 54 GOTO T403A NOT BLANK 11610CSR Z-ADDA B 11620C*--------------------------------------------------------------- 11630CSR T403E TAG 11640CSR 1 ADD B B 11650CSR B COMP 15 54 11660CSR 54 GOTO END403 11670CSR Z-ADDB C 20 11680CSR EXSR SR500 SEE IF NON-BLANK 11690CSRN54 GOTO T403E EMPTY 11700CSR SETOF 55 11710CSR EXSR SR501 MOVE B TO A 11720CSR SETON 56 11730CSR Z-ADDB C ÐÐ11740CSR EXSR SR502 INIT B'S 11750CSR GOTO T403A 11760CSR END403 ENDSR 11770C***************************************************************** 11780CSR SR500 BEGSR 11790C* SET 54 ON IF MFR ARRAYS NON-BLANK 11800CSR EGM,C COMP 0 54 11810CSRN54 MS,C COMP ' ' 54 11820CSRN54 MFR,C COMP ' ' 54 11830CSRN54 MPN,C COMP BLK24 54 11840CSR ENDSR 11850C***************************************************************** 11860CSR SR501 BEGSR 11870C* MOVE MFR INDEX B TO MFR INDEX A 11880CSRN57 MOVE MS,B MS,A 11890CSR MOVE MFR,B MFR,A 11900CSR MOVE OMF,B OMF,A 11910CSR MOVE MPN,B MPN,A 11920CSR Z-ADDEGM,B EGM,A 11930CSR ENDSR 11940C***************************************************************** 11950CSR SR502 BEGSR 11960C* INIT MFR ARRAY ELEMENT 11970CSRN57 MOVE ' ' MS,C 11980CSR MOVE ' ' MFR,C ÐÐ11990CSR MOVE BLK24 MPN,C 12000CSR MOVE ' ' OMF,B 12010CSR Z-ADD0 EGM,C 12020CSR ENDSR 12030C****************************************************************** 12040CSR SR503 BEGSR 12050C* SET 54 ON IF TEXT ARRAY ELEMENT NON-BLANK 12060CSR EGT,C COMP 0 54 12070CSRN54 TXT,C COMP BLK45 54 12080CSRN54 TS,C COMP ' ' 54 12090CSR ENDSR 12100C****************************************************************** 12110CSR SR504 BEGSR 12120C* MOVE TEXT ARRAY B-INDEX TO A-INDEX 12130CSRN57 MOVE TS,B TS,A 12140CSR MOVE TXT,B TXT,A 12150CSR Z-ADDEGT,B EGT,A 12160CSR ENDSR 12170C*************************************************************** 12180CSR SR505 BEGSR 12190C* INIT TEXT ARRAY ELEMENT 12200CSRN57 MOVE ' ' TS,C 12210CSR MOVE BLK45 TXT,C 12220CSR Z-ADD0 EGT,C 12230CSR ENDSR ÐÐ12240C* 12250C* 12260C* 12270C* 12280O************************************************************** 12290OTERM132 E 70 12300O OR 71 12310O BIT,28 1 12320O 8 '8091001' 12330O UDATE 16 ' - - ' 12340O 57 'E N G I N E E R I N G' 12350O 75 'S T A N D A R D' 12360O 85 'P A R T' 12370O 99 'N U M B E R' 12380O 111 'I N P U T' 12390O*----------------------------------------------------------------- 12400O E 70 12410O OR 71 12420O OR 72 01 12430O OR 72 02 12440O N72 NUL8 8 12450O 72 BIT,28 1 12460O 72 2 '8' 12470O 72 LOC,F 8 12480O 72 8 '001' ÐÐ12490O 31 '(1) TRAN CODE (A,C,D):' 12500O TRAN 33 12510O TRNNAM 41 12520O 68 '(2) DYNAIR PART NO. :' 12530O TPN 82 ' - - ' 12540O*---------------------------------------------------------------- 12550O E 70 12560O OR 71 12570O OR 72 03 12580O OR 72 04 12590O N72 NUL8 8 12600O 72 BIT,28 1 12610O 72 2 '8' 12620O 72 LOC,F 8 12630O 72 8 '001' 12640O 30 '(3) STANDARD CODE :' 12650O EGSTD 38 12660O 50 '(4)' 12670O 68 'INSPECTION CODE :' 12680O EGINSP 75 12690O*-------------------------------------------------------------- 12700O E 71 12710O 38 'D E S C R I P T I O N' 12720O 84 'M A N U F A C T U R E R ' 12730O 96 'C R O S S' ÐÐ12740O 98 '-' 12750O 116 'R E F E R E N C E' 12760O*---------------------------------------------------------------- 12770O E 71 12780O 9 'ACTION' 12790O DASH 58 12800O 69 'ACTION' 12810O 85 'MANUFACTURER' 12820O 103 'PART-NNUMBER' 12830O*---------------------------------------------------------------- 12840O E 71 12850O 1 ' ' 12860O*--------------------------------------------------------------- 12870O E 72 51 12880O BIT,28 1 12890O 2 '8' 12900O LOC,F 8 12910O 8 '001' 12920O N53 12 '( )' 12930O N53 N5,1 Z 11 12940O N53 TS,T 14 12950O N53N55 14 '*' 12960O N53 21 '( )' 12970O N53 N5,2 Z 20 12980O N53 TXT,T 68 ÐÐ12990O 74 '( )' 13000O N5,3 Z 73 13010O MS,P 77 13020O N56 77 '*' 13030O 85 '( )' 13040O N5,4 Z 84 13050O MFR,P 91 13060O 102 '( )' 13070O N5,5 Z 101 13080O MPN,P 127 13090O*------------------------------------------------------------------- 13100O E 73 13110O OR 74 13120O OR 75 13130O BIT,28 1 13140O 8 '8112001' 13150O 73 17 'E R R O R' 13160O 73 36 'M E S S A G E:' 13170O MGTEXT B 74 13180O BIT,8 132 13190O*----------------------------------------------------------------- 13200O E 74 13210O BIT,32 1 13220O 23 'ACTION CODES: A = ADD' 13230O 76 'ESCAPE CODES:' ÐÐ13240O ESC,1 121 13250O E 74 13260O 25 'C = CHANGE' 13270O ESC,2 120 13280O E 74 13290O 25 'D = DELETE' 13300O ESC,3 120 13310O E 74 13320O 29 '# = DELETE ALL' 13330O ESC,4 120 13340O E 74 13350O 27 '* = INACTIVE' 13360O ESC,5 120 13370O E 74 13380O 35 'BLANK = ACTIVE FILE RECO' 13390O 37 'RD' 13400O ESC,6 120 13410O E 74 13420O ESC,7 120 13430O BIT,31 128 13440O BIT,28 129 13450O 130 'K' 13460O BIT,28 131 13470O 132 'K' 13480O*---------------------------------------------------------------- ÐÐ13490O D H8 13500O 24 'JOB ABORTED-- PLEASE CON' 13510O 48 'TACT DATA PROCESSING ' 13520O********************************************************************* 13530OEGMAST EADD 81 13540O TPN 10 13550O EGSTD 16 13560O EGINSP 21 13570O EGT 51P 13580O EGM 96P 13590O 100 'A' 13600O*------------------------------------------------------------------- 13610O E 82 13620O EGSTD 16 13630O EGINSP 21 13640O EGT 51P 13650O EGM 96P 13660O EGSTAT 100 13670O******************************************************************* 13680OEGMFRPN E 83 13690O MFR,P 5 13700O MPN,P 29 13710O TPN 39 13720O EPSTAT 40 13730O******************************************************************** ÐÐ13740OEGMFR EADD 84 60 13750O W20A 20 13760O W1A 21 13770O*-------------------------------------------------------------------- 13780O E 84N60 13790O W1A 21 13800O***************************************************************** 13810OEGTEXT E 78 13820O* ETPN 10 13830O ETLINE 12 13840O ETTEXT 57 13850O ETSTAT 60 13860O***************************************************************** 13870OEGRRN E 38 13880O TXTRRN 3P 13890O MFRRRN 6P 13900O****************************************************************** 13910OEGCONT E 80 99 13920O GTXDEL 5 13930O LUTEXT 10 13940O DELTXT 15 13950O GMFDEL 20 13960O LUMFR 25 13970O DELMFR 30 13980O***************************************************************** ÐÐ13990OCRTFILE E 97 14000O PROG 26 14010O CRTIME 33 14020O CRDATE 37 14030O LNK 79 14040O*************************************************************** ** NUL ARRAY 014050 014060** VF ARRAY 140700506252627 1 140800708282930 2 140900910313233 3 141001112343536 4 141101314373839 5 141201516404142 6 141301718434445 7 141401920464748 8 141502122495051 9 141602324525354 10 141700000555657 11 141800000585960 12 141900000616263 13 142000000646566 14 142100000676869 15 14220** A5 ARRAY 14230ÐÐ 14240** N5 ARRAY 14250 14260** DASH ARRAY 14270<- - - - - - - - T E X T- - - - - - - - - -> 14280** A46 ARRAY 014290 014300** LOC ARRAY 14310092025 TRAN 1 14320092065 PART # 2 14330093025 STDS CODE 3 14340093065 INSP CODE 4 14350097006101 TS 1 5 14360097015201 TXT 1 6 14370098006102 TS 2 7 14380098015202 TXT 2 8 14390099006103 TS 3 9 14400099015203 TXT 3 10 14410100006104 TS 4 11 14420100015204 TXT 4 12 14430101006105 TS 5 13 14440101015205 TXT 5 14 14450102006106 TS 6 15 14460102015206 TXT 6 16 14470103006107 TS 7 17 14480ÐÐ103015207 TXT 7 18 14490104006108 TS 8 19 14500104015208 TXT 8 20 14510105006109 TS 9 21 14520105015209 TXT 9 22 14530106006110 TS 10 23 14540106015210 TXT 10 24 14550097070101 MS 1 25 14560097080201 MFR 1 26 14570097096301 MPN 1 27 14580098070102 MS 2 28 14590098080202 MFR 2 29 14600098096302 MPN 2 30 14610099070103 MS 3 31 14620099080203 MFR 3 32 14630099096303 MPN 3 33 14640100070104 MS 4 34 14650100080204 MFR 4 35 14660100096304 MPN 4 36 14670101070105 MS 5 37 14680101080205 MFR 5 38 14690101096305 MPN 5 39 14700102070106 MS 6 40 14710102080206 MFR 6 41 14720102096306 MPN 6 42 14730ÐÐ103070107 MS 7 43 14740103080207 MFR 7 44 14750103096307 MPN 7 45 14760104070108 MS 8 46 14770104080208 MFR 8 47 14780104096308 MPN 8 48 14790105070109 MS 9 49 14800105080209 MFR 9 50 14810105096309 MPN 9 51 14820106070110 MS 10 52 14830106080210 MFR 10 53 14840106096310 MPN 10 54 14850107070111 MS 11 55 14860107080211 MFR 11 56 14870107096311 MPN 11 57 14880108070112 MS 12 58 14890108080212 MFR 12 59 14900108096312 MPN 12 60 14910109070113 MS 13 61 14920109080213 MFR 13 62 14930109096313 MPN 13 63 14940110070114 MS 14 64 14950110080214 MFR 14 65 14960110096314 MPN 14 66 14970111070115 MS 15 67 14980ÐÐ111080215 MFR 15 68 14990111096315 MPN 15 69 15000** A9 ARRAY 15010 15020** NUM ARRAY 1503002 PART NO. 015040** DUN ARRAY 15050 015060** MES ARRAY 015070---MESSAGE NOT ON FILE--- 015080** MFR ARRAY 015090 15100** MPN ARRAY 15110 15120** MS ARRAY 15130 15140** TXT ARRAY 15150 15160** TS ARRAY 15170 15180** ESC ARRAY 15190\B = BACKWARD SKIP TO PREVIOUS FIELD 15200\E = EXIT TO MENU 15210\G = GOODBY (SIGN OFF) 15220\J = JUMP TO SPECIFIED FIELD 15230ÐÐ\N = NEW SCREEN 15240\M = RESEQUENCE (TEXT OR MFR ONLY) 15250\U = UPDATE (KEEP) 15260** OMF ARRAY 15270 15280** LNK ARRAY 15290 15300/* 15310_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(úc; úiX024BM P120282120282(èÈÐ00010H Q024BM00020F* PRINT BMBATCH FILE AS ENG CHANGE (X024BM) 00030F* REVISED 1-28-80 2:15 PM. 00040FMGFILE IC F 80R DISK 00050FBMBATCH IP F 98R I DISK 00060FBMADRT IR F 300 3 3IT EDISK 00070FPMMST IC F 576R12AI 1 DISK 00080FPRINT O F 132 OF PRINTER 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A6 6 6 1 CALL READ PARAM. 00120E A4 4 4 1 A INPUT DATA ARRAY 00130E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 1 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E BMADRT BMBATCH 00170E CALL 5 6 CALL STACK 00180E ERR 7 5 0A 00190E* 00200I******************************************************************* 00210IMGFILE MG 00220I* MESSAGE FILE. 00230I 1 35 MGTEXT 00240I******************************************************************** 00250IBMBATCH BH 01 98 CD ÐÐ00260I* BATCH BILL MATL TRANSACTIONS. 00270I 1 100TAPN 00280I 11 200TCPN 00290I 21 270TITNO 00300I P 28 310TQTY 00310I 34 352TSCRP 00320I 36 37 TISSU 00330I 38 39 TBCHG 00340I 40 41 TECHG 00350I 42 46 TBECN 00360I 47 51 TEECN 00370I 52 52 TDISP 00380I 53 54 TAECHG 00390I 55 560TLL 00400I P 58 600TOPER 00410I P 61 630TDEPT 00420I P 64 650TWC 00430I 66 75 TREF 00440I P 76 96 ERR 00450I 97 97 TTCODE 00460I 98 98 TSTAT 00470I GG 02 00480I******************************************************************** 00490IPMMST PM 00500I 48 76 PMDESC ÐÐ00510I 542 543 PMFABC 00520C******************************************************************** 00530C* INITIALIZE 00540C N69 EXSR SR101 1-TIME INIT 00550C* UPDATE DATA BASE. 00560C EXSR SR106 80 00570C L2 SETOF 81 00580C 01 SETON 8081 00590C 01 EXSR SR206 00600CL0 Z-ADD1 X 30 00610C*------------------------------------------------------------------- 00620CL0 START TAG 00630CL0 80 ZERO5 LOKUPERR,X 54 00640CL0 80N54 GOTO ENDL0 00650CL0 80 Z-ADDERR,X W5N 50 00660CL0 80 W5N CHAINMGFILE 54 00670CL0 80 Z-ADD0 W5N 00680CL0 80 54 GOTO START 00690CL0 80 EXSR SR89 00700CL0 80 SETON 73 00710CL0 80 EXCPT 00720CL0 80 SETOF 73 00730CL0 80 GOTO START 00740C*------------------------------------------------------------------- 00750CL0 ENDL0 TAG ÐÐ00760C******************************************************************** 00770CSR SR89 BEGSR 00780C* GET MESSAGE MASTER 00790CSR M CHAINMGFILE 54 00800CSR 54 MOVE BLK35 MGTEXT 00810CSR 54 MOVELM MGTEXT 00820CSR 54 MOVE MES,1 MGTEXT 00830CSR ENDSR 00840C*********************************************************************** 00850CSR SR101 BEGSR 00860C* 1-TIME INITIALIZE 00870CSR SETON 69 00880C* DEFINE WORK FIELDS,ETC. 00890CSR MOVE ' ' BLK35 35 00900CSR Z-ADD0 ZERO5 5 00910CSR MOVE ' ' BLK29 29 00920C* 00930C* 00940C* 00950CSR ENDSR 00960C******************************************************************** 00970CSR SR206 BEGSR 00980C* CLASSIFY TRAN. 00990CSR TTCODE COMP 'A' 60 ADD. 01000CSR TTCODE COMP 'C' 61 CHANGE. ÐÐ01010CSR TTCODE COMP 'D' 62 DELETE ITEM. 01020CSR TTCODE COMP '#' 63 DELETE ASSY. 01030C* 01040CSR TSTAT COMP 'D' 64 COMPLETED. 01050CSR ENDSR 01060O******************************************************************** 01070OPRINT H 2 1P 01080O OR OF 01090O 59 'ENGINEERING CHANGE' 01100O 66 'NOTICE' 01110O UDATE Y 8 01120O 119 'PAGE' 01130O PAGE Z 124 01140O*------------------------------------------------------------------- 01150O H 1 1P 01160O OR OF 01170O 63 'PARTS LIST CHANGES' 01180O*------------------------------------------------------------------- 01190O H 1 1P 01200O OR OF 01210O 18 'ASSEMBLY' 01220O 27 'DWG' 01230O 74 'QTY' 01240O 88 'COMPONENT' 01250O 124 'FAB' ÐÐ01260O*------------------------------------------------------------------- 01270O H 2 1P 01280O OR OF 01290O 4 'TRAN' 01300O 21 'PART-NUMBER' 01310O 27 'REV' 01320O 38 'ASSEMBLY-' 01330O 49 'DESCRIPTION' 01340O 66 'ITEM' 01350O 77 'PER-ASSY' 01360O 90 'PART-NUMBER' 01370O 102 'COMPONENT-' 01380O 112 'DESCRIPTION' 01390O 124 'CODE' 01400O*------------------------------------------------------------------- 01410O D 1 01 01420O 60 8 'ADD ' 01430O 61 8 'CHG ' 01440O 62 8 'DEL-ITEM' 01450O 63 8 'DEL-ASSY' 01460O TAPN 22 ' - - ' 01470O TAECHG 27 01480O ADESC 58 01490O TITNO Z 66 01500O TQTY 1 77 ÐÐ01510O TCPN 91 ' - - ' 01520O PMDESC 121 01530O PMFABC 124 01540O*------------------------------------------------------------------- 01550O EF 1 73 01560O MGTEXT 35 ** NUL ARRAY 001570 001580** A6 ARRAY 001590 001600** A4 ARRAY 001610 001620** NUM ARRAY 001630001 001640** DUN ARRAY 001650 001660** MES ARRAY 001670---MESSAGE NOT ON FILE--- 001680/* 001690_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Xc¥ XúX024GL P120282120282(èÈÐ00010H Q024GL00020F* PRINT ACCOUNT WHERE-USED - SINGLE LEVEL. (X024GL) 00030F* REVISED 7-29-81 10:10 AM. S Y S T E M P R I N T E R 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FCAMAST IC F 40R18AI 1 DISK 00070FGLWU ID F 19L18AI 1 DISK 00080FGLMAST IC F 165R 9AI 1 DISK 00090FPRINT O F 132 OF PRINTER 00100F**************************************************************** 00110E NUL 1 132 1 NULL CHAR 00120E A8 8 8 1 A INPUT DATA ARRAY 00130E NUM 1 6 3 0 NUMERIC FIELD NO.'S 00140E DUN 13 13 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E LEV 1 20 18 00170E BIT 256 1 SCREEN CONTR. CHAR 00180E GLA 12 11 2 00190I******************************************************************* 00200IBITHEX BT 00210I 1 256 BIT 00220I******************************************************************* 00230IMGFILE MG 00240I* MESSAGE FILE. 00250I 1 35 MGTEXT ÐÐ00260I******************************************************************** 00270IGLWU GW 00280I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00290I* KEY AREA. 00300I* SUB-ACCOUNT 9A 00310I 1 9 GWSUB 00320I* PARENT ACCOUNT 9A 00330I 10 18 GWPAR 00340I* RECORD STATUS 1A 00350I 19 19 GWSTAT 00360I******************************************************************** 00370IGLMAST GL 00380I* ACCOUNT MASTER. 00390I* KEY AREA 00400I* ACCOUNT # 9A 00410I 1 9 GLKEY 00420I 1 1 GLPRFX 00430I 2 60GLPRIM 00440I 7 90GLDASH 30 00450I* ACCOUNT GROUP 4A 00460I 14 17 GLGRUP 00470I* ACCOUNT DESCRIPTION 40A 00480I 18 57 GLDESC 00490I* BALANCE FORWARD AMOUNT 11.2P 00500I P 58 632GLBALF ÐÐ00510I* ACTUAL $ 11.2P X 12 00520I P 64 135 GLA 00530I* CURRENT MONTH-PLUS 11.2P 00540I P 136 1412GLCMP 00550I* CURRENT MONTH-MINUS 11.2P 00560I P 142 1472GLCMM 00570I* SOURCE CODE 1A 00580I* S = SUB-ACCOUNT ONLY, 00590I* MAY NOT BE PARENT 00600I 148 148 GLSC 00610I* BALANCE FORWARD CODE 2A 00620I* 1ST COL 00630I* 1 = ZERO BAL AT START NEW YR 00640I* 2 = CARRY PREV YR FRWD 00650I* 2ND COL 00660I* A = ZERO BAL AT START NEW MO 00670I* B = CARRY PREV MO FRWD 00680I 149 150 GLBFC 00690I* NUMB OF SUB-ACCOUNTS 5P 00700I P 157 1590GLNOSA 00710I* LOW LEVEL CODE 3N 00720I 160 1620GLLL 00730I* FILLER 00740I* RECORD STATUS 1A 00750I 165 165 GLSTAT ÐÐ00760I******************************************************************** 00770ICAMAST CA 00780I* CHART OF ACCOUNTS. 00790I* KEY AREA. 00800I* PARENT ACCOUNT 9A 00810I 1 9 CAPAR 00820I* SUB-ACCOUNT 9A 00830I 10 18 CASUB 00840I* OPERATOR 1A 00850I* S = SUBTRACT 00860I* A = ADD 00870I 25 25 CAOPER 00880I* EFFECTIVITY 00890I* START DATE 6N (YMD) 00900I 26 310CASDAT 00910I* END DATE 6N (YMD) 00920I 32 370CAEDAT 00930I* FILLER 00940I* RECORD STATUS 1A 00950I 40 40 CASTAT 00960C******************************************************************** 00970C* INITIALIZE 00980C EXSR SR101 1-TIME INIT 00990C*------------------------------------------------------------------ 01000C START TAG ÐÐ01010C* SET-UP 1ST FIELD NO. 01020C MOVE ' ' DUN INIT EDIT ARRAY 01030C Z-ADD1 F 30 FIELD # 01040C GOTO READ 01050C*------------------------------------------------------------------ 01060C NEXT TAG 01070C* SET-UP NEXT FIELD NO. 01080C 1 ADD F F FIELD # 01090C*----------------------------------------------------------------- 01100C READ TAG 01110C* READ DATA FROM TERMINAL. 01120C SETOF 9096 01130C EXSR SR102 VALIDATE FIELD # 01140C 55 GOTO UPDATE DONE 01150C EXSR SR201 IDENTIFY-F 01160C 01 GOTO NEXT 01170C 01 Z-ADD362 M 50 ENTER PREFIX 01180C 02 Z-ADD363 M ENTER PRIME 01190C 03 Z-ADD364 M ENTER DASH 01200C EXSR SR89 GET MSG. 01210C SETON 69 01220C EXSR SR73 PROMPT 01230C SETOF 69 01240C EXSR SR75 READ TERMINAL 01250C*---------------------------------------------------------- ÐÐ01260C ESCAPE TAG 01270C 98 GOTO GOODBY GOODBY 01280C 94 GOTO MENU MENU REQUEST 01290C N77N88 EXSR SR104 EDIT INPUT FIELD 01300C 93 GOTO NEWITM NEW ITEM 01310C 92 GOTO JUMP FIELD JUMP REQST 01320C 91 GOTO NEXT SKIP FORWARD 01330C 89 F SUB 1 F SKIP BACKWARD 01340C 89 EXSR SR201 01350C 89 01 Z-ADD2 F 01360C 89 GOTO READ " " 01370C 88 SETOF 90 SPACE FILL 01380C 88 SETON 77 " " 01390C 87 GOTO START 01400C 86 GOTO UPDATE UPDATE 01410C 85 GOTO READ REPEAT 01420C 96 GOTO ERROR ERROR 01430C*------------------------------------------------------------------ 01440C PROCES TAG 01450C* PROCESS INPUT DATA 01460C EXSR SR103 MOVE DATA 01470C N96 EXSR SR104 EDIT DATA 01480C 96 GOTO ERROR ERROR 01490C GOTO NEXT 01500C*------------------------------------------------------------------ ÐÐ01510C UPDATE TAG 01520C* UPDATE DATA BASE. 01530C EXSR SR105 FINAL EDIT 01540C 96 GOTO ERROR ERROR 01550C EXSR SR106 UPDATE 01560C 96 GOTO ERROR ERROR 01570C 90 GOTO ESCAPE 01580C GOTO START 01590C*------------------------------------------------------------------- 01600C JUMP TAG 01610C* SET-UP JUMP TO REQUESTED FIELD 01620C 1 ADD W W 30 01630C W COMP 8 54 01640C 54 Z-ADD318 M 50 96 FLAG ERROR 01650C 54 GOTO ERROR BAD ESC 01660C MOVE ' ' W3A 3 01670C MOVEAA8,W W3A 01680C Z-ADD3 W2N 20 01690C EXIT SUBRAJ R. JUSTIFY 01700C RLABL W2N 01710C RLABL W3A 01720C MOVE W3A F NEW FIELD # 01730C GOTO READ 01740C*-------------------------------------------------------------------- 01750C ERROR TAG ÐÐ01760C EXSR SR102 VALIDATE FIELD # 01770C EXSR SR89 GET MSG 01780C EXSR SR73 PUT MSG 01790C GOTO START 01800C*------------------------------------------------------------------ 01810C NEWITM TAG 01820C* SET-UP LINK FOR NEW ITEM 01830C GOTO START 01840C*------------------------------------------------------------------- 01850C MENU TAG 01860C* SET-UP LINK TO MENU 01870C MOVEL'QQGL02' PROG 8 01880C GOTO END 01890C*-------------------------------------------------------------------- 01900C GOODBY TAG 01910C* LINK TO SIGN-OFF 01920C MOVEL'GOODBY' PROG 01930C GOTO END 01940C*------------------------------------------------------------------- 01950C END TAG 01960C EXITFCHAIN LINK TO NEXT PROG 01970C RLABL PROG 01980C********************************************************************* 01990CSR SR3 BEGSR 02000C* EDIT INPUT ACCOUNT NO. ÐÐ02010CSR MOVE TKEY W9A 9 02020CSR EXSR SR80 GET GLMAST 02030C*R 60 *** Z-ADD302 M 96 FLAG ERROR 02040C*R 60 *** GOTO END3 02050CSR MOVE GLPRFX PAPRFX 1 02060CSR Z-ADDGLPRIM PAPRIM 50 02070CSR Z-ADDGLDASH PADASH 30 02080CSR MOVE GLDESC PADESC 40 02090CSR MOVE GLSC PASC 1 02100CSR END3 ENDSR 02110C***************************************************************** 02120CSR SR70 BEGSR 02130C* CLEAR TERM SCREEN. 02140CSR EXITFQTOPF CLEAR SCREEN 02150CSR ENDSR 02160C********************************************************************** 02170CSR SR71 BEGSR 02180C* PUT HEADINGS TO TERMINAL 02190CSR SETON 71 02200CSR EXCPT PUT HEADINGS 02210CSR SETOF 71 02220CSR Z-ADD8 LINENO 30 02230CSR ENDSR 02240C********************************************************************* 02250CSR SR72 BEGSR ÐÐ02260C* PUT DATA TO TERMINAL 02270CSR 1 ADD LINENO LINENO 30 02280CSR LINENO COMP 31 54 02290CSRN54 GOTO T72A NOT END PAGE 02300CSR EXITFQEPAGE 02310CSR EXSR SR75 READ 02320CSR 90 GOTO END72 ESC INPUT 02330CSR EXSR SR71 PUT HEADING 02340C*--------------------------------------------------------------- 02350CSR T72A TAG 02360CSR SETON 72 02370CSR EXCPT 02380CSR SETOF 72 02390CSR END72 ENDSR 02400C*********************************************************************** 02410CSR SR73 BEGSR 02420C* PUT ERROR MESSAGE TO TERMINAL 02430CSR SETON 73 02440CSR EXCPT PUT MSG 02450CSR SETOF 73 02460CSR Z-ADDM LSTERR 50 02470CSR ENDSR 02480C******************************************************************* 02490CSR SR75 BEGSR 02500C* READ FROM TERMINAL ÐÐ02510CSR SETOF 779096 02520CSR SETOF 939291 02530CSR SETOF 898887 02540CSR SETOF 8685 02550CSR MOVE BIT,5 BUFLGT 2 READ BUFFER LGTH 02560CSR MOVE BLK8 W8A 8 BUFFER 02570CSR EXITFQWREED READ FROM TERMINAL 02580CSR RLABL W8A READ BUFFER 02590CSR RLABL BUFLGT READ BUFFER LGTH 02600CSR MOVEAW8A A8 INPUT DATA ARRAY 02610CSR MOVE BLK8 W8A INIT INPUT ARRAY 02620CSR Z-ADD1 W 30 02630CSR '\' LOKUPA8,W 90 FLAG ESC 02640CSRN90 GOTO T75B NOT ESC 02650CSR 1 ADD W W 02660CSR W COMP 8 54 02670CSR 54 GOTO T75A BAD ESC 02680CSR A8,W COMP 'G' 98 GOODBY 02690CSR A8,W COMP 'E' 94 MENU 02700CSR A8,W COMP 'N' 93 NEW ITEM 02710CSR A8,W COMP 'J' 92 JUMP 02720CSR A8,W COMP 'F' 91 SKIP FRWRD 02730CSR A8,W COMP 'B' 89 SKIP BKWRD 02740CSR A8,W COMP 'S' 88 SPACE FILL 02750CSR A8,W COMP 'H' 87 HOME ÐÐ02760CSR A8,W COMP 'U' 86 UPDATE 02770CSR A8,W COMP 'R' 85 REPEAT 02780CSR 98 02790COR 94 02800COR 93 02810COR 92 02820COR 91 02830COR 89 02840COR 88 02850COR 87 02860COR 86 02870COR 85 GOTO END75 GOOD ESC 02880C*------------------------------------------------------------------ 02890CSR T75A TAG 02900C* FLAG BAD ESC INPUT 02910CSR Z-ADD318 M 96 FLAG ERROR 02920CSR GOTO END75 02930C*-------------------------------------------------------------------- 02940CSR T75B TAG 02950C* MOVE DATA 02960CSR Z-ADD1 W 02970CSR ' ' LOKUPA8,W 77 02980CSR 77 MOVEAA8,W W8A INPUT DATA 02990CSR END75 ENDSR 03000C********************************************************************** ÐÐ03010CSR SR80 BEGSR 03020C* GET MASTER RECORD 03030CSR W9A CHAINGLMAST 60 GET MASTER 03040CSRN60 GLSTAT COMP 'D' 60 FLAG DELETE 03050CSR ENDSR 03060C********************************************************************** 03070CSR SR89 BEGSR 03080C* GET MESSAGE MASTER 03090CSR M CHAINMGFILE 54 03100CSR 54 MOVE BLK35 MGTEXT 03110CSR 54 MOVELM MGTEXT 03120CSR 54 MOVE MES,1 MGTEXT 03130CSR ENDSR 03140C*********************************************************************** 03150CSR SR101 BEGSR 03160C* 1-TIME INITIALIZE 03170CSR MOVE BIT,1 NUL 03180CSR MOVEANUL NUL92 92 03190CSR EXSR SR70 CLEAR SCREEN. 03200CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03210CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS 03220CSR MOVE ' ' BLK8 8 03230C* DEFINE WORK FIELDS,ETC. 03240CSR MOVE ' ' BLK35 35 03250CSR MOVE ' ' BLK8 8 ÐÐ03260CSR ENDSR 03270C********************************************************************** 03280CSR SR102 BEGSR 03290C* VALIDATE FIELD NO. 03300CSR F COMP 0 54 03310CSRN54 Z-ADD1 F 03320CSR F COMP FLIMIT 55 03330CSR 55 Z-ADD1 F 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR103 BEGSR 03370C* MOVE INPUT DATA 03380CSR EXSR SR201 IDENTIFY-F 03390CSR EXSR SR202 R. JUSTIFY 03400CSR 01 MOVELW8A TPRFX 1 ACCOUNT PREFIX 03410CSR 02 MOVE W8A TPRIM 50 ACCOUNT PRIME 03420CSR 03 MOVE W8A TDASH 30 ACCOUNT DASH 03430CSR 03 MOVELTPRFX TKEY 9 03440CSR 03 MOVELTPRIM W8A 8 03450CSR 03 MOVE TDASH W8A 03460CSR 03 MOVE W8A TKEY 03470CSR MOVE ' ' DUN,F EDIT FLAG 03480CSR ENDSR 03490C******************************************************************** 03500CSR SR104 BEGSR ÐÐ03510C* EDIT INPUT DATA 03520CSR 03 EXSR SR3 EDIT INPUT. 03530CSR 96 MOVE ' ' DUN,F EDIT FLAG 03540CSRN96 MOVE 'X' DUN,F 03550CSR ENDSR 03560C*********************************************************************** 03570CSR SR105 BEGSR 03580C* FINAL EDIT 03590CSR SETON 79 FINAL EDIT FLAG 03600CSR Z-ADD1 F 96 03610C*-------------------------------------------------------------------- 03620CSR T105A TAG 03630CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03640CSRN54 GOTO END105 03650CSR EXSR SR201 IDENTIFY-F 03660CSR EXSR SR104 EDIT 03670CSRN96 GOTO T105A 03680C*-------------------------------------------------------------------- 03690CSR END105 TAG 03700CSR SETOF 79 03710CSR ENDSR 03720C******************************************************************** 03730CSR SR106 BEGSR 03740C* DISPLAY INDENTED CHART OF ACCOUNTS 03750CSR MOVELTKEY W18A 18 ÐÐ03760CSR W18A SETLLGLWU 03770CSR EXSR SR71 PUT HEADING 03780C*--------------------------------------------------------------- 03790CSR T106A TAG 03800CSR SETOF 54 03810CSR READ GLWU 54 03820CSR 54 GOTO T106P 03830CSR GWSUB COMP TKEY 54 03840CSRN54 GOTO T106P END OF STRUCTURE 03850CSR GWSTAT COMP 'D' 54 03860CSR 54 GOTO T106A DELETED 03870CSR MOVE GWPAR W9A 03880CSR EXSR SR80 GET GLMAST 03890CSR MOVELGWPAR W18A 03900CSR MOVE GWSUB W18A 03910CSR W18A CHAINCAMAST 54 03920CSR 54 GOTO T106A 03930CSR EXSR SR72 PUT DATA 03940CSRN90 GOTO T106A GET NEXT RECORD 03950CSR GOTO END106 03960C*-------------------------------------------------------------- 03970CSR T106P TAG 03980C* END ITEM MESSAGE 03990CSR EXITFQEITEM 04000CSR END106 ENDSR ÐÐ04010C************************************************************************ 04020CSR SR201 BEGSR 04030C* IDENTIFY FIELD NO. 04040CSR F COMP 1 01 04050CSR F COMP 2 02 04060CSR F COMP 3 03 04070CSR ENDSR 04080C********************************************************************** 04090CSR SR202 BEGSR 04100C* RIGHT JUSTIFY 04110CSR F LOKUPNUM 54 04120CSRN54 GOTO END202 NOT NUMERIC FIELD 04130CSR Z-ADD8 W2N 20 04140CSR EXIT SUBRAJ R. JUSTIFY 04150CSR RLABL W2N 04160CSR RLABL W8A 04170CSR END202 ENDSR 04180O******************************************************************** 04190OPRINT E 71 04200O* PUT HEADING - SUB-ACCOUNT. 04210O 72 'ACCOUNT WHERE-USED' 04220O*------------------------------------------------------------------- 04230O E 71 04240O 15 'SUB-ACCOUNT' 04250O 66 'TYPE' ÐÐ04260O*------------------------------------------------------------------- 04270O E 71 04280O* * * * 6 'PREFIX' 04290O 13 'PRIME' 04300O 20 'DASH' 04310O 35 '<--------------' 04320O 46 'DESCRIPTION' 04330O 60 '------------->' 04340O 66 'CODE' 04350O*------------------------------------------------------------------- 04360O E 71 04370O* PARENT ACCOUNT DATA. 04380O PAPRFX 4 04390O PAPRIMZ 14 04400O PADASHZ 19 04410O PADESC 60 04420O PASC 64 04430O*------------------------------------------------------------------- 04440O E 71 04450O* PUT HEADING - PARENT ACCOUNT. 04460O 24 'PARENT-ACCOUNT' 04470O 71 'TYPE' 04480O 77 'OPER' 04490O 94 'EFFECTIVITY' 04500O 118 'CURRENT MONTH' ÐÐ04510O*------------------------------------------------------------------- 04520O E 71 04530O* * * * 12 'PREFIX' 04540O 19 'PRIME' 04550O 25 'DASH' 04560O 40 '<--------------' 04570O 51 'DESCRIPTION' 04580O 65 '------------->' 04590O 71 'CODE' 04600O 77 'CODE' 04610O 87 'START' 04620O 95 'STOP' 04630O 112 'PLUS' 04640O 126 'MINUS' 04650O*------------------------------------------------------------------- 04660O E 72 04670O* SUB-ACCOUNT DATA. 04680O GLPRFX 10 04690O GLPRIMZ 20 04700O 30 21 '-' 04710O GLDASHZ 24 04720O GLDESC 65 04730O GLSC 69 04740O CAOPER 75 04750O CASDAT 87 ' - - ' ÐÐ04760O CAEDAT 97 ' - - ' 04770O GLCMP K 112 04780O GLCMM K 125 04790O*------------------------------------------------------------------- 04800O E 73 04810O* PUT MESSAGE. 04820O NUL92 132 04830O 96 5 '*****' 04840O N96 5 ' ' 04850O MGTEXT 40 04860O BIT,8 132 ** NUL ARRAY 004870 004880** A8 ARRAY 004890 004900** NUM ARRAY 004910002 PAR PRIME 004920003 PAR DASH 004930** DUN ARRAY 004940 004950** MES ARRAY 004960---MESSAGE NOT ON FILE--- 004970** LEV ARRAY 04980 04990/* 05000ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Šd  ŠX025BM P120282120282(èÈÐ00010H Q025BM00020F* PRINT (DIABLO) BMBATCH TRANSACTION FILE. (X025BM) 00030F* REVISED 5-07-80 4:00 PM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FBMBATCH IC F 98R DISK 00080F**************************************************************** 00090E A6 6 6 1 CALL READ PARAM. 00100E A4 4 4 1 A INPUT DATA ARRAY 00110E NUM 1 2 3 0 NUMERIC FIELD NO.'S 00120E DUN 1 2 1 A EDIT CMPLT FLAG 00130E MES 1 1 30 00140E BIT 256 1 SCREEN CONTR. CHAR 00150E REC 132 1 CRTFILE WORK AREA 00160E CALL 5 6 CALL STACK 00170E ERR 7 5 0A 00180I******************************************************************* 00190IBITHEX BT 00200I 1 256 BIT 00210I******************************************************************* 00220IMGFILE MG 00230I* MESSAGE FILE. 00240I 1 35 MGTEXT 00250I****************************************************************** ÐÐ00260ICRTFILE CR 00270I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00280I* STD AREA - SAME FOR ALL PROGRAMS. 00290I* EMPLOYEE # 5N 00300I 1 50CREMPL 00310I* USER CODE 8A 00320I 6 13 CRUSER 00330I* DEPT # 5N 00340I 14 180CRDEPT 00350I* JOB NAME 8A (JOB LOADED BY MENU) 00360I 19 26 CRJOB 00370I* SHUTDOWN FLAG 1A 00380I* BLANK = NO SHUTDOWN 00390I 27 27 CRSHUT 00400I* TIME STARTED 6N 00410I 28 330CRTIME 00420I* DATE STARTED 4N 00430I 34 370CRDATE 00440I* CALL STACK 5 X 6A 00450I 38 67 CALL 00460I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00470I 68 73 CRRET 00480I* MENU NAME 6A 00490I 74 79 CRMENU 00500I* TEXT 1A X 132 ÐÐ00510I 81 212 REC 00520I******************************************************************** 00530IBMBATCH BH 00540I* BATCH BILL MATL TRANSACTIONS. 00550I 1 100TAPN 00560I 11 200TCPN 00570I 25 270TITNO 00580I P 28 310TQTY 00590I 34 352TSCRP 00600I 36 37 TISSU 00610I 38 39 TBCHG 00620I 40 41 TECHG 00630I 42 46 TBECN 00640I 47 51 TEECN 00650I 52 52 TDISP 00660I 53 54 TAECHG 00670I 55 560TLL 00680I P 58 600TOPER 00690I P 61 630TDEPT 00700I P 64 650TWC 00710I 66 75 TREF 00720I P 76 96 ERR 00730I 97 97 TTCODE 00740I 98 98 TSTAT 00750C******************************************************************** ÐÐ00760C* INITIALIZE 00770C*---------------------------------------------------------------- 00780C START TAG 00790C EXSR SR101 1-TIME INIT 00800C H9 GOTO ENDJOB PROG ERROR 00810C Z-ADD0 EGAP 40 PAGE # 00820C* SET-UP 1ST FIELD NO. 00830C Z-ADD1 F 30 FIELD # 00840C GOTO READ 00850C*------------------------------------------------------------------ 00860C NEXT TAG 00870C* SET-UP NEXT FIELD NO. 00880C 1 ADD F F FIELD # 00890C*----------------------------------------------------------------- 00900C READ TAG 00910C* READ DATA FROM TERMINAL. 00920C SETOF 9096 00930C EXSR SR102 VALIDATE FIELD # 00940C 55 GOTO UPDATE DONE 00950C EXSR SR201 IDENTIFY-F 00960C 01 Z-ADD139 MSGNO 50 PROMPT BEG LINE# 00970C 02 Z-ADD142 MSGNO PROMPT END LINE# 00980C EXSR SR89 GET PROMPT MSG 00990C SETON 69 01000C EXSR SR73 PROMPT ÐÐ01010C SETOF 69 01020C EXSR SR75 READ TERMINAL 01030C*---------------------------------------------------------------- 01040C ESCAPE TAG 01050C 98 GOTO GOODBY GOODBY 01060C 94 GOTO MENU MENU REQUEST 01070C N77N88 EXSR SR104 EDIT INPUT FIELD 01080C 93 GOTO NEWITM NEW ITEM 01090C 92 GOTO JUMP FIELD JUMP REQST 01100C 91 GOTO NEXT SKIP FORWARD 01110C 89 F SUB 1 F SKIP BACKWARD 01120C 89 GOTO READ " " 01130C 88 SETOF 90 SPACE FILL 01140C 88 SETON 77 " " 01150C 87 GOTO START 01160C 86 GOTO UPDATE UPDATE 01170C 85 GOTO READ REPEAT 01180C 96 GOTO ERROR ERROR 01190C 90 Z-ADD318 M 50 96 FLAG ERROR 01200C 90 GOTO ERROR 01210C N77 GOTO NEXT NO DATA INPUT 01220C*------------------------------------------------------------------ 01230C PROCES TAG 01240C* PROCESS INPUT DATA 01250C EXSR SR103 MOVE DATA ÐÐ01260C N96 EXSR SR104 EDIT DATA 01270C 96 GOTO ERROR ERROR 01280C GOTO NEXT 01290C*------------------------------------------------------------------ 01300C UPDATE TAG 01310C* UPDATE DATA BASE. 01320C EXSR SR105 FINAL EDIT 01330C 96 GOTO ERROR ERROR 01340C EXSR SR106 UPDATE 01350C 96 GOTO ERROR ERROR 01360C 90 GOTO ESCAPE ESC CODE INPUT 01370C GOTO NEWITM START NEW LIST 01380C*------------------------------------------------------------------- 01390C JUMP TAG 01400C* SET-UP JUMP TO REQUESTED FIELD 01410C 1 ADD W W 30 01420C W COMP 4 54 01430C 54 Z-ADD318 M 50 96 FLAG ERROR 01440C 54 GOTO ERROR BAD ESC 01450C MOVE '000' W3A 3 01460C MOVEAA4,W W3A 01470C Z-ADD3 W2N 20 01480C EXIT SUBRAJ R. JUSTIFY 01490C RLABL W2N 01500C RLABL W3A ÐÐ01510C MOVE W3A F NEW FIELD # 01520C GOTO READ 01530C*-------------------------------------------------------------------- 01540C ERROR TAG 01550C EXSR SR102 VALIDATE FIELD # 01560C Z-ADDM MSGNO 50 01570C EXSR SR89 GET MSG 01580C EXSR SR73 PUT MSG 01590C GOTO READ 01600C*------------------------------------------------------------------ 01610C NEWITM TAG 01620C* SET-UP LINK FOR NEW ITEM 01630C EXITFQTOPF TOP OF FORM 01640C GOTO START 01650C Z-ADD150 STALL 01660C EXSR SR207 STALL FOR TIME 01670C*------------------------------------------------------------------- 01680C MENU TAG 01690C* SET-UP LINK TO MENU 01700C MOVEL'HELLO' PROG 8 01710C GOTO END 01720C*-------------------------------------------------------------------- 01730C GOODBY TAG 01740C* LINK TO SIGN-OFF 01750C MOVEL'GOODBY' PROG ÐÐ01760C GOTO END 01770C*------------------------------------------------------------------- 01780C END TAG 01790C EXITFQTOPF TOP OF FORM 01800C EXSR SR97 UPDATE CRTFILE 01810C EXITFCHAIN LINK TO NEXT PROG 01820C RLABL PROG 01830C*------------------------------------------------------------- 01840C ENDJOB TAG 01850C EXITFQTOPF TOP OF FORM 01860C******************************************************************** 01870CSR SR1 BEGSR 01880C* EDIT FROM RECORD NO. 01890CSR FRRN COMP 0 54 01900CSRN54 Z-ADD1 FRRN 01910CSR ENDSR 01920C******************************************************************** 01930CSR SR2 BEGSR 01940C* EDIT ENDING RECORD #. 01950CSR ERRN COMP FRRN 54 54 01960CSRN54 Z-ADDFRRN ERRN 01970CSR ENDSR 01980C******************************************************************** 01990CSR SR71 BEGSR 02000C* PUT HEADING TO DIABLO. ÐÐ02010CSR EXITFQTOPF TOP FORM. 02020CSR Z-ADD150 WAIT 30 STALL COUNTER 02030CSR 1 ADD EGAP EGAP PAGE # 02040CSR EXSR SR207 STALL FOR TIME 02050CSR Z-ADD5 COUNT 30 02060CSR SETON 41 02070CSR EXSR SR79 PUT HEADING. 02080CSR EXITFQCLF L/F. 02090CSR SETON 42 02100CSR EXSR SR79 PUT LINE-3. 02110CSR SETON 43 02120CSR EXSR SR79 PUT LINE-4. 02130CSR EXITFQCLFCR LF/CR. 02140CSR MOVE BIT,5 BUFLGT 02150CSR EXITFQNULLS 02160CSR RLABL BUFLGT 02170CSR ENDSR 02180C********************************************************************* 02190CSR SR72 BEGSR 02200C* PUT DATA LINE TO DIABLO. 02210CSR 1 ADD COUNT COUNT 30 02220CSR EXSR SR76 TEST NEW PAGE. 02230CSR EXSR SR77 READ CRTFILE. 02240CSR MOVE ' ' REC 02250CSR SETON 72 ÐÐ02260CSR EXCPT PUT CRTFILE. 02270CSR SETOF 72 02280CSR EXSR SR77 READ CRTFILE. 02290CSR EXSR SR78 PUT DIABLO. 02300CSR ENDSR 02310C*********************************************************************** 02320CSR SR73 BEGSR 02330C* PUT MESSAGE. 02340CSR EXSR SR89 GET MSG. 02350CSR 1 ADD COUNT COUNT 02360CSR EXSR SR77 READ CRTFILE. 02370CSR MOVE ' ' REC 02380CSR SETON 73 02390CSR EXCPT PUT MSG. 02400CSR SETOF 73 02410CSR EXSR SR77 READ CRTFILE. 02420CSR EXSR SR78 PUT DIABLO. 02430CSRN69 GOTO END73 NOT PROMPT. 02440CSR MOVE BIT,45 BUFLGT 02450CSR EXITFQATAB ABSOLUTE TAB. 02460CSR RLABL BUFLGT 02470CSR END73 ENDSR 02480C******************************************************************* 02490CSR SR75 BEGSR 02500C* READ FROM TERMINAL ÐÐ02510CSR SETOF 779096 02520CSR SETOF 939291 02530CSR SETOF 898887 02540CSR SETOF 8685 02550CSR MOVE BIT,3 A6,2 BUF LENGTH 02560CSR MOVEAA6 W6A 6 02570CSR MOVE BLK4 W4A 4 BUFFER 02580CSR EXITFQWREED READ TERM 02590CSR RLABL W4A 02600CSR RLABL W6A 02610CSR MOVEAW4A A4 02620CSR MOVE BLK4 W4A 02630CSR Z-ADD1 W 30 02640CSR '\' LOKUPA4,W 90 FLAG ESC 02650CSRN90 GOTO T75B NOT ESC 02660CSR 1 ADD W W 02670CSR W COMP 4 54 02680CSR 54 GOTO T75A BAD ESC 02690CSR A4,W COMP 'G' 98 GOODBY 02700CSR A4,W COMP 'E' 94 MENU 02710CSR A4,W COMP 'N' 93 NEW ITEM 02720CSR A4,W COMP 'J' 92 JUMP 02730CSR A4,W COMP 'F' 91 SKIP FRWRD 02740CSR A4,W COMP 'B' 89 SKIP BKWRD 02750CSR A4,W COMP 'S' 88 SPACE FILL ÐÐ02760CSR A4,W COMP 'H' 87 HOME 02770CSR A4,W COMP 'U' 86 UPDATE 02780CSR A4,W COMP 'R' 85 REPEAT 02790CSR 98 02800COR 94 02810COR 93 02820COR 92 02830COR 91 02840COR 89 02850COR 88 02860COR 87 02870COR 86 02880COR 85 GOTO END75 GOOD ESC 02890C*------------------------------------------------------------------ 02900CSR T75A TAG 02910C* FLAG BAD ESC INPUT 02920CSR Z-ADD318 M 96 FLAG ERROR 02930CSR GOTO END75 02940C*-------------------------------------------------------------------- 02950CSR T75B TAG 02960C* MOVE DATA 02970CSR Z-ADD1 W 02980CSR ' ' LOKUPA4,W 77 02990CSR 77 MOVEAA4,W W4A INPUT DATA 03000C*------------------------------------------------------------------- ÐÐ03010CSR END75 ENDSR 03020C******************************************************************** 03030CSR SR76 BEGSR 03040C* TEST NEW PAGE. 03050CSR COUNT COMP 55 54 03060CSR 54 EXSR SR71 PUT HEADINGS. 03070CSR ENDSR 03080C******************************************************************** 03090CSR SR77 BEGSR 03100C* READ CRT FILE. 03110CSR PORT CHAINCRTFILE 54 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR78 BEGSR 03150C* PUT TO DIABLO. 03160CSR EXITFQCLFCR LF/CR. 03170CSR MOVE BIT,5 BUFLGT 2 03180CSR MOVELBIT,1 BUFLGT 03190CSR EXITFQNULLS PUT NULLS. 03200CSR RLABL BUFLGT 03210CSR MOVEAREC W66A 66 03220CSR EXITFQTW132 1ST PASS. 03230CSR RLABL W66A 03240CSR MOVEAREC,67 W66A 03250CSR EXITFQTW132 2ND PASS. ÐÐ03260CSR RLABL W66A 03270CSR ENDSR 03280C******************************************************************** 03290CSR SR79 BEGSR 03300C* PUT HEADING (SEE SR71). 03310CSR EXSR SR77 READ CRTFILE. 03320CSR MOVE ' ' REC 03330CSR EXCPT PUT CRTFILE. 03340CSR SETOF 414243 03350CSR EXSR SR77 READ CRTFILE. 03360CSR EXSR SR78 PUT DIABLO. 03370CSR ENDSR 03380C******************************************************************** 03390CSR SR89 BEGSR 03400C* GET MESSAGE MASTER 03410CSR MSGNO CHAINMGFILE 54 03420CSR 54 MOVE BLK35 MGTEXT 03430CSR 54 MOVELM MGTEXT 03440CSR 54 MOVE MES,1 MGTEXT 03450CSR ENDSR 03460C****************************************************************** 03470CSR SR97 BEGSR 03480C* UPDATE CRTFILE. 03490CSR SETON 97 03500CSR EXCPT UPDATE CRTFILE ÐÐ03510CSR SETOF 97 03520CSR ENDSR 03530C*********************************************************************** 03540CSR SR101 BEGSR 03550C* 1-TIME INITIALIZE 03560CSR EXITFQTOPF TOP OF FORM 03570CSR Z-ADD150 WAIT STALL COUNTER 03580CSR EXSR SR207 STALL FOR TIME 03590CSR EXITFQHALT PAUSE PAPER POSITION 03600CSR EXITFQBELL RING BELL 03610CSR EXITFQBELL 03620CSR MOVELBIT,1 BUFLGT 03630CSR MOVE BIT,1 A6 03640CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS 03650CSR MOVE ' ' BLK4 4 03660C* GET PORT # AND CRTFILE 03670CSR MOVE ' ' W8A 8 03680CSR Z-ADD0 W2N 20 03690CSR Z-ADD0 W1N 10 03700CSR MOVE ' ' W2A 2 03710CSR EXITFPGMINX GET PORT # 03720CSR RLABL W8A 03730CSR RLABL W2N 03740CSR RLABL W1N 03750CSR RLABL W2A ÐÐ03760CSR MOVE W2A PORT 20 PORT NO. 03770CSR PORT COMP 0 54 03780CSRN54 Z-ADD25 PORT DEFAULT 03790CSR EXSR SR77 GET CRTFILE 03800CSR 54 SETON H9 NO GET 03810CSR H9 GOTO END101 03820CSR MOVE ' ' REC 03830CSR SETON 70 03840CSR EXCPT INIT CRTFILE 03850CSR SETOF 70 03860C* DEFINE WORK FIELDS,ETC. 03870CSR MOVE ' ' BLK35 35 03880CSR Z-ADD0 ZERO5 50 03890CSR END101 ENDSR 03900C********************************************************************** 03910CSR SR102 BEGSR 03920C* VALIDATE FIELD NO. 03930CSR F COMP 0 54 03940CSRN54 Z-ADD1 F 03950CSR F COMP FLIMIT 55 03960CSR 55 Z-ADD1 F 03970CSR ENDSR 03980C******************************************************************** 03990CSR SR103 BEGSR 04000C* MOVE INPUT DATA ÐÐ04010CSR EXSR SR201 IDENTIFY-F 04020CSR EXSR SR202 R. JUSTIFY 04030CSR 01 MOVE W4A FRRN 40 BEG LINE # 04040CSR 02 MOVE W4A ERRN 40 ENDING LINE# 04050CSR MOVE ' ' DUN,F EDIT FLAG 04060CSR ENDSR 04070C******************************************************************** 04080CSR SR104 BEGSR 04090C* EDIT INPUT DATA 04100CSR 01 EXSR SR1 04110CSR 02 EXSR SR2 04120CSR 96 MOVE ' ' DUN,F EDIT FLAG 04130CSRN96 MOVE 'X' DUN,F 04140CSR ENDSR 04150C*********************************************************************** 04160CSR SR105 BEGSR 04170C* FINAL EDIT 04180CSR SETON 79 FINAL EDIT FLAG 04190CSR Z-ADD1 F 96 04200C*-------------------------------------------------------------------- 04210CSR T105A TAG 04220CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04230CSRN54 GOTO END105 04240CSR EXSR SR201 IDENTIFY-F 04250CSR EXSR SR104 EDIT ÐÐ04260CSRN96 GOTO T105A 04270C*-------------------------------------------------------------------- 04280CSR END105 TAG 04290CSR SETOF 79 04300CSR ENDSR 04310C******************************************************************** 04320CSR SR106 BEGSR 04330C* DISPLAY TRAN FILE. 04340CSR EXSR SR71 PUT HEADING. 04350CSR Z-ADDFRRN TRRN 40 04360C*------------------------------------------------------------------- 04370CSR T106A TAG 04380CSR TRRN COMP 0 54 04390CSRN54 Z-ADD1 TRRN 04400CSR TRRN CHAINBMBATCH 54 04410CSR 54 GOTO T106T END OF FILE. 04420CSR EXSR SR206 CLASSIFY TRAN. 04430CSR EXSR SR72 DISPLAY TRAN. 04440CSR Z-ADD1 M 50 04450C*-------------------------------------------------------------- 04460CSR T106B TAG 04470CSR ZERO5 LOKUPERR,M 54 FIND ERR MSG# 04480CSRN54 GOTO T106C NO MORE ERRS 04490CSR ERR,M CHAINMGFILE 54 04500CSR 54 Z-ADD0 ERR,M ÐÐ04510CSR 54 GOTO T106B ERR NOT ON FILE 04520CSR Z-ADDERR,M MSGNO 50 04530CSR EXSR SR73 PUT ERR MSG. 04540CSR 1 ADD COUNT COUNT 04550CSR Z-ADD0 ERR,M 04560CSR GOTO T106B 04570C*------------------------------------------------------------- 04580CSR T106C TAG 04590CSR TRRN COMP ERRN 54 54 04600CSR 54 GOTO T106E DONE 04610CSR COUNT COMP 55 54 04620CSR 1 ADD TRRN TRRN 04630CSRN54 GOTO T106A 04640CSR EXSR SR71 PUT HEADING. 04650CSR GOTO T106A 04660C*--------------------------------------------------------------- 04670CSR T106E TAG 04680CSR EXITFQELIST END MSG 04690CSR GOTO T106W 04700C*------------------------------------------------------------------- 04710CSR T106T TAG 04720C* END OF FILE. 04730CSR MOVE BIT,5 BUFLGT 04740CSR EXITFQNULLS PUT NULLS. 04750CSR RLABL BUFLGT ÐÐ04760CSR EXITFQEFILE 04770CSR MOVE BIT,5 BUFLGT 04780C*------------------------------------------------------------ 04790CSR T106W TAG 04800CSR END106 ENDSR 04810C************************************************************************ 04820CSR SR201 BEGSR 04830C* IDENTIFY FIELD NO. 04840CSR F COMP 1 01 04850CSR F COMP 2 02 04860CSR ENDSR 04870C********************************************************************** 04880CSR SR202 BEGSR 04890C* RIGHT JUSTIFY 04900CSR F LOKUPNUM 54 04910CSRN54 GOTO END202 NOT NUMERIC FIELD 04920CSR Z-ADD4 W2N 20 04930CSR EXIT SUBRAJ R. JUSTIFY 04940CSR RLABL W2N 04950CSR RLABL W4A 04960CSR END202 ENDSR 04970C******************************************************************** 04980CSR SR206 BEGSR 04990C* CLASSIFY TRAN. 05000CSR TTCODE COMP 'A' 60 ADD. ÐÐ05010CSR TTCODE COMP 'C' 61 CHANGE. 05020CSR TTCODE COMP 'D' 62 DELETE ITEM. 05030CSR TTCODE COMP '#' 63 DELETE ASSY. 05040C* 05050CSR TSTAT COMP 'D' 64 COMPLETED. 05060CSR TSTAT COMP 'R' 65 REJECT 05070CSR TSTAT COMP 'W' 66 IN PROCESS 05080CSR SETOF 67 05090CSRN64N65N66 SETON 67 NOT YET PROCESSED 05100CSR ENDSR 05110C*************************************************************** 05120CSR SR207 BEGSR 05130C* STALL FOR TIME 05140CSR Z-ADD0 STALL 30 05150C*--------------------------------------------------------------- 05160CSR T207A TAG 05170CSR 1 ADD STALL STALL 05180CSR STALL COMP WAIT 54 05190CSRN54 GOTO T207A 05200CSR ENDSR 05210O**************************************************************** 05220OCRTFILE E 41 05230O REC 212 05240O UDATE 88 ' - - ' 05250O 154 'BILL MATERIAL BATCH TRAN' ÐÐ05260O 162 'SACTIONS' 05270O 207 'PAGE' 05280O EGAP Z 212 05290O*------------------------------------------------------------------- 05300O E 42 05310O REC 212 05320O 173 'STARTING' 05330O 185 'ENDING' 05340O 150 'ROUTING' 05350O 134 'ISSUE' 05360O*------------------------------------------------------------------- 05370O E 43 05380O REC 212 05390O 88 'ASSEMBLY' 05400O 103 'COMPONENT' 05410O 111 'ITEM' 05420O 121 'QTY-PER' 05430O 129 'SCRAP %' 05440O 134 'CODE' 05450O 139 'OPER' 05460O 145 'DEPT' 05470O 150 'W.C.' 05480O 160 'REF-INFO' 05490O 167 'ECN' 05500O 175 'CHG' ÐÐ05510O 180 'ECN' 05520O 187 'CHG' 05530O 194 'TRANS' 05540O 204 'STATUS' 05550O 212 'REC' 05560O*------------------------------------------------------------------- 05570O E 72 05580O* PUT DATA. 05590O REC 212 05600O TAPN 92 ' - - ' 05610O TCPN 106 ' - - ' 05620O TITNO Z 111 05630O TQTY 1 122 05640O TSCRP Z 126 05650O TISSU 133 05660O TOPER Z 138 05670O TDEPT Z 145 05680O TWC Z 150 05690O TREF 162 05700O TBECN 169 05710O TBCHG 175 05720O TEECN 182 05730O TECHG 187 05740O 60 197 'ADD ITEM' 05750O 61 197 'CHG ITEM' ÐÐ05760O 62 197 'DEL ITEM' 05770O 63 197 'DEL ASSY' 05780O 64 207 'PROCESSED' 05790O 65 206 'REJECTED' 05800O 66 205 'IN-PROC' 05810O 67 206 'NOT-PROC' 05820O TRRN Z 212 05830O*------------------------------------------------------------------- 05840O E 73 05850O* PUT MSG. 05860O REC 212 05870O 96 85 '*****' 05880O N96 85 ' ' 05890O MGTEXT 120 05900O*------------------------------------------------------------- 05910O E 70 05920O REC 212 ** A6 ARRAY 005930 005940** A4 ARRAY 005950 005960** NUM ARRAY 005970001 BEG LINE# 005980002 END LINE# 005990** DUN ARRAY 006000ÐÐ 006010** MES ARRAY 006020---MESSAGE NOT ON FILE--- 006030/* 006040_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(e°  X025GL P120282120282(èÈÐ00010H Q025GL00020F* CREATE G/L GUIDE FILE FOR TOP LEVEL ACCOUNTS ONLY. (X025GL) 00030F* REVISED 5/29/81 12:40 PM. 00040FGLWU IP F 25 DISK 00050FGLMAST IS F 165R I DISK 00060FGLADRT IR F 300 3 3IT EDISK 00070FGLGUIDE O F 11 DISK 00080E******************************************************************** 00090E GLADRT GLMAST 00100I******************************************************************** 00110IGLWU GW 03 25NCD 00120I 3 13 GWSUB M1 00130I GB 02 00140I******************************************************************** 00150IGLMAST GL 01 165NCD 00160I 3 13 GLACNT M1 00170I P 157 1590GLNOSA 00180I GG 02 00190O******************************************************************** 00200OGLGUIDE D 01NMR 00210O GLACNT 11 /* 000220_‚ ÐÐ _‚_‚0FGLADRT IR F 300 3 3IT EDISK 00070FGLGUIDE O F 11 DISK 00080E******************************************************************** 00090E GLADRT GLMAST 00100I******************************************************************** 00110IGLWU GW 03 25NCD 00120I 3 13 GWSUB M1 00130I GB 02 00140I******************************************************************** 00150IGLMAST GL 01 165NCD 00160I 3 13 GLACNT M1 00170I P 157 1590GLNOSA 00180I GG 02 00190O******************************************************************** 00200OGLGUIDE D 01NMR 00210O GLACNT 11 /* 000220_‚ ÐÈ(úe¾ úiX026BM P120282120282(èÈÐ00010H Q026BM00020F* FLAG PECULIAR PARTS (RUN IN CONJUNCTION WITH X017BM) (X026BM) 00030F* REV 1/22/80 3:45 PM. 00040F* 00050FBITTAB IP F 33 DISK 00060FPMMST UD F 576L12AI 1 DISK 00070FBMWU ID F 21L20AI 1 DISK 00080FBMMAST IC F 86R20AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FPRINT O F 132 PRINTER 00110FTERM50 O F 50 5 00120E******************************************************************** 00130E LEV 1 20 20 NEXT RRN AT EA LEVEL 00140E BIT 33 1 BITTAB. 00150I******************************************************************** 00160IBITTAB BT 00170I 1 33 BIT 00180I**************************************************************** 00190IBMWU BW 00200I 1 100BWCPN 00210I 11 200BWAPN 00220I 21 21 BWSTAT 00230I******************************************************************** 00240IPMMST PM 00250I* PART NO ÐÐ00260I 1 100PMPN 00270I* USAGE FLAG 00280I 36 36 USFLAG 00290I* RECORD STATUS 1A 00300I* D = DELETED 00310I 576 576 PMSTAT 00320I******************************************************************** 00330IBMMAST BM 00340I* BILL OF MATERIAL RECORD 00350I* KEY AREA 00360I* ASSY PART NO. 10N 00370I 1 100BMAPN 00380I* COMPONENT PART # 10N 00390I 11 200BMCPN 00400I* ITEM NO. 3N 00410I 25 270BMITNO 00420I* QTY PER ASSY 7P 00430I P 28 310BMQTY 00440I* SCRAP ALLOW .2N 00450I 34 352BMSCRP 00460I* ISSUE CODE 2A 00470I* PT = PULL TIME 00480I* OR = ON REQUEST 00490I* BI = BULK ISSUE 00500I* AR = AS REQUIRED ÐÐ00510I* RA = REF ASSY 00520I* TD = TRAV DOC 00530I* SD = SHIP DOC 00540I* RD = REF DOC 00550I* VS = VENDOR SUPPLIED 00560I 36 37 BMISSU 00570I* EFFECTIVITY. 00580I* BEGIN CHANGE LEVEL 2A 00590I 38 39 BMBCHG 00600I* ENDING CHANGE LEVEL 2A 00610I 40 41 BMECHG 00620I* BEGIN ECN # 5A 00630I 42 46 BMBECN 00640I* ENDING ECN # 5A 00650I 47 51 BMEECN 00660I* DISPOSITION CODE 1A 00670I* U = USE UP OLD STYLE 00680I* N = NOW (IMMEDIATE) 00690I 52 52 BMDISP 00700I* FILLER 5A 53 57 FFFFFF 00710I* ROUTING. 00720I* OPER NO. 5P 00730I P 58 600BMOPER 00740I* DEPT NO. 5P 00750I P 61 630BMDEPT ÐÐ00760I* WORK CENTER NO. 3P 00770I P 64 650BMWC 00780I* COMPONENT OPER REFERENCE INFO 10A 00790I 66 75 BMREF 00800I* FILLER 10A 76 85 FFFFFF 00810I* 00820I* RECORD STATUS 1A 00830I* D = DELETED 00840I 86 86 BMSTAT 00850I******************************************************************** 00860IMGFILE MG 00870I* MESSAGE FILE. 00880I* TEXT 35A 00890I 1 35 MGTEXT 00900I* LINE-2 35A 00910I 36 70 MGLIN2 00920I* PROG NAME 5A 00930I 71 75 MGPROG 00940C******************************************************************** 00950C* INITIALIZE 00960C EXSR SR101 INIT 00970C MOVE BLK12 W12A 12 00980C*--------------------------------------------------------------- 00990C TAG5 TAG 01000C W12A SETLLPMMST ÐÐ01010C*-------------------------------------------------------------- 01020C TAG10 TAG 01030C SETOF 54 01040C READ PMMST 54 01050C 54 GOTO END END OF FILE 01060C PMSTAT COMP 'D' 54 01070C 54 GOTO TAG10 DELETED MAST 01080C USFLAG COMP 'X' 54 01090C N54 GOTO TAG10 NOT CANDIDATE 01100C MOVELPMPN USPN 100 USAGE PART # 01110C USPN COMP LASTPN 54 01120C N54 SETON LR 01130C N54 GOTO END 01140C Z-ADDUSPN LASTPN 100 01150C SETON 49 01160C EXCPT PUT PN TO TERM 01170C SETOF 49 01180C* SET-UP INITIAL BILL MATERIAL READ 01190C Z-ADD3 L 20 INDENTURE LEVEL 01200C MOVE BLK20 LEV 01210C MOVELUSPN LEV,2 01220C*----------------------------------------------------------------- 01230C TAG20 TAG 01240C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 01250C L SUB 1 L 54 INDENT LEVEL ÐÐ01260C N54 MOVE BLK12 W12A 01270C N54 1 ADD USPN USPN 01280C N54 MOVELUSPN W12A 01290C N54 GOTO TAG5 BOTTOM INDENT 01300C LEV,L COMP BLK20 54 01310C N54 GOTO TAG20 NONE THIS LEVEL 01320C MOVE LEV,L W20A 20 01330C MOVELLEV,L CURASY 100 MATCH PART # 01340C MOVE BLK20 LEV,L 01350C*------------------------------------------------------------------ 01360C TAG30 TAG 01370C* SET-UP NEXT READ 01380C W20A SETLLBMWU 01390C*--------------------------------------------------------------- 01400C TAG40 TAG 01410C* GET NEXT COMPONENT. 01420C SETOF 54 01430C READ BMWU 54GET COMPONENT 01440C 54 GOTO TAG20 END OF FILE 01450C BWCPN COMP CURASY 54 01460C N54 GOTO TAG20 WRONG COMPONENT 01470C BWSTAT COMP 'D' 54 01480C 54 GOTO TAG40 DELETED RECORD 01490C* DISPLAY COMPONENT DATA 01500C MOVE BLK12 W12A ÐÐ01510C MOVELBWAPN W12A 01520C EXSR SR81 GET ASSY MAST 01530C 96 GOTO END PROG ERROR 01540C USFLAG COMP 'X' 54 01550C N54 GOTO TAG60 OTHER USAGE 01560C*------------------------------------------------------------------ 01570C TAG50 TAG 01580C* SAVE CUR LEVEL COMP/ASSEMBLY PART # 01590C MOVELBWCPN LEV,L 01600C 1 ADD BWAPN W10N 100 01610C MOVE W10N LEV,L 01620C MOVE BWAPN CURASY 01630C MOVELBWAPN W20A 01640C MOVE ZERO10 W20A 01650C 1 ADD L L INDENT LEVEL 01660C GOTO TAG30 01670C*------------------------------------------------------------- 01680C TAG60 TAG 01690C* REMOVE USAGE FLAG FROM INITIAL PART MASTER READ 01700C MOVE BLK12 W12A 01710C MOVELUSPN W12A 01720C EXSR SR81 READ PMMST 01730C 96 GOTO END PROG ERROR 01740C SETON 74 01750C EXCPT INIT USAGE FLAG ÐÐ01760C SETOF 74 01770C MOVE BLK12 W12A 01780C 1 ADD USPN USPN 01790C MOVELUSPN W12A 01800C GOTO TAG5 01810C*---------------------------------------------------------- 01820C END TAG 01830C******************************************************************** 01840CSR SR71 BEGSR 01850C* CLEAR CRT. PUT HEADINGS. 01860CSR SETON 71 01870CSR EXCPT PUT HEADING 01880CSR SETOF 71 01890CSR ENDSR 01900C******************************************************************** 01910CSR SR81 BEGSR 01920C* GET PART MAST. 01930CSR W12A SETLLPMMST 01940CSR SETOF 54 01950CSR READ PMMST 54 01960CSR 54 GOTO T81A 01970CSR MOVELW12A W10N 100 01980CSR PMPN COMP W10N 54 01990CSR 54 GOTO END81 02000C*------------------------------------------------------------- ÐÐ02010CSR T81A TAG 02020CSR SETON 4140 02030CSR EXCPT 02040CSR SETOF 4140 02050CSR END81 ENDSR 02060C******************************************************************** 02070CSR SR101 BEGSR 02080C* INITIALIZE (1-TIME). 02090CSR MOVE ' ' BLK35 35 02100CSR MOVE ' ' BLK12 12 02110CSR MOVE ' ' BLK20 20 02120CSR Z-ADD0 ZERO10 100 02130CSR ENDSR 02140O*************************************************************** 02150OPMMST E 74 U1 U2 02160O AND U3 U4 02170O 36 ' ' 02180O************************************************************* 02190OPRINT E 40 02200O USPN 10 02210O 41 40 'ERROR 41' 02220O********************************************************** 02230OTERM50 E 49 02240O USPN 12 ' - - ' ** LEV ARRAY 002250ÐÐ 002260/* 002270_‚ ÐÐ_‚_‚ 002260/* 002270_‚ ÐÈ(–f( –?X027BM P120282120282(èÈÐ00010H Q027BM00020F* INPUT PART # TO BE EXPLODED BY X017BM 00030F* REVISED 9/19/80 3:50 PM. 00040FBITTAB IP F 33 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FENDITEM UC F 12R10AI 1 DISK A 00070FTERM132 O F 132 5 00080E*************************************************************** 00090E A12 12 12 1 A 00100E NUL 1 132 1 00110E BIT 33 1 00120I************************************************************ 00130IBITTAB BT 00140I 1 33 BIT 00150I*************************************************************** 00160IPMMST2 PM 00170I 1 100PMPN 00180I******************************************************** 00190IENDITEM EF 00200I 1 100EFPN 00210C********************************************************* 00220C MOVE ' ' BLK12 12 00230C MOVELBIT,1 BUFLGT 00240C MOVE BIT,1 NUL 00250C*------------------------------------------------------------------- ÐÐ00260C BEGIN TAG 00270C* GET TRAN CODE. 00280C EXITFQCLFCR 00290C MOVE BIT,3 BUFLGT 2 00300C MOVELBIT,1 BUFLGT 00310C MOVE ' ' W2A 2 00320C SETON 73 00330C EXCPT RQST TRAN. 00340C SETOF 73 00350C EXITFQWREED READ. 00360C RLABL W2A 00370C RLABL BUFLGT 00380C MOVELW2A TTCODE 1 00390C TTCODE COMP 'A' 40 00400C TTCODE COMP 'D' 41 00410C N40N41 SETON 74 00420C N40N41 EXCPT ERROR MSG. 00430C N40N41 SETOF 74 00440C N40N41 GOTO BEGIN 00450C*------------------------------------------------------------------- 00460C START TAG 00470C SETOF 6061 00480C EXITFQCLFCR LFCR 00490C MOVE BLK12 W12A 12 00500C MOVE BIT,7 BUFLGT 2 ÐÐ00510C EXITFQWREED READ CRT 00520C RLABL W12A 00530C RLABL BUFLGT 00540C MOVEAW12A A12 00550C MOVE BLK12 W12A 00560C Z-ADD1 W 30 00570C ' ' LOKUPA12,W 54 00580C N54 GOTO START 00590C A12,W COMP '\' 90 00600C N90 GOTO CONTU 00610C 1 ADD W W 00620C W COMP 12 54 00630C 54 GOTO START 00640C A12,W COMP 'N' 54 00650C 54 GOTO BEGIN 00660C GOTO END 00670C*------------------------------------------------------------------- 00680C CONTU TAG 00690C MOVEAA12,W W12A 00700C Z-ADD12 W2N 20 00710C EXIT SUBRAJ R.JUSTIFY 00720C RLABL W2N 00730C RLABL W12A 00740C MOVE W12A W10N 100 00750C MOVE BLK12 W12A ÐÐ00760C W10N COMP 0 54 00770C N54 GOTO START 00780C MOVELW10N W12A 00790C W12A CHAINPMMST2 60 00800C EXITFQMOVUP BUMP CURSOR UP 00810C W10N CHAINENDITEM 61 00820C 41 61 SETON 75 00830C 41 61 EXCPT ERROR MSG. 00840C 41 61 SETOF 75 00850C 41 61 GOTO START 00860C SETON 72 00870C EXCPT 00880C SETOF 72 00890C GOTO START 00900C*------------------------------------------------------------ 00910C END TAG 00920O****************************************************************** 00930OTERM132 E 72 00940O 60 56 'E R R O R' 00950O N61 40 56 'E R R O R' 00960O W10N 12 ' - - ' 00970O 60 20 '*****' 00980O 60 35 'NO PART MASTER' 00990O 60 44 '*****' 01000O N61 40 37 'PREVIOUSLY INPUT' ÐÐ01010O*------------------------------------------------------------------- 01020O E 74 01030O 17 'TRAN CODE INVALID' 01040O 40 'E R R O R' 01050O*------------------------------------------------------------------- 01060O E 73 01070O NUL 132 01080O 18 'ENTER TRAN CODE: ' 01090O*------------------------------------------------------------------- 01100O E 75 01110O 15 'NOT ENTERED YET' 01120O 40 'E R R O R' 01130O******************************************************************** 01140OENDITEM EADD 72N60 61 01150O W10N 10 01160O 12 'A' 01170O*------------------------------------------------------------------- 01180O E 72N61N60 01190O 40 12 'A' 01200O 41 12 'D' ** A12 001210 001220** NUL ARRAY 001230 001240/* 001250ÐÐ_‚ ÐÐ_‚_‚ ÐÈ(Xfµ XúX005HG Pâ999999052483(èÈÐ00010H Q005HG00020F* 00030F* PRINT PROPOSAL TASKS-- CALCULATE AMOUNTS AND TOTALS 00040FP#PRINT IP F 80 DISK 00050FCRTFILE UC F 256R DISK 00060FMGFILE IC F 80R DISK 00070FTERM50 O F 50 5 00080E********************************************************************** 00090E HDG 1 9 70 A 00100E PRT 1 70 1 A 00110E TRP 70 1 00120E REC 73 1 00130I****************************************************************** 00140IMGFILE MG 00150I* MESSAGE TEXT FILE 00160I 1 40 MGTEXT 00170I******************************************************************** 00180ICRTFILE CR 00190I 81 150 TRP 00200I******************************************************************* 00210IP#PRINT PP 40 1 C# 00220I* PROPOSAL PRINT FILE 00230I* TASK NAME 27A 00240I 4 30 PPTASKL1 00250I* QTY 5.1 7A ÐÐ00260I 38 44 PPQTY 00270I* TOTAL SHEET COLUMN # 4A 00280I 56 59 PPCOL 00290I*---------------------------------------------------------------- 00300I PL 99 1 C/ 2 C* 00310I* END OF FILE DESIGNATOR 00320I 1 2 EOF 00330I*----------------------------------------------------------------- 00340I PH 42 1 C% 00350I* HEADING 00360I 2 20PPLINE 00370I 1 73 REC 00380I*------------------------------------------------------------------- 00390I PR 41 1 C 00400I* TEXT RECORD 00410I* RECORD CODE 2A 00420I* 1ST COL 00430I* A= HOURS X RATE = AMOUNT. AMOUNT IS ADDED TO CUMAMT. 00440I* B= RATE X CUMAMT = AMOUNT. AMOUNT IS ADDED TO CUMAMT. 00450I* C= AMOUNT IS INPUT. AMOUNT IS ADDED TO CUMAMT. 00460I* D= RATE X CUMAMT = AMOUNT. AMOUNT IS ADDED TO SUBTOT. 00470I* CUMAMT IS NOT INCREASED. 00480I* E= RATE X CUMAMT = AMOUNT. AMOUNT IS ADDED TO SUBTOT. 00490I* SUBTOT IS ADDED TO CUMAMT. SUBTOT IS SET TO ZERO. 00500I* F= AMOUNT IS INPUT. AMOUNT IS ADDED TO SUBTOTAL (NOT ÐÐ00510I* TO CUMAMT). 00520I* G= AMOUNT IS INPUT. AMOUNT IS ADDED TO SUBTOT. SUBTOT 00530I* IS ADDED TO CUMAMT. SUBTOT IS ZEROED. 00540I* J= NO CALCULATION- AMOUNT IS INPUT. HOURS,RATE,AMOUNT 00550I* ARE RIGHT JUSTIFIED. 00560I* 2ND COL 00570I* @= PRINT SUB TOTAL LINE (CUMAMT) AFTER THIS LINE IS 00580I* PRINTED. 00590I* 00600I 2 3 PPCODE 00610I* 00620I* FULL RECORD/PRINT LINE 70A 00630I 1 73 REC 00640I* DESCRIPTION 28A 00650I 4 31 PPDESC 00660I* HOURS 13A 00670I 35 47 PPHRS 00680I* RATE 8A 00690I 50 57 PPRATE 00700I 59 59 PPSIGN 00710I* AMOUNT 13A 00720I 61 73 PPAMT 00730C****************************************************************** 00740C* INITIALIZE. 00750C N43 EXSR SR200 1-TIME ONLY ÐÐ00760C SETON 43 00770C MOVE ' ' BLK70 70 STUPIDITY 00780C 40 PPTASK COMP BLK28 54 00790C 40N54 SETON 44LR 00800C 40N54 EXCPT ABORT MESSAGE 00810C 40N54 GOTO END 00820C EXSR SR101 EVERYTIME 00830C 40 98 EXSR SR110 PREV TASK TOTALS 00840C 40 EXSR SR100 NEW TASK INIT 00850C 40 SETOF 98 00860C 40 GOTO END 00870C 99 SETON LR END OF FILE 00880C 99 GOTO END 00890C 42 GOTO TAG200 HEADING 00900C* 00910C* DO TEXT LINE 00920C SETON 98 00930C REC,2 COMP 'A' 01 00940C REC,2 COMP 'B' 02 00950C REC,2 COMP 'C' 03 00960C REC,2 COMP 'D' 04 00970C REC,2 COMP 'E' 05 00980C REC,2 COMP 'F' 06 00990C REC,2 COMP 'F' 07 01000C REC,2 COMP 'J' 08 ÐÐ01010C REC,3 COMP '@' 10 01020C 01 GOTO TAG110 CODE A 01030C 02 GOTO TAG120 CODE B 01040C 03 GOTO TAG130 CODE C 01050C 04 GOTO TAG140 CODE D 01060C 05 GOTO TAG150 CODE E 01070C 06 GOTO TAG160 CODE F 01080C 07 GOTO TAG170 CODE G 01090C 08 GOTO TAG180 CODE J 01100C EXSR SR75 CHECK SPACING 01110C MOVEAREC,4 PRT 01120C ' ' LOKUPPRT 54 01130C N54 GOTO END 01140C EXSR SR72 INT PRT,69,70 01150C PRT,1 COMP '*' 54 01160C 54 MOVE ' ' PRT,1 01170C EXSR SR80 01180C 10 GOTO TAG600 PRINT TOTAL 01190C GOTO END 01200C*-------------------------------------------------------------------- 01210C TAG110 TAG 01220C* A-CODE 01230C EXSR SR102 RJ 01240C N94 GOTO END 01250C 77 HOURS MULT RATE AMOUNT 92 ÐÐ01260C N77 HOURS MULT RATE AMOUNT 01270C AMOUNT ADD CUMAMT CUMAMT 92 01280C GOTO TAG500 01290C*------------------------------------------------------------------- 01300C TAG120 TAG 01310C* B-CODE 01320C EXSR SR102 RJ 01330C N94 GOTO END 01340C 77 RATE MULT CUMAMT AMOUNT 01350C N77 PCTMUL MULT CUMAMT AMOUNT 01360C AMOUNT ADD CUMAMT CUMAMT 01370C GOTO TAG500 01380C*------------------------------------------------------------------- 01390C TAG130 TAG 01400C* C-CODE 01410C EXSR SR102 RJ 01420C N94 GOTO END 01430C AMOUNT ADD CUMAMT CUMAMT 01440C GOTO TAG500 01450C*------------------------------------------------------------ 01460C TAG140 TAG 01470C* D-CODE 01480C EXSR SR102 RJ 01490C N94 GOTO END 01500C 77 RATE MULT CUMAMT AMOUNT ÐÐ01510C N77 PCTMUL MULT CUMAMT AMOUNT 01520C AMOUNT ADD SUBTOT SUBTOT 92 01530C GOTO TAG500 01540C*------------------------------------------------------------ 01550C TAG150 TAG 01560C* E-CODE 01570C EXSR SR102 RJ 01580C N94 GOTO END 01590C 77 RATE MULT CUMAMT AMOUNT 01600C N77 PCTMUL MULT CUMAMT AMOUNT 01610C AMOUNT ADD SUBTOT SUBTOT 01620C SUBTOT ADD CUMAMT CUMAMT 01630C Z-ADD0 SUBTOT 01640C GOTO TAG500 01650C*------------------------------------------------------------ 01660C TAG160 TAG 01670C* F-CODE 01680C EXSR SR102 RJ 01690C N94 GOTO END 01700C AMOUNT ADD SUBTOT SUBTOT 01710C GOTO TAG500 01720C*------------------------------------------------------------- 01730C TAG170 TAG 01740C* G-CODE 01750C EXSR SR102 RJ ÐÐ01760C N94 GOTO END 01770C AMOUNT ADD SUBTOT SUBTOT 01780C SUBTOT ADD CUMAMT CUMAMT 01790C Z-ADD0 SUBTOT 01800C GOTO TAG500 01810C*----------------------------------------------------------------- 01820C TAG180 TAG 01830C* J-CODE 01840C EXSR SR102 RJ 01850C N94 GOTO END 01860C GOTO TAG500 01870C*------------------------------------------------------------------ 01880C TAG200 TAG 01890C* HEADINGS 01900C Z-ADDPPLINE H 30 01910C H COMP 0 54 01920C N54 Z-ADD1 H 01930C H COMP 9 54 01940C 54 Z-ADD9 H 01950C Z-ADDH X 30 01960C*--------------------------------------------------------------- 01970C TAG210 TAG 01980C 1 ADD X X 01990C X COMP 9 54 02000C N54 MOVE BLK70 HDG,X ÐÐ02010C N54 GOTO TAG210 02020C MOVEAREC,4 PRT,1 02030C PRT,1 COMP '*' 54 02040C 54 MOVE ' ' PRT,1 02050C EXSR SR72 INIT PRT 69,70 02060C MOVEAPRT HDG,H 02070C H COMP 1 73 02080C N73 9 ADD COUNT W3N 02090C N73 W3N COMP 45 54 54 02100C N73 54 EXSR SR69 TOP OF FORM 02110C 73 EXSR SR69 TOP OF FORM 02120C SETON 76 02130C EXSR SR80 PRINT HEADING 02140C SETOF 76 02150C SETOF 73 02160C GOTO END 02170C*----------------------------------------------------------------- 02180C TAG500 TAG 02190C EXSR SR75 CHECK SPACING 02200C MOVEAREC,4 PRT,1 02210C PRT,1 COMP '*' 54 02220C 54 MOVE ' ' PRT,1 02230C EXSR SR72 INIT PRT 02240C EXSR SR81 02250C*------------------------------------------------------------------ ÐÐ02260C TAG600 TAG 02270C 10 EXSR SR109 PRINT SUB-TOTAL 02280C*----------------------------------------------------------------- 02290C END TAG 02300C*------------------------------------------------------------------- 02310C* PUT OUT TOTALS 02320CLR 98 EXSR SR110 PUT OUT TASK TOTALS 02330CLR EXSR SR69 TOP OF FORM 02340C******************************************************************** 02350CSR SR69 BEGSR 02360C* TOP OF FORM 02370CSR EXITFZTFORM TOP OF FORM 02380CSR SETON 45 02390CSR Z-ADD1 COUNT 30 02400CSR 1 ADD EGAP EGAP 40 02410CSRNU1 EXITFZBELL RING BELL 02420CSRNU1 EXITFZBELL 02430CSRNU1 EXITFZBELL 02440CSRNU1 MOVE ' ' W4A 4 02450CSRNU1 EXITFZR4 DUMMY READ 02460CSR RLABL W4A 02470CSR SETOF 45 02480CSR ENDSR 02490C********************************************************************* 02500CSR SR70 BEGSR ÐÐ02510C* PRINT ROUTINE 02520CSR SETON 45 02530CSRN82 EXSR SR71 LF 02540CSR SETOF 45 02550CSR PORT CHAINCRTFILE H9 02560CSR H9 GOTO END 02570CSR EXCPT PUT CRTFILE 02580CSR MOVE ' ' PRT 02590CSR SETOF 74 02600CSR SETOF 808182 02610CSR SETOF 8373 02620CSR SETOF 8990 02630CSR PORT CHAINCRTFILE H9 02640CSR H9 GOTO END 02650CSR MOVEATRP W148A 148 02660CSR EXITFZD148 PRINT 02670CSR RLABL W148A 02680CSR ENDSR 02690C******************************************************************* 02700CSR SR71 BEGSR 02710CSRN45 EXSR SR75 CHECK SPACING 02720CSR EXITFZLF LF 02730CSR 1 ADD COUNT COUNT 30 LINE COUNT 02740CSR ENDSR 02750C******************************************************************* ÐÐ02760CSR SR72 BEGSR 02770CSR MOVEA' ' PRT,69 02780CSR ENDSR 02790C******************************************************************* 02800CSR SR73 BEGSR 02810C* TOP OF FORM AND HEADINGS 02820CSR EXSR SR69 TOP OF FORM 02830CSR Z-ADD1 X 02840C*----------------------------------------------------------- 02850CSR T73A TAG 02860CSR BLK70 LOKUPHDG,X 54 02870CSRN54 GOTO END73 02880CSR MOVEAHDG,X PRT,1 02890CSR X COMP 1 73 02900CSR EXSR SR80 PRINT HEADING 02910CSR SETOF 73 02920CSR 1 ADD X X 02930CSR X COMP 9 54 02940CSRN54 GOTO T73A 02950C*----------------------------------------------------------------- 02960CSR END73 TAG 02970CSR EXSR SR82 LF,LF 02980CSR ENDSR 02990C********************************************************************* 03000CSR SR74 BEGSR ÐÐ03010C* GET MESSAGE FILE 03020CSR M CHAINMGFILE H8 03030CSR H8 GOTO END 03040CSR ENDSR 03050C****************************************************************** 03060CSR SR75 BEGSR 03070C* CHECK PAGE SPACING 03080CSR 1 ADD COUNT W3N 30 03090CSR W3N COMP 45 54 54 03100CSR 54 EXSR SR73 TOP OF PAGE 03110CSR ENDSR 03120C******************************************************************* 03130CSR SR80 BEGSR 03140C* PRINT PRT ARRAY-- NO OVERLAYS 03150CSRN75N76 EXSR SR82 LF,LF 03160CSR SETON 80 03170CSR EXSR SR70 PRINT 03180CSRN76 SETON 75 03190CSR ENDSR 03200C******************************************************************** 03210CSR SR81 BEGSR 03220C* PRINT PRT ARRAY-- OVERLAY RATE,HOURS,AMOUNT, K-EDIT CODE 03230CSR 47 QTY MULT AMOUNT EXTAMT 102H 03240CSR 47 QTY MULT CUMAMT EXTCUM 90H 03250CSR 47 QTY MULT HOURS EXTHRS 71H ÐÐ03260CSRN47 Z-ADDAMOUNT EXTAMT H 03270CSRN47 Z-ADDCUMAMT EXTCUM H 03280CSRN47 Z-ADDHOURS EXTHRS H 03290CSR MOVEABLK38 PRT,33 03300CSRN75 EXSR SR82 LF,LF 03310CSR SETOF 49 03320CSRN48 SETON 49 03330CSR SETON 48 03340CSR SETON 81 03350CSR EXSR SR70 PRINT 03360CSR SETON 75 03370CSR ENDSR 03380C******************************************************************* 03390CSR SR82 BEGSR 03400CSR EXSR SR71 LF 03410CSR EXSR SR71 LF 03420CSR ENDSR 03430C****************************************************************** 03440CSR SR100 BEGSR 03450C* NEW TASK INIT 03460CSR Z-ADD0 SUBTOT 92 03470CSR Z-ADD0 HOURS 03480CSR Z-ADD0 RATE 03490CSR Z-ADD0 PCTMUL 03500CSR Z-ADD0 PERCNT ÐÐ03510CSR Z-ADD0 AMOUNT 03520CSR Z-ADD0 CUMAMT 03530CSR Z-ADD7 W2N 20 03540CSR EXIT SUBRAJ RJ QTY 03550CSR RLABL W2N 03560CSR RLABL PPQTY 03570CSR MOVE PPQTY QTY 51 03580CSR QTY COMP 0 47 03590CSRN47 Z-ADD1 QTY 03600CSR SETOF 75 03610CSR Z-ADD4 W2N 03620CSR EXIT SUBRAJ RJ 03630CSR RLABL W2N 03640CSR RLABL PPCOL 03650CSR ENDSR 03660C****************************************************************** 03670CSR SR101 BEGSR 03680C* INIT. ROUTINE 03690CSR Z-ADD0 HOURS 03700CSR Z-ADD0 RATE 03710CSR Z-ADD0 PCTMUL 03720CSR Z-ADD0 PERCNT 03730CSR Z-ADD0 AMOUNT 03740CSR Z-ADD0 EXTAMT 102 03750CSR SETOF 747778 ÐÐ03760CSR ENDSR 03770C*********************************************************************** 03780CSR SR102 BEGSR 03790C* RIGHT JUSTIFY. 03800CSR PPSIGN COMP 'R' 77 RATE IS NOT % 03810CSR Z-ADD13 W2N 20 03820CSR EXIT SUBRAJ 03830CSR RLABL W2N 03840CSR RLABL PPHRS 03850CSR MOVE PPHRS HOURS 91 LABOR HOURS 03860CSR Z-ADD8 W2N 03870CSR EXIT SUBRAJ 03880CSR RLABL W2N 03890CSR RLABL PPRATE 03900CSR 77 MOVE PPRATE RATE 52 RATE 03910CSRN77 MOVE PPRATE PERCNT 51 PER CENT 03920CSRN77 MOVE PPRATE PCTMUL 53 PERCENT MULTIPLIER 03930CSRN77 MOVE PERCNT W1A 1 03940CSRN77 W1A COMP '0' 78 03950CSR RATE COMP 0 7474 03960CSRN74 PERCNT COMP 0 7474 03970CSR Z-ADD13 W2N 03980CSR EXIT SUBRAJ 03990CSR RLABL W2N 04000CSR RLABL PPAMT ÐÐ04010CSR MOVE PPAMT AMOUNT 92 AMOUNT 04020CSR HOURS COMP 0 9494 04030CSRN94 PERCNT COMP 0 9494 04040CSRN94 RATE COMP 0 9494 04050CSRN94 AMOUNT COMP 0 9494 04060CSR ENDSR 04070C**************************************************************** 04080CSR SR109 BEGSR 04090C* PRINT SUB-TOTAL 04100CSR MOVE ' ' PRT 04110CSR SETON 82 04120CSR EXSR SR70 UNDERLINE 04130CSR SETON 83 04140CSR EXSR SR70 PRINT SUBTOTAL 04150CSR EXSR SR71 LF 04160CSR ENDSR 04170C****************************************************************** 04180CSR SR110 BEGSR 04190C* TOTAL PRICE 04200CSR SETOF 98 04210CSR MOVE ' ' PRT 04220CSR SETON 89 04230CSR EXSR SR70 PRINT TOTAL 04240CSR SETON 82 04250CSR EXSR SR70 UNDERLINE ÐÐ04260CSR EXSR SR71 LF 04270CSR SETON 90 04280CSR EXSR SR70 PRINT ROUNDED TOTAL 04290CSR SETON 82 04300CSR EXSR SR70 UNDERLINE 04310CSR MOVE '000002' W6A 6 04320CSR EXITFZVSPAC SPACE 2 1/40THS 04330CSR RLABL W6A 04340CSR EXSR SR71 LF 04350CSR SETON 82 04360CSR EXSR SR70 UNDERLINE 04370CSR MOVE '000009' W6A 04380CSR EXITFZVSPAC CHG SPACE BACK 04390CSR RLABL W6A 04400CSR END110 ENDSR 04410C****************************************************************** 04420CSR SR200 BEGSR 04430C* 1-TIME INIT 04440CSR MOVE ' ' BLK13 13 04450CSR MOVE ' ' BLK38 38 04460CSR MOVE ' ' BLK28 28 04470CSR MOVE ' ' W2A 2 04480CSR EXITFZGMINX GET PORT NO. 04490CSR RLABL W2A 04500CSR MOVE W2A PORT 20 ÐÐ04510CSR PORT COMP 0 54 04520CSRN54 Z-ADD25 PORT 04530CSR MOVE '000009' W6A 04540CSR EXITFZVSPAC SET VERTICAL SPACE 04550CSR RLABL W6A 04560CSR Z-ADD638 M 50 04570CSR EXSR SR74 GET SUB TOT HEADING 04580CSR MOVELMGTEXT TOTHDG 5 04590CSR Z-ADD639 M 04600CSR EXSR SR74 GET UNIT TOT HEADING 04610CSR MOVELMGTEXT UNTHDG 16 04620CSR Z-ADD709 M 04630CSR EXSR SR74 GET EXT TOT HEADING 04640CSR MOVELMGTEXT EXTHDG 40 04650CSR ENDSR 04660O******************************************************************* 04670OTERM50 E 44 04680O 24 'TASK NAME MISSING..ABORT' 04690O***************************************************************** 04700OCRTFILE E 80 04710O PRT 150 04720O*------------------------------------------------------------------ 04730O E 81 04740O PRT 150 04750O BLK13 121 ÐÐ04760O BLK13 131 04770O BLK13 145 04780O HOURS K 126 04790O 77 RATE K 134 '$' 04800O N77 PERCNTK 133 04810O* * * N77 78 133 ' ' 04820O 74N77 134 '%' 04830O 49 AMOUNTK 150 '$' 04840O N49 AMOUNTK 150 04850O*------------------------------------------------------------------- 04860O E 82 04870O BLK70 150 04880O 150 '_____________' 04890O*----------------------------------------------------------------- 04900O E 83 04910O BLK70 150 04920O TOTHDG 88 04930O CUMAMTJ 150 '$' 04940O*---------------------------------------------------------------- 04950O E 89 04960O BLK70 150 04970O UNTHDG 99 04980O CUMAMTJ 150 '$' 04990O*----------------------------------------------------------------- 05000O E 90 ÐÐ05010O BLK70 150 05020O EXTHDG 120 05030O EXTCUMJ 147 '$' 05040O***************************************************************** ** HDG ARRAY 05050 05060** PRT ARRAY 05070 05080/* 05090_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(KqÎ K X028BM P120282120282(èÈÐ00010H Q028BM00020F* LIST DELETE CANDIDATES. WRITE DELETE FLAG IF ON HAND IS 00030F* ZERO AND SWITCH-1,2,3,4 IS ON. 00040F* 01-19-80 05:18:PM 00050FPMMST IP F 576 12AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070IPMMST PM 01 00080I 1 100PMPN 00090I 24 35 PMMODL 00100I 36 36 USFLAG 00110I 48 76 PMDESC 00120I P 347 3500PMOHB 00130I P 519 5222PMCOST 00140I 576 576 PMSTAT 00150C PMSTAT COMP 'D' 54 00160C N54 USFLAG COMP ' ' 54 00170C 54 SETOF 01 00180C 01 PMOHB MULT PMCOST EXTCST 92 00190C 01 EXTCST ADD TOTCST TOTCST 102 00200OPRINT H 201 1P 00210O OR OF 00220O 70 'PECULIAR PARTS LIST' 00230O UDATE Y 8 00240O 115 'PAGE' 00250O PAGE Z 120 ÐÐ00260O H 2 1P 00270O OR OF 00280O 11 'PART NUMBER' 00290O 25 'DESCRIPTION' 00300O 50 'MODEL' 00310O 70 'COST' 00320O 90 'ON-HAND-STOCK' 00330O 110 'EXTENDED COST' 00340O D 1 01 00350O PMPN 12 ' - - ' 00360O PMDESC 43 00370O PMMODL 57 00380O PMCOST2 70 00390O PMOHB J 90 00400O EXTCSTJ 110 00410O T 11 LR 00420O TOTCSTJ 110 /* 000430_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(?qï ?ðXHELLO P999999120282(èÈÐ00010H HELLO 00020F* USER SIGN-ON ROUTINE. (XHELLO) 00030F* REVISED 7-25-82 11:45 AM. DG-132-1-OK 00040F* 00050FBITPAR IP F 90 DISK 00060FEMPLFILEID F 64L14AI 1 DISK 00070FCRTFILE UC F 256R DISK 00080FJOBFILE IC F 48R 7AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FTERM52 O F 52 5 00110FTERM12 O F 12 5 00120E******************************************************************** 00130E NUL 1 52 1 00140E A6 1 6 1 00150E A10 1 10 1 A 00160E PRG 1 84 6 00170E ITM 1 84 3 0 00180E N10 1 10 1 00190E CALL 7 6 00200E BIT 33 1 00210E PAR 25 1 00220E TST 25 1 00230I******************************************************************** 00240IBITPAR BT 01 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************** 00290IEMPLFILEEE 02 1 CE 00300I* RECORD CODE 2A 00310I* E = EMPLOYEE/USER CROSS-REF 00320I* U = USER/EMPLOYEE CROSS-REF 00330I* J = EMPLOYEE/JOB 00340I 1 1 EREC 00350I* EMPLOYEE # 5N 00360I 2 60EEEMPL 00370I* USER-ID 8A 00380I 15 22 EEUSER 00390I* EMPLOYEE NAME 20A 00400I 23 42 EENAME 00410I* EMPLOYEE DEPT # 5N 00420I 43 470EEDEPT 00430I* RECORD STATUS 1A 00440I 64 64 EESTAT 00450I*------------------------------------------------------------------- 00460I EU 03 1 CU 00470I 1 1 EREC 00480I 2 9 EUUSER 00490I 15 190EUEMPL 00500I 64 64 EUSTAT ÐÐ00510I*------------------------------------------------------------------- 00520I EJ 04 1 CJ 00530I 1 1 EREC 00540I 2 60EJEMPL 00550I 7 90EJSEQ 00560I 15 49 EJDESC 00570I 50 55 EJJOB 00580I 64 64 EJSTAT 00590I*------------------------------------------------------------------- 00600I EG 10 00610I* GARBAGE RECORD. 00620I 1 1 EREC 00630I******************************************************************** 00640IJOBFILE JN 05 1 CN 00650I* RECORD CODE 1A 00660I* N = JOB NAME RECORD 00670I 1 1 JNREC 00680I* JOB NAME 6A 00690I 2 7 JNJOB 00700I* JOB DESCRIPTION 35A 00710I 8 42 JNDESC 00720I* RECORD STATUS 1A 00730I 48 48 JNSTAT 00740I*------------------------------------------------------------------- 00750I JG 10 ÐÐ00760I* GARBAGE RECORD. 00770I 1 1 JNREC 00780I******************************************************************** 00790IMGFILE MG 00800I* MESSAGE FILE 00810I* TEXT 35A 00820I 1 35 MGTEXT 00830I* LINE-2 35A 00840I 36 70 MGLIN2 61 00850I* PROG NAME 5A 00860I 71 75 MGPROG 00870I******************************************************************** 00880ICRTFILE CR 00890I 1 50CREMPL 00900I 6 13 CRUSER 00910I 14 18 CRDEPT 00920I 19 26 CRJOB 00930I 27 27 CRSHUT 00940I 28 330CRTIME 00950I 34 370CRDATE 00960I 38 79 CALL 00970C******************************************************************** 00980C START TAG 00990C* INITIALIZE - CLEAR CRT - PUT SIGN-ON MESSAGE. 01000C EXSR SR201 INIT. ÐÐ01010C 86 GOTO UPDCRT SHUTDOWN 01020C H9 GOTO ENDJOB ERROR 01030C*------------------------------------------------------------------- 01040C USER TAG 01050C* READ USER-ID FROM CRT. 01060C N71 EXSR SR76 POSITION CURSOR 01070C SETOF 949677 01080C MOVE BIT,6 A6,2 01090C MOVEAA6 W6A 6 01100C MOVE BLK10 W10A 10 01110C EXITFQSREED 01120C RLABL W10A 01130C RLABL W6A 01140C MOVEAW10A A10 01150C '\' LOKUPA10 94 01160C 94 GOTO UPDCRT GOODBY 01170C Z-ADD1 W 30 01180C ' ' LOKUPA10,W 54 01190C N54 GOTO USER 01200C MOVE BLK10 W10A 01210C MOVEAA10,W W10A 01220C MOVELW10A USERID 8 01230C USERID COMP BLK8 55 01240C N55 GOTO USER 01250C*------------------------------------------------------------------- ÐÐ01260C MENU TAG 01270C SETOF 949677 01280C EXSR SR102 GET/PUT MENU. 01290C 96 EXSR SR73 PUT ERR MSG. 01300C 96 GOTO USER ERROR. 01310C* BRANCH IF DIABLO 01320C 71 MOVEL'Q005JQ' PROG 8 01330C 71 MOVEL'Q005JQ' JOB 8 01340C 71 GOTO UPDCRT 01350C*------------------------------------------------------------------ 01360C READ TAG 01370C SETON 76 01380C EXSR SR75 READ SELECTION. 01390C SETOF 76 01400C 94 GOTO UPDCRT GOODBY 01410C N77 GOTO READ NO INPUT. 01420C EXSR SR103 SET-UP PROG. 01430C 96 EXSR SR73 PUT ERR MSG. 01440C 96 GOTO READ ERROR. 01450C*------------------------------------------------------------------- 01460C END TAG 01470C PROG COMP BLK8 54 01480C N54 GOTO START PROG NAME EMPTY 01490C*------------------------------------------------------------------- 01500C UPDCRT TAG ÐÐ01510C # CHAINCRTFILE H9 01520C H9 GOTO ENDJOB 01530C TIME CRTIME TIME OF DAY (IN) 01540C MOVELUDATE CRDATE 01550C MOVE BLK6 CALL 01560C 94 MOVE BLK8 PROG 8 01570C 94 MOVEL'GOODBY' PROG 01580C 94 MOVE PROG JOB 01590C N86 CRSHUT COMP ' ' 86 SHUTDOWN 01600C 86 MOVE 'SHUTDOWN'JOB 8 01610C 86 MOVE JOB PROG 8 01620C SETON 85 01630C EXCPT REWRITE CRTFILE 01640C SETOF 85 01650C SETON LR 01660C*------------------------------------------------------------------- 01670C LINK TAG 01680C N50 EXITFQTOPF CLEAR SCREEN 01690C 50 EXITFZESCH CLEAR SCREEN 01700C EXITFCHAIN LOAD PROGRAM. 01710C RLABL PROG 01720C*------------------------------------------------------------------- 01730C ENDJOB TAG 01740C SETON LR 01750C******************************************************************** ÐÐ01760CSR SR70 BEGSR 01770C* CLEAR CRT. 01780CSR 50 EXITFZISTAT CLEAR STATUS LINE 01790CSRN71N50 EXITFQTOPF CLEAR CRT 01800CSRN71 50 EXITFZESCH CLEAR CRT 01810CSR SETON 70 01820CSR EXCPT CLEAR CRT. 01830CSR SETOF 70 01840CSR ENDSR 01850C******************************************************************** 01860CSR SR73 BEGSR 01870C* PUT ERR MSG. 01880CSR EXSR SR89 GET MSG. 01890CSR EXSR SR74 PUT MSG. 01900CSR ENDSR 01910C******************************************************************** 01920CSR SR74 BEGSR 01930C* PUT MSG. 01940CSR SETON 74 01950CSR EXCPT PUT MSG. 01960CSR SETOF 74 01970CSR MOVE 'X' FLAG 1 01980CSR ENDSR 01990C******************************************************************** 02000CSR SR75 BEGSR ÐÐ02010C* SET CURSOR. 02020CSR EXSR SR76 POSITION CURSOR 02030CSR SETOF 949677 02040C* READ FROM CRT. 02050CSR MOVE BIT,6 A6,2 BUF LGTH. 02060CSR MOVEAA6 W6A 6 02070CSR MOVE BLK10 W10A 10 02080CSR EXITFXCREAD READ CRT. 02090CSR RLABL W10A BUF. 02100CSR RLABL W6A BUF LGTH. 02110CSR MOVE BLK35 MGTEXT 02120CSR EXSR SR74 INIT ERR MSG 02130CSR MOVEAW10A A10 02140CSR MOVE BLK10 W10A 02150CSR '\' LOKUPA10 90 02160CSR 90 'G' LOKUPA10 94 02170CSR 90N94 'E' LOKUPA10 94 02180CSR 94 GOTO UPDCRT GOOD-BY 02190CSR Z-ADD1 W 30 02200CSR ' ' LOKUPA10,W 77 02210CSR MOVEAA10,W W10A 02220CSRN76 MOVELW10A USERID 8 USER-ID. 02230CSRN76 GOTO END75 02240CSR Z-ADD10 W2N 20 02250CSR EXIT SUBRAJ ÐÐ02260CSR RLABL W2N 02270CSR RLABL W10A 02280CSR MOVE W10A SELECT 30 SELECTION #. 02290C*------------------------------------------------------------------- 02300CSR END75 TAG 02310CSR FLAG COMP ' ' 54 02320CSR 54 MOVE BLK35 MGTEXT 02330CSR 54 MOVE ' ' FLAG 1 02340CSR 54 EXSR SR74 02350CSR ENDSR 02360C********************************************************************** 02370CSR SR76 BEGSR 02380C* BLANK OUT USER-ID CODE JUST INPUT 02390CSR SETON 75 02400CSR EXCPT POSITION CURSOR 02410CSR SETOF 75 02420CSR ENDSR 02430C********************************************************************** 02440CSR SR89 BEGSR 02450C* GET MGFILE. 02460CSR M CHAINMGFILE 60 02470CSR 60 MOVE BLK35 MGTEXT 02480CSR 60 MOVEL'M' MGTEXT 02490CSR 60 MOVE 'NO-FILE' MGTEXT 02500CSR ENDSR ÐÐ02510C******************************************************************** 02520CSR SR101 BEGSR 02530C* INITIALIZE. 02540CSRN69 EXSR SR201 INIT/GET CRTFIL 02550CSR MOVE ' ' BLK35 35 02560CSR MOVE ' ' BLK6 6 02570CSR MOVE ' ' BLK10 10 02580CSR ENDSR 02590C******************************************************************** 02600CSR SR102 BEGSR 02610C* GET EMPLOYEE NUMBER. 02620CSR EXSR SR202 GET EMPLOYEE #. 02630CSR 96 GOTO END102 ERROR. 02640CSR 71 GOTO T102C DIABLO 02650CSR MOVE BLK14 W14A 02660CSR MOVEL'J' W6A 02670CSR MOVE EUEMPL W6A 02680CSR MOVELW6A W14A 02690CSR W14A SETLLEMPLFILE SET LOW LIMIT. 02700CSR Z-ADD0 P 30 PRG INDEX. 02710CSR SETOF 81 02720C*------------------------------------------------------------------- 02730CSR T102A TAG 02740C* GET MENU (EMPLFILE) AND DISPLAY. 02750CSR SETOF 54 ÐÐ02760CSR READ EMPLFILE 54 GET MENU. 02770CSR 54 GOTO T102B END OF FILE. 02780CSR EREC COMP 'J' 54 02790CSR 54 EJEMPL COMP EMPLOY 54 02800CSRN54 GOTO T102B NO MATCH. 02810CSR EJSTAT COMP 'D' 54 02820CSR 54 GOTO T102A DELETED. 02830CSR 1 ADD P P 02840CSR MOVE EJJOB PRG,P SAVE JOB NAME. 02850CSR Z-ADDEJSEQ ITM,P 02860CSR Z-ADDP E 30 02870CSR EXSR SR203 SET X-Y POS. 02880CSR P COMP 23 54 02890CSRN54 P COMP 46 54 02900CSRN54 P COMP 69 54 02910CSR SETON 7281 02920CSR EXCPT PUT MENU. 02930CSR SETOF 72 02940CSR P COMP 69 54 02950CSRN54 GOTO T102A 02960C*------------------------------------------------------------------- 02970CSR T102B TAG 02980CSR 81 GOTO T102C 02990CSR P COMP 0 54 03000CSRN54 Z-ADD306 M 50 96 FLAG ERROR. ÐÐ03010CSRN54 GOTO END102 03020C*------------------------------------------------------------------- 03030CSR T102C TAG 03040C* GET EMPLOYEE 'EE' RECORD. 03050CSR MOVE BLK14 W14A 03060CSR MOVEL'E' W6A 03070CSR MOVE EMPLOY W6A 03080CSR MOVELW6A W14A 03090CSR W14A SETLLEMPLFILE 03100CSR READ EMPLFILE 03110CSR MOVE EEDEPT DEPT 5 03120CSR 71 GOTO END102 DIABLO 03130C* PUT REQUEST SELECTION MSG. 03140CSR SETON 73 03150CSR EXCPT PUT SELECT RQST 03160CSR SETOF 73 03170CSR END102 ENDSR 03180C******************************************************************** 03190CSR SR103 BEGSR 03200C* SET-UP PROG NAME. 03210CSR SELECT COMP 0 54 03220CSR 54 SELECT COMP E 5454 03230CSRN54 Z-ADD306 M 96 FLAG ERR. 03240CSR 54 Z-ADDSELECT P 03250CSR 54 MOVELPRG,P PROG 8 PROG NAME. ÐÐ03260CSR MOVELPROG JOB 8 03270CSR ENDSR 03280C******************************************************************** 03290CSR SR201 BEGSR 03300C* GET CRTFIL. 03310CSR SETOF 96 03320CSR SETON 69 03330CSR MOVE BLK8 W8A 8 03340CSR Z-ADD0 W2N 20 03350CSR Z-ADD0 W1N 10 03360CSR MOVE ' ' W2A 2 03370CSR EXITFZGMINX 03380CSR RLABL W2A PORT. 03390CSR MOVE W2A # 20 03400CSR # COMP 0 54 03410CSRN54 Z-ADD25 # MASTER TERMINAL 03420CSR PAR,# COMP '1' 50 03430CSR TST,# COMP 'S' 87 03440CSR 87 SETON 86 03450CSR 87 MOVE 'SHUTDOWN'PROG 03460CSR 87 GOTO LINK 03470CSR # CHAINCRTFILE H9 GET CRTFILE 03480CSR H9 GOTO END201 PROG ERROR 03490CSR # COMP 7 71 FLAG DIABLO 03500CSR MOVE BLK6 CALL ÐÐ03510CSR MOVELUDATE CRDATE 03520CSR CRSHUT COMP ' ' 86 FLAG SHUTDOWN 03530CSR MOVEL'HELLO ' JOB 03540CSR TIME CRTIME TIME IN 03550CSR 86 MOVE 'SHUTDOWN'JOB 03560CSR SETON 85 03570CSRNLR EXCPT POST TIME IN 03580CSR SETOF 85 03590CSR 86 GOTO LINK 03600CSR MOVE ' ' BLK8 8 03610CSR MOVE BIT,1 A6 03620CSR MOVE BIT,1 NUL 03630CSR MOVE ' ' BLK14 14 03640CSR MOVE ' ' BLK35 35 03650CSR MOVE BIT,1 N10 03660CSR MOVE ' ' BLK10 10 03670CSR MOVE ' ' BLK33 33 03680CSR EXSR SR70 CLEAR CRT 03690CSR END201 ENDSR 03700C******************************************************************** 03710CSR SR202 BEGSR 03720C* GET EMPLOYEE #. 03730CSR MOVE BLK14 W14A 03740CSR MOVEL'U' W9A 9 03750CSR MOVE USERID W9A ÐÐ03760CSR MOVELW9A W14A 14 03770CSR W14A SETLLEMPLFILE 03780CSR SETOF 54 03790CSR READ EMPLFILE 54 READ EMPLFILE. 03800CSR 54 GOTO T202A END OF FILE. 03810CSR EUUSER COMP USERID 54 03820CSRN54 GOTO T202A NOT ON FILE. 03830CSR EUSTAT COMP 'D' 54 03840CSR 54 GOTO T202A 03850CSR Z-ADDEUEMPL EMPLOY 50 EMPLOYEE #. 03860CSR MOVE EUUSER USERID 8 SAVE USER CODE. 03870CSR GOTO END202 03880C*------------------------------------------------------------------- 03890CSR T202A TAG 03900C* FLAG INVALID USER CODE. 03910CSR Z-ADD307 M 96 03920CSR END202 ENDSR 03930C******************************************************************** 03940CSR SR203 BEGSR 03950C* SET CURSOR POSITION. 03960CSR P COMP 1 55 1ST COL 03970CSR P COMP 23 56 2ND COL 03980CSR P COMP 46 57 3RD COL 03990CSR 56 SETOF 55 04000CSR 57 SETOF 5655 ÐÐ04010CSR 1 ADD P LN 30 04020CSR 56 LN SUB 23 LN 04030CSR 57 LN SUB 46 LN 04040CSR 55 Z-ADD1 CN 30 04050CSR 56 Z-ADD47 CN 04060CSR 57 Z-ADD93 CN 04070CSR MOVE LN LA 3 04080CSR MOVE CN CA 3 04090CSR ENDSR 04100O******************************************************************** 04110OTERM12 E 75 04120O* SET CURSOR FOR READ. 04130O BIT,28 1 04140O N50 2 '8' 04150O N50 8 '001022' 04160O 50 2 '[' 04170O 50 5 '001' 04180O 50 BIT,28 6 04190O 50 10 '022' 04200O 50 7 ']' 04210O BIT,1 11 04220O BIT,1 12 04230O******************************************************************** 04240OTERM52 E 72 04250O* PUT MENU. ÐÐ04260O NUL 52 04270O BIT,28 1 04280O N50 2 '8' 04290O N50 LA 5 04300O N50 CA 8 04310O 50 2 '[' 04320O 50 LA 5 04330O 50 BIT,28 6 04340O 50 7 ']' 04350O 50 CA 10 04360O P Z 13 04370O 15 ' ' 04380O EJDESC 50 04390O 54 BIT,28 51 04400O 54 52 'K' 04410O*------------------------------------------------------------------- 04420O E 74 04430O* PUT ERROR MESSAGE. 04440O NUL 52 04450O N71 BIT,28 1 04460O N71N50 2 '8' 04470O N71N50 8 '002082' 04480O N71 50 5 '[002' 04490O N71 50 BIT,28 6 04500O N71 50 10 ']082' ÐÐ04510O MGTEXT 45 04520O*------------------------------------------------------------------- 04530O E 70 04540O* REQUEST USER NAME. 04550O NUL 52 04560O BIT,28 1 04570O N50 8 '8001001' 04580O 50 5 '[001' 04590O 50 BIT,28 6 04600O 50 10 ']001' 04610O 30 'ENTER USER-ID CODE ' 04620O BIT,8 52 04630O*------------------------------------------------------------------- 04640O E 73 04650O* REQUEST SELECTION #. 04660O NUL 52 04670O BIT,28 1 04680O N50 2 '8' 04690O N50 8 '001001' 04700O 50 5 '[001' 04710O 50 BIT,28 6 04720O 50 10 ']001' 04730O 29 'ENTER SELECTION NO.' 04740O 44 ' ' 04750O BIT,8 52 ÐÐ04760O*------------------------------------------------------------------- 04770O E 85 86 04780O 23 'SYSTEM IS NOT AVAILABLE' 04790O 36 'AT THIS TIME' 04800O******************************************************************** 04810OCRTFILE E 85 04820O 86 BLK33 33 04830O 86N87 27 'X' 04840O EMPLOY 5 04850O USERID 13 04860O DEPT 18 04870O JOB 26 04880O CRTIME 33 04890O CRDATE 37 04900O CALL 79 04910O 79 'CONTU ' ** NUL ARRAY 004920 004930** A6 ARRAY 004940 004950** A10 ARRAY 004960 004970** ITM ARRAY 004980 004990** PRG ARRAY 005000ÐÐ 005010** N10 ARRAY 005020 005030/* 005040_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( rà X029BM P120282120282(èÈÐ00010H Q029BM00020F* INIT USAGE FLAG PMMST COL 36-37 00030FPMMST UP F 576 12AI 1 DISK 00040IPMMST PM 01 00050I 36 37 USFLAG 00060OPMMST D 01 00070O 37 ' ' /* 000080_‚ _‚_‚ ÐÈ(dræ d*X030BM P120282120282(èÈÐ00010H Q030BM00020F* DELETE BILLS OF MATERIAL FOR PART # W/USAGE FLAG 00030F* (SEE Q017,26,27,28 BM) 00040FPMMST UP F 576 12AI 1 DISK 00050FBMMAST UD F 86L20AI 1 DISK 00060FBMWU UC F 21R20AI 1 DISK 00070FTERM80 O F 80 5 00080E MSG 1 2 70 00090I***************************************************************** 00100IPMMST PM 01 00110I 1 100PMPN 00120I 36 36 USFLAG 00130I**************************************************************** 00140IBMMAST BM 00150I 1 100BMAPN 00160I 11 200BMCPN 00170I 86 86 BMSTAT 00180I**************************************************************** 00190IBMWU WU 00200I 1 100BWCPN 00210I 11 200BWAPN 00220I 21 21 BWSTAT 00230C**************************************************************** 00240C SETOF 7071 00250C 76 GOTO BEGIN ÐÐ00260C SETON 7576 00270C EXCPT 00280C SETOF 75 00290C EXITFQHALT 00300C BEGIN TAG 00310C Z-ADD0 ZERO10 100 00320C USFLAG COMP 'X' 01 00330C N01 GOTO END 00340C MOVELPMPN W20A 20 00350C MOVE ZERO10 W20A 00360C W20A SETLLBMMAST 00370C*---------------------------------------------------------------- 00380C START TAG 00390C SETOF 54 00400C READ BMMAST 54 00410C 54 GOTO END 00420C BMSTAT COMP 'D' 54 00430C 54 GOTO START 00440C BMAPN COMP PMPN 54 00450C N54 GOTO END 00460C SETON 70 00470C MOVELBMCPN W20A 00480C MOVE BMAPN W20A 00490C W20A CHAINBMWU 60 00500C N60 SETON 71 ÐÐ00510C SETON 80 00520C EXCPT 00530C SETOF 80 00540C GOTO START 00550C*--------------------------------------------------------------- 00560C END TAG 00570O***************************************************************** 00580OPMMST D 01 00590O 576 'D' 00600O*************************************************************** 00610OBMMAST E 80 00620O 86 'D' 00630O*************************************************************** 00640OBMWU E 80N60 00650O 21 'D' 00660OTERM80 D 01 00670O PMPN 12 ' - - ' 00680O N71 25 'NO WU' 00690O N70 35 'NO BM' 00700O E 75 00710O MSG,1 70 00720O E 75 00730O MSG,2 70 ** MSG 000740THIS PROG DELETES OBSOLETE PMMST AND BMMST REC-- CANCEL IF YOU DO NOT 000750ÐÐUNDERSTAND WHAT YOU ARE DOING!!!!!!!!!!!!!!!!! 000760/* 000770_‚ ÐÐ_‚_‚RSTAND WHAT YOU ARE DOING!!!!!!!!!!!!!!!!! 000760/* 000770_‚ ÐÈ(s  X030DP P120282120282(èÈÐ00010H Q030DP00020F* REORG PART MAST FILE. (X030DP) 00030F* CREATED 5/21/79 10:35 PM. 00040FOLDPM IP F 674 674 12AI 1 DISK 00050FPMMST2 O F 674 674 12AI 1 DISK 00060IOLDPM PM 01 674NCD 00070I 1 256 REC1 00080I 257 512 REC2 00090I 513 674 REC3 00100I GG 02 00110OPMMST2 D 01 00120O REC1 256 00130O REC2 512 00140O REC3 674 /* 000150_‚ _‚_‚ ÐÈ(–s –?X030DX P120282120282(èÈÐ00010H Q030DX00020F* TEXT RESEQUENCE - PHASE-2. (X030DX) 00030F* REVISED 10/03/79 8:45 PM. 00031F* NOTE: THIS IS A COPY OF X030TX. 00040FBITTAB IP F 33 DISK 00050FTEXTSEQ UD F 23 DISK 00060FTEXTPTR UC F 16R12AI 1 DISK A 00070FTEXTFILEUC F 155R DISK 00080FCRTFILE UC F 256R DISK 00090E******************************************************************** 00100E BIT 33 1 00110E TXT 132 1 A 00120I******************************************************************* 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160ICRTFILE CR 00170I P 222 2250CRFLIN 00180I 240 245 CRNAME 00190I P 250 2510CRINCR 00200I******************************************************************** 00210ITEXTPTR TP 00220I* TEXT POINTER FILE. 00230I* TEXT NAME 6A 00240I 1 6 TPNAME ÐÐ00250I* LINE # 6N 00260I 7 120TPLINE 00270I* POINTER 7P 00280I P 13 160TPPTR 61 00290I******************************************************************** 00300ITEXTFILETX 00310I* TEXTFILE RECORD. 00320I* NAME 6A 00330I 1 6 TXNAME 00340I* LINE # 6N 00350I 7 120TXLINE 00360I* TEXT 1A X 132 00370I 13 144 TXT 00380I* TEXT TYPE 1A 00390I 145 145 TXTYPE 00400I* HEAD/FOOTNOTE LINE 1A 00410I 146 146 TXHFLN 00420I* SPACE CODE 1A 00430I 147 147 TXSPAC 00440I* BACKWARD PTR (DELETE) 7P 00450I P 148 1510TXBPTR 00460I* RECORD STATUS 1A 00470I 155 155 TXSTAT 00480I******************************************************************** 00490ITEXTSEQ TS ÐÐ00500I 1 6 TSNAME 00510I 7 120TSOLIN 00520I 13 180TSNLIN 00530I P 19 220TSPTR 88 00540I 23 23 TSSTAT 00550C******************************************************************** 00560C* INITIALIZE. 00570C N89 EXSR SR101 00580C*-------------------------------------------------------------------- 00590C START TAG 00600C SETOF 54 00610C READ TEXTSEQ 54 00620C 54 GOTO END 00630C 88 GOTO START 00640C MOVELTSNAME W12A 12 00650C MOVE TSNLIN W12A 00660C W12A CHAINTEXTPTR 60 00670C TSPTR CHAINTEXTFILE 61 00680C 61 GOTO START 00690C SETON 81 00700C EXCPT UPDATE TEXT. 00710C SETOF 81 00720C GOTO START 00730C*------------------------------------------------------------------- 00740C END TAG ÐÐ00750CLR SETON 97 00760CLR EXCPT UPDATE CRTFILE 00770CLR SETOF 97 00780CLR MOVEL'Q002TX' PROG 8 00790CLR EXITFCHAIN 00800CLR RLABL PROG 00810C******************************************************************** 00820CSR SR101 BEGSR 00830C* 1-TIME INIT 00840CSR SETON 89 00850CSR MOVE ' ' W8A 8 00860CSR Z-ADD0 W1N 10 00870CSR Z-ADD0 W2N 20 00880CSR MOVE ' ' W2A 2 00890CSR EXITFPGMINX 00900CSR RLABL W8A 00910CSR RLABL W2N 00920CSR RLABL W1N 00930CSR RLABL W2A 00940CSR MOVE W2A PORT 20 00950CSR PORT COMP 0 54 00960CSRN54 Z-ADD25 PORT 00970CSR PORT CHAINCRTFILE H9 00980CSR ENDSR 00990O******************************************************************** ÐÐ01000OCRTFILE E 97 01010O CRFLIN 225P 01020O CRINCR 251P 01030O******************************************************************** 01040OTEXTFILEE 81 01050O W12A 12 01060O******************************************************************** 01070OTEXTPTR EADD 81 60 01080O W12A 12 01090O TSPTR 16P 01100O*------------------------------------------------------------------- 01110O E 81N60 01120O TSPTR 16P 01130O******************************************************************** 01140OTEXTSEQ E 81 01150O 23 'D' /* 001160_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(s[ §X021RX P120282120282(èÈÐ00010H Q021RX00020F* ROUTING TEXT SEQUENCE PROGRAM. (X021RX) DG REL006 OK 00030F* REVISED 12-01-82 11:55 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060FREXTPTR UD F 25L21AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FREXTSEQ O F 32 DISK 00090FTERM37 O F 37 5 00100E******************************************************************** 00110E A6 6 6 1 00120E A20 20 20 1 A 00130E A44 44 44 1 00140E SAV 20 20 1 00150E BIT 33 1 00160E CALL 5 6 00170E CTX 60 1 A 00180E TXT 60 1 A 00190I******************************************************************* 00200IBITTAB BT 00210I 1 33 BIT 00220I********************************************************************* 00230IMGFILE MG 00240I 1 35 MGTEXT 00250I********************************************************************** ÐÐ00260ICRTFILE CR 00270I* MENU FIELDS 1 33 XXXXXX 00280I* CURRENT JOB 6A 00290I 21 26 CRJOB 00300I* CALLED BY PROG 6A 00310I 68 73 CRRET 00320I* CALL STACK 6A X 5 00330I 38 67 CALL 00340I* MENU NAME 6A 00350I 74 79 CRMENU 00360I*------------------------------------------------------------------- 00370I* PART # 12A 00380I 80 91 CRPN 00390I* OPER SEQ # 3N 00400I 92 940CRSEQ 00410I* TEXT WORK AREA 1A X 60 00420I 95 154 CTX 00430I* TEXT TYPE 1A 00440I 212 212 CRTYPE 00450I* HEAD LINE # 1N 00460I 213 2130CRHFLN 00470I* SPACE 1A 00480I 214 214 CRSPAC 00490I* CUR INSTR 1A 00500I 215 215 CRTRAN ÐÐ00510I* COPY FROM TEXT 6A 00520I 216 221 CRFTXT 00530I* COPY FROM LINE 7P 00540I P 222 2250CRFLIN 00550I* COPY THRU LINE 7P 00560I P 226 2290CRELIN 00570I* COPY TO TEXT 6A 00580I 230 235 CRTTXT 00590I* COPY TO LINE 7P 00600I P 236 2390CRTLIN 00610I* CURRENT LINE # 7P 00620I P 246 2490CRCLIN 00630I* LINE INCREMENT 3P 00640I P 250 2510CRINCR 00650I******************************************************************** 00660IREXTPTR TP 00670I* TEXT POINTER FILE. 00680I* TEXT KEY 15A 00690I 1 15 TPKEY 00700I* LINE # 6N 00710I 16 210TPLINE 00720I* POINTER 7P 00730I P 22 250TPPTR 61 00740C******************************************************************** 00750C* INITIALIZE. ÐÐ00760C EXSR SR101 INIT. 00770C H9 GOTO END PROG ERROR. 00780C MOVELCRPN CRKEY 15 00790C MOVE CRSEQ CRKEY 00800C*------------------------------------------------------------------- 00810C START TAG 00820C SETOF 9687 00830C* PROMPT/READ: TEXT NAME, LINE FROM, ENDING LINE, INCREMENT. 00840C EXSR SR102 PROMPT/READ 00850C 96 GOTO START ERROR. 00860C 98 GOTO GOODBY 00870C 94 GOTO MENU 00880C 93 GOTO NEWITM 00890C* GET TEXT. 00900C MOVELCRKEY FROM 21 00910C MOVE CRFLIN W6A 6 00920C MOVE W6A FROM 00930C Z-ADDCRELIN ELINE 60 00940C Z-ADDCRFLIN FLINE 60 00950C Z-ADDCRFLIN NEWLIN 60 00960C FROM SETLLREXTPTR 00970C*-------------------------------------------------------------------- 00980C TAG10 TAG 00990C* READ REXTPTR FILE. STORE PTR'S. INIT FILE PTR. 01000C SETOF 54 ÐÐ01010C READ REXTPTR 54 01020C 54 GOTO DONE END FILE. 01030C 61 GOTO TAG10 NO PTR. 01040C TPKEY COMP CRKEY 54 01050C N54 GOTO DONE 01060C TPLINE COMP ELINE 54 01070C 54 GOTO CONTU 01080C 99 CRINCR ADD NEWLIN NEWLIN 60 01090C Z-ADDNEWLIN LASTL 60 01100C EXSR SR84 OUTPUT REXTSEQ. 01110C GOTO TAG10 01120C*------------------------------------------------------------------- 01130C CONTU TAG 01140C TPLINE COMP LASTL 54 01150C 54 GOTO DONE 01160C 2 ADD NEWLIN NEWLIN 01170C Z-ADDNEWLIN LASTL 60 01180C EXSR SR84 OUTPUT REXTSEQ. 01190C GOTO TAG10 01200C*-------------------------------------------------------------------- 01210C DONE TAG 01220C MOVEL'Q030RX' PROG 8 01230C GOTO END 01240C*------------------------------------------------------------------- 01250C NEWITM TAG ÐÐ01260C MOVEL'Q002RX' CRRET 01270C GOTO END 01280C*------------------------------------------------------------------- 01290C MENU TAG 01300C GOTO NEWITM 01310C*------------------------------------------------------------------- 01320C GOODBY TAG 01330C MOVEL'GOODBY' CRRET 01340C GOTO END 01350C*------------------------------------------------------------------- 01360C END TAG 01370C PROG COMP BLK8 54 01380C N54 MOVEL'Q030RX' PROG 01390C Z-ADDCRELIN CRCLIN 01400C 99 MOVEL'Q030RX' PROG 01410C SETON 97 01420C EXCPT UPDATE CRTFILE 01430C SETOF 97 01440C EXITFCHAIN 01450C RLABL PROG 01460C*------------------------------------------------------------------- 01470C ENDJOB TAG 01480C******************************************************************** 01490CSR SR73 BEGSR 01500C* PUT MESSAGE TO SCREEN ÐÐ01510CSR SETON 73 01520CSR EXCPT PUT MSG 01530CSR SETOF 73 01540CSR ENDSR 01550C******************************************************************** 01560CSR SR75 BEGSR 01570C* READ 20-BYTES FROM SCREEN. 01580CSR SETOF 969098 01590CSR SETOF 949392 01600CSR SETOF 77 01610CSR MOVE BIT,1 A6 01620CSR MOVE BIT,11 A6,2 01630CSR MOVEAA6 W6A 6 01640CSR MOVE BLK20 W20A 20 01650CSR EXITFQWREED READ TERMINAL. 01660CSR RLABL W20A 01670CSR RLABL W6A 01680CSR MOVEAW20A A20 01690CSR MOVE BLK20 W20A 01700CSR Z-ADD1 W 30 01710CSR '\' LOKUPA20,W 90 01720CSRN90 GOTO T75B NO ESCAPE 01730CSR 1 ADD W W 01740CSR W COMP 20 54 01750CSR 54 GOTO T75A BAD ESC ÐÐ01760CSR A20,W COMP 'G' 98 GOODBY 01770CSR A20,W COMP 'E' 94 MENU 01780CSR A20,W COMP 'N' 93 NEW ITEM 01790CSR A20,W COMP 'D' 92 DONE 01800CSR 98 01810COR 94 01820COR 93 01830COR 92 GOTO END75 01840C*----------------------------------------------------------------- 01850CSR T75A TAG 01860C* FLAG BAD ESC CODE. 01870CSR Z-ADD318 M 50 96 FLAG ERROR. 01880CSR EXSR SR999 01890CSR GOTO END75 01900C*------------------------------------------------------------------- 01910CSR T75B TAG 01920CSR Z-ADD1 W 01930CSR ' ' LOKUPA20,W 77 01940CSR 77 MOVEAA20,W W20A 01950C*------------------------------------------------------------------- 01960CSR END75 ENDSR 01970C******************************************************************* 01980CSR SR84 BEGSR 01990C* OUTPUT REXTSEQ RECORD 02000CSR SETON 8499 ÐÐ02010CSR EXCPT OUTPUT REXTSEQ 02020CSR SETOF 84 02030CSR ENDSR 02040C****************************************************************** 02050CSR SR89 BEGSR 02060C* GET MESSAGE MAST 02070CSR M CHAINMGFILE 54 02080CSR ENDSR 02090C*********************************************************************** 02100CSR SR101 BEGSR 02110C* 1-TIME INITIALIZE 02120CSR MOVE BIT,1 A6 02130CSR MOVE ' ' W2A 2 02140CSR EXITFZGMINX GET PORT # 02150CSR RLABL W2A 02160CSR MOVE W2A PORT 20 02170CSR PORT CHAINCRTFILE H9 02180CSR H9 GOTO ENDJOB PROG ERROR 02190CSR MOVE BLK6 CRRET 02200C* DEFINE WORK FIELDS. 02210CSR MOVE ' ' BLK8 8 02220CSR MOVE ' ' BLK6 6 02230CSR MOVE ' ' BLK10 10 02240CSR Z-ADD0 ZERO7 70 02250CSR MOVE ' ' BLK35 35 ÐÐ02260CSR MOVE ' ' BLK20 20 02270CSR MOVE ' ' BLK66 66 02280CSR END101 ENDSR 02290C******************************************************************** 02300CSR SR102 BEGSR 02310C* PROMPT/READ: FROM LINE#,END LINE#, INCREMENT 02320CSR Z-ADD0 CRFLIN FROM LINE# 02330CSR Z-ADD0 CRELIN ENDING LINE# 02340C*------------------------------------------------------------------ 02350CSR T102A TAG 02360CSR SETOF 96 02370CSR Z-ADD253 M MSG # 02380CSR EXSR SR89 GET MSG 02390CSR SETON 69 02400CSR EXSR SR73 PUT MSG 02410CSR SETOF 69 02420CSR EXSR SR75 READ TERMINAL 02430CSR 96 GOTO T102A ERROR 02440CSR 98 GOODBY 02450COR 94 MENU 02460COR 93 GOTO END102 NEW ITEM 02470CSR MOVEAW20A SAV INPUT DATA 02480CSR EXSR SR203 GET FROM LINE 02490CSR Z-ADDW6N CRFLIN FROM LINE# 02500CSR EXSR SR203 GET END LINE ÐÐ02510CSR Z-ADDW6N CRELIN ENDING LINE# 02520CSR EXSR SR203 GET INCREMENT 02530CSR Z-ADDW6N CRINCR INCREMENT # 02540CSR CRFLIN COMP 0 55 02550CSRN55 Z-ADD161 M 96 02560CSRN55 EXSR SR999 FLAG ERROR 02570CSR CRELIN COMP 0 55 02580CSRN55 Z-ADD119 M 96 02590CSRN55 EXSR SR999 FLAG ERROR 02600CSR 96 GOTO T102A ERROR 02610CSR CRINCR COMP 0 55 02620CSRN55 Z-ADD10 CRINCR DEFALUT 02630CSR END102 ENDSR 02640C********************************************************************* 02650CSR SR104 BEGSR 02660C* LOAD PTR OUTPUT ARRAY. INITIALIZE REXTPTR FILE 02670CSR ENDSR 02680C******************************************************************* 02690CSR SR202 BEGSR 02700C* RIGHT JUSTIFY 02710CSR Z-ADD6 W2N 20 02720CSR EXIT SUBRAJ R.J. 02730CSR RLABL W2N 02740CSR RLABL W6A 02750CSR MOVE W6A W6N 60 ÐÐ02760CSR ENDSR 02770C******************************************************************** 02780CSR SR203 BEGSR 02790C* SEPARATE NEXT INPUT FIELD, SAVE REST 02800CSR MOVE BLK6 W6A 6 02810CSR MOVEASAV A20 02820CSR MOVE ' ' SAV 02830CSR Z-ADD1 W 30 02840CSR ',' LOKUPA20,W 54 02850CSR 54 MOVEAA20,W SAV 02860CSR 54 MOVE ' ' SAV,1 02870CSR 54 MOVEABLK20 A20,W 02880CSR Z-ADD1 W 02890CSR ' ' LOKUPA20,W 54 02900CSR 54 MOVEAA20,W W6A 02910CSR EXSR SR202 R.JUSTIFY 02920CSR MOVE W6A W6N 60 02930CSR ENDSR 02940C********************************************************************* 02950CSR SR999 BEGSR 02960C* PUT ERR MSG TO TERM. 02970CSR EXSR SR89 GET MESSAGE 02980CSR EXSR SR73 PUT MSG 02990CSR ENDSR 03000O********************************************************************* ÐÐ03010OCRTFILE E 97 03020O CTX 154 03030O CRTRAN 215 03040O CRFTXT 221 03050O CRFLIN 225P 03060O CRELIN 229P 03070O CRTTXT 235 03080O CRTLIN 249P 03090O CRCLIN 249P 03100O CRINCR 251P 03110O******************************************************************** 03120OREXTPTR E 84 03130O ZERO7 25P 03140O******************************************************************** 03150OTERM37 E 73 03160O MGTEXT 35 03170O****************************************************************** 03180OREXTSEQ E 84N61 03190O TPKEY 15 03200O TPLINE 21 03210O NEWLIN 27 03220O TPPTR 31P 03230O******************************************************************* ** A6 ARRAY 003240 003250ÐÐ** A20 ARRAY 003260 003270** A44 ARRAY 003280 003290** SAV ARRAY 003300 003310/* 003320_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dNN d*X002DC P  050383050383(èÈÐ00010H Q002DC00020F* BILL OF MATERIAL COMVERSION TO DISK80 FOR DEC INPUT 00030F* REVISED 5-03-83 11:15 AM. 00040FBMMAST IP F 86 20AI 1 DISK 00050FDISK80 O F 80 DISK 00060F**************************************************************** 00070IBMMAST BM 10 86NCD 00080I* BILL OF MATERIAL RECORD 00090I* KEY AREA 00100I* ASSY PART NO. 10N 00110I 1 100BMAPN 00120I* COMPONENT PART # 10N 00130I 11 200BMCPN 00140I* ITEM NO. 3N 00150I 25 270BMITNO 00160I* QTY PER ASSY 7P 00170I P 28 310BMQTY 00180I* FILLER 32 33 FFFFFF 00190I* SCRAP ALLOW .2N 00200I 34 352BMSCRP 00210I* ISSUE CODE 2A 00220I* PT = PULL TIME 00230I* OR = ON REQUEST 00240I* BI = BULK ISSUE 00250I* AR = AS REQUIRED ÐÐ00260I* RA = REF ASSY 00270I* TD = TRAV DOC 00280I* SD = SHIP DOC 00290I* RD = REF DOC 00300I* VS = VENDOR SUPPLIED 00310I 36 37 BMISSU 00320I* EFFECTIVITY. 00330I* BEGIN CHANGE LEVEL 2A 00340I 38 39 BMBCHG 00350I* ENDING CHANGE LEVEL 2A 00360I 40 41 BMECHG 00370I* BEGIN ECN # 5A 00380I 42 46 BMBECN 00390I* ENDING ECN # 5A 00400I 47 51 BMEECN 00410I* DISPOSITION CODE 1A 00420I* U = USE UP OLD STYLE 00430I* N = NOW (IMMEDIATE) 00440I 52 52 BMDISP 00450I* FILLER 5A 53 57 FFFFFF 00460I* ROUTING. 00470I* OPER NO. 5P 00480I P 58 600BMOPER 00490I* DEPT NO. 5P 00500I P 61 630BMDEPT ÐÐ00510I* WORK CENTER NO. 3P 00520I P 64 650BMWC 00530I* COMPONENT OPER REFERENCE INFO 10A 00540I 66 75 BMREF 00550I* FILLER 10A 76 85 FFFFFF 00560I* RECORD STATUS 1A 00570I* D = DELETED 00580I 86 86 BMSTAT 00590I*--------------------------------------------------------------------- 00600I ZZ 11 00610C******************************************************************** 00620ODISK80 D 10 00630O 3 'BM1' 00640O BMAPN 10 00650O BMCPN 20 00660O BMITNO 23 00670O BMQTY 30 00680O BMSCRP 32 00690O BMISSU 34 00700O BMBCHG 36 00710O BMECHG 38 00720O BMBECN 43 00730O BMEECN 48 00740O BMDISP 49 00750O BMOPER 54 ÐÐ00760O BMDEPT 59 00770O BMWC 62 00780O BMREF 72 00790O*********************************************************************** /* 00800_‚ ÐÐ_‚_‚0O BMDEPT 59 00770O BMWC 62 00780O BMREF 72 00790O*********************************************************************** /* 00800_‚ ÐÈ(üt" ü¿X031PM PŽ120282120282(èÈÐ00010H Q031PM00020F* GENERAL EDIT - PMMST2. (X031PM) 00030F* REVISED 9-23-80 5:15 PM. 00040FMGFILE IC F 80R DISK 00050FPMMST2 IP F 576 12AI 1 DISK 00060FBMWU ID F 21L20AI 1 DISK 00070FLABRATE IT F 80 EDISK 00080FPRINT O F 132 OF PRINTER 00090F**************************************************************** 00100E ACT 1 3 15 00110E TOT 1 3 9 3 COST TOTALS 00120E TABRC 1 4 1 TABRCN 15 DWG REL CODES 00130E TABISS 1 9 2 TABICN 15 ISSUE CODES 00140E TABSC 1 5 2 TABSCN 15 SOURCE CODES 00150E TABUM 1 15 2 TABUMN 15 UNITS OF MEAS 00160E TABPV 1 6 1 TABPVN 18 PROVISION CODES 00170E LABRATE TABDEP 1 10 5 0 TABRAT 9 LABOR DEPT/RATES 00180E DIF 1 7 9 3 STD/MFG $ VAR 00190E VAR 1 6 7 2 STD/MFG HR VAR 00200E ERR 1 25 5 0A 00210E PM$ 7 9 3 MFG $ FILE 00220E PA$ 7 9 3 STD $ FILE 00230E PLT 8 3 0 LEAD TIMES 00240E PHZ 5 3 0 HORIZON M-DAYS 00250E PMM 6 7 0 MIN/MAX CODES ÐÐ00260I******************************************************************* 00270IMGFILE MG 00280I* MESSAGE FILE. 00290I 1 35 MGTEXT 00300I******************************************************************** 00310IBMWU BW 00320I* BILL MATERIAL WHERE-USED. 00330I* COMPONENT PN 10N 00340I 1 100BWCPN 00350I* ASSY PN 10N 00360I 11 200BWAPN 00370I* RECORD STATUS 1A 00380I 21 21 BWSTAT 00390I******************************************************************** 00400IPMMST2 PM 01 576NCD 00410I* PART MASTER RECORD (XPMMST) 00420I* KEY AREA 00430I* PART NO. 10N 00440I 1 100PMPN 00450I* NUMB OF COMPONENTS 3P 00460I P 13 140PMNOBM 00470I* PROD LINE 4N 00480I 15 180PMPL 00490I* MODEL NAME 12A 00500I 19 30 PMMODL ÐÐ00510I* DESCRIPTION 29A 00520I 31 59 PMDESC 00530I* MFG HOURS BY DEPT. 00540I* ASSY DEPT 3P 00550I P 60 610PMMADP 00560I* ASSY HRS 5.2P 00570I P 62 642PMMAHR 00580I* TEST DEPT 3P 00590I P 65 660PMMTDP 00600I* TEST HRS 5.2P 00610I P 67 692PMMTHR 00620I* Q.C. DEPT 3P 00630I P 70 710PMMQDP 00640I* Q.C. HRS 5.2P 00650I P 72 742PMMQHR 00660I* COMMODITY CODE 9P 00670I P 75 790PMCC 00680I* FILLER 80 82 FFFFFF 00690I* ENG CHANGE STATUS. 00700I* LAST ECN # 5A 00710I 83 87 PMECN 00720I* CUR CHG LEVEL 2A 00730I 88 89 PMECHG 00740I* CUR CHG DATE 6N 00750I 90 950PMDCHG ÐÐ00760I* RELEASE STATUS 1A 00770I* E = ENG ONLY 00780I* M = REL TO MFG 00790I* P = PROTOTYPE 00800I* X = PRE-RELEASE 00810I 96 96 PMRELS 00820I* INSPECT CODE 3A 00830I 97 99 PMINSP 00840I* DRAWING INFO. 00850I* DWG SIZE 00860I 101 101 PMSIZ 00870I* DWG CLASS 1A 00880I* D = DYNAIR DWG 00890I* V = VENDOR DWG 00900I 102 102 PMDCLS 00910I* STANDARD CODE 1A 00920I 103 103 PMSTDC 00930I* FILLER 104 104 FFFFFF 00940I* UNIT MEAS 2A 00950I* EA = EACH OZ = OUNCE 00960I* ST = SET TC = TROY OUNCE 00970I* IN = INCH LB = POUND 00980I* FT = FEET PT = PINT 00990I* YD = YARD QT = QUART 01000I* SI = SQ.INCH GL = GALLON ÐÐ01010I* SF = SQ.FEET DR = DRUM 01020I* SY = SQ.YARD 01030I 105 106 PMUM 01040I***** UNIT MEAS CONVERSION. 01050I***** UM MULTIPLIER 7.2P 01060I***** P 107 1102PMUMM 01070I***** UM CONVERTER 1A 01080I***** M = MULTIPLY 01090I***** D = DIVIDE 01100I***** 111 111 PMUMC 01110I***** SET/DRUM UM 2A 01120I***** 112 113 PMUMUM 01130I* SOURCE CODE 2A 01140I* MA = MFG ASSY 01150I* MP = MFG PART 01160I* PA = PURCH ASSY 01170I* PP = PURCH PART 01180I* RS = RAW STOCK 01190I 114 115 PMSC 01200I* PROVISIONING CODE 1A 01210I* A = FORECAST,NO VALUE ADDED 01220I* B = FORECAST,VALUE ADDED 01230I* C = BUILD TO ORDER (B) 01240I* D = BUILD TO ORDER (NOT B) 01250I* E = CUSTOM ÐÐ01260I* Y = OBSOLETE,REPAIRABLE 01270I* Z = OBSOLETE,NOT REPAIRABLE 01280I 116 116 PMPROV 01290I* ISSUE CODE 2A 01300I* PT = PULL TIME 01310I* OR = ON REQUEST 01320I* BI = BULK ISSUE 01330I* AR = AS REQUIRED 01340I* VS = VENDOR SUPPLIED 01350I* SD = SHIPPING DOCUMENT 01360I* TD = TRAV DOCUMENT 01370I* RD = REF DOCUMENT 01380I* RA = REF ASSY 01390I 117 118 PMISSU 01400I* DELIVER TO DEPT 5P 01410I P 119 1210PMDEL 01420I* RESPONSIBILITY CODES 01430I* ENGR CODE 2A 01440I 122 123 PMEGR 01450I* PLANNER CODE 2A 01460I 124 125 PMPLNR 01470I* BUYER CODE 2A 01480I 126 127 PMBUYR 01490I* SALESMAN CODE 2A 01500I 128 129 PMSLSM ÐÐ01510I* INVENTORY ACCOUNT 5P 01520I P 130 1320PMACNT 01530I* LEAD TIMES 3P X 8 01540I* 1 = PRODUCTION CONTROL,SCHEDULE 01550I* 2 = PURCHASING,PLACE P.O. 01560I* 3 = VENDOR,SUPPLY PART OR SERVICE 01570I* 4 = STOCK,PULL PARTS 01580I* 5 = SHOP,FAB & ASSEMBLE 01590I* 6 = INSPECTION & TEST 01600I* 7 = STOCK,RECEIVE PARTS 01610I* 8 = SAFETY LEAD TIME 01620I P 133 148 PLT 01630I* ORDER POLICY CODES. 01640I* HORIZON M-DAYS 3P X 5 01650I* 1 = SALES ORDERS 01660I* 2 = PROD REQMTS-REL 01670I* 3 = PROD REQMTS-PLAN 01680I* 4 = FORECAST 01690I* 5 = SAFETY STOCK 01700I P 149 158 PHZ 01710I* FILLER 159 168 FFFFFF 01720I* MIN/MAX CODES. 01730I* ARRAY 7P X 6 01740I* 1 = MIN ORDER QTY 01750I* 2 = MIN ORDER $ ÐÐ01760I* 3 = MIN STOCK QTY 01770I* 4 = MAX ORDER QTY 01780I* 5 = MAX ORDER $ 01790I* 6 = MAX STOCK QTY 01800I P 169 192 PMM 01810I* MINIMUM REQMT SPAN 3P 01820I P 193 1940PMMRQS 01830I* MAXIMUM REQMT SPAN 3P 01840I P 195 1960PMXRQS 01850I* ROUNDING FACTOR 5P 01860I P 197 1990PMRNDF 01870I* EOQ CODE 2A 01880I 200 201 PMEOQ 01890I* EOQ PARAMETER 2A 01900I 202 203 PMEOQP 01910I* EXCEPTION REPORT CRITERIA. 01920I* ALLOWABLE SURPLUS QTY 7P 01930I P 204 2070PMSQTY 01940I* ALLOWABLE SURPLUS % 5.2P 01950I P 208 2102PMSPCT 01960I* ALLOWABLE SURPLUS SPAN 3P 01970I P 211 2120PMSSP 01980I* ALLOWABLE SHORTAGE SPAN 3P 01990I P 213 2140PMSHSP 02000I* STANDARD COSTS 9.3P X 7 ÐÐ02010I* ADDED COSTS 02020I* 1 = LABOR 02030I* 2 = LABOR BURDEN 02040I* 3 = MATERIAL 02050I* 4 = MATERIAL BURDEN 02060I* 5 = OUTSIDE PROC 02070I* CUM COSTS 02080I* 6 = LABOR 02090I* 7 = MATERIAL 02100I P 215 249 PA$ 02110I* STANDARD LABOR HOURS. 02120I* STD LOT SIZE 7P 02130I P 255 2580PMSLOT 02140I* STD SET-UP HRS 9.3P 02150I P 259 2633PMSSUH 02160I* STD RUN HRS 9.3P 02170I P 264 2683PMSRH 02180I* STD COST DATE 6N 02190I 269 2740PMSDAT 02200I* STD COST CODE 1A 02210I* E = ESTIMATED 02220I* H = HISTORICAL 02230I 275 275 PMSCCD 02240I* AVER LABOR **** 7.2P 02250I P 276 2792PMOSAL ÐÐ02260I* CURRENT COSTS 9.3P X 7 02270I* ADDED COSTS 02280I* 1 = LABOR 02290I* 2 = LABOR BURDEN 02300I* 3 = MATERIAL 02310I* 4 = MATERIAL BURDEN 02320I* 5 = OUTSIDE PROC 02330I* CUM COSTS 02340I* 6 = LABOR 02350I* 7 = MATERIAL 02360I P 280 314 PM$ 02370I* CURRENT LABOR HOURS. 02380I* CUR LOT SIZE 7P 02390I P 316 3190PMCLOT 02400I* CUR SET-UP HRS 9.3P 02410I P 320 3243PMCSUH 02420I* CUR RUN HRS 9.3P 02430I P 325 3293PMCRH 02440I* CUR COST DATE 6N 02450I 330 3350PMCDAT 02460I* CUR COST CODE 1A 02470I* E = ESTIMATED 02480I* H = HISTORICAL 02490I 336 336 PMCCCD 02500I* PREV MO STK BAL **** 7P ÐÐ02510I P 337 3400PMPMSB 02520I* DATE LAST TRAN 6N 02530I 341 3460PMDLT 02540I* CALCULATED DATA. 02550I* CURRENT BALANCES. 02560I* ON HAND STOCK 7P 02570I P 347 3500PMOHB 02580I* REQUIRED QTYS. 02590I* FORECAST BAL 7P 02600I P 351 3540PMFRCB 02610I* ALLOCATIONS 7P 02620I P 355 3580PMALB 02630I* REL REQS 7P 02640I P 359 3620PMRLB 02650I* SALES BACKLOG 7P 02660I P 363 3660PMSOB 02670I* QUOTES 7P 02680I P 367 3700PMQTB 02690I* BACKORDERS 7P 02700I P 371 3740PMBOB 02710I* ON ORDER BALANCES. 02720I* PURCHASE REQS 7P 02730I P 375 3780PMPRB 02740I* PURCH ORDERS 7P 02750I P 379 3820PMPOB ÐÐ02760I* RECD P.O. 7P 02770I P 383 3860PMRPOB 02780I* OPEN WORK ORDER 7P 02790I P 387 3900PMPWOB 02800I* REL WORK ORDER 7P 02810I P 391 3940PMRWOB 02820I* PAST USAGE. 02830I* PLANNED USAGE QTYS. 02840I* SHIPPED QTYS 7P 02850I P 395 3980PMPSHP 02860I* ISSUE QTYS 7P 02870I P 399 4020PMPISS 02880I* RECEIPT QTYS 7P 02890I P 403 4060PMPRCT 02900I* SCRAP QTYS 7P 02910I P 407 4100PMPSCR 02920I* UNPLANNED USAGE QTYS. 02930I* SHIPPED QTYS 7P 02940I P 411 4140PMUSHP 02950I* ISSUE QTYS 7P 02960I P 415 4180PMUISS 02970I* RECEIPT QTYS 7P 02980I P 419 4220PMURCT 02990I* SCRAP QTYS 7P 03000I P 423 4260PMUSCR ÐÐ03010I* CUST RET $ 7P 03020I P 427 4300PMUCRT 03030I* PLANNED USAGE FREQ. 03040I* SHIPPED 5P 03050I P 431 4330PMFSHP 03060I* ISSUE 5P 03070I P 434 4360PMFISS 03080I* RECEIPT 5P 03090I P 437 4390PMFRCT 03100I* SCRAP 5P 03110I P 440 4420PMFSCR 03120I* UNPLANNED USAGE FREQ. 03130I* SHIPPED 5P 03140I P 443 4450PMQSHP 03150I* ISSUE 5P 03160I P 446 4480PMQISS 03170I* RECEIPT 5P 03180I P 449 4510PMQRCT 03190I* SCRAP 5P 03200I P 452 4540PMQSCR 03210I* CUST RET 5P 03220I P 455 4570PMQCRT 03230I* BACKORDER FREQ 5P 03240I P 458 4600PMFBO 03250I* USAGE RATIO .7P ÐÐ03260I P 461 4647PMRATO 03270I* INVENTORY CLASS 1A 03280I 465 465 PMINVC 03290I* LOW LEVEL CODE 2N 03300I 466 4670PMLL 03310I* PHYSICAL INVENTORY. 03320I* CYCLE INV FREQ 3P 03330I P 468 4690PMFCYC 03340I* DATE LAST CYCLE 6N 03350I 470 4750PMDLCI 03360I* ADJ FREQ 3P 03370I P 476 4770PMFADJ 03380I* ADJ NET VALUE $ 9.2P 03390I P 478 4822PMVADJ 03400I* LAST SALE INFO. 03410I* LAST SALE DATE 6N 03420I 483 4880PMDLS 03430I* LAST SALE QTY 7P 03440I P 489 4920PMLSQ 03450I* LAST SALE PRICE 9.3P 03460I P 493 4973PMLSP 03470I* LAST BUY INFO. 03480I* LAST BUY DATE 6N 03490I 498 5030PMDLB 03500I* LAST BUY QTY 7P ÐÐ03510I P 504 5070PMLBQ 03520I* LAST BUY PRICE 9.3P 03530I P 508 5123PMLBP 03540I* DATE LAST STK TRANS 6N 03550I 513 5180PMDLST 03560I* OLD STYLE PART MASTER FIELDS. HRS=ACCOUNTING STD HRS 03570I* AVER LABOR 7.2P P 276 2792PMOSAL 03580I* PREV MO STK BAL 7P P 337 3400PMPMSB 03590I* DEVALUED CODE 1A 03600I 523 523 PMDVAL 03610I* ASSY DEPT # 3P 03620I P 524 5250PMAADP 03630I* ASSY HRS 5.2P 03640I P 526 5282PMAAHR 03650I* TEST DEPT # 3P 03660I P 529 5300PMATDP 03670I* TEST HOURS 5.2P 03680I P 531 5332PMATHR 03690I* Q.C. DEPT # 3P 03700I P 534 5350PMAQDP 03710I* Q.C. HRS 5.2P 03720I P 536 5382PMAQHR 03730I*** LOT QTY 5P 03740I P 539 5410PMOSLQ 03750I* FAB CODE 2A ÐÐ03760I 542 543 PMFABC 03770I*** STD UNIT COST 9.3P 03780I P 544 5483PMOSUC 03790I* LEAD TIME 3P 03800I P 549 5500PMOSLT 03810I* OLD STYLE MCN 5A 03820I 551 555 PMMCN 03830I* SPARES CODE 1A 03840I 556 556 PMSPAR 03850I* GSA PRICE 9.2P 03860I P 557 5612PMGSA 03870I* SET-UP PRICE 9.2P 03880I P 562 5662PMSUPR 03890I* LIST PRICE 9.2P 03900I P 567 5712PMLPR 03910I* PMDESCR FILE KEY CODE 3P 03920I P 574 5750PMPDKC 03930I* RECORD STATUS 1A 03940I* D = DELETED 03950I 576 576 PMSTAT 03960I PG 02 03970C******************************************************************* 03980C* INITIALIZE - 1-TIME. 03990C N79 EXSR SR101 1-TIME INIT 04000C* BYPASS DELETES. ÐÐ04010C 01 PMSC COMP 'RD' 54 04020C 01 54 SETOF 01 04030C N01 GOTO END 04040C* CHECK VALID SOURCE CODES. 04050C EXSR SR501 04060C* CHECK VALID ISSUE CODES. 04070C EXSR SR502 04080C* CHECK VALID PROV CODES. 04090C EXSR SR503 04100C* FLAG PURCH WITH LABOR. 04110C EXSR SR504 04120C* FLAG MFG WITH NO LABOR/MATERIAL. 04130C EXSR SR505 04140C* FLAG NOT USED. 04150C EXSR SR506 04160C* FLAG NO COST. 04170C EXSR SR507 04180C* PRINT LINE & ERRORS. 04190C EXSR SR901 PRINT 04200C*------------------------------------------------------------------- 04210C END TAG 04220C************************************************************* 04230CSR SR7 BEGSR 04240C* EDIT PROV CODE 04250CSR PMPROV COMP ' ' 54 ÐÐ04260CSRN54 GOTO END7 NO INPUT 04270CSR PMPROV LOKUPTABPV TABPVN 54 04280CSR 54 MOVE TABPVN PRVNAM 18 PROV CODE NAME 04290CSRN54 MOVE BLK18 PRVNAM 04300CSRN54 Z-ADD8 M 96 FLAG ERROR 04310CSR END7 ENDSR 04320C******************************************************************* 04330CSR SR8 BEGSR 04340C* EDIT SOURCE CODE. 04350CSR PMSC COMP ' ' 54 04360CSRN54 Z-ADD404 M 96 FLAG ERROR 04370CSRN54 GOTO END8 04380CSR PMSC LOKUPTABSC TABSCN 54 04390CSRN54 Z-ADD6 M 96 FLAG ERROR 04400CSRN54 MOVE BLK15 SCNAME 15 04410CSR 54 MOVE TABSCN SCNAME 04420CSR END8 ENDSR 04430C******************************************************************** 04440CSR SR9 BEGSR 04450C* EDIT ISSUE CODE. 04460CSR PMISSU COMP ' ' 54 04470CSRN54 Z-ADD405 M 96 FLAG ERROR 04480CSRN54 GOTO END9 04490CSR PMISSU LOKUPTABISS TABICN 54 04500CSR 54 MOVE TABICN ICNAME 15 ÐÐ04510CSRN54 Z-ADD9 M 96 FLAG ERROR 04520CSRN54 MOVE BLK15 ICNAME 04530CSR END9 ENDSR 04540C******************************************************************** 04550CSR SR101 BEGSR 04560C* INITIALIZE. 04570CSR SETON 79 04580CSR Z-ADD0 ZERO5 50 04590CSR MOVE ' ' BLK15 15 04600CSR MOVE ' ' BLK18 18 04610CSR MOVE ' ' BLK35 35 04620CSR Z-ADD0 ERR 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR501 BEGSR 04660C* EDIT SOURCE CODES. 04670CSR EXSR SR8 EDIT 04680CSR 96 EXSR SR900 SAVE ERROR 04690CSR ENDSR 04700C******************************************************************** 04710CSR SR502 BEGSR 04720C* EDIT ISSUE CODE. 04730CSR EXSR SR9 EDIT 04740CSR 96 EXSR SR900 SAVE ERROR 04750CSR ENDSR ÐÐ04760C******************************************************************** 04770CSR SR503 BEGSR 04780C* EDIT PROVISION CODE. 04790CSR EXSR SR7 EDIT 04800CSR 96 EXSR SR900 SAVE ERROR 04810CSR ENDSR 04820C******************************************************************** 04830CSR SR504 BEGSR 04840C* EDIT PURCH PARTS WITH LABOR. 04850CSR MOVELPMSC W1A 1 04860CSR W1A COMP 'P' 54 04870CSRN54 GOTO END504 NOT PUR 04880CSR PM$,1 COMP 0 54 04890CSRN54 PM$,2 COMP 0 54 04900CSRN54 PM$,6 COMP 0 54 04910CSRN54 GOTO END504 NO LABOR 04920CSR Z-ADD495 M 50 96 04930CSR EXSR SR900 FLAG ERROR 04940CSR END504 ENDSR 04950C******************************************************************** 04960CSR SR505 BEGSR 04970C* FLAG MFG PART WITH NO LABOR. 04980CSR MOVELPMSC W1A 04990CSR W1A COMP 'M' 54 05000CSRN54 PMSC COMP 'RA' 54 ÐÐ05010CSRN54 GOTO T505A NOT MFG 05020CSR PM$,1 COMP 0 54 05030CSRN54 PM$,2 COMP 0 54 05040CSRN54 PM$,6 COMP 0 54 05050CSR 54 GOTO END505 GOT LABOR 05060CSR Z-ADD496 M 96 FLAG ERROR 05070CSR EXSR SR900 05080C*------------------------------------------------------------------- 05090CSR T505A TAG 05100C* FLAG ASSYS - NO MATL $. 05110CSR MOVE PMSC W1A 05120CSR W1A COMP 'A' 54 05130CSR 54 PM$,3 COMP 0 55 05140CSR 54N55 Z-ADD498 M 96 05150CSR 54N55 EXSR SR900 05160CSR END505 ENDSR 05170C******************************************************************** 05180CSR SR506 BEGSR 05190C* FLAG NOT USED. 05200C* 05210CSR ENDSR 05220C******************************************************************** 05230CSR SR507 BEGSR 05240C* FLAG PURCH PART - NO COST. 05250CSR MOVELPMSC W1A ÐÐ05260CSR W1A COMP 'P' 54 05270CSRN54 GOTO END507 05280CSR PM$,5 COMP 0 54 05290CSRN54 Z-ADD497 M 96 FLAG ERROR 05300CSRN54 EXSR SR900 05310CSR END507 ENDSR 05320C******************************************************************** 05330CSR SR900 BEGSR 05340C* SAVE ERROR #. 05350CSR Z-ADD1 X 30 05360CSR ZERO5 LOKUPERR,X 54 05370CSR 54 Z-ADDM ERR,X 05380CSR Z-ADD0 M 05390CSR SETOF 96 05400CSR ENDSR 05410C******************************************************************** 05420CSR SR901 BEGSR 05430C* PRINT. 05440CSR Z-ADD1 X 05450CSR SETOF 80 05460C*------------------------------------------------------------------- 05470CSR T901A TAG 05480CSR ZERO5 LOKUPERR,X 54 05490CSRN54 GOTO T901P 05500CSR ERR,X CHAINMGFILE 54 ÐÐ05510CSR 54 MOVE BLK35 MGTEXT 05520CSR SETON 81 05530CSR EXCPT PRINT 05540CSR SETOF 81 05550CSR SETON 80 05560CSR Z-ADD0 ERR,X 05570CSR GOTO T901A 05580C*------------------------------------------------------------------- 05590CSR T901P TAG 05600CSR ENDSR 05610C* 05620C* 05630C* 05640C* 05650C* 05660O******************************************************************** 05670OPRINT H 201 1P 05680O OR OF 05690O 70 'PART MASTER EDIT' 05700O UDATE Y 8 05710O 127 'PAGE' 05720O PAGE Z 132 05730O*------------------------------------------------------------------- 05740O H 1 1P 05750O OR OF ÐÐ05760O 68 'SOURCE' 05770O 75 'ISSUE' 05780O 56 'MODEL-NO.' 05790O 86 'FAB' 05800O 81 'PROV' 05810O*------------------------------------------------------------------- 05820O H 2 1P 05830O OR OF 05840O 8 'PART-NO.' 05850O 25 'DESCRIPTION' 05860O 67 'CODE' 05870O 74 'CODE' 05880O 81 'CODE' 05890O 87 'CODE' 05900O*------------------------------------------------------------------- 05910O EF11 81N80 05920O PMPN 12 ' - - ' 05930O PMDESC 45 05940O PMMODL 60 05950O PMSC 66 05960O PMISSU 73 05970O PMPROV 80 05980O PMFABC 86 05990O*------------------------------------------------------------------- 06000O EF 1 81 ÐÐ06010O 9 '****' 06020O MGTEXT B 46 ** ACT ARRAY 06030FINISHED GOODS 006040DETAIL PARTS 006050SLOW-MOVING 006060** TOT ARRAY - COST TOTALS 006070 006080** TABRC/TABRCN - DWG REL CODES 006090EENG USE ONLY 006100MREL FOR MFG 006110PPROTOTYPE 006120XPRE-RELEASE 006130** TABISS/TABICN - ISSUE CODES 006140PTPULL TIME 006150ORON REQUEST 006160BIBULK ISSUE 006170ARAS REQD 006180VSVENDOR SUPL 006190SDSHIPPING DOC 006200TDTRAVELER DOC 006210RDREF DOC ONLY 006220RAREF ASSY/PART 006230** TABSC/TABSCN - SOURCE CODES 006240MAMFG ASSY 006250ÐÐMPMFG PART 006260PAPURCH ASSY 006270PPPURCH PART 006280RSRAW STOCK 006290** TABUM/TABUMN - UNITS MEASURE 006300EAEACH 006310STSET 006320ININCH 006330FTFOOT 006340YDYARD 006350SISQ INCH 006360SFSQ FOOT 006370SYSQ YARD 006380OZOUNCE 006390TCTROY OZ 006400LBPOUND 006410PTPINT 006420QTQUART 006430GLGALLON 006440DRDRUM 006450** TABPV/TABPVN - PROVISIONING CODES/NAMES 006460AFRCST-NO VAL ADDED 006470BFRCST-VAL ADDED 006480CFRCST-BUILD TO ORD 006490ECUSTOM 006500ÐÐYOBSLETE-REPAIRABLE 006510ZOBSLETE-NO REPAIR 006520** DIF ARRAY - STD LESS CUR $ COST INPUT 006530 006540** VAR ARRAY - STD LESS MFG HRS INPUT 006550 006560** ERR ARRAY 006570 006580/* 006590_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(^wâ ^’X031RX P120282120282(èÈÐ00010H Q031RX00020F* TEXT COPY PROG - CALLED BY X012RX (X031RX) 00030F* REVISED 10/29/79 4:15 PM. 00040FBITTAB IP F 33 DISK 00050FREXTCOPYUD F 400 DISK 00060FREXTCONTUC F 16R DISK 00070FREXTPTR UC F 25R21AI 1 DISK A 00080FREXTFILEUC F 90R DISK 00090FCRTFILE UC F 256R DISK 00100FMGFILE IC F 80R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E NUL 1 132 1 00140E BIT 33 1 00150E SAV 100 7 0A 00160E TXT 60 1 A 00170E CTX 60 1 A 00180I******************************************************************* 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************** 00220ICRTFILE CR 00230I* PART # 12A 00240I 80 91 CRPN 00250I* OPER SEQ # 3N ÐÐ00260I 92 940CRSEQ 00270I* TEXT WORK AREA 1A X 60 00280I 95 154 CTX 00290I* CUR INSTR 1A 00300I 215 215 CRTRAN 00310I* COPY FROM PN 12A 00320I 216 227 CRFPN 00330I* COPY FROM SEQ 3P 00340I P 228 2290CRFSEQ 00350I* COPY THRU SEQ 3P 00360I P 230 2310CRESEQ 00370I* COPY TO SEQ 3P 00380I P 232 2330CRTSEQ 00390I* CURRENT LINE # 7P 00400I P 246 2490CRCLIN 00410I* LINE INCREMENT 3P 00420I P 250 2510CRINCR 00430I******************************************************************** 00440IREXTCONTTC 00450I* LAST USED PTR 7N 00460I 1 70TCLUTX 00470I* LAST DELETED PTR 7N 00480I 8 140TCLDTX 00490I******************************************************************** 00500IREXTPTR TP ÐÐ00510I* TEXT POINTER FILE. 00520I* PART # 12A 00530I 1 12 TPPN 00540I* OPER SEQ # 3N 00550I 13 150TPSEQ 00560I* LINE # 6N 00570I 16 210TPLINE 00580I* POINTER 7P 00590I P 13 160TPPTR 61 00600I******************************************************************** 00610IREXTFILETX 00620I* REXTFILE RECORD. 00630I* PART # 12A 00640I 1 12 TXPN 00650I* OPER SEQ # 3N 00660I 13 150TXSEQ 00670I* LINE # 6N 00680I 16 210TXLINE 00690I* TEXT 1A X 60 00700I 22 81 TXT 00710I* BACKWARD PTR (DELETE) 7P 00720I P 82 850TXBPTR 00730I* RECORD STATUS 1A 00740I 90 90 TXSTAT 00750I******************************************************************** ÐÐ00760IREXTCOPYTT 00770I* COPY PTRS 7P X 100 00780I P 1 400 SAV 00790I******************************************************************** 00800IMGFILE MG 00810I 1 35 MGTEXT 00820C******************************************************************** 00830C* INITIALIZE. 00840C N89 EXSR SR101 00850C H9 GOTO END 00860C Z-ADD0 ZERO7 70 STUPIDITY. 00870C*-------------------------------------------------------------------- 00880C START TAG 00890C* GET NEXT COPY RECORD. 00900C SETOF 54 00910C READ REXTCOPY 54 00920C 54 GOTO END END FILE. 00930C Z-ADD1 S 30 00940C*------------------------------------------------------------------- 00950C TAG10 TAG 00960C ZERO7 LOKUPSAV,S 54 00970C N54 EXSR SR81 UPDATE REXTCOPY 00980C N54 GOTO START 00990C* GET COPY FROM RECORD. 01000C Z-ADDSAV,S RRN 70 PTR. ÐÐ01010C Z-ADD0 SAV,S 01020C EXSR SR80 GET REXTFILE. 01030C 96 GOTO ERROR PROG ERROR. 01040C* SAVE COPY DATA. 01050C EXSR SR102 SAVE DATA. 01060C* GET COPYTO REXTPTR. 01070C EXSR SR82 01080C H6 GOTO END 01090C* GET NEXT AVAIL RRN. 01100C EXSR SR88 GET NEXT AVAIL. 01110C 96 GOTO ERROR 01120C* UPDATE REXTFILE & REXTPTR. 01130C EXSR SR83 01140C 96 GOTO ERROR 01150C GOTO TAG10 01160C*------------------------------------------------------------------- 01170C ERROR TAG 01180C EXSR SR89 01190C EXSR SR73 01200C*------------------------------------------------------------------- 01210C END TAG 01220CLR SETON 97 01230CLR EXCPT UPDATE CRTFILE 01240CLR SETOF 97 01250CLR MOVEL'Q002TX' PROG 8 ÐÐ01260CLR EXITFCHAIN 01270CLR RLABL PROG 01280C******************************************************************** 01290CSR SR73 BEGSR 01300C* PUT MSG TO TERM. 01310CSR SETON 73 01320CSR EXCPT PUT MSG. 01330CSR SETOF 73 01340CSR ENDSR 01350C******************************************************************** 01360CSR SR80 BEGSR 01370C* GET REXTFILE. 01380CSR RRN CHAINREXTFILE 54 01390CSR 54 Z-ADD125 M 50 96 FLAG ERROR. 01400CSR 54 SETON H8 01410CSR ENDSR 01420C******************************************************************** 01430CSR SR81 BEGSR 01440C* UPDATE REXTCOPY RECORD. 01450CSR SETON 81 01460CSR EXCPT REWRITE REXTCOPY 01470CSR SETOF 81 01480CSR ENDSR 01490C******************************************************************** 01500CSR SR82 BEGSR ÐÐ01510C* GET COPY-TO REXTPTR. 01520CSR MOVELCRPN W21A 21 01530CSRN82 GOTO T82A 01540CSR 1 ADD LINOUT LINOUT 60 01550CSR SAVSEQ COMP LSTSEQ 54 01560CSRN54 1 ADD CRTSEQ SAVSEQ 01570CSRN54 Z-ADDSAVSEQ LSTSEQ 30 01580CSRN54 Z-ADD1 LINOUT 01590CSR SETOF 82 01600CSR GOTO T82B 01610C*------------------------------------------------------------------- 01620CSR T82A TAG 01630CSR Z-ADD1 LINOUT 01640CSR Z-ADDSAVSEQ LSTSEQ 01650C*------------------------------------------------------------------- 01660CSR T82B TAG 01670CSR MOVELCRTSEQ W8A 8 01680CSR MOVE LINOUT W8A 01690CSR MOVE W8A W21A 01700CSR W21A CHAINREXTPTR 60 01710CSRN60N61 SETON 74H6 01720CSRN60N61 EXCPT FLAG ERROR 01730CSR SETOF 74 01740CSR ENDSR 01750C******************************************************************** ÐÐ01760CSR SR83 BEGSR 01770C* UPDATE REXTFILE/TEXT PTR. 01780CSR SETON 8382 UPDATE. 01790CSR EXCPT REXTFILE/PTR. 01800CSR SETOF 83 01810CSR ENDSR 01820C******************************************************************** 01830CSR SR85 BEGSR 01840C* UPDATE REXTCONT FILE. 01850CSR SETON 85 01860CSR EXCPT REWRITE REXTCONT 01870CSR SETOF 85 01880CSR ENDSR 01890C******************************************************************** 01900CSR SR88 BEGSR 01910C* GET NEXT AVAIL RRN. 01920CSR Z-ADD1 RRN 70 01930CSR RRN CHAINREXTCONT 55 01940CSR 55 Z-ADD126 M 96 01950CSR 55 SETON H7 01960CSR 55 EXSR SR999 ERROR. 01970CSR 55 GOTO END88 01980CSR Z-ADDTCLDTX RRN 54 01990CSRN54 GOTO T88A 02000CSR EXSR SR80 GET REXTFILE. ÐÐ02010CSR 96 GOTO END88 PROG ERROR. 02020CSR Z-ADDTXBPTR TCLDTX 02030CSR GOTO END88 02040C*------------------------------------------------------------------- 02050CSR T88A TAG 02060CSR 1 ADD TCLUTX TCLUTX 02070CSR Z-ADDTCLUTX RRN 02080CSR EXSR SR80 GET REXTFILE. 02090C*------------------------------------------------------------------- 02100CSR END88 TAG 02110CSR Z-ADDRRN TPPTR TEXT PTR. 02120CSR EXSR SR85 UPDATE REXTCONT 02130CSR Z-ADD0 TXBPTR BKWD PTR. 02140CSR MOVE ' ' TXT 02150CSR ENDSR 02160C******************************************************************** 02170CSR SR89 BEGSR 02180C* GET MSG FILE. 02190CSR M CHAINMGFILE 54 GET MSG. 02200CSR 54 MOVE BLK35 MGTEXT 02210CSR ENDSR 02220C******************************************************************** 02230CSR SR101 BEGSR 02240C* 1-TIME INIT. 02250CSR SETON 89 ÐÐ02260CSR MOVE BIT,1 NUL 02270CSR MOVE ' ' BLK35 35 02280CSR MOVE ' ' W8A 8 02290CSR Z-ADD0 W1N 10 02300CSR Z-ADD0 W2N 20 02310CSR MOVE ' ' W2A 2 02320CSR EXITFPGMINX 02330CSR RLABL W8A 02340CSR RLABL W2N 02350CSR RLABL W1N 02360CSR RLABL W2A 02370CSR MOVE W2A PORT 20 02380CSR PORT COMP 0 54 02390CSRN54 Z-ADD25 PORT 02400CSR PORT CHAINCRTFILE H9 02410CSR CRINCR COMP 0 54 02420CSRN54 Z-ADD2 CRINCR 02430CSR Z-ADD0 ZERO7 70 02440CSR ENDSR 02450C******************************************************************** 02460CSR SR102 BEGSR 02470C* SAVE TEXT COPY DATA. 02480CSR MOVEATXT CTX 02490CSR MOVE TXSEQ SAVSEQ 30 02500CSR ENDSR ÐÐ02510C******************************************************************** 02520CSR SR999 BEGSR 02530C* PUT MESSAGE. 02540CSR EXSR SR89 GET MSG. 02550CSR EXSR SR73 PUT MSG. 02560CSR ENDSR 02570O******************************************************************** 02580OCRTFILE E 97 02590O CRFSEQ 229P 02600O CRESEQ 231P 02610O LINOUT 239P 02620O CRCLIN 249P 02630O CRINCR 251P 02640O******************************************************************** 02650OREXTFILEE 83 02660O W21A 21 02670O CTX 81 02680O ZERO7 85P 02690O 90 'A' 02700O******************************************************************** 02710OREXTPTR EADD 83 60 02720O W21A 21 02730O TPPTR 25P 02740O*------------------------------------------------------------------- 02750O E 83N60 ÐÐ02760O TPPTR 25P 02770O******************************************************************** 02780OREXTCOPYE 81 02790O SAV 400P 02800O******************************************************************** 02810OREXTCONTE 85 02820O TCLUTX 7 02830O TCLDTX 14 02840O******************************************************************** 02850OTERM132 E 73 02860O NUL 132 02870O MGTEXT 35 02880O 37 ' ' 02890O*---------------------------------------------------------------- 02900O E 83 02910O CTX 60 02920O CRTSEQZ 70 02930O LINOUTZ 80 02940O*---------------------------------------------------------------- 02950O E 74 02960O 24 '***NO ROOM LEFT- ABORT**' ** NUL ARRAY 002970 002980/* 002990_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(^xu ^’X002PC P120282120282(èÈÐ00010H Q002PC00020F* CUM-UP PRODUCT COST. (X002PC) 00030F* REV 8/13/81 1:30 PM. DG-REL006 OK. 00040FPCGUIDE2UP F 13 12AI 1 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060FBMMAST ID F 86L20AI 1 DISK 00070FLABRATE IT F 80 EDISK 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E LABRATE TABDEP 1 11 5 0 TABRAT 9 LABOR RATES/DEPT 00110E CUM 1 7 9 3 00120E PM$ 7 9 3 MFG COST $ 00130E MHR 12 7 3A MFG HRS 00140E MDP 12 3 0 MFG DEPTS 00150I******************************************************************** 00160IPCGUIDE2PG 01 13NCD 00170I 1 20PGLL 00180I 3 120PGPN 00190I 13 13 PGSTAT 00200I GG 02 00210I******************************************************************** 00220IPMMST2 PM 00230I* PART MASTER RECORD 00240I* KEY AREA 00250I* PART NO. 10N ÐÐ00260I 1 100PMPN 00270I* NUMB OF COMPONENTS 3P 00280I P 13 140PMNOBM 00290I* SOURCE CODE 2A 00300I 94 95 PMSC 00310I* ISSUE CODE 2A 00320I 97 98 PMISSU 00330I* CURRENT COSTS 9.3P X 7 00340I* ADDED COSTS 00350I* 1 = LABOR 00360I* 2 = LABOR BURDEN 00370I* 3 = MATERIAL 00380I* 4 = MATERIAL BURDEN ) NOT USED 00390I* 5 = OUTSIDE BURDEN ) NOT USED 00400I* CUM COSTS 00410I* 6 = LABOR ) NOT USED 00420I* 7 = MATERIAL ) NOT USED 00430I P 245 279 PM$ 00440I* MFG LABOR HRS. 00450I P 543 590 MHR 00460I* MFG LABOR DEPTS. 00470I P 591 614 MDP 00480I 674 674 PMSTAT 00490I******************************************************************** 00500IBMMAST BM ÐÐ00510I* BILL OF MATERIAL RECORD (XBMREC) 00520I* KEY AREA 00530I* ASSY PART NO. 10N 00540I 1 100BMAPN 00550I* COMPONENT PART NO. 10N 00560I 11 200BMCPN 00570I* ITEM NO. 3N 00580I 25 270BMITNO 00590I* QTY PER ASSY 7P 00600I P 28 310BMQTY 00610I* SCRAP ALLOW .2N 00620I 34 352BMSCRP 00630I* ISSUE CODE 2A 00640I* PT = PULL TIME 00650I* OR = ON REQUEST 00660I* BI = BULK ISSUE 00670I* AR = AS REQUIRED 00680I* RA = REF ASSY 00690I* TD = TRAV DOC 00700I* SD = SHIP DOC 00710I* RD = REF DOC 00720I* VS = VENDOR SUPPLIED 00730I 36 37 BMISSU 00740I* EFFECTIVITY. 00750I* BEGIN CHANGE LEVEL 2A ÐÐ00760I 38 39 BMBCHG 00770I* ENDING CHANGE LEVEL 2A 00780I 40 41 BMECHG 00790I* BEGIN ECN # 5A 00800I 42 46 BMBECN 00810I* ENDING ECN # 5A 00820I 47 51 BMEECN 00830I* DISPOSITION CODE 1A 00840I* U = USE UP OLD STYLE 00850I* N = NOW (IMMEDIATE) 00860I 52 52 BMDISP 00870I* FILLER 5A 53 57 FFFFFF 00880I* ROUTING. 00890I* OPER NO. 5P 00900I P 58 600BMOPER 00910I* DEPT NO. 5P 00920I P 61 630BMDEPT 00930I* WORK CENTER NO. 3P 00940I P 64 650BMWC 00950I* COMPONENT OPER REFERENCE INFO 10A 00960I 66 75 BMREF 00970I* FILLER 76 85 FFFFFF 00980I* 00990I* RECORD STATUS 1A 01000I* D = DELETED ÐÐ01010I 86 86 BMSTAT 01020C******************************************************************** 01030C* INITIALIZE (1-TIME). 01040C N01 GOTO END 01050C 79 GOTO START 01060C Z-ADD0 ZER7D3 73 STUPIDITY 01070C EXSR SR101 INIT. 01080C*------------------------------------------------------------------- 01090C START TAG 01100C* GET ASSY PART MAST. 01110C Z-ADD0 CUM 01120C MOVELPGPN W12A 12 01130C EXSR SR81 GET ASSY PMMST 01140C 60 GOTO END 01150C* BYPASS NON-ASSYS. 01160C PMNOBM COMP 0 54 01170C N54 GOTO END 01180C TIME TIME 60 01190C SETON 80 01200C EXCPT 01210C SETOF 80 01220C* SAVE ADDED COSTS. 01230C Z-ADDPM$,1 CUM,1 ADD LABOR 01240C Z-ADDPM$,2 CUM,2 ADD LAB BURD 01250C* * * * * * * * Z-ADDPM$,5 CUM,5 VENDOR COST-ADD ÐÐ01260C* SET-UP BM READ. 01270C MOVELPGPN W20A 20 01280C MOVE ZERO10 W20A 01290C*--------------------------------------------------------------- 01300C SETLIM TAG 01310C W20A SETLLBMMAST 01320C*------------------------------------------------------------------- 01330C CHASE TAG 01340C* GET NEXT BILL MATL RECORD. 01350C SETOF 54 01360C READ BMMAST 54 GET BMMAST. 01370C 54 GOTO ENDASY PROG ERROR. 01380C BMAPN COMP PGPN 54 01390C N54 GOTO ENDASY 01400C BMSTAT COMP 'D' 54 01410C 54 GOTO CHASE 01420C* GET COMPONENT PART MASTER. UPDATE COST & CUM. 01430C MOVE BLK12 W12A 01440C MOVELBMCPN W12A 01450C EXSR SR81 GET PMMST 01460C 60 GOTO CHASE ERROR 01470C EXSR SR72 COMPUTE ASSY COST 01480C GOTO CHASE 01490C*------------------------------------------------------------------- 01500C ENDASY TAG ÐÐ01510C MOVELPGPN W12A 01520C MOVE ' ' W12A 01530C EXSR SR81 GET ASSY MAST 01540C 60 GOTO END NO HIT 01550C* UPDATE ASSY COST. 01560C Z-ADDCUM PM$ 01570C EXSR SR82 UPDATE ASSY PMMST 01580C GOTO END 01590C*------------------------------------------------------------------- 01600C END TAG 01610C*------------------------------------------------------------------- 01620C ENDJOB TAG 01630C******************************************************************** 01640CSR SR72 BEGSR 01650C* ADD COMPONENT COST TO ASSY COST. 01660CSR BMISSU COMP ' ' 54 01670CSRN54 MOVE PMISSU BMISSU DEFAULT 01680CSR MOVELPMSC SCL 1 SOURCE CODE LEFT 01690CSR MOVE PMSC SCR 1 SOURCE CODE RIGHT 01700CSR MOVELBMISSU ICL 1 ISSUE CODE LEFT 01710CSR MOVE BMISSU ICR 1 ISSUE CODE RIGHT 01720C* BYPASS REF & BULK ISSUE ITEMS. 01730CSR ICL COMP 'R' 54 01740CSR 54 ICR COMP 'A' 55 01750CSR 54N55 GOTO END72 REF ITEM, BYPASS ÐÐ01760CSR BMISSU COMP 'BI' 54 01770CSR 54 GOTO END72 BULK ISSUE, BYPASS 01780CSR SCL COMP 'P' 56 FLAG PURCHASED 01790CSRN56 SETON 57 FLAG MFG 01800C* COMPUTE LABOR COST AND UPDATE COMPONENT. 01810CSR Z-ADD1 X 30 01820CSR Z-ADD0 PM$,1 ADDED LABOR 01830CSR Z-ADD0 PM$,2 ADDED LABOR BURDEN 01840C*----------------------------------------------------------------- 01850CSR T72A TAG 01860CSR ZER7D3 LOKUPMHR,X 54 01870CSRN54 GOTO T72C 01880CSR Z-ADDMDP,X W5N 50 01890CSR W5N LOKUPTABDEP TABRAT 54 01900CSRN54 GOTO T72B 01910CSR MOVELTABRAT W9N 90 01920CSR MOVELW9N LABRAT 52 LABOR RATE 01930CSR MOVE W9N BURRAT 42 BURDEN RATE 01940CSR LABRAT MULT MHR,X W9D3 93 01950CSR W9D3 ADD PM$,1 PM$,1 LABOR COST 01960CSR BURRAT MULT MHR,X W9D3 01970CSR W9D3 ADD PM$,2 PM$,2 BURDEN COST 01980C*---------------------------------------------------------------- 01990CSR T72B TAG 02000CSR 1 ADD X X ÐÐ02010CSR X COMP 12 54 02020CSRN54 GOTO T72A 02030C*--------------------------------------------------------------- 02040CSR T72C TAG 02050C* ADD COMPONENT COST TO COST OF ASSY 02060CSR XFOOTPM$ W9D3 93 02070CSR BMQTY MULT W9D3 W9D3 02080CSR EXSR SR82 UPDATE PMMST2 02090CSR W9D3 ADD CUM,3 CUM,3 ASSY MATERIAL COST 02100C*-------------------------------------------------------------------- 02110C* FOLLOWING COSTING METHOD SUSPENDED FOR TIME BEING 02120C*R 58 PM$,1 ADD CUM,6 CUM,6 ADD/CUM LAB 02130C*R 58 PM$,2 ADD CUM,6 CUM,6 ADD/CUM LAB 02140C*R 58 PM$,3 ADD CUM,7 CUM,7 ADD/CUM MATL 02150C*R 58 PM$,4 ADD CUM,7 CUM,7 ADD/CUM MATL 02160C*R 55 58 PM$,5 ADD CUM,3 CUM,3 VEND/ADD MATL 02170C*RN55 58 PM$,5 ADD CUM,6 CUM,6 OP/CUM LABOR 02180C*R 58 PM$,6 ADD CUM,6 CUM,6 CUM/CUM LABOR 02190C*R 58 PM$,7 ADD CUM,7 CUM,7 CUM/CUM MATL 02200CSR END72 ENDSR 02210C******************************************************************** 02220CSR SR81 BEGSR 02230C* GET PART MAST. 02240CSR MOVE ' ' W12A 02250CSR W12A CHAINPMMST2 60 ÐÐ02260CSRN60 PMSTAT COMP 'D' 60 02270CSR ENDSR 02280C******************************************************************** 02290CSR SR82 BEGSR 02300C* UPDATE ASSY PMMST COSTS. 02310CSR SETON 8280 02320CSR EXCPT 02330CSR SETOF 8280 02340CSR ENDSR 02350C******************************************************************** 02360CSR SR101 BEGSR 02370C* 1-TIME INITIALIZE. 02380CSR SETON 79 02390CSR MOVE ' ' BLK12 12 02400CSR MOVE ' ' BLK35 35 02410CSR Z-ADD0 ZERO10 100 02420CSR ENDSR 02430O******************************************************************** 02440OTERM132 E 80 02450O TIME 8 ' : : ' 02460O PGLL Z 12 02470O PGPN 26 ' - - ' 02480O PMNOBMZ 30 02490O PM$ 1 132 02500O******************************************************************** ÐÐ02510OPMMST2 E 82 02520O PMNOBM 14P 02530O PM$ 279P 02540O MHR 590P 02550O MDP 614P 02560O******************************************************************** 02570OPCGUIDE2D 01 02580O 13 'D' ** CUM ARRAY 002590 002600/* 002610_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(y  XESCH P999999120282(èÈÐ SUBROUTINE ZESCH 00010C CLEAR DG TERMINAL 00020 INTEGER IBUF (20) 00030 ILU=0 00040 IXY=-1 00050 N1= 40 00060 N2=0 00070 ITC=0 00080 DO 10 I=1, 20 00090 10 IBUF(I) = $0000 00100 IBUF(1) = $1B48 00110 CALL WTREAD(ILU,IXY,IBUF,N1,IXY,IBUF,N2,ITC) 00120 RETURN 00130 END 00140_‚ _‚_‚ ÐÈ(¼y ¼$X033BM P120282120282(èÈÐ00010H Q033BM00020F* LIST, WHERE-USED FILE GEN BY Q032BM(X033BM) 00030F* D I A B L O 00040F* REV 5/07/80 4:10 PM. DG-REL006 OK. 00050FBITHEX IP F 256 DISK 00060FPURCHWU IS F 132R I DISK U1 00070FWUADRT IR F 3 3IT EDISK 00080E******************************************************************** 00090E WUADRT PURCHWU 00100E HED 1 5 66 00110E TOT 1 2 66 00120E BIT 256 1 BITHEX. 00130E REC 132 1 00140I******************************************************************** 00150IBITHEX BT 01 00160I 1 256 BIT 00170I************************************************************** 00180IPURCHWU PW 02 00190I 2 3 PWLEV 00200I 8 10 PWITNO 00210I 14 25 PWCPN L2 00220I 29 40 PWAPN L1 00230I 122 132 COST 00240I 1 132 REC 00250C******************************************************************** ÐÐ00260C 01 EXITFQLF8 00270C 01 Z-ADD0 COUNT 00280C 01 MOVE ' ' BLK12 12 00290C 01 MOVE ' ' BLK66 66 00300C 01 Z-ADD9 W2N 20 00310C 01 MOVE 'Y' ECODE 1 00320C 01 MOVE BLK12 W8A 8 00330C 01 EXIT SUBRED 00340C RLABL UDATE 00350C RLABL ECODE 00360C RLABL W8A 00370C RLABL W2N 00380C 01 MOVELW8A HED,1 00390C 01 EXSR SR71 HEADINGS 00400C 01 GOTO END 00410C* COMPUTE COST. 00420C MOVE BLK12 W12A 12 00430C MOVE COST W12A 00440C Z-ADD12 W2N 20 00450C EXIT SUBRAJ 00460C RLABL W2N 00470C RLABL W12A 00480C MOVE W12A COST9 93 00490C COST9 ADD ACOST ACOST 113 00500C COST9 ADD TOTCST TOTCST 113 ÐÐ00510C 1 ADD COUNT COUNT 30 00520C COUNT COMP 80 54 54 00530C 54 EXSR SR71 00540C MOVEAREC W66A 66 00550C EXITFQTW132 00560C RLABL W66A 00570C MOVEAREC,67 W66A 00580C EXITFQTW132 00590C RLABL W66A 00600C EXITFQCLFCR 00610C*------------------------------------------------------------------- 00620C END TAG 00630CL2 MOVE '2' ECODE 00640CL2 Z-ADD15 W2N 00650CL2 MOVELBLK12 W15A 15 00660CL2 MOVE ' ' W15A 00670CL2 EXIT SUBRED 00680CL2 RLABL ACOST 00690CL2 RLABL ECODE 00700CL2 RLABL W15A 00710CL2 RLABL W2N 00720CL2 MOVE BLK66 W66A 00730CL2 EXITFQTW132 00740CL2 RLABL W66A 00750CL2 MOVEATOT,1 W66A 66 ÐÐ00760CL2 MOVE W15A W66A 00770CL2 EXITFQTW132 00780CL2 RLABL W66A 00790CL2 Z-ADD0 ACOST 00800CL2 EXITFQCLFCR 00810CL2 EXITFQCLFCR 00820CL2 2 ADD COUNT COUNT 00830CL2 COUNT COMP 80 54 54 00840CL2 54 EXSR SR71 00850CLR MOVE '2' ECODE 00860CLR Z-ADD15 W2N 00870CLR MOVELBLK12 W15A 00880CLR MOVE ' ' W15A 00890CLR EXIT SUBRED 00900CLR RLABL TOTCST 00910CLR RLABL ECODE 00920CLR RLABL W15A 00930CLR RLABL W2N 00940CLR MOVE BLK66 W66A 00950CLR EXITFQTW132 00960CLR RLABL W66A 00970CLR MOVEATOT,2 W66A 00980CLR MOVE W15A W66A 00990CLR EXITFQTW132 01000CLR RLABL W66A ÐÐ01010CLR EXITFQTOPF 01020CLR EXITFQLF6 01030C******************************************************************** 01040CSR SR71 BEGSR 01050C* PUT HEADINGS 01060CSR 1 ADD EGAP EGAP 40 01070CSR MOVE ' ' W4A 4 01080CSR Z-ADD4 W2N 01090CSR MOVE 'Z' ECODE 01100CSR EXIT SUBRED 01110CSR RLABL EGAP 01120CSR RLABL ECODE 01130CSR RLABL W4A 01140CSR RLABL W2N 01150CSR EXITFQTOPF 01160CSR EXITFQCCR 01170CSR MOVEAHED,1 W66A 01180CSR EXITFQTW132 01190CSR RLABL W66A 01200CSR MOVE BLK66 W66A 01210CSR MOVE W4A W66A 01220CSR EXITFQTW132 01230CSR RLABL W66A 01240CSR EXITFQCLFCR 01250CSR MOVEAHED,2 W66A ÐÐ01260CSR EXITFQTW132 01270CSR RLABL W66A 01280CSR MOVEAHED,3 W66A 01290CSR EXITFQTW132 01300CSR RLABL W66A 01310CSR EXITFQCLFCR 01320CSR MOVEAHED,4 W66A 01330CSR EXITFQTW132 01340CSR RLABL W66A 01350CSR MOVEAHED,5 W66A 01360CSR EXITFQTW132 01370CSR RLABL W66A 01380CSR EXITFQCLFCR 01390CSR EXITFQCLF 01400CSR Z-ADD5 COUNT 01410CSR ENDSR ** HED ARRAY 001420 WHERE-USED 001430 ITEM COMPONENT NEXT ASSY 001440 UNIT QUANTITY SOURCE ISSUE PROV EXTENDED FAB MATERIAL 001450LEVEL NO. PART # PART # DESCRIPTION 001460 COST PER-ASSY CODE CODE CODE QUANTITY CODE COST 001470** TOT ARRAY 001480 PART TOTAL...... 001490 FINAL TOTAL..... 001500ÐÐ/* 001510_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼z7 ¼$X034BM PüD120282120282(èÈÐ00010H Q034BM00020F* REQUEST PART #'S FOR PROGRAMS USING SUSPENSE FOR PART # INPUT. (X034BM) 00030F* REVISED 12-10-82 3:10 PM. DG-REL006 OK. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FSUSPENSEUC F 128R29AI 1 DISK A 00070FPMMODEL2ID F 23L22AI 1 DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FCRTFILE UC F 256R DISK 00100FJQCONT UC F 6R DISK 00110FJQMAST O F 96 4AI 1 DISK A 00120FJQDEVICEO F 8 6AI 1 DISK A 00130FJQDEPT O F 10 9AI 1 DISK A 00140FJQJOB O F 11 10AI 1 DISK A 00150FTERM60 O F 60 5 00160E******************************************************************** 00170E A12 12 12 1 A INPUT DATA ARRAY 00180E A29 29 29 1 00190E DES 1 25 40 JOB 6 JOB DESCR/PROG # 00200E PRG 1 25 6 COD 2 PROG#/SUSPENSE-CODE 00210E PGN 1 25 6 DEV 1 00220E BIT 33 1 SCREEN CONTR. CHAR 00230E LNK 1 7 6 A 00240E PAR 25 1 00250E TST 25 1 ÐÐ00260E CALL 7 6 00270E APN 8 10 0A SUSPENSE FILE 00280E QTY 8 3 0 SUSPENSE FILE 00290I******************************************************************* 00300IBITPAR BT 00310I 1 33 BIT 00320I 34 58 PAR 00330I 59 83 TST 00340I******************************************************************** 00350ICRTFILE CR 00360I 1 5 CREMPL 00370I 6 13 CRUSER 00380I 14 18 CRDEPT 00390I 19 26 CRJOB 00400I 27 27 CRSHUT 00410I 28 330CRTIME 00420I 34 370CRDATE 00430I 38 79 CALL 00440I******************************************************************** 00450IJQCONT JC 00460I 1 40JCJOB 00470I******************************************************************** 00480IMGFILE MG 00490I* MESSAGE FILE. 00500I 1 35 MGTEXT ÐÐ00510I******************************************************************** 00520ISUSPENSESP 00530I* RECORD CODE 2A 00540I 3 4 SPREC 00550I* COUNTER 3N 00560I 5 70SPCNTR 00570I* PART # 10N X 8 00580I 30 109 APN 00590I P 110 125 QTY 00600I* RECORD STATUS 00610I 128 128 SPSTAT 00620I******************************************************************** 00630IPMMODEL2PD 00640I* MODEL NAME 12A 00650I 1 12 PDMODL 00660I* PART # 1ON 00670I 13 220PDPN 00680I* RECORD STATUS 1A 00690I 23 23 PDSTAT 00700I******************************************************************** 00710IPMMST2 PM 00720I* PART MASTER RECORD 00730I* KEY AREA 00740I* PART NO. 10N 00750I 1 100PMPN ÐÐ00760I* NUMB OF COMPONENTS 3P 00770I P 13 140PMNOBM 00780I* PROD LINE 4N 00790I 15 180PMPL 00800I* MODEL NAME 12A 00810I 19 30 PMMODL 00820I* DESCRIPTION 29A 00830I 31 59 PMDESC 00840I* COMMODITY CODE 9P 00850I P 60 640PMCC 00860I* ENG CHANGE STATUS. 00870I* CUR CHG LEVEL 2A 00880I 70 71 PMECHG 00890I* CUR CHG DATE 6N 00900I 72 770PMDCHG 00910I* LAST ECN NO. 5A 00920I 65 69 PMECN 00930I* DRAWING INFO 00940I* DWG SIZE 1A 00950I 82 82 PMSIZ 00960I* DWG CLASS 1A 00970I* D = DYNAIR DWG 00980I* V = VENDOR DWG 00990I 83 83 PMDCLS 01000I* STANDARD CODE 1A ÐÐ01010I 84 84 PMSTDC 01020I* DWG REL CODE 1A 01030I* E = ENG ONLY 01040I* M = REL TO MFG 01050I* P = PROTOTYPE 01060I 78 78 PMDREL 01070I* UNIT MEAS 2A 01080I* EA = EACH OC = OUNCE 01090I* ST = SET TC = TROY OUNCE 01100I* IN = INCH LB = POUND 01110I* FT = FEET PT = PINT 01120I* YD = YARD QT = QUART 01130I* SI = SQ.INCH GL = GALLON 01140I* SF = SQ.FEET DR = DRUM 01150I* SY = SQ.YARD 01160I 85 86 PMUM 01170I* SOURCE CODE 2A 01180I* MA = MFG ASSY 01190I* MP = MFG PART 01200I* PA = PURCH ASSY 01210I* PP = PURCH PART 01220I* RS = RAW STOCK 01230I 94 95 PMSC 01240I* PROVISIONING CODE 1A 01250I* A = FORECAST,NO VALUE ADDED ÐÐ01260I* B = FORECAST,VALUE ADDED 01270I* C = BUILD TO ORDER (B) 01280I* D = BUILD TO ORDER (NOT B) 01290I* E = CUSTOM 01300I* Y = OBSOLETE,REPAIRABLE 01310I* Z = OBSOLETE,NOT REPAIRABLE 01320I 96 96 PMPROV 01330I* ISSUE CODE 2A 01340I* PT = PULL TIME 01350I* OR = ON REQUEST 01360I* BI = BULK ISSUE 01370I* AR = AS REQUIRED 01380I* VS = VENDOR SUPPLIED 01390I* SD = SHIPPING DOCUMENT 01400I* TD = TRAV DOCUMENT 01410I* RD = REF DOCUMENT 01420I* RA = REF ASSY 01430I 97 98 PMISSU 01440I* DELIVER TO DEPT 5P 01450I P 99 1010PMDEL 01460I* RESPONSIBILITY CODES 01470I* ENGR CODE 2A 01480I 102 103 PMEGR 01490I* PLANNER CODE 2A 01500I 104 105 PMPLNR ÐÐ01510I* BUYER CODE 2A 01520I 106 107 PMBUYR 01530I* SALESMAN CODE 2A 01540I 108 109 PMSLSM 01550I* INVENTORY ACCOUNT 5P 01560I P 110 1120PMACNT 01570I* OLD UNIT COST 9.3P 01580I P 489 4933PMOSUC 01590I* RECORD STATUS 1A 01600I* D = DELETED 01610I 674 674 PMSTAT 01620C******************************************************************** 01630C* INITIALIZE 1-TIME. 01640C EXSR SR101 INIT 01650C MOVE ' ' BLK6 6 01660C*------------------------------------------------------------------- 01670C START TAG 01680C* DISPLAY JOBS THAT MAY BE REQUESTED. REQUEST SELECTION. 01690C 78 EXSR SR79 UPDATE JQMAST 01700C EXSR SR70 DISPLAY JOBS 01710C EXSR SR102 REQUEST JOBS 01720C*------------------------------------------------------------------- 01730C TAG10 TAG 01740C* REQUEST PART # INPUT. 01750C Z-ADD298 M 50 ÐÐ01760C EXSR SR73 PROMPT 01770C EXSR SR75 READ 01780C 96 GOTO TAG10 ESC ERROR 01790C MOVE BLK12 W10A 10 01800C MOVELW12A W10A 01810C Z-ADD10 W2N 01820C EXIT SUBRAJ 01830C RLABL W2N 01840C RLABL W10A 01850C MOVE W10A TPN 100 01860C MOVELW10A W12A 12 01870C W12A CHAINPMMST2 60 01880C N60 PMSTAT COMP 'D' 60 01890C 60 Z-ADD291 M 50 01900C 60 EXSR SR73 FLAG ERROR 01910C 60 GOTO TAG10 01920C*---------------------------------------------------------------- 01930C TAG20 TAG 01940C Z-ADD0 TQTY 30 01950C Z-ADD564 M 01960C EXSR SR73 PROMPT 01970C EXSR SR75 READ 01980C 96 GOTO TAG20 ESC ERROR 01990C MOVELW12A W3A 3 02000C Z-ADD3 W2N ÐÐ02010C EXIT SUBRAJ 02020C RLABL W2N 02030C RLABL W3A 02040C MOVE W3A TQTY 02050C TQTY COMP 0 54 02060C N54 Z-ADD1 TQTY 02070C EXSR SR103 UPDATE SUSPENSE 02080C GOTO TAG10 02090C*------------------------------------------------------------------- 02100C NEWITM TAG 02110C MOVEL'Q034BM 'PROG 02120C GOTO END 02130C*-------------------------------------------------------------------- 02140C GOODBY TAG 02150C MOVEL'GOODBY 'PROG 8 02160C GOTO END 02170C*------------------------------------------------------------------- 02180C MENU TAG 02190C 78 EXSR SR79 UPDATE BATCH QUE 02200C EXSR SR96 02210C Z-ADD1 W 30 02220C BLK6 LOKUPLNK,W 54 02230C 54 MOVELLNK,W PROG 8 02240C 54 MOVE BLK6 LNK,W 02250C N54 MOVEL'CONTU 'PROG ÐÐ02260C EXSR SR97 02270C EXSR SR98 02280C*--------------------------------------------------------------------- 02290C END TAG 02300C EXSR SR96 02310C EXSR SR97 02320C EXSR SR98 02330C*--------------------------------------------------------------------- 02340C ENDJOB TAG 02350C MOVE 'ENDJOB 'PROG 02360C EXSR SR98 02370C***************************************************************** 02380CSR SR70 BEGSR 02390C* DISPLAY JOB SELECTIONS ON TERM. 02400CSR Z-ADD0 X 30 02410C*---------------------------------------------------------------- 02420CSR T70A TAG 02430CSR 1 ADD X X 02440CSR X COMP 25 54 02450CSR 54 GOTO END70 02460CSR JOB,X COMP ' ' 54 02470CSRN54 GOTO T70A 02480CSR SETON 70 02490CSR EXCPT DISPLAY JOBS 02500CSR SETOF 70 ÐÐ02510CSR GOTO T70A 02520CSR END70 ENDSR 02530C***************************************************************** 02540CSR SR73 BEGSR 02550C* PUT MSG TO TERM. 02560CSR M CHAINMGFILE 54 02570CSR 54 MOVE BLK35 MGTEXT 02580CSR 54 MOVELM MGTEXT 02590CSR 54 MOVE '??????' MGTEXT 02600CSR SETON 73 02610CSR EXCPT PUT MSG 02620CSR SETOF 73 02630CSR ENDSR 02640C******************************************************************* 02650CSR SR75 BEGSR 02660C* READ FROM TERMINAL 02670CSR SETOF 779096 02680CSR SETOF 939291 02690CSR SETOF 898887 02700CSR SETOF 8685 02710CSR MOVE BLK12 W12A 12 BUFFER 02720CSR EXITFZR12 READ FROM TERMINAL 02730CSR RLABL W12A READ BUFFER 02740CSR MOVEAW12A A12 INPUT DATA ARRAY 02750CSR MOVE BLK12 W12A INIT INPUT ARRAY ÐÐ02760CSR Z-ADD1 W 30 02770CSR '\' LOKUPA12,W 90 FLAG ESC 02780CSRN90 GOTO T75B NOT ESC 02790CSR 1 ADD W W 02800CSR W COMP 12 54 02810CSR 54 GOTO T75A BAD ESC 02820CSR A12,W COMP 'G' 98 GOODBY 02830CSR A12,W COMP 'E' 94 MENU 02840CSR A12,W COMP 'N' 93 NEW ITEM 02850CSRN94 A12,W COMP 'U' 94 UPDATE 02860CSR 98 GOTO GOODBY 02870CSR 93 GOTO NEWITM 02880CSR 94 GOTO MENU 02890C*------------------------------------------------------------------ 02900CSR T75A TAG 02910C* FLAG BAD ESC INPUT 02920CSR Z-ADD318 M 96 FLAG ERROR 02930CSR EXSR SR73 PUT MSG 02940CSR GOTO END75 02950C*-------------------------------------------------------------------- 02960CSR T75B TAG 02970C* MOVE DATA 02980CSR Z-ADD1 W 02990CSR ' ' LOKUPA12,W 77 03000CSR 77 MOVEAA12,W W12A INPUT DATA ÐÐ03010CSR END75 ENDSR 03020C******************************************************************** 03030CSR SR79 BEGSR 03040C* UPDATE JOB QUEUE. 03050CSR SETOF 78 03060CSR Z-ADD1 W5N 50 03070CSR W5N CHAINJQCONT 54 03080CSR 1 ADD JCJOB JCJOB 03090CSR SETON 79 03100CSR EXCPT UPDATE JQMAST 03110CSR SETOF 79 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR80 BEGSR 03150C* GET SUSPENSE FILE. 03160CSR MOVE SEQNO W3A 3 03170CSR MOVEAW3A A29,5 03180CSR MOVEAA29 W29A 29 03190CSR SETOF 61 03200CSR W29A CHAINSUSPENSE 60 03210CSRN60 SPSTAT COMP 'D' 61 03220CSR ENDSR 03230C******************************************************************** 03240CSR SR81 BEGSR 03250C* ADD NEW SUSPENSE RECORD. ÐÐ03260CSR MOVE SEQNO W3A 03270CSR MOVEAW3A A29,5 03280CSR MOVEAA29 W29A 03290CSR Z-ADD0 APN 03300CSR SETON 8178 03310CSR EXCPT ADD SUSPENSE 03320CSR SETOF 81 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR82 BEGSR 03360C* REWRITE SUSPENSE. 03370CSR SETON 8278 03380CSR EXCPT REWRITE SUSPENSE 03390CSR SETOF 82 03400CSR ENDSR 03410C****************************************************************** 03420CSR SR96 BEGSR 03430CSR # CHAINCRTFILE H9 GET CRTFILE 03440CSR H9 GOTO ENDJOB 03450CSR ENDSR 03460C****************************************************************** 03470CSR SR97 BEGSR 03480CSR TIME CRTIME 03490CSR MOVELUDATE CRDATE 03500CSR SETON 97 ÐÐ03510CSR EXCPT UPDATE CRTFILE 03520CSR SETOF 97 03530CSR ENDSR 03540C******************************************************************* 03550CSR SR98 BEGSR 03560CSR EXITFCHAIN >>>>>>>>>>>>>>>> 03570CSR RLABL PROG 03580CSR ENDSR 03590C******************************************************************** 03600CSR SR101 BEGSR 03610C* 1-TIME INITIALIZE 03620CSR Z-ADD0 COUNT 30 03630CSR MOVE ' ' BLK12 12 03640C* GET PORT # AND CRTFILE. 03650CSR MOVE ' ' W2A 2 03660CSR EXITFZGMINX 03670CSR RLABL W2A 03680CSR MOVE W2A # 20 PORT NO. 03690CSR # COMP 0 54 03700CSRN54 Z-ADD25 # DEFAULT 03710CSR EXSR SR96 03720CSR MOVE CALL LNK 03730CSR MOVE 'Q034BM 'PROG 03740CSR PAR,# COMP '1' 50 03750CSR TST,# COMP 'S' 54 ÐÐ03760CSR 54 MOVE 'SHUTDOWN'PROG 03770CSR EXSR SR97 03780CSR 54 EXSR SR98 03790C* DEFINE WORK FIELDS, ETC. 03800CSR MOVE ' ' BLK35 35 03810CSR MOVE ' ' BLK10 10 03820CSR Z-ADD0 ZERO10 100 03830C* 03840C* 03850CSR END101 ENDSR 03860C******************************************************************** 03870CSR SR102 BEGSR 03880C* REQUEST JOB #. 03890CSR MOVE ' ' JOBNO 6 03900CSR Z-ADD559 M 50 03910CSR EXSR SR73 PROMPT 03920CSR EXSR SR75 READ 03930CSR 90 GOTO END102 03940CSR Z-ADD12 W2N 20 03950CSR EXIT SUBRAJ 03960CSR RLABL W2N 03970CSR RLABL W12A 12 03980CSR MOVE W12A X 30 03990CSR X COMP 25 55 04000CSR 55 Z-ADD560 M ÐÐ04010CSR 55 EXSR SR73 FLAG ERROR 04020CSR 55 GOTO SR102 04030CSR X COMP 0 55 04040CSRN55 Z-ADD560 M 04050CSRN55 EXSR SR73 FLAG ERROR 04060CSRN55 GOTO SR102 04070CSR MOVE JOB,X JOBNO 6 04080CSR MOVE COD,X CODENO 2 04090CSR JOBNO COMP ' ' 55 04100CSRN55 Z-ADD560 M 04110CSRN55 EXSR SR73 04120CSRN55 GOTO SR102 04130CSR MOVE ' ' A29 04140CSR MOVEACODENO A29,3 04150CSR Z-ADD1 SEQNO 30 04160CSR MOVE SEQNO W3A 3 04170CSR MOVEAW3A A29,5 04180CSR MOVEACRDEPT A29,8 04190CSR MOVEACREMPL A29,13 04200CSR END102 ENDSR 04210C******************************************************************** 04220CSR SR103 BEGSR 04230C* UPDATE SUSPENSE FILE. 04240CSR EXSR SR80 GET SUSPENSE 04250CSR 60 EXSR SR81 ADD SUSPENSE ÐÐ04260CSR 60 GOTO SR103 04270CSR Z-ADD1 X 04280CSR ZERO10 LOKUPAPN,X 54 04290CSRN54 1 ADD SEQNO SEQNO 04300CSRN54 GOTO SR103 04310CSR Z-ADDTPN APN,X 04320CSR Z-ADDTQTY QTY,X 04330CSR EXSR SR82 REWRITE SUSPENSE 04340CSR ENDSR 04350C******************************************************************** 04360C* 04370C* 04380C* 04390C* 04400O******************************************************************** 04410OSUSPENSEEADD 81 04420O W29A 29 04430O APN 109 04440O QTY 125P 04450O 128 'A' 04460O*------------------------------------------------------------------- 04470O E 82 04480O APN 109 04490O QTY 125P 04500O 128 'A' ÐÐ04510O******************************************************************** 04520OTERM60 E 70 04530O X Z 3 04540O DES,X 45 04550O E 73 04560O MGTEXT 35 04570O****************************************************************** 04580OJQMAST EADD 79 04590O JCJOB 4 04600O CRDEPT 11 04610O JOBNO 17 04620O******************************************************************** 04630OJQCONT E 79 04640O JCJOB 4 04650O******************************************************************** 04660OJQDEVICEEADD 79 04670O 1 'D' 04680O JCJOB 6 04690O******************************************************************** 04700OJQDEPT EADD 79 04710O CRDEPT 5 04720O JCJOB 9 04730O 10 'A' 04740O******************************************************************* 04750OJQJOB EADD 79 ÐÐ04760O JOBNO 6 04770O JCJOB 10 04780O 11 'A' 04790O***************************************************************** 04800OCRTFILE E 97 04810O PROG 26 04820O CRTIME 33 04830O CRDATE 37 04840O LNK 79 04850O******************************************************************* ** A12 ARRAY 004860 004870** A29 ARRAY 004880 004890** DES/JOB ARRAY (JOB DESCRIPTION / PROG NUMBER 004900INDENTED PARTS LIST, MFG PARTS ONLY Q106PM 1 004910PARTS LIST, SINGLE LEVEL Q107BM 2 004920INDENTED PARTS LIST, ALL PARTS Q016BM 3 004930INDENTED PARTS LIST,COSTED-ALL PARTS ZBMCS1 4 004940INDENTED PARTS LIST,COSTED-ALL & W/U ZBMCS2 5 04950INDENTED PARTS LIST,COSTED-MFD ONLY ZBMCS3 6 04960INDENTED PARTS LIST,COSTED-MFD & W/U ZBMCS4 7 04970WHERE-USED, SINGLE-LEVEL Q108BM 8 004980WHERE-USED, INDENTED Q122BM 9 004990 10 005000ÐÐ 11 005010 12 005020 13 05030 14 05040 15 05050 16 05060 17 05070 18 05080 19 05090 20 05100 21 05110 22 05120 23 05130 24 05140 25 05150** PRG/COD ARRAY (PROG NAMES/SUSPENSE RECORD CODES) 05160Q106PMMP INDENTED PARTS LIST, MFG PARTS 1 05170Q107BMSL PARTS LIST, SINGLE LEVEL 2 05180Q016BMIP INDENTED PARTS LIST 3 05190ZBMCS1CP INDENTED PARTS LIST,COSTED-ALL PARTS 4 05200ZBMCS2CP INDENTED PARTS LIST,COSTED-ALL & W/U 5 05210ZBMCS3CP INDENTED PARTS LIST,COSTED-MFD ONLY 6 05220ZBMCS4CP INDENTED PARTS LIST,COSTED-MFD & W/U 7 05230Q108BMSW WHERE-USED, SINGLE-LEVEL 8 05240Q122BMIW WHERE-USED, INDENTED 9 05250ÐÐ 10 05260 11 05270 12 05280 13 05290 14 05300 15 05310 16 05320 17 05330 18 05340 19 05350 20 05360 21 05370 22 05380 23 05390 24 05400 25 05410** PGN/DEV (PROG NAME / PRINTER DEVICE CODE) 05420Q106PMD INDENTED PARTS LIST, MFG PARTS, DIABLO 1 05430Q107BMD PARTS LIST, SINGLE-LEVEL, DIABLO 2 05440Q016BMD INDENTED PARTS LIST, DIABLO 3 05450ZBMCS1D INDENTED PARTS LIST,COSTED,ALL,DIABLO 4 05460ZBMCS2D INDENTED PARTS LIST,COSTED,ALL,W-U,DIABLO5 05470ZBMCS3D INDENTED PARTS LIST,COSTED,MFD,DIABLO 6 05480ZBMCS4D INDENTED PARTS LIST,COSTED,MFD,W-U,DIABLO7 05490Q108BMD WHERE-USED, SINGLE-LEVEL, DIABLO 8 05500ÐÐQ122BMD WHERE-USED, INDENTED, DIABLO 9 05510 10 05520 11 05530 12 05540 13 05550 14 05560 15 05570 16 05580 17 05590 18 05600 19 05610 20 05620 21 05630 22 05640 23 05650 24 05660 25 05670** LNK ARRAY 05680 05690/* 05700_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(–{\ –?X030RX P120282120282(èÈÐ00010H Q030RX00020F* ROUTING TEXT RESEQUENCE - PHASE-2. (X030RX) DG REL006 OK 00030F* REVISED 12/01/82 11:45 AM. 00040FBITTAB IP F 33 DISK 00050FREXTSEQ UD F 32 DISK 00060FREXTPTR UC F 25R21AI 1 DISK A 00070FREXTFILEUC F 90R DISK 00080FCRTFILE UC F 256R DISK 00090E******************************************************************** 00100E BIT 33 1 00110E TXT 60 1 A 00120I******************************************************************* 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160ICRTFILE CR 00170I 80 91 CRPN 00180I 92 940CRSEQ 00190I P 222 2250CRFLIN 00200I P 250 2510CRINCR 00210I******************************************************************** 00220IREXTPTR TP 00230I* TEXT POINTER FILE. 00240I* TEXT KEY 15A 00250I 1 15 TPKEY ÐÐ00260I* LINE # 6N 00270I 16 210TPLINE 00280I* POINTER 7P 00290I P 22 250TPPTR 61 00300I******************************************************************** 00310IREXTFILETX 00320I* REXTFILE RECORD. 00330I* NAME 6A 00340I 1 12 TXPN 00350I 13 150TXSEQ 00360I 1 150TXKEY 00370I* LINE # 6N 00380I 16 210TXLINE 00390I* TEXT 1A X 60 00400I 22 81 TXT 00410I* BACKWARD PTR (DELETE) 7P 00420I P 82 850TXBPTR 00430I* RECORD STATUS 1A 00440I 90 90 TXSTAT 00450I******************************************************************** 00460IREXTSEQ TS 00470I 1 12 TSPN 00480I 13 150TSSEQ 00490I 1 15 TSKEY 00500I 16 210TSOLIN ÐÐ00510I 22 270TSNLIN 00520I P 28 310TSPTR 88 00530I 32 32 TSSTAT 00540C******************************************************************** 00550C* INITIALIZE. 00560C N89 EXSR SR101 00570C*-------------------------------------------------------------------- 00580C START TAG 00590C SETOF 54 00600C READ REXTSEQ 54 00610C 54 GOTO END 00620C 88 GOTO START 00630C MOVELTSKEY W21A 21 00640C MOVE TSNLIN W21A 00650C W21A CHAINREXTPTR 60 00660C TSPTR CHAINREXTFILE 61 00670C 61 GOTO START 00680C SETON 81 00690C EXCPT UPDATE TEXT. 00700C SETOF 81 00710C GOTO START 00720C*------------------------------------------------------------------- 00730C END TAG 00740CLR SETON 97 00750CLR EXCPT UPDATE CRTFILE ÐÐ00760CLR SETOF 97 00770CLR MOVEL'Q002RX' PROG 8 00780CLR EXITFCHAIN 00790CLR RLABL PROG 00800C*------------------------------------------------------------------- 00810CLR ENDJOB TAG 00820C******************************************************************** 00830CSR SR101 BEGSR 00840C* 1-TIME INIT 00850CSR SETON 89 00860CSR MOVE ' ' W2A 2 00870CSR EXITFZGMINX 00880CSR RLABL W2A 00890CSR MOVE W2A PORT 20 00900CSR PORT COMP 0 54 00910CSRN54 Z-ADD25 PORT 00920CSR PORT CHAINCRTFILE H9 00930CSR H9 GOTO ENDJOB 00940CSR ENDSR 00950O******************************************************************** 00960OCRTFILE E 97 00970O CRFLIN 225P 00980O CRINCR 251P 00990O******************************************************************** 01000OREXTFILEE 81 ÐÐ01010O W21A 21 01020O******************************************************************** 01030OREXTPTR EADD 81 60 01040O W21A 21 01050O TSPTR 25P 01060O*------------------------------------------------------------------- 01070O E 81N60 01080O TSPTR 25P 01090O******************************************************************** 01100OREXTSEQ E 81 01110O 23 'D' /* 001120_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Â{œ ¼XQPM01 P 999999120282(èÈÐ00010H QQPM0100020F* PART MASTER ORDER POLICY UPDATE MENU.(XQPM01) 00030F* REVISED 8-11-82 3:20 PM. 00040FBITPAR IP F 90 DISK 00050FCRTFILE UC F 256R DISK 00060E******************************************************************** 00070E PA 1 23 8 NA 50 PROGRAM #/NAMES 00080E PB 1 23 8 NB 50 PROGRAM #/NAMES 00090E NUL 1 132 1 NULL CHAR 00100E A4 4 4 1 A 00110E TITL 1 6 66 MENU TITLE,HEADINGS 00120E MSG 1 3 25 00130E SEL 1 46 8 00140E PRG 1 23 8 NAM 50 AWORK ARRAY 00150E LNK 1 7 6 A 00160E BIT 33 1 00170E PAR 25 1 00180E TST 25 1 00190E CALL 7 6 A 00200E REC 177 1 00210I******************************************************************** 00220IBITPAR BT 02 00230I 1 33 BIT 00240I 34 58 PAR 00250I 59 83 TST ÐÐ00260I******************************************************************** 00270ICRTFILE CR 00280I 19 26 CRJOB 00290I 27 27 CRSHUT 00300I 28 330CRTIME 00310I 34 370CRDATE 00320I 38 79 CALL 00330I 80 256 REC 00340C******************************************************************** 00350C EXSR SR101 INIT 00360C EXSR SR102 DISPLAY MENU 00370C EXSR SR103 REQUEST SELECTION 00380C*------------------------------------------------------------------ 00390C NEWITM TAG 00400C MOVEL'QQPM01' PROG 8 00410C EXSR SR98 <<>> 00420C*------------------------------------------------------------------ 00430C MENU TAG 00440C EXSR SR97 <<>> 00450C*--------------------------------------------------------------------- 00460C GOODBY TAG 00470C MOVEL'GOODBY' PROG 8 00480C EXSR SR98 <<>> 00490C*----------------------------------------------------------------- 00500C ENDJOB TAG <<>> ÐÐ00510C MOVEL'ENDJOB 'PROG 00520C EXITFCHAIN 00530C RLABL PROG 00540C************************************************************************ 00550CSR SR68 BEGSR 00560CSR EXITFZLFCR LF/CR 00570CSR ENDSR 00580C***************************************************************** 00590CSR SR69 BEGSR 00600C* MOVE CURSOR 00610CSR 50 EXITFZPUTXY 00620CSR RLABL RPGLIN 00630CSR RLABL RPGCOL 00640CSRN50 EXITFZMOVXY 00650CSR RLABL RPGLIN 00660CSR RLABL RPGCOL 00670CSR ENDSR 00680C**************************************************************** 00690CSR SR70 BEGSR 00700CSR MOVELW66A OUTPUT 80 00710CSR EXITFZW80 WRITE 80-BYTES CRT 00720CSR RLABL OUTPUT 00730CSR ENDSR 00740C****************************************************************** 00750CSR SR71 BEGSR ÐÐ00760CSR MOVELREQST RPGLIN 00770CSR MOVEL'067' RPGCOL 00780CSR EXSR SR69 MOVE CURSOR 00790CSR 50 EXITFZBLINK START BLINK 00800CSR EXSR SR70 WRITE MESSAGE 00810CSR EXITFZBLUNK STOP BLINK 00820CSR ENDSR 00830C******************************************************************* 00840CSR SR72 BEGSR 00850CSR MOVE BLK66 W66A 00860CSR EXSR SR71 INIT MESSAGE 00870CSR ENDSR 00880C****************************************************************** 00890CSR SR75 BEGSR 00900C* READ CRT 00910CSR SETOF 7790 00920CSR MOVE BLK4 W4A 4 00930CSR EXITFZR4 READ CRT 00940CSR RLABL W4A 00950CSR MOVEAW4A A4 00960CSR MOVE BLK4 W4A 4 00970CSR Z-ADD1 W 30 00980CSR '\' LOKUPA4,W 90 00990CSRN90 GOTO T75C 01000CSR 1 ADD W W ÐÐ01010CSR W COMP 4 54 01020CSRN54 GOTO T75B 01030C*--------------------------------------------------------------- 01040CSR T75A TAG 01050C* FLAG BAD ESCAPE CODE 01060CSR MOVE BLK66 W66A 01070CSR MOVELMSG,3 W66A 01080CSR EXSR SR71 PUT ERROR MESSAGE 01090CSR GOTO SR75 01100C*-------------------------------------------------------------- 01110CSR T75B TAG 01120CSR A4,W COMP 'G' 98 01130CSR A4,W COMP 'E' 94 01140CSR A4,W COMP 'N' 93 01150CSR 98 GOTO GOODBY 01160CSR 94 GOTO MENU 01170CSR 93 GOTO NEWITM 01180CSR GOTO T75A BAD ESCAPE CODE 01190C*-------------------------------------------------------------------- 01200CSR T75C TAG 01210CSR Z-ADD1 W 01220CSR ' ' LOKUPA4,W 77 01230CSR 77 MOVEAA4,W W4A 01240CSR END75 TAG 01250CSR EXSR SR72 INIT MESSAGE ÐÐ01260CSR ENDSR 01270C******************************************************************** 01280CSR SR96 BEGSR 01290CSR # CHAINCRTFILE H9 GET CRTFILE 01300CSR H9 GOTO ENDJOB 01310CSR ENDSR 01320C***************************************************************** 01330CSR SR97 BEGSR 01340C* MENU REQUEST EXIT. 01350CSR Z-ADD1 W 30 01360CSR ' ' LOKUPLNK,W 54 01370CSRN54 MOVEL'CONTU' PROG 01380CSR 54 MOVELLNK,W PROG 8 01390CSR 54 MOVE ' ' LNK,W 01400CSR EXSR SR98 <<>> 01410CSR ENDSR 01420C***************************************************************** 01430CSR SR98 BEGSR 01440C* NORMAL EOJ - UPDATE CRTFILE AND LINK TO PROG PROGRAM. 01450CSR 50 EXITFZISTAT 01460CSR 50 EXITFZESCH 01470CSRN50 EXITFZCPAGE 01480CSR # CHAINCRTFILE H8 01490CSR H8 GOTO ENDJOB <<>> 01500CSR MOVE LNK CALL ÐÐ01510CSR MOVE ' ' REC 01520CSR MOVE PROG CRJOB 01530CSR MOVELUDATE CRDATE 01540CSR TIME CRTIME 01550CSR SETON 97 01560CSR EXCPT UPDATE CRTFILE 01570CSR SETOF 97 01580CSR EXITFCHAIN <<>> 01590CSR RLABL PROG 01600CSR ENDSR 01610C******************************************************************* 01620CSR SR99 BEGSR 01630C* PROGRAM SELECTED - LOAD THIS MENU AS RETURN-TO PROG 01640CSR Z-ADD8 W 01650C*----------------------------------------------------------------- 01660CSR T99A TAG 01670CSR W SUB 1 W 54 01680CSRN54 SETON H7 01690CSRN54 GOTO ENDJOB <<>> 01700CSR LNK,W COMP ' ' 54 01710CSRN54 GOTO T99A 01720CSR MOVEL'QQPM01' LNK,W 01730CSR EXSR SR98 <<>> 01740CSR ENDSR 01750C******************************************************************* ÐÐ01760C* 01770C* 01780C* 01790C* 01800C* 01810C* 01820C* 01830C********************************************************************** 01840CSR SR101 BEGSR 01850C* 1-TIME INIT 01860CSR MOVE BIT,1 NUL 01870CSR MOVEANUL OUTPUT 01880CSR MOVE ' ' W2A 2 01890CSR EXITFZGMINX GET TERMINAL # 01900CSR RLABL W2A 01910CSR MOVE W2A # 20 01920CSR # COMP 0 54 01930CSRN54 Z-ADD25 # 01940CSR # CHAINCRTFILE H9 01950CSR H9 GOTO ENDJOB <<>> 01960CSR MOVE CALL LNK 01970CSR PAR,# COMP '1' 50 01980CSR 50 EXITFZISTAT CLEAR STATUS LINE 01990CSR 50 EXITFZESCH CLEAR SCREEN 02000CSRN50 EXITFZCPAGE CLEAR SCREEN ÐÐ02010CSRN50 MOVEL'091' RPGLIN 4 02020CSRN50 MOVEL'001' RPGCOL 4 02030CSRN50 EXSR SR69 MOVE CURSOR 02040CSR TST,# COMP 'S' 54 02050CSRN54 CRSHUT COMP 'S' 54 02060CSR 54 MOVE 'SHUTDOWN'PROG 02070CSR 54 EXSR SR98 <<>> 02080CSR MOVE ' ' BLK50 50 02090CSR MOVE ' ' BLK66 66 02100CSR MOVE ' ' BLK132132 02110CSR MOVE ' ' BLK35 35 02120CSR MOVE ' ' BLK8 8 02130CSR MOVE ' ' BLK4 4 02140C* 02150C* 02160CSR MOVE ' ' REC 02170CSR MOVE 'QQPM01 'CRJOB 02180CSR TIME CRTIME 02190CSR MOVELUDATE CRDATE 02200CSR SETON 97 02210CSR EXCPT REWRITE CRTFILE 02220CSR SETOF 97 02230CSR ENDSR 02240C********************************************************************** 02250CSR SR102 BEGSR ÐÐ02260C* DISPLAY MENU 02270CSR Z-ADD-1 M 20 02280CSR Z-ADD1 REQST 30 02290CSR 50 Z-ADD0 W3N 30 02300CSRN50 Z-ADD90 W3N 02310C*--------------------------------------------------------------------- 02320CSR T102A TAG 02330CSR MOVE BLK132 W132A 132 02340CSR 2 ADD M M 20 02350CSR M COMP 5 54 02360CSR 54 GOTO T102C 02370CSR 1 ADD M A 20 02380CSR TITL,M COMP BLK66 54 02390CSR 54 MOVELTITL,M W132A 02400CSR TITL,A COMP BLK66 55 02410CSR 55 MOVE TITL,A W132A 02420CSRN54N55 GOTO T102A 02430CSR 1 ADD W3N W3N 02440CSR MOVELW3N RPGLIN 4 02450CSR MOVEL'001' RPGCOL 4 02460CSR EXSR SR69 MOVE CURSOR 02470CSR EXITFZW132 WRITE TITLE LINE 02480CSR RLABL W132A 02490CSR Z-ADDW3N REQST 30 02500CSR GOTO T102A ÐÐ02510C*---------------------------------------------------------------- 02520CSR T102C TAG 02530CSR Z-ADD0 M 02540CSR Z-ADD0 S 20 02550CSR MOVE BLK8 SEL 02560CSR 1 ADD REQST REQST 02570CSR Z-ADDREQST W3N 30 02580CSR MOVE PA PRG 02590CSR MOVE NA NAM 02600CSR MOVEL'001' RPGCOL 02610CSR EXSR SR201 OUTPUT MENU 02620CSR MOVE PB PRG 02630CSR MOVE NB NAM 02640CSR MOVEL'067' RPGCOL 02650CSR Z-ADDREQST W3N 02660CSR EXSR SR201 OUTPUT MENU 02670CSR ENDSR 02680C******************************************************************** 02690CSR SR103 BEGSR 02700C* REQUEST SELECTION. 02710C*------------------------------------------------------------------- 02720CSR MOVEANUL W66A 66 02730CSR MOVELMSG,1 W66A 02740CSR MOVELREQST RPGLIN 4 02750CSR MOVEL'001' RPGCOL 4 ÐÐ02760CSR EXSR SR69 MOVE CURSOR 02770CSR EXSR SR70 WRITE PROMPT 02780CSR EXSR SR75 READ CRT 02790CSR Z-ADD4 W2N 20 02800CSR EXIT SUBRAJ RJ 02810CSR RLABL W2N 02820CSR RLABL W4A 02830CSR MOVE W4A S 20 02840CSR S COMP 0 54 02850CSR 54 S COMP 46 5454 02860CSR 54 SEL,S COMP BLK8 54 02870CSR 54 MOVELSEL,S PROG 8 02880CSR 54 EXSR SR99 <<>> 02890CSR MOVELBLK66 W66A 02900CSR MOVE MSG,2 W66A 02910CSR EXSR SR71 PUT MESSAGE 02920CSR GOTO SR103 REQUEST AGAIN 02930CSR ENDSR 02940C********************************************************************* 02950CSR SR201 BEGSR 02960C* DISPLAY PROGRAM SELECTIONS 02970CSR Z-ADD1 M 20 02980C*------------------------------------------------------------------ 02990CSR T201C TAG 03000CSR BLK50 LOKUPNAM,M 54 ÐÐ03010CSRN54 GOTO END201 03020CSR 1 ADD W3N W3N 03030CSR MOVELW3N RPGLIN 03040C* 03050CSR PRG,M COMP BLK8 55 03060CSR 55 1 ADD S S 03070CSR 55 MOVE PRG,M SEL,S SAVE PROG NAME 03080CSR MOVEANUL W66A 03090CSR MOVE BLK66 W54A 54 03100CSR 55 MOVELS W54A 03110CSR 55 S COMP 9 54 03120CSR 55N54 MOVEL' ' W54A 03130CSR MOVE NAM,M W54A 03140CSR MOVELW54A W66A 03150CSR MOVE '. ' W66A 03160CSR EXSR SR69 MOVE CURSOR 03170CSR EXSR SR70 DISPLAY ENTRY 03180CSR MOVE BLK50 NAM,M 03190CSR GOTO T201C 03200CSR END201 ENDSR 03210C* 03220C* 03230C* 03240C* 03250O*************************************************************** ÐÐ03260OCRTFILE E 97 03270O CRJOB 26 03280O CRTIME 33 03290O CRDATE 37 03300O CALL 79 03310O REC 256 03320O******************************************************************** ** PA/NA ARRAY 03330Q028PM PART MASTER ORDER POLICY 1 03340 2 03350 3 03360 4 03370 5 03380 6 03390 7 03400 8 03410 9 03420 10 03430 11 03440 12 03450 13 03460 14 03470 15 03480 16 03490 37 03500ÐÐ 18 03510 19 03520 20 03530 21 03540 22 03550 23 03560** PB/NB ARRAY 03570QQPM02 PART MASTER DISPLAY MENU 1 03580 2 03590 3 03600 4 03610 5 03620 6 03630 7 03640 8 03650 9 03660 10 03670 11 03680 12 03690 13 03700 14 03710 15 03720 16 03730 17 03740 18 03750ÐÐ 19 03760 20 03770 21 03780 22 03790 23 03800** NUL ARRAY 03810 03820** A4 ARRAY 03830 03840** TITL ARRAY (EA ELEMENT = 1/2 TITLE LINE) 03850 P A R T M A S T E R 03860U P D A T E M E N U 03870<---------U P D A T E P R O G R A M S---------> 03880<--------D I S P L A Y P R O G R A M S--------> 03890 03900 03910** MSG ARRAY 03920ENTER SELECTION NO.: 03930INVALID... TRY AGAIN: 03940\ CODE INVALID.... TRY AGAIN: 03950** SEL ARRAY 03960 03970** PRG/NAM ARRAY 03980 03990** LNK ARRAY 04000ÐÐ 04010/* 04020_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( |Y  NX034PM P120282120282(èÈÐ00010H Q034PM00020F* INPUT PMMST2 LEAD TIME DATA. (X034PM) 00030F* REVISED 11-19-80 12:25 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FPMMST2 UD F 674L12AI 1 DISK 00070FCRTFILE IC F 256R DISK 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A12 12 12 1 A INPUT DATA ARRAY 00120E NUM 1 14 3 0 NUMERIC FIELD NO.'S 00130E DUN 1 14 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E LOC 1 14 3 0 TYP 1 00160E DASH 1 57 1 00170E A9 9 9 1 00180E BIT 256 1 SCREEN CONTR. CHAR 00190E PLT 8 3 0 00200E* 00210I******************************************************************* 00220IBITHEX BT 00230I 1 256 BIT 00240I******************************************************************* 00250IMGFILE MG ÐÐ00260I* MESSAGE FILE. 00270I 1 35 MGTEXT 00280I****************************************************************** 00290IPMMST2 PM 00300I* PART MASTER RECORD. 00310I* PART NO. 10N 00320I 1 100PMPN 00330I* MODEL NAME 12A 00340I 19 30 PMMODL 00350I* DESCRIPTION 29A 00360I 31 59 PMDESC 00370I* SOURCE CODE 2A 00380I 94 95 PMSC 00390I* LEAD TIMES 3P X 8 00400I* 1 = PROD CONTROL 00410I* 2 = PURCHASING 00420I* 3 = VENDOR 00430I* 4 = STORES,PULL KIT 00440I* 5 = SHOP,FAB/ASSY 00450I* 6 = INSPECT/TEST 00460I* 7 = STORES,PUT AWAY 00470I* 8 = SAFETY LEAD TIME 00480I P 113 128 PLT 00490I* OLD STD UNIT COST 9.3P 00500I P 489 4933PMOSUC ÐÐ00510I* RECORD STATUS 1A 00520I* D = DELETED 00530I 674 674 PMSTAT 00540I******************************************************************** 00550ICRTFILE CR 00560I 74 79 CRMENU 00570C******************************************************************** 00580C* INITIALIZE 00590C EXSR SR101 1-TIME INIT 00600C*------------------------------------------------------------------ 00610C START TAG 00620C* SET-UP 1ST FIELD NO. 00630C SETOF 7765 00640C MOVE ' ' DUN INIT EDIT ARRAY 00650C Z-ADD0 F 30 FIELD # 00660C GOTO READ 00670C*------------------------------------------------------------------ 00680C NEXT TAG 00690C* SET-UP NEXT FIELD NO. 00700C 1 ADD F F FIELD # 00710C*----------------------------------------------------------------- 00720C READ TAG 00730C* READ DATA FROM TERMINAL. 00740C SETOF 909677 00750C EXSR SR102 VALIDATE FIELD # ÐÐ00760C 55 GOTO UPDATE DONE 00770C F COMP 1 54 00780C N54 GOTO CONTU 00790C TYP,F COMP ' ' 54 00800C 54 GOTO CONTU 00810C MOVELPMSC W1A 1 00820C W1A COMP 'P' 54 00830C N54 W1A COMP 'M' 54 00840C N54 GOTO CONTU 00850C TYP,F COMP W1A 54 00860C N54 GOTO NEXT 00870C*------------------------------------------------------------------ 00880C CONTU TAG 00890C EXSR SR201 IDENTIFY-F 00900C SETON 69 00910C EXSR SR72 PROMPT 00920C SETOF 69 00930C EXSR SR75 READ TERMINAL 00940C 98 GOTO GOODBY GOODBY 00950C 94 GOTO MENU MENU REQUEST 00960C N77N88 EXSR SR104 EDIT INPUT FIELD 00970C 96 ERROR 00980CORN77N88 EXSR SR72 REWRITE INPUT DATA 00990C 93 GOTO NEWITM NEW ITEM 01000C 92 GOTO JUMP FIELD JUMP REQST ÐÐ01010C 91 GOTO NEXT SKIP FORWARD 01020C 89 F SUB 1 F SKIP BACKWARD 01030C 89 GOTO READ " " 01040C 88 SETOF 90 SPACE FILL 01050C 88 SETON 77 " " 01060C 86 GOTO UPDATE UPDATE 01070C 85 GOTO READ REPEAT 01080C 96 GOTO ERROR ERROR 01090C N77 GOTO EDIT NO DATA INPUT 01100C*------------------------------------------------------------------ 01110C PROCES TAG 01120C* PROCESS INPUT DATA 01130C EXSR SR103 MOVE DATA 01140C*------------------------------------------------------------------- 01150C EDIT TAG 01160C N96 EXSR SR104 EDIT DATA 01170C EXSR SR72 REWRITE DATA 01180C 96 GOTO ERROR ERROR 01190C GOTO NEXT 01200C*------------------------------------------------------------------ 01210C UPDATE TAG 01220C* UPDATE DATA BASE. 01230C EXSR SR81 UPDATE 01240C 1 ADD COUNT COUNT 30 01250C COUNT COMP 29 54 ÐÐ01260C 54 EXSR SR71 01270C EXITFQCLFCR 01280C Z-ADD1 F 01290C Z-ADD0 TCC 90 01300C Z-ADD0 PLT 01310C SETOF 77 01320C GOTO EDIT 01330C*------------------------------------------------------------------- 01340C JUMP TAG 01350C* SET-UP JUMP TO REQUESTED FIELD 01360C 1 ADD W W 30 01370C W COMP 12 54 01380C 54 Z-ADD318 M 50 96 FLAG ERROR 01390C 54 GOTO ERROR BAD ESC 01400C MOVE ' ' W3A 3 01410C MOVEAA12,W W3A 01420C Z-ADD3 W2N 20 01430C EXIT SUBRAJ R. JUSTIFY 01440C RLABL W2N 01450C RLABL W3A 01460C MOVE W3A F NEW FIELD # 01470C GOTO READ 01480C*-------------------------------------------------------------------- 01490C ERROR TAG 01500C EXSR SR102 VALIDATE FIELD # ÐÐ01510C EXSR SR89 GET MSG 01520C EXSR SR73 PUT MSG 01530C GOTO READ 01540C*------------------------------------------------------------------ 01550C NEWITM TAG 01560C* SET-UP LINK FOR NEW ITEM 01570C MOVEL'Q034PM' PROG 8 01580C GOTO END 01590C*------------------------------------------------------------------- 01600C MENU TAG 01610C* SET-UP LINK TO MENU 01620C MOVELCRMENU PROG 01630C GOTO END 01640C*-------------------------------------------------------------------- 01650C GOODBY TAG 01660C* LINK TO SIGN-OFF 01670C MOVEL'GOODBY' PROG 01680C GOTO END 01690C*------------------------------------------------------------------- 01700C END TAG 01710C EXITFCHAIN LINK TO NEXT PROG 01720C RLABL PROG 01730C********************************************************************* 01740CSR SR1 BEGSR 01750C* EDIT PART #. ÐÐ01760CSRN77 GOTO T1A 01770CSR MOVELTPN W12A 12 01780CSR W12A SETLLPMMST2 01790C*------------------------------------------------------------------- 01800CSR T1A TAG 01810CSR SETOF 5465 01820CSR READ PMMST2 54 01830CSR 54 GOTO END1 01840CSRN77 PMPN COMP LASTPN 54 01850CSRN77N54 GOTO END1 01860CSR PMSTAT COMP 'D' 54 01870CSR 54 GOTO T1A 01880CSR MOVELPMSC W1A 1 01890CSR W1A COMP 'P' 65 01900CSR Z-ADDPMPN LASTPN 100 01910CSR END1 ENDSR 01920C********************************************************************** 01930CSR SR71 BEGSR 01940C* PUT HEADINGS TO TERMINAL 01950CSR EXITFQTOPF TOP FORM 01960CSR Z-ADD8 COUNT 30 01970CSR SETON 71 01980CSR EXCPT PUT HEADINGS 01990CSR SETOF 71 02000CSR ENDSR ÐÐ02010C********************************************************************* 02020CSR SR72 BEGSR 02030C* PUT DATA TO TERMINAL 02040CSR COUNT SUB 1 W3N 30 02050CSR MOVELW3N W6A 6 02060CSR MOVE '001' W6A 02070CSR EXITFQXYPOS 02080CSR RLABL W6A 02090CSR SETON 72 02100CSR EXCPT PUT DATA 02110CSR SETOF 72 02120CSR ENDSR 02130C*********************************************************************** 02140CSR SR73 BEGSR 02150C* PUT ERROR MESSAGE TO TERMINAL 02160CSR SETON 73 02170CSR EXCPT PUT MSG 02180CSR SETOF 73 02190CSR Z-ADDM LSTERR 50 02200CSR ENDSR 02210C******************************************************************* 02220CSR SR75 BEGSR 02230C* READ FROM TERMINAL 02240CSR SETOF 779096 02250CSR SETOF 939291 ÐÐ02260CSR SETOF 8988 02270CSR SETOF 8685 02280CSR MOVELCOUNT W6A 6 02290CSR MOVE LOC,F W6A 02300CSR MOVE BIT,28 A9,1 02310CSR MOVE '8' A9,2 02320CSR MOVEAW6A A9,3 02330CSR MOVE BIT,8 A9,9 02340CSR MOVEAA9 W9A 9 02350CSR MOVE BIT,7 BUFLGT 2 READ BUFFER LGTH 02360CSR MOVE BLK12 W12A 12 BUFFER 02370CSR EXITFQPREED READ FROM TERMINAL 02380CSR RLABL W9A 02390CSR RLABL W12A 12 READ BUFFER 02400CSR RLABL BUFLGT READ BUFFER LGTH 02410CSR MOVEAW12A A12 INPUT DATA ARRAY 02420CSR MOVE BLK12 W12A 02430CSR Z-ADD1 W 30 02440CSR '\' LOKUPA12,W 90 FLAG ESC 02450CSRN90 GOTO T75B NOT ESC 02460CSR 1 ADD W W 02470CSR W COMP 12 54 02480CSR 54 GOTO T75A BAD ESC 02490CSR A12,W COMP 'G' 98 GOODBY 02500CSR A12,W COMP 'E' 94 MENU ÐÐ02510CSR A12,W COMP 'N' 93 NEW ITEM 02520CSR A12,W COMP 'J' 92 JUMP 02530CSR A12,W COMP 'F' 91 SKIP FRWRD 02540CSR A12,W COMP 'B' 89 SKIP BKWRD 02550CSR A12,W COMP 'S' 88 SPACE FILL 02560CSR A12,W COMP 'U' 86 UPDATE 02570CSR A12,W COMP 'R' 85 REPEAT 02580CSR 98 02590COR 94 02600COR 93 02610COR 92 02620COR 91 02630COR 89 02640COR 88 02650COR 86 02660COR 85 GOTO END75 GOOD ESC 02670C*------------------------------------------------------------------ 02680CSR T75A TAG 02690C* FLAG BAD ESC INPUT 02700CSR Z-ADD318 M 96 FLAG ERROR 02710CSR GOTO END75 02720C*-------------------------------------------------------------------- 02730CSR T75B TAG 02740C* MOVE DATA 02750CSR Z-ADD1 W ÐÐ02760CSR ' ' LOKUPA12,W 77 02770CSR 77 MOVEAA12,W W12A INPUT DATA 02780C*-------------------------------------------------------------------- 02790CSR END75 TAG 02800C* INIT PREV ERROR MSG. 02810CSR LSTERR COMP 0 54 02820CSR 54 MOVE BLK35 MGTEXT 02830CSR 54 EXSR SR73 BLANK MESSAGE 02840CSR Z-ADD0 LSTERR 50 02850CSR ENDSR 02860C********************************************************************** 02870CSR SR81 BEGSR 02880C* UPDATE MASTER TO FILE. 02890CSR SETON 81 02900CSR EXCPT UPD MASTER 02910CSR SETOF 81 02920CSR ENDSR 02930C********************************************************************** 02940CSR SR89 BEGSR 02950C* GET MESSAGE MASTER 02960CSR M CHAINMGFILE 54 02970CSR 54 MOVE BLK35 MGTEXT 02980CSR 54 MOVELM MGTEXT 02990CSR 54 MOVE MES,1 MGTEXT 03000CSR ENDSR ÐÐ03010C*********************************************************************** 03020CSR SR101 BEGSR 03030C* 1-TIME INITIALIZE 03040CSR MOVE BIT,1 NUL 03050CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03060CSR Z-ADD14 FLIMIT 30 TOTAL NUMB FIELDS 03070CSR MOVE ' ' BLK12 12 03080C* GET PORT # AND CRTFILE. 03090CSR MOVE ' ' W8A 8 03100CSR Z-ADD0 W2N 20 03110CSR Z-ADD0 W1N 10 03120CSR MOVE ' ' W2A 2 03130CSR EXITFPGMINX GET PORT # 03140CSR RLABL W8A 03150CSR RLABL W2N 03160CSR RLABL W1N 03170CSR RLABL W2A 03180CSR MOVE W2A PORT 20 PORT NO. 03190CSR PORT COMP 0 54 03200CSRN54 Z-ADD25 PORT DEFAULT 03210CSR PORT CHAINCRTFILE H9 03220CSR H9 GOTO END101 03230C* DEFINE WORK FIELDS, ETC. 03240CSR MOVE ' ' BLK35 35 03250CSR MOVE '-' DASH ÐÐ03260CSR MOVE ' ' BLK132132 03270CSR EXSR SR71 PUT HEADING 03280CSR END101 ENDSR 03290C********************************************************************** 03300CSR SR102 BEGSR 03310C* VALIDATE FIELD NO. 03320CSR F COMP 0 54 03330CSRN54 Z-ADD1 F 03340CSR F COMP FLIMIT 55 03350CSR 55 Z-ADD1 F 03360CSR ENDSR 03370C******************************************************************** 03380CSR SR103 BEGSR 03390C* MOVE INPUT DATA 03400CSR EXSR SR201 IDENTIFY-F 03410CSR EXSR SR202 R. JUSTIFY 03420CSR 01 MOVE W10A TPN 100 PART # 03430CSR 02 MOVE W10A TCC COMMODITY 03440CSR 03 MOVE W10A PLT,8 PUR,SAFETY 03450CSR 04 MOVE W10A PLT,1 PUR,PROD CONT 03460CSR 05 MOVE W10A PLT,2 PUR,PURCH 03470CSR 06 MOVE W10A PLT,3 PUR,VENDOR 03480CSR 07 MOVE W10A PLT,6 PUR,INSP/TEST 03490CSR 08 MOVE W10A PLT,7 PUR,STORES PUT AWAY 03500CSR 09 MOVE W10A PLT,1 MFG,PROD CONT ÐÐ03510CSR 10 MOVE W10A PLT,4 MFG,STORES,PULL KIT 03520CSR 11 MOVE W10A PLT,5 MFG,SHOP,FAB/ASSY 03530CSR 12 MOVE W10A PLT,3 MFG,OUTSIDE VEND 03540CSR 13 MOVE W10A PLT,6 MFG,INSP/TEST 03550CSR 14 MOVE W10A PLT,7 MFG,STORES PUT AWAY 03560CSR MOVE ' ' DUN,F EDIT FLAG 03570CSR ENDSR 03580C******************************************************************** 03590CSR SR104 BEGSR 03600C* EDIT INPUT DATA 03610CSR EXSR SR201 03620CSR 01 EXSR SR1 03630CSR 96 MOVE ' ' DUN,F EDIT FLAG 03640CSRN96 MOVE 'X' DUN,F 03650CSR ENDSR 03660C************************************************************************ 03670CSR SR201 BEGSR 03680C* IDENTIFY FIELD NO. 03690CSR F COMP 1 01 03700CSR F COMP 2 02 03710CSR F COMP 3 03 03720CSR F COMP 4 04 03730CSR F COMP 5 05 03740CSR F COMP 6 06 03750CSR F COMP 7 07 ÐÐ03760CSR F COMP 8 08 03770CSR F COMP 9 09 03780CSR F COMP 10 10 03790CSR F COMP 11 11 03800CSR F COMP 12 12 03810CSR F COMP 13 13 03820CSR F COMP 14 14 03830CSR ENDSR 03840C********************************************************************** 03850CSR SR202 BEGSR 03860C* RIGHT JUSTIFY 03870CSR F LOKUPNUM 54 03880CSRN54 GOTO END202 NOT NUMERIC FIELD 03890CSR Z-ADD10 W2N 20 03900CSR MOVELW12A W10A 10 03910CSR EXIT SUBRAJ R. JUSTIFY 03920CSR RLABL W2N 03930CSR RLABL W10A 03940CSR END202 ENDSR 03950O******************************************************************** 03960OTERM132 E 71 03970O BIT,28 1 03980O 2 'K' 03990O 72 'LEAD-TIME/COMMODITY' 04000O 78 'INPUT' ÐÐ04010O*------------------------------------------------------------------- 04020O E 71 04030O*------------------------------------------------------------------- 04040O E 71 04050O DASH 132 04060O 100 ' ' 04070O 76 '*' 04080O 98 '*' 04090O 102 ' *' 04100O 132 '*' 04110O 91 'PURCHASED' 04120O 122 'MANUFACTURED' 04130O*------------------------------------------------------------------- 04140O E 71 04150O 4 '1' 04160O 63 '2' 04170O 72 '3' 04180O 76 '4' 04190O 81 '5' 04200O 86 '6' 04210O 91 '7' 04220O 97 '8' 04230O 102 '9' 04240O 107 '10' 04250O 112 '11' ÐÐ04260O 118 '12' 04270O 124 '13' 04280O 129 '14' 04290O*------------------------------------------------------------------- 04300O E 71 04310O 49 'SOURCE' 04320O 68 'COMMODITY' 04330O 73 'SAF' 04340O 77 'PC' 04350O 82 'PUR' 04360O 87 'VEN' 04370O 93 'INSP' 04380O 98 'STK' 04390O 103 'PC' 04400O 108 'KIT' 04410O 114 'SHOP' 04420O 120 'VEND' 04430O 126 'INSP' 04440O 131 'STK' 04450O*------------------------------------------------------------------- 04460O E 71 04470O 7 'PART-NO' 04480O 25 'DESCRIPTION' 04490O 47 'CODE' 04500O 57 'COST' ÐÐ04510O 65 'CODE' 04520O 72 'LT' 04530O 77 'LT' 04540O 81 'LT' 04550O 86 'LT' 04560O 92 'LT' 04570O 97 'LT' 04580O 103 'LT' 04590O 107 'LT' 04600O 113 'LT' 04610O 119 'LT' 04620O 125 'LT' 04630O 130 'LT' 04640O*------------------------------------------------------------------- 04650O E 71 04660O 1 ' ' 04670O E 71 04680O 1 ' ' 04690O*------------------------------------------------------------------- 04700O E 72 04710O PMPN 12 ' - - ' 04720O PMDESC 43 04730O PMSC 46 04740O PMOSUC2 57 04750O TCC Z 68 ÐÐ04760O PLT,8 Z 73 04770O 65 PLT,1 Z 78 04780O 65 PLT,2 Z 82 04790O 65 PLT,3 Z 87 04800O 65 PLT,6 Z 93 04810O 65 PLT,7 Z 98 04820O N65 PLT,1 Z 103 04830O N65 PLT,4 Z 108 04840O N65 PLT,5 Z 114 04850O N65 PLT,3 Z 120 04860O N65 PLT,6 Z 126 04870O N65 PLT,7 Z 131 04880O*------------------------------------------------------------------- 04890O E 73 04900O MGTEXT 35 04910O******************************************************************** 04920OPMMST2 E 81 04930O PLT 128P 04940O PMOSUC 493P ** NUL ARRAY 004950 004960** A12 ARRAY 004970 004980** NUM ARRAY 004990001 005000ÐÐ002 005010003 005020004 005030005 005040006 005050007 005060008 005070009 005080010 005090011 005100012 005110013 005120014 005130** DUN ARRAY 005140 005150** MES ARRAY 005160---MESSAGE NOT ON FILE--- 005170** LOC ARRAY 005180001 PART NO 1 005190060 COMMODITY 2 005200070 LT SAFETY PURCH 3 005210075P LT PROD CONT PURCH 4 005220080P LT PURCH PURCH 5 005230085P LT VEND PURCH 6 005240091P LT INSP PURCH 7 005250ÐÐ096P LT STOCK PURCH 8 005260101M LT PROD CONT MFG 9 005270106M LT KIT MFG 10 005280112M LT SHOP MFG 11 005290118M LT VEND MFG 12 005300124M LT INSP MFG 13 005310129M LT STK MFG 14 005320** DASH 005330 005340** A9 ARRAY 005350 005360/* 005370_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È}¨ ÈTX035PM P\120282120282(èÈÐ00010H Q035PM00020F* PRINT MIN/MAX QTYS ON CARD STOCK (BI). (X035PM) 00030F* REVISED 2/11/81 4:15 PM. 00040FPMMST2 IP F 674 12AI 1 DISK 00050FPRINT O F 74 LPRINTER 00060FTERM80 O F 80 5 00070L******************************************************************** 00080LPRINT 88FL 88OL 00090I******************************************************************** 00100IPMMST2 PM 01 674NCD 97 CB 98 CI 00110I 1 100PMPN 00120I 31 59 PMDESC 00130I 97 98 PMISSU 00140I P 147 1500PMMIN 00150I P 159 1620PMMAX 00160I GG 02 00170C******************************************************************** 00180C 70 GOTO TAG10 00190C SETON 8170 00200C EXCPT 00210C SETOF 81 00220C EXITFQPAUSE 00230C*-------------------------------------------------------------------- 00240C TAG10 TAG 00250C 01 SETON 80 ÐÐ00260C 01 EXCPT 00270C 01 SETOF 80 00280O********************************************************************* 00290OTERM80 E 81 00300O 24 'MOUNT CARD STOCK, 8-LPI ' 00310O********************************************************************* 00320OPRINT E 80 00330O 1 ' ' 00340O E 80 00350O 1 ' ' 00360O E 80 00370O PMPN 16 ' - - ' 00380O E 80 00390O PMDESC 33 00400O E 80 00410O 8 'MIN=' 00420O PMMIN 2 17 00430O E 80 00440O 8 'MAX=' 00450O PMMAX 2 17 00460O E 80 00470O 1 ' ' 00480O E 80 00490O 1 ' ' 00500O E 80 ÐÐ00510O 1 ' ' 00520O E 80 00530O 1 ' ' 00540O E 80 00550O 1 ' ' 00560O E 80 00570O 1 ' ' 00580O E 80 00590O 1 ' ' 00600O E 80 00610O 1 ' ' 00620O E 80 00630O 1 ' ' 00640O E 80 00650O 1 ' ' 00660O E 80 00670O 1 ' ' 00680O E 80 00690O 1 ' ' 00700O E 80 00710O 1 ' ' 00720O E 80 00730O 1 ' ' 00740O E 80 00750O 1 ' ' ÐÐ00760O E 80 00770O 1 ' ' 00780O E 80 00790O 1 ' ' 00800O E 80 00810O 1 ' ' 00820O E 80 00830O 1 ' ' 00840O E 80 00850O 1 ' ' /* 000860_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d}ý d*X036PM P120282120282(èÈÐ00010H Q036PM00020F* LIST PURCHASED PARTS. (X036PM) 00030F* REVISED 4/14/81 4:15 PM. 00040FLTBEGIN IP F 4 DISK 00050FPMMST2 IS F 674 12AI 1 DISK 00060FPRINT O F 132 OF LPRINTER 00070FTERM25 O F 25 5 00080E******************************************************************** 00090E PLT 8 3 0 00100L******************************************************************** 00110LPRINT 88FL 80OL 00120I******************************************************************** 00130ILTBEGIN LB 03 00140I 1 4 LIMIT 00150I******************************************************************** 00160IPMMST2 PM 01 674NCD 00170I 1 100PMPN 00180I 31 59 PMDESC 00190I 94 95 PMSC 00200I 94 94 PMSC1 00210I 95 95 PMSC2 00220I P 113 128 PLT 00230I P 615 6193PMTCST 00240I GG 02 00250C******************************************************************** ÐÐ00260C N70 EXCPT 00270C N70 EXITFQPAUSE 00280C SETON 70 00290C 01 Z-ADD4 W2N 20 00300C 01 EXIT SUBRAJ 00310C RLABL W2N 00320C RLABL LIMIT 00330C 01 PMSC1 COMP 'P' 01 00340C 01 XFOOTPLT TLT 40 00350C 01 U1 MOVE LIMIT TIMIL 40 00360C 01 U1 TLT COMP TIMIL 01 01 00370O******************************************************************** 00380OTERM25 E 00390O 24 '************************' 00400O E 00410O 24 'STD 1-PART,8-LPI ' 00420O E 00430O 1 ' ' 00440O E 00450O 24 'SWITCH-1 BYPASSES ITEMS ' 00460O E 00470O 24 'WITH LEAD TIMES LESS ' 00480O E 00490O 24 'THAN THE ONE PREVIOUSLY ' 00500O E ÐÐ00510O 24 'INPUT TO LTBEGIN FILE ' 00520O******************************************************************** 00530OPRINT H 201 1P 00540O OR OF 00550O 70 'PURCH PARTS LIST' 00560O UDATE Y 8 00570O 127 'PAGE' 00580O PAGE Z 132 00590O*------------------------------------------------------------------- 00600O H 1 1P 00610O OR OF 00620O 51 'SOURCE' 00630O 67 'UNIT' 00640O 94 '<- - - - - - - - - - - -' 00650O 115 '- - - - - - - - - - - ->' 00660O 96 'LEAD TIME' 00670O*------------------------------------------------------------------- 00680O H 2 1P 00690O OR OF 00700O 7 'PART-NO' 00710O 25 'DESCRIPTION' 00720O 50 'CODE' 00730O 67 'COST' 00740O 74 'P.C.' 00750O 81 'PURCH' ÐÐ00760O 87 'VEND' 00770O 93 'INSP' 00780O 100 'STOCK' 00790O 108 'SAFETY' 00800O 115 'TOTAL' 00810O*------------------------------------------------------------------- 00820O D 1 01 00830O PMPN 12 ' - - ' 00840O PMDESC 43 00850O PMSC 49 00860O PMTCST2 67 00870O PLT,1 Z 73 00880O PLT,2 Z 80 00890O PLT,3 Z 86 00900O PLT,6 Z 92 00910O PLT,7 Z 99 00920O PLT,8 Z 106 00930O TLT Z 115 /* 000940_‚ ÐÐ_‚_‚0O 87 'VEND' 00770O 93 'INSP' 00780O 100 'STOCK' 00790O 108 'SAFETY' 00800O 115 'TOTAL' 00810O*------------------------------------------------------------------- 00820O D 1 01 00830O PMPN 12 ' - - ' 00840O PMDESC 43 00850O PMSC 49 00860O PMTCST2 67 00870O PLT,1 Z 73 00880O PLT,2 Z 80 00890O PLT,3 Z 86 00900O PLT,6 Z 92 00910O PLT,7 Z 99 00920O PLT,8 Z 106 00930O TLT Z 115 /* 000940_‚ ÐÈ( ~(  NX037BM P120282120282(èÈÐ00010H Q037BM00020F* INDENTED PARTS LIST, MFD PARTS ONLY, ALL END-USE ITEMS. (X037BM) 00030F* REVISED 3/09/81 12:10 PM. DG-REL006 OK. 00040FEUGUIDE IP F 10 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FBMMAST ID F 86L20AI 1 DISK 00070FTERM70 O F 70 5 00080FPRINT O F 132 OF LPRINTER 00090E******************************************************************** 00100E A12 12 12 1 A INPUT ARRAY. 00110E LEV 1 20 20 NEXT RRN AT EA LEVEL 00120E QTY 1 20 7 0 QTY MULTIPLIER 00130E A29 1 29 1 00140E PLT 8 3 0 LEAD TIMES 00150E PMM 6 7 0 MIN MAX CODES 00160LPRINT 88FL 80OL 00170I******************************************************************** 00180IEUGUIDE EU 00190I 1 100EUPN 00200I******************************************************************** 00210IPMMST2 PM 00220I* PART MASTER RECORD. 00230I* KEY AREA 00240I* PART NO. 12A 00250I 1 12 PMPN ÐÐ00260I* NUMB OF COMPONENTS 3P 00270I P 13 140PMNOBM 00280I* PROD LINE 4N 00290I 15 180PMPL 00300I* MODEL NAME 12A 00310I 19 30 PMMODL 00320I* DESCRIPTION 29A 00330I 31 59 PMDESC 00340I* COMMODITY CODE 9P 00350I P 60 640PMCC 00360I* ENG CHANGE STATUS. 00370I* CUR CHG LEVEL 2A 00380I 70 71 PMECHG 00390I* CUR CHG DATE 6N 00400I 72 770PMDCHG 00410I* LAST ECN NO. 5A 00420I 65 69 PMECN 00430I* DRAWING INFO 00440I* DWG SIZE 1A 00450I 82 82 PMSIZ 00460I* DWG CLASS 1A 00470I* D = DYNAIR DWG 00480I* V = VENDOR DWG 00490I 83 83 PMDCLS 00500I* STANDARD CODE 1A ÐÐ00510I 84 84 PMSTDC 00520I* DWG REL CODE 1A 00530I* E = ENG ONLY 00540I* M = REL TO MFG 00550I* P = PROTOTYPE 00560I 78 78 PMDREL 00570I* UNIT MEAS 2A 00580I* EA = EACH OC = OUNCE 00590I* ST = SET TC = TROY OUNCE 00600I* IN = INCH LB = POUND 00610I* FT = FEET PT = PINT 00620I* YD = YARD QT = QUART 00630I* SI = SQ.INCH GL = GALLON 00640I* SF = SQ.FEET DR = DRUM 00650I* SY = SQ.YARD 00660I 85 86 PMUM 00670I* SOURCE CODE 2A 00680I* MA = MFG ASSY 00690I* MP = MFG PART 00700I* PA = PURCH ASSY 00710I* PP = PURCH PART 00720I* RS = RAW STOCK 00730I 94 95 PMSC 00740I* PROVISIONING CODE 1A 00750I* A = FORECAST,NO VALUE ADDED ÐÐ00760I* B = FORECAST,VALUE ADDED 00770I* C = BUILD TO ORDER (B) 00780I* D = BUILD TO ORDER (NOT B) 00790I* E = CUSTOM 00800I* Y = OBSOLETE,REPAIRABLE 00810I* Z = OBSOLETE,NOT REPAIRABLE 00820I 96 96 PMPROV 00830I* ISSUE CODE 2A 00840I* PT = PULL TIME 00850I* OR = ON REQUEST 00860I* BI = BULK ISSUE 00870I* AR = AS REQUIRED 00880I* VS = VENDOR SUPPLIED 00890I* SD = SHIPPING DOCUMENT 00900I* TD = TRAV DOCUMENT 00910I* RD = REF DOCUMENT 00920I* RA = REF ASSY 00930I 97 98 PMISSU 00940I* INVENTORY ACCOUNT 5P 00950I P 110 1120PMACNT 00960I* LEAD TIMES 3P X 8 00970I P 113 128 PLT 00980I* MIN/MAX CODES 7P X 6 00990I P 139 162 PMM 01000I* ROUNDING FACTOR 5P ÐÐ01010I P 167 1690PMRNDF 01020I* FAB CODE 2A 01030I 487 488 PMFABC 01040I* RECORD STATUS 1A 01050I* D = DELETED 01060I 674 674 PMSTAT 01070I******************************************************************** 01080IBMMAST BM 01090I* BILL OF MATERIAL RECORD 01100I* KEY AREA 01110I* ASSY PART NO. 10N 01120I 1 100BMAPN 01130I* COMPONENT PART # 10N 01140I 11 200BMCPN 01150I* ITEM NO. 3N 01160I 25 270BMITNO 01170I* QTY PER ASSY 7P 01180I P 28 310BMQTY 01190I* SCRAP ALLOW .2N 01200I 34 352BMSCRP 01210I* ISSUE CODE 2A 01220I* PT = PULL TIME 01230I* OR = ON REQUEST 01240I* BI = BULK ISSUE 01250I* AR = AS REQUIRED ÐÐ01260I* RA = REF ASSY 01270I* TD = TRAV DOC 01280I* SD = SHIP DOC 01290I* RD = REF DOC 01300I* VS = VENDOR SUPPLIED 01310I 36 37 BMISSU 01320I* EFFECTIVITY. 01330I* BEGIN CHANGE LEVEL 2A 01340I 38 39 BMBCHG 01350I* ENDING CHANGE LEVEL 2A 01360I 40 41 BMECHG 01370I* BEGIN ECN # 5A 01380I 42 46 BMBECN 01390I* ENDING ECN # 5A 01400I 47 51 BMEECN 01410I* DISPOSITION CODE 1A 01420I* U = USE UP OLD STYLE 01430I* N = NOW (IMMEDIATE) 01440I 52 52 BMDISP 01450I* FILLER 5A 53 57 FFFFFF 01460I* ROUTING. 01470I* OPER NO. 5P 01480I P 58 600BMOPER 01490I* DEPT NO. 5P 01500I P 61 630BMDEPT ÐÐ01510I* WORK CENTER NO. 3P 01520I P 64 650BMWC 01530I* COMPONENT OPER REFERENCE INFO 10A 01540I 66 75 BMREF 01550I* FILLER 10A 76 85 FFFFFF 01560I* RECORD STATUS 1A 01570I* D = DELETED 01580I 86 86 BMSTAT 01590C******************************************************************** 01600C* INITIALIZE 01610C N79 EXSR SR101 INIT 01620C Z-ADD1 P 30 01630C EUPN COMP FPN 54 54 01640C N54 GOTO END 01650C Z-ADDEUPN TAPN 100 01660C MOVELTAPN W12A 12 01670C EXSR SR81 GET PMMST2 01680C N60 GOTO TAG10 GOT IT 01690C Z-ADD302 M 50 96 FLAG ERROR 01700C EXSR SR73 PUT MSG 01710C GOTO END 01720C*-------------------------------------------------------------------- 01730C TAG10 TAG 01740C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 01750C Z-ADD1 QTY,2 QTY MULTIPLIER ÐÐ01760C SETON 8976 01770C EXSR SR71 PUT HEADING 01780C SETOF 89 01790C* FLAG NO COMPONENTS ON FILE. 01800C PMNOBM COMP 0 55 01810C N55 GOTO END NO COMPONENTS 01820C* SET-UP INITIAL BILL MATERIAL READ 01830C Z-ADD3 L 20 INDENTURE LEVEL 01840C MOVE BLK20 LEV 01850C MOVELTAPN LEV,2 01860C*----------------------------------------------------------------- 01870C TAG20 TAG 01880C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 01890C L SUB 1 L 54 INDENT LEVEL 01900C N54 GOTO END BOTTOM INDENT 01910C LEV,L COMP BLK20 54 01920C N54 GOTO TAG20 NONE THIS LEVEL 01930C MOVE LEV,L W20A 20 01940C MOVELLEV,L CURASY 100 MATCH PART # 01950C MOVE BLK20 LEV,L 01960C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 01970C*------------------------------------------------------------------ 01980C TAG30 TAG 01990C* SET-UP NEXT READ 02000C W20A SETLLBMMAST ÐÐ02010C*--------------------------------------------------------------- 02020C TAG40 TAG 02030C* GET NEXT COMPONENT. 02040C SETOF 54 02050C READ BMMAST 54GET COMPONENT 02060C 54 GOTO TAG20 END OF FILE 02070C BMAPN COMP CURASY 54 02080C N54 GOTO TAG20 WRONG ASSY 02090C BMSTAT COMP 'D' 54 02100C 54 GOTO TAG40 DELETED RECORD 02110C* DISPLAY COMPONENT DATA 02120C EXSR SR72 DISPLAY DATA 02130C* BRANCH IF NOT ASSY 02140C PMNOBM COMP 0 54 02150C N54 GOTO TAG40 NOT ASSY 02160C*------------------------------------------------------------------ 02170C TAG50 TAG 02180C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02190C MOVELBMAPN LEV,L 02200C 1 ADD BMCPN W10N 100 02210C MOVE W10N LEV,L 02220C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02230C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02240C MOVE BMCPN CURASY 02250C MOVELBMCPN W20A ÐÐ02260C MOVE ZERO10 W20A 02270C 1 ADD L L INDENT LEVEL 02280C GOTO TAG30 02290C*----------------------------------------------------------------- 02300C END TAG 02310CLR EXSR SR68 TOP FORM 02320CLR EXSR SR68 TOP FORM 02330C******************************************************************** 02340CSR SR65 BEGSR 02350C* UPDATE CRTFILE. 02360CSR EXSR SR83 UPD CRTFILE 02370CSR 1 ADD COUNT COUNT 02380CSR ENDSR 02390C******************************************************************* 02400CSR SR66 BEGSR 02410C* LINE FEED. 02420CSR SETON 66 02430CSR EXCPT BLANK LINE 02440CSR SETOF 66 02450CSR 1 ADD COUNT COUNT 02460CSR ENDSR 02470C****************************************************************** 02480CSR SR67 BEGSR 02490C* RIGHT ADJUST 02500CSR Z-ADD12 W2N 20 ÐÐ02510CSR EXIT SUBRAJ R.J. 02520CSR RLABL W2N 02530CSR RLABL W12A 02540CSR ENDSR 02550C****************************************************************** 02560CSR SR68 BEGSR 02570C* TOP OF FORM. 02580CSR SETON 68 02590CSR EXCPT TOP OF FORM 02600CSR SETOF 68 02610CSR 1 ADD EGAP EGAP 30 PAGE # 02620CSR Z-ADD0 COUNT 30 02630CSR ENDSR 02640C******************************************************************** 02650CSR SR70 BEGSR 02660C* PRINT LINE. 02670CSR EXSR SR65 PRINT LINE 02680CSR COUNT COMP 80 54 54 02690CSR 54 SETON 78 02700CSR 54 EXSR SR71 NEW PAGE 02710CSR ENDSR 02720C******************************************************************* 02730CSR SR71 BEGSR 02740C* CLEAR CRT. PUT HEADINGS. 02750CSRN78 COUNT COMP 80 78 78 ÐÐ02760CSR 78 EXSR SR68 TOP OF FORM 02770CSRN78 EXSR SR66 02780CSRN78 EXSR SR66 02790CSRN78 GOTO T71A 02800CSR SETOF 78 02810CSR MOVELTAPN W12A 02820CSR MOVE ' ' W12A 02830CSR EXSR SR81 GET TOP-ASSY PMMST2 02840CSR SETON 7131 02850CSR EXSR SR65 PUT HEADING 02860CSR SETON 7132 02870CSR EXSR SR65 PUT HEADING 02880CSR SETON 7133 02890CSR EXSR SR65 PUT HEADING 02900CSR EXSR SR66 LF/CR 02910C*------------------------------------------------------------------ 02920CSR T71A TAG 02930CSR Z-ADDP LINE 02940CSR SETON 75 02950CSR EXSR SR70 PUT TOP ASSY DATA 02960CSR ENDSR 02970C******************************************************************** 02980CSR SR72 BEGSR 02990C* DISPLAY DATA LINE TO CRT. 03000CSR MOVELBMCPN W12A COMP PN ÐÐ03010CSR EXSR SR81 GET PMMST2 03020C* BYPASS IF NOT MFG. 03030CSR MOVELPMSC W1A 1 03040CSR W1A COMP 'M' 54 03050CSRN54 GOTO END72 NOT MFG 03060CSR MOVELBMISSU W1A 03070CSR W1A COMP 'R' 54 03080CSR 54 BMISSU COMP 'RA' 55 03090CSR 54N55 GOTO END72 REF ITEM 03100CSR L COMP 1 0101 03110CSR L COMP 2 02 03120CSR L COMP 3 03 03130CSR L COMP 4 04 03140CSR L COMP 5 05 03150CSR L COMP 6 06 03160CSR L COMP 7 07 07 03170CSR 01 Z-ADD1 L 03180CSR BMISSU COMP ' ' 55 03190CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03200CSR 1 ADD P P 03210CSR Z-ADDP LINE 30 03220CSR SETON 7276 03230CSR EXSR SR70 PUT DATA. 03240CSR END72 ENDSR 03250C******************************************************************** ÐÐ03260CSR SR73 BEGSR 03270C* PUT MSG TO CRT. 03280CSR SETON 73 03290CSR EXCPT PUT MSG CRT 03300CSR SETOF 73 03310CSR ENDSR 03320C******************************************************************** 03330CSR SR81 BEGSR 03340C* GET PART MAST. 03350CSR SETOF 61 03360CSR MOVE ' ' W12A 03370CSR W12A CHAINPMMST2 60 GET PMMST. 03380CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE. 03390CSR ENDSR 03400C******************************************************************* 03410CSR SR83 BEGSR 03420C* UPDATE CRTFILE 03430CSR EXCPT PRINT LINE 03440CSR SETOF 7172 03450CSR SETOF 747577 03460CSR SETOF 313233 03470CSR ENDSR 03480C******************************************************************** 03490CSR SR101 BEGSR 03500C* INITIALIZE (1-TIME). ÐÐ03510CSR SETON 7978 03520CSR MOVE ' ' BLK12 12 03530CSR MOVE ' ' BLK20 20 03540CSR Z-ADD0 ZERO10 100 03550CSR Z-ADD0 W2N 20 03560C* PUT PRTR INSTR TO CRT & RQST STARTING PART #. 03570CSR EXSR SR73 03580CSR MOVE BLK12 W12A 12 03590CSR EXITFQRED12 READ TERMINAL 03600CSR RLABL W12A 03610CSR Z-ADD12 W2N 20 03620CSR EXSR SR67 R.J. W12A 03630CSR MOVE W12A FPN 100 03640CSR ENDSR 03650O******************************************************************** 03660OPRINT E 101 68 03670O 1 ' ' 03680O E 1 66 03690O 1 ' ' 03700O*------------------------------------------------------------------- 03710O E 1 72 03720O* DATA LINE. 03730O 11 '.' 03740O 14 '.' 03750O 17 '.' ÐÐ03760O 20 '.' 03770O 23 '.' 03780O 26 '.' 03790O 29 '.' 03800O 02 29 ' ' 03810O 03 29 ' ' 03820O L Z 8 03830O LINE Z 3 03840O 01 BMCPN 22 '0 - - ' 03850O 02 BMCPN 25 '0 - - ' 03860O 03 BMCPN 28 '0 - - ' 03870O 04 BMCPN 31 '0 - - ' 03880O 05 BMCPN 34 '0 - - ' 03890O 06 BMCPN 37 '0 - - ' 03900O 07 BMCPN 40 '0 - - ' 03910O PMDESC 71 03920O BMQTY 2 82 03930O PMUM 86 03940O PMSC 91 03950O EXTQTYZ 98 03960O PMFABC 103 03970O BMISSU 109 03980O PLT,5 Z 114 03990O PLT,8 Z 118 04000O PMM,4 Z 125 ÐÐ04010O PMRNDFZ 132 04020O*------------------------------------------------------------------- 04030O E 1 75 04040O* PUT TOP ASSY LINE. 04050O 8 '1' 04060O 89 LINE Z 3 04070O TAPN 22 '0 - - ' 04080O N89 29 'CONT''D' 04090O PMDESC 71 04100O PMUM 86 04110O PMSC 91 04120O PLT,5 Z 114 04130O PLT,8 Z 120 04140O PMM,4 Z 125 04150O PMRNDFZ 132 04160O 98 '1' 04170O PMFABC 103 04180O*------------------------------------------------------------------- 04190O E 1 71 31 04200O* CLEAR SCREEN - LINE-1. 04210O UDATE 8 ' - - ' 04220O EGAP Z 18 04230O 15 'PAGE' 04240O 61 'INDENTED PARTS LIST - ' 04250O 71 'MFG PARTS' ÐÐ04260O 79 'ASSY=' 04270O TAPN 91 ' - - ' 04280O 115 '<----------' 04290O 132 '----->' 04300O 124 'INPUT FIELDS' 04310O*------------------------------------------------------------------- 04320O E 1 71 32 04330O* HEADING, LINE-2. 04340O 26 ' <----------INDENTURE' 04350O 40 '------------->' 04360O 5 'LINE ' 04370O 82 'QUANTITY' 04380O 94 'SOURCE' 04390O 98 'EXT' 04400O 103 'FAB' 04410O 110 'ISSUE' 04420O 116 'LEAD' 04430O 125 'MIN' 04440O 132 'ROUND' 04450O*------------------------------------------------------------------- 04460O E 1 71 33 04470O* HEADING, LINE-3. 04480O 8 'LEV' 04490O 4 'ITEM' 04500O 29 '1 2 3 4 5 6 7' ÐÐ04510O 32 '-UP' 04520O 53 'DESCRIPTION' 04530O 82 'PER-ASSY' 04540O 86 'UM' 04550O 93 'CODE' 04560O 98 'QTY' 04570O 104 'CODE' 04580O 109 'CODE' 04590O 114 'ASY' 04600O 118 'PAR' 04610O 125 'ORD' 04620O 131 'FACT' 04630O****************************************************************** 04640OTERM70 E 73 04650O 24 '1-PART, STD SIZE PAPER ' 04660O E 73 04670O 24 'SET PRINTER 8-LPI ' 04680O E 73 04690O 24 'ENTER STARTING PART NO. ' 04700O***************************************************************** ** A12 ARRAY 004710 004720** LEV ARRAY 004730 004740** QTY ARRAY 004750ÐÐ 004760** A29 ARRAY 004770 004780/* 004790_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dw d*X037PM P120282120282(èÈÐ00010H Q037PM00020F* LIST PART MASTER FOR ORDER ENTRY. (X037PM) 00030F* REVISED 3/11/81 3:25 PM. 00040FPMMST2 IP F 674R I DISK 00050FPMADRT IR F 300 3 3IT EDISK 00060FPRINT O F 132 OF PRINTER 00070E******************************************************************** 00080E PMADRT PMMST2 00090I******************************************************************** 00100IPMMST2 PM 01 674NCD 00110I 1 100PMPN 00120I 15 180PMPL 00130I 19 30 PMMODL 00140I 31 59 PMDESC 00150I 96 96 PMPROV 00160I P 502 5062PMGSA 00170I P 512 5162PMLPR 00180I 519 5240PMLPUD 00190I 674 674 PMSTAT 00200I GG 02 00210O******************************************************************** 00220OPRINT H 201 1P 00230O OR OF 00240O 68 'PART MASTER' 00250O 88 ' - MODEL LISTING' ÐÐ00260O UDATE 8 ' - - ' 00270O 127 'PAGE' 00280O PAGE Z 132 00290O*------------------------------------------------------------------- 00300O H 2 1P 00310O OR OF 00320O 11 'PART-NUMBER' 00330O 23 'MODEL-NO.' 00340O 39 'DESCRIPTION' 00350O 68 'PROV-CODE' 00360O 80 'PROD-CLASS' 00370O 93 'LIST-PRICE' 00380O 106 'GSA-PRICE' 00390O 122 'CHANGE-DATE' 00400O*------------------------------------------------------------------- 00410O D 2 01 00420O PMPN 12 ' - - ' 00430O PMMODL 26 00440O PMDESC 57 00450O PMPROV 64 00460O PMPL Z 78 00470O PMLPR 2 93 00480O PMGSA 2 106 00490O PMLPUDY 122 /* 000500ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(R¢ RcX005RR P999999120282(èÈÐ00010H Q005RR00020F* INPUT RUN REL QTYS - ADD, DEL, CHG. (X005RR) 00030F* REVISED 7-09-82 2:35 PM. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FRUNREL UC F 34R14AI 1 DISK A 00090FPMMODEL2ID F 23L22AI 1 DISK 00100FPMMST2 IC F 674R12AI 1 DISK 00110FCALENDARIC F 22R 7AI 1 DISK 00120FTERM132 O F 132 5 00130F**************************************************************** 00140E NUL 1 132 1 NULL CHAR 00150E A14 14 14 1 A INPUT DATA ARRAY 00160E A9 9 9 1 EXITF QPREED PAR. 00170E LOC 1 5 3 START-COL 00180E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00190E DUN 1 5 1 A EDIT CMPLT FLAG 00200E MES 1 1 30 00210E BIT 33 1 SCREEN CONTR. CHAR 00220I******************************************************************* 00230IBITTAB BT 00240I 1 33 BIT 00250I******************************************************************** ÐÐ00260IMGFILE MG 00270I* MESSAGE FILE. 00280I 1 35 MGTEXT 00290I******************************************************************** 00300ICRTFILE CR 00310I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00320I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00330I 68 73 CRRET 00340I* MENU NAME 6A 00350I 74 79 CRMENU 00360I******************************************************************** 00370IRUNREL RL 00380I* RUN RELEASE INPUT FILE 00390I 1 14 RLKEY 00400I* MODEL 12A 00410I 1 12 RLMODL 00420I* LOT # 2N 00430I 13 140RLLOT 00440I* QTY 5P 00450I P 15 170RLQTY 00460I* DUE DATE 6N 00470I 18 230RLDUE 00480I* PART # 10N 00490I 24 330RLPN 00500I* RECORD STATUS 1A ÐÐ00510I 34 34 RLSTAT 00520I******************************************************************** 00530IPMMODEL2PD 00540I* PART MAST MODEL ALT-KEY 00550I* MODEL NO. 00560I 1 12 PDMODL 00570I* PART # 10N 00580I 13 220PDPN 00590I* RECORD STATUS 1A 00600I 23 23 PDSTAT 00610I******************************************************************** 00620IPMMST2 PM 00630I* PART MASTER FILE 00640I* NUMBER OF COMPONENTS 3P 00650I P 13 140PMNOBM 00660I* MODEL NO. 12A 00670I 19 30 PMMODL 00680I* DESCRIPTION 29A 00690I 31 59 PMDESC 00700I* RECORD STATUS 1A 00710I 674 674 PMSTAT 00720I**************************************************************** 00730ICALENDARCL 00740I* CALENDAR FILE 00750I* CAL DATE RECORD ÐÐ00760I* 2 70CACDT 00770I 14 170CACMDT 00780I* MDAY RECORD 00790I 4 70CAMMDT 00800I 8 130CAMCDT 00810C******************************************************************** 00820C* INITIALIZE 00830C EXSR SR101 1-TIME INIT 00840C EXSR SR71 1ST PAGE 00850C*------------------------------------------------------------------- 00860C START TAG 00870C* SET-UP 1ST FIELD NO. 00880C MOVE ' ' DUN INIT EDIT ARRAY 00890C Z-ADD1 F 30 FIELD # 00900C GOTO READ 00910C*------------------------------------------------------------------- 00920C NEXT TAG 00930C* SET-UP NEXT FIELD NO. 00940C 1 ADD F F FIELD # 00950C*------------------------------------------------------------------- 00960C READ TAG 00970C* READ DATA FROM TERMINAL. 00980C SETOF 909677 00990C EXSR SR102 VALIDATE FIELD # 01000C 55 GOTO UPDATE DONE ÐÐ01010C EXSR SR201 IDENTIFY-F 01020C SETON 69 01030C EXSR SR72 PROMPT 01040C SETOF 69 01050C EXSR SR75 READ TERMINAL 01060C 98 GOTO GOODBY GOODBY 01070C 94 GOTO MENU MENU REQUEST 01080C 90 EXSR SR72 DISPLAY INPUT DATA 01090C 93 GOTO NEWITM NEW ITEM 01100C 92 GOTO JUMP FIELD JUMP REQST 01110C 91 GOTO NEXT SKIP FORWARD 01120C 89 F SUB 1 F SKIP BACKWARD 01130C 89 GOTO READ " " 01140C 88 SETOF 90 SPACE FILL 01150C 88 SETON 77 " " 01160C 87 GOTO START 01170C 86 GOTO UPDATE UPDATE 01180C 85 GOTO READ REPEAT 01190C 96 GOTO ERROR ERROR 01200C N77 GOTO EDIT NO DATA INPUT 01210C*------------------------------------------------------------------- 01220C PROCES TAG 01230C* PROCESS INPUT DATA 01240C EXSR SR103 MOVE DATA 01250C*------------------------------------------------------------------- ÐÐ01260C EDIT TAG 01270C N96 EXSR SR104 EDIT DATA 01280C EXSR SR72 REWRITE DATA 01290C 96 GOTO ERROR ERROR 01300C GOTO NEXT 01310C*------------------------------------------------------------------- 01320C UPDATE TAG 01330C* UPDATE DATA BASE. 01340C EXSR SR105 FINAL EDIT 01350C 96 GOTO ERROR ERROR 01360C EXSR SR106 UPDATE 01370C 96 GOTO ERROR ERROR 01380C 1 ADD COUNT COUNT 30 01390C COUNT COMP 118 54 54 01400C 54 EXSR SR71 NEW PAGE 01410C GOTO START 01420C*------------------------------------------------------------------- 01430C JUMP TAG 01440C* SET-UP JUMP TO REQUESTED FIELD 01450C 1 ADD W W 30 01460C W COMP 28 54 01470C 54 Z-ADD318 M 50 96 FLAG ERROR 01480C 54 GOTO ERROR BAD ESC 01490C MOVE ' ' W3A 3 01500C MOVEAA14,W W3A ÐÐ01510C Z-ADD3 W2N 20 01520C EXIT SUBRAJ R. JUSTIFY 01530C RLABL W2N 01540C RLABL W3A 01550C MOVE W3A F NEW FIELD # 01560C GOTO READ 01570C*------------------------------------------------------------------- 01580C ERROR TAG 01590C EXSR SR102 VALIDATE FIELD # 01600C EXSR SR89 GET MSG 01610C EXSR SR73 PUT MSG 01620C GOTO READ 01630C*------------------------------------------------------------------- 01640C NEWITM TAG 01650C* SET-UP LINK FOR NEW ITEM 01660C MOVEL'Q005RR' PROG 8 01670C GOTO END 01680C*------------------------------------------------------------------- 01690C MENU TAG 01700C* SET-UP LINK TO MENU 01710C MOVELCRMENU PROG 01720C GOTO END 01730C*------------------------------------------------------------------- 01740C GOODBY TAG 01750C* LINK TO SIGN-OFF ÐÐ01760C MOVEL'GOODBY' PROG 01770C GOTO END 01780C*------------------------------------------------------------------- 01790C END TAG 01800C EXSR SR97 UPDATE CRTFILE 01810C EXITFCHAIN LINK TO NEXT PROG 01820C RLABL PROG 01830C******************************************************************** 01840CSR SR1 BEGSR 01850C* EDIT TRAN CODE. 01860CSR EXSR SR203 CLASSIFY TRAN 01870CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 01880CSR MOVE BLK6 TRNNAM 6 01890CSR 60 MOVE 'ADD ' TRNNAM 01900CSR 61 MOVE 'CHANGE' TRNNAM 01910CSR 62 MOVE 'DELETE' TRNNAM 01920CSR ENDSR 01930C********************************************************************* 01940CSR SR2 BEGSR 01950C* EDIT MODEL/PART # 01960CSR MOVELTMODL W22A 22 01970CSR W22A SETLLPMMODEL2 01980C*------------------------------------------------------------------- 01990CSR T2A TAG 02000CSR SETOF 54 ÐÐ02010CSR READ PMMODEL2 54 02020CSR 54 GOTO T2P 02030CSR PDMODL COMP TMODL 54 02040CSRN54 GOTO T2P 02050CSR PDSTAT COMP 'D' 54 02060CSR 54 GOTO T2A 02070CSR Z-ADDPDPN RLPN 02080CSR GOTO T2S 02090C*------------------------------------------------------------------- 02100CSR T2P TAG 02110CSR MOVELTMODL W10A 10 02120CSR Z-ADD10 W2N 02130CSR EXIT SUBRAJ R.J. 02140CSR RLABL W2N 02150CSR RLABL W10A 02160CSR MOVE W10A RLPN 02170C*------------------------------------------------------------------- 02180CSR T2S TAG 02190CSR MOVELRLPN W12A 12 02200CSR MOVE ' ' W12A 02210CSR W12A CHAINPMMST2 60 02220CSRN60 PMSTAT COMP 'D' 60 02230CSR 60 Z-ADD291 M 96 FLAG ERROR 02240CSRN96 MOVE PMMODL TMODL 02250CSR ENDSR ÐÐ02260C******************************************************************** 02270CSR SR3 BEGSR 02280C* EDIT LOT #. 02290CSR TLOT COMP 0 54 02300CSRN54 Z-ADD687 M 96 FLAG ERROR 02310CSRN54 GOTO END3 02320CSR MOVELTMODL KEYRL 14 02330CSR MOVE TLOT KEYRL 02340CSR EXSR SR80 GET RUNREL RECORD 02350CSR EXSR SR203 CLASSIFY TRAN 02360CSR 60N30N31 Z-ADD4 M 96 FLAG DUPLICATE ADD 02370CSRN60 30 02380CORN60 31 Z-ADD5 M 96 FLAG NO HIT ERROR 02390CSRN30N31 EXSR SR71 PUT SCREEN 02400CSR 30 02410COR 31 EXSR SR205 INIT RUNREL 02420CSR END3 ENDSR 02430C******************************************************************** 02440CSR SR4 BEGSR 02450C* EDIT QTY 02460CSR RLQTY COMP 0 54 02470CSRN54 Z-ADD184 M 96 FLAG ERROR 02480CSR ENDSR 02490C******************************************************************** 02500CSR SR5 BEGSR ÐÐ02510C* EDIT DUE DATE 02520CSR MOVELRLDUE W2N 02530CSR W2N COMP 12 54 02540CSRN54 MOVELRLDUE W4N 40 02550CSRN54 MOVE RLDUE W2N 02560CSRN54 MOVELW2N RLDUE 02570CSRN54 MOVE W4N RLDUE 02580CSR MOVEL'C' W7A 7 02590CSR MOVE RLDUE W7A 02600CSR W7A CHAINCALENDAR 60 02610CSR 60 Z-ADD578 M 96 FLAG ERROR 02620CSR ENDSR 02630C***************************************************************** 02640CSR SR68 BEGSR 02650CSR EXITFQCLF LINE FEED 02660CSR ENDSR 02670C**************************************************************** 02680CSR SR69 BEGSR 02690CSR EXITFQXYPOS MOVE CURSOR 02700CSR RLABL W6A 02710CSR ENDSR 02720C***************************************************************** 02730CSR SR70 BEGSR 02740C* CLEAR TERM SCREEN. 02750CSR EXITFZCPAGE CLEAR SCREEN ÐÐ02760CSR Z-ADD91 COUNT 30 02770CSR ENDSR 02780C********************************************************************** 02790CSR SR71 BEGSR 02800C* PUT HEADINGS TO TERMINAL 02810CSR EXSR SR70 CLEAR PAGE 4 02820CSR SETON 71 02830CSR EXCPT PUT HEADINGS 02840CSR SETOF 71 02850CSR Z-ADD95 COUNT 02860CSR ENDSR 02870C********************************************************************* 02880CSR SR72 BEGSR 02890C* PUT DATA TO TERMINAL 02900CSR COUNT SUB 1 W3N 30 02910CSR MOVELW3N W6A 6 02920CSR MOVE '001' W6A 02930CSR EXSR SR69 MOVE CURSOR 02940CSR SETON 72 02950CSR EXCPT PUT DATA 02960CSR SETOF 72 02970CSR ENDSR 02980C*********************************************************************** 02990CSR SR73 BEGSR 03000C* PUT ERROR MESSAGE TO TERMINAL ÐÐ03010CSR MOVELCOUNT W6A 03020CSR MOVE '001' W6A 03030CSR EXSR SR69 MOVE CURSOR 03040CSR SETON 73 03050CSR EXCPT PUT MSG 03060CSR SETOF 73 03070CSR ENDSR 03080C******************************************************************* 03090CSR SR75 BEGSR 03100C* READ FROM TERMINAL 03110CSR SETOF 779096 03120CSR SETOF 939291 03130CSR SETOF 898887 03140CSR SETOF 8685 03150CSR MOVE BIT,15 BUFLGT 2 READ BUFFER LGTH 03160CSR MOVE BLK14 W14A 14 BUFFER 03170CSR MOVE BIT,28 A9,1 03180CSR MOVE '8' A9,2 03190CSR MOVE COUNT W3A 3 03200CSR MOVEAW3A A9,3 03210CSR MOVEALOC,F A9,6 03220CSR MOVE BIT,8 A9,9 03230CSR MOVEAA9 W9A 9 03240CSR EXITFQPREED READ FROM TERMINAL 03250CSR RLABL W9A STARTING POSITION ÐÐ03260CSR RLABL W14A READ BUFFER 03270CSR RLABL BUFLGT READ BUFFER LGTH 03280CSR MOVEAW14A A14 INPUT DATA ARRAY 03290CSR MOVE BLK14 W14A INIT INPUT ARRAY 03300CSR Z-ADD1 W 30 03310CSR '\' LOKUPA14,W 90 FLAG ESC 03320CSRN90 GOTO T75B NOT ESC 03330CSR 1 ADD W W 03340CSR W COMP 14 54 03350CSR 54 GOTO T75A BAD ESC 03360CSR A14,W COMP 'G' 98 GOODBY 03370CSR A14,W COMP 'E' 94 MENU 03380CSR A14,W COMP 'N' 93 NEW ITEM 03390CSR A14,W COMP 'J' 92 JUMP 03400CSR A14,W COMP 'F' 91 SKIP FRWRD 03410CSR A14,W COMP 'B' 89 SKIP BKWRD 03420CSR A14,W COMP 'S' 88 SPACE FILL 03430CSR A14,W COMP 'H' 87 HOME 03440CSR A14,W COMP 'U' 86 UPDATE 03450CSR A14,W COMP 'R' 85 REPEAT 03460CSR 98 03470COR 94 03480COR 93 03490COR 92 03500COR 91 ÐÐ03510COR 89 03520COR 88 03530COR 87 03540COR 86 03550COR 85 GOTO END75 GOOD ESC 03560C*------------------------------------------------------------------ 03570CSR T75A TAG 03580C* FLAG BAD ESC INPUT 03590CSR Z-ADD318 M 96 FLAG ERROR 03600CSR GOTO END75 03610C*-------------------------------------------------------------------- 03620CSR T75B TAG 03630C* MOVE DATA 03640CSR Z-ADD1 W 03650CSR ' ' LOKUPA14,W 77 03660CSR 77 MOVEAA14,W W14A INPUT DATA 03670C*-------------------------------------------------------------------- 03680CSR END75 TAG 03690C* INIT PREV ERROR MSG. 03700CSR LSTERR COMP 0 54 03710CSR 54 MOVE BLK35 MGTEXT 03720CSR 54 EXSR SR73 BLANK MESSAGE 03730CSR Z-ADD0 LSTERR 50 03740CSR ENDSR 03750C********************************************************************** ÐÐ03760CSR SR80 BEGSR 03770C* GET MASTER RECORD 03780CSR SETOF 31 03790CSR KEYRL CHAINRUNREL 30 GET MASTER 03800CSRN30 RLSTAT COMP 'D' 31 FLAG DELETE 03810CSR ENDSR 03820C********************************************************************** 03830CSR SR81 BEGSR 03840C* ADD NEW MASTER TO FILE 03850CSR SETON 81 03860CSR EXCPT ADD MASTER 03870CSR SETOF 81 03880CSR ENDSR 03890C*********************************************************************** 03900CSR SR82 BEGSR 03910C* REWRITE MASTER 03920CSR SETON 82 03930CSR EXCPT REWRITE MASTER 03940CSR SETOF 82 03950CSR ENDSR 03960C********************************************************************** 03970CSR SR89 BEGSR 03980C* GET MESSAGE MASTER 03990CSR M CHAINMGFILE 54 04000CSR 54 MOVE BLK35 MGTEXT ÐÐ04010CSR 54 MOVELM MGTEXT 04020CSR 54 MOVE MES,1 MGTEXT 04030CSR ENDSR 04040C****************************************************************** 04050CSR SR97 BEGSR 04060C* UPDATE CRTFILE. 04070CSR SETON 97 04080CSR EXCPT UPDATE CRTFILE 04090CSR SETOF 97 04100CSR ENDSR 04110C******************************************************************** 04120CSR SR101 BEGSR 04130C* 1-TIME INITIALIZE 04140CSR MOVE BIT,1 NUL 04150CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 04160CSR Z-ADD5 FLIMIT 30 TOTAL NUMB FIELDS 04170CSR MOVE ' ' BLK14 14 04180C* GET PORT # AND CRTFILE 04190CSR MOVE ' ' W8A 8 04200CSR Z-ADD0 W2N 20 04210CSR Z-ADD0 W1N 10 04220CSR MOVE ' ' W2A 2 04230CSR EXITFPGMINX GET PORT # 04240CSR RLABL W8A 04250CSR RLABL W2N ÐÐ04260CSR RLABL W1N 04270CSR RLABL W2A 04280CSR MOVE W2A PORT 20 PORT NO. 04290CSR PORT COMP 0 54 04300CSRN54 Z-ADD25 PORT DEFAULT 04310CSR PORT CHAINCRTFILE H9 04320C* DEFINE WORK FIELDS,ETC. 04330CSR MOVE ' ' BLK35 35 04340CSR MOVE ' ' BLK6 6 04350CSR ENDSR 04360C********************************************************************** 04370CSR SR102 BEGSR 04380C* VALIDATE FIELD NO. 04390CSR F COMP 0 54 04400CSRN54 Z-ADD1 F 04410CSR F COMP FLIMIT 55 04420CSR 55 Z-ADD8 F 04430CSR EXSR SR203 CLASSIFY TRAN 04440CSR 62 F COMP 3 54 04450CSR 62 54 SETON 55 04460CSR ENDSR 04470C******************************************************************** 04480CSR SR103 BEGSR 04490C* MOVE INPUT DATA 04500CSR EXSR SR201 IDENTIFY-F ÐÐ04510CSR EXSR SR202 R. JUSTIFY 04520CSR 01 MOVELW14A TRAN 1 TRAN CODE 04530CSR 02 MOVELW14A TMODL 12 MODEL 04540CSR 03 MOVE W10A TLOT 20 LOT # 04550CSR 04 MOVE W10A RLQTY QTY 04560CSR 05 MOVE W10A RLDUE DUE DATE 04570CSR MOVE ' ' DUN,F EDIT FLAG 04580CSR ENDSR 04590C******************************************************************** 04600CSR SR104 BEGSR 04610C* EDIT INPUT DATA 04620CSR 01 EXSR SR1 04630CSR 02 EXSR SR2 04640CSR 03 EXSR SR3 04650CSR 04 EXSR SR4 04660CSR 05 EXSR SR5 04670CSR 96 MOVE ' ' DUN,F EDIT FLAG 04680CSRN96 MOVE 'X' DUN,F 04690CSR ENDSR 04700C*********************************************************************** 04710CSR SR105 BEGSR 04720C* FINAL EDIT 04730CSR SETOF 77 04740CSR SETON 79 FINAL EDIT FLAG 04750CSR Z-ADD1 F 96 ÐÐ04760C*-------------------------------------------------------------------- 04770CSR T105A TAG 04780CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04790CSRN54 GOTO END105 04800CSR EXSR SR201 IDENTIFY-F 04810CSR EXSR SR104 EDIT 04820CSRN96 GOTO T105A 04830C*-------------------------------------------------------------------- 04840CSR END105 TAG 04850CSR SETOF 79 04860CSR ENDSR 04870C******************************************************************** 04880CSR SR106 BEGSR 04890C* UPDATE DATA BASE. 04900CSR EXSR SR203 CLASSIFY TRAN 04910CSR 60 GOTO T106A ADD TRAN 04920CSR 61 GOTO T106D CHANGE TRAN 04930CSR 62 GOTO T106F DELETE TRAN 04940C* FLAG BAD TRAN CODE 04950CSR Z-ADD300 M 96 FLAG ERROR 04960CSR Z-ADD8 F FIELD # 04970CSR GOTO END106 04980C*------------------------------------------------------------------- 04990CSR T106A TAG 05000C* ADD TRANSACTION ÐÐ05010CSR 30 GOTO T106B NOT ON FILE 05020CSR 31 GOTO T106C DELETED MASTER 05030C* FLAG DUPLICATE ADD ERROR 05040CSR Z-ADD301 M 96 FLAG ERROR 05050CSR Z-ADD8 F FIELD # 05060CSR GOTO END106 05070C*--------------------------------------------------------------------- 05080CSR T106B TAG 05090C* ADD-- MAST NOT ON FILE 05100CSR EXSR SR81 ADD NEW MASTER 05110CSR GOTO END106 05120C*--------------------------------------------------------------------- 05130CSR T106C TAG 05140C* ADD-- MAST IS DELETED 05150CSR MOVE 'A' RLSTAT RECORD STATUS 05160CSR EXSR SR82 REWRITE MAST 05170CSR GOTO END106 05180C*---------------------------------------------------------------------- 05190CSR T106D TAG 05200C* CHANGE TRANSACTION. 05210CSRN30N31 GOTO T106E GOT IT 05220C* FLAG NO MASTER ERROR 05230CSR Z-ADD302 M 96 FLAG ERROR 05240CSR Z-ADD8 F FIELD # 05250CSR GOTO END106 ÐÐ05260C*----------------------------------------------------------------------- 05270CSR T106E TAG 05280C* REWRITE MASTER 05290CSR EXSR SR82 REWRITE MAST 05300CSR GOTO END106 05310C*----------------------------------------------------------------------- 05320CSR T106F TAG 05330C* DELETE TRANSACTION 05340CSRN30N31 GOTO T106G GOT IT 05350C* FLAG NO MASTER ERROR 05360CSR Z-ADD302 M 96 FLAG ERROR 05370CSR Z-ADD8 F FIELD # 05380CSR GOTO END106 05390C*----------------------------------------------------------------------- 05400CSR T106G TAG 05410C* DELETE MASTER. 05420CSR MOVE 'D' RLSTAT RECORD STATUS 05430CSR EXSR SR82 REWRITE MASTER 05440CSR END106 ENDSR 05450C************************************************************************ 05460CSR SR201 BEGSR 05470C* IDENTIFY FIELD NO. 05480CSR F COMP 1 01 05490CSR F COMP 2 02 05500CSR F COMP 3 03 ÐÐ05510CSR F COMP 4 04 05520CSR F COMP 5 05 05530CSR ENDSR 05540C********************************************************************** 05550CSR SR202 BEGSR 05560C* RIGHT JUSTIFY 05570CSR F LOKUPNUM 54 05580CSRN54 GOTO END202 NOT NUMERIC FIELD 05590CSR Z-ADD10 W2N 20 05600CSR MOVELW14A W10A 10 05610CSR EXIT SUBRAJ R. JUSTIFY 05620CSR RLABL W2N 05630CSR RLABL W10A 05640CSR END202 ENDSR 05650C*********************************************************************** 05660CSR SR203 BEGSR 05670C* CLASSIFY TRAN CODE 05680CSR TRAN COMP 'A' 60 ADD 05690CSR TRAN COMP 'C' 61 CHANGE 05700CSR TRAN COMP 'D' 62 DELETE 05710CSR ENDSR 05720C**************************************************************************05730CSR SR205 BEGSR 05740C* INIT RUNREL RECORD 05750CSR MOVE BLK35 RLKEY ÐÐ05760CSR MOVE BLK35 RLMODL 05770CSR Z-ADD0 RLLOT 05780CSR Z-ADD0 RLQTY 05790CSR Z-ADD0 RLDUE 05800CSR MOVE ' ' RLSTAT 05810CSR ENDSR 05820C* 05830O******************************************************************** 05840ORUNREL EADD 81 05850O TMODL 12 05860O TLOT 14 05870O RLQTY 17P 05880O RLDUE 23 05890O RLPN 33 05900O 34 'A' 05910O*------------------------------------------------------------------- 05920O E 82 05930O RLQTY 17P 05940O RLDUE 23 05950O RLPN 33 05960O RLSTAT 34 05970O********************************************************************* 05980OTERM132 E 71 05990O BIT,28 1 06000O 8 '8091001' ÐÐ06010O UDATE 16 ' - - ' 06020O 55 'R U N' 06030O 72 'R E L E A S E' 06040O 85 'I N P U T' 06050O*--------------------------------------------------------------- 06060O E 71 06070O 1 ' ' 06080O*--------------------------------------------------------------- 06090O E 71 06100O 9 'TRAN-CODE' 06110O 19 'PART-NO.' 06120O 33 'MODEL-NO.' 06130O 42 'LOT #' 06140O 57 'DESCRIPTION' 06150O 85 'QUANTITY' 06160O 95 'DUE-DATE' 06170O 120 'E R R O R M E S S A G ' 06180O 121 'E' 06190O*------------------------------------------------------------- 06200O E 71 06210O 3 '(1)' 06220O 27 '(2)' 06230O 40 '(3)' 06240O 80 '(4)' 06250O 90 '(5)' ÐÐ06260O*------------------------------------------------------------------- 06270O E 72 06280O TRAN 1 06290O TRNNAM 8 06300O RLPN 22 ' - - ' 06310O TMODL 36 06320O TLOT Z 41 06330O PMDESC 75 06340O RLQTY 2 85 06350O RLDUE 95 ' - - ' 06360O MGTEXT 132 ** NUL ARRAY 06370 06380** A14 ARRAY 06390 06400** A9 ARRAY 06410 06420** LOC ARRAY 06430001 1 TRAN 06440012 2 MODEL 06450041 3 LOT # 06460078 4 QTY 06470088 5 DUE 06480** NUM ARRAY 06490003 LOT 06500ÐÐ004 QTY 06510005 DUE 06520** DUN ARRAY 06530 06540** MES ARRAY 06550---MESSAGE NOT ON FILE--- 06560/* 06570_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d d*X038PM P120282120282(èÈÐ00010H Q038PM00020F* ELIMINATE MODEL NAME IF NO PROVISIONING CODE. (X038PM) 00030F* REVISED 3/12/81 9:30 AM. 00040FPMMST2 UP F 674 12AI 1 DISK 00050I******************************************************************** 00060IPMMST2 PM 01 00070I 19 30 PMMODL 50 00080I 96 96 PMPROV 60 00090C******************************************************************** 00100C 60N50 MOVEL' ' PMMODL 00110C 60N50 MOVE ' ' PMMODL 00120O******************************************************************** 00130OPMMST2 D 01 60N50 00140O PMMODL 30 /* 000150_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(D1 DòX039BM P120282120282(èÈÐ00010H Q039BM00020F* PRINT SINGLE LEVEL PARTS LIST (X039BM) S Y S T E M P R I N T E R 00030F* REVISED 6/09/81 3:30 PM. DG-REL006 OK. 00040FPMMST2 IC F 674R12AI 1 DISK 00050FBMMAST IP F 86 20AI 1 DISK 00060FPRINT O F 132 LPRINTER 00070FTERM24 O F 24 5 00080E******************************************************************** 00090E TABIC 1 9 2 TABICN 15 ISSUE CODES. 00100E TABSC 1 6 2 ATABSCN 12 SOURCE CODES. 00110E TABPC 1 7 1 TABPCN 20 PROV CODES. 00120E AR 1 132 1 00130L****************************************************************** 00140LPRINT 88FL 88OL 00150I******************************************************************** 00160IPMMST2 PM 00170I* PART MASTER RECORD (XPMMST) 00180I* KEY AREA 00190I* PART NO. 12A 00200I 1 100PMPN 00210I* PROD LINE 4N 00220I 15 180PMPL 00230I* MODEL NAME 12A 00240I 19 30 PMMODL 00250I* DESCRIPTION 29A ÐÐ00260I 31 59 PMDESC 00270I* COMMODITY CODE 9P 00280I P 60 640PMCC 00290I* ENG CHANGE STATUS. 00300I* CUR CHG LEVEL 2A 00310I 70 71 PMECHG 00320I* CUR CHG DATE 6N 00330I 72 770PMDCHG 00340I* LAST ECN NO. 5A 00350I 65 69 PMECN 00360I* DRAWING INFO 00370I* DWG SIZE 1A 00380I 82 82 PMSIZ 00390I* DWG CLASS 1A 00400I* D = DYNAIR DWG 00410I* V = VENDOR DWG 00420I 83 83 PMDCLS 00430I* STANDARD CODE 1A 00440I 84 84 PMSTDC 00450I* DWG REL CODE 1A 00460I* E = ENG ONLY 00470I* M = REL TO MFG 00480I* P = PROTOTYPE 00490I 78 78 PMDREL 00500I* UNIT MEAS 2A ÐÐ00510I* EA = EACH OC = OUNCE 00520I* ST = SET TC = TROY OUNCE 00530I* IN = INCH LB = POUND 00540I* FT = FEET PT = PINT 00550I* YD = YARD QT = QUART 00560I* SI = SQ.INCH GL = GALLON 00570I* SF = SQ.FEET DR = DRUM 00580I* SY = SQ.YARD 00590I 85 86 PMUM 00600I* SOURCE CODE 2A 00610I* MA = MFG ASSY 00620I* MP = MFG PART 00630I* PA = PURCH ASSY 00640I* PP = PURCH PART 00650I* RS = RAW STOCK 00660I 94 95 PMSC 00670I* PROVISIONING CODE 1A 00680I* A = FORECAST,NO VALUE ADDED 00690I* B = FORECAST,VALUE ADDED 00700I* C = BUILD TO ORDER (B) 00710I* D = BUILD TO ORDER (NOT B) 00720I* E = CUSTOM 00730I* Y = OBSOLETE,REPAIRABLE 00740I* Z = OBSOLETE,NOT REPAIRABLE 00750I 96 96 PMPROV ÐÐ00760I* ISSUE CODE 2A 00770I* PT = PULL TIME 00780I* OR = ON REQUEST 00790I* BI = BULK ISSUE 00800I* AR = AS REQUIRED 00810I* VS = VENDOR SUPPLIED 00820I* SD = SHIPPING DOCUMENT 00830I* TD = TRAV DOCUMENT 00840I* RD = REF DOCUMENT 00850I* RA = REF ASSY 00860I 97 98 PMISSU 00870I* DELIVER TO DEPT 5P 00880I P 99 1010PMDEL 00890I* RESPONSIBILITY CODES 00900I* ENGR CODE 2A 00910I 102 103 PMEGR 00920I* PLANNER CODE 2A 00930I 104 105 PMPLNR 00940I* BUYER CODE 2A 00950I 106 107 PMBUYR 00960I* SALESMAN CODE 2A 00970I 108 109 PMSLSM 00980I* INVENTORY ACCOUNT 5P 00990I P 110 1120PMACNT 01000I* LOW LEVEL CODE 2N ÐÐ01010I 430 4310PMLL 01020I* FAB CODE 2A 01030I 487 488 PMFAB 01040I* RECORD STATUS 1A 01050I* D = DELETED 01060I 674 674 PMSTAT 01070I******************************************************************** 01080IBMMAST BM 01 86NCD 01090I* BILL OF MATERIAL RECORD (XBMREC) 01100I* KEY AREA 01110I* ASSY PART NO. 10N 01120I 1 100BMAPN L1 01130I* COMPONENT PART NO. 10N 01140I 11 200BMCPN 01150I* ITEM NO. 3N 01160I 25 270BMITNO 01170I* QTY PER ASSY 7P 01180I P 28 310BMQTY 01190I* SCRAP ALLOW .2N 01200I 34 352BMSCRP 01210I* ISSUE CODE 2A 01220I* PT = PULL TIME 01230I* OR = ON REQUEST 01240I* BI = BULK ISSUE 01250I* AR = AS REQUIRED ÐÐ01260I* RA = REF ASSY 01270I* TD = TRAV DOC 01280I* SD = SHIP DOC 01290I* RD = REF DOC 01300I* VS = VENDOR SUPPLIED 01310I 36 37 BMISSU 01320I* EFFECTIVITY. 01330I* BEGIN CHANGE LEVEL 2A 01340I 38 39 BMBCHG 01350I* ENDING CHANGE LEVEL 2A 01360I 40 41 BMECHG 01370I* BEGIN ECN # 5A 01380I 42 46 BMBECN 01390I* ENDING ECN # 5A 01400I 47 51 BMEECN 01410I* DISPOSITION CODE 1A 01420I* U = USE UP OLD STYLE 01430I* N = NOW (IMMEDIATE) 01440I 52 52 BMDISP 01450I* FILLER 5A 53 57 FFFFFF 01460I* ROUTING. 01470I* OPER NO. 5P 01480I P 58 600BMOPER 01490I* DEPT NO. 5P 01500I P 61 630BMDEPT ÐÐ01510I* WORK CENTER NO. 3P 01520I P 64 650BMWC 01530I* ASSEMBLY OPER REFERENCE INFO 10A 01540I 66 75 BMREF 01550I* FILLER 76 85 FFFFFF 01560I* 01570I* RECORD STATUS 1A 01580I* D = DELETED 01590I 86 86 BMSTAT 01600I*--------------------------------------------------------------------- 01610I GG 02 01620C******************************************************************** 01630C* INITIALIZE (1-TIME). 01640C N79 EXSR SR101 INIT. 01650C N91 BMAPN COMP BEGPN 91 91 01660C N91 GOTO ENDJOB 01670C NL1 GOTO NOTL1 01680C SETOF 7873 01690C* SPACE 1, GET PART MASTER FOR ASSEMBLY 01700C EXSR SR70 01710C 1 ADD COUNT COUNT 30 01720C MOVELBMAPN W12A 12 01730C EXSR SR81 GET PMMST. 01740C 60 GOTO END 01750C* SAVE ASSEMBLY DATA. ÐÐ01760C EXSR SR102 SAVE ASSEMBLY DATA 01770C*------------------------------------------------------------------- 01780C NOTL1 TAG 01790C* GET COMPONENT PART MASTER 01800C MOVELBMCPN W12A 01810C EXSR SR81 GET PMMST2 01820C 60 GOTO END NO MASTER 01830C* PUT TO CRT. 01840C MOVELPMPN NUMPN 100 01850C EXSR SR72 PUT DATA. 01860C* SEE IF END OF EGAP. 01870C COUNT COMP 81 54 54 LINE #. 01880C N54 GOTO END NOT EOP. 01890C SETON 73 01900C EXSR SR74 END OF EGAP SPACING 01910C EXSR SR71 01920C*------------------------------------------------------------------- 01930C END TAG 01940C*------------------------------------------------------------------- 01950C ENDJOB TAG 01960C****************************************************************** 01970CSR SR70 BEGSR 01980CSR SETON 70 01990CSR EXCPT PUT BLANK LINE 02000CSR SETOF 70 ÐÐ02010CSR ENDSR 02020C******************************************************************** 02030CSR SR71 BEGSR 02040C* PUT HEADINGS. 02050CSR 1 ADD EGAP EGAP 40 02060CSR SETON 71 02070CSR EXCPT CLEAR CRT. 02080CSR SETOF 71 02090CSR Z-ADD6 COUNT 30 02100CSR ENDSR 02110C******************************************************************** 02120CSR SR72 BEGSR 02130C* PUT DATA LINE. 02140CSR PMMODL COMP BLK12 54 02150CSR 54 MOVE BLK35 PMDESC 02160CSR 54 MOVELPMMODL PMDESC 02170CSR 1 ADD COUNT COUNT 02180CSR SETON 72 02190CSR EXCPT 02200CSR SETOF 7273 02210CSR SETON 78 02220CSR ENDSR 02230C******************************************************************** 02240CSR SR74 BEGSR 02250C* SPACING AT END OF EGAP ÐÐ02260CSR 1 ADD COUNT COUNT 02270CSR COUNT COMP 88 54 02280CSR 54 GOTO END74 02290CSR EXSR SR70 PUT BLANK LINE 02300CSR GOTO SR74 02310CSR END74 ENDSR 02320C******************************************************************** 02330CSR SR81 BEGSR 02340C* GET PART MAST. 02350CSR MOVE ' ' W12A 02360CSR W12A CHAINPMMST2 60 02370CSRN60 PMSTAT COMP 'D' 60 02380CSR ENDSR 02390C******************************************************************** 02400CSR SR101 BEGSR 02410C* 1-TIME INITIALIZE. 02420CSR SETON 79 02430CSR MOVE ' ' BLK12 12 02440CSR MOVE ' ' BLK35 35 02450CSR Z-ADD0 ZERO10 100 02460CSR MOVE '-' AR 02470CSR MOVE '<' AR,1 02480CSR MOVE '>' AR,132 02490CSR MOVE '>' AR,80 02500CSR MOVEA' ' AR,84 ÐÐ02510CSR MOVE '<' AR,85 02520CSR MOVEAAR DIV 132 02530CSR SETON 74 02540CSR EXCPT SETUP PRTR MSG 02550CSR SETOF 74 02560CSR MOVE BLK12 W12A 02570CSR EXITFZRED12 READ STARTING PN 02580CSR RLABL W12A 02590CSR Z-ADD12 W2N 20 02600CSR EXIT SUBRAJ RJ 02610CSR RLABL W2N 02620CSR RLABL W12A 02630CSR MOVE W12A BEGPN 100 STARTING PART # 02640CSR SETON 75 02650CSR EXCPT EGAP PROMPT 02660CSR SETOF 75 02670CSR MOVE BLK12 W12A 02680CSR EXITFZRED12 READ STARTING EGAP # 02690CSR RLABL W12A 02700CSR Z-ADD12 W2N 02710CSR EXIT SUBRAJ R.J. 02720CSR RLABL W2N 02730CSR RLABL W12A 02740CSR MOVE W12A EGAP 40 02750CSR EGAP COMP 0 54 ÐÐ02760CSR 54 EGAP SUB 1 EGAP 02770CSR EXSR SR71 PUT HEADINGS 02780CSR ENDSR 02790C******************************************************************* 02800CSR SR102 BEGSR 02810C* MOVE PART MAST TO ASSEMBLY SAVE FIELDS 02820CSR Z-ADDPMPN CPN 100 02830CSR MOVE PMFAB CFAB 2 02840CSR MOVELPMDESC CDESC 22 02850CSR MOVE PMMODL CMODL 12 02860CSR MOVE PMSC CSC 2 02870CSR MOVE PMISSU CISSU 2 02880CSR MOVE PMPROV CPROV 1 02890CSR MOVE PMECHG CECHG 2 02900CSR MOVE PMECN CECN 5 02910CSR Z-ADDPMPL CPL 40 02920CSR ENDSR 02930O***************************************************************** 02940OTERM24 E 74 02950O 24 'SET PRINTER 8-LPI ' 02960O*------------------------------------------------------------------- 02970O E 74 02980O 24 'ENTER STARTING PART # : ' 02990O*------------------------------------------------------------------- 03000O E 75 ÐÐ03010O 24 'ENTER STARTING PAGE # : ' 03020O****************************************************************** 03030OPRINT E 70 03040O 1 ' ' 03050O*-------------------------------------------------------------- 03060O E 71 03070O 72 'SINGLE-LEVEL PARTS-LIST' 03080O 127 'PAGE' 03090O EGAP Z 132 03100O UDATE Y 8 03110O*--------------------------------------------------------------- 03120O E 71 03130O 1 ' ' 03140O*----------------------------------------------------------------- 03150O E 71 03160O DIV 132 03170O 48 'C O M P O N E N T' 03180O 118 'A S S E M B L Y' 03190O 83 'QTY' 03200O*------------------------------------------------------------------- 03210O E 71 03220O 64 'SOURCE' 03230O 70 'ISSUE' 03240O 132 'CHG' 03250O 74 'FAB' ÐÐ03260O 83 'PER' 03270O*-------------------------------------------------------------------- 03280O E 71 03290O 8 'PART-NO.' 03300O 25 'DESCRIPTION' 03310O 49 'MODEL' 03320O 63 'CODE' 03330O 69 'CODE' 03340O 75 'CODE' 03350O 92 'PART-NO.' 03360O 102 'MODEL' 03370O 121 'DESCRIPTION' 03380O 132 'LEV' 03390O 83 'ASSY' 03400O*------------------------------------------------------------------- 03410O E 71 03420O 1 ' ' 03430O*------------------------------------------------------------------- 03440O E 72 03450O PMPN 12 ' - - ' 03460O PMDESC 43 03470O PMMODL 57 03480O PMSC 61 03490O BMISSU 68 03500O PMFAB 74 ÐÐ03510O BMQTY 2 83 03520O 73 CPN 96 ' - - ' 03530O 73 CMODL 109 03540O N78 CPN 96 ' - - ' 03550O N78 CMODL 109 03560O N73N78 CDESC 132 03570O N73N78 CECHG 132 03580O N73N78 130 ' ' 03590O 73 78 128 'C O N T I N U E D' ** TABIC/TABICN VALID ISSUE CODES 003600ORON REQUEST 003610BIBULK ISSUE 003620ARAS REQD 003630VSVENDOR SUPL'D 003640SDSHIPPING DOCUMENT 003650TDTRAVELER DOCUMENT 003660RDREF DOC ONLY 003670RAREF ASSY/PART 003680** TABSC/TABSCN VALID SOURCE CODES 003690MAMFG ASSY 003700MPMFG PART 003710PAPURCH ASSY 003720PPPURCH PART 003730RDREF DOC ONLY 003740RSRAW STOCK 003750ÐÐ** TABPC/TABPCN VALID PROVISION CODES 003760AFRCST,NO VAL ADDED 003770BFRCST,VAL IS ADDED 003780CBLD/ORD,NO VAL ADDED 003790DBLD TO ORD,VAL ADDED 003800ECUSTOM 003810YOBSLT, REPAIRABLE 003820ZOBSLT,NOT REPAIR 003830** AR ARRAY 003840 03850/* 03860_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ _‚_‚ ÐÈ(X$ XúX039PM P120282120282(èÈÐ00010H Q039PM00020F* REDUCE PART MAST CONVERSION FILE SIZE (CALLLED BY Z039PM) 00030F* REVISED 2-09-81 10:15 AM. DG-REL006 OK. 00040FOLDPMCNVIP F 82 DISK 00050FPMCONVRTO F 82 DISK 00060I******************************************************************* 00070IOLDPMCNVPK 01 81 CA 82 CK 00080I GG 02 00090I 1 82 RECORD 00100OPMCONVRTD 02 00110O RECORD 82 /* 000120_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(  ZSRTPROG P999999120282(èÈÐ * SORT PROGNAME, COL 62-63 00010INPUT=ZSRTPROG 00020DSORT 00030FN=PROG1, 00040F2=PROGNAME, , 00050OP=TAG,F,A 00060KF=A,62,2,A,60,2,A,1,8 00070SL=I,62,2,NE,'--' 00080INPUT=TERMINAL 00090_‚ _‚_‚ ÐÈ(d/ d*X041PM P120282120282(èÈÐ00010H Q041PM00020F* REMOVE HRS-NO DEPT/DEPT-NO HRS IN PMMST2. (X041PM) 00030F* REVISED 4/15/81 11:00 AM. 00040FPMMST2 UP F 674 12AI 1 DISK 00050FPRINT O F 132 PRINTER 00060E******************************************************************** 00070E MDP 12 3 0 DEPT 00080E MHR 12 7 3 HRS 00090I******************************************************************** 00100IPMMST2 PM 01 00110I 1 100PMPN 00120I P 543 590 MHR 00130I P 591 614 MDP 00140I 674 674 PMSTAT 00150C******************************************************************** 00160C PMSTAT COMP 'D' 54 00170C 54 SETOF 01 00180C 54 GOTO END 00190C Z-ADD0 X 30 00200C*------------------------------------------------------------------- 00210C START TAG 00220C 1 ADD X X 00230C X COMP 12 54 00240C 54 GOTO END 00250C MHR,X COMP 0 55 ÐÐ00260C MDP,X COMP 0 56 00270C 55 56 00280CORN55N56 GOTO START 00290C SETON 80 00300C EXCPT 00310C SETOF 80 00320C Z-ADD0 MHR,X 00330C Z-ADD0 MDP,X 00340C GOTO START 00350C*------------------------------------------------------------------- 00360C END TAG 00370O******************************************************************** 00380OPRINT E 80 00390O PMPN 10 00400O MHR,X J 25 00410O MDP,X Z 35 00420O*************************************************************** 00430OPMMST2 D 01 U1 U9 00440O MHR 590P 00450O MDP 614P /* 000460_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ôZ ôÑX042PM P120282120282(èÈÐ00010H Q042PM00020F* UPDATE PART MAST CUR BAL FROM SFMAST. (X042PM) 00030F* REVISED 4/22/81 5:00 PM. 00040FSFMAST IP F 128 29AI 1 DISK 00050FPMMST2 US F 674 12AI 1 DISK 00060I******************************************************************** 00070ISFMAST SF 00080I* SCHEDULE MASTER. 00090I* COMMON FIELDS. 00100I* KEY AREA. 00110I 1 29 SFKEY 00120I* PART NO. 10N 00130I 1 100SFPN L1M1 00140I* DATE DUE 6N (YMD) 00150I 11 160SFDUE 00160I* RECORD CODE 2N 00170I* 10 = RECEIVED PO 00180I* 20 = REL WO 00190I* 30 = PURCHASE ORDER 00200I* 40 = PLAN WO 00210I* 50 = PURCHASE REQ 00220I* 60 = SALES ORDER-BACKLOG 00230I* 70 = REL REQUIREMENT 00240I* 80 = PLAN REQUIREMENT 00250I* 90 = RUN RELEASE ÐÐ00260I 17 180SFREC 00270I* ORDER NO. 00280I 19 29 SFORD 00290I* PREFIX 1A 00300I 19 19 SFPRFX 00310I* PRIME 5N 00320I 20 240SFPRIM 00330I* ITEM 3N 00340I 25 270SFITEM 00350I* RECEIVING LOG # 2N 00360I 28 290SFRLOG 00370I* QUANTITY 7P 00380I P 30 330SFQTY 00390I* QTY COMPLETE 7P 00400I P 34 370SFQTYC 00410I* DATE LAST TRAN 6N (YMD) 00420I 38 430SFDLT 00430I* CUST #/DEPT #/VEND # 3P 00440I P 44 460SFCUST 00450I* PLAN/REL REQMTS. 00460I* NEXT ASSY PART # 10N 00470I 47 560SFNAPN 00480I* QTY PER ASSY 7P 00490I P 57 600SFQPA 00500I* ISSUE CODE 2A ÐÐ00510I 61 62 SFISSU 00520I* PULL # 3P 00530I P 63 640SFPULL 00540I* ASSY REVISION 2A 00550I 65 66 SFREV 00560I* ASSY WO QTY 7P 00570I P 67 700SFQTYA 00580I* SALES ORDERS 00590I* CUST P.O. 20A 00600I 71 90 SFCPO 00610I* UNIT PRICE 9.3P 00620I P 91 953SFPRIC 00630I* PURCH ORDERS 00640I* VENDOR NAME 20A 00650I* SEE SFCPO UNDER SALES ORDERS. 00660I* UNIT PRICE 9.3P 00670I* SEE SFPRIC UNDER SALES ORDERS. 00680I* WORK ORDERS 00690I* DEPT NAME 20A 00700I* SEE SFCPO UNDER SALES ORDERS. 00710I* OPER SEQ # 3P 00720I P 96 970SFSEQ 00730I* START DATE 6N 00740I 98 1030SFSTRT 00750I* PULL # 3P ÐÐ00760I* SEE PLAN/REL REQMTS. 00770I* REQUIREMENT FLAG 1A 00780I 104 104 SFRFLG 00790I* REVISION 2A 00800I* SEE PLAN/REL REQMTS. 00810I* AVAIL STOCK BAL 7P 00820I P 120 1230SFSAVQ 00830I* AVAIL BAL 7P 00840I P 124 1270SFAVQ 00850I* RECORD STATUS 1A 00860I 128 128 SFSTAT 00870I******************************************************************** 00880IPMMST2 PM 20 674NCD 00890I* PART # 10N 00900I 1 100PMPN L1M1 00910I* REQUIRED QTYS. 00920I* FORECAST BAL 7P 00930I P 315 3180PMFRCB 00940I* ALLOCATIONS 7P 00950I P 319 3220PMALB 00960I* REL REQS 7P 00970I P 323 3260PMRLB 00980I* SALES BACKLOG 7P 00990I P 327 3300PMSOB 01000I* QUOTES 7P ÐÐ01010I P 331 3340PMQTB 01020I* BACKORDERS 7P 01030I P 335 3380PMBOB 01040I* ON ORDER BALANCES. 01050I* PURCHASE REQS 7P 01060I P 339 3420PMPRB 01070I* PURCH ORDERS 7P 01080I P 343 3460PMPOB 01090I* RECD P.O. 7P 01100I P 347 3500PMRPOB 01110I* OPEN WORK ORDER 7P 01120I P 351 3540PMPWOB 01130I* REL WORK ORDER 7P 01140I P 355 3580PMRWOB 01150I*------------------------------------------------------------------- 01160I GG 21 01170C******************************************************************** 01180C L1 Z-ADD0 RPO 01190C L1 Z-ADD0 RWO 01200C L1 Z-ADD0 PO 01210C L1 Z-ADD0 PWO 01220C L1 Z-ADD0 PR 01230C L1 Z-ADD0 SO 01240C L1 Z-ADD0 RRQ 01250C L1 Z-ADD0 PRQ ÐÐ01260C L1 Z-ADD0 FRC 01270C L1 Z-ADD0 BO 01280C L1 Z-ADD0 ZERO7 70 01290C 20 ACTIVE PMMST 01300COR 21 DELETED PMMST 01310COR 22 GOTO END SFMAST 01320C SFQTY SUB SFQTYC QTY 70 54 01330C N54 GOTO END 01340C 01 QTY ADD RPO RPO 70 01350C 02 QTY ADD RWO RWO 70 01360C 03 QTY ADD PO PO 70 01370C 04 QTY ADD PWO PWO 70 01380C 05 QTY ADD PR PR 70 01390C 06 QTY ADD SO SO 70 01400C 07 QTY ADD RRQ RRQ 70 01410C 08 QTY ADD PRQ PRQ 70 01420C 09 QTY ADD FRC FRC 70 01430C N06N07N08 01440CANN09 GOTO END 01450C SFQTYC COMP 0 54 01460C 54 QTY ADD BO BO 70 01470C*-------------------------------------------------------------------- 01480C END TAG 01490O******************************************************************** 01500OPMMST2 D 01 ÐÐ01510O FRC 318P 01520O PRQ 322P 01530O RRQ 326P 01540O SO 330P 01550O ZERO7 334P 01560O BO 338P 01570O PR 342P 01580O PO 346P 01590O RPO 350P 01600O PWO 354P 01610O RWO 358P /* 001620_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d, d*X043PM P120282120282(èÈÐ00010H Q043PM00020F* LIST NON-FORECAST WITH CURRENT ON HAND. (X043PM) 00030F* REVISED 5/29/81 3:30 PM. 00040FPMMST2 IP F 674 12AI 1 DISK 00050FPRINT O F 132 OF PRINTER 00060I******************************************************************** 00070IPMMST2 PM 01 674NCD 00080I 1 100PMPN 00090I 31 59 PMDESC 00091I 94 94 PMSC1 00100I P 315 3180PMFRCB 60 00110I P 425 4287PMRATO 61 00120I 19 30 PMMODL 00130I P 311 3140PMOHB 62 00140I P 489 4933PMOSUC 00150I GG 02 00160C******************************************************************** 00161C 01 PMSC1 COMP 'P' 01 00170C 01 62N60 00180CANN61 PMOHB MULT PMOSUC EXTCST 102 00190O******************************************************************** 00200OPRINT H 201 1P 00210O OR OF 00220O UDATE Y 8 00230O 67 'NON-FORECAST' ÐÐ00240O 75 'ON-HAND' 00250O*------------------------------------------------------------------- 00260O H 2 1P 00261O OR OF 00270O 4 'PART' 00280O 115 'ON-HAND' 00290O 90 'VALUE' 00300O*------------------------------------------------------------------- 00310O D 1 01 62N60 00320O AND N61 00330O PMPN 12 ' - - ' 00340O PMDESC 45 00350O PMMODL 60 00360O PMOSUC2 75 00370O EXTCST2 90 00380O PMOHB 2 115 /* 00390_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dW d*X044PM PÖ120282120282(èÈÐ00010H Q0001000020F* LIST MFG PARTS WITH NO HRS - FAB SEQ. (X044PM) 0002000030F* REVISED 9-23-82 2:30 PM. 0003000040F* NOTE: MUST BE RUN WITH JOB STREAM - Z044PM. 0004000050FPMMST2 IP F 674R I DISK 0005000060FPMADRT IR F 3 3IT EDISK 0006000070FPRINT O F 132 OF PRINTER 0007000080E******************************************************************** 0008000090E PMADRT PMMST2 0009000100E MHR 12 7 3A 0010000110I******************************************************************** 0011000120IPMMST2 PM 01 674NCD 0012000130I 1 100PMPN 0013000140I 31 59 PMDESC 0014000150I 94 95 PMSC 0015000160I 94 94 PMSC1 0016000170I 487 488 PMFAB L1 0017000180I P 543 590 MHR 0018000190I*------------------------------------------------------------------- 0019000200I GG 02 0020000210C******************************************************************** 0021000220C 01 PMSC1 COMP 'M' 55 0022000230C 01N55 PMSC COMP 'RA' 55 0023000240C 01N55 SETOF 01 0024000250C 01 XFOOTMHR W9D3 93 54 00250ÐÐ00260O******************************************************************** 0026000270OPRINT H 201 1P 0027000280O OR OF 0028000290O UDATE Y 8 0029000300O 67 'MANUFACTURED PARTS WITH ' 0030000310O 77 'NO STD HRS' 0031000320O 121 'MP440R' 0032000330O 127 'PAGE' 0033000340O PAGE Z 132 0034000350O*------------------------------------------------------------------- 0035000360O H 2 1P 0036000370O OR OF 0037000380O 8 'PART-NO.' 0038000390O 25 'DESCRIPTION' 0039000400O 50 'SOURCE' 0040000410O*------------------------------------------------------------------- 0041000420O D 01N54 0042000430O PMPN 12 ' - - ' 0043000440O PMDESC 43 0044000450O PMSC 48 0045000460O PMFAB 54 00460/* 00470_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(x‚ xHX003KP P120282120282(èÈÐ00010H Q003KP00020F* DATA ENTRY UTILITY. (X003KP) 00030F* REVISED 10/07/82 3:00 PM. DG-REL006 OK. 00040FBITHEX IP F 256 DISK 00050FCRTFILE IC F 256R DISK 00060FKPMAST ID F 64L10AI 1 DISK 00070FKPDEPT ID F 13L12AI 1 DISK 00080FKPNAME UC F 352R 6AI 1 DISK 00090FKPCONT UC F 48R10AI 1 DISK A 00100FKPDATA UC F 192R14AI 1 DISK A 00110FKPTABLE ID F 23L22AI 1 DISK 00120FMGFILE IC F 80R DISK 00130FTERM132 O F 132 5 00140E******************************************************************** 00150E JOB 1 30 6 FRM 1 JOB # 00160E KPS 1 30 1 SPEC INSTR 00170E KPN 1 30 12 NAME 00180E KPT 1 30 1 TYPE 00190E KPE 1 30 1 EDIT 00200E KPD 1 30 1 0 DEC PLACES 00210E COL 1 30 3 0A COLUMN 00220E SIZ 1 30 3 0 SIZE 00230E KPB 1 30 1 0A BATCH TOT # 00240E A15 15 15 1 A 00250E A6 6 6 1 A ÐÐ00260E A132 1 132 1 A 00270E ERR 1 5 5 0 00280E OPT 30 30 1 00290E POS 1 132 1 00300E KTN 1 30 18 TABLE NAMES 00310E KTO 1 30 3 A TABLE OPER 00320E SAV 1 132 1 00330E KPL 3 6 TABLE NAMES 00340E KPO 3 1 A OPERATORS 00350E BIT 256 1 00360E KCB 5 11 3 BAT TOTALS 00370I******************************************************************** 00380IBITHEX BT 00390I 1 256 BIT 00400I******************************************************************** 00410IMGFILE MG 00420I 1 35 MGTEXT 00430I******************************************************************** 00440IKPDATA KE 00450I* KEY PUNCH DATA RECORD. 00460I* NOTE: SPACE ALLOWED EA FIELD MUST BE EDITED SIZE. 00470I 22 153 RECORD 00480I 192 192 KESTAT 00490I******************************************************************** 00500IKPTABLE KT ÐÐ00510I 1 6 KTNAME 00520I 7 21 KTVAL 00530I 23 23 KTSTAT 00540I**************************************************************** 00550IKPCONT KC 00560I* JOB # 6A 00570I 1 6 KCJOB 00580I* BATCH # 3N 00590I 8 100KCBAT 00600I* BATCH TOTALS 11.3P X 5 00610I P 11 40 KCB 00620I* RECORD COUNT 5P 00630I P 41 430KCREC 00640I* DEPT# 5P 00650I P 45 470KCDEPT 00660I* RECORD STATUS 1A 00670I 48 48 KCSTAT 00680I************************************************************** 00690ICRTFILE CR 00700I 1 50CREMPL 00710I 14 180CRDEPT 00720I 68 73 CRRET 00730I 74 79 CRMENU 00740I******************************************************************** 00750IKPMAST KP ÐÐ00760I* KEYPUNCH MASTER. 00770I* KEY AREA. 00780I* JOB # 6A 00790I 1 6 KPJOB 00800I* FORMAT CODE 1A 00810I 7 7 KPFRMT 00820I* SEQ NO. 3N 00830I 8 100KPSEQ 00840I* FIELD TYPE 1A 00850I* A = ALPHA N = NUMERIC 00860I 11 11 KPTYPE 00870I* START COLUMN 3P 00880I P 12 130KPCOL 00890I* FIELD SIZE 3P 00900I P 14 150KPSIZE 00910I* SPEC INSTR. 1A 00920I* D = DUP S = SKIP 00930I 16 16 KPSPEC 00940I* EDIT CODE 1A 00950I* (Z,2,K,Y) 00960I 17 17 KPEDIT 00970I* DECIMAL PLACES 1N 00980I 18 180KPDEC 00990I* SUB-TOTAL FIELD # 1N 01000I 19 190KPTOT ÐÐ01010I* FIELD NAME 12A 01020I 20 31 KPNAME 01030I* OPTION CODE 1A 01040I* M = MANDATORY 01050I 32 32 KPOPTN 01060I* TABLE AREA. 01070I* TABLE NAMES 6A X 3 01080I 33 50 KPL 01090I* OPERATORS 1A X 3 (>,<,=) 01100I 51 53 KPO 01110I* RECORD STATUS 1A 01120I 64 64 KPSTAT 01130I******************************************************************** 01140IKPDEPT KD 01150I* KEYPUNCH DEPT MENU RECORD. 01160I* KEY AREA. 01170I* DEPT # 5N 01180I 1 50KDDEPT 01190I* JOB # 6A 01200I 6 11 KDJOB 01210I* FORMAT CODE 1A 01220I 12 12 KDFRMT 01230I* RECORD STATUS 1A 01240I 13 13 KDSTAT 01250I******************************************************************** ÐÐ01260IKPNAME KN 01270I* KEYPUNCH JOB MASTER. 01280I* JOB # 6A 01290I 1 6 KNJOB 01300I* TITLE 60A 01310I 7 66 KNTITL 01320I* HEADING-LINE 1 132A 01330I 67 198 KNHL1 01340I* HEADING-LINE 2 132A 01350I 199 330 KNHL2 01360I* LAST BATCH NO. 5P 01370I P 331 3330KNLBAT 01380I* FORMAT CODE 1A (H,V) 01390I 334 334 KNFRMT 01400I* LINK-TO PROG NAME 8A 01410I 335 342 KNLINK 01420I* RECORD STATUS 1A 01430I 352 352 KNSTAT 01440C******************************************************************** 01450C START TAG 01460C* INITIALIZE. 01470C EXSR SR210 SETOFFS 01480C EXSR SR101 INIT. 01490C* DISPLAY K.P. MENU. 01500C EXSR SR102 DISPLAY KP MENU ÐÐ01510C*------------------------------------------------------------------- 01520C TAG10 TAG 01530C* REQUEST SELECTION. GET MASTER. 01540C EXSR SR210 SETOFFS 01550C EXSR SR103 RQST SELECT. 01560C 92 GOTO START BKWD ESC 01570C 98 GOTO GOODBY SIGN-OFF. 01580C 94 GOTO MENU BACK TO ITOS 01590C 93 GOTO NEWITM NEW ITEM. 01600C N77 GOTO TAG10 NO INPUT DATA 01610C*------------------------------------------------------------------- 01620C TAG20 TAG 01630C* DISPLAY K.P. LAYOUT. LOAD ARRAYS. 01640C EXSR SR68 CLEAR SCREEN 01650C EXSR SR210 SETOFFS 01660C EXSR SR104 PUT LAYOUT. 01670C* REQUEST SPECIAL INSTRUCTIONS (DUP,SKIP). 01680C EXSR SR111 RQST SPEC INSTR 01690C 92 GOTO TAG20 01700C 98 GOTO GOODBY SIGN-OFF 01710C 94 GOTO MENU MENU 01720C 93 GOTO TAG20 NEW ITEM 01730C*------------------------------------------------------------------- 01740C TAG40 TAG 01750C* REQUEST BATCH #. ÐÐ01760C EXSR SR210 01770C EXSR SR106 01780C 92 GOTO TAG20 01790C 98 GOTO GOODBY 01800C 94 GOTO MENU 01810C 93 GOTO NEWITM 01820C* CLEAR SCREEN. PUT HEADINGS. 01830C EXSR SR68 CLEAR SCREEN 01840C SETON 65 01850C EXSR SR107 PUT HEADING 01860C SETOF 65 01870C MOVE BLK132 LAST 132 INIT LAST LINE 01880C*------------------------------------------------------------------- 01890C TAG50 TAG 01900C* REQUEST RECORD #. 01910C EXSR SR210 SETOFFS 01920C EXSR SR109 RQST REC # 01930C 92 GOTO TAG40 01940C 98 GOTO GOODBY 01950C 94 GOTO MENU 01960C 93 GOTO NEWITM 01970C RECNO SUB 1 RECNO 50 01980C SETOF 38 01990C*------------------------------------------------------------------- 02000C TAG60 TAG ÐÐ02010C* ACCEPT INPUT. 02020C EXSR SR210 SETOFFS 02030C EXSR SR108 INPUT DATA 02040C 98 GOTO GOODBY SIGN-OFF 02050C 94 GOTO START MENU 02060C 93 GOTO TAG50 DISPLAY LAYOUT 02070C SETON 38 02080C GOTO TAG60 02090C*------------------------------------------------------------------- 02100C GOODBY TAG 02110C MOVEL'GOODBY' CRRET 02120C GOTO END 02130C*------------------------------------------------------------------- 02140C NEWITM TAG 02150C MOVEL'Q003KP' CRRET 02160C GOTO END 02170C*------------------------------------------------------------------- 02180C MENU TAG 02190C MOVELCRMENU CRRET 02200C GOTO END 02210C*------------------------------------------------------------------- 02220C END TAG 02230C 83 EXSR SR82 02240C SETOF 54 02250C MOVELKNLINK PROG 8 ÐÐ02260C 20 PROG COMP BLK8 54 02270C N54 MOVELCRRET PROG 02280C EXITFCHAIN 02290C RLABL PROG 02300C******************************************************************** 02310CSR SR68 BEGSR 02320C* CLEAR SCREEN. 02330CSR EXITFQTOPF CLEAR SCREEN. 02340CSR ENDSR 02350C*************************************************************** 02360CSR SR70 BEGSR 02370C* REWRITE INPUT LINE 02380CSR SETON 32 02390CSR EXCPT PUT TITLE LINE 02400CSR SETOF 32 02410CSR MOVELLINENO W6A 02420CSR MOVE '001' W6A 02430CSR EXITFQXYPOS POSITION CURSOR 02440CSR RLABL W6A 02450CSR EXITFQMOVUP 02460CSR SETON 70 02470CSR EXCPT 02480CSR SETOF 70 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR73 BEGSR 02520C* PUT MSG. 02530CSR M CHAINMGFILE 54 02540CSR SETON 73 02550CSR EXCPT 02560CSR SETOF 73 02570CSR 96 Z-ADDM LSTERR 50 02580CSR ENDSR 02590C******************************************************************* 02600CSR SR75 BEGSR 02610C* READ 6-BYTES FROM TERMINAL. 02620CSR EXSR SR210 02630CSR MOVE BIT,4 BUFLGT 02640CSR MOVE BLK6 W6A 6 02650CSR MOVE BIT,28 A15,1 02660CSR MOVE '8' A15,2 02670CSR MOVEA'002045' A15,3 02680CSR MOVE BIT,8 A15,9 02690CSR MOVEAA15,1 W9A 9 02700CSR EXITFQPREED READ. 02710CSR RLABL W9A XY-POS 02720CSR RLABL W6A BUFFER 02730CSR RLABL BUFLGT BUF LGTH 02740CSR MOVEAW6A A6 02750CSR MOVE BLK6 W6A ÐÐ02760CSR Z-ADD1 W 30 02770CSR '\' LOKUPA6,W 90 02780CSRN90 GOTO T75B NOT ESC 02790CSR 1 ADD W W 02800CSR W COMP 6 54 02810CSR 54 GOTO T75A 02820CSR A6,W COMP 'G' 98 02830CSR A6,W COMP 'E' 94 02840CSR A6,W COMP 'N' 93 02850CSR A6,W COMP 'B' 92 02860C* 02870C* 02880CSR GOTO END75 02890C*------------------------------------------------------------------- 02900CSR T75A TAG 02910C* FLAG BAD ESC. 02920CSR Z-ADD318 M 50 96 FLAG ERROR. 02930CSR EXSR SR73 PUT MSG 02940CSR GOTO SR75 02950C*------------------------------------------------------------------- 02960CSR T75B TAG 02970C* MOVE DATA. 02980CSR Z-ADD1 W 02990CSR ' ' LOKUPA6,W 77 03000CSR 77 MOVEAA6 W6A ÐÐ03010CSR EXSR SR76 CLEAR MSG 03020CSR END75 ENDSR 03030C******************************************************************** 03040CSR SR76 BEGSR 03050C* CLEAR MSG. 03060CSR LSTERR COMP 0 54 03070CSR 54 Z-ADD0 LSTERR 03080CSR 54 MOVE BLK132 MGTEXT 03090CSR 54 SETON 73 03100CSR 54 EXCPT BLK MSG 03110CSR SETOF 73 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR82 BEGSR 03150C* UPDATE KPCONT. 03160CSR SETON 82 03170CSR EXCPT UPDATE KPCONE 03180CSR SETOF 8283 03190CSR ENDSR 03200C******************************************************************** 03210CSR SR101 BEGSR 03220C* INITIALIZE. 03230CSR MOVELBIT,1 BUFLGT 2 03240CSR EXSR SR68 CLEAR SCREEN 03250CSR MOVE ' ' BLK18 18 ÐÐ03260CSR MOVE ' ' BLK132132 03270CSR MOVE ' ' BLK6 6 03280CSR MOVE ' ' BLK7 7 03290CSR MOVE ' ' BLK8 8 03300CSR MOVE ' ' BLK15 15 03310CSR MOVE ' ' W8A 8 03320CSR MOVE ' ' W2A 2 03330CSR Z-ADD0 W1N 10 03340CSR Z-ADD0 W2N 20 03350CSR EXITFPGMINX GET PORT# 03360CSR RLABL W8A 03370CSR RLABL W2N 03380CSR RLABL W1N 03390CSR RLABL W2A 03400CSR MOVE W2A PORT 20 03410CSR PORT COMP 0 54 03420CSRN54 Z-ADD25 PORT 03430CSR PORT CHAINCRTFILE H9 03440CSR MOVELUDATE W4N 40 03450CSR MOVE UDATE W2N 03460CSR MOVELW2N TODAY 60 03470CSR MOVE W4N TODAY 03480CSR END101 ENDSR 03490C******************************************************************** 03500CSR SR102 BEGSR ÐÐ03510C* PUT DEPT MENU. 03520CSR MOVE BLK7 JOB 03530CSR Z-ADD0 J 30 03540CSR SETON 71 03550CSR EXCPT PUT HEADING 03560CSR SETOF 71 03570CSR MOVELCRDEPT W11A 11 03580CSR MOVE BLK6 W11A 03590CSR MOVELW11A W12A 12 03600CSR W12A SETLLKPDEPT 03610C*------------------------------------------------------------------- 03620CSR T102A TAG 03630CSR SETOF 54 03640CSR READ KPDEPT 54 03650CSR 54 GOTO END102 END OF FILE. 03660CSR KDDEPT COMP CRDEPT 54 03670CSRN54 GOTO END102 DONE. 03680CSR KDSTAT COMP 'D' 54 03690CSR 54 GOTO T102A DELETED. 03700CSR 1 ADD J J 03710CSR MOVE KDJOB JOB,J SAVE JOB. 03720CSR MOVE KDFRMT FRM,J AND FORMAT. 03730CSR KDJOB CHAINKPNAME H8 03740CSR H8 GOTO END102 PROG ERROR 03750CSR SETON 72 ÐÐ03760CSR EXCPT PUT MENU 03770CSR SETOF 72 03780CSR GOTO T102A 03790CSR END102 ENDSR 03800C******************************************************************** 03810CSR SR103 BEGSR 03820C* REQUEST SELECTION. 03830C*------------------------------------------------------------------- 03840CSR T103A TAG 03850CSR SETON 74 03860CSR EXCPT RQST MSG. 03870CSR SETOF 74 03880CSR EXSR SR75 READ. 03890CSRN77 GOTO END103 NO DATA OR ESC. 03900CSR EXSR SR202 R. JUSTIFY. 03910CSR MOVE W6A W3N 30 03920CSR W3N COMP 0 54 03930CSR 54 W3N COMP J 5454 03940CSRN54 SETON 75 03950CSRN54 EXCPT PUT ERR MSG 03960CSRN54 SETOF 75 03970CSRN54 GOTO T103A 03980CSR Z-ADDW3N J 03990CSR MOVE JOB,J JOBNO 6 04000CSR MOVE FRM,J FORMAT 1 ÐÐ04010CSR END103 ENDSR 04020C******************************************************************** 04030CSR SR104 BEGSR 04040C* DISPLAY K.P. LAYOUT. 04050CSR EXSR SR201 INIT AR'S. 04060CSR SETON 76 04070CSR EXCPT PUT HEADING 04080CSR SETOF 76 04090CSR MOVE ' ' POS 04100CSR MOVELJOBNO W7AA 7 04110CSR MOVE FORMAT W7AA 04120CSR MOVELW7AA W10A 10 04130CSR MOVE '000' W10A 04140CSR W10A SETLLKPMAST 04150CSR Z-ADD0 P 30 04160C*------------------------------------------------------------------- 04170CSR T104A TAG 04180CSR SETOF 54 04190CSR READ KPMAST 54 GET KPMAST 04200CSR 54 GOTO END104 END FILE. 04210CSR MOVELKPJOB W7A 7 04220CSR MOVE KPFRMT W7A 04230CSR W7A COMP W7AA 54 04240CSRN54 GOTO END104 WRONG JOB. 04250CSR KPSTAT COMP 'D' 54 ÐÐ04260CSR 54 GOTO T104A DELETED. 04270CSR 1 ADD P P 04280CSR MOVE KPSPEC KPS,P SPEC INSTR 04290CSR MOVE KPNAME KPN,P FIELD NAME 04300CSR MOVE KPTYPE KPT,P FIELD TYPE 04310CSR MOVE KPEDIT KPE,P EDIT CODE 04320CSR MOVE KPDEC KPD,P DEC PLACES 04330CSR MOVE KPCOL COL,P START COL 04340CSR MOVE KPSIZE SIZ,P FIELD SIZE 04350CSR MOVE KPTOT KPB,P SUB-TOT # 04360CSR MOVE KPOPTN OPT,P OPTION CODE 04370CSR MOVEAKPL KTN,P TAB NAME 04380CSR MOVEAKPO KTO,P TAB OP 04390CSR KTN,P COMP BLK18 54 04400CSRN54 OPT,P COMP 'M' 54 04410CSR KPS,P COMP 'S' 55 04420CSR 54 55 MOVE ' ' KPS,P 04430CSR MOVE ' ' W3A 3 04440CSR Z-ADDCOL,P X 30 04450CSR P COMP 9 54 04460CSR P COMP 99 55 04470CSR Z-ADD1 W2N 04480CSR 54 Z-ADD2 W2N 04490CSR 55 Z-ADD3 W2N 04500CSR MOVE 'Z' W1A ÐÐ04510CSR EXIT SUBRED 04520CSR RLABL P 04530CSR RLABL W1A 04540CSR RLABL W3A 04550CSR RLABL W2N 04560CSR MOVEAW3A POS,X 04570CSR OPT,P COMP 'D' 54 04580CSR OPT,P COMP 'S' 55 04590CSR OPT,P COMP 'B' 56 04600CSR SETON 78 04610CSR EXCPT PUT FIELD DATA 04620CSR SETOF 78 04630CSR GOTO T104A 04640CSR END104 ENDSR 04650C******************************************************************** 04660CSR SR105 BEGSR 04670C* REQUEST SPECIAL INSTRUCT. 04680C*------------------------------------------------------------------- 04690CSR T105A TAG 04700CSR SETON 35 04710CSR EXCPT PUT REQUEST 04720CSR SETOF 35 04730CSR EXSR SR75 READ. 04740CSRN77 GOTO END105 04750CSR MOVEAW6A A6 ÐÐ04760CSR Z-ADD1 X 30 04770CSR ',' LOKUPA6,X 54 04780CSRN54 GOTO T105T ERROR. 04790CSR MOVEAA6,X W2A 2 04800CSR MOVE W2A W1A 1 04810CSR MOVEABLK6 A6,X 04820CSR MOVE BLK6 W4A 4 04830CSR MOVEAA6,1 W4A 04840CSR MOVE BLK6 W6A 6 04850CSR MOVE W4A W6A 04860CSR EXSR SR202 R. JUSTIFY 04870CSR MOVE W6A P 04880CSR P COMP 0 54 04890CSR 54 P COMP 30 5454 04900CSRN54 GOTO T105T ERROR 04910CSR 22 MOVE W1A OPT,P 04920CSR 21 MOVE W1A KPS,P SPEC INSTR 04930CSR P ADD 5 W3N 04940CSR MOVELW3N W6A 04950CSR MOVE '029' W6A 04960CSR EXITFQXYPOS POSITION CURSOR 04970CSR RLABL W6A 04980CSR MOVE BIT,3 BUFLGT 04990CSR MOVELKPS,P W2A 2 05000CSR MOVE ' ' W2A ÐÐ05010CSR MOVELW2A W4A 4 05020CSR MOVELOPT,P W2A 05030CSR MOVE ' ' W2A 05040CSR MOVE W2A W4A 05050CSR EXITFQWRITE PUT SPEC INSTR 05060CSR RLABL W4A 05070CSR RLABL BUFLGT 05080CSR GOTO T105A 05090C*------------------------------------------------------------------- 05100CSR T105T TAG 05110C* FLAG ERROR. 05120CSR SETON 75 05130CSR EXCPT 05140CSR SETOF 75 05150CSR GOTO T105A 05160C*------------------------------------------------------------------- 05170CSR END105 TAG 05180CSR SETOF 2122 05190CSR ENDSR 05200C******************************************************************** 05210CSR SR106 BEGSR 05220C* REQUEST BATCH #. 05230CSR 83 EXSR SR82 UPDATE KPCONT 05240CSR SETON 36 05250CSR EXCPT RQST BATCH # ÐÐ05260CSR SETOF 36 05270CSR EXSR SR75 READ 05280CSR 90 GOTO END106 ESC 05290CSR JOBNO CHAINKPNAME H7 05300CSR H7 GOTO END106 05310CSR 77 EXSR SR202 R. JUSTIFY 05320CSR 77 MOVE W6A BATCH 30 05330CSR 77 BATCH COMP 0 54 05340CSR 77N54 SETOF 77 05350CSRN77 1 ADD KNLBAT BATCH 05360CSR BATCH COMP KNLBAT 54 05370CSR 54 Z-ADDBATCH KNLBAT 05380CSR 83 EXSR SR82 UPDATE KPCONT 05390CSR MOVELKNJOB KEYKC 10 05400CSR MOVE BATCH KEYKC 05410CSR KEYKC CHAINKPCONT 60 05420CSR 60 Z-ADD0 KCREC 05430CSR SETON 81 05440CSR EXCPT UPDATE BATCH # 05450CSR SETOF 81 05460CSR KEYKC CHAINKPCONT 54 05470CSRN54 SETON 83 05480CSR END106 ENDSR 05490C******************************************************************** 05500CSR SR107 BEGSR ÐÐ05510C* CLEAR SCREEN. PUT INPUT HEADINGS. 05520CSR SETON 33 05530CSR EXCPT PUT HEADING 05540CSR SETOF 33 05550CSR Z-ADD6 LINENO 30 05560CSR ENDSR 05570C******************************************************************** 05580CSR SR108 BEGSR 05590C* ACCEPT INPUT DATA. 05600CSR MOVE BLK132 WORK 132 05610CSR 50 1 ADD RECNO RECNO 05620CSR 50 Z-ADDRECNO NXTREC 05630CSRN50 1 ADD KCREC NXTREC 50 NEXT RECORD # 05640CSR MOVELKNJOB W14A 14 05650CSR MOVELBATCH W8A 05660CSR MOVE NXTREC W8A 05670CSR MOVE W8A W14A 05680CSR W14A CHAINKPDATA 79 05690CSRN79 KESTAT COMP 'D' 54 05700CSR 79 05710CORN79 54 MOVE BLK132 RECORD 05720CSR 79 05730CORN79 54 MOVE ' ' KESTAT 05740CSR 79 05750CORN79 54 Z-ADD0 ERR ÐÐ05760CSRN79N54 EXSR SR110 MOVE/EDIT DATA 05770CSR Z-ADD0 P 30 05780C*------------------------------------------------------------------- 05790CSR T108A TAG 05800C* GET NEXT FIELD 05810CSR MOVELBIT,1 ITC 2 05820CSR MOVE BIT,3 ITC 05830CSR EXSR SR210 ESC SET-OFFS 05840CSR P COMP 0 54 05850CSRN54 Z-ADD0 P 05860CSR 1 ADD P P 05870CSR P COMP 30 54 05880CSR 54 GOTO T108B DONE 05890CSR COL,P COMP 0 54 05900CSRN54 GOTO T108B DONE 05910C* PROCESS SKIP/DUP FIELDS. 05920CSR MOVE BLK132 W132A 132 05930CSRN38 EXSR SR70 DISPLAY DATA 05940CSRN38 GOTO T108A1 1ST RECORD 05950CSR KPS,P COMP 'S' 54 05960CSR 54 GOTO T108A SKIP FIELD 05970CSR KPS,P COMP 'D' 56 DUP FIELD 05980CSRN56 KPS,P COMP 'B' 56 SKIP & DUP 05990CSRN56 EXSR SR70 DISPLAY 06000CSRN56 GOTO T108A1 NOT DUP FIELD ÐÐ06010CSR EXSR SR208 DUP DATA 06020CSR EXSR SR211 MOVE DATA 06030CSR EXSR SR207 EDIT 06040CSR EXSR SR70 DISPLAY 06050CSR KPS,P COMP 'B' 54 06060CSR 54 GOTO T108A2 DUP & SKIP 06070C*------------------------------------------------------------------- 06080CSR T108A1 TAG 06090C* READ TERMINAL. 06100CSR EXSR SR203 CHK FOR DUP FIELD 06110CSR 54 MOVEAW132A SAV SAVE DUPED DATA 06120CSR 54 MOVE BLK132 W132A 06130CSR MOVELLINENO W6A 6 06140CSR 1 ADD COL,P W3N 30 06150CSR MOVE W3N W6A 06160CSR 1 ADD SIZ,P X 30 BUF LGTH 06170CSR KPE,P COMP 'K' 54 06180CSR 54 1 ADD X X 06190CSR X COMP 5 54 54 06200CSRN54 Z-ADD5 X MIN BUF SIZE 06210CSR MOVE BIT,X BUFLGT 2 BUFFER LENGTH 06220CSR EXITFQR132P READ,POS CURSOR 06230CSR RLABL W6A XY-POS 06240CSR RLABL W132A BUFFER 06250CSR RLABL BUFLGT BUF LGTH ÐÐ06260CSR RLABL ITC RET CODE 06270CSR EXSR SR76 BLANK MSG 06280C*------------------------------------------------------------------- 06290CSR T108A2 TAG 06300C* SAVE DUP OR INPUT DATA. 06310CSR MOVEAW132A A132 06320CSR MOVE BLK132 W132A 06330CSR Z-ADD1 W 30 06340CSR '\' LOKUPA132,W 90 CHECK FOR ESC 06350CSR 90 EXSR SR70 PUT DATA LINE 06360CSR 90 GOTO T108C ESC INPUT 06370CSR Z-ADD1 W 06380CSR ' ' LOKUPA132,W 77 06390CSRN77 EXSR SR203 CHECK FOR DUP FIELD 06400CSRN77 54 MOVEASAV A132 06410CSRN77 54 SETON 77 06420CSR OPT,P COMP 'M' 54 06430CSR 54N77 GOTO T108A1 NO MANDATORY INPUT 06440CSR EXSR SR205 CHK RETURN CODE 06450CSR 55N77 GOTO T108B LINE FEED 06460CSRN77 GOTO T108A CAR RETURN 06470CSR MOVEAA132,W W132A 06480C*------------------------------------------------------------------- 06490CSR T108A3 TAG 06500CSR EXSR SR210 ESC SET-OFFS ÐÐ06510C* SAVE INPUT DATA - EDIT & PUT TO SCREEN. 06520CSR EXSR SR211 MOVE DATA 06530CSR EXSR SR207 EDIT 06540CSR EXSR SR70 REWRITE SCREEN 06550CSR EXSR SR205 FLAG RET CODE 06560CSR 54 GOTO T108A CAR RET. 06570C*------------------------------------------------------------------- 06580CSR T108B TAG 06590C* CHECK MANDATORY/TABLE FIELDS 06600CSR EXSR SR210 SETOFFS 06610CSR EXSR SR212 VERIFY DATA 06620CSR 96 X SUB 1 P 06630CSR 96 GOTO T108A 06640C*------------------------------------------------------------------- 06650CSR T108BA TAG 06660C* OUTPUT DATA RECORD TO KPDATA FILE 06670CSR 1 ADD LINENO LINENO 30 SCREEN LINE 06680CSR NXTREC COMP KCREC 54 06690CSR 54 Z-ADDNXTREC KCREC 06700CSR SETON 8020 06710CSR EXCPT OUTPUT KPDATA 06720CSR SETOF 80 06730CSR EXSR SR213 CUM BAT TOT 06740CSR Z-ADD0 P 06750CSR MOVE RECORD LAST 132 ÐÐ06760CSR MOVE BLK132 RECORD 06770CSR MOVE BLK132 WORK 132 06780CSR LINENO COMP 29 54 54 06790CSR 54 EXSR SR107 PUT HEADINGS 06800CSR GOTO END108 DONE 06810C*------------------------------------------------------------------- 06820CSR T108C TAG 06830C* ESCAPE ROUTINE. 06840CSR SETOF 88 06850CSR 1 ADD W W 06860CSR W COMP 132 54 06870CSR 54 GOTO T108T ERROR 06880CSR A132,W COMP 'B' 92 SKIP BKWD 06890CSR A132,W COMP 'G' 98 SIGN-OFF 06900CSR A132,W COMP 'N' 93 NEW ITEM 06910CSR A132,W COMP 'E' 94 MENU 06920CSR A132,W COMP 'S' 89 SPACE FILL 06930CSR A132,W COMP 'J' 91 JUMP 06940CSR A132,W COMP 'U' 95 UPDATE 06950CSR A132,W COMP 'D' 99 DELETE 06960CSR 89 SETON 88 06970CSR 99 MOVE 'D' KESTAT 06980CSR 99 GOTO T108BA 06990CSR 95 GOTO T108B UPDATE 07000CSRN92 GOTO T108E NOT BKWD TAB ÐÐ07010CSR P SUB 2 P 54 07020CSRN54 Z-ADD0 P 07030CSR GOTO T108A 07040C*------------------------------------------------------------------- 07050CSR T108E TAG 07060CSR 89 GOTO T108A3 SPACE FILL 07070CSR 91 GOTO T108G JUMP 07080CSRN98N94N93 GOTO T108T ERROR 07090CSR GOTO END108 07100C*------------------------------------------------------------------- 07110CSR T108G TAG 07120C* JUMP ROUTINE. 07130CSR 1 ADD W W 07140CSR W COMP 132 54 07150CSR 54 GOTO T108T ERROR 07160CSR MOVE ' ' W3A 3 07170CSR MOVEAA132,W W3A 07180CSR EXSR SR216 MOVE BLK15->W15A 07190CSR MOVE W3A W15A 07200CSR EXSR SR215 R.ADJUST 07210CSR MOVE W15A P 07220CSR P SUB 1 P 07230CSR GOTO T108A 07240C*------------------------------------------------------------------- 07250CSR T108T TAG ÐÐ07260C* FLAG ESCAPE CODE ERROR. 07270CSR Z-ADD318 M 96 07280CSR EXSR SR73 PUT MSG 07290CSR P SUB 1 P 07300CSR GOTO T108A 07310CSR END108 ENDSR 07320C******************************************************************** 07330CSR SR109 BEGSR 07340C* REQUEST RECORD #. 07350CSR Z-ADD0 RECNO 07360CSR SETON 37 07370CSR EXCPT PROMPT 07380CSR SETOF 3750 07390CSR EXSR SR75 READ 07400CSR 90 GOTO END109 07410CSR EXSR SR202 R. ADJUST 07420CSR MOVE W6A RECNO 50 07430CSR RECNO COMP 0 50 07440CSR END109 ENDSR 07450C************************************************************* 07460CSR SR110 BEGSR 07470C* MOVE RECORD TO WORK 07480CSR Z-ADD1 P 07490CSR SETON 39 07500C*------------------------------------------------------------ ÐÐ07510CSR T110A TAG 07520CSR 000 LOKUPCOL,P 54 07530CSRN54 GOTO END110 07540CSR EXSR SR207 EDIT/MOVE 07550CSR 1 ADD P P 07560CSR P COMP 30 54 07570CSRN54 GOTO T110A 07580C*----------------------------------------------------------- 07590CSR END110 TAG 07600CSR SETOF 39 07610CSR ENDSR 07620C******************************************************************** 07630CSR SR111 BEGSR 07640C* REQUEST SPEC INSTR. 07650CSR SETON 21 07660CSR EXSR SR105 07670CSR 90 GOTO END111 07680C* REQUEST OPTION. 07690CSR SETON 22 07700CSR EXSR SR105 07710CSR 92 GOTO SR111 07720CSR END111 ENDSR 07730C******************************************************************** 07740CSR SR201 BEGSR 07750C* INIT KP LAYOUT ARRAYS. ÐÐ07760CSR MOVE ' ' KPS SPEC INSTR 07770CSR MOVE BLK15 KPN FIELD NAME 07780CSR MOVE ' ' KPT TYPE 07790CSR MOVE ' ' KPE EDIT CODES 07800CSR Z-ADD0 KPD DEC PLACES 07810CSR Z-ADD0 COL START COL 07820CSR Z-ADD0 SIZ FIELD SIZE 07830CSR Z-ADD0 KPB BATCH TOTALS 07840CSR MOVE ' ' OPT OPTION CODES 07850CSR MOVE BLK18 KTN TABLE NAMES 07860CSR MOVE ' ' KTO TABLE OPERATORS 07870CSR MOVE ' ' KPL TABLE NAMES-FILE 07880CSR MOVE ' ' KPO TABLE OPER-FILE 07890CSR ENDSR 07900C******************************************************************** 07910CSR SR202 BEGSR 07920C* R. JUSTIFY 6-BYTES. 07930CSR EXSR SR216 MOVE BLK15->W15A 07940CSR MOVE W6A W15A 07950CSR EXSR SR215 R.ADJUST 07960CSR MOVE W15A W6A 6 07970CSR ENDSR 07980C************************************************************** 07990CSR SR203 BEGSR 08000C* CHECK FOR DUP FIELD INSTR ÐÐ08010CSR KPS,P COMP 'D' 54 08020CSRN54 KPS,P COMP 'B' 54 08030CSR ENDSR 08040C******************************************************************** 08050CSR SR205 BEGSR 08060C* CLASSIFY RETURN CODE. 08070CSR MOVE ITC W1A RETURN CODE 08080CSR W1A COMP BIT,3 54 CAR RET 08090CSR W1A COMP BIT,4 55 LINE FEED 08100CSR ENDSR 08110C******************************************************************** 08120CSR SR207 BEGSR 08130C* EDIT INPUT FIELD - SET-UP WORK FIELD FOR SCREEN OUTPUT 08140C* BRANCH IF ALPHA FIELD. 08150CSR KPT,P COMP 'A' 54 08160CSR 54 GOTO T207H ALPHA FIELD 08170C* INIT NUMERIC WORK FIELDS 08180CSR Z-ADD0 W11N 110 08190CSR Z-ADD0 W11D1 08200CSR Z-ADD0 W11D2 08210CSR Z-ADD0 W11D3 08220C* MOVE INPUT DATA(N39) OR FILE DATA(39) TO WORK FIELD W15A 08230CSRN39 MOVELW132A W15A 15 08240CSR 39 EXSR SR216 MOVE BLK15->W15A 08250CSR 39 Z-ADDCOL,P SS ÐÐ08260CSR 39 Z-ADDSIZ,P N 08270CSR 39 Z-ADD1 TS 08280CSR 39 EXSR SR214 MOV REC TO W15A 08290CSR EXSR SR215 R. JUSTIFY. 08300CSRN39 EXSR SR209 MOV NUM TO RECORD 08310C* BRANCH IF NO EDIT CODE 08320CSR KPE,P COMP ' ' 54 08330CSR 54 GOTO T207H NO EDIT CODE. 08340C* BRANCH IF Y-EDIT CODE 08350CSR KPE,P COMP 'Y' 54 08360CSR 54 GOTO T207J Y-EDIT CODE 08370C* BRANCH ON NUMB OF DEC PLACES 08380C******** KPD,P COMP 0 54 08390CSR KPD,P COMP 1 55 08400CSR KPD,P COMP 2 56 08410CSR KPD,P COMP 3 57 08420CSR 55 MOVE W15A W11D1 111 08430CSR 56 MOVE W15A W11D2 112 08440CSR 57 MOVE W15A W11D3 113 08450CSR MOVE W15A W11N DEFAULT 08460CSR MOVE KPE,P W1A 1 08470CSR EXSR SR216 MOVE BLK15->W15A 08480CSR Z-ADD15 W2N 20 08490CSR 55 GOTO T207C 08500CSR 56 GOTO T207E ÐÐ08510CSR 57 GOTO T207F 08520C* NOTE: DEFAULT FALLS THRU 08530C*------------------------------------------------------------------- 08540CSR T207B TAG 08550CSR EXIT SUBRED 08560CSR RLABL W11N 08570CSR RLABL W1A 08580CSR RLABL W15A 08590CSR RLABL W2N 08600CSR GOTO T207M 08610C*------------------------------------------------------------------- 08620CSR T207C TAG 08630CSR EXIT SUBRED 08640CSR RLABL W11D1 08650CSR RLABL W1A 08660CSR RLABL W15A 08670CSR RLABL W2N 08680CSR GOTO T207M 08690C*------------------------------------------------------------------- 08700CSR T207E TAG 08710CSR EXIT SUBRED 08720CSR RLABL W11D2 08730CSR RLABL W1A 08740CSR RLABL W15A 08750CSR RLABL W2N ÐÐ08760CSR GOTO T207M 08770C*------------------------------------------------------------------- 08780CSR T207F TAG 08790CSR EXIT SUBRED 08800CSR RLABL W11D3 08810CSR RLABL W1A 08820CSR RLABL W15A 08830CSR RLABL W2N 08840CSR GOTO T207M 08850C*------------------------------------------------------------------- 08860CSR T207H TAG 08870C* MOVE NUMERIC (NO EDIT) OR ALPHA FROM RECORD TO WORK. 08880CSR Z-ADDSIZ,P NUMB 08890CSR EXSR SR302 MOVE BLKS TO WORK 08900CSR Z-ADDSIZ,P N 30 08910CSR Z-ADDCOL,P SS 08920CSR Z-ADDCOL,P TS 08930CSR EXIT SUBRMV 08940CSR RLABL RECORD SOURCE 08950CSR RLABL SS SOURCE START 08960CSR RLABL WORK TARGET 08970CSR RLABL TS TARGET START 08980CSR RLABL N NUMB CHAR 08990CSR GOTO END207 09000C*------------------------------------------------------------ ÐÐ09010CSR T207J TAG 09020C* DO Y-EDIT CODE 09030CSR MOVE KPE,P W1A 1 09040CSR MOVE W15A W10N 100 09050CSR Z-ADD10 W2N 09060CSR EXSR SR216 MOVE BLK15->W15A 09070CSR MOVE BLK15 W10A 10 09080CSR EXIT SUBRED EDIT 09090CSR RLABL W10N 09100CSR RLABL W1A EDIT CODE 09110CSR RLABL W10A RESULT 09120CSR RLABL W2N END POSITION 09130CSR MOVE W10A W15A 09140C*------------------------------------------------------------ 09150CSR T207M TAG 09160C* MOVE EDITED NUMERIC TO WORK. 09170C* COMPUTE EDITED SIZE. 09180CSR Z-ADD1 X 30 09190CSR MOVEAW15A A15 09200C*-------------------------------------------------------------- 09210CSR T207P TAG 09220CSR KPE,P COMP 'Y' 55 09230CSR 55 '0' LOKUPA15,X 54 09240CSRN55 '.' LOKUPA15,X 54 54 09250CSRN54N88 GOTO END207 ÐÐ09260CSRN54 Z-ADD1 X 09270CSR Z-ADDX SS 09280CSR 15 SUB X N 09290CSR 1 ADD N N 09300CSR EXSR SR301 COMPUTE TS 09310CSR EXIT SUBRMV MOVE EDIT FIELD 09320CSR RLABL W15A SOURCE 09330CSR RLABL SS SOURCE START 09340CSR RLABL WORK TARGET 09350CSR RLABL TS TARGET START 09360CSR RLABL N NUMB CHAR 09370CSR END207 ENDSR 09380C******************************************************************** 09390CSR SR208 BEGSR 09400C* DUP DATA FROM PREV LINE. 09410CSR Z-ADDCOL,P SS 09420CSR Z-ADDSIZ,P N 09430CSR Z-ADD1 TS 09440CSR EXIT SUBRMV MOVE DATA 09450CSR RLABL LAST SOURCE 09460CSR RLABL SS SOURCE START 09470CSR RLABL W132A TARGET 09480CSR RLABL TS TARGET START 09490CSR RLABL N NUMB CHAR 09500CSR ENDSR ÐÐ09510C************************************************************* 09520CSR SR209 BEGSR 09530C* MOVE NUMERIC TO RECORD 09540CSR Z-ADDCOL,P TS 30 09550CSR 15 SUB SIZ,P SS 30 09560CSR 1 ADD SS SS 09570CSR Z-ADDSIZ,P N 30 09580CSR EXIT SUBRMV MOVE NUMERIC 09590CSR RLABL W15A 15 SOURCE 09600CSR RLABL SS SOURCE START 09610CSR RLABL RECORD TARGET 09620CSR RLABL TS TARGET START 09630CSR RLABL N NUMB OF CHAR 09640CSR ENDSR 09650C******************************************************************** 09660CSR SR210 BEGSR 09670C* SET-OFF ESC FLAGS. 09680CSR SETOF 899091 09690CSR SETOF 929394 09700CSR SETOF 987796 09710CSR SETOF 9995 09720CSR ENDSR 09730C******************************************************************** 09740CSR SR211 BEGSR 09750C* SAVE INPUT DATA - EDIT & PUT TO SCREEN. ÐÐ09760CSR Z-ADD1 SS 30 09770CSR Z-ADDCOL,P TS 30 09780CSR Z-ADDSIZ,P N 30 09790CSR EXIT SUBRMV MOVE DATA 09800CSR RLABL W132A SOURCE DATA 09810CSR RLABL SS SOURCE START 09820CSR RLABL RECORD TARGET 09830CSR RLABL TS TARGET START 09840CSR RLABL N NUMB CHAR 09850CSR ENDSR 09860C******************************************************************** 09870CSR SR212 BEGSR 09880C* VERIFY MANDATORY AND TABLE DATA. 09890CSR Z-ADD1 X 30 09900C*------------------------------------------------------------------- 09910CSR T212A TAG 09920CSR EXSR SR216 BLK15-->W15A 09930CSR 000 LOKUPCOL,X 54 09940CSRN54 GOTO END212 09950CSR Z-ADDCOL,X SS 09960CSR Z-ADDSIZ,X N 09970CSR Z-ADD1 TS 09980CSR EXSR SR214 MOVE RECORD->W15A 09990CSR KPT,X COMP 'N' 54 10000CSR 54 EXSR SR215 R. ADJUST ÐÐ10010CSR 54 MOVE W15A W15N 150 10020CSR 54 MOVE W15N W15A 10030C* CHECK MANDATORY SPEC 10040CSR OPT,X COMP 'M' 54 10050CSRN54 GOTO T212B 10060CSR KPT,X COMP 'A' 54 10070CSR 54 W15A COMP BLK15 55 10080CSRN54 W15N COMP 0 55 10090CSRN55 GOTO T212F ERROR 10100C*------------------------------------------------------------------ 10110CSR T212B TAG 10120C* CHECK TABLES 10130CSR KTN,X COMP BLK18 54 10140CSRN54 GOTO T212L NO TABLES 10150CSR MOVEAKTO,X KPO 10160CSR MOVEAKTN,X KPL 10170CSR Z-ADD1 K 30 10180C*------------------------------------------------------------------- 10190CSR T212C TAG 10200CSR ' ' LOKUPKPO,K 54 10210CSRN54 GOTO T212L 10220CSR MOVE BLK18 W21A 21 10230CSR MOVELKPL,K W21A 10240CSR KPO,K COMP '<' 54 10250CSRN54 MOVE W15A W21A ÐÐ10260CSR W21A SETLLKPTABLE 10270C*------------------------------------------------------------------- 10280CSR T212D TAG 10290CSR SETOF 54 10300CSR READ KPTABLE 54 10310CSR 54 GOTO T212F 10320CSR KTNAME COMP KPL,K 54 10330CSRN54 GOTO T212F 10340CSR KTSTAT COMP 'D' 54 10350CSR 54 GOTO T212D DELETED 10360CSR KPT,X COMP 'N' 54 10370CSR 54 MOVE KTVAL NUM15 150 10380CSR 54 NUM15 COMP W15N 414243 10390CSRN54 KTVAL COMP W15A 414243 10400CSR KPO,K COMP '>' 44 10410CSR KPO,K COMP '<' 45 10420CSR KPO,K COMP '=' 46 10430CSR 41 44 GOTO T212E OK 10440CSR 41 45 GOTO T212F ERROR 10450CSR 41 46 GOTO T212F ERROR 10460CSR 42 44 GOTO T212D READ NEXT TABLE 10470CSR 42 45 GOTO T212E OK 10480CSR 42 46 GOTO T212D READ NEXT TABLE 10490CSR 43 44 GOTO T212D READ NEXT TABLE 10500CSR 43 45 GOTO T212F ERROR ÐÐ10510CSR 43 46 GOTO T212E OK 10520C*-------------------------------------------------------------- 10530CSR T212E TAG 10540C* LAST TABLE OK, GET NEXT TABLE. 10550CSR 1 ADD K K 10560CSR K COMP 3 54 10570CSRN54 GOTO T212C GET NEXT TABLE 10580CSR GOTO T212L GET NEXT DATA FIELD 10590C*------------------------------------------------------------------- 10600CSR T212F TAG 10610C* FLAG ERROR. 10620CSR EXSR SR900 10630CSR GOTO END212 10640C*------------------------------------------------------------------- 10650CSR T212L TAG 10660C* SET-UP NEXT DATA FIELD 10670CSR 1 ADD X X 10680CSR X COMP 30 54 10690CSRN54 GOTO T212A GET NEXT DATA FIELD 10700CSR END212 ENDSR 10710C******************************************************************** 10720CSR SR213 BEGSR 10730C* CUM BATCH TOTALS. 10740CSR Z-ADD1 P 10750C*------------------------------------------------------------------- ÐÐ10760CSR T213A TAG 10770CSR 0 LOKUPKPB,P 54 10780CSRN54 GOTO END213 10790CSR Z-ADDCOL,P SS 10800CSR Z-ADD1 TS 10810CSR Z-ADDSIZ,P N 10820CSR EXSR SR216 MOVE BLK15->W15A 10830CSR EXSR SR214 MOVE RECORD->W15A 10840CSR EXSR SR215 R.ADJUST 10850CSR MOVE W15A W15N 10860CSR Z-ADDKPB,P X 10870CSRN99 W15N ADD KCB,X KCB,X 10880CSR 99 KCB,X SUB W15N KCB,X 10890CSR 1 ADD P P 10900CSR P COMP 30 54 10910CSRN54 GOTO T213A 10920CSR END213 ENDSR 10930C************************************************************* 10940CSR SR214 BEGSR 10950C* COMMON MOVE ROUTINE 10960CSR MOVE BLK15 W15A 10970CSR EXIT SUBRMV MOVE DATA 10980CSR RLABL RECORD SOURCE 10990CSR RLABL SS SOURCE START 11000CSR RLABL W15A TARGET ÐÐ11010CSR RLABL TS TARGET START 11020CSR RLABL N NUMB OF CHAR 11030CSR ENDSR 11040C************************************************************ 11050CSR SR215 BEGSR 11060C* R.ADJUST 11070CSR Z-ADD15 W2N 20 11080CSR EXIT SUBRAJ R.ADJUST 11090CSR RLABL W2N SIZE 11100CSR RLABL W15A RESULT 11110CSR ENDSR 11120C************************************************************** 11130CSR SR216 BEGSR 11140C* UTILITY MOVE 11150CSR MOVE BLK15 W15A 15 11160CSR ENDSR 11170C***************************************************************** 11180CSR SR217 BEGSR 11190C* UTILITY COMPARE 11200CSR P COMP 30 54 11210CSR ENDSR 11220C******************************************************************** 11230CSR SR301 BEGSR 11240C* COMPUTE TS(TARGET START) FOR NUMERIC DISPLAY FIELD 11250CSR KPE,P COMP '2' 54 ÐÐ11260CSRN54 KPE,P COMP 'K' 54 11270CSRN54 GOTO T301B 11280CSR SIZ,P SUB KPD,P WHOLE 30 11290CSR WHOLE DIV 3 XTRA 30 11300CSR XTRA ADD WHOLE WHOLE WHOLE # SIZE 11310CSR KPD,P COMP 0 54 11320CSR 54 1 ADD KPD,P XTRA 11330CSRN54 Z-ADDKPD,P XTRA DEC SIZE 11340CSR KPE,P COMP 'K' 54 11350CSR 54 1 ADD XTRA XTRA MINUS SIGN 11360CSR N SUB XTRA W3N 30 ACTUAL WHOLE# 11370CSR WHOLE SUB W3N W3N 11380CSR COL,P ADD W3N TS 54 11390CSRN54 Z-ADD1 TS START POS 11400CSR XTRA ADD WHOLE NUMB 30 11410CSR EXSR SR302 BLKS TO WORK 11420CSR GOTO END301 11430C*------------------------------------------------------------------- 11440CSR T301B TAG 11450C* DO Y-EDIT CODE 11460CSR KPE,P COMP 'Y' 54 11470CSRN54 GOTO T301D NOT Y-EDIT 11480CSR SIZ,P DIV 2 XTRA 11490CSR XTRA SUB 1 XTRA 54 11500CSRN54 Z-ADD0 XTRA ÐÐ11510CSR SIZ,P ADD XTRA W3N 11520CSR COL,P ADD W3N TS 11530CSR TS SUB N TS 54 11540CSRN54 Z-ADD1 TS 11550CSR SIZ,P ADD XTRA NUMB 11560CSR EXSR SR302 BLKS TO WORK 11570CSR GOTO END301 11580C*----------------------------------------------------------------- 11590CSR T301D TAG 11600C* EDIT CODE OTHER THAN 2,K,Y. 11610CSR SIZ,P SUB N W3N 54 11620CSRN54 Z-ADD0 W3N 11630CSR COL,P ADD W3N TS 11640CSR Z-ADDSIZ,P NUMB 11650CSR EXSR SR302 BLKS TO WORK 11660CSR END301 ENDSR 11670C************************************************************** 11680CSR SR302 BEGSR 11690C* BLANK CUR FIELD IN WORK 11700CSR Z-ADD1 W3N 11710CSR Z-ADDCOL,P T 30 11720CSR EXIT SUBRMV MOVE BLANKS 11730CSR RLABL BLK132 SOURCE 11740CSR RLABL W3N SOURCE START 11750CSR RLABL WORK TARGET ÐÐ11760CSR RLABL T TARGET START 11770CSR RLABL NUMB NUMB CHAR 11780CSR ENDSR 11790C*************************************************************** 11800CSR SR900 BEGSR 11810C* FLAG INVALID DATA ERROR 11820CSR SETON 85 11830CSR EXCPT 11840CSR SETOF 85 11850CSR Z-ADD436 M 50 96 11860CSR EXSR SR73 FLAG ERROR 11870CSR ENDSR 11880O******************************************************************** 11890OKPDATA EADD 80 79 11900O KNJOB 6 11910O BATCH 9 11920O NXTREC 14 11930O CREMPL 19 11940O PORT 21 11950O RECORD 153 11960O ERR 168P 11970O 192 ' ' 11980O*------------------------------------------------------------------- 11990O E 80N79 12000O CREMPL 19 ÐÐ12010O PORT 21 12020O RECORD 153 12030O ERR 168P 12040O KESTAT 192 12050O******************************************************************** 12060OKPCONT EADD 81 60 12070O KEYKC 10 12080O KCB 40P 12090O KCREC 43P 12100O CRDEPT 47P 12110O 48 ' ' 12120O*------------------------------------------------------------------- 12130O E 82 12140O OR 81N60 12150O KCB 40P 12160O KCREC 43P 12170O CRDEPT 47P 12180O 48 ' ' 12190O**************************************************************** 12200OKPNAME E 81 12210O KNLBAT 333P 12220O******************************************************************** 12230OTERM132 E 71 12240O* PUT HEADING. 12250O 65 BIT,28 1 ÐÐ12260O 65 8 '8001001' 12270O 78 'DATA ENTRY MENU' 12280O*------------------------------------------------------------------- 12290O E 71 12300O 1 ' ' 12310O*------------------------------------------------------------------- 12320O E 71 12330O 1 ' ' 12340O*------------------------------------------------------------------- 12350O E 71 12360O 7 'JOB-NO.' 12370O 18 'JOB-NAME' 12380O 78 'FORMAT' 12390O*------------------------------------------------------------------- 12400O E 72 12410O J Z 5 12420O KNTITL 70 12430O KDFRMT 75 12440O*------------------------------------------------------------------- 12450O E 74 12460O BIT,28 1 12470O 8 '8002001' 12480O 24 'ENTER SELECTION:' 12490O*------------------------------------------------------------------- 12500O E 76 ÐÐ12510O BIT,28 1 12520O 8 '8001001' 12530O 78 'DATA ENTRY FORMAT' 12540O*------------------------------------------------------------------- 12550O E 76 12560O 1 ' ' 12570O*------------------------------------------------------------------- 12580O E 76 12590O 1 ' ' 12600O*------------------------------------------------------------------- 12610O E 76 12620O 9 'FIELD-NO.' 12630O 21 'FIELD-NAME' 12640O 41 'SPECIAL-INSTR' 12650O*------------------------------------------------------------------- 12660O E 76 12670O 1 ' ' 12680O*------------------------------------------------------------------- 12690O E 78 12700O KPNAME 26 12710O KPS,P 29 12720O OPT,P 31 12730O P Z 6 12740O*------------------------------------------------------------------- 12750O E 35 ÐÐ12760O BIT,28 1 12770O 8 '8002001' 12780O 21 28 'ENTER SPECIAL INSTR:' 12790O 22 32 'ENTER OPTION CODE (O,M):' 12800O*------------------------------------------------------------------- 12810O E 75 12820O BIT,28 1 12830O 8 '8002065' 12840O 25 'INVALID SELECTION' 12850O*------------------------------------------------------------------- 12860O E 36 12870O OR 81 12880O BIT,28 1 12890O 8 '8002001' 12900O 24 'ENTER BATCH NO:' 12910O BATCH Z 29 12920O*------------------------------------------------------------------- 12930O E 37 12940O BIT,28 1 12950O 8 '8002001' 12960O 23 'ENTER RECORD #:' 12970O*------------------------------------------------------------------- 12980O E 73 12990O BIT,28 1 13000O 8 '8002001' ÐÐ13010O 96 13 '*****' 13020O N96 13 ' ' 13030O MGTEXT 50 13040O 96 60 'E R R O R' 13050O N96 60 ' ' 13060O BIT,8 132 13070O*------------------------------------------------------------------- 13080O E 33 13090O OR 32 13100O BIT,28 1 13110O 8 '8001001' 13120O KNTITL 103 13130O 111 'BATCH=' 13140O BATCH Z 114 13150O 120 'REC=' 13160O NXTRECZ 125 13170O*------------------------------------------------------------------- 13180O E 33 13190O 1 ' ' 13200O*------------------------------------------------------------------- 13210O E 33 13220O POS 132 13230O*------------------------------------------------------------------- 13240O E 33 13250O KNHL1 132 ÐÐ13260O*------------------------------------------------------------------- 13270O E 33 13280O KNHL2 132 13290O*------------------------------------------------------------------- 13300O E 33 13310O 1 ' ' 13320O*--------------------------------------------------------------- 13330O E 70 13340O* REWRITE INPUT DATA 13350O WORK 132 13360O*------------------------------------------------------------------- ** JOB ARRAY 013370 013380** KPS ARRAY 013390 013400** KPN ARRAY 013410 013420** KPT ARRAY 013430 013440** KPE ARRAY 013450 013460** KPD ARRAY 013470 013480** COL ARRAY 013490 013500ÐÐ** SIZ ARRAY 013510 013520** KPB ARRAY 013530 013540** A15 ARRAY 013550 013560** A6 ARRAY 013570 013580** A132 ARRAY 013590 013600** ERR ARRAY 013610 013620** POS ARRAY 013630 013640** OPT ARRAY 013650 013660** KTN ARRAY 013670 013680** KTO ARRAY 013690 013700** SAV ARRAY 013710 013720/* 013730_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(#Ë #X046PM P120282120282(èÈÐ00010H Q046PM00020F* UPDATE PART MASTER INVENTORY CLASS (SEE X045PM ALSO) 00030FABCOUT IP F 12 DISK 00040FPMMST2 UC F 674R12AI 1 DISK 00050IABCOUT AB 01 00060I 1 100APN 00070I 12 12 ACLASS 00080IPMMST2 PM 00090I 429 429 PMINVC 00100C MOVELAPN W12A 12 00110C W12A CHAINPMMST2 54 00120OPMMST2 D 01N54 00130O ACLASS 429 /* 00140_‚ ÐÐ _‚_‚0C W12A CHAINPMMST2 54 00120OPMMST2 D 01N54 00130O ACLASS 429 /* 00140_‚ ÐÈ(Û X051DP P120282120282(èÈÐ00010H Q051DP00020F* UTILITY FLOPPY DISK TO PRINTER. (X051DP) 00030F* REVISED 6-20-81 9:00 AM. 00040FFLOPPY IP F 122 17 00050F KEBCDIC 00060FPRINT O F 132 PRINTER 00070IFLOPPY FL 01 00080I 1 80 REC 00090C 1 ADD COUNT COUNT 50 00100OPRINT D 01 00110O REC 80 00120O COUNT 2 132 /* 000130_‚ _‚_‚ ÐÈ(}ã }5X055DP PÔè120282120282(èÈÐ00010H Q055DP00020F* COPY 80-BYTE DISK FILE TO 122-BYTE DISKETT FILE. (X055DP) 00030F* GENERAL UTILITY SKIPS 1ST 17 RECORDS (FOR SVC. BUREAU). 00040F* REV 4/02/82 11:45 AM. 00050F****************************************************************** 00060FBITTAB IP F 33 DISK 00070FDISK80 IC F 80R DISK 00080FSTARTFL UC F 5R DISK 00090FFLOPPY O F 122 17 00100F KEBCDIC 00110FTERM80 O F 80 5 00120FPRINT O F 132 OF PRINTER U1 00130E******************************************************************* 00140E EOF 1 61 2 00150E BIT 33 1 00160I******************************************************************** 00170IBITTAB BT 00180I 1 33 BIT 00190I***************************************************************** 00200IDISK80 DS 00210I 1 80 REC 00220I**************************************************************** 00230ISTARTFL SF 00240I* STARTING RRN # 00250I 1 50BEGIN ÐÐ00260C****************************************************************** 00270C MOVE ' ' BLK122122 00280C Z-ADD0 X 30 00290C Z-ADD1 RRN 50 00300C RRN CHAINSTARTFL H7 00310C Z-ADD0 COUNT 00320C*------------------------------------------------------------------- 00330C START TAG 00340C 1 ADD X X 00350C X COMP 17 54 00360C 54 Z-ADDBEGIN COUNT 00370C 54 GOTO TAG10 00380C 1 ADD COUNT COUNT 50 00390C SETON 81 00400C EXCPT 00410C SETOF 81 00420C GOTO START 00430C*------------------------------------------------------------------- 00440C TAG10 TAG 00450C 1 ADD COUNT COUNT 00460C Z-ADDCOUNT BEGIN 00470C COUNT CHAINDISK80 54 00480C 54 GOTO ENDJOB 00490C SETON 82 00500C EXCPT WRITE FLOPPY ÐÐ00510C SETOF 82 00520C RRN CHAINSTARTFL H9 00530C SETON 83 00540C EXCPT UPDATE STARTFL FILE 00550C SETOF 83 00560C GOTO TAG10 00570C*------------------------------------------------------------------- 00580C ENDJOB TAG 00590CLR RRN CHAINSTARTFL H8 00600CLR Z-ADD0 BEGIN 00610CLR SETON 83 00620CLR EXCPT INIT STARTFL FILE 00630CLR SETOF 83 00640CLR MOVE '?*' EOF 00650C*----------------------------------------------------------------- 00660CLR LOOP TAG 00670CLR 1 ADD COUNT COUNT 50 00680CLR SETON 71 00690CLR EXCPT PUT /* 00700CLR SETOF 71 00710CLR MOVE '/*' EOF 00720CLR GOTO LOOP 00730O******************************************************************** 00740OPRINT E 82 U1 00750O REC 80 ÐÐ00760O COUNT Z 100 00770O******************************************************************** 00780OFLOPPY E 82 00790O BLK122 122 00800O REC 80 00810O 82 '1' 00820O E 81 00830O BLK122 122 00840O E 71 00850O EOF 122 00860O******************************************************************** 00870OSTARTFL E 83 00880O BEGIN 5 00890O******************************************************************** 00900OTERM80 E 71 00910O COUNT Z 80 00920O E 81 00930O COUNT Z 80 00940O E 82 00950O REC 80 00960O E 82 00970O COUNT Z 80 ** EOF 000980 000990/* 001000ÐÐ_‚ ÐÐ_‚_‚ ÐÈ(d d*X056BM P120282120282(èÈÐ00010H Q056BM00020F* COUNT MULTI-USAGE MFG PARTS. (X056BM) 00030F* REVISED 3/07/81 2:45 PM. 00040FBMWU IP F 21 20AI 1 DISK 00050FPMMST2 IS F 674 12AI 1 DISK 00060FPRINT O F 132 PRINTER U2 00070FTERM50 O F 50 5 U1 00080I******************************************************************** 00090IBMWU WU 01 21NCD 00100I 1 100WUPN L1M1 00110I*------------------------------------------------------------------- 00120I WG 02 00130I******************************************************************** 00140IPMMST2 PM 03 674NCD 94 CM 00150I OR 674NCD 94 CR 95 CA 00160I 1 100PMPN L1M1 00170I*------------------------------------------------------------------- 00180I PG 04 00190C******************************************************************** 00200C L1 Z-ADD0 COUNT 50 70 00210C 01 MR 1 ADD COUNT COUNT 70 00220C 03 1 ADD MFG MFG 50 00230CL1 70 COUNT COMP 1 70 00240CL1 70 1 ADD MULTI MULTI 50 00250O******************************************************************** ÐÐ00260OPRINT T 101 LR U2 00270O MULTI 2 25 00280O 17 'MULTI-USAGE' 00290O*-------------------------------------------------------------- 00300O T 11 LR U2 00310O 35 'MFG PARTS:' 00320O MFG 2 50 00330O******************************************************************** 00340OTERM50 T LR U1 00350O MULTI 2 50 00360O 35 'MULTI-USERS' 00370O*------------------------------------------------------------------- 00380O T LR U1 00390O 35 'MFG PARTS' 00400O MFG 2 50 /* 000410_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dD d*X059DP P120282120282(èÈÐ00010H Q059DP00020F* PROGRAM LOADER. (X059DP) 00030F* REVISED 7/05/79 9:00 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060E******************************************************************** 00070E BIT 33 1 00080E CALL 5 6 A 00090I******************************************************************** 00100IBITTAB BT 01 00110I 1 33 BIT 00120I******************************************************************** 00130ICRTFILE CR 00140I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00150I* STD AREA - SAME FOR ALL PROGRAMS. 00160I* EMPLOYEE # 5N 00170I 1 50CREMPL 00180I* USER CODE 8A 00190I 6 13 CRUSER 00200I* DEPT # 5N 00210I 14 180CRDEPT 00220I* JOB NAME 8A (JOB LOAD BY MENU) 00230I 19 26 CRJOB 00240I* SHUTDOWN FLAG 1A 00250I* BLANK = NO SHUTDOWN ÐÐ00260I 27 27 CRSHUT 00270I* TIME STARTED 6N 00280I 28 330CRTIME 00290I* DATE STARTED 4N 00300I 34 370CRDATE 00310I* CALL STACK 5 X 6A 00320I 38 67 CALL 00330I* RET TO PROG NAME (FOR PROG LOADER) 6A 00340I 68 73 CRRET 00350I* MENU NAME 6A 00360I 74 79 CRMENU 00370I*------------------------------------------------------------------- 00380I* PROGRAM AREA - VARIES WITH EACH SYSTEM. 00390C******************************************************************** 00400C MOVE ' ' BLK8 8 00410C MOVE ' ' BLK6 6 00420C MOVE ' ' W8A 8 00430C Z-ADD0 W2N 20 00440C Z-ADD0 W1N 10 00450C MOVE ' ' W2A 2 00460C* GET PORT #. CHAIN TO CRTFILE. 00470C EXITFPGMINX 00480C RLABL W8A 00490C RLABL W2N 00500C RLABL W1N ÐÐ00510C RLABL W2A 00520C MOVE W2A PORT 20 00530C PORT COMP 0 54 00540C N54 Z-ADD25 PORT 00550C PORT CHAINCRTFILE H9 00560C Z-ADD1 X 30 00570C BLK6 LOKUPCALL,X 54 00580C 54 MOVELCALL,X PROG 8 00590C 54 MOVE BLK6 CALL,X 00600C 54 GOTO END 00610C MOVELCRRET PROG 00620C MOVE BLK6 CRRET 00630C PROG COMP BLK8 54 00640C 54 GOTO END 00650C MOVELCRMENU PROG 00660C MOVE BLK6 CRMENU 00670C PROG COMP BLK8 54 00680C 54 GOTO END 00690C MOVEL'CONTU' PROG 00700C*----------------------------------------------------------------- 00710C END TAG 00720C* NOTE--- CRTFILE UPDATED AT DETAIL OUTPUT TIME. 00730CLR EXITFCHAIN 00740CLR RLABL PROG 00750O******************************************************************** ÐÐ00760OCRTFILE D 01NH9 00770O CALL 67 00780O CRRET 73 /* 000790_‚ ÐÐ_‚_‚0OCRTFILE D 01NH9 00770O CALL 67 00780O CRRET 73 /* 000790_‚ ÐÈ(ôo ôÑX060DP P120282120282(èÈÐ00010H Q060DP00020F* UPDATE DPJOBCON FILE.(X060DP) 00030F* REVISED 5/07/80 1:50 PM. DG-REL006 OK. 00040F* 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FDPJOBCONUC F 24R 6AI 1 DISK A 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A6 6 6 1 CALL READ PARAM. 00120E A8 8 8 1 A INPUT DATA ARRAY 00130E DUN 1 3 1 A EDIT CMPLT FLAG 00140E MES 1 1 30 00150E BIT 33 1 SCREEN CONTR. CHAR 00160E CALL 5 6 CALL STACK 00170I******************************************************************* 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************* 00210IMGFILE MG 00220I* MESSAGE FILE. 00230I 1 35 MGTEXT 00240I******************************************************************** 00250IDPJOBCONDP ÐÐ00260I* JOB CONTROL FILE. 00270I* JOB NAME 6A (KEY) 00280I 1 6 DPJOB 00290I* TIME 6N 00300I 7 120DPTIME 00310I* DATE 6N 00320I 13 180DPDATE 00330I* BUSY FLAG 1A 00340I 19 19 DPFLAG 00350I* RECORD STATUS 1A 00360I 24 24 DPSTAT 00370I* 00380I* 00390I* 00400I* 00410I* 00420I* 00430I* 00440I* 00450I* 00460I* 00470C******************************************************************** 00480C* INITIALIZE 00490C EXSR SR101 1-TIME INIT 00500C*------------------------------------------------------------------ ÐÐ00510C START TAG 00520C* SET-UP 1ST FIELD NO. 00530C Z-ADD1 F 30 FIELD # 00540C GOTO READ 00550C*------------------------------------------------------------------ 00560C NEXT TAG 00570C* SET-UP NEXT FIELD NO. 00580C 1 ADD F F FIELD # 00590C*----------------------------------------------------------------- 00600C READ TAG 00610C* READ DATA FROM TERMINAL. 00620C EXSR SR102 VALIDATE FIELD # 00630C 55 GOTO UPDATE DONE 00640C EXSR SR201 IDENTIFY-F 00650C SETON 69 00660C EXSR SR72 PROMPT 00670C SETOF 69 00680C EXSR SR75 READ TERMINAL 00690C 98 GOTO GOODBY GOODBY 00700C 94 GOTO MENU MENU REQUEST 00710C N77 EXSR SR104 EDIT INPUT FIELD 00720C 96 ERROR 00730CORN77 EXSR SR72 REWRITE INPUT DATA 00740C 93 GOTO NEWITM NEW ITEM 00750C 92 GOTO JUMP FIELD JUMP REQST ÐÐ00760C 91 GOTO NEXT SKIP FORWARD 00770C 89 F SUB 1 F SKIP BACKWARD 00780C 89 GOTO READ " " 00790C 88 SETOF 90 SPACE FILL 00800C 88 SETON 77 " " 00810C 87 GOTO START 00820C 86 GOTO UPDATE UPDATE 00830C 85 GOTO READ REPEAT 00840C 96 GOTO ERROR ERROR 00850C N77 GOTO NEXT NO DATA INPUT 00860C*------------------------------------------------------------------ 00870C PROCES TAG 00880C* PROCESS INPUT DATA 00890C EXSR SR103 MOVE DATA 00900C N96 EXSR SR104 EDIT DATA 00910C EXSR SR72 REWRITE DATA 00920C 96 GOTO ERROR ERROR 00930C GOTO NEXT 00940C*------------------------------------------------------------------ 00950C UPDATE TAG 00960C* UPDATE DATA BASE. 00970C EXSR SR105 FINAL EDIT 00980C 96 GOTO ERROR ERROR 00990C EXSR SR106 UPDATE 01000C 96 GOTO ERROR ERROR ÐÐ01010C GOTO START 01020C*------------------------------------------------------------------- 01030C JUMP TAG 01040C* SET-UP JUMP TO REQUESTED FIELD 01050C 1 ADD W W 30 01060C W COMP 8 54 01070C 54 Z-ADD318 M 50 96 FLAG ERROR 01080C 54 GOTO ERROR BAD ESC 01090C MOVE '000' W3A 3 01100C MOVEAA8,W W3A 01110C Z-ADD3 W2N 20 01120C EXIT SUBRAJ R. JUSTIFY 01130C RLABL W2N 01140C RLABL W3A 01150C MOVE W3A F NEW FIELD # 01160C GOTO READ 01170C*-------------------------------------------------------------------- 01180C ERROR TAG 01190C EXSR SR102 VALIDATE FIELD # 01200C EXSR SR89 GET MSG 01210C EXSR SR73 PUT MSG 01220C GOTO READ 01230C*------------------------------------------------------------------ 01240C NEWITM TAG 01250C* SET-UP LINK FOR NEW ITEM ÐÐ01260C MOVEL'Q060DP' PROG 8 01270C GOTO END 01280C*------------------------------------------------------------------- 01290C MENU TAG 01300C* SET-UP LINK TO MENU 01310C MOVEL'QQDP01' PROG 01320C GOTO END 01330C*-------------------------------------------------------------------- 01340C GOODBY TAG 01350C* LINK TO SIGN-OFF 01360C MOVEL'GOODBY' PROG 01370C GOTO END 01380C*------------------------------------------------------------------- 01390C END TAG 01400C EXSR SR97 UPDATE CRTFILE 01410C EXITFCHAIN LINK TO NEXT PROG 01420C RLABL PROG 01430C******************************************************************** 01440CSR SR1 BEGSR 01450C* EDIT TRAN CODE. 01460CSR EXSR SR203 CLASSIFY TRAN. 01470CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR. 01480CSR ENDSR 01490C********************************************************************* 01500CSR SR2 BEGSR ÐÐ01510C* EDIT PROG NAME. 01520CSR TPROG COMP BLK8 54 01530CSRN54 Z-ADD33 M 96 FLAG ERROR. 01540CSR ENDSR 01550C********************************************************************** 01560CSR SR71 BEGSR 01570C* PUT HEADINGS TO TERMINAL 01580CSR SETON 71 01590CSR EXCPT PUT HEADINGS 01600CSR SETOF 71 01610CSR ENDSR 01620C********************************************************************* 01630CSR SR72 BEGSR 01640C* PUT DATA TO TERMINAL 01650CSR SETON 72 01660CSR EXCPT PUT DATA 01670CSR SETOF 72 01680CSR ENDSR 01690C*********************************************************************** 01700CSR SR73 BEGSR 01710C* PUT ERROR MESSAGE TO TERMINAL 01720CSR SETON 73 01730CSR EXCPT PUT MSG 01740CSR SETOF 73 01750CSR Z-ADDM LSTERR 50 ÐÐ01760CSR ENDSR 01770C******************************************************************* 01780CSR SR75 BEGSR 01790C* READ FROM TERMINAL 01800CSR SETOF 779096 01810CSR SETOF 939291 01820CSR SETOF 8988 01830CSR MOVE BIT,5 A6,2 BUF LENGTH 01840CSR MOVEAA6 W6A 6 01850CSR MOVE BLK8 W8A 8 BUFFER 01860CSR EXITFXCREAD READ TERM 01870CSR RLABL W8A 01880CSR RLABL W6A 01890CSR MOVEAW8A A8 01900CSR MOVE BLK8 W8A 01910CSR Z-ADD1 W 30 01920CSR '\' LOKUPA8,W 90 FLAG ESC 01930CSRN90 GOTO T75B NOT ESC 01940CSR 1 ADD W W 01950CSR W COMP 8 54 01960CSR 54 GOTO T75A BAD ESC 01970CSR A8,W COMP 'G' 98 GOODBY 01980CSR A8,W COMP 'E' 94 MENU 01990CSR A8,W COMP 'N' 93 NEW ITEM 02000CSR A8,W COMP 'J' 92 JUMP ÐÐ02010CSR A8,W COMP 'F' 91 SKIP FRWRD 02020CSR A8,W COMP 'B' 89 SKIP BKWRD 02030CSR A8,W COMP 'S' 88 SPACE FILL 02040CSR A8,W COMP 'H' 87 HOME 02050CSR A8,W COMP 'U' 86 UPDATE 02060CSR A8,W COMP 'R' 85 REPEAT 02070CSR 98 02080COR 94 02090COR 93 02100COR 92 02110COR 91 02120COR 89 02130COR 88 02140COR 87 GOTO END75 GOOD ESC 02150C*------------------------------------------------------------------ 02160CSR T75A TAG 02170C* FLAG BAD ESC INPUT 02180CSR Z-ADD318 M 96 FLAG ERROR 02190CSR GOTO END75 02200C*-------------------------------------------------------------------- 02210CSR T75B TAG 02220C* MOVE DATA 02230CSR Z-ADD1 W 02240CSR ' ' LOKUPA8,W 77 02250CSR 77 MOVEAA8 W8A INPUT DATA ÐÐ02260C*-------------------------------------------------------------------- 02270CSR END75 TAG 02280C* INIT PREV ERROR MSG. 02290CSR LSTERR COMP 0 54 02300CSR 54 Z-ADD0 LSTERR 50 02310CSR 54 MOVE BLK35 MGTEXT 02320CSR 54 EXSR SR73 BLANK MESSAGE 02330CSR ENDSR 02340C********************************************************************** 02350CSR SR80 BEGSR 02360C* GET MASTER RECORD 02370CSR SETOF 61 02380CSR TPROG CHAINDPJOBCON 60 GET MASTER 02390CSRN60 DPSTAT COMP 'D' 61 FLAG DELETE 02400CSR ENDSR 02410C********************************************************************** 02420CSR SR81 BEGSR 02430C* ADD NEW MASTER TO FILE 02440CSR SETON 81 02450CSR EXCPT ADD MASTER 02460CSR SETOF 81 02470CSR ENDSR 02480C*********************************************************************** 02490CSR SR82 BEGSR 02500C* REWRITE MASTER ÐÐ02510CSR SETON 82 02520CSR EXCPT REWRITE MASTER 02530CSR SETOF 82 02540CSR ENDSR 02550C********************************************************************** 02560CSR SR89 BEGSR 02570C* GET MESSAGE MASTER 02580CSR M CHAINMGFILE 54 02590CSR 54 MOVE BLK35 MGTEXT 02600CSR 54 MOVELM MGTEXT 02610CSR 54 MOVE MES,1 MGTEXT 02620CSR ENDSR 02630C****************************************************************** 02640CSR SR97 BEGSR 02650C* UPDATE CRTFILE. 02660CSR SETON 97 02670CSR EXCPT UPDATE CRTFILE 02680CSR SETOF 97 02690CSR ENDSR 02700C*********************************************************************** 02710CSR SR101 BEGSR 02720C* 1-TIME INITIALIZE 02730CSR MOVE BIT,1 NUL 02740CSR MOVE BIT,1 A6 02750CSR Z-ADD3 FLIMIT 30 TOTAL NUMB FIELDS ÐÐ02760CSR MOVE ' ' BLK8 8 02770C* CLEAR CRT. 02780CSR EXITFQTOPF CLEAR CRT. 02790C* DEFINE WORK FIELDS,ETC. 02800CSR MOVE ' ' BLK35 35 02810CSR ENDSR 02820C********************************************************************** 02830CSR SR102 BEGSR 02840C* VALIDATE FIELD NO. 02850CSR F COMP 0 54 02860CSRN54 Z-ADD1 F 02870CSR F COMP FLIMIT 55 02880CSR 55 Z-ADD1 F 02890CSR ENDSR 02900C******************************************************************** 02910CSR SR103 BEGSR 02920C* MOVE INPUT DATA 02930CSR EXSR SR201 IDENTIFY-F 02940CSR 01 MOVELW8A TTCODE 1 02950CSR 02 MOVELW8A TPROG 6 02960CSR 03 MOVELW8A TFLAG 1 02970CSR MOVE ' ' DUN,F EDIT FLAG 02980CSR ENDSR 02990C******************************************************************** 03000CSR SR104 BEGSR ÐÐ03010C* EDIT INPUT DATA 03020CSR 01 EXSR SR1 EDIT TRAN. 03030CSR 02 EXSR SR2 EDIT PROG NAME. 03040CSR 96 MOVE ' ' DUN,F 03050CSRN96 MOVE 'X' DUN,F 03060CSR ENDSR 03070C*********************************************************************** 03080CSR SR105 BEGSR 03090C* FINAL EDIT 03100CSR SETON 79 FINAL EDIT FLAG 03110CSR Z-ADD1 F 03120C*-------------------------------------------------------------------- 03130CSR T105A TAG 03140CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 03150CSRN54 GOTO END105 03160CSR EXSR SR201 IDENTIFY-F 03170CSR EXSR SR104 EDIT 03180CSRN96 GOTO T105A 03190C*-------------------------------------------------------------------- 03200CSR END105 TAG 03210CSR SETOF 79 03220CSR ENDSR 03230C******************************************************************** 03240CSR SR106 BEGSR 03250C* UPDATE DATA BASE. ÐÐ03260CSR EXSR SR203 CLASSIFY TRAN 03270CSR 60 GOTO T106A ADD TRAN 03280CSR 61 GOTO T106D CHANGE TRAN 03290CSR 62 GOTO T106F DELETE TRAN 03300C* FLAG BAD TRAN CODE 03310CSR Z-ADD300 M 96 FLAG ERROR 03320CSR Z-ADD2 F FIELD # 03330CSR GOTO END106 03340C*------------------------------------------------------------------- 03350CSR T106A TAG 03360C* ADD TRANSACTION 03370CSR EXSR SR80 GET MASTER 03380CSR 60 GOTO T106B NOT ON FILE 03390CSR 61 GOTO T106C DELETED MASTER 03400C* FLAG DUPLICATE ADD ERROR 03410CSR Z-ADD301 M 96 FLAG ERROR 03420CSR Z-ADD2 F FIELD # 03430CSR GOTO END106 03440C*--------------------------------------------------------------------- 03450CSR T106B TAG 03460C* ADD-- MAST NOT ON FILE 03470CSR EXSR SR81 ADD NEW MASTER 03480CSR GOTO END106 03490C*--------------------------------------------------------------------- 03500CSR T106C TAG ÐÐ03510C* ADD-- MAST IS DELETED 03520CSR MOVE 'A' DPSTAT RECORD STATUS 03530CSR EXSR SR82 REWRITE MAST 03540CSR GOTO END106 03550C*---------------------------------------------------------------------- 03560CSR T106D TAG 03570C* CHANGE TRANSACTION. 03580CSR EXSR SR80 GET MASTER 03590CSRN60N61 GOTO T106E GOT IT 03600C* FLAG NO MASTER ERROR 03610CSR Z-ADD302 M 96 FLAG ERROR 03620CSR Z-ADD2 F FIELD # 03630CSR GOTO END106 03640C*----------------------------------------------------------------------- 03650CSR T106E TAG 03660C* REWRITE MASTER 03670CSR EXSR SR82 REWRITE MAST 03680CSR GOTO END106 03690C*----------------------------------------------------------------------- 03700CSR T106F TAG 03710C* DELETE TRANSACTION 03720CSR EXSR SR80 GET MASTER 03730CSRN60N61 GOTO T106G GOT IT 03740C* FLAG NO MASTER ERROR 03750CSR Z-ADD302 M 96 FLAG ERROR ÐÐ03760CSR Z-ADD2 F FIELD # 03770CSR GOTO END106 03780C*----------------------------------------------------------------------- 03790CSR T106G TAG 03800C* DELETE MASTER. 03810CSR 96 Z-ADD2 F FIELD # 03820CSR 96 GOTO END106 ERROR 03830CSR MOVE 'D' DPSTAT RECORD STATUS 03840CSR EXSR SR82 REWRITE MASTER 03850CSR END106 ENDSR 03860C************************************************************************ 03870CSR SR201 BEGSR 03880C* IDENTIFY FIELD NO. 03890CSR SETOF 0102 03900CSR F COMP 1 01 03910CSR F COMP 2 02 03920CSR F COMP 3 03 03930CSR ENDSR 03940C*********************************************************************** 03950CSR SR203 BEGSR 03960C* CLASSIFY TRAN CODE 03970CSR TTCODE COMP 'A' 60 ADD 03980CSR TTCODE COMP 'C' 61 CHANGE 03990CSR TTCODE COMP 'D' 62 DELETE 04000CSR ENDSR ÐÐ04010O******************************************************************** 04020ODPJOBCONEADD 81 04030O TPROG 6 04040O TFLAG 19 04050O 24 'A' 04060O*------------------------------------------------------------------- 04070O E 82 04080O TFLAG 19 04090O DPSTAT 24 04100O******************************************************************** 04110OTERM132 E 72 04120O BIT,28 1 04130O 2 '8' 04140O 01 8 '002001' 04150O 02 8 '003001' 04160O 03 8 '004001' 04170O 01 23 'ENTER TRAN CODE' 04180O 02 23 'ENTER PROG NAME' 04190O 03 18 'ENTER FLAG' 04200O 01 TTCODE 35 04210O 02 TPROG 40 04220O 03 TFLAG 35 04230O 69 BIT,28 124 04240O 69 125 '8' 04250O 69 01 131 '002027' ÐÐ04260O 69 02 131 '003027' 04270O 69 03 131 '004027' 04280O 69 BIT,8 132 04290O*------------------------------------------------------------------- 04300O E 73 04310O BIT,28 1 04320O 2 '8' 04330O 8 '006001' 04340O MGTEXT 43 ** NUL ARRAY 004350 004360** A6 ARRAY 004370 004380** A8 ARRAY 004390 004400** DUN ARRAY 004410 004420** MES ARRAY 004430---MESSAGE NOT ON FILE--- 004440/* 004450_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d A d*X061DP P120282120282(èÈÐ00010H Q061DP00020F* REMOVE FLAG FROM JOB CONTROL FILE. (X061DP) 00030F* REVISED 7/06/79 11:30 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060FDPJOBCONUC F 24R 6AI 1 DISK 00070E******************************************************************** 00080E BIT 33 1 BITTAB 00090E CALL 5 6 CALL STACK 00100I******************************************************************** 00110IBITTAB BT 01 00120I 1 33 BIT 00130I******************************************************************** 00140IDPJOBCONDP 00150I 19 19 DPFLAG 00160I******************************************************************** 00170ICRTFILE CR 00180I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00190I* STD AREA - SAME FOR ALL PROGRAMS. 00200I* EMPLOYEE # 5N 00210I 1 50CREMPL 00220I* USER CODE 8A 00230I 6 13 CRUSER 00240I* DEPT # 5N 00250I 14 180CRDEPT ÐÐ00260I* JOB NAME 8A (JOB LOAD BY MENU) 00270I 19 26 CRJOB 00280I* SHUTDOWN FLAG 1A 00290I 27 27 CRSHUT 00300I* TIME STARTED 6N 00310I 28 330CRTIME 00320I* DATE STARTED 4N 00330I 34 370CRDATE 00340I* CALL STACK 5 X 6A 00350I 38 67 CALL 00360I* RET TO PROG NAME (FOR PROG LOADER) 00370I 68 73 CRRET 00380I* MENU NAME 6A 00390I 74 79 CRMENU 00400C******************************************************************** 00410C MOVE ' ' W8A 8 00420C Z-ADD0 W2N 20 00430C Z-ADD0 W1N 10 00440C MOVE ' ' W2A 2 00450C EXITFPGMINX 00460C RLABL W8A 00470C RLABL W2N 00480C RLABL W1N 00490C RLABL W2A 00500C MOVE W2A PORT 20 ÐÐ00510C PORT COMP 0 54 00520C N54 Z-ADD25 PORT 00530C PORT CHAINCRTFILE H9 00540C MOVELCRJOB W6A 6 00550C W6A CHAINDPJOBCON 60 00560C N60 SETON 81 00570C N60 EXCPT 00580C N60 SETOF 81 00590CLR MOVELCRMENU PROG 8 00600CLR EXITFCHAIN 00610CLR RLABL PROG 00620O******************************************************************** 00630ODPJOBCONE 81 00640O 19 ' ' /* 000650_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( l  X062BM P120282120282(èÈÐ00010H Q062BM00020F* GEN WHERE-USED FILE BMWU. (X062BM) 00030F* CREATED 3/03/80 1:45 PM. 00040FBMMAST IP F 86 20AI 1 DISK 00050FBMWU O F 21 20AI 1 DISK A 00060I******************************************************************** 00070IBMMAST BM 01 86NCD 00080I 1 10 BMAPN 00090I 11 20 BMCPN 00100I GG 02 00110O******************************************************************** 00120OBMWU DADD 01 00130O BMCPN 10 00140O BMAPN 20 /* 000150_‚ _‚_‚ ÐÈ(K v K X062DP P120282120282(èÈÐ00010H Q062DP00020F* 'REFRESH' DESCRIPTIONS IN EMPL/JOB FILE. (X062DP) 00030F* REV 7/07/79 4:05 PM. 00040FEMPLFILEUP F 64 14AI 1 DISK 00050FJOBFILE IC F 48R 7AI 1 DISK 00060I******************************************************************** 00070IJOBFILE JN 00080I* RECORD CODE 1A 00090I* N = JOB NAME RECORD 00100I 1 1 JNREC 00110I* JOB NAME 6A 00120I 2 7 JNJOB 00130I* JOB DESCRIPTION 35A 00140I 8 42 JNDESC 00150I* RECORD STATUS 1A 00160I 48 48 JNSTAT 00170I*----------------------------------------------------------------- 00180I GG 03 00190I******************************************************************** 00200IEMPLFILEEJ 01 00210I* RECORD CODE 2A 00220I* J = EMPLOYEE/JOB 00230I 1 1 EJREC 00240I 2 60EJEMPL 00250I 7 90EJSEQ ÐÐ00260I 15 49 EJDESC 00270I 50 55 EJJOB 00280I 56 600EJDEPT 00290I 64 64 EJSTAT 00300C******************************************************************** 00310C EJREC COMP 'J' 01 00320C 01 EJSTAT COMP 'D' 54 00330C 01 54 SETOF 01 00340C N01 GOTO END 00350C MOVEL'N' W7A 7 00360C MOVE EJJOB W7A 00370C SETOF 61 00380C W7A CHAINJOBFILE 60 00390C N60 JNSTAT COMP 'D' 61 00400C 60 MOVE 'D' EJSTAT 00410C N60N61 MOVE JNDESC EJDESC 00420C SETON 80 00430C EXCPT 00440C SETOF 80 00450C*------------------------------------------------------------------- 00460C END TAG 00470O******************************************************************** 00480OEMPLFILEE 80 00490O EJDESC 49 00500O EJSTAT 64 ÐÐ/* 000510_‚ ÐÐ_‚_‚ 000510_‚ ÐÈ( —  X006WM P999999120282(èÈÐ00010H Q006WM00020F* INITIALIZE WMSTART FILE (SEE Q005WM). (X006WM) 00030F* REVISED 9-01-81 10:15 AM. 00040FWMSTART UP F 16 DISK 00050I******************************************************************** 00060IWMSTART WS 01 00070I 1 50WSRRN 00080C******************************************************************** 00090C Z-ADD0 WSRRN 00100O******************************************************************** 00110OWMSTART D 01 00120O WSRRN 5 /* 00130_‚ _‚_‚ ÐÈ( ¡ X063DP P120282120282(èÈÐ00010H Q063DP00020F* DISPLAY CRTFILE RECORD ON 132-COL TERM. 00030FCRTFILE IP F 256 DISK 00040FTERM132 O F 132 5 00050ICRTFILE CR 01 00060I 1 128 RECA 00070I 129 256 RECB 00080C 1 ADD COUNT COUNT 20 00090OTERM132 D 01 00100O RECA 128 00110O COUNT Z 132 00120O D 01 00130O RECB 128 00140O COUNT Z 132 /* 000150_‚_‚ _‚_‚ ÐÈ( ©  X067DP P120282120282(èÈÐ00010H Q067DP00020F* COPY 122-BYTE DISKETT FILE TO 80-COL ADD-ON DISK FILE. (X067DP) 00030F* REVISED 7/16/79 12:10 PM. 00040FFLOPPY IP F 122 17 00050F KEBCDIC 00060FDISK80 O F 80 80 DISK A 00070IFLOPPY FL 01 00080I 1 2 EOF 00090I 1 80 REC 70 00100C EOF COMP '/*' 54 00110C 54 SETON LR 00120ODISK80 DADD 01N54N70 00130O REC 80 /* 000140_‚ ÐÐ_‚_‚0H Q067DP00020F* COPY 122-BYTE DISKETT FILE TO 80-COL ADD-ON DISK FILE. (X067DP) 00030F* REVISED 7/16/79 12:10 PM. 00040FFLOPPY IP F 122 17 00050F KEBCDIC 00060FDISK80 O F 80 80 DISK A 00070IFLOPPY FL 01 00080I 1 2 EOF 00090I 1 80 REC 70 00100C EOF COMP '/*' 54 00110C 54 SETON LR 00120ODISK80 DADD 01N54N70 00130O REC 80 /* 000140_‚ ÐÈ( µ  X068DP P120282120282(èÈÐ00010H Q068DP00020F* LOAD UTILITY INDEXED TABLE FILE. (X068DP) 00030F* REVISED 8/13/79 11:45 AM. 00040FUTILTAB IP F 80 DISK 00050FINDEXTABO F 75 15AI 1 DISK A 00060I******************************************************************** 00070IUTILTAB UT 01 00080I* COL 1- 2 = TABLE I-D CODE 00090I* COL 3-15 = TABLE CONTROL FIELD 00100I* COL 16-75 = TABLE DATA 00110I 1 75 REC 00120I 1 2 EOF 00130C******************************************************************** 00140C EOF COMP '/*' LR 00150O******************************************************************** 00160OINDEXTABDADD 01NLR 00170O REC 75 /* 000180_‚ _‚_‚ ÐÈ(– ¿ –?X069DP P120282120282(èÈÐ00010H Q069DP00020F* LIST MENU CONTROL FILES (X069DP) 00030F* REV 8/13/79 5:15 PM. 00040F* 00060FEMPLFILEIP F 64 14AI 1 DISK 00070FDEPTFILEIS F 32 12AI 1 DISK 00080FJOBFILE IS F 48 7AI 1 DISK 00100FPRINT O F 132 OF LPRINTER 00110LPRINT 66FL 60OL 00150I******************************************************************** 00160IEMPLFILEEE 01 1 CE 64NCD 00170I* RECORD CODE 2A 00180I* E = EMPLOYEE/USER CROSS-REF 00190I* U = USER/EMPLOYEE CROSS-REF 00200I* J = EMPLOYEE/JOB 00210I 1 1 REC 00220I* EMPLOYEE # 5N 00230I 2 60EMPL 00240I* USER-ID 8A 00250I 15 22 USER 00260I* EMPLOYEE NAME 20A 00270I 23 42 NAME20 00280I* EMPLOYEE DEPT # 5N 00290I 43 470DEPT 00300I* RECORD STATUS 1A ÐÐ00310I 64 64 STAT 00320I*------------------------------------------------------------------- 00330I EU 02 1 CU 64NCD 00340I 1 1 REC 00350I 2 9 USER 00360I 15 190EMPL 00370I 64 64 STAT 00380I*------------------------------------------------------------------- 00390I EJ 03 1 CJ 64NCD 00400I 1 1 REC 00410I 2 60EMPL 00420I 7 90SEQ 00430I 15 49 NAME35 00440I 50 55 JOB 00450I 56 600DEPT 00460I 64 64 STAT 00470I*------------------------------------------------------------------- 00480I XX 54 00490I******************************************************************** 00500IDEPTFILEDH 04 1 CH 32NCD 00510I* RECORD CODE 1A 00520I* H = DEPT HEAD RECORD 00530I* J = DEPT JOB RECORD 00540I 1 1 REC 00550I* DEPT # 5N ÐÐ00560I 2 60DEPT 00570I* DEPT HEAD EMPLOYEE # 5N 00580I 7 110EMPL 00590I* RECORD STATUS 1A 00600I 32 32 STAT 00610I*------------------------------------------------------------------- 00620I DJ 05 1 CJ 32NCD 00630I* RECORD CODE 1A 00640I 1 1 REC 00650I* DEPT # 5N 00660I 2 60DEPT 00670I* SEQ # 3N 00680I 7 90SEQ 00690I* JOB CODE 6A 00700I 13 18 JOB 00710I* RECORD STATUS 1A 00720I 32 32 STAT 00730I*------------------------------------------------------------------- 00740I XX 54 00750I******************************************************************** 00760IJOBFILE JN 06 1 CN 48NCD 00770I* RECORD CODE 1A 00780I* N = JOB NAME RECORD 00790I* C = JOB CODE RECORD 00800I 1 1 RECEC ÐÐ00810I* JOB NAME 6A 00820I 2 7 JOB 00830I* JOB DESCRIPTION 35A 00840I 8 42 NAME35 00850I* RECORD STATUS 1A 00860I 48 48 STAT 00870I*------------------------------------------------------------------- 00880I XX 54 00890I******************************************************************** 00900O******************************************************************* 00910OPRINT H 201 1P 00920O OR OF 00930O 75 'MENU CONTROL FILE LIST' 00940O H 2 1P 00950O OR OF 00960O 10 'RECORD' 00970O 35 'DEPT' 00980O 45 'EMPL' 00990O 55 'USER' 01000O 65 'SEQ' 01010O 75 'JOB' 01020O 85 'NAME' 01030O D 1 N54 01040O 01 8 'EMPLOYEE' 01050O 02 4 'USER' ÐÐ01060O 03 8 'EMPL JOB' 01070O 04 9 'DEPT HEAD' 01080O 05 8 'DEPT JOB' 01090O 06 8 'JOB MAST' 01100O DEPT ZB 35 01110O EMPL ZB 45 01120O USER B 55 01130O SEQ ZB 65 01140O JOB B 75 01150O 01 NAME20 B 115 01160O N01 NAME35 B 115 /* 001170_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(( ÿ (X070DP P120282120282(èÈÐ00010H Q070DP00020F* LINK USER BACK TO STARTING MENU. (X070DP) 00030F* CREATED 8/22/79 3:10 PM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060E******************************************************************** 00070E BIT 33 1 00080I******************************************************************** 00090IBITTAB BT 00100I 1 33 BIT 00110I******************************************************************** 00120ICRTFILE CR 00130I 74 79 CRMENU 00140C******************************************************************** 00150C MOVE ' ' BLK8 8 00160C MOVE ' ' W8A 8 00170C Z-ADD0 W1N 10 00180C Z-ADD0 W2N 20 00190C MOVE ' ' W2A 2 00200C EXITFPGMINX 00210C RLABL W8A 00220C RLABL W2N 00230C RLABL W1N 00240C RLABL W2A 00250C MOVE W2A PORT 20 ÐÐ00260C PORT COMP 0 54 00270C N54 Z-ADD25 PORT 00280C PORT CHAINCRTFILE H9 00290C H9 GOTO END 00300C MOVELCRMENU PROG 8 00310C PROG COMP BLK8 54 00320C N54 MOVEL'GOODBY' PROG 00330C EXITFCHAIN 00340C RLABL PROG 00350C*------------------------------------------------------------------- 00360C END TAG /* 000370_‚ _‚_‚0C MOVE ' ' W8A 8 00170C Z-ADD0 W1N 10 00180C Z-ADD0 W2N 20 00190C MOVE ' ' W2A 2 00200C EXITFPGMINX 00210C RLABL W8A 00220C RLABL W2N 00230C RLABL W1N 00240C RLABL W2A 00250C MOVE W2A PORT 20 ÐÈ((  (X072DP P120282120282(èÈÐ00010H Q072DP00020F* ACCESS FILE CONTROL BLOCK & WRITE TO DISK FILE VTOC. (X072DP) 00030F* REVISED 11/30/79 11:05 AM. 00040FBITTAB IP F 33 DISK 00050FVTOC O F 192 DISK A 00060E******************************************************************** 00070E AR 1 192 1 00080E BIT 33 1 00090I******************************************************************** 00100IBITTAB BT 00110I 1 33 BIT 00120C******************************************************************** 00130C MOVE ' ' IRPG 98 00140C*------------------------------------------------------------------- 00150C START TAG 00160C EXITFQGVTOC 00170C RLABL IRPG 00180C MOVEAIRPG AR 00190C MOVE 'SYSVOL' IVOL 8 00200C EXITFQGVTOC 00210C RLABL IRPG 00220C RLABL IVOL 00230C MOVEAIRPG AR,97 00240C TESTB'0' AR,49 54 00250C 54 GOTO END ÐÐ00260C SETON 80 00270C EXCPT 00280C SETOF 80 00290C GOTO START 00300C*------------------------------------------------------------------- 00310C END TAG 00320O******************************************************************** 00330OVTOC EADD 80 00340O AR 192 ** AR ARRAY 000350 000360/* 000370_‚ _‚_‚0C EXITFQGVTOC 00170C RLABL IRPG 00180C MOVEAIRPG AR 00190C MOVE 'SYSVOL' IVOL 8 00200C EXITFQGVTOC 00210C RLABL IRPG 00220C RLABL IVOL 00230C MOVEAIRPG AR,97 00240C TESTB'0' AR,49 54 00250C 54 GOTO END ÐÈ(# # #X073DP P120282120282(èÈÐ00010H Q073DP00020F* READ/PRINT VTOC FILE. (X073DP) 00030FVTOCSRT IP F 192 DISK 00040FPRINT O F 132 OF PRINTER 00050I******************************************************************** 00060IVTOCSRT VT 00070I* MAXIMUM # RECORDS 3B 00080I B 4 60VMXREC 00090I* STARTING SECTOR 3B 00100I B 8 100VSTSEC 00110I* SWITCHES 2A 00120I* BIT-15 00130I* 0 = NOT SECTOR ALIGNED 00140I* 1 = SECTOR ALIGNED 00150I* BIT-13 00160I* 0 = CLOSED 00170I* 1 = OPEN 00180I* BIT-8 00190I* 0 = BINARY FILE 00200I* 1 = ASCII 00210I* BIT-0 00220I* 0 = SEQUENTIAL 00230I* 1 = INDEXED 00240I 11 12 VSWTCH 00250I* NO. ACTUAL RECORDS 4B ÐÐ00260I B 13 160VACREC 00270I* KEY LENGTH 2B 00280I B 29 300VKYLEN 00290I* FILE NAME 8A 00300I 49 56 VFLNAM 00310I* OWNER 8A 00320I 57 64 VOWNER 00330I* RECORD LENGTH 2B 00340I B 65 660VRCLEN /* 000350_‚_‚0I* SWITCHES 2A 00120I* BIT-15 00130I* 0 = NOT SECTOR ALIGNED 00140I* 1 = SECTOR ALIGNED 00150I* BIT-13 00160I* 0 = CLOSED 00170I* 1 = OPEN 00180I* BIT-8 00190I* 0 = BINARY FILE 00200I* 1 = ASCII 00210I* BIT-0 00220I* 0 = SEQUENTIAL 00230I* 1 = INDEXED 00240I 11 12 VSWTCH 00250I* NO. ACTUAL RECORDS 4B ÐÈ(KU… K X081DP Pžî082383082383(èÈÐ00010H Q081DP00020F* BUILD MFG DAY CALENDAR. (X081DP) 5 DAY 00030F* REVISED 8/23/81 1:00 PM. 00040FCALENDARIP F 22 7AI 1 DISK 00050FMDAYCL5 O F 154 DISK 00060E******************************************************************** 00070E CAL 1 25 2 00080E MFG 1 25 4 00090E WM 1 7 4 00100E WC 1 7 2 00110I******************************************************************** 00120ICALENDARCL 01 1 CC 00130I 2 70CACAL 00140I 2 30CAYEAR 00150I 2 50CAYRMOL1 00160I 4 50CAMO 00170I 6 70CADAY 00180I 14 170CAMDAY 00190I 18 200CAWEEK 00200I 21 220CADOW 00210I*----------------------------------------------------------------- 00220I GG 02 00230C******************************************************************** 00240C N01 GOTO END NOT CAL DATE RECORD 00250C N79 Z-ADD-4 W ÐÐ00260C SETON 79 00270C CADOW COMP 3 54 54 00280C 54 CADOW COMP 7 5454 00290C N54 GOTO END 00300C Z-ADDCADOW D 30 00310C MOVE CADAY WC,D 00320C MOVE CAMDAY WM,D 00330C WM,D COMP LSTMFG 54 00340C N54 MOVE '0000' WM,D 00350C 54 MOVE CAMDAY LSTMFG 4 00360C SETON 70 00370C D COMP 7 54 00380C 54 70 5 ADD W W 30 00390C 54 70 MOVEAWC,3 W10A 10 00400C 54 70 MOVEAW10A CAL,W 00410C 54 70 MOVEAWM,3 W20A 20 00420C 54 70 MOVEAW20A MFG,W 00430C 54 70 MOVE '00' WC 00440C 54 70 MOVE '0000' WM 00450C 54 70 SETON 75 00460C 54 70 SETOF 70 00470C*---------------------------------------------------------------- 00480C END TAG 00490CL1 70 MOVEAWC,3 W10A 00500CL1 70 5 ADD W W ÐÐ00510CL1 70 MOVEAW10A CAL,W 00520CL1 70 MOVEAWM,3 W20A 00530CL1 70 MOVEAW20A MFG,W 00540CL1 70 SETON 75 00550CL1 75 SETON 71 00560CL1 75 EXCPT 00570CL1 75 SETOF 71 00580CL1 MOVE '0000' WM 00590CL1 MOVE '00' WC 00600CL1 SETOF 75 00610CL1 Z-ADD-4 W 30 00620O******************************************************************* 00630OMDAYCL5 E 71 00640O CAYRMO 4 00650O MFG B 104 00660O CAL B 154 ** CAL ARRAY 000670 000680** MFG ARRAY 00690 00700** WM ARRAY 000710 000720** WC ARRAY 000730 000740/* 000750ÐÐ_‚_‚0CL1 70 MOVEAW10A CAL,W 00520CL1 70 MOVEAWM,3 W20A 00530CL1 70 MOVEAW20A MFG,W 00540CL1 70 SETON 75 00550CL1 75 SETON 71 00560CL1 75 EXCPT 00570CL1 75 SETOF 71 00580CL1 MOVE '0000' WM 00590CL1 MOVE '00' WC 00600CL1 SETOF 75 00610CL1 Z-ADD-4 W 30 00620O******************************************************************* 00630OMDAYCL5 E 71 00640O CAYRMO 4 00650O MFG B 104 00660O CAL B 154 ** CAL ARRAY 000670 000680** MFG ARRAY 00690 00700** WM ARRAY 000710 000720** WC ARRAY 000730 000740/* 000750ÐÈ(2 s 2X075DP P120282120282(èÈÐ00010H Q075DP00020F* PROGRAM PROVIDES A HALT IN JOB STREAM. (X075DP) 00030F* 1/24/80 3:40 PM. 00040F* 'N' REPLY SIGNS OFF TERMINAL. 00050F* ANY OTHER REPLY CONTINUES JOB. 00060FBITTAB IP F 33 DISK 00070FTERM30 O F 30 5 00080E******************************************************************** 00090E BIT 33 1 00100I******************************************************************** 00110IBITTAB BT 00120I 1 33 BIT 00130C******************************************************************** 00140C MOVE ' ' W2A 2 00150C EXCPT 00160C MOVELBIT,1 BUFLGT 2 00170C MOVE BIT,2 BUFLGT 00180C EXITFQWREED 00190C RLABL W2A 00200C RLABL BUFLGT 00210C MOVELW2A W1A 1 00220C W1A COMP 'N' 54 00230C N54 MOVE W2A W1A 00240C N54 W1A COMP 'N' 54 00250C N54 GOTO END ÐÐ00260C MOVEL'GOODBY' PROG 8 00270C EXITFCHAIN 00280C RLABL PROG 00290C*------------------------------------------------------------------- 00300C END TAG 00310O******************************************************************** 00320OTERM30 E 00330O 24 'ENTER "N" TO DISCONTINUE' 00340O 28 'JOB' /* 000350_‚ ÐÐ_‚_‚0C MOVEL'GOODBY' PROG 8 00270C EXITFCHAIN 00280C RLABL PROG 00290C*------------------------------------------------------------------- 00300C END TAG 00310O******************************************************************** 00320OTERM30 E 00330O 24 'ENTER "N" TO DISCONTINUE' 00340O 28 'JOB' /* 000350_‚ ÐÈ(d ‰ d*X076DP P120282120282(èÈÐ00010H Q076DP00020F* LIST RPG CALCS BY OPER, FACT-1,-2, OR RESULT. (X076DP) 00030F* REVISED 4/02/81 11:55 AM. 00040FEDPIN IP F 80R I DISK 00050FEDPADRT IR F 300 3 3IT EDISK 00060FPRINT O F 132 PRINTER 00070E******************************************************************** 00080E EDPADRT EDPIN 00090I******************************************************************** 00100IEDPIN EP 01 7NC* 00110I 28 32 OPER L4 00120I 18 27 FACT1 L3 00130I 33 42 FACT2 L2 00140I 43 48 RESULTL1 00150I 1 80 REC 00160I GG 02 00170O******************************************************************** 00180OPRINT D 1 01 L1 00190O 1 ' ' 00200O*------------------------------------------------------------------- 00210O D 1 01 00220O REC 80 /* 000230_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( ´  X078DP P120282120282(èÈÐ00010H Q078DP00020F* INIT ORDERLOG FILE - D A N G E R 00030F* REVISED 07-09-81 2-18 PM 00040FBITTAB IP F 33 DISK 00050FORDERLOGO F 32 13AI 1 DISK U 00060I******************************************************************* 00070IBITTAB BT 01 00080I 1 33 BIT 00090C******************************************************************** 00100O***************************************************************** 00110OORDERLOGD 01 00120O 6 '$\CONT' 00130O******************************************************************** /* 000140_‚ ÐÐ_‚_‚0H Q078DP00020F* INIT ORDERLOG FILE - D A N G E R 00030F* REVISED 07-09-81 2-18 PM 00040FBITTAB IP F 33 DISK 00050FORDERLOGO F 32 13AI 1 DISK U 00060I******************************************************************* 00070IBITTAB BT 01 00080I 1 33 BIT 00090C******************************************************************** 00100O***************************************************************** 00110OORDERLOGD 01 00120O 6 '$\CONT' 00130O******************************************************************** /* 000140_‚ ÐÈ( À  X079DP P120282120282(èÈÐ00010H Q079DP00020F* GENERATE BIT44 FILE - BIT 44 MUST BE EMPTY TO RUN. (X079DP) 00030F* REVISED 4/28/81 2:15 PM. 00040FBITHEX IP F 256 DISK 00050FBIT44 O F 44 DISK 00060I******************************************************************** 00070IBITHEX BT 01 00080I 1 44 BIT 00090O******************************************************************** 00100OBIT44 D 01 00110O BIT 44 /* 000120_‚ _‚_‚ ÐÈ(K Ê K X080RX P120282120282(èÈÐ00010H Q080RX00020F* UTILITY - DISPLAY REXTPTR FILE LINE # AND POINTER DG REL006 OK 00030F* REVISED 7/30/80 12:10 PM. 00040FBITTAB IP F 33 DISK 00050FREXTPTR ID F 25L21AI 1 DISK 00060FREXTFILEIC F 90R DISK 00070FTERM132 O F 132 5 00080E******************************************************************** 00090E A6 1 6 1 00100E BIT 33 1 00110I******************************************************************** 00120IBITTAB BT 00130I 1 33 BIT 00140I******************************************************************** 00150IREXTPTR TP 00160I 1 12 TPPN 00170I 13 150TPSEQ 00180I 16 210TPLINE 00190I P 22 250TPPTR 61 00200I******************************************************************** 00210IREXTFILERF 00220I 22 81 TXT 00230C******************************************************************** 00240C MOVE ' ' BLK6 6 00250C MOVE ' ' BLK21 21 ÐÐ00260C MOVE BIT,1 A6 00270C*------------------------------------------------------------------- 00280C START TAG 00290C MOVE BIT,12 A6,2 00300C MOVE BLK21 W21A 21 00310C MOVEAA6 W6A 6 00320C EXITFQWREED 00330C RLABL W21A 00340C RLABL W6A 00350C W21A SETLLREXTPTR 00360C*------------------------------------------------------------------- 00370C CONTU TAG 00380C SETOF 54 00390C READ REXTPTR 54 00400C 54 GOTO START 00410C TPPTR COMP 0 54 00420C 54 TPPTR CHAINREXTFILE 55 00430C EXCPT 00440C 1 ADD COUNT COUNT 50 00450C COUNT COMP 25 54 54 00460C N54 GOTO CONTU 00470C EXITFQPAUSE 00480C RLABL W6A 00490C W6A COMP BLK6 54 00500C Z-ADD0 COUNT ÐÐ00510C N54 GOTO CONTU 00520C GOTO START 00530C*------------------------------------------------------------------- 00540C END TAG 00550O******************************************************************** 00560OTERM132 E 54 00570O TPPN 12 00580O TPSEQ Z 18 00590O TPLINEZ 26 00600O TPPTR Z 35 00610O N55 TXT B 100 ** A6 000620 000630/* 000640_‚ ÐÐ_‚_‚0C N54 GOTO CONTU 00520C GOTO START 00530C*------------------------------------------------------------------- 00540C END TAG 00550O******************************************************************** 00560OTERM132 E 54 00570O TPPN 12 00580O TPSEQ Z 18 00590O TPLINEZ 26 00600O TPPTR Z 35 00610O N55 TXT B 100 ** A6 000620 000630/* 000640_‚ ÐÈ(– ë –?X080VT P120282120282(èÈÐ00010H Q080VT00020F* LIST VTOC. (X080VT) (NOTE: WAS X080DP) 00030F* REVISED 1/12/81 10:45 AM. 00040FSTATUSPTIP F 136 DISK 00050FPRINT O F 132 OF PRINTER 00060E TABHEX 1 16 1 TABNUM 2 0 00070E DIG 1 5 2 0 00080E ANS 1 5 6 0 00090E SEC 5 1 00100ISTATUSPTSP 01 00110I* FILE NAME 8A 00120I 6 13 FILNAM 00130I* FILE DATE 6N 00140I 25 300FILDAT 00150I* FILE TYPE 1A (D,R,S,B) 00160I 34 34 FILTYP 00170I* RECORD LGTH 4N 00180I 40 430FILLGT 00190I* KEY LGTH 2N 00200I 47 480KEYLGT 00210I* KEY POSITION 4N 00220I 50 530KEYPOS 00230I* STARTING SECTOR 5A(HEX) 00240I 85 89 SECTOR 00250I 85 89 SEC ÐÐ00260I* RECORD COUNT 6N 00270I 92 970RECCNT 00280I* EXPIRATION DATE 6N 00290I 99 1040EXPDAT 00300I* MAX RECORDS 00310I 109 1140MAXREC 00320I* FILE STATUS 6A 00330I 116 121 FILSTS 00340I* SECTOR ALIGNED 1A (Y,N) 00350I 124 124 SECALG 00360C N70 SETOF 01 00370C N70 GOTO END 00380C MOVELSECTOR W2A 2 00390C W2A COMP 'ST' 54 00400C N54 W2A COMP 'CT' 54 00410C 54 SETOF 01 00420C 54 GOTO END 00430C MOVELSECTOR W1A 1 00440C W1A COMP LSTW1A 71 00450C MOVE W1A LSTW1A 1 00460C MOVE ' ' W6A 6 00470C MOVELFILNAM PREFIX 1 00480C PREFIX COMP 'X' 73 00490C RECCNT COMP MAXREC 72 00500C MAXREC MULT FILLGT BYTES 80 ÐÐ00510C BYTES DIV 192 W10D4 104H 00520C MOVELW10D4 NOSEC 60 00530C MOVE W10D4 W4N 40 00540C W4N COMP 0 54 00550C 54 1 ADD NOSEC NOSEC 00560C Z-ADD1 X 20 00570C EXSR SR101 00580C Z-ADD2 X 00590C EXSR SR101 00600C Z-ADD3 X 00610C EXSR SR101 00620C Z-ADD4 X 00630C EXSR SR101 00640C Z-ADD5 X 00650C EXSR SR101 00660C DIG,5 MULT 1 ANS,5 00670C DIG,4 MULT 16 ANS,4 00680C DIG,3 MULT 256 ANS,3 00690C DIG,2 MULT 4096 ANS,2 00700C DIG,1 MULT 65536 ANS,1 00710C XFOOTANS BEGSEC 60 00720C BEGSEC SUB ENDSEC GAP 60 00730C NOSEC ADD BEGSEC ENDSEC 60 00740C END TAG 00750C SETON 70 ÐÐ00760CSR SR101 BEGSR 00770CSR SEC,X LOKUPTABHEX TABNUM 54 00780CSR Z-ADDTABNUM DIG,X 00790CSR ENDSR 00800OPRINT H 201 1P 00810O OR OF 00820O UDATE Y 8 00830O 70 'VTOC LIST' 00840O PAGE Z 132 00850O H 2 1P 00860O OR OF 00870O 9 'FILE NAME' 00880O 20 'FILE DATE' 00890O 32 'FILE TYPE' 00900O 44 'FILE LGTH' 00910O 56 'KEY LGTH' 00920O 68 'KEY POS' 00930O 82 'SEC-START' 00940O 104 'SEC-END' 00950O 115 'REC-COUNT' 00960O 124 'MAX' 00970O 132 'GAP' 00980O D 1 01 00990O FILNAM 8 01000O N73 10 '**' ÐÐ01010O FILDATY 20 01020O FILTYP 30 01030O FILLGT2 44 01040O KEYLGTZ 56 01050O KEYPOS2 68 01060O BEGSEC2 82 01070O SECTOR 89 01080O ENDSEC2 104 01090O RECCNT2 115 01100O N72 117 '**' 01110O MAXREC2 124 01120O 71 GAP 2 132 ** TABHEX/TABNUM 001130000 001140101 001150202 001160303 001170404 001180505 001190606 001200707 001210808 001220909 001230A10 001240B11 001250ÐÐC12 001260D13 001270E14 001280F15 001290** DIG ARRAY 001300 001310** ANS ARRAY 001320 001330/* 001340_‚ ÐÐ_‚_‚ 001260D13 001270E14 001280F15 001290** DIG ARRAY 001300 001310** ANS ARRAY 001320 001330/* 001340_‚ ÐÈ(d + d*X082RX P120282120282(èÈÐ00010H Q082RX00020F* REORG ROUTING TEXT FILE. (X082RX) 00030F* REVISED 12/10/81 11:45 AM. 00040F* NOTE: THIS PROG RUN AS PART OF PROCEDURE - Z900RM. 00050F* SEE ALSO PROCEDURE - ZRXORG. 00060FPTROUT UP F 25 21AI 1 DISK 00070FREXTFILEIC F 90R DISK 00080FNEWREXT UC F 90R DISK 00090FNEWRXCNTUC F 16R DISK 00100F******************************************************************* 00110IPTROUT TP 00120I 1 15 TPNAME 00130I 16 210TPLINE 00140I P 22 250TPPTR 05 00150I**************************************************************** 00160IREXTFILETX 00170I 22 81 TXT 00180I*********************************************************** 00190INEWREXT NR 00200I 1 90 NREC 00210I*************************************************************** 00220INEWRXCNTNX 00230I 1 16 NRXT 00240C******************************************************************* 00250C Z-ADD0 ZERO7 70 ÐÐ00260C 05 1 ADD COUNT COUNT 70 00270C 05 COUNT CHAINNEWREXT H9 00280C 05 TPPTR CHAINREXTFILE 55 00290C 05N55 SETON 80 00300C 05N55 EXCPT UPDATE NEWREXT 00310C 05N55 SETOF 80 00320CLR Z-ADD1 RRN 50 00330CLR RRN CHAINNEWRXCNT H8 00340CLR SETON 81 00350CLR EXCPT 00360CLR SETOF 81 00370O***************************************************************** 00380ONEWREXT E 80NH9 00390O TPNAME 15 00400O TPLINE 21 00410O TXT 81 00420O ZERO7 85P 00430O 90 ' ' 00440O******************************************************************** 00450ONEWRXCNTE 81NH8 00460O COUNT 7 00470O ZERO7 14 00480O******************************************************************** 00490OPTROUT D 05NH9 00500O COUNT 25P ÐÐ/* 000510_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(2 V 2X081VT P120282120282(èÈÐ00010H Q081VT00020F* LIST SPOOLER FILE. (X081VT) (NOTE: WAS X081DP) 00030F* REVISED 1/12/81 10:45 AM. 00040FSTATUSPTIP F 136 DISK 00050FPRINT O F 132 PRINTER 00060ISTATUSPTSP 01 00070I 6 134 REC 00080OPRINT D 01 00090O REC 132 /* 000100_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(2 l 2X020XP P999999120282(èÈÐ00010H Q020XP00020F* UPDATE FORECAST BALANCE IN PMMST2. (X020XP) 00030F* REVISED 12-18-81 3:45 PM. 00031F* NOTE: THIS PROGRAM RUN IN JOB ZXP020. SEE ALSO X019XP. 00040FXPMAST IP F 99 22AI 1 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060E******************************************************************** 00070E XPQ 18 7 0 00080I******************************************************************** 00090IXPMAST XP 01 99NCD 00100I* PART # 10N 00110I 3 120XPPN 00120I* QTY ARRAY 18 X 7P 00130I P 23 94 XPQ 00140I*------------------------------------------------------------------- 00150I GG 02 00160I******************************************************************** 00170IPMMST2 PM 00180I P 315 3180PMFRCB 00190C******************************************************************** 00200C N01 GOTO END 00210C MOVELXPPN W12A 12 00220C MOVE ' ' W12A 00230C W12A CHAINPMMST2 54 00240C 54 SETOF 01 ÐÐ00250C 54 GOTO END 00260C XFOOTXPQ W7N 70 00270C W7N ADD PMFRCB PMFRCB 00280C*------------------------------------------------------------------- 00290C END TAG 00300O******************************************************************** 00310OPMMST2 D 01 00320O PMFRCB 318P /* 00330_‚ ÐÐ_‚_‚0C 54 GOTO END 00260C XFOOTXPQ W7N 70 00270C W7N ADD PMFRCB PMFRCB 00280C*------------------------------------------------------------------- 00290C END TAG 00300O******************************************************************** 00310OPMMST2 D 01 00320O PMFRCB 318P /* 00330_‚ ÐÈ(È ‚ ÈTX082VT P120282120282(èÈÐ00010H Q082VT00020F* CONDENSE DISK FILES. (X082VT) 00030F* REVISED 1/12/81 11:15 AM. 00040F* SWITCH-1 = PACK D1 00050F* SWITCH-2 = PACK D2 00060F* SWITCH-3 = SYSVOL 00070FSTATUSPTIP F 136 DISK 00080FZNEWVTOCO F 80 DISK 00090FTERM80 O F 80 5 00100ISTATUSPTSP 02 00110I* FILE NAME 8A 00120I 6 13 FILNAM 00130I* FILE OWNER 8A 00140I 15 22 FILOWN 00150I* FILE DATE 6N 00160I 25 300FILDAT 00170I* FILE TYPE 1A (D,R,S,B) 00180I 34 34 FILTYP 00190I* RECORD LGTH 4N 00200I 40 430FILLGT 00210I* KEY LENGTH 2N 00220I 47 480KEYLGT 00230I* KEY POSITION 4N 00240I 50 530KEYPOS 00250I* STARTING SECTOR 5A (HEX) ÐÐ00260I 85 89 SECTOR 00270I 85 89 SEC 00280I* RECORD COUNT 6N 00290I 92 970RECCNT 00300I* EXPIRATION DATE 6N 00310I 99 1040EXPDAT 00320I* MAX RECORDS 6N 00330I 109 1140OLDMAX 00340I* FILE STATUS 6A 00350I 116 121 FILSTS 00360I* SECTOR ALIGNED 1A (Y,N) 00370I 124 124 SECALG 00380C******************************************************************** 00390C N79 SETON 85 00400C N79 EXCPT 00410C N79 SETOF 85 00420C N79 EXITFQPAUSE 00430C SETON 79 00440C N02 GOTO END 00450C FILOWN COMP ' ' 02 00460C N02 GOTO END 00470C MOVELFILNAM W1A 1 00480C W1A COMP ' ' 54 00490C N54 SETOF 02 00500C N54 GOTO END ÐÐ00510C N71 EXSR SR80 00520C EXSR SR81 00530C*------------------------------------------------------------------- 00540C END TAG 00550CLR EXSR SR82 00560C******************************************************************** 00570CSR SR80 BEGSR 00580C* PUT UTIL COMMAND (1-TIME). 00590CSR SETON 8071 00600CSR EXCPT 00610CSR SETOF 80 00620CSR ENDSR 00630C******************************************************************** 00640CSR SR81 BEGSR 00650C* PUT INSTR STMT. 00660CSR FILTYP COMP 'R' 84 00670CSR SETON 81 00680CSR EXCPT 00690CSR SETOF 81 00700CSR ENDSR 00710C******************************************************************** 00720CSR SR82 BEGSR 00730C* PUT EXIT STMT. 00740CSR SETON 82 00750CSR EXCPT ÐÐ00760CSR SETOF 82 00770CSR ENDSR 00780O******************************************************************** 00790OTERM80 E 85 00800O 25 'SWITCH-1 = D1' 00810O E 85 00820O 25 'SWITCH-2 = D2' 00830O E 85 00840O 25 'SWITCH-3 = SYSVOL' 00850O E 85 00860O 19 'ARE SWITCHES RIGHT?' 00870O******************************************************************** 00880OZNEWVTOCE 80 00890O 14 'INPUT=ZNEWVTOC' 00900O E 80 00910O 4 'UTIL' 00920O E 80 00930O 19 'DEFINE,FN=VTOCCOPY,' 00940O 24 'NR=1,' 00950O 29 'TY=S,' 00960O 38 'VL=D2 ' 00970O E 80 00980O 2 'EX' 00990O*------------------------------------------------------------------- 01000O E 81 ÐÐ01010O 2 '*' 01020O FILNAM 12 01030O E 81 01040O 14 'INPUT=ZNEWVTOC' 01050O E 81 01060O 4 'UTIL' 01070O E 81 01080O 18 'DELETE,FN=VTOCCOPY' 01090O E 81 01100O 19 'DEFINE,FN=VTOCCOPY,' 01110O 22 'NR=' 01120O OLDMAX 28 01130O 32 ',TY=' 01140O FILTYP 33 01150O 45 ',VL=SCRATCH,' 01160O 48 'LR=' 01170O FILLGT 52 01180O 84 56 ',K1=' 01190O 84 KEYLGT 58 01200O 84 62 ',P1=' 01210O 84 KEYPOS 66 01220O E 81 01230O 8 'COPY,FN=' 01240O FILNAM 16 01250O 28 ',F2=VTOCCOPY' ÐÐ01260O E 81 01270O 10 'DELETE,FN=' 01280O FILNAM 18 01290O E 81 01300O 10 'DEFINE,FN=' 01310O FILNAM 18 01320O 22 ',NR=' 01330O OLDMAX 28 01340O 32 ',TY=' 01350O FILTYP 33 01360O U1 39 ',VL=D1' 01370O U2 39 ',VL=D2' 01380O U3 43 ',VL=SYSVOL' 01390O NU3 43 ',LR=' 01400O NU3 FILLGT 47 01410O 84NU3 51 ',K1=' 01420O 84NU3 KEYLGT 53 01430O 84NU3 57 ',P1=' 01440O 84NU3 KEYPOS 61 01450O U3 47 ',LR=' 01460O U3 FILLGT 51 01470O U3 84 55 ',K1=' 01480O U3 84 KEYLGT 57 01490O U3 84 61 ',P1=' 01500O U3 84 KEYPOS 65 ÐÐ01510O E 81 01520O 20 'COPY,FN=VTOCCOPY,F2=' 01530O FILNAM 28 01540O E 81 01550O 2 'EX' 01560O*------------------------------------------------------------------- 01570O E 82 01580O 14 'INPUT=ZNEWVTOC' 01590O E 82 01600O 4 'UTIL' 01610O E 82 01620O 18 'DELETE,FN=VTOCCOPY' 01630O E 82 01640O 2 'EX' 01650O E 82 01660O 14 'INPUT=TERMINAL' /* 001670_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(d × d*X083DP P120282120282(èÈÐ00010H Q083DP00020F* BUILD MFG DAY CALENDAR. (X083DP) 00030F* REVISED 4/27/81 5:00 PM. 00040FCALENDARIP F 22 7AI 1 DISK 00050FMDAYCAL O F 124 DISK 00060E******************************************************************** 00070E CAL 1 20 2 00080E MFG 1 20 4 00090E WM 1 7 4 00100E WC 1 7 2 00110I******************************************************************** 00120ICALENDARCL 01 1 CC 00130I 2 70CACAL 00140I 2 30CAYEAR 00150I 2 50CAYRMOL1 00160I 4 50CAMO 00170I 6 70CADAY 00180I 14 170CAMDAY 00190I 18 200CAWEEK 00200I 21 220CADOW 00210I*----------------------------------------------------------------- 00220I GG 02 00230C******************************************************************** 00240C N01 GOTO END NOT CAL DATE RECORD 00250C N79 Z-ADD-3 W ÐÐ00260C SETON 79 00270C CADOW COMP 3 54 54 00280C 54 CADOW COMP 6 5454 00290C N54 GOTO END 00300C Z-ADDCADOW D 30 00310C MOVE CADAY WC,D 00320C MOVE CAMDAY WM,D 00330C WM,D COMP LSTMFG 54 00340C N54 MOVE '0000' WM,D 00350C 54 MOVE CAMDAY LSTMFG 4 00360C SETON 70 00370C D COMP 6 54 00380C 54 70 4 ADD W W 30 00390C 54 70 MOVEAWC,3 W8A 8 00400C 54 70 MOVEAW8A CAL,W 00410C 54 70 MOVEAWM,3 W16A 16 00420C 54 70 MOVEAW16A MFG,W 00430C 54 70 MOVE '00' WC 00440C 54 70 MOVE '0000' WM 00450C 54 70 SETON 75 00460C 54 70 SETOF 70 00470C*---------------------------------------------------------------- 00480C END TAG 00490CL1 70 MOVEAWC,3 W8A 8 00500CL1 70 4 ADD W W ÐÐ00510CL1 70 MOVEAW8A CAL,W 00520CL1 70 MOVEAWM,3 W16A 00530CL1 70 MOVEAW16A MFG,W 00540CL1 70 SETON 75 00550CL1 75 SETON 71 00560CL1 75 EXCPT 00570CL1 75 SETOF 71 00580CL1 MOVE '0000' WM 00590CL1 MOVE '00' WC 00600CL1 SETOF 75 00610CL1 Z-ADD-3 W 30 00620O******************************************************************* 00630OMDAYCAL E 71 00640O CAYRMO 4 00650O MFG B 84 00660O CAL B 124 ** CAL ARRAY 000670 000680** MFG ARRAY 00690 00700** WM ARRAY 000710 000720** WC ARRAY 000730 000740/* 000750ÐÐ_‚ ÐÐ_‚_‚ ÐÈ(ú  úiX084DP PÔÔ120282120282(èÈÐ00010H Q084DP00020F* DISPLAY MFG DAY CALENDAR. (X084DP) 5-DAY WEEK 00030F* REVISED 4/25/81 5:05 PM. DG-REL006 OK. * D I A B L O * 00040FBITTAB IP F 33 DISK 00050FMDAYCAL IS F 124 DISK 00060FCRTFILE UC F 256R DISK 00070E******************************************************************** 00080E MFG 20 4 0 00090E CAL 20 2 0 00100E BIT 33 1 00110E REC 132 1 00120I******************************************************************** 00130IBITTAB BT 01 00140I 1 33 BIT 00150I****************************************************************** 00160ICRTFILE CR 00170I 81 212 REC 00180I******************************************************************** 00190IMDAYCAL MD 02 00200I 1 20YEAR 00210I 3 40MONTH 00220I 5 84 MFG 00230I 85 124 CAL 00240C******************************************************************** 00250C 01 GOTO END ÐÐ00260C 69 GOTO TAG10 00270C* GET PORT # AND CRTFILE. 00280C MOVE '08' W2A 2 00290C EXITFZVMI SET VERTICAL SPAC 00300C RLABL W2A 00310C MOVE '15' W2A 00320C EXITFZHMI SET HORIZ SPAC 00330C RLABL W2A 00340C MOVE ' ' W8A 8 00350C Z-ADD0 W2N 20 00360C Z-ADD0 W1N 10 00370C MOVE ' ' W2A 2 00380C EXITFPGMINX GET PORT #. 00390C RLABL W8A 00400C RLABL W2N 00410C RLABL W1N 00420C RLABL W2A 00430C MOVE W2A PORT 20 PORT NO. 00440C PORT COMP 0 54 00450C N54 Z-ADD25 PORT DEFAULT 00460C EXITFZTFORM TOP FORM 00470C EXITFQBELL RING BELL 00480C EXITFQPAUSE PAUSE 00490C EXITFZTFORM TOP FORM 00500C SETON 41 ÐÐ00510C EXSR SR69 PUT HEADING 00520C EXSR SR68 LF 00530C SETON 42 00540C EXSR SR69 00550C SETON 43 00560C EXSR SR69 00570C SETON 44 00580C EXSR SR69 00590C Z-ADD5 COUNT 30 00600C SETON 69 00610C*------------------------------------------------------------------- 00620C TAG10 TAG 00630C SETON 46 00640C EXSR SR69 PUT CAL DATES 00650C SETON 47 00660C EXSR SR69 00670C SETON 44 00680C EXSR SR69 00690C COUNT COMP 60 54 00700C N54 GOTO END 00710C EXITFZTFORM 00720C SETON 41 00730C EXSR SR69 PUT NEW PAGE 00740C EXSR SR68 LF 00750C SETON 42 ÐÐ00760C EXSR SR69 00770C SETON 43 00780C EXSR SR69 00790C SETON 44 00800C EXSR SR69 00810C Z-ADD5 COUNT 00820C*------------------------------------------------------------------- 00830C END TAG 00840CLR EXITFZTFORM TOP FORM 00850CLR EXITFZTFORM TOP FORM 00860C******************************************************************** 00870CSR SR68 BEGSR 00880C* LF/CR. 00890CSR EXITFQCLF 00900CSR 1 ADD COUNT COUNT 00910CSR ENDSR 00920C******************************************************************** 00930CSR SR69 BEGSR 00940C* PUT DATA TO DIABLO. 00950CSR EXSR SR68 LF 00960CSR PORT CHAINCRTFILE H9 00970CSR H9 GOTO T69A 00980CSR MOVE ' ' REC 00990CSR EXCPT UPDATE CRTFILE 01000CSR PORT CHAINCRTFILE H9 ÐÐ01010CSR H9 GOTO T69A 01020CSR MOVEAREC W132A 132 01030CSR EXITFZD132B PUT DIABLO 01040CSR RLABL W132A 01050C*------------------------------------------------------------------- 01060CSR T69A TAG 01070CSR SETOF 414243 01080CSR SETOF 444647 01090CSR END69 ENDSR 01100O******************************************************************** 01110OCRTFILE E 41 01120O REC 212 01130O 135 'M A N U F A C T U R I N ' 01140O 137 'G' 01150O 145 'D A Y' 01160O 163 'C A L E N D A R' 01170O*------------------------------------------------------------------- 01180O E 42 01190O REC 212 01200O 85 'YR-MO' 01210O 89 '*' 01220O 105 'W E E K - 1' 01230O 114 '*' 01240O 130 'W E E K - 2' 01250O 139 '*' ÐÐ01260O 155 'W E E K - 3' 01270O 164 '*' 01280O 180 'W E E K - 4' 01290O 189 '*' 01300O 205 'W E E K - 5' 01310O*------------------------------------------------------------------- 01320O E 43 01330O REC 212 01340O 94 'MON' 01350O 100 'TUE' 01360O 106 'WED' 01370O 112 'THU' 01380O 119 'MON' 01390O 125 'TUE' 01400O 131 'WED' 01410O 137 'THU' 01420O 144 'MON' 01430O 150 'TUE' 01440O 156 'WED' 01450O 162 'THU' 01460O 169 'MON' 01470O 175 'TUE' 01480O 181 'WED' 01490O 187 'THU' 01500O 194 'MON' ÐÐ01510O 200 'TUE' 01520O 206 'WED' 01530O 212 'THU' 01540O 89 '*' 01550O 114 '*' 01560O 139 '*' 01570O 164 '*' 01580O 189 '*' 01590O*------------------------------------------------------------------- 01600O E 44 01610O REC 212 01620O 89 '*' 01630O 114 '*' 01640O 139 '*' 01650O 164 '*' 01660O 189 '*' 01670O*------------------------------------------------------------------- 01680O E 46 01690O REC 212 01700O YEAR Z 82 01710O MONTH Z 85 01720O 83 '-' 01730O MFG,1 Z 94 01740O MFG,2 Z 100 01750O MFG,3 Z 106 ÐÐ01760O MFG,4 Z 112 01770O MFG,5 Z 119 01780O MFG,6 Z 125 01790O MFG,7 Z 131 01800O MFG,8 Z 137 01810O MFG,9 Z 144 01820O MFG,10Z 150 01830O MFG,11Z 156 01840O MFG,12Z 162 01850O MFG,13Z 169 01860O MFG,14Z 175 01870O MFG,15Z 181 01880O MFG,16Z 187 01890O MFG,17Z 194 01900O MFG,18Z 200 01910O MFG,19Z 206 01920O MFG,20Z 212 01930O 89 '*' 01940O 114 '*' 01950O 139 '*' 01960O 164 '*' 01970O 189 '*' 01980O*------------------------------------------------------------------- 01990O E 47 02000O REC 212 ÐÐ02010O CAL,1 Z 94 02020O CAL,2 Z 100 02030O CAL,3 Z 106 02040O CAL,4 Z 112 02050O CAL,5 Z 119 02060O CAL,6 Z 125 02070O CAL,7 Z 131 02080O CAL,8 Z 137 02090O CAL,9 Z 144 02100O CAL,10Z 150 02110O CAL,11Z 156 02120O CAL,12Z 162 02130O CAL,13Z 169 02140O CAL,14Z 175 02150O CAL,15Z 181 02160O CAL,16Z 187 02170O CAL,17Z 194 02180O CAL,18Z 200 02190O CAL,19Z 206 02200O CAL,20Z 212 02210O 89 '*' 02220O 114 '*' 02230O 139 '*' 02240O 164 '*' 02250O 189 '*' ÐÐ/* 002260_‚ ÐÐ_‚_‚ 002260_‚ ÐÈ( l  X085DP P120282120282(èÈÐ00010H Q085DP00020F* BUILD MONTH-ENDING M-DAY TABLE. (X085DP) 00030F* REVISED 4/29/80 10:40 AM. 00040FCALENDARIP F 22 7AI 1 DISK 00050FMDAYME O F 10 DISK 00060I******************************************************************** 00070ICALENDARCL 01 1 CM 00080I 8 110YRMO L1 00090I 12 130DAY 00100I 2 50MDAY 00110I GG 02 00120O******************************************************************** 00130OMDAYME D 01 L1 00140O YRMO 4 00150O DAY 6 00160O MDAY 10 00170O*------------------------------------------------------------------- 00180O T LR 00190O 2 '/*' /* 000200_‚ ÐÐ _‚_‚0I******************************************************************** 00070ICALENDARCL 01 1 CM 00080I 8 110YRMO L1 00090I 12 130DAY 00100I 2 50MDAY 00110I GG 02 00120O******************************************************************** 00130OMDAYME D 01 L1 00140O YRMO 4 00150O DAY 6 00160O MDAY 10 00170O*------------------------------------------------------------------- 00180O T LR 00190O 2 '/*' /* 000200_‚ ÐÈ(( z (X086DP P120282120282(èÈÐ00010H Q086DP00020F* BUILD WEEK-END M-DAY TABLE. (X086DP) 00030F* REVISED 5/13/80 2:40 PM. 00040FCALENDARIP F 22 7AI 1 DISK 00050FMDAYWE O F 9 DISK 00060I******************************************************************** 00070ICALENDARCL 01 1 CC 21 C0 22 C7 00080I 2 50YRMO 00090I 6 70DAY 00100I 21 220DAYWK 00110I 14 170MDAY 00120I GG 02 00130C******************************************************************** 00140C N01 GOTO END 00150C*------------------------------------------------------------------- 00160C END TAG 00170O******************************************************************** 00180OMDAYWE D 01 00190O MDAY 4 00200O YRMO 9 00210O T LR 00220O 2 '/*' /* 000230_‚ ÐÐ _‚_‚0C END TAG 00170O******************************************************************** 00180OMDAYWE D 01 00190O MDAY 4 00200O YRMO 9 00210O T LR 00220O 2 '/*' /* 000230_‚ ÐÈ(2 Œ 2X087DP P120282120282(èÈÐ00010H Q087DP00020F* PUT ASCII CHAR CODES IN EDCDIC SEQ. (X087DP) 00030F* REVISED 5/15/80 1:15 PM. 00040FBITHEX IP F 256 DISK 00050FBITEBDICO F 256 DISK 00060FTERMO O F 10 5 00070E******************************************************************** 00080E BIT 256 1 00090I******************************************************************** 00100IBITHEX BT 01 00110I 1 256 BIT 00120C******************************************************************** 00130C Z-ADD0 X 30 00140C*------------------------------------------------------------------- 00150C TAG10 TAG 00160C 1 ADD X X 00170C X COMP 256 54 00180C 54 GOTO END 00190C Z-ADDX A 30 00200C*------------------------------------------------------------------- 00210C TAG20 TAG 00220C 1 ADD A A 00230C A COMP 256 54 00240C 54 GOTO TAG10 00250C SETON 80 ÐÐ00260C EXCPT 00270C SETOF 80 00280C BIT,X COMP BIT,A 54 00290C N54 GOTO TAG20 00300C MOVE BIT,X W1A 1 00310C MOVE BIT,A BIT,X 00320C MOVE W1A BIT,A 00330C GOTO TAG20 00340C*------------------------------------------------------------------- 00350C END TAG 00360C SETON 81 00370C EXCPT 00380C SETOF 81 00390O******************************************************************** 00400OBITEBDICE 81 00410O BIT 256 00420O******************************************************************** 00430OTERMO E 80 00440O X Z 3 00450O A Z 10 /* 000460_‚ ÐÐ_‚_‚0C EXCPT 00270C SETOF 80 00280C BIT,X COMP BIT,A 54 00290C N54 GOTO TAG20 00300C MOVE BIT,X W1A 1 00310C MOVE BIT,A BIT,X 00320C MOVE W1A BIT,A 00330C GOTO TAG20 00340C*------------------------------------------------------------------- 00350C END TAG 00360C SETON 81 00370C EXCPT 00380C SETOF 81 00390O******************************************************************** 00400OBITEBDICE 81 00410O BIT 256 00420O******************************************************************** 00430OTERMO E 80 00440O X Z 3 00450O A Z 10 /* 000460_‚ ÐÈ(d ¢ d*X088DP P120282120282(èÈÐ00010H Q088DP00020F* UPDATE MESSAGE FILE. (X088DP) 00030F* REVISED 5/02/80 11:45 AM. 00040FBITHEX IP F 256 DISK 00050FMGFILE UC F 80R DISK 00060FTERM80 O F 80 5 00070E******************************************************************** 00080E A80 1 80 1 A 00090E BIT 256 1 00100I******************************************************************** 00110IBITHEX BT 00120I 1 256 BIT 00130I******************************************************************** 00140IMGFILE MG 00150I 1 80 REC 00160C******************************************************************** 00170C SETON 72 00180C EXCPT 00190C SETOF 72 00200C MOVE ' ' BLK80 80 00210C START TAG 00220C SETON 71 00230C EXCPT ENTER RECORD# 00240C SETOF 71 00250C EXITFQCLFCR CRLF ÐÐ00260C MOVE BLK80 W80A 80 00270C MOVELBIT,1 BUFLGT 2 00280C MOVE BIT,41 BUFLGT 00290C EXITFQBELL RING BELL 00300C EXITFQWREED 00310C RLABL W80A 00320C RLABL BUFLGT 00330C MOVEAW80A A80 00340C MOVE BLK80 W80A 00350C Z-ADD1 W 30 00360C ' ' LOKUPA80,1 54 00370C N54 GOTO START 00380C A80,W COMP '\' 90 00390C 90 GOTO END 00400C MOVEAA80,W W5A 5 00410C Z-ADD5 W2N 20 00420C EXIT SUBRAJ 00430C RLABL W2N 00440C RLABL W5A 00450C MOVE W5A W5N 50 00460C W5N CHAINMGFILE 54 00470C 54 MOVE BLK80 REC 00480C N54 GOTO TAG10 00490C SETON 74 00500C EXCPT ÐÐ00510C SETOF 74 00520C GOTO START 00530C*------------------------------------------------------------------- 00540C TAG10 TAG 00550C SETON 75 00560C EXCPT 00570C SETOF 75 00580C EXITFQCLFCR LFCR 00590C MOVE REC W80A 00600C EXITFQBELL RING BELL 00610C EXITFQWREED 00620C RLABL W80A 00630C RLABL BUFLGT 00640C MOVEAW80A A80 00650C '\' LOKUPA80 54 00660C 54 GOTO START 00670C SETON 76 00680C EXCPT 00690C SETOF 76 00700C GOTO START 00710C*------------------------------------------------------------------- 00720C END TAG 00730C MOVEL'Q089DP' PROG 8 00740C EXITFCHAIN 00750C RLABL PROG ÐÐ00760O******************************************************************** 00770OMGFILE E 76 00780O W80A 80 00790O W5A 80 00800O******************************************************************** 00810OTERM80 E 75 00820O REC 80 00830O E 74 00840O 11 'NOT ON FILE' 00850O E 71 00860O 14 'ENTER RECORD #' 00870O E 72 00880O 12 'PUT PAGE OFF' ** A80 ARRAY 000890 000900/* 000910_‚ ÐÐ_‚_‚0O******************************************************************** 00770OMGFILE E 76 00780O W80A 80 00790O W5A 80 00800O******************************************************************** 00810OTERM80 E 75 00820O REC 80 00830O E 74 00840O 11 'NOT ON FILE' 00850O E 71 00860O 14 'ENTER RECORD #' 00870O E 72 00880O 12 'PUT PAGE OFF' ** A80 ARRAY 000890 000900/* 000910_‚ ÐÈ(Â Í ¼X088PM PLº120282120282(èÈÐ00010H Q088PM00020F* GENERATE OLD STYLE PM UPDATE TRANS. (X088PM) 00030F* REV 1/20/83 2:20 PM. 00040FTRNSRT UP F 32 DISK 00050F*MADRT IR F 300 3 3IT EDISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070F*RINT O F 132 OF PRINTER 00080FPMTRANO O F 80 DISK 00090E******************************************************************** 00100E* PMADRT TRNOUT ADRT SORT SPEC 00110E ACT 1 25 1 00120E TABWAS 1 8 2 TABNOW 1 00130I******************************************************************** 00140ITRNSRT TR 01 1 CP 2 CM 00150I* PART MASTER FINDERS 00160I* RECORD CODE 2A (PM) 00170I 1 2 PTREC 00180I* TIME 6A 00190I 3 8 PTTIME 00200I* PART # 12A 00210I 9 20 PTPN L1 00220I* TRAN CODE 1A (A,C,D) 00230I 21 21 PTTRAN 00240I* TRAN DATE 6N 00250I 26 310PTDATE ÐÐ00260I* UPDATE CODE 1A (D=DONE) 00270I 32 32 PTUPD 00280I* CARD IMAGE 00290I 1 32 PTIMAG 00300I*------------------------------------------------------------------- 00310I GG 02 00320I* GARBAGE RECORD. 00330I******************************************************************** 00340IPMMST2 PM 00350I* PART MASTER RECORD. 00360I* KEY AREA 00370I* PART NO. 12A 00380I 1 12 PMPN 00390I* PROD LINE 4N 00400I 15 180PMPL 00410I* MODEL NAME 12A 00420I 19 30 PMMODL 00430I* DESCRIPTION 29A 00440I 31 59 PMDESC 00450I* ENG CHANGE STATUS. 00460I* CUR CHG LEVEL 2A 00470I 70 71 PMECHG 00480I* PROVISIONING CODE 1A 00490I* A = FORECAST,NO VALUE ADDED 00500I* B = FORECAST,VALUE ADDED ÐÐ00510I* C = BUILD TO ORDER (B) 00520I* D = BUILD TO ORDER (NOT B) 00530I* E = CUSTOM 00540I* Y = OBSOLETE,REPAIRABLE 00550I* Z = OBSOLETE,NOT REPAIRABLE 00560I 96 96 PMPROV 00570I* INVENTORY ACCOUNT 5P 00580I P 110 1120PMACNT 00590I* STD COST DATE 6N 00600I 234 2390PMSDAT 00610I* STD COST CODE 1A 00620I* E = ESTIMATED 00630I* H = HISTORICAL 00640I 240 240 PMSCCD 00650I* OLD STYLE PART MASTER FIELDS. 00660I* LIST PRICE 7.2P 00670I P 512 5162PMLPR 00680I* DEVALUED CODE 1A 00690I 483 483 PMDVAL 00700I* ASSY DEPT # 3P 00710I P 537 5380PMADEP 00720I* ASSY HRS 7.3P 00730I P 525 5283PMAHRS 00740I* TEST DEPT # 3P 00750I P 539 5400PMTDEP ÐÐ00760I* TEST HOURS 7.3P 00770I P 529 5323PMTHRS 00780I* Q.C. DEPT # 3P 00790I P 541 5420PMQDEP 00800I* Q.C. HRS 7.3P 00810I P 533 5363PMQHRS 00820I* FAB CODE 2A 00830I 487 488 PMFABC 00840I* STD UNIT COST 9.3P 00850I P 489 4933PMOSUC 00860I* OLD STYLE MCN 5A 00870I 496 500 PMMCN 00880I* RECORD STATUS 1A 00890I* D = DELETED 00900I 674 674 PMSTAT 00910C******************************************************************** 00920C* INITIALIZE. 00930C N79 EXSR SR101 INIT. 00940C* INIT TRAN CODE ARRAY. 00950C L1 MOVE ' ' ACT 00960C* BYPASS NON-PM RECORD. 00970C N01 GOTO END NOT PM. 00980C* BYPASS ALREADY DONE. 00990C PTUPD COMP ' ' 54 01000C 54 SETOF 01 ÐÐ01010C 54 GOTO END ALREADY DONE. 01020C* UPDATE ACTIVITY ARRAY. 01030C Z-ADD1 X 30 01040C ' ' LOKUPACT,X 54 01050C MOVE PTTRAN ACT,X 01060C SETON 70 01070C*------------------------------------------------------------------- 01080C END TAG 01090C* PUT OUT TRANS. 01100CL1 70 EXSR SR102 TRAN OUTPUT. 01110CL1 SETOF 70 01120C******************************************************************** 01130CSR SR80 BEGSR 01140C* GET PART MAST. 01150CSR MOVE BLK12 W12A 12 01160CSR MOVELPTPN W12A 01170CSR SETOF 61 01180CSR W12A CHAINPMMST2 60 GET PMMST. 01190CSRN60 PMSTAT COMP 'D' 61 01200CSR ENDSR 01210C******************************************************************** 01220CSR SR101 BEGSR 01230C* INITIALIZE (1-TIME) 01240CSR SETON 79 01250CSR MOVE ' ' BLK12 12 ÐÐ01260CSR ENDSR 01270C******************************************************************** 01280CSR SR102 BEGSR 01290C* PUT TRANS RECORDS. 01300C* DETERMINE TRAN CODE. 01310CSR EXSR SR201 01320CSRN70 GOTO END102 NO PUT REQD. 01330C* GET PART MAST. 01340CSR EXSR SR80 GET PMMST. 01350CSRN60 GOTO T102A GOT IT. 01360CSR GOTO END102 01370C*------------------------------------------------------------------- 01380CSR T102A TAG 01390C* BRANCH ON INVENTORY TYPE. 01400CSR TIME TIME 60 01410CSR PMACNT COMP 12100 54 F.G. 01420CSR PMACNT COMP 14100 55 DETAIL. 01430CSR PMACNT COMP 14600 56 SLO-MOV. 01440CSR 54 GOTO T102B F.G. 01450CSR 55 GOTO T102C DETAIL. 01460CSR 56 GOTO T102D SLO-MOV. 01470CSR GOTO END102 01480C*------------------------------------------------------------------- 01490CSR T102B TAG 01500C* PUT F.G. TRANS. ÐÐ01510CSR EXSR SR301 MOVE DATA. 01520CSR TTCODE COMP 'A' 71 ADD. 01530CSR SETON 81 01540CSR EXCPT PUT F.G. 01550CSR SETOF 81 01560CSR Z-ADDPMAHRS AHRS 52 ASSY HRS 01570CSR Z-ADDPMTHRS THRS 52 TEST HRS 01580CSR Z-ADDPMQHRS QHRS 52 Q.C. HRS 01590CSR SETON 84 01600CSR EXCPT 01610CSR SETOF 84 01620CSR GOTO END102 01630C*------------------------------------------------------------------- 01640CSR T102C TAG 01650C* PUT DETAIL TRANS. 01660CSR TTCODE COMP 'A' 71 ADD. 01670CSR EXSR SR302 MOVE DATA. 01680CSR SETON 82 01690CSR EXCPT PUT DETAIL. 01700CSR SETOF 82 01710CSR GOTO END102 01720C*------------------------------------------------------------------- 01730CSR T102D TAG 01740C* PUT SLOW-MOV. 01750CSR TTCODE COMP 'A' 71 ADD. ÐÐ01760CSR EXSR SR303 MOVE DATA. 01770CSR SETON 83 01780CSR EXCPT PUT SLO-MOV. 01790CSR SETOF 83 01800CSR Z-ADDPMAHRS AHRS H ASSY HRS 01810CSR Z-ADDPMTHRS THRS H TEST HRS 01820CSR Z-ADDPMQHRS QHRS H Q.C. HRS 01830CSR SETON 86 01840CSR EXCPT 01850CSR SETOF 86 01860CSR END102 ENDSR 01870C******************************************************************** 01880CSR SR201 BEGSR 01890C* COMPUTE TRAN CODE. 01900CSR MOVE ' ' TTCODE 1 01910CSR MOVE ' ' W2A 2 01920CSR Z-ADD0 X 01930C*------------------------------------------------------------------- 01940CSR T201A TAG 01950CSR 1 ADD X X 01960CSR X COMP 25 54 01970CSR 54 GOTO T201Z 01980CSR ACT,X COMP ' ' 54 01990CSRN54 GOTO T201Z 02000CSR MOVE ACT,X W2A ÐÐ02010CSR W2A LOKUPTABWAS TABNOW 54 02020CSR 54 MOVE TABNOW TTCODE 02030CSR 54 MOVELTTCODE W2A 2 02040CSR GOTO T201A 02050C*------------------------------------------------------------------- 02060CSR T201Z TAG 02070CSR TTCODE COMP ' ' 70 02080CSR ENDSR 02090C******************************************************************** 02100CSR SR301 BEGSR 02110C* MOVE F/G DATA - 'A' CARD. 02120CSR MOVELPMPN TPN 100 PART #. 02130CSR MOVELPMMODL TMOD 10 MODEL. 02140CSR MOVE PMLPR TPRIC 72 LIST PRICE. 02150CSR MOVE PMSCCD THRSC 1 HOURS CODE. 02160CSR MOVE PMPROV TPROV 1 PROV CODE. 02170CSR MOVE PMMCN TMCN 50 MCN. 02180CSR Z-ADDPMOSUC TCOST 83 OLD STD COST. 02190CSR Z-ADDPMPL EDP 40 EDP CODE. 02200CSR Z-ADDPMSDAT W6N 60 02210CSR EXSR SR304 02220CSR MOVELW5N TREV 50 COST REV DATE. 02230CSR MOVE PMFABC TFAB 20 FAB CODE. 02240C* MOVE F/G 'B CARD DATA. 02250CSR MOVELPMPN TPN PART #: ÐÐ02260CSR Z-ADDPMADEP TADEP 30 ASSY DEPT #. 02270CSR Z-ADDPMAHRS TAHRS 52 ASSY HRS. 02280CSR Z-ADDPMTDEP TTDEP 30 TEST DEPT #. 02290CSR Z-ADDPMTHRS TTHRS 52 TEST HRS. 02300CSR Z-ADDPMQDEP TQDEP 30 Q.C. DEPT #. 02310CSR Z-ADDPMQHRS TQHRS 52 Q.C. HRS. 02320C* CHECK FOR ZEROED-OUT FIELDS. 02330CSR TADEP COMP 0 20 02340CSR TAHRS COMP 0 21 02350CSR TTDEP COMP 0 22 02360CSR TTHRS COMP 0 23 02370CSR TQDEP COMP 0 24 02380CSR TQHRS COMP 0 25 02390CSR ENDSR 02400C******************************************************************** 02410CSR SR302 BEGSR 02420C* MOVE DETAIL DATA. 02430CSR MOVELPMPN TPN PART #. 02440CSR MOVELPMDESC TDES7 7 DESCRIPTION. 02450CSR Z-ADDPMLPR TPRIC LIST PRICE. 02460CSR MOVE PMDVAL TDVAL 1 DEVALUED CODE. 02470CSR Z-ADDPMOSUC TCOST OLD STD COST. 02480CSR Z-ADDPMSDAT W6N 02490CSR EXSR SR304 02500CSR MOVELW5N TREV COST REV DATE. ÐÐ02510CSR MOVE PMFABC TFAB FAB CODE. 02520C* CHECK FOR BLANKED-OUT FIELDS. 02530CSR TDVAL COMP ' ' 26 02540CSR ENDSR 02550C******************************************************************** 02560CSR SR303 BEGSR 02570C* MOVE SLOW-MOV DATA - 'A' CARD. 02580CSR MOVELPMPN TPN PART #. 02590CSR MOVELPMDESC TDES7 DESCRIPTION. 02600CSR MOVE PMSCCD THRSC HOURS CODE. 02610CSR Z-ADDPMOSUC TCOST OLD STD COST. 02620CSR Z-ADDPMSDAT W6N 02630CSR EXSR SR304 02640CSR MOVELW5N TREV COST REV DATE. 02650CSR MOVE PMFABC TFAB FAB CODE. 02660C* MOVE 'B' CARD DATA. 02670CSR MOVELPMPN TPN PART #. 02680CSR Z-ADDPMADEP TADEP ASSY DEPT #. 02690CSR Z-ADDPMAHRS TAHRS ASSY HRS. 02700CSR Z-ADDPMTDEP TTDEP TEST DEPT #. 02710CSR Z-ADDPMTHRS TTHRS TEST HRS. 02720CSR Z-ADDPMQDEP TQDEP Q.C. DEPT #. 02730CSR Z-ADDPMQHRS TQHRS Q.C. HRS. 02740C* CHECK FOR ZEROED-OUT FIELDS. 02750CSR TADEP COMP 0 20 ÐÐ02760CSR TAHRS COMP 0 21 02770CSR TTDEP COMP 0 22 02780CSR TTHRS COMP 0 23 02790CSR TQDEP COMP 0 24 02800CSR TQHRS COMP 0 25 02810CSR ENDSR 02820C******************************************************************** 02830CSR SR304 BEGSR 02840C* REFORMAT 6-DIGIT DATE TO 5-DIGIT DATE, MO-DAY-YR. 02850CSR MOVELW6N W2N 20 02860CSR W2N COMP 12 54 02870CSR 54 MOVE W6N W4N 40 02880CSR 54 MOVE W2N W6N 02890CSR 54 MOVELW4N W6N MO-DAY-YR 02900CSR MOVELW6N W5N 50 02910CSR MOVE W6N W1N 10 02920CSR MOVE W1N W5N 02930CSR ENDSR 02940O******************************************************************** 02950OTRNSRT D 01 02960O 32 'X' 02970O******************************************************************** 02980OPMTRANO E 81 02990O* F/G TRANS OUTPUT- 'A' CARD 03000O 1 'D' ÐÐ03010O TTCODE 2 03020O TPN 12 03030O 71 TMOD 22 03040O TPRIC 29 03050O PMSCCD 30 03060O PMPROV 36 03070O 71 TMCN 41 03080O 71 TCOST 49 03090O EDP 53 03100O 56 '0' 03110O 71 TREV 61 03120O TFAB 69 03130O 79 '1' 03140O 80 'A' 03150O*------------------------------------------------------------------- 03160O E 83 03170O* SLO-MOV, TYPE-3 TRAN- 'A' CARD 03180O 1 'D' 03190O TTCODE 2 03200O TPN 12 03210O 71 TDES7 19 03220O PMSCCD 30 03230O 71 TCOST 49 03240O 56 '0' 03250O 71 TREV 61 ÐÐ03260O TFAB 69 03270O 79 '3' 03280O 80 'A' 03290O*------------------------------------------------------------------- 03300O E 84 03310O OR 86 03320O* F/G OR SLO-MOV TRANS - 'B' CARD 03330O 2 'DC' 03340O TPN 12 03350O 20 PMADEP 15 03360O N20N71 13 '?' 03370O 21 AHRS 20 03380O N21N71 16 '?' 03390O 22 PMTDEP 23 03400O N22N71 21 '?' 03410O 23 THRS 28 03420O N23N71 24 '?' 03430O 24 PMQDEP 31 03440O N24N71 29 '?' 03450O 25 QHRS 36 03460O N25N71 32 '?' 03470O 84 79 '1' 03480O 86 79 '3' 03490O 80 'B' 03500O*------------------------------------------------------------------- ÐÐ03510O E 82 03520O* DETAIL (TYPE 2) TRANS. 03530O 1 'D' 03540O TTCODE 2 03550O TPN 12 03560O 71 TDES7 19 03570O TPRIC 29 03580O PMPROV 30 03590O 26 PMDVAL 36 03600O 71 TCOST 49 03610O 56 '0' 03620O 71 TREV 61 03630O TFAB 69 03640O 79 '2' 03650O 80 'A' ** ACT ARRAY 003660 003670** TABWAS/TABNOW 003680 AA WAS BLK, NOW ADD = ADD 003690DAC WAS DEL, NOW ADD = CHG 003700 CC WAS BLK, NOW CHG = CHG 003710CCC WAS CHG, NOW CHG = CHG 003720ACA WAS ADD, NOW CHG = ADD 003730 DD WAS BLK, NOW DEL = DEL 003740AD WAS ADD, NOW DEL = NO OUTPUT 003750ÐÐCDD WAS CHG, NOW DEL = DEL 003760/* 003770_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( Š ¼X089CF P120282120282(èÈÐ00010H Q089CF00020F* LOAD OLD STYLE N/A REC TO CFMAST. (X089CF) 00030F* REVISED 4/25/80 11:30 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FNATEMP ID F 80L 7AI 1 DISK 00060FCFMAST UC F 370R15AI 1 DISK A 00070FTERM38 O F 38 5 00080E******************************************************************** 00090E NUL 38 38 1 00100E A6 6 6 1 00110E A36 36 36 1 A 00120E MES 1 11 35 00130E TAC 16 16 1 00140E CFA 8 35 00150E NAC 24 1 00160E CFN 5 3 00170E CFC 5 3 0 00180E BIT 33 1 00190I******************************************************************** 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************** 00230INATEMP NA 01 00240I* CUSTOMER MAST CARD-OLD STYLE - CARD-1 00250I* KEY FIELD 7A ÐÐ00260I 1 7 CCKEY 70 00270I* CUST # 5N 00280I 1 50CCCUST 00290I* CARD CODE 2A 00300I* C1 = CUST - SOLD TO 00310I* C3 = CUST - BILL TO 00320I* M1 = CATALOG 00330I 6 7 CCCARD 00340I* EXPORT 1A 00350I 8 8 CCEXPT 00360I* CLASS 2A 00370I 9 10 CCCLAS 00380I* REC CODE 3A 00390I* BLK 00400I* ADD 00410I* TRF 00420I 11 13 CCREC 00430I* NAME - 1ST 23A 00440I 15 37 CCNAM1 00450I* NAME - 2ND 20A 00460I 38 57 CCNAM2 00470I* ADDRESS-1 23A 00480I 58 80 CCADR1 00490I*------------------------------------------------------------------- 00500I* CUST CARD-OLD STYLE - CARD-2 ÐÐ00510I* COL 1-13 SAME AS CARD1 00520I* ADDRESS-2 20A 00530I 15 34 CCADR2 00540I* CITY 23A 00550I 35 57 CCCITY 00560I* STATE & ZIP 7A 00570I 58 64 CCSTZP 00580I* COUNTRY (IF NOT U.S.) 23A 00590I 58 80 CCCTRY 00600I*------------------------------------------------------------------- 00610I* CATALOG CARD-OLD STYLE - CARD-1 00620I* SAME AS CUST CARD-1 EXCEPT FOR CARD CODE. 00630I*------------------------------------------------------------------- 00640I* CATALOG CARD-OLD STYLE - CARD-2 00650I* SAME AS CUST CARD-2 EXCEPT FOR CARD CODE. 00660I******************************************************************** 00670ICFMAST CF 00680I* CATALOG HOLDER MAST. 00690I* KEY AREA. 00700I* NAME KEY 15A 00710I 1 15 CFKEY 00720I* ADDRESS LINES 35A X 8 00730I 16 295 CFA 00740I* STATE CODE 2A 00750I 296 297 CFSTCD ÐÐ00760I* ZIP 9P 00770I P 298 3020CFZIP 00780I* CATALOGS. 00790I* NAME 3A X 5 00800I 303 317 CFN 00810I* COPIES 3P X 5 00820I P 318 327 CFC 00830I* SELECTOR CODES 24A X 1 00840I 328 351 NAC 00850I* TELEPHONE # 12A 00860I 352 363 CFTEL 00870I* DATE LAST TRAN 6N (YMD) 00880I 364 3690CFDLT 00890I* RECORD STATUS 1A 00900I 370 370 CFSTAT 00910C******************************************************************** 00920C* INITIALIZE. 00930C EXSR SR101 INIT. 00940C*------------------------------------------------------------------- 00950C START TAG 00960C* REQUEST CUSTOMER NUMBER. 00970C MOVE ' ' TAC 00980C SETOF 96 00990C Z-ADD1 M 50 MSG #. 01000C EXSR SR72 PROMPT. ÐÐ01010C EXSR SR75 READ. 01020C 98 GOTO EXIT 01030C 94 GOTO EXIT 01040C 93 GOTO START 01050C 90 GOTO EXIT EXIT. 01060C 96 GOTO ERROR ERROR. 01070C MOVELW36A TCUST 7 01080C TCUST COMP BLK7 54 01090C N54 Z-ADD2 M 96 FLAG ERROR. 01100C N54 GOTO ERROR 01110C* REQUEST KEY. 01120C Z-ADD3 M MSG #. 01130C EXSR SR72 PROMPT. 01140C EXSR SR75 READ. 01150C 98 GOTO EXIT 01160C 94 GOTO EXIT 01170C 93 GOTO START 01180C 90 GOTO EXIT EXIT. 01190C 96 GOTO ERROR ERROR. 01200C MOVELW36A TKEY 15 KEY FIELD. 01210C TKEY COMP BLK15 54 01220C N54 Z-ADD4 M 96 FLAG ERROR. 01230C N54 GOTO ERROR 01240C SETOF 61 01250C TKEY CHAINCFMAST 60 GET MAST. ÐÐ01260C N60 CFSTAT COMP 'D' 61 FLAG DELETE. 01270C N60N61 Z-ADD5 M 96 FLAG ERROR. 01280C N60N61 GOTO ERROR 01290C EXSR SR102 INIT CFMAST. 01300C* REQUEST NAME. 01310C Z-ADD10 M 01320C EXSR SR72 PROMPT. 01330C EXSR SR75 READ. 01340C 98 GOTO EXIT 01350C 94 GOTO EXIT 01360C 93 GOTO START 01370C 90 GOTO EXIT 01380C 96 GOTO ERROR 01390C MOVELW36A TNAME 35 01400C* REQUEST TITLE. 01410C Z-ADD11 M 01420C EXSR SR72 PROMPT. 01430C EXSR SR75 READ. 01440C 98 GOTO EXIT 01450C 94 GOTO EXIT 01460C 93 GOTO START 01470C 90 GOTO EXIT 01480C 96 GOTO ERROR 01490C MOVELW36A TTITLE 35 01500C* REQUEST SELECTOR CODES. ÐÐ01510C Z-ADD9 M 01520C EXSR SR72 01530C EXSR SR75 01540C 98 GOTO EXIT 01550C 94 GOTO EXIT 01560C 93 GOTO START 01570C 90 GOTO EXIT 01580C 96 GOTO ERROR 01590C MOVEAW36A TAC 01600C MOVE TCUST W7A 7 01610C MOVE ' ' W7A 01620C W7A SETLLNATEMP SETUP 1ST READ. 01630C SETOF 80 01640C*------------------------------------------------------------------- 01650C READ TAG 01660C SETOF 70 01670C READ NATEMP 70 GET NATEMP. 01680C 70 GOTO OUTPUT END FILE. 01690C MOVELCCKEY W6A 6 01700C MOVELTCUST W6AA 6 01710C W6AA COMP W6A 54 MATCH. 01720C N54 GOTO OUTPUT NOT SAME CUST. 01730C MOVE CCCARD W1A 1 01740C W1A COMP '1' 71 CARD-1. 01750C N71 W1A COMP '3' 71 ÐÐ01760C W1A COMP '2' 72 CARD-2. 01770C N72 W1A COMP '4' 72 01780C 71 GOTO CARD1 01790C 72 GOTO CARD2 01800C Z-ADD6 M 96 FLAG ERROR. 01810C GOTO ERROR 01820C*------------------------------------------------------------------- 01830C CARD1 TAG 01840C 60 MOVE TKEY CFKEY KEY. 01850C MOVE TNAME CFA,1 NAME 01860C MOVE TTITLE CFA,2 TITLE 01870C MOVE TAC NAC 01880C MOVELCCCARD TYPE 1 01890C TYPE COMP 'M' 54 01900C 54 MOVE 'MAS' CFN,1 01910C 54 Z-ADD1 CFC,1 01920C 54 Z-ADD1 X 30 01930C 54 ' ' LOKUPNAC,X 55 01940C 54 55 MOVE '4' NAC,X 01950C MOVELCCNAM1 CFA,3 01960C MOVELCCNAM2 CFA,4 NAME-2. 01970C MOVELCCADR1 CFA,5 ADDRESS-1. 01980C MOVELCCEXPT CFN,4 EXPORT CODE. 01990C MOVE CCCLAS CFN,5 CLASS CODE. 02000C SETON 80 ÐÐ02010C GOTO READ 02020C*------------------------------------------------------------------- 02030C CARD2 TAG 02040C 60 MOVE TKEY CFKEY KEY. 02050C MOVELCCADR2 CFA,6 ADDRESS-2. 02060C MOVELCCCITY CFA,7 CITY. 02070C MOVELCCSTZP CFSTCD STATE CODE. 02080C MOVE CCSTZP W5N 50 02090C MOVE W5N CFZIP ZIP. 02100C CFN,4 COMP ' ' 54 02110C 54 MOVELCCCTRY CFA,8 COUNTRY 02120C SETON 80 02130C*------------------------------------------------------------------- 02140C OUTPUT TAG 02150C* FLAG NOT ON FILE. 02160C N80 Z-ADD7 M 96 FLAG ERROR. 02170C N80 GOTO ERROR 02180C EXSR SR212 02190C SETOF 80 02200C SETON 81 02210C EXCPT 02220C SETOF 816061 02230C MOVE BLK35 TNAME 02240C MOVE BLK35 TTITLE 02250C MOVE ' ' TAC ÐÐ02260C MOVE BLK7 TCUST 02270C GOTO START 02280C*------------------------------------------------------------------- 02290C ERROR TAG 02300C* PUT ERROR MESSAGE. 02310C EXSR SR73 02320C GOTO START 02330C*------------------------------------------------------------------- 02340C EXIT TAG 02350C MOVEL'QQCF01' PROG 8 02360C EXITFCHAIN 02370C RLABL PROG 02380C******************************************************************** 02390CSR SR72 BEGSR 02400C* PROMPT. 02410CSR MOVE MES,M MSG 35 02420CSR SETON 72 02430CSR EXCPT PUT PROMPT. 02440CSR SETOF 72 02450CSR MOVE BLK35 MSG 02460CSR ENDSR 02470C******************************************************************** 02480CSR SR73 BEGSR 02490C* PUT ERR MESSAGE. 02500CSRN75 MOVE MES,M MSG ÐÐ02510CSR SETON 73 02520CSR EXCPT PUT MSG. 02530CSR SETOF 73 02540CSR MOVE BLK35 MSG 02550CSR ENDSR 02560C******************************************************************** 02570CSR SR74 BEGSR 02580C* PUT PRE-SET MSG TO TERM. 02590CSR SETON 74 02600CSR EXCPT PUT MSG. 02610CSR SETOF 74 02620CSR ENDSR 02630C******************************************************************** 02640CSR SR75 BEGSR 02650C* READ FROM TERMINAL 02660CSR SETOF 779096 02670CSR SETOF 939291 02680CSR SETOF 8988 02690CSR MOVE BIT,1 A6 02700CSR MOVE BIT,19 A6,2 BUF LENGTH 02710CSR MOVEAA6 W6A 6 02720CSR MOVE BLK36 W36A BUFFER 02730CSR EXITFXCREAD READ TERM 02740CSR RLABL W36A 02750CSR RLABL W6A ÐÐ02760CSR MOVEAW36A A36 02770CSR MOVE BLK36 W36A 02780CSR Z-ADD1 W 30 02790CSR '\' LOKUPA36,W 90 FLAG ESC 02800CSRN90 GOTO T75B NOT ESC 02810CSR 1 ADD W W 02820CSR W COMP 36 54 02830CSR 54 GOTO T75A BAD ESC 02840CSR A36,W COMP 'G' 98 GOODBY 02850CSR A36,W COMP 'E' 94 MENU 02860CSR A36,W COMP 'N' 93 NEW ITEM 02870CSR A36,W COMP 'J' 92 JUMP 02880CSR A36,W COMP 'F' 91 SKIP FRWRD 02890CSR A36,W COMP 'B' 89 SKIP BKWRD 02900CSR A36,W COMP 'S' 88 SPACE FILL 02910CSR A36,W COMP 'H' 87 HOME 02920CSR A36,W COMP 'U' 86 UPDATE 02930CSR A36,W COMP 'R' 85 REPEAT 02940CSR 98 02950COR 94 02960COR 93 02970COR 92 02980COR 91 02990COR 89 03000COR 88 ÐÐ03010COR 87 GOTO END75 GOOD ESC 03020C*------------------------------------------------------------------ 03030CSR T75A TAG 03040C* FLAG BAD ESC INPUT 03050CSR Z-ADD8 M 96 FLAG ERROR 03060CSR GOTO END75 03070C*-------------------------------------------------------------------- 03080CSR T75B TAG 03090C* MOVE DATA 03100CSR Z-ADD1 W 03110CSR ' ' LOKUPA36,W 77 03120CSR 77 MOVEAA36 W36A 36 INPUT DATA 03130C*-------------------------------------------------------------------- 03140CSR END75 TAG 03150C* INIT PREV ERROR MSG. 03160CSR SETON 75 03170CSR LSTERR COMP 0 54 03180CSR 54 Z-ADD0 LSTERR 50 03190CSR 54 MOVE BLK35 MSG 35 03200CSR 54 EXSR SR74 BLANK MESSAGE 03210CSR SETOF 75 03220CSR ENDSR 03230C********************************************************************** 03240CSR SR101 BEGSR 03250C* INITIALIZE. ÐÐ03260CSR EXITFQTOPF CLEAR CRT 03270CSR MOVE ' ' BLK15 15 03280CSR MOVE ' ' BLK16 16 03290CSR MOVE ' ' BLK35 35 03300CSR MOVE ' ' BLK7 7 03310CSR MOVE ' ' BLK36 36 03320CSR ENDSR 03330C******************************************************************** 03340CSR SR102 BEGSR 03350C* INIT CFMAST. 03360CSR MOVE BLK35 CFKEY 03370CSR MOVE BLK35 CFA 03380CSR MOVE ' ' CFSTCD 03390CSR Z-ADD0 CFZIP 03400CSR MOVE ' ' CFN 03410CSR Z-ADD0 CFC 03420CSR MOVE ' ' NAC 03430CSR MOVE BLK35 CFTEL 03440CSR MOVE ' ' CFSTAT 03450CSR ENDSR 03460C******************************************************************** 03470CSR SR212 BEGSR 03480C* SORT SELECTOR CODES PRIOR TO OUTPUT. 03490CSR Z-ADD0 X 03500C*------------------------------------------------------------------- ÐÐ03510CSR T212A TAG 03520CSR 1 ADD X X 30 03530CSR X COMP 24 54 03540CSR 54 GOTO END212 03550CSR Z-ADDX Y 30 03560CSR SETOF 56 03570C*------------------------------------------------------------------- 03580CSR T212B TAG 03590CSR 1 ADD Y Y 03600CSR Y COMP 24 54 03610CSR 54 56 GOTO T212A 03620CSR 54 GOTO END212 ALL DONE. 03630CSR NAC,Y COMP ' ' 54 03640CSRN54 GOTO T212B SPACE. 03650CSR SETON 56 03660CSR NAC,X COMP NAC,Y 54 03670CSRN54 NAC,X COMP ' ' 55 03680CSRN54N55 GOTO T212B 03690CSR MOVE NAC,X W1A 1 03700CSR MOVE NAC,Y NAC,X 03710CSR MOVE W1A NAC,Y 03720CSR GOTO T212B 03730CSR END212 ENDSR 03740O******************************************************************** 03750OCFMAST EADD 81 60 ÐÐ03760O* ADD MAST. 03770O CFKEY 15 03780O CFA 295 03790O CFSTCD 297 03800O CFZIP 302P 03810O CFN 317 03820O CFC 327P 03830O NAC 351 03840O CFTEL 363 03850O UDATE 369 03860O 370 'A' 03870O*------------------------------------------------------------------- 03880O E 81 61 03890O* REWRITE MAST. 03900O CFA 295 03910O CFSTCD 297 03920O CFZIP 302P 03930O CFN 317 03940O CFC 327P 03950O NAC 351 03960O CFTEL 363 03970O UDATE 369 03980O 370 'A' 03990O******************************************************************** 04000OTERM38 E 72 ÐÐ04010O OR 73 04020O OR 74 04030O MSG 35 04040O 37 ' ' 04050O 96 BIT,8 38 04060O* ** NUL ARRAY 004070 004080** A6 ARRAY 004090 004100** A36 ARRAY 004110 004120** MES ARRAY 004130ENTER CUSTOMER # 0041402 CUSTOMER # MISSING-REJECT 004150ENTER KEY FIELD 0041604 KEY FIELD MISSING-REJECT 0041705 DUPLICATE KEY-REJECT 0041806 PROGRAM ERROR!! CALL EDP!!! 0041907 THIS CUST NOT ON FILE-REJECT 0042008 BAD ESCAPE CODE-REJECT 004210ENTER SELECTOR CODES 004220ENTER NAME 004230ENTER TITLE 004240** TAC ARRAY 004250ÐÐ 004260/* 004270_‚ ÐÐ_‚_‚ 004260/* 004270_‚ ÐÈ(2G 2X089DP P120282120282(èÈÐ00010H Q089DP00020F* MAINLINE - LIST/SEARCH/UPDATE MGFILE. (X089DP) 00030F* REVISED 5/02/80 3:45 PM. 00040FBITTAB IP F 33 DISK 00050FTERM80 O F 80 5 00060E******************************************************************** 00070E BIT 33 1 00080I******************************************************************** 00090IBITTAB BT 00100I 1 33 BIT 00110C******************************************************************** 00120C START TAG 00130C SETON 72 00140C EXCPT 00150C SETOF 72 00160C EXITFQCLFCR LF/CR 00170C MOVELBIT,1 BUFLGT 2 00180C MOVE BIT,2 BUFLGT 00190C MOVE ' ' W2A 2 00200C EXITFQWREED 00210C RLABL W2A 00220C RLABL BUFLGT 00230C MOVELW2A W1A 1 00240C W1A COMP ' ' 54 00250C N54 MOVE W2A W1A ÐÐ00260C N54 W1A COMP ' ' 54 00270C N54 GOTO START 00280C W1A COMP 'U' 54 00290C W1A COMP 'L' 55 00300C W1A COMP 'S' 56 00310C N54N55N56 GOTO START 00320C 54 MOVEL'Q088DP' PROG 8 UPDATE 00330C 55 MOVEL'Q091DP' PROG LIST 00340C 56 MOVEL'Q090DP' PROG SEARCH 00350C EXITFCHAIN 00360C RLABL PROG 00370O******************************************************************** 00380OTERM80 E 72 00390O 18 'ENTER TRAN CODE: ' /* 000400_‚ ÐÐ_‚_‚0C N54 W1A COMP ' ' 54 00270C N54 GOTO START 00280C W1A COMP 'U' 54 00290C W1A COMP 'L' 55 00300C W1A COMP 'S' 56 00310C N54N55N56 GOTO START 00320C 54 MOVEL'Q088DP' PROG 8 UPDATE 00330C 55 MOVEL'Q091DP' PROG LIST 00340C 56 MOVEL'Q090DP' PROG SEARCH 00350C EXITFCHAIN 00360C RLABL PROG 00370O******************************************************************** 00380OTERM80 E 72 00390O 18 'ENTER TRAN CODE: ' /* 000400_‚ ÐÈ(d] d*X089PM P120282120282(èÈÐ00010H Q089PM00020F* ACCTG DEPT/HRS TO FLOPPY. (X089PM) 00030F* REVISED 2/25/81 3:00 PM. 00040FPMMST2 IP F 674 12AI 1 DISK 00050FFLOPPY O F 122 17 00060F KEBCDIC 00070E AHR 3 7 3A 00080E ADP 3 3 0A 00090I******************************************************************** 00100IPMMST2 PM 01 674NCD 00110I P 525 536 AHR 00120I P 537 542 ADP 00130I 1 100PN 00140I P 110 1120PMACCT 00150I GG 02 00160C******************************************************************** 00170C 70 GOTO TAG10 00180C SETON 70 00190C MOVE ' ' BLK122122 00200C Z-ADD0 X 30 00210C*------------------------------------------------------------------- 00220C START TAG 00230C SETON 89 00240C 1 ADD X X 00250C X COMP 17 54 ÐÐ00260C 54 GOTO TAG10 00270C SETON 81 00280C EXCPT 00290C SETOF 81 00300C GOTO START 00310C*------------------------------------------------------------------- 00320C TAG10 TAG 00330C 01 XFOOTAHR W7N 93 01 00340O******************************************************************** 00350OFLOPPY D 01 00360O PN 10 00370O ADP 19 00380O AHR 40 00390O PMACCT 45 00400O 82 '1' 00410O E 81 00420O BLK122 122 00430O T LR 00440O BLK122 122 00450O 2 '?*' /* 000460_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ˆ ¼X090CF P120282120282(èÈÐ00010H Q090CF00020F* GEN CFKEYOUT FILE FOR CFMAST PRINT BY COMPANY, SELECTIVELY. (X010CF) 00030F* SWITCH-1 ON SELECTS ALL ACTIVE CFMAST FOR OUTPUT TO CFKEYOUT FILE 00040F* *** NOTE: THIS IS A SPECIAL PROGRAM -SELECTS # COPIES > 1 *** 00050F* REVISED 5/15/80 5:15 PM. DG-REL006 OK. 00060FCFSELECTIP F 900 900 DISK 00070FCFMAST IS F 370 15AI 1 DISK 00080FCFKEYOUTO F 59 59 DISK 00090E******************************************************************** 00100E NA4 5 5 6 00110E NB4 5 5 4 0 00120E TABSC 1 58 2 TABSCN 20 STATE CODE NAMES 00130E ERR 1 9 1 VERTICAL ERRORS 00140E WK2 11 11 2 00150E WK3 11 11 3 00160E BIT 33 1 00170E CFA 8 35 00180E CFN 5 3 00190E CFC 5 3 0 00200E NAC 24 1 00210E SET 9 1 0A 00220E FZIP 9 9 0A 00230E TZIP 9 9 0A 00240E NZIP 9 1 A 00250E STC 9 2 A ÐÐ00260E NST 9 1 A 00270E FC 9 35 A 00280E NFC 9 1 A 00290E MC1 9 3 A 00300E NM1 9 1 A 00310E MC2 9 3 A 00320E NM2 9 1 A 00330E SC 9 33 A 00340I******************************************************************** 00350ICFSELECTCS 10 00360I* MAIL LIST SELECTOR RECORD. 00370I* SET # 1N X 9 00380I 1 9 SET 00390I* FROM ZIP 9N X 9 00400I 10 90 FZIP 00410I* THRU ZIP 9N X 9 00420I 91 171 TZIP 00430I* NOT ZIP 1A X 9 00440I 172 180 NZIP 00450I* STATE CODE 2A X 9 00460I 181 198 STC 00470I* NOT STATE 1A X 9 00480I 199 207 NST 00490I* FRGN CTRY 35A X 9 00500I 208 522 FC ÐÐ00510I* NOT FRGN CTRY 1A X 9 00520I 523 531 NFC 00530I* MAIL CODE-1 3A X 9 00540I 532 558 MC1 00550I* NOT MAIL CODE-1 1A X 9 00560I 559 567 NM1 00570I* MAIL CODE-2 3A X 9 00580I 568 594 MC2 00590I* NOT MAIL CODE-2 1A X 9 00600I 595 603 NM2 00610I* SELECTOR CODES 3A X 11 X 9 00620I* EA CODE=1 BYTE 00630I* NOT CODE= 1 BYTE 00640I* BOTH ARE R.J. IN 3-BYTE ELEMENT 00650I* (LEFTMOST BYTE IS BLANK) 00660I 604 900 SC 00670I******************************************************************** 00680ICFMAST CF 01 00690I* CATALOG HOLDER (MAIL LIST) MASTER. 00700I* KEY AREA. 00710I* NAME KEY 15A 00720I 1 15 CFKEY 00730I* ADDRESS LINES 35A X 8 00740I 16 295 CFA 00750I* STATE CODE 2A ÐÐ00760I 296 297 CFSTCD 00770I* ZIP 9P 00780I P 298 3020CFZIP 00790I* CATALOGS. 00800I* NAME 3A X 5 00810I 303 317 CFN 00820I* COPIES 3P X 5 00830I P 318 327 CFC 00840I* SELECTOR CODES 24 X 1A 1 00850I 328 351 NAC 00860I* TELEPHONE # 12A 00870I 352 363 CFTEL 00880I* DATE LAST UPDATE 6N (YMD) 00890I 364 3690CFDLT 00900I* RECORD STATUS 1A 00910I 370 370 CFSTAT 00920C******************************************************************** 00930C* INITIALIZE - 1 TIME. 00940C 10 EXSR SR101 INIT. 00950C 10 GOTO END 00960C*------------------------------------------------------------------- 00970C SETOF 65 00980C CFSTAT COMP 'D' 54 00990C 54 SETOF 01 01000C 54 GOTO END DELETED CFMAST. ÐÐ01010C U1 GOTO END 01020C MOVE CFN NA4 01030C Z-ADDCFC NB4 01040C CFSTCD COMP ' ' 54 01050C 54 CFSTCD LOKUPTABSC TABSCN 54 01060C 54 MOVELTABSCN W20A 20 01070C N54 MOVE BLK35 W20A 01080C* TEST RECORD. 01090C MOVE ' ' ERR 01100C 02 EXSR SR202 ZIP CODE. 01110C 03 EXSR SR203 STATE CODE. 01120C 04 EXSR SR204 FRGN CTRY. 01130C 05 EXSR SR205 MAILER CODE. 01140C 06 EXSR SR206 SELECTOR CODE. 01150C* CHECK TEST RESULTS. SET 01 OFF IF NOT A HIT. 01160C Z-ADD0 X 01170C*-------------------------------------------------------------- 01180C TAG100 TAG 01190C 1 ADD X X 01200C X COMP 9 54 01210C 54 SETOF 01 01220C 54 GOTO END DONE- ALL ERRORS 01230C SET,X COMP 0 54 01240C N54 GOTO TAG100 NO TEST DATA 01250C ERR,X COMP ' ' 54 ÐÐ01260C N54 GOTO END GOT A HIT 01270C GOTO TAG100 TRY AGAIN 01280C*---------------------------------------------------------------- 01290C END TAG 01300C******************************************************************** 01310CSR SR101 BEGSR 01320C* INITIALIZE 1-TIME. 01330C* FLAG ZIP CODE. 01340CSR U1 GOTO T101A SEE F-SPECS 01350CSR Z-ADD1 X 30 01360CSR EXSR SR102 01370CSR 54 01380COR 55 SETON 02 ZIP CODE. 01390C* FLAG STATE CODE. 01400CSR Z-ADD1 X 01410CSR EXSR SR103 01420CSR 54 01430COR 55 SETON 03 STATE CODE. 01440C* FLAG FOREIGN COUNTRY. 01450CSR Z-ADD1 X 01460CSR EXSR SR104 01470CSR 54 01480COR 55 SETON 04 FRGN CTRY. 01490C* FLAG MAILER CODES. 01500CSR Z-ADD1 X ÐÐ01510CSR EXSR SR105 01520C*------------------------------------------------------------------ 01530CSR T101A TAG 01540C* DEFINE WORK FIELDS 01550CSR 54 01560COR 55 01570COR 56 01580COR 57 SETON 05 MAILER CODES. 01590C* FLAG SELECTOR CODES. 01600CSR Z-ADD1 X 01610CSR EXSR SR106 01620CSR 54 SETON 06 SELECTOR CODES. 01630C* DEFINE WORK FIELDS. 01640CSR 79 GOTO END101 01650CSR SETON 79 01660CSR Z-ADD0 ZERO9 90 01670CSR MOVE ' ' BLK33 33 01680CSR MOVE ' ' BLK16 16 01690CSR MOVE ' ' BLK35 35 01700CSR END101 ENDSR 01710C******************************************************************** 01720CSR SR102 BEGSR 01730C* FIND ZIP TEST DATA. 01740CSR Z-ADDX A 30 01750CSR Z-ADDX B 30 ÐÐ01760CSR ZERO9 LOKUPTZIP,A 54 01770CSR ' ' LOKUPNZIP,B 55 01780CSR 54 55 A COMP B 56 01790CSR 54 55 56 Z-ADDB X 01800CSR 54 55N56 Z-ADDA X 01810CSR 54N55 Z-ADDA X 01820CSRN54 55 Z-ADDB X 01830CSR ENDSR 01840C******************************************************************** 01850CSR SR103 BEGSR 01860C* FIND STATE CODE TEST DATA. 01870CSR Z-ADDX A 01880CSR Z-ADDX B 01890CSR ' ' LOKUPSTC,A 54 01900CSR ' ' LOKUPNST,B 55 01910CSR 54 55 A COMP B 56 01920CSR 54 55 56 Z-ADDB X 01930CSR 54 55N56 Z-ADDA X 01940CSR 54N55 Z-ADDA X 01950CSRN54 55 Z-ADDB X 01960CSR ENDSR 01970C******************************************************************** 01980CSR SR104 BEGSR 01990C* FIND FOR COUNTRY TEST DATA. 02000CSR Z-ADDX A ÐÐ02010CSR Z-ADDX B 02020CSR BLK35 LOKUPFC,A 54 02030CSR ' ' LOKUPNFC,B 55 02040CSR 54 55 A COMP B 56 02050CSR 54 55 56 Z-ADDB X 02060CSR 54 55N56 Z-ADDA X 02070CSR 54N55 Z-ADDA X 02080CSRN54 55 Z-ADDB X 02090CSR ENDSR 02100C******************************************************************** 02110CSR SR105 BEGSR 02120C* FIND MAILER TEST DATA. 02130CSR Z-ADDX A 02140CSR Z-ADDX B 02150CSR ' ' LOKUPMC1,A 54 02160CSR ' ' LOKUPNM1,B 55 02170CSR 54 55 A COMP B 58 02180CSR 54 55 58 Z-ADDB X 02190CSR 54 55N58 Z-ADDA X 02200CSR 54N55 Z-ADDA X 02210CSRN54 55 Z-ADDB X 02220CSR Z-ADDX A 02230CSR Z-ADDX B 02240CSR ' ' LOKUPMC2,A 56 02250CSR ' ' LOKUPNM2,B 57 ÐÐ02260CSR 56 57 A COMP B 58 02270CSR 56 57 58 Z-ADDB X 02280CSR 56 57N58 Z-ADDA X 02290CSR 56N57 Z-ADDA X 02300CSRN56 57 Z-ADDB X 02310CSR ENDSR 02320C******************************************************************** 02330CSR SR106 BEGSR 02340C* FIND SELECTOR CODE TEST DATA. 02350CSR BLK33 LOKUPSC,X 54 02360CSR ENDSR 02370C******************************************************************** 02380CSR SR202 BEGSR 02390C* TEST ZIP CODE. 02400CSR Z-ADD1 X 30 02410C*------------------------------------------------------------------- 02420CSR T202A TAG 02430CSR SETOF 99 02440CSR EXSR SR102 FIND ZIP. 02450CSRN54N55 GOTO END202 02460CSR CFZIP COMP FZIP,X 54 54 02470CSR 54 CFZIP COMP TZIP,X 5454 02480CSR NZIP,X COMP ' ' 55 02490CSRN54N55 02500COR 54 55 SETON 99 FAILURE. ÐÐ02510CSR 99 MOVE 'E' ERR,X 02520CSR EXSR SR301 UP-X. 02530CSRN54 GOTO T202A 02540CSR END202 ENDSR 02550C******************************************************************** 02560CSR SR203 BEGSR 02570C* TEST STATE CODE. 02580CSR Z-ADD1 X 02590C*------------------------------------------------------------------- 02600CSR T203A TAG 02610CSR SETOF 99 02620CSR EXSR SR103 FIND STATE CODE 02630CSRN54N55 GOTO END203 DONE. 02640CSR CFSTCD COMP STC,X 54 02650CSR NST,X COMP ' ' 55 02660CSR 54 55 02670CORN54N55 SETON 99 02680CSR 99 MOVE 'E' ERR,X 02690CSR EXSR SR301 UP-X. 02700CSRN54 GOTO T203A 02710CSR END203 ENDSR 02720C******************************************************************** 02730CSR SR204 BEGSR 02740C* TEST FRGN CTRY. 02750CSR Z-ADD1 X ÐÐ02760C*------------------------------------------------------------------- 02770CSR T204A TAG 02780CSR SETOF 99 02790CSR EXSR SR104 FIND CTRY. 02800CSRN54N55 GOTO END204 DONE. 02810CSR CFA,8 COMP FC,X 54 02820CSR NFC,X COMP ' ' 55 02830CSR 54 55 02840CORN54N55 SETON 99 02850CSR 99 MOVE 'E' ERR,X 02860CSR EXSR SR301 UP-X. 02870CSRN54 GOTO T204A 02880CSR END204 ENDSR 02890C******************************************************************** 02900CSR SR205 BEGSR 02910C* TEST MAIL CODES. 02920CSR Z-ADD1 X 02930C*------------------------------------------------------------------- 02940CSR T205A TAG 02950CSR SETOF 99 02960CSR EXSR SR105 FIND MAIL CODE. 02970CSRN54N55 GOTO T205B DONE 1ST PASS. 02980CSR Z-ADD1 C 20 02990CSR MC1,X LOKUPCFN,C 54 03000CSR 54 CFC,C COMP 1 54 ÐÐ03010CSR NM1,X COMP ' ' 55 03020CSR 54 55 03030CORN54N55 SETON 99 03040CSR 99 MOVE 'E' ERR,X 03050CSR EXSR SR301 UP-X. 03060CSRN54 GOTO T205A 03070C*------------------------------------------------------------------- 03080CSR T205B TAG 03090CSR Z-ADD1 X 03100C*------------------------------------------------------------------- 03110CSR T205C TAG 03120CSR SETOF 99 03130CSR EXSR SR105 FIND MAIL CODE. 03140CSRN56N57 GOTO END205 DONE 2ND PASS. 03150CSR MC2,X LOKUPCFN 54 03160CSR NM2,X COMP ' ' 55 03170CSR 54 55 03180CORN54N55 SETON 99 FAILURE. 03190CSR 99 MOVE 'E' ERR,X 03200CSR EXSR SR301 UP-X. 03210CSRN54 GOTO T205B 03220CSR END205 ENDSR 03230C******************************************************************** 03240CSR SR206 BEGSR 03250C* TEST SELECTOR CODES. ÐÐ03260CSR Z-ADD0 S 30 03270C*------------------------------------------------------------------- 03280CSR T206A TAG 03290CSR 1 ADD S S 03300CSR S COMP 9 54 03310CSR 54 GOTO END206 03320CSR SET,S COMP 0 54 03330CSRN54 GOTO T206A 03340CSR SC,S COMP BLK33 54 03350CSRN54 GOTO T206A 03360CSR MOVEASC,S WK3 03370CSR MOVE WK3 WK2 03380CSR Z-ADD0 X 03390C*------------------------------------------------------------------- 03400CSR T206B TAG 03410CSR SETOF 99 03420CSR 1 ADD X X 03430CSR X COMP 11 54 03440CSR 54 GOTO T206A 03450CSR WK2,X COMP ' ' 54 03460CSRN54 GOTO T206B 03470CSR MOVELWK2,X W1A 1 SELECTOR CODE. 03480CSR W1A LOKUPNAC 54 03490CSR MOVE WK2,X W1A NOT FLAG. 03500CSR W1A COMP ' ' 55 ÐÐ03510CSR 54 55 03520CORN54N55 SETON 99 03530CSR 99 MOVE 'E' ERR,S 03540CSR 99 GOTO T206A 03550CSR GOTO T206B 03560CSR END206 ENDSR 03570C******************************************************************** 03580CSR SR301 BEGSR 03590C* INCREASE INDEX. 03600CSR 1 ADD X X 03610CSR X COMP 9 54 03620CSR ENDSR 03630O******************************************************************** 03640OCFKEYOUTD 01 03650O CFA,3 35 03660O CFKEY 50 03670O CFZIP 59 ** NA4 ARRAY 003680 003690** NB4 ARRAY 003700 003710** TABSC/TABSCN --- STATE CODES/NAMES 003720 003730ALALABAMA 003740AKALASKA 003750ÐÐAZARIZONA 003760ARARKANSAS 003770ASAMERICAN SAMOA 003780CACALIFORNIA 003790CZCANAL ZONE 003800COCOLORADO 003810CTCONNECTICUT 003820DEDELAWARE 003830DCDISTRICT OF COLUMBIA 003840FLFLORIDA 003850GAGEORGIA 003860GUGUAM 003870HIHAWAII 003880IDIDAHO 003890ILILLINOIS 003900ININDIANA 003910IAIOWA 003920KSKANSAS 003930KYKENTUCKY 003940LALOUISIANA 003950MEMAINE 003960MDMARYLAND 003970MAMASSACHUSETTS 003980MIMICHIGAN 003990MNMINNESOTA 004000ÐÐMSMISSISSIPPI 004010MOMISSOURI 004020MTMONTANA 004030NENEBRASKA 004040NVNEVADA 004050NHNEW HAMPSHIRE 004060NJNEW JERSEY 004070NMNEW MEXICO 004080NYNEW YORK 004090NCNORTH CAROLINA 004100NDNORTH DAKOTA 004110OHOHIO 004120OKOKLAHOMA 004130OROREGON 004140PAPENNSYLVANIA 004150PRPUERTO RICO 004160RIRHODE ISLAND 004170SCSOUTH CAROLINA 004180SDSOUTH DAKOTA 004190TNTENNESSEE 004200TTTRUST TERRITORIES 004210TXTEXAS 004220UTUTAH 004230VTVERMONT 004240VAVIRGINIA 004250ÐÐVIVIRGIN ISLANDS 004260WAWASHINGTON 004270WVWEST VIRGINIA 004280WIWISCONSIN 004290WYWYOMING 004300** ERR ARRAY 004310 004320** WK2 ARRAY 004330 004340** WK3 ARRAY 004350 004360/* 004370_‚ ÐÐ_‚_‚RGIN ISLANDS 004260WAWASHINGTON 004270WVWEST VIRGINIA 004280WIWISCONSIN 004290WYWYOMING 004300** ERR ARRAY 004310 004320** WK2 ARRAY 004330 004340** WK3 ARRAY 004350 004360/* 004370_‚ ÐÈ(dE d*X090DP P120282120282(èÈÐ00010H Q090DP00020F* SEARCH MGFILE. (X090DP) 00030F* REVISED 5/13/80 4:05 PM. 00040FBITHEX IP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FTERM80 O F 80 5 00070E******************************************************************** 00080E A80 1 80 1 A 00090E BIT 256 1 00100E REC 80 1 00110I******************************************************************** 00120IBITHEX BT 00130I 1 256 BIT 00140I******************************************************************** 00150IMGFILE MG 00160I 1 80 REC 00170C******************************************************************** 00180C MOVE ' ' BLK80 80 00190C*------------------------------------------------------------------- 00200C START TAG 00210C SETON 72 00220C EXCPT 00230C SETOF 72 00240C MOVELBIT,1 BUFLGT 2 00250C MOVE BIT,41 BUFLGT ÐÐ00260C MOVE BLK80 W80A 80 00270C EXITFQWREED 00280C RLABL W80A 00290C RLABL BUFLGT 00300C MOVEAW80A A80 00310C MOVE BLK80 W80A 00320C '\' LOKUPA80 90 00330C 90 GOTO END 00340C Z-ADD0 RRN 50 00350C*------------------------------------------------------------------- 00360C TAG10 TAG 00370C MOVE ' ' W2A 2 00380C EXITFQSTOP 00390C RLABL W2A 00400C W2A COMP 'XX' 54 00410C 54 GOTO START 00420C 1 ADD RRN RRN 00430C SETOF 58 00440C RRN CHAINMGFILE 54 00450C 54 GOTO START 00460C Z-ADD1 A 30 00470C*------------------------------------------------------------------- 00480C TAG20 TAG 00490C Z-ADD1 R 30 00500C*------------------------------------------------------------------- ÐÐ00510C TAG30 TAG 00520C ' ' LOKUPA80,A 54 00530C N54 58 GOTO TAG40 00540C N54 GOTO TAG10 00550C A80,A LOKUPREC,R 54 00560C N54 GOTO TAG10 00570C SETON 58 00580C 1 ADD A A 00590C 1 ADD R R 00600C A COMP 80 55 00610C R COMP 80 54 00620C 55 58 GOTO TAG40 00630C 55 GOTO TAG10 00640C 54 R SUB 1 R 00650C GOTO TAG30 00660C*------------------------------------------------------------------- 00670C TAG40 TAG 00680C SETON 73 00690C EXCPT 00700C SETOF 73 00710C 1 ADD COUNT COUNT 30 00720C COUNT COMP 29 54 54 00730C 54 Z-ADD0 COUNT 00740C 54 EXITFQPAUSE 00750C GOTO TAG10 ÐÐ00760C*------------------------------------------------------------------- 00770C END TAG 00780C MOVEL'Q089DP' PROG 8 00790C EXITFCHAIN 00800C RLABL PROG 00810O******************************************************************** 00820OTERM80 E 72 00830O 17 'ENTER RECORD #: ' 00840O BIT,14 80 00850O E 73 00860O REC 80 ** A80 ARRAY 000870 000880/* 000890_‚ ÐÐ_‚_‚0C*------------------------------------------------------------------- 00770C END TAG 00780C MOVEL'Q089DP' PROG 8 00790C EXITFCHAIN 00800C RLABL PROG 00810O******************************************************************** 00820OTERM80 E 72 00830O 17 'ENTER RECORD #: ' 00840O BIT,14 80 00850O E 73 00860O REC 80 ** A80 ARRAY 000870 000880/* 000890_‚ ÐÈ(2p 2X090PM P120282120282(èÈÐ00010H Q090PM00020F* UPDATE ON-HAND BALANCE WITH OLD STYLE INV ADJST. (X090PM) 00030F* REVISED 1-18-81 1:00 PM. 00040F* 00050FTRAN IP F 80 DISK 00060FPMMST2 UC F 674R12AI 1 DISK 00070FTERMO O F 80 5 00080E ADJ 4 6 0 00090E TPN 4 10 0 00100I******************************************************************** 00110ITRAN TR 01 00120I 1 10 TPN,1 00130I 11 16 ADJ,1 00140I 17 26 TPN,2 00150I 27 32 ADJ,2 00160I 33 42 TPN,3 00170I 43 48 ADJ,3 00180I 49 58 TPN,4 00190I 59 64 ADJ,4 00200I******************************************************************** 00210IPMMST2 PM 00220I* CALCULATED DATA. 00230I* CURRENT BALANCES. 00240I* ON HAND STOCK 7P 00250I P 311 3140PMOHB ÐÐ00260C******************************************************************** 00270C Z-ADD0 X 30 00280C TAG10 TAG 00290C 1 ADD X X 00300C X COMP 4 54 00310C 54 GOTO END 00320C TPN,X COMP 0 54 00330C N54 GOTO TAG10 00340C MOVELTPN,X W12A 12 00350C W12A CHAINPMMST2 60 00360C Z-ADDADJ,X PMOHB 00370C SETON 80 00380C EXCPT 00390C SETOF 80 00400C GOTO TAG10 00410C END TAG 00420O******************************************************************** 00430OPMMST2 E 80N60 00440O PMOHB 314P 00450O******************************************************************** 00460OTERMO E 80 00470O TPN,X 12 00480O ADJ,X J 25 /* 000490_‚ ÐÐ_‚_‚0C******************************************************************** 00270C Z-ADD0 X 30 00280C TAG10 TAG 00290C 1 ADD X X 00300C X COMP 4 54 00310C 54 GOTO END 00320C TPN,X COMP 0 54 00330C N54 GOTO TAG10 00340C MOVELTPN,X W12A 12 00350C W12A CHAINPMMST2 60 00360C Z-ADDADJ,X PMOHB 00370C SETON 80 00380C EXCPT 00390C SETOF 80 00400C GOTO TAG10 00410C END TAG 00420O******************************************************************** 00430OPMMST2 E 80N60 00440O PMOHB 314P 00450O******************************************************************** 00460OTERMO E 80 00470O TPN,X 12 00480O ADJ,X J 25 /* 000490_‚ ÐÈ(–† –?X090RM P120282120282(èÈÐ00010H Q090RM00020F* GENERATE ROUTING FROM PMMST HRS DATA. (X090RM) 00030F* REVISED 8/30/80 1:00 PM. 00040FPMMST2 IP F 576 12AI 1 DISK 00050FRMMAST2 UC F 140R15AI 1 DISK A 00060FTERMO O F 80 5 00070E******************************************************************** 00080E DES 1 3 40 00090I******************************************************************** 00100IPMMST2 PM 01 576NCD 00110I 1 100PMPN 00120I 31 59 PMDESC 00130I* ACCOUNTING STD HOURS. 00140I* ASSY DEPT # 3P 00150I P 524 5250PMAADP 00160I* ASSY HRS 5.2P 00170I P 526 5282PMAAHR 00180I* TEST DEPT # 3P 00190I P 529 5300PMATDP 00200I* TEST HOURS 5.2P 00210I P 531 5332PMATHR 00220I* Q.C. DEPT # 3P 00230I P 534 5350PMAQDP 00240I* Q.C. HRS 5.2P 00250I P 536 5382PMAQHR ÐÐ00260I* LOT SIZE 5P 00270I P 539 5410PMOSLQ 00280I*------------------------------------------------------------------- 00290I GG 02 00300I******************************************************************** 00310IRMMAST2 RM 03 00320I 1 100RMPN 00330C N01 GOTO END 00340C PMAAHR COMP 0 54 00350C N54 PMATHR COMP 0 54 00360C N54 PMAQHR COMP 0 54 00370C N54 SETOF 01 00380C N01 GOTO END 00390C MOVELPMPN W15A 15 00400C Z-ADD0 W3N 30 00410C*------------------------------------------------------------ 00420C TAG10 TAG 00430C 10 ADD W3N W3N 00440C MOVE W3N W15A 00450C W15A CHAINRMMAST2 54 00460C N54 GOTO END 00470C W3N COMP 50 54 54 00480C N54 GOTO TAG10 00490C*------------------------------------------------------------ 00500C TAG30 TAG ÐÐ00510C Z-ADD0 SEQ 30 00520C N79 EXSR SR101 1-TIME INIT 00530C* ASSY DEPT. 00540C Z-ADDPMAAHR RUN 93 54 00550C N54 GOTO TAG40 00560C Z-ADDPMAADP DEPT 50 00570C Z-ADDPMOSLQ LOT 70 00580C Z-ADD1 X 30 00590C EXSR SR81 00600C*------------------------------------------------------------------- 00610C TAG40 TAG 00620C* TEST DEPT. 00630C Z-ADDPMATHR RUN 54 00640C N54 GOTO TAG50 00650C Z-ADDPMATDP DEPT 00660C Z-ADD2 X 00670C EXSR SR81 00680C*------------------------------------------------------------------- 00690C TAG50 TAG 00700C* QC DEPT. 00710C Z-ADDPMAQHR RUN 54 00720C N54 GOTO END 00730C Z-ADDPMAQDP DEPT 00740C Z-ADD3 X 00750C EXSR SR81 ÐÐ00760C*------------------------------------------------------------------- 00770C END TAG 00780C******************************************************************** 00790CSR SR81 BEGSR 00800C* OUTPUT RMMAST2. 00810CSR 10 ADD SEQ SEQ 00820CSR 1 ADD OUTCNT OUTCNT 50 00830CSR SETON 81 00840CSR EXCPT 00850CSR SETOF 81 00860CSR ENDSR 00870C******************************************************************** 00880CSR SR101 BEGSR 00890C* INIT. 00900CSR SETON 79 00910CSR Z-ADD0 ZERO2 20 00920CSR Z-ADD0 ZERO3 30 00930CSR Z-ADD0 ZERO5 50 00940CSR Z-ADD0 ZERO7 70 00950CSR Z-ADD0 ZERO9 90 00960CSR MOVELUDATE W4N 40 00970CSR MOVE UDATE W2N 20 00980CSR MOVE W4N W6N 60 00990CSR MOVELW2N W6N 01000CSR Z-ADDW6N TODAY7 70 ÐÐ01010CSR ENDSR 01020O******************************************************************** 01030ORMMAST2 EADD 81 01040O PMPN 10 01050O SEQ 15 01060O 17 ' ' 01070O ZERO2 B 19 01080O 24 ' ' 01090O DEPT B 27P 01100O ZERO3 B 29P 01110O DES,X 69 01120O TODAY7 73P 01130O ZERO9 B 78P 01140O RUN 83P 01150O ZERO7 B 87P 01160O LOT 91P 01170O TODAY7 95P 01180O ZERO9 B 100P 01190O RUN B 105P 01200O ZERO7 B 109P 01210O LOT B 113P 01220O 114 'C' 01230O 119 ' ' 01240O ZERO5 122P 01250O ZERO5 125P ÐÐ01260O ZERO5 128P 01270O ZERO5 131P 01280O 140 'G' 01290OTERMO D 01300O PMPN 12 ' _ - ' 01310O SEQ Z 20 01320O OUTCNT1 40 ** DES 001330ASSEMBLE PER DRAWING 001340TEST PER DRAWINGS AND SPECIFICATIONS 001350INSPECT PER DRAWING 001360/* 001370_‚ ÐÐ_‚_‚0O ZERO5 128P 01270O ZERO5 131P 01280O 140 'G' 01290OTERMO D 01300O PMPN 12 ' _ - ' 01310O SEQ Z 20 01320O OUTCNT1 40 ** DES 001330ASSEMBLE PER DRAWING 001340TEST PER DRAWINGS AND SPECIFICATIONS 001350INSPECT PER DRAWING 001360/* 001370_‚ ÐÈ(dÆ d*X091DP P120282120282(èÈÐ00010H Q091DP00020F* LIST MGFILE ON CONSOLE. (X091DP) 00030F* REVISED 5/13/80 4:00 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FTERM80 O F 80 5 00070E******************************************************************** 00080E A6 6 6 1 00090E BIT 33 1 00100I******************************************************************** 00110IBITTAB BT 01 00120I 1 33 BIT 00130I******************************************************************** 00140IMGFILE MG 00150I 1 80 REC 00160C******************************************************************** 00170C START TAG 00180C SETON 72 00190C EXCPT 00200C SETOF 72 00210C MOVE ' ' BLK6 6 00220C EXITFQCLFCR LF/CR 00230C MOVELBIT,1 BUFLGT 2 00240C MOVE BIT,4 BUFLGT 00250C MOVE ' ' W6A 6 ÐÐ00260C EXITFQWREED 00270C RLABL W6A 00280C RLABL BUFLGT 00290C MOVEAW6A A6 00300C '\' LOKUPA6 90 00310C 90 GOTO END 00320C Z-ADD6 W2N 20 00330C EXIT SUBRAJ R. ADJUST 00340C RLABL W2N 00350C RLABL W6A 00360C MOVE W6A W5N 50 00370C Z-ADD0 LINENO 00380C*------------------------------------------------------------------- 00390C CONTU TAG 00400C MOVE ' ' W2A 2 00410C EXITFQSTOP 00420C RLABL W2A 00430C W2A COMP 'XX' 54 00440C 54 GOTO START 00450C W5N CHAINMGFILE 54 00460C 54 GOTO START 00470C SETON 73 00480C EXCPT 00490C SETOF 73 00500C 1 ADD LINENO LINENO 30 ÐÐ00510C 1 ADD W5N W5N 00520C LINENO COMP 29 54 54 00530C N54 GOTO CONTU 00540C MOVE BLK6 W6A 00550C EXITFQWREED 00560C RLABL W6A 00570C RLABL BUFLGT 00580C MOVEAW6A A6 00590C '\' LOKUPA6 90 00600C 90 GOTO END 00610C W6A COMP BLK6 54 00620C N54 Z-ADD0 LINENO 00630C N54 GOTO CONTU 00640C 54 GOTO START 00650C*------------------------------------------------------------------- 00660C END TAG 00670C MOVEL'Q089DP' PROG 8 00680C EXITFCHAIN 00690C RLABL PROG 00700O******************************************************************** 00710OTERM80 E 72 00720O 17 'ENTER RECORD #: ' 00730O E 73 00740O REC 80 ** A6 ARRAY 000750ÐÐ 000760/* 000770_‚ ÐÐ_‚_‚ 000760/* 000770_‚ ÐÈ(dñ d*X092DP P120282120282(èÈÐ00010H Q092DP00020F* DISPLAY SPOOLER FILE ON TERMINAL 00030FBITHEX IP F 256 DISK 00040FSPLRFILEIC F 136R DISK 00050FTERM132 O F 132 5 00060F*---------------------------------------------------------------- 00070E BIT 256 1 00080E REC 131 1 00090E*-------------------------------------------------------------- 00100IBITHEX BT 00110I 1 256 BIT 00120ISPLRFILESP 00130I 2 132 REC 00140I*---------------------------------------------------------------- 00150C MOVE ' ' BLK6 6 00160C MOVELBIT,1 BUFLGT 2 00170C MOVE BIT,4 BUFLGT 00180C*-------------------------------------------------------------- 00190C START TAG 00200C MOVE BLK6 W6A 6 00210C EXITFQCLFCR 00220C EXITFQWREED 00230C RLABL W6A 00240C RLABL BUFLGT 00250C Z-ADD6 W2N 20 ÐÐ00260C EXIT SUBRAJ 00270C RLABL W2N 00280C RLABL W6A 00290C MOVE W6A W5N 50 00300C W5N COMP 0 54 00310C 54 W5N SUB 1 RRN 50 00320C*------------------------------------------------------------------ 00330C CONTU TAG 00340C 1 ADD RRN RRN 00350C RRN CHAINSPLRFILE 54 00360C 54 GOTO START 00370C SETON 80 00380C EXCPT 00390C SETOF 80 00400C 1 ADD COUNT COUNT 30 00410C COUNT COMP 28 54 54 00420C 54 Z-ADD0 COUNT 00430C 54 GOTO START 00440C GOTO CONTU 00450C*-------------------------------------------------------------- 00460O****************************************************************** 00470OTERM132 E 80 00480O REC 131 00490O NU1 RRN Z 132 /* 000500ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È ÈTX092PM P120282120282(èÈÐ00010H Q092PM00020F* OLD TO NEW UNIT COST UPDATE. (X092PM) DG-REL006 OK. 00030F* REVISED 7/14/81 10:45 AM. 00040FCSTTRN IP F 80 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070ICSTTRN CS 01 1 CD 2 CC 00080I 3 120CPN 70 00090I 23 292CPRIC 72 00100I 42 493CCST 00110I 57 610CDATE 00120I 1 2 EOF 00130I******************************************************************** 00140IPMMST2 PM 00150I P 489 4933PMOSUC 00160I 234 2390PMSDAT 00170I P 512 5162PMLPR 00180I 519 5240PMLPUD 00190C******************************************************************** 00200C EOF COMP '/*' 80 00210C 80 SETON LR 00220C N70 00230COR 80 SETOF 01 00240C N01 GOTO END 00250C MOVELCPN W12A 12 ÐÐ00260C W12A CHAINPMMST2 71 00270C 71 SETOF 01 00280C 71 GOTO END 00290C Z-ADDPMLPR OLDPRC 92 00300C Z-ADDPMLPUD OLDPD 60 00310C Z-ADDPMOSUC OLDCST 93 00320C Z-ADDPMSDAT OLDDAT 60 00330C MOVELCDATE W4A 4 00340C MOVE CDATE W1A 1 00350C W1A COMP '9' 54 00360C W1A COMP '0' 55 00370C W1A COMP '1' 56 00380C W1A COMP '2' 57 00390C W1A COMP '3' 58 00400C W1A COMP '4' 59 00410C 54 MOVE '79' PMSDAT 00420C 55 MOVE '80' PMSDAT 00430C 56 MOVE '81' PMSDAT 00440C 57 MOVE '82' PMSDAT 00450C 58 MOVE '83' PMSDAT 00460C 59 MOVE '84' PMSDAT 00470C MOVELW4A PMSDAT 00480C Z-ADDCCST PMOSUC 00490C 72 Z-ADDCPRIC PMLPR 00500C 72 Z-ADDUDATE PMLPUD ÐÐ00510C END TAG 00520O******************************************************************** 00530OPMMST2 D 01 00540O PMSDAT 239 00550O PMSDAT 299 00560O PMOSUC 493P 00570O PMLPR 516P 00580O 72 PMLPUD 524 00590O PMOSUC 619P 00600O******************************************************************** 00610OPRINT H 201 1P 00620O OR OF 00630O 8 'PART NO.' 00640O 25 'OLD COST' 00650O 40 'NEW COST' 00660O 60 'OLD DATE' 00670O 70 'NEW DATE' 00680O 85 'OLD PRICE' 00690O 100 'NEW PRICE' 00700O 110 'OLD DATE' 00710O 120 'NEW DATE' 00720O*------------------------------------------------------------------- 00730O D 01 00740O CPN 12 ' - - ' 00750O OLDCST2 25 ÐÐ00760O PMOSUC2 40 00770O OLDDATY 60 00780O PMSDATY 70 00790O OLDPRC2 85 00800O PMLPR 2 100 00810O OLDPD Y 110 00820O PMLPUDY 120 /* 000830_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dq d*X093DP P120282120282(èÈÐ00010H Q093DP00020F* DISPLAY 80 COL TEXTFILE ON TERMINAL 00030FBITHEX IP F 256 DISK 00040FSPLRFILEIC F 80R DISK 00050FTERM80 O F 80 5 00060F*---------------------------------------------------------------- 00070E BIT 256 1 00080E REC 80 1 00090E*-------------------------------------------------------------- 00100IBITHEX BT 00110I 1 256 BIT 00120ISPLRFILESP 00130I 1 80 REC 00140I*---------------------------------------------------------------- 00150C MOVE ' ' BLK6 6 00160C MOVELBIT,1 BUFLGT 2 00170C MOVE BIT,4 BUFLGT 00180C*-------------------------------------------------------------- 00190C START TAG 00200C MOVE BLK6 W6A 6 00210C EXITFQCLFCR 00220C EXITFQWREED 00230C RLABL W6A 00240C RLABL BUFLGT 00250C Z-ADD6 W2N 20 ÐÐ00260C EXIT SUBRAJ 00270C RLABL W2N 00280C RLABL W6A 00290C MOVE W6A W5N 50 00300C W5N COMP 0 54 00310C 54 W5N SUB 1 RRN 50 00320C*------------------------------------------------------------------ 00330C CONTU TAG 00340C 1 ADD RRN RRN 00350C RRN CHAINSPLRFILE 54 00360C 54 GOTO START 00370C SETON 80 00380C EXCPT 00390C SETOF 80 00400C 1 ADD COUNT COUNT 30 00410C COUNT COMP 28 54 54 00420C 54 Z-ADD0 COUNT 00430C 54 GOTO START 00440C GOTO CONTU 00450C*-------------------------------------------------------------- 00460O****************************************************************** 00470OTERM80 E 80 00480O REC 80 00490O NU1 RRN Z 80 /* 000500ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(œ  X093PM P120282120282(èÈÐ00010H Q093PM00020F* PICK-UP REVISION FROM BM FLOPPY. (X093PM) 00030F* REVISED 1/18/81 1:30 PM. 00040FFLOPPY IP F 122 17 00041F KEBCDIC 00050FPMMST2 UC F 674R12AI 1 DISK 00060I******************************************************************** 00070IFLOPPY FL 01 00080I 1 2 EOF 00090I 3 120TAPN L1 60 00100I 13 14 TCHG 00110IPMMST2 PM 00120I 70 71 PMECHG 00121C SETOF 54 00130C 60 GOTO END 00140C EOF COMP '/*' LR 00150C LR GOTO END 00160C L1 MOVE TAPN W10N 100 00170C L1 MOVELW10N W12A 12 00180C L1 W12A CHAINPMMST2 54 00190C END TAG 00200OPMMST2 D 01N54N60 00210O AND NLR L1 00220O TCHG 71 /* 000230ÐÐ_‚_‚0H Q093PM00020F* PICK-UP REVISION FROM BM FLOPPY. (X093PM) 00030F* REVISED 1/18/81 1:30 PM. 00040FFLOPPY IP F 122 17 00041F KEBCDIC 00050FPMMST2 UC F 674R12AI 1 DISK 00060I******************************************************************** 00070IFLOPPY FL 01 00080I 1 2 EOF 00090I 3 120TAPN L1 60 00100I 13 14 TCHG 00110IPMMST2 PM 00120I 70 71 PMECHG 00121C SETOF 54 00130C 60 GOTO END 00140C EOF COMP '/*' LR 00150C LR GOTO END 00160C L1 MOVE TAPN W10N 100 00170C L1 MOVELW10N W12A 12 00180C L1 W12A CHAINPMMST2 54 00190C END TAG 00200OPMMST2 D 01N54N60 00210O AND NLR L1 00220O TCHG 71 /* 000230ÐÈ(¨  X094CM P120282120282(èÈÐ00010H Q094CM00020F* PUT TAX CODE = 4 IF TAX CODE = 0 AND STATE NOT CALIF. (X094CM) 00030F* REVISED 6/23/81 2:45 PM. 00040FCMMAST UP F 576 5AI 1 DISK 00050I******************************************************************** 00060ICMMAST CM 01 00070I* STATE CODE 2A 00080I 271 272 CMSTCD 00090I* TAX CODE 1A 00100I 521 521 CMTAX 00110C******************************************************************** 00120C CMTAX COMP '0' 61 00130C N61 CMTAX COMP ' ' 61 00140C CMSTCD COMP 'CA' 60 00150C N60 61 MOVE '4' CMTAX 00160C 60 61 MOVE '5' CMTAX 00170O******************************************************************** 00180OCMMAST D 01 61 00190O CMTAX 521 /* 00200_‚_‚0C END TAG 00200OPMMST2 D 01N54N60 00210O AND NLR L1 00220O TCHG 71 /* 000230ÐÈ(d² d*X094DP P120282120282(èÈÐ SUBROUTINE Z094DP (IRPG) 00010* DISPLAY BITHEX FILE IN HEX CHAR 00020 INTEGER IRPG (128) 00030 INTEGER IBUF (256) 00040 INTEGER IBUF4 (2) 00050 INTEGER IBUF6 (3) 00060 ISPACE = $2020 00070 ILU = 0 00080 ITC = 0 00090 IXY = -1 00100 N2 = 0 00110 IF (IPASS.EQ.1) GO TO 30 00120 IPASS=1 00130 DO 10 I = 1,128 0014010 IBUF(I) = IRPG(I) 00150 GO TO 900 0016030 IA = 0 00170 DO 40 I=129, 256 00180 IA = IA+1 0019040 IBUF(I) = IRPG(IA) 00200 DO 50 I=1,256 00210 CALL HEXASC (IBUF(I),IBUF4) 00220 CALL HEXDEC (IBUF(I),IBUF6) 00230 CALL QCLFCR 00240 N1 = 6 00250ÐÐ CALL WTREAD (ILU,IXY,IBUF6,N1,IXY,IBUF6,N2,ITC) 00260 N1 = 2 00270 CALL WTREAD (ILU,IXY,ISPACE,N1,IXY,ISPACE,N2,ITC) 00280 N1 = 4 00290 CALL WTREAD (ILU,IXY,IBUF4,N1,IXY,IBUF4,N2,ITC) 00300 IF (I.EQ.100) PAUSE 00310 IF (I.EQ.200) PAUSE 0032050 CONTINUE 00330900 CONTINUE 00340 RETURN 00350 END 00360_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ((Ý (X094PM Ph120282120282(èÈÐ00010H Q094PM00020F* UPDATE ON-HAND BAL WITH OLD STYLE ISSUE/RECPT TRANS (X094PM) 00030F* REVISED 1/18/81 1:30 PM. DG-REL006 OK. 00040F* 00050FTRAN IP F 80 DISK 00060FPMMST2 UC F 674R12AI 1 DISK 00070FTERMO O F 80 PRINTER 00080I******************************************************************** 00090ITRAN TR 01 00100I 3 120TPN 70 00110I 13 190NET 75 00120I******************************************************************** 00130IPMMST2 PM 00140I* CALCULATED DATA. 00150I* CURRENT BALANCES. 00160I* ON HAND STOCK 7P 00170I P 311 3140PMOHB 00180C******************************************************************** 00190C 70 00200COR 75 SETOF 01 00210C N01 GOTO END 00220C MOVELTPN W12A 12 00230C W12A CHAINPMMST2 60 00240C 60 GOTO END 00250C NET ADD PMOHB PMOHB ÐÐ00260C*------------------------------------------------------------------- 00270C END TAG 00280O******************************************************************** 00290OPMMST2 D 01N60 00300O PMOHB 314P 00310O******************************************************************** 00320OTERMO D 01 00330O N60 TPN 12 00340O 60 TPN 50 00350O NET K 25 /* 000360_‚ _‚_‚0I* ON HAND STOCK 7P 00170I P 311 3140PMOHB 00180C******************************************************************** 00190C 70 00200COR 75 SETOF 01 00210C N01 GOTO END 00220C MOVELTPN W12A 12 00230C W12A CHAINPMMST2 60 00240C 60 GOTO END 00250C NET ADD PMOHB PMOHB ÐÈ(2ï 2X095DP P120282120282(èÈÐ00010H Q095DP00020FBITHEX IP F 256 DISK 00030E A132 1 132 2 00040E BIT 256 1 00050IBITHEX BT 00060I 1 256 BIT 00070C MOVELBIT,1 A132 00080C MOVE BIT A132 00090C MOVEAA132 W256A 256 00100C EXITFZ094DP 00110C RLABL W256A 00120C Z-ADD129 X 30 00130C MOVEAA132,X W256A 00140C EXITFZ094DP 00150C RLABL W256A ** 000160 000170/* 000180_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(( (X096BM P120282120282(èÈÐ00010H Q096BM00020F* COPY 80-BYTE DISK FILE TO 122-BYTE DISKETT FILE. (X096BM) 00030F* CREATED FOR Z098BM STREAM. 00040F* REV 6/04/79 11:45 AM. 00050FBMTRANO IP F 80 80 DISK 00060FFLOPPY O F 122 17 00070F KEBCDIC 00080IBMTRANO PT 01 00090I 1 80 REC 00100C 89 GOTO END 00110C MOVE ' ' BLK122122 00120C Z-ADD0 X 30 00130C*------------------------------------------------------------------- 00140C START TAG 00150C SETON 89 00160C 1 ADD X X 00170C X COMP 17 54 00180C 54 GOTO END 00190C SETON 81 00200C EXCPT 00210C SETOF 81 00220C GOTO START 00230C*------------------------------------------------------------------- 00240C END TAG 00250OFLOPPY D 01 ÐÐ00260O BLK122 122 00270O REC 80 00280O 82 '1' 00290O E 81 00300O BLK122 122 00310O T LR 00320O BLK122 122 00330O 2 '?*' /* 000340_‚ _‚_‚0C 1 ADD X X 00170C X COMP 17 54 00180C 54 GOTO END 00190C SETON 81 00200C EXCPT 00210C SETOF 81 00220C GOTO START 00230C*------------------------------------------------------------------- 00240C END TAG 00250OFLOPPY D 01 ÐÈ(  X096CM P120282120282(èÈÐ00010H Q096CM00020F* QUICKIE TO DELETE CMMAST FROM CARD INPUT. (X096CM) 00030F* REVISED 7/31/80 11:00 AM. 00040FFLOPPY IP F 122 17 00050F KEBCDIC 00060FCMMAST UC F 576R 5AI 1 DISK 00070I******************************************************************** 00080IFLOPPY FL 01 00090I 3 70CUSTNO 00100I******************************************************************** 00110ICMMAST CM 00120I 1 50CMCUST 00130C******************************************************************** 00140C CUSTNO CHAINCMMAST 55 00150O******************************************************************** 00160OCMMAST D 01N55 00170O 576 'D' /* 000180_‚ _‚_‚0C SETOF 81 00220C GOTO START 00230C*------------------------------------------------------------------- 00240C END TAG 00250OFLOPPY D 01 ÐÈ(Ü1 ÜqX093PI P.¤/²090283090283(èÈÐ00010H Q003PI00020F* RECEIVED PO UPDATE. (X093PI) WITH OUTPUT P/O PERFORMANCE RECS*** 00030F* REVISED 02-15-84 11:30 AM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FPOITEM UC F 384R 9AI 1 DISK 00080FSFMAST UC F 128R29AI 1 DISK A 00090FPMMST2 UC F 674R12AI 1 DISK 00100FVMMAST IC F 384R 5AI 1 DISK 00110FSFPNA O F 10 DISK A 00120FPORECD O F 75 DISK A 00130FTERM132 O F 132 5 00140F**************************************************************** 00150E NUL 1 132 1 NULL CHAR 00160E A16 16 16 1 A INPUT DATA ARRAY 00170E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00180E DUN 1 5 1 A EDIT CMPLT FLAG 00190E MES 1 1 30 00200E A29 29 29 1 00210E DOT 26 26 1 00220E LN 1 3 10 00230E RCD 1 26 7 0A 00240E REC 1 13 7 0A 00250E OPN 1 26 7 0A ÐÐ00260E LNK 1 7 6 A 00270E BIT 33 1 SCREEN CONTR. CHAR 00280E PAR 25 1 00290E TST 25 1 00300E CALL 7 6 CALL STACK 00310E PID 26 6 0A 00320E PIQ 26 7 0A 00330I******************************************************************* 00340IBITPAR BT 00350I 1 33 BIT 00360I 34 58 PAR 00370I 59 83 TST 00380I******************************************************************* 00390IMGFILE MG 00400I* MESSAGE FILE. 00410I 1 35 MGTEXT 00420I******************************************************************** 00430I 2 70CCCAL 00440I******************************************************************** 00450ICRTFILE CR 00460I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00470I* STD AREA - SAME FOR ALL PROGRAMS. 00480I* EMPLOYEE # 5N 00490I 1 50CREMPL 00500I* USER CODE 8A ÐÐ00510I 6 13 CRUSER 00520I* DEPT # 5N 00530I 14 180CRDEPT 00540I* JOB NAME 8A (JOB LOADED BY MENU) 00550I 19 26 CRJOB 00560I* SHUTDOWN FLAG 1A 00570I* BLANK = NO SHUTDOWN 00580I 27 27 CRSHUT 00590I* TIME STARTED 6N 00600I 28 330CRTIME 00610I* DATE STARTED 4N 00620I 34 370CRDATE 00630I* CALL STACK 7 X 6A 00640I 38 79 CALL 00650I******************************************************************** 00660ISFMAST SF 00670I* SCHEDULE MASTER. 00680I* COMMON FIELDS. 00690I* KEY AREA. 00700I* 1 29 SFKEY 00710I* PART NO. 10N 00720I* 1 100SFPN 00730I* DATE DUE 6N (YMD) 00740I* 11 160SFDUE 00750I* RECORD CODE 2N ÐÐ00760I* 10 = RECEIVED PO 00770I* 20 = REL WO 00780I* 30 = PURCHASE ORDER 00790I* 40 = PLAN WO 00800I* 50 = PURCHASE REQ 00810I* 60 = SALES ORDER-BACKLOG 00820I* 70 = REL REQUIREMENT 00830I* 80 = PLAN REQUIREMENT 00840I* 90 = RUN RELEASE 00850I* 17 180SFREC 00860I* ORDER NO. 00870I* 19 29 SFORD 00880I* PREFIX 1A 00890I* 19 19 SFPRFX 00900I* PRIME 5N 00910I* 20 240SFPRIM 00920I* ITEM 3N 00930I* 25 270SFITEM 00940I* RECEIVING LOG # 2N 00950I* 28 290SFRLOG 00960I* QUANTITY 7P 00970I P 30 330SFQTY 00980I* QTY COMPLETE 7P 00990I P 34 370SFQTYC 01000I* DATE LAST TRAN 6N (YMD) ÐÐ01010I* 38 430SFDLT 01020I* VEND #/DEPT # 3P 01030I* P 44 460SFVEND 01040I* PLAN/REL REQMTS. 01050I* NEXT ASSY PART # 10N 01060I* 47 560SFNAPN 01070I* QTY PER ASSY 7P 01080I* P 57 600SFQPA 01090I* ISSUE CODE 2A 01100I* 61 62 SFISSU 01110I* PULL # 3P 01120I* P 63 640SFPULL 01130I* ASSY REVISION 2A 01140I* 65 66 SFREV 01150I* ASSY WO QTY 7P 01160I* P 67 700SFQTYA 01170I* SALES ORDERS 01180I* VEND P.O. 20A 01190I 71 90 SFCPO 01200I* UNIT PRICE 9.2P 01210I* P 91 952SFPRIC 01220I* PURCH ORDERS 01230I* VENDOR NAME 20A 01240I* SEE SFCPO UNDER SALES ORDERS. 01250I* UNIT PRICE 9.3P ÐÐ01260I* SEE SFPRIC UNDER SALES ORDERS. 01270I* PACKING SLIP 9A 01280I 96 104 SFPKGS 01290I* WORK ORDERS 01300I* DEPT NAME 20A 01310I* SEE SFCPO UNDER SALES ORDERS. 01320I* OPER SEQ # 3P 01330I* P 96 970SFSEQ 01340I* START DATE 6N 01350I* 98 1030SFSTRT 01360I* PULL # 3P 01370I* SEE PLAN/REL REQMTS. 01380I* REVISION 2A 01390I* SEE PLAN/REL REQMTS. 01400I* AVAIL STOCK BAL 7P 01410I* P 120 1230SFSAVQ 01420I* AVAIL BAL 7P 01430I* P 124 1270SFAVQ 01440I* RECORD STATUS 1A 01450I 128 128 SFSTAT 01460I******************************************************************** 01470IPMMST2 PM 01480I* PART NUMBER 10N 01490I 1 100PMPN 01500I* PROD LINE 4N ÐÐ01510I 15 180PMPL 01520I* MODEL NO. 12A 01530I 19 30 PMMODL 01540I* PART DESCRIPTION 29A 01550I 31 59 PMDESC 01560I* ENG CHANGE LEVEL 2A 01570I 70 71 PMECHG 01580I* SOURCE CODE 2A 01590I 94 95 PMSC 01600I* LEAD TIMES 3P X 8 01610I* * * * P 113 128 PLT 01620I* ON-HAND BALANCE 7P 01630I P 311 3140PMOHB 01640I* P.O. BAL 7P 01650I P 343 3460PMPOB 01660I* RECD PO BAL 7P 01670I P 347 3500PMRPOB 01680I* RECORD STATUS 1A 01690I 674 674 PMSTAT 01700I******************************************************************** 01710IPOITEM PI 01720I* PURCHASE ORDER ITEM RECORD. 01730I* KEY AREA. 01740I* PO # 6N 01750I 1 60PIPO ÐÐ01760I* PO ITEM 3N 01770I* * * * * * 7 90PIITEM 01780I* DYNAIR PART # 10N 01790I 10 190PIPN 01800I* VENDOR PART # 15A 01810I 20 34 PIVPN 01820I* DESCRIPTION 29A 01830I 35 63 PIDESC 01840I* NON-INVENTORY DESCRIPTION 70A 01850I 10 79 PINDES 01860I* DATE LAST RECEIPT 6N 01870I 80 850PIDLR 01880I* QTY RECEIVED 7P 01890I P 86 890PIQRCD 01900I* QTY TO STK,SCRAP,RTV 7P 01910I P 90 930PIQSTK 01920I* PRICE CODE 1A 01930I* L = LOT 01940I* N = NO CHARGE 01950I 94 94 PILOT 01960I* PRICE 9.3P 01970I P 95 993PI$PRC 01980I* WORK ORDER # 9A 01990I 100 108 PIWO 02000I 100 105 PIWOP ÐÐ02010I 106 1080PIWOD 02020I* VENDOR 5P (FROM POMAST) 02030I P 109 1110PIVEND 02040I* LAST RCVG LOG # USED 2N 02050I 112 1130PILLOG 02060I* SCHEDULE DATES 6N X 26 (Y,M,D) 02070I 114 269 PID 02080I* SCHED QTYS 7P X 26 02090I P 270 373 PIQ 02100I* RECORD STATUS 1A 02110I 384 384 PISTAT 02120I******************************************************************** 02130IVMMAST VM 02140I 26 60 VMNAME 02150I* COMMENTS, CUSTOMER HOLD 02160I 318 337 VMHOLD 02170C******************************************************************** 02180C* INITIALIZE 02190C EXSR SR101 1-TIME INIT 02200C MOVE ' ' BLK6 6 02210C*------------------------------------------------------------------ 02220C START TAG 02230C* SET-UP 1ST FIELD NO. 02240C SETOF 70 02250C MOVE ' ' DUN INIT EDIT ARRAY ÐÐ02260C Z-ADD1 F 30 FIELD # 02270C EXSR SR205 INIT INPUT FIELDS 02280C EXSR SR70 CLEAR SCREEN 02290C EXSR SR71 PUT HEADING 02300C Z-ADD0 ZERO7 70 STUPIDITY 02310C GOTO READ 02320C*------------------------------------------------------------------ 02330C NEXT TAG 02340C* SET-UP NEXT FIELD NO. 02350C 1 ADD F F FIELD # 02360C*----------------------------------------------------------------- 02370C READ TAG 02380C* READ DATA FROM TERMINAL. 02390C SETOF 909677 02400C EXSR SR102 VALIDATE FIELD # 02410C 55 GOTO UPDATE DONE 02420C EXSR SR201 IDENTIFY-F 02430C 03 GOTO EDIT 02440C SETON 69 02450C EXSR SR72 PROMPT 02460C SETOF 69 02470C EXSR SR75 READ TERMINAL 02480C 98 GOTO GOODBY GOODBY 02490C 94 GOTO MENU MENU REQUEST 02500C N77N88 EXSR SR104 EDIT INPUT FIELD ÐÐ02510C 96 ERROR 02520CORN77N88 EXSR SR72 REWRITE INPUT DATA 02530C 93 GOTO NEWITM NEW ITEM 02540C 92 GOTO JUMP FIELD JUMP REQST 02550C 89 F SUB 1 F SKIP BACKWARD 02560C 89 EXSR SR201 02570C 89 01 02580COR 89 02 02590COR 89 03 GOTO NEWITM 02600C 89 GOTO READ " " 02610C 88 SETOF 90 SPACE FILL 02620C 88 SETON 77 " " 02630C 86 GOTO UPDATE UPDATE 02640C 96 GOTO ERROR ERROR 02650C N77 GOTO EDIT NO DATA INPUT 02660C*------------------------------------------------------------------ 02670C PROCES TAG 02680C* PROCESS INPUT DATA 02690C EXSR SR103 MOVE DATA 02700C*------------------------------------------------------------------- 02710C EDIT TAG 02720C N96 EXSR SR104 EDIT DATA 02730C EXSR SR72 REWRITE DATA 02740C 96 GOTO ERROR ERROR 02750C GOTO NEXT ÐÐ02760C*------------------------------------------------------------------ 02770C UPDATE TAG 02780C* UPDATE DATA BASE. 02790C EXSR SR105 FINAL EDIT 02800C 96 GOTO ERROR ERROR 02810C EXSR SR106 UPDATE 02820C 96 GOTO ERROR ERROR 02830C GOTO START 02840C*------------------------------------------------------------------- 02850C JUMP TAG 02860C* SET-UP JUMP TO REQUESTED FIELD 02870C 1 ADD W W 30 02880C W COMP 16 54 02890C 54 Z-ADD318 M 50 96 FLAG ERROR 02900C 54 GOTO ERROR BAD ESC 02910C MOVE ' ' W3A 3 02920C MOVEAA16,W W3A 02930C Z-ADD3 W2N 20 02940C EXIT SUBRAJ R. JUSTIFY 02950C RLABL W2N 02960C RLABL W3A 02970C MOVE W3A F NEW FIELD # 02980C EXSR SR201 02990C 01 03000COR 02 ÐÐ03010COR 03 GOTO NEWITM 03020C GOTO READ 03030C*-------------------------------------------------------------------- 03040C ERROR TAG 03050C EXSR SR102 VALIDATE FIELD # 03060C EXSR SR89 GET MSG 03070C GOTO READ 03080C*------------------------------------------------------------------ 03090C NEWITM TAG 03100C* SET-UP LINK FOR NEW ITEM 03110C MOVEL'Q003PI 'PROG 8 03120C GOTO END 03130C*------------------------------------------------------------------- 03140C MENU TAG 03150C* SET-UP LINK TO MENU 03160C EXSR SR96 GET CRTFILE 03170C Z-ADD1 W 03180C BLK6 LOKUPLNK,W 54 03190C 54 MOVELLNK,W PROG 03200C 54 MOVE BLK6 LNK,W 03210C N54 MOVEL'CONTU' PROG 03220C EXSR SR97 UPD CRTFILE 03230C EXSR SR98 >>>>>>>>>> 03240C*-------------------------------------------------------------------- 03250C GOODBY TAG ÐÐ03260C* LINK TO SIGN-OFF 03270C MOVEL'GOODBY' PROG 03280C GOTO END 03290C*------------------------------------------------------------------- 03300C END TAG 03310C EXSR SR96 GET CRTFILE 03320C EXSR SR97 UPDATE CRTFILE 03330C EXSR SR98 >>>>>>>>>> 03340C*------------------------------------------------------------------- 03350C ENDJOB TAG 03360C MOVEL'ENDJOB' PROG 03370C EXSR SR98 >>>>>>>>>> 03380C********************************************************************* 03390CSR SR1 BEGSR 03400C* EDIT PO #. 03410CSR MOVE TPO W5N 50 03420CSR W5N COMP 0 54 03430CSRN54 Z-ADD341 M 96 FLAG ERROR 03440CSRN54 GOTO END1 03450CSR END1 ENDSR 03460C******************************************************************* 03470CSR SR2 BEGSR 03480C* EDIT ITEM #. 03490CSR Z-ADD0 OLDORD 70 03500CSR Z-ADD0 OLDRCD 70 ÐÐ03510CSR TITEM COMP 0 54 03520CSRN54 Z-ADD47 M 96 FLAG ERROR 03530CSRN54 GOTO END2 03540CSR MOVELTPO TPOITM 9 03550CSR MOVE TITEM TPOITM POITEM # 03560C* GET POITEM & PART MAST. 03570CSR EXSR SR80 GET POITEM MASTER 03580CSR 30 03590COR 31 Z-ADD510 M 96 FLAG ERROR 03600CSR 96 GOTO END2 ERROR 03610CSR Z-ADDTOTORD OLDORD 03620CSR Z-ADDPIQRCD OLDRCD 03630CSR PIVEND CHAINVMMAST 54 03640CSRN54 MOVELVMNAME VEND20 20 03650CSR 54 MOVE BLK35 VEND20 03660CSRN54 VMHOLD COMP BLK20 58 03670CSRN54N58 SETON 41 CUST HOLD 03680CSR EXSR SR71 DISPLAY ITEM 03690CSR Z-ADDPIQRCD NEWRCD 70 03700CSR 02 EXSR SR252 APPLY RCPTS 03710CSR 02 EXSR SR253 DISPLAY SCHED 03720CSR END2 ENDSR 03730C********************************************************************* 03740CSR SR3 BEGSR 03750C* EDIT LOG #. ÐÐ03760CSR DUN,F COMP ' ' 54 03770CSR 54 GOTO END3 03780CSR 1 ADD PILLOG PILLOG 03790CSR Z-ADDPILLOG TLOG DEFAULT 03800CSR MOVELTPO W9A 9 03810CSR MOVE TITEM W9A 03820CSR MOVELW9A TORD 11 03830CSR MOVE TLOG TORD 03840CSR MOVELPIPN W29A 29 03850CSR MOVEL'000000' W8A 8 03860CSR MOVE '10' W8A 03870CSR MOVELW8A W19A 19 03880CSR MOVE TORD W19A 03890CSR MOVE W19A W29A 03900CSR EXSR SR86 GET SFMAST 03910CSRN60 GOTO SR3 03920CSR MOVE W29A RPOKEY 29 03930CSR END3 ENDSR 03940C********************************************************************** 03950CSR SR4 BEGSR 03960C* EDIT QTY RECEIVED. 03970CSR 70 TQTY COMP 0 54 03980CSRN70 TQTY COMP 0 54 54 03990CSRN54 Z-ADD184 M 96 FLAG ERROR 04000CSRN54 GOTO END4 ÐÐ04010CSR Z-ADD1 S 04020CSR Z-ADDTQTY W7N 04030C*------------------------------------------------------------------- 04040CSR T4A TAG 04050CSR ZERO7 LOKUPOPN,S 54 04060CSRN54 GOTO T4G 04070CSR OPN,S COMP W7N 545554 04080CSR 54 W7N ADD RCD,S RCD,S 04090CSR 54 OPN,S SUB W7N OPN,S 04100CSR 54 Z-ADD0 W7N 56 04110CSR 55 OPN,S ADD RCD,S RCD,S 04120CSR 55 W7N SUB OPN,S W7N 56 04130CSR 55 Z-ADD0 OPN,S 04140CSR 56 GOTO T4A 04150CSR GOTO T4G 04160C*------------------------------------------------------------------- 04170CSR T4G TAG 04180CSR TQTY ADD PIQRCD TOTRCD 04190CSR Z-ADDTOTRCD NEWRCD 04200CSRN96 EXSR SR252 APPLY RCPTS 04210CSRN96 EXSR SR253 DISPLAY SCHEDULE 04220CSR END4 ENDSR 04230C******************************************************************** 04240CSR SR66 BEGSR 04250CSR EXITFZLF LINE FEED ÐÐ04260CSR ENDSR 04270C******************************************************************* 04280CSR SR69 BEGSR 04290CSR 50 EXITFZPUTXY POSITION CURSOR 04300CSR RLABL RPGLIN 04310CSR RLABL RPGCOL 04320CSRN50 EXITFZMOVXY MOVE CURSOR 04330CSR RLABL RPGLIN 04340CSR RLABL RPGCOL 04350CSR ENDSR 04360C***************************************************************** 04370CSR SR70 BEGSR 04380C* CLEAR TERM SCREEN. 04390CSR 50 EXITFZISTAT 04400CSR 50 EXITFZESCH CLEAR PAGE 04410CSRN50 EXITFZCPAGE CLEAR PAGE-4 04420CSRN50 MOVEL'091' RPGLIN 4 04430CSRN50 MOVEL'001' RPGCOL 4 04440CSRN50 EXSR SR69 MOVE CURSOR 04450CSR ENDSR 04460C********************************************************************** 04470CSR SR71 BEGSR 04480C* PUT HEADINGS TO TERMINAL 04490CSR PIWOD COMP 0 55 04500CSR SETON 71 ÐÐ04510CSR EXCPT PUT HEADINGS 04520CSR SETOF 71 04530CSR ENDSR 04540C********************************************************************* 04550CSR SR72 BEGSR 04560C* PUT DATA TO TERMINAL 04570CSR PIWOD COMP 0 55 04580CSR 91 ADD F W3N 30 04590CSR 50 W3N SUB 90 W3N 04600CSR MOVELW3N RPGLIN 04610CSR MOVEL'001' RPGCOL 04620CSR EXSR SR69 POSITION CURSOR 04630CSR SETON 72 04640CSR EXCPT PUT DATA 04650CSR SETOF 72 04660CSR ENDSR 04670C******************************************************************** 04680CSR SR73 BEGSR 04690C* PUT MGTEXT TO CRT. 04700CSR SETON 73 04710CSR EXCPT PUT MSG 04720CSR SETOF 73 04730CSR ENDSR 04740C******************************************************************* 04750CSR SR75 BEGSR ÐÐ04760C* READ FROM TERMINAL 04770CSR SETOF 779096 04780CSR SETOF 9392 04790CSR SETOF 8988 04800CSR SETOF 86 04810CSR 92 ADD F W3N 3 04820CSR 50 W3N SUB 90 W3N 04830CSR MOVELW3N RPGLIN 04840CSR MOVEL'029' RPGCOL 04850CSR EXSR SR69 MOVE CURSOR 04860CSR MOVE BLK16 W16A 16 BUFFER 04870CSR EXITFZR16 READ FROM TERMINAL 04880CSR RLABL W16A READ BUFFER 04890CSR MOVEAW16A A16 INPUT DATA ARRAY 04900CSR MOVE BLK16 W16A INIT INPUT ARRAY 04910CSR Z-ADD1 W 30 04920CSR '\' LOKUPA16,W 90 FLAG ESC 04930CSRN90 GOTO T75B NOT ESC 04940CSR 1 ADD W W 04950CSR W COMP 16 54 04960CSR 54 GOTO T75A BAD ESC 04970CSR A16,W COMP 'G' 98 GOODBY 04980CSR A16,W COMP 'E' 94 MENU 04990CSR A16,W COMP 'N' 93 NEW ITEM 05000CSR A16,W COMP 'J' 92 JUMP ÐÐ05010CSR A16,W COMP 'B' 89 SKIP BKWRD 05020CSR A16,W COMP 'S' 88 SPACE FILL 05030CSR A16,W COMP 'U' 86 UPDATE 05040CSR 98 05050COR 94 05060COR 93 05070COR 92 05080COR 89 05090COR 88 05100COR 86 GOTO END75 GOOD ESC 05110C*------------------------------------------------------------------ 05120CSR T75A TAG 05130C* FLAG BAD ESC INPUT 05140CSR Z-ADD318 M 96 FLAG ERROR 05150CSR GOTO END75 05160C*-------------------------------------------------------------------- 05170CSR T75B TAG 05180C* MOVE DATA 05190CSR Z-ADD1 W 05200CSR ' ' LOKUPA16,W 77 05210CSR 77 MOVEAA16,W W16A INPUT DATA 05220C*-------------------------------------------------------------------- 05230CSR END75 TAG 05240C* INIT PREV ERROR MSG. 05250CSR MOVE BLK35 MGTEXT ÐÐ05260CSR ENDSR 05270C******************************************************************** 05280CSR SR76 BEGSR 05290C* PUT SCHEDULE HEADINGS 05300CSR 40 GOTO T76B 05310CSRN50 MOVEL'104' RPGLIN 05320CSR 50 MOVEL'014' RPGLIN 05330CSR MOVEL'001' RPGCOL 05340CSR EXSR SR69 MOVE CURSOR 05350CSR SETON 75 05360CSR EXCPT PUT SCHED HEADING 05370CSR SETOF 75 05380C*------------------------------------------------------------------- 05390CSR T76B TAG 05400C* PUT SCHEDULE DATA TO CRT 05410CSRN50 S ADD 105 W3N 30 05420CSR 50 W3N SUB 90 W3N 05430CSR S COMP 13 54 05440CSR 54 W3N SUB 13 W3N 05450CSR 54 MOVEL'060' RPGCOL 05460CSRN54 MOVEL'001' RPGCOL 05470CSR W3N SUB 1 W3N 05480CSR MOVELW3N RPGLIN 05490CSR EXSR SR69 MOVE CURSOR 05500CSR SETON 76 ÐÐ05510CSR EXCPT PUT SCHED DATA 05520CSR SETOF 76 05530CSR SETON 40 05540CSR ENDSR 05550C********************************************************************** 05560CSR SR78 BEGSR 05570CSR SETON 78 05580CSR EXCPT ADD PORECD REC 05590CSR SETOF 7841 05600CSR ENDSR 05610C********************************************************************** 05620CSR SR80 BEGSR 05630C* GET POITEM MASTER. 05640CSR Z-ADD0 TOTORD 70 05650CSR SETOF 3170 05660CSR TPOITM CHAINPOITEM 30 GET POITEM 05670CSRN30 PISTAT COMP 'D' 31 FLAG DELETE 05680CSR MOVE BLK35 LOTNAM 10 05690CSR 30 NOT ON FILE 05700COR 31 GOTO END80 DELETED 05710CSR EXSR SR204 CLASSIFY ACCOUNT 05720CSRN70 GOTO END80 NOT INVENTORY 05730CSR EXSR SR83 GET PART MAST 05740CSR 60 Z-ADD291 M 96 FLAG ERROR 05750CSR 60 GOTO END80 ÐÐ05760CSR EXSR SR206 CLASSIFY LOT CODE 05770CSR XFOOTPIQ TOTORD 70 05780CSR END80 ENDSR 05790C*********************************************************************** 05800CSR SR82 BEGSR 05810C* REWRITE POITEM 05820CSR SETON 82 05830CSR EXCPT REWRITE POITEM 05840CSR SETOF 82 05850CSR ENDSR 05860C******************************************************************** 05870CSR SR83 BEGSR 05880C* GET PART MAST. 05890CSR MOVELPIPN W12A 12 05900CSR MOVE ' ' W12A 05910CSR W12A CHAINPMMST2 60 GET PMMST2 05920CSRN60 PMSTAT COMP 'D' 60 05930CSR ENDSR 05940C******************************************************************** 05950CSR SR84 BEGSR 05960C* UPDATE PART MAST. 05970CSR TOTORD SUB NEWRCD W7N 70 54 05980CSRN54 Z-ADD0 W7N 05990CSR PMPOB SUB W7N PMPOB PO-BAL 06000CSR TQTY ADD PMRPOB PMRPOB RPO-BAL ÐÐ06010CSR SETON 84 06020CSR EXCPT UPDATE PMMST2 06030CSR SETOF 84 06040CSR ENDSR 06050C****************************************************************** 06060CSR SR85 BEGSR 06070C* UPDATE SFMAST 06080CSR SETON 85 06090CSR EXCPT UPDATE SFMAST 06100CSR SETOF 85 06110CSR ENDSR 06120C********************************************************************** 06130CSR SR86 BEGSR 06140C* GET SFMAST 06150CSR W29A CHAINSFMAST 60 06160CSRN60 SFSTAT COMP 'D' 54 06170CSR ENDSR 06180C********************************************************************** 06190CSR SR89 BEGSR 06200C* GET MESSAGE MASTER 06210CSR M CHAINMGFILE 54 06220CSR 54 MOVE BLK35 MGTEXT 06230CSR 54 MOVELM MGTEXT 06240CSR 54 MOVE MES,1 MGTEXT 06250CSR ENDSR ÐÐ06260C******************************************************************** 06270CSR SR96 BEGSR 06280CSR # CHAINCRTFILE H9 GET CRTFILE 06290CSR H9 GOTO ENDJOB 06300CSR ENDSR 06310C****************************************************************** 06320CSR SR97 BEGSR 06330C* UPDATE CRTFILE. 06340CSR TIME CRTIME 06350CSR MOVELUDATE CRDATE 06360CSR SETON 97 06370CSR EXCPT UPDATE CRTFILE 06380CSR SETOF 97 06390CSR ENDSR 06400C******************************************************************** 06410CSR SR98 BEGSR 06420CSR EXITFCHAIN >>>>>>>>>> 06430CSR RLABL PROG 06440CSR ENDSR 06450C*********************************************************************** 06460CSR SR101 BEGSR 06470C* 1-TIME INITIALIZE 06480CSR MOVE BIT,1 NUL 06490CSR Z-ADD5 FLIMIT 30 TOTAL NUMB FIELDS 06500CSR MOVE ' ' BLK16 16 ÐÐ06510CSR MOVELUDATE W4N 40 06520CSR MOVE UDATE W2N 06530CSR MOVELW2N TODAY 60 06540CSR MOVE W4N TODAY 06550C* GET PORT # AND CRTFILE 06560CSR MOVE ' ' W2A 2 06570CSR EXITFZGMINX GET PORT # 06580CSR RLABL W2A 06590CSR MOVE W2A # 20 PORT NO. 06600CSR # COMP 0 54 06610CSRN54 Z-ADD25 # DEFAULT 06620CSR EXSR SR96 GET CRTFILE 06630CSR MOVE CALL LNK 06640CSR MOVE 'Q003PI 'PROG 06650CSR PAR,# COMP '1' 50 06660CSR TST,# COMP 'S' 54 06670CSR 54 MOVEL'SHUTDOWN'PROG 06680CSR EXSR SR97 UPD CRTFILE 06690CSR 54 EXSR SR98 >>>>>>>>>> 06700CSR MOVE ' 'PROG 06710C* DEFINE WORK FIELDS,ETC. 06720CSR MOVE ' ' BLK35 35 06730CSR MOVE ' ' BLK20 20 06740CSR MOVE ' ' BLK8 8 06750CSR Z-ADD0 ZERO7 70 ÐÐ06760CSR Z-ADD0 ZERO6 60 06770CSR ENDSR 06780C********************************************************************** 06790CSR SR102 BEGSR 06800C* VALIDATE FIELD NO. 06810CSR F COMP 0 54 06820CSRN54 Z-ADD1 F 06830CSR F COMP FLIMIT 55 06840CSR 55 Z-ADD1 F 06850CSR ENDSR 06860C******************************************************************** 06870CSR SR103 BEGSR 06880C* MOVE INPUT DATA 06890CSR EXSR SR201 IDENTIFY-F 06900CSR EXSR SR202 R. JUSTIFY 06910CSR 01 EXSR SR211 BUILD P.O.# 06920CSR 02 MOVE W10A TITEM 30 ITEM # 06930CSR 03 MOVE W10A TLOG 20 RECEIVING LOG # 06940CSR 04 MOVE W10A TQTY 70 QTY RECEIVED 06950CSR 05 MOVELW16A TPKGS 9 PKG SLIP 06960CSR MOVE ' ' DUN,F EDIT FLAG 06970CSR ENDSR 06980C******************************************************************** 06990CSR SR104 BEGSR 07000C* EDIT INPUT DATA ÐÐ07010CSR 01 EXSR SR1 07020CSR 02 EXSR SR2 07030CSR 03 EXSR SR3 07040CSR 04 EXSR SR4 07050CSR 96 MOVE ' ' DUN,F EDIT FLAG 07060CSRN96 MOVE 'X' DUN,F 07070CSR ENDSR 07080C*********************************************************************** 07090CSR SR105 BEGSR 07100C* FINAL EDIT 07110CSR SETOF 77 07120CSR SETON 79 FINAL EDIT FLAG 07130CSR Z-ADD1 F 96 07140C*-------------------------------------------------------------------- 07150CSR T105A TAG 07160CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 07170CSRN54 GOTO END105 07180CSR EXSR SR201 IDENTIFY-F 07190CSR EXSR SR104 EDIT 07200CSRN96 GOTO T105A 07210C*-------------------------------------------------------------------- 07220CSR END105 TAG 07230CSR SETOF 79 07240CSR ENDSR 07250C******************************************************************** ÐÐ07260CSR SR106 BEGSR 07270C* UPDATE. 07280CSR Z-ADDTODAY PIDLR DATE LAST TRAN 07290CSR PIQRCD ADD TQTY NEWRCD 70 54 UPDATED TOTAL RECVD 07300CSRN54 Z-ADD0 NEWRCD 07310C* UPDATE SFMAST RECD PO RECORD 07320CSR 70 SETON 81 07330CSR 70 EXCPT ADD SFMAST RPO 07340CSR SETOF 81 07350C* UPDATE PART MAST, PO ITEM MAST, AND SFMAST PO RECORDS 07360CSR 70 EXSR SR214 UPDATE SFMAST PO'S 07370CSR 70 EXSR SR255 OUTPUT PO PERFORM 07380CSR EXSR SR82 UPDATE POITEM 07390CSR 70 EXSR SR84 UPDATE PMMST2 07400CSR END106 ENDSR 07410C************************************************************************ 07420CSR SR201 BEGSR 07430C* IDENTIFY FIELD NO. 07440CSR F COMP 1 01 07450CSR F COMP 2 02 07460CSR F COMP 3 03 07470CSR F COMP 4 04 07480CSR F COMP 5 05 07490CSR ENDSR 07500C********************************************************************** ÐÐ07510CSR SR202 BEGSR 07520C* RIGHT JUSTIFY 07530CSR F LOKUPNUM 54 07540CSRN54 GOTO END202 NOT NUMERIC FIELD 07550CSR Z-ADD10 W2N 20 07560CSR MOVELW16A W10A 10 07570CSR EXIT SUBRAJ R. JUSTIFY 07580CSR RLABL W2N 07590CSR RLABL W10A 07600CSR END202 ENDSR 07610C******************************************************************** 07620CSR SR204 BEGSR 07630C* CLASSIFY ACCOUNT. 07640CSR PIWOP COMP ' 12100' 70 07650CSRN70 PIWOP COMP ' 14100' 70 07660CSRN70 PIWOP COMP ' 14600' 70 07670CSR ENDSR 07680C******************************************************************** 07690CSR SR205 BEGSR 07700C* INIT INPUT DATA. 07710CSR MOVE ' ' TPO 07720CSR Z-ADD0 TITEM 07730CSR Z-ADD0 TLOG 07740CSR Z-ADD0 TQTY 07750CSR MOVE BLK16 TPKGS ÐÐ07760CSR Z-ADD0 PIPO 07770CSR Z-ADD0 PIPN 07780CSR MOVE BLK16 PIVPN 07790CSR MOVE BLK35 PIDESC 07800CSR MOVE BLK35 PINDES 07810CSR MOVELBLK35 PINDES 07820CSR Z-ADD0 PIDLR 07830CSR Z-ADD0 PIQRCD 07840CSR Z-ADD0 PIQSTK 07850CSR MOVE ' ' PILOT 07860CSR Z-ADD0 PI$PRC 07870CSR MOVE BLK16 PIWO 07880CSR MOVE BLK8 PIWOP 07890CSR Z-ADD0 PIWOD 07900CSR Z-ADD0 PIVEND 07910CSR Z-ADD0 PILLOG 07920CSR Z-ADD0 PID 07930CSR Z-ADD0 PIQ 07940CSR MOVE ' ' PISTAT 07950CSR MOVE BLK35 VMNAME 07960CSR MOVE BLK35 PMDESC 07970CSR MOVE BLK16 LOTNAM 07980CSR ENDSR 07990C******************************************************************* 08000CSR SR206 BEGSR ÐÐ08010C* CLASSIFY LOT CODE. 08020CSR PILOT COMP 'L' 49 LOT PRICE 08030CSR PILOT COMP 'N' 51 NO CHARGE 08040CSR MOVE BLK35 LOTNAM 10 08050CSR 49 MOVE LN,1 LOTNAM 08060CSR 51 MOVE LN,2 LOTNAM 08070CSRN49N51 MOVE LN,3 LOTNAM 08080CSR ENDSR 08090C******************************************************************** 08100CSR SR211 BEGSR 08110C* BUILD PO #. 08120CSR MOVEAW16A A16 08130CSR A16,1 COMP '0' 54 54 08140CSRN54 GOTO T211A NON-NUMERIC INPUT 08150CSR MOVEAA16,1 W5A 5 08160CSR Z-ADD5 W2N 08170CSR EXIT SUBRAJ R.J. 08180CSR RLABL W2N 08190CSR RLABL W5A 08200CSR MOVEL' ' TPO 6 08210CSR MOVE W5A TPO 08220CSR GOTO END211 08230C*------------------------------------------------------------------- 08240CSR T211A TAG 08250CSR MOVELW16A TPO ÐÐ08260CSR MOVE TPO W5A 08270CSR Z-ADD5 W2N 08280CSR EXIT SUBRAJ R.J. 08290CSR RLABL W2N 08300CSR RLABL W5A 08310CSR MOVE W5A TPO 08320CSR END211 ENDSR 08330C****************************************************************** 08340CSR SR214 BEGSR 08350C* UPDATE PURCH ORDER SFMAST RECORDS WITH RECEIVED QTY 08360CSR Z-ADD1 R 30 08370CSR MOVELPIPN W29A 08380CSR MOVE '30' W8A 08390CSR MOVE TORD W19A 08400CSR MOVE '00' W19A 08410C*---------------------------------------------------------------------- 08420CSR T214A TAG 08430CSR ZERO7 LOKUPPIQ,R 54 GET NEXT RECVD QTY 08440CSRN54 GOTO END214 DONE 08450CSR MOVELPID,R W8A 08460CSR MOVELW8A W19A 08470CSR MOVE W19A W29A 08480CSR W29A CHAINSFMAST 60 08490CSR Z-ADDPIQ,R SFQTY 08500CSR Z-ADDRCD,R SFQTYC ÐÐ08510CSR EXSR SR85 UPDATE SFMAST PO 08520CSR 1 ADD R R 08530CSR R COMP 13 54 08540CSRN54 GOTO T214A 08550CSR END214 ENDSR 08560C********************************************************************* 08570CSR SR252 BEGSR 08580C* APPLY RECEIPTS TO SCHEDULE 08590CSR Z-ADD0 RCD 08600CSR Z-ADD1 A 08610CSR Z-ADDNEWRCD SAVQTY 70 57 08620C*------------------------------------------------------------------- 08630CSR T252A TAG 08640CSRN57 GOTO END252 08650CSR ZERO7 LOKUPPIQ,A 54 08660CSRN54 GOTO T252C 08670CSR Z-ADDPIQ,A W7N 70 08680CSR SAVQTY COMP W7N 545556 08690CSR 54 Z-ADDW7N RCD,A 08700CSR 54 SAVQTY SUB W7N SAVQTY 57 08710CSR 54 Z-ADD0 W7N 08720CSR 55 Z-ADDSAVQTY RCD,A 08730CSR 55 W7N SUB SAVQTY W7N 08740CSR 55 Z-ADD0 SAVQTY 57 08750CSR 56 Z-ADDSAVQTY RCD,A ÐÐ08760CSR 56 Z-ADD0 SAVQTY 57 08770CSR 56 Z-ADD0 W7N 08780CSR 1 ADD A A 30 08790CSR A COMP 13 54 08800CSRN57 08810COR 54 GOTO END252 08820CSR GOTO T252A 08830C*-------------------------------------------------------------------- 08840CSR T252C TAG 08850CSR Z-ADD1 A 08860CSR ZERO7 LOKUPPIQ,A 54 08870CSR 54 Z-ADDSAVQTY RCD,A 08880CSR END252 ENDSR 08890C********************************************************************* 08900CSR SR253 BEGSR 08910C* DISPLAY SCHEDULE. 08920CSR Z-ADD0 S 30 08930CSR PIQ SUB RCD OPN OPEN PO QTYS 08940CSR SETOF 40 08950CSR MOVE BLK35 MGTEXT 08960C*------------------------------------------------------------------- 08970CSR T253A TAG 08980CSR 1 ADD S S 08990CSR S COMP 13 54 09000CSR 54 GOTO T253C ÐÐ09010CSR PIQ,S COMP 0 54 09020CSRN54 RCD,S COMP 0 54 09030CSR 13 ADD S Y 30 09040CSR PID,Y COMP 0 58 09050CSRN54 58 Z-ADDPID,S PID,Y 09060CSRN54 GOTO T253A 09070CSR EXSR SR76 PUT SCHEDULE 09080CSR GOTO T253A 09090C*------------------------------------------------------------------- 09100CSR T253C TAG 09110C* PUT TOTALS. 09120CSR XFOOTPIQ TOTPIQ 80 09130CSR XFOOTRCD TOTRCD 80 09140CSR TOTPIQ SUB TOTRCD TOTOPN 80 09150CSR SETON 74 09160CSR EXCPT PUT TOTALS 09170CSR SETOF 74 09180CSR ENDSR 09190C*********************************************************************** 09200CSR SR255 BEGSR 09210C* APPLY RECEIPTS TO SCHEDULE FOR P/O PERFORMANCE 09220CSR Z-ADD0 REC 09230CSR Z-ADD1 A 09240CSR Z-ADDPIQRCD SAVRCD 70 53 09250C*-------------------------------------------------------------------- ÐÐ09260CSR T255A TAG 09270CSRN53 GOTO T255B 09280CSR ZERO7 LOKUPPIQ,A 54 09290CSRN54 GOTO END255 09300CSR Z-ADDPIQ,A W7N 09310CSR SAVRCD COMP W7N 545556 09320CSR 54 Z-ADDW7N REC,A 09330CSR 54 SAVRCD SUB W7N SAVRCD 53 09340CSRN54 Z-ADDSAVRCD REC,A 09350CSRN54 Z-ADD0 SAVRCD 53 09360CSR 1 ADD A A 09370CSR A COMP 13 54 09380CSRN54 53 GOTO T255A 09390C*-------------------------------------------------------------------- 09400CSR T255B TAG 09410CSR Z-ADD0 Y 30 09420CSR Z-ADD1 A 09430CSR Z-ADD0 W7N 09440CSR Z-ADDTQTY RECQTY 70 09450C*----------------------------------------------------------------------- 09460CSR T255C TAG 09470CSR PIQ,A COMP 0 54 09480CSRN54 GOTO END255 09490CSR PIQ,A SUB REC,A W7N 545658 09500CSR 56 GOTO END255 ÐÐ09510CSR 58 GOTO T255D 09520CSR RECQTY COMP W7N 545654 09530CSR 56 Z-ADDRECQTY RECPO 70 NEW RECD QTY 09540CSR 56 Z-ADD0 RECQTY 09550CSR 54 Z-ADDW7N RECPO 09560CSR A ADD 13 Y 09570CSR PID,Y COMP 0 58 09580CSR 58 Z-ADDPID,A PID,Y 09590CSR EXSR SR78 OUTPUT PORECD 09600CSR RECQTY SUB W7N RECQTY 09610CSR Z-ADD0 RECPO 09620CSR Z-ADD0 W7N 09630C*-------------------------------------------------------------------- 09640CSR T255D TAG 09650CSR RECQTY COMP 0 54 09660CSRN54 GOTO END255 09670CSR 1 ADD A A 09680CSR A COMP 13 54 09690CSRN54 GOTO T255C 09700CSR END255 ENDSR 09710C********************************************************************** 09720OTERM132 E 71 09730O* PUT HEADINGS 09740O BIT,28 1 09750O N50 8 '8091001' ÐÐ09760O N50 BIT,1 9 09770O N50 BIT,1 10 09780O 50 10 '[001 ]001' 09790O 50 BIT,28 6 09800O 80 'RECEIVE P.O.' 09810O 86 'INPUT' 09820O UDATE Y 18 09830O*------------------------------------------------------------------- 09840O E 71 09850O 1 ' ' 09860O*------------------------------------------------------------------- 09870O E 71 09880O OR 72 01 09890O DOT 26 09900O 4 '(1)' 09910O 14 'P.O. NO.' 09920O TPO 36 09930O VMNAME 75 09940O MGTEXT 132 09950O*------------------------------------------------------------------- 09960O E 71 09970O OR 72 02 09980O DOT 26 09990O 4 '(2)' 10000O 17 'ITEM NUMBER' ÐÐ10010O TITEM Z 33 10020O MGTEXT 132 10030O*------------------------------------------------------------------- 10040O E 71 10050O OR 72 03 10060O DOT 26 10070O 21 'RECEIVING LOG #' 10080O 4 '(3)' 10090O TLOG Z 32 10100O MGTEXT 132 10110O*------------------------------------------------------------------- 10120O E 71 10130O OR 72 04 10140O DOT 26 10150O 4 '(4)' 10160O 18 'QTY RECEIVED' 10170O TQTY 2 37 10180O MGTEXT 132 10190O*------------------------------------------------------------------- 10200O E 71 10210O OR 72 05 10220O DOT 26 10230O 4 '(5)' 10240O 20 'PACKING SLIP #' 10250O TPKGS 37 ÐÐ10260O MGTEXT 132 10270O*------------------------------------------------------------------- 10280O E 71 10290O 26 ':' 10300O 21 'ORDER/ACCOUNT #' 10310O PIWOP 34 10320O 55 35 '-' 10330O 55 PIWOD 38 10340O MGTEXT 132 10350O*------------------------------------------------------------------- 10360O E 71 70 10370O 26 ':' 10380O 12 'PART #' 10390O PIPN 40 ' - - ' 10400O PMDESC 71 10410O MGTEXT 132 10420O*------------------------------------------------------------------- 10430O E 71 70 10440O 26 ':' 10450O 19 'VENDOR PART #' 10460O PIVPN 43 10470O MGTEXT 132 10480O*------------------------------------------------------------------- 10490O E 71N70 10500O 26 ':' ÐÐ10510O 22 'ITEM DESCRIPTION' 10520O PINDES 98 10530O MGTEXT 132 10540O*------------------------------------------------------------------- 10550O E 71 10560O 26 ':' 10570O 22 'PRICE-CODE (L,N)' 10580O PILOT 29 10590O LOTNAM 44 10600O MGTEXT 132 10610O*------------------------------------------------------------------- 10620O E 71 10630O 26 ':' 10640O 11 'PRICE' 10650O PI$PRC2 41 10660O MGTEXT 132 10670O*------------------------------------------------------------------- 10680O E 71 10690O 1 ' ' 10700O*----------------------------------------------------------------- 10710O E 75 10720O* SCHEDULE HEADING 10730O 8 'DUE-DATE' 10740O 19 'SCHED-QTY' 10750O 30 'QTY-RECVD' ÐÐ10760O 41 'QTY-OPEN' 10770O*-------------------------------------------------------------- 10780O E 76 10790O* PUT SCHEDULE DATA 10800O PID,S 8 ' - - ' 10810O PIQ,S 2 19 10820O RCD,S 2 30 10830O OPN,S K 41 10840O*-------------------------------------------------------------------- 10850O* E 73 10860O* PUT MESSAGE. 10870O* NUL 132 10880O* BIT,28 1 10890O* 2 '8' 10900O* LOC 5 10910O* N50 8 '098' 10920O* N50 BIT,1 9 10930O* N50 BIT,1 10 10940O* 50 10 '098' 10950O* 50 BIT,28 6 10960O* MGTEXT 45 10970O* 96 BIT,8 132 10980O*------------------------------------------------------------------- 10990O E 74 11000O* PUT SCHED TOTALS. ÐÐ11010O NUL 132 11020O BIT,28 1 11030O N50 8 '8120056' 11040O N50 BIT,1 9 11050O N50 BIT,1 10 11060O 50 10 '[024 ]056' 11070O 50 BIT,28 6 11080O 18 'TOTALS ' 11090O TOTPIQ2 28 11100O 29 ' ' 11110O TOTRCD2 39 11120O 40 ' ' 11130O TOTOPNK 51 11140O BIT,28 131 11150O 132 'K' 11160O******************************************************************** 11170OCRTFILE E 97 11180O PROG 26 11190O CRTIME 33 11200O CRDATE 37 11210O LNK 79 11220O******************************************************************** 11230OPOITEM E 82 11240O PIPN 19 11250O PIVPN 34 ÐÐ11260O 70 PIDESC 63 11270O N70 PINDES 79 11280O PIDLR 85 11290O NEWRCD 89P 11300O PIQSTK 93P 11310O PILOT 94 11320O PI$PRC 99P 11330O PIWO 108 11340O PIVEND 111P 11350O PILLOG 113 11360O PID 269 11370O PIQ 373P 11380O PISTAT 384 11390O******************************************************************** 11400OSFPNA EADD 82 70 11410O PIPN 10 11420O******************************************************************* 11430OPMMST2 E 84 11440O* * * * PLT 128P 11450O PMOHB 314P 11460O PMPOB 346P 11470O PMRPOB 350P 11480O******************************************************************** 11490OSFMAST EADD 85 60 11500O OR 81 ÐÐ11510O 85 W29A 29 11520O 81 RPOKEY 29 11530O 85 SFQTY 33P 11540O 85 SFQTYC 37P 11550O 81 TQTY 33P 11560O 81 ZERO7 37P 11570O TODAY 43 11580O PIVEND 46P 11590O PMECHG 66 11600O VEND20 90 11610O PI$PRC 95P 11620O 81 TPKGS 104 11630O PILOT 105 11640O ZERO7 123P 11650O ZERO7 127P 11660O 128 'A' 11670O*------------------------------------------------------------------- 11680O E 85N60 11690O SFQTY 33P 11700O SFQTYC 37P 11710O TODAY 43 11720O PIVEND 46P 11730O PMECHG 66 11740O VEND20 90 11750O PI$PRC 95P ÐÐ11760O PILOT 105 11770O ZERO7 123P 11780O ZERO7 127P 11790O SFSTAT 128 11800O************************************************************************* 11810OPORECD EADD 78 11820O PIVEND 5 11830O VEND20 25 11840O PIPO 31 11850O PIPN 37P 11860O TODAY 43 11870O PID,Y 49 11880O PID,A 55 11890O RECPO 59P 11900O PIQ,A 63P 11910O PI$PRC 68P 11920O********** 41 74 'H' 11930O*********************************************************************** ** NUL ARRAY 011940 011950** A16 ARRAY 011960 011970** NUM ARRAY 011980002 ITEM 011990003 LOG 12000ÐÐ004 QTY 12010** DUN ARRAY 012020 012030** MES ARRAY 012040---MESSAGE NOT ON FILE--- 012050** A29 ARRAY 12060 12070** DOT ARRAY 12080 - - - - - - - - - -> 12090** LN ARRAY 12100LOT PRICE 12110NO CHARGE 12120UNIT PRICE 12130** RCD ARRAY 12140 12150** REC ARRAY 12160 12170** OPN ARRAY 12180 12190** LNK ARRAY 12200 12210/* 12220_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(<É <X096ES P120282120282(èÈÐ00010H Q096ES00020F* LIST DUPLICATE KEY MFG PN TRANS. (X096ES) 00030F* REVISED 4/23/80 1:15 PM. DG-REL006 OK. 00040FOLDPL IP F 80 80 DISK 00050FPEMAST IC F 45R17AI 1 DISK 00060FEPMAST IC F 45R29AI 1 DISK 00070FPRINT O F 132 OF PRINTER 00080I******************************************************************** 00090IOLDPL PL 01 00100I 3 120PN 20 00110I 49 52 MFG 21 00120I 53 73 MPN 22 00130I******************************************************************** 00140IPEMAST PE 00150I 1 100PEPN 00160I 13 17 PEMFG 00170I 18 41 PEMPN 00180I******************************************************************** 00190IEPMAST EP 00200I 1 5 EPMFG 00210I 6 29 EPMPN 00220I 30 390EPPN 00230C******************************************************************** 00240C SETOF 8081 00250C SETOF 6061 ÐÐ00260C MOVELPN W17A 17 00270C MOVELMFG W5A 5 00280C MOVE W5A W17A 00290C N21 W17A CHAINPEMAST 60 00300C MOVELMPN W24A 24 00310C N21N60 W24A COMP PEMPN 80 00320C MOVELW5A W29A 29 00330C MOVE W24A W29A 00340C N21 W29A CHAINEPMAST 61 00350C N21N61 PN COMP EPPN 81 00360O******************************************************************** 00370OPRINT H 101 1P 00380O OR OF 00390O 127 'PAGE' 00400O PAGE Z 132 00410O 30 'DYNAIR/MFR' 00420O 90 'MFR/DYNAIR' 00430O*------------------------------------------------------------------- 00440O D 01N21N80 00450O AND N60 00460O OR 01N21N81 00470O AND N61 00480O N80 PN 12 ' - - ' 00490O N80 MFG 20 00500O N80 MPN 50 ÐÐ00510O N81 PN 65 ' - - ' 00520O N81 MFG 75 00530O N81 MPN 105 /* 000540_‚ _‚_‚0O******************************************************************** 00370OPRINT H 101 1P 00380O OR OF 00390O 127 'PAGE' 00400O PAGE Z 132 00410O 30 'DYNAIR/MFR' 00420O 90 'MFR/DYNAIR' 00430O*------------------------------------------------------------------- 00440O D 01N21N80 00450O AND N60 00460O OR 01N21N81 00470O AND N61 00480O N80 PN 12 ' - - ' 00490O N80 MFG 20 00500O N80 MPN 50 ÐÈ(ã  X096PM P 120282120282(èÈÐ00010H Q096PM00020F* COPY 122-BYTE DISKETT FILE TO 80-COL DISK FILE. (X096PM) 00030F* CREATED FOR Z098PM STREAM. COPY OF UT XDP003. 00040F* REV 6/18/79 3:15 PM. 00050F* 00060FFLOPPY IP F 122 17 00070F KEBCDIC 00080FTRANFL O F 80 80 DISK A 00090IFLOPPY FL 01 00100I 1 2 EOF 00110I 1 80 REC 70 00120C EOF COMP '/*' 54 00130C 54 SETON LR 00140OTRANFL DADD 01N54N70 00150O REC 80 /* 000160_‚ _‚_‚0O OR 01N21N81 00470O AND N61 00480O N80 PN 12 ' - - ' 00490O N80 MFG 20 00500O N80 MPN 50 ÐÈ(–í –?X097CF P120282120282(èÈÐ00010H Q097CF00020F* LIST NATEMP FILE (X097CF) 00030F* REVISED 7/02/79 4:30 PM. 00040FNATEMP IP F 80R I DISK 00050FNAADRT IR F 4 3IT EDISK 00060FPRINT O F 132 OF PRINTER 00070E******************************************************************** 00080E NAADRT NATEMP 00090I******************************************************************** 00100INATEMP NA 01 00110I* CUSTOMER MAST CARD-OLD STYLE - CARD-1 00120I* KEY FIELD 7A 00130I 1 7 CCKEY 20 00140I* CUST # 5N 00150I 1 50CCCUST 21 00160I* CARD CODE 2A 00170I* C1 = CUST - SOLD TO 00180I* C3 = CUST - BILL TO 00190I* M1 = CATALOG 00200I 6 7 CCCARD 22 00210I* EXPORT 1A 00220I 8 8 CCEXPT 23 00230I* CLASS 2A 00240I 9 10 CCCLAS 24 00250I* REC CODE 3A ÐÐ00260I* BLK 00270I* ADD 00280I* TRF 00290I 11 13 CCREC 25 00300I* NAME - 1ST 23A 00310I 15 37 CCNAM1 26 00320I* NAME - 2ND 20A 00330I 38 57 CCNAM2 27 00340I* ADDRESS-1 23A 00350I 58 80 CCADR1 28 00360I*------------------------------------------------------------------- 00370I* CUST CARD-OLD STYLE - CARD-2 00380I* COL 1-13 SAME AS CARD1 00390I* ADDRESS-2 20A 00400I 15 34 CCADR2 29 00410I* CITY 23A 00420I 35 57 CCCITY 30 00430I* STATE & ZIP 7A 00440I 58 64 CCSTZP 31 00450I* COUNTRY (IF NOT U.S.) 23A 00460I 58 80 CCCTRY 32 00470I 80 80 FLAG 00480I*------------------------------------------------------------------- 00490I* CATALOG CARD-OLD STYLE - CARD-1 00500I* SAME AS CUST CARD-1 EXCEPT FOR CARD CODE. ÐÐ00510I*------------------------------------------------------------------- 00520I* CATALOG CARD-OLD STYLE - CARD-2 00530I* SAME AS CUST CARD-2 EXCEPT FOR CARD CODE. 00540C******************************************************************** 00550C MOVE ' ' FLAG 00560C MOVE CCCARD W1A 1 00570C W1A COMP '1' 01 00580C N01 W1A COMP '3' 01 00590C W1A COMP '2' 02 00600C N02 W1A COMP '4' 02 00610C MOVELCCCUST W6A 6 00620C MOVELCCCARD W1AA 1 00630C 02 MOVELCCSTZP STATE 2 00640C 02 MOVE CCSTZP ZIP 50 00650O******************************************************************** 00660OPRINT H 101 1P 00670O OR OF 00680O 70 'NAME/ADDRESS WORK FILE' 00690O 127 'PAGE' 00700O PAGE Z 132 00710O H 2 1P 00720O OR OF 00730O 5 'CUST#' 00740O 9 'CC' 00750O 13 'EXP' ÐÐ00760O 19 'CLASS' 00770O 40 'ADDRESS' 00780O D 11 01 00790O D 1 01 00800O D 1 01 00810O CCCUST 5 00820O W1AA 6 00830O W1A 9 00840O CCEXPT 13 00850O CCCLAS 17 00860O CCREC 21 00870O CCNAM1 50 00880O D 1 01N27 00890O CCNAM2 47 00900O D 1 01N28 00910O CCADR1 50 00920O* 00930O D 1 02 00940O W1A 9 00950O CCADR2 47 00960O D 1 02N30 00970O CCCITY 50 00980O D 1 02 00990O STATE 29 01000O D 1 02 ÐÐ01010O ZIP Z 32 01020O D 1 02N32 01030O CCCTRY 50 01040O FLAG 50 /* 001050_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(-  X097CM P120282120282(èÈÐ00010H Q097CM00020F* GENERATE CUSTOMER ALT-KEY FILE. (X097CM) 00030F* REVISED 9/11/79 4:40 PM. 00040FCMMAST IP F 576 5AI 1 DISK 00050FCMKEY O F 26R25AI 1 DISK A 00060I******************************************************************** 00070ICMMAST CM 01 576NCD 00080I 1 50CMCUST 00090I 6 25 CMSORT 00100I 576 576 CMSTAT 00110I GG 02 00120C******************************************************************** 00130C 01 MOVELCMSORT W25A 25 00140C 01 MOVE CMCUST W25A 00150O******************************************************************** 00160OCMKEY DADD 01 00170O W25A 25 /* 000180_‚ ÐÐ_‚_‚0H Q097CM00020F* GENERATE CUSTOMER ALT-KEY FILE. (X097CM) 00030F* REVISED 9/11/79 4:40 PM. 00040FCMMAST IP F 576 5AI 1 DISK 00050FCMKEY O F 26R25AI 1 DISK A 00060I******************************************************************** 00070ICMMAST CM 01 576NCD 00080I 1 50CMCUST 00090I 6 25 CMSORT 00100I 576 576 CMSTAT 00110I GG 02 00120C******************************************************************** 00130C 01 MOVELCMSORT W25A 25 00140C 01 MOVE CMCUST W25A 00150O******************************************************************** 00160OCMKEY DADD 01 00170O W25A 25 /* 000180_‚ ÐÈ((9 (X097PM P120282120282(èÈÐ00010H Q097PM00020F* COPY 80-BYTE DISK FILE TO 122-BYTE DISKETT FILE. (X097PM) 00030F* CREATED FOR Z099PM STREAM. 00040F* REV 5/25/79 12:35 PM. 00050FPMTRANO IP F 80 80 DISK 00060FFLOPPY O F 122 17 00070F KEBCDIC 00080IPMTRANO PT 01 00090I 1 80 REC 00100C 89 GOTO END 00110C MOVE ' ' BLK122122 00120C Z-ADD0 X 30 00130C*------------------------------------------------------------------- 00140C START TAG 00150C SETON 89 00160C 1 ADD X X 00170C X COMP 17 54 00180C 54 GOTO END 00190C SETON 81 00200C EXCPT 00210C SETOF 81 00220C GOTO START 00230C*------------------------------------------------------------------- 00240C END TAG 00250OFLOPPY D 01 ÐÐ00260O BLK122 122 00270O REC 80 00280O 82 '1' 00290O E 81 00300O BLK122 122 00310O T LR 00320O BLK122 122 00330O 2 '?*' /* 000340_‚ _‚_‚0C 1 ADD X X 00170C X COMP 17 54 00180C 54 GOTO END 00190C SETON 81 00200C EXCPT 00210C SETOF 81 00220C GOTO START 00230C*------------------------------------------------------------------- 00240C END TAG 00250OFLOPPY D 01 ÐÈ(ÈK ÈTX097VT P120282120282(èÈÐ00010H Q097VT00020F* COPY FILES FROM SCRATCH PACK TO D1/D2/SYSVOL. (X097VT) 00030F* REVISED 4/09/81 2:45 PM. 00040F* SWITCH-1 = D1 00050F* SWITCH-2 = D2 00060F* SWITCH-3 = SYSVOL 00070FSTATUSPTIP F 136 DISK 00080FZNEWVTOCO F 80 DISK 00090FTERM80 O F 80 5 00100E******************************************************************** 00110E NAM 11000 8 00120I******************************************************************** 00130ISTATUSPTSP 02 00140I* FILE NAME 8A 00150I 6 13 FILNAM 00160I* OWNER 8A 00170I 15 22 FILOWN 00180I* FILE DATE 6N 00190I 25 300FILDAT 00200I* FILE TYPE 1A (D,R,S,B) 00210I 34 34 FILTYP 00220I* RECORD LGTH 4N 00230I 40 430FILLGT 00240I* KEY LENGTH 2N 00250I 47 480KEYLGT ÐÐ00260I* KEY POSITION 4N 00270I 50 530KEYPOS 00280I* STARTING SECTOR 5A (HEX) 00290I 85 89 SECTOR 00300I 85 89 SEC 00310I* RECORD COUNT 6N 00320I 92 970RECCNT 00330I* EXPIRATION DATE 6N 00340I 99 1040EXPDAT 00350I* MAX RECORDS 6N 00360I 109 1140OLDMAX 00370I* FILE STATUS 6A 00380I 116 121 FILSTS 00390I* SECTOR ALIGNED 1A (Y,N) 00400I 124 124 SECALG 00410C******************************************************************** 00420C N79 MOVE ' ' BLK8 8 00430C N79 MOVE ' 'NAM 00440C N79 SETON 85 00450C N79 EXCPT 00460C N79 SETOF 85 00470C N79 EXITFQPAUSE 00480C SETON 79 00490C U1 U2 00500COR U1 U3 ÐÐ00510COR U2 U3 00520CORNU1NU2NU3 SETON H9 00530C H9 GOTO END 00540C FILOWN COMP BLK8 54 00550C 54 GOTO TAG10 00560C MOVELFILNAM W1A 1 00570C W1A COMP ' ' 54 00580C N54 GOTO TAG10 00590C MOVELFILNAM W2A 2 00600C W2A COMP '$$' 54 00610C 54 GOTO TAG10 00620C FILNAM COMP 'ZNEWVTOC' 54 00630C 54 GOTO TAG10 00640C W1A COMP 'A' 54 54 00650C 54 W1A COMP 'Z' 5454 00660C N54 GOTO TAG10 00670C GOTO END 00680C*---------------------------------------------------------------- 00690C TAG10 TAG 00700C SETOF 02 00710C*----------------------------------------------------------------- 00720C END TAG 00730C 02NH9 EXSR SR81 00740CLR EXSR SR82 00750C******************************************************************** ÐÐ00760CSR SR81 BEGSR 00770C* PUT INSTR STMT. 00780CSR FILNAM LOKUPNAM 54 00790CSR 54 GOTO END81 00800CSR 1 ADD N N 40 00810CSR MOVE FILNAM NAM,N 00820CSR FILTYP COMP 'R' 84 00830CSR SETON 81 00840CSR EXCPT 00850CSR SETOF 81 00860CSR END81 ENDSR 00870C******************************************************************** 00880CSR SR82 BEGSR 00890C* PUT EXIT STMT. 00900CSR SETON 82 00910CSR EXCPT 00920CSR SETOF 82 00930CSR ENDSR 00940O******************************************************************** 00950OZNEWVTOCE 81 00960O 2 '*' 00970O FILNAM 12 00980O E 81 00990O 14 'INPUT=ZNEWVTOC' 01000O E 81 ÐÐ01010O 4 'UTIL' 01020O E 81 01030O 19 'DEFINE,FN= ,' 01040O FILNAM 18 01050O 22 'NR=' 01060O OLDMAX 28 01070O 32 ',TY=' 01080O FILTYP 33 01090O U1 40 ',VL=D1,' 01100O U2 40 ',VL=D2,' 01110O U3 44 ',VL=SYSVOL,' 01120O NU3 43 'LR=' 01130O NU3 FILLGT 47 01140O 84NU3 51 ',K1=' 01150O 84NU3 KEYLGT 53 01160O 84NU3 57 ',P1=' 01170O 84NU3 KEYPOS 61 01180O U3 47 ',LR=' 01190O U3 FILLGT 51 01200O U3 84 55 ',K1=' 01210O U3 84 KEYLGT 57 01220O U3 84 61 ',P1=' 01230O U3 84 KEYPOS 65 01240O E 81 01250O 8 'COPY,FN=' ÐÐ01260O FILNAM 16 01270O 27 ',VL=SCRATCH' 01280O 39 ',F2= ' 01290O FILNAM 39 01300O U1 45 ',V2=D1' 01310O U2 45 ',V2=D2' 01320O U3 49 ',V2=SYSVOL' 01330O E 81 01340O 2 'EX' 01350O*------------------------------------------------------------------- 01360O E 82 01370O 14 'INPUT=TERMINAL' 01380O******************************************************************** 01390OTERM80 E 85 01400O 25 'SWITCH-1 = D1' 01410O E 85 01420O 25 'SWITCH-2 = D2' 01430O E 85 01440O 29 'SWITCH-3 = SYSVOL' 01450O E 85 01460O 16 'SWITCHES ON ARE:' 01470O U1 22 '1-D1' 01480O U2 28 '2-D2' 01490O U3 35 '3-SYS' 01500O E 85 ÐÐ01510O 19 'ARE SWITCHES RIGHT?' ** NAM ARRAY 001520 001530/* 001540_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È  ÈTX098BM P120282120282(èÈÐ00010H Q098BM00020F* SUMMARIZE BM CONVERT NEW TO OLD TRANS. (X098BM) 00030F* REVISED 2/19/81 11:25 AM. DG-REL006 OK. 00040F* 00050FBMTSRT IP F 80 80 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FBMTRANO O F 80 80 DISK 00080E******************************************************************** 00090E TABIS 1 11 6 TABDO 3 00100I******************************************************************** 00110IBMTSRT BM 01 00120I 1 100ASSYPNL2 20 00130I 11 12 CHGLEV 21 00140I 13 26 DESC14 22 00150I 27 300QTY4 23 00160I 31 400COMPPNL1 24 00170I 31 33 ALL 00180I 41 47 DESCR7 25 00190I 65 700DATE 00200I 71 760TIME 28 00210I 77 79 TRAN 26 00220I 80 80 TTCODE 27 00230I******************************************************************** 00240IPMMST2 PM 00250I P 13 140PMNOBM ÐÐ00260I 70 71 PMECHG 00270C******************************************************************** 00280C L2 SETOF 7778 00290C L1 MOVE ' ' LAST 3 00300C L1 EXSR SR102 INIT 00310C L1 SETOF 76 00320C TRAN COMP 'DEL' 71 00330C TRAN COMP 'CHG' 72 00340C TRAN COMP 'ADD' 73 00350C ALL COMP 'ALL' 74 00360C 74 SETON 7577 00370C N74 SETON 7678 00380C 71 EXSR SR102 INIT 00390C EXSR SR101 MOVE DATA 00400C MOVELLAST W6A 6 00410C MOVE TRAN W6A 00420C W6A LOKUPTABIS TABDO 54 00430C N54 MOVE ' ' LAST 00440C 54 MOVE TABDO LAST 00450CL1 76 SETOF 75 00460CL1 MOVELTASSY W12A 12 00470CL1 W12A CHAINPMMST2 55 00480CL1 55 MOVE ' ' PMECHG 00490CL1 MOVE PMECHG W1A 1 00500CL1 W1A COMP ' ' 54 ÐÐ00510CL1N54 MOVELPMECHG W1A 00520CL1N54 MOVE W1A PMECHG 00530CL1N54 MOVEL' ' PMECHG 00540CL1 PMECHG COMP TCHG 55 00550CL1 55 MOVE PMECHG TCHG 00560CL1 LAST COMP ' ' 54 00570CL1N54 00580CORN76 SETOF 78 00590CL1 54 SETON 80 00600CL1 54 76 EXCPT 00610CL1 SETOF 80 00620CL1 MOVE ' ' TCHG 00630CL1 MOVE BLK14 TDES14 00640CL1 Z-ADD0 TQTY 00650CL1 Z-ADD0 TCPN 00660CL1 MOVE BLK14 TDES7 00670CL1 MOVE ' ' LAST 00680CL2 78 SETOF 77 00690CL2 PMNOBM COMP 0 54 00700CL2N54 SETOF 77 00710CL2 77 SETON 81 00720CL2 77 EXCPT 00730CL2 SETOF 81 00740C******************************************************************** 00750CSR SR101 BEGSR ÐÐ00760C* MOVE INPUT DATA. 00770CSRN20 Z-ADDASSYPN TASSY 100 00780CSRN21 MOVE CHGLEV TCHG 2 00790CSR 74 GOTO T101A 00800CSRN21 MOVE TCHG W1A 1 00810CSRN21 W1A COMP ' ' 54 00820CSRN21N54 MOVELTCHG W1A 00830CSRN21N54 MOVE W1A TCHG 00840CSRN21N54 MOVEL' ' TCHG 00850CSRN22 MOVE DESC14 TDES14 14 00860CSRN23 Z-ADDQTY4 TQTY 40 00870CSRN24 Z-ADDCOMPPN TCPN 100 00880CSRN25 MOVE DESCR7 TDES7 7 00890C*------------------------------------------------------------------- 00900CSR T101A TAG 00910CSR 74 MOVE TCHG SAVCHG 2 00920CSR 74 MOVE 'ALL' TALL 3 00930CSR END101 ENDSR 00940C******************************************************************** 00950CSR SR102 BEGSR 00960C* INITIALIZE WORK FIELDS 00970CSR 89 GOTO T102A 00980CSR SETON 89 00990CSR MOVE ' ' BLK14 14 01000C*------------------------------------------------------------------ ÐÐ01010CSR T102A TAG 01020C* INITIALIZE T-FIELDS. 01030CSR Z-ADD0 TASSY 01040CSR MOVE ' ' TCHG 01050CSR MOVE BLK14 TDES14 01060CSR Z-ADD0 TQTY 01070CSR Z-ADD0 TCPN 01080CSR MOVE BLK14 TDES7 01090CSR L2 MOVE ' ' TALL 01100CSR ENDSR 01110O******************************************************************** 01120OBMTRANO E 80 76 01130O TASSY 10 01140O TCHG 12 01150O TDES14 B 26 01160O TQTY B 30 01170O TCPN B 40 01180O TDES7 B 47 01190O LAST B 79 01200O 80 '1' 01210O*------------------------------------------------------------------- 01220O E 81 01230O TASSY B 10 01240O SAVCHG 12 01250O 33 'ALL' ÐÐ01260O 79 'CHG' 01270O 80 '1' ** TABIS/TABDO 001280 ADDADD 001290 CHGCHG 001300 DELDEL 001310ADDADDADD 001320ADDCHGADD 001330ADDDEL 001340CHGADDCHG 001350CHGDELDEL 001360DELADDCHG 001370DELCHGDEL 001380DELDELDEL 001390/* 001400_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(úõ úiX098CM P120282120282(èÈÐ00010H Q098CM00020F* CONVERT CUST MAST - OLD TO NEW. (X098CM) 00030F* REVISED 09/07/79 10:45 AM. 00040FCMTRAN IP F 80 80 DISK 00050FCMMAST UC F 576R 5AI 1 DISK A 00060F* 00070E******************************************************************** 00080E CMA 7 35 00090E CMB 10 9 2 00100E CMS 10 9 2 00110E CMD 5 7 0 00120E CMAR 4 9 2 00130I******************************************************************** 00140ICMTRAN DK 01 1 CC 2 C1 00150I* CARD-1 FORMAT 00160I* CARD CODE 2A 00170I 1 2 CARD 10 00180I* CUST # 5N 00190I 3 70CUST L1 11 00200I* EXPORT CODE 1A 00210I 8 8 EXPT 12 00220I* CUST CLASS 2A 00230I 9 10 CLASS 13 00240I* NAME-1 23A 00250I 14 36 NAME1 14 ÐÐ00260I* NAME-2 20A 00270I 37 56 NAME2 15 00280I* ADDRESS-1 23A 00290I 57 79 ADR1 16 00300I*------------------------------------------------------------------- 00310I DL 02 1 CC 2 C2 00320I* CARD-2 FORMAT 00330I* CARD CODE 2A 00340I 1 2 CARD 10 00350I* CUST # 5N 00360I 3 70CUST L1 11 00370I* EXPORT CODE 1A 00380I 8 8 EXPT 12 00390I* CUST CLASS 2A 00400I 9 10 CLASS 13 00410I* ADDRESS-2 20A 00420I 14 33 ADR2 17 00430I* CITY 23A 00440I 34 56 CITY 18 00450I* FOREIGN COUNTRY 23A (EXPORT=E) 00460I 57 79 CNTRY 19 00470I* STATE CODE 2A 00480I 57 58 STATE 20 00490I* ZIP 5N 00500I 59 630ZIP 21 ÐÐ00510I*------------------------------------------------------------------- 00520I DM 05 1 CC 2 C5 00530I* CARD-5 FORMAT 00540I* CARD CODE 2A 00550I 1 2 CARD 10 00560I* CUST # 5N 00570I 3 70CUST L1 11 00580I* EXPORT CODE 1A 00590I 8 8 EXPT 12 00600I* CUST CLASS 2A 00610I 9 10 CLASS 13 00620I* CREDIT LIMIT 8.2N 00630I 11 182CREDIT 22 00640I******************************************************************** 00650ICMMAST CM 00660I* CUSTOMER MASTER. 00670I* CUSTOMER NO. 5N 00680I 1 50CMCUST 00690I* SORT (ALT) KEY 20A 00700I 6 25 CMSORT 00710I* ADDRESS 35A X 7 00720I 26 270 CMA 00730I* STATE CODE 2A 00740I 271 272 CMSTCD 00750I* ZIP CODE 9P ÐÐ00760I P 273 2770CMZIP 00770I* PHONE NO. 15A 00780I 278 292 CMPHON 00790I* CONTACT NAME 35A 00800I 293 327 CMCONT 00810I* REMARKS 35A 00820I 328 362 CMREM 00830I* CUSTOMER CLASS 2A 00840I 363 364 CMCLAS 00850I* SALESMAN 3A 00860I 365 367 CMSLSM 00870I* CREDIT LIMIT 7P 00880I P 368 3710CMCRLM 00890I* PAYMENT TERMS 8A 00900I 372 379 CMTERM 00910I* NUMBER OF INVOICE COPIES 1N 00920I 380 380 CMINV 00930I* SHIPPING METHOD 20A 00940I 381 400 CMSHIP 00950I* CURRENT BACKLOG 9.2P X 10 00960I* P 401 450 CMB 00970I* LAST 12-MOS SHIPMENTS 9.2P X 10 00980I* P 451 500 CMS 00990I* CURRENT RECEIVABLES 9.2P X 4 01000I* P 501 520 CMAR ÐÐ01010I* TAX CODE 1A 01020I 521 521 CMTAX 01030I* STD DISCOUNT 3.2P 01040I P 522 5232CMDISC 01050I* EXPORT CODE 1A 01060I 524 524 CMEXPT 01070I* DATE HISTORY 7P X 5 01080I* 1 = DATE INPUT 01090I* 2 = DATE LAST ORDER 01100I* 3 = DATE LAST SHIPMENT 01110I* 4 = NOT USED 01120I* 5 = NOT USED 01130I* P 525 544 CMD 01140I* LOCATION CODE 5A 01150I 545 549 CMLOC 01160I* HOLD CODE 1A 01170I 550 550 CMHOLD 01180I* POINTERS. 01190I* CREDIT CHANGES 5P 01200I P 573 5750CMFCC 01210I* RECORD STATUS 1A 01220I 576 576 CMSTAT 01230C******************************************************************** 01240C L1 SETOF 8060 01250C L1 CUST CHAINCMMAST 60 ÐÐ01260C 11 GOTO END 01270C N12 MOVE EXPT CMEXPT 01280C N13 MOVE CLASS CMCLAS 01290C N14 01 MOVELNAME1 CMSORT 01300C N14 01 MOVELNAME1 CMA,1 01310C N15 01 MOVELNAME2 CMA,3 01320C N16 01 MOVELADR1 CMA,4 01330C N17 02 MOVELADR2 CMA,5 01340C N18 02 MOVELCITY CMA,6 01350C CMEXPT COMP 'E' 54 01360C N19 02 54 MOVELCNTRY CMA,7 01370C 02N54N20 MOVE STATE CMSTCD 01380C 02N54N21 Z-ADDZIP CMZIP 01390C 05N22 Z-ADDCREDIT CMCRLM H 01400C SETON 80 01410C*------------------------------------------------------------------- 01420C END TAG 01430CL1 80 SETON 81 01440CL1 80 EXCPT 01450CL1 SETOF 8081 01460O******************************************************************** 01470OCMMAST EADD 81 60 01480O CUST B 5 01490O CMSORT B 25 01500O CMA B 270 ÐÐ01510O CMSTCD B 272 01520O CMZIP B 277P 01530O CMPHON B 292 01540O CMCONT B 327 01550O CMREM B 362 01560O CMCLAS B 364 01570O CMSLSM B 367 01580O CMCRLM B 371P 01590O CMTERM B 379 01600O CMINV B 380 01610O CMSHIP B 400 01620O CMB B 450P 01630O CMS B 500P 01640O CMAR B 520P 01650O CMTAX B 521 01660O CMDISC B 523P 01670O CMEXPT B 524 01680O CMD B 544P 01690O CMLOC B 549 01700O CMHOLD B 550 01710O 576 'A' 01720O*------------------------------------------------------------------- 01730O E 81N60 01740O CMSORT B 25 01750O CMA B 270 ÐÐ01760O CMSTCD B 272 01770O CMZIP B 277P 01780O CMPHON B 292 01790O CMCONT B 327 01800O CMREM B 362 01810O CMCLAS B 364 01820O CMSLSM B 367 01830O CMCRLM B 371P 01840O CMTERM B 379 01850O CMINV B 380 01860O CMSHIP B 400 01870O CMB B 450P 01880O CMS B 500P 01890O CMAR B 520P 01900O CMTAX B 521 01910O CMDISC B 523P 01920O CMEXPT B 524 01930O CMD B 544P 01940O CMLOC B 549 01950O CMHOLD B 550 01960O CMSTAT 576 /* 001970_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(d_ d*X098GL P120282120282(èÈÐ00010H Q098GL00020F* CONVERT OLD GL TO 9-BYTE KEY. (X098GL) 00030F* REVISED 7/27/81 11:00 AM. 00040FOLDGL IP F 165 11AI 3 DISK 00050FOLDGW IS F 25 22AI 3 DISK 00060FOLDCA IS F 40 22AI 3 DISK 00070FGLMAST O F 165 9AI 1 DISK 00080FGLWU O F 19 18AI 1 DISK 00090FCAMAST O F 40 18AI 1 DISK 00100I******************************************************************** 00110IOLDGL GL 01 165NCD 00120I 6 130PRIME 00130I 14 165 GLREC 00140I GG 05 00150I******************************************************************** 00160IOLDGW GW 02 25NCD 00170I 6 13 SUB 00180I 17 24 PAR 00190I WG 05 00200I******************************************************************** 00210IOLDCA CA 03 40NCD 00220I 6 13 PAR 00230I 17 24 SUB 00240I 25 40 CAREC 00250I CG 05 ÐÐ00260O******************************************************************** 00270OGLMAST D 01 00280O PRIME 9 00290O GLREC 165 00300O******************************************************************** 00310OGLWU D 02 00320O SUB 9 00330O PAR 18 00340O******************************************************************** 00350OCAMAST D 03 00360O PAR 9 00370O SUB 18 00380O CAREC 40 /* _‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Š §X098PJ P120282120282(èÈÐ00010H Q098PJ00020F* EWO CONVERSION-OLD TO NEW - UPDATE $. (X098PJ) 00030F* REVISED 3/03/81 2:00 PM. 00040FOLDEWO IP F 80 DISK 00050FPJMAST UC F 170R12AI 1 DISK A 00060F**************************************************************** 00070E PA$ 2 9 2 00080E PB$ 2 7 0 00090E PC$ 2 9 2 00100E PT$ 2 9 2 00110I******************************************************************** 00120IPJMAST PJ 00130I* PROJECT WORK ORDER. 00140I* WORK ORDER NO. 00150I 1 9 PJORD 00160I* PRIME 6A 00170I 1 6 PJPRIM 00180I* DASH 3N 00190I 7 90PJDASH 00200I* DEPT 3N 00210I 10 120PJDEPT 00220I* ACCOUNT 5N 00230I 13 170PJACNT 00240I* MODEL 12A 00250I 18 29 PJMODL ÐÐ00260I* DESCRIPTION 40A 00270I 30 69 PJDESC 00280I* SCHEDULE. 00290I* START DATE 6N 00300I 70 750PJBSD 00310I* COMPLETION DATE 6N 00320I 76 810PJBCD 00330I* BUDGET - LABOR HRS 7P 00340I P 82 850PJBLH 00350I* BUDGET - LABOR $ 7P 00360I P 86 89 PB$,1 00370I* BUDGET - MATERIAL $ 7P 00380I P 90 93 PB$,2 00390I* ACTUAL. 00400I* START DATE 6N 00410I 94 990PJASD 00420I* COMPLETION DATE 6N 00430I 100 1050PJACD 00440I* LABOR HRS 7.1P 00450I P 106 1091PJALH 00460I* LABOR $ 9.2P 00470I P 110 114 PA$,1 00480I* MATERIAL $ 9.2P 00490I P 115 119 PA$,2 00500I* STATUS. ÐÐ00510I* LABOR - % COMPLETE 3.2P 00520I P 120 1212PJLPCT 00530I* MATERIAL - % COMPLETE 3.2P 00540I P 122 1232PJMPCT 00550I* CURRENT MONTH - ACTUAL. 00560I* LABOR HRS 7.1P 00570I P 124 1271PJCLH 00580I* LABOR $ 9.2P 00590I P 128 132 PC$,1 00600I* MATERIAL $ 9.2P 00610I P 133 137 PC$,2 00620I* TRANSFER $ 9.2P 00630I P 138 147 PT$ 00640I* RECORD STATUS 1A 00650I 170 170 PJSTAT 00660I******************************************************************** 00670IOLDEWO EW 01 1 CA 2 C3 80 C1 00680I* EWO LABOR INPUT. 00690I* REWORK CODE (R) 1A 00700I 20 20 EWRWRK 00710I* JOB # 6A 00720I 21 26 EWORD 00730I* SUMMARY DATE 6N (MMDDYY) 00740I 30 350EWSUM 00750I* LABOR $ 7.2N ÐÐ00760I 42 482EWLAB 00770I* BURDEN $ 7.2N 00780I 49 552EWBUR 00790I* STRAIGHT TIME HRS 5.1N 00800I 59 631EWSHRS 00810I* OVERTIME HRS 4.1N 00820I 64 671EWOTHR 00830I* WORK DEPT 3N 00840I 72 740EWDEPT 00850I* SOURCE 1A 00860I 75 75 EWSC 00870I*------------------------------------------------------------------- 00880I EX 02 1 CA 2 C4 80 C1 00890I* EWO MATERIAL INPUT. 00900I* JOB # 6A 00910I 21 26 EWORD 00920I* SUMMARY DATE 6N 00930I 30 350EWSUM 00940I* MATL $ 7.2N 00950I 49 552EWMATL 00960I* TRAN CODE 1A 00970I* 3 = RET TO STOCK 00980I* 4 = UNPLAN ISSUE 00990I* 6 = PLAN ISSUE 01000I 74 74 EWTRAN ÐÐ01010I*------------------------------------------------------------------- 01020I EV 03 1 CA 2 C0 80 C1 01030I AND 56 C2 01040I* TRANSFER VOUCHER. 01050I 21 26 EWORD 01060I 42 492EWTRSF 01070I*------------------------------------------------------------------- 01080I GG 04 01090I* GARBAGE. 01100C******************************************************************** 01110C EXSR SR101 01120C 01 GOTO TAG10 LABOR 01130C 02 GOTO TAG20 MATERIAL 01140C 03 GOTO TAG30 01150C 04 GOTO END GARBAGE 01160C*------------------------------------------------------------------- 01170C TAG10 TAG 01180C EXSR SR80 GET MAST 01190C EWLAB ADD PC$,1 PC$,1 01200C EWBUR ADD PC$,1 PC$,1 01210C EWSHRS ADD PJCLH PJCLH 01220C EWOTHR ADD PJCLH PJCLH 01230C SETON 81 01240C EXCPT 01250C SETOF 81 ÐÐ01260C GOTO END 01270C*------------------------------------------------------------------- 01280C TAG20 TAG 01290C EXSR SR80 01300C EWMATL ADD PC$,2 PC$,2 01310C SETON 81 01320C EXCPT 01330C SETOF 81 01340C GOTO END 01350C*------------------------------------------------------------------- 01360C TAG30 TAG 01370C EXSR SR80 01380C EWTRSF ADD PT$,2 PT$,2 01390C SETON 81 01400C EXCPT 01410C SETOF 81 01420C GOTO END 01430C*------------------------------------------------------------------- 01440C END TAG 01450C******************************************************************** 01460CSR SR80 BEGSR 01470C* GET PJMAST. 01480CSR Z-ADD0 W6N 60 01490CSR MOVELEWORD W12A 12 01500CSR EWDEPT COMP 0 54 ÐÐ01510CSRN54 Z-ADD1 EWDEPT 01520CSR MOVE EWDEPT W6A 6 01530CSR MOVEL'000' W6A 01540CSR MOVE W6A W12A 01550CSR W12A CHAINPJMAST 54 01560CSRN54 GOTO END80 01570CSR SETON 80 01580CSR EXCPT 01590CSR SETOF 80 01600CSR GOTO SR80 01610CSR END80 ENDSR 01620C******************************************************************** 01630CSR SR101 BEGSR 01640C* INITIALIZE. 01650CSR 70 GOTO T101A 01660CSR SETON 70 01670CSR MOVE ' ' BLK12 12 01680CSR MOVE ' ' BLK40 40 01690C*------------------------------------------------------------------- 01700CSR T101A TAG 01710CSRN01 Z-ADD1 EWDEPT 01720CSR MOVE ' ' PJPRIM 01730CSR Z-ADD0 PJDASH 01740CSR Z-ADD0 PJDEPT 01750CSR MOVELBLK40 PJDESC ÐÐ01760CSR Z-ADD0 PJACNT 01770CSR MOVE BLK12 PJMODL 01780CSR Z-ADD0 PJASD 01790CSR Z-ADD0 PJACD 01800CSR Z-ADD0 PJBCD 01810CSR Z-ADD0 PJBSD 01820CSR Z-ADD0 PJBLH 01830CSR Z-ADD0 PB$,1 01840CSR Z-ADD0 PB$,2 01850CSR Z-ADD0 PJALH 01860CSR Z-ADD0 PA$ 01870CSR Z-ADD0 PJLPCT 01880CSR Z-ADD0 PJMPCT 01890CSR Z-ADD0 PJCLH 01900CSR Z-ADD0 PC$ 01910CSR Z-ADD0 PT$ 01920CSR ENDSR 01930O******************************************************************** 01940OPJMAST EADD 80 01950O W12A 12 01960O PJACNT B 17 01970O PJMODL B 29 01980O PJDESC B 69 01990O PJBSD B 75 02000O PJBCD B 81 ÐÐ02010O PJBLH B 85P 02020O PB$ B 93P 02030O PJASD B 99 02040O PJACD B 105 02050O PJALH B 109P 02060O PA$ B 119P 02070O PJLPCT B 121P 02080O PJMPCT B 123P 02090O PJCLH B 127P 02100O PC$ B 137P 02110O PT$ B 147P 02120O 170 'A' 02130O*------------------------------------------------------------------- 02140O E 81 02150O PJACNT B 17 02160O PJMODL B 29 02170O PJDESC B 69 02180O PJBSD B 75 02190O PJBCD B 81 02200O PJBLH B 85P 02210O PB$ B 93P 02220O PJASD B 99 02230O PJACD B 105 02240O PJALH B 109P 02250O PA$ B 119P ÐÐ02260O PJLPCT B 121P 02270O PJMPCT B 123P 02280O PJCLH B 127P 02290O PC$ B 137P 02300O PT$ B 147P 02310O PJSTAT 170 /* 002320_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È2 ÈTX098VT P120282120282(èÈÐ00010H Q098VT00020F* DELETE SYSVOL/D1/D2 FILES. (X098VT) 00030F* REVISED 4/21/81 1:40 PM. 00040F* N O T E: IT IS NOT USUALLY NECESSARY TO RUN THIS PROGRAM UNLESS 00050F* THE PACK IS SYSVOL. FOR OTHER PACKS IT IS FASTER TO 00060F* DO A SAVE AND THEN RUN Q097VT ONLY. 00070F* SWITCH-1 = D1 00080F* SWITCH-2 = D2 00090F* SWITCH-3 = SYSVOL 00100FSTATUSPTIP F 136 DISK 00110FZNEWVTOCO F 80 DISK 00120FTERM80 O F 80 5 00130E******************************************************************** 00140E NAM 11000 8 00150I******************************************************************** 00160ISTATUSPTSP 02 00170I* FILE NAME 8A 00180I 6 13 FILNAM 00190I* OWNER 8A 00200I 15 22 FILOWN 00210I* FILE DATE 6N 00220I 25 300FILDAT 00230I* FILE TYPE 1A (D,R,S,B) 00240I 34 34 FILTYP 00250I* RECORD LGTH 4N ÐÐ00260I 40 430FILLGT 00270I* KEY LENGTH 2N 00280I 47 480KEYLGT 00290I* KEY POSITION 4N 00300I 50 530KEYPOS 00310I* STARTING SECTOR 5A (HEX) 00320I 85 89 SECTOR 00330I 85 89 SEC 00340I* RECORD COUNT 6N 00350I 92 970RECCNT 00360I* EXPIRATION DATE 6N 00370I 99 1040EXPDAT 00380I* MAX RECORDS 6N 00390I 109 1140OLDMAX 00400I* FILE STATUS 6A 00410I 116 121 FILSTS 00420I* SECTOR ALIGNED 1A (Y,N) 00430I 124 124 SECALG 00440C******************************************************************** 00450C N79 MOVE ' ' BLK8 8 00460C N79 MOVE ' 'NAM 00470C N79 SETON 85 00480C N79 EXCPT 00490C N79 SETOF 85 00500C N79 EXITFQPAUSE ÐÐ00510C SETON 79 00520C U1 U2 00530COR U1 U3 00540COR U2 U3 00550CORNU1NU2NU3 SETON H9 00560C H9 GOTO END 00570C FILOWN COMP BLK8 54 00580C 54 GOTO TAG10 00590C MOVELFILNAM W1A 1 00600C W1A COMP ' ' 54 00610C N54 GOTO TAG10 00620C MOVELFILNAM W2A 2 00630C W2A COMP '$$' 54 00640C 54 GOTO TAG10 00650C FILNAM COMP 'ZNEWVTOC' 54 00660C 54 GOTO TAG10 00670C W1A COMP 'A' 54 54 00680C 54 W1A COMP 'Z' 5454 00690C N54 GOTO TAG10 00700C GOTO END 00710C*---------------------------------------------------------------- 00720C TAG10 TAG 00730C SETOF 02 00740C*----------------------------------------------------------------- 00750C END TAG ÐÐ00760C 02NH9 EXSR SR81 00770CLR EXSR SR82 00780C******************************************************************** 00790CSR SR81 BEGSR 00800C* PUT INSTR STMT. 00810CSR FILNAM LOKUPNAM 54 00820CSR 54 GOTO END81 00830CSR 1 ADD N N 30 00840CSR MOVE FILNAM NAM,N 00850CSR FILTYP COMP 'R' 84 00860CSR SETON 81 00870CSR EXCPT 00880CSR SETOF 81 00890CSR END81 ENDSR 00900C******************************************************************** 00910CSR SR82 BEGSR 00920C* PUT EXIT STMT. 00930CSR SETON 82 00940CSR EXCPT 00950CSR SETOF 82 00960CSR ENDSR 00970O******************************************************************** 00980OZNEWVTOCE 81 00990O 2 '*' 01000O FILNAM 12 ÐÐ01010O E 81 01020O 14 'INPUT=ZNEWVTOC' 01030O E 81 01040O 4 'UTIL' 01050O E 81 01060O 19 'DELETE,FN= ,' 01070O FILNAM 18 01080O U1 24 ',VL=D1' 01090O U2 24 ',VL=D2' 01100O U3 28 ',VL=SYSVOL' 01110O E 81 01120O 2 'EX' 01130O*------------------------------------------------------------------- 01140O E 82 01150O 14 'INPUT=TERMINAL' 01160O******************************************************************** 01170OTERM80 E 85 01180O 25 'SWITCH-1 = D1' 01190O E 85 01200O 25 'SWITCH-2 = D2' 01210O E 85 01220O 29 'SWITCH-3 = SYSVOL' 01230O E 85 01240O 16 'SWITCHES ON ARE:' 01250O U1 22 '1-D1' ÐÐ01260O U2 28 '2-D2' 01270O U3 35 '3-SYS' 01280O E 85 01290O 19 'ARE SWITCHES RIGHT?' ** NAM ARRAY 001300 001310/* 001320_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ȇ ÈTX099DP P120282120282(èÈÐ00010H Q099DP00020F* COPY SYSVOL FILES. (X098DP) 00030F* REVISED 5/27/80 2:05 PM. 00040FSTATUSPTIP F 136 DISK 00050FZNEWVTOCO F 80 DISK 00060E NAM 1 700 8 00070ISTATUSPTSP 02 00080I* FILE NAME 8A 00090I 6 13 FILNAM 00100I* OWNER 8A 00110I 15 22 FILOWN 00120I* FILE DATE 6N 00130I 25 300FILDAT 00140I* FILE TYPE 1A (D,R,S,B) 00150I 34 34 FILTYP 00160I* RECORD LGTH 4N 00170I 40 430FILLGT 00180I* KEY LENGTH 2N 00190I 47 480KEYLGT 00200I* KEY POSITION 4N 00210I 50 530KEYPOS 00220I* STARTING SECTOR 5A (HEX) 00230I 85 89 SECTOR 00240I 85 89 SEC 00250I* RECORD COUNT 6N ÐÐ00260I 92 970RECCNT 00270I* EXPIRATION DATE 6N 00280I 99 1040EXPDAT 00290I* MAX RECORDS 6N 00300I 109 1140OLDMAX 00310I* FILE STATUS 6A 00320I 116 121 FILSTS 00330I* SECTOR ALIGNED 1A (Y,N) 00340I 124 124 SECALG 00350C******************************************************************** 00360C MOVE ' ' BLK8 8 00370C FILOWN COMP BLK8 54 00380C 54 GOTO TAG10 00390C MOVELFILNAM W1A 1 00400C W1A COMP ' ' 54 00410C N54 GOTO TAG10 00420C MOVELFILNAM W2A 2 00430C W2A COMP '$$' 54 00440C 54 GOTO TAG10 00450C FILNAM COMP 'ZNEWVTOC' 54 00460C 54 GOTO TAG10 00470C W1A COMP 'A' 54 54 00480C 54 W1A COMP 'Z' 5454 00490C N54 GOTO TAG10 00500C GOTO END ÐÐ00510C*---------------------------------------------------------------- 00520C TAG10 TAG 00530C SETOF 02 00540C*----------------------------------------------------------------- 00550C END TAG 00560C 02 EXSR SR81 00570CLR EXSR SR82 00580C******************************************************************** 00590CSR SR81 BEGSR 00600C* PUT INSTR STMT. 00610CSR FILNAM LOKUPNAM 54 00620CSR 54 GOTO END81 00630CSR 1 ADD N N 30 00640CSR MOVE FILNAM NAM,N 00650CSR FILTYP COMP 'R' 84 00660CSR SETON 81 00670CSR EXCPT 00680CSR SETOF 81 00690CSR END81 ENDSR 00700C******************************************************************** 00710CSR SR82 BEGSR 00720C* PUT EXIT STMT. 00730CSR SETON 82 00740CSR EXCPT 00750CSR SETOF 82 ÐÐ00760CSR ENDSR 00770O******************************************************************** 00780OZNEWVTOCE 81 00790O 2 '*' 00800O FILNAM 12 00810O E 81 00820O 14 'INPUT=ZNEWVTOC' 00830O E 81 00840O 4 'UTIL' 00850O E 81 00860O 19 'DEFINE,FN= ,' 00870O FILNAM 18 00880O 22 'NR=' 00890O OLDMAX 28 00900O 32 ',TY=' 00910O FILTYP 33 00920O 44 ',VL=SYSVOL,' 00930O 47 'LR=' 00940O FILLGT 51 00950O 84 55 ',K1=' 00960O 84 KEYLGT 57 00970O 84 61 ',P1=' 00980O 84 KEYPOS 65 00990O E 81 01000O 8 'COPY,FN=' ÐÐ01010O FILNAM 16 01020O 22 ',VL=D5' 01030O 34 ',F2= ' 01040O FILNAM 34 01050O 44 ',V2=SYSVOL' 01060O E 81 01070O 2 'EX' 01080O*------------------------------------------------------------------- 01090O E 82 01100O 14 'INPUT=TERMINAL' ** NAM ARRAY 001110 001120/* 001130_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ôÜ ôÑX099GL P120282120282(èÈÐ00010H Q099GL00020F* CONVERT CHART OF ACCOUNTS. (X099GL) 00030F* REVISED 6-09-82 3:00 PM. 00040FGLINPT IP F 80 DISK 00050FLGMAST UC F 165R 9AI 1 DISK A 00060FCAMAST UC F 40R18AI 1 DISK A 00070FGLWU UC F 19R18AI 1 DISK A 00080E******************************************************************** 00090E GLA 1 12 11 2 00100E A9 9 9 1 00110E CAD 1 25 9 ASD 9 DEPT #S 00120E SUB 1 25 9 ASDN 40 DEPT NAMES 00130E EXP 1 69 3 AEXN 40 EXPENSE NAMES 00140E A40 40 40 1 00150E ADN 1 25 12 ABBREV DEPT NAMES 00160I******************************************************************* 00170IGLINPT DK 01 00180I 1 2 EOF 00190I 3 4 LBRAKEL2 00200I 3 70ACOUNTL1 70 00210I 8 33 DESCR 00220I****************************************************************** 00230ILGMAST GL 00240I* ACCOUNT MASTER. 00250I* KEY AREA. ÐÐ00260I 1 9 GLKEY 00270I* ACCOUNT PREFIX 1A 00280I 1 1 GLPRFX 00290I* ACCOUNT PRIME 5N 00300I 2 60GLPRIM 00310I* ACCOUNT DASH 3N 00320I 7 90GLDASH 00330I* ACCOUNT GROUP 4A 00340I 14 17 GLGRUP 00350I* ACCOUNT DESCRIPTION 40A 00360I 18 57 GLDESC 00370I* BALANCE FORWARD AMOUNT 11.2P 00380I P 58 632GLBALF 00390I* ACTUAL $ 11.2P X 12 00400I P 64 135 GLA 00410I* CURRENT MONTH-PLUSES 11.2P 00420I P 136 1412GLCMP 00430I* CURRENT MONTH-MINUS 11.2P 00440I P 142 1472GLCMM 00450I* SOURCE CODE 1A 00460I* S = SUB-ACCOUNT ONLY, 00470I* MAY NOT BE PARENT 00480I 148 148 GLSC 00490I* BALANCE FORWARD CODE 2A 00500I* 1ST COL ÐÐ00510I* 1 = ZERO BAL AT START NEW YR 00520I* 2 = CARRY PREV YR FRWD 00530I* 2ND COL 00540I* A = ZERO BAL AT START NEW MO 00550I* B = CARRY PREV MO FRWD 00560I 149 150 GLBFC 00570I* NUMB OF SUB-ACCOUNTS 5P 00580I P 157 1590GLNOSA 00590I* LOW LEVEL CODE 3N 00600I 160 1620GLLL 00610I* FILLER 00620I* RECORD STATUS 1A 00630I 165 165 GLSTAT 00640I******************************************************************* 00650ICAMAST CA 00660I* CHART OF ACCOUNTS. 00670I* KEY AREA. 00680I* PARENT ACCOUNT 9A 00690I 1 9 CAPAR 00700I* SUB-ACCOUNT 9A 00710I 10 18 CASUB 00720I* OPERATOR 1A 00730I* S = SUBTRACT 00740I* A = ADD 00750I 25 25 CAOPER ÐÐ00760I* EFFECTIVITY 00770I* START DATE 6N (YMD) 00780I 26 310CASDAT 00790I* END DATE 6N (YMD) 00800I 32 370CAEDAT 00810I* FILLER 00820I* RECORD STATUS 1A 00830I 40 40 CASTAT 00840I******************************************************************** 00850IGLWU GW 00860I* CHART ACCOUNTS ALT-KEY (SUB-ACCT). 00870I* KEY AREA. 00880I* SUB-ACCOUNT 9A 00890I 1 9 GWSUB 00900I* PARENT ACCOUNT 9A 00910I 10 18 GWPAR 00920I* RECORD STATUS 1A 00930I 19 19 GWSTAT 00940C******************************************************************** 00950C N79 Z-ADD0 GLA 00960C N79 Z-ADD69 EXPLIM 30 00970C N79 Z-ADD25 CADLIM 30 00980C SETON 79 00990C EOF COMP '/*' LR 01000C LR ÐÐ01010CORNL1 01020CORN70 GOTO END 01030C*------------------------------------------------------------------- 01040C TAG10 TAG 01050C MOVE ' ' A9 01060C MOVE ACOUNT W5A 5 01070C MOVEAW5A A9,2 01080C MOVEA'000' A9,7 01090C MOVEAA9 W9A 9 01100C W9A CHAINLGMAST 54 01110C N54 GOTO TAG20 01120C SETON 80 01130C EXCPT ADD NEW MAST 01140C SETOF 80 01150C GOTO TAG10 01160C*------------------------------------------------------------------- 01170C TAG20 TAG 01180C L2 GOTO TAG30 01190C ACOUNT COMP 60001 54 54 01200C 54 ACOUNT COMP 60099 5454 01210C 54 GOTO END 01220C MOVELLASTL2 W18A 18 01230C MOVE W9A W18A 01240C W18A CHAINCAMAST 54 01250C N54 GOTO END ÐÐ01260C SETON 81 01270C EXCPT ADD CAMAST 01280C SETOF 81 01290C GOTO END 01300C*------------------------------------------------------------------- 01310C TAG30 TAG 01320C MOVE W9A LASTL2 9 01330C*------------------------------------------------------------------- 01340C END TAG 01350CLR EXSR SR101 01360C******************************************************************** 01370CSR SR101 BEGSR 01380CSR Z-ADD0 ZERO11 110 01390CSR Z-ADD0 ZERO3 30 01400CSR Z-ADD0 ZERO5 50 01410CSR MOVE ' ' BLK9 9 01420CSR Z-ADD1 X 30 01430C*------------------------------------------------------------------- 01440CSR T101A TAG 01450CSR BLK9 LOKUPCAD,X 54 01460CSRN54 GOTO END101 01470CSR Z-ADD1 N 30 01480CSR SD,X LOKUPSUB,N 54 01490CSR MOVE SD,X W9A 01500CSR W9A CHAINLGMAST 60 ÐÐ01510CSR SETON 82 01520CSR EXCPT ADD SUB-DEPT 01530CSR SETOF 82 01540CSR Z-ADD1 S 30 01550C*------------------------------------------------------------------- 01560CSR T101B TAG 01570CSR '000' LOKUPEXP,S 54 01580CSRN54 GOTO T101C 01590CSR MOVEAEXN,S A40 01600CSR MOVEAADN,N A40,29 01610CSR MOVE SD,X W9A 01620CSR MOVE EXP,S W9A 01630CSR W9A CHAINLGMAST 60 01640CSR SETON 84 01650CSR EXCPT ADD EXPENSE 01660CSR SETOF 84 01670CSR 1 ADD S S 01680CSR S COMP EXPLIM 54 01690CSRN54 GOTO T101B 01700C*------------------------------------------------------------------- 01710CSR T101C TAG 01720CSR 1 ADD X X 01730CSR X COMP CADLIM 54 01740CSRN54 GOTO T101A 01750CSR END101 ENDSR ÐÐ01760O******************************************************************** 01770OLGMAST EADD 80 01780O* ADD ACCOUNT #'S FROM FILE. 01790O W9A 9 01800O 17 ' ' 01810O DESCR 43 01820O ZERO11 63P 01830O GLA 135P 01840O ZERO11 141P 01850O ZERO11 147P 01860O 148 ' ' 01870O 150 ' ' 01880O ZERO5 159P 01890O ZERO3 162 01900O 165 'A' 01910O*------------------------------------------------------------------- 01920O EADD 82 60 01930O* ADD SUB-DEPT ACCOUNTS FROM TABLE. 01940O SD,X 9 01950O 9 '000' 01960O 17 ' ' 01970O SDN,N 57 01980O ZERO11 63P 01990O GLA 135P 02000O ZERO11 141P ÐÐ02010O ZERO11 147P 02020O 150 ' ' 02030O ZERO5 159P 02040O ZERO3 162 02050O 165 'A' 02060O*------------------------------------------------------------------- 02070O EADD 84 60 02080O SD,X 9 02090O EXP,S 9 02100O 17 ' ' 02110O A40 57 02120O ZERO11 63P 02130O GLA 135P 02140O ZERO11 141P 02150O ZERO11 147P 02160O 150 ' ' 02170O ZERO5 159P 02180O ZERO3 162 02190O 165 'A' 02200O******************************************************************** 02210OCAMAST EADD 81 02220O W18A 18 02230O 25 'A' 02240O 40 'A' 02250O*------------------------------------------------------------------- ÐÐ02260O EADD 82 02270O CAD,X 9 02280O SD,X 18 02290O 25 'A' 02300O 40 'A' 02310O*------------------------------------------------------------------- 02320O EADD 84 02330O SD,X 9 02340O SD,X 18 02350O EXP,S 24 02360O 25 'A' 02370O 40 'A' 02380O*------------------------------------------------------------------- 02390O EADD 84 02400O 3 '60' 02410O EXP,S 6 02420O 9 '000' 02430O SD,X 18 02440O EXP,S 18 02450O******************************************************************** 02460OGLWU EADD 81 02470O W9A 9 02480O LASTL2 18 02490O 19 'A' 02500O*------------------------------------------------------------------- ÐÐ02510O EADD 82 02520O SD,X 9 02530O CAD,X 18 02540O 19 'A' 02550O*------------------------------------------------------------------- 02560O EADD 84 02570O SD,X 9 02580O EXP,S 9 02590O SD,X 18 02600O 19 'A' 02610O*------------------------------------------------------------------- 02620O EADD 84 02630O SD,X 9 02640O EXP,S 9 02650O 12 '60' 02660O EXP,S 15 02670O 18 '000' ** GLA ARRAY 002680 002690** A9 ARRAY 002700 002710** CAD/SD - MAIN DEPT #/ SUB DEPT # 002720 60400000 60410000 02730 60400000 60421000 02740 60400000 60422000 02750ÐÐ 60400000 60423000 02760 60400000 60425000 02770 60400000 60427000 02780 60400000 60429000 02790 60400000 60430000 02800 60400000 60440000 02810 60400000 60460000 02820 60400000 60470000 02830 60400000 60481000 02840 60400000 60485000 02850 60400000 60490000 02860 60600000 60610000 02870 60600000 60620000 02880 60600000 60630000 02890 60600000 60640000 02900 60700000 60710000 02910 60700000 60720000 02920 60700000 60760000 02930 60700000 60790000 02940 60800000 60810000 02950 60800000 60840000 02960 60900000 60910000 02970** SUB/SDN - SUB DEPT #/ SUB DEPT NAME 002980 60410000OPERATIONS ADMIN 02990 60421000SUB ASSY-PREP/STUFF 03000ÐÐ 60422000CB FAB 03010 60423000SUB ASSY (TOUCHUP) 03020 60425000FINAL ASSEMBLY 03030 60427000SYSTEMS 03040 60429000SUB ASSY-PROCESSING 03050 60430000METAL FABRICATION 03060 60440000TEST 03070 60460000QUALITY ASSURANCE 03080 60470000MFG CONTROL 03090 60481000PURCHASING 03100 60485000MATL CTL & HANDLING 03110 60490000INDUSTRIAL ENG 03120 60610000ADMINISTRATION 03130 60620000DESIGN 03140 60630000SERVICES 03150 60640000TECHNICAL PUBLICATIONS 03160 60710000MARKETING ADMIN 03170 60720000ADVERTISING 03180 60760000TV SALES 03190 60790000INTERNATIONAL SALES 03200 60810000FINANCE & PERSONNEL 03210 60840000DATA PROCESSING 03220 60910000OCCUPANCY 03230** EXP/EXN - EXPENSE DASH # (3)/ EXPENSE NAME 003240001OVERTIME PREMIUM 003250ÐÐ002SALARIES, INDIR EMPLOYEES 003260003SICK AND TERMINATION PAY 003270004VACATION PAY EXPENSE 003280005HOLIDAY PAY EXPENSE 003290006GROUP INSURANCE EXPENSE 003300007WORKMEN'S COMPENSATION INS 003310008UNEMPLOYMENT INS, STATE, FED 003320009OLD AGE, SURV INS (FICA) 003330011DIRECT LINE SUPERVISION 003340012MARKETING COMMISSIONS 003350013TRAINING EXPENSE 003360014EMP RELATIONS & ADMIN 003370015MARKETING LIAISON 003380016PUBLICATIONS EXPENSE 003390017TOOLING, DESIGN, MAINT 003400018UNALLOCATED DIRECT LABOR 003410019IDLE TIME 003420021DIRECT MAIL, PRODUCTIVE 003430023PRODUCTION SUPPLIES, SERV 003440027REWORK MATERIALS 003450041OFFICE SUPPLIES, SERVICES 003460042POSTAGE 003470043TELEPHONE, TELEGRAPH 003480044EQUIPMENT REPAIRS, MAINT 003490045DUES, SUBSCRIPTIONS 003500ÐÐ046CONSULTING FEE, TEMP LABOR 003510047AUTO, AIRCRAFT EXPENSE 003520048EQUIPMENT RENT 003530049EMPLOYEE EDUCATION 003540051PLACEMENT OF ADVERTISEMENT 003550052ADVERT MAIL, PROD COSTS 003560053PARTS LISTS, INSTR MANUALS 003570054SALES CATALOG, DATA SHEETS 003580055COST OF TRADE SHOWS 003590056DIRECT MAIL 003600061OTHER INSURANCE 003610062BAD DEBTS, COLLECTION EXP 003620063DONATIONS 003630064TRAVEL EXPENSE 003640065LEGAL AND ACCOUNTING 003650066PENSION COST 003660067DIRECTORS FEES 003670068ENTERTAINMENT EXPENSE 003680069OTHER MISC EXPENSES 003690071BUILDING RENT 003700072PROPERTY INS 003710073PLANT PROTECTION 003720074PROPERTY TAXES 003730075GEN MAINT, SUPPLY, SERVICE 003740076OTHER UTILITIES 003750ÐÐ078EMPLOYEE RELATIONS COST 003760079OCCUPANCY ALLOCATION 003770081AMORT, TECHNICAL DRAWINGS 003780082AMORT, BUILDING IMPROV 003790083AMORT, TOOLING 003800084DEPREC, MACHINERY, EQUIP 003810085DEPREC, ELECT TEST EQUIP 003820086DEPREC, DISPLAY/DEMO EQUIP 003830087DEPREC, FURNITURE, FIXTURE 003840088DEPREC, TRANSPORTATION EQ 003850089AMORTIZATION, BUILDING 003860091OVERHEAD TO OTHERS 003870092OVERHEAD FROM OTHERS 003880093DIRECT LABOR 003890094DIR LABOR, CHGD TO OTHERS 003900095DIR LABOR, CHGD FROM OTHERS 003910096DIRECT MATERIAL 003920099MISC PROOF ACCT 003930** A40 ARRAY 003940 003950** ADN - ABBREV DEPT NAMES 003960OPER ADMIN 003970S/A-PREP,STF 003980CB FAB 003990S/A-TOUCHUP 004000ÐÐFINAL ASSY 004010SYSTEMS 004020S/A-PROCESS 004030METAL FAB 004040TEST 004050QUAL ASSUR 004060MFG CONTROL 004070PURCHASING 004080MTL CTL,HDLG 004090INDUST ENG 004100ENG ADMIN 004110DESIGN 004120SERVICES 004130TECH PUB 004140MKTG ADMIN 004150ADVERTISING 004160TV SALES 004170INT'L SALES 004180FIN & PSNL 004190DATA PROC 004200OCCUPANCY 004210/* 004220_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(„® „wX099PJ P120282120282(èÈÐ00010H Q099PJ00020F* CONVERT EWO MASTERS, OLD TO NEW. (X099PJ) 00030F* REVISED 3/24/81 9:30 AM. 00040FOLDEWO IP F 80 DISK 00050FPJMAST UC F 170R12AI 1 DISK A 00060FTERM70 O F 70 5 00070F**************************************************************** 00080E PA$ 2 9 2 00090E PB$ 2 7 0 00100E PC$ 2 9 2 00110I******************************************************************** 00120IPJMAST PJ 00130I* PROJECT WORK ORDER. 00140I* WORK ORDER NO. 00150I 1 9 PJORD 00160I* PRIME 6A 00170I 1 6 PJPRIM 00180I* DASH 3N 00190I 7 90PJDASH 00200I* DEPT 3N 00210I 10 120PJDEPT 00220I* ACCOUNT 5N 00230I 13 170PJACNT 00240I* MODEL 12A 00250I 18 29 PJMODL ÐÐ00260I* DESCRIPTION 40A 00270I 30 69 PJDESC 00280I* SCHEDULE. 00290I* START DATE 6N 00300I 70 750PJBSD 00310I* COMPLETION DATE 6N 00320I 76 810PJBCD 00330I* BUDGET - LABOR HRS 7P 00340I P 82 850PJBLH 00350I* BUDGET - LABOR $ 7P 00360I P 86 89 PB$,1 00370I* BUDGET - MATERIAL $ 7P 00380I P 90 93 PB$,2 00390I* ACTUAL. 00400I* START DATE 6N 00410I 94 990PJASD 00420I* COMPLETION DATE 6N 00430I 100 1050PJACD 00440I* LABOR HRS 7.1P 00450I P 106 1091PJALH 00460I* LABOR $ 9.2P 00470I P 110 114 PA$,1 00480I* MATERIAL $ 9.2P 00490I P 115 119 PA$,2 00500I* STATUS. ÐÐ00510I* LABOR - % COMPLETE 3.2P 00520I P 120 1212PJLPCT 00530I* MATERIAL - % COMPLETE 3.2P 00540I P 122 1232PJMPCT 00550I* CURRENT MONTH - ACTUAL. 00560I* LABOR HRS 7.1P 00570I P 124 1271PJCLH 00580I* LABOR $ 9.2P 00590I P 128 132 PC$,1 00600I* MATERIAL $ 9.2P 00610I P 133 137 PC$,2 00620I* RECORD STATUS 1A 00630I 170 170 PJSTAT 00640I******************************************************************** 00650IOLDEWO EW 01 1 CA 2 C0 80 C1 00660I AND 56 C1 00670I* EWO MASTER INPUT. 00680I* NAME 18A 00690I 3 20 EWNAME 00700I* JOB # 6A 00710I 21 26 EWNO 00720I* START DATE 6N (MMDDYY) 00730I 30 350EWSTRT 00740I* BUDGET HRS 5N 00750I 37 410EWBHRS ÐÐ00760I* LABOR $-BUDGET 6N 00770I 42 470EWBL$ 00780I* MATL $ -BUDGET 6N 00790I 48 530EWBM$ 00800I* DATE CLOSED 5N (MMDDY) 00810I 57 610EWCLS5 78 00820I*------------------------------------------------------------------- 00830I GG 02 00840C******************************************************************** 00850C 70 GOTO START 00860C SETON 70 00870C MOVE ' ' BLK12 12 00880C Z-ADD0 ZERO9 90 00890C*--------------------------------------------------------------- 00900C START TAG 00910C N01 GOTO END 00920C N78 Z-ADD0 EWCLOS 00930C N78 GOTO TAG10 00940C MOVELEWCLS5 EWCLOS 60 CLOSE DATE 00950C MOVE EWCLS5 W1A 1 00960C W1A COMP '8' 54 00970C W1A COMP '9' 55 00980C W1A COMP '0' 56 00990C W1A COMP '1' 57 01000C MOVE ' ' W2A 2 ÐÐ01010C 54 MOVE '78' W2A 2 01020C 55 MOVE '79' W2A 01030C 56 MOVE '80' W2A 01040C 57 MOVE '81' W2A 01050C MOVE W2A EWCLOS 01060C*------------------------------------------------------------------ 01070C TAG10 TAG 01080C MOVELEWNO W12A 12 01090C MOVE '000001' W12A 01100C W12A CHAINPJMAST 60 01110C N60 GOTO END 01120C MOVE EWNO PJPRIM 01130C Z-ADD0 PJDASH 01140C Z-ADD1 PJDEPT 01150C MOVELEWNAME PJDESC 01160C Z-ADD0 PJACNT 01170C MOVE BLK12 PJMODL 01180C Z-ADDEWSTRT PJASD 01190C Z-ADDEWCLOS PJACD 01200C Z-ADDEWCLOS PJBCD 01210C Z-ADDEWSTRT PJBSD 01220C Z-ADDEWBHRS PJBLH 01230C Z-ADDEWBL$ PB$,1 01240C Z-ADDEWBM$ PB$,2 01250C Z-ADD0 PJALH ÐÐ01260C Z-ADD0 PA$ 01270C Z-ADD0 PJLPCT 01280C Z-ADD0 PJMPCT 01290C Z-ADD0 PJCLH 01300C Z-ADD0 PC$ 01310C MOVE 'A' PJSTAT 01320C SETON 81 01330C EXCPT ADD PJMAST 01340C SETOF 81 01350C*------------------------------------------------------------------- 01360C END TAG 01370O******************************************************************** 01380OPJMAST EADD 81 01390O PJPRIM 6 01400O PJDASH 9 01410O PJDEPT 12 01420O PJACNT 17 01430O PJMODL 29 01440O PJDESC 69 01450O PJBSD 75 01460O PJBCD 81 01470O PJBLH 85P 01480O PB$ 93P 01490O PJASD 99 01500O PJACD 105 ÐÐ01510O PJALH 109P 01520O PA$ 119P 01530O PJLPCT 121P 01540O PJMPCT 123P 01550O PJCLH 127P 01560O PC$ 137P 01570O ZERO9 142P 01580O ZERO9 147P 01590O 170 'A' 01600O******************************************************************** 01610OTERM70 E 85 01620O EWNO 6 /* 001630_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2& 2X099PM P120282120282(èÈÐ00010H Q099PM00020F* BUILD PM/BM CONVERSION FILES. (X099PM) 00030F* REVISED 1/18/81 11:45 AM. 00040FPMCONVRTIP F 82 DISK 00050FTRNOUT O F 32 DISK A 00060FBMTRAN O F 80 DISK A 00070I********************************************************************* 00080IPMCONVRTPM 01 81 CP 82 CM 00090I 1 32 RECA 00100I*------------------------------------------------------------------- 00110I PB 02 81 CB 82 CM 00120I 1 80 RECB 00130I*------------------------------------------------------------------- 00140I GG 03 00150O********************************************************************* 00160OTRNOUT DADD 01 00170O RECA 32 00180O********************************************************************* 00190OBMTRAN DADD 02 00200O RECB 80 /* 000210_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È< ÈTX099TX P120282120282(èÈÐ00010H Q099TX00020F* ADD TXFILE TEXT FROM 80-COL DISK FILE 00030F* REVISED 6-25-81 11:00 AM. 00040FEDPIN IP F 80 DISK 00050FTXCONT UC F 16R DISK 00060FTXPTR UC F 2R DISK 00070FTXMAST UC F 86R10AI 1 DISK A 00080FTXFILE UC F 92R DISK 00090E******************************************************************* 00100E A77 1 77 1 00110E TMP 25 5 0A 00120I******************************************************************** 00130IEDPIN EP 01 00140I 1 77 REC 00150I 78 78 TYPE 00160I 79 79 HLIN 00170I 80 80 SPACE 00180I**************************************************************** 00190ITXCONT TC 00200I 1 70TCLU 00210I**************************************************************** 00220ITXPTR TP 00230I 1 1 TPPTR 00240I*************************************************************** 00250ITXMAST TM ÐÐ00260I 1 8 TMNAME 00270I P 11 85 TMP 00280I************************************************************** 00290ITXFILE TX 00300I 92 92 TXSTAT 00310C******************************************************************* 00320C MOVELREC W1A 1 00330C W1A COMP '\' 54 FLAG NAME RECORD 00340C N54 GOTO TAG10 NOT NAME RECORD 00350C MOVELREC W9A 9 00360C MOVE W9A NAME 8 TEXT NAME 00370C MOVELNAME W2A 2 00380C W2A COMP '$R' 70 FLAG RPG PROG 00390C Z-ADD1 RECNO 20 TXMAST REC NO 00400C Z-ADD1 L 40 TXMAST LINE NO 00410C GOTO ENDJOB 00420C*------------------------------------------------------------------ 00430C TAG10 TAG 00440C MOVELREC W2A 00450C N71 W2A COMP '**' 71 FLAG TABLE 00460C W2A COMP '/*' LR END OF FILE 00470C LR GOTO ENDJOB 00480C 1 ADD L L 00490C L COMP 25 54 00500C N54 GOTO TAG20 ÐÐ00510C SETON 85 00520C EXCPT 00530C SETOF 85 00540C Z-ADD1 L 00550C 1 ADD RECNO RECNO 00560C Z-ADD0 TMP 00570C*------------------------------------------------------------------- 00580C TAG20 TAG 00590C N70 NOT RPG PROG 00600COR 70 71 GOTO TAG25 RPG TABLE 00610C MOVEAREC A77 00620C MOVEAA77,28 W8A 8 00630C W8A COMP '--------' 54 00640C N54 W8A COMP '********' 54 00650C 54 GOTO ENDJOB 00660C*----------------------------------------------------------------- 00670C TAG25 TAG 00680C 1 ADD RRN RRN 50 00690C RRN CHAINTXPTR 54 00700C 54 Z-ADD1 RRN 00710C 54 GOTO TAG20 00720C TPPTR COMP 'X' 54 00730C N54 GOTO TAG20 00740C MOVE ' ' TPPTR 00750C SETON 80 ÐÐ00760C EXCPT UPDATE TXPTR 00770C SETOF 80 00780C RRN CHAINTXFILE H9 00790C H9 GOTO ENDJOB 00800C SETON 81 00810C EXCPT UPDATE TXFILE 00820C SETOF 81 00830C Z-ADDRRN TMP,L 00840C*------------------------------------------------------------------- 00850C END TAG 00860CLR Z-ADD1 W5N 50 00870CLR W5N CHAINTXCONT H9 00880CLR SETON 82 00890CLR EXCPT UPDATE TXCONT 00900CLR SETOF 82 00910C*--------------------------------------------------------------------- 00920CLR ENDJOB TAG 00930O****************************************************************** 00940OTXFILE E 81 00950O REC 77 00960O TYPE 78 00970O HLIN 79 00980O SPACE 80 00990O NAME 88 01000O 92 'A' ÐÐ01010O***************************************************************** 01020OTXPTR E 80 01030O 1 'X' 01040O****************************************************************** 01050OTXCONT E 82 01060O RRN 5 01070O****************************************************************** 01080OTXMAST EADD 85 01090O NAME 8 01100O RECNO 10 01110O TMP 85P 01120O***************************************************************** ** A77 ARRAY 01130 01140/* 01150_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( ñ PNSTRT P 111883111883(èÈÐ00000000000000 00010_‚_‚ 111883111883(è ÐÈ(ÈU© ÈTX201BM P®ê120282120282(èÈÐ00010H Q201BM00020F* UPDATE BMMAST/BMWU FILE WITH DELETES (CALLED BY Q102BM) (X201BM) 00030F* REVISED 2/08/83 4:35 PM. DG-REL006 OK. 00040F* 1. DELETES WHERE-USED RECORD, IF SINGLE ITEM DELETE 00050F* (BMMAST DELETED BY Q102BM). 00060F* 2. DELETED WHERE-USED AND BMMAST IF DELETE ENTIRE 00070F* ASSY TRANSACTION. 00080F* 3. ADDS BMTRAN RECORD. 00090FBITTAB IP F 33 DISK 00100FBMMAST UD F 86L20AI 1 DISK 00110FPMMST2 UC F 674R12AI 1 DISK 00120FBMWU UD F 21L20AI 1 DISK 00130FCRTFILE IC F 256R DISK 00140FBMTRAN O F 80 DISK A 00150FTERMO O F 25 5 00160E******************************************************************** 00170E BIT 33 1 00180I******************************************************************** 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************** 00220IBMMAST BM 00230I 1 100BMAPN 00240I 11 200BMCPN 00250I 86 86 BMSTAT ÐÐ00260I******************************************************************** 00270IPMMST2 PM 00280I P 13 140PMNOBM 00290I 70 71 PMECHG 00300I******************************************************************** 00310IBMWU BW 00320I 1 100BWCPN 00330I 11 200BWAPN 00340I 21 21 BWSTAT 00350I******************************************************************** 00360ICRTFILE CR 00370I 80 890CRAPN 00380I 90 990CRCPN 00390I 250 250 CRTRAN 00400C******************************************************************** 00410C EXSR SR101 00420C SETOF 83 00430C H9 GOTO ENDJOB 00440C CRTRAN COMP '#' 54 00450C 54 GOTO TAG50 DELETE ALL. 00460C* DELETE SINGLE COMOPONENT, WHERE-USED ONLY. 00470C MOVELCRCPN W20A 20 00480C MOVE CRAPN W20A 00490C W20A SETLLBMWU 00500C*------------------------------------------------------------ ÐÐ00510C TAG10 TAG 00520C SETOF 54 00530C READ BMWU 54GET WHERE-USED 00540C 54 GOTO ENDJOB 00550C CRTRAN COMP 'D' 54 00560C 54 GOTO TAG20 DELETE ITEM 00570C* FLAG BAD TRAN. GO TO END PROG. 00580C SETON 85 00590C EXCPT FLAG ERROR 00600C SETOF 85 00610C EXITFQMOVUP BUMP CURSOR UP 00620C GOTO ENDJOB 00630C*-------------------------------------------------------------- 00640C TAG20 TAG 00650C* UPDATE WHERE-USED, SINGLE ITEM. 00660C BWCPN COMP CRCPN 54 00670C 54 BWAPN COMP CRAPN 54 00680C N54 GOTO ENDJOB 00690C BWSTAT COMP 'D' 54 00700C 54 GOTO ENDJOB 00710C SETON 80 00720C EXCPT UPDATE BMWU 00730C SETOF 80 00740C Z-ADDBWAPN W10N 100 00750C EXSR SR102 UPDATE PMMST. ÐÐ00760C GOTO ENDJOB 00770C*----------------------------------------------------------------- 00780C TAG50 TAG 00790C* DELETE ENTIRE ASSY, BMMAST & BMWU. 00800C MOVELCRAPN W20A 00810C MOVE ZERO10 W20A 00820C W20A SETLLBMMAST 00830C SETOF 83 00840C*------------------------------------------------------------------- 00850C TAG55 TAG 00860C* GET NEXT COMPONENT. 00870C SETOF 54 00880C READ BMMAST 54GET BMMAST 00890C 54 GOTO ENDJOB 00900C BMAPN COMP CRAPN 54 00910C N54 GOTO ENDJOB WRONG ASSY 00920C BMSTAT COMP 'D' 54 00930C 54 GOTO TAG55 00940C MOVELBMCPN W20A 00950C MOVE CRAPN W20A 00960C W20A SETLLBMWU 00970C SETOF 54 00980C READ BMWU 54GET WHERE-USED 00990C 54 GOTO TAG60 END OF FILE 01000C BWAPN COMP BMAPN 54 ÐÐ01010C 54 BWCPN COMP BMCPN 54 01020C N54 GOTO TAG60 WRONG RECORD 01030C SETON 80 01040C*------------------------------------------------------------------- 01050C TAG60 TAG 01060C Z-ADDBWAPN W10N 01070C SETON 8183 01080C EXCPT UPD BMMAST,BMWU 01090C SETOF 8081 01100C EXSR SR102 UPDATE PMMST2 01110C GOTO TAG55 GET NEXT COMPONENT 01120C*------------------------------------------------------------------- 01130C ENDJOB TAG 01140C CRTRAN COMP 'D' 54 01150C CRTRAN COMP '#' 55 01160C TIME TIME 60 01170C 54 MOVEL'Q102BM' PROG 8 01180C 55 MOVEL'Q101BM' PROG 01190C PROG COMP ' ' 54 01200C N54 MOVEL'Q101BM' PROG 01210C EXITFCHAIN 01220C RLABL PROG 01230C******************************************************************** 01240CSR SR101 BEGSR 01250C* 1-TIME INITIALIZE ÐÐ01260C* GET PORT # AND CRTFILE 01270CSR MOVE ' ' W2A 2 01280CSR EXITFZGMINX GET PORT # 01290CSR RLABL W2A 01300CSR MOVE W2A PORT 20 PORT NO. 01310CSR PORT COMP 0 54 01320CSRN54 Z-ADD25 PORT DEFAULT 01330CSR PORT CHAINCRTFILE H9 01340C* DEFINE WORK FIELDS,ETC. 01350CSR MOVE ' ' BLK35 35 01360CSR Z-ADD0 ZERO10 100 01370CSR ENDSR 01380C******************************************************************** 01390CSR SR102 BEGSR 01400C* UPDATE PMMST2# OF COMPONENTS. 01410CSR MOVELW10N W12A 12 01420CSR MOVE ' ' W12A 01430CSR W12A CHAINPMMST2 66 01440CSR 66 GOTO END102 01450CSR PMNOBM SUB 1 PMNOBM 01460CSR SETON 82 01470CSR EXCPT 01480CSR SETOF 82 01490CSR END102 ENDSR 01500O******************************************************************** ÐÐ01510OBMWU E 80 01520O 21 'D' 01530O******************************************************************** 01540OBMMAST E 81 01550O 86 'D' 01560O******************************************************************** 01570OPMMST2 E 82 01580O PMNOBM 14P 01590O***************************************************************** 01600OBMTRAN EADD 81 01610O BMAPN 10 01620O PMECHG 12 01630O BMCPN 40 01640O UDATE 70 01650O TIME 76 01660O 79 'DEL' 01670O 80 '1' 01680O************************************************************* 01690OTERMO E 85 01700O 13 'BAD TRAN CODE' /* 001710_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(d  X100DP P120282120282(èÈÐ00010H Q100DP00020F* PUT 80-COL RECORD TO FLOPPY (ASCII). (X100DP) 00030F* REVISED 7/30/80 1:35 PM. 00040FDISK80 IP F 80 DISK 00050FFLOPPY O F 80 17 00060I******************************************************************** 00070IDISK80 DK 01 00080I 1 80 REC 00090O******************************************************************** 00100OFLOPPY D 01 00110O REC 80 00120O T LR 00130O 2 '/*' /* 000140_‚ _‚_‚ ÐÈ(Ðn ÐBX100DX P120282120282(èÈÐ00010H S Q100DX00020F* 132-COL TEXT FILE UPDATE. (X100DX) 00030F* REVISED 6/16/80 5:30 PM. 00040FBITHEX IP F 256 DISK 00050FDXMAST UC F 288R 8AI 1 DISK A 00060FDXPTR UC F 100R DISK 00070FDXFILE UC F 99R DISK 00080FDXAVAIL UC F 200R DISK 00090FDXCOPY UC F 402R DISK 00100FMGFILE IC F 80R DISK 00110E******************************************************************** 00120E A96 1 96 1 A 00130E FROM 1 96 1 A 00140E TOR 1 96 1 A 00150E BAT 1 96 1 00160E CRT 1 132 1 00170E ARA 1 96 1 WORK ARRAY 00180E ARB 1 96 1 WORK ARRAY 00190E BIT 256 1 00200E REC 96 1 A 00210E BLK 100 3 0A 00220E PAG 100 1 A 00230E NAB 200 1 00240E CPY 100 7 0A 00250I******************************************************************** ÐÐ00260IBITHEX BT 00270I 1 256 BIT 00280I******************************************************************** 00290IMGFILE MG 00300I 1 60 MGTEXT 00310I******************************************************************** 00320IDXMAST TM 00330I* TEXT MASTER. 00340I* TEXT NAME 8A 00350I 1 8 TMNAME 00360I* TEXT TITLE 60A 00370I 9 68 TMTITL 00380I* TEXT TYPE 1A 00390I 69 69 TMTYPE 00400I* PTR BLOCKS ASSIGNED 3P X 100 00410I P 88 287 BLK 00420I* RECORD STATUS 1A 00430I 288 288 TMSTAT 00440I******************************************************************** 00450IDXPTR TP 00460I* TEXT POINTER FILE. 00470I* REL RECORD STATUS 1A X 100 00480I* Y = RECORD ALLOCATED 00490I* N = RECORD NOT IN USE 00500I 1 100 PAG ÐÐ00510I******************************************************************** 00520IDXFILE DX 00530I* TEXT FILE. 00540I* TEXT DATA 1A X 96 00550I 1 96 REC 00560I* TEXT TYPE 1A 00570I* H = HEADING C = TABLE CONTENTS 00580I* T = TEXT X = INDEX 00590I* F = FOOTNOTE 00600I 97 97 DXTYPE 00610I* HEADING/FOOTNOTE LINE # 1N 00620I 98 980DXLINE 00630I* SPACE CODE 1A 00640I* 1-3 = SPACE LINES BEFORE PRINT 00650I* S = SKIP NEW PAGE 00660I 99 99 DXSPAC 00670I******************************************************************** 00680IDXAVAIL TA 00690I* TEXT AVAIL FILE (UNUSED BLOCKS) 00700I* AVAIL BLOCKS 1A X 200 00710I* 'N' = BLK IS AVAIL 00720I* 'Y' = BLK IS NOT AVAIL 00730I 1 200 NAB 00740I******************************************************************** 00750IDXCOPY TC ÐÐ00760I* TEXT COPY WORK FILE 00770I* TERMINAL NUMBER 2N 00780I 1 20TCPORT 00790I* COPY PTR ARRAY 7P X 100 00800I P 3 402 CPY 00810C******************************************************************** 00820C* INITIALIZE 1-TIME. 00830C EXSR SR101 INIT 00840C*------------------------------------------------------------------- 00850C START TAG 00860C* PUT MENU. 00870C EXSR SR102 SETOFFS 00880C EXSR SR103 PUT MENU 00890C*------------------------------------------------------------------- 00900C TAG5 TAG 00910C* REQUEST SELECTION AND BRANCH 00920C EXSR SR616 MOV NAME TO KEY 00930C 40 00940COR 44 EXSR SR400 UPD/GET DXMAST 00950C 41 EXSR SR404 UPDATE DXPTR 00960C EXSR SR102 SETOFFS 00970C EXSR SR104 RQST SELECTION 00980C 94 GOTO START ESC BKWD 00990C 90 GOTO ESCAPE ESC OTHER 01000C N40N63N44 MOVE 'G' INSTR ÐÐ01010C N40N63N44 GOTO TAG10 FORCE GET 01020C 55 GOTO TAG10 GET 01030C 56 GOTO TAG20 ADD 01040C 57 GOTO TAG30 DELETE 01050C 58 GOTO TAG40 LIST 01060C 59 GOTO TAG50 REPLACE 01070C 60 GOTO TAG60 RESEQ 01080C 61 GOTO TAG70 SEARCH 01090C 62 GOTO TAG80 COPY 01100C 63 GOTO TAG90 SET-TAB 01110C Z-ADD241 M 50 01120C EXSR SR455 FLAG ERROR 01130C GOTO TAG5 01140C*------------------------------------------------------------------- 01150C TAG10 TAG 01160C* GET TEXT. 01170C EXSR SR105 RQST NAME 01180C 90 GOTO ESCAPE 01190C*------------------------------------------------------------------- 01200C TAG11 TAG 01210C EXSR SR106 RQST TITLE 01220C 94 GOTO TAG10 01230C 90 GOTO ESCAPE 01240C*------------------------------------------------------------------- 01250C TAG12 TAG ÐÐ01260C EXSR SR107 RQST TYPE 01270C 94 GOTO TAG11 01280C 90 GOTO ESCAPE 01290C EXSR SR616 NAME TO KEY 01300C EXSR SR400 GET DXMAST 01310C GOTO TAG5 01320C*------------------------------------------------------------------- 01330C TAG20 TAG 01340C* ADD TEXT. 01350C EXSR SR108 RQST START 01360C 90 GOTO ESCAPE 01370C*------------------------------------------------------------------- 01380C TAG21 TAG 01390C EXSR SR110 RQST INCREMENT 01400C 94 GOTO TAG20 01410C 90 GOTO ESCAPE 01420C EXSR SR117 RQST LINE OPTION 01430C 94 GOTO TAG21 01440C 90 GOTO ESCAPE 01450C EXSR SR201 ADD TEXT 01460C 90 GOTO ESCAPE 01470C GOTO TAG5 01480C*------------------------------------------------------------------- 01490C TAG30 TAG 01500C* DELETE TEXT. ÐÐ01510C EXSR SR108 RQST START 01520C 90 GOTO ESCAPE 01530C*------------------------------------------------------------------- 01540C TAG31 TAG 01550C EXSR SR109 RQST END 01560C 94 GOTO TAG30 01570C 90 GOTO ESCAPE 01580C EXSR SR203 DELETE TEXT 01590C 90 GOTO ESCAPE 01600C GOTO TAG5 01610C*------------------------------------------------------------------- 01620C TAG40 TAG 01630C* LIST TEXT. 01640C EXSR SR108 RQST START 01650C 90 GOTO ESCAPE 01660C*------------------------------------------------------------------- 01670C TAG41 TAG 01680C EXSR SR109 RQST END 01690C 94 GOTO TAG40 01700C 90 GOTO ESCAPE 01710C EXSR SR204 LIST TEXT 01720C 90 GOTO ESCAPE 01730C GOTO TAG5 01740C*------------------------------------------------------------------- 01750C TAG50 TAG ÐÐ01760C* REPLACE TEXT. 01770C EXSR SR108 RQST START 01780C 90 GOTO ESCAPE 01790C*---------------------------------------------------------------- 01800C TAG51 TAG 01810C EXSR SR109 RQST END 01820C 94 GOTO TAG50 01830C 90 GOTO ESCAPE 01840C*------------------------------------------------------------------- 01850C TAG52 TAG 01860C EXSR SR111 RQST SEARCH OPTION 01870C 94 GOTO TAG51 01880C 90 GOTO ESCAPE 01890C*------------------------------------------------------------------- 01900C TAG53 TAG 01910C EXSR SR112 RQST FROM DATA 01920C 94 GOTO TAG52 01930C 90 GOTO ESCAPE 01940C*------------------------------------------------------------------- 01950C TAG54 TAG 01960C EXSR SR113 RQST CHG-TO DATA 01970C 94 GOTO TAG53 01980C 90 GOTO ESCAPE 01990C EXSR SR920 REPLACE TEXT 02000C 90 GOTO ESCAPE ÐÐ02010C GOTO TAG5 02020C*------------------------------------------------------------------- 02030C TAG60 TAG 02040C* RESEQ TEXT. 02050C EXSR SR108 RQST START 02060C 90 GOTO ESCAPE 02070C*------------------------------------------------------------------- 02080C TAG61 TAG 02090C EXSR SR109 RQST END 02100C 94 GOTO TAG60 02110C 90 GOTO ESCAPE 02120C*------------------------------------------------------------------- 02130C TAG62 TAG 02140C EXSR SR110 RQST INCREMENT 02150C 94 GOTO TAG61 02160C 90 GOTO ESCAPE 02170C EXSR SR206 RESEQ TEXT 02180C 90 GOTO ESCAPE 02190C GOTO TAG5 02200C*------------------------------------------------------------------- 02210C TAG70 TAG 02220C* SEARCH TEXT. 02230C EXSR SR108 RQST START 02240C 90 GOTO ESCAPE 02250C*------------------------------------------------------------------- ÐÐ02260C TAG71 TAG 02270C EXSR SR109 RQST END 02280C 94 GOTO TAG70 02290C 90 GOTO ESCAPE 02300C*------------------------------------------------------------------- 02310C TAG72 TAG 02320C EXSR SR111 RQST SEARCH OPTION 02330C 94 GOTO TAG71 02340C 90 GOTO ESCAPE 02350C*------------------------------------------------------------------- 02360C TAG73 TAG 02370C EXSR SR112 RQST SEARCH DATA 02380C 94 GOTO TAG72 02390C 90 GOTO ESCAPE 02400C EXSR SR920 SEARCH TEXT 02410C 90 GOTO ESCAPE 02420C GOTO TAG5 02430C*------------------------------------------------------------------- 02440C TAG80 TAG 02450C* COPY TEXT. 02460C EXSR SR114 RQST COPY FROM NAME 02470C 90 GOTO ESCAPE 02480C*------------------------------------------------------------------- 02490C TAG81 TAG 02500C EXSR SR108 RQST START ÐÐ02510C 94 GOTO TAG80 02520C 90 GOTO ESCAPE 02530C*------------------------------------------------------------------- 02540C TAG82 TAG 02550C EXSR SR109 RQST END 02560C 94 GOTO TAG81 02570C 90 GOTO ESCAPE 02580C*------------------------------------------------------------------- 02590C TAG83 TAG 02600C EXSR SR115 RQST COPY-TO LINE 02610C 94 GOTO TAG82 02620C 90 GOTO ESCAPE 02630C EXSR SR110 RQST INCREMENT 02640C 94 GOTO TAG83 02650C 90 GOTO ESCAPE 02660C EXSR SR208 COPY TEXT 02670C 90 GOTO ESCAPE 02680C GOTO TAG5 02690C*------------------------------------------------------------------- 02700C TAG90 TAG 02710C* SET-TAB STOPS. 02720C EXSR SR209 SET-TABS. 02730C 90 GOTO ESCAPE 02740C GOTO TAG5 02750C*------------------------------------------------------------------- ÐÐ02760C ESCAPE TAG 02770C 97 GOTO START 02780C 98 GOTO MENU 02790C 99 GOTO GOODBY 02800C GOTO TAG5 02810C*------------------------------------------------------------------- 02820C MENU TAG 02830C MOVEL'QQDX01' PROG 8 02840C GOTO END 02850C*------------------------------------------------------------------- 02860C GOODBY TAG 02870C MOVEL'GOODBY' PROG 02880C*------------------------------------------------------------------- 02890C END TAG 02900C 44 02910COR 40 EXSR SR401 UPD DXMAST 02920C 41 EXSR SR404 UPD DXPTR 02930C EXSR SR408 UPD DXAVAIL 02940C EXITFCHAIN 02950C RLABL PROG 02960C*------------------------------------------------------------- 02970C ENDJOB TAG 02980C******************************************************************** 02990C* ESCAPE INDICATORS. 03000C* 90 GENERAL 94 BACKWARD-SKIP ÐÐ03010C* 91 LINE-FEED (TAB) 96 NEW ITEM 03020C* 92 REPEAT 97 LOCAL MENU 03030C* 93 DONE 98 SYSTEM MENU 03040C* 94 BACKWARD-TAB 99 GOODBY 03050C******************************************************************** 03060CSR SR70 BEGSR 03070C* PUT LINE TO CRT. 03080CSR MOVEACRT BUFOUT132 03090CSR EXSR SR501 CR-ONLY 03100CSR EXITFQW132 PUT CRT 03110CSR RLABL BUFOUT 03120CSR ENDSR 03130C******************************************************************** 03140CSR SR71 BEGSR 03150C* PROMPT - CURSOR 120,37. 03170CSR MOVEAMGTEXT CRT,1 03180CSR MOVEAW60A CRT,60 03190CSRN33 EXSR SR502 LFCR 03200CSR SETOF 33 03210CSR EXSR SR70 PUT 03220CSR MOVE '120037' W6A 03230CSR EXSR SR500 POSITION CURSOR 03240CSR ENDSR 03250C******************************************************************** 03260CSR SR72 BEGSR ÐÐ03270C* PROMPT - 03280CSR EXSR SR603 INIT CRT ARRAY 03290CSR MOVEAMGTEXT CRT,1 03300CSR EXSR SR502 LFCR 03310CSR EXSR SR70 PUT 03320CSR EXSR SR502 LFCR 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR73 BEGSR 03360C* ERR MSG - 03370CSR EXSR SR603 INIT CRT 03380CSR MOVEAMGTEXT CRT,1 03390CSR EXSR SR502 LFCR 03400CSR EXSR SR70 PUT 03410CSR ENDSR 03420C******************************************************************** 03430CSR SR74 BEGSR 03440C* PUT TEXT LINE. 03450CSR MOVEAREC CRT 03460CSR Z-ADDLINENO W5N 50 03470CSR EXSR SR611 Z-EDIT 03480CSR MOVE W5A W4A 4 03490CSR Z-ADD129 X 03500CSR MOVEAW4A CRT,X 03510CSR EXSR SR70 PUT CRT ÐÐ03520CSR ENDSR 03530C******************************************************************** 03540CSR SR101 BEGSR 03550C* 1-TIME INIT. 03560CSR Z-ADD9999 LLIMIT 50 LINE LIMIT 03570CSR Z-ADD99000 RLIMIT 60 RECORD LIMIT 03580CSR LLIMIT DIV 100 BLIMIT 30 BLK LIMIT 03590CSR RLIMIT DIV 100 NLIMIT 30 DXAVAIL LIMIT 03600CSR Z-ADDBLIMIT SLIMIT 50 DXRESEQ LIMIT 03610CSR Z-ADD100 PLIMIT 30 PAG LIMIT 03620CSR MOVELBIT,1 BUFLGT 2 READ BUF LGTH 03630CSR MOVE BIT,97 BUFLGT 03640CSR MOVE ' ' W8A 8 03650CSR Z-ADD0 W2N 20 03660CSR Z-ADD0 W1N 10 03670CSR MOVE ' ' W2A 2 03680CSR EXITFPGMINX GET PORT # 03690CSR RLABL W8A 03700CSR RLABL W2N 03710CSR RLABL W1N 03720CSR RLABL W2A 03730CSR MOVE W2A PORT 20 03740CSR PORT COMP 0 54 03750CSRN54 Z-ADD25 PORT 03760CSR Z-ADD1 N 30 ÐÐ03770CSR MOVE ' ' BLK96 96 03780CSR MOVE ' ' BLK8 8 03790CSR Z-ADD0 ZERO3 30 03800CSR Z-ADD0 ZERO5 50 03810CSR Z-ADD0 ZERO7 70 03820CSR MOVE ' ' BAT 03830C* SET TAB STOPS AT EVERY COL ON CRT. 03840CSR Z-ADD1 X 03850CSR MOVELBIT,28 W2A 2 03860CSR MOVE '1' W2A 03870CSR MOVELW2A W3A 3 03880CSR MOVE ' ' W3A 03890C*------------------------------------------------------------------- 03900CSR T101 TAG 03910CSR MOVEAW3A CRT,X 03920CSR 3 ADD X X 03930CSR EXSR SR606 COMP 96 03940CSRN54 GOTO T101 03950CSR EXSR SR502 03960CSR EXSR SR70 03970CSR EXSR SR70 03980CSR EXSR SR70 03990C* SET TAB DEFAULT. 04000CSR Z-ADD0 X 30 04010CSR Z-ADD234 A ÐÐ04020CSR MOVE BIT,A BAT 04030CSR MOVE 'X' BAT,1 04040C*---------------------------------------------------------- 04050CSR T101A TAG 04060CSR 10 ADD X X 04070CSR MOVE 'X' BAT,X 04080CSR X COMP 122 54 04090CSRN54 GOTO T101A 04100CSR END101 ENDSR 04110C******************************************************************** 04120CSR SR102 BEGSR 04130C* SET-OFF HEAVY INDICATORS. 04140CSR SETOF 779091 04150CSR SETOF 929394 04160CSR SETOF 9697 04170CSR SETOF 9899 04180CSR ENDSR 04190C******************************************************************** 04200CSR SR103 BEGSR 04210C* PUT MENU. 04220CSR Z-ADD437 M 50 04230CSR Z-ADD1 X 30 04240CSR Z-ADD0 COUNT 04250CSR MOVE '120001' W6A 6 04260CSR EXSR SR500 POSITION CUROSR ÐÐ04270C*------------------------------------------------------------------- 04280CSR T103A TAG 04290CSR EXSR SR411 GET MESSAGE 04300CSR EXSR SR73 PUT MSG 04310CSR 1 ADD M M 04320CSR 1 ADD COUNT COUNT 30 04330CSR COUNT COMP 8 54 04340CSRN54 GOTO T103A 04350CSR ENDSR 04360C******************************************************************** 04370CSR SR104 BEGSR 04380C* REQUEST SELECTION. 04390CSR Z-ADD454 M 04400CSR EXSR SR605 INIT W60A 04410CSR EXSR SR451 PROMPT/READ 04420CSR 90 GOTO END104 04430CSR MOVELBUFIN INSTR 1 INSTRUCTION 04440CSR EXSR SR707 CLASSIFY INSTR 04450CSR END104 ENDSR 04460C******************************************************************** 04470CSR SR105 BEGSR 04480C* REQUEST TEXT NAME 04490CSR EXSR SR605 INIT W60A 04500CSR MOVE NAME W15A 15 04510CSR EXSR SR619 W15A L W60A ÐÐ04520CSR Z-ADD155 M 04530CSR EXSR SR451 PROMPT/READ 04540CSR 90 GOTO END105 04550CSR MOVELBUFIN NAME 8 TEXT NAME 04560CSR EXSR SR616 NAME TO KEY 04570CSR EXSR SR400 GET DXMAST 04580CSR 60 MOVE BLK96 TMTITL 04590CSR 60 MOVE ' ' TMTYPE 04600CSR 60 MOVE 'A' TMSTAT 04610CSR 60 Z-ADD0 BLK 04620CSRN60 MOVE TMTITL TITLE 60 04630CSRN60 MOVE TMTYPE MTYPE 1 04640CSR END105 ENDSR 04650C******************************************************************** 04660CSR SR106 BEGSR 04670C* REQUEST TITLE. 04680CSR Z-ADD52 M 04690CSR EXSR SR605 CLEAR W60A 04700CSR MOVE TITLE W60A 60 04710CSR EXSR SR450 PROMPT/READ 04720CSR 92 GOTO SR106 REPEAT ESC 04730CSR 90 GOTO END106 OTHER ESC 04740CSR ' ' LOKUPA96 54 04750CSR 54 MOVELBUFIN TITLE TEXT TITLE 04760CSR END106 ENDSR ÐÐ04770C******************************************************************** 04780CSR SR107 BEGSR 04790C* REQUEST MASTER TYPE. 04800CSR Z-ADD461 M 04810CSR EXSR SR605 CLEAR W60A 04820CSR MOVE MTYPE W15A 04830CSR EXSR SR619 W15A L W60A 04840CSR EXSR SR450 PROMPT/READ 04850CSR MOVELBUFIN W1A TEXT TYPE 04860CSR W1A COMP ' ' 54 04870CSR 54N90 MOVE W1A MTYPE 04880CSR ENDSR 04890C******************************************************************** 04900CSR SR108 BEGSR 04910C* REQUEST START LINE NO. 04920CSR Z-ADD156 M 04930CSR EXSR SR605 CLEAR W60A 04940CSR Z-ADDSTART W5N 50 04950CSR EXSR SR611 EDIT-Z 04960CSR EXSR SR617 W5A TO W60A 04970CSR EXSR SR451 PROMPT/READ 04980CSR 90 GOTO END108 04990CSR 77 EXSR SR701 R. ADJUST 05000CSR 77 MOVE W10A START 50 05010CSR START COMP 0 54 ÐÐ05020CSR 54 START COMP LLIMIT 5454 05030CSR 54 GOTO END108 05040CSR Z-ADD467 M 05050CSR EXSR SR455 FLAG ERROR 05060CSR GOTO SR108 05070CSR END108 ENDSR 05080C******************************************************************** 05090CSR SR109 BEGSR 05100C* REQUEST END LINE #. 05110CSR Z-ADD0 ENDLIN 05120CSR Z-ADD157 M 05130CSR EXSR SR605 CLEAR W60A 05140CSR Z-ADDENDLIN W5N 05150CSR EXSR SR611 EDIT-Z 05160CSR EXSR SR617 W5A TO W60A 05170CSR EXSR SR450 PROMPT/READ 05180CSR 90 GOTO END109 05190CSR 77 EXSR SR701 R. ADJUST 05200CSR 77 MOVE W10A ENDLIN 50 END LINE # 05210CSR ENDLIN COMP 0 54 05220CSR 54 GOTO T109A 05230CSR EXSR SR707 05240CSR 57 05250COR 59 05260COR 60 ÐÐ05270COR 62 Z-ADDSTART ENDLIN DEFAULT 05280CSR 58 05290COR 61 Z-ADDLLIMIT ENDLIN DEFAULT 05300C*------------------------------------------------------------------- 05310CSR T109A TAG 05320CSR ENDLIN COMP START 55 55 05330CSR 55 ENDLIN COMP LLIMIT 5555 05340CSRN55 Z-ADD243 M 05350CSRN55 EXSR SR455 FLAG ERROR 05360CSRN55 GOTO SR109 05370CSR END109 ENDSR 05380C******************************************************************** 05390CSR SR110 BEGSR 05400C* REQUEST INCREMENT. 05410CSR Z-ADD455 M 05420CSR EXSR SR605 INIT W60A 05430CSR Z-ADDINCRMT W5N 05440CSR EXSR SR611 EDIT-Z 05450CSR EXSR SR617 W5A TO W60A 05460CSR EXSR SR450 PROMPT/READ 05470CSR 90 GOTO END110 05480CSR 77 EXSR SR701 R. ADJUST 05490CSR 77 MOVE W10A INCRMT 30 INCREMENT 05500CSR INCRMT COMP 0 54 05510CSRN54 Z-ADD1 INCRMT ÐÐ05520CSR END110 ENDSR 05530C******************************************************************** 05540CSR SR111 BEGSR 05550C* REQUEST SEARCH OPTION. 05560CSR Z-ADD468 M 05570CSR EXSR SR605 INIT W60A 05580CSR MOVE SOPTON W15A 05590CSR EXSR SR619 W15A L W60A 05600CSR EXSR SR450 PROMPT/READ 05610CSR 90 GOTO END111 05620CSR 77 MOVELBUFIN SOPTON 1 SEARCH OPTION 05630CSR SOPTON COMP ' ' 54 05640CSRN54 SOPTON COMP 'C' 54 05650C*------------------------------------------------------------------- 05660CSR END111 TAG 05670CSR ENDSR 05680C******************************************************************** 05690CSR SR112 BEGSR 05700C* REQUEST SEARCH DATA. 05710CSR Z-ADD456 M 05720CSR MOVE BIT,1 REC 05730CSR EXSR SR452 PROMPT/READ 05740CSR 92 GOTO SR112 REPEAT ESC 05750CSR 90 GOTO END112 05760CSR EXSR SR708 MOVE INPUT DATA ÐÐ05770CSR MOVEABUFIN FROM SEARCH DATA 05780CSR BIT,32 LOKUPFROM 54 05790CSR 54 GOTO END112 INPUT WAS MADE 05800CSR Z-ADD469 M 05810CSR EXSR SR455 FLAG ERROR 05820CSR GOTO SR112 05830CSR END112 ENDSR 05840C******************************************************************** 05850CSR SR113 BEGSR 05860C* REQUEST CHANGE-TO DATA. 05870CSR MOVE BIT,1 REC 05880CSR Z-ADD471 M 05890CSR EXSR SR452 PUT MSG 05900CSR 92 GOTO SR113 REPEAT ESC 05910CSR 90 GOTO END113 OTHER ESC 05920CSR EXSR SR708 MOVE INPUT DATA 05930CSR MOVEABUFIN TOR CHANGE-TO DATA 05940CSR BIT,32 LOKUPTOR 54 05950CSR 54 GOTO END113 INPUT WAS MADE 05960CSR Z-ADD469 M 05970CSR EXSR SR455 FLAG ERROR 05980CSR GOTO SR113 05990CSR END113 ENDSR 06000C******************************************************************** 06010CSR SR114 BEGSR ÐÐ06020C* REQUEST COPY-FROM TEXT NAME. 06030CSR EXSR SR605 INIT W60A 06040CSR MOVE FRNAME W15A 06050CSR EXSR SR619 W15A L W60A 06060CSR Z-ADD458 M 06070CSR EXSR SR451 PROMPT/READ 06080CSR 90 GOTO END114 06090CSR 77 MOVELBUFIN FRNAME 8 06100CSR 44 06110COR 40 EXSR SR401 UPDATE DXMAST 06120CSR MOVE FRNAME TNAME 8 COPY-FROM NAME 06130CSR EXSR SR400 GET FROM MAST 06140CSR SETOF 4044 06150CSRN60 GOTO T114A GOT IT 06160CSR Z-ADD5 M 06170CSR EXSR SR455 FLAG ERROR 06180CSR GOTO SR114 06190C*------------------------------------------------------------------- 06200CSR T114A TAG 06210CSR EXSR SR616 NAME TO KEY 06220CSR EXSR SR400 CUT CUR MAST 06230CSR END114 ENDSR 06240C******************************************************************** 06250CSR SR115 BEGSR 06260C* REQUEST COPY-TO LINE. ÐÐ06270CSR EXSR SR605 INIT W60A 06280CSR Z-ADDCOPYTO W5N 06290CSR EXSR SR611 EDIT-Z 06300CSR EXSR SR617 W5A TO W60A 06310CSR Z-ADD459 M 06320CSR EXSR SR451 PROMPT/READ 06330CSR 90 GOTO END115 06340CSR 77 EXSR SR701 R. ADJUST 06350CSR 77 MOVE W10A COPYTO 50 COPY-TO LINE# 06360CSR COPYTO COMP 0 54 06370CSR 54 COPYTO COMP LLIMIT 5454 06380CSR 54 GOTO END115 06390CSR Z-ADD277 M 06400CSR EXSR SR455 FLAG ERROR 06410CSR GOTO SR115 06420CSR END115 ENDSR 06430C******************************************************************** 06440CSR SR116 BEGSR 06450C* REQUEST LINE CONTROL DATA. 06460CSR EXSR SR605 INIT W60A 06470CSR MOVE TYPE W15A 06480CSR EXSR SR619 W15A L W60A 06490CSR Z-ADD472 M 06500CSR EXSR SR411 GET MGFILE 06510CSR SETON 33 SUPPRESS LF ÐÐ06520CSR EXSR SR450 PROMPT/READ 06530CSR 90 GOTO END116 06540CSR 77 MOVELBUFIN TYPE 1 TEXT TYPE 06550C*------------------------------------------------------------------- 06560CSR T116A TAG 06570CSR TYPE COMP 'H' 54 06580CSRN54 TYPE COMP 'F' 54 06590CSRN54 GOTO T116B 06600CSR EXSR SR605 INIT W60A 06610CSR Z-ADDHLINE W5N 06620CSR EXSR SR611 EDIT-Z 06630CSR EXSR SR619 W5A TO W60A 06640CSR Z-ADD81 M 06650CSR SETON 33 06660CSR EXSR SR450 PROMPT/READ 06670CSR 94 GOTO SR116 BKWD-SKIP 06680CSR 90 GOTO END116 06690CSR 77 MOVELBUFIN HLINE 10 HDG LINE # 06700C*------------------------------------------------------------------- 06710CSR T116B TAG 06720CSR EXSR SR605 INIT W60A 06730CSR MOVE SPACE W15A 06740CSR EXSR SR619 W15A L W60A 06750CSR Z-ADD113 M 06760CSR SETON 33 ÐÐ06770CSR EXSR SR450 PROMPT/READ 06780CSR 94 GOTO T116A BKWD-SKIP 06790CSR 90 GOTO END116 06800CSR 77 MOVELBUFIN SPACE 1 SPACE CODE 06810CSR END116 ENDSR 06820C******************************************************************** 06830CSR SR117 BEGSR 06840C* REQUEST LINE OPTION. 06850CSR EXSR SR605 INIT W60A 06860CSR MOVE LCNTRL W15A 06870CSR EXSR SR619 W15A L W60A 06880CSR Z-ADD473 M 06890CSR EXSR SR450 PROMPT/READ 06900CSR 90 GOTO END117 ESC 06910CSR 77 MOVELBUFIN LCNTRL 1 LINE CONTROL CODE 06920C*------------------------------------------------------------------- 06930CSR T117A TAG 06940CSR LCNTRL COMP 'Y' 54 06950CSRN54 LCNTRL COMP 'N' 54 06960CSR LCNTRL COMP ' ' 55 06970CSRN54 55 MOVE 'N' LCNTRL 1 06980CSR 54 06990COR 55 GOTO END117 07000CSR Z-ADD385 M 07010CSR EXSR SR455 FLAG ERROR ÐÐ07020CSR GOTO SR117 07030C*------------------------------------------------------------------- 07040CSR END117 TAG 07050CSR ENDSR 07060C******************************************************************** 07070CSR SR201 BEGSR 07080C* ADD TEXT. 07090CSR MOVE BIT,1 ARA NULLS 07100CSR START SUB INCRMT LINENO 50 07110C*------------------------------------------------------------------- 07120CSR T201A TAG 07130CSR EXSR SR502 LFCR 07140CSR LCNTRL COMP 'Y' 54 07150CSR 54 EXSR SR116 RQST LINE CNTRL 07160CSR 90 GOTO END201 ESC 07170CSR EXSR SR615 INCRMT + LINENO 07180CSR EXSR SR614 CHK LINE LIMIT 07190CSR 54 GOTO T201T FILE FULL 07200CSR EXSR SR300 CALC B,P 07210CSR EXSR SR612 CHK BLK # 07220CSRN54 EXSR SR703 GET NEW BLOCK 07230CSR EXSR SR412 GET DXPTR 07240CSR EXSR SR301 CALC RRN 07250CSR EXSR SR405 GET DXFILE 07260CSR EXSR SR618 P=Y COMP ÐÐ07270CSRN54 MOVEABLK96 REC 07280CSRN54 MOVE ' ' DXTYPE 07290CSRN54 Z-ADD0 DXLINE HDG LINE # 07300CSRN54 MOVE ' ' DXSPAC 07310CSR 54 MOVE DXTYPE TYPE 07320CSR 54 Z-ADDDXLINE HLINE 07330CSR 54 MOVE DXSPAC SPACE 07340CSR EXSR SR454 SPACING 07350C*-------------------------------------------------------------------- 07360CSR T201B TAG 07370CSR EXSR SR74 PUT TEXT CRT 07380CSR MOVEAREC ARB 07390CSR EXSR SR476 READ 07400CSR 90 MOVEAARB REC 07410CSR EXSR SR74 PUT CRT 07420CSR 92 GOTO T201B REPEAT ESC 07430CSR 90 GOTO END201 ESC 07440CSR EXSR SR406 UPDATE DXFILE 07450CSR MOVE 'Y' PAG,P 07460CSR GOTO T201A 07470C*------------------------------------------------------------------- 07480CSR T201T TAG 07490C* FLAG FULL FILE. 07500CSR Z-ADD470 M 07510CSR EXSR SR455 FLAG ERROR ÐÐ07520C*------------------------------------------------------------------- 07530CSR END201 TAG 07540CSR 41 EXSR SR404 UPDATE DXPTR 07550CSR ENDSR 07560C******************************************************************** 07570CSR SR203 BEGSR 07580C* DELETE/LIST TEXT. 07590CSR EXSR SR600 INIT BUFIN 07600CSR Z-ADD0 COUNT 77 07610CSR START SUB 1 LINENO 50 07620CSRN36 EXSR SR502 LFCR 07630C*------------------------------------------------------------------- 07640CSR T203A TAG 07650CSR EXSR SR604 CHK CNTRL-D 07660CSR 54 GOTO END203 07670CSR 1 ADD LINENO LINENO INCRMT + LINENO 07680CSR EXSR SR613 CHK ENDLIN 07690CSR 54 GOTO END203 07700CSR EXSR SR300 CALC B,P 07710CSR EXSR SR612 CHK BLK # 07720CSRN54 EXSR SR610 ADVANCE LINENO 07730CSRN54 GOTO T203A NO BLK # 07740CSR EXSR SR412 GET DXPTR 07750CSR EXSR SR618 P=Y COMP 07760CSR 54 GOTO T203B ACTIVE LINE ÐÐ07770CSR EXSR SR601 FIND NEXT 'Y' 07780CSR 55 EXSR SR302 CALC NEW LINE# 07790CSR 55 EXSR SR613 CHK ENDLIN 07800CSR 54 GOTO END203 PAST LIMIT 07810CSR 55 GOTO T203B GET NEXT LINE 07820CSRN38 'Y' LOKUPPAG 54 07830CSRN38N54 EXSR SR704 STORE LINE 07840CSR Z-ADD100 P 07850CSR EXSR SR302 CALC NEW LINE# 07860CSR GOTO T203A 07870C*------------------------------------------------------------------- 07880CSR T203B TAG 07890CSR EXSR SR301 CALC RRN 07900CSR EXSR SR405 GET DXFILE 07910CSRN36 EXSR SR502 LFCR 07920CSRN36 EXSR SR456 SPACING 07930CSRN36 EXSR SR74 PUT TEXT 07940CSR 1 ADD COUNT COUNT 07950CSR COUNT COMP 29 56 56 07960CSR 56 EXSR SR475 READ 07970CSR 77 GOTO END203 07980CSR 56 Z-ADD0 COUNT 07990CSR 38 GOTO T203A LIST INSTR 08000CSR MOVE 'N' PAG,P DELETE INSTR 08010CSR GOTO T203A ÐÐ08020C*------------------------------------------------------------------- 08030CSR END203 TAG 08040CSR 40 EXSR SR400 UPDATE DXMAST 08050CSR 41 EXSR SR404 UPDATE DXPTR 08060CSRN36 EXSR SR502 LFCR 08070CSR ENDSR 08080C******************************************************************** 08090CSR SR204 BEGSR 08100C* LIST TEXT. 08110CSR SETON 38 08120CSR EXSR SR203 08130CSR SETOF 38 08140CSR ENDSR 08150C******************************************************************** 08160CSR SR206 BEGSR 08170C* RESEQUENCE TEXT. 08180C* UPDATE PREV GETS. 08190CSR SETON 3936 08200CSR 40 EXSR SR401 UPDATE DXMAST 08210CSR 41 EXSR SR404 UPDATE DXPTR 08220C* CHECK AVAIL SPACE FOR RESEQ RECORDS. 08230CSR MOVE NAME DXTNAM 8 SAVE TEXT NAME 08240CSR MOVE NAME FRNAME 08250CSR Z-ADDSTART COPYTO 08260CSR EXSR SR922 CHECK SPACE ÐÐ08270CSR 58 GOTO END206 NO SPACE 08280C*------------------------------------------------------------------- 08290C* GENERATE FUNKY DXMAST FOR DUMMY COPY ROUTINE. 08300CSR MOVE BLK8 NAME 08310CSR MOVELPORT NAME FUNKY TEXT NAME 08320CSR MOVE 'FUNKY' NAME UNIQUE CHAR 08330CSR EXSR SR616 MOVE NAME TO KEY 08340CSR EXSR SR400 GET FUNKY MAST 08350C* IF FUNKY MAST NOT ON FILE, ADD TO FILE. 08360CSR 60 Z-ADD0 BLK 08370CSR 60 EXSR SR401 UPD FUNKY MAST 08380CSR 60 EXSR SR400 GET FUNKY MAST 08390CSR MOVE TNAME FUNKY 8 SAVE FUNKY KEY 08400C*------------------------------------------------------------------- 08410C* COPY REAL TEXT TO FUNKY TEXT. 08420CSR MOVE DXTNAM FRNAME REAL TEXT KEY 08430CSR Z-ADDSTART COPYTO 08440CSR EXSR SR208 COPY DXT TO FUNKY DXT08450C*------------------------------------------------------------------- 08460C* DELETE COPIED LINES FROM REAL TEXT. 08470CSR MOVE DXTNAM NAME 08480CSR EXSR SR616 NAME TO KEY 08490CSR EXSR SR400 GET REAL MAST 08500CSR EXSR SR203 DELETE REAL TEXT 08510C*------------------------------------------------------------------- ÐÐ08520C* COPY FUNKY TEXT TO REAL TEXT. 08530CSR SETOF 36 08540CSR MOVE FUNKY FRNAME FUNKY KEY 08550CSR Z-ADD9999 ENDLIN ADJUSTED END-LINE 08560CSR MOVE DXTNAM NAME REAL KEY 08570CSR EXSR SR616 NAME TO KEY 08580CSR EXSR SR208 COPY FUNKY TO REAL 08590C*------------------------------------------------------------------- 08600C* DELETE FUNKY TEXT. 08610CSR SETON 36 08620CSR MOVE FUNKY NAME 08630CSR EXSR SR616 NAME TO KEY 08640CSR EXSR SR400 GET DXMAST 08650CSR Z-ADD9999 ENDLIN 08660CSR EXSR SR203 DELETE FUNKY TEXT 08670CSR 40 EXSR SR401 UPDATE DXMAST 08680CSR 41 EXSR SR404 UPDATE DXPTR 08690CSR MOVE DXTNAM NAME REAL KEY 08700CSR EXSR SR616 MOVE NAME TO KEY 08710CSR EXSR SR400 GET TEXT BACK 08720C*------------------------------------------------------------------- 08730CSR END206 TAG 08740CSR SETOF 3936 08750CSR ENDSR 08760C******************************************************************** ÐÐ08770CSR SR208 BEGSR 08780C* COPY TEXT 08790CSR 44 08800COR 40 EXSR SR401 UPDATE DXMAST 08810CSR 41 EXSR SR404 UPDATE DXPTR 08820CSRN39 EXSR SR922 VERIFY REC SPACE 08830CSR 58 GOTO END208 NOT ENOUGH ROOM 08840CSR MOVE FRNAME TNAME COPY FROM NAME 08850CSR EXSR SR400 GET CPY FR MAST 08860CSR SETOF 4044 08870CSR SETOF 43 08880CSR START SUB 1 LINENO 08890CSR Z-ADD0 SAVCPY 30 08900CSR Z-ADD0 SAVES 30 08910CSR Z-ADD0 CPYRRN 70 08920C*-------------------------------------------------------------------- 08930CSR T208A TAG 08940C* GET/SAVE COPY FROM PTRS 08950CSR 1 ADD LINENO LINENO 08960CSR EXSR SR613 CHK LINE# 08970CSR 54 GOTO T208D BEYOND LIMIT 08980CSR EXSR SR300 CONVERT LINE,B,P 08990CSR EXSR SR612 CHK BLK# 09000CSRN54 EXSR SR610 ADVANCE LINENO 09010CSRN54 GOTO T208A GET NEXT BLOCK ÐÐ09020CSR EXSR SR412 GET DXPTR 09030CSR EXSR SR618 P=Y COMP 09040CSR SETOF 56 09050CSRN54 SETON 56 09060CSR 56 EXSR SR601 FIND NEXT 'Y' 09070CSR 56N55 Z-ADD100 P 09080CSR 56 EXSR SR302 CALC NEW LINE# 09090CSR 56N55 GOTO T208A GET NEXT LINE 09100CSR EXSR SR301 CALC RRN 09110CSR 43 GOTO T208C DXCOPY ACTIVE 09120C*------------------------------------------------------------------ 09130CSR T208B TAG 09140C* GET DXCOPY RECORD 09150CSR 1 ADD CPYRRN CPYRRN 09160CSR EXSR SR409 GET DXCOPY 09170CSR TCPORT COMP 0 54 09180CSRN54 GOTO T208B WRONG PORT # 09190CSR Z-ADD0 CPY 09200CSR Z-ADDPORT TCPORT 09210CSR Z-ADD0 S 30 09220C*----------------------------------------------------------------- 09230CSR T208C TAG 09240C* COPY PTRS TO DXCOPY RECORD 09250CSR 1 ADD S S 09260CSR S COMP SLIMIT 54 ÐÐ09270CSR 54 GOTO T208B BEYOND LIMIT 09280CSR Z-ADDRRN CPY,S SAVE RRN 09290CSR GOTO T208A GET NXT CPY LINE 09300C*------------------------------------------------------------------ 09310CSR T208D TAG 09320C* USE SAVED PTRS TO COPY TEXT 09330CSR 43 EXSR SR410 UPDATE DXCOPY 09340CSR Z-ADDCPYRRN SAVCPY 30 09350CSR COPYTO SUB INCRMT LINENO 09360CSR 40 09370COR 44 EXSR SR401 UPDATE DXMAST 09380CSR EXSR SR616 NAME TO KEY 09390CSR EXSR SR400 GET DXMAST 09400CSR Z-ADD0 CPYRRN 09410C*------------------------------------------------------------------ 09420CSR T208E TAG 09430CSR 1 ADD CPYRRN CPYRRN 09440CSR CPYRRN COMP SAVCPY 54 09450CSR 54 GOTO END208 DONE 09460CSR TCPORT COMP PORT 54 09470CSRN54 GOTO T208E WRONG PORT# 09480CSR Z-ADD1 S 09490C*--------------------------------------------------------------- 09500CSR T208F TAG 09510CSR ZERO7 LOKUPCPY,S 54 ÐÐ09520CSRN54 GOTO T208E GET NXT DXCOPY 09530CSR Z-ADDCPY,S RRN 70 09540CSR EXSR SR405 GET DXFILE REC 09550CSR MOVEAREC FROM 09560CSR MOVE DXTYPE TYPE 09570CSR MOVE DXLINE HLINE 09580CSR MOVE DXSPAC SPACE 09590CSR Z-ADD0 TCPORT 09600CSR Z-ADD0 CPY,S 09610C*-------------------------------------------------------------- 09620CSR T208G TAG 09630C* GET COPY-TO RECORD 09640CSR EXSR SR615 INCRMT + LINENO 09650CSR EXSR SR614 CHECK LINE LIMIT 09660CSR 54 GOTO T208J ABORT COPY 09670CSR EXSR SR300 CALC B,P 09680CSR EXSR SR612 CHK BLK# 09690CSRN54 EXSR SR703 GET NEW BLK# 09700CSR EXSR SR412 GET DXPTR 09710C*--------------------------------------------------------------- 09720CSR T208H TAG 09730CSR EXSR SR618 P=Y COMP 09740CSR 54 GOTO T208J ABORT COPY 09750CSR MOVE 'Y' PAG,P 09760CSR EXSR SR301 CALC RRN ÐÐ09770CSR EXSR SR405 GET DXFILE 09780CSR MOVEAFROM REC 09790CSR EXSR SR406 UPDATE DXFILE 09800CSRN36 EXSR SR502 LFCR 09810CSRN36 EXSR SR74 DISPLAY TEXT 09820CSR GOTO T208F GET NEXT PTR 09830C*--------------------------------------------------------------- 09840CSR T208J TAG 09850C* FLAG COPY ABORTED-- NO ROOM 09860CSR Z-ADD475 M 09870CSR EXSR SR455 FLAG ERROR 09880C*-------------------------------------------------------------- 09890CSR T208K TAG 09900C* INIT UNUSED PTRS 09910CSR Z-ADD0 CPY 09920CSR Z-ADD0 TCPORT 09930CSR EXSR SR410 UPDATE DXCOPY 09940C*------------------------------------------------------------- 09950CSR T208L TAG 09960CSR 1 ADD CPYRRN CPYRRN 09970CSR CPYRRN COMP SAVCPY 54 09980CSR 54 GOTO END208 09990CSR TCPORT COMP PORT 54 10000CSRN54 GOTO T208L WRONG PORT 10010CSR GOTO T208K INIT ÐÐ10020C*-------------------------------------------------------------- 10030CSR END208 TAG 10040C* END COPY/RESEQ ROUTINE 10050CSR 41 EXSR SR404 UPDATE DXPTR 10060CSR 43 EXSR SR410 UPDATE DXCOPY 10070CSR 40 10080COR 44 EXSR SR401 UPDATE DXMAST 10090CSR EXSR SR616 NAME TO KEY 10100CSR EXSR SR400 GET DXMAST 10110CSR ENDSR 10120C****************************************************************** 10130CSR SR209 BEGSR 10140C* UPDATE TAB - STOPS 10150CSR EXSR SR502 LFCR 10160CSR MOVEABAT REC 10170CSR EXSR SR74 PUT EXIST TABS 10180CSR Z-ADD474 M 10190CSR EXSR SR452 PROMPT 10200CSR 92 GOTO SR209 REPEAT ESC 10210CSR 90 GOTO END209 10220CSR EXSR SR708 MOVE DATA 10230CSR MOVEABUFIN BAT 10240CSR END209 ENDSR 10250C******************************************************************** 10260CSR SR300 BEGSR ÐÐ10270C* CALCULATE BLK INDEX (B) AND PAG INDEX (P) FROM LINE #. 10280CSR .01 MULT LINENO W5D2 52 10290CSR MOVELW5D2 B 30 10300CSR MOVE W5D2 W2N 20 10310CSR Z-ADDW2N P 30 54 10320CSRN54 B SUB 1 B 10330CSRN54 Z-ADD100 P 10340CSR 1 ADD B B 10350CSR ENDSR 10360C******************************************************************** 10370CSR SR301 BEGSR 10380C* CALC RRN FROM BLOCK # AND PAG INDEX (P). 10390CSR Z-ADDBLK,B RRN 10400CSR 100 MULT RRN RRN RRN 10410CSR P ADD RRN RRN 10420CSR RRN SUB 100 RRN 10430CSR ENDSR 10440C******************************************************************** 10450CSR SR302 BEGSR 10460C* CALC LINE # FROM B AND P INDEX. 10470CSR 100 MULT B LINENO 10480CSR LINENO ADD P LINENO 10490CSR LINENO SUB 100 LINENO 10500CSR ENDSR 10510C******************************************************************** ÐÐ10520CSR SR303 BEGSR 10530C* COMPUTE B AND P FOR END LINE. 10540CSR Z-ADDENDLIN LINENO 50 10550CSR EXSR SR300 CALC B,P 10560CSR Z-ADDB BEND 30 10570CSR Z-ADDP PEND 30 10580CSR ENDSR 10590C******************************************************************** 10600CSR SR400 BEGSR 10610C* GET DXMAST FILE. 10620CSR MOVE ' ' TMSTAT 10630CSR 44 NEW ADD PENDING 10640COR 40 EXSR SR401 UPD PREV GET 10650CSR TNAME CHAINDXMAST 60 GET DXMAST 10660CSR 60 SETON 44 ADD FLAG 10670CSRN60 SETON 40 ACTIVE REL FLAG 10680CSR ENDSR 10690C******************************************************************** 10700CSR SR401 BEGSR 10710C* UPDATE DXMAST. 10720CSR SETON 80 10730CSR 40 ACTIVE GET 10740COR 44 EXCPT PREV NO HIT 10750CSR SETOF 804044 10760CSR ENDSR ÐÐ10770C******************************************************************** 10780CSR SR403 BEGSR 10790C* GET DXPTR FILE. 10800CSR 41 EXSR SR404 UPD PREV GET 10810CSR BLK,B CHAINDXPTR 60 GET DXPTR 10820CSRN60 SETON 41 ACT REC FLAG 10830CSR Z-ADDBLK,B LASTTP 30 10840CSR MOVE TNAME LASTTM 8 10850CSR ENDSR 10860C******************************************************************** 10870CSR SR404 BEGSR 10880C* UPDATE DXPTR FILE. 10890CSR SETON 81 10900CSR 41 EXCPT UPDATE DXPTR 10910CSR SETOF 8141 10920CSR ENDSR 10930C******************************************************************** 10940CSR SR405 BEGSR 10950C* GET DXFILE. 10960CSR RRN CHAINDXFILE 60 GET DXFILE 10970CSR ENDSR 10980C******************************************************************** 10990CSR SR406 BEGSR 11000C* UPDATE DXFILE. 11010CSR SETON 82 ÐÐ11020CSR EXCPT UPDATE DXFILE 11030CSR SETOF 82 11040CSR ENDSR 11050C******************************************************************** 11060CSR SR407 BEGSR 11070C* GET DXAVAIL. 11080CSR 42 EXSR SR408 UPDATE DXAVAIL 11090CSR Z-ADD1 W5N 11100CSR W5N CHAINDXAVAIL H4 11110CSRNH4 SETON 42 11120CSR ENDSR 11130C******************************************************************** 11140CSR SR408 BEGSR 11150C* UPDATE DXAVAIL FILE. 11160CSR SETON 83 11170CSR 42 EXCPT UPDATE DXAVAIL 11180CSR SETOF 8342 11190CSR ENDSR 11200C******************************************************************** 11210CSR SR409 BEGSR 11220C* GET DXCOPY FILE. 11230CSR 43 EXSR SR410 UPD PREV GET 11240CSR CPYRRN CHAINDXCOPY 60 GET DXCOPY 11250CSRN60 SETON 43 ACT REC FLAG 11260CSR ENDSR ÐÐ11270C******************************************************************** 11280CSR SR410 BEGSR 11290C* UPDATE DXCOPY FILE. 11300CSR SETON 84 11310CSR 43 EXCPT UPDATE DXCOPY 11320CSR SETOF 8443 11330CSR ENDSR 11340C******************************************************************** 11350CSR SR411 BEGSR 11360C* GET MESSAGE MAST. 11370CSR M CHAINMGFILE 54 11380CSR 54 MOVE BLK96 MGTEXT 11390CSR 54 MOVEL'NO-MSG' MGTEXT 11400CSR ENDSR 11410C******************************************************************** 11420CSR SR412 BEGSR 11430C* GET DXPTR. 11440CSR 41 BLK,B COMP LASTTP 54 11450CSR 41 54 TNAME COMP LASTTM 54 11460CSR 41N54 11470CORN41 EXSR SR403 GET DXPTR 11480CSR ENDSR 11490C******************************************************************** 11500CSR SR450 BEGSR 11510C* PROMPT, LINE-120, CURSOR AT COL-37 - OPTIONAL INPUT. ÐÐ11511CSR EXSR SR603 INIT CRT 11520CSR SETON 34 11530CSR EXSR SR411 GET MGFILE 11540CSR EXSR SR71 PROMPT 11550CSR EXSR SR600 INIT BUFIN 11560CSR EXSR SR475 READ 11570CSR SETOF 34 11580CSR ENDSR 11590C******************************************************************** 11600CSR SR451 BEGSR 11610C* PROMPT, LINE-120, CURSOR AT COL-37 - MANDATORY INPUT. 11620CSR EXSR SR450 PROMPT/READ 11630CSR 77 11640COR 90 GOTO END451 11650CSR Z-ADDM SAVEM 50 11660CSR Z-ADD435 M 11670CSR EXSR SR455 FLAG ERROR 11680CSR Z-ADDSAVEM M 11690CSR GOTO SR451 11700CSR END451 ENDSR 11710C******************************************************************** 11720CSR SR452 BEGSR 11730C* PROMPT, LINE-118. 11740CSR MOVE BIT,1 ARA 11750CSR EXSR SR453 INIT PROMPT ÐÐ11760CSR SETON 35 11770CSR EXSR SR476 READ 11780CSR SETOF 35 11790CSR ENDSR 11800C******************************************************************** 11810CSR SR453 BEGSR 11820C* PUT MSG AT CURRENT LINE. 11830CSR EXSR SR411 GET MGFILE 11840CSR EXSR SR603 INIT CRT 11850CSR MOVEAMGTEXT CRT 11860CSR EXSR SR72 LFCR/PROMPT/LFCR 11870CSR ENDSR 11880C******************************************************************** 11890CSR SR454 BEGSR 11900C* SPACE BEFORE PRINT (SR201). 11910CSR SPACE COMP '1' 54 11920CSR 54 EXSR SR502 LFCR 11930CSR SPACE COMP '2' 54 11940CSR 54 EXSR SR502 LFCR 11950CSR SPACE COMP '3' 54 11960CSR 54 EXSR SR502 LFCR 11970CSR SPACE COMP 'S' 54 11980CSR 54 EXSR SR502 LFCR 11990CSR 54 EXSR SR502 LFCR 12000CSR 54 EXSR SR502 LFCR ÐÐ12010CSR 54 EXSR SR502 LFCR 12020CSR ENDSR 12030C******************************************************************** 12040CSR SR455 BEGSR 12050C* PUT ERR MESSAGE 12060CSR MOVE BIT,8 BELL 1 12070CSR EXSR SR411 GET MGFILE 12080CSR EXSR SR73 PUT MSG 12090CSR MOVE ' ' BELL 12100CSR ENDSR 12110C******************************************************************** 12120CSR SR456 BEGSR 12130C* SPACE BEFORE PRINT (SR203). 12140CSR MOVE DXSPAC SPACE 12150CSR EXSR SR454 12160CSR ENDSR 12170C******************************************************************** 12180CSR SR475 BEGSR 12190C* READ CRT - BASIC UTILITY SR. 12200CSR EXSR SR102 SETOFFS 12210CSR MOVE ' ' RETCOD 2 RETURN CODE 12220CSR EXITFQBELL RING BELL 12230CSR EXITFQR96 R READ 12240CSR RLABL BUFIN BUFFER 12250CSR RLABL BUFLGT BUF LGTH ÐÐ12260CSR RLABL RETCOD RET CODE 12270CSRN37 MOVEABUFIN A96 INPUT DATA 12280CSR 37 Z-ADDCURCOL W 12290CSR 37 MOVEABUFIN A96,W 12300CSR RETCOD COMP '03' 91 FLAG LF/TAB 12310CSR 91 EXSR SR503 BUMP CURSOR UP 12320CSR Z-ADD1 W 30 12330CSR BIT,32 LOKUPA96,W 54 FIND INPUT 12340CSRN54 GOTO END475 12350CSR A96,W COMP '\' 90 12360CSRN90 GOTO T475B 12370CSR 1 ADD W W 12380CSR W COMP 96 54 12390CSR 54 GOTO T475A BAD ESC 12400CSR A96,W COMP 'B' 94 BKWD TAB 12410CSR A96,W COMP 'N' 96 NEW ITEM 12420CSR A96,W COMP 'R' 92 REPEAT 12430CSR A96,W COMP 'E' 98 SYST-MENU 12440CSR A96,W COMP 'M' 97 LOCAL-MENU 12450CSR A96,W COMP 'G' 99 GOODBY 12460CSR A96,W COMP 'D' 93 DONE 12470CSR 92 12480COR 93 12490COR 94 12500COR 94 ÐÐ12510COR 96 12520COR 97 12530COR 98 12540COR 99 GOTO END475 GOOD ESC 12550C*------------------------------------------------------------------- 12560CSR T475A TAG 12570C* FLAG BAD ESCAPE. 12580CSR Z-ADD318 M 12590CSR EXSR SR455 FLAG ERROR 12600CSR GOTO SR475 TRY AGAIN 12610C*------------------------------------------------------------------- 12620CSR T475B TAG 12630CSR SETON 77 12640CSR 37 GOTO END475 12650CSR 77 EXSR SR600 INIT BUFIN 12660CSR 77 MOVEAA96,W BUFIN 12670C*----------------------------------------------------------------- 12680CSR END475 TAG 12690CSR ENDSR 12700C******************************************************************** 12710CSR SR476 BEGSR 12720C* READ CRT (TEXT ADD ONLY) 12730CSR SETOF 3231 12740CSR SETON 37 ADD TRAN FLAG 12750CSR EXSR SR501 CR-ONLY ÐÐ12760CSR MOVEAARA BUFIN 96 12770CSR Z-ADD1 CURCOL 30 12780C*------------------------------------------------------------------- 12790CSR T476B TAG 12800C* READ CRT 12810CSR Z-ADDCURCOL OLDCUR 30 12820CSR EXSR SR475 READ CRT 12830CSR 91 SETON 32 12840CSR 94 SETOF 90 12850CSR 94 GOTO T476F 12860CSR 90 GOTO END476 ESCAPE,NOT BKW TAB 12870CSRN77N91N31 SETON 9093 DEFAULT DONE 12880CSRN77N91 GOTO END476 12890CSR Z-ADDCURCOL W 12900C*------------------------------------------------------------------ 12910CSR T476C TAG 12920C* MOVE INPUT DATA TO RECORD 12930CSR BIT,32 LOKUPA96,W 54 12940CSRN54 GOTO T476D 12950CSR SETON 31 ACTIVITY FLAG 12960CSR MOVE A96,W REC,W 12970CSR MOVE BIT,1 A96,W 12980CSR Z-ADDW CURCOL 12990CSR GOTO T476C 13000C*------------------------------------------------------------------ ÐÐ13010CSR T476D TAG 13020C* MOVE CURSOR TO NEXT TAB POSITION 13030CSRN91 GOTO END476 NO LF(TAB) 13040CSR 1 ADD CURCOL CURCOL 13050CSR Z-ADDCURCOL W 13060CSR W COMP 96 54 13070CSRN54 'X' LOKUPBAT,W 55 FIND TAB STOP 13080CSR 54 13090CORN54N55 Z-ADD96 W 13100CSR GOTO T476G 13110C*------------------------------------------------------------------ 13120CSR T476F TAG 13130C* DO BACKWARD TAB 13140CSR Z-ADDOLDCUR W 13150CSR 77 GOTO T476G 13160C*--------------------------------------------------------------- 13170CSR T476FA TAG 13180CSR W SUB 1 W 54 13190CSRN54 Z-ADD1 W 13200CSR Z-ADDW CURCOL 13210CSRN54 GOTO T476G 13220CSR BAT,W COMP 'X' 54 13230CSRN54 GOTO T476FA 13240C*----------------------------------------------------------------- 13250CSR T476G TAG ÐÐ13260CSRN35 EXSR SR74 PUT CRT 13270CSR Z-ADDW CURCOL 13280CSR MOVEAARA BUFIN 13290CSR 1 ADD W W3N 13300CSR MOVE W3N W6A 6 13310CSRN32 MOVEL'120' W6A 13320CSR 32 MOVEL'119' W6A 13330CSR EXSR SR500 POSITION CURSOR 13340CSR GOTO T476B DO NEXT READ 13350C*------------------------------------------------------------------ 13360CSR END476 TAG 13370CSR SETOF 3731 13380CSR ENDSR 13390C******************************************************************** 13400CSR SR500 BEGSR 13410C* MOVE CURSOR. 13420CSR EXITFQXYPOS MOVE CURSOR 13430CSR RLABL W6A 13440CSR ENDSR 13450C******************************************************************** 13460CSR SR501 BEGSR 13470C* CAR-RETURN (ONLY). 13480CSR EXITFQCCR CAR-RETURN 13490CSR ENDSR 13500C******************************************************************** ÐÐ13510CSR SR502 BEGSR 13520C* CR/LF. 13530CSR EXITFQCLFCR LF/CR 13540CSR ENDSR 13550C********************************************************************* 13560CSR SR503 BEGSR 13570C* BUMP CURSOR UP 13580CSR EXITFQMOVUP BUMP CURSOR UP 13590CSR ENDSR 13600C****************************************************************** 13610CSR SR600 BEGSR 13620C* UTILITY INIT. 13630CSR MOVE BLK96 BUFIN 96 INIT BUFIN 13640CSR ENDSR 13650C****************************************************************** 13660CSR SR601 BEGSR 13670C* FIND NEXT ACTIVE LINE 13680CSR 'Y' LOKUPPAG,P 55 13690CSR ENDSR 13700C***************************************************************** 13710CSR SR602 BEGSR 13720C* COMPUTE ENDING LINE # (COPY/RESEQ SR922,SR920) 13730CSR INCRMT MULT ACTUAL REQD 50 13740CSR REQD SUB INCRMT REQD 13750CSR COPYTO ADD REQD REQD ÐÐ13760CSR ENDSR 13770C******************************************************************** 13780CSR SR603 BEGSR 13790CSR MOVE ' ' CRT 13800CSR ENDSR 13810C******************************************************************** 13820CSR SR604 BEGSR 13830C* CHECK FOR CONTROL-D. 13840CSR MOVE ' ' W2A 2 13850CSR EXITFQSTOP 13860CSR RLABL W2A 13870CSR W2A COMP 'XX' 54 13880CSR ENDSR 13890C***************************************************************** 13900CSR SR605 BEGSR 13910C* INIT W60A. 13920CSR MOVE BLK96 W60A INIT W60A 13930CSR MOVE W60A W15A 13940CSR ENDSR 13950C******************************************************************** 13960CSR SR606 BEGSR 13970CSR X COMP 96 54 13980CSR ENDSR 13990C******************************************************************** 14000CSR SR607 BEGSR ÐÐ14010CSR BIT,32 LOKUPFROM,X 54 14020CSR ENDSR 14030C******************************************************************** 14040CSR SR610 BEGSR 14050C* RESET LINENO TO START AT NEXT INDEX-B BLOCK. 14060CSR 100 SUB P W5N 50 14070CSR W5N ADD LINENO LINENO 14080CSR ENDSR 14090C******************************************************************** 14100CSR SR611 BEGSR 14110C* EDIT 5-DIGIT NUMB. 14120CSR MOVE 'Z' W1A 1 14130CSR Z-ADD5 W2N 20 14140CSR MOVE ' ' W5A 5 14150CSR EXIT SUBRED EDIT ROUTINE 14160CSR RLABL W5N SOURCE 14170CSR RLABL W1A EDIT CODE 14180CSR RLABL W5A RESULT 14190CSR RLABL W2N END POS 14200CSR ENDSR 14210C****************************************************************** 14220CSR SR612 BEGSR 14230C* CHECK FOR ACTIVE BLOCK 14240CSR BLK,B COMP 0 54 14250CSR ENDSR ÐÐ14260C**************************************************************** 14270CSR SR613 BEGSR 14280C* FLAG PAST END LINE LIMIT 14290CSR LINENO COMP ENDLIN 54 14300CSR ENDSR 14310C**************************************************************** 14320CSR SR614 BEGSR 14330C* CHECK LINE# TO LINE LIMIT 14340CSR LINENO COMP LLIMIT 54 CHK LINE LIMIT 14350CSR ENDSR 14360C******************************************************************** 14370CSR SR615 BEGSR 14380CSR INCRMT ADD LINENO LINENO 50 14390CSR ENDSR 14400C******************************************************************** 14410CSR SR616 BEGSR 14420CSR MOVE NAME TNAME 8 14430CSR ENDSR 14440C******************************************************************** 14450CSR SR617 BEGSR 14460CSR MOVE W5A W15A 14470CSR EXSR SR619 W15A L W60A 14480CSR ENDSR 14490C******************************************************************** 14500CSR SR618 BEGSR ÐÐ14510CSR PAG,P COMP 'Y' 54 14520CSR ENDSR 14530C***************************************************************** 14540CSR SR619 BEGSR 14550CSR MOVELW15A W60A 14560CSR ENDSR 14570C******************************************************************** 14580CSR SR701 BEGSR 14590C* R. ADJUST. 14600CSR MOVELBUFIN W10A 10 14610CSR Z-ADD10 W2N 20 14620CSR EXIT SUBRAJ R. ADJUST 14630CSR RLABL W2N 14640CSR RLABL W10A 14650CSR ENDSR 14660C******************************************************************** 14670CSR SR702 BEGSR 14680C* CHECK CONTROL-D INPUT. 14690CSR MOVE ' ' W2A 2 14700CSR EXITFQSTOP 14710CSR RLABL W2A 14720CSR W2A COMP 'XX' 54 54 14730CSR ENDSR 14740C******************************************************************** 14750CSR SR703 BEGSR ÐÐ14760C* GET NEXT AVAIL BLOCK. 14770CSR EXSR SR407 GET DXAVAIL 14780CSR 'N' LOKUPNAB,N 54 14790CSRN54 GOTO T703Z NONE FOUND 14800C*--------------------------------------------------------------- 14810CSR T703A TAG 14820CSR Z-ADDN BLK,B NEW BLK # 14830CSR MOVE 'Y' NAB,N 14840CSR GOTO END703 14850C*--------------------------------------------------------------- 14860CSR T703Z TAG 14870C* TRY AGAIN FROM FRONT OF ARRAY 14880CSR Z-ADD1 N 30 14890CSR 'N' LOKUPNAB,N 54 14900CSR 54 GOTO T703A GOT ONE 14910C* FLAG FILE FULL ERROR 14920CSR Z-ADD470 M 14930CSR EXSR SR455 FLAG ERROR 14940C*------------------------------------------------------------- 14950CSR END703 TAG 14960CSR EXSR SR408 UPDATE DXAVAIL 14970CSR 40 14980COR 44 EXSR SR400 UPDATE DXMAST 14990CSR ENDSR 15000C******************************************************************** ÐÐ15010CSR SR704 BEGSR 15020C* STORE DELETED BLOCK #. 15030CSR EXSR SR407 GET DXAVAIL 15040CSR Z-ADDBLK,B Y 30 15050CSR MOVE 'N' NAB,Y 15060CSR EXSR SR403 GET DELETED DXPTR 15070CSR MOVE 'N' PAG 15080CSR EXSR SR404 UPDATE DXPTR 15090CSR Z-ADD0 BLK,B 15100C*------------------------------------------------------------- 15110CSR END704 TAG 15120CSR EXSR SR408 UPDATE DXAVAIL 15130CSR 40 15140COR 44 EXSR SR400 UPDATE DXMAST 15150CSR ENDSR 15160C****************************************************************** 15170CSR SR707 BEGSR 15180C* CLASSIFY INSTRUCTION. 15190CSR INSTR COMP 'G' 55 GET 15200CSR INSTR COMP 'A' 56 ADD 15210CSR INSTR COMP 'D' 57 DELETE 15220CSR INSTR COMP 'L' 58 LIST 15230CSR INSTR COMP 'R' 59 REPLACE 15240CSR INSTR COMP 'S' 60 RESEQ 15250CSR INSTR COMP 'F' 61 FIND ÐÐ15260CSR INSTR COMP 'C' 62 COPY 15270CSR INSTR COMP 'T' 63 SET-TAB 15280CSR ENDSR 15290C*************************************************************** 15300CSR SR708 BEGSR 15310C* MOVE SIGNIFICANT INPUT DATA 15320CSR MOVE BIT,1 CRT 15330CSR Z-ADD1 X 15340C*------------------------------------------------------------- 15350CSR T708A TAG 15360CSR BIT,32 LOKUPREC,X 54 15370CSRN54 GOTO END708 15380CSR REC,X COMP '!' 54 15390CSR 54 MOVE ' ' CRT,X 15400CSRN54 MOVE REC,X CRT,X 15410CSR 1 ADD X X 15420CSR EXSR SR606 COMP 96 15430CSRN54 GOTO T708A 15440C*---------------------------------------------------------- 15450CSR END708 TAG 15460CSR MOVEACRT BUFIN 15470CSR ENDSR 15480C******************************************************************** 15490CSR SR903 BEGSR 15500C* PAUSE. ÐÐ15510CSR EXITFQPAUSE PAUSE 15520CSR ENDSR 15530C******************************************************************** 15540CSR SR920 BEGSR 15550C* SEARCH TEXT. 15560CSR START SUB 1 LINENO 15570CSR SETOF 59 15580C*------------------------------------------------------------------- 15590CSR T920A TAG 15600CSR EXSR SR604 CHK CONTROL-D 15610CSR 54 GOTO END920 15620CSR 1 ADD LINENO LINENO 15630CSR EXSR SR613 CHK LIMIT 15640CSR 54 GOTO T920F PAST LIMIT 15650CSR EXSR SR300 CALC B,P 15660CSR EXSR SR612 CHK BLK # 15670CSRN54 EXSR SR610 ADVANCE LINE # 15680CSRN54 GOTO T920A 15690CSR EXSR SR412 GET DXPTR 15700CSR 'Y' LOKUPPAG,P 54 15710CSRN54 GOTO T920E NO LINES 15720CSR EXSR SR302 CALC LINENO 15730CSR EXSR SR613 CHECK LIMIT 15740CSR 54 GOTO T920F PAST LIMIT 15750CSR EXSR SR301 CALC RRN ÐÐ15760CSR EXSR SR405 GET DXFILE 15770CSR SOPTON COMP 'C' 54 SEARCH OPTION 15780CSR 54 GOTO T920B BY COL 15790CSR EXSR SR926 NOT BY COL 15800CSR 58 SETON 59 MATCH FLAG 15810CSR 58 GOTO T920C GOT ONE 15820CSR GOTO T920A NO HIT 15830C*------------------------------------------------------------------- 15840CSR T920B TAG 15850CSR EXSR SR927 SEARCH BY COL 15860CSRN58 GOTO T920A NO HIT 15870CSR SETON 59 15880C*------------------------------------------------------------------- 15890CSR T920C TAG 15900CSR INSTR COMP 'F' 54 CHK INSTRUCT 15910CSR 54 GOTO T920D FIND INSTR 15920CSR EXSR SR928 REPLACE INSTR 15930CSR EXSR SR406 UPDATE DXFILE 15940C*------------------------------------------------------------------- 15950CSR T920D TAG 15960CSR EXSR SR502 LFCR 15970CSR EXSR SR74 DISPLAY 15980CSR GOTO T920A 15990C*------------------------------------------------------------------- 16000CSR T920E TAG ÐÐ16010CSR Z-ADD100 P ADVANCE LINE 16020CSR EXSR SR302 CALC LINE # 16030CSR GOTO T920A 16040C*------------------------------------------------------------------- 16050CSR T920F TAG 16060C* IF NO HITS, DISPLAY MSG. 16070CSRN59 Z-ADD476 M 16080CSRN59 EXSR SR455 16090CSR END920 ENDSR 16100C******************************************************************** 16110CSR SR922 BEGSR 16120C* VERIFY THAT ENOUGH SPACE EXISTS FOR COPY/RESEQ. 16130CSR 44 16140COR 40 EXSR SR401 UPDATE DXMAST 16150CSR 41 EXSR SR404 UPDATE DXPTR 16160C*------------------------------------------------------------------- 16170CSR T922A TAG 16180C* COUNT LINES TO BE RESEQ/COPIED. 16190CSR MOVE FRNAME TNAME 16200CSR EXSR SR400 GET DXMAST 16210CSR SETOF 4044 16220CSR EXSR SR923 COUNT LINES REQD 16230C*--------------------------------------------------------------- 16240CSR T922B TAG 16250C* VERIFY LINES AVAIL. ÐÐ16260CSR EXSR SR616 NAME TO KEY 16270CSR EXSR SR400 GET COPY-TO MAST 16280CSR SETOF 4044 16290CSR EXSR SR924 COUNT LINES AVAIL 16300CSRN58 GOTO END922 SPACE OK 16310C*-------------------------------------------------------------- 16320CSR T922C TAG 16330CSR SETOF 58 16340CSR EXSR SR602 CALC LINES REQD 16350CSR REQD COMP LINENO 54 54 16360CSRN54 GOTO END922 SPACE OK 16370CSR 54 39 EXSR SR613 CHK ENDLIN(RESEQ) 16380CSR 54 INCRMT SUB 1 INCRMT 54 16390CSR 54 GOTO T922C 16400CSR Z-ADD475 M 16410CSR EXSR SR455 FLAG ERROR 16420CSR SETON 58 16430C*-------------------------------------------------------------- 16440CSR END922 TAG 16450CSR 40 16460COR 44 EXSR SR401 UPDATE DXMAST 16470CSR EXSR SR616 NAME TO KEY 16480CSR EXSR SR400 GET DXMAST 16490CSR ENDSR 16500C******************************************************************** ÐÐ16510CSR SR923 BEGSR 16520C* COUNT LINES TO BE RESEQ. 16530CSR START SUB 1 LINENO 16540CSR Z-ADD0 ACTUAL 16550C*------------------------------------------------------------------- 16560CSR T923A TAG 16570CSR 1 ADD LINENO LINENO 16580CSR EXSR SR613 CHK ENDLIN 16590CSR 54 GOTO END923 16600CSR EXSR SR300 CALC B,P 16610CSR EXSR SR612 CHK BLK # 16620CSRN54 EXSR SR610 ADVANCE LINENO 16630CSRN54 GOTO T923A 16640CSR EXSR SR412 GET DXPTR 16650CSR EXSR SR618 P=Y COMP 16660CSRN54 GOTO T923A NO LINE 16670CSR 1 ADD ACTUAL ACTUAL 50 COPY LINE 16680CSR GOTO T923A 16690CSR END923 ENDSR 16700C******************************************************************** 16710CSR SR924 BEGSR 16720C* CHK AVAIL SPACE. 16730CSR Z-ADD0 AVAIL 50 16740CSR EXSR SR602 CALC LINES REQD 16750CSR Z-ADDCOPYTO LINENO ÐÐ16760CSR LINENO SUB 1 LINENO 16770C*------------------------------------------------------------------- 16780CSR T924A TAG 16790CSR 1 ADD LINENO LINENO 16800CSR EXSR SR614 CHECK LINE LIMIT 16810CSR 54 GOTO END924 16820CSR EXSR SR300 CALC B,P 16830CSR EXSR SR612 CHK BLK# 16840CSRN54 EXSR SR610 ADVANCE LINENO 16850CSRN54 W5N ADD AVAIL AVAIL 16860CSRN54 AVAIL COMP REQD 55 55 16870CSRN54 55 GOTO END924 SPACE OK 16880CSRN54 GOTO T924A 16890CSR EXSR SR412 GET DXPTR 16900CSR EXSR SR618 P=Y COMP 16910CSR 54 GOTO T924C ACTIVE LINE 16920CSR 1 ADD AVAIL AVAIL 16930CSR LINENO COMP REQD 54 54 16940CSR 54 GOTO END924 HAVE ENOUGH LINES 16950CSR GOTO T924A GET NEXT LINE 16960C*--------------------------------------------------------------- 16970CSR T924C TAG 16980C* SEE IF ACTIVE LINE IS WITHIN CRITICAL AREA 16990CSR REQD COMP LINENO 54 54 17000CSR 54 39 EXSR SR613 CHK ENDLIN(RESEQ) ÐÐ17010CSRN54 1 ADD AVAIL AVAIL 17020CSRN54 GOTO T924A GET NEXT LINE 17030CSR SETON 58 OVERFLOW FLAG 17040CSR END924 ENDSR 17050C******************************************************************** 17060CSR SR926 BEGSR 17070C* GLOBAL SEARCH. 17080CSR SETOF 58 17090CSR Z-ADD0 LX 30 17100CSR Z-ADD1 X 17110CSR Z-ADD1 A 30 17120CSR EXSR SR607 LOKUP 17130CSRN54 GOTO T926C MATCH 17140CSR FROM,X LOKUPREC,A 54 17150CSRN54 GOTO END926 NO MATCH 17160CSR Z-ADDA FA 30 17170CSR Z-ADDX FX 30 17180C*------------------------------------------------------------------- 17190CSR T926A TAG 17200CSR Z-ADDFX X 17210C*------------------------------------------------------------------- 17220CSR T926B TAG 17230CSR Z-ADDX LX 30 17240CSR 1 ADD X X 17250CSR EXSR SR606 COMP 96 ÐÐ17260CSR 54 GOTO T926C MATCHED 17270CSR EXSR SR607 LOKUP 17280CSRN54 GOTO T926C MATCHED 17290CSR X SUB LX W3N 30 NUMB ADVANCED 17300CSR W3N ADD A A +A SAME AS X 17310CSR A COMP 96 54 17320CSR 54 GOTO END926 17330CSR REC,A COMP FROM,X 54 17340CSR 54 GOTO T926B GET NEXT MATCH 17350C* 'A' NOT MATCHED. START AGAIN. 17360CSR 1 ADD FA FA 17370CSR Z-ADDFA A 17380CSR Z-ADDFX X 17390CSR FROM,X LOKUPREC,A 54 17400CSRN54 GOTO END926 17410CSR GOTO T926B 17420C*------------------------------------------------------------------- 17430CSR T926C TAG 17440CSR SETON 58 17450CSR END926 ENDSR 17460C******************************************************************** 17470CSR SR927 BEGSR 17480C* MATCH TEXT RECORD, BY COL. 17490CSR SETOF 58 17500CSR Z-ADD1 X ÐÐ17510C*------------------------------------------------------------------- 17520CSR T927A TAG 17530CSR EXSR SR607 LOKUP 17540CSRN54 SETON 58 17550CSRN54 GOTO END927 17560CSR REC,X COMP FROM,X 54 17570CSRN54 GOTO END927 17580CSR 1 ADD X X 17590CSR EXSR SR606 COMP 96 17600CSRN54 GOTO T927A 17610CSR SETON 58 17620CSR END927 ENDSR 17630C******************************************************************** 17640CSR SR928 BEGSR 17650C* REPLACE MATCHED DATA (SEE SR920). 17660CSR SOPTON COMP 'C' 54 17670CSR 54 GOTO T928B COLUMN OPTION 17680C* REPLACE FOR GLOBAL OPTION. 17690CSR SETOF 56 17700CSR Z-ADD1 X 17710CSR Z-ADDFA A 17720CSR Z-ADD0 FX 17730C*---------------------------------------------------------------- 17740CSR T928A TAG 17750CSR BIT,32 LOKUPTOR,X 54 ÐÐ17760CSRN54 GOTO END928 17770CSR 56 X SUB FX W3N 17780CSR 56 W3N ADD A A 17790CSR A COMP 96 54 17800CSR 54 GOTO END928 17810CSR SETON 56 17820CSR MOVE TOR,X REC,A 17830CSR Z-ADDX FX 17840CSR 1 ADD X X 17850CSR EXSR SR606 COMP 96 17860CSR 54 GOTO END928 17870CSR GOTO T928A 17880C*------------------------------------------------------------------- 17890CSR T928B TAG 17900C* REPLACE FOR COLUMN OPTION. 17910CSR Z-ADD0 X 17920C*------------------------------------------------------------------- 17930CSR T928C TAG 17940CSR 1 ADD X X 17950CSR EXSR SR606 COMP 96 17960CSR 54 GOTO END928 17970CSR BIT,32 LOKUPTOR,X 54 17980CSRN54 GOTO END928 17990CSR MOVE TOR,X REC,X 18000CSR GOTO T928C ÐÐ18010CSR END928 ENDSR 18020O******************************************************************** 18030ODXMAST EADD 80 44 18040O TNAME 8 18050O TITLE 68 18060O MTYPE 69 18070O BLK 287P 18080O TMSTAT 288 18090O*------------------------------------------------------------------- 18100O E 80N44 40 18110O TITLE 68 18120O MTYPE 69 18130O BLK 287P 18140O TMSTAT 288 18150O******************************************************************** 18160ODXPTR E 81 18170O PAG 100 18180O******************************************************************** 18190ODXFILE E 82 18200O REC 96 18210O TYPE 133 18220O HLINE 134 18230O TYPE 135 18240O******************************************************************** 18250ODXAVAIL E 83 ÐÐ18260O NAB 200 18270O*************************************************************** 18280ODXCOPY E 84 18290O TCPORT 2 18300O CPY 402P 18310O**************************************************************** ** ALT A B C D E F G L M N R S T \ Y 018320ALTSEQ C12FC262C363C464C565C666C767D325D43BD53ED972E273E3745F20E879 018330** A96 ARRAY 018340 018350** FROM ARRAY 018360 018370** TOR ARRAY 018380 018390** BAT ARRAY 018400 018410** CRT ARRAY 018420 018430** ARA 018440 018450** ARB 018460 018470/* 018480_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(б ÐBX100RX P120282120282(èÈÐ00010H S Q100RX00020F* 60 - COL ROUTING TEXT UPDATE. (X100RX) 00030F* REVISED 8/27/80 3:50 PM. 00040FBITHEX IP F 256 DISK 00050FSXMAST UC F 314R12AI 1 DISK A 00060FSXPTR UC F 10R DISK 00070FSXFILE UC F 63R DISK 00080FSXAVAIL UC F 2000R DISK 00090FSXCOPY UC F 302R DISK 00100FMGFILE IC F 80R DISK 00110FCRT800 IC F 800R DISK 00120E******************************************************************** 00130E A60 1 60 1 A 00140E FROM 1 60 1 A 00150E TOR 1 60 1 A 00160E BAT 1 60 1 00170E CRT 1 65 1 00180E ARA 1 60 1 WORK ARRAY 00190E ARB 1 60 1 WORK ARRAY 00200E A3 3 3 1 WORK ARRAY 00210E BIT 256 1 00220E REC 60 1 A 00230E BLK 100 5 0A 00240E PAG 10 1 A 00250E NAB 2000 1 ÐÐ00260E CPY 100 5 0A 00270I******************************************************************** 00280IBITHEX BT 00290I 1 256 BIT 00300I******************************************************************** 00310IMGFILE MG 00320I 1 60 MGTEXT 00330I******************************************************************** 00340ISXMAST TM 00350I* TEXT MASTER. 00360I* SALES ORDER/ITEM/SUB (6/3/3 A) 00370I 1 12 TMKEY 00380I* TEXT TYPE 1A 00390I 13 13 TMTYPE 00400I* PTR BLOCKS ASSIGNED 5P X 100 00410I P 14 313 BLK 00420I* RECORD STATUS 1A 00430I 314 314 TMSTAT 00440I******************************************************************** 00450ISXPTR TP 00460I* TEXT POINTER FILE. 00470I* REL RECORD STATUS 1A X 10 00480I* Y = RECORD ALLOCATED 00490I* N = RECORD NOT IN USE 00500I 1 10 PAG ÐÐ00510I******************************************************************** 00520ISXFILE SX 00530I* TEXT FILE. 00540I* TEXT DATA 1A X 60 00550I 1 60 REC 00560I* TEXT TYPE 1A 00570I* H = HEADING C = TABLE CONTENTS 00580I* T = TEXT X = INDEX 00590I* F = FOOTNOTE 00600I 61 61 SXTYPE 00610I* HEADING/FOOTNOTE LINE # 1N 00620I 62 620SXLINE 00630I* SPACE CODE 1A 00640I* 1-3 = SPACE LINES BEFORE PRINT 00650I* S = SKIP NEW PAGE 00660I 63 63 SXSPAC 00670I******************************************************************** 00680ISXAVAIL TA 00690I* TEXT AVAIL FILE (UNUSED BLOCKS) 00700I* AVAIL BLOCKS 1A X 200 00710I* 'N' = BLK IS AVAIL 00720I* 'Y' = BLK IS NOT AVAIL 00730I 12000 NAB 00740I******************************************************************** 00750ISXCOPY TC ÐÐ00760I* TEXT COPY WORK FILE 00770I* TERMINAL NUMBER 2N 00780I 1 20TCPORT 00790I* COPY PTR ARRAY 5P X 100 00800I P 3 302 CPY 00810I************************************************************* 00820ICRT800 CR 00830I* SALES ORDER(6A)/ITEM(3N)/SUB(3N) 00840I 1 6 CRORD 00850I 477 4790CRITEM 00860I 480 4820CRSUB 00870I 773 778 CRRET 00880C******************************************************************** 00890C* INITIALIZE 1-TIME. 00900C EXSR SR101 INIT 00910C*------------------------------------------------------------------- 00920C START TAG 00930C* PUT MENU. 00940C EXSR SR102 SETOFFS 00950C EXSR SR103 PUT MENU 00960C*------------------------------------------------------------------- 00970C TAG5 TAG 00980C* REQUEST SELECTION AND BRANCH 00990C EXSR SR616 MOV NAME TO KEY 01000C 40 ÐÐ01010COR 44 EXSR SR400 UPD/GET SXMAST 01020C 41 EXSR SR404 UPDATE SXPTR 01030C EXSR SR102 SETOFFS 01040C 78 EXSR SR104 RQST SELECTION 01050C 94 GOTO START ESC BKWD 01060C 90 GOTO ESCAPE ESC OTHER 01070C N40N63N44 MOVE 'G' INSTR 01080C N40N63N44 GOTO TAG10 FORCE GET 01090C 55 GOTO TAG10 GET 01100C 56 GOTO TAG20 ADD 01110C 57 GOTO TAG30 DELETE 01120C 58 GOTO TAG40 LIST 01130C 59 GOTO TAG50 REPLACE 01140C 60 GOTO TAG60 SEQ 01150C 61 GOTO TAG70 FIND 01160C 62 GOTO TAG80 COPY 01170C 63 GOTO TAG90 TAB-SET 01180C 64 GOTO TAG100 MOVE TEXT 01190C Z-ADD241 M 50 01200C EXSR SR455 FLAG ERROR 01210C GOTO TAG5 01220C*------------------------------------------------------------------- 01230C TAG10 TAG 01240C* GET TEXT. 01250C SETON 78 ÐÐ01260C EXSR SR105 RQST NAME 01270C 90 GOTO ESCAPE 01280C*------------------------------------------------------------------- 01290C TAG12 TAG 01300C*********** EXSR SR107 RQST TYPE 01310C 94 GOTO TAG10 01320C 90 GOTO ESCAPE 01330C EXSR SR616 NAME TO KEY 01340C EXSR SR400 GET SXMAST 01350C GOTO TAG5 01360C*------------------------------------------------------------------- 01370C TAG20 TAG 01380C* ADD TEXT. 01390C EXSR SR108 RQST START 01400C 90 GOTO ESCAPE 01410C*------------------------------------------------------------------- 01420C TAG21 TAG 01430C EXSR SR110 RQST INCREMENT 01440C 94 GOTO TAG20 01450C 90 GOTO ESCAPE 01460C EXSR SR117 RQST LINE OPTION 01470C 94 GOTO TAG21 01480C 90 GOTO ESCAPE 01490C EXSR SR201 ADD TEXT 01500C 90 GOTO ESCAPE ÐÐ01510C GOTO TAG5 01520C*------------------------------------------------------------------- 01530C TAG30 TAG 01540C* DELETE TEXT. 01550C EXSR SR108 RQST START 01560C 90 GOTO ESCAPE 01570C*------------------------------------------------------------------- 01580C TAG31 TAG 01590C EXSR SR109 RQST END 01600C 94 GOTO TAG30 01610C 90 GOTO ESCAPE 01620C EXSR SR203 DELETE TEXT 01630C 90 GOTO ESCAPE 01640C GOTO TAG5 01650C*------------------------------------------------------------------- 01660C TAG40 TAG 01670C* LIST TEXT. 01680C EXSR SR108 RQST START 01690C 90 GOTO ESCAPE 01700C*------------------------------------------------------------------- 01710C TAG41 TAG 01720C EXSR SR109 REQUEST END 01730C 94 GOTO TAG40 01740C 90 GOTO ESCAPE 01750C EXSR SR204 LIST TEXT ÐÐ01760C 90 GOTO ESCAPE 01770C GOTO TAG5 01780C*------------------------------------------------------------------- 01790C TAG50 TAG 01800C* REPLACE TEXT. 01810C EXSR SR108 RQST START 01820C 90 GOTO ESCAPE 01830C*---------------------------------------------------------------- 01840C TAG51 TAG 01850C EXSR SR109 RQST END 01860C 94 GOTO TAG50 01870C 90 GOTO ESCAPE 01880C*------------------------------------------------------------------- 01890C TAG52 TAG 01900C EXSR SR111 RQST SEARCH OPTION 01910C 94 GOTO TAG51 01920C 90 GOTO ESCAPE 01930C*------------------------------------------------------------------- 01940C TAG53 TAG 01950C EXSR SR112 RQST FROM DATA 01960C 94 GOTO TAG52 01970C 90 GOTO ESCAPE 01980C*------------------------------------------------------------------- 01990C TAG54 TAG 02000C EXSR SR113 RQST CHG-TO DATA ÐÐ02010C 94 GOTO TAG53 02020C 90 GOTO ESCAPE 02030C EXSR SR920 REPLACE TEXT 02040C 90 GOTO ESCAPE 02050C GOTO TAG5 02060C*------------------------------------------------------------------- 02070C TAG60 TAG 02080C* RESEQ TEXT. 02090C EXSR SR108 RQST START 02100C 90 GOTO ESCAPE 02110C*------------------------------------------------------------------- 02120C TAG61 TAG 02130C EXSR SR109 RQST END 02140C 94 GOTO TAG60 02150C 90 GOTO ESCAPE 02160C*------------------------------------------------------------------- 02170C TAG62 TAG 02180C EXSR SR110 RQST INCREMENT 02190C 94 GOTO TAG61 02200C 90 GOTO ESCAPE 02210C EXSR SR206 RESEQ TEXT 02220C 90 GOTO ESCAPE 02230C GOTO TAG5 02240C*------------------------------------------------------------------- 02250C TAG70 TAG ÐÐ02260C* SEARCH TEXT. 02270C EXSR SR108 RQST START 02280C 90 GOTO ESCAPE 02290C*------------------------------------------------------------------- 02300C TAG71 TAG 02310C EXSR SR109 RQST END 02320C 94 GOTO TAG70 02330C 90 GOTO ESCAPE 02340C*------------------------------------------------------------------- 02350C TAG72 TAG 02360C EXSR SR111 RQST SEARCH OPTION 02370C 94 GOTO TAG71 02380C 90 GOTO ESCAPE 02390C*------------------------------------------------------------------- 02400C TAG73 TAG 02410C EXSR SR112 RQST SEARCH DATA 02420C 94 GOTO TAG72 02430C 90 GOTO ESCAPE 02440C EXSR SR920 SEARCH TEXT 02450C 90 GOTO ESCAPE 02460C GOTO TAG5 02470C*------------------------------------------------------------------- 02480C TAG80 TAG 02490C* COPY TEXT. 02500C EXSR SR114 RQST COPY FROM NAME ÐÐ02510C 90 GOTO ESCAPE 02520C*------------------------------------------------------------------- 02530C TAG81 TAG 02540C EXSR SR108 RQST START 02550C 94 GOTO TAG80 02560C 90 GOTO ESCAPE 02570C*------------------------------------------------------------------- 02580C TAG82 TAG 02590C EXSR SR109 RQST END 02600C 94 GOTO TAG81 02610C 90 GOTO ESCAPE 02620C*------------------------------------------------------------------- 02630C TAG83 TAG 02640C EXSR SR115 RQST COPY-TO LINE 02650C 94 GOTO TAG82 02660C 90 GOTO ESCAPE 02670C EXSR SR110 RQST INCREMENT 02680C 94 GOTO TAG83 02690C 90 GOTO ESCAPE 02700C EXSR SR208 COPY TEXT 02710C 90 GOTO ESCAPE 02720C GOTO TAG5 02730C*------------------------------------------------------------------- 02740C TAG90 TAG 02750C* SET-TAB STOPS. ÐÐ02760C EXSR SR209 SET-TABS. 02770C 90 GOTO ESCAPE 02780C GOTO TAG5 02790C*------------------------------------------------------------------- 02800C TAG100 TAG 02810C* MOVE TEXT. 02820C EXSR SR108 RQST START LINE 02830C 90 GOTO ESCAPE 02840C*------------------------------------------------------------------- 02850C TAG102 TAG 02860C EXSR SR109 RQST END LINE 02870C 94 GOTO TAG100 02880C 90 GOTO ESCAPE 02890C*------------------------------------------------------------------- 02900C TAG104 TAG 02910C EXSR SR118 RQST FROM COL 02920C 94 GOTO TAG102 02930C 90 GOTO ESCAPE 02940C*------------------------------------------------------------------- 02950C TAG106 TAG 02960C EXSR SR119 RQST TO COL 02970C 94 GOTO TAG104 02980C 90 GOTO ESCAPE 02990C EXSR SR205 MOVE DATA 03000C 90 GOTO ESCAPE ÐÐ03010C GOTO TAG5 03020C*------------------------------------------------------------------- 03030C ESCAPE TAG 03040C 96 GOTO MENU 03050C 97 GOTO START 03060C 98 GOTO MENU 03070C 99 GOTO GOODBY 03080C GOTO TAG5 03090C*------------------------------------------------------------------- 03100C MENU TAG 03110C MOVELCRRET PROG 8 03120C GOTO END 03130C*------------------------------------------------------------------- 03140C GOODBY TAG 03150C MOVEL'GOODBY' PROG 03160C*------------------------------------------------------------------- 03170C END TAG 03180C 44 03190COR 40 EXSR SR401 UPD SXMAST 03200C 41 EXSR SR404 UPD SXPTR 03210C EXSR SR408 UPD SXAVAIL 03220C EXITFCHAIN 03230C RLABL PROG 03240C*------------------------------------------------------------- 03250C ENDJOB TAG ÐÐ03260C******************************************************************** 03270C* ESCAPE INDICATORS. 03280C* 90 GENERAL 95 BACKWARD-SKIP 03290C* 91 LINE-FEED (TAB) 96 NEW ITEM 03300C* 92 REPEAT 97 LOCAL MENU 03310C* 93 DONE 98 SYSTEM MENU 03320C* 94 BACKWARD-TAB 99 GOODBY 03330C******************************************************************** 03340CSR SR70 BEGSR 03350C* PUT LINE TO CRT. 03360CSR MOVEACRT BUFOUT 70 03370CSR 20 MOVE TYPE A3,1 03380CSR 20 MOVE HLINE A3,2 03390CSR 20 MOVE SPACE A3,3 03400CSR 20 MOVEAA3 W3A 3 03410CSR 20 MOVE W3A BUFOUT 03420CSRN20 MOVE ' ' BUFOUT 03430CSRN33N30 EXSR SR501 CR-ONLY 03440CSR EXITFQW70 PUT CRT 03450CSR RLABL BUFOUT 03460CSR SETOF 33 03470CSR ENDSR 03480C******************************************************************** 03490CSR SR71 BEGSR 03500C* PROMPT - CURSOR 120,37. ÐÐ03510CSR MOVEAMGTEXT CRT,1 03520CSR MOVEAW60A CRT,45 03530CSRN33 EXSR SR502 LFCR 03540CSR EXSR SR70 PUT 03550CSR MOVE '120037' W6A 03560CSR EXSR SR500 POSITION CURSOR 03570CSR ENDSR 03580C******************************************************************** 03590CSR SR72 BEGSR 03600C* PROMPT - 03610CSR EXSR SR603 INIT CRT ARRAY 03620CSR MOVEAMGTEXT CRT,1 03630CSR EXSR SR502 LFCR 03640CSR EXSR SR70 PUT 03650CSR EXSR SR502 LFCR 03660CSR ENDSR 03670C******************************************************************** 03680CSR SR73 BEGSR 03690C* ERR MSG - 03700CSR EXSR SR603 INIT CRT 03710CSR MOVEAMGTEXT CRT,1 03720CSR EXSR SR502 LFCR 03730CSR EXSR SR70 PUT 03740CSR ENDSR 03750C******************************************************************** ÐÐ03760CSR SR74 BEGSR 03770C* PUT TEXT LINE. 03780CSR MOVEAREC CRT 03790CSR Z-ADDLINENO W5N 50 03800CSR EXSR SR611 Z-EDIT 03810CSR MOVE W5A W4A 4 03820CSR MOVEAW4A CRT,61 03830CSR SETON 20 03840CSR EXSR SR70 PUT CRT 03850CSR SETOF 20 03860CSR ENDSR 03870C******************************************************************** 03880CSR SR101 BEGSR 03890C* 1-TIME INIT. 03900CSR Z-ADD1 N 30 03910CSR Z-ADD999 LLIMIT 50 LINE LIMIT 03920CSR Z-ADD20000 RLIMIT 50 RECORD LIMIT 03930CSR Z-ADD99 BLIMIT 30 BLK LIMIT 03940CSR Z-ADD99 SLIMIT 50 SXRESEQ LIMIT 03950CSR Z-ADD10 PLIMIT 30 PAG LIMIT 03960CSR MOVELBIT,1 BUFLGT 2 READ BUF LGTH 03970CSR MOVE BIT,61 BUFLGT 03980CSR MOVE ' ' W8A 8 03990CSR Z-ADD0 W2N 20 04000CSR Z-ADD0 W1N 10 ÐÐ04010CSR MOVE ' ' W2A 2 04020CSR EXITFPGMINX GET PORT # 04030CSR RLABL W8A 04040CSR RLABL W2N 04050CSR RLABL W1N 04060CSR RLABL W2A 04070CSR MOVE W2A PORT 20 04080CSR PORT COMP 0 54 04090CSRN54 Z-ADD25 PORT 04100CSR PORT CHAINCRT800 H9 04110CSR H9 GOTO END101 PROG ERROR 04120CSR MOVELCRORD CRKEY 04130CSR MOVELCRITEM W6A 04140CSR MOVE CRSUB W6A 04150CSR MOVE W6A CRKEY 12 04160CSR Z-ADD1 N 30 04170CSR MOVE ' ' BLK60 60 04180CSR MOVE ' ' BLK12 12 04190CSR Z-ADD0 ZERO3 30 04200CSR Z-ADD0 ZERO5 50 04210CSR MOVE ' ' BAT 04220C* SET TAB STOPS AT EVERY COL ON CRT. 04230CSR Z-ADD1 X 04240CSR MOVELBIT,28 W2A 2 04250CSR MOVE '1' W2A ÐÐ04260CSR MOVELW2A W3A 3 04270CSR MOVE ' ' W3A 04280C*------------------------------------------------------------------- 04290CSR T101 TAG 04300CSR MOVEAW3A CRT,X 04310CSR 3 ADD X X 04320CSR EXSR SR606 COMP 60 04330CSRN54 GOTO T101 04340CSR SETON 30 04350CSR EXSR SR502 04360CSR EXSR SR70 04370CSR EXSR SR70 04380CSR EXSR SR70 04390CSR SETOF 30 04400C* SET TAB DEFAULT. 04410CSR Z-ADD0 X 30 04420CSR Z-ADD234 A 04430CSR MOVE BIT,A BAT 04440CSR MOVE 'X' BAT,1 04450C*---------------------------------------------------------- 04460CSR T101A TAG 04470CSR 10 ADD X X 04480CSR MOVE 'X' BAT,X 04490CSR X COMP 50 54 04500CSRN54 GOTO T101A ÐÐ04510CSR END101 ENDSR 04520C******************************************************************** 04530CSR SR102 BEGSR 04540C* SET-OFF HEAVY INDICATORS. 04550CSR SETOF 779091 04560CSR SETOF 929394 04570CSR SETOF 959697 04580CSR SETOF 9899 04590CSR ENDSR 04600C******************************************************************** 04610CSR SR103 BEGSR 04620C* PUT MENU. 04630CSR Z-ADD437 M 50 04640CSR Z-ADD0 X 30 04650CSR Z-ADD0 COUNT 30 04660CSR MOVE '120001' W6A 6 04670CSR EXSR SR500 POSITION CUROSR 04680C*------------------------------------------------------------------- 04690CSR T103A TAG 04700CSR EXSR SR411 GET MESSAGE 04710CSR EXSR SR73 PUT MSG 04720C*--------------------------------------------------------------- 04730CSR T103B TAG 04740CSR 1 ADD M M 04750CSR M COMP 441 54 ÐÐ04760CSR 54 GOTO T103B 04770CSR 1 ADD X X 30 04780CSR X COMP 8 54 04790CSRN54 GOTO T103A 04800CSR ENDSR 04810C******************************************************************** 04820CSR SR104 BEGSR 04830C* REQUEST SELECTION. 04840CSR SETON 78 04850CSR Z-ADD454 M 04860CSR EXSR SR605 INIT W60A 04870CSR EXSR SR451 PROMPT/READ 04880CSR 90 GOTO END104 04890CSR MOVELBUFIN INSTR 1 INSTRUCTION 04900CSR EXSR SR707 CLASSIFY INSTR 04910CSR END104 ENDSR 04920C******************************************************************** 04930CSR SR105 BEGSR 04940C* GET TEXT MASTER 04950CSR EXSR SR605 INIT W60A 04960CSR MOVELCRKEY NAME 12 04970CSR EXSR SR616 NAME TO KEY 04980CSR EXSR SR400 GET SXMAST 04990CSR 60 MOVE ' ' TMTYPE 05000CSR 60 MOVE 'A' TMSTAT ÐÐ05010CSR 60 Z-ADD0 BLK 05020CSRN60 MOVE TMTYPE MTYPE 1 05030CSR END105 ENDSR 05040C******************************************************************** 05050CSR SR107 BEGSR 05060C* REQUEST MASTER TYPE. 05070CSR Z-ADD461 M 05080CSR EXSR SR605 CLEAR W60A 05090CSR MOVE MTYPE W15A 05100CSR EXSR SR619 W15A L W60A 05110CSR EXSR SR450 PROMPT/READ 05120CSR MOVELBUFIN W1A TEXT TYPE 05130CSR W1A COMP ' ' 54 05140CSR 54N90 MOVE W1A MTYPE 05150CSR ENDSR 05160C******************************************************************** 05170CSR SR108 BEGSR 05180C* REQUEST START LINE NO. 05190CSR Z-ADD156 M 05200CSR EXSR SR605 CLEAR W60A 05210CSR Z-ADDSTART W5N 50 05220CSR EXSR SR611 EDIT-Z 05230CSR EXSR SR617 W5A TO W60A 05240CSR EXSR SR451 PROMPT/READ 05250CSR 90 GOTO END108 ÐÐ05260CSR 77 EXSR SR701 R. ADJUST 05270CSR 77 MOVE W10A START 50 05280CSR START COMP 0 54 05290CSR 54 START COMP LLIMIT 5454 05300CSR 54 GOTO END108 05310CSR Z-ADD467 M 05320CSR EXSR SR455 FLAG ERROR 05330CSR GOTO SR108 05340CSR END108 ENDSR 05350C******************************************************************** 05360CSR SR109 BEGSR 05370C* REQUEST END LINE #. 05380CSR Z-ADD0 ENDLIN 05390CSR Z-ADD157 M 05400CSR EXSR SR605 CLEAR W60A 05410CSR Z-ADDENDLIN W5N 05420CSR EXSR SR611 EDIT-Z 05430CSR EXSR SR617 W5A TO W60A 05440CSR EXSR SR450 PROMPT/READ 05450CSR 90 GOTO END109 05460CSR 77 EXSR SR701 R. ADJUST 05470CSR 77 MOVE W10A ENDLIN 50 END LINE # 05480CSR ENDLIN COMP 0 54 05490CSR 54 GOTO T109A 05500CSR EXSR SR707 ÐÐ05510CSR 57 05520COR 59 05530COR 60 05540COR 62 Z-ADDSTART ENDLIN DEFAULT 05550CSR 58 05560COR 61 Z-ADDLLIMIT ENDLIN DEFAULT 05570C*------------------------------------------------------------------- 05580CSR T109A TAG 05590CSR ENDLIN COMP START 55 55 05600CSR 55 ENDLIN COMP LLIMIT 5555 05610CSRN55 Z-ADD243 M 05620CSRN55 EXSR SR455 FLAG ERROR 05630CSRN55 GOTO SR109 05640CSR END109 ENDSR 05650C******************************************************************** 05660CSR SR110 BEGSR 05670C* REQUEST INCREMENT. 05680CSR Z-ADD455 M 05690CSR EXSR SR605 INIT W60A 05700CSR Z-ADDINCRMT W5N 05710CSR EXSR SR611 EDIT-Z 05720CSR EXSR SR617 W5A TO W60A 05730CSR EXSR SR450 PROMPT/READ 05740CSR 90 GOTO END110 05750CSR 77 EXSR SR701 R. ADJUST ÐÐ05760CSR 77 MOVE W10A INCRMT 30 INCREMENT 05770CSR INCRMT COMP 0 54 05780CSRN54 Z-ADD1 INCRMT 05790CSR END110 ENDSR 05800C******************************************************************** 05810CSR SR111 BEGSR 05820C* REQUEST SEARCH OPTION. 05830CSR Z-ADD468 M 05840CSR EXSR SR605 INIT W60A 05850CSR MOVE SOPTON W15A 05860CSR EXSR SR619 W15A L W60A 05870CSR EXSR SR450 PROMPT/READ 05880CSR 90 GOTO END111 05890CSR 77 MOVELBUFIN SOPTON 1 SEARCH OPTION 05900CSR SOPTON COMP ' ' 54 05910CSRN54 SOPTON COMP 'C' 54 05920C*------------------------------------------------------------------- 05930CSR END111 TAG 05940CSR ENDSR 05950C******************************************************************** 05960CSR SR112 BEGSR 05970C* REQUEST SEARCH DATA. 05980CSR Z-ADD456 M 05990CSR MOVE BIT,1 REC 06000CSR EXSR SR452 PROMPT/READ ÐÐ06010CSR 92 GOTO SR112 REPEAT ESC 06020CSR 90 GOTO END112 06030CSR EXSR SR708 MOVE INPUT DATA 06040CSR MOVEABUFIN FROM SEARCH DATA 06050CSR BIT,32 LOKUPFROM 54 06060CSR 54 GOTO END112 INPUT WAS MADE 06070CSR Z-ADD469 M 06080CSR EXSR SR455 FLAG ERROR 06090CSR GOTO SR112 06100CSR END112 ENDSR 06110C******************************************************************** 06120CSR SR113 BEGSR 06130C* REQUEST CHANGE-TO DATA. 06140CSR MOVE BIT,1 REC 06150CSR Z-ADD471 M 06160CSR EXSR SR452 PUT MSG 06170CSR 92 GOTO SR113 REPEAT ESC 06180CSR 90 GOTO END113 OTHER ESC 06190CSR EXSR SR708 MOVE INPUT DATA 06200CSR MOVEABUFIN TOR CHANGE-TO DATA 06210CSR BIT,32 LOKUPTOR 54 06220CSR 54 GOTO END113 INPUT WAS MADE 06230CSR Z-ADD469 M 06240CSR EXSR SR455 FLAG ERROR 06250CSR GOTO SR113 ÐÐ06260CSR END113 ENDSR 06270C******************************************************************** 06280CSR SR114 BEGSR 06290C* REQUEST COPY-FROM TEXT NAME. 06300CSR EXSR SR605 INIT W60A 06310CSR EXSR SR619 W15A L W60A 06320CSR Z-ADD458 M 06330CSR EXSR SR451 PROMPT/READ 06340CSR 90 GOTO END114 06350CSR 77 MOVELBUFIN FRNAME 12 06360CSR 44 06370COR 40 EXSR SR401 UPDATE SXMAST 06380CSR MOVE FRNAME TNAME 12 COPY-FROM NAME 06390CSR EXSR SR400 GET FROM MAST 06400CSR SETOF 4044 06410CSRN60 GOTO T114A GOT IT 06420CSR Z-ADD5 M 06430CSR EXSR SR455 FLAG ERROR 06440CSR GOTO SR114 06450C*------------------------------------------------------------------- 06460CSR T114A TAG 06470CSR EXSR SR616 NAME TO KEY 06480CSR EXSR SR400 CUT CUR MAST 06490CSR END114 ENDSR 06500C******************************************************************** ÐÐ06510CSR SR115 BEGSR 06520C* REQUEST COPY-TO LINE. 06530CSR EXSR SR605 INIT W60A 06540CSR Z-ADDCOPYTO W5N 06550CSR EXSR SR611 EDIT-Z 06560CSR EXSR SR617 W5A TO W60A 06570CSR Z-ADD459 M 06580CSR EXSR SR451 PROMPT/READ 06590CSR 90 GOTO END115 06600CSR 77 EXSR SR701 R. ADJUST 06610CSR 77 MOVE W10A COPYTO 50 COPY-TO LINE# 06620CSR COPYTO COMP 0 54 06630CSR 54 COPYTO COMP LLIMIT 5454 06640CSR 54 GOTO END115 06650CSR Z-ADD277 M 06660CSR EXSR SR455 FLAG ERROR 06670CSR GOTO SR115 06680CSR END115 ENDSR 06690C******************************************************************** 06700CSR SR116 BEGSR 06710C* REQUEST LINE CONTROL DATA. 06720CSR EXSR SR605 INIT W60A 06730CSR MOVE TYPE W15A 06740CSR EXSR SR619 W15A L W60A 06750CSR Z-ADD472 M ÐÐ06760CSR SETON 33 SUPPRESS LF 06770CSR EXSR SR458 PROMPT/READ 06780CSR 90 GOTO END116 06790CSR 77 MOVELBUFIN TYPE 1 TEXT TYPE 06800C*------------------------------------------------------------------- 06810CSR T116A TAG 06820CSR TYPE COMP 'H' 54 FLAG HEADING 06830CSRN54 TYPE COMP 'F' 54 FLAG FOOTNOTE 06840CSRN54 Z-ADD0 HLINE 06850CSRN54 GOTO T116B 06860CSR EXSR SR605 INIT W60A 06870CSR Z-ADDHLINE W5N 06880CSR EXSR SR611 EDIT-Z 06890CSR EXSR SR619 W5A TO W60A 06900CSR Z-ADD81 M 06910CSR SETON 33 06920CSR EXSR SR458 PROMPT/READ 06930CSR 94 GOTO SR116 BKWD-SKIP 06940CSR 90 GOTO END116 06950CSR 77 MOVELBUFIN HLINE 10 HDG LINE # 06960C*------------------------------------------------------------------- 06970CSR T116B TAG 06980CSR TYPE COMP 'F' 54 FLAG FOOTNOTE 06990CSR 54 MOVE ' ' SPACE 07000CSR 54 GOTO END116 ÐÐ07010CSR EXSR SR605 INIT W60A 07020CSR MOVE SPACE W15A 07030CSR EXSR SR619 W15A L W60A 07040CSR Z-ADD113 M 07050CSR SETON 33 07060CSR EXSR SR458 PROMPT/READ 07070CSR 94 GOTO T116A BKWD-SKIP 07080CSR 90 GOTO END116 07090CSR 77 MOVELBUFIN SPACE 1 SPACE CODE 07100CSR END116 ENDSR 07110C******************************************************************** 07120CSR SR117 BEGSR 07130C* REQUEST LINE OPTION. 07140CSR EXSR SR605 INIT W60A 07150CSR MOVE LCNTRL W15A 07160CSR EXSR SR619 W15A L W60A 07170CSR Z-ADD473 M 07180CSR EXSR SR450 PROMPT/READ 07190CSR 90 GOTO END117 ESC 07200CSR 77 MOVELBUFIN LCNTRL 1 LINE CONTROL CODE 07210C*------------------------------------------------------------------- 07220CSR T117A TAG 07230CSR LCNTRL COMP 'Y' 54 07240CSRN54 LCNTRL COMP 'N' 54 07250CSRN54 LCNTRL COMP ' ' 55 ÐÐ07260CSRN54 55 MOVE 'N' LCNTRL 07270CSR 54 07280COR 55 GOTO END117 07290CSR Z-ADD385 M 07300CSR EXSR SR455 FLAG ERROR 07310CSR GOTO SR117 07320C*------------------------------------------------------------------- 07330CSR END117 ENDSR 07340C******************************************************************** 07350CSR SR118 BEGSR 07360C* REQUEST 'FROM' COL #. 07370CSR Z-ADD491 M 07380CSR EXSR SR605 CLEAR W60A 07390CSR Z-ADDCOLF W5N FROM COL # 07400CSR EXSR SR611 EDIT-Z 07410CSR EXSR SR617 W5A TO W60A 07420CSR EXSR SR451 PROMPT/READ 07430CSR 90 GOTO END118 ESCAPE 07440CSR 77 EXSR SR701 R. ADJUST 07450CSR 77 MOVE W10A COLF 50 FROM COL # 07460CSR COLF COMP 0 54 07470CSR 54 COLF COMP 60 5454 07480CSR 54 GOTO END118 COL # OK 07490CSR Z-ADD492 M 07500CSR EXSR SR455 FLAG ERROR ÐÐ07510CSR GOTO SR118 TRY AGAIN 07520CSR END118 ENDSR 07530C******************************************************************** 07540CSR SR119 BEGSR 07550C* REQUEST 'TO' COL #. 07560CSR Z-ADD493 M 07570CSR EXSR SR605 CLEAR W60A 07580CSR Z-ADDCOLT W5N TO COL # 07590CSR EXSR SR611 EDIT-Z 07600CSR EXSR SR617 W5A TO W60A 07610CSR EXSR SR451 PROMPT/READ 07620CSR 90 GOTO END119 ESCAPE 07630CSR 77 EXSR SR701 R. ADJUST 07640CSR 77 MOVE W10A COLT 50 TO COL # 07650CSR COLT COMP 0 54 07660CSR 54 GOTO END119 COL # OK 07670CSR Z-ADD492 M 07680CSR EXSR SR455 FLAG ERROR 07690CSR GOTO SR119 TRY AGAIN 07700CSR END119 ENDSR 07710C******************************************************************** 07720CSR SR201 BEGSR 07730C* ADD TEXT. 07740CSR MOVE BIT,1 ARA NULLS 07750CSR START SUB INCRMT LINENO 50 ÐÐ07760C*------------------------------------------------------------------- 07770CSR T201A TAG 07780CSR EXSR SR502 LFCR 07790CSR 90 GOTO END201 ESC 07800CSR EXSR SR615 INCRMT + LINENO 07810CSR EXSR SR614 CHK LINE LIMIT 07820CSR 54 GOTO T201T FILE FULL 07830CSR EXSR SR300 CALC B,P 07840CSR EXSR SR612 CHK BLK # 07850CSRN54 EXSR SR703 GET NEW BLOCK 07860CSR EXSR SR412 GET SXPTR 07870CSR EXSR SR301 CALC RRN 07880CSR EXSR SR405 GET SXFILE 07890CSR EXSR SR618 P=Y COMP 07900CSRN54 MOVEABLK60 REC 07910CSRN54 MOVE ' ' SXTYPE 07920CSRN54 Z-ADD0 SXLINE HDG LINE # 07930CSRN54 MOVE ' ' SXSPAC 07940CSR 54 MOVE SXTYPE TYPE 07950CSR 54 Z-ADDSXLINE HLINE 07960CSR 54 MOVE SXSPAC SPACE 07970C*-------------------------------------------------------------------- 07980CSR T201B TAG 07990CSR EXSR SR74 PUT TEXT CRT 08000CSR MOVEAREC ARB ÐÐ08010CSR EXSR SR476 READ 08020CSR 90 MOVEAARB REC 08030CSR EXSR SR74 PUT CRT 08040CSRN90 LCNTRL COMP 'Y' 54 08050CSR 54N90 EXSR SR116 08060CSR 92 GOTO T201B REPEAT ESC 08070CSR 90 GOTO END201 ESC 08080CSR EXSR SR406 UPDATE SXFILE 08090CSR MOVE 'Y' PAG,P 08100CSR GOTO T201A 08110C*------------------------------------------------------------------- 08120CSR T201T TAG 08130C* FLAG FULL FILE. 08140CSR Z-ADD470 M 08150CSR EXSR SR455 FLAG ERROR 08160C*------------------------------------------------------------------- 08170CSR END201 TAG 08180CSR 41 EXSR SR404 UPDATE SXPTR 08190CSR ENDSR 08200C******************************************************************** 08210CSR SR203 BEGSR 08220C* DELETE/LIST TEXT. 08230CSR EXSR SR600 INIT BUFIN 08240CSR Z-ADD0 COUNT 77 08250CSR START SUB 1 LINENO 50 ÐÐ08260CSRN36 EXSR SR502 LFCR 08270C*------------------------------------------------------------------- 08280CSR T203A TAG 08290CSR EXSR SR702 CHK CNTRL-D 08300CSR 54 GOTO END203 08310CSR 1 ADD LINENO LINENO INCRMT + LINENO 08320CSR EXSR SR613 CHK ENDLIN 08330CSR 54 GOTO END203 08340CSR EXSR SR300 CALC B,P 08350CSR EXSR SR612 CHK BLK # 08360CSRN54 EXSR SR610 ADVANCE LINENO 08370CSRN54 GOTO T203A NO BLK # 08380CSR EXSR SR412 GET SXPTR 08390CSR EXSR SR618 P=Y COMP 08400CSR 54 GOTO T203B ACTIVE LINE 08410CSR EXSR SR601 FIND NEXT 'Y' 08420CSR 55 EXSR SR302 CALC NEW LINE# 08430CSR 55 EXSR SR613 CHK ENDLIN 08440CSR 55 54 GOTO END203 PAST LIMIT 08450CSR 55 GOTO T203B GET NEXT LINE 08460CSR Z-ADD10 P 08470CSR EXSR SR302 CALC NEW LINE# 08480CSR GOTO T203A 08490C*------------------------------------------------------------------- 08500CSR T203B TAG ÐÐ08510CSR EXSR SR301 CALC RRN 08520CSR EXSR SR405 GET SXFILE 08530CSRN36 EXSR SR502 LFCR 08540CSRN36 EXSR SR456 SPACE 08550CSR 28 EXSR SR709 MOVE TEXT 08560CSRN36 MOVE SXTYPE TYPE 08570CSRN36 MOVE SXLINE HLINE 08580CSRN36 MOVE SXSPAC SPACE 08590CSRN36 EXSR SR74 PUT TEXT 08600CSRN38 GOTO T203C 08610CSR COUNT COMP 29 56 56 08620CSRN56 GOTO T203C 08630CSR Z-ADD34 M 08640CSR EXSR SR455 08650CSR EXSR SR600 INIT BUFIN 08660CSR EXSR SR475 READ 08670CSR 90 GOTO END203 08680CSR Z-ADD0 COUNT 08690C*------------------------------------------------------------------- 08700CSR T203C TAG 08710CSR 28 MOVE TEXT 08720COR 38 GOTO T203A LIST INSTR 08730CSR MOVE 'N' PAG,P DELETE INSTR 08740CSR 'Y' LOKUPPAG 54 08750CSRN54 EXSR SR704 FREE-UP BLK# ÐÐ08760CSR GOTO T203A 08770C*------------------------------------------------------------------- 08780CSR END203 TAG 08790CSR 40 EXSR SR400 UPDATE SXMAST 08800CSR 41 EXSR SR404 UPDATE SXPTR 08810CSRN36 EXSR SR502 LFCR 08820CSR ENDSR 08830C******************************************************************** 08840CSR SR204 BEGSR 08850C* LIST TEXT. 08860CSR SETON 38 08870CSR EXSR SR203 08880CSR SETOF 38 08890CSR ENDSR 08900C******************************************************************** 08910CSR SR205 BEGSR 08920C* MOVE TEXT. 08930CSR SETON 28 08940CSR EXSR SR203 MOVE TEXT 08950CSR SETOF 28 08960CSR ENDSR 08970C******************************************************************** 08980CSR SR206 BEGSR 08990C* RESEQUENCE TEXT. 09000C* UPDATE PREV GETS. ÐÐ09010CSR SETON 3936 09020CSR 40 EXSR SR401 UPDATE SXMAST 09030CSR 41 EXSR SR404 UPDATE SXPTR 09040C* CHECK AVAIL SPACE FOR RESEQ RECORDS. 09050CSR MOVE NAME SXTNAM 12 SAVE TEXT NAME 09060CSR MOVE NAME FRNAME 09070CSR Z-ADDSTART COPYTO 09080CSR EXSR SR922 CHECK SPACE 09090CSR 58 GOTO END206 NO SPACE 09100C*------------------------------------------------------------------- 09110C* GENERATE FUNKY SXMAST FOR DUMMY COPY ROUTINE. 09120CSR MOVE BLK12 NAME 09130CSR MOVELPORT NAME FUNKY TEXT NAME 09140CSR MOVE 'FUNKY' NAME UNIQUE CHAR 09150CSR EXSR SR616 MOVE NAME TO KEY 09160CSR EXSR SR400 GET FUNKY MAST 09170C* IF FUNKY MAST NOT ON FILE, ADD TO FILE. 09180CSR 60 Z-ADD0 BLK 09190CSR 60 EXSR SR401 UPD FUNKY MAST 09200CSR 60 EXSR SR400 GET FUNKY MAST 09210CSR MOVE TNAME FUNKY 12 SAVE FUNKY KEY 09220C*------------------------------------------------------------------- 09230C* COPY REAL TEXT TO FUNKY TEXT. 09240CSR MOVE SXTNAM FRNAME REAL TEXT KEY 09250CSR Z-ADDSTART COPYTO ÐÐ09260CSR EXSR SR208 COPY SXT TO FUNKY SXT09270C*------------------------------------------------------------------- 09280C* DELETE COPIED LINES FROM REAL TEXT. 09290CSR MOVE SXTNAM NAME 09300CSR EXSR SR616 NAME TO KEY 09310CSR EXSR SR400 GET REAL MAST 09320CSR EXSR SR203 DELETE REAL TEXT 09330C*------------------------------------------------------------------- 09340C* COPY FUNKY TEXT TO REAL TEXT. 09350CSR SETOF 36 09360CSR MOVE FUNKY FRNAME FUNKY KEY 09370CSR Z-ADD999 ENDLIN ADJUSTED END-LINE 09380CSR MOVE SXTNAM NAME REAL KEY 09390CSR EXSR SR616 NAME TO KEY 09400CSR EXSR SR208 COPY FUNKY TO REAL 09410C*------------------------------------------------------------------- 09420C* DELETE FUNKY TEXT. 09430CSR SETON 36 09440CSR MOVE FUNKY NAME 09450CSR EXSR SR616 NAME TO KEY 09460CSR EXSR SR400 GET SXMAST 09470CSR Z-ADD999 ENDLIN 09480CSR EXSR SR203 DELETE FUNKY TEXT 09490CSR 40 EXSR SR401 UPDATE SXMAST 09500CSR 41 EXSR SR404 UPDATE SXPTR ÐÐ09510CSR MOVE SXTNAM NAME REAL KEY 09520CSR EXSR SR616 MOVE NAME TO KEY 09530CSR EXSR SR400 GET TEXT BACK 09540C*------------------------------------------------------------------- 09550CSR END206 TAG 09560CSR SETOF 3936 09570CSR ENDSR 09580C******************************************************************** 09590CSR SR208 BEGSR 09600C* COPY TEXT 09610CSR 44 09620COR 40 EXSR SR401 UPDATE SXMAST 09630CSR 41 EXSR SR404 UPDATE SXPTR 09640CSRN39 EXSR SR922 VERIFY REC SPACE 09650CSR 58 GOTO END208 NOT ENOUGH ROOM 09660CSR MOVE FRNAME TNAME COPY FROM NAME 09670CSR EXSR SR400 GET CPY FR MAST 09680CSR SETOF 4044 09690CSR SETOF 43 09700CSR START SUB 1 LINENO 09710CSR Z-ADD0 SAVCPY 30 09720CSR Z-ADD0 SAVES 30 09730CSR Z-ADD0 CPYRRN 50 09740C*-------------------------------------------------------------------- 09750CSR T208A TAG ÐÐ09760C* COPY TEXT PTRS TO SXCOPY FILE 09770CSR 1 ADD LINENO LINENO 09780CSR EXSR SR613 CHK LINE# 09790CSR 54 GOTO T208D BEYOND LIMIT 09800CSR EXSR SR300 CONVERT LINE,B,P 09810CSR EXSR SR612 CHK BLK# 09820CSRN54 EXSR SR610 ADVANCE LINENO 09830CSRN54 GOTO T208A GET NEXT BLOCK 09840CSR EXSR SR412 GET SXPTR 09850CSR EXSR SR618 P=Y COMP 09860CSR SETOF 56 09870CSRN54 SETON 56 09880CSR 56 EXSR SR601 FIND NEXT 'Y' 09890CSR 56N55 Z-ADD10 P 09900CSR 56 EXSR SR302 CALC NEW LINE# 09910CSR 56N55 GOTO T208A GET NEXT LINE 09920CSR EXSR SR301 CALC RRN 09930CSR 43 GOTO T208C SXCOPY ACTIVE 09940C*------------------------------------------------------------------ 09950CSR T208B TAG 09960C* GET SXCOPY RECORD 09970CSR 1 ADD CPYRRN CPYRRN 09980CSR EXSR SR409 GET SXCOPY 09990CSR TCPORT COMP 0 54 10000CSRN54 GOTO T208B WRONG PORT # ÐÐ10010CSR Z-ADD0 CPY 10020CSR Z-ADDPORT TCPORT 10030CSR Z-ADD0 S 30 10040C*----------------------------------------------------------------- 10050CSR T208C TAG 10060C* COPY PTRS TO SXCOPY RECORD 10070CSR 1 ADD S S 10080CSR S COMP SLIMIT 54 10090CSR 54 GOTO T208B BEYOND LIMIT 10100CSR Z-ADDRRN CPY,S SAVE RRN 10110CSR GOTO T208A GET NXT CPY LINE 10120C*------------------------------------------------------------------ 10130CSR T208D TAG 10140C* USE SAVED PTRS TO COPY TEXT 10150CSR 43 EXSR SR410 UPDATE SXCOPY 10160CSR Z-ADDCPYRRN SAVCPY 30 10170CSR COPYTO SUB INCRMT LINENO 10180CSR 40 10190COR 44 EXSR SR401 UPDATE SXMAST 10200CSR EXSR SR616 NAME TO KEY 10210CSR EXSR SR400 GET SXMAST 10220CSR Z-ADD0 CPYRRN 10230C*------------------------------------------------------------------ 10240CSR T208E TAG 10250CSR 1 ADD CPYRRN CPYRRN ÐÐ10260CSR CPYRRN COMP SAVCPY 54 10270CSR 54 GOTO END208 DONE 10280CSR TCPORT COMP PORT 54 10290CSRN54 GOTO T208E WRONG PORT# 10300CSR Z-ADD1 S 10310C*--------------------------------------------------------------- 10320CSR T208F TAG 10330CSR ZERO5 LOKUPCPY,S 54 10340CSRN54 GOTO T208E GET NXT SXCOPY 10350CSR Z-ADDCPY,S RRN 50 10360CSR EXSR SR405 GET SXFILE REC 10370CSR MOVEAREC FROM 10380CSR MOVE SXTYPE TYPE 10390CSR MOVE SXLINE HLINE 10400CSR MOVE SXSPAC SPACE 10410CSR Z-ADD0 TCPORT 10420CSR Z-ADD0 CPY,S 10430C*-------------------------------------------------------------- 10440CSR T208G TAG 10450C* GET COPY-TO RECORD 10460CSR EXSR SR615 INCRMT + LINENO 10470CSR EXSR SR614 CHECK LINE LIMIT 10480CSR 54 GOTO T208J ABORT COPY 10490CSR EXSR SR300 CALC B,P 10500CSR EXSR SR612 CHK BLK# ÐÐ10510CSRN54 EXSR SR703 GET NEW BLK# 10520CSR EXSR SR412 GET SXPTR 10530C*--------------------------------------------------------------- 10540CSR T208H TAG 10550CSR EXSR SR618 P=Y COMP 10560CSR 54 GOTO T208J ABORT COPY 10570CSR MOVE 'Y' PAG,P 10580CSR EXSR SR301 CALC RRN 10590CSR EXSR SR405 GET SXFILE 10600CSR MOVEAFROM REC 10610CSR EXSR SR406 UPDATE SXFILE 10620CSRN36 EXSR SR502 LFCR 10630CSRN36 EXSR SR74 DISPLAY TEXT 10640CSR GOTO T208F GET NEXT PTR 10650C*--------------------------------------------------------------- 10660CSR T208J TAG 10670C* FLAG COPY ABORTED-- NO ROOM 10680CSR Z-ADD475 M 10690CSR EXSR SR455 FLAG ERROR 10700C*-------------------------------------------------------------- 10710CSR T208K TAG 10720C* INIT UNUSED PTRS 10730CSR Z-ADD0 CPY 10740CSR Z-ADD0 TCPORT 10750CSR EXSR SR410 UPDATE SXCOPY ÐÐ10760C*------------------------------------------------------------- 10770CSR T208L TAG 10780CSR 1 ADD CPYRRN CPYRRN 10790CSR CPYRRN COMP SAVCPY 54 10800CSR 54 GOTO END208 10810CSR TCPORT COMP PORT 54 10820CSRN54 GOTO T208L WRONG PORT 10830CSR GOTO T208K INIT 10840C*-------------------------------------------------------------- 10850CSR END208 TAG 10860C* END COPY/RESEQ ROUTINE 10870CSR 41 EXSR SR404 UPDATE SXPTR 10880CSR 43 EXSR SR410 UPDATE SXCOPY 10890CSR 40 10900COR 44 EXSR SR401 UPDATE SXMAST 10910CSR EXSR SR616 NAME TO KEY 10920CSR EXSR SR400 GET SXMAST 10930CSR ENDSR 10940C****************************************************************** 10950CSR SR209 BEGSR 10960C* UPDATE TAB - STOPS 10970CSR EXSR SR502 LFCR 10980CSR MOVEABAT REC 10990CSR EXSR SR74 PUT EXIST TABS 11000CSR Z-ADD474 M ÐÐ11010CSR EXSR SR452 PROMPT 11020CSR 92 GOTO SR209 REPEAT ESC 11030CSR 90 GOTO END209 11040CSR EXSR SR708 MOVE DATA 11050CSR MOVEABUFIN BAT 11060CSR END209 ENDSR 11070C******************************************************************** 11080CSR SR300 BEGSR 11090C* CALCULATE BLK INDEX (B) AND PAG INDEX (P) FROM LINE #. 11100CSR .1 MULT LINENO W4D1 41 11110CSR MOVELW4D1 B 30 11120CSR MOVE W4D1 W1N 11130CSR Z-ADDW1N P 30 54 11140CSRN54 B SUB 1 B 11150CSRN54 Z-ADD10 P 11160CSR 1 ADD B B 11170CSR ENDSR 11180C******************************************************************** 11190CSR SR301 BEGSR 11200C* CALC RRN FROM BLOCK # AND PAG INDEX (P). 11210CSR Z-ADDBLK,B RRN 11220CSR 10 MULT RRN RRN RRN 11230CSR P ADD RRN RRN 11240CSR RRN SUB 10 RRN 11250CSR ENDSR ÐÐ11260C******************************************************************** 11270CSR SR302 BEGSR 11280C* CALC LINE # FROM B AND P INDEX. 11290CSR 10 MULT B LINENO 11300CSR LINENO ADD P LINENO 11310CSR LINENO SUB 10 LINENO 11320CSR ENDSR 11330C******************************************************************** 11340CSR SR303 BEGSR 11350C* COMPUTE B AND P FOR END LINE. 11360CSR Z-ADDENDLIN LINENO 50 11370CSR EXSR SR300 CALC B,P 11380CSR Z-ADDB BEND 30 11390CSR Z-ADDP PEND 30 11400CSR ENDSR 11410C******************************************************************** 11420CSR SR400 BEGSR 11430C* GET SXMAST FILE. 11440CSR MOVE ' ' TMSTAT 11450CSR 44 NEW ADD PENDING 11460COR 40 EXSR SR401 UPD PREV GET 11470CSR TNAME CHAINSXMAST 60 GET SXMAST 11480CSR 60 SETON 44 ADD FLAG 11490CSRN60 SETON 40 ACTIVE REL FLAG 11500CSR ENDSR ÐÐ11510C******************************************************************** 11520CSR SR401 BEGSR 11530C* UPDATE SXMAST. 11540CSR SETON 80 11550CSR 40 ACTIVE GET 11560COR 44 EXCPT PREV NO HIT 11570CSR SETOF 804044 11580CSR ENDSR 11590C******************************************************************** 11600CSR SR403 BEGSR 11610C* GET SXPTR FILE. 11620CSR 41 EXSR SR404 UPD PREV GET 11630CSR BLK,B CHAINSXPTR 60 GET SXPTR 11640CSRN60 SETON 41 ACT REC FLAG 11650CSR Z-ADDBLK,B LASTTP 30 11660CSR MOVE TNAME LASTTM 12 11670CSR ENDSR 11680C******************************************************************** 11690CSR SR404 BEGSR 11700C* UPDATE SXPTR FILE. 11710CSR SETON 81 11720CSR 41 EXCPT UPDATE SXPTR 11730CSR SETOF 8141 11740CSR ENDSR 11750C******************************************************************** ÐÐ11760CSR SR405 BEGSR 11770C* GET SXFILE. 11780CSR RRN CHAINSXFILE 60 GET SXFILE 11790CSR ENDSR 11800C******************************************************************** 11810CSR SR406 BEGSR 11820C* UPDATE SXFILE. 11830CSR SETON 82 11840CSR EXCPT UPDATE SXFILE 11850CSR SETOF 82 11860CSR ENDSR 11870C******************************************************************** 11880CSR SR407 BEGSR 11890C* GET SXAVAIL. 11900CSR 42 EXSR SR408 UPDATE SXAVAIL 11910CSR Z-ADD1 NABLK 50 11920CSR NABLK CHAINSXAVAIL H4 11930CSRNH4 SETON 42 11940CSR ENDSR 11950C******************************************************************** 11960CSR SR408 BEGSR 11970C* UPDATE SXAVAIL FILE. 11980CSR SETON 83 11990CSR 42 EXCPT UPDATE SXAVAIL 12000CSR SETOF 8342 ÐÐ12010CSR ENDSR 12020C******************************************************************** 12030CSR SR409 BEGSR 12040C* GET SXCOPY FILE. 12050CSR 43 EXSR SR410 UPD PREV GET 12060CSR CPYRRN CHAINSXCOPY 60 GET SXCOPY 12070CSRN60 SETON 43 ACT REC FLAG 12080CSR ENDSR 12090C******************************************************************** 12100CSR SR410 BEGSR 12110C* UPDATE SXCOPY FILE. 12120CSR SETON 84 12130CSR 43 EXCPT UPDATE SXCOPY 12140CSR SETOF 8443 12150CSR ENDSR 12160C******************************************************************** 12170CSR SR411 BEGSR 12180C* GET MESSAGE MAST. 12190CSR M CHAINMGFILE 54 12200CSR 54 MOVE BLK60 MGTEXT 12210CSR 54 MOVEL'NO-MSG' MGTEXT 12220CSR ENDSR 12230C******************************************************************** 12240CSR SR412 BEGSR 12250C* GET SXPTR. ÐÐ12260CSR 41 BLK,B COMP LASTTP 54 12270CSR 41 54 TNAME COMP LASTTM 54 12280CSR 41N54 12290CORN41 EXSR SR403 GET SXPTR 12300CSR ENDSR 12310C******************************************************************** 12320CSR SR450 BEGSR 12330C* PROMPT, LINE-120, CURSOR AT COL-37 - OPTIONAL INPUT. 12340CSR EXSR SR603 INIT CRT ARRAY 12350CSR EXSR SR411 GET MGFILE 12360CSR EXSR SR71 PROMPT 12370CSR EXSR SR600 INIT BUFIN 12380CSR EXSR SR475 READ 12390CSR ENDSR 12400C******************************************************************** 12410CSR SR451 BEGSR 12420C* PROMPT, LINE-120, CURSOR AT COL-37 - MANDATORY INPUT. 12430CSR EXSR SR450 PROMPT/READ 12440CSR 77 12450COR 90 GOTO END451 12460CSR Z-ADDM SAVEM 50 12470CSR Z-ADD435 M 12480CSR EXSR SR455 FLAG ERROR 12490CSR Z-ADDSAVEM M 12500CSR GOTO SR451 ÐÐ12510CSR END451 ENDSR 12520C******************************************************************** 12530CSR SR452 BEGSR 12540C* PROMPT, LINE-118. 12550CSR MOVE BIT,1 ARA 12560CSR EXSR SR453 INIT PROMPT 12570CSR SETON 35 12580CSR EXSR SR476 READ 12590CSR SETOF 35 12600CSR ENDSR 12610C******************************************************************** 12620CSR SR453 BEGSR 12630C* PUT MSG AT CURRENT LINE. 12640CSR EXSR SR411 GET MGFILE 12650CSR EXSR SR603 INIT CRT 12660CSR MOVEAMGTEXT CRT 12670CSR EXSR SR72 LFCR/PROMPT/LFCR 12680CSR ENDSR 12690C******************************************************************** 12700CSR SR454 BEGSR 12710C* SPACE BEFORE PRINT (SR201). 12720CSR SPACE COMP '1' 54 12730CSR 54 EXSR SR502 LFCR 12740CSR SPACE COMP '2' 54 12750CSR 54 EXSR SR502 LFCR ÐÐ12760CSR 54 EXSR SR502 12770CSR SPACE COMP '3' 54 12780CSR 54 EXSR SR502 LFCR 12790CSR 54 EXSR SR502 12800CSR 54 EXSR SR502 12810CSR SPACE COMP 'S' 54 12820CSR 54 EXSR SR502 LFCR 12830CSR 54 EXSR SR502 LFCR 12840CSR 54 EXSR SR502 LFCR 12850CSR 54 EXSR SR502 LFCR 12860CSR ENDSR 12870C******************************************************************** 12880CSR SR455 BEGSR 12890C* PUT ERR MESSAGE 12900CSR MOVE BIT,8 BELL 1 12910CSR EXSR SR411 GET MGFILE 12920CSR EXSR SR73 PUT MSG 12930CSR MOVE ' ' BELL 12940CSR ENDSR 12950C******************************************************************** 12960CSR SR456 BEGSR 12970C* SPACE BEFORE PRINT (SR203). 12980CSR MOVE SXSPAC SPACE 12990CSR EXSR SR454 13000CSR ENDSR ÐÐ13010C******************************************************************** 13020CSR SR457 BEGSR 13030C* LINE CONTROL CURSOR POSITION. 13040CSRN32 MOVE '120067' W6A 13050CSR 32 MOVE '119068' W6A 13060CSR EXSR SR500 POSITION CURSOR 13070CSR ENDSR 13080C************************************************************ 13090CSR SR458 BEGSR 13100C* LINE CONTROL PROMPT 13110CSR EXSR SR603 INIT CRT 13120CSR EXSR SR411 GET MGFILE 13130CSR MOVEAMGTEXT CRT,1 13140CSR MOVEAW60A CRT,45 13150CSR EXSR SR457 POSITION CURSOR 13160CSR EXSR SR70 WRITE 13170CSR EXSR SR600 INIT BUFIN 13180CSRN32 MOVE '120095' W6A 13190CSR 32 MOVE '119095' W6A 13200CSR EXSR SR500 POSITION CUROSR 13210CSR EXSR SR475 READ 13220CSR ENDSR 13230C***************************************************************** 13240CSR SR475 BEGSR 13250C* READ CRT - BASIC UTILITY SR. ÐÐ13260CSR EXSR SR102 SETOFFS 13270CSR MOVE ' ' RETCOD 2 RETURN CODE 13280CSR EXITFQBELL RING BELL 13290CSR EXITFQR60R READ 13300CSR RLABL BUFIN BUFFER 13310CSR RLABL BUFLGT BUF LGTH 13320CSR RLABL RETCOD RET CODE 13330CSRN37 MOVEABUFIN A60 INPUT DATA 13340CSR 37 Z-ADDCURCOL W 13350CSR 37 MOVEABUFIN A60,W 13360CSR RETCOD COMP '03' 91 FLAG LF/TAB 13370CSR 91 EXSR SR503 BUMP CURSOR UP 13380CSR Z-ADD1 W 30 13390CSR BIT,32 LOKUPA60,W 54 FIND INPUT 13400CSRN54 GOTO END475 13410CSR A60,W COMP '\' 90 13420CSRN90 GOTO T475B 13430CSR 1 ADD W W 13440CSR W COMP 60 54 13450CSR 54 GOTO T475A BAD ESC 13460CSR A60,W COMP 'B' 94 BKWD TAB 13470CSR A60,W COMP 'N' 96 NEW ITEM 13480CSR A60,W COMP 'R' 92 REPEAT 13490CSR A60,W COMP 'E' 98 SYST-MENU 13500CSR A60,W COMP 'M' 97 LOCAL-MENU ÐÐ13510CSR A60,W COMP 'G' 99 GOODBY 13520CSR A60,W COMP 'D' 93 DONE 13530CSR 92 13540COR 93 13550COR 94 13560COR 94 13570COR 96 13580COR 97 13590COR 98 13600COR 99 GOTO END475 GOOD ESC 13610C*------------------------------------------------------------------- 13620CSR T475A TAG 13630C* FLAG BAD ESCAPE. 13640CSR Z-ADD318 M 13650CSR EXSR SR455 FLAG ERROR 13660CSR GOTO SR475 TRY AGAIN 13670C*------------------------------------------------------------------- 13680CSR T475B TAG 13690CSR SETON 77 13700CSR 37 GOTO END475 13710CSR 77 EXSR SR600 INIT BUFIN 13720CSR 77 MOVEAA60,W BUFIN 13730C*----------------------------------------------------------------- 13740CSR END475 TAG 13750CSR ENDSR ÐÐ13760C******************************************************************** 13770CSR SR476 BEGSR 13780C* READ CRT (TEXT ADD ONLY) 13790CSR SETOF 3231 13800CSR SETON 37 ADD TRAN FLAG 13810CSR EXSR SR501 CR-ONLY 13820CSR MOVEAARA BUFIN 60 13830CSR Z-ADD1 CURCOL 30 13840C*------------------------------------------------------------------- 13850CSR T476B TAG 13860C* READ CRT 13870CSR Z-ADDCURCOL OLDCUR 30 13880CSR EXSR SR475 READ CRT 13890CSR 91 SETON 32 13900CSR 94 SETOF 90 13910CSR 94 GOTO T476F 13920CSR 90 GOTO END476 ESCAPE,NOT BKW TAB 13930CSRN77N91N31 SETON 9093 DEFAULT DONE 13940CSRN77N91 GOTO END476 13950CSR Z-ADDCURCOL W 13960C*------------------------------------------------------------------ 13970CSR T476C TAG 13980C* MOVE INPUT DATA TO RECORD 13990CSR BIT,32 LOKUPA60,W 54 14000CSRN54 GOTO T476D ÐÐ14010CSR SETON 31 ACTIVITY FLAG 14020CSR MOVE A60,W REC,W 14030CSR MOVE BIT,1 A60,W 14040CSR Z-ADDW CURCOL 14050CSR GOTO T476C 14060C*------------------------------------------------------------------ 14070CSR T476D TAG 14080C* MOVE CURSOR TO NEXT TAB POSITION 14090CSRN91 GOTO END476 NO LF(TAB) 14100CSR SETON 31 ACTIVITY FLAG 14110CSR 1 ADD CURCOL CURCOL 14120CSR Z-ADDCURCOL W 14130CSR W COMP 60 54 14140CSRN54 'X' LOKUPBAT,W 55 FIND TAB STOP 14150CSR 54 14160CORN54N55 Z-ADD60 W 14170CSR GOTO T476G 14180C*------------------------------------------------------------------ 14190CSR T476F TAG 14200C* DO BACKWARD TAB 14210CSR Z-ADDOLDCUR W 14220CSR 77 GOTO T476G 14230C*------------------------------------------------------------- 14240CSR T476FA TAG 14250CSR W SUB 1 W 54 ÐÐ14260CSRN54 Z-ADD1 W 14270CSR Z-ADDW CURCOL 14280CSRN54 GOTO T476G 14290CSR BAT,W COMP 'X' 54 14300CSRN54 GOTO T476FA 14310C*----------------------------------------------------------------- 14320CSR T476G TAG 14330CSRN35 EXSR SR74 PUT CRT 14340CSR Z-ADDW CURCOL 14350CSR MOVEAARA BUFIN 14360CSR 1 ADD W W3N 14370CSR MOVE W3N W6A 6 14380CSRN32 MOVEL'120' W6A 14390CSR 32 MOVEL'119' W6A 14400CSR EXSR SR500 POSITION CURSOR 14410CSR GOTO T476B DO NEXT READ 14420C*------------------------------------------------------------------ 14430CSR END476 TAG 14440CSR SETOF 3731 14450CSR ENDSR 14460C******************************************************************** 14470CSR SR500 BEGSR 14480C* MOVE CURSOR. 14490CSR EXITFQXYPOS MOVE CURSOR 14500CSR RLABL W6A ÐÐ14510CSR ENDSR 14520C******************************************************************** 14530CSR SR501 BEGSR 14540C* CAR-RETURN (ONLY). 14550CSR EXITFQCCR CAR-RETURN 14560CSR ENDSR 14570C******************************************************************** 14580CSR SR502 BEGSR 14590C* CR/LF. 14600CSR EXITFQCLFCR LF/CR 14610CSR 1 ADD COUNT COUNT 14620CSR ENDSR 14630C********************************************************************* 14640CSR SR503 BEGSR 14650C* BUMP CURSOR UP 14660CSR EXITFQMOVUP BUMP CURSOR UP 14670CSR ENDSR 14680C****************************************************************** 14690CSR SR600 BEGSR 14700C* UTILITY INIT. 14710CSR MOVE BLK60 BUFIN 60 INIT BUFIN 14720CSR ENDSR 14730C****************************************************************** 14740CSR SR601 BEGSR 14750C* FIND NEXT ACTIVE LINE ÐÐ14760CSR 'Y' LOKUPPAG,P 55 14770CSR ENDSR 14780C***************************************************************** 14790CSR SR602 BEGSR 14800C* COMPUTE ENDING LINE # (COPY/RESEQ SR922,SR920) 14810CSR INCRMT MULT ACTUAL REQD 50 14820CSR REQD SUB INCRMT REQD 14830CSR COPYTO ADD REQD REQD 14840CSR ENDSR 14850C******************************************************************** 14860CSR SR603 BEGSR 14870CSR MOVE ' ' CRT 14880CSR ENDSR 14890C***************************************************************** 14900CSR SR605 BEGSR 14910C* INIT W60A. 14920CSR MOVE BLK60 W60A 60 INIT W60A 14930CSR MOVE W60A W15A 15 14940CSR ENDSR 14950C******************************************************************** 14960CSR SR606 BEGSR 14970CSR X COMP 60 54 14980CSR ENDSR 14990C******************************************************************** 15000CSR SR607 BEGSR ÐÐ15010CSR BIT,32 LOKUPFROM,X 54 15020CSR ENDSR 15030C******************************************************************** 15040CSR SR610 BEGSR 15050C* RESET LINENO TO START AT NEXT INDEX-B BLOCK. 15060CSR 10 SUB P W5N 50 15070CSR W5N ADD LINENO LINENO 15080CSR ENDSR 15090C******************************************************************** 15100CSR SR611 BEGSR 15110C* EDIT 5-DIGIT NUMB. 15120CSR MOVE 'Z' W1A 1 15130CSR Z-ADD5 W2N 20 15140CSR MOVE ' ' W5A 5 15150CSR EXIT SUBRED EDIT ROUTINE 15160CSR RLABL W5N SOURCE 15170CSR RLABL W1A EDIT CODE 15180CSR RLABL W5A RESULT 15190CSR RLABL W2N END POS 15200CSR ENDSR 15210C****************************************************************** 15220CSR SR612 BEGSR 15230C* CHECK FOR ACTIVE BLOCK 15240CSR BLK,B COMP 0 54 15250CSR ENDSR ÐÐ15260C**************************************************************** 15270CSR SR613 BEGSR 15280C* FLAG PAST END LINE LIMIT 15290CSR LINENO COMP ENDLIN 54 15300CSR ENDSR 15310C**************************************************************** 15320CSR SR614 BEGSR 15330C* CHECK LINE# TO LINE LIMIT 15340CSR LINENO COMP LLIMIT 54 CHK LINE LIMIT 15350CSR ENDSR 15360C******************************************************************** 15370CSR SR615 BEGSR 15380CSR INCRMT ADD LINENO LINENO 50 15390CSR ENDSR 15400C******************************************************************** 15410CSR SR616 BEGSR 15420CSR MOVE NAME TNAME 12 15430CSR ENDSR 15440C******************************************************************** 15450CSR SR617 BEGSR 15460CSR MOVE W5A W15A 15470CSR EXSR SR619 W15A L W60A 15480CSR ENDSR 15490C******************************************************************** 15500CSR SR618 BEGSR ÐÐ15510CSR PAG,P COMP 'Y' 54 15520CSR ENDSR 15530C***************************************************************** 15540CSR SR619 BEGSR 15550CSR MOVELW15A W60A 60 15560CSR ENDSR 15570C******************************************************************** 15580CSR SR701 BEGSR 15590C* R. ADJUST. 15600CSR MOVELBUFIN W10A 10 15610CSR Z-ADD10 W2N 20 15620CSR EXIT SUBRAJ R. ADJUST 15630CSR RLABL W2N 15640CSR RLABL W10A 15650CSR ENDSR 15660C******************************************************************** 15670CSR SR702 BEGSR 15680C* CHECK CONTROL-D INPUT. 15690CSR MOVE ' ' W2A 2 15700CSR EXITFQSTOP 15710CSR RLABL W2A 15720CSR W2A COMP 'XX' 54 54 15730CSR ENDSR 15740C******************************************************************** 15750CSR SR703 BEGSR ÐÐ15760C* GET NEXT AVAIL BLOCK. 15770CSR EXSR SR407 GET SXAVAIL 15780CSR 'N' LOKUPNAB,N 54 15790CSRN54 GOTO T703Z NONE FOUND 15800C*--------------------------------------------------------------- 15810CSR T703A TAG 15820CSR MOVE 'Y' NAB,N 15830CSR Z-ADDN BLK,B 15840CSR GOTO END703 15850C*--------------------------------------------------------------- 15860CSR T703Z TAG 15870C* TRY AGAIN FROM FRONT OF ARRAY 15880CSR Z-ADD1 N 30 15890CSR 'N' LOKUPNAB,N 54 15900CSR 54 GOTO T703A GOT ONE 15910C* FLAG FILE FULL ERROR 15920CSR Z-ADD470 M 15930CSR EXSR SR455 FLAG ERROR 15940C*------------------------------------------------------------- 15950CSR END703 TAG 15960CSR EXSR SR408 UPDATE SXAVAIL 15970CSR 40 15980COR 44 EXSR SR400 UPDATE SXMAST 15990CSR ENDSR 16000C******************************************************************** ÐÐ16010CSR SR704 BEGSR 16020C* STORE DELETED BLOCK #. 16030CSR Z-ADDBLK,B N 16040CSR EXSR SR407 GET SXAVAIL 16050CSR MOVE 'N' NAB,N 16060CSR EXSR SR403 GET DELETED SXPTR 16070CSR MOVE 'N' PAG 16080CSR EXSR SR404 UPDATE SXPTR 16090CSR Z-ADD0 BLK,B 16100C*------------------------------------------------------------- 16110CSR END704 TAG 16120CSR EXSR SR408 UPDATE SXAVAIL 16130CSR 40 16140COR 44 EXSR SR400 UPDATE SXMAST 16150CSR ENDSR 16160C****************************************************************** 16170CSR SR707 BEGSR 16180C* CLASSIFY INSTRUCTION. 16190CSR INSTR COMP 'G' 55 GET 16200CSR INSTR COMP 'A' 56 ADD 16210CSR INSTR COMP 'D' 57 DELETE 16220CSR INSTR COMP 'L' 58 LIST 16230CSR INSTR COMP 'R' 59 REPLACE 16240CSR INSTR COMP 'S' 60 SEQ 16250CSR INSTR COMP 'F' 61 FIND ÐÐ16260CSR INSTR COMP 'C' 62 COPY 16270CSR INSTR COMP 'T' 63 TAB-SET 16280CSR INSTR COMP 'M' 64 MOVE TEXT 16290CSR ENDSR 16300C*************************************************************** 16310CSR SR708 BEGSR 16320C* MOVE SIGNIFICANT INPUT DATA 16330CSR MOVE BIT,1 CRT 16340CSR Z-ADD1 X 16350C*------------------------------------------------------------- 16360CSR T708A TAG 16370CSR BIT,32 LOKUPREC,X 54 16380CSRN54 GOTO END708 16390CSR REC,X COMP '!' 54 16400CSR 54 MOVE ' ' CRT,X 16410CSRN54 MOVE REC,X CRT,X 16420CSR 1 ADD X X 16430CSR EXSR SR606 COMP 60 16440CSRN54 GOTO T708A 16450C*---------------------------------------------------------- 16460CSR END708 TAG 16470CSR MOVEACRT BUFIN 16480CSR ENDSR 16490C******************************************************************** 16500CSR SR709 BEGSR ÐÐ16510C* MOVE TEXT (SEE SR205,SR203). 16520CSR MOVE ' ' TOR 16530CSR Z-ADDCOLF X 16540CSR MOVEAREC,X TOR,X 16550CSR MOVEABLK60 REC,X 16560CSR COLT COMP 60 54 16570CSRN54 Z-ADDCOLT T 30 16580CSRN54 MOVEATOR,X REC,T 16590CSR EXSR SR406 UPDATE SXFILE 16600CSR EXSR SR405 GET SXFILE 16610CSR ENDSR 16620C******************************************************************** 16630CSR SR920 BEGSR 16640C* SEARCH TEXT. 16650CSR START SUB 1 LINENO 16660CSR SETOF 59 16670C*------------------------------------------------------------------- 16680CSR T920A TAG 16690CSR EXSR SR702 CHK CONTROL-D 16700CSR 54 GOTO END920 16710CSR 1 ADD LINENO LINENO 16720CSR SETOF 29 16730CSR EXSR SR613 CHK LIMIT 16740CSR 54 GOTO T920F PAST LIMIT 16750CSR EXSR SR300 CALC B,P ÐÐ16760CSR EXSR SR612 CHK BLK # 16770CSRN54 EXSR SR610 ADVANCE LINE # 16780CSRN54 GOTO T920A 16790CSR EXSR SR412 GET SXPTR 16800CSR 'Y' LOKUPPAG,P 54 16810CSRN54 GOTO T920E NO LINES 16820CSR EXSR SR302 CALC LINENO 16830CSR EXSR SR613 CHECK LIMIT 16840CSR 54 GOTO T920F PAST LIMIT 16850CSR EXSR SR301 CALC RRN 16860CSR EXSR SR405 GET SXFILE 16870CSR SOPTON COMP 'C' 54 SEARCH OPTION 16880CSR 54 GOTO T920B SEARCH BY COL 16890C*----------------------------------------------------------- 16900CSR T920AB TAG 16910CSR EXSR SR926 SEARCH GLOBAL 16920CSR 58 SETON 5929 MATCH FLAG 16930CSR 58 GOTO T920C GOT ONE 16940CSR 29 GOTO T920CA PREV HIT 16950CSR GOTO T920A NO HIT 16960C*------------------------------------------------------------------- 16970CSR T920B TAG 16980CSR EXSR SR927 SEARCH BY COL 16990CSRN58 GOTO T920A NO HIT 17000CSR SETON 59 ÐÐ17010C*------------------------------------------------------------------- 17020CSR T920C TAG 17030CSR INSTR COMP 'F' 54 CHK INSTRUCT 17040CSR 54 GOTO T920D FIND INSTR 17050CSR EXSR SR928 REPLACE INSTR 17060CSR SOPTON COMP 'C' 54 FLAG BY COL 17070CSRN54 GOTO T920AB GLOBAL 17080C*------------------------------------------------------------- 17090CSR T920CA TAG 17100CSR EXSR SR406 UPDATE SXFILE 17110C*------------------------------------------------------------------- 17120CSR T920D TAG 17130CSR EXSR SR502 LFCR 17140CSR EXSR SR74 DISPLAY 17150CSR GOTO T920A 17160C*------------------------------------------------------------------- 17170CSR T920E TAG 17180CSR Z-ADD10 P ADVANCE LINE 17190CSR EXSR SR302 CALC LINE # 17200CSR GOTO T920A 17210C*------------------------------------------------------------------- 17220CSR T920F TAG 17230C* IF NO HITS, DISPLAY MSG. 17240CSRN59 Z-ADD476 M 17250CSRN59 EXSR SR455 ÐÐ17260CSR END920 ENDSR 17270C******************************************************************** 17280CSR SR922 BEGSR 17290C* VERIFY THAT ENOUGH SPACE EXISTS FOR COPY/RESEQ. 17300CSR 44 17310COR 40 EXSR SR401 UPDATE SXMAST 17320CSR 41 EXSR SR404 UPDATE SXPTR 17330C*------------------------------------------------------------------- 17340CSR T922A TAG 17350C* COUNT LINES TO BE RESEQ/COPIED. 17360CSR MOVE FRNAME TNAME 17370CSR EXSR SR400 GET SXMAST 17380CSR SETOF 4044 17390CSR EXSR SR923 COUNT LINES REQD 17400C*--------------------------------------------------------------- 17410CSR T922B TAG 17420C* VERIFY LINES AVAIL. 17430CSR EXSR SR616 NAME TO KEY 17440CSR EXSR SR400 GET COPY-TO MAST 17450CSR SETOF 4044 17460CSR EXSR SR924 COUNT LINES AVAIL 17470CSRN58 GOTO END922 SPACE OK 17480C*-------------------------------------------------------------- 17490CSR T922C TAG 17500CSR SETOF 58 ÐÐ17510CSR EXSR SR602 CALC LINES REQD 17520CSR REQD COMP LINENO 54 54 17530CSRN54 GOTO END922 SPACE OK 17540CSR 54 39 EXSR SR613 CHK ENDLIN(RESEQ) 17550CSR 54 INCRMT SUB 1 INCRMT 54 17560CSR 54 GOTO T922C 17570CSR Z-ADD475 M 17580CSR EXSR SR455 FLAG ERROR 17590CSR SETON 58 17600C*-------------------------------------------------------------- 17610CSR END922 TAG 17620CSR 40 17630COR 44 EXSR SR401 UPDATE SXMAST 17640CSR EXSR SR616 NAME TO KEY 17650CSR EXSR SR400 GET SXMAST 17660CSR ENDSR 17670C******************************************************************** 17680CSR SR923 BEGSR 17690C* COUNT LINES TO BE RESEQ. 17700CSR START SUB 1 LINENO 17710CSR Z-ADD0 ACTUAL 17720C*------------------------------------------------------------------- 17730CSR T923A TAG 17740CSR 1 ADD LINENO LINENO 17750CSR EXSR SR613 CHK ENDLIN ÐÐ17760CSR 54 GOTO END923 17770CSR EXSR SR300 CALC B,P 17780CSR EXSR SR612 CHK BLK # 17790CSRN54 EXSR SR610 ADVANCE LINENO 17800CSRN54 GOTO T923A 17810CSR EXSR SR412 GET SXPTR 17820CSR EXSR SR618 P=Y COMP 17830CSRN54 GOTO T923A NO LINE 17840CSR 1 ADD ACTUAL ACTUAL 50 COPY LINE 17850CSR GOTO T923A 17860CSR END923 ENDSR 17870C******************************************************************** 17880CSR SR924 BEGSR 17890C* CHK AVAIL SPACE. 17900CSR Z-ADD0 AVAIL 50 17910CSR EXSR SR602 CALC LINES REQD 17920CSR Z-ADDCOPYTO LINENO 17930CSR LINENO SUB 1 LINENO 17940C*------------------------------------------------------------------- 17950CSR T924A TAG 17960CSR 1 ADD LINENO LINENO 17970CSR EXSR SR614 CHECK LINE LIMIT 17980CSR 54 GOTO END924 17990CSR EXSR SR300 CALC B,P 18000CSR EXSR SR612 CHK BLK# ÐÐ18010CSRN54 EXSR SR610 ADVANCE LINENO 18020CSRN54 W5N ADD AVAIL AVAIL 18030CSRN54 AVAIL COMP REQD 55 55 18040CSRN54 55 GOTO END924 SPACE OK 18050CSRN54 GOTO T924A 18060CSR EXSR SR412 GET SXPTR 18070CSR EXSR SR618 P=Y COMP 18080CSR 54 GOTO T924C ACTIVE LINE 18090CSR 1 ADD AVAIL AVAIL 18100CSR LINENO COMP REQD 54 54 18110CSR 54 GOTO END924 HAVE ENOUGH LINES 18120CSR GOTO T924A GET NEXT LINE 18130C*--------------------------------------------------------------- 18140CSR T924C TAG 18150C* SEE IF ACTIVE LINE IS WITHIN CRITICAL AREA 18160CSR REQD COMP LINENO 54 54 18170CSR 54 39 EXSR SR613 CHK ENDLIN(RESEQ) 18180CSRN54 1 ADD AVAIL AVAIL 18190CSRN54 GOTO T924A GET NEXT LINE 18200CSR SETON 58 OVERFLOW FLAG 18210CSR END924 ENDSR 18220C******************************************************************** 18230CSR SR926 BEGSR 18240C* GLOBAL SEARCH. 18250CSR SETOF 58 ÐÐ18260CSR Z-ADD0 LX 30 18270CSR Z-ADD1 X 18280CSR Z-ADD1 A 30 18290CSR EXSR SR607 LOKUP 18300CSRN54 GOTO T926C MATCH 18310CSR FROM,X LOKUPREC,A 54 18320CSRN54 GOTO END926 NO MATCH 18330CSR Z-ADDA FA 30 18340CSR Z-ADDX FX 30 18350C*------------------------------------------------------------------- 18360CSR T926A TAG 18370CSR Z-ADDFX X 18380C*------------------------------------------------------------------- 18390CSR T926B TAG 18400CSR Z-ADDX LX 30 18410CSR 1 ADD X X 18420CSR EXSR SR606 COMP 60 18430CSR 54 GOTO T926C MATCHED 18440CSR EXSR SR607 LOKUP 18450CSRN54 GOTO T926C MATCHED 18460CSR X SUB LX W3N 30 NUMB ADVANCED 18470CSR W3N ADD A A +A SAME AS X 18480CSR A COMP 60 54 18490CSR 54 GOTO END926 18500CSR REC,A COMP FROM,X 54 ÐÐ18510CSR 54 GOTO T926B GET NEXT MATCH 18520C* 'A' NOT MATCHED. START AGAIN. 18530CSR 1 ADD FA FA 18540CSR Z-ADDFA A 18550CSR Z-ADDFX X 18560CSR FROM,X LOKUPREC,A 54 18570CSRN54 GOTO END926 18580CSR GOTO T926B 18590C*------------------------------------------------------------------- 18600CSR T926C TAG 18610CSR SETON 58 18620CSR END926 ENDSR 18630C******************************************************************** 18640CSR SR927 BEGSR 18650C* MATCH TEXT RECORD, BY COL. 18660CSR SETOF 58 18670CSR Z-ADD1 X 18680C*------------------------------------------------------------------- 18690CSR T927A TAG 18700CSR EXSR SR607 LOKUP 18710CSRN54 SETON 58 18720CSRN54 GOTO END927 18730CSR REC,X COMP FROM,X 54 18740CSRN54 GOTO END927 18750CSR 1 ADD X X ÐÐ18760CSR EXSR SR606 COMP 60 18770CSRN54 GOTO T927A 18780CSR SETON 58 18790CSR END927 ENDSR 18800C******************************************************************** 18810CSR SR928 BEGSR 18820C* REPLACE MATCHED DATA (SEE SR920). 18830CSR SOPTON COMP 'C' 54 18840CSR 54 GOTO T928B COLUMN OPTION 18850C* REPLACE FOR GLOBAL OPTION. 18860CSR SETOF 56 18870CSR Z-ADD1 X 18880CSR Z-ADDFA A 18890CSR Z-ADD0 FX 18900C*---------------------------------------------------------------- 18910CSR T928A TAG 18920CSR BIT,32 LOKUPTOR,X 54 18930CSRN54 GOTO END928 18940CSR 56 X SUB FX W3N 18950CSR 56 W3N ADD A A 18960CSR A COMP 60 54 18970CSR 54 GOTO END928 18980CSR SETON 56 18990CSR MOVE TOR,X REC,A 19000CSR Z-ADDX FX ÐÐ19010CSR 1 ADD X X 19020CSR EXSR SR606 COMP 60 19030CSR 54 GOTO END928 19040CSR GOTO T928A 19050C*------------------------------------------------------------------- 19060CSR T928B TAG 19070C* REPLACE FOR COLUMN OPTION. 19080CSR Z-ADD0 X 19090C*------------------------------------------------------------------- 19100CSR T928C TAG 19110CSR 1 ADD X X 19120CSR EXSR SR606 COMP 60 19130CSR 54 GOTO END928 19140CSR BIT,32 LOKUPTOR,X 54 19150CSRN54 GOTO END928 19160CSR MOVE TOR,X REC,X 19170CSR GOTO T928C 19180CSR END928 ENDSR 19190O******************************************************************** 19200OSXMAST EADD 80 44 19210O TNAME 12 19220O MTYPE 13 19230O BLK 313P 19240O TMSTAT 314 19250O*------------------------------------------------------------------- ÐÐ19260O E 80N44 40 19270O MTYPE 13 19280O BLK 313P 19290O TMSTAT 314 19300O******************************************************************** 19310OSXPTR E 81 19320O PAG 10 19330O******************************************************************** 19340OSXFILE E 82 19350O REC 60 19360O TYPE B 61 19370O HLINE B 62 19380O SPACE B 63 19390O******************************************************************** 19400OSXAVAIL E 83 19410O NAB 2000 19420O*************************************************************** 19430OSXCOPY E 84 19440O TCPORT 2 19450O CPY 302P 19460O**************************************************************** ** ALT A B C D E F G L M N R S T \ Y H 019470ALTSEQ C12FC262C363C464C565C666C767D325D43BD53ED972E273E3745F20E879C868 019480** A60 ARRAY 019490 019500ÐÐ** FROM ARRAY 019510 019520** TOR ARRAY 019530 019540** BAT ARRAY 019550 019560** CRT ARRAY 019570 019580** ARA 019590 019600** ARB 019610 019620** A3 019630 019640/* 019650_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(ô XNULL P999999120282(èÈÐ PROGRAM QNULL 00010 END 00020_‚ _‚_‚ ÐÈ(Xø XúX103BM P999999120282(èÈÐ00010H Q103BM00020F* DISPLAY SINGLE LEVEL PARTS LIST. (X103BM) 00030F* REVISED 8-11-82 12:10 PM. 00040F* MENU: MQBM02 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST ID F 86L20AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E A12 1 12 1 A INPUT ARRAY. 00130E NUL 1 132 1 NULL CHAR. 00140E TABIC 1 9 2 TABICN 15 ISSUE CODES. 00150E TABSC 1 6 2 ATABSCN 12 SOURCE CODES. 00160E TABPC 1 7 1 TABPCN 20 PROV CODES. 00170E LNK 1 7 6 A 00180E CALL 7 6 00190E PAR 25 1 00200E TST 25 1 00210E BIT 33 1 BITTAB FILE. 00220I******************************************************************** 00230IBITPAR BT 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I******************************************************************** 00280ICRTFILE CR 00290I 28 330CRTIME 00300I 34 370CRDATE 00310I 38 79 CALL 00320I******************************************************************** 00330IPMMST2 PM 00340I* PART MASTER RECORD (XPMMST) 00350I* KEY AREA 00360I* PART NO. 12A 00370I 1 12 PMPN 00380I* NUMB OF COMPONENTS 3P 00390I P 13 140PMNOBM 00400I* PROD LINE 4N 00410I 15 180PMPL 00420I* MODEL NAME 12A 00430I 19 30 PMMODL 00440I* DESCRIPTION 29A 00450I 31 59 PMDESC 00460I* COMMODITY CODE 9P 00470I P 60 640PMCC 00480I* ENG CHANGE STATUS. 00490I* CUR CHG LEVEL 2A 00500I 70 71 PMECHG ÐÐ00510I* CUR CHG DATE 6N 00520I 72 770PMDCHG 00530I* LAST ECN NO. 5A 00540I 65 69 PMECN 00550I* DRAWING INFO 00560I* DWG SIZE 1A 00570I 82 82 PMSIZ 00580I* DWG CLASS 1A 00590I 83 83 PMDCLS 00600I* STANDARD CODE 1A 00610I 84 84 PMSTDC 00620I* DWG REL CODE 1A 00630I 78 78 PMDREL 00640I* UNIT MEAS 2A 00650I* EA = EACH OC = OUNCE 00660I* ST = SET TC = TROY OUNCE 00670I* IN = INCH LB = POUND 00680I* FT = FEET PT = PINT 00690I* YD = YARD QT = QUART 00700I* SI = SQ.INCH GL = GALLON 00710I* SF = SQ.FEET DR = DRUM 00720I* SY = SQ.YARD 00730I 85 86 PMUM 00740I* SOURCE CODE 2A 00750I* MA = MFG ASSY ÐÐ00760I* MP = MFG PART 00770I* PA = PURCH ASSY 00780I* PP = PURCH PART 00790I* RS = RAW STOCK 00800I 94 95 PMSC 00810I* PROVISIONING CODE 1A 00820I* A = FORECAST,NO VALUE ADDED 00830I* B = FORECAST,VALUE ADDED 00840I* C = BUILD TO ORDER (B) 00850I* D = BUILD TO ORDER (NOT B) 00860I* E = CUSTOM 00870I* Y = OBSOLETE,REPAIRABLE 00880I* Z = OBSOLETE,NOT REPAIRABLE 00890I 96 96 PMPROV 00900I* ISSUE CODE 2A 00910I* PT = PULL TIME 00920I* OR = ON REQUEST 00930I* BI = BULK ISSUE 00940I* AR = AS REQUIRED 00950I* VS = VENDOR SUPPLIED 00960I* SD = SHIPPING DOCUMENT 00970I* TD = TRAV DOCUMENT 00980I* RD = REF DOCUMENT 00990I* RA = REF ASSY 01000I 97 98 PMISSU ÐÐ01010I* DELIVER TO DEPT 5P 01020I P 99 1010PMDEL 01030I* RESPONSIBILITY CODES 01040I* ENGR CODE 2A 01050I 102 103 PMEGR 01060I* PLANNER CODE 2A 01070I 104 105 PMPLNR 01080I* BUYER CODE 2A 01090I 106 107 PMBUYR 01100I* SALESMAN CODE 2A 01110I 108 109 PMSLSM 01120I* INVENTORY ACCOUNT 5P 01130I P 110 1120PMACNT 01140I* LOW LEVEL CODE 2N 01150I 430 4310PMLL 01160I* RECORD STATUS 1A 01170I* D = DELETED 01180I 674 674 PMSTAT 01190I******************************************************************** 01200IBMMAST BM 01210I* BILL OF MATERIAL RECORD (XBMREC) 01220I* KEY AREA 01230I* ASSY PART NO. 10N 01240I 1 100BMAPN 01250I* COMPONENT PART NO. 10N ÐÐ01260I 11 200BMCPN 01270I* ITEM NO. 3N 01280I 25 270BMITNO 01290I* QTY PER ASSY 7P 01300I P 28 310BMQTY 01310I* SCRAP ALLOW .2N 01320I 34 352BMSCRP 01330I* ISSUE CODE 2A 01340I* PT = PULL TIME 01350I* OR = ON REQUEST 01360I* BI = BULK ISSUE 01370I* AR = AS REQUIRED 01380I* RA = REF ASSY 01390I* TD = TRAV DOC 01400I* SD = SHIP DOC 01410I* RD = REF DOC 01420I* VS = VENDOR SUPPLIED 01430I 36 37 BMISSU 01440I* EFFECTIVITY. 01450I* BEGIN CHANGE LEVEL 2A 01460I 38 39 BMBCHG 01470I* ENDING CHANGE LEVEL 2A 01480I 40 41 BMECHG 01490I* BEGIN ECN # 5A 01500I 42 46 BMBECN ÐÐ01510I* ENDING ECN # 5A 01520I 47 51 BMEECN 01530I* DISPOSITION CODE 1A 01540I 52 52 BMDISP 01550I* FILLER 5A 53 57 FFFFFF 01560I* ROUTING. 01570I* OPER NO. 5P 01580I P 58 600BMOPER 01590I* DEPT NO. 5P 01600I P 61 630BMDEPT 01610I* WORK CENTER NO. 3P 01620I P 64 650BMWC 01630I* COMPONENT OPER REFERENCE INFO 10A 01640I 66 75 BMREF 01650I* FILLER 76 85 FFFFFF 01660I* RECORD STATUS 1A 01670I* D = DELETED 01680I 86 86 BMSTAT 01690I******************************************************************** 01700IMGFILE MG 01710I* MESSAGE FILE. 01720I* TEXT 35A 01730I 1 35 MGTEXT 01740I* LINE-2 35A 01750I 36 70 MGLIN2 ÐÐ01760I* PROG NAME 5A 01770I 71 75 MGPROG 01780C******************************************************************** 01790C* INITIALIZE (1-TIME). 01800C EXSR SR101 INIT. 01810C MOVE ' ' BLK6 6 01820C*------------------------------------------------------------------- 01830C START TAG 01840C* CLEAR CRT - PUT HEADING. 01850C Z-ADD0 COUNT 30 01860C EXSR SR70 CLEAR SCREEN 01870C*------------------------------------------------------------------- 01880C READ TAG 01890C* READ ASSY #. 01900C SETOF 909693 01910C Z-ADD286 M 01920C EXSR SR73 PROMPT. 01930C SETOF 75 01940C EXSR SR75 READ ASSY. 01950C 93 GOTO START 01960C 96 EXSR SR73 PUT ERR MSG 01970C 96 GOTO READ 01980C N77 GOTO READ 01990C EXSR SR102 R.JUSTIFY 02000C MOVE W12A NAPN 100 ASSY PART NO. ÐÐ02010C MOVE BLK12 W12A 12 02020C MOVELNAPN W12A PMMST2KEY 02030C EXSR SR81 GET PMMST. 02040C N60 GOTO SETUP GOT IT. 02050C*------------------------------------------------------------------ 02060C READER TAG 02070C* FLAG NO MAST ERROR. 02080C Z-ADD302 M 50 96 02090C M CHAINMGFILE 54 02100C EXSR SR73 PUT MSG 02110C GOTO READ 02120C*------------------------------------------------------------------- 02130C SETUP TAG 02140C* SAVE ASSY DATA. 02150C MOVE PMPN TAPN 12 02160C MOVE PMDESC ADESC 29 02170C MOVE PMMODL AMODL 12 02180C MOVE PMPROV APROV 1 02190C MOVE PMSC ASC 2 02200C MOVE PMISSU AISSU 2 02210C MOVE PMPL APL 40 02220C MOVE PMECHG AECHG 2 02230C MOVE PMECN AECN 5 02240C* PUT ASSY DATA TO CRT. 02250C PMPROV LOKUPTABPC TABPCN 40 ÐÐ02260C PMISSU LOKUPTABIC TABICN 41 02270C PMSC LOKUPTABSC TABSCN 42 02280C EXSR SR71 PUT HEADING. 02290C MOVELNAPN W20A 20 02300C MOVE ZERO10 W20A 02310C*--------------------------------------------------------------- 02320C SETLIM TAG 02330C W20A SETLLBMMAST 02340C*------------------------------------------------------------------- 02350C CHASE TAG 02360C* GET NEXT BILL MATL RECORD. 02370C SETOF 54 02380C READ BMMAST 54 GET BMMAST. 02390C 54 GOTO ENDASY PROG ERROR. 02400C BMAPN COMP NAPN 54 02410C N54 GOTO ENDASY 02420C BMSTAT COMP 'D' 54 02430C 54 GOTO CHASE 02440C* GET COMPONENT PART MASTER. 02450C MOVE BLK12 W12A 02460C MOVELBMCPN W12A 02470C EXSR SR81 GET PMMST2 02480C 60 GOTO READER ERROR 02490C* PUT TO CRT. 02500C MOVELBMCPN NUMPN 100 ÐÐ02510C EXSR SR72 PUT CMPNT DATA. 02520C*------------------------------------------------------------------- 02530C ENDPAG TAG 02540C* SEE IF END OF PAGE. 02550C 50 COUNT COMP 24 54 54 02560C N50 COUNT COMP 31 54 54 LINE #. 02570C N54 GOTO CHASE NOT EOP. 02580C Z-ADD320 M 02590C EXSR SR73 02600C EXSR SR75 READ. 02610C 93 GOTO START NEW ASSY. 02620C EXSR SR71 PUT HEADINGS 02630C N77 GOTO CHASE NO INPUT 02640C*------------------------------------------------------------- 02650C NEWLIM TAG 02660C* SET NEW COMPONENT AS LOWER LIMIT, SAME ASSY. 02670C EXSR SR102 R. JUSTIFY 02680C MOVE W12A W10A 10 COMPNT PART # 02690C MOVE W10A W20A 02700C MOVELNAPN W20A ASSY PN 02710C GOTO SETLIM SET LOWER LIMIT 02720C*------------------------------------------------------------------- 02730C ENDASY TAG 02740C* PUT END OF ASSY MSG. 02750C Z-ADD317 M ÐÐ02760C EXSR SR73 PUT MSG. 02770C EXSR SR75 READ 02780C N77 GOTO START NO INPUT 02790C GOTO NEWLIM NEW COMPONENT 02800C*------------------------------------------------------------------- 02810C ERROR TAG 02820C EXSR SR73 PUT ERR MSG 02830C GOTO READ 02840C*------------------------------------------------------------------- 02850C MENU TAG 02860C EXSR SR96 GET CRTFILE 02870C Z-ADD1 W 02880C BLK6 LOKUPLNK,W 54 02890C 54 MOVELLNK,W PROG 8 02900C 54 MOVE BLK6 LNK,W 02910C N54 MOVEL'CONTU' PROG 02920C EXSR SR97 UPD CRTFILE 02930C EXSR SR98 >>>>>>>>>> 02940C*------------------------------------------------------------------- 02950C GOODBY TAG 02960C MOVEL'GOODBY' PROG 02970C GOTO END 02980C*------------------------------------------------------------------- 02990C END TAG 03000C EXSR SR96 GET CRTFILE ÐÐ03010C EXSR SR97 UPD CRTFILE 03020C EXSR SR98 >>>>>>>>>> 03030C*------------------------------------------------------------------- 03040C ENDJOB TAG 03050C MOVEL'ENDJOB 'PROG 8 03060C EXSR SR98 >>>>>>>>>> 03070C******************************************************************** 03080CSR SR69 BEGSR 03090CSR 50 EXITFZPUTXY 03100CSR RLABL RPGLIN 03110CSR RLABL RPGCOL 03120CSRN50 EXITFZMOVXY 03130CSR RLABL RPGLIN 03140CSR RLABL RPGCOL 03150CSR ENDSR 03160C******************************************************************** 03170CSR SR70 BEGSR 03180C* CLEAR CRT. 03190CSR 50 EXITFZISTAT 03200CSR 50 EXITFZESCH 03210CSRN50 EXITFZCPAGE 03220CSRN50 MOVEL'091' RPGLIN 4 03230CSRN50 MOVEL'001' RPGCOL 4 03240CSRN50 EXSR SR69 03250CSR ENDSR ÐÐ03260C******************************************************************** 03270CSR SR71 BEGSR 03280C* PUT HEADINGS - CLEAR CRT. 03290CSR EXSR SR70 CLEAR SCREEN 03300CSR SETON 71 03310CSR EXCPT CLEAR CRT. 03320CSR SETOF 71 03330CSR Z-ADD9 COUNT 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR72 BEGSR 03370C* PUT DATA LINE. 03380CSR 90 ADD COUNT W3N 30 03390CSR 50 W3N SUB 90 W3N 03400CSR MOVELW3N RPGLIN 4 03410CSR MOVEL'001' RPGCOL 4 03420CSR EXSR SR69 MOVE CURSOR 03430CSR PMMODL COMP BLK12 54 03440CSR 54 MOVE BLK35 PMDESC 03450CSR 54 MOVELPMMODL PMDESC 03460CSR 54 MOVE '***' PMDESC 03470CSR 1 ADD COUNT COUNT 03480CSR SETON 72 03490CSR EXCPT 03500CSR SETOF 72 ÐÐ03510CSR ENDSR 03520C******************************************************************** 03530CSR SR73 BEGSR 03540C* PUT MSG TO CRT. 03550CSR M CHAINMGFILE 54 GET MSG. 03560CSR 99 MOVELPRGERR MGTEXT 03570CSR EXSR SR74 PUT MSG. 03580CSR ENDSR 03590C******************************************************************** 03600CSR SR74 BEGSR 03610C* PUT MSG TO CRT. 03620CSR SETON 74 03630CSR EXCPT PUT MSG. 03640CSR SETOF 74 03650CSR ENDSR 03660C******************************************************************** 03670CSR SR75 BEGSR 03680C* READ CRT. 03690CSR SETOF 909693 03700CSR SETOF 9477 03710C*------------------------------------------------------------------- 03720CSR T75A TAG 03730CSR MOVE BLK12 W12A 12 03740CSR EXITFZR12 03750CSR RLABL W12A ÐÐ03760CSR MOVEAW12A A12 03770CSR MOVE BLK12 W12A 03780CSR Z-ADD1 W 20 03790CSR '\' LOKUPA12,W 90 03800CSRN90 GOTO T75B NOT ESCAPE. 03810CSR 1 ADD W W 03820CSR W COMP 12 55 03830CSR 55 GOTO T75E 03840CSR A12,W COMP 'G' 98 03850CSR A12,W COMP 'N' 93 NEW ASSY. 03860CSR A12,W COMP 'E' 94 EXIT. 03870CSR 98 GOTO GOODBY 03880CSR 94 GOTO MENU 03890CSR 93 GOTO END75 03900CSR GOTO T75E BAD ESC CODE 03910C*------------------------------------------------------------------- 03920CSR T75B TAG 03930CSR Z-ADD1 W 03940CSR ' ' LOKUPA12,W 77 03950CSRN77 GOTO END75 NO DATA INPUT. 03960CSR MOVEAA12,W W12A INPUT DATA. 03970CSR GOTO END75 03980C*------------------------------------------------------------------- 03990CSR T75E TAG 04000C* FLAG BAD ESCAPE. ÐÐ04010CSR Z-ADD318 M 96 04020CSR END75 ENDSR 04030C******************************************************************** 04040CSR SR81 BEGSR 04050C* GET PART MAST. 04060CSR MOVE ' ' W12A 04070CSR W12A CHAINPMMST2 60 04080CSRN60 PMSTAT COMP 'D' 60 04090CSR ENDSR 04100C******************************************************************** 04110CSR SR96 BEGSR 04120CSR # CHAINCRTFILE H9 GET CRTFILE 04130CSR H9 GOTO ENDJOB 04140CSR ENDSR 04150C******************************************************************** 04160CSR SR97 BEGSR 04170C* UPDATE CRTFILE. EXIT PROGRAM. 04180CSR TIME CRTIME 04190CSR MOVELUDATE CRDATE 04200CSR SETON 97 04210CSR EXCPT UPD CRTFILE 04220CSR SETOF 97 04230CSR ENDSR 04240C******************************************************************** 04250CSR SR98 BEGSR ÐÐ04260CSR EXSR SR70 CLEAR SCREEN 04270CSR EXITFCHAIN >>>>>>>>>> 04280CSR RLABL PROG 04290CSR ENDSR 04300C******************************************************************** 04310CSR SR101 BEGSR 04320C* 1-TIME INITIALIZE. 04330CSR MOVE BIT,1 NUL 04340CSR MOVE ' ' BLK12 12 04350CSR MOVE ' ' BLK35 35 04360CSR Z-ADD0 ZERO10 100 04370CSR MOVE ' ' W2A 2 04380CSR EXITFZGMINX GET TERM # 04390CSR RLABL W2A 04400CSR MOVE W2A # 20 04410CSR # COMP 0 54 04420CSRN54 Z-ADD25 # 04430CSR EXSR SR96 GET CRTFILE 04440CSR MOVE CALL LNK 04450CSR MOVEL'Q103BM 'PROG 04460CSR PAR,# COMP '1' 50 04470CSR TST,# COMP 'S' 54 04480CSR 54 MOVE 'SHUTDOWN'PROG 04490CSR EXSR SR97 UPD CRTFILE 04500CSR 54 EXSR SR98 >>>>>>>>>> ÐÐ04501CSR MOVE ' 'PROG 04510CSR ENDSR 04520C**************************************************************** 04530CSR SR102 BEGSR 04540C* R. JUSTIFY SR75 INPUT FIELD 04550CSR Z-ADD12 W2N 20 04560CSR EXIT SUBRAJ R.JUSTIFY 04570CSR RLABL W2N 04580CSR RLABL W12A 04590CSR ENDSR 04600C******************************************************************** 04610CSR SR902 BEGSR 04620C* FLAG PROGRAM ERROR. 04630CSR SETON 9699 04640CSR Z-ADDM PRGERR 30 04650CSR Z-ADD319 M 04660CSR EXSR SR73 04670CSR ENDSR 04680O******************************************************************** 04690OTERM132 E 74 1254004700O* PUT MSG TO CRT 1255004710O NUL 132 04720O MGTEXT 35 04730O 37 ' ' 04740O*------------------------------------------------------------------- ÐÐ04750O E 71 04760O* PUT HEADINGS 04770O BIT,28 1 04780O N50 8 '8091001' 04790O N50 BIT,1 9 04800O N50 BIT,1 10 04810O 50 10 '[001 ]001' 04820O 50 BIT,28 6 04830O UDATE 18 ' - - ' 04840O 85 'SINGLE LEVEL PARTS LIST ' 04850O E 71 04860O 127 'CHG LAST' 04870O E 71 04880O 10 'ASSY-PART#' 04890O 34 '<-------DESCRIPTION' 04900O 43 '-------->' 04910O 56 'MODEL-NAME' 04920O 70 'SOURCE-CODE' 04930O 82 'ISSUE-CODE' 04940O 101 'PROVISIONING-CODE' 04950O 114 'PROD-LINE' 04960O 126 'LEV ECN' 04970O E 71 04980O* PUT ASSY DATA LINES 04990O NAPN 12 ' - - ' ÐÐ05000O ADESC 43 05010O AMODL 57 05020O ASC 61 05030O AISSU 73 05040O APROV 84 05050O APL Z 111 05060O AECHG 120 05070O AECN 128 05080O E 71 05090O 42 TABSCN 69 05100O 41 TABICN 86 05110O 40 TABPCN 104 05120O E 71 05130O NUL 132 05140O E 71 05150O 4 'ITEM' 05160O 15 'COMPONENT' 05170O 59 'QUANTITY' 05180O 80 'SOURCE ISSUE ENG' 05190O 88 'SCRAP' 05200O 111 '<-----ROUTING------->' 05210O 127 '<--E.C.N.--->' 05220O E 71 05230O 3 'NO' 05240O 14 'PART-NO' ÐÐ05250O 39 '<-------DESCRIPTION' 05260O 49 '--------->' 05270O 59 'PER-ASSY' 05280O 63 'UM' 05290O 69 'CODE' 05300O 75 'CODE' 05310O 81 'STD ' 05320O 88 'ALLOW' 05330O 94 'OPER' 05340O 100 'DEPT' 05350O 111 'REFERENCE' 05360O 119 'START' 05370O 127 'STOP' 05380O E 72 05390O* PUT COMPONENT DATA LINE. 05400O BMITNOZ 3 05410O NUMPN 18 ' - - ' 05420O PMDESC 49 05430O BMQTY 2 59 05440O PMUM 63 05450O PMSC 68 05460O BMISSU 74 05470O PMSTDC 79 05480O BMSCRP2 86 05490O 87 '%' ÐÐ05500O BMOPERZ 94 05510O BMDEPTZ 100 05520O BMREF 112 05530O BMBECN 118 05540O BMBCHG 121 05550O BMEECN 128 05560O BMECHG 131 05570O******************************************************************** 05580OCRTFILE E 97 05590O PROG 26 05600O CRTIME 33 05610O CRDATE 37 05620O LNK 79 ** A12 ARRAY 005630 005640** NUL ARRAY 005650 005660** TABIC/TABICN VALID ISSUE CODES 005670PTPULL TIME 005680ORON REQUEST 005690BIBULK ISSUE 005700ARAS REQD 005710VSVENDOR SUPL'D 005720SDSHIPPING DOCUMENT 005730TDTRAVELER DOCUMENT 005740ÐÐRDREF DOC ONLY 005750RAREF ASSY/PART 005760** TABSC/TABSCN VALID SOURCE CODES 005770MAMFG ASSY 005780MPMFG PART 005790PAPURCH ASSY 005800PPPURCH PART 005810RDREF DOC ONLY 005820RSRAW STOCK 005830** TABPC/TABPCN VALID PROVISION CODES 005840AFRCST,NO VAL ADDED 005850BFRCST,VAL IS ADDED 005860CBLD/ORD,NO VAL ADDED 005870DBLD TO ORD,VAL ADDED 005880ECUSTOM 005890YOBSLT, REPAIRABLE 005900ZOBSLT,NOT REPAIR 005910** LNK ARRAY 005920 05930/* 05940_‚ ÐÐ_‚_‚F DOC ONLY 005750RAREF ASSY/PART 005760** TABSC/TABSCN VALID SOURCE CODES 005770MAMFG ASSY 005780MPMFG PART 005790PAPURCH ASSY 005800PPPURCH PART 005810RDREF DOC ONLY 005820RSRAW STOCK 005830** TABPC/TABPCN VALID PROVISION CODES 005840AFRCST,NO VAL ADDED 005850BFRCST,VAL IS ADDED 005860CBLD/ORD,NO VAL ADDED 005870DBLD TO ORD,VAL ADDED 005880ECUSTOM 005890YOBSLT, REPAIRABLE 005900ZOBSLT,NOT REPAIR 005910** LNK ARRAY 005920 05930/* 05940_‚ ÐÈ(4ó 4kX100T1 P120282120282(èÈÐ00010H S Q100T100020F* 132-COL TEXT FILE UPDATE. (X100TX) 00030F* REVISED 8/14/80 9:55 AM. 00040FBITHEX UP F 256 DISK 00050FMGFILE IC F 80R DISK 00060FTXMAST UC F 288R 8AI 1 DISK A 00070FTXPTR UC F 100R DISK 00080FTXFILE UC F 135R DISK 00090FTXAVAIL UC F 200R DISK 00100FTXCOPY UC F 402R DISK 00110E******************************************************************** 00120E A132 1 132 1 A 00130E FROM 1 132 1 A 00140E TOR 1 132 1 A 00150E BAT 1 132 1 00160E CRT 1 132 1 00170E ARA 1 132 1 WORK ARRAY 00180E ARB 1 132 1 WORK ARRAY 00190E BIT 256 1 00200E REC 132 1 A 00210E BLK 100 3 0A 00220E PAG 100 1 A 00230E NAB 200 1 00240E CPY 100 7 0A 00250I******************************************************************** ÐÐ00260IBITHEX BT 00270I 1 256 BIT 00280I******************************************************************** 00290IMGFILE MG 00300I 1 60 MGTEXT 00310I******************************************************************** 00320ITXMAST TM 00330I* TEXT MASTER. 00340I* TEXT NAME 8A 00350I 1 8 TMNAME 00360I* TEXT TITLE 60A 00370I 9 68 TMTITL 00380I* TEXT TYPE 1A 00390I 69 69 TMTYPE 00400I* PTR BLOCKS ASSIGNED 3P X 100 00410I P 88 287 BLK 00420I* RECORD STATUS 1A 00430I 288 288 TMSTAT 00440I******************************************************************** 00450ITXPTR TP 00460I* TEXT POINTER FILE. 00470I* REL RECORD STATUS 1A X 100 00480I* Y = RECORD ALLOCATED 00490I* N = RECORD NOT IN USE 00500I 1 100 PAG ÐÐ00510I******************************************************************** 00520ITXFILE TX 00530I* TEXT FILE. 00540I* TEXT DATA 1A X 132 00550I 1 132 REC 00560I* TEXT TYPE 1A 00570I* H = HEADING C = TABLE CONTENTS 00580I* T = TEXT X = INDEX 00590I* F = FOOTNOTE 00600I 133 133 TXTYPE 00610I* HEADING/FOOTNOTE LINE # 1N 00620I 134 1340TXLINE 00630I* SPACE CODE 1A 00640I* 1-3 = SPACE LINES BEFORE PRINT 00650I* S = SKIP NEW PAGE 00660I 135 135 TXSPAC 00670I******************************************************************** 00680ITXAVAIL TA 00690I* TEXT AVAIL FILE (UNUSED BLOCKS) 00700I* AVAIL BLOCKS 1A X 200 00710I* 'N' = BLK IS AVAIL 00720I* 'Y' = BLK IS NOT AVAIL 00730I 1 200 NAB 00740I******************************************************************** 00750ITXCOPY TC ÐÐ00760I* TEXT COPY WORK FILE 00770I* TERMINAL NUMBER 2N 00780I 1 20TCPORT 00790I* COPY PTR ARRAY 7P X 100 00800I P 3 402 CPY 00810C******************************************************************** 00820C* INITIALIZE 1-TIME. 00830C EXSR SR101 INIT 00840C*------------------------------------------------------------------- 00850C START TAG 00860C* PUT MENU. 00870C EXSR SR102 SETOFFS 00880C N27 EXSR SR103 PUT MENU 00890C*------------------------------------------------------------------- 00900C TAG5 TAG 00910C* REQUEST SELECTION AND BRANCH 00920C EXSR SR616 MOV NAME TO KEY 00930C 40 00940COR 44 EXSR SR400 UPD/GET TXMAST 00950C 41 EXSR SR404 UPDATE TXPTR 00960C EXSR SR102 SETOFFS 00970C N27 MOVE 'G' INSTR 00980C N27 GOTO TAG10 1ST GET 00990C EXSR SR104 RQST SELECTION 01000C 94 GOTO START ESC BKWD ÐÐ01010C 90 GOTO ESCAPE ESC OTHER 01020C 55 GOTO TAG10 GET 01030C 56 GOTO TAG20 ADD 01040C 57 GOTO TAG30 DELETE 01050C 58 GOTO TAG40 LIST 01060C 59 GOTO TAG50 REPLACE 01070C 60 GOTO TAG60 SEQ 01080C 61 GOTO TAG70 FIND 01090C 62 GOTO TAG80 COPY 01100C 63 GOTO TAG90 TAB-SET 01110C 64 GOTO TAG100 MOVE TEXT 01120C 65 GOTO TAG110 LINE CONTROL ONLY 01130C Z-ADD241 M 50 01140C EXSR SR455 FLAG ERROR 01150C GOTO TAG5 01160C*------------------------------------------------------------------- 01170C TAG10 TAG 01180C* GET TEXT. 01190C EXSR SR105 RQST NAME 01200C 90 GOTO ESCAPE 01210C*------------------------------------------------------------------- 01220C TAG11 TAG 01230C EXSR SR106 RQST TITLE 01240C 94 GOTO TAG10 01250C 90 GOTO ESCAPE ÐÐ01260C*------------------------------------------------------------------- 01270C TAG12 TAG 01280C EXSR SR107 RQST TYPE 01290C 94 GOTO TAG11 01300C 90 GOTO ESCAPE 01310C EXSR SR616 NAME TO KEY 01320C EXSR SR400 GET TXMAST 01330C SETON 27 1ST GET DONE FLAG 01340C GOTO TAG5 01350C*------------------------------------------------------------------- 01360C TAG20 TAG 01370C* ADD TEXT. 01380C EXSR SR108 RQST START 01390C 90 GOTO ESCAPE 01400C*------------------------------------------------------------------- 01410C TAG21 TAG 01420C EXSR SR110 RQST INCREMENT 01430C 94 GOTO TAG20 01440C 90 GOTO ESCAPE 01450C EXSR SR117 RQST LINE OPTION 01460C 94 GOTO TAG21 01470C 90 GOTO ESCAPE 01480C EXSR SR201 ADD TEXT 01490C 90 GOTO ESCAPE 01500C GOTO TAG5 ÐÐ01510C*------------------------------------------------------------------- 01520C TAG30 TAG 01530C* DELETE TEXT. 01540C EXSR SR108 RQST START 01550C 90 GOTO ESCAPE 01560C*------------------------------------------------------------------- 01570C TAG31 TAG 01580C EXSR SR109 RQST END 01590C 94 GOTO TAG30 01600C 90 GOTO ESCAPE 01610C EXSR SR203 DELETE TEXT 01620C 90 GOTO ESCAPE 01630C GOTO TAG5 01640C*------------------------------------------------------------------- 01650C TAG40 TAG 01660C* LIST TEXT. 01670C EXSR SR108 RQST START 01680C 90 GOTO ESCAPE 01690C*------------------------------------------------------------------- 01700C TAG41 TAG 01710C EXSR SR109 RQST END 01720C 94 GOTO TAG40 01730C 90 GOTO ESCAPE 01740C EXSR SR204 LIST TEXT 01750C 90 GOTO ESCAPE ÐÐ01760C GOTO TAG5 01770C*------------------------------------------------------------------- 01780C TAG50 TAG 01790C* REPLACE TEXT. 01800C EXSR SR108 RQST START 01810C 90 GOTO ESCAPE 01820C*---------------------------------------------------------------- 01830C TAG51 TAG 01840C EXSR SR109 RQST END 01850C 94 GOTO TAG50 01860C 90 GOTO ESCAPE 01870C*------------------------------------------------------------------- 01880C TAG52 TAG 01890C EXSR SR111 RQST SEARCH OPTION 01900C 94 GOTO TAG51 01910C 90 GOTO ESCAPE 01920C*------------------------------------------------------------------- 01930C TAG53 TAG 01940C EXSR SR112 RQST FROM DATA 01950C 94 GOTO TAG52 01960C 90 GOTO ESCAPE 01970C*------------------------------------------------------------------- 01980C TAG54 TAG 01990C EXSR SR113 RQST CHG-TO DATA 02000C 94 GOTO TAG53 ÐÐ02010C 90 GOTO ESCAPE 02020C EXSR SR920 REPLACE TEXT 02030C 90 GOTO ESCAPE 02040C GOTO TAG5 02050C*------------------------------------------------------------------- 02060C TAG60 TAG 02070C* RESEQ TEXT. 02080C EXSR SR108 RQST START 02090C 90 GOTO ESCAPE 02100C*------------------------------------------------------------------- 02110C TAG61 TAG 02120C EXSR SR109 RQST END 02130C 94 GOTO TAG60 02140C 90 GOTO ESCAPE 02150C*------------------------------------------------------------------- 02160C TAG62 TAG 02170C EXSR SR110 RQST INCREMENT 02180C 94 GOTO TAG61 02190C 90 GOTO ESCAPE 02200C EXSR SR206 RESEQ TEXT 02210C 90 GOTO ESCAPE 02220C GOTO TAG5 02230C*------------------------------------------------------------------- 02240C TAG70 TAG 02250C* SEARCH TEXT. ÐÐ02260C EXSR SR108 RQST START 02270C 90 GOTO ESCAPE 02280C*------------------------------------------------------------------- 02290C TAG71 TAG 02300C EXSR SR109 RQST END 02310C 94 GOTO TAG70 02320C 90 GOTO ESCAPE 02330C*------------------------------------------------------------------- 02340C TAG72 TAG 02350C EXSR SR111 RQST SEARCH OPTION 02360C 94 GOTO TAG71 02370C 90 GOTO ESCAPE 02380C*------------------------------------------------------------------- 02390C TAG73 TAG 02400C EXSR SR112 RQST SEARCH DATA 02410C 94 GOTO TAG72 02420C 90 GOTO ESCAPE 02430C EXSR SR920 SEARCH TEXT 02440C 90 GOTO ESCAPE 02450C GOTO TAG5 02460C*------------------------------------------------------------------- 02470C TAG80 TAG 02480C* COPY TEXT. 02490C EXSR SR114 RQST COPY FROM NAME 02500C 90 GOTO ESCAPE ÐÐ02510C*------------------------------------------------------------------- 02520C TAG81 TAG 02530C EXSR SR108 RQST START 02540C 94 GOTO TAG80 02550C 90 GOTO ESCAPE 02560C*------------------------------------------------------------------- 02570C TAG82 TAG 02580C EXSR SR109 RQST END 02590C 94 GOTO TAG81 02600C 90 GOTO ESCAPE 02610C*------------------------------------------------------------------- 02620C TAG83 TAG 02630C EXSR SR115 RQST COPY-TO LINE 02640C 94 GOTO TAG82 02650C 90 GOTO ESCAPE 02660C EXSR SR110 RQST INCREMENT 02670C 94 GOTO TAG83 02680C 90 GOTO ESCAPE 02690C EXSR SR208 COPY TEXT 02700C 90 GOTO ESCAPE 02710C GOTO TAG5 02720C*------------------------------------------------------------------- 02730C TAG90 TAG 02740C* SET-TAB STOPS. 02750C EXSR SR209 SET-TABS. ÐÐ02760C 90 GOTO ESCAPE 02770C GOTO TAG5 02780C*------------------------------------------------------------------- 02790C TAG100 TAG 02800C* MOVE TEXT. 02810C EXSR SR108 RQST START LINE 02820C 90 GOTO ESCAPE 02830C*------------------------------------------------------------------- 02840C TAG102 TAG 02850C EXSR SR109 RQST END LINE 02860C 94 GOTO TAG100 02870C 90 GOTO ESCAPE 02880C*------------------------------------------------------------------- 02890C TAG104 TAG 02900C EXSR SR118 RQST FROM COL 02910C 94 GOTO TAG102 02920C 90 GOTO ESCAPE 02930C*------------------------------------------------------------------- 02940C TAG106 TAG 02950C EXSR SR119 RQST TO COL 02960C 94 GOTO TAG104 02970C 90 GOTO ESCAPE 02980C EXSR SR205 MOVE DATA 02990C 90 GOTO ESCAPE 03000C GOTO TAG5 ÐÐ03010C*---------------------------------------------------------- 03020C TAG110 TAG 03030C* UPDATE LINE CONTROL ONLY 03040C EXSR SR108 REQUEST LINE# 03050C 90 GOTO ESCAPE 03060C Z-ADDSTART LINENO 03070C EXSR SR400 GET TXMAST 03080C EXSR SR300 CALC B & P INDEX 03090C EXSR SR612 CHK BLOCK # 03100C N54 GOTO TAG112 ERROR 03110C EXSR SR403 GET TXPTR 03120C EXSR SR618 CHK ACTIVE LINE 03130C N54 GOTO TAG112 ERROR 03140C EXSR SR301 CALC RRN 03150C EXSR SR405 GET TXFILE 03160C MOVE TXTYPE TYPE 03170C MOVE TXLINE HLINE 03180C MOVE TXSPAC SPACE 03190C EXSR SR116 REQUEST LINE CONTRL 03200C 94 GOTO TAG110 BKWD ESC 03210C 90 GOTO ESCAPE 03220C EXSR SR406 UPDATE TXFILE 03230C GOTO TAG110 DO AGAIN 03240C*------------------------------------------------------------------ 03250C TAG112 TAG ÐÐ03260C Z-ADD106 M 03270C EXSR SR455 FLAG ERROR 03280C GOTO TAG110 REPEAT 03290C*----------------------------------------------------------------- 03300C ESCAPE TAG 03310C 97 GOTO START 03320C 98 GOTO MENU 03330C 99 GOTO GOODBY 03340C GOTO TAG5 03350C*------------------------------------------------------------------- 03360C MENU TAG 03370C MOVEL'QQTX01' PROG 8 03380C GOTO END 03390C*------------------------------------------------------------------- 03400C GOODBY TAG 03410C MOVEL'GOODBY' PROG 03420C*------------------------------------------------------------------- 03430C END TAG 03440C 44 03450COR 40 EXSR SR401 UPD TXMAST 03460C 41 EXSR SR404 UPD TXPTR 03470C EXSR SR408 UPD TXAVAIL 03480C EXITFCHAIN 03490C RLABL PROG 03500C*------------------------------------------------------------- ÐÐ03510C ENDJOB TAG 03520C******************************************************************** 03530C* ESCAPE INDICATORS. 03540C* 90 GENERAL 94 BACKWARD-SKIP 03550C* 91 LINE-FEED (TAB) 96 NEW ITEM 03560C* 92 REPEAT 97 LOCAL MENU 03570C* 93 DONE 98 SYSTEM MENU 03580C* 94 BACKWARD-TAB 99 GOODBY 03590C******************************************************************** 03600CSR SR70 BEGSR 03610C* PUT LINE TO CRT. 03620CSR MOVEACRT BUFOUT132 03630CSRN30 EXSR SR501 CR-ONLY 03640CSR EXITFQW132 PUT CRT 03650CSR RLABL BUFOUT 03660CSR ENDSR 03670C******************************************************************** 03680CSR SR71 BEGSR 03690C* PROMPT - CURSOR 120,37. 03700CSR MOVEAMGTEXT CRT,1 03710CSR MOVEAW60A CRT,60 03720CSRN33 EXSR SR502 LFCR 03730CSR SETOF 33 03740CSR EXSR SR70 PUT 03750CSR MOVE '120037' W6A ÐÐ03760CSR EXSR SR500 POSITION CURSOR 03770CSR ENDSR 03780C******************************************************************** 03790CSR SR72 BEGSR 03800C* PROMPT - 03810CSR EXSR SR603 INIT CRT ARRAY 03820CSR MOVEAMGTEXT CRT,1 03830CSR EXSR SR502 LFCR 03840CSR EXSR SR70 PUT 03850CSR EXSR SR502 LFCR 03860CSR ENDSR 03870C******************************************************************** 03880CSR SR73 BEGSR 03890C* ERR MSG - 03900CSR EXSR SR603 INIT CRT 03910CSR MOVEAMGTEXT CRT,1 03920CSR EXSR SR502 LFCR 03930CSR EXSR SR70 PUT 03940CSR ENDSR 03950C******************************************************************** 03960CSR SR74 BEGSR 03970C* PUT TEXT LINE. 03980CSR MOVEAREC CRT 03990CSR Z-ADDLINENO W5N 50 04000CSR EXSR SR611 Z-EDIT ÐÐ04010CSR MOVE W5A W4A 4 04020CSR Z-ADD129 X 04030CSR MOVEAW4A CRT,X 04040CSR EXSR SR70 PUT CRT 04050CSR ENDSR 04060C******************************************************************** 04070CSR SR101 BEGSR 04080C* 1-TIME INIT. 04090CSR MOVE '120001' W6A 04100CSR EXSR SR500 MOVE CURSOR 04110CSR Z-ADD9999 LLIMIT 50 LINE LIMIT 04120CSR Z-ADD20000 RLIMIT 50 RECORD LIMIT 04130CSR LLIMIT DIV 100 BLIMIT 30 BLK LIMIT 04140CSR RLIMIT DIV 100 NLIMIT 30 TXAVAIL LIMIT 04150CSR Z-ADDBLIMIT SLIMIT 50 TXRESEQ LIMIT 04160CSR Z-ADD100 PLIMIT 30 PAG LIMIT 04170CSR MOVELBIT,1 BUFLGT 2 READ BUF LGTH 04180CSR Z-ADD133 X 04190CSR MOVE BIT,X BUFLGT 04200CSR MOVE ' ' W8A 8 04210CSR Z-ADD0 W2N 20 04220CSR Z-ADD0 W1N 10 04230CSR MOVE ' ' W2A 2 04240CSR EXITFPGMINX GET PORT # 04250CSR RLABL W8A ÐÐ04260CSR RLABL W2N 04270CSR RLABL W1N 04280CSR RLABL W2A 04290CSR MOVE W2A PORT 20 04300CSR PORT COMP 0 54 04310CSRN54 Z-ADD25 PORT 04320CSR Z-ADD1 N 30 04330CSR MOVE ' ' BLK132132 04340CSR MOVE ' ' BLK8 8 04350CSR Z-ADD0 ZERO3 30 04360CSR Z-ADD0 ZERO5 50 04370CSR Z-ADD0 ZERO7 70 04380CSR MOVE ' ' BAT 04390C* SET TAB STOPS AT EVERY COL ON CRT. 04400CSR Z-ADD1 X 04410CSR MOVELBIT,28 W2A 2 04420CSR MOVE '1' W2A 04430CSR MOVELW2A W3A 3 04440CSR MOVE ' ' W3A 04450C*------------------------------------------------------------------- 04460CSR T101 TAG 04470CSR MOVEAW3A CRT,X 04480CSR 3 ADD X X 04490CSR EXSR SR606 COMP 132 04500CSRN54 GOTO T101 ÐÐ04510CSR EXSR SR502 04520CSR SETON 30 04530CSR EXSR SR70 04540CSR EXSR SR70 04550CSR EXSR SR70 04560CSR SETOF 30 04570C* SET TAB DEFAULT. 04580CSR Z-ADD0 X 30 04590CSR Z-ADD234 A 04600CSR MOVE BIT,A BAT 04610CSR MOVE 'X' BAT,1 04620C*---------------------------------------------------------- 04630CSR T101A TAG 04640CSR 10 ADD X X 04650CSR MOVE 'X' BAT,X 04660CSR X COMP 122 54 04670CSRN54 GOTO T101A 04680CSR END101 ENDSR 04690C******************************************************************** 04700CSR SR102 BEGSR 04710C* SET-OFF HEAVY INDICATORS. 04720CSR SETOF 779091 04730CSR SETOF 929394 04740CSR SETOF 9697 04750CSR SETOF 9899 ÐÐ04760CSR ENDSR 04770C******************************************************************** 04780CSR SR103 BEGSR 04790C* PUT MENU. 04800CSR Z-ADD437 M 50 04810CSR Z-ADD0 X 30 04820CSR Z-ADD0 COUNT 30 04830CSR MOVE '120001' W6A 6 04840CSR EXSR SR500 POSITION CUROSR 04850C*------------------------------------------------------------------- 04860CSR T103A TAG 04870CSR EXSR SR411 GET MESSAGE 04880CSR EXSR SR73 PUT MSG 04890CSR 1 ADD M M 04900CSR 1 ADD X X 30 04910CSR X COMP 10 54 04920CSRN54 GOTO T103A 04930CSR ENDSR 04940C******************************************************************** 04950CSR SR104 BEGSR 04960C* REQUEST SELECTION. 04970CSR Z-ADD454 M 04980CSR EXSR SR605 INIT W60A 04990CSR EXSR SR451 PROMPT/READ 05000CSR 90 GOTO END104 ÐÐ05010CSR MOVELBUFIN INSTR 1 INSTRUCTION 05020CSR EXSR SR707 CLASSIFY INSTR 05030CSR END104 ENDSR 05040C******************************************************************** 05050CSR SR105 BEGSR 05060C* REQUEST TEXT NAME 05070CSR EXSR SR605 INIT W60A 05080CSR MOVE NAME W15A 15 05090CSR EXSR SR619 W15A L W60A 05100CSR Z-ADD155 M 05110CSR EXSR SR451 PROMPT/READ 05120CSR 90 GOTO END105 05130CSR MOVELBUFIN NAME 8 TEXT NAME 05140CSR EXSR SR616 NAME TO KEY 05150CSR EXSR SR400 GET TXMAST 05160CSR 60 MOVE BLK132 TMTITL 05170CSR 60 MOVE ' ' TMTYPE 05180CSR 60 MOVE 'A' TMSTAT 05190CSR 60 Z-ADD0 BLK 05200CSRN60 MOVE TMTITL TITLE 60 05210CSRN60 MOVE TMTYPE MTYPE 1 05220CSR END105 ENDSR 05230C******************************************************************** 05240CSR SR106 BEGSR 05250C* REQUEST TITLE. ÐÐ05260CSR Z-ADD52 M 05270CSR EXSR SR605 CLEAR W60A 05280CSR MOVE TITLE W60A 60 05290CSR EXSR SR450 PROMPT/READ 05300CSR 92 GOTO SR106 REPEAT ESC 05310CSR 90 GOTO END106 OTHER ESC 05320CSR ' ' LOKUPA132 54 05330CSR 54 MOVELBUFIN TITLE TEXT TITLE 05340CSR END106 ENDSR 05350C******************************************************************** 05360CSR SR107 BEGSR 05370C* REQUEST MASTER TYPE. 05380CSR Z-ADD461 M 05390CSR EXSR SR605 CLEAR W60A 05400CSR MOVE MTYPE W15A 05410CSR EXSR SR619 W15A L W60A 05420CSR EXSR SR450 PROMPT/READ 05430CSR MOVELBUFIN W1A TEXT TYPE 05440CSR W1A COMP ' ' 54 05450CSR 54N90 MOVE W1A MTYPE 05460CSR ENDSR 05470C******************************************************************** 05480CSR SR108 BEGSR 05490C* REQUEST START LINE NO. 05500CSR Z-ADD156 M ÐÐ05510CSR EXSR SR605 CLEAR W60A 05520CSR Z-ADDSTART W5N 50 05530CSR EXSR SR611 EDIT-Z 05540CSR EXSR SR617 W5A TO W60A 05550CSR EXSR SR451 PROMPT/READ 05560CSR 90 GOTO END108 05570CSR 77 EXSR SR701 R. ADJUST 05580CSR 77 MOVE W10A START 50 05590CSR START COMP 0 54 05600CSR 54 START COMP LLIMIT 5454 05610CSR 54 GOTO END108 05620CSR Z-ADD467 M 05630CSR EXSR SR455 FLAG ERROR 05640CSR GOTO SR108 05650CSR END108 ENDSR 05660C******************************************************************** 05670CSR SR109 BEGSR 05680C* REQUEST END LINE #. 05690CSR Z-ADD0 ENDLIN 05700CSR Z-ADD157 M 05710CSR EXSR SR605 CLEAR W60A 05720CSR Z-ADDENDLIN W5N 05730CSR EXSR SR611 EDIT-Z 05740CSR EXSR SR617 W5A TO W60A 05750CSR EXSR SR450 PROMPT/READ ÐÐ05760CSR 90 GOTO END109 05770CSR 77 EXSR SR701 R. ADJUST 05780CSR 77 MOVE W10A ENDLIN 50 END LINE # 05790CSR ENDLIN COMP 0 54 05800CSR 54 GOTO T109A 05810CSR EXSR SR707 05820CSR 57 05830COR 59 05840COR 60 05850COR 62 Z-ADDSTART ENDLIN DEFAULT 05860CSR 58 05870COR 61 Z-ADDLLIMIT ENDLIN DEFAULT 05880C*------------------------------------------------------------------- 05890CSR T109A TAG 05900CSR ENDLIN COMP START 55 55 05910CSR 55 ENDLIN COMP LLIMIT 5555 05920CSRN55 Z-ADD243 M 05930CSRN55 EXSR SR455 FLAG ERROR 05940CSRN55 GOTO SR109 05950CSR END109 ENDSR 05960C******************************************************************** 05970CSR SR110 BEGSR 05980C* REQUEST INCREMENT. 05990CSR Z-ADD455 M 06000CSR EXSR SR605 INIT W60A ÐÐ06010CSR Z-ADDINCRMT W5N 06020CSR EXSR SR611 EDIT-Z 06030CSR EXSR SR617 W5A TO W60A 06040CSR EXSR SR450 PROMPT/READ 06050CSR 90 GOTO END110 06060CSR 77 EXSR SR701 R. ADJUST 06070CSR 77 MOVE W10A INCRMT 30 INCREMENT 06080CSR INCRMT COMP 0 54 06090CSRN54 Z-ADD1 INCRMT 06100CSR END110 ENDSR 06110C******************************************************************** 06120CSR SR111 BEGSR 06130C* REQUEST SEARCH OPTION. 06140CSR Z-ADD468 M 06150CSR EXSR SR605 INIT W60A 06160CSR MOVE SOPTON W15A 06170CSR EXSR SR619 W15A L W60A 06180CSR EXSR SR450 PROMPT/READ 06190CSR 90 GOTO END111 06200CSR 77 MOVELBUFIN SOPTON 1 SEARCH OPTION 06210CSR SOPTON COMP ' ' 54 06220CSRN54 SOPTON COMP 'C' 54 06230C*------------------------------------------------------------------- 06240CSR END111 TAG 06250CSR ENDSR ÐÐ06260C******************************************************************** 06270CSR SR112 BEGSR 06280C* REQUEST SEARCH DATA. 06290CSR Z-ADD456 M 06300CSR MOVE BIT,1 REC 06310CSR EXSR SR452 PROMPT/READ 06320CSR 92 GOTO SR112 REPEAT ESC 06330CSR 90 GOTO END112 06340CSR EXSR SR708 MOVE INPUT DATA 06350CSR MOVEABUFIN FROM SEARCH DATA 06360CSR BIT,32 LOKUPFROM 54 06370CSR 54 GOTO END112 INPUT WAS MADE 06380CSR Z-ADD469 M 06390CSR EXSR SR455 FLAG ERROR 06400CSR GOTO SR112 06410CSR END112 ENDSR 06420C******************************************************************** 06430CSR SR113 BEGSR 06440C* REQUEST CHANGE-TO DATA. 06450CSR MOVE BIT,1 REC 06460CSR Z-ADD471 M 06470CSR EXSR SR452 PUT MSG 06480CSR 92 GOTO SR113 REPEAT ESC 06490CSR 90 GOTO END113 OTHER ESC 06500CSR EXSR SR708 MOVE INPUT DATA ÐÐ06510CSR MOVEABUFIN TOR CHANGE-TO DATA 06520CSR BIT,32 LOKUPTOR 54 06530CSR 54 GOTO END113 INPUT WAS MADE 06540CSR Z-ADD469 M 06550CSR EXSR SR455 FLAG ERROR 06560CSR GOTO SR113 06570CSR END113 ENDSR 06580C******************************************************************** 06590CSR SR114 BEGSR 06600C* REQUEST COPY-FROM TEXT NAME. 06610CSR EXSR SR605 INIT W60A 06620CSR MOVE FRNAME W15A 06630CSR EXSR SR619 W15A L W60A 06640CSR Z-ADD458 M 06650CSR EXSR SR451 PROMPT/READ 06660CSR 90 GOTO END114 06670CSR 77 MOVELBUFIN FRNAME 8 06680CSR 44 06690COR 40 EXSR SR401 UPDATE TXMAST 06700CSR MOVE FRNAME TNAME 8 COPY-FROM NAME 06710CSR EXSR SR400 GET FROM MAST 06720CSR SETOF 4044 06730CSRN60 GOTO T114A GOT IT 06740CSR Z-ADD5 M 06750CSR EXSR SR455 FLAG ERROR ÐÐ06760CSR GOTO SR114 06770C*------------------------------------------------------------------- 06780CSR T114A TAG 06790CSR EXSR SR616 NAME TO KEY 06800CSR EXSR SR400 CUT CUR MAST 06810CSR END114 ENDSR 06820C******************************************************************** 06830CSR SR115 BEGSR 06840C* REQUEST COPY-TO LINE. 06850CSR EXSR SR605 INIT W60A 06860CSR Z-ADDCOPYTO W5N 06870CSR EXSR SR611 EDIT-Z 06880CSR EXSR SR617 W5A TO W60A 06890CSR Z-ADD459 M 06900CSR EXSR SR451 PROMPT/READ 06910CSR 90 GOTO END115 06920CSR 77 EXSR SR701 R. ADJUST 06930CSR 77 MOVE W10A COPYTO 50 COPY-TO LINE# 06940CSR COPYTO COMP 0 54 06950CSR 54 COPYTO COMP LLIMIT 5454 06960CSR 54 GOTO END115 06970CSR Z-ADD277 M 06980CSR EXSR SR455 FLAG ERROR 06990CSR GOTO SR115 07000CSR END115 ENDSR ÐÐ07010C******************************************************************** 07020CSR SR116 BEGSR 07030C* REQUEST LINE CONTROL DATA. 07040CSR EXSR SR502 LFCR 07050CSR EXSR SR605 INIT W60A 07060CSR MOVE TYPE W15A 07070CSR EXSR SR619 W15A L W60A 07080CSR Z-ADD472 M 07090CSR SETON 33 SUPPRESS LF 07100CSR EXSR SR450 PROMPT/READ 07110CSR 90 GOTO END116 07120CSR 77 MOVELBUFIN TYPE 1 TEXT TYPE 07130C*------------------------------------------------------------------- 07140CSR T116A TAG 07150CSR TYPE COMP 'H' 54 FLAG HEADING 07160CSRN54 TYPE COMP 'F' 54 FLAG FOOTNOTE 07170CSR TYPE COMP 'L' 54 FLAG LINK 07180CSRN54 TYPE COMP ' ' 54 TEXT 07190CSRN54 TYPE COMP ' ' 54 TEXT 07200CSRN54 Z-ADD0 HLINE 07210CSRN54 GOTO T116B 07220CSR EXSR SR605 INIT W60A 07230CSR Z-ADDHLINE W5N 07240CSR EXSR SR611 EDIT-Z 07250CSR EXSR SR617 W5A TO W60A ÐÐ07260CSR Z-ADD81 M 07270CSR SETON 33 07280CSR EXSR SR450 PROMPT/READ 07290CSR 94 GOTO SR116 BKWD-SKIP 07300CSR 90 GOTO END116 07310CSR 77 MOVELBUFIN HLINE 10 HDG LINE # 07320C*------------------------------------------------------------------- 07330CSR T116B TAG 07340CSR TYPE COMP 'H' 54 07350CSRN54 TYPE COMP ' ' 54 07360CSRN54 TYPE COMP 'T' 54 07370CSRN54 MOVE ' ' SPACE 07380CSRN54 GOTO END116 07390CSR EXSR SR605 INIT W60A 07400CSR MOVE SPACE W15A 07410CSR EXSR SR619 W15A L W60A 07420CSR Z-ADD113 M 07430CSR SETON 33 07440CSR EXSR SR450 PROMPT/READ 07450CSR TYPE COMP 'H' 54 07460CSRN54 TYPE COMP 'F' 54 07470CSR 54 94 GOTO SR116 07480CSR 94 GOTO T116A BKWD-SKIP 07490CSR 90 GOTO END116 07500CSR 77 MOVELBUFIN SPACE 1 SPACE CODE ÐÐ07510CSR END116 ENDSR 07520C******************************************************************** 07530CSR SR117 BEGSR 07540C* REQUEST LINE OPTION. 07550CSR EXSR SR605 INIT W60A 07560CSR MOVE LCNTRL W15A 07570CSR EXSR SR619 W15A L W60A 07580CSR Z-ADD473 M 07590CSR EXSR SR450 PROMPT/READ 07600CSR 90 GOTO END117 ESC 07610CSR 77 MOVELBUFIN LCNTRL 1 LINE CONTROL CODE 07620C*------------------------------------------------------------------- 07630CSR T117A TAG 07640CSR LCNTRL COMP 'Y' 54 07650CSRN54 LCNTRL COMP 'N' 54 07660CSR LCNTRL COMP ' ' 55 07670CSRN54 55 MOVE 'N' LCNTRL 1 07680CSR 54 07690COR 55 GOTO END117 07700CSR Z-ADD385 M 07710CSR EXSR SR455 FLAG ERROR 07720CSR GOTO SR117 07730C*------------------------------------------------------------------- 07740CSR END117 ENDSR 07750C******************************************************************** ÐÐ07760CSR SR118 BEGSR 07770C* REQUEST 'FROM' COL #. 07780CSR Z-ADD491 M 07790CSR EXSR SR605 CLEAR W60A 07800CSR Z-ADDCOLF W5N FROM COL # 07810CSR EXSR SR611 EDIT-Z 07820CSR EXSR SR617 W5A TO W60A 07830CSR EXSR SR451 PROMPT/READ 07840CSR 90 GOTO END118 ESCAPE 07850CSR 77 EXSR SR701 R. ADJUST 07860CSR 77 MOVE W10A COLF 50 FROM COL # 07870CSR COLF COMP 0 54 07880CSR 54 COLF COMP 132 5454 07890CSR 54 GOTO END118 COL # OK 07900CSR Z-ADD492 M 07910CSR EXSR SR455 FLAG ERROR 07920CSR GOTO SR118 TRY AGAIN 07930CSR END118 ENDSR 07940C******************************************************************** 07950CSR SR119 BEGSR 07960C* REQUEST 'TO' COL #. 07970CSR Z-ADD493 M 07980CSR EXSR SR605 CLEAR W60A 07990CSR Z-ADDCOLT W5N TO COL # 08000CSR EXSR SR611 EDIT-Z ÐÐ08010CSR EXSR SR617 W5A TO W60A 08020CSR EXSR SR451 PROMPT/READ 08030CSR 90 GOTO END119 ESC 08040CSR 77 EXSR SR701 R. ADJUST 08050CSR 77 MOVE W10A COLT 50 TO COL # 08060CSR COLT COMP 0 54 08070CSR 54 GOTO END119 COL # OK 08080CSR Z-ADD492 M 08090CSR EXSR SR455 FLAG ERROR 08100CSR GOTO SR119 TRY AGAIN 08110CSR END119 ENDSR 08120C******************************************************************** 08130CSR SR201 BEGSR 08140C* ADD TEXT. 08150CSR MOVE BIT,1 ARA NULLS 08160CSR START SUB INCRMT LINENO 50 08170CSR EXSR SR502 LFCR 08180CSR GOTO T201AA 08190C*------------------------------------------------------------------- 08200CSR T201A TAG 08210CSR LCNTRL COMP 'Y' 54 CHK LINE CONTROL 08220CSRN54 EXSR SR502 LFCR 08230C*------------------------------------------------------------ 08240CSR T201AA TAG 08250CSR 90 GOTO END201 ESC ÐÐ08260CSR EXSR SR615 INCRMT + LINENO 08270CSR EXSR SR614 CHK LINE LIMIT 08280CSR 54 GOTO T201T FILE FULL 08290CSR EXSR SR300 CALC B,P 08300CSR EXSR SR612 CHK BLK # 08310CSRN54 EXSR SR703 GET NEW BLOCK 08320CSR EXSR SR412 GET TXPTR 08330CSR EXSR SR301 CALC RRN 08340CSR EXSR SR405 GET TXFILE 08350CSR EXSR SR618 P=Y COMP 08360CSRN54 MOVEABLK132 REC 08370CSRN54 MOVE ' ' TXTYPE 08380CSRN54 Z-ADD0 TXLINE HDG LINE # 08390CSRN54 MOVE ' ' TXSPAC 08400CSR 54 MOVE TXTYPE TYPE 08410CSR 54 Z-ADDTXLINE HLINE 08420CSR 54 MOVE TXSPAC SPACE 08430C*-------------------------------------------------------------------- 08440CSR T201B TAG 08450CSR EXSR SR74 PUT TEXT CRT 08460CSR MOVEAREC ARB 08470CSR EXSR SR476 READ 08480CSR 90 MOVEAARB REC 08490CSR EXSR SR74 PUT CRT 08500CSR 92 GOTO T201B REPEAT ESC ÐÐ08510CSR 90 GOTO END201 ESC 08520CSR LCNTRL COMP 'Y' 54 08530CSR 54 EXSR SR116 RQST LINE CONTROL 08540CSR 90 GOTO END201 ESC 08550CSR EXSR SR406 UPDATE TXFILE 08560CSR MOVE 'Y' PAG,P 08570CSR GOTO T201A 08580C*------------------------------------------------------------------- 08590CSR T201T TAG 08600C* FLAG FULL FILE. 08610CSR Z-ADD470 M 08620CSR EXSR SR455 FLAG ERROR 08630C*------------------------------------------------------------------- 08640CSR END201 TAG 08650CSR 41 EXSR SR404 UPDATE TXPTR 08660CSR ENDSR 08670C******************************************************************** 08680CSR SR203 BEGSR 08690C* DELETE/LIST TEXT. 08700CSR EXSR SR600 INIT BUFIN 08710CSR Z-ADD0 COUNT 77 08720CSR START SUB 1 LINENO 50 08730CSRN36 EXSR SR502 LFCR 08740C*------------------------------------------------------------------- 08750CSR T203A TAG ÐÐ08760CSR EXSR SR604 CHK CNTRL-D 08770CSR 54 GOTO END203 08780CSR 1 ADD LINENO LINENO INCRMT + LINENO 08790CSR EXSR SR613 CHK ENDLIN 08800CSR 54 GOTO END203 08810CSR EXSR SR300 CALC B,P 08820CSR EXSR SR612 CHK BLK # 08830CSRN54 EXSR SR610 ADVANCE LINENO 08840CSRN54 GOTO T203A NO BLK # 08850CSR EXSR SR412 GET TXPTR 08860CSR EXSR SR618 P=Y COMP 08870CSR 54 GOTO T203B ACTIVE LINE 08880CSR EXSR SR601 FIND NEXT 'Y' 08890CSR 55 EXSR SR302 CALC NEW LINE# 08900CSR 55 EXSR SR613 CHK ENDLIN 08910CSR 55 54 GOTO END203 PAST LIMIT 08920CSR 55 GOTO T203B GET NEXT LINE 08930CSR Z-ADD100 P 08940CSR EXSR SR302 CALC NEW LINE# 08950CSR GOTO T203A 08960C*------------------------------------------------------------------- 08970CSR T203B TAG 08980CSR EXSR SR301 CALC RRN 08990CSR EXSR SR405 GET TXFILE 09000CSRN36 EXSR SR502 LFCR ÐÐ09010CSRN36 EXSR SR456 SPACING 09020CSR 28 EXSR SR709 MOVE TEXT 09030CSRN36 EXSR SR74 PUT TEXT 09040CSRN38 GOTO T203C 09050CSR COUNT COMP 29 56 56 09060CSRN56 GOTO T203C NOT END PAGE 09070CSR Z-ADD34 M 09080CSR EXSR SR455 09090CSR EXSR SR600 INIT BUFIN 09100CSR EXSR SR475 READ 09110CSR 90 GOTO END203 09120CSR Z-ADD0 COUNT 09130C*------------------------------------------------------------------- 09140CSR T203C TAG 09150CSR 28 MOVE TEXT 09160COR 38 GOTO T203A LIST INSTR 09170CSR MOVE 'N' PAG,P DELETE INSTR 09180CSR 'Y' LOKUPPAG 54 09190CSRN54 EXSR SR704 FREE-UP BLK# 09200CSR GOTO T203A 09210C*------------------------------------------------------------------- 09220CSR END203 TAG 09230CSR 40 EXSR SR400 UPDATE TXMAST 09240CSR 41 EXSR SR404 UPDATE TXPTR 09250CSRN36 EXSR SR502 LFCR ÐÐ09260CSR ENDSR 09270C******************************************************************** 09280CSR SR204 BEGSR 09290C* LIST TEXT. 09300CSR SETON 38 09310CSR EXSR SR203 09320CSR SETOF 38 09330CSR ENDSR 09340C******************************************************************** 09350CSR SR205 BEGSR 09360C* MOVE TEXT. 09370CSR SETON 28 09380CSR EXSR SR203 MOVE TEXT 09390CSR SETOF 28 09400CSR ENDSR 09410C******************************************************************** 09420CSR SR206 BEGSR 09430C* RESEQUENCE TEXT. 09440C* UPDATE PREV GETS. 09450CSR SETON 3936 09460CSR 40 EXSR SR401 UPDATE TXMAST 09470CSR 41 EXSR SR404 UPDATE TXPTR 09480C* CHECK AVAIL SPACE FOR RESEQ RECORDS. 09490CSR MOVE NAME TXTNAM 8 SAVE TEXT NAME 09500CSR MOVE NAME FRNAME ÐÐ09510CSR Z-ADDSTART COPYTO 09520CSR EXSR SR922 CHECK SPACE 09530CSR 58 GOTO END206 NO SPACE 09540C*------------------------------------------------------------------- 09550C* GENERATE FUNKY TXMAST FOR DUMMY COPY ROUTINE. 09560CSR MOVE BLK8 NAME 09570CSR MOVELPORT NAME FUNKY TEXT NAME 09580CSR MOVE 'FUNKY' NAME UNIQUE CHAR 09590CSR EXSR SR616 MOVE NAME TO KEY 09600CSR EXSR SR400 GET FUNKY MAST 09610C* IF FUNKY MAST NOT ON FILE, ADD TO FILE. 09620CSR 60 Z-ADD0 BLK 09630CSR 60 EXSR SR401 UPD FUNKY MAST 09640CSR 60 EXSR SR400 GET FUNKY MAST 09650CSR MOVE TNAME FUNKY 8 SAVE FUNKY KEY 09660C*------------------------------------------------------------------- 09670C* COPY REAL TEXT TO FUNKY TEXT. 09680CSR MOVE TXTNAM FRNAME REAL TEXT KEY 09690CSR Z-ADDSTART COPYTO 09700CSR EXSR SR208 COPY TXT TO FUNKY TXT09710C*------------------------------------------------------------------- 09720C* DELETE COPIED LINES FROM REAL TEXT. 09730CSR MOVE TXTNAM NAME 09740CSR EXSR SR616 NAME TO KEY 09750CSR EXSR SR400 GET REAL MAST ÐÐ09760CSR EXSR SR203 DELETE REAL TEXT 09770C*------------------------------------------------------------------- 09780C* COPY FUNKY TEXT TO REAL TEXT. 09790CSR SETOF 36 09800CSR MOVE FUNKY FRNAME FUNKY KEY 09810CSR Z-ADD9999 ENDLIN ADJUSTED END-LINE 09820CSR MOVE TXTNAM NAME REAL KEY 09830CSR EXSR SR616 NAME TO KEY 09840CSR EXSR SR208 COPY FUNKY TO REAL 09850C*------------------------------------------------------------------- 09860C* DELETE FUNKY TEXT. 09870CSR SETON 36 09880CSR MOVE FUNKY NAME 09890CSR EXSR SR616 NAME TO KEY 09900CSR EXSR SR400 GET TXMAST 09910CSR Z-ADD9999 ENDLIN 09920CSR EXSR SR203 DELETE FUNKY TEXT 09930CSR 40 EXSR SR401 UPDATE TXMAST 09940CSR 41 EXSR SR404 UPDATE TXPTR 09950CSR MOVE TXTNAM NAME REAL KEY 09960CSR EXSR SR616 MOVE NAME TO KEY 09970CSR EXSR SR400 GET TEXT BACK 09980C*------------------------------------------------------------------- 09990CSR END206 TAG 10000CSR SETOF 3936 ÐÐ10010CSR ENDSR 10020C******************************************************************** 10030CSR SR208 BEGSR 10040C* COPY TEXT 10050CSR 44 10060COR 40 EXSR SR401 UPDATE TXMAST 10070CSR 41 EXSR SR404 UPDATE TXPTR 10080CSRN39 EXSR SR922 VERIFY REC SPACE 10090CSR 58 GOTO END208 NOT ENOUGH ROOM 10100CSR MOVE FRNAME TNAME COPY FROM NAME 10110CSR EXSR SR400 GET CPY FR MAST 10120CSR SETOF 4044 10130CSR SETOF 43 10140CSR START SUB 1 LINENO 10150CSR Z-ADD0 SAVCPY 30 10160CSR Z-ADD0 SAVES 30 10170CSR Z-ADD0 CPYRRN 70 10180C*-------------------------------------------------------------------- 10190CSR T208A TAG 10200C* GET/SAVE COPY FROM PTRS 10210CSR 1 ADD LINENO LINENO 10220CSR EXSR SR613 CHK LINE# 10230CSR 54 GOTO T208D BEYOND LIMIT 10240CSR EXSR SR300 CONVERT LINE,B,P 10250CSR EXSR SR612 CHK BLK# ÐÐ10260CSRN54 EXSR SR610 ADVANCE LINENO 10270CSRN54 GOTO T208A GET NEXT BLOCK 10280CSR EXSR SR412 GET TXPTR 10290CSR EXSR SR618 P=Y COMP 10300CSR SETOF 56 10310CSRN54 SETON 56 10320CSR 56 EXSR SR601 FIND NEXT 'Y' 10330CSR 56N55 Z-ADD100 P 10340CSR 56 EXSR SR302 CALC NEW LINE# 10350CSR 56N55 GOTO T208A GET NEXT LINE 10360CSR EXSR SR301 CALC RRN 10370CSR 43 GOTO T208C TXCOPY ACTIVE 10380C*------------------------------------------------------------------ 10390CSR T208B TAG 10400C* GET TXCOPY RECORD 10410CSR 1 ADD CPYRRN CPYRRN 10420CSR EXSR SR409 GET TXCOPY 10430CSR TCPORT COMP 0 54 10440CSRN54 GOTO T208B WRONG PORT # 10450CSR Z-ADD0 CPY 10460CSR Z-ADDPORT TCPORT 10470CSR Z-ADD0 S 30 10480C*----------------------------------------------------------------- 10490CSR T208C TAG 10500C* COPY PTRS TO TXCOPY RECORD ÐÐ10510CSR 1 ADD S S 10520CSR S COMP SLIMIT 54 10530CSR 54 GOTO T208B BEYOND LIMIT 10540CSR Z-ADDRRN CPY,S SAVE RRN 10550CSR GOTO T208A GET NXT CPY LINE 10560C*------------------------------------------------------------------ 10570CSR T208D TAG 10580C* USE SAVED PTRS TO COPY TEXT 10590CSR 43 EXSR SR410 UPDATE TXCOPY 10600CSR Z-ADDCPYRRN SAVCPY 30 10610CSR COPYTO SUB INCRMT LINENO 10620CSR 40 10630COR 44 EXSR SR401 UPDATE TXMAST 10640CSR EXSR SR616 NAME TO KEY 10650CSR EXSR SR400 GET TXMAST 10660CSR Z-ADD0 CPYRRN 10670C*------------------------------------------------------------------ 10680CSR T208E TAG 10690CSR 1 ADD CPYRRN CPYRRN 10700CSR CPYRRN COMP SAVCPY 54 10710CSR 54 GOTO END208 DONE 10720CSR TCPORT COMP PORT 54 10730CSRN54 GOTO T208E WRONG PORT# 10740CSR Z-ADD1 S 10750C*--------------------------------------------------------------- ÐÐ10760CSR T208F TAG 10770CSR ZERO7 LOKUPCPY,S 54 10780CSRN54 GOTO T208E GET NXT TXCOPY 10790CSR Z-ADDCPY,S RRN 70 10800CSR EXSR SR405 GET TXFILE REC 10810CSR MOVEAREC FROM 10820CSR MOVE TXTYPE TYPE 10830CSR MOVE TXLINE HLINE 10840CSR MOVE TXSPAC SPACE 10850CSR Z-ADD0 TCPORT 10860CSR Z-ADD0 CPY,S 10870C*-------------------------------------------------------------- 10880CSR T208G TAG 10890C* GET COPY-TO RECORD 10900CSR EXSR SR615 INCRMT + LINENO 10910CSR EXSR SR614 CHECK LINE LIMIT 10920CSR 54 GOTO T208J ABORT COPY 10930CSR EXSR SR300 CALC B,P 10940CSR EXSR SR612 CHK BLK# 10950CSRN54 EXSR SR703 GET NEW BLK# 10960CSR EXSR SR412 GET TXPTR 10970C*--------------------------------------------------------------- 10980CSR T208H TAG 10990CSR EXSR SR618 P=Y COMP 11000CSR 54 GOTO T208J ABORT COPY ÐÐ11010CSR MOVE 'Y' PAG,P 11020CSR EXSR SR301 CALC RRN 11030CSR EXSR SR405 GET TXFILE 11040CSR MOVEAFROM REC 11050CSR EXSR SR406 UPDATE TXFILE 11060CSRN36 EXSR SR502 LFCR 11070CSRN36 EXSR SR74 DISPLAY TEXT 11080CSR GOTO T208F GET NEXT PTR 11090C*--------------------------------------------------------------- 11100CSR T208J TAG 11110C* FLAG COPY ABORTED-- NO ROOM 11120CSR Z-ADD475 M 11130CSR EXSR SR455 FLAG ERROR 11140C*-------------------------------------------------------------- 11150CSR T208K TAG 11160C* INIT UNUSED PTRS 11170CSR Z-ADD0 CPY 11180CSR Z-ADD0 TCPORT 11190CSR EXSR SR410 UPDATE TXCOPY 11200C*------------------------------------------------------------- 11210CSR T208L TAG 11220CSR 1 ADD CPYRRN CPYRRN 11230CSR CPYRRN COMP SAVCPY 54 11240CSR 54 GOTO END208 11250CSR TCPORT COMP PORT 54 ÐÐ11260CSRN54 GOTO T208L WRONG PORT 11270CSR GOTO T208K INIT 11280C*-------------------------------------------------------------- 11290CSR END208 TAG 11300C* END COPY/RESEQ ROUTINE 11310CSR 41 EXSR SR404 UPDATE TXPTR 11320CSR 43 EXSR SR410 UPDATE TXCOPY 11330CSR 40 11340COR 44 EXSR SR401 UPDATE TXMAST 11350CSR EXSR SR616 NAME TO KEY 11360CSR EXSR SR400 GET TXMAST 11370CSR ENDSR 11380C****************************************************************** 11390CSR SR209 BEGSR 11400C* UPDATE TAB - STOPS 11410CSR EXSR SR502 LFCR 11420CSR MOVEABAT REC 11430CSR EXSR SR74 PUT EXIST TABS 11440CSR Z-ADD474 M 11450CSR EXSR SR452 PROMPT 11460CSR 92 GOTO SR209 REPEAT ESC 11470CSR 90 GOTO END209 11480CSR EXSR SR708 MOVE DATA 11490CSR MOVEABUFIN BAT 11500CSR END209 ENDSR ÐÐ11510C******************************************************************** 11520CSR SR300 BEGSR 11530C* CALCULATE BLK INDEX (B) AND PAG INDEX (P) FROM LINE #. 11540CSR .01 MULT LINENO W5D2 52 11550CSR MOVELW5D2 B 30 11560CSR MOVE W5D2 W2N 20 11570CSR Z-ADDW2N P 30 54 11580CSRN54 B SUB 1 B 11590CSRN54 Z-ADD100 P 11600CSR 1 ADD B B 11610CSR ENDSR 11620C******************************************************************** 11630CSR SR301 BEGSR 11640C* CALC RRN FROM BLOCK # AND PAG INDEX (P). 11650CSR Z-ADDBLK,B RRN 11660CSR 100 MULT RRN RRN RRN 11670CSR P ADD RRN RRN 11680CSR RRN SUB 100 RRN 11690CSR ENDSR 11700C******************************************************************** 11710CSR SR302 BEGSR 11720C* CALC LINE # FROM B AND P INDEX. 11730CSR 100 MULT B LINENO 11740CSR LINENO ADD P LINENO 11750CSR LINENO SUB 100 LINENO ÐÐ11760CSR ENDSR 11770C******************************************************************** 11780CSR SR303 BEGSR 11790C* COMPUTE B AND P FOR END LINE. 11800CSR Z-ADDENDLIN LINENO 50 11810CSR EXSR SR300 CALC B,P 11820CSR Z-ADDB BEND 30 11830CSR Z-ADDP PEND 30 11840CSR ENDSR 11850C******************************************************************** 11860CSR SR400 BEGSR 11870C* GET TXMAST FILE. 11880CSR MOVE ' ' TMSTAT 11890CSR 44 NEW ADD PENDING 11900COR 40 EXSR SR401 UPD PREV GET 11910CSR TNAME CHAINTXMAST 60 GET TXMAST 11920CSR 60 SETON 44 ADD FLAG 11930CSRN60 SETON 40 ACTIVE REL FLAG 11940CSR ENDSR 11950C******************************************************************** 11960CSR SR401 BEGSR 11970C* UPDATE TXMAST. 11980CSR SETON 80 11990CSR 40 ACTIVE GET 12000COR 44 EXCPT PREV NO HIT ÐÐ12010CSR SETOF 804044 12020CSR ENDSR 12030C******************************************************************** 12040CSR SR403 BEGSR 12050C* GET TXPTR FILE. 12060CSR 41 EXSR SR404 UPD PREV GET 12070CSR BLK,B CHAINTXPTR 60 GET TXPTR 12080CSRN60 SETON 41 ACT REC FLAG 12090CSR Z-ADDBLK,B LASTTP 30 12100CSR MOVE TNAME LASTTM 8 12110CSR ENDSR 12120C******************************************************************** 12130CSR SR404 BEGSR 12140C* UPDATE TXPTR FILE. 12150CSR SETON 81 12160CSR 41 EXCPT UPDATE TXPTR 12170CSR SETOF 8141 12180CSR ENDSR 12190C******************************************************************** 12200CSR SR405 BEGSR 12210C* GET TXFILE. 12220CSR RRN CHAINTXFILE 60 GET TXFILE 12230CSR ENDSR 12240C******************************************************************** 12250CSR SR406 BEGSR ÐÐ12260C* UPDATE TXFILE. 12270CSR SETON 82 12280CSR EXCPT UPDATE TXFILE 12290CSR SETOF 82 12300CSR ENDSR 12310C******************************************************************** 12320CSR SR407 BEGSR 12330C* GET TXAVAIL. 12340CSR 42 EXSR SR408 UPDATE TXAVAIL 12350CSR Z-ADD1 W5N 12360CSR W5N CHAINTXAVAIL H4 12370CSRNH4 SETON 42 12380CSR ENDSR 12390C******************************************************************** 12400CSR SR408 BEGSR 12410C* UPDATE TXAVAIL FILE. 12420CSR SETON 83 12430CSR 42 EXCPT UPDATE TXAVAIL 12440CSR SETOF 8342 12450CSR ENDSR 12460C******************************************************************** 12470CSR SR409 BEGSR 12480C* GET TXCOPY FILE. 12490CSR 43 EXSR SR410 UPD PREV GET 12500CSR CPYRRN CHAINTXCOPY 60 GET TXCOPY ÐÐ12510CSRN60 SETON 43 ACT REC FLAG 12520CSR ENDSR 12530C******************************************************************** 12540CSR SR410 BEGSR 12550C* UPDATE TXCOPY FILE. 12560CSR SETON 84 12570CSR 43 EXCPT UPDATE TXCOPY 12580CSR SETOF 8443 12590CSR ENDSR 12600C******************************************************************** 12610CSR SR411 BEGSR 12620C* GET MESSAGE MAST. 12630CSR M CHAINMGFILE 54 12640CSR 54 MOVE BLK132 MGTEXT 12650CSR 54 MOVEL'NO-MSG' MGTEXT 12660CSR ENDSR 12670C******************************************************************** 12680CSR SR412 BEGSR 12690C* GET TXPTR. 12700CSR 41 BLK,B COMP LASTTP 54 12710CSR 41 54 TNAME COMP LASTTM 54 12720CSR 41N54 12730CORN41 EXSR SR403 GET TXPTR 12740CSR ENDSR 12750C******************************************************************** ÐÐ12760CSR SR450 BEGSR 12770C* PROMPT, LINE-120, CURSOR AT COL-37 - OPTIONAL INPUT. 12780CSR EXSR SR603 INIT CRT 12790CSR EXSR SR411 GET MGFILE 12800CSR EXSR SR71 PROMPT 12810CSR EXSR SR600 INIT BUFIN 12820CSR EXSR SR474 READ 12830CSR ENDSR 12840C******************************************************************** 12850CSR SR451 BEGSR 12860C* PROMPT, LINE-120, CURSOR AT COL-37 - MANDATORY INPUT. 12870CSR EXSR SR450 PROMPT/READ 12880CSR 77 12890COR 90 GOTO END451 12900CSR Z-ADDM SAVEM 50 12910CSR Z-ADD435 M 12920CSR EXSR SR455 FLAG ERROR 12930CSR Z-ADDSAVEM M 12940CSR GOTO SR451 12950CSR END451 ENDSR 12960C******************************************************************** 12970CSR SR452 BEGSR 12980C* PROMPT, LINE-118. 12990CSR MOVE BIT,1 ARA 13000CSR EXSR SR453 INIT PROMPT ÐÐ13010CSR SETON 35 13020CSR EXSR SR476 READ 13030CSR SETOF 35 13040CSR ENDSR 13050C******************************************************************** 13060CSR SR453 BEGSR 13070C* PUT MSG AT CURRENT LINE. 13080CSR EXSR SR411 GET MGFILE 13090CSR EXSR SR603 INIT CRT 13100CSR MOVEAMGTEXT CRT 13110CSR EXSR SR72 LFCR/PROMPT/LFCR 13120CSR ENDSR 13130C******************************************************************** 13140CSR SR454 BEGSR 13150C* SPACE BEFORE PRINT (SR201). 13160CSR SPACE COMP '1' 54 13170CSR 54 EXSR SR502 LFCR 13180CSR SPACE COMP '2' 54 13190CSR 54 EXSR SR502 LFCR 13200CSR 54 EXSR SR502 LFCR 13210CSR SPACE COMP '3' 54 13220CSR 54 EXSR SR502 LFCR 13230CSR 54 EXSR SR502 LFCR 13240CSR 54 EXSR SR502 LFCR 13250CSR SPACE COMP 'S' 54 ÐÐ13260CSR 54 EXSR SR502 LFCR 13270CSR 54 EXSR SR502 LFCR 13280CSR 54 EXSR SR502 LFCR 13290CSR 54 EXSR SR502 LFCR 13300CSR ENDSR 13310C******************************************************************** 13320CSR SR455 BEGSR 13330C* PUT ERR MESSAGE 13340CSR MOVE BIT,8 BELL 1 13350CSR EXSR SR411 GET MGFILE 13360CSR EXSR SR73 PUT MSG 13370CSR MOVE ' ' BELL 13380CSR ENDSR 13390C******************************************************************** 13400CSR SR456 BEGSR 13410C* SPACE BEFORE PRINT (SR203). 13420CSR MOVE TXSPAC SPACE 13430CSR EXSR SR454 13440CSR ENDSR 13450C******************************************************************** 13460CSR SR474 BEGSR 13470C* READ TERMINAL. 13480CSR EXSR SR475 READ 13490CSR 77 ' ' LOKUPA132 77 13500CSR ENDSR ÐÐ13510C******************************************************************** 13520CSR SR475 BEGSR 13530C* READ CRT - BASIC UTILITY SR. 13540CSR EXSR SR102 SETOFFS 13550CSR MOVE ' ' RETCOD 2 RETURN CODE 13560CSR EXITFQBELL RING BELL 13570CSR EXITFQR132R READ 13580CSR RLABL BUFIN BUFFER 13590CSR RLABL BUFLGT BUF LGTH 13600CSR RLABL RETCOD RET CODE 13610CSRN37 MOVEABUFIN A132 INPUT DATA 13620CSR 37 Z-ADDCURCOL W 13630CSR 37 MOVEABUFIN A132,W 13640CSR RETCOD COMP '03' 91 FLAG LF/TAB 13650CSR 91 EXSR SR503 BUMP CURSOR UP 13660CSR Z-ADD1 W 30 13670CSR BIT,32 LOKUPA132,W 54 FIND INPUT 13680CSRN54 GOTO END475 13690CSR A132,W COMP '\' 90 13700CSRN90 GOTO T475B 13710CSR 1 ADD W W 13720CSR W COMP 132 54 13730CSR 54 GOTO T475A BAD ESC 13740CSR A132,W COMP 'B' 94 BKWD TAB 13750CSR A132,W COMP 'N' 96 NEW ITEM ÐÐ13760CSR A132,W COMP 'R' 92 REPEAT 13770CSR A132,W COMP 'E' 98 SYST-MENU 13780CSR A132,W COMP 'M' 97 LOCAL-MENU 13790CSR A132,W COMP 'G' 99 GOODBY 13800CSR A132,W COMP 'D' 93 DONE 13810CSR 92 13820COR 93 13830COR 94 13840COR 94 13850COR 96 13860COR 97 13870COR 98 13880COR 99 GOTO END475 GOOD ESC 13890CSR SETOF 90 BYPASS ESC CODE 13900CSR GOTO T475B ESC IS DATA 13910C*------------------------------------------------------------------- 13920CSR T475A TAG 13930C* FLAG BAD ESCAPE. 13940CSR Z-ADD318 M 13950CSR EXSR SR455 FLAG ERROR 13960CSR GOTO SR475 TRY AGAIN 13970C*------------------------------------------------------------------- 13980CSR T475B TAG 13990CSR SETON 77 14000CSR 37 GOTO END475 ÐÐ14010CSR 77 EXSR SR600 INIT BUFIN 14020CSR 77 MOVEAA132,W BUFIN 14030C*----------------------------------------------------------------- 14040CSR END475 TAG 14050CSR ENDSR 14060C******************************************************************** 14070CSR SR476 BEGSR 14080C* READ CRT (TEXT ADD ONLY) 14090CSR SETOF 3231 14100CSR SETON 37 ADD TRAN FLAG 14110CSR EXSR SR501 CR-ONLY 14120CSR MOVEAARA BUFIN 132 14130CSR Z-ADD1 CURCOL 30 14140C*------------------------------------------------------------------- 14150CSR T476B TAG 14160C* READ CRT 14170CSR Z-ADDCURCOL OLDCUR 30 14180CSR EXSR SR475 READ CRT 14190CSR 91 SETON 32 14200CSR 94 SETOF 90 14210CSR 94 GOTO T476F 14220CSR 90 GOTO END476 ESCAPE,NOT BKW TAB 14230CSRN77N91N31 SETON 9093 DEFAULT DONE 14240CSRN77N91 GOTO END476 14250CSR Z-ADDCURCOL W ÐÐ14260C*------------------------------------------------------------------ 14270CSR T476C TAG 14280C* MOVE INPUT DATA TO RECORD 14290CSR BIT,32 LOKUPA132,W 54 14300CSRN54 GOTO T476D 14310CSR SETON 31 ACTIVITY FLAG 14320CSR MOVE A132,W REC,W 14330CSR MOVE BIT,1 A132,W 14340CSR Z-ADDW CURCOL 14350CSR GOTO T476C 14360C*------------------------------------------------------------------ 14370CSR T476D TAG 14380C* MOVE CURSOR TO NEXT TAB POSITION 14390CSRN91 GOTO END476 NO LF(TAB) 14400CSR SETON 31 14410CSR 1 ADD CURCOL CURCOL 14420CSR Z-ADDCURCOL W 14430CSR W COMP 132 54 14440CSRN54 'X' LOKUPBAT,W 55 FIND TAB STOP 14450CSR 54 14460CORN54N55 Z-ADD132 W 14470CSR GOTO T476G 14480C*------------------------------------------------------------------ 14490CSR T476F TAG 14500C* DO BACKWARD TAB ÐÐ14510CSR Z-ADDOLDCUR W 14520CSR 77 GOTO T476G 14530C*--------------------------------------------------------------- 14540CSR T476FA TAG 14550CSR W SUB 1 W 54 14560CSRN54 Z-ADD1 W 14570CSR Z-ADDW CURCOL 14580CSRN54 GOTO T476G 14590CSR BAT,W COMP 'X' 54 14600CSRN54 GOTO T476FA 14610C*----------------------------------------------------------------- 14620CSR T476G TAG 14630CSRN35 EXSR SR74 PUT CRT 14640CSR Z-ADDW CURCOL 14650CSR MOVEAARA BUFIN 14660CSR 1 ADD W W3N 14670CSR MOVE W3N W6A 6 14680CSRN32 MOVEL'120' W6A 14690CSR 32 MOVEL'119' W6A 14700CSR EXSR SR500 POSITION CURSOR 14710CSR GOTO T476B DO NEXT READ 14720C*------------------------------------------------------------------ 14730CSR END476 TAG 14740CSR SETOF 3731 14750CSR ENDSR ÐÐ14760C******************************************************************** 14770CSR SR500 BEGSR 14780C* MOVE CURSOR. 14790CSR EXITFQXYPOS MOVE CURSOR 14800CSR RLABL W6A 14810CSR ENDSR 14820C******************************************************************** 14830CSR SR501 BEGSR 14840C* CAR-RETURN (ONLY). 14850CSR EXITFQCCR CAR-RETURN 14860CSR ENDSR 14870C******************************************************************** 14880CSR SR502 BEGSR 14890C* CR/LF. 14900CSR EXITFQCLFCR LF/CR 14910CSR 1 ADD COUNT COUNT 14920CSR ENDSR 14930C********************************************************************* 14940CSR SR503 BEGSR 14950C* BUMP CURSOR UP 14960CSR EXITFQMOVUP BUMP CURSOR UP 14970CSR ENDSR 14980C****************************************************************** 14990CSR SR600 BEGSR 15000C* UTILITY INIT. ÐÐ15010CSR MOVE BLK132 BUFIN 132 INIT BUFIN 15020CSR ENDSR 15030C****************************************************************** 15040CSR SR601 BEGSR 15050C* FIND NEXT ACTIVE LINE 15060CSR 'Y' LOKUPPAG,P 55 15070CSR ENDSR 15080C***************************************************************** 15090CSR SR602 BEGSR 15100C* COMPUTE ENDING LINE # (COPY/RESEQ SR922,SR920) 15110CSR INCRMT MULT ACTUAL REQD 50 15120CSR REQD SUB INCRMT REQD 15130CSR COPYTO ADD REQD REQD 15140CSR ENDSR 15150C******************************************************************** 15160CSR SR603 BEGSR 15170CSR MOVE ' ' CRT 15180CSR ENDSR 15190C******************************************************************** 15200CSR SR604 BEGSR 15210C* CHECK FOR CONTROL-D. 15220CSR MOVE ' ' W2A 2 15230CSR EXITFQSTOP 15240CSR RLABL W2A 15250CSR W2A COMP 'XX' 54 ÐÐ15260CSR ENDSR 15270C***************************************************************** 15280CSR SR605 BEGSR 15290C* INIT W60A. 15300CSR MOVE BLK132 W60A INIT W60A 15310CSR MOVE W60A W15A 15320CSR ENDSR 15330C******************************************************************** 15340CSR SR606 BEGSR 15350CSR X COMP 132 54 15360CSR ENDSR 15370C******************************************************************** 15380CSR SR607 BEGSR 15390CSR BIT,32 LOKUPFROM,X 54 15400CSR ENDSR 15410C******************************************************************** 15420CSR SR610 BEGSR 15430C* RESET LINENO TO START AT NEXT INDEX-B BLOCK. 15440CSR 100 SUB P W5N 50 15450CSR W5N ADD LINENO LINENO 15460CSR ENDSR 15470C******************************************************************** 15480CSR SR611 BEGSR 15490C* EDIT 5-DIGIT NUMB. 15500CSR MOVE 'Z' W1A 1 ÐÐ15510CSR Z-ADD5 W2N 20 15520CSR MOVE ' ' W5A 5 15530CSR EXIT SUBRED EDIT ROUTINE 15540CSR RLABL W5N SOURCE 15550CSR RLABL W1A EDIT CODE 15560CSR RLABL W5A RESULT 15570CSR RLABL W2N END POS 15580CSR ENDSR 15590C****************************************************************** 15600CSR SR612 BEGSR 15610C* CHECK FOR ACTIVE BLOCK 15620CSR BLK,B COMP 0 54 15630CSR ENDSR 15640C**************************************************************** 15650CSR SR613 BEGSR 15660C* FLAG PAST END LINE LIMIT 15670CSR LINENO COMP ENDLIN 54 15680CSR ENDSR 15690C**************************************************************** 15700CSR SR614 BEGSR 15710C* CHECK LINE# TO LINE LIMIT 15720CSR LINENO COMP LLIMIT 54 CHK LINE LIMIT 15730CSR ENDSR 15740C******************************************************************** 15750CSR SR615 BEGSR ÐÐ15760CSR INCRMT ADD LINENO LINENO 50 15770CSR ENDSR 15780C******************************************************************** 15790CSR SR616 BEGSR 15800CSR MOVE NAME TNAME 8 15810CSR ENDSR 15820C******************************************************************** 15830CSR SR617 BEGSR 15840CSR MOVE W5A W15A 15850CSR EXSR SR619 W15A L W60A 15860CSR ENDSR 15870C******************************************************************** 15880CSR SR618 BEGSR 15890CSR PAG,P COMP 'Y' 54 15900CSR ENDSR 15910C***************************************************************** 15920CSR SR619 BEGSR 15930CSR MOVELW15A W60A 15940CSR ENDSR 15950C******************************************************************** 15960CSR SR701 BEGSR 15970C* R. ADJUST. 15980CSR MOVELBUFIN W10A 10 15990CSR Z-ADD10 W2N 20 16000CSR EXIT SUBRAJ R. ADJUST ÐÐ16010CSR RLABL W2N 16020CSR RLABL W10A 16030CSR ENDSR 16040C******************************************************************** 16050CSR SR702 BEGSR 16060C* CHECK CONTROL-D INPUT. 16070CSR MOVE ' ' W2A 2 16080CSR EXITFQSTOP 16090CSR RLABL W2A 16100CSR W2A COMP 'XX' 54 54 16110CSR ENDSR 16120C******************************************************************** 16130CSR SR703 BEGSR 16140C* GET NEXT AVAIL BLOCK. 16150CSR EXSR SR407 GET TXAVAIL 16160CSR 'N' LOKUPNAB,N 54 16170CSRN54 GOTO T703Z NONE FOUND 16180C*--------------------------------------------------------------- 16190CSR T703A TAG 16200CSR Z-ADDN BLK,B NEW BLK # 16210CSR MOVE 'Y' NAB,N 16220CSR GOTO END703 16230C*--------------------------------------------------------------- 16240CSR T703Z TAG 16250C* TRY AGAIN FROM FRONT OF ARRAY ÐÐ16260CSR Z-ADD1 N 30 16270CSR 'N' LOKUPNAB,N 54 16280CSR 54 GOTO T703A GOT ONE 16290C* FLAG FILE FULL ERROR 16300CSR Z-ADD470 M 16310CSR EXSR SR455 FLAG ERROR 16320C*------------------------------------------------------------- 16330CSR END703 TAG 16340CSR EXSR SR408 UPDATE TXAVAIL 16350CSR 40 16360COR 44 EXSR SR400 UPDATE TXMAST 16370CSR ENDSR 16380C******************************************************************** 16390CSR SR704 BEGSR 16400C* STORE DELETED BLOCK #. 16410CSR EXSR SR407 GET TXAVAIL 16420CSR Z-ADDBLK,B Y 30 16430CSR MOVE 'N' NAB,Y 16440CSR EXSR SR403 GET DELETED TXPTR 16450CSR MOVE 'N' PAG 16460CSR EXSR SR404 UPDATE TXPTR 16470CSR Z-ADD0 BLK,B 16480C*------------------------------------------------------------- 16490CSR END704 TAG 16500CSR EXSR SR408 UPDATE TXAVAIL ÐÐ16510CSR 40 16520COR 44 EXSR SR400 UPDATE TXMAST 16530CSR ENDSR 16540C****************************************************************** 16550CSR SR707 BEGSR 16560C* CLASSIFY INSTRUCTION. 16570CSR INSTR COMP 'G' 55 GET 16580CSR INSTR COMP 'A' 56 ADD 16590CSR INSTR COMP 'D' 57 DELETE 16600CSR INSTR COMP 'L' 58 LIST 16610CSR INSTR COMP 'R' 59 REPLACE 16620CSR INSTR COMP 'S' 60 SEQ 16630CSR INSTR COMP 'F' 61 FIND 16640CSR INSTR COMP 'C' 62 COPY 16650CSR INSTR COMP 'T' 63 TAB-SET 16660CSR INSTR COMP 'M' 64 MOVE 16670CSR INSTR COMP 'X' 65 LINE CNTRL CHANGE 16680CSR ENDSR 16690C*************************************************************** 16700CSR SR708 BEGSR 16710C* MOVE SIGNIFICANT INPUT DATA 16720CSR MOVE BIT,1 CRT 16730CSR Z-ADD1 X 16740C*------------------------------------------------------------- 16750CSR T708A TAG ÐÐ16760CSR BIT,32 LOKUPREC,X 54 16770CSRN54 GOTO END708 16780CSR REC,X COMP '!' 54 16790CSR 54 MOVE ' ' CRT,X 16800CSRN54 MOVE REC,X CRT,X 16810CSR 1 ADD X X 16820CSR EXSR SR606 COMP 132 16830CSRN54 GOTO T708A 16840C*---------------------------------------------------------- 16850CSR END708 TAG 16860CSR MOVEACRT BUFIN 16870CSR ENDSR 16880C******************************************************************** 16890CSR SR709 BEGSR 16900C* MOVE TEXT (SEE SR205,SR203). 16910CSR MOVE ' ' TOR 16920CSR Z-ADDCOLF X 16930CSR MOVEAREC,X TOR,X 16940CSR MOVEABLK132 REC,X 16950CSR COLT COMP 132 54 16960CSRN54 Z-ADDCOLT T 30 16970CSRN54 MOVEATOR,X REC,T 16980CSR EXSR SR406 UPDATE TXFILE 16990CSR EXSR SR405 GET TXFILE 17000CSR ENDSR ÐÐ17010C******************************************************************** 17020CSR SR903 BEGSR 17030C* PAUSE. 17040CSR EXITFQPAUSE PAUSE 17050CSR ENDSR 17060C******************************************************************** 17070CSR SR920 BEGSR 17080C* SEARCH TEXT. 17090CSR START SUB 1 LINENO 17100CSR SETOF 59 17110C*------------------------------------------------------------------- 17120CSR T920A TAG 17130CSR EXSR SR604 CHK CONTROL-D 17140CSR 54 GOTO END920 17150CSR 1 ADD LINENO LINENO 17160CSR SETOF 29 17170CSR EXSR SR613 CHK LIMIT 17180CSR 54 GOTO T920F PAST LIMIT 17190CSR EXSR SR300 CALC B,P 17200CSR EXSR SR612 CHK BLK # 17210CSRN54 EXSR SR610 ADVANCE LINE # 17220CSRN54 GOTO T920A 17230CSR EXSR SR412 GET TXPTR 17240CSR 'Y' LOKUPPAG,P 54 17250CSRN54 GOTO T920E NO LINES ÐÐ17260CSR EXSR SR302 CALC LINENO 17270CSR EXSR SR613 CHECK LIMIT 17280CSR 54 GOTO T920F PAST LIMIT 17290CSR EXSR SR301 CALC RRN 17300CSR EXSR SR405 GET TXFILE 17310CSR SOPTON COMP 'C' 54 SEARCH OPTION 17320CSR 54 GOTO T920B SEARCH BY COL 17330C*------------------------------------------------------------------- 17340CSR T920AB TAG 17350CSR EXSR SR926 SEARCH GLOBAL 17360CSR 58 SETON 5929 MATCH FLAG 17370CSR 58 GOTO T920C GOT ONE 17380CSR 29 GOTO T920CA 17390CSR GOTO T920A NO HIT 17400C*------------------------------------------------------------------- 17410CSR T920B TAG 17420CSR EXSR SR927 SEARCH BY COL 17430CSRN58 GOTO T920A NO HIT 17440CSR SETON 59 17450C*------------------------------------------------------------------- 17460CSR T920C TAG 17470CSR INSTR COMP 'F' 54 CHK INSTRUCT 17480CSR 54 GOTO T920D FIND INSTR 17490CSR EXSR SR928 REPLACE INSTR 17500CSR SOPTON COMP 'C' 54 ÐÐ17510CSRN54 GOTO T920AB 17520C*------------------------------------------------------------------- 17530CSR T920CA TAG 17540CSR EXSR SR406 UPDATE TXFILE 17550C*------------------------------------------------------------------- 17560CSR T920D TAG 17570CSR EXSR SR502 LFCR 17580CSR EXSR SR74 DISPLAY 17590CSR GOTO T920A 17600C*------------------------------------------------------------------- 17610CSR T920E TAG 17620CSR Z-ADD100 P ADVANCE LINE 17630CSR EXSR SR302 CALC LINE # 17640CSR GOTO T920A 17650C*------------------------------------------------------------------- 17660CSR T920F TAG 17670C* IF NO HITS, DISPLAY MSG. 17680CSRN59 Z-ADD476 M 17690CSRN59 EXSR SR455 17700CSR END920 ENDSR 17710C******************************************************************** 17720CSR SR922 BEGSR 17730C* VERIFY THAT ENOUGH SPACE EXISTS FOR COPY/RESEQ. 17740CSR 44 17750COR 40 EXSR SR401 UPDATE TXMAST ÐÐ17760CSR 41 EXSR SR404 UPDATE TXPTR 17770C*------------------------------------------------------------------- 17780CSR T922A TAG 17790C* COUNT LINES TO BE RESEQ/COPIED. 17800CSR MOVE FRNAME TNAME 17810CSR EXSR SR400 GET TXMAST 17820CSR SETOF 4044 17830CSR EXSR SR923 COUNT LINES REQD 17840C*--------------------------------------------------------------- 17850CSR T922B TAG 17860C* VERIFY LINES AVAIL. 17870CSR EXSR SR616 NAME TO KEY 17880CSR EXSR SR400 GET COPY-TO MAST 17890CSR SETOF 4044 17900CSR EXSR SR924 COUNT LINES AVAIL 17910CSRN58 GOTO END922 SPACE OK 17920C*-------------------------------------------------------------- 17930CSR T922C TAG 17940CSR SETOF 58 17950CSR EXSR SR602 CALC LINES REQD 17960CSR REQD COMP LINENO 54 54 17970CSRN54 GOTO END922 SPACE OK 17980CSR 54 39 EXSR SR613 CHK ENDLIN(RESEQ) 17990CSR 54 INCRMT SUB 1 INCRMT 54 18000CSR 54 GOTO T922C ÐÐ18010CSR Z-ADD475 M 18020CSR EXSR SR455 FLAG ERROR 18030CSR SETON 58 18040C*-------------------------------------------------------------- 18050CSR END922 TAG 18060CSR 40 18070COR 44 EXSR SR401 UPDATE TXMAST 18080CSR EXSR SR616 NAME TO KEY 18090CSR EXSR SR400 GET TXMAST 18100CSR ENDSR 18110C******************************************************************** 18120CSR SR923 BEGSR 18130C* COUNT LINES TO BE RESEQ. 18140CSR START SUB 1 LINENO 18150CSR Z-ADD0 ACTUAL 18160C*------------------------------------------------------------------- 18170CSR T923A TAG 18180CSR 1 ADD LINENO LINENO 18190CSR EXSR SR613 CHK ENDLIN 18200CSR 54 GOTO END923 18210CSR EXSR SR300 CALC B,P 18220CSR EXSR SR612 CHK BLK # 18230CSRN54 EXSR SR610 ADVANCE LINENO 18240CSRN54 GOTO T923A 18250CSR EXSR SR412 GET TXPTR ÐÐ18260CSR EXSR SR618 P=Y COMP 18270CSRN54 GOTO T923A NO LINE 18280CSR 1 ADD ACTUAL ACTUAL 50 COPY LINE 18290CSR GOTO T923A 18300CSR END923 ENDSR 18310C******************************************************************** 18320CSR SR924 BEGSR 18330C* CHK AVAIL SPACE. 18340CSR Z-ADD0 AVAIL 50 18350CSR EXSR SR602 CALC LINES REQD 18360CSR Z-ADDCOPYTO LINENO 18370CSR LINENO SUB 1 LINENO 18380C*------------------------------------------------------------------- 18390CSR T924A TAG 18400CSR 1 ADD LINENO LINENO 18410CSR EXSR SR614 CHECK LINE LIMIT 18420CSR 54 GOTO END924 18430CSR EXSR SR300 CALC B,P 18440CSR EXSR SR612 CHK BLK# 18450CSRN54 EXSR SR610 ADVANCE LINENO 18460CSRN54 W5N ADD AVAIL AVAIL 18470CSRN54 AVAIL COMP REQD 55 55 18480CSRN54 55 GOTO END924 SPACE OK 18490CSRN54 GOTO T924A 18500CSR EXSR SR412 GET TXPTR ÐÐ18510CSR EXSR SR618 P=Y COMP 18520CSR 54 GOTO T924C ACTIVE LINE 18530CSR 1 ADD AVAIL AVAIL 18540CSR LINENO COMP REQD 54 54 18550CSR 54 GOTO END924 HAVE ENOUGH LINES 18560CSR GOTO T924A GET NEXT LINE 18570C*--------------------------------------------------------------- 18580CSR T924C TAG 18590C* SEE IF ACTIVE LINE IS WITHIN CRITICAL AREA 18600CSR REQD COMP LINENO 54 54 18610CSR 54 39 EXSR SR613 CHK ENDLIN(RESEQ) 18620CSRN54 1 ADD AVAIL AVAIL 18630CSRN54 GOTO T924A GET NEXT LINE 18640CSR SETON 58 OVERFLOW FLAG 18650CSR END924 ENDSR 18660C******************************************************************** 18670CSR SR926 BEGSR 18680C* GLOBAL SEARCH. 18690CSR SETOF 58 18700CSR Z-ADD0 LX 30 18710CSR Z-ADD1 X 18720CSR Z-ADD1 A 30 18730CSR EXSR SR607 LOKUP 18740CSRN54 GOTO T926C MATCH 18750CSR FROM,X LOKUPREC,A 54 ÐÐ18760CSRN54 GOTO END926 NO MATCH 18770CSR Z-ADDA FA 30 18780CSR Z-ADDX FX 30 18790C*------------------------------------------------------------------- 18800CSR T926A TAG 18810CSR Z-ADDFX X 18820C*------------------------------------------------------------------- 18830CSR T926B TAG 18840CSR Z-ADDX LX 30 18850CSR 1 ADD X X 18860CSR EXSR SR606 COMP 132 18870CSR 54 GOTO T926C MATCHED 18880CSR EXSR SR607 LOKUP 18890CSRN54 GOTO T926C MATCHED 18900CSR X SUB LX W3N 30 NUMB ADVANCED 18910CSR W3N ADD A A +A SAME AS X 18920CSR A COMP 132 54 18930CSR 54 GOTO END926 18940CSR REC,A COMP FROM,X 54 18950CSR 54 GOTO T926B GET NEXT MATCH 18960C* 'A' NOT MATCHED. START AGAIN. 18970CSR 1 ADD FA FA 18980CSR Z-ADDFA A 18990CSR Z-ADDFX X 19000CSR FROM,X LOKUPREC,A 54 ÐÐ19010CSRN54 GOTO END926 19020CSR GOTO T926B 19030C*------------------------------------------------------------------- 19040CSR T926C TAG 19050CSR SETON 58 19060CSR END926 ENDSR 19070C******************************************************************** 19080CSR SR927 BEGSR 19090C* MATCH TEXT RECORD, BY COL. 19100CSR SETOF 58 19110CSR Z-ADD1 X 19120C*------------------------------------------------------------------- 19130CSR T927A TAG 19140CSR EXSR SR607 LOKUP 19150CSRN54 SETON 58 19160CSRN54 GOTO END927 19170CSR REC,X COMP FROM,X 54 19180CSRN54 GOTO END927 19190CSR 1 ADD X X 19200CSR EXSR SR606 COMP 132 19210CSRN54 GOTO T927A 19220CSR SETON 58 19230CSR END927 ENDSR 19240C******************************************************************** 19250CSR SR928 BEGSR ÐÐ19260C* REPLACE MATCHED DATA (SEE SR920). 19270CSR SOPTON COMP 'C' 54 19280CSR 54 GOTO T928B COLUMN OPTION 19290C* REPLACE FOR GLOBAL OPTION. 19300CSR SETOF 56 19310CSR Z-ADD1 X 19320CSR Z-ADDFA A 19330CSR Z-ADD0 FX 19340C*---------------------------------------------------------------- 19350CSR T928A TAG 19360CSR BIT,32 LOKUPTOR,X 54 19370CSRN54 GOTO END928 19380CSR 56 X SUB FX W3N 19390CSR 56 W3N ADD A A 19400CSR A COMP 132 54 19410CSR 54 GOTO END928 19420CSR SETON 56 19430CSR MOVE TOR,X REC,A 19440CSR Z-ADDX FX 19450CSR 1 ADD X X 19460CSR EXSR SR606 COMP 132 19470CSR 54 GOTO END928 19480CSR GOTO T928A 19490C*------------------------------------------------------------------- 19500CSR T928B TAG ÐÐ19510C* REPLACE FOR COLUMN OPTION. 19520CSR Z-ADD0 X 19530C*------------------------------------------------------------------- 19540CSR T928C TAG 19550CSR 1 ADD X X 19560CSR EXSR SR606 COMP 132 19570CSR 54 GOTO END928 19580CSR BIT,32 LOKUPTOR,X 54 19590CSRN54 GOTO END928 19600CSR MOVE TOR,X REC,X 19610CSR GOTO T928C 19620CSR END928 ENDSR 19630O******************************************************************** 19640OTXMAST EADD 80 44 19650O TNAME 8 19660O TITLE 68 19670O MTYPE 69 19680O BLK 287P 19690O TMSTAT 288 19700O*------------------------------------------------------------------- 19710O E 80N44 40 19720O TITLE 68 19730O MTYPE 69 19740O BLK 287P 19750O TMSTAT 288 ÐÐ19760O******************************************************************** 19770OTXPTR E 81 19780O PAG 100 19790O******************************************************************** 19800OTXFILE E 82 19810O REC 132 19820O TYPE B 133 19830O HLINE B 134 19840O SPACE B 135 19850O******************************************************************** 19860OTXAVAIL E 83 19870O NAB 200 19880O*************************************************************** 19890OTXCOPY E 84 19900O TCPORT 2 19910O CPY 402P 19920O****************************************************************** 19930OBITHEX D LRNLR 19940O BIT 256 ** ALT A B C D E F G L M N R S T \ Y H 019950ALTSEQ C12FC262C363C464C565C666C767D325D43BD53ED972E273E3745F20E879C868 019960** A132 ARRAY 019970 019980** FROM ARRAY 019990 020000ÐÐ** TOR ARRAY 020010 020020** BAT ARRAY 020030 020040** CRT ARRAY 020050 020060** ARA 020070 020080** ARB 020090 020100/* 020110_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(l#_ lX100EM P999999120282(èÈÐ00010H Q100EM00020F* EMPLOYEE MASTER UPDATE - ADD,CHG,DEL, & INPUT JOB STATUS DATA (X100EM) 00030F* REVISED 11-01-82 10:10 AM. 00040F* 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FEMMAST UC F 1536R 5AI 1 DISK A 00090FWCMAST IC F 960R 8AI 1 DISK 00100FEFMAST IC F 90R28AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A40 40 40 1 A INPUT DATA ARRAY 00150E LIN 1 36 3 0 COL 3 0 X-Y POSITIONS 00160E A39 39 39 1 MGTEXT ARRAY 00170E NUM 1 23 3 0 NUMERIC FIELD NO.'S 00180E DUN 1 36 1 A EDIT CMPLT FLAG 00190E MES 1 1 30 00200E LNK 1 7 6 A 00210E DOTS 17 17 2 00220E EJN 1 5 9 NAMES FOR EMJ AR 00230E TABPUM 1 6 1 TABPUN 13 00240E ENJ 1 10 9 JOB STATUS NAMES 00250E BIT 33 1 ÐÐ00260E PAR 25 1 00270E TST 25 1 00280E CALL 7 6 CALL STACK 00290E EMS 2 35 STREET ADDRESS 00300E EME 2 25 NOTIFY EMERGENCY 00310E EEO 8 1 EEO CODE 00320E EMJ 5 1 JOB STATUS CODES 00330E HPD 7 3 1A HOURS PER DAY 00340E STD 7 4 0 START TIMES 00350E EMC 5 5 0 PTR00360E PTH 7 5 1 PAYROLL HRS YTD 00370E PTE 7 9 2 PAYROLL EARNED $ YTD 00380E PTF 6 7 2 FED TAX $ TOTALS 00390E PTS 6 7 2 STATE TAX $ TOTALS 00400E PRT 20 2 DEDUCTION TYPE 00410E PRB 20 6 0 DEDUCTION BEGIN DATE 00420E PRS 20 6 0 DEDUCTION STOP DATE 00430E PRC 20 1 DEDUCTION AMOUNT CODE 00440E PRA 20 7 2 DEDUCTION AMOUNT $ 00450E PRY 20 7 2 DEDUCTION AMOUNT YTD 00460E PRN 20 14 DEDUCTION ACCOUNT # 00470I******************************************************************* 00480IBITPAR BT 00490I 1 33 BIT 00500I 34 58 PAR ÐÐ00510I 59 83 TST 00520I******************************************************************* 00530IMGFILE MG 00540I* MESSAGE FILE. 00550I 1 35 MGTEXT 00560I****************************************************************** 00570ICRTFILE CR 00580I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00590I* EMPLOYEE # 5N 00600I 1 50CREMPL 00610I* TERMINAL USER CODE 00620I 6 13 CRUSER 00630I* DEPT # 5N 00640I 14 180CRDEPT 00650I* JOB NAME 8A (JOB LOADED BY MENU) 00660I* 19 26 CRJOB 00670I* SHUTDOWN FLAG 1A 00680I* BLANK = NO SHUTDOWN 00690I 27 27 CRSHUT 00700I* TIME STARTED 6N 00710I 28 330CRTIME 00720I* DATE STARTED 4N 00730I 34 370CRDATE 00740I* CALL STACK 7 X 6A 00750I 38 79 CALL ÐÐ00760I******************************************************************** 00770IEMMAST EM 00780I* EMPLOYEE MASTER 00790I* CLOCK # 5N 00800I 1 50EMCLOK 00810I*-------PERSONAL DATA------------------------------------------------ 00820I* NAME 00830I* 1ST 25A 00840I 7 31 EMFNAM 00850I* MIDDLE 25A 00860I 32 56 EMMNAM 00870I* LAST 30A 00880I 57 86 EMLNAM 00890I* ADDRESS 00900I* STREET 35A X 2 00910I 87 156 EMS 00920I* CITY 25A 00930I 157 181 EMCITY 00940I* STATE 2A 00950I 182 183 EMSTCD 00960I* ZIP 9P 00970I P 184 1880EMZIP 00980I* TELEPHONE 15A 00990I 189 203 EMPHON 01000I* NOTIFY IN EMERGENCY 25A X 2 ÐÐ01010I 204 253 EME 01020I* EEO CODE 1A X 8 01030I 254 261 EEO 01040I* BIRTH DATE 6N (YMD) 01050I 262 2670EMBIRD 01060I* EDUCATION 30A 01070I 268 297 EMEDUC 01080I* SPOUSE NAME 30A 01090I 298 327 EMSNAM 01100I* SPOUSE BIRTH DATE 6N (YMD) 01110I 328 3330EMSBIR 01120I*-------JOB STATUS---------------------------------------------------- 01130I* FILLER 2A 334 335 FFFFFF 01140I* 01150I* DEPT 5P 01160I P 336 3380EMDEPT 01170I* WORK CENTER 3P 01180I P 339 3400EMWC 01190I* JOB NAME 28A 01200I 341 368 EMJOB 01210I* JOB STATUS 1A X 5 01220I* 1 = ADMIN(A) OR FACTORY(F) 01230I* 2 = PERMANENT(P) OR TEMPORARY(T) 01240I* 3 = FULL TIME(F) OR PART TIME(P) 01250I* 4 = HOURLY(H) OR SALARY(S) ÐÐ01260I* 5 = DIRECT(D) OR INDIRECT(I) 01270I 370 374 EMJ 01280I* PAY RATE 9.3P 01290I P 375 3793EMRATE 01300I* PAY UNIT 1A 01310I* H = HOURLY 01320I* D = DAILY 01330I* W = WEEKLY 01340I* M = MONTHLY 01350I* S = SEMI-MONTHLY 01360I* A = ANNUALLY (YR) 01370I 380 380 EMPUM 01380I* PAY FREQUENCY 1A 01390I* W = WEEKLY 01400I* S = SEMI-MONTHLY 01410I* M = MONTHLY 01420I 381 381 EMPFRQ 01430I* HOLD PAYCHECK CODE 1A 01440I 382 382 EMHOLD 01450I* WORK SHIFT DATA 01460I* HOURS PER DAY 3.1P X 7 01470I P 383 396 HPD 01480I* START TIMES 4B X 7 01490I B 397 410 STD 01500I* HOURS PER WEEK 5.1P ÐÐ01510I P 411 4131EMHPW 01520I* CURRENT PERIOD PAYROLL TOTALS 01530I* HRS WORKED 5.1P 01540I P 414 4161EMCPHW 01550I* O.T. HRS WORKED 5.1P 01560I P 417 4191EMCPOW 01570I* O.T. AUTHORIZED 5.1P 01580I P 420 4221EMCPOA 01590I* REVIEW DATA 01600I* LAST REVIEW DATE 6N 01610I 458 4630EMLRD 01620I* LAST REVIEW TYPE 1A 01630I 464 464 EMLRT 01640I* LAST PAY INCREASE DATE 6N 01650I 465 4700EMLRP 01660I* LAST PAY INCREASE AMOUNT 5.2P 01670I P 471 4732EMLPA 01680I* NEXT SCHED REVIEW DATA 6N 01690I 476 4810EMNSRD 01700I* NEXT SCHED REVIEW COMMENT 15A 01710I 482 496 EMNSRR 01720I* REVIEW FREQUENCY 1N (MOS) 01730I 497 4970EMRFRQ 01740I* DATE HIRED 6N 01750I 498 5030EMHIRD ÐÐ01760I* ADDITIONAL SENIORITY ALLOWED 01770I* YEARS 2N 01780I 504 5050EMASYR 01790I* MONTHS 2N 01800I 506 5070EMASMO 01810I* DAYS 2N 01820I 508 5090EMASDY 01830I* TERMINATION DATA 01840I* DATE 6N 01850I 510 5150EMDATT 01860I* REASON CODE 2A 01870I 516 517 EMTREA 01880I* COMMENTS PRTS 5P X 5 01890I P 518 532 EMC 01900I* REHIRE ELIGIBILITY CODE 1A 01910I 533 533 EMREH 01920I*-------VACATION---------------------------------------------------- 01930I* CLASS CODE 1A 01940I 534 534 EMVCC 01950I* EARNED HOURS 9.6P 01960I P 535 5396EMVEH 01970I* HOURS TAKEN 5.1P 01980I P 540 5421EMVHT 01990I* LAST DATE PAID IN LIEU OF 6N 02000I 543 5480EMVLDP ÐÐ02010I* SCHEDULED LEAVE DATE 6N 02020I 549 5540EMVSLD 02030I* ACTUAL LEAVE DATE 6N 02040I 555 5600EMVALD 02050I* SCHEDULED RETURN DATE 6N 02060I 561 5660EMVSRD 02070I* ACTUAL RETURN DATE 6N 02080I 567 5720EMVARD 02090I*-------SICK LEAVE-------------------------------------------------- 02100I* EARNED HOURS 9.6P 02110I P 573 5776EMSLEH 02120I* HOURS TAKEN 5.1P 02130I P 578 5801EMSLHT 02140I* LAST DATE PAID IN LIEU OF 6N 02150I 581 5860EMSLDP 02160I* SCHEDULED LEAVE DATE 6N 02170I 587 5920EMSLSL 02180I* ACTUAL LEAVE DATE 6N 02190I 593 5980EMSLAL 02200I* SCHEDULED RETURN DATE 6N 02210I 599 6040EMSLSR 02220I* ACTUAL RETURN DATE 6N 02230I 605 6100EMSLAR 02240I*-------FEDERAL TAX CODES-------------------------------------------- 02250I* MARITAL STATUS 1A ÐÐ02260I* M = MARRIED 02270I* S = SINGLE 02280I* H = HEAD OF HOUSEHOLD 02290I* X = EXEMPT 02300I 611 611 EMFTMS 02310I* NUMBER OF EXEMPTIONS 2N 02320I 612 6130EMFTNE 02330I* EXTRA EXEMPTIONS 2N 02340I 614 6150EMFXEX 02350I* XTRA WITHHOLDING CODE 1A (%,$) 02360I 616 616 EMFTXC 02370I* XTRA WITHHOLDING AMOUNT 4N 02380I 617 6200EMFTXA 02390I* SOCIAL SECURITY NO. 14A 02400I 621 634 EMSS 02410I* COMPREHENSIVE INSURANCE CLASS 1A 02420I 635 635 EMCICA 02430I* EIC CLAIM (1,2) 1N 02440I 636 6360EMFEIC 02450I*-------STATE TAX CODES------------------------------------------- 02460I* MARITAL STATUS 1A 02470I* M = MARRIED 02480I* S = SINGLE 02490I* H = HEAD OF HOUSEHOLD 02500I* X = EXEMPT ÐÐ02510I 637 637 EMSTMS 02520I* NUMBER OF EXEMPTIONS 2N 02530I 638 6390EMSTNE 02540I* EXTRA EXEMPTIONS 2N 02550I 640 6410EMSXEX 02560I* XTRA WITHHOLDING CODE 1A 02570I 642 642 EMSTXC 02580I* XTRA WITHHOLDING AMOUNT 4N 02590I 643 6460EMSTXA 02600I* EICA CLAIM 1N 02610I 647 6470EMSEIC 02620I*-------PAYROLL TOTALS YEAR TO DATE ------------------------------- 02630I* HOURS ARRAY 5.1P X 7 02640I* 1 = REGULAR 02650I* 2 = PREMIUM 02660I* 3 = VACATION 02670I* 4 = SICK LEAVE 02680I* 5 = ABSENT 02690I* 6 = OTHER 02700I* 7 = NOT USED 02710I P 648 668 PTH 02720I* EARNED DOLLARS 9.2P X 7 02730I* 1 = REGULAR 02740I* 2 = PREMIUM 02750I* 3 = VACATION ÐÐ02760I* 4 = SICK LEAVE 02770I* 5 = BONUS 02780I* 6 = OTHER 02790I* 7 = NOT USED 02800I P 669 703 PTE 02810I* DEDUCTION TOTALS 02820I* FEDERAL TAX 7.2P X 6 02830I* 1 = WITHHOLDING 02840I* 2 = XTRA WITHHOLDING 02850I* 3 = REBATED 02860I* 4 = FICA 02870I* 5 = EIC 02880I* 6 = NOT USED 02890I P 704 727 PTF 02900I* STATE TAX 7.2P X 6 02910I* 1 = WITHHOLDING 02920I* 2 = XTRA WITHHOLDIG 02930I* 3 = REBATED 02940I* 4 = S.D.I. 02950I* 5 = EIC 02960I* 6 = NOT USED 02970I P 728 751 PTS 02980I*-------PAYROLL DEDUCTIONS------------------------------------------ 02990I* 03000I* TYPE CODE 2A X 20 ÐÐ03010I 752 791 PRT 03020I* START DATE 6N X 20 03030I 792 911 PRB 03040I* STOP DATE 6N X 20 03050I 9121031 PRS 03060I* AMOUNT CODE (%,$) 1A X 20 03070I 10321051 PRC 03080I* AMOUNT 7.2P X 20 03090I P10521131 PRA 03100I* YTD $ TOTAL 7.2P X 20 03110I P11321211 PRY 03120I* ACCOUNT NO. 14A X 20 03130I 12121491 PRN 03140I*-------LEAVE OF ABSENCE-------------------------------------------- 03150I* LEAVE DATE 6N 03160I 149214970EMLOAL 03170I* RETURN DATE 6N 03180I 149815030EMLOAR 03190I* DAYS TAKEN 3P 03200I P150415050EMLOAT 03210I* PAYROLL FLAG 1A 03220I 15351535 EMFLAG 03230I* RECORD STATUS 1A 03240I 15361536 EMSTAT 03250I******************************************************************** ÐÐ03260IWCMAST WC 03270I 9 37 WCNAME 03280I 960 960 WCSTAT 03290I******************************************************************* 03300IEFMAST EF 03310I* JOB NAME FILE 03320I* JOB CODE 8A 03330I* 1 8 EFCODE 03340I* JOB NAME 20A 03350I 9 28 EFNAME 03360I* RECORD STATUS 1A 03370I 90 90 EFSTAT 03380C******************************************************************** 03390C* INITIALIZE 03400C EXSR SR101 1-TIME INIT 03410C MOVE ' ' BLK6 6 STUPIDITY 03420C*------------------------------------------------------------------ 03430C START TAG 03440C* SET-UP 1ST FIELD NO. 03450C EXSR SR66 INIT A39 03460C MOVE ' ' DUN INIT EDIT ARRAY 03470C Z-ADD1 F 30 FIELD # 03480C EXSR SR205 INIT MAST 03490C EXSR SR206 INIT INPUT 03500C EXSR SR70 NEW PAGE ÐÐ03510C GOTO READ 03520C*------------------------------------------------------------------ 03530C NEXT TAG 03540C EXSR SR66 INIT A39 03550C 1 ADD F F FIELD # 03560C*----------------------------------------------------------------- 03570C READ TAG 03580C* READ DATA FROM TERMINAL. 03590C SETOF 909677 03600C SETOF 95 03610C EXSR SR102 VALIDATE FIELD # 03620C 55 GOTO UPDATE DONE 03630C EXSR SR201 IDENTIFY-F 03640C 18N78 03650COR 25N78 03660COR 32 EXSR SR66 INIT A39 03670C SETOF 78 03680C EXSR SR203 03690C 62 F COMP 3 54 03700C 62 54 GOTO UPDATE 03710C 32 GOTO EDIT 03720C SETON 69 03730C EXSR SR72 PROMPT 03740C SETOF 69 03750C EXSR SR75 READ TERMINAL ÐÐ03760C 90N88 EXSR SR72 DISPLAY INPUT DATA 03770C 93 GOTO START NEW ITEM 03780C 92 GOTO JUMP FIELD JUMP REQST 03790C 89 F SUB 1 F SKIP BACKWARD 03800C 89 EXSR SR201 03810C 89 32 Z-ADD31 F 03820C 89 GOTO READ " " 03830C 88 SETOF 90 SPACE FILL 03840C 88 SETON 77 " " 03850C 86 GOTO UPDATE UPDATE 03860C 85 GOTO READ REPEAT 03870C 96 GOTO ERROR ERROR 03880C 77 EXSR SR103 MOVE DATA 03890C*------------------------------------------------------------------- 03900C EDIT TAG 03910C EXSR SR104 EDIT DATA 03920C N95N96 EXSR SR72 REWRITE DATA 03930C N95N96 GOTO NEXT 03940C GOTO ERROR ERROR 03950C* 03960C*------------------------------------------------------------------ 03970C UPDATE TAG 03980C* UPDATE DATA BASE. 03990C EXSR SR105 FINAL EDIT 04000C 96 GOTO ERROR ERROR ÐÐ04010C EXSR SR106 UPDATE 04020C 96 GOTO ERROR ERROR 04030C 1 ADD COUNT COUNT 30 04040C GOTO START 04050C*------------------------------------------------------------------- 04060C JUMP TAG 04070C* SET-UP JUMP TO REQUESTED FIELD 04080C 1 ADD W W 30 04090C W COMP 40 54 04100C 54 Z-ADD318 M 50 96 FLAG ERROR 04110C 54 GOTO ERROR BAD ESC 04120C MOVE ' ' W3A 3 04130C MOVEAA40,W W3A 04140C Z-ADD3 W2N 20 04150C EXIT SUBRAJ R. JUSTIFY 04160C RLABL W2N 04170C RLABL W3A 04180C MOVE W3A F NEW FIELD # 04190C EXSR SR201 04200C 32 Z-ADD31 F 04210C GOTO READ 04220C*-------------------------------------------------------------------- 04230C ERROR TAG 04240C N95N96 GOTO READ 04250C SETON 78 ÐÐ04260C EXSR SR89 GET MESSAGE 04270C 95 EXSR SR72 DISPLAY DATA/MSG 04280C 95 GOTO NEXT 04290C GOTO READ 04300C* 04310C* 04320C*-------------------------------------------------------------------- 04330C NEWITM TAG 04340C MOVEL'Q100EM' PROG 8 04350C GOTO END 04360C*------------------------------------------------------------------- 04370C MENU TAG 04380C* SET-UP LINK TO MENU 04390C EXSR SR96 GET CRTFILE 04400C Z-ADD1 W 04410C BLK6 LOKUPLNK,W 54 04420C 54 MOVELLNK,W PROG 8 04430C 54 MOVE BLK6 LNK,W 04440C N54 MOVEL'CONTU 'PROG 04450C EXSR SR97 UPDATE CRTFILE 04460C EXSR SR98 >>>>>>>>>>>>> 04470C*-------------------------------------------------------------------- 04480C GOODBY TAG 04490C* LINK TO SIGN-OFF 04500C MOVEL'GOODBY' PROG ÐÐ04510C*---------------------------------------------------------------- 04520C END TAG 04530C EXSR SR96 GET CRTFILE 04540C EXSR SR97 REWRITE CRTFILE 04550C EXSR SR98 >>>>>>>>>>> 04560C*------------------------------------------------------------------- 04570C ENDJOB TAG 04580C MOVEL'ENDJOB' PROG 04590C EXSR SR98 >>>>>>>>>>>>>>>> 04600C********************************************************************* 04610CSR SR1 BEGSR 04620C* EDIT TRAN CODE. 04630CSR EXSR SR203 CLASSIFY TRAN 04640CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 04650CSR ENDSR 04660C******************************************************************** 04670CSR SR2 BEGSR 04680C* EDIT CLOCK #. 04690CSR SETON 68 04700CSR TCLOCK COMP 0 54 04710CSRN54 Z-ADD400 M 96 FLAG ERROR 04720CSRN54 GOTO END2 04730CSR EXSR SR80 GET EMMAST 04740CSRN40N41 GOTO T2C GOT IT 04750CSR EXSR SR205 INIT EMMAST ÐÐ04760CSR EXSR SR203 CLASSIFY TRAN 04770CSRN60 Z-ADD5 M 96 FLAG ERROR 04780CSR EXSR SR71 PUT SCREEN 04790CSR GOTO END2 04800C*------------------------------------------------------------------- 04810CSR T2C TAG 04820C* IS ON FILE. 04830CSR EXSR SR203 CLASSIFY TRAN 04840CSR 60 Z-ADD301 M 96 FLAG ERROR 04850CSR 62 EMFLAG COMP 'P' 54 04860CSR 62 54 Z-ADD29 M 96 FLAG ERROR 04870CSR 62 54 GOTO END2 04880CSR EXSR SR7 04890CSR EXSR SR8 04900CSR EXSR SR66 INIT A39 04910CSR EXSR SR14 04920CSR EXSR SR15 04930CSR EXSR SR16 04940CSR EXSR SR50 SET-UP JOB CODES 04950CSR SETON 42 04960CSR EXSR SR71 PUT SCREEN 04970CSR SETOF 42 04980C*------------------------------------------------------------------- 04990CSR END2 TAG 05000CSR SETOF 68 ÐÐ05010CSR ENDSR 05020C******************************************************************** 05030CSR SR3 BEGSR 05040C* EDIT 1ST NAME. 05050CSR EMFNAM COMP BLK25 54 05060CSRN54 Z-ADD371 M FLAG WARNING 05070CSRN54 EXSR SR89 GET MSG 05080CSR ENDSR 05090C******************************************************************** 05100CSR SR5 BEGSR 05110C* EDIT LAST NAME. 05120CSR EMLNAM COMP BLK30 54 05130CSRN54 Z-ADD224 M 96 FLAG ERROR 05140CSR ENDSR 05150C******************************************************************** 05160CSR SR6 BEGSR 05170C* EDIT DEPT. 05180CSR EMDEPT COMP 0 54 05190CSRN54 Z-ADD552 M 96 FLAG ERROR 05200CSR ENDSR 05210C******************************************************************** 05220CSR SR7 BEGSR 05230C* EDIT WORK CENTER. 05240CSR SETOF 55 05250CSR 96 SETON 55 ÐÐ05260CSR MOVE BLK35 WCNAME 05270CSR MOVELEMDEPT W8A 8 05280CSR MOVE EMWC W8A 05290CSR W8A CHAINWCMAST 60 05300CSRN60 WCSTAT COMP 'D' 60 05310CSR 60N68 Z-ADD304 M 96 FLAG ERROR 05320CSR 96N55N68 Z-ADD7 F 05330CSR ENDSR 05340C******************************************************************* 05350CSR SR8 BEGSR 05360C* EDIT JOB NAME 05370CSR EMJOB COMP BLK28 54 05380CSRN54 GOTO END8 05390CSR EMJOB CHAINEFMAST 54 05400CSRN54 EFSTAT COMP 'D' 54 05410CSR 54N68 Z-ADD384 M FLAG WARNING 05420CSR 54N68 EXSR SR89 05430CSR END8 ENDSR 05440C******************************************************************* 05450CSR SR9 BEGSR 05460C* EDIT ADMIN/FACTORY. 05470CSR EXSR SR51 05480CSRN55N56 Z-ADD615 M 96 FLAG ERROR 05490CSR ENDSR 05500C******************************************************************** ÐÐ05510CSR SR10 BEGSR 05520C* EDIT PERM/TEMP. 05530CSR SETOF 52 05540CSR EXSR SR52 05550CSRN55N56 SETON 52 05560CSR 52 MOVE 'P' EMJ,2 DEFAULT 05570CSR 52 Z-ADD693 M 95 FLAG WARNING 05580CSR 52 EXSR SR52 05590CSR ENDSR 05600C******************************************************************** 05610CSR SR11 BEGSR 05620C* EDIT FULL/PART TIME. 05630CSR SETOF 52 05640CSR EXSR SR53 05650CSRN55N56 SETON 52 05660CSR 52 MOVE 'F' EMJ,3 DEFAULT 05670CSR 52 Z-ADD693 M 95 FLAG WARNING 05680CSR 52 EXSR SR53 05690CSR ENDSR 05700C******************************************************************** 05710CSR SR12 BEGSR 05720C* EDIT HOURLY/SALARY. 05730CSR SETOF 52 05740CSR EXSR SR54 05750CSRN55N56 SETON 52 ÐÐ05760CSR 52 MOVE 'H' EMJ,4 DEFAULT 05770CSR 52 Z-ADD693 M 95 FLAG WARNING 05780CSR 52 EXSR SR54 05790CSR ENDSR 05800C******************************************************************** 05810CSR SR13 BEGSR 05820C* EDIT DIRECT/INDIRECT. 05830CSR SETOF 52 05840CSR EXSR SR55 05850CSRN55N56 SETON 52 05860CSR 52 EMJ,1 COMP 'A' 54 05870CSR 52 54 MOVE 'I' EMJ,5 INDIRECT 05880CSR 52N54 MOVE 'D' EMJ,5 DIRECT 05890CSR 52 Z-ADD693 M 95 FLAG DEFAULT 05900CSR 52 EXSR SR55 05910CSR ENDSR 05920C****************************************************************** 05930CSR SR14 BEGSR 05940C* EDIT PAY RATE 05950CSR EMRATE COMP 0 54 05960CSR 54 EMRATE COMP 250000 54 LT 05970CSRN54N68 Z-ADD387 M 96 FLAG ERROR 05980CSR ENDSR 05990C***************************************************************** 06000CSR SR15 BEGSR ÐÐ06010C* EDIT PAY UNIT 06020CSR MOVE BLK20 NAMEMP 13 06030CSR EMPUM LOKUPTABPUM TABPUN 54 06040CSR 54 MOVE TABPUN NAMEMP 06050CSRN54N68 Z-ADD26 M 96 FLAG ERROR 06060CSR ENDSR 06070C************************************************************* 06080CSR SR16 BEGSR 06090C* EDIT PAY FREQUENCY CODE 06100CSR MOVE BLK20 NAMEPF 9 06110CSR EMPFRQ COMP 'W' 54 06120CSR EMPFRQ COMP 'S' 55 06130CSR EMPFRQ COMP 'M' 56 06140CSRN68 06150CANN54N55N56 Z-ADD615 M 96 FLAG ERROR 06160CSR 54 MOVEL'WEEKLY' NAMEPF 06170CSR 55 MOVEL'SEMI-MON'NAMEPF 06180CSR 56 MOVEL'MONTHLY' NAMEPF 06190CSR ENDSR 06200C******************************************************************** 06210CSR SR18 BEGSR 06220C* EDIT HRS PER DAY 06230CSR EXSR SR208 EDIT HRS PER DAY 06240CSR END18 ENDSR 06250C******************************************************************** ÐÐ06260CSR SR25 BEGSR 06270C* EDIT START TIME. 06280CSR EXSR SR209 EDIT START TIME 06290CSR END25 ENDSR 06300C************************************************************** 06310CSR SR32 BEGSR 06320C* EDIT HRS PER WEEK 06330CSR XFOOTHPD EMHPW 54 COMPUTE HRS PER WEEK 06340CSRN54 Z-ADD694 M 96 FLAG ERROR 06350CSRN96 EMHPW COMP 40 54 06360CSRN96 54 Z-ADD695 M FLAG WARNING 06370CSRN96 54 EXSR SR89 06380C*---------------------------------------------------------------- 06390CSR END32 TAG 06400CSR 96 Z-ADD18 F 06410CSR 96 EXSR SR201 REIDENTIFY F 06420CSR ENDSR 06430C********************************************************************** 06440CSR SR33 BEGSR 06450C* EDIT START DATE 06460CSR EMHIRD COMP 0 54 06470CSRN54 Z-ADD380 M 96 FLAG ERROR 06480CSRN54 GOTO END33 06490CSR MOVELEMHIRD W2N 06500CSR W2N COMP 12 54 ÐÐ06510CSRN54 MOVELEMHIRD W4N 40 06520CSRN54 MOVE EMHIRD W2N 06530CSRN54 MOVELW2N EMHIRD 06540CSRN54 MOVE W4N EMHIRD 06550CSR MOVELEMHIRD YR 20 06560CSR MOVE EMHIRD W4N 06570CSR MOVELW4N MO 20 06580CSR MOVE W4N DAY 20 06590CSR MOVE UDATE W2N 06600CSR YR COMP 60 54 06610CSR 54 YR COMP W2N 5454 06620CSR 54 MO COMP 0 54 06630CSR 54 MO COMP 12 5454 06640CSR 54 DAY COMP 0 54 06650CSR 54 DAY COMP 31 5454 06660CSRN54 Z-ADD380 M 96 FLAG ERROR 06670CSRN54 GOTO END33 06680CSR EMDATT COMP 0 54 06690CSRN54 GOTO END33 06700CSR EMDATT COMP EMHIRD 54 54 06710CSRN54 Z-ADD380 M 96 FLAG ERROR 06720CSR END33 ENDSR 06730C******************************************************************** 06740CSR SR50 BEGSR 06750C* GENERAL EDIT - JOB STATUS CODES. ÐÐ06760CSR EXSR SR51 06770CSR EXSR SR52 06780CSR EXSR SR53 06790CSR EXSR SR54 06800CSR EXSR SR55 06810CSR ENDSR 06820C******************************************************************** 06830CSR SR51 BEGSR 06840C* ADMIN/FACTORY. 06850CSR EMJ,1 COMP 'A' 55 06860CSR EMJ,1 COMP 'F' 56 06870CSR MOVE BLK35 EJN,1 06880CSR 55 MOVELENJ,1 EJN,1 ADMIN 06890CSR 56 MOVELENJ,2 EJN,1 FACTORY 06900CSR ENDSR 06910C******************************************************************** 06920CSR SR52 BEGSR 06930CSR EMJ,2 COMP 'P' 55 06940CSR EMJ,2 COMP 'T' 56 06950CSR MOVE BLK35 EJN,2 06960CSR 55 MOVELENJ,3 EJN,2 PERMANENT 06970CSR 56 MOVELENJ,4 EJN,2 TEMPORARY 06980CSR ENDSR 06990C******************************************************************** 07000CSR SR53 BEGSR ÐÐ07010C* FULL/PART TIME. 07020CSR EMJ,3 COMP 'F' 55 07030CSR EMJ,3 COMP 'P' 56 07040CSR MOVE BLK35 EJN,3 07050CSR 55 MOVELENJ,5 EJN,3 FULL TIME 07060CSR 56 MOVELENJ,6 EJN,3 PART TIME 07070CSR ENDSR 07080C************************************************************************ 07090CSR SR54 BEGSR 07100CSR EMJ,4 COMP 'S' 55 07110CSR EMJ,4 COMP 'H' 56 07120CSR MOVE BLK35 EJN,4 SALARY 07130CSR 55 MOVELENJ,7 EJN,4 HOURLY 07140CSR 56 MOVELENJ,8 EJN,4 07150CSR ENDSR 07160C************************************************************************ 07170CSR SR55 BEGSR 07180CSR EMJ,5 COMP 'I' 55 07190CSR EMJ,5 COMP 'D' 56 07200CSR MOVE BLK35 EJN,5 07210CSR 55 MOVELENJ,9 EJN,5 INDIRECT 07220CSR 56 MOVELENJ,10 EJN,5 DIRECT 07230CSR ENDSR 07240C************************************************************************ 07250CSR SR66 BEGSR ÐÐ07260CSR MOVEABLK35 A39,3 INIT A39 07270CSR ENDSR 07280C******************************************************************** 07290CSR SR67 BEGSR 07300CSR EXITFZCR 07310CSR ENDSR 07320C***************************************************************** 07330CSR SR68 BEGSR 07340CSR EXITFZLF LINE FEED 07350CSR ENDSR 07360C**************************************************************** 07370CSR SR69 BEGSR 07380CSR 50 EXITFZPUTXY MOVE CURSOR 07390CSR RLABL RPGLIN 07400CSR RLABL RPGCOL 07410CSRN50 EXITFZMOVXY MOVE CURSOR 07420CSR RLABL RPGLIN 07430CSR RLABL RPGCOL 07440CSR ENDSR 07450C***************************************************************** 07460CSR SR70 BEGSR 07470C* CLEAR TERM SCREEN. 07480CSR 50 EXITFZISTAT INIT STATUS LINE 07490CSR 50 EXITFZESCH CLEAR SCREEN 07500CSRN50 EXITFZCPAGE CLEAR SCREEN ÐÐ07510CSRN50 MOVEL'091' RPGLIN 07520CSRN50 MOVEL'001' RPGCOL 07530CSRN50 EXSR SR69 MOVE CURSOR 07540CSR Z-ADD91 COUNT 30 07550CSR SETON 70 07560CSRN51 EXCPT PUT HDG 1ST LINE 07570CSR SETOF 70 07580CSR ENDSR 07590C********************************************************************** 07600CSR SR71 BEGSR 07610C* PUT HEADINGS TO TERMINAL 07620CSR 42 EMDATT COMP 0 43 07630CSR SETON 71 07640CSR EXCPT PUT HEADINGS 07650CSR SETOF 7143 07660CSR Z-ADD91 COUNT 07670CSR ENDSR 07680C********************************************************************* 07690CSR SR72 BEGSR 07700C* PUT DATA TO TERMINAL 07710CSR LIN,F SUB 1 W3N 30 07720CSRN50 90 ADD W3N W3N 30 07730CSR MOVELW3N RPGLIN 4 07740CSR MOVELCOL,F RPGCOL 4 07750CSR EXSR SR69 MOVE CURSOR ÐÐ07760CSR SETON 72 07770CSR EXCPT PUT DATA 07780CSR SETOF 72 07790CSR ENDSR 07800C**************************************************************** 07810CSR SR74 BEGSR 07820C* PUT WARNING MESSAGE 07830CSR EXSR SR89 GET MESSAGE 07840CSR EXSR SR72 PUT MESSAGE 07850CSR ENDSR 07860C******************************************************************* 07870CSR SR75 BEGSR 07880C* READ FROM TERMINAL 07890CSR SETOF 779096 07900CSR SETOF 9392 07910CSR SETOF 8988 07920CSR SETOF 8685 07930CSR EXSR SR66 INIT A39 07940CSR MOVE BLK40 W40A 40 BUFFER 07950CSR Z-ADDLIN,F W3N 30 07960CSRN50 90 ADD W3N W3N 30 07970CSR MOVELW3N RPGLIN 4 07980CSR MOVELCOL,F RPGCOL 4 07990CSR EXSR SR69 MOVE CURSOR 08000CSR EXITFZR40 READ FROM TERMINAL ÐÐ08010CSR RLABL W40A READ BUFFER 08020CSR MOVEAW40A A40 INPUT DATA ARRAY 08030CSR MOVE BLK40 W40A INIT INPUT ARRAY 08040CSR Z-ADD1 W 30 08050CSR '\' LOKUPA40,W 90 FLAG ESC 08060CSRN90 GOTO T75B NOT ESC 08070CSR 1 ADD W W 08080CSR W COMP 40 54 08090CSR 54 GOTO T75A BAD ESC 08100CSR A40,W COMP 'G' 98 GOODBY 08110CSR A40,W COMP 'E' 94 MENU 08120CSR A40,W COMP 'N' 93 NEW ITEM 08130CSR A40,W COMP 'J' 92 JUMP 08140CSR A40,W COMP 'B' 89 SKIP BKWRD 08150CSR A40,W COMP 'S' 88 SPACE FILL 08160CSR A40,W COMP 'U' 86 UPDATE 08170CSR A40,W COMP 'R' 85 REPEAT 08180CSR 98 GOTO GOODBY 08190CSR 94 GOTO MENU 08200CSR 93 GOTO NEWITM 08210CSR 92 08220COR 89 08230COR 88 08240COR 86 08250COR 85 GOTO END75 GOOD ESC ÐÐ08260C*------------------------------------------------------------------ 08270CSR T75A TAG 08280C* FLAG BAD ESC INPUT 08290CSR Z-ADD318 M 96 FLAG ERROR 08300CSR GOTO END75 08310C*-------------------------------------------------------------------- 08320CSR T75B TAG 08330C* MOVE DATA 08340CSR Z-ADD1 W 08350CSR ' ' LOKUPA40,W 77 08360CSR 77 MOVEAA40,W W40A INPUT DATA 08370C*-------------------------------------------------------------------- 08380CSR END75 TAG 08390C* INIT PREV ERROR MSG. 08400CSR EXSR SR66 08410CSR ENDSR 08420C********************************************************************** 08430CSR SR80 BEGSR 08440C* GET MASTER RECORD 08450CSR SETOF 41 08460CSR TCLOCK CHAINEMMAST 40 GET MASTER 08470CSRN40 EMSTAT COMP 'D' 41 FLAG DELETE 08480CSR 40 08490COR 41 EXSR SR205 INIT MASTER 08500CSR EXSR SR207 SAVE MASTER ÐÐ08510CSR ENDSR 08520C********************************************************************** 08530CSR SR81 BEGSR 08540C* ADD NEW MASTER TO FILE 08550CSR SETON 81 08560CSR EXCPT ADD MASTER 08570CSR SETOF 81 08580CSR ENDSR 08590C*********************************************************************** 08600CSR SR82 BEGSR 08610C* REWRITE MASTER 08620CSR SETON 82 08630CSR EXCPT REWRITE MASTER 08640CSR SETOF 82 08650CSR ENDSR 08660C********************************************************************** 08670CSR SR89 BEGSR 08680C* GET MESSAGE MASTER 08690CSR M CHAINMGFILE 54 08700CSR 54 MOVE BLK35 MGTEXT 08710CSR 54 MOVELM MGTEXT 08720CSR 54 MOVE MES,1 MGTEXT 08730CSR MOVEAMGTEXT A39,3 08740CSR ENDSR 08750C******************************************************************** ÐÐ08760CSR SR96 BEGSR 08770CSR # CHAINCRTFILE H9 GET CRTFILE 08780CSR H9 GOTO ENDJOB 08790CSR ENDSR 08800C****************************************************************** 08810CSR SR97 BEGSR 08820C* UPDATE CRTFILE. EXIT PROGRAM. 08830CSR TIME CRTIME 08840CSR MOVELUDATE CRDATE 08850CSR SETON 97 08860CSR EXCPT UPDATE CRTFILE 08870CSR SETOF 97 08880CSR ENDSR 08890CSR SR98 BEGSR 08900CSR SETON 51 08910CSR EXSR SR70 CLEAR SCREEN 08920CSR EXITFCHAIN >>>>>>>>>> 08930CSR RLABL PROG 08940CSR ENDSR 08950C******************************************************************** 08960CSR SR99 BEGSR 08970C* STORE THIS PROG AS RETURN TO PROG. 08980CSR EXSR SR96 GET CRTFILE 08990CSR Z-ADD8 W 09000C*------------------------------------------------------------------- ÐÐ09010CSR T99A TAG 09020CSR W SUB 1 W 54 09030CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> 09040CSR LNK,W COMP BLK6 54 09050CSRN54 GOTO T99A 09060CSR MOVELRETURN LNK,W 09070CSR EXSR SR97 UPDATE CRTFILE 09080CSR EXSR SR98 >>>>>>>>>>>>>> 09090CSR END99 ENDSR 09100C*********************************************************************** 09110CSR SR101 BEGSR 09120C* 1-TIME INITIALIZE 09130CSR MOVE BIT,1 NUL 09140CSR MOVE ' ' A39 09150CSR MOVE BIT,28 A39,1 09160CSR MOVE 'D' A39,2 09170CSR MOVE BIT,28 A39,38 09180CSR MOVE 'E' A39,39 09190CSR Z-ADD36 FLIMIT 30 TOTAL NUMB FIELDS 09200CSR MOVE ' ' BLK40 40 09210CSR Z-ADD17 X 30 09220CSR MOVE '-' DOTS 09230CSR MOVEL'>' DOTS,X 09240CSR MOVE ' ' DOTS,X 09250C* GET PORT # AND CRTFILE ÐÐ09260CSR MOVE ' ' W2A 2 09270CSR EXITFZGMINX GET PORT # 09280CSR RLABL W2A 09290CSR MOVE W2A # 20 PORT NO. 09300CSR # COMP 0 54 09310CSRN54 Z-ADD25 # DEFAULT 09320CSR EXSR SR96 GET CRTFILE 09330CSR MOVE CALL LNK 09340CSR MOVE 'Q100EM 'PROG 09350CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 09360CSR TST,# COMP 'S' 56 09370CSRN56 CRSHUT COMP 'S' 56 09380CSR 56 MOVE 'S' CRSHUT SHUTDOWN 09390CSR 56 MOVE 'SHUTDOWN'PROG 09400CSR EXSR SR97 UPDATE CRTFILE 09410CSR 56 EXSR SR98 >>>>>>>>>>>>> 09420C* DEFINE WORK FIELDS,ETC. 09430CSR MOVE BLK8 RETURN 8 09440CSR MOVE ' ' BLK35 35 09450CSR MOVE ' ' BLK28 28 09460CSR MOVE ' ' BLK25 25 09470CSR MOVE ' ' BLK30 30 09480CSR MOVE ' ' BLK20 20 09490CSR MOVE ' ' BLK8 8 09500CSR MOVE ' ' BLK15 15 ÐÐ09510CSR MOVE ' ' BLK6 6 09520CSR ENDSR 09530C********************************************************************** 09540CSR SR102 BEGSR 09550C* VALIDATE FIELD NO. 09560CSR F COMP 0 54 09570CSRN54 Z-ADD1 F 09580CSR F COMP FLIMIT 55 09590CSR 55 Z-ADD1 F 09600CSR ENDSR 09610C******************************************************************** 09620CSR SR103 BEGSR 09630C* MOVE INPUT DATA 09640CSR EXSR SR201 IDENTIFY-F 09650CSR EXSR SR202 RIGHT ADJUST 09660CSR 01 MOVELW40A TRAN 1 TRAN CODE 09670CSR 02 MOVE W15A TCLOCK 50 CLOCK # 09680CSR 03 MOVELW40A EMFNAM 1ST NAME 09690CSR 04 MOVELW40A EMMNAM MIDDLE NAME 09700CSR 05 MOVELW40A EMLNAM LAST NAME 09710CSR 06 MOVE W15A EMDEPT DEPT # 09720CSR 07 MOVE W15A EMWC WORK CENTER 09730CSR 08 MOVELW40A EMJOB JOB NAME 09740CSR 09 MOVELW40A EMJ,1 ADMIN/FACTORY 09750CSR 10 MOVELW40A EMJ,2 PERM/TEMP ÐÐ09760CSR 11 MOVELW40A EMJ,3 FULL/PART TIME 09770CSR 12 MOVELW40A EMJ,4 HOURLY/SALARY 09780CSR 13 MOVELW40A EMJ,5 DIRECT/INDIRECT 09790CSR 14 MOVE W15A EMRATE PAY RATE 09800CSR 15 MOVELW40A EMPUM PAY UNIT MEAS 09810CSR 16 MOVELW40A EMPFRQ PAY FREQUENCY 09820CSR 17 MOVELW40A EMHOLD HOLD PAY CHECK FLAG 09830CSR 18 MOVE W15A HPD,1 HRS PER DAY-SUN 09840CSR 19 MOVE W15A HPD,2 MON 09850CSR 20 MOVE W15A HPD,3 TUES 09860CSR 21 MOVE W15A HPD,4 WED 09870CSR 22 MOVE W15A HPD,5 THURS 09880CSR 23 MOVE W15A HPD,6 FRI 09890CSR 24 MOVE W15A HPD,7 SAT 09900CSR 25 MOVE W15A STD,1 SUN 09910CSR 26 MOVE W15A STD,2 MON 09920CSR 27 MOVE W15A STD,3 TUES 09930CSR 28 MOVE W15A STD,4 WED 09940CSR 29 MOVE W15A STD,5 THUR 09950CSR 30 MOVE W15A STD,6 FRI 09960CSR 31 MOVE W15A STD,7 SAT 09970CSR 32 MOVE W15A EMHPW HRS PER WEEK 09980CSR 33 MOVE W15A EMHIRD DATE HIRED 09990CSR 34 MOVE W15A EMASYR ADD. SENIORITY-YRS 10000CSR 35 MOVE W15A EMASMO ADD. SENIORITY-MOS ÐÐ10010CSR 36 MOVE W15A EMASDY ADD. SENIORITY-DAYS 10020CSR MOVE ' ' DUN,F EDIT FLAG 10030CSR ENDSR 10040C******************************************************************** 10050CSR SR104 BEGSR 10060C* EDIT INPUT DATA 10070CSR 01 EXSR SR1 10080CSR 02 EXSR SR2 10090CSR 03 EXSR SR3 10100CSR 05 EXSR SR5 10110CSR 06 EXSR SR6 10120CSR 07 EXSR SR7 10130CSR 08 EXSR SR8 10140CSR 09 EXSR SR9 10150CSR 10 EXSR SR10 10160CSR 11 EXSR SR11 10170CSR 12 EXSR SR12 10180CSR 13 EXSR SR13 10190CSR 14 EXSR SR14 10200CSR 15 EXSR SR15 10210CSR 16 EXSR SR16 10220CSR 18 EXSR SR18 10230CSR 19 EXSR SR18 10240CSR 20 EXSR SR18 10250CSR 21 EXSR SR18 ÐÐ10260CSR 22 EXSR SR18 10270CSR 23 EXSR SR18 10280CSR 24 EXSR SR18 10290CSR 25 EXSR SR25 10300CSR 26 EXSR SR25 10310CSR 27 EXSR SR25 10320CSR 28 EXSR SR25 10330CSR 29 EXSR SR25 10340CSR 30 EXSR SR25 10350CSR 31 EXSR SR25 10360CSR 32 EXSR SR32 10370CSR 33 EXSR SR33 10380CSR 96 MOVE ' ' DUN,F EDIT FLAG 10390CSRN96 MOVE 'X' DUN,F 10400CSR ENDSR 10410C*********************************************************************** 10420CSR SR105 BEGSR 10430C* FINAL EDIT 10440CSR SETOF 77 10450CSR SETON 79 FINAL EDIT FLAG 10460CSR Z-ADD1 F 96 10470C*-------------------------------------------------------------------- 10480CSR T105A TAG 10490CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 10500CSRN54 GOTO END105 ÐÐ10510CSR EXSR SR201 IDENTIFY-F 10520CSR EXSR SR104 EDIT 10530CSRN96 GOTO T105A 10540C*-------------------------------------------------------------------- 10550CSR END105 TAG 10560CSR SETOF 79 10570CSR ENDSR 10580C******************************************************************** 10590CSR SR106 BEGSR 10600C* UPDATE DATA BASE. 10610CSR EXSR SR203 CLASSIFY TRAN 10620CSR 60 GOTO T106A ADD TRAN 10630CSR 61 GOTO T106D CHANGE TRAN 10640CSR 62 GOTO T106F DELETE TRAN 10650C* FLAG BAD TRAN CODE 10660CSR Z-ADD300 M 96 FLAG ERROR 10670CSR Z-ADD1 F FIELD # 10680CSR GOTO END106 10690C*------------------------------------------------------------------- 10700CSR T106A TAG 10710C* ADD TRANSACTION 10720CSR 40 GOTO T106B NOT ON FILE 10730CSR 41 GOTO T106C DELETED MASTER 10740C* FLAG DUPLICATE ADD ERROR 10750CSR Z-ADD301 M 96 FLAG ERROR ÐÐ10760CSR Z-ADD1 F FIELD # 10770CSR GOTO END106 10780C*--------------------------------------------------------------------- 10790CSR T106B TAG 10800C* ADD-- MAST NOT ON FILE 10810CSR EXSR SR81 ADD NEW MASTER 10820CSR GOTO END106 10830C*--------------------------------------------------------------------- 10840CSR T106C TAG 10850C* ADD-- MAST IS DELETED 10860CSR MOVE 'A' EMSTAT RECORD STATUS 10870CSR EXSR SR82 REWRITE MAST 10880CSR GOTO END106 10890C*---------------------------------------------------------------------- 10900CSR T106D TAG 10910C* CHANGE TRANSACTION. 10920CSRN40N41 GOTO T106E GOT IT 10930C* FLAG NO MASTER ERROR 10940CSR Z-ADD302 M 96 FLAG ERROR 10950CSR Z-ADD1 F FIELD # 10960CSR GOTO END106 10970C*----------------------------------------------------------------------- 10980CSR T106E TAG 10990C* REWRITE MASTER 11000CSR EXSR SR82 REWRITE MAST ÐÐ11010CSR GOTO END106 11020C*----------------------------------------------------------------------- 11030CSR T106F TAG 11040C* DELETE TRANSACTION 11050CSRN40N41 GOTO T106G GOT IT 11060C* FLAG NO MASTER ERROR 11070CSR Z-ADD302 M 96 FLAG ERROR 11080CSR Z-ADD1 F FIELD # 11090CSR GOTO END106 11100C*----------------------------------------------------------------------- 11110CSR T106G TAG 11120C* DELETE MASTER. 11130CSR MOVE 'D' EMSTAT RECORD STATUS 11140CSR EXSR SR82 REWRITE MASTER 11150CSR END106 ENDSR 11160C************************************************************************ 11170CSR SR201 BEGSR 11180C* IDENTIFY FIELD NO. 11190CSR SETOF 545556 11200CSR F COMP 30 54 >30 11210CSRN54 F COMP 20 55 >20 11220CSRN54N55 F COMP 10 56 >10 11230CSR 56 GOTO T201A 11240CSR 55 GOTO T201B 11250CSR 54 GOTO T201C ÐÐ11260CSR EXSR SR302 SETOF 11-20 11270CSR EXSR SR303 SETOF 21-30 11280CSR EXSR SR304 SETOF 31-36 11290CSR F COMP 1 01 11300CSR F COMP 2 02 11310CSR F COMP 3 03 11320CSR F COMP 4 04 11330CSR F COMP 5 05 11340CSR F COMP 6 06 11350CSR F COMP 7 07 11360CSR F COMP 8 08 11370CSR F COMP 9 09 11380CSR F COMP 10 10 11390CSR GOTO END201 11400C*--------------------------------------------------------------- 11410CSR T201A TAG 11420CSR EXSR SR301 SETOF 1-10 11430CSR EXSR SR303 SETOF 21-30 11440CSR EXSR SR304 SETOF 31-40 11450CSR F COMP 11 11 11460CSR F COMP 12 12 11470CSR F COMP 13 13 11480CSR F COMP 14 14 11490CSR F COMP 15 15 11500CSR F COMP 16 16 ÐÐ11510CSR F COMP 17 17 11520CSR F COMP 18 18 11530CSR F COMP 19 19 11540CSR F COMP 20 20 11550CSR GOTO END201 11560C*--------------------------------------------------------------------- 11570CSR T201B TAG 11580CSR EXSR SR301 SETOF 1-10 11590CSR EXSR SR302 SETOF 11-20 11600CSR EXSR SR304 SETOF 31-40 11610CSR F COMP 21 21 11620CSR F COMP 22 22 11630CSR F COMP 23 23 11640CSR F COMP 24 24 11650CSR F COMP 25 25 11660CSR F COMP 26 26 11670CSR F COMP 27 27 11680CSR F COMP 28 28 11690CSR F COMP 29 29 11700CSR F COMP 30 30 11710CSR GOTO END201 11720C*--------------------------------------------------------------------- 11730CSR T201C TAG 11740CSR EXSR SR301 SETOF 1-10 11750CSR EXSR SR302 SETOF 11-20 ÐÐ11760CSR EXSR SR303 SETOF 21-30 11770CSR F COMP 31 31 11780CSR F COMP 32 32 11790CSR F COMP 33 33 11800CSR F COMP 34 34 11810CSR F COMP 35 35 11820CSR F COMP 36 36 11830CSR END201 ENDSR 11840C********************************************************************** 11850CSR SR202 BEGSR 11860C* RIGHT JUSTIFY 11870CSR F LOKUPNUM 54 11880CSRN54 GOTO END202 NOT NUMERIC FIELD 11890CSR Z-ADD15 W2N 20 11900CSR MOVELW40A W15A 15 11910CSR EXIT SUBRAJ R. JUSTIFY 11920CSR RLABL W2N 11930CSR RLABL W15A 11940CSR END202 ENDSR 11950C*********************************************************************** 11960CSR SR203 BEGSR 11970C* CLASSIFY TRAN CODE 11980CSR TRAN COMP 'A' 60 ADD 11990CSR TRAN COMP 'C' 61 CHANGE 12000CSR TRAN COMP 'D' 62 DELETE ÐÐ12010CSR MOVE BLK35 TRNNAM 6 12020CSR 60 MOVE 'ADD ' TRNNAM 12030CSR 61 MOVE 'CHANGE' TRNNAM 12040CSR 62 MOVE 'DELETE' TRNNAM 12050CSR ENDSR 12060C******************************************************************** 12070CSR SR205 BEGSR 12080C* INIT EMMAST FIELDS. 12090CSR Z-ADD0 EMCLOK 12100CSR MOVE BLK35 EMFNAM 12110CSR MOVE BLK35 EMMNAM 12120CSR MOVE BLK35 EMLNAM 12130CSR MOVE ' ' EMS 12140CSR MOVE BLK35 EMCITY 12150CSR MOVE ' ' EMSTCD 12160CSR Z-ADD0 EMZIP 12170CSR MOVE BLK15 EMPHON 12180CSR MOVE ' ' EME 12190CSR MOVE ' ' EEO 12200CSR Z-ADD0 EMBIRD 12210CSR MOVE BLK35 EMEDUC 12220CSR MOVE BLK35 EMSNAM 12230CSR Z-ADD0 EMSBIR 12240CSR Z-ADD0 EMDEPT 12250CSR Z-ADD0 EMWC ÐÐ12260CSR MOVE BLK35 EMJOB 12270CSR MOVE ' ' EMJ 12280CSR Z-ADD0 EMRATE 12290CSR MOVE ' ' EMPUM 12300CSR MOVE ' ' EMPFRQ 12310CSR MOVE ' ' EMHOLD 12320CSR Z-ADD0 HPD 12330CSR Z-ADD0 STD 12340CSR Z-ADD0 EMHPW 12350CSR Z-ADD0 EMLRD 12360CSR MOVE ' ' EMLRT 12370CSR Z-ADD0 EMLRP 12380CSR Z-ADD0 EMLPA 12390CSR Z-ADD0 EMNSRD 12400CSR MOVE BLK15 EMNSRR 12410CSR Z-ADD0 EMRFRQ 12420CSR Z-ADD0 EMHIRD 12430CSR Z-ADD0 EMASYR 12440CSR Z-ADD0 EMASMO 12450CSR Z-ADD0 EMASDY 12460CSR Z-ADD0 EMDATT 12470CSR MOVE ' ' EMTREA 12480CSR Z-ADD0 EMC 12490CSR MOVE ' ' EMREH 12500CSR MOVE ' ' EMVCC ÐÐ12510CSR Z-ADD0 EMVEH 12520CSR Z-ADD0 EMVHT 12530CSR Z-ADD0 EMVLDP 12540CSR Z-ADD0 EMVSLD 12550CSR Z-ADD0 EMVALD 12560CSR Z-ADD0 EMVSRD 12570CSR Z-ADD0 EMVARD 12580CSR Z-ADD0 EMSLEH 12590CSR Z-ADD0 EMSLHT 12600CSR Z-ADD0 EMSLDP 12610CSR Z-ADD0 EMSLSL 12620CSR Z-ADD0 EMSLAL 12630CSR Z-ADD0 EMSLSR 12640CSR Z-ADD0 EMSLAR 12650CSR MOVE ' ' EMFTMS 12660CSR Z-ADD0 EMFTNE 12670CSR Z-ADD0 EMFXEX 12680CSR MOVE ' ' EMFTXC 12690CSR Z-ADD0 EMFTXA 12700CSR MOVE BLK15 EMSS 12710CSR MOVE ' ' EMCICA 12720CSR Z-ADD0 EMFEIC 12730CSR MOVE ' ' EMSTMS 12740CSR Z-ADD0 EMSTNE 12750CSR Z-ADD0 EMSXEX ÐÐ12760CSR MOVE ' ' EMSTXC 12770CSR Z-ADD0 EMFTXA 12780CSR Z-ADD0 EMSEIC 12790CSR Z-ADD0 PTH 12800CSR Z-ADD0 PTE 12810CSR Z-ADD0 PTF 12820CSR Z-ADD0 PTS 12830CSR MOVE ' ' PRT 12840CSR Z-ADD0 PRB 12850CSR Z-ADD0 PRS 12860CSR MOVE ' ' PRC 12870CSR Z-ADD0 PRA 12880CSR Z-ADD0 PRY 12890CSR MOVE ' ' PRN 12900CSR Z-ADD0 EMLOAL 12910CSR Z-ADD0 EMLOAR 12920CSR Z-ADD0 EMLOAT 12930CSR MOVE ' ' EMFLAG 12940CSR MOVE ' ' EMSTAT 12950CSR MOVE BLK35 WCNAME 12960CSR MOVE BLK35 EJN 12970CSR MOVE BLK35 NAMEMP 12980CSR MOVE BLK35 NAMEPF 12990CSR ENDSR 13000C****************************************************************** ÐÐ13010CSR SR206 BEGSR 13020C* INIT INPUT ONLY FIELDS 13030CSR MOVE ' ' TRAN TRAN CODE 13040CSR Z-ADD0 TCLOCK CLOCK # 13050CSR MOVE BLK35 TRNNAM 13060CSR SETOF 4041 13070CSR ENDSR 13080C****************************************************************** 13090CSR SR207 BEGSR 13100C* SAVE MASTER "OLD" FIELDS 13110CSR ENDSR 13120C**************************************************************** 13130CSR SR208 BEGSR 13140C* EDIT HRS PER DAY 13150CSR Z-ADD16 W3D1 31 13160CSR Z-ADD1 X 13170CSR W3D1 LOKUPHPD,X 54 13180CSR 54 Z-ADD694 M 96 FLAG ERROR 13190CSR 54 17 ADD X F 13200CSR 54 GOTO END208 13210CSR Z-ADD10 W3D1 13220CSR W3D1 LOKUPHPD 54 13230CSR 54 Z-ADD695 M 95 13240CSR 54 EXSR SR89 FLAG WARNING 13250CSR END208 ENDSR ÐÐ13260C****************************************************************** 13270CSR SR209 BEGSR 13280C* EDIT START TIMES 13290CSR Z-ADD1 X 13300C*------------------------------------------------------------------ 13310CSR T209A TAG 13320CSR MOVELSTD,X HRS 20 13330CSR MOVE STD,X MINUTE 20 13340CSR HRS COMP 0 54 13350CSR HRS COMP 24 55 13360CSR MINUTE COMP 0 56 13370CSR MINUTE COMP 60 57 13380CSR 55 13390COR 57 Z-ADD695 M 95 13400CSR 55 13410COR 57 EXSR SR89 FLAG WARNING 13420CSR 55 13430COR 57 GOTO END209 13440CSR 1 ADD X X 13450CSR X COMP 7 54 13460CSRN54 GOTO T209A 13470CSR END209 ENDSR 13480C***************************************************************** 13490CSR SR301 BEGSR 13500CSR SETOF 010203 ÐÐ13510CSR SETOF 040506 13520CSR SETOF 070809 13530CSR SETOF 10 13540CSR ENDSR 13550C******************************************************************** 13560CSR SR302 BEGSR 13570CSR SETOF 111213 13580CSR SETOF 141516 13590CSR SETOF 171819 13600CSR SETOF 20 13610CSR ENDSR 13620C****************************************************************** 13630CSR SR303 BEGSR 13640CSR SETOF 212223 13650CSR SETOF 242526 13660CSR SETOF 272829 13670CSR SETOF 30 13680CSR ENDSR 13690C****************************************************************** 13700CSR SR304 BEGSR 13710CSR SETOF 313233 13720CSR SETOF 343536 13730CSR ENDSR 13740O******************************************************************** 13750OTERM132 E 70 ÐÐ13760O OR 71 13770O BIT,28 1 13780O N50 8 '8091001' 13790O N50 BIT,1 9 13800O N50 BIT,1 10 13810O 50 10 '[001 ]001' 13820O 50 BIT,28 6 13830O UDATE 18 ' - - ' 13840O 53 'E M P L O Y E E' 13850O 68 'M A S T E R' 13860O 77 'J O B' 13870O 92 'S T A T U S' 13880O 107 'U P D A T E' 13890O 43 50 BIT,28 110 13900O 43 50 111 'D' 13910O 43 121 'TERMINATED' 13920O 43 EMDATTY 130 13930O 43 50 BIT,28 131 13940O 43 50 132 'E' 13950O*----------------------------------------------------------------- 13960O E 70 13970O OR 71 13980O OR 72 01 13990O DOTS 34 14000O 23 '(1) TRAN CODE (A,C,D)' ÐÐ14010O TRAN 36 14020O TRNNAM 49 14030O A39 132 14040O*------------------------------------------------------------------ 14050O E 70 14060O OR 71 14070O OR 72 02 14080O DOTS 34 14090O 15 '(2) CLOCK NO.' 14100O TCLOCKZ 40 14110O A39 132 14120O*----------------------------------------------------------------- 14130O E 71 14140O OR 72 03 14150O DOTS 34 14160O 14 '(3) 1ST NAME' 14170O EMFNAM 60 14180O A39 132 14190O*------------------------------------------------------------------ 14200O E 71 14210O OR 72 04 14220O DOTS 34 14230O 17 '(4) MIDDLE NAME' 14240O EMMNAM 60 14250O*------------------------------------------------------------------- ÐÐ14260O E 71 14270O OR 72 05 14280O DOTS 34 14290O 15 '(5) LAST NAME' 14300O EMLNAM 65 14310O A39 132 14320O*---------------------------------------------------------------- 14330O E 71 14340O OR 72 06 14350O DOTS 34 14360O 20 '(6) DEPARTMENT NO.' 14370O EMDEPTZ 40 14380O A39 132 14390O*---------------------------------------------------------------- 14400O E 71 14410O OR 72 07 14420O DOTS 34 14430O 17 '(7) WORK CENTER' 14440O EMWC Z 40 14450O WCNAME 70 14460O A39 132 14470O*----------------------------------------------------------------- 14480O E 71 14490O OR 72 08 14500O DOTS 34 ÐÐ14510O 14 '(8) JOB NAME' 14520O EMJOB 63 14530O A39 132 14540O*----------------------------------------------------------------- 14550O E 71 14560O OR 72 09 14570O DOTS 34 14580O 19 '(9) ADMIN/FACTORY' 14590O 31 '(A,F)' 14600O EMJ,1 36 14610O EJN,1 47 14620O A39 132 14630O*-------------------------------------------------------------------- 14640O E 71 14650O OR 72 10 14660O DOTS 34 14670O 24 '(10) PERMANENT/TEMPORAR' 14680O 25 'Y' 14690O 31 '(P,T)' 14700O EMJ,2 36 14710O EJN,2 47 14720O A39 132 14730O*--------------------------------------------------------------------- 14740O E 71 14750O OR 72 11 ÐÐ14760O DOTS 34 14770O 20 '(11) FULL/PART TIME' 14780O 31 '(F,P)' 14790O EMJ,3 36 14800O A39 132 14810O EJN,3 47 14820O*-------------------------------------------------------------------- 14830O E 71 14840O OR 72 12 14850O DOTS 34 14860O 19 '(12) HOURLY/SALARY' 14870O 31 '(H,S)' 14880O EMJ,4 36 14890O EJN,4 47 14900O A39 132 14910O*---------------------------------------------------------------- 14920O E 71 14930O OR 72 13 14940O DOTS 34 14950O 21 '(13) DIRECT/INDIRECT' 14960O 31 '(D,I)' 14970O EMJ,5 36 14980O EJN,5 47 14990O A39 132 15000O*-------------------------------------------------------------- ÐÐ15010O E 71 15020O OR 72 14 15030O DOTS 34 15040O 16 '(14) PAY RATE $' 15050O EMRATE2 46 15060O A39 132 15070O*-------------------------------------------------------------- 15080O E 71 15090O OR 72 15 15100O DOTS 34 15110O 24 '(15) PAY UNIT (H,D,W,M,' 15120O 28 'S,A)' 15130O EMPUM 36 15140O NAMEMP 51 15150O A39 132 15160O*------------------------------------------------------------------ 15170O E 71 15180O OR 72 16 15190O DOTS 34 15200O 24 '(16) PAY FREQUENCY (W,S' 15210O 27 ',M)' 15220O EMPFRQ 36 15230O NAMEPF 47 15240O A39 132 15250O*-------------------------------------------------------------- ÐÐ15260O E 71 15270O OR 72 17 15280O DOTS 34 15290O 24 '(17) HOLD PAY CHECK FLA' 15300O 25 'G' 15310O EMHOLD 36 15320O A39 132 15330O*-------------------------------------------------------------- 15340O E 71 15350O 40 'S' 15360O 46 'S' 15370O 52 'M' 15380O 58 'T' 15390O 64 'W' 15400O 70 'T' 15410O 76 'F' 15420O*--------------------------------------------------------------- 15430O E 71 15440O OR 72 18 15450O OR 72 19 15460O OR 72 20 15470O OR 72 21 15480O OR 72 22 15490O OR 72 23 15500O OR 72 24 ÐÐ15510O DOTS 34 15520O 19 '(18) HOURS PER DAY' 15530O HPD,1 2 42 15540O HPD,2 2 48 15550O HPD,3 2 54 15560O HPD,4 2 60 15570O HPD,5 2 66 15580O HPD,6 2 72 15590O HPD,7 2 78 15600O A39 132 15610O*---------------------------------------------------------------- 15620O E 71 15630O OR 72 25 15640O OR 72 26 15650O OR 72 27 15660O OR 72 28 15670O OR 72 29 15680O OR 72 30 15690O OR 72 31 15700O DOTS 34 15710O 23 '(25) START TIME EA DAY' 15720O STD,1 42 ' : ' 15730O STD,2 48 ' : ' 15740O STD,3 54 ' : ' 15750O STD,4 60 ' : ' ÐÐ15760O STD,5 66 ' : ' 15770O STD,6 72 ' : ' 15780O STD,7 78 ' : ' 15790O A39 132 15800O*-------------------------------------------------------------- 15810O E 71 15820O OR 72 32 15830O DOTS 34 15840O 20 '(32) HOURS PER WEEK' 15850O EMHPW 2 41 15860O 78 'ADDITIONAL SENIORITY' 15870O A39 132 15880O*-------------------------------------------------------------- 15890O E 71 15900O OR 72 33 15910O DOTS 34 15920O 16 '(33) DATE HIRED' 15930O EMHIRD 43 ' - - ' 15940O 57 '(34) YRS:' 15950O EMASYRZ 60 15960O 72 '(35) MOS:' 15970O EMASMOZ 75 15980O 88 '(36) DAYS:' 15990O EMASDYZ 91 16000O A39 132 ÐÐ16010O**************************************************************** 16020OCRTFILE E 97 16030O PROG 26 16040O CRTIME 33 16050O CRDATE 37 16060O LNK 79 16070O******************************************************************** 16080OEMMAST EADD 81 16090O TCLOCK 5 16100O EMFNAM 31 16110O EMMNAM 56 16120O EMLNAM 86 16130O EMS 156 16140O EMCITY 181 16150O EMSTCD 183 16160O EMZIP 188P 16170O EMPHON 203 16180O EME 253 16190O EEO 261 16200O EMBIRD 267 16210O EMEDUC 297 16220O EMSNAM 327 16230O EMSBIR 333 16240O EMDEPT 338P 16250O EMWC 340P ÐÐ16260O EMJOB 368 16270O EMJ 374 16280O EMRATE 379P 16290O EMPUM 380 16300O EMPFRQ 381 16310O EMHOLD 382 16320O HPD 396P 16330O STD 410B 16340O EMHPW 413P 16350O EMCPHW 416P 16360O EMCPOW 419P 16370O EMCPOA 422P 16380O EMLRD 463 16390O EMLRT 464 16400O EMLRP 470 16410O EMLPA 473P 16420O EMNSRD 481 16430O EMNSRR 496 16440O EMRFRQ 497 16450O EMHIRD 503 16460O EMASYR 505 16470O EMASMO 507 16480O EMASDY 509 16490O EMDATT 515 16500O EMTREA 517 ÐÐ16510O EMC 532P 16520O EMREH 533 16530O EMVCC 534 16540O EMVEH 539P 16550O EMVHT 542P 16560O EMVLDP 548 16570O EMVSLD 554 16580O EMVALD 560 16590O EMVSRD 566 16600O EMVARD 572 16610O EMSLEH 577P 16620O EMSLHT 580P 16630O EMSLDP 586 16640O EMSLSL 592 16650O EMSLAL 598 16660O EMSLSR 604 16670O EMSLAR 610 16680O EMFTMS 611 16690O EMFTNE 613 16700O EMFXEX 615 16710O EMFTXC 616 16720O EMFTXA 620 16730O EMSS 634 16740O EMCICA 635 16750O EMFEIC 636 ÐÐ16760O EMSTMS 637 16770O EMSTNE 639 16780O EMSXEX 641 16790O EMSTXC 642 16800O EMSTXA 646 16810O EMSEIC 647 16820O PTH 668P 16830O PTE 703P 16840O PTF 727P 16850O PTS 751P 16860O PRT 791 16870O PRB 911 16880O PRS 1031 16890O PRC 1051 16900O PRA 1131P 16910O PRY 1211P 16920O PRN 1491 16930O EMLOAL 1497 16940O EMLOAR 1503 16950O EMLOAT 1505P 16960O EMFLAG 1535 16970O 1536 'A' 16980O*------------------------------------------------------------------- 16990O E 82 17000O EMFNAM 31 ÐÐ17010O EMMNAM 56 17020O EMLNAM 86 17030O EMS 156 17040O EMCITY 181 17050O EMSTCD 183 17060O EMZIP 188P 17070O EMPHON 203 17080O EME 253 17090O EEO 261 17100O EMBIRD 267 17110O EMEDUC 297 17120O EMSNAM 327 17130O EMSBIR 333 17140O EMDEPT 338P 17150O EMWC 340P 17160O EMJOB 368 17170O EMJ 374 17180O EMRATE 379P 17190O EMPUM 380 17200O EMPFRQ 381 17210O EMHOLD 382 17220O HPD 396P 17230O STD 410B 17240O EMHPW 413P 17250O EMCPHW 416P ÐÐ17260O EMCPOW 419P 17270O EMCPOA 422P 17280O EMLRD 463 17290O EMLRT 464 17300O EMLRP 470 17310O EMLPA 473P 17320O EMNSRD 481 17330O EMNSRR 496 17340O EMRFRQ 497 17350O EMHIRD 503 17360O EMASYR 505 17370O EMASMO 507 17380O EMASDY 509 17390O EMDATT 515 17400O EMTREA 517 17410O EMC 532P 17420O EMREH 533 17430O EMVCC 534 17440O EMVEH 539P 17450O EMVHT 542P 17460O EMVLDP 548 17470O EMVSLD 554 17480O EMVALD 560 17490O EMVSRD 566 17500O EMVARD 572 ÐÐ17510O EMSLEH 577P 17520O EMSLHT 580P 17530O EMSLDP 586 17540O EMSLSL 592 17550O EMSLAL 598 17560O EMSLSR 604 17570O EMSLAR 610 17580O EMFTMS 611 17590O EMFTNE 613 17600O EMFXEX 615 17610O EMFTXC 616 17620O EMFTXA 620 17630O EMSS 634 17640O EMCICA 635 17650O EMFEIC 636 17660O EMSTMS 637 17670O EMSTNE 639 17680O EMSXEX 641 17690O EMSTXC 642 17700O EMSTXA 646 17710O EMSEIC 647 17720O PTH 668P 17730O PTE 703P 17740O PTF 727P 17750O PTS 751P ÐÐ17760O PRT 791 17770O PRB 911 17780O PRS 1031 17790O PRC 1051 17800O PRA 1131P 17810O PRY 1211P 17820O PRN 1491 17830O EMLOAL 1497 17840O EMLOAR 1503 17850O EMLOAT 1505P 17860O EMFLAG 1535 17870O EMSTAT 1536 ** NUL ARRAY 017880 17890** A40 ARRAY 17900 17910** LIN/COL ARRAYS 17920002037 1 TRAN 17930003037 2 CLOCK 17940004037 3 1ST NAME 17950005037 4 MID. NAME 17960006037 5 LAST NAME 17970007037 6 DEPT 17980008037 7 WC 17990009037 8 JOB NAME 18000ÐÐ010037 9 A/F 18010011037 10 P/T 18020012037 11 F/P 18030013037 12 H/S 18040014037 13 D/I 18050015037 14 PAY 18060016037 15 PAY UNIT 18070017037 16 PAY FREQ 18080018037 17 HOLD PAY FLAG 18090020040 18 HRS PER DAY 18100020046 19 18110020052 20 18120020058 21 18130020064 22 18140020069 23 18150020075 24 18160021040 25 START TIMES 18170021046 26 18180021052 27 18190021058 28 18200021064 29 18210021070 30 18220021076 31 18230022037 32 HRS PER WEEK 18240023037 33 DATE HIRED 18250ÐÐ023060 34 XTRA SEN. YRS 18260023075 35 XTRA SEN. MOS 18270023091 36 XTRA SEN. DAYS 18280** A39 ARRAY 18290 18300** NUM ARRAY 018310002 CLOCK 1 18320006 DEPT 2 18330007 WC 3 18340014 PAY RATE 4 18350018 HPD,1 5 18360019 HPD,2 6 18370020 HPD,3 7 18380021 HPD,4 8 18390022 HPD,5 9 18400023 HPD,6 10 018410024 HPD,7 1 18420025 STD,1 2 18430026 STD,2 3 18440027 STD,3 4 18450028 STD,4 5 18460029 STD,5 6 18470030 STD,6 7 18480031 STD,7 8 18490032 HRS PER WK 9 18500ÐÐ033 HIRE DATE 20 018510034 XTRA SEN 1 18520035 XTRA SEN 2 18530036 XTRA SEN 3 18540** DUN ARRAY 18550 018560** MES ARRAY 018570---MESSAGE NOT ON FILE--- 018580** LNK ARRAY 018590 18600** DOTS ARRAY 18610 18620** EJN ARRAY 18630 18640** TABPUM/TABPUN 18650HHOURLY 18660DDAILY 18670WWEEKLY 18680MMONTHLY 18690SSEMI-MONTHLY 18700AANNUALLY (YR) 18710** ENJ ARRAY 18720ADMIN 18730FACTORY 18740PERMANENT 18750ÐÐTEMPORARY 18760FULL TIME 18770PART TIME 18780SALARY 18790HOURLY 18800INDIRECT 18810DIRECT 18820/* 18830_‚ ÐÐ_‚_‚ORARY 18760FULL TIME 18770PART TIME 18780SALARY 18790HOURLY 18800INDIRECT 18810DIRECT 18820/* 18830_‚ ÐÈ(&x  X101DP P120282120282(èÈÐ00010H Q101DP00020F* READ 80-COL FLOPPY TO DISK (ASCII). (X101DP) 00030F* REVISED 7/30/80 1:45 PM. 00040FFLOPPY IP F 80 17 00050FDISK80 O F 80 DISK A 00060I******************************************************************** 00070IFLOPPY FL 01 00080I 1 80 REC 00090O******************************************************************** 00100ODISK80 DADD 01 00110O REC 80 /* 000120_‚ _‚_‚ ÐÈ(–&‚ –?X101PM P120282120282(èÈÐ00010H Q101PM00020F* PURCH LT TO FLOPPY FOR UNIVAC. (X101PM) 00030F* N O T E: SKIPS 1ST 17 RECORDS (FOR SVC. BUREAU). 00040F* REV 7/25/81 3:40 PM. 00050F****************************************************************** 00060FBITTAB IP F 33 DISK 00070FPMMST2 ID F 674L12AI 1 DISK 00080FSTARTFL UC F 10R DISK 00090FFLOPPY O F 122 17 00100F KEBCDIC 00110FTERM50 O F 50 5 00120FPRINT O F 132 OF PRINTER U1 00130E******************************************************************* 00140E EOF 1 61 2 00150E BIT 33 1 00160E PLT 8 3 0 00170I******************************************************************** 00180IBITTAB BT 00190I 1 33 BIT 00200I***************************************************************** 00210IPMMST2 PM 00220I* PART NO. 10N 00230I 1 100PMPN 00240I* SOURCE CODE 2A 00250I 94 95 PMSC ÐÐ00260I* LEAD TIMES 8 X 3P 00270I P 113 128 PLT 00280I* RECORD STATUS 1A 00290I 674 674 PMSTAT 00300I**************************************************************** 00310ISTARTFL SF 00320I* STARTING PART # 00330I 1 100BEGIN 00340C****************************************************************** 00350C 89 GOTO TAG10 00360C SETON 89 00370C MOVE ' ' BLK122122 00380C Z-ADD0 X 30 00390C Z-ADD1 RRN 50 00400C RRN CHAINSTARTFL H7 00410C BEGIN SUB 1 W10N 100 00420C MOVELW10N W12A 12 00430C W12A SETLLPMMST2 00440C Z-ADD0 COUNT 00450C*------------------------------------------------------------------- 00460C START TAG 00470C 1 ADD X X 00480C X COMP 17 54 00490C 54 GOTO TAG10 00500C 1 ADD COUNT COUNT 50 ÐÐ00510C SETON 81 00520C EXCPT 00530C SETOF 81 00540C GOTO START 00550C*------------------------------------------------------------------- 00560C TAG10 TAG 00570C SETOF 54 00580C READ PMMST2 54 00590C 54 GOTO ENDJOB 00600C PMPN COMP BEGIN 54 00610C N54 GOTO TAG10 00620C PMSTAT COMP 'D' 54 00630C 54 GOTO TAG10 00640C PMPN COMP LASTPN 54 00650C N54 GOTO ENDJOB 00660C MOVELPMSC W1A 1 00670C W1A COMP 'P' 54 00680C N54 GOTO TAG10 00690C XFOOTPLT W3N 30 54 00700C N54 GOTO TAG10 00710C 1 ADD COUNT COUNT 50 00720C RRN CHAINSTARTFL H6 00730C SETON 82 00740C EXCPT WRITE FLOPPY 00750C SETOF 82 ÐÐ00760C Z-ADDPMPN LASTPN 100 00770C GOTO TAG10 00780C*------------------------------------------------------------------- 00790C ENDJOB TAG 00800C RRN CHAINSTARTFL H8 00810C Z-ADD0 PMPN 00820C SETON 83 00830C EXCPT INIT STARTFL FILE 00840C SETOF 83 00850C MOVE '?*' EOF 00860C*----------------------------------------------------------------- 00870C LOOP TAG 00880C 1 ADD COUNT COUNT 50 00890C SETON 71 00900C EXCPT PUT /* 00910C SETOF 71 00920C MOVE '/*' EOF 00930C GOTO LOOP 00940O******************************************************************** 00950OPRINT E 82 U1 00960O PMPN 12 ' - - ' 00970O PLT Z 100 00980O COUNT Z 132 00990O******************************************************************** 01000OFLOPPY E 82 ÐÐ01010O BLK122 122 01020O PMPN 10 01030O W3N 18 01040O 82 '1' 01050O E 81 01060O BLK122 122 01070O E 71 01080O EOF 122 01090O******************************************************************** 01100OSTARTFL E 82 01110O OR 83 01120O PMPN 10 01130O******************************************************************** 01140OTERM50 E 71 01150O COUNT Z 50 01160O E 81 01170O COUNT Z 50 01180O E 82 01190O PMPN 12 ' - - ' 01200O COUNT Z 50 01210O W3N Z 30 ** EOF 001220 001230/* 001240_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(Â& ¼XQZPC1 P999999120282(èÈÐ00010H QQZPC100020F* PRODUCTION CONTROL CONVERSION MENU. (XQZPC1) 00030F* REVISED 11-23-82 9:30 AM. 00040F* 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070E******************************************************************** 00080E PA 1 23 8 NA 50 PROGRAM #/NAMES 00090E PB 1 23 8 NB 50 PROGRAM #/NAMES 00100E NUL 1 132 1 NULL CHAR 00110E A4 4 4 1 A 00120E TITL 1 6 66 MENU TITLE,HEADINGS 00130E MSG 1 3 25 00140E SEL 1 46 8 00150E PRG 1 23 8 NAM 50 AWORK ARRAY 00160E LNK 1 7 6 A 00170E BIT 33 1 00180E PAR 25 1 00190E TST 25 1 00200E CALL 7 6 A 00210E REC 177 1 00220I******************************************************************** 00230IBITPAR BT 02 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I******************************************************************** 00280ICRTFILE CR 00290I 19 26 CRJOB 00300I 27 27 CRSHUT 00310I 28 330CRTIME 00320I 34 370CRDATE 00330I 38 79 CALL 00340I 80 256 REC 00350C******************************************************************** 00360C EXSR SR101 INIT 00370C EXSR SR102 DISPLAY MENU 00380C EXSR SR103 REQUEST SELECTION 00390C*------------------------------------------------------------------ 00400C NEWITM TAG 00410C MOVEL'QQZPC1 'PROG 8 00420C EXSR SR98 <<>> 00430C*------------------------------------------------------------------ 00440C MENU TAG 00450C EXSR SR97 <<>> 00460C*--------------------------------------------------------------------- 00470C GOODBY TAG 00480C MOVEL'GOODBY 'PROG 8 00490C EXSR SR98 <<>> 00500C*----------------------------------------------------------------- ÐÐ00510C ENDJOB TAG <<>> 00520C MOVEL'ENDJOB 'PROG 00530C EXITFCHAIN 00540C RLABL PROG 00550C************************************************************************ 00560CSR SR68 BEGSR 00570CSR EXITFZLFCR LF/CR 00580CSR ENDSR 00590C***************************************************************** 00600CSR SR69 BEGSR 00610C* MOVE CURSOR 00620CSR 50 EXITFZPUTXY 00630CSR RLABL RPGLIN 00640CSR RLABL RPGCOL 00650CSRN50 EXITFZMOVXY 00660CSR RLABL RPGLIN 00670CSR RLABL RPGCOL 00680CSR ENDSR 00690C**************************************************************** 00700CSR SR70 BEGSR 00710CSR MOVELW66A OUTPUT 80 00720CSR EXITFZW80 WRITE 80-BYTES CRT 00730CSR RLABL OUTPUT 00740CSR ENDSR 00750C****************************************************************** ÐÐ00760CSR SR71 BEGSR 00770CSR MOVELREQST RPGLIN 00780CSR MOVEL'067' RPGCOL 00790CSR EXSR SR69 MOVE CURSOR 00800CSR 50 EXITFZBLINK START BLINK 00810CSR EXSR SR70 WRITE MESSAGE 00820CSR EXITFZBLUNK STOP BLINK 00830CSR ENDSR 00840C******************************************************************* 00850CSR SR72 BEGSR 00860CSR MOVE BLK66 W66A 00870CSR EXSR SR71 INIT MESSAGE 00880CSR ENDSR 00890C****************************************************************** 00900CSR SR75 BEGSR 00910C* READ CRT 00920CSR SETOF 7790 00930CSR MOVE BLK4 W4A 4 00940CSR EXITFZR4 READ CRT 00950CSR RLABL W4A 00960CSR MOVEAW4A A4 00970CSR MOVE BLK4 W4A 4 00980CSR Z-ADD1 W 30 00990CSR '\' LOKUPA4,W 90 01000CSRN90 GOTO T75C ÐÐ01010CSR 1 ADD W W 01020CSR W COMP 4 54 01030CSRN54 GOTO T75B 01040C*--------------------------------------------------------------- 01050CSR T75A TAG 01060C* FLAG BAD ESCAPE CODE 01070CSR MOVE BLK66 W66A 01080CSR MOVELMSG,3 W66A 01090CSR EXSR SR71 PUT ERROR MESSAGE 01100CSR GOTO SR75 01110C*-------------------------------------------------------------- 01120CSR T75B TAG 01130CSR A4,W COMP 'G' 98 01140CSR A4,W COMP 'E' 94 01150CSR A4,W COMP 'N' 93 01160CSR 98 GOTO GOODBY 01170CSR 94 GOTO MENU 01180CSR 93 GOTO NEWITM 01190CSR GOTO T75A BAD ESCAPE CODE 01200C*-------------------------------------------------------------------- 01210CSR T75C TAG 01220CSR Z-ADD1 W 01230CSR ' ' LOKUPA4,W 77 01240CSR 77 MOVEAA4,W W4A 01250CSR END75 TAG ÐÐ01260CSR EXSR SR72 INIT MESSAGE 01270CSR ENDSR 01280C******************************************************************** 01290CSR SR96 BEGSR 01300CSR # CHAINCRTFILE H9 GET CRTFILE 01310CSR H9 GOTO ENDJOB 01320CSR ENDSR 01330C***************************************************************** 01340CSR SR97 BEGSR 01350C* MENU REQUEST EXIT. 01360CSR Z-ADD1 W 30 01370CSR ' ' LOKUPLNK,W 54 01380CSRN54 MOVEL'CONTU 'PROG 01390CSR 54 MOVELLNK,W PROG 8 01400CSR 54 MOVE ' ' LNK,W 01410CSR EXSR SR98 <<>> 01420CSR ENDSR 01430C***************************************************************** 01440CSR SR98 BEGSR 01450C* NORMAL EOJ - UPDATE CRTFILE AND LINK TO PROG PROGRAM. 01460CSR 50 EXITFZISTAT 01470CSR 50 EXITFZESCH 01480CSRN50 EXITFZCPAGE 01490CSR # CHAINCRTFILE H8 01500CSR H8 GOTO ENDJOB <<>> ÐÐ01510CSR MOVE LNK CALL 01520CSR MOVE ' ' REC 01530CSR MOVE PROG CRJOB 01540CSR MOVELUDATE CRDATE 01550CSR TIME CRTIME 01560CSR SETON 97 01570CSR EXCPT UPDATE CRTFILE 01580CSR SETOF 97 01590CSR EXITFCHAIN <<>> 01600CSR RLABL PROG 01610CSR ENDSR 01620C******************************************************************* 01630CSR SR99 BEGSR 01640C* PROGRAM SELECTED - LOAD THIS MENU AS RETURN-TO PROG 01650CSR Z-ADD8 W 01660C*----------------------------------------------------------------- 01670CSR T99A TAG 01680CSR W SUB 1 W 54 01690CSRN54 SETON H7 01700CSRN54 GOTO ENDJOB <<>> 01710CSR LNK,W COMP ' ' 54 01720CSRN54 GOTO T99A 01730CSR MOVEL'QQZPC1' LNK,W 01740CSR EXSR SR98 <<>> 01750CSR ENDSR ÐÐ01760C******************************************************************* 01770C* 01780C* 01790C* 01800C* 01810C* 01820C* 01830C* 01840C********************************************************************** 01850CSR SR101 BEGSR 01860C* 1-TIME INIT 01870CSR MOVE BIT,1 NUL 01880CSR MOVEANUL OUTPUT 01890CSR MOVE ' ' W2A 2 01900CSR EXITFZGMINX GET TERMINAL # 01910CSR RLABL W2A 01920CSR MOVE W2A # 20 01930CSR # COMP 0 54 01940CSRN54 Z-ADD25 # 01950CSR # CHAINCRTFILE H9 01960CSR H9 GOTO ENDJOB <<>> 01970CSR MOVE CALL LNK 01980CSR PAR,# COMP '1' 50 01990CSR 50 EXITFZISTAT CLEAR STATUS LINE 02000CSR 50 EXITFZESCH CLEAR SCREEN ÐÐ02010CSRN50 EXITFZCPAGE CLEAR SCREEN 02020CSRN50 MOVEL'091' RPGLIN 4 02030CSRN50 MOVEL'001' RPGCOL 4 02040CSRN50 EXSR SR69 MOVE CURSOR 02050CSR TST,# COMP 'S' 54 02060CSRN54 CRSHUT COMP 'S' 54 02070CSR 54 MOVE 'SHUTDOWN'PROG 02080CSR 54 EXSR SR98 <<>> 02090CSR MOVE ' ' BLK50 50 02100CSR MOVE ' ' BLK66 66 02110CSR MOVE ' ' BLK132132 02120CSR MOVE ' ' BLK35 35 02130CSR MOVE ' ' BLK8 8 02140CSR MOVE ' ' BLK4 4 02150C* 02160C* 02170CSR MOVE ' ' REC 02180CSR MOVE 'QQZPC1 'CRJOB 02190CSR TIME CRTIME 02200CSR MOVELUDATE CRDATE 02210CSR SETON 97 02220CSR EXCPT REWRITE CRTFILE 02230CSR SETOF 97 02240CSR ENDSR 02250C********************************************************************** ÐÐ02260CSR SR102 BEGSR 02270C* DISPLAY MENU 02280CSR Z-ADD-1 M 20 02290CSR Z-ADD1 REQST 30 02300CSR 50 Z-ADD0 W3N 30 02310CSRN50 Z-ADD90 W3N 02320C*--------------------------------------------------------------------- 02330CSR T102A TAG 02340CSR MOVE BLK132 W132A 132 02350CSR 2 ADD M M 20 02360CSR M COMP 5 54 02370CSR 54 GOTO T102C 02380CSR 1 ADD M A 20 02390CSR TITL,M COMP BLK66 54 02400CSR 54 MOVELTITL,M W132A 02410CSR TITL,A COMP BLK66 55 02420CSR 55 MOVE TITL,A W132A 02430CSRN54N55 GOTO T102A 02440CSR 1 ADD W3N W3N 02450CSR MOVELW3N RPGLIN 4 02460CSR MOVEL'001' RPGCOL 4 02470CSR EXSR SR69 MOVE CURSOR 02480CSR EXITFZW132 WRITE TITLE LINE 02490CSR RLABL W132A 02500CSR Z-ADDW3N REQST 30 ÐÐ02510CSR GOTO T102A 02520C*---------------------------------------------------------------- 02530CSR T102C TAG 02540CSR Z-ADD0 M 02550CSR Z-ADD0 S 20 02560CSR MOVE BLK8 SEL 02570CSR 1 ADD REQST REQST 02580CSR Z-ADDREQST W3N 30 02590CSR MOVE PA PRG 02600CSR MOVE NA NAM 02610CSR MOVEL'001' RPGCOL 02620CSR EXSR SR201 OUTPUT MENU 02630CSR MOVE PB PRG 02640CSR MOVE NB NAM 02650CSR MOVEL'067' RPGCOL 02660CSR Z-ADDREQST W3N 02670CSR EXSR SR201 OUTPUT MENU 02680CSR ENDSR 02690C******************************************************************** 02700CSR SR103 BEGSR 02710C* REQUEST SELECTION. 02720C*------------------------------------------------------------------- 02730CSR MOVEANUL W66A 66 02740CSR MOVELMSG,1 W66A 02750CSR MOVELREQST RPGLIN 4 ÐÐ02760CSR MOVEL'001' RPGCOL 4 02770CSR EXSR SR69 MOVE CURSOR 02780CSR EXSR SR70 WRITE PROMPT 02790CSR EXSR SR75 READ CRT 02800CSR Z-ADD4 W2N 20 02810CSR EXIT SUBRAJ RJ 02820CSR RLABL W2N 02830CSR RLABL W4A 02840CSR MOVE W4A S 20 02850CSR S COMP 0 54 02860CSR 54 S COMP 46 5454 02870CSR 54 SEL,S COMP BLK8 54 02880CSR 54 MOVELSEL,S PROG 8 02890CSR 54 EXSR SR99 <<>> 02900CSR MOVELBLK66 W66A 02910CSR MOVE MSG,2 W66A 02920CSR EXSR SR71 PUT MESSAGE 02930CSR GOTO SR103 REQUEST AGAIN 02940CSR ENDSR 02950C********************************************************************* 02960CSR SR201 BEGSR 02970C* DISPLAY PROGRAM SELECTIONS 02980CSR Z-ADD1 M 20 02990C*------------------------------------------------------------------ 03000CSR T201C TAG ÐÐ03010CSR BLK50 LOKUPNAM,M 54 03020CSRN54 GOTO END201 03030CSR 1 ADD W3N W3N 03040CSR MOVELW3N RPGLIN 03050C* 03060CSR PRG,M COMP BLK8 55 03070CSR 55 1 ADD S S 03080CSR 55 MOVE PRG,M SEL,S SAVE PROG NAME 03090CSR MOVEANUL W66A 03100CSR MOVE BLK66 W54A 54 03110CSR 55 MOVELS W54A 03120CSR 55 S COMP 9 54 03130CSR 55N54 MOVEL' ' W54A 03140CSR MOVE NAM,M W54A 03150CSR MOVELW54A W66A 03160CSR MOVE '. ' W66A 03170CSR EXSR SR69 MOVE CURSOR 03180CSR EXSR SR70 DISPLAY ENTRY 03190CSR MOVE BLK50 NAM,M 03200CSR GOTO T201C 03210CSR END201 ENDSR 03220C* 03230C* 03240C* 03250C* ÐÐ03260O*************************************************************** 03270OCRTFILE E 97 03280O CRJOB 26 03290O CRTIME 33 03300O CRDATE 37 03310O CALL 79 03320O REC 256 03330O******************************************************************** ** PA/NA ARRAY 03340Q001WO WORK ORDERS - ADD,CHANGE,DELETE 1 03350Q007WO WORK ORDERS - RELEASE 2 03360 3 03370Q012WO INPUT BACKORDERS-ADD,CHG,DEL (UNPLANNED) 4 03380Q010WO INPUT PULL SHEET BACKORDERS 5 03390Q011WO ISSUE PULL SHEETS 6 03400Q017WO ISSUE BACKORDERS 7 03410Q018WO ISSUE FROM STOCK - UNPLANNED 8 03420 9 03430 10 03440 11 03450 12 03460 13 03470 14 03480 15 03490 16 03500ÐÐ 37 03510 18 03520 19 03530 20 03540 21 03550 22 03560 23 03570** PB/NB ARRAY 03580Q002WO WORK ORDERS - BY WORK ORDER NO. 1 03590Q003WO - BY TOP ASSY PART NO. 2 03600Q004WO - BY DUE DATE 3 03610Q005WO - BY START DATE 4 03620Q006WO - BY PART NO. 5 03630Q013WO WORK ORDERS - VARIOUS SEQUENCES 6 03640Q024WO PULL SHEETS - BY WORK ORDER NO. 7 03650Q020WO ROUTING OPERATIONS - BY WORK ORDER NO. 8 03660Q028WO BACKORDERS - VARIOUS SEQUENCES 9 03670Q013PO PURCH ORDERS- VARIOUS SEQUENCES 10 03680Q029WO INVENTORY STATUS BY PART NO. OR MODEL 11 03690Q007FC FORECAST - BY PART # OR MODEL 12 03700Q008FC FORECAST - VARIOUS SEQUENCES 13 03710 14 03720 15 03730 16 03740 17 03750ÐÐ 18 03760 19 03770 20 03780 21 03790 22 03800 23 03810** NUL ARRAY 03820 03830** A4 ARRAY 03840 03850** TITL ARRAY (EA ELEMENT = 1/2 TITLE LINE) 03860 P R O D U C T I O N C O N T R O L C O N 03870V E R S I O N U P D A T E M E N U 03880<---------U P D A T E P R O G R A M S---------> 03890<--------D I S P L A Y P R O G R A M S--------> 03900 03910 03920** MSG ARRAY 03930ENTER SELECTION NO.: 03940INVALID... TRY AGAIN: 03950\ CODE INVALID.... TRY AGAIN: 03960** SEL ARRAY 03970 03980** PRG/NAM ARRAY 03990 04000ÐÐ** LNK ARRAY 04010 04020/* 04030_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(¼' ¼$X209SF P120282120282(èÈÐ00010H Q209SF00020F* DISPLAY REQUIREMENTS FOR SPECIFIED WORK ORDER. (X209SF) 00030F* REVISED 8/20/81 4:30 PM. 00040FBITTAB IP F 33 DISK 00050FSFMAST IC F 128R29AI 1 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FORDERLOGIC F 32R13AI 1 DISK 00090FALTKEY ID F 32L29AI 1 DISK 00100FCRTFILE UC F 256R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E NULL 1 132 1 00140E A14 14 14 1 A 00150E A29 29 29 1 00160E BIT 33 1 00170I**************************************************************** 00180IBITTAB BT 00190I 1 33 BIT 00200I******************************************************************** 00210ICRTFILE CR 00220I 68 73 CRRET 00230I******************************************************************** 00240IORDERLOGOL 00250I 1 2 OLREC ÐÐ00260I 3 11 OLORD 00270I 14 23 OLPN 00280I 24 29 OLDUE 00290I 30 30 OLTYPE 00300I 32 32 OLSTAT 00310I******************************************************************** 00320IMGFILE MG 00330I 1 35 MGTEXT 00340I******************************************************************** 00350ISFMAST SF 00360I* SCHEDULE MASTER. 00370I* COMMON FIELDS. 00380I* KEY AREA. 00390I 1 29 SFKEY 00400I* PART NO. 10A 00410I 1 10 SFPN 00420I* DATE DUE 6N (YMD) 00430I 11 160SFDUE 00440I* RECORD CODE 2N 00450I* 10 = RECEIVED PO 00460I* 20 = REL WO 00470I* 30 = PURCHASE ORDER 00480I* 40 = PLAN WO 00490I* 50 = PURCHASE REQ 00500I* 60 = SALES ORDER-BACKLOG ÐÐ00510I* 70 = REL REQUIREMENT 00520I* 80 = PLAN REQUIREMENT 00530I* 90 = RUN RELEASE 00540I 17 18 SFREC 00550I* ORDER NO. 9A 00560I 19 27 SFORD 00570I* PREFIX 1A 00580I 19 19 SFPRFX 00590I* PRIME 6A 00600I 19 24 SFPRIM 00610I* ITEM 3N 00620I 25 270SFITEM 00630I* RECEVING LOG # 00640I 28 29 SFRLOG 00650I* QUANTITY 7P 00660I P 30 330SFQTY 00670I* QTY COMPLETE 7P 00680I P 34 370SFQTYC 00690I* DATE LAST TRAN 6N (YMD) 00700I 38 430SFDLT 00710I* CUST #/DEPT #/VEND # 5P 00720I P 44 460SFCUST 00730I* PLAN/REL REQMTS. 00740I* NEXT ASSY PART # 10N 00750I 47 560SFNAPN ÐÐ00760I* QTY PER ASSY 7P 00770I P 57 600SFQPA 00780I* ISSUE CODE 2A 00790I 61 62 SFISSU 00800I* PULL # 3P 00810I P 63 640SFPULL 00820I* ASSY REVISION 2A 00830I 65 66 SFREV 00840I* ASSY WO QTY 7P 00850I P 67 700SFQTYA 00860I* SALES ORDERS 00870I* CUST P.O. 20A 00880I 71 90 SFCPO 00890I* UNIT PRICE 9.3P 00900I P 91 953SFPRIC 00910I* PURCH ORDERS 00920I* VENDOR NAME 20A 00930I* SEE SFCPO UNDER SALES ORDERS. 00940I* UNIT PRICE 9.3P 00950I* SEE SFPRIC UNDER SALES ORDERS. 00960I* WORK ORDERS 00970I* DEPT NAME 20A 00980I* SEE SFCPO UNDER SALES ORDERS. 00990I* OPER SEQ # 3P 01000I P 96 970SFSEQ ÐÐ01010I* START DATE 6N 01020I 98 1030SFSTRT 01030I* PULL # 3P 01040I* SEE PLAN/REL REQMTS. 01050I* REQUIREMENT FLAG 1A 01060I 104 104 SFRFLG 01070I* REVISION 2A 01080I* SEE PLAN/REL REQMTS. 01090I* IN USE--- SEE ABOVE... 105 113 01100I* AVAIL STOCK 7P 01110I P 120 1230SFSAVQ 01120I* AVL BAL 7P 01130I P 124 1270SFAVQ 01140I* RECORD STATUS 1A 01150I 128 128 SFSTAT 01160I******************************************************************** 01170IPMMST2 PM 01180I 1 100PMPN 01190I* 15 180PMPL 01200I 19 30 PMMODL 01210I 31 59 PMDESC 01220I* 70 71 PMECHG 01230I 94 95 PMSC 01240I* ON HAND BAL 01250I P 311 3140PMOHB ÐÐ01260I* REL REQS 7P 01270I* P 323 3260PMRLB 01280I* PURCH REQ BAL 7P 01290I* P 339 3420PMPRB 01300I* PO BAL 01310I* P 343 3460PMPOB 01320I* PLAN REQMT BAL 01330I* P 319 3220PMALB 01340I* FAB CODE 2A 01350I 487 488 PMFAB 01360I 674 674 PMSTAT 01370I******************************************************************** 01380IALTKEY AK 21 1 CA 01390I OR 22 1 CB 01400I OR 25 1 CE 01410I OR 26 1 CF 01420I* ALTERNATE KEY FILE FOR SFMAST. 01430I* COL-1 DEFINITIONS 01440I* A = ORDER ALT KEY FILE 01450I* B = DUE DATE ALT KEY FILE 01460I* E = START DATE ALT KEY FILE 01470I* COL-2 DEFINITIONS. 01480I* 1 = RECD PO 01490I* 3 = PO 01500I* 5 = PUR REQ ÐÐ01510I* 6 = SALES ORDER 01520I* 7 = REL REQMT 01530I* 8 = PLAN REQMT 01540I* 9 = FORECAST 01550I* W = WORK ORDER (PLAN OR RELEASED) 01560I* COMMON FIELDS. 01570I* RECORD CODE (SEE ABOVE) 2A 01580I 1 1 AKTYPE 01590I 2 2 AKKIND 01600I 1 2 AKREC 01610I* RECORD STATUS 1A 01620I 32 32 AKSTAT 01630I 1 29 AKFILE 01640I* NON-COMMON FIELDS. 01650I*------------------------------------------------------------------- 01660I* REQUIREMENT ORDER ALT-KEY - 01670I* KEY AREA. 01680I* ORDER 9A 01690I 3 13 AKORD 21 01700I* PART # 10A 01710I 14 23 AKPN 21 01720I* DUE DATE 6A 01730I 24 29 AKDUE 21 01740I*------------------------------------------------------------------- 01750I* DUE DATE ALT-KEY - ÐÐ01760I* KEY AREA. 01770I* DUE DATE 6N 01780I 3 8 AKDUE 22 01790I* ORDER NO. 11A 01800I 9 19 AKORD 22 01810I* PREFIX 1A 01820I 9 9 AKPRFX 22 01830I* PRIME 6A 01840I 9 14 AKPRIM 22 01850I* ITEM 3N 01860I 15 170AKITEM 22 01870I* RECEIVING LOG # 01880I 18 19 AKRLOG 22 01890I* PART NO. 10A 01900I 20 29 AKPN 22 01910I*------------------------------------------------------------------- 01920I* CUSTOMER/VENDOR ALT-KEY 01930I* KEY AREA. 01940I* CUSTOMER 5N 01950I 3 70AKCUST 23 01960I* ORDER NO. 9A 01970I 8 18 AKORD 23 01980I* PREFIX 1A 01990I 8 8 AKPRFX 23 02000I* PRIME 5N ÐÐ02010I 8 13 AKPRIM 23 02020I* ITEM 3N 02030I 14 160AKITEM 23 02040I* RECEIVING LOG # 02050I 17 18 AKRLOG 23 02060I*------------------------------------------------------------------- 02070I* START DATE ALT-KEY - 02080I* KEY AREA. 02090I* START DATE 6N 02100I 3 80AKSTRD 25 02110I* PART NO. 10N 02120I 9 18 AKPN 25 02130I* ORDER NO. 9A 02140I 19 29 AKORD 25 02150I* PREFIX 1A 02160I 19 19 AKPRFX 25 02170I* PRIME 5N 02180I 19 24 AKPRIM 25 02190I* ITEM 3N 02200I 25 270AKITEM 25 02210I* RECEIVING LOG # 2N 02220I 28 29 AKRLOG 25 02230C******************************************************************** 02240C* 1-TIME INITIALIZE. 02250C EXSR SR101 INIT. ÐÐ02260C*------------------------------------------------------------------- 02270C START TAG 02280C* REQUEST WORK-ORDER PRIME. 02290C EXSR SR201 POSITION CURSOR 02300C EXITFQCLF LF 02310C Z-ADD570 M 50 02320C EXSR SR74 PROMPT/READ 02330C 92 GOTO START ESC BKWD 02340C 93 GOTO NEWITM 02350C 94 GOTO MENU 02360C 98 GOTO GOODBY 02370C N77 GOTO TAG10 NO INPUT 02380C*------------------------------------------------------------------- 02390C TAG5 TAG 02400C MOVELW14A W1A 1 PREFIX 02410C MOVEL' ' W14A 02420C EXSR SR102 R.J. 02430C MOVE W14A W5A 5 02440C MOVELW1A PRIME 6 02450C MOVE W5A PRIME 02460C*------------------------------------------------------------------- 02470C TAG10 TAG 02480C* REQUEST WORK ORDER DASH. 02490C Z-ADD571 M 02500C EXSR SR74 PROMPT/READ ÐÐ02510C 92 GOTO START 02520C 93 GOTO NEWITM 02530C 94 GOTO MENU 02540C 98 GOTO GOODBY 02550C N77 GOTO TAG20 NO INPUT 02560C EXSR SR102 R.J. 02570C MOVE W14A DASH 30 02580C*------------------------------------------------------------------- 02590C TAG20 TAG 02600C* GET WO ORDERLOG/PMMST/SFMAST. 02610C MOVELPRIME ORDER 11 02620C MOVELDASH W5A 5 02630C MOVE '00' W5A 02640C MOVE W5A ORDER 02650C MOVEL'WO' W13A 13 02660C MOVE ORDER W13A 02670C W13A CHAINORDERLOG 54 02680C N54 OLSTAT COMP 'D' 54 02690C 54 GOTO TAG60 WO NOT ON FILE 02700C MOVEAOLPN A29,1 02710C MOVEAOLDUE A29,11 02720C MOVE OLTYPE A29,17 02730C MOVE '0' A29,18 02740C MOVEAORDER A29,19 02750C MOVEAA29,1 W29A 29 ÐÐ02760C EXSR SR80 GET SFMAST 02770C 60 GOTO TAG60 NOT ON FILE 02780C*------------------------------------------------------------------- 02790C TAG30 TAG 02800C MOVELSFPN W12A 12 02810C EXSR SR81 GET PMMST2 02820C 60 GOTO TAG60 NOT ON FILE 02830C EXSR SR103 SAVE WO DATA 02840C EXSR SR71 PUT HEADING 02850C* CHASE ALTKEY ORDER KEYS AND GET REQUIREMENTS. 02860C MOVE ' ' A29 02870C 78 MOVEA'A7' A29,1 02880C 79 MOVEA'A8' A29,1 02890C MOVEAORDER A29,3 02900C MOVEAA29 W29A 02910C W29A SETLLALTKEY 02920C*------------------------------------------------------------------- 02930C TAG40 TAG 02940C SETOF 54 02950C READ ALTKEY 54 02960C 54 GOTO TAG70 02970C AKORD COMP ORDER 54 02980C 54 AKTYPE COMP 'A' 54 02990C N54 GOTO TAG70 03000C AKSTAT COMP 'D' 54 ÐÐ03010C 54 GOTO TAG40 03020C MOVEAAKPN A29,1 03030C MOVEAAKDUE A29,11 03040C MOVE AKKIND A29,17 03050C MOVE '0' A29,18 03060C MOVEAORDER A29,19 03070C MOVEAA29 W29A 29 03080C EXSR SR80 GET SFMAST 03090C 60 GOTO TAG40 03100C MOVELSFPN W12A 03110C EXSR SR81 GET PMMST2 03120C 60 GOTO TAG40 03130C SFREC COMP '70' 76 REL REQMT 03140C SFREC COMP '80' 75 PLAN REQMT 03150C SETON 72 03160C EXCPT DISPLAY 03170C SETOF 72 03180C 1 ADD COUNT COUNT 03190C COUNT COMP 29 54 54 03200C N54 GOTO TAG40 03210C Z-ADD320 M 03220C EXSR SR74 END PAGE MSG 03230C 98 GOTO GOODBY 03240C 94 GOTO MENU 03250C 92 GOTO NEWITM ÐÐ03260C EXSR SR71 03270C GOTO TAG40 03280C*------------------------------------------------------------------- 03290C TAG60 TAG 03300C SETON 74 03310C EXCPT WO NOT ON FILE MSG 03320C SETOF 74 03330C GOTO START 03340C*------------------------------------------------------------------- 03350C TAG70 TAG 03360C SETON 70 03370C EXCPT 03380C SETOF 70 03390C GOTO START 03400C*------------------------------------------------------------------- 03410C NEWITM TAG 03420C MOVEL'Q209SF' PROG 8 03430C GOTO END 03440C*------------------------------------------------------------------- 03450C MENU TAG 03460C MOVEL'Q059DP' PROG 03470C GOTO END 03480C*------------------------------------------------------------------- 03490C GOODBY TAG 03500C MOVEL'GOODBY' CRRET ÐÐ03510C MOVEL'Q059DP' PROG 8 03520C*------------------------------------------------------------------- 03530C END TAG 03540C SETON 97 03550C EXCPT 03560C SETOF 97 03570C EXITFCHAIN 03580C RLABL PROG 03590C*------------------------------------------------------------------- 03600C ENDJOB TAG 03610C******************************************************************** 03620CSR SR71 BEGSR 03630C* PUT HEADINGS. 03640CSR Z-ADD12 COUNT 30 03650CSR SETON 71 03660CSR EXCPT PUT HEADING 03670CSR SETOF 71 03680CSR ENDSR 03690C******************************************************************** 03700CSR SR73 BEGSR 03710C* PUT MESSAGE TO CRT 03720CSR M CHAINMGFILE 54 03730CSR 54 MOVE BLK35 MGTEXT 03740CSR 54 MOVEL'??????' MGTEXT 03750CSR SETON 73 ÐÐ03760CSR EXCPT PUT MSG 03770CSR SETOF 73 03780CSR ENDSR 03790C********************************************************************* 03800CSR SR74 BEGSR 03810C* PROMPT/READ. 03820CSR EXSR SR73 PROMPT 03830CSR EXITFQBELL RING BELL 03840CSR EXSR SR75 READ CRT 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR75 BEGSR 03880C* READ CRT. 03890CSR SETOF 779092 03900CSR SETOF 939498 03910CSR MOVE BIT,8 BUFLGT 2 03920CSR MOVE BLK35 W14A 14 03930CSR EXITFQWREED 03940CSR RLABL W14A 03950CSR RLABL BUFLGT 03960CSR MOVEAW14A A14 03970CSR MOVE BLK14 W14A 03980CSR Z-ADD1 W 30 03990CSR '\' LOKUPA14,W 90 04000CSRN90 GOTO T75B ÐÐ04010CSR 1 ADD W W 04020CSR W COMP 14 54 04030CSR 54 GOTO T75A 04040CSR A14,W COMP 'B' 92 04050CSR A14,W COMP 'N' 93 04060CSR A14,W COMP 'E' 94 04070CSR A14,W COMP 'G' 98 04080CSR 92 04090COR 93 04100COR 94 04110COR 98 GOTO END75 04120C*------------------------------------------------------------------- 04130CSR T75A TAG 04140CSR Z-ADDM W5N 50 04150CSR Z-ADD318 M 04160CSR EXSR SR73 04170CSR Z-ADDW5N M 04180CSR GOTO SR75 04190C*------------------------------------------------------------------- 04200CSR T75B TAG 04210CSR Z-ADD1 W 04220CSR ' ' LOKUPA14,W 77 04230CSR 77 MOVEAA14,W W14A 04240CSR END75 ENDSR 04250C******************************************************************** ÐÐ04260CSR SR80 BEGSR 04270C* GET SFMAST. 04280CSR W29A CHAINSFMAST 60 04290CSRN60 SFSTAT COMP 'D' 60 04300CSRN60 SFQTY SUB SFQTYC QTYBAL 70 6060 LT,EQ 04310CSR ENDSR 04320C******************************************************************** 04330CSR SR81 BEGSR 04340C* GET PART MAST. 04350CSR MOVE ' ' W12A 04360CSR W12A CHAINPMMST2 60 04370CSRN60 PMSTAT COMP 'D' 60 04380CSR ENDSR 04390C******************************************************************** 04400CSR SR101 BEGSR 04410C* 1-TIME INIT. 04420CSR MOVE BIT,1 NULL 04430CSR MOVELBIT,1 BUFLGT 2 04440CSR EXSR SR201 POSITION CURSOR 04450CSR MOVE ' ' BLK35 35 04460CSR MOVE ' ' BLK14 14 04470CSR MOVE '120001' W6A 6 04480CSR EXITFQXYPOS 04490CSR RLABL W6A 04500CSR MOVE ' 'W8A 8 ÐÐ04510CSR Z-ADD0 W2N 20 04520CSR Z-ADD0 W1N 10 04530CSR MOVE ' ' W2A 2 04540CSR EXITFPGMINX 04550CSR RLABL W8A 04560CSR RLABL W2N 04570CSR RLABL W1N 04580CSR RLABL W2A 04590CSR MOVE W2A PORT 20 04600CSR PORT COMP 0 54 04610CSRN54 Z-ADD25 PORT 04620CSR PORT CHAINCRTFILE H9 04630CSR H9 GOTO ENDJOB 04640CSR ENDSR 04650C******************************************************************** 04660CSR SR102 BEGSR 04670C* RIGHT ADJUST. 04680CSR Z-ADD14 W2N 20 04690CSR EXIT SUBRAJ 04700CSR RLABL W2N 04710CSR RLABL W14A 04720CSR ENDSR 04730C******************************************************************** 04740CSR SR103 BEGSR 04750C* SAVE WORK ORDER DATA. ÐÐ04760CSR MOVE SFPN WOPN 100 04770CSR MOVE PMDESC WODESC 29 04780CSR MOVE PMMODL WOMODL 12 04790CSR MOVE PMFAB WOFAB 2 04800CSR Z-ADDSFSTRT WOSTRT 60 04810CSR Z-ADDSFDUE WODUE 60 04820CSR SFQTY SUB SFQTYC WOQTY 70 54 04830CSRN54 Z-ADD0 WOQTY 04840CSR SFREC COMP '20' 78 04850CSR SFREC COMP '40' 79 04860CSR ENDSR 04870C******************************************************************** 04880CSR SR201 BEGSR 04890C* POSITION CURSOR. 04900CSR MOVE '120001' W6A 6 04910CSR EXITFQXYPOS POSITION CURSOR 04920CSR RLABL W6A 04930CSR ENDSR 04940O******************************************************************** 04950OCRTFILE E 97 04960O CRRET 73 04970O******************************************************************** 04980OTERM132 E 71 04990O UDATE 8 ' - - ' 05000O 45 'D I S P L A Y' ÐÐ05010O 55 'W O R K' 05020O 67 'O R D E R' 05030O 93 'R E Q U I R E M E N T S' 05040O*------------------------------------------------------------------- 05050O E 71 05060O 1 ' ' 05070O*------------------------------------------------------------------- 05080O E 71 05090O 4 'WORK' 05100O 19 'ASSY' 05110O 78 'FAB' 05120O 86 'ORDER' 05130O 101 'START' 05140O 114 'DUE' 05150O*------------------------------------------------------------------- 05160O E 71 05170O 5 'ORDER' 05180O 22 'PART-NO.' 05190O 42 'DESCRIPTION' 05200O 67 'MODEL' 05210O 79 'CODE' 05220O 88 'QUANTITY' 05230O 100 'DATE' 05240O 115 'DATE' 05250O 130 'STATUS' ÐÐ05260O*------------------------------------------------------------------- 05270O E 71 05280O 1 ' ' 05290O*------------------------------------------------------------------- 05300O E 71 05310O PRIME 6 05320O 7 '-' 05330O DASH 10 05340O WOPN 26 ' - - ' 05350O WODESC 60 05360O WOMODL 74 05370O WOFAB 78 05380O WOQTY 2 88 05390O WOSTRT 104 ' - - ' 05400O WODUE 119 ' - - ' 05410O 78 132 'RELEASED' 05420O 79 132 'PLANNED ' 05430O*------------------------------------------------------------------- 05440O E 71 05450O 1 ' ' 05460O*------------------------------------------------------------------- 05470O E 71 05480O 72 'C O M P O N E N T S' 05490O*------------------------------------------------------------------- 05500O E 71 ÐÐ05510O 1 ' ' 05520O*------------------------------------------------------------------- 05530O E 71 05540O 61 'SOURCE' 05550O 68 'ISSUE' 05560O 75 'FAB' 05570O 82 'QTY' 05580O 92 'QTY' 05590O 102 'DATE' 05600O 113 'ON-HAND' 05610O 121 'AVAIL' 05620O 132 'AVAIL' 05630O*------------------------------------------------------------------- 05640O E 71 05650O 8 'PART-NO.' 05660O 25 'DESCRIPTION' 05670O 51 'STATUS' 05680O 60 'CODE' 05690O 67 'CODE' 05700O 75 'CODE' 05710O 85 'PER-ASSY' 05720O 93 'REQD' 05730O 101 'DUE' 05740O 113 'BALANCE' 05750O 121 'STOCK' ÐÐ05760O 131 'BAL' 05770O E 71 05780O 1 ' ' 05790O*------------------------------------------------------------------- 05800O E 72 05810O PMPN 12 ' - - ' 05820O PMDESC 43 05830O 76 53 'RELEASED' 05840O 75 53 'PLANNED ' 05850O PMSC 60 05860O SFISSU 67 05870O PMFAB 75 05880O SFQPA J 85 05890O QTYBAL2 93 05900O SFDUE 103 ' - - ' 05910O SFAVQ J 132 05920O SFSAVQJ 123 05930O PMOHB J 113 05940O*------------------------------------------------------------------- 05950O E 73 05960O NULL 132 05970O MGTEXT 35 05980O 37 ' ' 05990O*------------------------------------------------------------------- 06000O E 74 ÐÐ06010O 22 'WORK ORDER NOT ON FILE' 06020O*------------------------------------------------------------------- 06030O E 70 06040O 19 'END OF REQUIREMENTS' ** NULL ARRAY 006050 006060** A14 ARRAY 006070 006080** A29 ARRAY 006090 006100/* 006110_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È(¤ ÈTX102DP P120282120282(èÈÐ00010H Q102DP00020F* DELETE TEXT FILES ON D1. (X102DP) 00030F* REVISED 8/20/80 3:15 PM. 00040FSTATUSPTIP F 136 DISK 00050FZNEWVTOCO F 80 DISK 00060E NAM 1 700 8 00070ISTATUSPTSP 02 00080I* FILE NAME 8A 00090I 6 13 FILNAM 00100I* OWNER 8A 00110I 15 22 FILOWN 00120I* FILE DATE 6N 00130I 25 300FILDAT 00140I* FILE TYPE 1A (D,R,S,B) 00150I 34 34 FILTYP 00160I* RECORD LGTH 4N 00170I 40 430FILLGT 00180I* KEY LENGTH 2N 00190I 47 480KEYLGT 00200I* KEY POSITION 4N 00210I 50 530KEYPOS 00220I* STARTING SECTOR 5A (HEX) 00230I 85 89 SECTOR 00240I 85 89 SEC 00250I* RECORD COUNT 6N ÐÐ00260I 92 970RECCNT 00270I* EXPIRATION DATE 6N 00280I 99 1040EXPDAT 00290I* MAX RECORDS 6N 00300I 109 1140OLDMAX 00310I* FILE STATUS 6A 00320I 116 121 FILSTS 00330I* SECTOR ALIGNED 1A (Y,N) 00340I 124 124 SECALG 00350C******************************************************************** 00360C MOVE ' ' BLK8 8 00370C FILOWN COMP BLK8 54 00380C 54 GOTO TAG10 00390C MOVELFILNAM W1A 1 00400C W1A COMP ' ' 54 00410C 54 W1A COMP 'X' 54 00420C N54 GOTO TAG10 00430C GOTO END 00440C*---------------------------------------------------------------- 00450C TAG10 TAG 00460C SETOF 02 00470C*----------------------------------------------------------------- 00480C END TAG 00490C 02 EXSR SR81 00500CLR EXSR SR82 ÐÐ00510C******************************************************************** 00520CSR SR81 BEGSR 00530C* PUT INSTR STMT. 00540CSR FILNAM LOKUPNAM 54 00550CSR 54 GOTO END81 00560CSR 1 ADD N N 30 00570CSR MOVE FILNAM NAM,N 00580CSR FILTYP COMP 'R' 84 00590CSR SETON 81 00600CSR EXCPT 00610CSR SETOF 81 00620CSR END81 ENDSR 00630C******************************************************************** 00640CSR SR82 BEGSR 00650C* PUT EXIT STMT. 00660CSR SETON 82 00670CSR EXCPT 00680CSR SETOF 82 00690CSR ENDSR 00700O******************************************************************** 00710OZNEWVTOCE 81 00720O 2 '*' 00730O FILNAM 12 00740O E 81 00750O 14 'INPUT=ZNEWVTOC' ÐÐ00760O E 81 00770O 4 'UTIL' 00780O E 81 00790O 19 'DELETE,FN= ,' 00800O FILNAM 18 00810O 28 ',VL=D1 ' 00820O E 81 00830O 2 'EX' 00840O*------------------------------------------------------------------- 00850O E 82 00860O 14 'INPUT=TERMINAL' ** NAM ARRAY 000870 000880/* 000890_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2) 2X901PO PJ999999120282(èÈÐ00010H Q901PO00020F* P. O. MAST - REORG (X901PO) 00030F* REVISED 6/09/82 2:15 PM. 00040FPOITEM IP F 384 9AI 1 DISK 00050FOLDPO IS F 128 6AI 1 DISK 00060FPOMAST O F 128 6AI 1 DISK 00070FPOVKEY O F 16 11AI 1 DISK 00080I******************************************************************** 00090IOLDPO PO 01 128NCD 00100I* PURCHASE ORDER MASTER RECORD. 00110I 1 128 RECORD 00120I* P.O. # 6A (KEY) 00130I 1 6 POPO L1M1 00140I* VENDOR 5N 00150I 7 110POVEND 00160I GG 03 00170I******************************************************************** 00180IPOITEM PI 02 384NCD 00190I* PURCHASE ORDER ITEM RECORD. 00200I* KEY AREA. 00210I* PO # 6N 00220I 1 6 PIPO L1M1 00230I PG 03 00240O**************************************************************** 00250OPOMAST D 01 MR ÐÐ00260O RECORD 128 00270O********************************************************************* 00280OPOVKEY D 01 MR 00290O POVEND 5 00300O POPO 11 00310O 16 'A' 00320O********************************************************************* /* 00330_‚ ÐÐ_‚_‚0O RECORD 128 00270O********************************************************************* 00280OPOVKEY D 01 MR 00290O POVEND 5 00300O POPO 11 00310O 16 'A' 00320O********************************************************************* /* 00330_‚ ÐÈ( )¦  NX005PO P999999120282(èÈÐ00010H Q005PO00020F* DISPLAY PO BY VENDOR #.(X005PO) 00030F* REVISED 8-02-82 12:45 PM. 00040FBITPAR IP F 90 DISK 00050FVMMAST IC F 384R 5AI 1 DISK 00060FPOITEM ID F 384L 9AI 1 DISK 00070FPOVKEY ID F 16L11AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FCRTFILE UC F 256R DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 1 132 1 00130E A10 10 10 1 A 00140E RCD 1 26 7 0A 00150E DIV 1 132 1 00160E LNK 1 7 6 A 00170E PID 26 6 0 00180E PIQ 26 7 0A 00190E BIT 33 1 00200E PAR 25 1 00210E TST 25 1 00220E CALL 7 6 00230I******************************************************************** 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************** 00290IMGFILE MG 00300I 1 35 MGTEXT 00310I******************************************************************** 00320IVMMAST VM 00330I 26 60 VMNAME 00340I 384 384 VMSTAT 00350I******************************************************************** 00360IPOITEM PI 00370I* PURCHASE ORDER ITEM RECORD. 00380I* KEY AREA. 00390I* PO # 6N 00400I 1 6 PIPO 00410I* PO ITEM 3N 00420I 7 90PIITEM 00430I 1 9 PIKEY 00440I* DYNAIR PART # 10N 00450I 10 190PIPN 00460I* VENDOR PART # 15A 00470I 20 34 PIVPN 00480I* DESCRIPTION 29A 00490I 35 63 PIDESC 00500I* NON-INVENTORY DESCRIPTION 70A ÐÐ00510I 10 79 PINDES 00520I* DATE LAST RECEIPT 6N 00530I 80 850PIDLR 00540I* QTY RECEIVED 7P 00550I P 86 890PIQRCD 00560I* QTY TO STK,SCRAP,RTV 7P 00570I P 90 930PIQSTK 00580I* PRICE CODE 1A 00590I* L = LOT 00600I* N = NO CHARGE 00610I 94 94 PILOT 00620I* PRICE 9.3P 00630I P 95 993PI$PRC 00640I* WORK ORDER # 9A 00650I 100 108 PIWO 00660I 100 105 PIWOP 00670I 106 1080PIWOD 00680I* VENDOR # 5P (FROM POMAST) 00690I P 109 1110PIVEND 00700I* LAST RCVG LOG # USED 2N 00710I 112 1130PILLOG 00720I* SCHEDULE DATES 6N X 26 (Y,M,D) 00730I 114 269 PID 00740I* SCHED QTYS 7P X 26 00750I P 270 373 PIQ ÐÐ00760I* RECORD STATUS 1A 00770I 384 384 PISTAT 00780I******************************************************************** 00790IPOVKEY PV 00800I 1 50PVVEND 00810I 6 11 PVPO 00820I 1 11 PVKEY 00830I 16 16 PVSTAT 00840I******************************************************************** 00850ICRTFILE CR 00860I* 1 50CREMPL 00870I* 6 13 CRUSER 00880I* 14 180CRDEPT 00890I* 19 26 CRJOB 00900I 27 27 CRSHUT 00910I 28 330CRTIME 00920I 34 370CRDATE 00930I 38 79 CALL 00940C******************************************************************** 00950C* INITIALIZE 1-TIME. 00960C EXSR SR101 INIT 00970C MOVE ' ' BLK6 6 DUMB 00980C EXSR SR105 CLEAR PAGE 00990C*------------------------------------------------------------------- 01000C START TAG ÐÐ01010C* REQUEST VENDOR #. 01020C EXSR SR102 RQST VEND # 01030C 90 GOTO ESCAPE 01040C*------------------------------------------------------------------- 01050C TAG10 TAG 01060C* REQUEST PO #. 01070C EXSR SR103 RQST PO # 01080C 92 GOTO START 01090C 90 GOTO ESCAPE 01100C*------------------------------------------------------------------- 01110C TAG20 TAG 01120C* DISPLAY PO ITEMS. 01130C EXSR SR104 DISPLAY PO ITEMS 01140C 92 GOTO TAG10 01150C 90 GOTO ESCAPE 01160C 77 EXSR SR202 R.J. VENDOR 01170C 77 MOVE W10A TVEND 01180C 77 GOTO TAG10 01190C*------------------------------------------------------------------- 01200C ESCAPE TAG 01210C 98 GOTO GOODBY 01220C 94 GOTO MENU 01230C 93 GOTO NEWITM 01240C GOTO START 01250C*------------------------------------------------------------------- ÐÐ01260C NEWITM TAG 01270C MOVEL'Q005PO' PROG 8 01280C GOTO END 01290C*------------------------------------------------------------------- 01300C GOODBY TAG 01310C MOVEL'GOODBY' PROG 01320C GOTO END 01330C*------------------------------------------------------------------- 01340C MENU TAG 01350C EXSR SR96 GET CRTFILE 01360C Z-ADD1 W 01370C BLK6 LOKUPLNK,W 54 01380C 54 MOVELLNK,W PROG 8 01390C 54 MOVE BLK6 LNK,W 01400C N54 MOVEL'CONTU' PROG 01410C EXSR SR97 UPD CRTFILE 01420C EXSR SR98 >>>>>>>>>> 01430C*------------------------------------------------------------------- 01440C END TAG 01450C EXSR SR96 GET CRTFILE 01460C EXSR SR97 UPD CRTFILE 01470C EXSR SR98 >>>>>>>>>> 01480C*----------------------------------------------------------------- 01490C ENDJOB TAG 01500C MOVEL'ENDJOB' PROG ÐÐ01510C EXSR SR98 >>>>>>>>>> 01520C********************************************************************* 01530CSR SR68 BEGSR 01540CSR EXITFZLF LINE FEED 01550CSR 1 ADD COUNT COUNT 01560CSR ENDSR 01570C********************************************************************** 01580CSR SR69 BEGSR 01590CSR 50 EXITFZPUTXY 01600CSR RLABL RPGLIN 01610CSR RLABL RPGCOL 01620CSRN50 EXITFZMOVXY MOVE CURSOR 01630CSR RLABL RPGLIN 01640CSR RLABL RPGCOL 01650CSR ENDSR 01660C********************************************************************* 01670CSR SR72 BEGSR 01680C* PUT DATA TO TERMINAL 01690CSR SETON 72 01700CSR EXCPT PUT DATA 01710CSR SETOF 72 01720CSR SETON 40 01730CSR 1 ADD COUNT COUNT 01740CSR ENDSR 01750C*********************************************************************** ÐÐ01760CSR SR73 BEGSR 01770C* PUT ERROR MESSAGE TO TERMINAL 01780CSR SETON 73 01790CSR EXCPT PUT MSG 01800CSR SETOF 73 01810CSR 1 ADD COUNT COUNT 01820CSR ENDSR 01830C******************************************************************* 01840CSR SR74 BEGSR 01850C* PROMPT/READ 01860CSR EXSR SR89 GET MSG 01870CSR EXSR SR73 PUT PROMPT 01880CSR EXSR SR75 READ 01890CSR ENDSR 01900C****************************************************************** 01910CSR SR75 BEGSR 01920C* READ FROM TERMINAL 01930CSR SETOF 779096 01940CSR SETOF 939288 01950CSR MOVE BIT,6 BUFLGT 2 READ BUFFER LGTH 01960CSR MOVE BLK10 W10A 10 BUFFER 01970CSR EXITFZR10 READ FROM TERMINAL 01980CSR RLABL W10A READ BUFFER 01990CSR MOVEAW10A A10 INPUT DATA ARRAY 02000CSR MOVE BLK10 W10A INIT INPUT ARRAY ÐÐ02010CSR Z-ADD1 W 30 02020CSR '\' LOKUPA10,W 90 FLAG ESC 02030CSRN90 GOTO T75B NOT ESC 02040CSR 1 ADD W W 02050CSR W COMP 10 54 02060CSR 54 GOTO T75A BAD ESC 02070CSR A10,W COMP 'G' 98 GOODBY 02080CSR A10,W COMP 'E' 94 MENU 02090CSR A10,W COMP 'N' 93 NEW ITEM 02100CSR A10,W COMP 'B' 92 SKIP BKWRD 02110CSR A10,W COMP 'S' 88 SPACE FILL 02120CSR 88 SETOF 90 02130CSR 88 SETON 77 02140CSR 98 02150COR 94 02160COR 93 02170COR 92 02180COR 88 GOTO END75 GOOD ESC 02190C*------------------------------------------------------------------ 02200CSR T75A TAG 02210C* FLAG BAD ESC INPUT 02220CSR Z-ADD318 M 96 FLAG ERROR 02230CSR GOTO END75 02240C*-------------------------------------------------------------------- 02250CSR T75B TAG ÐÐ02260C* MOVE DATA 02270CSR Z-ADD1 W 02280CSR ' ' LOKUPA10,W 77 02290CSR 77 MOVEAA10,W W10A INPUT DATA 02300CSR END75 ENDSR 02310C******************************************************************** 02320CSR SR76 BEGSR 02330C* PUT SCHEDULE LINE. 02340CSR SETON 76 02350CSR EXCPT PUT SCHED 02360CSR SETOF 76 02370CSR 1 ADD COUNT COUNT 02380CSR ENDSR 02390C******************************************************************** 02400CSR SR81 BEGSR 02410C* END PAGE MSG. 02420CSR SETON 81 02430CSR EXCPT PUT END PAGE 02440CSR SETOF 81 02450CSR ENDSR 02460C********************************************************************** 02470CSR SR89 BEGSR 02480C* GET MESSAGE MASTER 02490CSR M CHAINMGFILE 54 02500CSR 54 MOVE BLK35 MGTEXT ÐÐ02510CSR 54 MOVELM MGTEXT 02520CSR 54 MOVE '????????'MGTEXT 02530CSR ENDSR 02540C******************************************************************** 02550CSR SR96 BEGSR 02560CSR # CHAINCRTFILE H9 GET CRTFILE 02570CSR H9 GOTO ENDJOB 02580CSR ENDSR 02590C******************************************************************** 02600CSR SR97 BEGSR 02610C* UPDATE CRTFILE. EXIT PROGRAM. 02620CSR TIME CRTIME 02630CSR MOVELUDATE CRDATE 02640CSR SETON 97 02650CSR EXCPT UPDATE CRTFILE 02660CSR SETOF 97 02670CSR ENDSR 02680C******************************************************************** 02690CSR SR98 BEGSR 02700CSR EXITFCHAIN >>>>>>>>>> 02710CSR RLABL PROG 02720CSR ENDSR 02730C******************************************************************** 02740CSR SR101 BEGSR 02750C* 1-TIME INITIALIZE ÐÐ02760CSR MOVE BIT,1 NUL 02770CSR MOVE '-' DIV 02780CSR MOVE ' ' BLK10 10 02790C* GET PORT # AND CRTFILE 02800CSR Z-ADD0 W2N 20 02810CSR MOVE ' ' W2A 2 02820CSR EXITFZGMINX GET PORT # 02830CSR RLABL W2A 02840CSR MOVE W2A # 20 PORT NO. 02850CSR # COMP 0 54 02860CSRN54 Z-ADD25 # DEFAULT 02870CSR EXSR SR96 GET CRTFILE 02880CSR MOVE CALL LNK 02881CSR MOVE 'Q005PO 'PROG 02890CSR PAR,# COMP '1' 50 02900CSR TST,# COMP 'S' 56 02910CSR 56 MOVE 'SHUTDOWN'PROG 02920CSR EXSR SR97 UPDATE CRTFILE 02930CSR 56 EXSR SR98 >>>>>>>>>>>>>>>>> 02931CSR MOVE ' 'PROG 02940C* DEFINE WORK FIELDS,ETC. 02950CSR MOVE ' ' BLK6 6 02960CSR MOVE ' ' RPGLIN 4 02970CSR MOVE ' ' RPGCOL 4 02980CSR MOVE ' ' BLK35 35 ÐÐ02990CSR MOVE ' ' BLK8 8 03000CSR Z-ADD0 ZERO7 70 03010CSR ENDSR 03020C******************************************************************** 03030CSR SR102 BEGSR 03040C* REQUEST VENDOR NUMBER. 03050CSR Z-ADD515 M 50 03060CSR EXSR SR74 PROMPT/READ 03070CSR 90 GOTO END102 ESC 03080CSR 77 EXSR SR202 R.J. 03090CSR 77 MOVE W10A TVEND 50 VENDOR # 03100CSR END102 ENDSR 03110C******************************************************************** 03120CSR SR103 BEGSR 03130C* REQUEST PO #. 03140CSR Z-ADD514 M 03150CSR EXSR SR74 PROMPT/READ 03160CSR 90 GOTO END103 ESC 03170CSR 77 EXSR SR211 BUILD PO # 03180CSR END103 ENDSR 03190C******************************************************************** 03200CSR SR104 BEGSR 03210C* DISPLAY PO'S FOR SELECTED VENDOR. 03220CSR MOVELTVEND W11A 11 03230CSR MOVE TPO W11A ÐÐ03240CSR W11A SETLLPOVKEY 03250CSR MOVE BLK35 LASTPV 11 03260C*------------------------------------------------------------------- 03270CSR T104A TAG 03280CSR SETOF 54 03290CSR READ POVKEY 54 03300CSR 54 GOTO END104 03310CSR PVKEY COMP LASTPV 54 03320CSRN54 GOTO END104 03330CSR MOVELLASTPV W5N 50 03340CSR MOVE PVKEY LASTPV 03350CSR PVVEND COMP W5N 54 03360CSR 54 GOTO T104B 03370CSR PVVEND CHAINVMMAST 54 03380CSR 54 MOVE BLK35 VMNAME 03390CSRN54 SETON 69 03400CSR SETON 71 03410CSR EXCPT PUT DIVIDER 03420CSR SETOF 7169 03430CSR Z-ADDPVVEND TVEND 03440CSR 1 ADD COUNT COUNT 03450C*---------------------------------------------------------------- 03460CSR T104B TAG 03470CSR PVSTAT COMP 'D' 54 03480CSR 54 GOTO T104A ÐÐ03490CSR MOVELPVPO W9A 9 03500CSR MOVE ' ' W9A 03510CSR W9A SETLLPOITEM 03520CSR MOVE BLK35 LASTPO 9 03530C*------------------------------------------------------------------- 03540CSR T104C TAG 03550CSR SETOF 54 40 03560CSR READ POITEM 54 03570CSR 54 GOTO T104L 03580CSR PIPO COMP PVPO 54 03590CSRN54 GOTO T104L 03600CSR PISTAT COMP 'D' 54 03610CSR 54 GOTO T104C 03620CSR PIWOP COMP ' 12100' 70 03630CSRN70 PIWOP COMP ' 14100' 70 03640CSRN70 PIWOP COMP ' 14600' 70 03650CSR EXSR SR252 ALLOC RCPTS TO SCHD 03660CSR Z-ADD1 S 30 03670CSR ZERO7 LOKUPPIQ,S 54 03680CSRN54 Z-ADD1 S 03690CSRN54 ZERO7 LOKUPRCD,S 54 03700CSRN54 Z-ADD1 S 03710CSR EXSR SR72 DISPLAY ITEM 03720CSRN50 COUNT COMP 27 54 54 03730CSR 50 COUNT COMP 22 54 54 ÐÐ03740CSRN54 GOTO T104E 03750CSR EXSR SR81 END PAGE 03760CSR EXSR SR75 READ 03770CSRN90 EXSR SR105 NEW PAGE 03780CSR 90 GOTO END104 03790CSR 77 GOTO END104 NEW VENDOR 03800C*------------------------------------------------------------------- 03810CSR T104E TAG 03820CSR ZERO7 LOKUPPIQ,S 54 03830CSRN54 Z-ADD1 S 03840CSRN54 ZERO7 LOKUPRCD,S 54 03850CSRN54 GOTO T104C 03860CSR EXSR SR76 DISPLAY SCHED 03870CSRN50 COUNT COMP 26 54 54 03880CSR 50 COUNT COMP 21 54 54 03890CSRN54 GOTO T104E 03900CSR EXSR SR81 END PAGE 03910CSR EXSR SR75 READ 03920CSR 90 GOTO END104 03930CSR EXSR SR105 NEW PAGE 03940CSR 77 GOTO END104 NEW VENDOR 03950CSR GOTO T104E 03960C*------------------------------------------------------------------- 03970CSR T104L TAG 03980CSR EXSR SR68 LF ÐÐ03990CSR GOTO T104A 04000CSR END104 ENDSR 04010C******************************************************************** 04020CSR SR105 BEGSR 04030C* CLEAR PAGE 04040CSRN50 EXITFZCPAGE CLEAR PAGE 04050CSR 50 EXITFZISTAT 04060CSR 50 EXITFZESCH 04070CSR Z-ADD4 COUNT 30 04080CSR SETON 75 04090CSR EXCPT PUT HDG 04100CSR SETOF 75 04110CSR ENDSR 04120C******************************************************************** 04130CSR SR202 BEGSR 04140C* RIGHT ADJUST. 04150CSR Z-ADD10 W2N 04160CSR EXIT SUBRAJ R.J. 04170CSR RLABL W2N 04180CSR RLABL W10A 04190CSR ENDSR 04200C****************************************************************** 04210CSR SR211 BEGSR 04220C* BUILD PO #. 04230CSR MOVEAW10A A10 ÐÐ04240CSR A10,1 COMP '0' 54 54 04250CSRN54 GOTO T211A NON-NUMERIC INPUT 04260CSR MOVEAA10,1 W5A 5 04270CSR Z-ADD5 W2N 04280CSR EXIT SUBRAJ R.J. 04290CSR RLABL W2N 04300CSR RLABL W5A 04310CSR MOVEL' ' TPO 6 04320CSR MOVE W5A TPO 04330CSR GOTO END211 04340C*------------------------------------------------------------------- 04350CSR T211A TAG 04360CSR MOVELW10A TPO 04370CSR MOVE TPO W5A 04380CSR Z-ADD5 W2N 04390CSR EXIT SUBRAJ R.J. 04400CSR RLABL W2N 04410CSR RLABL W5A 04420CSR MOVE W5A TPO 04430CSR END211 ENDSR 04440C******************************************************************** 04450CSR SR252 BEGSR 04460C* APPLY RECPTS TO SCHEDULE. 04470CSR Z-ADD0 RCD 04480CSR Z-ADD1 A 30 ÐÐ04490CSR Z-ADDPIQRCD SAVQTY 70 04500C*------------------------------------------------------------------- 04510CSR T252A TAG 04520CSR ZERO7 LOKUPPIQ,A 54 04530CSRN54 GOTO T252C 04540CSR Z-ADDPIQ,A W7N 70 04550CSR SETOF 57 04560CSR SAVQTY COMP W7N 545556 04570CSR 54 Z-ADDW7N RCD,A 04580CSR 54 SAVQTY SUB W7N SAVQTY 57 04590CSR 54 Z-ADD0 W7N 04600CSR 55 Z-ADDSAVQTY RCD,A 04610CSR 55 W7N SUB SAVQTY W7N 04620CSR 55 Z-ADD0 SAVQTY 57 04630CSR 56 Z-ADDSAVQTY RCD,A 04640CSR 56 Z-ADD0 SAVQTY 57 04650CSR 56 Z-ADD0 W7N 04660CSR 57 1 ADD A A 04670CSR 57 A COMP 26 54 04680CSR 57 GOTO T252A 04690CSR GOTO END252 04700C*------------------------------------------------------------------- 04710CSR T252C TAG 04720CSR Z-ADD1 A 04730CSR ZERO7 LOKUPPIQ,A 54 ÐÐ04740CSR 54 Z-ADDSAVQTY RCD,A 04750CSR END252 ENDSR 04760O******************************************************************** 04770OTERM132 E 73 04780O NUL 132 04790O MGTEXT 35 04800O BIT,8 36 04810O*------------------------------------------------------------------- 04820O E 75 04830O NUL 132 04840O BIT,28 1 04850O N50 8 '8091001' 04860O 50 10 '[001 ]001' 04870O 50 BIT,28 6 04880O*------------------------------------------------------------------- 04890O E 75 04900O BIT,28 1 04910O 2 'K' 04920O 21 'DYNAIR' 04930O 35 'VENDOR' 04940O 114 'DUE' 04950O 125 'SCHED' 04960O 132 'QTY' 04970O*------------------------------------------------------------------- 04980O E 75 ÐÐ04990O 4 'P.O.' 05000O 10 'ITEM' 05010O 20 'PART-NO.' 05020O 34 'PART-NO.' 05030O 54 'DESCRIPTION' 05040O 93 'PRICE' 05050O 102 'ACCOUNT' 05060O 113 'DATE' 05070O 122 'QTY' 05080O 132 'RECVD' 05090O*------------------------------------------------------------------- 05100O E 75 05110O DIV 132 05120O*------------------------------------------------------------------- 05130O E 72 05140O PIPO 6 05150O 7 '-' 05160O PIITEM 10 05170O 70 PIPN 23 ' - - ' 05180O 70 PIVPN 39 05190O 70 PIDESC 72 05200O N70 PINDES 81 05210O PI$PRC2 93 05220O PILOT 94 05230O PIWOP 100 ÐÐ05240O 101 '-' 05250O PIWOD 104 05260O PID,S YB 113 05270O PIQ,S 2B 122 05280O RCD,S KB 132 05290O*------------------------------------------------------------------- 05300O E 76 05310O PID,S YB 113 05320O PIQ,S 2B 122 05330O RCD,S KB 132 05340O*------------------------------------------------------------------- 05350O E 81 05360O NUL 132 05370O 14 'END OF PAGE...' 05380O 38 'ENTER VENDOR # OR RETURN' 05390O 54 ', OR ESC CODE: ' 05400O BIT,8 55 05410O*--------------------------------------------------------------- 05420O E 71 05430O DIV 132 05440O*----------------------------------------------------------------- 05450O E 69 05460O PVVENDZ 5 05470O VMNAME 45 05480O******************************************************************** ÐÐ05490OCRTFILE E 97 05500O PROG 26 05510O CRTIME 33 05520O CRDATE 37 05530O LNK 79 05540O********************************************************************* ** NUL ARRAY 05550 05560** A10 ARRAY 05570 05580** RCD ARRAY 05590 05600** DIV 05610 05620** LNK ARRAY 05630 05640/* 05650_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼*õ ¼$X020WO P999999120282(èÈÐ00010H Q020WO00020F* DISPLAY WORK ORDER OPERATIONS. (X020WO) 00030F* REVISED 11/24/82 10:15 AM. 00040F* 00050FBITPAR IP F 90 DISK 00060FWOOPER ID F 64L20AI 1 DISK 00070FWOMAST ID F 228L 9AI 1 DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FCRTFILE UC F 256R DISK 00110FRMMAST IC F 140R15AI 1 DISK 00120FWCMAST IC F 960R 8AI 1 DISK 00130FCALENDARIC F 22R 7AI 1 DISK 00140FTERM132 O F 132 5 00150E******************************************************************** 00160E NULL 1 132 1 00170E RCD 1 26 7 0 00180E REL 1 26 7 0A 00190E OPN 1 26 7 0A 00200E NR 1 26 7 0A 00210E A16 16 16 1 A 00220E LNK 1 7 6 A 00230E CALL 7 6 00240E BIT 33 1 00250E PAR 25 1 ÐÐ00260E TST 25 1 00270E MHR 12 7 3A 00280E MDP 12 3 0 00290E PLT 8 3 0 00300I**************************************************************** 00310IBITPAR BT 00320I 1 33 BIT 00330I 34 58 PAR 00340I 59 83 TST 00350I******************************************************************** 00360ICRTFILE CR 00370I 28 330CRTIME 00380I 34 370CRDATE 00390I 38 79 CALL 00400I******************************************************************** 00410IWOOPER WP 00420I* WORK ORDER OPER RECORD. 00430I* WORK ORDER # 9A 00440I 1 9 WPWO 00450I* PRIME 6A 00460I 1 6 WPWOP 00470I* DASH 3N 00480I 7 90WPWOD 00490I* OPER SEQ # 3N 00500I 10 120WPSEQ ÐÐ00510I 1 12 WPKEY 00520I* DEPT # 5N 00530I 13 170WPDEPT 00540I* WORK CENTER 3N 00550I 18 200WPWC 00560I* STD HRS - PER UNIT 00570I* SET-UP 9.3P 00580I P 25 293WPSSUH 00590I* RUN 9.3P 00600I P 30 343WPSRUN 00610I* ACTUAL HRS - TOTALS 00620I* SET-UP 7.1P 00630I P 35 381WPASUH 00640I* RUN 7.1P 00650I P 39 421WPARUN 00660I* QTY MOVED-IN 7P 00670I P 43 460WPQIN 00680I* QTY MOVED-OUT 7P 00690I P 47 500WPQOUT 00700I* WPDUE 6N 00710I 51 560WPDUE 00720I* DATE LAST TRAN 6N 00730I 58 630WPDLT 00740I* RECORD STATUS 1A 00750I 64 64 WPSTAT ÐÐ00760I******************************************************************** 00770IWOMAST WO 00780I* WORK ORDER MASTER. 00790I* WORK ORDER NO. 00800I 1 9 WOWO 00810I* PRIME 6A 00820I 1 1 PREFIX 00830I 1 6 WOWOP 00840I* DASH 3N 00850I 7 90WOWOD 00860I* PART NO. 10N 00870I 10 190WOPN 00880I* TOP ASSY PN 10N 00890I 20 290WOTAPN 00900I* RUN NO. 3N 00910I 30 320WORUN 00920I* PROD LINE 4N 00930I 33 360WOPL 00940I* SCHED QTY 7P 00950I P 37 400WOQTYS 00960I* RELEASED QTY 7P 00970I P 41 440WOQTYR 00980I* COMPLETED QTY 7P 00990I P 45 480WOQTYC 01000I* START DATE 6N (YMD) ÐÐ01010I 49 540WOSTRT 01020I* DUE DATE 6N (YMD) 01030I 55 600WODUE 01040I* DATE ENTERED 6N (YMD) 01050I 61 660WODATE 01060I* DATE LAST REL 6N (YMD) 01070I 67 720WODLTR 01080I* DATE LAST COMPLETION 6N (YMD) 01090I 73 780WODLTC 01100I* DATE LAST LABOR 6N (YMD) 01110I 79 840WODLTL 01120I* DATE LAST MATL CHARGE 6N (YMD) 01130I 85 900WODLTM 01140I* LABOR HRS CHARGED 7.1P 01150I P 91 941WOLABH 01160I* LABOR $ CHARGED 9.3P 01170I P 95 993WOLAB$ 01180I* MATL $ CHARGED 9.3P 01190I P 100 1043WOMAT$ 01200I* QTY TRSF 7P 01210I P 105 1080WOQTYT 01220I* AMOUNT TRANSFERRED 9.3P 01230I P 109 1133WO$T 01240I* REMARKS 35A 01250I 114 148 WODESC ÐÐ01260I* MODEL 12A 01270I 149 160 WOMODL 01280I* FAB CODE 2A 01290I 161 162 WOFAB 01300I* ALTERNATE BILL OF MATERIAL PART NO. 10N 01310I 163 1720WOABM 01320I* ALTERNATE ROUTING PART NO. 10N 01330I 173 1820WOARPN 01340I* DATE CLOSED 6N (YMD) 01350I 183 1880WOCLOS 01360I* RECORD STATUS 1A 01370I 228 228 WOSTAT 01380I******************************************************************** 01390IRMMAST RM 01400I 30 69 RMDESC 01410I********************************************************************** 01420IWCMAST WC 01430I* WORK CENTER MASTER 01440I* WORK CENTER NAME 29A 01450I 9 37 WCDESC 01460I 960 960 WCSTAT 01470I******************************************************************** 01480IMGFILE MG 01490I 1 35 MGTEXT 01500I**************************************************************** ÐÐ01510ICALENDARCA 20 1 CC 01520I* CALENDAR DATE RECORD 01530I* CALENDAR DATE 6N (Y,M,D) 01540I 2 70CACAL 01550I* MFG DAY 4N 01560I 14 170CAMDAY 01570I* SEQUENTIAL WEEK # 3N 01580I 18 200CAWKNO 01590I* DAY OF WEEK 2N 01600I 21 220CADOW 01610I*-------------------------------------------------------------------- 01620I CB 21 1 CM 01630I* MFG DATE RECORD 01640I* MFG DATE 4N 01650I 4 70CAMDAY 01660I* CALDENDAR DATE 6N 01670I 8 130CACAL 01680I* SEQ WEEK # 3N 01690I 18 200CAWKNO 01700I* DAY OF WEEK 2N 01710I 21 220CADOW 01720I******************************************************************** 01730IPMMST2 PM 01740I 1 100PMPN 01750I* 15 180PMPL ÐÐ01760I 19 30 PMMODL 01770I 31 59 PMDESC 01780I* 70 71 PMECHG 01790I 94 95 PMSC 01800I* LEAD TIMES 3P X 8 01810I P 113 128 PLT 01820I* ON HAND BAL 01830I* P 311 3140PMOHB 01840I* REL REQS 7P 01850I* P 323 3260PMRLB 01860I* PURCH REQ BAL 7P 01870I* P 339 3420PMPRB 01880I* PO BAL 01890I* P 343 3460PMPOB 01900I* PLAN REQMT BAL 01910I* P 319 3220PMALB 01920I* FAB CODE 2A 01930I 487 488 PMFAB 01940I* MFG HRS 12 X 7.3P 01950I P 543 590 MHR 01960I* MFG DEPTS 12 X 3P 01970I P 591 614 MDP 01980I 674 674 PMSTAT 01990C******************************************************************** 02000C* 1-TIME INITIALIZE. ÐÐ02010C EXSR SR101 INIT. 02020C Z-ADD0 ZERO7 70 STUPIDITY 02030C MOVE ' ' BLK6 6 STUPIDITY 02040C EXSR SR70 NEW PAGE 02050C*------------------------------------------------------------------- 02060C START TAG 02070C* REQUEST WORK-ORDER. 02080C EXITFQCLF LF 02090C Z-ADD516 M 50 02100C EXSR SR74 PROMPT/READ 02110C 92 GOTO START ESC BKWD 02120C 93 GOTO START 02130C*------------------------------------------------------------------- 02140C TAG20 TAG 02150C EXSR SR210 BUILD WORK ORDER # 02160C TWO SETLLWOMAST 02170C*------------------------------------------------------------------- 02180C TAG25 TAG 02190C EXSR SR80 GET WORK ORDER MAST 02200C 69 GOTO START NOT ON FILE ERROR 02210C MOVE BLK35 W20A 20 02220C MOVELWOWO W20A 02230C W20A SETLLWOOPER SET LOW LIMIT 02240C Z-ADD0 LSTSEQ 30 02250C*--------------------------------------------------------------- ÐÐ02260C TAG40 TAG 02270C SETOF 54 02280C READ WOOPER 54GET OPER RECORD 02290C 54 GOTO TAG70 END THIS WO 02300C WPWO COMP WOWO 54 02310C 54 WPSEQ COMP LSTSEQ 54 02320C N54 GOTO TAG70 END THIS WO 02330C Z-ADDWPSEQ LSTSEQ 30 02340C WPSTAT COMP 'D' 54 02350C 54 GOTO TAG40 DELETED 02360C BALREL MULT WPSSUH WOSSUH 51H STD SET-UP HRS 02370C BALREL MULT WPSRUN WOSRUN 51H STD RUN HRS 02380C MOVE BLK40 W15A 15 02390C WOARPN COMP 0 54 02400C N54 MOVELWOPN W15A 02410C 54 MOVE WOARPN W15A 02420C MOVE WPSEQ W15A 02430C W15A CHAINRMMAST 54 02440C 54 MOVE BLK40 DESC 40 02450C N54 MOVE RMDESC DESC 40 02460C N54 GOTO TAG50 02470C MOVELWPDEPT W8A 8 02480C MOVE WPWC W8A 02490C W8A CHAINWCMAST 54 02500C 54 GOTO TAG50 BAD WORK CENTER KEY ÐÐ02510C DESC COMP BLK40 54 02520C N54 MOVELWCDESC DESC 02530C*------------------------------------------------------------------- 02540C TAG50 TAG 02550C 1 ADD COUNT COUNT 02560C N50 COUNT COMP 118 54 54 02570C 50 COUNT COMP 113 54 54 02580C N54 GOTO TAG60 02590C Z-ADD320 M 02600C EXSR SR74 END PAGE MSG 02610C 93 GOTO START 02620C 77 GOTO TAG20 02630C EXSR SR40 HEADING 02640C EXSR SR42 OPER HDG 02650C*------------------------------------------------------------------- 02660C TAG60 TAG 02670C WPWC COMP 0 55 02680C SETON 72 02690C EXCPT DISPLAY 02700C SETOF 72 02710C GOTO TAG40 02720C*------------------------------------------------------------------- 02730C TAG70 TAG 02740C SETON 70 02750C EXCPT ÐÐ02760C SETOF 70 02770C 1 ADD COUNT COUNT 02780C GOTO START 02790C*------------------------------------------------------------------- 02800C MENU TAG 02810C EXSR SR96 GET CRTFILE 02820C Z-ADD1 W 02830C BLK6 LOKUPLNK,W 54 02840C 54 MOVELLNK,W PROG 8 02850C 54 MOVE BLK6 LNK,W 02860C N54 MOVEL'CONTU 'PROG 02870C EXSR SR97 UPD CRTFILE 02880C EXSR SR98 >>>>>>>>>> 02890C*------------------------------------------------------------------- 02900C GOODBY TAG 02910C MOVEL'GOODBY' PROG 8 02920C*------------------------------------------------------------------- 02930C END TAG 02940C EXSR SR96 GET CRTFILE 02950C EXSR SR97 UPD CRTFILE 02960C EXSR SR98 >>>>>>>>>> 02970C*------------------------------------------------------------------- 02980C ENDJOB TAG 02990C MOVEL'ENDJOB 'PROG 03000C EXSR SR98 >>>>>>>>>> ÐÐ03010C******************************************************************* 03020CSR SR40 BEGSR 03030C* PUT WORK ORDER MASTER DATA 03040CSR EXSR SR70 CLEAR PAGE 03050CSR WOQTYS SUB WOQTYC QTY 70 54 03060CSRN54 Z-ADD0 QTY 03070CSR WOQTYR SUB WOQTYC BALREL 70 54 03080CSRN54 Z-ADD0 BALREL 03090CSR WOWOD COMP 0 55 03100CSR SETON 40 03110CSR EXCPT WO DATA 03120CSR SETOF 40 03130CSR Z-ADD96 COUNT 30 CRT LINE NO. 03140CSR ENDSR 03150C******************************************************************* 03160CSR SR42 BEGSR 03170C* PUT OPER LINE HEADINGS 03180CSR SETON 42 03190CSR EXCPT PUT OPER HEADINGS 03200CSR SETOF 42 03210CSR 6 ADD COUNT COUNT 03220CSR ENDSR 03230C******************************************************************** 03240CSR SR69 BEGSR 03250C* MOVE CURSOR. ÐÐ03260CSRN50 EXITFZMOVXY MOVE CURSOR 03270CSR RLABL RPGLIN 03280CSR RLABL RPGCOL 03290CSR 50 EXITFZPUTXY MOVE CURSOR 03300CSR RLABL RPGLIN 03310CSR RLABL RPGCOL 03320CSR ENDSR 03330C******************************************************************** 03340CSR SR70 BEGSR 03350C* CLEAR NEW PAGE. 03360CSRN50 EXITFZCPAGE CLEAR PAGE 03370CSR 50 EXITFZISTAT CLEAR STATUS LINE 03380CSR 50 EXITFZESCH CLEAR SCREEN 03390CSRN50 MOVEL'091' RPGLIN 4 03400CSRN50 MOVEL'001' RPGCOL 4 03410CSRN50 EXSR SR69 CURSOR TOP PAGE 03420CSR Z-ADD91 COUNT 30 03430CSR ENDSR 03440C******************************************************************** 03450CSR SR73 BEGSR 03460C* PUT MESSAGE TO CRT 03470CSR M CHAINMGFILE 54 03480CSR 54 MOVE BLK35 MGTEXT 03490CSR 54 MOVEL'??????' MGTEXT 03500CSR SETON 73 ÐÐ03510CSR EXCPT PUT MSG 03520CSR SETOF 73 03530CSR ENDSR 03540C********************************************************************* 03550CSR SR74 BEGSR 03560C* PROMPT/READ. 03570CSR EXSR SR73 PROMPT 03580CSR EXSR SR75 READ CRT 03590CSR ENDSR 03600C******************************************************************** 03610CSR SR75 BEGSR 03620C* READ CRT. 03630CSR SETOF 779092 03640CSR SETOF 939498 03650CSR MOVE BLK35 W16A 16 03660CSR EXITFZR16 03670CSR RLABL W16A 03680CSR MOVEAW16A A16 03690CSR MOVE BLK16 W16A 03700CSR Z-ADD1 W 30 03710CSR '\' LOKUPA16,W 90 03720CSRN90 GOTO T75B 03730CSR 1 ADD W W 03740CSR W COMP 14 54 03750CSR 54 GOTO T75A ÐÐ03760CSR A16,W COMP 'B' 92 03770CSR A16,W COMP 'N' 93 03780CSR A16,W COMP 'E' 94 03790CSRN94 A16,W COMP 'D' 94 03800CSR A16,W COMP 'G' 98 03810CSR 92 GOTO END75 03820CSR 93 GOTO END75 03830CSR 94 GOTO MENU 03840CSR 98 GOTO GOODBY 03850C*------------------------------------------------------------------- 03860CSR T75A TAG 03870CSR Z-ADDM W5N 50 03880CSR Z-ADD318 M 03890CSR EXSR SR73 03900CSR Z-ADDW5N M 03910CSR GOTO SR75 03920C*------------------------------------------------------------------- 03930CSR T75B TAG 03940CSR Z-ADD1 W 03950CSR ' ' LOKUPA16,W 77 03960CSR 77 MOVEAA16,W W16A 03970CSR END75 ENDSR 03980C***************************************************************** 03990CSR SR80 BEGSR 04000C* GET WORK ORDER MASTER ÐÐ04010CSR SETOF 69 04020CSR READ WOMAST 69 GET WORK ORDER MAST 04030CSR 69 GOTO END80 04040CSR WOSTAT COMP 'D' 69 04050CSR 69 GOTO SR80 04060CSR EXSR SR81 GET PART MAST 04070CSR 60 GOTO SR80 NOT ON FILE 04080CSR EXSR SR40 PUT WORK ORDER DATA 04090CSR EXSR SR42 PUT OPER HEADINGS 04100CSR END80 ENDSR 04110C******************************************************************** 04120CSR SR81 BEGSR 04130C* GET PART MAST. 04140CSR MOVELWOPN W12A 12 04150CSR MOVE ' ' W12A 04160CSR W12A CHAINPMMST2 60 04170CSRN60 PMSTAT COMP 'D' 60 04180CSR Z-ADD0 TOTLT 30 04190CSRN60 XFOOTPLT TOTLT 04200CSR ENDSR 04210C******************************************************************** 04220CSR SR96 BEGSR 04230CSR # CHAINCRTFILE H9 GET CRTFILE 04240CSR H9 GOTO ENDJOB 04250CSR ENDSR ÐÐ04260C******************************************************************** 04270CSR SR97 BEGSR 04280C* UPDATE CRTFILE. EXIT PROGRAM. 04290CSR TIME CRTIME 04300CSR MOVELUDATE CRDATE 04310CSR SETON 97 04320CSR EXCPT UPD CRTFILE 04330CSR SETOF 97 04340CSR ENDSR 04350C******************************************************************** 04360CSR SR98 BEGSR 04370CSR EXSR SR70 CLEAR SCREEN 04380CSR EXITFCHAIN >>>>>>>>>> 04390CSR RLABL PROG 04400CSR ENDSR 04410C******************************************************************** 04420CSR SR101 BEGSR 04430C* 1-TIME INIT. 04440CSR MOVE BIT,1 NULL 04450CSR MOVE ' ' BLK35 35 04460CSR MOVE ' ' BLK16 16 04470CSR Z-ADD0 ZERO9 90 04480CSR MOVE ' ' BLK40 40 04490CSR MOVE ' ' W2A 2 04500CSR EXITFZGMINX ÐÐ04510CSR RLABL W2A 04520CSR MOVE W2A # 20 04530CSR # COMP 0 54 04540CSRN54 Z-ADD25 # 04550CSR EXSR SR96 GET CRTFILE 04560CSR MOVE CALL LNK 04570CSR MOVE 'Q020WO 'PROG 04580CSR 54 MOVE 'SHUTDOWN'PROG 04590CSR PAR,# COMP '1' 50 04600CSR TST,# COMP 'S' 54 04610CSR 54 MOVE 'SHUTDOWN'PROG 04620CSR EXSR SR97 UPD CRTFILE 04630CSR 54 EXSR SR98 >>>>>>>>>> 04640CSR MOVE ' 'PROG 04650CSR MOVE ' ' BLK8 8 04660CSR ENDSR 04670C******************************************************************** 04680CSR SR102 BEGSR 04690C* RIGHT ADJUST. 04700CSR Z-ADD14 W2N 20 04710CSR EXIT SUBRAJ 04720CSR RLABL W2N 04730CSR RLABL W16A 04740CSR ENDSR 04750C****************************************************************** ÐÐ04760CSR SR210 BEGSR 04770C* BUILD WORK ORDER. 04780CSR MOVE ' ' A16 04790CSR MOVEAW16A A16 04800CSR Z-ADD1 W 04810CSR '-' LOKUPA16,W 54 04820CSRN54 Z-ADD7 W 04830CSR MOVEAA16,W W4A 4 04840CSR 54 MOVEL' ' W4A 04850CSR Z-ADD4 W2N 04860CSR EXIT SUBRAJ R.J. 04870CSR RLABL W2N 04880CSR RLABL W4A 04890CSR MOVE W4A TWOD 30 WORK ORDER DASH 04900CSR MOVEABLK16 A16,W 04910CSR A16,1 COMP '0' 54 54 04920CSR 54 MOVEAA16,1 W5A 5 04930CSR 54 MOVEL' ' TWOP 6 04940CSRN54 MOVEAA16 TWOP 04950CSRN54 MOVE TWOP W5A 04960CSR Z-ADD5 W2N 04970CSR EXIT SUBRAJ R.J. 04980CSR RLABL W2N 04990CSR RLABL W5A 05000CSR MOVE W5A TWOP WORK ORDER DASH ÐÐ05010CSR MOVELTWOP TWO 9 05020CSR MOVE TWOD TWO 05030CSR MOVELTWOP PREFIX 1 05040CSR ENDSR 05050O******************************************************************** 05060OTERM132 E 40 05070O BIT,28 1 05080O N50 8 '8091001' 05090O N50 BIT,1 9 05100O N50 BIT,1 10 05110O 50 10 '[001 ]001' 05120O 50 BIT,28 6 05130O UDATE 18 ' - - ' 05140O 58 'D I S P L A Y' 05150O 68 'W O R K' 05160O 80 'O R D E R' 05170O 102 'O P E R A T I O N S' 05180O*------------------------------------------------------------------- 05190O E 40 05200O 1 ' ' 05210O*------------------------------------------------------------------- 05220O E 40 05230O 4 'WORK' 05240O 20 'ASSY' 05250O 87 'FAB' ÐÐ05260O 99 'ORDER' 05270O 108 'START' 05280O 116 'DUE' 05290O*------------------------------------------------------------------- 05300O E 40 05310O 5 'ORDER' 05320O 22 'PART-NO.' 05330O 39 'DESCRIPTION' 05340O 75 'MODEL' 05350O 88 'CODE' 05360O 99 'QUANTITY' 05370O 107 'DATE' 05380O 117 'DATE' 05390O*------------------------------------------------------------------- 05400O E 40 05410O 1 ' ' 05420O*------------------------------------------------------------------- 05430O E 40 05440O WOWOP 6 05450O 55 7 '-' 05460O 55 WOWOD 10 05470O WOPN 26 ' - - ' 05480O PMDESC 68 05490O PMMODL 82 05500O PMFAB 86 ÐÐ05510O QTY 2 99 05520O WOSTRT 109 ' - - ' 05530O WODUE 119 ' - - ' 05540O*------------------------------------------------------------------- 05550O E 42 05560O 1 ' ' 05570O*------------------------------------------------------------------- 05580O E 42 05590O 72 'O P E R A T I O N S' 05600O*------------------------------------------------------------------- 05610O E 42 05620O 1 ' ' 05630O*----------------------------------------------------------- 05640O E 42 05650O 4 'OPER' 05660O 21 'DUE' 05670O 87 '<---STD HRS--->' 05680O 105 '<-ACTUAL HRS->' 05690O 113 'QTY' 05700O 121 'QTY' 05710O 129 'DATE' 05720O*------------------------------------------------------------------- 05730O E 42 05740O 4 'SEQ#' 05750O 12 'DEPT #' ÐÐ05760O 22 'DATE' 05770O 41 'DESCRIPTION' 05780O 79 'SET-UP' 05790O 87 'RUN' 05800O 97 'SET-UP' 05810O 105 'RUN' 05820O 113 'IN' 05830O 121 'OUT' 05840O 132 'LAST-TRAN' 05850O*------------------------------------------------------------------- 05860O E 42 05870O 1 ' ' 05880O*-------------------------------------------------------------------- 05890O E 72 05900O WPDLT 132 ' - - ' 05910O WPQOUTK 121 05920O WPQIN K 113 05930O WPARUN2 105 05940O WPASUH2 97 05950O WOSRUN2 87 05960O WOSSUH2 79 05970O DESC 70 05980O WPDUE 24 ' - - ' 05990O 55 WPWC Z 14 06000O 55 11 '-' ÐÐ06010O WPDEPTZ 10 06020O WPSEQ Z 3 06030O*------------------------------------------------------------------- 06040O E 73 06050O NULL 132 06060O MGTEXT 35 06070O 37 ' ' 06080O*------------------------------------------------------------------- 06090O E 70 06100O 9 '---END---' 06110O******************************************************************** 06120OCRTFILE E 97 06130O PROG 26 06140O CRTIME 33 06150O CRDATE 37 06160O LNK 79 ** NULL ARRAY 006170 006180** RCD ARRAY 06190 06200** REL ARRAY 06210 06220** OPN ARRAY 06230 06240** NR ARRAY 06250ÐÐ 06260** A16 ARRAY 006270 006280** LNK ARRAY 006290 06300/* 06310_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(È, ÈTX103DP P120282120282(èÈÐ00010H Q103DP00020F* COPY TEXT FILES, D1 TO D2. (X103DP) 00030F* REVISED 8/20/80 3:15 PM. 00040FSTATUSPTIP F 136 DISK 00050FZNEWVTOCO F 80 DISK 00060E NAM 1 700 8 00070ISTATUSPTSP 02 00080I* FILE NAME 8A 00090I 6 13 FILNAM 00100I* OWNER 8A 00110I 15 22 FILOWN 00120I* FILE DATE 6N 00130I 25 300FILDAT 00140I* FILE TYPE 1A (D,R,S,B) 00150I 34 34 FILTYP 00160I* RECORD LGTH 4N 00170I 40 430FILLGT 00180I* KEY LENGTH 2N 00190I 47 480KEYLGT 00200I* KEY POSITION 4N 00210I 50 530KEYPOS 00220I* STARTING SECTOR 5A (HEX) 00230I 85 89 SECTOR 00240I 85 89 SEC 00250I* RECORD COUNT 6N ÐÐ00260I 92 970RECCNT 00270I* EXPIRATION DATE 6N 00280I 99 1040EXPDAT 00290I* MAX RECORDS 6N 00300I 109 1140OLDMAX 00310I* FILE STATUS 6A 00320I 116 121 FILSTS 00330I* SECTOR ALIGNED 1A (Y,N) 00340I 124 124 SECALG 00350C******************************************************************** 00360C MOVE ' ' BLK8 8 00370C FILOWN COMP BLK8 54 00380C 54 GOTO TAG10 00390C MOVELFILNAM W1A 1 00400C W1A COMP ' ' 54 00410C 54 W1A COMP 'X' 54 00420C N54 GOTO TAG10 00430C GOTO END 00440C*---------------------------------------------------------------- 00450C TAG10 TAG 00460C SETOF 02 00470C*----------------------------------------------------------------- 00480C END TAG 00490C 02 EXSR SR81 00500CLR EXSR SR82 ÐÐ00510C******************************************************************** 00520CSR SR81 BEGSR 00530C* PUT INSTR STMT. 00540CSR FILNAM LOKUPNAM 54 00550CSR 54 GOTO END81 00560CSR 1 ADD N N 30 00570CSR MOVE FILNAM NAM,N 00580CSR FILTYP COMP 'R' 84 00590CSR SETON 81 00600CSR EXCPT 00610CSR SETOF 81 00620CSR END81 ENDSR 00630C******************************************************************** 00640CSR SR82 BEGSR 00650C* PUT EXIT STMT. 00660CSR SETON 82 00670CSR EXCPT 00680CSR SETOF 82 00690CSR ENDSR 00700O******************************************************************** 00710OZNEWVTOCE 81 00720O 2 '*' 00730O FILNAM 12 00740O E 81 00750O 14 'INPUT=ZNEWVTOC' ÐÐ00760O E 81 00770O 4 'UTIL' 00780O E 81 00790O 19 'DEFINE,FN= ,' 00800O FILNAM 18 00810O 22 'NR=' 00820O OLDMAX 28 00830O 32 ',TY=' 00840O FILTYP 33 00850O 44 ',VL=D2 ,' 00860O 47 'LR=' 00870O FILLGT 51 00880O 84 55 ',K1=' 00890O 84 KEYLGT 57 00900O 84 61 ',P1=' 00910O 84 KEYPOS 65 00920O E 81 00930O 8 'COPY,FN=' 00940O FILNAM 16 00950O 22 ',VL=D1' 00960O 34 ',F2= ' 00970O FILNAM 34 00980O 44 ',V2=D2 ' 00990O E 81 01000O 2 'EX' ÐÐ01010O*------------------------------------------------------------------- 01020O E 82 01030O 14 'INPUT=TERMINAL' ** NAM ARRAY 001040 001050/* 001060_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(î,o î9X103PM P120282120282(èÈÐ00010H Q103PM00020F* COMPUTE ADDED LABOR # FROM ROUTING - CONVERSION PROG. (X103PM) 00030F* REVISED 8-13-81 5:10 PM. DG-REL006 OK. 00040FRMMAST IP F 140 15AI 1 DISK 00050FLABRATE IT F 80 EDISK 00060FPMMST2 UC F 674R12AI 1 DISK 00070F**************************************************************** 00080E LABRATE TABDEP 1 11 5 0 TABRAT 9 LABOR RATES 00090E PM$ 7 9 3 MFG $ FILE 00100E PA$ 7 9 3 STD $ FILE 00110I******************************************************************** 00120IRMMAST RM 01 140NCD 00130I* ROUTING MASTER. 00140I* KEY AREA. 00150I* PART # 10N 00160I 1 100RMPN L1 00170I* OPER SEQ # 3N 00180I 13 150RMSEQ 00190I* OPER GROUP CODE 2A 00200I 16 17 RMGRUP 00210I* OVERLAP % .2N 00220I 18 192RMOVLP 00230I* OPER CODE 5A 00240I 20 24 RMOPER 00250I* OPER DEPT. ÐÐ00260I* DEPT # 5P 00270I P 25 270RMDEPT 00280I* WORK CENTER 3P 00290I P 28 290RMWC 00300I* OPER DESCRIPTION 40A 00310I 30 69 RMDESC 00320I* LABOR STDS. 00330I* ACCOUNTING STD. 00340I* DATE ADOPTED 7P 00350I P 70 730RMADAT 00360I* SET-UP 9.3P 00370I P 74 783RMASU 00380I* RUN 9.3P 00390I P 79 833RMARUN 00400I* MIN CHARGE 7.2P 00410I P 84 872RMAMIN 00420I* STD LOT SIZE 7P 00430I P 88 910RMALOT 00440I* REVISED STDS. 00450I* DATE LAST REVISED 7P 00460I P 92 950RMRDAT 00470I* SET-UP 9.3P 00480I P 96 1003RMRSU 00490I* RUN 9.3P 00500I P 101 1053RMRRUN ÐÐ00510I* MIN. CHARGE 7.2P 00520I P 106 1092RMRMIN 00530I* STD LOT SIZE 7P 00540I P 110 1130RMRLOT 00550I* METHOD ESTAB 1A 00560I 114 114 RMMETH 00570I* JOB SKILL 5A 00580I 115 119 RMSKIL 00590I* PERFORM FACTOR. 00600I* ACTUAL 5.2P 00610I P 120 1222RMPER 00620I* ASSIGNED 5.2P 00630I P 123 1252RMPER2 00640I* NUMB LOTS RUN 5P 00650I P 126 1280RMLRUN 00660I* NUMB UNITS RUN 5P 00670I P 129 1310RMQRUN 00680I* FILLER 132 139 FFFFFF 00690I* RECORD STATUS 1A 00700I 140 140 RMSTAT 00710I GG 03 00720I******************************************************************** 00730IPMMST2 PM 02 674NCD 00740I* PART MASTER RECORD 00750I* KEY AREA ÐÐ00760I* PART NO. 10N 00770I 1 100PMPN 00780I* CURRENT COSTS 9.3P X 7 00790I* ADDED COSTS 00800I* 1 = LABOR 00810I* 2 = LABOR BURDEN 00820I* 3 = MATERIAL 00830I* 4 = MATERIAL BURDEN 00840I* 5 = OUTSIDE PROC 00850I* CUM COSTS 00860I* 6 = LABOR 00870I* 7 = MATERIAL 00880I* P 245 279 PM$ 00890I* CURRENT LABOR HOURS. 00900I* CUR COST DATE 6N 00910I 294 2990PMCDAT 00920I* RECORD STATUS 1A 00930I* D = DELETED 00940I 674 674 PMSTAT 00950I PG 04 00960C******************************************************************** 00970C* INITIALIZE 00980C N79 EXSR SR101 1 TIME ONLY 00990C L1 EXSR SR102 NEW PART # 01000C 01 GOTO TAG10 ROUTING ÐÐ01010C GOTO END DELETED RECORD 01020C*--------------------------------------------------------------- 01030C TAG10 TAG 01040C* PROCESS ROUTING 01050C Z-ADD0 USETUP 93 01060C Z-ADD0 ULABOR 93 01070C Z-ADD0 UBURD 93 01080C RMDEPT LOKUPTABDEP TABRAT 54 GET LABOR RATES 01090C N54 GOTO END BAD DEPT 01100C Z-ADDRMRDAT W6N 60 01110C MOVELW6N W2N 20 01120C W2N COMP 70 54 01130C 54 GOTO TAG12 01140C MOVELW6N W4N 40 01150C MOVE W6N W2N 01160C MOVELW2N W6N 01170C MOVE W4N W6N 01180C Z-ADDW6N RMRDAT 01190C*------------------------------------------------------------------- 01200C TAG12 TAG 01210C W6N COMP LSTDAT 54 01220C 54 Z-ADDW6N LSTDAT 60 01230C RMRLOT COMP 0 54 01240C RMRSU COMP 0 55 01250C N55 GOTO TAG15 NO SETUP HRS ÐÐ01260C N54 Z-ADD1 RMRLOT LOT SIZE DEFAULT 01270C RMRSU DIV RMRLOT USETUP 93H UNIT SETUP HRS 01280C*------------------------------------------------------------ 01290C TAG15 TAG 01300C USETUP ADD RMRRUN ULABOR 93 LABOR HOURS 01310C MOVE TABRAT PCT 42 BURDEN RATE 01320C MOVELTABRAT RATE 52 LABOR RATE 01330C RMRRUN ADD RUNHRS RUNHRS 93 PN RUN HRS 01340C USETUP ADD SETUPH SETUPH 93 PN SETUP HRS 01350C RATE MULT ULABOR ULAB$ 93H ADD LAB $ 01360C PCT MULT ULAB$ UBUR$ 93H ADD LAB BURD $ 01370C ULAB$ ADD LABOR LABOR 93 TOT LAB $ 01380C UBUR$ ADD BURDEN BURDEN 93 TOT BURD $ 01390C*------------------------------------------------------------------- 01400C END TAG 01410CL1 MOVELRMPN W12A 12 01420CL1 W12A CHAINPMMST2 54 01430CL1 54 GOTO ENDL1 01440C* PROCESS PART MASTER 01450CL1 MOVELPMCDAT W2N 20 01460CL1 W2N COMP 70 54 01470CL1N54 MOVELPMCDAT W4N 40 01480CL1N54 MOVE PMCDAT W2N 01490CL1N54 MOVELW2N PMCDAT 01500CL1N54 MOVE W4N PMCDAT ÐÐ01510CL1 PMCDAT COMP LSTDAT 54 01520CL1 54 Z-ADDLSTDAT PMCDAT 01530CL1 Z-ADDLABOR PM$,1 01540CL1 Z-ADDBURDEN PM$,2 01550CL1 SETON 80 01560CL1 EXCPT 01570CL1 SETOF 80 01580C*----------------------------------------------------------- 01590CL1 ENDL1 TAG 01600C******************************************************************** 01610CSR SR101 BEGSR 01620C* 1-TIME INIT. 01630CSR SETON 79 01640CSR ENDSR 01650C******************************************************************** 01660CSR SR102 BEGSR 01670C* NEW PART # INIT. 01680CSR Z-ADD0 LABOR 01690CSR Z-ADD0 BURDEN 01700CSR Z-ADD0 RUNHRS 01710CSR Z-ADD0 SETUPH 01720CSR Z-ADD0 LSTDAT 01730CSR ENDSR 01740O******************************************************************** 01750OPMMST2 E 80 ÐÐ01760O PM$ 279P 01770O SETUPH 324P 01780O RUNHRS 329P 01790O PMCDAT 335 /* 001800_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ô-© ôÑX103SF P120282120282(èÈÐ00010H Q103SF00020F* GENERATE CALLING SEQUENCE FOR SF BATCH UPDATE. (X103SF) 00030F* REVISED 12/22/80 3:45 PM. 00040FBITTAB IP F 33 DISK 00050FSFTRAN UC F 128R DISK 00060FSFCONT UC F 16R DISK 00070FSFPROG O F 11R11AI 1 DISK 00080FSFCALL O F 6 DISK 00090E******************************************************************** 00100E A4 4 4 1 00110E DUN 1 100 1 00120E COD 1 100 4 PRG 6 00130I******************************************************************** 00140IBITTAB BT 00150I******************************************************************** 00160ISFTRAN ST 00170I* RECORD CODE 2A 00180I 124 125 STREC 00190I* TRAN CODE 1A 00200I* A = ADD 00210I* C = CHANGE 00220I* D = DELETE ITEM 00230I* # = DELETE ORDER 00240I* E = EXPLODE RQMTS 00250I* V = RET TO VENDOR ÐÐ00260I* S = SCRAP 00270I* P = PLUS 00280I* M = MINUS 00290I* T = STOCK RECEIPT 00300I* F = STOCK ISSUE 00310I* W = EXPLODE WO OPER 00320I* R = RELEASE 00330I 126 126 STTRAN 00340I* PHASE CODE 1A 00350I 127 127 STPHAS 00360I* RECORD STATUS 1A 00370I 128 128 STSTAT 00380I******************************************************************** 00390ISFCONT SC 00400I 1 50SCRRN 00410C******************************************************************** 00420C* INITIALIZE 1-TIME. 00430C EXSR SR101 INIT. 00440C*------------------------------------------------------------------- 00450C START TAG 00460C RRN CHAINSFTRAN 54 00470C 54 GOTO END END OF FILE 00480C STSTAT COMP 'D' 54 ALREADY PROC 00490C 54 1 ADD RRN RRN 50 00500C 54 GOTO START GET NEXT ÐÐ00510C Z-ADD1 P 30 00520C MOVEASTREC A4 00530C MOVE STTRAN A4,3 00540C MOVE STPHAS A4,4 00550C MOVEAA4 W4A 4 00560C W4A LOKUPCOD,P 54 00570C N54 GOTO START 00580C SETON 80 00590C EXCPT UPD SFTRAN 00600C SETOF 80 UPD SFPROG 00610C 1 ADD RRN RRN 00620C MOVE 'X' DUN,P 00630C GOTO START 00640C*------------------------------------------------------------------- 00650C END TAG 00660C SETON 81 00670C EXCPT UPD SFCONT 00680C SETOF 81 00690C Z-ADD1 P 00700C*------------------------------------------------------------------- 00710C END2 TAG 00720C 'X' LOKUPDUN,P 54 00730C N54 GOTO ENDALL 00740C SETON 82 00750C EXCPT UPD SFCALL ÐÐ00760C SETOF 82 00770C MOVE ' ' DUN,P 00780C GOTO END2 00790C*------------------------------------------------------------------- 00800C ENDALL TAG 00810C******************************************************************** 00820CSR SR101 BEGSR 00830C* 1-TIME INIT. 00840CSR Z-ADD1 W5N 50 00850CSR W5N CHAINSFCONT H9 00860CSR 1 ADD SCRRN RRN 50 00870CSR ENDSR 00880O******************************************************************** 00890OSFTRAN E 80 00900O 128 'L' 00910O******************************************************************** 00920OSFPROG E 80 00930O PRG,P 6 00940O RRN 11 00950O******************************************************************** 00960OSFCONT E 81 00970O RRN 5 00980O******************************************************************** 00990OSFCALL E 82 01000O PRG,P 6 ÐÐ** A4 ARRAY 001010 001020** DUN ARRAY 001030 001040** COD/PRG 00105010A1Q105SF RPO-ADD PHASE-1 RAND UPDATE 00106010A2Q106SF RPO-ADD PHASE-2 SEQ UPDATE 001070/* 001080_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2)h 2X903CD P042083042083(èÈÐ00010H Q903CD00020F* CREATE 1ST COMMODITY CODE FROM P/N 2-6 00030F* REVISED 05/20/83 11:00 A.M. 00040F* 00050FPMMST2 UP F 674 12AI 1 DISK 00060F******************************************************************* 00070IPMMST2 PM 10 674NCD 94 CP 00080I* PARTS MASTER 00090I* P/N DIGITS 2-3 (TEMP COMM. CODE) 4N 00100I 2 3 PN2 00110I 2 4 PN3 00120I* COMMODITY CODE 9P 00130I P 60 640PMCC 00140I ZZ 11 00150I******************************************************************* 00160C N10 GOTO END 00170C Z-ADD0 W9N 90 00180C PN3 COMP '313' 58SEP IC'S 00190C 58 MOVELPN3 W9N 00200C N58 MOVELPN2 W9N 00210C Z-ADDW9N PMCC 90 00220C*--------------------------------------------------------------------- 00230C END TAG 00240C******************************************************************* 00250OPMMST2 D 10 ÐÐ00260O PMCC 64P 00270O******************************************************************** /* 00280_‚ ÐÐ_‚_‚0O PMCC 64P 00270O******************************************************************** /* 00280_‚ ÐÈ(È0 ÈTX104PM P120282120282(èÈÐ00010H Q104PM00020F* UPDATE PMMST2 LEAD TIME FROM LTFILE. (X104PM) 00030F* REVISED 8-28-80 11:30 AM. 00040FLTFILE IP F 34 10AI 1 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060F**************************************************************** 00070E LT 9 3 0A 00080E PLT 8 3 0 00090I****************************************************************** 00100IPMMST2 PM 00110I P 113 128 PLT 00120I******************************************************************** 00130ILTFILE LT 00140I* LEAD TIME FILE. 00150I* PART # 10N 00160I 1 100LTPN 00170I* LEAD TIMES 3P X 9 00180I* 1 = PRODUCTION CONTROL,SCHEDULE 00190I* 2 = PURCHASING,PLACE P.O. 00200I* 3 = VENDOR,SUPPLY PART OR SERVICE 00210I* 4 = STOCK,PULL PARTS 00220I* 5 = SHOP,FAB & ASSEMBLE 00230I* 6 = INSPECTION & TEST 00240I* 7 = STOCK,RECEIVE PARTS 00250I* 8 = SAFETY LEAD TIME ÐÐ00260I* 9 = 00270I P 11 28 LT 00280I* COMMODITY CODE 9P 00290I P 29 330LTCC 00300I 34 34 LTSTAT 00310C******************************************************************** 00320C Z-ADD0 ZERO3 30 00330C LTSTAT COMP 'D' 54 00340C 54 GOTO END 00350C ZERO3 LOKUPLT 54 00360C N54 GOTO END 00370C MOVELLTPN W12A 12 00380C W12A CHAINPMMST2 54 00390C 54 GOTO END 00400C Z-ADDLT PLT 00410C SETON 80 00420C EXCPT 00430C SETOF 80 00440C*------------------------------------------------------------------- 00450C END TAG 00460O******************************************************************** 00470OPMMST2 E 80 00480O PLT 128P /* 000490_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(20r 2XRF P999999120282(èÈÐ SUBROUTINE ZRF (REQBUF,FILNAM,MUL,ADD,IERROR) 00010* REDUCE SIZE OF CLOSED SEQUENTIAL FILE. 00020*--------------------------------------------------------------------------00030* REQBUF = FILE MGR REQUEST BUFFER 00040* FILNAM = FILE NAME 00050* MUL = RRN MULTIPLIER - NEW NUMB OF RECORDS 00060* ADD = RRN ADDON - NEW NUMB OF RECORDS 00070* IERROR = ISTAT AS HEX-CHAR 00080*--------------------------------------------------------------------------00090 INTEGER REQBUF (24) 00100 INTEGER FILNEM (4) 00110 INTEGER MUL (3) 00120 INTEGER ADD (3) 00130 INTEGER IERROR (2) 00140 INTEGER IDATA (14) 00150 INTEGER IVOL (4) 00160 DO 10 I = 1, 2 00170 10 IERROR (I) = $2020 00180 DO 20 I = 1, 24 00190 20 REQBUF (I) = $0000 00200 DO 30 I = 1, 14 00210 30 IDATA (I) = $2020 00220 DO 40 I = 1, 4 00230 40 IDATA (I) = FILNAM (I) 00240 IDATA (13) = 0 00250ÐÐ IDATA (14) = 0 00260 CALL DECHEX (MUL,IDATA(13)) 00270 CALL DECHEX (ADD,IDATA(14)) 00280* 00290 CALL REDUCE (REQBUF,IDATA,ISTAT) 00300 IF (ISTAT.NE.0) CALL HEXASC (ISTAT,IERROR) 00310* 00320 RETURN 00330 END 00340_‚ ÐÐ_‚_‚ IDATA (14) = 0 00260 CALL DECHEX (MUL,IDATA(13)) 00270 CALL DECHEX (ADD,IDATA(14)) 00280* 00290 CALL REDUCE (REQBUF,IDATA,ISTAT) 00300 IF (ISTAT.NE.0) CALL HEXASC (ISTAT,IERROR) 00310* 00320 RETURN 00330 END 00340_‚ ÐÈ(ú0ˆ úiX104TX P120282120282(èÈÐ00010H Q104TX00020F* PRINT TABLE CONTENTS. (X104TX) 00030F* REVISED 9/11/80 12:55 PM. 00040FBITHEX IP F 256 DISK 00050FCONTINDXIS F 160 DISK 00060E******************************************************************** 00070E AR 1 148 1 A OUTPUT ARRAY 00080E RA 1 148 1 A WORK ARRAY 00090E REC 132 1 A TXFILE 00100E BIT 256 1 00110I*************************************************************** 00120IBITHEX BT 00130I 1 256 BIT 00140I******************************************************************** 00150ICONTINDXCC 01 1 CC 00160I 2 60PAGE 00170I 7 138 REC 00180I 139 139 SPACE 00190I 140 144 LINE 00200I 145 152 NAME 00210I GG 02 00220C******************************************************************** 00230C* INITIALIZE. 00240C N79 EXSR SR101 INITIALIZE 00250C N01 GOTO END ÐÐ00260C N40 EXSR SR68 TOP FORM 00270C SETON 40 00280C ' ' LOKUPREC 54 00290C N54 GOTO END 00300C SPACE COMP '0' 54 00310C 54 EXSR SR67 LF 00320C MOVE REC AR 00330C REC,1 COMP BIT,95 54 00340C 54 EXSR SR106 CENTER TEXT 00350C EXSR SR308 BOLD PRINT 00360C EXSR SR309 UNDERLINE 00370C EXSR SR70 PRINT 00380C*------------------------------------------------------------------- 00390C END TAG 00400C******************************************************************** 00410CSR SR67 BEGSR 00420C* LINE SPACE. 00430CSR U1 EXITFQCLF LINE FEED ONLY 00440CSR 1 ADD LINENO LINENO 00450CSR ENDSR 00460C******************************************************************** 00470CSR SR68 BEGSR 00480C* TOP OF FORM. 00490CSR U1 EXITFZTFORM 00500CSR Z-ADD1 LINENO 50 ÐÐ00510CSR 1 ADD EGAP EGAP 40 PAGE # 00520CSR Z-ADD5 W2N 20 00530CSR MOVE '2' W1A 1 00540CSR MOVE BLK6 PAGNO 5 00550CSR EXIT SUBRED EDIT PAGE # 00560CSR RLABL EGAP SOURCE 00570CSR RLABL W1A EDIT CODE 00580CSR RLABL PAGNO RESULT 00590CSR RLABL W2N END POS 00600CSR SETON 40 00610CSR ENDSR 00620C******************************************************************** 00630CSR SR69 BEGSR 00640C* PUT TO DIABLO. 00650CSRN40 EXSR SR68 TOP FORM 00660CSR U1 EXITFZD148 PUT DIABLO 00670CSR RLABL W148A 00680CSR ENDSR 00690C******************************************************************** 00700CSR SR70 BEGSR 00710C* PUT DIABLO. 00720CSR EXSR SR401 FIND NON-BLK 00730CSRN54 GOTO END70 00740CSR EXSR SR67 LF 00750C* DO HEADING LINE 1 FIX ÐÐ00760CSRN40 EXSR SR68 TOP FORM 00770CSR EXSR SR311 SUBSCRIPTS 00780CSR EXSR SR308 BOLD PRINT 00790CSR EXSR SR309 UNDERLINE 00800CSR EXSR SR71 INSRT PAGE 00810CSR U2 MOVEANAME AR,135 00820CSR U2 MOVEALINE AR,143 00830CSR MOVEAAR W148A 148 00840CSR EXSR SR69 PUT DIABLO 00850CSR MOVE ' ' AR 00860CSR END70 ENDSR 00870C******************************************************************** 00880CSR SR71 BEGSR 00890C* INSERT PAGE # IN OUTPUT ARRAY. 00900CSR MOVE ' ' W5A 5 00910CSR Z-ADD5 W2N 20 00920CSR MOVE 'Z' W1A 00930CSR EXIT SUBRED 00940CSR RLABL PAGE 00950CSR RLABL W1A 00960CSR RLABL W5A 00970CSR RLABL W2N 00980CSR MOVEAW5A AR,100 00990CSR Z-ADD101 X 30 01000C*------------------------------------------------------------------- ÐÐ01010CSR T71A TAG 01020CSR X SUB 1 X 54 01030CSRN54 GOTO END71 01040CSR AR,X COMP ' ' 54 01050CSR 54 GOTO END71 01060CSR X SUB 1 X 54 01070CSRN54 GOTO END71 01080CSR AR,X COMP ' ' 54 01090CSR 54 GOTO END71 01100CSR MOVE '.' AR,X 01110CSR GOTO T71A 01120CSR END71 ENDSR 01130C**************************************************************** 01140CSR SR101 BEGSR 01150C* 1-TIME INIT 01160CSR SETON 79 01170CSR MOVE ' ' BLK6 6 01180CSR MOVE UDATE TODAY 6 01190CSR ENDSR 01200C******************************************************************** 01210CSR SR106 BEGSR 01220C* CENTER LINE IN TEXT. 01230CSR AR,1 COMP BIT,95 54 01240CSRN54 GOTO END106 01250CSR MOVE ' ' AR,1 ÐÐ01260CSR Z-ADD1 Z 30 01270CSR ' ' LOKUPAR,Z 54 01280CSRN54 GOTO END106 NO DATA 01290CSR Z-ADDZ SAVEZ 30 01300CSR Z-ADD149 Z 01310C*------------------------------------------------------------------- 01320CSR T106A TAG 01330CSR Z SUB 1 Z 54 01340CSRN54 GOTO END106 01350CSR AR,Z COMP ' ' 54 01360CSRN54 GOTO T106A 01370CSR Z SUB SAVEZ W3N 30 01380CSR 1 ADD W3N W3N 01390CSR 148 SUB W3N W3N 01400CSR W3N DIV 2 W3N H 01410CSR MOVE ' ' RA 01420CSR Z-ADDW3N Z 54 01430CSRN54 Z-ADD1 Z 01440CSR Z-ADDSAVEZ Y 30 01450CSR MOVEAAR,Y RA,Z 01460CSR MOVEARA AR 01470CSR END106 ENDSR 01480C******************************************************************** 01490CSR SR308 BEGSR 01500C* BOLD PRINT. ÐÐ01510CSR Z-ADD1 L 30 01520CSR MOVE ' ' RA 01530CSR SETOF 55 01540C*------------------------------------------------------------------- 01550CSR T308A TAG 01560CSR BIT,97 LOKUPAR,L 54 01570CSRN54 GOTO T308M 01580CSR MOVE ' ' AR,L 01590C*------------------------------------------------------------------- 01600CSR T308B TAG 01610CSR 1 ADD L L 01620CSR L COMP 148 54 01630CSR 54 GOTO T308M 01640CSR AR,L COMP BIT,97 54 01650CSR 54 MOVE ' ' AR,L 01660CSR 54 GOTO T308A 01670CSR MOVE AR,L RA,L 01680CSR SETON 55 01690CSR GOTO T308B 01700C*------------------------------------------------------------------- 01710CSR T308M TAG 01720CSRN55 GOTO END308 01730CSR MOVEARA W148A 01740CSR EXSR SR69 BOLD PRINT 01750CSR END308 ENDSR ÐÐ01760C******************************************************************** 01770CSR SR309 BEGSR 01780C* UNDERLINE. 01790CSR Z-ADD1 L 01800CSR MOVE ' ' RA 01810CSR SETOF 55 01820C*------------------------------------------------------------------- 01830CSR T309A TAG 01840CSR BIT,96 LOKUPAR,L 54 01850CSRN54 GOTO T309M 01860CSR MOVE BIT,97 AR,L SETUP BOLD PRINT 01870C*------------------------------------------------------------------- 01880CSR T309B TAG 01890CSR 1 ADD L L 01900CSR L COMP 148 54 01910CSR 54 GOTO T309M 01920CSR AR,L COMP BIT,96 54 01930CSR 54 MOVE BIT,97 AR,L SETUP BOLD PRINT 01940CSR 54 1 ADD L L 01950CSR 54 L COMP 148 56 01960CSR 54 56 GOTO T309M 01970CSR 54 GOTO T309A 01980CSR MOVE BIT,96 RA,L 01990CSR SETON 55 02000CSR GOTO T309B ÐÐ02010C*------------------------------------------------------------------- 02020CSR T309M TAG 02030CSRN55 GOTO END309 02040CSR MOVEARA W148A 02050CSR EXSR SR69 02060CSR EXSR SR308 BOLD PRINT 02070CSR END309 ENDSR 02080C******************************************************************** 02090CSR SR311 BEGSR 02100C* PRINT SUBSCRIPT. 02110CSR MOVE ' ' RA 02120CSR SETOF 55 02130CSR Z-ADD1 L 02140C*------------------------------------------------------------------- 02150CSR T311A TAG 02160CSR BIT,127 LOKUPAR,L 54 02170CSRN54 GOTO T311B 02180CSR SETON 55 02190CSR MOVE ' ' AR,L 02200CSR L SUB 1 L 54 02210CSRN54 GOTO T311A 02220CSR MOVE AR,L RA,L 02230CSR MOVE ' ' AR,L 02240CSR GOTO T311A 02250C*------------------------------------------------------------------- ÐÐ02260CSR T311B TAG 02270CSRN55 GOTO END311 02280CSR EXITFZNHLF NEG HALF LF 02290CSR MOVEARA W148A 02300CSR EXSR SR69 PRINT SUBSCRIPT 02310CSR EXITFZPHLF POS HALF LF 02320CSR END311 ENDSR 02330C******************************************************************** 02340CSR SR401 BEGSR 02350C* CHECK FOR NON-BLK LINE 02360CSR ' ' LOKUPAR 54 NON-BLK 02370CSRN54 BIT,97 LOKUPAR 54 BOLD 02380CSRN54 BIT,96 LOKUPAR 54 UNDERLINE 02390CSR ENDSR ** AR ARRAY 002400 002410** RA ARRAY 002420 002430 002440/* 002450_‚ ÐÐ_‚_‚0CSR T311B TAG 02270CSRN55 GOTO END311 02280CSR EXITFZNHLF NEG HALF LF 02290CSR MOVEARA W148A 02300CSR EXSR SR69 PRINT SUBSCRIPT 02310CSR EXITFZPHLF POS HALF LF 02320CSR END311 ENDSR 02330C******************************************************************** 02340CSR SR401 BEGSR 02350C* CHECK FOR NON-BLK LINE 02360CSR ' ' LOKUPAR 54 NON-BLK 02370CSRN54 BIT,97 LOKUPAR 54 BOLD 02380CSRN54 BIT,96 LOKUPAR 54 UNDERLINE 02390CSR ENDSR ** AR ARRAY 002400 002410** RA ARRAY 002420 002430 002440/* 002450_‚ ÐÈ(Š0ò ŠX104BM P999999120282(èÈÐ00010H Q104BM00020F* DISPLAY SINGLE LEVEL WHERE-USED. (X104BM) 00030F* REVISED 8/11/82 10:00 AM. 00040F* MENU: QQBM02 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST IC F 86R20AI 1 DISK 00090FBMWU ID F 21L20AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FTERM132 O F 132 5 00120E******************************************************************** 00130E A12 1 12 1 A INPUT ARRAY. 00140E NUL 1 132 1 NULL CHAR. 00150E TABIC 1 9 2 TABICN 15 ISSUE CODES. 00160E TABSC 1 6 2 ATABSCN 12 SOURCE CODES. 00170E TABPC 1 7 1 TABPCN 20 PROV CODES. 00180E LNK 1 7 6 A 00190E BIT 33 1 BITTAB FILE. 00200E PAR 25 1 00210E TST 25 1 00220E CALL 7 6 00230I******************************************************************** 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************** 00290ICRTFILE CR 00300I 28 330CRTIME 00310I 34 370CRDATE 00320I 38 79 CALL 00330I******************************************************************** 00340IPMMST2 PM 00350I* PART MASTER RECORD (XPMMST) 00360I* KEY AREA 00370I* PART NO. 12A 00380I 1 12 PMPN 00390I* PROD LINE 4N 00400I 15 180PMPL 00410I* MODEL NAME 12A 00420I 19 30 PMMODL 00430I* DESCRIPTION 29A 00440I 31 59 PMDESC 00450I* COMMODITY CODE 9P 00460I P 60 640PMCC 00470I* ENG CHANGE STATUS. 00480I* CUR CHG LEVEL 2A 00490I 70 71 PMECHG 00500I* CUR CHG DATE 6N ÐÐ00510I 72 770PMDCHG 00520I* LAST ECN NO. 5A 00530I 65 69 PMECN 00540I* DRAWING INFO 00550I* DWG SIZE 1A 00560I 82 82 PMSIZ 00570I* DWG CLASS 1A 00580I* D = DYNAIR DWG 00590I* V = VENDOR DWG 00600I 83 83 PMDCLS 00610I* STANDARD CODE 1A 00620I 84 84 PMSTDC 00630I* DWG REL CODE 1A 00640I* E = ENG ONLY 00650I* M = REL TO MFG 00660I* P = PROTOTYPE 00670I 78 78 PMDREL 00680I* UNIT MEAS 2A 00690I* EA = EACH OC = OUNCE 00700I* ST = SET TC = TROY OUNCE 00710I* IN = INCH LB = POUND 00720I* FT = FEET PT = PINT 00730I* YD = YARD QT = QUART 00740I* SI = SQ.INCH GL = GALLON 00750I* SF = SQ.FEET DR = DRUM ÐÐ00760I* SY = SQ.YARD 00770I 85 86 PMUM 00780I* SOURCE CODE 2A 00790I* MA = MFG ASSY 00800I* MP = MFG PART 00810I* PA = PURCH ASSY 00820I* PP = PURCH PART 00830I* RD = REF DOC ONLY 00840I* RS = RAW STOCK 00850I 94 95 PMSC 00860I* PROVISIONING CODE 1A 00870I* A = FORECAST,NO VALUE ADDED 00880I* B = FORECAST,VALUE ADDED 00890I* C = BUILD TO ORDER (B) 00900I* D = BUILD TO ORDER (NOT B) 00910I* E = CUSTOM 00920I* Y = OBSOLETE,REPAIRABLE 00930I* Z = OBSOLETE,NOT REPAIRABLE 00940I 96 96 PMPROV 00950I* ISSUE CODE 2A 00960I* PT = PULL TIME 00970I* OR = ON REQUEST 00980I* BI = BULK ISSUE 00990I* AR = AS REQUIRED 01000I* VS = VENDOR SUPPLIED ÐÐ01010I* SD = SHIPPING DOCUMENT 01020I* TD = TRAV DOCUMENT 01030I* RD = REF DOC ONLY 01040I* RA = REF ASSY 01050I 97 98 PMISSU 01060I* DELIVER TO DEPT 5P 01070I P 99 1010PMDEL 01080I* RESPONSIBILITY CODES 01090I* ENGR CODE 2A 01100I 102 103 PMEGR 01110I* PLANNER CODE 2A 01120I 104 105 PMPLNR 01130I* BUYER CODE 2A 01140I 106 107 PMBUYR 01150I* SALESMAN CODE 2A 01160I 108 109 PMSLSM 01170I* INVENTORY ACCOUNT 5P 01180I P 110 1120PMACNT 01190I* LOW LEVEL CODE 2N 01200I 430 4310PMLL 01210I* RECORD STATUS 1A 01220I* D = DELETED 01230I 674 674 PMSTAT 01240I******************************************************************** 01250IBMMAST BM ÐÐ01260I* BILL OF MATERIAL RECORD (XBMREC) 01270I* KEY AREA 01280I* ASSY PART NO. 10N 01290I 1 100BMAPN 01300I* COMPONENT PART NO. 10N 01310I 11 200BMCPN 01320I* ITEM NO. 3N 01330I 25 270BMITNO 01340I* QTY PER ASSY 7P 01350I P 28 310BMQTY 01360I* SCRAP ALLOW .2N 01370I 34 352BMSCRP 01380I* ISSUE CODE 2A 01390I* PT = PULL TIME 01400I* OR = ON REQUEST 01410I* BI = BULK ISSUE 01420I* AR = AS REQUIRED 01430I* RA = REF ASSY 01440I* TD = TRAV DOC 01450I* SD = SHIP DOC 01460I* RD = REF DOC 01470I* VS = VENDOR SUPPLIED 01480I 36 37 BMISSU 01490I* EFFECTIVITY. 01500I* BEGIN CHANGE LEVEL 2A ÐÐ01510I 38 39 BMBCHG 01520I* ENDING CHANGE LEVEL 2A 01530I 40 41 BMECHG 01540I* BEGIN ECN # 5A 01550I 42 46 BMBECN 01560I* ENDING ECN # 5A 01570I 47 51 BMEECN 01580I* DISPOSITION CODE 1A 01590I* U = USE UP OLD STYLE 01600I* N = NOW (IMMEDIATE) 01610I 52 52 BMDISP 01620I* FILLER 5A 53 57 FFFFFF 01630I* ROUTING. 01640I* OPER NO. 5P 01650I P 58 600BMOPER 01660I* DEPT NO. 5P 01670I P 61 630BMDEPT 01680I* WORK CENTER NO. 3P 01690I P 64 650BMWC 01700I* COMPONENT OPER REFERENCE INFO 10A 01710I 66 75 BMREF 01720I* FILLER 76 85 FFFFFF 01730I* 01740I* RECORD STATUS 1A 01750I* D = DELETED ÐÐ01760I 86 86 BMSTAT 01770I******************************************************************** 01780IBMWU BW 01790I* COMPONENT PN 10N 01800I 1 100BWCPN 01810I* ASSY PART # 10N 01820I 11 200BWAPN 01830I* RECORD STATUS 1A 01840I 21 21 BWSTAT 01850I******************************************************************** 01860IMGFILE MG 01870I* MESSAGE FILE. 01880I* TEXT 35A 01890I 1 35 MGTEXT 01900I* LINE-2 35A 01910I 36 70 MGLIN2 01920I* PROG NAME 5A 01930I 71 75 MGPROG 01940C******************************************************************** 01950C* INITIALIZE (1-TIME). 01960C EXSR SR101 INIT. 01970C*------------------------------------------------------------------- 01980C START TAG 01990C* CLEAR CRT - PUT HEADING. 02000C Z-ADD0 COUNT 30 ÐÐ02010C MOVE ' ' BLK6 6 02020C EXSR SR70 CLEAR CRT 02030C 50 MOVEL'001' RPGLIN 4 02040C N50 MOVEL'091' RPGLIN 02050C MOVEL'001' RPGCOL 4 02060C EXSR SR69 02070C*------------------------------------------------------------------- 02080C READ TAG 02090C* READ ASSY #. 02100C SETOF 909693 02110C Z-ADD287 M 02120C EXSR SR73 02130C EXSR SR75 READ ASSY. 02140C 96 EXSR SR73 PUT ERR MSG 02150C 96 GOTO READ 02160C N77 GOTO READ 02170C EXSR SR102 R.JUSTIFY 02180C MOVE W12A W10A 10 02190C MOVE BLK12 W12A 02200C MOVELW10A W12A PMMST2KEY 02210C MOVE W10A NUMPN 02220C MOVELW12A NCPN 100 02230C EXSR SR81 GET PMMST. 02240C N60 GOTO SETUP GOT IT. 02250C*------------------------------------------------------------------ ÐÐ02260C READER TAG 02270C* FLAG NO MAST ERROR. 02280C Z-ADD302 M 50 96 02290C M CHAINMGFILE 54 02300C EXSR SR73 PUT ERR MSG 02310C GOTO READ 02320C*------------------------------------------------------------------- 02330C SETUP TAG 02340C* SAVE COMPONENT DATA. 02350C MOVE PMPN TCPN 12 02360C MOVE PMDESC ADESC 29 02370C MOVE PMMODL AMODL 12 02380C MOVE PMSC ASC 2 02390C MOVE PMISSU AISSU 2 02400C MOVE PMPROV APROV 1 02410C MOVE PMPL APL 40 02420C MOVE PMECHG AECHG 2 02430C MOVE PMECN AECN 5 02440C* PUT COMP DATA TO CRT. 02450C PMPROV LOKUPTABPC TABPCN 40 02460C PMISSU LOKUPTABIC TABICN 41 02470C PMSC LOKUPTABSC TABSCN 42 02480C EXSR SR71 PUT HEADINGS 02490C MOVELNCPN W20A 20 02500C MOVE ZERO10 W20A ÐÐ02510C*-------------------------------------------------------------- 02520C SETLIM TAG 02530C* SET LOW LIMIT FOR READ 02540C W20A SETLLBMWU 02550C*------------------------------------------------------------------- 02560C CHASE TAG 02570C* GET NEXT BILL MATL RECORD. 02580C SETOF 54 02590C READ BMWU 54 02600C 54 GOTO ENDASY 02610C BWCPN COMP NCPN 54 02620C N54 GOTO ENDASY 02630C BWSTAT COMP 'D' 54 02640C 54 GOTO CHASE 02650C MOVELBWAPN W20A 02660C MOVE BWCPN W20A 02670C W20A CHAINBMMAST H8 02680C H8 GOTO ENDJOB 02690C* GET ASSEMBLY PART MASTER. 02700C MOVELBMAPN W12A 02710C EXSR SR81 GET PMMST2 02720C 60 GOTO READER ERROR 02730C* PUT TO CRT. 02740C MOVELPMPN NUMPN 100 02750C EXSR SR72 PUT DATA. ÐÐ02760C*------------------------------------------------------------------- 02770C ENDPAG TAG 02780C* SEE IF END OF PAGE. 02790C COUNT COMP 31 54 54 LINE #. 02800C N54 GOTO CHASE NOT EOP. 02810C Z-ADD320 M 02820C EXSR SR73 02830C EXSR SR75 READ. 02840C SETON 78 02850C EXSR SR71 02860C N77 GOTO CHASE NO INPUT 02870C*--------------------------------------------------------------- 02880C NEWLIM TAG 02890C* SET NEW LOW LIMIT FROM INPUT 02900C EXSR SR102 R.JUSTIFY 02910C MOVE W12A W10A 02920C MOVE W10A W20A 02930C MOVELNCPN W20A 02940C GOTO SETLIM SET LOW LIMIT 02950C*------------------------------------------------------------------- 02960C ENDASY TAG 02970C* PUT END OF W-U MSG. 02980C Z-ADD317 M 02990C EXSR SR73 PUT MSG. 03000C EXSR SR75 READ ÐÐ03010C N77 GOTO START 03020C GOTO NEWLIM SET NEW LOW LIMIT 03030C*------------------------------------------------------------------- 03040C ERROR TAG 03050C EXSR SR73 PUT ERROR MSG 03060C GOTO READ 03070C*------------------------------------------------------------------- 03080C NEWITM TAG 03090C MOVEL'Q104BM' PROG 03100C GOTO END 03110C*------------------------------------------------------------------- 03120C GOODBY TAG 03130C MOVEL'GOODBY' PROG 8 03140C GOTO END 03150C*------------------------------------------------------------------- 03160C MENU TAG 03170C EXSR SR96 GET CRTFILE 03180C Z-ADD1 W 03190C BLK6 LOKUPLNK,W 54 03200C 54 MOVELLNK,W PROG 03210C 54 MOVE BLK6 LNK,W 03220C N54 MOVEL'CONTU' PROG 03230C EXSR SR97 UPD CRTFILE 03240C EXSR SR98 >>>>>>>>>> 03250C*------------------------------------------------------------------- ÐÐ03260C END TAG 03270C EXSR SR96 GET CRTFILE 03280C EXSR SR97 UPD CRTFILE 03290C EXSR SR98 >>>>>>>>>> 03300C*------------------------------------------------------------------- 03310C ENDJOB TAG 03320C MOVEL'ENDJOB' PROG 03330C EXSR SR98 >>>>>>>>>> 03340C******************************************************************** 03350CSR SR69 BEGSR 03360CSR 50 EXITFZPUTXY 03370CSR RLABL RPGLIN 03380CSR RLABL RPGCOL 03390CSRN50 EXITFZMOVXY 03400CSR RLABL RPGLIN 03410CSR RLABL RPGCOL 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR70 BEGSR 03450C* CLEAR CRT. 03460CSR 50 EXITFZISTAT 03470CSR 50 EXITFZESCH 03480CSRN50 EXITFZCPAGE 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR71 BEGSR 03520C* PUT HEADINGS. 03530CSR EXSR SR70 CLEAR CRT 03540CSR SETON 71 03550CSR EXCPT PUT HEADING 03560CSR SETOF 71 03570CSR Z-ADD11 COUNT 30 03580CSR ENDSR 03590C******************************************************************** 03600CSR SR72 BEGSR 03610C* PUT DATA LINE. 03620CSR PMMODL COMP BLK12 54 03630CSR 54 MOVE BLK35 PMDESC 03640CSR 54 MOVELPMMODL PMDESC 03650CSR 54 MOVE '***' PMDESC 03660CSR 1 ADD COUNT COUNT 03670CSR SETON 72 03680CSR EXCPT 03690CSR SETOF 72 03700CSR ENDSR 03710C******************************************************************** 03720CSR SR73 BEGSR 03730C* PUT MSG TO CRT. 03740CSR M CHAINMGFILE 54 GET MSG. 03750CSR 99 MOVELPRGERR MGTEXT ÐÐ03760CSR EXSR SR74 PUT MSG. 03770CSR ENDSR 03780C******************************************************************** 03790CSR SR74 BEGSR 03800C* PUT MSG TO CRT. 03810CSR SETON 74 03820CSR EXCPT PUT MSG. 03830CSR SETOF 74 03840C* 03850CSR ENDSR 03860C******************************************************************** 03870CSR SR75 BEGSR 03880C* READ CRT. 03890CSR SETOF 9096 03900CSR SETOF 77 03910C*------------------------------------------------------------------- 03920CSR T75A TAG 03930CSR MOVE BLK12 W12A 12 03940CSR EXITFZR12 READ CRT 03950CSR RLABL W12A 03960CSR MOVEAW12A A12 03970CSR MOVE BLK12 W12A 03980CSR Z-ADD1 W 20 03990CSR '\' LOKUPA12,W 90 04000CSRN90 GOTO T75B NOT ESCAPE. ÐÐ04010CSR 1 ADD W W 04020CSR W COMP 12 55 04030CSR 55 GOTO T75E 04040CSR A12,W COMP 'G' 98 04050CSR A12,W COMP 'N' 93 NEW ASSY. 04060CSR A12,W COMP 'E' 94 EXIT. 04070CSR 98 GOTO GOODBY 04080CSR 94 GOTO MENU 04090CSR 93 GOTO NEWITM 04100CSR GOTO T75E 04110C*------------------------------------------------------------------- 04120CSR T75B TAG 04130CSR Z-ADD1 W 04140CSR ' ' LOKUPA12,W 77 04150CSRN77 GOTO END75 NO DATA INPUT. 04160CSR MOVEAA12,W W12A INPUT DATA. 04170CSR GOTO END75 04180C*------------------------------------------------------------------- 04190CSR T75E TAG 04200C* FLAG BAD ESCAPE. 04210CSR Z-ADD318 M 96 04220CSR END75 ENDSR 04230C******************************************************************** 04240CSR SR81 BEGSR 04250C* GET PART MAST. ÐÐ04260CSR MOVE ' ' W12A 04270CSR W12A CHAINPMMST2 60 04280CSRN60 PMSTAT COMP 'D' 60 04290CSR ENDSR 04300C******************************************************************** 04310CSR SR96 BEGSR 04320CSR # CHAINCRTFILE H9 GET CRTFILE 04330CSR H9 GOTO ENDJOB 04340CSR ENDSR 04350C******************************************************************** 04360CSR SR97 BEGSR 04370C* UPDATE CRTFILE. EXIT PROGRAM. 04380CSR TIME CRTIME 04390CSR MOVELUDATE CRDATE 04400CSR SETON 97 04410CSR EXCPT UPD CRTFILE 04420CSR SETOF 97 04430CSR ENDSR 04440C******************************************************************** 04450CSR SR98 BEGSR 04460CSR EXSR SR70 CLEAR SCREEN 04470CSR EXITFCHAIN >>>>>>>>>> 04480CSR RLABL PROG 04490CSR ENDSR 04500C******************************************************************** ÐÐ04510CSR SR101 BEGSR 04520C* 1-TIME INITIALIZE. 04530CSR MOVE BIT,1 NUL 04540CSR MOVE ' ' W2A 2 04550CSR EXITFZGMINX GET TERM # 04560CSR RLABL W2A 04570CSR MOVE W2A # 20 04580CSR # COMP 0 54 04590CSRN54 Z-ADD25 # 04600CSR EXSR SR96 GET CRTFILE 04610CSR MOVE CALL LNK 04620CSR MOVEL'Q104BM 'PROG 04630CSR PAR,# COMP '1' 50 04640CSR TST,# COMP 'S' 54 04650CSR 54 MOVE 'SHUTDOWN'PROG 04660CSR EXSR SR97 UPD CRTFILE 04670CSR 54 EXSR SR98 >>>>>>>>>> 04671CSR MOVE ' 'PROG 04680CSR MOVE ' ' BLK12 12 04690CSR MOVE ' ' BLK35 35 04700CSR Z-ADD0 ZERO10 100 04710CSR ENDSR 04720C***************************************************************** 04730CSR SR102 BEGSR 04740C* RIGHT JUSTIFY SR75 INPUT FIELD ÐÐ04750CSR Z-ADD12 W2N 20 04760CSR EXIT SUBRAJ R.JUSTIFY 04770CSR RLABL W2N 04780CSR RLABL W12A 04790CSR ENDSR 04800C******************************************************************** 04810CSR SR902 BEGSR 04820C* FLAG PROGRAM ERROR. 04830CSR SETON 9699 04840CSR Z-ADDM PRGERR 30 04850CSR Z-ADD319 M 04860CSR EXSR SR73 04870CSR ENDSR 04880O******************************************************************** 04890OTERM132 E 74 04900O* PUT MSG TO CRT 04910O NUL 132 04920O MGTEXT 35 04930O 37 ' ' 04940O*------------------------------------------------------------------- 04950O E 71 04960O* PUT HEADINGS 04970O BIT,28 1 04980O N50 8 '8091001' 04990O N50 BIT,1 9 ÐÐ05000O N50 BIT,1 10 05010O 50 10 '[001 ]001' 05020O 50 BIT,28 6 05030O UDATE 18 ' - - ' 05040O 80 'SINGLE LEVEL WHERE-USED ' 05050O E 71 05060O 127 'CHG LAST' 05070O E 71 05080O 15 'COMPONENT-PART#' 05090O 34 '<-------DESCRIPTION' 05100O 43 '-------->' 05110O 56 'MODEL-NAME' 05120O 70 'SOURCE-CODE' 05130O 82 'ISSUE-CODE' 05140O 101 'PROVISIONING-CODE' 05150O 114 'PROD-LINE' 05160O 126 'LEV ECN' 05170O* 05180O* 05190O E 71 05200O* PUT COMP DATA LINES 05210O NCPN 12 ' - - ' 05220O ADESC 43 05230O AMODL 57 05240O ASC 61 ÐÐ05250O AISSU 73 05260O APROV 84 05270O APL Z 111 05280O AECHG 120 05290O AECN 128 05300O E 71 05310O 42 TABSCN 69 05320O 41 TABICN 86 05330O 40 TABPCN 104 05340O E 71 05350O E 71 05360O 4 'ITEM' 05370O 15 'ASSEMBLY' 05380O 59 'QUANTITY' 05390O 80 'SOURCE ISSUE ENG' 05400O 88 'SCRAP' 05410O 111 '<-----ROUTING------->' 05420O 127 '<--E.C.N.--->' 05430O E 71 05440O 3 'NO' 05450O 14 'PART-NO' 05460O 39 '<-------DESCRIPTION' 05470O 49 '--------->' 05480O 59 'PER-ASSY' 05490O 63 'UM' ÐÐ05500O 69 'CODE' 05510O 75 'CODE' 05520O 81 'STD ' 05530O 88 'ALLOW' 05540O 94 'OPER' 05550O 100 'DEPT' 05560O 111 'REFERENCE' 05570O 119 'START' 05580O 127 'STOP' 05590O* 05600O E 72 05610O BMITNOZ 3 05620O NUMPN 18 ' - - ' 05630O PMDESC 49 05640O BMQTY 2 59 05650O PMUM 63 05660O PMSC 68 05670O BMISSU 74 05680O PMSTDC 79 05690O BMSCRP2 86 05700O 87 '%' 05710O BMOPERZ 94 05720O BMDEPTZ 100 05730O BMREF 112 05740O BMBECN 118 ÐÐ05750O BMBCHG 121 05760O BMEECN 128 05770O BMECHG 131 05780O******************************************************************** 05790OCRTFILE E 97 05800O PROG 26 05810O CRTIME 33 05820O CRDATE 37 05830O LNK 79 05840O******************************************************************** ** A12 ARRAY 005850 005860** NUL ARRAY 005870 005880** TABIC/TABICN VALID ISSUE CODES 005890PTPULL TIME 005900ORON REQUEST 005910BIBULK ISSUE 005920ARAS REQD 005930VSVENDOR SUPL'D 005940SDSHIPPING DOCUMENT 005950TDTRAVELER DOCUMENT 005960RDREF DOC ONLY 005970RAREF ASSY/PART 005980** TABSC/TABSCN VALID SOURCE CODES 005990ÐÐMAMFG ASSY 006000MPMFG PART 006010PAPURCH ASSY 006020PPPURCH PART 006030RDREF DOC ONLY 006040RSRAW STOCK 006050** TABPC/TABPCN VALID PROVISION CODES 006060AFRCST,NO VAL ADDED 006070BFRCST,VAL IS ADDED 006080CBLD/ORD,NO VAL ADDED 006090DBLD TO ORD,VAL ADDED 006100ECUSTOM 006110YOBSLT, REPAIRABLE 006120ZOBSLT,NOT REPAIR 006130** LNK ARRAY 006140 06150/* 06160_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(,2 ,}X105DP P120282120282(èÈÐ00010H Q105DP00020F* CALCULATOR PROGRAM. (X105DP) 00030F* REVISED 10/29/80 11:10 AM. 00040FBITTAB UP F 34 DISK 00050FCALC UC F 8R DISK 00060FTERM132 O F 132 5 00070E******************************************************************** 00080E NAM 1 250 6 A 00090E ROW 1 250 3 0A 00100E COL 1 250 1 0A 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160ICALC CC 00170I P 1 80NUMB 00180C******************************************************************** 00190C* INITIALIZE - 1-TIME. 00200C EXSR SR101 INIT 00210C*------------------------------------------------------------------- 00220C START TAG 00230C EXSR SR102 INIT 00240C EXSR SR103 RQST INSTR 00250C 90 GOTO ESCAPE ÐÐ00260C 10 EXSR SR10 NAME 00270C 11 EXSR SR11 ADD 00280C 12 EXSR SR12 XFOOT 00290C 13 EXSR SR13 SUB 00300C 14 EXSR SR14 MULT 00310C 15 EXSR SR15 DIV 00320C 16 EXSR SR16 ZADD 00330C 17 EXSR SR17 BRITE 00340C 18 EXSR SR18 SQUARE 00350C 19 EXSR SR19 SQ-ROOT 00360C 20 EXSR SR20 INIT 00370C 21 EXSR SR21 COMPUTE 00380C 90 22 EXSR SR22 ENTER DATA 00390C 90 22 GOTO ESCAPE 00400C GOTO START 00410C*------------------------------------------------------------------- 00420C ESCAPE TAG 00430C 98 00440COR 94 00450COR 92 GOTO GOODBY 00460C GOTO START 00470C*------------------------------------------------------------------- 00480C GOODBY TAG 00490C 98 MOVEL'GOODBY' PROG 8 00500C 94 MOVEL'CONTU' PROG ÐÐ00510C 92 MOVEL'Q105DP' PROG 00520C EXITFCHAIN 00530C RLABL PROG 00540C*------------------------------------------------------------------- 00550C ENDJOB TAG 00560C******************************************************************** 00570CSR SR10 BEGSR 00580C* NAME INSTR. 00590CSR FACT1A COMP BLK6 54 00600CSRN54 Z-ADD224 M 50 96 FLAG ERROR 00610CSRN54 GOTO END10 00620CSR ROWNO COMP 0 54 00630CSR 54 ROWNO COMP 100 5454 00640CSRN54 Z-ADD523 M 96 FLAG ERROR 00650CSRN54 GOTO END10 00660CSR COLNO COMP 0 54 00670CSRN54 Z-ADD492 M 96 FLAG ERROR 00680CSRN54 GOTO END10 00690CSR NUMB COMP 0 54 00700CSR 54 NUMB COMP 900 5454 00710CSRN54 Z-ADD524 M 96 FLAG ERROR 00720CSRN54 GOTO END10 00730CSR Z-ADD1 N 30 00740CSR FACT1A LOKUPNAM,N 54 00750CSRN54 BLK6 LOKUPNAM,N 54 ÐÐ00760CSRN54 Z-ADD525 M 96 FLAG ERROR 00770CSRN54 GOTO END10 00780CSR MOVE FACT1A NAM,N 00790CSR Z-ADDROWNO ROW,N 00800CSR Z-ADDCOLNO COL,N 00810CSR Z-ADDNUMB NUM,N 00820CSR END10 ENDSR 00830C******************************************************************** 00840CSR SR11 BEGSR 00850C* ADD INSTR. 00860CSR EXSR SR303 EDIT FACT-1 00870CSRN96 EXSR SR304 EDIT FACT-2 00880CSRN96 EXSR SR305 EDIT RESULT 00890CSRN96 EXSR SR200 SETOFFS 00900CSRN96 EXSR SR306 DO ARITH 00910CSR ENDSR 00920C******************************************************************** 00930CSR SR12 BEGSR 00940C* XFOOT INSTR. 00950CSR MOVE FACT1 FACT2 DUMMY FACT-2 00960CSR EXSR SR11 ADD 00970CSR ENDSR 00980C******************************************************************** 00990CSR SR13 BEGSR 01000C* SUBTRACT INSTR. ÐÐ01010CSR EXSR SR11 01020CSR ENDSR 01030C******************************************************************** 01040CSR SR14 BEGSR 01050C* MULTIPLY INSTR. 01060CSR EXSR SR11 01070CSR ENDSR 01080C******************************************************************** 01090CSR SR15 BEGSR 01100C* DIVIDE INSTR. 01110CSR EXSR SR11 01120CSR ENDSR 01130C******************************************************************** 01140CSR SR16 BEGSR 01150C* Z-ADD INSTR. 01160CSR EXSR SR303 EDIT FACT-1 01170CSRN96 EXSR SR305 EDIT RESULT 01180CSRN96 EXSR SR200 SETOFFS 01190CSRN96 EXSR SR307 INIT RESULT 01200CSRN96 EXSR SR306 DO ARITH 01210CSR ENDSR 01220C******************************************************************** 01230CSR SR103 BEGSR 01240C* REQUEST INSTR. 01250CSR EXSR SR69 DELETE 115 ÐÐ01260CSR EXSR SR68 CLEAR 119-120 01270C+------------------------------------------------------------------- 01280CSR T103A TAG 01290CSR EXSR SR200 SETOFFS 01300CSR EXSR SR201 RQST INSTR 01310CSR 90 GOTO END103 01320CSR EXSR SR202 EDIT INSTR 01330CSR 96 GOTO T103A 01340CSR EXSR SR203 SET-UP GUD 01350CSR Z-ADD1 G 30 01360C*------------------------------------------------------------------- 01370CSR T103B TAG 01380CSR EXSR SR200 SETOFFS 01390CSR 'X' LOKUPGUD,G 54 01400CSRN54 GOTO END103 01410CSR X COMP 1 41 01420CSR X COMP 2 42 01430CSR X COMP 3 43 01440CSR X COMP 4 44 01450CSR X COMP 5 45 01460CSR X COMP 6 46 01470CSR 41 EXSR SR41 FACT-1 01480CSR 42 EXSR SR42 FACT-2 01490CSR 43 EXSR SR43 RESULT 01500CSR 44 EXSR SR44 ROW ÐÐ01510CSR 45 EXSR SR45 COL 01520CSR 46 EXSR SR46 NUMB 01530CSR 92 Z-ADD1 G 01540CSR 92 GOTO T103B ESC BKWD 01550CSR 90 GOTO END103 OTHER ESC 01560CSR 1 ADD G G 01570CSR G COMP 7 54 01580CSRN54 GOTO T103B 01590CSR END103 ENDSR 01600C******************************************************************** 01610CSR SR301 BEGSR 01620C* UTILITY SR - EDIT FACTOR. 01630CSR SETOF 56 01640CSR MOVEAW15A A15 01650CSR Z-ADD1 X 30 01660CSR '9' LOKUPA15,X 56 01670CSRN56 GOTO T301A 01680CSR EXSR SR201 R. ADJUST 01690CSR MOVE W15A W15D3 153 01700CSR W15D3 COMP 0 54 01710CSR 54 Z-ADD526 M 96 FLAG ERROR 01720CSR GOTO END301 01730C*------------------------------------------------------------------- 01740CSR T301A TAG 01750CSR MOVE BLK15 W15A 15 ÐÐ01760CSR MOVEAA15,X W15A 01770CSR END301 ENDSR 01780C******************************************************************** 01790CSR SR303 BEGSR 01800C* UTILITY - EDIT FACTOR-1. 01810CSR SETOF 5152 01820CSR MOVE FACT1 W15A 15 01830CSR EXSR SR301 EDIT FACT-1 01840CSR 96 GOTO END303 ERROR 01850CSRN56 SETON 51 FACT-1 IS NUM 01860CSRN56 MOVE W15A FACT1N 153 01870CSRN56 GOTO END303 01880CSR MOVELW15A FACT1A 6 01890CSR MOVE FACT1A W6A 6 01900CSR EXSR SR302 LOKUP NAM 01910CSRN54 Z-ADD527 M 96 FLAG ERROR 01920CSRN54 GOTO END303 01930CSR Z-ADDROW,N R1 30 FACT-1 ROW 01940CSR Z-ADDCOL,N C1 30 FACT-1 COL 01950CSR Z-ADDNUM,N N1 30 FACT-1 NUMB 01960CSR END303 ENDSR 01970C******************************************************************** 01980CSR SR304 BEGSR 01990CSR MOVE FACT2 W15A 02000CSR EXSR SR301 EDIT FACT-2 ÐÐ02010CSR 96 GOTO END304 ERROR 02020CSRN56 SETON 52 02030CSRN56 MOVE W15A FACT2N 153 02040CSRN56 GOTO END304 02050CSR MOVELW15A FACT2A 15 02060CSR MOVE FACT2A W6A 02070CSR EXSR SR302 LOKUP NAM 02080CSRN54 Z-ADD528 M 96 FLAG ERROR 02090CSRN54 GOTO END304 02100CSR Z-ADDROW,N R2 30 FACT-2 ROW 02110CSR Z-ADDCOL,N C2 30 FACT-2 COL 02120CSR Z-ADDNUM,N N2 30 FACT-2 NUMB 02130CSR END304 ENDSR 02140C******************************************************************** 02150CSR SR306 BEGSR 02160C* UTILITY - ARITHMETIC. 02170CSR R1 SUB 1 R1 02180CSR C1 SUB 1 C1 02190CSR C2 SUB 1 C2 02200CSRN12 C3 SUB 1 C3 02210CSR Z-ADD0 COUNT 30 02220C*------------------------------------------------------------------- 02230CSR T306A TAG 02240CSR 1 ADD COUNT COUNT 02250CSR COUNT COMP N1 55 ÐÐ02260CSRN55 COUNT COMP N2 55 02270CSRN55N12 COUNT COMP N3 55 02280CSR 55 GOTO END306 EXCEEDS NUMB 02290CSR Z-ADDCOUNT COUNTX 30 02300CSRN51 Z-ADDR1 WR 30 ROW WORK 02310CSRN51 Z-ADDC1 WC 30 COL WORK 02320CSRN51 EXSR SR408 GET VALUE 02330CSRN51 Z-ADDW15D3 FACT1N FACTOR-1 02340CSRN52 Z-ADDR2 WR ROW WORK 02350CSRN52 Z-ADDC2 WC COL WORK 02360CSRN52 EXSR SR408 GET VAL 02370CSRN52 Z-ADDW15D3 FACT2N FACTOR-2 02380CSR Z-ADDR3 WR ROW WORK 02390CSR Z-ADDC3 WC COL WORK 02400CSR 12 SETON 68 02410CSR EXSR SR408 GET RES INDEX 02420CSR 12 SETOF 68 02430CSR Z-ADDINDEX A3 02440CSR 11 FACT1N ADD FACT2N RES,A3 02450CSR 13 FACT1 SUB FACT2N RES,A3 02460CSR 14 FACT1 MULT FACT2N RES,A3 02470CSR 15 FACT1 DIV FACT2N RES,A3 02480CSR GOTO T306A 02490CSR ENDSR 02500C******************************************************************** ÐÐ02510CSR SR305 BEGSR 02520CSR MOVE RES2 W15A 02530CSR EXSR SR301 EDIT RESULT 02540CSR 96 GOTO END305 ERROR 02550CSR 56 Z-ADD529 M 96 FLAG ERROR 02560CSR 56 GOTO END305 02570CSR MOVELW15A RESULT 02580CSR MOVE RESULT W6A 02590CSR EXSR SR302 LOKUP NAM 02600CSRN54 Z-ADD529 M 96 FLAG ERROR 02610CSRN54 GOTO END305 02620CSR Z-ADDROW,N R3 RESULT ROW 02630CSR Z-ADDCOL,N C3 RESULT COL 02640CSR Z-ADDNUM,N N3 RESULT NUMB 02650CSR END305 ENDSR 02660C******************************************************************** 02670CSR SR408 BEGSR 02680C* GET INDEX. 02690CSR WC SUB 1 W1N 10 02700CSR W1N MULT 100 INDEX 30 02710CSR WR ADD INDEX INDEX 02720CSR 68 Z-ADD1 COUNTX 02730CSR COUNT SUB 1 W3N 30 02740CSR W3N ADD INDEX INDEX 02750CSR ENDSR ÐÐ02760C******************************************************************** 02770CSR SR407 BEGSR 02780C* MOVE ARRAY TO WORK FIELD. 02790CSR EXSR SR408 GET INDEX 02800CSR Z-ADDINDEX X 30 02810CSR Z-ADDVAL,X W15D3 02820CSR ENDSR 02830C******************************************************************** /* 002840_‚ ÐÐ_‚_‚0C******************************************************************** 02770CSR SR407 BEGSR 02780C* MOVE ARRAY TO WORK FIELD. 02790CSR EXSR SR408 GET INDEX 02800CSR Z-ADDINDEX X 30 02810CSR Z-ADDVAL,X W15D3 02820CSR ENDSR 02830C******************************************************************** /* 002840_‚ ÐÈ( 2€  NX105PM P120282120282(èÈÐ00010H Q105PM00020F* QUICK ORDER POLICY UPDATE, MFG PARTS ONLY. (X105PM) 00030F* REV 3/07/81 3:30 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060FBMMAST UD F 86L20AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E A12 12 12 1 A INPUT ARRAY. 00110E LEV 1 20 20 NEXT RRN AT EA LEVEL 00120E QTY 1 20 7 0 QTY MULTIPLIER 00130E TPN 1 20 10 0 APN 10 0 00140E NUL 1 132 1 00150E PLT 8 3 0 LEAD TIMES 00160E PMM 6 7 0 MIN MAX CODES 00170E BIT 33 1 BITTAB. 00180I******************************************************************** 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************** 00220IPMMST2 PM 00230I* PART MASTER RECORD (XPMMST) 00240I* KEY AREA 00250I* PART NO. 12A ÐÐ00260I 1 12 PMPN 00270I* NUMB OF COMPONENTS 3P 00280I P 13 140PMNOBM 00290I* PROD LINE 4N 00300I 15 180PMPL 00310I* MODEL NAME 12A 00320I 19 30 PMMODL 00330I* DESCRIPTION 29A 00340I 31 59 PMDESC 00350I* COMMODITY CODE 9P 00360I P 60 640PMCC 00370I* ENG CHANGE STATUS. 00380I* CUR CHG LEVEL 2A 00390I 70 71 PMECHG 00400I* CUR CHG DATE 6N 00410I 72 770PMDCHG 00420I* LAST ECN NO. 5A 00430I 65 69 PMECN 00440I* DRAWING INFO 00450I* DWG SIZE 1A 00460I 82 82 PMSIZ 00470I* DWG CLASS 1A 00480I* D = DYNAIR DWG 00490I* V = VENDOR DWG 00500I 83 83 PMDCLS ÐÐ00510I* STANDARD CODE 1A 00520I 84 84 PMSTDC 00530I* DWG REL CODE 1A 00540I* E = ENG ONLY 00550I* M = REL TO MFG 00560I* P = PROTOTYPE 00570I 78 78 PMDREL 00580I* UNIT MEAS 2A 00590I* EA = EACH OC = OUNCE 00600I* ST = SET TC = TROY OUNCE 00610I* IN = INCH LB = POUND 00620I* FT = FEET PT = PINT 00630I* YD = YARD QT = QUART 00640I* SI = SQ.INCH GL = GALLON 00650I* SF = SQ.FEET DR = DRUM 00660I* SY = SQ.YARD 00670I 85 86 PMUM 00680I* SOURCE CODE 2A 00690I* MA = MFG ASSY 00700I* MP = MFG PART 00710I* PA = PURCH ASSY 00720I* PP = PURCH PART 00730I* RS = RAW STOCK 00740I 94 95 PMSC 00750I* PROVISIONING CODE 1A ÐÐ00760I* A = FORECAST,NO VALUE ADDED 00770I* B = FORECAST,VALUE ADDED 00780I* C = BUILD TO ORDER (B) 00790I* D = BUILD TO ORDER (NOT B) 00800I* E = CUSTOM 00810I* Y = OBSOLETE,REPAIRABLE 00820I* Z = OBSOLETE,NOT REPAIRABLE 00830I 96 96 PMPROV 00840I* ISSUE CODE 2A 00850I* PT = PULL TIME 00860I* OR = ON REQUEST 00870I* BI = BULK ISSUE 00880I* AR = AS REQUIRED 00890I* VS = VENDOR SUPPLIED 00900I* SD = SHIPPING DOCUMENT 00910I* TD = TRAV DOCUMENT 00920I* RD = REF DOCUMENT 00930I* RA = REF ASSY 00940I 97 98 PMISSU 00950I* INVENTORY ACCOUNT 5P 00960I P 110 1120PMACNT 00970I* LEAD TIMES 3P X 8 00980I P 113 128 PLT 00990I* MIN/MAX CODES 7P X 6 01000I P 139 162 PMM ÐÐ01010I* ROUNDING FACTOR 5P 01020I P 167 1690PMRNDF 01030I* FAB CODE 2A 01040I 487 488 PMFABC 01050I* RECORD STATUS 1A 01060I* D = DELETED 01070I 674 674 PMSTAT 01080I******************************************************************** 01090IBMMAST BM 01100I* BILL OF MATERIAL RECORD 01110I* KEY AREA 01120I* ASSY PART NO. 10N 01130I 1 100BMAPN 01140I* COMPONENT PART # 10N 01150I 11 200BMCPN 01160I* QTY PER ASSY 7P 01170I P 28 310BMQTY 01180I* ISSUE CODE 2A 01190I* PT = PULL TIME 01200I* OR = ON REQUEST 01210I* BI = BULK ISSUE 01220I* AR = AS REQUIRED 01230I* RA = REF ASSY 01240I* TD = TRAV DOC 01250I* SD = SHIP DOC ÐÐ01260I* RD = REF DOC 01270I* VS = VENDOR SUPPLIED 01280I 36 37 BMISSU 01290I* RECORD STATUS 1A 01300I* D = DELETED 01310I 86 86 BMSTAT 01320I******************************************************************** 01330IMGFILE MG 01340I* MESSAGE FILE. 01350I* TEXT 35A 01360I 1 35 MGTEXT 01370I* LINE-2 35A 01380I 36 70 MGLIN2 01390I* PROG NAME 5A 01400I 71 75 MGPROG 01410C******************************************************************** 01420C* INITIALIZE 01430C EXSR SR101 INIT 01440C*---------------------------------------------------------------- 01450C START TAG 01460C* GET ASSY PART NO FROM TERMINAL 01470C SETOF 969376 01480C Z-ADD185 M 50 MSG # 01490C SETON 69 01500C EXSR SR73 PROMPT ÐÐ01510C SETOF 69 01520C EXSR SR75 READ 01530C 96 GOTO START ERROR 01540C 98 GOTO GOODBY ABORT 01550C 94 GOTO MENU RET TO MENU 01560C 93 GOTO START NEW ITEM REQST 01570C N77 GOTO START NO INPUT 01580C Z-ADD12 W2N 20 01590C EXSR SR67 R.J. 01600C MOVE W12A TAPN 100 TOP ASSY PN 01610C EXSR SR65 BLK12-->W12A 01620C MOVELTAPN W12A 01630C EXSR SR81 GET PMMST2 01640C N60 GOTO TAG10 GOT IT 01650C Z-ADD302 M 96 FLAG ERROR 01660C EXSR SR73 PUT MSG 01670C GOTO START 01680C*-------------------------------------------------------------------- 01690C TAG10 TAG 01700C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 01710C Z-ADD1 QTY,2 QTY MULTIPLIER 01720C SETON 8976 01730C EXSR SR71 PUT HEADING 01740C SETOF 89 01750C* FLAG NO COMPONENTS ON FILE. ÐÐ01760C PMNOBM COMP 0 55 01770C N55 GOTO ENDASY NO COMPONENTS 01780C* SET-UP INITIAL BILL MATERIAL READ 01790C Z-ADD3 L 20 INDENTURE LEVEL 01800C MOVE BLK20 LEV 01810C MOVELTAPN LEV,2 01820C*----------------------------------------------------------------- 01830C TAG20 TAG 01840C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 01850C L SUB 1 L 54 INDENT LEVEL 01860C N54 GOTO ENDASY BOTTOM INDENT 01870C LEV,L COMP BLK20 54 01880C N54 GOTO TAG20 NONE THIS LEVEL 01890C MOVE LEV,L W20A 20 01900C MOVELLEV,L CURASY 100 MATCH PART # 01910C MOVE BLK20 LEV,L 01920C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 01930C*------------------------------------------------------------------ 01940C TAG30 TAG 01950C* SET-UP NEXT READ 01960C W20A SETLLBMMAST 01970C*--------------------------------------------------------------- 01980C TAG40 TAG 01990C* GET NEXT COMPONENT. 02000C SETOF 54 ÐÐ02010C READ BMMAST 54GET COMPONENT 02020C 54 GOTO TAG20 END OF FILE 02030C BMAPN COMP CURASY 54 02040C N54 GOTO TAG20 WRONG ASSY 02050C BMSTAT COMP 'D' 54 02060C 54 GOTO TAG40 DELETED RECORD 02070C* DISPLAY COMPONENT DATA 02080C Z-ADDBMCPN SAVEPN 100 SAVE PART NO. 02090C EXSR SR72 DISPLAY DATA 02100C 98 GOTO GOODBY 02110C 94 GOTO MENU 02120C 93 GOTO START 02130C* BRANCH IF NOT ASSY 02140C PMNOBM COMP 0 54 02150C N54 GOTO TAG40 NOT ASSY 02160C*------------------------------------------------------------------ 02170C TAG50 TAG 02180C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02190C MOVELBMAPN LEV,L 02200C 1 ADD BMCPN W10N 100 02210C MOVE W10N LEV,L 02220C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02230C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02240C MOVE BMCPN CURASY 02250C MOVELBMCPN W20A ÐÐ02260C MOVE ZERO10 W20A 02270C 1 ADD L L INDENT LEVEL 02280C GOTO TAG30 02290C*------------------------------------------------------------------ 02300C ENDASY TAG 02310C* END OF ASSY PROMPT. 02320C EXSR SR76 END ASSY MSG 02330C 76 EXSR SR102 RQST INPUT 02340C 98 GOTO GOODBY 02350C 94 GOTO MENU 02360C GOTO START NEW PART # 02370C*----------------------------------------------------------------- 02380C MENU TAG 02390C* SET RETURN TO MENU LINKAGE 02400C MOVEL'QQPM01' PROG 8 02410C GOTO END 02420C*----------------------------------------------------------------- 02430C GOODBY TAG 02440C* SET ABORT LINKAGE 02450C MOVEL'GOODBY' PROG 02460C GOTO END 02470C*----------------------------------------------------------------- 02480C END TAG 02490C* LINK TO NEXT PROG 02500C EXITFCHAIN ÐÐ02510C RLABL PROG 02520C*------------------------------------------------------------------ 02530C ENDJOB TAG 02540C**************************************************************** 02550CSR SR63 BEGSR 02560C* UTILITY MOVE 02570CSR MOVE '119001' W6A 6 02580CSR ENDSR 02590C*************************************************************** 02600CSR SR64 BEGSR 02610C* UTILITY MOVE 02620CSR MOVE '120001' W6A 02630CSR ENDSR 02640C**************************************************************** 02650CSR SR65 BEGSR 02660C* UTILITY MOVE 02670CSR MOVE BLK12 W12A 12 02680CSR ENDSR 02690C******************************************************************* 02700CSR SR66 BEGSR 02710C* LINE FEED/CR. 02720CSR SETON 70 02730CSR EXCPT BLANK LINE 02740CSR SETOF 70 02750CSR ENDSR ÐÐ02760C****************************************************************** 02770CSR SR67 BEGSR 02780C* RIGHT ADJUST 02790CSR Z-ADD12 W2N 20 02800CSR EXIT SUBRAJ R.J. 02810CSR RLABL W2N 02820CSR RLABL W12A 02830CSR ENDSR 02840C****************************************************************** 02850CSR SR68 BEGSR 02860C* POSITION CURSOR 02870CSR EXITFQXYPOS POSITION CURSOR 02880CSR RLABL W6A 02890CSR ENDSR 02900C******************************************************************* 02910CSR SR71 BEGSR 02920C* CLEAR CRT. PUT HEADINGS. 02930CSR Z-ADD5 COUNT 30 LINE COUNT 02940CSR MOVELTAPN W12A 02950CSR MOVE ' ' W12A 02960CSR EXSR SR81 GET TOP-ASSY PMMST2 02970CSR Z-ADD0 TPN 02980CSR Z-ADD1 P 30 02990CSR Z-ADDTAPN TPN,P 03000CSR SETON 71 ÐÐ03010CSR EXCPT PUT HEADING 03020CSR SETOF 71 03030CSR EXSR SR64 MOVE CURSOR 120 03040CSR EXSR SR68 POS CURSOR 03050CSR EXSR SR66 LF/CR 03060CSR EXSR SR66 LF/CR 03070CSR MOVE '117001' W6A 03080CSR EXSR SR68 POSITION CURSOR 03090CSR Z-ADDP LINE 03100CSR SETON 75 03110CSR EXCPT PUT TOP ASSY DATA 03120CSR SETOF 75 03130CSR 1 ADD COUNT COUNT 03140CSR ENDSR 03150C******************************************************************** 03160CSR SR72 BEGSR 03170C* DISPLAY DATA LINE TO CRT. 03180CSR EXSR SR65 BLK12--> W12A 03190CSR MOVELBMCPN W12A COMP PN 03200CSR EXSR SR81 GET PMMST2 03210C* BYPASS IF NOT MFG. 03220CSR MOVELPMSC W1A 1 03230CSR W1A COMP 'M' 54 03240CSRN54 PMSC COMP 'RA' 54 03250CSRN54 GOTO END72 NOT ASSY ÐÐ03260C* BYPASS REFERENCE ITEMS 03270CSR MOVELBMISSU W1A 1 03280CSR W1A COMP 'R' 54 03290CSR 54 BMISSU COMP 'RA' 55 03300CSR 54N55 GOTO END72 REFERENCE ITEM 03310CSR 1 ADD COUNT COUNT 30 LINE COUNT 03320CSR L COMP 1 0101 03330CSR L COMP 2 02 03340CSR L COMP 3 03 03350CSR L COMP 4 04 03360CSR L COMP 5 05 03370CSR L COMP 6 06 03380CSR L COMP 7 07 07 03390CSR 01 Z-ADD1 L 03400CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03410CSR 1 ADD P P 03420CSR Z-ADDBMCPN TPN,P 03430CSR Z-ADDBMAPN APN,P 03440CSR EXSR SR64 MOVE CURSOR LINE 120 03450CSR EXSR SR68 POSITION CURSOR 03460CSR EXSR SR66 LF/CR 03470CSR MOVE '117001' W6A 03480CSR EXSR SR68 POSITION CURSOR 03490CSR Z-ADDP LINE 30 03500CSR SETON 7276 ÐÐ03510CSR EXCPT PUT DATA. 03520CSR SETOF 72 03530CSR P COMP 20 54 54 03540CSRN54 GOTO END72 NOT END PAGE 03550CSR Z-ADD34 M 03560CSR EXSR SR73 END PAGE MSG 03570CSR EXSR SR64 MOVE CURSOR LINE 120 03580CSR EXSR SR68 POSITION CURSOR 03590CSR 76 EXSR SR102 REQUEST DATA 03600CSR 98 03610COR 94 03620COR 93 GOTO END72 03630CSR EXSR SR71 PUT HEADINGS 03640CSR MOVELSAVEPN W12A 03650CSR EXSR SR81 GET BACK MAST 03660CSR END72 ENDSR 03670C******************************************************************** 03680CSR SR73 BEGSR 03690C* PUT PROMPT TO CRT. 03700CSR EXSR SR89 03710CSR 54 MOVELM MGTEXT 03720CSR 2 ADD COUNT COUNT 03730CSR EXSR SR63 MOVE CURSOR LINE 119 03740CSR EXSR SR68 POSITION CURSOR 03750CSR SETON 73 ÐÐ03760CSR EXCPT PUT PROMPT. 03770CSR SETOF 73 03780CSR Z-ADDM LSTERR 50 03790CSR 69 MOVE '120037' W6A 6 03800CSR 69 EXSR SR68 POSITION CURSOR 03810CSR ENDSR 03820C******************************************************************** 03830CSR SR74 BEGSR 03840C* PUT DATA LINE PROMPT. 03850CSR MOVE '118001' W6A 03860CSR EXSR SR68 POSITION CURSOR 03870CSR SETON 74 03880CSR EXCPT PROMPT 03890CSR SETOF 74 03900CSR ENDSR 03910C******************************************************************** 03920CSR SR75 BEGSR 03930C* READ CRT. 03940CSR T75 TAG 03950CSR SETOF 909493 03960CSR SETOF 7796 03970CSR SETOF 919295 03980CSR MOVE BIT,7 BUFLGT 2 03990CSR EXSR SR65 BLK12--> W12A 04000CSR EXITFQBELL RING BELL ÐÐ04010CSR EXITFQWREED 04020CSR RLABL W12A 04030CSR RLABL BUFLGT 04040CSR MOVEAW12A A12 04050CSR EXSR SR65 BLK12--> W12A 04060CSR Z-ADD1 W 20 04070CSR '\' LOKUPA12,W 90 04080CSRN90 GOTO T75A NOT ESC. 04090CSR 1 ADD W W 04100CSR W COMP 12 54 04110CSR 54 GOTO T75C BAD ESC. 04120CSR A12,W COMP 'E' 94 EXIT. 04130CSR A12,W COMP 'N' 93 NEW ASSY. 04140CSR A12,W COMP 'G' 98 GOODBY 04150CSR A12,W COMP 'B' 92 SKIP BACK 04160CSR A12,W COMP 'U' 91 UPDATE/DONE 04170CSRN91 A12,W COMP 'D' 91 " " 04180CSR A12,W COMP 'S' 95 SPACE FILL 04190CSRN92N91N95 04200CANN94N93N98 GOTO T75C BAD ESCAPE 04210CSR 95 SETON 77 04220CSR 95 SETOF 9095 04230CSR GOTO T75Z 04240C*------------------------------------------------------------------- 04250CSR T75A TAG ÐÐ04260CSR Z-ADD1 W 04270CSR ' ' LOKUPA12,W 77 04280CSR 77 MOVEAA12,W W12A INPUT DATA. 04290CSR GOTO T75Z 04300C*------------------------------------------------------------------- 04310CSR T75C TAG 04320C* FLAG BAD ESCAPE. 04330CSR Z-ADD318 M 96 04340CSR EXSR SR73 FLAG ERROR. 04350CSR GOTO T75 04360C*--------------------------------------------------------------------- 04370CSR T75Z TAG 04380CSR LSTERR COMP 0 54 04390CSRN54 GOTO END75 04400CSR Z-ADD0 LSTERR 04410CSR EXSR SR63 MOVE CURSOR LINE 119 04420CSR EXSR SR68 POSITION CURSOR 04430CSR EXSR SR66 BLANK LINE 120 04440CSR EXSR SR63 MOVE CURSOR LINE 119 04450CSR EXSR SR68 POSITION CURSOR 04460CSR END75 ENDSR 04470C******************************************************************** 04480CSR SR76 BEGSR 04490C* END OF ASSY PROMPT/READ. 04500CSR Z-ADD317 M ÐÐ04510CSR EXSR SR73 PUT MSG. 04520CSR ENDSR 04530C******************************************************************** 04540CSR SR78 BEGSR 04550C* REWRITE DATA LINE WITH REVISED DATA. 04560CSR BEGIN ADD TITEM LINE 04570CSR MOVELLINE W6A 04580CSR F COMP 1 51 TITEM 04590CSR F COMP 2 52 ISSUE CODE 04600CSR F COMP 3 53 REG LT 04610CSR F COMP 4 54 SAF LT 04620CSR F COMP 5 55 ORDER SPAN 04630CSR F COMP 6 56 ROUND FACT 04640CSR 52 MOVE '108' W6A 04650CSR 53 MOVE '112' W6A 04660CSR 54 MOVE '116' W6A 04670CSR 55 MOVE '119' W6A 04680CSR 56 MOVE '128' W6A 04690CSR SETON 78 04700CSR EXCPT PUT DATA 04710CSR SETOF 78 04720CSR ENDSR 04730C******************************************************************** 04740CSR SR81 BEGSR 04750C* GET PART MAST. ÐÐ04760CSR SETOF 61 04770CSR MOVE ' ' W12A 04780CSR W12A CHAINPMMST2 60 GET PMMST. 04790CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE. 04800CSR ENDSR 04810C******************************************************************** 04820CSR SR82 BEGSR 04830C* GET BMMAST FOR UPDATE. 04840CSR MOVELAPN,X W20A 20 04850CSR MOVE TPN,X W20A 04860CSR W20A SETLLBMMAST 04870CSR SETOF 79 04880CSR READ BMMAST 79 04890CSRN79 BMSTAT COMP 'D' 79 04900CSR 79 GOTO END82 04910CSR BMAPN COMP APN,X 54 04920CSR 54 BMCPN COMP TPN,X 54 04930CSRN54 SETON 79 04940CSR END82 ENDSR 04950C******************************************************************** 04960CSR SR89 BEGSR 04970C* GET MGFILE. 04980CSR M CHAINMGFILE 54 GET MGFILE. 04990CSR 54 MOVE BLK35 MGTEXT 05000CSR 54 MOVELM MGTEXT ÐÐ05010CSR 54 MOVE 'NO MSG' MGTEXT 05020CSR ENDSR 05030C******************************************************************** 05040CSR SR101 BEGSR 05050C* INITIALIZE (1-TIME). 05060CSR MOVE BIT,1 NUL 05070CSR MOVELBIT,1 BUFLGT 2 05080CSR MOVE ' ' BLK35 35 05090CSR MOVE ' ' BLK12 12 05100CSR MOVE ' ' BLK20 20 05110CSR Z-ADD0 ZERO10 100 05120CSR ENDSR 05130C******************************************************************** 05140CSR SR102 BEGSR 05150C* REQUEST DATA INPUT. 05160C* PUT PROMPT LINE. 05170CSR 118 SUB P BEGIN 30 05180C*------------------------------------------------------------------- 05190CSR T102A TAG 05200CSR Z-ADD0 TITEM 05210CSR Z-ADD0 PLT 05220CSR Z-ADD0 PMM 05230CSR Z-ADD0 PMRNDF 05240CSR EXSR SR74 PROMPT 05250C*------------------------------------------------------------------- ÐÐ05260CSR T102B TAG 05270C* REQUEST ITEM #. 05280CSR Z-ADD1 F 30 05290CSR MOVE '119023' W6A 05300CSR EXSR SR68 POSITION CURSOR 05310CSR EXSR SR75 READ CRT 05320CSR 92 GOTO T102A 05330CSR 90 05340CORN77 GOTO END102 05350CSR EXSR SR67 R.J. 05360CSR MOVE W12A TITEM 30 05370CSR TITEM COMP 0 5555 05380CSRN55 TITEM COMP 20 55 05390CSR 55 GOTO T102C 05400CSR Z-ADDTITEM X 30 05410CSR TPN,X COMP 0 55 05420CSR 55 GOTO T102D 05430C*------------------------------------------------------------------- 05440CSR T102C TAG 05450CSR Z-ADD335 M 05460CSR EXSR SR73 FLAG ERROR 05470CSR GOTO T102A 05480C*------------------------------------------------------------------- 05490CSR T102D TAG 05500CSR MOVELTPN,X W12A 12 ÐÐ05510CSR EXSR SR81 GET PART MAST 05520CSR 60 05530COR 61 GOTO T102C 05540CSR EXSR SR82 GET BMMAST 05550CSR EXSR SR78 PUT DATA 05560CSR EXSR SR74 PROMPT 05570C*------------------------------------------------------------------- 05580CSR T102E TAG 05590C* REQUEST ISSUE CODE. 05600CSR Z-ADD2 F 05610CSR TITEM COMP 1 54 05620CSR 54 MOVE ' ' BMISSU 05630CSR 54 GOTO T102F 05640CSR MOVE '119040' W6A 05650CSR EXSR SR68 POSITION CURSOR 05660CSR EXSR SR75 READ CRT 05670CSR 92 GOTO T102D 05680CSR 90 GOTO T102U 05690CSRN77 GOTO T102F 05700CSR MOVELW12A BMISSU 05710CSR EXSR SR78 UPDATE LINE 05720CSR EXSR SR74 PROMPT 05730C*------------------------------------------------------------------- 05740CSR T102F TAG 05750C* REQUEST REGULAR LT. ÐÐ05760CSR Z-ADD3 F 05770CSR MOVE '119060' W6A 05780CSR EXSR SR68 POSITION CURSOR 05790CSR EXSR SR75 READ CRT 05800CSR 92 GOTO T102A 05810CSR 90 GOTO T102U 05820CSRN77 GOTO T102G 05830CSR EXSR SR67 R.J. 05840CSR MOVE W12A PLT,5 05850CSR EXSR SR78 UPDATE LINE 05860CSR EXSR SR74 PROMPT 05870C*------------------------------------------------------------------- 05880CSR T102G TAG 05890C* REQUEST SAFETY LEAD TIME. 05900CSR Z-ADD4 F 05910CSR MOVE '119086' W6A 05920CSR EXSR SR68 POSITION CURSOR 05930CSR EXSR SR75 READ CRT 05940CSR 92 GOTO T102F 05950CSR 90 GOTO T102U 05960CSRN77 GOTO T102H 05970CSR EXSR SR67 R.J. 05980CSR MOVE W12A PLT,8 05990CSR EXSR SR78 UPDATE LINE 06000CSR EXSR SR74 PROMPT ÐÐ06010C*------------------------------------------------------------------- 06020CSR T102H TAG 06030C* REQUEST ORDER SPAN. 06040CSR Z-ADD5 F 06050CSR MOVE '119107' W6A 06060CSR EXSR SR68 POSITION CURSOR 06070CSR EXSR SR75 READ CRT 06080CSR 92 GOTO T102G 06090CSR 90 GOTO T102U 06100CSRN77 GOTO T102J 06110CSR EXSR SR67 R.J. 06120CSR MOVE W12A PMM,2 06130CSR EXSR SR78 UPDATE LINE 06140CSR EXSR SR74 PROMPT 06150C*------------------------------------------------------------------- 06160CSR T102J TAG 06170C* REQUEST ROUNDING FACTOR. 06180CSR Z-ADD6 F 06190CSR MOVE '119130' W6A 06200CSR EXSR SR68 POSITION CURSOR 06210CSR EXSR SR75 READ CRT 06220CSR 92 GOTO T102H 06230CSR 90 GOTO T102U 06240CSRN77 GOTO T102U 06250CSR EXSR SR67 R.J. ÐÐ06260CSR MOVE W12A PMRNDF 06270CSR EXSR SR78 UPDATE LINE 06280CSR EXSR SR74 PROMPT 06290C*------------------------------------------------------------------- 06300CSR T102U TAG 06310C* UPDATE. 06320CSR 94 06330COR 93 06340COR 98 GOTO END102 06350CSRN91 90 GOTO END102 06360CSR TITEM COMP 1 54 06370CSR 54 SETON 79 06380CSR SETON 80 06390CSR EXCPT 06400CSR SETOF 80 06410CSR GOTO T102A 06420CSR END102 TAG 06430CSR SETOF 76 06440CSR ENDSR 06450O******************************************************************** 06460OTERM132 E 72 06470O* DATA LINE. 06480O 11 '.' 06490O 14 '.' 06500O 17 '.' ÐÐ06510O 20 '.' 06520O 23 '.' 06530O 26 '.' 06540O 29 '.' 06550O 02 29 ' ' 06560O 03 29 ' ' 06570O L Z 8 06580O LINE Z 3 06590O 01 BMCPN 22 ' - - ' 06600O 02 BMCPN 25 ' - - ' 06610O 03 BMCPN 28 ' - - ' 06620O 04 BMCPN 31 ' - - ' 06630O 05 BMCPN 34 ' - - ' 06640O 06 BMCPN 37 ' - - ' 06650O 07 BMCPN 40 ' - - ' 06660O PMDESC 71 06670O BMQTY 2 82 06680O PMUM 86 06690O PMSC 91 06700O EXTQTYZ 98 06710O PMFABC 103 06720O BMISSU 109 06730O PLT,5 Z 114 06740O PLT,8 Z 118 06750O PMM,2 Z 125 ÐÐ06760O PMRNDFZ 132 06770O*------------------------------------------------------------------- 06780O E 78 06790O* REWRITE ABOVE DATA. 06800O NUL 132 06810O BIT,28 1 06820O 2 '8' 06830O W6A 8 06840O 52 BMISSU 132 06850O 53 PLT,5 Z 132 06860O 54 PLT,8 Z 132 06870O 55 PMM,2 Z 132 06880O 56 PMRNDFZ 132 06890O*------------------------------------------------------------------- 06900O E 75 06910O* PUT TOP ASSY LINE. 06920O 8 '1' 06930O LINE Z 3 06940O TAPN 22 ' - - ' 06950O N89 29 'CONT''D' 06960O PMDESC 71 06970O 82 '1' 06980O PMUM 86 06990O PMSC 91 07000O PLT,5 Z 114 ÐÐ07010O PLT,8 Z 118 07020O PMM,2 Z 125 07030O PMRNDFZ 132 07040O 98 '1' 07050O PMFABC 103 07060O*------------------------------------------------------------------- 07070O E 73 07080O* PUT ERROR MESSAGE. 07090O MGTEXT 35 07100O N69 BIT,28 130 07110O N69 131 'K' 07120O BIT,8 132 07130O*------------------------------------------------------------------- 07140O E 71 07150O* CLEAR SCREEN - LINE-1. 07160O 71 'QUICK ORDER POLICY ' 07170O 79 'ASSY=' 07180O TAPN 91 ' - - ' 07190O 113 '<--------' 07200O 132 '------>' 07210O 125 'INPUT FIELDS' 07220O*------------------------------------------------------------------- 07230O E 71 07240O* HEADING, LINE-2. 07250O 26 ' <----------INDENTURE' ÐÐ07260O 40 '------------->' 07270O 5 'LINE ' 07280O 82 'QUANTITY' 07290O 93 'SOURCE' 07300O 98 'EXT' 07310O 103 'FAB' 07320O 109 'ISSUE' 07330O 116 'LEAD' 07340O 125 'MIN' 07350O 132 'ROUND' 07360O*------------------------------------------------------------------- 07370O E 71 07380O* HEADING, LINE-3. 07390O 8 'LEV' 07400O 4 'ITEM' 07410O 29 '1 2 3 4 5 6 7' 07420O 32 '-UP' 07430O 53 'DESCRIPTION' 07440O 82 'PER-ASSY' 07450O 86 'UM' 07460O 92 'CODE' 07470O 98 'QTY' 07480O 103 'CODE' 07490O 109 'CODE' 07500O 114 'ASY' ÐÐ07510O 118 'PAR' 07520O 125 'ORD' 07530O 131 'FACT' 07540O E 71 07550O* HEADING, LINE-4 (BLANK). 07560O*------------------------------------------------------------------- 07570O E 70 07580O* BLANK LINE 07590O 1 ' ' 07600O*------------------------------------------------------------------- 07610O E 74 07620O* DATA INPUT PROMPT. 07630O 10 'ENTER---->' 07640O 21 'LINE-ITEM:' 07650O TITEM Z 25 07660O 38 'ISSUE-CODE:' 07670O BMISSU 41 07680O 58 'ASY-LEAD-TIME:' 07690O PLT,5 Z 62 07700O 84 'PARALLEL-LEAD-TIME:' 07710O PLT,8 Z 88 07720O 105 'MIN-ORDER-QTY:' 07730O PMM,2 Z 113 07740O PMRNDFZ 132 07750O 128 'ROUNDING-FACTOR:' ÐÐ07760O******************************************************************** 07770OPMMST2 E 80 07780O PMNOBM 14P 07790O PMCC 64P 07800O PMACNT 112P 07810O PLT 128P 07820O PMM 162P 07830O PMRNDF 169P 07840O******************************************************************** 07850OBMMAST E 80N79 07860O BMQTY 31P 07870O BMISSU 37 ** A12 ARRAY 007880 007890** LEV ARRAY 007900 007910** QTY ARRAY 007920 007930** TPN/APN ARRAY 007940 007950** NUL ARRAY 007960 007970/* 007980_‚ ÐÐ_‚_‚0O******************************************************************** 07770OPMMST2 E 80 07780O PMNOBM 14P 07790O PMCC 64P 07800O PMACNT 112P 07810O PLT 128P 07820O PMM 162P 07830O PMRNDF 169P 07840O******************************************************************** 07850OBMMAST E 80N79 07860O BMQTY 31P 07870O BMISSU 37 ** A12 ARRAY 007880 007890** LEV ARRAY 007900 007910** QTY ARRAY 007920 007930** TPN/APN ARRAY 007940 007950** NUL ARRAY 007960 007970/* 007980_‚ ÐÈ(ú3Ï úiX105TX P120282120282(èÈÐ00010H Q105TX00020F* PRINT INDEX. (X105TX) 00030F* REVISED 9/11/80 1:55 PM. 00040FBITHEX IP F 256 DISK 00050FINDXCONTIS F 160 DISK 00060E******************************************************************** 00070E AR 1 148 1 A OUTPUT ARRAY 00080E RA 1 148 1 A WORK ARRAY 00090E WRK 1 132 1 00100E REC 132 1 A TXFILE 00110E BIT 256 1 00120I**************************************************************** 00130IBITHEX BT 00140I 1 256 BIT 00150I******************************************************************** 00160IINDXCONTCC 01 1 CX 00170I 2 60PAGE 00180I 7 138 REC 00190I 139 139 SPACE 00200I 140 144 LINE 00210I 145 152 NAME 00220I GG 02 00230C******************************************************************** 00240C* INITIALIZE. 00250C N79 EXSR SR101 INITIALIZE ÐÐ00260C N01 GOTO END 00270C N40 EXSR SR68 TOP FORM 00280C SETON 40 00290C ' ' LOKUPREC 54 00300C N54 GOTO END 00310C EXSR SR102 INIT PRIMARY 00320C EXSR SR308 BOLD PRINT 00330C EXSR SR309 UNDERLINE 00340C EXSR SR70 PRINT 00350C*------------------------------------------------------------------- 00360C END TAG 00370CLR EXSR SR68 00380C******************************************************************** 00390CSR SR67 BEGSR 00400C* LINE SPACE. 00410CSR EXITFQCLF LINE FEED ONLY 00420CSR 1 ADD LINENO LINENO 00430CSR ENDSR 00440C******************************************************************** 00450CSR SR68 BEGSR 00460C* TOP OF FORM. 00470CSR EXITFZTFORM 00480CSR Z-ADD1 LINENO 50 00490CSR 1 ADD EGAP EGAP 40 PAGE # 00500CSR Z-ADD5 W2N 20 ÐÐ00510CSR MOVE '2' W1A 1 00520CSR MOVE BLK6 PAGNO 5 00530CSR EXIT SUBRED EDIT PAGE # 00540CSR RLABL EGAP SOURCE 00550CSR RLABL W1A EDIT CODE 00560CSR RLABL PAGNO RESULT 00570CSR RLABL W2N END POS 00580CSR SETON 40 00590CSR ENDSR 00600C******************************************************************** 00610CSR SR69 BEGSR 00620C* PUT TO DIABLO. 00630CSRN40 EXSR SR68 TOP FORM 00640CSR EXITFZD148C PUT DIABLO 00650CSR RLABL W148A 00660CSR ENDSR 00670C******************************************************************** 00680CSR SR70 BEGSR 00690C* PUT DIABLO. 00700CSR EXSR SR401 FIND NON-BLK 00710CSRN54 GOTO END70 00720CSR EXSR SR67 LF 00730CSRN40 EXSR SR68 TOP FORM 00740CSR EXSR SR311 SUBSCRIPTS 00750CSR EXSR SR308 BOLD PRINT ÐÐ00760CSR EXSR SR309 UNDERLINE 00770CSR EXSR SR71 PUT PAGE # 00780CSR U2 MOVEANAME AR,135 00790CSR U2 MOVEALINE AR,143 00800CSR MOVEAAR W148A 148 00810CSR EXSR SR69 PUT DIABLO 00820CSR MOVE ' ' AR 00830CSR END70 ENDSR 00840C******************************************************************** 00850CSR SR71 BEGSR 00860C* INSERT PAGE #. 00870CSR MOVE ' ' W5A 5 00880CSR Z-ADD5 W2N 00890CSR MOVE 'Z' W1A 00900CSR EXIT SUBRED 00910CSR RLABL PAGE 00920CSR RLABL W1A 00930CSR RLABL W5A 00940CSR RLABL W2N 00950CSR MOVE W5A W3A 3 00960CSR Z-ADD134 X 00970C*------------------------------------------------------------------- 00980CSR T71A TAG 00990CSR X SUB 1 X 30 54 01000CSRN54 GOTO END71 ÐÐ01010CSR AR,X COMP ' ' 54 01020CSR 54 GOTO T71B 01030CSR GOTO T71A 01040C*------------------------------------------------------------------- 01050CSR T71B TAG 01060CSR 2 ADD X X 01070CSR MOVE '(' AR,X 01080CSR 1 ADD X X 01090CSR MOVEAW3A AR,X 01100CSR 3 ADD X X 01110CSR MOVE ')' AR,X 01120CSR END71 ENDSR 01130C******************************************************************** 01140CSR SR101 BEGSR 01150C* 1-TIME INIT 01160CSR SETON 79 01170CSR MOVE ' ' BLK132132 01180CSR MOVE ' ' BLK6 6 01190CSR MOVE UDATE TODAY 6 01200CSR ENDSR 01210C******************************************************************** 01220CSR SR102 BEGSR 01230C* INIT DATA PRIOR TO 1ST COMMA IF SAME AS LAST LINE. 01240CSR MOVE REC WRK 01250CSR Z-ADD1 X 30 ÐÐ01260CSR ',' LOKUPWRK,X 54 01270CSR 54 MOVEABLK132 WRK,X 01280CSR MOVEAWRK,1 W132A 132 01290CSR W132A COMP LSTLIN 54 01300CSRN54 GOTO T102B NEW PRIM 01310C*------------------------------------------------------------------- 01320CSR T102A TAG 01330CSR MOVE ' ' WRK,X 01340CSR X SUB 1 X 54 01350CSRN54 MOVE WRK AR 01360CSRN54 GOTO END102 01370CSR GOTO T102A 01380C*------------------------------------------------------------------- 01390CSR T102B TAG 01400CSR MOVE W132A LSTLIN132 01410CSR MOVE REC AR 01420CSR EXSR SR67 LF 01430CSR END102 ENDSR 01440C******************************************************************** 01450CSR SR308 BEGSR 01460C* BOLD PRINT. 01470CSR Z-ADD1 L 30 01480CSR MOVE ' ' RA 01490CSR SETOF 55 01500C*------------------------------------------------------------------- ÐÐ01510CSR T308A TAG 01520CSR BIT,97 LOKUPAR,L 54 01530CSRN54 GOTO T308M 01540CSR MOVE ' ' AR,L 01550C*------------------------------------------------------------------- 01560CSR T308B TAG 01570CSR 1 ADD L L 01580CSR L COMP 148 54 01590CSR 54 GOTO T308M 01600CSR AR,L COMP BIT,97 54 01610CSR 54 MOVE ' ' AR,L 01620CSR 54 GOTO T308A 01630CSR MOVE AR,L RA,L 01640CSR SETON 55 01650CSR GOTO T308B 01660C*------------------------------------------------------------------- 01670CSR T308M TAG 01680CSRN55 GOTO END308 01690CSR MOVEARA W148A 01700CSR EXSR SR69 BOLD PRINT 01710CSR END308 ENDSR 01720C******************************************************************** 01730CSR SR309 BEGSR 01740C* UNDERLINE. 01750CSR Z-ADD1 L ÐÐ01760CSR MOVE ' ' RA 01770CSR SETOF 55 01780C*------------------------------------------------------------------- 01790CSR T309A TAG 01800CSR BIT,96 LOKUPAR,L 54 01810CSRN54 GOTO T309M 01820CSR MOVE BIT,97 AR,L SETUP BOLD PRINT 01830C*------------------------------------------------------------------- 01840CSR T309B TAG 01850CSR 1 ADD L L 01860CSR L COMP 148 54 01870CSR 54 GOTO T309M 01880CSR AR,L COMP BIT,96 54 01890CSR 54 MOVE BIT,97 AR,L SETUP BOLD PRINT 01900CSR 54 1 ADD L L 01910CSR 54 L COMP 148 56 01920CSR 54 56 GOTO T309M 01930CSR 54 GOTO T309A 01940CSR MOVE BIT,96 RA,L 01950CSR SETON 55 01960CSR GOTO T309B 01970C*------------------------------------------------------------------- 01980CSR T309M TAG 01990CSRN55 GOTO END309 02000CSR MOVEARA W148A ÐÐ02010CSR EXSR SR69 02020CSR EXSR SR308 BOLD PRINT 02030CSR END309 ENDSR 02040C******************************************************************** 02050CSR SR311 BEGSR 02060C* PRINT SUBSCRIPT. 02070CSR MOVE ' ' RA 02080CSR SETOF 55 02090CSR Z-ADD1 L 02100C*------------------------------------------------------------------- 02110CSR T311A TAG 02120CSR BIT,127 LOKUPAR,L 54 02130CSRN54 GOTO T311B 02140CSR SETON 55 02150CSR MOVE ' ' AR,L 02160CSR L SUB 1 L 54 02170CSRN54 GOTO T311A 02180CSR MOVE AR,L RA,L 02190CSR MOVE ' ' AR,L 02200CSR GOTO T311A 02210C*------------------------------------------------------------------- 02220CSR T311B TAG 02230CSRN55 GOTO END311 02240CSR EXITFZNHLF NEG HALF LF 02250CSR MOVEARA W148A ÐÐ02260CSR EXSR SR69 PRINT SUBSCRIPT 02270CSR EXITFZPHLF POS HALF LF 02280CSR END311 ENDSR 02290C******************************************************************** 02300CSR SR401 BEGSR 02310C* CHECK FOR NON-BLK LINE 02320CSR ' ' LOKUPAR 54 NON-BLK 02330CSRN54 BIT,97 LOKUPAR 54 BOLD 02340CSRN54 BIT,96 LOKUPAR 54 UNDERLINE 02350CSR ENDSR ** AR ARRAY 002360 002370** RA ARRAY 002380 002390 002400** WRK ARRAY 002410 002420/* 002430_‚ ÐÐ_‚_‚0CSR EXSR SR69 PRINT SUBSCRIPT 02270CSR EXITFZPHLF POS HALF LF 02280CSR END311 ENDSR 02290C******************************************************************** 02300CSR SR401 BEGSR 02310C* CHECK FOR NON-BLK LINE 02320CSR ' ' LOKUPAR 54 NON-BLK 02330CSRN54 BIT,97 LOKUPAR 54 BOLD 02340CSRN54 BIT,96 LOKUPAR 54 UNDERLINE 02350CSR ENDSR ** AR ARRAY 002360 002370** RA ARRAY 002380 002390 002400** WRK ARRAY 002410 002420/* 002430_‚ ÐÈ(ú49 úiX019RM P999999120282(èÈÐ00010H Q019RM00020F* LIST OPER BY WORK CENTER. (X018RM) 00030F* REVISED 11-12-81 2:45 PM. 00040FPMMST2 IP AF 674 12AI 1 DISK 00050FRMMAST IS AF 140 15AI 1 DISK 00060FRMWCNOS IC F 920R DISK 00070FWCMAST IC F 960R 8AI 1 DISK 00080FPRINT O F 132 OF PRINTER 00090E******************************************************************** 00100E USE 1 115 1 A 00110E P1 1 115 1 00120E P2 1 115 1 00130E P3 1 115 1 00140E DEP 115 8 A 00150E ADP 3 3 0A 00160E MDP 12 3 0A 00170I******************************************************************** 00180IRMWCNOS RW 10 00190I 1 920 DEP 00200I******************************************************************** 00210IPMMST2 PM 02 674NCD 00220I 1 100PN L1M1 00230I 31 59 PMDESC 00240I P 537 542 ADP 00250I P 591 614 MDP ÐÐ00260I GG 04 00270I******************************************************************** 00280IRMMAST RM 03 140NCD 00290I 1 100PN L1M1 00300I P 25 270RMDEPT 00310I P 28 290RMWC 00320I 30 69 RMDESC 00330I RG 04 00340I*********************************************************************** 00350IWCMAST WC 00360I* WORK CENTER MASTER 00370I 9 37 WCDESC 00380C******************************************************************** 00390C* INIT 1-TIME. 00400C N79 MOVE ' ' BLK8 8 STUPIDITY 00410C N79 EXSR SR101 INIT 00420C N79 Z-ADD0 ZERO3 30 STUPIDITY 00430C N79 SETON 79 00440C L1 MOVE '.' USE 00450C* BRANCH ON RECORD CODE. 00460C 02 GOTO TAG200 PMMST2 00470C 03 GOTO TAG300 RMMAST 00480C GOTO END 00490C*------------------------------------------------------------------- 00500C TAG200 TAG ÐÐ00510C* PART MAST. 00520C MOVE BLK8 W8A 8 00530C Z-ADD0 W3N 30 00540C Z-ADD1 X 30 00550C*------------------------------------------------------------------- 00560C TAG210 TAG 00570C ZERO3 LOKUPADP,X 54 00580C N54 Z-ADD1 X 00590C N54 GOTO TAG230 00600C Z-ADDADP,X W5N 50 00610C EXSR SR103 LOAD DEP & USE 00620C Z-ADD0 ADP,X 00630C GOTO TAG210 00640C*------------------------------------------------------------------- 00650C TAG230 TAG 00660C ZERO3 LOKUPMDP,X 54 00670C N54 GOTO END 00680C Z-ADDMDP,X W5N 00690C EXSR SR103 LOAD DEP & USE 00700C Z-ADD0 MDP,X 00710C GOTO TAG230 00720C*------------------------------------------------------------------- 00730C TAG300 TAG 00740C* ROUTING OPER. 00750C Z-ADDRMDEPT W5N ÐÐ00760C Z-ADDRMWC W3N 30 00770C EXSR SR103 LOAD DEP & USE 00780C GOTO END 00790C*------------------------------------------------------------------- 00800C END TAG 00810CL1 'X' LOKUPUSE 59 00820CL1 59 MOVEAUSE PRT 115 00830CL1 59 91 SETON 90 00840CL1 59 SETON 91 00850CLR EXSR SR104 PRINT DEPTS 00860C******************************************************************** 00870CSR SR101 BEGSR 00880C* 1-TIME INIT. 00890CSR Z-ADD1 W3N 30 00900CSR W3N CHAINRMWCNOS H9 00910CSR MOVE ' ' BLK8 8 00920CSR Z-ADD0 ADP 00930CSR MOVE ' ' BLK35 35 00940CSR Z-ADD0 MDP 00950CSR MOVE ' ' P1 00960CSR MOVE ' ' P2 00970CSR MOVE ' ' P3 00980CSR MOVE ' ' USE 00990CSR Z-ADD0 X 01000C*------------------------------------------------------------------ ÐÐ01010CSR T101A TAG 01020C* BUILD COL NO. HEADING PRINT LINES 01030CSR 1 ADD X X 01040CSR X COMP 115 54 01050CSR 54 GOTO T101B 01060CSR MOVE X P3,X 01070CSR P3,X COMP '0' 54 01080CSRN54 GOTO T101A 01090CSR MOVELX W2A 2 01100CSR MOVE W2A P2,X 01110CSR MOVELW2A P1,X 01120CSR P1,X COMP '0' 54 01130CSR P2,X COMP '0' 55 01140CSR 54 MOVE ' ' P1,X 01150CSR 54 55 MOVE ' ' P2,X 01160CSR GOTO T101A 01170C*------------------------------------------------------------------- 01180CSR T101B TAG 01190CSR MOVEAP1 HED1 115 01200CSR MOVEAP2 HED2 115 01210CSR MOVEAP3 HED3 115 01220CSR END101 ENDSR 01230C******************************************************************** 01240CSR SR103 BEGSR 01250C* LOAD DEP AND USE ARRAYS. ÐÐ01260CSR MOVELW5N W8A 8 01270CSR MOVE W3N W8A 8 01280CSR Z-ADD1 W 30 01290CSR W8A LOKUPDEP,W 54 01300CSR 54 MOVE 'X' USE,W 01310CSR 54 GOTO END103 01320CSR Z-ADD1 W 01330CSR BLK8 LOKUPDEP,W 54 01340CSRN54 GOTO END103 01350CSR MOVE W8A DEP,W 01360CSR MOVE 'X' USE,W 01370CSR EXSR SR103 SORT 01380CSR END103 ENDSR 01390C******************************************************************* 01400CSR SR104 BEGSR 01410C* PRINT DEPT NO'S / COL NO'S. 01420CSR Z-ADD1 X 01430C*------------------------------------------------------------------- 01440CSR T104A TAG 01450CSR BLK8 LOKUPDEP,X 54 01460CSRN54 GOTO END104 01470CSR DEP,X CHAINWCMAST 54 01480CSR 54 MOVE BLK35 WCDESC 01490CSR MOVELDEP,X W5N 50 01500CSR MOVE DEP,X W3A 3 PRINT DEPT ÐÐ01510CSR MOVE BLK8 DEP,X 01520CSR SETON 85 01530CSR EXCPT PRINT COL/DEPT 01540CSR SETOF 85 01550CSR SETON 86 01560CSR GOTO T104A 01570CSR END104 ENDSR 01580O*********************************************************************** 01590OPRINT H 201 N90 59 01600O OR OF 01610O 78 'WORK CENTERS BY PART NO.' 01620O UDATE Y 8 01630O 127 'PAGE' 01640O PAGE Z 132 01650O*-------------------------------------------------------------------- 01660O H 1 N90 59 01670O OR OF 01680O HED1 132 01690O*-------------------------------------------------------------------- 01700O H 1 N90 59 01710O OR OF 01720O HED2 132 01730O*-------------------------------------------------------------------- 01740O H 2 N90 59 01750O OR OF ÐÐ01760O HED3 132 01770O 8 'PART-NO.' 01780O*----------------------------------------------------------------------- 01790O TF 1 L1 59 01800O PN 12 ' - - ' 01810O PRT B 132 01820O*------------------------------------------------------------------- 01830O EF22 85N86 01840O 16 'DEPT''S BY COLUMN' 01850O*------------------------------------------------------------------ 01860O E 1 85N86 01870O X Z 3 01880O W5N Z 10 01890O 11 '-' 01900O W3A 14 01910O WCDESC 50 01920O*------------------------------------------------------------------ 01930O EF 1 85 86 01940O X Z 3 01950O W5N Z 10 01960O 11 '-' 01970O W3A 14 01980O WCDESC 50 01990O******************************************************************** 02000O* ÐÐ02010O* 02020O* 02030O* 02040O* ** USE ARRAY 02050 02060** P1 ARRAY 02070 02080** P2 ARRAY 02090 02100** P3 ARRAY 02110 02120/* 02130_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(È4£ ÈTX106DP P120282120282(èÈÐ00010H Q106DP00020F* READ MATL USAGE FROM FLOPPY TO MATLHIST. (X106DP) 00030F* REVISED 6/30/81 11:55 AM. 00040FFLOPPY IP F 122 17 00050F KEBCDIC 00060FMATLHISTUC F 232R10AI 1 DISK A 00070E******************************************************************** 00080E C4 12 6 0 UNPLAN (1) 00090E C6 12 6 0 PLAN (2) 00100E SP 12 6 0 SP/REP (3) 00110E UU 12 6 0 1 00120E PU 12 6 0 2 00130E SR 12 6 0 3 00140I******************************************************************** 00150IMATLHISTMH 00160I* PART NO. 10N 00170I 1 100PARTNO 00180I* UNPLAN USAGE 6N X 12 (C4) 00190I 11 82 UU 00200I* PLAN USAGE 6N X 12 (C6) 00210I 83 154 PU 00220I* SPARES & REPAIRS 6N X 12 (SP) 00230I 155 226 SR 00240I* LAST DATE 6N 00250I 227 2320DATE ÐÐ00260I******************************************************************** 00270IFLOPPY MI 01 1 CY 2 C1 00280I* Y1-C4 UNPLAN USAGE 00290I 3 120PN L1 00300I 13 18 C4,12 00310I 19 24 C4,11 00320I 25 30 C4,10 00330I 31 36 C4,9 00340I 37 42 C4,8 00350I 43 48 C4,7 00360I 49 54 C4,6 00370I 55 60 C4,5 00380I 61 66 C4,4 00390I 67 72 C4,3 00400I 73 78 C4,2 00410I*------------------------------------------------------------------- 00420I MJ 02 1 CY 2 C2 00430I 3 120PN L1 00440I 13 18 C4,1 00450I 19 24 C6,12 00460I 25 30 C6,11 00470I 31 36 C6,10 00480I 37 42 C6,9 00490I 43 48 C6,8 00500I 49 54 C6,7 ÐÐ00510I 55 60 C6,6 00520I 61 66 C6,5 00530I 67 72 C6,4 00540I 73 78 C6,3 00550I*------------------------------------------------------------------- 00560I MK 03 1 CY 2 C3 00570I 3 120PN L1 00580I 13 18 C6,2 00590I 19 24 C6,1 00600I 25 30 SP,12 00610I 31 36 SP,11 00620I 37 42 SP,10 00630I 43 48 SP,9 00640I 49 54 SP,8 00650I 55 60 SP,7 00660I 61 66 SP,6 00670I 67 72 SP,5 00680I 73 78 SP,4 00690I*------------------------------------------------------------------- 00700I ML 04 1 CY 2 C4 00710I 3 120PN L1 00720I 13 18 SP,3 00730I 19 24 SP,2 00740I 25 30 SP,1 00750I 31 340MMYY ÐÐ00760I*------------------------------------------------------------------- 00770I GG 05 00780C******************************************************************** 00790CL1 PN CHAINMATLHIST 54 00800CL1 54 Z-ADD0 UU 00810CL1 54 Z-ADD0 PU 00820CL1 54 Z-ADD0 SR 00830CL1 54 Z-ADD0 DATE 00840CL1 54 SETON 81 00850CL1 54 EXCPT 00860CL1 54 SETOF 81 00870CL1 54 PN CHAINMATLHIST 54 00880CL1 Z-ADDC4 UU 00890CL1 Z-ADDC6 PU 00900CL1 Z-ADDSP SR 00910CL1 SETON 82 00920CL1 EXCPT 00930CL1 SETOF 82 00940CL1 Z-ADD0 C4 00950CL1 Z-ADD0 C6 00960CL1 Z-ADD0 SP 00970O******************************************************************** 00980OMATLHISTEADD 81 00990O PN 10 01000O UU 82 ÐÐ01010O PU 154 01020O SR 226 01030O DATE 232 01040O*------------------------------------------------------------------- 01050O E 82 01060O UU 82 01070O PU 154 01080O SR 226 01090O MMYY 230 /* 01100_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( 4ø  NX106PM P120282120282(èÈÐ00010H Q106PM00020F* INDENTED PARTS LIST, MFD PARTS ONLY. (X106PM) 00030F* REVISED 4/21/81 1:45 PM. DG-REL006 OK. *** D I A B L O *** 00040FBITTAB IP F 33 DISK 00050FSUSPENSEUD F 128L29AI 1 DISK 00060FPMMST2 IC F 674R12AI 1 DISK 00070FBMMAST ID F 86L20AI 1 DISK 00080FMGFILE IC F 80R DISK 00090FCRTFILE UC F 256R DISK 00100FEMPLFILEIC F 64R14AI 1 DISK 00110FMENUDEPTIT F 25 EDISK 00120E******************************************************************** 00130E MENUDEPT TABDEP 1 10 5 0 TABNAM 20 00140E A12 12 12 1 A INPUT ARRAY. 00150E LEV 1 20 20 NEXT RRN AT EA LEVEL 00160E QTY 1 20 7 0 QTY MULTIPLIER 00170E A29 1 29 1 00180E PLT 8 3 0 LEAD TIMES 00190E PMM 6 7 0 MIN MAX CODES 00200E BIT 33 1 BITTAB. 00210E REC 132 1 CRTFILE 00220E APN 8 10 0A 00230E QAR 8 3 0 00240I******************************************************************** 00250IBITTAB BT ÐÐ00260I 1 33 BIT 00270I******************************************************************** 00280ICRTFILE CR 00290I 81 212 REC 00300I******************************************************************** 00310IEMPLFILEEE 00320I 23 42 EENAME 00330I******************************************************************** 00340ISUSPENSESP 00350I* RECORD CODE 2A (MP) 00360I 3 4 SPREC 00370I* REQUESTING DEPT 5N 00380I 8 120SPDEPT 00390I* EMPL # 5A 00400I 13 17 SPEMPL 00410I* ASSY PART NOS. 10N X 8 00420I 30 109 APN 00430I* QTY ARRAY 3P X 8 00440I P 110 125 QAR 00450I* RECORD STATUS 1A 00460I 128 128 SPSTAT 00470I******************************************************************** 00480IPMMST2 PM 00490I* PART MASTER RECORD. 00500I* KEY AREA ÐÐ00510I* PART NO. 12A 00520I 1 12 PMPN 00530I* NUMB OF COMPONENTS 3P 00540I P 13 140PMNOBM 00550I* PROD LINE 4N 00560I 15 180PMPL 00570I* MODEL NAME 12A 00580I 19 30 PMMODL 00590I* DESCRIPTION 29A 00600I 31 59 PMDESC 00610I* COMMODITY CODE 9P 00620I P 60 640PMCC 00630I* ENG CHANGE STATUS. 00640I* CUR CHG LEVEL 2A 00650I 70 71 PMECHG 00660I* CUR CHG DATE 6N 00670I 72 770PMDCHG 00680I* LAST ECN NO. 5A 00690I 65 69 PMECN 00700I* DRAWING INFO 00710I* DWG SIZE 1A 00720I 82 82 PMSIZ 00730I* DWG CLASS 1A 00740I* D = DYNAIR DWG 00750I* V = VENDOR DWG ÐÐ00760I 83 83 PMDCLS 00770I* STANDARD CODE 1A 00780I 84 84 PMSTDC 00790I* DWG REL CODE 1A 00800I* E = ENG ONLY 00810I* M = REL TO MFG 00820I* P = PROTOTYPE 00830I 78 78 PMDREL 00840I* UNIT MEAS 2A 00850I* EA = EACH OC = OUNCE 00860I* ST = SET TC = TROY OUNCE 00870I* IN = INCH LB = POUND 00880I* FT = FEET PT = PINT 00890I* YD = YARD QT = QUART 00900I* SI = SQ.INCH GL = GALLON 00910I* SF = SQ.FEET DR = DRUM 00920I* SY = SQ.YARD 00930I 85 86 PMUM 00940I* SOURCE CODE 2A 00950I* MA = MFG ASSY 00960I* MP = MFG PART 00970I* PA = PURCH ASSY 00980I* PP = PURCH PART 00990I* RD = REF DOC ONLY 01000I* RS = RAW STOCK ÐÐ01010I 94 95 PMSC 01020I* PROVISIONING CODE 1A 01030I* A = FORECAST,NO VALUE ADDED 01040I* B = FORECAST,VALUE ADDED 01050I* C = BUILD TO ORDER (B) 01060I* D = BUILD TO ORDER (NOT B) 01070I* E = CUSTOM 01080I* Y = OBSOLETE,REPAIRABLE 01090I* Z = OBSOLETE,NOT REPAIRABLE 01100I 96 96 PMPROV 01110I* ISSUE CODE 2A 01120I* PT = PULL TIME 01130I* OR = ON REQUEST 01140I* BI = BULK ISSUE 01150I* AR = AS REQUIRED 01160I* VS = VENDOR SUPPLIED 01170I* SD = SHIPPING DOCUMENT 01180I* TD = TRAV DOCUMENT 01190I* RD = REF DOC ONLY 01200I* RA = REF ASSY 01210I 97 98 PMISSU 01220I* INVENTORY ACCOUNT 5P 01230I P 110 1120PMACNT 01240I* LEAD TIMES 3P X 8 01250I P 113 128 PLT ÐÐ01260I* MIN/MAX CODES 7P X 6 01270I P 139 162 PMM 01280I* ROUNDING FACTOR 5P 01290I P 167 1690PMRNDF 01300I* FAB CODE 2A 01310I 487 488 PMFABC 01320I* RECORD STATUS 1A 01330I* D = DELETED 01340I 674 674 PMSTAT 01350I******************************************************************** 01360IBMMAST BM 01370I* BILL OF MATERIAL RECORD 01380I* KEY AREA 01390I* ASSY PART NO. 10N 01400I 1 100BMAPN 01410I* COMPONENT PART # 10N 01420I 11 200BMCPN 01430I* ITEM NO. 3N 01440I 25 270BMITNO 01450I* QTY PER ASSY 7P 01460I P 28 310BMQTY 01470I* SCRAP ALLOW .2N 01480I 34 352BMSCRP 01490I* ISSUE CODE 2A 01500I* PT = PULL TIME ÐÐ01510I* OR = ON REQUEST 01520I* BI = BULK ISSUE 01530I* AR = AS REQUIRED 01540I* RA = REF ASSY 01550I* TD = TRAV DOC 01560I* SD = SHIP DOC 01570I* RD = REF DOC 01580I* VS = VENDOR SUPPLIED 01590I 36 37 BMISSU 01600I* EFFECTIVITY. 01610I* BEGIN CHANGE LEVEL 2A 01620I 38 39 BMBCHG 01630I* ENDING CHANGE LEVEL 2A 01640I 40 41 BMECHG 01650I* BEGIN ECN # 5A 01660I 42 46 BMBECN 01670I* ENDING ECN # 5A 01680I 47 51 BMEECN 01690I* DISPOSITION CODE 1A 01700I* U = USE UP OLD STYLE 01710I* N = NOW (IMMEDIATE) 01720I 52 52 BMDISP 01730I* FILLER 5A 53 57 FFFFFF 01740I* ROUTING. 01750I* OPER NO. 5P ÐÐ01760I P 58 600BMOPER 01770I* DEPT NO. 5P 01780I P 61 630BMDEPT 01790I* WORK CENTER NO. 3P 01800I P 64 650BMWC 01810I* COMPONENT OPER REFERENCE INFO 10A 01820I 66 75 BMREF 01830I* FILLER 10A 76 85 FFFFFF 01840I* RECORD STATUS 1A 01850I* D = DELETED 01860I 86 86 BMSTAT 01870I******************************************************************** 01880IMGFILE MG 01890I* MESSAGE FILE. 01900I* TEXT 35A 01910I 1 35 MGTEXT 01920I* LINE-2 35A 01930I 36 70 MGLIN2 01940I* PROG NAME 5A 01950I 71 75 MGPROG 01960C******************************************************************** 01970C* INITIALIZE 01980C EXSR SR101 INIT 01990C Z-ADD0 ZERO10 100 STUPIDITY 02000C* SET-UP 1ST SUSPENSE READ. ÐÐ02010C MOVE ' ' A29 02020C MOVEA'MP' A29,3 02030C MOVEAA29 W29A 29 02040C W29A SETLLSUSPENSE 02050C*------------------------------------------------------------------- 02060C START TAG 02070C* GET NEXT SUSPENSE RECORD. 02080C SETOF 54 02090C READ SUSPENSE 54 02100C 54 GOTO END 02110C SPREC COMP 'MP' 54 02120C N54 GOTO END 02130C SPSTAT COMP 'D' 54 02140C 54 GOTO START 02150C ZERO10 LOKUPAPN 54 02160C N54 GOTO TAG5 02170C EXSR SR77 TITLE PAGE 02180C*------------------------------------------------------------------- 02190C TAG5 TAG 02200C* GET NEXT ASSY. 02210C Z-ADD1 S 30 02220C ZERO10 LOKUPAPN,S 54 02230C N54 SETON 80 02240C N54 EXCPT DELETE SUSPENSE 02250C N54 SETOF 80 ÐÐ02260C N54 GOTO START 02270C Z-ADD0 EGAP 30 PAGE # 02280C Z-ADDAPN,S TAPN 100 02290C Z-ADD0 APN,S 02300C MOVELTAPN W12A 12 02310C EXSR SR81 GET PMMST2 02320C N60 GOTO TAG10 GOT IT 02330C Z-ADD302 M 50 96 FLAG ERROR 02340C EXSR SR73 PUT MSG 02350C GOTO TAG5 02360C*-------------------------------------------------------------------- 02370C TAG10 TAG 02380C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02390C Z-ADDQAR,S QTY,2 QTY MULTIPLIER 02400C SETON 8976 02410C EXSR SR71 PUT HEADING 02420C SETOF 89 02430C* FLAG NO COMPONENTS ON FILE. 02440C PMNOBM COMP 0 55 02450C N55 GOTO ENDASY NO COMPONENTS 02460C* SET-UP INITIAL BILL MATERIAL READ 02470C Z-ADD3 L 20 INDENTURE LEVEL 02480C MOVE BLK20 LEV 02490C MOVELTAPN LEV,2 02500C*----------------------------------------------------------------- ÐÐ02510C TAG20 TAG 02520C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02530C L SUB 1 L 54 INDENT LEVEL 02540C N54 GOTO ENDASY BOTTOM INDENT 02550C LEV,L COMP BLK20 54 02560C N54 GOTO TAG20 NONE THIS LEVEL 02570C MOVE LEV,L W20A 20 02580C MOVELLEV,L CURASY 100 MATCH PART # 02590C MOVE BLK20 LEV,L 02600C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02610C*------------------------------------------------------------------ 02620C TAG30 TAG 02630C* SET-UP NEXT READ 02640C W20A SETLLBMMAST 02650C*--------------------------------------------------------------- 02660C TAG40 TAG 02670C* GET NEXT COMPONENT. 02680C SETOF 54 02690C READ BMMAST 54GET COMPONENT 02700C 54 GOTO TAG20 END OF FILE 02710C BMAPN COMP CURASY 54 02720C N54 GOTO TAG20 WRONG ASSY 02730C BMSTAT COMP 'D' 54 02740C 54 GOTO TAG40 DELETED RECORD 02750C* DISPLAY COMPONENT DATA ÐÐ02760C EXSR SR72 DISPLAY DATA 02770C* BRANCH IF NOT ASSY 02780C PMNOBM COMP 0 54 02790C N54 GOTO TAG40 NOT ASSY 02800C*------------------------------------------------------------------ 02810C TAG50 TAG 02820C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02830C MOVELBMAPN LEV,L 02840C 1 ADD BMCPN W10N 100 02850C MOVE W10N LEV,L 02860C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02870C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02880C MOVE BMCPN CURASY 02890C MOVELBMCPN W20A 02900C MOVE ZERO10 W20A 02910C 1 ADD L L INDENT LEVEL 02920C GOTO TAG30 02930C*------------------------------------------------------------------ 02940C ENDASY TAG 02950C* END OF ASSY PROMPT. 02960C EXSR SR76 END ASSY MSG 02970C GOTO TAG5 NEW PART # 02980C*----------------------------------------------------------------- 02990C END TAG 03000C*------------------------------------------------------------------ ÐÐ03010C ENDJOB TAG 03020C EXSR SR68 TOP FORM 03030C EXSR SR68 TOP FORM 03040C******************************************************************** 03050CSR SR65 BEGSR 03060C* UPDATE CRTFILE. 03070CSR EXSR SR82 GET CRTFILE 03080CSR MOVE ' ' REC 03090CSR EXSR SR83 UPD CRTFILE 03100CSR EXSR SR82 GET CRTFILE 03110CSR EXSR SR66 LF 03120CSR MOVEAREC W148A 148 03130CSR EXITFZD148 03140CSR RLABL W148A 03150CSR ENDSR 03160C******************************************************************* 03170CSR SR66 BEGSR 03180C* LINE FEED. 03190CSR EXITFQCLF LF 03200CSR 1 ADD COUNT COUNT 03210CSR ENDSR 03220C****************************************************************** 03230CSR SR67 BEGSR 03240C* RIGHT ADJUST 03250CSR Z-ADD12 W2N 20 ÐÐ03260CSR EXIT SUBRAJ R.J. 03270CSR RLABL W2N 03280CSR RLABL W12A 03290CSR ENDSR 03300C****************************************************************** 03310CSR SR68 BEGSR 03320C* TOP OF FORM. 03330CSR EXITFZTFORM TOP FORM 03340CSR 1 ADD EGAP EGAP 30 PAGE # 03350CSR Z-ADD0 COUNT 30 03360CSR ENDSR 03370C******************************************************************** 03380CSR SR69 BEGSR 03390C* PAUSE. 03400CSR EXITFQPAUSE 03410CSR ENDSR 03420C******************************************************************** 03430CSR SR70 BEGSR 03440C* PRINT LINE. 03450CSR EXSR SR65 PRINT LINE 03460CSR COUNT COMP 60 54 54 03470CSR 54 EXSR SR71 NEW PAGE 03480CSR ENDSR 03490C******************************************************************* 03500CSR SR71 BEGSR ÐÐ03510C* CLEAR CRT. PUT HEADINGS. 03520CSR EXSR SR68 TOP OF FORM 03530CSR MOVELTAPN W12A 03540CSR MOVE ' ' W12A 03550CSR EXSR SR81 GET TOP-ASSY PMMST2 03560CSR Z-ADD1 P 30 03570CSR SETON 7131 03580CSR EXSR SR65 PUT HEADING 03590CSR SETON 7132 03600CSR EXSR SR65 PUT HEADING 03610CSR SETON 7133 03620CSR EXSR SR65 PUT HEADING 03630CSR EXSR SR66 LF/CR 03640CSR Z-ADDP LINE 03650CSR PMMODL COMP BLK12 54 03660CSR 54 MOVE BLK35 PMDESC 03670CSR 54 MOVELPMMODL PMDESC 03680CSR 54 MOVE '***' PMDESC 03690CSR SETON 75 03700CSR EXSR SR70 PUT TOP ASSY DATA 03710CSR ENDSR 03720C******************************************************************** 03730CSR SR72 BEGSR 03740C* DISPLAY DATA LINE TO CRT. 03750CSR MOVELBMCPN W12A COMP PN ÐÐ03760CSR EXSR SR81 GET PMMST2 03770CSR PMMODL COMP BLK12 54 03780CSR 54 MOVE BLK35 PMDESC 03790CSR 54 MOVELPMMODL PMDESC 03800CSR 54 MOVE '***' PMDESC 03810C* BYPASS IF NOT MFG. 03820CSR MOVELPMSC W1A 1 03830CSR W1A COMP 'M' 54 03840CSRN54 PMSC COMP 'RA' 54 03850CSRN54 GOTO END72 NOT ASSY 03860C* BYPASS REFERENCE 03870CSR MOVELBMISSU W1A 1 03880CSR W1A COMP 'R' 54 03890CSR 54 BMISSU COMP 'RA' 55 03900CSR 54N55 GOTO END72 REF ITEM 03910CSR L COMP 1 0101 03920CSR L COMP 2 02 03930CSR L COMP 3 03 03940CSR L COMP 4 04 03950CSR L COMP 5 05 03960CSR L COMP 6 06 03970CSR L COMP 7 07 07 03980CSR 01 Z-ADD1 L 03990CSR BMISSU COMP ' ' 55 04000CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD ÐÐ04010CSR 1 ADD P P 04020CSR Z-ADDP LINE 30 04030CSR SETON 7276 04040CSR EXSR SR70 PUT DATA. 04050CSR END72 ENDSR 04060C******************************************************************** 04070CSR SR73 BEGSR 04080C* PUT MSG TO CRT. 04090CSR EXSR SR89 04100CSR 54 MOVELM MGTEXT 04110CSR SETON 73 04120CSR EXSR SR70 PUT MSG. 04130CSR ENDSR 04140C******************************************************************** 04150CSR SR76 BEGSR 04160C* END OF ASSY MSG. 04170CSR Z-ADD317 M 04180CSR EXSR SR73 PUT MSG. 04190CSR ENDSR 04200C******************************************************************** 04210CSR SR77 BEGSR 04220C* PRINT TITLE PAGE. 04230CSR EXSR SR68 TOP FORM 04240CSR EXSR SR66 LF 04250CSR EXSR SR66 LF ÐÐ04260CSR EXSR SR66 LF 04270CSR MOVE ' ' A29 04280CSR MOVE 'E' A29,1 04290CSR MOVEASPEMPL A29,2 04300CSR MOVEAA29 W14A 14 04310CSR W14A CHAINEMPLFILE 60 04320CSR 60 GOTO END77 04330CSR SPDEPT LOKUPTABDEP TABNAM 54 04340CSR MOVE TABNAM DEPNAM 17 04350CSR SETON 77 04360CSR EXSR SR65 PRINT 04370CSR END77 ENDSR 04380C******************************************************************** 04390CSR SR81 BEGSR 04400C* GET PART MAST. 04410CSR SETOF 61 04420CSR MOVE ' ' W12A 04430CSR W12A CHAINPMMST2 60 GET PMMST. 04440CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE. 04450CSR ENDSR 04460C******************************************************************* 04470CSR SR82 BEGSR 04480C* GET CRTFILE 04490CSR PORT CHAINCRTFILE H6 04500CSR H6 GOTO END ÐÐ04510CSR ENDSR 04520C******************************************************************* 04530CSR SR83 BEGSR 04540C* UPDATE CRTFILE 04550CSR EXCPT UPDATE CRTFILE 04560CSR SETOF 717273 04570CSR SETOF 747577 04580CSR SETOF 313233 04590CSR ENDSR 04600C****************************************************************** 04610CSR SR89 BEGSR 04620C* GET MGFILE. 04630CSR M CHAINMGFILE 54 GET MGFILE. 04640CSR 54 MOVE BLK35 MGTEXT 04650CSR 54 MOVELM MGTEXT 04660CSR 54 MOVE 'NO MSG' MGTEXT 04670CSR ENDSR 04680C******************************************************************** 04690CSR SR101 BEGSR 04700C* INITIALIZE (1-TIME). 04710CSR EXSR SR68 TOP FORM 04720CSR MOVELBIT,1 BUFLGT 2 04730CSR MOVE ' ' BLK35 35 04740CSR MOVE ' ' BLK12 12 04750CSR MOVE ' ' BLK20 20 ÐÐ04760CSR Z-ADD0 ZERO10 100 04770CSR MOVE ' ' W8A 8 04780CSR Z-ADD0 W2N 20 04790CSR Z-ADD0 W1N 10 04800CSR MOVE ' ' W2A 2 04810CSR EXITFPGMINX GET TERM NO. 04820CSR RLABL W8A 04830CSR RLABL W2N 04840CSR RLABL W1N 04850CSR RLABL W2A 04860CSR MOVE W2A PORT 20 TERM NO. 04870CSR PORT COMP 0 54 04880CSRN54 Z-ADD25 PORT 04890CSR Z-ADD557 M 50 04900CSR EXSR SR73 MOUNT 15-PITCH MSG 04910CSR EXSR SR69 PAUSE 04920CSR Z-ADD558 M MOUNT 11X8-1/2 PAPER 04930CSR EXSR SR73 PUT MSG 04940CSR EXSR SR69 PAUSE 04950CSR MOVE '08' W2A 2 04960CSR EXITFZVMI SET VERT SPACING 04970CSR RLABL W2A 04980CSR MOVE '15' W2A 04990CSR EXITFZHMI SET HORIZ SPACING 05000CSR RLABL W2A ÐÐ05010CSR ENDSR 05020O******************************************************************** 05030OSUSPENSEE 80 05040O APN 109 05050O QAR 125P 05060O 128 'D' 05070O******************************************************************** 05080OCRTFILE E 72 05090O* DATA LINE. 05100O REC 212 05110O 91 '.' 05120O 94 '.' 05130O 97 '.' 05140O 100 '.' 05150O 103 '.' 05160O 106 '.' 05170O 109 '.' 05180O 02 109 ' ' 05190O 03 109 ' ' 05200O L Z 88 05210O LINE Z 83 05220O 01 BMCPN 102 '0 - - ' 05230O 02 BMCPN 105 '0 - - ' 05240O 03 BMCPN 108 '0 - - ' 05250O 04 BMCPN 111 '0 - - ' ÐÐ05260O 05 BMCPN 114 '0 - - ' 05270O 06 BMCPN 117 '0 - - ' 05280O 07 BMCPN 120 '0 - - ' 05290O PMDESC 151 05300O BMQTY 2 162 05310O PMUM 166 05320O PMSC 171 05330O EXTQTYZ 178 05340O PMFABC 183 05350O BMISSU 189 05360O PLT,5 Z 194 05370O PLT,8 Z 198 05380O PMM,2 Z 205 05390O PMRNDFZ 212 05400O*------------------------------------------------------------------- 05410O E 75 05420O* PUT TOP ASSY LINE. 05430O REC 212 05440O 88 '1' 05450O 89 LINE Z 83 05460O TAPN 102 '0 - - ' 05470O N89 109 'CONT''D' 05480O PMDESC 151 05490O 162 '1' 05500O PMUM 166 ÐÐ05510O PMSC 171 05520O QAR,S Z 178 05530O PLT,5 Z 194 05540O PLT,8 Z 200 05550O PMM,2 Z 205 05560O PMRNDFZ 212 05570O PMFABC 183 05580O*------------------------------------------------------------------- 05590O E 73 05600O* PUT ERROR MESSAGE. 05610O REC 212 05620O MGTEXT 115 05630O BIT,8 212 05640O*------------------------------------------------------------------- 05650O E 71 31 05660O* CLEAR SCREEN - LINE-1. 05670O REC 212 05680O UDATE 88 ' - - ' 05690O EGAP Z 98 05700O 95 'PAGE' 05710O 141 'INDENTED PARTS LIST - ' 05720O 151 'MFG PARTS' 05730O 159 'ASSY=' 05740O TAPN 171 ' - - ' 05750O 195 '<----------' ÐÐ05760O 212 '----->' 05770O 204 'INPUT FIELDS' 05780O*------------------------------------------------------------------- 05790O E 71 32 05800O* HEADING, LINE-2. 05810O REC 212 05820O 106 ' <----------INDENTURE' 05830O 120 '------------->' 05840O 85 'LINE ' 05850O 162 'QUANTITY' 05860O 174 'SOURCE' 05870O 178 'EXT' 05880O 183 'FAB' 05890O 189 'ISSUE' 05900O 196 'LEAD' 05910O 205 'MIN' 05920O 212 'ROUND' 05930O*------------------------------------------------------------------- 05940O E 71 33 05950O* HEADING, LINE-3. 05960O REC 212 05970O 88 'LEV' 05980O 84 'ITEM' 05990O 109 '1 2 3 4 5 6 7' 06000O 112 '-UP' ÐÐ06010O 133 'DESCRIPTION' 06020O 162 'PER-ASSY' 06030O 166 'UM' 06040O 173 'CODE' 06050O 178 'QTY' 06060O 184 'CODE' 06070O 189 'CODE' 06080O 194 'ASY' 06090O 198 'PAR' 06100O 205 'ORD' 06110O 211 'FACT' 06120O*------------------------------------------------------------------- 06130O E 77 06140O REC 212 06150O EENAME 180 06160O DEPNAM 212 ** A12 ARRAY 006170 006180** LEV ARRAY 006190 006200** QTY ARRAY 006210 006220** A29 ARRAY 006230 006240/* 006250ÐÐ_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(6G  XRED12 P120282120282(èÈÐ SUBROUTINE ZRED12 (IRPG) 00010* READ 12 BYTES FROM TERMINAL AND RETURN TO RPG PROG 00020 DIMENSION IRPG (6) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 12 00070 ITC = 0 00080 IBELL = $0700 00090 CALL WTREAD (ILU,IXY,IBELL,N1,IXY,IRPG,N2,ITC) 00100 RETURN 00110 END 00120_‚ ÐÐ_‚_‚ SUBROUTINE ZRED12 (IRPG) 00010* READ 12 BYTES FROM TERMINAL AND RETURN TO RPG PROG 00020 DIMENSION IRPG (6) 00030 ILU = 0 00040 IXY = -1 00050 N1 = 2 00060 N2 = 12 00070 ITC = 0 00080 IBELL = $0700 00090 CALL WTREAD (ILU,IXY,IBELL,N1,IXY,IRPG,N2,ITC) 00100 RETURN 00110 END 00120_‚ ÐÈ(26S 2X903PI P999999120282(èÈÐ00010H Q903PI00020F* DELETE POITEM RECORD 00030FBITTAB IP F 33 DISK 00040FPOITEM UC F 384R 9AI 1 DISK 00050IBITTAB BT 00060I 1 33 BIT 00070IPOITEM PI 00080I 384 384 POSTAT 00090C MOVE ' ' W10A 10 00100C EXITFZR10 00110C RLABL W10A 00120C MOVELW10A W9A 9 00130C W9A CHAINPOITEM H9 00140C NH9 EXCPT 00150OPOITEM E NH9 00160O 384 'D' /* _‚ ÐÐ ÐÐ_‚_‚ ÐÈ(X6i XúX107BM P120282120282(èÈÐ00010H Q107BM00020F* PRINT SINGLE LEVEL PARTS LIST. (X107BM) 00030F* REVISED 4/21/81 2:20 PM. *** D I A B L O *** 00040FBITTAB IP F 33 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FBMMAST ID F 86L20AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FCRTFILE UC F 256R DISK 00090FSUSPENSEUD F 128L29AI 1 DISK 00100FEMPLFILEIC F 64R14AI 1 DISK 00110FMENUDEPTIT F 25 EDISK 00120E******************************************************************** 00130E TABIC 1 9 2 TABICN 15 ISSUE CODES. 00140E TABSC 1 6 2 ATABSCN 12 SOURCE CODES. 00150E TABPC 1 7 1 TABPCN 20 PROV CODES. 00160E MENUDEPT TABDEP 1 10 5 0 TABNAM 20 DEPT #/NAME 00170E A29 29 29 1 00180E BIT 33 1 BITTAB FILE. 00190E REC 132 1 00200E APN 8 10 0A SUSPENSE FILE 00210E QAR 8 3 0 SUSPENSE FILE 00220I******************************************************************** 00230IBITTAB BT 00240I 1 33 BIT 00250I******************************************************************** ÐÐ00260ICRTFILE CR 00270I 81 212 REC 00280I******************************************************************** 00290IEMPLFILEEE 00300I 23 42 EENAME 00310I******************************************************************** 00320IPMMST2 PM 00330I* PART MASTER RECORD. 00340I* KEY AREA. 00350I* PART NO. 12A 00360I 1 12 PMPN 00370I* NUMB OF COMPONENTS 3P 00380I P 13 140PMNOBM 00390I* PROD LINE 4N 00400I 15 180PMPL 00410I* MODEL NAME 12A 00420I 19 30 PMMODL 00430I* DESCRIPTION 29A 00440I 31 59 PMDESC 00450I* COMMODITY CODE 9P 00460I P 60 640PMCC 00470I* ENG CHANGE STATUS. 00480I* CUR CHG LEVEL 2A 00490I 70 71 PMECHG 00500I* CUR CHG DATE 6N ÐÐ00510I 72 770PMDCHG 00520I* LAST ECN NO. 5A 00530I 65 69 PMECN 00540I* DRAWING INFO. 00550I* DWG SIZE 1A 00560I 82 82 PMSIZ 00570I* DWG CLASS 1A 00580I* D = DYNAIR DWG 00590I* V = VENDOR DWG 00600I 83 83 PMDCLS 00610I* STANDARD CODE 1A 00620I 84 84 PMSTDC 00630I* DWG REL CODE 1A 00640I* E = ENG ONLY 00650I* M = REL TO MFG 00660I* P = PROTOTYPE 00670I 78 78 PMDREL 00680I* UNIT MEAS 2A 00690I 85 86 PMUM 00700I* SOURCE CODE 2A 00710I* MA = MFG ASSY 00720I* MP = MFG PART 00730I* PA = PURCH ASSY 00740I* PP = PURCH PART 00750I* RD = REF DOC ONLY ÐÐ00760I* RS = RAW STOCK 00770I 94 95 PMSC 00780I* PROVISIONING CODE 1A 00790I* A = FORECAST,NO VALUE ADDED 00800I* B = FORECAST,VALUE ADDED 00810I* C = FRCST-BUILD TO ORDER 00820I* D = NON-FRCST-BUILD TO ORD 00830I* E = CUSTOM 00840I* Y = OBSOLETE,REPAIRABLE 00850I* Z = OBSOLETE,NOT REPAIRABLE 00860I 96 96 PMPROV 00870I* ISSUE CODE 2A 00880I* PT = PULL TIME 00890I* OR = ON REQUEST 00900I* BI = BULK ISSUE 00910I* AR = AS REQUIRED 00920I* VS = VENDOR SUPPLIED 00930I* SD = SHIPPING DOCUMENT 00940I* TD = TRAV DOCUMENT 00950I* RD = REF DOC ONLY 00960I* RA = REF ASSY 00970I 97 98 PMISSU 00980I* DELIVER TO DEPT 5P 00990I P 99 1010PMDEL 01000I* RESPONSIBILITY CODES ÐÐ01010I* ENGR CODE 2A 01020I 102 103 PMEGR 01030I* PLANNER CODE 2A 01040I 104 105 PMPLNR 01050I* BUYER CODE 2A 01060I 106 107 PMBUYR 01070I* SALESMAN CODE 2A 01080I 108 109 PMSLSM 01090I* INVENTORY ACCOUNT 5P 01100I P 110 1120PMACNT 01110I* LOW LEVEL CODE 2N 01120I 430 4310PMLL 01130I* RECORD STATUS 1A 01140I* D = DELETED 01150I 674 674 PMSTAT 01160I******************************************************************** 01170IBMMAST BM 01180I* BILL OF MATERIAL RECORD (XBMREC) 01190I* KEY AREA 01200I* ASSY PART NO. 10N 01210I 1 100BMAPN 01220I* COMPONENT PART NO. 10N 01230I 11 200BMCPN 01240I* ITEM NO. 3N 01250I 25 270BMITNO ÐÐ01260I* QTY PER ASSY 7P 01270I P 28 310BMQTY 01280I* SCRAP ALLOW .2N 01290I 34 352BMSCRP 01300I* ISSUE CODE 2A 01310I* PT = PULL TIME 01320I* OR = ON REQUEST 01330I* BI = BULK ISSUE 01340I* AR = AS REQUIRED 01350I* RA = REF ASSY 01360I* TD = TRAV DOC 01370I* SD = SHIP DOC 01380I* RD = REF DOC 01390I* VS = VENDOR SUPPLIED 01400I 36 37 BMISSU 01410I* EFFECTIVITY. 01420I* BEGIN CHANGE LEVEL 2A 01430I 38 39 BMBCHG 01440I* ENDING CHANGE LEVEL 2A 01450I 40 41 BMECHG 01460I* BEGIN ECN # 5A 01470I 42 46 BMBECN 01480I* ENDING ECN # 5A 01490I 47 51 BMEECN 01500I* DISPOSITION CODE 1A ÐÐ01510I* U = USE UP OLD STYLE 01520I* N = NOW (IMMEDIATE) 01530I 52 52 BMDISP 01540I* FILLER 5A 53 57 FFFFFF 01550I* ROUTING. 01560I* OPER NO. 5P 01570I P 58 600BMOPER 01580I* DEPT NO. 5P 01590I P 61 630BMDEPT 01600I* WORK CENTER NO. 3P 01610I P 64 650BMWC 01620I* COMPONENT OPER REFERENCE INFO 10A 01630I 66 75 BMREF 01640I* FILLER 76 85 FFFFFF 01650I* 01660I* RECORD STATUS 1A 01670I* D = DELETED 01680I 86 86 BMSTAT 01690I******************************************************************** 01700ISUSPENSESP 01710I* SUSPENSE FILE (CONTAINS ASSY PART NO'S.) 01720I* KEY AREA. 01730I* TERMINAL # 2N (NOT USED) 1 2 01740I* RECORD CODE 2A (SL) 01750I 3 4 SPREC ÐÐ01760I* RECORD COUNTER 3N 01770I 5 70SPCNTR 01780I* REQUESTED BY DEPT 5N 01790I 8 120SPDEPT 01800I* EMPLOYEE # 5A 01810I 13 17 SPEMPL 01820I* FILLER 18 29 FFFFFF 01830I* ASSY PART # 10A X 8 01840I 30 109 APN 01850I* ASSY QTYS 3P X 8 01860I P 110 125 QAR 01870I* RECORD STATUS 1A 01880I 128 128 SPSTAT 01890I******************************************************************** 01900IMGFILE MG 01910I* MESSAGE FILE. 01920I* TEXT 35A 01930I 1 35 MGTEXT 01940I* LINE-2 35A 01950I 36 70 MGLIN2 01960I* PROG NAME 5A 01970I 71 75 MGPROG 01980C******************************************************************** 01990C* INITIALIZE. 02000C EXSR SR101 INIT. ÐÐ02010C Z-ADD0 ZERO10 100 02020C H9 GOTO ENDJOB PROG ERROR. 02030C MOVE ' ' A29 02040C MOVEA'SL' A29,3 02050C MOVEAA29 W29A 29 02060C W29A SETLLSUSPENSE SET LOW LIMIT 02070C*------------------------------------------------------------------- 02080C BEGIN TAG 02090C* GET SUSPENSE RECORD. 02100C SETOF 54 02110C READ SUSPENSE 54 02120C 54 GOTO ENDJOB END OF FILE. 02130C SPREC COMP 'SL' 54 MATCH SUSPENSE 02140C N54 GOTO ENDJOB NO MATCH. 02150C SPSTAT COMP 'D' 54 02160C 54 GOTO BEGIN DELETED. 02170C ZERO10 LOKUPAPN 54 02180C N54 GOTO START 02190C EXSR SR77 TITLE PAGE 02200C*------------------------------------------------------------------- 02210C START TAG 02220C* GET PART NO. 02230C Z-ADD1 S 30 02240C ZERO10 LOKUPAPN,S 54 02250C N54 EXSR SR80 UPDATE SUSPENSE ÐÐ02260C N54 GOTO BEGIN 02270C QAR,S COMP 0 54 02280C N54 Z-ADD1 QAR,S 02290C MOVE BLK12 W12A 12 02300C MOVELAPN,S W12A 02310C Z-ADDAPN,S CURASY 100 02320C EXSR SR81 GET PART MAST. 02330C N60 GOTO SETUP GOT IT. 02340C* FLAG NO MAST ERROR. 02350C Z-ADD302 M 50 96 02360C M CHAINMGFILE 54 02370C EXSR SR73 PUT MSG 02380C Z-ADD0 APN,S 02390C GOTO START 02400C*------------------------------------------------------------------- 02410C SETUP TAG 02420C* FLAG NO COMPONENTS ON FILE. 02430C PMNOBM COMP 0 55 02440C N55 Z-ADD316 M 96 FLAG ERROR 02450C N55 EXSR SR73 PUT MSG 02460C N55 Z-ADD0 APN,S 02470C N55 GOTO START 02480C* SAVE ASSY DATA. 02490C MOVELPMPN TAPN 100 02500C MOVE PMDESC ADESC 29 ÐÐ02510C MOVE PMMODL AMODL 12 02520C MOVE PMPROV APROV 1 02530C MOVE PMSC ASC 2 02540C MOVE PMISSU AISSU 2 02550C Z-ADDPMPL APL 40 02560C MOVE PMECHG AECHG 2 02570C MOVE PMECN AECN 5 02580C* PUT ASSY DATA TO CRT. 02590C PMPROV LOKUPTABPC TABPCN 40 02600C PMISSU LOKUPTABIC TABICN 41 02610C PMSC LOKUPTABSC TABSCN 42 02620C Z-ADD0 EGAP 02630C EXSR SR71 PUT HEADING. 02640C MOVELAPN,S W20A 20 02650C MOVE ZERO10 W20A 02660C*--------------------------------------------------------------- 02670C SETLIM TAG 02680C W20A SETLLBMMAST 02690C*------------------------------------------------------------------- 02700C CHASE TAG 02710C* GET NEXT BILL MATL RECORD. 02720C SETOF 54 02730C READ BMMAST 54 GET BMMAST. 02740C 54 GOTO ENDASY PROG ERROR. 02750C BMAPN COMP CURASY 54 ÐÐ02760C N54 GOTO ENDASY 02770C BMSTAT COMP 'D' 54 02780C 54 GOTO CHASE 02790C* GET COMPONENT PART MASTER. 02800C MOVE BLK12 W12A 02810C MOVELBMCPN W12A 02820C EXSR SR81 GET PMMST2 02830C* PUT TO CRT. 02840C QAR,S MULT BMQTY EXTQTY 70 02850C MOVELBMCPN NUMPN 100 02860C EXSR SR72 PUT CMPNT DATA. 02870C*------------------------------------------------------------------- 02880C ENDPAG TAG 02890C* SEE IF END OF PAGE. 02900C LINENO COMP 60 54 54 LINE #. 02910C 54 EXSR SR71 PUT HEADING. 02920C GOTO CHASE 02930C*------------------------------------------------------------------- 02940C ENDASY TAG 02950C* PUT END OF ASSY MSG. 02960C Z-ADD350 M 02970C EXSR SR73 PUT MSG. 02980C Z-ADD0 APN,S 02990C GOTO START NEW COMPONENT 03000C END TAG ÐÐ03010C*------------------------------------------------------------------- 03020C ENDJOB TAG 03030C SETON LR 03040C EXSR SR68 TOP FORM 03050C EXSR SR68 TOP FORM 03060C******************************************************************** 03070CSR SR67 BEGSR 03080C* LINE FEED. 03090CSR EXITFQCLF LF 03100CSR 1 ADD LINENO LINENO 30 03110CSR ENDSR 03120C******************************************************************** 03130CSR SR68 BEGSR 03140C* TOP OF FORM. 03150CSR EXITFQTOPF TOP OF FORM 03160CSR 1 ADD EGAP EGAP 40 PAGE # 03170CSR ENDSR 03180C******************************************************************** 03190CSR SR69 BEGSR 03200C* PRINT. 03210CSR EXSR SR67 LF 03220CSR PORT CHAINCRTFILE H8 03230CSR H8 GOTO END69 03240CSR MOVE ' ' REC 03250CSR EXCPT PRINT IMAGE TO DISK ÐÐ03260CSR SETOF 313233 03270CSR SETOF 343536 03280CSR SETOF 373839 03290CSR SETOF 727477 03300CSR PORT CHAINCRTFILE 54 03310CSR MOVEAREC,1 W148A 148 03320CSR EXITFZD148 PUT DIABLO. 03330CSR RLABL W148A 03340CSR END69 ENDSR 03350C******************************************************************** 03360CSR SR71 BEGSR 03370C* PUT HEADING. 03380CSR EXSR SR68 TOP FORM. 03390CSR SETON 31 03400CSR EXSR SR69 PRINT. 03410CSR SETON 32 03420CSR EXSR SR69 PRINT. 03430CSR SETON 33 03440CSR EXSR SR69 PRINT. 03450CSR SETON 34 03460CSR EXSR SR69 PRINT. 03470CSR SETON 35 03480CSR EXSR SR69 PRINT. 03490CSR SETON 36 03500CSR EXSR SR69 PRINT. ÐÐ03510CSR SETON 37 03520CSR EXSR SR69 PRINT. 03530CSR SETON 38 03540CSR EXSR SR69 PRINT. 03550CSR SETON 39 03560CSR EXSR SR69 PRINT 03570CSR EXSR SR67 LF 03580CSR ENDSR 03590C******************************************************************** 03600CSR SR72 BEGSR 03610C* PUT COMPONENT DATA TO DIABLO. 03620CSR PMMODL COMP BLK12 54 03630CSR 54 MOVE BLK35 PMDESC 03640CSR 54 MOVELPMMODL PMDESC 03650CSR 54 MOVE '***' PMDESC 03660CSR SETON 72 03670CSR EXSR SR69 PRINT. 03680CSR ENDSR 03690C******************************************************************** 03700CSR SR73 BEGSR 03710C* PUT MESSAGE. 03720CSR M CHAINMGFILE 54 GET MSG. 03730CSR 54 MOVE BLK35 MGTEXT 03740CSR 54 MOVEL'??????' MGTEXT 03750CSR SETON 73 ÐÐ03760CSR EXSR SR69 PUT MSG 03770CSR ENDSR 03780C******************************************************************** 03790CSR SR77 BEGSR 03800C* PRINT TITLE PAGE. 03810CSR EXSR SR68 TOP FORM 03820CSR EXSR SR67 LF 03830CSR EXSR SR67 LF 03840CSR MOVE ' ' A29 03850CSR MOVE 'E' A29,1 03860CSR MOVEASPEMPL A29,2 03870CSR MOVEAA29 W14A 14 03880CSR W14A CHAINEMPLFILE 60 03890CSR 60 GOTO END77 03900CSR SPDEPT LOKUPTABDEP TABNAM 54 03910CSR MOVELTABNAM DEPNAM 20 03920CSR SETON 77 03930CSR EXSR SR69 PRINT 03940CSR END77 ENDSR 03950C******************************************************************** 03960CSR SR80 BEGSR 03970C* UPDATE SUSPENSE. 03980CSR SETON 80 03990CSR EXCPT 04000CSR SETOF 80 ÐÐ04010CSR ENDSR 04020C******************************************************************** 04030CSR SR81 BEGSR 04040C* GET PART MAST. 04050CSR MOVE ' ' W12A 04060CSR W12A CHAINPMMST2 60 04070CSRN60 PMSTAT COMP 'D' 60 04080CSR ENDSR 04090C******************************************************************** 04100CSR SR101 BEGSR 04110C* 1-TIME INITIALIZE. 04120CSR MOVE ' ' BLK12 12 04130CSR MOVE ' ' BLK35 35 04140CSR Z-ADD0 ZERO10 100 04150C* GET PORT # AND CRTFILE. 04160CSR MOVE ' ' W8A 8 04170CSR Z-ADD0 W2N 20 04180CSR Z-ADD0 W1N 10 04190CSR MOVE ' ' W2A 2 04200CSR EXITFPGMINX GET PORT #. 04210CSR RLABL W8A 04220CSR RLABL W2N 04230CSR RLABL W1N 04240CSR RLABL W2A 04250CSR MOVE W2A PORT 20 PORT NO. ÐÐ04260CSR PORT COMP 0 54 04270CSRN54 Z-ADD25 PORT DEFAULT 04280CSR PORT CHAINCRTFILE H9 04290CSR H9 GOTO END101 04300CSR Z-ADD557 M 50 04310CSR EXSR SR73 MOUNT 15-PITCH MSG 04320CSR EXSR SR69 PAUSE 04330CSR Z-ADD558 M MOUNT 11X8-1/2 PAPER 04340CSR EXSR SR73 PUT MSG 04350CSR EXSR SR69 PAUSE 04360CSR MOVE '08' W2A 2 04370CSR EXITFZVMI SET VERTICAL SPACING 04380CSR RLABL W2A 04390CSR MOVE '15' W2A 04400CSR EXITFZHMI SET HORIZ SPACING 04410CSR RLABL W2A 04420CSR END101 ENDSR 04430O******************************************************************** 04440OSUSPENSEE 80 04450O APN 109 04460O QAR 125P 04470O 128 'D' 04480O******************************************************************** 04490OCRTFILE E 74 1254004500O* PUT MSG TO CRT 12550ÐÐ04510O REC 212 04520O MGTEXT 115 04530O 117 ' ' 04540O 96 BIT,8 212 04550O*------------------------------------------------------------------- 04560O E 31 04570O REC 212 04580O*------------------------------------------------------------------- 04590O E 32 04600O REC 212 04610O* PUT HEADINGS 04620O 155 'SINGLE LEVEL PARTS LIST ' 04630O 169 'REQUESTED BY:' 04640O TABNAM 191 04650O UDATE Y 88 04660O 207 'PAGE' 04670O EGAP Z 212 04680O E 33 04690O REC 212 04700O 207 'CHG LAST' 04710O E 34 04720O REC 212 04730O 90 'ASSY-PART#' 04740O 114 '<-------DESCRIPTION' 04750O 123 '-------->' ÐÐ04760O 136 'MODEL-NAME' 04770O 150 'SOURCE-CODE' 04780O 162 'ISSUE-CODE' 04790O 181 'PROVISIONING-CODE' 04800O 194 'PROD-LINE' 04810O 206 'LEV ECN' 04820O 212 'QTY' 04830O E 35 04840O* PUT ASSY DATA LINES 04850O REC 212 04860O TAPN 92 ' - - ' 04870O ADESC 123 04880O AMODL 137 04890O ASC 141 04900O AISSU 153 04910O APROV 154 04920O APL Z 191 04930O AECHG 200 04940O AECN 208 04950O E 36 04960O REC 212 04970O 42 TABSCN 149 04980O 41 TABICN 166 04990O 40 TABPCN 184 05000O QAR,S 2 212 ÐÐ05010O E 37 05020O REC 212 05030O E 38 05040O REC 212 05050O 84 'ITEM' 05060O 95 'COMPONENT' 05070O 139 'QUANTITY' 05080O 160 'SOURCE ISSUE ENG' 05090O 168 'SCRAP' 05100O 191 '<-----ROUTING------->' 05110O 207 '<--E.C.N.--->' 05120O E 39 05130O REC 212 05140O 83 'NO' 05150O 94 'PART-NO' 05160O 119 '<-------DESCRIPTION' 05170O 129 '--------->' 05180O 139 'PER-ASSY' 05190O 143 'UM' 05200O 149 'CODE' 05210O 155 'CODE' 05220O 161 'STD ' 05230O 168 'ALLOW' 05240O 174 'OPER' 05250O 180 'DEPT' ÐÐ05260O 191 'REFERENCE' 05270O 199 'START' 05280O 207 'STOP' 05290O E 72 05300O* PUT COMPONENT DATA LINE. 05310O REC 212 05320O BMITNOZ 83 05330O NUMPN 98 ' - - ' 05340O PMDESC 129 05350O EXTQTY2 139 05360O PMUM 143 05370O PMSC 148 05380O BMISSU 154 05390O PMSTDC 159 05400O BMSCRP2 166 05410O 167 '%' 05420O BMOPERZ 174 05430O BMDEPTZ 180 05440O BMREF 192 05450O BMBECN 198 05460O BMBCHG 201 05470O BMEECN 208 05480O BMECHG 211 05490O*------------------------------------------------------------------- 05500O E 77 ÐÐ05510O REC 212 05520O EENAME 190 05530O DEPNAM 212 ** TABIC/TABICN VALID ISSUE CODES 005540PTPULL TIME 005550ORON REQUEST 005560BIBULK ISSUE 005570ARAS REQD 005580VSVENDOR SUPL'D 005590SDSHIPPING DOCUMENT 005600TDTRAVELER DOCUMENT 005610RDREF DOC ONLY 005620RAREF ASSY/PART 005630** TABSC/TABSCN VALID SOURCE CODES 005640MAMFG ASSY 005650MPMFG PART 005660PAPURCH ASSY 005670PPPURCH PART 005680RDREF DOC ONLY 005690RSRAW STOCK 005700** TABPC/TABPCN VALID PROVISION CODES 005710AFRCST,NO VAL ADDED 005720BFRCST,VAL IS ADDED 005730CBLD/ORD,NO VAL ADDED 005740DBLD TO ORD,VAL ADDED 005750ÐÐECUSTOM 005760YOBSLT, REPAIRABLE 005770ZOBSLT,NOT REPAIR 005780** A29 ARRAY 005790 005800/* 005810_‚ ÐÐ_‚_‚TOM 005760YOBSLT, REPAIRABLE 005770ZOBSLT,NOT REPAIR 005780** A29 ARRAY 005790 005800/* 005810_‚ ÐÈ(È7d ÈTX107PM P120282120282(èÈÐ00010H Q107PM00020F* QUICKIE INPUT MIN/MAX STOCK QTYS. (X107PM) 00030F* REVISED 2/11/81 11:10 AM. 00040FKPDATA IP F 192 14AI 1 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060FBMWU ID F 21L20AI 1 DISK 00070FBMMAST UC F 86R20AI 1 DISK 00080I******************************************************************** 00090IKPDATA KP 01 00100I 22 310QPN 00110I 37 410QMIN 00120I 52 560QMAX 00130I******************************************************************** 00140IPMMST2 PM 00150I P 143 1460PMMAX 00160I P 163 1660PMSSTK 00170I******************************************************************** 00180IBMMAST BM 00190I 1 100BMAPN 00200I 11 200BMCPN 00210I 36 37 BMISSU 00220I******************************************************************** 00230IBMWU WU 00240I 1 100WUCPN 00250I 11 200WUAPN ÐÐ00260I 21 21 WUSTAT 00270C******************************************************************** 00280C MOVELQPN W12A 12 00290C W12A CHAINPMMST2 60 00300C 60 GOTO END 00310C Z-ADDQMIN PMSSTK 00320C Z-ADDQMAX PMMAX 00330C SETON 80 00340C EXCPT 00350C SETOF 80 00360C MOVELQPN WUKEY 20 00370C WUKEY SETLLBMWU 00380C*------------------------------------------------------------------- 00390C TAG10 TAG 00400C SETOF 54 00410C READ BMWU 54 00420C 54 GOTO END 00430C WUCPN COMP QPN 54 00440C N54 GOTO END 00450C WUSTAT COMP 'D' 54 00460C 54 GOTO TAG10 00470C MOVELWUAPN W20A 20 00480C MOVE WUCPN W20A 00490C W20A CHAINBMMAST 54 00500C 54 GOTO TAG10 ÐÐ00510C SETON 81 00520C EXCPT 00530C SETOF 81 00540C GOTO TAG10 00550C*------------------------------------------------------------------- 00560C END TAG 00570O******************************************************************** 00580OPMMST2 E 80 00590O 98 'BI' 00600O PMMAX 146P 00610O PMSSTK 166P 00620O******************************************************************** 00630OBMMAST E 81 00640O 37 'BI' /* 000650_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(X7¹ XúX010RM PÂ120282120282(èÈÐ00010H Q010RM00020F* DISPLAY ROUTING - OPERATION SEQ WITHIN PART NO. (X010RM) 00030F* REVISED 10-06-81 11:30 AM. 00040F* MAY BE CALLED FROM Q002RM,Q011RM,Q002RX. DG-REL006 OK. 00050FBITHEX IP F 256 DISK 00060FCRTFILE IC F 256R DISK 00070FMGFILE IC F 80R DISK 00080FRMMAST ID F 140L15AI 1 DISK 00090FREXTPTR ID F 25L21AI 1 DISK 00100FREXTFILEIC F 90R DISK 00110FPMMST2 IC F 674R12AI 1 DISK 00120FWCMAST IC F 960R 8AI 1 DISK 00130FTERM132 O F 132 5 00140F**************************************************************** 00150E NUL 1 132 1 NULL CHAR 00160E A12 12 12 1 A INPUT DATA ARRAY 00170E MES 1 1 30 00180E TABTRN 1 3 1 TABNAM 6 TRAN NAMES 00190E TABMET 1 2 1 TABMN 12 METHOD NAMES 00200E* 00210E BIT 256 1 SCREEN CONTR. CHAR 00220E CALL 5 6 00230E TXT 60 1 A 00240E* 00250I******************************************************************* ÐÐ00260IBITHEX BT 00270I 1 256 BIT 00280I****************************************************************** 00290ICRTFILE CR 00300I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00310I* STD AREA - SAME FOR ALL PROGRAMS. 00320I* EMPLOYEE # 5N 00330I 1 50CREMPL 00340I* USER CODE 8A 00350I 6 13 CRUSER 00360I* DEPT # 5N 00370I 14 180CRDEPT 00380I* JOB NAME 8A (JOB LOADED BY MENU) 00390I 19 26 CRJOB 00400I* SHUTDOWN FLAG 1A 00410I* BLANK = NO SHUTDOWN 00420I 27 27 CRSHUT 00430I* TIME STARTED 6N 00440I 28 330CRTIME 00450I* DATE STARTED 4N 00460I 34 370CRDATE 00470I* CALL STACK 5 X 6A 00480I 38 67 CALL 00490I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00500I 68 73 CRRET ÐÐ00510I* MENU NAME 6A 00520I 74 79 CRMENU 00530I*------------------------------------------------------------------- 00540I* PROGRAM AREA - ROUTING FIELDS. 00550I* KEY AREA. 00560I* PART # 12A 00570I 80 91 CRPN 00580I* OPER SEQ # 3N 00590I 92 940CRSEQ 00600I******************************************************************* 00610IMGFILE MG 00620I* MESSAGE FILE. 00630I 1 35 MGTEXT 00640I******************************************************************** 00650IRMMAST RM 00660I* ROUTING MASTER. 00670I* KEY AREA. 00680I* PART # 12A 00690I 1 12 RMPN 00700I* OPER SEQ # 3N 00710I 13 150RMSEQ 00720I* OPER GROUP CODE 2N 00730I 16 170RMGRUP 00740I* OVERLAP % .2N 00750I 18 192RMOVLP ÐÐ00760I* OPER CODE 5A 00770I 20 24 RMOPER 00780I* OPER DEPT. 00790I* DEPT # 5P 00800I P 25 270RMDEPT 00810I* WORK CENTER 3P 00820I P 28 290RMWC 00830I* OPER DESCRIPTION 40A 00840I 30 69 RMDESC 00850I* LABOR STDS. 00860I* ACCOUNTING STD. 00870I* DATE ADOPTED 7P 00880I P 70 730RMADAT 00890I* SET-UP 9.3P 00900I P 74 783RMASU 00910I* RUN 9.3P 00920I P 79 833RMARUN 00930I* MIN CHARGE 7.2P 00940I P 84 872RMAMIN 00950I* STD LOT SIZE 7P 00960I P 88 910RMALOT 00970I* REVISED STDS. 00980I* DATE LAST REVISED 7P 00990I P 92 950RMRDAT 01000I* SET-UP 9.3P ÐÐ01010I P 96 1003RMRSU 01020I* RUN 9.3P 01030I P 101 1053RMRRUN 01040I* MIN. CHARGE 7.2P 01050I P 106 1092RMRMIN 01060I* STD LOT SIZE 7P 01070I P 110 1130RMRLOT 01080I* METHOD ESTAB 1A 01090I 114 114 RMMETH 01100I* JOB SKILL 5A 01110I 115 119 RMSKIL 01120I* PERFORM FACTOR. 01130I* ACTUAL 5.2P 01140I P 120 1222RMPER 01150I* ASSIGNED 5.2P 01160I P 123 1252RMPER2 01170I* NUMB LOTS RUN 5P 01180I P 126 1280RMLRUN 01190I* NUMB UNITS RUN 5P 01200I P 129 1310RMQRUN 01210I* FILLER 132 139 FFFFFF 01220I* RECORD STATUS 1A 01230I 140 140 RMSTAT 01240I******************************************************************** 01250IREXTPTR TP ÐÐ01260I* TEXT POINTER FILE. 01270I* PART # 12A 01280I 1 12 TPPN 01290I* OPER SEQ # 3N 01300I 13 150TPSEQ 01310I* LINE # 6N 01320I 16 210TPLINE 01330I* POINTER 7P 01340I P 22 250TPPTR 01350I******************************************************************** 01360IREXTFILETX 01370I* REXTFILE RECORD. 01380I* PART # 12A 01390I 1 12 TXPN 01400I* OPER SEQ # EN 01410I 13 150TXSEQ 01420I* LINE # 6N 01430I 16 210TXLINE 01440I* TEXT 1A X 60 01450I 22 81 TXT 01460I* BACKWARD PTR (DELETE) 7P 01470I P 82 850TXBPTR 01480I* RECORD STATUS 1A 01490I 90 90 TXSTAT 01500I******************************************************************** ÐÐ01510IPMMST2 PM 01520I 1 12 PMPN 01530I 15 180PMPROD 01540I 19 30 PMMODL 01550I 31 59 PMDESC 01560I 94 95 PMSC 01570I 487 488 PMFAB 01580I 674 674 PMSTAT 01590I******************************************************************** 01600IWCMAST WC 01610I* WORK CENTER MASTER. 01620I* NAME 29A 01630I 8 37 WCNAME 01640I* SET-UP RATE 5.2P 01650I P 47 492WCLRAT 01660I* RUN RATE 5.2P 01670I P 50 522WCRRAT 01680I* BURDEN RATE 5.2P 01690I P 53 552WCBRAT 01700C******************************************************************** 01710C* INITIALIZE 01720C EXSR SR101 1-TIME INIT 01730C*------------------------------------------------------------------ 01740C UPDATE TAG 01750C* DISPLAY DATA BASE. ÐÐ01760C SETOF 909192 01770C SETOF 939498 01780C SETOF 898887 01790C SETOF 8685 01800C EXSR SR106 DISPLAY. 01810C 96 GOTO ERROR ERROR 01820C* SET-UP LINKAGE TO NEXT PROGRAM AFTER UPDATE 01830C 98 GOTO GOODBY 01840C 94 GOTO MENU 01850C 93 GOTO NEWITM 01860C MOVELCRRET PROG 8 01870C GOTO END 01880C*-------------------------------------------------------------------- 01890C ERROR TAG 01900C EXSR SR73 PUT MSG 01910C MOVELCRRET PROG 01920C GOTO END 01930C*------------------------------------------------------------------ 01940C NEWITM TAG 01950C* SET-UP LINK FOR NEW ITEM 01960C MOVELCRRET PROG 01970C GOTO END 01980C*------------------------------------------------------------------- 01990C MENU TAG 02000C* SET-UP LINK TO MENU ÐÐ02010C CRRET COMP 'Q011RM' 54 02020C 54 MOVEL'Q011RM' PROG 8 02030C N54 MOVELCRMENU PROG 8 02040C GOTO END 02050C*-------------------------------------------------------------------- 02060C GOODBY TAG 02070C* LINK TO SIGN-OFF 02080C MOVEL'GOODBY' PROG 02090C GOTO END 02100C*------------------------------------------------------------------- 02110C END TAG 02120C PROG COMP BLK8 54 02130C N54 MOVEL'Q001RM' PROG 02140C EXITFCHAIN LINK TO NEXT PROG 02150C RLABL PROG 02160C************************************************************** 02170CSR SR70 BEGSR 02180C* PUT FIELD MGTEXT TO TERMINAL 02190CSR SETON 73 02200CSR EXCPT 02210CSR SETOF 73 02220CSR ENDSR 02230C******************************************************************** 02240CSR SR71 BEGSR 02250C* PUT HEADING. ÐÐ02260CSR Z-ADD5 LINENO 30 02270CSR 79 3 ADD LINENO LINENO 02280CSR MOVELASYSC SC1 1 02290CSR SC1 COMP 'M' 54 02300CSR SETON 71 02310CSR EXCPT PUT HEADING. 02320CSR SETOF 7179 02330CSR ENDSR 02340C********************************************************************* 02350CSR SR72 BEGSR 02360C* PUT OPER TO TERMINAL 02370CSR SC1 COMP 'M' 54 02380CSR RMWC COMP 0 55 02390CSR SETON 72 02400CSR EXCPT PUT DATA 02410CSR SETOF 72 02420CSR 1 ADD LINENO LINENO 02430CSRN70 01 1 ADD LINENO LINENO 02440CSR ENDSR 02450C*********************************************************************** 02460CSR SR73 BEGSR 02470C* PUT ERROR MESSAGE TO TERMINAL 02480CSR EXSR SR89 GET MGFILE 02490CSR EXSR SR70 PUT MSG 02500CSR 96 Z-ADDM LSTERR 50 ÐÐ02510CSR ENDSR 02520C******************************************************************** 02530CSR SR74 BEGSR 02540C* PUT TEXT TO TERM. 02550CSR SETON 74 02560CSR EXCPT 02570CSR SETOF 74 02580CSR ENDSR 02590C******************************************************************* 02600CSR SR75 BEGSR 02610C* READ FROM TERMINAL 02620CSR SETOF 779096 02630CSR SETOF 939291 02640CSR SETOF 898887 02650CSR SETOF 8685 02660CSR MOVE BIT,7 BUFLGT BUF LENGTH 02670CSR MOVE BLK12 W12A 12 BUFFER 02680CSR EXITFQWREED READ TERM 02690CSR RLABL W12A 02700CSR RLABL BUFLGT 02710CSR MOVEAW12A A12 02720CSR MOVE BLK12 W12A 02730CSR Z-ADD1 W 30 02740CSR '\' LOKUPA12,W 90 FLAG ESC 02750CSRN90 GOTO T75B NOT ESC ÐÐ02760CSR 1 ADD W W 02770CSR W COMP 12 54 02780CSR 54 GOTO T75A BAD ESC 02790CSR A12,W COMP 'G' 98 GOODBY 02800CSR A12,W COMP 'E' 94 MENU 02810CSR A12,W COMP 'N' 93 NEW ITEM 02820CSR A12,W COMP 'J' 92 JUMP 02830CSR A12,W COMP 'F' 91 SKIP FRWRD 02840CSR A12,W COMP 'B' 89 SKIP BKWRD 02850CSR A12,W COMP 'S' 88 SPACE FILL 02860CSR A12,W COMP 'H' 87 HOME 02870CSR A12,W COMP 'U' 86 UPDATE 02880CSR A12,W COMP 'R' 85 REPEAT 02890CSR 98 02900COR 94 02910COR 93 02920COR 92 02930COR 91 02940COR 89 02950COR 88 02960COR 87 02970COR 86 02980COR 85 GOTO END75 GOOD ESC 02990C*------------------------------------------------------------------ 03000CSR T75A TAG ÐÐ03010C* FLAG BAD ESC INPUT 03020CSR Z-ADD318 M 50 96 FLAG ERROR 03030CSR GOTO END75 03040C*-------------------------------------------------------------------- 03050CSR T75B TAG 03060C* MOVE DATA 03070CSR Z-ADD1 W 03080CSR ' ' LOKUPA12,W 77 03090CSR 77 MOVEAA12,W W12A INPUT DATA 03100CSR EXSR SR202 R.J. 03110C*-------------------------------------------------------------------- 03120CSR END75 TAG 03130C* INIT PREV ERROR MSG. 03140CSR LSTERR COMP 0 54 03150CSR 54 MOVE BLK35 MGTEXT 03160CSR 54 EXSR SR70 BLANK MESSAGE 03170CSR Z-ADD0 LSTERR 50 03180CSR ENDSR 03190C********************************************************************** 03200CSR SR89 BEGSR 03210C* GET MESSAGE MASTER 03220CSR M CHAINMGFILE 54 03230CSR 54 MOVE BLK35 MGTEXT 03240CSR 54 MOVELM MGTEXT 03250CSR 54 MOVE MES,1 MGTEXT ÐÐ03260CSR ENDSR 03270C*********************************************************************** 03280CSR SR101 BEGSR 03290C* 1-TIME INITIALIZE 03300CSR MOVE BIT,1 NUL 03310CSR MOVELBIT,1 BUFLGT 2 03320CSR Z-ADD2 FLIMIT 30 TOTAL NUMB FIELDS 03330CSR MOVE ' ' BLK12 12 03340C* GET CRTFILE. 03350CSR MOVE ' ' W2A 2 03360CSR EXITFZGMINX GET PORT #. 03370CSR RLABL W2A 03380CSR MOVE W2A PORT 20 03390CSR PORT COMP 0 54 03400CSRN54 Z-ADD25 PORT 03410CSR PORT CHAINCRTFILE H9 03420CSR H9 GOTO END101 03430C* DEFINE WORK FIELDS,ETC. 03440CSR MOVE ' ' BLK35 35 03450CSR MOVE ' ' BLK40 40 03460CSR MOVE ' ' BLK8 8 03470CSR END101 ENDSR 03480C******************************************************************** 03490CSR SR106 BEGSR 03500C* DISPLAY ROUTING. ÐÐ03510CSR SETOF 70 03520CSR MOVELCRPN W15A 15 03530CSR MOVE ' ' W15A 03540CSR W15A SETLLRMMAST 03550CSR MOVE CRPN LASTPN 12 03560C*------------------------------------------------------------------- 03570CSR T106A TAG 03580CSR SETOF 54 03590CSR READ RMMAST 54 03600CSR 54 GOTO T106E END FILE. 03610CSR RMSTAT COMP 'D' 54 03620CSR 54 GOTO T106A DELETED. 03630CSR RMPN COMP LASTPN 54 03640CSRN70 03650COR 54 GOTO T106B 03660CSR Z-ADD548 M 03670CSR EXSR SR73 PUT END ITEM MSG 03680CSR EXSR SR75 END OF ITEM 03690CSR 90 GOTO END106 03700CSR 77 MOVELW10A CRPN 03710CSRN77 MOVE RMPN CRPN 03720CSR MOVE '*' NUL 03730CSR SETON 78 03740CSR EXCPT PUT DIVIDER 03750CSR SETOF 78 ÐÐ03760CSR MOVE BIT,1 NUL 03770CSR GOTO SR106 03780C*------------------------------------------------------------------- 03790CSR T106B TAG 03800CSR MOVE RMPN LASTPN 03810CSRN70 MOVELRMPN NUMPN 100 03820CSRN70 RMPN CHAINPMMST2 54 03830CSRN70 54 GOTO T106E 03840CSRN70 MOVE PMSC ASYSC 2 03850CSRN70 EXSR SR71 PUT HDG 03860CSR EXSR SR72 PUT DATA. 03870CSR SETON 70 03880CSR LINENO COMP 25 54 03890CSRN54 GOTO T106C NOT END PAGE. 03900CSR Z-ADD320 M 03910CSR EXSR SR73 END PAGE MSG 03920CSR EXSR SR75 READ. 03930CSR 90 GOTO END106 ESC INPUT. 03940CSR 77 MOVELW10A CRPN 03950CSR 77 GOTO SR106 03960CSR SETON 79 03970CSR EXSR SR71 NEW PAGE 03980C*------------------------------------------------------------------- 03990CSR T106C TAG 04000CSR EXSR SR203 DISPLAY TEXT. ÐÐ04010CSR 90 GOTO END106 ESCAPE 04020CSR 77 MOVELW10A CRPN 04030CSR 77 GOTO SR106 04040CSR GOTO T106A 04050C*------------------------------------------------------------------- 04060CSR T106E TAG 04070C* PUT END FILE MSG. 04080CSR Z-ADD327 M 04090CSR EXSR SR73 END FILE MSG 04100CSR EXSR SR75 READ 04110CSR 90 GOTO END106 04120CSR 77 MOVELW10A CRPN 04130CSR 77 GOTO SR106 04140CSR END106 ENDSR 04150C******************************************************************** 04160CSR SR202 BEGSR 04170C* RIGHT JUSTIFY 04180CSR Z-ADD10 W2N 20 04190CSR MOVELW12A W10A 10 04200CSR EXIT SUBRAJ R. JUSTIFY 04210CSR RLABL W2N 04220CSR RLABL W10A 04230CSR ENDSR 04240C******************************************************************** 04250CSR SR203 BEGSR ÐÐ04260C* DISPLAY TEXT (IF ANY) FOR LAST OPER DISPLAYED. 04270CSR SETOF 909677 04280CSR MOVELRMPN W15A 15 04290CSR MOVE RMSEQ W15A 04300CSR MOVELW15A W21A 21 04310CSR MOVE '000000' W21A 21 04320CSR W21A SETLLREXTPTR 04330C*------------------------------------------------------------------- 04340CSR T203A TAG 04350CSR SETOF 54 04360CSR READ REXTPTR 54 04370CSR 54 GOTO END203 04380CSR TPPN COMP RMPN 54 04390CSR 54 TPSEQ COMP RMSEQ 54 04400CSRN54 GOTO END203 04410CSR TPPTR COMP 0 54 04420CSRN54 GOTO T203A 04430CSR TPPTR CHAINREXTFILE 04440CSR EXSR SR74 DISPLAY TEXT. 04450CSR 1 ADD LINENO LINENO 04460CSR LINENO COMP 25 54 04470CSRN54 GOTO T203A NOT END PAGE 04480CSR Z-ADD320 M 04490CSR EXSR SR73 END PAGE MSG 04500CSR EXSR SR75 READ ÐÐ04510CSR 77 04520COR 90 GOTO END203 ESCAPE 04530CSR SETON 79 04540CSR EXSR SR71 NEW PAGE 04550CSR GOTO T203A 04560CSR END203 ENDSR 04570O******************************************************************** 04580OTERM132 E 71 04590O E 71 04600O* PUT DATA AND HEADINGS. 04610O 71 'ROUTING OPERATION INQUIR' 04620O 72 'Y' 04630O*------------------------------------------------------------------- 04640O E 71 04650O*------------------------------------------------------------------- 04660O E 71 04670O 51 'SOURCE' 04680O 56 'FAB' 04690O 11 'PART-NUMBER' 04700O 25 'DESCRIPTION' 04710O 68 'MODEL-NO.' 04720O 82 'PROD-LINE' 04730O*------------------------------------------------------------------- 04740O E 71 04750O*------------------------------------------------------------------- ÐÐ04760O E 72N70 04770O OR 79 04780O NUMPN 12 ' - - ' 04790O PMDESC 43 04800O PMSC 49 04810O PMFAB 56 04820O PMMODL 71 04830O PMPROD 84 04840O N54 132 '*** NOT MFD PART ***' 04850O*------------------------------------------------------------------- 04860O E 72N70 04870O OR 79 04880O 1 ' ' 04890O*------------------------------------------------------------------- 04900O E 72N70 04910O OR 79 04920O 4 'OPER' 04930O 11 'OVLAP' 04940O 18 'OPER' 04950O 90 'LABOR HOURS' 04960O 103 'LOT' 04970O 115 'MIN-VEND' 04980O 121 'CHG' 04990O 126 'M' 05000O 132 'PERF' ÐÐ05010O*------------------------------------------------------------------- 05020O E 72N70 05030O OR 79 05040O 3 'SEQ' 05050O 7 'GRP' 05060O 10 '%' 05070O 18 'CODE' 05080O 26 'DEPT-' 05090O 29 'WC' 05100O 42 'DESCRIPTION' 05110O 82 'SET-UP' 05120O 93 'RUN' 05130O 104 'SIZE' 05140O 114 'CHARGE' 05150O 122 'DATE' 05160O 126 'C' 05170O 132 'CODE' 05180O*------------------------------------------------------------------- 05190O E 72N70 05200O OR 79 05210O 1 ' ' 05220O*------------------------------------------------------------------- 05230O E 72 05240O RMSEQ Z 3 05250O RMGRUP 7 ÐÐ05260O RMOVLPZ 11 05270O 12 '%' 05280O RMOPER 18 05290O RMDEPTZ 25 05300O 55 26 '-' 05310O 55 RMWC 29 05320O RMDESC 71 05330O RMRSU 2 82 05340O RMRRUN2 93 05350O RMRLOT2 104 05360O RMRMIN2 114 05370O RMRDAT 124 ' - - ' 05380O RMPER22 132 05390O RMMETH 126 05400O*--------------------------------------------------------------- 05410O E 73 05420O NUL 132 05430O MGTEXT 40 05440O 96 5 '*****' 05450O 96 BIT,8 132 05460O 42 ' ' 05470O*-------------------------------------------------------------- 05480O E 74 05490O* PUT TEXT LINE 05500O TXT 91 ÐÐ05510O TPLINEZ 101 05520O*--------------------------------------------------------------- 05530O E 78 05540O* PUT DIVIDER 05550O NUL 132 05560O******************************************************************** ** NUL ARRAY 005570 005580** A12 ARRAY 005590 005600** MES ARRAY 005610---MESSAGE NOT ON FILE--- 005620** TABTRN/TABNAM 005630AADD 005640CCHANGE 005650DDELETE 005660** TABMET/TABMN 005670EESTIMATED 005680HHISTORICAL 005690/* 005700_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(28´ 2X107SX P120282120282(èÈÐ00010H Q107SX00020F* REORG SXMAST FILE. (X107SX) *** COPY OF X107TX *** 00030F* REVISED 8/27/80 4:30 PM. 00040FTXMAST IP F 288 8AI 1 DISK 00050FTXMOUT O F 288 8AI 1 DISK 00060E******************************************************************** 00070E BLK 100 3 0A 00080E REC 288 1 00090I******************************************************************** 00100ITXMAST TM 01 00110I P 88 287 BLK 00120I 288 288 TXSTAT 00130I 1 288 REC 00140C******************************************************************** 00150C Z-ADD0 ZERO3 30 00160C ZERO3 LOKUPBLK 01 00170C 01 TXSTAT COMP 'D' 54 00180C 01 54 SETOF 01 00190O******************************************************************** 00200OTXMOUT D 01 00210O REC 288 00220O BLK 287P /* 000230_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(X8Ê XúX108BM PÌ120282120282(èÈÐ00010H Q108BM00020F* PRINT SINGLE LEVEL WHERE-USED. (X108BM) 00030F* REVISED 6/26/81 4:00 PM. *** D I A B L O *** 00040FBITHEX IP F 256 DISK 00050FCRTFILE UC F 256R DISK 00060FSUSPENSEUD F 128L29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST IC F 86R20AI 1 DISK 00090FBMWU ID F 21L20AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FEMPLFILEIC F 64R14AI 1 DISK 00120FMENUDEPTIT F 25 EDISK 00130E******************************************************************** 00140E MENUDEPT TABDEP 1 10 5 0 TABNAM 20 00150E A6 1 6 1 00160E A12 1 12 1 A INPUT ARRAY. 00170E NUL 1 132 1 NULL CHAR. 00180E TABIC 1 9 2 TABICN 15 ISSUE CODES. 00190E TABSC 1 6 2 ATABSCN 12 SOURCE CODES. 00200E TABPC 1 7 1 TABPCN 20 PROV CODES. 00210E A29 29 29 1 00220E BIT 256 1 BITHEX FILE. 00230E REC 132 1 00240E APN 8 10 0A SUSPENSE FILE 00250E QAR 8 3 0 SUSPENSE FILE ÐÐ00260I******************************************************************** 00270IBITHEX BT 00280I 1 256 BIT 00290I******************************************************************** 00300ICRTFILE CR 00310I 81 212 REC 00320I******************************************************************** 00330IEMPLFILEEE 00340I 23 42 EENAME 00350I******************************************************************** 00360ISUSPENSESP 01 00370I* SUSPENSE FILE (CONTAINS COMP PART NO'S). 00380I* KEY AREA. 00390I* TERMINAL # 2N (NOT USED) 1 2 XXXXXX 00400I* RECORD CODE 2A (SW) 00410I 3 4 SPREC 00420I* RECORD COUNTER 3N 00430I 5 70SPCNTR 00440I* REQUESTING DEPT 5N 00450I 8 120SPDEPT 00460I* EMPLOYEE # 5A 00470I 13 17 SPEMPL 00480I* ASSY PART # 10A X 8 00490I 30 109 APN 00500I* QTYS 3P X 8 ÐÐ00510I P 110 125 QAR 00520I* RECORD STATUS 1A 00530I 128 128 SPSTAT 00540I******************************************************************** 00550IPMMST2 PM 00560I* PART MASTER RECORD. 00570I* KEY AREA. 00580I* PART NO. 12A 00590I 1 12 PMPN 00600I* PROD LINE 4N 00610I 15 180PMPL 00620I* MODEL NAME 12A 00630I 19 30 PMMODL 00640I* DESCRIPTION 29A 00650I 31 59 PMDESC 00660I* COMMODITY CODE 9P 00670I P 60 640PMCC 00680I* ENG CHANGE STATUS. 00690I* CUR CHG LEVEL 2A 00700I 70 71 PMECHG 00710I* CUR CHG DATE 6N 00720I 72 770PMDCHG 00730I* LAST ECN NO. 5A 00740I 65 69 PMECN 00750I* DRAWING INFO ÐÐ00760I* DWG SIZE 1A 00770I 82 82 PMSIZ 00780I* DWG CLASS 1A 00790I* D = DYNAIR DWG 00800I* V = VENDOR DWG 00810I 83 83 PMDCLS 00820I* STANDARD CODE 1A 00830I 84 84 PMSTDC 00840I* DWG REL CODE 1A 00850I* E = ENG ONLY 00860I* M = REL TO MFG 00870I* P = PROTOTYPE 00880I 78 78 PMDREL 00890I* UNIT MEAS 2A 00900I* EA = EACH OC = OUNCE 00910I* ST = SET TC = TROY OUNCE 00920I* IN = INCH LB = POUND 00930I* FT = FEET PT = PINT 00940I* YD = YARD QT = QUART 00950I* SI = SQ.INCH GL = GALLON 00960I* SF = SQ.FEET DR = DRUM 00970I* SY = SQ.YARD 00980I 85 86 PMUM 00990I* SOURCE CODE 2A 01000I* MA = MFG ASSY ÐÐ01010I* MP = MFG PART 01020I* PA = PURCH ASSY 01030I* PP = PURCH PART 01040I* RD = REF DOC ONLY 01050I* RS = RAW STOCK 01060I 94 95 PMSC 01070I* PROVISIONING CODE 1A 01080I* A = FORECAST,NO VALUE ADDED 01090I* B = FORECAST,VALUE ADDED 01100I* C = FRCST-BUILD TO ORDER 01110I* D = NON-FRCST-BUILD TO ORD 01120I* E = CUSTOM 01130I* Y = OBSOLETE,REPAIRABLE 01140I* Z = OBSOLETE,NOT REPAIRABLE 01150I 96 96 PMPROV 01160I* ISSUE CODE 2A 01170I* PT = PULL TIME 01180I* OR = ON REQUEST 01190I* BI = BULK ISSUE 01200I* AR = AS REQUIRED 01210I* VS = VENDOR SUPPLIED 01220I* SD = SHIPPING DOCUMENT 01230I* TD = TRAV DOCUMENT 01240I* RD = REF DOC ONLY 01250I* RA = REF ASSY ÐÐ01260I 97 98 PMISSU 01270I* DELIVER TO DEPT 5P 01280I P 99 1010PMDEL 01290I* RESPONSIBILITY CODES 01300I* ENGR CODE 2A 01310I 102 103 PMEGR 01320I* PLANNER CODE 2A 01330I 104 105 PMPLNR 01340I* BUYER CODE 2A 01350I 106 107 PMBUYR 01360I* SALESMAN CODE 2A 01370I 108 109 PMSLSM 01380I* INVENTORY ACCOUNT 5P 01390I P 110 1120PMACNT 01400I* LOW LEVEL CODE 2N 01410I 430 4310PMLL 01420I* RECORD STATUS 1A 01430I* D = DELETED 01440I 674 674 PMSTAT 01450I******************************************************************** 01460IBMMAST BM 01470I* BILL OF MATERIAL RECORD. 01480I* KEY AREA 01490I* ASSY PART NO. 10N 01500I 1 100BMAPN ÐÐ01510I* COMPONENT PART NO. 10N 01520I 11 200BMCPN 01530I* ITEM NO. 3N 01540I 25 270BMITNO 01550I* QTY PER ASSY 7P 01560I P 28 310BMQTY 01570I* SCRAP ALLOW .2N 01580I 34 352BMSCRP 01590I* ISSUE CODE 2A 01600I* PT = PULL TIME 01610I* OR = ON REQUEST 01620I* BI = BULK ISSUE 01630I* AR = AS REQUIRED 01640I* RA = REF ASSY 01650I* TD = TRAV DOC 01660I* SD = SHIP DOC 01670I* RD = REF DOC 01680I* VS = VENDOR SUPPLIED 01690I 36 37 BMISSU 01700I* EFFECTIVITY. 01710I* BEGIN CHANGE LEVEL 2A 01720I 38 39 BMBCHG 01730I* ENDING CHANGE LEVEL 2A 01740I 40 41 BMECHG 01750I* BEGIN ECN # 5A ÐÐ01760I 42 46 BMBECN 01770I* ENDING ECN # 5A 01780I 47 51 BMEECN 01790I* DISPOSITION CODE 1A 01800I* U = USE UP OLD STYLE 01810I* N = NOW (IMMEDIATE) 01820I 52 52 BMDISP 01830I* FILLER 5A 53 57 FFFFFF 01840I* ROUTING. 01850I* OPER NO. 5P 01860I P 58 600BMOPER 01870I* DEPT NO. 5P 01880I P 61 630BMDEPT 01890I* WORK CENTER NO. 3P 01900I P 64 650BMWC 01910I* COMPONENT OPER REFERENCE INFO 10A 01920I 66 75 BMREF 01930I* FILLER 76 85 FFFFFF 01940I* RECORD STATUS 1A 01950I* D = DELETED 01960I 86 86 BMSTAT 01970I******************************************************************** 01980IBMWU BW 01990I* COMPONENT PN 10N 02000I 1 100BWCPN ÐÐ02010I* ASSY PART # 10N 02020I 11 200BWAPN 02030I* RECORD STATUS 1A 02040I 21 21 BWSTAT 02050I******************************************************************** 02060IMGFILE MG 02070I* MESSAGE FILE. 02080I* TEXT 35A 02090I 1 35 MGTEXT 02100I* LINE-2 35A 02110I 36 70 MGLIN2 02120I* PROG NAME 5A 02130I 71 75 MGPROG 02140C******************************************************************** 02150C* INITIALIZE (1-TIME). 02160C EXSR SR101 INIT. 02170C Z-ADD0 ZERO10 100 STUPIDITY 02180C*------------------------------------------------------------------- 02190C START TAG 02200C* GET COMP PART NO FROM SUSPENSE. 02210C MOVE ' ' A29 02220C MOVEA'SW' A29,3 02230C MOVEAA29 W29A 29 02240C*------------------------------------------------------------------- 02250C TAG5 TAG ÐÐ02260C W29A SETLLSUSPENSE 02270C*------------------------------------------------------------------- 02280C TAG6 TAG 02290C SETOF 54 02300C READ SUSPENSE 54 02310C 54 GOTO ENDJOB 02320C SPREC COMP 'SW' 54 02330C N54 GOTO ENDJOB 02340C SPSTAT COMP 'D' 54 02350C 54 GOTO TAG6 02360C ZERO10 LOKUPAPN 54 02370C N54 GOTO TAG7 02380C EXSR SR77 TITLE PAGE 02390C*------------------------------------------------------------------- 02400C TAG7 TAG 02410C Z-ADD1 C 30 02420C ZERO10 LOKUPAPN,C 54 02430C Z-ADD0 EGAP 30 02440C N54 SETON 82 02450C N54 EXCPT UPDATE SUSPENSE 02460C N54 SETOF 82 02470C N54 GOTO TAG6 02480C Z-ADDAPN,C COMPPN 100 02490C Z-ADD0 APN,C 02500C MOVELCOMPPN W12A PMMST2 KEY ÐÐ02510C MOVE COMPPN NUMPN 02520C MOVELW12A NCPN 100 02530C EXSR SR81 GET PMMST. 02540C N60 GOTO SETUP GOT IT. 02550C*------------------------------------------------------------------- 02560C SETUP TAG 02570C* SAVE COMPONENT DATA. 02580C SETON 81 02590C EXSR SR67 UPDATE SUSPENSE 02600C SETOF 81 02610C MOVE PMPN TCPN 12 02620C MOVE PMDESC ADESC 29 02630C MOVE PMMODL AMODL 12 02640C MOVE PMSC ASC 2 02650C MOVE PMISSU AISSU 2 02660C MOVE PMPROV APROV 1 02670C Z-ADDPMPL APL 40 02680C MOVE PMECHG AECHG 2 02690C MOVE PMECN AECN 5 02700C* PUT COMP DATA TO CRT. 02710C PMPROV LOKUPTABPC TABPCN 40 02720C PMISSU LOKUPTABIC TABICN 41 02730C PMSC LOKUPTABSC TABSCN 42 02740C EXSR SR71 PUT HEADINGS 02750C MOVELNCPN W20A 20 ÐÐ02760C MOVE ZERO10 W20A 02770C*-------------------------------------------------------------- 02780C SETLIM TAG 02790C* SET LOW LIMIT FOR READ 02800C W20A SETLLBMWU 02810C*------------------------------------------------------------------- 02820C CHASE TAG 02830C* GET NEXT BILL MATL RECORD. 02840C SETOF 54 02850C READ BMWU 54 02860C 54 GOTO ENDASY 02870C BWCPN COMP NCPN 54 02880C N54 GOTO ENDASY 02890C BWSTAT COMP 'D' 54 02900C 54 GOTO CHASE 02910C MOVELBWAPN W20A 02920C MOVE BWCPN W20A 02930C W20A CHAINBMMAST H8 02940C H8 GOTO TAG7 02950C* GET ASSEMBLY PART MASTER. 02960C MOVELBMAPN W12A 02970C EXSR SR81 GET PMMST2 02980C 60 GOTO TAG7 ERROR 02990C* PUT TO CRT. 03000C MOVELPMPN NUMPN 100 ÐÐ03010C QAR,C MULT BMQTY EXTQTY 70 03020C EXSR SR72 PUT DATA. 03030C*------------------------------------------------------------------- 03040C ENDPAG TAG 03050C* SEE IF END OF PAGE. 03060C COUNT COMP 31 54 54 LINE #. 03070C N54 GOTO CHASE NOT EOP. 03080C SETON 78 03090C EXSR SR71 03100C N77 GOTO CHASE NO INPUT 03110C*------------------------------------------------------------------- 03120C ENDASY TAG 03130C* PUT END OF W-U MSG. 03140C Z-ADD317 M 50 03150C EXSR SR73 PUT MSG. 03160C GOTO TAG7 03170C*------------------------------------------------------------------- 03180C ENDJOB TAG 03190C******************************************************************** 03200CSR SR67 BEGSR 03210C* PRINT ROUTINE. 03220CSR EXSR SR68 LF 03230CSR MOVE ' ' REC 03240CSR EXCPT UPDATE CRTFILE 03250CSR SETOF 212223 ÐÐ03260CSR SETOF 242526 03270CSR SETOF 272829 03280CSR SETOF 717273 03290CSR SETOF 7477 03300CSR EXSR SR83 GET CRTFILE 03310CSR MOVEAREC W148A 148 03320CSR EXITFZD148 03330CSR RLABL W148A 03340CSR ENDSR 03350C******************************************************************** 03360CSR SR68 BEGSR 03370C* LINE FEED. 03380CSR EXITFQCLF LF 03390CSR 1 ADD COUNT COUNT 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR69 BEGSR 03430C* TOP FORM. 03440CSR Z-ADD0 COUNT 30 03450CSR 1 ADD EGAP EGAP 30 03460CSR EXITFZTFORM 03470CSR ENDSR 03480C******************************************************************** 03490CSR SR71 BEGSR 03500C* PUT HEADINGS. ÐÐ03510CSR EXSR SR69 TOP FORM 03520CSR SETON 21 03530CSR EXSR SR67 PRINT 03540CSR SETON 22 03550CSR EXSR SR67 PRINT 03560CSR SETON 23 03570CSR EXSR SR67 PRINT 03580CSR EXSR SR68 03590CSR EXSR SR68 03600CSR SETON 25 03610CSR EXSR SR67 PRINT 03620CSR EXSR SR68 LF 03630CSR SETON 26 03640CSR EXSR SR67 PRINT 03650CSR SETON 27 03660CSR EXSR SR67 PRINT 03670CSR EXSR SR68 LF 03680CSR EXSR SR68 LF 03690CSR ENDSR 03700C******************************************************************** 03710CSR SR72 BEGSR 03720C* PUT DATA LINE. 03730CSR PMMODL COMP BLK12 54 03740CSR 54 MOVE BLK35 PMDESC 03750CSR 54 MOVELPMMODL PMDESC ÐÐ03760CSR 54 MOVE '***' PMDESC 03770CSR 1 ADD COUNT COUNT 03780CSR SETON 72 03790CSR EXSR SR67 03800CSR SETOF 72 03810CSR ENDSR 03820C******************************************************************** 03830CSR SR73 BEGSR 03840C* PUT MSG TO CRT. 03850CSR M CHAINMGFILE 54 GET MSG. 03860CSR 97 MOVELPRGERR MGTEXT 03870CSR EXSR SR74 PUT MSG. 03880CSR ENDSR 03890C******************************************************************** 03900CSR SR74 BEGSR 03910C* PUT MSG TO CRT. 03920CSR SETON 74 03930CSR EXSR SR67 PUT MSG. 03940CSR SETOF 74 03950CSR ENDSR 03960C******************************************************************** 03970CSR SR77 BEGSR 03980C* PRINT TITLE PAGE. 03990CSR EXSR SR69 TOP FORM 04000CSR MOVE ' ' A29 ÐÐ04010CSR MOVE 'E' A29,1 04020CSR MOVEASPEMPL A29,2 04030CSR MOVEAA29 W14A 14 04040CSR W14A CHAINEMPLFILE 60 04050CSR 60 GOTO END77 04060CSR SPDEPT LOKUPTABDEP TABNAM 54 04070CSR MOVE TABNAM DEPNAM 17 04080CSR SETON 77 04090CSR EXSR SR67 PRINT 04100CSR END77 ENDSR 04110C******************************************************************** 04120CSR SR81 BEGSR 04130C* GET PART MAST. 04140CSR MOVE ' ' W12A 12 04150CSR W12A CHAINPMMST2 60 04160CSRN60 PMSTAT COMP 'D' 60 04170CSR ENDSR 04180C******************************************************************** 04190CSR SR83 BEGSR 04200CSR PORT CHAINCRTFILE H9 04210CSR ENDSR 04220C******************************************************************** 04230CSR SR101 BEGSR 04240C* 1-TIME INITIALIZE. 04250CSR MOVE BIT,1 NUL ÐÐ04260CSR MOVE ' ' BLK12 12 04270CSR MOVE ' ' BLK35 35 04280CSR Z-ADD0 ZERO10 100 04290C* GET PORT # AND CRTFILE. 04300CSR MOVE ' ' W8A 8 04310CSR Z-ADD0 W2N 20 04320CSR Z-ADD0 W1N 10 04330CSR MOVE ' ' W2A 2 04340CSR EXITFPGMINX GET PORT # 04350CSR RLABL W8A 04360CSR RLABL W2N 04370CSR RLABL W1N 04380CSR RLABL W2A 04390CSR MOVE W2A PORT 20 PORT NO. 04400CSR PORT COMP 0 54 04410CSRN54 Z-ADD25 PORT DEFAULT 04420CSR EXSR SR83 CHAIN CRTFILE 04430CSR H9 GOTO END101 04440CSR END101 ENDSR 04450C***************************************************************** 04460CSR SR102 BEGSR 04470C* RIGHT JUSTIFY SR75 INPUT FIELD 04480CSR Z-ADD12 W2N 20 04490CSR EXIT SUBRAJ R.JUSTIFY 04500CSR RLABL W2N ÐÐ04510CSR RLABL W12A 04520CSR ENDSR 04530C******************************************************************** 04540CSR SR902 BEGSR 04550C* FLAG PROGRAM ERROR. 04560CSR SETON 9697 04570CSR Z-ADDM PRGERR 30 04580CSR Z-ADD319 M 04590CSR EXSR SR73 04600CSR ENDSR 04610O******************************************************************** 04620OCRTFILE E 74 04630O* PUT MSG TO CRT 04640O REC 212 04650O MGTEXT 35 04660O*------------------------------------------------------------------- 04670O E 21 04680O* PUT HEADINGS 04690O REC 212 04700O UDATE Y 88 04710O 209 'PAGE' 04720O EGAP Z 212 04730O 150 'SINGLE LEVEL WHERE-USED ' 04740O E 22 04750O REC 212 ÐÐ04760O 207 'CHG LAST' 04770O E 23 04780O REC 212 04790O 95 'COMPONENT-PART#' 04800O 114 '<-------DESCRIPTION' 04810O 123 '-------->' 04820O 136 'MODEL-NAME' 04830O 150 'SOURCE-CODE' 04840O 162 'ISSUE-CODE' 04850O 181 'PROVISIONING-CODE' 04860O 184 'PROD-LINE' 04870O 206 'LEV ECN' 04880O* PUT COMP DATA LINES 04890O NCPN 92 ' - - ' 04900O ADESC 123 04910O AMODL 137 04920O ASC 141 04930O AISSU 153 04940O APROV 164 04950O APL Z 191 04960O AECHG 200 04970O AECN 208 04980O E 25 04990O REC 212 05000O 42 TABSCN 149 ÐÐ05010O 41 TABICN 166 05020O 40 TABPCN 184 05030O E 26 05040O REC 212 05050O 84 'ITEM' 05060O 95 'ASSEMBLY' 05070O 139 'QUANTITY' 05080O 160 'SOURCE ISSUE ENG' 05090O 168 'SCRAP' 05100O 191 '<-----ROUTING------->' 05110O 207 '<--E.C.N.--->' 05120O E 27 05130O REC 212 05140O 83 'NO' 05150O 94 'PART-NO' 05160O 119 '<-------DESCRIPTION' 05170O 129 '--------->' 05180O 139 'PER-ASSY' 05190O 143 'UM' 05200O 149 'CODE' 05210O 155 'CODE' 05220O 161 'STD ' 05230O 168 'ALLOW' 05240O 174 'OPER' 05250O 180 'DEPT' ÐÐ05260O 191 'REFERENCE' 05270O 199 'START' 05280O 207 'STOP' 05290O E 72 05300O REC 212 05310O BMITNOZ 83 05320O NUMPN 98 ' - - ' 05330O PMDESC 129 05340O BMQTY 2 139 05350O PMUM 143 05360O PMSC 148 05370O BMISSU 154 05380O PMSTDC 159 05390O BMSCRP2 166 05400O 167 '%' 05410O BMOPERZ 174 05420O BMDEPTZ 180 05430O BMREF 192 05440O BMBECN 198 05450O BMBCHG 201 05460O BMEECN 208 05470O BMECHG 211 05480O*------------------------------------------------------------------- 05490O E 77 05500O REC 212 ÐÐ05510O EENAME 190 05520O DEPNAM 212 05530O******************************************************************** 05540OSUSPENSEE 82 05550O APN 109 05560O QAR 125P 05570O 128 'D' ** A6 ARRAY 005580 005590** A12 ARRAY 005600 005610** NUL ARRAY 005620 005630** TABIC/TABICN VALID ISSUE CODES 005640PTPULL TIME 005650ORON REQUEST 005660BIBULK ISSUE 005670ARAS REQD 005680VSVENDOR SUPL'D 005690SDSHIPPING DOCUMENT 005700TDTRAVELER DOCUMENT 005710RDREF DOC ONLY 005720RAREF ASSY/PART 005730** TABSC/TABSCN VALID SOURCE CODES 005740MAMFG ASSY 005750ÐÐMPMFG PART 005760PAPURCH ASSY 005770PPPURCH PART 005780RDREF DOC ONLY 005790RSRAW STOCK 005800** TABPC/TABPCN VALID PROVISION CODES 005810AFRCST,NO VAL ADDED 005820BFRCST,VAL IS ADDED 005830CBLD/ORD,NO VAL ADDED 005840DBLD TO ORD,VAL ADDED 005850ECUSTOM 005860YOBSLT, REPAIRABLE 005870ZOBSLT,NOT REPAIR 005880** A29 ARRAY 005890 005900/* 005910_‚ ÐÐ_‚_‚G PART 005760PAPURCH ASSY 005770PPPURCH PART 005780RDREF DOC ONLY 005790RSRAW STOCK 005800** TABPC/TABPCN VALID PROVISION CODES 005810AFRCST,NO VAL ADDED 005820BFRCST,VAL IS ADDED 005830CBLD/ORD,NO VAL ADDED 005840DBLD TO ORD,VAL ADDED 005850ECUSTOM 005860YOBSLT, REPAIRABLE 005870ZOBSLT,NOT REPAIR 005880** A29 ARRAY 005890 005900/* 005910_‚ ÐÈ(29Å 2X108PM P120282120282(èÈÐ00010H Q108PM00020F* COPY INSP CODE FROM ESMAST TO PMMST2. (X108PM) 00030F* REVISED 7-13-81 10:35 AM. 00040FESMAST IP F 55 12AI 1 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060I******************************************************************** 00070IESMAST ES 01 00080I 1 12 ESPN 00090I 52 54 ESINSP 00100I 55 55 ESSTAT 00110I******************************************************************** 00120IPMMST2 PM 00130I 79 81 PMINSP 00140C******************************************************************** 00150C ESSTAT COMP 'D' 54 00160C 54 SETOF 01 00170C 01 ESINSP COMP ' ' 01 00180C 01 ESPN CHAINPMMST2 54 00190C 01 54 SETOF 01 00200O******************************************************************** 00210OPMMST2 D 01 00220O ESINSP 81 /* 00230_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(P/ò P"X017XP Pžž999999120282(èÈÐ00010H Q017XP00020F* UPDATE USAGE RATIO IN PART MAST. (X017XP) 00030F* REVISED 1/27/83 2:45 PM. 00040F*----------------------------------------------------------------- 00050F*------------------------------------------------------------------ 00060FXPMAST IS F 99 22AI 1 DISK 00070FABCTOTALIP F 16 DISK 00080FPMMST2 UC F 674R12AI 1 DISK 00090FTERM50 O F 50 5 U1 00100E******************************************************************** 00110E XPQ 18 7 0 00120E TPQ 18 7 0 00130I******************************************************************** 00140IXPMAST XP 01 99NCD 00150I* PART # 10N 00160I 3 120XPCPN L1 00170I* REQMT QTY 7P X 18 00180I P 23 94 XPQ 00190I GG 02 00200I******************************************************************** 00210IABCTOTALAB 00220I 1 102TOTAL 00230I******************************************************************** 00240IPMMST2 PM 00250I P 489 4933PMOSUC ÐÐ00260I 94 94 PMSC 00270I P 425 4287PMRATO 00280C******************************************************************** 00290C N01 00300COR L1 SETOF 40 00310C N01 GOTO END 00320C MOVELXPCPN W4N 40 00330C SETON 40 00340C L1 Z-ADD0 TPQ 00350C L1 MOVELXPCPN W12A 12 00360C L1 MOVE ' ' W12A 00370C L1 W12A CHAINPMMST2 60 00380C PMSC COMP 'P' 81 00390C XPQ ADD TPQ TPQ 00400C*---------------------------------------------------------------- 00410C END TAG 00420C*------------------------------------------------------------------- 00430CL0N40 GOTO ENDTOT 00440CL1 XFOOTTPQ TOT 70 00450CL1 81 PMOSUC MULT TOT TOT$ 92H54 00460CL1 81 TOT$ DIV TOTAL RATIO9 99H 00470CL1 81 Z-ADDRATIO9 RATIO7 77H55 00480CL1 81 54N55 Z-ADD.0000001 RATIO7 00490CL1 SETON 80 00500CL1 EXCPT ÐÐ00510CL1 SETOF 80 00520C*--------------------------------------------------------------- 00530CL1 ENDTOT TAG 00540O******************************************************************** 00550OPMMST2 E 80 00560O PMOSUC 493P 00570O TOT 318P 00580O 81 RATIO7 428P 00590O N81 PMRATO 428P 00600O******************************************************************** 00610OTERM50 E 80 00620O XPCPN 12 ' - - ' 00630O T L1 00640O XPCPN 12 ' - - ' 00650O T L1 00660O 1 ' ' /* 00670_‚ ÐÐ _‚_‚0O PMOSUC 493P 00570O TOT 318P 00580O 81 RATIO7 428P 00590O N81 PMRATO 428P 00600O******************************************************************** 00610OTERM50 E 80 00620O XPCPN 12 ' - - ' 00630O T L1 00640O XPCPN 12 ' - - ' 00650O T L1 00660O 1 ' ' /* 00670_‚ ÐÈ(Š;§ ŠX105BM PR999999120282(èÈÐ00010H Q105BM00020F* INDENTED PARTS LIST - COMPLETE. (X105BM) 00030F* REV 8/10/82 4:45 PM. 00040F* MENU: MQBM02 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST ID F 86L20AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 50 50 1 NULL CHAR. 00130E N20 20 20 1 NULL CHAR. 00140E A12 12 12 1 A INPUT ARRAY. 00150E LEV 1 20 20 NEXT RRN AT EA LEVEL 00160E QTY 1 20 7 0 QTY MULTIPLIER 00170E LNK 1 7 6 A 00180E CALL 7 6 00190E PAR 25 1 00200E TST 25 1 00210E BIT 33 1 BITTAB. 00220E PLT 8 3 0 LEAD TIMES 00230I******************************************************************** 00240IBITPAR BT 00250I 1 33 BIT ÐÐ00260I 34 58 PAR 00270I 59 83 TST 00280I******************************************************************** 00290ICRTFILE CR 00300I 28 330CRTIME 00310I 34 370CRDATE 00320I 38 79 CALL 00330I******************************************************************** 00340IPMMST2 PM 00350I* PART MASTER RECORD (XPMMST) 00360I* KEY AREA 00370I* PART NO. 12A 00380I 1 12 PMPN 00390I* NUMB OF COMPONENTS 3P 00400I P 13 140PMNOBM 00410I* PROD LINE 4N 00420I 15 180PMPL 00430I* MODEL NAME 12A 00440I 19 30 PMMODL 00450I* DESCRIPTION 29A 00460I 31 59 PMDESC 00470I* COMMODITY CODE 9P 00480I P 60 640PMCC 00490I* ENG CHANGE STATUS. 00500I* CUR CHG LEVEL 2A ÐÐ00510I 70 71 PMECHG 00520I* CUR CHG DATE 6N 00530I 72 770PMDCHG 00540I* LAST ECN NO. 5A 00550I 65 69 PMECN 00560I* DRAWING INFO 00570I* DWG SIZE 1A 00580I 82 82 PMSIZ 00590I* DWG CLASS 1A 00600I* D = DYNAIR DWG 00610I* V = VENDOR DWG 00620I 83 83 PMDCLS 00630I* STANDARD CODE 1A 00640I 84 84 PMSTDC 00650I* DWG REL CODE 1A 00660I* E = ENG ONLY 00670I* M = REL TO MFG 00680I* P = PROTOTYPE 00690I 78 78 PMDREL 00700I* UNIT MEAS 2A 00710I* EA = EACH OC = OUNCE 00720I* ST = SET TC = TROY OUNCE 00730I* IN = INCH LB = POUND 00740I* FT = FEET PT = PINT 00750I* YD = YARD QT = QUART ÐÐ00760I* SI = SQ.INCH GL = GALLON 00770I* SF = SQ.FEET DR = DRUM 00780I* SY = SQ.YARD 00790I 85 86 PMUM 00800I* SOURCE CODE 2A 00810I* MA = MFG ASSY 00820I* MP = MFG PART 00830I* PA = PURCH ASSY 00840I* PP = PURCH PART 00850I* RD = REF DOC ONLY 00860I* RS = RAW STOCK 00870I 94 95 PMSC 00880I* PROVISIONING CODE 1A 00890I* A = FORECAST,NO VALUE ADDED 00900I* B = FORECAST,VALUE ADDED 00910I* C = BUILD TO ORDER (B) 00920I* D = BUILD TO ORDER (NOT B) 00930I* E = CUSTOM 00940I* Y = OBSOLETE,REPAIRABLE 00950I* Z = OBSOLETE,NOT REPAIRABLE 00960I 96 96 PMPROV 00970I* ISSUE CODE 2A 00980I* PT = PULL TIME 00990I* OR = ON REQUEST 01000I* BI = BULK ISSUE ÐÐ01010I* AR = AS REQUIRED 01020I* VS = VENDOR SUPPLIED 01030I* SD = SHIPPING DOCUMENT 01040I* TD = TRAV DOCUMENT 01050I* RD = REF DOC ONLY 01060I* RA = REF ASSY 01070I 97 98 PMISSU 01080I* DELIVER TO DEPT 5P 01090I P 99 1010PMDEL 01100I* RESPONSIBILITY CODES 01110I* ENGR CODE 2A 01120I 102 103 PMEGR 01130I* PLANNER CODE 2A 01140I 104 105 PMPLNR 01150I* BUYER CODE 2A 01160I 106 107 PMBUYR 01170I* SALESMAN CODE 2A 01180I 108 109 PMSLSM 01190I* INVENTORY ACCOUNT 5P 01200I P 110 1120PMACNT 01210I* LEAD TIMES 8 X 3P 01220I P 113 128 PLT 01230I* FAB CODE 2A 01240I 487 488 PMFABC 01250I* RECORD STATUS 1A ÐÐ01260I* D = DELETED 01270I 674 674 PMSTAT 01280I******************************************************************** 01290IBMMAST BM 01300I* BILL OF MATERIAL RECORD 01310I* KEY AREA 01320I* ASSY PART NO. 10N 01330I 1 100BMAPN 01340I* COMPONENT PART # 10N 01350I 11 200BMCPN 01360I* ITEM NO. 3N 01370I 25 270BMITNO 01380I* QTY PER ASSY 7P 01390I P 28 310BMQTY 01400I* SCRAP ALLOW .2N 01410I 34 352BMSCRP 01420I* ISSUE CODE 2A 01430I* PT = PULL TIME 01440I* OR = ON REQUEST 01450I* BI = BULK ISSUE 01460I* AR = AS REQUIRED 01470I* RA = REF ASSY 01480I* TD = TRAV DOC 01490I* SD = SHIP DOC 01500I* RD = REF DOC ÐÐ01510I* VS = VENDOR SUPPLIED 01520I 36 37 BMISSU 01530I* EFFECTIVITY. 01540I* BEGIN CHANGE LEVEL 2A 01550I 38 39 BMBCHG 01560I* ENDING CHANGE LEVEL 2A 01570I 40 41 BMECHG 01580I* BEGIN ECN # 5A 01590I 42 46 BMBECN 01600I* ENDING ECN # 5A 01610I 47 51 BMEECN 01620I* DISPOSITION CODE 1A 01630I* U = USE UP OLD STYLE 01640I* N = NOW (IMMEDIATE) 01650I 52 52 BMDISP 01660I* FILLER 5A 53 57 FFFFFF 01670I* ROUTING. 01680I* OPER NO. 5P 01690I P 58 600BMOPER 01700I* DEPT NO. 5P 01710I P 61 630BMDEPT 01720I* WORK CENTER NO. 3P 01730I P 64 650BMWC 01740I* COMPONENT OPER REFERENCE INFO 10A 01750I 66 75 BMREF ÐÐ01760I* FILLER 10A 76 85 FFFFFF 01770I* 01780I* RECORD STATUS 1A 01790I* D = DELETED 01800I 86 86 BMSTAT 01810I******************************************************************** 01820IMGFILE MG 01830I* MESSAGE FILE. 01840I* TEXT 35A 01850I 1 35 MGTEXT 01860I* LINE-2 35A 01870I 36 70 MGLIN2 01880I* PROG NAME 5A 01890I 71 75 MGPROG 01900C******************************************************************** 01910C* INITIALIZE 01920C EXSR SR101 INIT 01930C MOVE ' ' BLK6 6 01940C EXSR SR70 CLEAR SCREEN 01950C*---------------------------------------------------------------- 01960C START TAG 01970C* GET ASSY PART NO FROM TERMINAL 01980C SETOF 9693 01990C Z-ADD185 M 50 MSG # 02000C EXSR SR73 PROMPT ÐÐ02010C EXSR SR75 READ 02020C 96 GOTO START ERROR 02030C 93 GOTO START NEW ITEM REQST 02040C N77 GOTO START NO INPUT 02050C*------------------------------------------------------------------- 02060C CONTU TAG 02070C Z-ADD12 W2N 20 02080C EXIT SUBRAJ R. JUSITFY 02090C RLABL W2N 02100C RLABL W12A 02110C MOVE W12A TAPN 100 TOP ASSY PN 02120C MOVE BLK12 W12A 02130C MOVELTAPN W12A 02140C EXSR SR81 GET PMMST2 02150C N60 GOTO TAG10 GOT IT 02160C Z-ADD302 M 96 FLAG ERROR 02170C EXSR SR73 PUT MSG 02180C GOTO START 02190C*-------------------------------------------------------------------- 02200C TAG10 TAG 02210C* FLAG NO COMPONENTS ON FILE 02220C PMNOBM COMP 0 55 02230C N55 Z-ADD316 M 50 02240C N55 EXSR SR73 PUT ERR MSG 02250C N55 GOTO START ÐÐ02260C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02270C XFOOTPLT TPLT 40 02280C Z-ADD1 QTY,2 QTY MULTIPLIER 02290C SETON 89 02300C EXSR SR71 PUT HEADING 02310C SETOF 89 02320C* SET-UP INITIAL BILL MATERIAL READ 02330C Z-ADD3 L 20 INDENTURE LEVEL 02340C MOVE BLK20 LEV 02350C MOVELTAPN LEV,2 02360C*----------------------------------------------------------------- 02370C TAG20 TAG 02380C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02390C L SUB 1 L 54 INDENT LEVEL 02400C N54 GOTO ENDASY BOTTOM INDENT 02410C LEV,L COMP BLK20 54 02420C N54 GOTO TAG20 NONE THIS LEVEL 02430C MOVE LEV,L W20A 20 02440C MOVELLEV,L CURASY 100 MATCH PART # 02450C MOVE BLK20 LEV,L 02460C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02470C*------------------------------------------------------------------ 02480C TAG30 TAG 02490C* SET-UP NEXT READ 02500C W20A SETLLBMMAST ÐÐ02510C*--------------------------------------------------------------- 02520C TAG40 TAG 02530C* GET NEXT COMPONENT. 02540C SETOF 54 02550C READ BMMAST 54GET COMPONENT 02560C 54 GOTO TAG20 END OF FILE 02570C BMAPN COMP CURASY 54 02580C N54 GOTO TAG20 WRONG ASSY 02590C BMSTAT COMP 'D' 54 02600C 54 GOTO TAG40 DELETED RECORD 02610C* DISPLAY COMPONENT DATA 02620C EXSR SR72 DISPLAY DATA 02630C 93 GOTO START 02640C 77 GOTO CONTU 02650C* BRANCH IF NOT ASSY 02660C PMNOBM COMP 0 54 02670C N54 GOTO TAG40 NOT ASSY 02680C*------------------------------------------------------------------ 02690C TAG50 TAG 02700C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02710C MOVELBMAPN LEV,L 02720C 1 ADD BMCPN W10N 100 02730C MOVE W10N LEV,L 02740C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02750C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER ÐÐ02760C MOVE BMCPN CURASY 02770C MOVELBMCPN W20A 02780C MOVE ZERO10 W20A 02790C 1 ADD L L INDENT LEVEL 02800C GOTO TAG30 02810C*------------------------------------------------------------------ 02820C ENDASY TAG 02830C* END OF ASSY PROMPT 02840C EXSR SR76 END ASSY PROMPT 02850C 77 GOTO CONTU 02860C GOTO START 02870C*----------------------------------------------------------------- 02880C MENU TAG 02890C* SET RETURN TO MENU LINKAGE 02900C EXSR SR96 GET CRTFILE 02910C Z-ADD1 W 02920C BLK6 LOKUPLNK,W 54 02930C 54 MOVELLNK,W PROG 8 02940C 54 MOVE BLK6 LNK,W 02950C N54 MOVEL'CONTU' PROG 02960C EXSR SR97 UPD CRTFILE 02970C EXSR SR98 >>>>>>>>>> 02980C GOTO END 02990C*----------------------------------------------------------------- 03000C GOODBY TAG ÐÐ03010C* SET ABORT LINKAGE 03020C MOVEL'GOODBY' PROG 03030C GOTO END 03040C*----------------------------------------------------------------- 03050C END TAG 03060C* LINK TO NEXT PROG 03070C EXSR SR96 GET CRTFILE 03080C EXSR SR97 UPD CRTFILE 03090C EXSR SR98 >>>>>>>>>> 03100C*------------------------------------------------------------------ 03110C ENDJOB TAG 03120C MOVEL'ENDJOB 'PROG 03130C EXSR SR98 >>>>>>>>>> 03140C******************************************************************** 03150CSR SR69 BEGSR 03160CSR 50 EXITFZPUTXY 03170CSR RLABL RPGLIN 03180CSR RLABL RPGCOL 03190CSR ENDSR 03200C******************************************************************** 03210CSR SR70 BEGSR 03220CSR 50 EXITFZISTAT 03230CSR 50 EXITFZESCH 03240CSRN50 EXITFZCPAGE 03250CSRN50 MOVEL'091' RPGLIN 4 ÐÐ03260CSRN50 MOVEL'001' RPGCOL 4 03270CSRN50 EXSR SR69 MOVE CURSOR 03280CSR ENDSR 03290C******************************************************************** 03300CSR SR71 BEGSR 03310C* CLEAR CRT. PUT HEADINGS. 03320CSR Z-ADD4 COUNT 30 LINE COUNT 03330CSR MOVELTAPN W12A 03340CSR MOVE ' ' W12A 03350CSR EXSR SR81 GET TOP-ASSY PMMST2 03360CSR EXSR SR70 NEW PAGE 03370CSR SETON 71 03380CSR EXCPT PUT HEADING 03390CSR SETOF 71 03400CSR PMMODL COMP BLK12 54 03410CSR 54 MOVE BLK35 PMDESC 03420CSR 54 MOVELPMMODL PMDESC 03430CSR 54 MOVE '***' PMDESC 03440CSR SETON 75 03450CSR EXCPT PUT TOP ASSY DATA 03460CSR SETOF 75 03470CSR ENDSR 03480C******************************************************************** 03490CSR SR72 BEGSR 03500C* DISPLAY DATA LINE TO CRT. ÐÐ03510CSR SETOF 909377 03520CSR 1 ADD COUNT COUNT 03530CSR MOVE BLK12 W12A 03540CSR MOVELBMCPN W12A COMP PN 03550CSR EXSR SR81 GET PMMST2 03560CSR PMMODL COMP BLK12 54 03570CSR 54 MOVE BLK35 PMDESC 03580CSR 54 MOVELPMMODL PMDESC 03590CSR 54 MOVE '***' PMDESC 03600CSR L COMP 1 0101 03610CSR L COMP 2 02 03620CSR L COMP 3 03 03630CSR L COMP 4 04 03640CSR L COMP 5 05 03650CSR L COMP 6 06 03660CSR L COMP 7 07 07 03670CSR 01 Z-ADD1 L 03680CSR BMISSU COMP ' ' 55 03690CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03700CSR XFOOTPLT LEAD 40 03710CSR SETON 72 03720CSR EXCPT PUT DATA. 03730CSR SETOF 72 03740CSR 50 COUNT COMP 23 54 54 03750CSRN50 COUNT COMP 28 54 54 ÐÐ03760CSRN54 GOTO END72 NOT END PAGE 03770CSR EXITFQEPAGE END PAGE MSG 03780CSR EXSR SR75 READ 03790CSRN90N77 EXSR SR71 PUT HEADINGS 03800CSR END72 ENDSR 03810C******************************************************************** 03820CSR SR73 BEGSR 03830C* PUT PROMPT TO CRT. 03840CSR EXSR SR89 03850CSR 54 MOVELM MGTEXT 03860CSR 2 ADD COUNT COUNT 03870CSR SETON 73 03880CSR EXCPT PUT PROMPT. 03890CSR SETOF 73 03900CSR ENDSR 03910C******************************************************************** 03920CSR SR75 BEGSR 03930C* READ CRT. 03940CSR T75 TAG 03950CSR SETOF 909493 03960CSR SETOF 7796 03970CSR MOVE BLK12 W12A 12 03980CSR EXITFZR12 03990CSR RLABL W12A 04000CSR MOVEAW12A A12 ÐÐ04010CSR MOVE BLK12 W12A 04020CSR Z-ADD1 W 20 04030CSR '\' LOKUPA12,W 90 04040CSRN90 GOTO T75A NOT ESC. 04050CSR 1 ADD W W 04060CSR W COMP 12 54 04070CSR 54 GOTO T75C BAD ESC. 04080CSR A12,W COMP 'E' 94 EXIT. 04090CSR A12,W COMP 'N' 93 NEW ASSY. 04100CSR A12,W COMP 'G' 98 GOODBY 04110CSR 98 GOTO GOODBY 04120CSR 94 GOTO MENU 04130CSR 93 GOTO END75 04140CSR GOTO T75C 04150C*------------------------------------------------------------------- 04160CSR T75A TAG 04170CSR Z-ADD1 W 04180CSR ' ' LOKUPA12,W 77 04190CSR 77 MOVEAA12,W W12A INPUT DATA. 04200CSR GOTO END75 04210C*------------------------------------------------------------------- 04220CSR T75C TAG 04230C* FLAG BAD ESCAPE. 04240CSR Z-ADD318 M 96 04250CSR EXSR SR73 FLAG ERROR. ÐÐ04260CSR GOTO T75 04270CSR END75 ENDSR 04280C******************************************************************** 04290CSR SR76 BEGSR 04300C* END OF ASSY PROMPT/READ. 04310CSR Z-ADD317 M 04320CSR EXSR SR73 PUT MSG. 04330CSR EXSR SR75 04340CSR ENDSR 04350C******************************************************************** 04360CSR SR81 BEGSR 04370C* GET PART MAST. 04380CSR SETOF 61 04390CSR W12A CHAINPMMST2 60 GET PMMST. 04400CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 04410CSR ENDSR 04420C******************************************************************** 04430CSR SR89 BEGSR 04440C* GET MGFILE. 04450CSR M CHAINMGFILE 54 GET MGFILE. 04460CSR 54 MOVE BLK35 MGTEXT 04470CSR 54 MOVELM MGTEXT 04480CSR 54 MOVE 'NO MSG' MGTEXT 04490CSR ENDSR 04500C******************************************************************** ÐÐ04510CSR SR96 BEGSR 04520CSR # CHAINCRTFILE H9 GET CRTFILE 04530CSR H9 GOTO ENDJOB 04540CSR ENDSR 04550C******************************************************************** 04560CSR SR97 BEGSR 04570C* UPDATE CRTFILE. EXIT PROGRAM. 04580CSR TIME CRTIME 04590CSR MOVELUDATE CRDATE 04600CSR SETON 97 04610CSR EXCPT UPD CRTFILE 04620CSR SETOF 97 04630CSR ENDSR 04640C******************************************************************** 04650CSR SR98 BEGSR 04660CSR EXSR SR70 CLEAR SCREEN 04670CSR EXITFCHAIN >>>>>>>>>> 04680CSR RLABL PROG 04690CSR ENDSR 04700C******************************************************************** 04710CSR SR101 BEGSR 04720C* INITIALIZE (1-TIME). 04730CSR MOVE BIT,1 N20 04740CSR MOVE BIT,1 NUL INIT NULL CHAR. 04750CSR MOVE ' ' W2A 2 ÐÐ04760CSR EXITFZGMINX 04770CSR RLABL W2A 04780CSR MOVE W2A # 20 04790CSR # COMP 0 54 04800CSRN54 Z-ADD25 # 04810CSR EXSR SR96 GET CRTFILE 04820CSR MOVEL'Q105BM 'PROG 04830CSR MOVE CALL LNK 04840CSR PAR,# COMP '1' 50 04850CSR TST,# COMP 'S' 54 04860CSR 54 MOVE 'SHUTDOWN'PROG 04870CSR EXSR SR97 UPD CRTFILE 04880CSR 54 EXSR SR98 >>>>>>>>>> 04881CSR MOVE ' 'PROG 04890CSR MOVE ' ' BLK35 35 04900CSR MOVE ' ' BLK12 12 04910CSR MOVE ' ' BLK20 20 04920CSR Z-ADD0 ZERO10 100 04930CSR ENDSR 04940O******************************************************************** 04950OTERM132 E 72 04960O* DATA LINE. 04970O 11 '.' 04980O 14 '.' 04990O 17 '.' ÐÐ05000O 20 '.' 05010O 23 '.' 05020O 26 '.' 05030O 29 '.' 05040O 02 29 ' ' 05050O 03 29 ' ' 05060O L Z 2 05070O BMITNOZ 8 05080O 01 BMCPN 22 ' - - ' 05090O 02 BMCPN 25 ' - - ' 05100O 03 BMCPN 28 ' - - ' 05110O 04 BMCPN 31 ' - - ' 05120O 05 BMCPN 34 ' - - ' 05130O 06 BMCPN 37 ' - - ' 05140O 07 BMCPN 40 ' - - ' 05150O PMDESC 71 05160O BMQTY 2 82 05170O PMUM 86 05180O PMSC 92 05190O PMISSU 98 05200O 55 BMISSU 98 05210O LEAD Z 105 05220O EXTQTY2 115 05230O PMSTDC 119 05240O PMFABC 125 ÐÐ05250O*------------------------------------------------------------------- 05260O E 75 05270O* PUT TOP ASSY LINE. 05280O 2 '1' 05290O TAPN 22 ' - - ' 05300O N89 29 'CONT''D' 05310O PMDESC 71 05320O 82 '1' 05330O PMUM 86 05340O PMISSU 98 05350O PMSC 92 05360O TPLT Z 105 05370O 115 '1' 05380O PMSTDC 119 05390O PMFABC 125 05400O*------------------------------------------------------------------- 05410O E 73 05420O* PUT ERROR MESSAGE. 05430O NUL 50 05440O NUL 100 05450O NUL 132 05460O MGTEXT 35 05470O 37 ' ' 05480O*------------------------------------------------------------------- 05490O E 71 ÐÐ05500O* CLEAR SCREEN - LINE-1. 05510O BIT,28 1 05520O N50 8 '8091001' 05530O N50 BIT,1 9 05540O N50 BIT,1 10 05550O 50 10 '[001 ]001' 05560O 50 BIT,28 6 05570O 71 'INDENTED PARTS LIST' 05580O 79 'ASSY=' 05590O TAPN 91 ' - - ' 05600O*------------------------------------------------------------------- 05610O E 71 05620O* HEADING, LINE-2. 05630O 26 '--------------INDENTURE' 05640O 40 '--------------' 05650O 82 'QUANTITY' 05660O 94 'SOURCE' 05670O 100 'ISSUE' 05680O 105 'LEAD' 05690O 115 'EXTENDED' 05700O 120 'STD' 05710O 126 'FAB' 05720O*------------------------------------------------------------------- 05730O E 71 05740O* HEADING, LINE-3. ÐÐ05750O 3 'LEV' 05760O 8 'ITEM' 05770O 29 '1 2 3 4 5 6 7' 05780O 32 '-UP' 05790O 53 'DESCRIPTION' 05800O 82 'PER-ASSY' 05810O 86 'UM' 05820O 93 'CODE' 05830O 99 'CODE' 05840O 105 'TIME' 05850O 115 'QUANTITY' 05860O 121 'CODE' 05870O 127 'CODE' 05880O E 71 05890O* HEADING, LINE-4 (BLANK). 05900O 1 ' ' 05910O******************************************************************** 05920OCRTFILE E 97 05930O PROG 26 05940O CRTIME 33 05950O CRDATE 37 05960O LNK 79 ** NUL ARRAY 005970 005980** N20 ARRAY 005990ÐÐ 006000** A12 ARRAY 006010 006020** LEV ARRAY 006030 006040** QTY ARRAY 006050 006060** LNK ARRAY 006070 06080/* 06090_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( <·  NX109SF P120282120282(èÈÐ00010H Q109SF00020F* RECD PO TO STOCK/RTV/SCRAP. (X109SF) *** D A T A G R A P H I X *** 00030F* REVISED 7-08-81 4:10 PM. 00040F* NOTE: DOES NOT UPDATE POITEM. 00050F* MENU: MQNS01 00060FBITTAB IP F 33 DISK 00070FMGFILE IC F 80R DISK 00080FCRTFILE IC F 256R DISK 00090FSFMAST UC F 128R29AI 1 DISK 00100FPMMST2 UC F 674R12AI 1 DISK 00110FORDERLOGIC F 32R13AI 1 DISK 00120FVMMAST IC F 384R 5AI 1 DISK 00130FMATLDISTO F 80 DISK A 00140FTERM132 O F 132 5 00150F**************************************************************** 00160E NUL 1 132 1 NULL CHAR 00170E A16 16 16 1 A INPUT DATA ARRAY 00180E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00190E LOC 1 5 3 00200E DUN 1 5 1 A EDIT CMPLT FLAG 00210E MES 1 1 30 00220E A29 29 29 1 00230E A9 9 9 1 00240E PA$ 7 9 3 ACCTG STD COSTS 00250E BIT 33 1 SCREEN CONTR. CHAR ÐÐ00260I******************************************************************* 00270IBITTAB BT 00280I 1 33 BIT 00290I******************************************************************* 00300IMGFILE MG 00310I* MESSAGE FILE. 00320I 1 35 MGTEXT 00330I****************************************************************** 00340ICRTFILE CR 00350I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00360I* STD AREA - SAME FOR ALL PROGRAMS. 00370I* EMPLOYEE # 5N 00380I 1 50CREMPL 00390I* USER CODE 8A 00400I 6 13 CRUSER 00410I* DEPT # 5N 00420I 14 180CRDEPT 00430I* JOB NAME 8A (JOB LOADED BY MENU) 00440I 19 26 CRJOB 00450I* SHUTDOWN FLAG 1A 00460I* BLANK = NO SHUTDOWN 00470I 27 27 CRSHUT 00480I* TIME STARTED 6N 00490I 28 330CRTIME 00500I* DATE STARTED 4N ÐÐ00510I 34 370CRDATE 00520I* CALL STACK 5 X 6A 00530I*** 38 67 CALL 00540I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00550I 68 73 CRRET 00560I* MENU NAME 6A 00570I 74 79 CRMENU 00580I******************************************************************** 0071200590IVMMAST VM 0071300600I 26 60 VMNAME 0071400610I******************************************************************** 00620ISFMAST SF 00630I* SCHEDULE MASTER. 00640I* COMMON FIELDS. 00650I* KEY AREA. 00660I 1 29 SFKEY 00670I* PART NO. 10N 00680I 1 100SFPN 00690I* DATE DUE 6N (YMD) 00700I 11 160SFDUE 00710I* RECORD CODE 2N 00720I* 10 = RECEIVED PO 00730I* 20 = REL WO 00740I* 30 = PURCHASE ORDER 00750I* 40 = PLAN WO ÐÐ00760I* 50 = PURCHASE REQ 00770I* 60 = SALES ORDER-BACKLOG 00780I* 70 = REL REQUIREMENT 00790I* 80 = PLAN REQUIREMENT 00800I* 90 = RUN RELEASE 00810I 17 180SFREC 00820I* ORDER NO. 00830I 19 29 SFORD 00840I* PREFIX 1A 00850I 19 19 SFPRFX 00860I* PRIME 5N 00870I 19 24 SFPRIM 00880I* DASH 3N 00890I 25 270SFDASH 00900I* RECEIVING LOG 2N 00910I 28 290SFRLOG 00920I* QUANTITY 7P 00930I P 30 330SFQTY 00940I* QTY COMPLETE 7P 00950I P 34 370SFQTYC 00960I* DATE LAST TRAN 6N (YMD) 00970I 38 430SFDLT 00980I* CUST #/DEPT #/VEND # 5P 00990I P 44 460SFCUST 01000I* VARIABLE AREA. ÐÐ01010I* PLAN/REL REQMTS 01020I* NEXT ASSY PART # 10N 01030I 47 560SFNAPN 01040I* QTY PER ASSY 7P 01050I P 57 600SFQPA 01060I* ISSUE CODE 2A 01070I 61 62 SFISSU 01080I* PULL # 3P 01090I P 63 640SFPULL 01100I* ASSY REVISION 2A 01110I 65 66 SFREV 01120I* ASSY WO QTY 7P 01130I 67 700SFQTYA 01140I* SALES ORDERS 01150I* CUST P.O. 20A 01160I 71 90 SFCPO 01170I* UNIT PRICE 9.3P 01180I P 91 953SFPRIC 01190I* PURCH ORDERS 01200I* VENDOR NAME 20A 01210I* SEE SFCPO UNDER SALES ORDERS. 01220I* UNIT PRICE 9.3P 01230I* SEE SFPRIC UNDER SALES ORDERS. 01240I* WORK ORDERS 01250I* DEPT NAME 20A ÐÐ01260I* SEE SFCPO UNDER SALES ORDERS. 01270I* OPER SEQ # 3P 01280I P 96 970SFSEQ 01290I* START DATE 6N 01300I 98 1030SFSTRT 01310I* PULL # 3P 01320I* SEE PLAN/REL REQMTS. 01330I* REQUIREMENT FLAG 1A 01340I 104 104 SFRFLG 01350I* REVISION 2A 01360I* SEE PLAN/REL REQMTS. 01370I* RECORD STATUS 1A 01380I 128 128 SFSTAT 01390I******************************************************************** 01400IPMMST2 PM 01410I 1 100PMPN 01420I 15 180PMPL 01430I 19 30 PMMODL 01440I 31 59 PMDESC 01450I 70 71 PMECHG 01460I 94 95 PMSC 01470I P 185 219 PA$ 01480I P 311 3140PMOHB 01490I P 347 3500PMRPOB 01500I P 367 3700PMPRCT ÐÐ01510I P 401 4030PMFRCT 01520I P 489 4933PMOSUC 01530I 674 674 PMSTAT 01540I*********************************************************************0072701550IORDERLOGOL 0072801560I 1 2 OLREC 0072901570I 3 13 OLORD 0073001580I 14 23 OLPN 0073101590I 24 29 OLDUE 0073201600I 30 30 OLTYPE 0073301610I 31 31 OLRFLG 0073401620I 32 32 OLSTAT 0073501630C******************************************************************** 0073601640C* INITIALIZE 01650C EXSR SR101 1-TIME INIT 01660C*------------------------------------------------------------------ 01670C START TAG 01680C* SET-UP 1ST FIELD NO. 01690C MOVE ' ' DUN INIT EDIT ARRAY 01700C Z-ADD1 F 30 FIELD # 01710C MOVE ' ' TRAN 01720C MOVE BLK10 TRNNAM 01730C MOVE BLK10 TPRIM 01740C Z-ADD0 TDASH 01750C Z-ADD0 TLOG ÐÐ01760C Z-ADD0 TQTY 01770C Z-ADD0 SFPN 01780C MOVE BLK35 PMDESC 01790C Z-ADD0 SFQTY 01800C Z-ADD0 QTYBAL 01810C Z-ADD0 SFCUST 01820C MOVE BLK35 VMNAME 01830C MOVE BLK35 SFCPO 01840C GOTO READ 01850C*------------------------------------------------------------------ 01860C NEXT TAG 01870C* SET-UP NEXT FIELD NO. 01880C 1 ADD F F FIELD # 01890C*----------------------------------------------------------------- 01900C READ TAG 01910C* READ DATA FROM TERMINAL. 01920C SETOF 909677 01930C EXSR SR102 VALIDATE FIELD # 01940C 55 GOTO UPDATE DONE 01950C EXSR SR201 IDENTIFY-F 01960C SETON 69 01970C EXSR SR72 PROMPT 01980C SETOF 69 01990C EXSR SR75 READ TERMINAL 02000C 98 GOTO GOODBY GOODBY ÐÐ02010C 94 GOTO MENU MENU REQUEST 02020C N77N88 EXSR SR104 EDIT INPUT FIELD 02030C 96 ERROR 02040CORN77N88 EXSR SR72 REWRITE INPUT DATA 02050C 93 GOTO NEWITM NEW ITEM 02060C 92 GOTO JUMP FIELD JUMP REQST 02070C 91 GOTO NEXT SKIP FORWARD 02080C 89 F SUB 1 F SKIP BACKWARD 02090C 89 GOTO READ " " 02100C 88 SETOF 90 SPACE FILL 02110C 88 SETON 77 " " 02120C 87 GOTO START 02130C 86 GOTO UPDATE UPDATE 02140C 85 GOTO READ REPEAT 02150C 96 GOTO ERROR ERROR 02160C N77 GOTO EDIT NO DATA INPUT 02170C*------------------------------------------------------------------ 02180C PROCES TAG 02190C* PROCESS INPUT DATA 02200C EXSR SR103 MOVE DATA 02210C*------------------------------------------------------------------- 02220C EDIT TAG 02230C N96 EXSR SR104 EDIT DATA 02240C EXSR SR72 REWRITE DATA 02250C 96 GOTO ERROR ERROR ÐÐ02260C GOTO NEXT 02270C*------------------------------------------------------------------ 02280C UPDATE TAG 02290C* UPDATE DATA BASE. 02300C EXSR SR105 FINAL EDIT 02310C 96 GOTO ERROR ERROR 02320C EXSR SR106 UPDATE 02330C 96 GOTO ERROR ERROR 02340C EXSR SR68 ROLL SCREEN UP 02350C COUNT COMP 30 54 54 02360C 54 EXSR SR71 PUT HEADING 02370C GOTO START 02380C*------------------------------------------------------------------- 02390C JUMP TAG 02400C* SET-UP JUMP TO REQUESTED FIELD 02410C 1 ADD W W 30 02420C W COMP 16 54 02430C 54 Z-ADD318 M 50 96 FLAG ERROR 02440C 54 GOTO ERROR BAD ESC 02450C MOVE ' ' W3A 3 02460C MOVEAA16,W W3A 02470C Z-ADD3 W2N 20 02480C EXIT SUBRAJ R. JUSTIFY 02490C RLABL W2N 02500C RLABL W3A ÐÐ02510C MOVE W3A F NEW FIELD # 02520C GOTO READ 02530C*-------------------------------------------------------------------- 02540C ERROR TAG 02550C EXSR SR102 VALIDATE FIELD # 02560C EXSR SR89 GET MSG 02570C EXSR SR73 PUT MSG 02580C GOTO READ 02590C*------------------------------------------------------------------ 02600C NEWITM TAG 02610C* SET-UP LINK FOR NEW ITEM 02620C MOVEL'Q109SF' PROG 8 02630C GOTO END 02640C*------------------------------------------------------------------- 02650C MENU TAG 02660C* SET-UP LINK TO MENU 02670C MOVELCRRET PROG 02680C GOTO END 02690C*-------------------------------------------------------------------- 02700C GOODBY TAG 02710C* LINK TO SIGN-OFF 02720C MOVEL'GOODBY' PROG 02730C GOTO END 02740C*------------------------------------------------------------------- 02750C END TAG ÐÐ02760C EXITFCHAIN LINK TO NEXT PROG 02770C RLABL PROG 02780C******************************************************************** 02790CSR SR1 BEGSR 02800C* EDIT TRAN CODE. 02810CSR EXSR SR203 CLASSIFY TRAN 02820CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02830CSR 60 MOVE 'STOCK ' TRNNAM 6 02840CSR 61 MOVE 'RTV ' TRNNAM 02850CSR 62 MOVE 'SCRAP ' TRNNAM 02860CSR ENDSR 02870C******************************************************************** 02880CSR SR2 BEGSR 02890C* EDIT PRIME. 02900CSR MOVE TPRIM W5A 5 02910CSR Z-ADD5 W2N 20 02920CSR EXIT SUBRAJ RJ 02930CSR RLABL W2N 02940CSR RLABL W5A 02950CSR MOVE W5A TPRIM 02960CSR MOVE W5A W5N 50 02970CSR W5N COMP 0 54 02980CSRN54 Z-ADD341 M 96 FLAG ERROR 02990CSR ENDSR 03000C******************************************************************** ÐÐ03010CSR SR3 BEGSR 03020C* EDIT DASH. 03030CSR TDASH COMP 0 54 03040CSRN54 Z-ADD341 M 96 FLAG ERROR 03050CSR ENDSR 03060C******************************************************************** 03070CSR SR4 BEGSR 03080C* EDIT LOG #. 03090CSR MOVE BLK35 VMNAME 03100CSR TLOG COMP 0 54 03110CSRN54 Z-ADD341 M 96 FLAG ERROR 03120CSRN54 GOTO END4 03130CSR MOVELTPRIM W9A 9 03140CSR MOVE TDASH W9A 03150CSR MOVELW9A TORD 11 03160CSR MOVE TLOG TORD 03170CSR EXSR SR81 GET ORDERLOG 03180CSR 60 Z-ADD5 M 96 FLAG ERROR 03190CSR 60 GOTO END4 03200CSR EXSR SR80 GET SFMAST 03210CSR 60 Z-ADD5 M 96 FLAG ERROR 03220CSRN60 EXSR SR83 GET VEND MAST 03230CSR END4 ENDSR 03240C******************************************************************** 03250CSR SR5 BEGSR ÐÐ03260C* EDIT QTY TO STOCK. 03270CSR TQTY COMP 0 54 03280CSRN54 Z-ADD184 M 96 FLAG ERROR 03290CSRN54 GOTO END5 03300CSR TQTY ADD SFQTYC W7N 70 03310CSR W7N COMP SFQTY 54 03320CSR 54 Z-ADD607 M 03330CSR 54 EXSR SR74 OVERSHIP WARNING 03340CSR END5 ENDSR 03350C******************************************************************** 03360CSR SR66 BEGSR 03370CSR EXITFQMOVUP BUMP UP 03380CSR ENDSR 03390C******************************************************************** 03400CSR SR67 BEGSR 03410CSR EXITFQCLF LINE FEED 03420CSR ENDSR 03430C******************************************************************** 03440CSR SR68 BEGSR 03450C* ROLL SCREEN-UP. 03460CSR MOVE '120001' W6A 03470CSR EXSR SR69 MOVE CURSOR 03480CSR EXSR SR67 LF 03490CSR EXSR SR66 BUMP CURSOR-UP 03500CSR 1 ADD COUNT COUNT 30 ÐÐ03510CSR ENDSR 03520C******************************************************************** 03530CSR SR69 BEGSR 03540CSR EXITFQXYPOS MOVE CURSOR 03550CSR RLABL W6A 03560CSR ENDSR 03570C********************************************************************** 03580CSR SR71 BEGSR 03590C* PUT HEADINGS TO TERMINAL 03600CSR MOVE '120001' W6A 6 03610CSR EXSR SR69 MOVE CURSOR 03620CSR Z-ADD6 COUNT 03630CSR SETON 71 03640CSR EXCPT PUT HEADINGS 03650CSR SETOF 71 03660CSR EXSR SR66 BUMP CURSOR UP 03670CSR ENDSR 03680C********************************************************************* 03690CSR SR72 BEGSR 03700C* PUT DATA TO TERMINAL 03710CSR SFCPO COMP BLK20 56 03720CSRN56 MOVELVMNAME SFCPO 03730CSR MOVE '118001' W6A 03740CSR SFCPO COMP BLK20 56 03750CSR EXSR SR69 MOVE CURSOR ÐÐ03760CSR TDASH COMP 0 55 03770CSR SETON 72 03780CSR EXCPT PUT DATA 03790CSR SETOF 72 03800CSR ENDSR 03810C*********************************************************************** 03820CSR SR73 BEGSR 03830C* PUT ERROR MESSAGE TO TERMINAL 03840CSR MOVE '119001' W6A 03850CSR EXSR SR69 POSITION CURSOR 03860CSR SETON 73 03870CSR EXCPT PUT MSG 03880CSR SETOF 73 03890CSR Z-ADDM LSTERR 50 03900CSR ENDSR 03910C*********************************************************************0071903920CSR SR74 BEGSR 0072003930C* PUT WARNING MESSAGE 0072103940CSR EXSR SR89 GET MESSAGE 0072203950CSR EXSR SR73 PUT MESSAGE 0072303960CSR ENDSR 0072403970C******************************************************************* 03980CSR SR75 BEGSR 03990C* READ FROM TERMINAL 04000CSR SETOF 779096 ÐÐ04010CSR SETOF 939291 04020CSR SETOF 898887 04030CSR SETOF 8685 04040CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 04050CSR MOVE BLK16 W16A 16 BUFFER 04060CSR MOVE BIT,28 A9,1 04070CSR MOVEA'8119' A9,2 04080CSR MOVEALOC,F A9,6 04090CSR MOVE BIT,8 A9,9 04100CSR MOVEAA9 W9A 04110CSR EXITFQPREED READ FROM TERMINAL 04120CSR RLABL W9A 04130CSR RLABL W16A READ BUFFER 04140CSR RLABL BUFLGT READ BUFFER LGTH 04150CSR MOVEAW16A A16 INPUT DATA ARRAY 04160CSR MOVE BLK16 W16A INIT INPUT ARRAY 04170CSR Z-ADD1 W 30 04180CSR '\' LOKUPA16,W 90 FLAG ESC 04190CSRN90 GOTO T75B NOT ESC 04200CSR 1 ADD W W 04210CSR W COMP 16 54 04220CSR 54 GOTO T75A BAD ESC 04230CSR A16,W COMP 'G' 98 GOODBY 04240CSR A16,W COMP 'E' 94 MENU 04250CSR A16,W COMP 'N' 93 NEW ITEM ÐÐ04260CSR A16,W COMP 'J' 92 JUMP 04270CSR A16,W COMP 'F' 91 SKIP FRWRD 04280CSR A16,W COMP 'B' 89 SKIP BKWRD 04290CSR A16,W COMP 'S' 88 SPACE FILL 04300CSR A16,W COMP 'H' 87 HOME 04310CSR A16,W COMP 'U' 86 UPDATE 04320CSR A16,W COMP 'R' 85 REPEAT 04330CSR 98 04340COR 94 04350COR 93 04360COR 92 04370COR 91 04380COR 89 04390COR 88 04400COR 87 04410COR 86 04420COR 85 GOTO END75 GOOD ESC 04430C*------------------------------------------------------------------ 04440CSR T75A TAG 04450C* FLAG BAD ESC INPUT 04460CSR Z-ADD318 M 96 FLAG ERROR 04470CSR GOTO END75 04480C*-------------------------------------------------------------------- 04490CSR T75B TAG 04500C* MOVE DATA ÐÐ04510CSR Z-ADD1 W 04520CSR ' ' LOKUPA16,W 77 04530CSR 77 MOVEAA16,W W16A INPUT DATA 04540C*-------------------------------------------------------------------- 04550CSR END75 TAG 04560C* INIT PREV ERROR MSG. 04570CSR LSTERR COMP 0 54 04580CSR 54 MOVE BLK35 MGTEXT 04590CSR 54 EXSR SR73 BLANK MESSAGE 04600CSR Z-ADD0 LSTERR 50 04610CSR ENDSR 04620C********************************************************************** 04630CSR SR80 BEGSR 04640C* GET MASTER RECORD 04650CSR MOVEAOLPN A29 04660CSR MOVEA'000000' A29,11 04670CSR MOVEA'10' A29,17 04680CSR MOVEATORD A29,19 04690CSR MOVEAA29 W29A 29 04700CSR W29A CHAINSFMAST 60 GET MASTER 04710CSRN60 SFSTAT COMP 'D' 60 FLAG DELETE 04720CSR 60 GOTO END80 04730CSR SFQTY SUB SFQTYC QTYBAL 70 54 0072504740CSRN54 Z-ADD0 QTYBAL 0072604750CSR MOVELSFPN W12A 12 ÐÐ04760CSR MOVE ' ' W12A 04770CSR W12A CHAINPMMST2 60 04780CSR 60 Z-ADD291 M 96 FLAG ERROR 04790CSR END80 ENDSR 04800C********************************************************************** 04810CSR SR81 BEGSR 04820C* GET ORDERLOG. 04830CSR MOVEL'10' W13A 13 04840CSR MOVE TORD W13A 04850CSR W13A CHAINORDERLOG 60 04860CSRN60 OLSTAT COMP 'D' 60 04870CSR ENDSR 04880C*********************************************************************** 04890CSR SR82 BEGSR 04900C* REWRITE MASTER 04910CSR TQTY MULT PA$,1 LAB$ 93 04920CSR TQTY MULT PA$,2 LABBUR 93 04930CSR TQTY MULT PA$,3 MAT$ 93 04940CSR TQTY MULT PA$,4 MATBUR 93 04950CSR SETON 82 04960CSR EXCPT REWRITE MASTER 04970CSR SETOF 82 04980CSR ENDSR 04990C******************************************************************** 05000CSR SR83 BEGSR ÐÐ05010C* GET VENDOR MAST. 05020CSR SFCUST CHAINVMMAST 60 05030CSR 60 MOVELBLK35 VMNAME 05040CSR ENDSR 05050C********************************************************************** 05060CSR SR89 BEGSR 05070C* GET MESSAGE MASTER 05080CSR M CHAINMGFILE 54 05090CSR 54 MOVE BLK35 MGTEXT 05100CSR 54 MOVELM MGTEXT 05110CSR 54 MOVE MES,1 MGTEXT 05120CSR ENDSR 05130C*********************************************************************** 05140CSR SR101 BEGSR 05150C* 1-TIME INITIALIZE 05160CSR MOVE BIT,1 NUL 05170CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05180CSR Z-ADD5 FLIMIT 30 TOTAL NUMB FIELDS 05190CSR MOVE ' ' BLK16 16 05200C* GET PORT # AND CRTFILE 05210CSR MOVE ' ' W8A 8 05220CSR Z-ADD0 W2N 20 05230CSR Z-ADD0 W1N 10 05240CSR MOVE ' ' W2A 2 05250CSR EXITFPGMINX GET PORT # ÐÐ05260CSR RLABL W8A 05270CSR RLABL W2N 05280CSR RLABL W1N 05290CSR RLABL W2A 05300CSR MOVE W2A PORT 20 PORT NO. 05310CSR PORT COMP 0 54 05320CSRN54 Z-ADD25 PORT DEFAULT 05330CSR PORT CHAINCRTFILE H9 05340CSR EXSR SR71 PUT HEADING 05350C* DEFINE WORK FIELDS,ETC. 05360CSR MOVELUDATE W4N 40 05370CSR MOVE UDATE W2N 20 05380CSR MOVELW2N TODAY 60 05390CSR MOVE W4N TODAY 05400CSR MOVE ' ' BLK35 35 05410CSR MOVE ' ' BLK10 10 05420CSR MOVE ' ' BLK20 20 05430CSR ENDSR 05440C********************************************************************** 05450CSR SR102 BEGSR 05460C* VALIDATE FIELD NO. 05470CSR F COMP 0 54 05480CSRN54 Z-ADD1 F 05490CSR F COMP FLIMIT 55 05500CSR 55 Z-ADD1 F ÐÐ05510CSR ENDSR 05520C******************************************************************** 05530CSR SR103 BEGSR 05540C* MOVE INPUT DATA 05550CSR EXSR SR201 IDENTIFY-F 05560CSR EXSR SR202 R. JUSTIFY 05570CSR 01 MOVELW16A TRAN 1 TRAN CODE 05580CSR 02 MOVELW16A TPRIM 6 ORDER PRIME 05590CSR 03 MOVE W10A TDASH 30 ORDER DASH 05600CSR 04 MOVE W10A TLOG 20 RECEIVING LOG # 05610CSR 05 MOVE W10A TQTY 70 QTY 05620CSR MOVE ' ' DUN,F EDIT FLAG 05630CSR ENDSR 05640C******************************************************************** 05650CSR SR104 BEGSR 05660C* EDIT INPUT DATA 05670CSR 01 EXSR SR1 05680CSR 02 EXSR SR2 05690CSR 03 EXSR SR3 05700CSR 04 EXSR SR4 05710CSR 05 EXSR SR5 05720CSR 96 MOVE ' ' DUN,F EDIT FLAG 05730CSRN96 MOVE 'X' DUN,F 05740CSR ENDSR 05750C*********************************************************************** ÐÐ05760CSR SR105 BEGSR 05770C* FINAL EDIT 05780CSR SETOF 77 05790CSR SETON 79 FINAL EDIT FLAG 05800CSR Z-ADD1 F 96 05810C*-------------------------------------------------------------------- 05820CSR T105A TAG 05830CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05840CSRN54 GOTO END105 05850CSR EXSR SR201 IDENTIFY-F 05860CSR EXSR SR104 EDIT 05870CSRN96 GOTO T105A 05880C*-------------------------------------------------------------------- 05890CSR END105 TAG 05900CSR SETOF 79 05910CSR ENDSR 05920C******************************************************************** 05930CSR SR106 BEGSR 05940C* UPDATE. 05950CSR SFQTY SUB SFQTYC QTYBAL 70 05960CSR TQTY COMP QTYBAL 54 05970CSR 54 Z-ADDTQTY W7N 05980CSRN54 Z-ADDQTYBAL W7N 05990CSR PMRPOB SUB W7N PMRPOB RPO BAL 06000CSR TQTY ADD PMPRCT PMPRCT PLAN RCPT QTY ÐÐ06010CSR 1 ADD PMFRCT PMFRCT PLAN RCPT FREQ 06020CSR TQTY ADD SFQTYC SFQTYC 06030CSR EXSR SR203 CLASSIFY TRAN 06040CSR 60 TQTY ADD PMOHB PMOHB 06050CSR EXSR SR82 UPDATE RECD PO SFMAST06060CSR ENDSR 06070C************************************************************************ 06080CSR SR201 BEGSR 06090C* IDENTIFY FIELD NO. 06100CSR F COMP 1 01 06110CSR F COMP 2 02 06120CSR F COMP 3 03 06130CSR F COMP 4 04 06140CSR F COMP 5 05 06150CSR ENDSR 06160C********************************************************************** 06170CSR SR202 BEGSR 06180C* RIGHT JUSTIFY 06190CSR F LOKUPNUM 54 06200CSRN54 GOTO END202 NOT NUMERIC FIELD 06210CSR Z-ADD10 W2N 20 06220CSR MOVELW16A W10A 10 06230CSR EXIT SUBRAJ R. JUSTIFY 06240CSR RLABL W2N 06250CSR RLABL W10A ÐÐ06260CSR END202 ENDSR 06270C*********************************************************************** 06280CSR SR203 BEGSR 06290C* CLASSIFY TRAN CODE 06300CSR TRAN COMP '1' 60 STOCK 06310CSR TRAN COMP '2' 61 RTV 06320CSR TRAN COMP '3' 62 SCRAP 06330CSR ENDSR 06340O******************************************************************** 06350OTERM132 E 71 06360O 1 ' ' 06370O*------------------------------------------------------------------- 06380O E 71 06390O 66 'RECEIVED PURCHASE' 06400O 83 'ORDER PROCESSING' 06410O UDATE Y 8 06420O*------------------------------------------------------------------- 06430O E 71 06440O 1 ' ' 06450O*------------------------------------------------------------------- 06460O E 71 06470O 4 'TRAN' 06480O 39 'THIS' 06490O 98 'QUANTITY' 06500O*------------------------------------------------------------------- ÐÐ06510O E 71 06520O 4 'CODE' 06530O 18 'ORDER' 06540O 24 'ITEM' 06550O 30 'LOG #' 06560O 41 'QUANTITY' 06570O 53 'PART NO.' 06580O 69 'DESCRIPTION' 06590O 96 'OPEN' 06600O 114 'VENDOR' 06610O*------------------------------------------------------------------- 06620O E 71 06630O 3 '(1)' 06640O 17 '(2)' 06650O 22 '(3)' 06660O 30 '(4)' 06670O 39 '(5)' 06680O*------------------------------------------------------------------- 06690O E 71 06700O 1 ' ' 06710O*------------------------------------------------------------------- 06720O E 71 06730O 1 ' ' 06740O*------------------------------------------------------------------- 06750O E 71 ÐÐ06760O 1 ' ' 06770O*------------------------------------------------------------------- 06780O E 72 06790O TRAN 2 06800O TRNNAM 10 06810O TPRIM 19 06820O 55 TDASH 23 06830O 55 20 '-' 06840O TLOG Z 30 06850O TQTY 2 41 06860O SFPN 56 ' - - ' 06870O PMDESC 88 06880O QTYBAL2 97 06890O N56 SFCUSTZ 115 06900O 56 SFCPO 132 06910O*------------------------------------------------------------------- 06920O E 73 06930O MGTEXT 35 06940O BIT,28 130 06950O 131 'K' 06960O BIT,8 132 06970O******************************************************************** 06980OSFMAST E 82 06990O SFPN 10 07000O SFDUE 16 ÐÐ07010O SFREC 18 07020O SFORD 29 07030O SFQTY 33P 07040O SFQTYC 37P 07050O SFDLT 43 07060O SFCUST 46P 07070O SFNAPN 56 07080O SFQPA 60P 07090O SFISSU 62 07100O SFPULL 64P 07110O SFREV 66 07120O SFQTYA 70 07130O SFCPO 90 07140O SFPRIC 95P 07150O SFSEQ 97P 07160O SFSTRT 103 07170O SFRFLG 104 07180O SFSTAT 128 07190O******************************************************************* 07200OPMMST2 E 82 07210O PA$ 219P 07220O PMOHB 314P 07230O PMRPOB 350P 07240O PMPRCT 370P 07250O PMFRCT 403P ÐÐ07260O PMOSUC 493P 07270O******************************************************************** 07280OMATLDISTEADD 82 07290O SFPN 10 07300O 11 '7' 07310O TORD 20 07320O TQTY 26P 07330O PMOSUC 35P 07340O TODAY 42 07350O CREMPL 45P 07360O LAB$ 50P 07370O LABBUR 55P 07380O MAT$ 60P 07390O MATBUR 65P 07400O 80 'A' ** NUL ARRAY 007410 007420** A16 ARRAY 007430 007440** NUM ARRAY 007450003 DASH 007460004 LOG 07470005 QTY 07480** LOC ARRAY 07490003 TRAN 07500ÐÐ015 PRIME 07510021 DASH 07520030 LOG 07530034 QTY 07540** DUN ARRAY 007550 007560** MES ARRAY 007570---MESSAGE NOT ON FILE--- 007580** A29 ARRAY 07590 07600** A9 ARRAY 007610 07620/* 07630_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(è> è¡X002EF P999999120282(èÈÐ00010H Q002EF00020F* JOB MASTER UPDATE. (X002EF) 00030F* REVISED 8-28-82 12:20 PM. 00040FBITPAR IP F 90 DISK 00050FMGFILE IC F 80R DISK 00060FCRTFILE UC F 256R DISK 00070FEFMAST UC F 90R28AI 1 DISK A 00080FTERM132 O F 132 5 00090F**************************************************************** 00100E NUL 1 132 1 NULL CHAR 00110E A28 28 28 1 A INPUT DATA ARRAY 00120E A39 39 39 1 MGTEXT ARRAY 00130E NUM 1 4 3 0 NUMERIC FIELD NO.'S 00140E DUN 1 10 1 A EDIT CMPLT FLAG 00150E MES 1 1 30 00160E LNK 1 7 6 A 00170E DOT 20 20 2 00180E TABPUM 1 5 1 TABPUN 10 00190E* 00200E BIT 33 1 SCREEN CONTR. CHAR 00210E PAR 25 1 00220E TST 25 1 00230E CALL 7 6 CALL STACK 00240E* 00250E* ÐÐ00260I******************************************************************* 00270IBITPAR BT 00280I 1 33 BIT 00290I 34 58 PAR 00300I 59 83 TST 00310I******************************************************************* 00320IMGFILE MG 00330I* MESSAGE FILE. 00340I 1 35 MGTEXT 00350I****************************************************************** 00360ICRTFILE CR 00370I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00380I* EMPLOYEE # 5N 00390I* 1 50CREMPL 00400I* USER CODE 8A 00410I* 6 13 CRUSER 00420I* DEPT # 5N 00430I* 14 180CRDEPT 00440I* JOB NAME 8A (JOB LOADED BY MENU) 00450I* 19 26 CRJOB 00460I* SHUTDOWN FLAG 1A 00470I* BLANK = NO SHUTDOWN 00480I 27 27 CRSHUT 00490I* TIME STARTED 6N 00500I 28 330CRTIME ÐÐ00510I* DATE STARTED 4N 00520I 34 370CRDATE 00530I* CALL STACK 7 X 6A 00540I 38 79 CALL 00550I******************************************************************** 00560IEFMAST EF 00570I* JOB MASTER 00580I* JOB NAME 28A 00590I 1 28 EFJOB 00600I* JOB CODE 5A 00610I 29 33 EFCODE 00620I* JOB GRADE 2N 00630I 34 350EFGRAD 00640I* LOW RATE RANGE 7.2P 00650I P 36 392EFLOW 00660I* HIGH RANGE 7.2P 00670I P 40 432EFHI 00680I* RATE MEDIAN 7.2P 00690I P 44 472EFMED 00700I* RATE UNIT 1A (H,W,M,A,Y) 00710I 48 48 EFUM 00720I* REMARKS LINE 1 20A 00730I 49 68 EFREM1 00740I* REMARKS LINE 2 20A 00750I 69 88 EFREM2 ÐÐ00760I* RECORD STATUS 1A 00770I 90 90 EFSTAT 00780C******************************************************************** 00790C* NOTE: INDICATORS 50 = DATAGRAPHIX 132-1 CRT 00800C* INITIALIZE 00810C EXSR SR101 1-TIME INIT 00820C MOVE ' ' BLK6 6 STUPIDITY 00830C*------------------------------------------------------------------ 00840C START TAG 00850C* SET-UP 1ST FIELD NO. 00860C EXSR SR66 INIT A39 00870C MOVE ' ' DUN INIT EDIT ARRAY 00880C Z-ADD1 F 30 FIELD # 00890C EXSR SR205 INIT MAST 00900C EXSR SR206 INIT INPUT 00910C EXSR SR70 CLEAR SCREEN 00920C GOTO READ 00930C*------------------------------------------------------------------ 00940C NEXT TAG 00950C EXSR SR66 INIT A39 00960C 1 ADD F F FIELD # 00970C*----------------------------------------------------------------- 00980C READ TAG 00990C* READ DATA FROM TERMINAL. 01000C SETOF 909677 ÐÐ01010C EXSR SR102 VALIDATE FIELD # 01020C 55 GOTO UPDATE DONE 01030C EXSR SR203 CLASSIFY TRAN 01040C F COMP 3 54 01050C 54 62 GOTO UPDATE 01060C EXSR SR201 IDENTIFY-F 01070C SETON 69 01080C EXSR SR72 PROMPT 01090C SETOF 69 01100C EXSR SR75 READ TERMINAL 01110C 90N88 EXSR SR72 DISPLAY INPUT DATA 01120C 93 GOTO START NEW ITEM 01130C 92 GOTO JUMP FIELD JUMP REQST 01140C 89 F SUB 1 F SKIP BACKWARD 01150C 89 GOTO READ " " 01160C 88 SETOF 90 SPACE FILL 01170C 88 SETON 77 " " 01180C 86 GOTO UPDATE UPDATE 01190C 85 GOTO READ REPEAT 01200C 96 GOTO ERROR ERROR 01210C 77 EXSR SR103 MOVE DATA 01220C*------------------------------------------------------------------- 01230C EDIT TAG 01240C N96 EXSR SR104 EDIT DATA 01250C EXSR SR72 REWRITE DATA ÐÐ01260C 96 GOTO ERROR ERROR 01270C GOTO NEXT 01280C*------------------------------------------------------------------ 01290C UPDATE TAG 01300C* UPDATE DATA BASE. 01310C EXSR SR105 FINAL EDIT 01320C 96 GOTO ERROR ERROR 01330C EXSR SR106 UPDATE 01340C 96 GOTO ERROR ERROR 01350C 1 ADD COUNT COUNT 30 01360C GOTO START 01370C*------------------------------------------------------------------- 01380C JUMP TAG 01390C* SET-UP JUMP TO REQUESTED FIELD 01400C 1 ADD W W 30 01410C W COMP 28 54 01420C 54 Z-ADD318 M 50 96 FLAG ERROR 01430C 54 GOTO ERROR BAD ESC 01440C MOVE ' ' W3A 3 01450C MOVEAA28,W W3A 01460C Z-ADD3 W2N 20 01470C EXIT SUBRAJ R. JUSTIFY 01480C RLABL W2N 01490C RLABL W3A 01500C MOVE W3A F NEW FIELD # ÐÐ01510C GOTO READ 01520C*-------------------------------------------------------------------- 01530C ERROR TAG 01540C EXSR SR102 VALIDATE FIELD # 01550C EXSR SR89 GET MSG 01560C* * * * * EXSR SR73 PUT MSG 01570C GOTO READ 01580C*------------------------------------------------------------------ 01590C NEWITM TAG 01600C MOVEL'Q002EF' PROG 01610C GOTO END 01620C*------------------------------------------------------------------- 01630C MENU TAG 01640C* SET-UP LINK TO MENU 01650C EXSR SR96 GET CRTFILE 01660C Z-ADD1 W 01670C BLK6 LOKUPLNK,W 54 01680C 54 MOVELLNK,W PROG 8 01690C 54 MOVE BLK6 LNK,W 01700C N54 MOVEL'CONTU' PROG 01710C EXSR SR97 UPDATE CRTFILE 01720C EXSR SR98 >>>>>>>>>>>>> 01730C*-------------------------------------------------------------------- 01740C GOODBY TAG 01750C* LINK TO SIGN-OFF ÐÐ01760C MOVEL'GOODBY' PROG 01770C*---------------------------------------------------------------- 01780C END TAG 01790C EXSR SR96 GET CRTFILE 01800C EXSR SR97 REWRITE CRTFILE 01810C EXSR SR98 >>>>>>>>>>> 01820C*------------------------------------------------------------------- 01830C ENDJOB TAG 01840C MOVEL'ENDJOB' PROG 01850C EXSR SR98 >>>>>>>>>>>>>>>> 01860C********************************************************************* 01870CSR SR1 BEGSR 01880C* EDIT TRAN CODE 01890CSR EXSR SR203 CLASSIFY TRAN 01900CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 01910CSR ENDSR 01920C******************************************************************** 01930CSR SR2 BEGSR 01940C* EDIT JOB CODE 01950CSR TJOB COMP BLK28 54 01960CSRN54 Z-ADD384 M 96 FLAG ERROR 01970CSRN54 GOTO END2 01980CSR EXSR SR80 GET EFMAST 01990CSRN30N31 GOTO T2C GOT IT 02000C* NOT ON FILE CONDITION ÐÐ02010CSR EXSR SR203 CLASSIFY TRAN 02020CSR EXSR SR205 INITIALIZE EFMAST 02030CSR EXSR SR71 PUT SCREEN 02040CSRN60 Z-ADD5 M 96 FLAG ERROR 02050CSR GOTO END2 02060C*---------------------------------------------------------------------- 02070CSR T2C TAG 02080C* IS ON FILE CONDITION 02090CSR EXSR SR203 CLASSIFY TRAN 02100CSR EXSR SR71 PUT SCREEN 02110CSR 60 Z-ADD4 M 96 FLAG ERROR 02120CSR END2 ENDSR 02130C******************************************************************** 02140CSR SR6 BEGSR 02150C* EDIT RATE RANGE UNIT MEASURE 02160CSR EFLOW COMP 0 54 02170CSR EFHI COMP 0 55 02180CSR EFMED COMP 0 56 02190CSR EFUM COMP ' ' 57 02200CSR 54N57 02210COR 55N57 02220COR 56N57 Z-ADD387 M 96 FLAG ERROR 02230CSR 96 02240CORN57 GOTO END6 02250CSR EFUM LOKUPTABPUM TABPUN 54 ÐÐ02260CSR 54 MOVE TABPUN PAYNAM 10 PAY UM NAME 02270CSRN54 Z-ADD387 M 96 FLAG ERROR 02280CSR END6 ENDSR 02290C******************************************************************** 02300CSR SR66 BEGSR 02310CSR MOVEABLK35 A39,3 INIT A39 02320CSR ENDSR 02330C******************************************************************** 02340CSR SR67 BEGSR 02350CSR EXITFZCR 02360CSR ENDSR 02370C***************************************************************** 02380CSR SR68 BEGSR 02390CSR EXITFZLF LINE FEED 02400CSR ENDSR 02410C**************************************************************** 02420CSR SR69 BEGSR 02430CSR 50 EXITFZPUTXY MOVE CURSOR 02440CSR RLABL RPGLIN 02450CSR RLABL RPGCOL 02460CSRN50 EXITFZMOVXY MOVE CURSOR 02470CSR RLABL RPGLIN 02480CSR RLABL RPGCOL 02490CSR ENDSR 02500C***************************************************************** ÐÐ02510CSR SR70 BEGSR 02520C* CLEAR TERM SCREEN. 02530CSR 50 EXITFZISTAT INIT STATUS LINE 02540CSR 50 EXITFZESCH CLEAR SCREEN 02550CSRN50 EXITFZCPAGE CLEAR SCREEN 02560CSRN50 MOVEL'091' RPGLIN 02570CSRN50 MOVEL'001' RPGCOL 02580CSRN50 EXSR SR69 MOVE CURSOR 02590CSR Z-ADD91 COUNT 30 02600CSR SETON 70 02610CSRN51 EXCPT PUT PARTIAL HDG 02620CSR SETOF 70 02630CSR ENDSR 02640C********************************************************************** 02650CSR SR71 BEGSR 02660C* PUT HEADINGS TO TERMINAL 02670CSR SETON 71 02680CSR EXCPT PUT HEADINGS 02690CSR SETOF 71 02700CSR ENDSR 02710C********************************************************************* 02720CSR SR72 BEGSR 02730C* PUT DATA TO TERMINAL 02740CSR F ADD 91 W3N 30 02750CSR 50 W3N SUB 90 W3N ÐÐ02760CSR MOVELW3N RPGLIN 4 02770CSR MOVEL'001' RPGCOL 4 02780CSR EXSR SR69 MOVE CURSOR 02790CSR SETON 72 02800CSR EXCPT PUT DATA 02810CSR SETOF 72 02820CSR ENDSR 02830C******************************************************************* 02840CSR SR75 BEGSR 02850C* READ FROM TERMINAL 02860CSR SETOF 779096 02870CSR SETOF 9392 02880CSR SETOF 8988 02890CSR SETOF 8685 02900CSR EXSR SR66 INIT A39 02910CSR MOVE BLK28 W28A 28 BUFFER 02920CSR F ADD 92 W3N 30 02930CSR 50 W3N SUB 90 W3N 02940CSR MOVELW3N RPGLIN 4 02950CSR MOVEL'044' RPGCOL 4 02960CSR EXSR SR69 MOVE CURSOR 02970CSR EXITFZR28 READ FROM TERMINAL 02980CSR RLABL W28A READ BUFFER 02990CSR MOVEAW28A A28 INPUT DATA ARRAY 03000CSR MOVE BLK28 W28A INIT INPUT ARRAY ÐÐ03010CSR Z-ADD1 W 30 03020CSR '\' LOKUPA28,W 90 FLAG ESC 03030CSRN90 GOTO T75B NOT ESC 03040CSR 1 ADD W W 03050CSR W COMP 28 54 03060CSR 54 GOTO T75A BAD ESC 03070CSR A28,W COMP 'G' 98 GOODBY 03080CSR A28,W COMP 'E' 94 MENU 03090CSR A28,W COMP 'N' 93 NEW ITEM 03100CSR A28,W COMP 'J' 92 JUMP 03110CSR A28,W COMP 'B' 89 SKIP BKWRD 03120CSR A28,W COMP 'S' 88 SPACE FILL 03130CSR A28,W COMP 'U' 86 UPDATE 03140CSR A28,W COMP 'R' 85 REPEAT 03150CSR 98 GOTO GOODBY 03160CSR 94 GOTO MENU 03170CSR 93 GOTO NEWITM 03180CSR 92 03190COR 89 03200COR 88 03210COR 86 03220COR 85 GOTO END75 GOOD ESC 03230C*------------------------------------------------------------------ 03240CSR T75A TAG 03250C* FLAG BAD ESC INPUT ÐÐ03260CSR Z-ADD318 M 96 FLAG ERROR 03270CSR GOTO END75 03280C*-------------------------------------------------------------------- 03290CSR T75B TAG 03300C* MOVE DATA 03310CSR Z-ADD1 W 03320CSR ' ' LOKUPA28,W 77 03330CSR 77 MOVEAA28,W W28A INPUT DATA 03340C*-------------------------------------------------------------------- 03350CSR END75 TAG 03360C* INIT PREV ERROR MSG. 03370CSR MOVEABLK35 A39,3 03380CSR ENDSR 03390C********************************************************************** 03400CSR SR80 BEGSR 03410C* GET MASTER RECORD 03420CSR SETOF 31 03430CSR TJOB CHAINEFMAST 30 GET MASTER 03440CSRN30 EFSTAT COMP 'D' 31 FLAG DELETE 03450CSR 30 03460COR 31 EXSR SR205 INIT MASTER 03470CSR ENDSR 03480C********************************************************************** 03490CSR SR81 BEGSR 03500C* ADD NEW MASTER TO FILE ÐÐ03510CSR SETON 81 03520CSR EXCPT ADD MASTER 03530CSR SETOF 81 03540CSR ENDSR 03550C*********************************************************************** 03560CSR SR82 BEGSR 03570C* REWRITE MASTER 03580CSR SETON 82 03590CSR EXCPT REWRITE MASTER 03600CSR SETOF 82 03610CSR ENDSR 03620C********************************************************************** 03630CSR SR89 BEGSR 03640C* GET MESSAGE MASTER 03650CSR M CHAINMGFILE 54 03660CSR 54 MOVE BLK35 MGTEXT 03670CSR 54 MOVELM MGTEXT 03680CSR 54 MOVE MES,1 MGTEXT 03690CSR MOVEAMGTEXT A39,3 03700CSR ENDSR 03710C******************************************************************** 03720CSR SR96 BEGSR 03730CSR # CHAINCRTFILE H9 GET CRTFILE 03740CSR H9 GOTO ENDJOB 03750CSR ENDSR ÐÐ03760C****************************************************************** 03770CSR SR97 BEGSR 03780C* UPDATE CRTFILE. EXIT PROGRAM. 03790CSR TIME CRTIME 03800CSR MOVELUDATE CRDATE 03810CSR SETON 97 03820CSR EXCPT UPDATE CRTFILE 03830CSR SETOF 97 03840CSR ENDSR 03850C******************************************************************** 03860CSR SR98 BEGSR 03870CSR SETON 51 03880CSR EXSR SR70 CLEAR SCREEN 03890CSR EXITFCHAIN >>>>>>>>>> 03900CSR RLABL PROG 03910CSR ENDSR 03920C******************************************************************** 03930CSR SR99 BEGSR 03940C* STORE THIS PROG AS RETURN TO PROG. 03950CSR EXSR SR96 GET CRTFILE 03960CSR Z-ADD8 W 03970C*------------------------------------------------------------------- 03980CSR T99A TAG 03990CSR W SUB 1 W 54 04000CSRN54 GOTO ENDJOB >>>>>>>>>>>>>>>>>> ÐÐ04010CSR LNK,W COMP BLK6 54 04020CSRN54 GOTO T99A 04030CSR MOVELRETURN LNK,W 04040CSR EXSR SR97 UPDATE CRTFILE 04050CSR EXSR SR98 >>>>>>>>>>>>>> 04060CSR END99 ENDSR 04070C*********************************************************************** 04080CSR SR101 BEGSR 04090C* 1-TIME INITIALIZE 04100CSR MOVE BIT,1 NUL 04110CSR MOVE ' ' A39 04120CSR MOVE BIT,28 A39,1 04130CSR MOVE 'D' A39,2 04140CSR MOVE BIT,28 A39,38 04150CSR MOVE 'E' A39,39 04160CSR MOVEL'-' DOT 04170CSR MOVE '>' DOT,20 04180CSR Z-ADD10 FLIMIT 30 TOTAL NUMB FIELDS 04190CSR MOVE ' ' BLK28 28 04200C* GET PORT # AND CRTFILE 04210CSR MOVE ' ' W2A 2 04220CSR EXITFZGMINX GET PORT # 04230CSR RLABL W2A 04240CSR MOVE W2A # 20 PORT NO. 04250CSR # COMP 0 54 ÐÐ04260CSRN54 Z-ADD25 # DEFAULT 04270CSR EXSR SR96 GET CRTFILE 04280CSR MOVE CALL LNK 04290CSR MOVE 'Q002EF 'PROG 04300CSR PAR,# COMP '1' 50 FLAG DG-132-1 CRT 04310CSR TST,# COMP 'S' 56 04320CSRN56 CRSHUT COMP 'S' 56 04330CSR 56 MOVE 'S' CRSHUT SHUTDOWN 04340CSR 56 MOVE 'SHUTDOWN'PROG 04350CSR EXSR SR97 UPDATE CRTFILE 04360CSR 56 EXSR SR98 >>>>>>>>>>>>> 04370C* DEFINE WORK FIELDS,ETC. 04380CSR MOVE ' ' BLK35 35 04390CSR MOVE ' ' BLK6 6 04400CSR MOVE ' ' RETURN 8 04410CSR MOVE ' ' BLK15 15 04420C* 04430C* 04440C* 04450C* 04460CSR ENDSR 04470C********************************************************************** 04480CSR SR102 BEGSR 04490C* VALIDATE FIELD NO. 04500CSR F COMP 0 54 ÐÐ04510CSRN54 Z-ADD1 F 04520CSR F COMP FLIMIT 55 04530CSR 55 Z-ADD1 F 04540CSR ENDSR 04550C******************************************************************** 04560CSR SR103 BEGSR 04570C* MOVE INPUT DATA 04580CSR EXSR SR201 IDENTIFY-F 04590CSR EXSR SR202 R. JUSTIFY 04600CSR 01 MOVELW28A TRAN 1 TRAN CODE 04610CSR 02 MOVELW28A TJOB 28 JOB NAME 04620CSR 03 MOVELW28A EFCODE JOB CODE 04630CSR 04 MOVE W10A EFGRAD JOB GRADE 04640CSR 05 MOVE W10A EFLOW LOW RANGE 04650CSR 06 MOVE W10A EFHI HIGH RANGE 04660CSR 07 MOVE W10A EFMED MEDIAN RATE 04670CSR 08 MOVELW28A EFUM RATE UNIT MEAS 04680CSR 09 MOVELW28A EFREM1 REMARKS LINE 1 04690CSR 10 MOVELW28A EFREM2 REMARKS LINE 2 04700CSR MOVE ' ' DUN,F EDIT FLAG 04710CSR ENDSR 04720C******************************************************************** 04730CSR SR104 BEGSR 04740C* EDIT INPUT DATA 04750CSR 01 EXSR SR1 ÐÐ04760CSR 02 EXSR SR2 04770CSR 08 EXSR SR203 CLASSIFY TRAN 04780CSR 08N62 EXSR SR6 04790CSR 96 MOVE ' ' DUN,F EDIT FLAG 04800CSRN96 MOVE 'X' DUN,F 04810CSR ENDSR 04820C*********************************************************************** 04830CSR SR105 BEGSR 04840C* FINAL EDIT 04850CSR SETOF 77 04860CSR SETON 79 FINAL EDIT FLAG 04870CSR Z-ADD1 F 96 04880C*-------------------------------------------------------------------- 04890CSR T105A TAG 04900CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 04910CSRN54 GOTO END105 04920CSR EXSR SR201 IDENTIFY-F 04930CSR EXSR SR104 EDIT 04940CSRN96 GOTO T105A 04950C*-------------------------------------------------------------------- 04960CSR END105 TAG 04970CSR SETOF 79 04980CSR ENDSR 04990C******************************************************************** 05000CSR SR106 BEGSR ÐÐ05010C* UPDATE DATA BASE. 05020CSR EXSR SR203 CLASSIFY TRAN 05030CSR 60 GOTO T106A ADD TRAN 05040CSR 61 GOTO T106D CHANGE TRAN 05050CSR 62 GOTO T106F DELETE TRAN 05060C* FLAG BAD TRAN CODE 05070CSR Z-ADD300 M 96 FLAG ERROR 05080CSR Z-ADD1 F FIELD # 05090CSR GOTO END106 05100C*------------------------------------------------------------------- 05110CSR T106A TAG 05120C* ADD TRANSACTION 05130CSR 30 GOTO T106B NOT ON FILE 05140CSR 31 GOTO T106C DELETED MASTER 05150C* FLAG DUPLICATE ADD ERROR 05160CSR Z-ADD301 M 96 FLAG ERROR 05170CSR Z-ADD1 F FIELD # 05180CSR GOTO END106 05190C*--------------------------------------------------------------------- 05200CSR T106B TAG 05210C* ADD-- MAST NOT ON FILE 05220CSR EXSR SR81 ADD NEW MASTER 05230CSR GOTO END106 05240C*--------------------------------------------------------------------- 05250CSR T106C TAG ÐÐ05260C* ADD-- MAST IS DELETED 05270CSR MOVE 'A' EFSTAT RECORD STATUS 05280CSR EXSR SR82 REWRITE MAST 05290CSR GOTO END106 05300C*---------------------------------------------------------------------- 05310CSR T106D TAG 05320C* CHANGE TRANSACTION. 05330CSRN30N31 GOTO T106E GOT IT 05340C* FLAG NO MASTER ERROR 05350CSR Z-ADD302 M 96 FLAG ERROR 05360CSR Z-ADD1 F FIELD # 05370CSR GOTO END106 05380C*----------------------------------------------------------------------- 05390CSR T106E TAG 05400C* REWRITE MASTER 05410CSR EXSR SR82 REWRITE MAST 05420CSR GOTO END106 05430C*----------------------------------------------------------------------- 05440CSR T106F TAG 05450C* DELETE TRANSACTION 05460CSRN30N31 GOTO T106G GOT IT 05470C* FLAG NO MASTER ERROR 05480CSR Z-ADD302 M 96 FLAG ERROR 05490CSR Z-ADD1 F FIELD # 05500CSR GOTO END106 ÐÐ05510C*----------------------------------------------------------------------- 05520CSR T106G TAG 05530C* DELETE MASTER. 05540CSR 96 Z-ADD1 F FIELD # 05550CSR 96 GOTO END106 ERROR 05560CSR MOVE 'D' EFSTAT RECORD STATUS 05570CSR EXSR SR82 REWRITE MASTER 05580CSR END106 ENDSR 05590C************************************************************************ 05600CSR SR201 BEGSR 05610C* IDENTIFY FIELD NO. 05620CSR F COMP 1 01 05630CSR F COMP 2 02 05640CSR F COMP 3 03 05650CSR F COMP 4 04 05660CSR F COMP 5 05 05670CSR F COMP 6 06 05680CSR F COMP 7 07 05690CSR F COMP 8 08 05700CSR F COMP 9 09 05710CSR F COMP 10 10 05720CSR ENDSR 05730C********************************************************************** 05740CSR SR202 BEGSR 05750C* RIGHT JUSTIFY ÐÐ05760CSR F LOKUPNUM 54 05770CSRN54 GOTO END202 NOT NUMERIC FIELD 05780CSR Z-ADD10 W2N 20 05790CSR MOVELW28A W10A 10 05800CSR EXIT SUBRAJ R. JUSTIFY 05810CSR RLABL W2N 05820CSR RLABL W10A 05830CSR END202 ENDSR 05840C*********************************************************************** 05850CSR SR203 BEGSR 05860C* CLASSIFY TRAN CODE 05870CSR TRAN COMP 'A' 60 ADD 05880CSR TRAN COMP 'C' 61 CHANGE 05890CSR TRAN COMP 'D' 62 DELETE 05900CSR MOVE BLK35 TRNNAM 6 05910CSR 60 MOVE 'ADD ' TRNNAM 05920CSR 61 MOVE 'CHANGE' TRNNAM 05930CSR 62 MOVE 'DELETE' TRNNAM 05940CSR ENDSR 05950C**************************************************************************05960CSR SR205 BEGSR 05970C* INIT EFMAST RECORD 05980CSR MOVE BLK28 EFJOB 05990CSR Z-ADD0 EFLOW 06000CSR Z-ADD0 EFHI ÐÐ06010CSR Z-ADD0 EFMED 06020CSR MOVE ' ' EFUM 06030CSR MOVE BLK28 EFREM1 06040CSR MOVE BLK28 EFREM2 06050CSR MOVE ' ' EFSTAT 06060CSR ENDSR 06070C**************************************************************** 06080CSR SR206 BEGSR 06090C* INIT INPUT FIELDS 06100CSR MOVE ' ' TRAN 06110CSR MOVE BLK28 TRNNAM 06120CSR MOVE BLK28 PAYNAM 10 06130CSR MOVE BLK35 TJOB 06140CSR ENDSR 06150O******************************************************************** 06160OTERM132 E 70 06170O OR 71 06180O BIT,28 1 06190O N50 8 '8091001' 06200O N50 BIT,1 9 06210O N50 BIT,1 10 06220O 50 10 '[001 ]001' 06230O 50 BIT,28 6 06240O UDATE 18 ' - - ' 06250O 52 'J O B' ÐÐ06260O 67 'M A S T E R' 06270O 82 'U P D A T E' 06280O*--------------------------------------------------------------- 06290O E 70 06300O OR 71 06310O 1 ' ' 06320O*-------------------------------------------------------------- 06330O E 70 06340O OR 71 06350O OR 72 01 06360O DOT 40 06370O 24 ' (1) TRAN CODE (A,C,D) ' 06380O TRAN 43 06390O TRNNAM 50 06400O A39 132 06410O*------------------------------------------------------------------- 06420O E 70 06430O OR 71 06440O OR 72 02 06450O DOT 40 06460O 24 ' (2) JOB NAME (28-CHAR)' 06470O TJOB 70 06480O A39 132 06490O*---------------------------------------------------------------- 06500O E 71 ÐÐ06510O OR 72 03 06520O DOT 40 06530O 14 ' (3) JOB CODE' 06540O EFCODE 47 06550O A39 132 06560O*------------------------------------------------------------------ 06570O E 71 06580O OR 72 04 06590O DOT 40 06600O 15 ' (4) JOB GRADE' 06610O EFGRADZ 44 06620O A39 132 06630O*------------------------------------------------------------------- 06640O E 71 06650O OR 72 05 06660O DOT 40 06670O 24 ' (5) LOW RATE (5.2-CHAR' 06680O 25 ')' 06690O EFLOW 2 51 06700O A39 132 06710O*------------------------------------------------------------------- 06720O E 71 06730O OR 72 06 06740O DOT 40 06750O 24 ' (6) HIGH RATE (5.2-CHA' ÐÐ06760O 26 'R)' 06770O EFHI 2 51 06780O A39 132 06790O*-------------------------------------------------------------------- 06800O E 71 06810O OR 72 07 06820O DOT 40 06830O 24 ' (7) MEDIAN RATE (5.2-C' 06840O 28 'HAR)' 06850O EFMED 2 51 06860O A39 132 06870O*------------------------------------------------------------------- 06880O E 71 06890O OR 72 08 06900O DOT 40 06910O 24 ' (8) RATE UNIT (Y,M,W,H' 06920O 25 ')' 06930O EFUM 44 06940O PAYNAM 55 06950O A39 132 06960O*------------------------------------------------------------------ 06970O E 71 06980O OR 72 09 06990O DOT 40 07000O 24 ' (9) REMARKS (20-CHAR) ' ÐÐ07010O EFREM1 62 07020O A39 132 07030O*------------------------------------------------------------------- 07040O E 71 07050O OR 72 10 07060O DOT 40 07070O 24 '(10) REMARKS (20-CHAR) ' 07080O EFREM2 62 07090O A39 132 07100O********************************************************************* 07110OEFMAST EADD 81 07120O TJOB 28 07130O EFCODE 33 07140O EFGRAD 35 07150O EFLOW 39P 07160O EFHI 43P 07170O EFMED 47P 07180O EFUM 48 07190O EFREM1 68 07200O EFREM2 88 07210O 90 'A' 07220O*------------------------------------------------------------------- 07230O E 82 07240O EFCODE 33 07250O EFGRAD 35 ÐÐ07260O EFLOW 39P 07270O EFHI 43P 07280O EFMED 47P 07290O EFUM 48 07300O EFREM1 68 07310O EFREM2 88 07320O EFSTAT 90 07330O* 07340O* 07350O******************************************************************** 07360OCRTFILE E 97 07370O PROG 26 07380O CRTIME 33 07390O CRDATE 37 07400O LNK 79 07410O******************************************************************** ** NUL ARRAY 007420 007430** A28 ARRAY 007440 007450** A39 ARRAY 07460 07470** NUM ARRAY 007480004 EFGRAD 07490005 EFLOW 07500ÐÐ006 EFHI 07510007 EFMED 07520** DUN ARRAY 007530 007540** MES ARRAY 007550---MESSAGE NOT ON FILE--- 007560** LNK ARRAY 007570 07580** DOTS 07590 07600** TABPUM/TABPUN 07610HHOURLY 07620WWEEKLY 07630MMONTHLY 07640AANNUALLY 07650YYEARLY 07660/* 07670_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Â?¨ ¼XQMC02 P999999120282(èÈÐ00010H QQMC0200020F* STOCKROOM DISPLAY MENU. (XQMC02) 00030F* REVISED 8-03-82 5:35 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FCRTFILE UC F 256R DISK 00070E******************************************************************** 00080E PA 1 23 8 NA 50 PROGRAM #/NAMES 00090E PB 1 23 8 NB 50 PROGRAM #/NAMES 00100E NUL 1 132 1 NULL CHAR 00110E A4 4 4 1 A 00120E TITL 1 6 66 MENU TITLE,HEADINGS 00130E MSG 1 3 25 00140E SEL 1 46 8 00150E PRG 1 23 8 NAM 50 AWORK ARRAY 00160E LNK 1 7 6 A 00170E BIT 33 1 00180E PAR 25 1 00190E TST 25 1 00200E CALL 7 6 A 00210E REC 177 1 00220I******************************************************************** 00230IBITPAR BT 02 00240I 1 33 BIT 00250I 34 58 PAR ÐÐ00260I 59 83 TST 00270I******************************************************************** 00280ICRTFILE CR 00290I 19 26 CRJOB 00300I 27 27 CRSHUT 00310I 28 330CRTIME 00320I 38 79 CALL 00330I 80 256 REC 00340C******************************************************************** 00350C EXSR SR101 INIT 00360C EXSR SR102 DISPLAY MENU 00370C EXSR SR103 REQUEST SELECTION 00380C*------------------------------------------------------------------ 00390C NEWITM TAG 00400C MOVEL'QQMC02' PROG 8 00410C EXSR SR98 <<>> 00420C*------------------------------------------------------------------ 00430C MENU TAG 00440C EXSR SR97 <<>> 00450C*--------------------------------------------------------------------- 00460C GOODBY TAG 00470C MOVEL'GOODBY' PROG 8 00480C EXSR SR98 <<>> 00490C*----------------------------------------------------------------- 00500C ENDJOB TAG <<>> ÐÐ00510C MOVEL'ENDJOB 'PROG 00520C EXITFCHAIN >>>>>>>>>> 00530C RLABL PROG 00540C************************************************************************ 00550CSR SR68 BEGSR 00560CSR EXITFZLFCR LF/CR 00570CSR ENDSR 00580C***************************************************************** 00590CSR SR69 BEGSR 00600C* MOVE CURSOR 00610CSR 50 EXITFZPUTXY 00620CSR RLABL RPGLIN 00630CSR RLABL RPGCOL 00640CSRN50 EXITFZMOVXY 00650CSR RLABL RPGLIN 00660CSR RLABL RPGCOL 00670CSR ENDSR 00680C**************************************************************** 00690CSR SR70 BEGSR 00700CSR MOVELW66A OUTPUT 80 00710CSR EXITFZW80 WRITE 80-BYTES CRT 00720CSR RLABL OUTPUT 00730CSR ENDSR 00740C****************************************************************** 00750CSR SR71 BEGSR ÐÐ00760CSR MOVELREQST RPGLIN 00770CSR MOVEL'067' RPGCOL 00780CSR EXSR SR69 MOVE CURSOR 00790CSR 50 EXITFZBLINK START BLINK 00800CSR EXSR SR70 WRITE MESSAGE 00810CSR EXITFZBLUNK STOP BLINK 00820CSR ENDSR 00830C******************************************************************* 00840CSR SR72 BEGSR 00850CSR MOVE BLK66 W66A 00860CSR EXSR SR71 INIT MESSAGE 00870CSR ENDSR 00880C****************************************************************** 00890CSR SR75 BEGSR 00900C* READ CRT 00910CSR SETOF 7790 00920CSR MOVE BLK4 W4A 4 00930CSR EXITFZR4 READ CRT 00940CSR RLABL W4A 00950CSR MOVEAW4A A4 00960CSR MOVE BLK4 W4A 4 00970CSR Z-ADD1 W 30 00980CSR '\' LOKUPA4,W 90 00990CSRN90 GOTO T75C 01000CSR 1 ADD W W ÐÐ01010CSR W COMP 4 54 01020CSRN54 GOTO T75B 01030C*--------------------------------------------------------------- 01040CSR T75A TAG 01050C* FLAG BAD ESCAPE CODE 01060CSR MOVE BLK66 W66A 01070CSR MOVELMSG,3 W66A 01080CSR EXSR SR71 PUT ERROR MESSAGE 01090CSR GOTO SR75 01100C*-------------------------------------------------------------- 01110CSR T75B TAG 01120CSR A4,W COMP 'G' 98 01130CSR A4,W COMP 'E' 94 01140CSR A4,W COMP 'N' 93 01150CSR 98 GOTO GOODBY 01160CSR 94 GOTO MENU 01170CSR 93 GOTO NEWITM 01180CSR GOTO T75A BAD ESCAPE CODE 01190C*-------------------------------------------------------------------- 01200CSR T75C TAG 01210CSR Z-ADD1 W 01220CSR ' ' LOKUPA4,W 77 01230CSR 77 MOVEAA4,W W4A 01240CSR END75 TAG 01250CSR EXSR SR72 INIT MESSAGE ÐÐ01260CSR ENDSR 01270C***************************************************************** 01280CSR SR97 BEGSR 01290C* MENU REQUEST EXIT. 01300CSR Z-ADD1 W 30 01310CSR ' ' LOKUPLNK,W 54 01320CSRN54 MOVEL'CONTU' PROG 01330CSR 54 MOVELLNK,W PROG 8 01340CSR 54 MOVE ' ' LNK,W 01350CSR EXSR SR98 <<>> 01360CSR ENDSR 01370C***************************************************************** 01380CSR SR98 BEGSR 01390C* NORMAL EOJ - UPDATE CRTFILE AND LINK TO PROG PROGRAM. 01400CSR # CHAINCRTFILE H8 01410CSR H8 GOTO ENDJOB <<>> 01420CSR MOVE LNK CALL 01430CSR MOVE ' ' REC 01440CSR MOVE PROG CRJOB 01450CSR MOVELUDATE DATE4 40 01460CSR TIME CRTIME 01470CSR SETON 97 01480CSR EXCPT UPDATE CRTFILE 01490CSR SETOF 97 01500CSR EXITFCHAIN <<>> ÐÐ01510CSR RLABL PROG 01520CSR ENDSR 01530C******************************************************************* 01540CSR SR99 BEGSR 01550C* PROGRAM SELECTED - LOAD THIS MENU AS RETURN-TO PROG 01560CSR Z-ADD8 W 01570C*----------------------------------------------------------------- 01580CSR T99A TAG 01590CSR W SUB 1 W 54 01600CSRN54 SETON H7 01610CSRN54 GOTO ENDJOB <<>> 01620CSR LNK,W COMP ' ' 54 01630CSRN54 GOTO T99A 01640CSR MOVEL'QQMC02' LNK,W 01650CSR EXSR SR98 <<>> 01660CSR ENDSR 01670C******************************************************************* 01680C* 01690C* 01700C* 01710C* 01720C* 01730C* 01740C* 01750C********************************************************************** ÐÐ01760CSR SR101 BEGSR 01770C* 1-TIME INIT 01780CSR MOVE BIT,1 NUL 01790CSR MOVEANUL OUTPUT 01800CSR MOVE ' ' W2A 2 01810CSR EXITFZGMINX GET TERMINAL # 01820CSR RLABL W2A 01830CSR MOVE W2A # 20 01840CSR # COMP 0 54 01850CSRN54 Z-ADD25 # 01860CSR # CHAINCRTFILE H9 01870CSR H9 GOTO ENDJOB <<>> 01880CSR MOVE CALL LNK 01890CSR PAR,# COMP '1' 50 01900CSR 50 EXITFZISTAT CLEAR STATUS LINE 01910CSR 50 EXITFZESCH CLEAR SCREEN 01920CSRN50 EXITFZCPAGE CLEAR SCREEN 01930CSRN50 MOVEL'091' RPGLIN 4 01940CSRN50 MOVEL'001' RPGCOL 4 01950CSRN50 EXSR SR69 MOVE CURSOR 01960CSR TST,# COMP 'S' 54 01970CSRN54 CRSHUT COMP 'S' 54 01980CSR 54 MOVE 'SHUTDOWN'PROG 01990CSR 54 EXSR SR98 <<>> 02000CSR MOVE ' ' BLK50 50 ÐÐ02010CSR MOVE ' ' BLK66 66 02020CSR MOVE ' ' BLK132132 02030CSR MOVE ' ' BLK35 35 02040CSR MOVE ' ' BLK8 8 02050CSR MOVE ' ' BLK4 4 02060C* 02070C* 02080CSR MOVE ' ' REC 02090CSR MOVE 'QQMC02 'CRJOB 02100CSR TIME CRTIME 02110CSR MOVELUDATE DATE4 02120CSR SETON 97 02130CSR EXCPT REWRITE CRTFILE 02140CSR SETOF 97 02150CSR ENDSR 02160C********************************************************************** 02170CSR SR102 BEGSR 02180C* DISPLAY MENU 02190CSR Z-ADD-1 M 20 02200CSR Z-ADD1 REQST 30 02210CSR 50 Z-ADD0 W3N 30 02220CSRN50 Z-ADD90 W3N 02230C*--------------------------------------------------------------------- 02240CSR T102A TAG 02250CSR MOVE BLK132 W132A 132 ÐÐ02260CSR 2 ADD M M 20 02270CSR M COMP 5 54 02280CSR 54 GOTO T102C 02290CSR 1 ADD M A 20 02300CSR TITL,M COMP BLK66 54 02310CSR 54 MOVELTITL,M W132A 02320CSR TITL,A COMP BLK66 55 02330CSR 55 MOVE TITL,A W132A 02340CSRN54N55 GOTO T102A 02350CSR 1 ADD W3N W3N 02360CSR MOVELW3N RPGLIN 4 02370CSR MOVEL'001' RPGCOL 4 02380CSR EXSR SR69 MOVE CURSOR 02390CSR EXITFZW132 WRITE TITLE LINE 02400CSR RLABL W132A 02410CSR Z-ADDW3N REQST 30 02420CSR GOTO T102A 02430C*---------------------------------------------------------------- 02440CSR T102C TAG 02450CSR Z-ADD0 M 02460CSR Z-ADD0 S 20 02470CSR MOVE BLK8 SEL 02480CSR 1 ADD REQST REQST 02490CSR Z-ADDREQST W3N 30 02500CSR MOVE PA PRG ÐÐ02510CSR MOVE NA NAM 02520CSR MOVEL'001' RPGCOL 02530CSR EXSR SR201 OUTPUT MENU 02540CSR MOVE PB PRG 02550CSR MOVE NB NAM 02560CSR MOVEL'067' RPGCOL 02570CSR Z-ADDREQST W3N 02580CSR EXSR SR201 OUTPUT MENU 02590CSR ENDSR 02600C******************************************************************** 02610CSR SR103 BEGSR 02620C* REQUEST SELECTION. 02630C*------------------------------------------------------------------- 02640CSR MOVEANUL W66A 66 02650CSR MOVELMSG,1 W66A 02660CSR MOVELREQST RPGLIN 4 02670CSR MOVEL'001' RPGCOL 4 02680CSR EXSR SR69 MOVE CURSOR 02690CSR EXSR SR70 WRITE PROMPT 02700CSR EXSR SR75 READ CRT 02710CSR Z-ADD4 W2N 20 02720CSR EXIT SUBRAJ RJ 02730CSR RLABL W2N 02740CSR RLABL W4A 02750CSR MOVE W4A S 20 ÐÐ02760CSR S COMP 0 54 02770CSR 54 S COMP 46 5454 02780CSR 54 SEL,S COMP BLK8 54 02790CSR 54 MOVELSEL,S PROG 8 02800CSR 54 EXSR SR99 <<>> 02810CSR MOVELBLK66 W66A 02820CSR MOVE MSG,2 W66A 02830CSR EXSR SR71 PUT MESSAGE 02840CSR GOTO SR103 REQUEST AGAIN 02850CSR ENDSR 02860C********************************************************************* 02870CSR SR201 BEGSR 02880C* DISPLAY PROGRAM SELECTIONS 02890CSR Z-ADD1 M 20 02900C*------------------------------------------------------------------ 02910CSR T201C TAG 02920CSR BLK50 LOKUPNAM,M 54 02930CSRN54 GOTO END201 02940CSR 1 ADD W3N W3N 02950CSR MOVELW3N RPGLIN 02960C* 02970CSR PRG,M COMP BLK8 55 02980CSR 55 1 ADD S S 02990CSR 55 MOVE PRG,M SEL,S SAVE PROG NAME 03000CSR MOVEANUL W66A ÐÐ03010CSR MOVE BLK66 W54A 54 03020CSR 55 MOVELS W54A 03030CSR 55 S COMP 9 54 03040CSR 55N54 MOVEL' ' W54A 03050CSR MOVE NAM,M W54A 03060CSR MOVELW54A W66A 03070CSR MOVE '. ' W66A 03080CSR EXSR SR69 MOVE CURSOR 03090CSR EXSR SR70 DISPLAY ENTRY 03100CSR MOVE BLK50 NAM,M 03110CSR GOTO T201C 03120CSR END201 ENDSR 03130C* 03140C* 03150C* 03160C* 03170O*************************************************************** 03180OCRTFILE E 97 03190O CRJOB 26 03200O CRTIME 33 03210O DATE4 37 03220O CALL 79 03230O REC 256 03240O******************************************************************** ** PA/NA ARRAY 03250ÐÐQ102SF INVENTORY STATUS - BY PART NO. 1 03260Q016WM REQUIREMENTS - BY WORK ORDER NO. 2 03270Q018WM REQUIREMENTS - BY DUE DATE 3 03280 4 03290 5 03300 6 03310 7 03320 8 03330 9 03340 10 03350 11 03360 12 03370 13 03380 14 03390 15 03400 16 03410 37 03420 18 03430 19 03440 20 03450 21 03460 22 03470 23 03480** PB/NB ARRAY 03490Q032WM STOCK ISSUES - BY WORK ORDER NO. 1 03500ÐÐQ034WM STOCK ISSUES - BY PART NO. 2 03510 3 03520 4 03530 5 03540 6 03550 7 03560 8 03570 9 03580 10 03590 11 03600 12 03610 13 03620 14 03630 15 03640 16 03650 17 03660 18 03670 19 03680 20 03690 21 03700 22 03710 23 03720** NUL ARRAY 03730 03740** A4 ARRAY 03750ÐÐ 03760** TITL ARRAY (EA ELEMENT = 1/2 TITLE LINE) 03770 S T O C K R O O M D I 03780 S P L A Y M E N U 03790<------------------------------------------------> 03800<------------------------------------------------> 03810 03820 03830** MSG ARRAY 03840ENTER SELECTION NO.: 03850INVALID... TRY AGAIN: 03860\ CODE INVALID.... TRY AGAIN: 03870** SEL ARRAY 03880 03890** PRG/NAM ARRAY 03900 03910** LNK ARRAY 03920 03930/* 03940_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( @e  NX021EG PJ999999120282(èÈÐ00010H Q021EG00020F* ENGR STD DISPLAY BY PART# (X021EG) 00030F* LAST REVISED 12-02-82 4:30 PM. 00040F* 00050FBITPAR IP F 90 DISK 00060FEGMAST ID F 100L10AI 1 DISK 00070FEGTEXT IC F 60R DISK 00080FEGMFRPN IC F 40R DISK 00090FEGMFR ID F 21L20AI 1 DISK 00100FEGHEAD IC F 92R 6AI 1 DISK 00110FMGFILE IC F 80R DISK 00120FCRTFILE UC F 256R DISK 00130FTERM132 O F 132 5 00140F**************************************************************** 00150E NUL 1 132 1 NULL CHAR 00160E A12 12 12 1 A INPUT DATA ARRAY 00170E DOT 1 66 2 A 00180E LNK 1 7 6 A 00190E BIT 33 1 SCREEN CONTR. CHAR 00200E PAR 25 1 00210E TST 25 1 00220E CALL 7 6 00230E EGT 10 5 0A 00240E EGM 15 5 0A 00250I******************************************************************* ÐÐ00260IBITPAR BT 00270I 1 33 BIT 00280I 34 58 PAR 00290I 59 83 TST 00300I******************************************************************* 00310IMGFILE MG 00320I* MESSAGE FILE. 00330I 1 35 MGTEXT 00340I****************************************************************** 00350ICRTFILE CR 00360I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00370I* STD AREA - SAME FOR ALL PROGRAMS. 00380I* EMPLOYEE # 5N 00390I* 1 50CREMPL 00400I* USER CODE 8A 00410I* 6 13 CRUSER 00420I* DEPT # 5N 00430I* 14 180CRDEPT 00440I* JOB NAME 8A (JOB LOADED BY MENU) 00450I* 19 26 CRJOB 00460I* TIME 6N O PROG NAME (FOR PROG LOADER) 6A 00470I 28 330CRTIME 00480I* DATE 4N 00490I 34 370CRDATE 00500I* CALL STACK 7 X 6A ÐÐ00510I 38 79 CALL 00520I******************************************************************** 00530IEGMAST EG 00540I* ENGR STD MASTER 00550I* PART NO. 10N 00560I 1 100EGPN 00570I* STANDARDS CODE 6A 00580I 11 16 EGSTD 00590I* INSPECTION CODE 5A 00600I 17 21 EGINSP 00610I* TEXT RRN'S 5P X 10 00620I P 22 51 EGT 00630I* PART NO. CROSS-REF RRN'S 5P X 15 00640I P 52 96 EGM 00650I* RECORD STATUS 1A 00660I 100 100 EGSTAT 00670I*********************************************************** 00680IEGTEXT ET 00690I* TEXT FILE 00700I* PART NO. 00710I 1 100ETPN 00720I* LINE NO. 2N 00730I 11 120ETLINE 00740I* TEXT 45A 00750I 13 57 ETTEXT ÐÐ00760I* RECORD STATUS 1A 00770I 60 60 ETSTAT 00780I****************************************************************** 00790IEGMFRPN EP 00800I* ENG STD DYNAIR/MFR PART-NO CROSS REF. 00810I* MFR CODE 5A 00820I 1 5 EPMFR 00830I* MFR PART NO. 24A 00840I 6 29 EPMPN 00850I* DYNAIR PART NO. 10N 00860I 30 39 EPPN 00870I* RECORD STATUS 1A 00880I 40 40 EPSTAT 00890I***************************************************************** 00900IEGMFR EM 00910I* MFR PART NO. POINTER 00920I 1 17 EMKEY 00930I* MFR CODE 5A 00940I 1 5 EMMFR 00950I* DYNAIR PART NO. 10N 00960I 6 150EMPN 00970I* POINTER TO EGMFRPN FILE 5N 00980I 16 200EMPTR 00990I* RECORD STATUS 1A 01000I 21 21 EMSTAT ÐÐ01010I******************************************************************** 01020IEGHEAD EH 01030I 1 5 EHPN 01040I 6 60EHLINE 01050I 7 86 EHTEXT 01060I 92 92 EHSTAT 01070C******************************************************************* 01080C* INITIALIZE 01090C EXSR SR101 1-TIME INIT 01100C MOVE ' ' BLK6 6 01110C Z-ADD0 ZERO5 50 STUPIDITY 01120C EXSR SR70 NEW PAGE 01130C N50 MOVEL'091' RPGLIN 01140C 50 MOVEL'001' RPGLIN 4 01150C MOVEL'001' RPGCOL 4 01160C EXSR SR69 MOVE CURSOR 01170C Z-ADD92 LINENO 01180C*------------------------------------------------------------------ 01190C START TAG 01200C* REQUEST SELECTION (EGMAST OR CROSS REF) 01210C Z-ADD0 EGT 01220C Z-ADD0 EGM 01230C Z-ADD0 EGPN 01240C MOVE BLK45 ETTEXT 01250C MOVE ' ' EGSTD ÐÐ01260C MOVE ' ' EGINSP 01270C MOVE BLK45 EPMFR 01280C MOVE BLK45 EPMPN 01290C Z-ADD0 TPN 01300C MOVE ' ' TMFR 01310C SETON 70 01320C EXCPT SELECTION PROMPT 01330C SETOF 70 01340C 1 ADD LINENO LINENO 01350C EXSR SR75 READ 01360C 90 GOTO START 01370C EXSR SR202 RJ 01380C MOVE W12A TSEL 20 SELECTION # 01390C TSEL COMP 1 54 01400C 54 GOTO TAG10 DISPLAY EGMAST BY PN 01410C GOTO TAG100 DISPLAY CROSS REF 01420C*-------------------------------------------------------------------- 01430C TAG10 TAG 01440C* REQUEST PART NO. 01450C SETON 75 01460C EXCPT PART # PROMPT 01470C SETOF 75 01480C 1 ADD LINENO LINENO 01490C EXSR SR75 READ CRT 01500C 90 GOTO START ÐÐ01510C EXSR SR202 RJ 01520C MOVE W12A TPN 100 PART NO. 01530C EXSR SR106 DISPLAY PART SEQ 01540C 90 GOTO START 01550C GOTO TAG10 01560C*---------------------------------------------------------------- 01570C TAG100 TAG 01580C* REQUEST MANUFACTURER (MFR) 01590C SETON 76 01600C EXCPT MFR PROMPT 01610C SETOF 76 01620C 1 ADD LINENO LINENO 01630C EXSR SR75 READ CRT 01640C 90 GOTO START 01650C MOVELW12A TMFR 5 01660C*---------------------------------------------------------------- 01670C TAG110 TAG 01680C EXSR SR107 DISPLAY CROSS REF 01690C 93 GOTO START NEW ITEM 01700C 77 MOVELW12A TMFR NEW MFR CODE 01710C 77 GOTO TAG110 NEW PART NO. INPUT 01720C GOTO TAG100 01730C*------------------------------------------------------------------- 01740C MENU TAG 01750C* SET-UP LINK TO MENU ÐÐ01760C EXSR SR96 GET CRTFILE 01770C Z-ADD1 W 01780C BLK6 LOKUPLNK,W 54 01790C 54 MOVELLNK,W PROG 8 01800C 54 MOVE BLK6 LNK,W 01810C N54 MOVEL'CONTU' PROG 01820C EXSR SR97 UPD CRTFILE 01830C EXSR SR98 >>>>>>>>>> 01840C*-------------------------------------------------------------------- 01850C GOODBY TAG 01860C* LINK TO SIGN-OFF 01870C MOVEL'GOODBY' PROG 01880C GOTO END 01890C*------------------------------------------------------------------- 01900C END TAG 01910C EXSR SR96 GET CRTFILE 01920C EXSR SR97 UPD CRTFILE 01930C EXSR SR98 >>>>>>>>>> 01940C*------------------------------------------------------------------- 01950C ENDJOB TAG 01960C MOVEL'ENDJOB' PROG 01970C EXSR SR98 >>>>>>>>>> 01980C********************************************************************* 01990CSR SR41 BEGSR 02000C* DISPLAY EGHEAD RECORD ÐÐ02010CSR MOVELEGPN W5A 5 02020CSR W5A COMP SAVEEH 54 02030CSR 54 GOTO END41 02040CSR MOVELW5A PN6 6 02050CSR MOVE ' ' PN6 02060CSR SETOF 43 02070C*------------------------------------------------------------------- 02080CSR T41A TAG 02090CSR PN6 CHAINEGHEAD 54 02100CSR 54 GOTO END41 02110CSR EHSTAT COMP 'D' 54 02120CSR 54 GOTO END41 02130CSR MOVEAEHTEXT DOT 02140CSRN43 44 MOVELEHPN W5A 02150CSRN43 44 W5A COMP KEEPEH 54 02160CSRN43 44 54 EXSR SR103 CONT'D 02170CSR Z-ADD1 X 30 02180CSR ' ' LOKUPDOT,X 54 02190CSRN54 Z-ADD1 X 02200CSR MOVEADASH DOT,X 02210CSR SETON 41 02220CSR EXCPT DISPLAY HEADING 02230CSR SETOF 41 02240CSR SETON 40 02250CSR MOVE EHPN SAVEEH 5 ÐÐ02260CSRN43 1 ADD LINENO LINENO 02270CSR 1 ADD LINENO LINENO 02280CSR SETON 43 02290CSR 1 ADD EHLINE EHLINE 02300CSR MOVE EHLINE PN6 02310CSR GOTO T41A 02320C*------------------------------------------------------------------- 02330CSR END41 TAG 02340CSR SETOF 44 02350CSR ENDSR 02360C************************************************************** 02370CSR SR42 BEGSR 02380C* PUT DATA CRT 02390CSRN45 EXSR SR71 PUT HEADING 02400CSRN21 EXSR SR41 PUT EH HEADING 02410CSR 1 ADD LINENO LINENO 30 02420CSR SETON 42 02430CSR EXCPT PUT DATA 02440CSR SETOF 42 02450CSR SETON 4546 02460CSR ENDSR 02470C**************************************************************** 02480CSR SR68 BEGSR 02490CSR EXITFZLF LINE FEED 02500CSR 1 ADD LINENO LINENO ÐÐ02510CSR ENDSR 02520C**************************************************************** 02530CSR SR69 BEGSR 02540CSR 50 EXITFZPUTXY MOVE CURSOR 02550CSR RLABL RPGLIN 02560CSR RLABL RPGCOL 02570CSRN50 EXITFZMOVXY 02580CSR RLABL RPGLIN 02590CSR RLABL RPGCOL 02600CSR ENDSR 02610C***************************************************************** 02620CSR SR70 BEGSR 02630C* CLEAR TERM SCREEN. 02640CSR 50 EXITFZISTAT 02650CSR 50 EXITFZESCH 02660CSRN50 EXITFZCPAGE CLEAR SCREEN 02670CSR ENDSR 02680C********************************************************************** 02690CSR SR71 BEGSR 02700CSR EXSR SR70 NEW PAGE 02710CSR SETON 71 02720CSR EXCPT PUT HDG 02730CSR SETOF 71 02740CSR Z-ADD94 LINENO 02750CSR MOVE SAVEEH KEEPEH 5 ÐÐ02760CSR MOVE ' ' SAVEEH 5 02770CSR ENDSR 02780C*********************************************************************** 02790CSR SR73 BEGSR 02800C* PUT ERROR MESSAGE TO TERMINAL 02810CSR EXSR SR89 GET MSG FILE 02820CSR SETON 73 02830CSR EXCPT PUT MSG 02840CSR SETOF 73 02850CSR 1 ADD LINENO LINENO 02860CSR ENDSR 02870C******************************************************************* 02880CSR SR75 BEGSR 02890C* READ FROM TERMINAL 02900CSR SETOF 779096 02910CSR SETOF 9392 02920CSR MOVE BLK12 W12A 12 BUFFER 02930CSR EXITFZR12 READ FROM TERMINAL 02940CSR RLABL W12A READ BUFFER 02950CSR MOVEAW12A A12 INPUT DATA ARRAY 02960CSR MOVE BLK12 W12A INIT INPUT ARRAY 02970CSR Z-ADD1 W 30 02980CSR '\' LOKUPA12,W 90 FLAG ESC 02990CSRN90 GOTO T75B NOT ESC 03000CSR 1 ADD W W ÐÐ03010CSR W COMP 12 54 03020CSR 54 GOTO T75A BAD ESC 03030CSR A12,W COMP 'G' 98 GOODBY 03040CSR A12,W COMP 'E' 94 MENU 03050CSR A12,W COMP 'N' 93 NEW ITEM 03060CSR A12,W COMP 'B' 92 SKIP BKWRD 03070CSRN92 A12,W COMP 'D' 92 DONE 03080CSR 98 GOTO GOODBY 03090CSR 94 GOTO MENU 03100CSR 93 GOTO END75 03110CSR 92 GOTO END75 GOOD ESC 03120C*------------------------------------------------------------------ 03130CSR T75A TAG 03140C* FLAG BAD ESC INPUT 03150CSR Z-ADD318 M 50 FLAG ERROR 03160CSR EXSR SR73 PUT MSG 03170CSR GOTO SR75 03180C*-------------------------------------------------------------------- 03190CSR T75B TAG 03200C* MOVE DATA 03210CSR Z-ADD1 W 03220CSR ' ' LOKUPA12,W 77 03230CSR 77 MOVEAA12,W W12A INPUT DATA 03240C*-------------------------------------------------------------------- 03250CSR END75 TAG ÐÐ03260C* INIT PREV ERROR MSG. 03270CSR LSTERR COMP 0 54 03280CSR 54 MOVE BLK35 MGTEXT 03290CSR 54 EXSR SR73 BLANK MESSAGE 03300CSR Z-ADD0 LSTERR 50 03310CSR ENDSR 03320C*************************************************************** 03330CSR SR78 BEGSR 03340CSR SETON 78 03350CSR EXCPT END PAGE PROMPT 03360CSR SETOF 78 03370CSR 1 ADD LINENO LINENO 03380CSR EXSR SR75 READ CRT 03390CSR ENDSR 03400C***************************************************************** 03410CSR SR79 BEGSR 03420CSR SETON 79 03430CSR EXCPT END FILE PROMPT 03440CSR SETOF 79 03450CSR 1 ADD LINENO LINENO 03460CSR EXSR SR75 READ CRT 03470CSR ENDSR 03480C********************************************************************** 03490CSR SR80 BEGSR 03500C* GET MASTER RECORD ÐÐ03510CSR SETOF 31 03520CSR TPN CHAINEGMAST 30 GET MASTER 03530CSRN30 EGSTAT COMP 'D' 31 FLAG DELETE 03540CSR ENDSR 03550C******************************************************************* 03560CSR SR82 BEGSR 03570C* GET NEXT CROSS REF (SR106) 03580CSR SETOF 36 03590CSR ZERO5 LOKUPEGM,P 54 03600CSRN54 SETON 36 03610CSRN54 GOTO END82 03620CSR Z-ADDEGM,P RRN 50 03630CSR Z-ADD0 EGM,P 03640CSR EXSR SR86 GET EGMFRPN 03650CSR END82 ENDSR 03660C******************************************************************** 03670CSR SR85 BEGSR 03680C* GET TEXT FILE 03690CSR SETOF 35 03700CSR ZERO5 LOKUPEGT,T 54 03710CSRN54 SETON 35 03720CSRN54 GOTO END85 03730CSR Z-ADDEGT,T RRN 03740CSR Z-ADD0 EGT,T 03750CSR RRN CHAINEGTEXT 60 GET EGTEXT ÐÐ03760CSR 60 SETON 35 03770CSR END85 ENDSR 03780C**************************************************************** 03790CSR SR86 BEGSR 03800C* GET PART NO. CROSS REF FILE 03810CSR RRN CHAINEGMFRPN 36 GET EGMFRPN FILE 03820CSR ENDSR 03830C*************************************************************** 03840CSR SR89 BEGSR 03850C* GET MESSAGE MASTER 03860CSR M CHAINMGFILE 54 03870CSR 54 MOVE BLK35 MGTEXT 03880CSR 54 MOVELM MGTEXT 03890CSR ENDSR 03900C******************************************************************** 03910CSR SR96 BEGSR 03920CSR # CHAINCRTFILE H9 GET CRTFILE 03930CSR H9 GOTO ENDJOB 03940CSR ENDSR 03950C******************************************************************** 03960CSR SR97 BEGSR 03970C* UPDATE CRTFILE. EXIT PROGRAM. 03980CSR TIME CRTIME 03990CSR MOVELUDATE CRDATE 04000CSR SETON 97 ÐÐ04010CSR EXCPT UPDATE CRTFILE 04020CSR SETOF 97 04030CSR ENDSR 04040C******************************************************************** 04050CSR SR98 BEGSR 04060CSR EXSR SR70 CLEAR SCREEN 04070CSR EXITFCHAIN >>>>>>>>>> 04080CSR RLABL PROG 04090CSR ENDSR 04100C******************************************************************* 04110CSR SR101 BEGSR 04120C* 1-TIME INITIALIZE 04130CSR MOVE BIT,1 NUL 04140CSR Z-ADD69 FLIMIT 30 TOTAL NUMB FIELDS 04150CSR MOVE '- ' DOT 04160CSR MOVEADOT DASH 132 04170CSR MOVE ' ' DOT 04180CSR MOVE ' ' BLK12 12 04190C* GET PORT # AND CRTFILE 04200CSR MOVE ' ' W2A 2 04210CSR EXITFZGMINX GET PORT # 04220CSR RLABL W2A 04230CSR MOVE W2A # 20 PORT NO. 04240CSR # COMP 0 54 04250CSRN54 Z-ADD25 # DEFAULT ÐÐ04260CSR EXSR SR96 GET CRTFILE 04270CSR MOVE CALL LNK 04280CSR PAR,# COMP '1' 50 04290CSR TST,# COMP 'S' 54 04300CSR 54 MOVE 'SHUTDOWN'PROG 04310CSR EXSR SR97 UPDATE CRTFILE 04320CSR 54 EXSR SR98 >>>>>>>>>> 04321CSR MOVE ' 'PROG 04330C* DEFINE WORK FIELDS,ETC. 04340CSR MOVE ' ' BLK35 35 04350CSR Z-ADD0 ZERO5 50 04360CSR MOVE ' ' BLK45 45 04370CSR MOVE ' ' BLK24 24 04380CSR ENDSR 04390C***************************************************************** 04400CSR SR103 BEGSR 04410C* INSERT CONT'D 04420CSR Z-ADD41 C 30 04430C*----------------------------------------------------------------- 04440CSR T103A TAG 04450CSR C SUB 1 C 54 04460CSRN54 GOTO END103 04470CSR DOT,C COMP ' ' 54 04480CSRN54 GOTO T103A 04490CSR 2 ADD C C ÐÐ04500CSR C COMP 40 54 04510CSRN54 MOVEA'CONT''D' DOT,C 04520CSRN54 MOVEADOT EHTEXT 04530CSR END103 ENDSR 04540C***************************************************************** 04550CSR SR106 BEGSR 04560C* DISPLAY BY PART NO. 04570CSR SETON 20 04580CSR SETOF 45 04590CSR TPN SETLLEGMAST 04600CSR Z-ADD0 LASTEG 04610C*--------------------------------------------------------------- 04620CSR T106B TAG 04630CSR Z-ADD1 T 04640CSR Z-ADD1 P 04650CSR SETOF 5446 04660CSR READ EGMAST 54 04670CSR 54 GOTO T106R END OF FILE 04680CSR EGPN COMP LASTEG 54 04690CSRN54 GOTO T106R END OF FILE 04700CSR Z-ADDEGPN LASTEG 100 04710CSR EGSTAT COMP 'D' 54 04720CSR 54 GOTO T106B 04730CSR SETOF 3536 04740CSR EXSR SR68 LF ÐÐ04750CSR 50 LINENO COMP 112 54 04760CSRN50 LINENO COMP 117 54 04770CSRN54 GOTO T106E NOT END PAGE 04780CSR EXSR SR78 END PAGE PROMPT 04790CSR 90 GOTO END106 04800CSR EXSR SR71 PUT HEADING 04810CSRN77 SETON 44 04820CSRN77 EXSR SR41 PUT EH HEADING 04830CSR 77 EXSR SR202 R.J. 04840CSR 77 MOVE W12A TPN 04850CSR 77 GOTO SR106 04860C*------------------------------------------------------------------- 04870CSR T106E TAG 04880CSR 35 36 GOTO T106B END OF TEXT,MFR 04890CSRN35 EXSR SR85 GET TEXT 04900CSRN36 EXSR SR82 GET MFR 04910CSRN35 04920CORN36 EXSR SR42 DISPLAY 04930CSR 50 LINENO COMP 113 54 04940CSRN50 LINENO COMP 118 54 04950CSRN54 GOTO T106E NOT END PAGE 04960CSR EXSR SR78 END PAGE PROMPT/READ 04970CSR 90 GOTO END106 04980CSR EXSR SR71 PUT HEADING 04990CSRN77 SETON 44 ÐÐ05000CSRN77 EXSR SR41 PUT EH HEADING 05010CSR 77 EXSR SR202 RJ 05020CSR 77 MOVE W12A TPN 05030CSR 77 GOTO SR106 05040CSR GOTO T106E 05050C*------------------------------------------------------------------ 05060CSR T106R TAG 05070CSR EXSR SR79 END FILE PROMPT 05080CSR 77 EXSR SR202 05090CSR 77 MOVE W12A TPN 05100CSR 77 GOTO SR106 05110C*----------------------------------------------------------------- 05120CSR END106 TAG 05130CSR SETOF 20 05140CSR ENDSR 05150C******************************************************************** 05160CSR SR107 BEGSR 05170C* DISPLAY MFR SEQ 05180CSR SETON 21 05190CSR SETOF 457790 05200CSR SETOF 92 05210CSR SETON 75 05220CSR EXCPT PART # PROMPT 05230CSR SETOF 75 05240CSR 1 ADD LINENO LINENO ÐÐ05250CSR EXSR SR75 READ CRT 05260CSR 90 GOTO END107 05270CSR SETOF 907736 05280CSR EXSR SR202 R.J. 05290CSR MOVE W12A TPN 05300CSR MOVELTMFR W20A 20 05310CSR MOVELTPN W15A 15 05320CSR MOVE ' ' W20A 05330CSR MOVE W15A W20A 05340CSR W20A SETLLEGMFR 05350C*------------------------------------------------------------------- 05360CSR T107B TAG 05370CSR Z-ADD1 T 20 05380CSR Z-ADD1 P 20 05390CSR SETOF 54 05400CSR READ EGMFR 54 05410CSR 54 GOTO T107R EOF 05420CSR EMSTAT COMP 'D' 54 05430CSR 54 GOTO T107B DELETED 05440CSR EMPN SETLLEGMAST 05450CSR SETOF 54 05460CSR READ EGMAST 54 GET EGMAST 05470CSRN54 EGSTAT COMP 'D' 54 CHECK DELETE 05480CSR 54 GOTO T107B NOT ON FILE 05490CSR EGPN COMP EMPN 54 ÐÐ05500CSRN54 GOTO T107B 05510CSR SETOF 463536 05520CSR Z-ADDEMPTR RRN 50 05530CSR EXSR SR86 GET EGMFRPN 05540CSR 36 GOTO T107B 05550CSR EXSR SR68 LF 05560CSR 50 LINENO COMP 112 54 05570CSRN50 LINENO COMP 117 54 05580CSRN54 GOTO T107E NOT END PAGE 05590CSR EXSR SR78 PUT EOP MSG 05600CSR EXSR SR71 NEW PAGE 05610CSR 77 GOTO END107 05620CSR 92 GOTO SR107 05630CSR 90 GOTO END107 05640C*------------------------------------------------------------------- 05650CSR T107E TAG 05660CSRN35 EXSR SR85 GET TEXT 05670CSR 35 46 GOTO T107B NO MORE TEXT 05680CSR EXSR SR42 PUT DATA 05690CSR 35 GOTO T107B NO MORE TEXT 05700CSR 50 LINENO COMP 113 54 54 05710CSRN50 LINENO COMP 118 54 54 05720CSRN54 GOTO T107E 05730CSR EXSR SR78 END PAGE PROMPT 05740CSR EXSR SR71 NEW PAGE ÐÐ05750CSR 77 GOTO END107 05760CSR 92 GOTO SR107 05770CSR 90 GOTO END107 05780CSR GOTO T107E 05790C*-------------------------------------------------------------- 05800CSR T107R TAG 05810CSR EXSR SR79 END FILE PROMPT 05820CSR 92 GOTO SR107 05830C*----------------------------------------------------------------- 05840CSR END107 TAG 05850CSR SETOF 21 05860CSR ENDSR 05870C************************************************************** 05880CSR SR202 BEGSR 05890C* RIGHT ADJUST 05900CSR Z-ADD12 W2N 20 05910CSR EXIT SUBRAJ RJ 05920CSR RLABL W2N 05930CSR RLABL W12A 05940CSR ENDSR 05950C****************************************************************** 05960OTERM132 E 71 05970O BIT,28 1 05980O N50 8 '8091001' 05990O N50 BIT,1 9 ÐÐ06000O N50 BIT,1 10 06010O 50 10 '[001 ]001' 06020O 50 BIT,28 6 06030O UDATE 18 ' - - ' 06040O 47 'E N G I N E E R I N G' 06050O 65 'S T A N D A R D' 06060O 75 'P A R T' 06070O 89 'N U M B E R' 06080O 105 'D I S P L A Y' 06090O*---------------------------------------------------------------- 06100O E 71 06110O 1 ' ' 06120O*---------------------------------------------------------------- 06130O E 71 06140O* DATA HEADING 06150O 20 'PART-NO.' 06160O 37 'DESCRIPTION' 06170O 83 'STD-CODE' 06180O 95 'INSP-CODE' 06190O 105 'MFR-CODE' 06200O 121 'MFR-PART-NO #' 06210O*-------------------------------------------------------------- 06220O E 71 06230O 1 ' ' 06240O*----------------------------------------------------------------- ÐÐ06250O E 41N43 06260O DOT 132 06270O E 41 06280O EHTEXT 80 06290O*--------------------------------------------------------------- 06300O E 42 06310O* DATA 06320O N46 EGPN 24 ' - - ' 06330O N35 ETTEXT B 71 06340O N46 EGSTD 81 06350O N46 EGINSP 93 06360O N36 EPMFR B 103 06370O N36 EPMPN B 132 06380O*----------------------------------------------------------------- 06390O E 70 06400O 24 '1. DYNAIR PART NO. DISP' 06410O 48 'LAY ' 06420O E 70 06430O 23 '2. MANUFACTURER''S PART' 06440O 48 'NO. DISPLAY ' 06450O E 70 06460O 1 ' ' 06470O E 70 06480O NUL 132 06490O 24 'ENTER SELECTION. . . . .' ÐÐ06500O*-------------------------------------------------------------- 06510O E 75 06520O NUL 132 06530O 24 'ENTER PART NO. . . . . .' 06540O E 76 06550O NUL 132 06560O 23 'ENTER MANUFACTURER''S CO' 06570O 47 'DE. . . . . . . . . ' 06580O*---------------------------------------------------------------- 06590O E 78 06600O NUL 132 06610O 24 'E N D O F P A G E...' 06620O*----------------------------------------------------------------- 06630O E 79 06640O NUL 132 06650O 24 'E N D O F F I L E...' 06660O******************************************************************** 06670OCRTFILE E 97 06680O PROG 26 06690O CRTIME 33 06700O CRDATE 37 06710O LNK 79 06720O*************************************************************** ** NUL ARRAY 006730 006740ÐÐ** A12 ARRAY 06750 06760** DOT 06770 06780** LNK ARRAY 06790 06800/* 06810_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ŠA´ ŠX005RM PV999999120282(èÈÐ00010H Q005RM00020F* PRINT SHOP TRAVELLERS (DIABLO). (X005RM) DG REL006 OK 00030F* REVISED 10-06-81 2:45 PM. 00040FBITHEX IP F 256 DISK 00050FWOINPUT US F 32 27AI 1 DISK 00060FRMMAST ID F 140L15AI 1 DISK 00070FREXTPTR ID F 25L21AI 1 DISK 00080FREXTFILEIC F 90R DISK 00090FPMMST2 IC F 674R12AI 1 DISK 00100FWCMAST IC F 960R 8AI 1 DISK 00110FCRTFILE UC F 256R DISK 00120E******************************************************************** 00130E BIT 256 1 00140E TXT 60 1 00150E REC 132 1 00160E WSH 104 9 3 00170E*** WAA 52 9 3 00180E*** WAS 52 9 3 00190E WEC 3 5 0 00200I******************************************************************** 00210IBITHEX BT 00220I 1 256 BIT 00230I**************************************************************** 00240ICRTFILE CR 00250I 125 256 REC ÐÐ00260I******************************************************************** 00270IWOINPUT WI 01 00280I* WORK ORDER INPUT FILE. 00290I* PART # 12A 00300I 1 12 WIPN 00310I* DUE DATE 6N 00320I 13 180WIDUE 00330I* WORK ORDER # 6N 00340I 19 24 WIORD 00350I* SPLIT # 3N 00360I 25 270WISPLT 00370I* QTY 7P 00380I P 28 310WIQTY 00390I* STATUS CODE 1A 00400I 32 32 WISTAT 00410I******************************************************************** 00420IRMMAST RM 00430I* ROUTING MASTER. 00440I* KEY AREA. 00450I* PART # 12A 00460I 1 12 RMPN 00470I* OPER SEQ # 3N 00480I 13 150RMSEQ 00490I 1 15 RMKEY 00500I* OPER GROUP CODE 2A ÐÐ00510I 16 17 RMGRUP 00520I* OVERLAP % .2N 00530I 18 192RMOVLP 00540I* OPER CODE 5A 00550I 20 24 RMOPER 00560I* OPER DEPT. 00570I* DEPT # 5P 00580I P 25 270RMDEPT 00590I* WORK CENTER 3P 00600I P 28 290RMWC 00610I* OPER DESCRIPTION 40A 00620I 30 69 RMDESC 00630I* LABOR STDS. 00640I* ACCOUNTING STD. 00650I* DATE ADOPTED 7P 00660I P 70 730RMADAT 00670I* SET-UP 9.3P 00680I P 74 783RMASU 00690I* RUN 9.3P 00700I P 79 833RMARUN 00710I* MIN CHARGE 7.2P 00720I P 84 872RMAMIN 00730I* STD LOT SIZE 7P 00740I P 88 910RMALOT 00750I* REVISED STDS. ÐÐ00760I* DATE LAST REVISED 7P 00770I P 92 950RMRDAT 00780I* SET-UP 9.3P 00790I P 96 1003RMRSU 00800I* RUN 9.3P 00810I P 101 1053RMRRUN 00820I* MIN. CHARGE 7.2P 00830I P 106 1092RMRMIN 00840I* STD LOT SIZE 7P 00850I P 110 1130RMRLOT 00860I* METHOD ESTAB 1A 00870I 114 114 RMMETH 00880I* JOB SKILL 5A 00890I 115 119 RMSKIL 00900I* PERFORM FACTOR. 00910I* ACTUAL 5.2P 00920I P 120 1222RMPER 00930I* ASSIGNED 5.2P 00940I P 123 1252RMPER2 00950I* NUMB LOTS RUN 5P 00960I P 126 1280RMLRUN 00970I* NUMB UNITS RUN 5P 00980I P 129 1310RMQRUN 00990I* FILLER 132 139 FFFFFF 01000I* RECORD STATUS 1A ÐÐ01010I 140 140 RMSTAT 01020I******************************************************************** 01030IREXTPTR TP 01040I* TEXT POINTER FILE. 01050I* TEXT KEY 15A 01060I 1 15 TPKEY 01070I 1 12 TPPN 01080I 13 150TPSEQ 01090I* LINE # 6N 01100I 16 210TPLINE 01110I* POINTER 7P 01120I P 22 250TPPTR 61 01130I******************************************************************** 01140IREXTFILETX 01150I* REXTFILE RECORD. 01160I* KEY 15A 01170I 1 15 TXKEY 01180I* LINE # 6N 01190I 16 210TXLINE 01200I* TEXT 1A X 60 01210I 22 81 TXT 01220I* BACKWARD PTR (DELETE) 7P 01230I P 82 850TXBPTR 01240I* RECORD STATUS 1A 01250I 90 90 TXSTAT ÐÐ01260I******************************************************************** 01270IPMMST2 PM 01280I 15 180PMPL 01290I 19 30 PMMODL 01300I 31 59 PMDESC 01310I 70 71 PMREV 01320I 496 500 PMMCN 01330I 674 674 PMSTAT 01340I******************************************************************** 01350IWCMAST WC 01360I* WORK CENTER MAST 01370I* DEPT # 5N 01380I 1 50WCDEPT 01390I* WORK CENTER # 3N 01400I 6 80WCWC 01410I* WORK CENTER NAME 29A 01420I 9 37 WCNAME 01430I* LABOR TYPE 1A 01440I* D = DIRECT ONLY 01450I* I = INDIRECT ONLY 01460I* B = BOTH 01470I 46 46 WCLAB 01480I* LABOR RATE - SET-UP 5.2P (HR) 01490I P 47 492WCLRAT 01500I* LABOR RATE - RUN 5.2P (HR) ÐÐ01510I P 50 522WCRRAT 01520I* LABOR RATE - BURDEN 5.2P (HR) 01530I P 53 552WCBRAT 01540I* UTILIZATION % 5.2P 01550I P 56 582WCUTIL 01560I* PERFORMANCE % 5.2P 01570I P 59 612WCPERF 01580I* SCHEDULED HRS 104 X 9.3B 01590I B 62 477 WSH 01600I* ACTUAL HRS (CMPLTNS) 52 X 9.3B 01610I*** B 478 685 WAA 01620I* STD HRS (CMPLTNS) 52 X 9.3B 01630I*** B 686 893 WAS 01640I* LEAD TIME 3P 01650I P 894 8950WCLT 01660I* MOVE-TO HRS REQD 3P 01670I P 896 8970WCMOVT 01680I* MOVE-FROM HRS REQD 3P 01690I P 898 8990WCMOVF 01700I* ESTIMATED CAPACITY-HRS/SHIFT 5P X 3 01710I P 900 908 WEC 01720I* SUPERVISOR NAME 15A 01730I 909 923 WCSPRV 01740I* FILLER 924 959 FFFFFF 01750I* RECORD STATUS 1A ÐÐ01760I 960 960 WCSTAT 01770C******************************************************************** 01780C* INITIALIZE. 01790C H8 GOTO END 01800C N79 EXSR SR101 INIT. 01810C* BYPASS BITHEX FILE 01820C N01 GOTO END NOT WOINPUT FILE 01830C* BYPASS ALREADY DONE. 01840C WISTAT COMP 'D' 54 01850C 54 SETOF 01 01860C 54 GOTO END 01870C MOVELWIPN NUMPN 100 01880C MOVELWIPN W15A 15 01890C Z-ADD0 EGAP 01900C*------------------------------------------------------------------- 01910C TAG100 TAG 01920C* GET ROUTING MAST/TEXT AND PRINT. 01930C EXSR SR102 PRINT OPER. 01940C*------------------------------------------------------------------- 01950C END TAG 01960CLR EXITFZTFORM TOP OF FORM 01970C******************************************************************** 01980CSR SR71 BEGSR 01990C* SKIP NEW PAGE. 02000CSR 1 ADD EGAP EGAP 20 ÐÐ02010CSR Z-ADD13 LINE 30 02020CSR EXITFZTFORM SKIP PAGE. 02030CSR Z-ADD0 X 30 02040C*--------------------------------------------------------------- 02050CSR T71A TAG 02060CSR 1 ADD X X 02070CSR X COMP 12 54 02080CSR 54 GOTO END71 02090CSR X COMP 1 41 02100CSR X COMP 3 43 02110CSR X COMP 4 44 02120CSR X COMP 5 45 02130CSR X COMP 6 46 02140CSR X COMP 7 47 02150CSR X COMP 8 48 02160CSR X COMP 9 49 02170CSR X COMP 10 50 02180CSR X COMP 11 51 02190CSR X COMP 12 52 02200CSR 41 02210COR 45 02220COR 49 GOTO T71B 02230CSR 41 02240COR 43 02250COR 44 ÐÐ02260COR 45 02270COR 46 02280COR 47 02290COR 48 02300COR 49 02310COR 50 02320COR 51 02330COR 52 EXSR SR72 PUT DATA 02340CSR GOTO T71A 02350C*------------------------------------------------------------- 02360CSR T71B TAG 02370CSR EXSR SR73 LF 02380CSR GOTO T71A 02390CSR END71 ENDSR 02400C******************************************************************** 02410CSR SR72 BEGSR 02420C* PUT LINE TO DIABLO 02430CSR EXSR SR73 LF 02440CSR PORT CHAINCRTFILE H9 02450CSR H9 GOTO END72 02460CSR MOVE ' ' REC 02470CSR RMWC COMP 0 54 02480CSR EXCPT 02490CSR PORT CHAINCRTFILE H9 02500CSR MOVEAREC W148A 148 ÐÐ02510CSR EXITFZD148 02520CSR RLABL W148A 02530C*------------------------------------------------------------------- 02540CSR END72 TAG 02550CSR SETOF 717273 02560CSR SETOF 444647 02570CSR SETOF 485051 02580CSR SETOF 527573 02590CSR SETOF 747841 02600CSR SETOF 424549 02610CSR SETOF 53 02620CSR ENDSR 02630C******************************************************************** 02640CSR SR73 BEGSR 02650C* LINE FEED. 02660CSR EXITFQCLF LF 02670CSR ENDSR 02680C******************************************************************** 02690CSR SR101 BEGSR 02700C* 1-TIME INITIALIZE. 02710CSR SETON 79 02720CSR MOVELBIT,1 NULLGT 2 NULL LGTH 02730CSR MOVE BIT,6 NULLGT 02740CSR MOVE ' ' BLK60 60 02750CSR MOVE ' ' W8A 8 ÐÐ02760CSR Z-ADD0 W2N 20 02770CSR Z-ADD0 W1N 10 02780CSR MOVE ' ' W2A 2 02790CSR EXITFPGMINX GET PORT # 02800CSR RLABL W8A 02810CSR RLABL W2N 02820CSR RLABL W1N 02830CSR RLABL W2A 02840CSR MOVE W2A PORT 20 RING BELL 02850CSR PORT COMP 0 54 02860CSRN54 Z-ADD25 PORT 02870CSR PORT CHAINCRTFILE H9 02880CSR H9 GOTO END101 02890CSR MOVE '08' W2A 2 02900CSR EXITFZVMI VERTICAL SPACING 02910CSR RLABL W2A 02920CSR MOVE '15' W2A 02930CSR EXITFZHMI HORIZ SPACING 02940CSR RLABL W2A 02950CSR MOVE ' ' REC 02960CSR EXITFQBELL RING BELL 02970CSR EXITFQBELL 02980CSR EXITFQBELL 02990CSR EXITFQBELL 03000CSR EXITFQBELL ÐÐ03010CSR EXITFQHALT DUMMY READ 03020CSR END101 ENDSR 03030C******************************************************************** 03040CSR SR102 BEGSR 03050C* PRINT TRAVELER. 03060C* GET PART MASTER. 03070CSR WIPN CHAINPMMST2 60 03080CSRN60 PMSTAT COMP 'D' 60 03090CSR 60 Z-ADD291 M 50 96 03100C* PRINT HEADING. 03110CSR EXSR SR71 03120CSR MOVELWIPN W15A 15 03130CSR W15A SETLLRMMAST 03140C*------------------------------------------------------------------- 03150CSR T102A TAG 03160C* GET ROUTING OPER. 03170CSR SETOF 5480 03180CSR READ RMMAST 54 03190CSR 54 GOTO T102W END FILE. 03200CSR WIPN COMP RMPN 54 03210CSRN54 GOTO T102W 03220CSR RMSTAT COMP 'D' 54 03230CSRN54 RMSTAT COMP 'G' 54 03240CSR 54 GOTO T102A 03250CSR MOVELRMDEPT W8N 80 ÐÐ03260CSR MOVE RMWC W8N 03270CSR W8N CHAINWCMAST 54 03280CSRN54 MOVELWCNAME DEPNAM 16 03290CSR 54 MOVE BLK60 DEPNAM 03300C* PRINT ROUTING OPER. 03310CSR SETON 75 03320CSR EXSR SR72 SKIP LINE 03330CSR SETOF 75 03340CSR SETON 72 03350CSR EXSR SR72 PRINT OPER. 03360CSR SETOF 72 03370CSR 2 ADD LINE LINE 03380CSR LINE COMP 75 54 03390CSR 54 EXSR SR71 SKIP PAGE. 03400CSR MOVELRMKEY W21A 21 03410CSR W21A SETLLREXTPTR 03420CSR SETOF 80 03430C*------------------------------------------------------------------- 03440CSR T102B TAG 03450C* PRINT TEXT. 03460CSR SETOF 54 03470CSR READ REXTPTR 54 03480CSR 54 GOTO T102E 03490CSR TPPN COMP RMPN 54 03500CSR 54 TPSEQ COMP RMSEQ 54 ÐÐ03510CSRN54 GOTO T102E 03520CSR TPPTR COMP 0 54 03530CSRN54 GOTO T102B INACTIVE PTR 03540CSR TPPTR CHAINREXTFILE 54 03550CSR 54 GOTO T102E 03560CSR SETON 73 03570CSR EXSR SR72 PRINT TEXT. 03580CSR SETOF 73 03590CSR SETON 80 03600CSR 1 ADD LINE LINE 03610CSR LINE COMP 80 54 PAGE LGTH. 03620CSR 54 EXSR SR71 SKIP PAGE. 03630CSR GOTO T102B 03640C*------------------------------------------------------------------- 03650CSR T102E TAG 03660CSR 80 GOTO T102A 03670CSR SETON 76 03680CSR EXSR SR72 PRINT RUN TIME 03690CSR SETOF 76 03700CSR 1 ADD LINE LINE 03710CSR LINE COMP 80 54 03720CSR 54 EXSR SR71 SKIP PAGE 03730CSR GOTO T102A 03740C*------------------------------------------------------------------- 03750CSR T102W TAG ÐÐ03760C* PRINT END TRAVELER LEGEND. 03770CSR EXSR SR73 LF 03780CSR SETON 74 03790CSR EXSR SR72 END TRAV MSG. 03800CSR SETOF 74 03810CSR END102 ENDSR 03820O******************************************************************** 03830OWOINPUT D 01 03840O 32 'D' 03850O******************************************************************** 03860OCRTFILE E 43 03870O REC 256 03880O 128 'PAGE' 03890O EGAP Z 131 03900O 159 'W O R K -' 03910O 171 'O R D E R -' 03920O 187 'T R A V E L E R' 03930O 210 'WORK' 03940O*------------------------------------------------------------------- 03950O E 44 03960O REC 256 03970O 212 'ORDER#' 03980O WIORD 219 03990O*------------------------------------------------------------------- 04000O E 46 ÐÐ04010O REC 256 04020O 137 'PART NO.' 04030O 142 ':' 04040O NUMPN 156 ' - - ' 04050O 202 'QUANTITY :' 04060O WIQTY 2 210 04070O*------------------------------------------------------------------- 04080O E 47 04090O REC 256 04100O 140 'DESCRIPTION' 04110O 142 ':' 04120O PMDESC 173 04130O 199 'DATE DUE' 04140O 202 ':' 04150O WIDUE 211 ' - - ' 04160O*------------------------------------------------------------------- 04170O E 48 04180O REC 256 04190O 138 'MODEL NO.' 04200O 142 ':' 04210O PMMODL 156 04220O 162 'MCN=' 04230O PMMCN 167 04240O 200 'PROD-LINE' 04250O 202 ':' ÐÐ04260O PMPL Z 211 04270O 220 'REV' 04280O PMREV 223 04290O E 50 04300O REC 256 04310O 134 'OPER*' 04320O 148 '---D E P A R T' 04330O 160 'M E N T---*' 04340O 181 '- - - - - - - - - - -' 04350O 202 'D E S C R I P T I O N' 04360O 223 '- - - - - - - - - - -' 04370O*------------------------------------------------------------------- 04380O E 51 04390O REC 256 04400O 132 'SEQ' 04410O 134 '*' 04420O 138 'NUMB' 04430O 144 'W.C.' 04440O 150 'NAME' 04450O 160 '*' 04460O 234 '*' 04470O 245 'LABOR-STD' 04480O*------------------------------------------------------------------- 04490O E 52 04500O REC 256 ÐÐ04510O 134 '*' 04520O 160 '*' 04530O 234 '*' 04540O*------------------------------------------------------------------ 04550O E 75 04560O REC 256 04570O 134 '*' 04580O 160 '*' 04590O 234 '*' 04600O*------------------------------------------------------------------- 04610O E 72 04620O REC 256 04630O RMSEQ Z 132 04640O RMDEPTZ 139 04650O RMWC Z 143 04660O 54 140 '-' 04670O DEPNAM 160 04680O 134 '*' 04690O 160 '*' 04700O RMDESC 201 04710O 234 '*' 04720O RMRSU 2 249 04730O 238 'SU =' 04740O*------------------------------------------------------------------- 04750O E 73 ÐÐ04760O REC 256 04770O TXT 221 04780O 134 '*' 04790O 160 '*' 04800O 234 '*' 04810O N80 RMRRUN2 249 04820O N80 238 'RUN=' 04830O*------------------------------------------------------------------- 04840O E 76 04850O REC 256 04860O RMRRUN2 249 04870O 238 'RUN=' 04880O 134 '*' 04890O 160 '*' 04900O 234 '*' 04910O*------------------------------------------------------------------- 04920O E 74 04930O REC 256 04940O 141 'END TRAVELER' /* 04950_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(XBÄ XúX112BM P120282120282(èÈÐ00010H Q112BM00020F* IND PARTS LIST - DISPLAY EXCESSIVE LEAD TIMES (X112BM) 00030F* REV 4/09/81 3:00 PM. DG-REL006 OK. 00040FBITTAB IP F 33 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FBMMAST ID F 86L20AI 1 DISK 00070FMGFILE IC F 80R DISK 00080FTERM132 O F 132 5 00090E******************************************************************** 00100E NUL 50 50 1 NULL CHAR. 00110E N20 20 20 1 NULL CHAR. 00120E A6 6 6 1 00130E A12 12 12 1 A INPUT ARRAY. 00140E LEV 1 20 20 NEXT RRN AT EA LEVEL 00150E QTY 1 20 7 0 QTY MULTIPLIER 00160E BIT 33 1 BITTAB. 00170E PLT 8 3 0 LEAD TIMES 00180I******************************************************************** 00190IBITTAB BT 00200I 1 33 BIT 00210I******************************************************************** 00220IPMMST2 PM 00230I* PART MASTER RECORD (XPMMST) 00240I* KEY AREA 00250I* PART NO. 12A ÐÐ00260I 1 12 PMPN 00270I* NUMB OF COMPONENTS 3P 00280I P 13 140PMNOBM 00290I* PROD LINE 4N 00300I 15 180PMPL 00310I* MODEL NAME 12A 00320I 19 30 PMMODL 00330I* DESCRIPTION 29A 00340I 31 59 PMDESC 00350I* COMMODITY CODE 9P 00360I P 60 640PMCC 00370I* ENG CHANGE STATUS. 00380I* CUR CHG LEVEL 2A 00390I 70 71 PMECHG 00400I* CUR CHG DATE 6N 00410I 72 770PMDCHG 00420I* LAST ECN NO. 5A 00430I 65 69 PMECN 00440I* DRAWING INFO 00450I* DWG SIZE 1A 00460I 82 82 PMSIZ 00470I* DWG CLASS 1A 00480I* D = DYNAIR DWG 00490I* V = VENDOR DWG 00500I 83 83 PMDCLS ÐÐ00510I* STANDARD CODE 1A 00520I 84 84 PMSTDC 00530I* DWG REL CODE 1A 00540I* E = ENG ONLY 00550I* M = REL TO MFG 00560I* P = PROTOTYPE 00570I 78 78 PMDREL 00580I* UNIT MEAS 2A 00590I* EA = EACH OC = OUNCE 00600I* ST = SET TC = TROY OUNCE 00610I* IN = INCH LB = POUND 00620I* FT = FEET PT = PINT 00630I* YD = YARD QT = QUART 00640I* SI = SQ.INCH GL = GALLON 00650I* SF = SQ.FEET DR = DRUM 00660I* SY = SQ.YARD 00670I 85 86 PMUM 00680I* SOURCE CODE 2A 00690I* MA = MFG ASSY 00700I* MP = MFG PART 00710I* PA = PURCH ASSY 00720I* PP = PURCH PART 00730I* RS = RAW STOCK 00740I 94 95 PMSC 00750I* PROVISIONING CODE 1A ÐÐ00760I* A = FORECAST,NO VALUE ADDED 00770I* B = FORECAST,VALUE ADDED 00780I* C = BUILD TO ORDER (B) 00790I* D = BUILD TO ORDER (NOT B) 00800I* E = CUSTOM 00810I* Y = OBSOLETE,REPAIRABLE 00820I* Z = OBSOLETE,NOT REPAIRABLE 00830I 96 96 PMPROV 00840I* ISSUE CODE 2A 00850I* PT = PULL TIME 00860I* OR = ON REQUEST 00870I* BI = BULK ISSUE 00880I* AR = AS REQUIRED 00890I* VS = VENDOR SUPPLIED 00900I* SD = SHIPPING DOCUMENT 00910I* TD = TRAV DOCUMENT 00920I* RD = REF DOCUMENT 00930I* RA = REF ASSY 00940I 97 98 PMISSU 00950I* DELIVER TO DEPT 5P 00960I P 99 1010PMDEL 00970I* RESPONSIBILITY CODES 00980I* ENGR CODE 2A 00990I 102 103 PMEGR 01000I* PLANNER CODE 2A ÐÐ01010I 104 105 PMPLNR 01020I* BUYER CODE 2A 01030I 106 107 PMBUYR 01040I* SALESMAN CODE 2A 01050I 108 109 PMSLSM 01060I* INVENTORY ACCOUNT 5P 01070I P 110 1120PMACNT 01080I* LEAD TIMES 8 X 3P 01090I P 113 128 PLT 01100I* FAB CODE 2A 01110I 487 488 PMFABC 01120I* RECORD STATUS 1A 01130I* D = DELETED 01140I 674 674 PMSTAT 01150I******************************************************************** 01160IBMMAST BM 01170I* BILL OF MATERIAL RECORD 01180I* KEY AREA 01190I* ASSY PART NO. 10N 01200I 1 100BMAPN 01210I* COMPONENT PART # 10N 01220I 11 200BMCPN 01230I* ITEM NO. 3N 01240I 25 270BMITNO 01250I* QTY PER ASSY 7P ÐÐ01260I P 28 310BMQTY 01270I* SCRAP ALLOW .2N 01280I 34 352BMSCRP 01290I* ISSUE CODE 2A 01300I* PT = PULL TIME 01310I* OR = ON REQUEST 01320I* BI = BULK ISSUE 01330I* AR = AS REQUIRED 01340I* RA = REF ASSY 01350I* TD = TRAV DOC 01360I* SD = SHIP DOC 01370I* RD = REF DOC 01380I* VS = VENDOR SUPPLIED 01390I 36 37 BMISSU 01400I* EFFECTIVITY. 01410I* BEGIN CHANGE LEVEL 2A 01420I 38 39 BMBCHG 01430I* ENDING CHANGE LEVEL 2A 01440I 40 41 BMECHG 01450I* BEGIN ECN # 5A 01460I 42 46 BMBECN 01470I* ENDING ECN # 5A 01480I 47 51 BMEECN 01490I* DISPOSITION CODE 1A 01500I* U = USE UP OLD STYLE ÐÐ01510I* N = NOW (IMMEDIATE) 01520I 52 52 BMDISP 01530I* FILLER 5A 53 57 FFFFFF 01540I* ROUTING. 01550I* OPER NO. 5P 01560I P 58 600BMOPER 01570I* DEPT NO. 5P 01580I P 61 630BMDEPT 01590I* WORK CENTER NO. 3P 01600I P 64 650BMWC 01610I* COMPONENT OPER REFERENCE INFO 10A 01620I 66 75 BMREF 01630I* FILLER 10A 76 85 FFFFFF 01640I* 01650I* RECORD STATUS 1A 01660I* D = DELETED 01670I 86 86 BMSTAT 01680I******************************************************************** 01690IMGFILE MG 01700I* MESSAGE FILE. 01710I* TEXT 35A 01720I 1 35 MGTEXT 01730I* LINE-2 35A 01740I 36 70 MGLIN2 01750I* PROG NAME 5A ÐÐ01760I 71 75 MGPROG 01770C******************************************************************** 01780C* INITIALIZE 01790C EXSR SR101 INIT 01800C*---------------------------------------------------------------- 01810C START TAG 01820C* GET ASSY PART NO FROM TERMINAL 01830C SETOF 9693 01840C Z-ADD185 M 50 MSG # 01850C EXSR SR73 PROMPT 01860C EXSR SR75 READ 01870C 96 GOTO START ERROR 01880C 98 GOTO GOODBY ABORT 01890C 94 GOTO MENU RET TO MENU 01900C 93 GOTO START NEW ITEM REQST 01910C N77 GOTO START NO INPUT 01920C Z-ADD12 W2N 20 01930C EXIT SUBRAJ R. JUSITFY 01940C RLABL W2N 01950C RLABL W12A 01960C MOVE W12A TAPN 100 TOP ASSY PN 01970C MOVE BLK12 W12A 01980C MOVELTAPN W12A 01990C EXSR SR81 GET PMMST2 02000C N60 GOTO TAG5 GOT IT ÐÐ02010C Z-ADD302 M 96 FLAG ERROR 02020C EXSR SR73 PUT MSG 02030C GOTO START 02040C*---------------------------------------------------------------- 02050C TAG5 TAG 02060C SETON 76 02070C EXCPT ENTER LIMIT PROMPT 02080C SETOF 76 02090C EXSR SR75 READ TERMINAL 02100C 96 GOTO START 02110C 98 GOTO GOODBY 02120C 94 GOTO MENU 02130C 93 GOTO START 02140C EXIT SUBRAJ R.J. 02150C RLABL W2N 02160C RLABL W12A 02170C MOVE W12A LIMIT 40 02180C TAG10 TAG 02190C* FLAG NO COMPONENTS ON FILE 02200C PMNOBM COMP 0 55 02210C N55 Z-ADD316 M 50 02220C N55 EXSR SR73 PUT ERR MSG 02230C N55 GOTO START 02240C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 02250C XFOOTPLT TPLT 40 ÐÐ02260C Z-ADD1 QTY,2 QTY MULTIPLIER 02270C SETON 89 02280C EXSR SR71 PUT HEADING 02290C SETOF 89 02300C* SET-UP INITIAL BILL MATERIAL READ 02310C Z-ADD3 L 20 INDENTURE LEVEL 02320C MOVE BLK20 LEV 02330C MOVELTAPN LEV,2 02340C*----------------------------------------------------------------- 02350C TAG20 TAG 02360C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02370C L SUB 1 L 54 INDENT LEVEL 02380C N54 GOTO ENDASY BOTTOM INDENT 02390C LEV,L COMP BLK20 54 02400C N54 GOTO TAG20 NONE THIS LEVEL 02410C MOVE LEV,L W20A 20 02420C MOVELLEV,L CURASY 100 MATCH PART # 02430C MOVE BLK20 LEV,L 02440C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02450C*------------------------------------------------------------------ 02460C TAG30 TAG 02470C* SET-UP NEXT READ 02480C W20A SETLLBMMAST 02490C*--------------------------------------------------------------- 02500C TAG40 TAG ÐÐ02510C* GET NEXT COMPONENT. 02520C SETOF 54 02530C READ BMMAST 54GET COMPONENT 02540C 54 GOTO TAG20 END OF FILE 02550C BMAPN COMP CURASY 54 02560C N54 GOTO TAG20 WRONG ASSY 02570C BMSTAT COMP 'D' 54 02580C 54 GOTO TAG40 DELETED RECORD 02590C* DISPLAY COMPONENT DATA 02600C EXSR SR72 DISPLAY DATA 02610C 98 GOTO GOODBY 02620C 94 GOTO MENU 02630C 93 GOTO START 02640C*------------------------------------------------------------------- 02650C TAG45 TAG 02660C* BRANCH IF NOT ASSY 02670C PMNOBM COMP 0 54 02680C N54 GOTO TAG40 NOT ASSY 02690C*------------------------------------------------------------------ 02700C TAG50 TAG 02710C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02720C MOVELBMAPN LEV,L 02730C 1 ADD BMCPN W10N 100 02740C MOVE W10N LEV,L 02750C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER ÐÐ02760C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02770C MOVE BMCPN CURASY 02780C MOVELBMCPN W20A 02790C MOVE ZERO10 W20A 02800C 1 ADD L L INDENT LEVEL 02810C GOTO TAG30 02820C*------------------------------------------------------------------ 02830C ENDASY TAG 02840C* END OF ASSY PROMPT 02850C EXSR SR76 END ASSY PROMPT 02860C 98 GOTO GOODBY 02870C 94 GOTO MENU 02880C GOTO START 02890C*----------------------------------------------------------------- 02900C MENU TAG 02910C* SET RETURN TO MENU LINKAGE 02920C MOVEL'QQBM02' PROG 8 02930C GOTO END 02940C*----------------------------------------------------------------- 02950C GOODBY TAG 02960C* SET ABORT LINKAGE 02970C MOVEL'GOODBY' PROG 02980C GOTO END 02990C*----------------------------------------------------------------- 03000C END TAG ÐÐ03010C* LINK TO NEXT PROG 03020C EXITFCHAIN 03030C RLABL PROG 03040C*------------------------------------------------------------------ 03050C ENDJOB TAG 03060C******************************************************************** 03070CSR SR71 BEGSR 03080C* CLEAR CRT. PUT HEADINGS. 03090CSR Z-ADD4 COUNT 30 LINE COUNT 03100CSR MOVELTAPN W12A 03110CSR MOVE ' ' W12A 03120CSR EXSR SR81 GET TOP-ASSY PMMST2 03130CSR SETON 71 03140CSR EXCPT PUT HEADING 03150CSR SETOF 71 03160CSR SETON 75 03170CSR EXCPT PUT TOP ASSY DATA 03180CSR SETOF 75 03190CSR ENDSR 03200C******************************************************************** 03210CSR SR72 BEGSR 03220C* DISPLAY DATA LINE TO CRT. 03230CSR MOVE BLK12 W12A 03240CSR MOVELBMCPN W12A COMP PN 03250CSR EXSR SR81 GET PMMST2 ÐÐ03260CSR XFOOTPLT LEAD 40 03270CSR LEAD COMP LIMIT 54 03280CSRN54 GOTO END72 03290CSR L COMP 1 0101 03300CSR L COMP 2 02 03310CSR L COMP 3 03 03320CSR L COMP 4 04 03330CSR L COMP 5 05 03340CSR L COMP 6 06 03350CSR L COMP 7 07 07 03360CSR 01 Z-ADD1 L 03370CSR BMISSU COMP ' ' 55 03380CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03390CSR SETON 72 03400CSR EXCPT PUT DATA. 03410CSR SETOF 72 03420CSR 1 ADD COUNT COUNT 30 03430CSR COUNT COMP 28 54 54 03440CSRN54 GOTO END72 NOT END PAGE 03450CSR EXITFQEPAGE END PAGE MSG 03460CSR EXSR SR75 READ 03470CSR 98 03480COR 94 03490COR 93 GOTO END72 03500CSR EXSR SR71 PUT HEADINGS ÐÐ03510CSR END72 ENDSR 03520C******************************************************************** 03530CSR SR73 BEGSR 03540C* PUT PROMPT TO CRT. 03550CSR EXSR SR89 03560CSR 54 MOVELM MGTEXT 03570CSR 2 ADD COUNT COUNT 03580CSR SETON 73 03590CSR EXCPT PUT PROMPT. 03600CSR SETOF 73 03610CSR ENDSR 03620C******************************************************************** 03630CSR SR75 BEGSR 03640C* READ CRT. 03650CSR T75 TAG 03660CSR SETOF 909493 03670CSR SETOF 7796 03680CSR MOVE BIT,7 A6,2 03690CSR MOVEAA6 W6A 6 03700CSR MOVE BLK12 W12A 12 03710CSR EXITFXCREAD 03720CSR RLABL W12A 03730CSR RLABL W6A 03740CSR MOVEAW12A A12 03750CSR MOVE BLK12 W12A ÐÐ03760CSR Z-ADD1 W 20 03770CSR '\' LOKUPA12,W 90 03780CSRN90 GOTO T75A NOT ESC. 03790CSR 1 ADD W W 03800CSR W COMP 12 54 03810CSR 54 GOTO T75C BAD ESC. 03820CSR A12,W COMP 'E' 94 EXIT. 03830CSR A12,W COMP 'N' 93 NEW ASSY. 03840CSR A12,W COMP 'G' 98 GOODBY 03850CSRN94N93N98 GOTO T75C BAD ESCAPE 03860CSR GOTO T75Z 03870C*------------------------------------------------------------------- 03880CSR T75A TAG 03890CSR Z-ADD1 W 03900CSR ' ' LOKUPA12,W 77 03910CSR 77 MOVEAA12,W W12A INPUT DATA. 03920CSR GOTO T75Z 03930C*------------------------------------------------------------------- 03940CSR T75C TAG 03950C* FLAG BAD ESCAPE. 03960CSR Z-ADD318 M 96 03970CSR EXSR SR73 FLAG ERROR. 03980CSR GOTO T75 03990C*--------------------------------------------------------------------- 04000CSR T75Z TAG ÐÐ04010CSR END75 ENDSR 04020C******************************************************************** 04030CSR SR76 BEGSR 04040C* END OF ASSY PROMPT/READ. 04050CSR Z-ADD317 M 04060CSR EXSR SR73 PUT MSG. 04070CSR EXSR SR75 04080CSR ENDSR 04090C******************************************************************** 04100CSR SR81 BEGSR 04110C* GET PART MAST. 04120CSR SETOF 61 04130CSR W12A CHAINPMMST2 60 GET PMMST. 04140CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 04150CSR ENDSR 04160C******************************************************************** 04170CSR SR89 BEGSR 04180C* GET MGFILE. 04190CSR M CHAINMGFILE 54 GET MGFILE. 04200CSR 54 MOVE BLK35 MGTEXT 04210CSR 54 MOVELM MGTEXT 04220CSR 54 MOVE 'NO MSG' MGTEXT 04230CSR ENDSR 04240C******************************************************************** 04250CSR SR101 BEGSR ÐÐ04260C* INITIALIZE (1-TIME). 04270CSR MOVE BIT,1 N20 04280CSR MOVE BIT,1 A6 04290CSR MOVE BIT,1 NUL INIT NULL CHAR. 04300CSR MOVE ' ' BLK35 35 04310CSR MOVE ' ' BLK12 12 04320CSR MOVE ' ' BLK20 20 04330CSR Z-ADD0 ZERO10 100 04340CSR ENDSR 04350O******************************************************************** 04360OTERM132 E 72 04370O* DATA LINE. 04380O 11 '.' 04390O 14 '.' 04400O 17 '.' 04410O 20 '.' 04420O 23 '.' 04430O 26 '.' 04440O 29 '.' 04450O 02 29 ' ' 04460O 03 29 ' ' 04470O L Z 2 04480O BMITNOZ 8 04490O 01 BMCPN 22 ' - - ' 04500O 02 BMCPN 25 ' - - ' ÐÐ04510O 03 BMCPN 28 ' - - ' 04520O 04 BMCPN 31 ' - - ' 04530O 05 BMCPN 34 ' - - ' 04540O 06 BMCPN 37 ' - - ' 04550O 07 BMCPN 40 ' - - ' 04560O PMDESC 71 04570O BMQTY 2 82 04580O PMUM 86 04590O PMSC 92 04600O PMISSU 98 04610O 55 BMISSU 98 04620O LEAD Z 105 04630O EXTQTY2 115 04640O PMSTDC 119 04650O PMFABC 125 04660O*------------------------------------------------------------------- 04670O E 76 04680O NUL 50 04690O NUL 100 04700O NUL 132 04710O 24 'ENTER LEAD TIME LIMIT ' 04720O 35 ' ' 04730O BIT,8 132 04740O*------------------------------------------------------------------- 04750O E 75 ÐÐ04760O* PUT TOP ASSY LINE. 04770O 2 '1' 04780O TAPN 22 ' - - ' 04790O N89 29 'CONT''D' 04800O PMDESC 71 04810O 82 '1' 04820O PMUM 86 04830O PMISSU 98 04840O PMSC 92 04850O TPLT Z 105 04860O 115 '1' 04870O PMSTDC 119 04880O PMFABC 125 04890O*------------------------------------------------------------------- 04900O E 73 04910O* PUT ERROR MESSAGE. 04920O NUL 50 04930O NUL 100 04940O NUL 132 04950O MGTEXT 35 04960O 37 ' ' 04970O BIT,8 132 04980O*------------------------------------------------------------------- 04990O E 71 05000O* CLEAR SCREEN - LINE-1. ÐÐ05010O 77 'DISPLAY EXCESSIVE LEAD' 05020O 83 'TIMES' 05030O*------------------------------------------------------------------- 05040O E 71 05050O* HEADING, LINE-2. 05060O 26 '--------------INDENTURE' 05070O 40 '--------------' 05080O 82 'QUANTITY' 05090O 94 'SOURCE' 05100O 100 'ISSUE' 05110O 105 'LEAD' 05120O 115 'EXTENDED' 05130O 120 'STD' 05140O 126 'FAB' 05150O*------------------------------------------------------------------- 05160O E 71 05170O* HEADING, LINE-3. 05180O 3 'LEV' 05190O 8 'ITEM' 05200O 29 '1 2 3 4 5 6 7' 05210O 32 '-UP' 05220O 53 'DESCRIPTION' 05230O 82 'PER-ASSY' 05240O 86 'UM' 05250O 93 'CODE' ÐÐ05260O 99 'CODE' 05270O 105 'TIME' 05280O 115 'QUANTITY' 05290O 121 'CODE' 05300O 127 'CODE' 05310O E 71 05320O* HEADING, LINE-4 (BLANK). ** NUL ARRAY 005330 005340** N20 ARRAY 005350 005360** A6 ARRAY 005370 005380** A12 ARRAY 005390 005400** LEV ARRAY 005410 005420** QTY ARRAY 005430 005440/* 005450_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dC¿ d*X112PM P120282120282(èÈÐ00010H Q112PM00020F* QUICKIE INPUT PROD LINE & MODEL TO PMMST2 00030FBITTAB IP F 33 DISK 00040FPMMST2 UC F 674R12AI 1 DISK 00050FTERM40 O F 40 5 00060E A12 1 12 1 A 00070E BIT 33 1 00080IBITTAB BT 00090I 1 33 BIT 00100IPMMST2 PM 00110I 1 100PMPN 00120I 15 180PMPL 00130I 19 30 PMMODL 00140I 674 674 PMSTAT 00150C MOVELBIT,1 BUFLGT 2 00160C MOVE ' ' BLK12 12 00170C START TAG 00180C SETON 82 00190C EXCPT 00200C SETOF 82 00210C EXITFQCLFCR 00220C MOVE BLK12 W12A 12 00230C MOVE BIT,7 BUFLGT 00240C EXITFQWREED 00250C RLABL W12A ÐÐ00260C RLABL BUFLGT 00270C Z-ADD12 W2N 20 00280C EXIT SUBRAJ 00290C RLABL W2N 00300C RLABL W12A 00310C MOVE W12A PN 100 00320C MOVELPN W12A 00330C MOVE ' ' W12A 00340C W12A CHAINPMMST2 60 00350C N60 GOTO TAG10 00360C SETON 80 00370C EXCPT 00380C SETOF 80 00390C GOTO START 00400C*---------------------------------------------------------------- 00410C TAG10 TAG 00420C EXITFQMOVUP 00430C SETON 85 00440C EXCPT 00450C SETOF 85 00460C SETON 83 00470C EXCPT 00480C SETOF 83 00490C EXITFQCLFCR 00500C MOVE BLK12 W12A ÐÐ00510C EXITFQWREED 00520C RLABL W12A 00530C RLABL BUFLGT 00540C EXSR SR102 00550C N77 GOTO TAG20 00560C EXIT SUBRAJ 00570C RLABL W2N 00580C RLABL W12A 00590C MOVE W12A PMPL 00600C*--------------------------------------------------------------- 00610C TAG20 TAG 00620C SETON 84 00630C EXCPT 00640C SETOF 84 00650C EXITFQCLFCR 00660C MOVE BLK12 W12A 00670C EXITFQWREED 00680C RLABL W12A 00690C RLABL BUFLGT 00700C EXSR SR102 00710C 77 MOVE W12A PMMODL 00720C SETON 81 00730C EXCPT 00740C SETOF 81 00750C GOTO START ÐÐ00760C END TAG 00770C***************************************************************** 00780CSR SR102 BEGSR 00790CSR MOVEAW12A A12 00800CSR ' ' LOKUPA12 77 00810CSR ENDSR 00820O********************************************************************* 00830OPMMST2 E 81 00840O PMPL 18 00850O PMMODL 30 00860OTERM40 E 80 00870O 24 'PART MASTER NOT ON FILE ' 00880O E 82 00890O 24 'ENTER PART # ' 00900O E 84 00910O 24 'ENTER MODEL ' 00920O PMMODL 40 00930O E 83 00940O 24 'ENTER PROD CLASS ' 00950O PMPL Z 32 00960O E 85 00970O PMPN 40 ' - - ' ** A12 ARRAY 000980 000990/* 001000ÐÐ_‚_‚0C END TAG 00770C***************************************************************** 00780CSR SR102 BEGSR 00790CSR MOVEAW12A A12 00800CSR ' ' LOKUPA12 77 00810CSR ENDSR 00820O********************************************************************* 00830OPMMST2 E 81 00840O PMPL 18 00850O PMMODL 30 00860OTERM40 E 80 00870O 24 'PART MASTER NOT ON FILE ' 00880O E 82 00890O 24 'ENTER PART # ' 00900O E 84 00910O 24 'ENTER MODEL ' 00920O PMMODL 40 00930O E 83 00940O 24 'ENTER PROD CLASS ' 00950O PMPL Z 32 00960O E 85 00970O PMPN 40 ' - - ' ** A12 ARRAY 000980 000990/* 001000ÐÈ(„Cê „wX112SF P120282120282(èÈÐ00010H Q112SF00020F* RECD PO TO STOCK/RTV/SCRAP. (X112SF) *** D A T A G R A P H I X *** 00030F* REVISED 7-24-81 10:45 AM. 00040F* MENU: MQNS01 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FSFMAST UC F 128R29AI 1 DISK 00090FPMMST2 UC F 674R12AI 1 DISK 00100FPOITEM UC F 384R 9AI 1 DISK 00110FVMMAST IC F 384R 5AI 1 DISK 00120FMATLDISTO F 80 DISK A 00130FTERM132 O F 132 5 00140F**************************************************************** 00150E NUL 1 132 1 NULL CHAR 00160E A16 16 16 1 A INPUT DATA ARRAY 00170E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00180E LOC 1 5 3 00190E DUN 1 5 1 A EDIT CMPLT FLAG 00200E MES 1 1 30 00210E A29 29 29 1 00220E A9 9 9 1 00230E PA$ 7 9 3 ACCTG STD COSTS 00240E BIT 33 1 SCREEN CONTR. CHAR 00250I******************************************************************* ÐÐ00260IBITTAB BT 00270I 1 33 BIT 00280I******************************************************************* 00290IMGFILE MG 00300I* MESSAGE FILE. 00310I 1 35 MGTEXT 00320I****************************************************************** 00330ICRTFILE CR 00340I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00350I* STD AREA - SAME FOR ALL PROGRAMS. 00360I* EMPLOYEE # 5N 00370I 1 50CREMPL 00380I* USER CODE 8A 00390I 6 13 CRUSER 00400I* DEPT # 5N 00410I 14 180CRDEPT 00420I* JOB NAME 8A (JOB LOADED BY MENU) 00430I 19 26 CRJOB 00440I* SHUTDOWN FLAG 1A 00450I* BLANK = NO SHUTDOWN 00460I 27 27 CRSHUT 00470I* TIME STARTED 6N 00480I 28 330CRTIME 00490I* DATE STARTED 4N 00500I 34 370CRDATE ÐÐ00510I* CALL STACK 5 X 6A 00520I*** 38 67 CALL 00530I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00540I 68 73 CRRET 00550I* MENU NAME 6A 00560I 74 79 CRMENU 00570I******************************************************************** 0071200580IVMMAST VM 0071300590I 26 60 VMNAME 0071400600I******************************************************************** 00610ISFMAST SF 00620I* SCHEDULE MASTER. 00630I* COMMON FIELDS. 00640I* KEY AREA. 00650I 1 29 SFKEY 00660I* PART NO. 10N 00670I 1 100SFPN 00680I* DATE DUE 6N (YMD) 00690I 11 160SFDUE 00700I* RECORD CODE 2N 00710I* 10 = RECEIVED PO 00720I* 20 = REL WO 00730I* 30 = PURCHASE ORDER 00740I* 40 = PLAN WO 00750I* 50 = PURCHASE REQ ÐÐ00760I* 60 = SALES ORDER-BACKLOG 00770I* 70 = REL REQUIREMENT 00780I* 80 = PLAN REQUIREMENT 00790I* 90 = RUN RELEASE 00800I 17 180SFREC 00810I* ORDER NO. 00820I 19 29 SFORD 00830I* PREFIX 1A 00840I 19 19 SFPRFX 00850I* PRIME 5N 00860I 19 24 SFPRIM 00870I* DASH 3N 00880I 25 270SFDASH 00890I* RECEIVING LOG 2N 00900I 28 290SFRLOG 00910I* QUANTITY 7P 00920I P 30 330SFQTY 00930I* QTY COMPLETE 7P 00940I P 34 370SFQTYC 00950I* DATE LAST TRAN 6N (YMD) 00960I 38 430SFDLT 00970I* CUST #/DEPT #/VEND # 5P 00980I P 44 460SFCUST 00990I* VARIABLE AREA. 01000I* PLAN/REL REQMTS ÐÐ01010I* NEXT ASSY PART # 10N 01020I 47 560SFNAPN 01030I* QTY PER ASSY 7P 01040I P 57 600SFQPA 01050I* ISSUE CODE 2A 01060I 61 62 SFISSU 01070I* PULL # 3P 01080I P 63 640SFPULL 01090I* ASSY REVISION 2A 01100I 65 66 SFREV 01110I* ASSY WO QTY 7P 01120I 67 700SFQTYA 01130I* SALES ORDERS 01140I* CUST P.O. 20A 01150I 71 90 SFCPO 01160I* UNIT PRICE 9.3P 01170I P 91 953SFPRIC 01180I* PURCH ORDERS 01190I* VENDOR NAME 20A 01200I* SEE SFCPO UNDER SALES ORDERS. 01210I* UNIT PRICE 9.3P 01220I* SEE SFPRIC UNDER SALES ORDERS. 01230I* WORK ORDERS 01240I* DEPT NAME 20A 01250I* SEE SFCPO UNDER SALES ORDERS. ÐÐ01260I* OPER SEQ # 3P 01270I P 96 970SFSEQ 01280I* START DATE 6N 01290I 98 1030SFSTRT 01300I* PULL # 3P 01310I* SEE PLAN/REL REQMTS. 01320I* REQUIREMENT FLAG 1A 01330I 104 104 SFRFLG 01340I* REVISION 2A 01350I* SEE PLAN/REL REQMTS. 01360I* RECORD STATUS 1A 01370I 128 128 SFSTAT 01380I******************************************************************** 01390IPMMST2 PM 01400I 1 100PMPN 01410I 15 180PMPL 01420I 19 30 PMMODL 01430I 31 59 PMDESC 01440I 70 71 PMECHG 01450I 94 95 PMSC 01460I P 185 219 PA$ 01470I P 311 3140PMOHB 01480I P 347 3500PMRPOB 01490I P 367 3700PMPRCT 01500I P 401 4030PMFRCT ÐÐ01510I P 489 4933PMOSUC 01520I 674 674 PMSTAT 01530I*********************************************************************0072701540IPOITEM PI 01550I* PURCHASE ORDER ITEM RECORD. 01560I* DYNAIR PART # 10N 01570I 10 19 PIPN 01580I* QTY RECEIVED 7P 01590I P 86 890PIQRCD 01600I* QTY TO STK,RTV,SCRAP 7P 01610I P 90 930PIQSTK 01620I* RECORD STATUS 1A 01630I 384 384 PISTAT 01640C******************************************************************** 0073601650C* INITIALIZE 01660C EXSR SR101 1-TIME INIT 01670C*------------------------------------------------------------------ 01680C START TAG 01690C* SET-UP 1ST FIELD NO. 01700C MOVE ' ' DUN INIT EDIT ARRAY 01710C Z-ADD1 F 30 FIELD # 01720C MOVE ' ' TRAN 01730C MOVE BLK10 TRNNAM 01740C MOVE BLK10 TPRIM 01750C Z-ADD0 TDASH ÐÐ01760C Z-ADD0 TLOG 01770C Z-ADD0 TQTY 01780C Z-ADD0 SFPN 01790C MOVE BLK35 PMDESC 01800C Z-ADD0 SFQTY 01810C Z-ADD0 QTYBAL 01820C Z-ADD0 SFCUST 01830C MOVE BLK35 VMNAME 01840C MOVE BLK35 SFCPO 01850C GOTO READ 01860C*------------------------------------------------------------------ 01870C NEXT TAG 01880C* SET-UP NEXT FIELD NO. 01890C 1 ADD F F FIELD # 01900C*----------------------------------------------------------------- 01910C READ TAG 01920C* READ DATA FROM TERMINAL. 01930C SETOF 909677 01940C EXSR SR102 VALIDATE FIELD # 01950C 55 GOTO UPDATE DONE 01960C EXSR SR201 IDENTIFY-F 01970C SETON 69 01980C EXSR SR72 PROMPT 01990C SETOF 69 02000C EXSR SR75 READ TERMINAL ÐÐ02010C 98 GOTO GOODBY GOODBY 02020C 94 GOTO MENU MENU REQUEST 02030C N77N88 EXSR SR104 EDIT INPUT FIELD 02040C 96 ERROR 02050CORN77N88 EXSR SR72 REWRITE INPUT DATA 02060C 93 GOTO NEWITM NEW ITEM 02070C 92 GOTO JUMP FIELD JUMP REQST 02080C 89 F SUB 1 F SKIP BACKWARD 02090C 89 GOTO READ " " 02100C 88 SETOF 90 SPACE FILL 02110C 88 SETON 77 " " 02120C 86 GOTO UPDATE UPDATE 02130C 96 GOTO ERROR ERROR 02140C N77 GOTO EDIT NO DATA INPUT 02150C*------------------------------------------------------------------ 02160C PROCES TAG 02170C* PROCESS INPUT DATA 02180C EXSR SR103 MOVE DATA 02190C*------------------------------------------------------------------- 02200C EDIT TAG 02210C N96 EXSR SR104 EDIT DATA 02220C EXSR SR72 REWRITE DATA 02230C 96 GOTO ERROR ERROR 02240C GOTO NEXT 02250C*------------------------------------------------------------------ ÐÐ02260C UPDATE TAG 02270C* UPDATE DATA BASE. 02280C EXSR SR105 FINAL EDIT 02290C 96 GOTO ERROR ERROR 02300C EXSR SR106 UPDATE 02310C 96 GOTO ERROR ERROR 02320C EXSR SR68 ROLL SCREEN UP 02330C COUNT COMP 30 54 54 02340C 54 EXSR SR71 PUT HEADING 02350C GOTO START 02360C*------------------------------------------------------------------- 02370C JUMP TAG 02380C* SET-UP JUMP TO REQUESTED FIELD 02390C 1 ADD W W 30 02400C W COMP 16 54 02410C 54 Z-ADD318 M 50 96 FLAG ERROR 02420C 54 GOTO ERROR BAD ESC 02430C MOVE ' ' W3A 3 02440C MOVEAA16,W W3A 02450C Z-ADD3 W2N 20 02460C EXIT SUBRAJ R. JUSTIFY 02470C RLABL W2N 02480C RLABL W3A 02490C MOVE W3A F NEW FIELD # 02500C GOTO READ ÐÐ02510C*-------------------------------------------------------------------- 02520C ERROR TAG 02530C EXSR SR102 VALIDATE FIELD # 02540C EXSR SR89 GET MSG 02550C EXSR SR73 PUT MSG 02560C GOTO READ 02570C*------------------------------------------------------------------ 02580C NEWITM TAG 02590C* SET-UP LINK FOR NEW ITEM 02600C MOVEL'Q112SF' PROG 8 02610C GOTO END 02620C*------------------------------------------------------------------- 02630C MENU TAG 02640C* SET-UP LINK TO MENU 02650C MOVELCRRET PROG 02660C GOTO END 02670C*-------------------------------------------------------------------- 02680C GOODBY TAG 02690C* LINK TO SIGN-OFF 02700C MOVEL'GOODBY' PROG 02710C GOTO END 02720C*------------------------------------------------------------------- 02730C END TAG 02740C EXITFCHAIN LINK TO NEXT PROG 02750C RLABL PROG ÐÐ02760C******************************************************************** 02770CSR SR1 BEGSR 02780C* EDIT TRAN CODE. 02790CSR EXSR SR203 CLASSIFY TRAN 02800CSRN60N61N62 Z-ADD300 M 96 FLAG ERROR 02810CSR 60 MOVE 'STOCK ' TRNNAM 6 02820CSR 61 MOVE 'RTV ' TRNNAM 02830CSR 62 MOVE 'SCRAP ' TRNNAM 02840CSR ENDSR 02850C******************************************************************** 02860CSR SR2 BEGSR 02870C* EDIT PRIME. 02880CSR MOVE TPRIM W5A 5 02890CSR Z-ADD5 W2N 20 02900CSR EXIT SUBRAJ RJ 02910CSR RLABL W2N 02920CSR RLABL W5A 02930CSR MOVE W5A TPRIM 02940CSR MOVE W5A W5N 50 02950CSR W5N COMP 0 54 02960CSRN54 Z-ADD341 M 96 FLAG ERROR 02970CSR ENDSR 02980C******************************************************************** 02990CSR SR3 BEGSR 03000C* EDIT DASH. ÐÐ03010CSR TDASH COMP 0 54 03020CSRN54 Z-ADD341 M 96 FLAG ERROR 03030CSR ENDSR 03040C******************************************************************** 03050CSR SR4 BEGSR 03060C* EDIT LOG #. 03070CSR MOVE BLK35 VMNAME 03080CSR TLOG COMP 0 54 03090CSRN54 Z-ADD341 M 96 03100CSRN54 GOTO END4 03110CSR MOVELTPRIM W9A 9 03120CSR MOVE TDASH W9A 03130CSR MOVELW9A TORD 11 03140CSR MOVE TLOG TORD 03150CSR EXSR SR81 GET ALTKEY 03160CSR 60 Z-ADD5 M 96 FLAG ERROR 03170CSR 60 GOTO END4 03180CSR EXSR SR80 GET SFMAST 03190CSR 60 Z-ADD5 M 96 FLAG ERROR 03200CSRN60 EXSR SR83 GET VEND MAST 03210CSR END4 ENDSR 03220C******************************************************************** 03230CSR SR5 BEGSR 03240C* EDIT QTY TO STOCK. 03250CSR TQTY COMP 0 54 ÐÐ03260CSRN54 Z-ADD184 M 96 FLAG ERROR 03270CSRN54 GOTO END5 03280CSR TQTY ADD SFQTYC W7N 70 03290CSR W7N COMP SFQTY 54 03300CSR 54 Z-ADD607 M 03310CSR 54 EXSR SR74 OVERSHIP WARNING 03320CSR END5 ENDSR 03330C******************************************************************** 03340CSR SR66 BEGSR 03350CSR EXITFQMOVUP BUMP UP 03360CSR ENDSR 03370C******************************************************************** 03380CSR SR67 BEGSR 03390CSR EXITFQCLF LINE FEED 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR68 BEGSR 03430C* ROLL SCREEN-UP. 03440CSR MOVE '120001' W6A 03450CSR EXSR SR69 MOVE CURSOR 03460CSR EXSR SR67 LF 03470CSR EXSR SR66 BUMP CURSOR-UP 03480CSR 1 ADD COUNT COUNT 30 03490CSR ENDSR 03500C******************************************************************** ÐÐ03510CSR SR69 BEGSR 03520CSR EXITFQXYPOS MOVE CURSOR 03530CSR RLABL W6A 03540CSR ENDSR 03550C********************************************************************** 03560CSR SR71 BEGSR 03570C* PUT HEADINGS TO TERMINAL 03580CSR MOVE '120001' W6A 6 03590CSR EXSR SR69 MOVE CURSOR 03600CSR Z-ADD6 COUNT 03610CSR SETON 71 03620CSR EXCPT PUT HEADINGS 03630CSR SETOF 71 03640CSR EXSR SR66 BUMP CURSOR UP 03650CSR ENDSR 03660C********************************************************************* 03670CSR SR72 BEGSR 03680C* PUT DATA TO TERMINAL 03690CSR SFCPO COMP BLK20 56 03700CSRN56 MOVELVMNAME SFCPO 03710CSR MOVE '118001' W6A 03720CSR SFCPO COMP BLK20 56 03730CSR EXSR SR69 MOVE CURSOR 03740CSR TDASH COMP 0 55 03750CSR SETON 72 ÐÐ03760CSR EXCPT PUT DATA 03770CSR SETOF 72 03780CSR ENDSR 03790C*********************************************************************** 03800CSR SR73 BEGSR 03810C* PUT ERROR MESSAGE TO TERMINAL 03820CSR MOVE '119001' W6A 03830CSR EXSR SR69 POSITION CURSOR 03840CSR SETON 73 03850CSR EXCPT PUT MSG 03860CSR SETOF 73 03870CSR Z-ADDM LSTERR 50 03880CSR ENDSR 03890C*********************************************************************0071903900CSR SR74 BEGSR 0072003910C* PUT WARNING MESSAGE 0072103920CSR EXSR SR89 GET MESSAGE 0072203930CSR EXSR SR73 PUT MESSAGE 0072303940CSR ENDSR 0072403950C******************************************************************* 03960CSR SR75 BEGSR 03970C* READ FROM TERMINAL 03980CSR SETOF 779096 03990CSR SETOF 939291 04000CSR SETOF 898887 ÐÐ04010CSR SETOF 8685 04020CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 04030CSR MOVE BLK16 W16A 16 BUFFER 04040CSR MOVE BIT,28 A9,1 04050CSR MOVEA'8119' A9,2 04060CSR MOVEALOC,F A9,6 04070CSR MOVE BIT,8 A9,9 04080CSR MOVEAA9 W9A 04090CSR EXITFQPREED READ FROM TERMINAL 04100CSR RLABL W9A 04110CSR RLABL W16A READ BUFFER 04120CSR RLABL BUFLGT READ BUFFER LGTH 04130CSR MOVEAW16A A16 INPUT DATA ARRAY 04140CSR MOVE BLK16 W16A INIT INPUT ARRAY 04150CSR Z-ADD1 W 30 04160CSR '\' LOKUPA16,W 90 FLAG ESC 04170CSRN90 GOTO T75B NOT ESC 04180CSR 1 ADD W W 04190CSR W COMP 16 54 04200CSR 54 GOTO T75A BAD ESC 04210CSR A16,W COMP 'G' 98 GOODBY 04220CSR A16,W COMP 'E' 94 MENU 04230CSR A16,W COMP 'N' 93 NEW ITEM 04240CSR A16,W COMP 'J' 92 JUMP 04250CSR A16,W COMP 'B' 89 SKIP BKWRD ÐÐ04260CSR A16,W COMP 'S' 88 SPACE FILL 04270CSR A16,W COMP 'U' 86 UPDATE 04280CSR 98 04290COR 94 04300COR 93 04310COR 92 04320COR 89 04330COR 88 04340COR 86 GOTO END75 GOOD ESC 04350C*------------------------------------------------------------------ 04360CSR T75A TAG 04370C* FLAG BAD ESC INPUT 04380CSR Z-ADD318 M 96 FLAG ERROR 04390CSR GOTO END75 04400C*-------------------------------------------------------------------- 04410CSR T75B TAG 04420C* MOVE DATA 04430CSR Z-ADD1 W 04440CSR ' ' LOKUPA16,W 77 04450CSR 77 MOVEAA16,W W16A INPUT DATA 04460C*-------------------------------------------------------------------- 04470CSR END75 TAG 04480C* INIT PREV ERROR MSG. 04490CSR LSTERR COMP 0 54 04500CSR 54 MOVE BLK35 MGTEXT ÐÐ04510CSR 54 EXSR SR73 BLANK MESSAGE 04520CSR Z-ADD0 LSTERR 50 04530CSR ENDSR 04540C********************************************************************** 04550CSR SR80 BEGSR 04560C* GET MASTER RECORD 04570CSR MOVEAPIPN A29 04580CSR MOVEA'000000' A29,11 04590CSR MOVEA'10' A29,17 04600CSR MOVEATORD A29,19 04610CSR MOVEAA29 W29A 29 04620CSR W29A CHAINSFMAST 60 GET MASTER 04630CSRN60 SFSTAT COMP 'D' 60 FLAG DELETE 04640CSR 60 GOTO END80 04650CSR SFQTY SUB SFQTYC QTYBAL 70 54 0072504660CSRN54 Z-ADD0 QTYBAL 0072604670CSR MOVELSFPN W12A 12 04680CSR MOVE ' ' W12A 04690CSR W12A CHAINPMMST2 60 04700CSR 60 Z-ADD291 M 96 FLAG ERROR 04710CSR END80 ENDSR 04720C********************************************************************** 04730CSR SR81 BEGSR 04740C* GET PO ITEM MASTER. 04750CSR TORD CHAINPOITEM 60 GET POITEM ÐÐ04760CSRN60 PISTAT COMP 'D' 60 04770CSR ENDSR 04780C*********************************************************************** 04790CSR SR82 BEGSR 04800C* REWRITE MASTER 04810CSR Z-ADDPA$,1 LAB$ 93 04820CSR Z-ADDPA$,2 LABBUR 93 04830CSR Z-ADDPA$,3 MAT$ 93 04840CSR Z-ADDPA$,4 MATBUR 93 04850CSR SETON 82 04860CSR EXCPT REWRITE MASTER 04870CSR SETOF 82 04880CSR ENDSR 04890C******************************************************************** 04900CSR SR83 BEGSR 04910C* GET VENDOR MAST. 04920CSR SFCUST CHAINVMMAST 60 04930CSR 60 MOVELBLK35 VMNAME 04940CSR ENDSR 04950C********************************************************************** 04960CSR SR89 BEGSR 04970C* GET MESSAGE MASTER 04980CSR M CHAINMGFILE 54 04990CSR 54 MOVE BLK35 MGTEXT 05000CSR 54 MOVELM MGTEXT ÐÐ05010CSR 54 MOVE MES,1 MGTEXT 05020CSR ENDSR 05030C*********************************************************************** 05040CSR SR101 BEGSR 05050C* 1-TIME INITIALIZE 05060CSR MOVE BIT,1 NUL 05070CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 05080CSR Z-ADD5 FLIMIT 30 TOTAL NUMB FIELDS 05090CSR MOVE ' ' BLK16 16 05100C* GET PORT # AND CRTFILE 05110CSR MOVE ' ' W8A 8 05120CSR Z-ADD0 W2N 20 05130CSR Z-ADD0 W1N 10 05140CSR MOVE ' ' W2A 2 05150CSR EXITFPGMINX GET PORT # 05160CSR RLABL W8A 05170CSR RLABL W2N 05180CSR RLABL W1N 05190CSR RLABL W2A 05200CSR MOVE W2A PORT 20 PORT NO. 05210CSR PORT COMP 0 54 05220CSRN54 Z-ADD25 PORT DEFAULT 05230CSR PORT CHAINCRTFILE H9 05240CSR EXSR SR71 PUT HEADING 05250C* DEFINE WORK FIELDS,ETC. ÐÐ05260CSR MOVELUDATE W4N 40 05270CSR MOVE UDATE W2N 20 05280CSR MOVELW2N TODAY 60 05290CSR MOVE W4N TODAY 05300CSR MOVE ' ' BLK35 35 05310CSR MOVE ' ' BLK10 10 05320CSR MOVE ' ' BLK20 20 05330CSR ENDSR 05340C********************************************************************** 05350CSR SR102 BEGSR 05360C* VALIDATE FIELD NO. 05370CSR F COMP 0 54 05380CSRN54 Z-ADD1 F 05390CSR F COMP FLIMIT 55 05400CSR 55 Z-ADD1 F 05410CSR ENDSR 05420C******************************************************************** 05430CSR SR103 BEGSR 05440C* MOVE INPUT DATA 05450CSR EXSR SR201 IDENTIFY-F 05460CSR EXSR SR202 R. JUSTIFY 05470CSR 01 MOVELW16A TRAN 1 TRAN CODE 05480CSR 02 MOVELW16A TPRIM 6 ORDER PRIME 05490CSR 03 MOVE W10A TDASH 30 ORDER DASH 05500CSR 04 MOVE W10A TLOG 20 RECEIVING LOG # ÐÐ05510CSR 05 MOVE W10A TQTY 70 QTY 05520CSR MOVE ' ' DUN,F EDIT FLAG 05530CSR ENDSR 05540C******************************************************************** 05550CSR SR104 BEGSR 05560C* EDIT INPUT DATA 05570CSR 01 EXSR SR1 05580CSR 02 EXSR SR2 05590CSR 03 EXSR SR3 05600CSR 04 EXSR SR4 05610CSR 05 EXSR SR5 05620CSR 96 MOVE ' ' DUN,F EDIT FLAG 05630CSRN96 MOVE 'X' DUN,F 05640CSR ENDSR 05650C*********************************************************************** 05660CSR SR105 BEGSR 05670C* FINAL EDIT 05680CSR SETOF 77 05690CSR SETON 79 FINAL EDIT FLAG 05700CSR Z-ADD1 F 96 05710C*-------------------------------------------------------------------- 05720CSR T105A TAG 05730CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 05740CSRN54 GOTO END105 05750CSR EXSR SR201 IDENTIFY-F ÐÐ05760CSR EXSR SR104 EDIT 05770CSRN96 GOTO T105A 05780C*-------------------------------------------------------------------- 05790CSR END105 TAG 05800CSR SETOF 79 05810CSR ENDSR 05820C******************************************************************** 05830CSR SR106 BEGSR 05840C* UPDATE SFMAST, PMMST2, POITEM 05850CSR SFQTY SUB SFQTYC QTYBAL 70 05860CSR TQTY COMP QTYBAL 54 05870CSR 54 Z-ADDTQTY W7N 05880CSRN54 Z-ADDQTYBAL W7N 05890CSR PMRPOB SUB W7N PMRPOB RPO BAL 05900CSR TQTY ADD PMPRCT PMPRCT PLAN RCPT QTY 05910CSR 1 ADD PMFRCT PMFRCT PLAN RCPT FREQ 05920CSR TQTY ADD SFQTYC SFQTYC 05930CSR EXSR SR203 CLASSIFY TRAN 05940CSR 60 TQTY ADD PMOHB PMOHB 05950CSR TQTY ADD PIQSTK PIQSTK 05960CSR EXSR SR82 UPDATE RECD PO SFMAST05970CSR ENDSR 05980C************************************************************************ 05990CSR SR201 BEGSR 06000C* IDENTIFY FIELD NO. ÐÐ06010CSR F COMP 1 01 06020CSR F COMP 2 02 06030CSR F COMP 3 03 06040CSR F COMP 4 04 06050CSR F COMP 5 05 06060CSR ENDSR 06070C********************************************************************** 06080CSR SR202 BEGSR 06090C* RIGHT JUSTIFY 06100CSR F LOKUPNUM 54 06110CSRN54 GOTO END202 NOT NUMERIC FIELD 06120CSR Z-ADD10 W2N 20 06130CSR MOVELW16A W10A 10 06140CSR EXIT SUBRAJ R. JUSTIFY 06150CSR RLABL W2N 06160CSR RLABL W10A 06170CSR END202 ENDSR 06180C*********************************************************************** 06190CSR SR203 BEGSR 06200C* CLASSIFY TRAN CODE 06210CSR TRAN COMP '1' 60 STOCK 06220CSR TRAN COMP '2' 61 RTV 06230CSR TRAN COMP '3' 62 SCRAP 06240CSR ENDSR 06250O******************************************************************** ÐÐ06260OTERM132 E 71 06270O 1 ' ' 06280O*------------------------------------------------------------------- 06290O E 71 06300O 66 'RECEIVED PURCHASE' 06310O 83 'ORDER PROCESSING' 06320O UDATE Y 8 06330O*------------------------------------------------------------------- 06340O E 71 06350O 1 ' ' 06360O*------------------------------------------------------------------- 06370O E 71 06380O 4 'TRAN' 06390O 39 'THIS' 06400O 98 'QUANTITY' 06410O*------------------------------------------------------------------- 06420O E 71 06430O 4 'CODE' 06440O 18 'ORDER' 06450O 24 'ITEM' 06460O 30 'LOG #' 06470O 41 'QUANTITY' 06480O 53 'PART NO.' 06490O 69 'DESCRIPTION' 06500O 96 'OPEN' ÐÐ06510O 114 'VENDOR' 06520O*------------------------------------------------------------------- 06530O E 71 06540O 3 '(1)' 06550O 17 '(2)' 06560O 22 '(3)' 06570O 30 '(4)' 06580O 39 '(5)' 06590O*------------------------------------------------------------------- 06600O E 71 06610O 1 ' ' 06620O*------------------------------------------------------------------- 06630O E 71 06640O 1 ' ' 06650O*------------------------------------------------------------------- 06660O E 71 06670O 1 ' ' 06680O*------------------------------------------------------------------- 06690O E 72 06700O TRAN 2 06710O TRNNAM 10 06720O TPRIM 19 06730O 55 TDASH 23 06740O 55 20 '-' 06750O TLOG Z 30 ÐÐ06760O TQTY 2 41 06770O SFPN 56 ' - - ' 06780O PMDESC 88 06790O QTYBAL2 97 06800O N56 SFCUSTZ 115 06810O 56 SFCPO 132 06820O*------------------------------------------------------------------- 06830O E 73 06840O MGTEXT 35 06850O BIT,28 130 06860O 131 'K' 06870O BIT,8 132 06880O******************************************************************** 06890OSFMAST E 82 06900O SFPN 10 06910O SFDUE 16 06920O SFREC 18 06930O SFORD 29 06940O SFQTY 33P 06950O SFQTYC 37P 06960O SFDLT 43 06970O SFCUST 46P 06980O SFNAPN 56 06990O SFQPA 60P 07000O SFISSU 62 ÐÐ07010O SFPULL 64P 07020O SFREV 66 07030O SFQTYA 70 07040O SFCPO 90 07050O SFPRIC 95P 07060O SFSEQ 97P 07070O SFSTRT 103 07080O SFRFLG 104 07090O SFSTAT 128 07100O******************************************************************** 07110OPOITEM E 82 07120O PIQRCD 88P 07130O PIQSTK 93P 07140O******************************************************************* 07150OPMMST2 E 82 07160O PA$ 219P 07170O PMOHB 314P 07180O PMRPOB 350P 07190O PMPRCT 370P 07200O PMFRCT 403P 07210O PMOSUC 493P 07220O******************************************************************** 07230OMATLDISTEADD 82 07240O SFPN 10 07250O 11 '7' ÐÐ07260O TORD 20 07270O TQTY 26P 07280O PMOSUC 35P 07290O TODAY 42 07300O CREMPL 45P 07310O LAB$ 50P 07320O LABBUR 55P 07330O MAT$ 60P 07340O MATBUR 65P 07350O 80 'A' ** NUL ARRAY 007360 007370** A16 ARRAY 007380 007390** NUM ARRAY 007400003 DASH 007410004 LOG 07420005 QTY 07430** LOC ARRAY 07440003 TRAN 07450015 PRIME 07460021 DASH 07470030 LOG 07480034 QTY 07490** DUN ARRAY 007500ÐÐ 007510** MES ARRAY 007520---MESSAGE NOT ON FILE--- 007530** A29 ARRAY 07540 07550** A9 ARRAY 007560 07570/* 07580_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Eb  X113PM P120282120282(èÈÐ00010H Q113PM00020F* LEFT-JUSTIFY CHANGE LEVEL IN PMMST2. (X113PM) 00030F* REVISED 7-15-81 10:10 AM. 00040FPMMST2 UP F 674 12AI 1 DISK 00050I******************************************************************** 00060IPMMST2 PM 01 00070I 70 70 PM1 70 00080I 71 71 PM2 71 00090C******************************************************************** 00100C N71 70 MOVE PM2 PM1 00110C N71 70 MOVE ' ' PM2 00120O******************************************************************** 00130OPMMST2 D 01N71 70 00140O PM1 70 00150O PM2 71 /* 00160_‚ _‚_‚ ÐÈ(ÈEl ÈTX114PM P120282120282(èÈÐ00010H Q114PM00020F* PLACE TO BE DELETED FLAG IN PART MAST. (X114PM) 00030F* REVISED 7-16-81 9:30 AM. 00040FBITTAB IP F 33 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060FMGFILE IC F 80R DISK 00070FTERM50 O F 50 5 00080E******************************************************************** 00090E A16 16 16 1 A 00100E NUL 1 50 1 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160IPMMST2 PM 00170I 31 59 PMDESC 00180I 674 674 PMSTAT 00190I******************************************************************** 00200IMGFILE MG 00210I 1 35 MGTEXT 00220C******************************************************************** 00230C EXSR SR101 00240C*------------------------------------------------------------------- 00250C START TAG ÐÐ00260C MOVE '120001' W6A 6 00270C EXSR SR69 MOVE CURSOR 00280C Z-ADD298 M 50 00290C EXSR SR73 PUT MSG 00300C EXSR SR75 READ 00310C 90 GOTO END 00320C MOVELW16A W14A 14 00330C Z-ADD14 W2N 20 00340C EXIT SUBRAJ R.J. 00350C RLABL W2N 00360C RLABL W14A 00370C MOVE W14A W10N 100 00380C MOVELW10N W12A 12 00390C W12A CHAINPMMST2 60 GET PART MAST 00400C 60 Z-ADD291 M FLAG ERROR 00410C 60 EXSR SR73 PUT MSG 00420C 60 GOTO START 00430C SETON 72 00440C EXCPT OK TO DEL PRMPT 00450C SETOF 72 00460C EXSR SR75 00470C 93 GOTO START 00480C 90 GOTO END 00490C 77 MOVELW16A W2A 2 00500C W2A COMP ' ' 54 ÐÐ00510C 54 GOTO START 00520C SETON 80 00530C EXCPT PUT DEL FLAG 00540C SETOF 80 00550C GOTO START 00560C*------------------------------------------------------------------- 00570C END TAG 00580C MOVEL'CONTU' PROG 8 00590C EXITFCHAIN 00600C RLABL PROG 00610C******************************************************************** 00620CSR SR69 BEGSR 00630CSR EXITFQXYPOS MOVE CURSOR 00640CSR RLABL W6A 00650CSR ENDSR 00660C******************************************************************** 00670CSR SR73 BEGSR 00680CSR EXSR SR89 00690CSR MOVE '120001' W6A 6 00700CSR EXSR SR69 MOVE CURSOR 00710CSR SETON 73 00720CSR EXCPT PUT MSG 00730CSR SETOF 73 00740CSR ENDSR 00750C******************************************************************** ÐÐ00760CSR SR75 BEGSR 00770C* READ CRT. 00780CSR SETOF 7790 00790CSR MOVE BLK16 W16A 16 00800CSR MOVELBIT,1 BUFLGT 2 00810CSR MOVE BIT,9 BUFLGT 00820CSR EXITFQBELL RING BELL 00830CSR EXITFQWREED READ 00840CSR RLABL W16A 00850CSR RLABL BUFLGT 00860CSR MOVEAW16A A16 00870CSR MOVE BLK16 W16A 00880CSR Z-ADD1 W 30 00890CSR '\' LOKUPA16,W 90 00900CSRN90 GOTO T75B 00910CSR 1 ADD W W 00920CSR W COMP 16 54 00930CSR 54 Z-ADD16 W 00940CSR A16,W COMP 'G' 98 00950CSR A16,W COMP 'E' 94 00960CSR A16,W COMP 'N' 93 00970CSRN98N94N93 SETON 93 00980CSR GOTO END75 00990C*------------------------------------------------------------------- 01000CSR T75B TAG ÐÐ01010CSR Z-ADD1 W 01020CSR ' ' LOKUPA16,W 77 01030CSR 77 MOVEAA16,W W16A 01040CSR END75 ENDSR 01050C******************************************************************** 01060CSR SR89 BEGSR 01070C* GET MESSAGE MASTER. 01080CSR M CHAINMGFILE 54 01090CSR 54 MOVE BLK35 MGTEXT 01100CSR 54 MOVELM MGTEXT 01110CSR ENDSR 01120C******************************************************************** 01130CSR SR101 BEGSR 01140CSR MOVE ' ' BLK35 35 01150CSR MOVE ' ' BLK16 16 01160CSR ENDSR 01170O******************************************************************** 01180OPMMST2 E 80 01190O 620 '*' 01200O******************************************************************** 01210OTERM50 E 73 01220O NUL 50 01230O MGTEXT 35 01240O*------------------------------------------------------------------- 01250O E 72 ÐÐ01260O W10N 12 ' - - ' 01270O N60 PMDESC 45 ** A16 ARRAY 01280 01290** NUL ARRAY 01300 01310/* 01320_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( a  NX222SF Pš999999120282(èÈÐ00010H Q222SF00020F* PRINT SCHEDULE FILE (SFMAST) (ALL) (X222SF) **** S Y S T E M **** 00030F* REVISED 4/14/82 11:45 AM. 00040F* NOTE : MOST CHANGES MADE TO THIS PROGRAM SHOULD ALSO BE MADE TO X102SF.00050F* 00060FBITTAB IP F 33 DISK 00070FSFMAST IS F 128 29AI 1 DISK 00080FPMMST2 UC F 674R12AI 1 DISK 00090FPRINT O F 132 OF PRINTER 00100FMGFILE IC F 80R DISK 00110FCALENDARIC F 22R 7AI 1 DISK 00120FCMMAST IC F 576R 5AI 1 DISK 00130FVMMAST IC F 384R 5AI 1 DISK 00140FREMARKS ID F 90L29AI 1 DISK 00150FBOBAL O F 17 DISK 00160E******************************************************************** 00170E TABSC 1 6 2 TABSCN 15 00180E SWO 1 25 11 A 00190E HLD 1 1 20 00200E PM$ 7 9 3 MFG $ FILE 00210E PLT 8 3 0 LEAD TIMES 00220E BIT 33 1 00230I******************************************************************** 00240IBITTAB BT 00250I 1 33 BIT ÐÐ00260I******************************************************************** 00270ISFMAST SF 28 128NCD 00280I* SCHEDULE MASTER. 00290I* COMMON FIELDS. 00300I* KEY AREA. 00310I 1 29 SFKEY 00320I* PART NO. 10N 00330I 1 100SFPN L4 00340I* DATE DUE 6N (YMD) 00350I 11 160SFDUE L3 00360I* RECORD CODE 2N 00370I* 10 = RECEIVED PO 00380I* 20 = REL WO 00390I* 30 = PURCHASE ORDER 00400I* 40 = PLAN WO 00410I* 50 = PURCHASE REQ 00420I* 60 = SALES ORDER-BACKLOG 00430I* 70 = REL REQUIREMENT 00440I* 80 = PLAN REQUIREMENT 00450I* 90 = RUN RELEASE 00460I 17 180SFREC L2 00470I* ORDER NO. 00480I 19 29 SFORD L1 00490I* PREFIX 1A 00500I 19 19 SFPRFX ÐÐ00510I* PRIME 5N 00520I 19 24 SFPRIM 00530I* DASH 3N 00540I 25 270SFDASH 00550I* RECEIVING LOG 2N 00560I 28 290SFRLOG 00570I* QUANTITY 7P 00580I P 30 330SFQTY 00590I* QTY COMPLETE 7P 00600I P 34 370SFQTYC 00610I* DATE LAST TRAN 6N (YMD) 00620I 38 430SFDLT 00630I* CUST #/DEPT #/VEND # 5P 00640I P 44 460SFCUST 00650I* VARIABLE AREA. 00660I* PLAN/REL REQMTS 00670I* NEXT ASSY PART # 10N 00680I 47 560SFNAPN 00690I* QTY PER ASSY 7P 00700I P 57 600SFQPA 00710I* ISSUE CODE 2A 00720I 61 62 SFISSU 00730I* PULL # 3P 00740I P 63 640SFPULL 00750I* ASSY REVISION 2A ÐÐ00760I 65 66 SFREV 00770I* ASSY WO QTY 7P 00780I 67 700SFQTYA 00790I* SALES ORDERS 00800I* PRICE CODE 1A 00810I* SEE WORK ORDERS. 00820I* CUST P.O. 20A 00830I 71 90 SFCPO 00840I* UNIT PRICE 9.3P 00850I P 91 953SFPRIC 00860I* PURCH ORDERS 00870I* PRICE CODE 1A 00880I* SEE WORK ORDERS. 00890I* VENDOR NAME 20A 00900I* SEE SFCPO UNDER SALES ORDERS. 00910I* UNIT PRICE 9.3P 00920I* SEE SFPRIC UNDER SALES ORDERS. 00930I* PACKING SLIP 9A 00940I* 96 104 SFPKGS 00950I* WORK ORDERS 00960I* DEPT NAME 20A 00970I* SEE SFCPO UNDER SALES ORDERS. 00980I* OPER SEQ # 3P 00990I P 96 970SFSEQ 01000I* START DATE 6N ÐÐ01010I 98 1030SFSTRT 01020I* PULL # 3P 01030I* SEE PLAN/REL REQMTS. 01040I* PRICE CODE 1A 01050I 105 105 SFPCOD 01060I* BACKORDER FLAG 1A (B=BO) 01070I 106 106 SFBOF 01080I* REVISION 2A 01090I* SEE PLAN/REL REQMTS. 01100I* RECORD STATUS 1A 01110I 128 128 SFSTAT 01120I*------------------------------------------------------------------- 01130I GG 29 01140I* GARBAGE 01150I******************************************************************** 01160IVMMAST VM 01170I 318 337 VMHOLD 01180I 1 50VMVEND 01190I******************************************************************** 01200IPMMST2 PM 01210I 1 100PMPN 01220I 15 180PMPL 01230I 19 30 PMMODL 01240I 31 59 PMDESC 01250I 70 71 PMECHG ÐÐ01260I 94 95 PMSC 01270I P 113 128 PLT 01280I P 163 1660PMSSTK 01290I P 245 279 PM$ 01300I P 311 3140PMOHB 01310I P 315 3180PMFRCB 01320I P 319 3220PMALB 01330I P 323 3260PMRLB 01340I P 327 3300PMSOB 01350I P 335 3380PMBOB 01360I P 339 3420PMPRB 01370I P 343 3460PMPOB 01380I P 347 3500PMRPOB 01390I P 351 3540PMPWOB 01400I P 355 3580PMRWOB 01410I P 489 4933PMOSUC 01420I 674 674 PMSTAT 01430I******************************************************************** 01440IMGFILE MG 01450I 1 35 MGTEXT 01460I******************************************************************** 01470ICALENDARCA 20 1 CC 01480I* CALENDAR DATE RECORD. 01490I 2 30CAYR 01500I 4 50CAMO ÐÐ01510I 6 70CADAY 01520I 14 170CAMDAY 01530I 18 200CAWK 01540I 21 220CADOW 01550I*------------------------------------------------------------------- 01560I CB 21 1 CM 01570I* MFG DATE RECORD. 01580I 4 70CAMDAY 01590I 8 90CAYR 01600I 10 110CAMO 01610I 12 130CADAY 01620I 18 200CAWK 01630I 21 220CADOW 01640I*------------------------------------------------------------------- 01650I GG 22 01660I******************************************************************** 01670ICMMAST CM 01680I* CUSTOMER MASTER 01690I* CUST NAME 35A 01700I 26 60 CMNAME 01710I******************************************************************** 01720IREMARKS RK 01730I* COMMENT FILE 01740I 1 100RKPN 01750I 11 160RKDUE ÐÐ01760I 17 180RKREC 01770I 19 27 RKWO 01780I 28 290RKLINE 01790I 1 29 RKKEY 01800I 30 89 RKTEXT 01810I 90 90 RKSTAT 01820C******************************************************************** 01830C* INITIALIZE. 01840C N69 EXSR SR101 INIT 01850C N28 GOTO END DELETED 01860C L4 MOVE BLK11 SWO 01870C L4 Z-ADD0 AVAIL 70 OVERALL AVAIL BAL 01880C L4 SETOF 6849 ACTIVITY FLAG 01890C L4 SETOF 7779 01900C L4 Z-ADD0 SAVAIL 70 AVAIL STOCK BAL 01910C SFQTY SUB SFQTYC QTYBAL 70 28 01920C N28 GOTO END COMPLETED RECORD 01930C N68 EXSR SR102 DISPLAY PART MASTER 01940C SETON 79 01950C 30 SETOF 28 01960C 30 GOTO END NOT ON FILE 01970C EXSR SR103 CLASSIFY SFMAST 01980C 13 Z-ADDSFQPA QPA5 50 QTY PER ASSY (CRT) 01990C 06 SFCUST CHAINCMMAST 54 GET CUSTOMER MAST 02000C 06N54 MOVELCMNAME SFCPO CUST NAME ÐÐ02010C EXSR SR72 PUT DATA 02020C SETON 68 ACTIVITY FLAG 02030C*------------------------------------------------------------------- 02040C END TAG 02050C* PUT TOTALS. 02060CL4 68 AVAIL COMP 0 55 LESS THAN 02070CL4 68 SETOF 79 02080CL4 68 SETON 76 02090CL4 68 EXSR SR79 PRINT TOTALS 02100CL4 77 EXSR SR77 PUT OUT B/O BAL 02110CL4 49 SETON 82 02120CL4 49 EXCPT 02130CL4 SETOF 8249 02140C*------------------------------------------------------------------- 02150CLR ENDJOB TAG 02160C******************************************************************** 02170CSR SR72 BEGSR 02180C* PUT DATA LINE. 02190CSR 10 QTYBAL ADD ORDBAL ORDBAL 70 02200CSR 11 QTYBAL ADD REQBAL REQBAL 70 02210CSR 10 Z-ADDQTYBAL QTYORD 70 02220CSR 11 Z-ADDQTYBAL QTYREQ 70 02230CSR ORDBAL ADD STKQTY AVAIL 70 02240CSR AVAIL SUB REQBAL AVAIL 02250CSR SAVAIL SUB REQBAL SAVAIL ÐÐ02260CSR 01 QTYORD ADD PMRPOB PMRPOB 02270CSR 02 QTYORD ADD PMRWOB PMRWOB 02280CSR 03 QTYORD ADD PMPOB PMPOB 02290CSR 04 QTYORD ADD PMPWOB PMPWOB 02300CSR 05 QTYORD ADD PMPRB PMPRB 02310CSR 06 QTYREQ ADD PMSOB PMSOB 02320CSR 07 QTYREQ ADD PMRLB PMRLB 02330CSR 08 QTYREQ ADD PMALB PMALB 02340CSR 07 QTYREQ ADD PMBOB PMBOB 02350CSR 07 QTYREQ ADD BOQTY BOQTY 70 77 B/O 02360CSR EXSR SR204 DATES/$ 02370CSR SFDASH COMP 0 56 02380CSR SETON 72 02390CSR EXSR SR79 PUT DATA 02400CSR SETOF 55 02410CSR 03 SFCUST COMP VMVEND 54 02420CSR 03N54 SFCUST CHAINVMMAST 55 02430CSR 55 MOVE BLK29 VMHOLD 02440CSR VMHOLD COMP HLD,1 54 02450CSR 54 Z-ADD708 M 02460CSR 54 EXSR SR73 CREDIT HOLD 02470CSR EXSR SR206 PUT REMARKS 02480CSR EXSR SR104 COMPUTE EXCEPTIONS 02490CSR END72 ENDSR 02500C******************************************************************** ÐÐ02510CSR SR73 BEGSR 02520C* PUT MESSAGE. 02530CSR M CHAINMGFILE 54 02540CSR 54 MOVE BLK35 MGTEXT 02550CSR 54 MOVEL'??????' MGTEXT 02560CSR SETON 73 02570CSR EXSR SR79 PUT MSG 02580CSR SETOF 96 02590CSR ENDSR 02600C******************************************************************** 02610CSR SR74 BEGSR 02620C* PUT PART MAST LINE. 02630CSR SETON 74 02640CSR EXSR SR79 PUT PMMST2 TO CRT 02650CSR ENDSR 02660C******************************************************************** 02670CSR SR77 BEGSR 02680C* PUT OUT B/O BALANCE RECORD 02690CSR SETON 87 02700CSR EXCPT OUTPUT BOBAL 02710CSR SETOF 87 02720CSR ENDSR 02730C*********************************************************************** 02740CSR SR79 BEGSR 02750C* PRINT ROUTINE. ÐÐ02760CSR EXCPT UPDATE CRTFILE 02770CSR SETOF 414243 02780CSR SETOF 447471 02790CSR SETOF 474881 02800CSR SETOF 767273 02810CSR SETOF 89 02820CSR ENDSR 02830C******************************************************************** 02840CSR SR101 BEGSR 02850C* 1-TIME INITIALIZE. 02860CSR SETON 69 02870CSR TIME TIME 60 02880CSR MOVE ' ' BLK35 35 02890CSR MOVE ' ' BLK12 12 02900CSR Z-ADDUDATE W6N 60 02910CSR EXSR SR205 02920CSR Z-ADDCAMDAY TODAY 40 CUR MDAY DATE 02930CSR Z-ADDW6N CURCAL 60 CUR CAL DATE 02940CSR MOVE ' ' BLK29 29 02950CSR MOVE ' ' BLK11 11 02960CSR MOVE ' ' BLK9 9 02970CSR ENDSR 02980C******************************************************************** 02990CSR SR102 BEGSR 03000C* DISPLAY PART MASTER. ÐÐ03010CSR Z-ADD0 AVAIL 03020CSR Z-ADD0 ORDBAL 03030CSR Z-ADD0 REQBAL 03040CSR MOVE BLK12 SCNAME 15 03050CSR MOVELSFPN W12A 12 03060CSR MOVE ' ' W12A 03070CSR W12A CHAINPMMST2 30 03080CSR Z-ADD0 PMOHB ZERO ON HAND BAL 03090CSRN30 PMSTAT COMP 'D' 30 03100CSR Z-ADD0 PMPRB 03110CSR Z-ADD0 PMPOB 03120CSR Z-ADD0 PMRPOB 03130CSR Z-ADD0 PMPWOB 03140CSR Z-ADD0 PMRWOB 03150CSR Z-ADD0 PMALB 03160CSR Z-ADD0 PMRLB 03170CSR Z-ADD0 PMSOB 03180CSR Z-ADD0 PMBOB 03190CSR 30 GOTO END102 03200CSR SETON 49 03210CSR PMMODL COMP BLK12 54 03220CSR 54 MOVEL'MODEL' W18A 18 03230CSR 54 MOVE PMMODL W18A 03240CSR 54 MOVE BLK35 PMDESC 03250CSR 54 MOVELW18A PMDESC ÐÐ03260CSR PMSC LOKUPTABSC TABSCN 54 03270CSR 54 MOVE TABSCN SCNAME 03280CSR Z-ADDPMOHB STKQTY 70 54 03290CSRN54 Z-ADD0 STKQTY 03300CSR Z-ADDSTKQTY BOSTK 70 STK FOR BACKORDERS 03310CSR Z-ADDSTKQTY AVAIL OVERALL AVAIL BAL 03320CSR Z-ADDAVAIL SAVAIL 70 AVAIL STOCK BAL 03330CSR XFOOTPLT LEAD 30 03340CSR EXSR SR203 CALC COST 03350CSR EXSR SR74 PUT PART MASTER 03360CSR SETON 80 03370CSR EXSR SR206 PUT REMARKS 03380CSR SETOF 80 03390CSR PMSSTK COMP 0 54 03400CSRN54 GOTO T102Z 03410CSR Z-ADDPMSSTK REQBAL 03420CSR AVAIL SUB PMSSTK AVAIL 03430CSR Z-ADDAVAIL SAVAIL 03440CSR SETON 47 03450CSR EXSR SR79 PUT SAFETY STOCK 03460CSR GOTO T102Z 03470C*------------------------------------------------------------------- 03480CSR T102Z TAG 03490CSR PMOHB COMP 0 54 54 03500CSRN54 Z-ADD630 M 50 96 ÐÐ03510CSRN54 EXSR SR73 FLAG NEG ON HAND 03520CSR END102 ENDSR 03530C******************************************************************** 03540CSR SR103 BEGSR 03550C* CLASSIFY SFMAST RECORD. 03560CSR SETOF 101112 03570CSR SETOF 131415 03580CSR SETOF 161718 03590CSR SFREC COMP 10 01 RPO 03600CSR SFREC COMP 20 02 RWO 03610CSR SFREC COMP 30 03 PO 03620CSR SFREC COMP 40 04 PWO 03630CSR SFREC COMP 50 05 PURREQ 03640CSR SFREC COMP 60 06 SO 03650CSR SFREC COMP 70 07 RREQ 03660CSR SFREC COMP 80 08 PREQ 03670CSR SFREC COMP 90 09 FORECAST 03680CSR 01 03690COR 02 03700COR 03 03710COR 04 03720COR 05 SETON 10 ORDER 03730CSRN10 SETON 11 REQMT 03740C* FLAG PROD REQMTS. 03750CSR 07 REL REQ ÐÐ03760COR 08 SETON 13 PLN REQ 03770C* FLAG PUR ORD. 03780CSR 01 RPO 03790COR 03 PO 03800COR 05 SETON 12 PUR REQ 03810C* FLAG WO. 03820CSR 02 REL WO 03830COR 04 SETON 14 PLN WO 03840C* FLAG USES CPO FIELD. 03850CSR 02 REL WO 03860COR 12 PO'S 03870COR 06 SETON 15 SO'S 03880C* FLAG USES PRICE FIELD. 03890CSR 15N14 SETON 16 03900C* FLAG WORK ORDER OR WO/REQMT. 03910CSR 13 REQUIREMENT 03920COR 14 SETON 17 WORK ORDER 03930CSR 01 RPO 03940COR 06 SETON 18 USES LOG # 03950CSR ENDSR 03960C******************************************************************** 03970CSR SR104 BEGSR 03980C* PUT EXCEPTION MESSAGES. 03990CSR TODAY COMP MDUE 54 04000CSR 01 RECD PO ÐÐ04010COR 04 PLAN WO 04020COR 08 PLANNED REQMT 04030CORN54 GOTO T104A NOT PAST DUE 04040CSRN09 Z-ADD518 M 96 04050CSR 96 EXSR SR73 FLAG PAST DUE 04060CSR 09 Z-ADD520 M 96 04070CSR 09 EXSR SR73 FLAG NOT SOLD 04080C*------------------------------------------------------------------- 04090CSR T104A TAG 04100CSRN04N08 GOTO T104B NOT PLN WO 04110CSR 04 CURCAL COMP SFSTRT 54 04120CSR 08 CURCAL COMP SFDUE 54 04130CSRN54 GOTO T104B START DATE OK 04140CSR Z-ADD521 M 04150CSR EXSR SR73 FLAG NOT REL 04160C*------------------------------------------------------------------- 04170CSR T104B TAG 04180CSRN05 GOTO T104C NOT PUR REQ 04190CSR TODAY ADD LEAD W4N 40 04200CSR W4N COMP SFDUE 54 04210CSRN54 GOTO T104C LT OK 04220CSR Z-ADD522 M FLAG NOT ENOUGH 04230CSR EXSR SR73 LEAD TIME. 04240C*------------------------------------------------------------------- 04250CSR T104C TAG ÐÐ04260CSRN05 GOTO T104D NOT PUR REQ 04270CSR TODAY SUB SFDLT DIF 40 04280CSR DIF COMP 5 54 04290CSRN54 GOTO T104D 04300CSR 05 Z-ADD524 M FLAG NOT PLACED 04310CSR EXSR SR73 04320C*------------------------------------------------------------------- 04330CSR T104D TAG 04340CSRN06 GOTO END104 04350CSR SFQTYC COMP 0 54 04360CSR 54 MOVE 'B' SFBOF 04370CSRN54 SFBOF COMP 'B' 54 04380CSRN54 GOTO END104 04390CSR Z-ADD565 M FLAG BACKORDER 04400CSR EXSR SR73 04410CSR BOSTK COMP 0 54 04420CSR 54 Z-ADD519 M 96 04430CSR 54 EXSR SR73 FLAG NOT ISSUED 04440CSR BOSTK SUB QTYREQ BOSTK 04450CSR END104 ENDSR 04460C******************************************************************** 04470CSR SR202 BEGSR 04480C* R. ADJUST. 04490CSR Z-ADD12 W2N 20 04500CSR EXIT SUBRAJ R. ADJUST ÐÐ04510CSR RLABL W2N 04520CSR RLABL W12A 04530CSR ENDSR 04540C******************************************************************** 04550CSR SR203 BEGSR 04560C* CALC PART MAST COST, EXTEND BY ON HAND, IF ANY. 04570CSR XFOOTPM$ TOTCST 93 04580CSR PMOHB MULT TOTCST TOTCST 54 04590CSRN54 XFOOTPM$ TOTCST 04600CSR ENDSR 04610C******************************************************************** 04620CSR SR204 BEGSR 04630C* CONVERT CAL DATES TO MDAYS. 04640CSR Z-ADDSFDUE W6N 04650CSR EXSR SR205 04660CSR Z-ADDCAMDAY MDUE 40 DUE DATE 04670C* CALC LINE ITEM COST. 04680CSR ENDSR 04690C******************************************************************** 04700CSR SR205 BEGSR 04710C* GET MDAYS. 04720CSR MOVELW6N W2N 04730CSR W2N COMP 12 54 04740CSR 54 GOTO T205A 04750CSR MOVELW6N W4N ÐÐ04760CSR MOVE W6N W2N 04770CSR MOVELW2N W6N 04780CSR MOVE W4N W6N 04790C*------------------------------------------------------------------- 04800CSR T205A TAG 04810CSR MOVEL'C' W7A 7 04820CSR MOVE W6N W7A 04830CSR W7A CHAINCALENDAR 54 04840CSR ENDSR 04850C******************************************************************** 04860CSR SR206 BEGSR 04870C* PUT REMARKS 04880CSR MOVELSFORD W9A 9 04890CSR MOVELSFREC W11A 11 04900CSR MOVE W9A W11A 04910CSR W11A LOKUPSWO 54 04920CSR 54 GOTO END206 04930CSR MOVELSFPN W16A 16 04940CSR MOVE '000000' W16A 04950CSR MOVELSFREC W13A 13 04960CSR MOVE SFORD W13A 04970CSR MOVE '00' W13A 04980CSR MOVELW16A W29A 29 04990CSR MOVE W13A W29A 05000CSR W29A SETLLREMARKS ÐÐ05010CSR MOVE BLK35 LASTRK 29 05020C*------------------------------------------------------------------- 05030CSR T206C TAG 05040CSR SETOF 54 05050CSR READ REMARKS 54 05060CSR 54 GOTO END206 05070CSR RKKEY COMP LASTRK 54 05080CSRN54 GOTO END206 05090CSR MOVE RKKEY LASTRK 05100CSR RKPN COMP SFPN 54 05110CSRN54 GOTO END206 05120CSRN80 RKREC COMP SFREC 54 05130CSR 54N80 MOVELSFORD W9A 05140CSR 54N80 RKWO COMP W9A 54 05150CSR 80 RKREC COMP 0 54 05160CSR 80 54 RKWO COMP BLK9 54 05170CSRN54 GOTO END206 05180CSR RKSTAT COMP 'D' 54 05190CSR 54 GOTO T206C 05200CSR MOVELRKREC W11A 05210CSR MOVE RKWO W11A 05220CSR Z-ADD1 X 05230CSR W11A LOKUPSWO,X 54 05240CSR 54 GOTO T206E 05250CSR Z-ADD1 X 30 ÐÐ05260CSR BLK11 LOKUPSWO,X 54 05270CSR 54 MOVE W11A SWO,X 05280C*------------------------------------------------------------------- 05290CSR T206E TAG 05300CSR SETON 78 05310CSR EXCPT PUT REMARKS 05320CSR SETOF 78 05330CSR GOTO T206C 05340CSR END206 ENDSR 05350O******************************************************************** 05360OPRINT H 201 OF 05370O OR 1P 05380O 54 'I N V E N T O R Y' 05390O 68 'S T A T U S' 05400O 74 'B Y' 05410O 90 'P A R T N O.' 05420O UDATE Y 8 05430O 18 'FS222R' 05440O 127 'PAGE' 05450O PAGE Z 132 05460O*------------------------------------------------------------------- 05470O H 1 OF 05480O OR 1P 05490O 46 'VENDOR' 05500O*------------------------------------------------------------------- ÐÐ05510O H 1 OF 05520O OR 1P 05530O 48 'CUSTOMER' 05540O 75 'COST/PRICE' 05550O 90 'QUANTITY' 05560O 100 'QUANTITY' 05570O 111 'QUANTITY' 05580O 121 'SCHEDULE' 05590O 131 'AVAILABLE' 05600O*------------------------------------------------------------------- 05610O H 2 OF 05620O OR 1P 05630O 8 'PART-NO.' 05640O 25 'DESCRIPTION' 05650O 38 'ORDER-NO.' 05660O 60 'ASSY PART-NO,QTY-PER' 05670O 79 'REV,START-DATE' 05680O 89 'ON-HAND' 05690O 100 'ON-ORDER' 05700O 111 'REQUIRED' 05710O 119 'DATE' 05720O 130 'BALANCE' 05730O*-------------------------------------------------------------- 05740O H 1 OF 79 05750O PMPN 12 ' - - ' ÐÐ05760O PMDESC 43 05770O 57 'C O N T '' D' 05780O*------------------------------------------------------------------- 05790O EF 1 74 05800O PMPN 12 ' - - ' 05810O PMDESC 43 05820O SCNAME 55 05830O PMECHG 69 05840O PMOSUC2 80 05850O PMOHB J 91 05860O AVAIL J 132 05870O*------------------------------------------------------------------- 05880O E 1 47 05890O 26 'SAFETY STOCK' 05900O PMSSTKJ 111 05910O AVAIL J 132 05920O*------------------------------------------------------------------- 05930O EF 1 72 05940O 01 21 'RECD-PO' 05950O 02 20 'REL-WO' 05960O 03 23 'PUR-ORDER' 05970O 04 21 'PLAN-WO' 05980O 05 23 'PURCH-REQ' 05990O 06 25 'SALES-ORDER' 06000O 07 23 'BACKORDER' ÐÐ06010O 08 24 'PLAN-REQMT' 06020O 09 22 'FORECAST' 06030O N09 SFPRIM 32 06040O N09 33 '-' 06050O N09 SFDASH 36 06060O 18 37 '-' 06070O 18 SFRLOG 39 06080O N13 SFCUSTZ 45 06090O 13 SFNAPN 52 ' - - ' 06100O 17 SFREV 69 06110O 13 QPA5 Z 59 06120O 13 SFISSU 62 06130O 15 SFCPO 60 06140O 14 SFSTRT 79 ' - - ' 06150O 16 SFPRIC2 80 06160O 16 SFPCOD 81 06170O 01 SFDLT 69 ' - - ' 06180O QTYORDKB 101 06190O QTYREQKB 111 06200O SFDUE 121 ' - - ' 06210O AVAIL J 132 06220O*-------------------------------------------------------------- 06230O E 1 76 06240O* PUT PART NUMBER TOTALS 06250O 55 30 '*** TO BE ORDERED ***' ÐÐ06260O 80 'TOTALS.....' 06270O PMOHB J 91 06280O ORDBALJB 101 06290O REQBALJB 111 06300O AVAIL J 132 06310O*--------------------------------------------------------------- 06320O EF 1 76 06330O 1 ' ' 06340O*------------------------------------------------------------------- 06350O EF 1 73 06360O 17 '...' 06370O MGTEXT 54 06380O*------------------------------------------------------------------- 06390O EF 1 78 06400O RKTEXT 79 06410O 18 '*' 06420O 81 '*' 06430O*------------------------------------------------------------------ 06440O T 101 LR 06450O 1 ' ' 06460O******************************************************************** 06470OPMMST2 E 82 06480O PLT 128P 06490O PMSSTK 166P 06500O PM$ 279P ÐÐ06510O PMOHB 314P 06520O PMFRCB 318P 06530O PMALB 322P 06540O PMRLB 326P 06550O PMSOB 330P 06560O PMBOB 338P 06570O PMPRB 342P 06580O PMPOB 346P 06590O PMRPOB 350P 06600O PMPWOB 354P 06610O PMRWOB 358P 06620O PMOSUC 493P 06630O********************************************************************** 06640OBOBAL E 87 06650O SFPN 10 06660O BOQTY B 17 06670O********************************************************************** ** TABSC/TABSCN SOURCE CODES/NAMES 006680MAMFG-ASSY 006690PAPURCH-ASSY 006700MPMFG-PART 006710PPPURCH-PART 006720RSRAW-STOCK 006730RDREF-DOCUMENT 006740** SWO ARRAY 006750ÐÐ 06760** HLD ARRAY 06770CREDIT HOLD 06780/* 06790_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(ÈE× ÈTX115PM P120282120282(èÈÐ00010H Q115PM00020F* REMOVE TO BE DELETED FLAG FROM PART MAST. (X115PM) 00030F* REVISED 7-16-81 9:50 AM. 00040FBITTAB IP F 33 DISK 00050FPMMST2 UC F 674R12AI 1 DISK 00060FMGFILE IC F 80R DISK 00070FTERM50 O F 50 5 00080E******************************************************************** 00090E A16 16 16 1 A 00100E NUL 1 50 1 00110E BIT 33 1 00120I******************************************************************** 00130IBITTAB BT 00140I 1 33 BIT 00150I******************************************************************** 00160IPMMST2 PM 00170I 31 59 PMDESC 00180I 674 674 PMSTAT 00190I******************************************************************** 00200IMGFILE MG 00210I 1 35 MGTEXT 00220C******************************************************************** 00230C EXSR SR101 00240C*------------------------------------------------------------------- 00250C START TAG ÐÐ00260C MOVE '120001' W6A 6 00270C EXSR SR69 MOVE CURSOR 00280C Z-ADD298 M 50 00290C EXSR SR73 PUT MSG 00300C EXSR SR75 READ 00310C 90 GOTO END 00320C MOVELW16A W14A 14 00330C Z-ADD14 W2N 20 00340C EXIT SUBRAJ R.J. 00350C RLABL W2N 00360C RLABL W14A 00370C MOVE W14A W10N 100 00380C MOVELW10N W12A 12 00390C W12A CHAINPMMST2 60 GET PART MAST 00400C 60 Z-ADD291 M FLAG ERROR 00410C 60 EXSR SR73 PUT MSG 00420C 60 GOTO START 00430C SETON 72 00440C EXCPT OK TO DEL PRMPT 00450C SETOF 72 00460C EXSR SR75 00470C 93 GOTO START 00480C 90 GOTO END 00490C 77 MOVELW16A W2A 2 00500C W2A COMP ' ' 54 ÐÐ00510C 54 GOTO START 00520C SETON 80 00530C EXCPT PUT DEL FLAG 00540C SETOF 80 00550C GOTO START 00560C*------------------------------------------------------------------- 00570C END TAG 00580C MOVEL'CONTU' PROG 8 00590C EXITFCHAIN 00600C RLABL PROG 00610C******************************************************************** 00620CSR SR69 BEGSR 00630CSR EXITFQXYPOS MOVE CURSOR 00640CSR RLABL W6A 00650CSR ENDSR 00660C******************************************************************** 00670CSR SR73 BEGSR 00680CSR EXSR SR89 00690CSR MOVE '120001' W6A 6 00700CSR EXSR SR69 MOVE CURSOR 00710CSR SETON 73 00720CSR EXCPT PUT MSG 00730CSR SETOF 73 00740CSR ENDSR 00750C******************************************************************** ÐÐ00760CSR SR75 BEGSR 00770C* READ CRT. 00780CSR SETOF 7790 00790CSR MOVE BLK16 W16A 16 00800CSR MOVELBIT,1 BUFLGT 2 00810CSR MOVE BIT,9 BUFLGT 00820CSR EXITFQBELL RING BELL 00830CSR EXITFQWREED READ 00840CSR RLABL W16A 00850CSR RLABL BUFLGT 00860CSR MOVEAW16A A16 00870CSR MOVE BLK16 W16A 00880CSR Z-ADD1 W 30 00890CSR '\' LOKUPA16,W 90 00900CSRN90 GOTO T75B 00910CSR 1 ADD W W 00920CSR W COMP 16 54 00930CSR 54 Z-ADD16 W 00940CSR A16,W COMP 'G' 98 00950CSR A16,W COMP 'E' 94 00960CSR A16,W COMP 'N' 93 00970CSRN98N94N93 SETON 93 00980CSR GOTO END75 00990C*------------------------------------------------------------------- 01000CSR T75B TAG ÐÐ01010CSR Z-ADD1 W 01020CSR ' ' LOKUPA16,W 77 01030CSR 77 MOVEAA16,W W16A 01040CSR END75 ENDSR 01050C******************************************************************** 01060CSR SR89 BEGSR 01070C* GET MESSAGE MASTER. 01080CSR M CHAINMGFILE 54 01090CSR 54 MOVE BLK35 MGTEXT 01100CSR 54 MOVELM MGTEXT 01110CSR ENDSR 01120C******************************************************************** 01130CSR SR101 BEGSR 01140CSR MOVE ' ' BLK35 35 01150CSR MOVE ' ' BLK16 16 01160CSR ENDSR 01170O******************************************************************** 01180OPMMST2 E 80 01190O 620 ' ' 01200O******************************************************************** 01210OTERM50 E 73 01220O NUL 50 01230O MGTEXT 35 01240O*------------------------------------------------------------------- 01250O E 72 ÐÐ01260O W10N 12 ' - - ' 01270O N60 PMDESC 45 ** A16 ARRAY 01280 01290** NUL ARRAY 01300 01310/* 01320_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2F, 2X116BM P120282120282(èÈÐ00010H Q116BM00020F* INIT. LOW LEVEL CODE PMMST2& GEN GUIDE FILE FOR Q115BM. (X116BM) 00030F* REVISED 2/27/81 9:50 AM. DG-REL006 OK. 00040FPMMST2 UP AF 674 674 12AI 1 DISK 00050FBMWU IS AF 21 21 20AI 1 DISK 00060FPMGUIDE O F 10 10 10AI 1 DISK 00070I******************************************************************** 00080IPMMST2 PM 01 00090I 1 100PMPN L1M1 00100I P 13 140PMNOBM 00110I 430 4310PMLL 00120I 674 674 PMSTAT 00130I**************************************************************** 00140IBMWU BW 00150I 1 100BWCPN L1M1 00160C******************************************************************** 00170C 01 PMSTAT COMP 'D' 70 00180C 01 PMNOBM COMP 0 85 00190O******************************************************************** 00200OPMMST2 D 01 00210O PMNOBM 14P 00220O 431 '01' 00230O******************************************************************** 00240OPMGUIDE D 01NMRN70 00250O AND 85 ÐÐ00260O PMPN 10 /* 000270_‚ ÐÐ_‚_‚0O PMPN 10 /* 000270_‚ ÐÈ(ôFB ôÑX116PM P120282120282(èÈÐ00010H Q116PM00020F* DELETE PART MAST WITH DELETE PENDING.(X116PM) 00030F* REVISED 7-23-81 2:15 PM. DG-REL006 OK. 00040FPMMST2 UP F 674 12AI 1 DISK 00050FRMMAST IS F 140 15AI 1 DISK 00060FBMWU IS F 21 20AI 1 DISK 00070FPMCONVRTO F 82 DISK A 00080I******************************************************************** 00090IBMWU BW 02 21NCD 00100I 1 100BWCPN M1 00110I 21 21 BWSTAT 00120I*------------------------------------------------------------------- 00130I BG 03 00140I******************************************************************** 00150IRMMAST RM 02 140NCD 00160I 1 100RMPN M1 00170I*------------------------------------------------------------------- 00180I RG 03 00190I******************************************************************** 00200IPMMST2 PM 01 674NCD 620 C* 00210I* PART MASTER RECORD. 00220I* KEY AREA 00230I* PART NO. 10N 00240I 1 100PMPN M1 00250I* NUMB OF COMPONENTS 3P ÐÐ00260I P 13 140PMNOBM 00270I* CALCULATED DATA. 00280I* CURRENT BALANCES. 00290I* ON HAND STOCK 7P 00300I P 311 3140PMOHB 00310I* REQUIRED QTYS. 00320I* FORECAST BAL 7P 00330I P 315 3180PMFRCB 00340I* ALLOCATIONS 7P 00350I P 319 3220PMALB 00360I* REL REQS 7P 00370I P 323 3260PMRLB 00380I* SALES BACKLOG 7P 00390I P 327 3300PMSOB 00400I* QUOTES 7P 00410I* P 331 3340PMQTB 00420I* BACKORDERS 7P 00430I P 335 3380PMBOB 00440I* ON ORDER BALANCES. 00450I* PURCHASE REQS 7P 00460I P 339 3420PMPRB 00470I* PURCH ORDERS 7P 00480I P 343 3460PMPOB 00490I* RECD P.O. 7P 00500I P 347 3500PMRPOB ÐÐ00510I* OPEN WORK ORDER 7P 00520I P 351 3540PMPWOB 00530I* REL WORK ORDER 7P 00540I P 355 3580PMRWOB 00550I* RECORD STATUS 1A 00560I* D = DELETED 00570I* 674 674 PMSTAT 00580I*------------------------------------------------------------------- 00590I GG 03 00600C******************************************************************** 00610C 01 MR SETOF 01 00620C N01 GOTO END 00630C PMNOBM COMP 0 54 # OF COMPONENTS 00640C N54 PMOHB COMP 0 54 ON HAND 00650C N54 PMFRCB COMP 0 54 FORECAST 00660C N54 PMALB COMP 0 54 ALLOCATIONS 00670C N54 PMRLB COMP 0 54 REL RQMTS 00680C N54 PMSOB COMP 0 54 SALES ORD 00690C N54 PMBOB COMP 0 54 BO QTY 00700C N54 PMPRB COMP 0 54 PUR REQ 00710C N54 PMPOB COMP 0 54 PO 00720C N54 PMRPOB COMP 0 54 RCD PO 00730C N54 PMPWOB COMP 0 54 PLAN WO 00740C N54 PMRWOB COMP 0 54 REL WO 00750C 54 SETOF 01 ÐÐ00760C*------------------------------------------------------------------- 00770C END TAG 00780C TIME TIME 60 00790O******************************************************************** 00800OPMCONVRTDADD 01 00810O 2 'PM' 00820O TIME 8 00830O PMPN 18 00840O 21 'D' 00850O UDATE 31 00860O 82 'PM' 00870O******************************************************************** 00880OPMMST2 D 01 00890O PMNOBM 14P 00900O PMOHB 314P 00910O PMFRCB 318P 00920O PMALB 322P 00930O PMRLB 326P 00940O PMSOB 330P 00950O PMBOB 338P 00960O PMPRB 342P 00970O PMPOB 346P 00980O PMRPOB 350P 00990O PMPWOB 354P 01000O PMRWOB 358P ÐÐ01010O 674 'D' /* 01020_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( G  NX117BM P120282120282(èÈÐ00010H Q117BM00020F* INDENTED PARTS LIST, MFD PARTS ONLY, ALL END-USE ITEMS. (X117BM) 00030F* REVISED 7/06/81 2:50 PM. DG-REL006 OK. *** D I A B L O *** 00040F* NOTE: USES 15-PITCH, STD PAPER. 00050FBITTAB IP F 33 DISK 00060FEUGUIDE IS F 10 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST ID F 86L20AI 1 DISK 00090FMGFILE IC F 80R DISK 00100FCRTFILE UC F 256R DISK 00110E******************************************************************** 00120E A12 12 12 1 A INPUT ARRAY. 00130E LEV 1 20 20 NEXT RRN AT EA LEVEL 00140E QTY 1 20 7 0 QTY MULTIPLIER 00150E A29 1 29 1 00160E PLT 8 3 0 LEAD TIMES 00170E PMM 6 7 0 MIN MAX CODES 00180E BIT 33 1 BITTAB. 00190E REC 132 1 CRTFILE 00200I******************************************************************** 00210IBITTAB BT 10 00220I 1 33 BIT 00230I******************************************************************** 00240IEUGUIDE EU 00250I 1 100EUPN ÐÐ00260I******************************************************************** 00270ICRTFILE CR 00280I 81 212 REC 00290I******************************************************************** 00300IPMMST2 PM 00310I* PART MASTER RECORD. 00320I* KEY AREA 00330I* PART NO. 12A 00340I 1 12 PMPN 00350I* NUMB OF COMPONENTS 3P 00360I P 13 140PMNOBM 00370I* PROD LINE 4N 00380I 15 180PMPL 00390I* MODEL NAME 12A 00400I 19 30 PMMODL 00410I* DESCRIPTION 29A 00420I 31 59 PMDESC 00430I* COMMODITY CODE 9P 00440I P 60 640PMCC 00450I* ENG CHANGE STATUS. 00460I* CUR CHG LEVEL 2A 00470I 70 71 PMECHG 00480I* CUR CHG DATE 6N 00490I 72 770PMDCHG 00500I* LAST ECN NO. 5A ÐÐ00510I 65 69 PMECN 00520I* DRAWING INFO 00530I* DWG SIZE 1A 00540I 82 82 PMSIZ 00550I* DWG CLASS 1A 00560I* D = DYNAIR DWG 00570I* V = VENDOR DWG 00580I 83 83 PMDCLS 00590I* STANDARD CODE 1A 00600I 84 84 PMSTDC 00610I* DWG REL CODE 1A 00620I* E = ENG ONLY 00630I* M = REL TO MFG 00640I* P = PROTOTYPE 00650I 78 78 PMDREL 00660I* UNIT MEAS 2A 00670I* EA = EACH OC = OUNCE 00680I* ST = SET TC = TROY OUNCE 00690I* IN = INCH LB = POUND 00700I* FT = FEET PT = PINT 00710I* YD = YARD QT = QUART 00720I* SI = SQ.INCH GL = GALLON 00730I* SF = SQ.FEET DR = DRUM 00740I* SY = SQ.YARD 00750I 85 86 PMUM ÐÐ00760I* SOURCE CODE 2A 00770I* MA = MFG ASSY 00780I* MP = MFG PART 00790I* PA = PURCH ASSY 00800I* PP = PURCH PART 00810I* RS = RAW STOCK 00820I 94 95 PMSC 00830I* PROVISIONING CODE 1A 00840I* A = FORECAST,NO VALUE ADDED 00850I* B = FORECAST,VALUE ADDED 00860I* C = BUILD TO ORDER (B) 00870I* D = BUILD TO ORDER (NOT B) 00880I* E = CUSTOM 00890I* Y = OBSOLETE,REPAIRABLE 00900I* Z = OBSOLETE,NOT REPAIRABLE 00910I 96 96 PMPROV 00920I* ISSUE CODE 2A 00930I* PT = PULL TIME 00940I* OR = ON REQUEST 00950I* BI = BULK ISSUE 00960I* AR = AS REQUIRED 00970I* VS = VENDOR SUPPLIED 00980I* SD = SHIPPING DOCUMENT 00990I* TD = TRAV DOCUMENT 01000I* RD = REF DOCUMENT ÐÐ01010I* RA = REF ASSY 01020I 97 98 PMISSU 01030I* INVENTORY ACCOUNT 5P 01040I P 110 1120PMACNT 01050I* LEAD TIMES 3P X 8 01060I P 113 128 PLT 01070I* MIN/MAX CODES 7P X 6 01080I P 139 162 PMM 01090I* ROUNDING FACTOR 5P 01100I P 167 1690PMRNDF 01110I* FAB CODE 2A 01120I 487 488 PMFABC 01130I* RECORD STATUS 1A 01140I* D = DELETED 01150I 674 674 PMSTAT 01160I******************************************************************** 01170IBMMAST BM 01180I* BILL OF MATERIAL RECORD 01190I* KEY AREA 01200I* ASSY PART NO. 10N 01210I 1 100BMAPN 01220I* COMPONENT PART # 10N 01230I 11 200BMCPN 01240I* ITEM NO. 3N 01250I 25 270BMITNO ÐÐ01260I* QTY PER ASSY 7P 01270I P 28 310BMQTY 01280I* SCRAP ALLOW .2N 01290I 34 352BMSCRP 01300I* ISSUE CODE 2A 01310I* PT = PULL TIME 01320I* OR = ON REQUEST 01330I* BI = BULK ISSUE 01340I* AR = AS REQUIRED 01350I* RA = REF ASSY 01360I* TD = TRAV DOC 01370I* SD = SHIP DOC 01380I* RD = REF DOC 01390I* VS = VENDOR SUPPLIED 01400I 36 37 BMISSU 01410I* EFFECTIVITY. 01420I* BEGIN CHANGE LEVEL 2A 01430I 38 39 BMBCHG 01440I* ENDING CHANGE LEVEL 2A 01450I 40 41 BMECHG 01460I* BEGIN ECN # 5A 01470I 42 46 BMBECN 01480I* ENDING ECN # 5A 01490I 47 51 BMEECN 01500I* DISPOSITION CODE 1A ÐÐ01510I* U = USE UP OLD STYLE 01520I* N = NOW (IMMEDIATE) 01530I 52 52 BMDISP 01540I* FILLER 5A 53 57 FFFFFF 01550I* ROUTING. 01560I* OPER NO. 5P 01570I P 58 600BMOPER 01580I* DEPT NO. 5P 01590I P 61 630BMDEPT 01600I* WORK CENTER NO. 3P 01610I P 64 650BMWC 01620I* COMPONENT OPER REFERENCE INFO 10A 01630I 66 75 BMREF 01640I* FILLER 10A 76 85 FFFFFF 01650I* RECORD STATUS 1A 01660I* D = DELETED 01670I 86 86 BMSTAT 01680I******************************************************************** 01690IMGFILE MG 01700I* MESSAGE FILE. 01710I* TEXT 35A 01720I 1 35 MGTEXT 01730I* LINE-2 35A 01740I 36 70 MGLIN2 01750I* PROG NAME 5A ÐÐ01760I 71 75 MGPROG 01770C******************************************************************** 01780C* INITIALIZE 01790C N79 EXSR SR101 INIT 01800C 10 GOTO END BITTAB FILE 01810C Z-ADD1 P 30 01820C EUPN COMP FPN 54 54 01830C N54 GOTO END 01840C Z-ADDEUPN TAPN 100 01850C MOVELTAPN W12A 12 01860C EXSR SR81 GET PMMST2 01870C N60 GOTO TAG10 GOT IT 01880C Z-ADD302 M 50 96 FLAG ERROR 01890C EXSR SR73 PUT MSG 01900C GOTO END 01910C*-------------------------------------------------------------------- 01920C TAG10 TAG 01930C* PUT HEADING. DISPLAY TOP ASSY DATA LINE. 01940C Z-ADD1 QTY,2 QTY MULTIPLIER 01950C SETON 8976 01960C EXSR SR71 PUT HEADING 01970C SETOF 89 01980C* FLAG NO COMPONENTS ON FILE. 01990C PMNOBM COMP 0 55 02000C 55 GOTO TAG15 ÐÐ02010C Z-ADD611 M 02020C SETON 75 02030C EXSR SR70 TOP ASSY LINE 02040C EXSR SR73 PUT MSG 02050C GOTO END 02060C*------------------------------------------------------------------- 02070C TAG15 TAG 02080C* SET-UP INITIAL BILL MATERIAL READ 02090C Z-ADD3 L 20 INDENTURE LEVEL 02100C MOVE BLK20 LEV 02110C MOVELTAPN LEV,2 02120C*----------------------------------------------------------------- 02130C TAG20 TAG 02140C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02150C L SUB 1 L 54 INDENT LEVEL 02160C N54 GOTO END BOTTOM INDENT 02170C LEV,L COMP BLK20 54 02180C N54 GOTO TAG20 NONE THIS LEVEL 02190C MOVE LEV,L W20A 20 02200C MOVELLEV,L CURASY 100 MATCH PART # 02210C MOVE BLK20 LEV,L 02220C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 02230C*------------------------------------------------------------------ 02240C TAG30 TAG 02250C* SET-UP NEXT READ ÐÐ02260C W20A SETLLBMMAST 02270C*--------------------------------------------------------------- 02280C TAG40 TAG 02290C* GET NEXT COMPONENT. 02300C SETOF 54 02310C READ BMMAST 54GET COMPONENT 02320C 54 GOTO TAG20 END OF FILE 02330C BMAPN COMP CURASY 54 02340C N54 GOTO TAG20 WRONG ASSY 02350C BMSTAT COMP 'D' 54 02360C 54 GOTO TAG40 DELETED RECORD 02370C* DISPLAY COMPONENT DATA 02380C EXSR SR72 DISPLAY DATA 02390C* BRANCH IF NOT ASSY 02400C PMNOBM COMP 0 54 02410C N54 GOTO TAG40 NOT ASSY 02420C*------------------------------------------------------------------ 02430C TAG50 TAG 02440C* SAVE CUR LEVEL ASSY/COMPONENT PART # 02450C MOVELBMAPN LEV,L 02460C 1 ADD BMCPN W10N 100 02470C MOVE W10N LEV,L 02480C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 02490C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 02500C MOVE BMCPN CURASY ÐÐ02510C MOVELBMCPN W20A 02520C MOVE ZERO10 W20A 02530C 1 ADD L L INDENT LEVEL 02540C GOTO TAG30 02550C*----------------------------------------------------------------- 02560C END TAG 02570CLR EXSR SR68 TOP FORM 02580CLR EXSR SR68 TOP FORM 02590C******************************************************************** 02600CSR SR65 BEGSR 02610C* UPDATE CRTFILE. 02620CSR EXSR SR82 GET CRTFILE 02630CSR MOVE ' ' REC 02640CSR EXSR SR83 UPD CRTFILE 02650CSR EXSR SR82 GET CRTFILE 02660CSR EXSR SR66 LF 02670CSR MOVEAREC W148A 148 02680CSR EXITFZD148 02690CSR RLABL W148A 02700CSR ENDSR 02710C******************************************************************* 02720CSR SR66 BEGSR 02730C* LINE FEED. 02740CSR EXITFQCLF LF 02750CSR 1 ADD COUNT COUNT ÐÐ02760CSR ENDSR 02770C****************************************************************** 02780CSR SR67 BEGSR 02790C* RIGHT ADJUST 02800CSR Z-ADD12 W2N 20 02810CSR EXIT SUBRAJ R.J. 02820CSR RLABL W2N 02830CSR RLABL W12A 02840CSR ENDSR 02850C****************************************************************** 02860CSR SR68 BEGSR 02870C* TOP OF FORM. 02880CSR EXITFZTFORM TOP FORM 02890CSR 1 ADD EGAP EGAP 30 PAGE # 02900CSR Z-ADD0 COUNT 30 02910CSR ENDSR 02920C******************************************************************** 02930CSR SR69 BEGSR 02940C* PAUSE. 02950CSR EXITFQPAUSE 02960CSR ENDSR 02970C******************************************************************** 02980CSR SR70 BEGSR 02990C* PRINT LINE. 03000CSR EXSR SR65 PRINT LINE ÐÐ03010CSR COUNT COMP 83 54 54 03020CSR 54 SETON 78 03030CSR 54 EXSR SR71 NEW PAGE 03040CSR ENDSR 03050C******************************************************************* 03060CSR SR71 BEGSR 03070C* CLEAR CRT. PUT HEADINGS. 03080CSRN78 COUNT COMP 80 78 78 03090CSR 78 EXSR SR68 TOP OF FORM 03100CSRN78 EXSR SR66 03110CSRN78 EXSR SR66 03120CSRN78 GOTO T71A 03130CSR SETOF 78 03140CSR MOVELTAPN W12A 03150CSR MOVE ' ' W12A 03160CSR EXSR SR81 GET TOP-ASSY PMMST2 03170CSR SETON 7131 03180CSR EXSR SR65 PUT HEADING 03190CSR SETON 7132 03200CSR EXSR SR65 PUT HEADING 03210CSR SETON 7133 03220CSR EXSR SR65 PUT HEADING 03230CSR EXSR SR66 LF/CR 03240C*------------------------------------------------------------------ 03250CSR T71A TAG ÐÐ03260CSR Z-ADDP LINE 03270CSR SETON 75 03280CSR EXSR SR70 PUT TOP ASSY DATA 03290CSR ENDSR 03300C******************************************************************** 03310CSR SR72 BEGSR 03320C* DISPLAY DATA LINE TO CRT. 03330CSR MOVELBMCPN W12A COMP PN 03340CSR EXSR SR81 GET PMMST2 03350C* BYPASS IF NOT MFG. 03360CSR MOVELPMSC W1A 1 03370CSR W1A COMP 'M' 54 03380CSRN54 PMSC COMP 'RA' 54 03390CSRN54 GOTO END72 NOT ASSY 03400C* BYPASS REFERENCE 03410CSR MOVELBMISSU W1A 03420CSR W1A COMP 'R' 54 03430CSR 54 BMISSU COMP 'RA' 55 03440CSR 54N55 GOTO END72 REF ITEM 03450CSR L COMP 1 0101 03460CSR L COMP 2 02 03470CSR L COMP 3 03 03480CSR L COMP 4 04 03490CSR L COMP 5 05 03500CSR L COMP 6 06 ÐÐ03510CSR L COMP 7 07 07 03520CSR 01 Z-ADD1 L 03530CSR BMISSU COMP ' ' 55 03540CSR CUMQTY MULT BMQTY EXTQTY 70 EXTENDED QTY REQD 03550CSR 1 ADD P P 03560CSR Z-ADDP LINE 30 03570CSR SETON 7276 03580CSR EXSR SR70 PUT DATA. 03590CSR END72 ENDSR 03600C******************************************************************** 03610CSR SR73 BEGSR 03620C* PUT MSG TO CRT. 03630CSR EXSR SR89 GET MSG 03640CSR 54 MOVE BLK35 MGTEXT 03650CSR 54 MOVELM MGTEXT 03660CSR EXSR SR66 LF 03670CSR SETON 73 03680CSR EXSR SR70 PUT MSG. 03690CSR ENDSR 03700C******************************************************************** 03710CSR SR81 BEGSR 03720C* GET PART MAST. 03730CSR SETOF 61 03740CSR MOVE ' ' W12A 03750CSR W12A CHAINPMMST2 60 GET PMMST. ÐÐ03760CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE. 03770CSR ENDSR 03780C******************************************************************* 03790CSR SR82 BEGSR 03800C* GET CRTFILE 03810CSR PORT CHAINCRTFILE H6 03820CSR H6 GOTO END 03830CSR ENDSR 03840C******************************************************************* 03850CSR SR83 BEGSR 03860C* UPDATE CRTFILE 03870CSR EXCPT UPDATE CRTFILE 03880CSR SETOF 717273 03890CSR SETOF 747577 03900CSR SETOF 313233 03910CSR ENDSR 03920C****************************************************************** 03930CSR SR89 BEGSR 03940C* GET MGFILE. 03950CSR M CHAINMGFILE 54 GET MGFILE. 03960CSR 54 MOVE BLK35 MGTEXT 03970CSR 54 MOVELM MGTEXT 03980CSR 54 MOVE 'NO MSG' MGTEXT 03990CSR ENDSR 04000C******************************************************************** ÐÐ04010CSR SR101 BEGSR 04020C* INITIALIZE (1-TIME). 04030CSR SETON 7978 04040CSR EXSR SR68 TOP FORM 04050CSR MOVELBIT,1 BUFLGT 2 04060CSR MOVE BIT,7 BUFLGT 04070CSR MOVE ' ' BLK35 35 04080CSR MOVE ' ' BLK12 12 04090CSR MOVE ' ' BLK20 20 04100CSR Z-ADD0 ZERO10 100 04110CSR MOVE ' ' W8A 8 04120CSR Z-ADD0 W2N 20 04130CSR Z-ADD0 W1N 10 04140CSR MOVE ' ' W2A 2 04150CSR EXITFPGMINX GET TERM NO. 04160CSR RLABL W8A 04170CSR RLABL W2N 04180CSR RLABL W1N 04190CSR RLABL W2A 04200CSR MOVE W2A PORT 20 TERM NO. 04210CSR PORT COMP 0 54 04220CSRN54 Z-ADD25 PORT 04230CSR Z-ADD557 M 50 04240CSR EXSR SR73 MOUNT 15-PITCH MSG 04250CSR EXSR SR69 PAUSE ÐÐ04260CSR Z-ADD558 M MOUNT 11X8-1/2 PAPER 04270CSR EXSR SR73 PUT MSG 04280CSR EXSR SR69 PAUSE 04290CSR MOVE '08' W2A 2 04300CSR EXITFZVMI SET VERT SPACING 04310CSR RLABL W2A 04320CSR MOVE '15' W2A 04330CSR EXITFZHMI SET HORIZ SPACING 04340CSR RLABL W2A 04350CSR Z-ADD298 M 04360CSR EXSR SR73 04370CSR Z-ADD0 EGAP 30 PAGE # 04380CSR MOVE BLK12 W12A 12 04390CSR EXITFQWREED 04400CSR RLABL W12A 04410CSR RLABL BUFLGT 04420CSR Z-ADD12 W2N 20 04430CSR EXIT SUBRAJ 04440CSR RLABL W2N 04450CSR RLABL W12A 04460CSR MOVE W12A FPN 100 04470CSR ENDSR 04480O******************************************************************** 04490OCRTFILE E 72 04500O* DATA LINE. ÐÐ04510O REC 212 04520O 91 '.' 04530O 94 '.' 04540O 97 '.' 04550O 100 '.' 04560O 103 '.' 04570O 106 '.' 04580O 109 '.' 04590O 02 109 ' ' 04600O 03 109 ' ' 04610O L Z 88 04620O LINE Z 83 04630O 01 BMCPN 102 '0 - - ' 04640O 02 BMCPN 105 '0 - - ' 04650O 03 BMCPN 108 '0 - - ' 04660O 04 BMCPN 111 '0 - - ' 04670O 05 BMCPN 114 '0 - - ' 04680O 06 BMCPN 117 '0 - - ' 04690O 07 BMCPN 120 '0 - - ' 04700O PMDESC 151 04710O BMQTY 2 162 04720O PMUM 166 04730O PMSC 171 04740O EXTQTYZ 178 04750O PMFABC 183 ÐÐ04760O BMISSU 189 04770O PLT,5 Z 194 04780O PLT,8 Z 198 04790O PMM,4 Z 205 04800O PMRNDFZ 212 04810O*------------------------------------------------------------------- 04820O E 75 04830O* PUT TOP ASSY LINE. 04840O REC 212 04850O 88 '1' 04860O 89 LINE Z 83 04870O TAPN 102 '0 - - ' 04880O N89 109 'CONT''D' 04890O PMDESC 151 04900O PMUM 166 04910O PMSC 171 04920O PLT,5 Z 194 04930O PLT,8 Z 200 04940O PMM,4 Z 205 04950O PMRNDFZ 212 04960O 178 '1' 04970O PMFABC 183 04980O*------------------------------------------------------------------- 04990O E 73 05000O* PUT ERROR MESSAGE. ÐÐ05010O REC 212 05020O MGTEXT 115 05030O BIT,8 212 05040O*------------------------------------------------------------------- 05050O E 71 31 05060O* CLEAR SCREEN - LINE-1. 05070O REC 212 05080O UDATE 88 ' - - ' 05090O EGAP Z 98 05100O 95 'PAGE' 05110O 141 'INDENTED PARTS LIST - ' 05120O 151 'MFG PARTS' 05130O 159 'ASSY=' 05140O TAPN 171 ' - - ' 05150O 195 '<----------' 05160O 212 '----->' 05170O 204 'INPUT FIELDS' 05180O*------------------------------------------------------------------- 05190O E 71 32 05200O* HEADING, LINE-2. 05210O REC 212 05220O 106 ' <----------INDENTURE' 05230O 120 '------------->' 05240O 85 'LINE ' 05250O 162 'QUANTITY' ÐÐ05260O 174 'SOURCE' 05270O 178 'EXT' 05280O 183 'FAB' 05290O 189 'ISSUE' 05300O 196 'LEAD' 05310O 205 'MIN' 05320O 212 'ROUND' 05330O*------------------------------------------------------------------- 05340O E 71 33 05350O* HEADING, LINE-3. 05360O REC 212 05370O 88 'LEV' 05380O 84 'ITEM' 05390O 109 '1 2 3 4 5 6 7' 05400O 112 '-UP' 05410O 133 'DESCRIPTION' 05420O 162 'PER-ASSY' 05430O 166 'UM' 05440O 173 'CODE' 05450O 178 'QTY' 05460O 184 'CODE' 05470O 189 'CODE' 05480O 194 'ASY' 05490O 198 'PAR' 05500O 205 'ORD' ÐÐ05510O 211 'FACT' ** A12 ARRAY 005520 005530** LEV ARRAY 005540 005550** QTY ARRAY 005560 005570** A29 ARRAY 005580 005590/* 005600_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(Hc  XASCHX P999999120282(èÈÐ SUBROUTINE ZASCHX (IASCII,IHEX) 00010* CONVERT 2-CHAR OF ASCII TO 4-ASCII-HEX-CHAR 00020* 00030 CALL HEXASC (IASCII,IHEX) 00040 RETURN 00050 END 00060_‚ ÐÐ_‚_‚ SUBROUTINE ZASCHX (IASCII,IHEX) 00010* CONVERT 2-CHAR OF ASCII TO 4-ASCII-HEX-CHAR 00020* 00030 CALL HEXASC (IASCII,IHEX) 00040 RETURN 00050 END 00060_‚ ÐÈ(dHo d*X120BM P120282120282(èÈÐ00010H Q120BM00020F* MATCH BM PART NO'S TO PART MASTER- LIST NO HITS 00030F* REVISED 2/12/81 3:20 PM. 00040FBMMAST IP F 86 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070I*************************************************************** 00080IBMMAST BM 01 86NCD 00090I 1 100BMAPN L1 00100I GG 02 00110I*************************************************************** 00120IPMMST2 PM 00130I 1 100PMPN 00140C************************************************************* 00150C N01 GOTO END 00160C L1 MOVELBMAPN W12A 12 00170C L1 W12A CHAINPMMST2 60 00180C*--------------------------------------------------------- 00190C END TAG 00200O***************************************************************** 00210OPRINT H 201 1P 00220O OR OF 00230O 75 'UNMATCHED BMMAST RECORDS' 00240O H 2 1P 00250O OR OF ÐÐ00260O 22 'ASSY PART#' 00270O 30 'ERROR' 00280O T 1 L1 60 00290O BMAPN 26 ' - - ' 00300O 60 35 'ERROR' 00310O 61 40 'COMP' /* 000320_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dHš d*X121BM P120282120282(èÈÐ00010H Q121BM00020F* MATCH BMWU PART NOS. TO PART MAST- LIST NO HITS. (X121BM) 00030F* REVISED 2/12/81 3:25 PM. 00040FBMWU IP F 21 DISK 00050FPMMST2 IC F 674R12AI 1 DISK 00060FPRINT O F 132 OF PRINTER 00070I*************************************************************** 00080IBMWU BM 01 21NCD 00090I 11 200BMCPN L1 00100I GG 02 00110I*************************************************************** 00120IPMMST2 PM 00130I 1 100PMPN 00140C************************************************************* 00150C N01 GOTO END 00160C L1 MOVELBMCPN W12A 12 00170C L1 W12A CHAINPMMST2 60 00180C*--------------------------------------------------------- 00190C END TAG 00200O***************************************************************** 00210OPRINT H 101 1P 00220O OR OF 00230O 75 'UNMATCHED BMMAST RECORDS' 00240O H 2 1P 00250O OR OF ÐÐ00260O 22 'COMP PART#' 00270O T 1 L1 60 00280O BMCPN 26 ' - - ' 00290O 60 35 'ERROR' /* 000300_‚ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ( HÅ  NX122BM P€ 120282120282(èÈÐ00010H Q122BM00020F* PRINT INDENTED WHERE-USED WITH PAST USAGE & PO BAL. (X122BM) 00030F* REVISED 1-17-83 9:15 AM. * * * D I A B L O * * * 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060FSUSPENSEUD F 128L29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FBMMAST IC F 86R20AI 1 DISK 00090FBMWU ID F 21L20AI 1 DISK 00100FMGFILE IC F 80R DISK 00110FEMPLFILEIC F 64R14AI 1 DISK 00120FMATLHISTIC F 232R10AI 1 DISK 00130FMENUDEPTIT F 25 EDISK 00140E******************************************************************** 00150E MENUDEPT TABDEP 1 10 5 0 TABNAM 20 00160E NUL 50 50 1 NULL CHAR. 00170E N20 20 20 1 NULL CHAR. 00180E A6 6 6 1 00190E A12 12 12 1 A INPUT ARRAY. 00200E LEV 1 20 20 NEXT RRN AT EA LEVEL 00210E QTY 1 20 7 0 00220E DASH 1 122 1 00230E A29 29 29 1 00240E BIT 33 1 BITTAB. 00250E APN 8 10 0A SUSPENSE ÐÐ00260E REC 132 1 00270E QAR 8 3 0 SUSPENSE 00280E UU 12 6 0 UNPLAN 00290E PU 12 6 0 PLAN 00300E SR 12 6 0 SPARES 00310I******************************************************************** 00320IBITTAB BT 00330I 1 33 BIT 00340I******************************************************************** 00350ICRTFILE CR 00360I 81 212 REC 00370I******************************************************************** 00380IEMPLFILEEE 00390I 23 42 EENAME 00400I******************************************************************** 00410ISUSPENSESP 01 00420I* SUSPENSE FILE (CONTAINS COMP PART NO'S). 00430I* KEY AREA. 00440I* TERMINAL # 2N (NOT USED) 1 2 XXXXXX 00450I* RECORD CODE 2A (IW) 00460I 3 4 SPREC 00470I* RECORD COUNTER 3N 00480I 5 70SPCNTR 00490I* REQUESTING DEPT 5N 00500I 8 120SPDEPT ÐÐ00510I* EMPLOYEE # 5A 00520I 13 17 SPEMPL 00530I* ASSY PART # 10A X 8 00540I 30 109 APN 00550I* QTYS 3P X 8 00560I P 110 125 QAR 00570I* RECORD STATUS 1A 00580I 128 128 SPSTAT 00590I******************************************************************** 00600IMATLHISTMH 00610I* PART NO. 10N 00620I 1 100PARTNO 00630I* UNPLAN USAGE 6N X 12 (C4) 00640I 11 82 UU 00650I* PLAN USAGE 6N X 12 (C6) 00660I 83 154 PU 00670I* SPARES & REPAIRS 6N X 12 (SP) 00680I 155 226 SR 00690I* LAST DATE 6N 00700I 227 232 DATE 00710I******************************************************************** 00720IPMMST2 PM 00730I* PART MASTER RECORD. 00740I* KEY AREA. 00750I* PART NO. 12A ÐÐ00760I 1 12 PMPN 00770I* PROD LINE 4N 00780I 15 180PMPL 00790I* MODEL NAME 12A 00800I 19 30 PMMODL 00810I* DESCRIPTION 29A 00820I 31 59 PMDESC 00830I* COMMODITY CODE 9P 00840I P 60 640PMCC 00850I* ENG CHANGE STATUS. 00860I* CUR CHG LEVEL 2A 00870I 70 71 PMECHG 00880I* CUR CHG DATE 6N 00890I 72 770PMDCHG 00900I* LAST ECN NO. 5A 00910I 65 69 PMECN 00920I* DRAWING INFO 00930I* DWG SIZE 1A 00940I 82 82 PMSIZ 00950I* DWG CLASS 1A 00960I* D = DYNAIR DWG 00970I* V = VENDOR DWG 00980I 83 83 PMDCLS 00990I* STANDARD CODE 1A 01000I 84 84 PMSTDC ÐÐ01010I* DWG REL CODE 1A 01020I* E = ENG ONLY 01030I* M = REL TO MFG 01040I* P = PROTOTYPE 01050I 78 78 PMDREL 01060I* UNIT MEAS 2A 01070I* EA = EACH OC = OUNCE 01080I* ST = SET TC = TROY OUNCE 01090I* IN = INCH LB = POUND 01100I* FT = FEET PT = PINT 01110I* YD = YARD QT = QUART 01120I* SI = SQ.INCH GL = GALLON 01130I* SF = SQ.FEET DR = DRUM 01140I* SY = SQ.YARD 01150I 85 86 PMUM 01160I* SOURCE CODE 2A 01170I* MA = MFG ASSY 01180I* MP = MFG PART 01190I* PA = PURCH ASSY 01200I* PP = PURCH PART 01210I* RD = REF DOC ONLY 01220I* RS = RAW STOCK 01230I 94 95 PMSC 01240I* PROVISIONING CODE 1A 01250I* A = FORECAST,NO VALUE ADDED ÐÐ01260I* B = FORECAST,VALUE ADDED 01270I* C = FRCST-BUILD TO ORDER 01280I* D = NON-FRCST-BUILD TO ORD 01290I* E = CUSTOM 01300I* Y = OBSOLETE,REPAIRABLE 01310I* Z = OBSOLETE,NOT REPAIRABLE 01320I 96 96 PMPROV 01330I* ISSUE CODE 2A 01340I* PT = PULL TIME 01350I* OR = ON REQUEST 01360I* BI = BULK ISSUE 01370I* AR = AS REQUIRED 01380I* VS = VENDOR SUPPLIED 01390I* SD = SHIPPING DOCUMENT 01400I* TD = TRAV DOCUMENT 01410I* RD = REF DOC ONLY 01420I* RA = REF ASSY 01430I 97 98 PMISSU 01440I* DELIVER TO DEPT 5P 01450I P 99 1010PMDEL 01460I* RESPONSIBILITY CODES 01470I* ENGR CODE 2A 01480I 102 103 PMEGR 01490I* PLANNER CODE 2A 01500I 104 105 PMPLNR ÐÐ01510I* BUYER CODE 2A 01520I 106 107 PMBUYR 01530I* SALESMAN CODE 2A 01540I 108 109 PMSLSM 01550I* INVENTORY ACCOUNT 5P 01560I P 110 1120PMACNT 01570I* LOW LEVEL CODE 2N 01580I 430 4310PMLL 01590I* FAB CODE 2A 01600I 487 488 PMFABC 01610I* RECORD STATUS 1A 01620I* D = DELETED 01630I 674 674 PMSTAT 01640I******************************************************************** 01650IBMMAST BM 01660I* BILL OF MATERIAL RECORD. 01670I* KEY AREA 01680I* ASSY PART NO. 10N 01690I 1 100BMAPN 01700I* COMPONENT PART NO. 10N 01710I 11 200BMCPN 01720I* ITEM NO. 3N 01730I 25 270BMITNO 01740I* QTY PER ASSY 7P 01750I P 28 310BMQTY ÐÐ01760I* SCRAP ALLOW .2N 01770I 34 352BMSCRP 01780I* ISSUE CODE 2A 01790I* PT = PULL TIME 01800I* OR = ON REQUEST 01810I* BI = BULK ISSUE 01820I* AR = AS REQUIRED 01830I* RA = REF ASSY 01840I* TD = TRAV DOC 01850I* SD = SHIP DOC 01860I* RD = REF DOC 01870I* VS = VENDOR SUPPLIED 01880I 36 37 BMISSU 01890I* EFFECTIVITY. 01900I* BEGIN CHANGE LEVEL 2A 01910I 38 39 BMBCHG 01920I* ENDING CHANGE LEVEL 2A 01930I 40 41 BMECHG 01940I* BEGIN ECN # 5A 01950I 42 46 BMBECN 01960I* ENDING ECN # 5A 01970I 47 51 BMEECN 01980I* DISPOSITION CODE 1A 01990I* U = USE UP OLD STYLE 02000I* N = NOW (IMMEDIATE) ÐÐ02010I 52 52 BMDISP 02020I* FILLER 5A 53 57 FFFFFF 02030I* ROUTING. 02040I* OPER NO. 5P 02050I P 58 600BMOPER 02060I* DEPT NO. 5P 02070I P 61 630BMDEPT 02080I* WORK CENTER NO. 3P 02090I P 64 650BMWC 02100I* COMPONENT OPER REFERENCE INFO 10A 02110I 66 75 BMREF 02120I* FILLER 76 85 FFFFFF 02130I* RECORD STATUS 1A 02140I* D = DELETED 02150I 86 86 BMSTAT 02160I******************************************************************** 02170IBMWU BW 02180I* COMPONENT PN 10N 02190I 1 100BWCPN 02200I* ASSY PART # 10N 02210I 11 200BWAPN 02220I* RECORD STATUS 1A 02230I 21 21 BWSTAT 02240I******************************************************************** 02250IMGFILE MG ÐÐ02260I* MESSAGE FILE. 02270I* TEXT 35A 02280I 1 35 MGTEXT 02290I* LINE-2 35A 02300I 36 70 MGLIN2 02310I* PROG NAME 5A 02320I 71 75 MGPROG 02330C******************************************************************** 02340C* INITIALIZE (1-TIME). 02350C EXSR SR101 INIT. 02360C Z-ADD0 ZERO10 100 STUPIDITY 02370C*------------------------------------------------------------------- 02380C BEGIN TAG 02390C* GET COMP PART NO FROM SUSPENSE. 02400C MOVE ' ' A29 02410C MOVEA'IW' A29,3 02420C MOVEAA29 W29A 29 02430C*------------------------------------------------------------------- 02440C TAG5 TAG 02450C W29A SETLLSUSPENSE 02460C*------------------------------------------------------------------- 02470C TAG6 TAG 02480C SETOF 54 02490C READ SUSPENSE 54 02500C 54 GOTO ENDJOB ÐÐ02510C SPREC COMP 'IW' 54 02520C N54 GOTO ENDJOB 02530C SPSTAT COMP 'D' 54 02540C 54 GOTO TAG6 02550C ZERO10 LOKUPAPN 54 02560C 54 EXSR SR77 TITLE PAGE 02570C*------------------------------------------------------------------- 02580C TAG7 TAG 02590C Z-ADD1 C 30 02600C ZERO10 LOKUPAPN,C 54 02610C Z-ADD0 EGAP 30 02620C N54 SETON 82 02630C N54 EXCPT UPDATE SUSPENSE 02640C N54 SETOF 82 02650C N54 GOTO TAG6 02660C Z-ADDAPN,C COMPPN 100 02670C Z-ADD0 APN,C 02680C MOVELCOMPPN W12A 12 PMMST2 KEY 02690C Z-ADDCOMPPN NUMPN 100 02700C MOVELW12A NCPN 100 02710C EXSR SR81 GET PMMST. 02720C 60 GOTO TAG7 GOT IT. 02730C*-------------------------------------------------------------------- 02740C TAG10 TAG 02750C* PUT HEADING. DISPLAY COMPONENT DATA LINE. ÐÐ02760C Z-ADD1 QTY,2 02770C SETON 89 02780C EXSR SR71 PUT HEADING 02790C SETOF 89 02800C EXSR SR84 PRINT USAGE 02810C* SET-UP INITIAL BILL MATERIAL READ 02820C Z-ADD3 L 20 INDENTURE LEVEL 02830C MOVE BLK20 LEV 02840C MOVELCOMPPN LEV,2 02850C*----------------------------------------------------------------- 02860C TAG20 TAG 02870C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 02880C L SUB 1 L 54 INDENT LEVEL 02890C N54 GOTO TAG7 BOTTOM INDENT 02900C LEV,L COMP BLK20 54 02910C N54 GOTO TAG20 NONE THIS LEVEL 02920C 79 SETON 78 02930C SETON 79 02940C MOVE LEV,L W20A 20 02950C MOVELLEV,L CURASY 100 MATCH PART # 02960C MOVE BLK20 LEV,L 02970C Z-ADDQTY,L CUMQTY 70 02980C*------------------------------------------------------------------ 02990C TAG30 TAG 03000C* SET-UP NEXT READ ÐÐ03010C W20A SETLLBMWU 03020C*--------------------------------------------------------------- 03030C TAG40 TAG 03040C* GET NEXT COMPONENT. 03050C SETOF 54 03060C READ BMWU 54GET COMPONENT 03070C 54 GOTO TAG20 END OF FILE 03080C BWCPN COMP CURASY 54 03090C N54 GOTO TAG20 WRONG COMPONENT 03100C BWSTAT COMP 'D' 54 03110C 54 GOTO TAG40 DELETED RECORD 03120C* DISPLAY COMPONENT DATA 03130C EXSR SR72 DISPLAY DATA 03140C*------------------------------------------------------------------ 03150C TAG50 TAG 03160C* SAVE CUR LEVEL COMP/ASSEMBLY PART # 03170C MOVELBWCPN LEV,L 03180C 1 ADD BWAPN W10N 100 03190C MOVE W10N LEV,L 03200C Z-ADDCUMQTY QTY,L 03210C Z-ADDEXTQTY CUMQTY 03220C MOVE BWAPN CURASY 03230C MOVELBWAPN W20A 03240C MOVE ZERO10 W20A 03250C 1 ADD L L INDENT LEVEL ÐÐ03260C GOTO TAG30 03270C*------------------------------------------------------------------ 03280C ENDJOB TAG 03290C******************************************************************** 03300CSR SR66 BEGSR 03310CSR EXITFQCLF LF 03320CSR 1 ADD COUNT COUNT 30 03330CSR ENDSR 03340C******************************************************************** 03350CSR SR68 BEGSR 03360C* TOP OF FORM. 03370CSR EXITFZTFORM TOP FORM 03380CSR Z-ADD0 COUNT 03390CSR 1 ADD EGAP EGAP 03400CSR ENDSR 03410C******************************************************************** 03420CSR SR69 BEGSR 03430C* PRINT. 03440CSR PORT CHAINCRTFILE H9 03450CSR H9 GOTO ENDJOB 03460CSR MOVE ' ' REC 03470CSR EXCPT UPDATE CRTFILE 03480CSR SETOF 717275 03490CSR SETOF 767784 03500CSR EXSR SR66 LF ÐÐ03510CSR MOVEAREC W148A 148 03520CSR EXITFZD148 PRINT 03530CSR RLABL W148A 03540CSR ENDSR 03550C******************************************************************** 03560CSR SR71 BEGSR 03570C* CLEAR CRT. PUT HEADINGS. 03580CSR EXSR SR68 TOP FORM 03590CSR Z-ADD4 COUNT 30 LINE COUNT 03600CSR MOVELCOMPPN W12A 03610CSR MOVE ' ' W12A 03620CSR EXSR SR81 GET COMPONENT PMMST2 03630CSR SETON 71 03640CSR EXSR SR69 PUT HEADING 03650CSR EXSR SR66 LF 03660CSR PMMODL COMP BLK12 54 03670CSR 54 MOVE BLK35 PMDESC 03680CSR 54 MOVELPMMODL PMDESC 03690CSR 54 MOVE '***' PMDESC 03700CSR SETON 75 03710CSR EXSR SR69 PUT COMPONENT DATA 03720CSR ENDSR 03730C******************************************************************** 03740CSR SR72 BEGSR 03750C* DISPLAY DATA LINE TO CRT. ÐÐ03760CSR 1 ADD COUNT COUNT CRT LINE COUNT 03770CSR MOVELBWAPN W20A 03780CSR MOVE BWCPN W20A 03790CSR W20A CHAINBMMAST H7 03800CSR H7 GOTO END72 03810CSR MOVE BLK12 W12A 03820CSR MOVELBMAPN W12A ASSY PN 03830CSR EXSR SR81 GET PMMST2 03840CSR PMMODL COMP BLK12 54 03850CSR 54 MOVE BLK35 PMDESC 03860CSR 54 MOVELPMMODL PMDESC 03870CSR 54 MOVE '***' PMDESC 03880CSR L COMP 1 0101 03890CSR L COMP 2 02 03900CSR L COMP 3 03 03910CSR L COMP 4 04 03920CSR L COMP 5 05 03930CSR L COMP 6 06 03940CSR L COMP 7 07 07 03950CSR 01 Z-ADD1 L 03960CSR BMISSU COMP ' ' 55 03970CSR CUMQTY MULT BMQTY EXTQTY 70 03980CSR Z-ADDL LASTL 30 03990CSR 78 1 ADD COUNT COUNT 04000CSR 78 SETON 76 ÐÐ04010CSR 78 EXSR SR69 PUT DASH 04020CSR SETOF 78 04030CSR SETON 72 04040CSR EXSR SR69 PUT DATA. 04050CSR COUNT COMP 28 54 54 04060CSRN54 GOTO END72 NOT END PAGE 04070CSR EXSR SR71 PUT HEADINGS 04080CSR END72 ENDSR 04090C******************************************************************** 04100CSR SR77 BEGSR 04110C* PRINT TITLE PAGE. 04120CSR EXSR SR68 TOP FORM 04130CSR MOVE ' ' A29 04140CSR MOVE 'E' A29,1 04150CSR MOVEASPEMPL A29,2 04160CSR MOVEAA29 W14A 14 04170CSR W14A CHAINEMPLFILE 60 04180CSR 60 GOTO END77 04190CSR SPDEPT LOKUPTABDEP TABNAM 54 04200CSR MOVE TABNAM DEPNAM 17 04210CSR SETON 77 04220CSR EXSR SR69 PRINT 04230CSR END77 ENDSR 04240C******************************************************************** 04250CSR SR81 BEGSR ÐÐ04260C* GET PART MAST. 04270CSR MOVE ' ' W12A 04280CSR W12A CHAINPMMST2 60 GET PMMST. 04290CSRN60 PMSTAT COMP 'D' 61 FLAG DELETE. 04300CSR ENDSR 04310C******************************************************************** 04320CSR SR84 BEGSR 04330C* PRINT USAGE. 04340CSR NCPN CHAINMATLHIST 54 04350CSR 54 GOTO END84 04360CSR Z-ADD0 H 30 04370C*------------------------------------------------------------------- 04380CSR T84A TAG 04390CSR 1 ADD H H 04400CSR H COMP 12 54 04410CSR 54 GOTO END84 04420CSR Z-ADDUU,H USAGE 70 04430CSR PU,H ADD USAGE USAGE 04440CSR SR,H ADD USAGE USAGE 54 04450CSRN54 GOTO T84A 04460CSR SETON 84 04470CSR EXSR SR69 PRINT USAGE 04480CSR GOTO T84A 04490CSR END84 ENDSR 04500C******************************************************************** ÐÐ04510CSR SR101 BEGSR 04520C* INITIALIZE (1-TIME). 04530CSR MOVE BIT,1 N20 04540CSR MOVE BIT,1 A6 04550CSR MOVE BIT,1 NUL INIT NULL CHAR. 04560CSR MOVE '-' DASH 04570CSR MOVE ' ' BLK35 35 04580CSR MOVE ' ' BLK12 12 04590CSR MOVE ' ' BLK20 20 04600CSR Z-ADD0 ZERO10 100 04610CSR MOVE ' 'W8A 8 04620CSR Z-ADD0 W2N 20 04630CSR Z-ADD0 W1N 10 04640CSR MOVE ' ' W2A 2 04650CSR EXITFPGMINX GET PORT # 04660CSR RLABL W8A 04670CSR RLABL W2N 04680CSR RLABL W1N 04690CSR RLABL W2A 04700CSR MOVE W2A PORT 20 PORT # 04710CSR PORT COMP 0 54 04720CSRN54 Z-ADD25 PORT DEFAULT 04730CSR ENDSR 04740O******************************************************************** 04750OCRTFILE E 72 ÐÐ04760O* ASSY DATA LINE. 04770O REC 212 04780O 91 '.' 04790O 94 '.' 04800O 97 '.' 04810O 100 '.' 04820O 103 '.' 04830O 106 '.' 04840O 109 '.' 04850O 02 109 ' ' 04860O 03 109 ' ' 04870O L Z 82 04880O BMITNOZ 88 04890O 01 BMAPN 102 ' - - ' 04900O 02 BMAPN 105 ' - - ' 04910O 03 BMAPN 108 ' - - ' 04920O 04 BMAPN 111 ' - - ' 04930O 05 BMAPN 114 ' - - ' 04940O 06 BMAPN 117 ' - - ' 04950O 07 BMAPN 120 ' - - ' 04960O PMDESC 151 04970O BMQTY 2 162 04980O PMUM 166 04990O PMSC 172 05000O PMISSU 178 ÐÐ05010O 55 BMISSU 178 05020O PMPROV 183 05030O EXTQTY2 195 05040O PMSTDC 199 05050O PMFABC 205 05060O*------------------------------------------------------------------- 05070O E 76 05080O REC 212 05090O DASH 212 05100O*------------------------------------------------------------------- 05110O E 75 05120O* PUT COMPONENT LINE. 05130O REC 212 05140O 82 '1' 05150O COMPPN 102 ' - - ' 05160O N89 109 'CONT''D' 05170O PMDESC 151 05180O PMUM 166 05190O PMISSU 178 05200O PMSC 172 05210O PMPROV 183 05220O PMSTDC 199 05230O PMFABC 205 05240O*------------------------------------------------------------------- 05250O E 71 ÐÐ05260O* CLEAR SCREEN - LINE-1. 05270O REC 212 05280O 151 'INDENTED WHERE-USED' 05290O 164 'COMPONENT=' 05300O COMPPN 176 ' - - ' 05310O*------------------------------------------------------------------- 05320O E 71 05330O* HEADING, LINE-2. 05340O REC 212 05350O 106 '--------------INDENTURE' 05360O 120 '--------------' 05370O 162 'QUANTITY' 05380O 174 'SOURCE' 05390O 180 'ISSUE' 05400O 185 'PROV' 05410O 195 'EXTENDED' 05420O 200 'STD' 05430O 206 'FAB' 05440O*------------------------------------------------------------------- 05450O E 71 05460O* HEADING, LINE-3. 05470O REC 212 05480O 83 'LEV' 05490O 88 'ITEM' 05500O 109 '1 2 3 4 5 6 7' ÐÐ05510O 112 '-UP' 05520O 133 'DESCRIPTION' 05530O 162 'PER-ASSY' 05540O 166 'UM' 05550O 173 'CODE' 05560O 179 'CODE' 05570O 185 'CODE' 05580O 195 'QUANTITY' 05590O 201 'CODE' 05600O 207 'CODE' 05610O*------------------------------------------------------------------- 05620O E 77 05630O REC 212 05640O EENAME 190 05650O DEPNAM 212 05660O*------------------------------------------------------------------- 05670O E 84 05680O REC 212 05690O USAGE 2 212 05700O H Z 205 05710O******************************************************************** 05720OSUSPENSEE 82 05730O APN 109 05740O QAR 125P 05750O 128 'D' ÐÐ** NUL ARRAY 005760 005770** N20 ARRAY 005780 005790** A6 ARRAY 005800 005810** A12 ARRAY 005820 005830** LEV ARRAY 005840 005850** QTY ARRAY 005860 005870** DASH ARRAY 005880 005890** A29 ARRAY 005900 05910/* 05920_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(dB d*X044BM P*f999999120282(èÈÐ00010H Q044BM00020F* REPLACE COMPONENT, PHASE-2.(PHASE-1=Q043BM) (X044BM) 00030F* REVISED 2-10-83 11:30 AM. 00040FBITTAB IP F 33 DISK 00050FTERMFILEUC F 256R 8AI 1 DISK 00060FBMWU UC F 21R20AI 1 DISK A 00070FCRTFILE IC F 256R DISK 00080E******************************************************************** 00090E TAR 12 20 A 00100E BIT 33 1 00110I******************************************************************** 00120IBITTAB BT 00130I 1 33 BIT 00140I******************************************************************** 00150ITERMFILETF 00160I 9 248 TAR 00170I******************************************************************** 00180IBMWU BW 00190I 21 21 BWSTAT 00200I******************************************************************** 00210ICRTFILE CR 00220I 68 73 CRRET 00230I 74 79 CRMENU 00240C******************************************************************** 00250C* INITIALIZE 1-TIME. ÐÐ00260C EXSR SR101 00270C MOVE ' ' BLK20 20 STUPIDITY 00280C Z-ADD0 TCOUNT 40 00290C MOVELPORT KEY 8 00300C MOVEL'RC' W6A 6 00310C MOVE W6A KEY 00320C*------------------------------------------------------------------- 00330C START TAG 00340C 1 ADD TCOUNT TCOUNT 40 00350C MOVE TCOUNT KEY 00360C KEY CHAINTERMFILE 54 00370C 54 GOTO END 00380C Z-ADD1 T 30 00390C*------------------------------------------------------------------- 00400C TAG10 TAG 00410C BLK20 LOKUPTAR,T 54 00420C N54 SETON 82 00430C N54 EXCPT UPDATE TERMFILE 00440C N54 SETOF 82 00450C N54 GOTO START 00460C TAR,T CHAINBMWU 60 00470C SETON 81 00480C EXCPT 00490C SETOF 81 00500C MOVE BLK20 TAR,T ÐÐ00510C GOTO TAG10 00520C*------------------------------------------------------------------- 00530C END TAG 00540C MOVELCRRET PROG 8 00550C EXITFCHAIN 00560C RLABL PROG 00570C*------------------------------------------------------------------- 00580C ENDJOB TAG 00590C******************************************************************** 00600CSR SR101 BEGSR 00610C* INIT 1-TIME. 00620CSR MOVE ' ' W2A 2 00630CSR EXITFZGMINX GET PORT # 00640CSR RLABL W2A 00650CSR MOVE W2A PORT 20 00660CSR PORT COMP 0 54 00670CSRN54 Z-ADD25 PORT 00680CSR PORT CHAINCRTFILE H9 00690CSR H9 GOTO ENDJOB 00700CSR ENDSR 00710O******************************************************************** 00720OBMWU EADD 81 60 00730O TAR,T 20 00740O 21 'A' 00750O*------------------------------------------------------------------- ÐÐ00760O E 81N60 00770O 21 'A' 00780O******************************************************************** 00790OTERMFILEE 82 00800O TAR 248 /* 00810_‚ ÐÐ_‚_‚0O E 81N60 00770O 21 'A' 00780O******************************************************************** 00790OTERMFILEE 82 00800O TAR 248 /* 00810_‚ ÐÈ(„Ji „wX201SF P120282120282(èÈÐ00010H Q201SF00020F* SEQUENTIAL BATCH UPDATE, SCHEDULE FILE (SFMAST). (X201SF) 00030F* REVISED 7/24/81 11:10 AM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE UC F 256R DISK 00060FSFTRAN UC F 128R DISK 00070FSFMAST UD F 128L29AI 1 DISK 00080FPMMST2 UC F 674R12AI 1 DISK 00090FORDERLOGUD F 32L13AI 1 DISK 00100FALTKEY UD F 32L29AI 1 DISK 00110FSFEXCPTNUC F 11R10AI 1 DISK A 00120FSFTRAN2 UC F 40R DISK 00130FWOOPER UD F 64L14AI 1 DISK 00140FPOITEM UC F 384R 9AI 1 DISK 00150FTERM80 O F 80 5 00160E******************************************************************** 00170E A29 29 29 1 00180I**************************************************************** 00190IBITTAB BT 00200I 1 33 BIT 00210I**************************************************************** 00220ICRTFILE CR 00230I 81 850CRTRRN 00240I 86 900CRBRRN 00250I 91 950CRERRN ÐÐ00260I 96 1000CRNRRN 00270I******************************************************************** 00280IWOOPER WP 00290I 1 9 WPWO 00300I 64 64 WPSTAT 00310I******************************************************************** 00320ISFTRAN ST 01 17 C1 18 C0 125 CA 00330I AND 126 CS 127 C1 128NCD 00340I OR 02 17 C2 18 C0 125 CA 00350I AND 126 CS 127 C1 128NCD 00360I OR 03 17 C4 18 C0 125 CD 00370I AND 126 CS 127 C1 128NCD 00380I OR 04 17 C2 18 C0 125 CD 00390I AND 126 CS 127 C1 128NCD 00400I OR 05 17 C2 18 C0 125 CC 00410I AND 126 CS 127 C1 128NCD 00420I OR 06 17 C4 18 C0 125 CC 00430I AND 126 CS 127 C1 128NCD 00440I OR 07 17 C3 18 C0 125 CA 00450I AND 126 CS 127 C1 128NCD 00460I* TRANSACTION FILE 00470I* 01 = REDUCE PO (RECD PO ADD TRAN) 00480I* 02 = DELETE PLANNED REQUIREMENTS (REL WO ADD TRAN) 00490I* 03 = DELETE PLANNED REQUIREMENTS (PLAN WO DEL TRAN) 00500I* 04 = DELETE RELEASED REQUIREMENTS (REL WO DEL TRAN) ÐÐ00510I* 05 = REL REQUIREMENT CHANGE (REL WO CHANGE TRAN) 00520I* 06 = PLAN REQUIREMENT DELETE (PLAN WO CHANGE TRAN) 00530I* 07 = PURCH REQ DELETE (PO ADD) 00540I* 18 = NOT PROCESSED BY THIS PROG 00550I* COMMON DATA FIELDS 00560I* KEY AREA. 00570I* PART NO. 10A 00580I 1 10 STPN 00590I* DATE DUE 6N (YMD) 00600I 11 160STDUE 00610I* RECORD CODE 2A 00620I* 10 = RECEIVED PO 00630I* 20 = REL WO 00640I* 30 = PURCHASE ORDER 00650I* 40 = PLAN WO 00660I* 50 = PURCHASE REQ 00670I* 60 = SALES ORDER-BACKLOG 00680I* 70 = REL REQUIREMENT 00690I* 80 = PLAN REQUIREMENT 00700I* 90 = RUN RELEASE 00710I 17 18 STREC 00720I* ORDER NO. 9A 00730I 19 27 STORD 00740I* PREFIX 1A 00750I 19 19 STPRFX ÐÐ00760I* PRIME 6A 00770I 19 24 STPRIM 00780I* ITEM 3N 00790I 25 270STITEM 00800I* RECEIVING LOG # 00810I 28 290STRLOG 00820I* QUANTITY 7P 00830I P 30 330STQTY 00840I* QTY COMPLETE 7P 00850I P 34 370STQTYC 00860I* DATE LAST TRAN 6N (YMD) 00870I 38 430STDLT 00880I* CUST #/DEPT #/VEND # 3P 00890I P 44 460STCUST 00900I* PLAN/REL REQMTS. 00910I* NEXT ASSY PART # 10N 00920I 47 560STNAPN 00930I* QTY PER ASSY 7P 00940I P 57 600STQPA 00950I* ISSUE CODE 2A 00960I 61 62 STISSU 00970I* PULL # 3P 00980I P 63 640STPULL 00990I* ASSY REVISION 2A 01000I 65 66 STREV ÐÐ01010I* ASSY WO QTY 7P 01020I P 67 700STQTYA 01030I* SALES ORDERS 01040I* CUST P.O. 20A 01050I 71 90 STCPO 01060I* UNIT PRICE 9.3P 01070I P 91 953STPRIC 01080I* PURCH ORDERS 01090I* VENDOR NAME 20A 01100I* SEE SFCPO UNDER SALES ORDERS. 01110I* UNIT PRICE 9.3P 01120I* SEE SFPRIC UNDER SALES ORDERS. 01130I* PURCH REQ # 9A 01140I 105 113 STPREQ 01150I* WORK ORDERS 01160I* REVISION 2A 01170I* SEE PLAN/REL REQMTS. 01180I* DEPT NAME 20A 01190I* SEE SFCPO UNDER SALES ORDERS. 01200I* OPER SEQ # 3P 01210I P 96 970STSEQ 01220I* START DATE 6N 01230I 98 1030STSTRT 01240I* PULL # 3P 01250I* SEE PLAN/REL REQMTS. ÐÐ01260I* REQUIREMENT FLAG 1A 01270I 104 104 STRFLG 01280I* PLAN WORK ORDER DUE DATE 6A 01290I* --- SEE ABOVE ----------------105 113 PREQNO 01300I* TERMINAL # 2N 01310I 123 1240STTERM 01320I* TRAN CODE 1A 01330I* A = ADD 01340I* C = CHANGE 01350I* D = DELETE 01360I* # = DELETE ALL 01370I* E = EXPLODE 01380I* V = CONVERT 01390I 125 125 STTRAN 01400I* FILE CODE 1A 01410I* S = SFMAST 01420I* A = ALTKEY 01430I* B = BOTH 01440I 126 126 STFILE 01450I* PHASE CODE 1A 01460I 127 127 STPHAS 01470I* RECORD STATUS 1A 01480I 128 128 STSTAT 01490I*------------------------------------------------------------------- 01500I GG 18 ÐÐ01510I******************************************************************* 01520ISFTRAN2 SR 01530I 1 29 BLKREC 01540I******************************************************************** 01550IORDERLOGOL 01560I 1 2 OLREC 01570I 3 11 OLORD 01580I 14 23 OLPN 01590I 24 29 OLDUE 01600I 32 32 OLSTAT 01610I******************************************************************** 01620ISFMAST SF 01630I* SCHEDULE MASTER. 01640I* COMMON FIELDS. 01650I* KEY AREA. 01660I 1 29 SFKEY 01670I* PART NO. 10A 01680I 1 10 SFPN 01690I* DATE DUE 6N (YMD) 01700I 11 16 SFDUE 01710I* RECORD CODE 2N 01720I* 10 = RECEIVED PO 01730I* 20 = REL WO 01740I* 30 = PURCHASE ORDER 01750I* 40 = PLAN WO ÐÐ01760I* 50 = PURCHASE REQ 01770I* 60 = SALES ORDER-BACKLOG 01780I* 70 = REL REQUIREMENT 01790I* 80 = PLAN REQUIREMENT 01800I* 90 = RUN RELEASE 01810I 17 18 SFREC 01820I* ORDER NO. 9A 01830I 19 27 SFORD 01840I* PREFIX 1A 01850I 19 19 SFPRFX 01860I* PRIME 6A 01870I 19 24 SFPRIM 01880I* ITEM 3N 01890I 25 270SFITEM 01900I* RECEVING LOG # 01910I 28 29 SFRLOG 01920I* QUANTITY 7P 01930I P 30 330SFQTY 01940I* QTY COMPLETE 7P 01950I P 34 370SFQTYC 01960I* DATE LAST TRAN 6N (YMD) 01970I 38 430SFDLT 01980I* CUST #/DEPT #/VEND # 5P 01990I P 44 460SFCUST 02000I* PLAN/REL REQMTS. ÐÐ02010I* NEXT ASSY PART # 10N 02020I 47 560SFNAPN 02030I* QTY PER ASSY 7P 02040I P 57 600SFQPA 02050I* ISSUE CODE 2A 02060I 61 62 SFISSU 02070I* PULL # 3P 02080I P 63 640SFPULL 02090I* ASSY REVISION 2A 02100I 65 66 SFREV 02110I* ASSY WO QTY 7P 02120I P 67 700SFQTYA 02130I* SALES ORDERS 02140I* CUST P.O. 20A 02150I 71 90 SFCPO 02160I* UNIT PRICE 9.3P 02170I P 91 953SFPRIC 02180I* PURCH ORDERS 02190I* VENDOR NAME 20A 02200I* SEE SFCPO UNDER SALES ORDERS. 02210I* UNIT PRICE 9.3P 02220I* SEE SFPRIC UNDER SALES ORDERS. 02230I* WORK ORDERS 02240I* DEPT NAME 20A 02250I* SEE SFCPO UNDER SALES ORDERS. ÐÐ02260I* OPER SEQ # 3P 02270I P 96 970SFSEQ 02280I* START DATE 6N 02290I 98 1030SFSTRT 02300I* PULL # 3P 02310I* SEE PLAN/REL REQMTS. 02320I* REQUIREMENT FLAG 1A 02330I 104 104 SFRFLG 02340I* REVISION 2A 02350I* SEE PLAN/REL REQMTS. 02360I* IN USE--- SEE ABOVE... 105 113 02370I* AVL BAL 7P 02380I P 124 1270SFAVQ 02390I* RECORD STATUS 1A 02400I 128 128 SFSTAT 02410I******************************************************************** 02420IPMMST2 PM 02430I 1 10 PMPN 02440I 15 180PMPL 02450I 19 30 PMMODL 02460I 31 59 PMDESC 02470I 70 71 PMECHG 02480I 94 95 PMSC 02490I* ON HAND BAL 02500I P 311 3140PMOHB ÐÐ02510I* REL REQS 7P 02520I P 323 3260PMRLB 02530I* PURCH REQ BAL 7P 02540I P 339 3420PMPRB 02550I* PO BAL 02560I P 343 3460PMPOB 02570I* PLAN REQMT BAL 02580I P 319 3220PMALB 02590I 674 674 PMSTAT 02600I*------------------------------------------------------------------- 02610I GG 22 02620I******************************************************************** 02630IALTKEY AK 21 1 CA 02640I OR 22 1 CB 02650I OR 25 1 CE 02660I OR 26 1 CF 02670I* ALTERNATE KEY FILE FOR SFMAST. 02680I* COL-1 DEFINITIONS 02690I* A = ORDER ALT KEY FILE 02700I* B = DUE DATE ALT KEY FILE 02710I* E = START DATE ALT KEY FILE 02720I* COL-2 DEFINITIONS. 02730I* 1 = RECD PO 02740I* 3 = PO 02750I* 5 = PUR REQ ÐÐ02760I* 6 = SALES ORDER 02770I* 7 = REL REQMT 02780I* 8 = PLAN REQMT 02790I* 9 = FORECAST 02800I* W = WORK ORDER (PLAN OR RELEASED) 02810I* COMMON FIELDS. 02820I* RECORD CODE (SEE ABOVE) 2A 02830I 1 2 OLREC 02840I* RECORD STATUS 1A 02850I 32 32 OLSTAT 02860I 1 29 OLFILE 02870I* NON-COMMON FIELDS. 02880I*------------------------------------------------------------------- 02890I* REQUIREMENT ORDER ALT-KEY - 02900I* KEY AREA. 02910I* ORDER 9A 02920I 3 11 OLORD 21 02930I* PART # 10A 02940I 14 23 OLPN 21 02950I* DUE DATE 6A 02960I 24 29 OLDUE 21 02970I*------------------------------------------------------------------- 02980I* DUE DATE ALT-KEY - 02990I* KEY AREA. 03000I* DUE DATE 6N ÐÐ03010I 3 8 AKDUE 22 03020I* PART NO. 10N 03030I 9 18 AKPN 22 03040I* ORDER NO. 9A 03050I 19 27 AKORD 22 03060I* PREFIX 1A 03070I 19 19 AKPRFX 22 03080I* PRIME 5N 03090I 19 24 AKPRIM 22 03100I* ITEM 3N 03110I 25 270AKITEM 22 03120I* RECEIVING LOG # 03130I 28 29 AKRLOG 22 03140I*------------------------------------------------------------------- 03150I* START DATE ALT-KEY - 03160I* KEY AREA. 03170I* START DATE 6N 03180I 3 80AKSTRD 25 03190I* PART NO. 10N 03200I 9 18 AKPN 25 03210I* ORDER NO. 9A 03220I 19 27 AKORD 25 03230I* PREFIX 1A 03240I 19 19 AKPRFX 25 03250I* PRIME 5N ÐÐ03260I 19 24 AKPRIM 25 03270I* ITEM 3N 03280I 25 270AKITEM 25 03290I* RECEIVING LOG # 2N 03300I 28 29 AKRLOG 25 03310I******************************************************************** 03320ISFEXCPTNSE 03330I 1 100SEPN 03340I******************************************************************** 03350IPOITEM PI 03360I P 86 890PIQRCD 03370C********************************************************************* 03380C* INITIALIZE 1-TIME. 03390C EXSR SR101 INIT 03400C*------------------------------------------------------------- 03410C START TAG 03420C* GET TRANSACTION 03430C SETOF 010203 03440C SETOF 040506 03450C SETOF 0718 03460C CRTRRN CHAINSFTRAN H8 03470C H8 GOTO ENDJOB 03480C 18 GOTO START GARBAGE 03490C SETOF 48 03500C* SELECT RECORDS FOR THIS TERMINAL ÐÐ03510C STTERM COMP PORT 54 03520C N54 PORT COMP 25 54 03530C N54 SETOF 010203 03540C N54 SETOF 040506 03550C N54 SETOF 07 03560C N54 SETON 18 03570C N54 GOTO START WRONG TERMINAL 03580C* SET REQUIREMENT FLAG. 03590C 02 03600COR 04 03610COR 05 03620COR 06 STRFLG COMP 'S' 48 03630C* BRANCH ON RECORD TYPE. 03640C 01 GOTO TAG10 RPO ADD 03650C 02 GOTO TAG20 RWO ADD 03660C 03 GOTO TAG30 PWO DEL 03670C 04 GOTO TAG40 RWO DEL 03680C 05 GOTO TAG50 RWO CHG 03690C 06 GOTO TAG60 PWO CHG 03700C 07 GOTO TAG70 PO ADD 03710C GOTO START 03720C*------------------------------------------------------------------- 03730C TAG10 TAG 03740C* RECEIVED PO ADD. 03750C EXSR SR102 REDUCE PO'S ÐÐ03760C MOVE 'D' STSTAT 03770C EXSR SR80 UPD SFTRAN 03780C GOTO END 03790C*------------------------------------------------------------------- 03800C TAG20 TAG 03810C* RELEASED WO ADD. 03820C EXSR SR110 DELETE PLAN RQMT 03830C MOVE '2' STPHAS 03840C EXSR SR80 UPD SFTRAN 03850C GOTO END 03860C*------------------------------------------------------------------- 03870C TAG30 TAG 03880C* PLAN WORK ORDER DELETE. 03890C EXSR SR110 DELETE PLAN RQMT 03900C MOVE 'D' STSTAT 03910C EXSR SR80 UPD SFTRAN 03920C GOTO END 03930C*------------------------------------------------------------------- 03940C TAG40 TAG 03950C* RELEASED WORK ORDER DELETE. 03960C EXSR SR115 DELETE REL RQMT 03970C MOVE 'D' STSTAT 03980C EXSR SR80 UPD SFTRAN 03990C EXSR SR116 DELETE WOOPER 04000C GOTO END ÐÐ04010C*------------------------------------------------------------------- 04020C TAG50 TAG 04030C* RELEASED WORK ORDER CHANGE. 04040C EXSR SR115 UPD REL REQMT 04050C MOVE 'D' STSTAT 04060C EXSR SR80 UPD SFTRAN 04070C GOTO END 04080C*------------------------------------------------------------------- 04090C TAG60 TAG 04100C* PLAN W.O. CHANGE. 04110C EXSR SR110 DELETE PLAN RQMT 04120C MOVE '2' STPHAS 04130C EXSR SR80 UPD SFTRAN 04140C GOTO END 04150C*------------------------------------------------------------------- 04160C TAG70 TAG 04170C* P.O. ADD. 04180C EXSR SR120 DEL PUR REQS 04190C MOVE 'D' STSTAT 04200C EXSR SR80 UPD SFTRAN 04210C GOTO END 04220C*------------------------------------------------------------------ 04230C TAG80 TAG 04240C* PLANNED WORK ORDER ADD 04250C MOVE '2' STPHAS ÐÐ04260C EXSR SR80 UPD SFTRAN 04270C GOTO END 04280C*------------------------------------------------------------------- 04290C END TAG 04300C SETON 97 04310C EXCPT 04320C SETOF 97 04330CLR MOVEL'Q010SF' PROG 8 PROG LOADER 04340CLR EXITFCHAIN 04350CLR RLABL PROG 04360C*------------------------------------------------------------------ 04370CLR ENDJOB TAG 04380C******************************************************************** 04390CSR SR80 BEGSR 04400C* UPDATE SFTRAN FILE 04410CSR SETON 80 04420CSR EXCPT UPDATE SFTRAN 04430CSR SETOF 80 04440CSR ENDSR 04450C******************************************************************* 04460CSR SR81 BEGSR 04470C* GET PART MASTER 04480CSR MOVE ' ' W12A 12 04490CSR W12A CHAINPMMST2 60 GET PART MASTER 04500CSRN60 PMSTAT COMP 'D' 60 FLAG DELETED ÐÐ04510CSR ENDSR 04520C****************************************************************** 04530CSR SR82 BEGSR 04540C* UPDATE SFMAST 04550CSR SFPN CHAINSFEXCPTN 50 04560CSR SFREC COMP '70' 13 FLAG REQMT 04570CSRN13 SFREC COMP '80' 13 FLAG REQMT 04580CSR SFREC COMP '20' 14 FLAG WO 04590CSRN14 SFREC COMP '40' 14 FLAG WO 04600CSR SFREC COMP '10' 15 FLAG PURCH 04610CSRN15 SFREC COMP '30' 15 FLAG PURCH 04620CSRN15 SFREC COMP '50' 15 FLAG PURCH 04630CSR SETON 82 04640CSR EXCPT UPDATE SFMAST 04650CSR SETOF 82 04660CSR ENDSR 04670C******************************************************************* 04680CSR SR83 BEGSR 04690C* UPDATE ORDERLOG FILE 04700CSR SETON 83 04710CSR EXCPT UPDATE ORDERLOG 04720CSR SETOF 83 04730C* 04740CSR ENDSR 04750C******************************************************************* ÐÐ04760CSR SR84 BEGSR 04770C* UPDATE ALTKEY 04780CSR SETON 84 04790CSR EXCPT UPDATE ALTKEY 04800CSR SETOF 84 04810CSR ENDSR 04820C****************************************************************** 04830CSR SR85 BEGSR 04840C* UPDATE PART MASTER 04850CSR SETON 85 04860CSR EXCPT UPDATE PART MAST 04870CSR SETOF 85 04880CSR ENDSR 04890C****************************************************************** 04900CSR SR86 BEGSR 04910C* FIND BLANK SFTRAN2 RECORD AND OUTPUT 04920CSR 1 ADD CRNRRN CRNRRN 50 04930CSR CRNRRN CHAINSFTRAN2 54 04940CSR 54 Z-ADD0 CRNRRN 04950CSR 54 GOTO SR86 04960CSR BLKREC COMP BLK29 54 04970CSR 54 GOTO SR86 NOT BLANK 04980CSRN87 Z-ADDCRNRRN CRBRRN 04990CSR Z-ADDCRNRRN CRERRN 05000CSR SETON 8687 ÐÐ05010CSR EXCPT OUTPUT SFTRAN2 05020CSR SETOF 86 05030CSR ENDSR 05040C******************************************************************** 05050CSR SR87 BEGSR 05060C* GET/DELETE ALTKEY DUE DATE RECORD 05070CSR MOVE ' ' A29 05080CSR MOVE 'B' A29,1 05090CSR MOVELSFREC A29,2 05100CSR MOVEASFDUE A29,3 05110CSR MOVEASFPN A29,9 05120CSR MOVEASFORD A29,19 05130CSR MOVEASFRLOG A29,28 05140CSR MOVEAA29 W29A 05150CSR W29A SETLLALTKEY 05160CSR SETOF 54 05170CSR READ ALTKEY 54 05180CSR 54 GOTO END87 05190CSR AKPN COMP SFPN 54 05200CSR 54 AKDUE COMP SFDUE 54 05210CSR 54 AKORD COMP SFORD 54 05220CSR 54 MOVEAA29,1 W2A 2 05230CSR 54 OLREC COMP W2A 54 05240CSRN54 GOTO END87 05250CSR MOVE 'D' OLSTAT ÐÐ05260CSR EXSR SR84 DELETE AK-DUE 05270CSR END87 ENDSR 05280C********************************************************************** 05290CSR SR88 BEGSR 05300C* GET/DELETE ORDERLOG 05310CSR MOVE ' ' A29 05320CSR MOVEASFREC A29,1 05330CSR MOVEASFORD A29,3 05340CSR MOVEAA29,1 W13A 13 05350CSR W13A SETLLORDERLOG 05360CSR SETOF 54 05370CSR READ ORDERLOG 54 05380CSR 54 GOTO END88 05390CSR OLREC COMP SFREC 54 05400CSR 54 OLORD COMP SFORD 54 05410CSR 54 MOVE 'D' OLSTAT 05420CSR 54 EXSR SR83 DELETE ORDERLOG 05430CSR END88 ENDSR 05440C******************************************************************** 05450CSR SR97 BEGSR 05460C* UPDATE CRTFILE. 05470CSR MOVE ' ' W8A 8 05480CSR Z-ADD0 W2N 20 05490CSR Z-ADD0 W1N 10 05500CSR MOVE ' ' W2A 2 ÐÐ05510CSR EXITFPGMINX GET PORT # 05520CSR RLABL W8A 05530CSR RLABL W2N 05540CSR RLABL W1N 05550CSR RLABL W2A 05560CSR MOVE W2A PORT 20 PORT NO. 05570CSR PORT COMP 0 54 05580CSRN54 Z-ADD25 PORT DEFAULT 05590CSR ENDSR 05600C******************************************************************** 05610CSR SR101 BEGSR 05620C* 1-TIME INIT 05630CSR SETON 72 05640CSR EXCPT TERMINAL MSG 05650CSR SETOF 72 05660CSR EXSR SR97 GET PORT # 05670CSR PORT CHAINCRTFILE H9 05680CSR H9 GOTO ENDJOB PROG ERROR 05690CSR MOVE ' ' BLK29 29 05700CSR END101 ENDSR 05710C*********************************************************************** 05720CSR SR102 BEGSR 05730C* RECEIVED P.O. ADD - REDUCE OPEN P.O.'S. 05740CSR STQTY SUB STQTYC QTY 70 54 05750CSRN54 GOTO END102 ÐÐ05760CSR MOVELSTORD W9A 9 05770CSR W9A CHAINPOITEM 54 05780CSRN54 STQTY ADD PIQRCD PIQRCD 05790CSRN54 SETON 88 05800CSRN54 EXCPT UPDATE POITEM 05810CSR SETOF 88 05820CSR MOVE ' ' A29 05830CSR MOVE STPN W10A 10 05840CSR MOVEAW10A A29 05850CSR MOVEAA29 W29A 29 05860CSR W29A SETLLSFMAST 05870C*------------------------------------------------------------------- 05880CSR T102A TAG 05890CSR SETOF 54 05900CSR READ SFMAST 54 05910CSR 54 GOTO END102 05920CSR SFPN COMP STPN 54 05930CSRN54 GOTO END102 05940CSR SFSTAT COMP 'D' 54 05950CSR 54 GOTO T102A 05960CSR SFREC COMP '30' 54 05970CSR 54 STORD COMP SFORD 54 05980CSRN54 GOTO T102A 05990CSR SFQTY SUB SFQTYC W7N 70 54 06000CSRN54 GOTO T102A ÐÐ06010CSR SETOF 575859 06020C*------------------------------------------------------------------- 06030CSR T102C TAG 06040CSR MOVELSFPN W12A 12 06050CSR EXSR SR81 GET PMMST2 06060CSR 60 GOTO END102 06070CSR QTY COMP W7N 545556 06080CSR 54 QTY SUB W7N QTY 57 06090CSR 54 PMPOB SUB W7N PMPOB 06100CSR 54 W7N ADD SFQTYC SFQTYC 58 06110CSR 54 Z-ADD0 W7N 59 06120CSR 55 W7N SUB QTY W7N 59 06130CSR 55 PMPOB SUB QTY PMPOB 06140CSR 55 QTY ADD SFQTYC SFQTYC 58 06150CSR 55 Z-ADD0 QTY 57 06160CSR 56 QTY ADD SFQTYC SFQTYC 58 06170CSR 56 PMPOB SUB QTY PMPOB 06180CSR 56 Z-ADD0 QTY 57 06190CSR 56 Z-ADD0 W7N 59 06200CSR EXSR SR82 UPDATE SFMAST 06210CSR EXSR SR85 UPDATE PMMST2 06220CSR 57 GOTO T102A 06230CSR END102 ENDSR 06240C********************************************************************** 06250CSR SR110 BEGSR ÐÐ06260C* PLANNED WORK ORDER CHANGE/DELETE TRANS 06270C* - OR - 06280C* RELEASED WORK ORDER ADD TRANS. 06290C*----------------------- 06300C* DELETE PLANNED REQUIREMENT 06310C* - AND - 06320C* GEN SFTRAN2 FILE RECORD, IF STRFLG = S. 06330CSR MOVE ' ' A29 06340CSR MOVEA'A8' A29,1 06350CSR MOVEASTORD A29,3 06360CSR MOVEAA29 W29A 06370CSR W29A SETLLALTKEY 06380C*-------------------------------------------------------------------- 06390CSR T110A TAG 06400CSR SETOF 54 06410CSR READ ALTKEY 54 06420CSR 54 GOTO END110 END OF FILE 06430CSR OLREC COMP 'A8' 54 06440CSR 54 OLORD COMP STORD 54 06450CSRN54 GOTO END110 NO MATCH 06460CSR OLSTAT COMP 'D' 54 06470CSR 54 GOTO T110A DELETED RECORD 06480CSR MOVE ' ' A29 06490CSR MOVEAOLPN A29,1 06500CSR MOVEAOLDUE A29,11 ÐÐ06510CSR MOVEA'80' A29,17 06520CSR MOVEAOLORD A29,19 06530CSR MOVEA'00' A29,28 06540CSR MOVEAA29 W29A 29 06550C* 06560CSR W29A SETLLSFMAST 06570CSR SETOF 54 06580CSR READ SFMAST 54GET SFMAST 06590CSR 54 GOTO T110A END OF FILE 06600CSR SFORD COMP OLORD 54 06610CSR 54 SFREC COMP '80' 54 06620CSRN54 GOTO T110A NO MATCH 06630CSR MOVELSFPN W12A 12 06640CSR EXSR SR81 GET PART MAST 06650CSR SFQTY SUB SFQTYC QTY 54 06660CSRN54 Z-ADD0 QTY 06670CSRN60 PMALB SUB QTY PMALB ALLOCATED BAL 06680CSRN60 EXSR SR85 UPDATE PART MAST 06690CSR MOVE 'D' SFSTAT 06700CSR MOVE 'D' OLSTAT 06710CSR EXSR SR82 DELETE SFMAST 06720CSR EXSR SR84 DELETE AK-ORDER 06730C* OUTPUT SFTRAN2 RECORD TO CONVERT PLAN REQUIREMENTS 06740CSR 02 48 REL WO ADD W/RQMT FLG06750COR 06 48 EXSR SR86 PLAN " " " " ÐÐ06760CSR MOVE OLFILE SAVEOL 29 06770CSR EXSR SR87 DELETE AK-DUE 06780CSR SAVEOL SETLLALTKEY 06790CSR GOTO T110A 06800CSR END110 ENDSR 06810C******************************************************************** 06820CSR SR115 BEGSR 06830C* RELEASED WORK ORDER CHANGE/DELETE TRANS 06840C* DELETE REL RQMT. 06850CSR MOVE ' ' A29 06860CSR MOVEA'A7' A29,1 06870CSR MOVEASTORD A29,3 06880CSR MOVEAA29 W29A 06890CSR W29A SETLLALTKEY 06900C*-------------------------------------------------------------------- 06910CSR T115A TAG 06920CSR SETOF 54 06930CSR READ ALTKEY 54 06940CSR 54 GOTO END115 END OF FILE 06950CSR OLREC COMP 'A7' 54 06960CSR 54 OLORD COMP STORD 54 06970CSRN54 GOTO END115 NO MATCH 06980CSR OLSTAT COMP 'D' 54 06990CSR 54 GOTO T115A DELETED RECORD 07000CSR MOVE ' ' A29 ÐÐ07010CSR MOVEAOLPN A29,1 07020CSR MOVEAOLDUE A29,11 07030CSR MOVEA'70' A29,17 07040CSR MOVEAOLORD A29,19 07050CSR MOVEA'00' A29,28 07060CSR MOVEAA29 W29A 29 07070C* 07080CSR W29A SETLLSFMAST 07090CSR SETOF 54 07100CSR READ SFMAST 54GET SFMAST 07110CSR 54 GOTO T115A END OF FILE 07120CSR SFORD COMP OLORD 54 07130CSR 54 SFREC COMP '70' 54 07140CSRN54 GOTO T115A NO MATCH 07150CSR MOVELSFPN W12A 12 07160CSR EXSR SR81 GET PART MAST 07170C* DELETE RELEASED REQUIREMENT. IF CHANGE TRAN, PUT OUT SFTRAN2 RECORD. 07180CSR SFQTY SUB SFQTYC QTY 54 07190CSRN54 GOTO T115A NO OPEN QTY 07200CSRN60 PMRLB SUB QTY PMRLB ALLOCATED BAL 07210CSRN60 EXSR SR85 UPDATE PART MAST 07220CSR MOVE 'D' SFSTAT 07230CSR MOVE 'D' OLSTAT 07240CSR EXSR SR82 DELETE SFMAST 07250CSR EXSR SR84 DELETE AK-ORDER ÐÐ07260CSR 05 EXSR SR86 OUTPUT SFTRAN2 07270CSR MOVE OLFILE SAVEOL 07280CSR EXSR SR87 DELETE AK-DUE 07290CSR SAVEOL SETLLALTKEY 07300CSR GOTO T115A 07310CSR END115 ENDSR 07320C******************************************************************** 07330CSR SR116 BEGSR 07340C* DELETE WOOPER. 07350CSR MOVELSTORD W14A 14 07360CSR MOVE '0000' W14A 07370CSR W14A SETLLWOOPER 07380C*------------------------------------------------------------------- 07390CSR T116A TAG 07400CSR SETOF 54 07410CSR READ WOOPER 54 07420CSR 54 GOTO END116 07430CSR WPWO COMP STORD 54 07440CSRN54 GOTO END116 07450CSR WPSTAT COMP 'D' 54 07460CSR 54 GOTO T116A 07470CSR SETON 81 07480CSR EXCPT DELETE WOOPER 07490CSR SETOF 81 07500CSR GOTO T116A ÐÐ07510CSR END116 ENDSR 07520C******************************************************************** 07530CSR SR120 BEGSR 07540C* DELETE PURCH REQ (PO-ADD) 07550CSR MOVE ' ' A29 07560CSR MOVEASTPN A29,1 07570CSR MOVEAA29 W29A 29 07580CSR W29A SETLLSFMAST 07590C*-------------------------------------------------------------------- 07600CSR T120A TAG 07610CSR SETOF 54 07620CSR READ SFMAST 54GET SFMAST 07630CSR 54 GOTO END120 END OF FILE 07640CSR SFPN COMP STPN 54 07650CSRN54 GOTO END120 07660CSR SFREC COMP '50' 54 07670CSRN54 GOTO T120A 07680CSR SFSTAT COMP 'D' 54 07690CSR 54 GOTO T120A 07700CSR STPREQ COMP SFORD 54 07710CSRN54 GOTO T120A 07720CSR MOVELSFPN W12A 07730CSR EXSR SR81 GET PART MAST 07740CSR SFQTY SUB SFQTYC QTY 54 07750CSRN54 Z-ADD0 QTY ÐÐ07760CSRN60 PMPRB SUB QTY PMPRB PUR REQ BAL 07770CSRN60 EXSR SR85 UPD PART MAST 07780CSR MOVE 'D' SFSTAT 07790CSR EXSR SR82 DELETE SFMAST 07800CSR EXSR SR87 GET/DELETE AK-DUE 07810CSR MOVE '50' W2A 2 07820CSR EXSR SR88 GET/DELETE ORDERLOG 07830CSR GOTO T120A 07840CSR END120 ENDSR 07850O******************************************************************** 07860OSFTRAN E 80 07870O* SCHEDULE FILE BATCH TRANSACTION FILE 07880O STQTY 33P 07890O STQTYC 37P 07900O STCUST 46P 07910O STQPA 60P 07920O STPULL 64P 07930O STPRIC 95P 07940O STSEQ 97P 07950O STQTYA 70P 07960O STPHAS 127 07970O STSTAT 128 07980O******************************************************************** 07990OWOOPER E 81 08000O 64 'D' ÐÐ08010O******************************************************************** 08020OORDERLOGE 83 08030O OLSTAT 32 08040O******************************************************************* 08050OALTKEY E 84 08060O OLSTAT 32 08070O******************************************************************** 08080OSFTRAN2 E 86 08090O SFKEY 29 08100O CRTRRN 34 08110O* 08120O******************************************************************** 08130OSFMAST E 82 08140O SFQTY 33P 08150O SFQTYC 37P 08160O SFCUST 46P 08170O SFQPA 60P 08180O SFPULL 64P 08190O SFQTYA 70P 08200O SFPRIC 95P 08210O SFSEQ 97P 08220O SFAVQ 127P 08230O SFSTAT 128 08240O******************************************************************** 08250OSFEXCPTNEADD 82 50 ÐÐ08260O SFPN 10 08270O 11 'A' 08280O*------------------------------------------------------------------- 08290O E 82N50 08300O 11 'A' 08310O******************************************************************** 08320OPMMST2 E 85 08330O PMOHB 314P 08340O PMPOB 346P 08350O PMALB 322P 08360O PMRLB 326P 08370O PMPRB 342P 08380O******************************************************************** 08390OPOITEM E 88 08400O PIQRCD 89P 08410O******************************************************************** 08420OCRTFILE E 97 08430O CRBRRN 90 08440O CRERRN 95 08450O CRNRRN 100 08460O******************************************************************** 08470OTERM80 E 72 U1 08480O 19 '2NDARY-UPDATE,' 08490O 27 'PHASE-2' 08500O********************************************************************* ÐÐ** A29 ARRAY 008510 008520/* 008530_‚ ÐÐ ÐÐ_‚_‚ ÐÈ( Ká  NX202SF P120282120282(èÈÐ00010H Q202SF00020F* EXPLODE WORK ORDER REQUIREMENTS. (X202SF) 00030F* REVISED 7/06/81 2:35 PM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060FSFTRAN UC F 128R DISK 00070FSFMAST UC F 128R29AI 1 DISK A 00080FALTKEY UC F 32R29AI 1 DISK A 00090FPMMST2 UC F 674R12AI 1 DISK 00100FBMMAST ID F 86L20AI 1 DISK 00110FSFEXCPTNUC F 11R10AI 1 DISK A 00120FWOOPER UC F 64R14AI 1 DISK A 00130FTERM132 O F 132 5 00140E******************************************************************** 00150E A29 29 29 1 00160E LEV 1 20 20 00170E QTY 1 20 7 0 00180E MHR 12 7 3A MFG ROUT HRS 00190E MDP 12 3 0 MFG ROUT DEPT 00200I****************************************************************** 00210IBITTAB BT 00220I 1 33 BIT 00230I***************************************************************** 00240ICRTFILE CR 00250I 81 850CRRRN ÐÐ00260I******************************************************************** 00270ISFTRAN ST 02 17 C2 18 C0 125 CA 00280I AND 126 CS 127 C2 128NCD 00290I AND 104NCS 00300I OR 06 17 C4 18 C0 125 CC 00310I AND 126 CS 127 C2 128NCD 00320I OR 18 00330I* RANDOM UPDATE TRAN FILE 00340I* INDICATOR TRANSACTION 00350I* 06 EXPLODE PLANNED REQUIREMENTS (PLAN WO CHG) 00360I* 02 EXPLODE RELEASED REQUIREMENTS (REL WO ADD) 00370I* 02 EXPLODE W/O OPER RECORDS (WOOPER) (REL WO ADD) 00380I* 18 GARBAGE 00390I 1 100STPN 00400I 11 160STDUE 00410I 17 18 STREC 00420I 19 29 STORD 00430I 1 29 STKEY 00440I P 30 330STQTY 00450I P 34 370STQTYC 00460I* 38 430STDLT 00470I* P 44 460STCUST 00480I* 47 560STNAPN 00490I* P 57 600STQPA 00500I* 61 62 STISSU ÐÐ00510I* P 63 640STPULL 00520I 65 66 STREV 00530I P 67 700STQTYA 00540I* 71 90 STCPO 00550I* P 91 953STPRIC 00560I* P 96 970STSEQ 00570I 98 1030STSTRT 00580I* 104 104 STRFLG 00590I* 105 113 STPREQ 00600I 123 1240STTERM 00610I* 125 125 STTRAN 00620I 128 128 STSTAT 00630I******************************************************************** 00640ISFMAST SF 00650I* SCHEDULE MASTER. 00660I* COMMON FIELDS. 00670I* KEY AREA. 00680I* PART NO. 10N 00690I* 1 100SFPN 00700I* DATE DUE 6N (YMD) 00710I* 11 160SFDUE 00720I* RECORD CODE 2N 00730I* 10 = RECEIVED PO 00740I* 20 = REL WO 00750I* 30 = PURCHASE ORDER ÐÐ00760I* 40 = PLAN WO 00770I* 50 = PURCHASE REQ 00780I* 60 = SALES ORDER-BACKLOG 00790I* 70 = REL REQUIREMENT 00800I* 80 = PLAN REQUIREMENT 00810I* 90 = FORECAST 00820I 17 180SFREC 00830I* ORDER NO. 00840I* 19 29 SFORD 00850I* PREFIX 1A 00860I* 19 19 SFPRFX 00870I* PRIME 6A 00880I* 19 24 SFPRIM 00890I* DASH 3N 00900I* 25 270SFDASH 00910I* RECEIVING LOG # 2N 00920I* 28 290SFRLOG 00930I* QUANTITY 7P 00940I P 30 330SFQTY 00950I* QUANTITY COMPLETE 7P 00960I P 34 370SFQTYC 00970I* DATE LAST TRAN 6N (YMD) 00980I* 38 430SFDLT 00990I* CUST #/DEPT #/VEND # 5P 01000I P 44 460SFCUST ÐÐ01010I* VARIABLE AREA. 01020I* PLAN/REL REQMTS 01030I* NEXT ASSY PART # 10N 01040I* 47 560SFNAPN 01050I* QTY PER ASSY 7P 01060I* P 57 600SFQPA 01070I* ISSUE CODE 2A 01080I* 61 62 SFISSU 01090I* PULL # 3P 01100I* P 63 640SFPULL 01110I* ASSY REVISION 2A 01120I 65 66 SFREV 01130I* ASSY WO QTY 7P 01140I P 67 700SFQTYA 01150I* SALES ORDERS. 01160I* CUST P.O. 20A 01170I* 71 90 SFCPO 01180I* UNIT PRICE 9.3P 01190I* P 91 953SFPRIC 01200I* PURCH ORDERS 01210I* VENDOR NAME 20A 01220I* SEE SFCPO UNDER SALES ORDERS. 01230I* UNIT PRICE 9.3P 01240I* SEE SFPRIC UNDER SALES ORDERS. 01250I* WORK ORDERS. ÐÐ01260I* DEPT NAME 20A 01270I* SEE SFCPO UNDER SALES ORDERS. 01280I* OPER SEQ # 3P 01290I* P 96 970SFSEQ 01300I* START DATE 6N 01310I* 98 1030SFSTRT 01320I* PULL # 3P 01330I* SEE PLAN/REL REQMTS. 01340I* RQMT FLAG 1A 01350I 104 104 SFRFLG 01360I* REVISION 2A 01370I* SEE PLAN/REL REQMTS. 01380I* AVAIL STOCK BAL 7P 01390I P 120 1230SFSAVQ 01400I* AVAIL BAL 7P 01410I P 124 1270SFAVQ 01420I* RECORD STATUS 1A 01430I 128 128 SFSTAT 01440I******************************************************************** 01450ISFEXCPTNSE 01460I 1 100SEPN 01470I******************************************************************** 01480IALTKEY AK 21 1 CA 01490I OR 22 1 CB 01500I OR 25 1 CE ÐÐ01510I OR 26 1 CF 01520I* ALTERNATE KEY FILE FOR SFMAST. 01530I* 21 = ORDER ALT KEY FILE 01540I* 22 = DUE DATE ALT KEY FILE 01550I* 25 = START DATE ALT KEY FILE 01560I* 26 = SECONDARY PROCESSING FILE 01570I* COL-2 DEFINITIONS. 01580I* 1 = RECD PO 01590I* 3 = PO 01600I* 5 = PUR REQ 01610I* 6 = SALES ORDER 01620I* 7 = REL REQMT 01630I* 8 = PLAN REQMT 01640I* 9 = FORECAST 01650I* W = WORK ORDER 01660I* COMMON FIELDS. 01670I* RECORD CODE (SEE ABOVE) 2A 01680I 1 2 AKREC 01690I* RECORD STATUS 1A 01700I 32 32 AKSTAT 01710I* NON-COMMON FIELDS. 01720I*------------------------------------------------------------------- 01730I* DUE DATE ALT-KEY - 01740I* KEY AREA. 01750I* DUE DATE 6N ÐÐ01760I 3 80AKDUE 22 01770I* PART NO. 10N 01780I 9 180AKPN 22 01790I* ORDER NO. 11A 01800I 19 29 AKORD 22 01810I* PREFIX 1A 01820I 19 19 AKPRFX 22 01830I* PRIME 5N 01840I 20 240AKPRIM 22 01850I* DASH 3N 01860I 25 270AKITEM 22 01870I* RECEIVNG LOG # 01880I 28 290AKRLOG 22 01890I*------------------------------------------------------------------- 01900I* START DATE ALT-KEY - 01910I* KEY AREA. 01920I* START DATE 6N 01930I 3 80AKSTRD 25 01940I* PART NO. 10N 01950I 9 180AKPN 25 01960I* ORDER NO. 11A 01970I 19 29 AKORD 25 01980I* PREFIX 1A 01990I 19 19 AKPRFX 25 02000I* PRIME 5N ÐÐ02010I 20 240AKPRIM 25 02020I* DASH 3N 02030I 25 270AKITEM 25 02040I* RECEIVING LOG 2N 02050I 28 290AKRLOG 25 02060I******************************************************************** 02070IPMMST2 PM 02080I* PART MASTER RECORD. 02090I* KEY AREA 02100I* PART NO. 10N 02110I 1 100PMPN 02120I* CUR CHG LEVEL 2A 02130I 70 71 PMECHG 02140I* CALCULATED DATA. 02150I* CURRENT BALANCES. 02160I* ON HAND STOCK 7P 02170I* REQUIRED QTYS. 02180I* FORECAST BAL 7P 02190I* P 315 3180PMFRCB 02200I* ALLOCATIONS 7P 02210I P 319 3220PMALB 02220I* REL REQS 7P 02230I P 323 3260PMRLB 02240I* MFG ROUTING HRS 12 X 7.3P 02250I P 543 590 MHR ÐÐ02260I P 591 614 MDP 02270I* RECORD STATUS 1A 02280I* D = DELETED 02290I 674 674 PMSTAT 02300I******************************************************************** 02310IBMMAST BM 02320I* BILL OF MATERIAL RECORD 02330I* KEY AREA 02340I* ASSY PART NO. 10N 02350I 1 100BMAPN 02360I* COMPONENT PART # 10N 02370I 11 200BMCPN 02380I* ITEM NO. 3N 02390I 25 270BMITNO 02400I* QTY PER ASSY 7P 02410I P 28 310BMQTY 02420I* FILLER 32 33 FFFFFF 02430I* SCRAP ALLOW .2N 02440I 34 352BMSCRP 02450I* ISSUE CODE 2A 02460I* PT = PULL TIME 02470I* OR = ON REQUEST 02480I* BI = BULK ISSUE 02490I* AR = AS REQUIRED 02500I* RA = REF ASSY ÐÐ02510I* TD = TRAV DOC 02520I* SD = SHIP DOC 02530I* RD = REF DOC 02540I* VS = VENDOR SUPPLIED 02550I 36 37 BMISSU 02560I* EFFECTIVITY. 02570I* BEGIN CHANGE LEVEL 2A 02580I 38 39 BMBCHG 02590I* ENDING CHANGE LEVEL 2A 02600I 40 41 BMECHG 02610I* BEGIN ECN # 5A 02620I 42 46 BMBECN 02630I* ENDING ECN # 5A 02640I 47 51 BMEECN 02650I* DISPOSITION CODE 1A 02660I* U = USE UP OLD STYLE 02670I* N = NOW (IMMEDIATE) 02680I 52 52 BMDISP 02690I* FILLER 5A 53 57 FFFFFF 02700I* ROUTING. 02710I* OPER NO. 5P 02720I P 58 600BMOPER 02730I* DEPT NO. 5P 02740I P 61 630BMDEPT 02750I* WORK CENTER NO. 3P ÐÐ02760I P 64 650BMWC 02770I* COMPONENT OPER REFERENCE INFO 10A 02780I 66 75 BMREF 02790I* FILLER 10A 76 85 FFFFFF 02800I* 02810I* RECORD STATUS 1A 02820I* D = DELETED 02830I 86 86 BMSTAT 02840I******************************************************************** 02850IWOOPER WP 02860I* WORK ORDER OPER RECORD. 02870I* WORK ORDER # 11A 02880I 1 11 WPORD 02890I* PRIME 6A 02900I 1 6 WPPRIM 02910I* DASH 3N 02920I 7 90WPDASH 02930I* RECEIVING LOG 02940I 10 110WPRLOG 02950I* OPER SEQ # 3N 02960I 12 140WPSEQ 02970I* OPER CODE 5A 02980I 15 19 WPOPER 02990I* DEPT # 5P 03000I P 20 220WPDEPT ÐÐ03010I* WORK CENTER 3P 03020I P 23 240WPWC 03030I* STD HRS - PER UNIT 03040I* SET-UP 9.3P 03050I P 25 293WPSSUH 03060I* RUN 9.3P 03070I P 30 343WPSRUN 03080I* ACTUAL HRS - TOTALS 03090I* SET-UP 9.3P 03100I P 35 393WPASUH 03110I* RUN 9.3P 03120I P 40 443WPARUN 03130I* QTY SCHED 7P 03140I P 45 480WPQORD 03150I* QTY MOVED-IN 7P 03160I P 49 520WPQIN 03170I* QTY MOVED-OUT 7P 03180I P 53 560WPQOUT 03190I* DATE LAST TRAN 6N 03200I 57 620WPDLT 03210I* FILLER 63 63 FFFFFF 03220I* RECORD STATUS 1A 03230I 64 64 WPSTAT 03240C******************************************************************** 03250C* INITIALIZE 1-TIME. ÐÐ03260C SETOF 19 03270C N79 EXSR SR101 INIT. 03280C 18 GOTO ENDJOB 03290C PORT COMP STTERM 54 03300C N54 PORT COMP 25 54 03310C N54 SETOF 0206 03320C N54 GOTO ENDJOB 03330C SETON 19 03340C* VERIFY SFMAST WORK ORDERS. 03350C 02 03360COR 06 EXSR SR102 VERIFY WO 03370C 06 GOTO TAG500 EXPL-PLAN-REQ 03380C 02 GOTO TAG100 EXPL-REL-REQ 03390C GOTO ENDJOB 03400C*------------------------------------------------------------------- 03410C TAG100 TAG 03420C* EXPLODE WO-OPER RECORDS. 03430C EXSR SR105 03440C*------------------------------------------------------------------- 03450C TAG500 TAG 03460C* EXPLODE BILL MATERIAL. 03470C Z-ADDSTPN W10N 100 03480C EXSR SR80 GET ASSY PMMST. 03490C 60 GOTO END NOT ON FILE 03500C MOVELPMPN W20A 20 ÐÐ03510C MOVE BLK20 LEV 03520C Z-ADD2 L 30 03530C Z-ADDPMPN CURASY 100 03540C MOVE PMECHG ASYREV 2 03550C STQTY SUB STQTYC ASYQTY 70 03560C STQTY SUB STQTYC CUMQTY 70 54 03570C N54 GOTO END NO QTY 03580C*------------------------------------------------------------------- 03590C TAG530 TAG 03600C W20A SETLLBMMAST 03610C*------------------------------------------------------------------- 03620C TAG540 TAG 03630C* READ BILL MATERIAL. 03640C SETOF 54 03650C READ BMMAST 54 03660C 54 GOTO TAG560 END FILE. 03670C BMAPN COMP CURASY 54 03680C N54 GOTO TAG560 WRONG ASSY #. 03690C BMSTAT COMP 'D' 54 03700C 54 GOTO TAG540 DELETED. 03710C Z-ADDBMQTY QTY5 50 03720C Z-ADDBMCPN W10N 03730C EXSR SR80 GET COMP PMMST. 03740C 60 GOTO TAG540 03750C SETOF 5556 ÐÐ03760C MOVELBMISSU W1A 1 03770C W1A COMP 'R' 55 REF 03780C MOVE BMISSU W1A 03790C W1A COMP 'A' 56 03800C N55 03810CORN56 GOTO TAG550 NOT REF ASSY. 03820C MOVELBMAPN LEV,L 03830C 1 ADD BMCPN W10N 03840C MOVE W10N LEV,L 03850C CUMQTY MULT BMQTY EXTQTY 03860C Z-ADDCUMQTY QTY,L 03870C Z-ADDEXTQTY CUMQTY 03880C MOVE BMCPN CURASY 03890C MOVELCURASY W20A 03900C MOVE ZERO10 W20A 03910C 1 ADD L L 03920C GOTO TAG530 03930C*------------------------------------------------------------------- 03940C TAG550 TAG 03950C* UPDATE REQUIREMENTS. 03960C N55 EXSR SR104 UPDATE REQMTS. 03970C GOTO TAG540 GET NEXT. 03980C*------------------------------------------------------------------- 03990C TAG560 TAG 04000C* GET SAVED HIGHER LEVEL, IF ANY. ÐÐ04010C L SUB 1 L 54 04020C N54 GOTO END 04030C LEV,L COMP BLK20 54 04040C N54 GOTO TAG560 04050C MOVE LEV,L W20A 04060C MOVELLEV,L CURASY 04070C Z-ADDQTY,L CUMQTY 04080C MOVE BLK20 LEV,L 04090C Z-ADD0 QTY,L 04100C GOTO TAG530 04110C*------------------------------------------------------------------- 04120C END TAG 04130C*------------------------------------------------------------------- 04140C ENDJOB TAG 04150CLRN79 EXSR SR101 INIT 04160CLR MOVEL'Q010SF' PROG 8 04170CLR EXITFCHAIN 04180CLR RLABL PROG 04190C******************************************************************** 04200CSR SR80 BEGSR 04210C* GET PART MASTER. 04220CSR MOVELW10N W12A 12 04230CSR MOVE ' ' W12A 04240CSR W12A CHAINPMMST2 60 GET PMMST2 04250CSRN60 PMSTAT COMP 'D' 60 ÐÐ04260CSR ENDSR 04270C******************************************************************** 04280CSR SR81 BEGSR 04290C* GET ALT KEY. 04300CSR W29A CHAINALTKEY 60 04310CSR ENDSR 04320C***************************************************************** 04330CSR SR82 BEGSR 04340C* GET ALTKEY. 04350CSR W29A CHAINALTKEY 60 GET ORDERLOG 04360CSR ENDSR 04370C***************************************************************** 04380CSR SR83 BEGSR 04390C* UPDATE ALTKEY 04400CSR SETON 83 04410CSR EXCPT UPDATE ALTKEY 04420CSR SETOF 83 04430CSR ENDSR 04440C******************************************************************** 04450CSR SR85 BEGSR 04460C* UPDATE ALTKEY. 04470CSR SETON 85 04480CSR EXCPT UPD ALTKEY 04490CSR SETOF 85 04500CSR ENDSR ÐÐ04510C******************************************************************** 04520CSR SR101 BEGSR 04530C* 1-TIME INITIALIZE. 04540CSR MOVE ' 'W8A 8 04550CSR Z-ADD0 W2N 20 04560CSR Z-ADD0 W1N 10 04570CSR MOVE ' ' W2A 2 04580CSR EXITFPGMINX GET PORT # 04590CSR RLABL W8A 04600CSR RLABL W2N 04610CSR RLABL W1N 04620CSR RLABL W2A 04630CSR MOVE W2A PORT 20 04640CSR PORT COMP 0 54 04650CSRN54 Z-ADD25 PORT 04660CSR PORT CHAINCRTFILE H9 04670CSR H9 GOTO END 04680CSR CRRRN CHAINSFTRAN H8 04690CSR H8 GOTO END 04700CSR SETON 79 04710CSR MOVELUDATE W4N 40 04720CSR MOVE UDATE W2N 20 04730CSR MOVELW2N TODAY 60 04740CSR MOVE W4N TODAY 04750CSR MOVE ' ' BLK29 29 ÐÐ04760CSR MOVE ' ' BLK20 20 04770CSR Z-ADD0 ZERO10 100 04780CSR Z-ADD0 ZERO7 70 04790CSR Z-ADD0 ZERO9 90 04800CSR Z-ADD0 ZERO3 30 04810CSR SETON 72 04820CSR EXCPT TERMINAL MSG 04830CSR SETOF 72 04840CSR ENDSR 04850C******************************************************************** 04860CSR SR102 BEGSR 04870C* VERIFY WORK ORDERS. 04880CSR STKEY CHAINSFMAST 60 04890CSRN60 SFSTAT COMP 'D' 61 04900CSR 60 04910COR 61 GOTO T102Z 04920CSR SFQTY COMP SFQTYC 54 04930CSRN54 GOTO T102Z 04940CSR SFREC COMP 40 54 04950CSR 54 SFSTAT COMP 'R' 54 04960CSRN54 GOTO END102 NOT REL/OPEN WO 04970CSR SETON 81 04980CSR EXCPT 04990CSR SETOF 81 05000CSR GOTO END102 ÐÐ05010C*------------------------------------------------------------------- 05020CSR T102Z TAG 05030CSR SETOF 190602 05040CSR END102 ENDSR 05050C******************************************************************** 05060CSR SR104 BEGSR 05070C* UPDATE SFMAST REQMTS. 05080CSR MOVELBMISSU W1A 05090CSR W1A COMP 'B' 54 05100CSRN54 W1A COMP 'R' 54 05110CSR 54 GOTO END104 05120CSR MOVE ' ' A29 05130CSR MOVE BMCPN W10A 10 05140CSR MOVEAW10A A29 05150CSR MOVE STSTRT W6A 6 05160CSR MOVEAW6A A29,11 05170CSR 06 MOVEA'80' A29,17 05180CSR 02 MOVEA'70' A29,17 05190CSR MOVEASTORD A29,19 05200CSR MOVEAA29 W29A 29 05210CSR BMQTY MULT CUMQTY EXTQTY 70 54 05220CSRN54 GOTO END104 NO QTY 05230CSR W29A CHAINSFMAST 60 05240CSRN60 SFSTAT COMP 'D' 54 05250CSRN60 54 ÐÐ05260COR 60 EXSR SR201 INIT SFMAST 05270CSR SFQTY ADD EXTQTY EXTQTY 05280CSR 06 EXTQTY ADD PMALB PMALB 05290CSR 02 EXTQTY ADD PMRLB PMRLB 05300CSR 06 MOVE 'A' SFSTAT 05310CSR 02 MOVE 'Z' SFSTAT 05320CSR SETON 82 UPD PMMST2 05330CSR EXCPT ADD SFMAST 05340CSR SETOF 82 05350C* UPDATE ALT KEYS. 05360CSR EXSR SR204 ALTKEY 05370CSR END104 ENDSR 05380C******************************************************************** 05390CSR SR105 BEGSR 05400C* OUTPUT WORK ORDER OPER RECORDS. 05410CSR Z-ADD1 X 30 05420CSR MOVE ' ' A29 05430CSR Z-ADD0 SEQ 30 05440CSR Z-ADDSTPN W10N 100 05450CSR EXSR SR80 GET PMMAST 05460CSR 60 GOTO END105 NOT ON FILE 05470C*------------------------------------------------------------------- 05480CSR T105A TAG 05490CSR ZERO7 LOKUPMHR,X 54 05500CSRN54 GOTO END105 ÐÐ05510CSR Z-ADDMDP,X DEPT 50 05520CSR MOVEASTORD A29 05530CSR 10 ADD SEQ SEQ 05540CSR MOVE SEQ W3A 3 05550CSR MOVEAW3A A29,12 05560CSR MOVEAA29 W14A 14 05570CSR W14A CHAINWOOPER 60 05580CSR SETON 87 05590CSR EXCPT 05600CSR SETOF 87 05610CSR 1 ADD X X 05620CSR X COMP 12 54 05630CSRN54 GOTO T105A 05640CSR END105 ENDSR 05650C******************************************************************** 05660CSR SR201 BEGSR 05670C* INITIALIZE SFMAST 05680CSR Z-ADD0 SFQTYC 05690CSR Z-ADD0 SFQTY 05700CSR ENDSR 05710C******************************************************************** 05720CSR SR204 BEGSR 05730C* UPDATE ALTKEY FILE. 05740CSR MOVE ' ' A29 05750CSR 06 MOVEA'A8' A29,1 PLAN REQMT ÐÐ05760CSR 02 MOVEA'A7' A29,1 REL REQMT 05770CSR MOVEASTORD A29,3 05780CSR MOVE BMCPN W10A 10 05790CSR MOVEAW10A A29,14 PART # 05800CSR MOVE STSTRT W6A 6 05810CSR MOVEAW6A A29,24 DUE DATE 05820CSR MOVEAA29 W29A 05830CSR EXSR SR81 GET ALTKEY 05840CSR EXSR SR85 UPD ALTKEY 05850CSR BMCPN CHAINSFEXCPTN 60 05860CSR SETON 84 05870CSR EXCPT UPD EXCPTN STATUS 05880CSR SETOF 84 05890C* UPDATE DUE ALT KEY 05900CSR MOVE ' ' A29 05910CSR 02 MOVEA'B7' A29,1 RECORD CODE,RWO 05920CSR 06 MOVEA'B8' A29,1 RECORD CODE,PWO 05930CSR MOVE STSTRT W6A 6 05940CSR MOVEAW6A A29,3 DUE DATE 05950CSR MOVE BMCPN W10A 05960CSR MOVEAW10A A29,9 PART NO. 05970CSR MOVEASTORD A29,19 WORK ORDER # 05980CSR MOVEAA29 W29A 05990CSR EXSR SR81 GET ALTKEY 06000CSR EXSR SR85 ADD ALTKEY ÐÐ06010CSR ENDSR 06020O**************************************************************** 06030OSFTRAN D 19 06040O STQTY 33P 06050O STQTYC 37P 06060O STQTYA 70P 06070O 128 'D' 06080O******************************************************************** 06090OSFMAST EADD 82 60 06100O W29A 29 06110O EXTQTY 33P 06120O SFQTYC 37P 06130O TODAY 43 06140O BMDEPT 46P 06150O BMAPN 56 06160O BMQTY 60P 06170O BMISSU 62 06180O ASYREV 66 06190O ASYQTY 70P 06200O ZERO7 123P 06210O ZERO7 127P 06220O SFSTAT 128 06230O*------------------------------------------------------------------- 06240O E 82N60 06250O OR 81 ÐÐ06260O EXTQTY 33P 06270O SFQTYC 37P 06280O TODAY 43 06290O BMDEPT 46P 06300O BMAPN 56 06310O BMQTY 60P 06320O BMISSU 62 06330O ASYREV 66 06340O ASYQTY 70P 06350O ZERO7 123P 06360O ZERO7 127P 06370O SFSTAT 128 06380O******************************************************************** 06390OWOOPER EADD 87 60 06400O W14A 14 06410O 19 ' ' 06420O DEPT 22P 06430O ZERO3 24P 06440O ZERO9 29P 06450O MHR,X 34P 06460O ZERO9 39P 06470O ZERO9 44P 06480O STQTY 48P 06490O ZERO7 52P 06500O ZERO7 56P ÐÐ06510O UDATE 62 06520O 63 ' ' 06530O 64 'A' 06540O*------------------------------------------------------------------- 06550O E 87N60 06560O 19 ' ' 06570O DEPT 22P 06580O ZERO3 24P 06590O ZERO9 29P 06600O MHR,X 34P 06610O ZERO9 39P 06620O ZERO9 44P 06630O STQTY 48P 06640O ZERO7 52P 06650O ZERO7 56P 06660O UDATE 62 06670O 63 ' ' 06680O WPSTAT 64 06690O******************************************************************** 06700OALTKEY EADD 85 60 06710O W29A 29 06720O 32 'A' 06730O*------------------------------------------------------------------- 06740O E 85N60 06750O 32 'A' ÐÐ06760O*------------------------------------------------------------------- 06770O EADD 83 60 06780O W29A 29 06790O 32 'A' 06800O*------------------------------------------------------------------- 06810O E 83N60 06820O 32 'A' 06830O******************************************************************** 06840OPMMST2 E 82 06850O PMALB 322P 06860O PMRLB 326P 06870O MHR 590P 06880O MDP 614P 06890O******************************************************************** 06900OSFEXCPTNEADD 84 60 06910O BMCPN 10 06920O 11 'A' 06930O*------------------------------------------------------------------- 06940O E 84N60 06950O 11 'A' 06960O***************************************************************** 06970OTERM132 E 72 U1 06980O 27 '2NDARY-UPDATE, PHASE-4' ** A29 ARRAY 006990 007000ÐÐ** LEV ARRAY 007010 007020** QTY ARRAY 007030 007040/* 007050_‚ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(,M0 ,}X203SF P120282120282(èÈÐ00010H Q203SF00020F* CONVERT PLAN REQMTS TO REL REQMTS. (X203SF) 00030F* REVISED 7/15/81 4:00 PM. 00040FBITTAB IP F 33 DISK 00050FSFTRAN2 UC F 40R DISK 00060FSFTRAN UC F 128R DISK 00070FSFMAST UC F 128R29AI 1 DISK A 00080FALTKEY UC F 32R29AI 1 DISK A 00090FCRTFILE IC F 256R DISK 00100FPMMST2 UC F 674R12AI 1 DISK 00110FORDERLOGIC F 32R13AI 1 DISK 00120FTERM70 O F 70 5 00130E******************************************************************** 00140E A29 1 29 1 00150E REC 29 1 A 00160I****************************************************************** 00170IBITTAB BT 01 00180I 1 33 BIT 00190I******************************************************************** 00200ISFTRAN2 ST 00210I 1 29 REC 00220I 1 10 STPN 00230I 11 16 STDUE 00240I 17 18 STREC 00250I 19 29 STORD ÐÐ00260I 30 340STRRN 00270I******************************************************************* 00280ICRTFILE CR 00290I 81 850CRTRRN 00300I 86 900CRBRRN 00310I 91 950CRERRN 00320I 96 1000CRNRRN 00330I********************************************************************* 00340ISFTRAN SS 00350I 17 18 SSREC 00360I 19 29 SSORD 00370I P 30 330SSQTY 00380I P 34 370SSQTYC 00390I 98 103 SSSTRT 00400I********************************************************** 00410IORDERLOGOL 00420I 1 2 OLREC 00430I 3 13 OLORD 00440I 14 23 OLPN 00450I 24 29 OLDUE 00460I 30 30 OLTYPE 00470I 32 32 OLSTAT 00480I******************************************************************** 00490ISFMAST SF 00500I* QTY ORDERED/REQUIRED 7P ÐÐ00510I P 30 330SFQTY 00520I* QTY COMPLETED/ISSUED 7P 00530I P 34 370SFQTYC 00540I* QTY PER ASSY 7P 00550I P 57 600SFQPA 00560I* PLANNED START DATE 6N 00570I 98 103 SFSTRT 00580I* AVAIL STOCK 7P 00590I P 120 1230SFSAVQ 00600I* AVAIL BAL 7P 00610I P 124 1270SFAVQ 00620I* RECORD STATUS 00630I 128 128 SFSTAT 00640I 30 128 SFR 00650I****************************************************************** 00660IPMMST2 PM 00670I* PART MASTER FILE 00680I* PLANNED REQUIREMENTS BAL 7P 00690I P 319 3220PMALB 00700I* RELEASED REQMTS BAL. 7P 00710I P 323 3260PMRLB 00720I* RECORD STATUS 1A 00730I 674 674 PMSTAT 00740I******************************************************************** 00750IALTKEY AK ÐÐ00760I 1 32 AKR 00770C******************************************************************** 00780C EXSR SR101 1-TIME INIT 00790C CRBRRN SUB 1 RRN 50 00800C*----------------------------------------------------------------- 00810C START TAG 00820C 1 ADD RRN RRN 00830C RRN COMP CRERRN 55 00840C CRERRN COMP CRBRRN 56 56 00850C 55 56 GOTO END 00860C RRN CHAINSFTRAN2 54 00870C 54 56 GOTO END 00880C 54 Z-ADD0 RRN 00890C 54 Z-ADD1 CRBRRN 00900C 54 GOTO START 00910C ' ' LOKUPREC 54 00920C N54 GOTO START 00930C STRRN COMP CRTRRN 54 00940C N54 GOTO START 00950C EXSR SR104 GET RQMT SFMAST 00960C 60 GOTO START 00970C EXSR SR105 ADD REL RQMT 00980C SETON 85 00990C EXCPT UPDATE SFTRAN,SFTRAN201000C SETOF 85 ÐÐ01010C GOTO START 01020C*------------------------------------------------------------------- 01030C END TAG 01040CLR MOVEL'Q010SF' PROG 8 01050CLR EXITFCHAIN 01060CLR RLABL PROG 01070C*------------------------------------------------------------------ 01080CLR ENDJOB TAG 01090C******************************************************************* 01100CSR SR101 BEGSR 01110C* 1 TIME INIT 01120CSR SETON 72 01130CSR EXCPT TERM70 MSG 01140CSR SETOF 72 01150CSR MOVE ' ' BLK40 40 01160CSR Z-ADD0 ZERO7 70 01170CSR MOVE ' 'W8A 8 01180CSR Z-ADD0 W2N 20 01190CSR Z-ADD0 W1N 10 01200CSR MOVE ' ' W2A 2 01210CSR EXITFPGMINX GET PORT# 01220CSR RLABL W8A 01230CSR RLABL W2N 01240CSR RLABL W1N 01250CSR RLABL W2A ÐÐ01260CSR MOVE W2A PORT 20 01270CSR PORT COMP 0 54 01280CSRN54 Z-ADD25 PORT 01290CSR PORT CHAINCRTFILE H9 01300CSR H9 GOTO ENDJOB 01310CSR CRTRRN CHAINSFTRAN H8 01320CSR H8 GOTO ENDJOB 01330CSR ENDSR 01340C****************************************************************** 01350CSR SR104 BEGSR 01360C* GET PLANNED REQUIREMENT SFMAST 01370CSR MOVEAREC W29A 29 01380CSR W29A CHAINSFMAST 60 01390CSRN60 MOVE SFR RFS 99 01400CSRN60 Z-ADDSFQPA SAVQPA 70 SAVE QTY PER ASSY 01410CSRN60 Z-ADDSFAVQ SAVAVQ 70 SAVE QTY AVAIL 01420CSRN60 Z-ADDSFSAVQ SASAVQ 70 SAVE AVAIL STOCK 01430CSRN60 Z-ADDSFQTYC SAVCMP 70 SAVE QTY CMPLT 01440CSR ENDSR 01450C****************************************************************** 01460CSR SR105 BEGSR 01470C* ADD REVISED REQUIREMENT TO FILE 01480CSR MOVEASSSTRT REC,11 01490CSR SSREC COMP '20' 48 REL WO 01500CSR SSREC COMP '40' 49 PLAN WO ÐÐ01510CSR 48 MOVEA'70' REC,17 01520CSR 49 MOVEA'80' REC,17 01530CSR MOVEAREC W29A 01540CSR W29A CHAINSFMAST 60 01550CSR SSQTY SUB SSQTYC NAQTY 70 54 WO QTY 01560CSRN54 Z-ADD0 NAQTY 01570CSR SAVQPA MULT NAQTY QTYREQ 70 QTY REQD 01580CSR QTYREQ SUB SAVCMP QTYREQ 01590CSR SETON 80 01600CSR EXCPT ADD SFMAST 01610CSR SETOF 80 01620C* ADD ALTKEY DUE DATE RECORD 01630CSR MOVE ' ' A29 01640CSR 48 MOVEA'B7' A29,1 01650CSR 49 MOVEA'B8' A29,1 01660CSR MOVEASSSTRT A29,3 01670CSR MOVEASTPN A29,9 01680CSR MOVEASTORD A29,19 01690CSR MOVEAA29,1 W29A 01700CSR W29A CHAINALTKEY 60 01710CSR SETON 81 01720CSR EXCPT ADD ALTKEY DUE 01730CSR SETOF 81 01740C* ADD ALTKEY ORDER RECORD 01750CSR MOVE ' ' A29 ÐÐ01760CSR 48 MOVEA'A7' A29,1 01770CSR 49 MOVEA'A8' A29,1 01780CSR MOVEASTORD A29,3 01790CSR MOVEASTPN A29,14 01800CSR MOVEASSSTRT A29,24 01810CSR MOVEAA29 W29A 01820CSR W29A CHAINALTKEY 60 01830CSR SETON 81 01840CSR EXCPT ADD ALTKEY ORDER 01850CSR SETOF 81 01860C* UPDATE PART MASTER 01870CSR MOVELSTPN W12A 12 01880CSR W12A CHAINPMMST2 60 01890CSR 48 QTYREQ ADD PMRLB PMRLB REL REQMT BAL 01900CSR 49 QTYREQ ADD PMALB PMALB PLAN REQMT BAL 01910CSR SETON 83 01920CSR EXCPT UPDATE PART MASTER 01930CSR SETOF 83 01940CSR END105 ENDSR 01950C******************************************************************** 01960C* 01970C* 01980C* 01990C* 02000C* ÐÐ02010C* 02020C* 02030C* 02040O********************************************************************* 02050OTERM70 E 72 U1 02060O 19 '2NDARY-UPDATE,' 02070O 27 'PHASE-3' 02080O******************************************************************* 02090OSFMAST EADD 80 60 02100O* ADD RELEASED REQUIREMENT 02110O W29A 29 02120O RFS 128 02130O QTYREQ 33P 02140O SAVCMP 37P 02150O SAVQPA 60P 02160O SASAVQ 123P 02170O SAVAVQ 127P 02180O 128 'A' 02190O*--------------------------------------------------------------- 02200O E 80N60 02210O RFS 128 02220O QTYREQ 33P 02230O SAVCMP 37P 02240O SAVQPA 60P 02250O SASAVQ 123P ÐÐ02260O SAVAVQ 127P 02270O 128 'A' 02280O******************************************************************* 02290OALTKEY EADD 81 60 02300O W29A 29 02310O 32 'A' 02320O*------------------------------------------------------------------- 02330O E 81N60 02340O 32 'A' 02350O******************************************************************* 02360OPMMST2 E 83N60 02370O PMALB 322P 02380O PMRLB 326P 02390O******************************************************************** 02400OSFTRAN2 E 85 02410O BLK40 40 02420O******************************************************************* 02430OSFTRAN D 01NH8 02440O SSQTY 33P 02450O SSQTYC 37P 02460O 128 'D' 02470O******************************************************************** ** A29 002480 002490/* 002500ÐÐ_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(„M® „wX110SF P120282120282(èÈÐ00010H Q110SF00020F* LIST DAILY RECEIPTS/ISSUES. (X110SF) D A T A G R A P H I X 00030F* REVISED 9-18-81 2:45 PM. 00040F* MENU: MQNS01 00050FBITTAB IP F 33 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE IC F 256R DISK 00080FMATLDISTIC F 128R DISK 00090FPMMST2 IC F 674R12AI 1 DISK 00100FGLMAST IC F 165R 9AI 1 DISK 00110FTERM132 O F 132 5 00120F**************************************************************** 00130E NUL 1 132 1 NULL CHAR 00140E A16 16 16 1 A INPUT DATA ARRAY 00150E NUM 1 1 3 0 NUMERIC FIELD NO.'S 00160E DUN 1 1 1 A EDIT CMPLT FLAG 00170E TABTRN 1 10 1 TABNAM 17 TRAN CODE/NAME 00180E TABRC 1 9 1 TABRN 15 REASON CODE/NAME 00190E DOT 30 30 1 00200E BIT 33 1 SCREEN CONTR. CHAR 00210E* * * * * CALL 5 6 CALL STACK 00220E MDS 5 9 3 00230E MDA 5 9 3 00240I******************************************************************* 00250IBITTAB BT ÐÐ00260I 1 33 BIT 00270I******************************************************************* 00280IMGFILE MG 00290I* MESSAGE FILE. 00300I 1 35 MGTEXT 00310I****************************************************************** 00320ICRTFILE CR 00330I* TERMINAL CONTROL FILE - 1 RECORD FOR EACH PORT # (PORT=RRN) 00340I* STD AREA - SAME FOR ALL PROGRAMS. 00350I* EMPLOYEE # 5N 00360I 1 50CREMPL 00370I* USER CODE 8A 00380I 6 13 CRUSER 00390I* DEPT # 5N 00400I 14 180CRDEPT 00410I* JOB NAME 8A (JOB LOADED BY MENU) 00420I 19 26 CRJOB 00430I* SHUTDOWN FLAG 1A 00440I* BLANK = NO SHUTDOWN 00450I 27 27 CRSHUT 00460I* TIME STARTED 6N 00470I 28 330CRTIME 00480I* DATE STARTED 4N 00490I 34 370CRDATE 00500I* CALL STACK 5 X 6A ÐÐ00510I* * * * * 38 67 CALL 00520I* RETURN TO PROG NAME (FOR PROG LOADER) 6A 00530I 68 73 CRRET 00540I* MENU NAME 6A 00550I 74 79 CRMENU 00560I******************************************************************** 00570IMATLDISTMD 00580I* MATERIAL DISTRIBUTION INPUT FILE. 00590I* PART NO. 10N 00600I 1 100MDPN 00610I* TRAN CODE 1A 00620I* 1 = UNPLAN RCPTS 6 = 00630I* 2 = PO TO STOCK 7 = UNPLAN ISSUE 00640I* 3 = WO TO STOCK 8 = PLAN ISSUE 00650I* 4 = SALES ORD RET STK 9 = SALES ORDER ISSUE 00660I* 5 = C = W/O CLOSE 00670I 11 11 MDTRAN 00680I* ACCOUNT # 9A 00690I 12 20 MDACT 00700I* PRIME 6A 00710I 12 17 MDPRIM 00720I* DASH 3N 00730I 18 200MDDASH 00740I* WORK ORDER # 9A 00750I 21 29 MDWO ÐÐ00760I* PRIME 6A 00770I 21 26 MDWOP 00780I* DASH 3N 00790I 27 290MDWOD 00800I* PURCH ORDER # 11A 00810I 30 40 MDPO 00820I* PRIME 6A 00830I 30 35 MDPOP 00840I* DASH 3N 00850I 36 380MDPOD 00860I* SUB 2N 00870I 39 400MDPSUB 00880I* QTY ISSUED/RCVD 7P 00890I P 41 440MDQTY 00900I* QTY BO 7P 00910I P 45 480MDBOQ 00920I* STD COST 9.3P 00930I P 49 533MDCST 00940I* STD LABOR/MATL 5 X 9.3P 00950I* 1 = STD LABOR COST 00960I* 2 = STD LABOR BURDEN 00970I* 3 = STD MATL COST 00980I* 4 = STD MATL BURDEN 00990I* 5 = NOT USED 01000I P 54 78 MDS ÐÐ01010I* ACT LABOR/MATL 5 X 9.3P 01020I* 1 = ACT LABOR COST 01030I* 2 = ACT LABOR BURDEN 01040I* 3 = ACT MATL COST 01050I* 4 = ACT MATL BURDEN 01060I* 5 = NOT USED 01070I P 79 103 MDA 01080I* REASON CODE 1A 01090I 104 104 MDREAS 01100I* DATE 6N 01110I 105 1100MDDATE 01120I* EMPLOYEE # 5P 01130I P 111 1130MDEMPL 01140I* RECORD STATUS 1A 01150I 128 128 MDSTAT 01160I******************************************************************** 01170IPMMST2 PM 01180I 1 100PMPN 01190I 15 180PMPL 01200I 19 30 PMMODL 01210I 31 59 PMDESC 01220I 70 71 PMECHG 01230I 94 95 PMSC 01240I P 311 3140PMOHB 01250I P 315 3180PMFRCB ÐÐ01260I P 319 3220PMALB 01270I P 323 3260PMRLB 01280I P 327 3300PMSOB 01290I P 339 3420PMPRB 01300I P 343 3460PMPOB 01310I P 347 3500PMRPOB 01320I P 351 3540PMPWOB 01330I P 355 3580PMRWOB 01340I 674 674 PMSTAT 01350I******************************************************************** 01360IGLMAST GL 01370I 18 57 GLDESC 01380I 165 165 GLSTAT 01390C******************************************************************** 01400C* INITIALIZE 01410C EXSR SR101 1-TIME INIT 01420C*------------------------------------------------------------------ 01430C START TAG 01440C* SET-UP 1ST FIELD NO. 01450C MOVE ' ' DUN INIT EDIT ARRAY 01460C Z-ADD1 F 30 FIELD # 01470C GOTO READ 01480C*------------------------------------------------------------------ 01490C NEXT TAG 01500C* SET-UP NEXT FIELD NO. ÐÐ01510C 1 ADD F F FIELD # 01520C*----------------------------------------------------------------- 01530C READ TAG 01540C* READ DATA FROM TERMINAL. 01550C SETOF 909677 01560C EXSR SR102 VALIDATE FIELD # 01570C 55 GOTO UPDATE DONE 01580C EXSR SR201 IDENTIFY-F 01590C SETON 69 01600C EXSR SR72 PROMPT 01610C SETOF 69 01620C EXSR SR75 READ TERMINAL 01630C 98 GOTO GOODBY GOODBY 01640C 94 GOTO MENU MENU REQUEST 01650C N77N88 EXSR SR104 EDIT INPUT FIELD 01660C 96 ERROR 01670CORN77N88 EXSR SR72 REWRITE INPUT DATA 01680C 93 GOTO NEWITM NEW ITEM 01690C 87 GOTO START 01700C 96 GOTO ERROR ERROR 01710C N77 GOTO EDIT NO DATA INPUT 01720C*------------------------------------------------------------------ 01730C PROCES TAG 01740C* PROCESS INPUT DATA 01750C EXSR SR103 MOVE DATA ÐÐ01760C*------------------------------------------------------------------- 01770C EDIT TAG 01780C N96 EXSR SR104 EDIT DATA 01790C EXSR SR72 REWRITE DATA 01800C 96 GOTO ERROR ERROR 01810C GOTO NEXT 01820C*------------------------------------------------------------------ 01830C UPDATE TAG 01840C* DISPLAY MATL DISTR FILE. 01850C EXSR SR105 FINAL EDIT 01860C 96 GOTO ERROR ERROR 01870C EXSR SR106 DISPLAY 01880C 96 GOTO ERROR ERROR 01890C 94 GOTO MENU 01900C 98 GOTO GOODBY 01910C 93 GOTO NEWITM 01920C GOTO START 01930C*-------------------------------------------------------------------- 01940C ERROR TAG 01950C EXSR SR102 VALIDATE FIELD # 01960C EXSR SR89 GET MSG 01970C EXSR SR73 PUT MSG 01980C GOTO READ 01990C*------------------------------------------------------------------ 02000C NEWITM TAG ÐÐ02010C* SET-UP LINK FOR NEW ITEM 02020C MOVEL'Q110SF' PROG 8 02030C GOTO END 02040C*------------------------------------------------------------------- 02050C MENU TAG 02060C* SET-UP LINK TO MENU 02070C MOVELCRRET PROG 02080C GOTO END 02090C*-------------------------------------------------------------------- 02100C GOODBY TAG 02110C* LINK TO SIGN-OFF 02120C MOVEL'GOODBY' PROG 02130C GOTO END 02140C*------------------------------------------------------------------- 02150C END TAG 02160C EXITFCHAIN LINK TO NEXT PROG 02170C RLABL PROG 02180C*------------------------------------------------------------------ 02190C ENDJOB TAG 02200C******************************************************************** 02210CSR SR66 BEGSR 02220C* BUMP CURSOR-UP. 02230CSR EXITFQMOVUP BUMP CURSOR-UP 02240CSR ENDSR 02250C******************************************************************** ÐÐ02260CSR SR67 BEGSR 02270C* ROLL SCREEN-UP. 02280CSR MOVE '120001' W6A 6 02290CSR EXSR SR69 POSITION CURSOR 02300CSR EXSR SR68 LF 02310CSR ENDSR 02320C******************************************************************** 02330CSR SR68 BEGSR 02340CSR EXITFQCLF LINE FEED 02350CSR ENDSR 02360C******************************************************************** 02370CSR SR69 BEGSR 02380CSR EXITFQXYPOS POSITION CURSOR 02390CSR RLABL W6A 02400CSR ENDSR 02410C********************************************************************** 02420CSR SR71 BEGSR 02430C* PUT HEADINGS TO TERMINAL 02440CSR EXSR SR67 02450CSR SETON 71 02460CSR EXCPT PUT HEADINGS 02470CSR SETOF 71 02480CSR ENDSR 02490C********************************************************************* 02500CSR SR72 BEGSR ÐÐ02510C* PUT PROMPT TO TERMINAL. 02520CSR 69 EXSR SR67 ROLL UP 02530CSR SETON 72 02540CSR EXCPT PUT PROMPT 02550CSR SETOF 72 02560CSR ENDSR 02570C*********************************************************************** 02580CSR SR73 BEGSR 02590C* PUT ERROR MESSAGE TO TERMINAL 02600CSR SETON 73 02610CSR EXCPT PUT MSG 02620CSR SETOF 73 02630CSR ENDSR 02640C******************************************************************* 02650CSR SR75 BEGSR 02660C* READ FROM TERMINAL 02670CSR SETOF 779096 02680CSR SETOF 939291 02690CSR SETOF 898887 02700CSR SETOF 8685 02710CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 02720CSR MOVE BLK16 W16A 16 BUFFER 02730CSR EXITFQBELL RING BELL 02740CSR EXITFQWREED READ FROM TERMINAL 02750CSR RLABL W16A READ BUFFER ÐÐ02760CSR RLABL BUFLGT READ BUFFER LGTH 02770CSR MOVEAW16A A16 INPUT DATA ARRAY 02780CSR MOVE BLK16 W16A INIT INPUT ARRAY 02790CSR Z-ADD1 W 30 02800CSR '\' LOKUPA16,W 90 FLAG ESC 02810CSRN90 GOTO T75B NOT ESC 02820CSR 1 ADD W W 02830CSR W COMP 16 54 02840CSR 54 GOTO T75A BAD ESC 02850CSR A16,W COMP 'G' 98 GOODBY 02860CSR A16,W COMP 'E' 94 MENU 02870CSR A16,W COMP 'N' 93 NEW ITEM 02880CSR 98 02890COR 94 02900COR 93 GOTO END75 GOOD ESC 02910C*------------------------------------------------------------------ 02920CSR T75A TAG 02930C* FLAG BAD ESC INPUT 02940CSR Z-ADD318 M 50 96 FLAG ERROR 02950CSR GOTO END75 02960C*-------------------------------------------------------------------- 02970CSR T75B TAG 02980C* MOVE DATA 02990CSR Z-ADD1 W 03000CSR ' ' LOKUPA16,W 77 ÐÐ03010CSR 77 MOVEAA16,W W16A INPUT DATA 03020C*-------------------------------------------------------------------- 03030CSR END75 ENDSR 03040C******************************************************************** 03050CSR SR80 BEGSR 03060C* GET MASTER RECORD 03070CSR TRRN COMP 0 54 03080CSRN54 Z-ADD1 TRRN 03090CSR TRRN CHAINMATLDIST 60 GET MASTER 03100CSR ENDSR 03110C********************************************************************** 03120CSR SR89 BEGSR 03130C* GET MESSAGE MASTER 03140CSR M CHAINMGFILE 54 03150CSR 54 MOVE BLK35 MGTEXT 03160CSR 54 MOVELM MGTEXT 03170CSR ENDSR 03180C*********************************************************************** 03190CSR SR101 BEGSR 03200C* 1-TIME INITIALIZE 03210CSR MOVE BIT,1 NUL 03220CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 03230CSR Z-ADD1 FLIMIT 30 TOTAL NUMB FIELDS 03240CSR MOVE ' ' BLK16 16 03250C* GET PORT # AND CRTFILE ÐÐ03260CSR MOVE ' ' W8A 8 03270CSR Z-ADD0 W2N 20 03280CSR Z-ADD0 W1N 10 03290CSR MOVE ' ' W2A 2 03300CSR EXITFPGMINX GET PORT # 03310CSR RLABL W8A 03320CSR RLABL W2N 03330CSR RLABL W1N 03340CSR RLABL W2A 03350CSR MOVE W2A PORT 20 PORT NO. 03360CSR PORT COMP 0 54 03370CSRN54 Z-ADD25 PORT DEFAULT 03380CSR PORT CHAINCRTFILE H9 GET CRTFILE 03390CSR H9 GOTO ENDJOB 03400CSR EXSR SR71 PUT HEADING 03410C* DEFINE WORK FIELDS,ETC. 03420CSR MOVE ' ' BLK35 35 03430CSR MOVE ' ' BLK20 20 03440CSR ENDSR 03450C********************************************************************** 03460CSR SR102 BEGSR 03470C* VALIDATE FIELD NO. 03480CSR F COMP 0 54 03490CSRN54 Z-ADD1 F 03500CSR F COMP FLIMIT 55 ÐÐ03510CSR 55 Z-ADD1 F 03520CSR ENDSR 03530C******************************************************************** 03540CSR SR103 BEGSR 03550C* MOVE INPUT DATA 03560CSR EXSR SR201 IDENTIFY-F 03570CSR EXSR SR202 R. JUSTIFY 03580CSR 01 MOVE W10A TRRN 50 REC # 03590CSR MOVE ' ' DUN,F EDIT FLAG 03600CSR ENDSR 03610C******************************************************************** 03620CSR SR104 BEGSR 03630C* EDIT INPUT DATA 03640CSR 96 MOVE ' ' DUN,F EDIT FLAG 03650CSRN96 MOVE 'X' DUN,F 03660CSR ENDSR 03670C*********************************************************************** 03680CSR SR105 BEGSR 03690C* FINAL EDIT 03700CSR SETOF 77 03710CSR SETON 79 FINAL EDIT FLAG 03720CSR Z-ADD1 F 96 03730C*-------------------------------------------------------------------- 03740CSR T105A TAG 03750CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD ÐÐ03760CSRN54 GOTO END105 03770CSR EXSR SR201 IDENTIFY-F 03780CSR EXSR SR104 EDIT 03790CSRN96 GOTO T105A 03800C*-------------------------------------------------------------------- 03810CSR END105 TAG 03820CSR SETOF 79 03830CSR ENDSR 03840C******************************************************************** 03850CSR SR106 BEGSR 03860C* DISPLAY MATL DISTR FILE. 03870CSR EXSR SR80 GET MATLDIST 03880CSR 60 GOTO END106 END FILE 03890CSR MDTRAN LOKUPTABTRN TABNAM 54 03900CSR 54 MOVE TABNAM TRNNAM 17 03910CSRN54 MOVE BLK35 TRNNAM 03920CSRN54 MOVELMDREAS TRNNAM 03930CSR MOVELMDPN W12A 12 03940CSR MOVE ' ' W12A 03950CSR W12A CHAINPMMST2 60 03960CSR 60 MOVE BLK35 PMDESC 03970CSR MDREAS LOKUPTABRC TABRN 54 03980CSR 54 MOVE TABRN REASON 15 03990CSRN54 MOVE BLK20 REASON REASON CODE/NAME 04000CSR EXSR SR71 DISPLAY DATA ÐÐ04010CSR EXSR SR72 04020CSR EXSR SR75 READ 04030CSR 90 GOTO END106 04040CSR 77 EXSR SR202 04050CSR 77 MOVE W10A TRRN 04060CSRN77 1 ADD TRRN TRRN 04070CSR GOTO SR106 DO AGAIN 04080CSR END106 ENDSR 04090C************************************************************************ 04100CSR SR201 BEGSR 04110C* IDENTIFY FIELD NO. 04120CSR F COMP 1 01 04130CSR ENDSR 04140C********************************************************************** 04150CSR SR202 BEGSR 04160C* RIGHT JUSTIFY 04170CSR F LOKUPNUM 54 04180CSRN54 GOTO END202 NOT NUMERIC FIELD 04190CSR Z-ADD10 W2N 20 04200CSR MOVELW16A W10A 10 04210CSR EXIT SUBRAJ R. JUSTIFY 04220CSR RLABL W2N 04230CSR RLABL W10A 04240CSR END202 ENDSR 04250O******************************************************************** ÐÐ04260OTERM132 E 71 04270O DOT 30 04280O 11 'RECORD TYPE' 04290O TRNNAM 41 04300O*------------------------------------------------------------------- 04310O E 71 04320O DOT 30 04330O 11 'ACCOUNT NO.' 04340O MDPRIM 38 04350O 39 '-' 04360O MDDASH 42 04370O GLDESC 82 04380O*------------------------------------------------------------------- 04390O E 71 04400O DOT 30 04410O 14 'WORK ORDER NO.' 04420O MDWOP 38 04430O 39 '-' 04440O MDWOD 42 04450O*------------------------------------------------------------------- 04460O E 71 04470O DOT 30 04480O 15 'PURCH ORDER NO.' 04490O MDPOP 38 04500O 39 '-' ÐÐ04510O MDPOD 42 04520O*------------------------------------------------------------------- 04530O E 71 04540O DOT 30 04550O 8 'QUANTITY' 04560O 45 15 'ISSUED' 04570O 46 17 'RECEIVED' 04580O MDQTY 2 41 04590O*-------------------------------------------------------------------- 04600O E 71 45 04610O DOT 30 04620O 21 'QUANTITY BACK-ORDERED' 04630O MDBOQ 2 41 04640O*------------------------------------------------------------------- 04650O E 71 04660O DOT 30 04670O 19 'STANDARD TOTAL COST' 04680O MDCST 2 45 04690O*------------------------------------------------------------------- 04700O E 71 04710O DOT 30 04720O 19 'STANDARD LABOR COST' 04730O MDS,1 2 45 04740O*------------------------------------------------------------------- 04750O E 71 ÐÐ04760O DOT 30 04770O 21 'STANDARD LABOR BURDEN' 04780O MDS,2 2 45 04790O*------------------------------------------------------------------- 04800O E 71 04810O DOT 30 04820O 22 'STANDARD MATERIAL COST' 04830O MDS,3 2 45 04840O*------------------------------------------------------------------- 04850O E 71 04860O DOT 30 04870O 24 'STANDARD MATERIAL BURDEN' 04880O MDS,4 2 45 04890O*------------------------------------------------------------------- 04900O E 71 47 04910O DOT 30 04920O 11 'REASON CODE' 04930O MDREAS 33 04940O REASON 55 04950O*------------------------------------------------------------------- 04960O E 71 04970O DOT 30 04980O 10 'DATE INPUT' 04990O MDDATEY 40 05000O*------------------------------------------------------------------- ÐÐ05010O E 71 05020O DOT 30 05030O 10 'EMPLOYEE #' 05040O*------------------------------------------------------------------- 05050O E 72 05060O NUL 132 05070O 16 'ENTER RECORD # ' 05080O* 05090O* 05100O* 05110O* 05120O* 05130O* 05140O* 05150O* 05160O* ** NUL ARRAY 005170 005180** A16 ARRAY 005190 005200** NUM ARRAY 005210001 TRAN 005220** DUN ARRAY 005230 005240** TABTRN/TABNAM - TRAN NAMES 05250ÐÐ1UNPLAN RECEIPT 052602PO TO STOCK 052703WO TO STOCK 052804SALES RET TO STK 052905 053006 053107UNPLAN ISSUE 053208PLAN ISSUE 053309SALES ISSUE 005340CWORK ORDER CLOSE 05350** TABRC/TABRN (REASON CODE/NAME) 05360AATTRITION 05370CCOUNT ERROR 05380EE.C.N. 05390LLOST 05400RREJECT 05410** DOT ARRAY 05420- - - - - - - - - - - - - - -> 05430/* 05440_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(2O& 2X035WM P999999120282(èÈÐ00010H Q035WM00020F* INIT SFPNACNT FILE. (X035WM) 00030F* REVISED 11-23-81 3:35 PM. 00040FBITTAB IP F 33 DISK 00050FSFPNACNTO F 16 DISK 00060I******************************************************************** 00070IBITTAB BT 01 00080I 1 33 BIT 00090O******************************************************************** 00100OSFPNACNTD 01 00110O 5 '00000' /* _‚ ÐÐ ÐÐ_‚_‚ ÐÈ( O<  NX206SF P120282120282(èÈÐ00010H Q206SF00020F* EXPLODE COMPONENT REQMTS FOR PLAN WORK ORDER ADD 00030F* REVISED 5/19/81 4:25 PM. 00040FBITTAB IP F 33 DISK 00050FCRTFILE IC F 256R DISK 00060FSFTRAN UC F 128R DISK 00070FSFMAST UC F 128R29AI 1 DISK A 00080FALTKEY UC F 32R29AI 1 DISK A 00090FPMMST2 UC F 674R12AI 1 DISK 00100FBMMAST ID F 86L20AI 1 DISK 00110FSFEXCPTNUC F 11R10AI 1 DISK A 00120FTERM132 O F 132 5 00130E******************************************************************** 00140E A29 29 29 1 00150E LEV 1 20 20 00160E QTY 1 20 7 0 00170E MHR 12 7 3A MFG ROUT HRS 00180E MDP 12 3 0 MFG ROUT DEPT 00190I****************************************************************** 00200IBITTAB BT 00210I 1 33 BIT 00220I***************************************************************** 00230ICRTFILE CR 00240I 81 850CRRRN 00250I******************************************************************** ÐÐ00260ISFTRAN ST 06 17 C4 18 C0 125 CA 00270I AND 126 CS 127 C2 128NCD 00280I OR 17 C4 18 C0 125 CC 00290I AND 126 CS 127 C2 128NCD 00300I OR 18 00310I* RANDOM UPDATE TRAN FILE 00320I* INDICATOR TRANSACTION 00330I* 06 EXPLODE PLANNED REQUIREMENTS (PLAN WO ADD) 00340I* 18 GARBAGE 00350I 1 100STPN 00360I 11 160STDUE 00370I 17 18 STREC 00380I 19 29 STORD 00390I 1 29 STKEY 00400I P 30 330STQTY 00410I P 34 370STQTYC 00420I* 38 430STDLT 00430I* P 44 460STCUST 00440I* 47 560STNAPN 00450I* P 57 600STQPA 00460I* 61 62 STISSU 00470I* P 63 640STPULL 00480I 65 66 STREV 00490I P 67 700STQTYA 00500I* 71 90 STCPO ÐÐ00510I* P 91 953STPRIC 00520I* P 96 970STSEQ 00530I 98 1030STSTRT 00540I* 104 104 STRFLG 00550I* 105 113 STPREQ 00560I 123 1240STTERM 00570I* 125 125 STTRAN 00580I 128 128 STSTAT 00590I******************************************************************** 00600ISFMAST SF 00610I* SCHEDULE MASTER. 00620I* COMMON FIELDS. 00630I* KEY AREA. 00640I* PART NO. 10N 00650I* 1 100SFPN 00660I* DATE DUE 6N (YMD) 00670I* 11 160SFDUE 00680I* RECORD CODE 2N 00690I* 10 = RECEIVED PO 00700I* 20 = REL WO 00710I* 30 = PURCHASE ORDER 00720I* 40 = PLAN WO 00730I* 50 = PURCHASE REQ 00740I* 60 = SALES ORDER-BACKLOG 00750I* 70 = REL REQUIREMENT ÐÐ00760I* 80 = PLAN REQUIREMENT 00770I* 90 = FORECAST 00780I 17 180SFREC 00790I* ORDER NO. 00800I* 19 29 SFORD 00810I* PREFIX 1A 00820I* 19 19 SFPRFX 00830I* PRIME 6A 00840I* 19 24 SFPRIM 00850I* DASH 3N 00860I* 25 270SFDASH 00870I* RECEIVING LOG # 2N 00880I* 28 290SFRLOG 00890I* QUANTITY 7P 00900I P 30 330SFQTY 00910I* QUANTITY COMPLETE 7P 00920I P 34 370SFQTYC 00930I* DATE LAST TRAN 6N (YMD) 00940I* 38 430SFDLT 00950I* CUST #/DEPT #/VEND # 5P 00960I P 44 460SFCUST 00970I* VARIABLE AREA. 00980I* PLAN/REL REQMTS 00990I* NEXT ASSY PART # 10N 01000I* 47 560SFNAPN ÐÐ01010I* QTY PER ASSY 7P 01020I* P 57 600SFQPA 01030I* ISSUE CODE 2A 01040I* 61 62 SFISSU 01050I* PULL # 3P 01060I* P 63 640SFPULL 01070I* ASSY REVISION 2A 01080I 65 66 SFREV 01090I* ASSY WO QTY 7P 01100I P 67 700SFQTYA 01110I* SALES ORDERS. 01120I* CUST P.O. 20A 01130I* 71 90 SFCPO 01140I* UNIT PRICE 9.3P 01150I* P 91 953SFPRIC 01160I* PURCH ORDERS 01170I* VENDOR NAME 20A 01180I* SEE SFCPO UNDER SALES ORDERS. 01190I* UNIT PRICE 9.3P 01200I* SEE SFPRIC UNDER SALES ORDERS. 01210I* WORK ORDERS. 01220I* DEPT NAME 20A 01230I* SEE SFCPO UNDER SALES ORDERS. 01240I* OPER SEQ # 3P 01250I* P 96 970SFSEQ ÐÐ01260I* START DATE 6N 01270I* 98 1030SFSTRT 01280I* PULL # 3P 01290I* SEE PLAN/REL REQMTS. 01300I* RQMT FLAG 1A 01310I 104 104 SFRFLG 01320I* REVISION 2A 01330I* SEE PLAN/REL REQMTS. 01340I* AVAIL STOCK 7P 01350I P 120 1230SFSAVQ 01360I* AVAIL BAL 7P 01370I P 124 1270SFAVQ 01380I* RECORD STATUS 1A 01390I 128 128 SFSTAT 01400I******************************************************************** 01410ISFEXCPTNSE 01420I 1 100SEPN 01430I******************************************************************** 01440IALTKEY AK 21 1 CA 01450I OR 22 1 CB 01460I OR 25 1 CE 01470I OR 26 1 CF 01480I* ALTERNATE KEY FILE FOR SFMAST. 01490I* 21 = ORDER ALT KEY FILE 01500I* 22 = DUE DATE ALT KEY FILE ÐÐ01510I* 25 = START DATE ALT KEY FILE 01520I* 26 = SECONDARY PROCESSING FILE 01530I* COL-2 DEFINITIONS. 01540I* 1 = RECD PO 01550I* 3 = PO 01560I* 5 = PUR REQ 01570I* 6 = SALES ORDER 01580I* 7 = REL REQMT 01590I* 8 = PLAN REQMT 01600I* 9 = FORECAST 01610I* W = WORK ORDER 01620I* COMMON FIELDS. 01630I* RECORD CODE (SEE ABOVE) 2A 01640I 1 2 AKREC 01650I* RECORD STATUS 1A 01660I 32 32 AKSTAT 01670I* NON-COMMON FIELDS. 01680I*------------------------------------------------------------------- 01690I* DUE DATE ALT-KEY - 01700I* KEY AREA. 01710I* DUE DATE 6N 01720I 3 80AKDUE 22 01730I* PART NO. 10N 01740I 9 180AKPN 22 01750I* ORDER NO. 11A ÐÐ01760I 19 29 AKORD 22 01770I* PREFIX 1A 01780I 19 19 AKPRFX 22 01790I* PRIME 5N 01800I 20 240AKPRIM 22 01810I* DASH 3N 01820I 25 270AKITEM 22 01830I* RECEIVNG LOG # 01840I 28 290AKRLOG 22 01850I*------------------------------------------------------------------- 01860I* START DATE ALT-KEY - 01870I* KEY AREA. 01880I* START DATE 6N 01890I 3 80AKSTRD 25 01900I* PART NO. 10N 01910I 9 180AKPN 25 01920I* ORDER NO. 11A 01930I 19 29 AKORD 25 01940I* PREFIX 1A 01950I 19 19 AKPRFX 25 01960I* PRIME 5N 01970I 20 240AKPRIM 25 01980I* DASH 3N 01990I 25 270AKITEM 25 02000I* RECEIVING LOG 2N ÐÐ02010I 28 290AKRLOG 25 02020I******************************************************************** 02030IPMMST2 PM 02040I* PART MASTER RECORD. 02050I* KEY AREA 02060I* PART NO. 10N 02070I 1 100PMPN 02080I* CUR CHG LEVEL 2A 02090I 70 71 PMECHG 02100I* CALCULATED DATA. 02110I* CURRENT BALANCES. 02120I* ON HAND STOCK 7P 02130I* P 311 3140PMOHB 02140I* REQUIRED QTYS. 02150I* FORECAST BAL 7P 02160I* P 315 3180PMFRCB 02170I* ALLOCATIONS 7P 02180I P 319 3220PMALB 02190I* MFG ROUTING HRS 12 X 7.3P 02200I P 543 590 MHR 02210I* MFG ROUTING DEPT 12 X 3P 02220I P 591 614 MDP 02230I* RECORD STATUS 1A 02240I* D = DELETED 02250I 674 674 PMSTAT ÐÐ02260I******************************************************************** 02270IBMMAST BM 02280I* BILL OF MATERIAL RECORD 02290I* KEY AREA 02300I* ASSY PART NO. 10N 02310I 1 100BMAPN 02320I* COMPONENT PART # 10N 02330I 11 200BMCPN 02340I* ITEM NO. 3N 02350I 25 270BMITNO 02360I* QTY PER ASSY 7P 02370I P 28 310BMQTY 02380I* FILLER 32 33 FFFFFF 02390I* SCRAP ALLOW .2N 02400I 34 352BMSCRP 02410I* ISSUE CODE 2A 02420I* PT = PULL TIME 02430I* OR = ON REQUEST 02440I* BI = BULK ISSUE 02450I* AR = AS REQUIRED 02460I* RA = REF ASSY 02470I* TD = TRAV DOC 02480I* SD = SHIP DOC 02490I* RD = REF DOC 02500I* VS = VENDOR SUPPLIED ÐÐ02510I 36 37 BMISSU 02520I* EFFECTIVITY. 02530I* BEGIN CHANGE LEVEL 2A 02540I 38 39 BMBCHG 02550I* ENDING CHANGE LEVEL 2A 02560I 40 41 BMECHG 02570I* BEGIN ECN # 5A 02580I 42 46 BMBECN 02590I* ENDING ECN # 5A 02600I 47 51 BMEECN 02610I* DISPOSITION CODE 1A 02620I* U = USE UP OLD STYLE 02630I* N = NOW (IMMEDIATE) 02640I 52 52 BMDISP 02650I* FILLER 5A 53 57 FFFFFF 02660I* ROUTING. 02670I* OPER NO. 5P 02680I P 58 600BMOPER 02690I* DEPT NO. 5P 02700I P 61 630BMDEPT 02710I* WORK CENTER NO. 3P 02720I P 64 650BMWC 02730I* COMPONENT OPER REFERENCE INFO 10A 02740I 66 75 BMREF 02750I* FILLER 10A 76 85 FFFFFF ÐÐ02760I* 02770I* RECORD STATUS 1A 02780I* D = DELETED 02790I 86 86 BMSTAT 02800C******************************************************************** 02810C* INITIALIZE 1-TIME. 02820C N79 EXSR SR101 INIT. 02830C 18 GOTO ENDJOB 02840C PORT COMP STTERM 54 02850C N54 PORT COMP 25 54 02860C N54 SETOF 06 02870C N54 GOTO ENDJOB 02880C* VERIFY SFMAST WORK ORDERS. 02890C EXSR SR102 VERIFY WO 02900C N18 GOTO TAG500 EXPL-PLAN-REQ 02910C GOTO ENDJOB 02920C*------------------------------------------------------------------- 02930C TAG500 TAG 02940C* EXPLODE BILL MATERIAL. 02950C Z-ADDSTPN W10N 100 02960C EXSR SR80 GET ASSY PMMST. 02970C 60 GOTO END NOT ON FILE 02980C MOVELPMPN W20A 20 02990C MOVE BLK20 LEV 03000C Z-ADD2 L 30 ÐÐ03010C Z-ADDPMPN CURASY 100 03020C MOVE PMECHG ASYREV 2 03030C STQTY SUB STQTYC ASYQTY 70 03040C STQTY SUB STQTYC CUMQTY 70 54 03050C N54 GOTO END NO QTY 03060C*------------------------------------------------------------------- 03070C TAG530 TAG 03080C W20A SETLLBMMAST 03090C*------------------------------------------------------------------- 03100C TAG540 TAG 03110C* READ BILL MATERIAL. 03120C SETOF 54 03130C READ BMMAST 54 03140C 54 GOTO TAG560 END FILE. 03150C BMAPN COMP CURASY 54 03160C N54 GOTO TAG560 WRONG ASSY #. 03170C BMSTAT COMP 'D' 54 03180C 54 GOTO TAG540 DELETED. 03190C Z-ADDBMQTY QTY5 50 03200C Z-ADDBMCPN W10N 03210C EXSR SR80 GET COMP PMMST. 03220C 60 GOTO TAG540 03230C SETOF 5556 03240C BMISSU COMP 'RA' 54 FLAG REF ASSY (FLOW)03250C N54 GOTO TAG550 NOT REF ASSY. ÐÐ03260C* SAVE DATA. GO DOWN 1-INDENTURE. 03270C MOVELBMAPN LEV,L 03280C 1 ADD BMCPN W10N 03290C MOVE W10N LEV,L 03300C CUMQTY MULT BMQTY EXTQTY 03310C Z-ADDCUMQTY QTY,L 03320C Z-ADDEXTQTY CUMQTY 03330C MOVE BMCPN CURASY 03340C MOVELCURASY W20A 03350C MOVE ZERO10 W20A 03360C 1 ADD L L 03370C GOTO TAG530 03380C*------------------------------------------------------------------- 03390C TAG550 TAG 03400C* UPDATE REQUIREMENTS. 03410C MOVELBMISSU W1A 1 03420C W1A COMP 'R' 54 FLAG REF ITEM 03430C N54 EXSR SR104 UPDATE REQMTS. 03440C GOTO TAG540 GET NEXT. 03450C*------------------------------------------------------------------- 03460C TAG560 TAG 03470C* GET SAVED HIGHER LEVEL, IF ANY. 03480C L SUB 1 L 54 03490C N54 GOTO END 03500C LEV,L COMP BLK20 54 ÐÐ03510C N54 GOTO TAG560 03520C MOVE LEV,L W20A 03530C MOVELLEV,L CURASY 03540C Z-ADDQTY,L CUMQTY 03550C MOVE BLK20 LEV,L 03560C Z-ADD0 QTY,L 03570C GOTO TAG530 03580C*------------------------------------------------------------------- 03590C END TAG 03600C*------------------------------------------------------------------- 03610C ENDJOB TAG 03620CLRN79 EXSR SR101 INIT 03630CLR MOVEL'Q010SF' PROG 8 03640CLR EXITFCHAIN 03650CLR RLABL PROG 03660C******************************************************************** 03670CSR SR80 BEGSR 03680C* GET PART MASTER. 03690CSR MOVELW10N W12A 12 03700CSR MOVE ' ' W12A 03710CSR W12A CHAINPMMST2 60 GET PMMST2 03720CSRN60 PMSTAT COMP 'D' 60 03730CSR ENDSR 03740C******************************************************************** 03750CSR SR81 BEGSR ÐÐ03760C* GET ALT KEY. 03770CSR W29A CHAINALTKEY 60 03780CSR ENDSR 03790C***************************************************************** 03800CSR SR82 BEGSR 03810C* GET ALTKEY. 03820CSR W29A CHAINALTKEY 60 GET ORDERLOG 03830CSR ENDSR 03840C******************************************************************** 03850CSR SR85 BEGSR 03860C* UPDATE ALTKEY. 03870CSR SETON 85 03880CSR EXCPT UPD ALTKEY 03890CSR SETOF 85 03900CSR ENDSR 03910C******************************************************************** 03920CSR SR101 BEGSR 03930C* 1-TIME INITIALIZE. 03940CSR SETON 79 03950CSR MOVE ' 'W8A 8 03960CSR Z-ADD0 W2N 20 03970CSR Z-ADD0 W1N 10 03980CSR MOVE ' ' W2A 2 03990CSR EXITFPGMINX GET PORT # 04000CSR RLABL W8A ÐÐ04010CSR RLABL W2N 04020CSR RLABL W1N 04030CSR RLABL W2A 04040CSR MOVE W2A PORT 20 04050CSR PORT COMP 0 54 04060CSRN54 Z-ADD25 PORT PORT # 04070CSR PORT CHAINCRTFILE H9 04080CSR H9 GOTO END101 04090CSR CRRRN CHAINSFTRAN H8 04100CSR H8 GOTO END101 04110CSR MOVELUDATE W4N 40 04120CSR MOVE UDATE W2N 20 04130CSR MOVELW2N TODAY 60 04140CSR MOVE W4N TODAY 04150CSR MOVE ' ' BLK29 29 04160CSR MOVE ' ' BLK20 20 04170CSR Z-ADD0 ZERO10 100 04180CSR Z-ADD0 ZERO7 70 04190CSR Z-ADD0 ZERO9 90 04200CSR SETON 72 04210CSR EXCPT TERMINAL MSG 04220CSR SETOF 72 04230CSR END101 ENDSR 04240C******************************************************************** 04250CSR SR102 BEGSR ÐÐ04260C* VERIFY WORK ORDERS. 04270CSR STKEY CHAINSFMAST 60 04280CSRN60 SFSTAT COMP 'D' 61 04290CSR 60 NOT ON FILE 04300COR 61 GOTO T102Z DELETED WORK ORDER 04310CSR SFQTY COMP SFQTYC 54 04320CSRN54 GOTO T102Z NO ACTIVE QTY 04330CSR SFSTAT COMP 'R' 54 04340CSRN54 GOTO END102 NOT OPEN/REL WO 04350CSR MOVE 'D' SFSTAT 04360CSR SETON 83 04370CSR EXCPT DELETE OPEN WO 04380CSR SETOF 83 04390CSR GOTO END102 04400C*------------------------------------------------------------------- 04410CSR T102Z TAG 04420CSR SETON 18 04430CSR END102 ENDSR 04440C******************************************************************** 04450CSR SR104 BEGSR 04460C* UPDATE SFMAST REQMTS. 04470CSR MOVELBMISSU W1A 04480CSR W1A COMP 'B' 54 04490CSRN54 W1A COMP 'R' 54 04500CSR 54 GOTO END104 ÐÐ04510CSR MOVE ' ' A29 04520CSR MOVE BMCPN W10A 10 04530CSR MOVEAW10A A29 04540CSR MOVE STSTRT W6A 6 04550CSR MOVEAW6A A29,11 04560CSR MOVEA'80' A29,17 04570CSR MOVEASTORD A29,19 04580CSR MOVEAA29 W29A 29 04590CSR BMQTY MULT CUMQTY EXTQTY 70 54 04600CSRN54 GOTO END104 NO QTY 04610CSR W29A CHAINSFMAST 60 04620CSRN60 SFSTAT COMP 'D' 54 04630CSRN60 54 04640COR 60 EXSR SR201 INIT SFMAST 04650CSR SFQTY ADD EXTQTY EXTQTY 04660CSR EXTQTY ADD PMALB PMALB 04670CSR MOVE 'A' SFSTAT 04680CSR SETON 82 UPD PMMST2 04690CSR EXCPT ADD SFMAST 04700CSR SETOF 82 04710C* UPDATE ALT KEYS. 04720CSR EXSR SR204 ALTKEY 04730CSR END104 ENDSR 04740C******************************************************************** 04750CSR SR201 BEGSR ÐÐ04760C* INITIALIZE SFMAST 04770CSR Z-ADD0 SFQTYC 04780CSR Z-ADD0 SFQTY 04790CSR ENDSR 04800C******************************************************************** 04810CSR SR204 BEGSR 04820C* UPDATE ALTKEY FILE. 04830C* UPDATE ORDER ALT KEY. 04840CSR MOVE ' ' A29 04850CSR MOVEA'A8' A29,1 PLAN REQMT 04860CSR MOVEASTORD A29,3 04870CSR MOVE BMCPN W10A 10 04880CSR MOVEAW10A A29,14 PART # 04890CSR MOVE STSTRT W6A 6 04900CSR MOVEAW6A A29,24 DUE DATE 04910CSR MOVEAA29 W29A 04920CSR EXSR SR81 GET ALTKEY 04930CSR EXSR SR85 ADD ALTKEY-ORDER 04940CSR BMCPN CHAINSFEXCPTN 60 04950CSR SETON 84 04960CSR EXCPT UPD EXCPTN STATUS 04970CSR SETOF 84 04980C* UPDATE DUE ALT KEY. 04990CSR MOVE ' ' A29 INIT KEY ARRAY 05000CSR 06 MOVEA'B8' A29,1 RECORD CODE ÐÐ05010CSR MOVE STSTRT W6A 6 WO START DATE 05020CSR MOVEAW6A A29,3 REQMT DUE DATE 05030CSR MOVE BMCPN W10A B/M COMPONENT PN 05040CSR MOVEAW10A A29,9 REQMT PART NO. 05050CSR MOVEASTORD A29,19 WORK ORDER # 05060CSR MOVEAA29 W29A ALTKEY KEY FIELD 05070CSR EXSR SR81 GET ALTKEY 05080CSR EXSR SR85 ADD ALTKEY-DUE 05090CSR ENDSR 05100O**************************************************************** 05110OSFTRAN D 06 05120O STQTY 33P 05130O STQTYC 37P 05140O STQTYA 70P 05150O 128 'D' 05160O******************************************************************** 05170OSFMAST EADD 82 60 05180O W29A 29 05190O EXTQTY 33P 05200O SFQTYC 37P 05210O TODAY 43 05220O BMDEPT 46P 05230O STPN 56 05240O BMQTY 60P 05250O BMISSU 62 ÐÐ05260O ASYREV 66 05270O ASYQTY 70P 05280O ZERO7 123P 05290O ZERO7 127P 05300O SFSTAT 128 05310O*------------------------------------------------------------------- 05320O E 82N60 05330O OR 83 05340O EXTQTY 33P 05350O SFQTYC 37P 05360O TODAY 43 05370O BMDEPT 46P 05380O STPN 56 05390O BMQTY 60P 05400O BMISSU 62 05410O ASYREV 66 05420O ASYQTY 70P 05430O ZERO7 123P 05440O ZERO7 127P 05450O SFSTAT 128 05460O******************************************************************** 05470OALTKEY EADD 85 60 05480O W29A 29 05490O 32 'A' 05500O*------------------------------------------------------------------- ÐÐ05510O E 85N60 05520O 32 'A' 05530O******************************************************************** 05540OPMMST2 E 82 05550O PMALB 322P 05560O MHR 590P 05570O MDP 614P 05580O******************************************************************** 05590OSFEXCPTNEADD 84 60 05600O BMCPN 10 05610O 11 'A' 05620O*------------------------------------------------------------------- 05630O E 84N60 05640O 11 'A' 05650O***************************************************************** 05660OTERM132 E 72 U1 05670O 27 '2NDARY-UPDATE, PHASE-1' ** A29 ARRAY 005680 005690** LEV ARRAY 005700 005710** QTY ARRAY 005720 005730/* 005740_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(,P‹ ,}X207SF P120282120282(èÈÐ00010H Q207SF00020F* SCHEDULE FILE SYSTEM PROGRAM LOADER. (X207SF) 00030F* REVISED 4/02/81 9:55 AM. 00040FBITTAB IP F 33 DISK 00050FSFTRAN IC F 128R DISK 00060FCRTFILE UC F 256R DISK 00070FTERM70 O F 70 5 U1 00080E******************************************************************** 00090E BIT 33 1 00100E CALL 5 6 A 00110I******************************************************************** 00120IBITTAB BT 00130I 1 33 BIT 00140I********************************************************************* 00150ICRTFILE CR 00160I 38 67 CALL 00170I 68 73 CRRET 00180I 74 79 CRMENU 00190I 81 850CRRRN 00200I******************************************************************** 00210ISFTRAN ST 00220I* COMMON DATA FIELDS 00230I* KEY AREA. 00240I* PART NO. 10A 00250I 1 10 STPN ÐÐ00260I* DATE DUE 6N (YMD) 00270I 11 160STDUE 00280I* RECORD CODE 2A 00290I* 10 = RECEIVED PO 00300I* 20 = REL WO 00310I* 30 = PURCHASE ORDER 00320I* 40 = PLAN WO 00330I* 50 = PURCHASE REQ 00340I* 60 = SALES ORDER-BACKLOG 00350I* 70 = REL REQUIREMENT 00360I* 80 = PLAN REQUIREMENT 00370I* 90 = RUN RELEASE 00380I 17 180STREC 00390I* ORDER NO. 9A 00400I 19 27 STORD 00410I* PREFIX 1A 00420I 19 19 STPRFX 00430I* PRIME 6A 00440I 19 24 STPRIM 00450I* ITEM 3N 00460I 25 270STITEM 00470I* RECEIVING LOG # 00480I 28 290STRLOG 00490I* QUANTITY 7P 00500I P 30 330STQTY ÐÐ00510I* QTY COMPLETE 7P 00520I P 34 370STQTYC 00530I* DATE LAST TRAN 6N (YMD) 00540I 38 430STDLT 00550I* CUST #/DEPT #/VEND # 3P 00560I P 44 460STCUST 00570I* PLAN/REL REQMTS. 00580I* NEXT ASSY PART # 10N 00590I 47 560STNAPN 00600I* QTY PER ASSY 7P 00610I P 57 600STQPA 00620I* ISSUE CODE 2A 00630I 61 62 STISSU 00640I* PULL # 3P 00650I P 63 640STPULL 00660I* ASSY REVISION 2A 00670I 65 66 STREV 00680I* ASSY WO QTY 7P 00690I P 67 700STQTYA 00700I* SALES ORDERS 00710I* CUST P.O. 20A 00720I 71 90 STCPO 00730I* UNIT PRICE 9.3P 00740I P 91 953STPRIC 00750I* PURCH ORDERS ÐÐ00760I* VENDOR NAME 20A 00770I* SEE SFCPO UNDER SALES ORDERS. 00780I* UNIT PRICE 9.3P 00790I* SEE SFPRIC UNDER SALES ORDERS. 00800I* PURCH REQ # 9A 00810I 105 113 STPREQ 00820I* WORK ORDERS 00830I* REVISION 2A 00840I* SEE PLAN/REL REQMTS. 00850I* DEPT NAME 20A 00860I* SEE SFCPO UNDER SALES ORDERS. 00870I* OPER SEQ # 3P 00880I P 96 970STSEQ 00890I* START DATE 6N 00900I 98 1030STSTRT 00910I* PULL # 3P 00920I* SEE PLAN/REL REQMTS. 00930I* REQUIREMENT FLAG 1A 00940I 104 104 STRFLG 00950I* IN USE--- SEE ABOVE 105 113 00960I* TERMINAL # 2N 00970I 123 1240STTERM 00980I* TRAN CODE 1A 00990I* A = ADD 01000I* C = CHANGE ÐÐ01010I* D = DELETE 01020I* # = DELETE ALL 01030I* E = EXPLODE 01040I* V = CONVERT 01050I 125 125 STTRAN 01060I* FILE CODE 1A 01070I* S = SFMAST 01080I* A = ALTKEY 01090I* B = BOTH 01100I 126 126 STFILE 01110I* PHASE CODE 1A 01120I 127 127 STPHAS 01130I* RECORD STATUS 1A 01140I 128 128 STSTAT 01150C****************************************************************** 01160C* LINK CRITERIA. 01170C* IF PLAN WO ADD------------> Q010SF,Q206SF,MENU 01180C* 01190C* IF REL WO ADD W/FLAG 01200C* OR REL WO CHG 01210C* OR PLAN WO CHG, W/FLAG----> Q010SF,Q201SF,Q203SF,MENU 01220C* 01230C* IF REL WO ADD NO/FLAG-----> Q010SF,Q201SF,Q202SF,MENU 01240C* 01250C* IF PLAN WO CHG NO/FLAG----> Q010SF,Q201SF,Q206SF,MENU ÐÐ01260C* 01270C* IF PO ADD 01280C* OR RECD PO ADD 01290C* OR PLAN WO DEL 01300C* OR REL WO DEL-------------> Q010SF,Q201SF,MENU 01310C****************************************************************** 01320C N79 EXSR SR101 1-TIME INITI 01330C H9 GOTO ENDJOB 01340C*------------------------------------------------------------------- 01350C START TAG 01360C* SELECT SFTRAN RECORD TO BE PROCESSED 01370C Z-ADD0 P 30 01380C 1 ADD CRRRN CRRRN REL REC NO. 01390C CRRRN CHAINSFTRAN 54 01400C 54 GOTO DONE END OF FILE 01410C STTERM COMP PORT 54 01420C N54 PORT COMP 25 54 01430C N54 GOTO START WRONG TERMINAL 01440C STSTAT COMP 'D' 54 01450C 54 GOTO START PREV PROCESSED 01460C* CLASSIFY TRANSACTION 01470C STTRAN COMP 'A' 60 ADD 01480C STTRAN COMP 'C' 61 CHANGE 01490C STTRAN COMP 'D' 62 DELETE 01500C STREC COMP 10 01 RECEIVED PO ÐÐ01510C STREC COMP 20 02 REL WO 01520C STREC COMP 30 03 P0 01530C STREC COMP 40 04 PLAN WO 01540C* SET REQUIREMENT FLAG 01550C 02 REL WO 01560COR 04 STRFLG COMP 'S' 11 PLAN WORK ORDER 01570C* SET-UP CALL SEQUENCE 01580C 04 60 MOVEL'Q206SF' W6A 6 PWO,ADD 01590C 04 60 EXSR SR102 01600C SETOF 55 01610C 02 60 11 RWO,ADD,W/FLG 01620COR 02 61 RWO,CHG 01630COR 04 61 11 SETON 55 PWO,CHG,W/FLG 01640C 55 MOVEL'Q201SF' W6A SEQ UPDATE 01650C 55 EXSR SR102 01660C 55 MOVEL'Q203SF' W6A RAND CONVERSION 01670C 55 EXSR SR102 01680C* DO RWO,ADD,NO FLG 01690C 02 60N11 MOVEL'Q201SF' W6A SEQ UPDATE 01700C 02 60N11 EXSR SR102 01710C 02 60N11 MOVEL'Q202SF' W6A EXPLODE BM 01720C 02 60N11 EXSR SR102 01730C* DO PWO,CHG,NO FLG 01740C 04 61N11 MOVEL'Q201SF' W6A 01750C 04 61N11 EXSR SR102 ÐÐ01760C 04 61N11 MOVEL'Q206SF' W6A 01770C 04 61N11 EXSR SR102 01780C SETOF 55 01790C 03 60 PO,ADD 01800COR 01 60 RPO,ADD 01810COR 04 62 PWO,DEL 01820COR 02 62 SETON 55 RWO,DEL 01830C 55 MOVEL'Q201SF' W6A SEQ UPDATE 01840C 55 EXSR SR102 01850C GOTO END 01860C*---------------------------------------------------------------- 01870C DONE TAG 01880C CRRET COMP ' ' 54 01890C 54 MOVELCRRET PROG 8 01900C N54 MOVELCRMENU PROG 01930C GOTO ENDJOB 01940C*---------------------------------------------------------------- 01950C END TAG 01960C Z-ADD1 X 30 01970C ' ' LOKUPCALL,X 54 01980C N54 GOTO START 01990C MOVELCALL,X PROG 02000C MOVE ' ' CALL,X 02010C*----------------------------------------------------------------- 02020C ENDJOB TAG ÐÐ02030C SETON 97 02040C EXCPT UPDATE CRTFILE 02050C SETOF 97 02060C EXITFCHAIN 02070C RLABL PROG 02080C****************************************************************** 02090CSR SR101 BEGSR 02100C* 1-TIME INIT 02110CSR SETON 79 02120CSR MOVE ' 'W8A 8 02130CSR Z-ADD0 W2N 20 02140CSR Z-ADD0 W1N 10 02150CSR MOVE ' ' W2A 2 02160CSR EXITFPGMINX GET PORT # 02170CSR RLABL W8A 02180CSR RLABL W2N 02190CSR RLABL W1N 02200CSR RLABL W2A 02210CSR MOVE W2A PORT 20 02220CSR PORT COMP 0 54 02230CSRN54 Z-ADD25 PORT 02240CSR PORT CHAINCRTFILE H9 02250CSR H9 GOTO END101 02260CSR MOVE ' ' CALL 02270CSR END101 ENDSR ÐÐ02280C**************************************************************** 02290CSR SR102 BEGSR 02300C* LOAD CALL ARRAY 02310CSR W6A COMP ' ' 54 02320CSRN54 GOTO END102 02330CSR 1 ADD P P 30 02340CSR MOVE W6A CALL,P 02350CSR 1 ADD P X 30 02360CSR MOVEL'Q010SF' CALL,X 02370CSR MOVE ' ' W6A 02380CSR END102 ENDSR 02390O******************************************************************* 02400OCRTFILE E 97 02410O CALL 67 02420O CRRRN 85 02430O***************************************************************** 02440OTERM70 E 97 02450O CALL,1 6 02460O CALL,2 13 02470O CALL,3 20 02480O CALL,4 27 02490O CALL,5 34 02500O CRRET 41 02510O CRMENU 48 02520O PROG 58 ÐÐ02530O CRRRN 65 02540O******************************************************************* /* 002550_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(…Q … X004WC P999999120282(èÈÐ00010H Q004WC00020F* UPDATE WORK CENTER SCHEDULED HOURS FROM WOOPER. (X004WC) 00030F* REVISED 12/02/81 2:50 PM. 00040F* SEE ZWC004. 00050FWCDATES IP F 936 DISK 00060FOPERADRTIR F 300 3 3IT EDISK 00070FWOOPER IS F 64R DISK 00080FWMMAST IC F 470R 6AI 1 DISK 00090FWCMAST UC F 960R 8AI 1 DISK 00100E******************************************************************** 00110E OPERADRTWOOPER 00120E NULL 1 132 1 00130E RCD 1 26 7 0 00140E REL 1 26 7 0A 00150E OPN 1 26 7 0A 00160E NR 1 26 7 0A 00170E SD 104 6 0A 00180E WSH 104 9 3 00190E WMQ 26 7 0A 00200E WMD 26 6 0 00210E WLT 26 3 0 00220I**************************************************************** 00230IWCDATES WD 00240I 1 624 SD 00250I******************************************************************** ÐÐ00260IWOOPER WP 01 64NCD 00270I* WORK ORDER OPER RECORD. 00280I* WORK ORDER # 9A 00290I 1 9 WPORD 00300I* PRIME 6A 00310I 1 6 WPWOP 00320I* DASH 3N 00330I 7 90WPWOD L1 00340I* OPER SEQ # 3N 00350I 10 120WPSEQ 00360I 1 12 WPKEY 00370I* OPER CODE 5A 00380I 13 17 WPOPER 00390I* DEPT # 5P 00400I P 18 200WPDEPT 00410I* WORK CENTER 3P 00420I P 21 220WPWC 00430I* STD HRS - PER UNIT 00440I* SET-UP 9.3P 00450I P 23 273WPSSUH 00460I* RUN 9.3P 00470I P 28 323WPSRUN 00480I* ACTUAL HRS - TOTALS 00490I* SET-UP 9.3P 00500I P 33 373WPASUH ÐÐ00510I* RUN 9.3P 00520I P 38 423WPARUN 00530I* QTY MOVED-IN 7P 00540I P 43 460WPQIN 00550I* QTY MOVED-OUT 7P 00560I P 47 500WPQOUT 00570I* DATE LAST TRAN 6N 00580I 58 630WPDLT 00590I* RECORD STATUS 1A 00600I 64 64 WPSTAT 00610I GG 02 00620I******************************************************************** 00630IWMMAST WM 00640I* WORK ORDER MASTER 00650I* WORK ORDER NO. 6A 00660I* QTY RECVD 7P 00670I P 95 980WMQRCD 00680I* SCHED CMPLTN DATES 6N X 26 00690I 99 2540WMD 00700I* SCHED QTYS 7P X 26 00710I P 255 358 WMQ 00720I* LEAD TIMES 3P X 26 00730I P 359 410 WLT 00740I* QTY RELEASED 7P 00750I P 417 4200WMQREL ÐÐ00760I 470 470 WMSTAT 00770I******************************************************************** 00780IWCMAST WC 00790I* WORK CENTER MASTER 00800I* WORK CENTER NAME 29A 00810I 9 37 WCDESC 00820I* SCHED HRS 104 X 9.3B 00830I B 62 477 WSH 00840I 960 960 WCSTAT 00850C******************************************************************** 00860C* INIT 1-TIME. 00870C N79 Z-ADD0 ZERO7 70 STUPIDITY 00880C N79 EXSR SR101 INIT 00890C N01 GOTO END 00900C L1 SETOF 80 00910C L1 EXSR SR80 GET WMMAST 00920C L1 60 SETON 80 00930C 80 SETOF 01 00940C 80 GOTO END 00950C EXSR SR81 GET WCMAST 00960C 60 SETOF 01 00970C 60 GOTO END 00980C Z-ADD0 X 30 00990C*------------------------------------------------------------------- 01000C TAG10 TAG ÐÐ01010C 1 ADD X X 01020C X COMP 26 54 01030C 54 GOTO TAG30 01040C ZERO7 LOKUPREL,X 54 01050C N54 GOTO TAG30 01060C WPQOUT COMP REL,X 545555 01070C 54 WPQOUT SUB REL,X WPQOUT 01080C 54 Z-ADD0 REL,X 01090C 55 REL,X SUB WPQOUT REL,X 01100C 55 Z-ADD0 WPQOUT 01110C REL,X COMP 0 54 01120C N54 GOTO TAG10 01130C Z-ADD1 S 30 01140C WMD,X LOKUPSD,S 54 54 01150C N54 Z-ADD1 S 01160C REL,X MULT WPSRUN W9D3 93 01170C WPQOUT COMP 0 54 01180C N54 WPSSUH ADD W9D3 W9D3 01190C W9D3 ADD WSH,S WSH,S 01200C 54 WPQOUT MULT WPSRUN W9D3 01210C 54 WSH,S SUB W9D3 WSH,S 01220C GOTO TAG10 01230C*-------------------------------------------------------------------- 01240C TAG30 TAG 01250C EXSR SR82 UPDATE WCMAST ÐÐ01260C*------------------------------------------------------------------- 01270C END TAG 01280C******************************************************************* 01290CSR SR40 BEGSR 01300C* PUT WORK ORDER MASTER DATA 01310CSR SETON 33 01320CSR EXSR SR252 01330CSR SETOF 33 01340CSR SETON 32 01350CSR EXSR SR252 01360CSR SETOF 32 01370CSR ENDSR 01380C***************************************************************** 01390CSR SR80 BEGSR 01400C* GET WORK ORDER MASTER 01410CSR WPWOP CHAINWMMAST 60 01420CSRN60 WMSTAT COMP 'D' 69 01430CSR EXSR SR40 ALLOCATE REL/RCPTS 01440CSR END80 ENDSR 01450C******************************************************************** 01460CSR SR81 BEGSR 01470C* GET WORK CENTER MASTER. 01480CSR MOVELWPDEPT W8A 8 01490CSR MOVE WPWC W8A 01500CSR W8A CHAINWCMAST 60 ÐÐ01510CSRN60 WCSTAT COMP 'D' 60 01520CSR ENDSR 01530C******************************************************************** 01540CSR SR82 BEGSR 01550C* UPDATE WCMAST. 01560CSR SETON 82 01570CSR EXCPT 01580CSR SETOF 82 01590CSR ENDSR 01600C******************************************************************** 01610CSR SR101 BEGSR 01620C* 1-TIME INIT. 01630CSR SETON 79 01640CSR MOVE ' ' BLK35 35 01650CSR MOVE ' ' BLK16 16 01660CSR MOVE ' ' BLK40 40 01670CSR ENDSR 01680C******************************************************************** 01690C*R SR103 BEGSR 01700C* GET SCHED DATES. 01710C*R MOVEL'C' W7A 7 01720C*R MOVE WMD,X W7A 01730C*R * * * W7A CHAINCALENDAR 54 01740C*R 54 Z-ADD0 START 60 01750C*R 54 GOTO END103 ÐÐ01760C*R WLT,X COMP 0 54 01770C*R 54 CAMDAY SUB WLT,X W6N 60 01780C*RN54 CAMDAY SUB TOTLT W6N 01790C*R MOVEL'M' W7A 01800C*R MOVE W6N W7A 01810C*R * * * W7A CHAINCALENDAR 54 01820C*R 54 Z-ADD0 START 01830C*RN54 Z-ADDCACAL START 01840C*R END103 ENDSR 01850C******************************************************************* 01860CSR SR252 BEGSR 01870C* APPLY RCPTS TO SCHEDULE. 01880CSR 32 Z-ADD0 RCD 01890CSR Z-ADD1 A 30 01900CSR 32 Z-ADDWMQRCD SAVQTY 70 01910CSR 33 Z-ADDWMQREL SAVQTY 01920CSR 33 Z-ADD0 REL 01930C*------------------------------------------------------------------- 01940CSR T252A TAG 01950CSR 33 ZERO7 LOKUPWMQ,A 54 01960CSR 32 ZERO7 LOKUPREL,A 54 01970CSRN54 GOTO T252C 01980CSR 33 Z-ADDWMQ,A W7N 70 01990CSR 32 Z-ADDREL,A W7N 02000CSR SETOF 57 ÐÐ02010CSR SAVQTY COMP W7N 545556 02020CSR 54 32 Z-ADDW7N RCD,A 02030CSR 54 33 Z-ADDW7N REL,A 02040CSR 54 SAVQTY SUB W7N SAVQTY 57 02050CSR 54 Z-ADD0 W7N 02060CSR 55 32 Z-ADDSAVQTY RCD,A 02070CSR 55 33 Z-ADDSAVQTY REL,A 02080CSR 55 W7N SUB SAVQTY W7N 02090CSR 55 Z-ADD0 SAVQTY 57 02100CSR 56 32 Z-ADDSAVQTY RCD,A 02110CSR 56 33 Z-ADDSAVQTY REL,A 02120CSR 56 Z-ADD0 SAVQTY 57 02130CSR 56 Z-ADD0 W7N 02140CSR 57 1 ADD A A 02150CSR 57 A COMP 26 54 02160CSR 57 GOTO T252A 02170CSR GOTO END252 02180C*------------------------------------------------------------------ 02190CSR T252C TAG 02200CSR Z-ADD1 A 02210CSR 33 ZERO7 LOKUPWMQ,A 54 02220CSR 32 ZERO7 LOKUPREL,A 54 02230CSR 33 54 Z-ADDSAVQTY REL,A 02240CSR 32 54 Z-ADDSAVQTY RCD,A 02250C*------------------------------------------------------------------- ÐÐ02260CSR END252 TAG 02270CSR 32 WMQ SUB REL NR 02280CSR 32 REL SUB RCD OPN 02290CSR 32 XFOOTWMQ TOTWMQ 70 02300CSR 32 XFOOTREL TOTREL 70 02310CSR 32 XFOOTRCD TOTRCD 70 02320CSR 32 XFOOTNR TOTNR 70 02330CSR 32 XFOOTOPN TOTOPN 70 02340CSR ENDSR 02350O******************************************************************** 02360OWCMAST E 82 02370O WSH 477B 02380O******************************************************************** 02390O* 02400O* 02410O* 02420O* 02430O* 02440O* 02450O* ** NULL ARRAY 02460 02470** RCD ARRAY 02480 02490** REL ARRAY 02500ÐÐ 02510** OPN ARRAY 02520 02530** NR ARRAY 02540 02550/* 002560_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ _‚_‚ ÐÈ(¶R ¶ŒX015WM P999999120282(èÈÐ00010H Q015WM00020F* PLANNED ISSUE UPDATE. (X015WM) 00030F* REVISED 8-02-82 10:15 AM. 00040F* MENU: MQMC01, MQMC03 00050FBITPAR IP F 90 DISK 00060FMGFILE IC F 80R DISK 00070FCRTFILE UC F 256R DISK 00080FSFMAST UD F 128L29AI 1 DISK 00090FWMMAST IC F 470R 6AI 1 DISK 00100FPMMST2 UC F 674R12AI 1 DISK 00110FWMISSUE UC F 60R21AI 1 DISK A 00120FWUKEY UC F 22R21AI 1 DISK A 00130FPJMAST IC F 170R12AI 1 DISK 00140FGLMAST IC F 165R 9AI 1 DISK 00150FSFPNA O F 10 DISK A 00160FTERM132 O F 132 5 00170F**************************************************************** 00180E NUL 1 132 1 NULL CHAR 00190E A16 16 16 1 A INPUT DATA ARRAY 00200E LOC 1 4 3 INPUT COL 00210E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00220E DUN 1 4 1 A EDIT CMPLT FLAG 00230E MES 1 1 30 00240E A9 9 9 1 00250E A29 29 29 1 ÐÐ00260E LNK 1 7 6 A 00270E BIT 33 1 SCREEN CONTR. CHAR 00280E PAR 25 1 00290E TST 25 1 00300E PA$ 7 9 3 ACTG STDS 00310E CALL 7 6 CALL STACK 00320I******************************************************************* 00330IBITPAR BT 00340I 1 33 BIT 00350I 34 58 PAR 00360I 59 83 TST 00370I******************************************************************* 00380IMGFILE MG 00390I* MESSAGE FILE. 00400I 1 35 MGTEXT 00410I****************************************************************** 00420ICRTFILE CR 00430I* EMPLOYEE # 5N 00440I 1 50CREMPL 00450I* USER CODE 8A 00460I 6 13 CRUSER 00470I* DEPT # 5N 00480I 14 180CRDEPT 00490I* JOB NAME 8A (JOB LOADED BY MENU) 00500I 19 26 CRJOB ÐÐ00510I* SHUTDOWN FLAG 1A 00520I* BLANK = NO SHUTDOWN 00530I 27 27 CRSHUT 00540I* TIME STARTED 6N 00550I 28 330CRTIME 00560I* DATE STARTED 4N 00570I 34 370CRDATE 00580I* CALL STACK 7 X 6A 00590I 38 79 CALL 00600I******************************************************************** 00610IWMMAST WM 00620I 422 4310WMPN 00630I 411 4160WMCLOS 00640I 470 470 WMSTAT 00650I******************************************************************** 00660IPMMST2 PM 00670I* PART # 10N 00680I* 1 100PMPN 00690I* DESCRIPTION 29A 00700I 31 59 PMDESC 00710I* INVENTORY ACCOUNT 5P 00720I P 110 1120PMACNT 00730I* ACTG STD COSTS 9.3P X 7 00740I P 185 219 PA$ 00750I* ON HAND STOCK 7P ÐÐ00760I P 311 3140PMOHB 00770I* BAL REL REQMTS 7P 00780I P 323 3260PMRLB 00790I* QTY ON B/O 7P 00800I P 335 3380PMBOB 00810I* PLAN ISSUE QTY 7P 00820I P 363 3660PMPISS 00830I* PLAN ISSUE FREQ 5P 00840I P 398 4000PMFISS 00850I* BACKORDER FREQUENCY 5P 00860I P 422 4240PMFBO 00870I* STD COST 9.3P 00880I P 489 4933PMOSUC 00890I 674 674 PMSTAT 00900I****************************************************************** 00910IWMISSUE WU 00920I* MATERIAL ISSUE RECORD 00930I* KEY AREA 00940I* PART NO. 10N 00950I 1 100WUPN 00960I* WORK ORDER/ACCOUNT 11A 00970I 11 21 WUWO 00980I* PRIME 6A 00990I 11 16 WUWOP 01000I* DASH 3N ÐÐ01010I 17 190WUDASH 01020I* SUB 2N 01030I 20 210WUSUB 01040I* CURRENT MONTH ISSUES. 01050I* PLANNED 7P 01060I P 22 250WUPCM 01070I* UNPLAN 7P 01080I P 26 290WUUCM 01090I* RETURNED 7P 01100I P 30 330WURCM 01110I* SUBSTITUTED 7P 01120I P 34 370WUSCM 01130I* TOTAL ISSUES. 01140I* PLANNED 7P 01150I P 38 410WUPTOT 01160I* UNPLAN 7P 01170I P 42 450WUUTOT 01180I* RETURNED 7P 01190I P 46 490WURTOT 01200I* SUBSTITUTED 7P 01210I P 50 530WUSTOT 01220I* REQD QTY 7P 01230I P 56 590WUREQD 01240I******************************************************************** 01250IWUKEY WK ÐÐ01260I* ALT KEY - WMISSUE 01270I 1 11 WKORD 01280I 12 210WKPN 01290I 22 22 WKSTAT 01300I*********************************************************************** 01310IPJMAST PJ 01320I* PROJECT WORK ORDER. 01330I* WORK ORDER NO. 01340I* 1 9 PJORD 01350I* PRIME 6A 01360I* 1 6 PJPRIM 01370I* DASH 3N 01380I* 7 90PJDASH 01390I* DEPT 3N 01400I* 10 120PJDEPT 01410I* ACCOUNT 5N 01420I* 13 170PJACNT 01430I* MODEL 12A 01440I* 18 29 PJMODL 01450I* DESCRIPTION 40A 01460I* 30 69 PJDESC 01470I* SCHEDULE. 01480I* START DATE 6N 01490I* 70 750PJBSD 01500I* COMPLETION DATE 6N ÐÐ01510I* 76 810PJBCD 01520I* BUDGET - LABOR HRS 7P 01530I* P 82 850PJBLH 01540I* BUDGET - LABOR $ 7P 01550I* P 86 89 PB$,1 01560I* BUDGET - MATERIAL $ 7P 01570I* P 90 93 PB$,2 01580I* ACTUAL. 01590I* START DATE 6N 01600I* 94 990PJASD 01610I* COMPLETION DATE 6N 01620I* 100 1050PJACD 01630I* LABOR HRS 7.1P 01640I* P 106 1091PJALH 01650I* LABOR $ 9.2P 01660I* P 110 114 PA$,1 01670I* MATERIAL $ 9.2P 01680I* P 115 119 PA$,2 01690I* STATUS. 01700I* LABOR - % COMPLETE 3.2P 01710I* P 120 1212PJLPCT 01720I* MATERIAL - % COMPLETE 3.2P 01730I* P 122 1232PJMPCT 01740I* CURRENT MONTH - ACTUAL. 01750I* LABOR HRS 7.1P ÐÐ01760I* P 124 1271PJCLH 01770I* LABOR $ 9.2P 01780I* P 128 132 PC$,1 01790I* MATERIAL $ 9.2P 01800I* P 133 137 PC$,2 01810I* TRANSFER $ 2 X 9.2P 01820I* P 138 147 PT$ 01830I* RECORD STATUS 1A 01840I 170 170 PJSTAT 01850I******************************************************************** 01860IGLMAST GL 01870I* GENERAL LEDGER MASTER. 01880I* ACCOUNT NAME 40A 01890I* 18 57 GLNAME 01900I* RECORD STATUS 1A 01910I 165 165 GLSTAT 01920I****************************************************************** 01930ISFMAST SF 01940I 1 100SFPN 01950I 11 160SFDUE 01960I 17 18 SFREC 01970I 19 29 SFORD 01980I 19 24 SFPRIM 01990I 25 270SFDASH 02000I P 30 330SFQTY ÐÐ02010I P 34 370SFQTYC 02020I 47 560SFNAPN 02030I 106 106 SFBOF 02040I 128 128 SFSTAT 02050C******************************************************************** 02060C* INITIALIZE 02070C EXSR SR101 1-TIME INIT 02080C MOVE ' ' BLK6 6 02090C EXSR SR71 NEW PAGE 02100C*------------------------------------------------------------------ 02110C START TAG 02120C* SET-UP 1ST FIELD NO. 02130C MOVE ' ' DUN INIT EDIT ARRAY 02140C* * * * * * * Z-ADD0 TPN PART # 02150C Z-ADD0 QTYBAL QTY B/O 02160C Z-ADD0 QTYBO 02170C MOVE BLK16 TWO 02180C MOVE BLK16 TWOP 02190C Z-ADD0 TWOD 02200C Z-ADD0 WMPN 02210C Z-ADD0 QTYREQ 02220C Z-ADD0 TQTY 02230C MOVE BLK35 PMDESC 02240C Z-ADD0 PMOHB 02250C Z-ADD0 TBOQ 70 ÐÐ02260C Z-ADD1 F 30 FIELD # 02270C GOTO READ 02280C*------------------------------------------------------------------ 02290C NEXT TAG 02300C* SET-UP NEXT FIELD NO. 02310C 1 ADD F F FIELD # 02320C*----------------------------------------------------------------- 02330C READ TAG 02340C* READ DATA FROM TERMINAL. 02350C SETOF 909677 02360C EXSR SR102 VALIDATE FIELD # 02370C 55 GOTO UPDATE DONE 02380C EXSR SR201 IDENTIFY-F 02390C SETON 69 02400C EXSR SR72 PROMPT 02410C SETOF 69 02420C EXSR SR75 READ TERMINAL 02430C 98 GOTO GOODBY GOODBY 02440C 94 GOTO MENU MENU REQUEST 02450C 90 EXSR SR72 REWRITE INPUT DATA 02460C 93 GOTO NEWITM NEW ITEM 02470C 92 GOTO JUMP FIELD JUMP REQST 02480C 91 GOTO NEXT SKIP FORWARD 02490C 89 F SUB 1 F SKIP BACKWARD 02500C 89 GOTO READ " " ÐÐ02510C 88 SETOF 90 SPACE FILL 02520C 88 SETON 77 " " 02530C 87 GOTO START 02540C 86 GOTO UPDATE UPDATE 02550C 96 GOTO ERROR ERROR 02560C N77 GOTO EDIT NO DATA INPUT 02570C*------------------------------------------------------------------ 02580C PROCES TAG 02590C* PROCESS INPUT DATA 02600C EXSR SR103 MOVE DATA 02610C*------------------------------------------------------------------- 02620C EDIT TAG 02630C EXSR SR104 EDIT DATA 02640C EXSR SR72 REWRITE DATA 02650C 96 GOTO ERROR ERROR 02660C GOTO NEXT 02670C*------------------------------------------------------------------ 02680C UPDATE TAG 02690C* UPDATE DATA BASE. 02700C EXSR SR105 FINAL EDIT 02710C 96 GOTO ERROR ERROR 02720C EXSR SR106 UPDATE 02730C SETON 59 02740C EXSR SR72 REWRITE DATA 02750C SETOF 59 ÐÐ02760C 96 GOTO ERROR 02770C ERRCNT ADD COUNT COUNT 02780C 1 ADD COUNT COUNT 02790C ERRCNT COMP 0 54 02800C 54 1 ADD COUNT COUNT 02810C Z-ADD0 ERRCNT 02820C COUNT COMP 119 54 54 02830C 54 EXSR SR71 02840C GOTO START 02850C*------------------------------------------------------------------- 02860C JUMP TAG 02870C* SET-UP JUMP TO REQUESTED FIELD 02880C 1 ADD W W 30 02890C W COMP 16 54 02900C 54 Z-ADD318 M 50 96 FLAG ERROR 02910C 54 GOTO ERROR BAD ESC 02920C MOVE ' ' W3A 3 02930C MOVEAA16,W W3A 02940C Z-ADD3 W2N 20 02950C EXIT SUBRAJ R. JUSTIFY 02960C RLABL W2N 02970C RLABL W3A 02980C MOVE W3A F NEW FIELD # 02990C GOTO READ 03000C*-------------------------------------------------------------------- ÐÐ03010C ERROR TAG 03020C EXSR SR102 VALIDATE FIELD # 03030C EXSR SR89 GET MSG 03040C EXSR SR73 PUT MSG 03050C GOTO READ 03060C*------------------------------------------------------------------ 03070C NEWITM TAG 03080C* SET-UP LINK FOR NEW ITEM 03090C MOVEL'Q015WM' PROG 8 03100C GOTO END 03110C*------------------------------------------------------------------- 03120C MENU TAG 03130C* SET-UP LINK TO MENU 03140C EXSR SR96 03150C Z-ADD1 W 03160C BLK6 LOKUPLNK,W 54 03170C 54 MOVELLNK,W PROG 03180C 54 MOVE BLK6 LNK,W 03190C N54 MOVEL'CONTU 'PROG 8 03200C EXSR SR97 03210C EXSR SR98 >>>>>>>>>>>>>>>>> 03220C*-------------------------------------------------------------------- 03230C GOODBY TAG 03240C* LINK TO SIGN-OFF 03250C MOVEL'GOODBY' PROG ÐÐ03260C GOTO END 03270C*------------------------------------------------------------------- 03280C END TAG 03290C EXSR SR96 03300C EXSR SR97 03310C EXSR SR98 03320C*----------------------------------------------------------------- 03330C ENDJOB TAG 03340C MOVEL'ENDJOB' PROG 03350C EXSR SR98 >>>>>>>>>>>>>>>> 03360C********************************************************************* 03370CSR SR1 BEGSR 03380C* EDIT ORDER #. 03390C* GET WORK ORDER. 03400CSR MOVE TWOP W5N 50 03410CSR W5N COMP 0 54 03420CSRN54 Z-ADD341 M 96 03430CSRN54 GOTO END1 ERROR 03440CSR TWOP CHAINWMMAST 54 03450CSRN54 WMSTAT COMP 'D' 54 03460CSRN54 WMCLOS COMP 0 54 03470CSRN54 GOTO END1 03480C* GET ACCOUNT #. 03490CSR TWO CHAINGLMAST 54 03500CSRN54 GLSTAT COMP 'D' 54 ÐÐ03510CSRN54 GOTO END1 03520C*------------------------------------------------------------------- 03530CSR T1C TAG 03540CSR MOVELTWO W12A 12 03550CSR MOVE '620' W12A 03560CSR W12A CHAINPJMAST 54 03570CSRN54 PJSTAT COMP 'D' 54 03580CSRN54 GOTO END1 03590C*R * * * * * * * * Z-ADD341 M 96 FLAG ERROR 03600CSR END1 ENDSR 03610C******************************************************************* 03620CSR SR2 BEGSR 03630C* EDIT PART #. 03640CSR TPN COMP 0 54 03650CSRN54 Z-ADD299 M 96 FLAG ERROR 03660CSRN54 GOTO END2 03670CSR MOVELTPN W12A 12 03680CSR EXSR SR80 GET PART MAST 03690CSR 60 Z-ADD291 M 96 FLAG ERROR 03700CSR 60 GOTO END2 03710CSR END2 ENDSR 03720C******************************************************************* 03730CSR SR3 BEGSR 03740C* EDIT QTY. 03750CSR TQTY COMP PMOHB 55 ÐÐ03760CSR 55 Z-ADD563 M 03770CSR 55 EXSR SR74 FLAG WARNING 03780CSR TQTY COMP 0 54 03790CSRN54 Z-ADD609 M 03800CSRN54 EXSR SR74 03810CSR END3 ENDSR 03820C* 03830C******************************************************************** 03840CSR SR66 BEGSR 03850C* MOVE CURSOR UP. 03860CSR EXITFQMOVUP BUMP UP 03870CSR ENDSR 03880C******************************************************************** 03890CSR SR68 BEGSR 03900CSR EXITFQCLF LINE FEED 03910CSR ENDSR 03920C******************************************************************** 03930CSR SR69 BEGSR 03940C* POSITION CURSOR. 03950CSR EXITFQXYPOS POSITION CURSOR 03960CSR RLABL W6A 03970CSR ENDSR 03980C******************************************************************* 03990CSR SR70 BEGSR 04000C* CLEAR PAGE ÐÐ04010CSRN50 EXITFZCPAGE CLEAR PAGE-4 04020CSR 50 EXITFZISTAT 04030CSR 50 EXITFZESCH 04040CSR ENDSR 04050C****************************************************************** 04060CSR SR71 BEGSR 04070C* PUT HEADINGS TO TERMINAL 04080CSR EXSR SR70 CLEAR PAGE 04090CSR SETON 71 04100CSR EXCPT PUT HEADINGS 04110CSR SETOF 71 04120CSR Z-ADD96 COUNT 30 04130CSR ENDSR 04140C********************************************************************* 04150CSR SR72 BEGSR 04160C* PUT DATA TO TERMINAL 04170CSR TWOP COMP ' ' 55 04180CSR COUNT SUB 1 W3N 30 04190CSR MOVELW3N W6A 04200CSR MOVE '001' W6A 04210CSR EXSR SR69 MOVE CURSOR 04220CSR SETON 72 04230CSR EXCPT PUT DATA 04240CSR SETOF 72 04250CSR SETOF 59 ÐÐ04260CSR ENDSR 04270C*********************************************************************** 04280CSR SR73 BEGSR 04290C* PUT ERROR MESSAGE TO TERMINAL 04300CSR COUNT ADD ERRCNT W3N 30 04310CSR W3N COMP 119 54 54 04320CSRN54 GOTO T73A 04330CSR EXSR SR71 PUT HEADING 04340CSR EXSR SR72 PUT DATA 04350CSR Z-ADD0 ERRCNT 04360C*-------------------------------------------------------------------- 04370CSR T73A TAG 04380CSR MOVELW3N W6A 6 04390CSR MOVE '001' W6A 04400CSR EXSR SR69 POSITION CURSOR 04410CSR SETON 73 04420CSR EXCPT PUT MSG 04430CSR SETOF 73 04440CSRN50 1 ADD ERRCNT ERRCNT 30 04450CSR ENDSR 04460C******************************************************************** 04470CSR SR74 BEGSR 04480C* PUT WARNING. 04490CSR EXSR SR89 GET MSG 04500CSR EXSR SR73 PUT MSG ÐÐ04510CSR ENDSR 04520C******************************************************************* 04530CSR SR75 BEGSR 04540C* READ FROM TERMINAL 04550CSR SETOF 779096 04560CSR SETOF 939291 04570CSR SETOF 898887 04580CSR SETOF 86 04590CSR MOVE BIT,28 A9,1 04600CSR MOVE '8' A9,2 04610CSR MOVE COUNT W3A 3 04620CSR MOVEAW3A A9,3 04630CSR MOVEALOC,F A9,6 04640CSR MOVE BIT,8 A9,9 04650CSR MOVEAA9 W9A 9 04660CSR MOVE BIT,9 BUFLGT 2 READ BUFFER LGTH 04670CSR MOVE BLK16 W16A 16 BUFFER 04680CSR EXITFQPREED READ FROM TERMINAL 04690CSR RLABL W9A 04700CSR RLABL W16A READ BUFFER 04710CSR RLABL BUFLGT READ BUFFER LGTH 04720CSR MOVEAW16A A16 INPUT DATA ARRAY 04730CSR MOVE BLK16 W16A INIT INPUT ARRAY 04740CSR Z-ADD1 W 30 04750CSR '\' LOKUPA16,W 90 FLAG ESC ÐÐ04760CSRN90 GOTO T75B NOT ESC 04770CSR 1 ADD W W 04780CSR W COMP 16 54 04790CSR 54 GOTO T75A BAD ESC 04800CSR A16,W COMP 'G' 98 GOODBY 04810CSR A16,W COMP 'E' 94 MENU 04820CSR A16,W COMP 'N' 93 NEW ITEM 04830CSR A16,W COMP 'J' 92 JUMP 04840CSR A16,W COMP 'F' 91 SKIP FRWRD 04850CSR A16,W COMP 'B' 89 SKIP BKWRD 04860CSR A16,W COMP 'S' 88 SPACE FILL 04870CSR A16,W COMP 'H' 87 HOME 04880CSR A16,W COMP 'U' 86 UPDATE 04890CSR 98 04900COR 94 04910COR 93 04920COR 92 04930COR 91 04940COR 89 04950COR 88 04960COR 87 04970COR 86 GOTO END75 GOOD ESC 04980C*------------------------------------------------------------------ 04990CSR T75A TAG 05000C* FLAG BAD ESC INPUT ÐÐ05010CSR Z-ADD318 M 96 FLAG ERROR 05020CSR GOTO END75 05030C*-------------------------------------------------------------------- 05040CSR T75B TAG 05050C* MOVE DATA 05060CSR Z-ADD1 W 05070CSR ' ' LOKUPA16,W 77 05080CSR 77 MOVEAA16,W W16A INPUT DATA 05090C*-------------------------------------------------------------------- 05100CSR END75 TAG 05110CSR EXSR SR76 INIT ERR MSG 05120CSR ENDSR 05130C******************************************************************** 05140CSR SR76 BEGSR 05150C* INIT PREV ERROR MSG. 05160CSR ERRCNT COMP 0 54 54 05170CSRN54 GOTO END76 05180CSR MOVE BLK35 MGTEXT 05190CSR SETON 50 05200CSR EXSR SR73 BLANK MESSAGE 05210CSR SETOF 50 05220CSR ERRCNT SUB 1 ERRCNT 54 54 05230CSR 54 GOTO SR76 05240CSR Z-ADD0 ERRCNT 05250CSR END76 ENDSR ÐÐ05260C********************************************************************** 05270CSR SR80 BEGSR 05280C* GET PART MAST. 05290CSR MOVE ' ' W12A 12 05300CSR W12A CHAINPMMST2 60 GET MASTER 05310CSRN60 PMSTAT COMP 'D' 60 FLAG DELETE 05320CSR ENDSR 05330C********************************************************************** 05340CSR SR81 BEGSR 05350C* GET SFMAST. 05360CSR MOVE BLK35 W29A 29 05370CSR MOVELTPN W29A 05380CSR W29A SETLLSFMAST 05390CSR SETOF 68 05400CSR Z-ADDTQTY TQTY2 70 QTY ISSUED 05410CSR Z-ADDTBOQ TBOQ2 70 QTY BACKORDERED 05420CSR Z-ADD0 QTYBO 70 05430CSR Z-ADD0 QTYREQ 70 05440C*------------------------------------------------------------------- 05450CSR T81A TAG 05460CSR SETOF 54 05470CSR READ SFMAST 54 05480CSR 54 GOTO END81 05490CSR SFPN COMP TPN 54 05500CSRN54 GOTO END81 ÐÐ05510CSR SFPRIM COMP TWOP 54 05520CSR 54 SFDASH COMP TWOD 54 05530CSR 54 SFREC COMP '70' 54 05540CSRN54 GOTO T81A 05550CSR SFSTAT COMP 'D' 54 05560CSR 54 GOTO T81A 05570CSR SFQTY COMP SFQTYC 54 05580CSRN54 GOTO T81A 05590CSR SFQTY SUB SFQTYC QTYBAL 70 54 05600CSRN54 GOTO T81A NO QTY OPEN 05610CSR SFQTYC COMP 0 54 05620CSR 54 PMBOB SUB QTYBAL PMBOB BO BALANCE 05630CSR QTYBAL ADD QTYREQ QTYREQ 05640CSR QTYBAL COMP TQTY2 545556 05650CSR TQTY2 ADD PMPISS PMPISS PLAN ISSUE QTY 05660CSRN54 PMRLB SUB QTYBAL PMRLB REL REQ BAL 05670CSR 54 PMRLB SUB TQTY2 PMRLB 05680CSR 54 TQTY2 ADD SFQTYC SFQTYC 05690CSR 54 Z-ADD0 TQTY2 05700CSR 55 QTYBAL ADD SFQTYC SFQTYC 05710CSR 55 TQTY2 SUB QTYBAL TQTY2 05720CSR 56 TQTY2 ADD SFQTYC SFQTYC 05730CSR 56 Z-ADD0 TQTY2 05740CSR SFQTY SUB SFQTYC W7N 70 54 05750CSRN54 Z-ADD0 W7N ÐÐ05760CSR W7N ADD QTYBO QTYBO 70 QTY BO THIS PART 05770CSR 54 MOVE 'B' SFBOF BACKORDER FLAG 05780CSR EXSR SR83 UPDATE SFMAST 05790CSR SETON 68 UPDATE FLAG 05800CSR SETON 59 05810CSR EXSR SR72 RE-PUT DATA 05820CSR QTYBO ADD PMBOB PMBOB NEW BO BAL 05830CSR TQTY2 COMP 0 54 05840CSRN54 TBOQ2 COMP 0 54 05850CSR 54 GOTO T81A 05860C*------------------------------------------------------------------ 05870CSR END81 TAG 05880CSR QTYBO COMP 0 54 05890CSR 54 1 ADD PMFBO PMFBO BACKORDER FREQ 05900CSR 1 ADD PMFISS PMFISS PLAN ISSUE FREQ 05910CSR TBOQ COMP QTYBO 54 05920CSRN54 Z-ADD629 M FLAG STUPID B/O 05930CSRN54 EXSR SR74 FLAG WARNING 05940CSR TQTY2 COMP 0 54 05950CSR 54 Z-ADD606 M FLAG OVERISSUE 05960CSR 54 EXSR SR74 PUT WARNING 05970CSR ENDSR 05980C*********************************************************************** 05990CSR SR82 BEGSR 06000C* UPDATE PART MAST. ÐÐ06010CSR PMOHB SUB TQTY PMOHB 54 LT 06020CSR 54 Z-ADD563 M 06030CSR 54 EXSR SR74 NEG OH WARNING 06040CSR SETON 82 06050CSR EXCPT UPDATE PMMST2 06060CSR SETOF 82 06070CSR ENDSR 06080C******************************************************************** 06090CSR SR83 BEGSR 06100C* UPDATE SCHED MAST. 06110CSR SETON 83 06120CSR EXCPT UPDATE SFMAST 06130CSR SETOF 83 06140CSR ENDSR 06150C******************************************************************** 06160CSR SR84 BEGSR 06170C* UPDATE MATERIAL DISTR. 06180CSR MOVE SFORD W21A 21 06190CSR MOVELSFPN W21A 06200CSR W21A CHAINWMISSUE 60 GET WMISSUE 06210CSR 60 EXSR SR204 INIT WMISSUE 06220CSR TQTY ADD WUPTOT WUPTOT 06230CSR TQTY ADD WUPCM WUPCM 06240CSR SETON 81 06250CSR EXCPT UPDATE WMISSUE ÐÐ06260CSR SETOF 81 06270CSR MOVELSFORD W21AA 21 06280CSR MOVE SFPN W21AA 06290CSR W21AA CHAINWUKEY 60 06300CSR SETON 84 06310CSR EXCPT UPDATE ALT KEY 06320CSR SETOF 84 06330CSR ENDSR 06340C********************************************************************** 06350CSR SR89 BEGSR 06360C* GET MESSAGE MASTER 06370CSR M CHAINMGFILE 54 06380CSR 54 MOVE BLK35 MGTEXT 06390CSR 54 MOVELM MGTEXT 06400CSR 54 MOVE MES,1 MGTEXT 06410CSR ENDSR 06420C**************************************************************** 06430CSR SR96 BEGSR 06440CSR # CHAINCRTFILE H9 06450CSR H9 GOTO ENDJOB 06460CSR ENDSR 06470C***************************************************************** 06480CSR SR97 BEGSR 06490CSR TIME CRTIME 06500CSR MOVELUDATE CRDATE ÐÐ06510CSR SETON 97 06520CSR EXCPT UPDATE CRTFILE 06530CSR SETOF 97 06540CSR ENDSR 06550C***************************************************************** 06560CSR SR98 BEGSR 06570CSR EXSR SR70 CLEAR CRT 06580CSR EXITFCHAIN >>>>>>>>>>>>>>> 06590CSR RLABL PROG 06600CSR ENDSR 06610CSR SR101 BEGSR 06620C* 1-TIME INITIALIZE 06630CSR MOVE BIT,1 NUL 06640CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 06650CSR Z-ADD4 FLIMIT 30 TOTAL NUMB FIELDS 06660CSR MOVE ' ' BLK16 16 06670C* GET PORT # AND CRTFILE 06680CSR MOVE ' ' W2A 2 06690CSR EXITFZGMINX GET PORT # 06700CSR RLABL W2A 06710CSR MOVE W2A # 20 PORT NO. 06720CSR # COMP 0 54 06730CSRN54 Z-ADD25 # DEFAULT 06740CSR EXSR SR96 06750CSR MOVE CALL LNK ÐÐ06760CSR PAR,# COMP '1' 50 06770CSR TST,# COMP 'S' 54 06780CSR 54 MOVE 'SHUTDOWN'PROG 8 06790CSR EXSR SR97 06800CSR 54 EXSR SR98 >>>>>>>>>>>>>>>> 06801CSR MOVE ' 'PROG 06810CSR MOVE ' ' BLK35 35 06820CSR MOVELUDATE W4N 40 06830CSR MOVE UDATE W2N 20 06840CSR MOVELW2N TODAY 60 06850CSR MOVE W4N TODAY 06860CSR Z-ADD0 ZERO7 70 06870CSR Z-ADD0 ZERO9 90 06880CSR ENDSR 06890C********************************************************************** 06900CSR SR102 BEGSR 06910C* VALIDATE FIELD NO. 06920CSR F COMP 0 54 06930CSRN54 Z-ADD1 F 06940CSR F COMP FLIMIT 55 06950CSR 55 Z-ADD1 F 06960CSR ENDSR 06970C******************************************************************** 06980CSR SR103 BEGSR 06990C* MOVE INPUT DATA ÐÐ07000CSR EXSR SR201 IDENTIFY-F 07010CSR EXSR SR202 R. JUSTIFY 07020CSR 01 EXSR SR205 WORK ORDER # 07030CSR 02 MOVE W10A TPN 100 PART NO. 07040CSR 03 MOVE W10A TQTY 70 QTY ISSUED 07050CSR 04 MOVE W10A TBOQ 70 QTY BACKORDERED 07060CSR MOVE ' ' DUN,F EDIT FLAG 07070CSR ENDSR 07080C******************************************************************** 07090CSR SR104 BEGSR 07100C* EDIT INPUT DATA 07110CSR 01 EXSR SR1 07120CSR 02 EXSR SR2 07130CSR 03 EXSR SR3 07140CSR 96 MOVE ' ' DUN,F EDIT FLAG 07150CSRN96 MOVE 'X' DUN,F 07160CSR ENDSR 07170C*********************************************************************** 07180CSR SR105 BEGSR 07190C* FINAL EDIT 07200CSR SETOF 77 07210CSR SETON 79 FINAL EDIT FLAG 07220CSR Z-ADD1 F 96 07230C*-------------------------------------------------------------------- 07240CSR T105A TAG ÐÐ07250CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 07260CSRN54 GOTO END105 07270CSR EXSR SR201 IDENTIFY-F 07280CSR EXSR SR104 EDIT 07290CSRN96 GOTO T105A 07300C*-------------------------------------------------------------------- 07310CSR END105 TAG 07320CSR TQTY COMP 0 54 07330CSRN54 TBOQ COMP 0 54 07340CSRN54 Z-ADD292 M 96 FLAG ERROR 07350CSRN54 Z-ADD3 F 07360CSR SETOF 79 07370CSR ENDSR 07380C******************************************************************** 07390CSR SR106 BEGSR 07400C* UPDATE. 07410CSR EXSR SR81 UPDATE SFMAST 07420CSRN68 Z-ADD604 M 96 FLAG ERROR 07430CSR 96 GOTO END106 07440CSR TQTY2 COMP 0 54 07450CSR 54 Z-ADD606 M 07460CSR 54 EXSR SR74 OVERISSUE WARNING 07470CSR EXSR SR82 UPDATE PMMST2 07480CSR EXSR SR84 UPDATE MATL DIST 07490CSR END106 ENDSR ÐÐ07500C************************************************************************ 07510CSR SR201 BEGSR 07520C* IDENTIFY FIELD NO. 07530CSR F COMP 1 01 07540CSR F COMP 2 02 07550CSR F COMP 3 03 07560CSR F COMP 4 04 07570CSR ENDSR 07580C********************************************************************** 07590CSR SR202 BEGSR 07600C* RIGHT JUSTIFY 07610CSR F LOKUPNUM 54 07620CSRN54 GOTO END202 NOT NUMERIC FIELD 07630CSR Z-ADD10 W2N 20 07640CSR MOVELW16A W10A 10 07650CSR EXIT SUBRAJ R. JUSTIFY 07660CSR RLABL W2N 07670CSR RLABL W10A 07680CSR END202 ENDSR 07690C******************************************************************** 07700CSR SR204 BEGSR 07710C* INIT ISSUE FIELDS. 07720CSR Z-ADD0 WUPCM 07730CSR Z-ADD0 WUUCM 07740CSR Z-ADD0 WURCM ÐÐ07750CSR Z-ADD0 WUSCM 07760CSR Z-ADD0 WUPTOT 07770CSR Z-ADD0 WUUTOT 07780CSR Z-ADD0 WURTOT 07790CSR Z-ADD0 WUSTOT 07800CSR Z-ADD0 WUREQD 07810CSR ENDSR 07820C******************************************************************** 07830CSR SR205 BEGSR 07840C* BUILD WORK ORDER #. 07850CSR MOVEAW16A A16 07860CSR Z-ADD1 W 07870CSR '-' LOKUPA16,W 54 07880CSRN54 Z-ADD7 W 07890CSR MOVE ' ' W4A 4 07900CSR MOVEAA16,W W4A 07910CSR MOVEL' ' W4A 07920CSR Z-ADD4 W2N 20 07930CSR EXIT SUBRAJ RJ 07940CSR RLABL W2N 07950CSR RLABL W4A 07960CSR MOVE W4A TWOD 30 WORK ORDER DASH 07970CSR MOVEABLK16 A16,W 07980CSR Z-ADD1 W 07990CSR ' ' LOKUPA16,W 54 ÐÐ08000CSRN54 Z-ADD1 W 08010CSR A16,W COMP '0' 54 54 08020CSR 54 MOVEAA16,W W5A 5 08030CSR 54 MOVEL' ' TWOP 6 WORK ORDER PRIME 08040CSRN54 MOVEAA16,W TWOP 08050CSRN54 MOVE TWOP W5A 08060CSR Z-ADD5 W2N 20 08070CSR EXIT SUBRAJ RJ 08080CSR RLABL W2N 08090CSR RLABL W5A 08100CSR MOVE W5A TWOP 08110CSR MOVELTWOP TWO 9 08120CSR MOVE TWOD TWO 9-CHAR WO # 08130CSR END205 ENDSR 08140O******************************************************************* 08150OCRTFILE E 97 08160O PROG 26 08170O CRTIME 33 08180O CRDATE 37 08190O LNK 79 08200O******************************************************************** 08210OTERM132 E 71 08220O BIT,28 1 08230O 8 '8091001' 08240O 78 'PLANNED ISSUE' ÐÐ08250O 85 'INPUT ' 08260O UDATE Y 16 08270O*------------------------------------------------------------------- 08280O E 71 08290O 20 'ASSEMBLY' 08300O 35 'COMPONENT' 08310O 119 'STOCK' 08320O*------------------------------------------------------------------- 08330O E 71 08340O 10 'WORK-ORDER' 08350O 20 'PART-NO.' 08360O 34 'PART-NO.' 08370O 51 'DESCRIPTION' 08380O 82 'QTY-REQ''D' 08390O 109 'QTY-BACKORDER' 08400O 94 'QTY-ISSUED' 08410O 120 'BALANCE' 08420O*------------------------------------------------------------------- 08430O E 71 08440O 5 '(1)' 08450O 30 '(2)' 08460O 91 '(3)' 08470O 105 '(4)' 08480O*------------------------------------------------------------------- 08490O E 71 ÐÐ08500O 1 ' ' 08510O E 72 08520O TWOP 6 08530O 55 7 '-' 08540O 55 TWOD 10 08550O WMPN 24 ' - - ' 08560O TPN 38 ' - - ' 08570O PMDESC 69 08580O QTYREQ2 82 08590O TQTY 2 94 08600O TBOQ 2 109 08610O 59 QTYBO K 110 08620O PMOHB K 120 08630O*------------------------------------------------------------------- 08640O E 73 08650O MGTEXT 35 08660O BIT,28 131 08670O 132 'K' 08680O******************************************************************** 08690OPMMST2 E 82 08700O PMACNT 112P 08710O PA$ 219P 08720O PMOHB 314P 08730O PMRLB 326P 08740O PMBOB 338P ÐÐ08750O PMPISS 366P 08760O PMFISS 400P 08770O PMFBO 424P 08780O PMOSUC 493P 08790O******************************************************************** 08800OSFPNA EADD 82 08810O TPN 10 08820O******************************************************************** 08830OSFMAST E 83 08840O SFQTY 33P 08850O SFQTYC 37P 08860O 106 'B' 08870O******************************************************************** 08880OWMISSUE EADD 81 60 08890O W21A 21 08900O WUPCM 25P 08910O WUUCM 29P 08920O WURCM 33P 08930O WUSCM 37P 08940O WUPTOT 41P 08950O WUUTOT 45P 08960O WURTOT 49P 08970O WUSTOT 53P 08980O WUREQD 59P 08990O*------------------------------------------------------------------- ÐÐ09000O E 81N60 09010O WUPCM 25P 09020O WUUCM 29P 09030O WURCM 33P 09040O WUSCM 37P 09050O WUPTOT 41P 09060O WUUTOT 45P 09070O WURTOT 49P 09080O WUSTOT 53P 09090O WUREQD 59P 09100O********************************************************************** 09110OWUKEY EADD 84 60 09120O W21AA 21 09130O 22 'A' 09140O*------------------------------------------------------------------- 09150O E 84N60 09160O 22 'A' 09170O********************************************************************* ** NUL ARRAY 009180 009190** A16 ARRAY 009200 009210** LOC ARRAY 09220001 ORDER # 09230027 PART # 09240ÐÐ090 QTY ISSUED 09250103 QTY BACKORDERED 09260** NUM ARRAY 009270002 PART # 09280003 QTY 09290004 BO QTY 09300** DUN ARRAY 009310 009320** A9 ARRAY 09330 09340** A29 ARRAY 09350 09360** MES ARRAY 009370---MESSAGE NOT ON FILE--- 009380** LNK ARRAY 009390 09400/* 09410_‚ ÐÐ_‚_‚ QTY ISSUED 09250103 QTY BACKORDERED 09260** NUM ARRAY 009270002 PART # 09280003 QTY 09290004 BO QTY 09300** DUN ARRAY 009310 009320** A9 ARRAY 09330 09340** A29 ARRAY 09350 09360** MES ARRAY 009370---MESSAGE NOT ON FILE--- 009380** LNK ARRAY 009390 09400/* 09410_‚ ÐÈ(¼S¤ ¼$X210SF P120282120282(èÈÐ00010H Q210SF00020F* LIST PART NOS. TO BE ORDERED - PURCH. (X210SF) *** D I A B L O *** 00030F* REVISED 4/01/81 4:40 PM. 00040FBITTAB IP F 33 DISK 00050FSFEMAST IS F 128R I DISK 00060FSEADRT IR F 300 3 3IT EDISK 00070FMGFILE IC F 80R DISK 00080FCRTFILE UC F 256R DISK 00090FPMMST2 IC F 674R12AI 1 DISK 00100FCALENDARIC F 22R 7AI 1 DISK 00110E******************************************************************** 00120E SEADRT SFEMAST 00130E LEV 1 160 2 0 00140E DAT 1 160 6 0 00150E PN 1 160 10 0A 00160E NUL 1 148 1 00170E PRT 1 148 1 00180E BIT 33 1 00190E REC 148 1 00200E EXC 50 4 0 00210I******************************************************************** 00220IBITTAB BT 00230I 1 33 BIT 00240I******************************************************************** 00250IMGFILE MG ÐÐ00260I 1 35 MGTEXT 00270I******************************************************************** 00280ICRTFILE CR 00290I 1 50CREMPL 00300I 6 13 CRUSER 00310I 14 180CRDEPT 00320I 19 26 CRJOB 00330I 27 27 CRSHUT 00340I 28 330CRTIME 00350I 34 370CRDATE 00360I 38 67 CALL 00370I 68 73 CRRET 00380I 74 79 CRMENU 00390I 81 228 REC 00400I******************************************************************** 00410IPMMST2 PM 00420I* 1 100PMPN 00430I* DESCRIPTION 29A 00440I 31 59 PMDESC 00450I 94 95 PMSC 00460I* LEAD TIMES 3P X 8 00470I* 1 = PRODUCTION CONTROL,SCHEDULE 00480I* 2 = PURCHASING,PLACE P.O. 00490I* 3 = VENDOR,SUPPLY PART OR SERVICE 00500I* 4 = STOCK,PULL PARTS ÐÐ00510I* 5 = SHOP,FAB & ASSEMBLE 00520I* 6 = INSPECTION & TEST 00530I* 7 = STOCK,RECEIVE PARTS 00540I* 8 = SAFETY LEAD TIME 00550I* P 113 128 PLT 00560I* ORDER POLICY CODES. 00570I* HORIZON M-DAYS 3P X 5 00580I* 1 = SALES ORDERS 00590I* 2 = PROD REQMTS-REL 00600I* 3 = PROD REQMTS-PLAN 00610I* 4 = FORECAST 00620I* 5 = SAFETY STOCK 00630I* P 129 138 PHZ 00640I* MIN/MAX CODES. 00650I* ARRAY 7P X 6 00660I* 1 = MIN ORDER QTY 00670I* 2 = MIN ORDER $ 00680I* 3 = MIN STOCK QTY 00690I* 4 = MAX ORDER QTY 00700I* 5 = MAX ORDER $ 00710I* 6 = MAX STOCK QTY 00720I* P 139 162 PMM 00730I* MINIMUM REQMT SPAN 3P 00740I* P 163 1640PMMRQS 00750I* MAXIMUM REQMT SPAN 3P ÐÐ00760I* P 165 1660PMXRQS 00770I* ROUNDING FACTOR 5P 00780I* P 167 1690PMRNDF 00790I* EOQ CODE 2A 00800I* 170 171 PMEOQ 00810I* EOQ PARAMETER 2A 00820I* 172 173 PMEOQP 00830I* EXCEPTION REPORT CRITERIA. 00840I* ALLOWABLE SURPLUS QTY 7P 00850I* P 174 1770PMSQTY 00860I* ALLOWABLE SURPLUS % 5.2P 00870I* P 178 1802PMSPCT 00880I* ALLOWABLE SURPLUS SPAN 3P 00890I* P 181 1820PMSSP 00900I* ALLOWABLE SHORTAGE SPAN 3P 00910I* P 183 1840PMSHSP 00920I* ON HAND BAL 7P 00930I* P 311 3140PMOHB 00940I* LOW LEVEL CODE 2N 00950I* 430 4310PMLL 00960I* RECORD STATUS 1A 00970I 674 674 PMSTAT 00980I******************************************************************** 00990ISFEMAST SE 01000I* EXCEPTION MASTER. ÐÐ01010I* PART NO. 10N 01020I 1 100SEPN 01030I* EXCEPTIONS 4B X 50 01040I B 11 110 EXC 01050I* BUCKET * EXCEPTION * CODE 01060I* 1 TO BE ORDERED - PURCH LOW LEVEL CODE 01070I* 2 TO BE ORDERED - MFG LOW LEVEL CODE 01080I* 3 PAST DUE-PURCH- ON ORDER DUE DATE 01090I* 4 PAST DUE-MFG - ON ORDER DUE DATE 01100I* 5 PAST DUE - PLAN REQMTS DUE DATE 01110I* 6 PAST DUE - REL REQMTS DUE DATE 01120I* 7 PAST DUE - SALES ORDER DUE DATE 01130I* 8 PAST DUE - RUN RELEASE DUE DATE 01140I* 9 NOT RELEASED - PLAN WO START DATE 01150I* 10 NOT PLACED - PURCH REQ DUE DATE 01160I* 11 NOT INSPECTED - RPO DLT 01170I* 12 BACKORDER - PURCH DUE DATE 01180I* 13 BACKORDER - MFG DUE DATE 01190I* 14 BACKORDER IN RECVG INSP DUE DATE 01200I* 15 BACKORDER IN STOCK DUE DATE 01210I* 16 NEGATIVE ON HAND VALUE OF 1 01220I* 17 SURPLUS DUE DATE 01230I* 18 SHORTAGE DUE DATE 01240I* LOW LEVEL CODE 2N 01250I 126 1270SELL ÐÐ01260I******************************************************************** 01270ICALENDARCA 20 1 CC 01280I* CALENDAR DATE RECORD. 01290I 2 30CAYR 01300I 4 50CAMO 01310I 6 70CADAY 01320I 2 70CACAL 01330I 14 170CAMDAY 01340I 18 200CAWK 01350I 21 220CADOW 01360I*------------------------------------------------------------------- 01370I CB 20 1 CM 01380I* MFG DATE RECORD. 01390I 4 70CAMDAY 01400I 8 90CAYR 01410I 10 110CAMO 01420I 12 130CADAY 01430I 8 130CACAL 01440I 18 200CAWK 01450I 21 220CADOW 01460I*------------------------------------------------------------------- 01470I GG 03 01480C******************************************************************** 01490C* INITIALIZE 1-TIME. GET INDENT-LEVEL. 01500C N79 EXSR SR101 INIT ÐÐ01510C SELL COMP BEGLEV 55 54 01520C N54 SETOF 01 01530C 55 SETON LR 01540C N54 GOTO END BYPASS 01550C* LOAD SAVE ARRAYS. 01560C EXSR SR102 LOAD ARRAYS 01570C* PRINT (ARRAY FULL). 01580C P COMP 159 54 01590C 54 EXSR SR103 PRINT 01600C*------------------------------------------------------------------- 01610C END TAG 01620C* END OF JOB PRINT. 01630CLR EXSR SR103 FINAL PRINT 01640C*------------------------------------------------------------------- 01650CLR ENDJOB TAG 01660C******************************************************************** 01670CSR SR67 BEGSR 01680C* LINE FEED. 01690CSR 1 ADD LINE LINE 30 01700CSR EXITFQCLF 01710CSR ENDSR 01720C******************************************************************** 01730CSR SR68 BEGSR 01740C* TOP OF FORM. 01750CSR 1 ADD EGAP EGAP 30 ÐÐ01760CSR EXITFZTFORM TOP FORM 01770CSR Z-ADD1 LINE 01780CSR ENDSR 01790C******************************************************************** 01800CSR SR69 BEGSR 01810C* PRINT ROUTINE. 01820CSR EXSR SR67 LF 01830CSR PORT CHAINCRTFILE H9 01840CSR H9 GOTO ENDJOB 01850CSR MOVE ' ' PRT 01860CSR EXCPT UPDATE CRTFILE 01870CSR SETOF 414243 01880CSR SETOF 7273 01890CSR PORT CHAINCRTFILE GET PRINT RECORD 01900CSR MOVEAREC W148A 148 01910CSR EXITFZD148 PRINT 01920CSR RLABL W148A 01930CSR ENDSR 01940C******************************************************************** 01950CSR SR72 BEGSR 01960C* PRINT DATA LINE. 01970CSR Z-ADDP W 30 01980CSR EXSR SR80 GET PART MST 01990CSRN60 MOVE PMDESC DESCR1 29 02000CSRN61 Z-ADDCACAL DATE1 60 ÐÐ02010CSR Z-ADDQ W 30 02020CSR EXSR SR80 GET PART MAST 02030CSRN60 MOVE PMDESC DESCR2 29 02040CSRN61 Z-ADDCACAL DATE2 60 72 02050CSR EXSR SR69 PRINT 02060CSR ENDSR 02070C******************************************************************** 02080CSR SR73 BEGSR 02090C* DISPLAY MESSAGE. 02100CSR M CHAINMGFILE 54 GET MSG 02110CSR 54 GOTO END73 02120CSR SETON 73 02130CSR EXSR SR69 PRINT 02140CSR END73 ENDSR 02150C******************************************************************** 02160CSR SR80 BEGSR 02170C* GET PART MAST. 02180CSR PN,W COMP 0 60 02190CSR MOVEL'M' W7A 7 02200CSR MOVE DAT,W W7A 02210CSR W7A CHAINCALENDAR 61 02220CSR ENDSR 02230C******************************************************************** 02240CSR SR101 BEGSR 02250C* 1-TIME INIT. ÐÐ02260CSR SETON 79 02270CSR MOVE BIT,1 NUL 02280CSR MOVE ' 'W8A 8 02290CSR Z-ADD0 ZERO10 100 02300CSR Z-ADD0 W2N 20 02310CSR Z-ADD0 W1N 10 02320CSR MOVE ' ' W2A 2 02330CSR EXITFPGMINX GET PORT # 02340CSR RLABL W8A 02350CSR RLABL W2N 02360CSR RLABL W1N 02370CSR RLABL W2A 02380CSR MOVE W2A PORT 20 02390CSR PORT COMP 0 54 02400CSRN54 Z-ADD25 PORT 02410CSR Z-ADD574 M 50 02420CSR EXSR SR73 PROMPT 02430CSR MOVELBIT,1 BUFLGT 2 02440CSR MOVE BIT,2 BUFLGT 02450CSR MOVE ' ' W2A 02460CSR EXITFQWREED READ INDENT LEV 02470CSR RLABL W2A 02480CSR RLABL BUFLGT 02490CSR Z-ADD2 W2N 02500CSR EXIT SUBRAJ ÐÐ02510CSR RLABL W2N 02520CSR RLABL W2A 02530CSR MOVE W2A BEGLEV 20 02540CSR BEGLEV COMP 0 54 02550CSRN54 Z-ADD1 BEGLEV 02560CSR ENDSR 02570C******************************************************************** 02580CSR SR102 BEGSR 02590C* LOAD ARRAYS. 02600CSR 1 ADD P P 30 02610CSR Z-ADDSELL LEV,P 02620CSR Z-ADDSEPN PN,P 02630CSR Z-ADDEXC,1 DAT,P 02640CSR ENDSR 02650C******************************************************************** 02660CSR SR103 BEGSR 02670C* PRINT. 02680CSR EXSR SR104 HEADINGS 02690CSR Z-ADD1 P 02700C*------------------------------------------------------------------- 02710CSR T103A TAG 02720CSR ZERO10 LOKUPPN,P 54 02730CSRN54 GOTO END103 DONE 02740CSR MOVELPN,P W12A 12 02750CSR W12A CHAINPMMST2 54 ÐÐ02760CSRN54 PMSTAT COMP 'D' 54 02770CSR 54 Z-ADD0 PN,P 02780CSR 54 GOTO T103A 02790CSR MOVELPMSC W1A 1 02800CSR W1A COMP 'P' 54 02810CSRN54 Z-ADD0 PN,P 02820CSRN54 GOTO T103A 02830CSR 80 ADD P Q 30 02840CSR EXSR SR72 PRINT 02850CSR Z-ADD0 PN,P 02860CSR Z-ADD0 PN,Q 02870CSR Z-ADD0 DAT,P 02880CSR Z-ADD0 DAT,Q 02890CSR Z-ADD0 LEV,P 02900CSR Z-ADD0 LEV,Q 02910CSR GOTO T103A 02920CSR Z-ADD0 P 02930CSR END103 ENDSR 02940C******************************************************************** 02950CSR SR104 BEGSR 02960C* PUT HEADINGS. 02970CSR EXSR SR68 TOP FORM 02980CSR SETON 41 02990CSR EXSR SR69 PRINT 03000CSR EXSR SR67 LF ÐÐ03010CSR SETON 42 03020CSR EXSR SR69 PRINT 03030CSR SETON 43 03040CSR EXSR SR69 PRINT 03050CSR EXSR SR67 LF 03060CSR EXSR SR67 LF 03070CSR ENDSR 03080O******************************************************************** 03090OCRTFILE E 41 03100O PRT 228 03110O UDATE Y 88 03120O 150 'TO BE ORDERED' 03130O EGAP Z 212 03140O 208 'PAGE' 03150O*------------------------------------------------------------------- 03160O E 42 03170O PRT 228 03180O 89 'INDENTURE' 03190O 95 'DATE' 03200O 154 'INDENTURE' 03210O 160 'DATE' 03220O*------------------------------------------------------------------- 03230O E 43 03240O PRT 228 03250O 87 'LEVEL' ÐÐ03260O 97 'REQUIRED' 03270O 108 'PART-NO.' 03280O 125 'DESCRIPTION' 03290O 152 'LEVEL' 03300O 162 'REQUIRED' 03310O 173 'PART-NO.' 03320O 190 'DESCRIPTION' 03330O*------------------------------------------------------------------- 03340O E 72 03350O PRT 228 03360O LEV,P ZB 82 03370O DATE1 B 97 ' - - ' 03380O PN,P B 111 ' - - ' 03390O DESCR1 B 143 03400O LEV,Q ZB 147 03410O DATE2 B 162 ' - - ' 03420O PN,Q B 176 ' - - ' 03430O DESCR2 B 208 03440O*------------------------------------------------------------------- 03450O E 73 03460O PRT 228 03470O NUL 228 03480O MGTEXT 115 03490O 117 ' ' ** LEV ARRAY 003500ÐÐ 003510** DAT ARRAY 003520 003530** PN ARRAY 003540 003550** NUL ARRAY 003560 003570** PRT ARRAY 003580 003590/* 003600_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(rTÉ r°X002PR P999999120282(èÈÐ00010H Q002PR00020F* PURCH REQ - ADD, CHANGE, DELETE. (X002PR) 00030F* REVISED 1/06/82 2:50 PM. 00040FBIT44 IP F 44 DISK 00050FPOITEM UC F 384R 9AI 1 DISK A 00060FPMMST2 UC F 674R12AI 1 DISK 00070FPRMAST UC F 128R 6AI 1 DISK 00080FWMMAST IC F 470R 6AI 1 DISK 00090FPJMAST IC F 170R12AI 1 DISK 00100FGLMAST IC F 165R 9AI 1 DISK 00110FMGFILE IC F 80R DISK 00120FCRTFILE UC F 256R DISK 00130FSFMAST UC F 128R29AI 1 DISK A 00140FALTKEY UC F 32R29AI 1 DISK A 00150FCALENDARIC F 22R 7AI 1 DISK 00160FSFPNA O F 10 DISK A 00170FTERM132 O F 132 5 00180E***************************************************************** 00190E NUL 1 132 1 NULL CHAR 00200E A9 9 9 1 SR75 READ CRT BUF 00210E A70 70 70 1 A SR75 READ CRT BUF 00220E NUM 1 3 3 0 NUMERIC FIELD NO.'S 00230E DUN 1 8 1 A EDIT VMPLT FLAG 00240E DOT 26 26 1 CRT OUTPUT CONSTANT 00250E RCD 1 26 7 0 RECEIVED QTYS ÐÐ00260E OPN 1 26 7 0 OPEN QTYS 00270E UP 26 26 1 UPDATE FLAGS 00280E LN 1 3 10 LOT CODE NAMES 00290E BQ 1 26 7 0A SCHED QTYS BEF UPDATE 00300E BD 1 26 6 0 SCHED DATES BEF UPDATE 00310E NAM 1 1 15 NAME ARRAY 00320E BIT 44 1 SCREEN CONTR. CHAR 00330E PLT 8 3 0 PART MAST LEAD TIMES 00340E PID 26 6 0A PRITEM SCHED DATES 00350E PIQ 26 7 0A PRITEM SCHED QTYS 00360I******************************************************************** 00370IBIT44 BT 00380I 1 44 BIT 00390I****************************************************************** 00400ICRTFILE CR 00410I 68 73 CRRET 00420I 74 79 CRMENU 00430I* TRAN CODE - PR MAST 00440I 81 81 CRPRTR 00450I* ORDER NO. 6A 00460I 82 87 CRPR 00470I* ITEM # 3N 00480I 88 900CRITEM 00490I* VENDOR NAME 35A 00500I 91 125 CRVNAM ÐÐ00510I***************************************************************** 00520IWMMAST WM 00530I* DATE CLOSED 6N 00540I 411 4160WMCLOS 00550I* QTY REL 7P 00560I P 417 4200WMQREL 00570I* RECORD STATUS 1A 00580I 470 470 WMSTAT 00590I***************************************************************** 00600IPJMAST PJ 00610I 30 69 PJNAME 00620I 170 170 PJSTAT 00630I****************************************************************** 00640IGLMAST GL 00650I 18 57 PJNAME 00660I 165 165 GLSTAT 00670I****************************************************************** 00680IPMMST2 PM 00690I* PART NUMBER 10N 00700I 1 100PMPN 00710I* PART DESCRIPTION 29A 00720I 31 59 PMDESC 00730I* ENG CHANGE LEVEL 2A 00740I 70 71 PMECHG 00750I* SOURCE CODE 2A ÐÐ00760I 94 95 PMSC 00770I* LEAD TIMES 3P X 8 00780I P 113 128 PLT 00790I* ON-HAND BALANCE 7P 00800I P 311 3140PMOHB 00810I* P.O. BAL 7P 00820I P 343 3460PMPOB 00830I* UNIT COST - MFG 9.3P 00840I P 615 6193PMTCST 00850I* RECORD STATUS 1A 00860I 674 674 PMSTAT 00870I******************************************************************** 00880IMGFILE MG 00890I 1 35 MGTEXT 00900I******************************************************************** 00910ICALENDARCA 20 1 CC 00920I* CALENDAR DATE RECORD. 00930I 2 70CACAL 00940I 14 170CAMDAY 00950I 18 200CAWK 00960I 21 220CADOW 00970I*------------------------------------------------------------------- 00980I CB 21 1 CM 00990I* MFG DATE RECORD. 01000I 4 70CAMDAY ÐÐ01010I 8 130CACAL 01020I 18 200CAWK 01030I 21 220CADOW 01040I*------------------------------------------------------------------- 01050I GG 02 01060I******************************************************************** 01070IPRMAST PO 01080I* PURCHASE ORDER MASTER RECORD. 01090I* P.O. # 6A (KEY) 01100I 1 6 PRPR 01110I* VENDOR # 5N 01120I 7 110PRVEND 01130I* DELIVER TO 12A 01140I 12 23 PRBY 01150I* ORDER TYPE 1A 01160I* Y = CONFIRMATION 01170I 24 24 PRTYPE 01180I* WORK ORDER/ACCOUNT 9A 01190I 27 35 PRWO 01200I* FILLER 36 42 FFFFFF 01210I* INSPECTION CODE 2A 01220I 43 44 PRINSP 01230I* ORDER DATE 6N 01240I 45 500PRDORD 01250I* SHIP VIA 10A ÐÐ01260I 51 60 PRVIA 01270I* ORDER ATTENTION OF 10A 01280I 61 70 PRATT 01290I* TERMS 8A 01300I 71 78 PRTERM 01310I* FOB 1A 01320I 79 79 PRFOB 01330I* RESALE 1A 01340I 80 80 PRRSAL 01350I* CONTRACT NO. 12A 01360I 81 92 PRCNTR 01370I* PRIORITY 15A 01380I 93 107 PRPRTY 01390I* CONFIRMATION REQD 1A 01400I 108 108 PRCONF 01410I* DATE CLOSED 6N 01420I 109 1140PRDCLS 01430I* BUYER CODE 2A 01440I 115 116 PRBUYR 01450I* CERTS REQD (Y,N) 1A 01460I 117 117 PRCERT 01470I* LAST ITEM NO. USED 3P 01480I P 118 1190PRLITM 01490I* RECORD STATUS 1A 01500I 128 128 PRSTAT ÐÐ01510I******************************************************************** 01520IPRITEM PQ 01530I* PURCHASE ORDER ITEM RECORD. 01540I* KEY AREA. 01550I* PR # 6N 01560I 1 60PQPR 01570I* PR ITEM 3N 01580I* * * * * * 7 90PQITEM 01590I* DYNAIR PART # 10N 01600I 10 190PQPN 01610I* VENDOR PART # 15A 01620I 20 34 PQVPN 01630I* DESCRIPTION 29A 01640I 35 63 PQDESC 01650I* NON-INVENTORY DESCRIPTION 70A 01660I 10 79 PQNDES 01670I* DATE LAST RECEIPT 6N 01680I 80 850PQDLR 01690I* QTY RECEIVED 7P 01700I P 86 890PQQRCD 01710I* QTY TO STK,SCRAP,RTV 7P 01720I P 90 930PQQSTK 01730I* PRICE CODE 1A 01740I* L = LOT 01750I* N = NO CHARGE ÐÐ01760I 94 94 PQLOT 01770I* PRICE 9.3P 01780I P 95 993PQ$PRC 01790I* WORK ORDER # 9A 01800I 100 108 PQWO 01810I 100 105 PQWOP 01820I 106 1080PQWOD 01830I* VENDOR # 5P (FROM PRMAST) 01840I P 109 1110PQVEND 01850I* LAST RCVG LOG # USED 2N 01860I 112 1130PQLLOG 01870I* SCHEDULE DATES 6N X 26 (Y,M,D) 01880I 114 269 PQD 01890I* SCHED QTYS 7P X 26 01900I P 270 373 PIQ 01910I* RECORD STATUS 1A 01920I 384 384 PQSTAT 01930I********************************************************************* 01940ISFMAST SF 01950I 128 128 SFSTAT 01960I********************************************************************* 01970IALTKEY AK 01980I 32 32 AKSTAT 01990C******************************************************************** 02000C* INITIALIZE ÐÐ02010C EXSR SR101 1-TIME INIT 02020C*------------------------------------------------------------------ 02030C START TAG 02040C* SET-UP 1ST FIELD NO. 02050C SETOF 603140 02060C MOVE ' ' DUN INIT EDIT ARRAY 02070C Z-ADD1 F 30 FIELD # 02071C EXSR SR205 INIT ITEM FIELDS 02080C EXSR SR70 NEW PAGE 02090C EXSR SR71 PUT HEADING 02100C GOTO READ 02110C*------------------------------------------------------------------ 02120C NEXT TAG 02130C* SET-UP NEXT FIELD NO. 02140C 1 ADD F F FIELD # 02150C*----------------------------------------------------------------- 02160C READ TAG 02170C* READ DATA FROM TERMINAL. 02180C SETOF 909677 02190C SETOF 40 02200C EXSR SR102 VALIDATE FIELD # 02210C 55 GOTO SCHED DONE 02220C EXSR SR201 IDENTIFY-F 02230C EXSR SR203 CLASSIFY TRAN 02240C F COMP 3 54 ÐÐ02250C 65 54 GOTO LINK2 LIST TRAN 02260C 62 54 GOTO SCHED DELETE TRAN 02270C N63N64N65 GOTO CONTU NOT TEXT OR MENU 02280C 63 02 GOTO NEXT 02290C 54 GOTO LINK2 TEXT ONLY 02300C GOTO CONTU2 02310C*------------------------------------------------------------------ 02320C CONTU TAG 02330C* NON-INVENTORY ITEM, BYPASS INVENTORY ITEM FIELDS 02340C 04N70 02350COR 05N70 GOTO NEXT 02360C*------------------------------------------------------------------ 02370C CONTU2 TAG 02380C SETON 69 02390C EXSR SR72 PROMPT 02400C SETOF 69 02410C EXSR SR75 READ TERMINAL 02420C MOVE BLK35 MGTEXT MSG INIT 02430C 90 EXSR SR72 PUT DATA ON ESC 02440C*------------------------------------------------------------------- 02450C ESCAPE TAG 02460C 98 GOTO GOODBY GOODBY 02470C 94 GOTO MENU MENU REQUEST 02480C 93 GOTO NEWITM NEW ITEM 02490C 92 GOTO JUMP FIELD JUMP REQST ÐÐ02500C 91 F SUB 1 F SKIP BACKWARD 02510C 91N70 EXSR SR201 02520C 91N70 04 02530COR 91N70 05 Z-ADD3 F 02540C 91 GOTO READ " " 02550C 95 SETOF 90 SPACE FILL 02560C 95 SETON 77 " " 02570C 88 GOTO UPDATE UPDATE 02580C 96 EXSR SR89 GET MGFILE 02590C 96 GOTO READ ERROR 02600C 99 GOTO LINK TEXT OR LIST 02610C N77 GOTO EDIT NO DATA INPUT 02620C*------------------------------------------------------------------ 02630C PROCES TAG 02640C* PROCESS INPUT DATA 02650C EXSR SR103 MOVE DATA 02660C*------------------------------------------------------------------- 02670C EDIT TAG 02680C EXSR SR104 EDIT DATA 02690C N96 EXSR SR72 REWRITE DATA 02700C 96 EXSR SR89 GET MGFILE 02710C 96 GOTO READ ERROR 02720C EXSR SR203 CLASSIFY TRAN 02730C 62 03 GOTO SCHED DELETE 02740C 63 02 GOTO LINK2 TEXT ÐÐ02750C 64N01 GOTO SCHED SCHED 02760C 65 02 GOTO LINK2 LIST 02770C GOTO NEXT 02780C*------------------------------------------------------------------- 02790C SCHED TAG 02800C* UPDATE SCHEDULE. 02810C SETOF 9096 02820C Z-ADD20 F 02830C EXSR SR201 SETOFF 01-08 02840C Z-ADD1 F 02850C EXSR SR250 SCHED UPDATE 02860C 90N88 GOTO ESCAPE 02870C 96 GOTO ERROR 02880C GOTO UPDATE 02890C*------------------------------------------------------------------ 02900C UPDATE TAG 02910C* UPDATE DATA BASE. 02920C EXSR SR105 FINAL EDIT 02930C 96 GOTO ERROR ERROR 02940C EXSR SR106 UPDATE 02950C 96 GOTO ERROR ERROR 02951C EXSR SR300 UPDATE SFMAST 02960C SETON 48 02970C EXCPT NOW WHADAYAWANNADO 02980C SETOF 48 ÐÐ02990C SETON 44 03000C EXSR SR75 03010C SETOF 44 03020C 98 GOTO GOODBY 03030C 94 GOTO MENU 03040C 93 GOTO NEWITM 03050C 99 GOTO LINK 03060C MOVEL'Q002PR' PROG 03070C GOTO END 03080C*------------------------------------------------------------------- 03090C JUMP TAG 03100C* SET-UP JUMP TO REQUESTED FIELD 03110C 1 ADD W W 30 03120C W COMP 70 54 03130C 54 Z-ADD318 M 50 96 FLAG ERROR 03140C 54 GOTO ERROR BAD ESC 03150C MOVE ' ' W3A 3 03160C MOVEAA70,W W3A 03170C Z-ADD3 W2N 20 03180C EXIT SUBRAJ R. JUSTIFY 03190C RLABL W2N 03200C RLABL W3A 03210C MOVE W3A F NEW FIELD # 03220C GOTO READ 03230C*-------------------------------------------------------------------- ÐÐ03240C ERROR TAG 03250C EXSR SR102 VALIDATE FIELD # 03260C EXSR SR89 GET MSG 03270C GOTO READ 03280C*--------------------------------------------------------------- 03290C LINK TAG 03300C* LINK TO PRODUCT MENU OR TO TEXT UPDATE 03310C A70,W COMP 'T' 63 TEXT UPDATE 03320C A70,W COMP 'L' 65 LIST REQUEST 03330C*------------------------------------------------------------------ 03340C LINK2 TAG 03350C 63 MOVEL'Q003PX' PROG TEXT UPDATE 03360C 65 MOVEL'Q010PR' PROG LIST TRAN 03370C GOTO END 03380C*------------------------------------------------------------------ 03390C NEWITM TAG 03400C* SET-UP LINK FOR NEW ITEM 03410C MOVELCRRET PROG 8 03420C GOTO END 03430C*------------------------------------------------------------------- 03440C MENU TAG 03450C* SET-UP LINK TO MENU 03460C MOVELCRMENU PROG 03470C GOTO END 03480C*-------------------------------------------------------------------- ÐÐ03490C GOODBY TAG 03500C* LINK TO SIGN-OFF 03510C MOVEL'GOODBY' PROG 03520C GOTO END 03530C*------------------------------------------------------------------- 03540C END TAG 03550C MOVE 'Q002PR' CRRET 03560C EXSR SR97 UPDATE CRTFILE 03570C PROG COMP BLK8 54 03580C N54 MOVELCRMENU PROG 03590C MOVELPROG W6A 03600C W6A COMP 'Q003PX' 54 TEXT UPDATE PROG 03610C EXITFCHAIN LINK TO NEXT PROG 03620C RLABL PROG 03630C*------------------------------------------------------------------- 03640C ENDJOB TAG 03650C******************************************************************** 03660CSR SR1 BEGSR 03670C* EDIT TRAN CODE 03680CSR TRAN COMP ' ' 54 03690CSR CRPRTR COMP 'I' 55 03700CSR 54N55 MOVE CRPRTR TRAN 03710CSR EXSR SR203 CLASSIFY TRAN 03720CSRN63N65N64 03730CANN60N61N62 Z-ADD300 M 50 96 FLAG ERROR ÐÐ03740CSR ENDSR 03750C******************************************************************* 03760CSR SR2 BEGSR 03770C* EDIT ITEM # 03780CSR TITEM COMP 0 54 03790CSRN54 EXSR SR203 CLASSIFY TRAN 03800CSRN54 60 PRLITM ADD 1 PRLITM 03810CSRN54 60 Z-ADDPRLITM TITEM DEFAULT 03820CSR TITEM COMP 0 54 03830CSRN54 Z-ADD47 M 96 FLAG ERROR 03840CSRN54 GOTO END2 03850CSR TITEM COMP PRLITM 54 03860CSR 54 Z-ADDTITEM PRLITM 03870CSR MOVELCRPR W9A 9 03880CSR MOVE TITEM W9A 03890CSR EXSR SR205 INIT PRITEM 03900CSR EXSR SR80 GET PRITEM 03910CSR 30 NOT ON FILE 03920COR 31 GOTO T2B DELETED 03930C* ITEM IS ON FILE. 03931CSR EXSR SR3 EDIT WO # 03932CSR EXSR SR4 EDIT PART NO. 03940CSR EXSR SR203 CLASSIFY TRAN 03950CSR 60 Z-ADD0 TITEM 03960CSR 60 Z-ADD301 M 96 FLAG ERROR ÐÐ03970CSR 62 PQQRCD COMP 0 54 03980CSR 62 54 Z-ADD29 M 96 FLAG ERROR 03990CSR EXSR SR7 EDIT LOT CODE 04000CSR EXSR SR204 CLASSIFY WORK ORDER 04010CSR EXSR SR71 PUT NEW SCREEN 04020CSR EXSR SR252 CALC RECEIPTS 04030CSR EXSR SR253 DISPLAY SCHED 04040CSR GOTO END2 04050C*--------------------------------------------------------------------- 04060CSR T2B TAG 04070C* ITEM NOT ON FILE. 04080CSR EXSR SR205 INIT PRITEM 04090CSR EXSR SR203 CLASSIFY TRAN 04100CSRN60 Z-ADD5 M 96 FLAG NOT ON FILE 04110CSR END2 ENDSR 04120C******************************************************************** 04130CSR SR3 BEGSR 04140C* EDIT WORK ORDER. 04150CSR MOVE BLK70 PJNAME 04160CSR PQWOP COMP ' 00000' 54 04170CSRN54 MOVE PRWO PQWO DEFAULT 04180CSRN54 MOVELPRWO PQWOP 04190CSRN54 MOVE PRWO PQWOD 04200CSR PQWOP COMP ' 00000' 54 04210CSRN54 MOVE ' 14100' PQWOP DEFAULT ÐÐ04220CSRN54 Z-ADD0 PQWOD 04230CSR MOVELPQWOP PQWO 04240CSR MOVE PQWOD PQWO 04250CSR EXSR SR204 CLASSIFY ACCOUNT 04260CSR 70 GOTO T3B INVENTORY ACCOUNT 04270CSR PQWOP CHAINWMMAST 54 GET PROD WORK ORDER 04280CSR 54 GOTO T3A NO HIT 04290CSR MOVELNAM,1 PJNAME 04300CSR WMSTAT COMP 'D' 54 04310CSR WMQREL COMP 0 54 04320CSR WMCLOS COMP 0 56 04330C*R 56 ********** CLOSED 04340C*R 54 ********** DELETED 04350C*RN55 ********** Z-ADD506 M 96 NOT RELEASED 04360CSR GOTO END3 04370C*----------------------------------------------------------------- 04380CSR T3A TAG 04390CSR MOVELPQWO W12A 12 04400CSR MOVE '620' W12A 04410CSR W12A CHAINPJMAST 54 GET PROJECT MASTER 04420CSR 54 GOTO T3B NO HIT 04430CSR PJSTAT COMP 'D' 54 04440C*R 54 ********** Z-ADD506 M 96 DELETED 04450CSR GOTO END3 04460C*---------------------------------------------------------------- ÐÐ04470CSR T3B TAG 04480CSR PQWO CHAINGLMAST 54 GET ACCOUNT MASTER 04490CSRN54 GLSTAT COMP 'D' 54 FLAG DELETE 04500C*R 54 ********** Z-ADD506 M 96 FLAG ERROR 04510CSR END3 ENDSR 04520C***************************************************************** 04530CSR SR4 BEGSR 04540C* EDIT PART NUMBER 04550CSRN70 GOTO END4 NOT INVENTORY ITEM 04560CSR PQPN COMP 0 54 04570CSRN54 Z-ADD299 M 96 FLAG ERROR 04580CSRN54 GOTO END4 04590CSR MOVELPQPN W12A 12 04600CSR EXSR SR83 GET PART MAST 04610CSR 60 Z-ADD291 M 96 FLAG ERROR 04620CSR 60 GOTO END4 04630CSR PQDESC COMP BLK29 54 04640CSRN54 MOVE PMDESC PQDESC 04650CSR END4 ENDSR 04660C******************************************************************** 04670CSR SR7 BEGSR 04680C* EDIT LOT CODE 04690CSR PQLOT COMP 'L' 50 04700CSR PQLOT COMP 'N' 51 04710CSR MOVE BLK35 LOTNAM 10 ÐÐ04720CSR 50 MOVE LN,1 LOTNAM LOT CHARGE 04730CSR 51 MOVE LN,2 LOTNAM NO CHARGE 04740CSRN50N51 MOVE LN,3 LOTNAM UNIT PRICE 04750CSRN50N51 MOVE 'U' PQLOT 04760CSR ENDSR 04770C******************************************************************** 04780CSR SR8 BEGSR 04790C* EDIT UNIT/LOT PRICE $ 04800CSR 51 GOTO T8B NO CHARGE 04810CSR 50 GOTO T8D LOT CHARGE 04820CSR GOTO T8H NET PRICE 04830C*--------------------------------------------------------------- 04840CSR T8B TAG 04850C* NO CHARGE 04860CSR Z-ADD0 PQ$PRC NO CHARGE 04870CSR GOTO END8 04880C*--------------------------------------------------------------- 04890CSR T8D TAG 04900C* LOT CHARGE 04910CSR PQ$PRC COMP 0 54 04920CSRN54 Z-ADD262 M 96 FLAG ERROR 04930CSR GOTO END8 04940C*---------------------------------------------------------------- 04950CSR T8H TAG 04960C* INPUT PRICE. ÐÐ04970CSR PQ$PRC COMP 0 55 04980CSRN55 Z-ADD262 M 96 FLAG ERROR 04990CSR END8 ENDSR 05000C******************************************************************** 05010CSR SR47 BEGSR 05020C* PUT CLEAR CRT. 05030CSR SETON 47 05040CSR EXCPT CLEAR CRT 05050CSR SETOF 47 05060CSR ENDSR 05070C*********************************************************** 05080CSR SR49 BEGSR 05090C* INIT PREV ERROR MESSAGE 05100CSR SETOF 96 05110CSR SETON 49 05120CSR EXCPT INIT SCHED ERR MSG 05130CSR SETOF 49 05140CSR ENDSR 05150C******************************************************************** 05160CSR SR67 BEGSR 05170C* MOVE CURSOR-UP 1-LINE. 05180CSR EXITFQMOVUP 05190CSR ENDSR 05200C****************************************************************** 05210CSR SR68 BEGSR ÐÐ05220C* LINE FEED 05230CSR EXITFQCLF LF 05240CSR ENDSR 05250C***************************************************************** 05260CSR SR69 BEGSR 05270C* POSITION CURSOR 05280CSR EXITFQXYPOS POSITION CURSOR 05290CSR RLABL W6A 05300CSR ENDSR 05310C******************************************************************** 05320CSR SR70 BEGSR 05330C* CLEAR NEW PAGE. 05340CSR EXITFZCPAGE CLEAR PAGE-4 05350CSR ENDSR 05360C********************************************************************** 05370CSR SR71 BEGSR 05380C* PUT HEADINGS TO TERMINAL 05390CSR PQWOD COMP 0 55 05400CSR SETON 7146 05410CSR EXCPT PUT HEADINGS 05420CSR SETOF 7146 05430CSR ENDSR 05440C********************************************************************* 05450CSR SR72 BEGSR 05460C* PUT DATA TO TERMINAL ÐÐ05470CSR PQWOD COMP 0 55 05480CSR 91 ADD F W3N 30 05490CSR MOVELW3N W6A 6 05500CSR MOVE '001' W6A 05510CSR EXSR SR69 POSITION CURSOR 05520CSR SETON 72 05530CSR EXCPT PUT DATA 05540CSR SETOF 72 05550CSR ENDSR 05560C*********************************************************************** 05570CSR SR73 BEGSR 05580C* PUT ERROR MESSAGE TO TERMINAL 05590CSRN41 91 ADD F W3N 05600CSRN41 MOVE W3N LOC 3 05610CSR SETON 73 05620CSR EXCPT PUT MSG 05630CSR SETOF 73 05640CSR ENDSR 05650C******************************************************************** 05660CSR SR74 BEGSR 05670C* PUT WARNING MESSAGE 05680CSR EXSR SR89 GET MESSAGE 05690CSR EXSR SR73 PUT MESSAGE 05700CSR ENDSR 05710C******************************************************************* ÐÐ05720CSR SR75 BEGSR 05730C* READ FROM TERMINAL 05740CSR SETOF 779096 05750CSR SETOF 939291 05760CSR SETOF 888789 05770CSR SETOF 9995 05780CSR MOVE BIT,36 BUFLGT 2 READ BUFFER LGTH 05790CSR MOVE BLK70 W70A 70 BUFFER 05800CSR MOVE BIT,28 A9,1 05810CSR MOVE '8' A9,2 05820CSRN41N44 F ADD 92 W3N 30 05830CSRN41N44 MOVE W3N W3A 3 05840CSRN41N44 MOVEAW3A A9,3 05850CSRN41N44 MOVEA'029' A9,6 05860CSR 41 MOVEA'103025' A9,3 05870CSR 44 MOVEA'103050' A9,3 05880CSR MOVE BIT,8 A9,9 05890CSR MOVEAA9 W9A 9 05900CSR EXSR SR69 POSITION CURSOR 05910CSR EXITFQPREED READ FROM TERMINAL 05920CSR RLABL W9A 05930CSR RLABL W70A READ BUFFER 05940CSR RLABL BUFLGT READ BUFFER LGTH 05950CSR MOVEAW70A A70 INPUT DATA ARRAY 05960CSR MOVE BLK70 W70A INIT INPUT ARRAY ÐÐ05970CSR Z-ADD1 W 30 05980CSR '\' LOKUPA70,W 90 FLAG ESC 05990CSRN90 GOTO T75B NOT ESC 06000CSR 1 ADD W W 06010CSR W COMP 70 54 06020CSR 54 GOTO T75A BAD ESC 06030CSR A70,W COMP 'G' 98 GOODBY 06040CSR A70,W COMP 'E' 94 MENU 06050CSR A70,W COMP 'N' 93 NEW ITEM 06060CSR A70,W COMP 'J' 92 JUMP 06070CSR A70,W COMP 'B' 91 SKIP BKWRD 06080CSR A70,W COMP 'S' 95 SPACE FILL 06090CSR A70,W COMP 'D' 87 DONE 06100CSR A70,W COMP 'U' 88 UPDATE 06110CSR A70,W COMP 'T' 99 TEXT REQUEST 06120CSRN99 A70,W COMP 'L' 99 LIST REQUEST 06130CSR A70,W COMP 'H' 89 HELP 06140CSR 99N41 06150COR 98 06160COR 94 06170COR 93 06180COR 92 06190COR 91N41 06200COR 95N41 06210COR 87 41 ÐÐ06220COR 88 GOTO END75 GOOD ESC 06230CSR 89 41 06240COR 89N41 01 GOTO T75C HELP 06250C*------------------------------------------------------------------ 06260CSR T75A TAG 06270C* FLAG BAD ESC INPUT 06280CSR Z-ADD318 M 96 FLAG ERROR 06290CSR EXSR SR89 GET MSG 06300CSR EXSR SR73 PUT MSG 06310CSR GOTO SR75 06320C*-------------------------------------------------------------------- 06330CSR T75B TAG 06340C* MOVE DATA 06350CSR Z-ADD1 W 06360CSR ' ' LOKUPA70,W 77 06370CSR 77 MOVEAA70,W W70A INPUT DATA 06380CSR GOTO END75 06390C*------------------------------------------------------------------- 06400CSR T75C TAG 06410C* HELP REQUEST. 06420CSRN41 SETON 7847 06430CSRN41 EXCPT NON-SCHD HELP 06440CSRN41 SETOF 7847 06450CSRN41 GOTO SR75 06460CSR 41 SETON 45 ÐÐ06470CSR 41 EXCPT PUT SCHED HELP 06480CSR 41 SETOF 45 06490C*----------------------------------------------------------------- 06500CSR END75 TAG 06510CSR 41N89 EXSR SR49 INIT PREV ERR MSG 06520CSR ENDSR 06530C*************************************************************** 06540CSR SR76 BEGSR 06550C* PUT SCHEDULE DATA TO CRT (SEE SR250,253). 06560CSR S ADD 105 W3N 30 06570CSR S COMP 13 54 06580CSR 54 W3N SUB 13 W3N 06590CSR W3N SUB 1 W3N 06600CSR MOVELW3N W6A 06610CSR MOVE '001' W6A X-Y POS 06620CSR 54 Z-ADDS B 06630CSR 54 B SUB 13 A 06640CSRN54 Z-ADDS A 06650CSRN54 13 ADD A B 06660CSR UP,A COMP ' ' 42 06670CSR UP,B COMP ' ' 43 06680CSR EXSR SR69 PUT CURSOR 06690CSR SETON 76 06700CSR EXCPT PUT SCHED DATA 06710CSR SETOF 76 ÐÐ06720CSR ENDSR 06730C**************************************************************** 06740CSR SR79 BEGSR 06750C* GET PURCH ORDER MASTER. 06760CSR CRPR CHAINPRMAST H8 GET PRMAST 06770CSRN60 PRSTAT COMP 'D' H8 06780CSR H8 GOTO ENDJOB 06790CSR ENDSR 06800C********************************************************************** 06810CSR SR80 BEGSR 06820C* GET PURCH ITEM MASTER 06830CSR SETOF 31 06840CSR W9A CHAINPRITEM 30 GET PRITEM 06850CSRN30 PQSTAT COMP 'D' 31 FLAG DELETE 06860CSR Z-ADD0 BEGPRB 70 BEGIN PR QTY TOTAL 06870CSR 30 06880COR 31 GOTO END80 06890CSR XFOOTPIQ BEGPRB 06900CSR BEGPRB SUB PQQRCD BEGPRB 54 06910CSRN54 Z-ADD0 BEGPRB 06920CSR END80 ENDSR 06930C********************************************************************** 06940CSR SR81 BEGSR 06950C* ADD NEW PURCH ITEM MASTER 06960CSR SETON 81 ÐÐ06970CSR EXCPT ADD PRITEM 06980CSR SETOF 813031 06990CSR ENDSR 07000C*********************************************************************** 07010CSR SR82 BEGSR 07020C* REWRITE PURCH ITEM MASTER 07030CSR SETON 82 07040CSR EXCPT REWRITE PRITEM 07050CSR SETOF 823031 07060CSR ENDSR 07070C*************************************************************** 07080CSR SR83 BEGSR 07090C* GET PART MASTER 07100CSR MOVE ' ' W12A 07110CSR W12A CHAINPMMST2 60 GET PMMST2 07120CSRN60 PMSTAT COMP 'D' 60 FLAG DELETE 07130CSR ENDSR 07140C*************************************************************** 07150CSR SR84 BEGSR 07160C* GET CALENDAR 07170CSR W7A CHAINCALENDAR 60 GET CALENDAR 07180CSR ENDSR 07190C****************************************************************** 07200CSR SR85 BEGSR 07210C* UPDATE PART MASTER ÐÐ07220CSR PMPRB SUB BEGPRB PMPRB 07230CSR XFOOTPIQ W7N 70 07240CSR W7N SUB PQQRCD W7N 54 07250CSRN54 Z-ADD0 W7N 07260CSR W7N ADD PMPRB PMPRB ENDING PR QTY TOTAL 07270CSR SETON 85 07280CSR EXCPT UPDATE PMMST2 07290CSR SETOF 85 07300CSR ENDSR 07310C***************************************************************** 07320CSR SR86 BEGSR 07330C* UPDATE PO MASTER 07340CSR SETON 86 07350CSR EXCPT UPDATE PRMAST 07360CSR SETOF 86 07370CSR ENDSR 07380C***************************************************************** 07390CSR SR89 BEGSR 07400C* GET MESSAGE MASTER 07410CSR M CHAINMGFILE 54 07420CSR 54 MOVE BLK35 MGTEXT 07430CSR 54 MOVELM MGTEXT 07440CSR ENDSR 07450C****************************************************************** 07460CSR SR97 BEGSR ÐÐ07470C* UPDATE CRTFILE. 07480CSR PROG COMP 'Q003PX ' 55 07490CSR SETON 97 07500CSR EXCPT UPDATE CRTFILE 07510CSR SETOF 97 07520CSR ENDSR 07530C*********************************************************************** 07540CSR SR101 BEGSR 07550C* 1-TIME INITIALIZE 07560CSR MOVE BIT,1 NUL 07570CSR MOVELBIT,1 BUFLGT 2 READ BUFFER LGTH 07580CSR Z-ADD8 FLIMIT 30 TOTAL NUMB FIELDS 07590CSR MOVE ' ' BLK70 70 07600CSR MOVE ' ' BLK29 29 07610CSR MOVE ' ' BLK6 6 07620C* GET PORT # AND CRTFILE 07630CSR MOVE ' ' W8A 8 07640CSR Z-ADD0 W2N 20 07650CSR Z-ADD0 W1N 10 07660CSR MOVE ' ' W2A 2 07670CSR EXITFPGMINX GET PORT # 07680CSR RLABL W8A 07690CSR RLABL W2N 07700CSR RLABL W1N 07710CSR RLABL W2A ÐÐ07720CSR MOVE W2A PRRT 20 PRRT NO. 07730CSR PRRT COMP 0 54 07740CSRN54 Z-ADD25 PRRT DEFAULT 07750CSR PRRT CHAINCRTFILE H9 07760CSR H9 GOTO END101 PROG ERROR 07770CSR EXSR SR1 CLASSIFY TRAN CODE 07780CSR SETOF 96 07790CSR EXSR SR79 GET PURCH ORDER MAST 07800C* DEFINE WORK FIELDS,ETC. 07810CSR MOVE ' ' BLK8 8 07820CSR MOVE ' ' BLK35 35 07830CSR Z-ADDUDATE W6N 07840CSR EXSR SR207 REVERSE DATE 07850CSR Z-ADDW6N TODAY 60 CUR DATE(YR,MO,DAY) 07860CSR Z-ADD0 ZERO7 70 07870CSR Z-ADD0 ZERO6 60 07880CSR END101 ENDSR 07890C********************************************************************** 07900CSR SR102 BEGSR 07910C* VALIDATE FIELD NO. 07920CSR F COMP 0 54 07930CSRN54 Z-ADD1 F 07940CSR F COMP FLIMIT 55 07950CSR 55 Z-ADD1 F 07960CSR ENDSR ÐÐ07970C******************************************************************** 07980CSR SR103 BEGSR 07990C* MOVE INPUT DATA 08000CSR EXSR SR201 IDENTIFY-F 08010CSR EXSR SR202 R. JUSTIFY 08020CSR 02 Z-ADD0 PIQ INIT PRITEM ARRAYS 08030CSR 02 Z-ADD0 PID 08040CSR 02 Z-ADD0 RCD 08050CSR 02 Z-ADD0 OPN 08060CSR 01 MOVELW70A TRAN 1 TRAN CODE 08070CSR 02 MOVE W15A TITEM 30 PR ITEM # 08080CSR 03N95 EXSR SR212 BUILD ORD/ACNT 08090CSR 03 95 MOVELBLK6 PQWOP 08100CSR 03 95 Z-ADD0 PQWOD 08110CSR 03 MOVELPQWOP PQWO 08120CSR 03 MOVE PQWOD PQWO 08130CSR 04 70 MOVE W15A PQPN PART # 08140CSR 05 70 MOVELW70A PQVPN VENDOR PART # 08150CSR 06 70 MOVELW70A PQDESC DESCRIPTION 08160CSR 06N70 MOVELW70A PQNDES NON-INV DESC 08170CSR 07 MOVELW70A PQLOT LOT CODE 08180CSR 08 MOVE W15A PQ$PRC COST 08190CSR MOVE ' ' DUN,F 08200CSR ENDSR 08210C******************************************************************** ÐÐ08220CSR SR104 BEGSR 08230C* EDIT INPUT DATA 08240CSR 01 EXSR SR1 08250CSR 02 EXSR SR2 08260CSR 03 EXSR SR3 08270CSR 04 EXSR SR4 08280CSR 07 EXSR SR7 08290CSR 08 EXSR SR8 08300CSR 96 MOVE ' ' DUN,F EDIT FLAG 08310CSRN96 MOVE 'X' DUN,F 08320CSR ENDSR 08330C*********************************************************************** 08340CSR SR105 BEGSR 08350C* FINAL EDIT 08360CSR SETOF 77 08370CSR SETON 79 FINAL EDIT FLAG 08380CSR Z-ADD1 F 96 08390C*-------------------------------------------------------------------- 08400CSR T105A TAG 08410CSR ' ' LOKUPDUN,F 54 UN-EDITED FIELD 08420CSRN54 GOTO END105 08430CSR TRAN COMP 'D' 54 08440CSR 54 F COMP 6 54 08450CSR 54 GOTO END105 DELETE TRAN 08460CSR EXSR SR201 IDENTIFY-F ÐÐ08470CSR EXSR SR104 EDIT 08480CSRN96 GOTO T105A 08490C*-------------------------------------------------------------------- 08500CSR END105 TAG 08510CSR SETOF 79 08520CSR ENDSR 08530C******************************************************************** 08540CSR SR106 BEGSR 08550C* UPDATE DATA BASE. 08560CSR EXSR SR203 CLASSIFY TRAN 08570CSR 64 SETON 61 08580CSR 60 GOTO T106A ADD TRAN 08590CSR 61 GOTO T106D CHANGE TRAN 08600CSR 62 GOTO T106F DELETE TRAN 08610C* FLAG BAD TRAN CODE 08620CSR Z-ADD300 M 96 FLAG ERROR 08630CSR Z-ADD1 F FIELD # 08640CSR GOTO END106 08650C*------------------------------------------------------------------- 08660CSR T106A TAG 08670C* ADD TRANSACTION 08680CSR 30 GOTO T106B PRITEM NOT ON FILE 08690CSR 31 GOTO T106C DELETED MASTER 08700C* FLAG DUPLICATE ADD ERROR 08710CSR Z-ADD301 M 96 FLAG ERROR ÐÐ08720CSR Z-ADD1 F FIELD # 08730CSR GOTO END106 08740C*--------------------------------------------------------------------- 08750CSR T106B TAG 08760C* ADD-- MAST NOT ON FILE 08770CSR MOVE 'A' PQSTAT 08780CSR EXSR SR81 ADD NEW MASTER 08790CSR GOTO T106U 08800C*--------------------------------------------------------------------- 08810CSR T106C TAG 08820C* ADD-- MAST IS DELETED 08830CSR MOVE 'A' PQSTAT RECORD STATUS 08840CSR EXSR SR82 REWRITE MAST 08850CSR GOTO T106U 08860C*---------------------------------------------------------------------- 08870CSR T106D TAG 08880C* CHANGE TRANSACTION. 08890CSRN30N31 GOTO T106E ACTIVE PRITEM 08900C* FLAG NO MASTER ERROR 08910CSR Z-ADD302 M 96 FLAG ERROR 08920CSR Z-ADD1 F FIELD # 08930CSR GOTO END106 08940C*----------------------------------------------------------------------- 08950CSR T106E TAG 08960C* REWRITE MASTER - CHANGE ÐÐ08970CSR EXSR SR82 REWRITE MAST 08980CSR GOTO T106U 08990C*----------------------------------------------------------------------- 09000CSR T106F TAG 09010C* DELETE TRANSACTION 09020CSRN30N31 GOTO T106G ACTIVE PRITEM 09030C* FLAG NO MASTER ERROR 09040CSR Z-ADD302 M 96 FLAG ERROR 09050CSR Z-ADD1 F FIELD # 09060CSR GOTO END106 09070C*----------------------------------------------------------------------- 09080CSR T106G TAG 09090C* CHECK FOR ACTIVITY. 09100CSR PQQRCD COMP 0 54 09110CSR 54 Z-ADD29 M 96 FLAG ERROR 09120CSR 54 GOTO END106 09130C* DELETE MASTER. 09140CSR MOVE 'D' PQSTAT RECORD STATUS 09150CSR EXSR SR82 REWRITE MASTER 09160C*--------------------------------------------------------------------- 09170CSR T106U TAG 09180CSR 70 EXSR SR85 UPDATE PMMST2 09190CSR EXSR SR86 UPDATE PRMAST 09200CSR END106 ENDSR 09210C************************************************************************ ÐÐ09220CSR SR201 BEGSR 09230C* IDENTIFY FIELD NO. 09240CSR F COMP 1 01 09250CSR F COMP 2 02 09260CSR F COMP 3 03 09270CSR F COMP 4 04 09280CSR F COMP 5 05 09290CSR F COMP 6 06 09300CSR F COMP 7 07 09310CSR F COMP 8 08 09320CSR ENDSR 09330C********************************************************************** 09340CSR SR202 BEGSR 09350C* RIGHT JUSTIFY 09360CSR 41 GOTO T202A SCHED INPUT 09370CSR F LOKUPNUM 54 09380CSRN54 GOTO END202 NOT NUMERIC FIELD 09390C*------------------------------------------------------------------- 09400CSR T202A TAG 09410CSR Z-ADD15 W2N 20 09420CSRN41 MOVELW70A W15A 15 09430CSR EXIT SUBRAJ R. JUSTIFY 09440CSR RLABL W2N 09450CSR RLABL W15A 09460CSR END202 ENDSR ÐÐ09470C*********************************************************************** 09480CSR SR203 BEGSR 09490C* CLASSIFY TRAN CODE 09500CSR TRAN COMP 'A' 60 ADD 09510CSR TRAN COMP 'C' 61 CHANGE 09520CSR TRAN COMP 'D' 62 DELETE 09530CSR TRAN COMP 'T' 63 TEXT ONLY 09540CSR TRAN COMP 'S' 64 SCHED CHG ONLY 09550CSR TRAN COMP 'L' 65 LIST TRAN 09560CSR MOVE BLK35 TRNNAM 8 09570CSR 60 MOVEL'ADD' TRNNAM 09580CSR 61 MOVEL'CHANGE' TRNNAM 09590CSR 62 MOVEL'DELETE' TRNNAM 09600CSR 63 MOVEL'TEXT' TRNNAM 09610CSR 64 MOVEL'SCHEDULE'TRNNAM 09620CSR 65 MOVEL'LIST' TRNNAM 09630CSR ENDSR 09640C******************************************************************** 09650CSR SR204 BEGSR 09660C* CLASSIFY ACCOUNT. 09670CSR PQWOP COMP ' 14100' 70 09680CSRN70 PQWOP COMP ' 12100' 70 09690CSRN70 PQWOP COMP ' 14600' 70 09700CSRN70 Z-ADD0 PQPN 09710CSRN70 MOVE BLK35 PQVPN ÐÐ09720CSR 70 MOVE BLK70 PQNDES 09730CSR ENDSR 09740C******************************************************************** 09750CSR SR205 BEGSR 09760C* INIT POITEM MAST. 09770CSR Z-ADD0 PQPR 09780CSR Z-ADD0 PQPN 09790CSR MOVE BLK35 PQVPN 09820CSR Z-ADD0 PQDLR 09830CSR Z-ADD0 PQQRCD 09840CSR Z-ADD0 PQQSTK 09850CSR MOVE ' ' PQLOT 09860CSR Z-ADD0 PQ$PRC 09870CSR MOVE BLK35 PQWO 09880CSR Z-ADD0 PQVEND 09890CSR Z-ADD0 PQLLOG 09900CSR Z-ADD0 PID 09910CSR Z-ADD0 PIQ 09920CSR MOVE ' ' PQSTAT 09930CSR Z-ADD0 RCD 09940CSR Z-ADD0 OPN 09941CSR Z-ADD0 BD 09942CSR Z-ADD0 BQ 09950CSR MOVE BLK29 PMDESC 09960CSR SETOF 40 ÐÐ09970CSR ENDSR 09980C******************************************************************** 09990CSR SR207 BEGSR 10000C* REVERSE DATE FIELDS 10010CSR MOVELW6N W2N 20 10020CSR W2N COMP 12 54 10030CSR 54 GOTO T207B 10040CSR MOVELW6N W4N 40 10050CSR MOVE W6N W2N 10060CSR MOVELW2N W6N 10070CSR MOVE W4N W6N 10080C*------------------------------------------------------------------- 10090CSR T207B TAG 10100CSR MOVEL'C' W7A 7 10110CSR MOVE W6N W7A 10120CSR EXSR SR84 GET CALENDAR 10130CSR END207 ENDSR 10140C******************************************************************** 10150CSR SR212 BEGSR 10160C* BUILD WORK ORDER # 10170CSR MOVEAW70A A70 10180CSR Z-ADD1 W 10190CSR '-' LOKUPA70,W 54 10200CSRN54 Z-ADD7 W 10210CSR MOVEAA70,W W4A 4 ÐÐ10220CSR 54 MOVEL' ' W4A 10230CSR Z-ADD4 W2N 10240CSR EXIT SUBRAJ RJ 10250CSR RLABL W2N 10260CSR RLABL W4A 10270CSR MOVE W4A PQWOD 30 WORK ORDER DASH 10280CSR MOVEABLK70 A70,W 10290CSR A70,1 COMP '0' 54 54 10300CSR 54 MOVEAA70,1 W5A 10310CSR 54 MOVEL' ' PQWOP 10320CSRN54 MOVEAA70 PQWOP 6 10330CSRN54 MOVE PQWOP W5A 5 10340CSR Z-ADD5 W2N 10350CSR EXIT SUBRAJ RJ 10360CSR RLABL W2N 10370CSR RLABL W5A 10380CSR MOVE W5A PQWOP WORK ORDER PRIME 10390CSR EXSR SR204 CLASSIFY WO 10400CSR ENDSR 10410C******************************************************************** 10420CSR SR250 BEGSR 10430C* UPDATE SCHEDULE. 10440CSR SETOF 878990 10450CSR Z-ADDPIQ BQ 10460CSR Z-ADDPID BD ÐÐ10470CSR EXSR SR203 CLASSIFY TRAN 10480CSR 62 Z-ADD0 PIQ DELETE TRAN 10490CSR 62 Z-ADD0 PID 10500CSR 62 GOTO T250K 10510CSRN40 EXSR SR252 ALLOC RCPTS 10520CSRN40 EXSR SR253 DISPLAY SCHED 10530C*------------------------------------------------------------------- 10540CSR T250A TAG 10550C* REQUEST DATE,QTY. 10560CSR SETOF 96 10570CSR SETOF 908789 10580CSR SETON 4146 10590CSR EXCPT PROMPT 10600CSR SETOF 46 10610CSR EXSR SR75 READ 10620CSR 89 GOTO T250A HELP REQUEST 10630CSR 87 GOTO T250K DONE REQUEST 10640CSR 90 GOTO T250K ESC OTHER 10650CSR MOVEAW70A A70 10660CSR Z-ADD1 S 10670CSR ',' LOKUPA70,S 54 10680CSR 54 GOTO T250B 10690C* COMMA MISSING - FLAG INVALID DATE, ETC. 10700CSR Z-ADD615 M 96 FLAG ERROR 10710CSR EXSR SR74 PUT MSG ÐÐ10720CSR GOTO T250A 10730C*------------------------------------------------------------------- 10740CSR T250B TAG 10750C* ISOLATE DATE,QTY. CHECK DATE TO CALENDAR FILE 10760CSR MOVE BLK35 W15A 10770CSR MOVEAA70,S W15A 10780CSR MOVEABLK70 A70,S 10790CSR EXSR SR202 R.J. 10800CSR MOVE W15A TQTY 70 SCHED QTY 10810CSR MOVEAA70,1 W15A 10820CSR EXSR SR202 R.J. 10830CSR MOVE W15A TDATE 60 SCHED DATE 10840CSR Z-ADDTDATE W6N 60 10850CSR EXSR SR207 EDIT DATE 10860CSR Z-ADDW6N TDATE 10870CSR 60 Z-ADD390 M 96 FLAG ERROR 10880CSR 60 EXSR SR74 PUT MSG 10890CSR 60 GOTO T250A 10900CSR Z-ADD1 S 30 10910C*------------------------------------------------------------------- 10920CSR T250E TAG 10930C* MATCH DATE TO SCHEDULE 10940CSR TDATE LOKUPPID,S 54 FIND EXISING DATE 10950CSRN54 Z-ADD1 S 10960CSRN54 ZERO6 LOKUPPID,S 55 FIND EMPTY BUCKET ÐÐ10970CSR 55 10980COR 54 GOTO T250G 10990CSR Z-ADD616 M 96 FLAG ERROR 11000CSR EXSR SR74 PUT MSG 11010CSR GOTO T250A 11020C*------------------------------------------------------------------- 11030CSR T250G TAG 11040CSR Z-ADDTDATE PID,S UPDATE DATE 11050CSR Z-ADDTQTY PIQ,S 54 UPDATE QTY 11060CSRN54 Z-ADD0 PIQ,S 11070CSRN54 Z-ADD0 PID,S 11080CSR Z-ADD0 RCD,S 11090CSR Z-ADD0 OPN,S 11100CSR MOVE 'X' UP,S 11110CSR EXSR SR76 PUT UPDATED SCHED 11120CSR GOTO T250A 11130C*------------------------------------------------------------------- 11140CSR T250K TAG 11150C* SORT/DISPLAY UPDATED SCHEDULE 11160CSR SETOF 41 11170CSR EXSR SR251 SORT SCHED 11180CSR EXSR SR252 APPLY RCPTS TO SCHED 11190CSR EXSR SR253 DISPLAY 11200CSR 87 GOTO T250A ESC-D 11210C*------------------------------------------------------------------- ÐÐ11220CSR END250 TAG 11230CSR SETOF 4187 11270CSR MOVE BLK35 MGTEXT 11280CSR ENDSR 11290C******************************************************************** 11300CSR SR251 BEGSR 11310C* SORT POITEM SCHEDULE. 11320CSR Z-ADD0 A 30 11330CSR SETOF 40 11340C*------------------------------------------------------------------- 11350CSR T251B TAG 11360CSR 1 ADD A A 11370CSR A COMP 26 54 11380CSR 54 GOTO END251 11390CSR PID,A COMP 0 54 11400CSR 54 GOTO T251E 11410CSR Z-ADDA B 30 11420CSR ZERO6 LOKUPPID,B 54 11430CSRN54 GOTO END251 11440CSR Z-ADDPID,B PID,A 11450CSR Z-ADDPIQ,B PIQ,A 11460CSR Z-ADD0 PID,B 11470CSR Z-ADD0 PIQ,B 11480C*------------------------------------------------------------------- 11490CSR T251E TAG ÐÐ11500CSR Z-ADDA B 11510C*------------------------------------------------------------------- 11520CSR T251G TAG 11530CSR B COMP 26 54 11540CSR 54 GOTO T251B 11550CSR ZERO6 LOKUPPID,B 54 11560CSRN54 GOTO T251B 11570CSR PID,A COMP PID,B 54 11580CSRN54 1 ADD B B 11590CSRN54 GOTO T251G 11600CSR Z-ADDPID,A SAVDAT 60 11610CSR Z-ADDPIQ,A SAVQTY 70 11620CSR Z-ADDPID,B PID,A 11630CSR Z-ADDPIQ,B PIQ,A 11640CSR Z-ADDSAVDAT PID,B 11650CSR Z-ADDSAVQTY PIQ,B 11660CSR 1 ADD B B 11670CSR GOTO T251G 11680CSR END251 ENDSR 11690C******************************************************************** 11700CSR SR252 BEGSR 11710C* APPLY RCPTS TO SCHEDULE. 11720CSR MOVE ' ' UP 11730CSR Z-ADD0 RCD 11740CSR Z-ADD1 A ÐÐ11750CSR Z-ADDPIQRCD SAVQTY 70 11760C*------------------------------------------------------------------- 11770CSR T252A TAG 11780CSR ZERO7 LOKUPPIQ,A 54 11790CSRN54 GOTO T252C 11800CSR Z-ADDPIQ,A W7N 70 11810CSR SETOF 57 11820CSR SAVQTY COMP W7N 545556 11830CSR 54 Z-ADDW7N RCD,A 11840CSR 54 SAVQTY SUB W7N SAVQTY 57 11850CSR 54 Z-ADD0 W7N 11860CSR 55 Z-ADDSAVQTY RCD,A 11870CSR 55 W7N SUB SAVQTY W7N 11880CSR 55 Z-ADD0 SAVQTY 57 11890CSR 56 Z-ADDSAVQTY RCD,A 11900CSR 56 Z-ADD0 SAVQTY 57 11910CSR 56 Z-ADD0 W7N 11920CSR 57 1 ADD A A 11930CSR 57 A COMP 26 54 11940CSR 57 GOTO T252A 11950CSR GOTO END252 11960C*------------------------------------------------------------------- 11970CSR T252C TAG 11980CSR Z-ADD1 A 11990CSR ZERO7 LOKUPPIQ,A 54 ÐÐ12000CSR 54 Z-ADDSAVQTY RCD,A 12010CSR END252 ENDSR 12020C******************************************************************** 12030CSR SR253 BEGSR 12040C* DISPLAY SCHEDULE. 12050CSR Z-ADD0 S 12060CSR PIQ SUB RCD OPN OPEN PR QTYS 12070C* PUT SCHEDULE HEADING. 12080CSR 40 GOTO T253A 12090CSR MOVE '104001' W6A 12100CSR EXSR SR69 MOVE CURSOR 12110CSR SETON 7540 12120CSR EXCPT PUT SCHED HEADING 12130CSR SETOF 75 12140C*------------------------------------------------------------------- 12150CSR T253A TAG 12160CSR 1 ADD S S 12170CSR S COMP 13 54 12180CSR 54 GOTO T253C 12190CSR PIQ,S COMP 0 54 12200CSRN54 RCD,S COMP 0 54 12210CSRN54 13 ADD S Y 30 12220CSRN54 PIQ,Y COMP 0 54 12230CSRN54 RCD,Y COMP 0 54 12240CSRN54 GOTO T253A ÐÐ12250CSR EXSR SR76 PUT SCHEDULE 12260CSR GOTO T253A 12270C*------------------------------------------------------------------- 12280CSR T253C TAG 12290C* PUT TOTALS. 12300CSR EXSR SR47 CLEAR SCREEN 12310CSR XFOOTPIQ TOTPIQ 80 12320CSR XFOOTRCD TOTRCD 80 12330CSR TOTPIQ SUB TOTRCD TOTOPN 80 12340CSR SETON 74 12350CSR EXCPT PUT TOTALS 12360CSR SETOF 74 12370CSR ENDSR 12380C****************************************************************** 12390CSR SR300 BEGSR 12400C* UPDATE SFMAST 12410CSRN70 GOTO END300 12420CSR MOVELCRVNAM VEND20 20 VENDOR NAME 12430CSR Z-ADD1 S 12440CSR MOVE 'D' STAT 1 12450C*--------------------------------------------------------------- 12460CSR T300B TAG 12470CSR ZERO7 LOKUPBQ,S 54 12480CSRN54 GOTO T300E 12490CSR MOVE BD,S DUEDAT 6 ÐÐ12500CSR Z-ADDBQ,S DUEQTY 70 12510CSR Z-ADD0 QTYRCD 70 RECORD STATUS 12520CSR EXSR SR400 UPDATE SFMAST 12530CSR Z-ADD0 BD,S 12540CSR Z-ADD0 BQ,S 12550CSR GOTO T300B 12560C*---------------------------------------------------------------- 12570CSR T300E TAG 12580CSR Z-ADD1 S 12590CSR MOVE 'A' STAT 12600C*------------------------------------------------------------------- 12610CSR T300G TAG 12620CSR ZERO7 LOKUPPIQ,S 54 12630CSRN54 GOTO END300 12640CSR Z-ADDPIQ,S DUEQTY 12650CSR MOVE PID,S DUEDAT 12660CSR Z-ADDRCD,S QTYRCD 12670CSR EXSR SR400 UPDATE SFMAST 12680CSR 1 ADD S S 12690CSR S COMP 26 54 12700CSRN54 GOTO T300G 12710CSR END300 ENDSR 12720C******************************************************************* 12730CSR SR400 BEGSR 12740C* UPDATE SFMAST/ALTKEY (SEE SR300) ÐÐ12750CSR MOVELPQPN W10A 10 12760CSR MOVEAW10A A70,1 12770CSR MOVEADUEDAT A70,11 12780CSR MOVEA'30' A70,17 12790CSR MOVEACRPR A70,19 12800CSR MOVE TITEM W3A 3 12810CSR MOVEAW3A A70,25 12820CSR MOVEA'00' A70,28 12830CSR MOVEAA70 W29A 29 12840CSR W29A CHAINSFMAST 60 12850CSR 60 STAT COMP 'D' 54 12860CSR 60 54 GOTO T400B 12870CSR SETON 83 12880CSR EXCPT UPDATE SFMAST 12890CSR SETOF 83 12900C*------------------------------------------------------------------ 12910CSR T400B TAG 12920CSR MOVEA'B3' A70,1 12930CSR MOVEADUEDAT A70,3 12940CSR MOVEACRPR A70,9 12950CSR MOVEAW3A A70,15 12960CSR MOVEA'00' A70,18 12970CSR MOVEAW10A A70,20 12980CSR MOVEAA70 W29A 12990CSR W29A CHAINALTKEY 60 ÐÐ13000CSR 60 STAT COMP 'D' 54 13010CSR 60 54 GOTO END400 13020CSR SETON 84 13030CSR EXCPT UPDATE AK-DUE 13040CSR SETOF 84 13050CSR END400 ENDSR 13060O************************************************************** 13070OTERM132 E 71 13080O* PUT HEADINGS 13090O BIT,28 1 13100O 8 '8091001' 13110O 77 'PURCHASE ORDER' 13120O 88 'ITEM INPUT' 13130O UDATE Y 16 13140O*------------------------------------------------------------------- 13150O E 71 13160O 1 ' ' 13170O*------------------------------------------------------------------- 13180O E 71 13190O OR 72 01 13200O DOT 26 13210O 4 '(1)' 13220O 15 'TRAN CODE' 13230O TRAN 31 13240O TRNNAM 46 ÐÐ13250O MGTEXT 132 13260O*------------------------------------------------------------------- 13270O E 71 13280O OR 72 02 13290O DOT 26 13300O 4 '(2)' 13310O 17 'ITEM NUMBER' 13320O TITEM Z 31 13330O MGTEXT 132 13340O*------------------------------------------------------------------- 13350O E 71 13360O OR 72 03 13370O DOT 26 13380O 4 '(3)' 13390O 21 'ORDER/ACCOUNT #' 13400O PQWOP 34 13410O 55 35 '-' 13420O 55 PQWOD 38 13430O PJNAME 80 13440O MGTEXT 132 13450O*------------------------------------------------------------------- 13460O E 71 13470O OR 72 04 70 13480O DOT 26 13490O 4 '(4)' ÐÐ13500O 12 'PART #' 13510O PQPN 40 ' - - ' 13520O PMDESC 71 13530O MGTEXT 132 13540O*------------------------------------------------------------------- 13550O E 71 13560O OR 72 05 70 13570O DOT 26 13580O 4 '(5)' 13590O 19 'VENDOR PART #' 13600O PQVPN 43 13610O MGTEXT 132 13620O*------------------------------------------------------------------- 13630O E 71 13640O OR 72 06 13650O DOT 26 13660O 4 '(6)' 13670O 22 'ITEM DESCRIPTION' 13680O 70 PQDESC 57 13690O N70 PQNDES 98 13700O 69 28 '[' 13710O 69 70 58 ']' 13720O 69N70 99 ']' 13730O MGTEXT 132 13740O*------------------------------------------------------------------- ÐÐ13750O E 71 13760O OR 72 07 13770O DOT 26 13780O 4 '(7)' 13790O 22 'PRICE-CODE (L,N)' 13800O PQLOT 29 13810O LOTNAM 44 13820O MGTEXT 132 13830O*------------------------------------------------------------------- 13840O E 71 13850O OR 72 08 13860O DOT 26 13870O 4 '(8)' 13880O 11 'PRICE' 13890O PQ$PRC2 41 13900O 56 'STD. COST =' 13910O PMTCST2 69 13920O MGTEXT 132 13930O*-------------------------------------------------------------- 13940O E 71 13950O 12 'QTY RECEIVED' 13960O 26 ':' 13970O PQQRCD2 37 13980O*------------------------------------------------------------------- 13990O E 71 ÐÐ14000O 76 'SCHEDULE DATES & QTYS' 14010O*----------------------------------------------------------------- 14020O E 75 14030O* SCHEDULE HEADING 14040O 8 'DUE-DATE' 14050O 19 'SCHED-QTY' 14060O 30 'QTY-RECVD' 14070O 41 'QTY-OPEN' 14080O 62 'DUE-DATE' 14090O 73 'SCHED-QTY' 14100O 85 'QTY-RECVD' 14110O 95 'QTY-OPEN' 14120O*-------------------------------------------------------------- 14130O E 76 14140O* PUT SCHEDULE DATA 14150O PID,A 8 ' - - ' 14160O PIQ,A 2 19 14170O RCD,A 2 30 14180O 42 41 30 'XXXXXXXXX' 14190O OPN,A K 41 14200O 42 41 41 'XXXXXXXXX' 14210O PID,B 62 ' - - ' 14220O PIQ,B 2 73 14230O RCD,B 2 85 14240O 43 41 85 'XXXXXXXXX' ÐÐ14250O OPN,B K 96 14260O 43 41 96 'XXXXXXXXXX' 14270O*--------------------------------------------------------------------- 14280O E 46 14290O NUL 132 14300O BIT,28 1 14310O 8 '8103001' 14320O 100 ' (9) ENTER DATE,QTY:' 14330O BLK29 131 14340O*-------------------------------------------------------------------- 14350O E 73 14360O* PUT MESSAGE. 14370O NUL 132 14380O BIT,28 1 14390O 41 8 '8104001' 14400O N41 2 '8' 14410O N41 LOC 5 14420O N41 8 '098' 14430O MGTEXT 43 14440O 96 BIT,8 132 14450O*------------------------------------------------------------------- 14460O E 49 14470O* INIT SCHED ERR MSG. 14480O NUL 132 14490O BIT,28 1 ÐÐ14500O 8 '8104001' 14510O BLK35 43 14520O BLK35 78 14530O*------------------------------------------------------------------- 14540O E 74 14550O* PUT SCHED TOTALS. 14560O NUL 132 14570O BIT,28 1 14580O 8 '8120056' 14590O 16 'TOTALS ' 14600O TOTPIQ2 26 14610O 27 ' ' 14620O TOTRCD2 37 14630O 38 ' ' 14640O TOTOPNK 49 14650O BIT,28 131 14660O 132 'K' 14670O*------------------------------------------------------------------- 14680O E 48 14690O BIT,28 1 14700O 8 '8102001' 14710O 21 'ITEM UPDATED.' 14720O*------------------------------------------------------------------- 14730O E 48 14740O 24 'ENTER \G, \E, \N, \L, \T' ÐÐ14750O 48 ', OR RETURN TO CONTINUE.' 14760O*------------------------------------------------------------------- 14770O E 97 55 14780O BIT,28 1 14790O 8 '8104001' 14800O 24 'LOADING TEXT-PLEASE WAIT' 14810O*------------------------------------------------------------------- 14820O E 45 14830O* HELP. 14840O NUL 132 14850O BIT,28 1 14860O 8 '8104001' 14870O 32 'ENTER [DATE,QTY], OR [\D' 14880O 56 ', \U, \E, \N, OR \G] ' 14890O*------------------------------------------------------------------- 14900O E 78 14910O* HELP MESSAGES. 14920O NUL 132 14930O BIT,28 1 14940O 8 '8104001' 14950O E 78 14960O 16 'A = ADD NEW ITEM' 14970O E 78 14980O 24 'C = CHANGE EXISTING ITEM' 14990O E 78 ÐÐ15000O 24 'D = DELETE EXISTING ITEM' 15010O E 78 15020O 20 'L = LIST SALES ORDER' 15030O E 78 15040O 24 'S = SCHEDULE ONLY UPDATE' 15050O E 78 15060O 15 'T = TEXT UPDATE' 15070O*------------------------------------------------------------------- 15080O E 47 15090O NUL 132 15100O BIT,28 1 15110O 2 'I' 15120O******************************************************************** 15130OPOITEM EADD 81 15140O CRPR 6 15150O TITEM 9 15160O PQPN 19 15170O PQVPN 34 15180O 70 PQDESC 63 15190O N70 PQNDES 79 15200O PQDLR 85 15210O PQQRCD 89P 15220O PQQSTK 93P 15230O PQLOT 94 15240O PQ$PRC 99P ÐÐ15250O PQWO 108 15260O PRVEND 111P 15270O 113 '00' 15280O PID 269 15290O PIQ 373P 15300O 384 'A' 15310O*-------------------------------------------------------------------- 15320O E 82 15330O PQPN 19 15340O PQVPN 34 15350O 70 PQDESC 63 15360O N70 PQNDES 79 15370O PQDLR 85 15380O PQQRCD 89P 15390O PQQSTK 93P 15400O PQLOT 94 15410O PQ$PRC 99P 15420O PQWO 108 15430O PRVEND 111P 15440O PQLLOG 113 15450O PID 269 15460O PIQ 373P 15470O PQSTAT 384 15480O******************************************************************** 15490OSFPNA EADD 81 ÐÐ15500O OR 82 15510O PQPN 10 15520O******************************************************************* 15530OPMMST2 E 85 15540O PLT 128P 15550O PMOHB 314P 15560O PMPRB 346P 15570O PMTCST 619P 15580O******************************************************************** 15590OPRMAST E 86 15600O PRLITM 119P 15610O***************************************************************** 15620OCRTFILE E 97 15630O CRRET 73 15640O TITEM 90 15650O***************************************************************** 15660OSFMAST EADD 83 60 15670O W29A 29 15680O DUEQTY 33P 15690O QTYRCD 37P 15700O TODAY 43 15710O PRVEND 46P 15720O PMECHG 66 15730O VEND20 90 15740O PQ$PRC 95P ÐÐ15750O PQLOT 105 15760O 128 'A' 15770O*------------------------------------------------------------------ 15780O E 83N60 15790O DUEQTY 33P 15800O QTYRCD 37P 15810O TODAY 43 15820O PRVEND 46P 15830O PMECHG 66 15840O VEND20 90 15850O PQ$PRC 95P 15860O PQLOT 105 15870O STAT 128 15880O***************************************************************** 15890OALTKEY EADD 84 60 15900O W29A 29 15910O 32 'A' 15920O*----------------------------------------------------------------- 15930O E 84N60 15940O STAT 32 15950O****************************************************************** ** NUL ARRAY 015960 015970** A9 ARRAY 15980 15990ÐÐ** A70 ARRAY 016000 016010** NUM ARRAY 016020002 ITEM 016030004 PART NO 016040008 UNIT COST 016050** DUN ARRAY 016060 016070** DOT ARRAY 016080 - - - - - - - - - -> 016090** RCD ARRAY 16100 16110** OPN ARRAY 16120 16130** UP ARRAY 16140 16150** LN ARRAY 16160LOT PRICE 16170NO CHARGE 16180UNIT PRICE 16190** BQ ARRAY 16200 16210** BD ARRAY 16220 16230** NAM ARRAY 16240ÐÐPROD WORK ORDER 16250/* 016260_‚ ÐÐ_‚_‚ WORK ORDER 16250/* 016260_‚ ÐÈ(2Wz 2X007WM P999999120282(èÈÐ00010H Q007WM00020F* GENERATE WMLUWO FILE. (X007WM) 00030F* REVISED 8-20-81 11:15 AM. 00040FBITTAB IP F 33 DISK 00050FWMPREFIXIT F 80 EDISK 00060FWMLUWO O F 8 2AI 1 DISK 00070E******************************************************************** 00080E WMPREFIX PX 1 50 1 00090E BIT 33 1 00100I******************************************************************** 00110IBITTAB BT 00120I 1 33 BIT 00130C******************************************************************** 00140C Z-ADD0 ZERO5 50 00150C Z-ADD0 X 30 00160C*------------------------------------------------------------------- 00170C START TAG 00180C 1 ADD X X 00190C X COMP 50 54 00200C 54 GOTO END 00210C PX,X COMP ' ' 54 00220C N54 GOTO START 00230C SETON 80 00240C EXCPT 00250C SETOF 80 ÐÐ00260C GOTO START 00270C*------------------------------------------------------------------- 00280C END TAG 00290O******************************************************************** 00300OWMLUWO E 80 00310O PX,X 1 00320O ZERO5 7 /* 00330_‚ ÐÐ_‚_‚0C GOTO START 00270C*------------------------------------------------------------------- 00280C END TAG 00290O******************************************************************** 00300OWMLUWO E 80 00310O PX,X 1 00320O ZERO5 7 /* 00330_‚ ÐÈ(èW è¡X214SF P120282120282(èÈÐ00010H Q214SF00020F* EXPLODE PLANNED WORK ORDERS/REQUIREMENTS (X214SF) 00030F* REV 5/04/81 1:55 PM. 00040FSFEXCONTUP F 16 DISK 00050FSFLOWLEVUD F 13L12AI 1 DISK 00060FCALENDARIC F 22R 7AI 1 DISK 00070FORDERLOGUC F 32R13AI 1 DISK A 00080FSFMAST ID F 128L29AI 1 DISK 00090FNEWSFREQO F 128 DISK 00100FBMMAST ID F 86L20AI 1 DISK 00110FPMMST2 IC F 674R12AI 1 DISK 00120FTERMO O F 20 5 00130E******************************************************************** 00140E LEV 1 20 20 00150E QTY 1 20 7 0 00160E CAL 1 150 4 0A 00170E XPQ 1 150 7 0A 00180E WMM 1 6 7 0 00190E WON 1 150 6 00200E PLT 8 3 0 00210E PHZ 5 3 0 00220E PMM 6 7 0 00230I******************************************************************* 00240ISFEXCONTSC 32 00250I 1 20SCPASS ÐÐ00260I 5 16 SCSTRT 00270I********************************************************************* 00280ISFLOWLEVSL 30 13NCD 00290I* LOW LEVEL CODE 00300I 1 20SLLL 00310I* PART NO. 00320I 3 120SLPN 00330I 1 12 SLKEY 00340I GG 31 00350I******************************************************************** 00360IORDERLOGOL 00370I 1 2 OLREC 00380I 3 11 OLORD 00390I 14 23 OLPN 00400I 24 29 OLDUE 00410I 30 30 OLTYPE 00420I 32 32 OLSTAT 00430I***************************************************************** 00440IPMMST2 PM 00450I 1 100PMPN 00460I P 13 140PMNOBM 00470I 19 30 PMMODL 00480I 31 59 PMDESC 00490I 70 71 PMECHG 00500I 94 95 PMSC ÐÐ00510I* LEAD TIMES 8 X 3P 00520I P 113 128 PLT 00530I* ORDER POLICY CODES. 00540I* HORIZON M-DAYS 3P X 5 00550I* 1 = SALES ORDERS 00560I* 2 = PROD REQMTS-REL 00570I* 3 = PROD REQMTS-PLAN 00580I* 4 = FORECAST 00590I* 5 = SAFETY STOCK 00600I P 129 138 PHZ 00610I* MIN/MAX CODES. 00620I* ARRAY 7P X 6 00630I* 1 = MIN ORDER SPAN 00640I* 2 = MIN ORDER QTY 00650I* 3 = MIN ORDER $ 00660I* 4 = MAX ORDER SPAN 00670I* 5 = MAX ORDER QTY 00680I* 6 = MAX STOCK $ 00690I P 139 162 PMM 00700I* MINIMUM STOCK QTY (SAFETY STOCK) 7P 00710I P 163 1660PMSSTK 00720I* ROUNDING FACTOR 5P 00730I P 167 1690PMRNDF 00740I* EOQ CODE 2A 00750I 170 171 PMEOQ ÐÐ00760I* EOQ PARAMETER 2A 00770I 172 173 PMEOQP 00780I* EXCEPTION REPORT CRITERIA. 00790I* ALLOWABLE SURPLUS QTY 7P 00800I P 174 1770PMSQTY 00810I* ALLOWABLE SURPLUS % 5.2P 00820I P 178 1802PMSPCT 00830I* ALLOWABLE SURPLUS SPAN 3P 00840I P 181 1820PMSSP 00850I* ALLOWABLE SHORTAGE SPAN 3P 00860I P 183 1840PMSHSP 00870I* CURRENT BALANCES. 00880I* ON HAND STOCK 7P 00890I P 311 3140PMOHB 00900I* REQUIRED QTYS. 00910I* FORECAST BAL 7P 00920I P 315 3180PMFRCB 00930I* ALLOCATIONS 7P 00940I P 319 3220PMALB 00950I* REL REQS 7P 00960I P 323 3260PMRLB 00970I* SALES BACKLOG 7P 00980I P 327 3300PMSOB 00990I* QUOTES 7P 01000I P 331 3340PMQTB ÐÐ01010I* BACKORDERS 7P 01020I P 335 3380PMBOB 01030I* ON ORDER BALANCES. 01040I* PURCHASE REQS 7P 01050I P 339 3420PMPRB 01060I* PURCH ORDERS 7P 01070I P 343 3460PMPOB 01080I* RECD P.O. 7P 01090I P 347 3500PMRPOB 01100I* OPEN WORK ORDER 7P 01110I P 351 3540PMPWOB 01120I* REL WORK ORDER 7P 01130I P 355 3580PMRWOB 01140I P 615 6193PMTCST 01150I 674 674 PMSTAT 01160I******************************************************************** 01170IBMMAST BM 01180I* BILL OF MATERIAL RECORD 01190I* KEY AREA 01200I* ASSY PART NO. 10N 01210I 1 100BMAPN 01220I* COMPONENT PART # 10N 01230I 11 200BMCPN 01240I* ITEM NO. 3N 01250I 25 270BMITNO ÐÐ01260I* QTY PER ASSY 7P 01270I P 28 310BMQTY 01280I* SCRAP ALLOW .2N 01290I 34 352BMSCRP 01300I* ISSUE CODE 2A 01310I* PT = PULL TIME 01320I* OR = ON REQUEST 01330I* BI = BULK ISSUE 01340I* AR = AS REQUIRED 01350I* RA = REF ASSY 01360I* TD = TRAV DOC 01370I* SD = SHIP DOC 01380I* RD = REF DOC 01390I* VS = VENDOR SUPPLIED 01400I 36 37 BMISSU 01410I* EFFECTIVITY. 01420I* BEGIN CHANGE LEVEL 2A 01430I 38 39 BMBCHG 01440I* ENDING CHANGE LEVEL 2A 01450I 40 41 BMECHG 01460I* BEGIN ECN # 5A 01470I 42 46 BMBECN 01480I* ENDING ECN # 5A 01490I 47 51 BMEECN 01500I* DISPOSITION CODE 1A ÐÐ01510I* U = USE UP OLD STYLE 01520I* N = NOW (IMMEDIATE) 01530I 52 52 BMDISP 01540I* FILLER 5A 53 57 FFFFFF 01550I* ROUTING. 01560I* OPER NO. 5P 01570I P 58 600BMOPER 01580I* DEPT NO. 5P 01590I P 61 630BMDEPT 01600I* WORK CENTER NO. 3P 01610I P 64 650BMWC 01620I* COMPONENT OPER REFERENCE INFO 10A 01630I 66 75 BMREF 01640I* FILLER 10A 76 85 FFFFFF 01650I* 01660I* RECORD STATUS 1A 01670I* D = DELETED 01680I 86 86 BMSTAT 01690I******************************************************************** 01700ISFMAST SF 01710I* SCHEDULE MASTER. 01720I* COMMON FIELDS. 01730I* KEY AREA. 01740I 1 29 SFKEY 01750I* PART NO. 10N ÐÐ01760I 1 100SFPN 01770I* DATE DUE 6N (YMD) 01780I 11 160SFDUE 01790I* RECORD CODE 2N 01800I* 10 = RECEIVED PO 01810I* 20 = REL WO 01820I* 30 = PURCHASE ORDER 01830I* 40 = PLAN WO 01840I* 50 = PURCHASE REQ 01850I* 60 = SALES ORDER-BACKLOG 01860I* 70 = REL REQUIREMENT 01870I* 80 = PLAN REQUIREMENT 01880I* 90 = RUN RELEASE 01890I 17 180SFREC 01900I* ORDER NO. 01910I 19 29 SFORD 01920I* PREFIX 1A 01930I 19 19 SFPRFX 01940I* PRIME 6A 01950I 19 24 SFPRIM 01960I* ITEM 3N 01970I 25 270SFITEM 01980I* RECEIVING LOG # 2N 01990I 28 290SFRLOG 02000I* QUANTITY 7P ÐÐ02010I P 30 330SFQTY 02020I* QTY COMPLETE 7P 02030I P 34 370SFQTYC 02040I* DATE LAST TRAN 6N (YMD) 02050I 38 430SFDLT 02060I* CUST #/DEPT #/VEND # 3P 02070I P 44 460SFCUST 02080I* PLAN/REL REQMTS. 02090I* NEXT ASSY PART # 10N 02100I 47 560SFNAPN 02110I* QTY PER ASSY 7P 02120I P 57 600SFQPA 02130I* ISSUE CODE 2A 02140I 61 62 SFISSU 02150I* PULL # 3P 02160I P 63 640SFPULL 02170I* ASSY REVISION 2A 02180I 65 66 SFREV 02190I* ASSY WO QTY 7P 02200I P 67 700SFQTYA 02210I* BACKORDER FLAG 02220I 105 105 SFBOF 02230I* SALES ORDERS 02240I* CUST P.O. 20A 02250I 71 90 SFCPO ÐÐ02260I* UNIT PRICE 9.3P 02270I P 91 953SFPRIC 02280I* BACKORDER FLAG 1A -- SEE ABOVE 02290I* PURCH ORDERS 02300I* VENDOR NAME 20A 02310I* SEE SFCPO UNDER SALES ORDERS. 02320I* UNIT PRICE 9.3P 02330I* SEE SFPRIC UNDER SALES ORDERS. 02340I* WORK ORDERS 02350I* DEPT NAME 20A 02360I* SEE SFCPO UNDER SALES ORDERS. 02370I* OPER SEQ # 3P 02380I P 96 970SFSEQ 02390I* START DATE 6N 02400I 98 1030SFSTRT 02410I* PULL # 3P 02420I* SEE PLAN/REL REQMTS. 02430I* REQUIREMENT FLAG 1A 02440I 104 104 SFRFLG 02450I* REVISION 2A 02460I* SEE PLAN/REL REQMTS. 02470I* AVAIL STOCK BAL 79 02480I P 120 1230SFSAVQ 02490I* AVAIL QTY 7P 02500I P 124 1270SFAVQ ÐÐ02510I* RECORD STATUS 1A 02520I 128 128 SFSTAT 02530I******************************************************************** 02540ICALENDARCA 20 1 CC 02550I* CALENDAR DATE RECORD. 02560I 2 30CAYR 02570I 4 50CAMO 02580I 6 70CADAY 02590I 2 70CACAL 02600I 14 170CAMDAY 02610I 18 200CAWK 02620I 21 220CADOW 02630I*------------------------------------------------------------------- 02640I CB 21 1 CM 02650I* MFG DATE RECORD. 02660I 4 70CAMDAY 02670I 8 90CAYR 02680I 10 110CAMO 02690I 12 130CADAY 02700I 8 130CACAL 02710I 18 200CAWK 02720I 21 220CADOW 02730I*------------------------------------------------------------------- 02740I GG 03 02750C**************************************************************** ÐÐ02760C* INITIALIZE 02770C N79 EXSR SR101 INIT 02780C*-------------------------------------------------------------- 02790C START TAG 02800C SETOF 54 02810C READ SFLOWLEV 54 02820C 54 GOTO END END OF FILE 02830C SLLL COMP SCPASS 56 55 02840C N55 78 GOTO END WRONG LEV, W/ACTIVITY02850C N55N56 GOTO END WRAP AROUND 02860C 56 EXSR SR203 SCPASS+1 02870C 56 GOTO START DO NEXT LEVEL 02880C N30 GOTO START DELETED SFLOWLEV REC 02890C EXSR SR86 DEL SFLOWLEV 02900C Z-ADD0 ZERO7 70 STUPIDITY 02910C Z-ADD0 XPQ 02920C Z-ADD0 MDUE 40 02930C Z-ADD9999 CAL 02940C MOVE ' ' WON 02950C Z-ADD0 TOTORD 70 02960C* GET ASSY PART MASTER 02970C MOVELSLPN W12A 12 02980C EXSR SR81 GET PART MASTER 02990C 60 03000COR 61 GOTO START NO MASTER ÐÐ03010C XFOOTPLT TOTLT 40 TOTAL LEAD TIME 03020C PMSSTK COMP 0 54 03030C 54 Z-ADD1 CAL,1 03040C 54 Z-ADDPMSSTK XPQ,1 03050C MOVE PMECHG WOREV 2 WORK ORDER REVISION 03060C* SET-UP SFMAST READ. 03070C MOVE BLK29 W29A 29 03080C MOVELSLPN W29A 03090C W29A SETLLSFMAST 03100C SETOF 73 03110C*----------------------------------------------------------------- 03120C TAG10 TAG 03130C* GET NEXT SFMAST 03140C SETOF 54 03150C READ SFMAST 54 03160C 54 GOTO TAG100 END OF FILE 03170C SFPN COMP SLPN 54 03180C N54 GOTO TAG100 WRONG PART # 03190C SFKEY COMP LSTSF 54 03200C N54 GOTO TAG100 WRAP-AROUND ERROR 03210C MOVE SFKEY LSTSF 29 03220C SFSTAT COMP 'D' 54 DELETED 03230C N54 SFSTAT COMP 'R' 54 RELEASED 03240C 54 GOTO TAG10 BYPASS 03250C EXSR SR102 CLASSIFY SFMAST ÐÐ03260C 11 EXSR SR103 LOAD ORDER 03270C 12 EXSR SR104 LOAD REQUIREMENT 03280C GOTO TAG10 GET NEXT SFMAST 03290C*----------------------------------------------------------------- 03300C TAG100 TAG 03310C* NET REQUIREMENTS. 03320C EXSR SR105 NET REQUIREMENTS 03330C ZERO7 LOKUPXPQ 54 03340C N54 GOTO START NETTED TO ZERO 03350C EXSR SR106 COMPUTE LOT SIZES 03360C EXSR SR107 PUT WORK ORDERS 03370C PMNOBM COMP 0 54 03380C N54 GOTO START NO COMPONENTS 03390C* SET-UP 1ST INDENTURE READ/WRITE REQUIREMENT RECORDS. 03400C Z-ADD1 QTY,2 QTY MULTIPLIER 03410C Z-ADD3 L 20 INDENTURE LEVEL 03420C MOVE BLK20 LEV 03430C MOVELSLPN LEV,2 03440C*----------------------------------------------------------------- 03450C TAG300 TAG 03460C* GET SAVED LOWER LEVEL PART NO.'S, IF ANY. 03470C L SUB 1 L 54 INDENT LEVEL 03480C N54 GOTO START BOTTOM INDENT 03490C LEV,L COMP BLK20 54 03500C N54 GOTO TAG300 NONE THIS LEVEL ÐÐ03510C MOVE LEV,L W20A 20 03520C MOVELLEV,L CURASY 100 MATCH PART # 03530C MOVE BLK20 LEV,L 03540C Z-ADDQTY,L CUMQTY 70 QTY MULTIPLIER 03550C*------------------------------------------------------------------ 03560C TAG400 TAG 03570C* SET-UP NEXT READ 03580C W20A SETLLBMMAST 03590C*--------------------------------------------------------------- 03600C TAG450 TAG 03610C* GET NEXT COMPONENT. 03620C SETOF 544950 03630C READ BMMAST 54GET COMPONENT 03640C 54 GOTO TAG300 END OF FILE 03650C BMAPN COMP CURASY 54 03660C N54 GOTO TAG300 WRONG ASSY 03670C BMSTAT COMP 'D' 54 03680C 54 GOTO TAG450 DELETED RECORD 03690C* OUTPUT COMPONENT DATA. 03700C BMISSU COMP 'RA' 50 FLAG REF ASSY 03710C MOVELBMISSU W1A 1 03720C N50 W1A COMP 'R' 49 FLAG REF DOCUMENT 03730C N49N50 EXSR SR72 OUTPUT RQMT 03740C* BRANCH IF NOT REF ASSY 03750C PMNOBM COMP 0 54 ÐÐ03760C N54 NO COMPONENTS 03770CORN50 GOTO TAG450 NOT REF ASSY 03780C*------------------------------------------------------------------ 03790C TAG500 TAG 03800C* SAVE CUR LEVEL ASSY/COMPONENT PART # 03810C MOVELBMAPN LEV,L 03820C 1 ADD BMCPN W10N 100 03830C MOVE W10N LEV,L 03840C Z-ADDCUMQTY QTY,L SAVE MULTIPLIER 03850C Z-ADDEXTQTY CUMQTY NEW MULTIPLIER 03860C MOVE BMCPN CURASY 03870C MOVELBMCPN W20A 03880C MOVE ZERO10 W20A 03890C 1 ADD L L INDENT LEVEL 03900C GOTO TAG400 03910C*------------------------------------------------------------------ 03920C END TAG 03930C MOVE BLK20 W13A 03940C MOVEL'$\CONT' W13A 03950C W13A CHAINORDERLOG 54 03960C SETON 85 03970C EXCPT UPDATE ORDERLOG 03980C SETOF 85 03990C MOVEL'Q219SF' PROG 8 04000C EXITFCHAIN ÐÐ04010C RLABL PROG 04020C ENDJOB TAG 04030C******************************************************************** 04040CSR SR72 BEGSR 04050C* DISPLAY DATA LINE TO CRT. 04060CSR MOVE BLK12 W12A 04070CSR MOVELBMCPN W12A COMP PN 04080CSR EXSR SR81 GET PMMST2 04090CSR PMMODL COMP BLK12 54 04100CSR 54 MOVE BLK35 PMDESC 04110CSR 54 MOVELPMMODL PMDESC 04120CSR L COMP 1 0101 04130CSR L COMP 2 02 04140CSR L COMP 3 03 04150CSR L COMP 4 04 04160CSR L COMP 5 05 04170CSR L COMP 6 06 04180CSR L COMP 7 07 07 04190CSR 01 Z-ADD1 L 04200CSR Z-ADD1 X 04210C*--------------------------------------------------------------------- 04220CSR T72A TAG 04230CSR ZERO7 LOKUPXPQ,X 54 04240CSRN54 GOTO END72 04250CSR CUMQTY MULT BMQTY EXTQTY 70 ÐÐ04260CSR XPQ,X MULT EXTQTY QTYOUT 70 04270CSR CAL,X SUB TOTLT W6N 60 54 04280CSRN54 Z-ADDMTODAY W6N 04290CSR MOVEL'M' W7A 04300CSR MOVE W6N W7A 04310CSR EXSR SR82 GET CALENDAR 04320CSR Z-ADDCACAL DUEDAT 60 04330CSR MOVELWON,X W11A 11 04340CSR MOVE '00000' W11A 04350CSR MOVELPMSC W1A 1 04360CSR SETON 7278 04370CSR EXCPT PUT REQUIREMENT 04380CSR SETOF 72 04390CSR 1 ADD X X 04400CSR X COMP 150 54 04410CSRN54 GOTO T72A 04420CSR END72 ENDSR 04430C******************************************************************** 04440CSR SR81 BEGSR 04450C* GET PART MAST. 04460CSR SETOF 61 04470CSR W12A CHAINPMMST2 60 GET PMMST. 04480CSRN61 PMSTAT COMP 'D' 61 FLAG DELETE. 04490CSR ENDSR 04500C*********************************************************************** ÐÐ04510CSR SR82 BEGSR 04520C* GET CALENDAR FILE 04530CSR SETOF 2021 04540CSR W7A CHAINCALENDAR H9 04550CSR H9 GOTO ENDJOB PROG ERROR 04560CSR ENDSR 04570C* 04580C* 04590C******************************************************************* 04600CSR SR86 BEGSR 04610C* WRITE DELETE CODE TO SFLOWLEV 04620CSR SETON 86 04630CSR EXCPT DELETE SFLOWLEV 04640CSR SETOF 86 04650CSR ENDSR 04660C******************************************************************** 04670CSR SR101 BEGSR 04680C* INITIALIZE (1-TIME). 04690CSR SETON 79 04700CSR MOVE ' ' BLK12 12 04710CSR MOVE ' ' BLK20 20 04720CSR Z-ADD0 ZERO10 100 04730CSR Z-ADD0 ZERO7 70 04740CSR Z-ADD0 ZERO5 50 04750CSR Z-ADD0 ZERO3 30 ÐÐ04760CSR MOVE ' ' BLK35 35 04770CSR MOVE ' ' BLK29 29 04780CSR MOVELUDATE W4N 40 04790CSR MOVE UDATE W2N 20 04800CSR MOVELW2N TODAY 60 04810CSR MOVE W4N TODAY 04820CSR MOVEL'C' W7A 04830CSR MOVE TODAY W7A 04840CSR EXSR SR82 GET CALENDAR 04850CSR Z-ADDCAMDAY MTODAY 40 04860CSR MOVE BLK20 W13A 04870CSR MOVEL'$\CONT' W13A 04880CSR W13A CHAINORDERLOG H8 04890CSR H8 GOTO ENDJOB 04900CSR MOVELOLPN WONUMB 50 04910CSR EXSR SR203 SET LOW LEVEL 04920CSR ENDSR 04930C******************************************************************** 04940CSR SR102 BEGSR 04950C* CLASSIFY SFMAST. 04960CSR SFREC COMP 10 01 RPO 04970CSR SFREC COMP 20 02 RWO 04980CSR SFREC COMP 30 03 PO 04990CSR SFREC COMP 40 04 PWO 05000CSR SFREC COMP 50 05 PR ÐÐ05010CSR SFREC COMP 60 06 SO 05020CSR SFREC COMP 70 07 RRQ 05030CSR SFREC COMP 80 08 PRQ 05040CSR SFREC COMP 90 09 FRC 05050CSR SETOF 1112 05060CSR 01 05070COR 02 05080COR 03 05090COR 04 05100COR 05 SETON 11 ORDER 05110CSRN11 SETON 12 REQUIREMENT 05120CSR ENDSR 05130C******************************************************************** 05140CSR SR103 BEGSR 05150C* LOAD ORDER. 05160CSR SFQTY SUB SFQTYC QTYBAL 70 54 05170CSRN54 Z-ADD0 QTYBAL 05180CSR QTYBAL ADD TOTORD TOTORD 70 05190CSR ENDSR 05200C******************************************************************** 05210CSR SR104 BEGSR 05220C* LOAD SFMAST REQUIREMENT RECORD 05230CSR EXSR SR201 GET DUE DATE MDAY 05240CSR Z-ADD1 X 30 05250CSR MDUE LOKUPCAL,X 55 55 ÐÐ05260CSR CAL,X COMP 9999 54 05270CSR 54 Z-ADDMDUE CAL,X 05280CSR SFQTY SUB SFQTYC QTYBAL 54 05290CSRN54 Z-ADD0 QTYBAL 05300CSR QTYBAL ADD XPQ,X XPQ,X 05310CSR SETON 70 05320CSR ENDSR 05330C******************************************************************** 05340CSR SR105 BEGSR 05350C* NET REQUIREMENTS. 05360CSR MOVELSLPN W12A 12 05370CSR EXSR SR81 GET PART MAST 05380CSRN60 PMOHB COMP 0 54 05390CSRN60N54 Z-ADD0 PMOHB 05400CSR PMOHB ADD TOTORD TOTORD 05410CSR Z-ADD1 X 05420C*------------------------------------------------------------------- 05430CSR T105A TAG 05440CSR SETOF 5758 05450CSR ZERO7 LOKUPXPQ,X 54 05460CSRN54 GOTO END105 05470CSR TOTORD COMP XPQ,X 545556 05480CSR 54 TOTORD SUB XPQ,X TOTORD 57 05490CSR 54 Z-ADD0 XPQ,X 58 05500CSR 55 XPQ,X SUB TOTORD XPQ,X 58 ÐÐ05510CSR 55 Z-ADD0 TOTORD 57 05520CSR 56 Z-ADD0 TOTORD 57 05530CSR 56 Z-ADD0 XPQ,X 58 05540CSR 57 GOTO T105A 05550CSR END105 ENDSR 05560C******************************************************************** 05570CSR SR106 BEGSR 05580C* COMPUTE LOT SIZES. 05590CSR EXSR SR202 POLICY DEFAULTS 05600CSR WMM,4 COMP 0 57 FLAG 05610CSR WMM,5 COMP 0 58 LOT SIZE 05620CSR WMM,6 COMP 0 59 LIMITS 05630CSRN57N58N59 GOTO T106R DO NOT LOT SIZE 05640CSR MOVE ' ' GOBACK 05650CSR Z-ADD0 F 30 FROM INDEX 05660CSR Z-ADD0 T 30 THRU INDEX 05670C*------------------------------------------------------------------- 05680CSR T106B TAG 05690C* ADVANCE FROM INDEX. 05700CSR 1 ADD F F 05710CSR F COMP 150 54 05720CSR 54 GOTO T106R DONE 05730C*------------------------------------------------------------------- 05740CSR T106E TAG 05750CSR ZERO7 LOKUPXPQ,F 54 ÐÐ05760CSRN54 GOTO T106R DONE 05770CSR Z-ADDF T 05780C*------------------------------------------------------------------- 05790CSR T106G TAG 05800C* ADVANCE THRU INDEX. 05810CSR 1 ADD T T 05820CSR T COMP 150 54 05830CSR 54 GOTO T106R DONE 05840C*------------------------------------------------------------------- 05850CSR T106J TAG 05860C* GET NEXT FLOATER. 05870CSR ZERO7 LOKUPXPQ,T 54 05880CSRN54 GOTO T106R DONE 05890C* CHECK SPAN LIMIT. 05900CSR XPQ,F ADD XPQ,T NEWQTY 70 05910CSR Z-ADDXPQ,T MOVQTY 70 05920CSRN57 GOTO T106L NO SPAN LIMIT 05930CSR CAL,T SUB CAL,F SPAN 70 05940CSR SPAN COMP WMM,4 54 05950CSR 54 Z-ADDT F 05960CSR 54 GOTO T106G 05970C*------------------------------------------------------------------- 05980CSR T106L TAG 05990C* CHECK QTY LIMIT. 06000CSR MOVE 'G' GOBACK 1 ÐÐ06010CSRN58 GOTO T106N NO QTY LIMIT 06020CSR NEWQTY COMP WMM,5 54 06030CSRN54 GOTO T106N LIMIT OK 06040C* CALCULATE PARTIAL MOVE QTY. 06050CSR MOVE ' ' GOBACK 06060CSR WMM,5 SUB XPQ,F MOVQTY 54 06070CSRN54 Z-ADD0 MOVQTY 06080CSR MOVQTY COMP XPQ,T 54 06090CSR 54 Z-ADDXPQ,T MOVQTY 06100CSR MOVQTY ADD XPQ,F NEWQTY 06110C*------------------------------------------------------------------- 06120CSR T106N TAG 06130C* CHECK $ LIMIT. 06140CSRN59 GOTO T106P NO $ LIMIT 06150CSR PMTCST MULT NEWQTY W7N 70H 06160CSR W7N COMP WMM,6 54 06170CSRN54 GOTO T106P LIMIT OK 06180CSR MOVE 'B' GOBACK 06190CSR PMTCST MULT XPQ,F W7N H54 06200CSRN54 Z-ADD0 W7N 06210CSR WMM,6 SUB W7N W7N 54 06220CSRN54 Z-ADD0 W7N 06230CSR W7N DIV PMTCST MOVQTY H54 06240CSRN54 Z-ADD0 MOVQTY 06250CSR MOVQTY COMP XPQ,T 54 ÐÐ06260CSR 54 Z-ADDXPQ,T MOVQTY 06270C*------------------------------------------------------------------- 06280CSR T106P TAG 06290CSR MOVQTY ADD XPQ,F XPQ,F 06300CSR XPQ,T SUB MOVQTY XPQ,T 06310CSR GOBACK COMP 'G' 54 06320CSR 54 GOTO T106G 06330CSR GOTO T106B 06340C*-------------------------------------------------------------------- 06350CSR T106R TAG 06360C* ROUNDING ROUTINE 06370CSR PMRNDF COMP 0 54 06380CSRN54 GOTO END106 06390CSR Z-ADD0 F 06400C*----------------------------------------------------------------- 06410CSR T106S TAG 06420CSR 1 ADD F F 06430CSR F COMP 150 54 06440CSR 54 GOTO END106 06450C*-------------------------------------------------------------------- 06460CSR T106T TAG 06470CSR ZERO7 LOKUPXPQ,F 54 06480CSRN54 GOTO END106 06490CSR 1 ADD F T 06500C*---------------------------------------------------------------- ÐÐ06510CSR T106U TAG 06520CSR T COMP 150 54 06530CSR 54 GOTO END106 06540C*------------------------------------------------------------------- 06550CSR T106V TAG 06560CSR ZERO7 LOKUPXPQ,T 54 06570CSRN54 GOTO END106 06580CSR XPQ,F DIV PMRNDF W11D4 114 06590CSR MOVE W11D4 W4A 4 06600CSR W4A COMP '0000' 54 06610CSRN54 GOTO T106S MOVE F UP 06620CSR MOVELW11D4 W7N 70 06630CSR PMRNDF ADD W7N W7N 06640CSR W7N SUB XPQ,F MOVQTY 06650CSR MOVQTY COMP XPQ,T 54 06660CSR 54 Z-ADDXPQ,T MOVQTY 06670CSR MOVQTY ADD XPQ,F XPQ,F 06680CSR XPQ,T SUB MOVQTY XPQ,T 06690CSR W7N COMP XPQ,F 54 06700CSR 54 XPQ,T COMP 0 55 06710CSR 54N55 1 ADD T T 06720CSR 54N55 GOTO T106U 06730CSR T SUB 1 F 06740CSR GOTO T106S 06750CSR END106 ENDSR ÐÐ06760C**************************************************************** 06770CSR SR107 BEGSR 06780C* OUTPUT WORK ORDER RECORDS 06790C* 06800CSR Z-ADD1 X 30 06810C*---------------------------------------------------------------- 06820CSR T107A TAG 06830CSR ZERO7 LOKUPXPQ,X 54 06840CSRN54 GOTO END107 06850C*---------------------------------------------------------------- 06860CSR T107B TAG 06870C* GET NEXT AVAIL WORK ORDER # 06880CSR 1 ADD WONUMB WONUMB 50 06890CSR MOVE WONUMB W6A 6 06900CSR MOVEL'M' W6A 06910CSR MOVELW6A W11A 11 06920CSR MOVE '00000' W11A 06930CSR MOVE W11A W13A 13 06940CSR MOVEL'WO' W13A 06950CSR W13A CHAINORDERLOG 60 06960CSRN60 OLSTAT COMP 'D' 61 06970CSRN60N61 GOTO T107B 06980CSR CAL,X SUB TOTLT W6N 06990CSR MOVEL'M' W7A 7 07000CSR MOVE W6N W7A ÐÐ07010CSR EXSR SR82 GET CALENDAR 07020CSR Z-ADDCACAL START 60 WO START DATE 07030CSR Z-ADDCAL,X W6N 07040CSR MOVE W6N W7A 07050CSR EXSR SR82 GET CALENDAR 07060CSR Z-ADDCACAL DUEDAT WO DUE DATE 07070CSR MOVELW11A WON,X 07080CSR SETON 8178 OUTPUT NEWSFREQ REC. 07090CSR EXCPT ADD ORDERLOG RECORD 07100CSR SETOF 81 07110CSR 1 ADD X X 07120CSR X COMP 150 54 07130CSRN54 GOTO T107A 07140CSR END107 ENDSR 07150C*************************************************************** 07160CSR SR201 BEGSR 07170C* GET SFMAST DUE DATE MDAY 07180CSR MOVEL'C' W7A 7 07190CSR MOVE SFDUE W7A 07200CSR EXSR SR82 GET CALENDAR 07210CSR Z-ADDCAMDAY MDUE 40 07220CSR ENDSR 07230C****************************************************************** 07240CSR SR202 BEGSR 07250C* ORDER POLICY DEFAULTS ÐÐ07260CSR Z-ADDPMM WMM 07270CSR ENDSR 07280C******************************************************************** 07290CSR SR203 BEGSR 07300C* SET LOW LEVEL. 07310CSR 1 ADD SCPASS SCPASS 07320CSR MOVE BLK12 W12A 12 07330CSR MOVELSCPASS W12A 07340CSR W12A SETLLSFLOWLEV 07350CSR ENDSR 07360C* 07370O******************************************************************** 07380OTERMO E 86 07390O SCPASS 20 07400O SLPN 12 ' - - ' 07410O***************************************************************** 07420OSFEXCONTE 85 07430O SCPASS 2 07440O SCSTRT 16 07450O******************************************************************* 07460OSFLOWLEVE 86 07470O 13 'D' 07480O************************************************************************ 07490ONEWSFREQE 81 07500O* PLAN WORK ORDER ÐÐ07510O SLPN 10 07520O DUEDAT 16 07530O 18 '40' 07540O W11A 29 07550O XPQ,X 33P 07560O ZERO7 37P 07570O TODAY 43 07580O ZERO5 46P 07590O ZERO3 64P 07600O PMECHG 66 07610O ZERO3 97P 07620O START 103 07630O ZERO7 123P 07640O ZERO7 127P 07650O 128 'E' 07660O*----------------------------------------------------------------- 07670O E 72 07680O* PLANNED REQUIREMENT 07690O BMCPN 10 07700O DUEDAT 16 07710O 18 '80' 07720O W11A 29 07730O QTYOUT 33P 07740O ZERO7 37P 07750O TODAY 43 ÐÐ07760O ZERO5 46P 07770O SLPN 56 07780O BMQTY 60P 07790O BMISSU 62 07800O ZERO3 64P 07810O WOREV 66 07820O XPQ,X 70P 07830O ZERO7 123P 07840O ZERO7 127P 07850O 128 'E' 07860O********************************************************************* 07870OORDERLOGEADD 81 60 07880O W13A 13 07890O SLPN 23 07900O DUEDAT 29 07910O 32 '4 A' 07920O*------------------------------------------------------------------- 07930O E 81N60 07940O SLPN 23 07950O DUEDAT 29 07960O 32 '4 A' 07970O*----------------------------------------------------------------- 07980O E 85 07990O WONUMB 18 08000O***************************************************************** ÐÐ** LEV ARRAY 008010 008020** QTY ARRAY 008030 008040** CAL ARRAY 008050 008060** LPQ ARRAY 008070 008080** WMM ARRAY 008090 008100** WON ARRAY 008110 008120/* 008130_‚ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ ÐÐ_‚_‚ ÐÈ(¼Y2 ¼$X215SF P120282120282(èÈÐ00010H Q215SF00020F* COMPUTE EXCEPTIONS FOR SPECIFIC PART NUMBER (X215SF) 00030F* REVISED 4/14/81 12:20 PM. 00040FBITTAB IP F 33 DISK 00050FMGFILE IC F 80R DISK 00060FSFMAST UD F 128L29AI 1 DISK 00070FPMMST2 IC F 674R12AI 1 DISK 00080FSFEMAST UC F 128R10AI 1 DISK A 00090FCALENDARIC F 22R 7AI 1 DISK 00100FTERM132 O F 132 5 00110E******************************************************************** 00120E NUL 1 132 1 00130E A12 1 12 1 00140E EXC 50 4 0 00150E PLT 8 3 0 00160E PHZ 5 3 0 00170E PMM 6 7 0 00180E BIT 33 1 00190I******************************************************************** 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************** 00230IMGFILE MG 00240I 1 50 MGTEXT 00250I******************************************************************** ÐÐ00260ISFMAST SF 00270I* SCHEDULE MASTER. 00280I* COMMON FIELDS. 00290I* KEY AREA. 00300I 1 29 SFKEY 00310I* PART NO. 10N 00320I 1 100SFPN 00330I* DATE DUE 6N (YMD) 00340I 11 160SFDUE 00350I* RECORD CODE 2N 00360I* 10 = RECEIVED PO 00370I* 20 = REL WO 00380I* 30 = PURCHASE ORDER 00390I* 40 = PLAN WO 00400I* 50 = PURCHASE REQ 00410I* 60 = SALES ORDER-BACKLOG 00420I* 70 = REL REQUIREMENT 00430I* 80 = PLAN REQUIREMENT 00440I* 90 = RUN RELEASE 00450I 17 180SFREC 00460I* ORDER NO. 00470I 19 29 SFORD 00480I* PREFIX 1A 00490I 19 19 SFPRFX 00500I* PRIME 6A ÐÐ00510I 19 24 SFPRIM 00520I* ITEM 3N 00530I 25 270SFITEM 00540I* RECEIVING LOG # 2N 00550I 28 290SFRLOG 00560I* QUANTITY 7P 00570I P 30 330SFQTY 00580I* QTY COMPLETE 7P 00590I P 34 370SFQTYC 00600I* DATE LAST TRAN 6N (YMD) 00610I 38 430SFDLT 00620I* CUST #/DEPT #/VEND # 3P 00630I P 44 460SFCUST 00640I* PLAN/REL REQMTS. 00650I* NEXT ASSY PART # 10N 00660I 47 560SFNAPN 00670I* QTY PER ASSY 7P 00680I P 57 600SFQPA 00690I* ISSUE CODE 2A 00700I 61 62 SFISSU 00710I* PULL # 3P 00720I P 63 640SFPULL 00730I* ASSY REVISION 2A 00740I 65 66 SFREV 00750I* ASSY WO QTY 7P ÐÐ00760I P 67 700SFQTYA 00770I* BACKORDER FLAG 00780I 105 105 SFBOF 00790I* SALES ORDERS 00800I* CUST P.O. 20A 00810I 71 90 SFCPO 00820I* UNIT PRICE 9.3P 00830I P 91 953SFPRIC 00840I* BACKORDER FLAG 1A -- SEE ABOVE 00850I* PURCH ORDERS 00860I* VENDOR NAME 20A 00870I* SEE SFCPO UNDER SALES ORDERS. 00880I* UNIT PRICE 9.3P 00890I* SEE SFPRIC UNDER SALES ORDERS. 00900I* WORK ORDERS 00910I* DEPT NAME 20A 00920I* SEE SFCPO UNDER SALES ORDERS. 00930I* OPER SEQ # 3P 00940I P 96 970SFSEQ 00950I* START DATE 6N 00960I 98 1030SFSTRT 00970I* PULL # 3P 00980I* SEE PLAN/REL REQMTS. 00990I* REQUIREMENT FLAG 1A 01000I 104 104 SFRFLG ÐÐ01010I* REVISION 2A 01020I* SEE PLAN/REL REQMTS. 01030I* AVAIL STOCK BAL 79 01040I P 120 1210SFSAVQ 01050I* AVAIL QTY 7P 01060I P 124 1270SFAVQ 01070I* RECORD STATUS 1A 01080I 128 128 SFSTAT 01090I******************************************************************** 01100IPMMST2 PM 01110I 1 100PMPN 01120I 94 95 PMSC 01130I* LEAD TIMES 3P X 8 01140I* 1 = PRODUCTION CONTROL,SCHEDULE 01150I* 2 = PURCHASING,PLACE P.O. 01160I* 3 = VENDOR,SUPPLY PART OR SERVICE 01170I* 4 = STOCK,PULL PARTS 01180I* 5 = SHOP,FAB & ASSEMBLE 01190I* 6 = INSPECTION & TEST 01200I* 7 = STOCK,RECEIVE PARTS 01210I* 8 = SAFETY LEAD TIME 01220I P 113 128 PLT 01230I* ORDER POLICY CODES. 01240I* HORIZON M-DAYS 3P X 5 01250I* 1 = SALES ORDERS ÐÐ01260I* 2 = PROD REQMTS-REL 01270I* 3 = PROD REQMTS-PLAN 01280I* 4 = FORECAST 01290I* 5 = SAFETY STOCK 01300I P 129 138 PHZ 01310I* MIN/MAX CODES. 01320I* ARRAY 7P X 6 01330I* 1 = MIN ORDER QTY 01340I* 2 = MIN ORDER $ 01350I* 3 = MIN STOCK QTY 01360I* 4 = MAX ORDER QTY 01370I* 5 = MAX ORDER $ 01380I* 6 = MAX STOCK QTY 01390I P 139 162 PMM 01400I* MINIMUM REQMT SPAN 3P 01410I P 163 1640PMMRQS 01420I* MAXIMUM REQMT SPAN 3P 01430I P 165 1660PMXRQS 01440I* ROUNDING FACTOR 5P 01450I P 167 1690PMRNDF 01460I* EOQ CODE 2A 01470I 170 171 PMEOQ 01480I* EOQ PARAMETER 2A 01490I 172 173 PMEOQP 01500I* EXCEPTION REPORT CRITERIA. ÐÐ01510I* ALLOWABLE SURPLUS QTY 7P 01520I P 174 1770PMSQTY 01530I* ALLOWABLE SURPLUS % 5.2P 01540I P 178 1802PMSPCT 01550I* ALLOWABLE SURPLUS SPAN 3P 01560I P 181 1820PMSSP 01570I* ALLOWABLE SHORTAGE SPAN 3P 01580I P 183 1840PMSHSP 01590I* ON HAND BAL 7P 01600I P 311 3140PMOHB 01610I* LOW LEVEL CODE 2N 01620I 430 4310PMLL 01630I* RECORD STATUS 1A 01640I 674 674 PMSTAT 01650I******************************************************************** 01660ISFEMAST SE 01670I* EXCEPTION MASTER. 01680I* PART NO. 10N 01690I 1 100SEPN 01700I* EXCEPTIONS 4B X 50 01710I B 11 110 EXC 01720I* BUCKET * EXCEPTION * CODE 01730I* 1 TO BE ORDERED - PURCH LOW LEVEL CODE 01740I* 2 TO BE ORDERED - MFG LOW LEVEL CODE 01750I* 3 PAST DUE-PURCH- ON ORDER DUE DATE ÐÐ01760I* 4 PAST DUE-MFG - ON ORDER DUE DATE 01770I* 5 PAST DUE - PLAN REQMTS DUE DATE 01780I* 6 PAST DUE - REL REQMTS DUE DATE 01790I* 7 PAST DUE - SALES ORDER DUE DATE 01800I* 8 PAST DUE - RUN RELEASE DUE DATE 01810I* 9 NOT RELEASED - PLAN WO START DATE 01820I* 10 NOT PLACED - PURCH REQ DUE DATE 01830I* 11 NOT INSPECTED - RPO DLT 01840I* 12 BACKORDER - PURCH DUE DATE 01850I* 13 BACKORDER - MFG DUE DATE 01860I* 14 BACKORDER IN RECVG INSP DUE DATE 01870I* 15 BACKORDER IN STOCK DUE DATE 01880I* 16 NEGATIVE ON HAND VALUE OF 1 01890I* 17 SURPLUS DUE DATE 01900I* 18 SHORTAGE DUE DATE 01910I* LOW LEVEL CODE 2N 01920I 126 1270SELL 01930I******************************************************************** 01940ICALENDARCA 20 1 CC 01950I* CALENDAR DATE RECORD. 01960I 2 30CAYR 01970I 4 50CAMO 01980I 6 70CADAY 01990I 14 170CAMDAY 02000I 18 200CAWK ÐÐ02010I 21 220CADOW 02020I*------------------------------------------------------------------- 02030I CB 21 1 CM 02040I* MFG DATE RECORD. 02050I 4 70MAMDAY 02060I 8 90MAYR 02070I 10 110MAMO 02080I 12 130MADAY 02090I 18 200MAWK 02100I 21 220MADOW 02110I*------------------------------------------------------------------- 02120I GG 03 02130C******************************************************************** 02140C* INITIALIZE. 02150C EXSR SR101 02160C*------------------------------------------------------------------- 02170C START TAG 02180C* REQUEST PART NO. 02190C MOVE BLK12 W12A 12 02200C MOVE BIT,1 BUFLGT 2 02210C SETOF 78 02220C SETOF 969093 02230C Z-ADD298 M 02240C EXSR SR73 02250C EXITFQWREED ÐÐ02260C RLABL W12A 02270C RLABL BUFLGT 02280C MOVEAW12A A12 02290C MOVE BLK12 W12A 02300C Z-ADD1 W 30 02310C '\' LOKUPA12,W 90 02320C N90 GOTO TAG5 02330C 1 ADD W W 02340C W COMP 12 55 02350C 55 Z-ADD318 M 50 02360C 55 EXSR SR73 02370C 55 GOTO START 02380C A12,W COMP 'E' 94 02390C A12,W COMP 'D' 95 02400C A12,W COMP 'G' 98 02410C A12,W COMP 'N' 93 02420C GOTO END 02430C*------------------------------------------------------------------- 02440C TAG5 TAG 02450C Z-ADD1 W 02460C ' ' LOKUPA12,W 54 02470C 54 MOVEAA12,W W12A 02480C Z-ADD12 W2N 20 02490C EXIT SUBRAJ 02500C RLABL W2N ÐÐ02510C RLABL W12A 02520C MOVE W12A W10A 10 02530C MOVEBLK12 W12A 02540C MOVELW10A W12A 02550C W12A CHAINPMMST2 60 GET PART MAST 02560C N60 PMSTAT COMP 'D' 60 02570C 60 Z-ADD291 M 02580C 60 EXSR SR73 FLAG ERROR 02590C 60 GOTO START 02600C SETON 78 02610C Z-ADDPMOHB STKQTY 70 54 02620C N54 Z-ADD0 STKQTY 02630C EXSR SR80 GET EXCPTN MAST 02640C Z-ADDSTKQTY AVAIL 70 OVERALL AVAIL BAL 02650C Z-ADDSTKQTY SAVAIL 70 AVAIL STOCK BAL 02660C Z-ADD0 FBO 40 02670C Z-ADD0 FPLUS 40 02680C Z-ADD0 FNEG 40 02690C MOVELSXPN KEYSF 29 02700C KEYSF SETLLSFMAST 02710C*------------------------------------------------------------------- 02720C TAG10 TAG 02730C SETOF 54 02740C READ SFMAST 54 02750C 54 GOTO TAG600 ÐÐ02760C SFPN COMP PMPN 54 02770C N54 GOTO TAG600 02780C SFSTAT COMP 'D' 54 02790C N54 SFSTAT COMP 'R' 54 02800C 54 GOTO TAG10 02810C EXSR SR102 CLASSIFY SFMAST 02820C 01 GOTO TAG110 RPO 02830C 02 GOTO TAG120 REL WO 02840C 03 GOTO TAG130 PO 02850C 04 GOTO TAG140 PLAN WO 02860C 05 GOTO TAG150 PUR REQ 02870C 06 GOTO TAG160 SO 02880C 07 GOTO TAG170 REL RQMT 02890C 08 GOTO TAG180 PLAN RQMT 02900C 09 GOTO TAG190 RUN REL 02910C GOTO TAG500 02920C*------------------------------------------------------------------- 02930C TAG110 TAG 02940C* RECEIVED PO. 02950C SETON 76 RPO FLAG 02960C EXSR SR201 PLUS AVAIL 02970C EXSR SR203 NOT INSPECTED 02980C EXSR SR210 BO IN INSP 02990C EXSR SR212 SURPLUS 03000C EXSR SR213 SHORTAGE ÐÐ03010C GOTO TAG500 03020C*------------------------------------------------------------------- 03030C TAG120 TAG 03040C* REL WO. 03050C EXSR SR201 PLUS AVAIL 03060C EXSR SR204 PAST DUE 03070C EXSR SR212 SURPLUS 03080C EXSR SR213 SHORTAGE 03090C GOTO TAG500 03100C*------------------------------------------------------------------- 03110C TAG130 TAG 03120C* PURCH ORDER. 03130C EXSR SR201 PLUS AVAIL 03140C EXSR SR204 PAST DUE 03150C EXSR SR212 SURPLUS 03160C EXSR SR213 SHORTAGE 03170C GOTO TAG500 03180C*------------------------------------------------------------------- 03190C TAG140 TAG 03200C* PLAN WO. 03210C EXSR SR105 START MDAY 03220C EXSR SR201 PLUS AVAIL 03230C EXSR SR204 PAST DUE 03240C EXSR SR205 NOT REL 03250C EXSR SR212 SURPLUS ÐÐ03260C EXSR SR213 SHORTAGE 03270C GOTO TAG500 03280C*------------------------------------------------------------------- 03290C TAG150 TAG 03300C* PUR REQ. 03310C EXSR SR201 PLUS AVAIL 03320C EXSR SR204 PAST DUE 03330C EXSR SR206 NOT PLACED 03340C EXSR SR212 SURPLUS 03350C EXSR SR213 SHORTAGE 03360C GOTO TAG500 03370C*------------------------------------------------------------------- 03380C TAG160 TAG 03390C* SALES ORDER. 03400C EXSR SR202 MINUS AVAIL 03410C EXSR SR204 PAST DUE 03420C EXSR SR208 BO 03430C EXSR SR210 BO IN INSP 03440C EXSR SR213 SHORTAGE 03450C GOTO TAG500 03460C*------------------------------------------------------------------- 03470C TAG170 TAG 03480C* REL REQMT. 03490C EXSR SR202 MINUS AVAIL 03500C EXSR SR204 PAST DUE ÐÐ03510C EXSR SR208 BACKORDER 03520C EXSR SR210 BO IN INSP 03530C EXSR SR213 SHORTAGE 03540C GOTO TAG500 03550C*------------------------------------------------------------------- 03560C TAG180 TAG 03570C* PLAN REQMT. 03580C EXSR SR202 MINUS AVAIL 03590C EXSR SR204 PAST DUE 03600C EXSR SR213 SHORTAGE 03610C GOTO TAG500 03620C*------------------------------------------------------------------- 03630C TAG190 TAG 03640C* RUN REL. 03650C EXSR SR202 MINUS AVAIL 03660C EXSR SR204 PAST DUE 03670C EXSR SR213 SHORTAGE 03680C GOTO TAG500 03690C*------------------------------------------------------------------- 03700C TAG500 TAG 03710C* UPDATE SFMAST. 03720C EXSR SR83 UPDATE SFMAST 03730C GOTO TAG10 GET NEXT 03740C*------------------------------------------------------------------- 03750C TAG600 TAG ÐÐ03760C* COMPUTE FINAL EXCEPTIONS. 03770C EXSR SR301 TO BE ORD 03780C EXSR SR302 NEG ON HAND 03790C EXSR SR303 SURPLUS 03800C EXSR SR81 UPD SFEMAST 03810C GOTO START 03820C*------------------------------------------------------------------- 03830C END TAG 03840C MOVEL'Q059DP' PROG 8 03850C EXITFCHAIN 03860C RLABL PROG 03870C******************************************************************** 03880CSR SR73 BEGSR 03890CSR M CHAINMGFILE 54 03900CSRN54 MOVE BLK35 MGTEXT 03910CSR SETON 73 03920CSR EXCPT 03930CSR SETOF 73 03940CSR ENDSR 03950C******************************************************************** 03960CSR SR80 BEGSR 03970C* GET EXCEPTION MASTER. 03980CSR SXPN CHAINSFEMAST 54 GET SFEMAST 03990CSRN54 GOTO END80 04000CSR Z-ADD0 EXC ÐÐ04010CSR SETON 82 04020CSR EXCPT ADD SFEMAST 04030CSR SETOF 82 04040CSR GOTO SR80 04050CSR END80 ENDSR 04060C******************************************************************** 04070CSR SR81 BEGSR 04080C* REWRITE SFEMAST. 04090CSR SETON 81 04100CSR EXCPT REWRITE SFEMAST 04110CSR SETOF 81 04120CSR ENDSR 04130C******************************************************************** 04140CSR SR83 BEGSR 04150C* UPDATE SFMAST. 04160CSR SETON 83 04170CSR EXCPT UPDATE SFMAST 04180CSR SETOF 83 04190CSR ENDSR 04200C******************************************************************** 04210CSR SR85 BEGSR 04220C* GET CALENDAR RECORD. 04230CSR W7A CHAINCALENDAR 60 04240CSR ENDSR 04250C******************************************************************** ÐÐ04260CSR SR101 BEGSR 04270C* INITIALIZE. 04280CSR MOVE BIT,1 NUL 04290CSR MOVE ' ' BLK20 20 04300CSR MOVELUDATE W4N 40 04310CSR MOVE UDATE W2N 20 04320CSR MOVELW2N TODAY 60 04330CSR MOVE W4N TODAY 04340CSR Z-ADDTODAY W6N 04350CSR EXSR SR401 GET MDAY 04360CSR Z-ADDCAMDAY MNOW 40 04370C* 04380C* 04390CSR ENDSR 04400C******************************************************************** 04410CSR SR102 BEGSR 04420C* CLASSIFY SFMAST. 04430CSR SETOF 101112 04440CSR SETOF 131415 04450CSR SETOF 16 04460CSR SFREC COMP 10 01 RPO 04470CSR SFREC COMP 20 02 RWO 04480CSR SFREC COMP 30 03 PO 04490CSR SFREC COMP 40 04 PWO 04500CSR SFREC COMP 50 05 PR ÐÐ04510CSR SFREC COMP 60 06 SO 04520CSR SFREC COMP 70 07 RRQMT 04530CSR SFREC COMP 80 08 PRQMT 04540CSR SFREC COMP 90 09 RR 04550CSR 01 04560COR 02 04570COR 03 04580COR 04 04590COR 05 SETON 10 ON ORD FLAG 04600CSR 06 04610COR 07 04620COR 08 04630COR 09 SETON 11 RQMT FLAG 04640CSR 01 04650COR 03 04660COR 05 SETON 12 PUR ON ORDER 04670CSR 02 04680COR 04 SETON 13 WO ON ORDER 04690CSR 07 04700COR 08 SETON 14 WO REQMT 04710CSR MOVELPMSC W1A 1 04720CSR W1A COMP 'P' 15 PURCH 04730CSRN15 SETON 16 MFG 04740CSR EXSR SR103 GET DLT MDAY 04750CSR EXSR SR104 GET DUE MDAY ÐÐ04760CSR ENDSR 04770C******************************************************************** 04780CSR SR103 BEGSR 04790C* GET DATE LAST TRAN MDAY. 04800CSR SFDLT COMP 0 54 04810CSRN54 Z-ADDTODAY SFDLT 04820CSR Z-ADDSFDLT W6N 60 04830CSR EXSR SR401 GET MDAY 04840CSR Z-ADDCAMDAY MDLT 40 04850CSR ENDSR 04860C******************************************************************** 04870CSR SR104 BEGSR 04880C* GET DUE DATE MDAY. 04890CSR SFDUE COMP 0 54 04900CSRN54 Z-ADDTODAY SFDUE 04910CSR Z-ADDSFDUE W6N 04920CSR EXSR SR401 04930CSR Z-ADDCAMDAY MDUE 40 04940CSR ENDSR 04950C******************************************************************** 04960CSR SR105 BEGSR 04970C* GET START DATE MDAY. 04980CSR Z-ADDSFSTRT W6N 54 04990CSRN54 Z-ADDMNOW MSTART 40 05000CSRN54 GOTO END105 ÐÐ05010CSR EXSR SR401 GET MDAY 05020CSR Z-ADDCAMDAY MSTART 05030CSR END105 ENDSR 05040C******************************************************************** 05050CSR SR201 BEGSR 05060C* PLUS AVAIL BAL. 05070CSR AVAIL COMP 0 575859 05080CSR SFQTY SUB SFQTYC BALQTY 70 54 05090CSRN54 Z-ADD0 BALQTY 05100CSR BALQTY ADD AVAIL AVAIL 70 05110CSR 01 BALQTY ADD RPOQTY RPOQTY 70 05120CSR AVAIL COMP 0 545556 05130CSR 54N57 Z-ADDMDUE FPLUS 40 05140CSR 55N58 Z-ADDMDUE FNEG 40 05150CSR ENDSR 05160C******************************************************************** 05170CSR SR202 BEGSR 05180C* MINUS AVAIL BAL. 05190CSR AVAIL COMP 0 575859 05200CSR SFQTY SUB SFQTYC BALQTY 54 05210CSRN54 Z-ADD0 BALQTY 05220CSR AVAIL SUB BALQTY AVAIL 05230CSR SAVAIL SUB BALQTY SAVAIL 05240CSR AVAIL COMP 0 545556 05250CSR 54N57 Z-ADDMDUE FPLUS ÐÐ05260CSR 55N58 Z-ADDMDUE FNEG 05270CSR SFBOF COMP 'B' 54 05280CSR 54 SETON 77 BO FLAG 05290CSR ENDSR 05300C******************************************************************** 05310CSR SR203 BEGSR 05320C* FLAG NOT INSPECTED IF: 05330C* 1) IN INSPECT 10-DAYS, REGARDLESS OF DUE DATE. 05340CSR MNOW SUB MDLT W4N 40 05350CSR W4N COMP 5 54 54 05360CSRN54 GOTO END203 05370CSR EXC,12 COMP MDLT 54 05380CSR 54 Z-ADDMDLT EXC,11 NOT INSP 05390CSR END203 ENDSR 05400C******************************************************************** 05410CSR SR204 BEGSR 05420C* FLAG PAST DUE IF: 05430C* 1) TODAY'S DATE IS GT DUE DATE. 05440CSR MNOW COMP MDUE 54 05450CSRN54 GOTO END204 05460CSR 12 EXC,3 COMP MDUE 54 05470CSR 13 EXC,4 COMP MDUE 54 05480CSR 07 EXC,5 COMP MDUE 54 05490CSR 08 EXC,6 COMP MDUE 54 05500CSR 06 EXC,7 COMP MDUE 54 ÐÐ05510CSR 09 EXC,8 COMP MDUE 54 05520CSR 12N54 Z-ADDMDUE EXC,3 05530CSR 13N54 Z-ADDMDUE EXC,4 05540CSR 07N54 Z-ADDMDUE EXC,5 05550CSR 08N54 Z-ADDMDUE EXC,6 05560CSR 06N54 Z-ADDMDUE EXC,7 05570CSR 09N54 Z-ADDMDUE EXC,8 05580CSR END204 ENDSR 05590C******************************************************************** 05600CSR SR205 BEGSR 05610C* FLAG NOT RELEASED. 05620CSR MSTART SUB 5 W4N 40 05630CSR MNOW COMP W4N 54 05640CSRN54 GOTO END205 05650CSR EXC,9 COMP MSTART 54 05660CSR 54 Z-ADDMSTART EXC,9 NOT REL 05670CSR END205 ENDSR 05680C******************************************************************** 05690CSR SR206 BEGSR 05700C* FLAG PUR REQ NOT PLACED. 05710CSR MDLT COMP MDUE 54 05720CSRN54 MNOW SUB MDLT W4N 05730CSRN54 W4N COMP 10 54 05740CSRN54 GOTO END206 05750CSR EXC,10 COMP MDUE 54 ÐÐ05760CSR 54 Z-ADDMDUE EXC,10 05770CSR END206 ENDSR 05780C******************************************************************** 05790CSR SR208 BEGSR 05800C* FLAG BACKORDER. 05810CSR SFBOF COMP 'B' 54 05820CSRN54 GOTO END208 NOT BO 05830CSRN15 Z-ADDSFDUE EXC,13 MFG 05840CSR 15 Z-ADDSFDUE EXC,12 PURCH 05850CSR FBO COMP 0 54 05860CSRN54 Z-ADDMDUE FBO 40 05870CSR END208 ENDSR 05880C******************************************************************** 05890CSR SR210 BEGSR 05900C* FLAG BO IN RCVG INSP. 05910CSR 01 77 05920COR 11 76 GOTO T210A 05930CSR GOTO END210 05940C*------------------------------------------------------------------- 05950CSR T210A TAG 05960CSR 11 EXC,14 COMP FBO 54 05970CSR 11 54 Z-ADDFBO EXC,14 05980CSR END210 ENDSR 05990C******************************************************************** 06000CSR SR212 BEGSR ÐÐ06010C* FLAG SURPLUS. 06020CSR AVAIL COMP 0 54 06030CSRN54 GOTO END212 06040CSR MDUE SUB FPLUS W4N 06050CSR W4N COMP PMSHSP 54 54 SURPLUS TIME LIMIT 06060CSRN54 GOTO END212 06070CSR EXC,17 COMP MDUE 54 06080CSR 54 Z-ADDMDUE EXC,17 06090CSR 54 01 Z-ADDMNOW EXC,17 06100CSR END212 ENDSR 06110C********************************************************************* 06120CSR SR213 BEGSR 06130C* FLAG SHORTAGE. 06140CSR AVAIL COMP 0 54 54 06150CSR 54 GOTO END213 06160CSR Z-ADDMDUE W4N 06170CSR 01 Z-ADDMNOW W4N 06180CSR W4N SUB FNEG W4N 06190CSR W4N COMP PMSHSP 54 54 SHRTG LIMIT 06200CSRN54 GOTO END213 06210CSR EXC,18 COMP MDUE 54 06220CSR 54 Z-ADDMDUE EXC,18 06230CSR 54 Z-ADDMNOW EXC,18 06240CSR END213 ENDSR 06250C******************************************************************** ÐÐ06260CSR SR301 BEGSR 06270C* FLAG TO BE ORDERED. 06280CSR AVAIL COMP 0 54 L.T. 06290CSRN54 GOTO END301 06300CSR 15 Z-ADDFNEG EXC,1 PURCH 06310CSRN15 Z-ADDFNEG EXC,2 MFG 06320CSR END301 ENDSR 06330C******************************************************************** 06340CSR SR302 BEGSR 06350C* FLAG NEG ON HAND BAL. 06360CSR PMOHB COMP 0 54 L.T. 06370CSR 54 Z-ADD1 EXC,16 NEG ON HAND 06380CSR ENDSR 06390C******************************************************************** 06400CSR SR303 BEGSR 06410C* FLAG SURPLUS. 06420CSR AVAIL COMP 0 54 06430CSRN54 GOTO END303 06440CSR MDUE SUB FPLUS W4N 40 06450CSR W4N COMP PMSSP 54 54 06460CSR 54 Z-ADDMDUE EXC,17 FLAG SURPLUS 06470CSR END303 ENDSR 06480C******************************************************************** 06490CSR SR401 BEGSR 06500C* GET CALENDAR BY CAL DATE. ÐÐ06510CSR MOVE BLK20 W7A 7 06520CSR MOVEL'C' W7A 06530CSR MOVE W6N W7A 06540CSR EXSR SR85 GET CALENDAR 06550CSR 60 Z-ADDMNOW CAMDAY 06560CSR ENDSR 06570O******************************************************************** 06580OSFMAST E 83 06590O SFQTY 33P 06600O SFQTYC 37P 06610O SFCUST 46P 06620O SFQPA 60P 06630O SFPULL 64P 06640O SFQTYA 70P 06650O SFPRIC 95P 06660O SFSEQ 97P 06670O SAVAIL 123P 06680O AVAIL 127P 06690O******************************************************************** 06700OTERM132 E 73 06710O NUL 132 06720O MGTEXT 50 06730O BIT,8 132 06740O******************************************************************** 06750OSFEMAST EADD 82 ÐÐ06760O PMPN 10 06770O EXC 110B 06780O PMLL 127 06790O*------------------------------------------------------------------- 06800O E 81 06810O EXC 110B 06820O PMLL 127 06830O******************************************************************** ** NUL ARRAY 006840 006850** A12 ARRAY 006860 006870/* 006880_‚ ÐÐ_‚_‚0O PMPN 10 06770O EXC 110B 06780O PMLL 127 06790O*------------------------------------------------------------------- 06800O E 81 06810O EXC 110B 06820O PMLL 127 06830O******************************************************************** ** NUL ARRAY 006840 006850** A12 ARRAY 006860 006870/* 006880_‚ ÐÈ(¼ZW ¼$X216SF P120282120282(èÈÐ00010H Q216SF00020F* COMPUTE EXCEPTIONS FOR SPECIFIED WORK ORDER COMPONENTS (X216SF) 00030F* REVISED 4/14/81 11:55 AM. 00040FBITTAB IP F 33 DISK 00050FALTKEY ID F 32L29AI 1 DISK 00060FORDERLOGIC F 32R13AI 1 DISK 00070FSFMAST UD F 128L29AI 1 DISK 00080FPMMST2 IC F 674R12AI 1 DISK 00090FSFEMAST UC F 128R10AI 1 DISK A 00100FCALENDARIC F 22R 7AI 1 DISK 00110E******************************************************************** 00120E NUL 1 132 1 00130E A29 1 29 1 00140E EXC 50 4 0 00150E PLT 8 3 0 00160E PHZ 5 3 0 00170E PMM 6 7 0 00180E BIT 33 1 00190I******************************************************************** 00200IBITTAB BT 00210I 1 33 BIT 00220I******************************************************************** 00230ISFMAST SF 00240I* SCHEDULE MASTER. 00250I* COMMON FIELDS. ÐÐ00260I* KEY AREA. 00270I 1 29 SFKEY 00280I* PART NO. 10N 00290I 1 100SFPN 00300I* DATE DUE 6N (YMD) 00310I 11 160SFDUE 00320I* RECORD CODE 2N 00330I* 10 = RECEIVED PO 00340I* 20 = REL WO 00350I* 30 = PURCHASE ORDER 00360I* 40 = PLAN WO 00370I* 50 = PURCHASE REQ 00380I* 60 = SALES ORDER-BACKLOG 00390I* 70 = REL REQUIREMENT 00400I* 80 = PLAN REQUIREMENT 00410I* 90 = RUN RELEASE 00420I 17 180SFREC 00430I* ORDER NO. 00440I 19 29 SFORD 00450I* PREFIX 1A 00460I 19 19 SFPRFX 00470I* PRIME 6A 00480I 19 24 SFPRIM 00490I* ITEM 3N 00500I 25 270SFITEM ÐÐ00510I* RECEIVING LOG # 2N 00520I 28 290SFRLOG 00530I* QUANTITY 7P 00540I P 30 330SFQTY 00550I* QTY COMPLETE 7P 00560I P 34 370SFQTYC 00570I* DATE LAST TRAN 6N (YMD) 00580I 38 430SFDLT 00590I* CUST #/DEPT #/VEND # 3P 00600I P 44 460SFCUST 00610I* PLAN/REL REQMTS. 00620I* NEXT ASSY PART # 10N 00630I 47 560SFNAPN 00640I* QTY PER ASSY 7P 00650I P 57 600SFQPA 00660I* ISSUE CODE 2A 00670I 61 62 SFISSU 00680I* PULL # 3P 00690I P 63 640SFPULL 00700I* ASSY REVISION 2A 00710I 65 66 SFREV 00720I* ASSY WO QTY 7P 00730I P 67 700SFQTYA 00740I* BACKORDER FLAG 00750I 105 105 SFBOF ÐÐ00760I* SALES ORDERS 00770I* CUST P.O. 20A 00780I 71 90 SFCPO 00790I* UNIT PRICE 9.3P 00800I P 91 953SFPRIC 00810I* BACKORDER FLAG 1A -- SEE ABOVE 00820I* PURCH ORDERS 00830I* VENDOR NAME 20A 00840I* SEE SFCPO UNDER SALES ORDERS. 00850I* UNIT PRICE 9.3P 00860I* SEE SFPRIC UNDER SALES ORDERS. 00870I* WORK ORDERS 00880I* DEPT NAME 20A 00890I* SEE SFCPO UNDER SALES ORDERS. 00900I* OPER SEQ # 3P 00910I P 96 970SFSEQ 00920I* START DATE 6N 00930I 98 1030SFSTRT 00940I* PULL # 3P 00950I* SEE PLAN/REL REQMTS. 00960I* REQUIREMENT FLAG 1A 00970I 104 104 SFRFLG 00980I* REVISION 2A 00990I* SEE PLAN/REL REQMTS. 01000I* AVAIL STOCK BAL 79 ÐÐ01010I P 120 1210SFSAVQ 01020I* AVAIL QTY 7P 01030I P 124 1270SFAVQ 01040I* RECORD STATUS 1A 01050I 128 128 SFSTAT 01060I******************************************************************** 01070IPMMST2 PM 01080I 1 100PMPN 01090I 94 95 PMSC 01100I* LEAD TIMES 3P X 8 01110I* 1 = PRODUCTION CONTROL,SCHEDULE 01120I* 2 = PURCHASING,PLACE P.O. 01130I* 3 = VENDOR,SUPPLY PART OR SERVICE 01140I* 4 = STOCK,PULL PARTS 01150I* 5 = SHOP,FAB & ASSEMBLE 01160I* 6 = INSPECTION & TEST 01170I* 7 = STOCK,RECEIVE PARTS 01180I* 8 = SAFETY LEAD TIME 01190I P 113 128 PLT 01200I* ORDER POLICY CODES. 01210I* HORIZON M-DAYS 3P X 5 01220I* 1 = SALES ORDERS 01230I* 2 = PROD REQMTS-REL 01240I* 3 = PROD REQMTS-PLAN 01250I* 4 = FORECAST ÐÐ01260I* 5 = SAFETY STOCK 01270I P 129 138 PHZ 01280I* MIN/MAX CODES. 01290I* ARRAY 7P X 6 01300I* 1 = MIN ORDER QTY 01310I* 2 = MIN ORDER $ 01320I* 3 = MIN STOCK QTY 01330I* 4 = MAX ORDER QTY 01340I* 5 = MAX ORDER $ 01350I* 6 = MAX STOCK QTY 01360I P 139 162 PMM 01370I* MINIMUM REQMT SPAN 3P 01380I P 163 1640PMMRQS 01390I* MAXIMUM REQMT SPAN 3P 01400I P 165 1660PMXRQS 01410I* ROUNDING FACTOR 5P 01420I P 167 1690PMRNDF 01430I* EOQ CODE 2A 01440I 170 171 PMEOQ 01450I* EOQ PARAMETER 2A 01460I 172 173 PMEOQP 01470I* EXCEPTION REPORT CRITERIA. 01480I* ALLOWABLE SURPLUS QTY 7P 01490I P 174 1770PMSQTY 01500I* ALLOWABLE SURPLUS % 5.2P ÐÐ01510I P 178 1802PMSPCT 01520I* ALLOWABLE SURPLUS SPAN 3P 01530I P 181 1820PMSSP 01540I* ALLOWABLE SHORTAGE SPAN 3P 01550I P 183 1840PMSHSP 01560I* ON HAND BAL 7P 01570I P 311 3140PMOHB 01580I* LOW LEVEL CODE 2N 01590I 430 4310PMLL 01600I* RECORD STATUS 1A 01610I 674 674 PMSTAT 01620I******************************************************************** 01630ISFEMAST SE 01640I* EXCEPTION MASTER. 01650I* PART NO. 10N 01660I 1 100SEPN 01670I* EXCEPTIONS 4B X 50 01680I B 11 110 EXC 01690I* BUCKET * EXCEPTION * CODE 01700I* 1 TO BE ORDERED - PURCH LOW LEVEL CODE 01710I* 2 TO BE ORDERED - MFG LOW LEVEL CODE 01720I* 3 PAST DUE-PURCH- ON ORDER DUE DATE 01730I* 4 PAST DUE-MFG - ON ORDER DUE DATE 01740I* 5 PAST DUE - PLAN REQMTS DUE DATE 01750I* 6 PAST DUE - REL REQMTS DUE DATE ÐÐ01760I* 7 PAST DUE - SALES ORDER DUE DATE 01770I* 8 PAST DUE - RUN RELEASE DUE DATE 01780I* 9 NOT RELEASED - PLAN WO START DATE 01790I* 10 NOT PLACED - PURCH REQ DUE DATE 01800I* 11 NOT INSPECTED - RPO DLT 01810I* 12 BACKORDER - PURCH DUE DATE 01820I* 13 BACKORDER - MFG DUE DATE 01830I* 14 BACKORDER IN RECVG INSP DUE DATE 01840I* 15 BACKORDER IN STOCK DUE DATE 01850I* 16 NEGATIVE ON HAND VALUE OF 1 01860I* 17 SURPLUS DUE DATE 01870I* 18 SHORTAGE DUE DATE 01880I* LOW LEVEL CODE 2N 01890I 126 1270SELL 01900I******************************************************************** 01910IALTKEY AK 01920I* REQMT ORDER-KEY ALTERNATE KEY. 01930I 1 2 AKREC 01940I 3 13 AKORD 01950I 14 230AKPN 01960I 24 290AKDUE 01970I 32 32 AKSTAT 01980I******************************************************************** 01990IORDERLOGOL 02000I 30 30 OLTYPE ÐÐ02010I 32 32 OLSTAT 02020I******************************************************************** 02030ICALENDARCA 20 1 CC 02040I* CALENDAR DATE RECORD. 02050I 2 30CAYR 02060I 4 50CAMO 02070I 6 70CADAY 02080I 14 170CAMDAY 02090I 18 200CAWK 02100I 21 220CADOW 02110I*------------------------------------------------------------------- 02120I CB 21 1 CM 02130I* MFG DATE RECORD. 02140I 4 70MAMDAY 02150I 8 90MAYR 02160I 10 110MAMO 02170I 12 130MADAY 02180I 18 200MAWK 02190I 21 220MADOW 02200I*------------------------------------------------------------------- 02210I GG 03 02220C******************************************************************** 02230C* INITIALIZE. 02240C EXSR SR101 02250C*------------------------------------------------------------------- ÐÐ02260C START TAG 02270C* REQUEST WORK ORDER PRIME. 02280C EXSR SR110 RQST WO PRIME 02290C 90 GOTO END 02300C*------------------------------------------------------------------- 02310C TAG2 TAG 02320C* REQUEST WO-DASH. 02330C EXSR SR111 02340C 92 GOTO START 02350C 90 GOTO END 02360C MOVEL'WO' W13A 13 02370C MOVE ORDER W13A 02380C W13A CHAINORDERLOG 60 02390C N60 OLSTAT COMP 'D' 60 02400C 60 Z-ADD5 M 02410C 60 EXSR SR73 FLAG ERROR 02420C 60 GOTO START 02430C MOVE 'A' A29,1 02440C MOVE OLTYPE A29,2 02450C MOVEAORDER A29,3 02460C MOVEAA29,1 W29A 29 02470C W29A SETLLALTKEY 02480C MOVEAA29 MATCH 2 02490C*------------------------------------------------------------------- 02500C TAG4 TAG ÐÐ02510C SETOF 54 02520C READ ALTKEY 54 02530C 54 GOTO START 02540C AKORD COMP ORDER 54 02550C 54 AKREC COMP MATCH 54 02560C N54 GOTO START 02570C AKSTAT COMP 'D' 54 02580C 54 GOTO TAG4 02590C MOVELAKPN W12A 02600C MOVE ' ' W12A 02610C W12A CHAINPMMST2 60 GET PART MAST 02620C N60 PMSTAT COMP 'D' 60 02630C 60 GOTO TAG4 02640C SETON 78 02650C Z-ADDPMOHB STKQTY 70 54 02660C N54 Z-ADD0 STKQTY 02670C EXSR SR80 GET EXCPTN MAST 02680C Z-ADDSTKQTY AVAIL 70 OVERALL AVAIL BAL 02690C Z-ADDSTKQTY SAVAIL 70 AVAIL STOCK BAL 02700C Z-ADD0 FBO 40 02710C Z-ADD0 FPLUS 40 02720C Z-ADD0 FNEG 40 02730C MOVELSXPN KEYSF 29 02740C KEYSF SETLLSFMAST 02750C*------------------------------------------------------------------- ÐÐ02760C TAG10 TAG 02770C SETOF 54 02780C READ SFMAST 54 02790C 54 GOTO TAG600 02800C SFPN COMP PMPN 54 02810C N54 GOTO TAG600 02820C SFSTAT COMP 'D' 54 02830C N54 SFSTAT COMP 'R' 54 02840C 54 GOTO TAG10 02850C EXSR SR102 CLASSIFY SFMAST 02860C 01 GOTO TAG110 RPO 02870C 02 GOTO TAG120 REL WO 02880C 03 GOTO TAG130 PO 02890C 04 GOTO TAG140 PLAN WO 02900C 05 GOTO TAG150 PUR REQ 02910C 06 GOTO TAG160 SO 02920C 07 GOTO TAG170 REL RQMT 02930C 08 GOTO TAG180 PLAN RQMT 02940C 09 GOTO TAG190 RUN REL 02950C GOTO TAG500 02960C*------------------------------------------------------------------- 02970C TAG110 TAG 02980C* RECEIVED PO. 02990C SETON 76 RPO FLAG 03000C EXSR SR201 PLUS AVAIL ÐÐ03010C EXSR SR203 NOT INSPECTED 03020C EXSR SR210 BO IN INSP 03030C EXSR SR212 SURPLUS 03040C EXSR SR213 SHORTAGE 03050C GOTO TAG500 03060C*------------------------------------------------------------------- 03070C TAG120 TAG 03080C* REL WO. 03090C EXSR SR201 PLUS AVAIL 03100C EXSR SR204 PAST DUE 03110C EXSR SR212 SURPLUS 03120C EXSR SR213 SHORTAGE 03130C GOTO TAG500 03140C*------------------------------------------------------------------- 03150C TAG130 TAG 03160C* PURCH ORDER. 03170C EXSR SR201 PLUS AVAIL 03180C EXSR SR204 PAST DUE 03190C EXSR SR212 SURPLUS 03200C EXSR SR213 SHORTAGE 03210C GOTO TAG500 03220C*------------------------------------------------------------------- 03230C TAG140 TAG 03240C* PLAN WO. 03250C EXSR SR105 START MDAY ÐÐ03260C EXSR SR201 PLUS AVAIL 03270C EXSR SR204 PAST DUE 03280C EXSR SR205 NOT REL 03290C EXSR SR212 SURPLUS 03300C EXSR SR213 SHORTAGE 03310C GOTO TAG500 03320C*------------------------------------------------------------------- 03330C TAG150 TAG 03340C* PUR REQ. 03350C EXSR SR201 PLUS AVAIL 03360C EXSR SR204 PAST DUE 03370C EXSR SR206 NOT PLACED 03380C EXSR SR212 SURPLUS 03390C EXSR SR213 SHORTAGE 03400C GOTO TAG500 03410C*------------------------------------------------------------------- 03420C TAG160 TAG 03430C* SALES ORDER. 03440C EXSR SR202 MINUS AVAIL 03450C EXSR SR204 PAST DUE 03460C EXSR SR208 BO 03470C EXSR SR210 BO IN INSP 03480C EXSR SR213 SHORTAGE 03490C GOTO TAG500 03500C*------------------------------------------------------------------- ÐÐ03510C TAG170 TAG 03520C* REL REQMT. 03530C EXSR SR202 MINUS AVAIL 03540C EXSR SR204 PAST DUE 03550C EXSR SR208 BACKORDER 03560C EXSR SR210 BO IN INSP 03570C EXSR SR213 SHORTAGE 03580C GOTO TAG500 03590C*------------------------------------------------------------------- 03600C TAG180 TAG 03610C* PLAN REQMT. 03620C EXSR SR202 MINUS AVAIL 03630C EXSR SR204 PAST DUE 03640C EXSR SR213 SHORTAGE 03650C GOTO TAG500 03660C*------------------------------------------------------------------- 03670C TAG190 TAG 03680C* RUN REL. 03690C EXSR SR202 MINUS AVAIL 03700C EXSR SR204 PAST DUE 03710C EXSR SR213 SHORTAGE 03720C GOTO TAG500 03730C*------------------------------------------------------------------- 03740C TAG500 TAG 03750C* UPDATE SFMAST. ÐÐ03760C EXSR SR83 UPDATE SFMAST 03770C GOTO TAG10 GET NEXT 03780C*------------------------------------------------------------------- 03790C TAG600 TAG 03800C* COMPUTE FINAL EXCEPTIONS. 03810C EXSR SR301 TO BE ORD 03820C EXSR SR302 NEG ON HAND 03830C EXSR SR303 SURPLUS 03840C EXSR SR81 UPD SFEMAST 03850C GOTO TAG4 03860C*------------------------------------------------------------------- 03870C END TAG 03880C MOVEL'Q059DP' PROG 8 03890C EXITFCHAIN 03900C RLABL PROG 03910C******************************************************************** 03920CSR SR73 BEGSR 03930C* PUT MSG TO PRINT. 03940CSR M CHAINMGFILE 54 03950CSR 54 MOVE BLK35 MGTEXT 03960CSR SETON 73 03970CSR EXCPT 03980CSR SETOF 73 03990CSR ENDSR 04000C******************************************************************** ÐÐ04010CSR SR80 BEGSR 04020C* GET EXCEPTION MASTER. 04030CSR SXPN CHAINSFEMAST 54 GET SFEMAST 04040CSRN54 GOTO END80 04050CSR Z-ADD0 EXC 04060CSR SETON 82 04070CSR EXCPT ADD SFEMAST 04080CSR SETOF 82 04090CSR GOTO SR80 04100CSR END80 ENDSR 04110C******************************************************************** 04120CSR SR81 BEGSR 04130C* REWRITE SFEMAST. 04140CSR SETON 81 04150CSR EXCPT REWRITE SFEMAST 04160CSR SETOF 81 04170CSR ENDSR 04180C******************************************************************** 04190CSR SR83 BEGSR 04200C* UPDATE SFMAST. 04210CSR SETON 83 04220CSR EXCPT UPDATE SFMAST 04230CSR SETOF 83 04240CSR ENDSR 04250C******************************************************************** ÐÐ04260CSR SR85 BEGSR 04270C* GET CALENDAR RECORD. 04280CSR W7A CHAINCALENDAR 60 04290CSR ENDSR 04300C******************************************************************** 04310CSR SR101 BEGSR 04320C* INITIALIZE. 04330CSR MOVE ' ' BLK35 35 04340CSR MOVE BIT,1 NUL 04350CSR MOVE ' ' BLK20 20 04360CSR MOVELUDATE W4N 40 04370CSR MOVE UDATE W2N 20 04380CSR MOVELW2N TODAY 60 04390CSR MOVE W4N TODAY 04400CSR Z-ADDTODAY W6N 04410CSR EXSR SR401 GET MDAY 04420CSR Z-ADDCAMDAY MNOW 40 04430C* 04440C* 04450CSR ENDSR 04460C******************************************************************** 04470CSR SR102 BEGSR 04480C* CLASSIFY SFMAST. 04490CSR SETOF 101112 04500CSR SETOF 131415 ÐÐ04510CSR SETOF 16 04520CSR SFREC COMP 10 01 RPO 04530CSR SFREC COMP 20 02 RWO 04540CSR SFREC COMP 30 03 PO 04550CSR SFREC COMP 40 04 PWO 04560CSR SFREC COMP 50 05 PR 04570CSR SFREC COMP 60 06 SO 04580CSR SFREC COMP 70 07 RRQMT 04590CSR SFREC COMP 80 08 PRQMT 04600CSR SFREC COMP 90 09 RR 04610CSR 01 04620COR 02 04630COR 03 04640COR 04 04650COR 05 SETON 10 ON ORD FLAG 04660CSR 06 04670COR 07 04680COR 08 04690COR 09 SETON 11 RQMT FLAG 04700CSR 01 04710COR 03 04720COR 05 SETON 12 PUR ON ORDER 04730CSR 02 04740COR 04 SETON 13 WO ON ORDER 04750CSR 07 ÐÐ04760COR 08 SETON 14 WO REQMT 04770CSR MOVELPMSC W1A 1 04780CSR W1A COMP 'P' 15 PURCH 04790CSRN15 SETON 16 MFG 04800CSR EXSR SR103 GET DLT MDAY 04810CSR EXSR SR104 GET DUE MDAY 04820CSR ENDSR 04830C******************************************************************** 04840CSR SR103 BEGSR 04850C* GET DATE LAST TRAN MDAY. 04860CSR SFDLT COMP 0 54 04870CSRN54 Z-ADDTODAY SFDLT 04880CSR Z-ADDSFDLT W6N 60 04890CSR EXSR SR401 GET MDAY 04900CSR Z-ADDCAMDAY MDLT 40 04910CSR ENDSR 04920C******************************************************************** 04930CSR SR104 BEGSR 04940C* GET DUE DATE MDAY. 04950CSR SFDUE COMP 0 54 04960CSRN54 Z-ADDTODAY SFDUE 04970CSR Z-ADDSFDUE W6N 04980CSR EXSR SR401 04990CSR Z-ADDCAMDAY MDUE 40 05000CSR ENDSR ÐÐ05010C******************************************************************** 05020CSR SR105 BEGSR 05030C* GET START DATE MDAY. 05040CSR Z-ADDSFSTRT W6N 54 05050CSRN54 Z-ADDMNOW MSTART 40 05060CSRN54 GOTO END105 05070CSR EXSR SR401 GET MDAY 05080CSR Z-ADDCAMDAY MSTART 05090CSR END105 ENDSR 05100C******************************************************************** 05110CSR SR201 BEGSR 05120C* PLUS AVAIL BAL. 05130CSR AVAIL COMP 0 575859 05140CSR SFQTY SUB SFQTYC BALQTY 70 54 05150CSRN54 Z-ADD0 BALQTY 05160CSR BALQTY ADD AVAIL AVAIL 70 05170CSR 01 BALQTY ADD RPOQTY RPOQTY 70 05180CSR AVAIL COMP 0 545556 05190CSR 54N57 Z-ADDMDUE FPLUS 40 05200CSR 55N58 Z-ADDMDUE FNEG 40 05210CSR ENDSR 05220C******************************************************************** 05230CSR SR202 BEGSR 05240C* MINUS AVAIL BAL. 05250CSR AVAIL COMP 0 575859 ÐÐ05260CSR SFQTY SUB SFQTYC BALQTY 54 05270CSRN54 Z-ADD0 BALQTY 05280CSR AVAIL SUB BALQTY AVAIL 05290CSR SAVAIL SUB BALQTY SAVAIL 05300CSR AVAIL COMP 0 545556 05310CSR 54N57 Z-ADDMDUE FPLUS 05320CSR 55N58 Z-ADDMDUE FNEG 05330CSR SFBOF COMP 'B' 54 05340CSR 54 SETON 77 BO FLAG 05350CSR ENDSR 05360C******************************************************************** 05370CSR SR203 BEGSR 05380C* FLAG NOT INSPECTED IF: 05390C* 1) IN INSPECT 10-DAYS, REGARDLESS OF DUE DATE. 05400CSR MNOW SUB MDLT W4N 40 05410CSR W4N COMP 5 54 54 05420CSRN54 GOTO END203 05430CSR EXC,12 COMP MDLT 54 05440CSR 54 Z-ADDMDLT EXC,11 NOT INSP 05450CSR END203 ENDSR 05460C******************************************************************** 05470CSR SR204 BEGSR 05480C* FLAG PAST DUE IF: 05490C* 1) TODAY'S DATE IS GT DUE DATE. 05500CSR MNOW COMP MDUE 54 ÐÐ05510CSRN54 GOTO END204 05520CSR 12 EXC,3 COMP MDUE 54 05530CSR 13 EXC,4 COMP MDUE 54 05540CSR 07 EXC,5 COMP MDUE 54 05550CSR 08 EXC,6 COMP MDUE 54 05560CSR 06 EXC,7 COMP MDUE 54 05570CSR 09 EXC,8 COMP MDUE 54 05580CSR 12N54 Z-ADDMDUE EXC,3 05590CSR 13N54 Z-ADDMDUE EXC,4 05600CSR 07N54 Z-ADDMDUE EXC,5 05610CSR 08N54 Z-ADDMDUE EXC,6 05620CSR 06N54 Z-ADDMDUE EXC,7 05630CSR 09N54 Z-ADDMDUE EXC,8 05640CSR END204 ENDSR 05650C******************************************************************** 05660CSR SR205 BEGSR 05670C* FLAG NOT RELEASED. 05680CSR MSTART SUB 5 W4N 40 05690CSR MNOW COMP W4N 54 05700CSRN54 GOTO END205 05710CSR EXC,9 COMP MSTART 54 05720CSR 54 Z-ADDMSTART EXC,9 NOT REL 05730CSR END205 ENDSR 05740C******************************************************************** 05750CSR SR206 BEGSR ÐÐ05760C* FLAG PUR REQ NOT PLACED. 05770CSR MDLT COMP MDUE 54 05780CSRN54 MNOW SUB MDLT W4N 05790CSRN54 W4N COMP 10 54 05800CSRN54 GOTO END206 05810CSR EXC,10 COMP MDUE 54 05820CSR 54 Z-ADDMDUE EXC,10 05830CSR END206 ENDSR 05840C******************************************************************** 05850CSR SR208 BEGSR 05860C* FLAG BACKORDER. 05870CSR SFBOF COMP 'B' 54 05880CSRN54 GOTO END208 NOT BO 05890CSRN15 Z-ADDSFDUE EXC,13 MFG 05900CSR 15 Z-ADDSFDUE EXC,12 PURCH 05910CSR FBO COMP 0 54 05920CSRN54 Z-ADDMDUE FBO 40 05930CSR END208 ENDSR 05940C******************************************************************** 05950CSR SR210 BEGSR 05960C* FLAG BO IN RCVG INSP. 05970CSR 01 77 05980COR 11 76 GOTO T210A 05990CSR GOTO END210 06000C*------------------------------------------------------------------- ÐÐ06010CSR T210A TAG 06020CSR 11 EXC,14 COMP FBO 54 06030CSR 11 54 Z-ADDFBO EXC,14 06040CSR END210 ENDSR 06050C******************************************************************** 06060CSR SR212 BEGSR 06070C* FLAG SURPLUS. 06080CSR AVAIL COMP 0 54 06090CSRN54 GOTO END212 06100CSR MDUE SUB FPLUS W4N 06110CSR W4N COMP PMSHSP 54 54 SURPLUS TIME LIMIT 06120CSRN54 GOTO END212 06130CSR EXC,17 COMP MDUE 54 06140CSR 54 Z-ADDMDUE EXC,17 06150CSR 54 01 Z-ADDMNOW EXC,17 06160CSR END212 ENDSR 06170C********************************************************************* 06180CSR SR213 BEGSR 06190C* FLAG SHORTAGE. 06200CSR AVAIL COMP 0 54 54 06210CSR 54 GOTO END213 06220CSR Z-ADDMDUE W4N 06230CSR 01 Z-ADDMNOW W4N 06240CSR W4N SUB FNEG W4N 06250CSR W4N COMP PMSHSP 54 54 SHRTG LIMIT ÐÐ06260CSRN54 GOTO END213 06270CSR EXC,18 COMP MDUE 54 06280CSR 54 Z-ADDMDUE EXC,18 06290CSR 54 Z-ADDMNOW EXC,18 06300CSR END213 ENDSR 06310C******************************************************************** 06320CSR SR301 BEGSR 06330C* FLAG TO BE ORDERED. 06340CSR AVAIL COMP 0 54 L.T. 06350CSRN54 GOTO END301 06360CSR 15 Z-ADDFNEG EXC,1 PURCH 06370CSRN15 Z-ADDFNEG EXC,2 MFG 06380CSR END301 ENDSR 06390C******************************************************************** 06400CSR SR302 BEGSR 06410C* FLAG NEG ON HAND BAL. 06420CSR PMOHB COMP 0 54 L.T. 06430CSR 54 Z-ADD1 EXC,16 NEG ON HAND 06440CSR ENDSR 06450C******************************************************************** 06460CSR SR303 BEGSR 06470C* FLAG SURPLUS. 06480CSR AVAIL COMP 0 54 06490CSRN54 GOTO END303 06500CSR MDUE SUB FPLUS W4N 40 ÐÐ06510CSR W4N COMP PMSSP 54 54 06520CSR 54 Z-ADDMDUE EXC,17 FLAG SURPLUS 06530CSR END303 ENDSR 06540C******************************************************************** 06550CSR SR401 BEGSR 06560C* GET CALENDAR BY CAL DATE. 06570CSR MOVE BLK20 W7A 7 06580CSR MOVEL'C' W7A 06590CSR MOVE W6N W7A 06600CSR EXSR SR85 GET CALENDAR 06610CSR 60 Z-ADDMNOW CAMDAY 06620CSR ENDSR 06630O******************************************************************** 06640OSFMAST E 83 06650O SFQTY 33P 06660O SFQTYC 37P 06670O SFCUST 46P 06680O SFQPA 60P 06690O SFPULL 64P 06700O SFQTYA 70P 06710O SFPRIC 95P 06720O SFSEQ 97P 06730O SAVAIL 123P 06740O AVAIL 127P 06750O******************************************************************** ÐÐ06760OTERM132 E 73 06770O NUL 132 06780O MGTEXT 35 06790O 37 ' ' 06800O BIT,8 132 06810O******************************************************************** 06820OSFEMAST EADD 82 06830O PMPN 10 06840O EXC 110B 06850O PMLL 127 06860O*------------------------------------------------------------------- 06870O E 81 06880O EXC 110B 06890O PMLL 127 06900O******************************************************************** ** NUL ARRAY 006910 006920** A29 ARRAY 006930 006940/* 006950_‚ ÐÐ_‚_‚0OTERM132 E 73 06770O NUL 132 06780O MGTEXT 35 06790O 37 ' ' 06800O BIT,8 132 06810O******************************************************************** 06820OSFEMAST EADD 82 06830O PMPN 10 06840O EXC 110B 06850O PMLL 127 06860O*------------------------------------------------------------------- 06870O E 81 06880O EXC 110B 06890O PMLL 127 06900O******************************************************************** ** NUL ARRAY 006910 006920** A29 ARRAY 006930 006940/* 006950_‚ ÐÈ(2[| 2X217SF P120282120282(èÈÐ00010H Q217SF00020F* CREATE GUIDE FILE FOR EXPLOSION 00030F* REVISED 4/22/81 5:00 PM. 00040FPMMST2 IP F 674 12AI 1 DISK 00050FSFLOWLEVO F 13 12AI 1 DISK 00060I******************************************************************** 00070IPMMST2 PM 01 674NCD 94 CM 00080I 1 100PMPN 00090I 430 4310PMLL 00100I*------------------------------------------------------------------- 00110I GG 02 00120C****************************************************************** 00130O****************************************************************** 00140OSFLOWLEVD 01 00150O PMLL 2 00160O PMPN 12 /* 000170_‚ ÐÐ ÐÐ_‚_‚ ÐÈ(<[’ <X218SF P120282120282(èÈÐ00010H Q218SF00020F* COPY SCHEDULE MAST FILE. DROP PLAN WORK ORDERS AND PLAN REQUIRE- 00030F* MENTS WHERE REQUIREMENT FLAG NOT EQUAL TO 'S' 00040F* 00050FOSFMAST IP F 128 29AI 1 DISK 00060FSFMAST O F 128 29AI 1 DISK 00070I**************************************************************** 00080IOSFMAST SO 01 00090I 1 128 RECORD 00100I 17 18 RECCOD 00110I 104 104 REQFLG 00120I 128 128 STAT 00130C****************************************************************** 00140C STAT COMP 'D' 54 00150C N54 RECCOD COMP '40' 55 00160C N54 55 STAT COMP 'R' 54 00170C 54 GOTO DELETE 00180C RECCOD COMP '40' 54 00190C N54 RECCOD COMP '80' 54 00200C 54 REQFLG COMP 'S' 55 00210C 54N55 GOTO DELETE 00220C GOTO END 00230C*----------------------------------------------------------------- 00240C DELETE TAG 00250C SETOF 01 ÐÐ00260C*----------------------------------------------------------------- 00270C END TAG 00280O****************************************************************** 00290OSFMAST D 01 00300O RECORD 128 00310O STAT 128 /* 000320_‚ ÐÐ _‚_‚ ÐÈ(–[¬ –?X219SF P120282120282(èÈÐ00010H Q219SF00020F* ADD RECORDS IN NEWSFREQ FILE TO SFMAST AND UPDATE ALTKEY. 00030F* REVISED 8/13/81 3:30 PM. 00040FNEWSFREQUP F 128 DISK 00050FSFMAST UC F 128R29AI 1 DISK A 00060FALTKEY UC F 32R29AI 1 DISK A 00070E A29 1 29 1 00080E KEY 29 1 00090I******************************************************************** 00100INEWSFREQSQ 30 00110I 30 128 RECORD 00120I 1 29 KEY 70 00130I 17 18 RECCOD 00140I 98 103 START 00150I P 30 330QTY 00160I 128 128 STAT 00170I******************************************************************** 00180ISFMAST SF 00190I 17 18 SFREC 00200I P 30 330SFQTY 00210I 128 128 SFSTAT 00220I******************************************************************** 00230IALTKEY AK 00240I 1 2 AKREC 00250I 32 32 AKSTAT Ð