(  TXOE010 P999999032778(000010H S OE010 00020X DECK-ID A45 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE010 00030F* THIS PROGRAM IS USED FOR INQUIRY/MAINTENANCE OF ARMAST FILE OE010 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE010 00060F* CONTROL DATA PROPRIETARY PRODUCT OE010 00070F* OE010 0000080FNULL IPEAF 72 DISK OE010 00090F@DIS10 IC F 32R DISK OE010 00100FARMAST UC F 0280R06AI 0001 DISK A OE010 00110E FN 050 22 FIELD NAME OE010 00120E CP 050 4 CURSOR POSITION OE010 00130E LN 050 2 0 LENGTH OE010 00140E EP 050 4 0 ENDING POSITION OE010 0000150INULL NS 01 OE010 00160I 1 1 A OE010 00170I@DIS10 NS 02 OE010 00180I 1 22 FIELDN OE010 00190I 23 26 CURPOS OE010 00200I 27 280LNGTH OE010 00210I 29 310ENDPOS OE010 0000220IARMAST NS 03 OE010 00230I 10256 RECORD OE010 00240I 2570280 LEFT01 OE010 00250C MOVE ' ' RCODE 1 OE010 00260C MOVE RCODE B22 22 OE010 00270C MOVE RCODE BLANKS 72 OE010 00280C MOVE RCODE FILLER 1 OE010 0000290C Z-ADD0 MASK 10 OE010 00300C SETON LR OE010 00310CLR Z-ADD050 SSIZE 30 OE010 00320CLR Z-ADD006 NSECT 30 OE010 00330CLR MOVEL'D' FF 1 OE010 00340CLR MOVE '[]<>' TEMP4 4 OE010 00350CLR START TAG OE010 0000360C* ********** OE010 00370CLR EXSR FIRSTP OE010 00380C* ********** OE010 00390CLR EXSR CLRSCR OE010 00400C* ********** OE010 00410CLR 40 GOTO EOJ OE010 00420C* ********** OE010 0000430CLR Z-ADD2 VL OE010 00440CLR MOVELSECTON VAR OE010 00450CLR EXSR RTADJ OE010 00460C* ********** OE010 00470CLR MOVELVAR SECTN 20 OE010 00480CLR EXSR GETSEC OE010 00490C* ********** OE010 0000500CLRN45 GOTO START OE010 00510C* ********** OE010 00520CLR EXSR CLRSCR OE010 00530C* ********** OE010 00540CLR EXSR OUTPUT OE010 00550C* ********** OE010 00560CLR EXSR UPDATE OE010 0000570C* ********** OE010 00580CLR GOTO START OE010 00590C* ********** OE010 00600CLR EOJ TAG OE010 00610C* ********** OE010 00620C********************************************************************OE010 00630C* OE010 0000640C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE010 00650C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE010 00660C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE010 00670C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE010 00680C* OE010 00690C********************************************************************OE010 00700CSR FIRSTP BEGSR OE010 0000710C* ********** OE010 00720CSR EXSR CLRSCR OE010 00730C* ********** OE010 00740CSR Z-ADD0 SECTN OE010 00750CSR EXSR GETSEC OE010 00760C* ********** OE010 00770CSR PGE TAG OE010 0000780C* ********** OE010 00790CSR SETON 61 OE010 00800CSR SETOF 62 OE010 00810CSR EXSR OUTPUT OE010 00820C* ********** OE010 00830CSR EXIT SUBRFL OE010 00840CSR RLABL RECORD OE010 0000850CSR RLABL FILLER 1 OE010 00860C* ********** OE010 00870C* ********** OE010 00880CSR EXIT SUBRFL OE010 00890CSR RLABL LEFT01 OE010 00900CSR RLABL FILLER 1 OE010 00910C* ********** OE010 0000920C* ********** OE010 00930C* ********** OE010 00940C* ********** OE010 00950C* ********** OE010 00960C* ********** OE010 00970C* ********** OE010 00980C* ********** OE010 0000990C* ********** OE010 01000C* ********** OE010 01010C* ********** OE010 01020C* ********** OE010 01030C* ********** OE010 01040C* ********** OE010 01050CSR Z-ADD06 NCHARS OE010 0001060CSR Z-ADD1 SSTRT OE010 01070CSR Z-ADD0001 TSTRT OE010 01080C* ********** OE010 01090CSR EXIT SUBRLM OE010 01100CSR RLABL KEY 06 OE010 01110CSR RLABL SSTRT 30 OE010 01120CSR RLABL RECORD OE010 0001130CSR RLABL TSTRT 30 OE010 01140CSR RLABL NCHARS 30 OE010 01150CSR Z-ADDNOFLDS SVFLDS 30 OE010 01160CSR Z-ADDSX NOFLDS OE010 01170CSR EXSR UPDATE OE010 01180C* ********** OE010 01190CSR Z-ADDSVFLDS NOFLDS OE010 0001200CSR Z-ADD06 NCHARS OE010 01210CSR Z-ADD0001 SSTRT OE010 01220CSR Z-ADD1 TSTRT OE010 01230C* ********** OE010 01240CSR EXIT SUBRLM OE010 01250CSR RLABL RECORD OE010 01260CSR RLABL SSTRT 30 OE010 0001270CSR RLABL KEY OE010 01280CSR RLABL TSTRT 30 OE010 01290CSR RLABL NCHARS 30 OE010 01300CSR KEY CHAINARMAST 55 OE010 01310CSR MOVELSAVPOS BUFFER OE010 01320CSR MOVELOFC BUFFER OE010 01330CSR EXSR POSCUR OE010 0001340C* ********** OE010 01350CSR MOVEL'] NEW R'WORD16 16 OE010 01360CSR MOVE 'ECORD 'WORD16 OE010 01370CSRN55 MOVELBLANKS WORD16 OE010 01380CSRN55 MOVEL']' WORD16 OE010 01390CSR MOVELWORD16 BUFFER 72 OE010 01400CSR MOVE 'T' TYPE 1 OE010 0001410CSR Z-ADD13 BLNGTH 20 OE010 01420CSR EXSR CRTCOM OE010 01430C* ********** OE010 01440CSR SETON 62 OE010 01450CSR Z-ADDSX X 30 OE010 01460CSR EXSR ACCEPT OE010 01470C* ********** OE010 0001480CSR MOVELBUFFER SECTON 2 OE010 01490CSR SECTON COMP 'E ' 40 OE010 01500CSR 40 GOTO ENDFP OE010 01510C* ********** OE010 01520CSR SECTON COMP 'D ' 40 OE010 01530CSR 40N55 EXCPT OE010 01540CSR 40 GOTO PGE OE010 0001550C* ********** OE010 01560CSR SECTON COMP ' 1' 30 30 OE010 01570CSR 30 SECTON COMP ' 9' 3030 OE010 01580CSR 30 GOTO GOOD OE010 01590C* ********** OE010 01600CSR SECTON COMP '01' 30 30 OE010 01610CSR 30 SECTON COMP '09' 3030 OE010 0001620CSR 30 GOTO GOOD OE010 01630C* ********** OE010 01640CSR SECTON COMP '1 ' 30 30 OE010 01650CSR 30 SECTON COMP '9 ' 3030 OE010 01660CSR 30 GOTO GOOD OE010 01670C* ********** OE010 01680CSR MOVELSECTON TEMP1 1 OE010 0001690CSR TEMP1 COMP '1' 30 30 OE010 01700CSR 30 TEMP1 COMP '9' 3030 OE010 01710CSRN30 GOTO PGE OE010 01720C* ********** OE010 01730CSR MOVE SECTON TEMP1 OE010 01740CSR TEMP1 COMP '0' 30 30 OE010 01750CSR 30 TEMP1 COMP '9' 3030 OE010 0001760CSRN30 GOTO PGE OE010 01770C* ********** OE010 01780CSR GOOD TAG OE010 01790C* ********** OE010 01800CSR SETOF 6162 OE010 01810CSRN55 GOTO ENDFP OE010 01820C* ********** OE010 0001830CSR SETON 80 OE010 01840CSR EXCPT OE010 01850CSR SETOF 80 OE010 01860CSR KEY CHAINARMAST 55 OE010 01870CSR ENDFP ENDSR OE010 01880C* ********** OE010 01890C********************************************************************OE010 0001900C* OE010 01910C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE010 01920C* OE010 01930C********************************************************************OE010 01940CSR GETSEC BEGSR OE010 01950C* ********** OE010 01960CSR 1 ADD SECTN N 20 OE010 0001970CSR SETOF 404145 OE010 01980CSR N COMP 0 3030 OE010 01990CSRN30 N COMP NSECT 30 OE010 02000CSR 30 GOTO ENDGET OE010 02010C* ********** OE010 02020CSR SECTN MULT SSIZE RRN 40 OE010 02030CSR Z-ADD1 X OE010 0002040CSR SCLOOP TAG OE010 02050C* ********** OE010 02060CSR RRN ADD 1 RRN OE010 02070CSR RRN CHAIN@DIS10 50 OE010 02080CSR 50 GOTO ENDGET OE010 02090C* ********** OE010 02100CSR FIELDN COMP B22 4141 OE010 0002110CSRN41 GOTO ENDGET OE010 02120C* ********** OE010 02130CSR 41N45 SETON 45 OE010 02140CSR MOVE FIELDN FN,X OE010 02150CSR MOVE CURPOS CP,X OE010 02160CSR MOVE LNGTH LN,X OE010 02170CSR Z-ADDENDPOS EP,X OE010 0002180CSR 1 ADD X X OE010 02190CSR X COMP SSIZE 32 OE010 02200CSRN32 GOTO SCLOOP OE010 02210C* ********** OE010 02220CSR ENDGET TAG OE010 02230C* ********** OE010 02240CSR Z-ADDX NOFLDS 30 OE010 0002250CSR 45 GOTO FINGET OE010 02260C* ********** OE010 02270CSR EXSR CLRSCR OE010 02280C* ********** OE010 02290CSR MOVEL'SECT # 'WORD9 9 OE010 02300CSR Z-ADD16 BLNGTH OE010 02310CSR MOVE SECTN WORD9 OE010 0002320CSR MOVELWORD9 WORD16 OE010 02330CSRN30 MOVE ' ABSENT' WORD16 OE010 02340CSR 30 MOVE ' ILLEG.' WORD16 OE010 02350CSR MOVELWORD16 BUFFER OE010 02360CSR MOVEL'T' TYPE OE010 02370CSR EXSR CRTCOM OE010 02380C* ********** OE010 0002390CSR FINGET ENDSR OE010 02400C* ********** OE010 02410C********************************************************************OE010 02420C* OE010 02430C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE010 02440C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE010 02450C* SECTION INDEX IS SAVED. OE010 0002460C* OE010 02470C********************************************************************OE010 02480CSR OUTPUT BEGSR OE010 02490C* ********** OE010 02500CSR EXSR CLRSCR OE010 02510C* ********** OE010 02520CSR Z-ADD1 X OE010 0002530CSR 61 SETON 63 OE010 02540CSR OTLOOP TAG OE010 02550C* ********** OE010 02560CSR 61 LN,X COMP 0 31 OE010 02570CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE010 02580CSR EXSR OUTFLD OE010 02590C* ********** OE010 0002600CSR X ADD 1 X OE010 02610CSR X COMP NOFLDS 31 OE010 02620CSR 31 GOTO OTLOOP OE010 02630C* ********** OE010 02640CSR SETOF 63 OE010 02650CSR ENDSR OE010 02660C********************************************************************OE010 0002670C* OE010 02680C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE010 02690C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE010 02700C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE010 02710C* THEN NO FIELD INFORMATION IS PRINTED OE010 02720C* OE010 02730C********************************************************************OE010 0002740CSR OUTFLD BEGSR OE010 02750C* ********** OE010 02760CSR MOVE FN,X FL 20 OE010 02770CSR EP,X COMP 0 98 OE010 02780CSR MOVELCP,X FC 20 OE010 02790CSR FC COMP FL 31 OE010 02800CSR 31 Z-ADDFC FL OE010 0002810CSR FC SUB FL CC 20 OE010 02820CSR CC ADD 1 CC OE010 02830CSR MOVELCP,X BUFFER OE010 02840CSR MOVELCC BUFFER OE010 02850CSR EXSR POSCUR OE010 02860C* ********** OE010 02870CSR MOVELBLANKS BUFFER OE010 0002880CSR MOVELFN,X FIELDN OE010 02890CSR MOVE ' ' FIELDN OE010 02900CSR MOVELFIELDN BUFFER OE010 02910CSR Z-ADDLN,X LEN 20 OE010 02920CSR LEN COMP 0 9730 OE010 02930CSR 97 Z-SUBLN,X LEN OE010 02940CSR 30 GOTO SKIPF OE010 0002950C* ********** OE010 02960CSR FL ADD 2 BPOS 20 OE010 02970C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE010 02980CSR Z-ADDBPOS TSTRT 30 OE010 02990CSRN98 Z-ADD1 SSTRT 30 OE010 03000CSR 98 Z-ADD3 SSTRT OE010 03010CSR Z-ADD1 NCHARS 30 OE010 0003020C* ********** OE010 03030CSR EXIT SUBRLM OE010 03040CSR RLABL TEMP4 OE010 03050CSR RLABL SSTRT 30 OE010 03060CSR RLABL BUFFER OE010 03070CSR RLABL TSTRT 30 OE010 03080CSR RLABL NCHARS 30 OE010 0003090CSR BPOS ADD 1 FPOS 20 OE010 03100CSR EXSR MVRECD OE010 03110C* ********** OE010 03120CSR SKIPF TAG OE010 03130C* ********** OE010 03140CSR 30 Z-ADDFL BLNGTH OE010 03150CSRN30 FL ADD 3 BLNGTH OE010 0003160CSRN30 BLNGTH ADD LEN BLNGTH OE010 03170CSR MOVE 'T' TYPE OE010 03180CSR EXSR CRTCOM OE010 03190C* ********** OE010 03200CSR ENDSR OE010 03210C********************************************************************OE010 03220C* OE010 0003230C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE010 03240C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE010 03250C* THE RIGHT BRACKET. OE010 03260C********************************************************************OE010 03270CSR MVRECD BEGSR OE010 03280C* ********** OE010 03290CSR 63 GOTO RBRK OE010 0003300C* ********** OE010 03310CSR 98 Z-SUBEP,X END 40 OE010 03320CSRN98 Z-ADDEP,X END OE010 03330CSR END SUB LEN STRT 40 81 81 OE010 03340CSR STRT ADD 1 STRT OE010 03350C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE010 03360C* FROM STRT IN RECORD TO FPOS IN BUFFER OE010 0003370CSR Z-ADDLEN NCHARS OE010 03380CSR Z-ADDSTRT SSTRT OE010 03390CSR Z-ADDFPOS TSTRT OE010 03400C* ********** OE010 03410CSRN81 GOTO RBRK OE010 03420CSR EXIT SUBRLM OE010 03430CSR RLABL RECORD OE010 0003440CSR RLABL SSTRT 30 OE010 03450CSR RLABL BUFFER OE010 03460CSR RLABL TSTRT 30 OE010 03470CSR RLABL NCHARS 30 OE010 03480CSR RBRK TAG OE010 03490C* ********** OE010 03500CSR EXSR RTBRKT OE010 0003510C* ********** OE010 03520CSR ENDSR OE010 03530C********************************************************************OE010 03540C* OE010 03550C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE010 03560C* OE010 03570C********************************************************************OE010 0003580CSR RTBRKT BEGSR OE010 03590C* ********** OE010 03600CSR LEN ADD FPOS FPOS OE010 03610CSR Z-ADDFPOS TSTRT OE010 03620CSR Z-ADD1 NCHARS OE010 03630CSRN98 Z-ADD2 SSTRT OE010 03640CSR 98 Z-ADD4 SSTRT OE010 0003650C* ********** OE010 03660CSR EXIT SUBRLM OE010 03670CSR RLABL TEMP4 OE010 03680CSR RLABL SSTRT 30 OE010 03690CSR RLABL BUFFER OE010 03700CSR RLABL TSTRT 30 OE010 03710CSR RLABL NCHARS 30 OE010 0003720CSR ENDSR OE010 03730C********************************************************************OE010 03740C* OE010 03750C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE010 03760C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE010 03770C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE010 03780C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE010 0003790C* OF THE FIELDS ARE LEFT UNCHANGED OE010 03800C* OE010 03810C********************************************************************OE010 03820CSR UPDATE BEGSR OE010 03830C* ********** OE010 03840CSR SETOF 32 OE010 03850CSR Z-ADD1 X OE010 0003860CSR UPLOOP TAG OE010 03870C* ********** OE010 03880CSR EP,X COMP 0 98 OE010 03890CSR 98 SETON 30 OE010 03900CSR 98 GOTO NOUPD OE010 03910C* ********** OE010 03920CSR Z-ADDLN,X LEN OE010 0003930CSR LEN COMP 0 9730 OE010 03940CSR 97 Z-SUBLEN LEN OE010 03950CSR NOUPD TAG OE010 03960C* ********** OE010 03970CSR 30N32 GOTO INCR OE010 03980C* ********** OE010 03990CSR 30 GOTO CHKRUB OE010 0004000C* ********** OE010 04010CSR SETOF 3233 OE010 04020CSR EXSR ACCEPT OE010 04030C* ********** OE010 04040CSR CHKRUB TAG OE010 04050C* ********** OE010 04060CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE010 0004070CSR 32 31 GOTO UPLOOP OE010 04080C* ********** OE010 04090CSR 32 GOTO ENDUPD OE010 04100C* ********** OE010 04110CSR MOVELBUFFER ATSIGN 1 OE010 04120CSR ATSIGN COMP '@' 35 OE010 04130CSR 35 GOTO OUTREC OE010 0004140C* ********** OE010 04150CSR 33 GOTO INCR WAS LINE FEED OE010 04160C* ********** OE010 04170CSR Z-ADDEP,X END OE010 04180CSR END SUB LEN STRT 81 81 OE010 04190CSR STRT ADD 1 STRT OE010 04200C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE010 0004210C* BUFFER TO THE STRT OF RECORD OE010 04220CSR Z-ADD1 SSTRT OE010 04230CSR Z-ADD1 SSTRT OE010 04240CSR Z-ADDSTRT TSTRT OE010 04250CSR Z-ADDLEN NCHARS OE010 04260C* ********** OE010 04270CSRN81 GOTO AAA OE010 0004280CSR EXIT SUBRLM OE010 04290CSR RLABL BUFFER OE010 04300CSR RLABL SSTRT 30 OE010 04310CSR RLABL RECORD OE010 04320CSR RLABL TSTRT 30 OE010 04330CSR RLABL NCHARS 30 OE010 04340CSR AAA TAG OE010 0004350CSR MOVELBUFFER TEMP5 5 OE010 04360CSR MOVELSAVPOS BUFFER OE010 04370CSR EXSR POSCUR OE010 04380C* ********** OE010 04390CSR MOVELTEMP5 BUFFER OE010 04400CSR Z-ADD1 FPOS OE010 04410CSR EXSR RTBRKT OE010 0004420C* ********** OE010 04430CSR LEN ADD 1 BLNGTH OE010 04440CSR MOVE 'T' TYPE OE010 04450CSR EXSR CRTCOM OE010 04460C* ********** OE010 04470CSR INCR TAG OE010 04480C* ********** OE010 0004490CSR X ADD 1 X OE010 04500CSR X COMP NOFLDS 30 OE010 04510CSR 30 GOTO UPLOOP OE010 04520C* ********** OE010 04530CSR OUTREC TAG OE010 04540C* ********** OE010 04550CSR SETON 80 OE010 0004560CSRN61 EXCPT OE010 04570CSR SETOF 80 OE010 04580CSR ENDUPD TAG OE010 04590C* ********** OE010 04600CSR ENDSR OE010 04610C********************************************************************OE010 04620C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE010 0004630C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE010 04640C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE010 04650C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE010 04660C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE010 04670C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE010 04680C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE010 04690C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE010 0004700C* TO BE OUTPUT TO THE SCREEN. OE010 04710C* OE010 04720C********************************************************************OE010 04730CSR ACCEPT BEGSR OE010 04740C* ********** OE010 04750CSR X COMP 1 30 OE010 04760CSRN30 X COMP SSIZE 30 OE010 0004770CSR 30 Z-ADD1 X OE010 04780CSR MOVELCP,X FC OE010 04790CSR FC ADD 3 FC OE010 04800CSR MOVELCP,X SAVPOS 4 OE010 04810CSR MOVELFC SAVPOS OE010 04820CSR Z-ADDLN,X LEN OE010 04830CSR LEN COMP 0 97 OE010 0004840CSR 97 Z-SUBLEN LEN OE010 04850CSR LEN ADD FC OFC 20 OE010 04860CSR ACLOOP TAG OE010 04870C* ********** OE010 04880CSR MOVELSAVPOS BUFFER OE010 04890CSR EXSR POSCUR OE010 04900C* ********** OE010 0004910CSR Z-ADDLEN BLNGTH OE010 04920CSR MOVE BLANKS BUFFER OE010 04930CSR MOVE 'A' TYPE OE010 04940CSR EXSR CRTCOM OE010 04950C* ********** OE010 04960CSR RCODE COMP 'R' 31 OE010 04970CSR 31 BUFFER COMP BLANKS 32 OE010 0004980CSR 31 32N62 GOTO DUPIT OE010 04990C* ********** OE010 05000CSR 31 GOTO ACLOOP OE010 05010C* ********** OE010 05020CSR RCODE COMP 'L' 33 OE010 05030CSR 33 GOTO DUPIT OE010 05040C* ********** OE010 0005050CSRN97 GOTO ENDACC OE010 05060C* ********** OE010 05070CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE010 05080CSR SIGN COMP '@' 30 OE010 05090CSR 30 GOTO ENDACC OE010 05100C* ********** OE010 05110CSR Z-ADDLEN VL 20 OE010 0005120CSR MOVELBUFFER VAR 15 OE010 05130CSR EXSR RTADJ OE010 05140C* ********** OE010 05150CSR MOVELVAR BUFFER OE010 05160CSR GOTO ENDACC OE010 05170C* ********** OE010 05180CSR DUPIT TAG OE010 0005190C* ********** OE010 05200CSR MOVELSAVPOS BUFFER OE010 05210CSR EXSR POSCUR OE010 05220C* ********** OE010 05230CSR 62 MOVELSECTON BUFFER OE010 05240CSRN62 Z-ADD1 FPOS OE010 05250CSRN62 EXSR MVRECD OE010 0005260C* ********** OE010 05270CSR MOVE 'T' TYPE OE010 05280CSR BLNGTH ADD 1 BLNGTH OE010 05290CSR EXSR CRTCOM OE010 05300C* ********** OE010 05310CSR ENDACC ENDSR OE010 05320C* ********** OE010 0005330C********************************************************************OE010 05340C* OE010 05350C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE010 05360C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE010 05370C* 4 DUMMY FOR RTADJ OE010 05380C* OE010 05390C********************************************************************OE010 0005400CSR POSCUR BEGSR OE010 05410C* ********** OE010 05420CSR MOVE 'P' TYPE OE010 05430CSR EXSR CRTCOM OE010 05440C* ********** OE010 05450CSR ENDSR OE010 05460C********************************************************************OE010 0005470CSR CLRSCR BEGSR OE010 05480C* ********** OE010 05490CSR MOVE 'C' TYPE OE010 05500CSR EXSR CRTCOM OE010 05510C* ********** OE010 05520CSR ENDSR OE010 05530C********************************************************************OE010 0005540CSR CRTCOM BEGSR OE010 05550C* ********** OE010 05560C* ********** OE010 05570CSR EXITFSUBRCM OE010 05580CSR RLABL BUFFER 72 OE010 05590CSR RLABL TYPE 1 OE010 05600CSR RLABL BLNGTH 20 OE010 0005610CSR RLABL RCODE 1 OE010 05620CSR RLABL MASK 10 OE010 05630CSR RLABL DTYPE 10 OE010 05640CSR ENDSR OE010 05650C********************************************************************OE010 05660CSR RTADJ BEGSR OE010 05670C* ********** OE010 0005680CSR EXIT SUBRAJ OE010 05690C* ********** OE010 05700CSR RLABL VL OE010 05710CSR RLABL VAR OE010 05720CSR ENDSR OE010 05730C********************************************************************OE010 05740OARMAST E 80N55 OE010 0005750O RECORD 0256 OE010 05760O LEFT01 0280 OE010 05770O E 40N80 OE010 05780O FF 115 OE010 05790O EADD 80 55 OE010 05800O RECORD 0256 OE010 05810O LEFT01 0280 OE010 00** 005820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005840ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005850ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005860/* 005870_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(A qTXOE022 Pr999999032778(000010H S OE022 00020X DECK-ID A48 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE022 00030F* PRINTS ALL ACTIVE PARTS IF U1 OFF, PRINTS FINISHED GOODS IF U1 ON OE022 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE022 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE022 00060F* CONTROL DATA PROPRIETARY PRODUCT OE022 00070F* OE022 0000080FPARTMST IPEAF 300 20AI 271 DISK OE022 00090FHEADING IT F 40 EDISK OE022 00100F$LP1 O F 132 OF PRINTER OE022 00110F********************************************************************OE022 00120F* OE022 00130F* PACKAGE DISTRIBUTION OE022 00140F* SYSTEM FILE MAINTENANCE OE022 0000150F* PROGRAM LISTS OUT ALL RECORDS IN PARTMST NOT FLAGGED OE022 00160F* FOR DELETION. IF U1 IS ON PRINT FINISHED GOODS ONLY. OE022 00170F* OE022 00180F* CONTRACTOR COMPUSOURCE OE022 00190F* PROGRAMMER T. MCCULLY OE022 00200F* DATE MAY 4, 1976 OE022 00210F* OE022 0000220F********************************************************************OE022 00230F* OE022 00240F* ID F C H L FUNCTION OF INDICATORS OE022 00250F* OE022 00260F* 01 RECORD NOT FLAGGED FOR DELETION OE022 00270F* 02 RECORD IS FLAGGED FOR DELETION OE022 00280F* NU1 PRINT ALL PARTS OE022 0000290F* U1 PRINT FINISHED GOODS ONLY OE022 00300F* OE022 00310F********************************************************************OE022 00320E HEADING HEAD 1 1 40 COMPANY NAME OE022 00330E PRC 5 7 3 PRICES OE022 00340I********************************************************************OE022 00350IPARTMST NS 01 74 C OE022 0000360I 271 290 PARTNO OE022 00370I 1 37 DESCRP OE022 00380I 38 39 UM OE022 00390I 40 40 CLASS OE022 00400I 41 430GROUP OE022 00410I 44 460LEAD OE022 00420I 47 490SAFETY OE022 0000430I 50 50 ABC OE022 00440I 51 51 INVTRY OE022 00450I 57 610VNDNUM OE022 00460I 62 73 VPTNUM OE022 00470I 75 813MATDLS OE022 00480I 89 953LABDLS OE022 00490I 96 1023BURDLS OE022 0000500I 103 1093OPDLS OE022 00510I 131 1373LABHRS OE022 00520I 181 1870MINROP OE022 00530I 188 1940MAXEOQ OE022 00540I 195 195 MINMAX OE022 00550I 210 2112ALPHA OE022 00560I 219 219 REVLTR OE022 0000570I 220 2250REVDAT OE022 00580I 226 260 PRC OE022 00590I 291 296 BIN OE022 00600I NS 02 OE022 00610I 1 1 AIR OE022 00620C********************************************************************OE022 00630C U1 01 CLASS COMP 'F' 01 OE022 0000640C N01 OE022 00650CORNU1 GOTO XDT OE022 00660C* FINISHED GOODS OE022 00670C MATDLS ADD LABDLS UNCOST 73 PROCESSED HEREOE022 00680C BURDLS ADD UNCOST UNCOST OE022 00690C OPDLS ADD UNCOST UNCOST OE022 00700C XDT TAG OE022 0000710C 01 COUNT ADD 1 COUNT 80 OE022 00720O********************************************************************OE022 00730O$LP1 H 202 1P OE022 00740O OR OF OE022 00750O PAGE Z 8 OE022 00760O 4 'PAGE' OE022 00770O HEAD,1 86 OE022 0000780O UDATE Y 132 OE022 00790O***** BELOW IS ALL PARTS REPORT. OE022 00800O H 2 1PNU1 OE022 00810O OR OFNU1 OE022 00820O 78 'PART MASTER FILE LISTING' OE022 00830O 132 'DIS022' OE022 00840O H 1 1PNU1 OE022 0000850O OR OFNU1 OE022 00860O 11 'PART NUMBER' OE022 00880O 54 'UM ALP LT ABC' OE022 00890O 76 'VEND # REV LTR' OE022 00900O 84 'MIN' OE022 00910O 104 'MATL $ LABOR $' OE022 00920O 114 'MIN/MAX' OE022 0000930O 121 'BIN #' OE022 00940O H 1 1PNU1 OE022 00950O OR OFNU1 OE022 00960O 59 '--------------------' OE022 00970O 79 '--------------------' OE022 00980O 99 '--------------------' OE022 00990O 114 '---------------' OE022 0001000O 121 '-------' OE022 01010O H 2 1PNU1 OE022 01020O OR OFNU1 OE022 01025O 12 'DESCRIPTION' 01030O 60 'CLS GRP SS INV VEND' OE022 01040O 76 'PART # REV DATE' OE022 01050O 94 'MAX BURDEN $' OE022 0001060O 114 'O.P. $ LAB HRS' OE022 01070O D 01 01NU1 OE022 01080O PARTNO 20 OE022 01100O UM 42 OE022 01110O ALPHA L 47 OE022 01120O LEAD L 51 OE022 01130O ABC 53 OE022 0001140O VNDNUM 67 OE022 01150O REVLTR 76 OE022 01160O MINROPL 85 OE022 01170O MATDLSL 95 OE022 01180O LABDLSL 105 OE022 01190O MINMAX 114 OE022 01200O BIN 121 OE022 0001210O D 02 01NU1 OE022 01215O DESCRP 38 01220O CLASS 42 OE022 01230O GROUP 46 OE022 01240O SAFETYL 51 OE022 01250O INVTRY 53 OE022 01260O VPTNUM 67 OE022 0001270O REVDATY 76 OE022 01280O MAXEOQL 85 OE022 01290O BURDLSL 95 OE022 01300O OPDLS L 105 OE022 01310O LABHRSL 115 OE022 01320O T 3 LRNU1 OE022 01330O 22 'END OF JOB. THERE ARE' OE022 0001340O COUNT 1 33 OE022 01350O 55 'ACTIVE RECORDS IN THE' OE022 01360O 73 'PART MASTER FILE.' OE022 01370O***** BELOW IS FINISHED GOODS REPORT. OE022 01380O H 2 OF U1 OE022 01390O OR 1P U1 OE022 01400O 77 'FINISHED GOODS LISTING' OE022 0001410O 132 'DIS022' OE022 01420O H 2 OF U1 OE022 01430O OR 1P U1 OE022 01440O 11 'PART NUMBER' 01445O 33 'DESCRIPTION' 01450O 81 'BIN # INV UNIT COST' 01455O 101 'PRICE 1 PRICE 2' 0001460O 121 'PRICE 3 PRICE 4' 01465O 131 'PRICE 5' 01480O D 2 01 U1 OE022 01490O PARTNO 20 OE022 01500O DESCRP 59 OE022 01510O BIN 67 OE022 01520O INVTRY 70 OE022 0001530O UNCOSTL 82 OE022 01540O PRC,1 L 92 OE022 01550O PRC,2 L 102 OE022 01560O PRC,3 L 112 OE022 01570O PRC,4 L 122 OE022 01580O PRC,5 L 132 OE022 01590O T 3 LR U1 OE022 0001600O 22 'END OF JOB. THERE ARE' OE022 01610O COUNT J 34 OE022 01620O 58 'ACTIVE RECORDS WITH CLAS' OE022 01630O 80 'S - ''F'' IN THE PARTMST' OE022 01640O 86 'FILE.' OE022 ** 001650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00166000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001690/* 001700_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(  TXOE020 P999999032778(000010H S OE020 00020X DECK-ID A47 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE020 00030F* THIS PROGRAM IS USED FOR INQUIRY/MAINTENANCE OF PARTMST FILE OE020 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE020 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE020 00060F* CONTROL DATA PROPRIETARY PRODUCT OE020 00070F* OE020 0000080FNULL IPEAF 72 DISK OE020 00090F@DIS20 IC F 32R DISK OE020 00100FPARTMST UC F 0300R20AI 271 DISK A OE020 00110E FN 050 22 FIELD NAME OE020 00120E CP 050 4 CURSOR POSITION OE020 00130E LN 050 2 0 LENGTH OE020 00140E EP 050 4 0 ENDING POSITION OE020 0000150INULL NS 01 OE020 00160I 1 1 A OE020 00170I@DIS20 NS 02 OE020 00180I 1 22 FIELDN OE020 00190I 23 26 CURPOS OE020 00200I 27 280LNGTH OE020 00210I 29 310ENDPOS OE020 0000220IPARTMST NS 03 OE020 00230I 10256 RECORD OE020 00240I 2570300 LEFT01 OE020 00250C MOVE ' ' RCODE 1 OE020 00260C MOVE RCODE B22 22 OE020 00270C MOVE RCODE BLANKS 72 OE020 00280C MOVE RCODE FILLER 1 OE020 0000290C Z-ADD0 MASK 10 OE020 00300C SETON LR OE020 00310CLR Z-ADD050 SSIZE 30 OE020 00320CLR Z-ADD006 NSECT 30 OE020 00330CLR MOVEL'D' FF 1 OE020 00340CLR MOVE '[]<>' TEMP4 4 OE020 00350CLR START TAG OE020 0000360C* ********** OE020 00370CLR EXSR FIRSTP OE020 00380C* ********** OE020 00390CLR EXSR CLRSCR OE020 00400C* ********** OE020 00410CLR 40 GOTO EOJ OE020 00420C* ********** OE020 0000430CLR Z-ADD2 VL OE020 00440CLR MOVELSECTON VAR OE020 00450CLR EXSR RTADJ OE020 00460C* ********** OE020 00470CLR MOVELVAR SECTN 20 OE020 00480CLR EXSR GETSEC OE020 00490C* ********** OE020 0000500CLRN45 GOTO START OE020 00510C* ********** OE020 00520CLR EXSR CLRSCR OE020 00530C* ********** OE020 00540CLR EXSR OUTPUT OE020 00550C* ********** OE020 00560CLR EXSR UPDATE OE020 0000570C* ********** OE020 00580CLR GOTO START OE020 00590C* ********** OE020 00600CLR EOJ TAG OE020 00610C* ********** OE020 00620C********************************************************************OE020 00630C* OE020 0000640C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE020 00650C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE020 00660C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE020 00670C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE020 00680C* OE020 00690C********************************************************************OE020 00700CSR FIRSTP BEGSR OE020 0000710C* ********** OE020 00720CSR EXSR CLRSCR OE020 00730C* ********** OE020 00740CSR Z-ADD0 SECTN OE020 00750CSR EXSR GETSEC OE020 00760C* ********** OE020 00770CSR PGE TAG OE020 0000780C* ********** OE020 00790CSR SETON 61 OE020 00800CSR SETOF 62 OE020 00810CSR EXSR OUTPUT OE020 00820C* ********** OE020 00830C* ********** OE020 00840CSR EXIT SUBRFL OE020 0000850CSR RLABL RECORD OE020 00860CSR RLABL FILLER 1 OE020 00870C* ********** OE020 00880C* ********** OE020 00890CSR EXIT SUBRFL OE020 00900CSR RLABL LEFT01 OE020 00910CSR RLABL FILLER 1 OE020 0000920C* ********** OE020 00930C* ********** OE020 00940C* ********** OE020 00950C* ********** OE020 00960C* ********** OE020 00970C* ********** OE020 00980C* ********** OE020 0000990C* ********** OE020 01000C* ********** OE020 01010C* ********** OE020 01020C* ********** OE020 01030C* ********** OE020 01040C* ********** OE020 01050CSR Z-ADD20 NCHARS OE020 0001060CSR Z-ADD1 SSTRT OE020 01070CSR Z-ADD0271 TSTRT OE020 01080C* ********** OE020 01090CSR EXIT SUBRLM OE020 01100CSR RLABL KEY 20 OE020 01110CSR RLABL SSTRT 30 OE020 01120CSR RLABL RECORD OE020 0001130CSR RLABL TSTRT 30 OE020 01140CSR RLABL NCHARS 30 OE020 01150CSR Z-ADDNOFLDS SVFLDS 30 OE020 01160CSR Z-ADDSX NOFLDS OE020 01170CSR EXSR UPDATE OE020 01180C* ********** OE020 01190CSR Z-ADDSVFLDS NOFLDS OE020 0001200CSR Z-ADD20 NCHARS OE020 01210CSR Z-ADD0271 SSTRT OE020 01220CSR Z-ADD1 TSTRT OE020 01230C* ********** OE020 01240CSR EXIT SUBRLM OE020 01250CSR RLABL RECORD OE020 01260CSR RLABL SSTRT 30 OE020 0001270CSR RLABL KEY OE020 01280CSR RLABL TSTRT 30 OE020 01290CSR RLABL NCHARS 30 OE020 01300CSR KEY CHAINPARTMST 55 OE020 01310CSR MOVELSAVPOS BUFFER OE020 01320CSR MOVELOFC BUFFER OE020 01330CSR EXSR POSCUR OE020 0001340C* ********** OE020 01350CSR MOVEL'] NEW R'WORD16 16 OE020 01360CSR MOVE 'ECORD 'WORD16 OE020 01370CSRN55 MOVELBLANKS WORD16 OE020 01380CSRN55 MOVEL']' WORD16 OE020 01390CSR MOVELWORD16 BUFFER 72 OE020 01400CSR MOVE 'T' TYPE 1 OE020 0001410CSR Z-ADD13 BLNGTH 20 OE020 01420CSR EXSR CRTCOM OE020 01430C* ********** OE020 01440CSR SETON 62 OE020 01450CSR Z-ADDSX X 30 OE020 01460CSR EXSR ACCEPT OE020 01470C* ********** OE020 0001480CSR MOVELBUFFER SECTON 2 OE020 01490CSR SECTON COMP 'E ' 40 OE020 01500CSR 40 GOTO ENDFP OE020 01510C* ********** OE020 01520CSR SECTON COMP 'D ' 40 OE020 01530CSR 40N55 EXCPT OE020 01540CSR 40 GOTO PGE OE020 0001550C* ********** OE020 01560CSR SECTON COMP ' 1' 30 30 OE020 01570CSR 30 SECTON COMP ' 9' 3030 OE020 01580CSR 30 GOTO GOOD OE020 01590C* ********** OE020 01600CSR SECTON COMP '01' 30 30 OE020 01610CSR 30 SECTON COMP '09' 3030 OE020 0001620CSR 30 GOTO GOOD OE020 01630C* ********** OE020 01640CSR SECTON COMP '1 ' 30 30 OE020 01650CSR 30 SECTON COMP '9 ' 3030 OE020 01660CSR 30 GOTO GOOD OE020 01670C* ********** OE020 01680CSR MOVELSECTON TEMP1 1 OE020 0001690CSR TEMP1 COMP '1' 30 30 OE020 01700CSR 30 TEMP1 COMP '9' 3030 OE020 01710CSRN30 GOTO PGE OE020 01720C* ********** OE020 01730CSR MOVE SECTON TEMP1 OE020 01740CSR TEMP1 COMP '0' 30 30 OE020 01750CSR 30 TEMP1 COMP '9' 3030 OE020 0001760CSRN30 GOTO PGE OE020 01770C* ********** OE020 01780CSR GOOD TAG OE020 01790C* ********** OE020 01800CSR SETOF 6162 OE020 01810CSRN55 GOTO ENDFP OE020 01820C* ********** OE020 0001830CSR SETON 80 OE020 01840CSR EXCPT OE020 01850CSR SETOF 80 OE020 01860CSR KEY CHAINPARTMST 55 OE020 01870CSR ENDFP ENDSR OE020 01880C* ********** OE020 01890C********************************************************************OE020 0001900C* OE020 01910C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE020 01920C* OE020 01930C********************************************************************OE020 01940CSR GETSEC BEGSR OE020 01950C* ********** OE020 01960CSR 1 ADD SECTN N 20 OE020 0001970CSR SETOF 404145 OE020 01980CSR N COMP 0 3030 OE020 01990CSRN30 N COMP NSECT 30 OE020 02000CSR 30 GOTO ENDGET OE020 02010C* ********** OE020 02020CSR SECTN MULT SSIZE RRN 40 OE020 02030CSR Z-ADD1 X OE020 0002040CSR SCLOOP TAG OE020 02050C* ********** OE020 02060CSR RRN ADD 1 RRN OE020 02070CSR RRN CHAIN@DIS20 50 OE020 02080CSR 50 GOTO ENDGET OE020 02090C* ********** OE020 02100CSR FIELDN COMP B22 4141 OE020 0002110CSRN41 GOTO ENDGET OE020 02120C* ********** OE020 02130CSR 41N45 SETON 45 OE020 02140CSR MOVE FIELDN FN,X OE020 02150CSR MOVE CURPOS CP,X OE020 02160CSR MOVE LNGTH LN,X OE020 02170CSR Z-ADDENDPOS EP,X OE020 0002180CSR 1 ADD X X OE020 02190CSR X COMP SSIZE 32 OE020 02200CSRN32 GOTO SCLOOP OE020 02210C* ********** OE020 02220CSR ENDGET TAG OE020 02230C* ********** OE020 02240CSR Z-ADDX NOFLDS 30 OE020 0002250CSR 45 GOTO FINGET OE020 02260C* ********** OE020 02270CSR EXSR CLRSCR OE020 02280C* ********** OE020 02290CSR MOVEL'SECT # 'WORD9 9 OE020 02300CSR Z-ADD16 BLNGTH OE020 02310CSR MOVE SECTN WORD9 OE020 0002320CSR MOVELWORD9 WORD16 OE020 02330CSRN30 MOVE ' ABSENT' WORD16 OE020 02340CSR 30 MOVE ' ILLEG.' WORD16 OE020 02350CSR MOVELWORD16 BUFFER OE020 02360CSR MOVEL'T' TYPE OE020 02370CSR EXSR CRTCOM OE020 02380C* ********** OE020 0002390CSR FINGET ENDSR OE020 02400C* ********** OE020 02410C********************************************************************OE020 02420C* OE020 02430C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE020 02440C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE020 02450C* SECTION INDEX IS SAVED. OE020 0002460C* OE020 02470C********************************************************************OE020 02480CSR OUTPUT BEGSR OE020 02490C* ********** OE020 02500CSR EXSR CLRSCR OE020 02510C* ********** OE020 02520CSR Z-ADD1 X OE020 0002530CSR 61 SETON 63 OE020 02540CSR OTLOOP TAG OE020 02550C* ********** OE020 02560CSR 61 LN,X COMP 0 31 OE020 02570CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE020 02580CSR EXSR OUTFLD OE020 02590C* ********** OE020 0002600CSR X ADD 1 X OE020 02610CSR X COMP NOFLDS 31 OE020 02620CSR 31 GOTO OTLOOP OE020 02630C* ********** OE020 02640CSR SETOF 63 OE020 02650CSR ENDSR OE020 02660C********************************************************************OE020 0002670C* OE020 02680C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE020 02690C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE020 02700C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE020 02710C* THEN NO FIELD INFORMATION IS PRINTED OE020 02720C* OE020 02730C********************************************************************OE020 0002740CSR OUTFLD BEGSR OE020 02750C* ********** OE020 02760CSR MOVE FN,X FL 20 OE020 02770CSR EP,X COMP 0 98 OE020 02780CSR MOVELCP,X FC 20 OE020 02790CSR FC COMP FL 31 OE020 02800CSR 31 Z-ADDFC FL OE020 0002810CSR FC SUB FL CC 20 OE020 02820CSR CC ADD 1 CC OE020 02830CSR MOVELCP,X BUFFER OE020 02840CSR MOVELCC BUFFER OE020 02850CSR EXSR POSCUR OE020 02860C* ********** OE020 02870CSR MOVELBLANKS BUFFER OE020 0002880CSR MOVELFN,X FIELDN OE020 02890CSR MOVE ' ' FIELDN OE020 02900CSR MOVELFIELDN BUFFER OE020 02910CSR Z-ADDLN,X LEN 20 OE020 02920CSR LEN COMP 0 9730 OE020 02930CSR 97 Z-SUBLN,X LEN OE020 02940CSR 30 GOTO SKIPF OE020 0002950C* ********** OE020 02960CSR FL ADD 2 BPOS 20 OE020 02970C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE020 02980CSR Z-ADDBPOS TSTRT 30 OE020 02990CSRN98 Z-ADD1 SSTRT 30 OE020 03000CSR 98 Z-ADD3 SSTRT OE020 03010CSR Z-ADD1 NCHARS 30 OE020 0003020C* ********** OE020 03030CSR EXIT SUBRLM OE020 03040CSR RLABL TEMP4 OE020 03050CSR RLABL SSTRT 30 OE020 03060CSR RLABL BUFFER OE020 03070CSR RLABL TSTRT 30 OE020 03080CSR RLABL NCHARS 30 OE020 0003090CSR BPOS ADD 1 FPOS 20 OE020 03100CSR EXSR MVRECD OE020 03110C* ********** OE020 03120CSR SKIPF TAG OE020 03130C* ********** OE020 03140CSR 30 Z-ADDFL BLNGTH OE020 03150CSRN30 FL ADD 3 BLNGTH OE020 0003160CSRN30 BLNGTH ADD LEN BLNGTH OE020 03170CSR MOVE 'T' TYPE OE020 03180CSR EXSR CRTCOM OE020 03190C* ********** OE020 03200CSR ENDSR OE020 03210C********************************************************************OE020 03220C* OE020 0003230C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE020 03240C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE020 03250C* THE RIGHT BRACKET. OE020 03260C********************************************************************OE020 03270CSR MVRECD BEGSR OE020 03280C* ********** OE020 03290CSR 63 GOTO RBRK OE020 0003300C* ********** OE020 03310CSR 98 Z-SUBEP,X END 40 OE020 03320CSRN98 Z-ADDEP,X END OE020 03330CSR END SUB LEN STRT 40 81 81 OE020 03340CSR STRT ADD 1 STRT OE020 03350C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE020 03360C* FROM STRT IN RECORD TO FPOS IN BUFFER OE020 0003370CSR Z-ADDLEN NCHARS OE020 03380CSR Z-ADDSTRT SSTRT OE020 03390CSR Z-ADDFPOS TSTRT OE020 03400C* ********** OE020 03410CSRN81 GOTO RBRK OE020 03420CSR EXIT SUBRLM OE020 03430CSR RLABL RECORD OE020 0003440CSR RLABL SSTRT 30 OE020 03450CSR RLABL BUFFER OE020 03460CSR RLABL TSTRT 30 OE020 03470CSR RLABL NCHARS 30 OE020 03480CSR RBRK TAG OE020 03490C* ********** OE020 03500CSR EXSR RTBRKT OE020 0003510C* ********** OE020 03520CSR ENDSR OE020 03530C********************************************************************OE020 03540C* OE020 03550C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE020 03560C* OE020 03570C********************************************************************OE020 0003580CSR RTBRKT BEGSR OE020 03590C* ********** OE020 03600CSR LEN ADD FPOS FPOS OE020 03610CSR Z-ADDFPOS TSTRT OE020 03620CSR Z-ADD1 NCHARS OE020 03630CSRN98 Z-ADD2 SSTRT OE020 03640CSR 98 Z-ADD4 SSTRT OE020 0003650C* ********** OE020 03660CSR EXIT SUBRLM OE020 03670CSR RLABL TEMP4 OE020 03680CSR RLABL SSTRT 30 OE020 03690CSR RLABL BUFFER OE020 03700CSR RLABL TSTRT 30 OE020 03710CSR RLABL NCHARS 30 OE020 0003720CSR ENDSR OE020 03730C********************************************************************OE020 03740C* OE020 03750C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE020 03760C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE020 03770C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE020 03780C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE020 0003790C* OF THE FIELDS ARE LEFT UNCHANGED OE020 03800C* OE020 03810C********************************************************************OE020 03820CSR UPDATE BEGSR OE020 03830C* ********** OE020 03840CSR SETOF 32 OE020 03850CSR Z-ADD1 X OE020 0003860CSR UPLOOP TAG OE020 03870C* ********** OE020 03880CSR EP,X COMP 0 98 OE020 03890CSR 98 SETON 30 OE020 03900CSR 98 GOTO NOUPD OE020 03910C* ********** OE020 03920CSR Z-ADDLN,X LEN OE020 0003930CSR LEN COMP 0 9730 OE020 03940CSR 97 Z-SUBLEN LEN OE020 03950CSR NOUPD TAG OE020 03960C* ********** OE020 03970CSR 30N32 GOTO INCR OE020 03980C* ********** OE020 03990CSR 30 GOTO CHKRUB OE020 0004000C* ********** OE020 04010CSR SETOF 3233 OE020 04020CSR EXSR ACCEPT OE020 04030C* ********** OE020 04040CSR CHKRUB TAG OE020 04050C* ********** OE020 04060CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE020 0004070CSR 32 31 GOTO UPLOOP OE020 04080C* ********** OE020 04090CSR 32 GOTO ENDUPD OE020 04100C* ********** OE020 04110CSR MOVELBUFFER ATSIGN 1 OE020 04120CSR ATSIGN COMP '@' 35 OE020 04130CSR 35 GOTO OUTREC OE020 0004140C* ********** OE020 04150CSR 33 GOTO INCR WAS LINE FEED OE020 04160C* ********** OE020 04170CSR Z-ADDEP,X END OE020 04180CSR END SUB LEN STRT 81 81 OE020 04190CSR STRT ADD 1 STRT OE020 04200C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE020 0004210C* BUFFER TO THE STRT OF RECORD OE020 04220CSR Z-ADD1 SSTRT OE020 04230CSR Z-ADDSTRT TSTRT OE020 04240CSR Z-ADDLEN NCHARS OE020 04250C* ********** OE020 04260CSRN81 GOTO AAA OE020 04270CSR EXIT SUBRLM OE020 0004280CSR RLABL BUFFER OE020 04290CSR RLABL SSTRT 30 OE020 04300CSR RLABL RECORD OE020 04310CSR RLABL TSTRT 30 OE020 04320CSR RLABL NCHARS 30 OE020 04330CSR AAA TAG OE020 04340CSR MOVELBUFFER TEMP5 5 OE020 0004350CSR MOVELSAVPOS BUFFER OE020 04360CSR EXSR POSCUR OE020 04370C* ********** OE020 04380CSR MOVELTEMP5 BUFFER OE020 04390CSR Z-ADD1 FPOS OE020 04400CSR EXSR RTBRKT OE020 04410C* ********** OE020 0004420CSR LEN ADD 1 BLNGTH OE020 04430CSR MOVE 'T' TYPE OE020 04440CSR EXSR CRTCOM OE020 04450C* ********** OE020 04460CSR INCR TAG OE020 04470C* ********** OE020 04480CSR X ADD 1 X OE020 0004490CSR X COMP NOFLDS 30 OE020 04500CSR 30 GOTO UPLOOP OE020 04510C* ********** OE020 04520CSR OUTREC TAG OE020 04530C* ********** OE020 04540CSR SETON 80 OE020 04550CSRN61 EXCPT OE020 0004560CSR SETOF 80 OE020 04570CSR ENDUPD TAG OE020 04580C* ********** OE020 04590CSR ENDSR OE020 04600C********************************************************************OE020 04610C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE020 04620C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE020 0004630C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE020 04640C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE020 04650C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE020 04660C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE020 04670C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE020 04680C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE020 04690C* TO BE OUTPUT TO THE SCREEN. OE020 0004700C* OE020 04710C********************************************************************OE020 04720CSR ACCEPT BEGSR OE020 04730C* ********** OE020 04740CSR X COMP 1 30 OE020 04750CSRN30 X COMP SSIZE 30 OE020 04760CSR 30 Z-ADD1 X OE020 0004770CSR MOVELCP,X FC OE020 04780CSR FC ADD 3 FC OE020 04790CSR MOVELCP,X SAVPOS 4 OE020 04800CSR MOVELFC SAVPOS OE020 04810CSR Z-ADDLN,X LEN OE020 04820CSR LEN COMP 0 97 OE020 04830CSR 97 Z-SUBLEN LEN OE020 0004840CSR LEN ADD FC OFC 20 OE020 04850CSR ACLOOP TAG OE020 04860C* ********** OE020 04870CSR MOVELSAVPOS BUFFER OE020 04880CSR EXSR POSCUR OE020 04890C* ********** OE020 04900CSR Z-ADDLEN BLNGTH OE020 0004910CSR MOVE BLANKS BUFFER OE020 04920CSR MOVE 'A' TYPE OE020 04930CSR EXSR CRTCOM OE020 04940C* ********** OE020 04950CSR RCODE COMP 'R' 31 OE020 04960CSR 31 BUFFER COMP BLANKS 32 OE020 04970CSR 31 32N62 GOTO DUPIT OE020 0004980C* ********** OE020 04990CSR 31 GOTO ACLOOP OE020 05000C* ********** OE020 05010CSR RCODE COMP 'L' 33 OE020 05020CSR 33 GOTO DUPIT OE020 05030C* ********** OE020 05040CSRN97 GOTO ENDACC OE020 0005050C* ********** OE020 05060CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE020 05070CSR SIGN COMP '@' 30 OE020 05080CSR 30 GOTO ENDACC OE020 05090C* ********** OE020 05100CSR Z-ADDLEN VL 20 OE020 05110CSR MOVELBUFFER VAR 15 OE020 0005120CSR EXSR RTADJ OE020 05130C* ********** OE020 05140CSR MOVELVAR BUFFER OE020 05150CSR GOTO ENDACC OE020 05160C* ********** OE020 05170CSR DUPIT TAG OE020 05180C* ********** OE020 0005190CSR MOVELSAVPOS BUFFER OE020 05200CSR EXSR POSCUR OE020 05210C* ********** OE020 05220CSR 62 MOVELSECTON BUFFER OE020 05230CSRN62 Z-ADD1 FPOS OE020 05240CSRN62 EXSR MVRECD OE020 05250C* ********** OE020 0005260CSR MOVE 'T' TYPE OE020 05270CSR BLNGTH ADD 1 BLNGTH OE020 05280CSR EXSR CRTCOM OE020 05290C* ********** OE020 05300CSR ENDACC ENDSR OE020 05310C* ********** OE020 05320C********************************************************************OE020 0005330C* OE020 05340C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE020 05350C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE020 05360C* 4 DUMMY FOR RTADJ OE020 05370C* OE020 05380C********************************************************************OE020 05390CSR POSCUR BEGSR OE020 0005400C* ********** OE020 05410CSR MOVE 'P' TYPE OE020 05420CSR EXSR CRTCOM OE020 05430C* ********** OE020 05440CSR ENDSR OE020 05450C********************************************************************OE020 05460CSR CLRSCR BEGSR OE020 0005470C* ********** OE020 05480CSR MOVE 'C' TYPE OE020 05490CSR EXSR CRTCOM OE020 05500C* ********** OE020 05510CSR ENDSR OE020 05520C********************************************************************OE020 05530CSR CRTCOM BEGSR OE020 0005540C* ********** OE020 05550C* ********** OE020 05560CSR EXITFSUBRCM OE020 05570CSR RLABL BUFFER 72 OE020 05580CSR RLABL TYPE 1 OE020 05590CSR RLABL BLNGTH 20 OE020 05600CSR RLABL RCODE 1 OE020 0005610CSR RLABL MASK 10 OE020 05620CSR RLABL DTYPE 10 OE020 05630CSR ENDSR OE020 05640C********************************************************************OE020 05650CSR RTADJ BEGSR OE020 05660C* ********** OE020 05670CSR EXIT SUBRAJ OE020 0005680C* ********** OE020 05690CSR RLABL VL OE020 05700CSR RLABL VAR OE020 05710CSR ENDSR OE020 05720C********************************************************************OE020 05730OPARTMST E 80N55 OE020 05740O RECORD 0256 OE020 0005750O LEFT01 0300 OE020 05760O E 40N80 OE020 05770O FF 74 OE020 05780O EADD 80 55 OE020 05790O RECORD 0256 OE020 05800O LEFT01 0300 OE020 ** 00581000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005850/* 005860_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0([ NTXIN610 P#F999999042878(000010H S IN610 00020X DECK-ID M57 MFG/DIST/ACCT SYSTEM SUMMARY-123 I0005000030F* THIS PROGRAM USED FOR ENTER/EDIT MANUAL INVENTORY TRANSACTIONS I0006000040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0I0007000050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0008000060F* CONTROL DATA PROPRIETARY PRODUCT I0009000070F* I001000000080FDUMMY IPEAF 72 DISK I0011000090FPARTMST UC F 300R20AI 271 DISK I0012000100FTRANTMP UC F 65R DISK I0013000110F********************************************************************I0014000120F* I0015000130F* PACKAGE MANUFACTURING I0016000140F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING I001700000150F* PROGRAM MANUAL INVENTORY TRANSACTIONS ENTRY/EDIT I0018000160F* AND UPDATE PARTMST WITH TRAN QTY'S. (S00, SOH, 0019000170F* ALLOC, MTD USAGE, AVGUSE, AVGMAT COST/UNIT, & 0020000180F* YTD USAGE). 0021000190F* I0022000200F* CONTRACTOR COMPUSOURCE I0023000210F* PROGRAMMER KATH HILL I002400000220F* DATE OCTOBER 30, 1975 I0025000230F* I0026000240F********************************************************************I0027000250F* I0028000260F* NARRATIVE: USES TRATMP RECORDS TO UPDATE PARTMST. 0029000270F* NARRATIVE: TRAN # DESCRIPTION I0030000280F* ---------- ------ ----------------------------------------- I003100000290F* I0032000300F* 10 NEW SALES ORDER I0033000310F* 12 DELETE SALES ORDER I0034000320F* 14 INVOICE I0035000330F* 16 CREDIT MEMO I0036000340F* 18 MANUAL INVOICE I0037000350F* 20 DIRECT BILL I003800000360F* 40 NEW PURCHASE ORDER I0039000370F* 42 REPLACE P.O. QTY ORDERED I0040000380F* 43 REPLACE P.O. QTY RECEIVED I0041000390F* 44 P.O. RECEIPT I0042000400F* 45 CANCEL PO QTY OR DELETE PO I0043000410F* 60 OPEN JOBS I0044000420F* 61 OPEN JOBS (COMPONENTS) I004500000430F* 62 RELEASE JOBS I0046000440F* 63 MATERIAL ISSUES I0047000450F* 64 CHANGE JOB QTY I0048000460F* 65 CHANGE JOB QTY (COMPONENTS) I0049000470F* 66 DELETE OPEN JOBS I0050000480F* 67 DELETE OPEN JOBS (COMPONENTS) I0051000490F* 68 CLOSE JOB SHORT I005200000500F* 70 ADJUST REQUISITIONS I0053000510F* 72 COMPLETED PRODUCTION#1 I0054000520F* 73 COMPLETED PRODUCTION#2 I0055000530F* 80 ADJUST ALLOCATION I0056000540F* 82 ADJUST STOCK ON ORDER I0057000550F* 84 REPLACE STOCK ON ORDER I0058000560F* 86 ADJUST STOCK ON HAND I005900000570F* 87 ADJUST AVERAGE USAGE-DIR 0060000580F* 88 REPLACE STOCK ON HAND I0061000590F* 89 REPLACE AVERAGE USAGE-DIR 0062000600F* 90 ADJUST AVERAGE USAGE-MFG I0063000610F* 91 ADJUST MTD USAGE-DIR 0064000620F* 92 REPLACE AVERAGE USAGE-MFG I0065000630F* 93 ADJUST MTD USAGE-MFG I006600000640F* 94 REPLACE MTD USAGE-MFG I0067000650F* 95 ADJUST YTD USAGE-MFG I0068000660F* 96 REPLACE YTD USAGE-MFG I0069000670F* 97 REPLACE MTD USAGE-DIR 0070000680F* 98 ADJUST YTD USAGE-DIR 0071000690F* 99 REPLACE YTD USAGE-DIR 0072000700F* I007300000710F********************************************************************I0074000720F* ID F C H L FUNCTION OF INDICATORS I0075000730F* I0076000740F* 01 DUMMY I0077000750F* 02 PARTMST I0078000760F* 03 TRNTMP 0079000770F* I008000000780F* 21 UNIT COST = 0 0081000790F* 22 DLT CD ' ' (PARTMST) I0082000800F* I0083000810F* 10 END OF JOB I0084000820F* 11 EDIT --- ERROR I0085000830F* 12 START A NEW SCREEN I0086000840F* 20 CHAIN TO PARTMST A MISS 008700000850F* 25 TABLE SEARCH 0088000860F* 31 RUBOUT TO START OF THIS FIELD I0089000870F* 32 RUBOUT TO START OF LAST FIELD I0090000880F* 33 LINEFEED I0091000890F* 34 FLDX VS. ACTY 0092000900F* 36 FIELD LOOPER GUARD 0093000910F* 50 TRANS # = 16 --> CREDIT MEMO --> Z-SUB QTY I009400000920F* 55 TRAN # = 43 OR 44 --> BUY COST (OVERRIDE) I0095000930F* 60 NEG. TRAN QTY I0096000940F* 61 TABLE SEARCH HIT I0097000950F* 70 STOCK-ON-HAND X=1 0098000960F* 71 STOCK-ON ORDER X=2 0099000970F* 72 ALLOCATE X=3 0100000980F* 83 MTD USAGE-M X=4 010100000990F* 88 AVERAGE USAGE-M X=5 0102001000F* 89 YTD USAGE-M X=6 0103001010F* 51 MTD USAGE-D X=7 0104001020F* 52 AVERAGE USAGE-D X=8 0105001030F* 53 YTD USAGE-D X=9 0106001040F* 84 ' ' Y=1 0107001050F* 85 '+' Y=2 010800001060F* 86 '-' Y=3 0109001070F* 87 'R' Y=4 0110001080F* 0111001090F* 0112001100F* 90 OUTPT --- ERROR 0113001110F* 0114001120F* 91 TRAN # 011500001130F* 92 PART # I0116001140F* 93 TRAN QTY I0117001150F* 94 REF # I0118001160F* 95 BUY COST (OVERRIDE) - TRAN #'S 43 AND 44 ONLY I0119001170F* 98 SETUP XPOSS & YPOSS AT START OF PROG 0120001180F* 99 HEADINGS FOR CRT I0121001190F* I012200001200F********************************************************************I0123001210E TABA 1 40 2 0 TABB 10 TRAN #/TYPE I0124001220E MSG 1 25 56 CRT I0125001230E MES 1 10 50 I0126001240E BLNKS 1 72 BLANKS I0127001250E TABD 1 40 2 0 TABE 9 TRAN #/FIELDS 0128001260E ACT 4 4 1 /+/-/R 012900001270E TABC 1 2 2 0 SPECIAL TRAN # 0130001280E* UPDATE AVGMAT 0131001290E FLD 9 1 TABE SPLIT APART 0132001300IDUMMY NS 01 I0133001310I 1 1 AIR I0134001320IPARTMST NS 02 I0135001330I 1 37 DESCRP 013600001340I 74 74 DLTPR 22 0137001350I 75 813STDCST 0138001360I 82 883AVGMAT 0139001370I 146 1520SOH 0140001380I 153 1590SOO 0141001390I 167 1730ALLOCA 0142001400I 196 2020MTDUSE 014300001410I 203 2090AVGUSE 0144001420I 212 2180YTDUSE 0145001430I 160 1660MTDDIR 0146001440I 174 1800YTDDIR 0147001450I 261 2650AVGDIR 0148001460ITRANTMP NS 03 0149001470I 1 2 TST 015000001480I 42 61 PARTNO I0151001490I 13 140TN I0152001500I 15 210BLIND I0153001510I 22 28 REFNUM 28 I0154001520I 35 413OVCOST 21 0155001530C SETON LR I0156001540CLR EXSR ALMTS I015700001550CLR Z-ADDLOW SEQNO I0158001560CLR MOVELBLNKS,1 BUFFER 72 I0159001570CLR MOVE ']' RTBRK 1 I0160001580CLR MODECK TAG I0161001590CLR SETOF 80 I0162001600CLR EXSR CLRSCR I0163001610CLR MOVEL'MODE-' BUFFER I016400001620CLR MOVE 'S' TYPE I0165001630CLR Z-ADD5 BLNGTH I0166001640CLR EXSR CRTCOM I0167001650CLR MOVE 'A' TYPE I0168001660CLR Z-ADD1 BLNGTH I0169001670CLR EXSR CRTCOM I0170001680CLR MOVELBUFFER MODE 1 I017100001690CLR 'C' COMP MODE 81 CHANGE I0172001700CLR 'A' COMP MODE 82 ADD I0173001710CLRN81N82 MOVEL'MODE NOT'WORDS 14 I0174001720CLRN81N82 MOVE 'A OR C' WORDS I0175001730CLRN81N82 MOVELWORDS BUFFER I0176001740CLRN81N82 Z-ADD14 BLNGTH I0177001750CLRN81N82 MOVE 'T' TYPE I017800001760CLRN81N82 EXSR CRTCOM I0179001770CLRN81N82 GOTO MODECK I0180001780CLR NEXT TAG NEW SCREEN I0181001790CLR Z-ADD0 Z 20 0 LINE INCR. I0182001800CLR EXSR CLRSCR CLEAR CRT SCRN I0183001810CLR Z-ADD0 Y 20 0 MSG INCR. I0184001820CLR LOOP1 TAG ---------------I018500001830CLR Y ADD 1 Y HEADINGS I0186001840CLR EXSR OUTPT I0187001850CLR Y COMP 7 99 I0188001860CLR 99 GOTO LOOP1 ---------------I0189001870CLR LINE TAG NEW LINE I0190001880CLR SHOW TAG ---------------I0191001890CLR 81 EXSR GETSEQ I019200001900CLR EXSR GETREC I0193001910CLR Z-ADDY YHOLD 20 PUT OUT I0194001920CLR SHOW1 TAG I0195001930CLR SETON 65 I0196001940CLR Y ADD 1 Y BRACKETS I0197001950CLR EXSR OUTPT FOR THIS LINE I0198001960CLR Y COMP 11 99 I019900001970CLR 99 GOTO SHOW1 I0200001980CLR Z-ADDYHOLD Y I0201001990CLR SETOF 65 I0202002000CLR INPUT1 TAG ---------------I0203002010CLR Z-ADD8 Y I0204002020CLR EXSR OUTPT I0205002030CLR SETON 91 I020600002040CLR EXSR ACCEPT TRANSACTION # I0207002050CLR SETOF 91 I0208002060CLR 10 GOTO END END OF JOB I0209002070CLR 80 GOTO MODECK I0210002080CLR 31 32 GOTO LINE RUBOUT I0211002090C* I0212002100CLR INPUT2 TAG ---------------I021300002110CLR Z-ADD9 Y I0214002120CLR EXSR OUTPT I0215002130CLR SETON 92 I0216002140CLR EXSR ACCEPT PART # I0217002150CLR SETOF 92 I0218002160CLR 31 32 GOTO INPUT1 BACK TO TRAN # I0219002170CLR INPUT3 TAG ---------------I022000002180CLR Z-ADD10 Y I0221002190CLR EXSR OUTPT I0222002200CLR SETON 93 I0223002210CLR EXSR ACCEPT TRANS. QTY. I0224002220CLR SETOF 93 I0225002230CLR 31 32 GOTO INPUT2 BACK TO PART # I0226002240CLR INPUT4 TAG ---------------I022700002250CLR Z-ADD11 Y I0228002260CLR EXSR OUTPT I0229002270CLR SETON 94 I0230002280CLR EXSR ACCEPT REF # I0231002290CLR SETOF 94 I0232002300CLR 31 32 GOTO INPUT3 BK TO TRAN QTY I0233002310C* ---------------I023400002320CLR INPUT5 TAG I0235002330CLR TN COMP 43 55 I0236002340CLRN55 TN COMP 44 55 I0237002350CLRN55 GOTO ALLIN I0238002360CLR Z-ADD11 Y I0239002370CLR EXSR OUTPT I0240002380CLR SETON 95 I024100002390CLR EXSR ACCEPT BUY COST I0242002400C* (OVERRIDE) I0243002410CLR SETOF 95 I0244002420CLR 31 32 GOTO INPUT4 I0245002430C* I0246002440CLR ALLIN TAG I0247002450C* I024800002460CLR TN COMP 16 50CREDIT MEMO I0249002470CLR 50 Z-SUBQTY BLIND 70 I0250002480CLRN50 Z-ADDQTY BLIND I0251002490C******************************************************************** 0252002500CLR Z-ADD9 XPOSS 20 SOH/SOO/ALLOCA 0253002510C* MTDUSE/AVGUSE 0254002520C* YTDUSE 025500002530CLRN98 Z-ADD4 YPOSS 20 /+/-/R 0256002540CLRN98 SETON 98 0257002550CLR PARTNO CHAINPARTMST 20 0258002560CLRN20N22 SETON 20 0259002570CLR 20 GOTO FINI 0260002580C* 0261002590CLR Z-ADDAVGMAT SV1 73 026200002600CLR Z-ADDSOH SV2 70 0263002610CLR Z-ADDSOO SV3 70 0264002620CLR Z-ADDALLOCA SV4 70 0265002630CLR Z-ADDMTDUSE SV5 70 0266002640CLR Z-ADDAVGUSE SV6 70 0267002650CLR Z-ADDYTDUSE SV7 70 0268002660CLR Z-ADDMTDDIR SV8 70 026900002670CLR Z-ADDYTDDIR SV9 70 0270002680CLR Z-ADDAVGDIR SV10 70 0271002690C* 0272002700CLR TN LOKUPTABC 25 0273002710CLR 25 EXSR CALC1 0274002720C* 0275002730CLR TN LOKUPTABD TABE 25 027600002740CLRN25 GOTO FINI 0277002750C* 0278002760CLR MOVELTABE FLDS2 2 0279002770CLR MOVE TABE FLDS4 7 0280002780CLR MOVELFLDS2 FLD,1 0281002790CLR MOVE FLDS2 FLD,2 0282002800CLR MOVELFLDS4 FLDSX 3 028300002810CLR MOVE FLDS4 FLDSY 4 0284002820CLR MOVELFLDSX FLDS2 0285002830CLR MOVELFLDS2 FLD,3 0286002840CLR MOVE FLDS2 FLD,4 0287002850CLR MOVE FLDSX FLD,5 0288002860CLR MOVELFLDSY FLDS2 0289002870CLR MOVELFLDS2 FLD,6 029000002880CLR MOVE FLDS2 FLD,7 0291002890CLR MOVE FLDSY FLDS2 0292002900CLR MOVELFLDS2 FLD,8 0293002910CLR MOVE FLDS2 FLD,9 0294002920C* 0295002930CLR Z-ADD0 X 20 0296002940CLR LOOP3 TAG 029700002950CLR X ADD 1 X 0298002960CLR Z-ADD0 Y 20 0299002970CLR X COMP XPOSS 36 0300002980CLR 36 GOTO ENDLP1 0301002990CLR LOOP2 TAG 0302003000CLR Y ADD 1 Y 0303003010CLR FLD,X COMP ACT,Y 34 030400003020CLR 34 EXSR CALC2 0305003030CLR 34 GOTO ENDLP2 0306003040CLR GOTO LOOP2 0307003050CLR ENDLP2 TAG 0308003060CLR GOTO LOOP3 0309003070CLR ENDLP1 TAG 0310003080C* 031100003090CLR FINI TAG 0312003100C* 0313003110CLRN20 PARTNO CHAINPARTMST 20 ALWAYS HITS! 0314003120C* 0315003130CLR EXCPT 0316003140CLR Z ADD 1 Z INCR. LINE 0317003150CLR Z COMP 14 12 15 LINES/SCRN 031800003160C******************************************************************** 0319003170C******************************************************************** 0320003180CLR 12 GOTO NEXT NEXT SCREEN I0321003190CLR Z-ADD8 Y I0322003200CLR GOTO LINE NEXT LINE I0323003210C* I0324003220CLR END TAG I032500003230CLR EXSR CLRSCR I0326003240CLR CLOSE TAG I0327003250C********************************************************************I0328003260C* I0329003270C* THIS SUBROUTINE ACCEPTS INFORMATION FROM THE CRT. I0330003280C* I0331003290C********************************************************************I033200003300CSR ACCEPT BEGSR I0333003310CSR AALOOP TAG I0334003320CSR 91 Z-ADD12 Y TRAN # I0335003330CSR 92 Z-ADD13 Y PART # I0336003340CSR 93 Z-ADD14 Y TRAN QTY I0337003350CSR 94 Z-ADD15 Y REF # (COMMENT)I0338003360CSR 95 Z-ADD16 Y BUY COST I033900003370C* (OVERRIDE) I0340003380CSR EXSR KEEP1 I0341003390CSR ACLOOP TAG I0342003400CSR MOVELXYPOS BUFFER I0343003410CSR EXSR POSCUR I0344003420CSR MOVELBLNKS BUFFER I0345003430CSR MOVE LENG BLNGTH I034600003440CSR MOVE 'A' TYPE I0347003450CSR EXSR CRTCOM I0348003460CSR RCODE COMP 'R' 31RUBOUT I0349003470CSR 31 BUFFER COMP BLNKS,1 32GO BACK A FIELDI0350003480CSR 31 32 GOTO ENDACP I0351003490CSR 31 GOTO ACLOOP I0352003500CSR RCODE COMP 'L' 33LINEFEED I035300003510CSRN33 91 MOVELBUFFER EOJ 1 I0354003520CSRN33 91 EOJ COMP 'E' 10END OF JOB I0355003530CSRN33 91 10 GOTO ENDACP I0356003540CSRN33 91 EOJ COMP 'M' 80 I0357003550CSRN33 91 80 GOTO ENDACP I0358003560CSRN33 91 MOVELBUFFER ALPH1 2 TRAN # I0359003570CSRN33 91 EXSR RTADJ I036000003580CSRN33 92 MOVELBUFFER PARTNO 20 I0361003590CSRN33 93 MOVELBUFFER MINUS 1 I0362003600CSRN33 93 MINUS COMP '-' 60 I0363003610CSRN33 93 60 MOVELBUFFER ALPH3 8 I0364003620CSRN33 93 60 MOVE ALPH3 ALPH4 7 I0365003630CSRN33 93N60 MOVELBUFFER ALPH4 I0366003640CSRN33 93 EXSR RTADJ I036700003650CSRN33 93 60 Z-SUBQTY QTY NUMERIC TN QTY I0368003660CSRN33 94 MOVELBUFFER REFNUM 7 I0369003670CSRN33 95 MOVELBUFFER WORD7 7 I0370003680CSRN33 95 EXSR RTADJ I0371003690CSRN33 GOTO ENDACC I0372003700CSR 91 MOVELTN BUFFER I0373003710CSR 92 MOVELPARTNO BUFFER I037400003720CSR 93 MOVELBLIND BUFFER I0375003730CSR 94 MOVELREFNUM BUFFER I0376003740CSR 95 MOVELOVCOST BUFFER I0377003750CSR ENDACC TAG I0378003760CSR EXSR CONFRM I0379003770CSR SETOF 11 I0380003780CSRN93N94N95 EXSR EDIT I038100003790CSR 11 GOTO AALOOP I0382003800CSR ENDACP ENDSR I0383003810C********************************************************************I0384003820C* I0385003830C* THIS SUBROUTINE RIGHT ADJUSTS. PROD #/TRAN #/TRAN QTY I0386003840C* I0387003850C********************************************************************I038800003860CSR RTADJ BEGSR I0389003870CSR 91 Z-ADDLENG VL I0390003880CSR 93 LENG SUB 1 VL I0391003890CSR 95 Z-ADDLENG VL I0392003900CSR 91 MOVELALPH1 VAR I0393003910CSR 93 MOVELALPH4 VAR I0394003920CSR 95 MOVELWORD7 VAR I039500003930CSR EXIT SUBRAJ I0396003940CSR RLABL VL 20 I0397003950CSR RLABL VAR 15 I0398003960CSR 91 MOVELVAR BUFFER I0399003970CSR 91 MOVELVAR TN 20 I0400003980CSR 93 MOVELVAR QTY 70 I0401003990CSR 93 60 MOVEL'-' ALPH3 I040200004000CSR 93N60 MOVEL' ' ALPH3 I0403004010CSR 93 MOVE QTY ALPH3 I0404004020CSR 93 MOVELALPH3 BUFFER I0405004030CSR 95 MOVELVAR BUFFER I0406004040CSR 95 MOVELVAR OVCOST 73 I0407004050CSR ENDSR I0408004060C********************************************************************I040900004070C* I0410004080C* THIS SUBROUTINE OUTPUTS THE FIELD AGAIN AFTER REPLACING THE I0411004090C* RIGHT BRACKET. I0412004100C* I0413004110C********************************************************************I0414004120CSR CONFRM BEGSR I0415004130CSR MOVE BUFFER FERBUF 72 I041600004140CSR MOVELXYPOS BUFFER I0417004150CSR EXSR POSCUR I0418004160CSR BLNGTH ADD 1 BLNGTH I0419004170CSR Z-ADD1 NCHARS 30 I0420004180CSR Z-ADD1 SSTRT 30 I0421004190CSR Z-ADDBLNGTH TSTRT 30 I0422004200CSR EXIT SUBRMV I042300004210CSR RLABL RTBRK I0424004220CSR RLABL SSTRT 30 I0425004230CSR RLABL FERBUF I0426004240CSR RLABL TSTRT 30 I0427004250CSR RLABL NCHARS 30 I0428004260CSR MOVELFERBUF BUFFER I0429004270CSR MOVE 'S' TYPE I043000004280CSR EXSR CRTCOM I0431004290CSR ENDSR I0432004300C********************************************************************I0433004310C* I0434004320C* THIS SUBROUTINE EDITS CRT ENTRIES. I0435004330C* I0436004340C********************************************************************I043700004350CSR EDIT BEGSR I0438004360CSRN91 GOTO TRY92 I0439004370C* I0440004380CSR TN LOKUPTABA TABB 61 I0441004390CSRN61 SETON 11 I0442004400CSR Z-ADD17 Y I0443004410CSRN11 SETON 90 I044400004420CSR MOVELTABB MESS I0445004430CSR EXSR OUTPT I0446004440CSR SETOF 90 I0447004450CSR GOTO EEDIT I0448004460C* I0449004470CSR TRY92 TAG I0450004480C* I045100004490CSR PARTNO CHAINPARTMST 11 I0452004500CSRN11N22 SETON 11 I0453004510CSR Z-ADD18 Y I0454004520CSRN11 SETON 90 I0455004530CSR EXSR OUTPT I0456004540CSR SETOF 90 I0457004550C* I045800004560CSR EEDIT ENDSR I0459004570C********************************************************************I0460004580C* I0461004590C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. I0462004600C* I0463004610C********************************************************************I0464004620CSR CRTCOM BEGSR I046500004630CSR EXITFSUBRCM I0466004640CSR RLABL BUFFER I0467004650CSR RLABL TYPE 1 I0468004660CSR RLABL BLNGTH 20 I0469004670CSR RLABL RCODE 1 I0470004680CSR RLABL MASK 10 I0471004690CSR RLABL DTYPE 10 I047200004700CSR ENDSR I0473004710C********************************************************************I0474004720C* I0475004730C* THIS SUBROUTINE CLEARS THE SCREEN. I0476004740C* I0477004750C********************************************************************I0478004760CSR CLRSCR BEGSR I047900004770CSR MOVE 'C' TYPE I0480004780CSR EXSR CRTCOM I0481004790CSR ENDSR I0482004800C********************************************************************I0483004810C* I0484004820C* THIS SUBROUTINE POSITIONS THE CURSOR. I0485004830C* I048600004840C********************************************************************I0487004850CSR POSCUR BEGSR I0488004860CSR MOVE 'P' TYPE I0489004870CSR EXSR CRTCOM I0490004880CSR ENDSR I0491004890C********************************************************************I0492004900C* I049300004910C* THIS SUBROUTINE UNPACKS THE DATA FROM THE PARAMETER I0494004920C* ARRAY 'MSG'. I0495004930C* I0496004940C********************************************************************I0497004950CSR KEEP1 BEGSR I0498004960CSR MOVE MSG,Y WORD50 50 I0499004970CSRN90 MOVELWORD50 MESS 50 I050000004980CSR MOVELMSG,Y WORD6 6 I0501004990CSR MOVELWORD6 XYPOS 40 I0502005000CSR XYPOS ADD Z XYPOS I0503005010CSR MOVE WORD6 LENG 20 I0504005020CSR ENDSR I0505005030C********************************************************************I0506005040C* I050700005050C* THIS SUBROUTINE DISPLAYS A SINGLE FIELD OR PROMPTING MESSAGE. I0508005060C* I0509005070C********************************************************************I0510005080CSR OUTPT BEGSR I0511005090CSR EXSR KEEP1 I0512005100CSR MOVELXYPOS BUFFER I0513005110CSR EXSR POSCUR I051400005120CSR MOVE LENG BLNGTH I0515005130CSR MOVE 'S' TYPE I0516005140CSR MOVELMESS BUFFER I0517005150CSR EXSR CRTCOM I0518005160CSR 65 81N90 EXSR CHGSUB I0519005170CSR ENDSR I0520005180C********************************************************************I052100005190C* THIS SUBROUTINE ACCEPTS SEQ NO I0522005200C********************************************************************I0523005210CSR GETSEQ BEGSR I0524005220CSR EXSR SKIP I0525005230CSR MOVEL'SEQ # - 'WORD 8 I0526005240CSR Z-ADD8 OLN 20 I0527005250CSR Z-ADD5 ILN 20 I052800005260CSR EXSR TYPES I0529005270CSR Z-ADD5 VL I0530005280CSR MOVELBUFFER VAR I0531005290CSR EXIT SUBRAJ I0532005300CSR RLABL VL I0533005310CSR RLABL VAR I0534005320CSR MOVELVAR SEQNO I053500005330CSR SEQNO COMP 0 20 I0536005340CSRN20 Z-ADD1 SEQNO I0537005350CSR EXSR SKIP I0538005360CSR ENDSEQ ENDSR I0539005370C********************************************************************I0540005380C* THIS SUBROUTINE GETS TRANTMP RECORD I0541005390C********************************************************************I054200005400CSR GETREC BEGSR I0543005410CSR SEQRD TAG I0544005420CSR EXSR TSTSEQ I0545005430CSR 74 EXSR GETSEQ I0546005440CSR 74 GOTO SEQRD I0547005450CSR SEQNO CHAINTRANTMP 56 I0548005460CSR TST COMP '<>' 49 I054900005470CSR 81 49 EXSR NOCHG I0550005480CSR 81 49 GOTO SEQRD I0551005490CSR 82N49 SEQNO ADD 1 SEQNO 50 I0552005500CSRN49N56 82 GOTO SEQRD I0553005510CSR 56 82 I0554005520COR 56 81 MOVELMES,1 BUFFER I0555005530CSR 56 82 I055600005540COR 56 81 MOVE 'T' TYPE I0557005550CSR 56 82 I0558005560COR 56 81 Z-ADD50 BLNGTH I0559005570CSR 56 82 I0560005580COR 56 81 EXSR CRTCOM I0561005590CSR 56 82 I0562005600COR 56 81 EXSR GETSEQ I056300005610CSR 56 82 I0564005620COR 56 81 GOTO SEQRD I0565005630CSR ENDSR I0566005640C********************************************************************I0567005650C* THIS SUBROUTINE SENDS MESSAGE AND ACCEPTS I0568005660C********************************************************************I0569005670CSR TYPES BEGSR I057000005680CSR OVER TAG I0571005690CSR Z-ADDOLN BLNGTH I0572005700CSR MOVELWORD BUFFER I0573005710CSR MOVE 'S' TYPE I0574005720CSR EXSR CRTCOM I0575005730CSR MOVE 'A' TYPE I0576005740CSR Z-ADDILN BLNGTH I057700005750CSR EXSR CRTCOM I0578005760CSR RCODE COMP 'R' 25 I0579005770CSR 25 EXSR SKIP I0580005780CSR 25 GOTO OVER I0581005790CSR RCODE COMP 'O' 25 I0582005800CSR 25 EXSR SKIP I0583005810CSR ENDSR I058400005820C********************************************************************I0585005830C* THIS SUBROUTINE SKIPS TO THE NEXT CRT LINE I0586005840C********************************************************************I0587005850CSR SKIP BEGSR I0588005860CSR Z ADD 1 Z I0589005870CSR MOVELBUFFER NBUF 1 I0590005880CSR MOVEL' ' BUFFER I059100005890CSR Z-ADD1 BLNGTH I0592005900CSR MOVE 'T' TYPE I0593005910CSR EXSR CRTCOM I0594005920CSR MOVELNBUF BUFFER I0595005930CSR ENDSR I0596005940C********************************************************************I0597005950C* THIS SUBROUTINE ACCEPTS BEGINNING AND ENDING LIMITS I059800005960C********************************************************************I0599005970CSR ALMTS BEGSR I0600005980CSR EXSR CLRSCR I0601005990CSR MOVELMES,2 BUFFER I0602006000CSR MOVE 'S' TYPE I0603006010CSR Z-ADD50 BLNGTH I0604006020CSR EXSR CRTCOM I060500006030CSR MOVE 'A' TYPE I0606006040CSR Z-ADD5 BLNGTH I0607006050CSR Z-ADD1 DTYPE I0608006060CSR EXSR CRTCOM I0609006070CSR EXSR SKIP I0610006080CSR RCODE COMP 'R' 76 I0611006090CSR Z-ADD5 VL I061200006100CSR MOVELBUFFER VAR I0613006110CSR EXIT SUBRAJ I0614006120CSR RLABL VL I0615006130CSR RLABL VAR I0616006140CSR MOVELVAR BUFFER I0617006150CSR MOVELBUFFER LOW 50 I0618006160CSR MOVELMES,3 BUFFER I061900006170CSR MOVE 'S' TYPE I0620006180CSR Z-ADD50 BLNGTH I0621006190CSR EXSR CRTCOM I0622006200CSR MOVE 'A' TYPE I0623006210CSR Z-ADD5 BLNGTH I0624006220CSR Z-ADD1 DTYPE I0625006230CSR EXSR CRTCOM I062600006240CSR RCODE COMP 'R' 77 I0627006250CSR Z-ADD5 VL I0628006260CSR MOVELBUFFER VAR I0629006270CSR EXIT SUBRAJ I0630006280CSR RLABL VL I0631006290CSR RLABL VAR I0632006300CSR MOVELVAR BUFFER I063300006310CSR MOVELBUFFER HIGH 50 I0634006320CSR MOVE 'C' TYPE I0635006330CSR EXSR CRTCOM I0636006340CSR 76 I0637006350COR 77 GOTO ALMTS I0638006360CSR Z-ADD0 DTYPE I0639006370CSR ENDSR I064000006380C********************************************************************I0641006390C* THIS SUBROUTINE VERIFIES THAT RECORD IS WITHIN LIMITS I0642006400C********************************************************************I0643006410CSR TSTSEQ BEGSR I0644006420CSR SETOF 747677 I0645006430CSR SEQNO COMP LOW 787678 I0646006440CSR 78 SEQNO COMP HIGH 777878 I064700006450CSR 78 GOTO ENDTST I0648006460CSR 82 76 MOVE MES,4 BUFFER I0649006470CSR 82 77 MOVE MES,5 BUFFER I0650006480CSRN82 MOVELMES,6 BUFFER I0651006490CSRN82 SETON 74 I0652006500CSR MOVE 'T' TYPE I0653006510CSR Z-ADD50 BLNGTH I065400006520CSR EXSR CRTCOM I0655006530CSR 82 77 MOVE 'F' TYPE I0656006540CSR 82 77 EXSR CRTCOM I0657006550CSR ENDTST ENDSR I0658006560C********************************************************************I0659006570C* THIS SUBROUTINE PUTS OUT EXISTING FIELDS I0660006580CSR CHGSUB BEGSR I066100006590CSR XYPOS ADD 100 PXYPOS 40 I0662006600CSR MOVELPXYPOS BUFFER I0663006610CSR EXSR POSCUR I0664006620CSR Y COMP 8 66 I0665006630CSR 66 MOVELTN BUFFER DISPLAY I0666006640CSR 66 Z-ADD2 BLNGTH EXISTING I0667006650CSR 66 GOTO ENDCHG TRAN NO I066800006660CSR Y COMP 9 66 DISPLAY I0669006670CSR 66 MOVELPARTNO BUFFER PART NO I0670006680CSR 66 Z-ADD20 BLNGTH I0671006690CSR 66 GOTO ENDCHG I0672006700CSR Y COMP 10 66 I0673006710CSR 66 MOVELBLIND BUFFER QTY I0674006720CSR 66 Z-ADD7 BLNGTH I067500006730CSR 66 GOTO ENDCHG I0676006740CSR Y COMP 11 66 I0677006750CSRN66 GOTO ENDCHG I0678006760CSR MOVELREFNUM BUFFER I0679006770CSR 28 MOVELOVCOST BUFFER I0680006780CSR Z-ADD7 BLNGTH I0681006790CSR ENDCHG TAG I068200006800CSR MOVE 'S' TYPE I0683006810CSR EXSR CRTCOM I0684006820CSR Y COMP 9 66 I0685006830CSR 66 PARTNO CHAINPARTMST 11 I0686006840CSR 66N11 MOVELDESCRP MESS I0687006850CSR 66 SETON 90 I0688006860CSR 66 Z-ADD18 Y I068900006870CSR 66 EXSR OUTPT I0690006880CSR 66 Z-ADD9 Y I0691006890CSR 66 SETOF 90 I0692006900CSR ENDSR I0693006910CSR NOCHG BEGSR I0694006920CSR MOVELMES,7 BUFFER I0695006930CSR Z-ADD50 BLNGTH I069600006940CSR MOVE 'T' TYPE I0697006950CSR EXSR CRTCOM I0698006960CSR EXSR GETSEQ I0699006970CSR ENDSR I0700006980C*********************************************************************0701006990C* 0702007000C*THIS SUBROUTINE UPDATRES THE AVERAGE MATERIAL COST/UNIT. 070300007010C* 0704007020C*********************************************************************0705007030CSR CALC1 BEGSR 0706007040CSR 21 Z-ADDSTDCST OVCOST 0707007050CSR Z-ADDSV2 SOTT 70 0708007060CSR SV1 MULT SOH A 73 0709007070CSR BLIND MULT OVCOST B 73 071000007080CSR A ADD B A 0711007090CSR SOH ADD BLIND B 0712007100CSR A DIV B SV1 H 0713007110CSR ENDSR 0714007120C*********************************************************************0715007130C* 0716007140C* THIS SUBROUTINE UPDATES: 1. STOCK-ON-HAND 071700007150C* 2. STOCK-ON-ORDER 0718007160C* 3. ALLOCATION 0719007170C* 4. MTD USAGE-M 0720007180C* 5. AVERAGE USAGE-M 0721007190C* 6. YTD USAGE-M 0722007200C* 7. MTD USAGE-D 0723007210C* 8. AVERAGE USAGE-D 072400007220C* 9. YTD USAGE-D 0725007230C* 0726007240C*********************************************************************0727007250CSR CALC2 BEGSR 0728007260CSR X COMP 1 70STOCK-ON-HAND 0729007270CSR X COMP 2 71STOCK-ON-ORDER 0730007280CSR X COMP 3 72ALLOCATE 073100007290CSR X COMP 4 83MTD USAGE-M 0732007300CSR X COMP 5 88AVERAGE USAGE-M 0733007310CSR X COMP 6 89YTD USAGE-M 0734007320CSR X COMP 7 51MTD USAGE-D 0735007330CSR X COMP 8 52AVERAGE USAGE-D 0736007340CSR X COMP 9 53YTD USAGE-D 0737007350CSR Y COMP 1 84' ' 073800007360CSR Y COMP 2 85'+' 0739007370CSR Y COMP 3 86'-' 0740007380CSR Y COMP 4 87'R' 0741007390C* 0742007400CSR 84 GOTO ENDC2 0743007410CSR 70 Z-ADDSV2 WORK 70 SOH 0744007420CSR 71 Z-ADDSV3 WORK SOO 074500007430CSR 72 Z-ADDSV4 WORK ALLOCA 0746007440CSR 83 Z-ADDSV5 WORK MTD USAGE-M 0747007450CSR 88 Z-ADDSV6 WORK AVGUSE-M 0748007460CSR 89 Z-ADDSV7 WORK YTD USAGE-M 0749007470CSR 51 Z-ADDSV8 WORK MTD USAGE-D 0750007480CSR 52 Z-ADDSV10 WORK AVGUSE-D 0751007490CSR 53 Z-ADDSV9 WORK YTD USAGE-D 075200007500C* 0753007510CSR 85 WORK ADD BLIND WORK FLD + QTY = FLD 0754007520CSR 86 WORK SUB BLIND WORK FLD - QTY = FLD 0755007530CSR 87 Z-ADDBLIND WORK QTY INTO FLD 0756007540C* 0757007550CSR 70 Z-ADDWORK SV2 SOH 0758007560CSR 71 Z-ADDWORK SV3 SOO 075900007570CSR 72 Z-ADDWORK SV4 ALLOCA 0760007580CSR 83 Z-ADDWORK SV5 MTD USAGE-M 0761007590CSR 88 Z-ADDWORK SV6 AVGUSE-M 0762007600CSR 89 Z-ADDWORK SV7 YTD USAGE-M 0763007610CSR 51 Z-ADDWORK SV8 MTD USAGE-D 0764007620CSR 52 Z-ADDWORK SV10 AVGUSE-D 0765007630CSR 53 Z-ADDWORK SV9 YTD USAGE-D 076600007640C* 0767007650CSR ENDC2 ENDSR 0768007660OPARTMST E 02N20 0769007670O SV1 B 88 0770007680O SV2 B 152 0771007690O SV3 B 159 0772007700O SV4 B 173 077300007710O SV5 B 202 0774007720O SV6 B 209 0775007730O SV7 B 218 0776007740O SV8 B 166 0777007750O SV9 B 180 0778007760O SV10 B 265 0779007770OTRANTMP E 02N56N20 078000007780O 2 ' ' 0781007790O PARTNO 61 0782007800O TN 14 0783007810O BLIND 21 0784007820O REFNUM 28 0785007830O 55 OVCOST 41 07860** 0784000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 07850ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 07860ALTSEQ 6E3E6F3F7C40C141C242C343C545C646C747C848C949D14AD24BD34CD44DC444 07870ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 07880** 00789010NEW SO 00790012DELETE SO 0079100014INVOICE 00792016CR MEMO 00793018MANUAL INV 00794020DRECT BILL 00795040NEW PO 00796042RPL PO QTY 00797043RPL PO REC 0079800044PO RECEIPT 00799045DELETE PO 00800060OPEN WO 00801061WO COMPT 00802062RLSE WO 00803063MTL ISSUE 00804064CHG WO QTY 0080500065MAT JOB QT 00806066DLT OPN WO 00807067DEC RS DLT 00808068CL WO SHRT 00809070ADJ STK RQ 00810072COM PRD #1 00811073COM PRD #2 0081200080ADJ ALLOC 00813082ADJUST SOO 00814084REPLCE SOO 00815086ADJUST SOH 00816087ADJ AVGU D 00817088REPLCE SOH 00818089RPL AVGU D 0081900090ADJ AVGU M 00820091ADJ MTDU D 00821092RPL AVGU M 00822093ADJ MTDU M 00823094RPL MTDU M 00824095ADJ YTDU M 00825096RPL YTDU M 0082600097RPL MTDU D 00827098ADJ YTDU D 00828099RPL YTDU D 008290** 008300250122INVENTORY TRANSACTIONS 008310020304TRAN 008320070304TYPE 00833000190306PART # 008340330311 08350600308QUANTITY 008360700309REF#/COST 008370020504[ ] 008380180522[ ] 008390590510[ ] 00840000700509[ ] 008410030502 008420190520 008430600508 008440710507 008450710507 008460070510**INVALID 00847000420516**INVALID PART # 008480** 008490RECORD NOT IN FILE 008500ENTER BEGINNING RRN 008510ENTER ENDING RRN 008520SEQNO TOO LOW 008530RUN EDIT PROG-FILE FULL 00854000SEQNO NOT IN LIMITS 008550RECORD HAS NO DATA-USE MODE A TO ADD 008560** 00857010 + 00858012 - 00859014- - + 00860016- + 0086100018- + 00862020- + 00863040 + 00864042 + 00865043+- 00866044+- 00867045 - 0086800060 + 00869061 + 00870062- -+ 00871063- + 00872064 + 00873065 + 00874066 - 0087500067 - 00876068 - 00877070- + 00878072+ 00879073 - 00880080 + 00881082 + 0088200084 R 00883086+ 00884087 + 00885088R 00886089 R 00887090 + 00888091 + 0088900092 R 00890093 + 00891094 R 00892095 + 00893096 R 00894097 R 00895098 + 0089600099 R 008970** 008980 +-R 008990** 00900043 00901044 009020/* 00903000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( ETXOE030 P999999032778(000010H S OE030 00020X DECK-ID A49 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE030 00030F* INQUIRY AND MAINTENANCE OF CONTROL FILE OE030 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE030 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE030 00060F* CONTROL DATA PROPRIETARY PRODUCT OE030 00070F* OE030 0000080FNULL IPEAF 72 DISK OE030 00090F@DIS30 IC F 32R DISK OE030 00100FCONTROL UC F 0256R07AI 0001 DISK A OE030 00110E FN 050 22 FIELD NAME OE030 00120E CP 050 4 CURSOR POSITION OE030 00130E LN 050 2 0 LENGTH OE030 00140E EP 050 4 0 ENDING POSITION OE030 0000150INULL NS 01 OE030 00160I 1 1 A OE030 00170I@DIS30 NS 02 OE030 00180I 1 22 FIELDN OE030 00190I 23 26 CURPOS OE030 00200I 27 280LNGTH OE030 00210I 29 310ENDPOS OE030 0000220ICONTROL NS 03 OE030 00230I 10256 RECORD OE030 00240C MOVE ' ' RCODE 1 OE030 00250C MOVE RCODE B22 22 OE030 00260C MOVE RCODE BLANKS 72 OE030 00270C MOVE RCODE FILLER 1 OE030 00280C Z-ADD0 MASK 10 OE030 0000290C SETON LR OE030 00300CLR Z-ADD050 SSIZE 30 OE030 00310CLR Z-ADD006 NSECT 30 OE030 00320C* OE030 00330CLR MOVE '[]<>' TEMP4 4 OE030 00340CLR START TAG OE030 00350C* ********** OE030 0000360CLR EXSR FIRSTP OE030 00370C* ********** OE030 00380CLR EXSR CLRSCR OE030 00390C* ********** OE030 00400CLR 40 GOTO EOJ OE030 00410C* ********** OE030 00420CLR Z-ADD2 VL OE030 0000430CLR MOVELSECTON VAR OE030 00440CLR EXSR RTADJ OE030 00450C* ********** OE030 00460CLR MOVELVAR SECTN 20 OE030 00470CLR EXSR GETSEC OE030 00480C* ********** OE030 00490CLRN45 GOTO START OE030 0000500C* ********** OE030 00510CLR EXSR CLRSCR OE030 00520C* ********** OE030 00530CLR EXSR OUTPUT OE030 00540C* ********** OE030 00550CLR EXSR UPDATE OE030 00560C* ********** OE030 0000570CLR GOTO START OE030 00580C* ********** OE030 00590CLR EOJ TAG OE030 00600C* ********** OE030 00610C********************************************************************OE030 00620C* OE030 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE030 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE030 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE030 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE030 00670C* OE030 00680C********************************************************************OE030 00690CSR FIRSTP BEGSR OE030 00700C* ********** OE030 0000710CSR EXSR CLRSCR OE030 00720C* ********** OE030 00730CSR Z-ADD0 SECTN OE030 00740CSR EXSR GETSEC OE030 00750C* ********** OE030 00760CSR PGE TAG OE030 00770C* ********** OE030 0000780CSR SETON 61 OE030 00790CSR SETOF 62 OE030 00800CSR EXSR OUTPUT OE030 00810C* ********** OE030 00820CSR EXIT SUBRFL OE030 00830C* ********** OE030 00840CSR RLABL RECORD OE030 0000850CSR RLABL FILLER 1 OE030 00860C* ********** OE030 00870C* ********** OE030 00880C* ********** OE030 00890C* ********** OE030 00900C* ********** OE030 00910C* ********** OE030 0000920C* ********** OE030 00930C* ********** OE030 00940C* ********** OE030 00950C* ********** OE030 00960C* ********** OE030 00970C* ********** OE030 00980C* ********** OE030 0000990C* ********** OE030 01000C* ********** OE030 01010CSR Z-ADD07 NCHARS OE030 01020CSR Z-ADD1 SSTRT OE030 01030CSR Z-ADD0001 TSTRT OE030 01040C* ********** OE030 01050CSR EXIT SUBRLM OE030 0001060CSR RLABL KEY 07 OE030 01070CSR RLABL SSTRT 30 OE030 01080CSR RLABL RECORD OE030 01090CSR RLABL TSTRT 30 OE030 01100CSR RLABL NCHARS 30 OE030 01110CSR Z-ADDNOFLDS SVFLDS 30 OE030 01120CSR Z-ADDSX NOFLDS OE030 0001130CSR MOVEL'CONTROL' RECORD OE030 01140C* ********** OE030 01150CSR Z-ADDSVFLDS NOFLDS OE030 01160CSR Z-ADD07 NCHARS OE030 01170CSR Z-ADD0001 SSTRT OE030 01180CSR Z-ADD1 TSTRT OE030 01190C* ********** OE030 0001200CSR EXIT SUBRLM OE030 01210CSR RLABL RECORD OE030 01220CSR RLABL SSTRT 30 OE030 01230CSR RLABL KEY OE030 01240CSR RLABL TSTRT 30 OE030 01250CSR RLABL NCHARS 30 OE030 01260CSR KEY CHAINCONTROL 55 OE030 0001270CSR MOVELSAVPOS BUFFER OE030 01280CSR MOVELOFC BUFFER OE030 01290CSR MOVEL'3403' BUFFER OE030 01300CSR EXSR POSCUR OE030 01310C* ********** OE030 01320CSR MOVEL'] NEW R'WORD16 16 OE030 01330CSR MOVE 'ECORD 'WORD16 OE030 0001340CSRN55 MOVELBLANKS WORD16 OE030 01350CSRN55 MOVEL']' WORD16 OE030 01360CSR MOVELWORD16 BUFFER 72 OE030 01370CSR MOVE 'T' TYPE 1 OE030 01380CSR Z-ADD13 BLNGTH 20 OE030 01390CSR EXSR CRTCOM OE030 01400C* ********** OE030 0001410CSR SETON 62 OE030 01420CSR Z-ADDSX X 30 OE030 01430CSR EXSR ACCEPT OE030 01440C* ********** OE030 01450CSR MOVELBUFFER SECTON 2 OE030 01460CSR SECTON COMP 'E ' 40 OE030 01470CSR 40 GOTO ENDFP OE030 0001480C* ********** OE030 01490C* OE030 01500C* OE030 01510C* OE030 01520C* OE030 01530CSR SECTON COMP ' 1' 30 30 OE030 01540CSR 30 SECTON COMP ' 9' 3030 OE030 0001550CSR 30 GOTO GOOD OE030 01560C* ********** OE030 01570CSR SECTON COMP '01' 30 30 OE030 01580CSR 30 SECTON COMP '09' 3030 OE030 01590CSR 30 GOTO GOOD OE030 01600C* ********** OE030 01610CSR SECTON COMP '1 ' 30 30 OE030 0001620CSR 30 SECTON COMP '9 ' 3030 OE030 01630CSR 30 GOTO GOOD OE030 01640C* ********** OE030 01650CSR MOVELSECTON TEMP1 1 OE030 01660CSR TEMP1 COMP '1' 30 30 OE030 01670CSR 30 TEMP1 COMP '9' 3030 OE030 01680CSRN30 GOTO PGE OE030 0001690C* ********** OE030 01700CSR MOVE SECTON TEMP1 OE030 01710CSR TEMP1 COMP '0' 30 30 OE030 01720CSR 30 TEMP1 COMP '9' 3030 OE030 01730CSRN30 GOTO PGE OE030 01740C* ********** OE030 01750CSR GOOD TAG OE030 0001760C* ********** OE030 01770CSR SETOF 6162 OE030 01780CSRN55 GOTO ENDFP OE030 01790C* ********** OE030 01800CSR SETON 80 OE030 01810CSR EXCPT OE030 01820CSR SETOF 80 OE030 0001830CSR KEY CHAINCONTROL 55 OE030 01840CSR ENDFP ENDSR OE030 01850C* ********** OE030 01860C********************************************************************OE030 01870C* OE030 01880C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE030 01890C* OE030 0001900C********************************************************************OE030 01910CSR GETSEC BEGSR OE030 01920C* ********** OE030 01930CSR 1 ADD SECTN N 20 OE030 01940CSR SETOF 404145 OE030 01950CSR N COMP 0 3030 OE030 01960CSRN30 N COMP NSECT 30 OE030 0001970CSR 30 GOTO ENDGET OE030 01980C* ********** OE030 01990CSR SECTN MULT SSIZE RRN 40 OE030 02000CSR Z-ADD1 X OE030 02010CSR SCLOOP TAG OE030 02020C* ********** OE030 02030CSR RRN ADD 1 RRN OE030 0002040CSR RRN CHAIN@DIS30 50 OE030 02050CSR 50 GOTO ENDGET OE030 02060C* ********** OE030 02070CSR FIELDN COMP B22 4141 OE030 02080CSRN41 GOTO ENDGET OE030 02090C* ********** OE030 02100CSR 41N45 SETON 45 OE030 0002110CSR MOVE FIELDN FN,X OE030 02120CSR MOVE CURPOS CP,X OE030 02130CSR MOVE LNGTH LN,X OE030 02140CSR Z-ADDENDPOS EP,X OE030 02150CSR 1 ADD X X OE030 02160CSR X COMP SSIZE 32 OE030 02170CSRN32 GOTO SCLOOP OE030 0002180C* ********** OE030 02190CSR ENDGET TAG OE030 02200C* ********** OE030 02210CSR Z-ADDX NOFLDS 30 OE030 02220CSR 45 GOTO FINGET OE030 02230C* ********** OE030 02240CSR EXSR CLRSCR OE030 0002250C* ********** OE030 02260CSR MOVEL'SECT # 'WORD9 9 OE030 02270CSR Z-ADD16 BLNGTH OE030 02280CSR MOVE SECTN WORD9 OE030 02290CSR MOVELWORD9 WORD16 OE030 02300CSRN30 MOVE ' ABSENT' WORD16 OE030 02310CSR 30 MOVE ' ILLEG.' WORD16 OE030 0002320CSR MOVELWORD16 BUFFER OE030 02330CSR MOVEL'T' TYPE OE030 02340CSR EXSR CRTCOM OE030 02350C* ********** OE030 02360CSR FINGET ENDSR OE030 02370C* ********** OE030 02380C********************************************************************OE030 0002390C* OE030 02400C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE030 02410C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE030 02420C* SECTION INDEX IS SAVED. OE030 02430C* OE030 02440C********************************************************************OE030 02450CSR OUTPUT BEGSR OE030 0002460C* ********** OE030 02470CSR EXSR CLRSCR OE030 02480C* ********** OE030 02490CSR Z-ADD1 X OE030 02500CSR 61 SETON 63 OE030 02510CSR OTLOOP TAG OE030 02520C* ********** OE030 0002530CSR 61 LN,X COMP 0 31 OE030 02540CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE030 02550CSR EXSR OUTFLD OE030 02560C* ********** OE030 02570CSR X ADD 1 X OE030 02580CSR X COMP NOFLDS 31 OE030 02590CSR 31 GOTO OTLOOP OE030 0002600C* ********** OE030 02610CSR SETOF 63 OE030 02620CSR ENDSR OE030 02630C********************************************************************OE030 02640C* OE030 02650C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE030 02660C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE030 0002670C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE030 02680C* THEN NO FIELD INFORMATION IS PRINTED OE030 02690C* OE030 02700C********************************************************************OE030 02710CSR OUTFLD BEGSR OE030 02720C* ********** OE030 02730CSR MOVE FN,X FL 20 OE030 0002740CSR EP,X COMP 0 98 OE030 02750CSR MOVELCP,X FC 20 OE030 02760CSR FC COMP FL 31 OE030 02770CSR 31 Z-ADDFC FL OE030 02780CSR FC SUB FL CC 20 OE030 02790CSR CC ADD 1 CC OE030 02800CSR MOVELCP,X BUFFER OE030 0002810CSR MOVELCC BUFFER OE030 02820CSR EXSR POSCUR OE030 02830C* ********** OE030 02840CSR MOVELBLANKS BUFFER OE030 02850CSR MOVELFN,X FIELDN OE030 02860CSR MOVE ' ' FIELDN OE030 02870CSR MOVELFIELDN BUFFER OE030 0002880CSR Z-ADDLN,X LEN 20 OE030 02890CSR LEN COMP 0 9730 OE030 02900CSR 97 Z-SUBLN,X LEN OE030 02910CSR 30 GOTO SKIPF OE030 02920C* ********** OE030 02930CSR FL ADD 2 BPOS 20 OE030 02940C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE030 0002950CSRN98 Z-ADD1 SSTRT 30 OE030 02960CSR Z-ADDBPOS TSTRT 30 OE030 02970CSR 98 Z-ADD3 SSTRT OE030 02980CSR Z-ADD1 NCHARS 30 OE030 02990C* ********** OE030 03000CSR EXIT SUBRLM OE030 03010CSR RLABL TEMP4 OE030 0003020CSR RLABL SSTRT 30 OE030 03030CSR RLABL BUFFER OE030 03040CSR RLABL TSTRT 30 OE030 03050CSR RLABL NCHARS 30 OE030 03060CSR BPOS ADD 1 FPOS 20 OE030 03070CSR EXSR MVRECD OE030 03080C* ********** OE030 0003090CSR SKIPF TAG OE030 03100C* ********** OE030 03110CSR 30 Z-ADDFL BLNGTH OE030 03120CSRN30 FL ADD 3 BLNGTH OE030 03130CSRN30 BLNGTH ADD LEN BLNGTH OE030 03140CSR MOVE 'T' TYPE OE030 03150CSR EXSR CRTCOM OE030 0003160C* ********** OE030 03170CSR ENDSR OE030 03180C********************************************************************OE030 03190C* OE030 03200C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE030 03210C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE030 03220C* THE RIGHT BRACKET. OE030 0003230C********************************************************************OE030 03240CSR MVRECD BEGSR OE030 03250C* ********** OE030 03260CSR 63 GOTO RBRK OE030 03270C* ********** OE030 03280CSR 98 Z-SUBEP,X END 40 OE030 03290CSRN98 Z-ADDEP,X END OE030 0003300CSR END SUB LEN STRT 40 81 81 OE030 03310CSR STRT ADD 1 STRT OE030 03320C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE030 03330C* FROM STRT IN RECORD TO FPOS IN BUFFER OE030 03340CSR Z-ADDLEN NCHARS OE030 03350CSR Z-ADDSTRT SSTRT OE030 03360CSR Z-ADDFPOS TSTRT OE030 0003370C* ********** OE030 03380CSRN81 GOTO RBRK OE030 03390CSR EXIT SUBRLM OE030 03400CSR RLABL RECORD OE030 03410CSR RLABL SSTRT 30 OE030 03420CSR RLABL BUFFER OE030 03430CSR RLABL TSTRT 30 OE030 0003440CSR RLABL NCHARS 30 OE030 03450CSR RBRK TAG OE030 03460C* ********** OE030 03470CSR EXSR RTBRKT OE030 03480C* ********** OE030 03490CSR ENDSR OE030 03500C********************************************************************OE030 0003510C* OE030 03520C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE030 03530C* OE030 03540C********************************************************************OE030 03550CSR RTBRKT BEGSR OE030 03560C* ********** OE030 03570CSR LEN ADD FPOS FPOS OE030 0003580CSR Z-ADDFPOS TSTRT OE030 03590CSR Z-ADD1 NCHARS OE030 03600CSRN98 Z-ADD2 SSTRT OE030 03610CSR 98 Z-ADD4 SSTRT OE030 03620C* ********** OE030 03630CSR EXIT SUBRLM OE030 03640CSR RLABL TEMP4 OE030 0003650CSR RLABL SSTRT 30 OE030 03660CSR RLABL BUFFER OE030 03670CSR RLABL TSTRT 30 OE030 03680CSR RLABL NCHARS 30 OE030 03690CSR ENDSR OE030 03700C********************************************************************OE030 03710C* OE030 0003720C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE030 03730C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE030 03740C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE030 03750C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE030 03760C* OF THE FIELDS ARE LEFT UNCHANGED OE030 03770C* OE030 03780C********************************************************************OE030 0003790CSR UPDATE BEGSR OE030 03800C* ********** OE030 03810CSR SETOF 32 OE030 03820CSR Z-ADD1 X OE030 03830CSR UPLOOP TAG OE030 03840C* ********** OE030 03850CSR EP,X COMP 0 98 OE030 0003860CSR 98 SETON 30 OE030 03870CSR 98 GOTO NOUPD OE030 03880C* ********** OE030 03890CSR Z-ADDLN,X LEN OE030 03900CSR LEN COMP 0 9730 OE030 03910CSR 97 Z-SUBLEN LEN OE030 03920CSR NOUPD TAG OE030 0003930C* ********** OE030 03940CSR 30N32 GOTO INCR OE030 03950C* ********** OE030 03960CSR 30 GOTO CHKRUB OE030 03970C* ********** OE030 03980CSR SETOF 3233 OE030 03990CSR EXSR ACCEPT OE030 0004000C* ********** OE030 04010CSR CHKRUB TAG OE030 04020C* ********** OE030 04030CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE030 04040CSR 32 31 GOTO UPLOOP OE030 04050C* ********** OE030 04060CSR 32 GOTO ENDUPD OE030 0004070C* ********** OE030 04080CSR MOVELBUFFER ATSIGN 1 OE030 04090CSR ATSIGN COMP '@' 35 OE030 04100CSR 35 GOTO OUTREC OE030 04110C* ********** OE030 04120CSR 33 GOTO INCR WAS LINE FEED OE030 04130C* ********** OE030 0004140CSR Z-ADDEP,X END OE030 04150CSR END SUB LEN STRT 81 81 OE030 04160CSR STRT ADD 1 STRT OE030 04170C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE030 04180C* BUFFER TO THE STRT OF RECORD OE030 04190CSR Z-ADD1 SSTRT OE030 04200CSR Z-ADDSTRT TSTRT OE030 0004210CSR Z-ADDLEN NCHARS OE030 04220C* ********** OE030 04230CSRN81 GOTO AAA OE030 04240CSR EXIT SUBRLM OE030 04250CSR RLABL BUFFER OE030 04260CSR RLABL SSTRT 30 OE030 04270CSR RLABL RECORD OE030 0004280CSR RLABL TSTRT 30 OE030 04290CSR RLABL NCHARS 30 OE030 04300CSR AAA TAG OE030 04310CSR MOVELBUFFER TEMP5 5 OE030 04320CSR MOVELSAVPOS BUFFER OE030 04330CSR EXSR POSCUR OE030 04340C* ********** OE030 0004350CSR MOVELTEMP5 BUFFER OE030 04360CSR Z-ADD1 FPOS OE030 04370CSR EXSR RTBRKT OE030 04380C* ********** OE030 04390CSR LEN ADD 1 BLNGTH OE030 04400CSR MOVE 'T' TYPE OE030 04410CSR EXSR CRTCOM OE030 0004420C* ********** OE030 04430CSR INCR TAG OE030 04440C* ********** OE030 04450CSR X ADD 1 X OE030 04460CSR X COMP NOFLDS 30 OE030 04470CSR 30 GOTO UPLOOP OE030 04480C* ********** OE030 0004490CSR OUTREC TAG OE030 04500C* ********** OE030 04510CSR SETON 80 OE030 04520CSRN61 EXCPT OE030 04530CSR SETOF 80 OE030 04540CSR ENDUPD TAG OE030 04550C* ********** OE030 0004560CSR ENDSR OE030 04570C********************************************************************OE030 04580C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE030 04590C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE030 04600C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE030 04610C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE030 04620C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE030 0004630C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE030 04640C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE030 04650C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE030 04660C* TO BE OUTPUT TO THE SCREEN. OE030 04670C* OE030 04680C********************************************************************OE030 04690CSR ACCEPT BEGSR OE030 0004700C* ********** OE030 04710CSR X COMP 1 30 OE030 04720CSRN30 X COMP SSIZE 30 OE030 04730CSR 30 Z-ADD1 X OE030 04740CSR MOVELCP,X FC OE030 04750CSR FC ADD 3 FC OE030 04760CSR MOVELCP,X SAVPOS 4 OE030 0004770CSR MOVELFC SAVPOS OE030 04780CSR Z-ADDLN,X LEN OE030 04790CSR LEN COMP 0 97 OE030 04800CSR 97 Z-SUBLEN LEN OE030 04810CSR LEN ADD FC OFC 20 OE030 04820CSR ACLOOP TAG OE030 04830C* ********** OE030 0004840CSR MOVELSAVPOS BUFFER OE030 04850CSR EXSR POSCUR OE030 04860C* ********** OE030 04870CSR Z-ADDLEN BLNGTH OE030 04880CSR MOVE BLANKS BUFFER OE030 04890CSR MOVE 'A' TYPE OE030 04900CSR EXSR CRTCOM OE030 0004910C* ********** OE030 04920CSR RCODE COMP 'R' 31 OE030 04930CSR 31 BUFFER COMP BLANKS 32 OE030 04940CSR 31 32N62 GOTO DUPIT OE030 04950C* ********** OE030 04960CSR 31 GOTO ACLOOP OE030 04970C* ********** OE030 0004980CSR RCODE COMP 'L' 33 OE030 04990CSR 33 GOTO DUPIT OE030 05000C* ********** OE030 05010CSRN97 GOTO ENDACC OE030 05020C* ********** OE030 05030CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE030 05040CSR SIGN COMP '@' 30 OE030 0005050CSR 30 GOTO ENDACC OE030 05060C* ********** OE030 05070CSR Z-ADDLEN VL 20 OE030 05080CSR MOVELBUFFER VAR 15 OE030 05090CSR EXSR RTADJ OE030 05100C* ********** OE030 05110CSR MOVELVAR BUFFER OE030 0005120CSR GOTO ENDACC OE030 05130C* ********** OE030 05140CSR DUPIT TAG OE030 05150C* ********** OE030 05160CSR MOVELSAVPOS BUFFER OE030 05170CSR EXSR POSCUR OE030 05180C* ********** OE030 0005190CSR 62 MOVELSECTON BUFFER OE030 05200CSRN62 Z-ADD1 FPOS OE030 05210CSRN62 EXSR MVRECD OE030 05220C* ********** OE030 05230CSR MOVE 'T' TYPE OE030 05240CSR BLNGTH ADD 1 BLNGTH OE030 05250CSR EXSR CRTCOM OE030 0005260C* ********** OE030 05270CSR ENDACC ENDSR OE030 05280C* ********** OE030 05290C********************************************************************OE030 05300C* OE030 05310C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE030 05320C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE030 0005330C* 4 DUMMY FOR RTADJ OE030 05340C* OE030 05350C********************************************************************OE030 05360CSR POSCUR BEGSR OE030 05370C* ********** OE030 05380CSR MOVE 'P' TYPE OE030 05390CSR EXSR CRTCOM OE030 0005400C* ********** OE030 05410CSR ENDSR OE030 05420C********************************************************************OE030 05430CSR CLRSCR BEGSR OE030 05440C* ********** OE030 05450CSR MOVE 'C' TYPE OE030 05460CSR EXSR CRTCOM OE030 0005470C* ********** OE030 05480CSR ENDSR OE030 05490C********************************************************************OE030 05500CSR CRTCOM BEGSR OE030 05510C* ********** OE030 05520C* ********** OE030 05530CSR EXITFSUBRCM OE030 0005540CSR RLABL BUFFER 72 OE030 05550CSR RLABL TYPE 1 OE030 05560CSR RLABL BLNGTH 20 OE030 05570CSR RLABL RCODE 1 OE030 05580CSR RLABL MASK 10 OE030 05590CSR RLABL DTYPE 10 OE030 05600CSR ENDSR OE030 0005610C********************************************************************OE030 05620CSR RTADJ BEGSR OE030 05630C* ********** OE030 05640CSR EXIT SUBRAJ OE030 05650C* ********** OE030 05660CSR RLABL VL OE030 05670CSR RLABL VAR OE030 0005680CSR ENDSR OE030 05690C********************************************************************OE030 05700OCONTROL E 80N55 OE030 05710O RECORD 0256 OE030 05720O* OE030 05730O* OE030 05740O EADD 80 55 OE030 0005750O RECORD 0256 OE030 ** 005760ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005770ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005780ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005790ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005800/* 00581000__0O RECORD 0256 OE030 ** 005760ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005770ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005780ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005790ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005800/* 0058100( TXOE040 Pv999999032778(000010H S OE040 00020X 1 1 OE040 00030F* INQUIRY AND MAINTENANCE OF SAMAST FILE OE040 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE040 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE040 00060F* CONTROL DATA PROPRIETARY PRODUCT OE040 00070F* OE040 0000080FNULL IPEAF 72 DISK OE040 00090F@DIS40 IC F 32R DISK OE040 00100FSAMAST UC F 0140R20AI 0121 DISK A OE040 00110E FN 030 22 FIELD NAME OE040 00120E CP 030 4 CURSOR POSITION OE040 00130E LN 030 2 0 LENGTH OE040 00140E EP 030 4 0 ENDING POSITION OE040 0000150INULL NS 01 OE040 00160I 1 1 A OE040 00170I@DIS40 NS 02 OE040 00180I 1 22 FIELDN OE040 00190I 23 26 CURPOS OE040 00200I 27 280LNGTH OE040 00210I 29 310ENDPOS OE040 0000220ISAMAST NS 03 OE040 00230I 10140 RECORD OE040 00240C MOVE ' ' RCODE 1 OE040 00250C MOVE RCODE B22 22 OE040 00260C MOVE RCODE BLANKS 72 OE040 00270C MOVE RCODE FILLER 1 OE040 00280C Z-ADD0 MASK 10 OE040 0000290C SETON LR OE040 00300CLR Z-ADD030 SSIZE 30 OE040 00310CLR Z-ADD003 NSECT 30 OE040 00320CLR MOVEL'D' FF 1 OE040 00330CLR MOVE '[]<>' TEMP4 4 OE040 00340CLR START TAG OE040 00350C* ********** OE040 0000360CLR EXSR FIRSTP OE040 00370C* ********** OE040 00380CLR EXSR CLRSCR OE040 00390C* ********** OE040 00400CLR 40 GOTO EOJ OE040 00410C* ********** OE040 00420CLR Z-ADD2 VL OE040 0000430CLR MOVELSECTON VAR OE040 00440CLR EXSR RTADJ OE040 00450C* ********** OE040 00460CLR MOVELVAR SECTN 20 OE040 00470CLR EXSR GETSEC OE040 00480C* ********** OE040 00490CLRN45 GOTO START OE040 0000500C* ********** OE040 00510CLR EXSR CLRSCR OE040 00520C* ********** OE040 00530CLR EXSR OUTPUT OE040 00540C* ********** OE040 00550CLR EXSR UPDATE OE040 00560C* ********** OE040 0000570CLR GOTO START OE040 00580C* ********** OE040 00590CLR EOJ TAG OE040 00600C* ********** OE040 00610C********************************************************************OE040 00620C* OE040 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE040 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE040 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE040 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE040 00670C* OE040 00680C********************************************************************OE040 00690CSR FIRSTP BEGSR OE040 00700C* ********** OE040 0000710CSR EXSR CLRSCR OE040 00720C* ********** OE040 00730CSR Z-ADD0 SECTN OE040 00740CSR EXSR GETSEC OE040 00750C* ********** OE040 00760CSR PGE TAG OE040 00770C* ********** OE040 0000780CSR SETON 61 OE040 00790CSR SETOF 62 OE040 00800CSR EXSR OUTPUT OE040 00810C* ********** OE040 00820CSR EXIT SUBRFL OE040 00830C* ********** OE040 00840CSR RLABL RECORD OE040 0000850CSR RLABL FILLER 1 OE040 00860C* ********** OE040 00870C* ********** OE040 00880C* ********** OE040 00890C* ********** OE040 00900C* ********** OE040 00910C* ********** OE040 0000920C* ********** OE040 00930C* ********** OE040 00940C* ********** OE040 00950C* ********** OE040 00960C* ********** OE040 00970C* ********** OE040 00980C* ********** OE040 0000990C* ********** OE040 01000C* ********** OE040 01010CSR Z-ADD20 NCHARS OE040 01020CSR Z-ADD1 SSTRT OE040 01030CSR Z-ADD0121 TSTRT OE040 01040C* ********** OE040 01050CSR EXIT SUBRLM OE040 0001060CSR RLABL KEY 20 OE040 01070CSR RLABL SSTRT 30 OE040 01080CSR RLABL RECORD OE040 01090CSR RLABL TSTRT 30 OE040 01100CSR RLABL NCHARS 30 OE040 01110CSR Z-ADDNOFLDS SVFLDS 30 OE040 01120CSR Z-ADDSX NOFLDS OE040 0001130CSR EXSR UPDATE OE040 01140C* ********** OE040 01150CSR Z-ADDSVFLDS NOFLDS OE040 01160CSR Z-ADD20 NCHARS OE040 01170CSR Z-ADD0121 SSTRT OE040 01180CSR Z-ADD1 TSTRT OE040 01190C* ********** OE040 0001200CSR EXIT SUBRLM OE040 01210CSR RLABL RECORD OE040 01220CSR RLABL SSTRT 30 OE040 01230CSR RLABL KEY OE040 01240CSR RLABL TSTRT 30 OE040 01250CSR RLABL NCHARS 30 OE040 01260CSR KEY CHAINSAMAST 55 OE040 0001270CSR MOVELSAVPOS BUFFER OE040 01280CSR MOVELOFC BUFFER OE040 01290CSR EXSR POSCUR OE040 01300C* ********** OE040 01310CSR MOVEL'] NEW R'WORD16 16 OE040 01320CSR MOVE 'ECORD 'WORD16 OE040 01330CSRN55 MOVELBLANKS WORD16 OE040 0001340CSRN55 MOVEL']' WORD16 OE040 01350CSR MOVELWORD16 BUFFER 72 OE040 01360CSR MOVE 'T' TYPE 1 OE040 01370CSR Z-ADD13 BLNGTH 20 OE040 01380CSR EXSR CRTCOM OE040 01390C* ********** OE040 01400CSR SETON 62 OE040 0001410CSR Z-ADDSX X 30 OE040 01420CSR EXSR ACCEPT OE040 01430C* ********** OE040 01440CSR MOVELBUFFER SECTON 2 OE040 01450CSR SECTON COMP 'E ' 40 OE040 01460CSR 40 GOTO ENDFP OE040 01470C* ********** OE040 0001480CSR SECTON COMP 'D ' 40 OE040 01490CSR 40N55 EXCPT OE040 01500CSR 40 GOTO PGE OE040 01510C* ********** OE040 01520CSR SECTON COMP ' 1' 30 30 OE040 01530CSR 30 SECTON COMP ' 9' 3030 OE040 01540CSR 30 GOTO GOOD OE040 0001550C* ********** OE040 01560CSR SECTON COMP '01' 30 30 OE040 01570CSR 30 SECTON COMP '09' 3030 OE040 01580CSR 30 GOTO GOOD OE040 01590C* ********** OE040 01600CSR SECTON COMP '1 ' 30 30 OE040 01610CSR 30 SECTON COMP '9 ' 3030 OE040 0001620CSR 30 GOTO GOOD OE040 01630C* ********** OE040 01640CSR MOVELSECTON TEMP1 1 OE040 01650CSR TEMP1 COMP '1' 30 30 OE040 01660CSR 30 TEMP1 COMP '9' 3030 OE040 01670CSRN30 GOTO PGE OE040 01680C* ********** OE040 0001690CSR MOVE SECTON TEMP1 OE040 01700CSR TEMP1 COMP '0' 30 30 OE040 01710CSR 30 TEMP1 COMP '9' 3030 OE040 01720CSRN30 GOTO PGE OE040 01730C* ********** OE040 01740CSR GOOD TAG OE040 01750C* ********** OE040 0001760CSR SETOF 6162 OE040 01770CSRN55 GOTO ENDFP OE040 01780C* ********** OE040 01790CSR SETON 80 OE040 01800CSR EXCPT OE040 01810CSR SETOF 80 OE040 01820CSR KEY CHAINSAMAST 55 OE040 0001830CSR ENDFP ENDSR OE040 01840C* ********** OE040 01850C********************************************************************OE040 01860C* OE040 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE040 01880C* OE040 01890C********************************************************************OE040 0001900CSR GETSEC BEGSR OE040 01910C* ********** OE040 01920CSR 1 ADD SECTN N 20 OE040 01930CSR SETOF 404145 OE040 01940CSR N COMP 0 3030 OE040 01950CSRN30 N COMP NSECT 30 OE040 01960CSR 30 GOTO ENDGET OE040 0001970C* ********** OE040 01980CSR SECTN MULT SSIZE RRN 40 OE040 01990CSR Z-ADD1 X OE040 02000CSR SCLOOP TAG OE040 02010C* ********** OE040 02020CSR RRN ADD 1 RRN OE040 02030CSR RRN CHAIN@DIS40 50 OE040 0002040CSR 50 GOTO ENDGET OE040 02050C* ********** OE040 02060CSR FIELDN COMP B22 4141 OE040 02070CSRN41 GOTO ENDGET OE040 02080C* ********** OE040 02090CSR 41N45 SETON 45 OE040 02100CSR MOVE FIELDN FN,X OE040 0002110CSR MOVE CURPOS CP,X OE040 02120CSR MOVE LNGTH LN,X OE040 02130CSR Z-ADDENDPOS EP,X OE040 02140CSR 1 ADD X X OE040 02150CSR X COMP SSIZE 32 OE040 02160CSRN32 GOTO SCLOOP OE040 02170C* ********** OE040 0002180CSR ENDGET TAG OE040 02190C* ********** OE040 02200CSR Z-ADDX NOFLDS 30 OE040 02210CSR 45 GOTO FINGET OE040 02220C* ********** OE040 02230CSR EXSR CLRSCR OE040 02240C* ********** OE040 0002250CSR MOVEL'SECT # 'WORD9 9 OE040 02260CSR Z-ADD16 BLNGTH OE040 02270CSR MOVE SECTN WORD9 OE040 02280CSR MOVELWORD9 WORD16 OE040 02290CSRN30 MOVE ' ABSENT' WORD16 OE040 02300CSR 30 MOVE ' ILLEG.' WORD16 OE040 02310CSR MOVELWORD16 BUFFER OE040 0002320CSR MOVEL'T' TYPE OE040 02330CSR EXSR CRTCOM OE040 02340C* ********** OE040 02350CSR FINGET ENDSR OE040 02360C* ********** OE040 02370C********************************************************************OE040 02380C* OE040 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE040 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE040 02410C* SECTION INDEX IS SAVED. OE040 02420C* OE040 02430C********************************************************************OE040 02440CSR OUTPUT BEGSR OE040 02450C* ********** OE040 0002460CSR EXSR CLRSCR OE040 02470C* ********** OE040 02480CSR Z-ADD1 X OE040 02490CSR 61 SETON 63 OE040 02500CSR OTLOOP TAG OE040 02510C* ********** OE040 02520CSR 61 LN,X COMP 0 31 OE040 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE040 02540CSR EXSR OUTFLD OE040 02550C* ********** OE040 02560CSR X ADD 1 X OE040 02570CSR X COMP NOFLDS 31 OE040 02580CSR 31 GOTO OTLOOP OE040 02590C* ********** OE040 0002600CSR SETOF 63 OE040 02610CSR ENDSR OE040 02620C********************************************************************OE040 02630C* OE040 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE040 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE040 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE040 0002670C* THEN NO FIELD INFORMATION IS PRINTED OE040 02680C* OE040 02690C********************************************************************OE040 02700CSR OUTFLD BEGSR OE040 02710C* ********** OE040 02720CSR MOVE FN,X FL 20 OE040 02730CSR EP,X COMP 0 98 OE040 0002740CSR MOVELCP,X FC 20 OE040 02750CSR FC COMP FL 31 OE040 02760CSR 31 Z-ADDFC FL OE040 02770CSR FC SUB FL CC 20 OE040 02780CSR CC ADD 1 CC OE040 02790CSR MOVELCP,X BUFFER OE040 02800CSR MOVELCC BUFFER OE040 0002810CSR EXSR POSCUR OE040 02820C* ********** OE040 02830CSR MOVELBLANKS BUFFER OE040 02840CSR MOVELFN,X FIELDN OE040 02850CSR MOVE ' ' FIELDN OE040 02860CSR MOVELFIELDN BUFFER OE040 02870CSR Z-ADDLN,X LEN 20 OE040 0002880CSR LEN COMP 0 9730 OE040 02890CSR 97 Z-SUBLN,X LEN OE040 02900CSR 30 GOTO SKIPF OE040 02910C* ********** OE040 02920CSR FL ADD 2 BPOS 20 OE040 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE040 02940CSR Z-ADDBPOS TSTRT 30 OE040 0002950CSRN98 Z-ADD1 SSTRT 30 OE040 02960CSR 98 Z-ADD3 SSTRT OE040 02970CSR Z-ADD1 NCHARS 30 OE040 02980C* ********** OE040 02990CSR EXIT SUBRLM OE040 03000CSR RLABL TEMP4 OE040 03010CSR RLABL SSTRT 30 OE040 0003020CSR RLABL BUFFER OE040 03030CSR RLABL TSTRT 30 OE040 03040CSR RLABL NCHARS 30 OE040 03050CSR BPOS ADD 1 FPOS 20 OE040 03060CSR EXSR MVRECD OE040 03070C* ********** OE040 03080CSR SKIPF TAG OE040 0003090C* ********** OE040 03100CSR 30 Z-ADDFL BLNGTH OE040 03110CSRN30 FL ADD 3 BLNGTH OE040 03120CSRN30 BLNGTH ADD LEN BLNGTH OE040 03130CSR MOVE 'T' TYPE OE040 03140CSR EXSR CRTCOM OE040 03150C* ********** OE040 0003160CSR ENDSR OE040 03170C********************************************************************OE040 03180C* OE040 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE040 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE040 03210C* THE RIGHT BRACKET. OE040 03220C********************************************************************OE040 0003230CSR MVRECD BEGSR OE040 03240C* ********** OE040 03250CSR 63 GOTO RBRK OE040 03260C* ********** OE040 03270CSR 98 Z-SUBEP,X END 40 OE040 03280CSRN98 Z-ADDEP,X END OE040 03290CSR END SUB LEN STRT 40 81 81 OE040 0003300CSR STRT ADD 1 STRT OE040 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE040 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER OE040 03330CSR Z-ADDLEN NCHARS OE040 03340CSR Z-ADDSTRT SSTRT OE040 03350CSR Z-ADDFPOS TSTRT OE040 03360C* ********** OE040 0003370CSRN81 GOTO RBRK OE040 03380CSR EXIT SUBRLM OE040 03390CSR RLABL RECORD OE040 03400CSR RLABL SSTRT 30 OE040 03410CSR RLABL BUFFER OE040 03420CSR RLABL TSTRT 30 OE040 03430CSR RLABL NCHARS 30 OE040 0003440CSR RBRK TAG OE040 03450C* ********** OE040 03460CSR EXSR RTBRKT OE040 03470C* ********** OE040 03480CSR ENDSR OE040 03490C********************************************************************OE040 03500C* OE040 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE040 03520C* OE040 03530C********************************************************************OE040 03540CSR RTBRKT BEGSR OE040 03550C* ********** OE040 03560CSR LEN ADD FPOS FPOS OE040 03570CSR Z-ADDFPOS TSTRT OE040 0003580CSR Z-ADD1 NCHARS OE040 03590CSRN98 Z-ADD2 SSTRT OE040 03600CSR 98 Z-ADD4 SSTRT OE040 03610C* ********** OE040 03620CSR EXIT SUBRLM OE040 03630CSR RLABL TEMP4 OE040 03640CSR RLABL SSTRT 30 OE040 0003650CSR RLABL BUFFER OE040 03660CSR RLABL TSTRT 30 OE040 03670CSR RLABL NCHARS 30 OE040 03680CSR ENDSR OE040 03690C********************************************************************OE040 03700C* OE040 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE040 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE040 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE040 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE040 03750C* OF THE FIELDS ARE LEFT UNCHANGED OE040 03760C* OE040 03770C********************************************************************OE040 03780CSR UPDATE BEGSR OE040 0003790C* ********** OE040 03800CSR SETOF 32 OE040 03810CSR Z-ADD1 X OE040 03820CSR UPLOOP TAG OE040 03830C* ********** OE040 03840CSR EP,X COMP 0 98 OE040 03850CSR 98 SETON 30 OE040 0003860CSR 98 GOTO NOUPD OE040 03870C* ********** OE040 03880CSR Z-ADDLN,X LEN OE040 03890CSR LEN COMP 0 9730 OE040 03900CSR 97 Z-SUBLEN LEN OE040 03910CSR NOUPD TAG OE040 03920C* ********** OE040 0003930CSR 30N32 GOTO INCR OE040 03940C* ********** OE040 03950CSR 30 GOTO CHKRUB OE040 03960C* ********** OE040 03970CSR SETOF 3233 OE040 03980CSR EXSR ACCEPT OE040 03990C* ********** OE040 0004000CSR CHKRUB TAG OE040 04010C* ********** OE040 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE040 04030CSR 32 31 GOTO UPLOOP OE040 04040C* ********** OE040 04050CSR 32 GOTO ENDUPD OE040 04060C* ********** OE040 0004070CSR MOVELBUFFER ATSIGN 1 OE040 04080CSR ATSIGN COMP '@' 35 OE040 04090CSR 35 GOTO OUTREC OE040 04100C* ********** OE040 04110CSR 33 GOTO INCR WAS LINE FEED OE040 04120C* ********** OE040 04130CSR Z-ADDEP,X END OE040 0004140CSR END SUB LEN STRT 81 81 OE040 04150CSR STRT ADD 1 STRT OE040 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE040 04170C* BUFFER TO THE STRT OF RECORD OE040 04180CSR Z-ADD1 SSTRT OE040 04190CSR Z-ADDSTRT TSTRT OE040 04200CSR Z-ADDLEN NCHARS OE040 0004210C* ********** OE040 04220CSRN81 GOTO AAA OE040 04230CSR EXIT SUBRLM OE040 04240CSR RLABL BUFFER OE040 04250CSR RLABL SSTRT 30 OE040 04260CSR RLABL RECORD OE040 04270CSR RLABL TSTRT 30 OE040 0004280CSR RLABL NCHARS 30 OE040 04290CSR AAA TAG OE040 04300CSR MOVELBUFFER TEMP5 5 OE040 04310CSR MOVELSAVPOS BUFFER OE040 04320CSR EXSR POSCUR OE040 04330C* ********** OE040 04340CSR MOVELTEMP5 BUFFER OE040 0004350CSR Z-ADD1 FPOS OE040 04360CSR EXSR RTBRKT OE040 04370C* ********** OE040 04380CSR LEN ADD 1 BLNGTH OE040 04390CSR MOVE 'T' TYPE OE040 04400CSR EXSR CRTCOM OE040 04410C* ********** OE040 0004420CSR INCR TAG OE040 04430C* ********** OE040 04440CSR X ADD 1 X OE040 04450CSR X COMP NOFLDS 30 OE040 04460CSR 30 GOTO UPLOOP OE040 04470C* ********** OE040 04480CSR OUTREC TAG OE040 0004490C* ********** OE040 04500CSR SETON 80 OE040 04510CSRN61 EXCPT OE040 04520CSR SETOF 80 OE040 04530CSR ENDUPD TAG OE040 04540C* ********** OE040 04550CSR ENDSR OE040 0004560C********************************************************************OE040 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE040 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE040 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE040 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE040 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE040 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE040 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE040 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE040 04650C* TO BE OUTPUT TO THE SCREEN. OE040 04660C* OE040 04670C********************************************************************OE040 04680CSR ACCEPT BEGSR OE040 04690C* ********** OE040 0004700CSR X COMP 1 30 OE040 04710CSRN30 X COMP SSIZE 30 OE040 04720CSR 30 Z-ADD1 X OE040 04730CSR MOVELCP,X FC OE040 04740CSR FC ADD 3 FC OE040 04750CSR MOVELCP,X SAVPOS 4 OE040 04760CSR MOVELFC SAVPOS OE040 0004770CSR Z-ADDLN,X LEN OE040 04780CSR LEN COMP 0 97 OE040 04790CSR 97 Z-SUBLEN LEN OE040 04800CSR LEN ADD FC OFC 20 OE040 04810CSR ACLOOP TAG OE040 04820C* ********** OE040 04830CSR MOVELSAVPOS BUFFER OE040 0004840CSR EXSR POSCUR OE040 04850C* ********** OE040 04860CSR Z-ADDLEN BLNGTH OE040 04870CSR MOVE BLANKS BUFFER OE040 04880CSR MOVE 'A' TYPE OE040 04890CSR EXSR CRTCOM OE040 04900C* ********** OE040 0004910CSR RCODE COMP 'R' 31 OE040 04920CSR 31 BUFFER COMP BLANKS 32 OE040 04930CSR 31 32N62 GOTO DUPIT OE040 04940C* ********** OE040 04950CSR 31 GOTO ACLOOP OE040 04960C* ********** OE040 04970CSR RCODE COMP 'L' 33 OE040 0004980CSR 33 GOTO DUPIT OE040 04990C* ********** OE040 05000CSRN97 GOTO ENDACC OE040 05010C* ********** OE040 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE040 05030CSR SIGN COMP '@' 30 OE040 05040CSR 30 GOTO ENDACC OE040 0005050C* ********** OE040 05060CSR Z-ADDLEN VL 20 OE040 05070CSR MOVELBUFFER VAR 15 OE040 05080CSR EXSR RTADJ OE040 05090C* ********** OE040 05100CSR MOVELVAR BUFFER OE040 05110CSR GOTO ENDACC OE040 0005120C* ********** OE040 05130CSR DUPIT TAG OE040 05140C* ********** OE040 05150CSR MOVELSAVPOS BUFFER OE040 05160CSR EXSR POSCUR OE040 05170C* ********** OE040 05180CSR 62 MOVELSECTON BUFFER OE040 0005190CSRN62 Z-ADD1 FPOS OE040 05200CSRN62 EXSR MVRECD OE040 05210C* ********** OE040 05220CSR MOVE 'T' TYPE OE040 05230CSR BLNGTH ADD 1 BLNGTH OE040 05240CSR EXSR CRTCOM OE040 05250C* ********** OE040 0005260CSR ENDACC ENDSR OE040 05270C* ********** OE040 05280C********************************************************************OE040 05290C* OE040 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE040 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE040 05320C* 4 DUMMY FOR RTADJ OE040 0005330C* OE040 05340C********************************************************************OE040 05350CSR POSCUR BEGSR OE040 05360C* ********** OE040 05370CSR MOVE 'P' TYPE OE040 05380CSR EXSR CRTCOM OE040 05390C* ********** OE040 0005400CSR ENDSR OE040 05410C********************************************************************OE040 05420CSR CLRSCR BEGSR OE040 05430C* ********** OE040 05440CSR MOVE 'C' TYPE OE040 05450CSR EXSR CRTCOM OE040 05460C* ********** OE040 0005470CSR ENDSR OE040 05480C********************************************************************OE040 05490CSR CRTCOM BEGSR OE040 05500C* ********** OE040 05510C* ********** OE040 05520CSR EXITFSUBRCM OE040 05530CSR RLABL BUFFER 72 OE040 0005540CSR RLABL TYPE 1 OE040 05550CSR RLABL BLNGTH 20 OE040 05560CSR RLABL RCODE 1 OE040 05570CSR RLABL MASK 10 OE040 05580CSR RLABL DTYPE 10 OE040 05590CSR ENDSR OE040 05600C********************************************************************OE040 0005610CSR RTADJ BEGSR OE040 05620C* ********** OE040 05630CSR EXIT SUBRAJ OE040 05640C* ********** OE040 05650CSR RLABL VL OE040 05660CSR RLABL VAR OE040 05670CSR ENDSR OE040 0005680C********************************************************************OE040 05690OSAMAST E 80N55 OE040 05700O RECORD 0140 OE040 05710O E 40N80 OE040 05720O FF 120 OE040 05730O EADD 80 55 OE040 05740O RECORD 0140 OE040 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( PTXOE042 PHz999999032778(000010H S OE042 00020X DECK-ID A51 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE042 00030F* PRINTS SALES ANALYSIS MASTER FILE (SAMAST) OE042 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE042 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE042 00060F* CONTROL DATA PROPRIETARY PRODUCT OE042 00070F* OE042 0000080FSAMAST IPEAF 140 20AI 121 DISK OE042 00090FHEADING IT F 40 EDISK OE042 00100F$LP1 O F 132 OF PRINTER OE042 00110F********************************************************************OE042 00120F* OE042 00130F* PACKAGE DISTRIBUTION OE042 00140F* SYSTEM FILE MAINTENANCE OE042 0000150F* PROGRAM LISTS SALES ANALYSIS MASTER FILE RECORDS THAT AREN'T OE042 00160F* FLAGGED FOR DELETION AND COUNTS THEM OE042 00170F* OE042 00180F* CONTRACTOR COMPUSOURCE OE042 00190F* PROGRAMMER KATHY HILL OE042 00200F* DATE OCTOBER 8, 1976 OE042 00210F* OE042 0000220F********************************************************************OE042 00230F* OE042 00240F* ID F C H L FUNCTION OF INDICATORS OE042 00250F* OE042 00260F* 01 SAMAST --> GOOD OE042 00270F* 02 SAMAST --> FLAGGED FOR DELETION OE042 00280F* OE042 0000290F* 20 SALES > 0 OE042 00300F* OE042 00310F********************************************************************OE042 00320E HEADING HEAD 1 1 40 COMPANY NAME OE042 00330E ARY 12 7 0 LAST 12 MONTHS OE042 00340ISAMAST NS 01 120 C OE042 00350I 121 140 PARTNO OE042 0000360I 13 190MTD OE042 00370I 22 105 ARY OE042 00380I 106 1130YTD OE042 00390I NS 02 OE042 00400I 1 1 DLTED OE042 00410C* OE042 00420C 01 CNT ADD 1 CNT 80 OE042 0000430C* OE042 00440C 01 XFOOTARY LAST12 100 OE042 00450C 01 LAST12 ADD MTD TOTAL 100 OE042 00460C 01 YTD ADD TOTAL TOTAL 20 OE042 00470C* OE042 00480O$LP1 H 202 1P OE042 00490O OR OF OE042 0000500O 4 'PAGE' OE042 00510O PAGE Z 8 OE042 00520O HEAD,1 86 OE042 00530O UDATE Y 132 OE042 00540O H 2 1P OE042 00550O OR OF OE042 00560O 63 'SALES ANALYSIS' OE042 0000570O 83 'MASTER FILE LISTING' OE042 00580O 132 'DIS042' OE042 00590O H 1 1P OE042 00600O OR OF OE042 00610O 36 'MTD SALES' OE042 00620O 56 'LAST 12 MONTHS' OE042 00630O 76 'PREVIOUS 12 MONTHS' OE042 0000640O H 2 1P OE042 00650O OR OF OE042 00660O 11 'PART NUMBER' OE042 00670O 36 'QUANTITY' OE042 00680O 56 'SALES QUANTITY' OE042 00690O 76 'SALES QUANTITY' OE042 00700O D 1 01 OE042 0000710O PARTNO 20 OE042 00720O MTD J 37 OE042 00730O LAST12J 57 OE042 00740O YTD J 77 OE042 00750O N20 104 '** THIS RECORD SHOULD BE' OE042 00760O N20 116 'DELETED! **' OE042 00770O T 21 LR OE042 0000780O 11 'END OF JOB.' OE042 00790O 23 'THERE WERE' OE042 00800O CNT 1 34 OE042 00810O 56 'ACTIVE RECORDS IN THE' OE042 00820O 71 'SALES ANALYSIS' OE042 00830O 84 'MASTER FILE.' OE042 ** 00084000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000850ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000860ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000870ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000880/* 000890_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(' DTXOE050 P999999032778(000010H S OE050 00020X DECK-ID A52 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE050 00030F* INQUIRY AND MAINTENANCE OF SLSMAN FILE OE050 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE050 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE050 00060F* CONTROL DATA PROPRIETARY PRODUCT OE050 00070F* OE050 0000080FNULL IPEAF 72 DISK OE050 00090F@DIS50 IC F 32R DISK OE050 00100FSLSMAN UC F 0030R03AI 0001 DISK A OE050 00110E FN 015 22 FIELD NAME OE050 00120E CP 015 4 CURSOR POSITION OE050 00130E LN 015 2 0 LENGTH OE050 00140E EP 015 4 0 ENDING POSITION OE050 0000150INULL NS 01 OE050 00160I 1 1 A OE050 00170I@DIS50 NS 02 OE050 00180I 1 22 FIELDN OE050 00190I 23 26 CURPOS OE050 00200I 27 280LNGTH OE050 00210I 29 310ENDPOS OE050 0000220ISLSMAN NS 03 OE050 00230I 10030 RECORD OE050 00240C MOVE ' ' RCODE 1 OE050 00250C MOVE RCODE B22 22 OE050 00260C MOVE RCODE BLANKS 72 OE050 00270C MOVE RCODE FILLER 1 OE050 00280C Z-ADD0 MASK 10 OE050 0000290C SETON LR OE050 00300CLR Z-ADD015 SSIZE 30 OE050 00310CLR Z-ADD002 NSECT 30 OE050 00320CLR MOVE 'D' FF 1 OE050 00330CLR MOVE '[]<>' TEMP4 4 OE050 00340CLR START TAG OE050 00350C* ********** OE050 0000360CLR EXSR FIRSTP OE050 00370C* ********** OE050 00380CLR EXSR CLRSCR OE050 00390C* ********** OE050 00400CLR 40 GOTO EOJ OE050 00410C* ********** OE050 00420CLR Z-ADD2 VL OE050 0000430CLR MOVELSECTON VAR OE050 00440CLR EXSR RTADJ OE050 00450C* ********** OE050 00460CLR MOVELVAR SECTN 20 OE050 00470CLR EXSR GETSEC OE050 00480C* ********** OE050 00490CLRN45 GOTO START OE050 0000500C* ********** OE050 00510CLR EXSR CLRSCR OE050 00520C* ********** OE050 00530CLR EXSR OUTPUT OE050 00540C* ********** OE050 00550CLR EXSR UPDATE OE050 00560C* ********** OE050 0000570CLR GOTO START OE050 00580C* ********** OE050 00590CLR EOJ TAG OE050 00600C* ********** OE050 00610C********************************************************************OE050 00620C* OE050 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE050 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE050 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE050 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE050 00670C* OE050 00680C********************************************************************OE050 00690CSR FIRSTP BEGSR OE050 00700C* ********** OE050 0000710CSR EXSR CLRSCR OE050 00720C* ********** OE050 00730CSR Z-ADD0 SECTN OE050 00740CSR EXSR GETSEC OE050 00750C* ********** OE050 00760CSR PGE TAG OE050 00770C* ********** OE050 0000780CSR SETON 61 OE050 00790CSR SETOF 62 OE050 00800CSR EXSR OUTPUT OE050 00810C* ********** OE050 00820CSR EXIT SUBRFL OE050 00830C* ********** OE050 00840CSR RLABL RECORD OE050 0000850CSR RLABL FILLER 1 OE050 00860C* ********** OE050 00870C* ********** OE050 00880C* ********** OE050 00890C* ********** OE050 00900C* ********** OE050 00910C* ********** OE050 0000920C* ********** OE050 00930C* ********** OE050 00940C* ********** OE050 00950C* ********** OE050 00960C* ********** OE050 00970C* ********** OE050 00980C* ********** OE050 0000990C* ********** OE050 01000C* ********** OE050 01010CSR Z-ADD03 NCHARS OE050 01020CSR Z-ADD1 SSTRT OE050 01030CSR Z-ADD0001 TSTRT OE050 01040C* ********** OE050 01050CSR EXIT SUBRLM OE050 0001060CSR RLABL KEY 03 OE050 01070CSR RLABL SSTRT 30 OE050 01080CSR RLABL RECORD OE050 01090CSR RLABL TSTRT 30 OE050 01100CSR RLABL NCHARS 30 OE050 01110CSR Z-ADDNOFLDS SVFLDS 30 OE050 01120CSR Z-ADDSX NOFLDS OE050 0001130CSR EXSR UPDATE OE050 01140C* ********** OE050 01150CSR Z-ADDSVFLDS NOFLDS OE050 01160CSR Z-ADD03 NCHARS OE050 01170CSR Z-ADD0001 SSTRT OE050 01180CSR Z-ADD1 TSTRT OE050 01190C* ********** OE050 0001200CSR EXIT SUBRLM OE050 01210CSR RLABL RECORD OE050 01220CSR RLABL SSTRT 30 OE050 01230CSR RLABL KEY OE050 01240CSR RLABL TSTRT 30 OE050 01250CSR RLABL NCHARS 30 OE050 01260CSR KEY CHAINSLSMAN 55 OE050 0001270CSR MOVELSAVPOS BUFFER OE050 01280CSR MOVELOFC BUFFER OE050 01290CSR EXSR POSCUR OE050 01300C* ********** OE050 01310CSR MOVEL'] NEW R'WORD16 16 OE050 01320CSR MOVE 'ECORD 'WORD16 OE050 01330CSRN55 MOVELBLANKS WORD16 OE050 0001340CSRN55 MOVEL']' WORD16 OE050 01350CSR MOVELWORD16 BUFFER 72 OE050 01360CSR MOVE 'T' TYPE 1 OE050 01370CSR Z-ADD13 BLNGTH 20 OE050 01380CSR EXSR CRTCOM OE050 01390C* ********** OE050 01400CSR SETON 62 OE050 0001410CSR Z-ADDSX X 30 OE050 01420CSR EXSR ACCEPT OE050 01430C* ********** OE050 01440CSR MOVELBUFFER SECTON 2 OE050 01450CSR SECTON COMP 'E ' 40 OE050 01460CSR 40 GOTO ENDFP OE050 01470C* ********** OE050 0001480CSR SECTON COMP 'D ' 40 OE050 01490CSR 40N55 EXCPT OE050 01500CSR 40 GOTO PGE OE050 01510C* ********** OE050 01520CSR SECTON COMP ' 1' 30 30 OE050 01530CSR 30 SECTON COMP ' 9' 3030 OE050 01540CSR 30 GOTO GOOD OE050 0001550C* ********** OE050 01560CSR SECTON COMP '01' 30 30 OE050 01570CSR 30 SECTON COMP '09' 3030 OE050 01580CSR 30 GOTO GOOD OE050 01590C* ********** OE050 01600CSR SECTON COMP '1 ' 30 30 OE050 01610CSR 30 SECTON COMP '9 ' 3030 OE050 0001620CSR 30 GOTO GOOD OE050 01630C* ********** OE050 01640CSR MOVELSECTON TEMP1 1 OE050 01650CSR TEMP1 COMP '1' 30 30 OE050 01660CSR 30 TEMP1 COMP '9' 3030 OE050 01670CSRN30 GOTO PGE OE050 01680C* ********** OE050 0001690CSR MOVE SECTON TEMP1 OE050 01700CSR TEMP1 COMP '0' 30 30 OE050 01710CSR 30 TEMP1 COMP '9' 3030 OE050 01720CSRN30 GOTO PGE OE050 01730C* ********** OE050 01740CSR GOOD TAG OE050 01750C* ********** OE050 0001760CSR SETOF 6162 OE050 01770CSRN55 GOTO ENDFP OE050 01780C* ********** OE050 01790CSR SETON 80 OE050 01800CSR EXCPT OE050 01810CSR SETOF 80 OE050 01820CSR KEY CHAINSLSMAN 55 OE050 0001830CSR ENDFP ENDSR OE050 01840C* ********** OE050 01850C********************************************************************OE050 01860C* OE050 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE050 01880C* OE050 01890C********************************************************************OE050 0001900CSR GETSEC BEGSR OE050 01910C* ********** OE050 01920CSR 1 ADD SECTN N 20 OE050 01930CSR SETOF 404145 OE050 01940CSR N COMP 0 3030 OE050 01950CSRN30 N COMP NSECT 30 OE050 01960CSR 30 GOTO ENDGET OE050 0001970C* ********** OE050 01980CSR SECTN MULT SSIZE RRN 40 OE050 01990CSR Z-ADD1 X OE050 02000CSR SCLOOP TAG OE050 02010C* ********** OE050 02020CSR RRN ADD 1 RRN OE050 02030CSR RRN CHAIN@DIS50 50 OE050 0002040CSR 50 GOTO ENDGET OE050 02050C* ********** OE050 02060CSR FIELDN COMP B22 4141 OE050 02070CSRN41 GOTO ENDGET OE050 02080C* ********** OE050 02090CSR 41N45 SETON 45 OE050 02100CSR MOVE FIELDN FN,X OE050 0002110CSR MOVE CURPOS CP,X OE050 02120CSR MOVE LNGTH LN,X OE050 02130CSR Z-ADDENDPOS EP,X OE050 02140CSR 1 ADD X X OE050 02150CSR X COMP SSIZE 32 OE050 02160CSRN32 GOTO SCLOOP OE050 02170C* ********** OE050 0002180CSR ENDGET TAG OE050 02190C* ********** OE050 02200CSR Z-ADDX NOFLDS 30 OE050 02210CSR 45 GOTO FINGET OE050 02220C* ********** OE050 02230CSR EXSR CLRSCR OE050 02240C* ********** OE050 0002250CSR MOVEL'SECT # 'WORD9 9 OE050 02260CSR Z-ADD16 BLNGTH OE050 02270CSR MOVE SECTN WORD9 OE050 02280CSR MOVELWORD9 WORD16 OE050 02290CSRN30 MOVE ' ABSENT' WORD16 OE050 02300CSR 30 MOVE ' ILLEG.' WORD16 OE050 02310CSR MOVELWORD16 BUFFER OE050 0002320CSR MOVEL'T' TYPE OE050 02330CSR EXSR CRTCOM OE050 02340C* ********** OE050 02350CSR FINGET ENDSR OE050 02360C* ********** OE050 02370C********************************************************************OE050 02380C* OE050 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE050 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE050 02410C* SECTION INDEX IS SAVED. OE050 02420C* OE050 02430C********************************************************************OE050 02440CSR OUTPUT BEGSR OE050 02450C* ********** OE050 0002460CSR EXSR CLRSCR OE050 02470C* ********** OE050 02480CSR Z-ADD1 X OE050 02490CSR 61 SETON 63 OE050 02500CSR OTLOOP TAG OE050 02510C* ********** OE050 02520CSR 61 LN,X COMP 0 31 OE050 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE050 02540CSR EXSR OUTFLD OE050 02550C* ********** OE050 02560CSR X ADD 1 X OE050 02570CSR X COMP NOFLDS 31 OE050 02580CSR 31 GOTO OTLOOP OE050 02590C* ********** OE050 0002600CSR SETOF 63 OE050 02610CSR ENDSR OE050 02620C********************************************************************OE050 02630C* OE050 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE050 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE050 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE050 0002670C* THEN NO FIELD INFORMATION IS PRINTED OE050 02680C* OE050 02690C********************************************************************OE050 02700CSR OUTFLD BEGSR OE050 02710C* ********** OE050 02720CSR MOVE FN,X FL 20 OE050 02730CSR EP,X COMP 0 98 OE050 0002740CSR MOVELCP,X FC 20 OE050 02750CSR FC COMP FL 31 OE050 02760CSR 31 Z-ADDFC FL OE050 02770CSR FC SUB FL CC 20 OE050 02780CSR CC ADD 1 CC OE050 02790CSR MOVELCP,X BUFFER OE050 02800CSR MOVELCC BUFFER OE050 0002810CSR EXSR POSCUR OE050 02820C* ********** OE050 02830CSR MOVELBLANKS BUFFER OE050 02840CSR MOVELFN,X FIELDN OE050 02850CSR MOVE ' ' FIELDN OE050 02860CSR MOVELFIELDN BUFFER OE050 02870CSR Z-ADDLN,X LEN 20 OE050 0002880CSR LEN COMP 0 9730 OE050 02890CSR 97 Z-SUBLN,X LEN OE050 02900CSR 30 GOTO SKIPF OE050 02910C* ********** OE050 02920CSR FL ADD 2 BPOS 20 OE050 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE050 02940CSR Z-ADDBPOS TSTRT 30 OE050 0002950CSRN98 Z-ADD1 SSTRT 30 OE050 02960CSR 98 Z-ADD3 SSTRT OE050 02970CSR Z-ADD1 NCHARS 30 OE050 02980C* ********** OE050 02990CSR EXIT SUBRLM OE050 03000CSR RLABL TEMP4 OE050 03010CSR RLABL SSTRT 30 OE050 0003020CSR RLABL BUFFER OE050 03030CSR RLABL TSTRT 30 OE050 03040CSR RLABL NCHARS 30 OE050 03050CSR BPOS ADD 1 FPOS 20 OE050 03060CSR EXSR MVRECD OE050 03070C* ********** OE050 03080CSR SKIPF TAG OE050 0003090C* ********** OE050 03100CSR 30 Z-ADDFL BLNGTH OE050 03110CSRN30 FL ADD 3 BLNGTH OE050 03120CSRN30 BLNGTH ADD LEN BLNGTH OE050 03130CSR MOVE 'T' TYPE OE050 03140CSR EXSR CRTCOM OE050 03150C* ********** OE050 0003160CSR ENDSR OE050 03170C********************************************************************OE050 03180C* OE050 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE050 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE050 03210C* THE RIGHT BRACKET. OE050 03220C********************************************************************OE050 0003230CSR MVRECD BEGSR OE050 03240C* ********** OE050 03250CSR 63 GOTO RBRK OE050 03260C* ********** OE050 03270CSR 98 Z-SUBEP,X END 40 OE050 03280CSRN98 Z-ADDEP,X END OE050 03290CSR END SUB LEN STRT 40 81 81 OE050 0003300CSR STRT ADD 1 STRT OE050 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE050 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER OE050 03330CSR Z-ADDLEN NCHARS OE050 03340CSR Z-ADDSTRT SSTRT OE050 03350CSR Z-ADDFPOS TSTRT OE050 03360C* ********** OE050 0003370CSRN81 GOTO RBRK OE050 03380CSR EXIT SUBRLM OE050 03390CSR RLABL RECORD OE050 03400CSR RLABL SSTRT 30 OE050 03410CSR RLABL BUFFER OE050 03420CSR RLABL TSTRT 30 OE050 03430CSR RLABL NCHARS 30 OE050 0003440CSR RBRK TAG OE050 03450C* ********** OE050 03460CSR EXSR RTBRKT OE050 03470C* ********** OE050 03480CSR ENDSR OE050 03490C********************************************************************OE050 03500C* OE050 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE050 03520C* OE050 03530C********************************************************************OE050 03540CSR RTBRKT BEGSR OE050 03550C* ********** OE050 03560CSR LEN ADD FPOS FPOS OE050 03570CSR Z-ADDFPOS TSTRT OE050 0003580CSR Z-ADD1 NCHARS OE050 03590CSRN98 Z-ADD2 SSTRT OE050 03600CSR 98 Z-ADD4 SSTRT OE050 03610C* ********** OE050 03620CSR EXIT SUBRLM OE050 03630CSR RLABL TEMP4 OE050 03640CSR RLABL SSTRT 30 OE050 0003650CSR RLABL BUFFER OE050 03660CSR RLABL TSTRT 30 OE050 03670CSR RLABL NCHARS 30 OE050 03680CSR ENDSR OE050 03690C********************************************************************OE050 03700C* OE050 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE050 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE050 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE050 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE050 03750C* OF THE FIELDS ARE LEFT UNCHANGED OE050 03760C* OE050 03770C********************************************************************OE050 03780CSR UPDATE BEGSR OE050 0003790C* ********** OE050 03800CSR SETOF 32 OE050 03810CSR Z-ADD1 X OE050 03820CSR UPLOOP TAG OE050 03830C* ********** OE050 03840CSR EP,X COMP 0 98 OE050 03850CSR 98 SETON 30 OE050 0003860CSR 98 GOTO NOUPD OE050 03870C* ********** OE050 03880CSR Z-ADDLN,X LEN OE050 03890CSR LEN COMP 0 9730 OE050 03900CSR 97 Z-SUBLEN LEN OE050 03910CSR NOUPD TAG OE050 03920C* ********** OE050 0003930CSR 30N32 GOTO INCR OE050 03940C* ********** OE050 03950CSR 30 GOTO CHKRUB OE050 03960C* ********** OE050 03970CSR SETOF 3233 OE050 03980CSR EXSR ACCEPT OE050 03990C* ********** OE050 0004000CSR CHKRUB TAG OE050 04010C* ********** OE050 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE050 04030CSR 32 31 GOTO UPLOOP OE050 04040C* ********** OE050 04050CSR 32 GOTO ENDUPD OE050 04060C* ********** OE050 0004070CSR MOVELBUFFER ATSIGN 1 OE050 04080CSR ATSIGN COMP '@' 35 OE050 04090CSR 35 GOTO OUTREC OE050 04100C* ********** OE050 04110CSR 33 GOTO INCR WAS LINE FEED OE050 04120C* ********** OE050 04130CSR Z-ADDEP,X END OE050 0004140CSR END SUB LEN STRT 81 81 OE050 04150CSR STRT ADD 1 STRT OE050 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE050 04170C* BUFFER TO THE STRT OF RECORD OE050 04180CSR Z-ADD1 SSTRT OE050 04190CSR Z-ADDSTRT TSTRT OE050 04200CSR Z-ADDLEN NCHARS OE050 0004210C* ********** OE050 04220CSRN81 GOTO AAA OE050 04230CSR EXIT SUBRLM OE050 04240CSR RLABL BUFFER OE050 04250CSR RLABL SSTRT 30 OE050 04260CSR RLABL RECORD OE050 04270CSR RLABL TSTRT 30 OE050 0004280CSR RLABL NCHARS 30 OE050 04290CSR AAA TAG OE050 04300CSR MOVELBUFFER TEMP5 5 OE050 04310CSR MOVELSAVPOS BUFFER OE050 04320CSR EXSR POSCUR OE050 04330C* ********** OE050 04340CSR MOVELTEMP5 BUFFER OE050 0004350CSR Z-ADD1 FPOS OE050 04360CSR EXSR RTBRKT OE050 04370C* ********** OE050 04380CSR LEN ADD 1 BLNGTH OE050 04390CSR MOVE 'T' TYPE OE050 04400CSR EXSR CRTCOM OE050 04410C* ********** OE050 0004420CSR INCR TAG OE050 04430C* ********** OE050 04440CSR X ADD 1 X OE050 04450CSR X COMP NOFLDS 30 OE050 04460CSR 30 GOTO UPLOOP OE050 04470C* ********** OE050 04480CSR OUTREC TAG OE050 0004490C* ********** OE050 04500CSR SETON 80 OE050 04510CSRN61 EXCPT OE050 04520CSR SETOF 80 OE050 04530CSR ENDUPD TAG OE050 04540C* ********** OE050 04550CSR ENDSR OE050 0004560C********************************************************************OE050 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE050 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE050 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE050 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE050 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE050 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE050 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE050 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE050 04650C* TO BE OUTPUT TO THE SCREEN. OE050 04660C* OE050 04670C********************************************************************OE050 04680CSR ACCEPT BEGSR OE050 04690C* ********** OE050 0004700CSR X COMP 1 30 OE050 04710CSRN30 X COMP SSIZE 30 OE050 04720CSR 30 Z-ADD1 X OE050 04730CSR MOVELCP,X FC OE050 04740CSR FC ADD 3 FC OE050 04750CSR MOVELCP,X SAVPOS 4 OE050 04760CSR MOVELFC SAVPOS OE050 0004770CSR Z-ADDLN,X LEN OE050 04780CSR LEN COMP 0 97 OE050 04790CSR 97 Z-SUBLEN LEN OE050 04800CSR LEN ADD FC OFC 20 OE050 04810CSR ACLOOP TAG OE050 04820C* ********** OE050 04830CSR MOVELSAVPOS BUFFER OE050 0004840CSR EXSR POSCUR OE050 04850C* ********** OE050 04860CSR Z-ADDLEN BLNGTH OE050 04870CSR MOVE BLANKS BUFFER OE050 04880CSR MOVE 'A' TYPE OE050 04890CSR EXSR CRTCOM OE050 04900C* ********** OE050 0004910CSR RCODE COMP 'R' 31 OE050 04920CSR 31 BUFFER COMP BLANKS 32 OE050 04930CSR 31 32N62 GOTO DUPIT OE050 04940C* ********** OE050 04950CSR 31 GOTO ACLOOP OE050 04960C* ********** OE050 04970CSR RCODE COMP 'L' 33 OE050 0004980CSR 33 GOTO DUPIT OE050 04990C* ********** OE050 05000CSRN97 GOTO ENDACC OE050 05010C* ********** OE050 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE050 05030CSR SIGN COMP '@' 30 OE050 05040CSR 30 GOTO ENDACC OE050 0005050C* ********** OE050 05060CSR Z-ADDLEN VL 20 OE050 05070CSR MOVELBUFFER VAR 15 OE050 05080CSR EXSR RTADJ OE050 05090C* ********** OE050 05100CSR MOVELVAR BUFFER OE050 05110CSR GOTO ENDACC OE050 0005120C* ********** OE050 05130CSR DUPIT TAG OE050 05140C* ********** OE050 05150CSR MOVELSAVPOS BUFFER OE050 05160CSR EXSR POSCUR OE050 05170C* ********** OE050 05180CSR 62 MOVELSECTON BUFFER OE050 0005190CSRN62 Z-ADD1 FPOS OE050 05200CSRN62 EXSR MVRECD OE050 05210C* ********** OE050 05220CSR MOVE 'T' TYPE OE050 05230CSR BLNGTH ADD 1 BLNGTH OE050 05240CSR EXSR CRTCOM OE050 05250C* ********** OE050 0005260CSR ENDACC ENDSR OE050 05270C* ********** OE050 05280C********************************************************************OE050 05290C* OE050 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE050 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE050 05320C* 4 DUMMY FOR RTADJ OE050 0005330C* OE050 05340C********************************************************************OE050 05350CSR POSCUR BEGSR OE050 05360C* ********** OE050 05370CSR MOVE 'P' TYPE OE050 05380CSR EXSR CRTCOM OE050 05390C* ********** OE050 0005400CSR ENDSR OE050 05410C********************************************************************OE050 05420CSR CLRSCR BEGSR OE050 05430C* ********** OE050 05440CSR MOVE 'C' TYPE OE050 05450CSR EXSR CRTCOM OE050 05460C* ********** OE050 0005470CSR ENDSR OE050 05480C********************************************************************OE050 05490CSR CRTCOM BEGSR OE050 05500C* ********** OE050 05510C* ********** OE050 05520CSR EXITFSUBRCM OE050 05530CSR RLABL BUFFER 72 OE050 0005540CSR RLABL TYPE 1 OE050 05550CSR RLABL BLNGTH 20 OE050 05560CSR RLABL RCODE 1 OE050 05570CSR RLABL MASK 10 OE050 05580CSR RLABL DTYPE 10 OE050 05590CSR ENDSR OE050 05600C********************************************************************OE050 0005610CSR RTADJ BEGSR OE050 05620C* ********** OE050 05630CSR EXIT SUBRAJ OE050 05640C* ********** OE050 05650CSR RLABL VL OE050 05660CSR RLABL VAR OE050 05670CSR ENDSR OE050 0005680C********************************************************************OE050 05690OSLSMAN E 80N55 OE050 05700O RECORD 0030 OE050 05710O E 40N80 OE050 05720O FF 30 OE050 05730O EADD 80 55 OE050 05740O RECORD 0030 OE050 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800__0O RECORD 0030 OE050 0(D GTXOE052 P999999032778(000010H S OE052 00020X DECK-ID A53 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE052 00030F* PRINTS SALESMAN MASTER FILE (SLSMAN) OE052 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE052 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE052 00060F* CONTROL DATA PROPRIETARY PRODUCT OE052 00070F* OE052 0000080FSLSMAN IPEAF 30 3AI 1 DISK OE052 00090FHEADING IT F 40 EDISK OE052 00100F$LP1 O F 132 OF PRINTER OE052 00110F********************************************************************OE052 00120F* OE052 00130F* PACKAGE DISTRIBUTION OE052 00140F* SYSTEM FILE MAINTENANCE OE052 0000150F* PROGRAM LISTS SALESMAN MASTER FILE RECORDS THAT AREN'T FLAGGED OE052 00160F* FOR DELETION AND COUNTS THEM OE052 00170F* OE052 00180F* CONTRACTOR COMPUSOURCE OE052 00190F* PROGRAMMER KATHY HILL OE052 00200F* DATE OCTOBER 8, 1976 OE052 00210F* OE052 0000220F********************************************************************OE052 00230F* OE052 00240F* ID F C H L FUNCTION OF INDICATORS OE052 00250F* OE052 00260F* 01 SLSMAN --> GOOD OE052 00270F* 02 SLSMAN --> FLAGGED FOR DELETION OE052 00280F* OE052 0000290F********************************************************************OE052 00300F* OE052 00310E HEADING HEAD 1 1 40 COMPANY NAME OE052 00320ISLSMAN NS 01 30 C OE052 00330I 1 30MANNUM OE052 00340I 4 28 NAME OE052 00350I NS 02 OE052 0000360I 1 1 DLTED OE052 00370C* OE052 00380C 01 CNT ADD 1 CNT 80 OE052 00390C* OE052 00400O$LP1 H 202 1P OE052 00410O OR OF OE052 00420O 4 'PAGE' OE052 0000430O PAGE Z 8 OE052 00440O HEAD,1 86 OE052 00450O UDATE Y 132 OE052 00460O H 2 1P OE052 00470O OR OF OE052 00480O 60 'SALESMAN' OE052 00490O 80 'MASTER FILE LISTING' OE052 0000500O 132 'DIS052' OE052 00510O H 2 1P OE052 00520O OR OF OE052 00530O 10 'SALESMAN #' OE052 00540O 16 'NAME' OE052 00550O D 1 01 OE052 00560O MANNUM 10 OE052 0000570O NAME 37 OE052 00580O T 21 LR OE052 00590O 11 'END OF JOB.' OE052 00600O 23 'THERE WERE' OE052 00610O CNT 1 34 OE052 00620O 56 'ACTIVE RECORDS IN THE' OE052 00630O 65 'SALESMAN' OE052 0000640O 78 'MASTER FILE.' OE052 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( DTXOE060 P999999032778(000010H S OE060 00020X DECK-ID A54 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE060 00030F* INQUIRY AND MAINTENANCE OF AREA FILE OE060 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE060 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE060 00060F* CONTROL DATA PROPRIETARY PRODUCT OE060 00070F* OE060 0000080FNULL IPEAF 72 DISK OE060 00090F@DIS60 IC F 32R DISK OE060 00100FAREA UC F 0030R02AI 0001 DISK A OE060 00110E FN 015 22 FIELD NAME OE060 00120E CP 015 4 CURSOR POSITION OE060 00130E LN 015 2 0 LENGTH OE060 00140E EP 015 4 0 ENDING POSITION OE060 0000150INULL NS 01 OE060 00160I 1 1 A OE060 00170I@DIS60 NS 02 OE060 00180I 1 22 FIELDN OE060 00190I 23 26 CURPOS OE060 00200I 27 280LNGTH OE060 00210I 29 310ENDPOS OE060 0000220IAREA NS 03 OE060 00230I 10030 RECORD OE060 00240C MOVE ' ' RCODE 1 OE060 00250C MOVE RCODE B22 22 OE060 00260C MOVE RCODE BLANKS 72 OE060 00270C MOVE RCODE FILLER 1 OE060 00280C Z-ADD0 MASK 10 OE060 0000290C SETON LR OE060 00300CLR Z-ADD015 SSIZE 30 OE060 00310CLR Z-ADD002 NSECT 30 OE060 00320CLR MOVE 'D' FF 1 OE060 00330CLR MOVE '[]<>' TEMP4 4 OE060 00340CLR START TAG OE060 00350C* ********** OE060 0000360CLR EXSR FIRSTP OE060 00370C* ********** OE060 00380CLR EXSR CLRSCR OE060 00390C* ********** OE060 00400CLR 40 GOTO EOJ OE060 00410C* ********** OE060 00420CLR Z-ADD2 VL OE060 0000430CLR MOVELSECTON VAR OE060 00440CLR EXSR RTADJ OE060 00450C* ********** OE060 00460CLR MOVELVAR SECTN 20 OE060 00470CLR EXSR GETSEC OE060 00480C* ********** OE060 00490CLRN45 GOTO START OE060 0000500C* ********** OE060 00510CLR EXSR CLRSCR OE060 00520C* ********** OE060 00530CLR EXSR OUTPUT OE060 00540C* ********** OE060 00550CLR EXSR UPDATE OE060 00560C* ********** OE060 0000570CLR GOTO START OE060 00580C* ********** OE060 00590CLR EOJ TAG OE060 00600C* ********** OE060 00610C********************************************************************OE060 00620C* OE060 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE060 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE060 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE060 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE060 00670C* OE060 00680C********************************************************************OE060 00690CSR FIRSTP BEGSR OE060 00700C* ********** OE060 0000710CSR EXSR CLRSCR OE060 00720C* ********** OE060 00730CSR Z-ADD0 SECTN OE060 00740CSR EXSR GETSEC OE060 00750C* ********** OE060 00760CSR PGE TAG OE060 00770C* ********** OE060 0000780CSR SETON 61 OE060 00790CSR SETOF 62 OE060 00800CSR EXSR OUTPUT OE060 00810C* ********** OE060 00820CSR EXIT SUBRFL OE060 00830C* ********** OE060 00840CSR RLABL RECORD OE060 0000850CSR RLABL FILLER 1 OE060 00860C* ********** OE060 00870C* ********** OE060 00880C* ********** OE060 00890C* ********** OE060 00900C* ********** OE060 00910C* ********** OE060 0000920C* ********** OE060 00930C* ********** OE060 00940C* ********** OE060 00950C* ********** OE060 00960C* ********** OE060 00970C* ********** OE060 00980C* ********** OE060 0000990C* ********** OE060 01000C* ********** OE060 01010CSR Z-ADD02 NCHARS OE060 01020CSR Z-ADD1 SSTRT OE060 01030CSR Z-ADD0001 TSTRT OE060 01040C* ********** OE060 01050CSR EXIT SUBRLM OE060 0001060CSR RLABL KEY 02 OE060 01070CSR RLABL SSTRT 30 OE060 01080CSR RLABL RECORD OE060 01090CSR RLABL TSTRT 30 OE060 01100CSR RLABL NCHARS 30 OE060 01110CSR Z-ADDNOFLDS SVFLDS 30 OE060 01120CSR Z-ADDSX NOFLDS OE060 0001130CSR EXSR UPDATE OE060 01140C* ********** OE060 01150CSR Z-ADDSVFLDS NOFLDS OE060 01160CSR Z-ADD02 NCHARS OE060 01170CSR Z-ADD0001 SSTRT OE060 01180CSR Z-ADD1 TSTRT OE060 01190C* ********** OE060 0001200CSR EXIT SUBRLM OE060 01210CSR RLABL RECORD OE060 01220CSR RLABL SSTRT 30 OE060 01230CSR RLABL KEY OE060 01240CSR RLABL TSTRT 30 OE060 01250CSR RLABL NCHARS 30 OE060 01260CSR KEY CHAINAREA 55 OE060 0001270CSR MOVELSAVPOS BUFFER OE060 01280CSR MOVELOFC BUFFER OE060 01290CSR EXSR POSCUR OE060 01300C* ********** OE060 01310CSR MOVEL'] NEW R'WORD16 16 OE060 01320CSR MOVE 'ECORD 'WORD16 OE060 01330CSRN55 MOVELBLANKS WORD16 OE060 0001340CSRN55 MOVEL']' WORD16 OE060 01350CSR MOVELWORD16 BUFFER 72 OE060 01360CSR MOVE 'T' TYPE 1 OE060 01370CSR Z-ADD13 BLNGTH 20 OE060 01380CSR EXSR CRTCOM OE060 01390C* ********** OE060 01400CSR SETON 62 OE060 0001410CSR Z-ADDSX X 30 OE060 01420CSR EXSR ACCEPT OE060 01430C* ********** OE060 01440CSR MOVELBUFFER SECTON 2 OE060 01450CSR SECTON COMP 'E ' 40 OE060 01460CSR 40 GOTO ENDFP OE060 01470C* ********** OE060 0001480CSR SECTON COMP 'D ' 40 OE060 01490CSR 40N55 EXCPT OE060 01500CSR 40 GOTO PGE OE060 01510C* ********** OE060 01520CSR SECTON COMP ' 1' 30 30 OE060 01530CSR 30 SECTON COMP ' 9' 3030 OE060 01540CSR 30 GOTO GOOD OE060 0001550C* ********** OE060 01560CSR SECTON COMP '01' 30 30 OE060 01570CSR 30 SECTON COMP '09' 3030 OE060 01580CSR 30 GOTO GOOD OE060 01590C* ********** OE060 01600CSR SECTON COMP '1 ' 30 30 OE060 01610CSR 30 SECTON COMP '9 ' 3030 OE060 0001620CSR 30 GOTO GOOD OE060 01630C* ********** OE060 01640CSR MOVELSECTON TEMP1 1 OE060 01650CSR TEMP1 COMP '1' 30 30 OE060 01660CSR 30 TEMP1 COMP '9' 3030 OE060 01670CSRN30 GOTO PGE OE060 01680C* ********** OE060 0001690CSR MOVE SECTON TEMP1 OE060 01700CSR TEMP1 COMP '0' 30 30 OE060 01710CSR 30 TEMP1 COMP '9' 3030 OE060 01720CSRN30 GOTO PGE OE060 01730C* ********** OE060 01740CSR GOOD TAG OE060 01750C* ********** OE060 0001760CSR SETOF 6162 OE060 01770CSRN55 GOTO ENDFP OE060 01780C* ********** OE060 01790CSR SETON 80 OE060 01800CSR EXCPT OE060 01810CSR SETOF 80 OE060 01820CSR KEY CHAINAREA 55 OE060 0001830CSR ENDFP ENDSR OE060 01840C* ********** OE060 01850C********************************************************************OE060 01860C* OE060 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE060 01880C* OE060 01890C********************************************************************OE060 0001900CSR GETSEC BEGSR OE060 01910C* ********** OE060 01920CSR 1 ADD SECTN N 20 OE060 01930CSR SETOF 404145 OE060 01940CSR N COMP 0 3030 OE060 01950CSRN30 N COMP NSECT 30 OE060 01960CSR 30 GOTO ENDGET OE060 0001970C* ********** OE060 01980CSR SECTN MULT SSIZE RRN 40 OE060 01990CSR Z-ADD1 X OE060 02000CSR SCLOOP TAG OE060 02010C* ********** OE060 02020CSR RRN ADD 1 RRN OE060 02030CSR RRN CHAIN@DIS60 50 OE060 0002040CSR 50 GOTO ENDGET OE060 02050C* ********** OE060 02060CSR FIELDN COMP B22 4141 OE060 02070CSRN41 GOTO ENDGET OE060 02080C* ********** OE060 02090CSR 41N45 SETON 45 OE060 02100CSR MOVE FIELDN FN,X OE060 0002110CSR MOVE CURPOS CP,X OE060 02120CSR MOVE LNGTH LN,X OE060 02130CSR Z-ADDENDPOS EP,X OE060 02140CSR 1 ADD X X OE060 02150CSR X COMP SSIZE 32 OE060 02160CSRN32 GOTO SCLOOP OE060 02170C* ********** OE060 0002180CSR ENDGET TAG OE060 02190C* ********** OE060 02200CSR Z-ADDX NOFLDS 30 OE060 02210CSR 45 GOTO FINGET OE060 02220C* ********** OE060 02230CSR EXSR CLRSCR OE060 02240C* ********** OE060 0002250CSR MOVEL'SECT # 'WORD9 9 OE060 02260CSR Z-ADD16 BLNGTH OE060 02270CSR MOVE SECTN WORD9 OE060 02280CSR MOVELWORD9 WORD16 OE060 02290CSRN30 MOVE ' ABSENT' WORD16 OE060 02300CSR 30 MOVE ' ILLEG.' WORD16 OE060 02310CSR MOVELWORD16 BUFFER OE060 0002320CSR MOVEL'T' TYPE OE060 02330CSR EXSR CRTCOM OE060 02340C* ********** OE060 02350CSR FINGET ENDSR OE060 02360C* ********** OE060 02370C********************************************************************OE060 02380C* OE060 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE060 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE060 02410C* SECTION INDEX IS SAVED. OE060 02420C* OE060 02430C********************************************************************OE060 02440CSR OUTPUT BEGSR OE060 02450C* ********** OE060 0002460CSR EXSR CLRSCR OE060 02470C* ********** OE060 02480CSR Z-ADD1 X OE060 02490CSR 61 SETON 63 OE060 02500CSR OTLOOP TAG OE060 02510C* ********** OE060 02520CSR 61 LN,X COMP 0 31 OE060 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE060 02540CSR EXSR OUTFLD OE060 02550C* ********** OE060 02560CSR X ADD 1 X OE060 02570CSR X COMP NOFLDS 31 OE060 02580CSR 31 GOTO OTLOOP OE060 02590C* ********** OE060 0002600CSR SETOF 63 OE060 02610CSR ENDSR OE060 02620C********************************************************************OE060 02630C* OE060 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE060 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE060 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE060 0002670C* THEN NO FIELD INFORMATION IS PRINTED OE060 02680C* OE060 02690C********************************************************************OE060 02700CSR OUTFLD BEGSR OE060 02710C* ********** OE060 02720CSR MOVE FN,X FL 20 OE060 02730CSR EP,X COMP 0 98 OE060 0002740CSR MOVELCP,X FC 20 OE060 02750CSR FC COMP FL 31 OE060 02760CSR 31 Z-ADDFC FL OE060 02770CSR FC SUB FL CC 20 OE060 02780CSR CC ADD 1 CC OE060 02790CSR MOVELCP,X BUFFER OE060 02800CSR MOVELCC BUFFER OE060 0002810CSR EXSR POSCUR OE060 02820C* ********** OE060 02830CSR MOVELBLANKS BUFFER OE060 02840CSR MOVELFN,X FIELDN OE060 02850CSR MOVE ' ' FIELDN OE060 02860CSR MOVELFIELDN BUFFER OE060 02870CSR Z-ADDLN,X LEN 20 OE060 0002880CSR LEN COMP 0 9730 OE060 02890CSR 97 Z-SUBLN,X LEN OE060 02900CSR 30 GOTO SKIPF OE060 02910C* ********** OE060 02920CSR FL ADD 2 BPOS 20 OE060 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE060 02940CSR Z-ADDBPOS TSTRT 30 OE060 0002950CSRN98 Z-ADD1 SSTRT 30 OE060 02960CSR 98 Z-ADD3 SSTRT OE060 02970CSR Z-ADD1 NCHARS 30 OE060 02980C* ********** OE060 02990CSR EXIT SUBRLM OE060 03000CSR RLABL TEMP4 OE060 03010CSR RLABL SSTRT 30 OE060 0003020CSR RLABL BUFFER OE060 03030CSR RLABL TSTRT 30 OE060 03040CSR RLABL NCHARS 30 OE060 03050CSR BPOS ADD 1 FPOS 20 OE060 03060CSR EXSR MVRECD OE060 03070C* ********** OE060 03080CSR SKIPF TAG OE060 0003090C* ********** OE060 03100CSR 30 Z-ADDFL BLNGTH OE060 03110CSRN30 FL ADD 3 BLNGTH OE060 03120CSRN30 BLNGTH ADD LEN BLNGTH OE060 03130CSR MOVE 'T' TYPE OE060 03140CSR EXSR CRTCOM OE060 03150C* ********** OE060 0003160CSR ENDSR OE060 03170C********************************************************************OE060 03180C* OE060 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE060 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE060 03210C* THE RIGHT BRACKET. OE060 03220C********************************************************************OE060 0003230CSR MVRECD BEGSR OE060 03240C* ********** OE060 03250CSR 63 GOTO RBRK OE060 03260C* ********** OE060 03270CSR 98 Z-SUBEP,X END 40 OE060 03280CSRN98 Z-ADDEP,X END OE060 03290CSR END SUB LEN STRT 40 81 81 OE060 0003300CSR STRT ADD 1 STRT OE060 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE060 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER OE060 03330CSR Z-ADDLEN NCHARS OE060 03340CSR Z-ADDSTRT SSTRT OE060 03350CSR Z-ADDFPOS TSTRT OE060 03360C* ********** OE060 0003370CSRN81 GOTO RBRK OE060 03380CSR EXIT SUBRLM OE060 03390CSR RLABL RECORD OE060 03400CSR RLABL SSTRT 30 OE060 03410CSR RLABL BUFFER OE060 03420CSR RLABL TSTRT 30 OE060 03430CSR RLABL NCHARS 30 OE060 0003440CSR RBRK TAG OE060 03450C* ********** OE060 03460CSR EXSR RTBRKT OE060 03470C* ********** OE060 03480CSR ENDSR OE060 03490C********************************************************************OE060 03500C* OE060 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE060 03520C* OE060 03530C********************************************************************OE060 03540CSR RTBRKT BEGSR OE060 03550C* ********** OE060 03560CSR LEN ADD FPOS FPOS OE060 03570CSR Z-ADDFPOS TSTRT OE060 0003580CSR Z-ADD1 NCHARS OE060 03590CSRN98 Z-ADD2 SSTRT OE060 03600CSR 98 Z-ADD4 SSTRT OE060 03610C* ********** OE060 03620CSR EXIT SUBRLM OE060 03630CSR RLABL TEMP4 OE060 03640CSR RLABL SSTRT 30 OE060 0003650CSR RLABL BUFFER OE060 03660CSR RLABL TSTRT 30 OE060 03670CSR RLABL NCHARS 30 OE060 03680CSR ENDSR OE060 03690C********************************************************************OE060 03700C* OE060 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE060 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE060 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE060 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE060 03750C* OF THE FIELDS ARE LEFT UNCHANGED OE060 03760C* OE060 03770C********************************************************************OE060 03780CSR UPDATE BEGSR OE060 0003790C* ********** OE060 03800CSR SETOF 32 OE060 03810CSR Z-ADD1 X OE060 03820CSR UPLOOP TAG OE060 03830C* ********** OE060 03840CSR EP,X COMP 0 98 OE060 03850CSR 98 SETON 30 OE060 0003860CSR 98 GOTO NOUPD OE060 03870C* ********** OE060 03880CSR Z-ADDLN,X LEN OE060 03890CSR LEN COMP 0 9730 OE060 03900CSR 97 Z-SUBLEN LEN OE060 03910CSR NOUPD TAG OE060 03920C* ********** OE060 0003930CSR 30N32 GOTO INCR OE060 03940C* ********** OE060 03950CSR 30 GOTO CHKRUB OE060 03960C* ********** OE060 03970CSR SETOF 3233 OE060 03980CSR EXSR ACCEPT OE060 03990C* ********** OE060 0004000CSR CHKRUB TAG OE060 04010C* ********** OE060 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE060 04030CSR 32 31 GOTO UPLOOP OE060 04040C* ********** OE060 04050CSR 32 GOTO ENDUPD OE060 04060C* ********** OE060 0004070CSR MOVELBUFFER ATSIGN 1 OE060 04080CSR ATSIGN COMP '@' 35 OE060 04090CSR 35 GOTO OUTREC OE060 04100C* ********** OE060 04110CSR 33 GOTO INCR WAS LINE FEED OE060 04120C* ********** OE060 04130CSR Z-ADDEP,X END OE060 0004140CSR END SUB LEN STRT 81 81 OE060 04150CSR STRT ADD 1 STRT OE060 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE060 04170C* BUFFER TO THE STRT OF RECORD OE060 04180CSR Z-ADD1 SSTRT OE060 04190CSR Z-ADDSTRT TSTRT OE060 04200CSR Z-ADDLEN NCHARS OE060 0004210C* ********** OE060 04220CSRN81 GOTO AAA OE060 04230CSR EXIT SUBRLM OE060 04240CSR RLABL BUFFER OE060 04250CSR RLABL SSTRT 30 OE060 04260CSR RLABL RECORD OE060 04270CSR RLABL TSTRT 30 OE060 0004280CSR RLABL NCHARS 30 OE060 04290CSR AAA TAG OE060 04300CSR MOVELBUFFER TEMP5 5 OE060 04310CSR MOVELSAVPOS BUFFER OE060 04320CSR EXSR POSCUR OE060 04330C* ********** OE060 04340CSR MOVELTEMP5 BUFFER OE060 0004350CSR Z-ADD1 FPOS OE060 04360CSR EXSR RTBRKT OE060 04370C* ********** OE060 04380CSR LEN ADD 1 BLNGTH OE060 04390CSR MOVE 'T' TYPE OE060 04400CSR EXSR CRTCOM OE060 04410C* ********** OE060 0004420CSR INCR TAG OE060 04430C* ********** OE060 04440CSR X ADD 1 X OE060 04450CSR X COMP NOFLDS 30 OE060 04460CSR 30 GOTO UPLOOP OE060 04470C* ********** OE060 04480CSR OUTREC TAG OE060 0004490C* ********** OE060 04500CSR SETON 80 OE060 04510CSRN61 EXCPT OE060 04520CSR SETOF 80 OE060 04530CSR ENDUPD TAG OE060 04540C* ********** OE060 04550CSR ENDSR OE060 0004560C********************************************************************OE060 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE060 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE060 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE060 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE060 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE060 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE060 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE060 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE060 04650C* TO BE OUTPUT TO THE SCREEN. OE060 04660C* OE060 04670C********************************************************************OE060 04680CSR ACCEPT BEGSR OE060 04690C* ********** OE060 0004700CSR X COMP 1 30 OE060 04710CSRN30 X COMP SSIZE 30 OE060 04720CSR 30 Z-ADD1 X OE060 04730CSR MOVELCP,X FC OE060 04740CSR FC ADD 3 FC OE060 04750CSR MOVELCP,X SAVPOS 4 OE060 04760CSR MOVELFC SAVPOS OE060 0004770CSR Z-ADDLN,X LEN OE060 04780CSR LEN COMP 0 97 OE060 04790CSR 97 Z-SUBLEN LEN OE060 04800CSR LEN ADD FC OFC 20 OE060 04810CSR ACLOOP TAG OE060 04820C* ********** OE060 04830CSR MOVELSAVPOS BUFFER OE060 0004840CSR EXSR POSCUR OE060 04850C* ********** OE060 04860CSR Z-ADDLEN BLNGTH OE060 04870CSR MOVE BLANKS BUFFER OE060 04880CSR MOVE 'A' TYPE OE060 04890CSR EXSR CRTCOM OE060 04900C* ********** OE060 0004910CSR RCODE COMP 'R' 31 OE060 04920CSR 31 BUFFER COMP BLANKS 32 OE060 04930CSR 31 32N62 GOTO DUPIT OE060 04940C* ********** OE060 04950CSR 31 GOTO ACLOOP OE060 04960C* ********** OE060 04970CSR RCODE COMP 'L' 33 OE060 0004980CSR 33 GOTO DUPIT OE060 04990C* ********** OE060 05000CSRN97 GOTO ENDACC OE060 05010C* ********** OE060 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE060 05030CSR SIGN COMP '@' 30 OE060 05040CSR 30 GOTO ENDACC OE060 0005050C* ********** OE060 05060CSR Z-ADDLEN VL 20 OE060 05070CSR MOVELBUFFER VAR 15 OE060 05080CSR EXSR RTADJ OE060 05090C* ********** OE060 05100CSR MOVELVAR BUFFER OE060 05110CSR GOTO ENDACC OE060 0005120C* ********** OE060 05130CSR DUPIT TAG OE060 05140C* ********** OE060 05150CSR MOVELSAVPOS BUFFER OE060 05160CSR EXSR POSCUR OE060 05170C* ********** OE060 05180CSR 62 MOVELSECTON BUFFER OE060 0005190CSRN62 Z-ADD1 FPOS OE060 05200CSRN62 EXSR MVRECD OE060 05210C* ********** OE060 05220CSR MOVE 'T' TYPE OE060 05230CSR BLNGTH ADD 1 BLNGTH OE060 05240CSR EXSR CRTCOM OE060 05250C* ********** OE060 0005260CSR ENDACC ENDSR OE060 05270C* ********** OE060 05280C********************************************************************OE060 05290C* OE060 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE060 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE060 05320C* 4 DUMMY FOR RTADJ OE060 0005330C* OE060 05340C********************************************************************OE060 05350CSR POSCUR BEGSR OE060 05360C* ********** OE060 05370CSR MOVE 'P' TYPE OE060 05380CSR EXSR CRTCOM OE060 05390C* ********** OE060 0005400CSR ENDSR OE060 05410C********************************************************************OE060 05420CSR CLRSCR BEGSR OE060 05430C* ********** OE060 05440CSR MOVE 'C' TYPE OE060 05450CSR EXSR CRTCOM OE060 05460C* ********** OE060 0005470CSR ENDSR OE060 05480C********************************************************************OE060 05490CSR CRTCOM BEGSR OE060 05500C* ********** OE060 05510C* ********** OE060 05520CSR EXITFSUBRCM OE060 05530CSR RLABL BUFFER 72 OE060 0005540CSR RLABL TYPE 1 OE060 05550CSR RLABL BLNGTH 20 OE060 05560CSR RLABL RCODE 1 OE060 05570CSR RLABL MASK 10 OE060 05580CSR RLABL DTYPE 10 OE060 05590CSR ENDSR OE060 05600C********************************************************************OE060 0005610CSR RTADJ BEGSR OE060 05620C* ********** OE060 05630CSR EXIT SUBRAJ OE060 05640C* ********** OE060 05650CSR RLABL VL OE060 05660CSR RLABL VAR OE060 05670CSR ENDSR OE060 0005680C********************************************************************OE060 05690OAREA E 80N55 OE060 05700O RECORD 0030 OE060 05710O E 40N80 OE060 05720O FF 30 OE060 05730O EADD 80 55 OE060 05740O RECORD 0030 OE060 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800__0O RECORD 0030 OE060 0( GTXOE062 P999999032778(000010H S OE062 00020X DECK-ID A55 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE062 00030F* PRINTS AREA MASTER FILE OE062 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE062 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE062 00060F* CONTROL DATA PROPRIETARY PRODUCT OE062 00070F* OE062 0000080FAREA IPEAF 30 2AI 1 DISK OE062 00090FHEADING IT F 40 EDISK OE062 00100F$LP1 O F 132 OF PRINTER OE062 00110F********************************************************************OE062 00120F* OE062 00130F* PACKAGE DISTRIBUTION OE062 00140F* SYSTEM FILE MAINTENANCE OE062 0000150F* PROGRAM LISTS AREA MASTER FILE RECORDS THAT AREN'T FLAGGED FOR OE062 00160F* DELETION AND COUNTS THEM OE062 00170F* OE062 00180F* CONTRACTOR COMPUSOURCE OE062 00190F* PROGRAMMER KATHY HILL OE062 00200F* DATE OCTOBER 8, 1976 OE062 00210F* OE062 0000220F********************************************************************OE062 00230F* OE062 00240F* ID F C H L FUNCTION OF INDICATORS OE062 00250F* OE062 00260F* 01 AREA --> GOOD OE062 00270F* 02 AREA --> FLAGGED FOR DELETION OE062 00280F* OE062 0000290F********************************************************************OE062 00300F* OE062 00310E HEADING HEAD 1 1 40 COMPANY NAME OE062 00320IAREA NS 01 30 C OE062 00330I 1 2 AREACD OE062 00340I 3 27 NAME OE062 00350I NS 02 OE062 0000360I 1 1 DLTED OE062 00370C* OE062 00380C 01 CNT ADD 1 CNT 80 OE062 00390C* OE062 00400O$LP1 H 202 1P OE062 00410O OR OF OE062 00420O 4 'PAGE' OE062 0000430O PAGE Z 8 OE062 00440O HEAD,1 86 OE062 00450O UDATE Y 132 OE062 00460O H 2 1P OE062 00470O OR OF OE062 00480O 58 'AREA' OE062 00490O 78 'MASTER FILE LISTING' OE062 0000500O 132 'DIS062' OE062 00510O H 2 1P OE062 00520O OR OF OE062 00530O 9 'AREA CODE' OE062 00540O 15 'NAME' OE062 00550O D 1 01 OE062 00560O AREACD 6 OE062 0000570O NAME 36 OE062 00580O T 21 LR OE062 00590O 11 'END OF JOB.' OE062 00600O 23 'THERE WERE' OE062 00610O CNT 1 34 OE062 00620O 56 'ACTIVE RECORDS IN THE' OE062 00630O 61 'AREA' OE062 0000640O 74 'MASTER FILE.' OE062 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( DTXOE070 P999999032778(000010H S OE070 00020X DECK-ID A56 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE070 00030F* INQUIRY AND MAINTENANCE FOR TERMS FILE OE070 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE070 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE070 00060F* CONTROL DATA PROPRIETARY PRODUCT OE070 00070F* OE070 0000080FNULL IPEAF 72 DISK OE070 00090F@DIS70 IC F 32R DISK OE070 00100FTERMS UC F 0030R01AI 0001 DISK A OE070 00110E FN 015 22 FIELD NAME OE070 00120E CP 015 4 CURSOR POSITION OE070 00130E LN 015 2 0 LENGTH OE070 00140E EP 015 4 0 ENDING POSITION OE070 0000150INULL NS 01 OE070 00160I 1 1 A OE070 00170I@DIS70 NS 02 OE070 00180I 1 22 FIELDN OE070 00190I 23 26 CURPOS OE070 00200I 27 280LNGTH OE070 00210I 29 310ENDPOS OE070 0000220ITERMS NS 03 OE070 00230I 10030 RECORD OE070 00240C MOVE ' ' RCODE 1 OE070 00250C MOVE RCODE B22 22 OE070 00260C MOVE RCODE BLANKS 72 OE070 00270C MOVE RCODE FILLER 1 OE070 00280C Z-ADD0 MASK 10 OE070 0000290C SETON LR OE070 00300CLR Z-ADD015 SSIZE 30 OE070 00310CLR Z-ADD002 NSECT 30 OE070 00320CLR MOVE 'D' FF 1 OE070 00330CLR MOVE '[]<>' TEMP4 4 OE070 00340CLR START TAG OE070 00350C* ********** OE070 0000360CLR EXSR FIRSTP OE070 00370C* ********** OE070 00380CLR EXSR CLRSCR OE070 00390C* ********** OE070 00400CLR 40 GOTO EOJ OE070 00410C* ********** OE070 00420CLR Z-ADD2 VL OE070 0000430CLR MOVELSECTON VAR OE070 00440CLR EXSR RTADJ OE070 00450C* ********** OE070 00460CLR MOVELVAR SECTN 20 OE070 00470CLR EXSR GETSEC OE070 00480C* ********** OE070 00490CLRN45 GOTO START OE070 0000500C* ********** OE070 00510CLR EXSR CLRSCR OE070 00520C* ********** OE070 00530CLR EXSR OUTPUT OE070 00540C* ********** OE070 00550CLR EXSR UPDATE OE070 00560C* ********** OE070 0000570CLR GOTO START OE070 00580C* ********** OE070 00590CLR EOJ TAG OE070 00600C* ********** OE070 00610C********************************************************************OE070 00620C* OE070 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE070 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE070 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE070 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE070 00670C* OE070 00680C********************************************************************OE070 00690CSR FIRSTP BEGSR OE070 00700C* ********** OE070 0000710CSR EXSR CLRSCR OE070 00720C* ********** OE070 00730CSR Z-ADD0 SECTN OE070 00740CSR EXSR GETSEC OE070 00750C* ********** OE070 00760CSR PGE TAG OE070 00770C* ********** OE070 0000780CSR SETON 61 OE070 00790CSR SETOF 62 OE070 00800CSR EXSR OUTPUT OE070 00810C* ********** OE070 00820CSR EXIT SUBRFL OE070 00830C* ********** OE070 00840CSR RLABL RECORD OE070 0000850CSR RLABL FILLER 1 OE070 00860C* ********** OE070 00870C* ********** OE070 00880C* ********** OE070 00890C* ********** OE070 00900C* ********** OE070 00910C* ********** OE070 0000920C* ********** OE070 00930C* ********** OE070 00940C* ********** OE070 00950C* ********** OE070 00960C* ********** OE070 00970C* ********** OE070 00980C* ********** OE070 0000990C* ********** OE070 01000C* ********** OE070 01010CSR Z-ADD01 NCHARS OE070 01020CSR Z-ADD1 SSTRT OE070 01030CSR Z-ADD0001 TSTRT OE070 01040C* ********** OE070 01050CSR EXIT SUBRLM OE070 0001060CSR RLABL KEY 01 OE070 01070CSR RLABL SSTRT 30 OE070 01080CSR RLABL RECORD OE070 01090CSR RLABL TSTRT 30 OE070 01100CSR RLABL NCHARS 30 OE070 01110CSR Z-ADDNOFLDS SVFLDS 30 OE070 01120CSR Z-ADDSX NOFLDS OE070 0001130CSR EXSR UPDATE OE070 01140C* ********** OE070 01150CSR Z-ADDSVFLDS NOFLDS OE070 01160CSR Z-ADD01 NCHARS OE070 01170CSR Z-ADD0001 SSTRT OE070 01180CSR Z-ADD1 TSTRT OE070 01190C* ********** OE070 0001200CSR EXIT SUBRLM OE070 01210CSR RLABL RECORD OE070 01220CSR RLABL SSTRT 30 OE070 01230CSR RLABL KEY OE070 01240CSR RLABL TSTRT 30 OE070 01250CSR RLABL NCHARS 30 OE070 01260CSR KEY CHAINTERMS 55 OE070 0001270CSR MOVELSAVPOS BUFFER OE070 01280CSR MOVELOFC BUFFER OE070 01290CSR EXSR POSCUR OE070 01300C* ********** OE070 01310CSR MOVEL'] NEW R'WORD16 16 OE070 01320CSR MOVE 'ECORD 'WORD16 OE070 01330CSRN55 MOVELBLANKS WORD16 OE070 0001340CSRN55 MOVEL']' WORD16 OE070 01350CSR MOVELWORD16 BUFFER 72 OE070 01360CSR MOVE 'T' TYPE 1 OE070 01370CSR Z-ADD13 BLNGTH 20 OE070 01380CSR EXSR CRTCOM OE070 01390C* ********** OE070 01400CSR SETON 62 OE070 0001410CSR Z-ADDSX X 30 OE070 01420CSR EXSR ACCEPT OE070 01430C* ********** OE070 01440CSR MOVELBUFFER SECTON 2 OE070 01450CSR SECTON COMP 'E ' 40 OE070 01460CSR 40 GOTO ENDFP OE070 01470C* ********** OE070 0001480CSR SECTON COMP 'D ' 40 OE070 01490CSR 40N55 EXCPT OE070 01500CSR 40 GOTO PGE OE070 01510C* ********** OE070 01520CSR SECTON COMP ' 1' 30 30 OE070 01530CSR 30 SECTON COMP ' 9' 3030 OE070 01540CSR 30 GOTO GOOD OE070 0001550C* ********** OE070 01560CSR SECTON COMP '01' 30 30 OE070 01570CSR 30 SECTON COMP '09' 3030 OE070 01580CSR 30 GOTO GOOD OE070 01590C* ********** OE070 01600CSR SECTON COMP '1 ' 30 30 OE070 01610CSR 30 SECTON COMP '9 ' 3030 OE070 0001620CSR 30 GOTO GOOD OE070 01630C* ********** OE070 01640CSR MOVELSECTON TEMP1 1 OE070 01650CSR TEMP1 COMP '1' 30 30 OE070 01660CSR 30 TEMP1 COMP '9' 3030 OE070 01670CSRN30 GOTO PGE OE070 01680C* ********** OE070 0001690CSR MOVE SECTON TEMP1 OE070 01700CSR TEMP1 COMP '0' 30 30 OE070 01710CSR 30 TEMP1 COMP '9' 3030 OE070 01720CSRN30 GOTO PGE OE070 01730C* ********** OE070 01740CSR GOOD TAG OE070 01750C* ********** OE070 0001760CSR SETOF 6162 OE070 01770CSRN55 GOTO ENDFP OE070 01780C* ********** OE070 01790CSR SETON 80 OE070 01800CSR EXCPT OE070 01810CSR SETOF 80 OE070 01820CSR KEY CHAINTERMS 55 OE070 0001830CSR ENDFP ENDSR OE070 01840C* ********** OE070 01850C********************************************************************OE070 01860C* OE070 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE070 01880C* OE070 01890C********************************************************************OE070 0001900CSR GETSEC BEGSR OE070 01910C* ********** OE070 01920CSR 1 ADD SECTN N 20 OE070 01930CSR SETOF 404145 OE070 01940CSR N COMP 0 3030 OE070 01950CSRN30 N COMP NSECT 30 OE070 01960CSR 30 GOTO ENDGET OE070 0001970C* ********** OE070 01980CSR SECTN MULT SSIZE RRN 40 OE070 01990CSR Z-ADD1 X OE070 02000CSR SCLOOP TAG OE070 02010C* ********** OE070 02020CSR RRN ADD 1 RRN OE070 02030CSR RRN CHAIN@DIS70 50 OE070 0002040CSR 50 GOTO ENDGET OE070 02050C* ********** OE070 02060CSR FIELDN COMP B22 4141 OE070 02070CSRN41 GOTO ENDGET OE070 02080C* ********** OE070 02090CSR 41N45 SETON 45 OE070 02100CSR MOVE FIELDN FN,X OE070 0002110CSR MOVE CURPOS CP,X OE070 02120CSR MOVE LNGTH LN,X OE070 02130CSR Z-ADDENDPOS EP,X OE070 02140CSR 1 ADD X X OE070 02150CSR X COMP SSIZE 32 OE070 02160CSRN32 GOTO SCLOOP OE070 02170C* ********** OE070 0002180CSR ENDGET TAG OE070 02190C* ********** OE070 02200CSR Z-ADDX NOFLDS 30 OE070 02210CSR 45 GOTO FINGET OE070 02220C* ********** OE070 02230CSR EXSR CLRSCR OE070 02240C* ********** OE070 0002250CSR MOVEL'SECT # 'WORD9 9 OE070 02260CSR Z-ADD16 BLNGTH OE070 02270CSR MOVE SECTN WORD9 OE070 02280CSR MOVELWORD9 WORD16 OE070 02290CSRN30 MOVE ' ABSENT' WORD16 OE070 02300CSR 30 MOVE ' ILLEG.' WORD16 OE070 02310CSR MOVELWORD16 BUFFER OE070 0002320CSR MOVEL'T' TYPE OE070 02330CSR EXSR CRTCOM OE070 02340C* ********** OE070 02350CSR FINGET ENDSR OE070 02360C* ********** OE070 02370C********************************************************************OE070 02380C* OE070 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE070 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE070 02410C* SECTION INDEX IS SAVED. OE070 02420C* OE070 02430C********************************************************************OE070 02440CSR OUTPUT BEGSR OE070 02450C* ********** OE070 0002460CSR EXSR CLRSCR OE070 02470C* ********** OE070 02480CSR Z-ADD1 X OE070 02490CSR 61 SETON 63 OE070 02500CSR OTLOOP TAG OE070 02510C* ********** OE070 02520CSR 61 LN,X COMP 0 31 OE070 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE070 02540CSR EXSR OUTFLD OE070 02550C* ********** OE070 02560CSR X ADD 1 X OE070 02570CSR X COMP NOFLDS 31 OE070 02580CSR 31 GOTO OTLOOP OE070 02590C* ********** OE070 0002600CSR SETOF 63 OE070 02610CSR ENDSR OE070 02620C********************************************************************OE070 02630C* OE070 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE070 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE070 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE070 0002670C* THEN NO FIELD INFORMATION IS PRINTED OE070 02680C* OE070 02690C********************************************************************OE070 02700CSR OUTFLD BEGSR OE070 02710C* ********** OE070 02720CSR MOVE FN,X FL 20 OE070 02730CSR EP,X COMP 0 98 OE070 0002740CSR MOVELCP,X FC 20 OE070 02750CSR FC COMP FL 31 OE070 02760CSR 31 Z-ADDFC FL OE070 02770CSR FC SUB FL CC 20 OE070 02780CSR CC ADD 1 CC OE070 02790CSR MOVELCP,X BUFFER OE070 02800CSR MOVELCC BUFFER OE070 0002810CSR EXSR POSCUR OE070 02820C* ********** OE070 02830CSR MOVELBLANKS BUFFER OE070 02840CSR MOVELFN,X FIELDN OE070 02850CSR MOVE ' ' FIELDN OE070 02860CSR MOVELFIELDN BUFFER OE070 02870CSR Z-ADDLN,X LEN 20 OE070 0002880CSR LEN COMP 0 9730 OE070 02890CSR 97 Z-SUBLN,X LEN OE070 02900CSR 30 GOTO SKIPF OE070 02910C* ********** OE070 02920CSR FL ADD 2 BPOS 20 OE070 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE070 02940CSR Z-ADDBPOS TSTRT 30 OE070 0002950CSRN98 Z-ADD1 SSTRT 30 OE070 02960CSR 98 Z-ADD3 SSTRT OE070 02970CSR Z-ADD1 NCHARS 30 OE070 02980C* ********** OE070 02990CSR EXIT SUBRLM OE070 03000CSR RLABL TEMP4 OE070 03010CSR RLABL SSTRT 30 OE070 0003020CSR RLABL BUFFER OE070 03030CSR RLABL TSTRT 30 OE070 03040CSR RLABL NCHARS 30 OE070 03050CSR BPOS ADD 1 FPOS 20 OE070 03060CSR EXSR MVRECD OE070 03070C* ********** OE070 03080CSR SKIPF TAG OE070 0003090C* ********** OE070 03100CSR 30 Z-ADDFL BLNGTH OE070 03110CSRN30 FL ADD 3 BLNGTH OE070 03120CSRN30 BLNGTH ADD LEN BLNGTH OE070 03130CSR MOVE 'T' TYPE OE070 03140CSR EXSR CRTCOM OE070 03150C* ********** OE070 0003160CSR ENDSR OE070 03170C********************************************************************OE070 03180C* OE070 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE070 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE070 03210C* THE RIGHT BRACKET. OE070 03220C********************************************************************OE070 0003230CSR MVRECD BEGSR OE070 03240C* ********** OE070 03250CSR 63 GOTO RBRK OE070 03260C* ********** OE070 03270CSR 98 Z-SUBEP,X END 40 OE070 03280CSRN98 Z-ADDEP,X END OE070 03290CSR END SUB LEN STRT 40 81 81 OE070 0003300CSR STRT ADD 1 STRT OE070 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE070 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER OE070 03330CSR Z-ADDLEN NCHARS OE070 03340CSR Z-ADDSTRT SSTRT OE070 03350CSR Z-ADDFPOS TSTRT OE070 03360C* ********** OE070 0003370CSRN81 GOTO RBRK OE070 03380CSR EXIT SUBRLM OE070 03390CSR RLABL RECORD OE070 03400CSR RLABL SSTRT 30 OE070 03410CSR RLABL BUFFER OE070 03420CSR RLABL TSTRT 30 OE070 03430CSR RLABL NCHARS 30 OE070 0003440CSR RBRK TAG OE070 03450C* ********** OE070 03460CSR EXSR RTBRKT OE070 03470C* ********** OE070 03480CSR ENDSR OE070 03490C********************************************************************OE070 03500C* OE070 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE070 03520C* OE070 03530C********************************************************************OE070 03540CSR RTBRKT BEGSR OE070 03550C* ********** OE070 03560CSR LEN ADD FPOS FPOS OE070 03570CSR Z-ADDFPOS TSTRT OE070 0003580CSR Z-ADD1 NCHARS OE070 03590CSRN98 Z-ADD2 SSTRT OE070 03600CSR 98 Z-ADD4 SSTRT OE070 03610C* ********** OE070 03620CSR EXIT SUBRLM OE070 03630CSR RLABL TEMP4 OE070 03640CSR RLABL SSTRT 30 OE070 0003650CSR RLABL BUFFER OE070 03660CSR RLABL TSTRT 30 OE070 03670CSR RLABL NCHARS 30 OE070 03680CSR ENDSR OE070 03690C********************************************************************OE070 03700C* OE070 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE070 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE070 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE070 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE070 03750C* OF THE FIELDS ARE LEFT UNCHANGED OE070 03760C* OE070 03770C********************************************************************OE070 03780CSR UPDATE BEGSR OE070 0003790C* ********** OE070 03800CSR SETOF 32 OE070 03810CSR Z-ADD1 X OE070 03820CSR UPLOOP TAG OE070 03830C* ********** OE070 03840CSR EP,X COMP 0 98 OE070 03850CSR 98 SETON 30 OE070 0003860CSR 98 GOTO NOUPD OE070 03870C* ********** OE070 03880CSR Z-ADDLN,X LEN OE070 03890CSR LEN COMP 0 9730 OE070 03900CSR 97 Z-SUBLEN LEN OE070 03910CSR NOUPD TAG OE070 03920C* ********** OE070 0003930CSR 30N32 GOTO INCR OE070 03940C* ********** OE070 03950CSR 30 GOTO CHKRUB OE070 03960C* ********** OE070 03970CSR SETOF 3233 OE070 03980CSR EXSR ACCEPT OE070 03990C* ********** OE070 0004000CSR CHKRUB TAG OE070 04010C* ********** OE070 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE070 04030CSR 32 31 GOTO UPLOOP OE070 04040C* ********** OE070 04050CSR 32 GOTO ENDUPD OE070 04060C* ********** OE070 0004070CSR MOVELBUFFER ATSIGN 1 OE070 04080CSR ATSIGN COMP '@' 35 OE070 04090CSR 35 GOTO OUTREC OE070 04100C* ********** OE070 04110CSR 33 GOTO INCR WAS LINE FEED OE070 04120C* ********** OE070 04130CSR Z-ADDEP,X END OE070 0004140CSR END SUB LEN STRT 81 81 OE070 04150CSR STRT ADD 1 STRT OE070 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE070 04170C* BUFFER TO THE STRT OF RECORD OE070 04180CSR Z-ADD1 SSTRT OE070 04190CSR Z-ADDSTRT TSTRT OE070 04200CSR Z-ADDLEN NCHARS OE070 0004210C* ********** OE070 04220CSRN81 GOTO AAA OE070 04230CSR EXIT SUBRLM OE070 04240CSR RLABL BUFFER OE070 04250CSR RLABL SSTRT 30 OE070 04260CSR RLABL RECORD OE070 04270CSR RLABL TSTRT 30 OE070 0004280CSR RLABL NCHARS 30 OE070 04290CSR AAA TAG OE070 04300CSR MOVELBUFFER TEMP5 5 OE070 04310CSR MOVELSAVPOS BUFFER OE070 04320CSR EXSR POSCUR OE070 04330C* ********** OE070 04340CSR MOVELTEMP5 BUFFER OE070 0004350CSR Z-ADD1 FPOS OE070 04360CSR EXSR RTBRKT OE070 04370C* ********** OE070 04380CSR LEN ADD 1 BLNGTH OE070 04390CSR MOVE 'T' TYPE OE070 04400CSR EXSR CRTCOM OE070 04410C* ********** OE070 0004420CSR INCR TAG OE070 04430C* ********** OE070 04440CSR X ADD 1 X OE070 04450CSR X COMP NOFLDS 30 OE070 04460CSR 30 GOTO UPLOOP OE070 04470C* ********** OE070 04480CSR OUTREC TAG OE070 0004490C* ********** OE070 04500CSR SETON 80 OE070 04510CSRN61 EXCPT OE070 04520CSR SETOF 80 OE070 04530CSR ENDUPD TAG OE070 04540C* ********** OE070 04550CSR ENDSR OE070 0004560C********************************************************************OE070 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE070 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE070 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE070 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE070 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE070 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE070 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE070 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE070 04650C* TO BE OUTPUT TO THE SCREEN. OE070 04660C* OE070 04670C********************************************************************OE070 04680CSR ACCEPT BEGSR OE070 04690C* ********** OE070 0004700CSR X COMP 1 30 OE070 04710CSRN30 X COMP SSIZE 30 OE070 04720CSR 30 Z-ADD1 X OE070 04730CSR MOVELCP,X FC OE070 04740CSR FC ADD 3 FC OE070 04750CSR MOVELCP,X SAVPOS 4 OE070 04760CSR MOVELFC SAVPOS OE070 0004770CSR Z-ADDLN,X LEN OE070 04780CSR LEN COMP 0 97 OE070 04790CSR 97 Z-SUBLEN LEN OE070 04800CSR LEN ADD FC OFC 20 OE070 04810CSR ACLOOP TAG OE070 04820C* ********** OE070 04830CSR MOVELSAVPOS BUFFER OE070 0004840CSR EXSR POSCUR OE070 04850C* ********** OE070 04860CSR Z-ADDLEN BLNGTH OE070 04870CSR MOVE BLANKS BUFFER OE070 04880CSR MOVE 'A' TYPE OE070 04890CSR EXSR CRTCOM OE070 04900C* ********** OE070 0004910CSR RCODE COMP 'R' 31 OE070 04920CSR 31 BUFFER COMP BLANKS 32 OE070 04930CSR 31 32N62 GOTO DUPIT OE070 04940C* ********** OE070 04950CSR 31 GOTO ACLOOP OE070 04960C* ********** OE070 04970CSR RCODE COMP 'L' 33 OE070 0004980CSR 33 GOTO DUPIT OE070 04990C* ********** OE070 05000CSRN97 GOTO ENDACC OE070 05010C* ********** OE070 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE070 05030CSR SIGN COMP '@' 30 OE070 05040CSR 30 GOTO ENDACC OE070 0005050C* ********** OE070 05060CSR Z-ADDLEN VL 20 OE070 05070CSR MOVELBUFFER VAR 15 OE070 05080CSR EXSR RTADJ OE070 05090C* ********** OE070 05100CSR MOVELVAR BUFFER OE070 05110CSR GOTO ENDACC OE070 0005120C* ********** OE070 05130CSR DUPIT TAG OE070 05140C* ********** OE070 05150CSR MOVELSAVPOS BUFFER OE070 05160CSR EXSR POSCUR OE070 05170C* ********** OE070 05180CSR 62 MOVELSECTON BUFFER OE070 0005190CSRN62 Z-ADD1 FPOS OE070 05200CSRN62 EXSR MVRECD OE070 05210C* ********** OE070 05220CSR MOVE 'T' TYPE OE070 05230CSR BLNGTH ADD 1 BLNGTH OE070 05240CSR EXSR CRTCOM OE070 05250C* ********** OE070 0005260CSR ENDACC ENDSR OE070 05270C* ********** OE070 05280C********************************************************************OE070 05290C* OE070 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE070 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE070 05320C* 4 DUMMY FOR RTADJ OE070 0005330C* OE070 05340C********************************************************************OE070 05350CSR POSCUR BEGSR OE070 05360C* ********** OE070 05370CSR MOVE 'P' TYPE OE070 05380CSR EXSR CRTCOM OE070 05390C* ********** OE070 0005400CSR ENDSR OE070 05410C********************************************************************OE070 05420CSR CLRSCR BEGSR OE070 05430C* ********** OE070 05440CSR MOVE 'C' TYPE OE070 05450CSR EXSR CRTCOM OE070 05460C* ********** OE070 0005470CSR ENDSR OE070 05480C********************************************************************OE070 05490CSR CRTCOM BEGSR OE070 05500C* ********** OE070 05510C* ********** OE070 05520CSR EXITFSUBRCM OE070 05530CSR RLABL BUFFER 72 OE070 0005540CSR RLABL TYPE 1 OE070 05550CSR RLABL BLNGTH 20 OE070 05560CSR RLABL RCODE 1 OE070 05570CSR RLABL MASK 10 OE070 05580CSR RLABL DTYPE 10 OE070 05590CSR ENDSR OE070 05600C********************************************************************OE070 0005610CSR RTADJ BEGSR OE070 05620C* ********** OE070 05630CSR EXIT SUBRAJ OE070 05640C* ********** OE070 05650CSR RLABL VL OE070 05660CSR RLABL VAR OE070 05670CSR ENDSR OE070 0005680C********************************************************************OE070 05690OTERMS E 80N55 OE070 05700O RECORD 0030 OE070 05710O E 40N80 OE070 05720O FF 30 OE070 05730O EADD 80 55 OE070 05740O RECORD 0030 OE070 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800__0O RECORD 0030 OE070 0( GTXOE072 P999999032778(000010H S OE072 00020X DECK-ID A57 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE072 00030F* PRINTS TERMS MASTER FILE OE072 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE072 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE072 00060F* CONTROL DATA PROPRIETARY PRODUCT OE072 00070F* OE072 0000080FTERMS IPEAF 30 1AI 1 DISK OE072 00090FHEADING IT F 40 EDISK OE072 00100F$LP1 O F 132 OF PRINTER OE072 00110F********************************************************************OE072 00120F* OE072 00130F* PACKAGE DISTRIBUTION OE072 00140F* SYSTEM FILE MAINTENANCE OE072 0000150F* PROGRAM LISTS PAYMENT TERMS MASTER FILE RECORDS THAT AREN'T OE072 00160F* FLAGGED FOR DELETION AND COUNTS THEM OE072 00170F* OE072 00180F* CONTRACTOR COMPUSOURCE OE072 00190F* PROGRAMMER KATHY HILL OE072 00200F* DATE OCTOBER 8, 1976 OE072 00210F* OE072 0000220F********************************************************************OE072 00230F* OE072 00240F* ID F C H L FUNCTION OF INDICATORS OE072 00250F* OE072 00260F* 01 TERMS --> GOOD OE072 00270F* 02 TERMS --> FLAGGED FOR DELETION OE072 00280F* OE072 0000290F********************************************************************OE072 00300F* OE072 00310E HEADING HEAD 1 1 40 COMPANY NAME OE072 00320ITERMS NS 01 30 C OE072 00330I 1 1 TRMSCD OE072 00340I 2 26 PYMTTM OE072 00350I NS 02 OE072 0000360I 1 1 DLTED OE072 00370C* OE072 00380C 01 CNT ADD 1 CNT 80 OE072 00390C* OE072 00400O$LP1 H 202 1P OE072 00410O OR OF OE072 00420O 4 'PAGE' OE072 0000430O PAGE Z 8 OE072 00440O HEAD,1 86 OE072 00450O UDATE Y 132 OE072 00460O H 2 1P OE072 00470O OR OF OE072 00480O 62 'PAYMENT TERMS' OE072 00490O 82 'MASTER FILE LISTING' OE072 0000500O 132 'DIS072' OE072 00510O H 2 1P OE072 00520O OR OF OE072 00530O 10 'TERMS CODE' OE072 00540O 25 'PAYMENT TERMS' OE072 00550O D 1 01 OE072 00560O TRMSCD 6 OE072 0000570O PYMTTM 37 OE072 00580O T 21 LR OE072 00590O 11 'END OF JOB.' OE072 00600O 23 'THERE WERE' OE072 00610O CNT 1 34 OE072 00620O 56 'ACTIVE RECORDS IN THE' OE072 00630O 70 'PAYMENT TERMS' OE072 0000640O 83 'MASTER FILE.' OE072 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(V `TXOE080 P999999032778(000010H S OE080 00020X DECK-ID A58 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE080 00030F* PURGES MASTER FILES OF R5CORDS FLAGGED FOR DELETION OE080 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE080 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE080 00060F* CONTROL DATA PROPRIETARY PRODUCT OE080 00070F* OE080 0000080FPARTMST IPEAF 300 DISK U1 OE080 00090FSLSMAN ISEAF 30 DISK U2 OE080 00100FAREA ISEAF 30 DISK U3 OE080 00110FTERMS ISEAF 30 DISK U4 OE080 00120FSAMAST ISEAF 140 DISK U7 OE080 00130FARMAST ISEAF 280 DISK U8 OE080 00140FPAROUT O F 300 DISK U1 OE080 0000150FSMNOUT O F 30 3AI 1 DISK U2 OE080 00160FARAOUT O F 30 2AI 1 DISK U3 OE080 00170FTRMOUT O F 30 1AI 1 DISK U4 OE080 00180FSAOUT O F 140 20AI 121 DISK U7 OE080 00190FAROUT O F 280 6AI 1 DISK U8 OE080 00200F$LP1 O F 132 OF PRINTER OE080 00210F********************************************************************OE080 0000220F* OE080 00230F* PACKAGE DISTRIBUTION OE080 00240F* SYSTEM FILE MAINTENANCE OE080 00250F* PROGRAM PURGES MASTER FILES OF RECORDS FLAGGED FOR DELETION OE080 00260F* OE080 00270F* CONTRACTOR COMPUSOURCE OE080 00280F* PROGRAMMER KATHY HILL OE080 0000290F* DATE MARCH 16, 1976 OE080 00300F* OE080 00310F********************************************************************OE080 00320F* OE080 00330F* U1 PARTMST OE080 00340F* U2 SLSMAN OE080 00350F* U3 AREA OE080 0000360F* U4 TERMS OE080 00370F* U7 SAMAST OE080 00380F* U8 ARMAST OE080 00390F* OE080 00400F********************************************************************OE080 00410F* OE080 00420F* ID F C H L FUNCTION OF INDICATORS OE080 0000430F* OE080 00440F* 01 PARTMST KEEP OE080 00450F* 02 PARTMST DELETE OE080 00460F* 03 SAMAST KEEP OE080 00470F* 04 SAMAST DELETE OE080 00480F* 05 ARMAST KEEP OE080 00490F* 06 ARMAST DELETE OE080 0000500F* 07 SLSMAN KEEP OE080 00510F* 08 SLSMAN DELETE OE080 00520F* 09 AREA KEEP OE080 00530F* 10 AREA DELETE OE080 00540F* 11 TERMS KEEP OE080 00550F* 12 TERMS DELETE OE080 00560F* OE080 0000570F********************************************************************OE080 00580IPARTMST NS 01 74 C OE080 00590I 1 200 A1 OE080 00600I 201 300 A2 OE080 00610I NS 02 OE080 00620I 271 290 X1 OE080 00630ISAMAST NS 03 120 C OE080 0000640I 1 140 B1 OE080 00650I NS 04 OE080 00660I 121 140 X2 OE080 00670IARMAST NS 05 115 C OE080 00680I 1 200 C1 OE080 00690I 201 280 C2 OE080 00700I NS 06 OE080 0000710I 1 60X3 OE080 00720ISLSMAN NS 07 30 C OE080 00730I 1 30 D1 OE080 00740I NS 08 OE080 00750I 1 30X4 OE080 00760IAREA NS 09 30 C OE080 00770I 1 30 E1 OE080 0000780I NS 10 OE080 00790I 1 2 X7 OE080 00800ITERMS NS 11 30 C OE080 00810I 1 30 F1 OE080 00820I NS 12 OE080 00830I 1 1 X8 OE080 00840OPAROUT D 01 OE080 0000850O A1 200 OE080 00860O A2 300 OE080 00870OSAOUT D 03 OE080 00880O B1 140 OE080 00890OAROUT D 05 OE080 00900O C1 200 OE080 00910O C2 280 OE080 0000920OSMNOUT D 07 OE080 00930O D1 30 OE080 00940OARAOUT D 09 OE080 00950O E1 30 OE080 00960OTRMOUT D 11 OE080 00970O F1 30 OE080 00980O$LP1 H 202 1P OE080 0000990O OR OF OE080 01000O U1 15 'PARTMST DELETES' OE080 01010O U2 14 'SLSMAN DELETES' OE080 01020O U3 12 'AREA DELETES' OE080 01030O U4 13 'TERMS DELETES' OE080 01040O U7 14 'SAMAST DELETES' OE080 01050O U8 14 'ARMAST DELETES' OE080 0001060O D 1 02 OE080 01070O OR 04 OE080 01080O OR 06 OE080 01090O OR 08 OE080 01100O OR 10 OE080 01110O OR 12 OE080 01120O U1X1 20 OE080 0001130O U7X2 20 OE080 01140O U8X3 6 OE080 01150O U2X4 3 OE080 01160O U3X7 2 OE080 01170O U4X8 1 OE080 ** 001180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00119000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001210ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001220/* 001230_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( ;TXOE081 PT999999032778(000010H S OE081 00020X DECK-ID A99 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE081 00030F* COPIES A TEMPORARY PURGED MASTER FILE TO THE MASTER FILE OE081 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE081 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE081 00060F* CONTROL DATA PROPRIETARY PRODUCT OE081 00070F* OE081 0000080FPAROUT IPEAF 300 DISK OE081 00090FPARTMST O F 300 20AI 271 DISK OE081 00100F********************************************************************OE081 00110F* OE081 00120F* COMPANY OE081 00130F* SYSTEM FILE MAINTENANCE OE081 00140F* PROGRAM COPIES BACK A PURGED MASTER FILE OE081 0000150F* OE081 00160F* CONTRACTOR COMPUSOURCE OE081 00170F* PROGRAMMER OE081 00180F* DATE OE081 00190F* OE081 00200F********************************************************************OE081 00210F* OE081 0000220F* OE081 00230F* ID F C H L FUNCTION OF INDICATORS OE081 00240F* OE081 00250F* 01 PAROUT OE081 00260F* OE081 00270F********************************************************************OE081 00280IPAROUT NS 01 OE081 0000290I 1 200 A OE081 00300I 201 300 B OE081 00310OPARTMST D 01 OE081 00320O A 200 OE081 00330O B 300 OE081 ** 000340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00035000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000380/* 000390_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(, ,}TXMR760 P999999111111(000010H S MR760 00020X DECK-ID M40 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR760 00030F* MATERIAL REQUIREMENTS REPORT MR760 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR760 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR760 00060F* CONTROL DATA PROPRIETARY PRODUCT MR760 00070F* MR760 0000080FPARTMST IPEAF 300 20AI 271 DISK MR760 00090FSEXPLD ISEAF 100 DISK MR760 00100FHEADING IT F 40 EDISK MR760 00110FORDACT O F 121 DISK MR760 00120F$LP1 O F 132 OF PRINTER U3 MR760 00130E HEADING HEAD 1 1 40 COMPANY NAME MR760 00140IPARTMST NS 01 MR760 0000150I 271 290 PARTNOL1M1 MR760 00160I 1 37 DESC MR760 00170I 38 39 UM MR760 00180I 40 40 CLS MR760 00190I 44 460LEAD MR760 00200I 47 490SSDAYS MR760 00210I 146 1520SOH MR760 0000220I 153 1590SOO MR760 00230I 181 1870MIN MR760 00235I 181 1870SVEMIN 10 00240I 188 1940LOTSIZ MR760 00250I 195 195 INVCOD MR760 00260I 203 2090AVGUSE MR760 00270ISEXPLD NS 03 1 CO 2 CJ MR760 0000280I OR 04 1 CR 2 CJ MR760 00290I OR 05 1 CS 2 CO MR760 00300I OR 06 1 CP 2 CR MR760 00310I OR 07 1 CP 2 CO MR760 00320I 61 80 PARTNOL1M1 MR760 00330I 15 19 REFNO MR760 00340I 20 21 REFLOT 12 MR760 0000350I 22 280EXPQTY MR760 00360I 29 340REQDTE MR760 00370I 35 400TRNDTE MR760 00380I 41 450CUSVEN MR760 00390I 81 100 PARENT MR760 00400I 53 53 RGCODE 15 MR760 00410I 54 600RGQTY MR760 0000420I NS 02 MR760 00430I 1 1 A MR760 00440C SETOF 8090 MR760 00450C 02 GOTO DEND MR760 00460C L1 SETOF 20 MR760 00470C L1 SETOF 659192 MR760 00480C L1 SETOF 959899 MR760 0000490C L1 Z-ADD0 RESERV 70 MR760 00500C L1 Z-ADD0 NEWSOO 70 MR760 00510C L1 Z-ADD0 AVAIL 70 MR760 00520C L1 Z-ADD0 TOTRG 70 MR760 00530C L1N01 Z-ADD0 SOH MR760 00540C 01 Z-ADDSOH AVAIL MR760 00550C 01 U1 Z-ADD0 MIN MR760 0000560C 01 U2 Z-ADD0 LOTSIZ MR760 00570C 01 SOH COMP MIN 90 SOH < MIN? MR760 00580C 01 90 Z-ADDUDATE ORDTE MR760 00590C 01 90 SETON 9192 MR760 00600C 01 SETON 99 PART# ON FILE MR760 00610C 01 INVCOD COMP 'X' 65 NO REQT GEN MR760 00620C 01N65 INVCOD COMP 'N' 65 NO REQT GEN MR760 0000630C 01 GOTO DEND MR760 00640C SETON 8095 MR760 00650C 03 MR760 00660COR 04 MR760 00670COR 07 GOTO ADDSOO MR760 00680C 05 MR760 00690COR 06 GOTO ADDRSV MR760 0000700C************************ MR760 00710C ADDSOO TAG MR760 00720C************************ MR760 00730C EXPQTY ADD NEWSOO NEWSOO MR760 00740C EXPQTY ADD AVAIL AVAIL MR760 00750C AVAIL COMP MIN 90 MR760 00760C 90N92 Z-ADDREQDTE ORDTE 60 MR760 0000770C 90 SETON 9192 MR760 00780C N90 SETOF 92 MR760 00790C GOTO DEND MR760 00800C************************ MR760 00810C ADDRSV TAG MR760 00820C************************ MR760 00830C AVAIL SUB EXPQTY AVAIL MR760 0000840C EXPQTY ADD RESERV RESERV MR760 00850C RGQTY ADD TOTRG TOTRG 20 MR760 00860C AVAIL COMP MIN 90 MR760 00870C 90N92 Z-ADDREQDTE ORDTE MR760 00880C 90 SETON 9192 MR760 00890C N90 SETOF 92 MR760 00900C************************ MR760 0000910C DEND TAG MR760 00920C************************ MR760 00930CL1 65 SETOF 92 MR760 00940CL1 92 EXSR ODATE MR760 00950CL1 99 NEWSOO COMP SOO 9898 MR760 00960C************************ MR760 00970CL1 L1END TAG MR760 0000980C************************ MR760 00990C********************************************************************MR760 01000C* SUBR ODATE CALCULATES REORDER DATE BY SUBTRACTING LEAD TIME MR760 01010C* FROM DUE DATE. MR760 01020C********************************************************************MR760 01030CSR ODATE BEGSR MR760 01040CSR MOVELORDTE DUEMO 20 MR760 0001050CSR MOVE ORDTE DUEYR 20 MR760 01060CSR MOVE ORDTE TEMP 40 MR760 01070CSR MOVELTEMP DUEDA 20 MR760 01080CSR DUEDA COMP 31 70 70 MR760 01090CSR 70 Z-ADD30 DUEDA ASSUME 30/MONTHMR760 01100CSR 70 LEAD SUB 1 LEADTM 30 MR760 01110CSRN70 Z-ADDLEAD LEADTM MR760 0001120CSR LEADTM DIV 30 T1 64 MR760 01130CSR MOVELT1 NMO 20 MR760 01140CSR MOVE T1 T2 44 MR760 01150CSR T2 MULT 30 NDAYS 20H MR760 01160CSR DUEDA SUB NDAYS NEWDA 20 7171 MR760 01170CSR 71 NMO ADD 1 NMO MR760 01180CSR 71 NEWDA ADD 30 NEWDA MR760 0001190CSR NMO DIV 12 T1 MR760 01200CSR MOVELT1 NYR 20 MR760 01210CSR MOVE T1 T2 MR760 01220CSR T2 MULT 12 NMONS 20H MR760 01230CSR DUEMO SUB NMONS NEWMO 20 7272 MR760 01240CSR 72 NYR ADD 1 NYR MR760 01250CSR 72 NEWMO ADD 12 NEWMO MR760 0001260CSR DUEYR SUB NYR NEWYR 20 MR760 01270CSR MOVELNEWMO ORDDAT 60 MR760 01280CSR MOVELNEWDA TEMP MR760 01290CSR MOVE NEWYR TEMP MR760 01300CSR MOVE TEMP ORDDAT MR760 01310CSR ENDSR MR760 01320C********************************************************************MR760 0001330C********************************************************************MR760 01340O$LP1 H 202 1P MR760 01350O OR OF MR760 01360O PAGE Z 8 MR760 01370O 4 'PAGE' MR760 01380O HEAD,1 86 MR760 01390O UDATE Y 132 MR760 0001400O H 2 1P MR760 01410O OR OF MR760 01420O 76 'MATERIAL REQUIREMENTS' MR760 01430O 132 'MFG760' MR760 01440O H 1 1P MR760 01450O OR OF MR760 01460O 80 'CUST/' MR760 0001470O H 1 1P MR760 01480O OR OF MR760 01485O 11 'PART NUMBER' 01490O 44 'M I' MR760 01500O 80 'TRAN VEND/' MR760 01510O 105 'REQUIRED' MR760 01520O 126 'AVAIL' MR760 0001530O H 2 1P MR760 01540O OR OF MR760 01560O 12 'DESCRIPTION' MR760 01570O 40 'UM' MR760 01580O 44 'P C' MR760 01590O 56 'TRANSACTION' MR760 01600O 65 'REF NBR' MR760 0001610O 72 'DATE' MR760 01620O 81 'PARENT' MR760 01630O 103 'DATE' MR760 01640O 116 'QUANTITY' MR760 01650O 127 'BALANCE' MR760 01660O D 11 L1 MR760 01670O PARTNO 20 MR760 0001675O D 1 L1 01680O 01 DESC 37 MR760 01690O N01 22 '** NO MASTER RECORD **' MR760 01700O 01 UM 40 MR760 01710O 01 CLS 42 MR760 01720O 01 INVCOD 44 MR760 01730O 52 'BEG BAL' MR760 0001740O SOH J 117 MR760 01750O SOH J 128 MR760 01760O 90 132 '**' MR760 01770O D 1 80 MR760 01780O 15 RGQTY M 35 MR760 01790O 15 44 'REQT GEN' MR760 01800O 03 56 'OPEN JOB ' MR760 0001810O 04 56 'REL JOB ' MR760 01820O 05 56 'SALES ORDER' MR760 01830O 06 56 'PLND REQT ' MR760 01840O 07 56 'OPEN P.O. ' MR760 01850O REFNO 62 MR760 01860O N12 63 '-' MR760 01870O N12 REFLOT 65 MR760 0001880O TRNDTEY 74 MR760 01890O N06 CUSVENZ 80 MR760 01900O 06 PARENT 95 MR760 01910O REQDTEY 105 MR760 01920O EXPQTYJ 117 MR760 01930O AVAIL J 128 MR760 01940O 90 132 '**' MR760 0001950O T 1 L1 95 MR760 01960O OR L1N95 91 MR760 01970O 20 TOTRG M 35 MR760 01980O 20 44 'TOTAL RG' MR760 01990O 52 'END BAL' MR760 02000O 91 10 88 '(MIN= )' MR760 02010O 91 10 SVEMIN3 87 MR760 0002020O 92 117 '** ACTION **' MR760 02030O AVAIL J 128 MR760 02040O 98 130 'OB' MR760 02050O 90 132 '**' MR760 02060O T 2 LR MR760 02070O 11 'END OF JOB.' MR760 02080OORDACT T L1 92 MR760 0002090O PARTNO 121 MR760 02100O 99 DESC 37 MR760 02110O N99 24 '** NOT ON PART MASTER **' MR760 02120O 99 UM 39 MR760 02130O 99 CLS 40 MR760 02140O SOH 47 MR760 02150O NEWSOO 54 MR760 0002160O RESERV 61 MR760 02170O 99 SVEMIN 68 MR760 02180O 99 LOTSIZ 75 MR760 02190O ORDTE 81 MR760 02200O ORDDAT 87 MR760 02210O 99 AVGUSE 94 MR760 02220O 99 LEAD 97 MR760 0002230O 99 SSDAYS 100 MR760 02240O 98 101 '*' MR760 ** 002250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00229000/* 002300_ 00 00 00 00 00 00 00 00 00 __ 0( XTXOE120 P999999032778(000010H S OE120 00020X DECK-ID A60 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE120 00030F* PRINT ORDER ENTRY AUDIT OE120 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE120 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE120 00060F* CONTROL DATA PROPRIETARY PRODUCT OE120 00070F* OE120 0000080FSOTEMP IPEAF 9 7AI 1 DISK OE120 00090F$LP1 O F 132 OF PRINTER OE120 00100FHEADING IT F 40 EDISK OE120 00110F* OE120 00120F********************************************************************OE120 00130F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [ORD030] OE120 00140F* OE120 0000150F* PACKAGE DISTRIBUTION OE120 00160F* SYSTEM SALES ORDER PROCESSING OE120 00170F* PROGRAM PRINT ORDER ENTRY AUDIT OE120 00180F* OE120 00190F* CONTRACTOR COMPUSOURCE OE120 00200F* PROGRAMMER KATH HILL OE120 00210F* DATE FEBRUARY 22, 1976 OE120 0000220F* OE120 00230F********************************************************************OE120 00240F* OE120 00250E HEADING HEAD 1 1 40 OE120 00260ISOTEMP XX 01 OE120 00270I 1 50SO OE120 00280I 8 8 CODE 11 OE120 0000290I 9 9 TYPE OE120 00300C N01 GOTO END OE120 00310C 99 GOTO START OE120 00320C Z-ADDSO SAVE 50 1ST CYCLE ONLY OE120 00330C SETON 9899 OE120 00340C GOTO SKIP OE120 00350C* OE120 0000360C START TAG OE120 00370C SETOF 98 OE120 00380C SAVE ADD 1 SAVE OE120 00390C SAVE COMP SO 2020 OE120 00400C 20 Z-ADDSAVE FROM 50 OE120 00410C 20 SO SUB 1 TO 50 OE120 00420C 20 SO SUB FROM DIFF 50 OE120 0000430C 20 MISS ADD DIFF MISS 60 OE120 00440C Z-ADDSO SAVE OE120 00450C* OE120 00460C SKIP TAG OE120 00470C TYPE COMP ' ' 31 OE120 00480C TYPE COMP 'C' 32 OE120 00490C TYPE COMP 'E' 33 OE120 0000500C TYPE COMP 'M' 34 OE120 00510C SOS ADD 1 SOS 60 OE120 00520C N11 ERRORS ADD 1 ERRORS 60 OE120 00530C END TAG OE120 00540O$LP1 H 02 1P OE120 00550O OR OF OE120 00560O 4 'PAGE' OE120 0000570O PAGE Z 8 OE120 00580O HEAD,1 86 OE120 00590O UDATE Y 85 OE120 00600O H 2 1P OE120 00610O OR OF OE120 00620O 51 'ORDER ENTRY SUMMARY' OE120 00630O 85 'DIS120' OE120 0000640O H 2 1P OE120 00650O OR OF OE120 00660O 5 'SALES' OE120 00670O H 11 1P OE120 00680O OR OF OE120 00690O 7 'ORDER #' OE120 00700O 14 'TYPE' OE120 0000710O 25 'COMMENTS' OE120 00720O D 1 01 20 OE120 00730O 31 'SALES ORDERS #' OE120 00740O FROM 37 OE120 00750O 39 '-' OE120 00760O TO 45 OE120 00770O 53 'MISSING' OE120 0000780O D 1 01 OE120 00790O SO 7 OE120 00800O 31 13 'SO' OE120 00810O 32 13 'CM' OE120 00820O 33 13 'DB' OE120 00830O 34 13 'MI' OE120 00840O N11 28 'BATCH ERROR' OE120 0000850O 98 56 'THIS SHOULD BE TODAY''S' OE120 00860O 98 72 'STARTING S.O. #' OE120 00870O T 3 LR OE120 00880O 11 'END OF JOB.' OE120 00890O 23 'THERE WERE' OE120 00900O SOS 1 31 OE120 00910O 44 'VALID ORDERS' OE120 0000920O 53 'OF WHICH' OE120 00930O ERRORS1 61 OE120 00940O 79 'HAD BATCH ERRORS.' OE120 00950O T 1 LR OE120 00960O 23 'THERE WERE' OE120 00970O MISS 1 31 OE120 00980O 47 'MISSING ORDERS.' OE120 00** 000990ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001010ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001020ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001030/* 001040_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(@ @TXOE160 P 999999032778(000010H S OE160 00020X DECK-ID A62 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE160 00030F* PRINT TODAYS ORDERS OE160 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE160 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE160 00060F* CONTROL DATA PROPRIETARY PRODUCT OE160 00070F* OE160 0000080FTODAYS IPEAF 119 DISK OE160 00090FARMAST IC F 280R 6AI 1 DISK OE160 00100FPARTMST IC F 300R20AI 271 DISK OE160 00110FHEADING IT F 40 EDISK OE160 00120F$LP1 O F 132 OF PRINTER OE160 00130F* OE160 00140F********************************************************************OE160 0000150F* OE160 00160F* PACKAGE DISTRIBUTION OE160 00170F* SYSTEM SALES ORDER PROCESSING OE160 00180F* PROGRAM PRINT TODAY'S ORDERS OE160 00190F* OE160 00200F* OE160 00210F********************************************************************OE160 0000220F* OE160 00230F* ************************************************************** OE160 00240F* ** ** OE160 00250F* ** FUNCTION OF INDICATORS ** OE160 00260F* ** ** OE160 00270F* ** 01 SNEWORD- HEADER ** OE160 00280F* ** 03 SNEWORD- LINE ITEM ** OE160 0000290F* ** 05 SNEWORD- ALL OTHER RECORDS ** OE160 00300F* ** ** OE160 00310F* ** 07 ARMAST ** OE160 00320F* ** ** OE160 00330F* ** 09 PARTMST ** OE160 00340F* ** ** OE160 00350F* ** 11 DASH# PART OF S.O.# IS ZERO - THIS IS NOT A ** OE160 0000360F* ** BACKORDER ** OE160 00370F* ** 12 NO OVERRIDE PRICE CODE ON HEADER ** OE160 00380F* ** 13 NO OVERRIDE PRICE FOR THIS LINE-ITEM ** OE160 00390F* ** 14 NO CREDIT LIMIT FOR THIS CUSTOMER ** OE160 00400F* ** ** OE160 00410F* ** 20 THIS ORDER IS A BACKORDER ** OE160 00420F* ** ** OE160 0000430F* ** 25 THIS CUST HAD NO CREDIT LIMIT ** OE160 00440F* ** ** OE160 00450F* ** 30 DELETED RECORD - ARMAST ** OE160 00460F* ** 31 DELETED RECORD - PARTMST ** OE160 00470F* ** ** OE160 00480F* ** 41 NO OVERRIDE PRICE - USE PRICE 1 FROM PARTMST ** OE160 00490F* ** 42 NO OVERRIDE PRICE - USE PRICE 2 FROM PARTMST ** OE160 0000500F* ** 43 NO OVERRIDE PRICE - USE PRICE 3 FROM PARTMST ** OE160 00510F* ** 44 NO OVERRIDE PRICE - USE PRICE 4 FROM PARTMST ** OE160 00520F* ** 45 NO OVERRIDE PRICE - USE PRICE 5 FROM PARTMST ** OE160 00530F* ** ** OE160 00540F* ** 90 CUSTOMER OVER CREDIT LIMIT - FLAG ** OE160 00550F* ** ** OE160 00560F* ************************************************************** OE160 0000570F* OE160 00580E HEADING HEAD 1 1 40 COMPANY NAME OE160 00590ITODAYS XX 01 8 CH OE160 00600I 3 70SONUM L1 OE160 00610I 9 130CUST OE160 00620I 20 31 PO OE160 00630I 43 430OVPC 12 OE160 0000640I 50 550PDATE OE160 00650I 105 105 STATUS 11 OE160 00660I XX 03 8 CL 11 CL OE160 00670I 3 70SONUM L1 OE160 00680I 65 84 PART OE160 00690I 24 300QTYORD OE160 00700I 52 583OVPRCE 13 OE160 0000710I XX 05 OE160 00720I 3 70SONUM L1 OE160 00730IARMAST XX 07 OE160 00740I 7 30 NAME OE160 00750I 109 1140CREDIT 14 OE160 00760I 115 115 DLTAR 30 OE160 00770I 161 1610PC OE160 0000780I 164 1722ARBAL OE160 00790IPARTMST XX 09 OE160 00800I 74 74 DLTPA 31 OE160 00810I 226 2323PRICE1 OE160 00820I 233 2393PRICE2 OE160 00830I 240 2463PRICE3 OE160 00840I 247 2533PRICE4 OE160 0000850I 254 2603PRICE5 OE160 00860C L1 SETOF 202590 OE160 00870C L1 Z-ADD0 ORDTOT 92 OE160 00880C L1N01 SETON H1 NO HEADER OE160 00890C H1 GOTO END OE160 00900C 01NL1 SETON H2 DUP HEADERS OE160 00910C H2 GOTO END OE160 0000920C 01 EXSR SUB1 HEADER OE160 00930C 03 EXSR SUB3 LINE-ITEM OE160 00940C END TAG OE160 00941C H5 SETOF H5 00950CL1 SOTOT ADD ORDTOT SOTOT 102 OE160 00960CL1 20 BOTOT ADD ORDTOT BOTOT 102 OE160 00970CL1 ORDTOT ADD ARBAL TOTAL 92 OE160 0000980CL1N25 TOTAL COMP CREDIT 90 OVER LIMIT OE160 00990C* OE160 01000C* ************************************************************** OE160 01010C* ** ** OE160 01020C* ** SUBR SUB1 PROCESSES THE HEADER RECORDS ** OE160 01030C* ** ** OE160 01040C* ************************************************************** OE160 0001050C* OE160 01060CSR SUB1 BEGSR OE160 01070CSR Z-ADDCUST CUST6 60 OE160 01080CSR CUST6 CHAINARMAST H3 NO HIT OE160 01090CSRNH3N30 SETON H3 OE160 01100CSR H3 GOTO END1 OE160 01110CSRN11 SETON 20 THIS IS A B.O. OE160 0001120CSR 12 Z-ADDPC CODE 10 SOLDTO BASIS OE160 01130CSRN12 Z-ADDOVPC CODE OVRIDE BASIS OE160 01140CSR 14 SETON 25 NO CRED LIMIT OE160 01150CSR SOS ADD 1 SOS 50 # OF S.O.'S OE160 01160CSRN11 BOS ADD 1 BOS 50 # OF BOR'S OE160 01170CSR END1 ENDSR OE160 01180C* OE160 0001190C* ************************************************************** OE160 01200C* ** ** OE160 01210C* ** SUBR SUB3 PROCESSES THE LINE ITEM RECORDS ** OE160 01220C* ** ** OE160 01230C* ************************************************************** OE160 01240C* OE160 01250CSR SUB3 BEGSR OE160 0001260CSR Z-ADD0 PRICE 73 PRCE DEFAULT=0 OE160 01270CSRN13 Z-ADDOVPRCE PRICE OVERRIDE PRICE OE160 01280CSRN13 GOTO SKIP3 OE160 01290CSR PART CHAINPARTMST H5 GET PRICES OE160 01300CSRNH5N31 SETON H5 OE160 01310CSR H5 GOTO END3 NO HIT OE160 01320CSR CODE COMP 1 41PRICE BASIS 1 OE160 0001330CSR CODE COMP 2 42PRICE BASIS 2 OE160 01340CSR CODE COMP 3 43PRICE BASIS 3 OE160 01350CSR CODE COMP 4 44PRICE BASIS 4 OE160 01360CSR CODE COMP 5 45PRICE BASIS 5 OE160 01370CSR 41 Z-ADDPRICE1 PRICE OE160 01380CSR 42 Z-ADDPRICE2 PRICE OE160 01390CSR 43 Z-ADDPRICE3 PRICE OE160 0001400CSR 44 Z-ADDPRICE4 PRICE OE160 01410CSR 45 Z-ADDPRICE5 PRICE OE160 01420CSR SKIP3 TAG OE160 01430CSR QTYORD MULT PRICE EXTAMT 92H OE160 01440CSR ORDTOT ADD EXTAMT ORDTOT OE160 01450CSR END3 ENDSR OE160 01460C** OE160 0001470C** OE160 01480O$LP1 H 202 1P OE160 01490O OR OF OE160 01500O PAGE Z 8 OE160 01510O 4 'PAGE' OE160 01520O HEAD,1 86 OE160 01530O UDATE Y 132 OE160 0001540O H 2 1P OE160 01550O OR OF OE160 01560O 69 'DAILY SALES ORDER' OE160 01570O 78 'REGISTER' OE160 01580O 132 'DIS160' OE160 01590O H 1 1P OE160 01600O OR OF OE160 0001610O 5 'SALES' OE160 01620O 69 'DELIVERY' OE160 01630O 81 'EXTENDED' OE160 01640O 96 'CURRENT' OE160 01650O 108 'CREDIT' OE160 01660O H 2 1P OE160 01670O OR OF OE160 0001680O 7 'ORDER #' OE160 01690O 16 'CUST #' OE160 01700O 31 'CUSTOMER NAME' OE160 01710O 59 'CUSTOMER P.O. #' OE160 01720O 67 'DATE' OE160 01730O 83 'ORDER AMOUNT' OE160 01740O 98 'A/R BALANCE' OE160 0001750O 108 'LIMIT' OE160 01760O 114 'FLAG' OE160 01770O T 1 L1 OE160 01780O SONUM 8 OE160 01790O CUST 16 OE160 01800O NAME 42 OE160 01810O PO 56 OE160 0001820O PDATE Y 69 OE160 01830O ORDTOTJ 84 OE160 01840O ARBAL J 99 OE160 01850O N25 CREDITK 108 OE160 01860O 25 108 '*NONE*' OE160 01870O 90 114 '****' OE160 01880O T 1 LR OE160 0001890O 83 '------------' OE160 01900O T 2 LR OE160 01910O SOTOT J 84 OE160 01920O 96 'TOTAL VALUE' OE160 01930O T 2 LR OE160 01940O BOTOT J 84 OE160 01950O 95 'BACKORDERS' OE160 0001960O T 1 LR OE160 01970O 11 'END OF JOB.' OE160 01980O 23 'THERE WERE' OE160 01990O SOS 3 29 OE160 02000O 51 'ORDERS TODAY OF WHICH' OE160 02010O BOS 3 57 OE160 02020O 74 'WERE BACKORDERS.' OE160 00** 002030ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002040ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002050ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002060ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002070/* 002080_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( \TXOE210 PV999999032778(000010H S OE210 00020X DECK-ID A64 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE210 00030F* PRINT BACKLOG BY PART NUMBER OE210 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE210 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE210 00060F* CONTROL DATA PROPRIETARY PRODUCT OE210 00070F* OE210 0000080FBKLOG IPEAF 143 DISK OE210 00090FHEADING IT F 40 EDISK OE210 00100F$LP1 O F 132 OF PRINTER OE210 00110F********************************************************************OE210 00120F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [ORD220] OE210 00130F* OE210 00140F* PACKAGE DISTRIBUTION OE210 0000150F* SYSTEM SALES ORDER PROCESSING OE210 00160F* PROGRAM PRINT BACKLOG BY PART # OE210 00170F* OE210 00180F* CONTRACTOR COMPUSOURCE OE210 00190F* PROGRAMMER KATH HILL OE210 00200F* DATE FEBRUARY 25, 1976 OE210 00210F* OE210 0000220F********************************************************************OE210 00230F* OE210 00240F* NARRATIVE: PROCESSED BKLOG BY PART #. OE210 00250F* OE210 00260F********************************************************************OE210 00270F* OE210 00280F* ID F C H L FUNCTION OF INDICATORS OE210 0000290F* OE210 00300F* 01 BKLOG OE210 00310F* OE210 00320F* L1PART #/BKLOG OE210 00330F* OE210 00340F********************************************************************OE210 00350E HEADING HEAD 1 1 40 COMPANY NAME OE210 0000360IBKLOG NS 01 OE210 00370I 124 143 PART L1 OE210 00380I 13 190MSO1 OE210 00390I 20 240CUST OE210 00400I 25 36 CPONUM OE210 00410I 37 420DUEDAT OE210 00420I 43 490ORDQTY OE210 0000430I 50 563UNITPR OE210 00440I 57 620ORDDAT OE210 00450I 63 86 CNAME OE210 00460I 87 123 DESCRP OE210 00470C* OE210 00480C ORDQTY MULT UNITPR EXTVAL 92H OE210 00490C TOTQTY ADD ORDQTY TOTQTY 70 OE210 0000500C TOTVAL ADD EXTVAL TOTVAL 92 OE210 00510C TOTAL ADD EXTVAL TOTAL 92 OE210 00520C* OE210 00530O$LP1 H 202 1P OE210 00540O OR OF OE210 00550O PAGE Z 10 OE210 00560O 4 'PAGE' OE210 0000570O HEAD,1 85 OE210 00580O UDATE Y 132 OE210 00590O H 2 1P OE210 00600O OR OF OE210 00610O 64 'BACKLOG REPORT' OE210 00611O 79 'BY PART NUMBER' 00620O 132 'DIS210' OE210 0000630O H 1 1P OE210 00640O OR OF OE210 00650O 44 'SALES' OE210 00660O 109 'ORDER DELIVERY' OE210 00670O 118 'ORDER' OE210 00680O 132 'EXTENDED' OE210 00681O H 1 1P 0000682O OR OF 00683O 11 'PART NUMBER' 00690O H 2 1P OE210 00700O OR OF OE210 00720O 12 'DESCRIPTION' OE210 00730O 53 'ORDER # CUST#' OE210 00740O 67 'CUSTOMER NAME' OE210 0000750O 90 'CUST P.O. #' OE210 00760O 98 'DATE' OE210 00770O 107 'DATE' OE210 00780O 119 'QUANTITY' OE210 00790O 131 'VALUE' OE210 00791O D 1 01 00792O L1 PART 20 0000793O OF PART 20 00800O D 1 01 OE210 00830O L1 DESCRP 38 OE210 00840O OF DESCRP 38 OE210 00850O MSO1 47 OE210 00860O CUST 53 OE210 00870O CNAME 78 OE210 0000880O CPONUM 91 OE210 00890O ORDDATY 100 OE210 00900O DUEDATY 109 OE210 00910O ORDQTYJ 120 OE210 00920O EXTVAL1 132 OE210 00930O T 1 L1 OE210 00940O 119 '---------' OE210 0000950O 132 '------------' OE210 00960O T 2 L1 OE210 00970O PART 102 OE210 00980O 109 'TOTALS' OE210 00990O TOTQTYJB 120 OE210 01000O TOTVAL1B 132 OE210 01010O T 31 LR OE210 0001020O 11 'END OF JOB.' OE210 01030O 35 'TOTAL VALUE OF BACKLOG' OE210 01040O 40 'IS $' OE210 01050O TOTAL J 52 OE210 ** 001060ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001070ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00108000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001090ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001100/* 001110_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(,U ,}TXOE200 P999999032778(000010H S OE200 00020X DECK-ID A63 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE200 00030F* CREATE BKLOGT FILE OE200 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE200 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE200 00060F* CONTROL DATA PROPRIETARY PRODUCT OE200 00070F* OE200 0000080FOPNORDS IPEAF 119 8AI 106 DISK OE200 00090FARMAST IC F 280R 6AI 1 DISK OE200 00100FPARTMST IC F 300R20AI 271 DISK OE200 00110FBKLOGT O F 143 DISK OE200 00120F********************************************************************OE200 00130F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [ORD200] OE200 00140F* OE200 0000150F* PACKAGE DISTRIBUTION OE200 00160F* SYSTEM SALES ORDER PROCESSING OE200 00170F* PROGRAM CREATE BKLOGT FROM OPNORDS OE200 00180F* OE200 00190F* CONTRACTOR COMPUSOURCE OE200 00200F* PROGRAMMER KATH HILL OE200 00210F* DATE FEBRUARY 22, 1976 OE200 0000220F* OE200 00230F********************************************************************OE200 00240F* OE200 00250F* NARRATIVE: IT CREATES A RECORD IN BKLOGT FOR EACH 'LL' RECORD OE200 00260F* IN OPNORDS. OE200 00270F* OE200 00280F********************************************************************OE200 0000290F* ID F C H L FUNCTION OF INDICATORS OE200 00300F* OE200 00310F* 01 OPNORDS (H) OE200 00320F* 03 (LL) OE200 00330F* 04 (ALL OTHERS) OE200 00340F* 05 ARMAST OE200 00350F* 06 PARTMST OE200 0000360F* OE200 00370F* N15 DELETE (ARMAST) OE200 00380F* N16 DELETE (PARTMST) OE200 00390F* 20 UNITPRICEOVERRIDE = 0 (LL) OE200 00400F* 21 PRICECODEOVERRIDE = 0 (H) OE200 00410F* OE200 00420F* 30 CHAIN 'MISS' (ARMAST) OE200 0000430F* 40 CHAIN 'MISS' (PARTMST) OE200 00440F* N50 BAD PRICE CODE ON FILE - DEFAULT TO PRICE = 0 OE200 00450F* OE200 00460F********************************************************************OE200 00470E PRCD 5 7 3 PRICE ARRAY OE200 00480IOPNORDS NS 01 8 CH OE200 00490I 9 130CUSTNO OE200 0000500I 14 190ORDATE OE200 00510I 20 31 CPONUM OE200 00520I 43 430PRCDOV 21 OE200 00530I 50 550PRODAT OE200 00540I 105 105 STATUS 60 OE200 00550I NS 03 8 CL 11 CL OE200 00560I 1 70MSOLL OE200 0000570I 65 84 PART OE200 00580I 24 300QTYORD OE200 00590I 52 583UNPROV 20 OE200 00600I NS 04 OE200 00610I 1 105 IMAGE OE200 00620IARMAST NS 05 OE200 00630I 7 30 NAME OE200 0000640I 115 115 DLTAR 15 OE200 00650I 161 1610PRCODE OE200 00660IPARTMST NS 06 OE200 00670I 271 290 PARTNO OE200 00680I 1 37 DESCR OE200 00690I 74 74 DLTPR 16 OE200 00700I 226 260 PRCD OE200 0000710C* OE200 00720C N01 GOTO TRY3 OE200 00730C N60 STATUS COMP 'P' 60 OE200 00740C N60 STATUS COMP 'B' 60 OE200 00750C N60 GOTO FINI OE200 00760C* OE200 00770C Z-ADDCUSTNO KEY 60 OE200 0000780C KEY CHAINARMAST 30 30 = MISS OE200 00790C N30N15 SETON 30 30 = HIT CODED OE200 00800C* TO DELETE OE200 00810C N21N30 Z-ADDPRCDOV I 10 OVERRIDE BASIS OE200 00820C 21N30 Z-ADDPRCODE I PRICE CODE OE200 00830C 30 Z-ADD0 I INVALID CUST # OE200 00840C* OE200 0000850C TRY3 TAG OE200 00860C N03 GOTO FINI OE200 00870C* OE200 00880C PART CHAINPARTMST 40 40 = MISS OE200 00890C N40N16 SETON 40 40 = HIT CODED OE200 00900C* TO DELETE OE200 00910C 30 INVALID CUST # OE200 0000920COR 40 Z-ADD0 UNITPR 73 INVALID PART # OE200 00930C* OE200 00940C 30 INVALID CUST # OE200 00950COR 40 GOTO FINI INVALID PART # OE200 00960C* OE200 00970C N20 Z-ADDUNPROV UNITPR OVERRIDE PRICE OE200 00980C 20 I COMP 1 50 50BASIS = 1 TO 5?OE200 0000990C 20 50 I COMP 5 5050 OE200 01000C 20 50 Z-ADDPRCD,I UNITPR YES --> PRICE OE200 01010C 20N50 Z-ADD0 UNITPR NO --> 0 OE200 01020C* OE200 01030C FINI TAG OE200 01040C* OE200 01050OBKLOGT D 03 60 OE200 0001060O PART 143 OE200 01070O MSOLL 19 OE200 01080O CUSTNO 24 OE200 01090O CPONUM 36 OE200 01100O PRODAT 42 OE200 01110O QTYORD 49 OE200 01120O UNITPR 56 OE200 0001130O ORDATE 62 OE200 01140O N30 NAME 86 OE200 01150O 30 82 '** INVALID CUST # **' OE200 01160O N40 DESCR 123 OE200 01170O 40 106 '** INVALID PART # **' OE200 ** 001180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00119000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001210ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001220/* 001230_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d d*TXBM135 P|999999111111(000010H S BM135 00020X DECK-ID M22 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM135 00030F* BLANKS ENCOUNTER CODE AND UPDATES NEXT CODE IN BOMSTR BM135 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM135 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM135 00060F* CONTROL DATA PROPRIETARY PRODUCT BM135 00070F* BM135 0000080FBOMSTR UC F 74R DISK BM135 00090FBM5DUM IPEAF 80 DISK BM135 00100IBOMSTR NS 01 BM135 00110I 1 20 PN 10 BM135 00120IBM5DUM NS 02 BM135 00130I 1 1 A BM135 00132C MOVE 'ZZZZZZZZ'TEST 16 0000134C MOVEL'ZZZZZZZZ'TEST 00136C MOVELTEST TEST1 20 00138C MOVE 'ZZZZ' TEST1 00140C SETON LR BM135 00150CLR LOOP TAG BM135 00160CLR RRN ADD 1 RRN 50 BM135 00170CLR RRN CHAINBOMSTR 20 BM135 0000180CLR N20 MOVE PN SPN 20 BM135 00190CLR N20 SETON 90 BM135 00200CLR 90 EXCPT BM135 00210CLR SETOF 90 BM135 00220CLR PN COMP LPN 2525 BM135 00230CLR LRRN COMP 0 26 BM135 00240CLR 25N26LRRN CHAINBOMSTR 21 BM135 0000250CLRN21 25N26 SETON 91 BM135 00260CLR 91 EXCPT BM135 00270CLR SETOF 91 BM135 00272CLR PN COMP TEST1 10 00274CLR 10 GOTO END 00290CLR MOVE RRN LRRN 50 BM135 00300CLR MOVE SPN LPN 20 BM135 0000310CLR GOTO LOOP BM135 00320CLR END TAG BM135 00330OBOMSTR E 90 BM135 00340O 52 ' ' BM135 00350O 53 ' ' BM135 00360O E 91 BM135 00370O 52 '1' BM135 00** 000380ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000390ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000400ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000410ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000420/* 000430_ 00 00 00 00 00 00 00 00 __ 0(<] </TXOE310 P1t999999032778(000010H S OE310 00020X DECK-ID A66 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE310 00030F* SALES ORDER INQUIRY/MAINTENANCE OE310 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE310 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE310 00060F* CONTROL DATA PROPRIETARY PRODUCT OE310 00070F* OE310 0000080FDUMMY IPEAF 72 DISK OE310 00090FDISPR2 IC F 32R DISK OE310 00100FARMAST IC F 280R 6AI 1 DISK OE310 00110FPARTMST UC F 300R20AI 271 DISK OE310 00120FOPNORDS UC F 119R 8AI 106 DISK OE310 00130FSLSMAN IC F 30R 3AI 1 DISK OE310 00140FAREA IC F 30R 2AI 1 DISK OE310 0000150FTERMS IC F 30R 1AI 1 DISK OE310 00160F********************************************************************OE310 00170F* PACKAGE-DISTRIBUTION CONTRACTOR-COMPUSOURCE OE310 00180F* OE310 00190F* SYSTEM-INVOICING BY-GAIL KARON/ROBBIE FREEMAN OE310 00200F* OE310 00210F* PROGRAM-SHIPPER CONFIRMATION DATE- 8/27/76 OE310 0000220F********************************************************************OE310 00230F* DIS310 IS SALES ORDER INQUIRY/MAINT PROGRAM. OE310 00240F********************************************************************OE310 00250F* FUNCTION OF INDICATORS OE310 00260F* OE310 00270F* 01 RECORD FROM DUMMY--NO RECORDS EXIST IN THIS FILE OE310 00280F* 02 ORDPR2 RECORD--PARAMETER FILE RECORDS OE310 0000290F* 03 RECORD FROM ARMAST--CHAIN TO IT OE310 00300F* 04 RECORD FROM ORDRRN--CHAIN TO IT OE310 00310F* 05 RECORD FROM PARTMST--CHAIN TO IT OE310 00320F* 06 RECORD FROM ROPNORD OE310 00330F* 08 RECORD FROM SLSMAN OE310 00340F* 09 RECORD FROM AREA OE310 00350F* 10 RECORD FROM TERMS OE310 0000360F* 30 OUTFLD SUBROUTINE-LEN = 0, IT'S A MESSAGE OE310 00370F* UPDATE SUBROUTINE--N73=TRY ANOTHER X OE310 00380F* -- 73=BEGIN AT X=7 AGAIN OE310 00390F* ACCEPT SUBROUTINE-IS X OUT OF SECTN SIZE RANGE OE310 00400F* -@ SIGN--LEAVE SUBROUTINE OE310 00410F* 31 OUTPUT SUBROUTINE--COMP NOFLDS TO CONTINUE LOOP OE310 00420F* OUTFLD SUBROUTINE--COMP CONSTANT LENGTH(FL) TO OE310 0000430F* END POS OF FIELD(FC)--LEN IS NEGATIVE IMPLIES OE310 00440F* THE FIELD IS NUMERIC OE310 00450F* UPDATE SUBROUTINE--RUBOUT AT FIRST CHARACTER OF OE310 00460F* FIELD IS NOT AT FIRST UPDATE ON SCREEN-CONTINUE OE310 00470F* THE LOOP OE310 00480F* ACCEPT SUBROUTINE--RCODE IS 'R'--RUBOUT OE310 00490F* OE310 0000500F* 32 BODY OF PROGRAM--RUBOUT AT FIRST UPDATE FIELD-GO OE310 00510F* TO PRIOR SCREEN OE310 00520F* GETSEC SUBROUTINE--X GREATER THAN SECTN SIZE OE310 00530F* UPDATE SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE310 00540F* ACCEPT SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE310 00550F* 33 UPDATE & ACCEPT SUBROUTINE--LINE FEED THROUGH FIELD OE310 00560F* 34 ACCEPT SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE310 0000570F* 35 UPDATE SUBROUTINE--@ AT BEGINNING OF FIELD OE310 00580F* 37 LNGTH SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE310 00590F* 40 END-OF-JOB CONDITION OE310 00600F* 41 GETSEC SUBROUTINE--FIELDN & CURPOS BLANK OE310 00610F* MEANS END OF THAT SECTION IN PARAMETER FILE OE310 00620F* 42 MODE IS BLANK, D, A, OR I -- EXCPT OUTPUT STATUS OE310 00630F* 43 MODE IS B FOR BACKORDER -- EXCPT OUTPUT STATUS OE310 0000640F* 45 MODE IS D OE310 00650F* 50 RRN CHAIN TO PARAMETER FILE--NO MORE RECORDS OE310 00660F* 58 USED IN GET2 FOR LINE ITEM TYPE OE310 00670F* 59 USED IN GET2, POSLIN, & EDIT SUBROUTINES OE310 00680F* USED FOR COMPARISIONS TO CONTINUE LOOPS, ETC. OE310 00690F* 60 SUBR E412 - PART# - DO SUBR PUTPRC TO STORE PRICE OE310 00700F* 61 FIRSTP SUBROUTINE OE310 0000710F* 62 FIRSTP SUBROUTINE OE310 00720F* 65 SUBR UPDATE - DON'T UPDATE RECORD (DON'T DO 'PUT') OE310 00730F* FOR OVERRIDE PRICE IF RESPONSE WAS LF OR ZERO. OE310 00740F* 66 'WHAT LINE ?' = T --GO TO CONTROL SCREEN OE310 00750F* 67 'WHAT LINE ?' = @ OR R OE310 00760F* DO ANOTHER LINE ITEM SCREEN--GO FORWARD OR BACK OE310 00770F* 68 'WHAT LINE ?' EDIT OE310 0000780F* DON'T ALTER LOWER & UPPER BOUND OE310 00790F* 70 SECTN = 1 HEADER OE310 00800F* 71 SECTN = 2 SHIP-TO CUST OE310 00810F* 72 SECTN = 3 MARK FOR COMMENTS OE310 00820F* 74 SECTN = 4 LINE ITEM UPDATE--PRICE OVERRIDE OE310 00830F* 75 SECTN = 5 LINE ITEM BACKORDER SITUATION OE310 00840F* 76 SECTN = 4 OR 5 EITHER LINE ITEM SCREEN OE310 0000850F* 77 SECTN = 6 OR 5 FREIGHT/SPECIAL CHARGES OE310 00860F* 80 EXCEPTION OUTPUT OF RANDOM RECORD OE310 00870F* 81 DISPLAY FIELD FROM RECORD--DON'T ALLOW UPDATE OE310 00880F* 83 XTYPE SUBROUTINE--SECTN 4 & 5, X=11 WHAT LINE ? OE310 00890F* 84 XTYPE SUBROUTINE--SECTN 4 & 5 X=12 PRODUCT # OE310 00900F* 85 XTYPE SUBROUTINE--SECTN 4 X=13 SHIP-TO-DATE OE310 00910F* XTYPE SUBROUTINE--SECTN 5 X=13 ORDERED OE310 0000920F* 86 XTYPE SUBROUTINE--SECTN 4 X=14 ON ORDER OE310 00930F* XTYPE SUBROUTINE--SECTN 5 X=14 SHIP OE310 00940F* 87 XTYPE SUBROUTINE--SECTN 4 X=15 PRICE OVERRIDE OE310 00950F* XTYPE SUBROUTINE--SECTN 5 X=15 BACKORDER OE310 00960F* 88 XTYPE SUBROUTINE--SECTN 4 & 5 X=16 LINE COMMENT OE310 00970F* 89 'WHAT LINE ?' EDIT IS VALID--INCREMENT X VALUE OE310 00980F* 90 EXCPT OUTPUT TO LINES OE310 0000990F* 95 EDIT SUBROUTINE--OUTPUT STATUS OF SALES ORDER # OE310 01000F* 96 EDIT SUBROUTINE--ERROR EXISTS OE310 01010F* 97 EDIT SUBROUTINE--GOTO CORRECT TAG OE310 01020F* LR LAST RECORD--BODY OF PROGRAM LOOPS THROUGH LR CALCS OE310 01030F* 99 OUTPUT SALLOC TO PARTMST OE310 01040E********************************************************************OE310 01050E FN 27 22 FIELD NAME OE310 0001060E CP 27 4 CURSOR POSITION OE310 01070E LN 27 2 0 LENGTH OE310 01080E EP 27 3 0 ENDING POSITION OE310 01090E PB 5 7 3 PARTMST PRICES OE310 01100E PRC 18 7 3 STORED PRICES OE310 01110E TABD 12 12 2 0 TABE 2 0 MONTH/DAY TABLE OE310 01120E MS 1 4 30 MESSAGE ARRAY OE310 0001130E TABA 1 17 3 0 TABB 30 ERROR MESSAGES OE310 01140E* OE310 01150E* TABA CONTAINS SECTION NUMBER AND X COORDINATE TO BE EDITED OE310 01160E* TABB CONTAINS CURPOS, ERROR MESSAGE, & SUBR# FOR SUBRXS. OE310 01170E********************************************************************OE310 01180IDUMMY NS 01 OE310 01190I 1 1 A OE310 0001200IDISPR2 NS 02 OE310 01210I 1 22 FIELDN OE310 01220I 23 26 CURPOS OE310 01230I 27 280LNGTHA OE310 01240I 29 310ENDPOS OE310 01250I 32 320SET OE310 01260IARMAST NS 03 OE310 0001270I 7 30 NAME OE310 01280I 31 54 ADR1 OE310 01290I 55 78 ADR2 OE310 01300I 79 91 CITY OE310 01310I 92 93 STCODE OE310 01320I 94 980ZIP OE310 01330I 94 98 AZIP OE310 0001340I 115 115 DCODE OE310 01350I 161 1610PC OE310 01360IPARTMST NS 05 OE310 01370I 1 37 DESC OE310 01380I 74 74 DPCODE OE310 01390I 146 1520SOH OE310 01400I 167 1730SALLOC OE310 0001410I 226 260 PB OE310 01420IOPNORDS NS 06 OE310 01430I 1 20BKORD OE310 01440I 3 70SO OE310 01450I 1 119 REC OE310 01460I 65 84 PART OE310 01470I 105 105 STATUS OE310 0001480I 9 130CUST OE310 01490I 43 430OVPC OE310 01500I 11 11 LM OE310 01510I 24 300QO OE310 01520I 38 44 QS OE310 01530ISLSMAN XX 08 OE310 01540I 4 28 SNAME OE310 0001550I 30 30 DLTSMN OE310 01560IAREA XX 09 OE310 01570I 3 27 ANAME OE310 01580I 30 30 DLTARA OE310 01590ITERMS XX 10 OE310 01600I 2 26 TNAME OE310 01610I 30 30 DLTTRM OE310 0001620C MOVE ' ' RCODE OE310 01630C MOVE RCODE B72 72 BLANK FIELDS OE310 01640C MOVE RCODE B26 26 OE310 01650C MOVE RCODE B22 22 OE310 01660C MOVE RCODE B7 7 OE310 01670C SETON LR OE310 01680C* OE310 0001690CLR Z-ADD36 UPPER 20 SET LINE-ITEM OE310 01700CLR MOVE UPPER UPPERA 2 LIMITS OE310 01710CLR Z-ADD27 SSIZE 20 OE310 01720CLR Z-ADD07 NSECT 20 OE310 01730C* OE310 01740CLR START TAG OE310 01750CLR SETOF 4243 OE310 0001760CLR SETOF 707172 OE310 01770CLR SETOF 767475 OE310 01780CLR MOVE ' ' RECORD OE310 01790CLR EXSR FIRSTP OE310 01800CLR 40 EXSR CLRSCR OE310 01810CLR 40 GOTO EOJ OE310 01820CLR 42 GOTO START OE310 0001830CLR EXSR CLRSCR OE310 01840CLR EXSR GETSEC OE310 01850CLR EXSR OUTPUT OE310 01860CLR Z-ADD1 Y 20 OE310 01870CLR MOVE Y YSAVE 20 OE310 01880CLR Z-ADD0 YLIM 20 OE310 01890CLR Z-ADD1 LB 20 LOWER BOUND OE310 0001900CLR Z-ADD18 UB 20 UPPER BOUND OE310 01910CLR BLOOP TAG OE310 01920CLR MOVE B7 PRC BLANK ARRAY OE310 01930CLR 76 EXSR GET2 OE310 01940CLR EXSR UPDATE OE310 01950CLR 67 EXSR CLRSCR OE310 01960CLR 67 EXSR OUTPUT OE310 0001970CLR 67 GOTO BLOOP OE310 01980CLR GOTO START OE310 01990CLR EOJ TAG OE310 02000C********************************************************************OE310 02010C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE310 02020C* SECTION FOR INQUIRY/UPDATE. OE310 02030C********************************************************************OE310 0002040CSR FIRSTP BEGSR OE310 02050CSR EXSR CLRSCR OE310 02060CSR Z-ADD0 SECTN 10 OE310 02070CSR EXSR GETSEC OE310 02080CSR PGE TAG OE310 02090CSR SETON 6162 OE310 02100CSR EXSR OUTPUT OE310 0002110CSR KXTAG TAG OE310 02120CSR Z-ADDKX X OE310 02130CSR EXSR ACCEPT OE310 02140CSR MOVELBUFFER KEY OE310 02150CSR MOVELSAVPOS BUFFER OE310 02160CSR EXSR POSCUR OE310 02170CSR MOVELKEY BUFFER OE310 0002180CSR MOVE 'S' TYPE OE310 02190CSR EXSR CRTCOM OE310 02200CSR MOVELKEY BUFFER OE310 02210CSR EXSR EDIT OE310 02220CSR 96 GOTO KXTAG OE310 02230CSR SETOF 62 OE310 02240CSR SXTAG TAG OE310 0002250CSR Z-ADDSX X 20 OE310 02260CSR EXSR ACCEPT OE310 02270CSR EXSR EDIT OE310 02280CSR 96 GOTO SXTAG OE310 02290CSR 30 GOTO PGE OE310 02300CSR SETOF 61 OE310 02310CSR ENDSR OE310 0002320C********************************************************************OE310 02330C* THIS SUBROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE310 02340C********************************************************************OE310 02350CSR GETSEC BEGSR OE310 02360CSR SETOF 4041 OE310 02370CSR SECTN MULT SSIZE RRN 50 OE310 02380CSR Z-ADD1 X OE310 0002390CSR SCLOOP TAG OE310 02400CSR RRN ADD 1 RRN OE310 02410CSR RRN CHAINDISPR2 50 OE310 02420CSR 50 GOTO ENDGET OE310 02430CSR FIELDN COMP B22 4141 OE310 02440CSRN41 CURPOS COMP ' ' 4141 OE310 02450CSRN41 GOTO ENDGET OE310 0002460CSR MOVE FIELDN FN,X OE310 02470CSR MOVE CURPOS CP,X OE310 02480CSR MOVE LNGTHA LN,X OE310 02490CSR MOVE ENDPOS EP,X OE310 02500CSR X ADD 1 X OE310 02510CSR X COMP SSIZE 32 OE310 02520CSRN32 GOTO SCLOOP OE310 0002530CSR ENDGET TAG OE310 02540CSR Z-ADDX NOFLDS 20 OE310 02550CSR 76 Z-ADD12 NOFLDS OE310 02560CSR ENDSR OE310 02570C********************************************************************OE310 02580C* THIS SUBROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE310 02590C* THAT OUTPUTS THEM. IF FIRSTP CALLED THIS ROUTINE THEN THE OE310 0002600C* KEY INDEX AND SECTION INDEX IS SAVED. OE310 02610C********************************************************************OE310 02620CSR OUTPUT BEGSR OE310 02630CSR Z-ADD1 X OE310 02640CSR Z-ADD0 Y OE310 02650CSR OTLOOP TAG OE310 02660CSR 61 EP,X COMP 1 31 OE310 0002670CSR 61 31 Z-ADDX KX 20 KEY FIELD INDEXOE310 02680CSR 61 EP,X COMP 2 31 OE310 02690CSR 61 31 Z-ADDX SX 20 SECTION INDEX OE310 02700CSR EXSR OUTFLD OE310 02710CSR X ADD 1 X OE310 02720CSR X COMP NOFLDS 31 OE310 02730CSR 31 GOTO OTLOOP OE310 0002740CSR ENDSR OE310 02750C********************************************************************OE310 02760C* THIS SUBROUTINE OUTPUTS THE FIELD NAMES, FIELD INFORMATION, OE310 02770C* AND BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD OE310 02780C* LENGTH IS 0 THEN ONLY THE FIELD NAME IS OUTPUT. OE310 02790C* EACH TYPE OF SCREEN CALLS THE APPROPRIATE ROUTINE TO OE310 02800C* OUTPUT ITS FIELD INFORMATION. OE310 0002810C********************************************************************OE310 02820CSR OUTFLD BEGSR OE310 02830CSR MOVE FN,X FL 20 OE310 02840CSR FL COMP 0 81 DISPLAY FIELD OE310 02850CSR MOVELCP,X FC 20 OE310 02860CSR FC COMP FL 31 OE310 02870CSR 31 Z-ADDFC FL OE310 0002880CSR FC SUB FL CC 20 OE310 02890CSR CC ADD 1 CC OE310 02900CSR MOVELCP,X BUFFER OE310 02910CSR 76 EXSR POSLIN OE310 02920CSR MOVELCC BUFFER OE310 02930CSR EXSR POSCUR OE310 02940CSR MOVELB72 BUFFER OE310 0002950CSR MOVELFN,X FIELDN OE310 02960CSR MOVE ' ' FIELDN OE310 02970CSR MOVELFIELDN BUFFER OE310 02980CSR Z-ADDLN,X LEN 20 OE310 02990CSR LEN COMP 0 3130 OE310 03000CSR 31 Z-SUBLN,X LEN OE310 03010CSR 30 GOTO SKIPF OE310 0003020CSR EXSR LTBRKT OE310 03030CSR 81 Z-ADDBPOS FPOS OE310 03040CSRN81 BPOS ADD 1 FPOS 20 OE310 03050CSRN61 EXSR GET OE310 03060CSR EXSR XTYPE OE310 03070CSR 74 EXSR GETPRC GET PRICE OE310 03080CSRN81 EXSR RTBRKT OE310 0003090CSR SKIPF TAG OE310 03100CSR 30 Z-ADDFL BLNGTH OE310 03110CSR SETOF 59 OE310 03120CSR 30N61 X COMP 5 59 OE310 03130CSR 59 MOVELKEY BUFFER OE310 03140CSR SETOF 59 OE310 03150CSRN30N81 FL ADD 3 BLNGTH OE310 0003160CSRN30 81 FL ADD 1 BLNGTH OE310 03170CSRN30 BLNGTH ADD LEN BLNGTH OE310 03180CSR MOVE 'S' TYPE OE310 03190CSR EXSR CRTCOM OE310 03200CSR ENDSR OE310 03210C********************************************************************OE310 03220C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE RECORD. OE310 0003230C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE310 03240C* CHARACTERS WERE TYPED, THE CURSOR JUMPS TO THE BEGINNING OE310 03250C* OF THE PREVIOUS FIELD. IF THE 1ST CHARACTER IS AN '@' THEN OE310 03260C* THE REST OF THE FIELDS ARE LEFT UNCHANGED. OE310 03270C********************************************************************OE310 03280CSR UPDATE BEGSR OE310 03290CSR SETOF 32 OE310 0003300CSR Z-ADD1 X OE310 03310CSR Z-ADDYSAVE Y OE310 03320CSR UPLOOP TAG OE310 03330CSR MOVE FN,X FL OE310 03340CSR FL COMP 0 30 OE310 03350CSRN30 EXSR LNGTH OE310 03360CSR 30N32 GOTO INCR OE310 0003370CSR 30 GOTO CHKRUB OE310 03380CSR SETOF 3233 OE310 03390CSR 76 EXSR XTYPE WHICH 'X' OE310 03400CSR 74 89 Z-ADD14 X GET TO X=15 OE310 03410CSR 75 89 Z-ADD14 X GET TO X=14 OE310 03420CSR SETOF 89 OE310 03430CSR EXSR XTYPE OE310 0003440CSR EXSR ACCEPT OE310 03450CSR CHKRUB TAG OE310 03460CSR 32 87 74 NO RUBOUT ON OE310 03470COR 32 86 75 WHAT LINE OR OE310 03480COR 32 83 76 GOTO UPLOOP BACK TO WHAT OE310 03490C* LINE OE310 03500CSR 32 X SUB 1 X 31 OE310 0003510CSR 32 31 GOTO UPLOOP OE310 03520CSR 32 GOTO ENDUPD OE310 03530CSR MOVELBUFFER ATSIGN 1 OE310 03540CSR ATSIGN COMP '@' 35 OE310 03550CSR 35 76 83 GOTO ATSG1 @ IN WHAT LINE OE310 03560CSR 35 76 GOTO UPLOOP NO @ LINE ITEMSOE310 03570CSR 35 GOTO OUTREC OE310 0003580CSR ATSG1 TAG OE310 03590CSR 33 Z-ADD1 FPOS OE310 03600CSR 33 EXSR GET OE310 03610CSR EXSR EDIT OE310 03620C* OE310 03630CSR 66 T=GOTO CONTROL OE310 03640COR 67 R,@= NEW LINES OE310 0003650COR 40 GOTO ENDUPD E=END OF JOB OE310 03660CSR 96 GOTO UPLOOP OE310 03670CSR 33 GOTO INCR OE310 03680CSRN65 EXSR PUT OE310 03690CSR EXSR OUTFLD OE310 03700CSR INCR TAG OE310 03710CSR SETOF 30 OE310 0003720CSR X ADD 1 X OE310 03730CSRN76 X COMP NOFLDS 30 OE310 03740CSR 30 GOTO UPLOOP OE310 03750CSR OUTREC TAG OE310 03760CSR 76 X COMP 16 30 OE310 03770CSR 76N30 GOTO UPLOOP OE310 03780CSR MOVELRECORD REC OE310 0003790CSR SETON 80 OE310 03800CSR EXCPT OE310 03810CSR SETOF 80 OE310 03820CSR 76 30 Z-ADD11 X OE310 03830CSR 76 GOTO UPLOOP OE310 03840CSR ENDUPD ENDSR OE310 03850C********************************************************************OE310 0003860C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE310 03870C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE310 03880C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC & OE310 03890C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE310 03900C* WAS USED TO TERMINATE THE OPERATION THEN THE OPERATION IS OE310 03910C* RETIRED IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE OE310 03920C* INDICATOR 32 IS SETON. IF A LINE FEED WAS USED THEN THE OE310 0003930C* ORIGINAL FIELD INFO IS OUTPUT TO THE SCREEN. A NORMAL OE310 03940C* TERMINATION CAUSES THE NEW INFO TO BE OUTPUT TO THE SCREEN. OE310 03950C********************************************************************OE310 03960CSR ACCEPT BEGSR OE310 03970CSR X COMP 1 30 OE310 03980CSRN30 X COMP SSIZE 30 OE310 03990CSR 30 Z-ADD1 X OE310 0004000CSR MOVELCP,X FC OE310 04010CSR FC ADD 3 FC OE310 04020CSR MOVELCP,X SAVPOS 4 OE310 04030CSR 76 EXSR POSLIN OE310 04040CSR MOVELFC SAVPOS OE310 04050CSR LN,X ADD FC OFC 20 OE310 04060CSR OFC ADD 1 OFC OE310 0004070CSR Z-ADDLN,X LEN OE310 04080CSR LEN COMP 0 34 OE310 04090CSR 34 Z-SUBLEN LEN OE310 04100CSR ACLOOP TAG OE310 04110CSR MOVELSAVPOS BUFFER OE310 04120CSR EXSR POSCUR OE310 04130CSR Z-ADDLEN BLNGTH OE310 0004140CSR MOVE B72 BUFFER OE310 04150CSR MOVE 'A' TYPE OE310 04160CSR EXSR CRTCOM OE310 04170CSR RCODE COMP 'R' 31 OE310 04180CSR 31 BUFFER COMP B72 32 OE310 04190CSR 31 32N61 GOTO ENDACC OE310 04200CSR 31 GOTO ACLOOP OE310 0004210CSR RCODE COMP 'L' 33 OE310 04220CSR 33 GOTO DUPIT OE310 04230CSRN34 GOTO ENDACC OE310 04240CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE310 04250CSR SIGN COMP '@' 30 OE310 04260CSR 30 GOTO ENDACC OE310 04270CSR Z-ADDLEN VL 20 OE310 0004280CSR MOVELBUFFER VAR 15 OE310 04290CSR EXSR RTADJ OE310 04300CSR MOVELVAR BUFFER OE310 04310CSR GOTO ENDACC OE310 04320CSR DUPIT TAG OE310 04330CSRN61 EXSR OUTFLD OE310 04340CSRN61 GOTO ENDACC OE310 0004350CSR MOVELSAVPOS BUFFER OE310 04360CSR EXSR POSCUR OE310 04370CSR 62 MOVELKEY BUFFER OE310 04380CSRN62 MOVELSECTON BUFFER OE310 04390CSR MOVE 'S' TYPE OE310 04400CSR EXSR CRTCOM OE310 04410CSR ENDACC ENDSR OE310 0004420C********************************************************************OE310 04430C* THIS SUBROUTINE MOVES A LEFT BRACKET INTO BUFFER AT BPOS. OE310 04440C********************************************************************OE310 04450CSR LTBRKT BEGSR OE310 04460CSR FL ADD 2 BPOS 20 OE310 04470CSR Z-ADD1 WHICH1 10 OE310 04480CSRN81 EXIT SUBRIN OE310 0004490CSR RLABL WHICH1 10 OE310 04500CSR RLABL BUFFER 72 OE310 04510CSR RLABL RECORD OE310 04520CSR RLABL BPOS 20 OE310 04530CSR RLABL FPOS 20 OE310 04540CSR RLABL STRT 30 OE310 04550CSR RLABL LEN 20 OE310 0004560CSR ENDSR OE310 04570C********************************************************************OE310 04580C* THIS SUBROUTINE MOVES INFO FROM 'RECORD' INTO BUFFER. OE310 04590C* MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE310 04600C* FROM STRT IN RECORD TO FPOS IN BUFFER. OE310 04610C********************************************************************OE310 04620CSR GET BEGSR OE310 0004630CSR EP,X SUB LEN STRT 30 OE310 04640CSR STRT ADD 1 STRT OE310 04650CSR Z-ADD2 WHICH1 10 OE310 04660CSR EXIT SUBRIN OE310 04670CSR RLABL WHICH1 10 OE310 04680CSR RLABL BUFFER 72 OE310 04690CSR RLABL RECORD OE310 0004700CSR RLABL BPOS 20 OE310 04710CSR RLABL FPOS 20 OE310 04720CSR RLABL STRT 30 OE310 04730CSR RLABL LEN 20 OE310 04740CSR ENDSR OE310 04750C********************************************************************OE310 04760C* THIS SUBROUTINE INSERTS A RIGHT BRACKET INTO BUFFER AT BPOS. OE310 0004770C********************************************************************OE310 04780CSR RTBRKT BEGSR OE310 04790CSR LEN ADD FPOS FPOS OE310 04800CSR Z-ADD3 WHICH1 10 OE310 04810CSR EXIT SUBRIN OE310 04820CSR RLABL WHICH1 10 OE310 04830CSR RLABL BUFFER 72 OE310 0004840CSR RLABL RECORD OE310 04850CSR RLABL BPOS 20 OE310 04860CSR RLABL FPOS 20 OE310 04870CSR RLABL STRT 30 OE310 04880CSR RLABL LEN 20 OE310 04890CSR ENDSR OE310 04900C********************************************************************OE310 0004910C* THIS SUBROUTINE MOVES LEN NUMBER OF CHARS FROM THE BEGINNING OE310 04920C* OF BUFFER TO THE STRT OF RECORD. OE310 04930C********************************************************************OE310 04940CSR PUT BEGSR OE310 04950CSR EP,X SUB LEN STRT OE310 04960CSR STRT ADD 1 STRT OE310 04970CSR Z-ADD4 WHICH1 10 OE310 0004980CSR EXIT SUBRIN OE310 04990CSR RLABL WHICH1 10 OE310 05000CSR RLABL BUFFER 72 OE310 05010CSR RLABL RECORD OE310 05020CSR RLABL BPOS 20 OE310 05030CSR RLABL FPOS 20 OE310 05040CSR RLABL STRT 30 OE310 0005050CSR RLABL LEN 20 OE310 05060CSR ENDSR OE310 05070C********************************************************************OE310 05080C* THIS SUBROUTINE RIGHT ADJUSTS FIELDS. OE310 05090C********************************************************************OE310 05100CSR RTADJ BEGSR OE310 05110CSR EXIT SUBRAJ OE310 0005120CSR RLABL VL OE310 05130CSR RLABL VAR OE310 05140CSR ENDSR OE310 05150C********************************************************************OE310 05160C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. OE310 05170C********************************************************************OE310 05180CSR CRTCOM BEGSR OE310 0005190CSR EXITFSUBRCM OE310 05200CSR RLABL BUFFER 72 OE310 05210CSR RLABL TYPE 1 OE310 05220CSR RLABL BLNGTH 20 OE310 05230CSR RLABL RCODE 1 OE310 05240CSR RLABL MASK 10 OE310 05250CSR RLABL DTYPE 10 OE310 0005260CSR ENDSR OE310 05270C********************************************************************OE310 05280C* THIS SUBROUTINE POSITIONS THE CURSOR. OE310 05290C********************************************************************OE310 05300CSR POSCUR BEGSR OE310 05310CSR MOVE 'P' TYPE OE310 05320CSR EXSR CRTCOM OE310 0005330CSR ENDSR OE310 05340C********************************************************************OE310 05350C* THIS SUBROUTINE CLEARS THE SCREEN. OE310 05360C********************************************************************OE310 05370CSR CLRSCR BEGSR OE310 05380CSR MOVE 'C' TYPE OE310 05390CSR EXSR CRTCOM OE310 0005400CSR ENDSR OE310 05410C********************************************************************OE310 05420C* THIS SUBROUTINE IS USED IN VARIOUS SUBROUTINES. OE310 05430C* IT TAKES THE VARIABLE LENGTH FROM THE ARRAYS AND MOVES IT OE310 05440C* INTO AN RPG FIELD 'LEN'. IF 'LEN' IS NEGATIVE THE VARIABLE OE310 05450C* IS NUMERIC, NOT ALPHA. IF 'LEN' IS ZERO, THERE IS NO VARIABLE, OE310 05460C* ONLY A MESSAGE. OE310 0005470C********************************************************************OE310 05480CSR LNGTH BEGSR OE310 05490CSR Z-ADDLN,X LEN OE310 05500CSR LEN COMP 0 3730 OE310 05510CSR 37 Z-SUBLEN LEN OE310 05520CSR ENDSR OE310 05530C********************************************************************OE310 0005540C* THIS SUBROUTINE DISPLAYS THE LINE ITEMS. OE310 05550C********************************************************************OE310 05560CSR GET2 BEGSR OE310 05570CSR MOVE YSAVE Y OE310 05580C* OE310 05590CSR GLOOP TAG OE310 05600CSR MOVELKEY WKEY 8 OE310 0005610CSR MOVELY WRKEY 3 OE310 05620CSR MOVE 'L' WRKEY OE310 05630CSR MOVE WRKEY WKEY OE310 05640CSR WKEY CHAINOPNORDS 59 NOT FOUND OE310 05642CSR 59 MOVE 'M' WKEY 05644CSR 59 WKEY CHAINOPNORDS 59 05650CSR MOVELREC RECORD OE310 0005660CSRN59 SO COMP SSO 5959 OE310 05670CSR 59 Z-ADDY YLIM OE310 05680CSR 59 GOTO EGET2 OE310 05690CSR EXSR POSLIN DISPLAY OE310 05700CSR MOVEL'03' BUFFER LINE # OE310 05710CSR EXSR POSCUR OE310 05720CSR MOVELY BUFFER OE310 0005730CSR MOVE 'S' TYPE OE310 05740CSR Z-ADD2 BLNGTH OE310 05750CSR EXSR CRTCOM OE310 05760C* OE310 05770CSR Z-ADD1 NCHARS FIND OUT IF IT OE310 05780CSR Z-ADD11 SSTRT 30 IS A LINE ITEMOE310 05790CSR Z-ADD1 TSTRT 30 OR LINE COMENTOE310 0005800CSR EXIT SUBRMV OE310 05810CSR RLABL RECORD SOURCE OE310 05820CSR RLABL SSTRT 30 OE310 05830CSR RLABL LC 1 TARGET OE310 05840CSR RLABL TSTRT 30 OE310 05850CSR RLABL NCHARS 30 OE310 05860C* OE310 0005870CSR LC COMP 'L' 58 OE310 05880CSRN58 Z-ADD16 X OE310 05890CSR 58 Z-ADD12 X OE310 05900CSR EXSR OUTFLD OE310 05910CSRN58 GOTO GL1 OE310 05920CSR Z-ADD20 NCHARS MOVE PRODUCT # OE310 05930CSR Z-ADD65 SSTRT TO BUFFER OE310 0005940CSR Z-ADD1 TSTRT OE310 05950CSR EXIT SUBRMV OE310 05960CSR RLABL RECORD OE310 05970CSR RLABL SSTRT 30 OE310 05980CSR RLABL BUFFER OE310 05990CSR RLABL TSTRT 30 OE310 06000CSR RLABL NCHARS 30 OE310 0006010CSR EXSR XTYPE OE310 06020CSR EXSR EDIT OE310 06030CSR Z-ADD13 X OE310 06040CSR EXSR OUTFLD OE310 06050CSR Z-ADD14 X OE310 06060CSR EXSR OUTFLD OE310 06070CSR Z-ADD15 X OE310 0006080CSR EXSR OUTFLD OE310 06090CSR GL1 TAG OE310 06100CSR EXSR YTOZ OE310 06110CSR Y ADD 1 Y OE310 06120CSRN59 GOTO GLOOP OE310 06130CSR Z-ADDY YLIM OE310 06140CSR EGET2 TAG OE310 0006150CSR SETOF 59 OE310 06160CSR ENDSR OE310 06170C********************************************************************OE310 06180C* THIS SUBROUTINE POSITIONS THE CURSOR TO THE PROPER LINE ON OE310 06190C* PAGE DURING LINE ITEMS, ETC. OE310 06200C********************************************************************OE310 06210CSR POSLIN BEGSR OE310 0006220CSR X COMP 12 59 OE310 06230CSR 59 GOTO EPOS OE310 06240CSR EXSR YTOZ OE310 06250CSR Z ADD 2 Z OE310 06260CSR MOVELZ BUFFER OE310 06270CSR MOVE Z SAVPOS OE310 06280CSR EPOS TAG OE310 0006290CSR SETOF 59 OE310 06300CSR ENDSR OE310 06310C********************************************************************OE310 06320C* THIS SUBROUTINE IS USED FOR LINE ITEMS ONLY. OE310 06330C* IT SETS AN INDICATOR ON ACCORDING TO WHICH 'X' ELEMENT IS OE310 06340C* BEING PROCESSED. IT'S ONLY CONCERNED WITH 'X' ELEMENTS 11-16. OE310 06350C********************************************************************OE310 0006360CSR XTYPE BEGSR OE310 06370CSR X COMP 11 83 WHAT LINE ? OE310 06380CSR X COMP 12 84 PRODUCT # OE310 06390CSR X COMP 13 85 S-T-D 74ON OE310 06400C** ORDERED 75ON OE310 06410CSR X COMP 14 86 ON ORDER 74ON OE310 06420C** SHIP 75ON OE310 0006430CSR X COMP 15 87 PRICE OVRD 74 OE310 06440C** BACKORDER 75 OE310 06450CSR X COMP 16 88 LINE COMMENT OE310 06460CSR ENDSR OE310 06470C********************************************************************OE310 06480C* THIS SUBROUTINE BREAKS UP A 6-BYTE DATE IN THE FORM MMDDYY, OE310 06490C* WHICH HAS BEEN MOVED INTO DIG6N, INTO YEAR (@YR), MONTH (@MO), OE310 0006500C* DAY (@DA). OE310 06510C********************************************************************OE310 06520CSR DATE BEGSR OE310 06530CSR MOVE DIG6N @YR 20 OE310 06540CSR MOVELDIG6N @MO 20 OE310 06550CSR MOVE DIG6N @DAYR 40 OE310 06560CSR MOVEL@DAYR @DA 20 OE310 0006570CSR ENDT ENDSR OE310 06580C********************************************************************OE310 06590C* THIS SUBROUTINE EDITS A DATE FIELD. OE310 06600C* IT LOOKS UP MONTH IN A TABLE TO VALIDATE THE YEAR. OE310 06610C********************************************************************OE310 06620CSR EDATE BEGSR OE310 06630CSR DIG6N COMP 0 59 OE310 0006640CSR 59 MOVE UDATE DIG6N OE310 06650CSR 59 MOVELUDATE SAVE OE310 06660CSR EXSR DATE OE310 06670CSR @MO COMP 0 96 OE310 06680CSRN96 @DA COMP 0 96 OE310 06690CSRN96 @YR COMP 0 96 OE310 06700CSRN96 @MO LOKUPTABD TABE 59 OE310 0006710CSRN96N59 SETON 96 OE310 06720CSRN96 59 @DA COMP TABE 96 OE310 06730CSR ENDTE ENDSR OE310 06740C********************************************************************OE310 06750C* THIS SUBROUTINE EDITS ANY FIELD SHOWN IN TABA. OE310 06760C* TABA CONTAINS SECTION AND X. OE310 06770C* TABB CONTAINS CURSOR POSITION,ERROR MESSAGE,& SUBR# FOR SUBRXS OE310 0006780C********************************************************************OE310 06790CSR EDIT BEGSR OE310 06800CSR SETOF 979695 OE310 06810CSR SETOF 596065 OE310 06820CSR SETOF 666768 OE310 06830CSR SETOF 4243 OE310 06840CSR MOVELSECTN XCNT 30 OE310 0006850CSR MOVE X XCNT OE310 06860CSR XCNT LOKUPTABA TABB 97 OE310 06870CSRN97 GOTO EEDIT OE310 06880CSR MOVE BUFFER SAVE 72 OE310 06890CSR MOVE B26 WORD26 26 OE310 06900CSR MOVE TABB DIG2N 20 OE310 06910CSR XCNT COMP 004 98 OE310 0006920CSR 98 EXSR E004 OE310 06930CSR XCNT COMP 005 98 OE310 06940CSR 98 EXSR E005 OE310 06950CSR XCNT COMP 106 98 OE310 06960CSR 98 EXSR E106 OE310 06970CSR XCNT COMP 107 98 OE310 06980CSR 98 EXSR E107 OE310 0006990CSR XCNT COMP 108 98 OE310 07000CSR 98 EXSR E107 OE310 07010CSR XCNT COMP 115 98 OE310 07020CSR 98 EXSR E115 OE310 07030CSR XCNT COMP 116 98 OE310 07040CSR 98 EXSR E116 OE310 07050CSR XCNT COMP 117 98 OE310 0007060CSR 98 EXSR E117 OE310 07070CSR XCNT COMP 118 98 OE310 07080CSR 98 EXSR E118 OE310 07090CSR XCNT COMP 119 98 OE310 07100CSR 98 EXSR E119 OE310 07110CSR XCNT COMP 206 98 OE310 07120CSR 98 EXSR E106 OE310 0007130CSR XCNT COMP 411 98 OE310 07140CSR 98 EXSR E411 OE310 07150CSR XCNT COMP 412 98 OE310 07160CSR 98 EXSR E412 OE310 07170CSR XCNT COMP 415 98 OE310 07180CSR 98 EXSR E415 OE310 07190CSR XCNT COMP 511 98 OE310 0007200CSR 98 EXSR E411 OE310 07210CSR XCNT COMP 512 98 OE310 07220CSR 98 EXSR E412 OE310 07230C********* OE310 07240C*** THIS SECTION DISPLAYS THE ERROR MESSAGE. OE310 07250C*** IT DISPLAYS BLANKS IF THE MESSAGE SHOUDN'T EXIST. OE310 07260C********* OE310 0007270CSR ERMESS TAG OE310 07280CSRN97 GOTO EEDIT OE310 07290CSR 96 MOVE TABB WORD26 OE310 07300CSR 96 MOVE ' ' WORD26 OE310 07310CSR MOVELTABB BUFFER OE310 07320CSR 76 EXSR POSLIN OE310 07330CSR 76 84 MOVEL'27' BUFFER PRODUCT DESC OE310 0007340CSR EXSR POSCUR OE310 07350CSR MOVE 'S' TYPE OE310 07360CSR MOVELWORD26 BUFFER OE310 07370CSR Z-ADD26 BLNGTH OE310 07380CSR EXSR CRTCOM OE310 07390CSR MOVE SAVE BUFFER OE310 07400CSR 74 60 EXSR PUTPRC STORE PRICES OE310 0007410CSR EEDIT ENDSR OE310 07420C********************************************************************OE310 07430C*** THIS SECTION EDITS THE SALES ORDER #. OE310 07440C*** CHAIN TO ORDRRN TO VALIDATE. THIS ALSO GIVES THE OE310 07450C*** RELATIVE RECORD # OF THE HEADER RECORD IN ROPNORD. OE310 07460C*** IT ALSO TELLS YOU THE STATUS OF THE S.O.,CUST#,& OVRD PRCE COD OE310 07470C********************************************************************OE310 0007480CSR E004 BEGSR OE310 07490CSR MOVELBUFFER KEY 50 OE310 07500CSR MOVELKEY WKEY OE310 07510CSR MOVEL'00' WRKEY OE310 07520CSR MOVE 'H' WRKEY OE310 07530CSR MOVE WRKEY WKEY OE310 07540CSR WKEY CHAINOPNORDS 96 SO NOT FOUND OE310 0007550CSR Z-ADDKEY SSO 50 OE310 07560CSR 96 GOTO END004 OE310 07570CSR Z-ADDCUST SCUST 60 SAVE CUST# OE310 07580CSR Z-ADDOVPC SOVPC 10 SAVE OVRD PC OE310 07590CSR STATUS COMP 'D' 59 OE310 07600CSR 59 MOVE MS,1 WORD26 OE310 07610CSR STATUS COMP 'I' 59 OE310 0007620CSR 59 MOVE MS,2 WORD26 OE310 07630CSR STATUS COMP 'B' 59 OE310 07640CSR 59 BKORD ADD 1 SBKORD 20 OE310 07650CSR 59 MOVE MS,3 WORD26 OE310 07660CSR STATUS COMP ' ' 59 OE310 07670CSR 59 MOVE MS,4 WORD26 OE310 07680CSR END004 ENDSR OE310 0007690C********************************************************************OE310 07700C*** THIS SECTION EDITS THE SECTION # OR MODE. OE310 07710C*** IT'S VALID FOR OE310 07720C*** A=ACTIVATE DELETED SALES ORDER 1=HEADER RECORD OE310 07730C*** B=BACKORDER SITUATION 2=SHIP-TO CUST OE310 07740C*** D=DELETE SALES ORDER 3=MARK FOR COMMENTS OE310 07750C*** E=END OF JOB 4=LINE ITEMS OE310 0007760C*** F=FREIGHT/SPEC. CHARGES OE310 07770C*** I=INVOICE ALL ITEMS OE310 07780C*** R=RETRY SALES ORDER # OE310 07790C********************************************************************OE310 07800CSR E005 BEGSR OE310 07810CSR MOVELBUFFER SECTON 1 OE310 07820CSR SECTON COMP 'E' 40 END OF JOB OE310 0007830CSR 40 GOTO END005 OE310 07840CSR SECTON COMP 'R' 30 RETRY KEY OE310 07850CSR 30 GOTO END005 OE310 07860CSR SECTON COMP 'A' 42 ACTIVATE ORDEROE310 07870CSR 42 EXSR ACTDEL OE310 07880CSR 42 STATUS COMP 'B' 59 OE310 07890CSR 42 MOVE ' ' STATUS OE310 0007900CSR 42 EXCPT OE310 07910CSR 42 GOTO END005 OE310 07920CSR SECTON COMP 'D' 42 DELETE ORDER OE310 07930CSR 42 SETON 45 OE310 07940CSR 42 EXSR ACTDEL OE310 07950CSR SETOF 45 OE310 07960CSR 42 MOVE 'D' STATUS OE310 0007970CSR 42 EXCPT OE310 07980CSR 42 GOTO END005 OE310 07990CSR SECTON COMP 'I' 42 INVOICE AS IS OE310 08000CSR 42 MOVE 'I' STATUS OE310 08010CSR 42 EXCPT OE310 08020CSR 42 GOTO END005 OE310 08030CSR SECTON COMP 'B' 43 BACKORDER OE310 0008040CSR 43 MOVE 'B' STATUS OE310 08050CSR 43 BKORD ADD 1 SBKORD 20 OE310 08060CSR 43 EXCPT OE310 08070CSR 43 Z-ADD5 SECTN OE310 08080CSR 43 SETON 7576 BACKORDER LINEOE310 08090CSR 43 GOTO END005 OE310 08100CSR SECTON COMP 'F' 77 FREIGHT OE310 0008110CSR 77 Z-ADD6 SECTN OE310 08120CSR 77 GOTO FRT OE310 08130CSR SECTON COMP '1' 96 OE310 08140CSRN96 SECTON COMP '4' 96 OE310 08150CSR 96 GOTO END005 OE310 08160CSR MOVE SECTON SECTN OE310 08170CSR FRT TAG OE310 0008180CSR SECTN COMP 1 70 HEADER OE310 08190CSR SECTN COMP 2 71 SHIP-TO CUST OE310 08200CSR SECTN COMP 3 72 MARK FOR COMNTOE310 08210CSR SECTN COMP 4 74 LINES UPDATE OE310 08220CSR SECTN COMP 6 77 FREIGHT OE310 08230CSR 74 SETON 76 OE310 08240CSR MOVELSSO WKEY OE310 0008250CSR MOVEL'00' WRKEY OE310 08260CSR 77 OE310 08270COR 70 MOVE 'H' WRKEY OE310 08280CSR 71 MOVE 'I' WRKEY OE310 08290CSR 72 MOVE 'K' WRKEY OE310 08300CSR MOVE WRKEY WKEY OE310 08310CSR WKEY CHAINOPNORDS 59 NOT FOUND OE310 0008320CSR MOVELREC RECORD120 OE310 08330CSR 74 EXSR CHAIN GET CUST PC OE310 08340CSR END005 ENDSR OE310 08350C********************************************************************OE310 08360C*** THIS SECTION EDITS THE CUSTOMER NUMBER. OE310 08370C*** IT CHAINS TO ARMAST TO SEE IF THE NUMBER ALREADY EXISTS. OE310 08380C*** IF IT EXISTS, IT'S VALID AND THE SOLD-TO LINES SHOULD OE310 0008390C*** BE DISPLAYED. THIS SAME SECTION WILL BE USED TO EDIT THE OE310 08400C*** SHIP-TO CUSTOMER. OE310 08410C********************************************************************OE310 08420CSR E106 BEGSR OE310 08430CSR MOVELBUFFER DIG5N 50 OE310 08440CSR 71 DIG5N COMP 99999 9696 OE310 08450CSR 71N96 GOTO END106 OE310 0008460CSR Z-ADDDIG5N DIG6N 60 OE310 08470CSR DIG6N CHAINARMAST 96 NOT FOUND OE310 08480CSR 96 GOTO END106 OE310 08490CSRN96 DCODE COMP ' ' 9696 OE310 08500CSR MOVEL'2605' BUFFER DISPLAY N/A OE310 08510CSR EXSR POSCUR LINE 1 OE310 08520CSR MOVE 'S' TYPE OE310 0008530CSR MOVELNAME BUFFER OE310 08540CSR Z-ADD24 BLNGTH OE310 08550CSR EXSR CRTCOM OE310 08560CSR 70 GOTO SKNAME OE310 08570CSR Z-ADD24 NCHARS OE310 08580CSR Z-ADD1 SSTRT OE310 08590CSR Z-ADD14 TSTRT OE310 0008600CSR EXIT SUBRMV OE310 08610CSR RLABL NAME SOURCE OE310 08620CSR RLABL SSTRT 30 OE310 08630CSR RLABL RECORD TARGET OE310 08640CSR RLABL TSTRT 30 OE310 08650CSR RLABL NCHARS 30 OE310 08660C* OE310 0008670C* OE310 08680CSR SKNAME TAG OE310 08690CSR MOVEL'2606' BUFFER DISPLAY OE310 08700CSR EXSR POSCUR ADDRESS 1 OE310 08710CSR MOVE 'S' TYPE OE310 08720CSR MOVELADR1 BUFFER OE310 08730CSR EXSR CRTCOM OE310 0008740CSR 70 GOTO SKADR1 OE310 08750CSR Z-ADD38 TSTRT OE310 08760CSR EXIT SUBRMV OE310 08770CSR RLABL ADR1 SOURCE OE310 08780CSR RLABL SSTRT 30 OE310 08790CSR RLABL RECORD TARGET OE310 08800CSR RLABL TSTRT 30 OE310 0008810CSR RLABL NCHARS 30 OE310 08820C* OE310 08830CSR SKADR1 TAG OE310 08840CSR MOVEL'2607' BUFFER DISPLAY OE310 08850CSR EXSR POSCUR ADDRESS 2 OE310 08860CSR MOVE 'S' TYPE OE310 08870CSR MOVELADR2 BUFFER OE310 0008880CSR EXSR CRTCOM OE310 08890CSR 70 GOTO SKADR2 OE310 08900CSR Z-ADD62 TSTRT OE310 08910CSR EXIT SUBRMV OE310 08920CSR RLABL ADR2 SOURCE OE310 08930CSR RLABL SSTRT 30 OE310 08940CSR RLABL RECORD TARGET OE310 0008950CSR RLABL TSTRT 30 OE310 08960CSR RLABL NCHARS 30 OE310 08970C* OE310 08980CSR SKADR2 TAG OE310 08990CSR MOVEL'2608' BUFFER DISPLAY OE310 09000CSR EXSR POSCUR CITY OE310 09010CSR MOVE 'S' TYPE OE310 0009020CSR MOVELCITY BUFFER OE310 09030CSR Z-ADD13 BLNGTH OE310 09040CSR EXSR CRTCOM OE310 09050CSR 70 GOTO SKCITY OE310 09060CSR Z-ADD13 NCHARS OE310 09070CSR Z-ADD86 TSTRT OE310 09080CSR EXIT SUBRMV OE310 0009090CSR RLABL CITY SOURCE OE310 09100CSR RLABL SSTRT 30 OE310 09110CSR RLABL RECORD TARGET OE310 09120CSR RLABL TSTRT 30 OE310 09130CSR RLABL NCHARS 30 OE310 09140C* OE310 09150CSR SKCITY TAG OE310 0009160CSR MOVEL'4308' BUFFER OE310 09170CSR EXSR POSCUR STATE CODE OE310 09180CSR MOVE 'S' TYPE OE310 09190CSR MOVELSTCODE BUFFER OE310 09200CSR Z-ADD2 BLNGTH OE310 09210CSR EXSR CRTCOM OE310 09220CSR 70 GOTO SKCODE OE310 0009230CSR Z-ADD2 NCHARS OE310 09240CSR Z-ADD99 TSTRT OE310 09250CSR EXIT SUBRMV OE310 09260CSR RLABL STCODE SOURCE OE310 09270CSR RLABL SSTRT 30 OE310 09280CSR RLABL RECORD TARGET OE310 09290CSR RLABL TSTRT 30 OE310 0009300CSR RLABL NCHARS 30 OE310 09310C* OE310 09320CSR SKCODE TAG OE310 09330CSR MOVEL'4908' BUFFER DISPLAY OE310 09340CSR EXSR POSCUR ZIP OE310 09350CSR MOVE 'S' TYPE OE310 09360CSR MOVELAZIP BUFFER OE310 0009370CSR Z-ADD5 BLNGTH OE310 09380CSR EXSR CRTCOM OE310 09390CSR 70 GOTO SKZIP OE310 09400CSR Z-ADD5 NCHARS OE310 09410CSR Z-ADD101 TSTRT OE310 09420CSR EXIT SUBRMV OE310 09430CSR RLABL AZIP SOURCE OE310 0009440CSR RLABL SSTRT 30 OE310 09450CSR RLABL RECORD TARGET OE310 09460CSR RLABL TSTRT 30 OE310 09470CSR RLABL NCHARS 30 OE310 09480C* OE310 09490CSR SKZIP TAG OE310 09500CSR END106 ENDSR OE310 0009510C********************************************************************OE310 09520C*** THIS SECTION EDITS A DATE FIELD. OE310 09530C********************************************************************OE310 09540CSR E107 BEGSR OE310 09550CSR MOVELBUFFER DIG6N OE310 09560CSR EXSR EDATE OE310 09570CSR ENDSR OE310 0009580C********************************************************************OE310 09590C*** THIS SECTION EDITS THE PAYMENT TERMS OVERRIDE. OE310 09600C********************************************************************OE310 09610CSR E115 BEGSR OE310 09620CSR MOVELBUFFER DIG1 1 OE310 09630CSR DIG1 COMP ' ' 9696 OE310 09640CSRN96 GOTO END115 OE310 0009650CSR DIG1 CHAINTERMS 96 OE310 09660CSRN96 MOVELTNAME WORD26 OE310 09670CSRN96 DLTTRM COMP ' ' 9696 OE310 09680CSR END115 ENDSR OE310 09690C********************************************************************OE310 09700C*** THIS SECTION EDITS THE PRICE CODE OVERRIDE. OE310 09710C*** IT'S A NUMERIC FIELD THAT'S VALID FOR 0-5. OE310 0009720C*** 0 IMPLIES THERE IS NO OVERRIDE. OE310 09730C********************************************************************OE310 09740CSR E116 BEGSR OE310 09750CSR MOVELBUFFER DIG1N 10 OE310 09760CSR DIG1N COMP 0 96 OE310 09770CSRN96 DIG1N COMP 5 96 OE310 09780CSR ENDSR OE310 0009790C********************************************************************OE310 09800C*** THIS SECTION EDITS THE TAX CODE OVERRIDE. OE310 09810C*** IT'S AN ALPHA FIELD THAT'S VALID FOR BLANK, C, O, N. OE310 09820C********************************************************************OE310 09830CSR E117 BEGSR OE310 09840CSR MOVELBUFFER DIG1 OE310 09850CSR DIG1 COMP ' ' 9696 OE310 0009860CSR 96 DIG1 COMP 'C' 9696 OE310 09870CSR 96 DIG1 COMP 'O' 9696 OE310 09880CSR 96 DIG1 COMP 'N' 9696 OE310 09890CSR ENDSR OE310 09900C********************************************************************OE310 09910C*** THIS SECTION EDITS THE SALESMAN# OE310 09920C********************************************************************OE310 0009930CSR E118 BEGSR OE310 09940CSR MOVELBUFFER DIG3N 30 OE310 09950CSR DIG3N COMP 0 9696 OE310 09960CSRN96 GOTO END118 OE310 09970CSR DIG3N CHAINSLSMAN 96 OE310 09980CSRN96 DLTSMN COMP ' ' 9696 OE310 09990CSRN96 MOVELSNAME WORD26 OE310 0010000CSR END118 ENDSR OE310 10010C********************************************************************OE310 10020C*** THIS SECTION EDITS THE AREA OE310 10030C********************************************************************OE310 10040CSR E119 BEGSR OE310 10050CSR MOVELBUFFER DIG2 2 OE310 10060CSR DIG2 COMP ' ' 9696 OE310 0010070CSRN96 GOTO END119 OE310 10080CSR DIG2 CHAINAREA 96 OE310 10090CSRN96 DLTARA COMP ' ' 9696 OE310 10100CSRN96 MOVELANAME WORD26 OE310 10110CSR END119 ENDSR OE310 10120C********************************************************************OE310 10130C*** THIS SECTION EDITS THE 'WHAT LINE ?' FIELD. OE310 0010140C*** 'Y' REPRESENTS THE ARRAY ELEMENT (WHAT LINE ?). OE310 10150C*** VALID ENTRIES ARE : OE310 10160C*** R = RUBOUT - GO BACK A SCREEN OE310 10170C*** @ = GO FORWARD A SCREEN OE310 10180C*** T = GO BACK TO CONTROL SCREEN OE310 10190C*** ZERO = INCREMENT THE Y ELEMENT BY ONE OE310 10200C*** # = MUST BE WITHIN INTERVAL SHOWN ON THE SCREEN. OE310 0010210C********************************************************************OE310 10220CSR E411 BEGSR OE310 10230CSR SETOF 53 OE310 10240CSR MOVELBUFFER DIG2 OE310 10250CSR DIG2 COMP '@ ' 67 OE310 10260CSRN67 GOTO SKIPE OE310 10270CSR UB COMP UPPER 68 68 OE310 0010280CSRN68 LB ADD 18 LB OE310 10290CSRN68 UB ADD 18 UB OE310 10300CSRN68 YSAVE ADD 18 YSAVE OE310 10310CSR GOTO END411 OE310 10320C* OE310 10330CSR SKIPE TAG OE310 10340CSR DIG2 COMP 'R ' 67 OE310 0010350CSRN67 GOTO SKIPX OE310 10360CSR UB COMP 18 68 OE310 10370CSRN68 LB SUB 18 LB OE310 10380CSRN68 UB SUB 18 UB OE310 10390CSRN68 YSAVE SUB 18 YSAVE OE310 10400CSR GOTO END411 OE310 10410C* OE310 0010420CSR SKIPX TAG OE310 10430CSR DIG2 COMP 'T ' 66 OE310 10440CSR 66 GOTO END411 OE310 10450C* OE310 10460CSR DIG2 COMP ' ' 9696 OE310 10470CSRN96 GOTO SKIPG OE310 10480CSR DIG2 COMP '00' 96 OE310 0010490CSRN96 DIG2 COMP UPPERA 96 OE310 10500CSR 96 GOTO END411 OE310 10510CSR SKIPG TAG OE310 10520CSR SETON 53 OE310 10530CSR Z-ADDY S 20 SAVE Y OE310 10540CSR MOVELBUFFER Y OE310 10550CSR Y COMP 0 59 OE310 0010560CSR 59N33N52S COMP 1 51 OE310 10570CSR 51 Z-ADD0 S OE310 10580CSR 51 SETON 52 OE310 10590CSR SETOF 51 OE310 10600CSR 59N33 S ADD 1 Y OE310 10610CSR 59 33 Z-ADDS Y OE310 10620CSR Y COMP LB 96 OE310 0010630CSRN96 Y COMP UB 96 OE310 10640CSRN96 Y COMP YLIM 96 96 OE310 10650CSR 96 GOTO END411 OE310 10660CSR MOVELY SAVE OE310 10670CSR MOVELSSO WKEY OE310 10680CSR MOVELY WRKEY OE310 10690CSR MOVE 'L' WRKEY OE310 0010700CSR MOVE WRKEY WKEY OE310 10710CSR WKEY CHAINOPNORDS 59 NOT FOUND OE310 10720CSR 59 SETON 96 OE310 10730CSR 59 GOTO END411 OE310 10740CSR MOVELREC RECORD OE310 10750CSR Z-ADD1 NCHARS OE310 10760CSR Z-ADD11 SSTRT OE310 0010770CSR Z-ADD1 TSTRT OE310 10780CSR EXIT SUBRMV OE310 10790CSR RLABL RECORD OE310 10800CSR RLABL SSTRT 30 OE310 10810CSR RLABL LC OE310 10820CSR RLABL TSTRT 30 OE310 10830CSR RLABL NCHARS 30 OE310 0010840CSR LC COMP 'L' 9696 OE310 10850CSRN96 SETON 89 INCREMENT X OE310 10860CSR END411 TAG OE310 10870CSRN53 SETOF 52 OE310 10880CSR ENDSR OE310 10890C********************************************************************OE310 10900C*** THIS SECTION EDITS THE PRODUCT # BY CHAINING TO PARTMST. OE310 0010910C*** IF IT EXISTS THE DESCRIPTION IS DISPLAYED. OE310 10920C*** IF IT DOESN'T EXIST AN ERROR MESSAGE DISPLAYS AND THE OE310 10930C*** USER MUST TRY AGAIN. OE310 10940C********************************************************************OE310 10950CSR E412 BEGSR OE310 10960CSR MOVELBUFFER DIG12 20 OE310 10970CSR Z-ADD0 PB OE310 0010980CSR DIG12 CHAINPARTMST 96 NOT FOUND OE310 10990CSRN96 DPCODE COMP ' ' 9696 OE310 11000CSRN96 SETON 60 OE310 11010CSRN96 MOVELDESC WORD16 16 OE310 11020CSRN96 MOVELWORD16 WORD26 11030CSR ENDSR OE310 11040C********************************************************************OE310 0011050C*** THIS SECTION EDITS THE PRICE OVERRIDE. OE310 11060C*** LINE-FEED OR CR: DISPLAY PRICE STORED IN 'PRC' ARRAY/DON'T OE310 11070C*** UPDATE RECORD. OE310 11080C*** OTHER: RE-DISPLAY NEW OVERRIDE/UPDATE RECORD. OE310 11090C********************************************************************OE310 11100CSR E415 BEGSR OE310 11110CSR SETOF 97 OE310 0011120CSR MOVELBUFFER PRICE OE310 11130CSR PRICE COMP 0 56 OE310 11140CSR 33 LINE-FEED OR OE310 11150COR 56 SETON 65 ZERO: DON'T OE310 11160C* UPDATE RECORD OE310 11170CSR EXSR YTOZ CONVERT Y OE310 11180CSRN56 Z-ADDPRICE PRC,Z OE310 0011190CSR MOVELPRC,Z SAVE ZERO ENTRY: OE310 11200CSR MOVE SAVE BUFFER USE FILE PRICE OE310 11210CSR END415 ENDSR OE310 11220C********************************************************************OE310 11230C* THIS SUBROUTINE GETS THE PRICE CODE FOR THIS ORDER. OE310 11240C* IF THE OVERRIDE PC IS ZERO, IT CHAINS TO ARMAST TO GET IT. OE310 11250C********************************************************************OE310 0011260CSR CHAIN BEGSR GET PRICE CODE OE310 11270CSR SOVPC COMP 0 59 IF NO OVRIDE OE310 11280CSRN59 Z-ADDSOVPC PC OE310 11290CSR 59 SCUST CHAINARMAST 59 MUST HIT OE310 11300CSR ENDCHN ENDSR OE310 11310C********************************************************************OE310 11320C* THIS SUBROUTINE STORES PRICES FOR EACH PART IN THE 'PRC' ARRAY. OE310 0011330C* PRICES COME FROM RECORD IF OVERRIDE, OTHERWISE FROM PARTMST 'PB' OE310 11340C* ARRAY (USING PRICE CODE FROM CHAIN SUBR). OE310 11350C********************************************************************OE310 11360CSR PUTPRC BEGSR OE310 11370CSR EXSR MVPRCE GET FROM REC OE310 11380CSR PRICE COMP 0 59 OE310 11390CSRN59 GOTO STORE USE OVRIDE PRC OE310 0011400CSR PC COMP 1 59 59 OE310 11410CSR 59 PC COMP 5 5959 OE310 11420CSR 59 Z-ADDPB,PC PRICE USE FILE PRICE OE310 11430CSR STORE TAG STORE IN 'PRC' OE310 11440CSR EXSR YTOZ OE310 11450CSR Z-ADDPRICE PRC,Z OE310 11460CSR ENDSR OE310 0011470C********************************************************************OE310 11480C* THIS SUBROUTINE MOVES OVERRIDE PRICE FIELD FROM RECORD TO PRICE. OE310 11490C********************************************************************OE310 11500CSR MVPRCE BEGSR OE310 11510CSR Z-ADD7 NCHARS OE310 11520CSR Z-ADD52 SSTRT OE310 11530CSR Z-ADD1 TSTRT OE310 0011540CSR EXIT SUBRMV OE310 11550CSR RLABL RECORD OE310 11560CSR RLABL SSTRT 30 OE310 11570CSR RLABL APRCE OE310 11580CSR RLABL TSTRT 30 OE310 11590CSR RLABL NCHARS 30 OE310 11600CSR MOVE APRCE PRICE 73 OE310 0011610CSR ENDSR OE310 11620C* THIS SUBROUTINE CALCULATES NEW SALLOC AND PUTS IN PARTMST OE310 11630C********************************************************************OE310 11640CSR ACTDEL BEGSR OE310 11650CSR Z-ADD0 ADKEY OE310 11660CSR MOVELSSO ADKEY 70 OE310 11670CSR ADKEY ADD 1 ADKEY OE310 0011680CSR LOOPA TAG OE310 11690CSR MOVELADKEY WKEY OE310 11700CSR MOVE 'L' WKEY OE310 11710CSR WKEY CHAINOPNORDS 96 OE310 11720CSR 96 GOTO ENDACT OE310 11730CSR LM COMP 'L' 96 OE310 11740CSRN96 GOTO BYPACT OE310 0011750CSR PART CHAINPARTMST 96 OE310 11760CSR 96 GOTO BYPACT OE310 11770CSR 42N45 SALLOC ADD QO SALLOC OE310 11780CSR 45 SALLOC SUB QO SALLOC OE310 11790CSR SETON 99 OE310 11800CSR EXCPT OE310 11810CSR SETOF 99 OE310 0011820CSR BYPACT TAG OE310 11830CSR ADKEY ADD 1 ADKEY OE310 11840CSR GOTO LOOPA OE310 11850CSR ENDACT TAG OE310 11860CSR Z-ADD0 ADKEY OE310 11870CSR MOVELSSO ADKEY OE310 11880CSR MOVELADKEY WKEY OE310 0011890CSR MOVE 'H' WKEY OE310 11900CSR WKEY CHAINOPNORDS 59 OE310 11910CSR SETOF 96 OE310 11920CSR ENDSR OE310 11930C********************************************************************OE310 11940C* THIS SUBROUTINE MOVES PRICE FROM 'PRC' TO BUFFER (DONE INSTEAD OE310 11950C* OF 'GET' SUBR FOR PRICES ONLY). OE310 0011960C********************************************************************OE310 11970CSR GETPRC BEGSR OE310 11980CSRN87 GOTO EGPRC OE310 11990CSR EXSR YTOZ OE310 12000CSR Z-ADDPRC,Z PRICE OE310 12010CSR Z-ADDLEN NCHARS OE310 12020CSR Z-ADD1 SSTRT OE310 0012030CSR Z-ADDFPOS TSTRT OE310 12040CSR MOVE PRICE APRCE 7 OE310 12050CSR EXIT SUBRMV OE310 12060CSR RLABL APRCE OE310 12070CSR RLABL SSTRT 30 OE310 12080CSR RLABL BUFFER OE310 12090CSR RLABL TSTRT 30 OE310 0012100CSR RLABL NCHARS 30 OE310 12110CSR EGPRC ENDSR OE310 12120C********************************************************************OE310 12130C* THIS SUBROUTINE CONVERTS Y TO THE CORRECT ARRAY ELEMENT# (1-18) OE310 12140C********************************************************************OE310 12150CSR YTOZ BEGSR OE310 12160CSR Y DIV 18 P 20 P=PAGE OE310 0012170CSR MVR Z 40 Z=LINE# ON PGE OE310 12180CSR Z COMP 0 59 OE310 12190CSR 59 Z ADD 18 Z OE310 12200CSR ENDSR OE310 12210O* OE310 12220O********************************************************************OE310 12230O* THIS SECTION OUTPUTS THE RECORDS AT EXCEPTION TIME. OE310 0012240O********************************************************************OE310 12250OOPNORDS E 80 OE310 12260O REC 119 OE310 12270O E 42 OE310 12280O STATUS 105 OE310 12290O E 43 OE310 12300O SBKORD 2 OE310 0012310O STATUS 105 OE310 12320O* OE310 12330O* OE310 12340OPARTMST E 99 OE310 12350O SALLOC 173 OE310 ** 012360ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 01237000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 012380ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 012390ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 012400** 012410013102290331043005310630073108310930103111301231 012420** 0124303602**DELETED SALES ORDER 1 012440003602**INVOICED ALL ITEMS 2 0124503602**BACKORDER SITUATION 3 0124603602 4 012470** 0124800043602**INVALID SALES ORDER # 01 1 0124900053104**INVALID MODE 02 2 0125001064104**INVALID CUST # 03 3 012510001074109**INVALID DATE 04 4 0125201084110**INVALID DATE 05 5 0125301154115**INVALID TERMS 06 6 0125401164116**INVALID PRICE CODE 07 7 0125501174117**INVALID TAX CODE 08 8 0125601184118**INVALID SALESMAN # 09 9 0125701194119**INVALID AREA 10 10 012580002064104**INVALID CUST # 11 11 0125904112321**INVALID 12 12 0126004121703**INVALID PART # 13 13 012610415 14 14 0126205112321**INVALID 15 15 0126305121703**INVALID PART # 16 16 012640 01265000/* 012660_ 00 00 00 00 00 00 00 00 00 00 __ 0( TXOE320 Pf999999032778(000010H S OE320 00020X DECK-ID A67 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE320 00030F* PRINT DELETED, SHIPPED ORDERS OE320 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE320 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE320 00060F* CONTROL DATA PROPRIETARY PRODUCT OE320 00070F* OE320 0000080FOPNORDS UPEAF 119 8AI 106 DISK OE320 00090FARMAST IC F 280R 6AI 1 DISK OE320 00100F$LP1 O F 132 OF PRINTER OE320 00110FHEADING IT F 40 EDISK OE320 00120F* OE320 00130F********************************************************************OE320 00140F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [ORD140] OE320 0000150F* OE320 00160F* PACKAGE DISTRIBUTION OE320 00170F* SYSTEM INVOICING OE320 00180F* PROGRAM PRINT DELETED, SHIPPED ORDERS OE320 00190F* OE320 00200F* CONTRACTOR COMPUSOURCE OE320 00210F* PROGRAMMER KATH HILL OE320 0000220F* DATE FEBRUARY 25, 1976 OE320 00230F* OE320 00240F********************************************************************OE320 00250F* OE320 00260F* ************************************************************** OE320 00270F* ** ** OE320 00280F* ** FUNCTION OF INDICATORS ** OE320 0000290F* ** ** OE320 00300F* ** 01 OPNORDS- HEADER ** OE320 00310F* ** 02 OPNORDS- SHIP-TO N/A ** OE320 00320F* ** 03 OPNORDS- 'MARK FOR' OR INVOICE COMMENTS ** OE320 00330F* ** 05 OPNORDS- LINE-ITEM ** OE320 00340F* ** 06 OPNORDS- LINE-ITEM COMMENT ** OE320 00350F* ** ** OE320 0000360F* ** 09 ARMAST ** OE320 00370F* ** 11 INVOICE DATE IS ZERO - USE UDATE ** OE320 00380F* ** 12 QTYSHP IS ZERO ** OE320 00390F* ** 13 QTYBOR IS ZERO ** OE320 00400F* ** 14 LINE-ITEM COMMENT IS BLANK ** OE320 00410F* ** ** OE320 00420F* ** 21 S.O. STATUS BLANK ** OE320 0000430F* ** 22 S.O. STATUS D ** OE320 00440F* ** 23 S.O. STATUS I ** OE320 00450F* ** 24 S.O. STATUS B ** OE320 00460F* ** ** OE320 00470F* ** ** OE320 00480F* ** 80 S.O. HAS SHIPMENTS ** OE320 00490F* ** ** OE320 0000500F* ** 90 S.O. HAS BACKORDERS ** OE320 00510F* ** ** OE320 00520F* ************************************************************** OE320 00530E HEADING HEAD 1 1 40 COMPANY NAME OE320 00540E* OE320 00550IOPNORDS XX 01 8 CH OE320 00560I 1 20BKORD 60 OE320 0000570I 3 70SONUM L1 OE320 00580I 9 130CUST OE320 00590I 14 190RDATE 11 OE320 00600I 20 31 PO OE320 00610I 105 105 STATUS OE320 00620I XX 02 8 CI OE320 00630I OR 03 8 CK OE320 0000640I 3 70SONUM L1 OE320 00650I XX 05 8 CL 11 CL OE320 00660I 3 70SONUM L1 OE320 00670I 9 100LINE OE320 00680I 65 84 PART OE320 00690I 24 300QTYORD OE320 00700I 31 370SHIPTD OE320 0000710I 38 440QTYSHP 12 OE320 00720I 45 510QTYBOR 13 OE320 00730I 52 583OVPRCE OE320 00740I XX 06 8 CL 11 CM OE320 00750I 3 70SONUM L1 OE320 00760I 9 100LINE OE320 00770I 12 49 LICMNT 14 OE320 0000780IARMAST XX 09 OE320 00790I 7 30 NAME OE320 00800I 115 115 DLTAR OE320 00810C SETOF 40 OE320 00820C L1N01 SETON H1 OE320 00830C H1 GOTO END OE320 00840C 01NL1 SETON H2 OE320 0000850C H2 GOTO END OE320 00860C L1 SETOF 212223 OE320 00870C L1 SETOF 248090 OE320 00880C L1 SETOF 5099 OE320 00890C 90 SETOF 91 OUTPUT HEADERS OE320 00900C 01 EXSR SUB1 OE320 00910C 50 GOTO END OE320 0000920C 05 EXSR SUB5 OE320 00930C END TAG OE320 00940C* OE320 00950C* ************************************************************** OE320 00960C* ** SUBR SUB1 - HEADER ** OE320 00970C* ** CHECK STATUS & DETERMINE ACTION FOR THIS ORDER. ** OE320 00980C* ** IF STATUS = ** OE320 0000990C* ** BLANK- OPEN S.O. - ENTIRE ORDER IS OUTPUT TO NEWOPN ** OE320 01000C* ** WITH NO CHANGE. NO INVENTORY TRANSACTIONS ARE ** OE320 01010C* ** GENERATED. NOT PRINTED ON REPORT. ** OE320 01020C* ** D- DELETE - ENTIRE ORDER IS DELETED. THE S.O. IS ** OE320 01030C* ** NOT OUTPUT TO ANY FILE BUT A 12 TRANSACTION IS ** OE320 01040C* ** OUTPUT TO TRANSAC FOR EACH LINE ITEM WITH TRANS ** OE320 01050C* ** QTY = QTY DELETED = QTYORD . PRINTED ON REPORT. ** OE320 0001060C* ** I- INVOICE ENTIRE ORDER - ALL RECORDS ARE OUTPUT TO ** OE320 01070C* ** INVINP ONLY. QTYORD IS PUT IN QTYSHP & ADDED TO ** OE320 01080C* ** SHIPPED-TO-DATE FOR LINE ITEMS. NO TRANSACTIONS ** OE320 01090C* ** ARE GENERATED. PRINTED ON REPORT. ** OE320 01100C* ** B- BACKORDER SITUATION - SOME LINE ITEMS TO BE ** OE320 01110C* ** INVOICED, SOME TO BE BACKORDERED OR CANCELED. ** OE320 01120C* ** ** OE320 0001130C* ************************************************************** OE320 01140C* OE320 01150CSR SUB1 BEGSR OE320 01160CSR STATUS COMP 'P' 20 OE320 01170CSR 20 SETON 21 OE320 01180CSR STATUS COMP ' ' 21NO CHANGE OE320 01190CSR STATUS COMP 'D' 22DELETE OE320 0001200CSR STATUS COMP 'I' 23SHIP COMPLETE OE320 01210CSR STATUS COMP 'B' 24BO/PARTIAL SHP OE320 01220CSR 20N60 SETON 24 OE320 01230CSR 20N60 SETOF 21 OE320 01240CSRN23N22N24 SETON 50 OE320 01250CSRN21N22N23 OE320 01260CANN24 SETON 99 OE320 0001270CSR 11 Z-ADDUDATE RDATE OE320 01280CSRN99 SOS ADD 1 SOS 50 OE320 01290CSR 21 A ADD 1 A 50 OE320 01300CSR 22 B ADD 1 B 50 OE320 01310CSR 23 C ADD 1 C 50 OE320 01320CSR 24 D ADD 1 D 50 OE320 01330CSR 21 GOTO END1 OE320 0001340CSR Z-ADDCUST CUST6 60 OE320 01350CSR CUST6 CHAINARMAST H3 OE320 01360CSRNH3 DLTAR COMP ' ' H3H3 OE320 01370CSR END1 ENDSR OE320 01380C* OE320 01390C* ************************************************************** OE320 01400C* ** SUBR SUB5 - LINE ITEMS ** OE320 0001410C* ************************************************************** OE320 01420C* OE320 01430CSR SUB5 BEGSR OE320 01440CSR 22 GOTO END5 OE320 01450CSR 99 GOTO END5 OE320 01460CSR 23 GOTO TAG23 OE320 01470CSR 24 GOTO TAG24 OE320 0001480C** OE320 01490C** OE320 01500CSR TAG23 TAG STATUS I OE320 01510C** OE320 01520CSR Z-ADDQTYORD QTYSHP OE320 01530CSR SHIPTD ADD QTYSHP SHIPTD OE320 01540CSR Z-ADD0 QTYBOR OE320 0001550CSR GOTO END5 OE320 01560C** OE320 01570CSR TAG24 TAG STATUS B OE320 01580C** OE320 01590CSRN12 SETON 80 OE320 01600CSR SHIPTD ADD QTYSHP SHIPTD OE320 01610CSRN13N90 SETON 9091 TO BKORDS OE320 0001620CSR END5 ENDSR OE320 01630O$LP1 H 202 1P OE320 01640O OR OF OE320 01650O PAGE Z 8 OE320 01660O 4 'PAGE' OE320 01670O HEAD,1 86 OE320 01680O UDATE Y 132 OE320 0001690O H 2 1P OE320 01700O OR OF OE320 01710O 75 'DELETED ORDERS REPORT' OE320 01720O 132 'DIS320' OE320 01730O H 1 1P OE320 01740O OR OF OE320 01750O 5 'SALES' OE320 0001760O H 2 1P OE320 01770O OR OF OE320 01780O 7 'ORDER #' OE320 01790O 16 'CUST #' OE320 01800O 31 'CUSTOMER NAME' OE320 01810O 59 'CUSTOMER P.O. #' OE320 01820O 68 'ACTION' OE320 0001830O T 1 L1N50 OE320 01840O SONUM 8 OE320 01850O CUST 16 OE320 01860O NAME 42 OE320 01870O PO 56 OE320 01880O 22 69 'DELETED' OE320 01890O 23 78 'SHIPPED COMPLETE' OE320 0001900O 24 90 73 'BACKORDERED' OE320 01910O 24 80N90 78 'PARTIAL SHIPPED/' OE320 01920O 24 80N90 91 'NO BACKORDERS' OE320 01930O 24N80N90 77 'STATUS B BUT NO' OE320 01940O 24N80N90 101 'SHIPMENTS OR BACKORDERS' OE320 01950O 24N80N90 116 '- NULL INVOICE' OE320 01960O T 31 LR OE320 0001970O 14 'END OF REPORT.' OE320 01980O 28 'OLD FILE HAD' OE320 01990O SOS Z 34 OE320 02000O 50 'ORDERS OF WHICH' OE320 02010O A Z 56 OE320 02020O 72 'WERE UNCHANGED,' OE320 02030O B Z 78 OE320 0002040O 92 'WERE DELETED,' OE320 02050O C Z 98 OE320 02060O 121 'WERE SHIPPED COMPLETE,' OE320 02070O T 1 LR OE320 02080O 19 'AND' OE320 02090O D Z 25 OE320 02100O 49 'WERE BACKORDERED AND/OR' OE320 0002110O 66 'PARTIAL SHIPPED.' OE320 02120OOPNORDS D 05 23N50 OE320 02130O OR 05 24N50 OE320 02140O SHIPTD 37 OE320 ** 002150ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002160ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00217000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002180ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002190/* 002200_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(, ,}IOLABELS P@|051378051378(000010H CRTLAB00020X 1 1 LABELS00030FDUMMY IPE F 72 72 DISK LABELS00040FCRT D F 80 80 CONSOLE 00050F*RINT O F 132 OF PRINTER LABELS00060FLDATADB O F 138 138 DISK A 00070E CRTOUT0010005030 0000080IDUMMY NS 01 LABELS00085C CONT TAG 00090C SETOF 77 00100C CRTOUT,1 DSPLYCRT CN3 30 00110C CRTOUT,2 DSPLYCRT ST3 28 00120C CRTOUT,3 DSPLYCRT CITY3 13 00130C CRTOUT,4 DSPLYCRT STATE3 04 0000140C CRTOUT,5 DSPLYCRT ZIP3 05 00150C SETON 77 00155C EXCPT 00157C GOTO CONT 00160O*RINT H 1P 00170O* 1 ' ' 00180O* E 77 006300000190O* CN3 31 0064000200O* E 77 0068000210O* ST3 29 0069000220O* E 2 77 0073000230O* CITY3 14 0074000240O* STATE3 19 0075000250O* ZIP3 25 007600000260OLDATADB EADD 77 00270O CN3 B 30 00280O ST3 B 58 00290O CITY3 B 71 00300O STATE3 B 75 00310O ZIP3 B 80 ** 00032000INPUT 30 CHARACTER NAME 00330INPUT 28 CHARACTER STREET 00340INPUT 13 CHARACTER CITY 000350INPUT 04 CHARACTER STATE 000360INPUT 05 CHARACTER ZIP CODE 000370/* 000380_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(n NKOTXOE350 P040678032778(000010H S OE350 00020X DECK-ID A69 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE350 00030F* UPDATE SALES STATS, UPDATE INVENTORY OE350 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE350 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE350 00060F* CONTROL DATA PROPRIETARY PRODUCT OE350 00070F* OE350 0000080FINVDTL IPEAF 55 DISK OE350 00090FMTHINV O F 54 DISK A OE350 00100FTRANSAC O F 45 DISK A OE350 00110F********************************************************************OE350 00120F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [INV060] OE350 00130F* OE350 00140F* PACKAGE DISTRIBUTION OE350 0000290F* OE350 00300F* 10 QTY = ZERO OE350 00310F* 20 TYPE ( ) = TRANSACTION # (14) OE350 00320F* 21 (C) = (16) OE350 00330F* 22 (M) = (18) OE350 00340F* 23 (D) = (20) OE350 00350F* OE350 0000360F********************************************************************OE350 00370IINVDTL NS 01 OE350 00380I 1 50INVNUM OE350 00390I 6 100CUSTNO OE350 00400I 11 160INVDAT OE350 00410I 17 190SLSMAN OE350 00420I 20 260QTY 10 OE350 0000430I 27 38 PARTNO OE350 00440I 39 452NETSLS OE350 00450I 46 523UNCOST OE350 00460I 53 54 AREA OE350 00470I 55 55 TYPE OE350 00480C TYPE COMP ' ' 20 OE350 00490C TYPE COMP 'C' 21 OE350 0000500C TYPE COMP 'M' 22 OE350 00510C TYPE COMP 'D' 23 OE350 00520C 20 Z-ADD14 TRANNO 20 OE350 00530C 21 Z-ADD16 TRANNO OE350 00540C 22 Z-ADD18 TRANNO OE350 00550C 23 Z-ADD20 TRANNO OE350 00560OMTHINV DADD 01N10 OE350 0000570O INVNUM 5 OE350 00580O CUSTNO 10 OE350 00590O INVDAT 16 OE350 00600O SLSMAN 19 OE350 00610O QTY 26 OE350 00620O PARTNO 38 OE350 00630O NETSLS 45 OE350 0000640O UNCOST 52 OE350 00650O AREA 54 OE350 00660OTRANSAC DADD 01N10 OE350 00670O PARTNO 12 OE350 00680O TRANNO 14 OE350 00690O QTY 21 OE350 00700O INVNUM 28 OE350 0000710O INVDAT 34 OE350 00720O UNCOST 41 OE350 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00077000/* 000780__0O UNCOST 41 OE350 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0007700(:m :TXOE340 Ph999999032778(000010H S 1 OE340 00020X DECK-ID A68 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE340 00030F* PRINT INVOICES OE340 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE340 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE340 00060F* CONTROL DATA PROPRIETARY PRODUCT OE340 00070F* OE340 0000080FOPNORDS IPEAF 119 8AI 106 DISK OE340 00090FCONTROL UC F 256R 7AI 1 DISK OE340 00100FARMAST IC F 280R 6AI 1 DISK OE340 00110FPARTMST IC F 300R20AI 271 DISK OE340 00120FTERMS IC F 30R 1AI 1 DISK OE340 00130FCARDS O F 80 7AI 74 DISK A OE340 00140FINVDTL O F 75 DISK OE340 0000150FARIND1 O F 32 7AI 7 DISK A OE340 00160FNOPNORD O F 119 8AI 106 DISK OE340 00170F$LP1 O F 85 OF LPRINTER OE340 00180F* OE340 00190F********************************************************************OE340 00200F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [INV040] OE340 00210F* OE340 0000220F* PACKAGE DISTRIBUTION OE340 00230F* SYSTEM INVOICING OE340 00240F* PROGRAM PRINT INVOICES OE340 00250F* OE340 00260F* CONTRACTOR COMPUSOURCE OE340 00270F* PROGRAMMER KATH HILL OE340 00280F* DATE FEBRUARY 25, 1976 OE340 0000290F* OE340 00300F********************************************************************OE340 00310F* OE340 00320F* ************************************************************** OE340 00330F* ** FUNCTION OF INDICATORS ** OE340 00340F* ** ** OE340 00350F* ** 01 INVINP- HEADER ** OE340 0000360F* ** 02 INVINP- SHIP-TO N/A ** OE340 00370F* ** 03 INVINP- 'MARK FOR' OR INVOICE COMMENTS ** OE340 00380F* ** 05 INVINP- LINE-ITEMS ** OE340 00390F* ** 06 INVINP- LINE-ITEM COMMENTS ** OE340 00400F* ** 08 CONTROL ** OE340 00410F* ** 09 ARMAST ** OE340 00420F* ** 10 PARTMST ** OE340 0000430F* ** 11 TERMS ** OE340 00440F* 21 NO OVERRIDE TERMS CODE ** OE340 00450F* ** 22 NO OVERRIDE PRICE CODE ** OE340 00460F* ** 23 NO OVERRIDE SALESMAN# ** OE340 00470F* ** 24 NO OVERRIDE AREA ** OE340 00480F* ** 25 NO OVERRIDE TAX CODE ** OE340 00490F* ** 26 OVERRIDE TAX CODE = N -- OUTPUT BLANK ** OE340 0000500F* ** 27 NO OVERRIDE PRICE FOR THIS LINE ITEM ** OE340 00510F* ** 28 LINE-ITEM COMMENT LINE IS BLANK ** OE340 00520F* ** 29 SHIP-TO ZIP CODE = ZERO - DON'T PRINT ** OE340 00530F* ** 30 AN INVOICE OR 'MARK FOR' COMMENT LINE IS BLANK ** OE340 00540F* ** 34 COMPRESSED COMMENT #4 IS BLANK ** OE340 00550F* ** 35 SUBR SUB3 LOOP IS DONE ** OE340 00560F* ** 40 SHIP-TO CUST# IS 99999 = MANUAL - DON'T CHAIN ** OE340 0000570F* ** 50 MULTIPLE PAGES- GO TO NEXT PAGE ** OE340 00580F* ** 60 INVALID PART # ** OE340 00590F* ** 65 PRICE CODE IS VALID (=1 TO 5) ** OE340 00600F* ** 80 NO HIT ON TERMS FILE ** OE340 00610F* ** 81 INVOICE TYPE BLANK - NORMAL INVOICE ** OE340 00620F* ** 82 INVOICE TYPE 'C' - CREDIT MEMO ** OE340 00630F* ** 83 INVOICE TYPE 'D' - DIRECT BILL ** OE340 0000640F* ** 84 INVOICE TYPE 'M' - MANUAL INVOICE - NO PRINT ** OE340 00650F* ** 85 PREVIOUS ORDER WAS A CREDIT MEMO ** OE340 00660F* ** N85 PREVIOUS ORDER WAS AN INVOICE ** OE340 00670F* ** 86&87 CHANGE OF BATCH FROM 'CM' TO 'IN' OR VICEVERSA ** OE340 00680F* ** 90 TAXABLE CUSTOMER - COMPUTE & PRINT TAX @ 6% ** OE340 00690F* ** 91 MISCELLANEOUS CHARGES ON THIS INVOICE ** OE340 00700F* ** 92 FREIGHT CHARGES ON THIS INVOICE ** OE340 0000710F* ** 98&99 1ST CYCLE ONLY ** OE340 00720F* ** ** OE340 00730F* ** H1 NO HEADER FOR THIS S.O. ** OE340 00740F* ** H2 DUPLICATE HEADERS FOR THIS S.O. ** OE340 00750F* ** H4 INVALID SOLD-TO CUST# ** OE340 00760F* ** NOTE- IF ANY 'H' HALTS OCCUR, THE ORDER ** OE340 00770F* ** ENTRY PROGRAM, DIS110, HAS BUGS & MUST ** OE340 0000780F* ** BE CORRECTED. ** OE340 00790F* ************************************************************** OE340 00800F* OE340 00810E COM 4 23 K COMMENTS INPUT OE340 00820E COUT 4 23 COMPRESSED K COM OE340 00830E PB 5 7 3 PARTMST PRICES OE340 00840L$LP1 66FL 60OL OE340 0000850IOPNORDS XX 01 8 CH OE340 00860I 1 119 ALL OE340 00870I 1 20BKORDS 56 OE340 00880I 3 70SONUM L1 OE340 00890I 9 130CUST OE340 00900I 14 190IDATE OE340 00910I 20 31 PONUM OE340 0000920I 32 41 CARIER OE340 00930I 42 42 OVTERM 21 OE340 00940I 43 430OVPC 22 OE340 00950I 44 460OVSMAN 23 OE340 00960I 47 48 OVAREA 24 OE340 00970I 49 49 OVTAX 25 OE340 00980I 50 550PDATE OE340 0000990I 56 622FRGHT OE340 01000I 63 692SPCHG OE340 01010I 70 89 SCNOTE OE340 01020I 105 105 ITYPE OE340 01030I XX 02 8 CI OE340 01040I 1 119 ALL OE340 01050I 3 70SONUM L1 OE340 0001060I 9 130SHIPTO OE340 01070I 14 37 SHIP1 OE340 01080I 38 61 SHIP2 OE340 01090I 62 85 SHIP3 OE340 01100I 86 98 SHIPCY OE340 01110I 99 100 SHIPST OE340 01120I 101 1050SHIPZP 29 OE340 0001130I XX 03 8 CK OE340 01140I 1 119 ALL OE340 01150I 3 70SONUM L1 OE340 01160I 9 100 COM OE340 01170I XX 05 8 CL 11 CL OE340 01180I 1 119 ALL OE340 01190I 3 70SONUM L1 OE340 0001200I 65 84 PART OE340 01210I 24 300QTYORD OE340 01220I 31 370SHIPTD OE340 01230I 38 440QTYSHP OE340 01240I 45 510QTYBOR OE340 01250I 52 583OVPRCE 27 OE340 01260I XX 06 8 CL 11 CM OE340 0001270I 1 119 ALL OE340 01280I 3 70SONUM L1 OE340 01290I 12 49 LICMNT 28 OE340 01300ICONTROL XX 08 OE340 01310I 8 120LASTNO OE340 01320I 254 2560CNTRLB OE340 01330IARMAST XX 09 OE340 0001340I 7 30 NAME OE340 01350I 31 54 LINE1 OE340 01360I 55 78 LINE2 OE340 01370I 79 91 CITY OE340 01380I 92 93 STATE OE340 01390I 94 980ZIP OE340 01400I 115 115 DLTAR OE340 0001410I 154 1560SLSMN OE340 01420I 157 158 AREA OE340 01430I 159 159 TXCODE OE340 01440I 160 160 TERM OE340 01450I 161 1610PC OE340 01460I 162 163 TYPE OE340 01470IPARTMST XX 10 OE340 0001480I 1 37 PDESC OE340 01490I 74 74 DLTPR OE340 01500I 75 813MAT$ OE340 01510I 89 953LAB$ OE340 01520I 96 1023BRD$ OE340 01530I 226 260 PB OE340 01540ITERMS XX 11 OE340 0001550I 2 26 TNAME OE340 01560I 30 30 DLTTRM OE340 01570C* OE340 01580C* INITIALIZE- GET LAST INVOICE# ASSIGNED. OE340 01590C* OE340 01600C Z-ADD0 ZROS 70 OE340 01610C 99 SETOF 98 OE340 0001620C 99 GOTO START OE340 01630C 'CONTROL' CHAINCONTROL H1 OE340 01640C H1 GOTO END OE340 01650C Z-ADDCNTRLB BATCH 30 OE340 01660C BATCH COMP 98 40 OE340 01670C 40 Z-ADD1 BATCH OE340 01680C Z-ADDLASTNO INVNO 50 OE340 0001690C MOVE ' ' BLANKS 23 OE340 01700C SETON 9998 OE340 01710C* OE340 01720C START TAG OE340 01730C L1 SETOF 73 OE340 01740C* OE340 01750C L1N01 SETON H2 NO HEADER OE340 0001760C H2 GOTO END OE340 01770C 01NL1 SETON H3 DUP HEADERS OE340 01780C H3 GOTO END OE340 01790C L1 SETOF 50 OE340 01800C L1 Z-ADD0 COUNT 40 OE340 01810C L1 Z-ADD0 NET 92 OE340 01820C 01 EXSR SUB1 OE340 0001830C 03N84 EXSR SUB3 OE340 01840C 05 EXSR SUB5 OE340 01850C 06N84N28 EXSR SUB6 OE340 01860C END TAG OE340 01870CL1 SEQ ADD 1 SEQ OE340 01880CL1 STXCOD COMP 'C' 90 OE340 01890CL1N90 Z-ADD0 TAX 72 OE340 0001900CL1 90 NET MULT .06 TAX H OE340 01910CL1 NET ADD TAX GROSS 92 OE340 01920CL1 GROSS ADD FRGHT GROSS OE340 01930CL1 GROSS ADD SPCHG GROSS OE340 01940CL1 SCNOTE COMP BLANKS 9191 OE340 01950CL1N91 SPCHG COMP 0 9191 OE340 01960CL1 FRGHT COMP 0 9292 OE340 0001970CL1 82 Z-SUBNET NETOUT 92 MAKE CREDIT OE340 01980CL1N82 Z-ADDNET NETOUT MEMO SIGNS OE340 01990CL1 82 Z-SUBTAX TAXOUT 72 POSITIVE FOR OE340 02000CL1N82 Z-ADDTAX TAXOUT OUTPUT TO A/R OE340 02010CL1 82 Z-SUBFRGHT FRTOUT 72 FILE, CARDS. OE340 02020CL1N82 Z-ADDFRGHT FRTOUT OE340 02030CL1 82 Z-SUBSPCHG SPCOUT 72 OE340 0002040CL1N82 Z-ADDSPCHG SPCOUT OE340 02050CL1 82 Z-SUBGROSS GRSOUT 92 OE340 02060CL1N82 Z-ADDGROSS GRSOUT OE340 02070CL1 BOUT ADD GRSOUT BOUT 102 OE340 02080CL1 86 87 EXCPT OE340 02090CLR MOVE ' ' BLANKS OE340 02100C* OE340 0002110C* ************************************************************** OE340 02120C* ** SUBR SUB1 - HEADER ** OE340 02130C* ************************************************************** OE340 02140C* OE340 02150CSR SUB1 BEGSR 02155CSR Z-ADD0 INDEX 20 02160CSR 86 SETOF 87 OE340 0002170CSR SETOF 81 OE340 02180CSR SETOF 49 OE340 02190CSR ITYPE COMP 'D' 69 OE340 02200CSR ITYPE COMP 'I' 70 OE340 02210CSR ITYPE COMP 'B' 71 OE340 02220CSR 70 OE340 02230COR 71 SETON 81 OE340 0002240CSR ITYPE COMP 'C' 82CREDIT MEMO OE340 02250CSR ITYPE COMP 'E' 83DIRECT BILL OE340 02260CSR ITYPE COMP 'M' 84MANUAL INVOICE OE340 02270CSR ITYPE COMP 'P' 55 OE340 02280CSR 55N56 SETON 81 OE340 02290CSR 55 56 SETON 49 OE340 02300CSR 98 99 1ST CYCLE ONLY OE340 0002310CORN82 85 NEW 'IN' BATCH OE340 02320COR 82N85 SETON 8687 NEW 'CM' BATCH OE340 02330CSRN82 SETOF 85 INVOICE OE340 02340CSR 82 SETON 85 CREDIT MEMO OE340 02350CSR 86 87 BATCH ADD 1 BATCH 30 NEW BATCH OE340 02360CSR 86 87 Z-ADD1 SEQ 40 OE340 02370CSRN84 INVNO ADD 1 INVNO OE340 0002380CSR Z-ADDCUST CUST6 60 OE340 02390CSR CUST6 CHAINARMAST H4 OE340 02400CSRNH4 DLTAR COMP ' ' H4H4 OE340 02410CSR H4 GOTO END1 OE340 02420CSR EXSR SAVEHD SAVE SOLD TO OE340 02430CSR STERM CHAINTERMS 80 CUST FIELDS OE340 02440CSRN80 DLTTRM COMP ' ' 8080 OE340 0002450CSR 84 Z-ADDSONUM SINVNO 70 OE340 02460CSRN84 Z-ADDINVNO SINVNO 70 OE340 02470CSR END1 ENDSR OE340 02480C* OE340 02490C* ************************************************************** OE340 02500C* ** SUBR SUB3 - COMPRESS K COMMENTS ** OE340 02510C* ** COMPRESS COMMENT LINES SO NO BLANK LINES ARE BETWEEN ** OE340 0002520C* ** NON-BLANK LINES. THEN CHECK LINE#4- IF BLANK ALLOW ONE ** OE340 02530C* ** SPACE BEFORE PRINTING OTHER 3 LINES. ** OE340 02540C* ************************************************************** OE340 02550C* OE340 02560CSR SUB3 BEGSR OE340 02570CSR MOVE BLANKS COUT OE340 02580CSR Z-ADD0 X 10 OE340 0002590CSR Z-ADD0 Y 10 OE340 02600CSR LOOP TAG OE340 02610CSR X COMP 4 35 OE340 02620CSR 35 GOTO DONE OE340 02630CSR X ADD 1 X OE340 02640CSR COM,X COMP BLANKS 30 OE340 02650CSR 30 GOTO LOOP OE340 0002660CSRN30 Y ADD 1 Y OE340 02670CSR MOVE COM,X COUT,Y OE340 02680CSR GOTO LOOP OE340 02690CSR DONE TAG OE340 02700CSR COUT,4 COMP BLANKS 34 OE340 02710CSR ENDSR OE340 02720C* OE340 0002730C* ************************************************************** OE340 02740C* ** SUBR SUB5 - LINE ITEMS ** OE340 02750C* ** GET DESC, PRICE, AND COSTS FOR PART. ** OE340 02760C* ** DO LINE# INCREMENTS & CHECK FOR PRINTING A MULTIPLE ** OE340 02770C* ** PAGE INVOICE. ** OE340 02780C* ************************************************************** OE340 02790C* OE340 0002800CSR SUB5 BEGSR OE340 02810CSR 82 Z-SUBQTYORD QTYSHP OE340 02820CSR 83 Z-ADDQTYORD QTYSHP OE340 02830CSR 70 Z-ADDQTYORD QTYSHP OE340 02831CSR 84 Z-ADDQTYORD QTYSHP 02840CSR Z-ADD0 PRICE 73 DEFAULT PRCE=0 OE340 02850CSR Z-ADD0 COST 73 TOT UNIT COST OE340 0002860CSR Z-ADD0 PAMT 72 OE340 02870CSR PART CHAINPARTMST 60 OE340 02880CSRN60 DLTPR COMP ' ' 6060 OE340 02890CSRN27 Z-ADDOVPRCE PRICE OVERRIDE PRICE OE340 02900CSRN27 GOTO SKIP5 OE340 02910CSR SPC COMP 1 65 65 PC = 1 TO 5? OE340 02920CSR 65 SPC COMP 5 6565 OE340 0002930CSR 65 Z-ADDPB,SPC PRICE OE340 02940CSR 60 Z-ADD0 PRICE OE340 02950CSR SKIP5 TAG OE340 02960CSR QTYSHP MULT PRICE PAMT H OE340 02970CSR 60 Z-ADD0 PAMT OE340 02980CSR NET ADD PAMT NET OE340 02990CSR MAT$ ADD LAB$ COST OE340 0003000CSR COST ADD BRD$ COST OE340 03010CSR 60 Z-ADD0 COST OE340 03020CSR COUNT COMP 22 50 50 OE340 03030CSR 50 Z-ADD0 COUNT OE340 03040CSR COUNT ADD 2 COUNT OE340 03050CSR QTYSHP COMP 0 68 OE340 03055CSR 71N56 SHIPTD ADD QTYSHP SHIPTD 0003060CSR QTYORD COMP SHIPTD 73 OE340 03065CSR 71N73 INDEX ADD 1 INDEX 03070CSR END5 ENDSR OE340 03080C* OE340 03090C* ************************************************************** OE340 03100C* ** SUBR SUB6 - LINE ITEM COMMENTS ** OE340 03110C* ** INCREMENT LINE COUNT & CHECK FOR SKIP TO NEW PAGE ** OE340 0003120C* ************************************************************** OE340 03130C* OE340 03140CSR SUB6 BEGSR OE340 03150CSR COUNT COMP 23 50 50 OE340 03160CSR 50 Z-ADD0 COUNT OE340 03170CSR COUNT ADD 1 COUNT OE340 03180CSR END6 ENDSR OE340 0003190C* OE340 03200C* ************************************************************** OE340 03210C* ** SUBR SAVEHD SAVES SOLD-TO CUSTOMER FIELDS FROM BEING ** OE340 03220C* ** LOST IF A 2ND CHAIN TO ARMAST IS NEEDED FOR THE SHIP-TO ** OE340 03230C* ** CUSTOMER. ** OE340 03240C* ************************************************************** OE340 03250C* OE340 0003260CSR SAVEHD BEGSR OE340 03270CSR MOVE NAME SNAME 24 OE340 03280CSR MOVE LINE1 SLINE1 24 OE340 03290CSR MOVE LINE2 SLINE2 24 OE340 03300CSR MOVE CITY SCITY 13 OE340 03310CSR MOVE STATE SSTATE 2 OE340 03320CSR MOVE ZIP SZIP 50 OE340 0003330CSR 21 MOVE TERM STERM 1 OE340 03340CSRN21 MOVE OVTERM STERM OE340 03350CSR 22 MOVE PC SPC 10 OE340 03360CSRN22 MOVE OVPC SPC OE340 03370CSR 23 MOVE SLSMN SSLSMN 30 OE340 03380CSRN23 MOVE OVSMAN SSLSMN OE340 03390CSR 24 MOVE AREA SAREA 2 OE340 0003400CSRN24 MOVE OVAREA SAREA OE340 03410CSR 25 MOVE TXCODE STXCOD 1 OE340 03420CSRN25 MOVE OVTAX STXCOD OE340 03430CSR STXCOD COMP 'N' 26 OE340 03440CSR 26 MOVE ' ' STXCOD OE340 03450CSR MOVE TYPE STYPE 2 OE340 03460CSR ENDSR OE340 0003470C** OE340 03480C** OE340 03490OCARDS EADD L1 86 87 OE340 03500O 2 'BH' OE340 03510O BATCH 5 OE340 03520O 7 'IN' OE340 03530O 82 7 'CM' OE340 0003531O 83 7 'MI' 03532O 84 7 'DB' 03540O BOUT B 17 OE340 03550O BATCH 76 OE340 03560O 80 '0000' OE340 03570O TADD L1 OE340 03580O 2 'IN' OE340 0003590O 82 2 'CM' OE340 03591O 83 2 'MI' 03592O 84 2 'DB' 03600O CUST6 8 OE340 03610O N84 INVNO 15 OE340 03620O 84 SONUM 15 OE340 03630O IDATE 21 OE340 0003640O GRSOUT 30 OE340 03650O FRTOUT 37 OE340 03660O STXCOD 38 OE340 03670O TAXOUT 45 OE340 03680O NETOUT 54 OE340 03690O SPCOUT 61 OE340 03700O BATCH 76 OE340 0003710O SEQ 80 OE340 03720OINVDTL D 05 OE340 03730O N84 INVNO 5 OE340 03740O 84 SONUM 5 OE340 03750O CUST 10 OE340 03760O IDATE 16 OE340 03770O SSLSMN 19 OE340 0003780O QTYSHP 26 OE340 03790O PART 75 OE340 03800O PAMT 45 OE340 03810O COST 52 OE340 03820O SAREA 54 OE340 03830O ITYPE 55 OE340 03831O 71N56 55 'I' 0003840OCONTROL T LR 99 OE340 03850O INVNO 12 OE340 03860O BATCH 256 OE340 03870O$LP1 H 18 1P OE340 03880O 15 'XXXXXXX XXXXXXX' OE340 03890O 36 'XXXXXXX XXXXXXXXXXXX' OE340 03900O 58 'XXXXXXXXXXXXXXXXXXXX' OE340 0003910O 80 'XXXXX XXXX.XXX XXXXX.XX' OE340 03920O D 201 50N84N69 OE340 03930O AND N49 OE340 03940O 58 '* CONTINUED - PAGE' OE340 03950O PAGE Z 64 OE340 03960O 66 '*' OE340 03970O D 103 01N84N69 OE340 0003980O AND N49 OE340 03990O OR 50N84N69 OE340 04000O AND N49 OE340 04010O SNAME 32 OE340 04020O D 1 01N84N69 OE340 04030O AND N49 OE340 04040O OR 50N84N69 OE340 0004050O AND N49 OE340 04060O SLINE1 32 OE340 04070O D 1 01N84N69 OE340 04080O AND N49 OE340 04090O OR 50N84N69 OE340 04100O AND N49 OE340 04110O SLINE2 32 OE340 0004120O D 1 01N84N69 OE340 04130O AND N49 OE340 04140O OR 50N84N69 OE340 04150O AND N49 OE340 04160O SCITY 21 OE340 04170O SSTATE 25 OE340 04180O SZIP 32 OE340 0004190O D 1 01N84N69 OE340 04200O AND N49 OE340 04210O OR 50N84N69 OE340 04220O AND N49 OE340 04230O INVNO 45 OE340 04240O IDATE Y 56 OE340 04250O 81 62 'SO#' OE340 0004260O 82 62 'CM#' OE340 04270O 83 62 'DB#' OE340 04280O SONUM 69 OE340 04290O D 1 02N84N69 OE340 04300O AND N49 OE340 04310O OR 50N84N69 OE340 04320O AND N49 OE340 0004330O SHIP1 32 OE340 04340O D 1 02N84N69 OE340 04350O AND N49 OE340 04360O OR 50N84N69 OE340 04370O AND N49 OE340 04380O SHIP2 32 OE340 04390O D 1 02N84N69 OE340 0004400O AND N49 OE340 04410O OR 50N84N69 OE340 04420O AND N49 OE340 04430O SHIP3 32 OE340 04440O D 2 02N84N69 OE340 04450O AND N49 OE340 04460O OR 50N84N69 OE340 0004470O AND N49 OE340 04480O SHIPCY 21 OE340 04490O SHIPST 25 OE340 04500O N29 SHIPZP 32 OE340 04510O D 1 03N84N69 OE340 04520O AND N49 OE340 04530O OR 50N84N69 OE340 0004540O AND N49 OE340 04550O COUT,1 31 OE340 04560O D 1 03N84N69 OE340 04570O AND N49 OE340 04580O OR 50N84N69 OE340 04590O AND N49 OE340 04600O COUT,2 31 OE340 0004610O D 1 03N84N69 OE340 04620O AND N49 OE340 04630O OR 50N84N69 OE340 04640O AND N49 OE340 04650O COUT,3 31 OE340 04660O D 1 03N84N69 OE340 04670O AND N49 OE340 0004680O OR 50N84N69 OE340 04690O AND N49 OE340 04700O COUT,4 31 OE340 04710O D 10 03N84N69 OE340 04720O AND N49 OE340 04730O OR 50N84N69 OE340 04740O AND N49 OE340 0004750O CUST 5 OE340 04760O SPC 8 OE340 04770O SSLSMN 13 OE340 04780O STYPE 17 OE340 04790O SAREA 21 OE340 04800O CARIER 34 OE340 04810O PONUM 49 OE340 0004820O N80 TNAME 77 OE340 04830O D 20 05N84N68 OE340 04840O AND N49 OE340 04850O QTYORDL 8 OE340 04860O QTYSHPL 15 OE340 04870O QTYBORL 23 OE340 04880O PART 36 OE340 0004910O PRICE L 72 OE340 04920O PAMT L 81 OE340 04921O D 10 05N84N68 04922O AND N49 04923O N60 PDESC 64 04924O 60 50 '** INVALID PART NUMBER ' 04925O 60 53 ' **' 0004930O D 20 06N84N28 OE340 04940O AND 50N49 OE340 04950O LICMNT 62 OE340 04960O D 10 06N84N28 OE340 04970O AND N50N49 OE340 04980O LICMNT 62 OE340 04990O T 145 L1N84 90 OE340 0005000O AND N49N69 OE340 05010O 71 'TAX -' OE340 05020O TAX L 81 OE340 05030O T 146 L1N84 91 OE340 05040O AND N49N69 OE340 05050O 48 'SPECIAL CHARGES FOR' OE340 05060O SCNOTE 69 OE340 0005070O 71 '-' OE340 05080O SPCHG L 81 OE340 05090O T 147 L1N84 92 OE340 05100O AND N49N69 OE340 05110O 71 'FREIGHT -' OE340 05120O FRGHT L 81 OE340 05130O T 149 L1N84N49 OE340 0005140O AND N69 OE340 05150O NET L 11 OE340 05160O NET L 33 OE340 05170O 36 '6%' OE340 05180O TAX L 47 OE340 05190O SPCHG L 56 OE340 05200O FRGHT L 65 OE340 0005210O GROSS L 81 OE340 05220OARIND1 TADD L1 OE340 05230O CUST6 6 OE340 05240O SINVNO 13 OE340 05250O GROSS 22 OE340 05260O GROSS 31 OE340 05270ONOPNORD D 01N70N82 OE340 0005280O AND N83N84N73 OE340 05290O AND N69 OE340 05300O ALL 119 OE340 05310O D 02N70N82 OE340 05320O AND N83N84N73 OE340 05330O AND N69 OE340 05340O ALL 119 OE340 0005350O D 03N70N82 OE340 05360O AND N83N84N73 OE340 05370O AND N69 OE340 05380O ALL 119 OE340 05390O D 05N70N82 OE340 05400O AND N83N84N73 OE340 05410O AND N69 OE340 0005420O ALL 119 OE340 05430O 71 ZROS 44 OE340 05435O 71 SHIPTD 37 05437O 71 INDEX 112 05440O D 06N70N82 OE340 05450O AND N83N84N73 OE340 05460O AND N69 OE340 0005470O ALL 119 OE340 ** 005480ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005490ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005500ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005510ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005520/* 00553000_ __EQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005500ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005510ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005520/* 0055300(T TTXOE510 P 999999032778(000010H S OE510 00020X DECK-ID A71 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE510 00030F* MONTH-END UPDATE OF SALES ANALYSIS FIELDS IN CONTROL AND ARMAST OE510 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE510 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE510 00060F* CONTROL DATA PROPRIETARY PRODUCT OE510 00070F* OE510 0000080FSMTHIN IPEAF 74 DISK OE510 00090FARMAST USEAF 280 6AI 1 DISK OE510 00100FCONTROL UC F 256R 7AI 1 DISK OE510 00110FHEADING IT F 40 EDISK OE510 00120F$LP1 O F 132 OF PRINTER OE510 00130F********************************************************************OE510 00140F* OE510 0000150F* PACKAGE DISTRIBUTION OE510 00160F* SYSTEM SALES ANALYSIS OE510 00170F* PROGRAM MONTH/END UPDATING OF SALES ANALYSIS FIELDS IN OE510 00180F* CONTROL AND ARMAST OE510 00190F* OE510 00200F* CONTRACTOR COMPUSOURCE OE510 00210F* PROGRAMMER KATHY HILL OE510 0000220F* DATE JUNE 17, 1976 OE510 00230F* OE510 00240F********************************************************************OE510 00250F* OE510 00260F* NARRATIVE: OE510 00270F* OE510 00280F* THIS PROGRAM SHOULD ONLY BE RUN ONCE AT MONTH/END TO ACCOMPLISH OE510 0000290F* THE MONTH/END UPDATING OF ARMAST AND CONTROL. OE510 00300F* -----------------------------------------------------------------OE510 00310F* THE DETERMINATION OF THE NEW REFERENCE MONTH (ARMAST) FIELD FOR OE510 00320F* THE CONTROL FILE AND OF THE NEW REFERENCE YEAR (ARMAST) FIELD OE510 00330F* FOR THE CONTROL FILE BY USE OF THE OLD REFERENCE MONTH (ARMAST) OE510 00340F* FIELD FROM THE CONTROL FILE, THE OLD REFERENCE YEAR (ARMAST) OE510 00350F* FIELD FROM THE CONTROL FILE, THE IPL MONTH, AND THE IPL YEAR OE510 0000360F* IS DONE ONCE ONLY [AT THE START OF THE PROGRAM]. OE510 00370F* OE510 00380F* CHAINS TO THE CONTROL FILE. IF CHAIN TO CONTROL GETS A MISS, OE510 00390F* THEN H3 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. AFTER OE510 00400F* CONTROL IS ON SYSTEM, OPERATOR CAN RETRY THE PROGRAM. OE510 00410F* OE510 00420F* CHECKS THAT [ 1 <= IPL-MONTH <= 12 ] AND [ 70 <= IPL-YEAR ]. OE510 0000430F* IF EITHER IS OUT OF BOUNDS, THEN H1 IS SET ON AND THE PROGRAM OE510 00440F* SHOULD BE CANCELLED. THE OPERATOR SHOULD IPL CORRECTLY BEFORE OE510 00450F* RETRYING THE PROGRAM. OE510 00460F* OE510 00470F* IF (1) THE REFERENCE MONTH (ARMAST) FIELD IN CONTROL AND/OR OE510 00480F* THE REFERENCE YEAR (ARMAST) FIELD IN CONTROL = 0 OE510 00490F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE510 0000500F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (ARMAST) OE510 00510F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE510 00520F* YEAR (ARMAST) IN CONTROL. OE510 00530F* OE510 00540F* IF (1) THE REFERENCE MONTH (ARMAST) FIELD IN CONTROL AND OE510 00550F* THE REFERENCE YEAR (ARMAST) FIELD IN CONTROL ARE OE510 00560F* NON-ZERO OE510 0000570F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE510 00580F* AND (3) THE IPL MONTH/YEAR COMBINATION CHRONOLOGICALLY OE510 00590F* FOLLOWS THE (ARMAST) REFERENCE MONTH/YEAR COMBINATION OE510 00600F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (ARMAST) OE510 00610F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE510 00620F* YEAR (ARMAST) IN CONTROL. OE510 00630F* OE510 0000640F* IF (1) THE REFERENCE MONTH (ARMAST) FIELD IN CONTROL AND OE510 00650F* THE REFERENCE YEAR (ARMAST) FIELD IN CONTROL ARE OE510 00660F* NON-ZERO OE510 00670F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE510 00680F* BUT (3) THE IPL MONTH/YEAR COMBINATION DOES NOT OE510 00690F* --- OE510 00700F* CHRONOLOGICALLY FOLLOW THE (ARMAST) REFERENCE OE510 0000710F* MONTH/YEAR COMBINATION OE510 00720F* THEN H2 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. OE510 00730F* OPERATOR CAN CHECK CONTROL, IPL CORRECTLY, AND RETRY THE OE510 00740F* PROGRAM. OE510 00750F* -----------------------------------------------------------------OE510 00760F* ALL SALES AGAINST GIVEN CUSTOMER # ARE SUMMED INTO ONE FIGURE. OE510 00770F* -----------------------------------------------------------------OE510 0000780F* IF IT'S JANUARY, THEN THE YTD $ SALES (LAST YEAR) FIELD IS OE510 00790F* ZEROED-OUT. OE510 00800F* -----------------------------------------------------------------OE510 00810F* ARRAY: ELEMENT 11 --> POSITION 12 OE510 00820F* ELEMENT 10 --> POSITION 11 OE510 00830F* ELEMENT 9 --> POSITION 10 OE510 00840F* ELEMENT 8 --> POSITION 9 OE510 0000850F* ELEMENT 7 --> POSITION 8 OE510 00860F* ELEMENT 6 --> POSITION 7 OE510 00870F* ELEMENT 5 --> POSITION 6 OE510 00880F* ELEMENT 4 --> POSITION 5 OE510 00890F* ELEMENT 3 --> POSITION 4 OE510 00900F* ELEMENT 2 --> POSITION 3 OE510 00910F* ELEMENT 1 --> POSITION 2 OE510 0000920F* -----------------------------------------------------------------OE510 00930F* OLD MTD $ SALES (THIS YEAR) INTO POSITION 1 OF SALES ARRAY OE510 00940F* -----------------------------------------------------------------OE510 00950F* IF ANY SALES TO THIS CUSTOMER, TOTAL FIGURE INTO OE510 00960F* MTD $ SALES (THIS YEAR) FIELD. IF THERE WERE NO SALES TO OE510 00970F* THIS CUSTOMER THIS MONTH, THEN THE MTD $ SALES (THIS YEAR) OE510 00980F* FIELD IS ZEROED-OUT. OE510 0000990F* -----------------------------------------------------------------OE510 01000F* YTD $ SALES (LAST YEAR) = YTD $ SALES (LAST YEAR) + OE510 01010F* 12TH ELEMENT OF SALES ARRAY OE510 01020F* -----------------------------------------------------------------OE510 01030F* IPL MONTH --> NEW (ARMAST) REFERENCE MONTH FOR CONTROL OE510 01040F* IPL YEAR --> NEW (ARMAST) REFERENCE YEAR FOR CONTROL OE510 01050F* OE510 0001060F********************************************************************OE510 01070F* ID F C H L FUNCTION OF INDICATORS OE510 01080F* OE510 01090F* 01 SMTHIN OE510 01100F* 02 ARMAST OE510 01110F* 03 CONTROL OE510 01120F* 10 OLD REFERENCE YEAR (ARMAST) FIELD IN CONTROL = 0 OE510 0001130F* 11 OLD REFERENCE MONTH (ARMAST) FIELD IN CONTROL = 0 OE510 01140F* 30 LOOP INCREMENT WATCHER OE510 01150F* N90 SALES FOR A CUSTOMER # WITH THAT CUSTOMER # NOT OE510 01160F* ON ARMAST OE510 01170F* 95 IPL MONTH = 01 [JANUARY] OE510 01180F* 99 GROUP OF CALCS TO BE PERFORMED ONCE ONLY OE510 01190F* H1 IPL_MONTH AND/OR IPL_YEAR OUT OF BOUNDS OE510 0001200F* H2 IPL MONTH/YEAR COMBINATION DOES NOT CHRONOLOGICALLY OE510 01210F* FOLLOW (ARMAST) REFERENCE MONTH/YEAR COMBINATION OE510 01220F* H3 CHAIN TO CONTROL GOT A MISS OE510 01230F* OE510 01240F********************************************************************OE510 01250E TS 12 7 0 OE510 01260E HEADING HEAD 1 1 40 COMPANY NAME OE510 0001270ISMTHIN NS 01 OE510 01280I 1 50INVNUM OE510 01290I 6 100CUSTNOL1M1 OE510 01300I 11 160INVDAT OE510 01310I 17 190SLSMAN OE510 01320I 20 260QTY OE510 01330I 55 74 PARTNO OE510 0001340I 39 452NETSLS OE510 01350I 46 523UNCOST OE510 01360I 53 54 AREA OE510 01370IARMAST NS 02 OE510 01380I 2 60CUSTNOL1M1 OE510 01390I 264 2700OLDMTD OE510 01400I 271 2720OLDMTH OE510 0001410I 173 256 TS OE510 01420I 257 2630OLDYTD OE510 01430ICONTROL NS 03 OE510 01440I 13 140OLDYR 10 OE510 01450I 15 160OLDMTH 11 OE510 01460C 99 GOTO START OE510 01470C* OE510 0001480C MOVE 'CONTROL' KEY 7 OE510 01490C KEY CHAINCONTROL H3 BETTER FIND! OE510 01500C H3 GOTO FINI OE510 01510C* OE510 01520C MOVELUDATE MONTH 20 OE510 01530C MOVE UDATE YEAR 20 OE510 01540C* OE510 0001550C MONTH COMP 1 H1 OE510 01560C NH1 MONTH COMP 12 H1 OE510 01570C NH1 YEAR COMP 70 H1 OE510 01580C H1 GOTO FINI OE510 01590C* OE510 01600C 10 OE510 01610COR 11 GOTO NEXT OE510 0001620C* OE510 01630C MONTH COMP 1 95JANUARY OE510 01640C N95 MONTH SUB 1 CHKMTH 20 OE510 01650C 95 Z-ADD12 CHKMTH OE510 01660C OLDMTH COMP CHKMTH H2H2 OE510 01670C H2 GOTO FINI OE510 01680C N95 Z-ADDYEAR CHKYR 20 OE510 0001690C 95 YEAR SUB 1 CHKYR OE510 01700C OLDYR COMP CHKYR H2H2 OE510 01710C H2 GOTO FINI OE510 01720C* OE510 01730C NEXT TAG OE510 01740C* OE510 01750C Z-ADDMONTH NEWMTH 20 OE510 0001760C Z-ADDYEAR NEWYR 20 OE510 01770C SETON 99 OE510 01780C START TAG OE510 01790C L1 Z-ADD0 SLS 82 OE510 01800C L1 SETOF 90 OE510 01810C 01 NETSLS ADD CUMSLS CUMSLS 92 OE510 01820C 01 NETSLS ADD SLS SLS OE510 0001830C N02 GOTO FINI OE510 01840C SETON 90 OE510 01850C 95 Z-ADD0 OLDYTD JANUARY OE510 01860C Z-ADD12 N 20 OE510 01870C LOOP TAG OE510 01880C N SUB 1 M 20 OE510 01890C MOVE TS,M KWATCH 70 OE510 0001900C MOVE KWATCH TS,N OE510 01910C MOVE M N OE510 01920C M COMP 1 30 OE510 01930C N30 GOTO LOOP OE510 01940C MOVE OLDMTD TS,1 OE510 01950C OLDYTD ADD TS,12 NEWYTD 70 OE510 01960C SLS MULT 1 TOTSLS 70H OE510 0001970C FINI TAG OE510 01980OARMAST D 02 OE510 01990O TOTSLS B 270 OE510 02000O TS 256 OE510 02010O NEWYTD 263 OE510 02020OCONTROL D 03 OE510 02030O NEWYR 14 OE510 0002040O NEWMTH 16 OE510 02050O$LP1 H 202 1P OE510 02060O OR OF OE510 02070O PAGE Z 8 OE510 02080O 4 'PAGE' OE510 02090O HEAD,1 86 OE510 02100O UDATE Y 132 OE510 0002110O H 2 1P OE510 02120O OR OF OE510 02130O 69 'MONTH END SALES ANALYSIS' OE510 02140O 88 'UPDATE BY CUSTOMER' OE510 02150O 132 'DIS510' OE510 02160O T 1 L1N90 OE510 02170O 6 'CUST #' OE510 0002180O CUSTNO3 12 OE510 02190O 25 'NOT ON FILE.' OE510 02200O 40 'SALES WERE $' OE510 02210O TOTSLSJB 51 OE510 02220O 52 '.' OE510 02230O T 2 LR OE510 02240O 24 'END OF JOB. TOTAL SALES' OE510 0002250O 43 'THIS MONTH WERE $' OE510 02260O CUMSLSJ 57 OE510 02270O 58 '.' OE510 ** 002280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00231000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002320/* 002330_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(J JTXOE520 P999999032778(000010H S OE520 00020X DECK-ID A72 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE520 00030F* MONTH-END UPDATE OF SALES ANALYSIS FIELDS IN CONTROL AND SAMAST OE520 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE520 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE520 00060F* CONTROL DATA PROPRIETARY PRODUCT OE520 00070F* OE520 0000080FSMTHIN IPEAF 74 DISK OE520 00090FSAMAST ISEAF 140 20AI 121 DISK OE520 00100FCONTROL UC F 256R 7AI 1 DISK OE520 00110FHEADING IT F 40 EDISK OE520 00120FSAMOUT O F 140 DISK OE520 00130F$LP1 O F 132 OF PRINTER OE520 00140F********************************************************************OE520 0000150F* OE520 00160F* PACKAGE DISTRIBUTION OE520 00170F* SYSTEM SALES ANALYSIS OE520 00180F* PROGRAM MONTH/END UPDATING OF SALES ANALYSIS FIELDS IN OE520 00190F* CONTROL AND SAMAST OE520 00200F* OE520 00210F* CONTRACTOR COMPUSOURCE OE520 0000220F* PROGRAMMER KATHY HILL OE520 00230F* DATE JUNE 17, 1976 OE520 00240F* OE520 00250F********************************************************************OE520 00260F* OE520 00270F* NARRATIVE: OE520 00280F* OE520 0000290F* THIS PROGRAM SHOULD ONLY BE RUN ONCE AT MONTH/END TO ACCOMPLISH OE520 00300F* THE MONTH/END UPDATING OF SAMAST AND CONTROL. OE520 00310F* -----------------------------------------------------------------OE520 00320F* THE DETERMINATION OF THE NEW REFERENCE MONTH (SAMAST) FIELD FOR OE520 00330F* THE CONTROL FILE AND OF THE NEW REFERENCE YEAR (SAMAST) FIELD OE520 00340F* FOR THE CONTROL FILE BY USE OF THE OLD REFERENCE MONTH (SAMAST) OE520 00350F* FIELD FROM THE CONTROL FILE, THE OLD REFERENCE YEAR (SAMAST) OE520 0000360F* FIELD FROM THE CONTROL FILE, THE IPL MONTH, AND THE IPL YEAR OE520 00370F* IS DONE ONLY ONCE [AT THE START OF THE PROGRAM]. OE520 00380F* OE520 00390F* CHAINS TO THE CONTROL FILE. IF CHAIN TO CONTROL GETS A MISS, OE520 00400F* THEN H3 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. AFTER OE520 00410F* CONTROL IS ON SYSTEM, OPERATOR CAN RETRY THE PROGRAM. OE520 00420F* OE520 0000430F* CHECKS THAT [ 1 <= IPL_MONTH <= 12 ] AND [ 70 <= IPL_YEAR ]. OE520 00440F* IF EITHER IS OUT OF BOUNDS, THEN H1 IS SET ON AND THE PROGRAM OE520 00450F* SHOULD BE CANCELLED. THE OPERATOR SHOULD IPL CORRECTLY OE520 00460F* BEFORE RETRYING THE PROGRAM. OE520 00470F* OE520 00480F* IF (1) THE REFERENCE MONTH (SAMAST) FIELD IN CONTROL AND/OR OE520 00490F* THE REFERENCE YEAR (SAMAST) FIELD IN CONTROL = 0 OE520 0000500F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE520 00510F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (SAMAST) OE520 00520F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE520 00530F* YEAR (SAMAST) IN CONTROL. OE520 00540F* OE520 00550F* IF (1) THE REFERENCE MONTH (SAMAST) FIELD IN CONTROL AND OE520 00560F* THE REFERENCE YEAR (SAMAST) FIELD IN CONTROL ARE OE520 0000570F* NON-ZERO OE520 00580F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE520 00590F* AND (3) THE IPL MONTH/YEAR COMBINATION CHRONOLIGICALLY OE520 00600F* FOLLOWS THE (SAMAST) REFERENCE MONTH/YEAR COMBINATION OE520 00610F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (SAMAST) OE520 00620F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE520 00630F* YEAR (SAMAST) IN CONTROL. OE520 0000640F* OE520 00650F* IF (1) THE REFERENCE MONTH (SAMAST) FIELD IN CONTROL AND OE520 00660F* THE REFERENCE YEAR (SAMAST) FIELD IN CONTROL ARE OE520 00670F* NON-ZERO OE520 00680F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE520 00690F* BUT (3) THE IPL MONTH/YEAR COMBINATION DOES NOT OE520 00700F* --- OE520 0000710F* CHRONOLOGICALLY FOLLOW THE (SAMAST) REFERENCE OE520 00720F* MONTH/YEAR COMBINATION OE520 00730F* THEN H2 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. OE520 00740F* OPERATOR CAN CHECK CONTROL, IPL CORRECTLY, AND RETRY THE OE520 00750F* PROGRAM. OE520 00760F* -----------------------------------------------------------------OE520 00770F* ALL SALES AGAINST GIVEN CUSTOMER # ARE SUMMED INTO ONE FIGURE. OE520 0000780F* -----------------------------------------------------------------OE520 00790F* IF IT'S JANUARY, THEN THE YTD QTY SALES (LAST YEAR) FIELD IS OE520 00800F* ZEROED-OUT. OE520 00810F* -----------------------------------------------------------------OE520 00820F* ARRAY: ELEMENT 11 --> POSITION 12 OE520 00830F* ELEMENT 10 --> POSITION 11 OE520 00840F* ELEMENT 9 --> POSITION 10 OE520 0000850F* ELEMENT 8 --> POSITION 9 OE520 00860F* ELEMENT 7 --> POSITION 8 OE520 00870F* ELEMENT 6 --> POSITION 7 OE520 00880F* ELEMENT 5 --> POSITION 6 OE520 00890F* ELEMENT 4 --> POSITION 5 OE520 00900F* ELEMENT 3 --> POSITION 4 OE520 00910F* ELEMENT 2 --> POSITION 3 OE520 0000920F* ELEMENT 1 --> POSITION 2 OE520 00930F* -----------------------------------------------------------------OE520 00940F* OLD MTD QTY SALES (THIS YEAR) INTO POSITION 1 OF SALES ARRAY OE520 00950F* -----------------------------------------------------------------OE520 00960F* IF ANY SALES TO THIS CUSTOMER, TOTAL FIGURE INTO OE520 00970F* MTD QTY SALES (THIS YEAR) FIELD. IF THERE WERE NO SALES TO OE520 00980F* THIS CUSTOMER THIS MONTH, THEN THE MTD QTY SALES (THIS YEAR) OE520 0000990F* FIELD IS ZEROED-OUT. OE520 01000F* -----------------------------------------------------------------OE520 01010F* YTD QTY SALES (THIS YEAR) = YTD QTY SALES (THIS YEAR) + OE520 01020F* 12TH ELEMENT OF SALES ARRAY OE520 01030F* -----------------------------------------------------------------OE520 01040F* IPL MONTH --> NEW (SAMAST) REFERENCE MONTH FOR CONTROL OE520 01050F* IPL YEAR --> NEW (SAMAST) REFERENCE YEAR FOR CONTROL OE520 0001060F* OE520 01070F********************************************************************OE520 01080F* ID F C H L FUNCTION OF INDICATORS OE520 01090F* OE520 01100F* 01 SMTHIN OE520 01110F* 02 SAMAST OE520 01120F* 03 CONTROL OE520 0001130F* 10 OLD REFERENCE YEAR (SAMAST) FIELD IN CONTROL = 0 OE520 01140F* 11 OLD REFERENCE MONTH (SAMAST) FIELD IN CONTROL = 0 OE520 01150F* 30 LOOP INCREMENT WATCHER OE520 01160F* 95 IPL MONTH = 01 [JANUARY] OE520 01170F* 99 GROUP OF CALCS TO BE PERFORMED ONLY ONCE OE520 01180F* H1 IPL_MONTH AND/OR IPL_YEAR OUT OF BOUNDS OE520 01190F* H2 IPL MONTH/YEAR COMBINATION DOES NOT CHRONOLOGICALLY OE520 0001200F* FOLLOW (SAMAST) REFERENCE MONTH/YEAR COMBINATION OE520 01210F* H3 CHAIN TO CONTROL GOT A MISS OE520 01220F* OE520 01230F********************************************************************OE520 01240E TS 12 7 0 OE520 01250E HEADING HEAD 1 1 40 COMPANY NAME OE520 01260ISMTHIN NS 01 OE520 0001270I 1 50INVNUM OE520 01280I 6 100CUSTNO OE520 01290I 11 160INVDAT OE520 01300I 17 190SLSMAN OE520 01310I 20 260QTY OE520 01320I 55 74 PARTNOL1M1 OE520 01330I 39 452NETSLS OE520 0001340I 46 523UNCOST OE520 01350I 53 54 AREA OE520 01360ISAMAST NS 02 OE520 01370I 121 140 PARTNOL1M1 OE520 01380I 13 190OLDMTD OE520 01390I 20 210OLDMTH OE520 01400I 22 105 TS OE520 0001410I 106 1130OLDYTD OE520 01420ICONTROL NS 03 OE520 01430I 17 180OLDYR 10 OE520 01440I 19 200OLDMTH 11 OE520 01450C 99 GOTO START OE520 01460C* OE520 01470C* OE520 0001480C MOVE 'CONTROL' KEY 7 OE520 01490C KEY CHAINCONTROL H3 BETTER FIND! OE520 01500C H3 GOTO FINI OE520 01510C* OE520 01520C MOVELUDATE MONTH 20 OE520 01530C MOVE UDATE YEAR 20 OE520 01540C* OE520 0001550C MONTH COMP 1 H1 OE520 01560C NH1 MONTH COMP 12 H1 OE520 01570C NH1 YEAR COMP 70 H1 OE520 01580C H1 GOTO FINI OE520 01590C* OE520 01600C 10 OE520 01610COR 11 GOTO NEXT OE520 0001620C* OE520 01630C MONTH COMP 1 95JANUARY OE520 01640C N95 MONTH SUB 1 CHKMTH 20 OE520 01650C 95 Z-ADD12 CHKMTH OE520 01660C OLDMTH COMP CHKMTH H2H2 OE520 01670C H2 GOTO FINI OE520 01680C N95 Z-ADDYEAR CHKYR 20 OE520 0001690C 95 YEAR SUB 1 CHKYR OE520 01700C OLDYR COMP CHKYR H2H2 OE520 01710C H2 GOTO FINI OE520 01720C* OE520 01730C NEXT TAG OE520 01740C* OE520 01750C Z-ADDMONTH NEWMTH 20 OE520 0001760C Z-ADDYEAR NEWYR 20 OE520 01770C SETON 99 OE520 01780C START TAG OE520 01790C L1 Z-ADD0 TOTQTY 70 OE520 01800C 01 L1NMR Z-ADD0 TS OE520 01810C 01 L1NMR Z-ADD0 NEWYTD 80 OE520 01820C 01 QTY ADD TOTQTY TOTQTY OE520 0001830C 01 NETSLS ADD CUMSLS CUMSLS 92 OE520 01840C N02 GOTO FINI OE520 01850C 95 Z-ADD0 OLDYTD JANUARY OE520 01860C Z-ADD12 N 20 OE520 01870C LOOP TAG OE520 01880C N SUB 1 M 20 OE520 01890C MOVE TS,M KWATCH 70 OE520 0001900C MOVE KWATCH TS,N OE520 01910C MOVE M N OE520 01920C M COMP 1 30 OE520 01930C N30 GOTO LOOP OE520 01940C MOVE OLDMTD TS,1 OE520 01950C OLDYTD ADD TS,12 NEWYTD OE520 01960C FINI TAG OE520 0001970OSAMOUT T L1 OE520 01980O PARTNO 140 OE520 01990O TOTQTY B 19 OE520 02000O TS 105 OE520 02010O NEWYTD 113 OE520 02020OCONTROL D 03 OE520 02030O NEWYR 18 OE520 0002040O NEWMTH 20 OE520 02050O$LP1 H 202 1P OE520 02060O OR OF OE520 02070O PAGE Z 8 OE520 02080O 4 'PAGE' OE520 02090O HEAD,1 86 OE520 02100O UDATE Y 132 OE520 0002110O H 2 1P OE520 02120O OR OF OE520 02130O 68 'MONTH END SALES ANALYSIS' OE520 02140O 86 'UPDATE BY PRODUCT' OE520 02150O 132 'DIS520' OE520 02160O T 2 LR OE520 02170O 24 'END OF JOB. TOTAL SALES' OE520 0002180O 43 'THIS MONTH WERE $' OE520 02190O CUMSLSJ 57 OE520 02200O 58 '.' OE520 ** 002210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00224000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002250/* 002260_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(1 TXOE550 P999999032778(000010H S OE550 00020X DECK-ID A73 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE550 00030F* PRINTS SALES ANALYSIS (NU1) AND HISTORY (U1) BY CUSTOMER NUMBER OE550 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE550 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE550 00060F* CONTROL DATA PROPRIETARY PRODUCT OE550 00070F* OE550 0000080FARMAST IPEAF 280 6AI 1 DISK OE550 00090FCONTROL IC F 256R 7AI 1 DISK OE550 00100FHEADING IT F 40 EDISK OE550 00110F$LP1 O F 132 OF LPRINTER OE550 00120F********************************************************************OE550 00130F* OE550 00140F* PACKAGE DISTRIBUTION OE550 0000150F* SYSTEM SALES ANALYSIS OE550 00160F* PROGRAM HISTORICAL SALES ANALYSIS REPORT BY CUSTOMER # (U1) OE550 00170F* COMPARATIVE SALES ANALYSIS REPORT BY CUSTOMER # (NU1) OE550 00180F* OE550 00190F* CONTRACTOR COMPUSOURCE OE550 00200F* PROGRAMMER KATHY HILL OE550 00210F* DATE JUNE 16, 1976 OE550 0000220F* OE550 00230F********************************************************************OE550 00240E HEADING HEAD 1 1 40 COMPANY NAME OE550 00250E TS 12 7 0 LAST 12 MTH SALESOE550 00260E GS 12 8 0 LR TOTALS OE550 00270E TD 12 2 0 OE550 00280L$LP1 66FL050OL OE550 0000290IARMAST NS 01 OE550 00300I 2 60CUSTNO OE550 00310I 7 30 CNAME OE550 00320I 264 2700MTD OE550 00330I 173 256 TS OE550 00340I 257 2630YTDLST OE550 00350ICONTROL NS 02 OE550 0000360I 13 140REFYR OE550 00370I 15 160REFMTH OE550 00380C********************************************************************OE550 00390C* OE550 00400C* THIS BLOCK OF LOGIC IS EXECUTED ONCE ONLY AT THE START OE550 00410C* OF THE PROGRAM. OE550 00420C* OE550 0000430C* IT CHAINS TO THE CONTROL FILE WITH THE KEY 'CONTROL' OE550 00440C* AND FETCHES THE REFERENCE MONTH (ARMAST) AND THE OE550 00450C* REFERENCE YEAR (ARMAST). OE550 00460C* OE550 00470C* IF THE 'CONTROL' RECORD IS MISSING, THEN H1 IS SET ON OE550 00480C* AND THE PROGRAM SHOULD BE CANCELLED. OE550 00490C* OE550 0000500C* IF THE REFERENCE MONTH (ARMAST) AND/OR THE OE550 00510C* REFERENCE YEAR (ARMAST) IS ZERO, THEN H2 IS SET ON OE550 00520C* AND THE PROGRAM SHOULD BE CANCELLED. OE550 00530C* OE550 00540C* USING THE REFERENCE MONTH (ARMAST) AND THE OE550 00550C* REFERENCE YEAR (ARMAST), THE PROGRAM DECIDES WHICH OE550 00560C* MONTH'S SALES FIGURE ($) IS HELD BY EACH OF THE OE550 0000570C* ELEMENTS OF THE SALES HISTORY ARRAY ($) OF ARMAST; OE550 00580C* USING THE MONTH/YEAR FROM CONTROL, THE PROGRAM OE550 00590C* ALSO DECIDES WHETHER THE RESPECTIVE MONTH WAS IN THE REFERENCE OE550 00600C* YEAR OR IN THE YEAR PRECEDING THE REFERENCE YEAR. OE550 00610C* OE550 00620C********************************************************************OE550 00630C* OE550 0000640C 97 SETOF 97 OE550 00650C 99 GOTO START OE550 00660C SETON 9799 OE550 00670C* OE550 00680C MOVEL'CONTROL' KEY 7 OE550 00690C KEY CHAINCONTROL H1 OE550 00700C NH1 REFYR COMP 0 H2 OE550 0000710C NH1NH2 REFMTH COMP 0 H2 OE550 00720C* OE550 00730C H1 OE550 00740COR H2 GOTO FINI OE550 00750C* OE550 00760C REFMTH SUB 1 LSTMTH 20 OE550 00770C REFYR SUB 1 LSTYR 20 OE550 0000780C* OE550 00790C Z-ADD1 INX 20 OE550 00800C MOVE LSTMTH MONTH 20 OE550 00810C* OE550 00820C LOOP1 TAG OE550 00830C* OE550 00840C MONTH COMP 0 98 OE550 0000850C 98 MOVE REFYR TD,INX OE550 00860C N98 MOVE LSTYR TD,INX OE550 00870C INX COMP 12 98 OE550 00880C 98 GOTO GETOUT OE550 00890C INX ADD 1 INX OE550 00900C MONTH SUB 1 MONTH OE550 00910C GOTO LOOP1 OE550 0000920C* OE550 00930C GETOUT TAG OE550 00940C* OE550 00950C********************************************************************OE550 00960C* OE550 00970C* ACCORDING TO WHETHER THE SWITCH SETTING IS U1 OR NU1, OE550 00980C* THE PROPER SUBROUTINES ARE EXECUTED. OE550 0000990C* OE550 01000C********************************************************************OE550 01010C* OE550 01020C START TAG OE550 01030C* OE550 01040C NU1 EXSR SASR OE550 01050C NU1 EXSR STOT OE550 0001060C U1 EXSR HSTSR OE550 01070C U1 EXSR HTOT OE550 01080C* OE550 01090C FINI TAG OE550 01100C* OE550 01110CLRNU1 EXSR PCT OE550 01120C* OE550 0001130C********************************************************************OE550 01140C* OE550 01150C* THIS SUBROUTINE SUMS ALL OF THE ELEMENTS OF THE SALES OE550 01160C* HISTORY ARRAY INTO A SINGLE FIGURE, LAST12. OE550 01170C* OE550 01180C* THEN, SOLELY FOR THE PURPOSES OF THE REPORT, THE OE550 01190C* ELEMENTS OF THE SALES HISTORY ARRAY ARE ROTATED. OE550 0001200C* THE PURPOSE OF THE ROTATION IS TO HAVE THE ELEMENTS OE550 01210C* OF THE ARRAY HOLDING THE SALES FIGURES FOR THE OE550 01220C* MONTHS IN DESCENDING ORDER; ELEMENT 1 HOLDING THE SALES FIGURE OE550 01230C* FOR THE MONTH OF DECEMBER, ELEMENT 2 HOLDING THE SALES OE550 01240C* FIGURE FOR THE MONTH OF NOVEMBER, ETC. OE550 01250C* IN THIS MANNER, THE PROGRAM CAN ALWAYS PRINT OE550 01260C* OUT THE SALES FIGURES JANUARY TO DECEMBER (THE OE550 0001270C* APPROPRIATE YEAR IS PRINTED BESIDE EACH MONTH IN THE HEADINGS). OE550 01280C* THE REFERENCE MONTH FROM CONTROL GUIDES THE OE550 01290C* SUBROUTINE IN THE ROTATION OF THE ARRAY. OE550 01300C* THE ROTATION IS ACCOMPLISHED THROUGH A NESTED LOOP. OE550 01310C* EACH PASS THROUGH THE INNER LOOP MANAGES TO OE550 01320C* ROTATE THE ELEMENTS IN THE ARRAY BY ONE POSITION ONLY OE550 01330C* (EX: MOVING ARRAY,2 INTO ARRAY,1) OE550 0001340C* AND THE REFERENCE MONTH IS USED (IN THE OUTER LOOP) OE550 01350C* TO TELL THE SUBROUTINE HOW MANY TIMES IT MUST OE550 01360C* ROTATE THE ELEMENTS OF THE ARRAY. OE550 01370C* OE550 01380C* OE550 01390C* OE550 01400CSR HSTSR BEGSR OE550 0001410C* OE550 01420CSR XFOOTTS LAST12 80 OE550 01430C* OE550 01440CSR MOVE LSTMTH MONTH OE550 01450C* OE550 01460CSR LOOP2 TAG OE550 01470C* OE550 0001480CSR MONTH SUB 1 MONTH OE550 01490CSR MONTH COMP 0 98 OE550 01500CSR 98 GOTO OUT1 OE550 01510CSR Z-ADD1 INX OE550 01520CSR MOVE TS,INX WRK7 70 OE550 01530C* OE550 01540CSR LOOP3 TAG OE550 0001550C* OE550 01560CSR INX ADD 1 IN2 20 OE550 01570CSR MOVE TS,IN2 KWATCH 70 OE550 01580CSR MOVE KWATCH TS,INX OE550 01590CSR IN2 COMP 12 98 OE550 01600CSR 98 MOVE WRK7 TS,12 OE550 01610CSR 98 GOTO LOOP2 OE550 0001620CSR MOVE IN2 INX OE550 01630CSR GOTO LOOP3 OE550 01640C* OE550 01650CSR OUT1 ENDSR OE550 01660C* OE550 01670C********************************************************************OE550 01680C* OE550 0001690C* THIS SUBROUTINE FIGURES THE % INCREASE IN SALES FROM OE550 01700C* LAST MONTH (1ST ELEMENT OF SALES ARRAY) TO THIS MONTH OE550 01710C* (MTD SALES). OE550 01720C* OE550 01730C* IT FIGURES THE % INCREASE IN SALES FROM THE OE550 01740C* CURRENT MONTH THIS YEAR (MTD SALES) COMPARED TO THE OE550 01750C* CURRENT MONTH LAST YEAR (12TH ELEMENT OF SALES ARRAY). OE550 0001760C* OE550 01770C* IT CALCULATES YTD SALES THIS YEAR = MTD SALES + OE550 01780C* VALUES FROM ALL OF THE ELEMENTS OF THE SALES ARRAY WHICH OE550 01790C* HOLD SALES FIGURES FOR MONTHS OF THE REFERENCE YEAR. OE550 01800C* IT THEN FIGURES THE % INCREASE IN SALES OF YTD SALES THIS YEAR OE550 01810C* COMPARED TO YTD SALES LAST YEAR (YTD SALES LAST YEAR). OE550 01820C* OE550 0001830C********************************************************************OE550 01840C* OE550 01850CSR SASR BEGSR OE550 01860C* OE550 01870CSR MTD SUB TS,1 WRK7 70 OE550 01880CSR WRK7 DIV TS,1 WRKPCT 53H OE550 01890CSR WRKPCT MULT 100 PCT1 41 OE550 0001900CSR WRK7 COMP 0 5051 OE550 01910CSR 50 OE550 01920COR 51 TS,1 COMP 0 52 OE550 01930CSR 50 52 Z-ADD100 PCT1 OE550 01940CSR 51 52 Z-SUB100 PCT1 OE550 01950C* OE550 01960CSR MTD SUB TS,12 WRK7 OE550 0001970CSR WRK7 DIV TS,12 WRKPCT H OE550 01980CSR WRKPCT MULT 100 PCT2 41 OE550 01990CSR WRK7 COMP 0 5051 OE550 02000CSR 50 OE550 02010COR 51 TS,12 COMP 0 52 OE550 02020CSR 50 52 Z-ADD100 PCT2 OE550 02030CSR 51 52 Z-SUB100 PCT2 OE550 0002040C* OE550 02050CSR Z-ADD0 YTDCUR 80 OE550 02060CSR MTD ADD YTDCUR YTDCUR OE550 02070CSR Z-ADD1 INX OE550 02080C* OE550 02090CSR LOOP4 TAG OE550 02100C* OE550 0002110CSR LSTMTH COMP INX 98 OE550 02120CSR 98 GOTO OUT2 OE550 02130CSR TS,INX ADD YTDCUR YTDCUR OE550 02140CSR INX ADD 1 INX OE550 02150CSR GOTO LOOP4 OE550 02160C* OE550 02170CSR OUT2 TAG OE550 0002180C* OE550 02190CSR YTDCUR SUB YTDLST WRK7 OE550 02200CSR WRK7 DIV YTDLST WRKPCT H OE550 02210CSR WRKPCT MULT 100 PCT3 41 OE550 02220CSR WRK7 COMP 0 5051 OE550 02230CSR 50 OE550 02240COR 51 YTDLST COMP 0 52 OE550 0002250CSR 50 52 Z-ADD100 PCT3 OE550 02260CSR 51 52 Z-SUB100 PCT3 OE550 02270C* OE550 02280CSR ENDSR OE550 02290C* OE550 02300C********************************************************************OE550 02310C* OE550 0002320C* THIS SUBROUTINE KEEPS RUNNING TOTALS. OE550 02330C* THEN THE COMPANY SALES HISOTRY IS PRINTED OUT AT THE END OF THE OE550 02340C* REPORT BY USE OF THESE VALUES. OE550 02350C* OE550 02360C********************************************************************OE550 02370C* OE550 02380CSR HTOT BEGSR OE550 0002390C* OE550 02400CSR MTD ADD HT1 HT1 80 OE550 02410CSR LAST12 ADD HT2 HT2 80 OE550 02420CSR TS ADD GS GS OE550 02430C* OE550 02440CSR ENDSR OE550 02450C* OE550 0002460C********************************************************************OE550 02470C* OE550 02480C* THIS SUBROUTINE KEEPS RUNNING TOTALS. OE550 02490C* THE FIGURES FOR SALES INCREASES BY % THAT WERE OE550 02500C* CALCULATED FOR AN INDIVIDUAL CUSTOMER IN SASR CAN THEN OE550 02510C* BE CALCULATED FOR THE COMPANY AS A WHOLE (IN PCT). OE550 02520C* OE550 0002530C********************************************************************OE550 02540C* OE550 02550CSR STOT BEGSR OE550 02560C* OE550 02570CSR MTD ADD ST1 ST1 80 OE550 02580CSR TS,1 ADD ST2 ST2 80 OE550 02590CSR TS,12 ADD ST3 ST3 80 OE550 0002600CSR YTDCUR ADD ST4 ST4 80 OE550 02610CSR YTDLST ADD ST5 ST5 80 OE550 02620C* OE550 02630CSR ENDSR OE550 02640C* OE550 02650C********************************************************************OE550 02660C* OE550 0002670C* THIS SUBROUTINE CALCULATES % INCREASES IN SALES OE550 02680C* FOR THE COMPANY AS A WHOLE. OE550 02690C* OE550 02700C********************************************************************OE550 02710C* OE550 02720CSR PCT BEGSR OE550 02730C* OE550 0002740CSR ST1 SUB ST2 WRK7 OE550 02750CSR WRK7 DIV ST2 WRKPCT H OE550 02760CSR WRKPCT MULT 100 PCT4 41 OE550 02770CSR WRK7 COMP 0 5051 OE550 02780CSR 50 OE550 02790COR 51 ST2 COMP 0 52 OE550 02800CSR 50 52 Z-ADD100 PCT4 OE550 0002810CSR 51 52 Z-SUB100 PCT4 OE550 02820C* OE550 02830CSR ST1 SUB ST3 WRK7 OE550 02840CSR WRK7 DIV ST3 WRKPCT H OE550 02850CSR WRKPCT MULT 100 PCT5 41 OE550 02860CSR WRK7 COMP 0 5051 OE550 02870CSR 50 OE550 0002880COR 51 ST3 COMP 0 52 OE550 02890CSR 50 52 Z-ADD100 PCT5 OE550 02900CSR 51 52 Z-SUB100 PCT5 OE550 02910C* OE550 02920CSR ST4 SUB ST5 WRK7 OE550 02930CSR WRK7 DIV ST5 WRKPCT H OE550 02940CSR WRKPCT MULT 100 PCT6 41 OE550 0002950CSR WRK7 COMP 0 5051 OE550 02960CSR 50 OE550 02970COR 51 ST5 COMP 0 52 OE550 02980CSR 50 52 Z-ADD100 PCT6 OE550 02990CSR 51 52 Z-SUB100 PCT6 OE550 03000C* OE550 03010CSR ENDSR OE550 0003020C* OE550 03030C********************************************************************OE550 03040O$LP1 H 202 1P OE550 03050O OR OF OE550 03060O PAGE Z 8 OE550 03070O 4 'PAGE' OE550 03080O HEAD,1 86 OE550 0003090O UDATE Y 132 OE550 03100O H 2 1P OE550 03110O OR OF OE550 03120O U1 69 'SALES HISTORY BY' OE550 03130O U1 78 'CUSTOMER' OE550 03140O NU1 70 'SALES ANALYSIS BY' OE550 03150O NU1 79 'CUSTOMER' OE550 0003160O 132 'DIS550' OE550 03170O H 1 97 U1 OE550 03180O OR OF U1 OE550 03190O 64 'THIS MTH' OE550 03200O 73 'JAN' OE550 03210O TD,1 76 OE550 03220O 84 'FEB' OE550 0003230O TD,2 87 OE550 03240O 95 'MAR' OE550 03250O TD,3 98 OE550 03260O 106 'APR' OE550 03270O TD,4 109 OE550 03280O 117 'MAY' OE550 03290O TD,5 120 OE550 0003300O 128 'JUN' OE550 03310O TD,6 131 OE550 03320O H 2 97 U1 OE550 03330O OR OF U1 OE550 03340O 6 'CUST #' OE550 03350O 21 'CUSTOMER NAME' OE550 03360O 64 'LAST 12' OE550 0003370O 73 'JUL' OE550 03380O TD,7 76 OE550 03390O 84 'AUG' OE550 03400O TD,8 87 OE550 03410O 95 'SEP' OE550 03420O TD,9 98 OE550 03430O 106 'OCT' OE550 0003440O TD,10 109 OE550 03450O 117 'NOV' OE550 03460O TD,11 120 OE550 03470O 128 'DEC' OE550 03480O TD,12 131 OE550 03490O H 1 97NU1 OE550 03500O OR OFNU1 OE550 0003510O 59 'CURRENT' OE550 03520O 70 'LAST' OE550 03530O 89 'CUR MTH' OE550 03540O 122 '- - Y E A R T O D A T' OE550 03550O 128 'E - -' OE550 03560O H 2 97NU1 OE550 03570O OR OFNU1 OE550 0003580O 6 'CUST #' OE550 03590O 21 'CUSTOMER NAME' OE550 03600O 58 'MONTH' OE550 03610O 70 'MONTH' OE550 03620O 76 '%' OE550 03630O 89 'LAST YR' OE550 03640O 95 '%' OE550 0003650O 109 'THIS YR' OE550 03660O 121 'LAST YR' OE550 03670O 127 '%' OE550 03680O D 11 01 U1 OE550 03690O CUSTNO 6 OE550 03700O CNAME 32 OE550 03710O MTD J 65 OE550 0003720O TS,12 J 77 OE550 03730O TS,11 J 88 OE550 03740O TS,10 J 99 OE550 03750O TS,9 J 110 OE550 03760O TS,8 J 121 OE550 03770O TS,7 J 132 OE550 03780O D 1 01 U1 OE550 0003790O LAST12JB 65 OE550 03800O TS,6 J 77 OE550 03810O TS,5 J 88 OE550 03820O TS,4 J 99 OE550 03830O TS,3 J 110 OE550 03840O TS,2 J 121 OE550 03850O TS,1 J 132 OE550 0003860O D 1 01NU1 OE550 03870O CUSTNO 6 OE550 03880O CNAME 32 OE550 03890O MTD J 60 OE550 03900O TS,1 J 71 OE550 03910O PCT1 J 78 OE550 03920O TS,12 J 90 OE550 0003930O PCT2 J 97 OE550 03940O YTDCURJB 110 OE550 03950O YTDLSTJ 122 OE550 03960O PCT3 J 129 OE550 03970O T 21 LR U1 OE550 03980O 11 'END OF JOB.' OE550 03990O 51 'COMPANY TOTALS' OE550 0004000O HT1 J 65 OE550 04010O GS,12 J 77 OE550 04020O GS,11 J 88 OE550 04030O GS,10 J 99 OE550 04040O GS,9 J 110 OE550 04050O GS,8 J 121 OE550 04060O GS,7 J 132 OE550 0004070O T 1 LR U1 OE550 04080O HT2 J 65 OE550 04090O GS,6 J 77 OE550 04100O GS,5 J 88 OE550 04110O GS,4 J 99 OE550 04120O GS,3 J 110 OE550 04130O GS,2 J 121 OE550 0004140O GS,1 J 132 OE550 04150O T 2 LRNU1 OE550 04160O 11 'END OF JOB.' OE550 04170O 46 'COMPANY TOTALS' OE550 04180O ST1 J 60 OE550 04190O ST2 J 71 OE550 04200O PCT4 J 78 OE550 0004210O ST3 J 90 OE550 04220O PCT5 J 97 OE550 04230O ST4 J 110 OE550 04240O ST5 J 122 OE550 04250O PCT6 J 129 OE550 ** 004260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00427000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004280ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004290ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004300/* 004310_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( iTXOE220 P999999032778(000010H S OE220 00020X DECK-ID A65 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE220 00030F* PRINT BACKLOG BY SALES ORDER NUMBER OE220 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE220 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE220 00060F* CONTROL DATA PROPRIETARY PRODUCT OE220 00070F* OE220 0000080FOPNORDS IPEAF 119 8AI 106 DISK OE220 00090FARMAST IC F 280R 6AI 1 DISK OE220 00100FPARTMST IC F 300R20AI 271 DISK OE220 00110FHEADING IT F 40 EDISK OE220 00120F$LP1 O F 132 OF PRINTER OE220 00130F********************************************************************OE220 00140F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [ORD240] OE220 0000150F* OE220 00160F* PACKAGE DISTRIBUTION OE220 00170F* SYSTEM SALES ORDER PROCESSING OE220 00180F* PROGRAM PRINT BACKLOG BY SALES ORDER # OE220 00190F* OE220 00200F* CONTRACTOR COMPUSOURCE OE220 00210F* PROGRAMMER KATH HILL OE220 0000220F* DATE FEBRUARY 25, 1976 OE220 00230F* OE220 00240F********************************************************************OE220 00250F* ID F C H L FUNCTION OF INDICATORS OE220 00260F* OE220 00270F* 01 OPNORDS (H) OE220 00280F* 03 (LL) OE220 0000290F* 04 (ALL OTHERS) OE220 00300F* 05 ARMAST OE220 00310F* 06 PARTMST OE220 00320F* OE220 00330F* 15 GOOD RECORD (ARMAST) OE220 00340F* 16 GOOD RECORD (PARTMST) OE220 00350F* 20 UNIT PRICE OVERRIDE = 0 OE220 0000360F* 21 PRICE CODE OVERRIDE = 0 OE220 00370F* OE220 00380F* 30 MISS ON CHAIN (ARMAST) OE220 00390F* 40 MISS ON CHAIN (PARTMST) OE220 00400F* N50 BAD PRICE CODE ON FILE - DEFAULT TO PRICE = 0 OE220 00410F* OE220 00420F********************************************************************OE220 0000430E PRCD 5 7 3 OE220 00440E HEADING HEAD 1 1 40 COMPANY NAME OE220 00450IOPNORDS NS 01 8 CH OE220 00460I 3 70MSO1 L1 OE220 00470I 9 130CUSTNO OE220 00480I 14 190ORDDAT OE220 00490I 20 31 CPONUM OE220 0000500I 43 430PRCDOV 21 OE220 00510I 50 550PRODAT OE220 00520I 105 105 STATUS 60 OE220 00530I NS 03 8 CL 11 CL OE220 00540I 3 70MSOLL OE220 00550I 65 84 PART OE220 00560I 24 300QTYORD OE220 0000570I 52 583UNPROV 20 OE220 00580I NS 04 OE220 00590I 1 105 IMAGE OE220 00600IARMAST NS 05 OE220 00610I 7 30 CNAME OE220 00620I 115 115 DLTAR 15 OE220 00630I 161 1610PRCODE OE220 0000640IPARTMST NS 06 OE220 00650I 74 74 DLTPR 16 OE220 00660I 226 260 PRCD OE220 00670C* OE220 00680C 01N60 STATUS COMP 'P' 60 OE220 00690C 01N60 STATUS COMP 'B' 60 OE220 00700C 01N60 GOTO FINI OE220 0000710C 01 Z-ADDCUSTNO KEY 60 OE220 00720C 01 KEY CHAINARMAST 30 OE220 00730C 01N30N15 SETON 30 OE220 00740C 21 Z-ADDPRCODE I 10 OE220 00750C N21 Z-ADDPRCDOV I OE220 00760C* OE220 00770C N03 GOTO FINI OE220 0000780C N60 GOTO FINI OE220 00790C N20 Z-ADDUNPROV UNITPR 73 OE220 00800C N20 GOTO ON1 OE220 00810C* OE220 00820C 30 Z-ADD0 UNITPR OE220 00830C 30 GOTO ON1 OE220 00840C* OE220 0000850C PART CHAINPARTMST 40 OE220 00860C N40N16 SETON 40 OE220 00870C 40 Z-ADD0 UNITPR OE220 00880C 40 GOTO ON1 OE220 00890C I COMP 1 50 50CODE 1-5 ? OE220 00900C 50 I COMP 5 5050 OE220 00910C N50 Z-ADD0 UNITPR NO. DEFAULT=0 OE220 0000920C 50 Z-ADDPRCD,I UNITPR YES. OE220 00930C* OE220 00940C ON1 TAG OE220 00950C* OE220 00960C QTYORD MULT UNITPR AMT 92H OE220 00970C MSOAMT ADD AMT MSOAMT 92 OE220 00980C TOTAL ADD AMT TOTAL 92 OE220 0000990C* OE220 01000C FINI TAG OE220 01010C* OE220 01020O$LP1 H 202 1P OE220 01030O OR OF OE220 01040O PAGE Z 8 OE220 01050O 4 'PAGE' OE220 0001060O HEAD,1 86 OE220 01070O UDATE Y 132 OE220 01080O H 2 1P OE220 01090O OR OF OE220 01100O 61 'BACKLOG REPORT' OE220 01101O 83 ' BY SALES ORDER NUMBER' 01110O 132 'DIS220' OE220 0001120O H 1 1P OE220 01130O OR OF OE220 01140O 5 'SALES' OE220 01150O 69 'DELIVERY' OE220 01160O 83 'ORDER' OE220 01170O 92 'ORDER' OE220 01180O H 2 1P OE220 0001190O OR OF OE220 01200O 7 'ORDER #' OE220 01210O 16 'CUST #' OE220 01220O 31 'CUSTOMER NAME' OE220 01230O 59 'CUSTOMER P.O. #' OE220 01240O 67 'DATE' OE220 01250O 83 'AMOUNT' OE220 0001260O 91 'DATE' OE220 01270O T 1 L1 60 OE220 01280O MSO1 8 OE220 01290O CUSTNO 16 OE220 01300O N30CNAME 42 OE220 01310O 30 38 '** INVALID CUST #' OE220 01320O CPONUM 56 OE220 0001330O PRODATY 69 OE220 01340O MSOAMTJB 84 OE220 01350O ORDDATY 93 OE220 01360O T 31 LR OE220 01370O 11 'END OF JOB.' OE220 01380O 35 'TOTAL VALUE OF BACKLOG' OE220 01390O 40 'IS $' OE220 0001400O TOTAL J 53 OE220 ** 001410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001420ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001450/* 00146000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d d*TXOECOPY P999999032778(000010H S OECOPY00020X DECK-ID A28 MFG/DIST/ACCT SYSTEM SUMMARY-123 OECOPY00030F* COPIES TEMPORARY SEQUENTIAL FILE TO PERMANENT INDEXED FILE OECOPY00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OECOPY00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OECOPY00060F* CONTROL DATA PROPRIETARY PRODUCT OECOPY00070F* OECOPY0000080FSVOPNORDIPE F 119 DISK OECOPY00090FOPNORDS O F 119 8AI 106 DISK OECOPY00100ISVOPNORDNS 01 OECOPY00110I 1 119 RECORD OECOPY00120OOPNORDS D 01 OECOPY00130O RECORD 119 OECOPY** 00014000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000190ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00021000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000220/* 000230_ 00 00 00 00 00 00 00 00 00 00 00 __ 0(d d*TXOECPY1 P999999032778(000010H S OECPY100020X DECK-ID A85 MFG/DIST/ACCT SYSTEM SUMMARY-123 OECPY100030F* COPIES TEMPORARY SEQUENTIAL FILE TO PERMANENT INDEXED FILE OECPY100040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OECPY100050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OECPY100060F* CONTROL DATA PROPRIETARY PRODUCT OECPY100070F* OECPY10000080FSAMOUT IPE F 140 DISK OECPY100090FSAMAST O F 140 20AI 121 DISK OECPY100100ISAMOUT NS 01 OECPY100110I 1 140 RCD OECPY100120OSAMAST D 01 OECPY100130O RCD 140 OECPY1** 00014000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000180/* 000190_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(! TXAR005 P999999032778(000010H S AR005 00020X DECK-ID A29 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR005 00030F* THIS PROGRAM IS USED FOR INQUIRY/MAINTENANCE OF ARMAST FILE AR005 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR005 00050F* CONTROL DATA PROPRIETARY PRODUCT AR005 00060F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR005 00070F* AR005 0000080FDUMMY IPEAF 72 DISK AR005 00090FPRM005 IC F 32R DISK AR005 00100FARMAST UC F 280R 6AI 001 DISK A AR005 00110E FN 20 22 FIELD NAME AR005 00120E CP 20 4 CURSOR POSITION AR005 00130E LN 20 2 0 LENGTH AR005 00140E EP 20 3 0 ENDING POSITION AR005 0000150IDUMMY NS 01 AR005 00160I 1 1 A AR005 00170IPRM005 NS 02 AR005 00180I 1 22 FIELDN AR005 00190I 23 26 CURPOS AR005 00200I 27 280LNGTH AR005 00210I 29 310ENDPOS AR005 0000220I 32 320SET AR005 00230IARMAST NS 03 AR005 00240I 1 256 RECORD AR005 00250I 257 280 LEFT01 AR005 00260C MOVE ' ' RCODE 1 AR005 00270C MOVE RCODE B22 22 AR005 00280C MOVE RCODE BLANKS 72 AR005 0000290C MOVE RCODE B256 200 AR005 00300C Z-ADD1 ONE 10 AR005 00310C SETON LR AR005 00320CLR START TAG AR005 00330CLR EXSR FIRSTP AR005 00340CLR SECTON COMP 'E' 40 AR005 00350CLR SECTON COMP '1' 9998 AR005 0000360CLR 99N40 GOTO START AR005 00370CLR 40 GOTO EOJ AR005 00380CLR MOVE SECTON SECTN 10 AR005 00390CLR EXSR GETSEC AR005 00400CLRN45 GOTO START AR005 00410CLR EXSR CLRSCR AR005 00420CLR EXSR KEYOUT AR005 0000430CLR EXSR OUTPUT AR005 00440CLR EXSR UPDATE AR005 00450CLR GOTO START AR005 00460CLR EOJ TAG AR005 00470C********************************************************************AR005 00480C* KEYOUT OUTPUTS THE CUST# ON SECTION 1 &2. AR005 00490C* AR005 0000500C* *** THIS SUBROUTINE IS UNIQUE TO CAR005. AR005 00510C* AR005 00520CSR KEYOUT BEGSR AR005 00530CSR MOVEL'5206' BUFFER AR005 00540CSRN98 MOVEL'2806' BUFFER AR005 00550CSR EXSR POSCUR AR005 00560CSR MOVEL'CUST#' A12 12 AR005 0000570CSR MOVE KEY A12 AR005 00580CSR MOVE 'S' TYPE AR005 00590CSR MOVELA12 BUFFER AR005 00600CSR Z-ADD12 BLNGTH AR005 00610CSR EXSR CRTCOM AR005 00620CSR ENDSR AR005 00630C********************************************************************AR005 0000640C********************************************************************AR005 00650C* AR005 00660C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND AR005 00670C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. AR005 00680C* IF T[ RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDCAR005 00690C* IF SECTION = 'R' THEN THE CUSTOMER # IS ASKED FOR AGAIN AR005 00700C* AR005 0000710C********************************************************************AR005 00720CSR FIRSTP BEGSR AR005 00730CSR EXSR CLRSCR AR005 00740CSR Z-ADD0 SECTN 10 AR005 00750CSR SETOF 98 AR005 00760CSR EXSR GETSEC AR005 00770CSR PGE TAG AR005 0000780CSR SETON 6162 AR005 00790CSR EXSR OUTPUT AR005 00800CSR Z-ADDKX X 20 AR005 00810CSR EXSR ACCEPT AR005 00820CSR MOVELBUFFER VAR AR005 00830CSR Z-ADD6 VL AR005 00840CSR EXSR RTADJ AR005 0000850CSR MOVELVAR A6 6 AR005 00860CSR MOVE A6 KEY 60 AR005 00870CSR KEY CHAINARMAST 55 AR005 00880CSRN55 GOTO SKIPMS AR005 00890CSR MOVELB256 RECORD AR005 00900CSR MOVELB256 LEFT01 AR005 00910CSR SKIPMS TAG AR005 0000920CSR MOVELSAVPOS BUFFER AR005 00930CSR MOVELOFC BUFFER AR005 00940CSR EXSR POSCUR AR005 00950CSR MOVEL' NEW RE'WORD16 16 AR005 00960CSR MOVE 'CORD 'WORD16 AR005 00970CSRN55 MOVELBLANKS WORD16 AR005 00980CSR MOVELWORD16 BUFFER AR005 0000990CSR MOVE 'T' TYPE 1 AR005 01000CSR Z-ADD12 BLNGTH 20 AR005 01010CSR EXSR CRTCOM AR005 01020CSR SETOF 62 AR005 01030CSR Z-ADDSX X AR005 01040CSR EXSR ACCEPT AR005 01050CSR MOVELBUFFER SECTON 1 AR005 0001060CSR SECTON COMP 'R' 30 AR005 01070CSR 30 GOTO PGE AR005 01080CSR SETOF 61 AR005 01090CSR ENDSR AR005 01100C********************************************************************AR005 01110C* AR005 01120C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. AR005 0001130C* AR005 01140C********************************************************************AR005 01150CSR GETSEC BEGSR AR005 01160CSR 1 ADD SECTN N 20 AR005 01170CSR SETOF 404145 AR005 01180CSR N COMP 0 3030 AR005 01190CSRN30 N COMP 10 30 AR005 0001200CSR 30 GOTO ENDGET AR005 01210CSR SECTN MULT 20 RRN 40 AR005 01220CSR Z-ADD1 X 20 AR005 01230CSR SCLOOP TAG AR005 01240CSR RRN ADD 1 RRN AR005 01250CSR RRN CHAINPRM005 50 AR005 01260CSR 50 GOTO ENDGET AR005 0001270CSR FIELDN COMP B22 4141 AR005 01280CSRN41 GOTO ENDGET AR005 01290CSR 41N45 SETON 45 AR005 01300CSR MOVE FIELDN FN,X AR005 01310CSR MOVE CURPOS CP,X AR005 01320CSR MOVE LNGTH LN,X AR005 01330CSR MOVE ENDPOS EP,X AR005 0001340CSR 1 ADD X X AR005 01350CSR X COMP 20 32 AR005 01360CSRN32 GOTO SCLOOP AR005 01370CSR ENDGET TAG AR005 01380CSR Z-ADDX NOFLDS 20 AR005 01390CSR 45 GOTO FINGET AR005 01400CSR EXSR CLRSCR AR005 0001410CSR MOVEL'SECTION 'WORD9 9 AR005 01420CSR MOVE SECTN WORD9 AR005 01430CSR MOVELWORD9 WORD16 16 AR005 01440CSRN30 MOVE ' ABSENT' WORD16 AR005 01450CSR 30 MOVE ' ILLEG.' WORD16 AR005 01460CSR MOVELWORD16 BUFFER AR005 01470CSR MOVEL'R' TYPE AR005 0001480CSRN61 Z-ADD6 MASK 10 AR005 01490CSR 61 Z-ADD1 MASK AR005 01500CSR EXSR CRTCOM AR005 01510CSR FINGET ENDSR AR005 01520C********************************************************************AR005 01530C* AR005 01540C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE AR005 0001550C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE KEY AR005 01560C* INDEX AND SECTION INDEX IS SAVED. AR005 01570C* AR005 01580C********************************************************************AR005 01590CSR OUTPUT BEGSR AR005 01600CSR Z-ADD1 X AR005 01610CSR OTLOOP TAG AR005 0001620CSR 61 EP,X COMP 1 31 AR005 01630CSR 61 31 Z-ADDX KX 20 KEY FIELD INDEXAR005 01640CSR 61 EP,X COMP 2 31 AR005 01650CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXAR005 01660CSR EXSR OUTFLD AR005 01670CSR X ADD 1 X AR005 01680CSR X COMP NOFLDS 31 AR005 0001690CSR 31 GOTO OTLOOP AR005 01700CSR ENDSR AR005 01710C********************************************************************AR005 01720C* AR005 01730C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND AR005 01740C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 AR005 01750C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS AR005 0001760C* THEN NO FIELD INFORMATION IS PRINTED AR005 01770C* AR005 01780C********************************************************************AR005 01790CSR OUTFLD BEGSR AR005 01800CSR MOVE FN,X FL 20 AR005 01810CSR MOVELCP,X FC 20 AR005 01820CSR FC COMP FL 31 AR005 0001830CSR 31 Z-ADDFC FL AR005 01840CSR FC SUB FL CC 20 AR005 01850CSR CC ADD 1 CC AR005 01860CSR MOVELCP,X BUFFER AR005 01870CSR MOVELCC BUFFER AR005 01880CSR EXSR POSCUR AR005 01890CSR MOVELBLANKS BUFFER AR005 0001900CSR MOVELFN,X FIELDN AR005 01910CSR MOVE ' ' FIELDN AR005 01920CSR MOVELFIELDN BUFFER AR005 01930CSR Z-ADDLN,X LEN 20 AR005 01940CSR LEN COMP 0 3130 AR005 01950CSR 31 Z-SUBLN,X LEN AR005 01960CSR 30 GOTO SKIPF AR005 0001970CSR FL ADD 2 BPOS 20 AR005 01980CSR MOVE '1' WHICH1 10 AR005 01990C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS AR005 02000CSR EXIT SUBRIN AR005 02010CSR RLABL WHICH1 10 AR005 02020CSR RLABL BUFFER 72 AR005 02030CSR RLABL RECORD AR005 0002040CSR RLABL BPOS 20 AR005 02050CSR RLABL FPOS 20 AR005 02060CSR RLABL STRT 30 AR005 02070CSR RLABL LEN 20 AR005 02080CSR BPOS ADD 1 FPOS 20 AR005 02090CSR EXSR MVRECD AR005 02100CSR SKIPF TAG AR005 0002110CSR 30 Z-ADDFL BLNGTH AR005 02120CSRN30 FL ADD 3 BLNGTH AR005 02130CSRN30 BLNGTH ADD LEN BLNGTH AR005 02140CSR MOVE 'T' TYPE AR005 02150CSR EXSR CRTCOM AR005 02160CSR ENDSR AR005 02170C********************************************************************AR005 0002180C* AR005 02190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN AR005 02200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST AR005 02210C* THE RIGHT BRACKET. AR005 02220C********************************************************************AR005 02230CSR MVRECD BEGSR AR005 02240CSR 61 GOTO RBRK AR005 0002250CSR EP,X SUB LEN STRT 30 AR005 02260CSR STRT ADD 1 STRT AR005 02270CSR MOVE '2' WHICH1 AR005 02280C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER AR005 02290C* FROM STRT IN RECORD TO FPOS IN BUFFER AR005 02300CSR EXIT SUBRIN AR005 02310CSR RLABL WHICH1 10 AR005 0002320CSR RLABL BUFFER 72 AR005 02330CSR RLABL RECORD AR005 02340CSR RLABL BPOS 20 AR005 02350CSR RLABL FPOS 20 AR005 02360CSR RLABL STRT 30 AR005 02370CSR RLABL LEN 20 AR005 02380CSR RBRK TAG AR005 0002390CSR EXSR RTBRKT AR005 02400CSR ENDSR AR005 02410C********************************************************************AR005 02420C* AR005 02430C* THIS ROUTINE INSERTS A '(' IN BUFFER AT FPOS AR005 02440C* AR005 02450C********************************************************************AR005 0002460CSR RTBRKT BEGSR AR005 02470CSR LEN ADD FPOS FPOS AR005 02480CSR MOVE '3' WHICH1 AR005 02490CSR EXIT SUBRIN AR005 02500CSR RLABL WHICH1 10 AR005 02510CSR RLABL BUFFER 72 AR005 02520CSR RLABL RECORD AR005 0002530CSR RLABL BPOS 20 AR005 02540CSR RLABL FPOS 20 AR005 02550CSR RLABL STRT 30 AR005 02560CSR RLABL LEN 20 AR005 02570CSR ENDSR AR005 02580C********************************************************************AR005 02590C* AR005 0002600C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. AR005 02610C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO AR005 02620C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF AR005 02630C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST AR005 02640C* OF THE FIELDS ARE LEFT UNCHANGED AR005 02650C* AR005 02660C********************************************************************AR005 0002670CSR UPDATE BEGSR AR005 02680CSR SETOF 32 AR005 02690CSR Z-ADD1 X AR005 02700CSR UPLOOP TAG AR005 02710CSR Z-ADDLN,X LEN AR005 02720CSR LEN COMP 0 3730 AR005 02730CSR 37 Z-SUBLEN LEN AR005 0002740CSR 30N32 GOTO INCR AR005 02750CSR 30 GOTO CHKRUB AR005 02760CSR SETOF 3233 AR005 02770CSR EXSR ACCEPT AR005 02780CSR CHKRUB TAG AR005 02790CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTAR005 02800CSR 32 31 GOTO UPLOOP AR005 0002810CSR 32 GOTO ENDUPD AR005 02820CSR MOVELBUFFER ATSIGN 1 AR005 02830CSR ATSIGN COMP '@' 35 AR005 02840CSR 35 GOTO OUTREC AR005 02850CSR 33 GOTO INCR WAS LINE FEED AR005 02860CSR EP,X SUB LEN STRT AR005 02870CSR STRT ADD 1 STRT AR005 0002880CSR MOVE '4' WHICH1 AR005 02890C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF AR005 02900C* BUFFER TO THE STRT OF RECORD AR005 02910CSR EXIT SUBRIN AR005 02920CSR RLABL WHICH1 10 AR005 02930CSR RLABL BUFFER 72 AR005 02940CSR RLABL RECORD AR005 0002950CSR RLABL BPOS 20 AR005 02960CSR RLABL FPOS 20 AR005 02970CSR RLABL STRT 30 AR005 02980CSR RLABL LEN 20 AR005 02990CSR EXSR OUTFLD AR005 03000CSR INCR TAG AR005 03010CSR X ADD 1 X AR005 0003020CSR X COMP NOFLDS 30 AR005 03030CSR 30 GOTO UPLOOP AR005 03040CSR OUTREC TAG AR005 03050CSR SETON 80 AR005 03060CSR EXCPT AR005 03070CSR SETOF 80 AR005 03080CSR ENDUPD TAG AR005 0003090CSR ENDSR AR005 03100C********************************************************************AR005 03110C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE AR005 03120C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X AR005 03130C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND AR005 03140C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT AR005 03150C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED AR005 0003160C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS AR005 03170C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS AR005 03180C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO AR005 03190C* TO BE OUTPUT TO THE SCREEN. AR005 03200C* AR005 03210C********************************************************************AR005 03220CSR ACCEPT BEGSR AR005 0003230CSR X COMP 1 30 AR005 03240CSRN30 X COMP 20 30 AR005 03250CSR 30 Z-ADD1 X AR005 03260CSR MOVELCP,X FC 20 AR005 03270CSR FC ADD 3 FC AR005 03280CSR MOVELCP,X SAVPOS 4 AR005 03290CSR MOVELFC SAVPOS AR005 0003300CSR LN,X ADD FC OFC 20 AR005 03310CSR OFC ADD 1 OFC AR005 03320CSR Z-ADDLN,X LEN AR005 03330CSR LEN COMP 0 34 AR005 03340CSR 34 Z-SUBLEN LEN AR005 03350CSR ACLOOP TAG AR005 03360CSR MOVELSAVPOS BUFFER AR005 0003370CSR EXSR POSCUR AR005 03380CSR MOVE BLANKS BUFFER AR005 03390CSR Z-ADDLEN BLNGTH AR005 03400CSR MOVE 'A' TYPE AR005 03410CSR EXSR CRTCOM AR005 03420CSR RCODE COMP 'R' 31 AR005 03430CSR 31 BUFFER COMP BLANKS 32 AR005 0003440CSR 31 32N61 GOTO ENDACC AR005 03450CSR 31 GOTO ACLOOP AR005 03460CSR RCODE COMP 'L' 33 AR005 03470CSR 33 GOTO DUPIT AR005 03480CSRN34 GOTO ENDACC AR005 03490CSR MOVELBUFFER SIGN 1 WE MUST CHECK AR005 03500CSR SIGN COMP '@' 30 AR005 0003510CSR 30 GOTO ENDACC AR005 03520CSR Z-ADDLEN VL 20 AR005 03530CSR MOVELBUFFER VAR 15 AR005 03540CSR EXSR RTADJ AR005 03550CSR MOVELVAR BUFFER AR005 03560CSR GOTO ENDACC AR005 03570CSR DUPIT TAG AR005 0003580CSRN61 EXSR OUTFLD AR005 03590CSRN61 GOTO ENDACC AR005 03600CSR MOVELSAVPOS BUFFER AR005 03610CSR EXSR POSCUR AR005 03620CSR 62 MOVELKEY BUFFER AR005 03630CSRN62 MOVELSECTON BUFFER AR005 03640CSR MOVE 'T' TYPE AR005 0003650CSR EXSR CRTCOM AR005 03660CSR ENDACC ENDSR AR005 03670C********************************************************************AR005 03680C* AR005 03690C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES AR005 03700C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM AR005 03710C* 4 DUMMY FOR RTADJ AR005 0003720C* AR005 03730C********************************************************************AR005 03740CSR POSCUR BEGSR AR005 03750CSR MOVE 'P' TYPE AR005 03760CSR EXSR CRTCOM AR005 03770CSR ENDSR AR005 03780C********************************************************************AR005 0003790CSR CLRSCR BEGSR AR005 03800CSR MOVE 'C' TYPE AR005 03810CSR EXSR CRTCOM AR005 03820CSR ENDSR AR005 03830C********************************************************************AR005 03840CSR CRTCOM BEGSR AR005 03850CSR EXITFSUBRCM AR005 0003860CSR RLABL BUFFER 72 AR005 03870CSR RLABL TYPE 1 AR005 03880CSR RLABL BLNGTH 20 AR005 03890CSR RLABL RCODE 1 AR005 03900CSR RLABL MASK 10 AR005 03910CSR RLABL DTYPE 10 AR005 03920CSR ENDSR AR005 0003930C********************************************************************AR005 03940CSR RTADJ BEGSR AR005 03950CSR EXIT SUBRAJ AR005 03960CSR RLABL VL AR005 03970CSR RLABL VAR AR005 03980CSR ENDSR AR005 03990C********************************************************************AR005 0004000OARMAST E 80N55 AR005 04010O RECORD 256 AR005 04020O LEFT01 280 AR005 04030OARMAST EADD 80 55 AR005 04040O RECORD 256 AR005 04050O LEFT01 280 AR005 04060O KEY 006 AR005 00** 004070ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 004080ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004090ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004100ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004110/* 004120__0O KEY 006 AR005 0(! ;CTXAR007 P999999032778(000010H S AR007 00020X DECK-ID A30 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR007 00030F* THIS PROGRAM PURGES ARMAST OF RECORDS WITH DELETE CODE SET AR007 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR007 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR007 00060F* CONTROL DATA PROPRIETARY PRODUCT AR007 00070F* AR007 0000080FARMAST IP F 280 6AI 1 DISK AR007 00090FNEWMST O F 280 6AI 1 DISK AR007 00100F$SYSLISTO F 132 OF PRINTER AR007 00110F* AR007 00120F* CAR007- CREATES A NEW ARMAST WITH DELETES REMOVED. AR007 00130F* LISTS RECORDS BEING REMOVED. AR007 00140F* AR007 0000150F********************************************************************AR007 00160IARMAST NS 01 115 CD AR007 00170I 1 60CUSTN AR007 00180I 7 30 NAME AR007 00190I NS 02 AR007 00200I 1 256 REC1 AR007 00210I 257 280 REC2 AR007 0000220C 01 NOUT ADD 1 NOUT 40 AR007 00230C 02 NREM ADD 1 NREM 40 AR007 00240C 21 SETON 22 AR007 00250C 21 GOTO END AR007 00260C TIME HHMMSS 60 TIME OF DAY AR007 00270C SETON 21 AR007 00280C END TAG AR007 0000290ONEWMST D 02 AR007 00300O REC1 256 AR007 00310O REC2 280 AR007 00320O$SYSLISTH 304 21N22 AR007 00330O OR OF AR007 00340O 9 'CAR007' AR007 00350O 42 'REMOVE FLAGGED CUSTOMERS' AR007 0000360O 59 'FROM ARMAST FILE' AR007 00370O UDATE Y 74 AR007 00380O HHMMSS 84 '0 : : ' AR007 00390O 91 'PAGE' AR007 00400O PAGE Z 95 AR007 00410O H 2 21N22 AR007 00420O OR OF AR007 0000430O 16 'CUST # NAME' AR007 00440O D 1 01 AR007 00450O CUSTN 3 9 AR007 00460O NAME 36 AR007 00470O T 13 LR AR007 00480O 14 'END OF JOB.' AR007 00490O NOUT 3 19 AR007 0000500O 42 'CUSTOMERS REMOVED FROM' AR007 00510O 50 'ARMAST,' AR007 00520O NREM 3 54 AR007 00530O 73 'CUSTOMERS REMAIN.' AR007 ** 000540ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000550ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00056000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000570ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000580/* 000590__0O 73 'CUSTOMERS REMAIN.' AR007 ** 000540ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000550ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0005600("< :CTXAR010 P999999032778(000010H S AR010 00020X DECK-ID A31 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR010 00030F* READS ARTRAN FILE AND CREATES INDEXED FILE ARIND1 AR010 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR010 00060F* CONTROL DATA PROPRIETARY PRODUCT AR010 00070F* AR010 0000080FARTRANS IP AF 48 DISK AR010 00090FARIND1 O F 32 7AI 7 DISK U AR010 00100F$LP1 O F 132 OF PRINTER AR010 00110F********************************************************************AR010 00120F*******************************************************************'AR010 00130F** **AR010 00140F** READS "ARTRAN" FILE AND CREATES AN INDEXED FILE, ARI5D1.'8AR010 0000150F** ''AR010 00160F** TOTAL A/R AT END OF RUN. ''AR010 00170F** **AR010 00180F********************************************************************AR010 00190IARTRANS NS 03 AR010 00200I 1 2 C AR010 00210I 9 21 KEY L1 AR010 0000220I 22 302AMOUNT AR010 00230C SETOF 0102 AR010 00240C C COMP 'DS' 61 AR010 00250C C COMP 'CA' 60 AR010 00260C C COMP 'CM' 62 AR010 00270C 60 AR010 00280COR 61 AR010 0000290COR 62 SETON 01 AR010 00300C N01 SETON 02 AR010 00310C L1 MOVE KEY DOC 70 AR010 00320C L1 DOC COMP 9999999 4040 AR010 00330C L1 01 Z-SUBAMOUNT ORIG 92 AR010 00340C L1 01 Z-SUBAMOUNT STILL 92 AR010 00350C L1 02 MOVE AMOUNT ORIG 92 AR010 0000360C L1 02 MOVE AMOUNT STILL 92 AR010 00370C 01NL1 STILL SUB AMOUNT STILL AR010 00380C 02NL1 STILL ADD AMOUNT STILL AR010 00390C 01 ARTOT SUB AMOUNT ARTOT 102 AR010 00400C 02 ARTOT ADD AMOUNT ARTOT AR010 00410OARIND1 T L1 40 AR010 00420O KEY 13 AR010 0000430O ORIG 22 AR010 00440O STILL 31 AR010 00450O$LP1 H 2 1P AR010 00460O UDATE Y 8 AR010 00470O 31 'CAR010 CREATE ARIND1' AR010 00480O 36 'FILE' AR010 00490O T LR AR010 0000500O 4 'EOJ.' AR010 00510O ARTOT J 21 '$' AR010 00520O 46 'NET A/R ON ARTRANS FILE.' AR010 ** 000530ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000540ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000550ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00056000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000570/* 000580__0O 46 'NET A/R ON ARTRANS FILE.' AR010 ** 000530ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000540ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000550ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0005600(L" TXAR021 P999999032778(000010H S AR021 00020X DECK-ID A32 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR021 00030F* ACCEPTS A/R TRANSACTIONS FROM CRT TO DISK FILE CARDS AR021 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR021 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR021 00060F* CONTROL DATA PROPRIETARY PRODUCT AR021 00070F* AR021 0000080FDUMMY IP AF 72 DISK AR021 00090FARIND1 UC F 32R 7AI 7 DISK A AR021 00100FARMAST IC F 280R 6AI 1 DISK 50 AR021 00110FINFO UC F 80R DISK AR021 00120FINTAB IT F 80 80 EDISK AR021 00130FCARDS O F 80 7AI 74 DISK A AR021 00140F********************************************************************AR021 0000150F* ************************************************************** AR021 00160F* ** ** AR021 00170F* ** ** AR021 00180F* ** PROGRAM- CAR021 ** AR021 00190F* ** ** AR021 00200F* DESCRIPTION- ENTERS BATCHES OF CA, IN, CM, DM, & AJ ENTRIES *AR021 00210F* (INCLUDING HEADERS) TO DISK FILE 'CARDS'. *AR021 0000220F* 'CARDS' IS USED BY CAR025 FOR THE FINAL EDIT RUN. *AR021 00230F* *AR021 00240F* THIS PROGRAM SUPPLIES THE SAME DIAGNOSTICS AS *AR021 00250F* CAR025, AND ALLOWS FOR CORRECTION BEFORE WRITING *AR021 00260F* TO 'CARDS' *AR021 00270F* *AR021 00280F* ************************************************************** AR021 0000290F* MODIFIED 01/26/76 TO USE ARIND1 ONLY. (ARINDX REMOVED.) *AR021 00300F* MODIFIED 07/16/76 TO CORRECT PROBELM W/ INPUT OF TAX CODE. AR021 00310F********************************************************************AR021 00320F* 11 OUTPUT BATCH HEADER AR021 00330F* 12 OUTPUT CASH AR021 00340F* 13 OUTPUTIN, CM, DM AR021 00350F* 14 OUTPUTGL AR021 0000360F* 15 OUTPUTAJ AR021 00370F* 16 DUMMY RECORD READ FIRST TIME AROUND AR021 00380F* 31 BLANK ENTERED FOR TAXCODE AR021 00390F* 32 O ENTERED FOR TAX CODE AR021 00400F* 33 C ENTERED FOR TAXCODE AR021 00410F* 40 INVNO IS 999999 AR021 00420F* 41 PARTIAL PAYMENT AR021 0000430F* 42 NEGATIVE BALANCE ON DOCUMENT # AR021 00440F* 43 AR021 00450F* 48 NEGATIVE NUMBER ENTERED AR021 00460F* 49 RUBOUT ENDS ENTRY AR021 00470F* 50 CR ENDS ENTRY AR021 00480F* 51 LINE FEED ENDS ENTRY AR021 00490F* 44 CONTINUE ENTERING BATCHES. AR021 0000500F** OK?- * AR021 00510F* 52 YES OPTION AR021 00520F* 53 NO AR021 00530F* 54 RETRY AR021 00540F* 56 DOCUMENT AND CUSTOMER DONT MATCH FOR IN, CM, OR DMENTRY ATTEMPAR021 00550F* 55 OTHER AR021 00560F* 70 NO HIT WHEN CHAINING. AR021 0000570F* 71 END OF BATCH. AR021 00580F* AR021 00590F*ERROR MESSAGES. AR021 00600F* 59 CONDITIONS ALL CONSOLE ERROR MESSAGES AR021 00610F* 58 AN OPEN ITEM (#999999) IS BEING CREATED ANEW. AR021 00620F* 91 PRINT BLANK LINE ON $CTKP AR021 00630F* 92 INVOICE NOT OPEN AR021 0000640F* 93 CASH APPLIED AR021 00650F* 94 PARTIAL PAYMENT AR021 00660F* 95 NEG BAL ON DOCUMENT # AR021 00670F* 96 PRINTS AMOUNT DUE, CHECK DUE, DISCOUNT DUE. AR021 00680F* 97 PRINTS 'TRANSACTION EDIT' AR021 00690F* 98 PRINTS 'START OF NEW BATCH' AR021 00700F* 99 PRINTS END OF BATCH DISPLAY AR021 0000710F* 01 CASH READ AR021 00720F* 02 IN READ AR021 00730F* 03 CM READ AR021 00740F* 04 DM READ AR021 00750F* 05 AJ READ AR021 00760F* 06 GL READ AR021 00770F* AR021 0000780F* 07 ARINDX CHAINED AR021 00790F* 08 CUSMST CHAINED AR021 00800F* 89 ** CUSTOMER NOT ON MASTER ** AR021 00810F* 88 ** INVOICE ALREADY EXISTS ** AR021 00820F* 87 ** NET DOESNT CROSSFOOT AR021 00830F* 86 ** DOCUMENT ADDED ** AR021 00840F* AR021 0000850F* AR021 00860F* 60 NET 15 0 AR021 00870F* 61 TAX IS 0 AR021 00880F* 62 FRT IS 0 AR021 00890F* 63 NET DOESN'T CROSSFOOT. AR021 00900E INTAB TAB1 1 12 2 0 TAB2 42 AR021 00910IDUMMY NS 16 AR021 0000920I 1 1 DMY AR021 00930IARIND1 NS 07 AR021 00940I 1 60CUSTNO AR021 00950I 23 312STILL AR021 00960IINFO NS 68 AR021 00970I 1 3 CBATCH AR021 00980I 4 15 CSTILL AR021 0000990I 16 27 CCASH AR021 01000I 28 38 CDISC AR021 01010I 39 52 CTRTOT AR021 01020I 53 66 CDSTOT AR021 01030IARMAST NS 08 AR021 01040I 1 1 @XX AR021 01050C* AR021 0001060C* ASK FOR TRANSACTION AR021 01070C* AR021 01080C MOVE ' ' BLANK 72 AR021 01090C EXSR CLRSCR AR021 01100C EXSR LINE AR021 01110C Z-ADD97 L 20 AR021 01120C EXSR PRT AR021 0001130C NEWTR TAG AR021 01140C 97 EXSR CLRSCR AR021 01150C EXSR LINE AR021 01160C SETON 97 AR021 01170C NEW1 TAG AR021 01180C Z-ADD98 L AR021 01190C EXSR PRT AR021 0001200C CDAGN TAG AR021 01210C* AR021 01220C* GET TRANS CODE. AR021 01230C* AR021 01240C Z-ADD5 BLNGTH 20 AR021 01250C EXSR PAD AR021 01260C MOVEL'TRANS CO'X13 13 AR021 0001270C MOVE 'DE- ' X13 AR021 01280C Z-ADD13 BLNGTH 20 AR021 01290C MOVE 'S' TYPE 1 AR021 01300C MOVELX13 BUFFER 72 AR021 01310C EXSR CRTCOM AR021 01320C Z-ADD25 BLNGTH 20 AR021 01330C MOVE 'A' TYPE AR021 0001340C EXSR CRTCOM AR021 01350C RCODE COMP 'C' 50 AR021 01360C EXSR LINE AR021 01370C N50 GOTO CDAGN AR021 01380C MOVELBUFFER TRANCD 2 AR021 01390C TRANCD COMP 'CA' 01 AR021 01400C TRANCD COMP 'IN' 02 AR021 0001410C TRANCD COMP 'CM' 03 AR021 01420C TRANCD COMP 'DM' 04 AR021 01430C TRANCD COMP 'AJ' 05 AR021 01440C*** TRANCD COMP 'GL' 06 AR021 01450C N01N02N03 AR021 01460CANN04N05 GOTO CDAGN AR021 01470C* AR021 0001480C* GET BATCH NUMBER AR021 01490C* AR021 01500C BCHAG TAG AR021 01510C Z-ADD0 SEQNO 40 AR021 01520C Z-ADD5 BLNGTH 20 AR021 01530C EXSR PAD AR021 01540C MOVE 'S' TYPE AR021 0001550C MOVEL'BATCH NO'X12 12 AR021 01560C MOVE '.- ' X12 AR021 01570C Z-ADD12 BLNGTH 20 AR021 01580C MOVELX12 BUFFER AR021 01590C EXSR CRTCOM AR021 01600C MOVE 'A' TYPE AR021 01610C Z-ADD25 BLNGTH 20 AR021 0001620C EXSR CRTCOM AR021 01630C RCODE COMP 'C' 50 AR021 01640C EXSR LINE AR021 01650C N50 GOTO BCHAG AR021 01660C Z-ADD3 VL 20 AR021 01670C MOVELBUFFER VAR 15 AR021 01680C EXSR RTADJ AR021 0001690C MOVELVAR BATCH 30 AR021 01700C BATCH COMP 99 89 AR021 01710C 89 GOTO ATAGN AR021 01720C MOVEL'BATCH NO'W14 14 AR021 01730C MOVE 'T > 99' W14 AR021 01740C MOVELW14 BUFFER AR021 01750C Z-ADD14 BLNGTH AR021 0001760C MOVE 'T' TYPE AR021 01770C EXSR CRTCOM AR021 01780C GOTO BCHAG AR021 01790C* AR021 01800C* GET AMOUNT TOTAL, DISCOUNT TOTAL AR021 01810C* AR021 01820C ATAGN TAG AR021 0001830C Z-ADD5 BLNGTH 20 AR021 01840C EXSR PAD AR021 01850C MOVE 'S' TYPE AR021 01860C MOVEL'TRANSACT'X16 16 AR021 01870C MOVE 'ION TOTA'X16 AR021 01880C MOVE 'L- ' X4 4 AR021 01890C MOVELX16 X20 20 AR021 0001900C MOVE X4 X20 AR021 01910C MOVELX20 BUFFER AR021 01920C Z-ADD20 BLNGTH 20 AR021 01930C EXSR CRTCOM AR021 01940C EXSR GETNUM AR021 01950C N50 GOTO ATAGN AR021 01960C MOVE FIELD FMT 92 AR021 0001970C 48 Z-SUBFMT TTOT 92 AR021 01980C N48 Z-ADDFMT TTOT 92 AR021 01990C DSAGN TAG AR021 02000C Z-ADD5 BLNGTH 20 AR021 02010C EXSR PAD AR021 02020C MOVE 'S' TYPE AR021 02030C MOVEL'DISCOUNT'X16 AR021 0002040C MOVE ' TOTAL- 'X16 AR021 02050C MOVE ' ' X1 1 AR021 02060C MOVELX16 X17 AR021 02070C MOVE X1 X17 AR021 02080C MOVELX17 BUFFER AR021 02090C Z-ADD17 BLNGTH 20 AR021 02100C EXSR CRTCOM AR021 0002110C EXSR GETNUM AR021 02120C N50 GOTO DSAGN AR021 02130C MOVE FIELD FMT AR021 02140C 48 Z-SUBFMT DTOT 92 AR021 02150C N48 Z-ADDFMT DTOT 92 AR021 02160C SETON 11 WRITE HEADER AR021 02170C EXCPT RECORD AR021 0002180C SETOF 11 AR021 02190C 01 GOTO NEWCA AR021 02200C 02 AR021 02210COR 03 AR021 02220COR 04 GOTO NEWICD AR021 02230C 05 GOTO NEWADJ AR021 02240C GOTO NEWTR AR021 0002250C********************************************************************AR021 02260C* AR021 02270C* CASH RECEIPTS AR021 02280C* AR021 02290C NEWCA TAG AR021 02300C EXSR CLRSCR AR021 02310C 1 ADD SEQNO SEQNO AR021 0002320C EXSR LINE AR021 02330C MOVE 'S' TYPE AR021 02340C Z-ADD10 BLNGTH 20 AR021 02350C MOVEL'* CASH *'X10 10 AR021 02360C MOVE ' ' X10 AR021 02370C MOVELX10 BUFFER AR021 02380C EXSR CRTCOM AR021 0002390C GOTO CA2 AR021 02400C B TAG AR021 02410C EXSR LINE AR021 02420C Z-ADD10 BLNGTH 20 AR021 02430C EXSR PAD AR021 02440C CA2 TAG AR021 02450C SETOF 58 AR021 0002460C MOVE 'S' TYPE AR021 02470C Z-ADD6 BLNGTH 20 AR021 02480C MOVEL'INV#- ' BUFFER AR021 02490C EXSR CRTCOM AR021 02500C EXSR GETNUM AR021 02510C 48 GOTO B AR021 02520C N50N51 GOTO B AR021 0002530C MOVE FIELD INVNO 70 AR021 02540C SETOF 40 AR021 02550C INVNO CHAINARIND1 70 AR021 02560C* AR021 02570C* ALLOW CASH APPLICATION TO 999999 AR021 02580C* AR021 02590C 70 INVNO COMP 9999999 40 AR021 0002600C 70 40 SETON 58 AR021 02610C 70 40 SETOF 70 AR021 02620C X1 COMP 'E' 71 AR021 02630C 71 GOTO ENDBCH END OF BATCH AR021 02640C 70 Z-ADD92 L AR021 02650C 70 EXSR PRT AR021 02660C 70 GOTO B AR021 0002670C* AR021 02680C* INVOICE WAS OK, NOW PRINT AMOUNTS & CALCULATE DISCOUNT. AR021 02690C* AR021 02700C 40 EXSR GETCUS AR021 02710C 40 70 GOTO B AR021 02720C 40 GOTO APMAN ******* AR021 02730C* * AR021 0002740C* * AR021 02750C* DONT CALCULATE AR021 02760C* AND DISPLAY AMTAR021 02770C Z-ADD0.00 DISC 82 DUE IF CASH AR021 02780C STILL SUB DISC CASH 92 GOES TO 999999 AR021 02790C EXSR INCH AR021 02800C SETON 96 AR021 0002810C EXCPT AR021 02820C SETOF 96 AR021 02830C EXSR INCH AR021 02840C Z-ADD12 BLNGTH AR021 02850C EXSR PAD AR021 02860C MOVE 'S' TYPE AR021 02870C Z-ADD9 BLNGTH AR021 0002880C MOVEL'AMT DUE-'X9 9 AR021 02890C MOVE ' ' X9 AR021 02900C MOVELX9 BUFFER AR021 02910C EXSR CRTCOM AR021 02920C Z-ADD12 BLNGTH AR021 02930C MOVELCSTILL BUFFER AR021 02940C EXSR CRTCOM AR021 0002950C MOVEL' CASH- 'BUFFER AR021 02960C Z-ADD8 BLNGTH AR021 02970C EXSR CRTCOM AR021 02980C Z-ADD12 BLNGTH AR021 02990C MOVELCCASH BUFFER AR021 03000C EXSR CRTCOM AR021 03010C Z-ADD8 BLNGTH AR021 0003020C MOVEL' DISC- 'BUFFER AR021 03030C EXSR CRTCOM AR021 03040C Z-ADD11 BLNGTH AR021 03050C MOVELCDISC BUFFER AR021 03060C EXSR CRTCOM AR021 03070C* AR021 03080C* ASK OK? AR021 0003090C* AR021 03100C EXSR LINE AR021 03110C EXSR OK AR021 03120C 54 GOTO B AR021 03130C N52 GOTO APMAN AR021 03140C GOTO CASHOK AR021 03150C* AR021 0003160C* APPLY PAYMENTS MANUALLY. (PAYMENTS ARE NOT FOR THE EXACT AMOUNT) AR021 03170C* AR021 03180C APMAN TAG AR021 03190C Z-ADD11 BLNGTH AR021 03200C EXSR PAD NO OPTION: AR021 03210C MOVE 'S' TYPE ASK FOR CASH AR021 03220C MOVEL' CASH- 'BUFFER AMOUNT & DISC AR021 0003230C Z-ADD8 BLNGTH AMOUNT AR021 03240C EXSR CRTCOM AR021 03250C EXSR GETNUM AR021 03260C N50 EXSR LINE TRY AGAIN IF AR021 03270C N51N50 GOTO APMAN NOT ENTERED AR021 03280C 48 GOTO APMAN AR021 03290C MOVE FIELD FLD 92 AR021 0003300C Z-ADDFLD CASH 92 AR021 03310C DSMAN TAG AR021 03320C Z-ADD10 BLNGTH AR021 03330C EXSR PAD AR021 03340C MOVE 'S' TYPE AR021 03350C MOVEL' DISC- 'X9 9 AR021 03360C MOVE ' ' X9 AR021 0003370C MOVELX9 BUFFER AR021 03380C Z-ADD9 BLNGTH AR021 03390C EXSR CRTCOM AR021 03400C EXSR GETNUM AR021 03410C N50N51 GOTO DSMAN RUBOUT AR021 03420C MOVE FIELD FLD AR021 03430C 48 Z-SUBFLD DISC 82 AR021 0003440C N48 Z-ADDFLD DISC AR021 03450C* AR021 03460C* CHECK FOR PARTIAL PAYMENT, NEGATIVE BALANCE AR021 03470C* AR021 03480C DISC ADD CASH FLD AR021 03490C N58 FLD COMP STILL 4241 AR021 03500C 58 FLD COMP 0 4241 AR021 0003510C 42 Z-ADD95 L AR021 03520C 41 Z-ADD94 L AR021 03530C 58 GOTO CASHOK AR021 03540C N41N42 GOTO CASHOK AR021 03550C 41 AR021 03560COR 42 EXSR PRT AR021 03570C EXSR OK AR021 0003580C N52 GOTO APMAN AR021 03590C CASHOK TAG AR021 03600C* AR021 03610C DISC ADD CASH SFLD 92 AR021 03620C* GETS CHECK#, ABA # AR021 03630C* AR021 03640C EXSR LINE AR021 0003650C Z-ADD11 BLNGTH AR021 03660C EXSR PAD AR021 03670C MOVEL'CHECK#- 'X9 9 ASK CHECK- AR021 03680C MOVE ' ' X9 AR021 03690C MOVELX9 BUFFER AR021 03700C Z-ADD9 BLNGTH AR021 03710C MOVE 'S' TYPE AR021 0003720C EXSR CRTCOM AR021 03730C EXSR GETNUM AR021 03740C* NEGATIVE OR AR021 03750C N50N51 GOTO CASHOK ENTERED WITH AR021 03760C MOVE FIELD FLD AR021 03770C Z-ADDFLD CHECK 60 AR021 03780C CASH01 TAG NON-LF AR021 0003790C Z-ADD9 BLNGTH AR021 03800C EXSR PAD AR021 03810C MOVEL' ABA#- 'X9 AR021 03820C MOVE ' ' X9 ASK ABA NO. AR021 03830C MOVELX9 BUFFER AR021 03840C MOVE 'S' TYPE AR021 03850C Z-ADD9 BLNGTH AR021 0003860C EXSR CRTCOM AR021 03870C MOVE 'A' TYPE AR021 03880C Z-ADD25 BLNGTH AR021 03890C EXSR CLEAR AR021 03900C EXSR CRTCOM AR021 03910C RCODE COMP 'C' 50 AR021 03920C RCODE COMP 'L' 51 RETRY IF NON- AR021 0003930C N50N51 GOTO CASH01 CR OR NON-LF AR021 03940C 51 EXSR LINE AR021 03950C MOVELBUFFER ABA 10 AR021 03960C WRTCA TAG AR021 03970C EXSR OK AR021 03980C N52 GOTO B AR021 03990C SETON 931259 AR021 0004000C STILL SUB SFLD STILL AR021 04010C EXCPT AR021 04020C SETOF 931259 AR021 04030C Z-ADD93 L AR021 04040C EXSR PRT AR021 04050C CASH ADD TRTOT TRTOT 92 AR021 04060C DISC ADD DSTOT DSTOT 92 AR021 0004070C GOTO NEWCA AR021 04080C* AR021 04090C* AJUSTMENT AR021 04100C* AR021 04110C NEWADJ TAG AR021 04120C EXSR CLRSCR AR021 04130C 1 ADD SEQNO SEQNO AR021 0004140C EXSR LINE AR021 04150C MOVE 'S' TYPE AR021 04160C MOVEL'* AJ * ' BUFFER AR021 04170C Z-ADD7 BLNGTH AR021 04180C EXSR CRTCOM AR021 04190C GOTO NOAJ AR021 04200C BADCUS TAG AR021 0004210C Z-ADD7 BLNGTH AR021 04220C EXSR PAD AR021 04230C NOAJ TAG AR021 04240C SETOF 58 AR021 04250C MOVE 'S' TYPE AR021 04260C MOVEL' CUSTOM'X13 AR021 04270C MOVE 'ER- ' X13 AR021 0004280C MOVELX13 BUFFER AR021 04290C Z-ADD13 BLNGTH AR021 04300C EXSR CRTCOM AR021 04310C EXSR GETNUM AR021 04320C N50N51 GOTO BADCUS RETRY AR021 04330C 48 GOTO BADCUS AR021 04340C X1 COMP 'E' 71 ENTERED & END AR021 0004350C 71 GOTO ENDBCH BATCH AR021 04360C MOVE FIELD CUSNO AR021 04370C CUSNO CHAINARMAST 70 AR021 04380C N70 GOTO ACUSOK AR021 04390C Z-ADD89 L AR021 04400C EXSR PRT AR021 04410C GOTO BADCUS AR021 0004420C ACUSOK TAG AR021 04430C Z-ADD9 BLNGTH AR021 04440C EXSR PAD AR021 04450C MOVE 'S' TYPE AR021 04460C MOVEL'DOC NO.-'X10 10 AR021 04470C MOVE ' ' X10 AR021 04480C MOVELX10 BUFFER AR021 0004490C Z-ADD10 BLNGTH AR021 04500C EXSR CRTCOM AR021 04510C EXSR GETNUM AR021 04520C N50N51 AR021 04530COR 48 GOTO ACUSOK AR021 04540C MOVE FIELD INVNO 70 AR021 04550C EXSR CHAIN1 AR021 0004560C INVNO COMP 9999999 40 NON-EXISTANT AR021 04570C 40 70 SETON 58 AR021 04580C 40 SETOF 70 DOCUMENT IF AR021 04590C N70 GOTO AOKDOC IT IS 999999 AR021 04600C Z-ADD92 L AR021 04610C EXSR PRT AR021 04620C GOTO ACUSOK ERROR MESSAGE AR021 0004630C AOKDOC TAG AR021 04640C AAMTGT TAG AR021 04650C Z-ADD9 BLNGTH AR021 04660C EXSR PAD AR021 04670C MOVE 'S' TYPE AR021 04680C MOVEL'AMOUNT- 'X9 9 AR021 04690C MOVE ' ' X9 AR021 0004700C MOVELX9 BUFFER AR021 04710C Z-ADD9 BLNGTH AR021 04720C EXSR CRTCOM AR021 04730C EXSR GETNUM RETRY IF NOT AR021 04740C N50N51 GOTO AAMTGT AR021 04750C MOVE FIELD FMT AR021 04760C N48 Z-ADDFMT ADJUST 92 AR021 0004770C 48 Z-SUBFMT ADJUST 92 AR021 04780C 58 Z-ADDADJUST FMT 42 AR021 04790C N58 STILL ADD ADJUST FMT 42 CHECK TO SEE AR021 04800C N42 GOTO APOSBA IF INVOICE AR021 04810C Z-ADD95 L AR021 04820C EXSR PRT AR021 04830C EXSR OK AR021 0004840C N52 GOTO AAMTGT AR021 04850C APOSBA TAG AR021 04860C EXSR OK AR021 04870C N52 GOTO BADCUS AR021 04880C SETON 178659 AR021 04890C STILL ADD ADJUST STILL AR021 04900C EXCPT AR021 0004910C SETOF 178659 AR021 04920C Z-ADD86 L AR021 04930C EXSR PRT AR021 04940C ADJUST ADD TRTOT TRTOT AR021 04950C GOTO NEWADJ AR021 04960C* AR021 04970C* IN, CM, DM AR021 0004980C* AR021 04990C NEWICD TAG AR021 05000C EXSR CLRSCR AR021 05010C 1 ADD SEQNO SEQNO AR021 05020C MOVE 'S' TYPE AR021 05030C 02 MOVEL'* INV *' BUFFER AR021 05040C 03 MOVEL'* CM * ' BUFFER AR021 0005050C 04 MOVEL'* DM * ' BUFFER AR021 05060C Z-ADD7 BLNGTH AR021 05070C EXSR CRTCOM AR021 05080C GOTO CONICD AR021 05090C CUSICD TAG AR021 05100C Z-ADD7 BLNGTH AR021 05110C EXSR PAD AR021 0005120C CONICD TAG AR021 05130C SETOF 56 AR021 05140C MOVE 'S' TYPE PUT 'CUSTOMER-'AR021 05150C MOVEL' CUSTOM'X13 13 AR021 05160C MOVE 'ER# ' X13 AR021 05170C MOVELX13 BUFFER AR021 05180C Z-ADD13 BLNGTH AR021 0005190C EXSR CRTCOM AR021 05200C EXSR GETNUM GET CUSTNO AR021 05210C N50N51 GOTO CUSICD RETRY NON CR,LFAR021 05220C 48 GOTO CUSICD RETRY IF NEG. AR021 05230C MOVE FIELD CUSNO 60 AR021 05240C MOVELBUFFER X1 1 AR021 05250C X1 COMP 'E' 71 AR021 0005260C 71 GOTO ENDBCH AR021 05270C CUSNO CHAINARMAST 70 AR021 05280C N70 GOTO CUSOK AR021 05290C Z-ADD89 L AR021 05300C EXSR PRT AR021 05310C GOTO CUSICD AR021 05320C CUSOK TAG AR021 0005330C Z-ADD9 BLNGTH AR021 05340C EXSR PAD AR021 05350C MOVE 'S' TYPE GET INVOICE# AR021 05360C 02 MOVEL'INVOICE-'X10 10 AR021 05370C N02 MOVEL'DOC NO.-'X10 AR021 05380C MOVE ' ' X10 AR021 05390C MOVELX10 BUFFER AR021 0005400C Z-ADD10 BLNGTH AR021 05410C EXSR CRTCOM AR021 05420C EXSR GETNUM AR021 05430C N50N51 NOT CR, LF OR AR021 05440COR 48 GOTO CUSOK NEGATIVE, RETRYAR021 05450C MOVE FIELD INVNO 70 AR021 05460C INVNO COMP 9999999 20 AR021 0005470C 20 MOVE BLANK X20 AR021 05480C 20 MOVEL'9999999 'X20 20 AR021 05490C 20 MOVE 'INVALID 'X20 AR021 05500C 20 MOVELX20 BUFFER AR021 05510C 20 Z-ADD20 BLNGTH AR021 05520C 20 MOVE 'S' TYPE AR021 05530C 20 EXSR CRTCOM AR021 0005540C 20 GOTO CUSOK AR021 05550C INVNO CHAINARIND1 70 AR021 05560C 70 GOTO BYPASS AR021 05570C CUSTNO COMP CUSNO 5656 AR021 05580C N56 GOTO BYPASS AR021 05590C Z-ADD56 L AR021 05600C EXSR PRT AR021 0005610C GOTO CUSICD AR021 05620C BYPASS TAG AR021 05630C 03 70 AR021 05640COR 04 70 SETON 25 AR021 05650C 03 ALLOW EXISTING AR021 05660COR 04 SETON 70 CM, DM AR021 05670C 70 GOTO OKDOC AR021 0005680C Z-ADD88 L AR021 05690C EXSR PRT AR021 05700C GOTO CUSICD AR021 05710C OKDOC TAG AR021 05720C AMTGET TAG AR021 05730C Z-ADD11 BLNGTH GET GROSS. AR021 05740C EXSR PAD FREIGHT, AR021 0005750C MOVE 'S' TYPE TAX, AR021 05760C MOVEL'GROSS AM'X12 NET AMOUNTSAR021 05770C MOVE 'T- ' X12 AR021 05780C MOVELX12 BUFFER AR021 05790C Z-ADD12 BLNGTH AR021 05800C EXSR CRTCOM AR021 05810C EXSR GETNUM AR021 0005820C N50N51 GOTO AMTGET AR021 05830C MOVE FIELD FMT AR021 05840C N48 Z-ADDFMT GROSS 92 AR021 05850C 48 Z-SUBFMT GROSS AR021 05860C GETTAX TAG AR021 05870C Z-ADD11 BLNGTH AR021 05880C EXSR PAD AR021 0005890C MOVE 'S' TYPE AR021 05900C MOVEL'TAX- ' BUFFER AR021 05910C Z-ADD6 BLNGTH AR021 05920C EXSR CRTCOM AR021 05930C EXSR GETNUM AR021 05940C N50N51 GOTO GETTAX CR OR LF AR021 05950C MOVE FIELD FMT 92 AR021 0005960C N48 Z-ADDFMT TAX 72 AR021 05970C 48 Z-SUBFMT TAX AR021 05980C GETFRT TAG AR021 05990C Z-ADD9 BLNGTH AR021 06000C EXSR PAD AR021 06010C MOVE 'S' TYPE AR021 06020C MOVEL' FRT- 'BUFFER AR021 0006030C Z-ADD8 BLNGTH AR021 06040C EXSR CRTCOM AR021 06050C EXSR GETNUM AR021 06060C N50N51 GOTO GETFRT AR021 06070C FRTOK TAG AR021 06080C MOVE FIELD FMT SPACE OVER AR021 06090C 48 Z-SUBFMT FRT 72 TO THE NEXT AR021 0006100C N48 Z-ADDFMT FRT 72 (NET) COLUMNAR021 06110C GETNET TAG AR021 06120C Z-ADD9 BLNGTH AR021 06130C EXSR PAD AR021 06140C MOVE 'S' TYPE AR021 06150C MOVEL' NET- 'BUFFER AR021 06160C Z-ADD8 BLNGTH AR021 0006170C EXSR CRTCOM AR021 06180C EXSR GETNUM AR021 06190C N50N51 GOTO GETNET AR021 06200C NETOK TAG AR021 06210C 51 EXSR LINE AR021 06220C MOVE FIELD FMT AR021 06230C N48 Z-ADDFMT NET 92 AR021 0006240C PROOFC TAG AR021 06250C NET COMP 0 60 PROOF CHECK AR021 06260C TAX COMP 0 61 NET+FRT+TAX AR021 06270C FRT COMP 0 62 =GROSS AR021 06280C 48 Z-SUBFMT NET AR021 06290C 60 61 62 GOTO SKIPCH AR021 06300C Z-ADDGROSS FMT AR021 0006310C FMT SUB TAX FMT AR021 06320C FMT SUB FRT FMT AR021 06330C FMT COMP NET 6363 AR021 06340C N63 GOTO SKIPCH AR021 06350C Z-ADD87 L AR021 06360C EXSR PRT AR021 06370C GOTO AMTGET AR021 0006380C SKIPCH TAG AR021 06390C N03N04 GOTO POSBAL CHECK TO SEE AR021 06400C EXSR CHAIN1 AR021 06410C 70 Z-ADD0 STILL BALANCE IS AR021 06420C 03 STILL SUB GROSS FMT 42 NEGATIVE AR021 06430C 04 STILL ADD GROSS FMT 42 AR021 06440C N42 GOTO POSBAL AR021 0006450C Z-ADD95 L AR021 06460C EXSR PRT AR021 06470C EXSR OK AR021 06480C N52 GOTO AMTGET AR021 06490C POSBAL TAG AR021 06500C EXSR LINE AR021 06510C EXSR GETDAT AR021 0006520C TX1 TAG AR021 06530C N61 MOVE 'C' TAXCD AR021 06540C N61 GOTO SKPTXC AR021 06550C Z-ADD11 BLNGTH AR021 06560C EXSR PAD AR021 06570C MOVE 'S' TYPE AR021 06580C MOVEL'TAX CODE'X11 11 AR021 0006590C MOVE '- ' X11 AR021 06600C MOVELX11 BUFFER AR021 06610C Z-ADD11 BLNGTH AR021 06620C EXSR CRTCOM AR021 06630C MOVE 'A' TYPE AR021 06640C Z-ADD25 BLNGTH AR021 06650C EXSR CRTCOM AR021 0006660C RCODE COMP 'C' 50 AR021 06670C EXSR LINE AR021 06680C N50 GOTO TX1 AR021 06690C MOVELBUFFER TAXCD 1 AR021 06700C TAXCD COMP ' ' 31 AR021 06710C TAXCD COMP 'O' 32 AR021 06720C TAXCD COMP 'C' 33 AR021 0006730C N31N32N33 GOTO TX1 AR021 06740C SKPTXC TAG AR021 06750C EXSR OK AR021 06760C N52 GOTO CUSICD AR021 06770C SETON 138659 AR021 06780C 03 AR021 06790COR 04 STILL ADD GROSS STILL AR021 0006800C EXCPT AR021 06810C SETOF 138659 AR021 06820C Z-ADD86 L AR021 06830C EXSR PRT AR021 06840C SETOF 4263 AR021 06850C GROSS ADD TRTOT TRTOT AR021 06860C GOTO NEWICD AR021 0006870C* AR021 06880C* END OF BATCH AR021 06890C* AR021 06900C ENDBCH TAG AR021 06910C SETOF 71 AR021 06920C EXSR CLRSCR AR021 06930C EXSR INCH AR021 0006940C SETON 99 AR021 06950C EXCPT AR021 06960C SETOF 99 AR021 06970C EXSR INCH AR021 06980C MOVE 'S' TYPE AR021 06990C MOVEL'END OF B'X14 14 AR021 07000C MOVE 'ATCH ' X14 AR021 0007010C MOVELX14 BUFFER AR021 07020C Z-ADD14 BLNGTH AR021 07030C EXSR CRTCOM AR021 07040C Z-ADD4 BLNGTH AR021 07050C MOVELCBATCH BUFFER AR021 07060C EXSR CRTCOM AR021 07070C Z-ADD23 BLNGTH AR021 0007080C MOVEL'. CONTR'X16 16 AR021 07090C MOVE 'OL TOTAL'X16 AR021 07100C MOVE 'S... ' X23 23 AR021 07110C MOVELX16 X23 AR021 07120C MOVELX23 BUFFER AR021 07130C EXSR CRTCOM AR021 07140C EXSR LINE AR021 0007150C MOVE 'S' TYPE AR021 07160C Z-ADD14 BLNGTH AR021 07170C MOVELCTRTOT BUFFER AR021 07180C EXSR CRTCOM AR021 07190C Z-ADD20 BLNGTH AR021 07200C MOVEL' TRANSA'X16 16 AR021 07210C MOVE 'CTION TO'X16 AR021 0007220C MOVE 'TAL ' X20 20 AR021 07230C MOVELX16 X20 AR021 07240C MOVELX20 BUFFER AR021 07250C EXSR CRTCOM AR021 07260C EXSR LINE AR021 07270C MOVE 'S' TYPE AR021 07280C Z-ADD14 BLNGTH AR021 0007290C MOVELCDSTOT BUFFER AR021 07300C EXSR CRTCOM AR021 07310C Z-ADD17 BLNGTH AR021 07320C MOVEL' DISCOU'X16 16 AR021 07330C MOVE 'NT TOTAL'X16 AR021 07340C MOVE ' ' X17 17 AR021 07350C MOVELX16 X17 AR021 0007360C MOVELX17 BUFFER AR021 07370C EXSR CRTCOM AR021 07380C EXSR LINE AR021 07390C LMSGAG TAG AR021 07400C EXSR LINE AR021 07410C MOVE 'S' TYPE AR021 07420C MOVEL'C-CONTIN'X16 AR021 0007430C MOVE 'UE E-EN'X16 AR021 07440C MOVE 'D JOB- 'X8 8 AR021 07450C MOVELX16 X24 24 AR021 07460C MOVE X8 X24 AR021 07470C MOVELX24 BUFFER AR021 07480C Z-ADD24 BLNGTH AR021 07490C EXSR CRTCOM AR021 0007500C MOVE 'A' TYPE AR021 07510C Z-ADD2 BLNGTH AR021 07520C EXSR CRTCOM AR021 07530C EXSR LINE AR021 07540C RCODE COMP 'C' 50 AR021 07550C N50 GOTO LMSGAG AR021 07560C MOVELBUFFER X1 AR021 0007570C X1 COMP 'C' 44 AR021 07580C 44 GOTO NEWTR AR021 07590C X1 COMP 'E' LR AR021 07600C NLR GOTO LMSGAG AR021 07610CLR MOVE ' ' X70 70 AR021 07620C********************************************************************AR021 07630C* *AR021 0007640C* LINKAGE SUBR'S FOR RT-ADJUSTING AND CRT-COMMUNICATION *AR021 07650C* *AR021 07660CSR CLRSCR BEGSR AR021 07670CSR MOVE 'C' TYPE AR021 07680CSR EXSR CRTCOM AR021 07690CSR ENDSR AR021 07700C********************************************************************AR021 0007710CSR PARMRJ BEGSR AR021 07720CSR MOVELVL VAR 15 AR021 07730CSR ENDSR AR021 07740C********************************************************************AR021 07750CSR CRTBUF BEGSR AR021 07760CSR MOVE BLNGTH RCODE 1 AR021 07770CSR MOVE TYPE MASK 10 AR021 0007780CSR MOVE ' ' BUFFER 72 AR021 07790CSR ENDSR AR021 07800C********************************************************************AR021 07810CSR CRTCOM BEGSR AR021 07820CSR EXITFSUBRCM AR021 07830CSR RLABL BUFFER AR021 07840CSR RLABL TYPE AR021 0007850CSR RLABL BLNGTH AR021 07860CSR RLABL RCODE AR021 07870CSR RLABL MASK AR021 07880CSR RLABL DTYPE 10 AR021 07890CSR ENDSR AR021 07900C********************************************************************AR021 07910CSR RTADJ BEGSR AR021 0007920CSR EXIT SUBRAJ AR021 07930CSR RLABL VL AR021 07940CSR RLABL VAR AR021 07950CSR ENDSR AR021 07960C********************************************************************AR021 07970C* AR021 07980C* SUBROUTINE LINE SPACES TO THE NEXT LINE. AR021 0007990C* AR021 08000CSR LINE BEGSR AR021 08010CSR MOVE BUFFER SAVBUF 72 AR021 08020CSR MOVE 'T' TYPE AR021 08030CSR EXSR CLEAR AR021 08040CSR Z-ADD1 BLNGTH AR021 08050CSR EXSR CRTCOM AR021 0008060CSR MOVE SAVBUF BUFFER AR021 08070CSR ENDSR AR021 08080C* AR021 08090C* SUBROUTINE PAD PRINTS N BLANKS AR021 08100CSR PAD BEGSR AR021 08110CSR MOVE 'S' TYPE AR021 08120CSR EXSR CLEAR AR021 0008130CSR EXSR CRTCOM AR021 08140CSR ENDSR AR021 08150C* AR021 08160C* SUBROUTINE CLEAR MOVES BLANKS TO BUFFER AR021 08170C* AR021 08180CSR CLEAR BEGSR AR021 08190CSR MOVELX70 BUFFER AR021 0008200CSR ENDSR AR021 08210C* AR021 08220C* SUBROUTINE OK ASKS OK?- 52 YES, 53 NO, 54 RETRY, 55 OTHER AR021 08230C* AR021 08240CSR OK BEGSR AR021 08250CSR OK1 TAG AR021 08260CSR SETOF 55 AR021 0008270CSR Z-ADD11 BLNGTH AR021 08280CSR EXSR PAD AR021 08290CSR MOVE 'S' TYPE AR021 08300CSR Z-ADD6 BLNGTH AR021 08310CSR MOVEL'OK?- ' BUFFER AR021 08320CSR EXSR CRTCOM AR021 08330CSR EXSR CLEAR AR021 0008340CSR MOVE 'A' TYPE AR021 08350CSR Z-ADD1 BLNGTH AR021 08360CSR EXSR CRTCOM AR021 08370CSR MOVELBUFFER X1 1 AR021 08380CSR X1 COMP 'Y' 52 AR021 08390CSR X1 COMP 'N' 53 AR021 08400CSR X1 COMP 'R' 54 AR021 0008410CSRN52N53N54 SETON 55 AR021 08420CSR 55 EXSR LINE AR021 08430CSR 55 GOTO OK1 AR021 08440CSR MOVE 'T' TYPE AR021 08450CSR 52 Z-ADD2 BLNGTH AR021 08460CSR 52 MOVEL'ES' BUFFER AR021 08470CSR 53 Z-ADD1 BLNGTH AR021 0008480CSR 53 MOVEL'O' BUFFER AR021 08490CSR 54 Z-ADD4 BLNGTH AR021 08500CSR 54 MOVEL'ETRY' BUFFER AR021 08510CSR EXSR CRTCOM AR021 08520CSR ENDSR AR021 08530C* AR021 08540C* SUBROUTINE PRT PRINTS A LINE IN TAB2 ON TO THE CRT AR021 0008550C* AR021 08560CSR PRT BEGSR AR021 08570CSR EXSR LINE AR021 08580CSR L LOKUPTAB1 TAB2 08 AR021 08590CSR Z-ADD42 BLNGTH AR021 08600CSR MOVELTAB2 BUFFER AR021 08610CSR MOVE 'T' TYPE AR021 0008620CSR EXSR CRTCOM AR021 08630CSR ENDSR AR021 08640CSR INCH BEGSR AR021 08650CSR 1 CHAININFO 98 AR021 08660CSR ENDSR AR021 08670C* AR021 08680C* SUBROUTINE GETNUM ASKS FOR A 10 CHARACTER FIELD, LOOKS FOR AR021 0008690C* A MINUS SIGN IN THE FIRST POS, RIGHT ADJUSTS IT TO A 9 DIGIT AR021 08700C* FIELD, EXITS AR021 08710CSR GETNUM BEGSR AR021 08720CSR MOVE 'A' TYPE AR021 08730CSR Z-ADD25 BLNGTH AR021 08740CSR EXSR CLEAR AR021 08750CSR EXSR CRTCOM AR021 0008760CSR RCODE COMP 'C' 50 AR021 08770CSR RCODE COMP 'L' 51 AR021 08780CSR RCODE COMP 'R' 49 AR021 08790CSR 49 GOTO ENDGET AR021 08800CSR MOVELBUFFER X1 1 AR021 08810CSR X1 COMP '-' 48 AR021 08820CSR 48 MOVEL'0' BUFFER AR021 0008830CSR Z-ADD9 VL 20 AR021 08840CSR MOVELBUFFER VAR AR021 08850CSR EXSR RTADJ AR021 08860CSR MOVELVAR FIELD 9 AR021 08870CSR EXSR LINE AR021 08880CSR ENDGET ENDSR AR021 08890C* AR021 0008900C* SUBROUTINE GETCUS GETS CUSTOMER NUMBER FOR OPEN ACCOUNT TRANSACTIOAR021 08910C* AR021 08920CSR GETCUS BEGSR AR021 08930CSR GETC1 TAG AR021 08940CSR Z-ADD10 BLNGTH AR021 08950CSR EXSR PAD AR021 08960CSR MOVE 'S' TYPE AR021 0008970CSR Z-ADD8 BLNGTH AR021 08980CSR MOVEL'CUST#- 'BUFFER AR021 08990CSR EXSR CRTCOM AR021 09000CSR EXSR GETNUM AR021 09010CSR 48 GOTO GETC1 AR021 09020CSR MOVE FIELD CUSTNO AR021 09030CSR CUSTNO CHAINARMAST 70 AR021 0009040CSR 70 Z-ADD89 L AR021 09050CSR 70 EXSR PRT AR021 09060CSR ENDSR AR021 09070C********************************************************************AR021 09080C* *AR021 09090C* SUBROUTINE GETDAT GETS DATE FROM CRT, CHECKS VALIDITY, *AR021 09100C* AND RETURNS ASOF, ADA, AMO, AYR *AR021 0009110C* *AR021 09120C********************************************************************AR021 09130CSR GETDAT BEGSR AR021 09140CSR LOOP TAG AR021 09150CSR Z-ADD11 BLNGTH AR021 09160CSR EXSR PAD AR021 09170CSR MOVE 'S' TYPE 1 AR021 0009180CSR Z-ADD7 BLNGTH 20 AR021 09190CSR MOVEL'DATE- ' BUFFER 72 AR021 09200CSR EXSR CRTCOM AR021 09210CSR MOVE 'A' TYPE AR021 09220CSR Z-ADD7 BLNGTH AR021 09230CSR EXSR CRTCOM AR021 09240C* AR021 0009250C* CHECK TO SEE THAT ENTRY WAS TERMINATED WITH CARRIAGE RETURN AR021 09260C* AR021 09270CSR RCODE COMP 'C' 4040 AR021 09280CSRN40 GOTO CHEC9 AR021 09290CSR SKIP TAG AR021 09300CSR EXSR LINE AR021 09310CSR GOTO LOOP AR021 0009320C* AR021 09330C* CHECK TO SEE DATE IS VALID AR021 09340C* AR021 09350CSR CHEC9 TAG AR021 09360CSR MOVELBUFFER ASOF 60 AR021 09370CSR MOVE ASOF AYR 20 AR021 09380CSR MOVELASOF AMO 20 AR021 0009390CSR MOVE ASOF NUM4 40 AR021 09400CSR MOVELNUM4 ADA 20 AR021 09410C* AR021 09420C* AR021 09430C* AR021 09440CSR AYR COMP 90 41 > 1990 AR021 09450CSR AYR COMP 74 42 < 1974 AR021 0009460CSR 41 AR021 09470COR 42 GOTO LOOP AR021 09480CSR ADA COMP 31 41 > 31 AR021 09490CSR ADA COMP 0 4242 <= 0 AR021 09500CSR 41 AR021 09510COR 42 GOTO LOOP AR021 09520CSR AMO COMP 12 41 > 12 AR021 0009530CSR AMO COMP 0 42 = 0 AR021 09540CSR 41 AR021 09550COR 42 GOTO LOOP AR021 09560CSR SETOF 404142 AR021 09570CSR ENDSR AR021 09580CSR CHAIN1 BEGSR AR021 09590CSR INVNO CHAINARIND1 70 A AR021 0009600CSRN70 CUSNO COMP CUSTNO 7070 AR021 09610CSR ENDSR AR021 09620CSR CALCSD BEGSR AR021 09630CSR CASH ADD DISC HOLD 92 AR021 09640CSR 12 AR021 09650COR 13 03 STILL SUB HOLD STILL AR021 09660CSR 13 04 AR021 0009670COR 17 STILL ADD HOLD STILL AR021 09680CSR ENDSR AR021 09690OINFO E 96 AR021 09700O STILL L 15 AR021 09710O CASH L 27 AR021 09720O DISC L 38 AR021 09730O E 99 AR021 0009740O BATCH 3 3 AR021 09750O TRTOT JB 52 AR021 09760O DSTOT JB 66 AR021 09770OCARDS EADD 11 AR021 09780O 2 'BH' AR021 09790O BATCH 5 AR021 09800O TRANCD 7 AR021 0009810O TTOT 17 AR021 09820O DTOT 27 AR021 09830O BATCH 76 AR021 09840O SEQNO 80 AR021 09850OCARDS EADD 12 AR021 09860O 2 'CA' AR021 09870O CUSTNO 8 AR021 0009880O INVNO 15 AR021 09890O CASH 24 AR021 09900O DISC 32 AR021 09910O CHECK 38 AR021 09920O ABA 48 AR021 09930O BATCH 76 AR021 09940O SEQNO 80 AR021 0009950OCARDS EADD 13 AR021 09960O TRANCD 2 AR021 09970O CUSNO 8 AR021 09980O INVNO 15 AR021 09990O ASOF 21 AR021 10000O GROSS 30 AR021 10010O FRT 37 AR021 0010020O TAXCD 38 AR021 10030O TAX 45 AR021 10040O NET 54 AR021 10050O BATCH 76 AR021 10060O SEQNO 80 AR021 10070OCARDS EADD 17 AR021 10080O 2 'AJ' AR021 0010090O CUSNO 8 AR021 10100O INVNO 15 AR021 10110O ADJUST 24 AR021 10120O BATCH 76 AR021 10130O SEQNO 80 AR021 10140OARIND1 E 12N58 AR021 10150O OR 17N58 AR021 0010160O OR 13 03N25 AR021 10170O OR 13 04N25 AR021 10180O STILL 31 AR021 10190O EADD 13 02 AR021 10200O OR 13 03 25 AR021 10210O OR 13 04 25 AR021 10220O CUSNO 6 AR021 0010230O INVNO 13 AR021 10240O GROSS 22 AR021 10250O GROSS 31 AR021 ** 010260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 010270ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 010280ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 01029000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 010300/* 010310__0O GROSS 31 AR021 ** 010260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 010270ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 010280ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0102900($L TXAR022 P`999999032778(000010H S AR022 00020X DECK-ID A33 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR022 00030F* ACCEPTS THRU CRT AND UPDATES CARDS FILE AR022 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR022 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR022 00060F* CONTROL DATA PROPRIETARY PRODUCT AR022 00070F* AR022 0000080FNULL IP F 72 DISK AR022 00090FCARDS UC F 80R 7AI 74 DISK AR022 00100FARIND1 UC F 32R 7AI 7 DISK AR022 00110F* AR022 00120F* UPDATES CARDS FILE BY REL REC#. NO ADDS AR022 00130F* AR022 00140F********************************************************************AR022 0000150F* ID F C H L FUNCTION OF INDICATORS AR022 00160F* AR022 00170F* 01 BH CARD WAS READ. AR022 00180F* 02 CA CARD WAS READ. AR022 00190F* 03 AT CARD WAS READ. AR022 00200F* 04 GL CARD WAS READ. AR022 00210F* 05 IN,DM,CM. AR022 0000220F* 21 A REL REC# HAS BEEN PROCESSED. AR022 00230F* 22 'E' WAS INPUT FOR REL REC#. -END THE JOB.- AR022 00240F* 23 THIS REL REC# IS BEHIND CURRENT REC. EJ. AR022 00250F* 24 THIS IS THE RECORD BEING SEARCHED FOR AR022 00260F* 25 RETURN CODE FROM SUBRCM IS 'R'(RUB OUT). AR022 00270F* 26 RETURN CODE FROM SUBRCM IS 'C' (CARR-RET). AR022 00280F* 27 RETURN CODE FROM SUBRCM IS 'L' (LINE FEED). AR022 0000290F* 28 FIELD TYPE IN SUBR GETFLD IS ALPHA. AR022 00300F* 29 THE NUMBER WHICH WAS RTADJ'ED WAS NEG. (IS NOW POS) AR022 00310F* AR022 00320F* AR022 00330E* AR022 00340E MES 1 4 50 MESSAGES AR022 00350E PRM 1 15 12 PROMPTS AR022 0000360INULL NS 10 AR022 00370I 1 1 A AR022 00380ICARDS NS 01 1 CB 2 CH AR022 00390I 1 2 TRCODE AR022 00400I NS 02 1 CC 2 CA AR022 00410I 1 2 TRCODE AR022 00420I 3 8 CUST AR022 0000430I 9 15 INVNO AR022 00440I 16 24 CASH AR022 00450I 25 32 DISC AR022 00460I NS 03 1 CA 2 CJ AR022 00470I 1 2 TRCODE AR022 00480I 3 8 CUST AR022 00490I 9 15 INVNO AR022 0000500I 16 24 AJAMT AR022 00510I NS 04 1 CG 2 CL AR022 00520I 1 2 TRCODE AR022 00530I 3 12 ACCT AR022 00540I 19 27 GLAMT AR022 00550I NS 05 1 CI 2 CN AR022 00560I OR 05 1 CC 2 CM AR022 0000570I OR 05 1 CD 2 CM AR022 00580I 1 2 TRCODE AR022 00590I 3 8 CUST AR022 00600I 9 15 INVNO AR022 00610I 22 30 GROSS AR022 00620I 31 37 FRT AR022 00630I 38 38 TXCD AR022 0000640I 39 45 TXAMT AR022 00650I 46 54 NET AR022 00660IARIND1 NS 06 AR022 00670I 23 312STILL AR022 00680CLR 21 GOTO START AR022 00690CLR NEWRRN TAG AR022 00700CLR EXSR CLRSCR AR022 0000710CLR EXSR GETKEY AR022 00720CLR 22 GOTO START AR022 00730CLR SETOF 020305 AR022 00740CLR SETOF 01 AR022 00750CLR RRN CHAINCARDS 23 AR022 00760CLR 23 MOVELMES,1 BUFFER AR022 00770CLR 23 EXSR MESSGE AR022 0000780CLR 23 GOTO NEWRRN AR022 00790CLR SETON 21 AR022 00800C* AR022 00810CLR START TAG AR022 00820CLR 22 GOTO END AR022 00830C* AR022 00840C* THIS IS THE REC BEING SEARCHED FOR. AR022 0000850CLR SETOF 21 NEXT CYCLE, GETAR022 00860CLR 01 GOTO BH NEW RRN. AR022 00870CLR 02 GOTO CA AR022 00880CLR 03 GOTO AJ AR022 00890CLR 04 GOTO GL AR022 00900CLR 05 GOTO INDMCM AR022 00910CLR GOTO NEWRRN AR022 0000920C********************************************************************AR022 00930C* BATCH HEADER CAN'T BE CHANGED. (NO NEED TO) AR022 00940C* AR022 00950CLR BH TAG AR022 00960CLR MOVELMES,2 BUFFER DISPLAY ERROR. AR022 00970CLR EXSR MESSGE GET NEW AR022 00980CLR SETOF 21 REL REC #. AR022 0000990CLR GOTO NEWRRN AR022 01000C********************************************************************AR022 01010C* AR022 01020CLR CA TAG AR022 01030CLR EXSR COMMON GET TR,CUST,INVAR022 01040CLR CACSH TAG GET CASH AMT AR022 01050CLR MOVELPRM,10 BUFFER AR022 0001060CLR EXSR PROMPT AR022 01070CLR Z-ADD9 BLNGTH AR022 01080CLR EXSR ACCEPT AR022 01090CLR 25 GOTO CACSH RUB-OUT AR022 01100CLRN27 GOTO CACSRJ NOT LF, RTADJ AR022 01110CLR MOVE CASH NCASH 9 LF- DUPE & AR022 01120CLR MOVELCASH BUFFER DISPLAY AR022 0001130CLR Z-ADD9 BLNGTH AR022 01140CLR MOVE 'T' TYPE AR022 01150CLR EXSR CRTCOM AR022 01160CLR GOTO CADISC AR022 01170CLR CACSRJ TAG RTADJ CASH AR022 01180CLR Z-ADD9 VL AR022 01190CLR EXSR RTADJ AR022 0001200CLR MOVELBUFFER NCASH AR022 01210CLR EXSR BLINE AR022 01220C** AR022 01230C* AR022 01240C* GET DISCOUNT ON CA CARD AR022 01250C* AR022 01260CLR CADISC TAG AR022 0001270CLR MOVELPRM,11 BUFFER AR022 01280CLR EXSR PROMPT AR022 01290CLR Z-ADD8 BLNGTH AR022 01300CLR EXSR ACCEPT AR022 01310CLR 25 GOTO CADISC RUB-OUT. RETRY AR022 01320CLRN27 GOTO CADSRJ NOT LF, RTADJ AR022 01330CLR MOVE DISC NDISC 8 LF- DUPE AR022 0001340CLR MOVELDISC BUFFER & DISPLAY AR022 01350CLR Z-ADD8 BLNGTH AR022 01360CLR MOVE 'T' TYPE AR022 01370CLR EXSR CRTCOM AR022 01380CLR EXCPT AR022 01390CLR GOTO NEWRRN AR022 01400CLR CADSRJ TAG AR022 0001410CLR Z-ADD8 VL AR022 01420CLR EXSR RTADJ AR022 01430CLR MOVELBUFFER NDISC AR022 01440CLR EXSR BLINE AR022 01450CLR EXSR CAUPDT AR022 01460CLR EXCPT AR022 01470CLR GOTO NEWRRN AR022 0001480C********************************************************************AR022 01490C* AR022 01500C* ADJUSTMENT TRANSACTION AR022 01510C* AR022 01520CLR AJ TAG AR022 01530CLR EXSR COMMON AR022 01540CLR AJAMNT TAG AR022 0001550CLR MOVELPRM,12 BUFFER AR022 01560CLR EXSR PROMPT AR022 01570CLR Z-ADD10 BLNGTH AR022 01580CLR EXSR ACCEPT AR022 01590CLR 25 GOTO AJAMNT AR022 01600CLRN27 GOTO AJRAJ NOT LF-RT ADJ AR022 01610CLR MOVE AJAMT NAJAMT 9 LF- DUPE & AR022 0001620CLR MOVELAJAMT BUFFER DISPLAY AR022 01630CLR Z-ADD9 BLNGTH AR022 01640CLR MOVE 'T' TYPE AR022 01650CLR EXSR CRTCOM AR022 01660CLR EXCPT AR022 01670CLR GOTO NEWRRN AR022 01680CLR AJRAJ TAG RTADJ AR022 0001690CLR Z-ADD10 VL AMOUNT. AR022 01700CLR EXSR RTADJ MAY BE NEG. AR022 01710CLR MOVELBUFFER D10 100 AR022 01720CLR 29 Z-SUBD10 D10 NEG- CHG SIGN. AR022 01730CLR MOVE D10 NAJAMT AR022 01740CLR EXSR BLINE AR022 01750CLR EXSR AJUPDT AR022 0001760CLR EXCPT AR022 01770CLR GOTO NEWRRN AR022 01780C********************************************************************AR022 01790C* AR022 01800C* GL HIT. AR022 01810C* AR022 01820CLR GL TAG AR022 0001830CLR MOVE PRM,2 A10 DISPLAY AR022 01840CLR MOVE TRCODE A10 TR AR022 01850CLR MOVELA10 BUFFER CODE. AR022 01860CLR EXSR PROMPT AR022 01870CLR EXSR BLINE AR022 01880CLR GLACCT TAG GET ACCT# AR022 01890CLR MOVELPRM,13 BUFFER AR022 0001900CLR EXSR PROMPT AR022 01910CLR Z-ADD10 BLNGTH AR022 01920CLR EXSR ACCEPT AR022 01930CLR 25 GOTO GLACCT RUB-OUT AR022 01940CLRN27 GOTO GLACRJ NOT LF, RTADJ AR022 01950CLR MOVE ACCT NACCT 10 LF- DUPE AND AR022 01960CLR MOVELACCT BUFFER DISPLAY AR022 0001970CLR Z-ADD10 BLNGTH AR022 01980CLR MOVE 'T' TYPE AR022 01990CLR EXSR CRTCOM AR022 02000CLR GOTO GLAMNT AR022 02010CLR GLACRJ TAG RT-ADJ AR022 02020CLR Z-ADD10 VL ACCT# AR022 02030CLR EXSR RTADJ AR022 0002040CLR MOVELBUFFER NACCT AR022 02050CLR EXSR BLINE AR022 02060CLR GLAMNT TAG GET AMOUNT AR022 02070CLR MOVELPRM,14 BUFFER AR022 02080CLR EXSR PROMPT AR022 02090CLR Z-ADD10 BLNGTH AR022 02100CLR EXSR ACCEPT AR022 0002110CLR 25 GOTO GLAMNT RUB-OUT AR022 02120CLRN27 GOTO GLAMRJ NOT LF, RTADJ AR022 02130CLR MOVE GLAMT NGLAMT 9 LF-DUPE AR022 02140CLR MOVELGLAMT BUFFER & DISPLAY AR022 02150CLR MOVE 'T' TYPE AR022 02160CLR Z-ADD9 BLNGTH AR022 02170CLR EXSR CRTCOM AR022 0002180CLR EXCPT AR022 02190CLR GOTO NEWRRN AR022 02200CLR GLAMRJ TAG AR022 02210CLR Z-ADD10 VL AR022 02220CLR EXSR RTADJ AR022 02230CLR MOVELBUFFER D10 100 AR022 02240CLR 29 Z-SUBD10 D10 AR022 0002250CLR Z-ADDD10 D9 90 AR022 02260CLR MOVE D9 NGLAMT AR022 02270CLR EXCPT AR022 02280CLR GOTO NEWRRN AR022 02290C********************************************************************AR022 02300C* IN,CM,DM TRANS AR022 02310C* AR022 0002320CLR INDMCM TAG AR022 02330CLR EXSR COMMON GET CUST#,INV# AR022 02340CLR MOVE 'N' AORN 1 AR022 02350CLR Z-ADD9 FLNGTH 20 AR022 02360CLR Z-ADD5 PN 20 AR022 02370CLR MOVELGROSS OLD 10 GET GROSS AR022 02380CLR EXSR GETFLD AR022 0002390CLR MOVELBUFFER NGROSS 9 AR022 02400CLR MOVELFRT OLD GET FREIGHT AR022 02410CLR Z-ADD6 PN AR022 02420CLR Z-ADD7 FLNGTH AR022 02430CLR EXSR GETFLD AR022 02440CLR MOVELBUFFER NFRT 7 AR022 02450C* AR022 0002460CLR MOVELTXAMT OLD GET TAX AMOUNT AR022 02470CLR Z-ADD7 FLNGTH AR022 02480CLR Z-ADD7 PN AR022 02490CLR EXSR GETFLD AR022 02500CLR MOVELBUFFER NTXAMT 7 AR022 02510C* AR022 02520CLR MOVELTXCD OLD GET TAX CODE AR022 0002530CLR Z-ADD1 FLNGTH AR022 02540CLR MOVE 'A' AORN AR022 02550CLR Z-ADD8 PN AR022 02560CLR EXSR GETFLD AR022 02570CLR MOVELBUFFER NTXCD 1 AR022 02580CLR MOVELNET OLD AR022 02590CLR Z-ADD9 FLNGTH AR022 0002600CLR MOVE 'N' AORN AR022 02610CLR Z-ADD9 PN AR022 02620CLR EXSR GETFLD AR022 02630CLR MOVELBUFFER NNET 9 AR022 02640CLR EXSR UPDT AR022 02650CLR EXCPT AR022 02660CLR GOTO NEWRRN AR022 0002670C********************************************************************AR022 02680C* AR022 02690CLR END TAG AR022 02700CLR EXSR CLRSCR AR022 02710C********************************************************************AR022 02720C********************************************************************AR022 02730C* AR022 0002740C* OUTPUT A MESSAGE AR022 02750C* AR022 02760CSR MESSGE BEGSR AR022 02770CSR Z-ADD50 BLNGTH 20 AR022 02780CSR MOVE 'T' TYPE 1 AR022 02790CSR EXSR CRTCOM AR022 02800CSR ENDSR AR022 0002810C********************************************************************AR022 02820C* AR022 02830C* GETS NEW KEY FROM OPERATOR. AR022 02840C* AR022 02850CSR GETKEY BEGSR AR022 02860CSR EXSR BLINE AR022 02870CSR GETR1 TAG AR022 0002880CSR EXSR BLINE AR022 02890CSR MOVELPRM,1 BUFFER AR022 02900CSR EXSR PROMPT AR022 02910CSR Z-ADD7 BLNGTH AR022 02920CSR EXSR ACCEPT AR022 02930CSR 25 GOTO GETR1 AR022 02940CSR 27 GOTO GETR1 AR022 0002950CSR MOVELBUFFER TSTEJ 1 AR022 02960CSR TSTEJ COMP 'E' 22 AR022 02970CSR 22 GOTO GETR9 'EJ' END JOB. AR022 02980CSRN26 EXSR BLINE NOT CAR-RET AR022 02990CSR MOVELTSTEJ BUFFER AR022 03000CSR MOVELBUFFER RRN 70 AR022 03010CSR GETR9 ENDSR AR022 0003020C********************************************************************AR022 03030C* OUTPUT A PROMPT AR022 03040C* AR022 03050CSR PROMPT BEGSR AR022 03060CSR Z-ADD12 BLNGTH AR022 03070CSR MOVE 'S' TYPE AR022 03080CSR EXSR CRTCOM AR022 0003090CSR ENDSR AR022 03100C********************************************************************AR022 03110C********************************************************************AR022 03120C* POSITION CURSOR AT BEGINNING OF NEXT LINE. AR022 03130C* AR022 03140CSR BLINE BEGSR AR022 03150CSR MOVELBUFFER B1 1 AR022 0003160CSR MOVEL' ' BUFFER AR022 03170CSR Z-ADD1 BLNGTH AR022 03180CSR MOVE 'T' TYPE AR022 03190CSR EXSR CRTCOM AR022 03200CSR MOVELB1 BUFFER AR022 03210CSR ENDSR AR022 03220C********************************************************************AR022 0003230C* AR022 03240C* ACCEPTS A REPLY & SETS IND'S 25,26,27 ACCORDING TO RCODE. AR022 03250C* AR022 03260CSR ACCEPT BEGSR AR022 03270CSR MOVE 'A' TYPE AR022 03280CSR EXSR CRTCOM AR022 03290CSR SETOF 252627 AR022 0003300CSR RCODE COMP 'R' 25 AR022 03310CSR RCODE COMP 'C' 26 AR022 03320CSR RCODE COMP 'L' 27 AR022 03330CSR ENDSR AR022 03340C********************************************************************AR022 03350C* AR022 03360C* SUBROUTINE 'COMMON' INPUTS UPDATED CUST# & INV#. AR022 0003370C* AR022 03380CSR COMMON BEGSR AR022 03390CSR MOVE PRM,2 A10 10 DISPLAY AR022 03400CSR MOVE TRCODE A10 TRCODE AR022 03410CSR MOVELA10 BUFFER AR022 03420CSR EXSR PROMPT AR022 03430CSR EXSR BLINE AR022 0003440CSR CCUST TAG GET CUST# AR022 03450CSR MOVELPRM,3 BUFFER AR022 03460CSR EXSR PROMPT AR022 03470CSR Z-ADD6 BLNGTH AR022 03480CSR EXSR ACCEPT AR022 03490CSR 25 GOTO CCUST RUB-OUT, RETRY AR022 03500CSRN27 GOTO CUSRAJ AR022 0003510CSR MOVE CUST NCUST 6 LINE-FEED. AR022 03520CSR MOVELCUST BUFFER DUPE CUST# AR022 03530CSR Z-ADD6 BLNGTH AND DISPLAY AR022 03540CSR MOVE 'T' TYPE AR022 03550CSR EXSR CRTCOM AR022 03560CSR GOTO CINV AR022 03570CSR CUSRAJ TAG RT-ADJ AR022 0003580CSR Z-ADD6 VL CUST# AR022 03590CSR EXSR RTADJ AR022 03600CSR MOVELBUFFER NCUST AR022 03610CSRN26 EXSR BLINE AR022 03620CSR CINV TAG GET INVOICE # AR022 03630CSR MOVELPRM,4 BUFFER AR022 03640CSR EXSR PROMPT AR022 0003650CSR Z-ADD7 BLNGTH AR022 03660CSR EXSR ACCEPT AR022 03670CSR 25 GOTO CINV RUB-OUT. RETRY AR022 03680CSR INVNO CHAINARIND1 39 AR022 03690CSR INVNO COMP '9999999' 20 AR022 03700CSR 20 02 AR022 03710COR 20 03 SETOF 39 AR022 0003720CSR 39 MOVELMES,4 BUFFER AR022 03730CSR 39 Z-ADD50 BLNGTH AR022 03740CSR 39 MOVE 'T' TYPE AR022 03750CSR 39 EXSR CRTCOM AR022 03760CSR 39 GOTO CINV AR022 03770CSRN27 GOTO INVRAJ NOT LF, RTADJ AR022 03780CSR MOVE INVNO NINV 7 LF- DUPE INV# AR022 0003790CSR MOVELINVNO BUFFER AND DISPLAY AR022 03800CSR Z-ADD7 BLNGTH AR022 03810CSR MOVE 'T' TYPE AR022 03820CSR EXSR CRTCOM AR022 03830CSR GOTO COMEND AR022 03840CSR INVRAJ TAG AR022 03850CSR Z-ADD7 VL AR022 0003860CSR EXSR RTADJ AR022 03870CSR MOVELBUFFER NINV AR022 03880CSRN26 EXSR BLINE AR022 03890CSR COMEND ENDSR AR022 03900C********************************************************************AR022 03910C* RIGHT ADJUST AR022 03920CSR RTADJ BEGSR AR022 0003930CSR MOVELBUFFER VAR 15 AR022 03940CSR MOVELVAR A1 1 AR022 03950CSR A1 COMP '-' 29 NEG NUMBER AR022 03960CSR 29 MOVEL' ' VAR AR022 03970CSR EXIT SUBRAJ AR022 03980CSR RLABL VL 20 AR022 03990CSR RLABL VAR 15 AR022 0004000CSR MOVELVAR BUFFER AR022 04010CSR ENDSR AR022 04020C********************************************************************AR022 04030C********************************************************************AR022 04040C* AR022 04050C* SUBROUTINE TO GET NEXT FIAJD. PN-PROMPT#, FLNGTH-FLD LENGTH, AR022 04060C* AORN- 'A1/'N', OLD- OLD FIELD AR022 0004070C********************************************************************AR022 04080CSR GETFLD BEGSR AR022 04090CSR GET1 TAG AR022 04100CSR MOVELPRM,PN BUFFER AR022 04110CSR EXSR PROMPT AR022 04120CSR Z-ADDFLNGTH BLNGTH AR022 04130CSR EXSR ACCEPT AR022 0004140CSR 25 GOTO GET1 RUB-OUT AR022 04150CSR AORN COMP 'A' 28 AR022 04160CSRN27 GOTO GET2 NOT LF. AR022 04170CSR MOVELOLD BUFFER LF- DUPE & DISPAR022 04180CSR Z-ADDFLNGTH BLNGTH AR022 04190CSR MOVE 'T' TYPE AR022 04200CSR EXSR CRTCOM AR022 0004210CSR GOTO GFEND AR022 04220CSR GET2 TAG AR022 04230CSR 28 GOTO GET3 ALPHA, NO RTADJAR022 04240CSR Z-ADDFLNGTH VL NUMERIC, RTADJ AR022 04250CSR EXSR RTADJ AR022 04260CSR GET3 TAG AR022 04270CSR EXSR BLINE AR022 0004280CSR GFEND ENDSR AR022 04290C********************************************************************AR022 04300C** AR022 04310CSR CRTCOM BEGSR AR022 04320CSR EXITFSUBRCM AR022 04330CSR RLABL BUFFER 80 AR022 04340CSR RLABL TYPE 1 AR022 0004350CSR RLABL BLNGTH 20 AR022 04360CSR RLABL RCODE 1 AR022 04370CSR RLABL MASK 10 AR022 04380CSR RLABL DTYPE 10 AR022 04390CSR ENDSR AR022 04400CSR CAUPDT BEGSR AR022 04410CSR MOVE NCASH NNCASH 92 AR022 0004420CSR MOVE NDISC NNDISC 92 AR022 04430CSR NNCASH ADD NNDISC NAMT 92 AR022 04440CSR MOVE CASH NUMCSH 92 AR022 04450CSR MOVE DISC NUMDIS 92 AR022 04460CSR NUMCSH ADD NUMDIS OAMT 92 AR022 04470CSR NAMT SUB OAMT NAMT AR022 04480CSR STILL SUB NAMT STILL AR022 0004490CSR ENDSR AR022 04500CSR AJUPDT BEGSR AR022 04510CSR MOVE NAJAMT NAJ 92 AR022 04520CSR MOVE AJAMT NUMAJ 92 AR022 04530CSR NAJ SUB NUMAJ NAJ 26 AR022 04540CSR STILL ADD NAJ STILL AR022 04550CSR ENDSR AR022 0004560CSR UPDT BEGSR AR022 04570CSR MOVELTRCODE HLD1 1 AR022 04580CSR HLD1 COMP 'I' 30 AR022 04590CSR HLD1 COMP 'D' 31 AR022 04600CSR HLD1 COMP 'C' 32 AR022 04610CSR MOVE NGROSS NNGRS 92 AR022 04620CSR MOVE GROSS NUMGRS 92 AR022 0004630CSR NNGRS SUB NUMGRS NNGRS 26 AR022 04640CSR 30 AR022 04650COR 31 STILL ADD NNGRS STILL AR022 04660CSR 32 STILL SUB NNGRS STILL AR022 04670CSR ENDSR AR022 04680CSR CLRSCR BEGSR AR022 04690CSR MOVE 'C' TYPE AR022 0004700CSR EXSR CRTCOM AR022 04710CSR ENDSR AR022 04720OCARDS E 02 AR022 04730O NCUST 8 AR022 04740O NINV 15 AR022 04750O NCASH 24 AR022 04760O NDISC 32 AR022 0004770O E 03 AR022 04780O NCUST 8 AR022 04790O NINV 15 AR022 04800O NAJAMT 24 AR022 04810O E 04 AR022 04820O NACCT 12 AR022 04830O NGLAMT 27 AR022 0004840O E 05 AR022 04850O NCUST 8 AR022 04860O NINV 15 AR022 04870O NGROSS 30 AR022 04880O NFRT 37 AR022 04890O NTXCD 38 AR022 04900O NTXAMT 45 AR022 0004910O NNET 54 AR022 04920OARIND1 E 02N20 AR022 04930O OR 03N20 AR022 04940O OR 05 AR022 04950O STILL 31 AR022 ** 004960ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00497000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004980ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004990ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005000** 005010 ** RECORD NOT ON FILE 005020 ** CAN'T CHANGE A 'BH' CARD. ** 005030 ** END OF FILE BEFORE YOUR REC#. 00504000 ** INVOICE NOT ON FILE 005050** 005060 KEY 005070 TRANS- 005080 CUST#: 005090 INVOICE#: 005100 GROSS: 00511000 FREIGHT: 005120 TAX AMT: 005130 TAX CODE: 005140 NET: 005150 CASH: 005160 DISCOUNT: 005170 AJ AMOUNT: 00518000 ACCOUNT#: 005190 AMOUNT: 005200 005210/* 005220__ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(&% TXAR025 P999999032778(000010H S AR025 00020X DECK-ID A34 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR025 00030F* PRODUCES TRANSACTION EDIT LIST FROM CARDS AND CREATES ARINPT FILE AR025 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR025 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR025 00060F* CONTROL DATA PROPRIETARY PRODUCT AR025 00070F* AR025 0000080FCARDS IP AF 80 7AI 74 DISK AR025 00090FARIND1 IC F 32R 7AI 7 DISK AR025 00100FARMAST IC F 280R 6AI 1 DISK AR025 00110FARHEAD ID F 50 DISK AR025 00120F$LP1 O F 132 OF PRINTER AR025 00130FARINPT O F 64 DISK AR025 00140F********************************************************************AR025 0000150F** **AR025 00160F** **AR025 00170F** PROGRAM- CAR025 **AR025 00180F** **AR025 00190F** **AR025 00200F** TRANSACTION INPUT **AR025 00210F** **AR025 0000220F** THE "CRDING" FILE IS INPUT GENERATING AN EDIT LISTING AND **AR025 00230F** CREATING TRANSACTION FILE "ARINPT". **AR025 00240F** **AR025 00250F** MODIFIED 9/21/76 TO INCLUDE MISC CHARGES - REMOVE XFOOT CALCS **AR025 00260F********************************************************************AR025 00270F* ID F C H L FUNCTION OF INDICATORS AR025 00280F* 10 HEADER CARD AR025 0000290F* 11 NOT HEADER CARD OR G/L CARD AR025 00300F* 12 G/L CARD. GL RECORDS ARE WRITTEN WITHOUT EDITING. AR025 00310F* 80 ARIND1 CHAINED AR025 00320F* 81 CUSMST CHAINED AR025 00330F* 82 ARHEAD AR025 00340F* 21 20 & 21 CONTROL THE PRINTING OF 'NO HEADER CARD' AR025 00350F* 22 FOR THE FIRST TIME THE ERROR IS SENSED ONLYAR025 0000360F* 23 PRINTS 'HEADER TYPE TO BE IGNORED' MESSAGE AR025 00370F* 24 PRINTS FIRST LINE OF HEADING AR025 00380F* 25 PRINTS REST OF HEADING L2 TYPES ARE POSSIBLE). AR025 00390F* 26 PRINTS 'ON ACCOUNT' FOR CASH APPLIED TO # 999999 AR025 00400F* 27 PRINTS BATCH TOTAL LINES AR025 00410F* 30 CASH BATCH BEING PROCESSED AR025 00420F* 31 INVOICE AR025 0000430F* 32 CREDIT MEMO AR025 00440F* 33 DEBIT MEMO AR025 00450F* 34 ADJUSTMENT AR025 00460F* 43 BATCH AMOUNT-CHECK TOTAL = 0 AR025 00470F* 44 DISCOUNT AMT-DISCOUNT CHECK TOTAL = 0 AR025 00480F* 45 ERROR ON THIS BATCH AR025 00490F* 50 NO BATCHES OUT OF BALANCE AR025 0000500F* 51 NO TERMINAL ERRORS AR025 00510F* 52 NO WARNING ERRORS AR025 00520F* 71 DOCUMENT NOT ON MASTER AR025 00530F* 72 CUSTOMER NOT ON MASTER AR025 00540F* 73 INVALID TR CODE ON THIS INPUT CARD AR025 00550F* 74 NEGATIVE BALANCE ON DOCUMENT AR025 00560F* 75 PARTIAL PAYMENT (USED WHEN PROCESSING CASH ONLY). AR025 0000570F* 77 DON'T PRINT OR ACCUMULATE BATCH TOTALS. AR025 00580F* 78 AT LEAST 1 WARNING ERROR OCCURRED THIS BATCH AR025 00590F* 79 AT LEAST 1 TERMINAL ERROR OCCURRED IN THE BATCH AR025 00600ICARDS NS 10 1 CB 2 CH AR025 00610I 6 7 TYPE AR025 00620I 3 5 BATCHN AR025 00630I 8 172TRTOT AR025 0000640I 18 272DISTOT AR025 00650I 74 80 KEY AR025 00660I NS 12 1 CG 2 CL AR025 00670I 3 63 RECORD AR025 00680I NS 11 2NCA AR025 00690I AND 2NCJ AR025 00700I 1 2 TRCODE AR025 0000710I 3 80CUSTNO AR025 00720I 9 150INVNO AR025 00730I 16 210DATE AR025 00740I 22 302GROSS AR025 00750I 31 372FRT AR025 00760I 38 38 TXCD AR025 00770I 39 452TAX AR025 0000780I 46 542NET AR025 00790I 55 612MSC AR025 00800I 74 80 KEY AR025 00810I NS 11 1 CC 2 CA AR025 00820I OR 11 1 CA 2 CJ AR025 00830I 1 2 TRCODE AR025 00840I 3 80CUSTNO AR025 0000850I 9 150INVNO AR025 00860I 16 242AMOUNT AR025 00870I 25 322DISAMT AR025 00880I 33 38 CHECKN AR025 00890I 39 48 ABAN AR025 00900I 74 80 KEY AR025 00910IARIND1 NS 80 AR025 0000920I 1 60DCUST AR025 00930I 23 312PAMT AR025 00940IARMAST NS 81 AR025 00950I 1 1 DUMMY AR025 00960IARHEAD NS 82 AR025 00970I 1 40 CONAME AR025 00980C********************************************************************AR025 0000990C* *AR025 01000C* HEADER CARD HAS BEEN READ *AR025 01010C* *AR025 01020C********************************************************************AR025 01030C N10 GOTO NOT10 AR025 01040C 20N77 EXSR BATCH PRINT BATCH AR025 01050C SETOF 267677 TOTALS FOR 2NDAR025 0001060C MOVE BATCHN OBATCH 30 AR025 01070C MOVE TYPE OLDTR 2 AR025 01080C MOVE TRTOT OTRTOT 102 AR025 01090C MOVE DISTOT OISTOT 102 AR025 01100C* HEADER AR025 01110C SETON 24 AR025 01120C EXCPT PRNT 1ST HEADERAR025 0001130C SETOF 24 LINE AR025 01140C TYPE COMP 'CA' 30 CASH AR025 01150C TYPE COMP 'IN' 31 INVOICE AR025 01160C TYPE COMP 'CM' 32 CREDIT MEMO AR025 01170C TYPE COMP 'DM' 33 DEBIT MEMO AR025 01180C TYPE COMP 'AJ' 34 ADJUSTMENT AR025 01190C SETON 20 AR025 0001200C N30N31N32 HEADER TYPE TO AR025 01210CANN33N34 SETON 2377 BE IGNORED AR025 01220C* AR025 01230C N23 SETON 25 PRINT MSG OR AR025 01240C EXCPT HEADING, DEP- AR025 01250C SETOF 2325 ENDING ON ABOVAR025 01260C GOTO END AR025 0001270C* AR025 01280C* HEADER HAS NOT JUST BEEN READ. IF ONE WAS NEVER READ AR025 01290C* PRINT ERROR MESSAGE 'MISSING HEADER' ONLY ONCE. AR025 01300C* AR025 01310C NOT10 TAG THIS MESSAGE AR025 01320C 20 GOTO SKIP CAN ONLY OCCURAR025 01330C N21 SETON 2224 ONCE PER RUN. AR025 0001340C N21 EXCPT AR025 01350C SETOF 222411 SETOF INPUT AR025 01360C SETON 21 INDICATOR TO AR025 01370C SKIP TAG SUPPRESS DETL AR025 01380C* PRINT LINE. AR025 01390C N30 GOTO NOTCA AR025 01400C********************************************************************AR025 0001410C* *AR025 01420C* CASH RECORD EXPECTED *AR025 01430C* *AR025 01440C********************************************************************AR025 01450C SETOF 747571 AR025 01460C AMOUNT ADD BCHTOT BCHTOT 102 AR025 01470C DISAMT ADD DSTOT DSTOT 102 AR025 0001480C EXSR CODVAL AR025 01490C EXSR VCUST AR025 01500C INVNO COMP 9999999 26 AR025 01510C N72 EXSR INSTAT AR025 01520C N71N72 EXSR NEGBAL AR025 01530C* AR025 01540C* KEEP ERROR TOTALS AR025 0001550C* AR025 01560C 73 INVALID CODE AR025 01570COR 71N26 NO INVOICE AR025 01580COR 72 1 ADD TERROR TERROR 30 NO CUSTOMER AR025 01590C 74 NEGATIVE BAL. AR025 01600COR 75 1 ADD WERROR WERROR 30 PARTIAL PYMENT AR025 01610C NOTCA TAG AR025 0001620C N31N32N33 GOTO ADJ AR025 01630C********************************************************************AR025 01640C* *AR025 01650C* INVOICE, CREDIT MEMO OR DEBIT MEMO EXPECTED *AR025 01660C* *AR025 01670C********************************************************************AR025 01680C SETOF 7476 AR025 0001690C GROSS ADD BCHTOT BCHTOT 102 AR025 01700C EXSR CODVAL AR025 01710C EXSR VCUST AR025 01720C INVNO COMP 9999999 26 AR025 01730C N72 EXSR INSTAT AR025 01740C N71N72 EXSR NEGBAL AR025 01750C* AR025 0001760C* KEEP ERROR TOTALS AR025 01770C* AR025 01780C 72 INVALID CUST AR025 01790COR 73 1 ADD TERROR TERROR AR025 01800C 74 1 ADD WERROR WERROR NEG. BALANCE AR025 01810C ADJ TAG AR025 01820C N34 GOTO END AR025 0001830C********************************************************************AR025 01840C* *AR025 01850C* ADJUSTMENT RECORD EXPECTED *AR025 01860C* *AR025 01870C********************************************************************AR025 01880C SETOF 717273 AR025 01890C EXSR CODVAL AR025 0001900C EXSR VCUST AR025 01910C EXSR INSTAT AR025 01920C EXSR NEGBAL AR025 01930C INVNO COMP 9999999 26 AR025 01940C AMOUNT ADD BCHTOT BCHTOT KEEP TOTAL AR025 01950C* KEEP ERROR TOTALS AR025 01960C* AR025 0001970C 71N26 AR025 01980COR 72 AR025 01990COR 73 1 ADD TERROR TERROR AR025 02000C END TAG AR025 02010CLR 20 EXSR BATCH AR025 02020C********************************************************************AR025 02030C* SUBROUTINE NEGBAL COMPUTES NEW AMOUNT DUE, SETS ON 75 IF PARTIAL*AR025 0002040C* PAYMENT, SETS ON 74 IF NEW BALANCE IS NEGATIVE. SUBTRACTS DIS- *AR025 02050C* COUNT IF 'CA' IS BEING PROCESSED *AR025 02060C********************************************************************AR025 02070CSR NEGBAL BEGSR AR025 02080CSR Z-ADDPAMT NEWAMT 92 AR025 02090CSR 30 PAMT ADD AMOUNT PAMT AR025 02100CSR 30 PAMT ADD DISAMT PAMT AR025 0002110CSR 31 AR025 02120COR 33 PAMT SUB GROSS PAMT AR025 02130CSR 32 PAMT ADD GROSS PAMT AR025 02140CSR 34 PAMT SUB AMOUNT PAMT AR025 02150CSR ENDSR AR025 02160C********************************************************************AR025 02170C* *AR025 0002180C* SUBROUTINE VCUST VALIDATES THE CUSTOMER NUMBER *AR025 02190C* *AR025 02200C********************************************************************AR025 02210CSR VCUST BEGSR AR025 02220CSR CUSTNO CHAINARMAST 72 AR025 02230CSR ENDSR AR025 02240C********************************************************************AR025 0002250C* *AR025 02260C* SUBROUTINE INSTAT SEES IF THE DOCUMENT IS ON ARINDX *AR025 02270C* *AR025 02280C********************************************************************AR025 02290CSR INSTAT BEGSR AR025 02300CSR INVNO CHAINARIND1 71 AR025 02310CSRN71 CUSTNO COMP DCUST 7171 AR025 0002320CSR ENDSR AR025 02330C********************************************************************AR025 02340C* *AR025 02350C* SUBROUTINE CODVAL SEES THAT TRCODE MATCHES BATCH CODE *AR025 02360C* *AR025 02370C********************************************************************AR025 02380CSR CODVAL BEGSR AR025 0002390CSR TYPE COMP TRCODE 7373 AR025 02400CSR ENDSR AR025 02410C********************************************************************AR025 02420C* SUBROUTINE BATCH COMPUTES THE DIFFERENCE BETWEEN HEADER VALUES *AR025 02430C* AND COMPUTED VALUES, AND PRINTS THEM. *AR025 02440C* *AR025 02450C********************************************************************AR025 0002460CSR BATCH BEGSR AR025 02470CSR WERROR COMP 0 7878 AR025 02480CSR TERROR COMP 0 7979 AR025 02490CSR 78 1 ADD WCNT WCNT 30 52 AR025 02500CSR 79 1 ADD TCNT TCNT 30 51 AR025 02510CSR SETOF 454443 AR025 02520CSR Z-ADD0 WERROR AR025 0002530CSR Z-ADD0 TERROR AR025 02540CSR BCHTOT SUB OTRTOT DIFF1 102 4343 AR025 02550CSR 30 DSTOT SUB OISTOT DIFF2 102 4444 AR025 02560CSR 43 AR025 02570COR 44 SETON 45 AR025 02580CSR 30 AR025 02590COR 32 NETCH SUB BCHTOT NETCH 102 AR025 0002600CSRN30N32 BCHTOT ADD NETCH NETCH 102 AR025 02610CSR 30 NETCH SUB DSTOT NETCH AR025 02620CSR SETON 27 AR025 02630CSR EXCPT AR025 02640CSR SETOF 27 AR025 02650CSR 45 1 ADD OUTBAL OUTBAL 30 50 AR025 02660CSR 0 COMP TCNT 51 AR025 0002670CSR 0 COMP WCNT 52 AR025 02680CSR 0 COMP OUTBAL 50 AR025 02690CSR ENDSR AR025 02700O$LP1 D 1 30 11 AR025 02710O OR 1 34 11 AR025 02720O KEY 7 AR025 02730O BATCHN 11 AR025 0002740O TRCODE 14 AR025 02750O CUSTNOZ 21 AR025 02760O N26 INVNO Z 29 AR025 02770O 26 29 'ON ACCT' AR025 02780O AMOUNTJ 44 AR025 02790O N71N72 PAMT J 59 AR025 02800O 30 DISAMTJ 73 AR025 0002810O N71N72 NEWAMTJ 87 AR025 02820O D 1 31 11 AR025 02830O OR 32 11 AR025 02840O OR 33 11 AR025 02850O KEY 7 AR025 02860O BATCHN 11 AR025 02870O TRCODE 14 AR025 0002880O CUSTNOZ 21 AR025 02890O N26 INVNO Z 29 AR025 02900O 26 29 'ON ACCT' AR025 02910O GROSS J 44 AR025 02920O TAX J 56 AR025 02930O TXCD 59 AR025 02940O FRT J 71 AR025 0002950O NET J 86 AR025 02960O D 1 73 11 AR025 02970O 111 'INVALID TRANSACTION CODE' AR025 02980O 132 '* RERUN *' AR025 02990O D 1 72 11 AR025 03000O 110 'INVALID CUSTOMER NUMBER' AR025 03010O 132 '* RERUN *' AR025 0003020O D 1 71N26 30 AR025 03030O AND 11 AR025 03040O OR 11 71 34 AR025 03050O AND N26 AR025 03060O 111 'INVOICE NOT OPEN FOR THI' AR025 03070O 117 'S CUST' AR025 03080O 132 '* RERUN *' AR025 0003090O D 1 N71N72 30 AR025 03100O AND 74 11 AR025 03110O 111 'NEGATIVE BALANCE ON THIS' AR025 03120O 119 'INVOICE' AR025 03130O 130 'WARNING' AR025 03140O D 1 30N71N72 AR025 03150O AND 75 11 AR025 0003160O 102 'PARTIAL PAYMENT' AR025 03170O T 22 LR AR025 03180O 25 'END OF JOB. THERE WERE' AR025 03190O N50 OUTBALZ 29 AR025 03200O 50 29 'NO' AR025 03210O 53 'BATCHES OUT OF BALANCE,' AR025 03220O N52 WCNT Z 58 AR025 0003230O 52 58 'NO' AR025 03240O 83 'TRANSACTIONS WITH WARNIN' AR025 03250O 86 'GS,' AR025 03260O N51 TCNT Z 90 AR025 03270O 51 91 'NONE' AR025 03280O 113 'WITH TERMINAL ERRORS.' AR025 03290O T LR AR025 0003300O 24 'GRAND TOTAL NET CHANGE' AR025 03310O 31 'IN A/R' AR025 03320O NETCH J 47 '$' AR025 03330O E 201 24 AR025 03340O UDATE Y 8 AR025 03350O CONAME 50 AR025 03360O 73 'A/R TRANSACTION EDIT' AR025 0003370O 89 'CAR025' AR025 03380O 102 'PAGE' AR025 03390O PAGE Z 106 AR025 03400O E 1 25 30 AR025 03410O OR 25 34 AR025 03420O 19 'KEY TR CUST' AR025 03430O 41 'INVOICE TRANSACTION' AR025 0003440O 56 'AMT PREV DUE' AR025 03450O 70 'DISCOUNT' AR025 03460O 84 'NEW AMT DUE' AR025 03470O E 1 25 30 AR025 03480O OR 25 34 AR025 03490O 12 ' BCH CD' AR025 03500O 27 'NUMBER NUMBER' AR025 0003510O 41 'AMOUNT' AR025 03520O 56 'ON INVOICE' AR025 03530O 70 'AMOUNT' AR025 03540O 84 'ON INVOICE' AR025 03550O 102 'C O M M E N T S' AR025 03560O E 1 25N30N34 AR025 03570O 19 'KEY TR CUST' AR025 0003580O 27 'INVOICE' AR025 03590O 41 'GROSS' AR025 03600O 53 'TAX' AR025 03610O 57 'TX' AR025 03620O 68 'FREIGHT' AR025 03630O 83 'NET' AR025 03640O E 1 25N30N34 AR025 0003650O 12 ' BCH CD' AR025 03660O 19 'NUMBER' AR025 03670O 41 'AMOUNT' AR025 03680O 53 'AMOUNT' AR025 03690O 57 'CD' AR025 03700O 68 'AMOUNT' AR025 03710O 83 'AMOUNT' AR025 0003720O 102 'C O M M E N T S' AR025 03730O E 1 23 AR025 03740O TYPE 9 AR025 03750O 15 'BATCH' AR025 03760O BATCHN 19 AR025 03770O 108 'THIS BATCH IS IGNORED.' AR025 03780O E 1 22 AR025 0003790O TRCODE 9 AR025 03800O 111 'NO HEADER FOR THIS BATCH' AR025 03810O 127 '. BATCH IGNORED.' AR025 03820O E 21 27 AR025 03830O OLDTR 9 AR025 03840O 22 'BATCH TOTALS' AR025 03850O BCHTOTJB 42 AR025 0003860O 30 DSTOT JB 71 AR025 03870O E 1 27 AR025 03880O OTRTOTJB 42 AR025 03890O 30 OISTOTJB 71 AR025 03900O 17 'BH CARD' AR025 03910O E 1 27 AR025 03920O 20 'DIFFERENCE' AR025 0003930O DIFF1 JB 42 AR025 03940O 30 DIFF2 JB 71 AR025 03950OARINPT D N73N72N71 AR025 03960O AND 30 11 AR025 03970O OR N73N72 71 AR025 03980O AND 26 30 11 AR025 03990O 2 'CA' AR025 0004000O UDATE 8 AR025 04010O CUSTNO 14 AR025 04020O INVNO 21 AR025 04030O AMOUNT 30 AR025 04040O DISAMT 39 AR025 04050O CHECKN 45 AR025 04060O ABAN 55 AR025 0004070O 64 '4' AR025 04080O D N30N34N12 AR025 04090O AND N72N73 31 AR025 04100O AND 11 AR025 04110O OR N30N34N12 AR025 04120O AND N72N73N31 AR025 04130O AND 11 AR025 0004140O 31 2 'IN' AR025 04150O 32 2 'CM' AR025 04160O 33 2 'DM' AR025 04170O DATE 8 AR025 04180O CUSTNO 14 AR025 04190O INVNO 21 AR025 04200O GROSS 30 AR025 0004210O TAX 37 AR025 04220O FRT 44 AR025 04230O TXCD 45 AR025 04240O MSC 52 AR025 04250O 31 64 '1' AR025 04260O 32 64 '2' AR025 04270O 33 64 '3' AR025 0004280O D 34N71N72 AR025 04290O AND N73 11 AR025 04300O OR 34 71N72 AR025 04310O AND N73 11 26 AR025 04320O 2 'AJ' AR025 04330O UDATE 8 AR025 04340O CUSTNO 14 AR025 0004350O INVNO 21 AR025 04360O AMOUNT 30 AR025 04370O 64 '5' AR025 04380O D 12 AR025 04390O 2 'GL' AR025 04400O RECORD 63 AR025 04410O 64 '7' AR025 00** 004420ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 004430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004460/* 004470__0O 64 '7' AR025 0(& dTXAR100 P999999032778(000010H S AR100 00020X DECK-ID A35 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR100 00030F* PRODUCES CASH RECEIPTS JOURNAL FROM SORTED ARINPT (SARINPT) AR100 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR100 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR100 00060F* CONTROL DATA PROPRIETARY PRODUCT AR100 00070F* AR100 0000080FSARINPT IP F 64 DISK AR100 00090FARMAST IC F 280R 6AI 1 DISK AR100 00100FARHEAD ID F 50 DISK AR100 00110F$LP1 O F 132 OF PRINTER AR100 00120F********************************************************************AR100 00130F* ** ** AR100 00140F* ** ** AR100 0000150F* ** PROGRAM- CAR100 ** AR100 00160F* ** ** AR100 00170F* ************************************************************** AR100 00180F* ** ** AR100 00190F** READS SARIN **AR100 00200F** **AR100 00210F** READS "SARIN" (SORTED ARINPT) FILE CONTAINING NEW ENTRIES AND**AR100 0000220F** PRODUCES THE CASH RECEIPTS JOURNAL REPORT. GENERAL LEDGER **AR100 00230F** CASH (IF ANY) FOLLOWS A/R CASH. NON-CASH TRANSACTIONS FROM **AR100 00240F** SARIN ARE IGNORED. **AR100 00250F** **AR100 00260F********************************************************************AR100 00270F* MODIFIED 7/01/75 TO REMOVE COMMENTS FOR PARTIALS. AR100 00280ISARINPT NS 01 1 CC 2 CA AR100 0000290I 9 140CUSTNOL2 AR100 00300I 15 210INVNO L1 AR100 00310I 22 302AMOUNT AR100 00320I 31 392DISC AR100 00330I 40 45 CHKNO AR100 00340I 46 55 ABA AR100 00350I NS 02 1 CG 2 CL AR100 0000360I 1 2 TYPE L3 AR100 00370I 9 18 GLACT AR100 00380I 19 272AMOUNT AR100 00390I 28 33 CHKNO AR100 00400I 34 63 DESC AR100 00410I NS 03 AR100 00420I 1 1 DUMMY AR100 0000430IARMAST NS 04 AR100 00440I 7 30 NAME AR100 00450IARHEAD NS 09 AR100 00460I 1 40 CONAME AR100 00470C* AR100 00480C* GET COMPANY NAME AR100 00490C* AR100 0000500C 28 SETON 29 AR100 00510C N28 READ ARHEAD 28 AR100 00520C SETON 28 AR100 00530C* AR100 00540C L1 SETOF 31 AR100 00550C NL2NL1 SETON 31 AR100 00560C L2 01 CUSTNO CHAINARMAST 99 AR100 0000570C 02N30 EXCPT AR100 00580C 02N30 SETON 30 AR100 00590C N01 GOTO GL AR100 00600C* AR100 00610C* CALC CHECK TOTAL, CASH APPLIED TOTAL, DISCOUNT TOTAL FOR NON G/L AR100 00620C* AR100 00630C 1 ADD CHKTOT CHKTOT 40 AR100 0000640C AMOUNT ADD DISC APPLD 92 AR100 00650C AMOUNT ADD TAMT TAMT 102 AR100 00660C DISC ADD TDISC TDISC 92 AR100 00670C APPLD ADD TAPPLD TAPPLD 102 AR100 00680C GL TAG AR100 00690C N02 GOTO END AR100 00700C AMOUNT ADD GLTOT GLTOT 102 AR100 0000710C END TAG AR100 00720CLRN30 EXCPT AR100 00730CLR TAMT ADD GLTOT GDTOT 102 AR100 00740O$LP1 H 203 28N29 AR100 00750O OR OF AR100 00760O CONAME 70 AR100 00770O H 2 28N29 AR100 0000780O OR OF AR100 00790O UDATE Y 9 AR100 00800O 18 'CAR100' AR100 00810O 60 'CASH RECEIPTS JOURNAL' AR100 00820O 89 'PAGE' AR100 00830O PAGE Z 93 AR100 00840O 122 'DEPOSIT VOUCHER' AR100 0000850O UDATE Y 132 AR100 00860O H 1 28N29 AR100 00870O OR OF AR100 00880O 45 'CHECK' AR100 00890O 58 'CHECK' AR100 00900O 67 'INVOICE' AR100 00910O 81 'CASH' AR100 0000920O 93 'DISCOUNT' AR100 00930O H 2 28N29 AR100 00940O OR OF AR100 00950O 6 'CUST#' AR100 00960O 21 'CUSTOMER NAME' AR100 00970O 45 'NUMBER' AR100 00980O 58 'AMOUNT' AR100 0000990O 67 'NUMBER' AR100 01000O 81 'APPLIED' AR100 01010O 93 'ALLOWED' AR100 01020O 112 'ABA #' AR100 01030O 130 'AMOUNT' AR100 01040O D 1 01 AR100 01050O L2 CUSTNOZ 7 AR100 0001060O L2 NAME 32 AR100 01070O CHKNO 45 AR100 01080O AMOUNTJ 59 AR100 01090O INVNO Z 67 AR100 01100O APPLD J 82 AR100 01110O DISC J 94 AR100 01120O ABA 117 AR100 0001130O AMOUNT1 130 AR100 01140O D 1 02 AR100 01150O CHKNO 45 AR100 01160O AMOUNTJ 59 AR100 01170O 69 'G/L ACCT#' AR100 01180O GLACT 79 AR100 01190O DESC 105 AR100 0001200O ABA 117 AR100 01210O AMOUNT1 130 AR100 01220O T 2 LR AR100 01230O 30 27 '* TOTAL NON-A/R CASH' AR100 01240O 30 GLTOT 1 58 AR100 01250O 30 60 '*' AR100 01260O 114 'TOTAL' AR100 0001270O GDTOT 1 130 '$' AR100 01280O 132 '*' AR100 01290O E 23 AR100 01300O 18 'END OF A/R CASH' AR100 01310O CHKTOT1 34 AR100 01320O 44 'CHECKS...' AR100 01330O TAMT J 59 AR100 0001340O TAPPLDJ 82 AR100 01350O TDISC 93 ' , . ' AR100 ** 001360ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001370ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001380ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001390ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00140000/* 001410__0O TDISC 93 ' , . ' AR100 ** 001360ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001370ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001380ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001390ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0014000('B v\TXAR110 P999999032778(000010H S AR110 00020X DECK-ID A36 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR110 00030F* PRINTS INVOICE REGISTER FROM SORTED ARINPT (SARINPT) AR110 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR110 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR110 00060F* CONTROL DATA PROPRIETARY PRODUCT AR110 00070F* AR110 0000080FARHEAD IP F 50 DISK AR110 00090FSARINPT IS F 64 DISK AR110 00100FARMAST IC F 280R 6AI 1 DISK AR110 00110F$LP1 O F 132 OF PRINTER AR110 00120F********************************************************************AR110 00130F* *AR110 00140F* COMPUSOURCE ACCOUNTS RECEIVABLE SYSTEM *AR110 0000150F* *AR110 00160F* PROGRAM- CAR100 *AR110 00170F* *AR110 00180F* *AR110 00190F* REMARKS- PRINTS INVOICE REGISTER (AMOUNTS ON ALL OUTSTANDING *AR110 00200F* INVOICES). WITH TOTALS OF CALIFORNIA TAXABLE, *AR110 00210F* CALIF. NON TAXABLE, AND OUT OF STATE SALES. *AR110 0000220F* *AR110 00230F* *AR110 00240F* MODIFIED 07/02/75 TO INCLUDE DM'S. AR110 00250F* *AR110 00260F********************************************************************AR110 00270IARHEAD NS 09 AR110 00280I 1 40 CONAME AR110 0000290ISARINPT NS 04 64NC1 64NC2 64NC3 AR110 00300I 1 1 DUMMY AR110 00310ISARINPT NS 01 45 C AR110 00320I OR 02 45 CC AR110 00330I OR 03 45 CO AR110 00340I 1 2 TRCODE AR110 00350I 9 140CUSTNO AR110 0000360I 15 210INVNO AR110 00370I 22 302AMT AR110 00380I 31 372TAX AR110 00390I 38 442FRT AR110 00400IARMAST NS 05 AR110 00410I 7 30 NAME AR110 00420C 09 GOTO END AR110 0000430C 04 GOTO END AR110 00440C SETOF 21 AR110 00450C TRCODE COMP 'CM' 21 AR110 00460C N21 GOTO GO1 AR110 00470C Z-SUBAMT AMT AR110 00480C Z-SUBTAX TAX AR110 00490C Z-SUBFRT FRT AR110 0000500C GO1 TAG AR110 00510C AMT SUB FRT NET 92 AR110 00520C NET SUB TAX NET AR110 00530C AMT ADD LRAMT LRAMT 102 AR110 00540C TAX ADD LRTAX LRTAX 82 AR110 00550C FRT ADD LRFRT LRFRT 82 AR110 00560C NET ADD LRNET LRNET 102 AR110 0000570C 01 NET ADD CNTAX CNTAX 102 AR110 00580C 02 NET ADD CTAX CTAX 102 AR110 00590C 03 NET ADD OUTST OUTST 102 AR110 00600C CUSTNO CHAINARMAST 99 AR110 00610C END TAG AR110 00620O$LP1 H 202 09 AR110 00630O OR OF AR110 0000640O CONAME 85 AR110 00650O H 2 09 AR110 00660O OR OF AR110 00670O UDATE Y 9 AR110 00680O 19 'CAR110' AR110 00690O 62 'I N V O I C E' AR110 00700O 81 'R E G I S T E R' AR110 0000710O 114 'PAGE' AR110 00720O PAGE Z 118 AR110 00730O H 2 09 AR110 00740O OR OF AR110 00750O 9 'INVOICE#' AR110 00760O 15 'CUST#' AR110 00770O 21 'NAME' AR110 0000780O 58 'GROSS AMT TX' AR110 00790O 69 'TAX' AR110 00800O 81 'FREIGHT' AR110 00810O 97 'NET AMT' AR110 00820O 102 'TR' AR110 00830O D 1 01 AR110 00840O OR 02 AR110 0000850O OR 03 AR110 00860O INVNO Z 9 AR110 00870O CUSTNOZ 16 AR110 00880O N99 NAME 41 AR110 00890O 99 29 '* UNKNOWN *' AR110 00900O AMT J 55 AR110 00910O 02 58 'C' AR110 0000920O 03 58 'O' AR110 00930O TAX J 70 AR110 00940O FRT J 82 AR110 00950O NET J 98 AR110 00960O TRCODE 102 AR110 00970O T 12 LR AR110 00980O 17 'END OF REPORT' AR110 0000990O 39 'GRAND TOTALS' AR110 01000O LRAMT J 55 AR110 01010O LRTAX J 70 AR110 01020O LRFRT J 82 AR110 01030O LRNET J 98 AR110 01040O T 1 LR AR110 01050O CTAX J 98 AR110 0001060O 112 'CALIF TAXABLE' AR110 01070O T 1 LR AR110 01080O CNTAX J 98 AR110 01090O 112 'CALIF NON-TAX' AR110 01100O T LR AR110 01110O OUTST J 98 AR110 01120O 111 'OUT OF STATE' AR110 00** 001130ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001140ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001150ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001160ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001170/* 001180__0O 111 'OUT OF STATE' AR110 0(|' TXAR120 P999999032778(000010H S AR120 00020X DECK-ID A37 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR120 00030F* MERGES SARINPT AND OLD ARTRAN FILES TO CREATE NEWART AR120 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR120 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR120 00060F* CONTROL DATA PROPRIETARY PRODUCT AR120 00070F* AR120 0000080FARTRANS IP AF 48 DISK AR120 00090FSARINPT IS AF 64 DISK AR120 00100FARMAST UC F 280R 6AI 1 DISK 50 AR120 00110FNEWART O F 48 DISK AR120 00120F$LP1 O F 132 132 OF PRINTER AR120 00130F* ******************************************************************AR120 00140F* ** ** AR120 0000150F* ** ** AR120 00160F* ** PROGRAM- CAR120 ** AR120 00170F* ** ** AR120 00180F* ******************************************************************AR120 00190F** **AR120 00200F** READS SARIN **AR120 00210F** **AR120 0000220F** MERGES "SARIN" (SORTED ARINPT) WITH THE OLD "ARTRAN" FILE, **AR120 00230F** CREATING AN UPDATED FILE "NEWART". G/L TRANSACTIONS ON **AR120 00240F** "SARIN" ARE IGNORED. THE YTD FIELD IS UPDATED BY NEW IN, CM, **AR120 00250F** DM TRANSACTIONS. CONTROL TOTALS ARE PRINTED AT END OF JOB. *AR120 00260F** **AR120 00270F* MODIFIED 1/26/76 TO INCLUDE UPDATE/ADD OF ARIND1. AR120 00280F* MODIFIED 9/21/76 TO UPDATE A/R BALANCE - INCLUDE MISC CHARGES AR120 0000290F********************************************************************AR120 00300F*ARTRANS READ: AR120 00310F* 01 INVOICE AR120 00320F* 02 CASH AR120 00330F* 03 AJUSTMENT AR120 00340F* 04 CREDIT MEMO AR120 00350F* 05 DEBIT MEMO AR120 0000360F* 06 CATCH-ALL AR120 00370F* 07 DISCOUNT AR120 00380F* ARINPT READ: AR120 00390F* 11 INVOICE AR120 00400F* 12 CREDIT MEMO AR120 00410F* 13 DEBIT MEMO AR120 00420F* 14 AJUSTMENT AR120 0000430F* 15 CASH AR120 00440F* 16 CATCH-ALL AR120 00450F* 17CUSMST READ AR120 00460F* 40 UPDATE CUSMST-- A SALE OCCURRED FOR THIS CUSTOMER IN ARINPT AR120 00470F* 45 ARTRANS WAS READ. AR120 00480F* 46 ARINPT WAS READ AR120 00490F* 47 SARINPT FOR THIS DOCNO. AR120 0000500F* 60 CUSTOMER NOT ON MASTERFILE ARMAST AR120 00510F* 50 WRITE A DISCOUNT RECORD. AR120 00520IARTRANS NS 01 AR120 00530I 1 2 TRCODE AR120 00540I 3 80TRDATE AR120 00550I 9 140ACTNO L2M2 AR120 00560I 15 210DOCNO L1M1 AR120 0000570I 22 302AMOUNT AR120 00580I 31 31 HCODE AR120 00590ISARINPT NS 11 AR120 00600I 1 2 TRCODE AR120 00610I 3 80TRDATE AR120 00620I 9 140ACTNO L2M2 AR120 00630I 15 210DOCNO L1M1 AR120 0000640I 22 302AMOUNT AR120 00650I 31 372TAX AR120 00660I 31 392DISAMT AR120 00670I 38 442FRT AR120 00680I 46 522MSC AR120 00690IARMAST NS 17 AR120 00700I 117 1230YTDSLS AR120 0000710C SETOF 4546 AR120 00720C SETOF 50 AR120 00730C L2 SETOF 4060 AR120 00740C L2 Z-ADD0 L2BAL 92 AR120 00750C 01 EXSR RECID AR120 00760C 11 EXSR RECID2 AR120 00770C 02 AR120 0000780COR 03 AR120 00790COR 04 AR120 00800COR 05 AR120 00810COR 06 AR120 00820COR 07 AR120 00830COR 01 SETON 45 ARTRAN READ AR120 00840C N45 GOTO INPT AR120 0000850C* AR120 00860C* OLD ARTRANS RECORD HAS BEEN SELECTED AR120 00870C* AR120 00880C* AR120 00890C 1 ADD OLDFIL OLDFIL 50 AR120 00900C 02 AR120 00910COR 04 AR120 0000920COR 07 Z-SUBAMOUNT AMT 92 AR120 00930C N02N04N07 Z-ADDAMOUNT AMT AR120 00940C AMT ADD OLDAR OLDAR 102 AR120 00950C AMT ADD L2BAL L2BAL AR120 00960C GOTO END AR120 00970C* AR120 00980C* AR120 0000990C* ARINPT (NEW AR ENTRIES) SELECTED FOR PROCESSING AR120 01000C* AR120 01010C INPT TAG AR120 01020C 16 GOTO END1 IGNORED RECORD AR120 01030C SETON 4647 AR120 01040C* AR120 01050C* IF SALE, KEEP L1SLS FOR L2 TIME UPDATE OF ARMAST YTD SALES. AR120 0001060C* AR120 01070C N11 GOTO NOTSL AR120 01080C SETON 40 A SALE OCCURS AR120 01090C AMOUNT ADD L1SLS L1SLS 92 AR120 01100C L1SLS SUB FRT L1SLS AR120 01110C L1SLS SUB TAX L1SLS AR120 01120C L1SLS SUB MSC L1SLS AR120 0001130C* AR120 01140C* MAKE CASH, CREDIT MEMO, AND DISCOUNTS NEGATIVE AR120 01150C* AR120 01160C* AR120 01170C NOTSL TAG AR120 01180C 15 0 COMP DISAMT 5050 AR120 01190C 15 Z-SUBDISAMT DAMT 92 AR120 0001200C 12 AR120 01210COR 15 Z-SUBAMOUNT AMT AR120 01220C N15N12 Z-ADDAMOUNT AMT AR120 01230C* AR120 01240C* ACCUMULATE TOTALS FOR NEW INVOICES,CREDIT MEMOS, CASH, AR120 01250C* ADJUSTMENTS/DEBIT MEMOS, DISCOUNTS. AR120 01260C* AR120 0001270C* AR120 01280C AMT ADD L2BAL L2BAL AR120 01290C 15 DAMT ADD L2BAL L2BAL AR120 01300C 11 AMT ADD INTOT INTOT 102 AR120 01310C 12 AMT ADD CMTOT CMTOT 102 AR120 01320C 13 AR120 01330COR 14 AMT ADD JDTOT JDTOT 102 AR120 0001340C 15 AMT ADD CATOT CATOT 102 AR120 01350C 15 DAMT ADD DSTOT DSTOT 102 AR120 01360C END TAG AR120 01370C 1 ADD NEWFIL NEWFIL 50 AR120 01380C 15 50 1 ADD NEWFIL NEWFIL AR120 01390C END1 TAG AR120 01400C L1N16 Z-ADDAMT ORGAMT 92 AR120 0001410C N16 AMT ADD INVTOT INVTOT 92 AR120 01420C 50 DAMT ADD INVTOT INVTOT AR120 01430C********************************************************************AR120 01440C* AR120 01450C* CHAIN & UPDATE AN ACCOUNT'S A/R BALANCE - UPDATE YTD SALES AR120 01460C* ONLY IF A NEW SALE WAS PROCESSED. AR120 01470C* AR120 0001480C********************************************************************AR120 01490CL2 ACTNO CHAINARMAST 60 AR120 01500CL2 60 40 EXCPT AR120 01510CL2 40 L1SLS ADD YTDSLS YTDSLS AR120 01520CL2 Z-ADD0 L1SLS AR120 01530CLR INTOT ADD CMTOT NETCH 102 AR120 01540CLR CATOT ADD NETCH NETCH 102 AR120 0001550CLR JDTOT ADD NETCH NETCH 102 AR120 01560CLR DSTOT ADD NETCH NETCH 102 AR120 01570CLR OLDAR ADD NETCH NEWAR 102 AR120 01580C* AR120 01590C******************************************************************* AR120 01600C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR120 01610C* AR120 0001620CSR RECID BEGSR AR120 01630CSR SETOF 010203 AR120 01640CSR SETOF 040506 AR120 01650CSR SETOF 071112 AR120 01660CSR SETOF 131415 AR120 01670CSR TRCODE COMP 'IN' 01 AR120 01680CSR TRCODE COMP 'CA' 02 AR120 0001690CSR TRCODE COMP 'AJ' 03 AR120 01700CSR TRCODE COMP 'CM' 04 AR120 01710CSR TRCODE COMP 'DM' 05 AR120 01720CSR TRCODE COMP 'DS' 07 AR120 01730CSRN01N02N03 AR120 01740CANN04N05N07 SETON 06 AR120 01750CSR ENDSR AR120 0001760C* AR120 01770C******************************************************************* AR120 01780C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR120 01790C* AR120 01800CSR RECID2 BEGSR AR120 01810CSR SETOF 010203 AR120 01820CSR SETOF 040506 AR120 0001830CSR SETOF 071112 AR120 01840CSR SETOF 131415 AR120 01850CSR SETOF 16 AR120 01860CSR TRCODE COMP 'IN' 11 AR120 01870CSR TRCODE COMP 'CA' 15 AR120 01880CSR TRCODE COMP 'AJ' 14 AR120 01890CSR TRCODE COMP 'CM' 12 AR120 0001900CSR TRCODE COMP 'DM' 13 AR120 01910CSR ENDSR AR120 01920O$LP1 H 203 1P AR120 01930O OR OF AR120 01940O UDATE Y 10 AR120 01950O 20 'CAR120' AR120 01960O 46 'ADD NEW TRANSACTIONS TO' AR120 0001970O 59 'ARTRANS FILE' AR120 01980O H 2 1P AR120 01990O OR OF AR120 02000O 59 'A/R AMOUNT' AR120 02010O T 1 LR AR120 02020O OLDAR J 60 '$' AR120 02030O 84 '* TOTAL A/R ON OLD FILE.' AR120 0002040O OLDFIL1 94 AR120 02050O 115 'RECORDS ON OLD FILE.' AR120 02060O T 1 LR AR120 02070O 43 'TODAYS TRANSACTIONS...' AR120 02080O T 1 LR AR120 02090O INTOT J 60 AR120 02100O 74 'NEW INVOICES' AR120 0002110O T 1 LR AR120 02120O CMTOT J 60 AR120 02130O 74 'CREDIT MEMOS' AR120 02140O T 1 LR AR120 02150O CATOT J 60 AR120 02160O 74 'CASH APPLIED' AR120 02170O T 1 LR AR120 0002180O JDTOT J 60 AR120 02190O 85 'ADJUSTMENTS/DEBIT MEMOS' AR120 02200O T 1 LR AR120 02210O DSTOT J 60 AR120 02220O 77 'DISCOUNTS TAKEN' AR120 02230O T 2 LR AR120 02240O NETCH J 60 AR120 0002250O 79 '* NET CHANGE IN A/R' AR120 02260O T LR AR120 02270O NEWAR J 60 '$' AR120 02280O 84 '* TOTAL A/R ON NEW FILE.' AR120 02290O NEWFILJ 94 AR120 02300O 115 'RECORDS ON NEW FILE.' AR120 02310O E 2 60 40 AR120 0002320O 17 '*** CUSTOMER' AR120 02330O ACTNO Z 25 AR120 02340O 50 'HAS A NEW INVOICE BUT IS' AR120 02350O 68 'NOT ON ARMAST ***' AR120 02360OARMAST T L2N60 AR120 02370O 40 YTDSLS 123 AR120 02380O L2BAL 172 AR120 0002390ONEWART D N06 45 AR120 02400O OR 46 AR120 02410O TRCODE 2 AR120 02420O TRDATE 8 AR120 02430O ACTNO 14 AR120 02440O DOCNO 21 AR120 02450O AMOUNT 30 AR120 0002460O 46 31 ' ' AR120 02470O 45 HCODE 31 AR120 02480O D 50 AR120 02490O 2 'DS' AR120 02500O TRDATE 8 AR120 02510O ACTNO 14 AR120 02520O DOCNO 21 AR120 0002530O DISAMT 30 AR120 02540O 31 ' ' AR120 ** 002550ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002560ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002570ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002580ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00259000/* 002600__0O 31 ' ' AR120 ** 002550ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002560ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002570ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002580ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0025900((? IKTXAR130 P999999032778(000010H S AR130 00020X DECK-ID A38 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR130 00030F* PRINTS CUSTOMER LIST FROM ARMAST FILE AR130 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR130 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR130 00060F* CONTROL DATA PROPRIETARY PRODUCT AR130 00070F* AR130 0000080FARHEAD IPE F 50 DISK AR130 00090FARMAST ISE F 280 6AI 1 DISK AR130 00100F$LP1 O F 132 132 OF PRINTER AR130 00110F********************************************************************AR130 00120F* *AR130 00130F* COMPUSOURCE ACCOUNTS RECEIVABLE SYSTEM *AR130 00140F* *AR130 0000150F* PROGRAM- CAR130 *AR130 00160F* *AR130 00170F* *AR130 00180F* *AR130 00190F* REMARKS- READS ARMAST AND LISTS IT. *AR130 00200F* *AR130 00210F********************************************************************AR130 0000220IARHEAD NS 02 AR130 00230I 1 40 CONAME AR130 00240IARMAST NS 01 AR130 00250I 1 60ACTNO AR130 00260I 7 30 NAME AR130 00270I 31 54 ADDR1 AR130 00280I 55 78 ADDR2 AR130 0000290I 79 91 CITY AR130 00300I 92 93 ST AR130 00310I 94 980ZIP AR130 00320I 109 1140CRLIM AR130 00330I 117 1230YTD AR130 00340C 01 1 ADD CUSNUM CUSNUM 50 AR130 00350O$LP1 H 203 OF AR130 0000360O OR 02 AR130 00370O UDATE Y 8 AR130 00380O CONAME 59 AR130 00390O 71 'CUSTOMER MASTERFILE' AR130 00400O 79 'LISTING' AR130 00410O 101 'CAR130' AR130 00420O 120 'PAGE' AR130 0000430O PAGE Z 124 AR130 00440O H 2 OF AR130 00450O OR 02 AR130 00460O 5 'CUST#' AR130 00470O 31 '/----- NAME -----------/' AR130 00480O 56 '/--- ADDRESS LINE 1 ---/' AR130 00490O 81 '/--- ADDRESS LINE 2 ---/' AR130 0000500O 86 'CITY' AR130 00510O 102 'ST ZIP' AR130 00520O 111 'CR LIM' AR130 00530O 124 'YTD SALES' AR130 00540O D 1 01 AR130 00550O ACTNO Z 6 AR130 00560O NAME 31 AR130 0000570O ADDR1 56 AR130 00580O ADDR2 81 AR130 00590O CITY 95 AR130 00600O ST 98 AR130 00610O ZIP Z 104 AR130 00620O CRLIM 1 112 AR130 00630O YTD 1 124 AR130 0000640O T 2 LR AR130 00650O 12 'END OF LIST.' AR130 00660O CUSNUM1 20 AR130 00670O 39 'CUSTOMERS LISTED.' AR130 ** 000680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00070000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000710ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000720/* 000730__0O 39 'CUSTOMERS LISTED.' AR130 ** 000680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0007000(( ]TTXAR140 P999999032778(000010H S AR140 00020X DECK-ID A39 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR140 00030F* FROM ARTRAN FILE CREATES ARZERO FILE OF INVOICES WITH ZERO DUE AR140 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR140 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR140 00060F* CONTROL DATA PROPRIETARY PRODUCT AR140 00070F* AR140 0000080FARTRANS IP AF 48 48 DISK AR140 00090FARZERO O F 13 DISK AR140 00100F$LP1 O F 132 OF PRINTER AR140 00110F********************************************************************AR140 00120F* ** ** AR140 00130F* ** ** AR140 00140F* ** PROGRAM- CAR140 ** AR140 0000150F* ** ** AR140 00160F***************************************************************** AR140 00170F** **AR140 00180F** READS THE "ARTRAN" FILE AND CREATES A FILE, "ARZERO", OF **AR140 00190F** INVOICES WHICH HAVE ZERO AMOUNTS DUE ON THEM. THIS PROGRAM **AR140 00200F** WILL HAVE THE OPTION (AT INSTALLATION TIME) TO INCLUDE LOGIC **AR140 00210F** SO THAT AN INVOICE WILL NOT BE REMOVED IF ALL OF THE TRANS- **AR140 0000220F** ACTIONS ASSOCIATED WITH IT HAVE NOT PREVIOUSLY APPEARED ON **AR140 00230F** THE DETAILED AGEING REPORT (CAR200). **AR140 00240F** **AR140 00250F********************************************************************AR140 00260F* AR140 00270F* AR140 00280F* AR140 0000290F*ARTRANS RECORDS READ: AR140 00300F* 01 INVOICE AR140 00310F* 02 CASH AR140 00320F* 03 AJUSTMENT AR140 00330F* 04 CREDIT MEMO AR140 00340F* 05 DEBIT MEMO AR140 00350F* 06 DISCOUNT AR140 0000360F* AR140 00370F* 30 DOCUMENT TOTAL IS ZERO. AR140 00380IARTRANS NS 01 AR140 00390I 1 2 TRCODE AR140 00400I 9 140ACTNO AR140 00410I 15 210DOCNO L1 AR140 00420I 22 302AMOUNT AR140 0000430C 1 ADD READC READC 50 INCREM READCNT AR140 00440C EXSR RECID AR140 00450C* AR140 00460C* MAKE CASH, CREDIT MEMOS, DISCOUNTS NEGATIVE, OTHERS POSITIVE. AR140 00470C* AR140 00480C 02 AR140 00490COR 04 AR140 0000500COR 06 Z-SUBAMOUNT AMT 92 AR140 00510C N02N04N06 Z-ADDAMOUNT AMT 92 AR140 00520C AMT ADD DOCTOT DOCTOT 92 30 AR140 00530C 1 ADD DOCCNT DOCCNT 30 AR140 00540CL1 30 DOCCNT ADD DELCNT DELCNT 50 AR140 00550CL1 Z-ADD0 DOCCNT AR140 00560CL1 Z-ADD0 DOCTOT AR140 0000570C* AR140 00580C******************************************************************* AR140 00590C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR140 00600C* AR140 00610CSR RECID BEGSR AR140 00620CSR SETOF 010203 AR140 00630CSR SETOF 040506 AR140 0000640CSR SETOF 07 AR140 00650CSR TRCODE COMP 'IN' 01 AR140 00660CSR TRCODE COMP 'CA' 02 AR140 00670CSR TRCODE COMP 'AJ' 03 AR140 00680CSR TRCODE COMP 'CM' 04 AR140 00690CSR TRCODE COMP 'DM' 05 AR140 00700CSR TRCODE COMP 'DS' 06 AR140 0000710CSR ENDSR AR140 00720OARZERO T L1 30 AR140 00730O ACTNO 6 AR140 00740O DOCNO 13 AR140 00750O$LP1 T 301 LR AR140 00760O UDATE Y 9 AR140 00770O 34 'CAR140 CREATE ARZERO' AR140 0000780O 57 '-FILE OF ZERO BALANCE' AR140 00790O 67 'INVOICES-' AR140 00800O T 1 LR AR140 00810O 7 'EOJ.' AR140 00820O READC 1 15 AR140 00830O 35 'RECORDS ON ARTRANS,' AR140 00840O T 1 LR AR140 0000850O DELCNT1 15 AR140 00860O 40 'OF WHICH ARE ELIGIBLE TO' AR140 00870O 52 'BE REMOVED.' AR140 ** 000880ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000890ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000900ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00091000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000920/* 000930__0O 52 'BE REMOVED.' AR140 ** 000880ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000890ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000900ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0009100(r(  TXAR160 P999999032778(000010H S AR160 00020X DECK-ID A40 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR160 00030F* CREATES NEW ARTRAN FILE W/O ZERO INVOICES. UPDATES ARMAST FILE AR160 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR160 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR160 00060F* CONTROL DATA PROPRIETARY PRODUCT AR160 00070F* AR160 0000080FARTRANS IP AF 48 DISK AR160 00090FARZERO IS AF 13 DISK AR160 00100FARMAST UC F 280R 6AI 1 DISK AR160 00110FNEWART O F 48 DISK AR160 00120F$LP1 O F 132 OF PRINTER AR160 00130F********************************************************************AR160 00140F* ** ** AR160 0000150F* ** ** AR160 00160F* ** PROGRAM- CAR160 ** AR160 00170F* ** ** AR160 00180F***************************************************************** AR160 00190F** **AR160 00200F** THE "ARTRAN" FILE AND THE "ARZERO" FILE ARE INPUT REMOVING **AR160 00210F** ALL TRANSACTIONS FOR THOSE INVOICES WHICH ARE PAID OFF (I.E., **AR160 0000220F** THOSE INVOICES ON THE "ARZERO" FILE). THIS PROGRAM CREATES A **AR160 00230F** NEW "ARTRAN" FILE WITH ALL TRANSACTIONS HAVING A "P" (PREVIOUS**AR160 00240F** MONTH) HISTORY CODE. UPDATES AVERAGE PAY DAYS AND TOTAL # **AR160 00250F** INVOICES FIELDS IN "CUSMST". COMBINES ANY 999999 ACCOUNTS AR160 00260F** FOR EACH CUSTOMER INTO ONE "CM" TRANSACTION. AR160 00270F** **AR160 00280F********************************************************************AR160 0000290F*ARTRANS RECORD ID INDS: AR160 00300F* 01 INVOICE AR160 00310F* 02 CASH AR160 00320F* 03 AJUSTMENT AR160 00330F* 04 CREDIT MEMO AR160 00340F* 05 DEBIT MEMO AR160 00350F* 07 DISCOUNT AR160 0000360F* 06 CATCH ALL AR160 00370F* AR160 00380F* 09 ARZERO WAS READ AR160 00390F* 20 ARTRANS WAS READ (NOT THE CATCH-ALL) AR160 00400F*40 AMOUNT NOT ZERO AS IT SHOULD BE IF IT IS TO BE DELETED AR160 00410F* 50 AT LEAST 1 '40' ERROR OCURRED IN THE PROGRAM. AR160 00420F* 60 CASH YEAR IS > DOCUMENT YEAR (CASH COMES IN YEAR FOLLOWING INV)AR160 0000430F* 61 CASH YEAR < DOCUMENT YEAR (PAID BEFORE INVOICE WAS ISSUED). AR160 00440F* 63 CASH JULIAN < DOCUMENT JULIAN DATE (SAME SITUATION AS ABOVE). AR160 00450F* 70 DOCUMENT DATE FOR CASH IS GREATER THAN THE PREVIOUS ONE FOR AR160 00460F* THIS ITEM. AR160 00470F* AR160 00480F* 71 CASH DATE IS 0 AT L1 TIME: NO CASH APPLD FOR THIS ZEROED ITEM. AR160 00490F* 72 DOCUMENT DATE IS 0 " : NO DBT MEMO OR INVOICE FOR " " . AR160 0000500F* 80 DOCUMENT NUMBER IS 999999 AR160 00510F* 90 CUSMST CHAINED TO. AR160 00520IARTRANS NS 01 AR160 00530I 1 2 TRCODE AR160 00540I 3 80TRDATE AR160 00550I 9 140ACTNO M2 AR160 00560I 15 210DOCNO M1 AR160 0000570I 9 210L1KEY L1 AR160 00580I 22 302AMOUNT AR160 00590I 31 31 HCODE AR160 00600I 1 30 REC AR160 00610IARZERO NS 09 AR160 00620I 1 60ACTNO M2 AR160 00630I 7 130DOCNO M1 AR160 0000640I 1 130L1KEY L1 AR160 00650IARMAST NS 90 AR160 00660I 146 1480AVGDAY AR160 00670I 149 1530BASED AR160 00680C EXSR RECID AR160 00690C 02 EXSR DTSHFT AR160 00700C L1 Z-ADD0 CSHDTE 60 AR160 0000710C L1 Z-ADD0 DOCDAT 60 AR160 00720C L1 SETOF 409099 AR160 00730C L1 Z-ADD0 DELTOT 92 AR160 00740C L1 Z-ADD0 OPENT 92 AR160 00750C SETOF 2080 AR160 00760C N09N06 SETON 20 AR160 00770C 06 GOTO END AR160 0000780C 20 DOCNO COMP 9999999 80 AR160 00790C 20 1 ADD READCT READCT 50 AR160 00800C EXSR ACCUM AR160 00810C 09 GOTO END AR160 00820C 80NMR 1 ADD DELCN1 DELCN1 50 AR160 00830C N20 AR160 00840CORNMR GOTO END AR160 0000850C* AR160 00860C* THE FOLLOWING GROUP OF CALCS APPLIES ONLY TO RECORDS WHICH ARE AR160 00870C* TO BE DELETED. AR160 00880C* AR160 00890C* ACCUMULATE TOTAL OF DELETED DOCUMENT SET. MOVE THE LATEST CASH AR160 00900C* DATE TO CSHDTE. MOVE DEBIT OR INVOICE DATE TO DOCDAT. AR160 00910C 02 AR160 0000920COR 04 AR160 00930COR 07 Z-SUBAMOUNT AMT 92 AR160 00940C N02N04N07 Z-ADDAMOUNT AMT AR160 00950C AMT ADD DELTOT DELTOT 92 4040 AR160 00960C 1 ADD DELCNT DELCNT 50 AR160 00970C 02 TSTDTE COMP CSHDTE 70 AR160 00980C 70 MOVE TSTDTE CSHDTE AR160 0000990C 70 MOVE TRDATE SVDATE 60 AR160 01000C SETOF 70 AR160 01010C 01 AR160 01020COR 05 MOVE TRDATE DOCDAT AR160 01030C END TAG AR160 01040C* AR160 01050C* IF THE DOCUMENT TOTAL IS ZERO, AND BOTH CASH AND (DM OR IN) AR160 0001060C* WERE READ, THEN THE AVERAGE DAYS TO PAY FIELD ON ARMASTER AR160 01070C* AR160 01080C* AR160 01090C* AR160 01100CL1 80NMR DELCN1 SUB 1 DELCN1 50 AR160 01110CL1 40 SETON 50 AT LEAST ONE AR160 01120CL1 40 GOTO END1 ERROR OCCURS AR160 0001130CL1 0 COMP CSHDTE 71 AR160 01140CL1 0 COMP DOCDAT 72 AR160 01150CL1N71 ACTNO CHAINARMAST 99 AR160 01160CL1 99 SETON 50 AR160 01170CL1 71 AR160 01180COR 72 GOTO END1 AR160 01190CL1 AVGDAY MULT BASED PROD 80 AR160 0001200CL1 EXSR AGEIT AR160 01210CL1 DADIF ADD PROD PROD AR160 01220CL1 1 ADD BASED BASED AR160 01230CL1 PROD DIV BASED AVGDAY H AR160 01240CL1 END1 TAG AR160 01250CLR READCT SUB DELCNT NEWREC 50 AR160 01260CLR NEWREC SUB DELCN1 NEWREC AR160 0001270C* AR160 01280C******************************************************************* AR160 01290C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR160 01300C* AR160 01310CSR RECID BEGSR AR160 01320CSR SETOF 010203 AR160 01330CSR SETOF 040506 AR160 0001340CSR SETOF 07 AR160 01350CSR TRCODE COMP 'IN' 01 AR160 01360CSR TRCODE COMP 'CA' 02 AR160 01370CSR TRCODE COMP 'AJ' 03 AR160 01380CSR TRCODE COMP 'CM' 04 AR160 01390CSR TRCODE COMP 'DM' 05 AR160 01400CSR TRCODE COMP 'DS' 07 AR160 0001410CSRN01N02N03 AR160 01420CANN04N05N07 SETON 06 AR160 01430CSR ENDSR AR160 01440C********************************************************************AR160 01450C* SUBROUTINE TO MAKE CORRECT TEST DATE. (YYMMDD) AR160 01460C* AR160 01470CSR DTSHFT BEGSR AR160 0001480CSR MOVE TRDATE D2 20 AR160 01490CSR MOVELTRDATE D4 40 AR160 01500CSR MOVELD2 TSTDTE 60 AR160 01510CSR MOVE D4 TSTDTE AR160 01520CSR ENDSR AR160 01530C********************************************************************AR160 01540C* SUBROUTINE AGE AGES THE LATEST CASH DATE AGAINST ITS INVOICE *AR160 0001550C* OR DEBIT MEMO. *AR160 01560C********************************************************************AR160 01570CSR AGEIT BEGSR AR160 01580CSR EXSR BRKDN AR160 01590CSR CYR SUB DYR YRDIF 50 AR160 01600CSR YRDIF MULT 365 YRDIF AR160 01610CSR CMO SUB DMO MODIF 40 AR160 0001620CSR MODIF MULT 30 MODIF AR160 01630CSR CDA SUB DDA DADIF 50 AR160 01640CSR DADIF ADD MODIF DADIF AR160 01650CSR DADIF ADD YRDIF DADIF 60 AR160 01660CSR 60 Z-ADD0 DADIF AR160 01670CSR ENDIT ENDSR AR160 01680C********************************************************************AR160 0001690C* SUBROUTINE BRKDN SEPARATES CSHDTE AND DOCDAT INTO MO,DA,YR *AR160 01700C********************************************************************AR160 01710CSR BRKDN BEGSR AR160 01720CSR MOVE SVDATE CYR 20 AR160 01730CSR MOVELSVDATE CMO 20 AR160 01740CSR MOVE SVDATE NUM4 40 AR160 01750CSR MOVELNUM4 CDA 20 AR160 0001760CSR MOVE DOCDAT DYR 20 AR160 01770CSR MOVELDOCDAT DMO 20 AR160 01780CSR MOVE DOCDAT NUM4 AR160 01790CSR MOVELNUM4 DDA 20 AR160 01800CSR ENDSR AR160 01810C********************************************************************AR160 01820C* SUBROUTINE ACCUM ACCUMULATES OLDAMT (OLDA/R TOTAL) *AR160 0001830C* AND NEWAMT (NEW A/R TOTAL AT DETAIL CALC TIME. *AR160 01840C********************************************************************AR160 01850CSR ACCUM BEGSR AR160 01860C* ACCUMULATE OLD AMT. AR160 01870C* AR160 01880CSRN20 GOTO ENDAC AR160 01890CSR 02 AR160 0001900COR 04 AR160 01910COR 07 Z-SUBAMOUNT AMT AR160 01920CSRN02N04N07 Z-ADDAMOUNT AMT AR160 01930CSR AMT ADD OLDAMT OLDAMT 102 AR160 01940CSR 80 OPENT SUB AMT OPENT AR160 01950C* AR160 01960C* ACCUMULATE NEWAMT. AR160 0001970C* AR160 01980CSRNMR AMT ADD NEWAMT NEWAMT 102 AR160 01990CSR ENDAC ENDSR AR160 02000ONEWART D 20NMRN80 AR160 02010O REC 30 AR160 02020O 31 'P' AR160 02030ONEWART T L1NMR 80 AR160 0002040O 2 'CM' AR160 02050O UDATE 8 AR160 02060O ACTNO 14 AR160 02070O DOCNO 21 AR160 02080O OPENT 30 AR160 02090O 31 'P' AR160 02100OARMAST T L1 90 AR160 0002110O SVDATE 145 AR160 02120O AVGDAY 148 AR160 02130O BASED 153 AR160 02140O$LP1 H 203 1P AR160 02150O OR OF AR160 02160O UDATE Y 9 AR160 02170O 36 'REMOVE CLOSED ITEMS FROM' AR160 0002180O 45 'A/R FILE' AR160 02190O 56 'CAR160' AR160 02200O T 1 L1 40 AR160 02210O 22 '* ERROR * CUST#' AR160 02220O ACTNO Z 29 AR160 02230O 39 ', INVOICE#' AR160 02240O DOCNO Z 46 AR160 0002250O 59 ', REMOVED BUT' AR160 02260O DELTOTJ 74 '$' AR160 02270O 85 'STILL DUE.' AR160 02280O T 1 L1 99 AR160 02290O 22 '* ERROR * CUST#' AR160 02300O ACTNO Z 29 AR160 02310O 48 'NOT ON MASTERFILE,' AR160 0002320O 61 'BUT INVOICE#' AR160 02330O DOCNO Z 68 AR160 02340O 80 'STILL OPEN.' AR160 02350O T 31 LR 50 AR160 02360O 26 'EOJ. THERE WERE ERRORS.' AR160 02370O 50 'DON''T PERFORM THE COPY.' AR160 02380O 74 'RE-RUN CAR140 AND THEN' AR160 0002390O 84 'THIS JOB.' AR160 02400O T 1 LR 50 AR160 02410O 32 'IF YOU STILL GET ERRORS,' AR160 02420O 56 'CONTACT COMPUSOURCE FOR' AR160 02430O 68 'ASSISTANCE.' AR160 02440O T 31 LRN50 AR160 02450O 7 'EOJ.' AR160 0002460O READCT1 14 AR160 02470O 35 'RECORDS ON OLD FILE,' AR160 02480O OLDAMTJ 54 '$' AR160 02490O 75 'A/R AMT ON OLD FILE.' AR160 02500O T 1 LRN50 AR160 02510O DELCNT1 14 AR160 02520O 38 'ZEROED RECORDS REMOVED.' AR160 0002530O T 1 LRN50 AR160 02540O DELCN11 14 AR160 02550O 32 'RECORDS COMBINED.' AR160 02560O T LRN50 AR160 02570O NEWREC1 14 AR160 02580O 35 'RECORDS ON NEW FILE.' AR160 02590O NEWAMTJ 54 '$' AR160 0002600O 75 'A/R AMT ON NEW FILE.' AR160 ** 002610ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002650/* 00266000__0O 75 'A/R AMT ON NEW FILE.' AR160 ** 002610ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002650/* 0026600()| TXAR200 P999999032778(000010H S AR200 00020X DECK-ID A41 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR200 00030F* PRODUCES DETAILED OPEN ITEM AGED TRIAL BALANCE REPORT AR200 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR200 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR200 00060F* CONTROL DATA PROPRIETARY PRODUCT AR200 00070F* AR200 0000080FARTRANS IP AF 48 48 DISK AR200 00090FARMAST IC F 280 280R 6AI 1 DISK 40 AR200 00100FARHEAD ID F 50 DISK AR200 00110F$LP1 O F 132 132 OF PRINTER AR200 00120F********************************************************************AR200 00130F** **AR200 00140F** **AR200 0000150F** PROGRAM- CAR200 **AR200 00160F** **AR200 00170F** READS THE "ARTRAN" AND "CUSMST" FILES AND PRODUCES A DETAILED **AR200 00180F** OPEN ITEM AGED TRIAL BALANCE REPORT. **AR200 00190F** **AR200 00200F********************************************************************AR200 00210F* 01 INVOICE READ AR200 0000220F* 02 CASH AR200 00230F* 03 ADJUSTMENT AR200 00240F* 04 CREDIT MEMO AR200 00250F* 05 DEBIT MEMO AR200 00260F* 06 CATCHALL AR200 00270F* 09 CUSMST CHAINED TO AR200 00280F* 20 ON FIRST TIME AROUND FOR PRINTING EXCPT HEADING AR200 0000290F* 21 OFF FIRST TIME AROUND AR200 00300F* 31 > 30 DAYS OLD AR200 00310F* 32 > 60 DAYS OLD AR200 00320F* 40 SIX CHARACTERS ENTERED FOR DATE IN CRT QUERY AR200 00330F* 41 BAD DATE ENTERED AR200 00340F* 42 BAD DATE ENTERED AR200 00350F* 50 THIRD CUSTOMER INFORMATION LINE HAS BEEN PRINTED. AR200 0000360F* 60 CUSTOMER IS OVER CREDIT LIMIT AR200 00370F* 61 CREDIT LIMIT IS BLANK. AR200 00380F* 70 TRANSACTION IS 'P': PAST AR200 00390F* 80 CURRENT AR200 00400F* 81 30 AR200 00410F* 82 60 AR200 00420F* 83 90 AR200 0000430IARTRANS NS 01 AR200 00440I 1 2 TRCODE AR200 00450I 3 80TRDATE AR200 00460I 9 140ACTNO L2 AR200 00470I 15 210DOCNO L1 AR200 00480I 22 302AMOUNT AR200 00490I 31 31 HCODE AR200 0000500IARMAST NS 09 AR200 00510I 7 30 NAME AR200 00520I 124 139 CONTAC AR200 00530I 140 1450LSTPAY AR200 00540I 99 1080PHONE AR200 00550I 109 1140CRLIM AR200 00560IARHEAD NS 08 AR200 0000570I 1 40 CONAME AR200 00580C* AR200 00590C* GET DATE FROM CRTCOM, THEN PRINT HEADING ON FIRST CYCLE. AR200 00600C* AR200 00610C* AR200 00620C 21 GOTO SECOND AR200 00630C SETON 2021 AR200 0000640C EXSR GETDAT AR200 00650C EXCPT AR200 00660C SETOF 20 AR200 00670C SECOND TAG AR200 00680C EXSR RECID AR200 00690C* AR200 00700C* SET CREDIT MEMOS, CASH NEGATIVE AR200 0000710C* AR200 00720C* ACCUMULATE SUMMARY TOTALS FOR LR TIME PRINT-OUT AR200 00730C* AR200 00740C 02 AR200 00750COR 07 AR200 00760COR 04 Z-SUBAMOUNT AMT 92 AR200 00770C 03 AR200 0000780COR 01 AR200 00790COR 05 MOVE AMOUNT AMT AR200 00800C 06 GOTO END CATCH-ALL AR200 00810C HCODE COMP 'P' 70 AR200 00820C 70 AMT ADD BEGBAL BEGBAL 102 AR200 00830C 70 GOTO NONP AR200 00840C 01 AMT ADD INTOT INTOT 102 AR200 0000850C 02 AMT ADD CRTOT CRTOT 102 AR200 00860C 04 AMT ADD CMTOT CMTOT 102 AR200 00870C 05 AMT ADD DMTOT DMTOT 102 AR200 00880C 03 AMT ADD AJTOT AJTOT 102 AR200 00890C 07 AMT ADD DSTOT DSTOT 102 AR200 00900C NONP TAG AR200 00910C* AR200 0000920C* ACCUMULATE L1 BALANCE AND DETAIL LINE PRINT LOGIC AR200 00930C* AR200 00940C* AR200 00950C L1 MOVE TRDATE AGEDAT 60 AR200 00960C L1 MOVE AMT L1BAL 92 AR200 00970C NL1 L1BAL ADD AMT L1BAL AR200 00980C L1 SETON 50 3RD ID LINE AR200 0000990C L2 ACTNO CHAINARMAST 99 WAS PRNTED AR200 01000C L2 SETOF 50 AR200 01010C L2 EXCPT AR200 01020C NL2 EXCPT AR200 01030C NL2 SETON 50 3RD ID LINE AR200 01040C* HAS BEEN PRNTD AR200 01050C* IF SECOND ITEM AR200 0001060C* FOR CUSTOMER AR200 01070C* WAS PROCESSED AR200 01080C END TAG AR200 01090CL1 L1BAL ADD L2BAL L2BAL 92 AR200 01100CL1 EXSR AGEIT AR200 01110CL1 80 L1BAL ADD L2CUR L2CUR 92 AR200 01120CL1 81 L1BAL ADD L230 L230 92 AR200 0001130CL1 82 L1BAL ADD L260 L260 92 AR200 01140CL1 83 L1BAL ADD L290 L290 92 AR200 01150CL2 L2BAL ADD LRBAL LRBAL 102 AR200 01160CL2 L2CUR ADD LRCUR LRCUR 102 AR200 01170CL2 L230 ADD LR30 LR30 102 AR200 01180CL2 L260 ADD LR60 LR60 102 AR200 01190CL2 L290 ADD LR90 LR90 102 AR200 0001200CL2 SETOF 60 AR200 01210CL2 CRLIM COMP L2BAL 60 AR200 01220CL2 60 CRLIM COMP 0 6060 AR200 01230CLR BEGBAL ADD INTOT NEWBAL 102 AR200 01240CLR NEWBAL ADD CRTOT NEWBAL AR200 01250CLR NEWBAL ADD CMTOT NEWBAL AR200 01260CLR NEWBAL ADD DMTOT NEWBAL AR200 0001270CLR NEWBAL ADD DSTOT NEWBAL AR200 01280CLR AJTOT ADD NEWBAL NEWBAL AR200 01290C* AR200 01300C******************************************************************* AR200 01310C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR200 01320C* AR200 01330CSR RECID BEGSR AR200 0001340CSR SETOF 010203 AR200 01350CSR SETOF 040506 AR200 01360CSR SETOF 07 AR200 01370CSR TRCODE COMP 'IN' 01 AR200 01380CSR TRCODE COMP 'CA' 02 AR200 01390CSR TRCODE COMP 'AJ' 03 AR200 01400CSR TRCODE COMP 'CM' 04 AR200 0001410CSR TRCODE COMP 'DM' 05 AR200 01420CSR TRCODE COMP 'DS' 07 AR200 01430CSRN01N02N03 AR200 01440CANN04N05N07 SETON 06 AR200 01450CSR ENDSR AR200 01460C********************************************************************AR200 01470C* *AR200 0001480C* SUBROUTINE GETDAT GETS DATE FROM CRT, CHECKS VALIDITY, *AR200 01490C* AND RETURNS ASOF, ADA, AMO, AYR. GETS COMPANY NAME FROM ARHEADI *AR200 01500C* *AR200 01510C********************************************************************AR200 01520CSR GETDAT BEGSR AR200 01530CSR READ ARHEAD 99 AR200 01540CSR LOOP TAG AR200 0001550CSR MOVE 'S' TYPE 1 AR200 01560CSR Z-ADD14 BLNGTH 20 AR200 01570CSR MOVEL'AGEING D'WORD 14 AR200 01580CSR MOVE 'ATE- ' WORD AR200 01590CSR MOVELWORD BUFFER 72 AR200 01600CSR EXSR CRTCOM AR200 01610CSR MOVE 'A' TYPE AR200 0001620CSR Z-ADD7 BLNGTH AR200 01630CSR EXSR CRTCOM AR200 01640C* AR200 01650C* CHECK TO SEE THAT ENTRY WAS TERMINATED WITH CARRIAGE RETURN AR200 01660C* AR200 01670CSR RCODE COMP 'C' 4040 AR200 01680CSRN40 GOTO CHECK AR200 0001690CSR SKIP TAG AR200 01700CSR MOVE 'T' TYPE RETURN CURSOR AR200 01710CSR Z-ADD1 BLNGTH TO NEXT LINE AR200 01720CSR MOVEL' ' BUFFER AR200 01730CSR EXSR CRTCOM AR200 01740CSR GOTO LOOP AR200 01750C* AR200 0001760C* CHECK TO SEE DATE IS VALID AR200 01770C* AR200 01780CSR CHECK TAG AR200 01790CSR MOVELBUFFER ASOF 60 AR200 01800CSR MOVE ASOF AYR 20 AR200 01810CSR MOVELASOF AMO 20 AR200 01820CSR MOVE ASOF NUM4 40 AR200 0001830CSR MOVELNUM4 ADA 20 AR200 01840C* AR200 01850C* AR200 01860C* AR200 01870CSR AYR COMP 90 41 > 1990 AR200 01880CSR AYR COMP 74 42 < 1974 AR200 01890CSR 41 AR200 0001900COR 42 GOTO LOOP AR200 01910CSR ADA COMP 31 41 > 31 AR200 01920CSR ADA COMP 0 4242 .= 0 AR200 01930CSR 41 AR200 01940COR 42 GOTO LOOP AR200 01950CSR AMO COMP 12 41 > 12 AR200 01960CSR AMO COMP 0 42 = 0 AR200 0001970CSR 41 AR200 01980COR 42 GOTO LOOP AR200 01990CSR ENDSR AR200 02000C********************************************************************AR200 02010C* *AR200 02020C* DUMMY SUBROUTINE FOR CRTCOM *AR200 02030C* *AR200 0002040C********************************************************************AR200 02050CSR CRTCOM BEGSR AR200 02060CSR EXITFSUBRCM AR200 02070CSR RLABL BUFFER 72 AR200 02080CSR RLABL TYPE 1 AR200 02090CSR RLABL BLNGTH 20 AR200 02100CSR RLABL RCODE 1 AR200 0002110CSR RLABL MASK 10 AR200 02120CSR RLABL DTYPE 10 AR200 02130CSR ENDSR AR200 02140C********************************************************************AR200 02150C* *AR200 02160C* SUBROUTINE AGEIT AGES AGEDAT TAKEN OF THE FIRST INVOICE *AR200 02170C* AGAINST THE AS OF DATE 'ASOF' TAKEN FROM THE CRT. *AR200 0002180C* *AR200 02190C* ASSUMES 30 DAY MONTHS. *AR200 02200C* *AR200 02210C********************************************************************AR200 02220CSR AGEIT BEGSR AR200 02230CSR SETOF 808182 AR200 02240CSR SETOF 8330 AR200 0002250CSR MOVE AGEDAT YR 20 AR200 02260CSR MOVELAGEDAT MO 20 AR200 02270CSR MOVE AGEDAT DAYR 40 AR200 02280CSR MOVELDAYR DA 20 AR200 02290CSR AYR SUB YR YDIFF 50 AR200 02300CSR YDIFF MULT 360 YDIFF AR200 02310CSR AMO SUB MO MDIFF 40 AR200 0002320CSR 30 MULT MDIFF MDIFF AR200 02330CSR ADA SUB DA DDIFF 50 AR200 02340CSR MDIFF ADD DDIFF DDIFF AR200 02350CSR YDIFF ADD DDIFF DDIFF AR200 02360CSR DDIFF COMP 30 8080 AR200 02370CSRN80 DDIFF COMP 60 8181 AR200 02380CSRN80N81 DDIFF COMP 90 838282 AR200 0002390CSR ENDAGE ENDSR AR200 02400O$LP1 H 201 OF AR200 02410O CONAME 85 AR200 02420O$LP1 H 2 OF AR200 02430O 5 'AS OF' AR200 02440O ASOF Y 14 AR200 02450O 24 'RUN-' AR200 0002460O UDATE Y 32 AR200 02470O 65 'DETAILED ACCOUNTS' AR200 02480O 83 'RECEIVABLE AGEING' AR200 02490O 105 'CAR200' AR200 02500O 128 'PAGE' AR200 02510O PAGE Z 132 AR200 02520O H 1 OF AR200 0002530O 20 'ACCOUNT ACCOUNT NAME' AR200 02540O 33 'CR LIMIT' AR200 02550O 41 'INVOICE' AR200 02560O 53 'TRANS TR' AR200 02570O 65 'TRANS' AR200 02580O 78 'INVOICE' AR200 02590O 100 '--------------------' AR200 0002600O 113 'A G E I N G' AR200 02610O 132 '-----------------' AR200 02620O H 1 OF AR200 02630O 33 'LAST PAY' AR200 02640O 41 'NUMBER' AR200 02650O 53 'DATE CD' AR200 02660O 65 'AMOUNT' AR200 0002670O 78 'BALANCE' AR200 02680O 92 'CURRENT' AR200 02690O 105 '31-60' AR200 02700O 117 '61-90' AR200 02710O 132 'OVER 90' AR200 02720O T 1 L1 AR200 02730O 80 L1BAL JB 93 AR200 0002740O 81 L1BAL JB 106 AR200 02750O 82 L1BAL JB 119 AR200 02760O 83 L1BAL JB 132 AR200 02770O T 1 N50 L1 AR200 02780O CONTAC 24 AR200 02790O LSTPAYY 33 AR200 02800O T 11 L2 AR200 0002810O ACTNO Z 7 AR200 02820O 26 '* ACCOUNT TOTALS *' AR200 02830O 60 52 '* OVER CREDIT LIMIT *' AR200 02840O L2BAL JB 79 AR200 02850O L2CUR KB 93 AR200 02860O L230 KB 106 AR200 02870O L260 KB 119 AR200 0002880O L290 KB 132 AR200 02890O T 21 LR AR200 02900O 54 'GRAND TOTALS' AR200 02910O LRBAL J 79 AR200 02920O LRCUR K 93 AR200 02930O LR60 K 119 AR200 02940O T 03 LR AR200 0002950O LR30 K 106 AR200 02960O LR90 K 132 AR200 02970O T 3 LR AR200 02980O 5 'AS OF' AR200 02990O ASOF Y 14 AR200 03000O 19 'RUN-' AR200 03010O UDATE Y 30 AR200 0003020O 38 'CAR200' AR200 03030O 52 'A/R SUMMARY' AR200 03040O T 1 LR AR200 03050O 54 'BEGINNING BALANCE A/R' AR200 03060O BEGBALJ 32 AR200 03070O T 1 LR AR200 03080O 41 'INVOICES' AR200 0003090O INTOT J 32 AR200 03100O T 1 LR AR200 03110O 46 'CASH RECEIPTS' AR200 03120O CRTOT J 32 AR200 03130O T 1 LR AR200 03140O 42 'DISCOUNTS' AR200 03150O DSTOT J 32 AR200 0003160O T 1 LR AR200 03170O 45 'CREDIT MEMOS' AR200 03180O CMTOT J 32 AR200 03190O T 1 LR AR200 03200O 44 'DEBIT MEMOS' AR200 03210O DMTOT J 32 AR200 03220O T 1 LR AR200 0003230O 44 'ADJUSTMENTS' AR200 03240O AJTOT J 32 AR200 03250O T 1 LR AR200 03260O 48 'NEW BALANCE A/R' AR200 03270O NEWBALJ 32 AR200 03280O E 202 20 AR200 03290O CONAME 85 AR200 0003300O E 2 20 AR200 03310O 5 'AS OF' AR200 03320O ASOF Y 14 AR200 03330O 24 'RUN-' AR200 03340O UDATE Y 32 AR200 03350O 65 'DETAILED ACCOUNTS' AR200 03360O 83 'RECEIVABLE AGEING' AR200 0003370O 105 'CAR200' AR200 03380O 128 'PAGE' AR200 03390O PAGE Z 132 AR200 03400O E 1 20 AR200 03410O 20 'ACCOUNT ACCOUNT NAME' AR200 03420O 41 'INVOICE' AR200 03430O 33 'CR LIMIT' AR200 0003440O 53 'TRANS TR' AR200 03450O 65 'TRANS' AR200 03460O 78 'INVOICE' AR200 03470O 100 '--------------------' AR200 03480O 113 'A G E I N G' AR200 03490O 132 '-----------------' AR200 03500O E 1 20 AR200 0003510O 7 'NUMBER' AR200 03520O 33 'LAST PAY' AR200 03530O 41 'NUMBER' AR200 03540O 53 'DATE CD' AR200 03550O 65 'AMOUNT' AR200 03560O 78 'BALANCE' AR200 03570O 92 'CURRENT' AR200 0003580O 105 '31-60' AR200 03590O 117 '61-90' AR200 03600O 132 'OVER 90' AR200 03610O E 1 L2N20 AR200 03620O ACTNO Z 7 AR200 03630O N99 NAME 32 AR200 03640O 99 32 '*** NOT ON MASTER ***' AR200 0003650O E 1 L2N20 AR200 03660O 9 '(' AR200 03670O PHONE 23 ' )& - ' AR200 03680O N99 CRLIM 1 33 AR200 03690O DOCNO Z 41 AR200 03700O TRDATEY 50 AR200 03710O TRCODE 53 AR200 0003720O AMT J 66 AR200 03730O L1BAL J 79 AR200 03740O E 1 NL2N20 AR200 03750O N50N99 CONTAC 24 AR200 03760O N50N99 LSTPAYY 33 AR200 03770O DOCNO Z 41 AR200 03780O TRDATEY 50 AR200 0003790O TRCODE 53 AR200 03800O AMT J 66 AR200 03810O L1BAL J 79 AR200 ** 003820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003840ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00385000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003860/* 003870__0O L1BAL J 79 AR200 ** 003820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003840ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0038500(h*J TXAR220 P999999032778(000010H S AR220 00020X DECK-ID A42 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR220 00030F* PRODUCES A SUMMARY AGED TRIAL BALANCE REPORT AR220 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR220 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR220 00060F* CONTROL DATA PROPRIETARY PRODUCT AR220 00070F* AR220 0000080FARTRANS IP AF 48 48 DISK AR220 00090FARMAST IC F 280 280R 6AI 1 DISK 40 AR220 00100FARHEAD ID F 50 DISK AR220 00110F$LP1 O F 132 132 OF PRINTER AR220 00120F********************************************************************AR220 00130F** **AR220 00140F** **AR220 0000150F** PROGRAM- CAR220 **AR220 00160F** **AR220 00170F** READS THE "ARTRAN" AND "CUSMST" FILES AND PRODUCES A SUMMARY **AR220 00180F** AGED TRIAL BALANCE REPORT. **AR220 00190F** **AR220 00200F********************************************************************AR220 00210F* 20 ON FIRST TIME FOR EXCEPTION HEADING, SETOF THEREAFTER AR220 0000220F* 21 SETON FIRST TIME, STAYS ON. HELPS INSURE HEADING FIRST CYCLE AR220 00230F* AR220 00240F* 01 INVOICE READ AR220 00250F* 02 CASH AR220 00260F* 03 ADJUST AR220 00270F* 04 CREDIT MEMO AR220 00280F* 05 DEBIT MEMO AR220 0000290F* 06 CATCH ALL AR220 00300F* 09 CUSMST READ AR220 00310F* AR220 00320F* 40 6 CHARACTERS ENTERED IN FOR DATE AR220 00330F* 41 BAD DATE ENTERED AR220 00340F* 42 BAD DATE ENTERED AR220 00350F* 60 CLIENT IS OVER HIS CREDIT LIMIT AR220 0000360F* 61 CREDIT LIMIT IS BLANK. AR220 00370F* 80 CURRENT BALANCE AR220 00380F* 81 31-60 AR220 00390F* 82 61-90 AR220 00400F* 83 OVER 90 AR220 00410IARTRANS NS 01 AR220 00420I 1 2 TRCODE AR220 0000430I 3 80TRDATE AR220 00440I 9 140ACTNO L2 AR220 00450I 15 210DOCNO L1 AR220 00460I 22 302AMOUNT AR220 00470I 31 31 HCODE AR220 00480IARMAST NS 09 AR220 00490I 7 30 NAME AR220 0000500I 109 1140CRLIM 98 AR220 00510I 117 1230YTDSLS AR220 00520I 146 1480AVGPAY AR220 00530IARHEAD NS 08 AR220 00540I 1 40 CONAME AR220 00550C* AR220 00560C* GET DATE FROM CRTCOM, THEN PRINT HEADING ON FIRST CYCLE AR220 0000570C* AR220 00580C* AR220 00590C SETOF 20 AR220 00600C 21 GOTO SECOND AR220 00610C SETON 2021 AR220 00620C EXSR GETDAT AR220 00630C READ ARHEAD 99 AR220 0000640C SECOND TAG AR220 00650C EXSR RECID AR220 00660C* AR220 00670C* SET CREDIT MEMOS, CASH NEGATIVE AR220 00680C* AR220 00690C* AR220 00700C L2 ACTNO CHAINARMAST 99 AR220 0000710C 06 GOTO END AR220 00720C L1 MOVE TRDATE AGEDAT 60 AR220 00730C 02 MAKE CA, CM, DSAR220 00740COR 07 AR220 00750COR 04 Z-SUBAMOUNT AMT 92 NEGATIVE, ALL AR220 00760C N02N04N07 Z-ADDAMOUNT AMT OTHERS POS. AR220 00770C AMT ADD L1BAL L1BAL 92 AR220 0000780C END TAG AR220 00790C* AR220 00800C* AGE L1BAL & ACCUMULATE L2BAL AR220 00810C* AR220 00820CL1 EXSR AGEIT AR220 00830CL1 L1BAL ADD L2BAL L2BAL 92 AR220 00840CL1 80 L1BAL ADD L2CUR L2CUR 92 AR220 0000850CL1 81 L1BAL ADD L230 L230 92 AR220 00860CL1 82 L1BAL ADD L260 L260 92 AR220 00870CL1 83 L1BAL ADD L290 L290 92 AR220 00880CL1 Z-ADD0 L1BAL AR220 00890CL2 L2BAL ADD LRBAL LRBAL 102 AR220 00900CL2 L2CUR ADD LRCUR LRCUR 102 AR220 00910CL2 L230 ADD LR30 LR30 102 AR220 0000920CL2 L260 ADD LR60 LR60 102 AR220 00930CL2 L290 ADD LR90 LR90 102 AR220 00940CL2 SETOF 60 AR220 00950CL2N98 CRLIM COMP L2BAL 60 AR220 00960C********************************************************************AR220 00970C* *AR220 00980C* SUBROUTINE GETDAT GETS DATE FROM CRT, CHECKS VALIDITY, *AR220 0000990C* AND RETURNS ASOF, ADA, AMO, AYR. GETS COMPANY NAME. AR220 01000C* *AR220 01010C********************************************************************AR220 01020CSR GETDAT BEGSR AR220 01030CSR LOOP TAG AR220 01040CSR MOVE 'S' TYPE 1 AR220 01050CSR Z-ADD14 BLNGTH 20 AR220 0001060CSR MOVEL'AGEING D'WORD 14 AR220 01070CSR MOVE 'ATE- ' WORD AR220 01080CSR MOVELWORD BUFFER 72 AR220 01090CSR EXSR CRTCOM AR220 01100CSR MOVE 'A' TYPE AR220 01110CSR Z-ADD7 BLNGTH AR220 01120CSR EXSR CRTCOM AR220 0001130C* AR220 01140C* CHECK TO SEE THAT ENTRY WAS TERMINATED WITH CARRIAGE RETURN AR220 01150C* AR220 01160CSR RCODE COMP 'C' 4040 AR220 01170CSRN40 GOTO CHECK AR220 01180CSR SKIP TAG AR220 01190CSR MOVE 'T' TYPE RETURN CURSOR AR220 0001200CSR Z-ADD1 BLNGTH TO NEXT LINE AR220 01210CSR MOVEL' ' BUFFER AR220 01220CSR EXSR CRTCOM AR220 01230CSR GOTO LOOP AR220 01240C* AR220 01250C* CHECK TO SEE DATE IS VALID AR220 01260C* AR220 0001270CSR CHECK TAG AR220 01280CSR MOVELBUFFER ASOF 60 AR220 01290CSR MOVE ASOF AYR 20 AR220 01300CSR MOVELASOF AMO 20 AR220 01310CSR MOVE ASOF NUM4 40 AR220 01320CSR MOVELNUM4 ADA 20 AR220 01330C* AR220 0001340C* AR220 01350C* AR220 01360CSR AYR COMP 90 41 > 1990 AR220 01370CSR AYR COMP 74 42 < 1974 AR220 01380CSR 41 AR220 01390COR 42 GOTO LOOP AR220 01400CSR ADA COMP 31 41 > 31 AR220 0001410CSR ADA COMP 0 4242 .= 0 AR220 01420CSR 41 AR220 01430COR 42 GOTO LOOP AR220 01440CSR AMO COMP 12 41 > 12 AR220 01450CSR AMO COMP 0 42 = 0 AR220 01460CSR 41 AR220 01470COR 42 GOTO LOOP AR220 0001480CSR ENDSR AR220 01490C* AR220 01500C******************************************************************* AR220 01510C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR220 01520C* AR220 01530CSR RECID BEGSR AR220 01540CSR SETOF 010203 AR220 0001550CSR SETOF 040506 AR220 01560CSR SETOF 07 AR220 01570CSR TRCODE COMP 'IN' 01 AR220 01580CSR TRCODE COMP 'CA' 02 AR220 01590CSR TRCODE COMP 'AJ' 03 AR220 01600CSR TRCODE COMP 'CM' 04 AR220 01610CSR TRCODE COMP 'DM' 05 AR220 0001620CSR TRCODE COMP 'DS' 07 AR220 01630CSRN01N02N03 AR220 01640CANN04N05N07 SETON 06 AR220 01650CSR ENDSR AR220 01660C********************************************************************AR220 01670C* *AR220 01680C* DUMMY SUBROUTINE FOR CRTCOM *AR220 0001690C* *AR220 01700C********************************************************************AR220 01710CSR CRTCOM BEGSR AR220 01720CSR EXITFSUBRCM AR220 01730CSR RLABL BUFFER 72 AR220 01740CSR RLABL TYPE 1 AR220 01750CSR RLABL BLNGTH 20 AR220 0001760CSR RLABL RCODE 1 AR220 01770CSR RLABL MASK 10 AR220 01780CSR RLABL DTYPE 10 AR220 01790CSR ENDSR AR220 01800C********************************************************************AR220 01810C* SUBROUTINE AGEIT AGES AGEDAT TAKEN OF THE FIRST INVOICE *AR220 01820C* AGAINST THE AS OF DATE 'ASOF' TAKEN FROM THE CRT. *AR220 0001830C* *AR220 01840C* ASSUMES 30 DAY MONTHS. *AR220 01850C* *AR220 01860C********************************************************************AR220 01870CSR AGEIT BEGSR AR220 01880CSR SETOF 8330 AR220 01890CSR SETOF 808182 AR220 0001900CSR MOVE AGEDAT YR 20 AR220 01910CSR MOVELAGEDAT MO 20 AR220 01920CSR MOVE AGEDAT DAYR 40 AR220 01930CSR MOVELDAYR DA 20 AR220 01940CSR AYR SUB YR YDIFF 50 AR220 01950CSR YDIFF MULT 360 YDIFF AR220 01960CSR AMO SUB MO MDIFF 40 AR220 0001970CSR 30 MULT MDIFF MDIFF AR220 01980CSR ADA SUB DA DDIFF 50 AR220 01990CSR MDIFF ADD DDIFF DDIFF AR220 02000CSR YDIFF ADD DDIFF DDIFF AR220 02010CSR DDIFF COMP 30 318080 AR220 02020CSRN80 DDIFF COMP 60 328181 AR220 02030CSRN80N81 DDIFF COMP 90 838282 AR220 0002040CSR ENDAGE ENDSR AR220 02050O$LP1 H 203 OF AR220 02060O OR 20NOF AR220 02070O CONAME 85 AR220 02080O H 2 OF AR220 02090O OR 20NOF AR220 02100O 5 'AS OF' AR220 0002110O ASOF Y 14 AR220 02120O 64 'SUMMARY ACCOUNTS' AR220 02130O 82 'RECEIVABLE AGEING' AR220 02140O 105 'CAR220' AR220 02150O 128 'PAGE' AR220 02160O PAGE Z 132 AR220 02170O H 1 OF AR220 0002180O OR 20NOF AR220 02190O 6 'ACCT' AR220 02200O 35 'AVG PAY' AR220 02210O 66 'A/R' AR220 02220O 42 'CREDIT' AR220 02230O H 2 OF AR220 02240O OR 20NOF AR220 0002250O 11 'NUMBER NAME' AR220 02260O 35 'DAYS' AR220 02270O 42 'CODE' AR220 02280O 52 'YTD SALES' AR220 02290O 66 'BALANCE' AR220 02300O 82 'CURRENT' AR220 02310O 96 '31-60' AR220 0002320O 111 '61-90' AR220 02330O 126 'OVER 90' AR220 02340O T 1 L2 AR220 02350O ACTNO Z 6 AR220 02360O NAME 31 AR220 02370O AVGPAYZ 35 AR220 02380O CRLIM Z 42 AR220 0002390O YTDSLSJ 53 AR220 02400O L2BAL JB 67 AR220 02410O L2CUR KB 82 AR220 02420O L230 KB 97 AR220 02430O L260 KB 112 AR220 02440O L290 KB 127 AR220 02450O 60 132 '****' AR220 0002460O T 2 LR AR220 02470O 49 'GRAND TOTALS' AR220 02480O LRBAL J 67 AR220 02490O LRCUR K 82 AR220 02500O LR30 K 97 AR220 02510O LR60 K 112 AR220 02520O LR90 K 127 AR220 00** 002530ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002540ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002550ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002560ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002570/* 002580__0O LR90 K 127 AR220 0(* QTXAR240 P999999032778(000010H S AR240 00020X DECK-ID A43 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR240 00030F* PRINTS STATEMENTS AR240 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR240 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR240 00060F* CONTROL DATA PROPRIETARY PRODUCT AR240 00070F* AR240 0000080FARTRANS IP AF 48 DISK AR240 00090FARMAST IC F 280R 6AI 1 DISK AR240 00100F$LP1 O F 132 OF LPRINTER AR240 00110F********************************************************************AR240 00120F* *AR240 00130F* COMPUSOURCE ACCOUNTS RECEIVABLE SYSTEM *AR240 00140F* *AR240 0000150F* PROGRAM- CAR240 *AR240 00160F* *AR240 00170F* *AR240 00180F* REMARKS- PRINTS STATEMENTS. *AR240 00190F* *AR240 00200F* *AR240 00210F* *AR240 0000220F* *AR240 00230F* *AR240 00240F********************************************************************AR240 00250F* AR240 00260F* 40 AGEDAT IS ZERO. THIS IMPLIES THAT THE FIRST ITEM FOR A DOC # AR240 00270F* WAS NOT AN INVOICE OR DEBIT MEMO, AND DOES NOT NEED TO BE AGED AR240 00280F* AR240 0000290F* 41 DOCUMENT TOTAL IS ZERO AT L1 TIME. AR240 00300F* SUPPRESSES AN AMOUNT DUE BEING PRINTED ON THE RIGHT SIDE OF AR240 00310F* THE INVOICE. AR240 00320F* AR240 00330F* 42 DOCUMENT TOTAL IS NEGATIVE AT L1 TIME. AR240 00340F* AR240 00350F* IF 40 OR 41 OR 42 IS ON, NO AGEING IS DONE, AND THE DOCUMENT AR240 0000360F* TOTAL IS ADDED TO THE OPEN CREDIT CATEGORY. AR240 00370F* 43 STATEMENT CODE IS NOT 'N'. - PRINT STATEMENT AR240 00380F* 01 INVOICE READ AR240 00390F* 02 DEBIT MEMO READ AR240 00400F* 03 ADJUSTMENT READ AR240 00410F* 04 CASH READ AR240 00420F* 05 DISCOUNT READ (ONE PER CASH RECORD AT MOST) AR240 0000430F* 06 CREDIT MEMO READ AR240 00440F* 10 ARMAST READ FOR NAME & ADDRESS AT DETL L2 TIME AR240 00450F* L2 NEW CUSTOMER AR240 00460F* L1 NEW DOCUMENT NUMBER AR240 00470F* AR240 00480F* 31 THIS IS NOT THE FIRST ITEM APPEARING IN THE RIGHT HAND COLUMN AR240 00490F* FOR THIS DOCUMENT ( USED FOR SPACING). AR240 0000500F* 32 SPACE ONE LINE BEFORE PRINTING PAYMENT, AJ, OR CM. AR240 00510F* 21 OFF FIRST CYCLE ONLY (USED TO GET DATE & PRINT EXCEPTION HEADUPAR240 00520F* 22 PRINT EXCEPTION HEADING MENTIONED ABOVE. AR240 00530L$LP1 38FL 32OL AR240 00540IARTRANS NS 01 AR240 00550I 1 2 TRCODE AR240 00560I 3 40MO1 AR240 0000570I 5 60DA1 AR240 00580I 3 80DATE AR240 00590I 9 140CUSTNOL2 AR240 00600I 15 210INVNO L1 AR240 00610I 22 302AMT AR240 00620IARMAST NS 10 AR240 00630I 7 30 NAME AR240 0000640I 31 54 ADDR1 AR240 00650I 55 78 ADDR2 AR240 00660I 79 91 CITY AR240 00670I 92 93 STATE AR240 00680I 94 980ZIP AR240 00690I 116 116 STCD AR240 00700C L2 Z-ADD0 L2AMT 92 AR240 0000710C L2 Z-ADD0 L1AMT 92 AR240 00720C L2 Z-ADD0 L2CURR 92 AR240 00730C L2 Z-ADD0 L230 92 AR240 00740C L2 Z-ADD0 L260 92 AR240 00750C L2 Z-ADD0 L290 92 AR240 00760C L2 Z-ADD0 OPCR 92 AR240 00770C L2 Z-ADD1 PAGE AR240 0000780C L2 Z-ADD1 PAGE1 AR240 00790C* AR240 00800C* EXECUTE GETDAT AND PRINT THE FIRST HEADING ON THE FIRST CYCLE AR240 00810C* AR240 00820C 20 GOTO SECOND AR240 00830C SETON 2021 AR240 00840C EXSR GETDAT AR240 0000850C SETOF 21 AR240 00860C SECOND TAG AR240 00870C EXSR RECID AR240 00880C* AR240 00890C* ACCUMULATE AMOUNT DUE AR240 00900C* AR240 00910C 01 AR240 0000920COR 02 AR240 00930COR 03 AMT ADD L1AMT L1AMT 92 AR240 00940C 04 AR240 00950COR 05 AR240 00960COR 06 L1AMT SUB AMT L1AMT 92 AR240 00970C L2 CUSTNO CHAINARMAST 99 AR240 00980C L2 SETOF 43 AR240 0000990C L2 STCD COMP 'N' 4343 AR240 01000C MOVE TRCODE FSTCDE 2 AR240 01010C L1 MOVE INVNO FIRST 70 AR240 01020C* AR240 01030C* KEEP A COUNT OF TRANSACTIONS APPEARING IN THE RIGHT HAND AR240 01040C* COLUMN FOR SPACING PURPOSES AR240 01050C* AR240 0001060C 03 AR240 01070COR 04 AR240 01080COR 05 AR240 01090COR 06 1 ADD MCOUNT MCOUNT 20 AR240 01100C SETOF 32 AR240 01110C MCOUNT COMP 1 31 AR240 01120C 03 31 AR240 0001130COR 03 L1 AR240 01140COR 04 31 AR240 01150COR 04 L1 AR240 01160COR 06 31 AR240 01170COR 06 L1 SETON 32 AR240 01180C* AR240 01190C* MOVE THE FIRST INVOICE OR DEBIT MEMO'S DATE TO AGE DATE. AR240 0001200C* AR240 01210C L1 01 AR240 01220COR L1 02 MOVE DATE AGEDAT 60 AR240 01230C* AR240 01240C* NEW DOCUMENT NUMBER. RESET COUNT OF RIGHT HAND COLUMN ITEMS, AR240 01250C* ACCUMULATE STATEMENT TOTAL, AGE IF NECESSARY AR240 01260C* AR240 0001270C* AR240 01280C* AR240 01290CL1 L1AMT ADD L2AMT L2AMT 92 AR240 01300CL1 Z-ADD0 MCOUNT AR240 01310CL1 AGEDAT COMP 0 40 AR240 01320CL1 40 L1AMT ADD OPCR OPCR 92 AR240 01330CL1 40 GOTO ENDL1 AR240 0001340CL1 L1AMT COMP 0 4241 AR240 01350CL1 42 AR240 01360COR 41 L1AMT ADD OPCR OPCR AR240 01370CL1 42 AR240 01380COR 41 GOTO ENDL1 AR240 01390C* AR240 01400C* AGE IF NECESSARY AR240 0001410C* AR240 01420CL1 EXSR AGEIT AR240 01430CL1 80 L1AMT ADD L2CURR L2CURR 92 AR240 01440CL1 81 L1AMT ADD L230 L230 92 AR240 01450CL1 82 L1AMT ADD L260 L260 92 AR240 01460CL1 83 L1AMT ADD L290 L290 92 AR240 01470CL1 ENDL1 TAG AR240 0001480CL1 Z-ADD0 AGEDAT AR240 01490C* AR240 01500C* NEW CUSTOMER. FINISH OFF OLD STATEMENT (BLANKING TOTALS AFTER), AR240 01510C* MOVE 1 TO PAGE, HEAD UP NEW STATEMENT. AR240 01520CL2 MOVE 1 PAGE AR240 01530C* AR240 01540C******************************************************************* AR240 0001550C* SETS RECORD ID CODES. (REQ'D DUE TO BUG IN V3 R1.) AR240 01560C* AR240 01570CSR RECID BEGSR AR240 01580CSR SETOF 010203 AR240 01590CSR SETOF 040506 AR240 01600CSR SETOF 07 AR240 01610CSR TRCODE COMP 'IN' 01 AR240 0001620CSR TRCODE COMP 'CA' 04 AR240 01630CSR TRCODE COMP 'AJ' 03 AR240 01640CSR TRCODE COMP 'CM' 06 AR240 01650CSR TRCODE COMP 'DM' 02 AR240 01660CSR TRCODE COMP 'DS' 05 AR240 01670CSRN01N02N03 AR240 01680CANN04N05N06 SETON 07 AR240 0001690CSR ENDSR AR240 01700C********************************************************************AR240 01710C* *AR240 01720C* SUBROUTINE AGEIT AGES AGEDAT TAKEN OF THE FIRST INVOICE *AR240 01730C* AGAINST THE AS OF DATE 'ASOF' TAKEN FROM THE CRT. *AR240 01740C* *AR240 01750C* ASSUMES 30 DAY MONTHS. *AR240 0001760C* *AR240 01770C********************************************************************AR240 01780CSR AGEIT BEGSR AR240 01790CSR SETOF 808182 AR240 01800CSR SETOF 8330 AR240 01810CSR MOVE AGEDAT YR 20 AR240 01820CSR MOVELAGEDAT MO 20 AR240 0001830CSR MOVE AGEDAT DAYR 40 AR240 01840CSR MOVELDAYR DA 20 AR240 01850CSR AYR SUB YR YDIFF 50 AR240 01860CSR YDIFF MULT 360 YDIFF AR240 01870CSR AMO SUB MO MDIFF 40 AR240 01880CSR 30 MULT MDIFF MDIFF AR240 01890CSR ADA SUB DA DDIFF 50 AR240 0001900CSR MDIFF ADD DDIFF DDIFF AR240 01910CSR YDIFF ADD DDIFF DDIFF AR240 01920CSR DDIFF COMP 30 8080 AR240 01930CSRN80 DDIFF COMP 60 8181 AR240 01940CSRN80N81 DDIFF COMP 90 838282 AR240 01950CSR ENDAGE ENDSR AR240 01960C************************************************************** AR240 0001970CSR GETDAT BEGSR AR240 01980CSR LOOP TAG AR240 01990CSR MOVE 'S' TYPE 1 AR240 02000CSR Z-ADD14 BLNGTH 20 AR240 02010CSR MOVEL'AGEING D'WORD 14 AR240 02020CSR MOVE 'ATE- ' WORD AR240 02030CSR MOVELWORD BUFFER 72 AR240 0002040CSR EXSR CRTCOM AR240 02050CSR MOVE 'A' TYPE AR240 02060CSR Z-ADD7 BLNGTH AR240 02070CSR EXSR CRTCOM AR240 02080C* AR240 02090C* CHECK TO SEE THAT ENTRY WAS TERMINATED WITH CARRIAGE RETURN AR240 02100C* AR240 0002110CSR RCODE COMP 'C' 4040 AR240 02120CSRN40 GOTO CHECK AR240 02130CSR SKIP TAG AR240 02140CSR MOVE 'T' TYPE RETURN CURSOR AR240 02150CSR Z-ADD1 BLNGTH TO NEXT LINE AR240 02160CSR MOVEL' ' BUFFER AR240 02170CSR EXSR CRTCOM AR240 0002180CSR GOTO LOOP AR240 02190C* AR240 02200C* CHECK TO SEE DATE IS VALID AR240 02210C* AR240 02220CSR CHECK TAG AR240 02230CSR MOVELBUFFER ASOF 60 AR240 02240CSR MOVE ASOF AYR 20 AR240 0002250CSR MOVELASOF AMO 20 AR240 02260CSR MOVE ASOF NUM4 40 AR240 02270CSR MOVELNUM4 ADA 20 AR240 02280C* AR240 02290C* AR240 02300C* AR240 02310CSR AYR COMP 90 41 > 1990 AR240 0002320CSR AYR COMP 74 42 < 1974 AR240 02330CSR 41 AR240 02340COR 42 GOTO LOOP AR240 02350CSR ADA COMP 31 41 > 31 AR240 02360CSR ADA COMP 0 4242 .= 0 AR240 02370CSR 41 AR240 02380COR 42 GOTO LOOP AR240 0002390CSR AMO COMP 12 41 > 12 AR240 02400CSR AMO COMP 0 42 = 0 AR240 02410CSR 41 AR240 02420COR 42 GOTO LOOP AR240 02430CSR ENDSR AR240 02440C********************************************************************AR240 02450C* *AR240 0002460C* DUMMY SUBROUTINE FOR CRTCOM *AR240 02470C* *AR240 02480C********************************************************************AR240 02490CSR CRTCOM BEGSR AR240 02500CSR EXITFSUBRCM AR240 02510CSR RLABL BUFFER 72 AR240 02520CSR RLABL TYPE 1 AR240 0002530CSR RLABL BLNGTH 20 AR240 02540CSR RLABL RCODE 1 AR240 02550CSR RLABL MASK 10 AR240 02560CSR RLABL DTYPE 10 AR240 02570CSR ENDSR AR240 02580C********************************************************************AR240 02590O*****NORMAL HEADER AR240 0002600O$LP1 D 209 L2 43 AR240 02610O NAME 32 AR240 02620O D 1 L2 43 AR240 02630O ADDR1 32 AR240 02640O CUSTNOZ 43 AR240 02650O ASOF 50 AR240 02660O CUSTNOZ 73 AR240 0002670O ASOF 80 AR240 02680O D 1 L2 43 AR240 02690O ADDR2 32 AR240 02700O D 00 L2 43 AR240 02710O CITY 21 AR240 02720O STATE 24 AR240 02730O ZIP Z 30 AR240 0002740O D 22 L2 43 AR240 02750O 1 ' ' AR240 02760O***** CONTINUATION TRAILER AR240 02770O D 3 OFNL2 43 AR240 02780O 59 'C O N T I N U E D' AR240 02790O 82 'C O N T I N U E D' AR240 02800O***** CONTINUATION HEADER AR240 0002810O D 211 OFNL2 43 AR240 02820O CUSTNOZ 43 AR240 02830O ASOF 50 AR240 02840O CUSTNOZ 73 AR240 02850O ASOF 80 AR240 02860O D 00 OFNL2 43 AR240 02870O PAGE Z 58 AR240 0002880O 54 'PAGE' AR240 02890O PAGE1 Z 84 AR240 02900O 80 'PAGE' AR240 02910O D 22 OFNL2 43 AR240 02920O 1 ' ' AR240 02930O**** BODY OF REPORT AR240 02940O D 1 01 43 AR240 0002950O OR 02 43 AR240 02960O MO1 3 AR240 02970O DA1 5 AR240 02980O AMT L 22 AR240 02990O INVNO Z 12 AR240 03000O 01 29 'INVOICE' AR240 03010O 02 29 'DR MEMO' AR240 0003020O D 1 32 43 AR240 03030O 1 ' ' AR240 03040O D 00 03 43 AR240 03050O OR 04 43 AR240 03060O OR 06 43 AR240 03070O 03 32 29 'ADJUST' AR240 03080O 04 32 29 'CASH' AR240 0003090O 06 32 29 'CR MEMO' AR240 03100O MO1 33 AR240 03110O AMT L 44 AR240 03120O DA1 35 AR240 03130O D 00 05 43 AR240 03140O AMT L 52 AR240 03150O***** TOTALS AR240 0003160O T 00 L1N41 43 AR240 03170O L1AMT L 61 AR240 03180O L1AMT LB 84 AR240 03190O FIRST Z 71 AR240 03200O FSTCDE 73 AR240 03210O T 133 L2 43NOF AR240 03220O 1 ' ' AR240 0003230O T 3 L2 43 AR240 03240O L2AMT L 84 AR240 03250O L2AMT LB 62 AR240 03260O L290 MB 53 AR240 03270O L260 MB 44 AR240 03280O L230 MB 35 AR240 03290O L2CURRMB 26 AR240 0003300O OPCR MB 17 AR240 03310O********************************************************************AR240 ** 003320ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003330ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003340ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003350ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00336000/* 003370__0O********************************************************************AR240 ** 003320ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003330ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003340ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003350ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0033600(+ AGTXAR250 P999999032778(000010H S AR250 00020X DECK-ID A44 MFG/DIST/ACCT SYSTEM SUMMARY-123 AR250 00030F* LIST AND ZERO-OUT YTD SALES FIELD IN ARMAST AR250 00040F* CYBER 18-10M/20 ACCOUNTS RECEIVABLE VERSION 1.0AR250 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AR250 00060F* CONTROL DATA PROPRIETARY PRODUCT AR250 00070F* AR250 0000080FARMAST UP F 280 6AI 1 DISK AR250 00090F$SYSLISTO F 132 OF PRINTER AR250 00100F* AR250 00110F* LIST AND ZERO-OUT YTD SALES FIELD IN ARMAST. AR250 00120F* AR250 00130F* AR250 00140IARMAST NS 01 115NCD AR250 0000150I 1 60CUSTNO AR250 00160I 7 30 NAME AR250 00170I 31 54 ADDR1 AR250 00180I 55 78 ADDR2 11 AR250 00190I 79 91 CITY AR250 00200I 92 93 STATE AR250 00210I 94 980ZIP AR250 0000220I 117 1230YTDSLS AR250 00230I NS 02 AR250 00240I 1 60CUSTNO AR250 00250C* AR250 00260C 01 YTDSLS ADD TSLS TSLS 90 AR250 00270C* AR250 00280CLR Z7 SUB Z7 Z7 70 AR250 0000290OARMAST D 01 AR250 00300O Z7 123 AR250 00310O$SYSLISTH 304 1P AR250 00320O OR OF AR250 00330O 7 'CAR250' AR250 00340O UDATE Y 20 AR250 00350O 47 'YEAR END SALES DATA' AR250 0000360O 55 'REMOVAL' AR250 00370O H 2 1P AR250 00380O OR OF AR250 00390O 20 'CUST# NAME/ADDRESS' AR250 00400O 49 'YTD SALES' AR250 00410O 72 'PAGE' AR250 00420O PAGE Z 76 AR250 0000430O D 1 01 AR250 00440O CUSTNOZ 6 AR250 00450O NAME 32 AR250 00460O YTDSLSJ 50 AR250 00470O D 1 01 AR250 00480O ADDR1 32 AR250 00490O D 1 01N11 AR250 0000500O ADDR2 32 AR250 00510O D 2 01 AR250 00520O CITY 21 AR250 00530O 22 ',' AR250 00540O STATE 25 AR250 00550O ZIP Z 32 AR250 00560O T 1 LR AR250 0000570O 12 'END OF JOB.' AR250 00580O 35 'TOTAL SALES-' AR250 00590O TSLS J 50 AR250 ** 000600ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000610ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000620ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00063000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000640/* 000650__0O TSLS J 50 AR250 ** 000600ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000610ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000620ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0006300(2+ 2KPROGSIS PPP999999041478(000010H KPROGI00015FNULL IP F 72 DISK KPROGI00020FKPROGS IS F 36 8AI 1 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00035INULL NS 01 KPROGI00040IKPROGS NS 02 MFGIS 00050I 1 36 ALL MFGIS 0000060OOUTPUT D 02 MFGIS 00070O ALL 36 MFGIS /* 000080_ 00 00 00 00 00 00 __ 0(" $TXMR765 P999999111111(000010H S MR765 00020X DECK-ID M41 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR765 00030F* TIME SERIES PLANNING REPORT MR765 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR765 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR765 00060F* CONTROL DATA PROPRIETARY PRODUCT MR765 00070F* MR765 0000080FSEXPLD IPEAF 100 DISK MR765 00090FPARTMST USEAF 300 20AI 271 DISK MR765 00100FHEADING IT F 40 EDISK MR765 00110FREXPLD UC F 100R DISK MR765 00120F$LP1 O F 132 OF PRINTER MR765 00130F* ************************************************************** MR765 00140F* ** COMPUSOURCE ADM- MATERIAL REQUIREMENTS PLANNING ** MR765 0000150F* ** ** MR765 00160F* ** MFG765- TIME SERIES PLANNING REPORT ** MR765 00170F* ** ** MR765 00180F* ** ROBBIE FREEMAN 8/3/76 ** MR765 00190F* ************************************************************** MR765 00200F* ** FUNCTION OF INDICATORS ** MR765 00210F* ** ** MR765 0000220F* ** 01 SEXPLD - REQUIREMENTS (SO,PR) ** MR765 00230F* ** 02 SEXPLD - RECEIPTS (OJ,RJ,PO) ** MR765 00240F* ** 03 PARTMST ** MR765 00250F* ** 04 REXPLD ** MR765 00260F* ** 20 AT LEAST ONE SEXPLD READ FOR THIS PART# ** MR765 00270F* ** 25 PARTMST READ FOR THIS PART# ** MR765 00280F* ** 31 SUBR "ACCEPT" - RUBOUT ** MR765 0000290F* ** 32 SUBR "ACCEPT" - RUBOUT @ BEGINNING OF FIELD ** MR765 00300F* ** 33 SUBR "ACCEPT" - LINEFEED ** MR765 00310F* ** 40 LOOP "LOOP" CONTROL ** MR765 00320F* ** 60 SUBR "CNET" - NET(T) > OR EQ TO 0 ** MR765 00330F* ** 61 1ST PASS THRU L1 LOOP "PLAN"-PRINT RCP,RQD,NET ** MR765 00340F* ** 62 2ND PASS THRU L1 LOOP "PLAN"-PRINT PLN ** MR765 00350F* ** 65 LOOPS "PLAN" & "OLOOP" CONTROL ** MR765 0000360F* ** 66 SUBR "CPLN" - NET(T)<0 & LOTSIZ > ABS[NET(T)] ** MR765 00370F* ** 69 PLN(T) NPLN(T) - OUTPUT '*' NEXT TO PLN(T) ** MR765 00380F* ** 70 SUBR "PERIOD"- TOTAL # OF PERIODS SPECIFIED ** MR765 00390F* ** WAS<11 - ADD DIFF TO LAST NON-0 PERIOD. ** MR765 00400F* ** 80 SUBR "CHKDAT" - DATE OVERFLOW TO NEXT MONTH ** MR765 00410F* ** 81 SUBR "PERIOD" - # OF WKS = 0 ** MR765 00420F* ** 82 SUBR "PERIOD" - # OF MOS = 0 ** MR765 0000430F* ** 83 SUBR "PERIOD" - # OF QTRS= 0 ** MR765 00440F* ** 85 LOOP "DONE" CONTROL ** MR765 00450F* ** 90 SUBR "OUTPUT" - DON'T USE MESSAGE IN TABLE ** MR765 00460F* ** 91 ACCEPT BEGINNING DATE ** MR765 00470F* ** 92 ACCEPT # OF WEEKS (ONLY IF U4 ON) ** MR765 00480F* ** 93 ACCEPT # OF MONTHS (ONLY IF U4 ON) ** MR765 00490F* ** 94 ACCEPT # OF QUARTERS (ONLY IF U4 ON) ** MR765 0000500F* ** 96 SUBR "EDIT" - ERROR - DISPLAY ERROR MESSAGE ** MR765 00510F* ** 98 1ST CYCLE ** MR765 00520F* ** 99 INITIALIZATION DONE ** MR765 00530F* ** U1 SET MIN=0; THEN, PLN=MAX(MIN-NET,LOTSIZ) ** MR765 00540F* ** =MAX[ABS(NET),LOTSIZ], IF NET OR EQ TO MIN. **MR765 04830C********************************************************************MR765 0004840CSR CPLN BEGSR MR765 04850CSR 60 Z-ADD0 NPLN,T MR765 04860CSR 60 GOTO ENDC MR765 04870CSR MIN SUB NET,T ABSNET 70 MR765 04880CSR LOTSIZ COMP ABSNET 66 MR765 04890CSR 66 Z-ADDLOTSIZ ABSNET MR765 04900CSR Z-ADDABSNET NPLN,T MR765 0004910CSR ENDC ENDSR MR765 04920C********************************************************************MR765 04930C** CAVL: TOTAL L1 TIME - COMPUTE AVL(T+1) = NET(T), IF NET(T)> OR **MR765 04940C** EQ TO MIN; = PLN(T)+NET(T), IF NET(T) NPLN(T). **MR765 05040C********************************************************************MR765 0005050CSR OPLAN BEGSR MR765 05060CSR Z-ADD0 T MR765 05070C************************ MR765 05080CSR OLOOP TAG MR765 05090C************************ MR765 05100CSR T ADD 1 T MR765 05110CSR Z-ADDPLN,T N7 MR765 0005120CSR MOVE B72 EWORD 24 MR765 05130CSR EXIT SUBRED MR765 05140CSR RLABL N7 70 MR765 05150CSR RLABL ECODE 1 ECODE = 4 MR765 05160CSR RLABL A8 8 MR765 05170CSR RLABL EPOS 20 EPOS = 7 MR765 05180CSR RLABL EWORD 24 MR765 0005190CSR MOVE A8 OPLN,T MR765 05200CSR PLN,T COMP NPLN,T 69 MR765 05210CSR 69 MOVE '*' OPLN,T MR765 05220CSR T COMP 13 65 MR765 05230CSRN65 GOTO OLOOP MR765 05240CSR ENDSR MR765 05250C********************************************************************MR765 0005260C********************************************************************MR765 05270O$LP1 H 02 1P MR765 05280O OR OF MR765 05290O UDATE Y 132 MR765 05300O HEAD,1 86 MR765 05310O H 2 98 MR765 05320O OR OF MR765 0005330O PAGE Z 8 MR765 05340O 4 'PAGE' MR765 05350O 71 'TIME SERIES PLANNING' MR765 05360O MD,1 Y 78 MR765 05370O 79 '/' MR765 05380O BYR 81 MR765 05390O 132 'MFG765' MR765 0005400O D 21 98 05405O OR OF 05410O 11 'PART NUMBER' 05415O 27 'UM' 05420O D 1 98 05425O OR OF 05430O 12 'DESCRIPTION' 0005435O 35 'PAST' 05440O D 1 98 05445O OR OF 05470O 23 'SOH' MR765 05480O 35 'DUE' MR765 05490O MD,2 Y 43 MR765 05500O MD,3 Y 51 MR765 0005510O MD,4 Y 59 MR765 05520O MD,5 Y 67 MR765 05530O MD,6 Y 75 MR765 05540O MD,7 Y 83 MR765 05550O MD,8 Y 91 MR765 05560O MD,9 Y 99 MR765 05570O MD,10 Y 107 MR765 0005580O MD,11 Y 115 MR765 05590O MD,12 Y 123 MR765 05600O 131 'FUTURE' MR765 05610O E 1 61 MR765 05620O PART 20 MR765 05630O 25 UM 27 MR765 05632O E 1 61 0005634O 25 DESC 37 05636O E 1 61 05640O SOH L 24 MR765 05650O 28 'RQD' MR765 05660O RQD 132 ' -' MR765 05670O E 1 61 MR765 05690O N25 24 '** NOT ON PART MASTER **' MR765 0005700O 28 'RCP' MR765 05710O RCP 132 ' -' MR765 05720O E 1 61 MR765 05730O 3 'LT:' MR765 05740O 25 LEAD M 8 MR765 05750O 15 'MIN:' MR765 05760O 25 MIN M 24 MR765 0005770O 28 'NET' MR765 05780O NET 132 ' -' MR765 05790O E 11 62 MR765 05800O 15 'TOT PLN:' MR765 05810O TOTPLNM 24 MR765 05820O 28 'PLN' MR765 05830O OPLN 132 MR765 0005840OREXPLD D 01 MR765 05850O OR 02 MR765 05860O REC 100 MR765 05870OPARTMST D 03 U3 MR765 05880O SAVERR 270 MR765 05890O********************************************************************MR765 05900O********************************************************************MR765 00** 005910ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005920ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005930ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005940ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005950** MSG: POS 1-4=CURPOS,5-6=LENG,7-54=MES 005960270046TIME SERIES PLANNING MFG765 00597000130248BEGINNING DATE WEEKS MONTHS QUARTERS 005980160448[ ] [ ] [ ] [ ] 005990170406 006000250402** 006010330402 006020370402** 006030440402 00604000480402** 006050560402 006060600402** 006070** MTH: #DAYS/MONTH 006080312831303130313130313031 006090/* 006100_ 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0( TXIN660 P999999032778(000010H S IN660 00020X DECK-ID M63 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN660 00030F* UPDATES MIN/MAX FIELDS IN THE PARTMST FILE RECORDS IN660 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN660 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN660 00060F* CONTROL DATA PROPRIETARY PRODUCT IN660 00070F* IN660 0000080FPARTMST UPEAF 300 20AI 271 DISK IN660 00090FHEADING IT F 40 EDISK IN660 00100F$LP1 O F 132 OF PRINTER IN660 00110F********************************************************************IN660 00120F* IN660 00130F* COMPANY IN660 00140F* SYSTEM PURCHASE/INVENTORY CONTROL IN660 0000150F* PROGRAM MIN/MAX UPDATES OF PARTMST IN660 00160F* IN660 00170F* CONTRACTOR COMPUSOURCE IN660 00180F* PROGRAMMER KATH HILL IN660 00190F* DATE NOVEMBER 10, 1975 IN660 00200F* IN660 00210F********************************************************************IN660 0000220F* IN660 00230F********************************************************************IN660 00240F* IN660 00250F* NARRATIVE: IN660 00260F* IN660 00270F* THIS PROGRAM LOOKS AT ALL RECORDS IN THE PARTMST FILE THAT IN660 00280F* ARE NOT FLAGGED FOR DELETION, HAVE A ' ' OR 'X' MIN/MAX UPDATE IN660 0000290F* CODE, AND HAVE NON-ZERO VALUES FOR THE PARAMETERS USED TO IN660 00300F* DO THE UPDATING (LEAD TIME DAYS, SAFETY STOCK DAYS, AND IN660 00310F* AVERAGE USAGE). IN660 00320F* IN660 00330F* IT'S POSSIBLE TO (1) UPDATE PARTMST AND GET A REPORT THAT IN660 00340F* SHOWS ALL OF THE RECORDS WHOSE MIN AND/OR MAX ALTERS BY AT LEAST IN660 00350F* XXX.X% --- U1 --- TO SEE ALL OF THE RECORDS, USE 0%. IN660 0000360F* (2) JUST GET THE REPORT, SHOWING HOW THE IN660 00370F* FILE WOULD BE UPDATED --- NU1 --- GIVES A CHANCE TO LOOK IN660 00380F* BEFORE LEAPING. IN660 00390F* IN660 00400F* THOUGH ANY RECORDS WITH ONE OR MORE ZERO PARAMETERS IS NOT IN660 00410F* UPDATED, IF THEY MEET THE OTHER REQUIREMENTS TO BE UPDATED, IN660 00420F* THEN THEY ARE PRINTED OUT IN THE REPORT WITH A WARNING IN660 0000430F* MESSAGE. IN660 00440F* IN660 00450F********************************************************************IN660 00460F* IN660 00470F********************************************************************IN660 00480F* IN660 00490F* ID F C H L FUNCTION OF INDICATORS IN660 0000500F* IN660 00510F* 01 PARTMST RECORDS: IN660 00520F* 1. DELETE CODE BLANK IN660 00530F* 02 ALL OTHER PARTMST RECORDS IN660 00540F* IN660 00550F* 11 LEAD TIME DAYS = 0 IN660 00560F* 12 SAFETY STOCK DAYS = 0 IN660 0000570F* 13 AVERAGE USAGE = 0 IN660 00580F* 20 LOOP-INCREMENT WATCHER IN660 00590F* 40 MIN = 0 IN660 00600F* 45 MAX = 0 IN660 00610F* 50 MINPCT < 0 IN660 00620F* 55 MAXPCT < 0 IN660 00630F* 41 NEWMIN = 0 IN660 0000640F* 46 NEWMAX = 0 IN660 00650F* 80 IF NEWMIN OR NEWMAX VARIES BY X% OR MORE IN660 00660F* 90 MIN/MAX UPDATE CODE ' ' OR 'X' IN660 00670F* N90 MIN/MAX UPDATE CODE 'M' OR 'N' IN660 00680F* 99 ONLY GET X% FROM CRT ONCE IN660 00690F* IN660 00700F********************************************************************IN660 0000710F* IN660 00720E MSG 1 3 38 CRT SCREEN IN660 00730E HEADING HEAD 1 1 40 COMPANY NAME IN660 00740IPARTMST NS 01 74 C IN660 00750I 271 290 PARTNO IN660 00760I 1 37 DESCRP IN660 00770I 38 39 UM IN660 0000780I 40 40 CLASS IN660 00790I 44 460LEAD 11 IN660 00800I 47 490SAFETY 12 IN660 00810I 74 74 DLTCD IN660 00820I 181 1870MIN IN660 00830I 188 1940MAX IN660 00840I 195 195 MINMAX IN660 0000850I 196 2020MTDUSE IN660 00860I 203 2090AVGUSE 13 IN660 00870I 210 2112ALPHA IN660 00880I 212 2180YTDUSE IN660 00890I 261 2650DIRAVG 00900I NS 02 IN660 00910I 1 1 AIR IN660 0000920C N99 EXSR INXPCT IN660 00930C N99 SETON 99 IN660 00940C* IN660 00950C 02 GOTO NEXT IN660 00960C MINMAX COMP ' ' 90 IN660 00970C N90 MINMAX COMP 'X' 90 IN660 00980C N90 GOTO NEXT IN660 0000990C SETOF 75 IN660 01000C 11 IN660 01010COR 12 IN660 01020COR 13 SETON 75 IN660 01030C 75 GOTO NEXT IN660 01040C EXSR FRMULA IN660 01050C* IN660 0001060C NEWMIN SUB MIN CHNG1 70 IN660 01070C NEWMAX SUB MAX CHNG2 70 IN660 01080C* IN660 01090C MIN COMP 0 40 IN660 01100C 40 NEWMIN COMP 0 41 IN660 01110C 40 41 Z-ADD0 PCT 53 IN660 01120C 40N41 Z-ADD1 PCT IN660 0001130C N40 CHNG1 DIV MIN PCT IN660 01140C PCT MULT 100 MINPCT 51 IN660 01150C* IN660 01160C MAX COMP 0 45 IN660 01170C 45 NEWMAX COMP 0 46 IN660 01180C 45 46 Z-ADD0 PCT IN660 01190C 45N46 Z-ADD1 PCT IN660 0001200C N45 CHNG2 DIV MAX PCT IN660 01210C PCT MULT 100 MAXPCT 51 IN660 01220C* IN660 01230C MINPCT COMP 0 50 IN660 01240C 50 Z-SUBMINPCT PCTC1 51 IN660 01250C N50 Z-ADDMINPCT PCTC1 IN660 01260C* IN660 0001270C MAXPCT COMP 0 55 IN660 01280C 55 Z-SUBMAXPCT PCTC2 51 IN660 01290C N55 Z-ADDMAXPCT PCTC2 IN660 01300C* IN660 01310C PCTC1 COMP X 80 80 IN660 01320C N80PCTC2 COMP X 80 80 IN660 01330C* IN660 0001340C 80COUNT ADD 1 COUNT 50 IN660 01350C* IN660 01360C NEXT TAG IN660 01370CLR EXSR CLRSCR IN660 01380C* IN660 01390C********************************************************************IN660 01400C* IN660 0001410C* THIS SUBROUTINE ACCEPTS THE MIN/MAX PERCENT (XXX.X%) IN660 01420C* FROM THE CRT. IN660 01430C* IN660 01440C********************************************************************IN660 01450CSR INXPCT BEGSR IN660 01460CSR EXSR CLRSCR IN660 01470CSR Z-ADD0 I 20 IN660 0001480CSR LOOP1 TAG IN660 01490CSR I ADD 1 I IN660 01500CSR MOVELMSG,I KEEP 60 IN660 01510CSR MOVE MSG,I MESS 32 IN660 01520CSR MOVELKEEP CURPOS 40 IN660 01530CSR MOVE KEEP LNGTH 20 IN660 01540CSR EXSR POSCUR IN660 0001550CSR MOVELMESS BUFFER 72 IN660 01560CSR EXSR OUTS IN660 01570CSR I COMP 3 20 IN660 01580CSR 20 GOTO LOOP1 IN660 01590CSR INX TAG IN660 01600CSR MOVEL'1103' CURPOS IN660 01610CSR EXSR POSCUR IN660 0001620CSR MOVEL'[' BUFFER IN660 01630CSR Z-ADD1 LNGTH IN660 01640CSR EXSR OUTS IN660 01650CSR Z-ADD4 LNGTH IN660 01660CSR EXSR ACCEPT IN660 01670CSR RCODE COMP 'R' 20 IN660 01680CSR 20 GOTO INX IN660 0001690CSR MOVELBUFFER XHOLD 4 IN660 01700CSR Z-ADD4 VL 20 IN660 01710CSR MOVELXHOLD VAR 15 IN660 01720CSR EXSR RTADJ IN660 01730CSR MOVELVAR X 41 IN660 01740CSR MOVEL'1203' CURPOS IN660 01750CSR EXSR POSCUR IN660 0001760CSR MOVELVAR BUFFER IN660 01770CSR EXSR OUTS IN660 01780CSR Z-ADD1 LNGTH IN660 01790CSR MOVEL']' BUFFER IN660 01800CSR EXSR OUTS IN660 01810CSR ENDSR IN660 01820C********************************************************************IN660 0001830C* IN660 01840C* THIS SUBROUTINE CALCULATES THE NEWMIN AND NEWMAX. IN660 01850C* IN660 01860C* AVGUSE AVERAGE MONTHLY USAGE IN660 01870C* LEAD LEAD TIME DAYS IN660 01880C* SAFETY SAFETY STOCK DAYS IN660 01890C* SSQ SAFETY STOCK QTY IN660 0001900C* IN660 01910C* SSQ = (SAFETY * AVGUSE)/30 IN660 01920C* IN660 01930C* NEWMIN = SSQ + (LEAD * AVGUSE)/30 IN660 01940C* IN660 01950C* NEWMAX = SSQ + 2((LEAD * AVGUSE)/30) IN660 01960C* IN660 0001970C********************************************************************IN660 01980CSR FRMULA BEGSR IN660 01990C* IN660 02000C* ADD DIRECT AVG USAGE TO MFG AVG USAGE 02010CSR AVGUSE ADD DIRAVG AVGUSE 02020CSR SAFETY MULT AVGUSE CACHE1 70 IN660 02030CSR CACHE1 DIV 30 SSQ 82 IN660 0002040C* IN660 02050CSR LEAD MULT AVGUSE CACHE2 70 IN660 02060CSR CACHE2 DIV 30 CACHE3 82 IN660 02070CSR SSQ ADD CACHE3 NEWMIN 70 IN660 02080C* IN660 02090CSR CACHE3 MULT 2 CACHE3 IN660 02100CSR SSQ ADD CACHE3 NEWMAX 70 IN660 0002110C* IN660 02120CSR ENDSR IN660 02130C********************************************************************IN660 02140C* IN660 02150C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. IN660 02160C* IT DEFINES ALL THE RLABL'S NECESSARY IN660 02170C* IN660 0002180C********************************************************************IN660 02190CSR CRTCOM BEGSR IN660 02200CSR EXITFSUBRCM IN660 02210CSR RLABL BUFFER 72 IN660 02220CSR RLABL TYPE 1 IN660 02230CSR RLABL BLNGTH 20 IN660 02240CSR RLABL RCODE 1 IN660 0002250CSR RLABL MASK 10 IN660 02260CSR RLABL DTYPE 10 IN660 02270CSR ENDSR IN660 02280C********************************************************************IN660 02290C* IN660 02300C* THIS SUBROUTINE CLEARS THE SCREEN. IN660 02310C* IN660 0002320C********************************************************************IN660 02330C* IN660 02340CSR CLRSCR BEGSR IN660 02350CSR MOVEL'C' TYPE IN660 02360CSR EXSR CRTCOM IN660 02370CSR ENDSR IN660 02380C********************************************************************IN660 0002390C* IN660 02400C* THIS SUBROUTINE POSITIONS THE CURSOR. IN660 02410C* IN660 02420C********************************************************************IN660 02430C* IN660 02440CSR POSCUR BEGSR IN660 02450CSR MOVELCURPOS BUFFER IN660 0002460CSR MOVEL'P' TYPE IN660 02470CSR EXSR CRTCOM IN660 02480CSR ENDSR IN660 02490C********************************************************************IN660 02500C* IN660 02510C* THIS SUBROUTINE ACCEPTS TYPE TO THE CRT FROM IN660 02520C* THE KEYBOARD. IN660 0002530C* IN660 02540C********************************************************************IN660 02550CSR ACCEPT BEGSR IN660 02560CSR MOVELLNGTH BLNGTH IN660 02570CSR MOVEL'A' TYPE IN660 02580CSR EXSR CRTCOM IN660 02590CSR ENDSR IN660 0002600C********************************************************************IN660 02610C* IN660 02620C* THIS SUBROUTINE OUTPUTS PRINT TO THE CRT AND IN660 02630C* REPOSITIONS THE CURSOR AT (BLNGTH + 1). IN660 02640C* IN660 02650C********************************************************************IN660 02660CSR OUTS BEGSR IN660 0002670CSR MOVELLNGTH BLNGTH IN660 02680CSR MOVEL'S' TYPE IN660 02690CSR EXSR CRTCOM IN660 02700CSR ENDSR IN660 02710C********************************************************************IN660 02720C* IN660 02730C* THIS SUBROUTINE RIGHT ADJSTS NUMERIC FIELDS. IN660 0002740C* IN660 02750C********************************************************************IN660 02760CSR RTADJ BEGSR IN660 02770CSR EXIT SUBRAJ IN660 02780CSR RLABL VL 20 IN660 02790CSR RLABL VAR 15 IN660 02800CSR ENDSR IN660 0002810C********************************************************************IN660 02820OPARTMST D 01 80N75 IN660 02830O AND U1 90 IN660 02840O NEWMIN 187 IN660 02850O NEWMAX 194 IN660 02860O$LP1 H 202 1P IN660 02870O OR OF IN660 0002880O PAGE Z 8 IN660 02890O 4 'PAGE' IN660 02900O HEAD,1 86 IN660 02910O UDATE Y 132 IN660 02920O H 2 1P IN660 02930O OR OF IN660 02940O 73 'MIN/MAX CHANGES' IN660 0002950O 132 'MFG660' IN660 02960O H 1 1P IN660 02970O OR OF IN660 02980O 11 'PART NUMBER' 02990O 54 'SAFTY' IN660 03000O 59 'LEAD' IN660 03010O 75 'AVERAGE' IN660 0003020O 96 '-------O L D-------' IN660 03030O 117 '-------N E W-------' IN660 03040O 132 '-- % CHANGE--' IN660 03050O H 2 1P IN660 03060O OR OF IN660 03070O 13 'DESCRIPTION' IN660 03080O 43 'UM' IN660 0003090O 48 'CLS' IN660 03100O 53 'STK' IN660 03110O 59 'TIME' IN660 03120O 65 'ALPH' IN660 03130O 74 'USAGE' IN660 03140O 86 'MIN' IN660 03150O 96 'MAX' IN660 0003160O 107 'MIN' IN660 03170O 117 'MAX' IN660 03180O 124 'MIN' IN660 03190O 131 'MAX' IN660 03200O D 1 01 80N75 IN660 03210O AND 90 IN660 03220O OR 01 75 90 IN660 0003230O PARTNO 20 IN660 03232O DIRAVGJ 76 03234O 77 'D' 03240O D 2 01 80N75 03250O AND 90 03260O OR 01 75 90 03270O DESCRP 39 IN660 0003280O UM 43 IN660 03290O CLASS 47 IN660 03300O SAFETYL 53 IN660 03310O LEAD L 59 IN660 03320O ALPHA J 65 IN660 03330O AVGUSEJ 76 IN660 03335O 77 'M' 0003340O MIN J 87 IN660 03350O MAX J 97 IN660 03360O N75NEWMINJ 108 IN660 03370O N75NEWMAXJ 118 IN660 03380O N75MINPCTL 125 IN660 03390O N75MAXPCTL 132 IN660 03400O 75 120 '** PARAMETER IS ZERO **' IN660 0003410O T 33 LR IN660 03420O 1 ' ' IN660 03430O T 33 LR IN660 03440O 1 ' ' IN660 03450O T 31 LR IN660 03460O 11 'END OF JOB.' IN660 03470O COUNT Z 18 IN660 0003480O 42 'PRODUCTS HAD CHANGES OF' IN660 03490O X 1 48 IN660 03500O 58 '% OR MORE.' IN660 ** 003510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003520ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003530ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00354000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003550** 003560200132UPDATE MIN/MAX LIMITS ON PARTMST 003570650106MFG660 003580030316MIN/MAX [ ] % 003590/* 003600_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(. mTXIN615 PF999999032778(000010H S IN615 00020X DECK-ID M58 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN615 00030F* THIS IS THE RECOVERY PROGRAM THAT DISPLAYS LAST RECORD ENTERED IN615 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN615 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN615 00060F* CONTROL DATA PROPRIETARY PRODUCT IN615 00070F* IN615 0000080FDUMMY UPE F 72 DISK IN615 00090FTRANTMP IC F 65R DISK IN615 00100E MSG 1 5 35 IN615 00110IDUMMY NS 01 IN615 00120I 1 72 ALL IN615 00130ITRANTMP NS 02 IN615 00140I 1 65 RCD IN615 0000150C SETOF 60 IN615 00160C SETON LR IN615 00170CLR MOVE ' ' B80 80 IN615 00180CLR EXSR ALMTS IN615 00190CLR Z-ADDLOW SEQNO 50 IN615 00200CLR LOOP TAG IN615 00210CLR SEQNO COMP HIGH 40 IN615 0000220CLR 40 GOTO A IN615 00230CLR SEQNO CHAINTRANTMP 50 IN615 00240CLR 50 GOTO A IN615 00250CLR MOVELRCD TST 2 IN615 00260CLR TST COMP '<>' 51 IN615 00270CLRN51 SEQNO ADD 1 SEQNO IN615 00280CLRN51 GOTO LOOP IN615 0000290CLR A TAG IN615 00300CLR SEQNO SUB 1 SUBNO 50 IN615 00310CLR SUBNO CHAINTRANTMP 50 IN615 00320CLR MOVELRCD BUFFER IN615 00330CLR MOVE 'T' TYPE IN615 00340CLR Z-ADD65 BLNGTH IN615 00350CLR EXSR CRTCOM IN615 0000360CLR MOVE B80 BUFFER IN615 00370CLR MOVELMSG,3 BUFFER IN615 00380CLR MOVE 'S' TYPE IN615 00390CLR Z-ADD35 BLNGTH IN615 00400CLR EXSR CRTCOM IN615 00410CLR MOVE B80 BUFFER IN615 00420CLR MOVELSEQNO BUFFER IN615 0000430CLR MOVE 'T' TYPE IN615 00440CLR Z-ADD5 BLNGTH IN615 00450CLR EXSR CRTCOM IN615 00460CLR MOVELMSG,4 BUFFER IN615 00470CLR MOVE 'S' TYPE IN615 00480CLR Z-ADD35 BLNGTH IN615 00490CLR EXSR CRTCOM IN615 0000500CLR MOVE B80 BUFFER IN615 00510CLR MOVE 'A' TYPE IN615 00520CLR Z-ADD1 BLNGTH IN615 00530CLR EXSR CRTCOM IN615 00540CLR MOVE 'C' TYPE IN615 00550CLR EXSR CRTCOM IN615 00560CLR MOVE 'F' TYPE IN615 0000570CLR EXSR CRTCOM IN615 00580CSR ALMTS BEGSR IN615 00590CSR MOVE B80 BUFFER 80 IN615 00600CSR MOVE 'C' TYPE 1 IN615 00610CSR Z-ADD0 BLNGTH 20 IN615 00620CSR MOVE ' ' RCODE 1 IN615 00630CSR Z-ADD0 MASK 10 IN615 0000640CSR Z-ADD0 DTYPE 10 IN615 00650CSR EXSR CRTCOM IN615 00660CSR MOVELMSG,1 BUFFER IN615 00670CSR MOVE 'S' TYPE IN615 00680CSR Z-ADD35 BLNGTH IN615 00690CSR EXSR CRTCOM IN615 00700CSR MOVE B80 BUFFER IN615 0000710CSR MOVE 'A' TYPE IN615 00720CSR Z-ADD5 BLNGTH IN615 00730CSR Z-ADD1 DTYPE IN615 00740CSR EXSR CRTCOM IN615 00750CSR EXSR SKIP IN615 00760CSR RCODE COMP 'R' 86 IN615 00770CSR EXSR AJ IN615 0000780CSR MOVELBUFFER LOW 50 IN615 00790CSR MOVE B80 BUFFER IN615 00800CSR MOVELMSG,2 BUFFER IN615 00810CSR MOVE 'S' TYPE IN615 00820CSR Z-ADD35 BLNGTH IN615 00830CSR EXSR CRTCOM IN615 00840CSR MOVE B80 BUFFER IN615 0000850CSR MOVE 'A' TYPE IN615 00860CSR Z-ADD5 BLNGTH IN615 00870CSR Z-ADD1 DTYPE IN615 00880CSR EXSR CRTCOM IN615 00890CSR RCODE COMP 'R' 87 IN615 00900CSR EXSR AJ IN615 00910CSR MOVELBUFFER HIGH 50 IN615 0000920CSR MOVE 'C' TYPE IN615 00930CSR EXSR CRTCOM IN615 00940CSR 86 IN615 00950COR 87 GOTO ALMTS IN615 00960CSR Z-ADD0 DTYPE IN615 00970CSR ENDSR IN615 00980CSR CRTCOM BEGSR IN615 0000990CSR EXITFSUBRCM IN615 01000CSR RLABL BUFFER IN615 01010CSR RLABL TYPE IN615 01020CSR RLABL BLNGTH IN615 01030CSR RLABL RCODE IN615 01040CSR RLABL MASK IN615 01050CSR RLABL DTYPE IN615 0001060CSR ENDSR IN615 01070CSR SKIP BEGSR IN615 01080CSR MOVELBUFFER NBUF 1 IN615 01090CSR MOVEL' ' BUFFER IN615 01100CSR Z-ADD1 BLNGTH IN615 01110CSR MOVE 'T' TYPE IN615 01120CSR EXSR CRTCOM IN615 0001130CSR MOVELNBUF BUFFER IN615 01140CSR ENDSR IN615 01150CSR AJ BEGSR IN615 01160CSR MOVELBUFFER VAR 15 IN615 01170CSR Z-ADD5 VL 20 IN615 01180CSR EXIT SUBRAJ IN615 01190CSR RLABL VL IN615 0001200CSR RLABL VAR IN615 01210CSR MOVELVAR BUFFER IN615 01220CSR ENDSR IN615 01230ODUMMY D 60 IN615 01240O ALL 72 IN615 ** 001250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00126000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001290** 001300ENTER BEGINNING RRN 001310ENTER ENDING RRN 001320TRANSACTION RRN 00133000ENTER E FOR END OF JOB 001340/* 001350_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( uTXIN640 P999999032778(000010H S IN640 00020X DECK-ID M61 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN640 00030F* THIS PROGRAM LISTS ALL INVENTORY TRANSACTIONS USED IN UPDATING IN640 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN640 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN640 00060F* CONTROL DATA PROPRIETARY PRODUCT IN640 00070F* IN640 0000080FTRANWRK IPEAF 65 DISK IN640 00090FPARTMST IC F 300R20AI 271 DISK IN640 00100FHEADING IT F 40 EDISK IN640 00110F$LP1 O F 132 OF PRINTER IN640 00120F********************************************************************IN640 00130F* IN640 00140F* PACKAGE MANUFACTURING IN640 0000150F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN640 00160F* PROGRAM PRINT TRANSACTION LISTING IN640 00170F* IN640 00180F* CONTRACTOR COMPUSOURCE IN640 00190F* PROGRAMMER KATH HILL IN640 00200F* DATE OCTOBER 31, 1975 IN640 00210F* IN640 0000220F********************************************************************IN640 00230F* IN640 00240F* NARRATIVE: THIS LISTS OUT THE TRANSACTION FILE BY --- IN640 00250F* TRAN #/PART #/TRAN DATE --- IF AN INVALID TRAN # IN640 00260F* OR INVALID PART # IS FOUND, IT'S NOTED ON THE IN640 00270F* PRINTOUT. IN640 00280F* IN640 0000290F* UNIT/COST IS PRINTED FOR TRAN # 44 [P.O. RECEIPT] IN640 00300F* AND TRAN # 43 [REPLACE P.O. QTY RECEIVED] IN640 00310F* ONLY. IN640 00320F* IN640 00330F* IF U1 IS OFF, THEN ALL TRANSACTIONS ARE PRINTED. IN640 00340F* IF U1 IS ON, THEN ONLY MANUAL TRANSACTIONS IN640 00345F* [87,89,91,97,98,99] AND 0000350F* [80,82,84,86,88,90,92,93,94,95,96] ARE PRINTED. IN640 00360F********************************************************************IN640 00370F* IN640 00380F* ID F C H L FUNCTION OF INDICATORS IN640 00390F* IN640 00400F* 01 TRANWRK IN640 00410F* 02 PARTMST IN640 0000420F* IN640 00430F* 12 GOOD PARTMST RECORD [DELETE CODE BLAND] IN640 00440F* IN640 00450F* 20 CHAIN TO PARTMST = A 'MISS' IN640 00460F* 30 GOOD TRAN # IN640 00470F* 35 TRAN # = 44 OR 43 IN640 00480F* 50 IF U1, THEN AT L2 CHECK TO SEE IF TRANNO IN TABPRT IN640 0000490F* 55 PRINT ALL RECORDS IN THIS TRANNO GROUP IN640 00500F* IN640 00510F* L1PART # ON TRANTMP IN640 00520F* L2TRAN # ON TRANTMP IN640 00530F* IN640 00540F* U1PRINT JUST MANUAL TRANSACTIONS IN640 00550F* NU1PRINT ALL TRANSACTIONS - NOT JUST MANUALS IN640 0000560F* IN640 00570F********************************************************************IN640 00580E TABA 1 40 2 0 TABB 26 TRAN #/DESCRP IN640 00590E HEADING HEAD 1 1 40 COMPANY NAME IN640 00600E TABPRT 1 17 2 0 MANUAL TRAN #'S IN640 00610E* 80/82/84/86/88/ IN640 00620E* 90/92/93/94/95/96IN640 0000625E* 87/89/91/97/98/99 00630ITRANWRK NS 01 IN640 00640I 42 61 PARTNOL1 IN640 00650I 13 140TRANNOL2 IN640 00660I 15 210QTY IN640 00670I 22 28 REFNUM IN640 00680I 29 340TRANDT IN640 0000690I 35 413UNCOST IN640 00700IPARTMST NS 02 IN640 00710I 271 290 PRNUM IN640 00720I 1 37 DESCRP IN640 00730I 74 74 DLTPR 12 IN640 00740C* IN640 00750C L2 SETOF 355055 IN640 0000760C L2 U1 TRANNO LOKUPTABPRT 50 IN640 00770C L2 U1 50 IN640 00780COR L2NU1 SETON 55 IN640 00790C N55 GOTO END IN640 00800C L2 TRANNO LOKUPTABA TABB 30 IN640 00810C L2 30 TRANNO COMP 44 35 IN640 00820C L2 30N35TRANNO COMP 43 35 IN640 0000830C L2N30 SETOF 35 IN640 00840C* IN640 00850C L1 PARTNO CHAINPARTMST 20 IN640 00860C L1N20N12 SETON 20 IN640 00870C* IN640 00880C END TAG IN640 00890C* IN640 0000900O$LP1 H 202 L2NOF 55 IN640 00910O OR OFNL2 55 IN640 00920O PAGE Z 8 IN640 00930O 4 'PAGE' IN640 00940O HEAD,1 86 IN640 00950O UDATE Y 132 IN640 00960O H 2 L2NOF 55 IN640 0000970O OR OFNL2 55 IN640 00980O 72 'INVENTORY TRANSACTION' IN640 00990O 80 'LISTING' IN640 01000O 132 'MFG640' IN640 01010O H 2 L2NOF 55 IN640 01020O OR OFNL2 55 IN640 01030O 47 'PART NUMBER' IN640 0001040O 69 'DESCRIPTION' IN640 01050O 104 'QUANTITY' IN640 01060O 111 'REF #' IN640 01070O 122 'TRN DATE' IN640 01080O 131 'BUY COST' IN640 01090O D 11 L2NOF 55 IN640 01100O OR OFNL2 55 IN640 0001110O 6 'TRAN #' IN640 01120O TRANNOZ 8 IN640 01130O 30 TABB 35 IN640 01140O N30 30 '** INVALID TRAN # **' IN640 01150O D 1 01 55 IN640 01160O PARTNO 56 IN640 01170O N20 DESCRP 95 IN640 0001180O 20 78 '** INVALID PART # **' IN640 01190O QTY J 105 IN640 01200O REFNUM 113 IN640 01210O TRANDTY 123 IN640 01220O 30 TABB 35 IN640 01230O N30 30 '** INVALID TRAN # **' IN640 01240O 35 UNCOST1 132 IN640 0001250O T 2 L2 55 IN640 01260O 1 ' ' IN640 ** 001270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001280ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001290ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001300ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00131000** 00132010SALES ORDERS 00133012DELETE SALES ORDERS 00134014INVOICES 00135016CREDIT MEMOS 00136018MANUAL INVOICES 00137020DIRECT BILLS 0013800040PURCHASE ORDERS 00139042REPLACE P.O. QTY ORDERED 00140043REPLACE P.O. QTY RECEIVED 00141044P.O. RECEIPT 00142045CANCEL P.O. QTY / DLT P.O. 00143060OPEN JOBS 00144061OPEN JOBS (COMPONENTS) 0014500062RELEASE JOBS 00146063MTL ISSUE 00147064CHANGE JOB QTY 00148065CHANGE JOB QTY (COMPT) 00149066DELETE OPEN JOB 00150067DELETE OPEN JOB (COMPT) 00151068CLOSE JOB SHORT/LONG 0015200070ADJUST REQUISITIONS 00153072COMPLETED PRODUCTION #1 00154073COMPLETED PRODUCTION #2 00155080ADJUST ALLOCATION 00156082ADJUST STOCK ON ORDER 00157084REPLACE STOCK ON ORDER 00158086ADJUST STOCK ON HAND 0015900087ADJUST AVERAGE USAGE - DIR 0159588REPLACE STOCK ON HAND 00160089REPLACE AVERAGE USAGE - DIR 0160590ADJUST AVERAGE USAGE - MFG 00161091ADJUST MTD USAGE - DIR 0161592REPLACE AVERAGE USAGE -MFG 00162093ADJUST MTD USAGE - MFG 0016300094REPLACE MTD USAGE - MFG 00164095ADJUST YTD USAGE - MFG 00165096REPLACE YTD USAGE - MFG 00166097REPLACE MTD USAGE - DIR 0166298ADJUST YTD USAGE - DIR 0166499REPLACE YTD USAGE - DIR 01666** 0016700080 00168082 00169084 00170086 00171087 0171588 00172089 017250090 00173091 0173592 00174093 00175094 00176095 00177096 0017800097 0178298 0178499 01786/* 001790_ 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0M =NEWHI 9999999051378  __M =NEWHI 9999999051378  (Tc TTXIN630 P j999999032778(000010H S IN630 00020X DECK-ID M60 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN630 00030F* THIS PROGRAM PROCESSES TRANSACTIONS ONTO THE PARTMST FILE IN630 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN630 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN630 00060F* CONTROL DATA PROPRIETARY PRODUCT IN630 00070F* IN630 0000080FTRANWRK IPEAF 65 DISK IN630 00090FPARTMST UC F 300R20AI 271 DISK IN630 00100F********************************************************************IN630 00110F* IN630 00120F* PACKAGE MANUFACTURING IN630 00130F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN630 00140F* PROGRAM UPDATES PARTMST (SOO, SOH, ALLOCA, MTD USAGE, AVGUSE, IN630 0000150F* AVGMAT COST/UNIT, & YTD USAGE) WITH TRAN QTY'S. IN630 00160F* IN630 00170F* CONTRACTOR COMPUSOURCE IN630 00180F* PROGRAMMER KATH HILL IN630 00190F* DATE OCTOBER 31, 1975 IN630 00200F* IN630 00210F********************************************************************IN630 0000220F* IN630 00230F* NARRATIVE: USES TRANWRK RECORDS TO UPDATE PARTMST. IN630 00240F* IN630 00250F********************************************************************IN630 00260F* IN630 00270F* ID F C H L FUNCTION OF INDICATORS IN630 00280F* IN630 0000290F* 01 TRANTMP IN630 00300F* 02 PARTMST IN630 00310F* IN630 00320F* 11 UNIT COST = 0 IN630 00330F* 12 DELETE CODE ON PARTMST BLANK IN630 00340F* IN630 00350F* 20 CHAIN TO PARTMST A MISS IN630 0000360F* 25 TABLE SEARCH IN630 00370F* 33 FIELD LOOPER GUARD IN630 00380F* 34 FLDX VS. ACTY IN630 00390F* 80 STOCK-ON-HAND X=1 IN630 00400F* 81 STOCK-ON-ORDER X=2 IN630 00410F* 82 ALLOCATE X=3 IN630 00420F* 83 MTD USAGE X=4 IN630 0000430F* 88 AVERAGE USAGE X=5 IN630 00440F* 89 YTD USAGE X=6 IN630 00450F* 84 ' ' Y=1 IN630 00460F* 85 '+' Y=2 IN630 00470F* 86 '-' Y=3 IN630 00480F* 87 'R' Y=4 IN630 00490F* 99 SETUP XPOSS & YPOSS AT START OF PROG IN630 0000500F* IN630 00510F* L1PART # IN630 00520F* IN630 00530F********************************************************************IN630 00540E TABA 1 35 2 0 TABB 6 TRAN #/FIELDS IN630 00550E ACT 4 4 1 /+/-/R IN630 00560E TABC 1 2 2 0 SPECIAL TRAN # IN630 0000570E* UPDATE AVGMAT IN630 00580E FLD 6 1 TABB SPLIT APART IN630 00590ITRANWRK NS 01 IN630 00600I 42 61 PARTNOL1 IN630 00610I 13 140TRANNO IN630 00620I 15 210QTY IN630 00630I 22 28 REFNUM IN630 0000640I 29 340TRANDT IN630 00650I 35 413UNCOST 11 IN630 00660IPARTMST NS 02 IN630 00670I 271 290 PRNUM IN630 00680I 74 74 DLTPR 12 IN630 00690I 75 813STDCST IN630 00700I 82 883AVGMAT IN630 0000710I 146 1520SOH IN630 00720I 153 1590SOO IN630 00730I 167 1730ALLOCA IN630 00740I 196 2020MTDUSE IN630 00750I 203 2090AVGUSE IN630 00760I 212 2180YTDUSE IN630 00770C N99 Z-ADD6 XPOSS 20 SOH/SOO/ALLOCA IN630 0000780C* MTDUSE/AVGUSE IN630 00790C* YTDUSE IN630 00800C N99 Z-ADD4 YPOSS 20 /+/-/R IN630 00810C N99 SETON 99 IN630 00820C* ---------------IN630 00830C L1 PARTNO CHAINPARTMST 20 IN630 00840C L1N20N12 SETON 20 IN630 0000850C 20 GOTO FINI IN630 00860C* IN630 00870C L1 Z-ADDAVGMAT SV1 73 IN630 00880C L1 Z-ADDSOH SV2 70 IN630 00890C L1 Z-ADDSOO SV3 70 IN630 00900C L1 Z-ADDALLOCA SV4 70 IN630 00910C L1 Z-ADDMTDUSE SV5 70 IN630 0000920C L1 Z-ADDAVGUSE SV6 70 IN630 00930C L1 Z-ADDYTDUSE SV7 70 IN630 00940C* IN630 00950C TRANNO LOKUPTABC 25 IN630 00960C 25 EXSR CALC1 IN630 00970C* IN630 00980C TRANNO LOKUPTABA TABB 25 IN630 0000990C N25 GOTO FINI IN630 01000C* IN630 01010C MOVELTABB FLDS2 2 IN630 01020C MOVE TABB FLDS4 4 IN630 01030C MOVELFLDS2 FLD,1 IN630 01040C MOVE FLDS2 FLD,2 IN630 01050C MOVELFLDS4 FLDS2 IN630 0001060C MOVELFLDS2 FLD,3 IN630 01070C MOVE FLDS2 FLD,4 IN630 01080C MOVE FLDS4 FLDS2 IN630 01090C MOVELFLDS2 FLD,5 IN630 01100C MOVE FLDS2 FLD,6 IN630 01110C* IN630 01120C Z-ADD0 X 20 IN630 0001130C LOOP1 TAG IN630 01140C X ADD 1 X IN630 01150C Z-ADD0 Y 20 IN630 01160C X COMP XPOSS 33 IN630 01170C 33 GOTO ENDLP1 IN630 01180C LOOP2 TAG IN630 01190C Y ADD 1 Y IN630 0001200C FLD,X COMP ACT,Y 34 IN630 01210C 34 EXSR CALC2 IN630 01220C 34 GOTO ENDLP2 IN630 01230C GOTO LOOP2 IN630 01240C ENDLP2 TAG IN630 01250C GOTO LOOP1 IN630 01260C ENDLP1 TAG IN630 0001270C* IN630 01280C FINI TAG IN630 01290C* IN630 01300CL1N20 PARTNO CHAINPARTMST 20 ALWAYS HITS! IN630 01310C********************************************************************IN630 01320C* IN630 01330C* THIS SUBROUTINE UPDATES THE AVERAGE MATERIAL COST/UNIT. IN630 0001340C* IN630 01350C********************************************************************IN630 01360CSR CALC1 BEGSR IN630 01370CSR 11 Z-ADDSTDCST UNCOST IN630 01380CSR Z-ADDSV2 SOH 70 IN630 01390CSR SV1 MULT SOH A 100 IN630 01400CSR QTY MULT UNCOST B 100 IN630 0001410CSR A ADD B A IN630 01420CSR SOH ADD QTY B IN630 01430CSR A DIV B SV1 H IN630 01440CSR ENDSR IN630 01450C********************************************************************IN630 01460C* IN630 01470C* THIS SUBROUTINE UPDATES: 1. STOCK-ON-HAND IN630 0001480C* 2. STOCK-ON-ORDER IN630 01490C* 3. ALLOCATION IN630 01500C* 4. MTD USAGE IN630 01510C* 5. AVERAGE USAGE IN630 01520C* 6. YTD USAGE IN630 01530C* IN630 01540C********************************************************************IN630 0001550CSR CALC2 BEGSR IN630 01560CSR X COMP 1 80STOCK-ON-HAND IN630 01570CSR X COMP 2 81STOCK-ON-ORDER IN630 01580CSR X COMP 3 82ALLOCATE IN630 01590CSR X COMP 4 83MTD USAGE IN630 01600CSR X COMP 5 88AVERAGE USAGE IN630 01610CSR X COMP 6 89YTD USAGE IN630 0001620CSR Y COMP 1 84' ' IN630 01630CSR Y COMP 2 85'+' IN630 01640CSR Y COMP 3 86'-' IN630 01650CSR Y COMP 4 87'R' IN630 01660C* IN630 01670CSR 84 GOTO ENDC2 IN630 01680CSR 80 Z-ADDSV2 WORK 70 SOH IN630 0001690CSR 81 Z-ADDSV3 WORK SOO IN630 01700CSR 82 Z-ADDSV4 WORK ALLOCA IN630 01710CSR 83 Z-ADDSV5 WORK MTD USAGE IN630 01720CSR 88 Z-ADDSV6 WORK AVGUSE IN630 01730CSR 89 Z-ADDSV7 WORK YTD USAGE IN630 01740C* IN630 01750CSR 85 WORK ADD QTY WORK FLD + QTY = FLDIN630 0001760CSR 86 WORK SUB QTY WORK FLD - QTY = FLDIN630 01770CSR 87 Z-ADDQTY WORK QTY INTO FLD IN630 01780C* IN630 01790CSR 80 Z-ADDWORK SV2 SOH IN630 01800CSR 81 Z-ADDWORK SV3 SOO IN630 01810CSR 82 Z-ADDWORK SV4 ALLOCA IN630 01820CSR 83 Z-ADDWORK SV5 MTD USAGE IN630 0001830CSR 88 Z-ADDWORK SV6 AVGUSE IN630 01840CSR 89 Z-ADDWORK SV7 YTD USAGE IN630 01850C* IN630 01860CSR ENDC2 ENDSR IN630 01870C********************************************************************IN630 01880OPARTMST T L1N20 IN630 01890O SV1 B 88 IN630 0001900O SV2 B 152 IN630 01910O SV3 B 159 IN630 01920O SV4 B 173 IN630 01930O SV5 B 202 IN630 01940O SV6 B 209 IN630 01950O SV7 B 218 IN630 ** 00196000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001970ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001980ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001990ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002000** 00201010 + 00202012 - 0020300014- -+ 00204016- + 00205018- + 00206020- + 00207040 + 00208042 + 00209043+- 0021000044+- 00211045 - 00212060 + 00213061 + 00214062- -+ 00215063- + 00216064 + 0021700065 + 00218066 - 00219067 - 00220068 - 00221069- + 0221570- + 00222072+ 0022300073 - 00224080 + 00225082 + 00226084 R 00227086+ 00228088R 00229090 + 0023000092 R 00231093 + 00232094 R 00233095 + 00234096 R 002350** 002360 +-R 00237000** 00238043 00239044 002400/* 002410_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d- d*REVISE P040578040578(000010H REVISE00020FNULL IP F 72 DISK 0002000030FOPARTMSTIS F 300 12AI 1 DISK 0003000040FPARTMST O F 300 20AI 271 DISK 0004000050INULL NS 01 0005000060IOPARTMSTNS 02 0006000070I 1 209 REC1 0000080I 210 300 REC2 0008000090I 1 12 PART 0009000100I 13 37 DESC 0010000110I 261 265 BIN 0011000120OPARTMST D 02 0012000130O REC1 209 0013000140O REC2 300 001400000145O* 290 ' ' 00150O PART 282 0015000160O DESC 25 0016000165O 37 ' ' 00170O BIN 295 00170/* 00180_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2- @MFG10IS P999999041078(000010H MFG10I00020F@MFG10 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040I@MFG10 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 __ 0(20 OTXPI010 P999999050178(000010H S PI010 00020X DECK-ID M44 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI010 00030F* THIS PROGRAM INITIALIZES THE TAGINP FILE PI010 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI010 00060F* CONTROL DATA PROPRIETARY PRODUCT PI010 00070F* PI010 0000080FDUMMY IP F 72 DISK PI010 00090FTAGINP UC F 32R DISK PI010 00100IDUMMY NS 02 PI010 00110I 1 1 A PI010 00120ITAGINP NS 01 PI010 00130I 1 32 REC PI010 00140C SETON LR99 PI010 0000150CLR LOOP TAG PI010 00160CLR RRN ADD 1 RRN 50 PI010 00170CLR RRN CHAINTAGINP 70 PI010 00180CLRN70 EXCPT PI010 00190CLRN70 GOTO LOOP PI010 00200OTAGINP E 99N70 PI010 00210O OR LRN70 PI010 0000220O REC 32 PI010 00230O 2 '<>' PI010 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' PI010 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(2A ;TXININIT P"999999032778(000010H S ININIT00020X DECK-ID M65 MFG/DIST/ACCT SYSTEM SUMMARY-123 ININIT00030F* INITIALIZES THE INPUT FILE WITH <> IN RECORD POSITION 1 AND 2 ININIT00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0ININIT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA ININIT00060F* CONTROL DATA PROPRIETARY PRODUCT ININIT00070F* ININIT0000080FDUMMY IP F 72 DISK ININIT00090FTRANTMP UC F 65R DISK ININIT00100IDUMMY NS 02 ININIT00110I 1 1 A ININIT00120ITRANTMP NS 01 ININIT00130I 1 65 REC ININIT00140C SETON LR99 ININIT0000150CLR LOOP TAG ININIT00160CLR RRN ADD 1 RRN 50 ININIT00170CLR RRN CHAINTRANTMP 70 ININIT00180CLRN70 EXCPT ININIT00190CLRN70 GOTO LOOP ININIT00200OTRANTMP E 99N70 ININIT00210O OR LRN70 ININIT0000220O REC 65 ININIT00230O 2 '<>' ININIT** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(2} ;TXAP090 P"999999032778(000010H S AP090 00020X DECK-ID A01 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP090 00030F* REFORMATS PAYBLS FILE TO CREATE VENINV FILE USED FOR VALIDATION AP090 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP090 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP090 00060F* CONTROL DATA PROPRIETARY PRODUCT AP090 00070F* AP090 0000080FPAYBLS IPEAF 80 DISK AP090 00090FVENINV OC F 32 13AI 1 DISK AP090 00100F* AP090 00110F* THIS PROGRAM BUILDS THE VENINV FILE FROM PAYBLS FILE FOR USE AP090 00120F* IN INPUT PROGRAMS TO CHECK FOR VENDOR DUPLICATE INVOICE AP090 00130F* AP090 00140IPAYBLS NS 01 AP090 0000150I 1 1 PT AP090 00160I 2 14 VENV AP090 00170I 27 352PGRS AP090 00180I 36 422PDIS AP090 00190OVENINV D 01 AP090 00200O VENV 13 AP090 00210O PGRS 22 AP090 0000220O PDIS 29 AP090 00230O PT 30 AP090 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O PT 30 AP090 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(x2 2TXAP101 P999999032778(000010H S AP101 00020X DECK-ID A02 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP101 00030F* INITIALIZES APINPT FILE WITH <> IN COLUMN 1 AND 2 ALL RECORDS AP101 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP101 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP101 00060F* CONTROL DATA PROPRIETARY PRODUCT AP101 00070F* AP101 0000080F* THIS PROGRAM LABELS APINPT RECORDS WITH '<>' IN C.C.1-2 AP101 00090FAPINPT UP AF 128 DISK AP101 00100IAPINPT NS 10 AP101 00110I 1 2 FIRST2 AP101 00120C FIRST2 COMP '<>' 1111 AP101 00130OAPINPT D 10 AP101 00140O 11 2 '<>' AP101 00** 000150ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000160ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000170ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000180ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000190/* 000200__0O 11 2 '<>' AP101 0(2 fTXAP102 P999999032778(000010H S AP102 00020X DECK-ID A03 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP102 00030F* RECOVERY PROGRAM WHICH DISPLAYS LAST RECORD INPUT AND RECORD NO. AP102 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP102 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP102 00060F* CONTROL DATA PROPRIETARY PRODUCT AP102 00070F* AP102 0000080FAPDUM UPE F 72 DISK AP102 00090FAPINPT IC F 128R DISK AP102 00100E MSG 1 5 35 AP102 00110IAPDUM NS 01 AP102 00120I 1 72 ALL AP102 00130IAPINPT NS 02 AP102 00140I 1 128 RCD AP102 0000150C SETOF 60 AP102 00160C SETON LR AP102 00170CLR MOVE ' ' B80 80 AP102 00180CLR EXSR ALMTS AP102 00190CLR Z-ADDLOW SEQNO 50 AP102 00200CLR LOOP TAG AP102 00210CLR SEQNO COMP HIGH 40 AP102 0000220CLR 40 GOTO A AP102 00230CLR SEQNO CHAINAPINPT 50 AP102 00240CLR 50 GOTO A AP102 00250CLR MOVELRCD TST 2 AP102 00260CLR TST COMP '<>' 51 AP102 00270CLRN51 SEQNO ADD 1 SEQNO AP102 00280CLRN51 GOTO LOOP AP102 0000290CLR A TAG AP102 00300CLR SEQNO SUB 1 SUBNO 50 AP102 00310CLR SUBNO CHAINAPINPT 50 AP102 00320CLR MOVELRCD BUFFER AP102 00330CLR MOVE 'T' TYPE AP102 00340CLR Z-ADD80 BLNGTH AP102 00350CLR EXSR CRTCOM AP102 0000360CLR MOVE RCD HOLD 48 AP102 00370CLR MOVE B80 BUFFER AP102 00380CLR MOVE 'T' TYPE AP102 00390CLR MOVELHOLD HOLD1 47 AP102 00400CLR MOVELHOLD HOLD2 42 AP102 00410CLR MOVELHOLD2 BUFFER AP102 00420CLR Z-ADD42 BLNGTH AP102 0000430CLR EXSR CRTCOM AP102 00440CLR MOVE B80 BUFFER AP102 00450CLR MOVELMSG,3 BUFFER AP102 00460CLR MOVE 'S' TYPE AP102 00470CLR Z-ADD35 BLNGTH AP102 00480CLR EXSR CRTCOM AP102 00490CLR MOVE B80 BUFFER AP102 0000500CLR MOVE HOLD1 HLDSEQ 5 AP102 00510CLR MOVELHLDSEQ BUFFER AP102 00520CLR MOVE 'T' TYPE AP102 00530CLR Z-ADD5 BLNGTH AP102 00540CLR EXSR CRTCOM AP102 00550CLR MOVELMSG,4 BUFFER AP102 00560CLR MOVE 'S' TYPE AP102 0000570CLR Z-ADD35 BLNGTH AP102 00580CLR EXSR CRTCOM AP102 00590CLR MOVE B80 BUFFER AP102 00600CLR MOVE 'A' TYPE AP102 00610CLR Z-ADD1 BLNGTH AP102 00620CLR EXSR CRTCOM AP102 00630CLR MOVE 'C' TYPE AP102 0000640CLR EXSR CRTCOM AP102 00650CLR MOVE 'F' TYPE AP102 00660CLR EXSR CRTCOM AP102 00670CSR ALMTS BEGSR AP102 00680CSR MOVE B80 BUFFER 80 AP102 00690CSR MOVE 'C' TYPE 1 AP102 00700CSR Z-ADD0 BLNGTH 20 AP102 0000710CSR MOVE ' ' RCODE 1 AP102 00720CSR Z-ADD0 MASK 10 AP102 00730CSR Z-ADD0 DTYPE 10 AP102 00740CSR EXSR CRTCOM AP102 00750CSR MOVELMSG,1 BUFFER AP102 00760CSR MOVE 'S' TYPE AP102 00770CSR Z-ADD35 BLNGTH AP102 0000780CSR EXSR CRTCOM AP102 00790CSR MOVE B80 BUFFER AP102 00800CSR MOVE 'A' TYPE AP102 00810CSR Z-ADD5 BLNGTH AP102 00820CSR Z-ADD1 DTYPE AP102 00830CSR EXSR CRTCOM AP102 00840CSR EXSR SKIP AP102 0000850CSR RCODE COMP 'R' 86 AP102 00860CSR EXSR AJ AP102 00870CSR MOVELBUFFER LOW 50 AP102 00880CSR MOVE B80 BUFFER AP102 00890CSR MOVELMSG,2 BUFFER AP102 00900CSR MOVE 'S' TYPE AP102 00910CSR Z-ADD35 BLNGTH AP102 0000920CSR EXSR CRTCOM AP102 00930CSR MOVE B80 BUFFER AP102 00940CSR MOVE 'A' TYPE AP102 00950CSR Z-ADD5 BLNGTH AP102 00960CSR Z-ADD1 DTYPE AP102 00970CSR EXSR CRTCOM AP102 00980CSR RCODE COMP 'R' 87 AP102 0000990CSR EXSR AJ AP102 01000CSR MOVELBUFFER HIGH 50 AP102 01010CSR MOVE 'C' TYPE AP102 01020CSR EXSR CRTCOM AP102 01030CSR 86 AP102 01040COR 87 GOTO ALMTS AP102 01050CSR Z-ADD0 DTYPE AP102 0001060CSR ENDSR AP102 01070CSR CRTCOM BEGSR AP102 01080CSR EXITFSUBRCM AP102 01090CSR RLABL BUFFER AP102 01100CSR RLABL TYPE AP102 01110CSR RLABL BLNGTH AP102 01120CSR RLABL RCODE AP102 0001130CSR RLABL MASK AP102 01140CSR RLABL DTYPE AP102 01150CSR ENDSR AP102 01160CSR SKIP BEGSR AP102 01170CSR MOVELBUFFER NBUF 1 AP102 01180CSR MOVEL' ' BUFFER AP102 01190CSR Z-ADD1 BLNGTH AP102 0001200CSR MOVE 'T' TYPE AP102 01210CSR EXSR CRTCOM AP102 01220CSR MOVELNBUF BUFFER AP102 01230CSR ENDSR AP102 01240CSR AJ BEGSR AP102 01250CSR MOVELBUFFER VAR 15 AP102 01260CSR Z-ADD5 VL 20 AP102 0001270CSR EXIT SUBRAJ AP102 01280CSR RLABL VL AP102 01290CSR RLABL VAR AP102 01300CSR MOVELVAR BUFFER AP102 01310CSR ENDSR AP102 01320OAPDUM D 60 AP102 01330O ALL 72 AP102 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(3S %TXAP105 P999999032778(000010H S AP105 00020X DECK-ID A04 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP105 00030F* REPORTS DATA INPUT ERRORS EXISTING IN APINPT INPUT FILE AP105 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP105 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP105 00060F* CONTROL DATA PROPRIETARY PRODUCT AP105 00070F* AP105 0000080F* 01/27/77 FIX BUG IN DUE DATE VALIDATION ROUTINE 'DATCHK'. CCW0 AP105 00090FAPHEAD IP AF 128 DISK AP105 00100FAPINPT IS AF 128 DISK AP105 00110FVENINV IC F 32R13AI 1 DISK AP105 00120FVENDOR IC F 256R 5AI 1 DISK AP105 00130FOUTCHK IC F 48R 5AI 1 DISK AP105 00140FCHRTAC IC F 48R10AI 1 DISK AP105 0000150FAPDATA O F 128 DISK AP105 00160F$SYSLISTO F 132 OF LPRINTER AP105 00170F* AP105 00180F* COMPUSOURCE ACCOUNTS PAYABLE INPUT EDIT LISTING. AP105 00190F* AP105 00200F* ID F C H L FUNCTION OF INDICATORS AP105 00210F* AP105 0000220F* 01 APHEAD INPUT AP105 00230F* 02 APINPT '<>' UNUSED RECORD. AP105 00240F* 03 'BH' BATCH HEADER. AP105 00250F* 04 'IN' INVOICE, CREDIT MEMO. AP105 00260F* 05 'DS' DISTR CONTINUATION. AP105 00270F* 06 'DP' DON'T PAY. AP105 00280F* 16 PAY NOTHING. (THIS IS NOT A PARTIAL.) AP105 0000290F* 07 'MC' MANUAL CHECK. AP105 00300F* 08 'RC' RETURNED CHECK. AP105 00310F* 09 VENINV INPUT. AP105 00320F* 10 VENDOR INPUT. AP105 00330F* 11 OUTCHK INPUT. AP105 00340F* 15 CHECK NOT YET VOIDED ON OUTCHK. AP105 00350F* 12 CHRTAC INPUT. AP105 0000360F* 13 APINPT UNKNOWN RECORD TYPE. AP105 00370F* 14 THIS RECORD IS TO BE IGNORED. AP105 00380F* 20 INVALID DATE AP105 00390F* 21 THIS BH IS FOR A BATCH OF 'IN'S. AP105 00400F* 22 NO HIT ON CHAIN TO VENDOR FILE. AP105 00410F* 24 INVOICE PRINT FLAG FOR 1ST LINE. AP105 00420F* 25 INVOICE PRINT FLAG FOR ADD'L DISTR LINES. AP105 0000430F* 26 NO HIT ON CHAIN TO CHRTAC. AP105 00440F* 27 GENERAL LOOP CONTROL. AP105 00450F* 28 INVOICE GROSS NOT EQUAL TO DISTRIBUTION. AP105 00460F* 29 MC PRINT FLAG FOR ADD'L INVOICES PAID. AP105 00470F* 30 NO HIT ON CHAIN TO OUTCHK. AP105 00480F* 31 MC PRINT FLAG FOR 1ST PRINT LINE. AP105 00490F* 32 MC NET NOT EQUAL TO GROSS DUE MINUS DISC. AP105 0000500F* 33 RC CHECK AMT INPUT DISAGREES WITH AMT ON OUTCHK. AP105 00510F* 34 RC THIS IS AN ATTEMP TO VOID A PREVIOUSLY VOIDED CKAP105 00520F* 35 RC THIS IS A VOID TRANSACTIOIN. AP105 00530F* 37 THE PREVIOUSLY PROCESSED TRANS WAS 'IN' OR 'DS' AP105 00540F* 38 THE PREVIOUSLY PROCESSED TRANS WAS 'MC'. AP105 00550F* 40 BATCH OUT OF BALANCE. AP105 00560F* 41 OUTPUT FLAG FOR APDATA. AP105 0000570F* 42 THIS IS THE 1ST OF A GROUP OF 'DP'S. AP105 00580F* 43 THIS IS THE 1ST OF A GROUP OF 'RC'S. AP105 00590F* 44 THE PREVIOUS TRANS WAS 'DP'. AP105 00600F* 45 THE PREVIOUS TRANS WAS 'RC'. AP105 00610F* 46 THIS BH IS FOR A BATCH OF MC'S. AP105 00620F* 47 THE BATCH TOTALS HAVE BEEN PRINTED ON MOST RECENT AP105 00630F* BATCH. DON'T PRINT AGAIN AT LR TIME. AP105 0000640F* 48 BATCH TOTAL OUTPUT FLAG. AP105 00650F* 49 NO HIT ON CHAIN TO CHRTAC ONCE OR MORE FOR RECORD AP105 00660F* 50 NO HIT ON CHAIN TO VENINV ONCE OR MORE FOR RECORD AP105 00670F* 51 ERRORS EXIST. SEND BLANK TO AP110 AP105 00680F*N51 EDIT CLEAN SEND 'OK' TO AP110. AP105 00690F* AP105 00700F* AP105 0000710F* AP105 00720F* AP105 00730F* AP105 00740F* AP105 00750E DAC 4 10 0 DISTR ACCTS AP105 00760E DAM 4 9 2 DISTR AMTS AP105 00770E MCI 11 8 MC INV'S PAID. AP105 0000780E DAYS 12 12 2 0 DAYS PER MONTH AP105 00790L$SYSLIST 66FL 50OL AP105 00800IAPHEAD NS 01 AP105 00810I 1 40 CNAME AP105 00820IAPINPT NS 02 1 C< 2 C> AP105 00830I 1 1 A1 AP105 00840I NS 03 1 CB 2 CH AP105 0000850I 6 7 TRTYPE AP105 00860I 13 160BNTRNS AP105 00870I 24 322BHTOT AP105 00880I 1 60 BH60 AP105 00890I NS 04 1 CI 2 CN AP105 00900I 3 70VENDNO AP105 00910I 8 15 INVNO AP105 0000920I 3 15 VINV L1 AP105 00930I 16 210INDATE AP105 00940I 22 270DUDATE AP105 00950I 28 362IGROSS AP105 00960I 37 432IDSAMT AP105 00970I 44 51 IPO AP105 00980I 52 610DAC,1 AP105 0000990I 62 702DAM,1 AP105 01000I 71 800DAC,2 AP105 01010I 81 892DAM,2 AP105 01020I 90 990DAC,3 AP105 01030I 100 1082DAM,3 AP105 01040I 1 128 REC AP105 01050I NS 05 1 CD 2 CS AP105 0001060I 3 70VENDNO AP105 01070I 8 15 INVNO AP105 01080I 16 25 DAC,1 AP105 01090I 26 34 DAM,1 AP105 01100I 35 44 DAC,2 AP105 01110I 45 53 DAM,2 AP105 01120I 54 63 DAC,3 AP105 0001130I 64 72 DAM,3 AP105 01140I 73 82 DAC,4 AP105 01150I 83 91 DAM,4 AP105 01160I 1 128 REC AP105 01170I 3 15 VINV L1 AP105 01180I NS 06 1 CD 2 CP AP105 01190I 3 70VENDNO AP105 0001200I 8 15 INVNO AP105 01210I 3 15 VINV L1 AP105 01220I 16 242IGROSS 16 AP105 01230I 1 128 REC AP105 01240I NS 07 1 CM 2 CC AP105 01250I 3 70VENDNO AP105 01260I 8 120CHECKN AP105 0001270I 13 180CKDATE AP105 01280I 19 272CKNET AP105 01290I 28 342IDSAMT AP105 01300I 35 122 MCI AP105 01310I 1 128 REC AP105 01320I NS 08 1 CR 2 CC AP105 01330I 3 70CHECKN AP105 0001340I 8 8 CTYPE AP105 01350I 9 172CKNET AP105 01360I 1 128 REC AP105 01370I NS 14 1 C@ 2 C@ AP105 01380I 1 1 A1 AP105 01390I NS 13 AP105 01400I 1 110 UNREC AP105 0001410IVENINV NS 09 AP105 01420I 14 222GRSDUE AP105 01430IVENDOR NS 10 AP105 01440I 1 1 A1 AP105 01450IOUTCHK NS 11 AP105 01460I 11 192CKAMT AP105 01470I 34 34 A1 15 AP105 0001480ICHRTAC NS 12 AP105 01490I 1 1 A1 AP105 01500C SETOF 495022 AP105 01510C SETOF 2341 AP105 01520C 01 GOTO LAST APHEAD AP105 01530C SEQNO ADD 1 SEQNO 40 AP105 01540C 02 GOTO LAST AP105 0001550C 03 GOTO BH AP105 01560C 04 GOTO IN AP105 01570C 05 GOTO DS AP105 01580C 06 GOTO DP AP105 01590C 07 GOTO MC AP105 01600C 08 GOTO RC AP105 01610C 13 GOTO END AP105 0001620C GOTO LAST AP105 01630C********************************************************************AP105 01640C* BATCH HEADER AP105 01650C* AP105 01660C BH TAG AP105 01670C SETOF 2146 AP105 01680C TRTYPE COMP 'IN' 21 AP105 0001690C TRTYPE COMP 'MC' 46 AP105 01700C Z-ADDSEQNO BSEQNO 40 AP105 01710C GOTO END AP105 01720C********************************************************************AP105 01730C* INVOICE OR CREDIT MEMO AP105 01740C* AP105 01750C IN TAG AP105 0001760C* AP105 01770C Z-ADDDUDATE DATE 60 AP105 01780C EXSR DATCHK AP105 01790C VENDNO CHAINVENDOR 22 AP105 01800C N22 VINV CHAINVENINV 23 AP105 01810C SETON 24 AP105 01820C MOVE DAC,1 A10 10 AP105 0001830C A10 CHAINCHRTAC 26 AP105 01840C Z-ADD1 N 20 AP105 01850C Z-ADDDAM,1 DISTOT 92 AP105 01860C ILOOP1 TAG AP105 01870C 26 SETON 49 AP105 01880C EXCPT PRINT INV LINE AP105 01890C SETOF 2425 AP105 0001900C SETOF 222627 AP105 01910C N ADD 1 N AP105 01920C N COMP 4 27 27 AP105 01930C N27 DAC,N COMP 0 2727 AP105 01940C 27 GOTO INTG1 AP105 01950C MOVE DAC,N A10 AP105 01960C A10 CHAINCHRTAC 26 AP105 0001970C SETON 25 AP105 01980C DAM,N ADD DISTOT DISTOT AP105 01990C GOTO ILOOP1 AP105 02000C INTG1 TAG AP105 02010C IGROSS ADD TTAMT TTAMT 102 AP105 02020C ITRNS ADD 1 ITRNS 40 AP105 02030C GOTO END AP105 0002040C********************************************************************AP105 02050C* DISTRIBUTION CONTINUATION RECORD. AP105 02060C* AP105 02070C DS TAG AP105 02080C* AP105 02090C Z-ADD1 N AP105 02100C SETOF 2627 AP105 0002110C DLOOP TAG AP105 02120C 26 SETON 49 AP105 02130C N COMP 5 27 27 AP105 02140C N27 DAC,N COMP 0 2727 AP105 02150C 27 GOTO END AP105 02160C MOVE DAC,N A10 AP105 02170C A10 CHAINCHRTAC 26 AP105 0002180C SETON 25 AP105 02190C EXCPT AP105 02200C SETOF 25 AP105 02210C DAM,N ADD DISTOT DISTOT AP105 02220C N ADD 1 N AP105 02230C GOTO DLOOP AP105 02240C********************************************************************AP105 0002250C* DON'T PAY RECORD AP105 02260C* AP105 02270C DP TAG AP105 02280C VENDNO CHAINVENDOR 22 AP105 02290C N22 VINV CHAINVENINV 23 AP105 02300C GOTO END AP105 02310C********************************************************************AP105 0002320C* MANUAL CHECK RECORD AP105 02330C* AP105 02340C MC TAG AP105 02350C* AP105 02360C SETOF 3032 AP105 02370C VENDNO CHAINVENDOR 22 AP105 02380C SETOF 2729 AP105 0002390C CHECKN CHAINOUTCHK 30 AP105 02400C Z-ADD1 N AP105 02410C SETON 31 AP105 02420C MOVELVENDNO A13 13 AP105 02430C ITRNS ADD 1 ITRNS AP105 02440C MCLOOP TAG PRINT INV'S AP105 02450C MOVE MCI,N A13 PAID BY THIS AP105 0002460C SETOF 23 AP105 02470C A13 CHAINVENINV 23 CHECK AP105 02480C 23 SETON 50 AP105 02490C EXCPT AP105 02500C SETOF 3129 AP105 02510C N23 GRSDUE ADD ITAMT ITAMT 102 AP105 02520C N ADD 1 N AP105 0002530C N COMP 11 27 AP105 02540C N27 MCI,N COMP ' ' 27 AP105 02550C N27 SETON 29 AP105 02560C N27 GOTO MCLOOP AP105 02570C CKNET ADD TTAMT TTAMT AP105 02580C CKNET ADD IDSAMT D102 102 TEST AMT PAID AP105 02590C D102 COMP ITAMT 3232 EQ GROSS-DISC AP105 0002600C 32 SETON 49 AP105 02610C 32 EXCPT AP105 02620C N32 Z-ADD0 ITAMT AP105 02630C GOTO END AP105 02640C********************************************************************AP105 02650C* RETURNED CHECKS AP105 02660C* AP105 0002670C RC TAG AP105 02680C* AP105 02690C SETOF 303536 AP105 02700C CHECKN CHAINOUTCHK 30 AP105 02710C SETOF 3334 AP105 02720C CTYPE COMP 'V' 35 AP105 02730C 35N15N30 SETON 34 AP105 0002740C N30 CKNET COMP CKAMT 3333 AP105 02750C GOTO END AP105 02760C********************************************************************AP105 02770C END TAG AP105 02780C 03N21N46 ACCUMULATE AP105 02790COR 04 22 ERROR COUNT AP105 02800COR 04 20 AP105 0002810COR 07N30 AP105 02820COR 08 30 AP105 02830COR 49 AP105 02840COR 13 NERR ADD 1 NERR 30 AP105 02850C* AP105 02860C SETOF 41 SET APDATA AP105 02870C N02N03N13 SETON 41 OUTPUT FLAG. AP105 0002880C 06 22 AP105 02890COR 06 23 COUNT. AP105 02900COR 07 22 AP105 02910COR 08 33 AP105 02920COR 50 AP105 02930COR 08 34 NWARN ADD 1 NWARN 30 AP105 02940C SETOF 3738 AP105 0002950C 04 SETON 37 AP105 02960C 07 SETON 38 AP105 02970C 05 SETON 37 AP105 02980C SETOF 4243 AP105 02990C 06N44 SETON 42 AP105 03000C 08N45 SETON 43 AP105 03010C SETOF 444547 AP105 0003020C 06 SETON 44 AP105 03030C 08 SETON 45 AP105 03040C N37N38 SETON 47 AP105 03050C LAST TAG AP105 03060C********************************************************************AP105 03070CL0 37N04N05 AP105 03080CANN14N02 AP105 0003090COR 38N07N14 SETON L2L1 END OF BATCH. AP105 03100C** AP105 03110CL0 SETOF 2840 AP105 03120CL1 37 IGROSS COMP DISTOT 2828 AP105 03130CL1 28N49N22NERR ADD 1 NERR AP105 03140CL1 37N28 Z-ADD0 DISTOT AP105 03150CL2N47 BNTRNS SUB ITRNS VTRNS 30 4040 AP105 0003160CL2N47 BHTOT SUB TTAMT D102 AP105 03170CL2N47 D102 COMP 0 4040 AP105 03180CL2 40 NBATCH ADD 1 NBATCH 30 AP105 03190CL2 SETON 48 AP105 03200CLR 47 SETOF 48 AP105 03210CLR NERR COMP 0 51 ANY ERROS ? AP105 03220C********************************************************************AP105 0003230CSR DATCHK BEGSR AP105 03240CSR MOVE DATE M 20 AP105 03250CSR M COMP 76 20 AP105 03260CSR 20 GOTO ENDATE AP105 03270CSR MOVELDATE M AP105 03280CSR M COMP 1 20 AP105 03290CSR N20 M COMP 12 20 AP105 0003300CSR 20 GOTO ENDATE AP105 03310CSR MOVE DATE NUM4 40 AP105 03320CSR MOVELNUM4 NUM2 20 AP105 03330CSR NUM2 COMP 1 20 AP105 03340CSR N20 NUM2 COMP DAYS,M 20 AP105 03350CSR ENDATE ENDSR AP105 03360OAPDATA D 41 AP105 0003370O REC 128 AP105 03380O$SYSLISTH 203 03 21 AP105 03390O OR 03 46 AP105 03400O OR 42 AP105 03410O OR 43 AP105 03420O OR OF AP105 03430O 5 'PAGE' AP105 0003440O PAGE Z 9 AP105 03450O CNAME 85 AP105 03460O UDATE Y 132 AP105 03470O H 2 03 21 AP105 03480O OR 03 46 AP105 03490O OR 42 AP105 03500O OR 43 AP105 0003510O OR OF AP105 03520O 70 'ACCOUNTS PAYABLE INPUT' AP105 03530O 83 'EDIT LISTING' AP105 03540O 132 'AP105' AP105 03550O H 31 03 21 AP105 03560O OR OF 37 AP105 03570O 6 'P' AP105 0003580O 38 'INVOICE DUE REFEREN' AP105 03590O 52 'CE GROSS' AP105 03600O 90 'GEN LEDGER ACCOUNT' AP105 03610O 109 'C O M M E N T S' AP105 03620O H 2 03 21 AP105 03630O OR OF 37 AP105 03640O 21 'SEQ# G VENDOR NUMBER' AP105 0003650O 39 'DATE (P.O. #)' AP105 03660O 64 'AMOUNT DISCOUNT' AP105 03670O 90 'ACCOUNT # AMOUNT' AP105 03680O H 31 03 46 AP105 03690O OR OF 38 AP105 03700O 6 'P' AP105 03710O 29 'CHECK CHECK' AP105 0003720O 53 'CHECK DISCOUNT' AP105 03730O 63 'INVOICE' AP105 03740O H 2 03 46 AP105 03750O OR OF 38 AP105 03760O 20 'SEQ# G VENDOR NUMBER' AP105 03770O 42 'DATE AMOUNT' AP105 03780O 63 'TAKEN PAID' AP105 0003790O 76 'GROSS DUE' AP105 03800O 96 'C O M M E N T S' AP105 03810O H 32 42 AP105 03820O OR OF 44 AP105 03830O 16 'DON''T PAY SEQ#' AP105 03840O 33 'VENDOR INVOICE' AP105 03850O 47 'AMT TO PAY' AP105 0003860O H 32 43 AP105 03870O OR OF 45 AP105 03880O 25 'RET CHECKS SEQ# CHK#' AP105 03890O 42 'TRANS TYPE' AP105 03900O 60 'RETURN AMT' AP105 03910O 75 'SHOULD BE' AP105 03920O E 1 04 24 AP105 0003930O SEQNO 3 4 AP105 03940O 6 '2' AP105 03950O VENDNO3 12 AP105 03960O INVNO 21 AP105 03970O DUDATEY 30 AP105 03980O IPO 39 AP105 03990O IGROSSA 54 AP105 0004000O IDSAMTA 66 AP105 04010O DAC,1 3 77 AP105 04020O DAM,1 A 92 AP105 04030O E 1 04 24 20 AP105 04040O 115 '* INVALID DUE DATE *' AP105 04050O 132 '*ERROR*' AP105 04060O E 1 04 24 22 AP105 0004070O 113 '* UNKNOWN VENDOR *' AP105 04080O 132 '*ERROR*' AP105 04090O E 1 25 AP105 04100O DAC,N 3 77 AP105 04110O DAM,N A 92 AP105 04120O 26 111 '* INVALID ACCT# *' AP105 04130O 26 132 '*ERROR*' AP105 0004140O 05 SEQNO 3 5 AP105 04150O E 1 04 24 26 AP105 04160O 111 '* INVALID ACCT# *' AP105 04170O 132 '*ERROR*' AP105 04180O E 1 07 31 AP105 04190O SEQNO 3 4 AP105 04200O 6 '4' AP105 0004210O VENDNO3 13 AP105 04220O CHECKN 19 AP105 04230O CKDATEY 29 AP105 04240O CKNET J 43 AP105 04250O IDSAMTJ 54 AP105 04260O MCI,1 63 AP105 04270O N23 GRSDUEA 78 AP105 0004280O E 1 07 31 22 AP105 04290O 99 '* UNKNOWN VENDOR *' AP105 04300O 132 'WARNING' AP105 04310O E 1 07 31N30 AP105 04320O 101 '* CHECK # PREVIOUSLY' AP105 04330O 108 'USED *' AP105 04340O 132 '*ERROR*' AP105 0004350O E 1 07 31 23 AP105 04360O 103 '* INVOICE NOT OPEN FOR' AP105 04370O 117 'THIS VENDOR *' AP105 04380O 132 'WARNING' AP105 04390O E 1 07 29 AP105 04400O MCI,N 63 AP105 04410O N23 GRSDUEA 78 AP105 0004420O 23 103 '* INVOICE NOT OPEN FOR' AP105 04430O 23 117 'THIS VENDOR *' AP105 04440O 23 132 'WARNING' AP105 04450O E 11 07 32 AP105 04460O 76 '------------' AP105 04470O E 1 07 32 AP105 04480O CKNET J 43 AP105 0004490O IDSAMTJ 54 AP105 04500O ITAMT AB 78 AP105 04510O 105 '* NET CHECK NOT EQUAL TO' AP105 04520O 120 'DUE-DISCOUNT *' AP105 04530O 132 '*ERROR*' AP105 04540O D 1 07N32 AP105 04550O 01 ' ' AP105 0004560O D 1 06 AP105 04570O 9 'PROG#=5' AP105 04580O SEQNO 3 16 AP105 04590O VENDNO3 23 AP105 04600O INVNO 33 AP105 04610O IGROSSJ 48 AP105 04620O 22 112 '* UNKNOWN VENDOR *' AP105 0004630O N22 23 118 '* INVALID VENDOR/INVOICE' AP105 04640O 22 132 'WARNING' AP105 04650O 23 132 'WARNING' AP105 04660O D 1 08 AP105 04670O 9 'PROG#=6' AP105 04680O SEQNO 3 17 AP105 04690O CHECKN3 25 AP105 0004700O 33 'VOIDED' AP105 04710O N35 36 'CANCELLED' AP105 04720O CKNET J 61 AP105 04730O N30 CKAMT J 76 AP105 04740O D 1 08 30 AP105 04750O 103 '* CHECK# NOT ON OUTSTAND' AP105 04760O 113 'ING FILE *' AP105 0004770O 132 '*ERROR*' AP105 04780O D 1 08 33 AP105 04790O 103 '* AMOUNT DIFFERENT FROM' AP105 04800O 117 'AMT ON FILE *' AP105 04810O 132 'WARNING' AP105 04820O D 1 08 34 AP105 04830O 99 '* CHECK PREVIOUSLY' AP105 0004840O 108 'VOIDED *' AP105 04850O 132 'WARNING' AP105 04860O D 11 13 AP105 04870O 5 '*SEQ#' AP105 04880O SEQNO 3 9 AP105 04890O 20 'UNKNOWN *''' AP105 04900O UNREC 124 AP105 0004910O 132 '''*ERROR*' AP105 04920O D 11 03N21N46 AP105 04930O 24 '* BH FOR INVALID TR TYPE' AP105 04940O 45 ', '' ''. ENTIRE RECORD' AP105 04950O TRTYPE 29 AP105 04960O 50 '...''' AP105 04970O BH60 110 AP105 0004980O 117 ''' SEQ#=' AP105 04990O SEQNO 3 121 AP105 05000O 132 '*ERROR*' AP105 05010O T 11 L1 28 37 AP105 05020O 90 '------------' AP105 05030O T 1 L1N28 37 AP105 05040O 1 ' ' AP105 0005050O T 1 L1 28 37 AP105 05060O IGROSSA 54 AP105 05070O 60 'GROSS' AP105 05080O 76 'G/L-' AP105 05090O DISTOTA 92 AP105 05100O 115 '* DISTRIBUTION NOT EQ' AP105 05110O 132 'GROSS *ERROR*' AP105 0005120O T 1 L2 48 AP105 05130O 17 '* END OF BATCH *' AP105 05140O 41 'SUMMARY... #TRANS' AP105 05150O 38 56 'NET AMT' AP105 05160O N38 56 'GROSS' AP105 05170O T 1 L2 48 AP105 05180O 32 'BH' AP105 0005190O 20 'SEQ#= , PROG#1' AP105 05200O BSEQNO3B 12 AP105 05210O BNTRNS3B 41 AP105 05220O BHTOT AB 58 AP105 05230O T 1 L2 48 AP105 05240O 32 'ACTUAL' AP105 05250O ITRNS 3B 41 AP105 0005260O TTAMT AB 58 AP105 05270O T 11 L2 48 AP105 05280O 32 'VARIANCE' AP105 05290O VTRNS 3 41 AP105 05300O D102 A 58 AP105 05310O 40 84 '* BATCH OUT OF BALANCE *' AP105 05320O 40 132 '*ERROR*' AP105 0005330O T 11 LR AP105 05340O 16 '* END OF JOB *' AP105 05350O NBATCH1 21 AP105 05360O 45 'BATCHES OUT OF BALANCE,' AP105 05370O NWARN 1 49 AP105 05380O 67 'TRANSACTIONS WITH' AP105 05390O 77 'WARNINGS,' AP105 0005400O NERR 1 81 AP105 05410O 106 'TRANSACTIONS WITH ERRORS' AP105 ** 005420ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00546000** ARRAY DAYS 005470312931303130313130313031 ARRAY DAYS 005480/* 005490__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0054600(#4c zTXAP110 P999999032778(000010H S AP110 00020X DECK-ID A05 MFG/DIST/ACCT SYSTEM SUMMARY-119 AP110 00030F* SEPERATES EDITED INPUT DATA INTO VARIOUS TRANSACTION TYPE FILES AP110 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP110 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP110 00060F* CONTROL DATA PROPRIETARY PRODUCT AP110 00070F* AP110 0000080FAPDATA IPEAF 128 DISK AP110 00090FVENINV IC F 32R13AI 1 DISK AP110 00100FRETCHK O F 16 DISK AP110 00110FDNTPAY O F 32 DISK AP110 00120FPAYUPD O F 64 DISK AP110 00130FPAYEDT O F 64 DISK AP110 00140F$SYSLISTO F 132 OF PRINTER AP110 0000150F* AP110 00160F* SEPARATES EDITED DATA INTO APPROPRIATE FILES FOR FURTHER AP110 00170F* PROCESSING. AP110 00180F* AP110 00190F* ID F C H L FUNCTION OF INDICATORS AP110 00200F* AP110 00210F* 01 IN RECORD. AP110 0000220F* 02 DS RECORD. AP110 00230F* 03 DP RECORD. AP110 00240F* 04 MC RECORD. AP110 00250F* 05 RC RECORD. AP110 00260F* 06 HIT ON VENINV FILE. AP110 00270F* 07 EDIT FLAG RECORD AP110 00280F*N10 NOI ERRORS-GO ON AP110 0000290F* 10 ERRORS IN AP105. IF U8 OFF PRINT MESSAGE & END. AP110 00300F* 21 AT LEAST ONE IN RECORD WAS READ. AP110 00310F* 23 AT LEAST ONE DP RECORD WAS READ. AP110 00320F* 24 AT LEAST ONE MC RECORD WAS READ. AP110 00330F* 25 AT LEAST ONE RC RECORD WAS READ. AP110 00340F* 11 THIS 'IN' IS A CREDIT MEMO. AP110 00350F* 26 LOOP CONTROL. AP110 0000360F* 27 EXCPT FLAG FOR 'C' RECORD OUTPUT TO 'PAYUPD'. AP110 00370F* U8 OVERRIDE ERROR PREVENTION IF ON. AP110 00380E GL 4 19 ACCT/AMT ON IN,DSAP110 00390E INV 11 8 INV'S PAID ON MC AP110 00400IAPDATA NS 01 1 CI 2 CN AP110 00410I 3 51 FLD1 AP110 00420I 16 210IDATE AP110 0000430I 22 270DUDATE AP110 00440I 28 362IGROSS 11 AP110 00450I 52 127 GL AP110 00460I NS 02 1 CD 2 CS AP110 00470I 16 91 GL AP110 00480I NS 03 1 CD 2 CP AP110 00490I 3 15 VNIN AP110 0000500I 16 242IGROSS AP110 00510I NS 04 1 CM 2 CC AP110 00520I 3 70VENDOR AP110 00530I 8 120CHECK AP110 00540I 13 180CKDATE AP110 00550I 19 272CKNET AP110 00560I 28 342DISAMT AP110 0000570I 35 122 INV AP110 00580I NS 05 1 CR 2 CC AP110 00590I 3 18 RCREC AP110 00600IVENINV NS 06 AP110 00610I 14 222IGROSS AP110 00620C 01 GOTO IN AP110 00630C 02 GOTO DS AP110 0000640C 03 GOTO DP AP110 00650C 04 GOTO MC AP110 00660C 05 GOTO RC AP110 00670C GOTO LAST AP110 00680C* AP110 00690C IN TAG AP110 00700C SETON 21 AP110 0000710C MOVE IDATE DATE 60 AP110 00720C EXSR YYMMDD AP110 00730C MOVE DATE IDATE AP110 00740C MOVE DUDATE DATE AP110 00750C EXSR YYMMDD AP110 00760C MOVE DATE DUDATE AP110 00770C* AP110 0000780C DS TAG AP110 00790C Z-ADD1 N 20 AP110 00800C SETOF 26 AP110 00810C DSLOOP TAG AP110 00820C MOVELGL,N D100 100 AP110 00830C D100 COMP 0 26 AP110 00840C 26 GOTO LAST AP110 0000850C EXCPT AP110 00860C N ADD 1 N AP110 00870C 01 N COMP 3 26 AP110 00880C 02 N COMP 4 26 AP110 00890C N26 GOTO DSLOOP AP110 00900C GOTO LAST AP110 00910C* AP110 0000920C DP TAG AP110 00930C SETON 23 AP110 00940C GOTO LAST AP110 00950C* AP110 00960C MC TAG AP110 00970C MOVE CKDATE DATE AP110 00980C EXSR YYMMDD AP110 0000990C MOVE DATE CKDATE AP110 01000C SETON 2427 AP110 01010C EXCPT AP110 01020C SETOF 2726 AP110 01030C Z-ADD1 N AP110 01040C MCLOOP TAG AP110 01050C INV,N COMP ' ' 26 AP110 0001060C ATAG TAG AP110 01070C 26 GOTO LAST AP110 01080C MOVELVENDOR KEY13 13 AP110 01090C MOVE INV,N KEY13 AP110 01100C BTAG TAG AP110 01110C KEY13 CHAINVENINV 26 AP110 01120C N26 EXCPT AP110 0001130C N ADD 1 N AP110 01140C N COMP 11 26 AP110 01150C N26 GOTO MCLOOP AP110 01160C GOTO LAST AP110 01170C* AP110 01180C RC TAG AP110 01190C SETON 25 AP110 0001200C GOTO LAST AP110 01210C* AP110 01220C LAST TAG AP110 01230C********************************************************************AP110 01240C* CHANGES FORMAT OF DATE FROM 'MMDDYY' TO 'YYMMDD'. AP110 01250C* AP110 01260CSR YYMMDD BEGSR AP110 0001270CSR MOVELDATE A4 4 AP110 01280CSR MOVE DATE A2 2 AP110 01290CSR MOVELA2 DATE AP110 01300CSR MOVE A4 DATE AP110 01310CSR ENDSR AP110 01320C********************************************************************AP110 01330OPAYEDT D 01 AP110 0001340O 1 'I' AP110 01350O 11 1 'C' AP110 01360O FLD1 50 AP110 01370O IDATE 20 AP110 01380O DUDATE 26 AP110 01390O E 02N26 AP110 01400O OR 01N26 AP110 0001410O 1 'M' AP110 01420O FLD1 50 AP110 01430O IDATE 20 AP110 01440O GL,N 39 AP110 01450O 50 'I ' AP110 01460O 11 50 'C ' AP110 01470ODNTPAY D 03 AP110 0001480O VNIN 13 AP110 01490O IGROSS 28 AP110 01500OPAYUPD E 04 27 AP110 01510O 1 'C' AP110 01520O CHECK 6 AP110 01530O VENDOR 11 AP110 01540O CKDATE 17 AP110 0001550O DISAMT 33 AP110 01560O CKNET 42 AP110 01570O E 04N27 AP110 01580O 1 'I' AP110 01590O CHECK 6 AP110 01600O VENDOR 11 AP110 01610O CKDATE 17 AP110 0001620O INV,N 25 AP110 01630O IGROSS 40 AP110 01640ORETCHK D 05 AP110 01650O RCREC 16 AP110 01660O$SYSLISTH 303 1P AP110 01670O 6 'AP110' AP110 01680O UDATE Y 18 AP110 0001690O 58 'SEPARATE INPUT RECORDS' AP110 01700O 81 'FOR FURTHER PROCESSING' AP110 01710O T 22 LR AP110 01720O 24 'END OF RUN SUMMARY...' AP110 01730O 50 'FILE NAMES: DNTPAY' AP110 01740O 70 'RETCHK PAYEDT' AP110 01750O 80 'PAYUPD' AP110 0001760O T 2 LR AP110 01770O 40 'RECORDS?' AP110 01780O 48 'YES' AP110 01790O N23 48 ' NO' AP110 01800O 58 'YES' AP110 01810O N25 58 ' NO' AP110 01820O 68 'YES' AP110 0001830O N21 68 ' NO' AP110 01840O 78 'YES' AP110 01850O N24 78 ' NO' AP110 ** 001860ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001870ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001880ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00189000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001900/* 001910__0O N24 78 ' NO' AP110 ** 001860ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001870ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001880ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0018900(A4 TXAP120 P999999032778(000010H S AP120 00020X DECK-ID A06 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP120 00030F* UPDATES AND ADDS NEW PAYABLES INFORMATION TO VARIOUS FILES AP120 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP120 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP120 00060F* CONTROL DATA PROPRIETARY PRODUCT AP120 00070F* AP120 0000080F* MODIFIED 01/20/77 - POST INVOICE GROSS TO VENDOR HISTORY RATHER AP120 00090F* THAN INVOICE NET. AP120 00100F* *** *** *** *** PROGRAM DOCUMENTATION *** *** *** *** AP120 00110F********************************************************************AP120 00120F* SYSTEM-ACCOUNTS PAYABLE PROGRAMMER-TIM MCCULLY *AP120 00130F* PROGRAM- DATE-04/08/75 *AP120 00140F********************************************************************AP120 0000150FSPYEDT IPEAF 64 DISK AP120 00160FPAYBLS ISEAF 80 DISK AP120 00170FAPHEAD IT F 128 EDISK AP120 00180FVENDOR UC F 256R 5AI 1 DISK AP120 00190FPAYOUT O F 80 DISK AP120 00200FGLDETL O F 64 DISK A AP120 00210F$LP1 O F 132 OF PRINTER AP120 0000220F* PROGRAM-NEW PAYABLES UPDATE DATE-4/3/75 AP120 00230F* ID F C H L FUNCTION OF INDICATORS AP120 00240F* 01 NEW INVOICE AP120 00250F* 02 NEW CREDIT MEMO AP120 00260F* 13 INVOICE MO/DA IS ZERO AP120 00270F* 04 MONEY DISTRIBUTION AP120 00280F* 05 PAYABLES AP120 0000290F* 08 VENDOR AP120 00300F* 75 FIRST CYCLE AP120 00310F* 76 CONDITIONS 75 AP120 00320F* 25 VENDOR NOT FOUND AP120 00330F* 61 O/P NEW INV OR CRM. AP120 00340F* H1 MULTIPLE NEW PAYABLES AP120 00350F********************************************************************AP120 0000360E MSG 1 1 23 AP120 00370E APHEAD CONAME 1 1 40 APACNO 10 AP120 00380E ANA 12 10 2 MONTH ANALYSIS AP120 00390ISPYEDT PI 01 1 CI AP120 00400I OR 02 1 CC AP120 00410I 1 64 ALL01 AP120 00420I 2 6 VEN M2 AP120 0000430I 7 14 INV M1 AP120 00440I 2 14 TVI AP120 00450I 15 160INVY AP120 00460I 17 200INVMD 13 AP120 00470I 27 352IGRS 15 AP120 00480I 36 422IDIS AP120 00490I 43 50 REFNO AP120 0000500I 1 1 ITP AP120 00510I PM 04 1 CM AP120 00520I 2 39 ALL04 AP120 00530I 2 6 VEN M2 AP120 00540I 7 14 INV M1 AP120 00550I 40 40 PTP AP120 00560IPAYBLS XX 05 AP120 0000570I 1 1 PT AP120 00580I 2 6 VEN M2 AP120 00590I 7 14 INV M1 AP120 00600I 27 352PGRS AP120 00610I 36 422PDIS AP120 00620I 1 80 ALL05 AP120 00630IVENDOR VN 08 AP120 0000640I 6 30 NAME AP120 00650I 116 235 ANA AP120 00660I********************************************************************AP120 00670C SETOF 75 AP120 00680C N76 SETON 7576 AP120 00690C 75 MOVE 'C' TYPE AP120 00700C 75 EXSR CRTCOM AP120 0000710C 75 EXSR GETDAT AP120 00720C 01 AP120 00730COR 02 MOVELINVMD Y 20 AP120 00740C 01 AP120 00750COR 02 EXSR UPINV AP120 00760C* ********** AP120 00770C 05 EXCPT AP120 0000780CLR MOVE 'C' TYPE AP120 00790CLR EXSR CRTCOM AP120 00800C****************************************************** UPINV *******AP120 00810CSR UPINV BEGSR NEW INV OR CR AP120 00820C* ********** AP120 00830CSR SETON 61 AP120 00840CSR PVI COMP TVI H1 MULTIPLE AP120 0000850CSR MOVELTVI PVI 13 PAYABLE AP120 00860CSR EXSR ITOTAL AP120 00870C* ********** AP120 00880CSR EXCPT AP120 00890CSR SETOF 61 AP120 00900CSR 01 INVCNT ADD 1 INVCNT 30 COUNTS AP120 00910CSR 02 CRDCNT ADD 1 CRDCNT 30 AP120 0000920CSR XUPINV ENDSR AP120 00930C* ********** AP120 00940C****************************************************** UPPAY *******AP120 00950C****************************************************** ITOTAL ******AP120 00960CSR ITOTAL BEGSR RUN AMOUNT AP120 00970C* ********** AP120 00980CSR IGRS SUB IDIS INET 92 TOTALS AP120 0000990CSR TIGRS SUB IGRS TIGRS 102 AP120 01000CSR IDIS ADD TIDIS TIDIS 92 AP120 01010CSR INET ADD TINET TINET 102 AP120 01020CSR VEN CHAINVENDOR 25 AP120 01030CSRN25 ANA,Y ADD IGRS ANA,Y AP120 01040CSR Z-SUBTIGRS PTIGRS 102 AP120 01050CSR XITOTA ENDSR AP120 0001060C* ********** AP120 01070CSR GETDAT BEGSR AP120 01080CSR MOVE MSG,1 WORD23 23 AP120 01090CSR MOVEL0102 BUFFER AP120 01100CSR MOVE 23 BLNGTH AP120 01110CSR EXSR POSCUR AP120 01120CSR MOVE 'S' TYPE AP120 0001130CSR MOVELWORD23 BUFFER AP120 01140CSR EXSR CRTCOM AP120 01150CSR MOVEL2402 BUFFER AP120 01160CSR EXSR POSCUR AP120 01170CSR MOVE 'A' TYPE AP120 01180CSR EXSR CRTCOM AP120 01190CSR MOVELBUFFER CRTMDY 60 AP120 0001200CSR MOVELCRTMDY CRTMD 40 AP120 01210CSR MOVE CRTMDY CRTY 20 AP120 01220CSR MOVELCRTY CRTYMD 60 AP120 01230CSR MOVE CRTMD CRTYMD AP120 01240CSR ENDDAT ENDSR AP120 01250C********************************************************************AP120 01260C* AP120 0001270C* THIS SUBROUTINE POSITIONS THE CURSOR. AP120 01280C* AP120 01290C********************************************************************AP120 01300CSR POSCUR BEGSR AP120 01310CSR MOVE 'P' TYPE AP120 01320CSR EXSR CRTCOM AP120 01330CSR ENDSR AP120 0001340C* AP120 01350C********************************************************************AP120 01360C* AP120 01370C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. AP120 01380C* AP120 01390C********************************************************************AP120 01400CSR CRTCOM BEGSR AP120 0001410CSR EXITFSUBRCM AP120 01420CSR RLABL BUFFER 72 AP120 01430CSR RLABL TYPE 1 AP120 01440CSR RLABL BLNGTH 20 AP120 01450CSR RLABL RCODE 1 AP120 01460CSR RLABL MASK 10 AP120 01470CSR RLABL DTYPE 10 AP120 0001480CSR ENDSR AP120 01490C* AP120 01500OPAYOUT E 61 AP120 01510O ALL01 64 AP120 01520O REFNO 51 AP120 01530O E 05 AP120 01540O ALL05 80 AP120 0001550OGLDETL DADD 04 AP120 01560O ALL04 40 AP120 01570O PTP 1 AP120 01580O 2 '2' AP120 01590O REFNO 54 AP120 01600O TADD LR AP120 01610O CRTYMD 21 AP120 0001620O TIGRS 40 AP120 01630O APACNO 31 AP120 01640O$LP1 H 202 1P AP120 01650O OR OF AP120 01660O PAGE Z 9 AP120 01670O 4 'PAGE' AP120 01680O CONAME 84 AP120 0001690O UDATE Y 132 AP120 01700O H 2 1P AP120 01710O OR OF AP120 01720O 74 'NEW VENDOR PAYABLES' AP120 01730O 132 'AP120' AP120 01740O H 1 1P AP120 01750O OR OF AP120 0001760O 14 'VENDOR VENDOR' AP120 01770O 59 'INVOICE # TYPE INVOICE' AP120 01780O 86 'GROSS DISCOUNT' AP120 01790O 112 'NET REFERENCE' AP120 01800O H 2 1P AP120 01810O OR OF AP120 01820O 5 'NO.' AP120 0001830O 71 'DATE AMOUNT' AP120 01840O E 1 61 AP120 01850O VEN 6 AP120 01860O N25 NAME 33 AP120 01870O 25 33 'VENDOR NOT FOUND' AP120 01880O INV 43 AP120 01890O 61 01 49 'INV' AP120 0001900O 61 02 49 'CM' AP120 01910O INVMD 58 ' / /' AP120 01920O INVY 60 AP120 01930O IGRS J 74 AP120 01940O IDIS B 87 AP120 01950O INET J 100 AP120 01960O REFNO 112 AP120 0001970O E 3 01 H1 AP120 01980O 24 'MULTIPLE NEW PAYABLES. C' AP120 01990O 48 'ORRECT AND RESTART ' AP120 02000O PVI 61 AP120 02010O T 1 LR AP120 02020O 84 '------------ ---------' AP120 02030O 99 '------------' AP120 0002040O T 1 LR AP120 02050O 23 'END OF JOB. THERE WERE' AP120 02060O INVCNT 41 ' &NEW&INVOICES' AP120 02070O TINET J 100 AP120 02080O TIDIS A 87 AP120 02090O PTIGRSJ 74 AP120 02100O T LR AP120 0002110O CRDCNT 41 ' -CREDIT&MEMOS' AP120 02120OVENDOR D 08N25 AP120 02130O ANA 235 AP120 ** 002140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00217000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002180** 002190ENTER TRANSACTION DATE 002200/* 002210__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0021700(5e  TXAP190 P999999032778(000010H S AP190 00020X DECK-ID A07 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP190 00030F* LISTS PAYABLES DUE BY CUTOFF DATE BY DUE DATE WITHIN VENDOR SEQ. AP190 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP190 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP190 00060F* CONTROL DATA PROPRIETARY PRODUCT AP190 00070F* AP190 0000080F* *** *** *** *** PROGRAM DOCUMENTATION *** *** *** *** AP190 00090F* SYSTEM-ACCOUNTS PAYABLE PROGRAMMER-TIM MCCULLY *AP190 00100F* PROGRAM- DATE-04/08/75 *AP190 00110F********************************************************************AP190 00120F* TO CHANGE THIS PROGRAM SO, IF THE INVOICE DUE DATE IS BEFORE THE AP190 00130F* AS-OF DATE, IT WILL NOT SUBTRACT THE DISCOUNT AMOUNT OF AN AP190 00140F* INVOICE FROM THE TOTAL NET CHECK AMOUNT THAT IS OUTPUT TO THE AP190 0000150F* VENDOR FILE, ACTIVATE STEP 10172 BY CHANGING THE ASTERISK TO 'S' AP190 00160F********************************************************************AP190 00170F* THIS PROGRAM REPORTS ALL INVOICES DUE ON/BEFORE THE CUTOFF OR AP190 00180F* CURRENT DATE, AND SUMMARIZES THE REST BY INTERVALS IN THE AP190 00190F* FUTURE. CUTOFF AND PAY DATES ARE ENTERED VIA CRT AND SAVED AP190 00200F* FOR USE IN SELECTION & PRINTING OF INVOICES ON COMPUTER CHECKS. AP190 00210F********************************************************************AP190 0000220F* ID F C H L FUNCTION OF INDICATORS AP190 00230F*01 PAYABLE AP190 00240F* 02 STATUS OF SYSTEM AP190 00250F* 03 VENDOR AP190 00260F* L1 VENDOR # AP190 00270F* 20 FIRST CYCLE DONE AP190 00280F* 21 LOCALIZED USAGE AP190 0000290F* 22 VENDOR NOT FOUND AP190 00300F* 23 CHECK NET IS NEGATIVE - WARNING AP190 00310F* 30 PAYABLE IS PAST OR CURRENT AP190 00320F* 31 DUE LESS THAN ONE INTERVAL IN FUTURE-10 DAYS. AP190 00330F* 32 DUE 1+ TO 2 INTERVALS AP190 00340F* 33 DUE 2+ TO 3 INTERVALS AP190 00350F* 34 DUE 3+ INTERVALS AP190 0000360F* 35 PAST DUE AP190 00370F********************************************************************AP190 00380FAPHEAD UPEAF 128 DISK AP190 00390FPAYOUT USEAF 80 DISK AP190 00400FVENDOR UC F 256R 5AI 1 DISK AP190 00410F$LP1 O F 132 OF LPRINTER AP190 00420FCRT D F 70 CONSOLE AP190 0000430F********************************************************************AP190 00440E CRTP 1 01 45 CRT PARAM & WORDSAP190 00450L$LP1 66FL 56OL AP190 00460IPAYOUT NS 01 AP190 00470I 1 1 PT AP190 00480I 2 6 VEN L1 AP190 00490I 7 14 INV AP190 0000500I 15 160INVY AP190 00510I 17 200INVMD AP190 00520I 21 220DUEY AP190 00530I 23 260DUEMD AP190 00540I 21 260DUEDT AP190 00550I 27 352GRS AP190 00560I 36 422DIS AP190 0000570I 23 240DUEM AP190 00580I 25 260DUED AP190 00590IAPHEAD NS 02 AP190 00600I 1 40 CONAME AP190 00610IVENDOR NS 03 AP190 00620I 6 30 VNAME AP190 00630C********************************************************************AP190 0000640C N20 EXSR FIRST AP190 00650C L1 EXSR NEWVEN AP190 00660C EXSR OVRFLO AP190 00670C 01 EXSR PAYABL AP190 00680CL1 EXSR TOTVEN AP190 00690CLR EXSR TOTRUN AP190 00700C****************************************************** FIRST *******AP190 0000710CSR FIRST BEGSR AP190 00720CSR SETON 2060 AP190 00730CSR Z-ADD1 CRTN 20 AP190 00740CSR EXSR GTDATE AP190 00750CSR MOVE GTDMDY CURMDY 60 AP190 00760CSR MOVE GTDYMD CURDT 60 AP190 00770CSR GTDY MULT 365.25 TMN72 72 AP190 0000780CSR GTDM MULT 30.5 TMN41 41 AP190 00790CSR TMN72 ADD TMN41 CURDAY 50H AP190 00800CSR GTDD ADD CURDAY CURDAY FUTURE SUMMARAP190 00810CSR Z-ADD10 FUINT 20 INTERVAL AP190 00820CSR CURDAY ADD FUINT F1DAY 50 FUTURE 1 INT AP190 00830CSR F1DAY ADD FUINT F2DAY 50 2 INT AP190 00840CSR F2DAY ADD FUINT F3DAY 50 3 INT AP190 0000850CSR ENDSR AP190 00860C****************************************************** PAYABL ******AP190 00870CSR PAYABL BEGSR AP190 00880CSR DUEY MULT 365.25 TMN72 AP190 00890CSR DUEM MULT 30.5 TMN41 AP190 00900CSR TMN72 ADD TMN41 DUEDAY 50 AP190 00910CSR DUEDAY ADD DUED DUEDAY AP190 0000920CSR SETOF 323334 AP190 00930CSR DUEDT COMP CURDT 313530 PAST/CURRENT AP190 00940CSR 35 SETON 30 AP190 00950CSR 31 DUEDAY COMP F1DAY 323131 FUTURE 1 INT AP190 00960CSR 32 DUEDAY COMP F2DAY 333232 2 INT AP190 00970CSR 33 DUEDAY COMP F3DAY 343333 3 INT & MORE AP190 00980CSR 30 GRS ADD JGRS11 JGRS11 112 AP190 0000990CSR 31 GRS ADD JGRS22 JGRS22 112 AP190 01000CSR 32 GRS ADD JGRS33 JGRS33 112 AP190 01010CSR 33 GRS ADD JGRS44 JGRS44 112 AP190 01020CSR 34 GRS ADD JGRS55 JGRS55 112 AP190 01030CSR 30 DIS ADD JDIS11 JDIS11 92 AP190 01040CSR 31 DIS ADD JDIS22 JDIS22 92 AP190 01050CSR 32 DIS ADD JDIS33 JDIS33 92 AP190 0001060CSR 33 DIS ADD JDIS44 JDIS44 92 AP190 01070CSR 34 DIS ADD JDIS55 JDIS55 92 AP190 01080CSR 30 GRS ADD PGRS PGRS 102 VENDOR P/C AP190 01090CSR 30 DIS ADD PDIS PDIS 82 AP190 01100CSRN30 GRS ADD FGRS FGRS 102 VENDOR FUTURE AP190 01110CSRN30 DIS ADD FDIS FDIS 82 AP190 01120CSR GRS ADD VGRS VGRS 112 VENDOR BAL FWD AP190 0001130CSR GRS SUB DIS NET 92 AP190 01140C*R 35 Z-ADDGRS NET AP190 01150CSR 30 NET ADD CNET CNET 92 EXPECTED CHECKAP190 01160CSR ENDSR AP190 01170C****************************************************** NEWVEN ******AP190 01180CSR NEWVEN BEGSR CLEAR OUT OLD AP190 01190CSR Z-ADD0 PGRS VENDOR & SETUP AP190 0001200CSR Z-ADD0 PDIS NEW VENDOR. AP190 01210CSR Z-ADD0 FGRS AP190 01220CSR Z-ADD0 FDIS AP190 01230CSR Z-ADD0 VGRS AP190 01240CSR Z-ADD0 CNET AP190 01250CSR VEN CHAINVENDOR 22 AP190 01260CSR SETON 61 AP190 0001270CSR ENDSR AP190 01280C****************************************************** TOTVEN ******AP190 01290CSR TOTVEN BEGSR AP190 01300CSR PGRS SUB PDIS PNET 102 AP190 01310CSR FGRS SUB FDIS FNET 102 AP190 01320CSR CNET COMP 0 23 AP190 01330CSR CNET ADD TCNET TCNET 112 TOT CHK NET AP190 0001340CSR VEN CHAINVENDOR 22 AP190 01350CSR CNET COMP PNET 4444 AP190 01360CSR 23 SETON 44 AP190 01370CSR ENDSR AP190 01380C****************************************************** TOTRUN ******AP190 01390CSR TOTRUN BEGSR RUN TOTAL CALCAP190 01400CSR FUINT ADD FUINT FUINT2 30 AP190 0001410CSR FUINT ADD FUINT2 FUINT3 30 AP190 01420CSR JGRS11 SUB JDIS11 JNET11 112 AP190 01430CSR JGRS22 SUB JDIS22 JNET22 112 AP190 01440CSR JGRS33 SUB JDIS33 JNET33 112 AP190 01450CSR JGRS44 SUB JDIS44 JNET44 112 AP190 01460CSR JGRS55 SUB JDIS55 JNET55 112 AP190 01470CSR JGRS11 ADD JGRS22 TGRS 112 AP190 0001480CSR JGRS33 ADD TGRS TGRS AP190 01490CSR JGRS44 ADD TGRS TGRS AP190 01500CSR JGRS55 ADD TGRS TGRS AP190 01510CSR JDIS11 ADD JDIS22 TDIS 92 AP190 01520CSR JDIS33 ADD TDIS TDIS AP190 01530CSR JDIS44 ADD TDIS TDIS AP190 01540CSR JDIS55 ADD TDIS TDIS AP190 0001550CSR JNET11 ADD JNET22 TNET 112 AP190 01560CSR JNET33 ADD TNET TNET AP190 01570CSR JNET44 ADD TNET TNET AP190 01580CSR JNET55 ADD TNET TNET AP190 01590CSR ENDSR AP190 01600C******************************************************* OVRFLO *****AP190 01610CSR OVRFLO BEGSR AP190 0001620CSR OF SETON 6061 AP190 01630CSR 61 AP190 01640COR 60 EXCPT AP190 01650CSR SETOF 6061 AP190 01660CSR ENDSR AP190 01670C****************************************************** GTDATE ******AP190 01680CSR GTDATE BEGSR AP190 0001690CSR GTDLOP TAG AP190 01700CSR CRTP,CRTN DSPLYCRT GTDMDY 60 AP190 01710CSR MOVELGTDMDY GTDMD 40 AP190 01720CSR MOVE GTDMDY GTDY 20 AP190 01730CSR GTDMD COMP 0101 21 AP190 01740CSRN21 GTDMD COMP 1231 21 AP190 01750CSRN21 GTDY COMP 75 21 AP190 0001760CSR 21 GOTO GTDLOP AP190 01770CSR MOVELGTDY GTDYMD 60 AP190 01780CSR MOVE GTDMD GTDYMD 60 AP190 01790CSR MOVE GTDMD GTDD 20 AP190 01800CSR MOVELGTDMD GTDM 20 AP190 01810CSR ENDSR AP190 01820C******************************************************** END *******AP190 0001830OPAYOUT D 01 AP190 01840O 71 'X' AP190 01850O N30 71 ' ' AP190 01860OAPHEAD D 02 AP190 01870O CURDT 118 AP190 01880OVENDOR T L1N22 AP190 01890O CNET 115 AP190 0001900O$LP1 E 202 60 AP190 01910O PAGE Z 9 AP190 01920O 4 'PAGE' AP190 01930O CONAME 84 AP190 01940O 123 'REPORT DATE' AP190 01950O UDATE Y 132 AP190 01960O E 2 60 AP190 0001970O 72 'CASH REQUIREMENTS AS OF ' AP190 01980O CURMDYY 80 AP190 01990O 132 'AP190' AP190 02000O E 1 61 AP190 02010O 6 'VENDOR' AP190 02020O VEN 13 AP190 02030O N22 VNAME 41 AP190 0002040O 22 41 'VENDOR NOT FOUND' AP190 02050O E 2 60 AP190 02060O 29 'INVOICE PAYM' AP190 02070O 50 'ENT GROSS GROSS' AP190 02080O 76 'DISCOUNT NET' AP190 02090O 98 'INV DATE DUE' AP190 02100O 123 'COMMENTS' AP190 0002110O D 1 01 30 AP190 02120O INV 23 AP190 02130O GRS J 53 AP190 02140O DIS B 66 AP190 02150O NET J 82 AP190 02160O INVMD 90 ' / /' AP190 02170O INVY Z 92 AP190 0002180O DUEMD 99 ' / /' AP190 02190O DUEY Z 101 AP190 02200O 35 128 '* PAST DUE *' AP190 02210O T 1 L1 AP190 02220O 64 '------------ ---------' AP190 02230O 81 '------------' AP190 02240O T 1 L1 AP190 0002250O PGRS J 53 AP190 02260O PDIS A 66 AP190 02270O PNET J 82 AP190 02280O 98 'PAST/CURRENT' AP190 02290O 44 113 'CHECK NET' AP190 02300O 44 CNET J 127 AP190 02310O T 3 L1 AP190 0002320O FGRS J 53 AP190 02330O FDIS A 66 AP190 02340O FNET J 82 AP190 02350O 92 'FUTURE' AP190 02360O 23 128 '*** INVALID-NO CHECK ***' AP190 02370O T 302 LR AP190 02380O 72 'CASH REQUIREMENTS AS OF ' AP190 0002390O CURMDYY 80 AP190 02400O 132 'AP190' AP190 02410O T 2 LR AP190 02420O 30 'GROSS' AP190 02430O 63 'DISCOUNT NET' AP190 02440O 83 'CHECK NET' AP190 02450O T 2 LR AP190 0002460O 12 'PAST/CURRENT' AP190 02470O JGRS11J 35 AP190 02480O JDIS11A 51 AP190 02490O JNET11J 69 AP190 02500O TCNET J 86 AP190 02510O T 2 LR AP190 02520O 11 'DUE DAYS' AP190 0002530O FUINT 6 AP190 02540O JGRS22J 35 AP190 02550O JDIS22A 51 AP190 02560O JNET22J 69 AP190 02570O T 2 LR AP190 02580O FUINT2 11 ' &DAYS' AP190 02590O JGRS33J 35 AP190 0002600O JDIS33A 51 AP190 02610O JNET33J 69 AP190 02620O T 2 LR AP190 02630O FUINT3 11 ' &DAYS' AP190 02640O JGRS44J 35 AP190 02650O JDIS44A 51 AP190 02660O JNET44J 69 AP190 0002670O T 1 LR AP190 02680O 14 'OVER ONE MONTH' AP190 02690O JGRS55J 35 AP190 02700O JDIS55A 51 AP190 02710O JNET55J 69 AP190 02720O T 2 LR AP190 02730O 34 '--------------' AP190 0002740O 49 '------------' AP190 02750O 68 '--------------' AP190 02760O T LR AP190 02770O 14 'TOTAL PAYABLES' AP190 02780O TGRS J 35 AP190 02790O TDIS A 51 AP190 02800O TNET J 69 AP190 00** 002810ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002850** 002860ENTER AS-OF DATE 00287000/* 002880__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002850** 002860ENTER AS-OF DATE 0028700(6 >DTXAP235 P999999032778(000010H S AP235 00020X DECK-ID A08 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP235 00030F* COMPUTES THE NET CHECK AMOUNT PER VENDOR; STORES IN VENDOR FILE AP235 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP235 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP235 00060F* CONTROL DATA PROPRIETARY PRODUCT AP235 00070F* AP235 0000080F********************************************************************AP235 00090F* *AP235 00100F* COMPUSOURCE ACCOUNTS PAYABLE SYSTEM. *AP235 00110F* *AP235 00120F* AP235 COMPUTES THE NET AMOUNT OF THE CHECK (IF ANY) TO BE PAID *AP235 00130F**TO EACH VENDOR WHO HAS AN OUTSTANDING INVOICE AND/OR CREDIT MEMO.*AP235 00140F* THE NET CHECK AMOUNT IS WRITTEN IN BYTES 107-115 OF THE 'VENDOR'*AP235 0000150F* FILE. *AP235 00160F********************************************************************AP235 00170F* ID F C H L FUNCTION OF INDICATORS AP235 00180F* 01 SDNTPY AP235 00190F* 02 PAYBLS AP235 00200F* 04 VENDOR AP235 00210F* 11 NOT ON CASH REQ. AP235 0000220F* 12 PAYAMT FROM DNTPAY IS 0. DON'T PAY AP235 00230F* 21 VENDOR NOT FOUND AP235 00240F* M1-2 MATCH VENDOR-INVOICE# FOR SDNTPY AND PAYBLS AP235 00250FSDNTPY IP AF 32 DISK AP235 00260FPAYBLS IS AF 80 DISK AP235 00270FVENDOR UC F 256R 5AI 1 DISK AP235 00280ISDNTPY NS 01 AP235 0000290I 1 50PVEN L1M2 AP235 00300I 6 13 PINV M1 AP235 00310I 20 280PAYAMT 12 AP235 00320IPAYBLS NS 02 AP235 00330I 2 60PVEN L1M2 AP235 00340I 7 14 PINV M1 AP235 00350I 21 260DUEDT AP235 0000360I 27 352PGRS AP235 00370I 36 422PDIS AP235 00380I 71 71 CRQFLG 11 AP235 00390IVENDOR NS 04 AP235 00400I 1 1 X AP235 00410C START TAG AP235 00420C L1 SETOF 31 AP235 0000430C 02N11 SETON 31 AP235 00440C L1 Z-ADD0 CNET AP235 00450C 02 11 AP235 00460CORN02 GOTO DEND AP235 00470C PVEN CHAINVENDOR 21 AP235 00480C 21 GOTO DEND AP235 00490C MR PGRS SUB PAYAMT PDIS AP235 0000500C CNET ADD PGRS CNET 92 AP235 00510C CNET SUB PDIS CNET AP235 00520C DEND TAG AP235 00530CL1 31N21 Z-ADDCNET SNET 92 AP235 00540CL1 31N21 PVEN CHAINVENDOR 21 AP235 00550OVENDOR T L1N21 31 AP235 00560O SNET 115 AP235 00** 000570ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000580ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000590ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000600ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000610/* 000620__0O SNET 115 AP235 0(6M `TXAP240 P999999032778(000010H S AP240 00020X DECK-ID A09 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP240 00030F* REPORTS INVOICES DUE BY CUTOFF DATE WHICH ARE NOT TO BE PAID AP240 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP240 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP240 00060F* CONTROL DATA PROPRIETARY PRODUCT AP240 00070F* AP240 0000080F* *** *** *** *** PROGRAM DOCUMENTATION *** *** *** *** AP240 00090F********************************************************************AP240 00100F* TO CHANGE THIS PROGRAM SO, IF THE INVOICE DUE DATE IS BEFORE THE AP240 00110F* AS-OF DATE AND IF THERE IS NO MATCHING DNTPAY, THE DISCOUNT AP240 00120F* AMOUNT WILL BE SET TO ZERO IN TDYCHK, ACTIVATE STEPS 0401, 0402, AP240 00130F* 0403 AND 0608 BY REMOVING THE ASTERISKS AP240 00140F********************************************************************AP240 0000150F* ID F C H L FUNCTION OF INDICATORS AP240 00160F* 01 SDNTPY AP240 00170F* 02 PAYBLS AP240 00180F* 03 APHEAD AP240 00190F* 04 VENDOR AP240 00200F* 11 NOT ON CASH REQ. AP240 00210F* 12 PAYAMT FROM DNTPAY IS 0. DON'T PAY AP240 0000220F* 21 VENDOR NOT FOUND AP240 00230F* 23 21 OR 31 OR (MR AND 12) AP240 00240F* 31 EXPECTED CHECK NET NEGATIVE- NO CHECK. AP240 00250F* M1-3 MATCH VENDOR-INVOICE# FOR SDNTPY AND PAYBLS AP240 00260F********************************************************************AP240 00270FSDNTPY IP AF 32 DISK AP240 00280FPAYBLS IS AF 80 DISK AP240 0000290FAPHEAD ID F 128 DISK AP240 00300FVENDOR IC F 256R 5AI 1 DISK AP240 00310FPAYOUT O F 80 DISK AP240 00320FTDYCHK OC F 64R DISK AP240 00330F$LP1 O F 132 OF PRINTER AP240 00340ISDNTPY NS 01 AP240 00350I 1 5 PVEN L1M2 AP240 0000360I 6 13 PINV M1 AP240 00370I 20 282PAYAMT 12 AP240 00380IPAYBLS NS 02 AP240 00390I 1 80 ALL2 AP240 00400I 2 6 PVEN L1M2 AP240 00410I 7 14 PINV M1 AP240 00420I 1 51 FST51 AP240 0000430I 21 260DUEDT AP240 00440I 27 352PGRS AP240 00450I 36 422PDIS AP240 00460I 71 71 CRQFLG 11 AP240 00470IAPHEAD NS 03 AP240 00480I 1 40 CONAME AP240 00490I 113 1140CURY AP240 0000500I 115 1180CURMD AP240 00510I 113 1180CURDT AP240 00520IVENDOR NS 04 AP240 00530I 6 30 VNAME AP240 00540I 107 1152CNET AP240 00550C SETOF 23 AP240 00560C L1 SETOF 31 AP240 0000570C N03 READ APHEAD 99 AP240 00580C* SETOF 35 AP240 00590C* 02N11NMRDUEDT COMP CURDT 35 AP240 00600C* 35 Z-ADD0 PDIS AP240 00610C N02 GOTO DEND AP240 00620C MRN12 PGRS SUB PAYAMT PDIS AP240 00630C L1 PVEN CHAINVENDOR 21 AP240 0000640C N21 L1 CNET COMP 0 31 AP240 00650C 11 GOTO DEND AP240 00660C 21 AP240 00670COR 31 AP240 00680COR MR 12 SETON 23 AP240 00690C 23 PGRS ADD TBAL TBAL 102 PRINT TOTALS AP240 00700C N23 RRN ADD 1 RRN 50 AP240 0000710C N23 RRN CHAINTDYCHK 24 AP240 00720C DEND TAG AP240 00730CLR RRN ADD 1 RRN AP240 00740CLR RRN CHAINTDYCHK 24 AP240 00750OPAYOUT D 02 23 AP240 00760O OR 02 11 AP240 00770O ALL2 80 AP240 0000780O MRN12 PDIS 42 AP240 00790O 71 ' ' AP240 00800OTDYCHK D 02N23N11 AP240 00810O FST51 51 AP240 00820O MRN12 PDIS 42 AP240 00830O* 35 PDIS 42 AP240 00840O T LR AP240 0000850O 14 ' 9999999999999' AP240 00860O$LP1 H 202 03 AP240 00870O OR OF AP240 00880O PAGE Z 9 AP240 00890O 4 'PAGE' AP240 00900O CONAME 84 AP240 00910O UDATE Y 132 AP240 0000920O D 2 03 AP240 00930O OR OF AP240 00940O 70 'UNPAID INVOICES AS OF' AP240 00950O CURMD 77 ' / /' AP240 00960O CURY 79 AP240 00970O 132 'AP240' AP240 00980O D 1 03 AP240 0000990O OR OF AP240 01000O 37 'VENDOR' AP240 01010O 67 'INVOICE' AP240 01020O 84 'GROSS DUE' AP240 01030O 96 'MESSAGE' AP240 01040O D 10 02 23 AP240 01050O PVEN 29 AP240 0001060O N21 VNAME 56 AP240 01070O PINV 68 AP240 01080O PGRS J 86 AP240 01090O 71 ' ' AP240 01100O D 01 02 31 23 AP240 01110O 113 'CHECK NET= ' AP240 01120O CNET J 113 AP240 0001130O D 01 02 MR 12 AP240 01140O AND 23 AP240 01150O 113 'DON''T PAY INPUT ' AP240 01160O D 01 02 21 23 AP240 01170O 102 'VENDOR NOT ON' AP240 01180O 114 'VENDOR FILE' AP240 01190O T 11 LR AP240 0001200O 85 '------------' AP240 01210O T 01 LR AP240 01220O TBAL J 86 AP240 01230O 71 'TOTAL' AP240 ** 001240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00126000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001280/* 001290__0O 71 'TOTAL' AP240 ** 001240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0012600(6 TXAP250 P999999032778(000010H S AP250 00020X DECK-ID A10 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP250 00030F* PRINTS COMPUTER CHECKS; HAS ALIGNMENT FEATURE AND PERMITS RESTART AP250 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP250 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP250 00060F* CONTROL DATA PROPRIETARY PRODUCT AP250 00070F* AP250 0000080F* *** *** *** *** PROGRAM DOCUMENTATION *** *** *** *** AP250 00090F* * DONE 'X' UNNEEDED '-' * AP250 00100F* *INITIALS...DATE.....TIME....SOURCE...SOURCE...OBJECT.* AP250 00110F* *.............................DECK.....LIBR.....LIBR..* AP250 00120F* * . . . . . * AP250 00130F* * . . . . . * AP250 00140F* * . . . . . * AP250 0000150F********************************************************************AP250 00160F* COMPANY-JAS. D. EASTON, INC. CONTRACTOR-COMPUSOURCE *AP250 00170F* SYSTEM-ACCOUNTS PAYABLE PROGRAMMER-TIM MCCULLY *AP250 00180F* PROGRAM-PRINT COMPUTER CHECKS DATE-4/16/75 AP250 00190F********************************************************************AP250 00200F* DESCRIPTION- PRINT EACH INVOICE OR CREDIT MEMO AMOUNT ON THE AP250 00210F* VOUCHER AND ACCUMULATE CHECK TOTALS. IF VOUCHER MUST OVERFLOW,AP250 0000220F* VOID THE INTERVENING CHECK & CONTINUE ON NEXT VOUCHER. AP250 00230F* DURING FIRST CYCLE, THE TOP CHECK # AND VENDOR ARE ENTERED AP250 00240F* AND DISPLAYED WITH OPTION FOR RE-ENTRY. THE TOP LINE OF THE AP250 00250F* FIRST VOUCHER HAS AN 'X' IN EACH CORNER & POSITIONING MAYBE AP250 00260F* RETRIED. AP250 00270F* NOTE- IF A RESTART OR PARTIAL RE-START IS NEEDED THE VENDOR AP250 00280F* # ENTERED IS FROM THE LAST GOOD CHECK, SO BEGIN PRINTING AT AP250 0000290F* THE NEXT HIGHER VENDOR NUMBER. THE TDAYCHKS RECORD IS ALWAYS AP250 00300F* UPDATED WITH THE CHECK # PRINTED SO THE FINAL RESULT SHOULD AP250 00310F* MATCH BETWEEN TDAYCHKS AND THE PRINTED CHECKS. AP250 00320F* ID F C H L FUNCTION OF INDICATORS AP250 00330F* 03 VENDOR AP250 00340F* AP250 00350F* 10 THIS RECORD HAS NOT BEEN USED TO STORE A VOID CHECK # AP250 0000360F* 20 VARIOUS- RETRY ENTRY OR FIRST CYCLE DONE. AP250 00370F* 21 TOP CHECK IS NOT END OF PREVIOUS RUN AP250 00380F* 22 TOP CHK SAME AS END CHK LAST RUN AP250 00390F* 23 ENTERED LAST GOOD CHECK VENDOR # IS NON-ZERO AP250 00400F* 24 ENTERED NON-ZERO VENDOR NOT ON FILE AP250 00410F* 30 TDAYCHKS LAST INVOICE RECORD-A DUMMY- IS READ. AP250 00420F* 31 TDYCK VENDOR IS ALREADY OK LOOK FOR RESTART RECORD. AP250 0000430F* 32 THIS TDYCK HAS A NEW VENDOR AP250 00440F* 33 VOUCHER LINE LIMIT IS REACHED-OVERFLOW. AP250 00450F* 34 VENDOR NOT ON FILE AP250 00460F* 40 NET AMOUNT OF CHECK IS ZERO AP250 00470F* 60 O/P TOP POSITIONING LINE ON FIRST CHECK. AP250 00480F* 61 O/P VOUCHER LINE, UPDATE TDYCK CHK #. AP250 00490F* 62 O/P LAST CHECK TO BEGIN NEXT RUN WITH AP250 0000500F* 63 O/P VOUCHER TOTALS & ALL OF NORMAL CHECK AP250 00510F* 64 O/P CORRECTED CHK # TO FIRST TDYCK RECDS.OVERFLOW. AP250 00520F* 65 O/P VOID INTERVENING OVERFLOW CHECK. AP250 00530F* 66 SKIP TO TOP OF FIRST STUB AP250 00540F* U1 SUPPRESS VOID END OF JOB CHECK AP250 00550F********************************************************************AP250 00560FTDYCHK UC F 64R DISK AP250 0000570FAPHEAD IP AF 128 DISK AP250 00580FVENDOR IC F 256R 5AI 1 DISK AP250 00590F$SYSLISTO F 132 OF LPRINTER AP250 00600E CRTP 1 6 60 CRT PARAMETERS AP250 00610L$SYSLIST 42FL 38OL AP250 00620ITDYCHK NS 01 1NC AP250 00630I 1 1 PTYP AP250 0000640I 2 6 VEN AP250 00650I 7 14 INV AP250 00660I 15 200INVDT AP250 00670I 15 160INVY AP250 00680I 17 200INVMD AP250 00690I 27 352GROSS AP250 00700I 36 422DISC AP250 0000710I 44 51 PO AP250 00720I 52 560CHECK AP250 00730I 57 57 REFTP AP250 00740I 63 63 VFL 10 AP250 00750I NS 30 AP250 00760I 1 1 X AP250 00770IAPHEAD NS 02 AP250 0000780I 71 750LSTCHK AP250 00790IVENDOR NS 03 AP250 00800I 6 30 NAME AP250 00810I 31 55 AD1 AP250 00820I 56 80 AD2 AP250 00830I 81 103 AD3 AP250 00840CLR MOVE 'C' TYPE AP250 0000850CLR EXSR CRTCOM AP250 00860CLRN20 EXSR FIRST AP250 00870CLR RDTDY TAG AP250 00880CLR RRN ADD 1 RRN 50 READ TDYCHK AP250 00890CLR RRN CHAINTDYCHK 30 AP250 00900CLR 30 GOTO ENDJOB AP250 00910CLR LSTVEN COMP VEN 31 IF NOT AT RE- AP250 0000920CLRN31 CHECK COMP 0 4545 AP250 00930CLRN31N45 GOTO RDTDY AP250 00940CLRN45 GOTO START AP250 00950C* THE VENDOR# INPUT IS MORE THAN ONE OF AN INVOICE W/ NO CHECK # AP250 00960CLR MOVELCRTP,6 CRTC75 77 AP250 00970CLR MOVE CRTC75 BUFFER 72 AP250 00980CLR MOVELVEN BUFFER 72 AP250 0000990CLR Z-ADD7 MASK AP250 01000CLR Z-ADD50 BLNGTH AP250 01010CLR MOVE 'R' TYPE AP250 01020CLR EXSR CRTCOM AP250 01030CLR START TAG AP250 01040CLR PREVEN COMP VEN 3232 AP250 01050CLR 32 EXSR CHECKS GO PRINT CHECK AP250 0001060CLR GROSS ADD CGRS CGRS 92 CHECK TOTALS AP250 01070CLR DISC ADD CDIS CDIS 72 AP250 01080CLR 1 ADD CINV CINV 20 OVERFLOW TO AP250 01090CLR GROSS SUB DISC NET 92 AP250 01100CLR 12 COMP CINV 33 NEXT CHECK ? AP250 01110CLR U8 3 COMP CINV 33 AP250 01120CLR 33 EXSR OVRFLO AP250 0001130CLR SETON 6164 AP250 01140CLR EXCPT O/P VOUCHER & AP250 01150CLR SETOF 6164 UPDATE TDYCHK AP250 01160CLR GOTO RDTDY CHECK # AP250 01170CLR ENDJOB TAG AP250 01180CLR EXSR CHECKS AP250 01190CLR SETON 62LR O/P LAST VOIDEDAP250 0001200CLRNU1 EXCPT CHECK AP250 01210CLR SETOF 62 AP250 01220C****************************************************** FIRST *******AP250 01230CSR FIRST BEGSR AP250 01240CSR GETCHK TAG AP250 01250CSR Z-ADD1 CRTN 20 FIRST CHECK # AP250 01260CSR EXSR CRTMSG AP250 0001270CSR MOVELBUFFER NXTCHK 50 AP250 01280CSR LSTCHK COMP NXTCHK 202122 AP250 01290CSR 20 GOTO GETCHK NXTCHK LOW AP250 01300CSR 21 NXTCHK SUB 1 MISCHK 50 AP250 01310CSRN21 GOTO RENTER AP250 01320CSR GETVEN TAG AP250 01330CSR Z-ADD2 CRTN FIRST VENDOR #AP250 0001340CSR EXSR CRTMSG AP250 01350CSR MOVELBUFFER LSTVEN 5 AP250 01360CSR LSTVEN COMP '00000' 2323 AP250 01370CSR 23 LSTVEN CHAINVENDOR 24 AP250 01380CSR 24 GOTO GETVEN AP250 01390CSR RENTER TAG REENTER OPTION AP250 01400CSR Z-ADD5 CRTN AP250 0001410CSR EXSR GTDATE PAY DATE AP250 01420CSR MOVE GTDMD PAYMD 40 AP250 01430CSR MOVE GTDY PAYY 20 AP250 01440CSR MOVELLSTVEN TMC32 32 AP250 01450CSR 23 MOVE NAME TMC32 AP250 01460CSR MOVELNXTCHK TMC40 40 AP250 01470CSR MOVE TMC32 TMC40 AP250 0001480CSR MOVELTMC40 BUFFER AP250 01490CSR MOVE 'T' TYPE AP250 01500CSR Z-ADD40 BLNGTH AP250 01510CSR EXSR CRTCOM AP250 01520CSR Z-ADD3 CRTN CHK/VEN REPEAT AP250 01530CSR EXSR CRTMSG OR EXIT AP250 01540CSR EXSR SKIP AP250 0001550CSR RCODE COMP 'E' 2020 AP250 01560CSR 20 GOTO GETCHK AP250 01570CSR PR1ST TAG AP250 01580CSR SETON 60 FIRST LINE AP250 01590CSR EXCPT PRINT AP250 01600CSR SETOF 60 AP250 01610CSR Z-ADD4 CRTN REPEAT PRINT, AP250 0001620CSR EXSR CRTMSG OR EXIT & REPOAP250 01630CSR EXSR SKIP AP250 01640CSR RCODE COMP 'R' 2020 AP250 01650CSRN20 GOTO PR1ST AP250 01660CSR SETON 66 AP250 01670CSR EXCPT AP250 01680CSR SETOF 66 AP250 0001690CSR ENDSR AP250 01700C****************************************************** GTDATE ******AP250 01710CSR GTDATE BEGSR AP250 01720CSR GTDLOP TAG AP250 01730CSR EXSR CRTMSG AP250 01740CSR MOVELBUFFER GTDMDY 60 AP250 01750CSR MOVELBUFFER GTDA6 6 AP250 0001760CSR MOVELGTDMDY GTDB6 6 AP250 01770CSR GTDA6 COMP GTDB6 2121 AP250 01780CSR MOVELGTDMDY GTDMD 40 AP250 01790CSR MOVE GTDMDY GTDY 20 AP250 01800CSRN21 GTDMD COMP 0101 21 AP250 01810CSRN21 GTDMD COMP 1231 21 AP250 01820CSRN21 GTDY COMP 75 21 AP250 0001830CSR 21 GOTO GTDLOP AP250 01840CSR MOVELGTDY GTDYMD 60 AP250 01850CSR MOVE GTDMD GTDYMD 60 AP250 01860CSR MOVE GTDMD GTDD 20 AP250 01870CSR MOVELGTDMD GTDM 20 AP250 01880CSR ENDSR AP250 01890C****************************************************** CHECK *******AP250 0001900CSR CHECKS BEGSR AP250 01910CSR Z-ADD0 CINV AP250 01920CSR CGRS SUB CDIS CNET 92 H140 AP250 01930CSR MOVELCNET CNETD 70 *** NOTE NET SIAP250 01940CSR MOVE CNET CNETC 20 AP250 01950CSR SETON 63 O/P ACCUMULATDAP250 01960CSRN20 EXCPT CHECK AP250 0001970CSR SETOF 6320 AP250 01980CSR Z-ADD0 CGRS ZERO ACCUMS AP250 01990CSR Z-ADD0 CDIS AP250 02000CSR Z-ADDRRN VENRRN 50 SAVE 1ST RRN AP250 02010CSR VEN CHAINVENDOR 34 NEXT VENDOR AP250 02020CSR MOVE VEN PREVEN 5 AP250 02030CSR NXTCHK ADD 1 NXTCHK AP250 0002040CSR XCHECK ENDSR AP250 02050C****************************************************** OVRFLO ******AP250 02060CSR OVRFLO BEGSR AP250 02070CSR Z-ADD1 CINV AP250 02080CSR SETON 65 O/P A VOIDED AP250 02090CSR EXCPT OVERFLOW CHECKAP250 02100CSR SETOF 65 AP250 0002110CSR Z-ADDNXTCHK VOIDCK 50 VOID CK # AP250 02120CSR MOVEL'X' VOIDFL 1 AP250 02130CSR NXTCHK ADD 1 NXTCHK AP250 02140CSR Z-ADDRRN NOWRRN 50 AP250 02150CSR Z-ADDVENRRN RRN AP250 02160CSR RSTCHK TAG RESET TO NEW AP250 02170CSR RRN CHAINTDYCHK 30 CHECK # AP250 0002180CSR SETON 64 EXCPT IND. AP250 02190CSR EXCPT O/P NEW CHK # AP250 02200CSR SETOF 64 AP250 02210CSR RRN ADD 1 RRN AP250 02220CSR RRN COMP NOWRRN 25 AP250 02230CSR 25 GOTO RSTCHK AP250 02240CSR RRN CHAINTDYCHK 30 AP250 0002250CSR XOVERF ENDSR AP250 02260C********************************************************************AP250 02270C****************************************************** CRTMSG AP250 02280C* THESE SUBROUTINES COMMUNICATE WITH THE CRT VIA SUBRCM AP250 02290C*E CRTP 1 20 75 CRT PARAM & WORDSAP250 02300C* ARRAY FORMAT IS 'TAABBWW...WW', WHERE T IS TYPE, AA IS LENGTH OF AP250 02310C* LEFT JUSTIFIED MESSAGE WW...WW-70 MAX, AND BB IS USED VARIOUSLY. AP250 0002320C* 'A' TYPE O/P MESSAGE AND ACCEPT INPUT LENGTH BB RETURN IN BUFFER.AP250 02330C* 'R' TYPE O/P MESSAGE RETURN E, OR R RESPONSE IN RCODE. C CANCELS.AP250 02340C* BB-RESPONSE/ 1-C, 2-E, 3-C&E, 4-R, 5-R&C, 6-R&E, 7-R&C&E LEGAL. AP250 02350CSR CRTMSG BEGSR AP250 02360CSR Z-ADD0 CRTV99 10 SAVE 99 AP250 02370CSR 99 Z-ADD1 CRTV99 VALUE AP250 02380CSR MOVELCRTP,CRTN CRTTYP 1 AP250 0002390CSR CRTTYP COMP 'A' 99 AP250 02400CSR 99 GOTO CRTTGA AP250 02410CSR CRTTYP COMP 'R' 99 AP250 02420CSR 99 GOTO CRTTGR AP250 02430CSR GOTO XCRTMS AP250 02440CSR CRTTGA TAG ACCEPT *AP250 02450CSR MOVE 'S' TYPE AP250 0002460CSR EXSR CRTOUT AP250 02470CSR EXSR CRTCOM AP250 02480CSR MOVE CRTTYP TYPE AP250 02490CSR MOVE CRTC5 BLNGTH AP250 02500CSR EXSR CRTCOM AP250 02510CSR EXSR CRTLIN CARRIAGE RETURNAP250 02520CSR RCODE COMP 'O' 9999 AP250 0002530CSR 99 GOTO CRTTGA RE TRY AP250 02540CSR GOTO XCRTMS AP250 02550CSR CRTTGR TAG ERROR/RESPONSE*AP250 02560CSR MOVE CRTTYP TYPE AP250 02570CSR EXSR CRTOUT AP250 02580CSR MOVE CRTC5 MASK AP250 02590CSR EXSR CRTCOM AP250 0002600CSR EXSR CRTLIN AP250 02610CSR GOTO XCRTMS AP250 02620CSR XCRTMS TAG AP250 02630CSR CRTV99 COMP 0 99 AP250 02640CSR ENDSR AP250 02650C****************************************************** CRTCOM ******AP250 02660CSR CRTCOM BEGSR CALL CRTCOM AP250 0002670CSR EXITFSUBRCM AP250 02680CSR RLABL BUFFER 72 AP250 02690CSR RLABL TYPE 1 AP250 02700CSR RLABL BLNGTH 20 AP250 02710CSR RLABL RCODE 1 AP250 02720CSR RLABL MASK 10 AP250 02730CSR RLABL DTYPE 10 AP250 0002740CSR XCRTCO ENDSR AP250 02750C****************************************************** CRTOUT ******AP250 02760CSR CRTOUT BEGSR OUTPUT ARRAY AP250 02770CSR MOVELCRTP,CRTN CRTC75 77 AP250 02780CSR MOVELCRTC75 CRTC3 3 AP250 02790CSR MOVELCRTC75 CRTC5 5 AP250 02800CSR MOVE CRTC75 BUFFER AP250 0002810CSR MOVE CRTC3 BLNGTH AP250 02820CSR ENDSR AP250 02830C****************************************************** CRTLIN AP250 02840CSR CRTLIN BEGSR SPACE A LINE IFAP250 02850CSR RCODE COMP 'E' 99 NOT ALREADY AP250 02860CSRN99 RCODE COMP 'C' 99 DONE. AP250 02870CSR 99 GOTO XCRTLI AP250 0002880CSR MOVE 'T' TYPE AP250 02890CSR Z-ADD1 BLNGTH AP250 02900CSR MOVELBUFFER CRTC75 AP250 02910CSR MOVE RCODE CRTC1 1 AP250 02920CSR MOVEL' ' BUFFER AP250 02930CSR EXSR CRTCOM AP250 02940CSR MOVE CRTC1 RCODE AP250 0002950CSR MOVELCRTC75 BUFFER AP250 02960CSR XCRTLI ENDSR AP250 02970CSR SKIP BEGSR AP250 02980CSR MOVE BUFFER SAVBUF 72 AP250 02990CSR MOVEL' ' BUFFER AP250 03000CSR Z-ADD1 BLNGTH AP250 03010CSR MOVE 'T' TYPE AP250 0003020CSR EXSR CRTCOM AP250 03030CSR MOVE SAVBUF BUFFER AP250 03040CSR ENDSR AP250 03050OTDYCHK E 64 AP250 03060O 10 VOIDCK B 26 AP250 03070O NXTCHK 56 AP250 03080O PAYY 58 AP250 0003090O PAYMD 62 AP250 03100O 10 VOIDFL B 63 AP250 03110O$SYSLISTE 0 60 AP250 03120O 1 'X' AP250 03130O 70 'X' AP250 03140O E 06 66 AP250 03150O 1 ' ' AP250 0003160O E 1 61 AP250 03170O INVMD 7 ' / /' AP250 03180O INVY 9 AP250 03190O INV 19 AP250 03200O PO 29 AP250 03210O NET J 70 AP250 03220O DISC J 58 AP250 0003230O GROSS J 40 AP250 03240O E 21 65 AP250 03250O VEN 18 AP250 03260O 56 'SEE NEXT CHECK' AP250 03270O E 3406 65 AP250 03280O 36 'SEE NEXT CHECK' AP250 03290O PAYMD 44 ' / /' AP250 0003300O PAYY 46 AP250 03310O NXTCHK 53 AP250 03320O 69 '**** VOID ****' AP250 03330O E 21 63 AP250 03340O PREVEN 18 AP250 03350O CNET J 70 AP250 03360O CDIS J 58 AP250 0003370O CGRS J 40 AP250 03380O E 134 63 AP250 03390O N34 NAME 36 AP250 03400O 34 36 '*** VOID. NOT ON FILE **' AP250 03410O PAYMD 44 ' / /' AP250 03420O PAYY 46 AP250 03430O NXTCHK 53 AP250 0003440O 57 '$' AP250 03450O N40N34 CNET J 70 '*' AP250 03460O 34 70 '**** VOID ****' AP250 03470O 40 70 '**** ZERO ****' AP250 03480O E 1 63 AP250 03490O AD1 36 AP250 03500O 40 69 '******* VOID *******' AP250 0003510O E 1 63 AP250 03520O AD2 36 AP250 03530O 40 69 'DOCUMENT WRITTEN FOR' AP250 03540O E 06 63 AP250 03550O AD3 34 AP250 03560O 40 66 'APPLYING A CREDIT' AP250 03570O E 33 62 AP250 0003580O 35 'RETAIN THIS CHECK TO' AP250 03590O 50 'START NEXT RUN' AP250 03600O E 20 62 21 AP250 03610O 15 'CHECKS TO' AP250 03620O LSTCHK 12 AP250 03630O MISCHK 21 AP250 03640O 45 'MAY BE MISSING FROM RUN' AP250 0003650O PAYMD 53 ' / /' AP250 03660O PAYY 55 AP250 03670O E 33 62 AP250 03680O 36 'PUT X''S AT PPOS 1 & 70' AP250 03690O PAYMD 44 ' / /' AP250 03700O PAYY 46 AP250 03710O NXTCHK 53 AP250 0003720O 69 '**** VOID ****' AP250 03730O E 01 62 AP250 03740O 1 'X' AP250 03750O 70 'X' AP250 ** 003760ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003770ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00378000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003790ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003800** 003810A3005ENTER TOP CHECK NO 'XXXXX' - 003820A5805ENTER VENDOR FROM LAST GOOD CHECK, OR ZEROS. 'XXXXX' 003830R5406CHECK VENDOR R/REENTER, E/ENTER & CONTINUE - 003840R5707R/REPEAT PRINT, E/EXIT, C/CANCEL 00385000A3106ENTER CHECK PAY DATE MMDDYY - 003860R0000 VENDOR SKIPPED CANCEL & RESTART - 'C' 003870/* 003880__5ENTER TOP CHECK NO 'XXXXX' - 003820A5805ENTER VENDOR FROM LAST GOOD CHECK, OR ZEROS. 'XXXXX' 003830R5406CHECK VENDOR R/REENTER, E/ENTER & CONTINUE - 003840R5707R/REPEAT PRINT, E/EXIT, C/CANCEL 0038500(7{ _TXAP270 P999999032778(000010H S AP270 00020X DECK-ID A11 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP270 00030F* UPDATES FILES WITH CHECK AND SUMMARY INFORMATION AP270 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP270 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP270 00060F* CONTROL DATA PROPRIETARY PRODUCT AP270 00070F* AP270 0000080F* *** *** *** *** PROGRAM DOCUMENTATION *** *** *** *** AP270 00090F* SYSTEM-ACCOUNTS PAYABLE PROGRAMMER-TIM MCCULLY *AP270 00100F* PROGRAM- COMPUTER CHECKS UPDATE DATE-4/16/75 AP270 00110F********************************************************************AP270 00120F* DESCRIPTION- AP270 00130F* GLDOUT - UPDATE MATCHING VENDOR-INVOICE RECORDS WITH THE AP270 00140F* CHECK # USED TO PAY THE INVOICE - IF NO CHECK # ASSIGNED. AP270 0000150F* OUTCHKS-ADD A RECORD FOR THE TOTALS PER CHECK NO. AP270 00160F* APHEAD- UPDATE WITH THE LAST CHECK # RETAINED. AP270 00170F* ID F C H L FUNCTION OF INDICATORS AP270 00180F* L1NEW CHECK NUMBER - TDYCHK AP270 00190F* M1INVOICE NUMBER AP270 00200F* M2VENDOR NUMBER AP270 00210F* 01 TDAYCK - INVOICE AP270 0000220F* 03 APHEAD AP270 00230F* 02 GLDOUT AP270 00240F* APHEAD AP270 00250F* 11 CHECK NUMBER ON GLDOUT RECORD IS BLANK AP270 00260F* N12 AN OVERFLOW CHECK IS TO BE VOIDED AP270 00270F* 20 FIRST MATCH. AP270 00280F* 21 CONDITIONS 20 AP270 0000290F* 70 THERE IS A MATCH FOR THIS CHECK NO. AP270 00300F* 30 CHECK NET AT OUTCHK TIME = 0 - OUTPUT COL. 34 AS 'V'AP270 00310F* 35 READ APHEAD AP270 00320F********************************************************************AP270 00330FGLDOUT IS AF 64 DISK AP270 00340FTDYCHK IP AF 64 DISK AP270 00350FAPHEAD UD F 128 DISK AP270 0000360FGLDETL O F 64 DISK AP270 00370FOUTCHK O F 48 5AI 1 DISK A AP270 00380IGLDOUT NS 02 AP270 00390I 1 64 ALL02 AP270 00400I 3 7 GVEN M2 AP270 00410I 8 15 GINV M1 AP270 00420I 41 450GCHK 11 AP270 0000430ITDYCHK NS 01 AP270 00440I 1 1 PT AP270 00450I 2 6 TVEN M2 AP270 00460I 7 14 TINV M1 AP270 00470I 15 20 INVDT AP270 00480I 22 260VOIDCK AP270 00490I 27 352GRS AP270 0000500I 36 422DIS AP270 00510I 44 51 PO AP270 00520I 52 560CHK L1 AP270 00530I 57 620PAYDT AP270 00540I 63 63 VOIDFL 12 AP270 00550IAPHEAD NS 03 AP270 00560I 41 500APACNO AP270 0000570I 51 600CACNO AP270 00580I 61 700DTACNO AP270 00590C SETOF 2030 AP270 00600C N21 MR SETON 2021 AP270 00610C SETOF 11 AP270 00620C START TAG AP270 00630C* ********** AP270 0000640C TVEN COMP '99999' 10 AP270 00650C TVEN COMP '99999' LR AP270 00660C LR GOTO SUMEND AP270 00670C NMR GOTO SUMEND AP270 00680C MR SETON 70 AP270 00690C L1 SETOF 70 AP270 00700C L1 MOVE CHK PCHK 50 AP270 0000710C L1 MOVE PAYDT SVPDT 60 AP270 00720C 01 GRS SUB DIS NET 92 OUTCHK AP270 00730C 01 NET ADD CNET CNET 92 CALCS AP270 00740C 01 DIS ADD CDIS CDIS 72 AP270 00750C DEND TAG AP270 00760C* ********** AP270 00770C 01 SNET SUB NET SNET 92 GLDETL SUMMARY AP270 0000780C 01 SDIS SUB DIS SDIS 72 OUTPUT AP270 00790C 01 SGROSS ADD GRS SGROSS 92 AP270 00800C SUMEND TAG AP270 00810C* ********** AP270 00820CL1 CNET COMP 0 30 AP270 00830CLR PCHK ADD 1 NWCHK 50 AP270 00840CLR READ APHEAD 35 AP270 0000850OGLDETL D 02 AP270 00860O ALL02 64 AP270 00870O MR 11CHK 45 AP270 00880O T LR AP270 00890O SVPDT 21 AP270 00900O CACNO 31 AP270 00910O SNET 40 AP270 0000920O T LR AP270 00930O SVPDT 21 AP270 00940O APACNO 31 AP270 00950O SGROSS 40 AP270 00960O T LR AP270 00970O* DISCOUNT TAKEN AP270 00980O SVPDT 21 AP270 0000990O* DISC TAKEN ACCT# AP270 01000O DTACNO 31 AP270 01010O SDIS 40 AP270 01020OOUTCHK TADD N10 L1 AP270 01030O CHK 5 AP270 01040O TVEN 10 AP270 01050O CNET B 19 AP270 0001060O CDIS B 26 AP270 01070O PAYDT 32 AP270 01080O 33 'C' AP270 01090O 30 34 'V' AP270 01100O DADD 01N12 AP270 01110O VOIDCK 5 AP270 01120O TVEN 10 AP270 0001130O SVPDT 32 AP270 01140O 34 'V' AP270 01150O TADD LR AP270 01160O NWCHK 5 AP270 01170O SVPDT 32 AP270 01180O 34 'V' AP270 01190OAPHEAD T LR AP270 0001200O NWCHK 75 AP270 01210O SVPDT 112 AP270 ** 001220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00126000/* 001270__0O SVPDT 112 AP270 ** 001220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0012600(7 `TXAP320 P999999032778(000010H S AP320 00020X DECK-ID A12 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP320 00030F* REPORTS MANUALLY PAID INVOICES WITH CHECK AND INVOICE AMOUNTS AP320 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP320 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP320 00060F* CONTROL DATA PROPRIETARY PRODUCT AP320 00070F* AP320 0000080F********************************************************************AP320 00090F* AP320 00100F* CLIENT: CONTRACTOR: COMPUSOURCE AP320 00110F* AP320 00120F* SYSTEM: ACCOUNTS PAYABLE PACKAGE PROGRAMMER: I. PAUL SCHEER AP320 00130F* AP320 00140F* PROGRAM: AP320 DATE: 2/9/76 AP320 0000150F* AP320 00160F********************************************************************AP320 00170F* AP320 00180F* THIS PROGRAM PRINTS A SUMMARY OF THE MANUALLY PAID CHECKS BY AP320 00190F* VENDOR, WITH A LISTING OF THE INVOICES PAID OFF BY EACH CHECK. AP320 00200F* AP320 00210F********************************************************************AP320 0000220FPAYUPD IP AF 64 DISK AP320 00230FAPHEAD IT F 128 EDISK AP320 00240FVENDOR IC F 256R 5AI 1 DISK AP320 00250F$LP1 O F 132 OF PRINTER AP320 00260E APHEAD CONAME 1 1 40 AP320 00270IPAYUPD NS 01 1 CC AP320 00280I 2 60CHKNO L1 AP320 0000290I 7 110VENDNOL2 AP320 00300I 12 170CHDATE AP320 00310I 27 332CDIS AP320 00320I 34 422CNET AP320 00330I NS 02 1 CI AP320 00340I 2 60CHKNO L1 AP320 00350I 7 110VENDNOL2 AP320 0000360I 18 250INVNO AP320 00370I 32 402IGRS AP320 00380IVENDOR NS 03 AP320 00390I 6 30 VENAME AP320 00400C NL1 GOTO INVOIC AP320 00410C VENDNO CHAINVENDOR 80 AP320 00420C EXSR DATE AP320 0000430C CNET ADD CDIS CGRS 92 AP320 00440C LCDIS ADD CDIS LCDIS 82 AP320 00450C LIDIS ADD CDIS LIDIS 82 AP320 00460C INVOIC TAG AP320 00470C 01 GOTO END AP320 00480C IGRS SUB CDIS INET 92 AP320 00490C TNET ADD INET TNET 92 AP320 0000500C TGRS ADD IGRS TGRS 92 AP320 00510C END TAG AP320 00520CL1 LCGRS ADD CGRS LCGRS 102 AP320 00530CL1 LIGRS ADD TGRS LIGRS 102 AP320 00540CL1 LCNET ADD CNET LCNET 102 AP320 00550CL1 LINET ADD TNET LINET 102 AP320 00560CL1 TNET COMP CNET 9090 AP320 0000570C********************************************************************AP320 00580C* AP320 00590C* THIS SUBROUTINE REARRANGES THE CHECK DATE FOR OUTPUT. AP320 00600C* AP320 00610C********************************************************************AP320 00620CSR DATE BEGSR AP320 00630CSR MOVE CHDATE TEMP4 4 AP320 0000640CSR MOVELCHDATE TEMP2 2 AP320 00650CSR MOVE TEMP2 CHDATE AP320 00660CSR MOVELTEMP4 CHDATE AP320 00670CSR ENDSR AP320 00680O$LP1 H 202 1P AP320 00690O OR OF AP320 00700O 4 'PAGE' AP320 0000710O PAGE 3 8 AP320 00720O CONAME 85 AP320 00730O UDATE Y 132 AP320 00740O H 2 1P AP320 00750O OR OF AP320 00760O 75 'MANUALLY PAID INVOICES' AP320 00770O 132 'AP320' AP320 0000780O H 1 1P AP320 00790O OR OF AP320 00800O 13 'VENDOR' AP320 00810O 5 'VEN #' AP320 00820O 48 'CHECK CHECK' AP320 00830O 60 'INVOICE' AP320 00840O 78 'GROSS' AP320 0000850O 93 'DISCOUNT' AP320 00860O 104 'NET' AP320 00870O 125 'MESSAGES' AP320 00880O H 2 1P AP320 00890O OR OF AP320 00900O 58 'NO. DATE NO.' AP320 00910O 91 'PAID TAKEN' AP320 0000920O D 1 01 AP320 00930O VENDNO 5 AP320 00940O N80 VENAME 32 AP320 00950O 80 28 '** NOT ON FILE **' AP320 00960O CHKNO 39 AP320 00970O CHDATEY 49 AP320 00980O CGRS J 81 AP320 0000990O CDIS J 92 AP320 01000O CNET J 108 AP320 01010O D 1 02 AP320 01020O INVNO Z 60 AP320 01030O IGRS J 81 AP320 01040O CDIS JB 92 AP320 01050O INET J 108 AP320 0001060O T 12 L1 AP320 01070O 67 'INVOICES TOTAL' AP320 01080O TGRS JB 81 AP320 01090O TNET JB 108 AP320 01100O 90 130 'CHECK OUT OF BALANCE' AP320 01110O T 1 LR AP320 01120O 81 '-------------' AP320 0001130O 92 '--------' AP320 01140O 108 '-------------' AP320 01150O T 1 LR AP320 01160O 61 'INVOICES' AP320 01170O LIGRS J 81 AP320 01180O LIDIS J 92 AP320 01190O LINET J 108 AP320 0001200O T 1 LR AP320 01210O 59 'CHECKS' AP320 01220O LCGRS J 81 AP320 01230O LCDIS J 92 AP320 01240O LCNET J 108 AP320 ** 001250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00126000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001290/* 001300__0O LCNET J 108 AP320 ** 001250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0012600(8< vTXAP330 P999999032778(000010H S AP330 00020X DECK-ID A13 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP330 00030F* UPDATES FILES WITH MANUAL PAID INVOICE AND CHECK INFORMATION AP330 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP330 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP330 00060F* CONTROL DATA PROPRIETARY PRODUCT AP330 00070F* AP330 0000080F********************************************************************AP330 00090F* AP330 00100F* CLIENT: CONTRACTOR: COMPUSOURCE AP330 00110F* AP330 00120F* SYSTEM: ACCOUNTS PAYABLE PACKAGE PROGRAMMER: I. PAUL SCHEER AP330 00130F* AP330 00140F* PROGRAM: AP330 DATE: 2/10/76 AP330 0000150F* AP330 00160F********************************************************************AP330 00170F* AP330 00180F* THIS PROGRAM PROCESSES THE MANUALLY PAID CHECKS. THE DISTRIBUTIONAP330 00190F* TO GLDETL IS UPDATED WITH CHECK # AND DATE AND 3 SUMMARY RECORDS AP330 00200F* ARE ADDED AT THE END. A RECORD IS ADDED TO OUTCHK FOR EACH CHECK AP330 00210F* WRITTEN AND EACH MANUALLY PAID INVOICE IS REMOVED FROM PAYBLS. AP330 0000220F* A SUMMARY IS PRINTED NOTING ANY DIFFERENCE BETWEEN THE CHECK AP330 00230F* TOTALS AND THE INVOICES PAID OFF. AP330 00240F* AP330 00250F********************************************************************AP330 00260FSPYUPD IP AF 64 DISK AP330 00270FGLDOUT IS AF 64 DISK AP330 00280FPAYBLS IS AF 80 DISK AP330 0000290FGLDETL O F 64 DISK AP330 00300FOUTCHK UC F 48R 5AI 1 DISK A AP330 00310FPAYOUT O F 80 DISK AP330 00320F$LP1 O F 132 OF PRINTER AP330 00330FAPHEAD ID F 128 DISK AP330 00340ISPYUPD NS 01 1 CC AP330 00350I 2 60CHECK AP330 0000360I 7 110VENDOR M2 AP330 00370I 12 170CHDATE AP330 00380I 18 25 INVOIC M1 AP330 00390I 27 332CHDIS AP330 00400I 34 422CHNET 99 AP330 00410I NS 02 1 CI AP330 00420I 2 60CHECK AP330 0000430I 7 110VENDOR M2 AP330 00440I 18 25 INVOIC M1 AP330 00450IGLDOUT NS 03 AP330 00460I 3 70VENDOR M2 AP330 00470I 8 15 INVOIC M1 AP330 00480I 1 64 GLREC AP330 00490IPAYBLS NS 04 AP330 0000500I 2 60VENDOR M2 AP330 00510I 7 14 INVOIC M1 AP330 00520I 27 352INGRS AP330 00530I 36 422INDIS AP330 00540I 1 80 PAYREC AP330 00550IAPHEAD NS 05 AP330 00560I 1 40 CONAME AP330 0000570I 41 500APNO AP330 00580I 51 600CASHNO AP330 00590I 61 700DISNO AP330 00600IOUTCHK NS 06 AP330 00610I 48 48 XXX AP330 00620C* AAP330 00630C* SAVE DATE OF FIRST CHECK FOR GLDETL SUMMARY RECORDS *AP330 0000640C* *AP330 00650C SETOF 75 AP330 00660C N76 01 SETON 7576 AP330 00670C 75 MOVELCHDATE SVYMD 60 AP330 00680C BEGIN TAG AP330 00690C 04 GOTO TYPE04 AP330 00700C 03 GOTO TYPE03 AP330 0000710C 02 GOTO TYPE02 AP330 00720C* AP330 00730C* MANUAL CHECK RECORD AP330 00740C* AP330 00750C TYPE01 TAG AP330 00760C MCNET ADD CHNET MCNET 92 AP330 00770C MCDIS ADD CHDIS MCDIS 92 AP330 0000780C Z-SUBMCNET GLNET 92 AP330 00790C Z-SUBMCDIS GLDIS 92 AP330 00800C CHECK CHAINOUTCHK 97 AP330 00810C GOTO END AP330 00820C* AP330 00830C* INVOICE RECORD AP330 00840C* AP330 0000850C TYPE02 TAG AP330 00860C GOTO END AP330 00870C* AP330 00880C* G/L DETAIL RECORD AP330 00890C* AP330 00900C TYPE03 TAG AP330 00910C GOTO END AP330 0000920C* AP330 00930C* PAYABLES RECORD AP330 00940C* AP330 00950C TYPE04 TAG AP330 00960C MR PIGRS ADD INGRS PIGRS 92 AP330 00970C MR PIDIS ADD INDIS PIDIS 92 AP330 00980C NMR NEWGRS ADD INGRS NEWGRS 92 AP330 0000990C END TAG AP330 01000C* AP330 01010C* LAST RECORD CALCS AP330 01020C* AP330 01030CLR READ APHEAD 98 AP330 01040CLR MOVE UDATE TEMP2 2 AP330 01050CLR MOVELUDATE TEMP4 4 AP330 0001060CLR MOVE TEMP4 DATE 60 AP330 01070CLR MOVELTEMP2 DATE AP330 01080CLR MCNET ADD MCDIS MCGRS 92 AP330 01090CLR PIGRS SUB PIDIS PINET 92 AP330 01100CLR PIGRS SUB MCGRS DGRS 92 AP330 01110CLR PIDIS SUB MCDIS DDIS 92 AP330 01120CLR PINET SUB MCNET DNET 92 AP330 0001130CLR PINET SUB MCNET DNET 92 AP330 01140OGLDETL D 03 AP330 01150O GLREC 64 AP330 01160O MR CHECK 45 AP330 01170O T LR AP330 01180O SVYMD 21 AP330 01190O APNO 31 AP330 0001200O MCGRS 40 AP330 01210O T LR AP330 01220O SVYMD 21 AP330 01230O CASHNO 31 AP330 01240O GLNET 40 AP330 01250O T LR AP330 01260O SVYMD 21 AP330 0001270O DISNO 31 AP330 01280O GLDIS 40 AP330 01290OOUTCHK D 01N97 AP330 01300O VENDOR 10 AP330 01310O CHNET 19 AP330 01320O CHDIS 26 AP330 01330O CHDATE 32 AP330 0001340O 33 'M' AP330 01350O 99 34 'V' AP330 01360O DADD 01 97 AP330 01370O CHECK 5 AP330 01380O VENDOR 10 AP330 01390O CHNET 19 AP330 01400O CHDIS 26 AP330 0001410O CHDATE 32 AP330 01420O 33 'M' AP330 01430O 99 34 'V' AP330 01440OPAYOUT D 04NMR AP330 01450O PAYREC 80 AP330 01460O$LP1 T 202 LR AP330 01470O CONAME 85 AP330 0001480O UDATE Y 132 AP330 01490O T 2 LR AP330 01500O 74 'MANUAL CHECKS SUMMARY' AP330 01510O 132 'AP330' AP330 01520O T 2 LR AP330 01530O 50 'GROSS' AP330 01540O 67 'DISCOUNT' AP330 0001550O 83 'NET' AP330 01560O T 2 LR AP330 01570O 35 'TOTAL PAID INVS' AP330 01580O PIGRS 2 53 AP330 01590O PIDIS 2 69 AP330 01600O PINET 2 89 AP330 01610O T 1 LR AP330 0001620O 33 'MANUAL CHECKS' AP330 01630O MCGRS 2 53 AP330 01640O MCDIS 2 69 AP330 01650O MCNET 2 89 AP330 01660O T 1 LR AP330 01670O 53 '------------' AP330 01680O 69 '------------' AP330 0001690O 89 '------------' AP330 01700O T 2 LR AP330 01710O 30 'DIFFERENCE' AP330 01720O DGRS 2 53 AP330 01730O DDIS 2 69 AP330 01740O DNET 2 89 AP330 01750O T LR AP330 0001760O 35 'NEW TOTAL PAYABLES' AP330 01770O NEWGRS1 53 AP330 ** 001780ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001790ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001800ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001810ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00182000/* 001830__0O NEWGRS1 53 AP330 ** 001780ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001790ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001800ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001810ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0018200( 8 xTXAP350 P999999032778(000010H S AP350 00020X DECK-ID A14 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP350 00030F* PRINTS CHECK REGISTER REPORT; CONTAINS MANUAL AND COMPUTER CHECKS AP350 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP350 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP350 00060F* CONTROL DATA PROPRIETARY PRODUCT AP350 00070F* AP350 0000080F********************************************************************AP350 00090F* CLIENT: CONTRACTOR: COMPUSOURCE AP350 00100F* SYSTEM: ACCOUNTS PAYABLE PACKAGE PROGRAMMER: I. PAUL SCHEER AP350 00110F* PROGRAM: AP350 DATE: 2/9/76 AP350 00120F********************************************************************AP350 00130F* THIS PROGRAM PRINTS A REGISTER OF ALL MANUAL AND COMPUTER CHECKS AP350 00140F* PRINTED SINCE THE LAST REGISTER. THE STATUS CODE IN OUTCHK IS AP350 0000150F* UPDATED TO 'W' WHENEVER A CHECK IS PRINTED IN THE REGISTER. THE AP350 00160F* MONTH-TO-DATE FIELDS IN APHEAD ARE UPDATED AT THE END OF THE RUN.AP350 00170F* AP350 00180F* MODIFIED 03/17/77 - APHEAD NULLED IF NO CURRENT CHECKS FOUND. AP350 00190F* MODIFIED 03/24/77 - WRONG VENDOR NAME PRINTED AT TIMES. AP350 00200F********************************************************************AP350 00210F* ID F C H L FUNCTION OF INDICATORS AP350 0000220F* 99 CONDITIONS FIRST PAGE HEADINGS AP350 00230F* 98 ON AFTER FIRST CYCLE AP350 00240F* 97 MISSING CHECKS AP350 00250F* 96 NON VIODED CHECK AP350 00260F* 95 CHECK NET = 0 AP350 00270F* 94 READ APHEAD DURING FIRST CYCLE ONLY AP350 00280F* 01 COMPUTER CHECK AP350 0000290F* 02 MANUAL CHECK AP350 00300F* 03 NOT PROCESSED AP350 00310F* 04 REC. IDENT. IND. FOR APHEAD AP350 00320F* 05 REC. IDENT. IND. FOR VENDOR AP350 00330FOUTCHK UP AF 48 5AI 1 DISK AP350 00340FAPHEAD ID F 128 DISK AP350 00350FVENDOR IC F 256R 5AI 1 DISK AP350 0000360F$LP1 O F 132 OF PRINTER AP350 00370FAPTEMP O F 128 DISK AP350 00380E MSG 1 1 25 AP350 00390IOUTCHK NS 01 33 CC 35NCW AP350 00400I OR 02 33 CM 35NCW AP350 00410I OR 03 35NCW AP350 00420I OR 06 AP350 0000430I 1 50CHKNO AP350 00440I 6 100VENDNOL1 AP350 00450I 11 192NET 95 AP350 00460I 20 262DISC AP350 00470I 33 33 CODE AP350 00480I 34 34 TYPE 96 AP350 00490IAPHEAD NS 04 AP350 0000500I 1 40 CONAME AP350 00510I 76 842DTMTD AP350 00520I 85 952CCMTD AP350 00530I 96 1062MCMTD AP350 00540I 1 128 RECORD AP350 00550IVENDOR NS 05 AP350 00560I 6 30 VENAME AP350 0000570C SETOF 99 AP350 00580C L1 VENDNO CHAINVENDOR 30 AP350 00590C 30 MOVELMSG,1 VENAME AP350 00600C N94 READ APHEAD H1 AP350 00610C SETON 94 AP350 00620C H1 AP350 00630COR 06 GOTO LAST AP350 0000640C 98 GOTO CALCS AP350 00650C SETON 9998 AP350 00660C CALCS TAG AP350 00670C N99 NEXTNO COMP CHKNO 9797 AP350 00680C CHKNO ADD 1 NEXTNO 50 AP350 00690C 03 AP350 00700CORN96 GOTO LAST AP350 0000710C* AP350 00720C* COMPUTER CHECK SECTION AP350 00730C* AP350 00740C CODE1 TAG AP350 00750C N01 GOTO CODE2 AP350 00760C CNO ADD 1 CNO 40 AP350 00770C CNET ADD NET CNET 112 AP350 0000780C CDIS ADD DISC CDIS 92 AP350 00790C Z-ADDCHKNO CLAST 50 AP350 00800C GOTO LAST AP350 00810C* AP350 00820C* MANUAL CHECK SECTION AP350 00830C* AP350 00840C CODE2 TAG AP350 0000850C N02 GOTO LAST AP350 00860C MNO ADD 1 MNO 40 AP350 00870C MNET ADD NET MNET 112 AP350 00880C MDIS ADD DISC MDIS 92 AP350 00890C Z-ADDCHKNO MLAST 50 AP350 00900C* AP350 00910C* LAST RECORD CALCS AP350 0000920C* AP350 00930C LAST TAG AP350 00940C SETOF 97 AP350 00950CLRN94 READ APHEAD H1 AP350 00960CLR MNO ADD CNO NOTOT 40 AP350 00970CLR MNET ADD CNET NETTOT 112 AP350 00980CLR MDIS ADD CDIS DISTOT 92 AP350 0000990CLR MCMTD ADD MNET MCMTD AP350 01000CLR CCMTD ADD CNET CCMTD AP350 01010CLR DTMTD ADD DISTOT DTMTD AP350 01020OOUTCHK D 01 AP350 01030O OR 02 AP350 01040O OR 03 AP350 01050O 35 'W' AP350 0001060OAPTEMP T LR AP350 01070O RECORD 128 AP350 01080O DTMTD 84 AP350 01090O CCMTD 95 AP350 01100O MCMTD 106 AP350 01110O$LP1 D 202 99 AP350 01120O OR OF AP350 0001130O 4 'PAGE' AP350 01140O PAGE 4 9 AP350 01150O CONAME 70 AP350 01160O D 2 99 AP350 01170O OR OF AP350 01180O 46 'CHECK REGISTER FOR' AP350 01190O UDATE Y 55 AP350 0001200O 85 'AP350' AP350 01210O D 2 99 AP350 01220O OR OF AP350 01230O 24 'CHECK # PAYEE/VENDOR' AP350 01240O 51 'NET AMOUNT' AP350 01250O 68 'DISC TAKEN' AP350 01260O D 1 97 AP350 0001270O 36 '** MISSING NUMBER(S) **' AP350 01280O D 1 01 AP350 01290O OR 02 AP350 01300O OR 03 AP350 01310O CHKNO 6 AP350 01320O CODE 8 AP350 01330O 96 VENAME 36 AP350 0001340O N96 22 '** VOID **' AP350 01350O NET 2 52 AP350 01360O DISC 2 67 AP350 01370O 95 49 'ZERO' AP350 01380O T 104 H1 AP350 01390O 20 '** APHEAD MISSING **' AP350 01400O T 102 LR AP350 0001410O 11 'END OF JOB.' AP350 01420O 28 '# CHECKS' AP350 01430O 50 'NET AMOUNT' AP350 01440O 78 'DISCOUNT LAST' AP350 01450O T 2 LR AP350 01460O 28 'WRITTEN' AP350 01470O 48 'TOTAL' AP350 0001480O 80 'TOTAL CHECK #' AP350 01490O T 1 LR AP350 01500O 10 'MANUAL' AP350 01510O MNO 1 27 AP350 01520O MNET 1 52 AP350 01530O MDIS 1 67 AP350 01540O MLAST 79 AP350 0001550O T 1 LR AP350 01560O 10 'COMPUTER' AP350 01570O CNO 1 27 AP350 01580O CNET 1 52 AP350 01590O CDIS 1 67 AP350 01600O CLAST 79 AP350 01610O T 1 LR AP350 0001620O 27 '-----' AP350 01630O 52 '--------------' AP350 01640O 67 '------------' AP350 01650O T 2 LR AP350 01660O 10 'TOTAL' AP350 01670O NOTOT 1 27 AP350 01680O NETTOT1 52 AP350 0001690O DISTOT1 67 AP350 01700O T 2 LR AP350 01710O 58 'MONTH-TO-DATE TOTALS' AP350 01720O T 1 LR AP350 01730O 35 'MANUAL CHECKS' AP350 01740O MCMTD 1 52 AP350 01750O T 1 LR AP350 0001760O 35 'COMPUTER CHECKS' AP350 01770O CCMTD 1 52 AP350 01780O T 1 LR AP350 01790O 35 'DISCOUNTS TAKEN' AP350 01800O DTMTD 1 52 AP350 ** 001810ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00182000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001850** 001860NOT ON FILE 001870/* 001880__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0018200(69, TXAP520 P999999032778(000010H S AP520 00020X DECK-ID A15 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP520 00030F* PRINTS RECONCILED CHECK REPORT AND UPDATES FILES WITH CHECK INFO AP520 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP520 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP520 00060F* CONTROL DATA PROPRIETARY PRODUCT AP520 00070F* AP520 0000080F* AP520 00090F* MODIFIED 03/28/77 - CORRECT COLUMN HEADINGS FOR JOURNAL ENTRIES. AP520 00100F* AP520 00110F* THIS PROGRAM PRINTS THE CHECK RECONCILIATION REGISTER; RECREATES AP520 00120F* THE OUTCHK FILE WITHOUT VOIDED OR CANCELLED CHECKS; ADDS RECORDS AP520 00130F* TO PAYBLS, REMOVES THE CHECK # FROM GLDETL RECORDS AND ADDS 3 AP520 00140F* RECORDS TO GLDETL TO ADJUST THE A/P, CASH, AND DISCOUNT ACCOUNTS AP520 0000150F* AND BACKS OUT VENDOR HISTORY BY UPDATING 'VENDOR' FILE AP520 00160F* FOR VOIDED CHECKS THAT HAVE POSITIVE CHECK AMOUNTS; REMOVES GLDETLAP520 00170F*RECORDS FOR CHECKS THAT ARE CANCELLED OR HAVE ZERO AMOUNTS. AP520 00180F* AP520 00190F********************************************************************AP520 00200F* ID F C H L FUNCTION OF INDICATORS AP520 00210F* 01 RETURNED CHECK AP520 0000220F* 02 OUTSTANDING CHECK-NOT VOID AP520 00230F* 03 GL DETAIL RECORD AP520 00240F* 04 APHEAD AP520 00250F* 05 CHECK AMOUNT FOR OUTSTANDING CHECK IS POSITIVE AP520 00260F* 06 CHECK PAYS MORE THAN ONE INVOICE AND WILL HAVE A AP520 00270F* RECORD ADDED TO PAYBLS WITH THE TOTAL DISCOUNT AP520 00280F* FOR THAT VENDOR. IT IS A VOIDED CHECK. AP520 0000290F* 07 RETURNED CHECK IS VOID AND MATCHES AP520 00300F* 09 07 AND 03 AP520 00310F* 15 NOT AN INVOICE EXPENSE DISTRIBUTION AP520 00320F* L2 CHECK NO. AP520 00330F* L1 INVOICE NO. AP520 00340F* 22 MANUAL VOIDED CHECK AP520 00350F* 24 COMPUTER VOIDED CHECK AP520 0000360F* 25 EXCPT FLAG FOR 'VENDOR' FILE UPDATE. AP520 00370F* 50 APHEAD HAS BEEN READ AP520 00380F* 97 RECORD IS IN GLIN AP520 00390F* M1 CHECK NO. AP520 00400F********************************************************************AP520 00410FSRTCHK IPEAF 16 DISK AP520 00420FOUTCHK ISEAF 48 5AI 1 DISK AP520 0000430FGLDOUT ISEAF 64 DISK AP520 00440FAPHEAD ID F 128 DISK AP520 00450FVENDOR UC F 256R 5AI 1 DISK AP520 00460FGLDETL O F 64 DISK AP520 00470FNEWOUT O F 48 5AI 1 DISK AP520 00480FPAYBLS O F 80 DISK A AP520 00490F$LP1 O F 132 OF PRINTER AP520 0000500F********************************************************************AP520 00510F* AP520 00520F* RULES FOR OUTPUT TO GLDETL FOR EACH GLDOUT RECORD: AP520 00530F* AP520 00540F*'G'? N(N97) Y(97) Y(97) Y(97) Y(97) AP520 00550F*EXPENSE? N(15) Y(N15) Y(N15) Y(N15) AP520 00560F*MATCH? N(NMR) Y(MR) Y(MR) AP520 0000570F*VOID? N(N09) Y(09) AP520 00580F* KEEP DROP KEEP DROP KEEP AP520 00590F*ACTION: ON FROM ON FROM ON AP520 00600F* FILE FILE FILE FILE FILE AP520 00610E* AP520 00620E MPY 12 10 2 VENDOR HISTORY AP520 00630E* BY MONTH AP520 0000640ISRTCHK NS 01 AP520 00650I 1 50CHK L2M1 AP520 00660I 6 6 CORV AP520 00670I 7 152CAMT AP520 00680IOUTCHK NS 02 AP520 00690I 1 50CHK L2M1 AP520 00700I 6 100VEN AP520 0000710I 11 192AMT 05 AP520 00720I 20 262DIS AP520 00730I 27 280YY AP520 00740I 29 320MMDD AP520 00750I 33 33 MNCM AP520 00760I 1 48 ALL48 AP520 00770IGLDOUT NS 03 AP520 0000780I 22 310GLACCT AP520 00790I 3 7 EXPNSE 15 AP520 00800I 1 1 CORI AP520 00810I 3 70VEN AP520 00820I 8 15 INV L1 AP520 00830I 16 210PAYDT AP520 00840I 18 190M AP520 0000850I 32 402GLAMT AP520 00860I 41 450CHK L2M1 AP520 00870I 47 54 REFNO AP520 00880I 1 64 ALL64 AP520 00890I 46 46 G AP520 00900IAPHEAD NS 04 AP520 00910I 1 40 CONAME AP520 0000920I 41 500APACCT AP520 00930I 51 600CAACCT AP520 00940I 61 700DSACCT AP520 00950IVENDOR NS 10 AP520 00960I 116 235 MPY AP520 00970C 03 G COMP 'G' 97 AP520 00980C N50 READ APHEAD H1 AP520 0000990C SETON 50 APHEAD READ AP520 01000C L2 SETOF 060709 AP520 01010C L2 MR CORV COMP 'V' 07 VOIDED? AP520 01020C 07 03 SETON 09 AP520 01030C 02 MNCM COMP 'M' 222224 AP520 01040C 02 AMT ADD DIS GROSS 92 AP520 01050C FEND TAG AP520 0001060C* ********** AP520 01070C N03 AP520 01080CORN09 GOTO DEND AP520 01090C* ********** AP520 01100C L1 Z-ADD0 INVAMT 92 AP520 01110C L1 07 EXSR VUPDT AP520 01120C GLAMT ADD INVAMT INVAMT AP520 0001130C DEND TAG AP520 01140C* ********** AP520 01150CL1 07NL2 SETON 06 AP520 01160CL2 09 CAMT ADD TNET TNET 92 AP520 01170CL2 09 DIS ADD TDIS TDIS 92 AP520 01180CLR TNET ADD TDIS TAMT 92 AP520 01190CLR Z-SUBTAMT TAMTCR 92 AP520 0001200C********************************************************************AP520 01210C* BACK OUT VENDOR HISTORY ON VOIDED CHECKS. *AP520 01220CSR VUPDT BEGSR AP520 01230CSR VEN CHAINVENDOR 21 AP520 01240CSR MPY,M SUB GLAMT MPY,M AP520 01250CSR SETON 25 AP520 01260CSRN21 EXCPT AP520 0001270CSR SETOF 25 AP520 01280CSR ENDSR AP520 01290C********************************************************************AP520 01300ONEWOUT D 02 05NMR AP520 01310O ALL48 48 AP520 01320OGLDETL D 03N97 AP520 01330O OR 03N15NMR AP520 0001340O OR 03N15 09 AP520 01350O ALL64 64 AP520 01360O 09 45 ' ' AP520 01370O T LR AP520 01380O PAYDT 21 AP520 01390O APACCT 31 AP520 01400O TAMTCR 40 AP520 0001410O T LR AP520 01420O PAYDT 21 AP520 01430O CAACCT 31 AP520 01440O TNET 40 AP520 01450O T LR AP520 01460O PAYDT 21 AP520 01470O DSACCT 31 AP520 0001480O TDIS 40 AP520 01490OPAYBLS TADD L2 09 AP520 01500O 1 'I' AP520 01510O N06 CORI 1 AP520 01520O VEN 6 AP520 01530O INV 14 AP520 01540O 06 14 'TO VOIDS' AP520 0001550O PAYDT 26 AP520 01560O N06 INVAMT 35 AP520 01570O DIS 42 AP520 01580O N06 REFNO 51 AP520 01590O TADD L1 06 AP520 01600O CORI 1 AP520 01610O VEN 6 AP520 0001620O INV 14 AP520 01630O PAYDT 26 AP520 01640O INVAMT 35 AP520 01650O REFNO 51 AP520 01660OVENDOR E L1 07 25 AP520 01670O MPY 235 AP520 01680O$LP1 D 02 04 AP520 0001690O OR OF AP520 01700O PAGE Z 7 AP520 01710O 4 'PAGE' AP520 01720O CONAME 58 AP520 01730O D 04 04 AP520 01740O OR OF AP520 01750O 50 'IATION REGISTER' AP520 0001760O 35 'CHECK RECONCIL' AP520 01770O D 22 04 AP520 01780O OR OF AP520 01790O 17 'CHECK# VENDOR#' AP520 01800O 33 'CHK DATE TYPE' AP520 01810O 50 'TRANSACTION' AP520 01820O 65 'CHECK NET' AP520 0001830O 74 'DISCOUNT' AP520 01840O APACCTZ 85 AP520 01850O 91 'ACCT#' AP520 01860O DSACCTZ 102 AP520 01870O 108 'ACCT#' AP520 01880O CAACCTZ 119 AP520 01890O 125 'ACCT#' AP520 0001900O D 1 02 MR AP520 01910O CHK 8 AP520 01920O VEN Z 17 AP520 01930O YY 27 '/ ' AP520 01940O MMDD 24 '0 / ' AP520 01950O 22 37 'COMPUTER' AP520 01960O 24 35 'MANUAL' AP520 0001970O 07 45 'VOIDED' AP520 01980O N07 48 'CANCELLED' AP520 01990O N07 AMT J 63 AP520 02000O N07 DIS J 74 AP520 02010O 07 CAMT J 123 AP520 02020O 07 DIS J 106 AP520 02030O 07 GROSS J 89 AP520 0002040O 07 91 'CR' AP520 ** 002050ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002060ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002070ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002080ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002090/* 00210000__0O 07 91 'CR' AP520 ** 002050ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002060ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002070ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002080ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002090/* 0021000(9 :BTXAP530 P999999032778(000010H S AP530 00020X DECK-ID A16 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP530 00030F* PRINTS OUTSTANDING CHECKS REPORT WITH TOTALS AP530 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP530 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP530 00060F* CONTROL DATA PROPRIETARY PRODUCT AP530 00070F* AP530 0000080F* MODIFIED 03/24/77 - CHECKS NOT LISTED IN CHECK NUMBER SEQUENCE. AP530 00090FAPHEAD IPEAF 128 DISK AP530 00100FOUTCHK ISEAF 48 5AI 1 DISK AP530 00110FVENDOR IC F 256R 5AI 1 DISK AP530 00120F$SYSLISTO F 132 OF PRINTER AP530 00130IAPHEAD NS 01 AP530 00140I 1 40 CONAME AP530 0000150IOUTCHK NS 02 AP530 00160I 1 50CHK AP530 00170I 6 100VEN AP530 00180I 11 192AMT AP530 00190I 27 280CHKY AP530 00200I 29 320CHKMD AP530 00210IVENDOR NS 03 AP530 0000220I 6 30 VNAME AP530 00230C VEN CHAINVENDOR 10 AP530 00240C 02 OCHK ADD 1 OCHK 40 AP530 00250C 02 AMT ADD TAMT TAMT 102 AP530 00260O$SYSLISTH 202 01 AP530 00270O OR OF AP530 00280O PAGE Z 7 AP530 0000290O 4 'PAGE' AP530 00300O CONAME 62 AP530 00310O UDATE Y 85 AP530 00320O H 2 01 AP530 00330O OR OF AP530 00340O 51 'OUTSTANDING CHECKS' AP530 00350O 85 'AP530' AP530 0000360O H 2 01 AP530 00370O OR OF AP530 00380O 31 'CHECK # PAYEE/VENDOR' AP530 00390O 70 'AMOUNT CHECK DATE' AP530 00400O D 1 02 AP530 00410O CHK 3 16 AP530 00420O N10 VNAME 44 AP530 0000430O AMT J 59 AP530 00440O CHKMD 67 '0 / /' AP530 00450O CHKY 69 AP530 00460O T 31 LR AP530 00470O 22 'END OF JOB. THERE ARE' AP530 00480O OCHK 3 30 AP530 00490O 49 'OUTSTANDING CHECKS' AP530 0000500O 58 'TOTALING' AP530 00510O 60 '$' AP530 00520O TAMT J 76 AP530 ** 000530ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000540ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000550ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00056000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000570/* 000580__0O TAMT J 76 AP530 ** 000530ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000540ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000550ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0005600(9 hTXAP540 P999999032778(000010H S AP540 00020X DECK-ID A17 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP540 00030F* FLAGS RECORDS WHICH ARE ADDED TO GENERAL LEDGER FILE AP540 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP540 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP540 00060F* CONTROL DATA PROPRIETARY PRODUCT AP540 00070F* AP540 0000080F* MODIFIED 03/28/77 TO CORRECT FOLLOWING ERRORS: AP540 00090F* 1.- PREVIOUS MONTHS HISTORY RECORDS CAN CAUSE INVALID AP540 00100F* OUT OF BALANCE CONDITION (DATA DEPENDENT BUG). AP540 00110F* 2.- HISTORY ONLY RECORDS ARE NEVER PURGED FROM GLDETL. AP540 00120F* AP540 00130F* THIS PROGRAM ADDS RECORDS TO APGLIN FROM GLDOUT WITH U8 ON. AP540 00140F* IT SUMS THE DISTRIBUTION AMOUNTS FOR EACH VENDOR/ACCOUNT #. AP540 0000150F* DEBITS AND CREDITS ARE TOTALED AND MUST ZERO BALANCE. AP540 00160F* AP540 00170FAPHEAD IPEAF 128 DISK AP540 00180FGLDOUT ISEAF 64 DISK AP540 00190FVENDOR IC F 256R 5AI 1 DISK AP540 00200FAPGLIN O F 80 DISK A U8 AP540 00210FGLDETL O F 64 DISK AP540 0000220F$SYSLISTO F 132 OF PRINTER AP540 00230F* ID F C H L FUNCTION OF INDICATORS AP540 00240F* 01 GLDOUT RECORD THAT HAS NOT BEEN ADDED TO APGLIN AP540 00250F* 02 GLDOUT RECORD THAT HAS BEEN ADDED TO APGLIN AP540 00260F* 03 APHEAD AP540 00270F* 04 VENDOR AP540 00280F* 05 GLDOUT HISTORY RECORD AP540 0000290F* 06 GLDOUT HISTORY RECORD FOR ACCOUNTS PAYABLE ACCOUNT AP540 00300F* 07 GLDOUT HISTORY RECORD FOR CASH ACCOUNT AP540 00310F* 08 GLDOUT HISTORY RECORD FOR DISCOUNTS TAKEN ACCOUNT AP540 00320F* 09 POSITIVE TOTAL AMOUNT FOR A VENDOR FOR ONE ACCOUNT AP540 00330F* 10 NEGATIVE TOTAL AMOUNT FOR A VENDOR FOR ONE ACCOUNT AP540 00340F* 11 NO HIT VENDOR FILE. AP540 00350F* 12 OUT OF BALANCE. AP540 0000360F* 13 ANY CURRENT MONTH HISTORY ACCOUNT. AP540 00370F* 14 ANY CURRENT MONTH EXPENSE ACCOUNT. AP540 00380F* L1 VENDOR # AP540 00390F* L2 ACCOUNT # AP540 00400F* U8 ADD GLDETL RECORDS ACCRUED THIS MONTH TO APGLIN AP540 00410IGLDOUT NS 01 46NCG AP540 00420I OR 02 AP540 0000430I 2 20HORNOT 05 AP540 00440I 3 70VENDNOL1 AP540 00450I 16 170TRDY AP540 00460I 18 210TRDMD AP540 00470I 22 310ACCTNOL2 AP540 00480I 32 402AMT AP540 00490I 1 64 ALL64 AP540 0000500IAPHEAD NS 03 AP540 00510I 1 40 CONAME AP540 00520I 41 500APACCT AP540 00530I 51 600CAACCT AP540 00540I 61 700DSACCT AP540 00550IVENDOR NS 04 AP540 00560I 6 30 VENAME AP540 0000570C SETOF 060708 AP540 00580C SETOF 13 AP540 00590C L1 SETOF 14 AP540 00600C L1 VENDNO CHAINVENDOR 11 AP540 00610C 02 GOTO DEND AP540 00620C N05 GOTO NEXT AP540 00630C ACCTNO COMP APACCT 06 AP540 0000640C ACCTNO COMP CAACCT 07 AP540 00650C ACCTNO COMP DSACCT 08 AP540 00660C NEXT TAG AP540 00670C TAMT ADD AMT TAMT 92 0910 AP540 00680C 06 AP540 00690COR 07 AP540 00700COR 08 SETON 13 AP540 0000710C N13 SETON 14 AP540 00720C N13 GOTO DEND AP540 00730C MOVELTRDMD TRDMDY AP540 00740C MOVE TRDY TRDMDY AP540 00750C 09 AMT ADD DEBAMT DEBAMT AP540 00760C 10 AMT ADD CRAMT CRAMT AP540 00770C DEND TAG AP540 0000780CL1N13 MOVELTRDMD TRDMDY 60 AP540 00790CL1N13 MOVE TRDY TRDMDY AP540 00800CL1 10N13 TAMT ADD CRAMT CRAMT 92 AP540 00810CL1 09N13 TAMT ADD DEBAMT DEBAMT 92 AP540 00820CLR CRAMT ADD DEBAMT T92 92 1212 AP540 00830OGLDETL D 01N13 AP540 00840O OR 02 AP540 0000850O ALL64 64 AP540 00860O 46 'G' AP540 00870OAPGLIN TADD L1 14 AP540 00880O OR 13 AP540 00890O ACCTNO 10 AP540 00900O 12 'AP' AP540 00910O UDATE 18 AP540 0000920O N11 14 VENAME 43 AP540 00930O 06 35 'ACCOUNTS PAYABLE' AP540 00940O 06 43 'ACCOUNT' AP540 00950O 07 43 'CASH ACCOUNT' AP540 00960O 08 35 'DISCOUNTS TAKEN' AP540 00970O 08 43 'ACCOUNT' AP540 00980O VENDNO 48 AP540 0000990O TRDMDY 54 AP540 01000O TAMT 64 AP540 01010O$SYSLISTH 03 03 AP540 01020O OR OF AP540 01030O 06 'PAGE' AP540 01040O PAGE Z 10 AP540 01050O CONAME 84 AP540 0001060O 120 'AP540' AP540 01070O H 1 03 AP540 01080O OR OF AP540 01090O 66 'ACCOUNTS PAYABLE INPUT' AP540 01100O 84 'TO GENERAL LEDGER' AP540 01110O UDATE Y 77 AP540 01120O H 21 03 AP540 0001130O OR OF AP540 01140O 26 'JOURNAL ACCOUNT # TR' AP540 01150O 44 'DATE DESCRIPTION' AP540 01160O 86 'DEBIT' AP540 01170O 103 'CREDIT' AP540 01180O T 1 L1 14 AP540 01190O OR 13 AP540 0001200O 4 'AP' AP540 01210O UDATE 10 AP540 01220O ACCTNOZ 21 AP540 01230O TRDMDYY 31 AP540 01240O N11N05 VENAME 58 AP540 01250O N05 VENDNOZ 63 AP540 01260O 11 49 'VENDOR NOT FOUND' AP540 0001270O 07 56 '* * * CASH ACCOUNT * * ' AP540 01280O 07 57 '*' AP540 01290O 06 55 '* * * ACCOUNTS PAYABLE' AP540 01300O 06 69 'ACCOUNT * * *' AP540 01310O 08 54 '* * * DISCOUNTS TAKEN' AP540 01320O 08 68 'ACCOUNT * * *' AP540 01330O 09 TAMT JB 86 AP540 0001340O 10 TAMT 2B 103 AP540 01350O T 1 LR AP540 01360O 86 '-------------' AP540 01370O 103 '-------------' AP540 01380O T 1 LR AP540 01390O 17 'END OF RUN.' AP540 01400O DEBAMTJ 86 AP540 0001410O CRAMT 2 103 AP540 01420O 12 124 '* OUT OF BALANCE *' AP540 ** 001430ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001440ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001450ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001460ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00147000/* 001480__0O 12 124 '* OUT OF BALANCE *' AP540 ** 001430ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001440ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001450ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001460ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0014700(,:[ }TXAP550 P999999032778(000010H S AP550 00020X DECK-ID A18 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP550 00030F* PRINTS AGING TRIAL BALANCE REPORT FOR DUE 30, 60 AND OVER 60 DAYS AP550 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP550 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP550 00060F* CONTROL DATA PROPRIETARY PRODUCT AP550 00070F* AP550 0000080F* PROGRAM-AGEING TRIAL BALANCE AP550 00090F* DESCRIPTION- GET AGE DATE & COMPUTE INTERVAL DATES FIRST AP550 00100F* CYCLE. REPORT PAYABLES BY DUE DATE WITHIN VENDOR,& SUMMARIZE. AP550 00110F* AP550 00120F* 01- -PAYDATE OPEN PAYABLE DATA. THIS IS A REVISED AP550 00130F* 02 -VENDOR VERSION USING OVERDUE AP550 00140F* 20 FIRST CYCLE DONE RATHER THAN FUTURE AP550 0000150F* 30 VENDOR NOT FOUND DUE CATEGORIES. AP550 00160F* 31 PAST/CURRENT (50 IS NEVER SET ON.) AP550 00170F* 32 DUE ON/BEFORE 1ST INTERVAL AP550 00180F* 33 DUE ON/BEFORE 2ND INTERVAL AP550 00190F* 34 DUE AFTER 2ND INTERVAL AP550 00200F* 60 O/P PAGE HDR & VENDOR HDR. AP550 00210FAPHEAD IPEAF 128 DISK AP550 0000220FPAYOUT ISEAF 80 DISK AP550 00230FVENDOR IC F 256R 5AI 1 DISK AP550 00240F$SYSLISTO F 132 OF LPRINTER AP550 00250FCRT D F 70 CONSOLE AP550 00260F********************************************************************AP550 00270E G 4 10 2 VENDOR GRS AGED AP550 00280E TG 4 11 2 GRAND AGED GROSS AP550 0000290E CRTP 1 1 40 CRTMSG PARAMETERSAP550 00300E********************************************************************AP550 00310L$SYSLIST 66FL 55OL AP550 00320L********************************************************************AP550 00330IPAYOUT NS 01 AP550 00340I 2 60VEN L1 AP550 00350I 7 14 INV AP550 0000360I 21 220DUEY AP550 00370I 23 260DUEMD AP550 00380I 25 260DUED AP550 00390I 23 240DUEM AP550 00400I 21 260DUEDT AP550 00410I 27 352IGRS AP550 00420I 36 422IDIS AP550 0000430IVENDOR NS 02 AP550 00440I 6 30 VNAME AP550 00450IAPHEAD NS 03 AP550 00460I 1 40 CONAME AP550 00470I********************************************************************AP550 00480C N20 SETON 6061 AP550 00490C N20 EXSR FIRST AP550 0000500C L1 VEN CHAINVENDOR 30 AP550 00510C L1 SETON 61 O/P HEADER & AP550 00520C EXSR OVRFLO AP550 00530C N01 GOTO DEND AP550 00540C N50 GOTO REVISE AP550 00550C Z-ADDDUEY GTDY AP550 00560C Z-ADDDUEM GTDM AP550 0000570C EXSR AGEIT AP550 00580C DUED ADD GTDDAY DUEDAY 50 AP550 00590C SETOF 323334 AP550 00600C DUEDAY COMP AGEDT 323131 AP550 00610C 32 DUEDAY COMP F1DAY 333232 AP550 00620C 33 DUEDAY COMP F2DAY 343333 AP550 00630C REVISE TAG AP550 0000640C SETOF 515253 AP550 00650C SETOF 54 AP550 00660C EXSR OVERDU AP550 00670C 51 IGRS ADD G,1 G,1 AP550 00680C 52 IGRS ADD G,2 G,2 AP550 00690C 53 IGRS ADD G,3 G,3 AP550 00700C 54 IGRS ADD G,4 G,4 AP550 0000710C IDIS ADD VDIS VDIS 82 AP550 00720C DEND TAG AP550 00730CL1 G ADD TG TG GRAND TOTALS AP550 00740CL1 VDIS ADD GDIS GDIS 92 GRANDR DISCOUNTAP550 00750CL1 XFOOTG VGRS 102 VENDOR GROSS AP550 00760CLR XFOOTTG GGRS 112 GRAND GROSS AP550 00770CSR FIRST BEGSR AP550 0000780CSR SETON 20 AP550 00790CSR Z-ADD1 CRTN 20 AP550 00800CSR EXSR GTDATE AP550 00810CSR EXSR AGEIT AP550 00820CSR GTDD ADD GTDDAY AGEDT 50 AP550 00830CSR Z-ADD30 FUINT 20 INTERVAL AP550 00840CSR AGEDT ADD FUINT F1DAY 50 FUTURE 1 INT AP550 0000850CSR F1DAY ADD FUINT F2DAY 50 2 INT AP550 00860CSR F2DAY ADD FUINT F3DAY 50 3 INT AP550 00870CSR Z-ADDGTDMDY AGEMDY 60 AP550 00880CSR ENDSR AP550 00890C******************************************************* OVRFLO *****AP550 00900CSR OVRFLO BEGSR AP550 00910CSR OF SETON 6061 AP550 0000920CSR 61 EXCPT AP550 00930CSR SETOF 6061 AP550 00940CSR ENDSR AP550 00950C******************************************************* AGEIT ******AP550 00960CSR AGEIT BEGSR AP550 00970CSR GTDY MULT 365.25 TMN72 72H AP550 00980CSR GTDM MULT 30.5 TMN41 41H AP550 0000990CSR TMN72 ADD TMN41 GTDDAY 50H AP550 01000CSR ENDSR AP550 01010C****************************************************** GTDATE ******AP550 01020CSR GTDATE BEGSR AP550 01030CSR GTDLOP TAG AP550 01040CSR CRTP,CRTN DSPLYCRT GTDMDY 60 AP550 01050CSR MOVELGTDMDY GTDMD 40 AP550 0001060CSR MOVE GTDMDY GTDY 20 AP550 01070CSR GTDMD COMP 0101 21 AP550 01080CSRN21 GTDMD COMP 1231 21 AP550 01090CSRN21 GTDY COMP 75 21 AP550 01100CSR 21 GOTO GTDLOP AP550 01110CSR MOVELGTDY GTDYMD 60 AP550 01120CSR MOVE GTDMD GTDYMD 60 AP550 0001130CSR MOVE GTDMD GTDD 20 AP550 01140CSR MOVELGTDMD GTDM 20 AP550 01150CSR ENDSR AP550 01160C***************************************************** OVERDU********AP550 01170CSR OVERDU BEGSR THIS SR DETER- AP550 01180CSR MOVE AGEMDY AGEY 20 MINES IF INV AP550 01190CSR MOVELAGEMDY AGEM 20 IS OVERDUE & AP550 0001200CSR MOVE AGEMDY AGEDY 40 IF SO BY HOW AP550 01210CSR MOVELAGEDY AGED 20 MANY DAYS. AP550 01220CSR AGEY SUB DUEY YOVER 10 AP550 01230CSR YOVER MULT 365.4 YOVERD 51 AP550 01240CSR AGEM SUB DUEM MOVER 20 AP550 01250CSR MOVER MULT 30.5 MOVERD 41 AP550 01260CSR AGED SUB DUED DOVER 20 AP550 0001270CSR DOVER ADD MOVERD OVDUE 51 AP550 01280CSR OVDUE ADD YOVERD OVDUE AP550 01290CSR OVDUE COMP 0 5151 AP550 01300CSRN51 OVDUE COMP 30 5252 AP550 01310CSRN51N52 OVDUE COMP 60 545353 AP550 01320CSR ENDSR AP550 01330C******************************************************** END *******AP550 0001340O$SYSLISTE 202 60 AP550 01350O PAGE Z 9 AP550 01360O 4 'PAGE' AP550 01370O CONAME 85 AP550 01380O UDATE Y 132 AP550 01390O E 3 60 AP550 01400O 72 'AGEING TRIAL BALANCE FOR' AP550 0001410O AGEMDYY 81 AP550 01420O 132 'AP550' AP550 01430O E 1 61N1P AP550 01440O 6 'VENDOR' AP550 01450O VEN 4 13 AP550 01460O N30 VNAME 40 AP550 01470O 30 40 'VENDOR NOT FOUND * * * *' AP550 0001480O E 1 61N1P AP550 01490O 68 'CURRENT AND' AP550 01500O E 2 61 AP550 01510O 23 'INVOICE DUE DATE' AP550 01520O 50 'GROSS DISCOUNT' AP550 01530O 79 'FUTURE DUE OVERDUE' AP550 01540O 101 '1-30 OVERDUE 31-60' AP550 0001550O 126 'OVERDUE 61+ ' AP550 01560O E 2 50 AP550 01570O 23 'INVOICE DUE DATE' AP550 01580O 50 'GROSS DISCOUNT' AP550 01590O 79 'NET CURRENT 1 TO 30' AP550 01600O 101 'DAYS 31 TO 60 DAYS' AP550 01610O 126 ' 61 + DAYS STATUS' AP550 0001620O D 1 01 AP550 01630O INV 13 AP550 01640O DUEMD 21 '0 / /' AP550 01650O DUEY Z 23 AP550 01660O IGRS J 38 AP550 01670O IDIS B 52 AP550 01680O 51 IGRS J 69 AP550 0001690O 52 IGRS J 85 AP550 01700O 53 IGRS J 101 AP550 01710O 54 IGRS J 117 AP550 01720O T 1 L1 AP550 01730O 37 '------------' AP550 01740O 50 '---------' AP550 01750O 68 '------------' AP550 0001760O 84 '------------' AP550 01770O 100 '------------' AP550 01780O 116 '------------' AP550 01790O T 3 L1 AP550 01800O 14 'VENDOR' AP550 01810O VEN 4 20 AP550 01820O VGRS JB 38 AP550 0001830O VDIS AB 52 AP550 01840O G B 119 ' , , 0. -&&' AP550 01850O T 1 LR AP550 01860O 11 'END OF JOB.' AP550 01870O T LR AP550 01880O 20 'GRAND TOTALS' AP550 01890O GGRS J 38 AP550 0001900O GDIS A 52 AP550 01910O TG 118 ' , , 0. -&' AP550 01920O********************************************************************AP550 ** 001930ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001940ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001950ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00196000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001970** 001980ENTER AGEING DATE - 001990/* 002000__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001940ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001950ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0019600(: gUTXAP560 P999999032778(000010H S AP560 00020X DECK-ID A19 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP560 00030F* PRINTS EXPENSE DISTRIBUTION REPORT BY VENDOR-INVOICE IN ACCT NO. AP560 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP560 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP560 00060F* CONTROL DATA PROPRIETARY PRODUCT AP560 00070F* AP560 0000080F* ID F C H L FUNCTION OF INDICATORS AP560 00090F* 01 GLDETL RECORDS TO BE PRINTED AP560 00100F* 02 OTHER GLDETL RECORDS AP560 00110F* 03 CHRTAC REDCORD AP560 00120F* 04 VENDOR RECORD AP560 00130F* 05 APHEAD RECORD AP560 00140F* 30 NO HIT CHRTAC AP560 0000150F* 31 NO HIT VENDOR AP560 00160F* 22 FIRST CYCLE AP560 00170F* 21 CONDITIONS 22 AP560 00180F* 40 THERE IS AN 01 FOR THIS ACCT NO. AP560 00190F* 50 FIRST 01 FOR THIS ACCT.NO. AP560 00200F* 51 CONDITIONS 50. AP560 00210F* L1VENDOR NO. AP560 0000220F* L2CHRTAC NO9 AP560 00230F********************************************************************AP560 00240F* MODIFIED 03/25/77 - 1.ACCOUNT NO. AND NAME LINE DOES NOT PRINT AP560 00250F* AT TIMES. AP560 00260F* - 2.VENDOR HEADING DOES NOT PRINT AT TIMES. AP560 00270F* - 3.SOME INVOICES ARE LISTED MORE THAN ONCE AP560 00280F* WITH AMOUNT CORRECT ON FIRST OCCURENCE AP560 0000290F* AND ZERO ON ADDITIONAL LINES. AP560 00300FAPHEAD IPEAF 128 DISK AP560 00310FGLDOUT USEAF 64 DISK AP560 00320FCHRTAC IC F 48R10AI 1 DISK AP560 00330FVENDOR IC F 256R 5AI 1 DISK AP560 00340F$SYSLISTO F 77 OF LPRINTER AP560 00350F********************************************************************AP560 0000360L$SYSLIST 66FL 57OL AP560 00370IAPHEAD NS 05 AP560 00380I 1 40 CONAME AP560 00390IGLDOUT NS 01 46NCE 46NCG 2NC AP560 00400I* NOT REPORTED & NOT HISTORY ONLY AP560 00410I OR 02 AP560 00420I 3 70VEN L1 AP560 0000430I 8 15 INV AP560 00440I 22 310GLACT L2 AP560 00450I 32 402GAMT AP560 00460ICHRTAC NS 03 AP560 00470I 11 35 ANAME AP560 00480IVENDOR NS 04 AP560 00490I 6 30 VNAME AP560 0000500C SETOF 2250 AP560 00510C N21 SETON 2122 AP560 00520C L2 SETOF 4051 AP560 00530C L2 GLACT CHAINCHRTAC 30 AP560 00540C L1 VEN CHAINVENDOR 31 AP560 00550C N01 GOTO END AP560 00560C SETON 40 AP560 0000570C N51 SETON 5051 AP560 00580C GAMT ADD VAMT VAMT 102 AP560 00590C GAMT ADD ACAMT ACAMT 102 AP560 00600C GAMT ADD TAMT TAMT 112 AP560 00610C END TAG AP560 00620CL0 OF SETOF 51 AP560 00630OGLDOUT D 01 AP560 0000640O 46 'E' AP560 00650O$SYSLISTD 02 22 AP560 00660O OR OF AP560 00670O PAGE Z 9 AP560 00680O 4 'PAGE' AP560 00690O CONAME 61 AP560 00700O UDATE Y 77 AP560 0000710O D 304 22 AP560 00720O OR OF AP560 00730O 51 'EXPENSE DISTRIBUTION' AP560 00740O 77 'AP560' AP560 00750O D 2 50 AP560 00760O 4 'ACCT' AP560 00770O GLACT 19 '0 - - ' AP560 0000780O N30 ANAME 45 AP560 00790O D 2 50 AP560 00800O 17 'VENDOR/PAYEE' AP560 00810O 57 'INVOICE # AMOUNT' AP560 00820O D 1 01 AP560 00830O N31 VNAME 30 AP560 00840O 31 30 'VENDOR NOT FOUND * * * *' AP560 0000850O INV 42 AP560 00860O GAMT JB 60 AP560 00870O T 1 L2 40 AP560 00880O 58 '------------' AP560 00890O T 2 L2 40 AP560 00900O 24 'ACCOUNT' AP560 00910O GLACT 38 '0 - - ' AP560 0000920O 44 'TOTAL' AP560 00930O ACAMT JB 60 AP560 00940O T 1 LR AP560 00950O 11 'END OF JOB.' AP560 00960O 43 'GRAND TOTAL' AP560 00970O TAMT J 60 AP560 ** 00098000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000990ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001010ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001020/* 001030__0O TAMT J 60 AP560 ** 0009800(A;/ TXAP580 P999999032778(000010H S AP580 00020X DECK-ID A20 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP580 00030F* PRINTS VENDOR ANALYSIS REPORT FOR GROSS DOLLARS SPENT IN LAST YR. AP580 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP580 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP580 00060F* CONTROL DATA PROPRIETARY PRODUCT AP580 00070F* AP580 0000080F********************************************************************AP580 00090F* *AP580 00100F* PACKAGE- ACCOUNTS PAYABLE CONTRACTOR- COMPUSOURCE *AP580 00110F* SYSTEM- PROGRAMMER- T. MCCULLY *AP580 00120F* PROGRAM- VENDOR PAYABLES ANALYSIS DATE- 5/05/76 *AP580 00130F* *AP580 00140F* DESCRIPTION- INVOICE NET IS ACCUMULATED IN A BUCKET BASED ON *AP580 0000150F* INVOICE DATE MONTH. THIS PGM REPORTS SAME & ZEROES NEXT *AP580 00160F* MONTH'S BUCKET IF U2 IS ON. *AP580 00170F* *AP580 00180F********************************************************************AP580 00190F* ID F C H L FUNCTION OF INDICATORS AP580 00200F* 01 VENDOR RECORD AP580 00210F* 02 APHEAD RECORD AP580 0000220F* 20 FIRST CYCLE USAGE. ON WHEN DONE. AP580 00230F*NU2 REPORT ONLY AP580 00240F* U2 REPORT AND ZERO M-T-D FIELDS & NEXT MONTH'S BUCKET. AP580 00250F********************************************************************AP580 00260FVENDOR USEAF 256 5AI 1 DISK AP580 00270FAPHEAD UPEAF 128 DISK AP580 00280F$LP1 O F 132 OF PRINTER AP580 0000290F********************************************************************AP580 00300E MP 12 10 2 MONTH'S PAYABLE AP580 00310E MN 12 12 6 MONTH/YR NAME AP580 00320E DL 1 1 2 0 DM 30 DATE MGLN & MESG.AP580 00330E MX 12 10 2 NEXT MP W/ZERO'D AP580 00340E** NEXT MONTH AMT.AP580 00350E GP 12 11 2 ALL TOTAL PAYABLEAP580 0000360E********************************************************************AP580 00370IVENDOR NS 01 AP580 00380I 1 5 VENNO AP580 00390I 6 30 NAME AP580 00400I 116 235 MP AP580 00410IAPHEAD NS 02 AP580 00420I 1 40 CONAME AP580 0000430C********************************************************************AP580 00440C 20 GOTO TALL IF FIRST CYCLE AP580 00450C Z-ADD0 BLNGTH 20 AP580 00460C MOVELBUFFER BUFFER 72 AP580 00470C MOVELMASK MASK 10 AP580 00480C MOVELRCODE RCODE 1 AP580 00490C Z-ADD0 RTNLVL 10 AP580 0000500C Z-ADD0 TERMNL 10 AP580 00510C MOVELTYPE TYPE 1 AP580 00520C Z-ADD0 NCHARS 30 AP580 00530C Z-ADD0 SSTRT 30 AP580 00540C Z-ADD0 TSTRT 30 AP580 00550C Z-ADD0 M 20 MONTH INDEX AP580 00560C Z-ADD0 MTH 20 THIS MONTH AP580 0000570C Z-ADD0 MNX 20 NEXT MONTH AP580 00580C Z-ADD0 YTH 20 THIS YEAR AP580 00590C MOVE ' ' BLNK31 31 M-T-D ZEROER AP580 00600C Z-ADD1 C1 10 AP580 00610C Z-ADDC1 TERMNL AP580 00620C Z-ADDC1 RTNLVL AP580 00630C***** AP580 0000640C TDATE TAG GET MONTHEND AP580 00650C Z-ADDDL,1 BLNGTH AP580 00660C MOVEL'S' TYPE AP580 00670C MOVELDM,1 BUFFER AP580 00680C EXITFSUBRCM AP580 00690C RLABL BUFFER 72 AP580 00700C RLABL TYPE 1 AP580 0000710C RLABL BLNGTH 20 AP580 00720C RLABL RCODE 1 AP580 00730C RLABL MASK 10 AP580 00740C RLABL DTYPE 10 AP580 00750C Z-ADD7 BLNGTH AP580 00760C MOVEL'A' TYPE AP580 00770C EXITFSUBRCM AP580 0000780C RLABL BUFFER 72 AP580 00790C RLABL TYPE 1 AP580 00800C RLABL BLNGTH 20 AP580 00810C RLABL RCODE 1 AP580 00820C RLABL MASK 10 AP580 00830C RLABL DTYPE 10 AP580 00840C MOVELBUFFER TAG 6 AP580 0000850C MOVELTAG TA4 4 AP580 00860C TA4 COMP '0101' 20 AP580 00870C N20 TA4 COMP '1231' 20 AP580 00880C MOVE TAG TA2 2 AP580 00890C N20 TA2 COMP '70' 20 AP580 00900C N20 TA2 COMP '99' 20 AP580 00910C 20 GOTO TDATE AP580 0000920C MOVELTAG MTH AP580 00930C MTH ADD C1 MNX AP580 00940C MNX COMP 12 20 AP580 00950C 20 Z-ADDC1 MNX AP580 00960C Z-ADDC1 M AP580 00970C MOVE TAG YTH AP580 00980C Z-ADDYTH TN2 20 AP580 0000990C MOVELTAG DATE 60 AP580 01000C TSETYR TAG SET HEADING YRSAP580 01010C M COMP MNX 20 FOR NEXT MONTHAP580 01020C 20 MNX COMP C1 2020 & NOT YEAR ENDAP580 01030C 20 YTH SUB C1 TN2 - USE LAST YR AP580 01040C MOVE TN2 MN,M SET HEADING YR AP580 01050C M ADD C1 M AP580 0001060C M COMP 12 20 AP580 01070C N20 GOTO TSETYR AP580 01080C Z-ADD120 NCHARS SETUP ARRAY AP580 01090C Z-ADDC1 SSTRT UPDATE AP580 01100C Z-ADDC1 TSTRT AP580 01110C SETON 20 AP580 01120C***** AP580 0001130C TALL TAG DO ALL CYCLES AP580 01140C XFOOTMP VENTOT 112 VENDOR 12 MO. AP580 01150C MP ADD GP GP GRAND MONTH TOTAP580 01160C NU2 GOTO DEND IF UPDATE OFF AP580 01170C EXIT SUBRMV AP580 01180C RLABL MP COPY OLD AMTS.AP580 01190C RLABL SSTRT 30 AP580 0001200C RLABL MX AP580 01210C RLABL TSTRT 30 AP580 01220C RLABL NCHARS 30 AP580 01230C Z-ADD0 MX,MNX ZERO NEXT MONTHAP580 01240C DEND TAG BUCKET AP580 01250CLR TLR TAG AP580 01260CLR XFOOTGP GRNTOT 112 AP580 0001270C********************************************************************AP580 01280OVENDOR D 01 U2 AP580 01290O MX 235 AP580 01300OAPHEAD D 02 U2 AP580 01310O BLNK31 106 AP580 01320O$LP1 D 202 02 AP580 01330O OR OF AP580 0001340O PAGE Z 11 AP580 01350O 6 'PAGE' AP580 01360O CONAME 82 AP580 01370O UDATE Y 128 AP580 01380O D 2 02 AP580 01390O OR OF AP580 01400O 56 'MONTHLY VENDOR' AP580 0001410O 77 'PAYABLES SUMMARY FOR' AP580 01420O DATE Y 86 AP580 01430O 125 'AP580' AP580 01440O NU2 49 ' REPORT' AP580 01450O D 1 02 AP580 01460O OR OF AP580 01470O 13 'VENDOR' AP580 0001480O MN,1 46 AP580 01490O MN,2 62 AP580 01500O MN,3 78 AP580 01510O MN,4 94 AP580 01520O MN,5 110 AP580 01530O MN,6 126 AP580 01540O D 2 02 AP580 0001550O OR OF AP580 01560O MN,7 46 AP580 01570O MN,8 62 AP580 01580O MN,9 78 AP580 01590O MN,10 94 AP580 01600O MN,11 110 AP580 01610O MN,12 126 AP580 0001620O D 1 01 AP580 01630O VENNO 5 AP580 01640O NAME 32 AP580 01650O MP,1 J 49 AP580 01660O MP,2 J 65 AP580 01670O MP,3 J 81 AP580 01680O MP,4 J 97 AP580 0001690O MP,5 J 113 AP580 01700O MP,6 J 129 AP580 01710O D 2 01 AP580 01720O 17 'LAST 12 MOS:' AP580 01730O VENTOTJ 32 AP580 01740O MP,7 J 49 AP580 01750O MP,8 J 65 AP580 0001760O MP,9 J 81 AP580 01770O MP,10 J 97 AP580 01780O MP,11 J 113 AP580 01790O MP,12 J 129 AP580 01800O T 32 LR AP580 01810O 22 'ALL VENDOR TOTALS' AP580 01820O MN,1 46 AP580 0001830O MN,2 62 AP580 01840O MN,3 78 AP580 01850O MN,4 94 AP580 01860O MN,5 110 AP580 01870O MN,6 126 AP580 01880O T 2 LR AP580 01890O GP,1 J 49 AP580 0001900O GP,2 J 65 AP580 01910O GP,3 J 81 AP580 01920O GP,4 J 97 AP580 01930O GP,5 J 113 AP580 01940O GP,6 J 129 AP580 01950O T 1 LR AP580 01960O MN,7 46 AP580 0001970O MN,8 62 AP580 01980O MN,9 78 AP580 01990O MN,10 94 AP580 02000O MN,11 110 AP580 02010O MN,12 126 AP580 02020O T 2 LR AP580 02030O 16 'LAST 12 MONTHS:' AP580 0002040O GRNTOTJ 32 AP580 02050O GP,7 J 49 AP580 02060O GP,8 J 65 AP580 02070O GP,9 J 81 AP580 02080O GP,10 J 97 AP580 02090O GP,11 J 113 AP580 02100O GP,12 J 129 AP580 0002110O********************************************************************AP580 ** 002120ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002160** 00217000JAN/ FEB/ MAR/ APR/ MAY/ JUN/ JUL/ AUG/ SEP/ OCT/ NOV/ DEC/ 002180** 00219026ENTER MONTH END (MMDDYY)- 002200/* 002210__EQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002160** 0021700(; -=TXAP590 P999999032778(000010H S AP590 00020X DECK-ID A21 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP590 00030F* LISTS VENDORS BY NUMBER WITH THEIR NAME AND ADDRESS AP590 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP590 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP590 00060F* CONTROL DATA PROPRIETARY PRODUCT AP590 00070F* AP590 0000080FAPHEAD IP AF 128 DISK AP590 00090FVENDOR IS AF 256 5AI 1 DISK AP590 00100F$LP1 O F 132 OF PRINTER AP590 00110F* VENDOR ADDRESSES APRIL 30, 1975 AP590 00120F* SYSTEM: ACCOUNTS PAYABLE *PROGRAMMER-DAVID LISCHINSKY AP590 00130IAPHEAD NS 02 AP590 00140I 1 40 CONAME AP590 0000150IVENDOR NS 01 AP590 00160I 1 5 VEN AP590 00170I 6 30 NAME AP590 00180I 31 55 ADRL1 AP590 00190I 56 80 ADRL2 AP590 00200I 81 103 ADRL3 AP590 00210C SETOF 75 AP590 0000220C N76 SETON 7576 AP590 00230O$LP1 D 202 OF AP590 00240O OR 75 AP590 00250O 6 'PAGE' AP590 00260O PAGE Z 11 AP590 00270O CONAME 85 AP590 00280O UDATE Y 128 AP590 0000290O D 3 OF AP590 00300O OR 75 AP590 00310O 65 'V E N D O R' AP590 00320O 81 'A D D R E S S' AP590 00330O 125 'AP590' AP590 00340O D 2 01 AP590 00350O VEN 5 AP590 0000360O NAME 32 AP590 00370O ADRL1 65 AP590 00380O ADRL2 95 AP590 00390O ADRL3 125 AP590 ** 000400ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000410ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00042000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000430ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000440/* 000450__0O ADRL3 125 AP590 ** 000400ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000410ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0004200(; $9TXAP595 P999999032778(000010H S AP595 00020X DECK-ID A22 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP595 00030F* PRINTS GENERAL LEDGER EXPENSE ACCOUNTS BY ACCOUNT NUMBER AP595 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP595 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP595 00060F* CONTROL DATA PROPRIETARY PRODUCT AP595 00070F* AP595 0000080FAPHEAD IP AF 128 DISK AP595 00090FCHRTAC IS AF 48 10AI 1 DISK AP595 00100F$LP1 O F 85 OF PRINTER AP595 00110F* CHRTAC ACCOUNT NAMES MAY 5,1976 AP595 00120F* SYSTEM: ACCOUNTS PAYABLE *PROGRAMMER-TIM MCCULLY AP595 00130IAPHEAD NS 02 AP595 00140I 1 40 CONAME AP595 0000150ICHRTAC NS 01 AP595 00160I 1 10 ACCT AP595 00170I 11 35 NAME AP595 00180O$LP1 H 202 OF AP595 00190O OR 02 AP595 00200O 6 'PAGE' AP595 00210O PAGE Z 11 AP595 0000220O CONAME 64 AP595 00230O UDATE Y 84 AP595 00240O H 3 OF AP595 00250O OR 02 AP595 00260O 51 'CHART OF ACCOUNTS' AP595 00270O 84 'AP595' AP595 00280O D 2 01 AP595 0000290O ACCT 10 AP595 00300O NAME 40 AP595 ** 000310ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000320ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000330ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000340ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00035000/* 000360__0O NAME 40 AP595 ** 000310ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000320ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000330ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000340ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0003500(<. DTXAP601 P999999032778(000010H S AP601 00020X DECK-ID A23 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP601 00030F* INQUIRY/MAINTENANCE OF VENDOR MASTER FILE (VENDOR) AP601 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0AP601 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP601 00060F* CONTROL DATA PROPRIETARY PRODUCT AP601 00070F* AP601 0000080FNULL IPEAF 72 DISK AP601 00090FAP601P IC F 32R DISK AP601 00100FVENDOR UC F 0256R05AI 0001 DISK A AP601 00110E FN 025 22 FIELD NAME AP601 00120E CP 025 4 CURSOR POSITION AP601 00130E LN 025 2 0 LENGTH AP601 00140E EP 025 4 0 ENDING POSITION AP601 0000150INULL NS 01 AP601 00160I 1 1 A AP601 00170IAP601P NS 02 AP601 00180I 1 22 FIELDN AP601 00190I 23 26 CURPOS AP601 00200I 27 280LNGTH AP601 00210I 29 310ENDPOS AP601 0000220IVENDOR NS 03 AP601 00230I 10256 RECORD AP601 00240C MOVE ' ' RCODE 1 AP601 00250C MOVE RCODE B22 22 AP601 00260C MOVE RCODE BLANKS 72 AP601 00270C MOVE RCODE FILLER 1 AP601 00280C Z-ADD0 MASK 10 AP601 0000290C SETON LR AP601 00300CLR Z-ADD025 SSIZE 30 AP601 00310CLR Z-ADD003 NSECT 30 AP601 00320CLR MOVEL'D' FF 1 AP601 00330CLR MOVE '[]<>' TEMP4 4 AP601 00340CLR START TAG AP601 00350C* ********** AP601 0000360CLR EXSR FIRSTP AP601 00370C* ********** AP601 00380CLR EXSR CLRSCR AP601 00390C* ********** AP601 00400CLR 40 GOTO EOJ AP601 00410C* ********** AP601 00420CLR Z-ADD2 VL AP601 0000430CLR MOVELSECTON VAR AP601 00440CLR EXSR RTADJ AP601 00450C* ********** AP601 00460CLR MOVELVAR SECTN 20 AP601 00470CLR EXSR GETSEC AP601 00480C* ********** AP601 00490CLRN45 GOTO START AP601 0000500C* ********** AP601 00510CLR EXSR CLRSCR AP601 00520C* ********** AP601 00530CLR EXSR OUTPUT AP601 00540C* ********** AP601 00550CLR EXSR UPDATE AP601 00560C* ********** AP601 0000570CLR GOTO START AP601 00580C* ********** AP601 00590CLR EOJ TAG AP601 00600C* ********** AP601 00610C********************************************************************AP601 00620C* AP601 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND AP601 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. AP601 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDAP601 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN AP601 00670C* AP601 00680C********************************************************************AP601 00690CSR FIRSTP BEGSR AP601 00700C* ********** AP601 0000710CSR EXSR CLRSCR AP601 00720C* ********** AP601 00730CSR Z-ADD0 SECTN AP601 00740CSR EXSR GETSEC AP601 00750C* ********** AP601 00760CSR PGE TAG AP601 00770C* ********** AP601 0000780CSR SETON 61 AP601 00790CSR SETOF 62 AP601 00800CSR EXSR OUTPUT AP601 00810C* ********** AP601 00820C* ********** AP601 00830CSR EXIT SUBRFL AP601 00840CSR RLABL RECORD AP601 0000850CSR RLABL FILLER 1 AP601 00860C* ********** AP601 00870C* ********** AP601 00880C* ********** AP601 00890C* ********** AP601 00900C* ********** AP601 00910C* ********** AP601 0000920C* ********** AP601 00930C* ********** AP601 00940C* ********** AP601 00950C* ********** AP601 00960C* ********** AP601 00970C* ********** AP601 00980C* ********** AP601 0000990C* ********** AP601 01000C* ********** AP601 01010CSR Z-ADD05 NCHARS AP601 01020CSR Z-ADD1 SSTRT AP601 01030CSR Z-ADD1 TSTRT AP601 01040C* ********** AP601 01050CSR EXIT SUBRLM AP601 0001060CSR RLABL KEY 05 AP601 01070CSR RLABL SSTRT 30 AP601 01080CSR RLABL RECORD AP601 01090CSR RLABL TSTRT 30 AP601 01100CSR RLABL NCHARS 30 AP601 01110CSR Z-ADDNOFLDS SVFLDS 30 AP601 01120CSR Z-ADDSX NOFLDS AP601 0001130CSR EXSR UPDATE AP601 01140C* ********** AP601 01150CSR Z-ADDSVFLDS NOFLDS AP601 01160CSR Z-ADD05 NCHARS AP601 01170CSR Z-ADD1 SSTRT AP601 01180CSR Z-ADD1 TSTRT AP601 01190C* ********** AP601 0001200CSR EXIT SUBRLM AP601 01210CSR RLABL RECORD AP601 01220CSR RLABL SSTRT 30 AP601 01230CSR RLABL KEY AP601 01240CSR RLABL TSTRT 30 AP601 01250CSR RLABL NCHARS 30 AP601 01260CSR KEY CHAINVENDOR 55 AP601 0001270CSR MOVELSAVPOS BUFFER AP601 01280CSR MOVELOFC BUFFER AP601 01290CSR EXSR POSCUR AP601 01300C* ********** AP601 01310CSR MOVEL'] NEW R'WORD16 16 AP601 01320CSR MOVE 'ECORD 'WORD16 AP601 01330CSRN55 MOVELBLANKS WORD16 AP601 0001340CSRN55 MOVEL']' WORD16 AP601 01350CSR MOVELWORD16 BUFFER 72 AP601 01360CSR MOVE 'T' TYPE 1 AP601 01370CSR Z-ADD13 BLNGTH 20 AP601 01380CSR EXSR CRTCOM AP601 01390C* ********** AP601 01400CSR SETON 62 AP601 0001410CSR Z-ADDSX X 30 AP601 01420CSR EXSR ACCEPT AP601 01430C* ********** AP601 01440CSR MOVELBUFFER SECTON 2 AP601 01450CSR SECTON COMP 'E ' 40 AP601 01460CSR 40 GOTO ENDFP AP601 01470C* ********** AP601 0001480CSR SECTON COMP 'D ' 40 AP601 01490CSR 40N55 EXCPT AP601 01500CSR 40 GOTO PGE AP601 01510C* ********** AP601 01520CSR SECTON COMP ' 1' 30 30 AP601 01530CSR 30 SECTON COMP ' 9' 3030 AP601 01540CSR 30 GOTO GOOD AP601 0001550C* ********** AP601 01560CSR SECTON COMP '01' 30 30 AP601 01570CSR 30 SECTON COMP '09' 3030 AP601 01580CSR 30 GOTO GOOD AP601 01590C* ********** AP601 01600CSR SECTON COMP '1 ' 30 30 AP601 01610CSR 30 SECTON COMP '9 ' 3030 AP601 0001620CSR 30 GOTO GOOD AP601 01630C* ********** AP601 01640CSR MOVELSECTON TEMP1 1 AP601 01650CSR TEMP1 COMP '1' 30 30 AP601 01660CSR 30 TEMP1 COMP '9' 3030 AP601 01670CSRN30 GOTO PGE AP601 01680C* ********** AP601 0001690CSR MOVE SECTON TEMP1 AP601 01700CSR TEMP1 COMP '0' 30 30 AP601 01710CSR 30 TEMP1 COMP '9' 3030 AP601 01720CSRN30 GOTO PGE AP601 01730C* ********** AP601 01740CSR GOOD TAG AP601 01750C* ********** AP601 0001760CSR SETOF 6162 AP601 01770CSRN55 GOTO ENDFP AP601 01780C* ********** AP601 01790CSR SETON 80 AP601 01800CSR EXCPT AP601 01810CSR SETOF 80 AP601 01820CSR KEY CHAINVENDOR 55 AP601 0001830CSR ENDFP ENDSR AP601 01840C* ********** AP601 01850C********************************************************************AP601 01860C* AP601 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. AP601 01880C* AP601 01890C********************************************************************AP601 0001900CSR GETSEC BEGSR AP601 01910C* ********** AP601 01920CSR 1 ADD SECTN N 20 AP601 01930CSR SETOF 404145 AP601 01940CSR N COMP 0 3030 AP601 01950CSRN30 N COMP NSECT 30 AP601 01960CSR 30 GOTO ENDGET AP601 0001970C* ********** AP601 01980CSR SECTN MULT SSIZE RRN 40 AP601 01990CSR Z-ADD1 X AP601 02000CSR SCLOOP TAG AP601 02010C* ********** AP601 02020CSR RRN ADD 1 RRN AP601 02030CSR RRN CHAINAP601P 50 AP601 0002040CSR 50 GOTO ENDGET AP601 02050C* ********** AP601 02060CSR FIELDN COMP B22 4141 AP601 02070CSRN41 GOTO ENDGET AP601 02080C* ********** AP601 02090CSR 41N45 SETON 45 AP601 02100CSR MOVE FIELDN FN,X AP601 0002110CSR MOVE CURPOS CP,X AP601 02120CSR MOVE LNGTH LN,X AP601 02130CSR Z-ADDENDPOS EP,X AP601 02140CSR 1 ADD X X AP601 02150CSR X COMP SSIZE 32 AP601 02160CSRN32 GOTO SCLOOP AP601 02170C* ********** AP601 0002180CSR ENDGET TAG AP601 02190C* ********** AP601 02200CSR Z-ADDX NOFLDS 30 AP601 02210CSR 45 GOTO FINGET AP601 02220C* ********** AP601 02230CSR EXSR CLRSCR AP601 02240C* ********** AP601 0002250CSR MOVEL'SECT # 'WORD9 9 AP601 02260CSR Z-ADD16 BLNGTH AP601 02270CSR MOVE SECTN WORD9 AP601 02280CSR MOVELWORD9 WORD16 AP601 02290CSRN30 MOVE ' ABSENT' WORD16 AP601 02300CSR 30 MOVE ' ILLEG.' WORD16 AP601 02310CSR MOVELWORD16 BUFFER AP601 0002320CSR MOVEL'T' TYPE AP601 02330CSR EXSR CRTCOM AP601 02340C* ********** AP601 02350CSR FINGET ENDSR AP601 02360C* ********** AP601 02370C********************************************************************AP601 02380C* AP601 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE AP601 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE AP601 02410C* SECTION INDEX IS SAVED. AP601 02420C* AP601 02430C********************************************************************AP601 02440CSR OUTPUT BEGSR AP601 02450C* ********** AP601 0002460CSR EXSR CLRSCR AP601 02470C* ********** AP601 02480CSR Z-ADD1 X AP601 02490CSR 61 SETON 63 AP601 02500CSR OTLOOP TAG AP601 02510C* ********** AP601 02520CSR 61 LN,X COMP 0 31 AP601 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXAP601 02540CSR EXSR OUTFLD AP601 02550C* ********** AP601 02560CSR X ADD 1 X AP601 02570CSR X COMP NOFLDS 31 AP601 02580CSR 31 GOTO OTLOOP AP601 02590C* ********** AP601 0002600CSR SETOF 63 AP601 02610CSR ENDSR AP601 02620C********************************************************************AP601 02630C* AP601 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND AP601 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 AP601 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS AP601 0002670C* THEN NO FIELD INFORMATION IS PRINTED AP601 02680C* AP601 02690C********************************************************************AP601 02700CSR OUTFLD BEGSR AP601 02710C* ********** AP601 02720CSR MOVE FN,X FL 20 AP601 02730CSR EP,X COMP 0 98 AP601 0002740CSR MOVELCP,X FC 20 AP601 02750CSR FC COMP FL 31 AP601 02760CSR 31 Z-ADDFC FL AP601 02770CSR FC SUB FL CC 20 AP601 02780CSR CC ADD 1 CC AP601 02790CSR MOVELCP,X BUFFER AP601 02800CSR MOVELCC BUFFER AP601 0002810CSR EXSR POSCUR AP601 02820C* ********** AP601 02830CSR MOVELBLANKS BUFFER AP601 02840CSR MOVELFN,X FIELDN AP601 02850CSR MOVE ' ' FIELDN AP601 02860CSR MOVELFIELDN BUFFER AP601 02870CSR Z-ADDLN,X LEN 20 AP601 0002880CSR LEN COMP 0 9730 AP601 02890CSR 97 Z-SUBLN,X LEN AP601 02900CSR 30 GOTO SKIPF AP601 02910C* ********** AP601 02920CSR FL ADD 2 BPOS 20 AP601 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS AP601 02940CSR Z-ADDBPOS TSTRT 30 AP601 0002950CSRN98 Z-ADD1 SSTRT 30 AP601 02960CSR 98 Z-ADD3 SSTRT AP601 02970CSR Z-ADD1 NCHARS 30 AP601 02980C* ********** AP601 02990CSR EXIT SUBRLM AP601 03000CSR RLABL TEMP4 AP601 03010CSR RLABL SSTRT 30 AP601 0003020CSR RLABL BUFFER AP601 03030CSR RLABL TSTRT 30 AP601 03040CSR RLABL NCHARS 30 AP601 03050CSR BPOS ADD 1 FPOS 20 AP601 03060CSR EXSR MVRECD AP601 03070C* ********** AP601 03080CSR SKIPF TAG AP601 0003090C* ********** AP601 03100CSR 30 Z-ADDFL BLNGTH AP601 03110CSRN30 FL ADD 3 BLNGTH AP601 03120CSRN30 BLNGTH ADD LEN BLNGTH AP601 03130CSR MOVE 'T' TYPE AP601 03140CSR EXSR CRTCOM AP601 03150C* ********** AP601 0003160CSR ENDSR AP601 03170C********************************************************************AP601 03180C* AP601 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN AP601 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST AP601 03210C* THE RIGHT BRACKET. AP601 03220C********************************************************************AP601 0003230CSR MVRECD BEGSR AP601 03240C* ********** AP601 03250CSR 63 GOTO RBRK AP601 03260C* ********** AP601 03270CSR 98 Z-SUBEP,X END 40 AP601 03280CSRN98 Z-ADDEP,X END AP601 03290CSR END SUB LEN STRT 40 81 81 AP601 0003300CSR STRT ADD 1 STRT AP601 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER AP601 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER AP601 03330CSR Z-ADDLEN NCHARS AP601 03340CSR Z-ADDSTRT SSTRT AP601 03350CSR Z-ADDFPOS TSTRT AP601 03360CSRN81 GOTO RBRK AP601 0003370C* ********** AP601 03380CSR EXIT SUBRLM AP601 03390CSR RLABL RECORD AP601 03400CSR RLABL SSTRT 30 AP601 03410CSR RLABL BUFFER AP601 03420CSR RLABL TSTRT 30 AP601 03430CSR RLABL NCHARS 30 AP601 0003440CSR RBRK TAG AP601 03450C* ********** AP601 03460CSR EXSR RTBRKT AP601 03470C* ********** AP601 03480CSR ENDSR AP601 03490C********************************************************************AP601 03500C* AP601 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS AP601 03520C* AP601 03530C********************************************************************AP601 03540CSR RTBRKT BEGSR AP601 03550C* ********** AP601 03560CSR LEN ADD FPOS FPOS AP601 03570CSR Z-ADDFPOS TSTRT AP601 0003580CSR Z-ADD1 NCHARS AP601 03590CSRN98 Z-ADD2 SSTRT AP601 03600CSR 98 Z-ADD4 SSTRT AP601 03610C* ********** AP601 03620CSR EXIT SUBRLM AP601 03630CSR RLABL TEMP4 AP601 03640CSR RLABL SSTRT 30 AP601 0003650CSR RLABL BUFFER AP601 03660CSR RLABL TSTRT 30 AP601 03670CSR RLABL NCHARS 30 AP601 03680CSR ENDSR AP601 03690C********************************************************************AP601 03700C* AP601 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. AP601 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO AP601 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF AP601 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST AP601 03750C* OF THE FIELDS ARE LEFT UNCHANGED AP601 03760C* AP601 03770C********************************************************************AP601 03780CSR UPDATE BEGSR AP601 0003790C* ********** AP601 03800CSR SETOF 32 AP601 03810CSR Z-ADD1 X AP601 03820CSR UPLOOP TAG AP601 03830C* ********** AP601 03840CSR EP,X COMP 0 98 AP601 03850CSR 98 SETON 30 AP601 0003860CSR 98 GOTO NOUPD AP601 03870C* ********** AP601 03880CSR Z-ADDLN,X LEN AP601 03890CSR LEN COMP 0 9730 AP601 03900CSR 97 Z-SUBLEN LEN AP601 03910CSR NOUPD TAG AP601 03920C* ********** AP601 0003930CSR 30N32 GOTO INCR AP601 03940C* ********** AP601 03950CSR 30 GOTO CHKRUB AP601 03960C* ********** AP601 03970CSR SETOF 3233 AP601 03980CSR EXSR ACCEPT AP601 03990C* ********** AP601 0004000CSR CHKRUB TAG AP601 04010C* ********** AP601 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTAP601 04030CSR 32 31 GOTO UPLOOP AP601 04040C* ********** AP601 04050CSR 32 GOTO ENDUPD AP601 04060C* ********** AP601 0004070CSR MOVELBUFFER ATSIGN 1 AP601 04080CSR ATSIGN COMP '@' 35 AP601 04090CSR 35 GOTO OUTREC AP601 04100C* ********** AP601 04110CSR 33 GOTO INCR WAS LINE FEED AP601 04120C* ********** AP601 04130CSR Z-ADDEP,X END AP601 0004140CSR END SUB LEN STRT 81 81 AP601 04150CSR STRT ADD 1 STRT AP601 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF AP601 04170C* BUFFER TO THE STRT OF RECORD AP601 04180CSR Z-ADD1 SSTRT AP601 04190CSR Z-ADDSTRT TSTRT AP601 04200CSR Z-ADDLEN NCHARS AP601 0004210CSRN81 GOTO AAA AP601 04220C* ********** AP601 04230CSR EXIT SUBRLM AP601 04240CSR RLABL BUFFER AP601 04250CSR RLABL SSTRT 30 AP601 04260CSR RLABL RECORD AP601 04270CSR RLABL TSTRT 30 AP601 0004280CSR RLABL NCHARS 30 AP601 04290CSR AAA TAG AP601 04300CSR MOVELBUFFER TEMP5 5 AP601 04310CSR MOVELSAVPOS BUFFER AP601 04320CSR EXSR POSCUR AP601 04330C* ********** AP601 04340CSR MOVELTEMP5 BUFFER AP601 0004350CSR Z-ADD1 FPOS AP601 04360CSR EXSR RTBRKT AP601 04370C* ********** AP601 04380CSR LEN ADD 1 BLNGTH AP601 04390CSR MOVE 'T' TYPE AP601 04400CSR EXSR CRTCOM AP601 04410C* ********** AP601 0004420CSR INCR TAG AP601 04430C* ********** AP601 04440CSR X ADD 1 X AP601 04450CSR X COMP NOFLDS 30 AP601 04460CSR 30 GOTO UPLOOP AP601 04470C* ********** AP601 04480CSR OUTREC TAG AP601 0004490C* ********** AP601 04500CSR SETON 80 AP601 04510CSRN61 EXCPT AP601 04520CSR SETOF 80 AP601 04530CSR ENDUPD TAG AP601 04540C* ********** AP601 04550CSR ENDSR AP601 0004560C********************************************************************AP601 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE AP601 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X AP601 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND AP601 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT AP601 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED AP601 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS AP601 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS AP601 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO AP601 04650C* TO BE OUTPUT TO THE SCREEN. AP601 04660C* AP601 04670C********************************************************************AP601 04680CSR ACCEPT BEGSR AP601 04690C* ********** AP601 0004700CSR X COMP 1 30 AP601 04710CSRN30 X COMP SSIZE 30 AP601 04720CSR 30 Z-ADD1 X AP601 04730CSR MOVELCP,X FC AP601 04740CSR FC ADD 3 FC AP601 04750CSR MOVELCP,X SAVPOS 4 AP601 04760CSR MOVELFC SAVPOS AP601 0004770CSR Z-ADDLN,X LEN AP601 04780CSR LEN COMP 0 97 AP601 04790CSR 97 Z-SUBLEN LEN AP601 04800CSR LEN ADD FC OFC 20 AP601 04810CSR ACLOOP TAG AP601 04820C* ********** AP601 04830CSR MOVELSAVPOS BUFFER AP601 0004840CSR EXSR POSCUR AP601 04850C* ********** AP601 04860CSR Z-ADDLEN BLNGTH AP601 04870CSR MOVE BLANKS BUFFER AP601 04880CSR MOVE 'A' TYPE AP601 04890CSR EXSR CRTCOM AP601 04900C* ********** AP601 0004910CSR RCODE COMP 'R' 31 AP601 04920CSR 31 BUFFER COMP BLANKS 32 AP601 04930CSR 31 32N62 GOTO DUPIT AP601 04940C* ********** AP601 04950CSR 31 GOTO ACLOOP AP601 04960C* ********** AP601 04970CSR RCODE COMP 'L' 33 AP601 0004980CSR 33 GOTO DUPIT AP601 04990C* ********** AP601 05000CSRN97 GOTO ENDACC AP601 05010C* ********** AP601 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK AP601 05030CSR SIGN COMP '@' 30 AP601 05040CSR 30 GOTO ENDACC AP601 0005050C* ********** AP601 05060CSR Z-ADDLEN VL 20 AP601 05070CSR MOVELBUFFER VAR 15 AP601 05080CSR EXSR RTADJ AP601 05090C* ********** AP601 05100CSR MOVELVAR BUFFER AP601 05110CSR GOTO ENDACC AP601 0005120C* ********** AP601 05130CSR DUPIT TAG AP601 05140C* ********** AP601 05150CSR MOVELSAVPOS BUFFER AP601 05160CSR EXSR POSCUR AP601 05170C* ********** AP601 05180CSR 62 MOVELSECTON BUFFER AP601 0005190CSRN62 Z-ADD1 FPOS AP601 05200CSRN62 EXSR MVRECD AP601 05210C* ********** AP601 05220CSR MOVE 'T' TYPE AP601 05230CSR BLNGTH ADD 1 BLNGTH AP601 05240CSR EXSR CRTCOM AP601 05250C* ********** AP601 0005260CSR ENDACC ENDSR AP601 05270C* ********** AP601 05280C********************************************************************AP601 05290C* AP601 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES AP601 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM AP601 05320C* 4 DUMMY FOR RTADJ AP601 0005330C* AP601 05340C********************************************************************AP601 05350CSR POSCUR BEGSR AP601 05360C* ********** AP601 05370CSR MOVE 'P' TYPE AP601 05380CSR EXSR CRTCOM AP601 05390C* ********** AP601 0005400CSR ENDSR AP601 05410C********************************************************************AP601 05420CSR CLRSCR BEGSR AP601 05430C* ********** AP601 05440CSR MOVE 'C' TYPE AP601 05450CSR EXSR CRTCOM AP601 05460C* ********** AP601 0005470CSR ENDSR AP601 05480C********************************************************************AP601 05490CSR CRTCOM BEGSR AP601 05500C* ********** AP601 05510C* ********** AP601 05520CSR EXITFSUBRCM AP601 05530CSR RLABL BUFFER 72 AP601 0005540CSR RLABL TYPE 1 AP601 05550CSR RLABL BLNGTH 20 AP601 05560CSR RLABL RCODE 1 AP601 05570CSR RLABL MASK 10 AP601 05580CSR RLABL DTYPE 10 AP601 05590CSR ENDSR AP601 05600C********************************************************************AP601 0005610CSR RTADJ BEGSR AP601 05620C* ********** AP601 05630CSR EXIT SUBRAJ AP601 05640C* ********** AP601 05650CSR RLABL VL AP601 05660CSR RLABL VAR AP601 05670CSR ENDSR AP601 0005680C********************************************************************AP601 05690OVENDOR E 80N55 AP601 05700O RECORD 0256 AP601 05710O E 40N80 AP601 05720O FF 106 AP601 05730O EADD 80 55 AP601 05740O RECORD 0256 AP601 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800__0O RECORD 0256 AP601 0(=K ITXAP621 P999999032778(000010H S AP621 00020X DECK-ID A24 MFG/DIST/ACCT SYSTEM SUMMARY-123 AP621 00030F* INQUIRY/MAINTENANCE PROGRAM FOR CHART OF ACCOUNTS FILE AP621 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0AP621 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA AP621 00060F* CONTROL DATA PROPRIETARY PRODUCT AP621 00070F* AP621 0000080FNULL IPEAF 72 DISK AP621 00090FAP621P IC F 32R DISK AP621 00100FCHRTAC UC F 0048R10AI 0001 DISK A AP621 00110E FN 005 22 FIELD NAME AP621 00120E CP 005 4 CURSOR POSITION AP621 00130E LN 005 2 0 LENGTH AP621 00140E EP 005 4 0 ENDING POSITION AP621 0000150INULL NS 31 AP621 00160I 1 1 A AP621 00170IAP621P NS 02 AP621 00180I 1 22 FIELDN AP621 00190I 23 26 CURPOS AP621 00200I 27 280LNGTH AP621 00210I 29 310ENDPOS AP621 0000220ICHRTAC NS 03 AP621 00230I 10048 RECORD AP621 00240C MOVE ' ' RCODE 1 AP621 00250C MOVE RCODE B22 22 AP621 00260C MOVE RCODE BLANKS 72 AP621 00270C MOVE RCODE FILLER 1 AP621 00280C Z-ADD0 MASK 10 AP621 0000290C SETON LR AP621 00300CLR Z-ADD005 SSIZE 30 AP621 00310CLR Z-ADD003 NSECT 30 AP621 00320CLR BITON'01234567'FF 1 AP621 00330CLR MOVE '[]<>' TEMP4 4 AP621 00340CLR START TAG AP621 00350C* ********** AP621 0000360CLR EXSR FIRSTP AP621 00370C* ********** AP621 00380CLR EXSR CLRSCR AP621 00390C* ********** AP621 00400CLR 40 GOTO EOJ AP621 00410C* ********** AP621 00420CLR Z-ADD2 VL AP621 0000430CLR MOVELSECTON VAR AP621 00440CLR EXSR RTADJ AP621 00450C* ********** AP621 00460CLR MOVELVAR SECTN 20 AP621 00470CLR EXSR GETSEC AP621 00480C* ********** AP621 00490CLRN45 GOTO START AP621 0000500C* ********** AP621 00510CLR EXSR CLRSCR AP621 00520C* ********** AP621 00530CLR EXSR OUTPUT AP621 00540C* ********** AP621 00550CLR EXSR UPDATE AP621 00560C* ********** AP621 0000570CLR GOTO START AP621 00580C* ********** AP621 00590CLR EOJ TAG AP621 00600C* ********** AP621 00610C********************************************************************AP621 00620C* AP621 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND AP621 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. AP621 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDAP621 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN AP621 00670C* AP621 00680C********************************************************************AP621 00690CSR FIRSTP BEGSR AP621 00700C* ********** AP621 0000710CSR EXSR CLRSCR AP621 00720C* ********** AP621 00730CSR Z-ADD0 SECTN AP621 00740CSR EXSR GETSEC AP621 00750C* ********** AP621 00760CSR PGE TAG AP621 00770C* ********** AP621 0000780CSR SETON 61 AP621 00790CSR SETOF 62 AP621 00800CSR EXSR OUTPUT AP621 00810C* ********** AP621 00820CSR EXIT SUBRFL AP621 00830C* ********** AP621 00840CSR RLABL RECORD AP621 0000850CSR RLABL FILLER 1 AP621 00860C* ********** AP621 00870C* ********** AP621 00880C* ********** AP621 00890C* ********** AP621 00900C* ********** AP621 00910C* ********** AP621 0000920C* ********** AP621 00930C* ********** AP621 00940C* ********** AP621 00950C* ********** AP621 00960C* ********** AP621 00970C* ********** AP621 00980C* ********** AP621 0000990C* ********** AP621 01000C* ********** AP621 01010CSR Z-ADD10 NCHARS AP621 01020CSR Z-ADD1 SSTRT AP621 01030CSR Z-ADD1 TSTRT AP621 01040C* ********** AP621 01050CSR EXIT SUBRLM AP621 0001060CSR RLABL KEY 10 AP621 01070CSR RLABL SSTRT 30 AP621 01080CSR RLABL RECORD AP621 01090CSR RLABL TSTRT 30 AP621 01100CSR RLABL NCHARS 30 AP621 01110CSR Z-ADDNOFLDS SVFLDS 30 AP621 01120CSR Z-ADDSX NOFLDS AP621 0001130CSR EXSR UPDATE AP621 01140C* ********** AP621 01150CSR Z-ADDSVFLDS NOFLDS AP621 01160CSR Z-ADD10 NCHARS AP621 01170CSR Z-ADD1 SSTRT AP621 01180CSR Z-ADD1 TSTRT AP621 01190C* ********** AP621 0001200CSR EXIT SUBRLM AP621 01210CSR RLABL RECORD AP621 01220CSR RLABL SSTRT 30 AP621 01230CSR RLABL KEY AP621 01240CSR RLABL TSTRT 30 AP621 01250CSR RLABL NCHARS 30 AP621 01260CSR KEY CHAINCHRTAC 55 AP621 0001270CSR MOVELSAVPOS BUFFER AP621 01280CSR MOVELOFC BUFFER AP621 01290CSR EXSR POSCUR AP621 01300C* ********** AP621 01310CSR MOVEL'] NEW R'WORD16 16 AP621 01320CSR MOVE 'ECORD 'WORD16 AP621 01330CSRN55 MOVELBLANKS WORD16 AP621 0001340CSRN55 MOVEL']' WORD16 AP621 01350CSR MOVELWORD16 BUFFER 72 AP621 01360CSR MOVE 'T' TYPE 1 AP621 01370CSR Z-ADD13 BLNGTH 20 AP621 01380CSR EXSR CRTCOM AP621 01390C* ********** AP621 01400CSR SETON 62 AP621 0001410CSR Z-ADDSX X 30 AP621 01420CSR EXSR ACCEPT AP621 01430C* ********** AP621 01440CSR MOVELBUFFER SECTON 2 AP621 01450CSR SECTON COMP 'E ' 40 AP621 01460CSR 40 GOTO ENDFP AP621 01470C* ********** AP621 0001480CSR SECTON COMP ' 1' 30 30 AP621 01490CSR 30 SECTON COMP ' 9' 3030 AP621 01500CSR 30 GOTO GOOD AP621 01510C* ********** AP621 01520CSR SECTON COMP '01' 30 30 AP621 01530CSR 30 SECTON COMP '09' 3030 AP621 01540CSR 30 GOTO GOOD AP621 0001550C* ********** AP621 01560CSR SECTON COMP '1 ' 30 30 AP621 01570CSR 30 SECTON COMP '9 ' 3030 AP621 01580CSR 30 GOTO GOOD AP621 01590C* ********** AP621 01600CSR MOVELSECTON TEMP1 1 AP621 01610CSR TEMP1 COMP '1' 30 30 AP621 0001620CSR 30 TEMP1 COMP '9' 3030 AP621 01630CSRN30 GOTO PGE AP621 01640C* ********** AP621 01650CSR MOVE SECTON TEMP1 AP621 01660CSR TEMP1 COMP '0' 30 30 AP621 01670CSR 30 TEMP1 COMP '9' 3030 AP621 01680CSRN30 GOTO PGE AP621 0001690C* ********** AP621 01700CSR GOOD TAG AP621 01710C* ********** AP621 01720CSR SETOF 6162 AP621 01730CSRN55 GOTO ENDFP AP621 01740C* ********** AP621 01750CSR SETON 80 AP621 0001760CSR EXCPT AP621 01770CSR SETOF 80 AP621 01780CSR KEY CHAINCHRTAC 55 AP621 01790CSR ENDFP ENDSR AP621 01800C* ********** AP621 01810C********************************************************************AP621 01820C* AP621 0001830C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. AP621 01840C* AP621 01850C********************************************************************AP621 01860CSR GETSEC BEGSR AP621 01870C* ********** AP621 01880CSR 1 ADD SECTN N 20 AP621 01890CSR SETOF 404145 AP621 0001900CSR N COMP 0 3030 AP621 01910CSRN30 N COMP NSECT 30 AP621 01920CSR 30 GOTO ENDGET AP621 01930C* ********** AP621 01940CSR SECTN MULT SSIZE RRN 40 AP621 01950CSR Z-ADD1 X AP621 01960CSR SCLOOP TAG AP621 0001970C* ********** AP621 01980CSR RRN ADD 1 RRN AP621 01990CSR RRN CHAINAP621P 50 AP621 02000CSR 50 GOTO ENDGET AP621 02010C* ********** AP621 02020CSR FIELDN COMP B22 4141 AP621 02030CSRN41 GOTO ENDGET AP621 0002040C* ********** AP621 02050CSR 41N45 SETON 45 AP621 02060CSR MOVE FIELDN FN,X AP621 02070CSR MOVE CURPOS CP,X AP621 02080CSR MOVE LNGTH LN,X AP621 02090CSR Z-ADDENDPOS EP,X AP621 02100CSR 1 ADD X X AP621 0002110CSR X COMP SSIZE 32 AP621 02120CSRN32 GOTO SCLOOP AP621 02130C* ********** AP621 02140CSR ENDGET TAG AP621 02150C* ********** AP621 02160CSR Z-ADDX NOFLDS 30 AP621 02170CSR 45 GOTO FINGET AP621 0002180C* ********** AP621 02190CSR EXSR CLRSCR AP621 02200C* ********** AP621 02210CSR MOVEL'SECT # 'WORD9 9 AP621 02220CSR Z-ADD16 BLNGTH AP621 02230CSR MOVE SECTN WORD9 AP621 02240CSR MOVELWORD9 WORD16 AP621 0002250CSRN30 MOVE ' ABSENT' WORD16 AP621 02260CSR 30 MOVE ' ILLEG.' WORD16 AP621 02270CSR MOVELWORD16 BUFFER AP621 02280CSR MOVEL'T' TYPE AP621 02290CSR EXSR CRTCOM AP621 02300C* ********** AP621 02310CSR FINGET ENDSR AP621 0002320C* ********** AP621 02330C********************************************************************AP621 02340C* AP621 02350C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE AP621 02360C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE AP621 02370C* SECTION INDEX IS SAVED. AP621 02380C* AP621 0002390C********************************************************************AP621 02400CSR OUTPUT BEGSR AP621 02410C* ********** AP621 02420CSR EXSR CLRSCR AP621 02430C* ********** AP621 02440CSR Z-ADD1 X AP621 02450CSR 61 SETON 63 AP621 0002460CSR OTLOOP TAG AP621 02470C* ********** AP621 02480CSR 61 LN,X COMP 0 31 AP621 02490CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXAP621 02500CSR EXSR OUTFLD AP621 02510C* ********** AP621 02520CSR X ADD 1 X AP621 0002530CSR X COMP NOFLDS 31 AP621 02540CSR 31 GOTO OTLOOP AP621 02550C* ********** AP621 02560CSR SETOF 63 AP621 02570CSR ENDSR AP621 02580C********************************************************************AP621 02590C* AP621 0002600C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND AP621 02610C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 AP621 02620C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS AP621 02630C* THEN NO FIELD INFORMATION IS PRINTED AP621 02640C* AP621 02650C********************************************************************AP621 02660CSR OUTFLD BEGSR AP621 0002670C* ********** AP621 02680CSR MOVE FN,X FL 20 AP621 02690CSR EP,X COMP 0 98 AP621 02700CSR MOVELCP,X FC 20 AP621 02710CSR FC COMP FL 31 AP621 02720CSR 31 Z-ADDFC FL AP621 02730CSR FC SUB FL CC 20 AP621 0002740CSR CC ADD 1 CC AP621 02750CSR MOVELCP,X BUFFER AP621 02760CSR MOVELCC BUFFER AP621 02770CSR EXSR POSCUR AP621 02780C* ********** AP621 02790CSR MOVELBLANKS BUFFER AP621 02800CSR MOVELFN,X FIELDN AP621 0002810CSR MOVE ' ' FIELDN AP621 02820CSR MOVELFIELDN BUFFER AP621 02830CSR Z-ADDLN,X LEN 20 AP621 02840CSR LEN COMP 0 9730 AP621 02850CSR 97 Z-SUBLN,X LEN AP621 02860CSR 30 GOTO SKIPF AP621 02870C* ********** AP621 0002880CSR FL ADD 2 BPOS 20 AP621 02890C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS AP621 02900CSR Z-ADDBPOS TSTRT 30 AP621 02910CSRN98 Z-ADD1 SSTRT 30 AP621 02920CSR 98 Z-ADD3 SSTRT AP621 02930CSR Z-ADD1 NCHARS 30 AP621 02940C* ********** AP621 0002950CSR EXIT SUBRLM AP621 02960CSR RLABL TEMP4 AP621 02970CSR RLABL SSTRT 30 AP621 02980CSR RLABL BUFFER AP621 02990CSR RLABL TSTRT 30 AP621 03000CSR RLABL NCHARS 30 AP621 03010CSR BPOS ADD 1 FPOS 20 AP621 0003020CSR EXSR MVRECD AP621 03030C* ********** AP621 03040CSR SKIPF TAG AP621 03050C* ********** AP621 03060CSR 30 Z-ADDFL BLNGTH AP621 03070CSRN30 FL ADD 3 BLNGTH AP621 03080CSRN30 BLNGTH ADD LEN BLNGTH AP621 0003090CSR MOVE 'T' TYPE AP621 03100CSR EXSR CRTCOM AP621 03110C* ********** AP621 03120CSR ENDSR AP621 03130C********************************************************************AP621 03140C* AP621 03150C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN AP621 0003160C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST AP621 03170C* THE RIGHT BRACKET. AP621 03180C********************************************************************AP621 03190CSR MVRECD BEGSR AP621 03200C* ********** AP621 03210CSR 63 GOTO RBRK AP621 03220C* ********** AP621 0003230CSR 98 Z-SUBEP,X END 40 AP621 03240CSRN98 Z-ADDEP,X END AP621 03250CSR END SUB LEN STRT 40 81 81 AP621 03260CSR STRT ADD 1 STRT AP621 03270C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER AP621 03280C* FROM STRT IN RECORD TO FPOS IN BUFFER AP621 03290CSR Z-ADDLEN NCHARS AP621 0003300CSR Z-ADDSTRT SSTRT AP621 03310CSR Z-ADDFPOS TSTRT AP621 03320CSRN81 GOTO RBRK AP621 03330C* ********** AP621 03340CSR EXIT SUBRLM AP621 03350CSR RLABL RECORD AP621 03360CSR RLABL SSTRT 30 AP621 0003370CSR RLABL BUFFER AP621 03380CSR RLABL TSTRT 30 AP621 03390CSR RLABL NCHARS 30 AP621 03400CSR RBRK TAG AP621 03410C* ********** AP621 03420CSR EXSR RTBRKT AP621 03430C* ********** AP621 0003440CSR ENDSR AP621 03450C********************************************************************AP621 03460C* AP621 03470C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS AP621 03480C* AP621 03490C********************************************************************AP621 03500CSR RTBRKT BEGSR AP621 0003510C* ********** AP621 03520CSR LEN ADD FPOS FPOS AP621 03530CSR Z-ADDFPOS TSTRT AP621 03540CSR Z-ADD1 NCHARS AP621 03550CSRN98 Z-ADD2 SSTRT AP621 03560CSR 98 Z-ADD4 SSTRT AP621 03570C* ********** AP621 0003580CSR EXIT SUBRLM AP621 03590CSR RLABL TEMP4 AP621 03600CSR RLABL SSTRT 30 AP621 03610CSR RLABL BUFFER AP621 03620CSR RLABL TSTRT 30 AP621 03630CSR RLABL NCHARS 30 AP621 03640CSR ENDSR AP621 0003650C********************************************************************AP621 03660C* AP621 03670C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. AP621 03680C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO AP621 03690C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF AP621 03700C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST AP621 03710C* OF THE FIELDS ARE LEFT UNCHANGED AP621 0003720C* AP621 03730C********************************************************************AP621 03740CSR UPDATE BEGSR AP621 03750C* ********** AP621 03760CSR SETOF 32 AP621 03770CSR Z-ADD1 X AP621 03780CSR UPLOOP TAG AP621 0003790C* ********** AP621 03800CSR EP,X COMP 0 98 AP621 03810CSR 98 SETON 30 AP621 03820CSR 98 GOTO NOUPD AP621 03830C* ********** AP621 03840CSR Z-ADDLN,X LEN AP621 03850CSR LEN COMP 0 9730 AP621 0003860CSR 97 Z-SUBLEN LEN AP621 03870CSR NOUPD TAG AP621 03880C* ********** AP621 03890CSR 30N32 GOTO INCR AP621 03900C* ********** AP621 03910CSR 30 GOTO CHKRUB AP621 03920C* ********** AP621 0003930CSR SETOF 3233 AP621 03940CSR EXSR ACCEPT AP621 03950C* ********** AP621 03960CSR CHKRUB TAG AP621 03970C* ********** AP621 03980CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTAP621 03990CSR 32 31 GOTO UPLOOP AP621 0004000C* ********** AP621 04010CSR 32 GOTO ENDUPD AP621 04020C* ********** AP621 04030CSR MOVELBUFFER ATSIGN 1 AP621 04040CSR ATSIGN COMP '@' 35 AP621 04050CSR 35 GOTO OUTREC AP621 04060C* ********** AP621 0004070CSR 33 GOTO INCR WAS LINE FEED AP621 04080C* ********** AP621 04090CSR SECTN COMP 0 37 AP621 04100CSRN37 GOTO LEE1 AP621 04110CSR X COMP 5 37 AP621 04120CSRN37 GOTO LEE1 AP621 04130CSR MOVELBUFFER SV1 100 AP621 0004140CSR SV1 COMP 0 37 AP621 04150CSRN37 GOTO LEE1 AP621 04160CSR GOTO UPLOOP AP621 04170CSR LEE1 TAG AP621 04180CSR Z-ADDEP,X END AP621 04190CSR END SUB LEN STRT 81 81 AP621 04200CSR STRT ADD 1 STRT AP621 0004210C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF AP621 04220C* BUFFER TO THE STRT OF RECORD AP621 04230CSR Z-ADD1 SSTRT AP621 04240CSR Z-ADDSTRT TSTRT AP621 04250CSR Z-ADDLEN NCHARS AP621 04260CSRN81 GOTO AAA AP621 04270C* ********** AP621 0004280CSR EXIT SUBRLM AP621 04290CSR RLABL BUFFER AP621 04300CSR RLABL SSTRT 30 AP621 04310CSR RLABL RECORD AP621 04320CSR RLABL TSTRT 30 AP621 04330CSR RLABL NCHARS 30 AP621 04340CSR AAA TAG AP621 0004350CSR MOVELBUFFER TEMP5 5 AP621 04360CSR MOVELSAVPOS BUFFER AP621 04370CSR EXSR POSCUR AP621 04380C* ********** AP621 04390CSR MOVELTEMP5 BUFFER AP621 04400CSR Z-ADD1 FPOS AP621 04410CSR EXSR RTBRKT AP621 0004420C* ********** AP621 04430CSR LEN ADD 1 BLNGTH AP621 04440CSR MOVE 'T' TYPE AP621 04450CSR EXSR CRTCOM AP621 04460C* ********** AP621 04470CSR INCR TAG AP621 04480C* ********** AP621 0004490CSR X ADD 1 X AP621 04500CSR X COMP NOFLDS 30 AP621 04510CSR 30 GOTO UPLOOP AP621 04520C* ********** AP621 04530CSR OUTREC TAG AP621 04540C* ********** AP621 04550CSR SETON 80 AP621 0004560CSRN61 EXCPT AP621 04570CSR SETOF 80 AP621 04580CSR ENDUPD TAG AP621 04590C* ********** AP621 04600CSR ENDSR AP621 04610C********************************************************************AP621 04620C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE AP621 0004630C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X AP621 04640C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND AP621 04650C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT AP621 04660C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED AP621 04670C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS AP621 04680C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS AP621 04690C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO AP621 0004700C* TO BE OUTPUT TO THE SCREEN. AP621 04710C* AP621 04720C********************************************************************AP621 04730CSR ACCEPT BEGSR AP621 04740C* ********** AP621 04750CSR X COMP 1 30 AP621 04760CSRN30 X COMP SSIZE 30 AP621 0004770CSR 30 Z-ADD1 X AP621 04780CSR MOVELCP,X FC AP621 04790CSR FC ADD 3 FC AP621 04800CSR MOVELCP,X SAVPOS 4 AP621 04810CSR MOVELFC SAVPOS AP621 04820CSR Z-ADDLN,X LEN AP621 04830CSR LEN COMP 0 97 AP621 0004840CSR 97 Z-SUBLEN LEN AP621 04850CSR LEN ADD FC OFC 20 AP621 04860CSR ACLOOP TAG AP621 04870C* ********** AP621 04880CSR MOVELSAVPOS BUFFER AP621 04890CSR EXSR POSCUR AP621 04900C* ********** AP621 0004910CSR Z-ADDLEN BLNGTH AP621 04920CSR MOVE BLANKS BUFFER AP621 04930CSR MOVE 'A' TYPE AP621 04940CSR EXSR CRTCOM AP621 04950C* ********** AP621 04960CSR RCODE COMP 'R' 31 AP621 04970CSR 31 BUFFER COMP BLANKS 32 AP621 0004980CSR 31 32N62 GOTO DUPIT AP621 04990C* ********** AP621 05000CSR 31 GOTO ACLOOP AP621 05010C* ********** AP621 05020CSR RCODE COMP 'L' 33 AP621 05030CSR 33 GOTO DUPIT AP621 05040C* ********** AP621 0005050CSRN97 GOTO ENDACC AP621 05060C* ********** AP621 05070CSR MOVELBUFFER SIGN 1 WE MUST CHECK AP621 05080CSR SIGN COMP '@' 30 AP621 05090CSR 30 GOTO ENDACC AP621 05100C* ********** AP621 05110CSR Z-ADDLEN VL 20 AP621 0005120CSR MOVELBUFFER VAR 15 AP621 05130CSR EXSR RTADJ AP621 05140C* ********** AP621 05150CSR MOVELVAR BUFFER AP621 05160CSR GOTO ENDACC AP621 05170C* ********** AP621 05180CSR DUPIT TAG AP621 0005190C* ********** AP621 05200CSR MOVELSAVPOS BUFFER AP621 05210CSR EXSR POSCUR AP621 05220C* ********** AP621 05230CSR 62 MOVELSECTON BUFFER AP621 05240CSRN62 Z-ADD1 FPOS AP621 05250CSRN62 EXSR MVRECD AP621 0005260C* ********** AP621 05270CSR MOVE 'T' TYPE AP621 05280CSR BLNGTH ADD 1 BLNGTH AP621 05290CSR EXSR CRTCOM AP621 05300C* ********** AP621 05310CSR ENDACC ENDSR AP621 05320C* ********** AP621 0005330C********************************************************************AP621 05340C* AP621 05350C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES AP621 05360C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM AP621 05370C* 4 DUMMY FOR RTADJ AP621 05380C* AP621 05390C********************************************************************AP621 0005400CSR POSCUR BEGSR AP621 05410C* ********** AP621 05420CSR MOVE 'P' TYPE AP621 05430CSR EXSR CRTCOM AP621 05440C* ********** AP621 05450CSR ENDSR AP621 05460C********************************************************************AP621 0005470CSR CLRSCR BEGSR AP621 05480C* ********** AP621 05490CSR MOVE 'C' TYPE AP621 05500CSR EXSR CRTCOM AP621 05510C* ********** AP621 05520CSR ENDSR AP621 05530C********************************************************************AP621 0005540CSR CRTCOM BEGSR AP621 05550C* ********** AP621 05560C* ********** AP621 05570CSR EXITFSUBRCM AP621 05580CSR RLABL BUFFER 72 AP621 05590CSR RLABL TYPE 1 AP621 05600CSR RLABL BLNGTH 20 AP621 0005610CSR RLABL RCODE 1 AP621 05620CSR RLABL MASK 10 AP621 05630CSR RLABL DTYPE 10 AP621 05640CSR ENDSR AP621 05650C********************************************************************AP621 05660CSR RTADJ BEGSR AP621 05670C* ********** AP621 0005680C* ********** AP621 05690CSR EXIT SUBRAJ AP621 05700CSR RLABL VL AP621 05710CSR RLABL VAR AP621 05720CSR ENDSR AP621 05730C********************************************************************AP621 05740OCHRTAC E 80N55 AP621 0005750O RECORD 0048 AP621 05760O E 40N80 AP621 05770O FF 1 AP621 05780O EADD 80 55 AP621 05790O RECORD 0048 AP621 ** 005800ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00581000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005820ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005830ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005840/* 005850__0O RECORD 0048 AP621 ** 005800ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0058100(>j 3?TXAPDCT P999999032778(000010H S APDCT 00020X DECK-ID A25 MFG/DIST/ACCT SYSTEM SUMMARY-123 APDCT 00030F* DELETES ALL RECORDS IN CHART OF ACCOUNT FILE FLAGGED BY AP621 APDCT 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0APDCT 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA APDCT 00060F* CONTROL DATA PROPRIETARY PRODUCT APDCT 00070F* APDCT 0000080FCHRTAC IS AF 48 10AI 1 DISK APDCT 00090FAPHEAD IP F 128 DISK APDCT 00100F@CHRT O F 48 10AI 1 DISK APDCT 00110F$LP1 O F 132 OF PRINTER APDCT 00120F* APDCT 00130F* THIS PROGRAM IS A FILE MAINTENANCE PROGRAM WHICH DELETES RECORDS APDCT 00140F* FROM THE CHART OF ACCOUNT FILE WHICH ARE FLAGGED FOR DELETION BY APDCT 0000150F* A 'D' IN RECORD POSITION 36. THE DELETED RECORDS ARE PRINTED ON APDCT 00160F* A REPORT. APDCT 00170F* APDCT 00180ICHRTAC NS 01 APDCT 00190I 1 10 ACCT APDCT 00200I 11 35 NAME APDCT 00210I 36 36 DCODE APDCT 0000220I 1 48 CHRREC APDCT 00230IAPHEAD NS 02 APDCT 00240I 1 40 CONAME APDCT 00250C SETOF 06 APDCT 00260C 01 DCODE COMP 'D' 06 APDCT 00270O@CHRT D 01N06 APDCT 00280O CHRREC 48 APDCT 0000290O$LP1 H 202 OF APDCT 00300O OR 02 APDCT 00310O 6 'PAGE' APDCT 00320O PAGE Z 11 APDCT 00330O CONAME 76 APDCT 00340O UDATE Y 124 APDCT 00350O H 3 OF APDCT 0000360O OR 02 APDCT 00370O 49 'CHART' APDCT 00380O 52 'OF' APDCT 00390O 61 'ACCOUNTS' APDCT 00400O 70 'DELETION' APDCT 00410O 77 'REPORT' APDCT 00420O 124 'APDCT' APDCT 0000430O D 2 01 06 APDCT 00440O ACCT 51 APDCT 00450O NAME 81 APDCT ** 000460ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000470ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000480ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00049000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000500/* 000510__0O NAME 81 APDCT ** 000460ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000470ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000480ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0004900(> 8ATXAPDVN P999999032778(000010H S APDVN 00020X DECK-ID A26 MFG/DIST/ACCT SYSTEM SUMMARY-123 APDVN 00030F* DELETES ALL RECORDS IN VENDOR FILE FLAGGED FOR DELETION BY AP601 APDVN 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0APDVN 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA APDVN 00060F* CONTROL DATA PROPRIETARY PRODUCT APDVN 00070F* APDVN 0000080FVENDOR IS AF 256 5AI 1 DISK APDVN 00090FAPHEAD IP AF 128 DISK APDVN 00100F@VEND O F 256 5AI 1 DISK APDVN 00110F$LP1 O F 132 OF PRINTER APDVN 00120F* APDVN 00130F* THIS PROGRAM IS A FILE MAINTENANCE PROGRAM WHICH DELETES RECORDS APDVN 00140F* FROM THE VENDOR FILE WHICH ARE FLAGGED FOR DELETION BY A 'D' IN APDVN 0000150F* RECORD POSITION 106. THE DELETED RECORDS ARE PRINTED ON A REPORT. APDVN 00160F* APDVN 00170IVENDOR NS 01 APDVN 00180I 1 5 VEN APDVN 00190I 6 30 NAME APDVN 00200I 31 55 ADRL1 APDVN 00210I 56 80 ADRL2 APDVN 0000220I 81 103 ADRL3 APDVN 00230I 106 106 DCODE APDVN 00240I 1 256 VENREC APDVN 00250IAPHEAD NS 02 APDVN 00260I 1 40 CONAME APDVN 00270C SETOF 75 APDVN 00280C N76 SETON 7576 APDVN 0000290C SETOF 06 APDVN 00300C 01 DCODE COMP 'D' 06 APDVN 00310O@VEND D 01N06 APDVN 00320O VENREC 256 APDVN 00330O$LP1 D 202 OF APDVN 00340O OR 75 APDVN 00350O 6 'PAGE' APDVN 0000360O PAGE Z 11 APDVN 00370O CONAME 85 APDVN 00380O UDATE Y 128 APDVN 00390O D 3 OF APDVN 00400O OR 75 APDVN 00410O 55 'VENDOR' APDVN 00420O 64 'DELETION' APDVN 0000430O 71 'REPORT' APDVN 00440O 124 'APDVN' APDVN 00450O D 2 01 06 APDVN 00460O VEN 5 APDVN 00470O NAME 32 APDVN 00480O ADRL1 65 APDVN 00490O ADRL2 95 APDVN 0000500O ADRL3 125 APDVN ** 000510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000520ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000530ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000550/* 00056000__0O ADRL3 125 APDVN ** 000510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000520ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000530ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000550/* 0005600(l>  mTXAPKYP P999999032778(000010H S APKYP 00020X DECK-ID A27 MFG/DIST/ACCT SYSTEM SUMMARY-123 APKYP 00030F* DATA ENTRY PROGRAM FOR ENTERING VARIOUS TYPES OF TRANSACTIONS APKYP 00040F* CYBER 18-10M/20 ACCOUNTS PAYABLE VERSION 1.0APKYP 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA APKYP 00060F* CONTROL DATA PROPRIETARY PRODUCT APKYP 00070F* APKYP 0000080F* APKYP 00090F* 'KYPEDT' FOR COMPUSOURCE A/P PACKAGE. APKYP 00100F* APKYP 00110F* APKYP 00120F****************************************************************** APKYP 00130F* APKYP 00140F* THIS IS A MODIFICATION OF 'KEYPCH' WHICH ALLOWS: APKYP 0000150F* 1) AUTOMATIC PROGRAM LEVEL SWITCHING, APKYP 00160F* 2) GANG-PUNCH FIELDS (CONSTANT INSERTION), APKYP 00170F* 3) EDIT FLAGGING OF FIELDS FOR PROCESSING BY SUBROUTINE APKYP 00180F* 'EDIT' INTERNAL TO THIS PROGRAM. APKYP 00190F* 4) EIGHT PROGRAM LEVELS APKYP 00200F* 5) AUTOMATIC LOADING OF THE 8 LEVELS BASED ON THE 1ST RECORD APKYP 00210F* UN THE FILE 'APDUM'. APKYP 0000220F* 6) IF MODE IS 'A', THE STARTING SEQ# WILL AUTOMATICALLY BE THE APKYP 00230F* FIRST RECORD WITH '<>' IN BYTES 1-2. APKYP 00240F* APKYP 00250F* APKYP 00260F* APKYP 00270F********************************************************************APKYP 00280FAPDUM IPEAF 72 DISK APKYP 0000290FKPROGX IC F 40R 8AI 1 DISK APKYP 00300FAPINPT UC F 128R DISK APKYP 00310F****************************************************************** APKYP 00320F* THE FILES BELOW ARE USED STRICTLY FOR EDITING. APKYP 00330FCHRTAC IC F 48R10AI 1 DISK APKYP 00340FOUTCHK IC F 48R 5AI 1 DISK APKYP 00350FVENDOR IC F 256R 5AI 1 DISK APKYP 0000360FVENINV UC F 32R13AI 1 DISK A APKYP 00370F********************************************************************APKYP 00380E ARY1 1 2 50 APKYP 00390E MSG 1 8 25 APKYP 00400E SFN 160 20 FIELD NAMES. APKYP 00410E SAN 160 1 ALPH OR NUM APKYP 00420E SAD 160 1 AUTO DUP FLAGS APKYP 0000430E SST 160 3 0 FIELD START APKYP 00440E SLN 160 2 0 FIELD LENGTHS APKYP 00450E SEF 160 2 EDIT FLAGS APKYP 00460E SGP 160 1 GANG PUNCH FLGS APKYP 00470E SNP 8 1 0 NEXT PROG# APKYP 00480E SNM 8 6 PROG NAMES APKYP 00490E SMX 8 3 0 MAX INDX'S APKYP 0000500E EMS 1 8 30 EDIT MESSAGES APKYP 00510IAPDUM NS 01 APKYP 00520I 1 48 SNM APKYP 00530IKPROGX NS 02 36NCD APKYP 00540I 9 28 FN APKYP 00550I 29 29 AN APKYP 00560I 30 30 AD APKYP 0000570I 31 33 ST APKYP 00580I 34 35 LN APKYP 00590I 36 36 DCODE APKYP 00600I 37 37 NPL APKYP 00610I 38 38 GP APKYP 00620I 39 40 EF APKYP 00630I NS 03 APKYP 0000640I 1 1 A APKYP 00650IAPINPT NS 05 APKYP 00660I 1 2 RC APKYP 00670I 1 128 RECORD APKYP 00680I 3 15 VENV APKYP 00690I 28 362GROSS 76 APKYP 00700I 37 432DISC APKYP 0000710I****************************************************************** APKYP 00720I* INPUT SPECS FOR EDITING FILES ARE LISTED BELOW. APKYP 00730ICHRTAC NS 09 APKYP 00740I 1 1 @XX APKYP 00750IOUTCHK NS 09 APKYP 00760I 1 1 @XX APKYP 00770IVENDOR NS 09 APKYP 0000780I 1 1 @XX APKYP 00790IVENINV NS 09 APKYP 00800I 1 1 @XX APKYP 00810C* APKYP 00820C* APKYP 00830C EXSR ALMTS APKYP 00840C Z-ADDLOW SEQNO APKYP 0000850C* APKYP 00860C MOVE ' ' B72 72 APKYP 00870C Z-ADD1 PN LOAD INITIAL APKYP 00880C LDLOOP TAG PROGS FROM 1STAPKYP 00890C SNM,PN COMP ' ' 2626 48 BYTES OF APKYP 00900C MOVELSNM,PN PNAME APKYP 00910C MOVE ' ' PNAME APKYP 0000920C 26 EXSR GETPRG 'DUMMY' REC. APKYP 00930C PN ADD 1 PN APKYP 00940C PN COMP 8 2626 APKYP 00950C 26 GOTO LDLOOP APKYP 00960C NLR SETON LR APKYP 00970CLR MOVE '1' RTNLVL 10 APKYP 00980CLR MOVE '1' TERMNL 10 APKYP 0000990CLR START TAG APKYP 01000CLR MOVEL'>MODE-' WORD 16 APKYP 01010CLR Z-ADD6 OLN 20 APKYP 01020CLR Z-ADD1 ILN 20 APKYP 01030CLR EXSR TYPES APKYP 01040CLR MOVELNBUF MODE 1 APKYP 01050CLR CHKMOD TAG APKYP 0001060CLR SETOF 9095 APKYP 01070CLR MODE COMP 'A' 62 APKYP 01080CLR MODE COMP 'C' 63 APKYP 01090CLR MODE COMP 'V' 64 APKYP 01100CLR MODE COMP 'K' 65 APKYP 01110CLR MODE COMP 'E' 66 APKYP 01120CLR 66 GOTO EOJ APKYP 0001130CLR 65 EXSR GETPRG APKYP 01140CLR 65 GOTO START APKYP 01150CLRN62N63N64 SETON 81 APKYP 01160CLR 81 EXSR EXCPT APKYP 01170CLR SETOF 81 APKYP 01180CLRN62N63N64 GOTO START APKYP 01190CLR EXSR GETPRG APKYP 0001200CLRN63N95N62 EXSR GETSEQ APKYP 01210CLR 86 GOTO EOJ APKYP 01220CLR SAMREC TAG APKYP 01230CLR SEQNO SUB 1 SEQNO 50 APKYP 01240CLR NXTREC TAG APKYP 01250CLR SETOF 2630 26=1ST FLD FLG APKYP 01260CLR SETOF 75 APKYP 0001270CLR SETON 18 APKYP 01280CLR 63 EXSR GETSEQ APKYP 01290CLRN63 SEQNO ADD 1 SEQNO APKYP 01300CLR EXSR CLRSCR APKYP 01310CLR EXSR GETREC APKYP 01320CLR 62 EXSR PUTSEQ APKYP 01330CLRN98N62 EXSR GETSEQ APKYP 0001340CLRN98 62 GOTO EOJ APKYP 01350CLR 62 MOVE OLDREC RECORD APKYP 01360CLR Z-ADDBP N 30 APKYP 01370CLR LOOP TAG APKYP 01380CLR 27 28 90N SUB 2 N APKYP 01390CLR N COMP BP 2920 APKYP 01400CLR 20 GOTO NXTMOD APKYP 0001410CLR N ADD 1 N APKYP 01420CLR N COMP MAXFLD 20 APKYP 01430CLR 20N29 SETON 83 NO FIELDS APKYP 01440CLR 83 EXSR EXCPT APKYP 01450CLR SETOF 83 APKYP 01460CLR 20N29 GOTO START APKYP 01470CLR 20 GOTO OUTREC APKYP 0001480C** 30 HERE MEANS '@' ON PRIOR FIELD FOR THIS RECORD. APKYP 01490CLR 30 GOTO SVFLD APKYP 01500C** APKYP 01510CLR SGP,N COMP ' ' 2323 GANG PUNCH? APKYP 01520CLR N23 GOTO CHKAD APKYP 01530CLR MOVELB72 BUFFER APKYP 01540CLR MOVELSFN,N BUFFER YES... APKYP 0001550CLR Z-ADDSLN,N BLNGTH PUT 1ST LN APKYP 01560CLR EXSR EXCPT CHARS OF FIELDAPKYP 01570CLR EXSR SKIP IN BUFFER. APKYP 01580CLR MOVE 'O' RCODE APKYP 01590CLR GOTO CHKVER APKYP 01600CLR CHKAD TAG APKYP 01610CLR SAD,N COMP 'D' 27 APKYP 0001620CLR 27 62 90 APKYP 01630COR 27 64 90 GOTO LOOP APKYP 01640CLR 62 GOTO SKIPMV APKYP 01650CLR EXSR MVRECD APKYP 01660CLR MOVE BUFFER TBUF 72 APKYP 01670CLR SKIPMV TAG APKYP 01680CLR OUTFLD TAG APKYP 0001690CLR SETON 84 OUTPUT FIELD APKYP 01700CLR EXSR EXCPT NAME APKYP 01710CLR SETOF 8418 APKYP 01720CLR 62 SETOF 8418 APKYP 01730CLR MOVE SLN,N BLNGTH APKYP 01740CLR SETON 19 APKYP 01750CLR MOVE TBUF BUFFER APKYP 0001760CLR EXSR EXCPT APKYP 01770CLR RDCRT TAG APKYP 01780CLR SETOF 2728 APKYP 01790CLR MOVE 'A' TYPE 1 APKYP 01800CLR Z-ADDSLN,N BLNGTH 20 APKYP 01810CLR EXSR CRTCOM APKYP 01820CLR RCODE COMP 'O' 20 APKYP 0001830CLR 20 EXSR SKIP APKYP 01840CLR RCODE COMP 'L' 20 APKYP 01850CLR 20 GOTO RITDUP APKYP 01860CLR RCODE COMP 'R' 20 APKYP 01870CLR 20 BUFFER COMP B72 21 APKYP 01880CLR 20N21 EXSR SKIP APKYP 01890CLR 20N21 N SUB 1 N APKYP 0001900CLR 20 21 N SUB 2 N 28 28 APKYP 01910CLRN20 GOTO CHKNUM APKYP 01920CLR N29 GOTO NXTMOD APKYP 01930CLR 21N26 GOTO NXTMOD RUB ON 1ST APKYP 01940CLR SETOF 26 APKYP 01950CLR GOTO LOOP APKYP 01960CLR NXTMOD TAG APKYP 0001970CLR SETOF 28 APKYP 01980CLR MOVEL'MODE-' WORD APKYP 01990CLR Z-ADD5 OLN APKYP 02000CLR Z-ADD1 ILN APKYP 02010CLR EXSR TYPES APKYP 02020CLR MOVELBUFFER MODE APKYP 02030CLR MODE COMP 'P' 60 NEW PROG#ONLY APKYP 0002040CLR MODE COMP 'D' 61 AUTO-DUP ONLY APKYP 02050CLRN60N61 GOTO CHKMOD NEW MODE APKYP 02060CLR EXSR GETPRG APKYP 02070CLR SETOF 6061 APKYP 02080CLR GOTO SAMREC APKYP 02090CLR CHKNUM TAG APKYP 02100CLR SETON 26 A FLD HAS APKYP 0002110C** BEEN ENTERED APKYP 02120CLR MOVELBUFFER MODE APKYP 02130CLR MODE COMP '@' 20 APKYP 02140CLRN20 GOTO NOAT APKYP 02150CLR 64 GOTO NOAT APKYP 02160CLR SETON 30 30= '@' FLAG APKYP 02170CLR MOVELB72 BUFFER APKYP 0002180CLR GOTO SVFLD APKYP 02190CLR NOAT TAG APKYP 02200CLR SAN,N COMP 'N' 19 APKYP 02210CLRN19 GOTO CHKVER APKYP 02220CLR Z-ADDSLN,N VL 20 APKYP 02230CLR MOVELBUFFER VAR 15 APKYP 02240CLR EXIT SUBRAJ APKYP 0002250CLR RLABL VL APKYP 02260CLR RLABL VAR APKYP 02270CLR MOVELVAR BUFFER APKYP 02280CLR Z-ADDVL BLNGTH APKYP 02290CLR EXSR EXCPT APKYP 02300CLR CHKVER TAG APKYP 02310CLR EXSR SKIP APKYP 0002320CLR N64 GOTO MOVBUF APKYP 02330CLR TBUF COMP BUFFER 2020 APKYP 02340CLRN20 GOTO MOVBUF APKYP 02350CLR MOVEL'KP VERIF'WORD APKYP 02360CLR MOVE 'Y ERROR 'WORD APKYP 02370CLR MOVELWORD BUFFER APKYP 02380CLR MOVE 'R' TYPE APKYP 0002390CLR Z-ADD6 MASK ONLY 'R' OR 'E'APKYP 02400CLR EXSR CRTCOM APKYP 02410CLR RCODE COMP 'R' 20 APKYP 02420CLR 20 GOTO OUTFLD APKYP 02430CLR MOVBUF TAG APKYP 02440CLR MOVE SEF,N EDCODE 2 APKYP 02450CLR EDCODE COMP ' ' 2424 EDITING? APKYP 0002460CLRN24 GOTO SVFLD APKYP 02470CLR SETOF 30 APKYP 02480CLR EXSR EDIT APKYP 02490CLRN30 GOTO SVFLD APKYP 02500CLR SETOF 30 APKYP 02510CLR N SUB 1 N APKYP 02520CLR GOTO LOOP APKYP 0002530CLR SVFLD TAG APKYP 02540CLR Z-ADD4 WHICH1 APKYP 02550CLR Z-ADDSST,N STRT 30 APKYP 02560CLR Z-ADDSLN,N LEN APKYP 02570CLR EXIT SUBRIN APKYP 02580CLR RLABL WHICH1 APKYP 02590CLR RLABL BUFFER APKYP 0002600CLR RLABL RECORD APKYP 02610CLR RLABL BPOS APKYP 02620CLR RLABL FPOS APKYP 02630CLR RLABL STRT APKYP 02640CLR RLABL LEN APKYP 02650CLR GOTO LOOP APKYP 02660CLR RITDUP TAG APKYP 0002670CLR EXSR MVRECD APKYP 02680CLR SETON 19 APKYP 02690CLR Z-ADDSLN,N BLNGTH APKYP 02700CLR EXSR EXCPT APKYP 02710CLR GOTO MOVBUF APKYP 02720CLR OUTREC TAG APKYP 02730CLR SETON 187084 APKYP 0002740CLR EXCPT APKYP 02750CLR EXSR EXCPT APKYP 02760CLR SETOF 708426 APKYP 02770CLR SEQNO CHAINAPINPT 91 APKYP 02780CLRN91 EXCPT APKYP 02790CLR MOVELRECORD OLDREC128 APKYP 02800CLR SNP,PN COMP 0 22 AUTO PROGRAM APKYP 0002810CLR N22 GOTO NXTREC CHANGE? APKYP 02820CLR SNP,PN COMP 9 2222 CODE .,NEWPROG APKYP 02830CLR N22 EXSR GETPRG APKYP 02840CLR N22 GOTO NXTREC APKYP 02850CLR SNP,PN COMP 8 2222CODE=1-8, APKYP 02860CLR N22 GOTO NXTREC AUTO CHANGE APKYP 02870CLR Z-ADDSNP,PN PN APKYP 0002880CLR EXSR GETPRG APKYP 02890CLR SETOF 22 APKYP 02900CLR GOTO NXTREC APKYP 02910CLR EOJ TAG APKYP 02920C********************************************************************APKYP 02930C********************************************************************APKYP 02940C* *APKYP 0002950C* SUBROUTINE 'EDIT' PERFORMS CUSTOM EDITING. UPON ENTRY, THE *APKYP 02960C* EDIT FLAG IS IN 'EDCODE', THE PROGRAM NAME IS IN THE LEFT-MOST APKYP 02970C* SIX CHARACTERS OF 'WORD', THE RESPONSE IS IN 'BUFFER'. APKYP 02980C* APKYP 02990C* INDICATOR 30 SHOULD BE SET ON BEFORE RETURNING IF YOU WANT THIS APKYP 03000C* FIELD TO BE RE-ENTERED. INDICATORS 31-59 MAY BE USED BY THIS SUBR.APKYP 03010C* APKYP 0003020CSR EDIT BEGSR APKYP 03030CSR EDCODE COMP 'CV' 31 APKYP 03040CSR 31 GOTO ECV APKYP 03050CSR EDCODE COMP 'MC' 31 APKYP 03060CSR 31 GOTO EMC APKYP 03070CSR EDCODE COMP 'MH' 31 MH= MUST HAVE APKYP 03080CSR 31 GOTO EMH APKYP 0003090CSR EDCODE COMP 'DT' 31 APKYP 03100CSR 31 GOTO EDT APKYP 03110CSR EDCODE COMP 'TR' 31 APKYP 03120CSR 31 GOTO ETR APKYP 03130CSR EDCODE COMP 'VN' 31 APKYP 03140CSR 31 GOTO EVN APKYP 03150CSR EDCODE COMP 'IN' 31 APKYP 0003160CSR 31 GOTO EIN APKYP 03170CSR EDCODE COMP 'GL' 31 APKYP 03180CSR 31 GOTO EGL APKYP 03190CSR EDCODE COMP 'CK' 31 APKYP 03200CSR 31 GOTO ECK APKYP 03210CSR EDCODE COMP 'VI' 31 APKYP 03220CSR 31 GOTO EVI APKYP 0003230CSR GOTO ENDEDT APKYP 03240C** APKYP 03250CSR ECV TAG APKYP 03260CSR MOVELBUFFER A1 1 OR 'N'. APKYP 03270CSR A1 COMP 'C' 32 APKYP 03280CSRN32 A1 COMP 'V' 32 APKYP 03290CSR 32 GOTO ENDEDT APKYP 0003300CSR Z-ADD7 NE 20 APKYP 03310CSR GOTO ERREDT APKYP 03320C** APKYP 03330CSR EMC TAG APKYP 03340CSR MOVELBUFFER A1 APKYP 03350CSR A1 COMP 'M' 32 APKYP 03360CSRN32 A1 COMP 'C' 32 APKYP 0003370CSR 32 GOTO ENDEDT APKYP 03380CSR Z-ADD8 NE APKYP 03390CSR GOTO ERREDT APKYP 03400C** APKYP 03410C** APKYP 03420CSR EMH TAG APKYP 03430CSR BUFFER COMP B72 32 APKYP 0003440CSRN32 GOTO ENDEDT APKYP 03450CSR Z-ADD8 NE APKYP 03460CSR GOTO ERREDT APKYP 03470C** APKYP 03480CSR ERREDT TAG DISPLAY ERROR APKYP 03490CSR EXSR SKIP APKYP 03500CSR MOVELEMS,NE BUFFER MESSAGE & APKYP 0003510CSR Z-ADD30 BLNGTH RETRY. APKYP 03520CSR MOVE 'T' TYPE APKYP 03530CSR EXSR CRTCOM APKYP 03540CSR SETON 30 APKYP 03550CSR GOTO ENDEDT APKYP 03560C** APKYP 03570CSR EDT TAG VALIDATE APKYP 0003580CSR MOVELBUFFER A6 6 APKYP 03590CSR MOVELA6 MM 20 00' 99 APKYP 05700CSRN99 62 SEQNO ADD 1 SEQNO APKYP 05710CSRN99 62 GOTO SEQRD APKYP 05720CSR 67 SETON 88 APKYP 05730CSR 88 EXSR EXCPT APKYP 05740CSR SETOF 88 APKYP 0005750CSR 67 EXSR GETSEQ APKYP 05760CSR 67 GOTO SEQRD APKYP 05770CSR ENDSR APKYP 05780C********************************************************************APKYP 05790C* APKYP 05800C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY APKYP 05810C* IS DONE IF A RUBOUT IS USED APKYP 0005820C* APKYP 05830C********************************************************************APKYP 05840CSR TYPES BEGSR APKYP 05850CSR OVER TAG APKYP 05860CSR Z-ADDOLN BLNGTH APKYP 05870CSR MOVELWORD BUFFER APKYP 05880CSR MOVE 'S' TYPE APKYP 0005890CSR EXSR CRTCOM APKYP 05900CSR MOVE 'A' TYPE APKYP 05910CSR Z-ADDILN BLNGTH APKYP 05920CSR EXSR CRTCOM APKYP 05930CSR RCODE COMP 'R' 25 APKYP 05940CSR 25 EXSR SKIP APKYP 05950CSR 25 GOTO OVER APKYP 0005960CSR RCODE COMP 'O' 25 APKYP 05970CSR 25 EXSR SKIP APKYP 05980CSR ENDSR APKYP 05990C********************************************************************APKYP 06000C* APKYP 06010C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT APKYP 06020C* APKYP 0006030C********************************************************************APKYP 06040CSR SKIP BEGSR APKYP 06050CSR MOVELBUFFER NBUF 1 APKYP 06060CSR MOVEL' ' BUFFER APKYP 06070CSR Z-ADD1 BLNGTH APKYP 06080CSR MOVE 'T' TYPE APKYP 06090CSR EXSR CRTCOM APKYP 0006100CSR MOVELNBUF BUFFER APKYP 06110CSR ENDSR APKYP 06120C********************************************************************APKYP 06130C* APKYP 06140C* APKYP 06150C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED APKYP 06160C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER APKYP 0006170C* APKYP 06180CSR MVRECD BEGSR APKYP 06190CSR MOVELB72 BUFFER APKYP 06200CSR Z-ADD2 WHICH1 APKYP 06210CSR Z-ADDSST,N STRT APKYP 06220CSR Z-ADD1 FPOS APKYP 06230CSR Z-ADDSLN,N LEN 20 APKYP 0006240CSR EXIT SUBRIN APKYP 06250CSR RLABL WHICH1 10 APKYP 06260CSR RLABL BUFFER 72 APKYP 06270CSR RLABL RECORD APKYP 06280CSR RLABL BPOS 20 APKYP 06290CSR RLABL FPOS 20 APKYP 06300CSR RLABL STRT 30 APKYP 0006310CSR RLABL LEN 20 APKYP 06320CSR ENDSR APKYP 06330C********************************************************************APKYP 06340CSR EXCPT BEGSR APKYP 06350CSRN81N82N83 APKYP 06360CANN84N88 GOTO PUTOUT APKYP 06370CSR MOVELB72 BUFFER APKYP 0006380CSR 81 MOVELMSG,1 BUFFER APKYP 06390CSR 83 MOVELMSG,2 BUFFER APKYP 06400CSR 88 MOVELMSG,3 BUFFER APKYP 06410CSR 82 MOVELMSG,4 BUFFER APKYP 06420CSRN84 GOTO PUTOUT APKYP 06430CSR MOVELSFN,N BUFFER APKYP 06440CSRN18 SETON 19 APKYP 0006450CSRN18 Z-ADD20 BLNGTH APKYP 06460CSRN18 GOTO PUTOUT APKYP 06470CSR MOVE HEAD BUFFER APKYP 06480CSR MOVELSEQNO WORD8 8 APKYP 06490CSR MOVE WORD8 BUFFER APKYP 06500CSR PUTOUT TAG APKYP 06510CSR MOVE 'S' TYPE APKYP 0006520CSRN19 Z-ADD69 BLNGTH APKYP 06530CSR SETOF 19 APKYP 06540CSR EXSR CRTCOM APKYP 06550CSR ENDSR APKYP 06560C* APKYP 06570C********************************************************************APKYP 06580CSR CLRSCR BEGSR APKYP 0006590CSR MOVE 'C' TYPE APKYP 06600CSR EXSR CRTCOM APKYP 06610CSR ENDSR APKYP 06620CSR ALMTS BEGSR APKYP 06630CSR EXSR CLRSCR APKYP 06640CSR MOVELARY1,1 BUFFER APKYP 06650CSR MOVE 'S' TYPE APKYP 0006660CSR Z-ADD50 BLNGTH APKYP 06670CSR EXSR CRTCOM APKYP 06680CSR MOVE 'A' TYPE APKYP 06690CSR Z-ADD5 BLNGTH APKYP 06700CSR Z-ADD1 DTYPE APKYP 06710CSR EXSR CRTCOM APKYP 06720CSR EXSR SKIP APKYP 0006730CSR RCODE COMP 'R' 86 APKYP 06740CSR Z-ADD5 VL APKYP 06750CSR MOVELBUFFER VAR APKYP 06760CSR EXIT SUBRAJ APKYP 06770CSR RLABL VL APKYP 06780CSR RLABL VAR APKYP 06790CSR MOVELVAR BUFFER APKYP 0006800CSR MOVELBUFFER LOW 50 APKYP 06810CSR MOVELARY1,2 BUFFER APKYP 06820CSR MOVE 'S' TYPE APKYP 06830CSR Z-ADD50 BLNGTH APKYP 06840CSR EXSR CRTCOM APKYP 06850CSR MOVE 'A' TYPE APKYP 06860CSR Z-ADD5 BLNGTH APKYP 0006870CSR Z-ADD1 DTYPE APKYP 06880CSR EXSR CRTCOM APKYP 06890CSR RCODE COMP 'R' 87 APKYP 06900CSR Z-ADD5 VL APKYP 06910CSR MOVELBUFFER VAR APKYP 06920CSR EXIT SUBRAJ APKYP 06930CSR RLABL VL APKYP 0006940CSR RLABL VAR APKYP 06950CSR MOVELVAR BUFFER APKYP 06960CSR MOVELBUFFER HIGH 50 APKYP 06970CSR MOVE 'C' TYPE APKYP 06980CSR EXSR CRTCOM APKYP 06990CSR 86 APKYP 07000COR 87 GOTO ALMTS APKYP 0007010CSR Z-ADD0 DTYPE APKYP 07020CSR ENDSR APKYP 07030CSR CRTCOM BEGSR APKYP 07040CSR EXITFSUBRCM APKYP 07050CSR RLABL BUFFER 72 APKYP 07060CSR RLABL TYPE 1 APKYP 07070CSR RLABL BLNGTH 20 APKYP 0007080CSR RLABL RCODE 1 APKYP 07090CSR RLABL MASK 10 APKYP 07100CSR RLABL DTYPE 10 APKYP 07110CSR ENDSR APKYP 07120CSR PUTSEQ BEGSR APKYP 07130CSR MOVELMSG,5 BUFFER APKYP 07140CSR MOVE 'S' TYPE APKYP 0007150CSR Z-ADD25 BLNGTH APKYP 07160CSR EXSR CRTCOM APKYP 07170CSR MOVELSEQNO BUFFER APKYP 07180CSR MOVE 'T' TYPE APKYP 07190CSR Z-ADD5 BLNGTH APKYP 07200CSR EXSR CRTCOM APKYP 07210CSR ENDSR APKYP 0007220CSR TSTSEQ BEGSR APKYP 07230CSR SETOF 949697 APKYP 07240CSR SEQNO COMP LOW 989698 APKYP 07250CSR 98 SEQNO COMP HIGH 979898 APKYP 07260CSR 98 GOTO ENDTST APKYP 07270CSR 62 96 MOVELMSG,6 BUFFER APKYP 07280CSR 62 97 MOVELMSG,7 BUFFER APKYP 0007290CSRN62 MOVELMSG,8 BUFFER APKYP 07300CSRN62 SETON 94 APKYP 07310CSR MOVE 'T' TYPE APKYP 07320CSR Z-ADD25 BLNGTH APKYP 07330CSR EXSR CRTCOM APKYP 07340CSR 62 97 MOVE 'F' TYPE APKYP 07350CSR 62 97 EXSR CRTCOM APKYP 0007360CSR ENDTST ENDSR APKYP 07370OAPINPT E 70N67 APKYP 07380O RECORD 128 APKYP 07390O 64 128 'X' APKYP 07400O SEQNO 127 APKYP 07410OVENINV EADD 75N70N91 APKYP 07420O VENV 13 APKYP 0007430O GROSS 22 APKYP 07440O DISC 29 APKYP 07450O 30 'I' APKYP 07460O 76 30 'C' APKYP 07470O E N32 63N70 APKYP 07480O AND N91 APKYP 07490O GROSS 22 APKYP 0007500O DISC 29 APKYP ** 007510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 007520ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 007530ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 007540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 007550** 00756000ENTER BEGINNING RELATIVE RECORD NUMBER 007570ENTER ENDING RELATIVE RECORD NUMBER 007580** 007590MODE MUST BE A,C,V,OR E 007600FIRST FIELD NAME BLANK 007610INVALID SEQ # 007620PROG# MUST BE FROM 1-8 00763000CURRENT SEQUENCE NBR 007640SEQNO TOO LOW 007650RUNEDIT PROG FILE FULL 007660SEQNO NOT IN YOUR LIMITS 007670** 007680 * MUST BE 'IN' OR 'MC' * 007690 * INVALID DATE * 00770000 * INVALID VENDOR # * 007710 * VENDOR/INVOICE NOT ON FILE * 007720 * ACCT # IS INVALID * 007730 * CHECK # IS NOT OUTSTANDING * 007740 * VENDOR/INV# NOT NEW ** 007750 * MUST NOT BE BLANK * 007760/* 00777000__NVALID VENDOR # * 007710 * VENDOR/INVOICE NOT ON FILE * 007720 * ACCT # IS INVALID * 007730 * CHECK # IS NOT OUTSTANDING * 007740 * VENDOR/INV# NOT NEW ** 007750 * MUST NOT BE BLANK * 007760/* 0077700(&@Z TXGL010 P999999032778(000010H S GL010 00020X DECK-ID A75 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL010 00030F* THIS PROGRAM DOES THE CRT UPDATING OF THE GLMAST FILE GL010 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL010 00060F* CONTROL DATA PROPRIETARY PRODUCT GL010 00070F* GL010 0000080FDUMMY IPEAF 72 DISK GL010 00090FPARAM1 IC F 32R DISK GL010 00100FGLMAST UC F 280R10AI 1 DISK A GL010 00110F* GL010 00120F* COMPUSOURCE GENERAL LEDGER SYSTEM. -MASTERFILE UPDATE- GL010 00130F* GL010 00140F**************************************************************** GL010 0000150F* * GL010 00160F* THIS PROGRAM ADDS AND CHANGES RECORDS ON G/L * GL010 00170F* MASTER FILE 'GLMAST' . THE PROGRAM IS A * GL010 00180F* MODIFICATION OF PACKAGE FILE MAINT PROGRAM. * GL010 00190F* * GL010 00200F**************************************************************** GL010 00210F* ID F C H L FUNCTION OF INDICATORS GL010 0000220F* 01 READ FROM DUMMY FILE TO INITIATE PROGRAM GL010 00230F* 02 READ FROM THE PARAMETER FILE GL010 00240F* 03 CHAIN TO UPDATE FILE GL010 00250F* 30 MULTIPLE USES GL010 00260F* 31 MULTIPLE USES GL010 00270F* 32 MULTIPLE USES GL010 00280F* 33 MULTIPLE USES GL010 0000290F* 34 MULTIPLE USES GL010 00300F* 35 MULTIPLE USES GL010 00310F* 37 MULTIPLE USES GL010 00320F* 40 MULTIPLE USES GL010 00330F* 41 MULTIPLE USES GL010 00340F* 45 MULTIPLE USES GL010 00350F* 50 CHAIN TO PARAMETER FILE WAS NO HIT GL010 0000360F* 55 CHAIN TO UPDATE FILE WAS NO HIT GL010 00370F* 61 MULTIPLE USES GL010 00380F* 62 MULTIPLE USES GL010 00390F* 80 FOR EXCEPTION OUT PUT OF UPDATE FILE GL010 00400E FN 40 22 FIELD NAME GL010 00410E CP 40 4 CURSOR POSITION GL010 00420E LN 40 2 0 LENGTH GL010 0000430E EP 40 3 0 ENDING POSITION GL010 00440E RN 10 4 0 GL010 00450IDUMMY NS 01 GL010 00460I 1 1 A GL010 00470IPARAM1 NS 02 GL010 00480I 1 22 FIELDN GL010 00490I 23 26 CURPOS GL010 0000500I 27 280LNGTH GL010 00510I 29 310ENDPOS GL010 00520I 32 320SET GL010 00530I 1 31 ALLREC GL010 00540IGLMAST NS 03 GL010 00550I 1 256 RECORD GL010 00560I 257 280 LEFT01 GL010 0000570C MOVE ' ' RCODE 1 GL010 00580C Z-ADD1 ONE 10 GL010 00590C MOVE ' ' BLANKS 72 GL010 00600C MOVE ' ' B256 256 GL010 00610C MOVE ' ' B31 31 GL010 00620C SETON LR GL010 00630CLR START TAG GL010 0000640CLR EXSR FIRSTP GL010 00650CLR SECTON COMP 'E' 40 GL010 00660CLR 40 GOTO EOJ GL010 00670CLR Z-ADD1 SECTN 10 GL010 00680CLR EXSR GETSEC GL010 00690CLRN45 GOTO START GL010 00700CLR EXSR CLRSCR GL010 0000710CLR EXSR OUTPUT GL010 00720CLR MOVEL'1001' BUFFER GL010 00730CLR EXSR POSCUR GL010 00740CLR MOVELKEY BUFFER GL010 00750CLR Z-ADD10 BLNGTH GL010 00760CLR MOVE 'S' TYPE GL010 00770CLR EXSR CRTCOM GL010 0000780CLR EXSR UPDATE GL010 00790CLR GOTO START GL010 00800CLR EOJ TAG GL010 00810C********************************************************************GL010 00820C* GL010 00830C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND GL010 00840C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. GL010 0000850C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDGL010 00860C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN GL010 00870C* GL010 00880C********************************************************************GL010 00890CSR FIRSTP BEGSR GL010 00900CSR EXSR CLRSCR GL010 00910CSR Z-ADD0 SECTN 10 GL010 0000920CSR EXSR GETSEC GL010 00930CSR PGE TAG GL010 00940CSR SETON 6162 GL010 00950CSR EXSR OUTPUT GL010 00960CSR Z-ADDKX X 20 GL010 00970CSR EXSR ACCEPT GL010 00980CSR MOVELBUFFER SECTON 1 GL010 0000990CSR Z-ADD10 VL GL010 01000CSR MOVELBUFFER VAR GL010 01010CSR EXSR RTADJ GL010 01020CSR MOVELVAR BUFFER GL010 01030CSR MOVELBUFFER KEY 10 GL010 01040CSR KEY CHAINGLMAST 55 GL010 01050CSRN55 GOTO SKIPMS GL010 0001060CSR MOVELB256 RECORD GL010 01070CSR MOVELB256 LEFT01 GL010 01080CSR MOVELSAVPOS BUFFER GL010 01090CSR MOVELOFC BUFFER GL010 01100CSR EXSR POSCUR GL010 01110CSR MOVEL' NEW RE'WORD16 16 GL010 01120CSR MOVE 'CORD 'WORD16 GL010 0001130CSR MOVELWORD16 BUFFER 72 GL010 01140CSR MOVE 'T' TYPE 1 GL010 01150CSR Z-ADD12 BLNGTH 20 GL010 01160CSR EXSR CRTCOM GL010 01170CSR SKIPMS TAG GL010 01180CSR SETOF 62 GL010 01190CSR SETOF 61 GL010 0001200CSR ENDSR GL010 01210C********************************************************************GL010 01220C* GL010 01230C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. GL010 01240C* GL010 01250C********************************************************************GL010 01260CSR GETSEC BEGSR GL010 0001270CSR 1 ADD SECTN N 20 GL010 01280CSR SETOF 404145 GL010 01290CSR N COMP 0 3030 GL010 01300CSRN30 N COMP 5 30 30 GL010 01310CSR 30 GOTO ENDGET GL010 01320CSR RN,N COMP 0 4040 GL010 01330CSRN40 RN,N SUB 1 RRN 40 GL010 0001340CSR 40 Z-ADD0 RRN GL010 01350CSR Z-ADD1 X 20 GL010 01360CSR SCLOOP TAG GL010 01370CSR RRN ADD 1 RRN GL010 01380CSR RRN CHAINPARAM1 50 GL010 01390CSR 50 GOTO ENDGET GL010 01400CSR SECTN COMP SET 41 GL010 0001410CSR 41 ALLREC COMP B31 50 GL010 01420CSR 50 GOTO ENDGET GL010 01430CSRN41 GOTO SCLOOP GL010 01440CSR 41N45 SETON 45 GL010 01450CSR 40 41 Z-ADDRRN RN,N GL010 01460CSR 40 41 SETOF 40 GL010 01470CSR MOVE FIELDN FN,X GL010 0001480CSR MOVE CURPOS CP,X GL010 01490CSR MOVE LNGTH LN,X GL010 01500CSR MOVE ENDPOS EP,X GL010 01510CSR 1 ADD X X GL010 01520CSR X COMP 40 32 GL010 01530CSRN32 GOTO SCLOOP GL010 01540CSR ENDGET TAG GL010 0001550CSR Z-ADDX NOFLDS 20 GL010 01560CSR 45 GOTO FINGET GL010 01570CSR EXSR CLRSCR GL010 01580CSR MOVEL'SECTION 'WORD9 9 GL010 01590CSR MOVE SECTN WORD9 GL010 01600CSR MOVELWORD9 WORD16 16 GL010 01610CSRN30 MOVE ' ABSENT' WORD16 GL010 0001620CSR 30 MOVE ' ILLEG.' WORD16 GL010 01630CSR MOVELWORD16 BUFFER GL010 01640CSR MOVEL'R' TYPE GL010 01650CSRN61 Z-ADD6 MASK 10 GL010 01660CSR 61 Z-ADD1 MASK GL010 01670CSR EXSR CRTCOM GL010 01680CSR FINGET ENDSR GL010 0001690C********************************************************************GL010 01700C* GL010 01710C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE GL010 01720C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE KEY GL010 01730C* INDEX AND SECTION INDEX IS SAVED. GL010 01740C* GL010 01750C********************************************************************GL010 0001760CSR OUTPUT BEGSR GL010 01770CSR Z-ADD1 X GL010 01780CSR OTLOOP TAG GL010 01790CSR 61 EP,X COMP 1 31 GL010 01800CSR 61 31 Z-ADDX KX 20 KEY FIELD INDEXGL010 01810CSR 61 EP,X COMP 2 31 GL010 01820CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXGL010 0001830CSR EXSR OUTFLD GL010 01840CSR X ADD 1 X GL010 01850CSR X COMP NOFLDS 31 GL010 01860CSR 31 GOTO OTLOOP GL010 01870CSR ENDSR GL010 01880C********************************************************************GL010 01890C* GL010 0001900C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND GL010 01910C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 GL010 01920C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS GL010 01930C* THEN NO FIELD INFORMATION IS PRINTED GL010 01940C* GL010 01950C********************************************************************GL010 01960CSR OUTFLD BEGSR GL010 0001970CSR MOVE FN,X FL 20 GL010 01980CSR MOVELCP,X FC 20 GL010 01990CSR FC COMP FL 31 GL010 02000CSR 31 Z-ADDFC FL GL010 02010CSR FC SUB FL CC 20 GL010 02020CSR CC ADD 1 CC GL010 02030CSR MOVELCP,X BUFFER GL010 0002040CSR MOVELCC BUFFER GL010 02050CSR EXSR POSCUR GL010 02060CSR MOVELBLANKS BUFFER GL010 02070CSR MOVELFN,X FIELDN GL010 02080CSR MOVE ' ' FIELDN GL010 02090CSR MOVELFIELDN BUFFER GL010 02100CSR Z-ADDLN,X LEN 20 GL010 0002110CSR LEN COMP 0 3130 GL010 02120CSR 31 Z-SUBLN,X LEN GL010 02130CSR 30 GOTO SKIPF GL010 02140CSR FL ADD 2 BPOS 20 GL010 02150CSR MOVE '1' WHICH1 10 GL010 02160C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS GL010 02170CSR EXIT SUBRIN GL010 0002180CSR RLABL WHICH1 10 GL010 02190CSR RLABL BUFFER 72 GL010 02200CSR RLABL RECORD GL010 02210CSR RLABL BPOS 20 GL010 02220CSR RLABL FPOS 20 GL010 02230CSR RLABL STRT 30 GL010 02240CSR RLABL LEN 20 GL010 0002250CSR BPOS ADD 1 FPOS 20 GL010 02260CSR EXSR MVRECD GL010 02270CSR SKIPF TAG GL010 02280CSR 30 Z-ADDFL BLNGTH GL010 02290CSRN30 FL ADD 3 BLNGTH GL010 02300CSRN30 BLNGTH ADD LEN BLNGTH GL010 02310CSR MOVE 'T' TYPE GL010 0002320CSR EXSR CRTCOM GL010 02330CSR ENDSR GL010 02340C********************************************************************GL010 02350C* GL010 02360C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN GL010 02370C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST GL010 02380C* THE RIGHT BRACKET. GL010 0002390C********************************************************************GL010 02400CSR MVRECD BEGSR GL010 02410CSR 61 GOTO RBRK GL010 02420CSR EP,X SUB LEN STRT 30 GL010 02430CSR STRT ADD 1 STRT GL010 02440CSR MOVE '2' WHICH1 GL010 02450C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER GL010 0002460C* FROM STRT IN RECORD TO FPOS IN BUFFER GL010 02470CSR EXIT SUBRIN GL010 02480CSR RLABL WHICH1 10 GL010 02490CSR RLABL BUFFER 72 GL010 02500CSR RLABL RECORD GL010 02510CSR RLABL BPOS 20 GL010 02520CSR RLABL FPOS 20 GL010 0002530CSR RLABL STRT 30 GL010 02540CSR RLABL LEN 20 GL010 02550CSR RBRK TAG GL010 02560CSR EXSR RTBRKT GL010 02570CSR ENDSR GL010 02580C********************************************************************GL010 02590C* GL010 0002600C* THIS ROUTINE INSERTS A '(' IN BUFFER AT FPOS GL010 02610C* GL010 02620C********************************************************************GL010 02630CSR RTBRKT BEGSR GL010 02640CSR LEN ADD FPOS FPOS GL010 02650CSR MOVE '3' WHICH1 GL010 02660CSR EXIT SUBRIN GL010 0002670CSR RLABL WHICH1 10 GL010 02680CSR RLABL BUFFER 72 GL010 02690CSR RLABL RECORD GL010 02700CSR RLABL BPOS 20 GL010 02710CSR RLABL FPOS 20 GL010 02720CSR RLABL STRT 30 GL010 02730CSR RLABL LEN 20 GL010 0002740CSR ENDSR GL010 02750C********************************************************************GL010 02760C* GL010 02770C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. GL010 02780C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO GL010 02790C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF GL010 02800C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST GL010 0002810C* OF THE FIELDS ARE LEFT UNCHANGED GL010 02820C* GL010 02830C********************************************************************GL010 02840CSR UPDATE BEGSR GL010 02850CSR SETOF 32 GL010 02860CSRN55 Z-ADD21 NOFLDS GL010 02870CSR Z-ADD1 X GL010 0002880CSR UPLOOP TAG GL010 02890CSR Z-ADDLN,X LEN GL010 02900CSR LEN COMP 0 3730 GL010 02910CSR 37 Z-SUBLEN LEN GL010 02920CSR 30N32 GOTO INCR GL010 02930CSR 30 GOTO CHKRUB GL010 02940CSR SETOF 3233 GL010 0002950CSR EXSR ACCEPT GL010 02960CSR CHKRUB TAG GL010 02970CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTGL010 02980CSR 32 31 GOTO UPLOOP GL010 02990CSR 32 GOTO ENDUPD GL010 03000CSR MOVELBUFFER ATSIGN 1 GL010 03010CSR ATSIGN COMP '@' 35 GL010 0003020CSR 35 GOTO OUTREC GL010 03030CSR 33 GOTO INCR WAS LINE FEED GL010 03040CSR SECTN COMP 1 90 GL010 03050CSRN90 GOTO LEE1 GL010 03060CSR X COMP 4 90 GL010 03070CSRN90 GOTO LEE1 GL010 03080CSR MOVELBUFFER SV1 1 GL010 0003090CSR SV1 COMP 'A' 91 GL010 03100CSRN91 SV1 COMP 'L' 91 GL010 03110CSRN91 SV1 COMP 'R' 91 GL010 03120CSRN91 SV1 COMP 'E' 91 GL010 03130CSRN91 GOTO UPLOOP GL010 03140CSR LEE1 TAG GL010 03150CSR SECTN COMP 1 90 GL010 0003160CSRN90 GOTO LEE2 GL010 03170CSR X COMP 6 90 GL010 03180CSRN90 GOTO LEE2 GL010 03190CSR MOVELBUFFER SV2 1 GL010 03200CSR SV2 COMP 'D' 91 GL010 03210CSRN91 SV2 COMP 'C' 91 GL010 03220CSRN91 GOTO UPLOOP GL010 0003230CSR LEE2 TAG GL010 03240CSR EP,X SUB LEN STRT GL010 03250CSR STRT ADD 1 STRT GL010 03260CSR MOVE '4' WHICH1 GL010 03270C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF GL010 03280C* BUFFER TO THE STRT OF RECORD GL010 03290CSR EXIT SUBRIN GL010 0003300CSR RLABL WHICH1 10 GL010 03310CSR RLABL BUFFER 72 GL010 03320CSR RLABL RECORD GL010 03330CSR RLABL BPOS 20 GL010 03340CSR RLABL FPOS 20 GL010 03350CSR RLABL STRT 30 GL010 03360CSR RLABL LEN 20 GL010 0003370CSR 37 EXSR OUTFLD GL010 03380CSR INCR TAG GL010 03390CSR X ADD 1 X GL010 03400CSR X COMP NOFLDS 30 GL010 03410CSR 30 GOTO UPLOOP GL010 03420CSR OUTREC TAG GL010 03430CSR SETON 80 GL010 0003440CSR EXCPT GL010 03450CSR SETOF 80 GL010 03460CSR ENDUPD TAG GL010 03470CSR ENDSR GL010 03480C********************************************************************GL010 03490C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE GL010 03500C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X GL010 0003510C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND GL010 03520C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT GL010 03530C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED GL010 03540C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS GL010 03550C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS GL010 03560C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO GL010 03570C* TO BE OUTPUT TO THE SCREEN. GL010 0003580C* GL010 03590C********************************************************************GL010 03600CSR ACCEPT BEGSR GL010 03610CSR X COMP 1 30 GL010 03620CSRN30 X COMP 40 30 GL010 03630CSR 30 Z-ADD1 X GL010 03640CSR MOVELCP,X FC 20 GL010 0003650CSR FC ADD 3 FC GL010 03660CSR MOVELCP,X SAVPOS 4 GL010 03670CSR MOVELFC SAVPOS GL010 03680CSR LN,X ADD FC OFC 20 GL010 03690CSR OFC ADD 1 OFC GL010 03700CSR Z-ADDLN,X LEN GL010 03710CSR LEN COMP 0 34 GL010 0003720CSR 34 Z-SUBLEN LEN GL010 03730CSR ACLOOP TAG GL010 03740CSR MOVELSAVPOS BUFFER GL010 03750CSR EXSR POSCUR GL010 03760CSR Z-ADDLEN BLNGTH GL010 03770CSR MOVE 'A' TYPE GL010 03780CSR EXSR CRTCOM GL010 0003790CSR RCODE COMP 'R' 31 GL010 03800CSR 31 BUFFER COMP BLANKS 32 GL010 03810CSR 31 32N61 GOTO ENDACC GL010 03820CSR 31 GOTO ACLOOP GL010 03830CSR RCODE COMP 'L' 33 GL010 03840CSR 33 GOTO DUPIT GL010 03850CSRN34 GOTO ENDACC GL010 0003860CSR MOVELBUFFER SIGN 1 WE MUST CHECK GL010 03870CSR SIGN COMP '@' 30 GL010 03880CSR 30 GOTO ENDACC GL010 03890CSR Z-ADDLEN VL 20 GL010 03900CSR MOVELBUFFER VAR 15 GL010 03910CSR EXSR RTADJ GL010 03920CSR MOVELVAR BUFFER GL010 0003930CSR GOTO ENDACC GL010 03940CSR DUPIT TAG GL010 03950CSRN61 EXSR OUTFLD GL010 03960CSRN61 GOTO ENDACC GL010 03970CSR MOVELSAVPOS BUFFER GL010 03980CSR EXSR POSCUR GL010 03990CSR 62 MOVELKEY BUFFER GL010 0004000CSRN62 MOVELSECTON BUFFER GL010 04010CSR MOVE 'T' TYPE GL010 04020CSR EXSR CRTCOM GL010 04030CSR ENDACC ENDSR GL010 04040C********************************************************************GL010 04050C* GL010 04060C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES GL010 0004070C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM GL010 04080C* 4 DUMMY FOR RTADJ GL010 04090C* GL010 04100C********************************************************************GL010 04110CSR POSCUR BEGSR GL010 04120CSR MOVE 'P' TYPE GL010 04130CSR EXSR CRTCOM GL010 0004140CSR ENDSR GL010 04150C********************************************************************GL010 04160CSR CLRSCR BEGSR GL010 04170CSR MOVE 'C' TYPE GL010 04180CSR EXSR CRTCOM GL010 04190CSR ENDSR GL010 04200C********************************************************************GL010 0004210CSR CRTCOM BEGSR GL010 04220CSR EXITFSUBRCM GL010 04230CSR RLABL BUFFER 72 GL010 04240CSR RLABL TYPE 1 GL010 04250CSR RLABL BLNGTH 20 GL010 04260CSR RLABL RCODE 1 GL010 04270CSR RLABL MASK 10 GL010 0004280CSR RLABL DTYPE 10 GL010 04290CSR ENDSR GL010 04300C********************************************************************GL010 04310CSR RTADJ BEGSR GL010 04320CSR EXIT SUBRAJ GL010 04330CSR RLABL VL GL010 04340CSR RLABL VAR GL010 0004350CSR ENDSR GL010 04360C********************************************************************GL010 04370OGLMAST E 80N55 GL010 04380O RECORD 256 GL010 04390O LEFT01 280 GL010 04400O EADD 80 55 GL010 04410O RECORD 256 GL010 0004420O LEFT01 280 GL010 04430O KEY 10 GL010 ** 004440ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 004450ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004460ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004470ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00448000/* 004490__0O KEY 10 GL010 ** 004440ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 004450ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004460ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004470ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0044800(AA 7TXGL011 P999999032778(000010H S GL011 00020X DECK-ID A76 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL011 00030F* THIS PROGRAM PURGES GLMAST FILE OF RECORDS FLAGGED FOR DELETION GL011 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL011 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL011 00060F* CONTROL DATA PROPRIETARY PRODUCT GL011 00070F* GL011 0000080FGLMAST IP F 280 10AI 1 DISK GL011 00090FNEWMAST O F 280 10AI 1 DISK GL011 00100IGLMAST NS 01 GL011 00110I 1 148 HALF GL011 00120I 149 270 FOURTH GL011 00130I 271 271 DELCOD GL011 00140I 272 280 LAST GL011 0000150C DELCOD COMP 'D' 111112 GL011 00160ONEWMAST D 11N12 GL011 00170O HALF 148 GL011 00180O FOURTH 270 GL011 00190O DELCOD 271 GL011 00200O LAST 280 GL011 ** 00021000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000250/* 000260__0O LAST 280 GL011 ** 0002100(Ay ;CTXGL012 P999999032778(000010H S GL012 00020X DECK-ID A77 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL012 00030F* THIS PROGRAM PROVIDES A LISTING OF THE GLSEQ FILE GL012 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL012 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL012 00060F* CONTROL DATA PROPRIETARY PRODUCT GL012 00070F* GL012 0000080FGLHEAD IP F 64 DISK GL012 00090FGLSEQ IS F 128 DISK GL012 00100F$LP1 O F 132 OF PRINTER GL012 00110F********************************************************************GL012 00120F* LISTS FINANCIAL STATEMENT SEQUENCE FILE, GLSEQ. *GL012 00130F********************************************************************GL012 00140IGLHEAD NS 01 GL012 0000150I 1 40 COHEAD GL012 00160IGLSEQ NS 02 1 CS GL012 00170I 2 110ACCTN GL012 00180I 12 12 EFFCO GL012 00190I 13 130SPACO GL012 00200I 14 53 DESCR GL012 00210I 54 540PPOS GL012 0000220I NS 03 GL012 00230I 1 1 X GL012 00240C 01 SETON 90 GL012 00250C N01 SEQNO ADD 1 SEQNO 30 GL012 00260O$LP1 D 02 01 90 GL012 00270O OR OF GL012 00280O COHEAD 41 GL012 0000290O D 2 01 90 GL012 00300O OR OF GL012 00310O 16 'CGL012 LIST OF' GL012 00320O 36 'FINANCIAL STATEMENT' GL012 00330O 53 'SEQUENCE NUMBERS' GL012 00340O UDATE Y 63 GL012 00350O 70 'PAGE' GL012 0000360O PAGE Z 74 GL012 00370O D 2 01 90 GL012 00380O OR OF GL012 00390O 28 'ACCOUNT EFF SPACE' GL012 00400O 73 'PRNT' GL012 00410O D 11 01 90 GL012 00420O OR OF GL012 0000430O 5 'SEQ#' GL012 00440O 18 'NUMBER' GL012 00450O 40 'DESCRIPTION' GL012 00460O 73 'POS' GL012 00470O D 1 02 GL012 00480O SEQNO Z 5 GL012 00490O ACCTN Z 18 GL012 0000500O EFFCO 21 GL012 00510O SPACO 27 GL012 00520O DESCR 69 GL012 00530O PPOS Z 72 GL012 ** 000540ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000550ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00056000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000570ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000580/* 000590__0O PPOS Z 72 GL012 ** 000540ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000550ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0005600(A mTXGL013 P999999032778(000010H S GL013 00020X DECK-ID A78 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL013 00030F* THIS PROGRAM VERIFIES UPDATE MONTH OF THE GLMAST FILE THROUGH CRT GL013 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL013 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL013 00060F* CONTROL DATA PROPRIETARY PRODUCT GL013 00070F* GL013 0000080FGLMAST UP F 280 10AI 1 DISK GL013 00090F* GL013 00100F* CRT PROGRAM TO VERIFY THE MONTH-OF-LAST-UPDATE FIELD IN THE GL013 00110F* FIRST RECORD ON GLMAST. GL013 00120F* GL013 00130E MSG 1 8 50 GL013 00140E MOS 12 12 3 GL013 0000150IGLMAST NS 01 GL013 00160I 1 10 ACCT GL013 00170I 269 2700LM GL013 00180C 10 SETON LR11 GL013 00190C 10 GOTO LAST GL013 00200C* GL013 00210C MOVELMSG,1 BUFFER 72 GL013 0000220C Z-ADD45 BLNGTH 20 GL013 00230C EXSR SOUT GL013 00240C MOVELACCT BUFFER GL013 00250C Z-ADD10 BLNGTH GL013 00260C EXSR TOUT GL013 00270C MOVELMSG,2 BUFFER GL013 00280C Z-ADD51 BLNGTH GL013 0000290C EXSR TOUT GL013 00300C MOVELMSG,3 BUFFER GL013 00310C Z-ADD20 BLNGTH GL013 00320C EXSR SOUT GL013 00330C LM ADD 1 CM 20 GL013 00340C CM COMP 12 21 GL013 00350C 21 Z-ADD1 CM GL013 0000360C Z-ADDCM TM 20 GL013 00370C MOVE ')' A8 8 GL013 00380C MOVE '( ' A7 7 GL013 00390C MOVE MOS,CM A7 GL013 00400C MOVELCM A7 GL013 00410C MOVELA7 A8 GL013 00420C MOVELA8 BUFFER GL013 0000430C Z-ADD8 BLNGTH GL013 00440C EXSR SOUT GL013 00450C EXSR YORN GL013 00460C N25 GOTO NOTAG GL013 00470C YESTAG TAG GL013 00480C MOVEL' OK' BUFFER GL013 00490C Z-ADD4 BLNGTH GL013 0000500C EXSR TOUT GL013 00510C GOTO LAST GL013 00520C* GL013 00530C NOTAG TAG GL013 00540C MOVELMSG,6 BUFFER GL013 00550C Z-ADD50 BLNGTH GL013 00560C EXSR TOUT GL013 0000570C MOVELMSG,7 BUFFER GL013 00580C Z-ADD35 BLNGTH GL013 00590C EXSR SOUT GL013 00600C Z-ADD2 BLNGTH GL013 00610C MOVE 'A' TYPE GL013 00620C EXITFSUBRCM GL013 00630C RLABL BUFFER 72 GL013 0000640C RLABL TYPE 1 GL013 00650C RLABL BLNGTH 20 GL013 00660C RLABL RCODE 1 GL013 00670C RLABL MASK 10 GL013 00680C RLABL DTYPE 10 GL013 00690C MOVELBUFFER TM 20 GL013 00700C TM COMP 1 22 22 GL013 0000710C 22 TM COMP 12 2222 GL013 00720C N22 Z-ADD1 TM GL013 00730C EXSR SPACE GL013 00740C MOVELMSG,8 BUFFER GL013 00750C Z-ADD16 BLNGTH GL013 00760C EXSR SOUT GL013 00770C MOVE 'FOR ' A10 10 GL013 0000780C MOVE MOS,TM A10 GL013 00790C MOVELTM A10 GL013 00800C MOVELA10 BUFFER GL013 00810C Z-ADD10 BLNGTH GL013 00820C EXSR SOUT GL013 00830C EXSR YORN GL013 00840C 25 GOTO YESTAG GL013 0000850C GOTO NOTAG GL013 00860C* GL013 00870C LAST TAG GL013 00880C SETON 10LR GL013 00890C TM COMP CM 2323 GL013 00900C 23 TM SUB 1 TM 2424 GL013 00910C 23 24 Z-ADD12 TM GL013 0000920C********************************************************************GL013 00930CSR SOUT BEGSR GL013 00940CSR MOVE 'S' TYPE 1 GL013 00950CSR EXITFSUBRCM GL013 00960CSR RLABL BUFFER 72 GL013 00970CSR RLABL TYPE 1 GL013 00980CSR RLABL BLNGTH 20 GL013 0000990CSR RLABL RCODE 1 GL013 01000CSR RLABL MASK 10 GL013 01010CSR RLABL DTYPE 10 GL013 01020CSR ENDSR GL013 01030C********************************************************************GL013 01040CSR TOUT BEGSR GL013 01050CSR MOVE 'T' TYPE GL013 0001060CSR EXITFSUBRCM GL013 01070CSR RLABL BUFFER 72 GL013 01080CSR RLABL TYPE 1 GL013 01090CSR RLABL BLNGTH 20 GL013 01100CSR RLABL RCODE 1 GL013 01110CSR RLABL MASK 10 GL013 01120CSR RLABL DTYPE 10 GL013 0001130CSR ENDSR GL013 01140C********************************************************************GL013 01150CSR SPACE BEGSR GL013 01160CSR MOVEL' ' BUFFER GL013 01170CSR Z-ADD2 BLNGTH GL013 01180CSR EXSR TOUT GL013 01190CSR ENDSR GL013 0001200C********************************************************************GL013 01210CSR YORN BEGSR GL013 01220CSR MOVELMSG,4 BUFFER GL013 01230CSR Z-ADD25 BLNGTH GL013 01240CSR EXSR SOUT GL013 01250CSR Z-ADD1 BLNGTH GL013 01260CSR MOVE 'A' TYPE GL013 0001270CSR EXITFSUBRCM GL013 01280CSR RLABL BUFFER 72 GL013 01290CSR RLABL TYPE 1 GL013 01300CSR RLABL BLNGTH 20 GL013 01310CSR RLABL RCODE 1 GL013 01320CSR RLABL MASK 10 GL013 01330CSR RLABL DTYPE 10 GL013 0001340CSR MOVELBUFFER YTEST 1 GL013 01350CSR YTEST COMP 'Y' 25 GL013 01360CSR EXSR SPACE GL013 01370CSR ENDSR GL013 01380C********************************************************************GL013 01390OGLMAST D 01 23N11 GL013 01400O TM 270 GL013 00** 001410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001420ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001450** 001460 ACCORDING TO THE 1ST ACCOUNT ON FILE, ACCT# 00147000 THE CURRENT MONTH FOR WHICH TRANSACTIONS ARE TO BE 001480 PROCESSED IS MONTH 001490. IS THIS CORRECT? (Y/N) 001500 OK 001510 NO, ENTER THE NUMBER OF THE CURRENT MONTH BELOW 001520 (01=JAN, 02=FEB, ... 12=DEC) 001530 YOU ENTERED 00154000** 001550JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 001560/* 001570__ 001510 NO, ENTER THE NUMBER OF THE CURRENT MONTH BELOW 001520 (01=JAN, 02=FEB, ... 12=DEC) 001530 YOU ENTERED 0015400(B+ jXTXGL015 P999999032778(000010H S GL015 00020X DECK-ID A79 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL015 00030F* THIS PROGRAM LISTS THE GENERAL LEDGER MASTER FILE GL015 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL015 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL015 00060F* CONTROL DATA PROPRIETARY PRODUCT GL015 00070F* GL015 0000080FGLHEAD IP AF 64 DISK GL015 00090FGLMAST IS AF 280 10AI 1 DISK GL015 00100F$LP1 O F 132 OF PRINTER GL015 00110F********************************************************************GL015 00120F* GL015 00130F* LISTS THE GENERAL LEDGER MASTERFILE, GLMAST. GL015 00140F* GL015 0000150F********************************************************************GL015 00160F* FUNCTION OF INDICATORS GL015 00170F* 01--> HEADING RECORD GL015 00180F* 02--> MASTERFILE RECORD GL015 00190F* 40--> SUBTRACT 12 TO GET REAL MONTH GL015 00200F* 50--> CONTINUE WITH MONTH LOOP GL015 00210F* 52--> LAST MONTH OF LOOP-PRINT CURR BALANCE GL015 0000220E B 12 8 0 GL015 00230E C 12 10 2 GL015 00240E M 12 12 3 GL015 00250IGLHEAD NS 01 GL015 00260I 1 40 HEAD GL015 00270I 41 440FMYCFY GL015 00280IGLMAST NS 02 GL015 0000290I 1 100ACCNO GL015 00300I 11 11 TYPE GL015 00310I 12 12 SIGN GL015 00320I 13 42 DESC GL015 00330I 43 522BALFWD GL015 00340I 53 148 B GL015 00350I 149 268 C GL015 0000360C N01 GOTO NOT01 GL015 00370C MOVE FMYCFY Y 20 YEAR FIS YR BEGGL015 00380C MOVELFMYCFY MO 20 MONTH FIS YR BEGL015 00390C NOT01 TAG GL015 00400C SIGN COMP 'C' 31CREDIT GL015 00410C SIGN COMP 'D' 32DEBIT GL015 00420C XFOOTC TOTALA 102 GL015 0000430C TOTALA ADD BALFWD CURBAL 102 GL015 00440C SETOF 505152 GL015 00450C 0 ADD 1 CO 20 GL015 00460C MOVE MO MC 20 GL015 00470C LOOP TAG GL015 00480C CO COMP 1 511ST MO OF LOOP.GL015 00490C CO COMP 12 5212TH MO " " .GL015 0000500C 02 EXCPT GL015 00510C CO ADD 1 CO GL015 00520C CO COMP 13 50 GL015 00530C SETOF 40 GL015 00540C MC ADD 1 MC GL015 00550C MC COMP 12 40 GL015 00560C 40 MC SUB 12 MC GL015 0000570C 50 GOTO LOOP GL015 00580O$LP1 H 203 01 GL015 00590O OR OFN1P GL015 00600O HEAD 74 GL015 00610O H 2 01 GL015 00620O OR OFN1P GL015 00630O 52 'GENERAL LEDGER' GL015 0000640O 71 'MASTERFILE LISTING' GL015 00650O H 2 01 GL015 00660O OR OFN1P GL015 00670O 9 'CGL015' GL015 00680O 60 'FISCAL YEAR BEGINNING' GL015 00690O 84 'RUN-' GL015 00700O UDATE Y 93 GL015 0000710O 124 'PAGE' GL015 00720O PAGE Z 128 GL015 00730O 67 '19' GL015 00740O Y 69 GL015 00750O M,MO 64 GL015 00760O H 1 01 GL015 00770O OR OFN1P GL015 0000780O 60 'T DB BALANCE FWD' GL015 00790O 96 'CURR YR CURR YR' GL015 00800O H 2 01 GL015 00810O OR OFN1P GL015 00820O 22 'ACCOUNT # DESCRIPTION' GL015 00830O 60 'Y CR BEG FISCAL YR' GL015 00840O 96 'ACTUAL BUDGET' GL015 0000850O E 1 02 GL015 00860O 51ACCNO Z 10 GL015 00870O 51DESC 41 GL015 00880O 51TYPE 43 GL015 00890O 31 51 46 'CR' GL015 00900O 32 51 46 'DB' GL015 00910O 51BALFWDA 62 GL015 0000920O C,MC A 81 GL015 00930O M,MC 85 GL015 00940O B,MC A 98 GL015 00950O 52 45 'CURR BALANCE $' GL015 00960O 52 CURBALA 62 GL015 00970O D 1 GL015 00980O 50 ' ' GL015 00** 000990ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001010ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001020ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001030** 001040JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 00105000/* 001060__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001010ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001020ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001030** 001040JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 0010500(B FGTXGL020 P999999032778(000010H S GL020 00020X DECK-ID A80 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL020 00030F* THIS PROGRAM LISTS THE CHART OF ACCOUNTS FROM THE GLMAST FILE GL020 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL020 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL020 00060F* CONTROL DATA PROPRIETARY PRODUCT GL020 00070F* GL020 0000080FGLMAST IS AF 280 10AI 1 DISK GL020 00090FGLHEAD IP AF 64 DISK GL020 00100F$LP1 O F 75 OF PRINTER GL020 00110F********************************************************************GL020 00120F* GL020 00130F* LISTS THE CHART OF ACCOUNTS FROM DATA ON GLMAST. GL020 00140F* GL020 0000150F********************************************************************GL020 00160F* ID F C H L FUNCTION OF INDICATORS GL020 00170F* 02 ASSET GL020 00180F* 03 LIABILITY GL020 00190F* 04 REVENUE GL020 00200F* 05 EXPENSE GL020 00210F* 20 DEBIT GL020 0000220F* 21 CREDIT GL020 00230F* 01 COMPANY NAME RECORD GL020 00240IGLMAST NS 02 11 CA GL020 00250I OR 03 11 CL GL020 00260I OR 04 11 CR GL020 00270I OR 05 11 CE GL020 00280I 1 100ACCNO GL020 0000290I 13 42 DESC GL020 00300I 11 11 TYPE L1 GL020 00310I 12 12 SIGN GL020 00320IGLHEAD NS 01 GL020 00330I 1 40 HEAD GL020 00340C SETOF 30 GL020 00350C L1 GL020 0000360COR OF SETON 30 GL020 00370C SIGN COMP 'D' 20 GL020 00380C SIGN COMP 'C' 21 GL020 00390O$LP1 D 203 30 GL020 00400O HEAD 58 GL020 00410O D 1 30 GL020 00420O 8 'CGL020' GL020 0000430O 45 'CHART OF ACCOUNTS' GL020 00440O 70 'PAGE' GL020 00450O PAGE Z 74 GL020 00460O D 1 30 GL020 00470O UDATE Y 41 GL020 00480O D 1 30 GL020 00490O 62 'NORMAL' GL020 0000500O D 2 30 GL020 00510O 24 'ACCOUNT # DESCRIPTION' GL020 00520O 61 'TYPE SIGN' GL020 00530O D 1 02 GL020 00540O OR 03 GL020 00550O OR 04 GL020 00560O OR 05 GL020 0000570O ACCNO Z 12 GL020 00580O DESC 43 GL020 00590O 02 49 'ASSET' GL020 00600O 03 53 'LIABILITY' GL020 00610O 04 51 'REVENUE' GL020 00620O 05 51 'EXPENSE' GL020 00630O 20 60 'DB' GL020 0000640O 21 60 'CR' GL020 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000__0O 21 60 'CR' GL020 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 0007000(B ;TXGL029 P999999032778(000010H S GL029 00020X DECK-ID A81 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL029 00030F* THIS PROGRAM CLEARS THE JEINPT FILE GL029 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL029 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL029 00060F* CONTROL DATA PROPRIETARY PRODUCT GL029 00070F* GL029 0000080FDUM29 IP F 72 DISK GL029 00090FJEINPT UC F 128R DISK GL029 00100IDUM29 NS 02 GL029 00110I 1 1 A GL029 00120IJEINPT NS 02 GL029 00130I 1 1 F GL029 00140I 1 128 REC GL029 0000150C SETON LR99 GL029 00160CLR LOOP TAG GL029 00170CLR RRN ADD 1 RRN 50 GL029 00180CLR RRN CHAINJEINPT 70 GL029 00190CLRN70 EXCPT GL029 00200CLRN70 GOTO LOOP GL029 00210OJEINPT E 99N70 GL029 0000220O OR LRN70 GL029 00230O REC 128 GL029 00240O 2 '<>' GL029 ** 000250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00028000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000290/* 000300__0O 2 '<>' GL029 ** 000250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0002800(C mTXGL030 P999999032778(000010H S GL030 00020X DECK-ID A82 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL030 00030F* THIS PROGRAM EDITS JOURNAL ENTRY TRANSACTIONS ENTERED FROM CRT GL030 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL030 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL030 00060F* CONTROL DATA PROPRIETARY PRODUCT GL030 00070F* GL030 0000080FGLHEAD IP F 64 DISK GL030 00090FJEINPT IS F 128 DISK GL030 00100FGLMAST IC F 280R10AI 1 DISK GL030 00110F$LP1 O F 132 OF PRINTER GL030 00120FTMPDAT O F 80 DISK GL030 00130F********************************************************************GL030 00140F* *GL030 0000150F* JOURNAL ENTRY EDIT PROGRAM. *GL030 00160F* *GL030 00170F********************************************************************GL030 00180I* GL030 00190I* GL030 00200IJEINPT XX 01 1 CH GL030 00210I 2 9 SRC GL030 0000220I 10 120TRNS GL030 00230I 13 222DBTS GL030 00240I 23 24 BATCH L1 GL030 00250I XX 02 1 CD GL030 00260I 2 9 JRNL GL030 00270I 10 190ACTNO GL030 00280I 20 250DATE GL030 0000290I 26 55 DSCRP GL030 00300I 56 652DBT 10 GL030 00310I 66 752CRDT 20 GL030 00320I XX 05 GL030 00330I 1 1 REC GL030 00340IGLMAST XX 03 GL030 00350I 13 42 DESCR GL030 0000360IGLHEAD XX 04 GL030 00370I 1 40 CONAME GL030 00380C N04 GOTO SPOT GL030 00390C SETON 5354 GL030 00400C GOTO END GL030 00410C SPOT TAG GL030 00420C SETOF 54 GL030 0000430C L1 Z-ADD0 TOTDBT 102 GL030 00440C L1 Z-ADD0 TOTCRD 102 GL030 00450C L1 Z-ADD0 TRNSAC 30 GL030 00460C RRN ADD 1 RRN 30 GL030 00470C N01 GOTO BRANCH GL030 00480C Z-ADDTRNS SAVNO 30 GL030 00490C Z-ADDDBTS HOLD 102 GL030 0000500C GOTO END GL030 00510C BRANCH TAG GL030 00520C N02 GOTO END GL030 00530C TRNSAC ADD 1 TRNSAC GL030 00540C ACTNO CHAINGLMAST 99 GL030 00550C 99 ERROR ADD 1 ERROR 40 GL030 00560C DBT COMP 0 98 GL030 0000570C 98N99ERROR ADD 1 ERROR GL030 00580C CRDT COMP 0 97 GL030 00590C 97N98N99ERROR ADD 1 ERROR GL030 00600C N10N20N97 GL030 00610CANN98N99 ERROR ADD 1 ERROR GL030 00620C DBT ADD TOTDBT TOTDBT GL030 00630C CRDT ADD TOTCRD TOTCRD GL030 0000640C DBT SUB CRDT AOUT 102 GL030 00650C END TAG GL030 00660CL1 TOTDBT COMP TOTCRD 9696 GL030 00670CL1 TOTDBT COMP HOLD 9595 GL030 00680CL1 TOTCRD COMP HOLD 9494 GL030 00690CL1 HOLD SUB TOTCRD L1CRD 102 9393 GL030 00700CL1 HOLD SUB TOTDBT L1DBT 102 9292 GL030 0000710CL1 SAVNO SUB TRNSAC DIFF 30 9191 GL030 00720CL1 SETOF 21 GL030 00730CL1 93 GL030 00740COR 92 GL030 00750COR 91 SETON 21 GL030 00760CL1 21 OB ADD 1 OB 20 GL030 00770CLR ERROR COMP 0 8989 GL030 0000780CLRN89 OB COMP 0 8989 GL030 00790O$LP1 D 203 L1 53 GL030 00800O OR OFNL1 53 GL030 00810O CONAME 74 GL030 00820O D 2 L1 53 GL030 00830O OR OFNL1 53 GL030 00840O 55 'JOURNAL ENTRY EDIT' GL030 0000850O UDATE Y 64 GL030 00860O 8 'CGL030' GL030 00870O 127 'PAGE' GL030 00880O PAGE Z 132 GL030 00890O D 1 L1 53 GL030 00900O OR OFNL1 53 GL030 00910O 12 'JOURN OR' GL030 0000920O D 2 L1 53 GL030 00930O OR OFNL1 53 GL030 00940O 22 'SEQ SOURCE ACCOUNT #' GL030 00950O 47 'TR DATE TR DESCRIPTION' GL030 00960O 77 'DEBIT' GL030 00970O 92 'CREDIT' GL030 00980O 116 'COMMENTS' GL030 0000990O D 1 02 GL030 01000O RRN Z 3 GL030 01010O JRNL 12 GL030 01020O ACTNO Z 21 GL030 01030O DATE Y 32 GL030 01040O DSCRP 63 GL030 01050O DBT K 78 GL030 0001060O CRDT K 93 GL030 01070O N10N20 109 'BOTH CRDT & DBT' GL030 01080O 99 122 'INVALID ACC#' GL030 01090O 98 132 'NEG AMT' GL030 01100O 97 132 'NEG AMT' GL030 01110O T 1 L1N54 GL030 01120O 77 '--------------' GL030 0001130O 93 '--------------' GL030 01140O T 1 L1N54 GL030 01150O 30 '* END OF BATCH * ACTUA' GL030 01160O 46 'L TOTALS #TR-' GL030 01170O TRNSACZ 51 GL030 01180O TOTDBTK 78 GL030 01190O TOTCRDK 93 GL030 0001200O 96 119 '* CREDITS AND DEBITS DON' GL030 01210O 96 126 'T MATCH' GL030 01220O T 1 L1N54 GL030 01230O 38 'HEADER TOTALS' GL030 01240O SAVNO Z 51 GL030 01250O HOLD K 78 GL030 01260O HOLD K 93 GL030 0001270O T 3 21 L1N54 GL030 01280O 41 '** VARIANCE **' GL030 01290O DIFF K 52 GL030 01300O L1DBT K 78 GL030 01310O L1CRD K 93 GL030 01320O 119 'BATCH OUT OF BALANCE' GL030 01330O T 33 LR GL030 0001340O 14 'END OF RUN.' GL030 01350O ERROR 1 20 GL030 01360O 45 'TRANSACTIONS WITH ERRORS' GL030 01370O 46 ',' GL030 01380O OB 1 49 GL030 01390O 73 'BATCHES OUT OF BALANCE.' GL030 01400O 89 100 'CORRECT ERRORS AND RERUN' GL030 0001410OTMPDAT D 02 GL030 01420O ACTNO 10 GL030 01430O JRNL 18 GL030 01440O DSCRP 48 GL030 01450O DATE 54 GL030 01460O AOUT 64 GL030 ** 00147000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001480ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001490ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001500ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001510/* 001520__0O AOUT 64 GL030 ** 0014700(Cv TTXGL031 P999999032778(000010H S GL031 00020X DECK-ID A83 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL031 00030F* RECOVERY PROGRAM WHICH DISPLAYS LAST RECORD INPUT AND RECORD NO. GL031 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL031 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL031 00060F* CONTROL DATA PROPRIETARY PRODUCT GL031 00070F* GL031 0000080FGLDUM UPE F 72 DISK GL031 00090FJEINPT IC F 128R DISK GL031 00100E MSG 1 5 35 GL031 00110IGLDUM NS 01 GL031 00120I 1 72 ALL GL031 00130IJEINPT NS 02 GL031 00140I 1 128 RCD GL031 0000150C SETOF 60 GL031 00160C SETON LR GL031 00170CLR MOVE ' ' B80 80 GL031 00180CLR EXSR ALMTS GL031 00190CLR Z-ADDLOW SEQNO 50 GL031 00200CLR LOOP TAG GL031 00210CLR SEQNO COMP HIGH 40 GL031 0000220CLR 40 GOTO A GL031 00230CLR SEQNO CHAINJEINPT 50 GL031 00240CLR 50 GOTO A GL031 00250CLR MOVELRCD TST 2 GL031 00260CLR TST COMP '<>' 51 GL031 00270CLRN51 SEQNO ADD 1 SEQNO GL031 00280CLRN51 GOTO LOOP GL031 0000290CLR A TAG GL031 00300CLR SEQNO SUB 1 SUBNO 50 GL031 00310CLR SUBNO CHAINJEINPT 50 GL031 00320CLR MOVELRCD BUFFER GL031 00330CLR MOVE 'T' TYPE GL031 00340CLR Z-ADD80 BLNGTH GL031 00350CLR EXSR CRTCOM GL031 0000360CLR MOVE RCD HOLD 48 GL031 00370CLR MOVE B80 BUFFER GL031 00380CLR MOVE 'T' TYPE GL031 00390CLR MOVELHOLD HOLD1 47 GL031 00400CLR MOVELHOLD HOLD2 42 GL031 00410CLR MOVELHOLD2 BUFFER GL031 00420CLR Z-ADD42 BLNGTH GL031 0000430CLR EXSR CRTCOM GL031 00440CLR MOVE B80 BUFFER GL031 00450CLR MOVELMSG,3 BUFFER GL031 00460CLR MOVE 'S' TYPE GL031 00470CLR Z-ADD35 BLNGTH GL031 00480CLR EXSR CRTCOM GL031 00490CLR MOVE B80 BUFFER GL031 0000500CLR MOVE HOLD1 HLDSEQ 5 GL031 00510CLR MOVELHLDSEQ BUFFER GL031 00520CLR MOVE 'T' TYPE GL031 00530CLR Z-ADD5 BLNGTH GL031 00540CLR EXSR CRTCOM GL031 00550CLR MOVELMSG,4 BUFFER GL031 00560CLR MOVE 'S' TYPE GL031 0000570CLR Z-ADD35 BLNGTH GL031 00580CLR EXSR CRTCOM GL031 00590CLR MOVE B80 BUFFER GL031 00600CLR MOVE 'A' TYPE GL031 00610CLR Z-ADD1 BLNGTH GL031 00620CLR EXSR CRTCOM GL031 00630CLR MOVE 'C' TYPE GL031 0000640CLR EXSR CRTCOM GL031 00650CLR MOVE 'F' TYPE GL031 00660CLR EXSR CRTCOM GL031 00670CSR ALMTS BEGSR GL031 00680CSR MOVE B80 BUFFER 80 GL031 00690CSR MOVE 'C' TYPE 1 GL031 00700CSR Z-ADD0 BLNGTH 20 GL031 0000710CSR MOVE ' ' RCODE 1 GL031 00720CSR Z-ADD0 MASK 10 GL031 00730CSR Z-ADD0 DTYPE 10 GL031 00740CSR EXSR CRTCOM GL031 00750CSR MOVELMSG,1 BUFFER GL031 00760CSR MOVE 'S' TYPE GL031 00770CSR Z-ADD35 BLNGTH GL031 0000780CSR EXSR CRTCOM GL031 00790CSR MOVE B80 BUFFER GL031 00800CSR MOVE 'A' TYPE GL031 00810CSR Z-ADD5 BLNGTH GL031 00820CSR Z-ADD1 DTYPE GL031 00830CSR EXSR CRTCOM GL031 00840CSR EXSR SKIP GL031 0000850CSR RCODE COMP 'R' 86 GL031 00860CSR EXSR AJ GL031 00870CSR MOVELBUFFER LOW 50 GL031 00880CSR MOVE B80 BUFFER GL031 00890CSR MOVELMSG,2 BUFFER GL031 00900CSR MOVE 'S' TYPE GL031 00910CSR Z-ADD35 BLNGTH GL031 0000920CSR EXSR CRTCOM GL031 00930CSR MOVE B80 BUFFER GL031 00940CSR MOVE 'A' TYPE GL031 00950CSR Z-ADD5 BLNGTH GL031 00960CSR Z-ADD1 DTYPE GL031 00970CSR EXSR CRTCOM GL031 00980CSR RCODE COMP 'R' 87 GL031 0000990CSR EXSR AJ GL031 01000CSR MOVELBUFFER HIGH 50 GL031 01010CSR MOVE 'C' TYPE GL031 01020CSR EXSR CRTCOM GL031 01030CSR 86 GL031 01040COR 87 GOTO ALMTS GL031 01050CSR Z-ADD0 DTYPE GL031 0001060CSR ENDSR GL031 01070CSR CRTCOM BEGSR GL031 01080CSR EXITFSUBRCM GL031 01090CSR RLABL BUFFER GL031 01100CSR RLABL TYPE GL031 01110CSR RLABL BLNGTH GL031 01120CSR RLABL RCODE GL031 0001130CSR RLABL MASK GL031 01140CSR RLABL DTYPE GL031 01150CSR ENDSR GL031 01160CSR SKIP BEGSR GL031 01170CSR MOVELBUFFER NBUF 1 GL031 01180CSR MOVEL' ' BUFFER GL031 01190CSR Z-ADD1 BLNGTH GL031 0001200CSR MOVE 'T' TYPE GL031 01210CSR EXSR CRTCOM GL031 01220CSR MOVELNBUF BUFFER GL031 01230CSR ENDSR GL031 01240CSR AJ BEGSR GL031 01250CSR MOVELBUFFER VAR 15 GL031 01260CSR Z-ADD5 VL 20 GL031 0001270CSR EXIT SUBRAJ GL031 01280CSR RLABL VL GL031 01290CSR RLABL VAR GL031 01300CSR MOVELVAR BUFFER GL031 01310CSR ENDSR GL031 01320OGLDUM D 60 GL031 01330O ALL 72 GL031 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430 001440/* 001450__ 001390ENTER BEGINNING RRN 0014000(C iTXGL032 P999999032778(000010H S GL032 00020X DECK-ID A84 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL032 00030F* RECOVERY PROGRAM WHICH DISPLAYS LAST RECORD INPUT AND RECORD NO. GL032 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL032 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL032 00060F* CONTROL DATA PROPRIETARY PRODUCT GL032 00070F* GL032 0000080FGLDUM UPE F 72 DISK GL032 00090FGLSEQ IC F 128R DISK GL032 00100E MSG 1 5 35 GL032 00110IGLDUM NS 01 GL032 00120I 1 72 ALL GL032 00130IGLSEQ NS 02 GL032 00140I 1 128 RCD GL032 0000150C SETOF 60 GL032 00160C SETON LR GL032 00170CLR MOVE ' ' B80 80 GL032 00180CLR EXSR ALMTS GL032 00190CLR Z-ADDLOW SEQNO 50 GL032 00200CLR LOOP TAG GL032 00210CLR SEQNO COMP HIGH 40 GL032 0000220CLR 40 GOTO A GL032 00230CLR SEQNO CHAINGLSEQ 50 GL032 00240CLR 50 GOTO A GL032 00250CLR MOVELRCD TST 2 GL032 00260CLR TST COMP '<>' 51 GL032 00270CLRN51 SEQNO ADD 1 SEQNO GL032 00280CLRN51 GOTO LOOP GL032 0000290CLR A TAG GL032 00300CLR SEQNO SUB 1 SUBNO 50 GL032 00310CLR SUBNO CHAINGLSEQ 50 GL032 00320CLR MOVELRCD BUFFER GL032 00330CLR MOVE 'T' TYPE GL032 00340CLR Z-ADD80 BLNGTH GL032 00350CLR EXSR CRTCOM GL032 0000360CLR MOVE RCD HOLD 48 GL032 00370CLR MOVE B80 BUFFER GL032 00380CLR MOVE 'T' TYPE GL032 00390CLR MOVELHOLD HOLD1 47 GL032 00400CLR MOVELHOLD HOLD2 42 GL032 00410CLR MOVELHOLD2 BUFFER GL032 00420CLR Z-ADD42 BLNGTH GL032 0000430CLR EXSR CRTCOM GL032 00440CLR MOVE B80 BUFFER GL032 00450CLR MOVELMSG,3 BUFFER GL032 00460CLR MOVE 'S' TYPE GL032 00470CLR Z-ADD35 BLNGTH GL032 00480CLR EXSR CRTCOM GL032 00490CLR MOVE B80 BUFFER GL032 0000500CLR MOVE HOLD1 HLDSEQ 5 GL032 00510CLR MOVELHLDSEQ BUFFER GL032 00520CLR MOVE 'T' TYPE GL032 00530CLR Z-ADD5 BLNGTH GL032 00540CLR EXSR CRTCOM GL032 00550CLR MOVELMSG,4 BUFFER GL032 00560CLR MOVE 'S' TYPE GL032 0000570CLR Z-ADD35 BLNGTH GL032 00580CLR EXSR CRTCOM GL032 00590CLR MOVE B80 BUFFER GL032 00600CLR MOVE 'A' TYPE GL032 00610CLR Z-ADD1 BLNGTH GL032 00620CLR EXSR CRTCOM GL032 00630CLR MOVE 'C' TYPE GL032 0000640CLR EXSR CRTCOM GL032 00650CLR MOVE 'F' TYPE GL032 00660CLR EXSR CRTCOM GL032 00670CSR ALMTS BEGSR GL032 00680CSR MOVE B80 BUFFER 80 GL032 00690CSR MOVE 'C' TYPE 1 GL032 00700CSR Z-ADD0 BLNGTH 20 GL032 0000710CSR MOVE ' ' RCODE 1 GL032 00720CSR Z-ADD0 MASK 10 GL032 00730CSR Z-ADD0 DTYPE 10 GL032 00740CSR EXSR CRTCOM GL032 00750CSR MOVELMSG,1 BUFFER GL032 00760CSR MOVE 'S' TYPE GL032 00770CSR Z-ADD35 BLNGTH GL032 0000780CSR EXSR CRTCOM GL032 00790CSR MOVE B80 BUFFER GL032 00800CSR MOVE 'A' TYPE GL032 00810CSR Z-ADD5 BLNGTH GL032 00820CSR Z-ADD1 DTYPE GL032 00830CSR EXSR CRTCOM GL032 00840CSR EXSR SKIP GL032 0000850CSR RCODE COMP 'R' 86 GL032 00860CSR EXSR AJ GL032 00870CSR MOVELBUFFER LOW 50 GL032 00880CSR MOVE B80 BUFFER GL032 00890CSR MOVELMSG,2 BUFFER GL032 00900CSR MOVE 'S' TYPE GL032 00910CSR Z-ADD35 BLNGTH GL032 0000920CSR EXSR CRTCOM GL032 00930CSR MOVE B80 BUFFER GL032 00940CSR MOVE 'A' TYPE GL032 00950CSR Z-ADD5 BLNGTH GL032 00960CSR Z-ADD1 DTYPE GL032 00970CSR EXSR CRTCOM GL032 00980CSR RCODE COMP 'R' 87 GL032 0000990CSR EXSR AJ GL032 01000CSR MOVELBUFFER HIGH 50 GL032 01010CSR MOVE 'C' TYPE GL032 01020CSR EXSR CRTCOM GL032 01030CSR 86 GL032 01040COR 87 GOTO ALMTS GL032 01050CSR Z-ADD0 DTYPE GL032 0001060CSR ENDSR GL032 01070CSR CRTCOM BEGSR GL032 01080CSR EXITFSUBRCM GL032 01090CSR RLABL BUFFER GL032 01100CSR RLABL TYPE GL032 01110CSR RLABL BLNGTH GL032 01120CSR RLABL RCODE GL032 0001130CSR RLABL MASK GL032 01140CSR RLABL DTYPE GL032 01150CSR ENDSR GL032 01160CSR SKIP BEGSR GL032 01170CSR MOVELBUFFER NBUF 1 GL032 01180CSR MOVEL' ' BUFFER GL032 01190CSR Z-ADD1 BLNGTH GL032 0001200CSR MOVE 'T' TYPE GL032 01210CSR EXSR CRTCOM GL032 01220CSR MOVELNBUF BUFFER GL032 01230CSR ENDSR GL032 01240CSR AJ BEGSR GL032 01250CSR MOVELBUFFER VAR 15 GL032 01260CSR Z-ADD5 VL 20 GL032 0001270CSR EXIT SUBRAJ GL032 01280CSR RLABL VL GL032 01290CSR RLABL VAR GL032 01300CSR MOVELVAR BUFFER GL032 01310CSR ENDSR GL032 01320OGLDUM D 60 GL032 01330O ALL 72 GL032 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430 001440/* 001450__ 001390ENTER BEGINNING RRN 0014000(KD5  TXGL034 P999999032778(000010H S GL034 00020X DECK-ID A86 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL034 00030F* THIS PROGRAM CLEARS THE GLSEQ FILE GL034 00040F* BLANKS OUT GLSEQ FILE PRIOR TO ENTERING DATA GL034 00050F* CYBER 18-10M/20 GENERAL LEDGER GL034 00060F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL034 00070F* CONTROL DATA PROPRIETARY PRODUCT GL034 0000080F* GL034 00090FDUM29 IP F 72 DISK GL034 00100FGLSEQ UC F 128R DISK GL034 00110IDUM29 NS 02 GL034 00120I 1 1 A GL034 00130IGLSEQ NS 02 GL034 00140I 1 1 F GL034 0000150I 1 128 REC GL034 00160C SETON LR99 GL034 00170CLR LOOP TAG GL034 00180CLR RRN ADD 1 RRN 50 GL034 00190CLR RRN CHAINGLSEQ 70 GL034 00200CLRN70 EXCPT GL034 00210CLRN70 GOTO LOOP GL034 0000220OGLSEQ E 99N70 GL034 00230O OR LRN70 GL034 00240O REC 128 GL034 00250O 2 '<>' GL034 ** 000260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000270ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00028000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000290ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000300/* 000310__0O 2 '<>' GL034 ** 000260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000270ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0002800(,DV }TXGL040 P999999032778(000010H S GL040 00020X DECK-ID A87 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL040 00030F* THIS PROGRAM LISTS TRANSACTIONS ADDED TO THE GLMAST FILE GL040 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL040 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL040 00060F* CONTROL DATA PROPRIETARY PRODUCT GL040 00070F* GL040 0000080FGLHEAD ID F 64 DISK GL040 00090FGLTRNS IPEAF 80 DISK GL040 00100FGLDATA ISEAF 80 DISK GL040 00110FGLMAST IC F 280R10AI 1 DISK GL040 00120FNEWGL O F 80 DISK GL040 00130F$LP1 O F 132 OF PRINTER GL040 00140F* ID F C H L FUNCTION OF INDICATORS GL040 0000150F* 02 GLTRNS GL040 00160F* 03 GLDATA GL040 00170F* L1 CHANGE IN ACCOUNT #. GL040 00180F* 99 HEADING OUTPUT. CYCLE ONE ONLY. GL040 00190F* 20 02 SETS ON 20 AT DETAIL.INDICATES PREVIOUS RECORDGL040 00200F* FOLLOW. TIME DETAIL COMES AROUND. GL040 00210F* 70 SETON BY 03 AND L1 OR 03 AND 20.INDICATES FIRST GL040 0000220F* TIME A PARTICULAR ACC # IS READ FROM GLDATA. GL040 00230F* 60 CHAIN ERROR. GL040 00240F* 11 TYPE A OR L. GL040 00250F* 12 TYPE E OR R. GL040 00260F* 98 EXCEPTION GLMAST INFO OUTPUT. GL040 00270F* H1 SET ON BY CHAIN ERROR. GL040 00280F* 30 03 SETS ON 30 AT DETAIL.INDICATES PREVIOUS RECORDGL040 0000290F* AT FOLLOWING TOTAL CALCS. GL040 00300F* 39 DATA AMT NEGATIVE. GL040 00310F* 97 EXCPT DATA OUTPUT (NOT LAST OF GROUP.) GL040 00320F* 96 EXCPT DATA OUTPUT (LAST OF GROUP.) GL040 00330F* 77 GRANTO (DIFF) = ZERO. GL040 00340E C 12 10 2 ACTUAL BY MONTHS GL040 00350IGLHEAD AA 01 GL040 0000360I 1 40 COMPHD GL040 00370IGLTRNS BB 02 GL040 00380I 1 100ACCNO L1M1 GL040 00390I 55 642TAMT GL040 00400I 1 64 RECORD GL040 00410IGLDATA CC 03 GL040 00420I 1 100ACCNO L1M1 GL040 0000430I 11 18 SOURCE GL040 00440I 19 48 TRDESC GL040 00450I 49 540DATE GL040 00460I 55 642DATA GL040 00470I 1 64 RECORD GL040 00480IGLMAST DD 04 GL040 00490I 11 11 TYPE GL040 0000500I 13 42 ACDESC GL040 00510I 43 522BALFWD GL040 00520I 149 268 C GL040 00530C SETOF 3070 GL040 00540C 50 GOTO NOTCY1 GL040 00550C SETON 5099 GL040 00560C 99 READ GLHEAD GL040 0000570C 99 EXCPT GL040 00580C 99 SETOF 99 GL040 00590C NOTCY1 TAG GL040 00600C N02 GOTO NOT2 GL040 00610C OCOUNT ADD 1 OCOUNT 60 GL040 00620C MR TOTAMT ADD TAMT TOTAMT 102 GL040 00630C SETON 20 GL040 0000640C NOT2 TAG GL040 00650C N03 GOTO NOT3 GL040 00660C DCOUNT ADD 1 DCOUNT 60 GL040 00670C L1 GL040 00680COR 20 SETON 70 GL040 00690C N70 GOTO NOT70 GL040 00700C ACCNO CHAINGLMAST 60 GL040 0000710C 60 EXCPT GL040 00720C 60 GOTO CHAERR GL040 00730C XFOOTC TOTC 102 GL040 00740C TOTC ADD BALFWD BALFWD GL040 00750C BALFWD ADD TOTAMT BALFWD GL040 00760C Z-ADD0 TOTAMT GL040 00770C SETON 98 GL040 0000780C 98 EXCPT GL040 00790C SETOF 98 GL040 00800C TYPE COMP 'A' 11 GL040 00810C N11TYPE COMP 'L' 11 GL040 00820C TYPE COMP 'R' 12 GL040 00830C N12TYPE COMP 'E' 12 GL040 00840C NOT70 TAG GL040 0000850C SETON 30 GL040 00860C DATA COMP 0 383938 GL040 00870C 11 39N38ALCRE ADD DATA ALCRE 102 GL040 00880C 11N39 38ALDEB ADD DATA ALDEB 102 GL040 00890C 12 39N38ERCRE ADD DATA ERCRE 102 GL040 00900C 12N39 38ERDEB ADD DATA ERDEB 102 GL040 00910C SETOF 20 GL040 0000920C NOT3 TAG GL040 00930C CHAERR TAG GL040 00940C SETOF 60 GL040 00950CL0 30 BALFWD ADD DATA BALFWD GL040 00960CL0 30NL1 SETON 97 GL040 00970CL0 97 EXCPT GL040 00980CL0 SETOF 97 GL040 0000990CL1 30 SETON 96 GL040 01000CL1 96 EXCPT GL040 01010CL1 SETOF 96 GL040 01020CLR ALDEB ADD ERDEB TODEBS 102 GL040 01030CLR ALCRE ADD ERCRE TOCRES 102 GL040 01040CLR ALDEB ADD ALCRE ALTOT 102 GL040 01050CLR ERDEB ADD ERCRE ERTOT 102 GL040 0001060CLR TODEBS ADD TOCRES GRANTO 102 77 GL040 01070CLR OCOUNT ADD DCOUNT NCOUNT 60 GL040 01080ONEWGL D 02 GL040 01090O OR 03 GL040 01100O RECORD 64 GL040 01110O$LP1 H 203 OFN1P GL040 01120O COMPHD 84 GL040 0001130O H 3 OFN1P GL040 01140O OR OFN1P GL040 01150O 8 'CGL 040' GL040 01160O 72 'GENERAL LEDGER CHANGES-' GL040 01170O UDATE Y 81 GL040 01180O 124 'PAGE' GL040 01190O PAGE Z 128 GL040 0001200O H 2 OFN1P GL040 01210O 18 'ACCOUNT # DATE' GL040 01220O 42 'SOURCE DESCRIPTION' GL040 01230O 94 'DEBIT CREDIT' GL040 01240O 109 'BALANCE' GL040 01250O E 203 99 GL040 01260O COMPHD 84 GL040 0001270O E 3 99 GL040 01280O 8 'CGL040' GL040 01290O 72 'GENERAL LEDGER CHANGES-' GL040 01300O UDATE Y 81 GL040 01310O 124 'PAGE' GL040 01320O PAGE Z 128 GL040 01330O E 2 99 GL040 0001340O 18 'ACCOUNT # DATE' GL040 01350O 42 'SOURCE DESCRIPTION' GL040 01360O 94 'DEBIT CREDIT' GL040 01370O 109 'BALANCE' GL040 01380O E 1 98 GL040 01390O ACCNO Z 11 GL040 01400O ACDESC 61 GL040 0001410O BALFWDA 111 GL040 01420O 123 '* BAL FWD *' GL040 01430O E 1 97 GL040 01440O ACCNO Z 11 GL040 01450O DATE Y 21 GL040 01460O SOURCE 30 GL040 01470O TRDESC 65 GL040 0001480O 38N39 DATA J 80 GL040 01490O N38 39 DATA J 95 GL040 01500O BALFWDA 111 GL040 01510O E 2 96 GL040 01520O ACCNO Z 11 GL040 01530O DATE Y 21 GL040 01540O SOURCE 30 GL040 0001550O TRDESC 65 GL040 01560O N39 38 DATA J 80 GL040 01570O 39N38 DATA J 95 GL040 01580O BALFWDAB 111 GL040 01590O 123 '* NEW BAL *' GL040 01600O E 1 60 GL040 01610O 35 '* * * ACCOUNT #' GL040 0001620O ACCNO Z 46 GL040 01630O 65 'UNKNOWN IN GLMAST.' GL040 01640O 89 'RECTIFY AND RETRY * * *' GL040 01650O T 205 LR GL040 01660O 25 'END OF RUN. SUMMARY...' GL040 01670O 46 'ASSET/LIABILITIES' GL040 01680O 80 'EXP/REV TOTAL' GL040 0001690O T 1 LR GL040 01700O ALDEB J 47 GL040 01710O 53 'DEBITS' GL040 01720O ERDEB J 69 GL040 01730O TODEBSJ 87 GL040 01740O 100 'TOTAL DEBITS' GL040 01750O T 1 LR GL040 0001760O ALCRE J 47 GL040 01770O 54 'CREDITS' GL040 01780O ERCRE J 69 GL040 01790O TOCRESJ 87 GL040 01800O 101 'TOTAL CREDITS' GL040 01810O T 2 LR GL040 01820O N77 30 '* OUT OF BALANCE *' GL040 0001830O ALTOT J 47 GL040 01840O ERTOT J 69 GL040 01850O GRANTOJ 87 GL040 01860O 103 '* DIFFERENCE *' GL040 01870O T LR GL040 01880O OCOUNT2 30 GL040 01890O 50 'RECS ON OLD GLTRNS.' GL040 0001900O DCOUNT2 57 GL040 01910O 73 'RECS ON GLDATA.' GL040 01920O NCOUNT2 80 GL040 01930O 100 'RECS ON NEW GLTRNS.' GL040 ** 001940ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001950ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00196000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001970ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001980/* 001990__0O 100 'RECS ON NEW GLTRNS.' GL040 ** 001940ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001950ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0019600(D qTXGL050 P999999032778(000010H S GL050 00020X DECK-ID A88 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL050 00030F* THIS PROGRAM PRODUCES THE TRIAL BALANCE REPORT GL050 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL050 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL050 00060F* CONTROL DATA PROPRIETARY PRODUCT GL050 00070F* GL050 0000080FGLHEAD ID F 64 DISK GL050 00090FGLTRNS IP AF 80 DISK GL050 00100FGLMAST IS AF 280 10AI 1 DISK GL050 00110F$LP1 O F 132 OF PRINTER GL050 00120F********************************************************************GL050 00130F* *GL050 00140F* PRINTS THE TRIAL BALANCE REPORT. GL050 0000150F* *GL050 00160F********************************************************************GL050 00170F* ID F C H L FUNCTION OF INDICATORS GL050 00180F* 01 GLHEAD GL050 00190F* 02 GLTRNS GL050 00200F* 03 GLMAST GL050 00210F* L1TYPE - GLMAST GL050 0000220F* M1ACCOUNT # - GLTRNS & GLMAST GL050 00230F* 21 A = TYPE GL050 00240F* 22 L = TYPE GL050 00250F* 23 E = TYPE GL050 00260F* 24 R = TYPE GL050 00270F* 30 FIRST 03 GL050 00280F* 51 12 < MONTH GL050 0000290F* 52 MONTH < FIRST MONTH GL050 00300F* 60 NET < 0 GL050 00310F* 61 A=L+P GL050 00320F* 75 READ GLHEAD - INDICATOR GL050 00330F* 98 NOT FIRST CYCLE - NEW TYPE GL050 00340E C 12 10 2 ACTUAL BY FISCAL GL050 00350E* MONTHS. GL050 0000360E M 12 12 3 MONTHS OF YEAR. GL050 00370IGLHEAD NS 01 GL050 00380I 1 40 NAME GL050 00390I 41 440FMYCFY GL050 00400IGLTRNS NS 02 GL050 00410I 1 100ACCNO M1 GL050 00420I 55 642TAMT GL050 0000430IGLMAST NS 03 GL050 00440I 1 100ACCNO M1 GL050 00450I 11 11 TYPE L1 GL050 00460I 13 42 DESC GL050 00470I 43 522BALFWD GL050 00480I 149 268 C GL050 00490I 269 2700FMLU GL050 0000500C N99 READ GLHEAD GL050 00510C SETON 99 GL050 00520C 02TAMT ADD CURMO CURMO 102 GL050 00530C SETOF 30 GL050 00540C N03 GOTO NOT03 GL050 00550C 98 GOTO NOT1ST GL050 00560C SETON 30 1ST 03 ONLY GL050 0000570C FMLU ADD 1 MO 20 GL050 00580C MOVELFMYCFY FRSTM 20 GL050 00590C 12 COMP MO 51 GL050 00600C 51MO SUB 12 MO MONTH OF REPORTGL050 00610C MOVE FMYCFY FRSTY 20 GL050 00620C MO COMP FRSTM 52 GL050 00630C 52FRSTY ADD 1 YR 20 YEAR OF REPORT GL050 0000640C N52FRSTY ADD 0 YR GL050 00650C TIME HHMMSS 60 TIME OF DAY GL050 00660C SETON 98 GL050 00670C NOT1ST TAG GL050 00680C XFOOTC TOTC 102 GL050 00690C BALFWD ADD TOTC PREBAL 102 GL050 00700C TYPE COMP 'A' 21 GL050 0000710C TYPE COMP 'L' 22 GL050 00720C TYPE COMP 'E' 23 GL050 00730C TYPE COMP 'R' 24 GL050 00740C CURMO ADD PREBAL NEWBAL 102 GL050 00750C CURMO ADD CURMOT CURMOT 102 GL050 00760C PREBAL ADD PRBALT PRBALT 102 GL050 00770C NEWBAL ADD NWBALT NWBALT 102 GL050 0000780C NOT03 TAG GL050 00790CL1 21 98 ASSTOT ADD NWBALT ASSTOT 102 GL050 00800CL1 22 98 LIATOT ADD NWBALT LIATOT 102 GL050 00810CL1 23 98 EXPTOT ADD NWBALT EXPTOT 102 GL050 00820CL1 24 98 REVTOT ADD NWBALT REVTOT 102 GL050 00830CLR REVTOT ADD EXPTOT NET 102 60 GL050 00840CLR NET ADD LIATOT TOLIAB 102 GL050 0000850CLR TOLIAB MULT -1 TOL 102 GL050 00860CLR TOL COMP ASSTOT 61 A=L+P GL050 00870O$LP1 H 202 OFN1P GL050 00880O OR 30 GL050 00890O NAME 84 GL050 00900O H 2 OFN1P GL050 00910O OR 30 GL050 0000920O 18 'CGL050 RUN-' GL050 00930O UDATE Y 26 GL050 00940O HHMMSS 36 '0 : : ' GL050 00950O 64 'GENERAL LEDGER TRIAL' GL050 00960O 81 'BALANCE MONTH OF' GL050 00970O M,MO 85 GL050 00980O 88 ',19' GL050 0000990O YR 90 GL050 01000O 114 'PAGE' GL050 01010O PAGE Z 118 GL050 01020O H 2 OFN1P GL050 01030O OR 30 GL050 01040O 14 'ACCOUNT # TY' GL050 01050O 26 'DESCRIPTION' GL050 0001060O 60 'PREV BAL' GL050 01070O 78 'CURR MO' GL050 01080O 96 'NEW BAL' GL050 01090O D 1 03 GL050 01100O ACCNO Z 11 GL050 01110O TYPE 14 GL050 01120O DESC 45 GL050 0001130O PREBALAB 62 GL050 01140O CURMO AB 80 GL050 01150O NEWBALAB 98 GL050 01160O T 13 L1 98 GL050 01170O TYPE 14 GL050 01180O 33 '* TYPE TOTALS *' GL050 01190O PRBALTAB 62 GL050 0001200O 63 '*' GL050 01210O CURMOTAB 80 GL050 01220O 81 '*' GL050 01230O NWBALTAB 98 GL050 01240O 99 '*' GL050 01250O T 104 LR GL050 01260O 23 'END OF TRIAL BALANCE.' GL050 0001270O 36 'SUMMARY...' GL050 01280O REVTOTA 55 GL050 01290O 69 'TOTAL REVENUE' GL050 01300O 84 'RUN-' GL050 01310O UDATE Y 92 GL050 01320O HHMMSS 101 '0 : : ' GL050 01330O 108 'PAGE' GL050 0001340O PAGE Z 112 GL050 01350O T 2 LR GL050 01360O EXPTOTA 55 GL050 01370O 69 'TOTAL EXPENSE' GL050 01380O T 3 LR GL050 01390O NET A 55 GL050 01400O 59 'NET' GL050 0001410O 60 66 'PROFIT' GL050 01420O N60 64 'LOSS' GL050 01430O T 2 LR GL050 01440O ASSTOTA 55 GL050 01450O 68 'TOTAL ASSETS' GL050 01460O T 1 LR GL050 01470O LIATOTA 55 GL050 0001480O 80 'TOTAL LIABILITY ACCOUNTS' GL050 01490O T 2 LR GL050 01500O NET A 55 GL050 01510O 59 'NET' GL050 01520O 60 66 'PROFIT' GL050 01530O N60 64 'LOSS' GL050 01540O T LR GL050 0001550O N61 24 '* OUT OF BALANCE *' GL050 01560O TOLIABA 55 GL050 01570O 73 'TOTAL LIABILITIES' GL050 ** 001580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00161000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001620** 001630JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 001640/* 001650__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0016100(EF `TXGL055 P999999032778(000010H S GL055 00020X DECK-ID A89 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL055 00030F* THIS PROGRAM UPDATES THE GLSEQ FILE FROM THE GLTRNS FILE GL055 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL055 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL055 00060F* CONTROL DATA PROPRIETARY PRODUCT GL055 00070F* GL055 0000080FGLMAST IPEAF 280 10AI 1 DISK GL055 00090FGLTRNS ISEAF 80 DISK GL055 00100FGLSEQ US AF 128R I DISK GL055 00110FADDR55 IRE F 4 IT EDISK GL055 00120F$SYSLISTO F 132 OF PRINTER GL055 00130F********************************************************************GL055 00140F* *GL055 0000150F* UPDATES GLSEQ WITH DESCRIPTIONS AND AMOUNTS. *GL055 00160F* *GL055 00170F********************************************************************GL055 00180F* ID F C H L FUNCTION OF INDICATORS GL055 00190F* GL055 00200F* 01 GLMAST INPUT GL055 00210F* 02 GLTRNS INPUT GL055 0000220F* 03 GLSEQ INPUT GL055 00230F* M1 L1 ACCOUNT NUMBER. GL055 00240F* 21 THERE WAS A GLMAST RECORD FOR THIS ACCT. GL055 00250F* 22 THIS GLSEQ RECORD IS AN 'S' RECORD. GL055 00260F* 23 THE YTD BUDGET & ACTUAL HAVE BEEN CALCULATED GL055 00270F* 24 THIS GLSEQ HAS EFFECT CODE 'N' OR 'S'. GL055 00280F* 25 UPDATE GLSEQ FLAG. GL055 0000290F* 26 AT LEAST ONE GLSEQ WAS READ FOR THIS ACCT. GL055 00300E ADDR55 GLSEQ GL055 00310E B 12 8 0 BUDGET ARRAY GL055 00320E A 12 10 2 ACTUAL AMTS GL055 00330IGLMAST NS 01 GL055 00340I 1 100ACCT L1M1 GL055 00350I 11 11 ACTYPE GL055 0000360I 12 12 SIGN GL055 00370I 13 42 DESCM GL055 00380I 43 522YBALF GL055 00390I 53 148 B GL055 00400I 149 268 A GL055 00410I 269 2700LM GL055 00420IGLTRNS NS 02 GL055 0000430I 1 100ACCT L1M1 GL055 00440I 55 642TRAMT GL055 00450IGLSEQ NS 03 GL055 00460I 1 1 TYPE GL055 00470I 2 110ACCT L1M1 GL055 00480I 12 12 EFCD GL055 00490C NL1 GOTO START GL055 0000500C Z-ADD0 CURTRN 102 GL055 00510C SETOF 212326 GL055 00520C START TAG GL055 00530C 01 SETON 21 GL055 00540C 01 GOTO LAST GL055 00550C* GL055 00560C 02 TRAMT ADD CURTRN CURTRN GL055 0000570C 02 GOTO LAST GL055 00580C* GL055 00590C N03 GOTO LAST GL055 00600C SETOF 2225 GL055 00610C TYPE COMP 'S' 22 GL055 00620C N22 GOTO LAST GL055 00630C SETON 26 GL055 0000640C* NO MASTER GL055 00650C N21 GOTO CKCODS GL055 00660C 23 GOTO CKCODS GL055 00670C Z-ADD1 N 20 CALCULATE YTD GL055 00680C Z-ADDYBALF NWBAL 102 BUDGET AND GL055 00690C Z-ADD0 YTDB 80 ACTUAL. GL055 00700C LOOP1 TAG GL055 0000710C N COMP LM 23 GL055 00720C 23 GOTO ENDLP1 GL055 00730C B,N ADD YTDB YTDB GL055 00740C A,N ADD NWBAL NWBAL GL055 00750C N ADD 1 N GL055 00760C GOTO LOOP1 GL055 00770C* GL055 0000780C ENDLP1 TAG GL055 00790C N COMP 13 96 GL055 00800C 96 Z-ADD1 N GL055 00810C Z-ADDB,N CBUD 80 GL055 00820C CURTRN ADD NWBAL NWBAL GL055 00830C* GL055 00840C CKCODS TAG GL055 0000850C SETOF 24 GL055 00860C EFCD COMP 'N' 24 GL055 00870C N24 EFCD COMP 'S' 24 GL055 00880C 24N21 EXCPT NEEDS MASTER GL055 00890C 24 21 SETON 25 GL055 00900C* GL055 00910C LAST TAG GL055 0000920O$SYSLISTH 303 1P GL055 00930O OR OF GL055 00940O 25 'CGL055 UPDATE GLSEQ' GL055 00950O 30 'FILE' GL055 00960O UDATE Y 45 GL055 00970O H 2 1P GL055 00980O OR OF GL055 0000990O 38 'ACCOUNT # DESCRIPTION' GL055 01000O 66 'COMMENTS' GL055 01010O T 1 L1 21N26 GL055 01020O 13 '* WARNING *' GL055 01030O ACCT 3 26 GL055 01040O DESCM 57 GL055 01050O 82 '* NOT INCLUDED IN FINANC' GL055 0001060O 99 'IAL STATEMENTS. *' GL055 01070O E 1 24N21 GL055 01080O 12 '* ERROR *' GL055 01090O ACCT 3 26 GL055 01100O 80 '* NEEDED FOR FINANCIAL' GL055 01110O 102 'STATEMENTS BUT NOT ON' GL055 01120O 110 'GLMAST.' GL055 0001130O T 13 LR GL055 01140O 19 'END OF RUN.' GL055 01150OGLSEQ D 03 25 GL055 01160O 24 DESCM 43 GL055 01170O 53 ' ' GL055 01180O CURTRN 64 GL055 01190O NWBAL 74 GL055 0001200O CBUD 82 GL055 01210O YTDB 90 GL055 01220O ACTYPE 91 GL055 01230O SIGN 92 GL055 ** 001240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00126000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001280/* 001290__0O SIGN 92 GL055 ** 001240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0012600(E 3?TXGL059 P999999032778(000010H S GL059 00020X DECK-ID A90 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL059 00030F* THIS PROGRAM CREATES GLUPDT FILE FROM GLTRNS AND GLMAST FILE GL059 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL059 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL059 00060F* CONTROL DATA PROPRIETARY PRODUCT GL059 00070F* GL059 0000080FGLMAST IP AF 280 10AI 1 DISK GL059 00090FGLTRNS IS AF 80 DISK GL059 00100FGLUPDT O F 73 DISK GL059 00110F* GL059 00120F* MERGES GLMAST AND GLTRNS TO CREATE GLUPDT TO BE USED BY CGL060. GL059 00130F* GL059 00140F* ID F C H L FUNCTION OF INDICATORS GL059 0000150F* GL059 00160F* 01 INPUT FROM GLMAST. GL059 00170F* 02 INPUT FROM GLTRNS. GL059 00180E ACT 12 10 2 GL059 00190IGLMAST NS 01 GL059 00200I 1 100ACCT M1 GL059 00210I 13 42 DESCR GL059 0000220I 43 522YBALF GL059 00230I 149 268 ACT GL059 00240I 269 2700MU GL059 00250IGLTRNS NS 02 GL059 00260I 1 100ACCT M1 GL059 00270I 11 64 REST GL059 00280C 02 GOTO LAST GL059 0000290C XFOOTACT TACT 102 GL059 00300C MU COMP 0 21 GL059 00310C 21 Z-ADD0 MACT 102 GL059 00320C N21 Z-ADDACT,MU MACT GL059 00330C LAST TAG GL059 00340OGLUPDT D 01 GL059 00350O 1 'B' GL059 0000360O ACCT 11 GL059 00370O MU 13 GL059 00380O DESCR 43 GL059 00390O YBALF 53 GL059 00400O TACT 63 GL059 00410O MACT 73 GL059 00420O D 02 GL059 0000430O 1 'C' GL059 00440O ACCT 11 GL059 00450O REST 65 GL059 ** 000460ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000470ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000480ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00049000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000500/* 000510__0O REST 65 GL059 ** 000460ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000470ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000480ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0004900(^E TXGL060 P999999032778(000010H S GL060 00020X DECK-ID A91 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL060 00030F* THIS PROGRAM UPDATES GLMAST AND ISSUES LISTING OF TRANSACTIONS GL060 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL060 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL060 00060F* CONTROL DATA PROPRIETARY PRODUCT GL060 00070F* GL060 0000080FGLHEAD ID F 64 DISK GL060 00090FGLUPDT IP F 73 DISK GL060 00100FGLMAST UC F 280R10AI 1 DISK GL060 00110FGLYEAR O F 66 DISK A U1 GL060 00120F$SYSLISTO F 132 OF PRINTER GL060 00130F* *GL060 00140F* MONTHLY UPDATE OF GLMAST. IF U1 IS ON, THE TRANSACTIONS ON *GL060 0000150F* GLTRANS WILL BE ADDED TO GLYEAR. IF U2 IS ON, GLMAST WILL *GL060 00160F* BE UPDATED. *GL060 00170F********************************************************************GL060 00180F* ID F C H L FUNCTION OF INDICATORS GL060 00190F* GL060 00200F* 01 INPUT FROM GLHEAD. GL060 00210F* 02 'B' RECORD READ FROM GLUPDT. GL060 0000220F* 03 'C' RECORD READ FROM GLUPDT. GL060 00230F* 04 GLMAST INPUT. GL060 00240F* 21 ACCOUNT ON GLUPDT BUT NOT ON GLMAST. GL060 00250F* 22 FIRST VALID CYCLE HAS BEEN PROCESSED. GL060 00260F* 23 NEXT MONTH TO BE UPDATED IS JAN. GL060 00270F* 24 NEXT MONTH TO BE UPDATED IS IN THE CALENDAR YEAR GL060 00280F* FOLLOWING 1ST FISCAL MONTH OF THIS FISCAL YEAR. GL060 0000290F* 25 Y OR N RESPONSE WAS 'Y'. GL060 00300F* 26 Y OR N RESPONSE WAS 'N'. GL060 00310F* 27 PREVIOUS UPDATE MONTH WAS DEC. GL060 00320F* 28 THIS ACCT IS ASSET/LIABILITY. GL060 00330F* 29 THIS ACCT IS EXP/REV. GL060 00340F* 30 FILE IS OUT OF BALANCE. GL060 00350F* 31 THERE HAS BEEN AT LEAST 2 DETAIL CYCLES. GL060 0000360F* H1 NO RECORDS IN GLHEAD. GL060 00370F* 33 FISCAL MONTH IS IN SAME CALENDAR YEAR AS AMO. GL060 00380E ACT 12 10 2 ACTUAL AMTS GL060 00390E MOS 12 12 3 MONTH ABBR'S. GL060 00400E MSG 1 7 50 MESSAGES GL060 00410IGLHEAD NS 01 GL060 00420I 1 40 CNAME GL060 0000430I 41 440FMMYY GL060 00440IGLUPDT NS 02 1 CB GL060 00450I 12 130AMO GL060 00460I 14 43 ADESCR GL060 00470I 44 532YBALFW GL060 00480I 54 632TACT GL060 00490I 64 732MACT GL060 0000500I 2 110ACCT L1 GL060 00510I NS 03 1 CC GL060 00520I 2 110ACCT L1 GL060 00530I 12 19 SRC GL060 00540I 20 49 TDESCR GL060 00550I 50 550TDATE GL060 00560I 56 652TAMT GL060 0000570I 2 65 FLD1 GL060 00580IGLMAST NS 04 GL060 00590I 11 11 ATYPE GL060 00600I 149 268 ACT GL060 00610C L1 ACCT CHAINGLMAST 21 GL060 00620C N22 READ GLHEAD H1 GL060 00630C 22 SETON 31 GL060 0000640C N22 Z-ADD0 PM 20 GL060 00650C N22 EXSR FIRST GL060 00660C N22 EXSR FMCALC GL060 00670C SETON 22 GL060 00680C 03 GOTO CREC GL060 00690C* GL060 00700C N02 GOTO LAST GL060 0000710C TACT ADD YBALFW BALFWD 102 GL060 00720C Z-ADDBALFWD ENDBAL 102 GL060 00730C GOTO LAST GL060 00740C* GL060 00750C CREC TAG GL060 00760C ENDBAL ADD TAMT ENDBAL GL060 00770C TAMT ADD TCURR TCURR 102 GL060 0000780C GOTO LAST GL060 00790C* GL060 00800C LAST TAG GL060 00810C********************************************************************GL060 00820C* GL060 00830CL1 ATYPE COMP 'A' 28 GL060 00840CL1N28 ATYPE COMP 'L' 28 GL060 0000850CL1 ATYPE COMP 'R' 29 GL060 00860CL1N29 ATYPE COMP 'E' 29 GL060 00870CL1 28 ENDBAL ADD TAL TAL 112 GL060 00880CL1 29 ENDBAL ADD TRE TRE 112 GL060 00890CL1N21 Z-ADDTCURR ACT,PM GL060 00900CL1 Z-ADD0 TCURR GL060 00910CLR TAL ADD TRE GTOT 112 GL060 0000920CLR GTOT COMP 0 3030 GL060 00930C********************************************************************GL060 00940CSR FMCALC BEGSR CALCULATE FISCAGL060 00950CSR PM SUB FM TMM 20 MONTH. GL060 00960CSR TMM ADD 1 TMM 33 GL060 00970CSRN33 TMM ADD 12 TMM GL060 00980CSR ENDSR GL060 0000990C********************************************************************GL060 01000CSR FIRST BEGSR GL060 01010C* DISPLAY 'TRIAL' MESSAGE IF U2 IS OFF GL060 01020C* DISPLAY 'UPDATE' MESSAGE IF U2 IS ON GL060 01030CSR U2 GOTO FTAG0 GL060 01040CSR MOVELMSG,7 BUFFER GL060 01050CSR MOVE 'T' TYPE GL060 0001060CSR Z-ADD50 BLNGTH GL060 01070CSR EXSR CRTCOM GL060 01080CSR GOTO FTAG1 GL060 01090CSR FTAG0 TAG GL060 01100CSR MOVELMSG,1 BUFFER 72 GL060 01110CSR MOVE 'T' TYPE 1 GL060 01120CSR Z-ADD50 BLNGTH 20 GL060 0001130CSR EXSR CRTCOM GL060 01140CSR FTAG1 TAG GL060 01150CSR MOVE 'S' TYPE GL060 01160CSR MOVELMSG,2 BUFFER GL060 01170CSR Z-ADD32 BLNGTH GL060 01180CSR EXSR CRTCOM GL060 01190CSR MOVE 'T' TYPE GL060 0001200CSR MOVE FMMYY FY 20 GL060 01210CSR MOVELFMMYY FM 20 GL060 01220CSR AMO ADD 1 PM 20 GL060 01230CSR PM COMP 12 23 GL060 01240CSR 23 Z-ADD1 PM GL060 01250CSR PM COMP FM 24 GL060 01260CSR 24 FY ADD 1 PY 20 GL060 0001270CSRN24 Z-ADDFY PY GL060 01280CSR MOVELPY A3 3 GL060 01290CSR MOVE '.' A3 GL060 01300CSR MOVE ', 19 ' A10 10 GL060 01310CSR MOVE A3 A10 GL060 01320CSR MOVELMOS,PM A10 GL060 01330CSR MOVELA10 BUFFER GL060 0001340CSR Z-ADD10 BLNGTH GL060 01350CSR EXSR CRTCOM GL060 01360CSR FTAG2 TAG GL060 01370CSR Z-ADD27 BLNGTH GL060 01380CSR MOVE 'S' TYPE GL060 01390CSR MOVELMSG,3 BUFFER GL060 01400CSR EXSR CRTCOM GL060 0001410CSR MOVE 'A' TYPE GL060 01420CSR Z-ADD1 BLNGTH GL060 01430CSR EXSR CRTCOM GL060 01440CSR MOVELBUFFER YORN 1 GL060 01450CSR YORN COMP 'Y' 25 GL060 01460CSR YORN COMP 'N' 26 GL060 01470CSR 25 GOTO FEND GL060 0001480CSR EXSR SPACE GL060 01490CSRN26 GOTO FTAG2 GL060 01500CSR MOVELMSG,5 BUFFER GL060 01510CSR MOVE 'T' TYPE GL060 01520CSR Z-ADD50 BLNGTH GL060 01530CSR EXSR CRTCOM GL060 01540CSR MOVELMSG,6 BUFFER GL060 0001550CSR MOVE 'T' TYPE GL060 01560CSR EXSR CRTCOM GL060 01570CSR SETON LR21 GL060 01580CSR FEND ENDSR GL060 01590C********************************************************************GL060 01600CSR CRTCOM BEGSR GL060 01610CSR EXITFSUBRCM GL060 0001620CSR RLABL BUFFER 72 GL060 01630CSR RLABL TYPE 1 GL060 01640CSR RLABL BLNGTH 20 GL060 01650CSR RLABL RCODE 1 GL060 01660CSR RLABL MASK 10 GL060 01670CSR RLABL DTYPE 10 GL060 01680CSR ENDSR GL060 0001690C********************************************************************GL060 01700CSR SPACE BEGSR SKIPS ONE LINE GL060 01710CSR MOVE 'T' TYPE ON CRT. GL060 01720CSR Z-ADD1 BLNGTH GL060 01730CSR MOVEL' ' BUFFER GL060 01740CSR EXSR CRTCOM GL060 01750CSR ENDSR GL060 0001760C********************************************************************GL060 01770OGLMAST T L1N21 U2 GL060 01780O ACT 268 GL060 01790O PM 270 GL060 01800OGLYEAR DADD 03 U1 GL060 01810O FLD1 64 GL060 01820O TMM 66 GL060 0001830O$SYSLISTH 203 22N31 GL060 01840O OR OF GL060 01850O CNAME 84 GL060 01860O H 2 22N31 GL060 01870O OR OF GL060 01880O 8 'CGL060' GL060 01890O 56 'GENERAL LEDGER CHANGES' GL060 0001900O 70 'FOR XXX 19XX.' GL060 01910O MOS,PM 64 GL060 01920O PY 69 GL060 01930O 93 'RUN' GL060 01940O UDATE Y 102 GL060 01950O 117 'PAGE' GL060 01960O PAGE Z 121 GL060 0001970O NU2 33 'TRIAL' GL060 01980O NU2 89 'TRIAL' GL060 01990O H 1 22N31 GL060 02000O OR OF GL060 02010O 18 'ACCOUNT # DATE' GL060 02020O 44 'SOURCE DESCRIPTION' GL060 02030O 83 'AMOUNT' GL060 0002040O 99 'BALANCE' GL060 02050O D 13 L1 21 GL060 02060O 20 '*ERROR. ACCT#' GL060 02070O ACCT 3 31 GL060 02080O 54 'NOT ON MASTERFILE. **' GL060 02090O D 2 L1N21 02 GL060 02100O ACCT 3 12 GL060 0002110O ADESCR 63 GL060 02120O BALFWDA 101 GL060 02130O 115 '* BAL FWD *' GL060 02140O D 1 03N21 GL060 02150O ACCT 3 12 GL060 02160O TDATE Y 22 GL060 02170O SRC 32 GL060 0002180O TDESCR 66 GL060 02190O TAMT A 85 GL060 02200O ENDBALA 101 GL060 02210O T 1 LR GL060 02220O 25 'END OF LIST. SUMMARY...' GL060 02230O TAL A 45 GL060 02240O 67 'NET ASSET/LIABILITIES' GL060 0002250O T 1 LR GL060 02260O TRE A 45 GL060 02270O 66 'NET EXPENSE/REVENUES' GL060 02280O T 1 LR GL060 02290O 30 21 '* OUT OF BALANCE *' GL060 02300O GTOT A 45 GL060 02310O 59 'NET ON GLMAST' GL060 00** 002320ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002330ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002340ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002350ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002360** 002370JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 00238000** 002390 THIS MONTHLY UPDATE OF THE GENERAL LEDGER 002400 FILES WILL BE FOR THE MONTH OF XXX, 19XX. 002410 IS THIS CORRECT? (Y/N) 002420 DO YOU WANT TO RE-UPDATE FOR XXX, 19XX? (Y/N) 002430 CONTACT CDC IF YOU NEED HELP. 002440 *** JOB WILL BE CANCELLED *** 00245000 THIS TRIAL RUN OF THE MONTHLY UPDATE OF G L 002460/* 002470__ES WILL BE FOR THE MONTH OF XXX, 19XX. 002410 IS THIS CORRECT? (Y/N) 002420 DO YOU WANT TO RE-UPDATE FOR XXX, 19XX? (Y/N) 002430 CONTACT CDC IF YOU NEED HELP. 002440 *** JOB WILL BE CANCELLED *** 0024500(Fz 7TXGL061 P999999032778(000010H S GL061 00020X DECK-ID A92 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL061 00030F* THIS PROGRAM CLEARS THE GLTRNS FILE GL061 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL061 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL061 00060F* CONTROL DATA PROPRIETARY PRODUCT GL061 00070F* GL061 0000080FGLHEAD IP F 64 DISK GL061 00090FGLTRNS O F 80 DISK GL061 00100F* GL061 00110F* NULL GLTRNS FILE AFTER MONTH-END RUN, CGL060. GL061 00120F* GL061 00130IGLHEAD NS 01 GL061 00140I 1 1 D GL061 0000150OGLTRNS D LR 01N01 GL061 00160O D 1 GL061 ** 000170ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000180ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000190ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000200ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00021000/* 000220__0O D 1 GL061 ** 000170ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000180ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000190ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000200ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002100(^F TXGL065 P999999032778(000010H S GL065 00020X DECK-ID A93 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL065 00030F* THIS PROGRAM PRINTS THE FINANCIAL STATEMENTS GL065 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL065 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL065 00060F* CONTROL DATA PROPRIETARY PRODUCT GL065 00070F* GL065 0000080FGLSEQ IP F 128 DISK GL065 00090F$SYSLISTO F 122 OF PRINTER GL065 00100F********************************************************************GL065 00110F* GL065 00120F* COMPUSOURCE GENERAL LEDGER PACKAGE. GL065 00130F* GL065 00140F* THIS PROGRAM PRINTS THE FINANCIAL STATEMENTS. GL065 0000150F* GL065 00160F********************************************************************GL065 00170F* GL065 00180F* ID F C H L FUNCTION OF INDICATORS GL065 00190F* GL065 00200F* 01 GLSEQ INPUT GL065 00210F* 02 UNUSED RECORD INPUT FROM GLSEQ. IGNORE. GL065 0000220F* 21 EFFECT CODE IS 'N'. PRINT AND ACCUMULATE. GL065 00230F* 22 EFFECT CODE IS 'S'. ACCUMULATE ONLY. GL065 00240F* 23 EFFECT CODE IS 'A'. PRINT ONLY. GL065 00250F* 24 EFFECT CODE IS 'D'. PRINT DATE. GL065 00260F* 25 EFFECT CODE IS '1'. GL065 00270F* 26 EFFECT CODE IS '2'. GL065 00280F* 27 EFFECT CODE IS '3'. GL065 0000290F* 28 EFFECT CODE IS '4'. GL065 00300F* 29 EFFECT CODE IS '5'. GL065 00310F* 30 SPACE CODE IS ZERO. GL065 00320F* 31 SPACE CODE IS 1. GL065 00330F* 32 SPACE CODE IS 2. GL065 00340F* 33 SPACE CODE IS 3. GL065 00350F* 34 SPACE CODE IS 9. GL065 0000360F* 35 EFFECT CODE 'A' & PRINT CODE ZERO. GL065 00370F* 36 EFFECT CODE 'A' & PRINT CODE 1. GL065 00380F* 37 EFFECT CODE 'A' & PRINT CODE 2. GL065 00390F* 38 EFFECT CODE IS '0'. GL065 00400F* 51 NORMAL PRINT. END IN POS 42. GL065 00410F* 52 NORMAL PRINT. END IN POS 82. GL065 00420F* 53 NORMAL PRINT. END IN POS 122. GL065 0000430F* 54 EXCEPTION PRINT SPACE FLAG. GL065 00440F* 55 EXCPT PRINT FOR AN AMOUNT (TYPE N,1-5). GL065 00450F* 56 THIS IS A REVENUE/EXPENSE TYPE ACCOUNT. GL065 00460F* 57 THIS IS A SIGN CODE 'C'. REVERSE SIGN. GL065 00470F* 58 LOOP CONTROL. GL065 00480F* GL065 00490F* GL065 0000500F* GL065 00510F* GL065 00520F* GL065 00530F* GL065 00540E LEVA 6 10 2 CURR ACTUAL GL065 00550E LEVB 6 8 0 CURR BUDGET GL065 00560E LEVC 6 10 2 YTD ACTUAL GL065 0000570E LEVD 6 8 0 YTD BUDGET GL065 00580E MOS 12 12 3 MONTHS OF YR. GL065 00590IGLSEQ XX 01 1 CS GL065 00600I 91 91 TYPE GL065 00610I 92 92 SIGN GL065 00620I 12 12 EFFCT GL065 00630I 13 130SPACE GL065 0000640I 54 540PRINT GL065 00650I 14 53 DESCR GL065 00660I 55 642CRMAC GL065 00670I 65 742YTDAC GL065 00680I 75 820CRMBG GL065 00690I 83 900YTDBG GL065 00700I 2 110ACCT GL065 0000710I NS 02 GL065 00720I 1 1 ZXZX GL065 00730C* GL065 00740C* GL065 00750C* GL065 00760C 02 GOTO END GL065 00770C* GL065 0000780C EFFCT COMP 'N' 21 GL065 00790C EFFCT COMP 'S' 22 GL065 00800C EFFCT COMP 'A' 23 GL065 00810C EFFCT COMP 'D' 24 GL065 00820C EFFCT COMP '1' 25 GL065 00830C EFFCT COMP '2' 26 GL065 00840C EFFCT COMP '3' 27 GL065 0000850C EFFCT COMP '4' 28 GL065 00860C EFFCT COMP '5' 29 GL065 00870C EFFCT COMP '0' 38 GL065 00880C* GL065 00890C SETOF 303132 GL065 00900C SETOF 3334 GL065 00910C SPACE COMP 1 3031 GL065 0000920C N30N31 SPACE COMP 3 343233 GL065 00930C* GL065 00940C PRINT COMP 1 373536 GL065 00950C* GL065 00960C* GL065 00970C Z-ADD1 N 20 GL065 00980C 23 GOTO ALPHA GL065 0000990C 24 GOTO DATE GL065 01000C 21 GOTO NORM GL065 01010C 22 GOTO SUBT GL065 01020C 25 GOTO SL1 GL065 01030C 26 GOTO SL2 GL065 01040C 27 GOTO SL3 GL065 01050C 28 GOTO SL4 GL065 0001060C 29 GOTO SL5 GL065 01070C 38 GOTO SL0 GL065 01080C GOTO END GL065 01090C* GL065 01100C********************************************************************GL065 01110C* GL065 01120C ALPHA TAG GL065 0001130C EXSR NPRINT GL065 01140C GOTO END GL065 01150C* GL065 01160C* GL065 01170C DATE TAG GL065 01180C MOVELUDATE M 20 GL065 01190C MOVE ', 19 ' A9 9 GL065 0001200C MOVE UDATE YR 20 GL065 01210C MOVE YR A9 GL065 01220C MOVELMOS,M A9 GL065 01230C MOVELA9 DESCR GL065 01240C EXSR NPRINT GL065 01250C GOTO END GL065 01260C* GL065 0001270C* GL065 01280C NORM TAG GL065 01290C EXSR ACCUM GL065 01300C LEVA,1 SUB CRMAC LEVA,1 'N' DOES NOT GL065 01310C LEVB,1 SUB CRMBG LEVB,1 ACCUMULATE GL065 01320C LEVC,1 SUB YTDAC LEVC,1 IN LEVEL 0. GL065 01330C LEVD,1 SUB YTDBG LEVD,1 GL065 0001340C EXSR APRINT GL065 01350C GOTO END GL065 01360C* GL065 01370C SUBT TAG GL065 01380C EXSR ACCUM GL065 01390C GOTO END GL065 01400C* GL065 0001410C SL5 TAG GL065 01420C N ADD 1 N GL065 01430C SL4 TAG GL065 01440C N ADD 1 N GL065 01450C SL3 TAG GL065 01460C N ADD 1 N GL065 01470C SL2 TAG GL065 0001480C N ADD 1 N GL065 01490C SL1 TAG GL065 01500C N ADD 1 N GL065 01510C SL0 TAG GL065 01520C Z-ADDLEVA,N CRMAC GL065 01530C Z-ADDLEVB,N CRMBG GL065 01540C Z-ADDLEVC,N YTDAC GL065 0001550C Z-ADDLEVD,N YTDBG GL065 01560C EXSR ZROUT GL065 01570C EXSR APRINT GL065 01580C GOTO END GL065 01590C* GL065 01600C END TAG GL065 01610C* GL065 0001620C********************************************************************GL065 01630CSR NPRINT BEGSR NORMAL PRINT. GL065 01640CSR SETOF 515253 THEN SPACE. GL065 01650CSRN23 SETON 51 GL065 01660CSR 23 35 SETON 51 GL065 01670CSR 23 36 SETON 52 GL065 01680CSR 23 37 SETON 53 GL065 0001690CSR EXCPT GL065 01700CSR SETOF 345152 GL065 01710CSR SETOF 53 GL065 01720CSR SETON 54 GL065 01730CSR EXCPT SPACE GL065 01740CSR SETOF 313233 GL065 01750CSR SETOF 54 GL065 0001760CSR ENDSR GL065 01770C********************************************************************GL065 01780CSR APRINT BEGSR GL065 01790CSR SIGN COMP 'C' 57 GL065 01800CSR 57 Z-SUBCRMAC CRMAC CHANGE SIGN GL065 01810CSR 57 Z-SUBYTDAC YTDAC IF APPROPRIATEGL065 01820CSR 57 Z-SUBCRMBG CRMBG GL065 0001830CSR 57 Z-SUBYTDBG YTDBG GL065 01840CSR SETON 55 PRINT AMOUNT GL065 01850CSR EXCPT GL065 01860CSR SETOF 3455 GL065 01870CSR SETON 54 SPACE GL065 01880CSR EXCPT GL065 01890CSR SETOF 313233 GL065 0001900CSR SETOF 54 GL065 01910CSR ENDSR GL065 01920C********************************************************************GL065 01930CSR ACCUM BEGSR GL065 01940CSR TYPE COMP 'R' 56 GL065 01950CSRN56 TYPE COMP 'E' 56 GL065 01960CSR CRMAC ADD LEVA LEVA GL065 0001970CSR CRMBG ADD LEVB LEVB GL065 01980CSR YTDAC ADD LEVC LEVC GL065 01990CSR YTDBG ADD LEVD LEVD GL065 02000CSR ENDSR GL065 02010C********************************************************************GL065 02020CSR ZROUT BEGSR ZERO OUT GL065 02030CSR SETOF 58 LEVEL ARRAYS GL065 0002040CSR ZRTAG TAG GL065 02050CSR Z-ADD0 LEVA,N GL065 02060CSR Z-ADD0 LEVB,N GL065 02070CSR Z-ADD0 LEVC,N GL065 02080CSR Z-ADD0 LEVD,N GL065 02090CSR N SUB 1 N 5858 GL065 02100CSRN58 GOTO ZRTAG GL065 0002110CSR ENDSR GL065 02120C********************************************************************GL065 02130O$SYSLISTE 01 34 GL065 02140O 1 ' ' GL065 02150O E 0 51 GL065 02160O DESCR 42 GL065 02170O E 0 52 GL065 0002180O DESCR 82 GL065 02190O E 0 53 GL065 02200O DESCR 122 GL065 02210O E 10 54 31 GL065 02220O 1 ' ' GL065 02230O E 20 54 32 GL065 02240O 1 ' ' GL065 0002250O E 30 54 33 GL065 02260O 1 ' ' GL065 02270O E 0 55 GL065 02280O DESCR B 42 GL065 02290O 56 CRMAC A 59 GL065 02300O 56 CRMBG A 73 GL065 02310O 56 YTDAC A 95 GL065 0002320O 56 YTDBG A 109 GL065 02330O N56 YTDAC A 59 GL065 02340O N56 YTDBG A 73 GL065 ** 002350ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002360ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002370ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00238000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002390** 002400JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 002410/* 002420__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002360ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002370ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0023800(GE TXGL100 P999999032778(000010H S GL100 00020X DECK-ID A94 MFG/DIST/ACCT SYSTEM SUMMARY-123 GL100 00030F* THIS PROGRAM DOES YEAR-END UPDATE AND GENL LEDGER DETAIL REPORT GL100 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0GL100 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA GL100 00060F* CONTROL DATA PROPRIETARY PRODUCT GL100 00070F* GL100 0000080FGLHEAD UD F 64 DISK GL100 00090FGLUPDT IP AF 73 DISK GL100 00100FGLYEAR IS AF 66 DISK GL100 00110FGLMAST UC F 280R10AI 1 DISK GL100 00120F$SYSLISTO F 132 OF LPRINTER GL100 00130F********************************************************************GL100 00140F* *GL100 0000150F* YEAR-END UPDATE OF GLMAST. IF THERE ARE TRANSACTIONS ON GLYEAR *GL100 00160F* AND TTHEIR NET DDISAGREES WITH THE ACTUAL AMOUNTS ON GLMAST, *GL100 00170F* THE GLMAST AMOUNTS TAKE PRECEDENCE. *GL100 00180F********************************************************************GL100 00190F* GL100 00200F* MODIFIED 03/24/76 SO THAT 'LMU' FROM GLUPDT WILL BE CONSIDERED GL100 00210F* TO BE ONE LESS THAN 'LMU' FROM GLMAST. GL100 0000220F********************************************************************GL100 00230F* ID F C H L FUNCTION OF INDICATORS GL100 00240F* GL100 00250F* 01 INPUT FROM GLHEAD. GL100 00260F* 02 INPUT FROM GLUPDT, 'B' RECORD. GL100 00270F* 03 GLUPDT 'C' RECORD. -IGNORE- GL100 00280F* 04 GLYEAR INPUT. GL100 0000290F* 05 GLMAST INPUT. GL100 00300F* L1 ACCT MONTH. GL100 00310F* M1 L2 ACCOUNT NUMBER GL100 00320F* 21 FIRST CYCLE HAS BEEN PROCESSED. GL100 00330F* 22 SECOND CYCLE HAS BEEN PROCESSED. GL100 00340F* H1 NO RECORD ON GLHEAD. GL100 00350F* 23 LAST MONTH OF FISCAL YEAR IS IN DIFF CALENDAR YEAR. GL100 0000360F* 24 (Y/N) PROMPT GAVE A 'Y' RESPONSE. GL100 00370F* 25 THIS ACCT WAS LAST UPDATED FOR A MONTH OTHER THAN GL100 00380F* THE LAST MONTH OF THE FISCAL YEAR. GL100 00390F* 26 CANCEL THE JOB. GL100 00400F* H2 ACCT ON GLUPDT BUT NOT GLMAST. GL100 00410F* 27 THIS ACCT IS ASSET/LIABILITY. GL100 00420F* 28 THIS ACCT IS REVENUE/EXPENSE. GL100 0000430F* 29 THERE WAS AT LEAST ONE GLYEAR REC FOR THIS ACCT. GL100 00440F* 30 THIS IS A NEW ACCT MONTH ON GLYEAR. GL100 00450F* 31 THIS ACCT MONTH IS LESS THAN FIST FISCAL MONTH. GL100 00460F* GL100 00470F* GL100 00480F* GL100 00490F* GL100 0000500E ACT 12 10 2 ACTUAL ANTS. GL100 00510E MSG 1 6 62 MESSAGES. GL100 00520E MOS 12 12 3 MONTH ABBR'S. GL100 00530E ZRA 12 10 2 ZERO ARRAY GL100 00540L$SYSLIST 66FL 60OL GL100 00550IGLHEAD NS 01 GL100 00560I 1 40 CNAME GL100 0000570I 41 44 FMMYY GL100 00580IGLUPDT NS 02 1 CB GL100 00590I 2 110ACCT L2M1 GL100 00600I 12 130LMU GL100 00610I 14 43 ADESCR GL100 00620I NS 03 1 CC GL100 00630I 2 110ACCT L2M1 GL100 0000640IGLYEAR NS 04 GL100 00650I 1 100ACCT L2M1 GL100 00660I 11 18 SRC GL100 00670I 19 48 TDESCR GL100 00680I 49 540TDATE GL100 00690I 55 642TAMT GL100 00700I 65 660PM L1 GL100 0000710IGLMAST NS 05 GL100 00720I 11 11 ATYPE GL100 00730I 149 268 ACT GL100 00740I 269 2700LMU GL100 00750I 43 522YBALF GL100 00760I 13 42 ADESCR GL100 00770I* GL100 0000780I* GL100 00790C 21 SETON 22 GL100 00800C N21 EXSR FIRST GL100 00810C 26 SETON LR GL100 00820C 26 GOTO LAST GL100 00830C L2 SETOF 29 GL100 00840C 02 GOTO BREC GL100 0000850C 03 GOTO LAST GL100 00860C 04 GOTO GLYREC GL100 00870C GOTO LAST GL100 00880C* GL100 00890C BREC TAG GL100 00900C LMU ADD 1 LMU GLUPDT HAS *GL100 00910C LMU COMP 13 23'LMU' 1 LESS GL100 0000920C 23 Z-ADD1 LMU THAN GLMAST. GL100 00930C N99 EXSR VERIFY GL100 00940C SETON 99 GL100 00950C 25 GOTO LAST GL100 00960C ACCT CHAINGLMAST H2 GL100 00970C H2 GOTO LAST GL100 00980C XFOOTACT YTACT 102 GL100 0000990C EXSR VERIFY GL100 01000C 25 GOTO LAST GL100 01010C SETOF 2728 GL100 01020C ATYPE COMP 'A' 27 GL100 01030C N27 ATYPE COMP 'L' 27 GL100 01040C N27 SETON 28 GL100 01050C YBALF ADD YTACT NEWBAL 102 GL100 0001060C GOTO LAST GL100 01070C* GL100 01080C* GL100 01090C GLYREC TAG GL100 01100C SETON 29 GL100 01110C PM COMP SVM 3030 GET ACCT-MO GL100 01120C N30 GOTO GTAG1 NAME. GL100 0001130C PM ADD FM TM 20 GL100 01140C TM SUB 1 TM GL100 01150C TM COMP 12 31 GL100 01160C 31 TM SUB 12 TM GL100 01170C MOVE MOS,TM PRMO 3 GL100 01180C Z-ADDPM SVM 20 GL100 01190C* GL100 0001200C GTAG1 TAG GL100 01210C TAMT ADD MOTOT MOTOT 102 GL100 01220C TAMT ADD YRTOT YRTOT 102 GL100 01230C GOTO LAST GL100 01240C* GL100 01250C LAST TAG GL100 01260C* GL100 0001270C********************************************************************GL100 01280CLR FY ADD 1 FY UPDATE GLHEAD GL100 01290CLRN26 EXCPT GL100 01300CLR Z-ADD0 Z10 102 DEFINE-Z10 GL100 01310C********************************************************************GL100 01320CSR CRTCOM BEGSR GL100 01330CSR EXITFSUBRCM GL100 0001340CSR RLABL BUFFER 72 GL100 01350CSR RLABL TYPE 1 GL100 01360CSR RLABL BLNGTH 20 GL100 01370CSR RLABL RCODE 1 GL100 01380CSR RLABL MASK 10 GL100 01390CSR RLABL DTYPE 10 GL100 01400CSR ENDSR GL100 0001410C********************************************************************GL100 01420CSR FIRST BEGSR GL100 01430CSR SETON 21 GL100 01440CSR MOVELMSG,1 BUFFER PRINT GL100 01450CSR MOVE 'T' TYPE MESSAGES GL100 01460CSR Z-ADD62 BLNGTH GL100 01470CSR EXSR CRTCOM GL100 0001480CSR READ GLHEAD H1 GL100 01490CSR H1 GOTO FREND GL100 01500CSR MOVELFMMYY FM 20 DETERMINE LAST GL100 01510CSR MOVE FMMYY FY 20 MONTH IN GL100 01520CSR FM ADD 11 LM 20 FISCAL YEAR. GL100 01530CSR LM COMP 12 23 GL100 01540CSR 23 LM SUB 12 LM GL100 0001550CSR 23 FY ADD 1 LY 20 GL100 01560CSRN23 Z-ADDFY LY GL100 01570CSR MOVEL'FOR' A7 7 GL100 01580CSR MOVE ',19 ' A12 12 GL100 01590CSR MOVE MOS,LM A7 GL100 01600CSR MOVELA7 A12 GL100 01610CSR MOVE LY A12 GL100 0001620CSR MOVE A12 A13 13 GL100 01630CSR MOVELMSG,2 BUFFER GL100 01640CSR EXSR CRTCOM GL100 01650CSR MOVELMSG,3 BUFFER GL100 01660CSR MOVELA13 BUFFER GL100 01670CSR EXSR CRTCOM GL100 01680CSR MOVEL' ' BUFFER SPACE ONE GL100 0001690CSR Z-ADD2 BLNGTH LINE. GL100 01700CSR EXSR CRTCOM GL100 01710CSR MOVELMSG,4 BUFFER ISSUE GL100 01720CSR Z-ADD33 BLNGTH PROMPT. GL100 01730CSR MOVE 'S' TYPE GL100 01740CSR EXSR CRTCOM GL100 01750CSR MOVE 'A' TYPE ACCEPT GL100 0001760CSR Z-ADD1 BLNGTH Y/N REPLY. GL100 01770CSR EXSR CRTCOM GL100 01780CSR MOVELBUFFER YORN 1 IF NOT 'Y', GL100 01790CSR YORN COMP 'Y' 24 CANCEL JOB. GL100 01800CSR 24 GOTO FREND GL100 01810CSR SETON LR26 GL100 01820CSR MOVELMSG,5 BUFFER DISPLAY 'JOB GL100 0001830CSR Z-ADD16 BLNGTH CANCELLED' GL100 01840CSR MOVE 'T' TYPE MESSAGE. GL100 01850CSR EXSR CRTCOM GL100 01860CSR FREND ENDSR GL100 01870C********************************************************************GL100 01880C* CHECK TO SEE THAT LAST MONTH OF FISCAL YR HAS BEEN UPDATED. GL100 01890C* GL100 0001900CSR VERIFY BEGSR GL100 01910CSR LMU COMP LM 2525 GL100 01920CSRN25 GOTO VEND GL100 01930CSR MOVELMSG,5 A32 32 ERROR. GL100 01940CSR MOVE ACCT A32 CANCEL JOB. GL100 01950CSR Z-ADD33 BLNGTH GL100 01960CSR MOVE 'T' TYPE GL100 0001970CSR MOVELA32 BUFFER GL100 01980CSR EXSR CRTCOM GL100 01990CSR MOVELMSG,6 A28 28 GL100 02000CSR MOVE MOS,LM A28 GL100 02010CSR MOVELA28 BUFFER GL100 02020CSR Z-ADD28 BLNGTH GL100 02030CSR EXSR CRTCOM GL100 0002040CSR SETON LR26 GL100 02050CSR VEND ENDSR GL100 02060OGLHEAD E LRN26 GL100 02070O FY 44 GL100 02080OGLMAST D 02N26NH2 GL100 02090O 27 NEWBAL 52 GL100 02100O 28 Z10 52 GL100 0002110O ZRA 268 GL100 02120O$SYSLISTH 203 21N22 GL100 02130O OR OF GL100 02140O CNAME 84 GL100 02150O H 3 21N22 GL100 02160O OR OF GL100 02170O 16 'CGL100 RUN-' GL100 0002180O UDATE Y 24 GL100 02190O 56 'GENERAL LEDGER CHANGES' GL100 02200O 79 'FOR FISCAL YEAR 19' GL100 02210O 93 'THRU 19' GL100 02220O MOS,FM 76 GL100 02230O FY 81 GL100 02240O MOS,LM 90 GL100 0002250O LY 95 GL100 02260O 128 'PAGE' GL100 02270O PAGE Z 132 GL100 02280O H 1 21N22 GL100 02290O OR OF GL100 02300O 59 'TRANS ACCT' GL100 02310O 98 'TRANS MASTERFILE' GL100 0002320O 132 'BEG BAL TYPE' GL100 02330O H 2 21N22 GL100 02340O OR OF GL100 02350O 24 'ACCOUNT# DESCRIPTION' GL100 02360O 66 'DATE MNTH SOURCE' GL100 02370O 82 'AMOUNT' GL100 02380O 98 'AMOUNT' GL100 0002390O 125 'NEXT YEAR' GL100 02400O D 1 02 GL100 02410O ACCT Z 11 GL100 02420O ADESCR 43 GL100 02430O YBALF A 100 GL100 02440O 112 '* BAL FWD *' GL100 02450O D 1 04 GL100 0002460O ACCT Z 11 GL100 02470O TDESCR 45 GL100 02480O TDATE Y 54 GL100 02490O PRMO 58 GL100 02500O SRC 68 GL100 02510O TAMT A 84 GL100 02520O TF11 L1 29 GL100 0002530O ACCT Z 11 GL100 02540O 32 '* MONTHLY TOTALS *' GL100 02550O PRMO 58 GL100 02560O MOTOT AB 84 GL100 02570O ACT,TMA 100 GL100 02580O 112 '* MNTH NET*' GL100 02590O T 13 L2 GL100 0002600O ACCT Z 11 GL100 02610O 33 '** YEARLY TOTALS **' GL100 02620O 29 YRTOT AB 84 GL100 02630O YTACT A 100 GL100 02640O 112 '* YTD NET *' GL100 02650O 27 NEWBALA 128 GL100 02660O 28 Z10 A 128 GL100 0002670O ATYPE 130 GL100 02680O T 33 LR 26 GL100 02690O A32 40 GL100 02700O A28 68 GL100 ** 002710ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00273000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002750** 002760 THIS IS THE YEARLY UPDATE OF THE GENERAL LEDGER MASTERFILE. 002770 THIS JOB SHOULD NOT BE RUN UNTIL AFTER THE MONTH-END UPDATE 002780 FOR XXX,19XX HAS BEEN RUN. 002790 ARE YOU READY TO BEGIN ? (Y/N) 00280000 JOB CANCELLED. ACCT# XXXXXXXXXX 002810 HASN'T BEEN UPDATED FOR XXX 002820** 002830JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC 002840/* 002850__ XXX,19XX HAS BEEN RUN. 002790 ARE YOU READY TO BEGIN ? (Y/N) 0028000(G NPTXAPTRNF P999999032778(000010H S APTRNF00020X DECK-ID A95 MFG/DIST/ACCT SYSTEM SUMMARY-123 APTRNF00030F* UPDATES GL FILES FROM ACCOUNTS PAYABLE FILE CREATED AT END MONTH APTRNF00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0APTRNF00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA APTRNF00060F* CONTROL DATA PROPRIETARY PRODUCT APTRNF00070F* APTRNF0000080FAPGLIN IPEAF 80 DISK APTRNF00090FGLDATA O F 80 DISK A APTRNF00100FNWGLIN O F 80 DISK APTRNF00110F* ID F C H L FUNCTION OF INDICATORS APTRNF00120F* 01 APGLIN APTRNF00130F* 20 RECORD IS FROM CURRENT MONTH APTRNF00140F* 75 FIRST CYCLE APTRNF0000150F* 76 CONDITIONS 75 APTRNF00160E MSG 1 1 23 APTRNF00170IAPGLIN AA 01 APTRNF00180I 1 80 ALL80 APTRNF00190I 49 500TRANM APTRNF00200C SETOF 75 APTRNF00210C N76 SETON 7576 APTRNF0000220C MOVE 'C' TYPE APTRNF00230C EXSR CRTCOM APTRNF00240C 75 EXSR GETDAT APTRNF00250C TRANM COMP CRTM 2020 APTRNF00260CLR MOVE 'C' TYPE APTRNF00270CLR EXSR CRTCOM APTRNF00280CSR GETDAT BEGSR APTRNF0000290CSR MOVE MSG,1 WORD23 23 APTRNF00300CSR MOVEL0102 BUFFER APTRNF00310CSR MOVE 23 BLNGTH APTRNF00320CSR EXSR POSCUR APTRNF00330CSR MOVE 'S' TYPE APTRNF00340CSR MOVELWORD23 BUFFER APTRNF00350CSR EXSR CRTCOM APTRNF0000360CSR MOVEL2502 BUFFER APTRNF00370CSR EXSR POSCUR APTRNF00380CSR MOVE 'A' TYPE APTRNF00390CSR EXSR CRTCOM APTRNF00400CSR MOVELBUFFER CRTM 20 APTRNF00410CSR ENDDAT ENDSR APTRNF00420C********************************************************************APTRNF0000430C* APTRNF00440C* THIS SUBROUTINE POSITIONS THE CURSOR. APTRNF00450C* APTRNF00460C********************************************************************APTRNF00470CSR POSCUR BEGSR APTRNF00480CSR MOVE 'P' TYPE APTRNF00490CSR EXSR CRTCOM APTRNF0000500CSR ENDSR APTRNF00510C* APTRNF00520C********************************************************************APTRNF00530C* APTRNF00540C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. APTRNF00550C* APTRNF00560C********************************************************************APTRNF0000570CSR CRTCOM BEGSR APTRNF00580CSR EXITFSUBRCM APTRNF00590CSR RLABL BUFFER 72 APTRNF00600CSR RLABL TYPE 1 APTRNF00610CSR RLABL BLNGTH 20 APTRNF00620CSR RLABL RCODE 1 APTRNF00630CSR RLABL MASK 10 APTRNF0000640CSR RLABL DTYPE 10 APTRNF00650CSR ENDSR APTRNF00660C* APTRNF00670OGLDATA DADD 01 20 APTRNF00680O ALL80 80 APTRNF00690ONWGLIN D 01N20 APTRNF00700O ALL80 80 APTRNF00** 000710ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000730ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000750** 000760ENTER TRANSACTION MONTH 00077000/* 000780__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000730ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000750** 000760ENTER TRANSACTION MONTH 0007700(dH: *TXCHACT P999999032778(000010H S CHACT 00020X DECK-ID A98 MFG/DIST/ACCT SYSTEM SUMMARY-123 CHACT 00030F* BUILDS CHART OF ACCOUNT FILE FROM GLMAST FILE CHACT 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0CHACT 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA CHACT 00060F* CONTROL DATA PROPRIETARY PRODUCT CHACT 00070F* CHACT 0000080FGLMAST IPEAF 280 10AI 1 DISK CHACT 00090FCHRTAC O F 48 10AI 1 DISK CHACT 00100F* CHACT 00110F* THIS PROGRAM CREATES A CHART OF ACCOUNTS FILE (CHRTAC) FOR THE CHACT 00120F* GENERAL LEDGERLE PACKAGE FROM THE GENERAL LEDGER MASTER FILE CHACT 00130F* (GLMAST) IN THE GENERAL LEDGER PACKAGE. CHACT 00140F* CHACT 0000150IGLMAST NS 01 CHACT 00160I 1 10 ACTNO CHACT 00170I 11 11 TYPE CHACT 00180I 13 37 DESC CHACT 00190I 37 42 DESC1 CHACT 00200I 43 280 UNUSED CHACT 00210C SETON 06 CHACT 0000220C MOVE ' ' FILL 18 CHACT 00230OCHRTAC D 06 CHACT 00240O ACTNO 10 CHACT 00250O DESC 35 CHACT 00260O FILL 48 CHACT ** 000270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00028000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000290ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000300ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000310/* 000320__0O FILL 48 CHACT ** 000270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0002800(He <TXJORNL P999999032778(000010H S JORNL 00020X DECK-ID A97 MFG/DIST/ACCT SYSTEM SUMMARY-123 JORNL 00030F* DATA AND DATA CORRECTION ENTRY PROGRAM FOR INPUT FILE JEINPT JORNL 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0JORNL 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA JORNL 00060F* CONTROL DATA PROPRIETARY PRODUCT JORNL 00070F* JORNL 0000080F* JORNL 00090F* 'KYPEDT' FOR COMPUSOURCE A/P PACKAGE. JORNL 00100F* JORNL 00110F* JORNL 00120F****************************************************************** JORNL 00130F* JORNL 00140F* THIS IS A MODIFICATION OF 'KEYPCH' WHICH ALLOWS: JORNL 0000150F* 1) AUTOMATIC PROGRAM LEVEL SWITCHING, JORNL 00160F* 2) GANG-PUNCH FIELDS (CONSTANT INSERTION), JORNL 00170F* 3) EDIT FLAGGING OF FIELDS FOR PROCESSING BY SUBROUTINE JORNL 00180F* 'EDIT' INTERNAL TO THIS PROGRAM. JORNL 00190F* 4) EIGHT PROGRAM LEVELS JORNL 00200F* 5) AUTOMATIC LOADING OF THE 8 LEVELS BASED ON THE 1ST RECORD JORNL 00210F* IN THE FILE GLDUM JORNL 0000220F* 6) IF MODE IS 'A', THE STARTING SEQ# WILL AUTOMATICALLY BE THE JORNL 00230F* FIRST RECORD WITH '<>' IN BYTES 1-2. JORNL 00240F* JORNL 00250F* JORNL 00260F* JORNL 00270F********************************************************************JORNL 00280FGLDUM IPEAF 72 DISK JORNL 0000290FKPROGX IC F 40R 8AI 1 DISK JORNL 00300FJEINPT UC F 128R DISK JORNL 00310F****************************************************************** JORNL 00320F* THE FILES BELOW ARE USED STRICTLY FOR EDITING. JORNL 00330FCHRTAC IC F 48R10AI 1 DISK JORNL 00340FOUTCHK IC F 48R 5AI 1 DISK JORNL 00350FVENDOR IC F 256R 5AI 1 DISK JORNL 0000360FVENINV IC F 32R13AI 1 DISK JORNL 00370F********************************************************************JORNL 00380E ARY1 1 2 50 JORNL 00390E MSG 1 8 25 JORNL 00400E SFN 160 20 FIELD NAMES. JORNL 00410E SAN 160 1 ALPH OR NUM JORNL 00420E SAD 160 1 AUTO DUP FLAGS JORNL 0000430E SST 160 3 0 FIELD START JORNL 00440E SLN 160 2 0 FIELD LENGTHS JORNL 00450E SEF 160 2 EDIT FLAGS JORNL 00460E SGP 160 1 GANG PUNCH FLGS JORNL 00470E SNP 8 1 0 NEXT PROG# JORNL 00480E SNM 8 6 PROG NAMES JORNL 00490E SMX 8 3 0 MAX INDX'S JORNL 0000500E EMS 1 8 30 EDIT MESSAGES JORNL 00510IGLDUM NS 01 JORNL 00520I 1 48 SNM JORNL 00530IKPROGX NS 02 36NCD JORNL 00540I 9 28 FN JORNL 00550I 29 29 AN JORNL 00560I 30 30 AD JORNL 0000570I 31 33 ST JORNL 00580I 34 35 LN JORNL 00590I 36 36 DCODE JORNL 00600I 37 37 NPL JORNL 00610I 38 38 GP JORNL 00620I 39 40 EF JORNL 00630I NS 03 JORNL 0000640I 1 1 A JORNL 00650IJEINPT NS 05 JORNL 00660I 1 2 RC JORNL 00670I 1 128 RECORD JORNL 00680I****************************************************************** JORNL 00690I* INPUT SPECS FOR EDITING FILES ARE LISTED BELOW. JORNL 00700ICHRTAC NS 09 JORNL 0000710I 1 1 @XX JORNL 00720IOUTCHK NS 09 JORNL 00730I 1 1 @XX JORNL 00740IVENDOR NS 09 JORNL 00750I 1 1 @XX JORNL 00760IVENINV NS 09 JORNL 00770I 1 1 @XX JORNL 0000780C* JORNL 00790C* JORNL 00800C* JORNL 00810C EXSR ALMTS JORNL 00820C Z-ADDLOW SEQNO JORNL 00830C MOVE ' ' B72 72 JORNL 00840C Z-ADD1 PN LOAD INITIAL JORNL 0000850C LDLOOP TAG PROGS FROM 1STJORNL 00860C SNM,PN COMP ' ' 2626 48 BYTES OF JORNL 00870C MOVELSNM,PN PNAME JORNL 00880C MOVE ' ' PNAME JORNL 00890C 26 EXSR GETPRG 'DUMMY' REC. JORNL 00900C PN ADD 1 PN JORNL 00910C PN COMP 8 2626 JORNL 0000920C 26 GOTO LDLOOP JORNL 00930C NLR SETON LR JORNL 00940CLR MOVE '1' RTNLVL 10 JORNL 00950CLR MOVE '1' TERMNL 10 JORNL 00960CLR START TAG JORNL 00970CLR EXSR SKIP JORNL 00980CLR MOVE 'C' TYPE JORNL 0000990CLR EXITFSUBRCM JORNL 01000CLR RLABL BUFFER 72 JORNL 01010CLR RLABL TYPE JORNL 01020CLR RLABL BLNGTH JORNL 01030CLR RLABL RCODE JORNL 01040CLR RLABL MASK JORNL 01050CLR RLABL DTYPE JORNL 0001060CLR MOVEL'>MODE-' WORD 16 JORNL 01070CLR Z-ADD6 OLN 20 JORNL 01080CLR Z-ADD1 ILN 20 JORNL 01090CLR EXSR TYPES JORNL 01100CLR MOVELNBUF MODE 1 JORNL 01110CLR CHKMOD TAG JORNL 01120CLR SETOF 9095 JORNL 0001130CLR MODE COMP 'A' 62 JORNL 01140CLR MODE COMP 'C' 63 JORNL 01150CLR MODE COMP 'V' 64 JORNL 01160CLR MODE COMP 'K' 65 JORNL 01170CLR MODE COMP 'E' 66 JORNL 01180CLR 66 GOTO EOJ JORNL 01190CLR 65 EXSR GETPRG JORNL 0001200CLR 65 GOTO START JORNL 01210CLRN62N63N64 SETON 81 JORNL 01220CLR 81 EXSR EXCPT JORNL 01230CLR SETOF 81 JORNL 01240CLRN62N63N64 GOTO START JORNL 01250CLR EXSR GETPRG JORNL 01260CLRN63N95N62 EXSR GETSEQ JORNL 0001270CLR 86 GOTO EOJ JORNL 01280CLR SAMREC TAG JORNL 01290CLR SEQNO SUB 1 SEQNO 50 JORNL 01300CLR NXTREC TAG JORNL 01310CLR EXSR SKIP JORNL 01320CLR MOVE 'C' TYPE JORNL 01330CLR EXITFSUBRCM JORNL 0001340CLR RLABL BUFFER JORNL 01350CLR RLABL TYPE JORNL 01360CLR RLABL BLNGTH JORNL 01370CLR RLABL RCODE JORNL 01380CLR RLABL MASK JORNL 01390CLR RLABL DTYPE JORNL 01400CLR SETOF 2630 26=1ST FLD FLG JORNL 0001410CLR SETON 18 JORNL 01420CLR 63 EXSR GETSEQ JORNL 01430CLRN63 SEQNO ADD 1 SEQNO JORNL 01440CLR EXSR GETREC JORNL 01450CLR 62 EXSR PUTSEQ JORNL 01460CLRN98N62 EXSR GETSEQ JORNL 01470CLRN98 62 GOTO EOJ JORNL 0001480CLR 62 MOVE OLDREC RECORD JORNL 01490CLR Z-ADDBP N 30 JORNL 01500CLR LOOP TAG JORNL 01510CLR 27 28 90N SUB 2 N JORNL 01520CLR N COMP BP 2920 JORNL 01530CLR 20 GOTO NXTMOD JORNL 01540CLR N ADD 1 N JORNL 0001550CLR N COMP MAXFLD 20 JORNL 01560CLR 20N29 SETON 83 NO FIELDS JORNL 01570CLR 83 EXSR EXCPT JORNL 01580CLR SETOF 83 JORNL 01590CLR 20N29 GOTO START JORNL 01600CLR 20 GOTO OUTREC JORNL 01610C** 30 HERE MEANS '@' ON PRIOR FIELD FOR THIS RECORD. JORNL 0001620CLR 30 GOTO SVFLD JORNL 01630C** JORNL 01640CLR SGP,N COMP ' ' 2323 GANG PUNCH? JORNL 01650CLR N23 GOTO CHKAD JORNL 01660CLR MOVELB72 BUFFER JORNL 01670CLR MOVELSFN,N BUFFER YES... JORNL 01680CLR Z-ADDSLN,N BLNGTH PUT 1ST LN JORNL 0001690CLR EXSR EXCPT CHARS OF FIELDJORNL 01700CLR EXSR SKIP IN BUFFER. JORNL 01710CLR MOVE 'O' RCODE JORNL 01720CLR GOTO CHKVER JORNL 01730CLR CHKAD TAG JORNL 01740CLR SAD,N COMP 'D' 27 JORNL 01750CLR 27 62 90 JORNL 0001760COR 27 64 90 GOTO LOOP JORNL 01770CLR 62 GOTO SKIPMV JORNL 01780CLR EXSR MVRECD JORNL 01790CLR MOVE BUFFER TBUF 72 JORNL 01800CLR SKIPMV TAG JORNL 01810CLR OUTFLD TAG JORNL 01820CLR SETON 84 OUTPUT FIELD JORNL 0001830CLR EXSR EXCPT NAME JORNL 01840CLR SETOF 8418 JORNL 01850CLR 62 SETOF 8418 JORNL 01860CLR 62 GOTO RDCRT JORNL 01870CLR MOVE SLN,N BLNGTH JORNL 01880CLR SETON 19 JORNL 01890CLR MOVE TBUF BUFFER JORNL 0001900CLR EXSR EXCPT JORNL 01910CLR RDCRT TAG JORNL 01920CLR SETOF 2728 JORNL 01930CLR MOVE B72 BUFFER JORNL 01940CLR MOVE 'A' TYPE 1 JORNL 01950CLR Z-ADDSLN,N BLNGTH 20 JORNL 01960CLR EXITFSUBRCM JORNL 0001970CLR RLABL BUFFER 72 JORNL 01980CLR RLABL TYPE 1 JORNL 01990CLR RLABL BLNGTH 20 JORNL 02000CLR RLABL RCODE 1 JORNL 02010CLR RLABL MASK 10 JORNL 02020CLR RLABL DTYPE 10 JORNL 02030CLR EXSR SKIP JORNL 0002040CLR RCODE COMP 'O' 20 JORNL 02050CLR RCODE COMP 'L' 20 JORNL 02060CLR 20 GOTO RITDUP JORNL 02070CLR RCODE COMP 'R' 20 JORNL 02080CLR 20 BUFFER COMP B72 21 JORNL 02090CLR 20N21 EXSR SKIP JORNL 02100CLR 20N21 N SUB 1 N JORNL 0002110CLR 20 21 N SUB 2 N 28 28 JORNL 02120CLRN20 GOTO CHKNUM JORNL 02130CLR N29 GOTO NXTMOD JORNL 02140CLR 21N26 GOTO NXTMOD RUB ON 1ST JORNL 02150CLR SETOF 26 JORNL 02160CLR GOTO LOOP JORNL 02170CLR NXTMOD TAG JORNL 0002180CLR EXSR SKIP JORNL 02190CLR SETOF 28 JORNL 02200CLR MOVEL'MODE-' WORD JORNL 02210CLR Z-ADD5 OLN JORNL 02220CLR Z-ADD1 ILN JORNL 02230CLR EXSR TYPES JORNL 02240CLR MOVELBUFFER MODE JORNL 0002250CLR MODE COMP 'P' 60 NEW PROG#ONLY JORNL 02260CLR MODE COMP 'D' 61 AUTO-DUP ONLY JORNL 02270CLRN60N61 GOTO CHKMOD NEW MODE JORNL 02280CLR EXSR GETPRG JORNL 02290CLR SETOF 6061 JORNL 02300CLR GOTO SAMREC JORNL 02310CLR CHKNUM TAG JORNL 0002320CLR SETON 26 A FLD HAS JORNL 02330C** BEEN ENTERED JORNL 02340CLR MOVELBUFFER MODE JORNL 02350CLR MODE COMP '@' 20 JORNL 02360CLRN20 GOTO NOAT JORNL 02370CLR 64 GOTO NOAT JORNL 02380CLR SETON 30 30= '@' FLAG JORNL 0002390CLR MOVELB72 BUFFER JORNL 02400CLR GOTO SVFLD JORNL 02410CLR NOAT TAG JORNL 02420CLR SAN,N COMP 'N' 19 JORNL 02430CLRN19 GOTO CHKVER JORNL 02440CLR Z-ADDSLN,N VL 20 JORNL 02450CLR MOVELBUFFER VAR 15 JORNL 0002460CLR EXIT SUBRAJ JORNL 02470CLR RLABL VL JORNL 02480CLR RLABL VAR JORNL 02490CLR MOVELVAR BUFFER JORNL 02500CLR Z-ADDVL BLNGTH JORNL 02510CLR EXSR EXCPT JORNL 02520CLR CHKVER TAG JORNL 0002530CLR EXSR SKIP JORNL 02540CLR N64 GOTO MOVBUF JORNL 02550CLR TBUF COMP BUFFER 2020 JORNL 02560CLRN20 GOTO MOVBUF JORNL 02570CLR MOVEL'KP VERIF'WORD JORNL 02580CLR MOVE 'Y ERROR 'WORD JORNL 02590CLR MOVELWORD BUFFER JORNL 0002600CLR MOVE 'R' TYPE JORNL 02610CLR Z-ADD6 MASK ONLY 'R' OR 'E'JORNL 02620CLR EXITFSUBRCM JORNL 02630CLR RLABL BUFFER 72 JORNL 02640CLR RLABL TYPE 1 JORNL 02650CLR RLABL BLNGTH 20 JORNL 02660CLR RLABL RCODE 1 JORNL 0002670CLR RLABL MASK 10 JORNL 02680CLR RLABL DTYPE 10 JORNL 02690CLR RCODE COMP 'R' 20 JORNL 02700CLR 20 GOTO OUTFLD JORNL 02710CLR MOVBUF TAG JORNL 02720CLR MOVE SEF,N EDCODE 2 JORNL 02730CLR EDCODE COMP ' ' 2424 EDITING? JORNL 0002740CLRN24 GOTO SVFLD JORNL 02750CLR SETOF 30 JORNL 02760CLR EXSR EDIT JORNL 02770CLRN30 GOTO SVFLD JORNL 02780CLR SETOF 30 JORNL 02790CLR N SUB 1 N JORNL 02800CLR GOTO LOOP JORNL 0002810CLR SVFLD TAG JORNL 02820CLR Z-ADD4 WHICH1 10 JORNL 02830CLR Z-ADDSST,N STRT 30 JORNL 02840CLR Z-ADDSLN,N LEN JORNL 02850CLR EXIT SUBRIN JORNL 02860CLR RLABL WHICH1 10 JORNL 02870CLR RLABL BUFFER 72 JORNL 0002880CLR RLABL RECORD JORNL 02890CLR RLABL BPOS 20 JORNL 02900CLR RLABL FPOS 20 JORNL 02910CLR RLABL STRT 30 JORNL 02920CLR RLABL LEN 20 JORNL 02930CLR GOTO LOOP JORNL 02940CLR RITDUP TAG JORNL 0002950CLR EXSR MVRECD JORNL 02960CLR SETON 19 JORNL 02970CLR Z-ADDSLN,N BLNGTH JORNL 02980CLR EXSR EXCPT JORNL 02990CLR GOTO MOVBUF JORNL 03000CLR OUTREC TAG JORNL 03010CLR SETON 187084 JORNL 0003020CLR EXCPT JORNL 03030CLR EXSR EXCPT JORNL 03040CLR SETOF 708426 JORNL 03050CLR MOVELRECORD OLDREC128 JORNL 03060CLR SNP,PN COMP 0 22 AUTO PROGRAM JORNL 03070CLR N22 GOTO NXTREC CHANGE? JORNL 03080CLR SNP,PN COMP 9 2222 CODE .,NEWPROG JORNL 0003090CLR N22 EXSR GETPRG JORNL 03100CLR N22 GOTO NXTREC JORNL 03110CLR SNP,PN COMP 8 2222CODE=1-8, JORNL 03120CLR N22 GOTO NXTREC AUTO CHANGE JORNL 03130CLR Z-ADDSNP,PN PN JORNL 03140CLR EXSR GETPRG JORNL 03150CLR SETOF 22 JORNL 0003160CLR GOTO NXTREC JORNL 03170CLR EOJ TAG JORNL 03180C********************************************************************JORNL 03190C********************************************************************JORNL 03200C* *JORNL 03210C* SUBROUTINE 'EDIT' PERFORMS CUSTOM EDITING. UPON ENTRY, THE *JORNL 03220C* EDIT FLAG IS IN 'EDCODE', THE PROGRAM NAME IS IN THE LEFT-MOST JORNL 0003230C* SIX CHARACTERS OF 'WORD', THE RESPONSE IS IN 'BUFFER'. JORNL 03240C* JORNL 03250C* INDICATOR 30 SHOULD BE SET ON BEFORE RETURNING IF YOU WANT THIS JORNL 03260C* FIELD TO BE RE-ENTERED. INDICATORS 31-59 MAY BE USED BY THIS SUBR.JORNL 03270C* JORNL 03280CSR EDIT BEGSR JORNL 03290CSR EDCODE COMP 'CV' 31 JORNL 0003300CSR 31 GOTO ECV JORNL 03310CSR EDCODE COMP 'MC' 31 JORNL 03320CSR 31 GOTO EMC JORNL 03330CSR EDCODE COMP 'MH' 31 MH= MUST HAVE JORNL 03340CSR 31 GOTO EMH JORNL 03350CSR EDCODE COMP 'DT' 31 JORNL 03360CSR 31 GOTO EDT JORNL 0003370CSR EDCODE COMP 'TR' 31 JORNL 03380CSR 31 GOTO ETR JORNL 03390CSR EDCODE COMP 'VN' 31 JORNL 03400CSR 31 GOTO EVN JORNL 03410CSR EDCODE COMP 'IN' 31 JORNL 03420CSR 31 GOTO EIN JORNL 03430CSR EDCODE COMP 'GL' 31 JORNL 0003440CSR 31 GOTO EGL JORNL 03450CSR EDCODE COMP 'CK' 31 JORNL 03460CSR 31 GOTO ECK JORNL 03470CSR EDCODE COMP 'VI' 31 JORNL 03480CSR 31 GOTO EVI JORNL 03490CSR GOTO ENDEDT JORNL 03500C** JORNL 0003510CSR ECV TAG JORNL 03520CSR MOVELBUFFER A1 1 OR 'N'. JORNL 03530CSR A1 COMP 'C' 32 JORNL 03540CSRN32 A1 COMP 'V' 32 JORNL 03550CSR 32 GOTO ENDEDT JORNL 03560CSR Z-ADD7 NE 20 JORNL 03570CSR GOTO ERREDT JORNL 0003580C** JORNL 03590CSR EMC TAG JORNL 03600CSR MOVELBUFFER A1 JORNL 03610CSR A1 COMP 'M' 32 JORNL 03620CSRN32 A1 COMP 'C' 32 JORNL 03630CSR 32 GOTO ENDEDT JORNL 03640CSR Z-ADD8 NE JORNL 0003650CSR GOTO ERREDT JORNL 03660C** JORNL 03670C** JORNL 03680CSR EMH TAG JORNL 03690CSR BUFFER COMP B72 32 JORNL 03700CSRN32 GOTO ENDEDT JORNL 03710CSR Z-ADD8 NE JORNL 0003720CSR GOTO ERREDT JORNL 03730C** JORNL 03740CSR ERREDT TAG DISPLAY ERROR JORNL 03750CSR EXSR SKIP JORNL 03760CSR MOVELEMS,NE BUFFER MESSAGE & JORNL 03770CSR Z-ADD30 BLNGTH RETRY. JORNL 03780CSR MOVE 'T' TYPE JORNL 0003790CSR EXITFSUBRCM JORNL 03800CSR RLABL BUFFER JORNL 03810CSR RLABL TYPE JORNL 03820CSR RLABL BLNGTH JORNL 03830CSR RLABL RCODE JORNL 03840CSR RLABL MASK JORNL 03850CSR RLABL DTYPE JORNL 0003860CSR SETON 30 JORNL 03870CSR GOTO ENDEDT JORNL 03880C** JORNL 03890CSR EDT TAG VALIDATE JORNL 03900CSR MOVELBUFFER A6 6 JORNL 03910CSR MOVELA6 MM 20 00' 99 JORNL 06070CSRN99 62 SEQNO ADD 1 SEQNO JORNL 06080CSRN99 62 GOTO SEQRD JORNL 06090CSR 67 SETON 88 JORNL 0006100CSR 88 EXSR EXCPT JORNL 06110CSR SETOF 88 JORNL 06120CSR 67 EXSR GETSEQ JORNL 06130CSR 67 GOTO SEQRD JORNL 06140CSR ENDSR JORNL 06150C********************************************************************JORNL 06160C* JORNL 0006170C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY JORNL 06180C* IS DONE IF A RUBOUT IS USED JORNL 06190C* JORNL 06200C********************************************************************JORNL 06210CSR TYPES BEGSR JORNL 06220CSR OVER TAG JORNL 06230CSR Z-ADDOLN BLNGTH JORNL 0006240CSR MOVELWORD BUFFER JORNL 06250CSR MOVE 'S' TYPE JORNL 06260CSR EXITFSUBRCM JORNL 06270CSR RLABL BUFFER 72 JORNL 06280CSR RLABL TYPE 1 JORNL 06290CSR RLABL BLNGTH 20 JORNL 06300CSR RLABL RCODE 1 JORNL 0006310CSR RLABL MASK 10 JORNL 06320CSR RLABL DTYPE 10 JORNL 06330CSR MOVE 'A' TYPE JORNL 06340CSR Z-ADDILN BLNGTH JORNL 06350CSR EXITFSUBRCM JORNL 06360CSR RLABL BUFFER 72 JORNL 06370CSR RLABL TYPE 1 JORNL 0006380CSR RLABL BLNGTH 20 JORNL 06390CSR RLABL RCODE 1 JORNL 06400CSR RLABL MASK 10 JORNL 06410CSR RLABL DTYPE 10 JORNL 06420CSR RCODE COMP 'R' 25 JORNL 06430CSR 25 EXSR SKIP JORNL 06440CSR 25 GOTO OVER JORNL 0006450CSR RCODE COMP 'O' 25 JORNL 06460CSR 25 EXSR SKIP JORNL 06470CSR ENDSR JORNL 06480C********************************************************************JORNL 06490C* JORNL 06500C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT JORNL 06510C* JORNL 0006520C********************************************************************JORNL 06530CSR SKIP BEGSR JORNL 06540CSR MOVELBUFFER NBUF 1 JORNL 06550CSR MOVEL' ' BUFFER JORNL 06560CSR Z-ADD1 BLNGTH JORNL 06570CSR MOVE 'T' TYPE JORNL 06580CSR EXITFSUBRCM JORNL 0006590CSR RLABL BUFFER 72 JORNL 06600CSR RLABL TYPE 1 JORNL 06610CSR RLABL BLNGTH 20 JORNL 06620CSR RLABL RCODE 1 JORNL 06630CSR RLABL MASK 10 JORNL 06640CSR RLABL DTYPE 10 JORNL 06650CSR MOVELNBUF BUFFER JORNL 0006660CSR ENDSR JORNL 06670C********************************************************************JORNL 06680C* JORNL 06690C* JORNL 06700C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED JORNL 06710C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER JORNL 06720C* JORNL 0006730CSR MVRECD BEGSR JORNL 06740CSR MOVELB72 BUFFER JORNL 06750CSR Z-ADD2 WHICH1 JORNL 06760CSR Z-ADDSST,N STRT JORNL 06770CSR Z-ADD1 FPOS JORNL 06780CSR Z-ADDSLN,N LEN 20 JORNL 06790CSR EXIT SUBRIN JORNL 0006800CSR RLABL WHICH1 10 JORNL 06810CSR RLABL BUFFER 72 JORNL 06820CSR RLABL RECORD JORNL 06830CSR RLABL BPOS 20 JORNL 06840CSR RLABL FPOS 20 JORNL 06850CSR RLABL STRT 30 JORNL 06860CSR RLABL LEN 20 JORNL 0006870CSR ENDSR JORNL 06880C********************************************************************JORNL 06890CSR EXCPT BEGSR JORNL 06900CSRN81N82N83 JORNL 06910CANN84N88 GOTO PUTOUT JORNL 06920CSR MOVELB72 BUFFER JORNL 06930CSR 81 MOVELMSG,1 BUFFER JORNL 0006940CSR 83 MOVELMSG,2 BUFFER JORNL 06950CSR 88 MOVELMSG,3 BUFFER JORNL 06960CSR 82 MOVELMSG,4 BUFFER JORNL 06970CSRN84 GOTO PUTOUT JORNL 06980CSR MOVELSFN,N BUFFER JORNL 06990CSRN18 SETON 19 JORNL 07000CSRN18 Z-ADD20 BLNGTH JORNL 0007010CSRN18 GOTO PUTOUT JORNL 07020CSR MOVE HEAD BUFFER JORNL 07030CSR MOVELSEQNO WORD8 8 JORNL 07040CSR MOVE WORD8 BUFFER JORNL 07050CSR PUTOUT TAG JORNL 07060CSR MOVE 'S' TYPE JORNL 07070CSRN19 Z-ADD69 BLNGTH JORNL 0007080CSR SETOF 19 JORNL 07090CSR EXITFSUBRCM JORNL 07100CSR RLABL BUFFER 72 JORNL 07110CSR RLABL TYPE 1 JORNL 07120CSR RLABL BLNGTH 20 JORNL 07130CSR RLABL RCODE 1 JORNL 07140CSR RLABL MASK 10 JORNL 0007150CSR RLABL DTYPE 10 JORNL 07160CSR ENDSR JORNL 07170CSR CLRSCR BEGSR JORNL 07180CSR MOVE 'C' TYPE JORNL 07190CSR EXSR CRTCOM JORNL 07200CSR ENDSR JORNL 07210CSR ALMTS BEGSR JORNL 0007220CSR EXSR CLRSCR JORNL 07230CSR MOVELARY1,1 BUFFER JORNL 07240CSR MOVE 'S' TYPE JORNL 07250CSR Z-ADD50 BLNGTH JORNL 07260CSR EXSR CRTCOM JORNL 07270CSR MOVE 'A' TYPE JORNL 07280CSR Z-ADD5 BLNGTH JORNL 0007290CSR Z-ADD1 DTYPE JORNL 07300CSR EXSR CRTCOM JORNL 07310CSR EXSR SKIP JORNL 07320CSR RCODE COMP 'R' 86 JORNL 07330CSR Z-ADD5 VL JORNL 07340CSR MOVELBUFFER VAR JORNL 07350CSR EXIT SUBRAJ JORNL 0007360CSR RLABL VL JORNL 07370CSR RLABL VAR JORNL 07380CSR MOVELVAR BUFFER JORNL 07390CSR MOVELBUFFER LOW 50 JORNL 07400CSR MOVELARY1,2 BUFFER JORNL 07410CSR MOVE 'S' TYPE JORNL 07420CSR Z-ADD50 BLNGTH JORNL 0007430CSR EXSR CRTCOM JORNL 07440CSR MOVE 'A' TYPE JORNL 07450CSR Z-ADD5 BLNGTH JORNL 07460CSR Z-ADD1 DTYPE JORNL 07470CSR EXSR CRTCOM JORNL 07480CSR RCODE COMP 'R' 87 JORNL 07490CSR Z-ADD5 VL JORNL 0007500CSR MOVELBUFFER VAR JORNL 07510CSR EXIT SUBRAJ JORNL 07520CSR RLABL VL JORNL 07530CSR RLABL VAR JORNL 07540CSR MOVELVAR BUFFER JORNL 07550CSR MOVELBUFFER HIGH 50 JORNL 07560CSR MOVE 'C' TYPE JORNL 0007570CSR EXSR CRTCOM JORNL 07580CSR 86 JORNL 07590COR 87 GOTO ALMTS JORNL 07600CSR Z-ADD0 DTYPE JORNL 07610CSR ENDSR JORNL 07620CSR CRTCOM BEGSR JORNL 07630CSR EXITFSUBRCM JORNL 0007640CSR RLABL BUFFER JORNL 07650CSR RLABL TYPE JORNL 07660CSR RLABL BLNGTH JORNL 07670CSR RLABL RCODE JORNL 07680CSR RLABL MASK JORNL 07690CSR RLABL DTYPE JORNL 07700CSR ENDSR JORNL 0007710CSR PUTSEQ BEGSR JORNL 07720CSR MOVELMSG,5 BUFFER JORNL 07730CSR MOVE 'S' TYPE JORNL 07740CSR Z-ADD25 BLNGTH JORNL 07750CSR EXSR CRTCOM JORNL 07760CSR MOVELSEQNO BUFFER JORNL 07770CSR MOVE 'T' TYPE JORNL 0007780CSR Z-ADD5 BLNGTH JORNL 07790CSR EXSR CRTCOM JORNL 07800CSR ENDSR JORNL 07810CSR TSTSEQ BEGSR JORNL 07820CSR SETOF 949697 JORNL 07830CSR SEQNO COMP LOW 989698 JORNL 07840CSR 98 SEQNO COMP HIGH 979898 JORNL 0007850CSR 98 GOTO ENDTST JORNL 07860CSR 62 96 MOVELMSG,6 BUFFER JORNL 07870CSR 62 97 MOVELMSG,7 BUFFER JORNL 07880CSRN62 MOVELMSG,8 BUFFER JORNL 07890CSRN62 SETON 94 JORNL 07900CSR MOVE 'T' TYPE JORNL 07910CSR Z-ADD25 BLNGTH JORNL 0007920CSR EXSR CRTCOM JORNL 07930CSR 62 97 MOVE 'F' TYPE JORNL 07940CSR 62 97 EXSR CRTCOM JORNL 07950CSR ENDTST ENDSR JORNL 07960C* JORNL 07970C********************************************************************JORNL 07980OJEINPT E 70N67 JORNL 0007990O RECORD 128 JORNL 08000O 64 128 'X' JORNL 08010O SEQNO 127 JORNL ** 008020ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 008030ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 008040ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00805000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 008060** 008070ENTER BEGINNING RELATIVE RECORD NUMBER 008080ENTER ENDING RELATIVE RECORD NUMBER 008090** 008100MODE MUST BE A,C,V,OR E 008110FIRST FIELD NAME BLANK 00812000INVALID SEQ # 008130PROG# MUST BE FROM 1-8 008140CURRENT SEQUENCE NBR 008150SEQNO TOO LOW 008160RUN EDIT PROG-FILE FULL 008170SEQNO NOT IN YOUR LIMITS 008180** 00819000 * MUST BE 'IN' OR 'MC' * 008200 * INVALID DATE * 008210 * INVALID VENDOR # * 008220 * VENDOR/INVOICE NOT ON FILE * 008230 * ACCT # IS INVALID * 008240 * CHECK # IS NOT OUTSTANDING * 008250 * VENDOR/INV# NOT NEW ** 00826000 * MUST NOT BE BLANK * 008270/* 008280__NVALID VENDOR # * 008220 * VENDOR/INVOICE NOT ON FILE * 008230 * ACCT # IS INVALID * 008240 * CHECK # IS NOT OUTSTANDING * 008250 * VENDOR/INV# NOT NEW ** 0082600(kI =mTXKYSEQ P999999032778(000010H S KYSEQ 00020X DECK-ID A96 MFG/DIST/ACCT SYSTEM SUMMARY-123 KYSEQ 00030F* DATA AND DATA CORRECTION ENTRY PROGRAM FOR INPUT FILE GLSEQ KYSEQ 00040F* CYBER 18-10M/20 GENERAL LEDGER VERSION 1.0KYSEQ 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA KYSEQ 00060F* CONTROL DATA PROPRIETARY PRODUCT KYSEQ 00070F* KYSEQ 0000080F* KYSEQ 00090F* 'KYPEDT' FOR COMPUSOURCE A/P PACKAGE. KYSEQ 00100F* KYSEQ 00110F* KYSEQ 00120F****************************************************************** KYSEQ 00130F* KYSEQ 00140F* THIS IS A MODIFICATION OF 'KEYPCH' WHICH ALLOWS: KYSEQ 0000150F* 1) AUTOMATIC PROGRAM LEVEL SWITCHING, KYSEQ 00160F* 2) GANG-PUNCH FIELDS (CONSTANT INSERTION), KYSEQ 00170F* 3) EDIT FLAGGING OF FIELDS FOR PROCESSING BY SUBROUTINE KYSEQ 00180F* 'EDIT' INTERNAL TO THIS PROGRAM. KYSEQ 00190F* 4) EIGHT PROGRAM LEVELS KYSEQ 00200F* 5) AUTOMATIC LOADING OF THE 8 LEVELS BASED ON THE 1ST RECORD KYSEQ 00210F* IN THE FILE GLSEQ KYSEQ 0000220F* 6) IF MODE IS 'A', THE STARTING SEQ# WILL AUTOMATICALLY BE THE KYSEQ 00230F* FIRST RECORD WITH '<>' IN BYTES 1-2. KYSEQ 00240F* KYSEQ 00250F* KYSEQ 00260F* KYSEQ 00270F********************************************************************KYSEQ 00280FGLDUM IPEAF 72 DISK KYSEQ 0000290FKPROGX IC F 40R 8AI 1 DISK KYSEQ 00300FGLSEQ UC F 128R DISK KYSEQ 00310F****************************************************************** KYSEQ 00320F* THE FILES BELOW ARE USED STRICTLY FOR EDITING. KYSEQ 00330FCHRTAC IC F 48R10AI 1 DISK KYSEQ 00340FOUTCHK IC F 48R 5AI 1 DISK KYSEQ 00350FVENDOR IC F 256R 5AI 1 DISK KYSEQ 0000360FVENINV IC F 32R13AI 1 DISK KYSEQ 00370F********************************************************************KYSEQ 00380E ARY1 1 2 50 KYSEQ 00390E MSG 1 8 25 KYSEQ 00400E SFN 160 20 FIELD NAMES. KYSEQ 00410E SAN 160 1 ALPH OR NUM KYSEQ 00420E SAD 160 1 AUTO DUP FLAGS KYSEQ 0000430E SST 160 3 0 FIELD START KYSEQ 00440E SLN 160 2 0 FIELD LENGTHS KYSEQ 00450E SEF 160 2 EDIT FLAGS KYSEQ 00460E SGP 160 1 GANG PUNCH FLGS KYSEQ 00470E SNP 8 1 0 NEXT PROG# KYSEQ 00480E SNM 8 6 PROG NAMES KYSEQ 00490E SMX 8 3 0 MAX INDX'S KYSEQ 0000500E EMS 1 8 30 EDIT MESSAGES KYSEQ 00510IGLDUM NS 01 KYSEQ 00520I 1 48 SNM KYSEQ 00530IKPROGX NS 02 36NCD KYSEQ 00540I 9 28 FN KYSEQ 00550I 29 29 AN KYSEQ 00560I 30 30 AD KYSEQ 0000570I 31 33 ST KYSEQ 00580I 34 35 LN KYSEQ 00590I 36 36 DCODE KYSEQ 00600I 37 37 NPL KYSEQ 00610I 38 38 GP KYSEQ 00620I 39 40 EF KYSEQ 00630I NS 03 KYSEQ 0000640I 1 1 A KYSEQ 00650IGLSEQ NS 05 KYSEQ 00660I 1 2 RC KYSEQ 00670I 1 128 RECORD KYSEQ 00680I****************************************************************** KYSEQ 00690I* INPUT SPECS FOR EDITING FILES ARE LISTED BELOW. KYSEQ 00700ICHRTAC NS 09 KYSEQ 0000710I 1 1 @XX KYSEQ 00720IOUTCHK NS 09 KYSEQ 00730I 1 1 @XX KYSEQ 00740IVENDOR NS 09 KYSEQ 00750I 1 1 @XX KYSEQ 00760IVENINV NS 09 KYSEQ 00770I 1 1 @XX KYSEQ 0000780C* KYSEQ 00790C* KYSEQ 00800C* KYSEQ 00810C EXSR ALMTS KYSEQ 00820C Z-ADDLOW SEQNO KYSEQ 00830C MOVE ' ' B72 72 KYSEQ 00840C Z-ADD1 PN LOAD INITIAL KYSEQ 0000850C LDLOOP TAG PROGS FROM 1STKYSEQ 00860C SNM,PN COMP ' ' 2626 48 BYTES OF KYSEQ 00870C MOVELSNM,PN PNAME KYSEQ 00880C MOVE ' ' PNAME KYSEQ 00890C 26 EXSR GETPRG 'DUMMY' REC. KYSEQ 00900C PN ADD 1 PN KYSEQ 00910C PN COMP 8 2626 KYSEQ 0000920C 26 GOTO LDLOOP KYSEQ 00930C NLR SETON LR KYSEQ 00940CLR MOVE '1' RTNLVL 10 KYSEQ 00950CLR MOVE '1' TERMNL 10 KYSEQ 00960CLR START TAG KYSEQ 00970CLR EXSR SKIP KYSEQ 00980CLR MOVE 'C' TYPE KYSEQ 0000990CLR EXITFSUBRCM KYSEQ 01000CLR RLABL BUFFER 72 KYSEQ 01010CLR RLABL TYPE KYSEQ 01020CLR RLABL BLNGTH KYSEQ 01030CLR RLABL RCODE KYSEQ 01040CLR RLABL MASK KYSEQ 01050CLR RLABL DTYPE KYSEQ 0001060CLR MOVEL'>MODE-' WORD 16 KYSEQ 01070CLR Z-ADD6 OLN 20 KYSEQ 01080CLR Z-ADD1 ILN 20 KYSEQ 01090CLR EXSR TYPES KYSEQ 01100CLR MOVELNBUF MODE 1 KYSEQ 01110CLR CHKMOD TAG KYSEQ 01120CLR SETOF 9095 KYSEQ 0001130CLR MODE COMP 'A' 62 KYSEQ 01140CLR MODE COMP 'C' 63 KYSEQ 01150CLR MODE COMP 'V' 64 KYSEQ 01160CLR MODE COMP 'K' 65 KYSEQ 01170CLR MODE COMP 'E' 66 KYSEQ 01180CLR 66 GOTO EOJ KYSEQ 01190CLR 65 EXSR GETPRG KYSEQ 0001200CLR 65 GOTO START KYSEQ 01210CLRN62N63N64 SETON 81 KYSEQ 01220CLR 81 EXSR EXCPT KYSEQ 01230CLR SETOF 81 KYSEQ 01240CLRN62N63N64 GOTO START KYSEQ 01250CLR EXSR GETPRG KYSEQ 01260CLRN63N95N62 EXSR GETSEQ KYSEQ 0001270CLR 86 GOTO EOJ KYSEQ 01280CLR SAMREC TAG KYSEQ 01290CLR SEQNO SUB 1 SEQNO 50 KYSEQ 01300CLR NXTREC TAG KYSEQ 01310CLR EXSR SKIP KYSEQ 01320CLR MOVE 'C' TYPE KYSEQ 01330CLR EXITFSUBRCM KYSEQ 0001340CLR RLABL BUFFER KYSEQ 01350CLR RLABL TYPE KYSEQ 01360CLR RLABL BLNGTH KYSEQ 01370CLR RLABL RCODE KYSEQ 01380CLR RLABL MASK KYSEQ 01390CLR RLABL DTYPE KYSEQ 01400CLR SETOF 2630 26=1ST FLD FLG KYSEQ 0001410CLR SETON 18 KYSEQ 01420CLR 63 EXSR GETSEQ KYSEQ 01430CLRN63 SEQNO ADD 1 SEQNO KYSEQ 01440CLR EXSR GETREC KYSEQ 01450CLR 62 EXSR PUTSEQ KYSEQ 01460CLRN98N62 EXSR GETSEQ KYSEQ 01470CLRN98 62 GOTO EOJ KYSEQ 0001480CLR 62 MOVE OLDREC RECORD KYSEQ 01490CLR Z-ADDBP N 30 KYSEQ 01500CLR LOOP TAG KYSEQ 01510CLR 27 28 90N SUB 2 N KYSEQ 01520CLR N COMP BP 2920 KYSEQ 01530CLR 20 GOTO NXTMOD KYSEQ 01540CLR N ADD 1 N KYSEQ 0001550CLR N COMP MAXFLD 20 KYSEQ 01560CLR 20N29 SETON 83 NO FIELDS KYSEQ 01570CLR 83 EXSR EXCPT KYSEQ 01580CLR SETOF 83 KYSEQ 01590CLR 20N29 GOTO START KYSEQ 01600CLR 20 GOTO OUTREC KYSEQ 01610C** 30 HERE MEANS '@' ON PRIOR FIELD FOR THIS RECORD. KYSEQ 0001620CLR 30 GOTO SVFLD KYSEQ 01630C** KYSEQ 01640CLR SGP,N COMP ' ' 2323 GANG PUNCH? KYSEQ 01650CLR N23 GOTO CHKAD KYSEQ 01660CLR MOVELB72 BUFFER KYSEQ 01670CLR MOVELSFN,N BUFFER YES... KYSEQ 01680CLR Z-ADDSLN,N BLNGTH PUT 1ST LN KYSEQ 0001690CLR EXSR EXCPT CHARS OF FIELDKYSEQ 01700CLR EXSR SKIP IN BUFFER. KYSEQ 01710CLR MOVE 'O' RCODE KYSEQ 01720CLR GOTO CHKVER KYSEQ 01730CLR CHKAD TAG KYSEQ 01740CLR SAD,N COMP 'D' 27 KYSEQ 01750CLR 27 62 90 KYSEQ 0001760COR 27 64 90 GOTO LOOP KYSEQ 01770CLR 62 GOTO SKIPMV KYSEQ 01780CLR EXSR MVRECD KYSEQ 01790CLR MOVE BUFFER TBUF 72 KYSEQ 01800CLR SKIPMV TAG KYSEQ 01810CLR OUTFLD TAG KYSEQ 01820CLR SETON 84 OUTPUT FIELD KYSEQ 0001830CLR EXSR EXCPT NAME KYSEQ 01840CLR SETOF 8418 KYSEQ 01850CLR 62 SETOF 8418 KYSEQ 01860CLR 62 GOTO RDCRT KYSEQ 01870CLR MOVE SLN,N BLNGTH KYSEQ 01880CLR SETON 19 KYSEQ 01890CLR MOVE TBUF BUFFER KYSEQ 0001900CLR EXSR EXCPT KYSEQ 01910CLR RDCRT TAG KYSEQ 01920CLRN62 EXSR SKIP KYSEQ 01930CLR SETOF 2728 KYSEQ 01940CLR MOVE B72 BUFFER KYSEQ 01950CLR MOVE 'A' TYPE 1 KYSEQ 01960CLR Z-ADDSLN,N BLNGTH 20 KYSEQ 0001970CLR EXITFSUBRCM KYSEQ 01980CLR RLABL BUFFER 72 KYSEQ 01990CLR RLABL TYPE 1 KYSEQ 02000CLR RLABL BLNGTH 20 KYSEQ 02010CLR RLABL RCODE 1 KYSEQ 02020CLR RLABL MASK 10 KYSEQ 02030CLR RLABL DTYPE 10 KYSEQ 0002040CLR RCODE COMP 'O' 20 KYSEQ 02050CLR RCODE COMP 'L' 20 KYSEQ 02060CLR 20 GOTO RITDUP KYSEQ 02070CLR RCODE COMP 'R' 20 KYSEQ 02080CLR 20 BUFFER COMP B72 21 KYSEQ 02090CLR 20N21 EXSR SKIP KYSEQ 02100CLR 20N21 N SUB 1 N KYSEQ 0002110CLR 20 21 N SUB 2 N 28 28 KYSEQ 02120CLRN20 GOTO CHKNUM KYSEQ 02130CLR N29 GOTO NXTMOD KYSEQ 02140CLR 21N26 GOTO NXTMOD RUB ON 1ST KYSEQ 02150CLR SETOF 26 KYSEQ 02160CLR GOTO LOOP KYSEQ 02170CLR NXTMOD TAG KYSEQ 0002180CLR EXSR SKIP KYSEQ 02190CLR SETOF 28 KYSEQ 02200CLR MOVEL'MODE-' WORD KYSEQ 02210CLR Z-ADD5 OLN KYSEQ 02220CLR Z-ADD1 ILN KYSEQ 02230CLR EXSR TYPES KYSEQ 02240CLR MOVELBUFFER MODE KYSEQ 0002250CLR MODE COMP 'P' 60 NEW PROG#ONLY KYSEQ 02260CLR MODE COMP 'D' 61 AUTO-DUP ONLY KYSEQ 02270CLRN60N61 GOTO CHKMOD NEW MODE KYSEQ 02280CLR EXSR GETPRG KYSEQ 02290CLR SETOF 6061 KYSEQ 02300CLR GOTO SAMREC KYSEQ 02310CLR CHKNUM TAG KYSEQ 0002320CLR SETON 26 A FLD HAS KYSEQ 02330C** BEEN ENTERED KYSEQ 02340CLR MOVELBUFFER MODE KYSEQ 02350CLR MODE COMP '@' 20 KYSEQ 02360CLRN20 GOTO NOAT KYSEQ 02370CLR 64 GOTO NOAT KYSEQ 02380CLR SETON 30 30= '@' FLAG KYSEQ 0002390CLR MOVELB72 BUFFER KYSEQ 02400CLR GOTO SVFLD KYSEQ 02410CLR NOAT TAG KYSEQ 02420CLR SAN,N COMP 'N' 19 KYSEQ 02430CLRN19 GOTO CHKVER KYSEQ 02440CLR Z-ADDSLN,N VL 20 KYSEQ 02450CLR MOVELBUFFER VAR 15 KYSEQ 0002460CLR EXIT SUBRAJ KYSEQ 02470CLR RLABL VL KYSEQ 02480CLR RLABL VAR KYSEQ 02490CLR MOVELVAR BUFFER KYSEQ 02500CLR Z-ADDVL BLNGTH KYSEQ 02510CLR EXSR EXCPT KYSEQ 02520CLR CHKVER TAG KYSEQ 0002530CLR EXSR SKIP KYSEQ 02540CLR N64 GOTO MOVBUF KYSEQ 02550CLR TBUF COMP BUFFER 2020 KYSEQ 02560CLRN20 GOTO MOVBUF KYSEQ 02570CLR MOVEL'KP VERIF'WORD KYSEQ 02580CLR MOVE 'Y ERROR 'WORD KYSEQ 02590CLR MOVELWORD BUFFER KYSEQ 0002600CLR MOVE 'R' TYPE KYSEQ 02610CLR Z-ADD6 MASK ONLY 'R' OR 'E'KYSEQ 02620CLR EXITFSUBRCM KYSEQ 02630CLR RLABL BUFFER 72 KYSEQ 02640CLR RLABL TYPE 1 KYSEQ 02650CLR RLABL BLNGTH 20 KYSEQ 02660CLR RLABL RCODE 1 KYSEQ 0002670CLR RLABL MASK 10 KYSEQ 02680CLR RLABL DTYPE 10 KYSEQ 02690CLR RCODE COMP 'R' 20 KYSEQ 02700CLR 20 GOTO OUTFLD KYSEQ 02710CLR MOVBUF TAG KYSEQ 02720CLR MOVE SEF,N EDCODE 2 KYSEQ 02730CLR EDCODE COMP ' ' 2424 EDITING? KYSEQ 0002740CLRN24 GOTO SVFLD KYSEQ 02750CLR SETOF 30 KYSEQ 02760CLR EXSR EDIT KYSEQ 02770CLRN30 GOTO SVFLD KYSEQ 02780CLR SETOF 30 KYSEQ 02790CLR N SUB 1 N KYSEQ 02800CLR GOTO LOOP KYSEQ 0002810CLR SVFLD TAG KYSEQ 02820CLR Z-ADD4 WHICH1 KYSEQ 02830CLR Z-ADDSST,N STRT 30 KYSEQ 02840CLR Z-ADDSLN,N LEN KYSEQ 02850CLR EXIT SUBRIN KYSEQ 02860CLR RLABL WHICH1 10 KYSEQ 02870CLR RLABL BUFFER 72 KYSEQ 0002880CLR RLABL RECORD KYSEQ 02890CLR RLABL BPOS 20 KYSEQ 02900CLR RLABL FPOS 20 KYSEQ 02910CLR RLABL STRT 30 KYSEQ 02920CLR RLABL LEN 20 KYSEQ 02930CLR GOTO LOOP KYSEQ 02940CLR RITDUP TAG KYSEQ 0002950CLR EXSR MVRECD KYSEQ 02960CLR SETON 19 KYSEQ 02970CLR Z-ADDSLN,N BLNGTH KYSEQ 02980CLR EXSR EXCPT KYSEQ 02990CLR EXSR SKIP KYSEQ 03000CLR GOTO MOVBUF KYSEQ 03010CLR OUTREC TAG KYSEQ 0003020CLR SETON 187084 KYSEQ 03030CLR EXCPT KYSEQ 03040CLR EXSR EXCPT KYSEQ 03050CLR SETOF 708426 KYSEQ 03060CLR MOVELRECORD OLDREC128 KYSEQ 03070CLR SNP,PN COMP 0 22 AUTO PROGRAM KYSEQ 03080CLR N22 GOTO NXTREC CHANGE? KYSEQ 0003090CLR SNP,PN COMP 9 2222 CODE .,NEWPROG KYSEQ 03100CLR N22 EXSR GETPRG KYSEQ 03110CLR N22 GOTO NXTREC KYSEQ 03120CLR SNP,PN COMP 8 2222CODE=1-8, KYSEQ 03130CLR N22 GOTO NXTREC AUTO CHANGE KYSEQ 03140CLR Z-ADDSNP,PN PN KYSEQ 03150CLR EXSR GETPRG KYSEQ 0003160CLR SETOF 22 KYSEQ 03170CLR GOTO NXTREC KYSEQ 03180CLR EOJ TAG KYSEQ 03190C********************************************************************KYSEQ 03200C********************************************************************KYSEQ 03210C* *KYSEQ 03220C* SUBROUTINE 'EDIT' PERFORMS CUSTOM EDITING. UPON ENTRY, THE *KYSEQ 0003230C* EDIT FLAG IS IN 'EDCODE', THE PROGRAM NAME IS IN THE LEFT-MOST KYSEQ 03240C* SIX CHARACTERS OF 'WORD', THE RESPONSE IS IN 'BUFFER'. KYSEQ 03250C* KYSEQ 03260C* INDICATOR 30 SHOULD BE SET ON BEFORE RETURNING IF YOU WANT THIS KYSEQ 03270C* FIELD TO BE RE-ENTERED. INDICATORS 31-59 MAY BE USED BY THIS SUBR.KYSEQ 03280C* KYSEQ 03290CSR EDIT BEGSR KYSEQ 0003300CSR EDCODE COMP 'CV' 31 KYSEQ 03310CSR 31 GOTO ECV KYSEQ 03320CSR EDCODE COMP 'MC' 31 KYSEQ 03330CSR 31 GOTO EMC KYSEQ 03340CSR EDCODE COMP 'MH' 31 MH= MUST HAVE KYSEQ 03350CSR 31 GOTO EMH KYSEQ 03360CSR EDCODE COMP 'DT' 31 KYSEQ 0003370CSR 31 GOTO EDT KYSEQ 03380CSR EDCODE COMP 'TR' 31 KYSEQ 03390CSR 31 GOTO ETR KYSEQ 03400CSR EDCODE COMP 'VN' 31 KYSEQ 03410CSR 31 GOTO EVN KYSEQ 03420CSR EDCODE COMP 'IN' 31 KYSEQ 03430CSR 31 GOTO EIN KYSEQ 0003440CSR EDCODE COMP 'GL' 31 KYSEQ 03450CSR 31 GOTO EGL KYSEQ 03460CSR EDCODE COMP 'CK' 31 KYSEQ 03470CSR 31 GOTO ECK KYSEQ 03480CSR EDCODE COMP 'VI' 31 KYSEQ 03490CSR 31 GOTO EVI KYSEQ 03500CSR GOTO ENDEDT KYSEQ 0003510C** KYSEQ 03520CSR ECV TAG KYSEQ 03530CSR MOVELBUFFER A1 1 OR 'N'. KYSEQ 03540CSR A1 COMP 'C' 32 KYSEQ 03550CSRN32 A1 COMP 'V' 32 KYSEQ 03560CSR 32 GOTO ENDEDT KYSEQ 03570CSR Z-ADD7 NE 20 KYSEQ 0003580CSR GOTO ERREDT KYSEQ 03590C** KYSEQ 03600CSR EMC TAG KYSEQ 03610CSR MOVELBUFFER A1 KYSEQ 03620CSR A1 COMP 'M' 32 KYSEQ 03630CSRN32 A1 COMP 'C' 32 KYSEQ 03640CSR 32 GOTO ENDEDT KYSEQ 0003650CSR Z-ADD8 NE KYSEQ 03660CSR GOTO ERREDT KYSEQ 03670C** KYSEQ 03680C** KYSEQ 03690CSR EMH TAG KYSEQ 03700CSR BUFFER COMP B72 32 KYSEQ 03710CSRN32 GOTO ENDEDT KYSEQ 0003720CSR Z-ADD8 NE KYSEQ 03730CSR GOTO ERREDT KYSEQ 03740C** KYSEQ 03750CSR ERREDT TAG DISPLAY ERROR KYSEQ 03760CSR EXSR SKIP KYSEQ 03770CSR MOVELEMS,NE BUFFER MESSAGE & KYSEQ 03780CSR Z-ADD30 BLNGTH RETRY. KYSEQ 0003790CSR MOVE 'T' TYPE KYSEQ 03800CSR EXITFSUBRCM KYSEQ 03810CSR RLABL BUFFER KYSEQ 03820CSR RLABL TYPE KYSEQ 03830CSR RLABL BLNGTH KYSEQ 03840CSR RLABL RCODE KYSEQ 03850CSR RLABL MASK KYSEQ 0003860CSR RLABL DTYPE KYSEQ 03870CSR SETON 30 KYSEQ 03880CSR GOTO ENDEDT KYSEQ 03890C** KYSEQ 03900CSR EDT TAG VALIDATE KYSEQ 03910CSR MOVELBUFFER A6 6 KYSEQ 03920CSR MOVELA6 MM 20 00' 99 KYSEQ 06080CSRN99 62 SEQNO ADD 1 SEQNO KYSEQ 06090CSRN99 62 GOTO SEQRD KYSEQ 0006100CSR 67 SETON 88 KYSEQ 06110CSR 88 EXSR EXCPT KYSEQ 06120CSR SETOF 88 KYSEQ 06130CSR 67 EXSR GETSEQ KYSEQ 06140CSR 67 GOTO SEQRD KYSEQ 06150CSR ENDSR KYSEQ 06160C********************************************************************KYSEQ 0006170C* KYSEQ 06180C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY KYSEQ 06190C* IS DONE IF A RUBOUT IS USED KYSEQ 06200C* KYSEQ 06210C********************************************************************KYSEQ 06220CSR TYPES BEGSR KYSEQ 06230CSR OVER TAG KYSEQ 0006240CSR Z-ADDOLN BLNGTH KYSEQ 06250CSR MOVELWORD BUFFER KYSEQ 06260CSR MOVE 'S' TYPE KYSEQ 06270CSR EXITFSUBRCM KYSEQ 06280CSR RLABL BUFFER 72 KYSEQ 06290CSR RLABL TYPE 1 KYSEQ 06300CSR RLABL BLNGTH 20 KYSEQ 0006310CSR RLABL RCODE 1 KYSEQ 06320CSR RLABL MASK 10 KYSEQ 06330CSR RLABL DTYPE 10 KYSEQ 06340CSR MOVE 'A' TYPE KYSEQ 06350CSR Z-ADDILN BLNGTH KYSEQ 06360CSR EXITFSUBRCM KYSEQ 06370CSR RLABL BUFFER 72 KYSEQ 0006380CSR RLABL TYPE 1 KYSEQ 06390CSR RLABL BLNGTH 20 KYSEQ 06400CSR RLABL RCODE 1 KYSEQ 06410CSR RLABL MASK 10 KYSEQ 06420CSR RLABL DTYPE 10 KYSEQ 06430CSR RCODE COMP 'R' 25 KYSEQ 06440CSR 25 EXSR SKIP KYSEQ 0006450CSR 25 GOTO OVER KYSEQ 06460CSR RCODE COMP 'O' 25 KYSEQ 06470CSR 25 EXSR SKIP KYSEQ 06480CSR ENDSR KYSEQ 06490C********************************************************************KYSEQ 06500C* KYSEQ 06510C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT KYSEQ 0006520C* KYSEQ 06530C********************************************************************KYSEQ 06540CSR SKIP BEGSR KYSEQ 06550CSR MOVELBUFFER NBUF 1 KYSEQ 06560CSR MOVEL' ' BUFFER KYSEQ 06570CSR Z-ADD1 BLNGTH KYSEQ 06580CSR MOVE 'T' TYPE KYSEQ 0006590CSR EXITFSUBRCM KYSEQ 06600CSR RLABL BUFFER 72 KYSEQ 06610CSR RLABL TYPE 1 KYSEQ 06620CSR RLABL BLNGTH 20 KYSEQ 06630CSR RLABL RCODE 1 KYSEQ 06640CSR RLABL MASK 10 KYSEQ 06650CSR RLABL DTYPE 10 KYSEQ 0006660CSR MOVELNBUF BUFFER KYSEQ 06670CSR ENDSR KYSEQ 06680C********************************************************************KYSEQ 06690C* KYSEQ 06700C* KYSEQ 06710C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED KYSEQ 06720C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER KYSEQ 0006730C* KYSEQ 06740CSR MVRECD BEGSR KYSEQ 06750CSR MOVELB72 BUFFER KYSEQ 06760CSR Z-ADD2 WHICH1 KYSEQ 06770CSR Z-ADDSST,N STRT KYSEQ 06780CSR Z-ADD1 FPOS KYSEQ 06790CSR Z-ADDSLN,N LEN 20 KYSEQ 0006800CSR EXIT SUBRIN KYSEQ 06810CSR RLABL WHICH1 10 KYSEQ 06820CSR RLABL BUFFER 72 KYSEQ 06830CSR RLABL RECORD KYSEQ 06840CSR RLABL BPOS 20 KYSEQ 06850CSR RLABL FPOS 20 KYSEQ 06860CSR RLABL STRT 30 KYSEQ 0006870CSR RLABL LEN 20 KYSEQ 06880CSR ENDSR KYSEQ 06890C********************************************************************KYSEQ 06900CSR EXCPT BEGSR KYSEQ 06910CSRN81N82N83 KYSEQ 06920CANN84N88 GOTO PUTOUT KYSEQ 06930CSR MOVELB72 BUFFER KYSEQ 0006940CSR 81 MOVELMSG,1 BUFFER KYSEQ 06950CSR 83 MOVELMSG,2 BUFFER KYSEQ 06960CSR 88 MOVELMSG,3 BUFFER KYSEQ 06970CSR 82 MOVELMSG,4 BUFFER KYSEQ 06980CSRN84 GOTO PUTOUT KYSEQ 06990CSR MOVELSFN,N BUFFER KYSEQ 07000CSRN18 SETON 19 KYSEQ 0007010CSRN18 Z-ADD20 BLNGTH KYSEQ 07020CSRN18 GOTO PUTOUT KYSEQ 07030CSR MOVE HEAD BUFFER KYSEQ 07040CSR MOVELSEQNO WORD8 8 KYSEQ 07050CSR MOVE WORD8 BUFFER KYSEQ 07060CSR PUTOUT TAG KYSEQ 07070CSR MOVE 'S' TYPE KYSEQ 0007080CSRN19 Z-ADD59 BLNGTH KYSEQ 07090CSR SETOF 19 KYSEQ 07100CSR EXITFSUBRCM KYSEQ 07110CSR RLABL BUFFER 72 KYSEQ 07120CSR RLABL TYPE 1 KYSEQ 07130CSR RLABL BLNGTH 20 KYSEQ 07140CSR RLABL RCODE 1 KYSEQ 0007150CSR RLABL MASK 10 KYSEQ 07160CSR RLABL DTYPE 10 KYSEQ 07170CSR ENDSR KYSEQ 07180C* KYSEQ 07190CSR CLRSCR BEGSR KYSEQ 07200CSR MOVE 'C' TYPE KYSEQ 07210CSR EXSR CRTCOM KYSEQ 0007220CSR ENDSR KYSEQ 07230CSR ALMTS BEGSR KYSEQ 07240CSR EXSR CLRSCR KYSEQ 07250CSR MOVELARY1,1 BUFFER KYSEQ 07260CSR MOVE 'S' TYPE KYSEQ 07270CSR Z-ADD50 BLNGTH KYSEQ 07280CSR EXSR CRTCOM KYSEQ 0007290CSR MOVE 'A' TYPE KYSEQ 07300CSR Z-ADD5 BLNGTH KYSEQ 07310CSR Z-ADD1 DTYPE KYSEQ 07320CSR EXSR CRTCOM KYSEQ 07330CSR EXSR SKIP KYSEQ 07340CSR RCODE COMP 'R' 86 KYSEQ 07350CSR Z-ADD5 VL KYSEQ 0007360CSR MOVELBUFFER VAR KYSEQ 07370CSR EXIT SUBRAJ KYSEQ 07380CSR RLABL VL KYSEQ 07390CSR RLABL VAR KYSEQ 07400CSR MOVELVAR BUFFER KYSEQ 07410CSR MOVELBUFFER LOW 50 KYSEQ 07420CSR MOVELARY1,2 BUFFER KYSEQ 0007430CSR MOVE 'S' TYPE KYSEQ 07440CSR Z-ADD50 BLNGTH KYSEQ 07450CSR EXSR CRTCOM KYSEQ 07460CSR MOVE 'A' TYPE KYSEQ 07470CSR Z-ADD5 BLNGTH KYSEQ 07480CSR Z-ADD1 DTYPE KYSEQ 07490CSR EXSR CRTCOM KYSEQ 0007500CSR RCODE COMP 'R' 87 KYSEQ 07510CSR Z-ADD5 VL KYSEQ 07520CSR MOVELBUFFER VAR KYSEQ 07530CSR EXIT SUBRAJ KYSEQ 07540CSR RLABL VL KYSEQ 07550CSR RLABL VAR KYSEQ 07560CSR MOVELVAR BUFFER KYSEQ 0007570CSR MOVELBUFFER HIGH 50 KYSEQ 07580CSR MOVE 'C' TYPE KYSEQ 07590CSR EXSR CRTCOM KYSEQ 07600CSR 86 KYSEQ 07610COR 87 GOTO ALMTS KYSEQ 07620CSR Z-ADD0 DTYPE KYSEQ 07630CSR ENDSR KYSEQ 0007640CSR CRTCOM BEGSR KYSEQ 07650CSR EXITFSUBRCM KYSEQ 07660CSR RLABL BUFFER 72 KYSEQ 07670CSR RLABL TYPE KYSEQ 07680CSR RLABL BLNGTH KYSEQ 07690CSR RLABL RCODE KYSEQ 07700CSR RLABL MASK KYSEQ 0007710CSR RLABL DTYPE KYSEQ 07720CSR ENDSR KYSEQ 07730CSR PUTSEQ BEGSR KYSEQ 07740CSR MOVELMSG,5 BUFFER KYSEQ 07750CSR MOVE 'S' TYPE KYSEQ 07760CSR Z-ADD25 BLNGTH KYSEQ 07770CSR EXSR CRTCOM KYSEQ 0007780CSR MOVELSEQNO BUFFER KYSEQ 07790CSR MOVE 'T' TYPE KYSEQ 07800CSR Z-ADD5 BLNGTH KYSEQ 07810CSR EXSR CRTCOM KYSEQ 07820CSR ENDSR KYSEQ 07830CSR TSTSEQ BEGSR KYSEQ 07840CSR SETOF 949697 KYSEQ 0007850CSR SEQNO COMP LOW 989698 KYSEQ 07860CSR 98 SEQNO COMP HIGH 979898 KYSEQ 07870CSR 98 GOTO ENDTST KYSEQ 07880CSR 62 96 MOVELMSG,6 BUFFER KYSEQ 07890CSR 62 97 MOVELMSG,7 BUFFER KYSEQ 07900CSRN62 MOVELMSG,8 BUFFER KYSEQ 07910CSRN62 SETON 94 KYSEQ 0007920CSR MOVE 'T' TYPE KYSEQ 07930CSR Z-ADD25 BLNGTH KYSEQ 07940CSR EXSR CRTCOM KYSEQ 07950CSR 62 97 MOVE 'F' TYPE KYSEQ 07960CSR 62 97 EXSR CRTCOM KYSEQ 07970CSR ENDTST ENDSR KYSEQ 07980C********************************************************************KYSEQ 0007990OGLSEQ E 70N67 KYSEQ 08000O RECORD 128 KYSEQ 08010O 64 128 'X' KYSEQ 08020O SEQNO 127 KYSEQ ** 008030ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 008040ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00805000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 008060ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 008070** 008080ENTER BEGINNING RELATIVE RECORD NUMBER 008090ENTER ENDING RELATIVE RECORD NUMBER 008100** 008110MODE MUST BE A,C,V,OR E 00812000FIRST FIELD NAME BLANK 008130INVALID SEQ # 008140PROG# MUST BE FROM 1-8 008150CURRENT SEQUENCE NBR 008160SEQNO TO LOW 008170RUN EDIT PROG-FILE FULL 008180SEQNO NOT IN YOUR LIMITS 00819000** 008200 * MUST BE 'IN' OR 'MC' * 008210 * INVALID DATE * 008220 * INVALID VENDOR # * 008230 * VENDOR/INVOICE NOT ON FILE * 008240 * ACCT # IS INVALID * 008250 * CHECK # IS NOT OUTSTANDING * 00826000 * VENDOR/INV# NOT NEW ** 008270 * MUST NOT BE BLANK * 008280/* 008290__NVALID VENDOR # * 008230 * VENDOR/INVOICE NOT ON FILE * 008240 * ACCT # IS INVALID * 008250 * CHECK # IS NOT OUTSTANDING * 0082600(K` ?TXPO305 P999999032778(000010H S PO305 00020X DECK-ID M66 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO305 00030F* THIS PROGRAM REFORMATS DUE DATES AND CREATE TEMPORARY FILE POTEMP PO305 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO305 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO305 00060F* CONTROL DATA PROPRIETARY PRODUCT PO305 00070F* PO305 0000080FPOOUT IPEAF 128 DISK PO305 00090FPOTEMP O F 83 DISK PO305 00100F* PO305 00110F* ************************************************************** PO305 00120F* ** ** PO305 00130F* ** SYSTEM - PURCHASING PROGRAMMER- ROBBIE F. ** PO305 00140F* ** ** PO305 0000150F* ** PROGRAM- CREATE POTEMP DATE - 11/10/75 ** PO305 00160F* ** REFORMAT DUE DATES ** PO305 00170F* ** ** PO305 00180F* ************************************************************** PO305 00190F* PO305 00200F* ************************************************************** PO305 00210F* ** ** PO305 0000220F* ** FUNCTION OF INDICATORS ** PO305 00230F* ** ** PO305 00240F* ** 01 POOUT - HEADER PO305 00250F* ** 02 POOUT - COMMENT PO305 00260F* ** 03 POOUT - LINE-ITEM PO305 00270F* ** 04 POOUT - UNDEFINED TYPE PO305 00280F* ** 05 POOUT - DELETED RECORD PO305 0000290F* ** 11 BLANK RECORD READ FROM POOUT PO305 00300F* ** 15 LINE-ITEM DUE DATE IS ZERO ** PO305 00310F* ** 20 HEADER READ FOR THIS PO# ** PO305 00320F* ** 15&20 INSERT HEADER DUE DATE IN LINE-ITEM ** PO305 00330F* ************************************************************** PO305 00340F* PO305 00350IPOOUT XX 01 8 CH 128NCD PO305 0000360I 1 2 TST PO305 00370I 1 70PO L1 PO305 00380I 22 250HMD PO305 00390I 26 270HY PO305 00400I 124 1270RR PO305 00410I 1 83 ALL72 PO305 00420I XX 02 8 CK 128NCD PO305 0000430I 1 2 TST PO305 00440I 1 70PO L1 PO305 00450I 124 1270RR PO305 00460I 1 83 ALL72 PO305 00470I XX 03 8 CL 128NCD PO305 00480I 1 2 TST PO305 00490I 1 70PO L1 PO305 0000500I 22 270LMDY 15 PO305 00510I 22 250LMD PO305 00520I 26 270LY PO305 00530I 124 1270RR PO305 00540I 1 83 ALL72 PO305 00550I XX 04 128NCD PO305 00560I 1 2 TST PO305 0000570I 1 70PO L1 PO305 00580I 124 1270RR PO305 00590I 1 83 ALL72 11 PO305 00600I XX 05 128 CD PO305 00610I 1 2 TST PO305 00620I 1 1 DUMMY PO305 00630C TST COMP '<>' 62 PO305 0000640C 62 GOTO PEND PO305 00650C L1 SETOF 20 PO305 00660C 01 SETON 20 PO305 00670C MOVELB12 B12 20 PO305 00680C Z-ADD1 TEST 20 PO305 00690C PEND TAG PO305 00700OPOTEMP D 01N62 PO305 0000710O ALL72 83 PO305 00720O B12 83 PO305 00730O HY 23 PO305 00740O HMD 27 PO305 00750O 28 '0' PO305 00760O 29 ' ' PO305 00770O RR 33 PO305 0000780O D 02N62 PO305 00790O ALL72 83 PO305 00800O B12 83 PO305 00810O 27 '000000' PO305 00820O 29 ' ' PO305 00830O RR 33 PO305 00840O D 03N62 PO305 0000850O ALL72 83 PO305 00860O LY 23 PO305 00870O LMD 27 PO305 00880O 15 20 HY 23 PO305 00890O 15 20 HMD 27 PO305 00900O 28 '0' PO305 00910O 29 ' ' PO305 0000920O RR 33 PO305 00930O D 04N11N62 PO305 00940O ALL72 83 PO305 00950O 29 ' ' PO305 00960O RR 33 PO305 ** 000970ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00098000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000990ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001010/* 001020_ 00 00 00 00 00 00 00 __ 0(KK  TXPO306 P999999032778(000010H S PO306 00020X DECK-ID M67 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO306 00030F* THIS PROGRAM INIALIZES POOUT FILE WITH <> IN POSITION 1 AND 2 PO306 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO306 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO306 00060F* CONTROL DATA PROPRIETARY PRODUCT PO306 00070F* PO306 0000080FPOOUT UPE F 128 DISK PO306 00090IPOOUT NS 01 PO306 00100I 1 128 REC PO306 00110OPOOUT D 01 PO306 00120O REC 128 PO306 00130O 2 '<>' PO306 ** 00014000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000180/* 000190__0O 2 '<>' PO306 ** 0001400(K TTXPO307 P999999032778(000010H S PO307 00020X DECK-ID M68 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO307 00030F* THIS RECOVERY PROGRAM DISPLAYS LAST RECORD ENTERED IN POOUT FILE PO307 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO307 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO307 00060F* CONTROL DATA PROPRIETARY PRODUCT PO307 00070F* PO307 0000080FPODUM UPE F 72 DISK PO307 00090FPOOUT IC F 128R DISK PO307 00100E MSG 1 5 35 PO307 00110IPODUM NS 01 PO307 00120I 1 72 ALL PO307 00130IPOOUT NS 02 PO307 00140I 1 128 RCD PO307 0000150C SETOF 60 PO307 00160C SETON LR PO307 00170CLR MOVE ' ' B80 80 PO307 00180CLR EXSR ALMTS PO307 00190CLR Z-ADDLOW SEQNO 50 PO307 00200CLR LOOP TAG PO307 00210CLR SEQNO COMP HIGH 40 PO307 0000220CLR 40 GOTO A PO307 00230CLR SEQNO CHAINPOOUT 50 PO307 00240CLR 50 GOTO A PO307 00250CLR MOVELRCD TST 2 PO307 00260CLR TST COMP '<>' 51 PO307 00270CLRN51 SEQNO ADD 1 SEQNO PO307 00280CLRN51 GOTO LOOP PO307 0000290CLR A TAG PO307 00300CLR SEQNO SUB 1 SUBNO 50 PO307 00310CLR SUBNO CHAINPOOUT 50 PO307 00320CLR MOVELRCD BUFFER PO307 00330CLR MOVE 'T' TYPE PO307 00340CLR Z-ADD80 BLNGTH PO307 00350CLR EXSR CRTCOM PO307 0000360CLR MOVE RCD HOLD 48 PO307 00370CLR MOVE B80 BUFFER PO307 00380CLR MOVE 'T' TYPE PO307 00390CLR MOVELHOLD HOLD1 47 PO307 00400CLR MOVELHOLD HOLD2 42 PO307 00410CLR MOVELHOLD2 BUFFER PO307 00420CLR Z-ADD42 BLNGTH PO307 0000430CLR EXSR CRTCOM PO307 00440CLR MOVE B80 BUFFER PO307 00450CLR MOVELMSG,3 BUFFER PO307 00460CLR MOVE 'S' TYPE PO307 00470CLR Z-ADD35 BLNGTH PO307 00480CLR EXSR CRTCOM PO307 00490CLR MOVE B80 BUFFER PO307 0000500CLR MOVE HOLD1 HLDSEQ 5 PO307 00510CLR MOVELHLDSEQ BUFFER PO307 00520CLR MOVE 'T' TYPE PO307 00530CLR Z-ADD5 BLNGTH PO307 00540CLR EXSR CRTCOM PO307 00550CLR MOVELMSG,4 BUFFER PO307 00560CLR MOVE 'S' TYPE PO307 0000570CLR Z-ADD35 BLNGTH PO307 00580CLR EXSR CRTCOM PO307 00590CLR MOVE B80 BUFFER PO307 00600CLR MOVE 'A' TYPE PO307 00610CLR Z-ADD1 BLNGTH PO307 00620CLR EXSR CRTCOM PO307 00630CLR MOVE 'C' TYPE PO307 0000640CLR EXSR CRTCOM PO307 00650CLR MOVE 'F' TYPE PO307 00660CLR EXSR CRTCOM PO307 00670CSR ALMTS BEGSR PO307 00680CSR MOVE B80 BUFFER 80 PO307 00690CSR MOVE 'C' TYPE 1 PO307 00700CSR Z-ADD0 BLNGTH 20 PO307 0000710CSR MOVE ' ' RCODE 1 PO307 00720CSR Z-ADD0 MASK 10 PO307 00730CSR Z-ADD0 DTYPE 10 PO307 00740CSR EXSR CRTCOM PO307 00750CSR MOVELMSG,1 BUFFER PO307 00760CSR MOVE 'S' TYPE PO307 00770CSR Z-ADD35 BLNGTH PO307 0000780CSR EXSR CRTCOM PO307 00790CSR MOVE B80 BUFFER PO307 00800CSR MOVE 'A' TYPE PO307 00810CSR Z-ADD5 BLNGTH PO307 00820CSR Z-ADD1 DTYPE PO307 00830CSR EXSR CRTCOM PO307 00840CSR EXSR SKIP PO307 0000850CSR RCODE COMP 'R' 86 PO307 00860CSR EXSR AJ PO307 00870CSR MOVELBUFFER LOW 50 PO307 00880CSR MOVE B80 BUFFER PO307 00890CSR MOVELMSG,2 BUFFER PO307 00900CSR MOVE 'S' TYPE PO307 00910CSR Z-ADD35 BLNGTH PO307 0000920CSR EXSR CRTCOM PO307 00930CSR MOVE B80 BUFFER PO307 00940CSR MOVE 'A' TYPE PO307 00950CSR Z-ADD5 BLNGTH PO307 00960CSR Z-ADD1 DTYPE PO307 00970CSR EXSR CRTCOM PO307 00980CSR RCODE COMP 'R' 87 PO307 0000990CSR EXSR AJ PO307 01000CSR MOVELBUFFER HIGH 50 PO307 01010CSR MOVE 'C' TYPE PO307 01020CSR EXSR CRTCOM PO307 01030CSR 86 PO307 01040COR 87 GOTO ALMTS PO307 01050CSR Z-ADD0 DTYPE PO307 0001060CSR ENDSR PO307 01070CSR CRTCOM BEGSR PO307 01080CSR EXITFSUBRCM PO307 01090CSR RLABL BUFFER PO307 01100CSR RLABL TYPE PO307 01110CSR RLABL BLNGTH PO307 01120CSR RLABL RCODE PO307 0001130CSR RLABL MASK PO307 01140CSR RLABL DTYPE PO307 01150CSR ENDSR PO307 01160CSR SKIP BEGSR PO307 01170CSR MOVELBUFFER NBUF 1 PO307 01180CSR MOVEL' ' BUFFER PO307 01190CSR Z-ADD1 BLNGTH PO307 0001200CSR MOVE 'T' TYPE PO307 01210CSR EXSR CRTCOM PO307 01220CSR MOVELNBUF BUFFER PO307 01230CSR ENDSR PO307 01240CSR AJ BEGSR PO307 01250CSR MOVELBUFFER VAR 15 PO307 01260CSR Z-ADD5 VL 20 PO307 0001270CSR EXIT SUBRAJ PO307 01280CSR RLABL VL PO307 01290CSR RLABL VAR PO307 01300CSR MOVELVAR BUFFER PO307 01310CSR ENDSR PO307 01320OPODUM D 60 PO307 01330O ALL 72 PO307 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(&L &TXPO310 PHL999999032778(000010H S PO310 00020X DECK-ID M69 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO310 00030F* THIS PROGRAM EDITS PURCHASE ORDER TRANSACTIONS AND WRITES EDITRPT PO310 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO310 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO310 00060F* CONTROL DATA PROPRIETARY PRODUCT PO310 00070F* PO310 0000080FPURUPD UPEAF 83 DISK PO310 00090FPURCH IC F 66R27AI 1 DISK PO310 00100FPOINDX IC F 8R 7AI 1 DISK PO310 00110FVENDOR IC F 256R 5AI 1 DISK PO310 00120FPARTMST IC F 300R20AI 271 DISK PO310 00130F$LP1 O F 132 OF PRINTER PO310 00140FHEADING IT F 40 EDISK PO310 0000150F* PO310 00160F* ************************************************************** PO310 00170F* ** ** PO310 00180F* ** COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO310 00190F* ** ** PO310 00200F* ** SYSTEM - PURCHASING PROGRAMMER- ROBBIE FREEMAN ** PO310 00210F* ** ** PO310 0000220F* ** PROGRAM- P.O. EDIT DATE - 11/12/75 ** PO310 00230F* ** ** PO310 00240F* ************************************************************** PO310 00250F* PO310 00260F* ************************************************************** PO310 00270F* ** ** PO310 00280F* ** FUNCTION OF INDICATORS ** PO310 0000290F* ** ** PO310 00300F* ** 01 PURUPD- HEADER ** PO310 00310F* ** 02 PURUPD- COMMENT ** PO310 00320F* ** 03 PURUPD- LINE-ITEM, ALL TRANSACTIONS EXCEPT 'R' ** PO310 00330F* ** 04 PURUPD- LINE-ITEM, TRANS = 'R' = RECEIPTS ** PO310 00340F* ** 05 PURUPD- INVALID RECORD TYPE ** PO310 00350F* ** 06 PURCH ** PO310 0000360F* ** 07 POINDX ** PO310 00370F* ** 08 VENDOR ** PO310 00380F* ** 09 PARTMST ** PO310 00390F* ** 10 NO DUE DATE IN HEADER ** PO310 00400F* ** 17 NO DUE DATE IN LINE-ITEM ** PO310 00410F* ** 18 NO VENDOR # IN LINE-ITEM- MANDATORY FOR ADD TO ** PO310 00420F* ** EXISTING P.O. OR BLANKET. ** PO310 0000430F* ** 19 QTY ORDERED = 0 ** PO310 00440F* ** 20 NO BUY COST OVERRIDE ** PO310 00450F* ** 21 HEADER TRANS = E = RELEASE NEW P.O. ** PO310 00460F* ** 22 HEADER TRANS = A = ADD NEW OPEN P.O. ** PO310 00470F* ** 23 HEADER TRANS = B = ADD NEW BLANKET P.O. ** PO310 00480F* ** 30 THIS LINE ITEM HAS SAME PO# AS LAST ITEM- USED ** PO310 00490F* ** TO CHECK THAT NOT MORE THAN 1 ITEM WITH THE ** PO310 0000500F* ** SAME PO#-PART#-DUE DATE IS BEING ADDED. ** PO310 00510F* ** 31 'L' TRANS = E = RELEASE LINE- NEW P.O. ** PO310 00520F* ** 32 'L' TRANS = A = ADD LINE- NEW OR EXISTING P.O. ** PO310 00530F* ** 33 'L' TRANS = B = ADD LINE- NEW OR EXISTING BLKT ** PO310 00540F* ** 34 'L' TRANS = C = CHANGE LINE ** PO310 00550F* ** 35 'L' TRANS = D = DELETE LINE ** PO310 00560F* ** ** PO310 0000570F* ** WARNING ERRORS ** PO310 00580F* ** 44 RELEASE QTY EXCEEDS BLANKET QTY ** PO310 00590F* ** 45 QTY ORDERED = ZERO ** PO310 00600F* ** 46 BUY COST OVERRIDE ** PO310 00610F* ** ** PO310 00620F* ** TERMINAL ERRORS ** PO310 00630F* ** 50 INVALID RECORD TYPE ** PO310 0000640F* ** 51 INVALID TRANSACTION ** PO310 00650F* ** 52 TRANSACTION DOESN'T MATCH HEADER TRANSACTION ** PO310 00660F* ** 53 NO VALID 'H' INPUT- MANDATORY FOR NEW P.O.'S ** PO310 00670F* ** 54 NO DUE DATE ** PO310 00680F* ** 55 INVALID DUE DATE ** PO310 00690F* ** 56 INVALID VENDOR# ** PO310 00700F* ** 57 INVALID PART # ** PO310 0000710F* ** 58 NO BLANKET ON FILE- MANDATORY FOR RELEASES ** PO310 00720F* ** 59 DUPLICATE ADD ** PO310 00730F* ** 60 P.O. NOT ON FILE ** PO310 00740F* ** 61 THIS PO#-PART#-DUE DATE NOT ON BLANKET ** PO310 00750F* ** 62 THIS PO#-PART#-DUE DATE NOT ON FILE ** PO310 00760F* ** ** PO310 00770F* ** 70 NO HIT TO POINDX OR PURCH FILES ** PO310 0000780F* ** 71 P.O. CODE = RELEASE ** PO310 00790F* ** 72 P.O. CODE = OPEN ** PO310 00800F* ** 73 P.O. CODE = BLANKET ** PO310 00810F* ** ** PO310 00820F* ** 89 AN ERROR HAS OCCURED IN THIS DETAIL CYCLE ** PO310 00830F* ** 90 A VALID HEADER WAS INPUT FOR THIS PO# ** PO310 00840F* ** ** PO310 0000850F* ** 98 A TERMINAL ERROR FOR ENTIRE L1 GROUP ** PO310 00860F* ** 99 A TERMINAL ERROR HAS OCCURRED IN THIS CYCLE ** PO310 00870F* ** ** PO310 00880F* ** H1 POINDX - INVALID P.O. TYPE - 'H' - POP SYS BUG ** PO310 00890F* ** H2 PURCH - INVALID P.O. TYPE - 'L' - POP SYS BUG ** PO310 00900F* ** ** PO310 00910F* ************************************************************** PO310 0000920E TABN 1 20 2 0ATABM 40 ERR#'S- MESSAGES PO310 00930E HEADING HEAD 1 1 40 PO310 00940IPURUPD XX 01 8 CH PO310 00950I 1 70PO L3 PO310 00960I 9 9 HACT PO310 00970I 22 270HDUE 10 PO310 00980I 22 230HYY PO310 0000990I 24 270HMMDD PO310 01000I 30 330RR PO310 01010I 34 380HVEN PO310 01020I XX 02 8 CK PO310 01030I 1 70PO L3 PO310 01040I 9 9 KACT PO310 01050I 28 280LINE PO310 0001060I 30 330RR PO310 01070I 34 63 COM PO310 01080I XX 03 8 CL 9NCR PO310 01090I 1 70PO L3 PO310 01100I 9 9 LACT PO310 01110I 64 83 PART L2 PO310 01120I 22 270LDUE L1 17 PO310 0001130I 30 330RR PO310 01140I 34 380LVEN 18 PO310 01150I 39 450LQTYDU 19 PO310 01160I 46 520LQTYIN PO310 01170I 53 593LCOST 20 PO310 01180I 64 83 FLD18 PO310 01190I 22 230LYY PO310 0001200I 24 270LMMDD PO310 01210I XX 04 8 CL 9 CR PO310 01220I 1 1 DUMMY PO310 01230I XX 05 PO310 01240I 1 70PO L3 PO310 01250I 8 8 ITYPE PO310 01260I 9 9 IACT PO310 0001270I 30 330RR PO310 01280IPURCH XX 06 PO310 01290I 34 380VEN PO310 01300I 45 510QTYDUE PO310 01310I 52 580QTYIN PO310 01320I 66 66 POC PO310 01330IPOINDX XX 07 PO310 0001340I 8 8 POC PO310 01350IVENDOR XX 08 PO310 01360I 1 1 DUMMY PO310 01370I 106 106 DLTVE PO310 01380IPARTMST XX 09 PO310 01390I 1 1 DUMMY PO310 01400I 74 74 DLTPA PO310 0001410C SETOF 44 PO310 01420C SETOF 454689 PO310 01430C SETOF 99 PO310 01440C Z-ADD0 ERR 20 PO310 01450C 03 1 ADD LCNT LCNT 60 PO310 01460C 04 GOTO END IGNORE RECPTS PO310 01470C L3 SETOF 515253 PO310 0001480C L3 SETOF 545556 PO310 01490C L3 SETOF 575859 PO310 01500C L3 SETOF 606162 PO310 01510C L3 SETOF 9098 PO310 01520C 98 51 Z-ADD51 ERR 99 PO310 01530C 98 54 Z-ADD54 ERR 99 PO310 01540C 98 55 Z-ADD55 ERR 99 PO310 0001550C 98 56 Z-ADD56 ERR 99 PO310 01560C 98 58 Z-ADD58 ERR 99 PO310 01570C 98 59 Z-ADD59 ERR 99 PO310 01580C 05 Z-ADD50 ERR 99 PO310 01590C 99 03 1 ADD CNTERR CNTERR PO310 01600C 99 GOTO END PO310 01610C 01 EXSR SUB1 PO310 0001620C 02 EXSR SUB2 PO310 01630C 03 EXSR SUB3 PO310 01640C END TAG PO310 01650C 99 SETON 89 PO310 01660C 89 ERR LOKUPTABN TABM 89 PO310 01670C* PO310 01680C* ************************************************************** PO310 0001690C* ** SUBR SUB1 VALIDATES HEADERS. 'H' INPUT IMPLIES THIS IS PO310 01700C* ** A NEW P.O. SO IF PRIMARY EDITS PASSED, CHECK THAT THIS ** PO310 01710C* ** PO# IS NOT ON POINDX. FOR RELEASES, ALSO CHECK THAT A ** PO310 01720C* ** BLANKET EXISTS FOR IT. ** PO310 01730C* ** ANY 'H' ERROR WILL REJECT ALL RECORDS WITH THIS PO#. ** PO310 01740C* ************************************************************** PO310 01750C* PO310 0001760CSR SUB1 BEGSR PO310 01770CSR SETOF 90 PO310 01780CSR HACT COMP 'E' 21RELEASE PO310 01790CSR HACT COMP 'A' 22ADD PO310 01800CSR HACT COMP 'B' 23BLANKET PO310 01810CSRN21N22N23 Z-ADD51 ERR 99 BAD TRANS PO310 01820CSR 99 SETON 9851 REJECT ALL PO310 0001830CSR 99 GOTO END1 PO310 01840CSR 10 Z-ADD54 ERR 99 NO DUE DATE PO310 01850CSR 99 SETON 9854 REJECT ALL PO310 01860CSR 99 GOTO END1 PO310 01870CSR MOVE HDUE DATE 60 PO310 01880CSR EXSR CHKDAT DUE DATE OK? PO310 01890CSR 99 Z-ADD55 ERR NO PO310 0001900CSR 99 SETON 9855 REJECT ALL PO310 01910CSR 99 GOTO END1 PO310 01920CSR HVEN CHAINVENDOR 99 VENDOR# OK? PO310 01930CSRN99 DLTVE COMP ' ' 9999 PO310 01940CSR 99 Z-ADD56 ERR NO PO310 01950CSR 99 SETON 9856 REJECT ALL PO310 01960CSR 99 GOTO END1 PO310 0001970C** PO310 01980C** NOW DO CHAINS TO CHECK FOR BLANKETS, DUPLICATE ADDS PO310 01990C** PO310 02000CSR 21 GOTO T21 RELEASE PO310 02010CSR 22 ADD PO310 02020COR 23 GOTO T22 BLANKET PO310 02030C** PO310 0002040CSR T21 TAG PO310 02050C** PO310 02060CSR MOVE PO POKEY1 70 PO310 02070CSR MOVE 00 POKEY1 PO310 02080CSR EXSR CHAIN1 BLNKT ON FILE? PO310 02090CSRN73 Z-ADD58 ERR 99 NO PO310 02100CSR 99 SETON 9858 REJECT ALL PO310 0002110CSR 99 GOTO END1 PO310 02120C** PO310 02130CSR T22 TAG PO310 02140C** PO310 02150CSR MOVE PO POKEY1 PO310 02160CSR EXSR CHAIN1 DUPLICATE ADD? PO310 02170CSRN70 Z-ADD59 ERR 99 YES PO310 0002180CSR 99 SETON 9859 REJECT ALL PO310 02190CSR 99 GOTO END1 PO310 02200C** VALID H- ALL PO310 02210CSR SETON 90 CHECKS PASSED PO310 02220CSR END1 ENDSR PO310 02230C** PO310 02240C** PO310 0002250CSR SUB2 BEGSR PO310 02260CSRN90 Z-ADD53 ERR 99 NO VALID H READPO310 02270CSR 99 GOTO END2 PO310 02280CSR KACT COMP 'A' 5151 TRANS OK? PO310 02290CSR 51 KACT COMP 'B' 5151 PO310 02300CSR 51 KACT COMP 'E' 5151 PO310 02310CSR 51 Z-ADD51 ERR 99 NO PO310 0002320CSR 99 GOTO END2 PO310 02330CSR HACT COMP KACT 5252 ACTION NOT PO310 02340CSR 52 Z-ADD52 ERR 99 SAME AS H PO310 02350CSR END2 ENDSR PO310 02360C** PO310 02370C** PO310 02380CSR SUB3 BEGSR PO310 0002390CSR LACT COMP 'E' 31RELEASE PO310 02400CSR LACT COMP 'A' 32ADD PO310 02410CSR LACT COMP 'B' 33BLANKET PO310 02420CSR LACT COMP 'C' 34CHANGE PO310 02430CSR LACT COMP 'D' 35DELETE PO310 02440CSRN31N32N33 PO310 02450CANN34N35 Z-ADD51 ERR 99 BAD TRANS PO310 0002460CSR 99 GOTO END3 PO310 02470C** PO310 02480C** DO PRIMARY EDIT CHECKS PO310 02490C** PO310 02500CSR 31N90 Z-ADD53 ERR 99 NO H INPUT FOR PO310 02510CSR 99 GOTO END3 RELEASE. PO310 02520CSR 31 90N21 TRANS SAME AS PO310 0002530COR 32 90N22 HEADER? PO310 02540COR 33 90N23 Z-ADD52 ERR 99 NO PO310 02550CSR 99 GOTO END3 PO310 02560CSR 17 Z-ADD54 ERR 99 NO DUE DATE PO310 02570CSR 99 GOTO END3 PO310 02580CSR MOVE LDUE DATE PO310 02590CSR EXSR CHKDAT DUE DATE OK? PO310 0002600CSR 99 Z-ADD55 ERR NO PO310 02610CSR 99 GOTO END3 PO310 02620CSR 32N90 PO310 02630COR 33N90 PO310 02640COR 34N18 LVEN CHAINVENDOR 99 PO310 02650CSR 32N90N99 PO310 02660COR 33N90N99 PO310 0002670COR 34N18N99DLTVE COMP ' ' 9999 PO310 02680CSR 99 Z-ADD56 ERR PO310 02690CSR 99 GOTO END3 PO310 02700CSR PART CHAINPARTMST 99 PART # OK? PO310 02710CSRN99 DLTPA COMP ' ' 9999 PO310 02720CSR 99 Z-ADD57 ERR NO PO310 02730CSR 99 GOTO END3 PO310 0002740CSR PO COMP SAVEPO 30 IS THIS A PO310 02750CSR MOVE PO SAVEPO 70 DUPLICATE ADD PO310 02760CSR 31 30NL1 ATTEMPT FROM PO310 02770COR 32 30NL1 PURUPD? PO310 02780COR 33 30NL1 Z-ADD59 ERR 99 YES PO310 02790CSR 99 GOTO END3 PO310 02800C** PO310 0002810CSR 31 GOTO T31 PRIMARY EDITS PO310 02820CSR 32 PASSED- NOW DO PO310 02830COR 33 GOTO T32 CHAINS PO310 02840CSR 34 GOTO T34 PO310 02850CSR 35 GOTO T35 PO310 02860C** PO310 02870CSR T31 TAG RELEASE PO310 0002880C** PO310 02890CSR MOVE PO POKEY1 PO310 02900CSR MOVE 00 POKEY1 PO310 02910CSR MOVELPOKEY1 POKEY2 27 PO310 02920CSR MOVE FLD18 POKEY2 PO310 02930CSR EXSR CHAIN2 BLNKT ON FILE? PO310 02940CSRN73 Z-ADD61 ERR 99 NO PO310 0002950CSR 99 GOTO END3 PO310 02960CSR LQTYDU COMP REMAIN 44 RELQTY>BLKTQTY PO310 02970CSR GOTO WARN CHECK WARNINGS PO310 02980C** PO310 02990CSR T32 TAG ADD,BLANKET PO310 03000C** PO310 03010CSR 90 GOTO WARN NEW PO-NO NEED PO310 0003020C** TO DO CHAINS PO310 03030C** THE FOLLOWING CHECKS ARE FOR ADDING AN ITEM TO AN PO310 03040C** ALREADY EXISTING OPEN OR BLANKET P.O. - IT IS PO310 03050C** ONLY DONE WHEN NO HEADER WAS INPUT IN THIS L3 (PO#) PO310 03060C** GROUP. THE P.O. MUST EXIST IN THIS CASE BUT AN ITEM PO310 03070C** WITH THE SAME PART#-DUE DATE CANNOT. PO310 03080C** PO310 0003090CSR MOVE PO POKEY1 OPEN OR BLNKT PO310 03100CSR EXSR CHAIN1 P.O. ON FILE? PO310 03110CSR 32N72 PO310 03120COR 33N73 Z-ADD60 ERR 99 NO PO310 03130CSR 99 GOTO END3 PO310 03140CSR MOVELPO POKEY2 PO310 03150CSR MOVE FLD18 POKEY2 PO310 0003160CSR EXSR CHAIN2 DUPLICATE ADD? PO310 03170CSRN70 Z-ADD59 ERR 99 YES PO310 03180CSR 99 GOTO END3 PO310 03190CSR GOTO WARN CHECK WARNINGS PO310 03200C** PO310 03210CSR T34 TAG CHANGE PO310 03220C** PO310 0003230CSR MOVELPO POKEY2 PO310 03240CSR MOVE FLD18 POKEY2 PO310 03250CSR EXSR CHAIN2 P.O. ON FILE? PO310 03260CSR 70 Z-ADD62 ERR 99 NO PO310 03270CSR 99 GOTO END3 PO310 03280CSR GOTO WARN PO310 03290C** PO310 0003300CSR T35 TAG DELETE PO310 03310C** PO310 03320CSR MOVELPO POKEY2 PO310 03330CSR MOVE FLD18 POKEY2 PO310 03340CSR EXSR CHAIN2 P.O. ON FILE? PO310 03350CSR 70 Z-ADD62 ERR 99 NO PO310 03360CSR GOTO END3 PO310 0003370C** PO310 03380CSR WARN TAG WARNING ERRORS PO310 03390C** PO310 03400CSR 44 Z-ADD44 ERR 89 RELQTY>BKTQTY? PO310 03410CSR 89 GOTO END3 YES PO310 03420CSR 19N34 Z-ADD45 ERR 89 QTY ORD=0 ? PO310 03430CSR 89 GOTO END3 YES PO310 0003440CSRN20 Z-ADD46 ERR 89 OVERRIDE COST PO310 03450CSR END3 TAG PO310 03460CSR 99 1 ADD CNTERR CNTERR 60 PO310 03470CSR ENDSR PO310 03480C** PO310 03490C** PO310 03500CSR CHAIN1 BEGSR PO310 0003510CSR SETOF 717273 PO310 03520CSR POKEY1 CHAINPOINDX 70 PO310 03530CSR 70 GOTO ENDCH1 PO310 03540CSR POC COMP 'R' 71RELEASE ONFILE PO310 03550CSR POC COMP ' ' 72OPEN ONFILE PO310 03560CSR POC COMP 'B' 73BLANKET ONFILE PO310 03570CSRN71N72N73 SETON H1 PO310 0003580CSR ENDCH1 ENDSR PO310 03590C** PO310 03600C** PO310 03610CSR CHAIN2 BEGSR PO310 03620CSR SETOF 717273 PO310 03630CSR POKEY2 CHAINPURCH 70 PO310 03640CSR 70 GOTO ENDCH2 PO310 0003650CSR POC COMP 'R' 71RELEASE ONFILE PO310 03660CSR POC COMP ' ' 72OPEN ONFILE PO310 03670CSR POC COMP 'B' 73BLANKET ONFILE PO310 03680CSRN71N72N73 SETON H2 PO310 03690CSR 73 QTYDUE SUB QTYIN REMAIN 70 BLKT QTY PO310 03700CSR ENDCH2 ENDSR REMAINING PO310 03710C** PO310 0003720C** PO310 03730CSR CHKDAT BEGSR PO310 03740CSR MOVE DATE MMDD 40 PO310 03750CSR MOVELDATE YY 20 PO310 03760CSR MOVELMMDD MM 20 PO310 03770CSR MOVE MMDD DD 20 PO310 03780CSR YY COMP 75 99 PO310 0003790CSR 99 GOTO ENDCHK PO310 03800CSR MM COMP 1 99 PO310 03810CSRN99 MM COMP 12 99 PO310 03820CSR 99 GOTO ENDCHK PO310 03830CSR DD COMP 1 99 PO310 03840CSRN99 DD COMP 31 99 PO310 03850CSR ENDCHK ENDSR PO310 0003860C** PO310 03870C** PO310 03880OPURUPD D 99 PO310 03890O 29 'X' PO310 03900O$LP1 H 02 1P PO310 03910O OR OF PO310 03920O 4 'PAGE' PO310 0003930O PAGE Z 8 PO310 03940O HEAD 86 PO310 03950O UDATE Y 132 PO310 03960O H 2 1P PO310 03970O OR OF PO310 03980O 75 'PURCHASE ORDER EDIT' PO310 03990O 132 'MFG310' PO310 0004000O H 2 1P PO310 04010O OR OF PO310 04020O 85 'OVERIDE' PO310 04030O 132 'ERROR' PO310 04040O H 12 1P PO310 04050O OR OF PO310 04060O 8 'PO #/LOT' PO310 0004070O 12 'ACT' PO310 04080O 16 'TYP' PO310 04090O 20 'LIN' PO310 04100O 26 'VEND#' PO310 04110O 38 'DUE DATE' PO310 04120O 51 'PART NUMBER' PO310 04130O 68 'PO QTY' PO310 0004140O 76 'QTY IN' PO310 04150O 85 'BUY CST' PO310 04160O 90 'RR#' PO310 04170O 98 'ERRORS' PO310 04180O 132 'SEVERITY' PO310 04190O D 2 L3N1P PO310 04200O 1 ' ' PO310 0004210O D 11 01 PO310 04220O PO 8 ' - ' PO310 04230O HACT 11 PO310 04240O 15 'H' PO310 04250O HVEN 26 PO310 04260O HMMDD 44 ' / ' PO310 04270O 45 '/' PO310 0004280O HYY 47 PO310 04290O RR Z 91 PO310 04300O 89 TABM 132 PO310 04310O D 1 02 PO310 04320O PO 8 ' - ' PO310 04330O KACT 11 PO310 04340O 15 'K' PO310 0004350O LINE 19 PO310 04360O COM 51 PO310 04370O RR Z 91 PO310 04380O 89 TABM 132 PO310 04390O D 1 03 PO310 04400O PO 8 ' - ' PO310 04410O LACT 11 PO310 0004420O 15 'L' PO310 04430O LVEN 26 PO310 04440O PART 60 PO310 04450O N17 LMMDD 35 ' / ' PO310 04460O N17 36 '/' PO310 04470O N17 LYY 38 PO310 04480O LQTYDUL 70 PO310 0004490O 34 LQTYINL 78 PO310 04500O N20 LCOST L 87 PO310 04510O RR Z 91 PO310 04520O 89 TABM 132 PO310 04530O 89 TABM 132 PO310 04540O D 11 05 PO310 04550O PO 8 ' - ' PO310 0004560O IACT 11 PO310 04570O ITYPE 15 PO310 04580O RR Z 91 PO310 04590O 89 TABM 132 PO310 04600O T 2 LR PO310 04610O 10 'THERE WERE' PO310 04620O LCNT Z 17 PO310 0004630O 39 'LINE ITEMS PROCESSED.' PO310 04640O T 2 LR PO310 04650O 10 'THERE WERE' PO310 04660O CNTERRZ 17 PO310 04670O 38 'LINE ITEMS REJECTED.' PO310 ** 004680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00469000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004700ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004710ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004720** 00473044RELEASE QTY EXCEEDS BLANKET QTY WARNING 00474045QTY ORDERED= ZERO WARNING 00475046BUY COST OVERRIDE WARNING 0047600050INVALID RECORD TYPE REJECTED 00477051INVALID TRANSACTION REJECTED 00478052TRANSACTION NOT SAME AS HEADER REJECTED 00479053NO VALID HEADER INPUT REJECTED 00480054NO DUE DATE REJECTED 00481055INVALID DUE DATE REJECTED 00482056INVALID VENDOR# REJECTED 0048300057INVALID PART # REJECTED 00484058BLANKET NOT ON FILE REJECTED 00485059DUPLICATE ADD REJECTED 00486060P.O. NOT ON FILE REJECTED 00487061PO#-PART#-DUEDATE NOT ON BLNKT REJECTED 00488062PO#-PART#-DUEDATE NOT ON FILE REJECTED 00489063 0049000064 00491065 00492066 004930/* 004940_ 00 00 00 00 00 00 00 00 __ 0(L iTXPO320 P >999999032778(000010H S PO320 00020X DECK-ID M70 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO320 00030F* THIS PROGRAM PROCESSES VALID NEW PURCHASE ORDERS AND CHANGES PO320 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO320 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO320 00060F* CONTROL DATA PROPRIETARY PRODUCT PO320 00070F* PO320 0000080FPURUPD IPEAF 83 DISK PO320 00090FPURCH UC F 66R27AI 1 DISK A PO320 00100FTRANSAC O F 65 DISK A PO320 00110F* PO320 00120F* ************************************************************** PO320 00130F* ** ** PO320 00140F* ** COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO320 0000150F* ** ** PO320 00160F* ** SYSTEM - PINS PROGRAMMER- R. FREEMAN ** PO320 00170F* ** ** PO320 00180F* ** PROGRAM- PROCESS A,B,C,D,E DATE - 11/14/75 ** PO320 00190F* ** TRANSACTIONS TO PURCH ** PO320 00200F* ** ** PO320 00210F* ************************************************************** PO320 0000220F* PO320 00230F* ************************************************************** PO320 00240F* ** ** PO320 00250F* ** FUNCTION OF INDICATORS ** PO320 00260F* ** ** PO320 00270F* ** 01 PURUPD- HEADER (NO ERROR CODE) ** PO320 00280F* ** 02 PURUPD- LINE-ITEM (NO ERROR CODE) ** PO320 0000290F* ** 03 PURUPD- OTHERS ** PO320 00300F* ** 04 PURCH ** PO320 00310F* ** 10 LINE-ITEM VENDOR#=ZERO - DON'T CHANGE ** PO320 00320F* ** 11 LINE-ITEM QTYDUE=ZERO - DON'T CHANGE ** PO320 00330F* ** 12 LINE-ITEM QTYIN=ZERO - DON'T CHANGE ** PO320 00340F* ** 13 LINE-ITEM BUY COST=ZERO- DON'T CHANGE ** PO320 00350F* ** 20 VALID HEADER READ FOR THIS PO#- NEW P.O. ** PO320 0000360F* ** 31 TRANS= RELEASE ** PO320 00370F* ** 32 TRANS= ADD (OPEN) ** PO320 00380F* ** 33 TRANS= BLANKET ** PO320 00390F* ** 34 TRANS= CHANGE ** PO320 00400F* ** 35 TRANS= DELETE ** PO320 00410F* ** 40 ADD TRAN# 40 TO TRANSAC ** PO320 00420F* ** 42 ADD TRAN# 42 TO TRANSAC ** PO320 0000430F* ** 43 ADD TRAN# 43 TO TRANSAC ** PO320 00440F* ** 45 ADD TRAN# 45 TO TRANSAC ** PO320 00450F* ** 71 P.O. CODE ON PURCH = RELEASE ** PO320 00460F* ** 72 P.O. CODE ON PURCH = OPEN ** PO320 00470F* ** 73 P.O. CODE ON PURCH = BLANKET ** PO320 00480F* ** H1 NO HIT ON PURCH - MFG310 HAS BUGS ** PO320 00490F* ** H2 P.O. CODE INVALID- MFG310 HAS BUGS ** PO320 0000500F* ************************************************************** PO320 00510F* PO320 00520IPURUPD XX 01 8 CH 29NCX PO320 00530I 1 70PO L1 PO320 00540I 34 380HVEN PO320 00550I 39 440HPODAT PO320 00560I XX 02 8 CL 9NCR 29NCX PO320 0000570I 1 70PO L1 PO320 00580I 9 9 ACTION PO320 00590I 64 83 PART PO320 00600I 22 270IDUE PO320 00610I 64 83 N18 PO320 00620I 34 380IVEN 10 PO320 00630I 39 450IQTYDU 11 PO320 0000640I 46 520IQTYIN 12 PO320 00650I 53 593ICOST 13 PO320 00660I XX 03 PO320 00670I 1 1 DUMMY PO320 00680IPURCH XX 04 PO320 00690I 34 380VEN PO320 00700I 45 510QTYDUE PO320 0000710I 52 580QTYIN PO320 00720I 66 66 POC PO320 00730C SETOF 404243 PO320 00740C SETOF 45 PO320 00750C L1 SETOF 20 PO320 00760C 01 SETON 20 PO320 00770C N02 GOTO END PO320 0000780C********************************************************************PO320 00790C* CALCS FOR ADD,CHANGE,DELETE LINE-ITEMS. FOR ADDS & BLANKETS PO320 00800C* NO NEED TO DO ANY CHAINS TO PURCH- JUST ADD TO FILE. ADDS (NOT PO320 00810C* BLANKETS) GENERATE TR#40 WITH TRNQTY = QTY ORDERED. RELEASE IS PO320 00820C* SAME AS ADD BUT WE ALSO CHAIN TO ITS BLANKET ON PURCH & UPDATE PO320 00830C* THE RELEASED-TO-DATE WITH THIS RELEASE QTY. ALSO GENERATES PO320 00840C* TR#40. FOR CHANGES, WE CHAIN TO PURCH & REPLACE ANY FIELDS PO320 0000850C* WHICH ARE NON-ZERO ON PURUPD- VENDOR#,QTYDUE,QTYIN,OR OVERRIDE PO320 00860C* BUY COST. CHANGE TO QTYDUE GENERATES TR#42 WITH TRNQTY = NEW PO320 00870C* QTYDUE - OLD QTYDUE, CHANGE TO QTYIN-TR#43 WITH TRNQTY = NEW PO320 00880C* QTYIN - OLD QTYIN. FOR DELETES, WE CHAIN & UPDATE PURCH WITH PO320 00890C* DELETE CODE, GENERATE TR#45 WITH TRNQTY = QTYDUE - QTYIN. PO320 00900C********************************************************************PO320 00910C ACTION COMP 'E' 31RELEASE PO320 0000920C ACTION COMP 'A' 32ADD PO320 00930C ACTION COMP 'B' 33BLANKET PO320 00940C ACTION COMP 'C' 34CHANGE PO320 00950C ACTION COMP 'D' 35DELETE PO320 00960C 31 PO320 00970COR 32 Z-ADDIQTYDU TRQTY1 70 4040 TR# 40 FOR E,A PO320 00980C 31 GOTO T31 PO320 0000990C 34 GOTO T34 PO320 01000C 35 GOTO T35 PO320 01010C GOTO END NO NEED TO DO PO320 01020C* CHAIN FOR A,B PO320 01030C* PO320 01040C T31 TAG REL- UPDATE PO320 01050C** QTY ON BLANKET PO320 0001060C MOVE PO N7 70 PO320 01070C MOVE 00 N7 PO320 01080C MOVELN7 POKEY 27 PO320 01090C MOVE N18 POKEY PO320 01100C EXSR CHAIN PO320 01110C N73 SETON H2 PO320 01120C H2 GOTO END PO320 0001130C QTYIN ADD IQTYDU QTYIN ADD RELEAS QTY PO320 01140C GOTO END PO320 01150C* PO320 01160C T34 TAG CHANGE PO320 01170C* PO320 01180C MOVELPO POKEY PO320 01190C MOVE N18 POKEY PO320 0001200C EXSR CHAIN PO320 01210C N71N72N73 SETON H2 PO320 01220C H2 GOTO END PO320 01230C 73 GOTO END PO320 01240C N11 IQTYDU SUB QTYDUE TRQTY1 4242 CHANGE QTYDUE= PO320 01250C* TR# 42 PO320 01260C N12 IQTYIN SUB QTYIN TRQTY2 70 4343 CHANGE QTYREC= PO320 0001270C* TR# 43 PO320 01280C N71 PO320 01290CORN42 GOTO END PO320 01300C MOVELPO K7 70 PO320 01310C MOVE '00' K7 PO320 01320C MOVELK7 POKEY PO320 01330C EXSR CHAIN PO320 0001340C N73 GOTO REST PO320 01350C QTYIN ADD TRQTY1 QTYIN PO320 01360C SETON 80 PO320 01370C 80 EXCPT PO320 01380C SETOF 80 PO320 01390C REST TAG PO320 01400C MOVELPO POKEY PO320 0001410C MOVE N18 POKEY PO320 01420C EXSR CHAIN PO320 01430C GOTO END PO320 01440C* PO320 01450C T35 TAG DELETE PO320 01460C* PO320 01470C MOVELPO POKEY PO320 0001480C MOVE N18 POKEY PO320 01490C EXSR CHAIN PO320 01500C N71N72N73 SETON H2 PO320 01510C H2 GOTO END PO320 01520C N73 QTYDUE SUB QTYIN TRQTY1 4545 DELETE QTYDUE= PO320 01530C END TAG TR# 45 PO320 01540CSR CHAIN BEGSR PO320 0001550CSR SETOF 717273 PO320 01560CSR POKEY CHAINPURCH H1 PO320 01570CSR H1 GOTO ENDCH PO320 01580CSR POC COMP 'R' 71 PO320 01590CSR POC COMP ' ' 72 PO320 01600CSR POC COMP 'B' 73 PO320 01610CSR ENDCH ENDSR PO320 0001620OPURCH D 02 31 PO320 01630O QTYIN 58 PO320 01640O D 02 34 PO320 01650O N10 IVEN 38 PO320 01660O N11 IQTYDU 51 PO320 01670O N12 IQTYIN 58 PO320 01680O N13 ICOST 65 PO320 0001690O D 02 35 PO320 01700O 66 'D' PO320 01710O E 80 PO320 01720O QTYIN 58 PO320 01730O DADD 02 31 PO320 01740O OR 02 32 PO320 01750O OR 02 33 PO320 0001760O PO 7 PO320 01770O PART 27 PO320 01780O IDUE 33 PO320 01790O 20 HVEN 38 PO320 01800O N20 IVEN 38 PO320 01810O 20 HPODAT 44 PO320 01820O N20 UDATE 44 PO320 0001830O IQTYDU 51 PO320 01840O N13 ICOST 65 PO320 01850O 31 66 'R' PO320 01860O 32 66 ' ' PO320 01870O 33 66 'B' PO320 01880OTRANSAC DADD 02 40 PO320 01890O OR 02 42 PO320 0001900O OR 02 45 PO320 01910O PART 61 PO320 01920O 40 14 '40' PO320 01930O 42 14 '42' PO320 01940O 45 14 '45' PO320 01950O TRQTY1 21 PO320 01960O PO 28 PO320 0001970O 20 HPODAT 34 PO320 01980O N20 UDATE 34 PO320 01990O DADD 02 43 PO320 02000O PART 61 PO320 02010O 14 '43' PO320 02020O TRQTY2 21 PO320 02030O PO 28 PO320 0002040O UDATE 34 PO320 02050O N13 ICOST 41 PO320 ** 002060ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002070ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002080ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002090ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00210000/* 002110_ 00 00 00 00 00 __ 0(d l d*TXBM102 P999999041178(000010H S BM102 00020X DECK-ID M10 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM102 00030F* FOR EVERY FINISHED GOOD IN BOMMST, CREATE A RECORD IN BOMLST BM102 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM102 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM102 00060F* CONTROL DATA PROPRIETARY PRODUCT BM102 00070F* BM102 0000080FBOMMST IPEAF 47 20AI 28 DISK BM102 00090FBOMCST O F 57 DISK BM102 00100F********************************************************************BM102 00110F* BM102 00120F* PACKAGE MANUFACTURING BM102 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM102 00140F* PROGRAM CREATE BOMCST FROM BOMMST BM102 0000150F* BM102 00160F* CONTRACTOR COMPUSOURCE BM102 00170F* PROGRAMMER TOM LEE BM102 00180F* DATE AUGUST 1, 1976 BM102 00190F********************************************************************BM102 00200F* BM102 00210F* NARRATIVE: BM102 0000220F* BM102 00230F* FIRST IN A SERIES OF PROGRAMS UPDATING ALL COSTS. BM102 00240F* BM102 00250F* THIS PROGRAM CREATES A PSEUDO-BOMINP. IN BOMMST, A FINISHED BM102 00260F* GOOD HAS A 0 WHERE-USED REL REC #. FOR EVERY FINISHED GOOD, BM102 00270F* A RECORD IS OUTPUT TO BOMCST. BM102 00280F* BM102 0000290F********************************************************************BM102 00300F* ID F C H L FUNCTION OF INDICATORS BM102 00310F* BM102 00320F* 01 BOMMST RECORD BM102 00330F* BM102 00340F* 10 WHERE-USED_REL_REC_#/BOMMST = 0 ---> FINISHED GOOD BM102 00350F* BM102 0000360F********************************************************************BM102 00370IBOMMST NS 01 28NCZ 30NCZ 31NCZ BM102 00380I 28 47 PN BM102 00390I 18 220WURRN 10 BM102 00395I NS 02 00400OBOMCST D 01 10 BM102 00410O 2 'PS' BM102 0000420O PN 23 BM102 00430O 51 '5' BM102 ** 000440ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000450ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000460ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000470ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00048000/* 000490_ 00 00 00 00 00 00 00 __ 0(N iTXPO340 PD999999032778(000010H S PO340 00020X DECK-ID M72 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO340 00030F* THIS PROGRAM WRITES PURCHASE ORDERS PO340 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FPURUPD IPEAF 83 DISK MFG34000090FVENDOR IC F 256R 5AI 1 DISK MFG34000100FPARTMST IC F 300R20AI 271 DISK MFG34000110F$LP1 O F 102 OF LPRINTER MFG34000120FCON D F 30 CONSOLE 00130E MSG 1 1 30 00140E SCOM 4 30 SAVE K COMMENTS MFG3400000150L$LP1 51FL 51OL MFG34000160IPURUPD XX 01 8 CH 29NCX MFG34000170I 1 70PO L1 MFG34000180I 9 9 ACTION MFG34000190I 22 270HDUE 11 MFG34000200I 22 230HYY MFG34000210I 24 270HMMDD MFG3400000220I 34 380VEN MFG34000230I 39 440PODAT 10 MFG34000240I XX 02 8 CK 29NCX MFG34000250I 1 70PO L1 MFG34000260I 34 63 COM 15 MFG34000270I XX 03 8 CL 9 CA 29NCX MFG34000280I OR 8 CL 9 CB 29NCX MFG3400000290I OR 8 CL 9 CE 29NCX MFG34000300I 1 70PO L1 MFG34000310I 64 83 PART MFG34000320I 22 270LDUE 18 MFG34000330I 22 230LYY MFG34000340I 24 270LMMDD MFG34000350I 39 450QTYDUE MFG3400000360I 53 593OVCOST 16 MFG34000370I XX 04 MFG34000380I 1 1 DUMMY MFG34000390IVENDOR XX 05 MFG34000400I 6 30 NAME MFG34000410I 31 55 AD1 17 MFG34000420I 56 80 AD2 MFG3400000430I 81 103 AD3 MFG34000440IPARTMST XX 06 MFG34000450I 1 37 DESCR MFG34000460I 62 73 VPART MFG34000470I 75 813STDMAT MFG34000480I 38 39 UM MFG34000490C N99 EXSR FORM 0000500C L1 SETOF 202122 MFG34000510C L1 SETOF 2325 MFG34000520C L1 SETOF 414243 MFG34000530C L1 SETOF 445090 MFG34000540C L1 MOVE BLANKS SCOM MFG34000550C L1 Z-ADD0 K 10 MFG34000560C L1 Z-ADD0 LINES 20 MFG3400000570C L1 Z-ADD2 PAGE MFG34000580C 01 EXSR SUB1 MFG34000590C 02 EXSR SUB2 MFG34000600C 03 20 EXSR SUB3 MFG34000610CL1N20 GOTO L1END MFG34000620CL1 SCOM,1 COMP BLANKS 4141 MFG34000630CL1 SCOM,2 COMP BLANKS 4242 MFG3400000640CL1 SCOM,3 COMP BLANKS 4343 MFG34000650CL1 SCOM,4 COMP BLANKS 4444 MFG34000660CL1 LINES COMP 11 90 50NEW PAGE FOR MFG34000670CL1 43 50 SETON 90 COMMENTS? MFG34000680CL1 L1END TAG MFG34000690CLR MOVE ' ' BLANKS 30 MFG34000700CSR SUB1 BEGSR MFG3400000710CSR SETON 20 MFG34000720CSR ACTION COMP 'E' 21RELEASE MFG34000730CSR ACTION COMP 'A' 22ADD MFG34000740CSR ACTION COMP 'B' 23BLANKET MFG34000750CSR VEN CHAINVENDOR H1 MFG310 BUG MFG34000760CSR H1 GOTO END1 MFG34000770CSR 17 SETON 25 MFG3400000780CSR END1 ENDSR MFG34000790C** MFG34000800C** MFG34000810CSR SUB2 BEGSR MFG34000820CSR 15 GOTO END2 MFG34000830CSR K ADD 1 K MFG34000840CSR K COMP 4 30 MFG3400000850CSR 30 GOTO END2 MFG34000860CSR MOVE COM SCOM,K MFG34000870CSR END2 ENDSR MFG34000880C** MFG34000890C** MFG34000900CSR SUB3 BEGSR MFG34000910CSR PART CHAINPARTMST H2 MFG310 BUG MFG3400000920CSR H2 GOTO END3 MFG34000930CSRN16 Z-ADDOVCOST COST 73 MFG34000940CSR 16 Z-ADDSTDMAT COST MFG34000950CSR LINES COMP 12 90 MFG34000960CSR 90 Z-ADD0 LINES MFG34000970CSR LINES ADD 1 LINES MFG34000980CSR END3 ENDSR MFG3400000990C** MFG34001000C** MFG34001010C* 01020C* 01030CSR FORM BEGSR 01040CSR SETON 9997 01050CSR FLOOP TAG 0001060CSR EXCPT 01070CSR MSG,1 DSPLYCON ANS 1 01080CSR ANS COMP 'Y' 98 01090CSR 98 GOTO FOUT 01100CSR GOTO FLOOP 01110CSR FOUT TAG 01120CSR SETOF 97 0001130CSR ENDSR 01140O$LP1 D 01 03 20 90 MFG34001150O PAGE Z 81 MFG34001160O 77 '** CONTINUED - PAGE' MFG34001170O 84 '**' MFG34001180O D 02 L1 20 MFG34001190O OR 90 MFG3400001200O 23 56 'THIS IS A BLANKET' MFG34001210O PO 84 ' - ' MFG34001220O D 10 L1 20 MFG34001230O OR 90 MFG34001240O NAME 36 MFG34001250O D 2 L1 20 MFG34001260O OR 90 MFG3400001270O 1 ' ' MFG34001280O N25 AD1 36 MFG34001290O 25 AD2 36 MFG34001300O D 1 L1 20 MFG34001310O OR 90 MFG34001320O 1 ' ' MFG34001330O N25 AD2 36 MFG3400001340O D 1 L1 20 MFG34001350O OR 90 MFG34001360O AD3 34 MFG34001370O D 32 L1 20 MFG34001380O OR 90 MFG34001390O N10 PODAT Y 9 MFG34001400O 10 UDATE Y 9 MFG3400001410O N11 HMMDD 81 ' / ' MFG34001420O N11 82 '/' MFG34001430O N11 HYY 84 MFG34001440O D 11 03 20 MFG34001450O QTYDUEL 10 MFG34001460O PART 30 MFG34001470O DESCR 68 MFG3400001480O VPART 81 MFG34001490O COST L 91 MFG34001500O UM 93 MFG34001510O N18 LMMDD 99 ' / ' MFG33001520O N18 100 '/' MFG33001530O N18 LYY 102 MFG33001540O T 01 L1 20 90 MFG3400001550O PAGE Z 81 MFG34001560O 77 '** CONTINUED - PAGE' MFG34001570O 84 '**' MFG34001580O T 0219 L1 20 90 MFG34001590O 23 56 'THIS IS A BLANKET' MFG34001600O PO 84 ' - ' MFG34001610O T 1 L1 20 41 MFG3400001620O 23 'NOTES -' MFG34001630O SCOM,1 54 MFG34001640O T 1 L1 20 42 MFG34001650O SCOM,2 54 MFG34001660O T 1 L1 20 43 MFG34001670O SCOM,3 54 MFG34001680O T 1 L1 20 44 MFG3400001690O SCOM,4 54 MFG34001700O E 2001 97 01710O 10 'XXXXXXX-' MFG34001720O 23 'XXXXXXXXXXXX' MFG34001730O 44 'XXXXXXXXXXXXXXXXXXXX' MFG34001740O 49 'XXXXX' MFG34001750O 62 'XXXXXXXXXXXX' MFG3400001760O 72 'XXXX.XXX-' MFG34001770O 75 'XX' MFG34001780O 84 'XX/XX/XX' MFG340** 01790ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 01800ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 01810ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0182000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 01830** 01840IS FORM ALLIGNMENT OK Y/N 01850/* 01860_ 00 00 00 00 00 00 00 00 00 __ 0(dNo d*TXPO345 P0999999032778(000010H S PO345 00020X DECK-ID M73 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO345 00030F* THIS PROGRAM UPDATES PURCHASE HISTORY FILE PO345 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FSPOREC IPEAF 77 DISK MFG34500090FPOHIST ISEAF 77 DISK MFG34500100FNEWHIS O F 77 DISK MFG34500110F********************************************************************MFG34500120F* MFG34500130F* COMPANY LOS ANGELES BRUSH MFG34500140F* SYSTEM PURCHASE/INVENTORY CONTROL MFG3450000150F* PROGRAM PUTS 10 MOST RECENT PURCHASES ON A PART # INTO POHIST MFG34500160F* MFG34500170F* MFG34500180F* CONTRACTOR COMPUSOURCE MFG34500190F* PROGRAMMER STEVE LEVANDOWSKI MFG34500200F* DATE NOVEMBER 13, 1975 MFG34500210F* MFG3450000220F********************************************************************MFG34500230F* MFG34500240F* ID F C H L FUNCTION OF INDICATORS MFG34500250F* MFG34500260F* 01 SPOREC MFG34500270F* 02 POHIST MFG34500280F* 10 POHIST WITH NMR MFG3450000290F* L1PART # MFG34500300F* M1 PART # MFG34500310F* MFG34500320F********************************************************************MFG34500330ISPOREC NS 01 MFG34500340I 58 77 PN L1M1 MFG34500350I 1 77 REC MFG3450000360IPOHIST NS 02 MFG34500370I 58 77 PN L1M1 MFG34500380I 1 77 REC MFG34500390C SETOF 10 MFG34500400C 02NMR SETON 10 MFG34500410C 02NMR GOTO END MFG34500420C L1 01 Z-ADD0 CNT 20 MFG3450000430C* MFG34500440C 01 MFG34500450COR 02 CNT ADD 1 CNT MFG34500460C CNT COMP 10 1010 MFG34500470C* MFG34500480C END TAG MFG34500490ONEWHIS D 10 MFG3450000500O REC 77 MFG345** 00510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00520ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00530ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00550/* 0056000_ 00 00 00 00 00 00 __ 0(N TXPO360 P  999999032778(000010H S PO360 00020X DECK-ID M75 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO360 00030F* THIS PROGRAM WRITES OPEN PURCHASE ORDER REPORT BY P.O. NUMBER PO360 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO360 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO360 00060F* CONTROL DATA PROPRIETARY PRODUCT PO360 00070F* PO360 0000080FPURCHT IPEAF 66 DISK PO360 00090FPARTMST IC F 300R20AI 271 DISK PO360 00100FVENDOR IC F 256R 5AI 1 DISK PO360 00110F$LP1 O F 132 OF PRINTER PO360 00120FHEADING IT F 40 EDISK PO360 00130F********************************************************************PO360 00140F* PO360 0000150F* COMPANY COMPUSOURCE MANUFACTURING SYSTEM PACKAGE PO360 00160F* SYSTEM PURCHASE/INVENTORY CONTROL PO360 00170F* PROGRAM PRINTS OUT: PO360 00180F* 1. PURCH FILE BY P.O. # AND PART # PO360 00190F* 2. CASH REQUIREMENTS FOR NEXT 3 MONTHS PO360 00200F* PO360 00210F* PO360 0000220F* CONTRACTOR COMPUSOURCE PO360 00230F* PROGRAMMER KATH HILL PO360 00240F* DATE NOVEMBER 13, 1975 PO360 00250F* PO360 00260F********************************************************************PO360 00270F* PO360 00280F* ID F C H L FUNCTION OF INDICATORS PO360 0000290F* PO360 00300F* 01 PURCHT PO360 00310F* 02 PARTMST PO360 00320F* 03 VENDOR PO360 00330F* PO360 00340F* 11 COST/UM OVERRIDE (PURCH) BLANK PO360 00350F* 12 DELETE CODE (PARTMST) BLANK PO360 0000360F* 13 DELETE CODE (VENDOR) BLANK PO360 00370F* PO360 00380F* 20 CHAIN TO PARTMST --- 'MISS' PO360 00390F* 30 CHAIN TO VENDOR --- 'MISS' PO360 00400F* 40 LOOK-UP MONTHS IN TABA --- # OF DAYS IN MONTH (TABB)PO360 00410F* 41 I LOOP-WATCHER PO360 00420F* 42 CHECK DAYS AGAINST # OF DAYS IN THIS MONTH PO360 0000430F* 43 COMPARE THIS MONTH TO DECEMBER PO360 00440F* 50 DATE <= IPL DATE (* IN COL 132) PO360 00450F* BUCKET THE $ PO360 00460F* 60 DATE > 6 MONTHS FROM IPL DATE PO360 00470F* BUCKET THE $ PO360 00480F* 75 BLANKET --> NOT INTO SUMMARY FIGURES. PO360 00490F* 55 BUCKET THE $ PO360 0000500F* 99 ONLY FIGURE OUT DATE DIVISIONS OF BUCKETS ONCE PO360 00510F* PO360 00520F* L3POKEY /PURCHT PO360 00530F* L2PART#/PURCHT PO360 00540F* L1VENDOR #/PURCHT PO360 00550F* LRPRINT OUT CASH REQUIREMENTS FORECAST FOR NEXT PO360 00560F* SIX MONTHS PO360 0000570F* PO360 00580F********************************************************************PO360 00590E HEADING HEAD 1 1 40 PO360 00600E TABA 1 12 2 0 TABB 2 0 MTHS/# OF DAYS PO360 00610E DAT 25 6 0 BUCKETS PO360 00620E REQ 26 9 2 $ IN BUCKETS PO360 00630IPURCHT NS 01 PO360 0000640I 1 50PO PO360 00650I 6 70LOT PO360 00660I 1 70POKEY L3 PO360 00670I 8 27 PART L2 PO360 00680I 28 290DUEY PO360 00690I 30 330DUEMD PO360 00700I 28 330DUEDAT PO360 0000710I 34 380VEND L1 PO360 00720I 39 440PODATE PO360 00730I 45 510QTYORD PO360 00740I 52 580QTYREC PO360 00750I 59 653CUMOV 11 PO360 00760I 66 66 POCODE PO360 00770IPARTMST NS 02 PO360 0000780I 1 37 DESCR PO360 00790I 75 813STDCST PO360 00800I 74 74 DLTPR 12 PO360 00810IVENDOR NS 03 PO360 00820I 1 50VENDNO PO360 00830I 6 30 VNAME PO360 00840I 106 106 DLTV 13 PO360 0000850C L3 POCODE COMP 'B' 75BLANKET PO360 00860C N99 EXSR LDDAT PO360 00870C N99 SETON 99 PO360 00880C* PO360 00890C L1 VEND CHAINVENDOR 30 PO360 00900C L1N30N13 SETON 30 PO360 00910C* PO360 0000920C L2 PART CHAINPARTMST 20 PO360 00930C L2N20N12 SETON 20 PO360 00940C* PO360 00950C N11 Z-ADDCUMOV COST 73 PO360 00960C 11 20 Z-ADD0 COST PO360 00970C 11N20 Z-ADDSTDCST COST PO360 00980C* PO360 0000990C QTYORD SUB QTYREC BALDUE 70 PO360 01000C BALDUE MULT COST EXTCST 92H PO360 01010C L3 Z-ADD0 TOTDUE 102 PO360 01020C 01 EXTCST ADD TOTDUE TOTDUE H PO360 01030C* PO360 01040C 75 GOTO ENDLP2 PO360 01050C MOVELDUEY DATE 60 PO360 0001060C MOVE DUEMD DATE PO360 01070C* PO360 01080C MOVELDUEMD OUTDAT 60 PO360 01090C MOVE DUEY OUTDAT PO360 01100C* PO360 01110C DATE COMP DAT,1 5050 PO360 01120C* PO360 0001130C DATE COMP DAT,25 60 PO360 01140C* PO360 01150C 60 REQ,26 ADD EXTCST REQ,26 PO360 01160C 60 GOTO ENDLP2 PO360 01170C* PO360 01180C Z-ADD0 I PO360 01190C LOOP2 TAG PO360 0001200C I ADD 1 I PO360 01210C DATE COMP DAT,I 5555 PO360 01220C 55 REQ,I ADD EXTCST REQ,I PO360 01230C 55 GOTO ENDLP2 PO360 01240C GOTO LOOP2 PO360 01250C ENDLP2 TAG PO360 01260C* PO360 0001270CLR XFOOTREQ TOTREQ 92 PO360 01280C* PO360 01290CLR Z-ADD0 I PO360 01300CLR LOOP3 TAG PO360 01310CLR I ADD 1 I PO360 01320CLR I COMP 26 41 PO360 01330CLR 41 GOTO ENDLP3 PO360 0001340CLR MOVELDAT,I YY PO360 01350CLR MOVE DAT,I MMDD PO360 01360CLR MOVELMMDD DAT,I PO360 01370CLR MOVE YY DAT,I PO360 01380CLR GOTO LOOP3 PO360 01390CLR ENDLP3 TAG PO360 01400C********************************************************************PO360 0001410C* PO360 01420C* THIS SUBROUTINE TAKES THE IPL DATE AND, USING IT, FORMS AN PO360 01430C* ARRAY OF DATES. THE DATE ARRAY IS USED TO FORECAST CASH [YYMMDD] PO360 01440C* REQUIRMENTS FOR THE NEXT 3 MONTHS ON A WEEK-BY-WEEK BASIS. PO360 01450C* PO360 01460C********************************************************************PO360 01470CSR LDDAT BEGSR PO360 0001480CSR MOVELUDATE MMDD 40 PO360 01490CSR MOVE UDATE YY 20 PO360 01500CSR MOVELMMDD MM 20 PO360 01510CSR MOVE MMDD DD 20 PO360 01520C* PO360 01530CSR MM LOKUPTABA TABB 40 PO360 01540CSR Z-ADD1 I 20 PO360 0001550CSR MOVELYY DAT,I PO360 01560CSR MOVE MMDD DAT,I PO360 01570C* PO360 01580CSR LOOP1 TAG PO360 01590CSR MM LOKUPTABA TABB 40 PO360 01600CSR I ADD 1 I PO360 01610CSR I COMP 26 41 PO360 0001620CSR 41 GOTO ENDLP1 PO360 01630CSR DD ADD 7 DD7 20 PO360 01640CSR DD7 COMP TABB 42 PO360 01650CSR 42 DD7 SUB TABB DD7 PO360 01660CSR 42 MM COMP 12 43 PO360 01670CSR 42 43 Z-ADD1 MM PO360 01680CSR 42 43 YY ADD 1 YY PO360 0001690CSR 42N43 MM ADD 1 MM PO360 01700CSR Z-ADDDD7 DD PO360 01710C* PO360 01720CSR MOVELMM MMDD PO360 01730CSR MOVE DD MMDD PO360 01740CSR MOVELYY DAT,I PO360 01750CSR MOVE MMDD DAT,I PO360 0001760CSR GOTO LOOP1 PO360 01770CSR ENDLP1 TAG PO360 01780CSR ENDSR PO360 01790C********************************************************************PO360 01800O$LP1 H 202 1P PO360 01810O OR LRNOF PO360 01820O OR OFNLR PO360 0001830O PAGE Z 8 PO360 01840O 4 'PAGE' PO360 01850O HEAD 86 PO360 01860O UDATE Y 132 PO360 01870O H 2 1P PO360 01880O OR LRNOF PO360 01890O OR OFNLR PO360 0001900O 68 'OPEN PURCHASE ORDERS' PO360 01910O 78 'BY P.O. #' PO360 01920O 132 'MFG360' PO360 01921O H 1 1P 01922O OR OFNLR 01923O 8 'PO/LOT #' 01924O 21 'PART NUMBER' 0001930O H 2 1P PO360 01940O OR OFNLR PO360 01970O 22 'DESCRIPTION' PO360 01980O 57 'VEND #' PO360 01990O 71 'TYPE' PO360 02000O 82 'ORDERED' PO360 02010O 94 'RECEIVED' PO360 0002020O 106 'BAL DUE' PO360 02030O 118 'COST/UM' PO360 02040O 130 'DUE DATE' PO360 02041O D 1 01 02042O L3 PO 5 02043O L3 6 '-' 02044O L3 LOT 8 0002045O PART 30 02050O D 1 01 PO360 02100O N20 DESCR 48 PO360 02110O VEND 57 PO360 02120O 30 67 '*INVALID*' PO360 02130O 20 32 '*** INVALID PART # ***' PO360 02140O POCODE 69 PO360 0002150O QTYORDJ 83 PO360 02160O QTYRECJ 95 PO360 02170O BALDUEJ 107 PO360 02180O COST J 119 PO360 02190O OUTDATY 130 PO360 02200O 50 132 '*' PO360 02210O T 12 L3 PO360 0002220O 25 '** TOTAL DOLLAR VALUE' PO360 02230O 35 'FOR P.O.#' PO360 02240O PO 41 PO360 02250O 42 '-' PO360 02260O LOT 44 PO360 02270O 49 'IS $' PO360 02280O TOTDUEJ 63 PO360 0002290O T 3 LR PO360 02300O 11 'END OF JOB.' PO360 02310O 36 'TOTAL STOCK-ON-ORDER IS' PO360 02320O 40 ' $' PO360 02330O TOTREQJ 53 PO360 02340O T 202 LR PO360 02350O HEAD,1 86 PO360 0002360O UDATE Y 132 PO360 02370O T 22 LR PO360 02380O 68 'CASH REQUIREMENT ' PO360 02390O 75 'SUMMARY' PO360 02400O T 3 LR PO360 02410O 17 'VALUE OF PURCHASE' PO360 02420O 34 'ORDERS BY PERIOD' PO360 0002430O 70 'PERIOD DATE' PO360 02440O 89 'PURCHASE VALUE' PO360 02450O T 1 LR PO360 02460O 70 'PAST DUE' PO360 02470O REQ,1 J 90 PO360 02480O T 1 LR PO360 02490O DAT,2 Y 70 PO360 0002500O REQ,2 J 90 PO360 02510O T 1 LR PO360 02520O DAT,3 Y 70 PO360 02530O REQ,3 J 90 PO360 02540O T 1 LR PO360 02550O DAT,4 Y 70 PO360 02560O REQ,4 J 90 PO360 0002570O T 1 LR PO360 02580O DAT,5 Y 70 PO360 02590O REQ,5 J 90 PO360 02600O T 1 LR PO360 02610O DAT,6 Y 70 PO360 02620O REQ,6 J 90 PO360 02630O T 1 LR PO360 0002640O DAT,7 Y 70 PO360 02650O REQ,7 J 90 PO360 02660O T 1 LR PO360 02670O DAT,8 Y 70 PO360 02680O REQ,8 J 90 PO360 02690O T 1 LR PO360 02700O DAT,9 Y 70 PO360 0002710O REQ,9 J 90 PO360 02720O T 1 LR PO360 02730O DAT,10Y 70 PO360 02740O REQ,10J 90 PO360 02750O T 1 LR PO360 02760O DAT,11Y 70 PO360 02770O REQ,11J 90 PO360 0002780O T 1 LR PO360 02790O DAT,12Y 70 PO360 02800O REQ,12J 90 PO360 02810O T 1 LR PO360 02820O DAT,13Y 70 PO360 02830O REQ,13J 90 PO360 02840O T 1 LR PO360 0002850O DAT,14Y 70 PO360 02860O REQ,14J 90 PO360 02870O T 1 LR PO360 02880O DAT,15Y 70 PO360 02890O REQ,15J 90 PO360 02900O T 1 LR PO360 02910O DAT,16Y 70 PO360 0002920O REQ,16J 90 PO360 02930O T 1 LR PO360 02940O DAT,17Y 70 PO360 02950O REQ,17J 90 PO360 02960O T 1 LR PO360 02970O DAT,18Y 70 PO360 02980O REQ,18J 90 PO360 0002990O T 1 LR PO360 03000O DAT,19Y 70 PO360 03010O REQ,19J 90 PO360 03020O T 1 LR PO360 03030O DAT,20Y 70 PO360 03040O REQ,20J 90 PO360 03050O T 1 LR PO360 0003060O DAT,21Y 70 PO360 03070O REQ,21J 90 PO360 03080O T 1 LR PO360 03090O DAT,22Y 70 PO360 03100O REQ,22J 90 PO360 03110O T 1 LR PO360 03120O DAT,23Y 70 PO360 0003130O REQ,23J 90 PO360 03140O T 1 LR PO360 03150O DAT,24Y 70 PO360 03160O REQ,24J 90 PO360 03170O T 1 LR PO360 03180O DAT,25Y 70 PO360 03190O REQ,25J 90 PO360 0003200O T 1 LR PO360 03210O 70 'OVER 24' PO360 03220O REQ,26J 90 PO360 03230O T 1 LR PO360 03240O 90 '---------------' PO360 03250O T 1 LR PO360 03260O 90 '$ ' PO360 0003270O TOTREQJ 90 PO360 ** 003280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003320** 003330000131 0033400229 0033500331 0033600430 0033700531 0033800630 0033900731 003400000831 0034100930 0034201031 0034301130 0034401231 003450/* 003460_ 00 00 00 00 00 00 00 00 __ 0(OB TXPO370 P  f999999032778(000010H S PO370 00020X DECK-ID M77 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO370 00030F* THIS PROGRAM WRITES OPEN PURCHASE ORDER REPORT BY PART NUMBER PO370 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO370 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO370 00060F* CONTROL DATA PROPRIETARY PRODUCT PO370 00070F* PO370 0000080FPURCHT IPEAF 66 DISK PO370 00090FPARTMST IC F 300R20AI 271 DISK PO370 00100FVENDOR IC F 256R 5AI 1 DISK PO370 00110F$LP1 O F 132 OF PRINTER PO370 00120FHEADING IT F 40 EDISK PO370 00130F********************************************************************PO370 00140F* PO370 0000150F* COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE PO370 00160F* SYSTEM PURCHASE/INVENTORY CONTROL PO370 00170F* PROGRAM PRINTS OUT: PO370 00180F* 1. PURCH FILE BY PART#/DUE DATE (YYMMDD) PO370 00190F* 2. CASH REQUIREMENTS FOR NEXT SIX MONTHS PO370 00200F* PO370 00210F* PO370 0000220F* CONTRACTOR COMPUSOURCE PO370 00230F* PROGRAMMER KATH HILL PO370 00240F* DATE NOVEMBER 13, 1975 PO370 00250F* PO370 00260F********************************************************************PO370 00270F* PO370 00280F* ID F C H L FUNCTION OF INDICATORS PO370 0000290F* PO370 00300F* 01 PURCHT PO370 00310F* 02 PARTMST PO370 00320F* 03 VENDOR PO370 00330F* PO370 00340F* 11 COST/UM OVERRIDE (PURCH) BLANK PO370 00350F* 12 DELETE CODE (PARTMST) BLANK PO370 0000360F* 13 DELETE CODE (VENDOR) BLANK PO370 00370F* PO370 00380F* 20 CHAIN TO PARTMST --- 'MISS' PO370 00390F* 30 CHAIN TO VENDOR --- 'MISS' PO370 00400F* 40 LOOK-UP MONTHS IN TABA --- # OF DAYS IN MONTH (TABB)PO370 00410F* 41 I LOOP-WATCHER PO370 00420F* 42 CHECK DAYS AGAINST # OF DAYS IN THIS MONTH PO370 0000430F* 43 COMPARE THIS MONTH TO DECEMBER PO370 00440F* 50 DATE <= IPL DATE (* IN COL 132) PO370 00450F* BUCKET THE $ PO370 00460F* 60 DATE > 6 MONTHS FROM IPL DATE PO370 00470F* BUCKET THE $ PO370 00480F* 55 BUCKET THE $ PO370 00490F* 75 BLANKET --> NOT INTO BAL DUE OR SUMMARY FIGURES. PO370 0000500F* 99 ONLY FIGURE OUT DATE DIVISIONS OF BUCKETS ONCE PO370 00510F* PO370 00520F* L3PART #/PURCHT PO370 00530F* L2DUE DATE/PURCHT PO370 00540F* L1VENDOR #/PURCHT PO370 00550F* LRPRINT OUT CASH REQUIREMENTS FORECAST FOR NEXT PO370 00560F* 3 MONTHS PO370 0000570F* PO370 00580F********************************************************************PO370 00590E HEADING HEAD 1 1 40 PO370 00600E TABA 1 12 2 0 TABB 2 0 MTHS/# OF DAYS PO370 00610E DAT 25 6 0 BUCKETS PO370 00620E REQ 26 9 2 $ IN BUCKETS PO370 00630IPURCHT NS 01 PO370 0000640I 1 50PO PO370 00650I 6 70LOT PO370 00660I 1 70POKEY PO370 00670I 8 27 PART L3 PO370 00680I 28 290DUEY PO370 00690I 30 330DUEMD PO370 00700I 28 330DUEDATL2 PO370 0000710I 34 380VEND L1 PO370 00720I 39 440PODATE PO370 00730I 45 510QTYORD PO370 00740I 52 580QTYREC PO370 00750I 59 653CUMOV 11 PO370 00760I 66 66 POCODE PO370 00770IPARTMST NS 02 PO370 0000780I 1 37 DESCR PO370 00790I 75 813STDCST PO370 00800I 74 74 DLTPR 12 PO370 00810IVENDOR NS 03 PO370 00820I 1 50VENDNO PO370 00830I 6 30 VNAME PO370 00840I 106 106 DLTV 13 PO370 0000850C 01 POCODE COMP 'B' 75BLANKET PO370 00860C N99 EXSR LDDAT PO370 00870C N99 SETON 99 PO370 00880C* PO370 00890C L1 VEND CHAINVENDOR 30 PO370 00900C L1N30N13 SETON 30 PO370 00910C* PO370 0000920C L3 PART CHAINPARTMST 20 PO370 00930C L3N20N12 SETON 20 PO370 00940C* PO370 00950C N11 Z-ADDCUMOV COST 73 PO370 00960C 11 20 Z-ADD0 COST PO370 00970C 11N20 Z-ADDSTDCST COST PO370 00980C* PO370 0000990C 75 GOTO ENDLP2 PO370 01000C QTYORD SUB QTYREC BALDUE 70 PO370 01010C L3 Z-ADD0 TBALDU PO370 01020C BALDUE ADD TBALDU TBALDU 90 PO370 01030C BALDUE MULT COST EXTCST 92H PO370 01040C* PO370 01050C MOVELDUEY DATE 60 PO370 0001060C MOVE DUEMD DATE PO370 01070C* PO370 01080C MOVELDUEMD OUTDAT 60 PO370 01090C MOVE DUEY OUTDAT PO370 01100C* PO370 01110C DATE COMP DAT,1 5050 PO370 01120C* PO370 0001130C DATE COMP DAT,25 60 PO370 01140C* PO370 01150C 60 REQ,26 ADD EXTCST REQ,26 PO370 01160C 60 GOTO ENDLP2 PO370 01170C* PO370 01180C Z-ADD0 I PO370 01190C LOOP2 TAG PO370 0001200C I ADD 1 I PO370 01210C DATE COMP DAT,I 5555 PO370 01220C 55 REQ,I ADD EXTCST REQ,I PO370 01230C 55 GOTO ENDLP2 PO370 01240C GOTO LOOP2 PO370 01250C ENDLP2 TAG PO370 01260C* PO370 0001270CLR XFOOTREQ TOTREQ 92 PO370 01280C* PO370 01290CLR Z-ADD0 I PO370 01300CLR LOOP3 TAG PO370 01310CLR I ADD 1 I PO370 01320CLR I COMP 26 41 PO370 01330CLR 41 GOTO ENDLP3 PO370 0001340CLR MOVELDAT,I YY PO370 01350CLR MOVE DAT,I MMDD PO370 01360CLR MOVELMMDD DAT,I PO370 01370CLR MOVE YY DAT,I PO370 01380CLR GOTO LOOP3 PO370 01390CLR ENDLP3 TAG PO370 01400C********************************************************************PO370 0001410C* PO370 01420C* THIS SUBROUTINE TAKES THE IPL DATE AND, USING IT, FORMS AN PO370 01430C* ARRAY OF DATES. THE DATE ARRAY IS USED TO FORECAST CASH [YYMMDD] PO370 01440C* REQUIRMENTS FOR THE NEXT 3 MONTHS ON A WEEK-BY-WEEK BASIS. PO370 01450C* PO370 01460C********************************************************************PO370 01470CSR LDDAT BEGSR PO370 0001480CSR MOVELUDATE MMDD 40 PO370 01490CSR MOVE UDATE YY 20 PO370 01500CSR MOVELMMDD MM 20 PO370 01510CSR MOVE MMDD DD 20 PO370 01520C* PO370 01530CSR MM LOKUPTABA TABB 40 PO370 01540CSR Z-ADD1 I 20 PO370 0001550CSR MOVELYY DAT,I PO370 01560CSR MOVE MMDD DAT,I PO370 01570C* PO370 01580CSR LOOP1 TAG PO370 01590CSR MM LOKUPTABA TABB 40 PO370 01600CSR I ADD 1 I PO370 01610CSR I COMP 26 41 PO370 0001620CSR 41 GOTO ENDLP1 PO370 01630CSR DD ADD 7 DD7 20 PO370 01640CSR DD7 COMP TABB 42 PO370 01650CSR 42 DD7 SUB TABB DD7 PO370 01660CSR 42 MM COMP 12 43 PO370 01670CSR 42 43 Z-ADD1 MM PO370 01680CSR 42 43 YY ADD 1 YY PO370 0001690CSR 42N43 MM ADD 1 MM PO370 01700CSR Z-ADDDD7 DD PO370 01710C* PO370 01720CSR MOVELMM MMDD PO370 01730CSR MOVE DD MMDD PO370 01740CSR MOVELYY DAT,I PO370 01750CSR MOVE MMDD DAT,I PO370 0001760CSR GOTO LOOP1 PO370 01770CSR ENDLP1 TAG PO370 01780CSR ENDSR PO370 01790C********************************************************************PO370 01800O$LP1 H 202 1P PO370 01810O OR LRNOF PO370 01820O OR OFNLR PO370 0001830O PAGE Z 8 PO370 01840O 4 'PAGE' PO370 01850O HEAD 86 PO370 01860O UDATE Y 132 PO370 01870O H 2 1P PO370 01880O OR LRNOF PO370 01890O OR OFNLR PO370 0001900O 68 'OPEN PURCHASE ORDERS' PO370 01910O 78 'BY PART #' PO370 01920O 132 'MFG370' PO370 01921O H 1 1P 01922O OR OFNLR 01923O 11 'PART NUMBER' 01930O H 2 1P PO370 0001940O OR OFNLR PO370 01960O 12 'DESCRIPTION' PO370 01970O 50 'PO/LOT #' PO370 01980O 57 'VEND#' PO370 01990O 71 'TYPE' PO370 02000O 82 'ORDERED' PO370 02010O 94 'RECEIVED' PO370 0002020O 106 'BAL DUE' PO370 02030O 118 'COST/UM' PO370 02040O 130 'DUE DATE' PO370 02041O D 1 01 02042O L2 PART 38 02050O D 1 01 PO370 02070O L2N20 DESCR 38 PO370 0002080O 20 L2 36 '*** INVALID PART # ***' PO370 02090O PO 47 PO370 02100O 48 '-' PO370 02110O LOT 50 PO370 02120O VEND Z 57 PO370 02130O 30 67 '*INVALID*' PO370 02140O POCODE 69 PO370 0002150O QTYORDJ 83 PO370 02160O QTYRECJ 95 PO370 02170O N75 BALDUEJ 107 PO370 02180O COST J 119 PO370 02190O OUTDATY 130 PO370 02200O 50 132 '*' PO370 02210O T 1 L3 PO370 0002220O 107 '-----------' PO370 02230O T 2 L3 PO370 02240O TBALDUJB 107 PO370 02250O 94 'TOTAL' PO370 02260O T 3 LR PO370 02270O 11 'END OF JOB.' PO370 02280O 36 'TOTAL STOCK-ON-ORDER IS' PO370 0002290O 40 ' $' PO370 02300O TOTREQJ 53 PO370 02310O T 202 LR PO370 02320O HEAD 86 PO370 02330O UDATE Y 132 PO370 02340O T 304 LR PO370 02350O 68 'CASH REQUIREMENT ' PO370 0002360O 75 'SUMMARY' PO370 02370O T 3 LR PO370 02380O 17 'VALUE OF PURCHASE' PO370 02390O 34 'ORDERS BY PERIOD' PO370 02400O 70 'PERIOD DATE' PO370 02410O 89 'PURCHASE VALUE' PO370 02420O T 1 LR PO370 0002430O 70 'PAST DUE' PO370 02440O REQ,1 J 90 PO370 02450O T 1 LR PO370 02460O DAT,2 Y 70 PO370 02470O REQ,2 J 90 PO370 02480O T 1 LR PO370 02490O DAT,3 Y 70 PO370 0002500O REQ,3 J 90 PO370 02510O T 1 LR PO370 02520O DAT,4 Y 70 PO370 02530O REQ,4 J 90 PO370 02540O T 1 LR PO370 02550O DAT,5 Y 70 PO370 02560O REQ,5 J 90 PO370 0002570O T 1 LR PO370 02580O DAT,6 Y 70 PO370 02590O REQ,6 J 90 PO370 02600O T 1 LR PO370 02610O DAT,7 Y 70 PO370 02620O REQ,7 J 90 PO370 02630O T 1 LR PO370 0002640O DAT,8 Y 70 PO370 02650O REQ,8 J 90 PO370 02660O T 1 LR PO370 02670O DAT,9 Y 70 PO370 02680O REQ,9 J 90 PO370 02690O T 1 LR PO370 02700O DAT,10Y 70 PO370 0002710O REQ,10J 90 PO370 02720O T 1 LR PO370 02730O DAT,11Y 70 PO370 02740O REQ,11J 90 PO370 02750O T 1 LR PO370 02760O DAT,12Y 70 PO370 02770O REQ,12J 90 PO370 0002780O T 1 LR PO370 02790O DAT,13Y 70 PO370 02800O REQ,13J 90 PO370 02810O T 1 LR PO370 02820O DAT,14Y 70 PO370 02830O REQ,14J 90 PO370 02840O T 1 LR PO370 0002850O DAT,15Y 70 PO370 02860O REQ,15J 90 PO370 02870O T 1 LR PO370 02880O DAT,16Y 70 PO370 02890O REQ,16J 90 PO370 02900O T 1 LR PO370 02910O DAT,17Y 70 PO370 0002920O REQ,17J 90 PO370 02930O T 1 LR PO370 02940O DAT,18Y 70 PO370 02950O REQ,18J 90 PO370 02960O T 1 LR PO370 02970O DAT,19Y 70 PO370 02980O REQ,19J 90 PO370 0002990O T 1 LR PO370 03000O DAT,20Y 70 PO370 03010O REQ,20J 90 PO370 03020O T 1 LR PO370 03030O DAT,21Y 70 PO370 03040O REQ,21J 90 PO370 03050O T 1 LR PO370 0003060O DAT,22Y 70 PO370 03070O REQ,22J 90 PO370 03080O T 1 LR PO370 03090O DAT,23Y 70 PO370 03100O REQ,23J 90 PO370 03110O T 1 LR PO370 03120O DAT,24Y 70 PO370 0003130O REQ,24J 90 PO370 03140O T 1 LR PO370 03150O DAT,25Y 70 PO370 03160O REQ,25J 90 PO370 03170O T 1 LR PO370 03180O 70 'OVER 24' PO370 03190O REQ,26J 90 PO370 0003200O T 1 LR PO370 03210O 90 '---------------' PO370 03220O T 1 LR PO370 03230O 90 '$ ' PO370 03240O TOTREQJ 90 PO370 ** 003250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00326000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003290** 0033000131 0033100229 0033200331 003330000430 0033400531 0033500630 0033600731 0033700831 0033800930 0033901031 003400001130 0034101231 003420/* 003430_ 00 00 00 00 00 00 00 00 __ 0(P) TXPO365 P  >999999032778(000010H S PO365 00020X DECK-ID M76 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO365 00030F* THIS PROGRAM WRITES OPEN PURCHASE ORDER REPORT BY VENDOR NUMBER PO365 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO365 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO365 00060F* CONTROL DATA PROPRIETARY PRODUCT PO365 00070F* PO365 0000080FPURCHT IPEAF 66 DISK PO365 00090FPARTMST IC F 300R20AI 271 DISK PO365 00100FVENDOR IC F 256R 5AI 1 DISK PO365 00110F$LP1 O F 132 OF PRINTER PO365 00120FHEADING IT F 40 EDISK PO365 00130F********************************************************************PO365 00140F* PO365 0000150F* COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE PO365 00160F* SYSTEM PURCHASE/INVENTORY CONTROL PO365 00170F* PROGRAM PRINTS OUT: PO365 00180F* 1. PURCH FILE BY VEND #, PART #, AND PO365 00190F* DUE DATE (YYMMDD) PO365 00200F* 2. CASH REQUIREMENTS FOR NEXT SIX MONTHS PO365 00210F* PO365 0000220F* PO365 00230F* CONTRACTOR COMPUSOURCE PO365 00240F* PROGRAMMER KATH HILL PO365 00250F* DATE NOVEMBER 13, 1975 PO365 00260F* PO365 00270F********************************************************************PO365 00280F* PO365 0000290F* ID F C H L FUNCTION OF INDICATORS PO365 00300F* PO365 00310F* 01 PURCHT PO365 00320F* 02 PARTMST PO365 00330F* 03 VENDOR PO365 00340F* PO365 00350F* 11 COST/UM OVERRIDE (PURCH) BLANK PO365 0000360F* 12 DELETE CODE (PARTMST) BLANK PO365 00370F* 13 DELETE CODE (VENDOR) BLANK PO365 00380F* PO365 00390F* 20 CHAIN TO PARTMST --- 'MISS' PO365 00400F* 30 CHAIN TO VENDOR --- 'MISS' PO365 00410F* 40 LOOK-UP MONTHS IN TABA --- # OF DAYS IN MONTH (TABB)PO365 00420F* 41 I LOOP-WATCHER PO365 0000430F* 42 CHECK DAYS AGAINST # OF DAYS IN THIS MONTH PO365 00440F* 43 COMPARE THIS MONTH TO DECEMBER PO365 00450F* 50 DATE <= IPL DATE (* IN COL 132) PO365 00460F* BUCKET THE $ PO365 00470F* 60 DATE > 3 MONTHS FROM IPL DATE PO365 00480F* BUCKET THE $ PO365 00490F* 55 BUCKET THE $ PO365 0000500F* 75 BLANKET --> NOT INTO BAL DUE OR SUMMARY FIGURES. PO365 00510F* 99 ONLY FIGURE OUT DATE DIVISIONS OF BUCKETS ONCE PO365 00520F* PO365 00530F* L1DUE DATE/PURCHT PO365 00540F* L2PART #/ PURCHT PO365 00550F* L3VENDOR #/PURCHT PO365 00560F* LRPRINT OUT CASH REQUIREMENTS FORECAST FOR NEXT PO365 0000570F* SIX MONTHS PO365 00580F* PO365 00590F********************************************************************PO365 00600E HEADING HEAD 1 1 40 PO365 00610E TABA 1 12 2 0 TABB 2 0 MTHS/# OF DAYS PO365 00620E DAT 25 6 0 BUCKETS PO365 00630E REQ 26 9 2 $ IN BUCKETS PO365 0000640IPURCHT NS 01 PO365 00650I 1 50PO PO365 00660I 6 70LOT PO365 00670I 1 70POKEY PO365 00680I 8 27 PART L2 PO365 00690I 28 290DUEY PO365 00700I 30 330DUEMD PO365 0000710I 28 330DUEDATL1 PO365 00720I 34 380VEND L3 PO365 00730I 39 440PODATE PO365 00740I 45 510QTYORD PO365 00750I 52 580QTYREC PO365 00760I 59 653CUMOV 11 PO365 00770I 66 66 POCODE PO365 0000780IPARTMST NS 02 PO365 00790I 75 813STDCST PO365 00800I 74 74 DLTPR 12 PO365 00810IVENDOR NS 03 PO365 00820I 1 50VENDNO PO365 00830I 6 30 VNAME PO365 00840I 106 106 DLTV 13 PO365 0000850C 01 POCODE COMP 'B' 75BLANKET PO365 00860C N99 EXSR LDDAT PO365 00870C N99 SETON 99 PO365 00880C* PO365 00890C L3 VEND CHAINVENDOR 30 PO365 00900C L3N30N13 SETON 30 PO365 00910C* PO365 0000920C L2 PART CHAINPARTMST 20 PO365 00930C L2N20N12 SETON 20 PO365 00940C* PO365 00950C N11 Z-ADDCUMOV COST 73 PO365 00960C 11 20 Z-ADD0 COST PO365 00970C 11N20 Z-ADDSTDCST COST PO365 00980C* PO365 0000990C 75 GOTO ENDLP2 PO365 01000C QTYORD SUB QTYREC BALDUE 70 PO365 01010C BALDUE MULT COST EXTCST 92H PO365 01020C* PO365 01030C MOVELDUEY DATE 60 PO365 01040C MOVE DUEMD DATE PO365 01050C* PO365 0001060C MOVELDUEMD OUTDAT 60 PO365 01070C MOVE DUEY OUTDAT PO365 01080C* PO365 01090C DATE COMP DAT,1 5050 PO365 01100C* PO365 01110C DATE COMP DAT,25 60 PO365 01120C* PO365 0001130C 60 REQ,26 ADD EXTCST REQ,26 PO365 01140C 60 GOTO ENDLP2 PO365 01150C* PO365 01160C Z-ADD0 I PO365 01170C LOOP2 TAG PO365 01180C I ADD 1 I PO365 01190C DATE COMP DAT,I 5555 PO365 0001200C 55 REQ,I ADD EXTCST REQ,I PO365 01210C 55 GOTO ENDLP2 PO365 01220C GOTO LOOP2 PO365 01230C ENDLP2 TAG PO365 01240C* PO365 01250CLR XFOOTREQ TOTREQ 92 PO365 01260C* PO365 0001270CLR Z-ADD0 I PO365 01280CLR LOOP3 TAG PO365 01290CLR I ADD 1 I PO365 01300CLR I COMP 26 41 PO365 01310CLR 41 GOTO ENDLP3 PO365 01320CLR MOVELDAT,I YY PO365 01330CLR MOVE DAT,I MMDD PO365 0001340CLR MOVELMMDD DAT,I PO365 01350CLR MOVE YY DAT,I PO365 01360CLR GOTO LOOP3 PO365 01370CLR ENDLP3 TAG PO365 01380C********************************************************************PO365 01390C* PO365 01400C* THIS SUBROUTINE TAKES THE IPL DATE AND, USING IT, FORMS AN PO365 0001410C* ARRAY OF DATES. THE DATE ARRAY IS USED TO FORECAST CASH [YYMMDD] PO365 01420C* REQUIRMENTS FOR THE NEXT 3 MONTHS ON A WEEK-BY-WEEK BASIS. PO365 01430C* PO365 01440C********************************************************************PO365 01450CSR LDDAT BEGSR PO365 01460CSR MOVELUDATE MMDD 40 PO365 01470CSR MOVE UDATE YY 20 PO365 0001480CSR MOVELMMDD MM 20 PO365 01490CSR MOVE MMDD DD 20 PO365 01500C* PO365 01510CSR MM LOKUPTABA TABB 40 PO365 01520CSR Z-ADD1 I 20 PO365 01530CSR MOVELYY DAT,I PO365 01540CSR MOVE MMDD DAT,I PO365 0001550C* PO365 01560CSR LOOP1 TAG PO365 01570CSR MM LOKUPTABA TABB 40 PO365 01580CSR I ADD 1 I PO365 01590CSR I COMP 26 41 PO365 01600CSR 41 GOTO ENDLP1 PO365 01610CSR DD ADD 7 DD7 20 PO365 0001620CSR DD7 COMP TABB 42 PO365 01630CSR 42 DD7 SUB TABB DD7 PO365 01640CSR 42 MM COMP 12 43 PO365 01650CSR 42 43 Z-ADD1 MM PO365 01660CSR 42 43 YY ADD 1 YY PO365 01670CSR 42N43 MM ADD 1 MM PO365 01680CSR Z-ADDDD7 DD PO365 0001690C* PO365 01700CSR MOVELMM MMDD PO365 01710CSR MOVE DD MMDD PO365 01720CSR MOVELYY DAT,I PO365 01730CSR MOVE MMDD DAT,I PO365 01740CSR GOTO LOOP1 PO365 01750CSR ENDLP1 TAG PO365 0001760CSR ENDSR PO365 01770C********************************************************************PO365 01780O$LP1 H 202 1P PO365 01790O OR LRNOF PO365 01800O OR OFNLR PO365 01810O PAGE Z 8 PO365 01820O 4 'PAGE' PO365 0001830O HEAD 86 PO365 01840O UDATE Y 132 PO365 01850O H 2 1P PO365 01860O OR LRNOF PO365 01870O OR OFNLR PO365 01880O 70 'OPEN PURCHASE ORDERS' PO365 01890O 80 'BY VENDOR' PO365 0001900O 132 'MFG365' PO365 01910O H 1 1P PO365 01920O OR OFNLR PO365 01930O 5 'VEND#' PO365 01940O 11 'NAME' PO365 01950O 42 'PO/LOT #' PO365 01960O 58 'PART #' PO365 0001970O 76 'TYPE' PO365 01980O 86 'ORDERED' PO365 01990O 97 'RECEIVED' PO365 02000O 108 'BAL DUE' PO365 02010O 119 'COST/UM' PO365 02020O 130 'DUE DATE' PO365 02030O D 1 L2NLR PO365 0002040O 1 ' ' PO365 02050O D 1 01 PO365 02060O L3 VEND Z 5 PO365 02070O L3 N30VNAME 32 PO365 02080O L3 30 29 '*** INVALID VEND # ***' PO365 02090O PO 39 PO365 02100O 40 '-' PO365 0002110O LOT 42 PO365 02120O 20 46 '***' PO365 02130O PART 67 PO365 02140O 20 71 '***' PO365 02150O POCODE 74 PO365 02160O QTYORDJ 87 PO365 02170O QTYRECJ 98 PO365 0002180O N75 BALDUEJ 109 PO365 02190O COST J 120 PO365 02200O OUTDATY 130 PO365 02210O 50 132 '*' PO365 02220O T 3 LR PO365 02230O 11 'END OF JOB.' PO365 02240O 36 'TOTAL STOCK-ON-ORDER IS' PO365 0002250O 40 ' $' PO365 02260O TOTREQJ 53 PO365 02270O T 202 LR PO365 02280O HEAD 86 PO365 02290O UDATE Y 132 PO365 02300O T 3 LR PO365 02310O 68 'CASH REQUIREMENT ' PO365 0002320O 75 'SUMMARY' PO365 02330O T 3 LR PO365 02340O 17 'VALUE OF PURCHASE' PO365 02350O 34 'ORDERS BY PERIOD' PO365 02360O 70 'PERIOD DATE' PO365 02370O 89 'PURCHASE VALUE' PO365 02380O T 1 LR PO365 0002390O 70 'PAST DUE' PO365 02400O REQ,1 J 90 PO365 02410O T 1 LR PO365 02420O DAT,2 Y 70 PO365 02430O REQ,2 J 90 PO365 02440O T 1 LR PO365 02450O DAT,3 Y 70 PO365 0002460O REQ,3 J 90 PO365 02470O T 1 LR PO365 02480O DAT,4 Y 70 PO365 02490O REQ,4 J 90 PO365 02500O T 1 LR PO365 02510O DAT,5 Y 70 PO365 02520O REQ,5 J 90 PO365 0002530O T 1 LR PO365 02540O DAT,6 Y 70 PO365 02550O REQ,6 J 90 PO365 02560O T 1 LR PO365 02570O DAT,7 Y 70 PO365 02580O REQ,7 J 90 PO365 02590O T 1 LR PO365 0002600O DAT,8 Y 70 PO365 02610O REQ,8 J 90 PO365 02620O T 1 LR PO365 02630O DAT,9 Y 70 PO365 02640O REQ,9 J 90 PO365 02650O T 1 LR PO365 02660O DAT,10Y 70 PO365 0002670O REQ,10J 90 PO365 02680O T 1 LR PO365 02690O DAT,11Y 70 PO365 02700O REQ,11J 90 PO365 02710O T 1 LR PO365 02720O DAT,12Y 70 PO365 02730O REQ,12J 90 PO365 0002740O T 1 LR PO365 02750O DAT,13Y 70 PO365 02760O REQ,13J 90 PO365 02770O T 1 LR PO365 02780O DAT,14Y 70 PO365 02790O REQ,14J 90 PO365 02800O T 1 LR PO365 0002810O DAT,15Y 70 PO365 02820O REQ,15J 90 PO365 02830O T 1 LR PO365 02840O DAT,16Y 70 PO365 02850O REQ,16J 90 PO365 02860O T 1 LR PO365 02870O DAT,17Y 70 PO365 0002880O REQ,17J 90 PO365 02890O T 1 LR PO365 02900O DAT,18Y 70 PO365 02910O REQ,18J 90 PO365 02920O T 1 LR PO365 02930O DAT,19Y 70 PO365 02940O REQ,19J 90 PO365 0002950O T 1 LR PO365 02960O DAT,20Y 70 PO365 02970O REQ,20J 90 PO365 02980O T 1 LR PO365 02990O DAT,21Y 70 PO365 03000O REQ,21J 90 PO365 03010O T 1 LR PO365 0003020O DAT,22Y 70 PO365 03030O REQ,22J 90 PO365 03040O T 1 LR PO365 03050O DAT,23Y 70 PO365 03060O REQ,23J 90 PO365 03070O T 1 LR PO365 03080O DAT,24Y 70 PO365 0003090O REQ,24J 90 PO365 03100O T 1 LR PO365 03110O DAT,25Y 70 PO365 03120O REQ,25J 90 PO365 03130O T 1 LR PO365 03140O 70 'OVER 24' PO365 03150O REQ,26J 90 PO365 0003160O T 1 LR PO365 03170O 90 '---------------' PO365 03180O T 1 LR PO365 03190O 90 '$ ' PO365 03200O TOTREQJ 90 PO365 ** 003210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00322000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003250** 0032600131 0032700229 0032800331 003290000430 0033000531 0033100630 0033200731 0033300831 0033400930 0033501031 003360001130 0033701231 003380/* 003390_ 00 00 00 00 00 00 00 00 00 __ 0(P TTXROUTZ PT999999111111(000010H S ROUTZ 00020X DECK-ID M93 MFG/DIST/ACCT SYSTEM SUMMARY-123 ROUTZ 00030F* INITALIZE THE ROUTING FILE TO ZZZZZZZZZZ FOR MATCHING RECORDS ROUTZ 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0ROUTZ 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA ROUTZ 00060F* CONTROL DATA PROPRIETARY PRODUCT ROUTZ 00070F* ROUTZ 0000080FNULL IPEAF 72 DISK ROUTZ 00090FROUTING UC F 102R DISK ROUTZ 00100INULL NS 02 ROUTZ 00110I 01 72 FIELD ROUTZ 00120IROUTING NS 03 ROUTZ 00130I 01 102 REC ROUTZ 00140C Z-ADD01 RRN ROUTZ 0000150C EXSR CHN ROUTZ 00160CSR CHN BEGSR ROUTZ 00170CSR TAGA TAG ROUTZ 00180CSR RRN CHAINROUTING 55 ROUTZ 00190CSR 55 GOTO END ROUTZ 00200CSR RRN ADD 01 RRN 30 ROUTZ 00210CSR SETON 20 ROUTZ 0000220CSR MOVE 'ZZZZZ' Z10 10 ROUTZ 00222CSR MOVEL'ZZZZZ' Z10 00224CSR MOVE Z10 Z20 20 00230CSR MOVELZ10 Z20 ROUTZ 00240CSR EXCPT ROUTZ 00250CSR GOTO TAGA ROUTZ 00260CSR END ENDSR ROUTZ 0000270OROUTING E 20 ROUTZ 00280O Z20 102 ROUTZ ** 000290ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000300ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000310ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000320ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00033000/* 000340_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(Qy @TXPOENT P999999032778(000010H S POENT 00020X DECK-ID M78 MFG/DIST/ACCT SYSTEM SUMMARY-123 POENT 00030F* THIS PROGRAM IS USED TO ENTER PURCHASE ORDER TRANSACTIONS POENT 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0POENT 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA POENT 00060F* CONTROL DATA PROPRIETARY PRODUCT POENT 00070F* POENT 0000080FPODUM IPE F 72 DISK POENT 00090FKPROGS IC F 36R 8AI 1 DISK POENT 00100FPOOUT UC F 128R DISK POENT 00110F********************************************************************POENT 00120F* INDICATOR FUNCTION LIST POENT 00130F* 01 DUMMY RECORD POENT 00140F* 02 KEYPYNCH PARAMETER FILE POENT 0000150F* 05 KEYPUNCH DATA FILE POENT 00160F* 18 POENT 00170F* 19 POENT 00180F* 20 POENT 00190F* 21 POENT 00200F* 25 RETRY ON RUBOUT POENT 00210F* 27 AUTO DUP POENT 0000220F* 28 POENT 00230F* 29 POENT 00240F* 40 MODE IS A-ADD POENT 00250F* 41 MODE IS C-CHANGE POENT 00260F* 42 MODE IS V-VERIFY POENT 00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS POENT 00280F* 44 MODE IS E-END OF JOB POENT 0000290F* 56 SEQ NBR NOT IN KPFILE POENT 00300F* 60 NEW PROGRAM NBR ONLY POENT 00310F* 61 AUTO DUP ONLY POENT 00320F* 70 POENT 00330F* 72 POENT 00340F* 73 MODE IS LESS THAN OR = 4 POENT 00350F* 81 MODE IS INVALID POENT 0000360F* 82 BAD PROG NBR POENT 00370F* 83 FIRST FIELD NAME BLANK POENT 00380F* 84 OUTPUT FIELD NAME POENT 00390F* 85 POENT 00400F* 88 SEQ NBR NOT IN KPFILE POENT 00410F* 90 AUTO DUP ON POENT 00420F* 95 POENT 0000430F* 98 RCD WITHIN OPERATOR LIMITS POENT 00440F* LR POENT 00450F********************************************************************POENT 00460E MSG 1 10 25 POENT 00470E SFN 80 20 POENT 00480E SAN 80 1 POENT 00490E SAD 80 1 POENT 0000500E SST 80 3 0 POENT 00510E SLN 80 2 0 POENT 00520E SNM 4 6 POENT 00530E SMX 4 2 0 POENT 00540E NP 4 1 0 POENT 00550E ARY1 1 2 50 POENT 00560IPODUM NS 01 POENT 0000570I 1 1 A POENT 00580IKPROGS NS 02 POENT 00590I 9 28 FN POENT 00600I 29 29 AN POENT 00610I 30 30 AD POENT 00620I 31 33 ST POENT 00630I 34 35 LN POENT 0000640I 36 36 DCODE POENT 00650IPOOUT NS 05 POENT 00660I 1 128 RECORD POENT 00670C MOVE ' ' B72 72 POENT 00680C EXSR ALMTS POENT 00690C Z-ADDLOW SEQNO POENT 00700C NLR SETON LR POENT 0000710CLR START TAG POENT 00720CLR MOVEL'' WORD POENT 01610CLR Z-ADD1 OLN POENT 0001620CLR Z-ADD1 ILN POENT 01630CLR EXSR TYPES POENT 01640CLR MOVELBUFFER MODE POENT 01650CLR MODE COMP '4' 7373 POENT 01660CLR MODE COMP 'P' 60 NEW PROG#ONLY POENT 01670CLR MODE COMP 'D' 61 AUTO-DUP ONLY POENT 01680CLRN60N61N73 GOTO CHKMOD NEW 46DE POENT 0001690CLR 73 MOVE MODE NPN 10 POENT 01700CLR EXSR GETPRG POENT 01710CLR SETOF 606173 POENT 01720CLR GOTO SAMREC POENT 01730CLR CHKNUM TAG POENT 01740CLR MOVELBUFFER MODE POENT 01750CLR MODE COMP '@' 20 POENT 0001760CLR 20N42 GOTO OUTREC POENT 01770CLR SAN,N COMP 'N' 19 POENT 01780CLRN19 GOTO CHKVER POENT 01790CLR Z-ADDSLN,N VL 20 POENT 01800CLR MOVELBUFFER VAR 15 POENT 01810CLR EXIT SUBRAJ POENT 01820CLR RLABL VL POENT 0001830CLR RLABL VAR POENT 01840CLR MOVELVAR BUFFER POENT 01850CLR Z-ADDVL BLNGTH POENT 01860CLR EXSR EXCPT POENT 01870CLR SETOF 19 POENT 01880CLR CHKVER TAG POENT 01890CLRN42 GOTO MOVBUF POENT 0001900CLR TBUF COMP BUFFER 2020 POENT 01910CLRN20 GOTO MOVBUF POENT 01920CLR MOVEL'KP VERIF'WORD POENT 01930CLR MOVE 'Y ERROR 'WORD POENT 01940CLR MOVELWORD BUFFER POENT 01950CLR MOVE 'R' TYPE POENT 01960CLR Z-ADD6 MASK ONLY 'R' OR 'E'POENT 0001970CLR EXSR CRTCOM POENT 01980CLR RCODE COMP 'R' 20 POENT 01990CLR 20 GOTO OUTFLD POENT 02000CLR MOVBUF TAG POENT 02010CLR Z-ADDSST,N TSTRT 30 POENT 02020CLR Z-ADDSLN,N NCHARS 30 POENT 02030CLR Z-ADD1 SSTRT POENT 0002040CLR EXIT SUBRMV POENT 02050CLR RLABL BUFFER POENT 02060CLR RLABL SSTRT POENT 02070CLR RLABL RECORD POENT 02080CLR RLABL TSTRT POENT 02090CLR RLABL NCHARS POENT 02100CLR GOTO LOOP POENT 0002110CLR RITDUP TAG POENT 02120CLR EXSR MVRECD POENT 02130CLR SETON 19 POENT 02140CLR Z-ADDSLN,N BLNGTH POENT 02150CLRN27 EXSR EXCPT POENT 02160CLR SETOF 19 POENT 02170CLR GOTO MOVBUF POENT 0002180CLR OUTREC TAG POENT 02190CLR SETON 187084 POENT 02200CLR SETON 85 POENT 02210CLR EXCPT POENT 02220CLR EXSR EXCPT POENT 02230CLR SETOF 708485 POENT 02240CLR MOVELRECORD OLDREC128 POENT 0002250CLR NP,PN COMP 0 72 POENT 02260CLRN72 GOTO NXTREC POENT 02270CLR MOVE NP,PN NPN POENT 02280CLR EXSR GETPRG POENT 02290CLR SETOF 72 POENT 02300CLR GOTO NXTREC POENT 02310CLR EOJ TAG POENT 0002320C********************************************************************POENT 02330C* POENT 02340C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION POENT 02350C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. POENT 02360C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. POENT 02370C* POENT 02380C********************************************************************POENT 0002390CSR GETPRG BEGSR POENT 02400CSR 61 GOTO JMPOUT POENT 02410CSR 72 POENT 02420COR 73 GOTO CHKPN POENT 02430CSR GETPNO TAG POENT 02440CSR MOVEL'PROG # -'WORD POENT 02450CSR Z-ADD8 OLN POENT 0002460CSR Z-ADD1 ILN POENT 02470CSR EXSR TYPES POENT 02480CSR MOVELBUFFER NPN 10 POENT 02490CSR CHKPN TAG POENT 02500CSR NPN COMP 0 2020 POENT 02510CSRN20 NPN COMP 4 20 BAD PROG# POENT 02520CSR 20 SETON 82 POENT 0002530CSR 82 EXSR EXCPT POENT 02540CSR SETOF 82 POENT 02550CSR 20 GOTO GETPNO TRY PROG# AGAINPOENT 02560CSR MOVE NPN PN 10 INPOENT 02570CSR MOVE PN NAME10 10 POENT 02580CSRN43 SNM,PN COMP ' ' 6060 POENT 02590CSR 60 PN SUB 1 BP 20 POENT 0002600CSR 60 BP MULT 20 BP POENT 02610CSR 43 GOTO GETPNM POENT 02620CSR 72 GOTO SETHED POENT 02630CSR 73 GOTO JMPOUT POENT 02640CSR 60 GOTO JMPOUT POENT 02650CSR GETPNM TAG POENT 02660CSR MOVEL'PROG NAM'WORD POENT 0002670CSR MOVE 'E - 'WORD POENT 02680CSR Z-ADD11 OLN POENT 02690CSR Z-ADD6 ILN POENT 02700CSR EXSR TYPES POENT 02710CSR MOVELBUFFER PNAME 8 POENT 02720CSR MOVE ' ' PNAME POENT 02730CSR CHNPRG TAG POENT 0002740CSR PNAME CHAINKPROGS 27 POENT 02750CSRN27 MOVELPNAME SNM,PN POENT 02760CSRN27 GOTO LOADIT POENT 02770CSR MOVEL' 'WORD POENT 02780CSR MOVELPNAME WORD POENT 02790CSR MOVE 'ABSENT 'WORD POENT 02800CSR MOVE 'R' TYPE 1 POENT 0002810CSR MOVELWORD BUFFER POENT 02820CSR Z-ADD7 MASK 10 POENT 02830CSR Z-ADD16 BLNGTH POENT 02840CSR EXSR CRTCOM POENT 02850CSR RCODE COMP 'E' 20 POENT 02860CSR PRGMT TAG POENT 02870C*R 20 EXSR PROGMT POENT 0002880C*R 20 GOTO CHNPRG POENT 02890CSR GOTO GETPNM POENT 02900CSR LOADIT TAG POENT 02910CSR Z-ADD14 OLN POENT 02920CSR Z-ADD1 ILN POENT 02930CSR MOVEL'NEXT PRO'WORD POENT 02940CSR MOVE 'G # - 'WORD POENT 0002950CSR EXSR TYPES POENT 02960CSR MOVELBUFFER NP,PN POENT 02970CSR PN SUB 1 BP POENT 02980CSR BP MULT 20 BP POENT 02990CSR BP ADD 1 N 20 POENT 03000CSR Z-ADD1 X 20 POENT 03010CSR BLDARY TAG POENT 0003020CSR FN COMP B72 20 POENT 03030CSR 20 N SUB 1 MAXFLD 20 POENT 03040CSR 20 MOVE MAXFLD SMX,PN POENT 03050CSR 20 GOTO JMPOUT POENT 03060CSR MOVE FN SFN,N FIELD NAME POENT 03070CSR MOVE AN SAN,N ALPHA OR NUMER POENT 03080CSR MOVE AD SAD,N AUTO DUP POENT 0003090CSR MOVE ST SST,N START POSITION POENT 03100CSR MOVE LN SLN,N POENT 03110CSR MVX TAG POENT 03120CSR MOVE X PNAME POENT 03130CSR PNAME CHAINKPROGS 20 POENT 03140CSR X ADD 1 X POENT 03150CSRN20 X COMP 20 20 POENT 0003160CSR 20 Z-ADDN MAXFLD POENT 03170CSR 20 MOVE MAXFLD SMX,PN POENT 03180CSR DCODE COMP 'D' 21 POENT 03190CSR 21N20 GOTO MVX POENT 03200CSRN20 N ADD 1 N POENT 03210CSRN20 GOTO BLDARY POENT 03220CSR JMPOUT TAG POENT 0003230CSR 43 GOTO ENDGET POENT 03240CSR 41 GOTO SETHED POENT 03250CSR MOVEL'AUTO-DUP'WORD POENT 03260CSR MOVE ' - 'WORD POENT 03270CSR Z-ADD11 OLN POENT 03280CSR Z-ADD1 ILN POENT 03290CSR EXSR TYPES POENT 0003300CSR MOVELBUFFER AUTO 1 POENT 03310CSR AUTO COMP 'O' 90AUTO-DUP ON POENT 03320CSR SETHED TAG POENT 03330CSR MOVELSNM,PN NAME10 POENT 03340CSR MOVELNAME10 WORD POENT 03350CSR MOVE SMX,PN MAXFLD 20 POENT 03360CSR 90 MOVE ' ON' WORD POENT 0003370CSRN90 MOVE 'OFF' WORD POENT 03380CSR MOVELWORD HEAD 40 POENT 03390CSR ENDGET ENDSR POENT 03400C********************************************************************POENT 03410C* POENT 03420C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST POENT 03430C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE POENT 0003440C* CHANGED POENT 03450C* POENT 03460C********************************************************************POENT 03470CSR GETSEQ BEGSR POENT 03480CSR MOVEL'SEQ # - 'WORD POENT 03490CSR Z-ADD8 OLN POENT 03500CSR Z-ADD5 ILN POENT 0003510CSR EXSR TYPES POENT 03520CSR Z-ADD5 VL POENT 03530CSR MOVELBUFFER VAR POENT 03540CSR EXIT SUBRAJ POENT 03550CSR RLABL VL POENT 03560CSR RLABL VAR POENT 03570CSR MOVELVAR SEQNO POENT 0003580CSR SEQNO COMP 0 20 POENT 03590CSRN20 Z-ADD1 SEQNO POENT 03600CSR SETON 95 POENT 03610CSR ENDSEQ ENDSR POENT 03620C********************************************************************POENT 03630C* POENT 03640C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO POENT 0003650C* POENT 03660C********************************************************************POENT 03670CSR GETREC BEGSR POENT 03680CSR SEQRD TAG POENT 03690CSR 10 SETOF 10 POENT 03700CSR EXSR TSTSEQ POENT 03710CSR 10 GOTO ENDGTY POENT 0003720CSR 94 EXSR GETSEQ POENT 03730CSR 94 GOTO SEQRD POENT 03740CSR SEQNO CHAINPOOUT 56 POENT 03750CSR MOVELRECORD TST 2 POENT 03760CSR TST COMP '<>' 99 POENT 03770CSR 40N99 SEQNO ADD 1 SEQNO POENT 03780CSR 40N99 GOTO SEQRD POENT 0003790CSR 41 99 EXSR NOCHG POENT 03800CSR 41 99 GOTO SEQRD POENT 03810CSR 56 SETON 88 POENT 03820CSR 88 EXSR EXCPT POENT 03830CSR SETOF 88 POENT 03840CSR 56 EXSR GETSEQ POENT 03850CSR 56 GOTO SEQRD POENT 0003860CSR ENDGTY ENDSR POENT 03870C********************************************************************POENT 03880C* POENT 03890C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY POENT 03900C* IS DONE IF A RUBOUT IS USED POENT 03910C* POENT 03920C********************************************************************POENT 0003930CSR TYPES BEGSR POENT 03940CSR OVER TAG POENT 03950CSR Z-ADDOLN BLNGTH POENT 03960CSR MOVELWORD BUFFER POENT 03970CSR MOVE 'S' TYPE POENT 03980CSR EXSR CRTCOM POENT 03990CSR MOVE 'A' TYPE POENT 0004000CSR Z-ADDILN BLNGTH POENT 04010CSR EXSR CRTCOM POENT 04020CSR RCODE COMP 'R' 25 POENT 04030CSR 25 EXSR SKIP POENT 04040CSR 25 GOTO OVER POENT 04050CSR RCODE COMP 'O' 25 POENT 04060CSR 25 EXSR SKIP POENT 0004070CSR ENDSR POENT 04080C********************************************************************POENT 04090C* POENT 04100C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT POENT 04110C* POENT 04120C********************************************************************POENT 04130CSR SKIP BEGSR POENT 0004140CSR MOVELBUFFER NBUF 1 POENT 04150CSR MOVEL' ' BUFFER POENT 04160CSR Z-ADD1 BLNGTH POENT 04170CSR MOVE 'T' TYPE POENT 04180CSR EXSR CRTCOM POENT 04190CSR MOVELNBUF BUFFER POENT 04200CSR ENDSR POENT 0004210C********************************************************************POENT 04220C* POENT 04230C* POENT 04240C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED POENT 04250C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER POENT 04260C* POENT 04270CSR MVRECD BEGSR POENT 0004280CSR MOVELB72 BUFFER POENT 04290CSR Z-ADD1 TSTRT POENT 04300CSR Z-ADDSST,N SSTRT POENT 04310CSR Z-ADDSLN,N NCHARS POENT 04320CSR EXIT SUBRMV POENT 04330CSR RLABL OLDREC POENT 04340CSR RLABL SSTRT 30 POENT 0004350CSR RLABL BUFFER POENT 04360CSR RLABL TSTRT 30 POENT 04370CSR RLABL NCHARS 30 POENT 04380CSR ENDSR POENT 04390C********************************************************************POENT 04400CSR EXCPT BEGSR POENT 04410CSRN81N82N83 POENT 0004420CANN84N88 GOTO PUTOUT POENT 04430CSR MOVELB72 BUFFER POENT 04440CSR 81 MOVELMSG,1 BUFFER POENT 04450CSR 83 MOVELMSG,2 BUFFER POENT 04460CSR 88 MOVELMSG,3 BUFFER POENT 04470CSR 82 MOVELMSG,4 BUFFER POENT 04480CSRN84 GOTO PUTOUT POENT 0004490CSRN85 MOVELSFN,N BUFFER POENT 04500CSRN18 SETON 19 POENT 04510CSRN18 Z-ADD20 BLNGTH POENT 04520CSRN18 GOTO PUTOUT POENT 04530CSR MOVE HEAD BUFFER POENT 04540CSR MOVELSEQNO WORD8 8 POENT 04550CSR MOVE WORD8 BUFFER POENT 0004560CSR PUTOUT TAG POENT 04570CSR MOVE 'S' TYPE POENT 04580CSRN19 Z-ADD69 BLNGTH POENT 04590CSR SETOF 19 POENT 04600CSR EXSR CRTCOM POENT 04610CSR ENDSR POENT 04620C* POENT 0004630CSR ALMTS BEGSR POENT 04640CSR MOVE 'C' TYPE 1 POENT 04650CSR Z-ADD0 BLNGTH 20 POENT 04660CSR MOVE ' ' RCODE 1 POENT 04670CSR Z-ADD0 MASK 10 POENT 04680CSR Z-ADD0 DTYPE 10 POENT 04690CSR EXSR CRTCOM POENT 0004700CSR MOVELARY1,1 BUFFER POENT 04710CSR MOVE 'S' TYPE POENT 04720CSR Z-ADD50 BLNGTH POENT 04730CSR EXSR CRTCOM POENT 04740CSR MOVE 'A' TYPE POENT 04750CSR Z-ADD5 BLNGTH POENT 04760CSR Z-ADD1 DTYPE POENT 0004770CSR EXSR CRTCOM POENT 04780CSR EXSR SKIP POENT 04790CSR RCODE COMP 'R' 86 POENT 04800CSR Z-ADD5 VL POENT 04810CSR MOVELBUFFER VAR POENT 04820CSR EXIT SUBRAJ POENT 04830CSR RLABL VL POENT 0004840CSR RLABL VAR POENT 04850CSR MOVELVAR BUFFER POENT 04860CSR MOVELBUFFER LOW 50 POENT 04870CSR MOVELARY1,2 BUFFER POENT 04880CSR MOVE 'S' TYPE POENT 04890CSR Z-ADD50 BLNGTH POENT 04900CSR EXSR CRTCOM POENT 0004910CSR MOVE 'A' TYPE POENT 04920CSR Z-ADD5 BLNGTH POENT 04930CSR Z-ADD1 DTYPE POENT 04940CSR EXSR CRTCOM POENT 04950CSR RCODE COMP 'R' 87 POENT 04960CSR Z-ADD5 VL POENT 04970CSR MOVELBUFFER VAR POENT 0004980CSR EXIT SUBRAJ POENT 04990CSR RLABL VL POENT 05000CSR RLABL VAR POENT 05010CSR MOVELVAR BUFFER POENT 05020CSR MOVELBUFFER HIGH 50 POENT 05030CSR MOVE 'C' TYPE POENT 05040CSR EXSR CRTCOM POENT 0005050CSR 86 POENT 05060COR 87 GOTO ALMTS POENT 05070CSR Z-ADD0 DTYPE POENT 05080CSR ENDSR POENT 05090CSR CRTCOM BEGSR POENT 05100CSR EXITFSUBRCM POENT 05110CSR RLABL BUFFER POENT 0005120CSR RLABL TYPE POENT 05130CSR RLABL BLNGTH POENT 05140CSR RLABL RCODE POENT 05150CSR RLABL MASK POENT 05160CSR RLABL DTYPE POENT 05170CSR ENDSR POENT 05180CSR PUTSEQ BEGSR POENT 0005190CSR MOVELMSG,5 BUFFER 72 POENT 05200CSR MOVE 'S' TYPE POENT 05210CSR Z-ADD25 BLNGTH POENT 05220CSR EXSR CRTCOM POENT 05230CSR MOVELSEQNO BUFFER POENT 05240CSR MOVE 'T' TYPE POENT 05250CSR Z-ADD5 BLNGTH POENT 0005260CSR EXSR CRTCOM POENT 05270CSR ENDSR POENT 05280CSR TSTSEQ BEGSR POENT 05290CSR SETOF 949697 POENT 05300CSR SEQNO COMP LOW 989698 POENT 05310CSR 98 SEQNO COMP HIGH 979898 POENT 05320CSR 98 GOTO ENDTST POENT 0005330CSR MOVE B72 BUFFER POENT 05340CSR 40 96 MOVELMSG,6 BUFFER POENT 05350CSR 40 97 MOVELMSG,7 BUFFER POENT 05360CSRN40 MOVELMSG,8 BUFFER POENT 05370CSRN40 SETON 94 POENT 05380CSR MOVE 'T' TYPE POENT 05390CSR Z-ADD25 BLNGTH POENT 0005400CSR 40 97 MOVE 'R' TYPE POENT 05410CSR 40 97 Z-ADD5 MASK POENT 05420CSR EXSR CRTCOM POENT 05430CSR 40 97 SETON 10 POENT 05440CSR 40 97 Z-ADD0 MASK POENT 05450CSR ENDTST ENDSR POENT 05460CSR NOCHG BEGSR POENT 0005470CSR MOVELMSG,9 BUFFER POENT 05480CSR MOVE 'T' TYPE POENT 05490CSR Z-ADD25 BLNGTH POENT 05500CSR EXSR CRTCOM POENT 05510CSR EXSR GETSEQ POENT 05520CSR ENDSR POENT 05530C********************************************************************POENT 0005540OPOOUT E 70N56 POENT 05550O RECORD 128 POENT 05560O 42 128 'X' POENT 05570O SEQNO 127 POENT ** 005580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00560000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005620** 005630MODE MUST BE A,C,V,OR E 005640FIRST FIELD NAME BLANK 005650INVALID SEQ # 005660PROG# MUST BE FROM 1-4 00567000CURRENT SEQUENCE NBR 005680SEQNO TOO LOW 005690FILE FULL ENTER R OR C 005700SEQNO NOT IN YOUR LIMITS 005710ILLEGAL CHANGE-NO DATA 005720** 005730ENTER BEGINNING RELATIVE RECORD NUMBER 00574000ENTER ENDING RELATIVE RECORD NUMBER 005750/* 005760__ FULL ENTER R OR C 005700SEQNO NOT IN YOUR LIMITS 005710ILLEGAL CHANGE-NO DATA 005720** 005730ENTER BEGINNING RELATIVE RECORD NUMBER 0057400(R iTXPR001 P999999032778(000010H S PR001 00020X DECK-ID B01 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR001 00030F* PRINT PERSONNEL REGISTER PR001 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR001 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR001 00060F* CONTROL DATA PROPRIETARY PRODUCT PR001 00070F* PR001 0000080F* PR001 00090F* *************************************************************** PR001 00100F* * ************************************************* * PR001 00110F* * * * * PR001 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR001 00130F* * * * * PR001 00140F* * ************************************************* * PR001 0000150F* *************************************************************** PR001 00160F* PR001 00170F* ---- PERSONNEL REGISTER. ---- PR001 00180F* PR001 00190F* PR001 00200F* MODIFIED 3/05/76 TO READ PRMAST INSTEAD OF ENMAST. THE REPORT PR001 00210F* WILL BE IN EMPLOYEE# WITHIN DEPARTMENT. PR001 0000220F* PR001 00230FPRMAST IP AF 600 10AI 2 DISK PR001 00240FRPT O F 132 132 OF LPRINTER PR001 00250FCNMAST IC F 128 128R 2AI 1 DISK PR001 00260LRPT 66FL 60OL PR001 00270ICNMAST NS 03 PR001 00280I 5 40 CONAME PR001 0000290I* PR001 00300IPRMAST NS 01 PR001 00310I 8 11 EMPL PR001 00320I 4 70DEPT L1 PR001 00330I 003 003 DIV L2 PR001 00340I 002 002 CORP L3 PR001 00350I 012 013 INIT PR001 0000360I 014 033 NAME PR001 00370I 034 067 ADDR PR001 00380I 068 085 CITY PR001 00390I 088 089 STATE PR001 00400I 090 094 ZIP PR001 00410I 095 1000BDATE 11 PR001 00420I 101 103 SS1 PR001 0000430I 104 105 SS2 PR001 00440I 106 109 SS3 PR001 00450I 110 1143HRATE PR001 00460I 115 1202SALARY PR001 00470I 121 121 UNCODE PR001 00480I 124 124 SEX PR001 00490I 125 125 MARIT PR001 0000500I 126 1270FDEP PR001 00510I 128 1290SDEP PR001 00520I 130 130 CCODE PR001 00530I 131 131 TERM PR001 00540I 132 132 TYPE PR001 00550I 133 133 SHIFT PR001 00560I 134 1390HDATE 12 PR001 0000570I 140 1450TDATE 13 PR001 00580I 146 1510RDATE 14 PR001 00590I 152 154 CLASS PR001 00600I 155 156 STCODE PR001 00610I 157 1580PAYPRD PR001 00620I 159 1620CTAXPC PR001 00630I 168 171 CABBR PR001 0000640I 2 30CORDIV PR001 00650I 382 3863PRATE PR001 00660I* PR001 00670I 571 5731STXPCT 15 PR001 00680I 574 5761FTXPCT 16 PR001 00690I 577 577 MINCOD PR001 00700I 387 3922PRSAL PR001 0000710I 246 2501YTDVAC PR001 00720C L2 MOVELCORDIV KEY2 2 PR001 00730C L2 KEY2 CHAINCNMAST 20 PR001 00740C L1 PRINT PR001 00750COR OF EXCPT HEADINGS. PR001 00760C TYPE COMP '3' 22 PR001 00770C N22 GOTO TAGA PR001 0000780C SALARY MULT PAYPRD ANNUAL 82 CONVERT SALARYSPR001 00790C ANNUAL DIV 2080 HRATE H TO HOURLY PR001 00800C PRSAL MULT PAYPRD ANNUAL RATES. PR001 00810C ANNUAL DIV 2080 PRATE H PR001 00820C TAGA TAG PR001 00830C* PR001 00840C* PR001 0000850C* PR001 00860C N01 GOTO BY01 PR001 00870C* ********** PR001 00880C* PR001 00890C TERM COMP 'T' 21 PR001 00900C* PR001 00910C* PR001 0000920C CNT ADD 1 CNT 50 PR001 00930C N21 CNTA ADD 1 CNTA 50 PR001 00940C 21 CNTT ADD 1 CNTT 50 PR001 00950C* PR001 00960C* PR001 00970C BY01 TAG PR001 00980C* ********** PR001 0000990ORPT E 302 01 PR001 01000O* PR001 01010O 6 'PR0001' PR001 01020O CONAME 45 PR001 01030O 71 'PERSONNEL REGISTER -' PR001 01040O 82 'DEPARTMENT' PR001 01050O DEPT 3 87 PR001 0001060O UDATE Y 106 PR001 01070O 127 'PAGE' PR001 01080O PAGE Z 131 PR001 01090O E 1 01 PR001 01100O 46 'SOCIAL BIRTH' PR001 01110O 66 'HIRE/TERM RAISE' PR001 01120O 91 'HOURLY PREV U S S' PR001 0001130O 113 'MIN FED STATE COMP/' PR001 01140O 125 'ST PY Y-T-D' PR001 01150O E 2 01 PR001 01160O 9 'EMP# NAME' PR001 01170O 45 'SECURITY # DATE' PR001 01180O 74 'DATE DATE RATE' PR001 01190O 100 'RATE N H X COD STAT' PR001 0001200O 119 'STAT CLASS CD PD' PR001 01210O 127 'VAC HRS' PR001 01220O D 1 01 PR001 01230O EMPL 4 PR001 01240O INIT 7 PR001 01250O NAME 28 PR001 01260O 36 '- -' PR001 0001270O SS1 32 PR001 01280O SS2 35 PR001 01290O SS3 40 PR001 01300O N11 BDATE Y 49 PR001 01310O HDATE Y 58 PR001 01320O N13 21 TDATE Y 58 PR001 01330O N13 21 59 'T' PR001 0001340O N14 RDATE Y 68 PR001 01350O HRATE 3 76 PR001 01360O 22 77 'S' PR001 01370O PRATE 3 85 PR001 01380O UNCODE 87 PR001 01390O SHIFT 89 PR001 01400O SEX 91 PR001 0001410O MINCOD 94 PR001 01420O MARIT 97 PR001 01430O FDEP 3 100 PR001 01440O MARIT 103 PR001 01450O SDEP 3 106 PR001 01460O N16 FTXPCT2 100 PR001 01470O N16 101 '%' PR001 0001480O N15 STXPCT2 106 PR001 01490O N15 107 '%' PR001 01500O CCODE 109 PR001 01510O 110 '/' PR001 01520O CLASS 113 PR001 01530O STCODE 116 PR001 01540O PAYPRD 119 PR001 0001550O YTDVAC3 127 PR001 01560O T 1 L1 PR001 01570O 20 'END OF DEPT .' PR001 01580O DEPT 19 PR001 01590O CNT 3B 26 PR001 01600O 37 'EMPLOYEES:' PR001 01610O CNTA 3B 42 PR001 0001620O 67 'ACTIVE, TERMINATED.' PR001 01630O CNTT 3B 55 PR001 ** 001640ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001650ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001660ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001670ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00168000/* 001690__0O CNTT 3B 55 PR001 ** 001640ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001650ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001660ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001670ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0016800(}R #5TXPR004 P999999032778(000010H S PR004 00020X DECK-ID B02 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR004 00030F* ADD RECORDS FROM TRANS FILE TO SVTRNS FILE PR004 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR004 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR004 00060F* CONTROL DATA PROPRIETARY PRODUCT PR004 00070F* PR004 0000080F* PR004 00090F* *************************************************************** PR004 00100F* * ************************************************* * PR004 00110F* * * * * PR004 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR004 00130F* * * * * PR004 00140F* * ************************************************* * PR004 0000150F* *************************************************************** PR004 00160F* PR004 00170FTRANS IP AF 132 DISK PR004 00180FSVTRNS O F 132 DISK A PR004 00190F* *PR004 00200F********************************************************************PR004 00210F* *PR004 0000220F* COMPUSOURCE PAYROLL SYSTEM. *PR004 00230F* *PR004 00240F* ADDS 'TRANS' RECORDS TO 'SVTRNS'. *PR004 00250F********************************************************************PR004 00260ITRANS NS 01 PR004 00270I 1 132 REC PR004 00280OSVTRNS DADD 01 PR004 0000290O REC 132 PR004 ** 000300ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000310ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000320ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000330ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000340/* 00035000__0O REC 132 PR004 ** 000300ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000310ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000320ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000330ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000340/* 0003500(S) TXPR005 P999999032778(000010H S PR005 00020X DECK-ID B03 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR005 00030F* PRINT DETAIL PAY REGISTER PR005 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR005 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR005 00060F* CONTROL DATA PROPRIETARY PRODUCT PR005 00070F* PR005 0000080F* PR005 00090F* *************************************************************** PR005 00100F* * ************************************************* * PR005 00110F* * * * * PR005 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR005 00130F* * * * * PR005 00140F* * ************************************************* * PR005 0000150F* *************************************************************** PR005 00160F* PR005 00170F* MODIFIED 08/10/76 TO PRODUCE SEPARATE 'P5' RECS FOR EACH WEEK. PR005 00180F* PR005 00190FWKLYPR IP AF 128 128 DISK PR005 00200FRPT O F 132 132 OF LPRINTER PR005 00210FWEARNS O F 140 140 DISK PR005 0000220FPRMAST IC F 600R10AI 2 DISK PR005 00230FCNMAST IC F 128 128R 2AI 1 DISK PR005 00240E D 132 1 DASHES PR005 00250LRPT 66FL 58OL PR005 00260IWKLYPR NS 04 1 C# PR005 00270I 1 128 RCD PR005 00280I 11 160WEDATE PR005 0000290I 20 21 WKNUM PR005 00300I NS 01 1 CP 2 C5 PR005 00310I OR 1 CL 2 C5 PR005 00320I OR 02 1 CP 2 CN PR005 00330I 1 128 RCD PR005 00340I 1 2 RC PR005 00350I 2 2 TYPE L1 PR005 0000360I 3 40CORDIVL4 PR005 00370I 3 12 KEY PR005 00380I 5 8 STA L3 PR005 00390I 9 12 EMP L2 PR005 00400I 13 140WEEK 11 PR005 00410I 15 181RGHR PR005 00420I 19 211SKHR PR005 0000430I 22 241HLHR PR005 00440I 25 281VCHR PR005 00450I 29 311OTHR PR005 00460I 32 372RGPY PR005 00470I 38 422SKPY PR005 00480I 43 472HLPY PR005 00490I 48 532VCPY PR005 0000500I 54 582OTPY PR005 00510I 59 632FWH PR005 00520I 74 782SWH PR005 00530I 79 832CWH PR005 00540I 90 921DTHR PR005 00550I 93 972DTPY PR005 00560I NS 05 1 CP 2 CP PR005 0000570I OR 10 1 CP 2 C7 PR005 00580I 1 128 RCD PR005 00590I 1 2 RC PR005 00600I 2 2 TYPE L1 PR005 00610I 3 40CORDIVL4 PR005 00620I 3 12 KEY PR005 00630I 5 8 STA L3 PR005 0000640I 9 12 EMP L2 PR005 00650I 14 192AFWH PR005 00660I 20 252ASWH PR005 00670I 26 312CUN PR005 00680I 32 372BONDS PR005 00690I 38 432UDUES PR005 00700I 44 492LINS PR005 0000710I 50 552HINS PR005 00720I 56 612PADV PR005 00730I 62 662EQUIP PR005 00740I 67 712STOCK PR005 00750I 72 762PENS PR005 00760I 77 812MISC PR005 00770I NS 06 1 CP 2 C8 PR005 0000780I 1 128 RCD PR005 00790I 1 2 RC PR005 00800I 2 2 TYPE L1 PR005 00810I 3 40CORDIVL4 PR005 00820I 3 12 KEY PR005 00830I 5 8 STA L3 PR005 00840I 9 12 EMP L2 PR005 0000850I 17 222ONEDED PR005 00860I NS 07 1 CP 2 C6 PR005 00870I OR 08 1 CP 2 CO PR005 00880I 1 128 RCD PR005 00890I 1 2 RC PR005 00900I 2 2 TYPE L1 PR005 00910I 3 40CORDIVL4 PR005 0000920I 3 12 KEY PR005 00930I 5 8 STA L3 PR005 00940I 9 12 EMP L2 PR005 00950I 13 192COMM PR005 00960IPRMAST NS 03 PR005 00970I 012 012 FINIT PR005 00980I 013 013 SINIT PR005 0000990I 014 033 NAME PR005 01000I* PR005 01010ICNMAST NS 09 PR005 01020I 5 40 CONAM PR005 01030C SETOF 41 PR005 01040C NL4 GOTO TRYL3 PR005 01050C* ********** PR005 0001060C SETOF 92 PR005 01070C MOVE '-' D PR005 01080C MOVELCORDIV KEY2 4 PR005 01090C CORDIV CHAINCNMAST 22 PR005 01100C Z-ADD0 GHP PR005 01110C Z-ADD0 GOT PR005 01120C Z-ADD0 GRP PR005 0001130C Z-ADD0 GV PR005 01140C Z-ADD0 GS PR005 01150C Z-ADD0 GVP PR005 01160C Z-ADD0 GSP PR005 01170C Z-ADD0 GH PR005 01180C Z-ADD0 GO PR005 01190C Z-ADD0 GR PR005 0001200C Z-ADD0 L3DED PR005 01210C Z-ADD0 L3COM PR005 01220C TRYL3 TAG PR005 01230C* ********** PR005 01240C NL3 GOTO TRYL2 PR005 01250C* ********** PR005 01260C Z-ADD0 L2HP PR005 0001270C Z-ADD0 L2OT PR005 01280C Z-ADD0 L2RP PR005 01290C Z-ADD0 L2V PR005 01300C Z-ADD0 L2S PR005 01310C Z-ADD0 L2VP PR005 01320C Z-ADD0 L2SP PR005 01330C Z-ADD0 L2H PR005 0001340C Z-ADD0 L2O PR005 01350C Z-ADD0 L2R PR005 01360C Z-ADD0 L2DED PR005 01370C Z-ADD0 L2COM PR005 01380C TRYL2 TAG PR005 01390C* ********** PR005 01400C NL2 GOTO TRYL1 PR005 0001410C* ********** PR005 01420C MOVEL' ' KEY PR005 01430C KEY CHAINPRMAST 21 PR005 01440C Z-ADD0 L1HP PR005 01450C Z-ADD0 L1OT PR005 01460C Z-ADD0 L1RP PR005 01470C Z-ADD0 L1V PR005 0001480C Z-ADD0 L1S PR005 01490C Z-ADD0 L1VP PR005 01500C Z-ADD0 L1SP PR005 01510C Z-ADD0 L1H PR005 01520C Z-ADD0 L1O PR005 01530C Z-ADD0 L1R PR005 01540C Z-ADD0 L1DED PR005 0001550C Z-ADD0 L1COM PR005 01560C TRYL1 TAG PR005 01570C* ********** PR005 01580C NL1 GOTO BEGIN PR005 01590C* ********** PR005 01600C SETOF 20 PR005 01610C Z-ADD0 DTPAY PR005 0001620C Z-ADD0 DT PR005 01630C Z-ADD0 OTPAY PR005 01640C Z-ADD0 OT PR005 01650C Z-ADD0.00 VPAY PR005 01660C Z-ADD0.00 HPAY PR005 01670C Z-ADD0.00 SPAY PR005 01680C Z-ADD0.00 RPAY PR005 0001690C Z-ADD0.0 VAC PR005 01700C Z-ADD0.0 HOL PR005 01710C Z-ADD0.0 SICK PR005 01720C Z-ADD0.0 REG PR005 01730C Z-ADD0.00 EFWH PR005 01740C Z-ADD0.00 ESWH PR005 01750C Z-ADD0.00 ECWH PR005 0001760C BEGIN TAG PR005 01770C* ********** PR005 01780C L3 PR005 01790COR OF SETON 93 PR005 01800C 93 EXCPT PR005 01810C SETOF 93 PR005 01820C N01 GOTO REC02 PR005 0001830C* ********** PR005 01840C SETON 20 PR005 01850C RC COMP 'L5' 32 PR005 01860C 32 MOVE 'PL' RC PR005 01870C NL1 WEEK COMP OLDWK 2323 IS THIS A PR005 01880C 23 EXCPT WEEK? PR005 01890C SETOF 23 YES- OUTPUT PR005 0001900C Z-ADDWEEK OLDWK 20 A 'P5'. PR005 01910C RGHR ADD REG REG 41 PR005 01920C SKHR ADD SICK SICK 31 PR005 01930C HLHR ADD HOL HOL 31 PR005 01940C VCHR ADD VAC VAC 41 PR005 01950C OTHR ADD OT OT 31 PR005 01960C RGPY ADD RPAY RPAY 62 PR005 0001970C SKPY ADD SPAY SPAY 52 PR005 01980C HLPY ADD HPAY HPAY 52 PR005 01990C VCPY ADD VPAY VPAY 62 PR005 02000C DTHR ADD DT DT 31 PR005 02010C OTPY ADD OTPAY OTPAY 52 PR005 02020C DTPY ADD DTPAY DTPAY 52 PR005 02030C EFWH ADD FWH EFWH 52 PR005 0002040C ESWH ADD SWH ESWH 52 PR005 02050C ECWH ADD CWH ECWH 52 PR005 02060C REC02 TAG PR005 02070C* ********** PR005 02080C N01N02 GOTO REC05 PR005 02090C* ********** PR005 02100C OTHR ADD DTHR COT 41 PR005 0002110C OTHR ADD DTHR DXHR 41 PR005 02120C OTPY ADD DTPY COTPAY 62 PR005 02130C OTPY ADD DTPY DXPY 62 PR005 02140C RGHR ADD L1R L1R 51 PR005 02150C SKHR ADD L1S L1S 51 PR005 02160C HLHR ADD L1H L1H 51 PR005 02170C VCHR ADD L1V L1V 61 PR005 0002180C COT ADD L1O L1O 51 PR005 02190C RGPY ADD L1RP L1RP 82 PR005 02200C SKPY ADD L1SP L1SP 72 PR005 02210C HLPY ADD L1HP L1HP 72 PR005 02220C VCPY ADD L1VP L1VP 82 PR005 02230C COTPAY ADD L1OT L1OT 72 PR005 02240C RGHR ADD L2R L2R 51 PR005 0002250C SKHR ADD L2S L2S 51 PR005 02260C HLHR ADD L2H L2H 51 PR005 02270C VCHR ADD L2V L2V 61 PR005 02280C COT ADD L2O L2O 51 PR005 02290C RGPY ADD L2RP L2RP 82 PR005 02300C SKPY ADD L2SP L2SP 72 PR005 02310C HLPY ADD L2HP L2HP 72 PR005 0002320C VCPY ADD L2VP L2VP 82 PR005 02330C COTPAY ADD L2OT L2OT 72 PR005 02340C RGHR ADD L3REG L3REG 41 PR005 02350C SKHR ADD L3SK L3SK 41 PR005 02360C HLHR ADD L3HOL L3HOL 41 PR005 02370C VCHR ADD L3VAC L3VAC 51 PR005 02380C COT ADD L3OT L3OT 41 PR005 0002390C RGPY ADD L3RP L3RP 72 PR005 02400C SKPY ADD L3SP L3SP 62 PR005 02410C HLPY ADD L3HP L3HP 62 PR005 02420C VCPY ADD L3VP L3VP 72 PR005 02430C COTPAY ADD L3OTP L3OTP 62 PR005 02440C RGHR ADD GR GR 51 PR005 02450C SKHR ADD GS GS 51 PR005 0002460C HLHR ADD GH GH 51 PR005 02470C VCHR ADD GV GV 61 PR005 02480C COT ADD GO GO 51 PR005 02490C RGPY ADD GRP GRP 82 PR005 02500C SKPY ADD GSP GSP 72 PR005 02510C HLPY ADD GHP GHP 72 PR005 02520C VCPY ADD GVP GVP 82 PR005 0002530C COTPAY ADD GOT GOT 72 PR005 02540C RGHR ADD L4GR L4GR 71 PR005 02550C SKHR ADD L4GS L4GS 71 PR005 02560C HLHR ADD L4GH L4GH 71 PR005 02570C VCHR ADD L4GV L4GV 71 PR005 02580C COT ADD L4GO L4GO 71 PR005 02590C RGPY ADD L4GRP L4GRP 92 PR005 0002600C SKPY ADD L4GSP L4GSP 92 PR005 02610C HLPY ADD L4GHP L4GHP 92 PR005 02620C VCPY ADD L4GVP L4GVP 92 PR005 02630C COTPAY ADD L4GOT L4GOT 92 PR005 02640C GOTO END PR005 02650C* ********** PR005 02660C* PR005 0002670C REC05 TAG PR005 02680C* ********** PR005 02690C N05N10 GOTO REC06 PR005 02700C* ********** PR005 02710C AFWH ADD ASWH DED05 62 PR005 02720C CUN ADD DED05 DED05 PR005 02730C BONDS ADD DED05 DED05 PR005 0002740C UDUES ADD DED05 DED05 PR005 02750C LINS ADD DED05 DED05 PR005 02760C HINS ADD DED05 DED05 PR005 02770C PADV ADD DED05 DED05 PR005 02780C EQUIP ADD DED05 DED05 PR005 02790C STOCK ADD DED05 DED05 PR005 02800C PENS ADD DED05 DED05 PR005 0002810C MISC ADD DED05 DED05 PR005 02820C DED05 ADD L1DED L1DED 62 PR005 02830C DED05 ADD L2DED L2DED 62 PR005 02840C DED05 ADD L3DED L3DED 72 PR005 02850C DED05 ADD L4DED L4DED 82 PR005 02860C GOTO END PR005 02870C* ********** PR005 0002880C* PR005 02890C REC06 TAG PR005 02900C* ********** PR005 02910C N06 GOTO REC07 PR005 02920C* ********** PR005 02930C ONEDED ADD L1DED L1DED PR005 02940C ONEDED ADD L2DED L2DED PR005 0002950C ONEDED ADD L3DED L3DED PR005 02960C ONEDED ADD L4DED L4DED PR005 02970C GOTO END PR005 02980C* ********** PR005 02990C* PR005 03000C REC07 TAG PR005 03010C* ********** PR005 0003020C N07N08 GOTO END PR005 03030C* ********** PR005 03040C COMM ADD L1COM L1COM 72 PR005 03050C COMM ADD L2COM L2COM 72 PR005 03060C COMM ADD L3COM L3COM 82 PR005 03070C COMM ADD L4COM L4COM 92 PR005 03080C END TAG PR005 0003090C* ********** PR005 03100C N01 SETON 41 PR005 03110C* PR005 03120CL4 SETON 92 PR005 03130ORPT E 101 93 PR005 03140O N22 CONAM 74 PR005 03150O 111 'RUN DATE' PR005 0003160O UDATE Y 120 PR005 03170O E 1 93 PR005 03180O 6 'PR0005' PR005 03190O 111 'W/E DATE' PR005 03200O WEDATEY 120 PR005 03210O E 1 93 PR005 03220O 19 'DETAIL PAY REGISTER' PR005 0003230O 120 'WEEK NO' PR005 03240O WKNUM 123 PR005 03250O 128 'PAGE' PR005 03260O PAGE Z 132 PR005 03270O N92 STA 52 PR005 03280O N92 47 'DEPT' PR005 03290O E 1 93 PR005 0003300O D 132 PR005 03310O E 1 93 PR005 03320O NLR 14 'EMPL/DEPT NAME' PR005 03330O 27 '***********' PR005 03340O 33 'HOURS' PR005 03350O 46 '************' PR005 03360O 72 '************************' PR005 0003370O 76 '****' PR005 03380O 80 'PAY' PR005 03390O 105 '************************' PR005 03400O 109 '****' PR005 03410O E 1 93 PR005 03420O 33 'RECD REG OT/DT SICK' PR005 03430O 56 'HOL VAC REGULAR' PR005 0003440O 73 'OT/DT SICK' PR005 03450O 98 'HOL VAC PIECE' PR005 03460O 119 'COMM DEDUCT' PR005 03470O 132 'COMMENT' PR005 03480O E 1 93 PR005 03490O D 132 PR005 03500OWEARNS D 41 PR005 0003510O RCD 128 PR005 03520ORPT D 1 L2 PR005 03530O NAME 30 PR005 03540O STA 9 PR005 03550O EMP 4 PR005 03560ORPT D 1 01 PR005 03570O OR 02 PR005 0003580O 02 132 'PREPAID' PR005 03590O VCPY K 91 PR005 03600O HLPY K 82 PR005 03610O SKPY K 74 PR005 03620O DXPY K 66 PR005 03630O RGPY K 57 PR005 03640O VCHR K 46 PR005 0003650O HLHR K 40 PR005 03660O SKHR K 34 PR005 03670O DXHR K 28 PR005 03680O RGHR K 22 PR005 03690O RC 14 PR005 03700O D 1 05 PR005 03710O 132 'PREPAID' PR005 0003720O DED05 K 120 PR005 03730O RC 14 PR005 03740O D 1 10 PR005 03750O DED05 K 120 PR005 03760O RC 14 PR005 03770O D 1 06 PR005 03780O ONEDEDK 120 PR005 0003790O RC 14 PR005 03800O D 1 07 PR005 03810O OR 08 PR005 03820O 08 132 'PREPAID' PR005 03830O COMM K 109 PR005 03840O RC 14 PR005 03850O* PR005 0003860OWEARNS E 23 PR005 03870O DTPAY B 97 PR005 03880O DT B 92 PR005 03890O ECWH B 83 PR005 03900O ESWH B 78 PR005 03910O EFWH B 63 PR005 03920O OTPAY B 58 PR005 0003930O VPAY B 53 PR005 03940O HPAY B 47 PR005 03950O SPAY B 42 PR005 03960O RPAY B 37 PR005 03970O OT B 31 PR005 03980O VAC B 28 PR005 03990O HOL B 24 PR005 0004000O SICK B 21 PR005 04010O REG B 18 PR005 04020O OLDWK 14 PR005 04030O EMP 12 PR005 04040O STA 8 PR005 04050O CORDIV 4 PR005 04060O 2 'P5' PR005 0004070O* PR005 04080OWEARNS T L1 20 PR005 04090O DTPAY 97 PR005 04100O DT 92 PR005 04110O ECWH 83 PR005 04120O ESWH 78 PR005 04130O EFWH 63 PR005 0004140O OTPAY 58 PR005 04150O VPAY 53 PR005 04160O HPAY 47 PR005 04170O SPAY 42 PR005 04180O RPAY 37 PR005 04190O OT 31 PR005 04200O VAC 28 PR005 0004210O HOL 24 PR005 04220O SICK 21 PR005 04230O REG 18 PR005 04240O WEEK 14 PR005 04250O 11 WKNUM 14 PR005 04260O EMP 12 PR005 04270O STA 8 PR005 0004280O CORDIV 4 PR005 04290O 2 'P5' PR005 04300ORPT T 1 L2 PR005 04310O 9 'TOTAL FOR' PR005 04320ORPT T 2 L2 PR005 04330O L1DED K 120 PR005 04340O L1COM K 109 PR005 0004350O L1VP K 91 PR005 04360O L1HP K 82 PR005 04370O L1SP K 74 PR005 04380O L1OT K 66 PR005 04390O L1RP K 57 PR005 04400O L1V K 46 PR005 04410O L1H K 40 PR005 0004420O L1S K 34 PR005 04430O L1O K 28 PR005 04440O L1R K 22 PR005 04450O 14 '*' PR005 04460O EMP 11 PR005 04470O 6 'EMPL' PR005 04480ORPT T 11 L3 PR005 0004490O L2DED K 120 PR005 04500O L2HP K 82 PR005 04510O L2OT K 66 PR005 04520O L2V K 46 PR005 04530O L2S K 34 PR005 04540O L2R K 22 PR005 04550O 9 'TOTAL FOR' PR005 0004560O T 2 L3 PR005 04570O L2COM K 109 PR005 04580O L2VP K 91 PR005 04590O L2SP K 74 PR005 04600O L2RP K 57 PR005 04610O L2H K 40 PR005 04620O L2O K 28 PR005 0004630O 15 '**' PR005 04640O STA 11 PR005 04650O 6 'DEPT' PR005 04660ORPT T 158 L4 PR005 04670O 1 ' ' PR005 04680ORPT TF 1 L4 PR005 04690O L3DED K 120 PR005 0004700O GHP K 82 PR005 04710O GOT K 66 PR005 04720O GV K 46 PR005 04730O GS K 34 PR005 04740O GR K 22 PR005 04750O 9 'TOTAL FOR' PR005 04760ORPT T 2 L4 PR005 0004770O L3COM K 109 PR005 04780O GVP K 91 PR005 04790O GSP K 74 PR005 04800O GRP K 57 PR005 04810O GH K 40 PR005 04820O GO K 28 PR005 04830O 16 '***' PR005 0004840O CORDIV 12 PR005 04850O 9 'COMPANY' PR005 04860ORPT T 158 LR PR005 04870O 1 ' ' PR005 04880ORPT TF 1 LR PR005 04890O L4DED K 120 PR005 04900O L4GHP K 82 PR005 0004910O L4GOT K 66 PR005 04920O L4GV K 46 PR005 04930O L4GS K 34 PR005 04940O L4GR K 22 PR005 04950O 12 'FINAL TOTALS' PR005 04960ORPT T 1 LR PR005 04970O L4COM K 109 PR005 0004980O L4GVP K 91 PR005 04990O L4GSP K 74 PR005 05000O L4GRP K 57 PR005 05010O L4GH K 40 PR005 05020O L4GO K 28 PR005 05030O 17 '****' PR005 ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00506000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005070ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005080/* 005090__0O L4GH K 40 PR005 05020O L4GO K 28 PR005 05030O 17 '****' PR005 ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0050600(T9 TXPR023 P999999032778(000010H S PR023 X DECK-ID B04 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR023 00030F* CALCULATES TAXES PR023 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080F* PR002300090F* *************************************************************** PR002300110F* * ************************************************* * PR002300120F* * * * * PR002300130F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR002300140F* * * * * PR002300150F* * ************************************************* * PR00230000160F* *************************************************************** PR002300170F* PR002300180F* ---- CALC OF TAXES. ---- PR002300190F* PR002300200F* MODIFIED 2/19/76 TO REMOVE SPECIAL CALIF ITEMIZED DEDUCTION PR002300210F* TABLE. ALL DEDUCTIONS ARE ASSUMED TO BE DEPENDENTS. ALSO, THE PR002300220F* VALUES IN 'TABFSC' WERE CORRECTED. (THEY USED TO BE THE SAME PR00230000230F* AS THOSE IN 'TABFMC'). PR002300240F* PR002300250F* MODIFIED 05/18/76 TO CORRECT LIMIT CALCULATIONS IN FICA; TO USE PR002300260F* VARIABLE,'FICRAT' AND 'SDIRAT' FOR FICA AND SDI CALCULATIONS. PR002300270F* PR002300280F* MODIFIED 6/24/76 TO ADD SUBROUTINE 'VALNET' TO INSURE THAT AN PR002300290F* AUTOMATIC FICA OR SDI ADJUSTMENT WILL NOT CREATE A NEGATIVE PR00230000300F* NET AMOUNT FOR THE CHECK. PR002300310F* PR002300320F* MODIFIED 06/26/76 TO ADD SUBROUTINE 'LIMDED' TO COMPUTE FICA PR002300330F* AND SDI AMOUNTS. PR002300340F* PR002300350F* MODIFIED 07/06/76 TO OUTPUT CHECK NUMBER IN P6 (COMMISSION) RECS.PR002300360F* PR00230000370F* MODIFIED 07/08/76 TO CORRECT PROBLEM WITH MULTIPLE P6 RECS FOR PR002300380F* NON-CALIFORNIANS. PR002300390F* PR002300400F* MODIFIED 08/10/76 TO CONSIDER VACATION TO BE NORMAL PART OF PR002300410F* GROSS PAY. USED TO BE CONSIDERED TO BE FROM A DIFFERENT PERIOD. PR002300420F* PR002300430F* OUTPUT - TAXES UPDATED INTO EARNINGS RECORDS PR00230000440F* PR002300450F* PR002300460F* PR002300470F* PR002300480F* PR002300490FWEARNS UP AF 140 DISK 00500FPRMAST IC F 600R10AI 2 DISK 500 PR00230000510FQTRLIM ID F 96 DISK PR002300515FCONSOL D F 80 CONSOLE PR023 00520F* PR002300530F* PR002300540F* PR002300550E AWM 1 9 7 2 00560E FWM 1 9 8 2 0000570E AWS 1 9 7 2 00580E FWS 1 9 8 2 00590E ACM 1 13 8 2 00600E FCM 1 13 8 2 00610E ACS 1 13 8 2 00620E FCS 1 13 8 2 00630E AMC 1 12 2 0 0000640E FMC 1 12 5 2 00650E ASC 1 12 2 0 00660E FSC 1 12 5 2 00670E AGM 1 8 8 2 00680E FGM 1 8 8 2 00690E AGS 1 8 8 2 00700E FGS 1 8 8 2 0000710E AGH 1 8 8 2 00720E FGH 1 8 8 2 00730E AMI 1 12 8 2 00740E FMI 1 12 9 3 00750E AMO 1 12 8 2 00760E FMO 1 12 9 3 00770E AVA 1 5 8 2 0000780E FVA 1 5 9 3 00790E AWI 1 16 8 2 00800E FWI 1 16 9 3 00810E ACH 1 13 8 2 00820E FCH 1 13 8 2 00825E ARY1 1 1 50 PR023 00830I* PR00230000840I* EMPLOYEE MASTER. PR002300850I* ---------------- PR002300860IPRMAST NS 01 PR002300870I 125 125 STAT PR002300880I 126 1270FDEP PR002300890I 128 1290SDEP PR002300900I 155 156 TAXCD PR00230000910I 157 1580PAYPRD 11 PR002300920I 393 3992AFWH PR002300930I 400 4062ASWH PR002300940I 571 5733STPCT 90 PR002300950I 574 5763FEDPCT 92 PR002300960I 110 1143HRATE PR002300970I 115 1202SRATE PR00230000980I 132 132 EMPTYP PR002300990I* PR002301000I* YTD EARNINGS. PR002301010I* ------------- PR002301020I 172 1782YRPAY PR002301030I 186 1922YHPAY PR002301040I 193 1992YVPAY PR00230001050I 315 3212YFWH 01060I 322 3282YFICA PR002301070I 329 3332YSDI PR002301080I 207 2132YCOMM PR002301090I 179 1852YSPAY PR002301100I 200 2062YOPAY PR002301110I 214 2202YDTPAY PR00230001120I* PR002301130I* WEEKLY EARNINGS. PR002301140I* ---------------- PR002301150I* 03 - PREPAID. PR002301160I* 04 - TO BE PAID. PR002301170I* PR002301180IWEARNS NS 03 1 CP 2 CN PR00230001190I OR 04 1 CP 2 C5 PR002301200I 9 12 EMP PR002301210I 32 372RPAY PR002301220I 38 422SPAY PR002301230I 43 472HPAY PR002301240I 48 532VPAY PR002301250I 54 582OPAY PR00230001260I 59 632FWH 56 PR002301270I 64 682FICA 57 PR002301280I 69 732SDI 58 PR002301290I 74 782SWH 59 PR002301300I 3 12 KEY L1 PR002301310I 93 972DTPAY PR002301320I 15 181RHRS PR00230001330I 25 281VHRS PR002301340I* PR002301350I* COMMISSIONS. PR002301360I* ------------ PR002301370I* 05 - PREPAID. PR002301380I* 06 - TO BE PAID. PR002301390I* PR00230001400I NS 05 1 CP 2 CO PR002301410I OR 06 1 CP 2 C6 PR002301420I 9 12 EMP PR002301430I 13 192COMM PR002301440I 30 342FICA PR002301450I 35 392SDI PR002301460I 46 472CFWPC 30 PR00230001470I 48 492CSWPC 31 PR002301480I 3 12 KEY L1 PR002301490I* PR002301500I* DATE CARD. PR002301510I* ---------- PR002301520I NS 99 1 C# PR002301530I 20 21 TWEEK PR00230001540I 75 800CHKNUM 91 PR002301550I* PR002301560I* UNUSED TRANSACTIONS. PR002301570I* -------------------- PR002301580I NS 10 PR002301590I 1 1 MKYMSE PR002301600IQTRLIM NS 02 PR00230001610I 1 50FICLIM PR002301620I 11 150SDILIM PR002301630C********************************************************************PR002301640C* 1ST CYCLE PROCESSING. PR002301650C* PR002301660C 98 GOTO START PR002301670C READ QTRLIM H1 PR00230001680C Z-ADD.0585 FICRAT 54 ** FICA RATE **PR002301690C Z-ADD.0100 SDIRAT 54 ** SDI RATE ***PR002301695C ARY1 DSPLYCONSOL CHKNUM PR023 01700C SETON 98 PR002301710C********************************************************************PR002301720C START TAG PR002301730C* PR00230001740C* CLEAR INDICATORS & COUNTERS. PR002301750C* ---------------------------- PR002301760C L1 YRPAY SUB YRPAY YRPAY 20 TURN OFF 20. PR002301770C L1 YHPAY SUB YHPAY YHPAY PR002301780C L1 YVPAY SUB YVPAY YVPAY PR002301790C L1 YFICA SUB YFICA YFICA PR002301800C L1 YSDI SUB YSDI YSDI PR00230001810C L1 YCOMM SUB YCOMM YCOMM PR002301820C L1 YSPAY SUB YSPAY YSPAY PR002301830C L1 YOPAY SUB YOPAY YOPAY PR002301840C L1 YGPAY SUB YGPAY YGPAY PR002301850C L1 SETOF 69 PR002301860C* CHAIN TO PAYROLL MASTER. PR002301870C* ------------------------ PR00230001880C L1 MOVEL' ' KEY * FOR SINGLE PR002301890C* COMPANY SYS'SPR002301900C L1 KEY CHAINPRMAST 22 PR002301910C 11 Z-ADD52 PAYPRD PR002301920C L1N22 2080 DIV PAYPRD HRSPD 52H PR002301930C* HRSPD = HOURS/ PAY PERIOD PR002301940C* PR00230001960C L1 CHKNUM ADD 1 CHKNUM PR002301970C 10 PR002301980COR 99 GOTO BY6 PR002301990C* ********** PR002302000C* PR002302010C* ROUTINE FOR EMPLOYEE MASTER. PR002302020C* ---------------------------- PR00230002030C N01 GOTO BY1 NOT MASTER. PR002302040C* ********** PR002302050C* PR002302060C* PR002302070C TAXCD COMP 'CA' 21 CALIFORNIA. PR002302080C TAXCD COMP 'GA' 42GEORGIA 02090C TAXCD COMP 'IL' 43ILLINOIS 0002100C TAXCD COMP 'MN' 44MINNESOTA 02110C TAXCD COMP 'MO' 45MISSOURI 02120C TAXCD COMP 'PA' 46PENNSYLVANIA 02130C TAXCD COMP 'VA' 47VIRGINIA 02140C TAXCD COMP 'WI' 48WISCONSIN 02150C* DETERMINE MARTIAL STATUS. FEDERAL PR002302160C* 70 - MARRIED. PR00230002170C SETOF 7071 71 - SINGLE. PR002302180C* PR002302190C STAT COMP 'M' 81 MARRIED. PR002302200C STAT COMP 'S' 82 SINGLE. PR002302210C STAT COMP 'H' 83HEAD-OF-HOUSE 02220C 81 SETON 70 PR002302230C 82 SETON 71 PR00230002240C* PR002302250C BY1 TAG PR002302260C* ********** PR002302270C* PR002302280C* ROUTINE FOR YTD EARNINGS. PR002302290C* ------------------------- PR002302300C N01 GOTO BY2 PR00230002310C* ********** PR002302320C* PR002302330C YGPAY ADD YRPAY YGPAY 72 CROSSFOOT PR002302340C YGPAY ADD YHPAY YGPAY YTD GROSS PR002302350C YGPAY ADD YVPAY YGPAY PAY. PR002302360C YGPAY ADD YSPAY YGPAY PR002302370C YGPAY ADD YOPAY YGPAY PR00230002380C YGPAY ADD YCOMM YGPAY PR002302390C YGPAY ADD YDTPAY YGPAY PR002302400C* PR002302410C BY2 TAG PR002302420C* ********** PR002302430C* PR002302440C* ROUTINE FOR PREPAID EARNINGS. PR00230002450C* ----------------------------- PR002302460C N03 GOTO BY3 PR002302470C* ********** PR002302480C* PR002302490C Z-ADD0 GPAY PR002302500C GPAY ADD RPAY GPAY 72 CROSSFOOT PR002302510C GPAY ADD SPAY GPAY GROSS PAY. PR00230002520C GPAY ADD HPAY GPAY PR002302530C GPAY ADD VPAY GPAY PR002302540C GPAY ADD OPAY GPAY PR002302550C GPAY ADD DTPAY GPAY PR002302560C* PR002302570C YGPAY ADD GPAY YGPAY PR002302580C* ADD WEEKS TAX PR00230002590C YFICA ADD FICA YFICA TO YTD, LIMIT PR002302600C YSDI ADD SDI YSDI TAX ONLY. PR002302610C* PR002302620C BY3 TAG PR002302630C* ********** PR002302640C* PR002302650C* ROUTINE FOR TO BE PAID EARNINGS. PR00230002660C* -------------------------------- PR002302670C N04 GOTO BY4 PR002302680C* ********** PR002302690C* PR002302700C SETON 69 PR002302710C* PR002302720C GPAY SUB GPAY GPAY PR00230002730C GPAY ADD RPAY GPAY CROSSFOOT PR002302740C GPAY ADD SPAY GPAY GROSS PAY. PR002302750C GPAY ADD HPAY GPAY PR002302760C GPAY ADD OPAY GPAY PR002302770C GPAY ADD DTPAY GPAY PR002302780C* PR002302790C VPAY ADD GPAY NET 72 TOTAL GROSS. PR00230002800C* PR002302810C P5900 TAG PR002302820C* ********** PR002302830C* PR002302840C* CALC THIS WEEKS FICA. PR002302850C* PR002302860C Z-ADDYGPAY PYG@ 82 PR00230002870C Z-ADDNET CUG@ 72 PR002302880C Z-ADDFICLIM DLG@ 72 PR002302890C Z-ADDFICRAT DRT@ 54 PR002302900C Z-ADD0 CUD@ 62 PR002302910C Z-ADDYFICA PYD@ 72 PR002302920C EXSR LIMDED PR002302930C Z-ADDCUD@ FICA PR00230002940C YFICA ADD FICA YFICA PR002302950C* PR002302960C* CALCULATE THIS WEEKS SDI. PR002302970C* PR002302980C N21 GOTO BYSDI CALIF EMPL. PR002302990C* ********** PR002303000C Z-ADDSDILIM DLG@ PR00230003010C Z-ADDSDIRAT DRT@ PR002303020C Z-ADDYSDI PYD@ PR002303030C EXSR LIMDED PR002303040C Z-ADDCUD@ SDI PR002303050C YSDI ADD SDI YSDI PR002303060C* PR002303070C* PR00230003080C* PR002303090C BYSDI TAG PR002303100C* ********** PR002303110C YGPAY ADD NET YGPAY PR002303120C Z-ADD0 DEP 20 PR002303130C* PR002303140C* IF THIS COMMISSION CARD, RETURN TO COMMISSION ROUTINE. PR00230003150C* PR002303160C 06 GOTO RET06 PR002303170C* ********** PR002303180C Z-ADDNET PAYTAX PR002303190C* PR002303200C Z-ADD0 DEP PR002303210C SETOF 6164 PR00230003220C* PR002303230C* CALC FEDERAL W/H. PR002303240C* PR002303250C Z-ADDNET TAXPAY PR002303260C Z-ADDFDEP DEP PR002303270C* PR002303280C* PR00230003290C N92 TAXPAY MULT FEDPCT TAXPAY 72H PR002303300C N92 FWH ADD TAXPAY FWH PR002303310C N92 GOTO ENDFWH 03320C* ********** PR002303330C TAXPAY MULT PAYPRD TAXPAY PR002303340C* *** WKLY *** PR002303350C Z-ADD750.00 WORK5 62 PER DEP. PR00230003360C WORK5 MULT DEP WORK07 72 EXEMPT AMT. PR002303370C TAXPAY SUB WORK07 TAXPAY 25 PR002303380C N25 GOTO ENDFWH 03390C* ********** PR002303400C* ********** PR002303410C* PR002303430C* SINGLE. PR00230003440C Z-ADD1 X 20 03450C A TAG 03460C N70 TAXPAY COMP AWS,X 88 03470C N70N88 X ADD 1 X 03480C N70 X COMP 9 89 03490C N70N88N89 GOTO A 03500C N70 89 GOTO ENDFWH 0003510C N70 X SUB 1 X 03520C N70 MOVE FWS,X PERCNT 03530C N70 MOVELFWS,X WORK6 03540C SETON 25 03550C N70 25 TAXPAY SUB AWS,X TAXPAY TAXABLE EXCESSPR002303560C N70 25 GOTO CALCFW PR002303570C* ********** PR00230003580C* MARRIED. PR002303590C Z-ADD1 X 03600C A1 TAG 03610C 70 TAXPAY COMP AWM,X 88 03620C 70N88 X ADD 1 X 03630C 70 X COMP 9 89 03640C 70N88N89 GOTO A1 0003650C 70 89 GOTO ENDFWH 03660C 70 X SUB 1 X 03670C 70 MOVE FWM,X PERCNT 03680C 70 MOVELFWM,X WORK6 03690C 70 SETON 25 03700C 70 25 TAXPAY SUB AWM,X TAXPAY 03710C 70 25 GOTO CALCFW PR00230003720C* ********** PR002303730C* PR002303740C CALCFW TAG PR002303750C* ********** PR002303760C* PR002303770C TAXPAY MULT PERCNT TAXPAY H THIS WEEKS PR002303780C TAXPAY ADD WORK6 TAXPAY 24 FEDERAL W/H. PR00230003790C N24 TAXPAY DIV PAYPRD TAXPAY PR002303800C FWH ADD TAXPAY FWH PR002303810C ENDFWH TAG 03820C* PR002303830C* CALC THIS WEEKS STATE W/H. PR002303840C N90 PAYTAX MULT STPCT PAYTAX H PR002303850C N90 SWH ADD PAYTAX SWH PR00230003860C N90 GOTO BYCWH PR002303870C* ********** PR002303880C Z-ADDSDEP DEP PR002303890C* PR002303900C* PR002303910C* MUTIPLY THIS WEEKS PAY FOR COMPUTING ON ANNUAL BASIS. PR002303920C* PR00230003930C PAYTAX MULT PAYPRD PAYTAX 82 PR002303940C N21 GOTO BYCWH CALIF. A EMPL. PR002303950C* ********** PR002303960C* PR002303970C SETOF 88 03980C DEP COMP 02 25 PR002303990C 82 0004000COR 81 25 PAYTAX COMP 5000.00 8888 04010C 88 GOTO BYCWH 04020C 83 04030COR 81N25 PAYTAX COMP 10000.00 8888 04040C 88 GOTO BYCWH 04050C 25 81 PAYTAX SUB 1000.00 PAYTAX 24 PR002304060C N25 81 PAYTAX SUB 2000.00 PAYTAX 24 PR00230004070C 82 PAYTAX SUB 1000.00 PAYTAX 24 04080C 83 PAYTAX SUB 2000.00 PAYTAX 24 04090C N24 GOTO BYCWH PR002304100C* ********** PR002304110C* PR002304120C N81 GOTO BYCMAR NOT MARRIED. PR002304130C* ********** PR00230004140C* PR002304150C Z-ADD1 X 04160C A2 TAG 04170C PAYTAX COMP ACM,X 88 04180C N88 X ADD 1 X 04190C X COMP 13 89 04200C N88N89 GOTO A2 0004210C 89 GOTO BYCWH 04220C X SUB 1 X 04230C MOVE FCM,X PERCNT 22 04240C MOVELFCM,X WORK6 62 04250C PAYTAX SUB ACM,X PAYTAX 04260C* PR002304270C Z-ADD1 X 0004280C A3 TAG 04290C DEP COMP AMC,X 88 04300C N88 X ADD 1 X 04310C X COMP 12 89 04320C N88N89 GOTO A3 04330C 89 Z-ADD114.00 WORK06 62 04340C N89 Z-ADDFMC,X WORK06 0004350C GOTO BYCSIN PR002304360C* ********** PR002304370C BYCMAR TAG PR002304380C* ********** PR002304390C* PR002304400C N82 GOTO BYCHOH 04410C Z-ADD1 X 0004420C A4 TAG 04430C PAYTAX COMP ACH,X 88 04440C N88 X ADD 1 X 04450C X COMP 13 89 04460C N88N89 GOTO A4 04470C 89 GOTO BYCWH 04480C X SUB 1 X 0004490C MOVE FCH,X PERCNT 04500C MOVELFCH,X WORK6 04510C PAYTAX SUB ACH,X PAYTAX 04520C Z-ADD1 X 04530C A5 TAG 04540C DEP COMP AMC,X 88 04550C N88 X ADD 1 X 0004560C X COMP 12 89 04570C N88N89 GOTO A5 04580C 89 Z-ADD114.00 WORK06 04590C N89 Z-ADDFMC,X WORK06 04600C GOTO BYCSIN 04610C BYCHOH TAG 04620C* PR00230004630C Z-ADD1 X 04640C A6 TAG 04650C PAYTAX COMP ACS,X 88 04660C N88 X ADD 1 X 04670C X COMP 13 89 04680C N88N89 GOTO A6 04690C 89 GOTO BYCSIN 0004700C X SUB 1 X 04710C MOVE FCS,X PERCNT 04720C MOVELFCS,X WORK6 04730C PAYTAX SUB ACS,X PAYTAX 04740C* PR002304750C Z-ADD1 X 04760C A7 TAG 0004770C DEP COMP ASC,X 88 04780C N88 X ADD 1 X 04790C X COMP 12 89 04800C N88N89 GOTO A7 04810C 89 Z-ADD114.00 WORK06 04820C N89 Z-ADDFSC,X WORK06 04830C BYCSIN TAG PR00230004840C* ********** PR002304850C* PR002304860C N25 GOTO BYCWH PR002304870C* ********** PR002304880C* PR002304890C PAYTAX MULT PERCNT PAYTAX H PR002304900C PAYTAX ADD WORK6 PAYTAX PR00230004910C PAYTAX SUB WORK06 PAYTAX 24 PR002304920C 24 PAYTAX DIV PAYPRD PAYTAX PR002304930C 24 SWH ADD PAYTAX SWH PR002304940C* PR002304950C BYCWH TAG PR002304960C* ********** PR002304970C N42 GOTO BYGWH GEORGIA 0004980C PAYTAX MULT .15 WORK82 82H PERCENTAGE 04990C 81 WORK82 COMP 650.00 89 METHOD 05000C 89 81 PAYTAX SUB 650.00 PAYTAX 05010C 81 WORK82 COMP 1000.00 88 05020C 88 81 PAYTAX SUB 1000.00 PAYTAX 05030C N89N88 81PAYTAX SUB WORK82 PAYTAX 05040C 83 0005050COR 82 WORK82 COMP 1300.00 89 05060C 83 89 05070COR 82 89 PAYTAX SUB 1300.00 PAYTAX 05080C 83 05090COR 82 WORK82 COMP 2000.00 88 05100C 83 88 05110COR 82 88 PAYTAX SUB 2000.00 PAYTAX 0005120C 83N89N88 05130COR 82N89N88PAYTAX SUB WORK82 PAYTAX 05140C 81 PAYTAX SUB 1500.00 PAYTAX 24 05150C 82 PAYTAX SUB 1500.00 PAYTAX 24 05160C 83 PAYTAX SUB 3000.00 PAYTAX 24 05170C DEP MULT 700.00 WORK82 05180C PAYTAX SUB WORK82 PAYTAX 24 PR00230005190C N81 GOTO BYGM 05200C N24 GOTO BYGM 05210C Z-ADD1 X 05220C A8 TAG 05230C PAYTAX COMP AGM,X 88 05240C N88 X ADD 1 X 05250C X COMP 8 89 0005260C N88N89 GOTO A8 05270C 89 GOTO BYGM 05280C X SUB 1 X 05290C MOVE FGM,X PERCNT 05300C MOVELFGM,X WORK6 05310C PAYTAX SUB AGM,X PAYTAX 05320C SETON 25 0005330C 25 EXSR SUBSWT 05340C BYGM TAG 05350C N82 GOTO BYGS 05360C N24 GOTO BYGS 05370C Z-ADD1 X 05380C A9 TAG 05390C PAYTAX COMP AGS,X 88 0005400C N88 X ADD 1 X 05410C X COMP 8 89 05420C N88N89 GOTO A9 05430C 89 GOTO BYGS 05440C X SUB 1 X 05450C MOVE FGS,X PERCNT 05460C MOVELFGS,X WORK6 0005470C PAYTAX SUB AGS,X PAYTAX 05480C SETON 25 05490C 25 EXSR SUBSWT 05500C BYGS TAG 05510C N83 GOTO BYGWH 05520C N24 GOTO BYGWH 05530C Z-ADD1 X 0005540C A10 TAG 05550C PAYTAX COMP AGH,X 88 05560C N88 X ADD 1 X 05570C X COMP 8 89 05580C N88N89 GOTO A10 05590C 89 GOTO BYGWH 05600C X SUB 1 X 0005610C MOVE FGH,X PERCNT 05620C MOVELFGH,X WORK6 05630C PAYTAX SUB AGH,X PAYTAX 05640C SETON 25 05650C 25 EXSR SUBSWT 05660C BYGWH TAG 05670C N43 GOTO BYILWH ILLINOIS 0005680C DEP MULT 1000 WORK82 DIRECT 05690C PAYTAX SUB WORK82 PAYTAX PERCENTAGE 05700C PAYTAX MULT .025 PAYTAX 05710C PAYTAX DIV PAYPRD SWH 05720C BYILWH TAG 05730C N44 GOTO BYMIWH MINNESOTA 05740C SETOF 8988 0005750C DEP COMP 02 89 05760C 89 PAYTAX COMP 1000.00 8888 05770C 88 GOTO BYMIWH 05780C N89 PAYTAX COMP 1800.00 8888 05790C 88 GOTO BYMIWH 05800C SETOF 8988 05810C PAYTAX SUB FWH PAYTAX 0005820C PAYTAX SUB YFWH PAYTAX 05830C PAYTAX MULT .10 WORK82 05850C PAYTAX SUB WORK82 PAYTAX 24 PR002305860C N24 GOTO BYMIWH PR002305870C Z-ADD1 X 05880C A11 TAG 05890C PAYTAX COMP AMI,X 88 0005900C N88 X ADD 1 X 05910C X COMP 12 89 05920C N88N89 GOTO A11 05930C 89 GOTO BYMIWH 05940C X SUB 1 X 05950C MOVE FMI,X PERC03 33 05960C MOVELFMI,X WORK6 0005970C PAYTAX SUB AMI,X PAYTAX 05980C SETON 25 05990C 25 PAYTAX MULT PERC03 PAYTAX H 06000C 25 PAYTAX ADD WORK6 PAYTAX 06010C 25 DEP MULT 21.00 WORK6 06020C 25 PAYTAX SUB WORK6 PAYTAX 06030C 25 PAYTAX DIV PAYPRD PAYTAX 0006040C 25 SWH ADD PAYTAX SWH 06050C BYMIWH TAG 06060C N45 GOTO BYMOWH MISSOURI 06070C 82 GOTO BYMIA 06080C PAYTAX COMP 5937.00 8989 06090C 89 PAYTAX SUB 950.00 PAYTAX 06100C N89 PAYTAX MULT .16 WORK82 H 0006110C N89 PAYTAX SUB WORK82 PAYTAX 06120C BYMIA TAG 06130C 82 PAYTAX COMP 10000.00 8989 06140C 82 89 PAYTAX SUB 1600.00 PAYTAX 06150C 82N89 PAYTAX MULT .16 WORK82 H 06160C 82N89 PAYTAX SUB WORK82 PAYTAX 06170C 81 0006180COR 83 PAYTAX SUB 2400.00 PAYTAX 06190C 83 PAYTAX SUB 800.00 PAYTAX 06200C 82 PAYTAX SUB 1200.00 PAYTAX 06210C DEP MULT 400.00 WORK82 06220C PAYTAX SUB WORK82 PAYTAX 06230C PAYTAX SUB FWH PAYTAX 06240C PAYTAX SUB YFWH PAYTAX 24 TAXABLE INCOME PR00230006245C N24 GOTO BYMOWH PR002306250C Z-ADD1 X 06260C A12 TAG 06270C PAYTAX COMP AMO,X 88 06280C N88 X ADD 1 X 06290C X COMP 12 89 06300C N88N89 GOTO A12 0006310C 89 GOTO BYMOWH 06320C X SUB 1 X 06330C MOVE FMO,X PERC03 06340C MOVELFMO,X WORK6 06350C PAYTAX SUB AMO,X PAYTAX 06360C SETON 25 06370C 25 PAYTAX MULT PERC03 PAYTAX 0006380C 25 PAYTAX ADD WORK6 PAYTAX 06390C 25 PAYTAX DIV PAYPRD PAYTAX 06400C 25 SWH ADD PAYTAX SWH 06410C BYMOWH TAG 06420C N46 GOTO BYPAWH PENN TAX 06430C PAYTAX MULT .02 PAYTAX 06440C PAYTAX DIV PAYPRD PAYTAX 0006450C SWH ADD PAYTAX SWH 06460C BYPAWH TAG 06470C N47 GOTO BYVAWH VIRGINIA TAX 06480C DEP MULT 600.00 WORK82 06490C PAYTAX SUB 650.00 PAYTAX 06500C PAYTAX SUB WORK82 PAYTAX 24 PR002306505C N24 GOTO BYVAWH PR00230006510C Z-ADD1 X 06520C A13 TAG 06530C PAYTAX COMP AVA,X 88 06540C N88 X ADD 1 X 06550C X COMP 5 89 06560C N88N89 GOTO A13 06570C 89 GOTO BYVAWH 0006580C X SUB 1 X 06590C MOVE FVA,X PERC03 06600C MOVELFVA,X WORK6 06610C PAYTAX SUB AVA,X PAYTAX 06620C SETON 25 06630C 25 PAYTAX MULT PERC03 PAYTAX 06640C 25 PAYTAX ADD WORK6 PAYTAX 0006650C 25 PAYTAX DIV PAYPRD PAYTAX 06660C 25 SWH ADD PAYTAX SWH 06670C BYVAWH TAG 06680C N48 GOTO BYWIWH 06690C PAYTAX MULT .15 WORK82 WISCONSIN 06700C WORK82 COMP 1300.00 89 06710C 89 PAYTAX SUB WORK82 PAYTAX 0006720C N89 PAYTAX SUB 1300.00 PAYTAX 24 PR002306725C N24 GOTO BYMIWH PR002306730C Z-ADD1 X 06740C A14 TAG 06750C PAYTAX COMP AWI,X 88 06760C N88 X ADD 1 X 06770C X COMP 16 89 0006780C N88N89 GOTO A14 06790C 89 GOTO BYWIWH 06800C X SUB 1 X 06810C MOVE FWI,X PERC03 06820C MOVELFWI,X WORK6 06830C PAYTAX SUB AWI,X PAYTAX 06840C SETON 25 0006850C 25 PAYTAX MULT PERC03 PAYTAX 06860C 25 PAYTAX ADD WORK6 PAYTAX 06870C DEP MULT 20.00 WORK82 06880C PAYTAX SUB WORK82 PAYTAX 06890C PAYTAX DIV PAYPRD PAYTAX 06900C PAYTAX ADD SWH SWH 06910C BYWIWH TAG 0006920C* PR002306930C* SEE IF ADDITIONAL TAX CAN BE TAKEN. PR002306940C* PR002306950C TRYTAX TAG PR002306960C* ********** PR002306970C* PR002306980C NET SUB FWH NET PR00230006990C NET SUB SWH NET PR002307000C NET SUB FICA NET PR002307010C NET SUB SDI NET PR002307020C* PR002307030C NET SUB AFWH TNET 72 62 PR002307040C 62 NET SUB AFWH NET PR002307050C 62 FWH ADD AFWH FWH PR00230007060C* PR002307070C NET SUB ASWH TNET 62 PR002307080C 62 SWH ADD ASWH SWH PR002307090C 62 NET SUB ASWH NET PR002307100C* PR002307110C BY4 TAG PR002307120C* ********** PR00230007130C* PR002307140C* ROUTINE FOR PREPAID COMMISSIONS. PR002307150C* -------------------------------- PR002307160C N05 GOTO BY5 PR002307170C* ********** PR002307180C* PR002307190C YFICA ADD FICA YFICA PR00230007200C YSDI ADD SDI YSDI PR002307210C YGPAY ADD COMM YGPAY PR002307220C* PR002307230C BY5 TAG PR002307240C* ********** PR002307250C* PR002307260C* ROUTINE FOR COMMISSION TO BE PAID. PR00230007270C* ---------------------------------- PR002307280C N06 GOTO BY6 PR002307290C* ********** PR002307300C* PR002307310C Z-ADDCOMM GPAY PR002307320C Z-ADDCOMM NET PR002307330C SETON 69 PR00230007340C* PR002307350C* BRANCH TO PAGE 59, LINE 00 TO CALCULATE FICA & SDI. PR002307360C* PR002307370C GOTO P5900 PR002307380C* ********** PR002307390C* PR002307400C RET06 TAG PR00230007410C* ********** PR002307420C 30 Z-ADDSTPCT CSWPC GET W/H PCT'S PR002307430C 31 Z-ADDFEDPCT CFWPC FROM PRMAST IF PR002307440C* NOT FROM P6 IF PR002307450C COMM MULT CFWPC CFWH 72H PR002307460C COMM MULT CSWPC CSWH 62H PR002307470C NET SUB CFWH NET PR00230007480C NET SUB CSWH NET PR002307490C NET SUB FICA NET PR002307500C NET SUB SDI NET PR002307510C* PR002307520C BY6 TAG PR002307530C* ********** PR002307540C 04 PR00230007550COR 06 EXSR VALNET PR002307560CL1N69 CHKNUM SUB 1 CHKNUM PR002307570C***************************************************** VALNET PR002307580CSR VALNET BEGSR PR002307590CSR Z-ADDGPAY D72 62 62 GROSS<0? PR002307600CSR 62 Z-ADDNET D72 72 62 IS NET<0? PR002307610CSRN62 GOTO ENDVAL NO, OK. PR00230007620CSR NET ADD SDI NET YES-PUT SDI & PR002307630CSR NET ADD FICA NET FICA BACK IN. PR002307640CSR NET COMP 0 62 STILL NEG ? PR002307650CSR YFICA SUB FICA YFICA YES, ZERO THEM PR002307660CSR YSDI SUB SDI YSDI PR002307670CSR 62 Z-ADD0 FICA PR002307680CSR 62 Z-ADD0 SDI PR00230007690CSR 62 GOTO ENDVAL PR002307700CSR NET MULT .854 FICA H RE CAL FICA & PR002307710C******* SDI. FICA= 85.4 % PR002307720CSR NET SUB FICA SDI SDI = 14.6% PR002307730CSR YFICA ADD FICA YFICA OF REM NET PR002307740CSR YSDI ADD SDI YSDI PR002307750CSR ENDVAL ENDSR PR00230007760C********************************************************************PR002307770C* SUBROUTINE TO COMPUTE FICA & SDI. PR002307780C* PR002307790C* INPUT... PYG@ = PREV YTD GROSS. PR002307800C* CUG@ = CURRENT GROSS PR002307810C* DLG@ = DEDUCTION GROSS LIMIT AMOUNT. PR002307820C* DRT@ = RATE FOR THIS DEDUCTION. PR00230007830C* PYD@ = PREV YTD DEDUCTION AMOUNT. PR002307840C* PR002307850C* OUTPUT... CUD@ = CURRENT DEDUCTION AMOUNT. PR002307860C* PR002307870C* PR002307880CSR LIMDED BEGSR PR002307890C*************** PR00230007900C** LOGIC... PR002307910C* LET A = PREV YTD DED + (CURR GROSS * DED RATE) PR002307920C* B = NEW YTD GROSS * DED RATE PR002307930C* L = CUTOFF LIMIT FOR YTD DED AMOUNT PR002307940C* PR002307950C* IF (A = B) AND (A LE L), THEN LET CUD@ = A - PREV YTD DED PR002307960C* PR00230007970C* IF (A NE B) AND (A LE L) AND (B LE L), PR002307980C* THEN LET CUD@ = B - PREV YTD DED ; PR002307990C* PR002308000C* OTHERWISE, LET CUD@ = L - PREV YTD DED. PR002308010C* PR002308020CSR CUG@ MULT DRT@ A 72H PR002308030CSR A ADD PYD@ A PR00230008040CSR PYG@ ADD CUG@ B 72 PR002308050CSR B MULT DRT@ B H PR002308060CSR DLG@ MULT DRT@ L 72H PR002308070CSR A COMP B 32 PR002308080CSR A COMP L 3333 PR002308090CSR B COMP L 3434 PR002308100CSR L SUB PYD@ CUD@ PR00230008110CSR 32 33 A SUB PYD@ CUD@ PR002308120CSRN32 33 34B SUB PYD@ CUD@ PR002308130CSR ENDSR PR002308140CSR SUBSWT BEGSR 08150CSR PAYTAX MULT PERCNT PAYTAX H 08170CSR PAYTAX ADD WORK6 PAYTAX 08190CSR PAYTAX DIV PAYPRD PAYTAX 0008210CSR SWH ADD PAYTAX SWH 08230CSR ENDSR 08240O* PR002308250O* UPDATE TO BE PAID EARNINGS WITH TAXES PR002308260O* ----------------------------------- PR002308270OWEARNS D 04 PR002308280O 59 SWH B 78 PR00230008290O 58 SDI B 73 PR002308300O 57 FICA B 68 PR002308310O 56 FWH B 63 PR002308320O CHKNUMX 89 PR002308330O* PR002308340O* UPDATE TAXES IN COMMISSION RECORDS PR002308350O* --------------------------- PR00230008360OWEARNS D 06 PR002308370O CFWH 29 PR002308380O FICA 34 PR002308390O SDI 39 PR002308400O CSWH 45 PR002308410O CHKNUM 89 PR0023** 0842000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 08430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 08440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 08450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 08460** 084700000000 084800315000 08490000545000 085001157500 085101445000 085201845000 085302245000 085402645000 085509999999 0856000** 0857000000000 0858000000015 0859003450018 0860014475022 0861020800025 0862030800025 086300042000032 0864054800036 0865099999999 08660** 086700000000 086800170000 086900359000 08700000745000 087100945000 087201145000 087301545000 087401845000 087509999999 08760** 087700000000000 0878000000016 0879003600018 0880009900022 0881014300024 0882019100028 0883030300032 088400039900036 0885099999999 08860** 0887000000000 0888000000100 0889000400000 0890000700000 089100001000000 0892001300000 0893001600000 0894001900000 0895002200000 0896002500000 0897002800000 089800003100000 0899099999999 09000** 0901000000000 0902000000001 0903000400002 0904001000003 090500001900004 0906003100005 0907004600006 0908006400007 0909008500008 0910010900009 0911013600010 091200016600011 0913099999999 09140** 0915000000000 0916000000100 0917000200000 0918000350000 091900000500000 0920000650000 0921000800000 0922000950000 0923001100000 0924001250000 0925001400000 092600001550000 0927099999999 09280** 0929000000000 0930000000001 0931000200002 0932000500003 093300000950004 0934001550005 0935002300006 0936003200007 0937004250008 0938005450009 0939006800010 094000008300011 0941099999999 09420** 0943000 0944001 0945002 0946003 094700004 0948005 0949006 0950007 0951008 0952009 0953010 095400099 09550** 0956000000 0957002500 0958005000 0959005800 0960006600 096100007400 0962008200 0963009000 0964009800 0965010600 0966011400 0967099999 0968000** 0969000 0970001 0971002 0972003 0973004 0974005 097500006 0976007 0977008 0978009 0979010 0980099 09810** 098200000000 0983002500 0984003300 0985004100 0986004900 0987005700 0988006500 098900007300 0990008100 0991008900 0992009700 0993099999 09940** 0995000000000 099600000000100 0997000050000 0998000150000 0999000250000 1000000350000 1001000500000 1002099999999 1003000** 1004000000000 1005000000001 1006000050002 1007000250003 1008000550004 1009000950005 101000001700006 1011099999999 10120** 1013000000000 1014000000100 1015000075000 1016000225000 101700000375000 1018000525000 1019000700000 1020099999999 10210** 1022000000000 1023000000001 102400000075002 1025000375003 1026000825004 1027001425005 1028002300006 1029099999999 10300** 103100000000000 1032000000100 1033000100000 1034000300000 1035000500000 1036000700000 1037001000000 103800099999999 10390** 1040000000000 1041000000001 1042000100002 1043000500003 01100004 104500001900005 1046003400006 1047099999999 10480** 1049000000000 1050000000100 1051000050000 105200000100000 1053000200000 1054000300000 1055000400000 1056000500000 1057000700000 1058000900000 105900001250000 1060099999999 10610** 10620000000000 10630000000016 10640000800022 10650001900035 1066000005400058 10670011200073 10680018500088 10690027300102 10700047700115 10710070700128 10720115500140 1073000999999999 10740** 1075000000000 1076000000100 1077000100800 1078000201600 1079000302400 108000000403200 1081000504000 1082000604800 1083000705600 1084000806400 1085000907200 1086099999999 1087000** 10880000000000 10890000000015 10900001512020 10910003528025 10920006048030 10930009072035 1094000012600040 10950016632045 10960021169050 10970026208055 10980031722060 10990999999999 11000** 110100000000000 1102000300000 1103000500000 1104001200000 1105099999999 11060** 11070000000020 1108000006000030 11090012000050 11100047000058 11110999999999 11120** 1113000000000 1114000100000 111500000200000 1116000300000 1117000400000 1118000500000 1119000600000 1120000700000 1121000800000 112200000900000 1123001000000 1124001100000 1125001200000 1126001300000 1127001400000 1128099999999 1129000** 11300000000031 11310003100034 11320006500036 11330010100048 11340014900054 11350020300059 1136000026200065 11370032700076 11380040300082 11390048500088 11400057900093 11410066600099 11420076500105 1143000087000111 11440098100114 11450999999999 11460** 1147000000000 1148000000100 1149000400000 115000000600000 1151000750000 1152000900000 1153001050000 1154001200000 1155001350000 1156001500000 115700001650000 1158001800000 1159099999999 11600** 1161000000000 1162000000001 1163000400002 116400000800003 1165001250004 1166001850005 1167002600006 1168003500007 1169004550008 1170005750009 117100007100010 1172008600011 1173099999999 11740** ENTER BEGINNING CHECK NO. /* 11750__0009 117100(V. QTXPR025 P999999111111(000010H S PR025 00020X DECK-ID B05 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR025 00030F* AUDIT OF VOLUNTARY DEDUCTIONS - PRINT DEDS NOT TAKEN PR025 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR025 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR025 00060F* CONTROL DATA PROPRIETARY PRODUCT PR025 00070F* PR025 0000080F* PR025 00090F* *************************************************************** PR025 00100F* * ******************************************************** PR025 00110F* * * * * PR025 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR025 00130F* * * * * PR025 00140F* * ******************************************************** PR025 0000150F* *************************************************************** PR025 00160F* PR025 00170F* ---- AUDIT OF MISC DEDUCTIONS. ---- PR025 00180F* PR025 00190F* PR025 00200F* PR025 00210F* MODIFIED 8/23/76 TO OUTPUT PREPAID DEDUCTIONS TO 'DEDUCT' FILE. PR025 0000220F* PR025 00230F* PR025 00240F* PR025 00250FWEARNS IP AF 140 140 DISK PR025 00260FEARNSW O F 140 140 DISK PR025 00270FDEDUCT O F 60 DISK PR025 00280FPRMAST IC F 600R10AI 2 DISK PR025 0000290FRPT O F 132 132 OF LPRINTER PR025 00300FCNMAST IC F 128 128R 2AI 1 DISK PR025 00310E TABRC 7 7 2 TABSC 2 REC CD/ SORT CD PR025 00320E A 13 7 2 PR025 00330E* PR025 00340LRPT 66FL 58OL PR025 00350ICNMAST NS 05 PR025 0000360I 5 40 CONAME PR025 00370I* PR025 00380I* EMPLOYEE MASTER. PR025 00390I* ---------------- PR025 00400IPRMAST NS 01 PR025 00410I 014 033 NAME PR025 00420I 131 131 TCODE PR025 0000430I 012 013 FI PR025 00440I 101 1090SOCSEC PR025 00450I 414 4202RCU 33 PR025 00460I 421 4272RBOND 34 PR025 00470I 428 4342RUN 35 PR025 00480I 435 4412RLI 36 PR025 00490I 442 4482RHI 37 PR025 0000500I 449 4552RPADV 38 PR025 00510I 456 4602REQUIP 39 PR025 00520I 461 4652RSP 41 PR025 00530I 466 4702RPEN 42 PR025 00540I 471 4752RMISC 43 PR025 00550I 476 482 A,3 PR025 00560I 483 489 A,4 PR025 0000570I 490 496 A,5 PR025 00580I 497 503 A,6 PR025 00590I 504 510 A,7 PR025 00600I 511 517 A,8 PR025 00610I 518 524 A,9 PR025 00620I 526 532 A,10 PR025 00630I 533 539 A,11 PR025 0000640I 540 546 A,12 PR025 00650I* PR025 00660I* WEEKLY EARNINGS. PR025 00670I* ---------------- PR025 00680I* 04 = TO BE PAID. PR025 00690I* PR025 00700IWEARNS NS 04 1 CP 2 C5 PR025 0000710I 9 120EMP L1 PR025 00720I 5 80DEPT L2 PR025 00730I 3 40LOC L3 PR025 00740I 32 372RPAY PR025 00750I 38 422SPAY PR025 00760I 43 472HPAY PR025 00770I 48 532VPAY PR025 0000780I 54 582OPAY PR025 00790I 59 632FWH PR025 00800I 64 682FICA PR025 00810I 69 732SDI PR025 00820I 74 782SWH PR025 00830I 1 140 RCD PR025 00840I 3 12 KEY PR025 0000850I 93 972DPAY PR025 00860I 79 832CWH PR025 00870I 101 1052PPAY PR025 00880I* PR025 00890I* COMMISSIONS. PR025 00900I* ------------ PR025 00910I* 06 = TO BE PAID. PR025 0000920I* PR025 00930I NS 06 1 CP 2 C6 PR025 00940I 9 120EMP L1 PR025 00950I 5 80DEPT L2 PR025 00960I 3 40LOC L3 PR025 00970I 13 192COMM PR025 00980I 23 292CFWH PR025 0000990I 30 342FICA PR025 01000I 35 392SDI PR025 01010I 40 452CSWH PR025 01020I 1 140 RCD PR025 01030I 3 12 KEY PR025 01040I* PR025 01050I* ONE TIME DEDUCTIONS. PR025 0001060I* -------------------- PR025 01070I NS 09 1 CP 2 C8 PR025 01080I 9 120EMP L1 PR025 01090I 5 80DEPT L2 PR025 01100I 3 40LOC L3 PR025 01110I 15 16 DCODE PR025 01120I 17 222AMT PR025 0001130I 3 12 KEY PR025 01140I* PR025 01150I* DATE CARD. PR025 01160I* ---------- PR025 01170I NS 11 1 C# PR025 01180I 11 160WEDATE PR025 01190I 20 210TWEEK PR025 0001200I 1 140 RCD PR025 01210I 25 25 T3 PR025 01220I 26 26 T4 PR025 01230I 27 27 T5 PR025 01240I 28 28 T6 PR025 01250I 29 29 T7 PR025 01260I 30 30 T8 PR025 0001270I 31 31 T9 PR025 01280I 32 32 TA PR025 01290I 33 33 TB PR025 01300I 34 34 TC PR025 01310I NS 08 1 CP 2 CP PR025 01320I 9 120EMP L1 PR025 01330I 5 80DEPT L2 PR025 0001340I 3 40LOC L3 PR025 01350I 26 312ICU PR025 01360I 32 372IBOND PR025 01370I 38 432IUN PR025 01380I 44 492ILI PR025 01390I 50 552IHI PR025 01400I 56 612IPADV PR025 0001410I 62 662IEQUIP PR025 01420I 67 712ISP PR025 01430I 72 762IPEN PR025 01440I 77 812IMISC PR025 01450I 1 140 RCD PR025 01460I* PR025 01470I* UNUSED TRANSACTIONS. PR025 0001480I* -------------------- PR025 01490I NS 07 PR025 01500I 1 140 RCD PR025 01510C 07 GOTO BY9 PR025 01520C* ********** PR025 01530C L3 MOVELLOC KEY2 4 PR025 01540C L3 LOC CHAINCNMAST 50 PR025 0001550C 11 T3 COMP 'Y' 33 PR025 01560C 11 T4 COMP 'Y' 34 PR025 01570C 11 T5 COMP 'Y' 35 PR025 01580C 11 T6 COMP 'Y' 36 PR025 01590C 11 T7 COMP 'Y' 37 PR025 01600C 11 T8 COMP 'Y' 38 PR025 01610C 11 T9 COMP 'Y' 39 PR025 0001620C 11 TA COMP 'Y' 41 PR025 01630C 11 TB COMP 'Y' 42 PR025 01640C 11 TC COMP 'Y' 43 PR025 01650C* PR025 01660C L1 SETOF 21 PR025 01670C* PR025 01680C* CLEAR INDICATORS & FIELDS. PR025 0001690C* ---------------------------- PR025 01700C L1 SETOF 20 PR025 01710C* PR025 01720C L1 Z-ADD0 ENET PR025 01730C L2 MOVE DEPT PDEP 4 PR025 01740C OF MOVE DEPT PDEP PR025 01750C* PR025 0001760C L1N01 Z-ADD0 RCU PR025 01770C L1N01 Z-ADD0 RBOND PR025 01780C L1N01 Z-ADD0 RUN PR025 01790C L1N01 Z-ADD0 RLI PR025 01800C L1N01 Z-ADD0 RHI PR025 01810C L1N01 Z-ADD0 RPADV PR025 01820C L1N01 Z-ADD0 REQUIP PR025 0001830C L1N01 Z-ADD0 RSP PR025 01840C L1N01 Z-ADD0 RPEN PR025 01850C L1N01 Z-ADD0 RMISC PR025 01860C* PR025 01870C* RETRIEVE P/R MASTER RECORD. PR025 01880C* PR025 01890C L1 MOVEL' ' KEY PR025 0001900C L1 KEY CHAINPRMAST 22 PR025 01910C L1 Z-ADD0 RAFWH 62 PR025 01920C L1 Z-ADD0 RASWH 62 PR025 01930C L1 Z-ADD0 RACWH 62 PR025 01940C L1 PR025 01950COR OF MOVE EMP PEMP 4 PR025 01960C N08 GOTO BY8 PR025 0001970C ICU ADD PCU PCU 62 PR025 01980C IBOND ADD PBOND PBOND 62 PR025 01990C IUN ADD PUN PUN 62 PR025 02000C ILI ADD PLI PLI 62 PR025 02010C IHI ADD PHI PHI 62 PR025 02020C IPADV ADD PPADV PPADV 62 PR025 02030C IEQUIP ADD PEQUIP PEQUIP 52 PR025 0002040C ISP ADD PSP PSP 52 PR025 02050C IPEN ADD PPEN PPEN 52 PR025 02060C IMISC ADD PMISC PMISC 52 PR025 02070C* PR025 02080C BY8 TAG PR025 02090C* PR025 02100C* ROUTINE FOR EMPLOYEE MASTER. PR025 0002110C* ---------------------------- PR025 02120C N01 GOTO BY1 NOT MASTER. PR025 02130C* ********** PR025 02140C* PR025 02150C TCODE COMP 'T' 20 TERMINATED, PR025 02160C 20 GOTO BY1 NO PROCESS. PR025 02170C* ********** PR025 0002180C* PR025 02190C BY1 TAG PR025 02200C* ********** PR025 02210C* PR025 02220C* ROUTINE FOR CURRENT EARNINGS. PR025 02230C* ----------------------------- PR025 02240C N04 GOTO BY4 PR025 0002250C* ********** PR025 02260C* PR025 02270C Z-ADD0 GPAY PR025 02280C GPAY ADD RPAY GPAY 72 CROSSFOOT PR025 02290C GPAY ADD SPAY GPAY GROSS PAY. PR025 02300C GPAY ADD HPAY GPAY PR025 02310C GPAY ADD VPAY GPAY PR025 0002320C GPAY ADD OPAY GPAY PR025 02330C GPAY ADD DPAY GPAY PR025 02340C GPAY ADD PPAY GPAY PR025 02350C* PR025 02360C Z-ADD0 TAXES PR025 02370C TAXES ADD FWH TAXES 72 CROSSFOOT PR025 02380C TAXES ADD FICA TAXES TAXES. PR025 0002390C TAXES ADD SDI TAXES PR025 02400C TAXES ADD SWH TAXES PR025 02410C TAXES ADD CWH TAXES PR025 02420C* PR025 02430C ENET ADD GPAY ENET 72 NET AFTER PR025 02440C ENET SUB TAXES ENET TAXES. PR025 02450C* PR025 0002460C BY4 TAG PR025 02470C* ********** PR025 02480C* PR025 02490C* ROUTINE FOR CURRENT COMMISSIONS. PR025 02500C*********************************** PR025 02510C N06 GOTO BY6 PR025 02520C* ********** PR025 0002530C* APPLY EARNS & PR025 02540C ENET ADD COMM ENET TAXES TO EMPL PR025 02550C ENET SUB CFWH ENET NET. PR025 02560C ENET SUB FICA ENET PR025 02570C ENET SUB SDI ENET PR025 02580C ENET SUB CSWH ENET PR025 02590C SETON 21 PR025 0002600C* PR025 02610C BY6 TAG PR025 02620C* ********** PR025 02630C* PR025 02640C* ROUTINE FOR 1 TIME DEDUCTIONS. PR025 02650C* ------------------------------ PR025 02660C N09 GOTO BY9 PR025 0002670C* ********** PR025 02680C* PR025 02690C DCODE COMP '03' 25 PR025 02700C 25 RCU ADD AMT RCU PR025 02710C 25 GOTO BY9 PR025 02720C* ********** PR025 02730C DCODE COMP '04' 25 PR025 0002740C 25 RBOND ADD AMT RBOND PR025 02750C 25 GOTO BY9 PR025 02760C* ********** PR025 02770C DCODE COMP '05' 25 PR025 02780C 25 RUN ADD AMT RUN PR025 02790C 25 GOTO BY9 PR025 02800C* ********** PR025 0002810C DCODE COMP '06' 25 PR025 02820C 25 RLI ADD AMT RLI PR025 02830C 25 GOTO BY9 PR025 02840C* ********** PR025 02850C DCODE COMP '07' 25 PR025 02860C 25 RHI ADD AMT RHI PR025 02870C 25 GOTO BY9 PR025 0002880C* ********** PR025 02890C DCODE COMP '08' 25 PR025 02900C 25 RPADV ADD AMT RPADV PR025 02910C 25 GOTO BY9 PR025 02920C* ********** PR025 02930C DCODE COMP '09' 25 PR025 02940C 25 REQUIP ADD AMT REQUIP PR025 0002950C 25 GOTO BY9 PR025 02960C* ********** PR025 02970C DCODE COMP '10' 25 PR025 02980C 25 RSP ADD AMT RSP PR025 02990C 25 GOTO BY9 PR025 03000C* ********** PR025 03010C DCODE COMP '11' 25 PR025 0003020C 25 RPEN ADD AMT RPEN PR025 03030C 25 GOTO BY9 PR025 03040C* ********** PR025 03050C DCODE COMP '12' 25 PR025 03060C 25 RMISC ADD AMT RMISC PR025 03070C 25 GOTO BY9 PR025 03080C* ********** PR025 0003090C DCODE COMP '01' 25 PR025 03100C 25 RAFWH ADD AMT RAFWH PR025 03110C 25 GOTO BY9 PR025 03120C* ********** PR025 03130C DCODE COMP '02' 25 PR025 03140C 25 RASWH ADD AMT RASWH PR025 03150C 25 GOTO BY9 PR025 0003160C* ********** PR025 03170C DCODE COMP '13' 25 PR025 03180C 25 RACWH ADD AMT RACWH PR025 03190C 25 GOTO BY9 PR025 03200C* ********** PR025 03210C* PR025 03220C BY9 TAG PR025 0003230C* ********** PR025 03240C MOVELRCD A2 2 GET SORT CODE PR025 03250C A2 LOKUPTABRC TABSC 23 FOR EARNSW. PR025 03260C 23 MOVE TABSC SRCODE 2 PR025 03270C SETON 24 24=OUTPUT PR025 03280C 09 SETOF 24 TO EARNSW PR025 03290C* PR025 0003300C* AT L1, BRANCH TO DEDUCTION TOO LARGE ROUTINE. PR025 03310C* --------------------------------------------- PR025 03320CL1 Z-ADD0 GDEDS 72 84 PR025 03330CL1 Z-ADD0 ODEDS 72 85 PR025 03340CL1 Z-ADDRCU GCU 62 PR025 03350CL1 Z-ADDRBOND GBOND 62 PR025 03360CL1 Z-ADDRUN GUN 62 PR025 0003370CL1 Z-ADDRLI GLI 62 PR025 03380CL1 Z-ADDRHI GHI 62 PR025 03390CL1 Z-ADDRPADV GPADV 62 PR025 03400CL1 Z-ADDREQUIP GEQUIP 52 PR025 03410CL1 Z-ADDRSP GSP 52 PR025 03420CL1 Z-ADDRPEN GPEN 52 PR025 03430CL1 Z-ADDRMISC GMISC 52 PR025 0003440CL1 Z-ADDRAFWH GAFWH 62 PR025 03450CL1 Z-ADDRASWH GASWH 62 PR025 03460CL1 Z-ADDRACWH GACWH 62 PR025 03470CL1 MOVE ' ' PCODE 2 PR025 03480CL1 MOVE DEPT ODEPT 4 PR025 03490CL1 MOVE EMP OEMP 4 PR025 03500CL1 MOVE FI OFI 2 PR025 0003510CL1 MOVE NAME ONAME 20 PR025 03520CL0 Z-ADD0 PAMT 62 PR025 03530C* PR025 03540C* EACH DEDUCTION CODE WILL FOLLOW THIS FORMULA. PR025 03550C* PR025 03560C* SUB. DEDUCTION FROM NET. IF NET IS MINUS (IND 70) DO FOLLOWING. PR025 03570C* RETURN AMOUNT TO NET. PR025 0003580C* ADD AMOUNT TO OVER DEDUCTIONS (ODEDS). PR025 03590C* PLACE IN COMMON FIELD FOR PUNCHING AND PRINTING. PR025 03600C* CLEAR DEDUCTION FIELD. PR025 03610C* PLACE APPROPIATE CODE IN COMMON FIELD FOR PUNCH. AND PRINT. PR025 03620C* BRANCH TO TOTAL TIME TO PUNCH AND PRINT OVER DEDUCTION. PR025 03630C* PR025 03640CL1 SETOF 71 PR025 0003650CL1 ENET SUB GAFWH ENET 70 PR025 03660CL1 70 ENET ADD GAFWH ENET PR025 03670CL1 70 ODEDS ADD GAFWH ODEDS PR025 03680CL1 Z-ADDGAFWH PAMT 71 PR025 03690CL1 70 Z-ADD0 GAFWH PR025 03700CL1 MOVE '01' PCODE PR025 03710CL1 MOVE PCODE NC 20 PR025 0003720CL1 EXCPT PR025 03730CL1 ENET SUB GASWH ENET 70 PR025 03740CL1 70 ENET ADD GASWH ENET PR025 03750CL1 70 ODEDS ADD GASWH ODEDS PR025 03760CL1 Z-ADDGASWH PAMT 71 PR025 03770CL1 70 Z-ADD0 GASWH PR025 03780CL1 MOVE '02' PCODE PR025 0003790CL1 MOVE PCODE NC PR025 03800CL1 EXCPT PR025 03810CL1 ENET SUB GCU ENET 70 PR025 03820CL1 70 ENET ADD GCU ENET PR025 03830CL1 70 ODEDS ADD GCU ODEDS PR025 03840CL1 70 Z-ADD0 GCU PR025 03850CL1 GCU ADD PCU PAMT 7171 PR025 0003860CL1 MOVE '03' PCODE PR025 03870CL1 MOVE PCODE NC PR025 03880CL1 EXCPT PR025 03890CL1 ENET SUB GBOND ENET 70 PR025 03900CL1 70 ENET ADD GBOND ENET PR025 03910CL1 70 ODEDS ADD GBOND ODEDS PR025 03920CL1 70 Z-ADD0 GBOND PR025 0003930CL1 GBOND ADD PBOND PAMT 7171 PR025 03940CL1 MOVE '04' PCODE PR025 03950CL1 MOVE PCODE NC PR025 03960CL1 EXCPT PR025 03970CL1 ENET SUB GUN ENET 70 PR025 03980CL1 70 ENET ADD GUN ENET PR025 03990CL1 70 ODEDS ADD GUN ODEDS PR025 0004000CL1 70 Z-ADD0 GUN PR025 04010CL1 GUN ADD PUN PAMT 7171 PR025 04020CL1 MOVE '05' PCODE PR025 04030CL1 MOVE PCODE NC PR025 04040CL1 EXCPT PR025 04050CL1 ENET SUB GLI ENET 70 PR025 04060CL1 70 ENET ADD GLI ENET PR025 0004070CL1 70 ODEDS ADD GLI ODEDS PR025 04080CL1 70 Z-ADD0 GLI PR025 04090CL1 GLI ADD PLI PAMT 7171 PR025 04100CL1 MOVE '06' PCODE PR025 04110CL1 MOVE PCODE NC PR025 04120CL1 EXCPT PR025 04130CL1 ENET SUB GHI ENET 70 PR025 0004140CL1 70 ENET ADD GHI ENET PR025 04150CL1 70 ODEDS ADD GHI ODEDS PR025 04160CL1 70 Z-ADD0 GHI PR025 04170CL1 GHI ADD PHI PAMT 7171 PR025 04180CL1 MOVE '07' PCODE PR025 04190CL1 MOVE PCODE NC PR025 04200CL1 EXCPT PR025 0004210CL1 ENET SUB GPADV ENET 70 PR025 04220CL1 70 ENET ADD GPADV ENET PR025 04230CL1 70 ODEDS ADD GPADV ODEDS PR025 04240CL1 70 Z-ADD0 GPADV PR025 04250CL1 GPADV ADD PPADV PAMT 7171 PR025 04260CL1 MOVE '08' PCODE PR025 04270CL1 MOVE PCODE NC PR025 0004280CL1 EXCPT PR025 04290CL1 ENET SUB GEQUIP ENET 70 PR025 04300CL1 70 ENET ADD GEQUIP ENET PR025 04310CL1 70 ODEDS ADD GEQUIP ODEDS PR025 04320CL1 70 Z-ADD0 GEQUIP PR025 04330CL1 GEQUIP ADD PEQUIP PAMT 7171 PR025 04340CL1 MOVE '09' PCODE PR025 0004350CL1 MOVE PCODE NC PR025 04360CL1 EXCPT PR025 04370CL1 ENET SUB GSP ENET 70 PR025 04380CL1 70 ENET ADD GSP ENET PR025 04390CL1 70 ODEDS ADD GSP ODEDS PR025 04400CL1 70 Z-ADD0 GSP PR025 04410CL1 GSP ADD PSP PAMT 7171 PR025 0004420CL1 MOVE '10' PCODE PR025 04430CL1 MOVE PCODE NC PR025 04440CL1 EXCPT PR025 04450CL1 ENET SUB GPEN ENET 70 PR025 04460CL1 70 ENET ADD GPEN ENET PR025 04470CL1 70 ODEDS ADD GPEN ODEDS PR025 04480CL1 70 Z-ADD0 GPEN PR025 0004490CL1 GPEN ADD PPEN PAMT 7171 PR025 04500CL1 MOVE '11' PCODE PR025 04510CL1 MOVE PCODE NC PR025 04520CL1 EXCPT PR025 04530CL1 ENET SUB GMISC ENET 70 PR025 04540CL1 70 ENET ADD GMISC ENET PR025 04550CL1 70 ODEDS ADD GMISC ODEDS PR025 0004560CL1 70 Z-ADD0 GMISC PR025 04570CL1 GMISC ADD PMISC PAMT 7171 PR025 04580CL1 MOVE '12' PCODE PR025 04590CL1 MOVE PCODE NC PR025 04600CL1 EXCPT PR025 04610CL1 ENET SUB GACWH ENET 70 PR025 04620CL1 70 ENET ADD GACWH ENET PR025 0004630CL1 70 ODEDS ADD GACWH ODEDS PR025 04640CL1 Z-ADDGACWH PAMT 71 PR025 04650CL1 70 Z-ADD0 GACWH PR025 04660CL1 MOVE '13' PCODE PR025 04670CL1 MOVE PCODE NC PR025 04680CL1 EXCPT PR025 04690CL1 SETOF 71 PR025 0004700CL1 Z-ADD0 PCU PR025 04710CL1 Z-ADD0 PBOND PR025 04720CL1 Z-ADD0 PUN PR025 04730CL1 Z-ADD0 PLI PR025 04740CL1 Z-ADD0 PHI PR025 04750CL1 Z-ADD0 PPADV PR025 04760CL1 Z-ADD0 PEQUIP PR025 0004770CL1 Z-ADD0 PSP PR025 04780CL1 Z-ADD0 PPEN PR025 04790CL1 Z-ADD0 PMISC PR025 04800C* PR025 04810CL1 Z-ADDODEDS ODEDS 8585 OVER DEDUCTED.PR025 04820O* PR025 04830O* REPORT HEADINGS. PR025 0004840O* ---------------- PR025 04850ORPT H 101 L3 PR025 04860O OR 1P PR025 04870O OR OFNL3 PR025 04880O N50CONAME 36 PR025 04890O 111 'RUN DATE' PR025 04900O UDATE Y 120 PR025 0004910O* PR025 04920ORPT H 1 L3 PR025 04930O OR 1P PR025 04940O OR OFNL3 PR025 04950O 6 'PR0025' PR025 04960O 111 'W/E DATE' PR025 04970O WEDATEY 120 PR025 0004980O* PR025 04990ORPT H 1 L3 PR025 05000O OR 1P PR025 05010O OR OFNL3 PR025 05020O 15 'WEEKLY AUDIT OF' PR025 05030O 34 'DEDUCTIONS WEEK #' PR025 05040O TWEEK 37 PR025 0005050O 111 'PAGE NO.' PR025 05060O PAGE Z 117 PR025 05070O* PR025 05080ORPT H 1 L3 PR025 05090O OR 1P PR025 05100O OR OFNL3 PR025 05110O 24 '------------------------' PR025 0005120O 48 '------------------------' PR025 05130O 72 '------------------------' PR025 05140O 96 '------------------------' PR025 05150O 120 '------------------------' PR025 05160O* PR025 05170O* COLUMNAR HEADINGS. PR025 05180O* ------------------ PR025 0005190ORPT H 1 L3 PR025 05200O OR 1P PR025 05210O OR OFNL3 PR025 05220O 16 'DEP/EMP N A M E' PR025 05230O* PR025 05240ORPT H 1 L3 PR025 05250O OR 1P PR025 0005260O OR OFNL3 PR025 05270O 24 '------------------------' PR025 05280O 48 '------------------------' PR025 05290O 72 '------------------------' PR025 05300O 96 '------------------------' PR025 05310O 120 '------------------------' PR025 05320O* PR025 0005330OEARNSW D 24 PR025 05340O RCD 140 PR025 05350O SRCODE B 128 PR025 05360O* PR025 05370O* PRINTING DEDUCTIONS TOO LARGE. PR025 05380O* ----------------------------------------- PR025 05390O* PR025 0005400ORPT E 1 L1 70 PR025 05410O 53 'DEDUCTION CODE' PR025 05420O 21 66 'TOO LARGE' PR025 05430O PCODE 56 PR025 05440O PAMT J 78 PR025 05450O PDEP B 4 PR025 05460O PEMP B 9 PR025 0005470O FI B 12 PR025 05480O NAME B 33 PR025 05490O* PR025 05500O* CREATING DEDUCTION SUMMARY. PR025 05510O* --------------------------- PR025 05520OEARNSW T L1 PR025 05530O 2 'P9' PR025 0005540O KEY 12 PR025 05550O GAFWH B 19 PR025 05560O GASWH B 25 PR025 05570O GCU B 31 PR025 05580O GBOND B 37 PR025 05590O GUN B 43 PR025 05600O GLI B 49 PR025 0005610O GHI B 55 PR025 05620O GPADV B 61 PR025 05630O GEQUIP B 66 PR025 05640O GSP B 71 PR025 05650O GPEN B 76 PR025 05660O GMISC B 81 PR025 05670O GACWH B 87 PR025 0005680O 128 '29' PR025 05690O* PR025 05700ORPT T 2 L1 85 PR025 05710O ODEDS JB 97 PR025 05720O N21 111 'NO EARNINGS' PR025 05730ODEDUCT D 11 PR025 05740O 2 '00' PR025 0005750O WEDATE 8 PR025 05760O TWEEK 10 PR025 05770O E L1 71 PR025 05780O PCODE 2 PR025 05790O ODEPT 6 PR025 05800O OEMP 10 PR025 05810O OFI 12 PR025 0005820O ONAME 32 PR025 05830O SOCSEC 41 PR025 05840O PAMT 48 PR025 05850O A,NC 55 PR025 ** 005860ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005870ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00588000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005890ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005900** 005910# P525PN15P626PO16P929PP17 005920/* 005930__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005870ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0058800(W> TXPR028 P(0__W> TXPR028 P( 005910# P525PN15P626PO16P929PP17 005920/* 005930__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005870ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0058800(X dTXPR029 P999999111111(000010H S PR029 00020X DECK-ID B07 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR029 00030F* PRINT DEDUCTION REGISTER PR029 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR029 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR029 00060F* CONTROL DATA PROPRIETARY PRODUCT PR029 00070F* PR029 0000080F* PR029 00090F* *************************************************************** PR029 00100F* * ************************************************* * PR029 00110F* * * * * PR029 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR029 00130F* * * * * PR029 00140F* * ************************************************* * PR029 0000150F* *************************************************************** PR029 00160F* PR029 00170FDEDUCT IPEAF 60 DISK PR029 00180FCNMAST IC F 128R 2AI 1 DISK PR029 00190F$LP1 O F 132 OF PRINTER PR029 00200F* PR029 00210F********************************************************************PR029 0000220F* *PR029 00230F* ID F C H L FUNCTION OF INDICATORS *PR029 00240F* *PR029 00250F* 01 DATE RECORD -- DEDUCT *PR029 00260F* 02 DEDUCTION RECORD - DEDUCT *PR029 00270F* 03 CNMAST RECORD *PR029 00280F* 99 FIRST CYCLE CONTROL FOR CNMAST CHAIN *PR029 0000290F* H1 NO HIT ON CHAIN TO CNMAST *PR029 00300F* L1 NEW DEPARTMENT *PR029 00310F* L2 NEW DEDUCTION *PR029 00320F* *PR029 00330F* MODIFIED 8/25/76 TO INCLUDE CURR AMT IN YTD. PR029 00340F* PR029 00350F********************************************************************PR029 0000360F* PR029 00370E NM 1 13 20 PR029 00380E* PR029 00390IDEDUCT NS 01 1 C0 2 C0 PR029 00400I 3 80WEDATE PR029 00410I 9 100TWEEK PR029 00420I NS 02 PR029 0000430I 1 20DED L2 PR029 00440I 3 60DEPT L1 PR029 00450I 7 100EMP PR029 00460I 11 12 INITS PR029 00470I 13 32 LNAME PR029 00480I 33 410SOCSEC PR029 00490I 42 482AMT PR029 0000500I 49 552YTD PR029 00510ICNMAST NS 03 PR029 00520I 5 40 CONAME PR029 00530I* PR029 00540C N99 '00' CHAINCNMAST H1 PR029 00550C SETON 99 PR029 00560C N02 GOTO LAST PR029 0000570C AMT ADD YTD YTD PR029 00580C SOCSEC COMP 99999999 21 PR029 00590C TDEPTA ADD AMT TDEPTA 82 PR029 00600C TDEPTY ADD YTD TDEPTY 82 PR029 00610C LAST TAG PR029 00620C********************************************************************PR029 00630CL1 TDEDA ADD TDEPTA TDEDA 92 PR029 0000640CL1 TDEDY ADD TDEPTY TDEDY 92 PR029 00650C* PR029 00660O$LP1 D 01 L2 PR029 00670O OR OF PR029 00680O 6 'PR0029' PR029 00690O CONAME 73 PR029 00700O 111 'RUN DATE' PR029 0000710O UDATE Y 120 PR029 00720O D 1 L2 PR029 00730O OR OF PR029 00740O 26 'WEEK #' PR029 00750O TWEEK 29 PR029 00760O 111 'W/E DATE' PR029 00770O WEDATEY 120 PR029 0000780O D 1 L2 PR029 00790O OR OF PR029 00800O NM,DED 65 PR029 00810O 107 'PAGE' PR029 00820O PAGE Z 120 PR029 00830O D 1 L2 PR029 00840O OR OF PR029 0000850O 24 '------------------------' PR029 00860O 48 '------------------------' PR029 00870O 72 '------------------------' PR029 00880O 96 '------------------------' PR029 00890O 120 '------------------------' PR029 00900O D 1 L2 PR029 00910O OR OF PR029 0000920O 20 'DEPT EMP# NAME' PR029 00930O 48 'SOC SEC #' PR029 00940O 68 'AMOUNT' PR029 00950O 88 'Y-T-D' PR029 00960O D 11 L2 PR029 00970O OR OF PR029 00980O 24 '------------------------' PR029 0000990O 48 '------------------------' PR029 01000O 72 '------------------------' PR029 01010O 96 '------------------------' PR029 01020O 120 '------------------------' PR029 01030O D 1 02 PR029 01040O DEPT 5 PR029 01050O EMP 11 PR029 0001060O INITS 15 PR029 01070O LNAME 36 PR029 01080O SOCSEC 49 '0 - - ' PR029 01090O N21 39 '0' PR029 01100O AMT J 69 PR029 01110O YTD K 89 PR029 01120O T 21 L1 PR029 0001130O 11 'DEPT' PR029 01140O DEPT 16 PR029 01150O 23 'TOTALS' PR029 01160O TDEPTAJB 69 PR029 01170O TDEPTYKB 89 PR029 01180O T 2 L2 PR029 01190O 23 'DEDUCTION TOTALS' PR029 0001200O TDEDA JB 69 PR029 01210O TDEDY KB 89 PR029 ** 001220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00126000** 001270ADDED FEDERAL 001280ADDED STATE 001290CREDIT UNION 001300BONDS 001310UNION DUES 001320LIFE INSURANCE 00133000HEALTH INSURANCE 001340PAY ADVANCE 001350MERCHANDISE 001360STOCK PURCHASE 001370PENSION 001380MISCELLANEOUS 001390ADDED CITY 00140000/* 001410__ADVANCE 001350MERCHANDISE 001360STOCK PURCHASE 001370PENSION 001380MISCELLANEOUS 001390ADDED CITY 0014000(XX TXPR030 P999999111111(000010H S PR030 00020X DECK-ID B08 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR030 00030F* PRINT PAYROLL REGISTER - U1=MONTHLY - NU1=WEEKLY PR030 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR030 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR030 00060F* CONTROL DATA PROPRIETARY PRODUCT PR030 00070F* PR030 0000080F* PR030 00090F* *************************************************************** PR030 00100F* * ************************************************* * PR030 00110F* * * * * PR030 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR030 00130F* * * * * PR030 00140F* * ************************************************* * PR030 0000150F* *************************************************************** PR030 00160F* PR030 00170F* NU1 ---- WEEKLY P/R REGISTER. ---- PR030 00180F* U1 ---- MONTHLY P/R REGISTER. ---- PR030 00190F* PR030 00200F* MODIFIED 7/06/76 TO INPUT CONTROL # FROM 'P6' RECORDS. (COMM) PR030 00210F* PR030 0000220F* PR030 00230FWEARNS IP AF 140 140 DISK PR030 00240FRPT O F 132 132 OF LPRINTER PR030 00250FPRMAST IC F 600R10AI 2 DISK PR030 00260FCNMAST IC F 128R 2AI 1 DISK PR030 00270LRPT 66FL 58OL PR030 00280ICNMAST NS 05 PR030 0000290I 5 40 CONAME PR030 00300I* PR030 00310I* EMPLOYE MASTER. PR030 00320I* --------------- PR030 00330IPRMAST NS 01 PR030 00340I 012 013 INT PR030 00350I 014 026 NAME PR030 0000360I 110 1143HRATE 10 PR030 00370I 131 131 TERM PR030 00380I 132 132 TYPEE PR030 00390I* PR030 00400I* WEEKLY EARNINGS. PR030 00410I* ---------------- PR030 00420IWEARNS NS 02 1 CP 2 C5 PR030 0000430I OR 1 CP 2 CN PR030 00440I 5 12 L1FLD L1 PR030 00450I 9 12 EMP PR030 00460I 5 8 DEPT PR030 00470I 3 40DIV L2 PR030 00480I 2 2 TYPE PR030 00490I 15 181RHRS PR030 0000500I 19 211SHRS PR030 00510I 22 241HHRS PR030 00520I 25 281VHRS PR030 00530I 29 311OHRS PR030 00540I 32 372RPAY PR030 00550I 38 422SPAY PR030 00560I 43 472HPAY PR030 0000570I 48 532VPAY PR030 00580I 54 582OPAY PR030 00590I 59 632FWH PR030 00600I 64 682FICA PR030 00610I 69 732SDI PR030 00620I 74 782SWH PR030 00630I 84 890CNTLNO PR030 0000640I 79 832CTAX PR030 00650I 3 12 KEY PR030 00660I 90 921DTHRS PR030 00670I 93 972DTPAY PR030 00680I* *** THE FOLLOWING TWO FIELDS ARE FOR PIECE PAY ONLY. ********* PR030 00690I* 101 1052PPAY PR030 00700I* 107 1130PIECE PR030 0000710I***************************************************************** PR030 00720I* PR030 00730I* COMMISSION. PR030 00740I* ----------- PR030 00750I NS 03 1 CP 2 C6 PR030 00760I OR 1 CP 2 CO PR030 00770I 5 12 L1FLD L1 PR030 0000780I 9 12 EMP PR030 00790I 5 8 DEPT PR030 00800I 3 40DIV L2 PR030 00810I 13 192CAMT PR030 00820I 23 292CFWH PR030 00830I 30 342FICA PR030 00840I 35 392SDI PR030 0000850I 40 452CSWH PR030 00860I 84 890CNTLNO PR030 00870I 2 2 TYPE PR030 00880I 3 12 KEY PR030 00890I* PR030 00900I* DEDUCTION SUMMARIES. PR030 00910I* -------------------- PR030 0000920I NS 04 1 CP 2 C9 PR030 00930I OR 1 CP 2 CP PR030 00940I 5 12 L1FLD L1 PR030 00950I 9 12 EMP PR030 00960I 5 8 DEPT PR030 00970I 3 40DIV L2 PR030 00980I 2 2 TYPE PR030 0000990I 14 192RAFWH PR030 01000I 20 252RASWH PR030 01010I 26 312RCU PR030 01020I 32 372RBD PR030 01030I 38 432RUN PR030 01040I 44 492RLI PR030 01050I 50 552RHI PR030 0001060I 56 612RPA PR030 01070I 62 662REQ PR030 01080I 67 712RSP PR030 01090I 72 762RPEN PR030 01100I 77 812RMISC PR030 01110I 82 872RACWH PR030 01120I 88 932RVFWH PR030 0001130I 94 992RVSWH PR030 01140I 3 12 KEY PR030 01150I* PR030 01160I* DATE CARD. PR030 01170I* ---------- PR030 01180I NS 06 1 C# PR030 01190I 11 160WEDATE PR030 0001200I 20 21 WKNUM PR030 01210I* PR030 01220I* UNUSED RECORDS. PR030 01230I* --------------- PR030 01240I NS 09 PR030 01250I 1 1 X@@ PR030 01260C 69 GOTO RNDA PR030 0001270C SETON 3269 PR030 01280C EXCPT PR030 01290C SETOF 32 PR030 01300C RNDA TAG PR030 01310C L1 MOVEL' ' KEY SINGLE CO. PR030 01320C L1 KEY CHAINPRMAST 22 PR030 01330C L2 Z-SUB1 DEPCNT 20 42 PR030 0001340C L2 MOVELDIV KEY2 4 PR030 01350C L2 DIV CHAINCNMAST 26 PR030 01360C* PR030 01370C* CLEARING INDICATORS & COUNTERS. PR030 01380C* ------------------------------- PR030 01390C SETOF 4041 PR030 01400C L1 SETOF 208993 PR030 0001410C L1 SETOF 25 PR030 01420C* PR030 01430C* ROUTINE FOR EMPLOYEE MASTER. PR030 01440C* ---------------------------- PR030 01450C* PR030 01460C 01 TYPEE COMP '1' 21 HOURLY PR030 01470C* PR030 0001480C 01 TERM COMP 'T' 24 PR030 01490C* PR030 01500C* ROUTINE FOR WEEKLY EARNINGS. PR030 01510C* ---------------------------- PR030 01520C* PR030 01530C N02 GOTO BY02 PR030 01540C* ********** PR030 0001550C TYPE COMP 'N' 20 PREPAID PR030 01560C* PR030 01570C OHRS ADD DTHRS OHRS PR030 01580C OPAY ADD DTPAY OPAY PR030 01590C ERHRS ADD RHRS ERHRS 41 ACCUM EMPL PR030 01600C ESHRS ADD SHRS ESHRS 31 PR030 01610C EHHRS ADD HHRS EHHRS 31 PR030 0001620C EVHRS ADD VHRS EVHRS 41 PR030 01630C EOHRS ADD OHRS EOHRS 31 PR030 01640C ERPAY ADD RPAY ERPAY 72 PR030 01650C*** THE FOLLOWING TWO LINES ARE FOR PIECE PAY ONLY. ************ PR030 01660C* EPIECE ADD PIECE EPIECE 70 PR030 01670C* EPPAY ADD PPAY EPPAY 62 PR030 01680C************************************************************* PR030 0001690C ESPAY ADD SPAY ESPAY 52 PR030 01700C EHPAY ADD HPAY EHPAY 52 PR030 01710C EVPAY ADD VPAY EVPAY 62 PR030 01720C EOPAY ADD OPAY EOPAY 52 PR030 01730C EFWH ADD FWH EFWH 62 PR030 01740C EFICA ADD FICA EFICA 52 PR030 01750C ESDI ADD SDI ESDI 52 PR030 0001760C ESWH ADD SWH ESWH 62 PR030 01770C ECTAX ADD CTAX ECTAX 62 PR030 01780C* PR030 01790C* ROUTINE FOR COMMISSIONS. PR030 01800C* PR030 01810C BY02 TAG PR030 01820C* ********** PR030 0001830C N03 GOTO BY03 PR030 01840C* ********** PR030 01850C TYPE COMP 'O' 20 PREPAID. PR030 01860C* PR030 01870C ERPAY ADD CAMT ERPAY ADD TO EMPL PR030 01880C EFWH ADD CFWH EFWH TOTALS. PR030 01890C EFICA ADD FICA EFICA PR030 0001900C ESDI ADD SDI ESDI PR030 01910C ESWH ADD CSWH ESWH PR030 01920C ECOMM ADD CAMT ECOMM 72 2525 PR030 01930C* PR030 01940C* ROUTINE FOR DEDUCTION SUMMARIES.. PR030 01950C BY03 TAG PR030 01960C* ********** PR030 0001970C N04 GOTO BY04 PR030 01980C* ********** PR030 01990C TYPE COMP 'P' 20 PREPAID PR030 02000C EFDED ADD RCU EFDED 62 PR030 02010C EFDED ADD RBD EFDED PR030 02020C EFDED ADD RUN EFDED PR030 02030C EFDED ADD RLI EFDED PR030 0002040C EFDED ADD RHI EFDED PR030 02050C EFDED ADD RPA EFDED PR030 02060C EFDED ADD REQ EFDED PR030 02070C EFDED ADD RMISC EFDED PR030 02080C EFDED ADD RSP EFDED PR030 02090C EFDED ADD RPEN EFDED PR030 02100C EFDED ADD RVFWH EFDED PR030 0002110C EFDED ADD RVSWH EFDED PR030 02120C EFWH ADD RAFWH EFWH PR030 02130C ESWH ADD RASWH ESWH PR030 02140C ECTAX ADD RACWH ECTAX PR030 02150C* PR030 02160C BY04 TAG PR030 02170C* ********** PR030 0002180C SETON 32 PR030 02190C L2 PR030 02200COR OF EXCPT PR030 02210C SETOF 32 PR030 02220C* PR030 02230C* ROUTINE FOR EMPLOYEE. PR030 02240C* --------------------- PR030 0002250CL0 02 20 SETON 4041 DO ROUTINE IF PR030 02260CL0 03 20 SETON 4041 40 IS ON. PR030 02270CL1 SETON 40 PR030 02280CL1 DEPCNT ADD 1 DEPCNT 42 PR030 02290CL1 DCNT ADD 1 DCNT 40 COUNT EMPLS. PR030 02300CL1 20 SETON 41 PREPAID ALSO. PR030 02310CL0N40 GOTO BYEMP PR030 0002320C* ********** PR030 02330C* PR030 02340CL0 EGHRS ADD ERHRS EGHRS 41 CROSSFOOT PR030 02350CL0 EGHRS ADD ESHRS EGHRS GROSS HOURS. PR030 02360CL0 EGHRS ADD EHHRS EGHRS PR030 02370CL0 EGHRS ADD EVHRS EGHRS PR030 02380CL0 EGHRS ADD EOHRS EGHRS PR030 0002390C* PR030 02400CL0 EGPAY ADD ERPAY EGPAY 72 CROSSFOOT PR030 02410CL0 EGPAY ADD ESPAY EGPAY GROSS PAY. PR030 02420CL0 EGPAY ADD EHPAY EGPAY PR030 02430CL0 EGPAY ADD EVPAY EGPAY PR030 02440CL0 EGPAY ADD EOPAY EGPAY PR030 02450C****** EGPAY ADD EPPAY EGPAY PR030 0002460CL0 ENET ADD EGPAY ENET 72 CROSS FOOT NETPR030 02470CL0 ENET SUB EFWH ENET PAY. PR030 02480CL0 ENET SUB EFICA ENET PR030 02490CL0 ENET SUB ESDI ENET PR030 02500CL0 ENET SUB ESWH ENET PR030 02510CL0 ENET SUB EFDED ENET PR030 02520CL0 ENET SUB ECTAX ENET PR030 0002530C* PR030 02540C* PR030 02550C* ACCUMULATE DEPT TOTALS. PR030 02560C* PR030 02570CL0 DRHRS ADD ERHRS DRHRS 51 PR030 02580CL0 DOHRS ADD EOHRS DOHRS 51 PR030 02590CL0 DSHRS ADD ESHRS DSHRS 51 PR030 0002600CL0 DHHRS ADD EHHRS DHHRS 51 PR030 02610CL0 DVHRS ADD EVHRS DVHRS 61 PR030 02620CL0 DGHRS ADD EGHRS DGHRS 71 PR030 02630CL0 DRPAY ADD ERPAY DRPAY 82 PR030 02640C***** NEXT 2 LINES FOR PIECE PAY ONLY. *************************** PR030 02650C*0 DPIECE ADD EPIECE DPIECE 80 PR030 02660C*0 DPPAY ADD EPPAY DPPAY 72 PR030 0002670C****************************************************************** PR030 02680CL0 DOPAY ADD EOPAY DOPAY 72 PR030 02690CL0 DSPAY ADD ESPAY DSPAY 72 PR030 02700CL0 DHPAY ADD EHPAY DHPAY 72 PR030 02710CL0 DVPAY ADD EVPAY DVPAY 72 PR030 02720CL0 DGPAY ADD EGPAY DGPAY 82 PR030 02730CL0 DFWH ADD EFWH DFWH 72 PR030 0002740CL0 DSWH ADD ESWH DSWH 72 PR030 02750CL0 DFICA ADD EFICA DFICA 72 PR030 02760CL0 DSDI ADD ESDI DSDI 72 PR030 02770CL0 DFDED ADD EFDED DFDED 72 PR030 02780CL0 DNET ADD ENET DNET 82 PR030 02790CL0 DCOMM ADD ECOMM DCOMM 82 PR030 02800CL0 41 DPNET ADD ENET DPNET 82 PR030 0002810CL0N41 DCNET ADD ENET DCNET 82 PR030 02820CL0 DCTAX ADD ECTAX DCTAX 72 PR030 02830C* PR030 02840CL0 BYEMP TAG PR030 02850C* ********** PR030 02860C* PR030 02870CL2 LCNT ADD DCNT LCNT 50 PR030 0002880CL2 LGPAY ADD DGPAY LGPAY 92 PR030 02890CL2 LFWH ADD DFWH LFWH 82 PR030 02900CL2 LSWH ADD DSWH LSWH 82 PR030 02910CL2 LFICA ADD DFICA LFICA 82 PR030 02920CL2 LSDI ADD DSDI LSDI 82 PR030 02930CL2 LFDED ADD DFDED LFDED 82 PR030 02940CL2 LNET ADD DNET LNET 92 PR030 0002950CL2 LCOMM ADD DCOMM LCOMM 92 PR030 02960CL2 LPNET ADD DPNET LPNET 92 PR030 02970CL2 LCNET ADD DCNET LCNET 92 PR030 02980CL2 LGHRS ADD DGHRS LGHRS 81 PR030 02990CL2 LCTAX ADD DCTAX LCTAX 82 PR030 03000CL2 LRHRS ADD DRHRS LRHRS 61 PR030 03010CL2 LSHRS ADD DSHRS LSHRS 61 PR030 0003020CL2 LVHRS ADD DVHRS LVHRS 71 PR030 03030CL2 LOHRS ADD DOHRS LOHRS 61 PR030 03040CL2 LHHRS ADD DHHRS LHHRS 61 PR030 03050CL2 LRPAY ADD DRPAY LRPAY 92 PR030 03060CL2 LSPAY ADD DSPAY LSPAY 82 PR030 03070CL2 LVPAY ADD DVPAY LVPAY 82 PR030 03080CL2 LOPAY ADD DOPAY LOPAY 82 PR030 0003090CL2 LHPAY ADD DHPAY LHPAY 82 PR030 03100C******* NEXT 2 LINES FOR PIECE PAY ONLY. ***************************PR030 03110C*2 LPPAY ADD DPPAY LPPAY 82 PR030 03120C*2 LPIECE ADD DPIECE LPIECE 90 PR030 03130C*****************************************************************: PR030 03140CL2 SETON 8993 PR030 03150CL0 40 EXCPT PR030 0003160CL0 40 SETOF 40 PR030 03170O* PR030 03180O* ---------------- PR030 03190ORPT E 101 32 PR030 03200O 111 'RUN DATE' PR030 03210O UDATE Y 120 PR030 03220O 93 80 'TOTAL' PR030 0003230O N26 CONAME 74 PR030 03240O* PR030 03250O* PR030 03260O E 1 32 PR030 03270O 6 'PR0030' PR030 03280O NU1 111 'W/E DATE' PR030 03290O NU1 WEDATEY 120 PR030 0003300O* PR030 03310ORPT E 2 32 PR030 03320O 18 'P/R CHECK REGISTER' PR030 03330O U1 20 'P/R MONTHLY REGISTER' PR030 03340O NU1 26 'WEEK #' PR030 03350O NU1 WKNUM 29 PR030 03360O 111 'PAGE NO.' PR030 0003370O PAGE 117 ' , 0' PR030 03380O DIV Z 52 PR030 03390O* PR030 03400O* COLUMNAR HEADINGS. PR030 03410O* ------------------ PR030 03420O E 1 32 PR030 03430O 97 '--T A X E S--' PR030 0003440O* PR030 03450O E 1 32 PR030 03460O N89 15 'EMP# N A M E' PR030 03470O 57 'REG O/T SICK' PR030 03480O 82 'HOL VAC GROSS' PR030 03490O 97 'FED FICA' PR030 03500O 106 'C TAX' PR030 0003510O 120 'NET CTL #' PR030 03520O* PR030 03530O E 2 32 PR030 03540O N89 12 'RATE' PR030 03550O N89 4 'TYPE' PR030 03560O 31 'COMM.' PR030 03570O 105 'STATE SDI DEDUCT' PR030 0003580O 120 'MESSG' PR030 03590O* PR030 03600O* TOTAL FOR EMPLOYEE. PR030 03610O* ------------------- PR030 03620ORPT E 1 40 PR030 03630O EMP 4 PR030 03640O INT 10 PR030 0003650O NAME 24 PR030 03660O 30 'HOURS' PR030 03670O* EPIECEZB 37 PR030 03680O ERHRS MB 44 PR030 03690O EOHRS MB 51 PR030 03700O ESHRS MB 58 PR030 03710O EHHRS MB 65 PR030 0003720O EVHRS MB 73 PR030 03730O EGHRS MB 82 PR030 03740O EFWH MB 91 PR030 03750O EFICA MB 98 PR030 03760O ECTAX MB 106 PR030 03770O ENET MB 115 PR030 03780O CNTLNOZB 121 PR030 0003790O* PR030 03800ORPT E 2 40 PR030 03810O HRATE M 15 PR030 03820O 21 4 'HRLY' PR030 03830O N21 3 'SAL' PR030 03840O 28 'PAY' PR030 03850O 25 ECOMM MB 31 PR030 0003860O* EPPAY MB 37 PR030 03870O ERPAY MB 45 PR030 03880O EOPAY MB 52 PR030 03890O ESPAY MB 59 PR030 03900O EHPAY MB 66 PR030 03910O EVPAY MB 74 PR030 03920O EGPAY MB 83 PR030 0003930O ESWH MB 91 PR030 03940O ESDI MB 98 PR030 03950O EFDED MB 106 PR030 03960O 24 120 'TERM.' PR030 03970O 41 120 'PREPD' PR030 03980O* PR030 03990O* TOTAL BY DIVISION. PR030 0004000O* -------------- PR030 04010O* PR030 04020O TF 1 L2 PR030 04030O 22 'COMPANY TOTALS' PR030 04040O 30 'HOURS' PR030 04050O DRHRS MB 44 PR030 04060O DSHRS MB 58 PR030 0004070O DVHRS MB 72 PR030 04080O* PR030 04090ORPT T 2 L2 PR030 04100O DOHRS MB 51 PR030 04110O DHHRS MB 65 PR030 04120O DGHRS MB 82 PR030 04130O***** DPIECEZB 37 PR030 0004140O T 1 L2 PR030 04150O DRPAY MB 45 PR030 04160O DSPAY MB 59 PR030 04170O DVPAY MB 73 PR030 04180O****** DPPAY MB 37 PR030 04190O 23 'PAY' PR030 04200O* PR030 0004210ORPT T 2 L2 PR030 04220O 19 'COMM.' PR030 04230O DCOMM MB 31 PR030 04240O DOPAY MB 52 PR030 04250O DHPAY MB 66 PR030 04260O DGPAY MB 83 PR030 04270O* PR030 0004280O T 1 L2 PR030 04290O 12 'TAXES & DED.' PR030 04300O 32 'CITY TAX' PR030 04310O 57 'FED W/H STATE W/H' PR030 04320O 70 'FICA' PR030 04330O 83 'SDI' PR030 04340O 96 'DEDUCTIONS' PR030 0004350O 113 '# OF EMPL' PR030 04360O DCNT MB 120 PR030 04370O* PR030 04380ORPT T 2 L2 PR030 04390O DCTAX MB 33 PR030 04400O DFWH MB 45 PR030 04410O DSWH MB 58 PR030 0004420O DFICA MB 71 PR030 04430O DSDI MB 84 PR030 04440O DFDED MB 97 PR030 04450O* PR030 04460ORPT T 2 L2 PR030 04470O 75 'TO BE PAID' PR030 04480O 102 'PREPAID' PR030 0004490O DCNET JB 65 PR030 04500O DPNET JB 95 PR030 04510O 132 'TOTAL P/R NET' PR030 04520O DNET JB 119 PR030 04530O* PR030 ** 004540ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00455000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004560ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004570ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004580/* 004590__0O* PR030 ** 004540ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0045500(Y~ 1TXPR035 P999999111111(000010H S PR035 00020X DECK-ID B09 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR035 00030F* UPDATE QTD AND YTD FIELDS IN PRMAST PR035 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR035 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR035 00060F* CONTROL DATA PROPRIETARY PRODUCT PR035 00070F* PR035 0000080F* PR035 00090F* *************************************************************** PR035 00100F* * ************************************************* * PR035 00110F* * * * * PR035 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR035 00130F* * * * * PR035 00140F* * ************************************************* * PR035 0000150F* *************************************************************** PR035 00160F* PR035 00170F* ---- UPDATE QTD & YTD. ---- PR035 00180F* PR035 00190FWEARNS IP AF 140 DISK PR035 00200FPRMAST UC F 600R10AI 2 DISK PR035 00210I* PR035 0000220I* WEEKLY EARNINGS. PR035 00230I*----------------- PR035 00240IWEARNS NS 05 1 CP 2 C5 PR035 00250I OR 1 CP 2 CN PR035 00260I 15 181WRHRS PR035 00270I 19 211WSHRS PR035 00280I 22 241WHHRS PR035 0000290I 25 281WVHRS PR035 00300I 29 311WOHRS PR035 00310I 32 372WRPAY PR035 00320I 38 422WSICK PR035 00330I 43 472WHOLID PR035 00340I 48 532WVACAT PR035 00350I 54 582WOTPAY PR035 0000360I 59 632WFED PR035 00370I 64 682WFICA PR035 00380I 69 732WSDI PR035 00390I 74 782WSTATE PR035 00400I 79 832WCTAX PR035 00410I 90 921WDTHRS PR035 00420I 93 972WDTPAY PR035 0000430I 3 12 KEY L1 PR035 00440I 101 1052PPAY PR035 00450I 106 106 PTYPE PR035 00460I 107 1130PIECES PR035 00470I* COMMISION RECORD. PR035 00480I*------------------- PR035 00490I NS 06 1 CP 2 C6 PR035 0000500I OR 1 CP 2 CO PR035 00510I 13 192CCOMM PR035 00520I 23 292CFED PR035 00530I 30 342CFICA PR035 00540I 35 392CSDI PR035 00550I 40 452CSTATE PR035 00560I 3 12 KEY L1 PR035 0000570I* PR035 00580I* WEEKLY DEDUCTION SUMMARY. PR035 00590I* ------------------------- PR035 00600I NS 09 1 CP 2 C9 PR035 00610I OR 1 CP 2 CP PR035 00620I 50 552WHI PR035 00630I 67 712WSP PR035 0000640I 32 372WBONDS PR035 00650I 62 662WEQUIP PR035 00660I 38 432WUN PR035 00670I 56 612WPADV PR035 00680I 3 12 KEY PR035 00690I 14 192RAFWH PR035 00700I 20 252RASWH PR035 0000710I 26 312WCU PR035 00720I 44 492WLI PR035 00730I 72 762WPENS PR035 00740I 77 812WMISC PR035 00750I 82 872RACWH PR035 00760I 88 932VFW PR035 00770I 94 992VSW PR035 0000780I 3 12 KEY L1 PR035 00790I* PR035 00800I* UNUSED PR035 00810I* PR035 00820I NS 01 PR035 00830I 1 1 X@@ PR035 00840I* PR035 0000850I* EMP MASTER. PR035 00860I*------------ PR035 00870IPRMAST NS 02 PR035 00880I* PR035 00890I*Y.T.D. PORTION PR035 00900I*------------- PR035 00910I 172 1782YRPAY PR035 0000920I 179 1852YSICK PR035 00930I 186 1922YHOLID PR035 00940I 193 1992YVACAT PR035 00950I 200 2062YOTPAY PR035 00960I 315 3212YFED PR035 00970I 322 3282YFICA PR035 00980I 329 3332YSDI PR035 0000990I 334 3402YSTATE PR035 01000I 207 2132YCOMM PR035 01010I 341 3472YCTAX PR035 01020I 214 2202YDTPAY PR035 01030I 231 2351YRHRS PR035 01040I 236 2401YSHRS PR035 01050I 241 2451YHHRS PR035 0001060I 246 2501YVHRS PR035 01070I 251 2551YOHRS PR035 01080I 256 2601YDHRS PR035 01090I* PR035 01100I* QTLY PORTION PR035 01110I*----------- PR035 01120I 266 2722QRPAY PR035 0001130I 273 2792QSICK PR035 01140I 280 2862QHOLID PR035 01150I 287 2932QVACAT PR035 01160I 294 3002QOTPAY PR035 01170I 348 3542QFED PR035 01180I 355 3612QFICA PR035 01190I 362 3662QSDI PR035 0001200I 367 3732QSTATE PR035 01210I 301 3072QCOMM PR035 01220I 374 3802QCTAX PR035 01230I 308 3142QDTPAY PR035 01240I* PR035 01250I* YTD DEDUCTION PR035 01260I* ------------- PR035 0001270I 504 5102YHI PR035 01280I 526 5322YSP PR035 01290I 483 4892YBONDS PR035 01300I 518 5242YEQUIP PR035 01310I 476 4822YCU PR035 01320I 490 4962YUD PR035 01330I 497 5032YLI PR035 0001340I 511 5172YPADV PR035 01350I 533 5392YPENS PR035 01360I 540 5462YMISC PR035 01370C SETOF 5051 PR035 01380C L1 MOVEL' ' KEY PR035 01390C L1 KEY CHAINPRMAST 21 PR035 01400C L1 SETOF 22 PR035 0001410C L1 02 SETON 22 PR035 01420C* PR035 01430C* CLEARING COUNTERS. PR035 01440C* ------------------ PR035 01450C* PR035 01460C L1N02 Z-ADD0 YRPAY PR035 01470C L1N02 Z-ADD0 YCOMM PR035 0001480C L1N02 Z-ADD0 QRPAY PR035 01490C L1N02 Z-ADD0 QSICK PR035 01500C L1N02 Z-ADD0 QHOLID PR035 01510C L1N02 Z-ADD0 QVACAT PR035 01520C L1N02 Z-ADD0 QOTPAY PR035 01530C L1N02 Z-ADD0 QFED PR035 01540C L1N02 Z-ADD0 QFICA PR035 0001550C L1N02 Z-ADD0 QSDI PR035 01560C L1N02 Z-ADD0 QSTATE PR035 01570C L1N02 Z-ADD0 QCOMM PR035 01580C L1N02 Z-ADD0 QCTAX PR035 01590C L1N02 Z-ADD0 YHI PR035 01600C L1N02 Z-ADD0 YSP PR035 01610C L1N02 Z-ADD0 YBONDS PR035 0001620C L1N02 Z-ADD0 YEQUIP PR035 01630C L1N02 Z-ADD0 YDTPAY PR035 01640C L1N02 Z-ADD0 QDTPAY PR035 01650C* PR035 01660C* ROUTINE FOR WEEKLY EARNINGS. PR035 01670C* ---------------------------- PR035 01680C N05 GOTO BY05 PR035 0001690C* ********** PR035 01700C* PR035 01710C YRPAY ADD WRPAY YRPAY ADD TO YEAR PR035 01720C YSICK ADD WSICK YSICK TO DATE. PR035 01730C YHOLID ADD WHOLID YHOLID PR035 01740C YVACAT ADD WVACAT YVACAT PR035 01750C YOTPAY ADD WOTPAY YOTPAY PR035 0001760C YFED ADD WFED YFED PR035 01770C YFICA ADD WFICA YFICA PR035 01780C YSDI ADD WSDI YSDI PR035 01790C YSTATE ADD WSTATE YSTATE PR035 01800C YCTAX ADD WCTAX YCTAX PR035 01810C YDTPAY ADD WDTPAY YDTPAY PR035 01820C PTYPE COMP 'F' 50 PR035 0001830C N50 PTYPE COMP 'L' 51 PR035 01840C* PR035 01850C QRPAY ADD WRPAY QRPAY ADD TO QTLY. PR035 01860C QSICK ADD WSICK QSICK PR035 01870C QHOLID ADD WHOLID QHOLID PR035 01880C QVACAT ADD WVACAT QVACAT PR035 01890C QOTPAY ADD WOTPAY QOTPAY PR035 0001900C QFED ADD WFED QFED PR035 01910C QFICA ADD WFICA QFICA PR035 01920C QSDI ADD WSDI QSDI PR035 01930C QSTATE ADD WSTATE QSTATE PR035 01940C QCTAX ADD WCTAX QCTAX PR035 01950C QDTPAY ADD WDTPAY QDTPAY PR035 01960C* PR035 0001970C YRHRS ADD WRHRS YRHRS PR035 01980C YSHRS ADD WSHRS YSHRS PR035 01990C YHHRS ADD WHHRS YHHRS PR035 02000C YVHRS ADD WVHRS YVHRS PR035 02010C YOHRS ADD WOHRS YOHRS PR035 02020C YDHRS ADD WDTHRS YDHRS PR035 02030C* PR035 0002040C BY05 TAG PR035 02050C* ********** PR035 02060C* PR035 02070C* ROUTINE FOR COMMISSIONS. PR035 02080C* ----------------------- PR035 02090C N06 GOTO BY06 PR035 02100C* ********** PR035 0002110C* PR035 02120C YCOMM ADD CCOMM YCOMM YEARLY COMM. PR035 02130C QCOMM ADD CCOMM QCOMM QTLY COMM. PR035 02140C* PR035 02150C YFED ADD CFED YFED ADD TO YTD PR035 02160C YFICA ADD CFICA YFICA TAXES. PR035 02170C YSDI ADD CSDI YSDI PR035 0002180C YSTATE ADD CSTATE YSTATE PR035 02190C* PR035 02200C QFED ADD CFED QFED ADD TO QTLY PR035 02210C QFICA ADD CFICA QFICA TAXES. PR035 02220C QSDI ADD CSDI QSDI PR035 02230C QSTATE ADD CSTATE QSTATE PR035 02240C* PR035 0002250C BY06 TAG PR035 02260C* ********** PR035 02270C* PR035 02280C* ROUTINE FOR WEEKLY DEDUCTION SUMMARIES. PR035 02290C* --------------------------------------- PR035 02300C N09 GOTO BY09 PR035 02310C* ********** PR035 0002320C* PR035 02330C YHI ADD WHI YHI ADD TO YTD PR035 02340C YSP ADD WSP YSP DEDUCTIONS. PR035 02350C YBONDS ADD WBONDS YBONDS PR035 02360C YEQUIP ADD WEQUIP YEQUIP PR035 02370C YCU ADD WCU YCU PR035 02380C YUD ADD WUN YUD PR035 0002390C YLI ADD WLI YLI PR035 02400C YPADV ADD WPADV YPADV PR035 02410C YPENS ADD WPENS YPENS PR035 02420C YMISC ADD WMISC YMISC PR035 02430C YFED ADD RAFWH YFED PR035 02440C QFED ADD RAFWH QFED PR035 02450C YSTATE ADD RASWH YSTATE PR035 0002460C QSTATE ADD RASWH QSTATE PR035 02470C YCTAX ADD RACWH YCTAX PR035 02480C QCTAX ADD RACWH QCTAX PR035 02490C* PR035 02500C BY09 TAG PR035 02510C* ********** PR035 02520O* NEW Y.T.D. PR035 0002530O*------------ PR035 02540OPRMAST T L1 22 PR035 02550O YRPAY 178 PR035 02560O YSICK 185 PR035 02570O YHOLID 192 PR035 02580O YVACAT 199 PR035 02590O YOTPAY 206 PR035 0002600O YFED 321 PR035 02610O YFICA 328 PR035 02620O YSDI 333 PR035 02630O YSTATE 340 PR035 02640O YCTAX 347 PR035 02650O YCOMM 213 PR035 02660O YDTPAY 220 PR035 0002670O YRHRS 235 PR035 02680O YSHRS 240 PR035 02690O YHHRS 245 PR035 02700O YVHRS 250 PR035 02710O YOHRS 255 PR035 02720O YDHRS 260 PR035 02730O* PR035 0002740O* NEW QTLY. PR035 02750O*---------- PR035 02760O QRPAY 272 PR035 02770O QHOLID 286 PR035 02780O QVACAT 293 PR035 02790O QOTPAY 300 PR035 02800O QFED 354 PR035 0002810O QFICA 361 PR035 02820O QSDI 366 PR035 02830O QSTATE 373 PR035 02840O QCTAX 380 PR035 02850O QCOMM 307 PR035 02860O QDTPAY 314 PR035 02870O* PR035 0002880O* NEW YTD DEDUCTIONS. PR035 02890O* ------------------- PR035 02900O YHI 510 PR035 02910O YSP 532 PR035 02920O YBONDS 489 PR035 02930O YEQUIP 524 PR035 02940O YCU 482 PR035 0002950O YUD 496 PR035 02960O YLI 503 PR035 02970O YPADV 517 PR035 02980O YPENS 539 PR035 02990O YMISC 546 PR035 ** 003000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00301000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003020ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003030ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003040/* 003050__0O YMISC 546 PR035 ** 003000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0030100(,Z& }TXPR036 P999999111111(000010H S PR036 00020X DECK-ID B10 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR036 00030F* PRINT QTD AND YTD REQISTER PR036 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR036 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR036 00060F* CONTROL DATA PROPRIETARY PRODUCT PR036 00070F* PR036 0000080F* PR036 00090F* *************************************************************** PR036 00100F* * ************************************************* * PR036 00110F* * * * * PR036 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR036 00130F* * * * * PR036 00140F* * ************************************************* * PR036 0000150F* *************************************************************** PR036 00160F* PR036 00170F* P/R YEAR TO DATE & QUARTER TO DATE EARNINGS. PR036 00180F* PR036 00190FWEARNS IP AF 140 DISK PR036 00200FPRMAST IS AF 600 10AI 2 DISK PR036 00210FRPT O F 132 132 OF LPRINTER PR036 0000220FCNMAST IC F 128R 2AI 1 DISK PR036 00230LRPT 66FL 60OL PR036 00240ICNMAST NS 03 PR036 00250I 5 40 CONAME PR036 00260I* PR036 00270I* DATE RCD. PR036 00280I*----------- PR036 0000290IWEARNS NS 01 1 C# PR036 00300I 11 160DATE PR036 00310I 20 21 WKNUM PR036 00320I NS 09 PR036 00330I 1 1 X@@ PR036 00340I* PR036 00350I* EMP MASTER. PR036 0000360I*------------ PR036 00370IPRMAST NS 02 PR036 00380I 4 11 L1FLD L1 PR036 00390I 8 11 EMP PR036 00400I 4 7 DEPT PR036 00410I 2 30DIV L2 PR036 00420I 012 013 MINIT PR036 0000430I 014 033 MNAME PR036 00440I* PR036 00450I*Y.T.D. RCD. PR036 00460I*------------- PR036 00470I 172 1782YRPAY PR036 00480I 179 1852YSICK PR036 00490I 186 1922YHOLID PR036 0000500I 193 1992YVACAT PR036 00510I 200 2062YOTPAY PR036 00520I 315 3212YFED PR036 00530I 322 3282YFICA PR036 00540I 329 3332YSDI PR036 00550I 334 3402YSTATE PR036 00560I 207 2132YCOMM PR036 0000570I 214 2202YDTPAY PR036 00580C 69 GOTO RNDA PR036 00590C SETON 2269 PR036 00600C EXCPT PR036 00610C SETOF 22 PR036 00620C RNDA TAG PR036 00630C L2 PR036 0000640COR OF SETON 22 PR036 00650C 22 EXCPT PR036 00660C SETOF 22 PR036 00670C L2 MOVELDIV KEY2 4 PR036 00680C L2 DIV CHAINCNMAST 20 PR036 00690C* PR036 00700C* ROUTINE AT END OF EMPLOYEE. PR036 0000710C* --------------------------- COMBINE REG & PR036 00720CL1 RZCOMM ADD YRPAY RZCOMM 72 COMM FOR RPT. PR036 00730CL1 RZCOMM ADD YCOMM RZCOMM PR036 00740CL1 YOTPAY ADD YDTPAY YOTPAY PR036 00750CL1 YGROSS ADD RZCOMM YGROSS 72 CROSSFOOT FOR PR036 00760CL1 YGROSS ADD YSICK YGROSS GROSS PAY. PR036 00770CL1 YGROSS ADD YHOLID YGROSS PR036 0000780CL1 YGROSS ADD YVACAT YGROSS PR036 00790CL1 YGROSS ADD YOTPAY YGROSS PR036 00800CL1 DRZCOM ADD RZCOMM DRZCOM 92 TOTALS FOR PR036 00810CL1 DSICK ADD YSICK DSICK 82 DEPARTMENT. PR036 00820CL1 DHOLID ADD YHOLID DHOLID 82 PR036 00830CL1 DVACAT ADD YVACAT DVACAT 82 PR036 00840CL1 DOTPAY ADD YOTPAY DOTPAY 82 PR036 0000850CL1 DGROSS ADD YGROSS DGROSS 92 PR036 00860CL1 DFED ADD YFED DFED 92 PR036 00870CL1 DFICA ADD YFICA DFICA 82 PR036 00880CL1 DSDI ADD YSDI DSDI 82 PR036 00890CL1 DSTATE ADD YSTATE DSTATE 92 PR036 00900ORPT E 101 22 PR036 00910O N20 CONAME 74 PR036 0000920O 111 'RUN DATE' PR036 00930O UDATE Y 120 PR036 00940O E 1 22 PR036 00950O 6 'PR0036' PR036 00960O 111 'W/E DATE' PR036 00970O DATE Y 120 PR036 00980O E 1 22 PR036 0000990O 10 'P/R Y.T.D.' PR036 01000O 27 'REGISTER, WEEK #' PR036 01010O WKNUM 30 PR036 01020O 111 'PAGE NO.' PR036 01030O PAGE Z 117 PR036 01040O DIV 52 PR036 01050O E 1 22 PR036 0001060O 24 '------------------------' PR036 01070O 48 '------------------------' PR036 01080O 72 '------------------------' PR036 01090O 96 '------------------------' PR036 01100O 120 '------------------------' PR036 01110O 132 '------------------------' PR036 01120O E 1 22 PR036 0001130O 20 'E M P L O Y E E' PR036 01140O 46 '---------------' PR036 01150O 61 '-P A Y---------' PR036 01160O 76 '---------------' PR036 01170O 87 '-----------' PR036 01180O 111 'T A X E S' PR036 01190O E 1 22 PR036 0001200O 4 'DEPT' PR036 01210O 7 '#' PR036 01220O 12 'NAME' PR036 01230O 40 'REG & COMM' PR036 01240O 51 'O/T' PR036 01250O 59 'SICK' PR036 01260O 68 'HOL' PR036 0001270O 77 'VAC' PR036 01280O 87 'GROSS' PR036 01290O 104 'FED FICA' PR036 01300O 120 'SDI STATE' PR036 01310O E 1 22 PR036 01320O 24 '------------------------' PR036 01330O 48 '------------------------' PR036 0001340O 72 '------------------------' PR036 01350O 96 '------------------------' PR036 01360O 120 '------------------------' PR036 01370O 132 '------------------------' PR036 01380ORPT T 1 L1 PR036 01390O DEPT 4 PR036 01400O EMP 9 PR036 0001410O MINIT 12 PR036 01420O MNAME 33 PR036 01430O YSTATEKB 121 PR036 01440O YSDI KB 112 PR036 01450O YFICA KB 105 PR036 01460O YFED KB 98 PR036 01470O YGROSSKB 88 PR036 0001480O YVACATKB 78 PR036 01490O YHOLIDKB 69 PR036 01500O YSICK KB 60 PR036 01510O YOTPAYKB 52 PR036 01520O RZCOMMKB 41 PR036 01530ORPT TF11 L2 PR036 01540O 14 'TOTAL FOR COMP' PR036 0001550O DSDI KB 112 PR036 01560O DFED KB 98 PR036 01570O DVACATKB 78 PR036 01580O DHOLIDKB 69 PR036 01590O DOTPAYKB 52 PR036 01600O DRZCOMKB 41 PR036 01610O T 2 L2 PR036 0001620O DSTATEKB 121 PR036 01630O DFICA KB 105 PR036 01640O DGROSSKB 88 PR036 01650O DSICK KB 60 PR036 ** 001660ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001670ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00168000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001690ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001700/* 001710__0O DSICK KB 60 PR036 ** 001660ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001670ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0016800(XZ 'TXPR040 P999999111111(00101 H S 1 PR040 X DECK-ID B11 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR040 F* PRINT PAYCHECKS PR040 F* CYBER 18-10M/20 PAYROLL VERSION 1.0 F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F* CONTROL DATA PROPRIETARY PRODUCT F* 000201 F* PR00400202 F* *************************************************************** PR00400203 F* * ************************************************* * PR00400204 F* * * * * PR00400205 F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR00400206 F* * * * * PR00400207 F* * ************************************************* * PR0040000208 F* *************************************************************** PR00400209 F* PR00400210 F* ---- P/R CHECKS. ---- PR00400211 F* PR00400212 F* U1- RESTART OF CHECK RUN. ASK FOR STARTING DEPT/EMP#. PR00400213 F* NU8- PRINT YEAR TO DATE AMOUNTS PR00400214 F* PR0040000215 F* MODIFIED 03/15/76 TO REMOVE PIECE PAY FOR LUGS & FLATS. PR00400216 F* MODIFIED 04/06/76 TO CORRECT FORMATTING OF PRINT. PR00400217 F* MODIFIED 06/18/76 TO SUPPRESS YEAR TO DATE AMOUNT PRINTING WITH PR00400218 F* U8 ON. PR00400219 F* MODIFIED 07/07/76 TO PICK UP CONTROL # FROM 'P6' RECS. PR00400220 F* PR00400221 FWEARNS IP AF 140 DISK PR0040000222 FPRMAST IC F 600R10AI 2 DISK PR00400223 FRPT O F 132 OF PRINTER PR00400301 E MSG 1 3 30 PROMPTS FOR RERUNPR040 0401 I* WEEKLY EARNINGS. PR00400402 I* PR00400403 I* ----------------- PR00400404 IWEARNS NS 01 1 CP 2 C5 PR0040000405 I 9 12 EMPL L1 PR00400406 I 5 80DEPT PR00400407 I 3 40DIV L2 PR00400408 I 3 12 KEY PR00400409 I 15 181RHRS PR00400410 I 19 211SHRS PR00400411 I 22 241HHRS PR0040000412 I 25 281VHRS PR00400413 I 29 311OHRS PR00400414 I 90 921DHRS PR00400415 I 32 372RPAY PR00400416 I 38 422SPAY PR00400417 I 43 472HPAY PR00400418 I 48 532VPAY PR0040000419 I 54 582OPAY PR00400420 I 93 972DPAY PR00400421 I 59 632FWH PR00400422 I 64 682FICA PR00400423 I 69 732SDI PR00400424 I 74 782SWH PR00400425 I 79 832CWH PR0040000426 I 84 89 CNTLNO PR00400427 I* PR00400428 I* COMMISSION RECORD * PR00400429 I* PR0 400430 I NS 08 1 CP 2 C6 PR00400431 I 9 12 EMPL L1 PR00400432 I 5 80DEPT PR0040000433 I 3 40DIV L2 PR00400434 I 3 12 KEY PR00400435 I 13 192CAMT PR00400436 I 23 292CFWH PR00400437 I 30 342FICA PR00400438 I 35 392SDI PR00400439 I 40 452CSWH PR0040000440 I 84 89 CNTLNO PR00400441 I 84 89 CNTLNO PR00400442 I* PR00400443 I* WEEKLY DEDUCTIONS. PR00400444 I* ------------------ PR00400445 I NS 02 1 CP 2 C9 PR00400446 I 9 12 EMPL L1 PR0040000447 I 5 80DEPT PR00400448 I 3 40DIV L2 PR00400449 I 3 12 KEY PR00400450 I 14 192T01 PR00400451 I 20 252T02 PR00400452 I 26 312T03 PR00400453 I 32 372T04 PR0040000454 I 38 432T05 PR00400455 I 44 492T06 PR00400456 I 50 552T07 PR00400457 I 56 612T08 PR00400458 I 62 662T09 PR00400459 I 67 712T10 PR00400460 I 72 762T11 PR0040000461 I 77 812T12 PR00400462 I 82 872T13 PR00400463 I 88 932T14 PR00400464 I 94 992T15 PR00400465 I* PR00400466 I* DATE CARD. PR00400467 I* ---------- PR0040000468 I NS 07 1 C# PR00400469 I 11 160WEDATE PR00400470 I 20 21 WKNO PR00400471 I NS 06 PR00400472 I 1 1 X@@ PR00400473 I* PR00400474 I* EMPLOYEE MASTER. PR0040000475 I* ---------------- PR00400476 IPRMAST NS 03 PR00400477 I 012 012 FI 11 PR00400478 I 013 013 SI 12 PR00400479 I 014 033 NAME PR00400480 I 034 067 ADDRS PR00400481 I 068 085 CITY PR0040000482 I 088 089 STATE PR00400483 I 90 940ZIP PR00400484 I 101 103 SS1 PR00400485 I 104 105 SS2 PR00400486 I 106 109 SS3 PR00400487 I 172 1782YPAYR PR00400488 I 179 1852YPAYS PR0040000489 I 186 1922YPAYH PR00400490 I 193 1992YPAYV PR00400491 I 200 2062YPAYO PR00400492 I 207 2132YPAYC PR00400493 I 214 2202YPAYD PR00400494 I 231 2351YHRSR PR00400495 I 236 2401YHRSS PR0040000496 I 241 2451YHRSH PR00400497 I 246 2501YHRSV PR00400498 I 251 2551YHRSO PR00400499 I 256 2601YHRSD PR00400501 I 315 3212YFWH PR00400502 I 322 3282YFICA PR00400503 I 329 3332YSDI PR0040000504 I 334 3402YSWH PR00400505 I 341 3472YCWH PR00400506 I 476 4822YT03 PR00400507 I 483 4892YT04 PR00400508 I 490 4962YT05 PR00400509 I 497 5032YT06 PR00400510 I 504 5102YT07 PR0040000511 I 511 5172YT08 PR00400512 I 518 5242YT09 PR00400513 I 526 5322YT10 PR00400514 I 533 5392YT11 PR00400515 I 540 5462YT12 42 PR00400516 I 555 564 EFNME 45 PR00400517 I 133 133 SHIFT PR0040000518 I 132 132 TYPEE PR00400519 I* PR00400601 C* PR00400602 C SETOF 4344 PR00400603 C U1N22 EXSR RESTRT GET DEPT/EMP# PR00400604 C* ********** PR00400605 C L1 MOVEL' ' KEY PR0040000606 C L1 KEY CHAINPRMAST 20 PR00400607 C L1NU1 SETON 23 PR00400608 C L1 U1N23KEY COMP TSTKEY 23 23 PR00400609 C L1N23 GOTO BY08 PR00400610 C* ********** PR00400611 C L1 Z-ADD0 L1RHRS PR00400612 C L1 Z-ADD0 L1SHRS PR0040000613 C L1 Z-ADD0 L1HHRS PR00400614 C L1 Z-ADD0 L1VHRS PR00400615 C L1 Z-ADD0 L1OHRS PR00400616 C L1 Z-ADD0 L1DHRS PR00400617 C L1 Z-ADD0 L1RPAY PR00400618 C L1 Z-ADD0 L1SPAY PR00400619 C L1 Z-ADD0 L1HPAY PR0040000620 C L1 Z-ADD0 L1VPAY PR00400621 C L1 Z-ADD0 L1OPAY PR00400622 C L1 Z-ADD0 L1DPAY PR00400623 C L1 Z-ADD0 L1FWH PR00400624 C L1 Z-ADD0 L1FICA PR00400625 C L1 Z-ADD0 L1SDI PR00400626 C L1 Z-ADD0 L1SWH PR0040000627 C L1 Z-ADD0 L1CWH PR00400628 C L1 Z-ADD0 L1T01 PR00400629 C L1 Z-ADD0 L1T02 PR00400630 C L1 Z-ADD0 L1T03 PR00400631 C L1 Z-ADD0 L1T04 PR00400632 C L1 Z-ADD0 L1T05 PR00400633 C L1 Z-ADD0 L1T06 PR0040000634 C L1 Z-ADD0 L1T07 PR00400635 C L1 Z-ADD0 L1T08 PR00400636 C L1 Z-ADD0 L1T09 PR00400637 C L1 Z-ADD0 L1T10 PR00400638 C L1 Z-ADD0 L1T11 PR00400639 C L1 Z-ADD0 L1T12 PR00400640 C L1 Z-ADD0 L1T13 PR0040000641 C L1 Z-ADD0 L1T14 PR00400642 C L1 Z-ADD0 L1T15 PR00400643 C* ROUTINE FOR EARNINGS. PR00400644 C* ---------------------- PR00400645 C N01 GOTO BY01 PR00400646 C* ********** PR00400647 C* PR0040000648 C L1RHRS ADD RHRS L1RHRS 51 PR00400649 C L1SHRS ADD SHRS L1SHRS 51 PR00400650 C L1HHRS ADD HHRS L1HHRS 51 PR00400651 C L1VHRS ADD VHRS L1VHRS 51 PR00400652 C L1OHRS ADD OHRS L1OHRS 51 PR00400653 C L1DHRS ADD DHRS L1DHRS 51 PR00400654 C L1RPAY ADD RPAY L1RPAY 72 PR0040000655 C L1SPAY ADD SPAY L1SPAY 72 PR00400656 C L1HPAY ADD HPAY L1HPAY 72 PR00400657 C L1VPAY ADD VPAY L1VPAY 72 PR00400658 C L1OPAY ADD OPAY L1OPAY 72 PR00400659 C L1DPAY ADD DPAY L1DPAY 72 PR00400660 C L1FWH ADD FWH L1FWH 72 PR00400661 C L1FICA ADD FICA L1FICA 72 PR0040000662 C L1SDI ADD SDI L1SDI 72 PR00400663 C L1SWH ADD SWH L1SWH 72 PR00400664 C L1CWH ADD CWH L1CWH 72 PR00400665 C* PR00400666 C BY01 TAG PR00400667 C* ********** PR00400668 C* PR0040000669 C* ROUTINE FOR DEDUCTIONS. PR00400670 C* ----------------------- PR00400671 C N02 GOTO BY02 PR00400672 C* ********** PR00400673 C* PR00400674 C L1T01 ADD T01 L1T01 72 PR00400675 C L1T02 ADD T02 L1T02 72 PR0040000676 C L1T03 ADD T03 L1T03 72 PR00400677 C L1T04 ADD T04 L1T04 72 PR00400678 C L1T05 ADD T05 L1T05 72 PR00400679 C L1T06 ADD T06 L1T06 72 PR00400680 C L1T07 ADD T07 L1T07 72 PR00400681 C L1T08 ADD T08 L1T08 72 PR00400682 C L1T09 ADD T09 L1T09 72 PR0040000683 C L1T10 ADD T10 L1T10 72 PR00400684 C L1T11 ADD T11 L1T11 72 PR00400685 C L1T12 ADD T12 L1T12 72 PR00400686 C L1T13 ADD T13 L1T13 72 PR00400687 C L1T14 ADD T14 L1T14 72 PR00400688 C L1T15 ADD T15 L1T15 72 PR00400689 C* PR0040000690 C BY02 TAG PR00400691 C* ********** PR00400692 C* PR00400693 C* ROUTINE FOR YTD. PR00400694 C* ---------------- PR00400695 C N03 GOTO BY03 PR00400696 C* ********** PR0040000697 C* PR00400698 C YPAYR ADD YPAYC YPAYR PR00400699 C YPAYO ADD YPAYD YPAYO PR00400701 C YHRSO ADD YHRSD YHRSO PR00400702 C YPAYR ADD YPAYS YPAYT 82 PR00400703 C YPAYT ADD YPAYH YPAYT PR00400704 C YPAYT ADD YPAYV YPAYT PR0040000705 C YPAYT ADD YPAYO YPAYT PR00400706 C YHRSR ADD YHRSS YHRST 61 PR00400707 C YHRST ADD YHRSH YHRST PR00400708 C YHRST ADD YHRSV YHRST PR00400709 C YHRST ADD YHRSO YHRST PR00400710 C YFWH ADD YFICA YTAXS 82 PR00400711 C YTAXS ADD YSDI YTAXS PR0040000712 C YTAXS ADD YSWH YTAXS PR00400713 C YTAXS ADD YCWH YTAXS PR00400714 C YT03 ADD YT04 YDEDS 82 PR00400715 C YDEDS ADD YT05 YDEDS PR00400716 C YDEDS ADD YT06 YDEDS PR00400717 C YDEDS ADD YT07 YDEDS PR00400718 C YDEDS ADD YT08 YDEDS PR0040000719 C YDEDS ADD YT09 YDEDS PR00400720 C YDEDS ADD YT10 YDEDS PR00400721 C YDEDS ADD YT11 YDEDS PR00400722 C YDEDS ADD YT12 YDEDS PR00400723 C YPAYT SUB YTAXS YNET1 82 PR00400724 C YNET1 SUB YDEDS YNET2 82 PR00400725 C* PR0040000726 C BY03 TAG PR00400727 C* ********** PR00400728 C N08 GOTO BY08 PR00400729 C* ********** PR00400730 C L1RPAY ADD CAMT L1RPAY PR00400731 C L1FWH ADD CFWH L1FWH PR00400732 C L1FICA ADD FICA L1FICA PR0040000733 C L1SDI ADD SDI L1SDI PR00400734 C L1SWH ADD CSWH L1SWH PR00400735 C* PR00400736 C BY08 TAG PR00400737 C* ********** PR00400738 C********************************************************************PR00400739 C* PR0040000740 CL1N23 GOTO LASTL1 PR00400741 C* ********** PR00400742 CL1 L1T01 ADD L1FWH L1FWH PR00400743 CL1 L1T02 ADD L1SWH L1SWH PR00400744 CL1 L1T13 ADD L1CWH L1CWH PR00400745 CL1 L1OHRS ADD L1DHRS L1OHRS PR00400746 CL1 L1OPAY ADD L1DPAY L1OPAY PR0040000747 CL1 L1RHRS ADD L1SHRS L1THRS 51 PR00400748 CL1 L1THRS ADD L1HHRS L1THRS PR00400749 CL1 L1THRS ADD L1VHRS L1THRS PR00400750 CL1 L1RPAY ADD L1SPAY L1TPAY 82 PR00400751 CL1 L1TPAY ADD L1HPAY L1TPAY PR00400752 CL1 L1TPAY ADD L1VPAY L1TPAY PR00400753 CL1 L1TPAY ADD L1OPAY L1TPAY PR0040000754 CL1 L1FWH ADD L1FICA L1TAXS 82 PR00400755 CL1 L1TAXS ADD L1SDI L1TAXS PR00400756 CL1 L1TAXS ADD L1SWH L1TAXS PR00400757 CL1 L1TAXS ADD L1CWH L1TAXS PR00400758 CL1 L1T03 ADD L1T04 L1DEDS 82 PR00400759 CL1 L1DEDS ADD L1T05 L1DEDS PR00400760 CL1 L1DEDS ADD L1T06 L1DEDS PR0040000761 CL1 L1DEDS ADD L1T07 L1DEDS PR00400762 CL1 L1DEDS ADD L1T08 L1DEDS PR00400763 CL1 L1DEDS ADD L1T09 L1DEDS PR00400764 CL1 L1DEDS ADD L1T10 L1DEDS PR00400765 CL1 L1DEDS ADD L1T11 L1DEDS PR00400766 CL1 L1DEDS ADD L1T12 L1DEDS PR00400767 CL1 L1DEDS ADD L1T14 L1DEDS PR0040000768 CL1 L1DEDS ADD L1T15 L1DEDS PR00400769 CL1 L1TPAY SUB L1TAXS L1NET1 82 PR00400770 CL1 L1NET1 SUB L1DEDS L1NET2 82 21 21 PR00400771 CL1 MOVELL1NET2 L1WRK6 60 PR00400772 CL1 MOVE L1NET2 L1WRK2 20 PR00400773 CL1 LASTL1 TAG PR00400774 C* ********** PR0040000775 CL1N23 SETOF 21 DON'T PRINT IF PR00400776 C** STILL LOOK- PR00400777 C** ING FOR 1ST PR00400778 C** DEPT/EMP#. PR00400779 C********************************************************************PR00400780 C* *PR00400781 C* GET BEGINNING DEPT/EMP# WHEN DOING A RE-RUN. SETS ON 22. *PR0040000782 C* *PR00400783 CSR RESTRT BEGSR PR00400784 C* ********** PR00400785 CSR MOVELMSG,1 BUFFER 72 PR00400786 CSR MOVE 'T' TYPE 1 PR00400787 CSR Z-ADD30 BLNGTH 20 PR00400789 C* ********** PR004000 CSR EXITFSUBRCM SUBCM CSR RLABL BUFFER 72 SUBCM CSR RLABL TYPE 1 SUBCM CSR RLABL BLNGTH 20 SUBCM CSR RLABL RCODE 1 SUBCM CSR RLABL MASK 10 SUBCM CSR RLABL DTYPE 10 SUBCM 000795 CSR RSTAG1 TAG PR00400796 C* ********** PR00400797 CSR MOVELMSG,2 BUFFER PR0040 CSR EXITFSUBRCM SUBCM CSR RLABL BUFFER 72 SUBCM CSR RLABL TYPE 1 SUBCM CSR RLABL BLNGTH 20 SUBCM 00 CSR RLABL RCODE 1 SUBCM CSR RLABL MASK 10 SUBCM CSR RLABL DTYPE 10 SUBCM 0799 C* ********** PR00400801 CSR Z-ADD8 BLNGTH GET BEGINNING PR00400802 CSR MOVE 'A' TYPE DEPT/EMP#. PR0040 CSR EXITFSUBRCM SUBCM 00 CSR RLABL BUFFER 72 SUBCM CSR RLABL TYPE 1 SUBCM CSR RLABL BLNGTH 20 SUBCM CSR RLABL RCODE 1 SUBCM CSR RLABL MASK 10 SUBCM CSR RLABL DTYPE 10 SUBCM 0804 C* ********** PR0040000805 CSR RCODE COMP 'R' 23IF RUB-OUT OR PR00400806 CSRN23 RCODE COMP 'L' 23 LINE-FEED, PR00400807 CSRN23 GOTO RSTAG2 RETRY. PR00400808 C* ********** PR00400809 CSR Z-ADD30 BLNGTH PR00400810 CSR MOVE 'T' TYPE PR00400811 CSR GOTO RSTAG1 PR0040000812 C* ********** PR00400813 CSR RSTAG2 TAG RIGHT ADJUST PR00400814 C* ********** PR00400815 CSR MOVELBUFFER VAR 15 REPLY IN PR00400816 CSR Z-ADD10 VL 20 10-CHAR FLD. PR00400817 CSR EXIT SUBRAJ PR00400818 C* ********** PR0040000819 CSR RLABL VAR PR00400820 CSR RLABL VL PR00400821 CSR MOVELVAR TSTKEY 10 PR00400822 CSR MOVEL' ' TSTKEY PR00400823 CSR TSTKEY CHAINPRMAST 23 IF NOT VASLID, PR00400824 CSRN23 GOTO RSTEND RETRY. PR00400825 C* ********** PR0040000826 CSR MOVELMSG,3 BUFFER PR00400827 CSR Z-ADD30 BLNGTH PR00400828 CSR MOVE 'T' TYPE PR0040 CSR EXITFSUBRCM SUBCM CSR RLABL BUFFER 72 SUBCM CSR RLABL TYPE 1 SUBCM CSR RLABL BLNGTH 20 SUBCM 00 CSR RLABL RCODE 1 SUBCM CSR RLABL MASK 10 SUBCM CSR RLABL DTYPE 10 SUBCM 0830 C* ********** PR00400831 CSR GOTO RSTAG1 PR00400832 C* ********** PR00400833 CSR RSTEND TAG PR0040000834 C* ********** PR00400835 CSR SETON 22 *PR00400836 CSR ENDSR PR00400837 C********************************************************************PR00400901 O* PR00400902 O* CHECKS. PR00400903 O* ------- PR00400009031ORPT H 10 1P PR040 09032O 58 'XXXXXX XXXXXXXX' PR040 09033O 76 'XXXXXX XXXXXXXX' PR040 09034O 93 'XX XXXX X ' PR040 09035O 113 'XXXXXXXXXXXXXXXXXXXX' PR040 09036O 124 '999-99-9999' PR040 0904 ORPT H 1P PR0040000905 O 60 'X' PR00400906 O T 23 L1 21 PR00400907 O 1 ' ' PR00400908 ORPT T 1 L1 21 PR00400909 O SS3 124 PR00400910 O 120 '- -' PR00400911 O SS2 119 PR0040000912 O SS1 116 PR00400913 O NAME 113 PR00400914 O SI 92 PR00400915 O FI 91 PR00400916 O EMPL 88 PR00400917 O DEPT Z 82 PR00400918 O WEDATEY 76 PR0040000919 O CNTLNO 67 PR00400920 O UDATE Y 58 PR00400921 O CNTLNO 49 PR00400922 O* PR00400923 O T 1 L1 21 PR00400924 O 110 'SICK' PR00400925 ORPT T 1 L1 21 PR0040000926 O L1THRSK 124 PR00400927 O L1SHRSK 114 PR00400928 O L1VHRSK 104 PR00400929 O L1HHRSK 94 PR00400930 O L1OHRSK 84 PR00400931 O L1RHRSK 74 PR00400932 O* PR0040000933 ORPT T 1 L1 21 PR00400934 O 1 ' ' PR00400935 O NU8 YHRST K 124 PR00400936 O NU8 YHRSH K 94 PR00400937 O NU8 YHRSO K 84 PR00400938 O NU8 YHRSS K 114 PR00400939 O NU8 YHRSV K 104 PR0040000940 O NU8 YHRSR K 74 PR00400941 O* PR00400942 ORPT T 1 L1 21 PR00400943 O L1TPAYK 125 PR00400944 O L1SPAYK 115 PR00400945 O L1VPAYK 105 PR00400946 O L1HPAYK 95 PR0040000947 O L1OPAYK 85 PR00400948 O L1RPAYK 75 PR00400949 O* PR00400950 ORPT T 2 L1 21 PR00400951 O NU8 YPAYT K 125 PR00400952 O NU8 YPAYS K 115 PR00400953 O NU8 YPAYV K 105 PR0040000954 O NU8 YPAYH K 95 PR00400955 O NU8 YPAYO K 85 PR00400956 O NU8 YPAYR K 75 PR00400957 O L1NET2J 58 '*' PR00400958 O 41 'CENTS' PR00400959 O L1WRK2X 35 PR00400960 O 32 'DOLLARS AND' PR0040000961 O L1WRK6J 21 '$' PR00400962 O 13 'THE SUM OF' PR00400963 O* PR00400964 ORPT T 1 L1 21 PR00400965 O L1NET13 132 PR00400966 O L1TAXS3 124 PR00400967 O L1SDI K 115 PR0040000968 O L1FICAK 105 PR00400969 O L1CWH K 95 PR00400970 O L1SWH K 85 PR00400971 O L1FWH K 75 PR00400972 O* PR00400973 ORPT T 1 L1 21 PR00400974 O 1 ' ' PR0040000975 O NU8 YNET1 3 132 PR00400976 O NU8 YTAXS 3 124 PR00400977 O NU8 YSDI K 115 PR00400978 O NU8 YFICA K 105 PR00400979 O NU8 YCWH K 95 PR00400980 O NU8 YSWH K 85 PR00400981 O NU8 YFWH K 75 PR0040000982 O* PR00400983 ORPT T 1 L1 21 PR00400984 O N42 123 'MISC LIFE INS' PR00400985 O 82 'CR UNION BONDS' PR00400986 O 101 'ADVANCE UNION' PR00400987 O 45 NAME 27 PR00400988 O 45 SI 6 PR0040000989 O 45 FI 5 PR00400990 O N45 NAME 34 PR00400991 O N45 EFNME 13 PR00400992 O* PR00400993 ORPT T 1 L1 21 PR00400994 O L1DEDS3 132 PR00400995 O L1T12 K 115 PR0040000996 O L1T05 K 105 PR00400997 O L1T08 K 95 PR00400998 O L1T06 K 125 PR00400999 O L1T04 K 85 PR00401001 O L1T03 K 75 PR00401002 O ADDRS 37 PR00401003 O* PR0040001004 ORPT T 1 L1 21 PR00401005 O NU8 YDEDS 3 132 PR00401006 O NU8 YT12 K 115 PR00401007 O NU8 YT05 K 105 PR00401008 O NU8 YT08 K 95 PR00401009 O NU8 YT06 3 124 PR00401010 O NU8 YT04 K 85 PR0040001011 O NU8 YT03 K 75 PR00401012 O ZIP Z 30 PR00401013 O STATE 24 PR00401014 O CITY 21 PR00401015 O* PR00401016 O T 1 L1 21 PR00401017 O 82 'HLTH INS MCHDSE' PR0040001018 O 103 'STOCK PENSION' PR00401019 ORPT T 1 L1 21 PR00401020 O L1NET23 132 PR00401021 O L1T11 K 105 PR00401022 O L1T10 K 95 PR00401023 O L1T09 K 85 PR00401024 O L1T07 K 75 PR0040001025 O* PR00401026 ORPT T 2 L1 21 PR00401027 O 1 ' ' PR00401028 O NU8 YNET2 3 132 PR00401029 O NU8 YT11 K 105 PR00401030 O NU8 YT10 K 95 PR00401031 O NU8 YT09 K 85 PR0040001032 O NU8 YT07 K 75 PR00401033 O* PR0040** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00** MESSAGE ARRAY PR0040 * RERUN OF CHECK PRINTING * PR0040ENTER DEPT/EMP OF 1ST CHECK... PR0040 * INVALID DEPT/EMP # * PR0040/* __EQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0([ TXPR062 P999999111111(00101 H S PR062 00020X DECK-ID B12 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR062 00030F* PRINT MONTHLY COMPENSATION REPORT PR062 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR062 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR062 00060F* CONTROL DATA PROPRIETARY PRODUCT PR062 00070F* PR062 0000080F* PR062 00090F* *************************************************************** PR062 00100F* * ******************************************************** PR062 00110F* * * * * PR062 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR062 00130F* * * * * PR062 00140F* * ******************************************************** PR062 0000150F* *************************************************************** PR062 00160F* PR062 00170F* ---- MONTHLY COMP REPORT. ---- PR062 00180F* PR062 00190F* PR062 00200F* PR062 00210FMEARNS IP AF 140 140 DISK PR062 0000220FRPT O F 132 132 OF LPRINTER PR062 00230FPRMAST IC F 600 600R10AI 2 DISK PR062 00240FCNMAST IC F 128 128R02AI 1 DISK PR062 00250E TABM 1 12 2 0 TABD 9 MONTHS PR062 00260E* TABA 1 24 5 TABF 4 INSURANCE RATES.PR062 00270LRPT 66FL 55OL PR062 00280ICNMAST NS 04 PR062 0000290I 5 40 CONAME PR062 00300I* PR062 00310I* PR062 00320I* PR062 00330I* EMPLOYEE MASTER. PR062 00340I* ---------------- PR062 00350IPRMAST NS 01 PR062 0000360I 012 013 INIT PR062 00370I 014 033 NAME PR062 00380I 130 130 CODE PR062 00390I 155 156 STCODE PR062 00400I 172 1782YTDPAY PR062 00410I 200 2062OVTPAY PR062 00420I 214 2202DBLPAY PR062 0000430I* PR062 00440I* EARNINGS RECORDS. PR062 00450I* ----------------- PR062 00460IMEARNS NS 02 1 CP 2 C5 PR062 00470I OR 1 CP 2 CN PR062 00480I 9 12 EMP L1 PR062 00490I 5 8 DEP L2 PR062 0000500I 3 40LOC L3 PR062 00510I 15 181RHRS PR062 00520I 32 372RPAY PR062 00530I 29 311OHRS PR062 00540I 54 582OPAY PR062 00550I 90 921DHRS PR062 00560I 93 972DPAY PR062 0000570I 3 12 KEY PR062 00580I* PR062 00590I* UNUSED RECORDS. PR062 00600I* --------------- PR062 00610I NS 03 PR062 00620I 1 1 UNUSED PR062 00630C N99 UMONTH LOKUPTABM TABD 98 PR062 0000640C N99 98 MOVELTABD MONTH 9 PR062 00650C SETON 99 PR062 00660C* CLEAR INDICATORS. PR062 00670C* ----------------- PR062 00680C L1 SETOF 212223 PR062 00690C L1 SETOF 242526 PR062 00700C L1 SETOF 272829 PR062 0000710C L1 SETOF 31 PR062 00720C L1 Z-ADD0 EPAY PR062 00730C L1 Z-ADD0 EHRS PR062 00740C L1 MOVEL' ' KEY PR062 00750C L1 KEY CHAINPRMAST 20 PR062 00760C* PR062 00770C L2 MOVE DEP PDEP 4 PR062 0000780C L3 LOC CHAINCNMAST 15 PR062 00790C OF MOVE DEP PDEP PR062 00800C* PR062 00810C* ROUTINE FOR EMPLOYEE MASTER. PR062 00820C* PR062 00830C N01 GOTO BY1 PR062 00840C* ********** PR062 0000850C* PR062 00860C CODE COMP '1' 21 DETERMINE PR062 00870C CODE COMP '2' 22 COMP CODE. PR062 00880C CODE COMP '3' 23 PR062 00890C CODE COMP '4' 24 PR062 00900C CODE COMP '5' 25 PR062 00910C CODE COMP '6' 26 PR062 0000920C CODE COMP '7' 27 PR062 00930C CODE COMP '8' 28 PR062 00940C CODE COMP '9' 29 PR062 00950C CODE COMP '0' 31 PR062 00960C OVTPAY MULT 2 TPAY 83 PR062 00970C TPAY DIV 3 TTPAY 72H PR062 00980C YTDPAY ADD TTPAY YTDPAY PR062 0000990C DBLPAY DIV 2 TTPAY H PR062 01000C YTDPAY ADD TTPAY YTDPAY PR062 01010C BY1 TAG PR062 01020C* ********** PR062 01030C* PR062 01040C* ROUTINE FOR EARNINGS RECORDS. PR062 01050C* PR062 0001060C N02 GOTO BY2 PR062 01070C* ********** PR062 01080C* PR062 01090C EPAY ADD RPAY EPAY 72 ACCUM EMPL PR062 01100C OPAY MULT 2 TPAY PR062 01110C TPAY DIV 3 TTPAY H PR062 01120C EPAY ADD TTPAY EPAY PR062 0001130C DPAY DIV 2 TTPAY H PR062 01140C EPAY ADD TTPAY EPAY PR062 01150C EHRS ADD RHRS EHRS 41 PR062 01160C* PR062 01170C EHRS ADD OHRS EHRS PR062 01180C EHRS ADD DHRS EHRS PR062 01190C BY2 TAG PR062 0001200C* ********** PR062 01210CL1 25 EXSR MAXAMT PR062 01220C* ********** PR062 01230C* PR062 01240C* ACCUM RECAP TOTALS BY DEPT. PR062 01250C* --------------------------- PR062 01260CL1 21 DPAY1 ADD EPAY DPAY1 82 PR062 0001270CL1 21 DHRS1 ADD EHRS DHRS1 51 PR062 01280CL1 22 DPAY2 ADD EPAY DPAY2 82 PR062 01290CL1 22 DHRS2 ADD EHRS DHRS2 51 PR062 01300C*1 22 DI2 ADD DI DI2 72 PR062 01310CL1 23 DPAY3 ADD EPAY DPAY3 82 PR062 01320CL1 23 DHRS3 ADD EHRS DHRS3 51 PR062 01330C*1 23 DI3 ADD DI DI3 72 PR062 0001340CL1 24 DPAY4 ADD EPAY DPAY4 82 PR062 01350CL1 24 DHRS4 ADD EHRS DHRS4 51 PR062 01360C*1 24 DI4 ADD DI DI4 72 PR062 01370CL1 25 DPAY5 ADD EPAY DPAY5 82 PR062 01380CL1 25 DHRS5 ADD EHRS DHRS5 51 PR062 01390C*1 25 DI5 ADD DI DI5 72 PR062 01400CL1 26 DPAY6 ADD EPAY DPAY6 82 PR062 0001410CL1 26 DHRS6 ADD EHRS DHRS6 51 PR062 01420C*1 26 DI6 ADD DI DI6 72 PR062 01430CL1 27 DPAY7 ADD EPAY DPAY7 82 PR062 01440CL1 27 DHRS7 ADD EHRS DHRS7 51 PR062 01450C*1 27 DI7 ADD DI DI7 72 PR062 01460CL1 28 DPAY8 ADD EPAY DPAY8 82 PR062 01470CL1 28 DHRS8 ADD EHRS DHRS8 51 PR062 0001480C*1 28 DI8 ADD DI DI8 72 PR062 01490CL1 29 DPAY9 ADD EPAY DPAY9 82 PR062 01500CL1 29 DHRS9 ADD EHRS DHRS9 51 PR062 01510C*1 29 DI9 ADD DI DI9 72 PR062 01520CL1 31 DPAY0 ADD EPAY DPAY0 72 PR062 01530CL1 31 DHRS0 ADD EHRS DHRS0 51 PR062 01540C*1 31 DI0 ADD DI DI0 72 PR062 0001550C* PR062 01560C* ACCUM TOTALS BY LOC. PR062 01570C* -------------------- PR062 01580CL2 LPAY1 ADD DPAY1 LPAY1 92 PR062 01590CL2 LPAY2 ADD DPAY2 LPAY2 92 PR062 01600CL2 LPAY3 ADD DPAY3 LPAY3 92 PR062 01610CL2 LPAY4 ADD DPAY4 LPAY4 92 PR062 0001620CL2 LPAY5 ADD DPAY5 LPAY5 92 PR062 01630CL2 LPAY6 ADD DPAY6 LPAY6 92 PR062 01640CL2 LPAY7 ADD DPAY7 LPAY7 92 PR062 01650CL2 LPAY8 ADD DPAY8 LPAY8 92 PR062 01660CL2 LPAY9 ADD DPAY9 LPAY9 92 PR062 01670CL2 LPAY0 ADD DPAY0 LPAY0 92 PR062 01680C* PR062 0001690CL2 LHRS1 ADD DHRS1 LHRS1 61 PR062 01700CL2 LHRS2 ADD DHRS2 LHRS2 61 PR062 01710CL2 LHRS3 ADD DHRS3 LHRS3 61 PR062 01720CL2 LHRS4 ADD DHRS4 LHRS4 61 PR062 01730CL2 LHRS5 ADD DHRS5 LHRS5 61 PR062 01740CL2 LHRS6 ADD DHRS6 LHRS6 61 PR062 01750CL2 LHRS7 ADD DHRS7 LHRS7 61 PR062 0001760CL2 LHRS8 ADD DHRS8 LHRS8 61 PR062 01770CL2 LHRS9 ADD DHRS9 LHRS9 61 PR062 01780CL2 LHRS0 ADD DHRS0 LHRS0 61 PR062 01790C* PR062 01800C********************************************************************PR062 01810CSR MAXAMT BEGSR PR062 01820C* ********** PR062 0001830CSR SETOF 50 PR062 01840CSR YTDPAY COMP 15000.00 50 PR062 01850CSR 50 GOTO NOTMAX PR062 01860C* ********** PR062 01870CSR YTDPAY SUB EPAY YTDPAY PR062 01880CSR YTDPAY COMP 15000.00 50 50 PR062 01890CSR 50 Z-ADD0.0 EHRS PR062 0001900CSR 50 Z-ADD0.06 EPAY PR062 01910CSR 50 GOTO NOTMAX PR062 01920C* ********** PR062 01930CSR 15000.00 SUB YTDPAY EPAY PR062 01940CSR NOTMAX ENDSR PR062 01950C* ********** PR062 01960C********************************************************************PR062 0001970O* PR062 01980O* REPORT HEADING. PR062 01990O* --------------- PR062 02000ORPT H 101 L3 PR062 02010O OR 1P PR062 02020O OR OF PR062 02030O CONAME 78 PR062 0002040O* PR062 02050ORPT H 1 L3 PR062 02060O OR 1P PR062 02070O OR OF PR062 02080O 6 'PR0062' PR062 02090O 111 'M/E DATE' PR062 02100O UDATE Y 120 PR062 0002110O* PR062 02120ORPT H 1 L3 PR062 02130O OR 1P PR062 02140O OR OF PR062 02150O 22 'MONTHLY WORKERS COMP,' PR062 02160O MONTH 32 PR062 02170O 111 'PAGE NO.' PR062 0002180O PAGE 1 117 PR062 02190O* PR062 02200ORPT H 1 L3 PR062 02210O OR 1P PR062 02220O OR OF PR062 02230O 24 '------------------------' PR062 02240O 48 '------------------------' PR062 0002250O 72 '------------------------' PR062 02260O 96 '------------------------' PR062 02270O 120 '------------------------' PR062 02280O* PR062 02290O* COLUMNAR HEADING. PR062 02300O* ----------------- PR062 02310ORPT H 1 L3 PR062 0002320O OR 1P PR062 02330O OR OF PR062 02340O 15 'STA/EMP N A M E' PR062 02350O 35 'CODE' PR062 02360O 44 'HRS' PR062 02370O 61 'INSURABLE PAY' PR062 02380O 73 'INSURANCE' PR062 0002390O 81 'CODE' PR062 02400O 90 'HRS' PR062 02410O 107 'INSURABLE PAY' PR062 02420O* 119 'INSURANCE' PR062 02430O* PR062 02440ORPT H 2 L3 PR062 02450O OR 1P PR062 0002460O OR OF PR062 02470O 24 '------------------------' PR062 02480O 48 '------------------------' PR062 02490O 72 '------------------------' PR062 02500O 96 '------------------------' PR062 02510O 120 '------------------------' PR062 02520O* PR062 0002530O* BODY OF REPORT. PR062 02540O* --------------- PR062 02550ORPT T 1 L1 PR062 02560O PDEP B 4 PR062 02570O EMP 8 PR062 02580O INIT 11 PR062 02590O NAME 32 PR062 0002600O CODE 34 PR062 02610O EHRS K 45 PR062 02620O EPAY K 60 PR062 02630O* DI K 73 PR062 02640O* PR062 02650O* TOTALS BY DEPT. PR062 02660O* --------------- PR062 0002670ORPT T 11 L2 PR062 02680O 14 'TOTAL FOR DEPT' PR062 02690O DEP 19 PR062 02700O 34 '1' PR062 02710O DHRS1 KB 45 PR062 02720O* DI1 KB 74 PR062 02730O DPAY1 KB 60 PR062 0002740O 80 '2' PR062 02750O DHRS2 KB 91 PR062 02760O* DI2 KB 120 PR062 02770O DPAY2 KB 106 PR062 02780O* PR062 02790ORPT T 1 L2 PR062 02800O 34 '3' PR062 0002810O DHRS3 KB 45 PR062 02820O* DI3 KB 74 PR062 02830O DPAY3 KB 60 PR062 02840O 80 '4' PR062 02850O DHRS4 KB 91 PR062 02860O* DI4 KB 120 PR062 02870O DPAY4 KB 106 PR062 0002880O* PR062 02890ORPT T 1 L2 PR062 02900O 34 '5' PR062 02910O DHRS5 KB 45 PR062 02920O* PR062 02930O DPAY5 KB 60 PR062 02940O 80 '6' PR062 0002950O DHRS6 KB 91 PR062 02960O* DI6 KB 120 PR062 02970O DPAY6 KB 106 PR062 02980O* PR062 02990ORPT T 1 L2 PR062 03000O 34 '7' PR062 03010O DHRS7 KB 45 PR062 0003020O* DI7 KB 74 PR062 03030O DPAY7 KB 60 PR062 03040O 80 '8' PR062 03050O DHRS8 KB 91 PR062 03060O* DI8 KB 120 PR062 03070O DPAY8 KB 106 PR062 03080O* PR062 0003090ORPT T 1 L2 PR062 03100O 34 '9' PR062 03110O DHRS9 KB 45 PR062 03120O* DI9 KB 74 PR062 03130O DPAY9 KB 60 PR062 03140O 80 '0' PR062 03150O DHRS0 KB 91 PR062 0003160O* DI0 KB 120 PR062 03170O DPAY0 KB 106 PR062 03180O* PR062 03190ORPT T 1 L2 PR062 03200O 24 '************************' PR062 03210O 48 '************************' PR062 03220O 72 '************************' PR062 0003230O 96 '************************' PR062 03240O 120 '************************' PR062 03250O* TOTALS BY LOCATION. PR062 03260O* ------------------- PR062 03270ORPT TF 1 L3 PR062 03280O 14 'FINAL TOTALS' PR062 03290O LOC 18 PR062 0003300O 34 '1' PR062 03310O LHRS1 KB 45 PR062 03320O* LI1 KB 74 PR062 03330O LPAY1 KB 60 PR062 03340O 80 '2' PR062 03350O LHRS2 KB 91 PR062 03360O* LI2 KB 120 PR062 0003370O LPAY2 KB 106 PR062 03380O* PR062 03390ORPT T 1 L3 PR062 03400O 34 '3' PR062 03410O LHRS3 KB 45 PR062 03420O* LI3 KB 74 PR062 03430O LPAY3 KB 60 PR062 0003440O 80 '4' PR062 03450O LHRS4 KB 91 PR062 03460O* LI4 KB 120 PR062 03470O LPAY4 KB 106 PR062 03480O* PR062 03490ORPT T 1 L3 PR062 03500O 34 '5' PR062 0003510O LHRS5 KB 45 PR062 03520O* LI5 KB 74 PR062 03530O LPAY5 KB 60 PR062 03540O 80 '6' PR062 03550O LHRS6 KB 91 PR062 03560O* LI6 KB 120 PR062 03570O LPAY6 KB 106 PR062 0003580O* PR062 03590ORPT T 1 L3 PR062 03600O 34 '7' PR062 03610O LHRS7 KB 45 PR062 03620O* LI7 KB 74 PR062 03630O LPAY7 KB 60 PR062 03640O 80 '8' PR062 0003650O LHRS8 KB 91 PR062 03660O* LI8 KB 120 PR062 03670O LPAY8 KB 106 PR062 03680O* PR062 03690ORPT T 1 L3 PR062 03700O 34 '9' PR062 03710O LHRS9 KB 45 PR062 0003720O* LI9 KB 74 PR062 03730O LPAY9 KB 60 PR062 03740O 80 '0' PR062 03750O LHRS0 KB 91 PR062 03760O* LI0 KB 120 PR062 03770O LPAY0 KB 106 PR062 03780O* PR062 00** 003790ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003800ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003810ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003820ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003830** 00384001JANUARY 0038500002FEBRUARY 00386003MARCH 00387004APRIL 00388005MAY 00389006JUNE 00390007JULY 00391008AUGUST 0039200009SEPTEMBER 00393010OCTOBER 00394011NOVEMBER 00395012DECEMBER 003960/* 003970__LY 00391008AUGUST 0039200(w\q  TXPR070 P999999111111(000010H S PR070 00020X DECK-ID B13 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR070 00030F* PRINT THE QUARTERLY TAX REPORT PR070 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR070 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR070 00060F* CONTROL DATA PROPRIETARY PRODUCT PR070 00070F* PR070 0000080F* PR070 00090F* *************************************************************** PR070 00100F* * ************************************************* * PR070 00110F* * * * * PR070 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR070 00130F* * * * * PR070 00140F* * ************************************************* * PR070 0000150F* *************************************************************** PR070 00160F* PR070 00170F* ----QUARTERLY TAX REPORT. ---- PR070 00180F* PR070 00190F* MODIFIED 10/27/76 TO PRINT QTD FED W/H AND QTD STATE W/H. PR070 00200F* PR070 00210FPRMAST IP AF 600 600 10AI 2 DISK PR070 0000220FCNMAST IC F 128 128R02AI 1 DISK PR070 00230FQTRLIM ID F 96 DISK PR070 00240FRPT O F 132 132 OF LPRINTER PR070 00250E TABM 13 13 2 0 TABQ 1 PR070 00260LRPT 66FL 58OL PR070 00270I* PR070 00280I* YTD EARNINGS. PR070 0000290I* ------------- PR070 00300IPRMAST NS 01 PR070 00310I 008 011 EMPL L1 PR070 00320I 004 007 DEPT L2 PR070 00330I 2 30DIV L3 PR070 00340I 172 1782RPAYY PR070 00350I 179 1852SPAYY PR070 0000360I 186 1922HPAYY PR070 00370I 193 1992VPAYY PR070 00380I 200 2062OPAYY PR070 00390I 207 2132CPAYY PR070 00400I 214 2202DPAYY PR070 00410I 002 0030LOC PR070 00420I* PR070 0000430I* QTLY EARNINGS. PR070 00440I* -------------- PR070 00450I 266 2722RPAYQ PR070 00460I 273 2792SPAYQ PR070 00470I 280 2862HPAYQ PR070 00480I 287 2932VPAYQ PR070 00490I 294 3002OPAYQ PR070 0000500I 301 3072CPAYQ PR070 00510I 308 3142DPAYQ PR070 00520I 348 3542QTDFWH PR070 00530I 367 3732QTDSWH PR070 00540I* PR070 00550I* COMPANY NAME FILE PR070 00560I* PR070 0000570ICNMAST NS 04 PR070 00580I 5 40 CONAME PR070 00590I* PR070 00600IQTRLIM NS 05 PR070 00610I 1 50LIM01 PR070 00620I 11 150LIM02 PR070 00630I 21 250LIM03 PR070 0000640I 31 350LIM04 PR070 00650I* PR070 00660C* PR070 00670C N69 SETON 69L3 PR070 00680C* GET LIMITS PR070 00690C* PR070 00700C N50 READ QTRLIM PR070 0000710C N50 SETON 50 PR070 00720C* PR070 00730C* CLEAR INDICATORS & FIELDS. PR070 00740C* -------------------------- PR070 00750C L1 SETOF 303138 PR070 00760C L1 SETOF 397475 PR070 00770C L1 SETOF 7879 PR070 0000780C L2 MOVE DEPT PDEPT 4 PR070 00790C L2 Z-ADD0 DYGR PR070 00800C L2 Z-ADD0 DQGR PR070 00810C L2 Z-ADD0 D01 PR070 00820C L2 Z-ADD0 D02 PR070 00830C L2 Z-ADD0 D03 PR070 00840C L2 Z-ADD0 D04 PR070 0000850C L2 Z-ADD0 DQFWH PR070 00860C L2 Z-ADD0 DQSWH PR070 00870C* PR070 00880C OF MOVE DEPT PDEPT PR070 00890C* PR070 00900C L3 LOC CHAINCNMAST 69 PR070 00910C* PR070 0000920C* LOOK UP QUARTER# PR070 00930C* ---------------------- PR070 00940C 99 GOTO SKIP PR070 00950C* ********** PR070 00960C UMONTH LOKUPTABM TABQ 40 PR070 00970C 40 MOVE TABQ QTR 1 PR070 00980C QTR COMP '1' 21 PR070 0000990C QTR COMP '2' 22 PR070 01000C QTR COMP '3' 23 PR070 01010C QTR COMP '4' 24 PR070 01020C* PR070 01030C MOVELQTR PQTR 3 BUILD PRINT PR070 01040C 21 MOVE 'ST' PQTR FIELD FOR PR070 01050C 22 MOVE 'ND' PQTR REPORT HDG. PR070 0001060C 23 MOVE 'RD' PQTR PR070 01070C 24 MOVE 'TH' PQTR PR070 01080C N40 MOVEL'***' PQTR PR070 01090C* PR070 01100C SETON 99 PR070 01110C SKIP TAG PR070 01120C* ********** PR070 0001130C* PR070 01140C* ROUTINE FOR YTD EARNINGS. PR070 01150C* ------------------------- PR070 01160C N01 GOTO BY01 PR070 01170C* ********** PR070 01180C* PR070 01190C RPAYY ADD SPAYY RPAYY CROSSFOOT PR070 0001200C RPAYY ADD HPAYY RPAYY INTO REG PAY PR070 01210C RPAYY ADD OPAYY RPAYY GROSS. PR070 01220C RPAYY ADD CPAYY RPAYY PR070 01230C RPAYY ADD DPAYY RPAYY PR070 01240C RPAYY ADD VPAYY RPAYY PR070 01250C* PR070 01260C BY01 TAG PR070 0001270C* ********** PR070 01280C* PR070 01290C* OUTINE FOR QTRLY EARNINGS. PR070 01300C* -------------------------- PR070 01310C N01 GOTO BY02 PR070 01320C* ********** PR070 01330C* PR070 0001340C RPAYQ ADD SPAYQ RPAYQ CROSSFOOT PR070 01350C RPAYQ ADD HPAYQ RPAYQ INTO REG PAY PR070 01360C RPAYQ ADD VPAYQ RPAYQ FOR QTR PR070 01370C RPAYQ ADD OPAYQ RPAYQ GROSS. PR070 01380C RPAYQ ADD CPAYQ RPAYQ PR070 01390C RPAYQ ADD DPAYQ RPAYQ PR070 01400C* PR070 0001410C BY02 TAG PR070 01420C* ********** PR070 01430C* PR070 01440C* ROUTINE AT END OF EMPLOYEE. PR070 01450C* --------------------------- PR070 01460C* PR070 01470CL1 Z-ADDRPAYY TEST 72 PR070 0001480CL1 TEST SUB LIM01 TEST 38 PR070 01490CL1N38 RPAYQ SUB TEST TEST1 72 39 PR070 01500CL1N38N39 Z-ADDTEST E01 72 PR070 01510CL1N38 39 Z-ADDRPAYQ E01 PR070 01520C* PR070 01530CL1 Z-ADDRPAYY TEST PR070 01540CL1 TEST SUB LIM02 TEST 30 PR070 0001550CL1N30 RPAYQ SUB TEST TEST1 31 PR070 01560CL1N30N31 Z-ADDTEST E02 72 PR070 01570CL1N30 31 Z-ADDRPAYQ E02 PR070 01580C* PR070 01590CL1 Z-ADDRPAYY TEST PR070 01600CL1 TEST SUB LIM03 TEST 74 PR070 01610CL1N74 RPAYQ SUB TEST TEST1 75 PR070 0001620CL1N74N75 Z-ADDTEST E03 72 PR070 01630CL1N74 75 Z-ADDRPAYQ E03 PR070 01640C* PR070 01650CL1 Z-ADDRPAYY TEST PR070 01660CL1 TEST SUB LIM04 TEST 96 PR070 01670CL1N96 RPAYQ SUB TEST TEST1 97 PR070 01680CL1N96N97 Z-ADDTEST E04 72 PR070 0001690CL1N96 97 Z-ADDRPAYQ E04 PR070 01700CL1 DYGR ADD RPAYY DYGR 82 ADD TO DEPT PR070 01710CL1 DQGR ADD RPAYQ DQGR 82 TOTALS. PR070 01720CL1 D01 ADD E01 D01 82 PR070 01730CL1 D02 ADD E02 D02 82 PR070 01740CL1 D03 ADD E03 D03 82 PR070 01750CL1 D04 ADD E04 D04 82 PR070 0001760CL1 DQFWH ADD QTDFWH DQFWH 82 PR070 01770CL1 DQSWH ADD QTDSWH DQSWH 82 PR070 01780CL2 LQFWH ADD DQFWH LQFWH 92 PR070 01790CL2 LQSWH ADD DQSWH LQSWH 92 PR070 01800CL2 LYGR ADD DYGR LYGR 92 ADD TO LOC PR070 01810CL2 LQGR ADD DQGR LQGR 92 TOTALS. PR070 01820CL2 L01 ADD D01 L01 92 PR070 0001830CL2 L02 ADD D02 L02 92 PR070 01840CL2 L03 ADD D03 L03 92 PR070 01850CL2 L04 ADD D04 L04 92 PR070 01860C* PR070 01870O* PR070 01880O* REPORT HEADINGS. PR070 01890O* ---------------- PR070 0001900ORPT H 101 L3 PR070 01910O OR OFNL3 PR070 01920O N69 CONAME 36 PR070 01930O 37 ' ' PR070 01940O* PR070 01950ORPT H 1 L3 PR070 01960O OR OFNL3 PR070 0001970O 6 'PR0070' PR070 01980O 111 'M/E DATE' PR070 01990O UDATE Y 120 PR070 02000O* PR070 02010ORPT H 1 L3 PR070 02020O OR OFNL3 PR070 02030O 23 'TAX REPORT. QUARTER' PR070 0002040O PQTR 15 PR070 02050O 111 'PAGE NO.' PR070 02060O PAGE 117 ' , 0' PR070 02070O* PR070 02080ORPT H 1 L3 PR070 02090O OR OFNL3 PR070 02100O 24 '------------------------' PR070 0002110O 48 '------------------------' PR070 02120O 72 '------------------------' PR070 02130O 96 '------------------------' PR070 02140O 120 '------------------------' PR070 02150O 132 '------------' PR070 02160O* PR070 02170O* COLUMNAR HEADINGS. PR070 0002180O* ------------------ PR070 02190ORPT H 1 L3 PR070 02200O OR OFNL3 PR070 02210O 26 '----------' PR070 02220O 45 '----------' PR070 02230O 35 'G R O S S' PR070 02240O 58 'IN EXCESS' PR070 0002250O 74 'IN EXCESS' PR070 02260O 89 'IN EXCESS' PR070 02270O 104 'IN EXCESS' PR070 02280O 130 'FED W/H STATE W/H' PR070 02290O* PR070 02300ORPT H 1 L3 PR070 02310O OR OFNL3 PR070 0002320O 8 'DEPT' PR070 02330O 13 'EMPL' PR070 02340O 29 'YTD' PR070 02350O 44 'THIS QTR' PR070 02360O 52 'OF' PR070 02370O LIM01 Z 58 PR070 02380O 68 'OF' PR070 0002390O LIM02 Z 74 PR070 02400O 83 'OF' PR070 02410O LIM03 Z 89 PR070 02420O 98 'OF' PR070 02430O LIM04 Z 104 PR070 02440O 130 'THIS QTR THIS QTR' PR070 02450O* PR070 0002460ORPT H 1 L3 PR070 02470O OR OFNL3 PR070 02480O 24 '------------------------' PR070 02490O 48 '------------------------' PR070 02500O 72 '------------------------' PR070 02510O 96 '------------------------' PR070 02520O 120 '------------------------' PR070 0002530O 132 '------------' PR070 02540O* PR070 02550O* TOTAL BY EMPLOYEE. PR070 02560O* ------------------ PR070 02570ORPT T 1 L1 PR070 02580O PDEPT B 8 PR070 02590O EMPL 13 PR070 0002600O RPAYY KB 30 PR070 02610O RPAYQ KB 45 PR070 02620O E01 KB 60 PR070 02630O E02 KB 75 PR070 02640O E03 KB 90 PR070 02650O E04 KB 105 PR070 02660O QTDFWHK 118 PR070 0002670O QTDSWHK 131 PR070 02680O* PR070 02690O* TOTAL BY DIV. PR070 02700O* ------------- PR070 02710ORPT T 22 L3 PR070 02720O 14 'COMPANY TOTAL' PR070 02730O LYGR KB 30 PR070 0002740O LQGR KB 45 PR070 02750O L01 KB 60 PR070 02760O L02 KB 75 PR070 02770O L03 KB 90 PR070 02780O L04 KB 105 PR070 02790O LQFWH KB 118 PR070 02800O LQSWH KB 131 PR070 00** 002810ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002850** 002860011021031042052062073083093104114124999 00287000/* 002880__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002850** 002860011021031042052062073083093104114124999 0028700(] <TXPR075 P999999111111(000010H S PR075 00020X DECK-ID B14 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR075 00030F* PRINT FORM 941-A PR075 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR075 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR075 00060F* CONTROL DATA PROPRIETARY PRODUCT PR075 00070F* PR075 0000080F* PR075 00090F* *************************************************************** PR075 00100F* * ************************************************* * PR075 00110F* * * * * PR075 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR075 00130F* * * * * PR075 00140F* * ************************************************* * PR075 0000150F* *************************************************************** PR075 00160F* PR075 00170F* PR075 00180F* PRINTS 941-A'S PR075 00190F* PR075 00200F* SCMAST IS A REFORMATTED VERSION OF PRMAST PR075 00210F* PR075 0000220FSCMAST IP AF 600 600 10AI 1 DISK PR075 00230FRPT O F 132 132 OF LPRINTER PR075 00240FQTRLIM ID F 96 DISK PR075 00250FCNMAST IC F 128 128R02AI 1 DISK PR075 00260FCTKP D F 70 CONSOLE PR075 00270E TABM 12 12 2 0 TABQ 1 PR075 00280E MSG 1 3 70 DISPLAY PR075 0000290LRPT 66FL 65OL PR075 00300I* PR075 00310I* PR075 00320I* EMPLOYEE MASTERS. PR075 00330I* ----------------- PR075 00340ISCMAST NS 01 PR075 00350I 1 2 SCODE L2 PR075 0000360I 3 6 EMP L1 PR075 00370I 155 1560LOC L3 PR075 00380I 012 012 FI 10 PR075 00390I 013 013 SI 11 PR075 00400I 014 033 NAME 12 PR075 00410I 101 103 SS1 13 PR075 00420I 104 105 SS2 14 PR075 0000430I 106 109 SS3 15 PR075 00440I* PR075 00450I* YTD EARNINGS 03 & QTR EARNINGS 04 . PR075 00460I* -------------------------------------- PR075 00470I 172 1782RPAY PR075 00480I 179 1852SPAY PR075 00490I 186 1922HPAY PR075 0000500I 193 1992VPAY PR075 00510I 200 2062OPAY PR075 00520I 207 2132CPAY PR075 00530I 214 2202DPAY PR075 00540I 266 2722RPAYQ PR075 00550I 273 2792SPAYQ PR075 00560I 280 2862HPAYQ PR075 0000570I 287 2932VPAYQ PR075 00580I 294 3002OPAYQ PR075 00590I 301 3072CPAYQ PR075 00600I 308 3142DPAYQ PR075 00610I* PR075 00620I* CONAME FILE PR075 00630I* PR075 0000640ICNMAST NS 04 PR075 00650I 106 127 LINE1 PR075 00660I 5 40 LINE2 PR075 00670I 41 63 LINE3 PR075 00680I 64 93 LINE4 PR075 00690I* PR075 00700IQTRLIM NS 05 PR075 0000710I 1 50LIMITF PR075 00720I* PR075 00730C N71 SETON 71L3 PR075 00740C* PR075 00750C U1N50 EXSR ALIGN PR075 00760C* ********** PR075 00770C N50 READ QTRLIM PR075 0000780C N50 SETON 50L3 PR075 00790C* CHECK LOCATION FOR ADDRESS TO PRINT. PR075 00800C* PR075 00810C SCODE COMP 'CA' 69 PR075 00820C L3 LOC CHAINCNMAST 30 PR075 00830C* PR075 00840C* PR075 0000850C* CLEARING INDICATORS & COUNTERS. PR075 00860C* PR075 00870C SETOF 32 PR075 00880C SETON 33 PR075 00890C L1 SETOF 7879 PR075 00900C L1 Z-ADD0 YGR PR075 00910C L1 Z-ADD0 QGR 40 PR075 0000920C L1 Z-ADD0 EFWAGE PR075 00930C* PR075 00940C* LOOK UP QUARTER # PR075 00950C* ---------------------- PR075 00960C 99 GOTO SKIP PR075 00970C* ********** PR075 00980C UMONTH LOKUPTABM TABQ 40 PR075 0000990C 40 MOVE TABQ QTR 1 PR075 01000C* PR075 01010C QTR COMP '1' 21 CHECK QTR #. PR075 01020C QTR COMP '2' 22 PR075 01030C QTR COMP '3' 23 PR075 01040C QTR COMP '4' 24 PR075 01050C* PR075 0001060C MOVELQTR PQTR 3 BUILD PRINT PR075 01070C 21 MOVE 'ST' PQTR FIELD PR075 01080C 22 MOVE 'ND' PQTR PR075 01090C 23 MOVE 'RD' PQTR PR075 01100C 24 MOVE 'TH' PQTR PR075 01110C N40 MOVEL'***' PQTR PR075 01120C SETON 99 PR075 0001130C SKIP TAG PR075 01140C* ********** PR075 01150C* PR075 01160C* ROUTINE FOR YTD. PR075 01170C* ---------------- PR075 01180C N01 GOTO BY03 PR075 01190C* ********** PR075 0001200C* PR075 01210C YGR ADD RPAY YGR 72 GROSSFOOT YTD PR075 01220C YGR ADD SPAY YGR GROSS. PR075 01230C YGR ADD HPAY YGR PR075 01240C YGR ADD VPAY YGR PR075 01250C YGR ADD OPAY YGR PR075 01260C YGR ADD CPAY YGR PR075 0001270C YGR ADD DPAY YGR PR075 01280C* PR075 01290C BY03 TAG PR075 01300C* ********** PR075 01310C* PR075 01320C* ROUTINE FOR QTR. PR075 01330C*----------------- PR075 0001340C N01 GOTO BY04 PR075 01350C* ********** PR075 01360C* PR075 01370C QGR ADD RPAYQ QGR 72 CROSSFOOT QTR PR075 01380C QGR ADD SPAYQ QGR GROSS. PR075 01390C QGR ADD HPAYQ QGR PR075 01400C QGR ADD VPAYQ QGR PR075 0001410C QGR ADD OPAYQ QGR PR075 01420C QGR ADD CPAYQ QGR PR075 01430C QGR ADD DPAYQ QGR 40 PR075 01440C* PR075 01450C BY04 TAG PR075 01460C* ********** PR075 01470C* PR075 0001480C* ROUTINE AT END OF EMPLOYEE. PR075 01490C* --------------------------- PR075 01500C* PR075 01510C* BYPASS UNLESS EMPLOYEE HAS EARNINGS THIS QUARTER. PR075 01520C* PR075 01530CL0 SETON 32 PR075 01540CL0 SETOF 33 PR075 0001550CL1 40 GOTO BYEMP PR075 01560C* ********** PR075 01570CL1 YGR SUB LIMITF TEST 72 78 PR075 01580CL1 78 Z-ADDQGR EFWAGE 72 PR075 01590CL1N78 QGR SUB TEST TEST 79 PR075 01600CL1N78N79 Z-ADDTEST EFWAGE PR075 01610C* PR075 0001620C*1 PCNT ADD 1 PCNT 40 PR075 01630CL1 PFWAGE ADD EFWAGE PFWAGE 82 PR075 01640CL1 LFWAGE ADD EFWAGE LFWAGE 92 PR075 01650C*1 LCNT ADD 1 LCNT 50 PR075 01660CL1 PQGR ADD QGR PQGR 82 PR075 01670CL1 LQGR ADD QGR LQGR 92 PR075 01680CL1 COUNT ADD 1 COUNT 40 PR075 0001690CL0 BYEMP TAG PR075 01700C* ********** PR075 01710CL0 COUNT COMP 41 55 PR075 01720CL0 55 Z-ADD0 COUNT PR075 01730CL1 EXCPT PR075 01740C********************************************************************PR075 01750CSR ALIGN BEGSR PR075 0001760C* ********** PR075 01770CSR AGAIN TAG PR075 01780C* ********** PR075 01790CSR SETON 51 PR075 01800CSR EXCPT PRINT SAMPLE PR075 01810CSR SETOF 51 PR075 01820CSR BADRES TAG PR075 0001830C* ********** PR075 01840CSR MOVEL' ' RESPON 1 PR075 01850CSR MSG,3 DSPLYCTKP (PUT BLANKS) PR075 01860CSR MSG,1 DSPLYCTKP PR075 01870CSR MSG,2 DSPLYCTKP RESPON PR075 01880CSR RESPON COMP 'Y' 52 PR075 01890CSR RESPON COMP 'N' 53 PR075 0001900CSR 52 GOTO FORMOK PR075 01910C* ********** PR075 01920CSR 53 GOTO AGAIN PR075 01930C* ********** PR075 01940CSR GOTO BADRES PR075 01950C* ********** PR075 01960CSR FORMOK ENDSR PR075 0001970C* ********** PR075 01980O*PT H 06 1P PR075 01990O* 1 ' ' PR075 02000O* PR075 02010O* PAGE TOTAL AT OF TIME. PR075 02020O* ---------------------- PR075 02030O*PT H 3 OF 32NL3 PR075 0002040O* PFWAGEKB 65 PR075 02050O* PQGR KB 78 NOT NEEDED ON NEW FORM PR075 02060O* PR075 02070O*PT H 3 OF 32NL3 PR075 02080O* PCNT K 36 PR075 02090O* PCNT KB 29 PR075 02100O* PR075 0002110O* COMPANY ID LINE. PR075 02120O* ----------------- PR075 02130ORPT H 05 L3 PR075 02140O OR 55 PR075 02150O UDATE Y 63 PR075 02160O PAGE Z 76 PR075 02170O* PR075 0002180ORPT H 06 L3 PR075 02190O OR 55 PR075 02200O N30 LINE1 36 PR075 02210O 1 ' ' PR075 02220O* PR075 02230O* COMPANY NAME. PR075 02240O* ------------- PR075 0002250ORPT H 08 L3 PR075 02260O OR 55 PR075 02270O N30 LINE2 50 PR075 02280O 1 ' ' PR075 02290O* PR075 02300O* COMPANY ADDRESS. PR075 02310O* ----------------- PR075 0002320ORPT H 09 L3 PR075 02330O OR 55 PR075 02340O N30 LINE3 37 PR075 02350O 1 ' ' PR075 02360O* PR075 02370O* COMPANY CITY, STATE & ZIP. PR075 02380O* -------------------------- PR075 0002390ORPT H 1017 L3 PR075 02400O OR 55 PR075 02410O N30 LINE4 44 PR075 02420O 1 ' ' PR075 02430O* PR075 02440O* TOTALS BY EMPLOYEE. PR075 02450ORPT E 1 L1N40 50 PR075 0002460O N13 SS1 B 10 PR075 02470O N14 SS2 B 14 PR075 02480O N15 SS3 B 20 PR075 02490O N12 NAME B 47 PR075 02500O N10 50 '.' PR075 02510O N10 FI B 49 PR075 02520O N11 52 '.' PR075 0002530O N11 SI B 51 PR075 02540O EFWAGEKB 65 PR075 02550O QGR KB 78 PR075 02560O* PR075 02570O* PAGE TOTAL AT END OF LOCATION. PR075 02580O* ------------------------------ - PR075 02590ORPT E 61 L3 50 PR075 0002600O OR 55 PR075 02610O PFWAGEKB 65 PR075 02620O* PQGR KB 78 PR075 02630ORPT E 05 L3 50 PR075 02640O UDATE Y 63 PR075 02650O PAGE Z 76 PR075 02660O* PR075 0002670ORPT E 06 L3 50 PR075 02680O N30 LINE1 36 PR075 02690O 1 ' ' PR075 02700O* PR075 02710ORPT E 08 L3 50 PR075 02720O N30 LINE2 50 PR075 02730O 1 ' ' PR075 0002740O* PR075 02750ORPT E 09 L3 50 PR075 02760O N30 LINE3 37 PR075 02770O 1 ' ' PR075 02780O* PR075 02790ORPT E 1017 L3 50 PR075 02800O N30 LINE4 44 PR075 0002810O 1 ' ' PR075 02820O* PR075 02830O* LOCATION TOTAL. PR075 02840O* --------------- PR075 02850ORPT E 57 L3 50 PR075 02860O 31 'STATE TOTAL FOR' PR075 02870O SCODE 15 PR075 0002880O PQTR 35 PR075 02890O 43 'QUARTER' PR075 02900O 46 '19' PR075 02910O UYEAR 48 PR075 02920O 49 '.' PR075 02930O* PR075 02940ORPT E 3 L3 50 PR075 0002950O LFWAGEKB 65 PR075 02960O* LQGR KB 78 PR075 02970O* LCNT K 36 PR075 02980O* LCNT KB 29 PR075 02990ORPT E 05 51 PR075 03000O 63 'XX/XX/XX' PR075 03010O 76 '9999' PR075 0003020ORPT E 61 51 PR075 03030O 65 '99,999.99-' PR075 03040O 65 '99,999.99-' PR075 ** 003050ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003060ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003070ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00308000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003090** 003100011021031042052062073083093104114124 003110** 003120CHECK SAMPLE FORM FOR PROPER ALIGNMENT 003130ARE FORMS PROPERLY ALIGNED? (Y,N) 003140 00315000/* 003160__ 003100011021031042052062073083093104114124 003110** 003120CHECK SAMPLE FORM FOR PROPER ALIGNMENT 003130ARE FORMS PROPERLY ALIGNED? (Y,N) 003140 0031500(d] ?*TXPR076 P999999111111(000010H S PR076 00020X DECK-ID B15 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR076 00030F* ZERO OUT QTD FIELDS IN PRMAST PR076 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR076 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR076 00060F* CONTROL DATA PROPRIETARY PRODUCT PR076 00070F* PR076 0000080F* PR076 00090F* *************************************************************** PR076 00100F* * ************************************************* * PR076 00110F* * * * * PR076 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR076 00130F* * * * * PR076 00140F* * ************************************************* * PR076 0000150F* *************************************************************** PR076 00160F* PR076 00170F* ---- ZERO OUT QTLY FIELDS. ---- PR076 00180F* PR076 00190FPRMAST UP AF 600 600 10AI 2 DISK PR076 00200IPRMAST NS 01 PR076 00210I 266 2722RPAYQ PR076 0000220I 273 2792SPAYQ PR076 00230I 280 2862HPAYQ PR076 00240I 287 2932VPAYQ PR076 00250I 294 3002OPAYQ PR076 00260I 301 3072CPAYQ PR076 00270I 308 3142DPAYQ PR076 00280I 348 3542QFED PR076 0000290I 355 3612QFICA PR076 00300I 362 3662QSDI PR076 00310I 367 3732QSTATE PR076 00320I 374 3802QCITY PR076 00330C Z-ADD.00 RPAYQ PR076 00340C Z-ADD.00 SPAYQ PR076 00350C Z-ADD.00 HPAYQ PR076 0000360C Z-ADD.00 VPAYQ PR076 00370C Z-ADD.00 OPAYQ PR076 00380C Z-ADD.00 CPAYQ PR076 00390C Z-ADD.00 DPAYQ PR076 00400C Z-ADD.00 QFED PR076 00410C Z-ADD.00 QFICA PR076 00420C Z-ADD.00 QSDI PR076 0000430C Z-ADD.00 QSTATE PR076 00440C Z-ADD.00 QCITY PR076 00450OPRMAST D 01 PR076 00460O RPAYQ 272 PR076 00470O SPAYQ 279 PR076 00480O HPAYQ 286 PR076 00490O VPAYQ 293 PR076 0000500O OPAYQ 300 PR076 00510O CPAYQ 307 PR076 00520O DPAYQ 314 PR076 00530O QFED 354 PR076 00540O QFICA 361 PR076 00550O QSDI 366 PR076 00560O QSTATE 373 PR076 0000570O QCITY 380 PR076 ** 000580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000620/* 00063000__0O QCITY 380 PR076 ** 000580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000620/* 0006300(^] TXPR080 P999999111111(000010H S PR080 00020X DECK-ID B16 MFG/DIST/ACCT SYSTEM SUMMARY-123 PR080 00030F* PRINT FORM W-2 PR080 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PR080 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PR080 00060F* CONTROL DATA PROPRIETARY PRODUCT PR080 00070F* PR080 0000080F* PR080 00090F* *************************************************************** PR080 00100F* * ************************************************* * PR080 00110F* * * * * PR080 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PR080 00130F* * * * * PR080 00140F* * ************************************************* * PR080 0000150F* *************************************************************** PR080 00160F* PR080 00170F* PR080 00180F* OUTPUT - W2'S. PR080 00190F* MODIFIED 10/27/76 TO PRINT SDI AMOUNT IN BOX#11. PR080 00200F* PR080 00210FPRMAST IP AF 600 600 10AI 2 DISK PR080 0000220FCNMAST IC F 128 128R02AI 1 DISK PR080 00230FQTRLIM ID F 96 DISK PR080 00240FRPT O F 132 132 OF LPRINTER PR080 00250FCTKP D F 38 CONSOLE PR080 00260E MSG 1 3 38 PR080 00270LRPT 22FL 21OL PR080 00280I* PR080 0000290I* EMPLOYEE MASTER. PR080 00300I*----------------- PR080 00310IPRMAST NS 01 PR080 00320I 002 0030DIV L1 PR080 00330I 012 012 FI 10 PR080 00340I 013 013 SI 11 PR080 00350I 014 033 NAME PR080 0000360I 101 103 SS1 12 PR080 00370I 104 105 SS2 PR080 00380I 106 109 SS3 PR080 00390I 122 122 PENCDE PR080 00400I 125 125 MSTAT PR080 00410I 033 067 ADDRS PR080 00420I 068 087 CITY PR080 0000430I 088 089 STATE PR080 00440I 090 094 ZIP PR080 00450I 155 156 STAXCD PR080 00460I 168 171 CITYAB PR080 00470I 172 1782RPAY PR080 00480I 179 1852SPAY PR080 00490I 186 1922HPAY PR080 0000500I 193 1992VPAY PR080 00510I 200 2062OPAY PR080 00520I 315 3212FWH PR080 00530I 322 3282FICA PR080 00540I 329 3332SDI PR080 00550I 334 3402SWH 13 PR080 00560I 207 2132COMM PR080 0000570I 341 3472CTAX 14 PR080 00580I 214 2202DPAY PR080 00590I* PR080 00600ICNMAST NS 02 PR080 00610I 5 40 CONAME PR080 00620I 41 63 COSTRT PR080 00630I 64 93 COCITY PR080 0000640I 106 116 FEDID PR080 00650I 117 127 STAID PR080 00660I* PR080 00670IQTRLIM NS 03 PR080 00680I 1 50LIMITF PR080 00690I* PR080 00700C N33 SETON 33L1 PR080 0000710C* PR080 00720C N81 U1 EXSR ALIGN PR080 00730C* ********** PR080 00740C N81 READ QTRLIM H4 PR080 00750C SETON 81 PR080 00760C* CLEAR ACCUMULATING FIELDS AND DEFINE THE FIELDS PR080 00770C SETOF 69 PR080 0000780C Z-ADD0.00 TSTR 82 PR080 00790C Z-ADD0.00 GPAY 82 PR080 00800C Z-ADD0.00 FICAW 82 PR080 00810C L1 Z-ADDTSWH TSWH 72 PR080 00820C L1 Z-ADDTFWH TFWH 82 PR080 00830C L1 Z-ADDTGPAY TGPAY 92 PR080 00840C L1 Z-ADDTFICA TFICA 92 PR080 0000850C L1 Z-ADDTFICAW TFICAW 92 PR080 00860C L1 Z-ADDTCTAX TCTAX 92 PR080 00870C* PR080 00880C* PR080 00890C* LOOK UP COMPANY ADDRESS. PR080 00900C* --------- --------- PR080 00910C* PR080 0000920C L1 DIV CHAINCNMAST 20 PR080 00930C L1 SETOF 40 PR080 00940C L1N20 SETON 40 PR080 00950C* PR080 00960C* ROUTINE FOR EMPLOYEE MASTER. PR080 00970C* --------- --------- PR080 00980C* DETERMINE PR080 0000990C MSTAT COMP 'M' 222221 PR080 01000C 21 MOVE '2' STAT 1 MARRIED. PR080 01010C 22 MOVE '1' STAT SINGLE. PR080 01020C* PR080 01030C PENCDE COMP 'Y' 80 PR080 01040C* PR080 01050C* PR080 0001060C* ROUTINE FOR YTD EARNINGS. PR080 01070C* ------------------------- PR080 01080C GPAY ADD RPAY GPAY CROSS FOOT PR080 01090C GPAY ADD SPAY GPAY YTD GROSS. PR080 01100C GPAY ADD HPAY GPAY PR080 01110C GPAY ADD VPAY GPAY PR080 01120C GPAY ADD OPAY GPAY PR080 0001130C GPAY ADD COMM GPAY PR080 01140C GPAY ADD DPAY GPAY PR080 01150C GPAY COMP TSTR 69 PR080 01160C 69 SETOF 01 PR080 01170C 69 GOTO BYALL PR080 01180C* ********** PR080 01190C* PR080 0001200C Z-ADDGPAY FICAP 82 FICA WAGES. PR080 01210C FICAP SUB LIMITF FICAW 30 PR080 01220C 30 Z-ADDLIMITF FICAW PR080 01230C N30 Z-ADDFICAP FICAW PR080 01240C* PR080 01250C* PR080 01260C* ACCUM FINAL TOTALS. PR080 0001270C* ------------------- PR080 01280C TSWH ADD SWH TSWH PR080 01290C TFWH ADD FWH TFWH PR080 01300C TGPAY ADD GPAY TGPAY PR080 01310C TFICA ADD FICA TFICA PR080 01320C TFICAW ADD FICAW TFICAW PR080 01330C TCTAX ADD CTAX TCTAX PR080 0001340C BYALL TAG PR080 01350C* ********** PR080 01360C********************************************************************PR080 01370CSR ALIGN BEGSR PR080 01380C* ********** PR080 01390CSR AGAIN TAG PR080 01400C* ********** PR080 0001410CSR SETON 82 PR080 01420CSR EXCPT PRINT SAMPLE PR080 01430CSR SETOF 82 PR080 01440CSR BADRES TAG PR080 01450C* ********** PR080 01460CSR MOVEL' ' RESPON 1 PR080 01470CSR MSG,3 DSPLYCTKP (PUT BLANKS) PR080 0001480CSR MSG,1 DSPLYCTKP PR080 01490CSR MSG,2 DSPLYCTKP RESPON PR080 01500CSR RESPON COMP 'Y' 83 PR080 01510CSR RESPON COMP 'N' 84 PR080 01520CSR 83 GOTO FORMOK PR080 01530C* ********** PR080 01540CSR 84 GOTO AGAIN PR080 0001550C* ********** PR080 01560CSR GOTO BADRES PR080 01570C* ********** PR080 01580CSR FORMOK ENDSR PR080 01590C* ********** PR080 01600C********************************************************************PR080 01610O* PR080 0001620O* COMPANY ADDRESS. PR080 01630O* ---------------- PR080 01640ORPT D 05 01 PR080 01650O 9 'FED' PR080 01660O FEDID 22 PR080 01670O* 26 'ST' PR080 01680O* STAID 39 PR080 0001690O* PR080 01700ORPT D 06 01 PR080 01710O CONAME 42 PR080 01720O* PR080 01730ORPT D 07 01 PR080 01740O COSTRT 29 PR080 01750O* PR080 0001760O D 08 01 PR080 01770O COCITY 36 PR080 01780O STAID 74 PR080 01790O D 11 01 PR080 01800O SS1 9 PR080 01810O 10 '-' PR080 01820O SS2 12 PR080 0001830O 13 '-' PR080 01840O SS3 17 PR080 01850O FWH J 33 PR080 01860O GPAY J 48 PR080 01870O FICA J 62 PR080 01880O FICAW J 75 PR080 01890O D 14 01 PR080 0001900O 80 48 'YES' PR080 01910O N80 48 'NO' PR080 01920O D 15 01 PR080 01930O FI 7 PR080 01940O N10 8 '.' PR080 01950O SI 9 PR080 01960O N11 10 '.' PR080 0001970O NAME 26 PR080 01980O D 16 01 PR080 01990O ADDRS 41 PR080 02000O D 17 01 PR080 02010O CITY 26 PR080 02020O STATE 29 PR080 02030O ZIP 35 PR080 0002040O N13 SWH J 48 PR080 02050O GPAY J 62 PR080 02060O N13 STATE 75 PR080 02070O D 19 01 PR080 02080O SDI J 45 PR080 02090O 48 'SDI' PR080 02100ORPT T 05 LR PR080 0002110O 9 'FED' PR080 02120O FEDID 22 PR080 02130O* 26 'ST' PR080 02140O* STATID 39 PR080 02150O T 06 LR PR080 02160O CONAME 42 PR080 02170O T 07 LR PR080 0002180O COSTRT 29 PR080 02190O T 08 LR PR080 02200O COCITY 36 PR080 02210O STAID 74 PR080 02220O T 09 LR PR080 02230O 36 '** COMPANY TOTALS **' PR080 02240O UDATE Y 46 PR080 0002250ORPT T 11 LR PR080 02260O 17 '***********' PR080 02270O TFWH J 33 PR080 02280O TGPAY J 48 PR080 02290O TFICA J 62 PR080 02300O TFICAWJ 75 PR080 02310ORPT T 15 LR PR080 0002320O 26 '** COMPANY TOTALS **' PR080 02330O T 17 LR PR080 02340O TSWH J 48 PR080 02350O TGPAY J 62 PR080 02360O* STATE 75 CAN BE MORE THAN ONE? PR080 02370O T 19 PR080 02380O TCTAX J 48 PR080 0002390O TGPAY J 62 PR080 02400O* CITYAB MORE THAN ONE ? PR080 02410ORPT E 08 82 PR080 02420O 74 'XXXXXXXXXXX' PR080 02430ORPT E 11 82 PR080 02440O 17 'XXX-XX-XXXX' PR080 02450O 33 '99,999.99-' PR080 0002460O 48 '999,999.99-' PR080 02470O 62 '99,999.99-' PR080 02480O 75 '999,999.99-' PR080 02490ORPT E 15 82 PR080 02500O 26 '*THIS IS NAME FIELD*' PR080 ** 002510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00252000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002530ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002550** 002560CHECK SAMPLE FORM FOR PROPER ALIGNMENT 002570ARE FORMS PROPERLY ALIGNED? (Y,N) 002580 00259000/* 002600__EQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002550** 002560CHECK SAMPLE FORM FOR PROPER ALIGNMENT 002570ARE FORMS PROPERLY ALIGNED? (Y,N) 002580 0025900(l^u KTXCMMANT P999999111111(000010H S CMMANT00020X DECK-ID B17 MFG/DIST/ACCT SYSTEM SUMMARY-123 CMMANT00030F* INQUIRY/MAINTENANCE - COMPANY NAME MASTER FILE (CNMAST) CMMANT00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0CMMANT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA CMMANT00060F* CONTROL DATA PROPRIETARY PRODUCT CMMANT00070F* CMMANT0000080F* CMMANT00090F* *************************************************************** CMMANT00100F* * ************************************************* * CMMANT00110F* * * * * CMMANT00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * CMMANT00130F* * * * * CMMANT00140F* * ************************************************* * CMMANT0000150F* *************************************************************** CMMANT00160F* CMMANT00170FNULL IPEAF 72 DISK CMMANT00180FCNPARM IC F 32R DISK CMMANT00190FCNMAST UC F 0128R02AI 0001 DISK A CMMANT00200E FN 012 22 FIELD NAME CMMANT00210E CP 012 4 CURSOR POSITION CMMANT0000220E LN 012 2 0 LENGTH CMMANT00230E EP 012 4 0 ENDING POSITION CMMANT00240INULL NS 01 CMMANT00250I 1 1 A CMMANT00260ICNPARM NS 02 CMMANT00270I 1 22 FIELDN CMMANT00280I 23 26 CURPOS CMMANT0000290I 27 280LNGTH CMMANT00300I 29 310ENDPOS CMMANT00310ICNMAST NS 03 CMMANT00320I 10128 RECORD CMMANT00330C MOVE ' ' RCODE 1 CMMANT00340C MOVE RCODE B22 22 CMMANT00350C MOVE RCODE BLANKS 72 CMMANT0000360C MOVE RCODE FILLER 1 CMMANT00370C Z-ADD0 MASK 10 CMMANT00380C SETON LR CMMANT00390CLR Z-ADD012 SSIZE 30 CMMANT00400CLR Z-ADD002 NSECT 30 CMMANT00410CLR BITON'01234567'FF 1 CMMANT00420CLR MOVE '[]<>' TEMP4 4 CMMANT0000430CLR START TAG CMMANT00440C* ********** CMMANT00450CLR EXSR FIRSTP CMMANT00460C* ********** CMMANT00470CLR EXSR CLRSCR CMMANT00480C* ********** CMMANT00490CLR 40 GOTO EOJ CMMANT0000500C* ********** CMMANT00510CLR Z-ADD2 VL CMMANT00520CLR MOVELSECTON VAR CMMANT00530CLR EXSR RTADJ CMMANT00540C* ********** CMMANT00550CLR MOVELVAR SECTN 20 CMMANT00560CLR EXSR GETSEC CMMANT0000570C* ********** CMMANT00580CLRN45 GOTO START CMMANT00590C* ********** CMMANT00600CLR EXSR CLRSCR CMMANT00610C* ********** CMMANT00620CLR EXSR OUTPUT CMMANT00630C* ********** CMMANT0000640CLR EXSR UPDATE CMMANT00650C* ********** CMMANT00660CLR GOTO START CMMANT00670C* ********** CMMANT00680CLR EOJ TAG CMMANT00690C* ********** CMMANT00700C********************************************************************CMMANT0000710C* CMMANT00720C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND CMMANT00730C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. CMMANT00740C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDCMMANT00750C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN CMMANT00760C* CMMANT00770C********************************************************************CMMANT0000780CSR FIRSTP BEGSR CMMANT00790C* ********** CMMANT00800CSR EXSR CLRSCR CMMANT00810C* ********** CMMANT00820CSR Z-ADD0 SECTN CMMANT00830CSR EXSR GETSEC CMMANT00840C* ********** CMMANT0000850CSR PGE TAG CMMANT00860C* ********** CMMANT00870CSR SETON 61 CMMANT00880CSR SETOF 62 CMMANT00890CSR EXSR OUTPUT CMMANT00900C* ********** CMMANT00910C* ********** CMMANT0000920CSR EXIT SUBRFL CMMANT00930CSR RLABL RECORD CMMANT00940CSR RLABL FILLER 1 CMMANT00950C* ********** CMMANT00960C* ********** CMMANT00970C* ********** CMMANT00980C* ********** CMMANT0000990C* ********** CMMANT01000C* ********** CMMANT01010C* ********** CMMANT01020C* ********** CMMANT01030C* ********** CMMANT01040C* ********** CMMANT01050C* ********** CMMANT0001060C* ********** CMMANT01070C* ********** CMMANT01080C* ********** CMMANT01090C* ********** CMMANT01100CSR Z-ADD02 NCHARS CMMANT01110CSR Z-ADD1 SSTRT CMMANT01120CSR Z-ADD1 TSTRT CMMANT0001130C* ********** CMMANT01140CSR EXIT SUBRLM CMMANT01150CSR RLABL KEY 02 CMMANT01160CSR RLABL SSTRT 30 CMMANT01170CSR RLABL RECORD CMMANT01180CSR RLABL TSTRT 30 CMMANT01190CSR RLABL NCHARS 30 CMMANT0001200CSR Z-ADDNOFLDS SVFLDS 30 CMMANT01210CSR Z-ADDSX NOFLDS CMMANT01220CSR EXSR UPDATE CMMANT01230C* ********** CMMANT01240CSR Z-ADDSVFLDS NOFLDS CMMANT01250CSR Z-ADD02 NCHARS CMMANT01260CSR Z-ADD1 SSTRT CMMANT0001270CSR Z-ADD1 TSTRT CMMANT01280C* ********** CMMANT01290CSR EXIT SUBRLM CMMANT01300CSR RLABL RECORD CMMANT01310CSR RLABL SSTRT 30 CMMANT01320CSR RLABL KEY CMMANT01330CSR RLABL TSTRT 30 CMMANT0001340CSR RLABL NCHARS 30 CMMANT01350CSR KEY CHAINCNMAST 55 CMMANT01360CSR MOVELSAVPOS BUFFER CMMANT01370CSR MOVELOFC BUFFER CMMANT01380CSR EXSR POSCUR CMMANT01390C* ********** CMMANT01400CSR MOVEL'] NEW R'WORD16 16 CMMANT0001410CSR MOVE 'ECORD 'WORD16 CMMANT01420CSRN55 MOVELBLANKS WORD16 CMMANT01430CSRN55 MOVEL']' WORD16 CMMANT01440CSR MOVELWORD16 BUFFER 72 CMMANT01450CSR MOVE 'T' TYPE 1 CMMANT01460CSR Z-ADD13 BLNGTH 20 CMMANT01470CSR EXSR CRTCOM CMMANT0001480C* ********** CMMANT01490CSR SETON 62 CMMANT01500CSR Z-ADDSX X 30 CMMANT01510CSR EXSR ACCEPT CMMANT01520C* ********** CMMANT01530CSR MOVELBUFFER SECTON 2 CMMANT01540CSR SECTON COMP 'E ' 40 CMMANT0001550CSR 40 GOTO ENDFP CMMANT01560C* ********** CMMANT01570CSR SECTON COMP 'D ' 40 CMMANT01580CSR 40N55 EXCPT CMMANT01590CSR 40 GOTO PGE CMMANT01600C* ********** CMMANT01610CSR SECTON COMP ' 1' 30 30 CMMANT0001620CSR 30 SECTON COMP ' 9' 3030 CMMANT01630CSR 30 GOTO GOOD CMMANT01640C* ********** CMMANT01650CSR SECTON COMP '01' 30 30 CMMANT01660CSR 30 SECTON COMP '09' 3030 CMMANT01670CSR 30 GOTO GOOD CMMANT01680C* ********** CMMANT0001690CSR SECTON COMP '1 ' 30 30 CMMANT01700CSR 30 SECTON COMP '9 ' 3030 CMMANT01710CSR 30 GOTO GOOD CMMANT01720C* ********** CMMANT01730CSR MOVELSECTON TEMP1 1 CMMANT01740CSR TEMP1 COMP '1' 30 30 CMMANT01750CSR 30 TEMP1 COMP '9' 3030 CMMANT0001760CSRN30 GOTO PGE CMMANT01770C* ********** CMMANT01780CSR MOVE SECTON TEMP1 CMMANT01790CSR TEMP1 COMP '0' 30 30 CMMANT01800CSR 30 TEMP1 COMP '9' 3030 CMMANT01810CSRN30 GOTO PGE CMMANT01820C* ********** CMMANT0001830CSR GOOD TAG CMMANT01840C* ********** CMMANT01850CSR SETOF 6162 CMMANT01860CSRN55 GOTO ENDFP CMMANT01870C* ********** CMMANT01880CSR SETON 80 CMMANT01890CSR EXCPT CMMANT0001900CSR SETOF 80 CMMANT01910CSR KEY CHAINCNMAST 55 CMMANT01920CSR ENDFP ENDSR CMMANT01930C* ********** CMMANT01940C********************************************************************CMMANT01950C* CMMANT01960C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. CMMANT0001970C* CMMANT01980C********************************************************************CMMANT01990CSR GETSEC BEGSR CMMANT02000C* ********** CMMANT02010CSR 1 ADD SECTN N 20 CMMANT02020CSR SETOF 404145 CMMANT02030CSR N COMP 0 3030 CMMANT0002040CSRN30 N COMP NSECT 30 CMMANT02050CSR 30 GOTO ENDGET CMMANT02060C* ********** CMMANT02070CSR SECTN MULT SSIZE RRN 40 CMMANT02080CSR Z-ADD1 X CMMANT02090CSR SCLOOP TAG CMMANT02100C* ********** CMMANT0002110CSR RRN ADD 1 RRN CMMANT02120CSR RRN CHAINCNPARM 50 CMMANT02130CSR 50 GOTO ENDGET CMMANT02140C* ********** CMMANT02150CSR FIELDN COMP B22 4141 CMMANT02160CSRN41 GOTO ENDGET CMMANT02170C* ********** CMMANT0002180CSR 41N45 SETON 45 CMMANT02190CSR MOVE FIELDN FN,X CMMANT02200CSR MOVE CURPOS CP,X CMMANT02210CSR MOVE LNGTH LN,X CMMANT02220CSR Z-ADDENDPOS EP,X CMMANT02230CSR 1 ADD X X CMMANT02240CSR X COMP SSIZE 32 CMMANT0002250CSRN32 GOTO SCLOOP CMMANT02260C* ********** CMMANT02270CSR ENDGET TAG CMMANT02280C* ********** CMMANT02290CSR Z-ADDX NOFLDS 30 CMMANT02300CSR 45 GOTO FINGET CMMANT02310C* ********** CMMANT0002320CSR EXSR CLRSCR CMMANT02330C* ********** CMMANT02340CSR MOVEL'SECT # 'WORD9 9 CMMANT02350CSR Z-ADD16 BLNGTH CMMANT02360CSR MOVE SECTN WORD9 CMMANT02370CSR MOVELWORD9 WORD16 CMMANT02380CSRN30 MOVE ' ABSENT' WORD16 CMMANT0002390CSR 30 MOVE ' ILLEG.' WORD16 CMMANT02400CSR MOVELWORD16 BUFFER CMMANT02410CSR MOVEL'T' TYPE CMMANT02420CSR EXSR CRTCOM CMMANT02430C* ********** CMMANT02440CSR FINGET ENDSR CMMANT02450C* ********** CMMANT0002460C********************************************************************CMMANT02470C* CMMANT02480C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE CMMANT02490C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE CMMANT02500C* SECTION INDEX IS SAVED. CMMANT02510C* CMMANT02520C********************************************************************CMMANT0002530CSR OUTPUT BEGSR CMMANT02540C* ********** CMMANT02550CSR EXSR CLRSCR CMMANT02560C* ********** CMMANT02570CSR Z-ADD1 X CMMANT02580CSR 61 SETON 63 CMMANT02590CSR OTLOOP TAG CMMANT0002600C* ********** CMMANT02610CSR 61 LN,X COMP 0 31 CMMANT02620CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXCMMANT02630CSR EXSR OUTFLD CMMANT02640C* ********** CMMANT02650CSR X ADD 1 X CMMANT02660CSR X COMP NOFLDS 31 CMMANT0002670CSR 31 GOTO OTLOOP CMMANT02680C* ********** CMMANT02690CSR SETOF 63 CMMANT02700CSR ENDSR CMMANT02710C********************************************************************CMMANT02720C* CMMANT02730C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND CMMANT0002740C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 CMMANT02750C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS CMMANT02760C* THEN NO FIELD INFORMATION IS PRINTED CMMANT02770C* CMMANT02780C********************************************************************CMMANT02790CSR OUTFLD BEGSR CMMANT02800C* ********** CMMANT0002810CSR MOVE FN,X FL 20 CMMANT02820CSR EP,X COMP 0 98 CMMANT02830CSR MOVELCP,X FC 20 CMMANT02840CSR FC COMP FL 31 CMMANT02850CSR 31 Z-ADDFC FL CMMANT02860CSR FC SUB FL CC 20 CMMANT02870CSR CC ADD 1 CC CMMANT0002880CSR MOVELCP,X BUFFER CMMANT02890CSR MOVELCC BUFFER CMMANT02900CSR EXSR POSCUR CMMANT02910C* ********** CMMANT02920CSR MOVELBLANKS BUFFER CMMANT02930CSR MOVELFN,X FIELDN CMMANT02940CSR MOVE ' ' FIELDN CMMANT0002950CSR MOVELFIELDN BUFFER CMMANT02960CSR Z-ADDLN,X LEN 20 CMMANT02970CSR LEN COMP 0 9730 CMMANT02980CSR 97 Z-SUBLN,X LEN CMMANT02990CSR 30 GOTO SKIPF CMMANT03000C* ********** CMMANT03010CSR FL ADD 2 BPOS 20 CMMANT0003020C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS CMMANT03030CSR Z-ADDBPOS TSTRT 30 CMMANT03040CSRN98 Z-ADD1 SSTRT 30 CMMANT03050CSR 98 Z-ADD3 SSTRT CMMANT03060CSR Z-ADD1 NCHARS 30 CMMANT03070C* ********** CMMANT03080CSR EXIT SUBRLM CMMANT0003090CSR RLABL TEMP4 CMMANT03100CSR RLABL SSTRT 30 CMMANT03110CSR RLABL BUFFER CMMANT03120CSR RLABL TSTRT 30 CMMANT03130CSR RLABL NCHARS 30 CMMANT03140CSR BPOS ADD 1 FPOS 20 CMMANT03150CSR EXSR MVRECD CMMANT0003160C* ********** CMMANT03170CSR SKIPF TAG CMMANT03180CSR 30 Z-ADDFL BLNGTH CMMANT03190CSRN30 FL ADD 3 BLNGTH CMMANT03200CSRN30 BLNGTH ADD LEN BLNGTH CMMANT03210CSR MOVE 'T' TYPE CMMANT03220CSR EXSR CRTCOM CMMANT0003230C* ********** CMMANT03240CSR ENDSR CMMANT03250C********************************************************************CMMANT03260C* CMMANT03270C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN CMMANT03280C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST CMMANT03290C* THE RIGHT BRACKET. CMMANT0003300C********************************************************************CMMANT03310CSR MVRECD BEGSR CMMANT03320C* ********** CMMANT03330CSR 63 GOTO RBRK CMMANT03340C* ********** CMMANT03350CSR 98 Z-SUBEP,X END 40 CMMANT03360CSRN98 Z-ADDEP,X END CMMANT0003370CSR END SUB LEN STRT 40 81 81 CMMANT03380CSR STRT ADD 1 STRT CMMANT03390C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER CMMANT03400C* FROM STRT IN RECORD TO FPOS IN BUFFER CMMANT03410CSR Z-ADDLEN NCHARS CMMANT03420CSR Z-ADDSTRT SSTRT CMMANT03430CSR Z-ADDFPOS TSTRT CMMANT0003440C* ********** CMMANT03450CSRN81 GOTO RBRK CMMANT03460CSR EXIT SUBRLM CMMANT03470CSR RLABL RECORD CMMANT03480CSR RLABL SSTRT 30 CMMANT03490CSR RLABL BUFFER CMMANT03500CSR RLABL TSTRT 30 CMMANT0003510CSR RLABL NCHARS 30 CMMANT03520CSR RBRK TAG CMMANT03530C* ********** CMMANT03540CSR EXSR RTBRKT CMMANT03550C* ********** CMMANT03560CSR ENDSR CMMANT03570C********************************************************************CMMANT0003580C* CMMANT03590C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS CMMANT03600C* CMMANT03610C********************************************************************CMMANT03620CSR RTBRKT BEGSR CMMANT03630C* ********** CMMANT03640CSR LEN ADD FPOS FPOS CMMANT0003650CSR Z-ADDFPOS TSTRT CMMANT03660CSR Z-ADD1 NCHARS CMMANT03670CSRN98 Z-ADD2 SSTRT CMMANT03680CSR 98 Z-ADD4 SSTRT CMMANT03690C* ********** CMMANT03700CSR EXIT SUBRLM CMMANT03710CSR RLABL TEMP4 CMMANT0003720CSR RLABL SSTRT 30 CMMANT03730CSR RLABL BUFFER CMMANT03740CSR RLABL TSTRT 30 CMMANT03750CSR RLABL NCHARS 30 CMMANT03760CSR ENDSR CMMANT03770C********************************************************************CMMANT03780C* CMMANT0003790C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. CMMANT03800C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO CMMANT03810C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF CMMANT03820C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST CMMANT03830C* OF THE FIELDS ARE LEFT UNCHANGED CMMANT03840C* CMMANT03850C********************************************************************CMMANT0003860CSR UPDATE BEGSR CMMANT03870C* ********** CMMANT03880CSR SETOF 32 CMMANT03890CSR Z-ADD1 X CMMANT03900CSR UPLOOP TAG CMMANT03910C* ********** CMMANT03920CSR EP,X COMP 0 98 CMMANT0003930CSR 98 SETON 30 CMMANT03940CSR 98 GOTO NOUPD CMMANT03950C* ********** CMMANT03960CSR Z-ADDLN,X LEN CMMANT03970CSR LEN COMP 0 9730 CMMANT03980CSR 97 Z-SUBLEN LEN CMMANT03990CSR NOUPD TAG CMMANT0004000C* ********** CMMANT04010CSR 30N32 GOTO INCR CMMANT04020C* ********** CMMANT04030CSR 30 GOTO CHKRUB CMMANT04040C* ********** CMMANT04050CSR SETOF 3233 CMMANT04060CSR EXSR ACCEPT CMMANT0004070C* ********** CMMANT04080CSR CHKRUB TAG CMMANT04090C* ********** CMMANT04100CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTCMMANT04110CSR 32 31 GOTO UPLOOP CMMANT04120C* ********** CMMANT04130CSR 32 GOTO ENDUPD CMMANT0004140C* ********** CMMANT04150CSR MOVELBUFFER ATSIGN 1 CMMANT04160CSR ATSIGN COMP '@' 35 CMMANT04170CSR 35 GOTO OUTREC CMMANT04180C* ********** CMMANT04190CSR 33 GOTO INCR WAS LINE FEED CMMANT04200C* ********** CMMANT0004210CSR Z-ADDEP,X END CMMANT04220CSR END SUB LEN STRT 81 81 CMMANT04230CSR STRT ADD 1 STRT CMMANT04240C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF CMMANT04250C* BUFFER TO THE STRT OF RECORD CMMANT04260CSR Z-ADD1 SSTRT CMMANT04270CSR Z-ADDSTRT TSTRT CMMANT0004280CSR Z-ADDLEN NCHARS CMMANT04290C* ********** CMMANT04300CSRN81 GOTO AAA CMMANT04310CSR EXIT SUBRLM CMMANT04320CSR RLABL BUFFER CMMANT04330CSR RLABL SSTRT 30 CMMANT04340CSR RLABL RECORD CMMANT0004350CSR RLABL TSTRT 30 CMMANT04360CSR RLABL NCHARS 30 CMMANT04370CSR AAA TAG CMMANT04380CSR MOVELBUFFER TEMP5 5 CMMANT04390CSR MOVELSAVPOS BUFFER CMMANT04400CSR EXSR POSCUR CMMANT04410C* ********** CMMANT0004420CSR MOVELTEMP5 BUFFER CMMANT04430CSR Z-ADD1 FPOS CMMANT04440CSR EXSR RTBRKT CMMANT04450C* ********** CMMANT04460CSR LEN ADD 1 BLNGTH CMMANT04470CSR MOVE 'T' TYPE CMMANT04480CSR EXSR CRTCOM CMMANT0004490C* ********** CMMANT04500CSR INCR TAG CMMANT04510C* ********** CMMANT04520CSR X ADD 1 X CMMANT04530CSR X COMP NOFLDS 30 CMMANT04540CSR 30 GOTO UPLOOP CMMANT04550C* ********** CMMANT0004560CSR OUTREC TAG CMMANT04570C* ********** CMMANT04580CSR SETON 80 CMMANT04590CSRN61 EXCPT CMMANT04600CSR SETOF 80 CMMANT04610CSR ENDUPD TAG CMMANT04620C* ********** CMMANT0004630CSR ENDSR CMMANT04640C********************************************************************CMMANT04650C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE CMMANT04660C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X CMMANT04670C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND CMMANT04680C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT CMMANT04690C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED CMMANT0004700C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS CMMANT04710C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS CMMANT04720C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO CMMANT04730C* TO BE OUTPUT TO THE SCREEN. CMMANT04740C* CMMANT04750C********************************************************************CMMANT04760CSR ACCEPT BEGSR CMMANT0004770C* ********** CMMANT04780CSR X COMP 1 30 CMMANT04790CSRN30 X COMP SSIZE 30 CMMANT04800CSR 30 Z-ADD1 X CMMANT04810CSR MOVELCP,X FC CMMANT04820CSR FC ADD 3 FC CMMANT04830CSR MOVELCP,X SAVPOS 4 CMMANT0004840CSR MOVELFC SAVPOS CMMANT04850CSR Z-ADDLN,X LEN CMMANT04860CSR LEN COMP 0 97 CMMANT04870CSR 97 Z-SUBLEN LEN CMMANT04880CSR LEN ADD FC OFC 20 CMMANT04890CSR ACLOOP TAG CMMANT04900C* ********** CMMANT0004910CSR MOVELSAVPOS BUFFER CMMANT04920CSR EXSR POSCUR CMMANT04930C* ********** CMMANT04940CSR Z-ADDLEN BLNGTH CMMANT04950CSR MOVE BLANKS BUFFER CMMANT04960CSR MOVE 'A' TYPE CMMANT04970CSR EXSR CRTCOM CMMANT0004980C* ********** CMMANT04990CSR RCODE COMP 'R' 31 CMMANT05000CSR 31 BUFFER COMP BLANKS 32 CMMANT05010CSR 31 32N62 GOTO DUPIT CMMANT05020C* ********** CMMANT05030CSR 31 GOTO ACLOOP CMMANT05040C* ********** CMMANT0005050CSR RCODE COMP 'L' 33 CMMANT05060CSR 33 GOTO DUPIT CMMANT05070C* ********** CMMANT05080CSRN97 GOTO ENDACC CMMANT05090C* ********** CMMANT05100CSR MOVELBUFFER SIGN 1 WE MUST CHECK CMMANT05110CSR SIGN COMP '@' 30 CMMANT0005120CSR 30 GOTO ENDACC CMMANT05130C* ********** CMMANT05140CSR Z-ADDLEN VL 20 CMMANT05150CSR MOVELBUFFER VAR 15 CMMANT05160CSR EXSR RTADJ CMMANT05170C* ********** CMMANT05180CSR MOVELVAR BUFFER CMMANT0005190CSR GOTO ENDACC CMMANT05200C* ********** CMMANT05210CSR DUPIT TAG CMMANT05220C* ********** CMMANT05230CSR MOVELSAVPOS BUFFER CMMANT05240CSR EXSR POSCUR CMMANT05250C* ********** CMMANT0005260CSR 62 MOVELSECTON BUFFER CMMANT05270CSRN62 Z-ADD1 FPOS CMMANT05280CSRN62 EXSR MVRECD CMMANT05290C* ********** CMMANT05300CSR MOVE 'T' TYPE CMMANT05310CSR BLNGTH ADD 1 BLNGTH CMMANT05320CSR EXSR CRTCOM CMMANT0005330C* ********** CMMANT05340CSR ENDACC ENDSR CMMANT05350C* ********** CMMANT05360C********************************************************************CMMANT05370C* CMMANT05380C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES CMMANT05390C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM CMMANT0005400C* 4 DUMMY FOR RTADJ CMMANT05410C* CMMANT05420C********************************************************************CMMANT05430CSR POSCUR BEGSR CMMANT05440C* ********** CMMANT05450CSR MOVE 'P' TYPE CMMANT05460CSR EXSR CRTCOM CMMANT0005470C* ********** CMMANT05480CSR ENDSR CMMANT05490C********************************************************************CMMANT05500CSR CLRSCR BEGSR CMMANT05510C* ********** CMMANT05520CSR MOVE 'C' TYPE CMMANT05530CSR EXSR CRTCOM CMMANT0005540C* ********** CMMANT05550CSR ENDSR CMMANT05560C********************************************************************CMMANT05570CSR CRTCOM BEGSR CMMANT05580C* ********** CMMANT05590CSR EXITFSUBRCM CMMANT05600CSR RLABL BUFFER 72 CMMANT0005610CSR RLABL TYPE 1 CMMANT05620CSR RLABL BLNGTH 20 CMMANT05630CSR RLABL RCODE 1 CMMANT05640CSR RLABL MASK 10 CMMANT05650CSR RLABL DTYPE 10 CMMANT05660CSR ENDSR CMMANT05670C********************************************************************CMMANT0005680CSR RTADJ BEGSR CMMANT05690C* ********** CMMANT05700CSR EXIT SUBRAJ CMMANT05710C* ********** CMMANT05720CSR RLABL VL CMMANT05730CSR RLABL VAR CMMANT05740CSR ENDSR CMMANT0005750C********************************************************************CMMANT05760OCNMAST E 80N55 CMMANT05770O RECORD 0128 CMMANT05780O E 40N80 CMMANT05790O FF 1 CMMANT05800O EADD 80 55 CMMANT05810O RECORD 0128 CMMANT00** 005820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005840ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005850ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005860/* 005870__0O RECORD 0128 CMMANT0(}_y 5TXPRAMR P999999111111(000010H S PRAMR 00020X DECK-ID B18 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRAMR 00030F* ADD WEEKLY EARNINGS (WEARNS) TO MONTHLY EARNINGS (MEARNS) PRAMR 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRAMR 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRAMR 00060F* CONTROL DATA PROPRIETARY PRODUCT PRAMR 00070F* PRAMR 0000080F* PRAMR 00090F* *************************************************************** PRAMR 00100F* * ************************************************* * PRAMR 00110F* * * * * PRAMR 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRAMR 00130F* * * * * PRAMR 00140F* * ************************************************* * PRAMR 0000150F* *************************************************************** PRAMR 00160F* PRAMR 00170FWEARNS IP AF 140 140 DISK PRAMR 00180FMEARNS O F 140 140 DISK A PRAMR 00190IWEARNS NS 01 1NC# PRAMR 00200I 1 140 RCD PRAMR 00210I* PRAMR 0000220I NS 02 PRAMR 00230I 1 1 MKYMSE PRAMR 00240C* 02 MOVE MKYMSE MKYMSE PRAMR 00250OMEARNS DADD 01 PRAMR 00260O RCD 140 PRAMR ** 000270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00028000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000290ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000300ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000310/* 000320__0O RCD 140 PRAMR ** 000270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0002800(}_ 5TXPRCP1 P999999111111(000010H S PRCP1 00020X DECK-ID B19 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRCP1 00030F* COPIES PAYROLL MASTER FILE FOR PURGING PURPOSES PRCP1 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRCP1 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRCP1 00060F* CONTROL DATA PROPRIETARY PRODUCT PRCP1 00070F* PRCP1 0000080F* PRCP1 00090FPRMAST IP AF 600 600 10AI 2 DISK PRCP1 00100FSQMAST O F 600 600 10AI 2 DISK PRCP1 00110IPRMAST NS 01 PRCP1 00120I 001 200 A PRCP1 00130I 201 380 B PRCP1 00140I 381 381 BB PRCP1 0000150I 382 600 C PRCP1 00160C SETOF 21 PRCP1 00170C BB COMP 'D' 21 PRCP1 00180OSQMAST D 01N21 PRCP1 00190O A 200 PRCP1 00200O B 380 PRCP1 00210O BB 381 PRCP1 0000220O C 600 PRCP1 ** 000230ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000240ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000250ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000260ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000270/* 00028000__0O C 600 PRCP1 ** 000230ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000240ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000250ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000260ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000270/* 0002800(}_ !5TXPRCP2 P999999111111(000010H S PRCP2 00020X DECK-ID B20 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRCP2 00030F* COPIES PAYROLL MASTER FILE FOR PURGING PURPOSES PRCP2 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRCP2 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRCP2 00060F* CONTROL DATA PROPRIETARY PRODUCT PRCP2 00070F* PRCP2 0000080F* PRCP2 00090FPRMAST IP AF 600 600 10AI 2 DISK PRCP2 00100FSCMAST O F 600 600 10AI 1 DISK PRCP2 00110IPRMAST NS 01 PRCP2 00120I 004 007 A PRCP2 00130I 008 011 CC PRCP2 00140I 012 154 DD PRCP2 0000150I 155 156 AA PRCP2 00160I 157 200 EE PRCP2 00170I 201 400 B PRCP2 00180I 401 600 C PRCP2 00190C SETON 01 PRCP2 00200OSCMAST D 01 PRCP2 00210O AA 02 PRCP2 0000220O CC 06 PRCP2 00230O A 10 PRCP2 00240O DD 154 PRCP2 00250O EE 200 PRCP2 00260O B 400 PRCP2 00270O C 600 PRCP2 ** 00028000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000320/* 000330__0O C 600 PRCP2 ** 0002800(}` 5TXPRCP3 P999999111111(000010H S PRCP3 00020X DECK-ID B21 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRCP3 00030F* COPIES PAYROLL MASTER FILE FOR PURGING PURPOSES PRCP3 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRCP3 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRCP3 00060F* CONTROL DATA PROPRIETARY PRODUCT PRCP3 00070F* PRCP3 0000080F* PRCP3 00090FPRMAST IP AF 600 600 10AI 2 DISK PRCP3 00100FSQMAST O F 600 600 10AI 2 DISK PRCP3 00110IPRMAST NS 01 PRCP3 00120I 001 130 A PRCP3 00130I 132 332 B PRCP3 00140I 131 131 BB PRCP3 0000150I 333 533 C PRCP3 00160I 534 600 D PRCP3 00170C SETOF 21 PRCP3 00180C BB COMP 'T' 21 PRCP3 00190OSQMAST D 01N21 PRCP3 00200O A 130 PRCP3 00210O B 332 PRCP3 0000220O BB 131 PRCP3 00230O C 533 PRCP3 00240O D 600 PRCP3 ** 000250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00028000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000290/* 000300__0O D 600 PRCP3 ** 000250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0002800(`Q pTXPRDE1 P999999111111(000010H S PRDE1 00020X DECK-ID B22 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRDE1 00030F* PRINT MONTHLY DEDUCTION REGISTER PRDE1 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRDE1 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRDE1 00060F* CONTROL DATA PROPRIETARY PRODUCT PRDE1 00070F* PRDE1 0000080F* PRDE1 00090F* *************************************************************** PRDE1 00100F* * ************************************************* * PRDE1 00110F* * * * * PRDE1 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRDE1 00130F* * * * * PRDE1 00140F* * ************************************************* * PRDE1 0000150F* *************************************************************** PRDE1 00160F* PRDE1 00170F* PRDE1 00180F* ---- INDIVIDUAL DEDUCTION REGISTER ---- PRDE1 00190F* PRDE1 00200F* PRDE1 00210FPRMAST IC F 600 600R10AI 2 DISK PRDE1 0000220FMEARNS IP AF 140 140 DISK PRDE1 00230FRPT O F 132 132 OF LPRINTER PRDE1 00240FCNMAST IC F 128 128R02AI 1 DISK PRDE1 00250LRPT 66FL 60OL PRDE1 00260I* PRDE1 00270I* EMPLOYEE MASTER. PRDE1 00280I* ---------------- PRDE1 0000290IPRMAST NS 05 PRDE1 00300I 012 013 INT PRDE1 00310I 014 033 NAME PRDE1 00320I* PRDE1 00330I* DEDUCTION SUMMARYS. PRDE1 00340I* ------------------- PRDE1 00350IMEARNS NS 02 1 CP 2 C9 PRDE1 0000360I OR 1 CP 2 CP PRDE1 00370I 9 12 EMP L1 PRDE1 00380I 5 8 DEPT L2 PRDE1 00390I 3 40LOC L3 PRDE1 00400I 26 312CU PRDE1 00410I 32 372BD PRDE1 00420I 38 432UN PRDE1 0000430I 44 492LI PRDE1 00440I 50 552HI PRDE1 00450I 56 612PA PRDE1 00460I 62 662EQ PRDE1 00470I 67 712SP PRDE1 00480I 72 762PEN PRDE1 00490I 77 812MISC PRDE1 0000500I 3 12 KEY PRDE1 00510I* PRDE1 00520I* UNUSED RECORDS IN DEDUCTION FILE. PRDE1 00530I* --------------------------------- PRDE1 00540I NS 07 PRDE1 00550I 1 1 UNUSED PRDE1 00560I* PRDE1 0000570ICNMAST NS 04 96NCD PRDE1 00580I 5 40 CONAME PRDE1 00590C L3 LOC CHAINCNMAST 21 PRDE1 00600C L1 MOVEL' ' KEY PRDE1 00610C L1 KEY CHAINPRMAST H1 PRDE1 00620C* ROUTINE FOR DEDUCTION SUMMARIES. PRDE1 00630C* -------------------------------- PRDE1 0000640C N02 GOTO BY2 PRDE1 00650C* ********** PRDE1 00660C* PRDE1 00670C ECU ADD CU ECU 72 43 PRDE1 00680C ETOT ADD CU ETOT 82 PRDE1 00690C EBD ADD BD EBD 72 44 PRDE1 00700C ETOT ADD BD ETOT PRDE1 0000710C EUN ADD UN EUN 72 45 PRDE1 00720C ETOT ADD UN ETOT PRDE1 00730C ELI ADD LI ELI 72 46 PRDE1 00740C ETOT ADD LI ETOT PRDE1 00750C EHI ADD HI EHI 72 47 PRDE1 00760C ETOT ADD HI ETOT PRDE1 00770C EPA ADD PA EPA 72 48 PRDE1 0000780C ETOT ADD PA ETOT PRDE1 00790C EEQ ADD EQ EEQ 72 49 PRDE1 00800C ETOT ADD EQ ETOT PRDE1 00810C ESP ADD SP ESP 72 51 PRDE1 00820C ETOT ADD SP ETOT PRDE1 00830C EPEN ADD PEN EPEN 72 53 PRDE1 00840C ETOT ADD PEN ETOT PRDE1 0000850C EMISC ADD MISC EMISC 72 50 PRDE1 00860C ETOT ADD MISC ETOT 52 PRDE1 00870C* PRDE1 00880C BY2 TAG PRDE1 00890C* ********** PRDE1 00900C* PRDE1 00910C* ACCUM DEPT TOTALS. PRDE1 0000920C* ------------------ PRDE1 00930CL1 DCU ADD ECU DCU 82 65 PRDE1 00940CL1 DBD ADD EBD DBD 82 54 PRDE1 00950CL1 DUN ADD EUN DUN 82 55 PRDE1 00960CL1 DLI ADD ELI DLI 82 56 PRDE1 00970CL1 DHI ADD EHI DHI 82 57 PRDE1 00980CL1 DPA ADD EPA DPA 82 58 PRDE1 0000990CL1 DEQ ADD EEQ DEQ 82 59 PRDE1 01000CL1 DMISC ADD EMISC DMISC 82 60 PRDE1 01010CL1 DSP ADD ESP DSP 82 61 PRDE1 01020CL1 DTOT ADD ETOT DTOT 92 62 PRDE1 01030CL1 DPEN ADD EPEN DPEN 82 66 PRDE1 01040C* PRDE1 01050C* ACCUM LOC TOTALS. PRDE1 0001060C* ----------------- PRDE1 01070CL2 LCU ADD DCU LCU 92 73 PRDE1 01080CL2 LBD ADD DBD LBD 92 74 PRDE1 01090CL2 LUN ADD DUN LUN 92 75 PRDE1 01100CL2 LLI ADD DLI LLI 92 76 PRDE1 01110CL2 LHI ADD DHI LHI 92 77 PRDE1 01120CL2 LPA ADD DPA LPA 92 78 PRDE1 0001130CL2 LEQ ADD DEQ LEQ 92 79 PRDE1 01140CL2 LMISC ADD DMISC LMISC 92 80 PRDE1 01150CL2 LSP ADD DSP LSP 92 81 PRDE1 01160CL2 LTOT ADD DTOT LTOT 102 PRDE1 01170CL2 LPEN ADD DPEN LPEN 92 83 PRDE1 01180O* PRDE1 01190O* REPORT HEADING. PRDE1 0001200O* --------------- PRDE1 01210ORPT H 101 L3 PRDE1 01220O OR 1P PRDE1 01230O OR L2 PRDE1 01240O OR OF PRDE1 01250O N21 CONAME 74 PRDE1 01260O 1 ' ' PRDE1 0001270O* PRDE1 01280ORPT H 1 L3 PRDE1 01290O OR 1P PRDE1 01300O OR L2 PRDE1 01310O OR OF PRDE1 01320O 6 'PRDED1' PRDE1 01330O 111 'M/E DATE' PRDE1 0001340O UDATE Y 120 PRDE1 01350O* PRDE1 01360ORPT H 1 L3 PRDE1 01370O OR 1P PRDE1 01380O OR L2 PRDE1 01390O OR OF PRDE1 01400O 24 'DEDUCTION REGISTER-MONTH' PRDE1 0001410O 26 'LY' PRDE1 01420O 111 'PAGE NO.' PRDE1 01430O PAGE 117 ' , 0' PRDE1 01440O LOC 52 PRDE1 01450O* PRDE1 01460ORPT H 1 L3 PRDE1 01470O OR 1P PRDE1 0001480O OR L2 PRDE1 01490O OR OF PRDE1 01500O 24 '------------------------' PRDE1 01510O 48 '------------------------' PRDE1 01520O 72 '------------------------' PRDE1 01530O 96 '------------------------' PRDE1 01540O 120 '------------------------' PRDE1 0001550O* PRDE1 01560O* COLUMNAR HEADINGS. PRDE1 01570O* ------------------ PRDE1 01580ORPT H 1 L3 PRDE1 01590O OR 1P PRDE1 01600O OR L2 PRDE1 01610O OR OF PRDE1 0001620O 7 'DEP/EMP' PRDE1 01630O 15 'N A M E' PRDE1 01640O 39 'T Y P E' PRDE1 01650O 69 'AMOUNT' PRDE1 01660O 89 'TOTAL' PRDE1 01670O* PRDE1 01680ORPT H 1 L3 PRDE1 0001690O OR 1P PRDE1 01700O OR L2 PRDE1 01710O OR OF PRDE1 01720O 24 '------------------------' PRDE1 01730O 48 '------------------------' PRDE1 01740O 72 '------------------------' PRDE1 01750O 96 '------------------------' PRDE1 0001760O 120 '------------------------' PRDE1 01770O* PRDE1 01780O* BODY OF REPORT. PRDE1 01790O* --------------- PRDE1 01800O* PRDE1 01810O* TOTALS BY TYPE FOR EMPLOYEE. PRDE1 01820O* ---------------------------- PRDE1 0001830O* PRDE1 01840ORPT TF1 L1N43 PRDE1 01850O EMP 9 PRDE1 01860O INT 12 PRDE1 01870O NAME 33 PRDE1 01880O 44 'CREDIT UNION' PRDE1 01890O ECU KB 70 PRDE1 0001900O* PRDE1 01910ORPT TF1 L1N44 PRDE1 01920O EMP 9 PRDE1 01930O INT 12 PRDE1 01940O NAME 33 PRDE1 01950O 37 'BONDS' PRDE1 01960O EBD KB 70 PRDE1 0001970O* PRDE1 01980ORPT TF1 L1N45 PRDE1 01990O EMP 9 PRDE1 02000O INT 12 PRDE1 02010O NAME 33 PRDE1 02020O 42 'UNION DUES' PRDE1 02030O EUN KB 70 PRDE1 0002040O* PRDE1 02050ORPT TF1 L1N46 PRDE1 02060O EMP 9 PRDE1 02070O INT 12 PRDE1 02080O NAME 33 PRDE1 02090O 46 'LIFE INSURANCE' PRDE1 02100O ELI KB 70 PRDE1 0002110O* PRDE1 02120ORPT TF1 L1N47 PRDE1 02130O EMP 9 PRDE1 02140O INT 12 PRDE1 02150O NAME 33 PRDE1 02160O 47 'GROUP INSURANCE' PRDE1 02170O EHI KB 70 PRDE1 0002180O* PRDE1 02190ORPT TF1 L1N48 PRDE1 02200O EMP 9 PRDE1 02210O INT 12 PRDE1 02220O NAME 33 PRDE1 02230O 43 'PAY ADVANCE' PRDE1 02240O EPA KB 70 PRDE1 0002250O* PRDE1 02260ORPT TF1 L1N49 PRDE1 02270O EMP 9 PRDE1 02280O INT 12 PRDE1 02290O NAME 33 PRDE1 02300O 41 'EQUIPMENT' PRDE1 02310O EEQ KB 70 PRDE1 0002320O* PRDE1 02330ORPT TF1 L1N51 PRDE1 02340O EMP 9 PRDE1 02350O INT 12 PRDE1 02360O NAME 33 PRDE1 02370O 46 'STOCK PURCHASE' PRDE1 02380O ESP KB 70 PRDE1 0002390O* PRDE1 02400ORPT TF1 L1N53 PRDE1 02410O EMP 9 PRDE1 02420O INT 12 PRDE1 02430O NAME 33 PRDE1 02440O 39 'PENSION' PRDE1 02450O EPEN KB 70 PRDE1 0002460O* PRDE1 02470ORPT TF1 L1N50 PRDE1 02480O EMISC KB 70 PRDE1 02490O 45 'MISCELLANEOUS' PRDE1 02500O EMP 9 PRDE1 02510O INT 12 PRDE1 02520O NAME 33 PRDE1 0002530O* PRDE1 02540O* OVERALL TOTAL FOR EMPLOYEE. PRDE1 02550O* --------------------------- PRDE1 02560ORPT T 1 L1N52 PRDE1 02570O ETOT KB 90 PRDE1 02580O DEPT 4 PRDE1 02590O* PRDE1 0002600ORPT T 160 L2N62NOF PRDE1 02610O 1 ' ' PRDE1 02620O* PRDE1 02630O* TOTALS BY TYPE FOR DEPT. PRDE1 02640O* ------------------------ PRDE1 02650ORPT TF1 L2N62 PRDE1 02660O 14 'TOTAL FOR DEPT' PRDE1 0002670O DEPT 19 PRDE1 02680O* PRDE1 02690ORPT T 1 L2N65 PRDE1 02700O 44 'CREDIT UNION' PRDE1 02710O DCU KB 70 PRDE1 02720O* PRDE1 02730ORPT T 1 L2N54 PRDE1 0002740O 37 'BONDS' PRDE1 02750O DBD KB 70 PRDE1 02760O* PRDE1 02770ORPT T 1 L2N55 PRDE1 02780O 42 'UNION DUES' PRDE1 02790O DUN KB 70 PRDE1 02800O* PRDE1 0002810ORPT T 1 L2N56 PRDE1 02820O 46 'LIFE INSURANCE' PRDE1 02830O DLI KB 70 PRDE1 02840O* PRDE1 02850ORPT T 1 L2N57 PRDE1 02860O 47 'GROUP INSURANCE' PRDE1 02870O DHI KB 70 PRDE1 0002880O* PRDE1 02890ORPT T 1 L2N58 PRDE1 02900O 43 'PAY ADVANCE' PRDE1 02910O DPA KB 70 PRDE1 02920O* PRDE1 02930ORPT T 1 L2N59 PRDE1 02940O 41 'EQUIPMENT' PRDE1 0002950O DEQ KB 70 PRDE1 02960O* PRDE1 02970ORPT T 1 L2N61 PRDE1 02980O 46 'STOCK PURCHASE' PRDE1 02990O DSP KB 70 PRDE1 03000O* PRDE1 03010ORPT T 1 L2N66 PRDE1 0003020O 39 'PENSION' PRDE1 03030O DPEN KB 70 PRDE1 03040O* PRDE1 03050ORPT T 1 L2N60 PRDE1 03060O 45 'MISCELLANEOUS' PRDE1 03070O DMISC KB 70 PRDE1 03080O* PRDE1 0003090ORPT T 2 L2N62 PRDE1 03100O DTOT KB 90 PRDE1 03110O* PRDE1 03120ORPT T 160 L2N62NOF PRDE1 03130O 1 ' ' PRDE1 03140O* PRDE1 03150ORPT T 160 LRNOF PRDE1 0003160O 1 ' ' PRDE1 03170O* PRDE1 03180O* FINAL TOTALS. PRDE1 03190O* ------------- PRDE1 03200ORPT TF1 LR PRDE1 03210O 16 'FINAL TOTALS' PRDE1 03220ORPT T 1 LRN73 PRDE1 0003230O 44 'CREDIT UNION' PRDE1 03240O LCU KB 70 PRDE1 03250ORPT T 1 LRN74 PRDE1 03260O 37 'BONDS' PRDE1 03270O LBD KB 70 PRDE1 03280O* PRDE1 03290ORPT T 1 LRN75 PRDE1 0003300O 42 'UNION DUES' PRDE1 03310O LUN KB 70 PRDE1 03320O* PRDE1 03330ORPT T 1 LRN76 PRDE1 03340O 46 'LIFE INSURANCE' PRDE1 03350O LLI KB 70 PRDE1 03360O* PRDE1 0003370ORPT T 1 LRN77 PRDE1 03380O 47 'GROUP INSURANCE' PRDE1 03390O LHI KB 70 PRDE1 03400O* PRDE1 03410ORPT T 1 LRN78 PRDE1 03420O 43 'PAY ADVANCE' PRDE1 03430O LPA KB 70 PRDE1 0003440O* PRDE1 03450ORPT T 1 LRN79 PRDE1 03460O 41 'EQUIPMENT' PRDE1 03470O LEQ KB 70 PRDE1 03480O* PRDE1 03490ORPT T 1 LRN81 PRDE1 03500O 46 'STOCK PURCHASE' PRDE1 0003510O LSP KB 70 PRDE1 03520O* PRDE1 03530ORPT T 1 LRN83 PRDE1 03540O 39 'PENSION' PRDE1 03550O LPEN KB 70 PRDE1 03560O* PRDE1 03570ORPT T 1 LRN80 PRDE1 0003580O 45 'MISCELLANEOUS' PRDE1 03590O LMISC KB 70 PRDE1 03600O* PRDE1 03610ORPT T 01 LR PRDE1 03620O LTOT KB 90 PRDE1 ** 003630ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00364000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003650ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003660ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003670/* 003680__0O LTOT KB 90 PRDE1 ** 003630ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0036400(,a }TXPRDL6 P999999111111(000010H S PRDL6 00020X DECK-ID B23 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRDL6 00030F* ADDS DAILY LABOR (CDS FILE) TO WKLYPR FILE PRDL6 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRDL6 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRDL6 00060F* CONTROL DATA PROPRIETARY PRODUCT PRDL6 00070F* PRDL6 0000080F* PRDL6 00090F* *************************************************************** PRDL6 00100F* * ************************************************* * PRDL6 00110F* * * * * PRDL6 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRDL6 00130F* * * * * PRDL6 00140F* * ************************************************* * PRDL6 0000150F* *************************************************************** PRDL6 00160F* PRDL6 00170F* ---- DAILY LABOR. ---- PRDL6 00180F* PRDL6 00190F* PRDL6 00200FCDS IP AF 132 132 DISK PRDL6 00210FPRMAST IC F 600R10AI 2 DISK PRDL6 0000220FWKLYPR O F 128 128 DISK A PRDL6 00230E TABP 4 4 2 TABH 4 1 PRDL6 00240I* PRDL6 00250I* DATE CARD. PRDL6 00260I* ---------- PRDL6 00270ICDS NS 03 1 C# PRDL6 00280I 11 18 WEDATE PRDL6 0000290I 20 21 WKNO PRDL6 00300I 1 128 RCD PRDL6 00310I* PRDL6 00320I* DAILY LABOR. PRDL6 00330I* ------------ PRDL6 00340ICDS NS 01 1 CP 2 CL PRDL6 00350I 38 45 JOB PRDL6 0000360I 9 12 EMPL L1 PRDL6 00370I 5 8 DEPT L2 PRDL6 00380I 4 4 DIV L3 PRDL6 00390I 3 3 CORP L4 PRDL6 00400I 13 15 FTHREE PRDL6 00410I 16 16 THOURS PRDL6 00420I 17 201HRS PRDL6 0000430I 21 231OTHRS PRDL6 00440I 24 261DTHRS PRDL6 00450I 27 31 TSTRTE PRDL6 00460I 27 313RATE 11 PRDL6 00470I 32 370DATE PRDL6 00480I 46 520QTY PRDL6 00490I 53 56 DWRK 12 PRDL6 0000500I 57 57 SHFT 13 PRDL6 00510I 32 35 MODAY PRDL6 00520I 36 37 YEAR PRDL6 00530I 3 12 KEY PRDL6 00540I 1 128 RCD PRDL6 00550I* PRDL6 00560I* PREPAIDS ETC. PRDL6 0000570I* ------------- PRDL6 00580I NS 02 1 CP PRDL6 00590I 1 128 RCD PRDL6 00600I* PRDL6 00610I* UNUSED. PRDL6 00620I* ------- PRDL6 00630I NS 04 PRDL6 0000640I 1 128 RCD PRDL6 00650I* PRDL6 00660I* EMPLOYEE MASTER. PRDL6 00670I* ---------------- PRDL6 00680IPRMAST NS 10 PRDL6 00690I 014 016 THREE PRDL6 00700I 012 013 INIT PRDL6 0000710I 014 033 NAME PRDL6 00720I 110 1143HRATE PRDL6 00730I 382 3863PRATE PRDL6 00740I 146 149 RMODAY PRDL6 00750I 133 133 SHIFT PRDL6 00760I 115 1202SPAY PRDL6 00770I 132 132 TYPE PRDL6 0000780I 387 3922PPAY PRDL6 00790I 157 158 PPER PRDL6 00800I 150 151 RYEAR PRDL6 00810C* PRDL6 00820C* RETRIEVE EMPLOYEE MASTER. PRDL6 00830C* ------------------------- PRDL6 00840C L1 MOVEL' ' KEY PRDL6 0000850C L1 KEY CHAINPRMAST 21 PRDL6 00860C L1 SETOF 22 PRDL6 00870C L1 10 SETON 22 PRDL6 00880C* PRDL6 00890C L3 MOVE DIV WRK2 2 PRDL6 00900C L3 MOVELCORP WRK2 PRDL6 00910C L3 Z-ADD0 PREM1 43 PRDL6 0000920C L3 Z-ADD0 PREM2 43 PRDL6 00930C* PRDL6 00940C* ROUTINE FOR EARNINGS. PRDL6 00950C* --------------------- PRDL6 00960C N01 GOTO BY01 PRDL6 00970C* ********** PRDL6 00980C* PRDL6 0000990C FTHREE COMP THREE 25 PRDL6 01000C* PRDL6 01010C MOVE MODAY WRK6 6 PRDL6 01020C MOVELYEAR WRK6 PRDL6 01030C MOVE RMODAY RDATE 6 PRDL6 01040C MOVELRYEAR RDATE PRDL6 01050C RDATE COMP WRK6 26 PRDL6 0001060C* PRDL6 01070C 13 MOVE SHIFT SHFT PRDL6 01080C SHFT COMP '1' 27 PRDL6 01090C N27 SHFT COMP ' ' 27 PRDL6 01100C SHFT COMP '2' 28 PRDL6 01110C SHFT COMP '3' 29 PRDL6 01120C N27N28N29 SETON 27 PRDL6 0001130C* PRDL6 01140C THOURS COMP 'R' 30 PRDL6 01150C THOURS COMP 'S' 31 PRDL6 01160C THOURS COMP 'H' 32 PRDL6 01170C THOURS COMP 'V' 33 PRDL6 01180C* PRDL6 01190C SETOF 24 PRDL6 0001200C 11 TYPE COMP '2' 24 PRDL6 01210C N24 GOTO SKIP PRDL6 01220C* ********** PRDL6 01230C 26 Z-ADDPPAY PAY PRDL6 01240C N26 Z-ADDSPAY PAY PRDL6 01250C PPER LOKUPTABP TABH 23 PRDL6 01260C 23 Z-ADDTABH HRS PRDL6 0001270C GOTO END PRDL6 01280C* ********** PRDL6 01290C SKIP TAG PRDL6 01300C* ********** PRDL6 01310C 26 11 Z-ADDPRATE RATE PRDL6 01320C N26 11 Z-ADDHRATE RATE PRDL6 01330C 27 RATE ADD PREM1 PRRATE 53 PRDL6 0001340C 28 RATE ADD PREM2 PRRATE PRDL6 01350C 29 RATE ADD PREM3 PRRATE PRDL6 01360C* PRDL6 01370C PRRATE MULT 1.5 HTRATE 64 PRDL6 01380C PRRATE MULT 2.0 DTRATE 64 PRDL6 01390C* PRDL6 01400C 32 PRDL6 0001410COR 30 HRS MULT PRRATE PAY 62H PRDL6 01420C N30N32 HRS MULT RATE PAY 62H PRDL6 01430C OTHRS MULT HTRATE OTPAY 52H PRDL6 01440C DTHRS MULT DTRATE DTPAY 52H PRDL6 01450C* PRDL6 01460C END TAG PRDL6 01470C* ********** PRDL6 0001480C L1HRS ADD HRS L1HRS 61 PRDL6 01490C L2HRS ADD HRS L2HRS 61 PRDL6 01500C L3HRS ADD HRS L3HRS 61 PRDL6 01510C L4HRS ADD HRS L4HRS 61 PRDL6 01520C L5HRS ADD HRS L5HRS 61 PRDL6 01530C L1OTH ADD OTHRS L1OTH 61 PRDL6 01540C L2OTH ADD OTHRS L2OTH 61 PRDL6 0001550C L3OTH ADD OTHRS L3OTH 61 PRDL6 01560C L4OTH ADD OTHRS L4OTH 61 PRDL6 01570C L5OTH ADD OTHRS L5OTH 61 PRDL6 01580C L1DTH ADD DTHRS L1DTH 61 PRDL6 01590C L2DTH ADD DTHRS L2DTH 61 PRDL6 01600C L3DTH ADD DTHRS L3DTH 61 PRDL6 01610C L4DTH ADD DTHRS L4DTH 61 PRDL6 0001620C L5DTH ADD DTHRS L5DTH 61 PRDL6 01630C L1PAY ADD PAY L1PAY 92 PRDL6 01640C L2PAY ADD PAY L2PAY 92 PRDL6 01650C L3PAY ADD PAY L3PAY 92 PRDL6 01660C L4PAY ADD PAY L4PAY 92 PRDL6 01670C L5PAY ADD PAY L5PAY 92 PRDL6 01680C L1OTP ADD OTPAY L1OTP 82 PRDL6 0001690C L2OTP ADD OTPAY L2OTP 82 PRDL6 01700C L3OTP ADD OTPAY L3OTP 82 PRDL6 01710C L4OTP ADD OTPAY L4OTP 82 PRDL6 01720C L5OTP ADD OTPAY L5OTP 82 PRDL6 01730C L1DTP ADD DTPAY L1DTP 82 PRDL6 01740C L2DTP ADD DTPAY L2DTP 82 PRDL6 01750C L3DTP ADD DTPAY L3DTP 82 PRDL6 0001760C L4DTP ADD DTPAY L4DTP 82 PRDL6 01770C L5DTP ADD DTPAY L5DTP 82 PRDL6 01780C* PRDL6 01790C 12 MOVE DEPT DWRK PRDL6 01800C L1QTY ADD QTY L1QTY 100 PRDL6 01810C L2QTY ADD QTY L2QTY 100 PRDL6 01820C L3QTY ADD QTY L3QTY 100 PRDL6 0001830C L4QTY ADD QTY L4QTY 100 PRDL6 01840C L5QTY ADD QTY L5QTY 100 PRDL6 01850C* PRDL6 01860C BY01 TAG PRDL6 01870C* ********** PRDL6 01880O* PRDL6 01890O* ADD RECORDS TO WEEKLY P/R FILE. PRDL6 0001900O* ------------------------------- PRDL6 01910OWKLYPR DADD 01 PRDL6 01920O JOB 121 PRDL6 01930O DWRK 125 PRDL6 01940O DTPAY B 97 PRDL6 01950O DTHRS 92 PRDL6 01960O OTPAY B 58 PRDL6 0001970O 33 PAY 53 PRDL6 01980O 32 PAY 47 PRDL6 01990O 31 PAY 42 PRDL6 02000O 30 PAY 37 PRDL6 02010O OTHRS 31 PRDL6 02020O 33 HRS 28 PRDL6 02030O 32 HRS 24 PRDL6 0002040O 31 HRS 21 PRDL6 02050O 30 HRS 18 PRDL6 02060O WKNO 14 PRDL6 02070O EMPL 12 PRDL6 02080O DEPT 8 PRDL6 02090O DIV 4 PRDL6 02100O CORP 3 PRDL6 0002110O 2 'L5' PRDL6 02120O* PRDL6 02130O* ADDING PREPAIDS ETC. PRDL6 02140O* -------------------- PRDL6 02150OWKLYPR DADD 02 PRDL6 02160O OR 03 PRDL6 02170O RCD 128 PRDL6 00** 002180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002190ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002210ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002220** 002230121730240880260800520400 00224000/* 002250__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002190ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002210ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002220** 002230121730240880260800520400 0022400(,a }TXPREDT P999999111111(000010H S PREDT 00020X DECK-ID B24 MFG/DIST/ACCT SYSTEM SUMMARY-123 PREDT 00030F* READS AND EDITS PAYIPT AND CREATES TRANS FILE PREDT 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PREDT 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PREDT 00060F* CONTROL DATA PROPRIETARY PRODUCT PREDT 00070F* PREDT 0000080F* PREDT 00090F* *************************************************************** PREDT 00100F* * ************************************************* * PREDT 00110F* * * * * PREDT 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PREDT 00130F* * * * * PREDT 00140F* * ************************************************* * PREDT 0000150F* *************************************************************** PREDT 00160F* PREDT 00170F* CARD TO DISK EDIT OF P/R TRANSACTIONS PREDT 00180F* PREDT 00190FNULL IPEAF 72 DISK PREDT 00200FPRINPT UC F 128R DISK PREDT 00210FPRMAST IC F 600R10AI 2 DISK 100 PREDT 0000220FTRANS O F 132 132 DISK PREDT 00230F$SYSLISTO F 132 OF PRINTER PREDT 00240E RCODE 15 15 2 PREDT 00250INULL NS 98 PREDT 00260I 1 1 A PREDT 00270IPRINPT NS 01 1 C# PREDT 00280I 1 110 REC PREDT 0000290I NC 02 1 CD 2 CC PREDT 00300I 1 110 REC PREDT 00310I 3 12 KEY PREDT 00320I 13 22 NEWKEY PREDT 00330I NS 03 1 CP 2 CL PREDT 00340I 1 110 REC PREDT 00350I 3 12 KEY PREDT 0000360I 13 15 FSTTRE PREDT 00370I 16 16 TYPE 13 PREDT 00380I 17 201REGHRS PREDT 00390I 21 231OTHRS PREDT 00400I 24 261DTHRS PREDT 00410I NS 04 1 CP 2NCL PREDT 00420I 1 110 REC PREDT 0000430I 1 2 RC PREDT 00440I 3 12 KEY PREDT 00450I 14 19 VFWH PREDT 00460I 20 25 VSWH PREDT 00470I 38 42 PPAY PREDT 00480I 43 43 PTYPE PREDT 00490I 44 50 PIECES PREDT 0000500I 79 82 CITYWH 14 PREDT 00510I 83 88 CHECK PREDT 00520I 90 921DTHRS PREDT 00530I NS 09 1 CH 2 CD PREDT 00540I 3 60NTRANS PREDT 00550I 7 121TOTREG PREDT 00560I 13 181TOTOT PREDT 0000570I 19 19 X 11 PREDT 00580I 1 110 REC PREDT 00590I NS 10 1 CE 2 CB PREDT 00600I 3 60HDSEQ PREDT 00610I NS 06 PREDT 00620I 1 110 REC PREDT 00630I 1 2 RC PREDT 0000640IPRMAST NS 07 PREDT 00650I 014 016 FTHREE PREDT 00660CLR SETON 99 PREDT 00670CLR START TAG PREDT 00680C* ********** PREDT 00690CLR SETOF 212223 PREDT 00700CLR SETOF 242526 PREDT 0000710CLR SETOF 2708 PREDT 00720CLR SETON 36 PREDT 00730CLR SEQ ADD 1 SEQ 40 PREDT 00740CLR SEQ CHAINPRINPT 50 PREDT 00750CLR 06 RC COMP '<>' 50 PREDT 00760CLR 50 GOTO LAST PREDT 00770C* ********** PREDT 0000780CLR 01 GOTO END PREDT 00790C* ********** PREDT 00800CLR 09N11 SETON 37 PREDT 00810CLR 10 SETOF 38 PREDT 00820CLR 10 37 NTRANS COMP 0 38 PREDT 00830CLR 10 37 38TOTREG COMP 0 38 PREDT 00840CLR 10 37 38TOTOT COMP 0 38 PREDT 0000850CLR 10 37 38HDSEQ CHAINPRINPT 50 PREDT 00860CLR 10 37 38 SETON 98 PREDT 00870CLR 10 37 38 EXCPT PREDT 00880CLR 10 37 38 SETOF 0998 PREDT 00890CLR 10 37 38SEQ CHAINPRINPT 50 PREDT 00900CLR 10 SETOF 37 PREDT 00910CLR 04 PREDT 0000920COR 06 RC LOKUPRCODE 36 PREDT 00930CLRN36 SETON 08 PREDT 00940CLR 06 PREDT 00950COR 08 GOTO END PREDT 00960C* ********** PREDT 00970CLR MOVEL' ' KEY PREDT 00980CLR KEY CHAINPRMAST 20 PREDT 0000990CLRN20 SETON 21 KEY ON FILE PREDT 01000CLRN02 GOTO SKIP PREDT 01010C* ********** PREDT 01020CLR MOVEL' ' NEWKEY PREDT 01030CLR NEWKEY CHAINPRMAST 20 PREDT 01040CLR 20 SETON 22 KEY NOT ON FILEPREDT 01050CLR SKIP TAG PREDT 0001060C* ********** PREDT 01070CLRN03 GOTO NEXT PREDT 01080C* ********** PREDT 01090CLR 37 NTRANS SUB 1 NTRANS PREDT 01100CLR 37 TOTREG SUB REGHRS TOTREG PREDT 01110CLR 37 TOTOT SUB OTHRS TOTOT PREDT 01120CLR 37 TOTOT SUB DTHRS TOTOT PREDT 0001130CLR 13 SETON 27 PREDT 01140CLR SETON 23 PREDT 01150CLR NEXT TAG PREDT 01160C* ********** PREDT 01170CLRN04 GOTO END PREDT 01180C* ********** PREDT 01190CLR RC COMP 'PP' 25 PREDT 0001200CLRN25 RC COMP 'P7' 25 PREDT 01210CLR 25 GOTO END PREDT 01220C* ********** PREDT 01230CLR RC COMP 'PN' 26 PREDT 01240CLRN26 RC COMP 'P5' 26 PREDT 01250CLR END TAG PREDT 01260C* ********** PREDT 0001270CLR EXCPT PREDT 01280CLR SETOF 010203 PREDT 01290CLR SETOF 040609 PREDT 01300CLR SETOF 1099 PREDT 01310CLR GOTO START PREDT 01320C* ********** PREDT 01330CLR LAST TAG PREDT 0001340C* ********** PREDT 01350O$SYSLISTE 303 99 PREDT 01360O 26 'PREDIT EDIT PAYROLL' PREDT 01370O 39 'TRANSACTIONS' PREDT 01380O UDATE Y 51 PREDT 01390O E 2 99 PREDT 01400O 4 'SEQ#' PREDT 0001410O 33 'RECORD CONTENTS...' PREDT 01420O 122 'ERROR' PREDT 01430O E 1 02N21 PREDT 01440O OR 02N22 PREDT 01450O OR 03N21 PREDT 01460O OR 03 21N23 PREDT 01470O OR 03 27 PREDT 0001480O OR 04N21 36 PREDT 01490O OR 08 PREDT 01500O OR 37 PREDT 01510O OR 10 38N98 PREDT 01520O SEQ Z 4 PREDT 01530O REC 115 PREDT 01540O 02N21 132 'BAD OLD' PREDT 0001550O 02N22 132 'BAD NEW' PREDT 01560O 03N23 132 'BAD NAME' PREDT 01570O N21N02N06 132 'NOT ON FILE' PREDT 01580O 03 27 132 'TYPE HOURS BLANK' PREDT 01590O 08 132 'INVALID RECORD ID' PREDT 01600O 09 132 'BATCH NOT BALANCED' PREDT 01610O 37 OF 132 'BATCH NOT BALANCED' PREDT 0001620O 10 38 132 '**NOW BALANCES**' PREDT 01630O T 2 LR PREDT 01640O 21 'PREDIT- END OF JOB.' PREDT 01650OTRANS E 01 PREDT 01660O OR 02 21 22 PREDT 01670O OR 03 21 23 PREDT 01680O AND N27 PREDT 0001690O OR 04 21N25 PREDT 01700O AND N26 PREDT 01710O REC 110 PREDT 01720O E 04 21 25 PREDT 01730O REC 110 PREDT 01740O E 04 21 26 PREDT 01750O REC 110 PREDT 0001760O N14 79 ' ' PREDT 01770O CITYWH 83 PREDT 01780O CHECK 89 PREDT 01790OPRINPT E 98 PREDT 01800O 19 ' ' PREDT ** 001810ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00182000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001850** 001860<>P5P5P5P5P5P5P5P5PNPPP8P6POP7 001870/* 001880__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0018200(db !*TXPRED0 P999999111111(000010H S PRED0 00020X DECK-ID B25 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRED0 00030F* PURGE PAYIPT - WRITE <> IN ALL RECORDS PRED0 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRED0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRED0 00060F* CONTROL DATA PROPRIETARY PRODUCT PRED0 00070F* PRED0 0000080F* PRED0 00090F* *************************************************************** PRED0 00100F* * ************************************************* * PRED0 00110F* * * * * PRED0 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRED0 00130F* * * * * PRED0 00140F* * ************************************************* * PRED0 0000150F* *************************************************************** PRED0 00160F* PRED0 00170F* THIS PROGRAM UPDATES THE FIRST TWO BYTES OF EVERY RECORD OF PRED0 00180F* 'KPFILE' WITH THE CHARACTERS, '<>'. PRED0 00190FPRINPT UP AF 128 DISK PRED0 00200IPRINPT NS 01 PRED0 00210I 1 2 RC PRED0 0000220C SETOF 21 PRED0 00230C RC COMP '<>' 21 PRED0 00240CLR MOVE ' ' B126 126 PRED0 00250OPRINPT D 01N21 PRED0 00260O 2 '<>' PRED0 00270O B126 128 PRED0 ** 00028000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000320/* 000330__0O B126 128 PRED0 ** 0002800(b5 TXPRFM1 P999999111111(000010H S PRFM1 00020X DECK-ID B26 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRFM1 00030F* INQUIRY/MAINTENANCE - PAYROLL MASTER FILE (PRMAST) PRFM1 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRFM1 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRFM1 00060F* CONTROL DATA PROPRIETARY PRODUCT PRFM1 00070F* PRFM1 0000080F* PRFM1 00090F* *************************************************************** PRFM1 00100F* * ******************************************************** PRFM1 00110F* * * * * PRFM1 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRFM1 00130F* * * * * PRFM1 00140F* * ******************************************************** PRFM1 0000150F* *************************************************************** PRFM1 00160F* MODIFIED 07/12/76 TO CORRECT PROBLEM IN PRINT PRFM1 00170F* PRFM1 00180FNULL IPEAF 72 DISK PRFM1 00190FPARM01 IC F 32R DISK PRFM1 00200FSCRFIL UC F 80R DISK U1 PRFM1 00210F$LP1 O F 132 OF PRINTER U1 PRFM1 0000220FPRMAST UC F 0600R10AI 0002 DISK A PRFM1 00230E FN 055 22 FIELD NAME PRFM1 00240E CP 055 4 CURSOR POSITION PRFM1 00250E LN 055 2 0 LENGTH PRFM1 00260E EP 055 4 0 ENDING POSITION PRFM1 00270INULL NS 01 PRFM1 00280I 1 1 A PRFM1 0000290IPARM01 NS 02 PRFM1 00300I 1 22 FIELDN PRFM1 00310I 23 26 CURPOS PRFM1 00320I 27 280LNGTH PRFM1 00330I 29 310ENDPOS PRFM1 00340ISCRFIL NS 03 PRFM1 00350I 1 80 LINE PRFM1 0000360IPRMAST NS 04 PRFM1 00370I 110 1140OLDHRT PRFM1 00380I 115 1200OLDSAL PRFM1 00390I 10256 RECORD PRFM1 00400I 2570512 LEFT01 PRFM1 00410I 5130600 LEFT02 PRFM1 00420I 1 256 OLDREC U2 PRFM1 0000430I 257 512 NEXT01 U2 PRFM1 00440I 513 600 NEXT02 U2 PRFM1 00450C MOVE ' ' RCODE 1 PRFM1 00460C MOVE RCODE B22 22 PRFM1 00470C MOVE RCODE BLANKS 72 PRFM1 00480C MOVE RCODE FILLER 1 PRFM1 00490C Z-ADD0 MASK 10 PRFM1 0000500C SETON LR PRFM1 00510CLR U2NU1 SETON H1 PRFM1 00520CLR U2NU1 GOTO EOJ PRFM1 00530C* ********** PRFM1 00540CLR Z-ADD055 SSIZE 30 PRFM1 00550CLR Z-ADD004 NSECT 30 PRFM1 00560CLR BITON'01234567'FF 1 PRFM1 0000570CLR MOVE '[]<>' TEMP4 4 PRFM1 00580CLR Z-ADDUDATE DDATE 70 PRFM1 00590CLR START TAG PRFM1 00600C* ********** PRFM1 00610CLR EXSR FIRSTP PRFM1 00620C* ********** PRFM1 00630CLR 40 GOTO EOJ PRFM1 0000640C* ********** PRFM1 00650CLR Z-ADD2 VL PRFM1 00660CLR MOVELSECTON VAR PRFM1 00670CLR EXSR RTADJ PRFM1 00680C* ********** PRFM1 00690CLR MOVELVAR SECTN 20 PRFM1 00700CLR EXSR GETSEC PRFM1 0000710C* ********** PRFM1 00720CLRN45 GOTO START PRFM1 00730C* ********** PRFM1 00740CLR EXSR OUTPUT PRFM1 00750C* ********** PRFM1 00760CLR EXSR UPDATE PRFM1 00770C* ********** PRFM1 0000780CLR GOTO START PRFM1 00790C* ********** PRFM1 00800CLR EOJ TAG PRFM1 00810C* ********** PRFM1 00820CLR EXSR CLRSCR PRFM1 00830C* ********** PRFM1 00840C********************************************************************PRFM1 0000850C* PRFM1 00860C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND PRFM1 00870C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. PRFM1 00880C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDPRFM1 00890C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN PRFM1 00900C* PRFM1 00910C********************************************************************PRFM1 0000920CSR FIRSTP BEGSR PRFM1 00930C* ********** PRFM1 00940CSR EXSR CLRSCR PRFM1 00950C* ********** PRFM1 00960CSR Z-ADD0 SECTN PRFM1 00970CSR EXSR GETSEC PRFM1 00980C* ********** PRFM1 0000990CSR PGE TAG PRFM1 01000C* ********** PRFM1 01010CSR SETON 61 PRFM1 01020CSR SETOF 62 PRFM1 01030CSR EXSR OUTPUT PRFM1 01040C* ********** PRFM1 01050C* ********** PRFM1 0001060CSR EXIT SUBRFL PRFM1 01070CSR RLABL RECORD PRFM1 01080CSR RLABL FILLER 1 PRFM1 01090C* ********** PRFM1 01100CSR EXIT SUBRFL PRFM1 01110CSR RLABL LEFT01 PRFM1 01120CSR RLABL FILLER 1 PRFM1 0001130C* ********** PRFM1 01140CSR EXIT SUBRFL PRFM1 01150CSR RLABL LEFT02 PRFM1 01160CSR RLABL FILLER 1 PRFM1 01170C* ********** PRFM1 01180CSRNU2 GOTO BBB PRFM1 01190CSR EXIT SUBRFL PRFM1 0001200CSR RLABL OLDREC PRFM1 01210CSR RLABL FILLER 1 PRFM1 01220C* ********** PRFM1 01230CSR EXIT SUBRFL PRFM1 01240CSR RLABL NEXT01 PRFM1 01250CSR RLABL FILLER 1 PRFM1 01260C* ********** PRFM1 0001270CSR EXIT SUBRFL PRFM1 01280CSR RLABL NEXT02 PRFM1 01290CSR RLABL FILLER 1 PRFM1 01300CSR BBB TAG PRFM1 01310CSR Z-ADD10 NCHARS PRFM1 01320CSR Z-ADD1 SSTRT PRFM1 01330CSR Z-ADD2 TSTRT PRFM1 0001340C* ********** PRFM1 01350CSR EXIT SUBRLM PRFM1 01360CSR RLABL KEY 10 PRFM1 01370CSR RLABL SSTRT 30 PRFM1 01380CSR RLABL RECORD PRFM1 01390CSR RLABL TSTRT 30 PRFM1 01400CSR RLABL NCHARS 30 PRFM1 0001410CSR Z-ADDNOFLDS SVFLDS 30 PRFM1 01420CSR Z-ADDSX NOFLDS PRFM1 01430CSR EXSR UPDATE PRFM1 01440C* ********** PRFM1 01450CSR Z-ADDSVFLDS NOFLDS PRFM1 01460CSR Z-ADD10 NCHARS PRFM1 01470CSR Z-ADD2 SSTRT PRFM1 0001480CSR Z-ADD1 TSTRT PRFM1 01490C* ********** PRFM1 01500CSR EXIT SUBRLM PRFM1 01510CSR RLABL RECORD PRFM1 01520CSR RLABL SSTRT 30 PRFM1 01530CSR RLABL KEY PRFM1 01540CSR RLABL TSTRT 30 PRFM1 0001550CSR RLABL NCHARS 30 PRFM1 01560CSR KEY CHAINPRMAST 55 PRFM1 01570CSR MOVELSAVPOS BUFFER PRFM1 01580CSR MOVELOFC BUFFER PRFM1 01590CSR EXSR POSCUR PRFM1 01600C* ********** PRFM1 01610CSR MOVEL'] NEW R'WORD16 16 PRFM1 0001620CSR MOVE 'ECORD 'WORD16 PRFM1 01630CSRN55 MOVELBLANKS WORD16 PRFM1 01640CSRN55 MOVEL']' WORD16 PRFM1 01650CSR MOVELWORD16 BUFFER 72 PRFM1 01660CSR MOVE 'S' TYPE 1 PRFM1 01670CSR Z-ADD13 BLNGTH 20 PRFM1 01680CSR EXSR CRTCOM PRFM1 0001690C* ********** PRFM1 01700CSR SETON 62 PRFM1 01710CSR Z-ADDSX X 30 PRFM1 01720CSR EXSR ACCEPT PRFM1 01730C* ********** PRFM1 01740CSR MOVELBUFFER SECTON 2 PRFM1 01750CSR SECTON COMP 'E ' 40 PRFM1 0001760CSR 40 GOTO ENDFP PRFM1 01770C* ********** PRFM1 01780CSR SECTON COMP 'D ' 40 PRFM1 01790CSR 40N55 EXCPT PRFM1 01800CSR 40 GOTO PGE PRFM1 01810C* ********** PRFM1 01820CSR SECTON COMP ' 1' 30 30 PRFM1 0001830CSR 30 SECTON COMP ' 9' 3030 PRFM1 01840CSR 30 GOTO GOOD PRFM1 01850C* ********** PRFM1 01860CSR SECTON COMP '01' 30 30 PRFM1 01870CSR 30 SECTON COMP '09' 3030 PRFM1 01880CSR 30 GOTO GOOD PRFM1 01890C* ********** PRFM1 0001900CSR SECTON COMP '1 ' 30 30 PRFM1 01910CSR 30 SECTON COMP '9 ' 3030 PRFM1 01920CSR 30 GOTO GOOD PRFM1 01930C* ********** PRFM1 01940CSR MOVELSECTON TEMP1 1 PRFM1 01950CSR TEMP1 COMP '1' 30 30 PRFM1 01960CSR 30 TEMP1 COMP '9' 3030 PRFM1 0001970CSRN30 GOTO PGE PRFM1 01980C* ********** PRFM1 01990CSR MOVE SECTON TEMP1 PRFM1 02000CSR TEMP1 COMP '0' 30 30 PRFM1 02010CSR 30 TEMP1 COMP '9' 3030 PRFM1 02020CSRN30 GOTO PGE PRFM1 02030C* ********** PRFM1 0002040CSR GOOD TAG PRFM1 02050C* ********** PRFM1 02060CSR SETOF 62 PRFM1 02070CSR SETON 63 PRFM1 02080CSR MOVEL'] ' BUFFER PRFM1 02090CSR Z-ADD2 BLNGTH PRFM1 02100CSR MOVE 'S' TYPE PRFM1 0002110CSR EXSR CRTCOM PRFM1 02120C* ********** PRFM1 02130CSR Z-ADDPX X PRFM1 02140CSR U1 EXSR ACCEPT PRFM1 02150C* ********** PRFM1 02160CSR MOVELBUFFER PRNTOP 1 PRFM1 02170CSR U1 PRNTOP COMP 'P' 70 PRFM1 0002180CSR SETOF 6163 PRFM1 02190CSRN55 GOTO ENDFP PRFM1 02200C* ********** PRFM1 02210CSR SETON 80 PRFM1 02220CSR EXCPT PRFM1 02230CSR SETOF 80 PRFM1 02240CSR KEY CHAINPRMAST 55 PRFM1 0002250CSR ENDFP ENDSR PRFM1 02260C* ********** PRFM1 02270C********************************************************************PRFM1 02280C* PRFM1 02290C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. PRFM1 02300C* PRFM1 02310C********************************************************************PRFM1 0002320CSR GETSEC BEGSR PRFM1 02330C* ********** PRFM1 02340CSR 1 ADD SECTN N 20 PRFM1 02350CSR SETOF 404145 PRFM1 02360CSR N COMP 0 3030 PRFM1 02370CSRN30 N COMP NSECT 30 PRFM1 02380CSR 30 GOTO ENDGET PRFM1 0002390C* ********** PRFM1 02400CSR SECTN MULT SSIZE RRN 40 PRFM1 02410CSR Z-ADD1 X PRFM1 02420CSR SCLOOP TAG PRFM1 02430C* ********** PRFM1 02440CSR RRN ADD 1 RRN PRFM1 02450CSR RRN CHAINPARM01 50 PRFM1 0002460CSR 50 GOTO ENDGET PRFM1 02470C* ********** PRFM1 02480CSR FIELDN COMP B22 4141 PRFM1 02490CSRN41 GOTO ENDGET PRFM1 02500C* ********** PRFM1 02510CSR 41N45 SETON 45 PRFM1 02520CSR MOVE FIELDN FN,X PRFM1 0002530CSR MOVE CURPOS CP,X PRFM1 02540CSR MOVE LNGTH LN,X PRFM1 02550CSR Z-ADDENDPOS EP,X PRFM1 02560CSR 1 ADD X X PRFM1 02570CSR X COMP SSIZE 32 PRFM1 02580CSRN32 GOTO SCLOOP PRFM1 02590C* ********** PRFM1 0002600CSR ENDGET TAG PRFM1 02610C* ********** PRFM1 02620CSR Z-ADDX NOFLDS 30 PRFM1 02630CSR 45 GOTO FINGET PRFM1 02640C* ********** PRFM1 02650CSR EXSR CLRSCR PRFM1 02660C* ********** PRFM1 0002670CSR MOVEL'SECT # 'WORD9 9 PRFM1 02680CSR Z-ADD16 BLNGTH PRFM1 02690CSR MOVE SECTN WORD9 PRFM1 02700CSR MOVELWORD9 WORD16 PRFM1 02710CSRN30 MOVE ' ABSENT' WORD16 PRFM1 02720CSR 30 MOVE ' ILLEG.' WORD16 PRFM1 02730CSR MOVELWORD16 BUFFER PRFM1 0002740CSR MOVEL'S' TYPE PRFM1 02750CSR EXSR CRTCOM PRFM1 02760C* ********** PRFM1 02770CSR FINGET ENDSR PRFM1 02780C* ********** PRFM1 02790C********************************************************************PRFM1 02800C* PRFM1 0002810C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE PRFM1 02820C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE PRFM1 02830C* SECTION INDEX IS SAVED. PRFM1 02840C* PRFM1 02850C********************************************************************PRFM1 02860CSR OUTPUT BEGSR PRFM1 02870C* ********** PRFM1 0002880CSR EXSR CLRSCR PRFM1 02890C* ********** PRFM1 02900CSR Z-ADD1 X PRFM1 02910CSR 61 SETON 63 PRFM1 02920CSR OTLOOP TAG PRFM1 02930C* ********** PRFM1 02940CSR 61 LN,X COMP 0 31 PRFM1 0002950CSR 61 31 Z-ADDPX SX 20 SECT INDEX PRFM1 02960CSR 61 31 Z-ADDX PX 20 PRINT INDEX PRFM1 02970CSR EXSR OUTFLD PRFM1 02980C* ********** PRFM1 02990CSR X ADD 1 X PRFM1 03000CSR X COMP NOFLDS 31 PRFM1 03010CSR 31 GOTO OTLOOP PRFM1 0003020C* ********** PRFM1 03030CSR SETOF 63 PRFM1 03040CSR ENDSR PRFM1 03050C********************************************************************PRFM1 03060C* PRFM1 03070C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND PRFM1 03080C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 PRFM1 0003090C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS PRFM1 03100C* THEN NO FIELD INFORMATION IS PRINTED PRFM1 03110C* PRFM1 03120C********************************************************************PRFM1 03130CSR OUTFLD BEGSR PRFM1 03140C* ********** PRFM1 03150CSR MOVE FN,X FL 20 PRFM1 0003160CSR EP,X COMP 0 98 PRFM1 03170CSR MOVELCP,X FC 20 PRFM1 03180CSR FC COMP FL 31 PRFM1 03190CSR 31 Z-ADDFC FL PRFM1 03200CSR FC SUB FL CC 20 PRFM1 03210CSR CC ADD 1 CC PRFM1 03220CSR MOVELCP,X BUFFER PRFM1 0003230CSR MOVELCC BUFFER PRFM1 03240CSR EXSR POSCUR PRFM1 03250C* ********** PRFM1 03260CSR MOVELBLANKS BUFFER PRFM1 03270CSR MOVELFN,X FIELDN PRFM1 03280CSR MOVE ' ' FIELDN PRFM1 03290CSR MOVELFIELDN BUFFER PRFM1 0003300CSR Z-ADDLN,X LEN 20 PRFM1 03310CSR LEN COMP 0 9730 PRFM1 03320CSR 97 Z-SUBLN,X LEN PRFM1 03330CSR 30 GOTO SKIPF PRFM1 03340C* ********** PRFM1 03350CSR FL ADD 2 BPOS 20 PRFM1 03360C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS PRFM1 0003370CSR Z-ADDBPOS TSTRT 30 PRFM1 03380CSRN98 Z-ADD1 SSTRT 30 PRFM1 03390CSR 98 Z-ADD3 SSTRT PRFM1 03400CSR Z-ADD1 NCHARS 30 PRFM1 03410C* ********** PRFM1 03420CSR EXIT SUBRLM PRFM1 03430CSR RLABL TEMP4 PRFM1 0003440CSR RLABL SSTRT 30 PRFM1 03450CSR RLABL BUFFER PRFM1 03460CSR RLABL TSTRT 30 PRFM1 03470CSR RLABL NCHARS 30 PRFM1 03480CSR BPOS ADD 1 FPOS 20 PRFM1 03490CSR EXSR MVRECD PRFM1 03500C* ********** PRFM1 0003510CSR SKIPF TAG PRFM1 03520C* ********** PRFM1 03530CSR 30 Z-ADDFL BLNGTH PRFM1 03540CSRN30 FL ADD 3 BLNGTH PRFM1 03550CSRN30 BLNGTH ADD LEN BLNGTH PRFM1 03560CSR MOVE 'S' TYPE PRFM1 03570CSR EXSR CRTCOM PRFM1 0003580C* ********** PRFM1 03590CSR ENDSR PRFM1 03600C********************************************************************PRFM1 03610C* PRFM1 03620C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN PRFM1 03630C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST PRFM1 03640C* THE RIGHT BRACKET. PRFM1 0003650C********************************************************************PRFM1 03660CSR MVRECD BEGSR PRFM1 03670C* ********** PRFM1 03680CSR 63 GOTO RBRK PRFM1 03690C* ********** PRFM1 03700CSR 98 Z-SUBEP,X END 40 PRFM1 03710CSRN98 Z-ADDEP,X END PRFM1 0003720CSR END SUB LEN STRT 40 81 81 PRFM1 03730CSR STRT ADD 1 STRT PRFM1 03740C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER PRFM1 03750C* FROM STRT IN RECORD TO FPOS IN BUFFER PRFM1 03760CSR Z-ADDLEN NCHARS PRFM1 03770CSR Z-ADDSTRT SSTRT PRFM1 03780CSR Z-ADDFPOS TSTRT PRFM1 0003790C* ********** PRFM1 03800CSRN81 GOTO RBRK PRFM1 03810CSR EXIT SUBRLM PRFM1 03820CSR RLABL RECORD PRFM1 03830CSR RLABL SSTRT 30 PRFM1 03840CSR RLABL BUFFER PRFM1 03850CSR RLABL TSTRT 30 PRFM1 0003860CSR RLABL NCHARS 30 PRFM1 03870CSR RBRK TAG PRFM1 03880C* ********** PRFM1 03890CSR EXSR RTBRKT PRFM1 03900C* ********** PRFM1 03910CSR ENDSR PRFM1 03920C********************************************************************PRFM1 0003930C* PRFM1 03940C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS PRFM1 03950C* PRFM1 03960C********************************************************************PRFM1 03970CSR RTBRKT BEGSR PRFM1 03980C* ********** PRFM1 03990CSR LEN ADD FPOS FPOS PRFM1 0004000CSR Z-ADDFPOS TSTRT PRFM1 04010CSR Z-ADD1 NCHARS PRFM1 04020CSRN98 Z-ADD2 SSTRT PRFM1 04030CSR 98 Z-ADD4 SSTRT PRFM1 04040C* ********** PRFM1 04050CSR EXIT SUBRLM PRFM1 04060CSR RLABL TEMP4 PRFM1 0004070CSR RLABL SSTRT 30 PRFM1 04080CSR RLABL BUFFER PRFM1 04090CSR RLABL TSTRT 30 PRFM1 04100CSR RLABL NCHARS 30 PRFM1 04110CSR ENDSR PRFM1 04120C********************************************************************PRFM1 04130C* PRFM1 0004140C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. PRFM1 04150C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO PRFM1 04160C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF PRFM1 04170C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST PRFM1 04180C* OF THE FIELDS ARE LEFT UNCHANGED PRFM1 04190C* PRFM1 04200C********************************************************************PRFM1 0004210CSR UPDATE BEGSR PRFM1 04220C* ********** PRFM1 04230CSR SETOF 32 PRFM1 04240CSR Z-ADD1 X PRFM1 04250CSR UPLOOP TAG PRFM1 04260C* ********** PRFM1 04270CSR EP,X COMP 0 98 PRFM1 0004280CSR 98 SETON 30 PRFM1 04290CSR 98 GOTO NOUPD PRFM1 04300C* ********** PRFM1 04310CSR Z-ADDLN,X LEN PRFM1 04320CSR LEN COMP 0 9730 PRFM1 04330CSR 97 Z-SUBLEN LEN PRFM1 04340CSR NOUPD TAG PRFM1 0004350C* ********** PRFM1 04360CSR 30N32 GOTO INCR PRFM1 04370C* ********** PRFM1 04380CSR 30 GOTO CHKRUB PRFM1 04390C* ********** PRFM1 04400CSR SETOF 3233 PRFM1 04410CSR EXSR ACCEPT PRFM1 0004420C* ********** PRFM1 04430CSR CHKRUB TAG PRFM1 04440C* ********** PRFM1 04450CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTPRFM1 04460CSR 32 31 GOTO UPLOOP PRFM1 04470C* ********** PRFM1 04480CSR 32 GOTO ENDUPD PRFM1 0004490C* ********** PRFM1 04500CSR MOVELBUFFER ATSIGN 1 PRFM1 04510CSR ATSIGN COMP '@' 35 PRFM1 04520CSR 35 GOTO OUTREC PRFM1 04530C* ********** PRFM1 04540CSR 33 GOTO INCR WAS LINE FEED PRFM1 04550C* ********** PRFM1 0004560CSR Z-ADDEP,X END PRFM1 04570CSR END SUB LEN STRT 81 81 PRFM1 04580CSR STRT ADD 1 STRT PRFM1 04590C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF PRFM1 04600C* BUFFER TO THE STRT OF RECORD PRFM1 04610CSR Z-ADD1 SSTRT PRFM1 04620CSR Z-ADDSTRT TSTRT PRFM1 0004630CSR Z-ADDLEN NCHARS PRFM1 04640C* ********** PRFM1 04650CSRN81 GOTO AAA PRFM1 04660CSR EXIT SUBRLM PRFM1 04670CSR RLABL BUFFER PRFM1 04680CSR RLABL SSTRT 30 PRFM1 04690CSR RLABL RECORD PRFM1 0004700CSR RLABL TSTRT 30 PRFM1 04710CSR RLABL NCHARS 30 PRFM1 04720CSR AAA TAG PRFM1 04730CSR MOVELBUFFER TEMP5 5 PRFM1 04740CSR MOVELSAVPOS BUFFER PRFM1 04750CSR EXSR POSCUR PRFM1 04760C* ********** PRFM1 0004770CSR MOVELTEMP5 BUFFER PRFM1 04780CSR Z-ADD1 FPOS PRFM1 04790CSR EXSR RTBRKT PRFM1 04800C* ********** PRFM1 04810CSR LEN ADD 1 BLNGTH PRFM1 04820CSR MOVE 'S' TYPE PRFM1 04830CSR EXSR CRTCOM PRFM1 0004840C* ********** PRFM1 04850CSR INCR TAG PRFM1 04860C* ********** PRFM1 04870CSR X ADD 1 X PRFM1 04880CSR X COMP NOFLDS 30 PRFM1 04890CSR 30 GOTO UPLOOP PRFM1 04900C* ********** PRFM1 0004910CSR OUTREC TAG PRFM1 04920C* ********** PRFM1 04930CSR SETON 80 PRFM1 04940CSRN61 EXSR CHKPAY SEE IF PAY CHNGPRFM1 04950C* ********** PRFM1 04960CSRN61 EXCPT PRFM1 04970CSR SETOF 7180 PRFM1 0004980CSR U2N61 EXSR CHKCHG PRFM1 04990C* ********** PRFM1 05000CSR 70 PRFM1 05010COR 71 EXSR PRNFIL PRFM1 05020C* ********** PRFM1 05030CSR SETOF 70 PRFM1 05040CSR ENDUPD TAG PRFM1 0005050C* ********** PRFM1 05060CSR ENDSR PRFM1 05070C********************************************************************PRFM1 05080C* *PRFM1 05090C* THIS ROUTINE COMPARES THE OUTPUT RECORD AGAINST THE INPUT *PRFM1 05100C* RECORD AND REPLACES THE OPENING BRACKET FOR EACH CHANGED *PRFM1 05110C* FIELD WITH AN ASTERISK *PRFM1 0005120C* *PRFM1 05130C********************************************************************PRFM1 05140C* PRFM1 05150CSR CHKCHG BEGSR PRFM1 05160C* ********** PRFM1 05170CSR Z-ADD1 X PRFM1 05180CSR Z-ADD1 TSTRT PRFM1 0005190CSR Z-ADD1 BLNGTH PRFM1 05200CSR SETOF 71 PRFM1 05210CSR CHLOOP TAG PRFM1 05220C* ********** PRFM1 05230CSR Z-ADDEP,X END 98 PRFM1 05240CSR 98 Z-SUBEND END PRFM1 05250CSR Z-ADDLN,X NCHARS 9730 PRFM1 0005260CSR 30 GOTO CHKINC PRFM1 05270C* ********** PRFM1 05280CSR 97 Z-SUBNCHARS NCHARS PRFM1 05290CSR END SUB NCHARS SSTRT PRFM1 05300CSR SSTRT ADD 1 SSTRT PRFM1 05310C* ********** PRFM1 05320CSR EXIT SUBRFL PRFM1 0005330CSR RLABL BUFFER PRFM1 05340CSR RLABL FILLER 1 PRFM1 05350C* ********** PRFM1 05360CSR EXIT SUBRLM PRFM1 05370CSR RLABL OLDREC PRFM1 05380CSR RLABL SSTRT 30 PRFM1 05390CSR RLABL BUFFER PRFM1 0005400CSR RLABL TSTRT 30 PRFM1 05410CSR RLABL NCHARS 30 PRFM1 05420C* ********** PRFM1 05430CSR EXIT SUBRFL PRFM1 05440CSR RLABL BUFF1 PRFM1 05450CSR RLABL FILLER 1 PRFM1 05460C* ********** PRFM1 0005470CSR EXIT SUBRLM PRFM1 05480CSR RLABL RECORD PRFM1 05490CSR RLABL SSTRT 30 PRFM1 05500CSR RLABL BUFF1 72 PRFM1 05510CSR RLABL TSTRT 30 PRFM1 05520CSR RLABL NCHARS 30 PRFM1 05530CSR BUFFER COMP BUFF1 30 PRFM1 0005540CSR 30 GOTO CHKINC PRFM1 05550C* PRFM1 05560C* FIELDS ARE DIFFERENT PRFM1 05570C* PRFM1 05580CSR SETON 71 CHANGE FLAG ON PRFM1 05590CSR MOVELCP,X POS 40 PRFM1 05600CSR POS ADD 200 POS +2 FOR BRACKET PRFM1 0005610CSR MOVELPOS BUFFER PRFM1 05620CSR EXSR POSCUR PRFM1 05630C* ********** PRFM1 05640CSR MOVEL'*' BUFFER PRFM1 05650CSR MOVE 'S' TYPE PRFM1 05660CSR EXSR CRTCOM PRFM1 05670C* ********** PRFM1 0005680CSRN98 GOTO CHKINC PRFM1 05690C* ********** PRFM1 05700C* PRFM1 05710C* CHANGED DISPLAY FIELD - REDISPLAY PRFM1 05720C* PRFM1 05730CSR MOVELBUFF1 BUFFER PRFM1 05740CSR Z-ADDNCHARS BLNGTH PRFM1 0005750CSR EXSR CRTCOM PRFM1 05760C* ********** PRFM1 05770CSR Z-ADD1 BLNGTH PRFM1 05780CSR CHKINC TAG PRFM1 05790C* ********** PRFM1 05800CSR X ADD 1 X PRFM1 05810CSR X COMP NOFLDS 30 PRFM1 0005820CSR 30 GOTO CHLOOP PRFM1 05830C* ********** PRFM1 05840CSR ENDSR PRFM1 05850C********************************************************************PRFM1 05860C* CUSTOM SUBROUTINE TO UPDATE PREVIOUS PAY FIELDS IF A CHANGE PRFM1 05870C* HAS BEEN MADE IN HOURLY RATE OR SALARY. PRFM1 05880C* PRFM1 0005890CSR CHKPAY BEGSR PRFM1 05900C* ********** PRFM1 05910CSR SECTN COMP 1 61 PRFM1 05920CSRN61 GOTO CHKEND PRFM1 05930C* ********** PRFM1 05940CSR SETOF 61 PRFM1 05950CSR Z-ADD110 SSTRT GET UPDATE PRFM1 0005960CSR Z-ADD1 TSTRT RATE FIELDS PRFM1 05970CSR Z-ADD11 NCHARS PRFM1 05980C* ********** PRFM1 05990CSR EXIT SUBRLM PRFM1 06000CSR RLABL RECORD PRFM1 06010CSR RLABL SSTRT 30 PRFM1 06020CSR RLABL BUFFER PRFM1 0006030CSR RLABL TSTRT 30 PRFM1 06040CSR RLABL NCHARS 30 PRFM1 06050CSR MOVELBUFFER A11 11 PRFM1 06060CSR MOVELA11 NEWHRT 50 PRFM1 06070CSR MOVE A11 NEWSAL 60 PRFM1 06080CSR OLDHRT COMP NEWHRT 5151 ANY CHANGES? PRFM1 06090CSR OLDSAL COMP NEWSAL 5252 PRFM1 0006100CSRN51N52 GOTO CHKEND NO- QUIT. PRFM1 06110C* ********** PRFM1 06120CSR Z-ADD382 TSTRT YES, DETERMINE PRFM1 06130CSR MOVELOLDHRT A11 WHICH FLDS PRFM1 06140CSR MOVE OLDSAL A11 GET MOVED ANDPRFM1 06150CSR Z-ADD11 NCHARS PRFM1 06160CSR Z-ADD1 SSTRT MOVE NEW FLDS PRFM1 0006170C* ********** PRFM1 06180CSR EXIT SUBRLM PRFM1 06190CSR RLABL A11 PRFM1 06200CSR RLABL SSTRT 30 PRFM1 06210CSR RLABL RECORD PRFM1 06220CSR RLABL TSTRT 30 PRFM1 06230CSR RLABL NCHARS 30 PRFM1 0006240CSR CHKEND TAG PRFM1 06250C* ********** PRFM1 06260CSR ENDSR PRFM1 06270C********************************************************************PRFM1 06280C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE PRFM1 06290C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X PRFM1 06300C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND PRFM1 0006310C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT PRFM1 06320C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED PRFM1 06330C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS PRFM1 06340C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS PRFM1 06350C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO PRFM1 06360C* TO BE OUTPUT TO THE SCREEN. PRFM1 06370C* PRFM1 0006380C********************************************************************PRFM1 06390CSR ACCEPT BEGSR PRFM1 06400C* ********** PRFM1 06410CSR X COMP 1 30 PRFM1 06420CSRN30 X COMP SSIZE 30 PRFM1 06430CSR 30 Z-ADD1 X PRFM1 06440CSR MOVELCP,X FC PRFM1 0006450CSR FC ADD 3 FC PRFM1 06460CSR MOVELCP,X SAVPOS 4 PRFM1 06470CSR MOVELFC SAVPOS PRFM1 06480CSR Z-ADDLN,X LEN PRFM1 06490CSR LEN COMP 0 97 PRFM1 06500CSR 97 Z-SUBLEN LEN PRFM1 06510CSR LEN ADD FC OFC 20 PRFM1 0006520CSR ACLOOP TAG PRFM1 06530C* ********** PRFM1 06540CSR MOVELSAVPOS BUFFER PRFM1 06550CSR EXSR POSCUR PRFM1 06560C* ********** PRFM1 06570CSR Z-ADDLEN BLNGTH PRFM1 06580CSR MOVE BLANKS BUFFER PRFM1 0006590CSR MOVE 'A' TYPE PRFM1 06600CSR EXSR CRTCOM PRFM1 06610C* ********** PRFM1 06620CSR RCODE COMP 'R' 31 PRFM1 06630CSR 31 BUFFER COMP BLANKS 32 PRFM1 06640CSR 31 32N62 GOTO DUPIT PRFM1 06650C* ********** PRFM1 0006660CSR 31 GOTO ACLOOP PRFM1 06670C* ********** PRFM1 06680CSR RCODE COMP 'L' 33 PRFM1 06690CSR 33 GOTO DUPIT PRFM1 06700C* ********** PRFM1 06710CSRN97 GOTO ENDACC PRFM1 06720C* ********** PRFM1 0006730CSR MOVELBUFFER SIGN 1 WE MUST CHECK PRFM1 06740CSR SIGN COMP '@' 30 PRFM1 06750CSR 30 GOTO ENDACC PRFM1 06760C* ********** PRFM1 06770CSR Z-ADDLEN VL 20 PRFM1 06780CSR MOVELBUFFER VAR 15 PRFM1 06790CSR EXSR RTADJ PRFM1 0006800C* ********** PRFM1 06810CSR MOVELVAR BUFFER PRFM1 06820CSR GOTO ENDACC PRFM1 06830C* ********** PRFM1 06840CSR DUPIT TAG PRFM1 06850C* ********** PRFM1 06860CSR MOVELSAVPOS BUFFER PRFM1 0006870CSR EXSR POSCUR PRFM1 06880C* ********** PRFM1 06890CSR 62 MOVELSECTON BUFFER PRFM1 06900CSRN62 Z-ADD1 FPOS PRFM1 06910CSRN62 EXSR MVRECD PRFM1 06920C* ********** PRFM1 06930CSR 63 MOVELPRNTOP BUFFER PRFM1 0006940CSR MOVE 'S' TYPE PRFM1 06950CSR BLNGTH ADD 1 BLNGTH PRFM1 06960CSR EXSR CRTCOM PRFM1 06970C* ********** PRFM1 06980CSR ENDACC ENDSR PRFM1 06990C* ********** PRFM1 07000C********************************************************************PRFM1 0007010C* PRFM1 07020C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES PRFM1 07030C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM PRFM1 07040C* 4 DUMMY FOR RTADJ PRFM1 07050C* PRFM1 07060C********************************************************************PRFM1 07070CSR POSCUR BEGSR PRFM1 0007080C* ********** PRFM1 07090CSR MOVE 'P' TYPE PRFM1 07100CSR EXSR CRTCOM PRFM1 07110C* ********** PRFM1 07120CSR ENDSR PRFM1 07130C********************************************************************PRFM1 07140CSR CLRSCR BEGSR PRFM1 0007150C* ********** PRFM1 07160CSR MOVE 'C' TYPE PRFM1 07170CSR EXSR CRTCOM PRFM1 07180C* ********** PRFM1 07190CSR ENDSR PRFM1 07200C********************************************************************PRFM1 07210CSR CRTCOM BEGSR PRFM1 0007220C* ********** PRFM1 07230C* ********** PRFM1 07240CSR EXITFSUBRCM PRFM1 07250CSR RLABL BUFFER 72 PRFM1 07260CSR RLABL TYPE 1 PRFM1 07270CSR RLABL BLNGTH 20 PRFM1 07280CSR RLABL RCODE 1 PRFM1 0007290CSR RLABL MASK 10 PRFM1 07300CSR RLABL DTYPE 10 PRFM1 07310CSR U2 PRFM1 07320COR 70 EXSR CLRFIL PRFM1 07330C* ********** PRFM1 07340CSR U2 PRFM1 07350COR 70 EXSR POSFIL PRFM1 0007360C* ********** PRFM1 07370CSR U2 PRFM1 07380COR 70 EXSR OUTFIL PRFM1 07390C* ********** PRFM1 07400CSR ENDSR PRFM1 07410C********************************************************************PRFM1 07420CSR RTADJ BEGSR PRFM1 0007430C* ********** PRFM1 07440CSR EXIT SUBRAJ PRFM1 07450C* ********** PRFM1 07460CSR RLABL VL PRFM1 07470CSR RLABL VAR PRFM1 07480CSR ENDSR PRFM1 07490C********************************************************************PRFM1 0007500C* PRFM1 07510C* PRNFIL -- PRINT SCREEN IMAGE FILE PRFM1 07520C* PRFM1 07530CSR PRNFIL BEGSR PRFM1 07540C* ********** PRFM1 07550CSR TIME HHMMSS 60 TIME OF DAY PRFM1 07560CSR HHMMSS DIV 100 HHMMSS PRFM1 0007570CSR MOVE LINE LIN1 PRFM1 07580CSR SETON 84 PRFM1 07590CSR EXCPT PRFM1 07600CSR SETOF 84 PRFM1 07610CSR SETON 97 PRFM1 07620CSR Z-ADD0 LIN 20 PRFM1 07630CSR PRNLP TAG PRFM1 0007640C* ********** PRFM1 07650CSR LIN ADD 1 LIN PRFM1 07660CSR LIN CHAINSCRFIL 56 PRFM1 07670CSR 56 GOTO ENDPRN PRFM1 07680C* ********** PRFM1 07690CSR SETON 82 PRFM1 07700CSR SETOF 8297 PRFM1 0007710CSR GOTO PRNLP PRFM1 07720C* ********** PRFM1 07730CSR ENDPRN ENDSR PRFM1 07740C* ********** PRFM1 07750C********************************************************************PRFM1 07760C* PRFM1 07770C* POSFIL -- SET LOCATION IN SCREEN-IMAGE FILE PRFM1 0007780C* PRFM1 07790CSR POSFIL BEGSR PRFM1 07800C* ********** PRFM1 07810CSR TYPE COMP 'P' 82 PRFM1 07820CSRN82 GOTO EPFIL PRFM1 07830C* ********** PRFM1 07840CSR SETOF 82 PRFM1 0007850CSR MOVELBUFFER FILPOS 4 PRFM1 07860CSR MOVELFILPOS COL 20 PRFM1 07870CSR COL ADD 1 COL PRFM1 07880CSR MOVE FILPOS NLIN 20 PRFM1 07890CSR NLIN ADD 1 NLIN PRFM1 07900CSR NLIN COMP LIN 82 PRFM1 07910CSR 82 GOTO EPFIL PRFM1 0007920C* ********** PRFM1 07930CSR MOVE LINE LIN1 PRFM1 07940CSR SETON 84 PRFM1 07950CSR EXCPT OUTPUT LIN1 PRFM1 07960CSR SETOF 84 PRFM1 07970CSR Z-ADDNLIN LIN PRFM1 07980CSR LIN CHAINSCRFIL 56 READ NEW LINE PRFM1 0007990CSR EPFIL TAG PRFM1 08000C* ********** PRFM1 08010CSR SETOF 82 PRFM1 08020CSR ENDSR PRFM1 08030C********************************************************************PRFM1 08040C* PRFM1 08050C* CLRFIL -- CLEAR SCREEN-IMAGE FILE TO BLANKS PRFM1 0008060C* PRFM1 08070CSR CLRFIL BEGSR PRFM1 08080C* ********** PRFM1 08090CSR TYPE COMP 'C' 82 PRFM1 08100CSRN82 GOTO CLREND PRFM1 08110C* ********** PRFM1 08120CSR SETOF 8240 PRFM1 0008130C* ********** PRFM1 08140CSR EXIT SUBRFL PRFM1 08150CSR RLABL LIN1 80 PRFM1 08160CSR RLABL FILLER 1 PRFM1 08170CSR Z-ADD1 LIN PRFM1 08180CSR CLRLP TAG PRFM1 08190C* ********** PRFM1 0008200CSR LIN CHAINSCRFIL 56 PRFM1 08210CSR 56 GOTO ENDCLR PRFM1 08220C* ********** PRFM1 08230CSR LIN ADD 1 LIN PRFM1 08240CSR SETON 84 PRFM1 08250CSR EXCPT PRFM1 08260CSR SETOF 84 PRFM1 0008270CSR GOTO CLRLP PRFM1 08280C* ********** PRFM1 08290CSR ENDCLR TAG PRFM1 08300C* ********** PRFM1 08310CSR Z-ADD1 LIN PRFM1 08320CSR LIN CHAINSCRFIL 56 PRFM1 08330CSR CLREND ENDSR PRFM1 0008340C* ********** PRFM1 08350C********************************************************************PRFM1 08360C* PRFM1 08370C* OUTFIL -- OUTPUT CHARACTERS TO LINE PRFM1 08380C* PRFM1 08390CSR OUTFIL BEGSR PRFM1 08400C* ********** PRFM1 0008410CSR TYPE COMP 'S' 82 PRFM1 08420CSR TYPE COMP 'T' 83 PRFM1 08430CSRN82N83 GOTO ENDOUT PRFM1 08440C* ********** PRFM1 08450CSR Z-ADDTSTRT SAVE1 40 PRFM1 08460CSR Z-ADDNCHARS SAVE2 40 PRFM1 08470CSR Z-ADDSSTRT SAVE3 40 PRFM1 0008480CSR Z-ADDCOL TSTRT PRFM1 08490CSR Z-ADDBLNGTH NCHARS PRFM1 08500CSR Z-ADD1 SSTRT PRFM1 08510C* ********** PRFM1 08520CSR EXIT SUBRMV PRFM1 08530CSR RLABL BUFFER PRFM1 08540CSR RLABL SSTRT 30 PRFM1 0008550CSR RLABL LINE PRFM1 08560CSR RLABL TSTRT 30 PRFM1 08570CSR RLABL NCHARS 30 PRFM1 08580CSR 82 GOTO ENDOUT PRFM1 08590C* ********** PRFM1 08600CSR MOVE TYPE TYP1 1 PRFM1 08610CSR MOVELBUFFER TEMP4B 4 PRFM1 0008620CSR Z-ADDLIN TEMP4A 40 PRFM1 08630CSR MOVELTEMP4A BUFFER PRFM1 08640CSR MOVE 'P' TYPE PRFM1 08650CSR EXSR POSFIL PRFM1 08660C* ********** PRFM1 08670CSR MOVELTEMP4B BUFFER PRFM1 08680CSR MOVE TYP1 TYPE PRFM1 0008690CSR Z-ADDSAVE1 TSTRT PRFM1 08700CSR Z-ADDSAVE2 NCHARS PRFM1 08710CSR Z-ADDSAVE3 SSTRT PRFM1 08720CSR ENDOUT TAG PRFM1 08730C* ********** PRFM1 08740CSR SETOF 8283 PRFM1 08750CSR ENDSR PRFM1 0008760C********************************************************************PRFM1 08770C* PRFM1 08780OPRMAST E 80N55 PRFM1 08790O RECORD 0256 PRFM1 08800O LEFT01 0512 PRFM1 08810O LEFT02 0600 PRFM1 08820O E 40N80 PRFM1 0008830O FF 1 PRFM1 08840O EADD 80 55 PRFM1 08850O RECORD 0256 PRFM1 08860O LEFT01 0512 PRFM1 08870O LEFT02 0600 PRFM1 08880OSCRFIL E 84 PRFM1 08890O LIN1 80 PRFM1 0008900O$LP1 E 103 82 97 PRFM1 08910O 9 'PRFM01 --' PRFM1 08920O 31 'CRT DISPLAY HARD COPY' PRFM1 08930O 41 'DATE:' PRFM1 08940O DDATE 50 '0 / / ' PRFM1 08950O 63 'TIME:' PRFM1 08960O HHMMSS 70 ' 0 : ' PRFM1 0008970O$LP1 E 1 82 PRFM1 08980O LINE 80 PRFM1 ** 008990ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 009000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 009010ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 009020ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00903000/* 009040__0O LINE 80 PRFM1 ** 008990ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 009000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 009010ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 009020ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0090300(c 2?TXPRFM6 P999999111111(000010H S PRFM6 00020X DECK-ID B27 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRFM6 00030F* READS TRANS, CREATES DCFILE FOR DEPARTMENT TRANSFERS PRFM6 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRFM6 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRFM6 00060F* CONTROL DATA PROPRIETARY PRODUCT PRFM6 00070F* PRFM6 0000080F* PRFM6 00090F* *************************************************************** PRFM6 00100F* * ************************************************* * PRFM6 00110F* * * * * PRFM6 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRFM6 00130F* * * * * PRFM6 00140F* * ************************************************* * PRFM6 0000150F* *************************************************************** PRFM6 00160F* CREATES THE 'DCFILE' FROM 'TRANS'. FLAGS OLD PRMAST RECS FOR PRFM6 00170F* DELETE; ADDS NEW PRMAST RECORDS TO THE FILE. PRFM6 00180F* PRFM6 00190FTRANS IP AF 132 132 DISK PRFM6 00200FPRMAST UC F 600R10AI 2 DISK A PRFM6 00210FDCFILE O F 20 DISK PRFM6 0000220ITRANS AA 01 1 CD 2 CC PRFM6 00230I 3 12 KEY1 PRFM6 00240I 13 22 KEY2 PRFM6 00250I BB 02 PRFM6 00260I 1 1 A1 PRFM6 00270IPRMAST NS 03 PRFM6 00280I 1 256 FLD1 PRFM6 0000290I 257 512 FLD2 PRFM6 00300I 513 600 FLD3 PRFM6 00310C 01 KEY1 CHAINPRMAST 22 PRFM6 00320C 01 SETON 21 PRFM6 00330ODCFILE D 01 PRFM6 00340O KEY1 10 PRFM6 00350O KEY2 20 PRFM6 0000360ODCFILE T LRN21 PRFM6 00370O 4 'NONE' PRFM6 00380OPRMAST D 01N22 PRFM6 00390O 381 'D' PRFM6 00400O DADD 01N22 PRFM6 00410O FLD1 256 PRFM6 00420O KEY2 11 PRFM6 0000430O FLD2 512 PRFM6 00440O FLD3 600 PRFM6 ** 000450ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000460ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000470ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000480ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00049000/* 000500__0O FLD3 600 PRFM6 ** 000450ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000460ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000470ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000480ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0004900(d .?TXPRFM7 P999999111111(000010H S PRFM7 00020X DECK-ID B28 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRFM7 00030F* PROCESS DEPARTMENT TRANSFERS AGAINST MEARNS - UPDATE RECORDS PRFM7 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRFM7 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRFM7 00060F* CONTROL DATA PROPRIETARY PRODUCT PRFM7 00070F* PRFM7 0000080F* PRFM7 00090F* *************************************************************** PRFM7 00100F* * ************************************************* * PRFM7 00110F* * * * * PRFM7 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRFM7 00130F* * * * * PRFM7 00140F* * ************************************************* * PRFM7 0000150F* *************************************************************** PRFM7 00160F* PRFM7 00170F* UPDATE ANY TRANSACTIONS ON 'MEARNS WHICH ARE FOR THE PRFM7 00180F* DEPARTMENTAL TRANSFERS ON 'DCFILE'. PRFM7 00190FMEARNS UP AF 140 140 DISK PRFM7 00200FDCFILE IT F 20 EDISK PRFM7 00210E DCFILE A1 1 100 10 F1 10 PRFM7 0000220IMEARNS NS 01 1 CP PRFM7 00230I 3 12 OLDKEY PRFM7 00240C 99 GOTO NEXT PRFM7 00250C* ********** PRFM7 00260C MOVELA1,1 BLKEY 20 PRFM7 00270C MOVE F1,1 BLKEY PRFM7 00280C BLKEY COMP 'NONE' LR PRFM7 0000290C LR GOTO END PRFM7 00300C* ********** PRFM7 00310C SETON 99 PRFM7 00320C NEXT TAG PRFM7 00330C* ********** PRFM7 00340C Z-ADD1 X 30 PRFM7 00350C OLDKEY LOKUPA1,X 20 PRFM7 0000360C 20 MOVE F1,X NEWKEY 10 PRFM7 00370C END TAG PRFM7 00380C* ********** PRFM7 00390OMEARNS D 01 20 PRFM7 00400O NEWKEY B 12 PRFM7 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00042000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000450/* 000460__0O NEWKEY B 12 PRFM7 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0004200(dW TTXPRINQ P999999111111(000010H S PRINQ 00020X DECK-ID B29 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRINQ 00030F* RECOVERY PROGRAM WHICH DISPLAYS LAST RECORD INPUT AND RECORD NO. PRINQ 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRINQ 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRINQ 00060F* CONTROL DATA PROPRIETARY PRODUCT PRINQ 00070F* PRINQ 0000080FDUMMY UPE F 72 DISK PRINQ 00090FPRINPT IC F 128R DISK PRINQ 00100E MSG 1 5 35 PRINQ 00110IDUMMY NS 01 PRINQ 00120I 1 72 ALL PRINQ 00130IPRINPT NS 02 PRINQ 00140I 1 128 RCD PRINQ 0000150C SETOF 60 PRINQ 00160C SETON LR PRINQ 00170CLR MOVE ' ' B80 80 PRINQ 00180CLR EXSR ALMTS PRINQ 00190CLR Z-ADDLOW SEQNO 50 PRINQ 00200CLR LOOP TAG PRINQ 00210CLR SEQNO COMP HIGH 40 PRINQ 0000220CLR 40 GOTO A PRINQ 00230CLR SEQNO CHAINPRINPT 50 PRINQ 00240CLR 50 GOTO A PRINQ 00250CLR MOVELRCD TST 2 PRINQ 00260CLR TST COMP '<>' 51 PRINQ 00270CLRN51 SEQNO ADD 1 SEQNO PRINQ 00280CLRN51 GOTO LOOP PRINQ 0000290CLR A TAG PRINQ 00300CLR SEQNO SUB 1 SUBNO 50 PRINQ 00310CLR SUBNO CHAINPRINPT 50 PRINQ 00320CLR MOVELRCD BUFFER PRINQ 00330CLR MOVE 'T' TYPE PRINQ 00340CLR Z-ADD80 BLNGTH PRINQ 00350CLR EXSR CRTCOM PRINQ 0000360CLR MOVE RCD HOLD 48 PRINQ 00370CLR MOVE B80 BUFFER PRINQ 00380CLR MOVE 'T' TYPE PRINQ 00390CLR MOVELHOLD HOLD1 47 PRINQ 00400CLR MOVELHOLD HOLD2 42 PRINQ 00410CLR MOVELHOLD2 BUFFER PRINQ 00420CLR Z-ADD42 BLNGTH PRINQ 0000430CLR EXSR CRTCOM PRINQ 00440CLR MOVE B80 BUFFER PRINQ 00450CLR MOVELMSG,3 BUFFER PRINQ 00460CLR MOVE 'S' TYPE PRINQ 00470CLR Z-ADD35 BLNGTH PRINQ 00480CLR EXSR CRTCOM PRINQ 00490CLR MOVE B80 BUFFER PRINQ 0000500CLR MOVE HOLD1 HLDSEQ 5 PRINQ 00510CLR MOVELHLDSEQ BUFFER PRINQ 00520CLR MOVE 'T' TYPE PRINQ 00530CLR Z-ADD5 BLNGTH PRINQ 00540CLR EXSR CRTCOM PRINQ 00550CLR MOVELMSG,4 BUFFER PRINQ 00560CLR MOVE 'S' TYPE PRINQ 0000570CLR Z-ADD35 BLNGTH PRINQ 00580CLR EXSR CRTCOM PRINQ 00590CLR MOVE B80 BUFFER PRINQ 00600CLR MOVE 'A' TYPE PRINQ 00610CLR Z-ADD1 BLNGTH PRINQ 00620CLR EXSR CRTCOM PRINQ 00630CLR MOVE 'C' TYPE PRINQ 0000640CLR EXSR CRTCOM PRINQ 00650CLR MOVE 'F' TYPE PRINQ 00660CLR EXSR CRTCOM PRINQ 00670CSR ALMTS BEGSR PRINQ 00680CSR MOVE B80 BUFFER 80 PRINQ 00690CSR MOVE 'C' TYPE 1 PRINQ 00700CSR Z-ADD0 BLNGTH 20 PRINQ 0000710CSR MOVE ' ' RCODE 1 PRINQ 00720CSR Z-ADD0 MASK 10 PRINQ 00730CSR Z-ADD0 DTYPE 10 PRINQ 00740CSR EXSR CRTCOM PRINQ 00750CSR MOVELMSG,1 BUFFER PRINQ 00760CSR MOVE 'S' TYPE PRINQ 00770CSR Z-ADD35 BLNGTH PRINQ 0000780CSR EXSR CRTCOM PRINQ 00790CSR MOVE B80 BUFFER PRINQ 00800CSR MOVE 'A' TYPE PRINQ 00810CSR Z-ADD5 BLNGTH PRINQ 00820CSR Z-ADD1 DTYPE PRINQ 00830CSR EXSR CRTCOM PRINQ 00840CSR EXSR SKIP PRINQ 0000850CSR RCODE COMP 'R' 86 PRINQ 00860CSR EXSR AJ PRINQ 00870CSR MOVELBUFFER LOW 50 PRINQ 00880CSR MOVE B80 BUFFER PRINQ 00890CSR MOVELMSG,2 BUFFER PRINQ 00900CSR MOVE 'S' TYPE PRINQ 00910CSR Z-ADD35 BLNGTH PRINQ 0000920CSR EXSR CRTCOM PRINQ 00930CSR MOVE B80 BUFFER PRINQ 00940CSR MOVE 'A' TYPE PRINQ 00950CSR Z-ADD5 BLNGTH PRINQ 00960CSR Z-ADD1 DTYPE PRINQ 00970CSR EXSR CRTCOM PRINQ 00980CSR RCODE COMP 'R' 87 PRINQ 0000990CSR EXSR AJ PRINQ 01000CSR MOVELBUFFER HIGH 50 PRINQ 01010CSR MOVE 'C' TYPE PRINQ 01020CSR EXSR CRTCOM PRINQ 01030CSR 86 PRINQ 01040COR 87 GOTO ALMTS PRINQ 01050CSR Z-ADD0 DTYPE PRINQ 0001060CSR ENDSR PRINQ 01070CSR CRTCOM BEGSR PRINQ 01080CSR EXITFSUBRCM PRINQ 01090CSR RLABL BUFFER PRINQ 01100CSR RLABL TYPE PRINQ 01110CSR RLABL BLNGTH PRINQ 01120CSR RLABL RCODE PRINQ 0001130CSR RLABL MASK PRINQ 01140CSR RLABL DTYPE PRINQ 01150CSR ENDSR PRINQ 01160CSR SKIP BEGSR PRINQ 01170CSR MOVELBUFFER NBUF 1 PRINQ 01180CSR MOVEL' ' BUFFER PRINQ 01190CSR Z-ADD1 BLNGTH PRINQ 0001200CSR MOVE 'T' TYPE PRINQ 01210CSR EXSR CRTCOM PRINQ 01220CSR MOVELNBUF BUFFER PRINQ 01230CSR ENDSR PRINQ 01240CSR AJ BEGSR PRINQ 01250CSR MOVELBUFFER VAR 15 PRINQ 01260CSR Z-ADD5 VL 20 PRINQ 0001270CSR EXIT SUBRAJ PRINQ 01280CSR RLABL VL PRINQ 01290CSR RLABL VAR PRINQ 01300CSR MOVELVAR BUFFER PRINQ 01310CSR ENDSR PRINQ 01320ODUMMY D 60 PRINQ 01330O ALL 72 PRINQ 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430 001440/* 001450__ 001390ENTER BEGINNING RRN 0014000(Ld TXPRKEY1 P999999111111(000010H S PRKEY100020X DECK-ID B31 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRKEY100030F* DATA ENTRY PROGRAM FOR TO-BE-PAID TRANSACTIONS PRKEY100040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRKEY100050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRKEY100060F* CONTROL DATA PROPRIETARY PRODUCT PRKEY100070F* PRKEY10000080F* PRKEY100090F* ************************** PRKEY100100F* * ************************************************* * PRKEY100110F* * * * * PRKEY100120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRKEY100130F* * * * * PRKEY100140F* * ************************************************* * PRKEY10000150F* *************************************************************** PRKEY100160F* PRKEY100170F****************************************************************** PRKEY100180F* PRKEY100190F* THIS IS A MODIFICATION OF 'KEYPCH' WHICH ALLOWS: PRKEY100200F* 1) AUTOMATIC PROGRAM LEVEL SWITCHING, PRKEY100210F* 2) GANG-PUNCH FIELDS (CONSTANT INSERTION), PRKEY10000220F* 3) EDIT FLAGGING OF FILEDS FOR PORCESSING BY SUBROUTINE PRKEY100230F* 'EDIT' INTERNAL TO THIS PROGRAM. PRKEY100240F* 4) EIGHT PORGRAM LEVELS. PRKEY100250F* 5) AUTOMATIC LOADING OF THE 8 LEVELS BASED ON THE 1ST RECORD PRKEY100260F* IN THE FILE 'DUMMY'. (BYTES 1-48 CONTAIN THE NAMES). PRKEY100270F* 6) IF MODE IS 'A', THE STARTING SEQ# WILL AUTOMATICALLY BE THE PRKEY100280F* FIRST RECORD WITH '<>' IN BYTES 1-2. PRKEY10000290F* PRKEY100300F* MODIFIED 07/09/76 TO CORRECT A PROBLEM IN BATCH TOTAL. ('EB') PRKEY100310F* PRKEY100320F* PRKEY100330F********************************************************************PRKEY100340FMANDUM IPEAF 36 DISK PRKEY100350FKPROGX IC F 40R 8AI 1 DISK PRKEY10000360FPRINPT UC F 128R DISK PRKEY100370F****************************************************************** PRKEY100380F* THE FILES BELOW ARE USED STRICTLY FOR EDITING. PRKEY100390FPRMAST IC F 600R10AI 2 DISK PRKEY100400F* PRKEY100410F* PRKEY100420F* PRKEY10000430F********************************************************************PRKEY100440E MSG 1 5 25 PRKEY100450E SFN 200 20 FIELD NAMES. PRKEY100460E SAN 200 1 ALPH OR NUM PRKEY100470E SAD 200 1 AUTO DUP FLAGS PRKEY100480E SST 200 3 0 FIELD START PRKEY100490E SLN 200 2 0 FIELD LENGTHS PRKEY10000500E SEF 200 2 EDIT FLAGS PRKEY100510E SGP 200 1 GANG PUNCH FLGS PRKEY100520E SNP 8 1 0 NEXT PROG# PRKEY100530E SNM 8 6 PROG NAMES PRKEY100540E SMX 8 3 0 MAX FLDS PRKEY100550E EMS 1 10 30 EDIT MESSAGES PRKEY100560IMANDUM NS 01 PRKEY10000570I 1 36 SNM PRKEY100580IKPROGX NS 02 36NCD PRKEY100590I 9 28 FN PRKEY100600I 29 29 AN PRKEY100610I 30 30 AD PRKEY100620I 31 33 ST PRKEY100630I 34 35 LN PRKEY10000640I 36 36 DCODE PRKEY100650I 37 37 NPL PRKEY100660I 38 38 GP PRKEY100670I 39 40 EF PRKEY100680I NS 03 PRKEY100690I 1 1 A PRKEY100700IPRINPT NS 05 PRKEY10000710I 1 2 RC PRKEY100720I 1 128 RECORD PRKEY100730I****************************************************************** PRKEY100740I* INPUT SPECS FOR EDITING FILES ARE LISTED BELOW. PRKEY100750IPRMAST NS 06 PRKEY100760I 14 16 DN3 PRKEY100770I 132 132 YTYPE PRKEY10000780C* PRKEY100790C* PRKEY100800C* PRKEY100810C MOVE ' ' B72 72 PRKEY100820C Z-ADD25 NFLDS 20 PRKEY100830C Z-ADD1 PN LOAD INITIAL PRKEY100840C LDLOOP TAG PROGS FROM 1STPRKEY10000850C* ********** PRKEY100860C SNM,PN COMP ' ' 2626 48 BYTES OF PRKEY100870C MOVELSNM,PN PNAME PRKEY100880C MOVE ' ' PNAME PRKEY100890C 26 EXSR GETPRG 'DUMMY' REC. PRKEY100900C* ********** PRKEY100910C PN ADD 1 PN PRKEY10000920C PN COMP 8 2626 PRKEY100930C 26 GOTO LDLOOP PRKEY100940C* ********** PRKEY100950C NLR SETON LR PRKEY100960CLR MOVE '1' RTNLVL 10 PRKEY100970CLR MOVE '1' TERMNL 10 PRKEY100980CLR START TAG PRKEY10000990C* ********** PRKEY101000CLR EXSR CLRSCR PRKEY101010CLR MOVEL'>MODE-' WORD 16 PRKEY101020CLR Z-ADD6 OLN 20 PRKEY101030CLR Z-ADD1 ILN 20 PRKEY101040CLR EXSR TYPES PRKEY101050C* ********** PRKEY10001060CLR MOVELNBUF MODE 1 PRKEY101070CLR CHKMOD TAG PRKEY101080C* ********** PRKEY101090CLR SETOF 9095 PRKEY101100CLR MODE COMP 'A' 62 PRKEY101110CLR MODE COMP 'C' 63 PRKEY101120CLR MODE COMP 'V' 64 PRKEY10001130CLR MODE COMP 'K' 65 PRKEY101140CLR MODE COMP 'E' 66 PRKEY101150CLR 66 GOTO EOJ PRKEY101160C* ********** PRKEY101170CLR 65 EXSR GETPRG PRKEY101180C* ********** PRKEY101190CLR 65 GOTO START PRKEY10001200C* ********** PRKEY101210CLRN62N63N64 SETON 81 PRKEY101220CLR 81 EXSR EXCPT PRKEY101230C* ********** PRKEY101240CLR SETOF 81 PRKEY101250CLRN62N63N64 GOTO START PRKEY101260C* ********** PRKEY10001270CLR EXSR GETPRG PRKEY101280C* ********** PRKEY101290CLRN63N95N62 EXSR GETSEQ PRKEY101300C* ********** PRKEY101310CLR 62 EXSR SEQ1ST PRKEY101320C* ********** PRKEY101330CLR 86 GOTO EOJ PRKEY10001340C* ********** PRKEY101350CLR SAMREC TAG PRKEY101360C* ********** PRKEY101370CLR SEQNO SUB 1 SEQNO 40 PRKEY101380CLR NXTREC TAG PRKEY101390CLR EXSR CLRSCR PRKEY101400C* ********** PRKEY10001410CLR SETOF 2630 26=1ST FLD FLG PRKEY101420CLR SETON 18 PRKEY101430CLR 63 EXSR GETSEQ PRKEY101440C* ********** PRKEY101450CLRN63 SEQNO ADD 1 SEQNO PRKEY101460CLR EXSR GETREC PRKEY101470C* ********** PRKEY10001480CLR 62 MOVE OLDREC RECORD PRKEY101490CLR Z-ADDBP N 30 PRKEY101500CLR LOOP TAG PRKEY101510C* ********** PRKEY101520CLR 27 28 90N SUB 2 N PRKEY101530CLR N COMP BP 2920 PRKEY101540CLR 20 GOTO NXTMOD PRKEY10001550C* ********** PRKEY101560CLR N ADD 1 N PRKEY101570CLR N COMP MAXFLD 20 PRKEY101580CLR 20N29 SETON 83 NO FIELDS PRKEY101590CLR 83 EXSR EXCPT PRKEY101600C* ********** PRKEY101610CLR SETOF 83 PRKEY10001620CLR 20N29 GOTO START PRKEY101630C* ********** PRKEY101640CLR 20 GOTO OUTREC PRKEY101650C* ********** PRKEY101660C** 30 HERE MEANS '@' ON PRIOR FIELD FOR THIS RECORD. PRKEY101670CLR 30 GOTO SVFLD PRKEY101680C* ********** PRKEY10001690C** PRKEY101700CLR SGP,N COMP ' ' 2323 GANG PUNCH? PRKEY101710CLR N23 GOTO CHKAD PRKEY101720C* ********** PRKEY101730CLR MOVELSFN,N BUFFER YES... PRKEY101740CLR Z-ADDSLN,N BLNGTH PUT 1ST LN PRKEY101750CLR EXSR EXCPT CHARS OF FIELDPRKEY10001760C* ********** PRKEY101770CLR EXSR SKIP IN BUFFER. PRKEY101780C* ********** PRKEY101790CLR MOVE 'O' RCODE PRKEY101800CLR GOTO CHKVER PRKEY101810C* ********** PRKEY101820CLR CHKAD TAG PRKEY10001830C* ********** PRKEY101840CLR SAD,N COMP 'D' 27 PRKEY101850CLR 27 62 90 PRKEY101860COR 27 64 90 GOTO LOOP PRKEY101870C* ********** PRKEY101880CLR 62 GOTO SKIPMV PRKEY101890C* ********** PRKEY10001900CLR EXSR MVRECD PRKEY101910C* ********** PRKEY101920CLR MOVE BUFFER TBUF 72 PRKEY101930CLR SKIPMV TAG PRKEY101940C* ********** PRKEY101950CLR OUTFLD TAG PRKEY101960C* ********** PRKEY10001970CLR N DIV 25 P 30 PRKEY101980CLR MVR R 20 PRKEY101990CLR R COMP 0 98 PRKEY102000CLR 98 GOTO BYPSS PRKEY102010CLR R DIV 5 P PRKEY102020CLR MVR R PRKEY102030CLR EXSR SKIP PRKEY10002040CLR R COMP 0 99 PRKEY102050CLR 99 EXSR CLRSCR PRKEY102060CLR BYPSS TAG PRKEY102070CLR SETOF 9899 PRKEY102080CLR SETON 84 OUTPUT FIELD PRKEY102090CLR EXSR EXCPT NAME PRKEY102100C* ********** PRKEY10002110CLR SETOF 8418 PRKEY102120CLR MOVE SLN,N BLNGTH PRKEY102130CLR SETON 19 PRKEY102140CLR MOVE TBUF BUFFER PRKEY102150CLR EXSR EXCPT PRKEY102160C* ********** PRKEY102170CLR SETOF 2728 PRKEY10002180CLR MOVE B72 BUFFER PRKEY102190CLR MOVE 'A' TYPE 1 PRKEY102200CLR Z-ADDSLN,N BLNGTH 20 PRKEY102210CLR EXITFSUBRCM PRKEY102220CLR RLABL BUFFER 72 PRKEY102230CLR RLABL TYPE 1 PRKEY102240CLR RLABL BLNGTH 20 PRKEY10002250CLR RLABL RCODE 1 PRKEY102260CLR RLABL MASK 10 PRKEY102270CLR RLABL DTYPE 10 PRKEY102280CLR RCODE COMP 'O' 20 PRKEY102290CLR 20 EXSR SKIP PRKEY102300C* ********** PRKEY102310CLR RCODE COMP 'L' 20 PRKEY10002320CLR 20 GOTO RITDUP PRKEY102330C* ********** PRKEY102340CLR RCODE COMP 'R' 20 PRKEY102350CLR 20 BUFFER COMP B72 21 PRKEY102360CLR 20N21 EXSR SKIP PRKEY102370C* ********** PRKEY102380CLR 20N21 N SUB 1 N PRKEY10002390CLR 20 21 N SUB 2 N 28 28 PRKEY102400CLRN20 GOTO CHKNUM PRKEY102410C* ********** PRKEY102420CLR N21 GOTO LOOP PRKEY102430C* ********** PRKEY102440CLR 21N26 GOTO NXTMOD RUB ON 1ST PRKEY102450C* ********** PRKEY10002460CLR GOTO LOOP PRKEY102470C* ********** PRKEY102480CLR NXTMOD TAG PRKEY102490C* ********** PRKEY102500CLR EXSR SKIP PRKEY102510CLR SETOF 28 PRKEY102520CLR MOVEL'MODE ' WORD PRKEY10002530CLR Z-ADD5 OLN PRKEY102540CLR Z-ADD1 ILN PRKEY102550CLR EXSR TYPES PRKEY102560C* ********** PRKEY102570CLR MOVELBUFFER MODE PRKEY102580CLR MODE COMP 'P' 60 NEW PROG#ONLY PRKEY102590CLR MODE COMP 'D' 61 AUTO-DUP ONLY PRKEY10002600CLRN60N61 GOTO CHKMOD NEW MODE PRKEY102610C* ********** PRKEY102620CLR EXSR GETPRG PRKEY102630C* ********** PRKEY102640CLR SETOF 6061 PRKEY102650CLR GOTO SAMREC PRKEY102660C* ********** PRKEY10002670CLR CHKNUM TAG PRKEY102680C* ********** PRKEY102690CLR SETON 26 A FLD HAS PRKEY102700C** BEEN ENTERED PRKEY102710CLR MOVELBUFFER MODE PRKEY102720CLR MODE COMP '@' 20 PRKEY102730CLRN20 GOTO NOAT PRKEY10002740C* ********** PRKEY102750CLR 64 GOTO NOAT PRKEY102760C* ********** PRKEY102770CLR SETON 30 30= '@' FLAG PRKEY102780CLR MOVELB72 BUFFER PRKEY102790CLR GOTO SVFLD PRKEY102800C* ********** PRKEY10002810CLR NOAT TAG PRKEY102820C* ********** PRKEY102830CLR SAN,N COMP 'N' 19 PRKEY102840CLRN19 GOTO CHKVER PRKEY102850C* ********** PRKEY102860CLR Z-ADDSLN,N VL 20 PRKEY102870CLR MOVELBUFFER VAR 15 PRKEY10002880CLR EXIT SUBRAJ PRKEY102890C* ********** PRKEY102900CLR RLABL VL PRKEY102910CLR RLABL VAR PRKEY102920CLR MOVELVAR BUFFER PRKEY102930CLR Z-ADDVL BLNGTH PRKEY102940CLR EXSR EXCPT PRKEY10002950C* ********** PRKEY102960CLR CHKVER TAG PRKEY102970C* ********** PRKEY102980CLR EXSR SKIP PRKEY102990CLR N64 GOTO MOVBUF PRKEY103000C* ********** PRKEY103010CLR TBUF COMP BUFFER 2020 PRKEY10003020CLRN20 GOTO MOVBUF PRKEY103030C* ********** PRKEY103040CLR MOVEL'KP VERIF'WORD PRKEY103050CLR MOVE 'Y ERROR 'WORD PRKEY103060CLR MOVELWORD BUFFER PRKEY103070CLR MOVE 'R' TYPE PRKEY103080CLR Z-ADD6 MASK ONLY 'R' OR 'E'PRKEY10003090CLR EXITFSUBRCM PRKEY103100CLR RLABL BUFFER 72 PRKEY103110CLR RLABL TYPE 1 PRKEY103120CLR RLABL BLNGTH 20 PRKEY103130CLR RLABL RCODE 1 PRKEY103140CLR RLABL MASK 10 PRKEY103150CLR RLABL DTYPE 10 PRKEY10003160C* ********** PRKEY103170CLR RCODE COMP 'R' 20 PRKEY103180CLR 20 GOTO OUTFLD PRKEY103190C* ********** PRKEY103200CLR MOVBUF TAG PRKEY103210C* ********** PRKEY103220CLR MOVE SEF,N EDCODE 2 PRKEY10003230CLR EDCODE COMP ' ' 2424 EDITING? PRKEY103240CLRN24 GOTO SVFLD PRKEY103250C* ********** PRKEY103260CLR SETOF 30 PRKEY103270CLR EXSR EDIT PRKEY103280C* ********** PRKEY103290CLRN30 GOTO SVFLD PRKEY10003300C* ********** PRKEY103310CLR SETOF 30 PRKEY103320CLR N SUB 1 N PRKEY103330CLR GOTO LOOP PRKEY103340C* ********** PRKEY103350CLR SVFLD TAG PRKEY103360C* ********** PRKEY10003370CLR MOVE '4' WHICH1 10 PRKEY103380CLR Z-ADDSST,N STRT 30 PRKEY103390CLR Z-ADDSLN,N LEN PRKEY103400CLR EXIT SUBRIN PRKEY103410CLR RLABL WHICH1 10 PRKEY103420CLR RLABL BUFFER 72 PRKEY103430CLR RLABL RECORD PRKEY10003440CLR RLABL BPOS 20 PRKEY103450CLR RLABL FPOS 20 PRKEY103460CLR RLABL STRT 30 PRKEY103470CLR RLABL LEN 20 PRKEY103480C* ********** PRKEY103490CLR GOTO LOOP PRKEY103500C* ********** PRKEY10003510CLR RITDUP TAG PRKEY103520C* ********** PRKEY103530CLR EXSR MVRECD PRKEY103540C* ********** PRKEY103550CLR SETON 19 PRKEY103560CLR Z-ADDSLN,N BLNGTH PRKEY103570CLR EXSR EXCPT PRKEY10003580C* ********** PRKEY103590CLR GOTO MOVBUF PRKEY103600C* ********** PRKEY103610CLR OUTREC TAG PRKEY103620C* ********** PRKEY103630CLR SETON 187084 PRKEY103640CLR EXCPT PRKEY10003650CLR EXSR EXCPT PRKEY103660C* ********** PRKEY103670CLR SETOF 708426 PRKEY103680CLR MOVELRECORD OLDREC128 PRKEY103690CLR SNP,PN COMP 0 22 AUTO PROGRAM PRKEY103700CLR N22 GOTO NXTREC CHANGE? PRKEY103710C* ********** PRKEY10003720CLR SNP,PN COMP 9 2222 CODE .,NEWPROG PRKEY103730CLR N22 EXSR GETPRG PRKEY103740C* ********** PRKEY103750CLR N22 GOTO NXTREC PRKEY103760C* ********** PRKEY103770CLR SNP,PN COMP 8 2222CODE=1-8, PRKEY103780CLR N22 GOTO NXTREC AUTO CHANGE PRKEY10003790C* ********** PRKEY103800CLR Z-ADDSNP,PN PN PRKEY103810CLR EXSR GETPRG PRKEY103820C* ********** PRKEY103830CLR SETOF 22 PRKEY103840CLR GOTO NXTREC PRKEY103850C* ********** PRKEY10003860CLR EOJ TAG PRKEY103870C* ********** PRKEY103880C********************************************************************PRKEY103890C********************************************************************PRKEY103900C* *PRKEY103910C* SUBROUTINE 'EDIT' PERFORMS CUSTOM EDITING. UPON ENTRY, THE *PRKEY103920C* EDIT FLAG IS IN 'EDCODE', THE PROGRAM NAME IS IN THE LEFT-MOST PRKEY10003930C* SIX CHARACTERS OF 'WORD', THE RESPONSE IS IN 'BUFFER'. PRKEY103940C* PRKEY103950C* INDICATOR 30 SHOULD BE SET ON BEFORE RETURNING IF YOU WANT THIS PRKEY103960C* FIELD TO BE RE-ENTERED. INDICATORS 31-59 MAY BE USED BY THIS SUBR.PRKEY103970C* PRKEY103980CSR EDIT BEGSR PRKEY103990C* ********** PRKEY10004000CSR EDCODE COMP 'YN' 31 'Y' OR 'N' PRKEY104010CSR 31 GOTO EYN PRKEY104020C* ********** PRKEY104030CSR EDCODE COMP 'DT' 31 PRKEY104040CSR 31 GOTO EDT PRKEY104050C* ********** PRKEY104060CSR EDCODE COMP 'EM' 31 PRKEY10004070CSR 31 GOTO EEM PRKEY104080C* ********** PRKEY104090CSR EDCODE COMP 'DP' 31 PRKEY104100CSR 31 GOTO EDP PRKEY104110C* ********** PRKEY104120CSR EDCODE COMP 'HD' 31 PRKEY104130CSR 31 GOTO EHD PRKEY10004140C* ********** PRKEY104150CSR EDCODE COMP 'DD' 31 PRKEY104160CSR 31 GOTO EDD PRKEY104170C* PRKEY104180CSR EDCODE COMP 'EB' 31 PRKEY104190CSR 31 GOTO EEB PRKEY104200C* ********** PRKEY10004210CSR EDCODE COMP 'T1' 31 PRKEY104220CSR 31 GOTO ET1 PRKEY104230C* ********** PRKEY104240CSR EDCODE COMP 'T2' 31 PRKEY104250CSR 31 GOTO ET2 PRKEY104260C* ********** PRKEY104270CSR EDCODE COMP 'T3' 31 PRKEY10004280CSR 31 GOTO ET3 PRKEY104290C* ********** PRKEY104300CSR EDCODE COMP 'HR' 31 PRKEY104310CSR 31 GOTO EHR PRKEY104320C* ********** PRKEY104330CSR MOVELWORD A6 6 PRKEY104340CSR A6 COMP 'DAYLAB' 31 PRKEY10004350CSR 31 GOTO DAYLAB PRKEY104360C* ********** PRKEY104370CSR A6 COMP 'DPXFRS' 31 PRKEY104380CSR 31 GOTO DPXFRS PRKEY104390C* ********** PRKEY104400CSR GOTO ENDEDT PRKEY104410C* ********** PRKEY10004420C** PRKEY104430CSR EYN TAG MUST BE 'Y' PRKEY104440C* ********** PRKEY104450CSR MOVELBUFFER A1 1 OR 'N'. PRKEY104460CSR A1 COMP 'Y' 32 PRKEY104470CSRN32 A1 COMP 'N' 32 PRKEY104480CSR 32 GOTO ENDEDT PRKEY10004490C* ********** PRKEY104500CSR Z-ADD1 NE 20 PRKEY104510C** PRKEY104520CSR ERREDT TAG DISPLAY ERROR PRKEY104530C* ********** PRKEY104540CSR MOVELEMS,NE BUFFER MESSAGE & PRKEY104550CSR Z-ADD30 BLNGTH RETRY. PRKEY10004560CSR MOVE 'T' TYPE PRKEY104570CSR EXITFSUBRCM PRKEY104580CSR RLABL BUFFER PRKEY104590CSR RLABL TYPE PRKEY104600CSR RLABL BLNGTH PRKEY104610CSR RLABL RCODE PRKEY104620CSR RLABL MASK PRKEY10004630CSR RLABL DTYPE PRKEY104640C* ********** PRKEY104650CSR SETON 30 PRKEY104660C* ********** PRKEY104670CSR GOTO ENDEDT PRKEY104680C* ********** PRKEY104690C** PRKEY10004700CSR EDT TAG VALIDATE PRKEY104710C* ********** PRKEY104720CSR MOVELBUFFER A6 DATE. PRKEY104730CSR MOVELA6 MM 20 00' IN PRKEY106400C* BYTES 1-2. IF NO SUCH RECORD IS FOUND, PROGRAM ENDS. PRKEY106410C* PRKEY106420CSR SEQ1ST BEGSR PRKEY106430C* ********** PRKEY106440CSR Z-ADD1 SEQNO PRKEY10006450CSR SQLOOP TAG PRKEY106460C* ********** PRKEY106470CSR SEQNO CHAINPRINPT 86 PRKEY106480CSR N86 RC COMP '<>' 85 PRKEY106490CSR N85N86SEQNO ADD 1 SEQNO PRKEY106500CSR N85N86 GOTO SQLOOP PRKEY106510C* ********** PRKEY10006520CSR MOVELMSG,5 A21 21 PRKEY106530CSR Z-ADD21 BLNGTH PRKEY106540CSR MOVE SEQNO A21 PRKEY106550CSR 86 MOVE '*NONE*' A21 PRKEY106560CSR MOVELA21 BUFFER PRKEY106570CSR EXSR EXCPT PRKEY106580C* ********** PRKEY10006590CSR MOVELB72 BUFFER PRKEY106600CSR ENDSR PRKEY106610C********************************************************************PRKEY106620C* PRKEY106630C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION PRKEY106640C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. PRKEY106650C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. PRKEY10006660C* IF 22 IS ON, THIS IS AN AUTOMATIC CHANGE TO PROG# IN 'PN'. PRKEY106670C* IF 22 IS ON, THIS IS AN AUTOMATIC PROG CHANGE TO PROG# IN 'PN'. PRKEY106680C* IF 26 IS ON, THIS IS AN INITIAL PROG LOAD FROM 'DUMMY' RECORD. PRKEY106690C* PRKEY106700C********************************************************************PRKEY106710CSR GETPRG BEGSR PRKEY106720C* ********** PRKEY10006730CSR 61 GOTO JMPOUT PRKEY106740C* ********** PRKEY106750CSR 22 GOTO GTPTG1 PRKEY106760C* ********** PRKEY106770CSR 26 GOTO CHNPRG PRKEY106780C* ********** PRKEY106790CSR MOVE B72 OLDREC PRKEY10006800CSR MOVELB72 OLDREC PRKEY106810CSR GETPNO TAG PRKEY106820C* ********** PRKEY106830CSR MOVEL'PROG # -'WORD PRKEY106840CSR Z-ADD8 OLN PRKEY106850CSR Z-ADD1 ILN PRKEY106860CSR EXSR TYPES PRKEY10006870C* ********** PRKEY106880CSR MOVELBUFFER PN 10 PRKEY106890CSR PN COMP 0 2020 PRKEY106900CSR N20 PN COMP 8 20 BAD PROG# PRKEY106910CSR 20 SETON 82 PRKEY106920CSR 82 EXSR EXCPT PRKEY106930C* ********** PRKEY10006940CSR SETOF 82 PRKEY106950CSR 20 GOTO GETPNO TRY PROG# AGAINPRKEY106960C* ********** PRKEY106970CSR GTPTG1 TAG PRKEY106980C* ********** PRKEY106990CSR MOVE PN NAME10 10 PRKEY107000CSR N65 SNM,PN COMP ' ' 6060 PRKEY10007010CSR 60 PN SUB 1 BP 30 PRKEY107020CSR 60 BP MULT NFLDS BP PRKEY107030CSR 60 GOTO JMPOUT PRKEY107040C* ********** PRKEY107050CSR GETPNM TAG PRKEY107060C* ********** PRKEY107070CSR MOVEL'PROG NAM'WORD PRKEY10007080CSR MOVE 'E - 'WORD PRKEY107090CSR Z-ADD11 OLN PRKEY107100CSR Z-ADD6 ILN PRKEY107110CSR EXSR TYPES PRKEY107120C* ********** PRKEY107130CSR MOVELBUFFER PNAME 8 PRKEY107140CSR MOVE ' ' PNAME PRKEY10007150CSR CHNPRG TAG PRKEY107160C* ********** PRKEY107170CSR PNAME CHAINKPROGX 27 PRKEY107180CSRN27 MOVELPNAME SNM,PN PRKEY107190CSRN27 GOTO LOADIT PRKEY107200C* ********** PRKEY107210CSR MOVEL' 'WORD PRKEY10007220CSR MOVELPNAME WORD PRKEY107230CSR MOVE 'ABSENT 'WORD PRKEY107240CSR MOVE 'R' TYPE PRKEY107250CSR MOVELWORD BUFFER PRKEY107260CSR Z-ADD7 MASK 10 PRKEY107270CSR Z-ADD16 BLNGTH PRKEY107280CSR EXITFSUBRCM PRKEY10007290CSR RLABL BUFFER 72 PRKEY107300CSR RLABL TYPE 1 PRKEY107310CSR RLABL BLNGTH 20 PRKEY107320CSR RLABL RCODE 1 PRKEY107330CSR RLABL MASK 10 PRKEY107340CSR RLABL DTYPE 10 PRKEY107350C* ********** PRKEY10007360CSR RCODE COMP 'E' 20 PRKEY107370C*R 20 EXSR PROGMT PRKEY107380C*R 20 GOTO CHNPRG PRKEY107390CSRN20 GOTO GETPNM PRKEY107400CSR MOVE 'F' TYPE PRKEY107410CSR EXITFSUBRCM PRKEY107420CSR RLABL BUFFER PRKEY10007430CSR RLABL TYPE PRKEY107440CSR RLABL BLNGTH PRKEY107450CSR RLABL RCODE PRKEY107460CSR RLABL MASK PRKEY107470CSR RLABL DTYPE PRKEY107480C* ********** PRKEY107490CSR LOADIT TAG PRKEY10007500C* ********** PRKEY107510CSR PN SUB 1 BP PRKEY107520CSR BP MULT NFLDS BP PRKEY107530CSR BP ADD 1 N PRKEY107540CSR Z-ADD1 X 20 PRKEY107550CSR BLDARY TAG PRKEY107560C* ********** PRKEY10007570CSR FN COMP B72 20 PRKEY107580CSR 20 N SUB 1 MAXFLD 30 PRKEY107590CSR 20 MOVE MAXFLD SMX,PN PRKEY107600CSR 20 GOTO JMPOUT PRKEY107610C* ********** PRKEY107620CSR MOVE FN SFN,N FIELD NAME PRKEY107630CSR MOVE AN SAN,N ALPHA OR NUMER PRKEY10007640CSR MOVE AD SAD,N AUTO DUP PRKEY107650CSR MOVE ST SST,N START POSITION PRKEY107660CSR MOVE LN SLN,N PRKEY107670CSR MOVE EF SEF,N PRKEY107680CSR MOVE GP SGP,N PRKEY107690CSR MOVE NPL SNP,PN PRKEY107700CSR MVX TAG PRKEY10007710C* ********** PRKEY107720CSR MOVE X PNAME PRKEY107730CSR PNAME CHAINKPROGX 20 PRKEY107740CSR X ADD 1 X PRKEY107750CSRN20 X COMP NFLDS 20 PRKEY107760CSR 20 Z-ADDN MAXFLD PRKEY107770CSR 20 MOVE MAXFLD SMX,PN PRKEY10007780CSR DCODE COMP 'D' 21 PRKEY107790CSR 21N20 GOTO MVX PRKEY107800C* ********** PRKEY107810CSRN20 N ADD 1 N PRKEY107820CSRN20 GOTO BLDARY PRKEY107830C* ********** PRKEY107840CSR JMPOUT TAG PRKEY10007850C* ********** PRKEY107860CSR 65 GOTO ENDGET PRKEY107870C* ********** PRKEY107880CSR 63 GOTO SETHED PRKEY107890C* ********** PRKEY107900CSR 26 MOVE 'N' AUTO PRKEY107910CSR 26 PRKEY10007920COR 22 GOTO GTPTG2 PRKEY107930C* ********** PRKEY107940CSR MOVEL'AUTO-DUP'WORD PRKEY107950CSR MOVE ' - 'WORD PRKEY107960CSR Z-ADD11 OLN PRKEY107970CSR Z-ADD1 ILN PRKEY107980CSR EXSR TYPES PRKEY10007990C* ********** PRKEY108000CSR MOVELBUFFER AUTO 1 PRKEY108010CSR GTPTG2 TAG PRKEY108020C* ********** PRKEY108030CSR AUTO COMP 'O' 90AUTO-DUP ON PRKEY108040CSR SETHED TAG PRKEY108050C* ********** PRKEY10008060CSR MOVELSNM,PN NAME10 PRKEY108070CSR MOVELNAME10 WORD PRKEY108080CSR MOVE SMX,PN MAXFLD PRKEY108090CSR 90 MOVE ' ON' WORD PRKEY108100CSRN90 MOVE 'OFF' WORD PRKEY108110CSR MOVELWORD HEAD 40 PRKEY108120CSR ENDGET ENDSR PRKEY10008130C* ********** PRKEY108140C********************************************************************PRKEY108150C* PRKEY108160C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST PRKEY108170C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE PRKEY108180C* CHANGED PRKEY108190C* PRKEY10008200C********************************************************************PRKEY108210CSR GETSEQ BEGSR PRKEY108220C* ********** PRKEY108230CSR MOVEL'SEQ # - 'WORD PRKEY108240CSR Z-ADD8 OLN PRKEY108250CSR Z-ADD4 ILN PRKEY108260CSR EXSR TYPES PRKEY10008270C* ********** PRKEY108280CSR Z-ADD4 VL PRKEY108290CSR MOVELBUFFER VAR PRKEY108300CSR EXIT SUBRAJ PRKEY108310CSR RLABL VL 20 PRKEY108320CSR RLABL VAR 15 PRKEY108330C* ********** PRKEY10008340CSR MOVELVAR SEQNO PRKEY108350CSR SEQNO COMP 0 20 PRKEY108360CSRN20 Z-ADD1 SEQNO PRKEY108370CSR SETON 95 PRKEY108380CSR ENDSR PRKEY108390C********************************************************************PRKEY108400C* PRKEY10008410C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO PRKEY108420C* PRKEY108430C********************************************************************PRKEY108440CSR GETREC BEGSR PRKEY108450C* ********** PRKEY108460CSR SEQRD TAG PRKEY108470C* ********** PRKEY10008480CSR SEQNO CHAINPRINPT 67 PRKEY108490CSR 67 SETON 88 PRKEY108500CSR 88 EXSR EXCPT PRKEY108510C* ********** PRKEY108520CSR SETOF 88 PRKEY108530CSR 67 EXSR GETSEQ PRKEY108540C* ********** PRKEY10008550CSR 67 GOTO SEQRD PRKEY108560C* ********** PRKEY108570CSR ENDSR PRKEY108580C********************************************************************PRKEY108590C* PRKEY108600C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY PRKEY108610C* IS DONE IF A RUBOUT IS USED PRKEY10008620C* PRKEY108630C********************************************************************PRKEY108640CSR TYPES BEGSR PRKEY108650C* ********** PRKEY108660CSR OVER TAG PRKEY108670C* ********** PRKEY108680CSR Z-ADDOLN BLNGTH PRKEY10008690CSR MOVELWORD BUFFER PRKEY108700CSR MOVE 'S' TYPE PRKEY108710CSR EXITFSUBRCM PRKEY108720CSR RLABL BUFFER 72 PRKEY108730CSR RLABL TYPE 1 PRKEY108740CSR RLABL BLNGTH 20 PRKEY108750CSR RLABL RCODE 1 PRKEY10008760CSR RLABL MASK 10 PRKEY108770CSR RLABL DTYPE 10 PRKEY108780C* ********** PRKEY108790CSR MOVE 'A' TYPE PRKEY108800CSR Z-ADDILN BLNGTH PRKEY108810CSR EXITFSUBRCM PRKEY108820CSR RLABL BUFFER 72 PRKEY10008830CSR RLABL TYPE 1 PRKEY108840CSR RLABL BLNGTH 20 PRKEY108850CSR RLABL RCODE 1 PRKEY108860CSR RLABL MASK 10 PRKEY108870CSR RLABL DTYPE 10 PRKEY108880C* ********** PRKEY108890CSR RCODE COMP 'R' 25 PRKEY10008900CSR 25 EXSR SKIP PRKEY108910C* ********** PRKEY108920CSR 25 GOTO OVER PRKEY108930C* ********** PRKEY108940CSR RCODE COMP 'O' 25 PRKEY108950CSR 25 EXSR SKIP PRKEY108960C* ********** PRKEY10008970CSR ENDSR PRKEY108980C********************************************************************PRKEY108990C* PRKEY109000C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT PRKEY109010C* PRKEY109020C********************************************************************PRKEY109030CSR SKIP BEGSR PRKEY10009040C* ********** PRKEY109050CSR MOVELBUFFER NBUF 1 PRKEY109060CSR MOVEL' ' BUFFER PRKEY109070CSR Z-ADD1 BLNGTH PRKEY109080CSR MOVE 'T' TYPE PRKEY109090CSR EXITFSUBRCM PRKEY109100CSR RLABL BUFFER 72 PRKEY10009110CSR RLABL TYPE 1 PRKEY109120CSR RLABL BLNGTH 20 PRKEY109130CSR RLABL RCODE 1 PRKEY109140CSR RLABL MASK 10 PRKEY109150CSR RLABL DTYPE 10 PRKEY109160C* ********** PRKEY109170CSR MOVELNBUF BUFFER PRKEY10009180CSR ENDSR PRKEY109190C********************************************************************PRKEY109200C* PRKEY109210C* PRKEY109220C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED PRKEY109230C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER PRKEY109240C* PRKEY10009250CSR MVRECD BEGSR PRKEY109260C* ********** PRKEY109270CSR MOVELB72 BUFFER PRKEY109280CSR MOVE '2' WHICH1 PRKEY109290CSR Z-ADDSST,N STRT PRKEY109300CSR Z-ADD1 FPOS PRKEY109310CSR Z-ADDSLN,N LEN 20 PRKEY10009320CSR EXIT SUBRIN PRKEY109330CSR RLABL WHICH1 10 PRKEY109340CSR RLABL BUFFER 72 PRKEY109350CSR RLABL RECORD PRKEY109360CSR RLABL BPOS 20 PRKEY109370CSR RLABL FPOS 20 PRKEY109380CSR RLABL STRT 30 PRKEY10009390CSR RLABL LEN 20 PRKEY109400CSR ENDSR PRKEY109410C********************************************************************PRKEY109420CSR EXCPT BEGSR PRKEY109430C* ********** PRKEY109440CSRN81N82N83 PRKEY109450CANN84N88 GOTO PUTOUT PRKEY10009460C* ********** PRKEY109470CSR MOVELB72 BUFFER PRKEY109480CSR 81 MOVELMSG,1 BUFFER PRKEY109490CSR 83 MOVELMSG,2 BUFFER PRKEY109500CSR 88 MOVELMSG,3 BUFFER PRKEY109510CSR 82 MOVELMSG,4 BUFFER PRKEY109520CSRN84 GOTO PUTOUT PRKEY10009530C* ********** PRKEY109540CSR MOVELSFN,N BUFFER PRKEY109550CSRN18 SETON 19 PRKEY109560CSRN18 Z-ADD20 BLNGTH PRKEY109570CSRN18 GOTO PUTOUT PRKEY109580C* ********** PRKEY109590CSR MOVE HEAD BUFFER PRKEY10009600CSR MOVELSEQNO WORD8 8 PRKEY109610CSR MOVE WORD8 BUFFER PRKEY109620CSR PUTOUT TAG PRKEY109630C* ********** PRKEY109640CSR MOVE 'T' TYPE PRKEY109650CSRN19 Z-ADD69 BLNGTH PRKEY109660CSR SETOF 19 PRKEY10009670CSR EXITFSUBRCM PRKEY109680CSR RLABL BUFFER 72 PRKEY109690CSR RLABL TYPE 1 PRKEY109700CSR RLABL BLNGTH 20 PRKEY109710CSR RLABL RCODE 1 PRKEY109720CSR RLABL MASK 10 PRKEY109730CSR RLABL DTYPE 10 PRKEY10009740C* ********** PRKEY109750CSR ENDSR PRKEY109760C* PRKEY109770CSR CLRSCR BEGSR PRKEY109780CSR MOVE 'C' TYPE PRKEY109790CSR EXITFSUBRCM PRKEY109800CSR RLABL BUFFER PRKEY10009810CSR RLABL TYPE PRKEY109820CSR RLABL BLNGTH PRKEY109830CSR RLABL RCODE PRKEY109840CSR RLABL MASK PRKEY109850CSR RLABL DTYPE PRKEY109860CSR ENDSR PRKEY109870C********************************************************************PRKEY10009880OPRINPT E 70N67 PRKEY109890O RECORD 128 PRKEY109900O 64 128 'X' PRKEY109910O SEQNO 127 PRKEY109920O E 71 PRKEY109930O 19 'X' PRKEY1** 00994000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 009950ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 009960ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 009970ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 009980ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 009990** 010000MODE MUST BE A,C,V,OR E 01001000FIRST FIELD NAME BLANK 010020INVALID SEQ # 010030PROG# MUST BE FROM 1-8 0100401ST AVAIL SEQ#= 010050** 010060# MUST BE 'Y' OR 'N' * 010070# INVALID DATE * 01008000# INVALID DEPT/EMP * 010090# LAST NAME DOES NOT BEGIN- 010100# WRONG TYPE.MUST BE (RSHV)* 010110# EMPLOYEE IS EXEMPT FROM O.T. 010120# NEW DEPT/EMP ALREADY ON FILE 010130# BOOK NUMBER INVALID 010140# G/L ACCT NUMBER INVALID 01015000# DED TYPE MUST BE 01-13. 010160/* 010170__ONG TYPE.MUST BE (RSHV)* 010110# EMPLOYEE IS EXEMPT FROM O.T. 010120# NEW DEPT/EMP ALREADY ON FILE 010130# BOOK NUMBER INVALID 010140# G/L ACCT NUMBER INVALID 0101500(Lfx TXPRKEY2 P999999111111(000010H S PRKEY200020X DECK-ID B32 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRKEY200030F* DATA ENTRY PROGRAM FOR TO-BE-PAID TRANSACTIONS PRKEY200040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRKEY200050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRKEY200060F* CONTROL DATA PROPRIETARY PRODUCT PRKEY200070F* PRKEY20000080F* PRKEY200090F* ************************** PRKEY200100F* * ************************************************* * PRKEY200110F* * * * * PRKEY200120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRKEY200130F* * * * * PRKEY200140F* * ************************************************* * PRKEY20000150F* *************************************************************** PRKEY200160F* PRKEY200170F****************************************************************** PRKEY200180F* PRKEY200190F* THIS IS A MODIFICATION OF 'KEYPCH' WHICH ALLOWS: PRKEY200200F* 1) AUTOMATIC PROGRAM LEVEL SWITCHING, PRKEY200210F* 2) GANG-PUNCH FIELDS (CONSTANT INSERTION), PRKEY20000220F* 3) EDIT FLAGGING OF FILEDS FOR PORCESSING BY SUBROUTINE PRKEY200230F* 'EDIT' INTERNAL TO THIS PROGRAM. PRKEY200240F* 4) EIGHT PORGRAM LEVELS. PRKEY200250F* 5) AUTOMATIC LOADING OF THE 8 LEVELS BASED ON THE 1ST RECORD PRKEY200260F* IN THE FILE 'DUMMY'. (BYTES 1-48 CONTAIN THE NAMES). PRKEY200270F* 6) IF MODE IS 'A', THE STARTING SEQ# WILL AUTOMATICALLY BE THE PRKEY200280F* FIRST RECORD WITH '<>' IN BYTES 1-2. PRKEY20000290F* PRKEY200300F* MODIFIED 07/09/76 TO CORRECT A PROBLEM IN BATCH TOTAL. ('EB') PRKEY200310F* PRKEY200320F* PRKEY200330F********************************************************************PRKEY200340FPENDUM IPEAF 36 DISK PRKEY200350FKPROGX IC F 40R 8AI 1 DISK PRKEY20000360FPRINPT UC F 128R DISK PRKEY200370F****************************************************************** PRKEY200380F* THE FILES BELOW ARE USED STRICTLY FOR EDITING. PRKEY200390FPRMAST IC F 600R10AI 2 DISK PRKEY200400F* PRKEY200410F* PRKEY200420F* PRKEY20000430F********************************************************************PRKEY200440E MSG 1 5 25 PRKEY200450E SFN 200 20 FIELD NAMES. PRKEY200460E SAN 200 1 ALPH OR NUM PRKEY200470E SAD 200 1 AUTO DUP FLAGS PRKEY200480E SST 200 3 0 FIELD START PRKEY200490E SLN 200 2 0 FIELD LENGTHS PRKEY20000500E SEF 200 2 EDIT FLAGS PRKEY200510E SGP 200 1 GANG PUNCH FLGS PRKEY200520E SNP 8 1 0 NEXT PROG# PRKEY200530E SNM 8 6 PROG NAMES PRKEY200540E SMX 8 3 0 MAX FLDS PRKEY200550E EMS 1 10 30 EDIT MESSAGES PRKEY200560IPENDUM NS 01 PRKEY20000570I 1 36 SNM PRKEY200580IKPROGX NS 02 36NCD PRKEY200590I 9 28 FN PRKEY200600I 29 29 AN PRKEY200610I 30 30 AD PRKEY200620I 31 33 ST PRKEY200630I 34 35 LN PRKEY20000640I 36 36 DCODE PRKEY200650I 37 37 NPL PRKEY200660I 38 38 GP PRKEY200670I 39 40 EF PRKEY200680I NS 03 PRKEY200690I 1 1 A PRKEY200700IPRINPT NS 05 PRKEY20000710I 1 2 RC PRKEY200720I 1 128 RECORD PRKEY200730I****************************************************************** PRKEY200740I* INPUT SPECS FOR EDITING FILES ARE LISTED BELOW. PRKEY200750IPRMAST NS 06 PRKEY200760I 14 16 DN3 PRKEY200770I 132 132 YTYPE PRKEY20000780C* PRKEY200790C* PRKEY200800C* PRKEY200810C MOVE ' ' B72 72 PRKEY200820C Z-ADD25 NFLDS 20 PRKEY200830C Z-ADD1 PN LOAD INITIAL PRKEY200840C LDLOOP TAG PROGS FROM 1STPRKEY20000850C* ********** PRKEY200860C SNM,PN COMP ' ' 2626 48 BYTES OF PRKEY200870C MOVELSNM,PN PNAME PRKEY200880C MOVE ' ' PNAME PRKEY200890C 26 EXSR GETPRG 'DUMMY' REC. PRKEY200900C* ********** PRKEY200910C PN ADD 1 PN PRKEY20000920C PN COMP 8 2626 PRKEY200930C 26 GOTO LDLOOP PRKEY200940C* ********** PRKEY200950C NLR SETON LR PRKEY200960CLR MOVE '1' RTNLVL 10 PRKEY200970CLR MOVE '1' TERMNL 10 PRKEY200980CLR START TAG PRKEY20000990C* ********** PRKEY201000CLR EXSR CLRSCR PRKEY201010CLR MOVEL'>MODE-' WORD 16 PRKEY201020CLR Z-ADD6 OLN 20 PRKEY201030CLR Z-ADD1 ILN 20 PRKEY201040CLR EXSR TYPES PRKEY201050C* ********** PRKEY20001060CLR MOVELNBUF MODE 1 PRKEY201070CLR CHKMOD TAG PRKEY201080C* ********** PRKEY201090CLR SETOF 9095 PRKEY201100CLR MODE COMP 'A' 62 PRKEY201110CLR MODE COMP 'C' 63 PRKEY201120CLR MODE COMP 'V' 64 PRKEY20001130CLR MODE COMP 'K' 65 PRKEY201140CLR MODE COMP 'E' 66 PRKEY201150CLR 66 GOTO EOJ PRKEY201160C* ********** PRKEY201170CLR 65 EXSR GETPRG PRKEY201180C* ********** PRKEY201190CLR 65 GOTO START PRKEY20001200C* ********** PRKEY201210CLRN62N63N64 SETON 81 PRKEY201220CLR 81 EXSR EXCPT PRKEY201230C* ********** PRKEY201240CLR SETOF 81 PRKEY201250CLRN62N63N64 GOTO START PRKEY201260C* ********** PRKEY20001270CLR EXSR GETPRG PRKEY201280C* ********** PRKEY201290CLRN63N95N62 EXSR GETSEQ PRKEY201300C* ********** PRKEY201310CLR 62 EXSR SEQ1ST PRKEY201320C* ********** PRKEY201330CLR 86 GOTO EOJ PRKEY20001340C* ********** PRKEY201350CLR SAMREC TAG PRKEY201360C* ********** PRKEY201370CLR SEQNO SUB 1 SEQNO 40 PRKEY201380CLR NXTREC TAG PRKEY201390CLR EXSR CLRSCR PRKEY201400C* ********** PRKEY20001410CLR SETOF 2630 26=1ST FLD FLG PRKEY201420CLR SETON 18 PRKEY201430CLR 63 EXSR GETSEQ PRKEY201440C* ********** PRKEY201450CLRN63 SEQNO ADD 1 SEQNO PRKEY201460CLR EXSR GETREC PRKEY201470C* ********** PRKEY20001480CLR 62 MOVE OLDREC RECORD PRKEY201490CLR Z-ADDBP N 30 PRKEY201500CLR LOOP TAG PRKEY201510C* ********** PRKEY201520CLR 27 28 90N SUB 2 N PRKEY201530CLR N COMP BP 2920 PRKEY201540CLR 20 GOTO NXTMOD PRKEY20001550C* ********** PRKEY201560CLR N ADD 1 N PRKEY201570CLR N COMP MAXFLD 20 PRKEY201580CLR 20N29 SETON 83 NO FIELDS PRKEY201590CLR 83 EXSR EXCPT PRKEY201600C* ********** PRKEY201610CLR SETOF 83 PRKEY20001620CLR 20N29 GOTO START PRKEY201630C* ********** PRKEY201640CLR 20 GOTO OUTREC PRKEY201650C* ********** PRKEY201660C** 30 HERE MEANS '@' ON PRIOR FIELD FOR THIS RECORD. PRKEY201670CLR 30 GOTO SVFLD PRKEY201680C* ********** PRKEY20001690C** PRKEY201700CLR SGP,N COMP ' ' 2323 GANG PUNCH? PRKEY201710CLR N23 GOTO CHKAD PRKEY201720C* ********** PRKEY201730CLR MOVELSFN,N BUFFER YES... PRKEY201740CLR Z-ADDSLN,N BLNGTH PUT 1ST LN PRKEY201750CLR EXSR EXCPT CHARS OF FIELDPRKEY20001760C* ********** PRKEY201770CLR EXSR SKIP IN BUFFER. PRKEY201780C* ********** PRKEY201790CLR MOVE 'O' RCODE PRKEY201800CLR GOTO CHKVER PRKEY201810C* ********** PRKEY201820CLR CHKAD TAG PRKEY20001830C* ********** PRKEY201840CLR SAD,N COMP 'D' 27 PRKEY201850CLR 27 62 90 PRKEY201860COR 27 64 90 GOTO LOOP PRKEY201870C* ********** PRKEY201880CLR 62 GOTO SKIPMV PRKEY201890C* ********** PRKEY20001900CLR EXSR MVRECD PRKEY201910C* ********** PRKEY201920CLR MOVE BUFFER TBUF 72 PRKEY201930CLR SKIPMV TAG PRKEY201940C* ********** PRKEY201950CLR OUTFLD TAG PRKEY201960C* ********** PRKEY20001970CLR N DIV 25 P 30 PRKEY201980CLR MVR R 20 PRKEY201990CLR R COMP 0 98 PRKEY202000CLR 98 GOTO BYPSS PRKEY202010CLR R DIV 5 P PRKEY202020CLR MVR R PRKEY202030CLR EXSR SKIP PRKEY20002040CLR R COMP 0 99 PRKEY202050CLR 99 EXSR CLRSCR PRKEY202060CLR BYPSS TAG PRKEY202070CLR SETOF 9899 PRKEY202080CLR SETON 84 OUTPUT FIELD PRKEY202090CLR EXSR EXCPT NAME PRKEY202100C* ********** PRKEY20002110CLR SETOF 8418 PRKEY202120CLR MOVE SLN,N BLNGTH PRKEY202130CLR SETON 19 PRKEY202140CLR MOVE TBUF BUFFER PRKEY202150CLR EXSR EXCPT PRKEY202160C* ********** PRKEY202170CLR SETOF 2728 PRKEY20002180CLR MOVE B72 BUFFER PRKEY202190CLR MOVE 'A' TYPE 1 PRKEY202200CLR Z-ADDSLN,N BLNGTH 20 PRKEY202210CLR EXITFSUBRCM PRKEY202220CLR RLABL BUFFER 72 PRKEY202230CLR RLABL TYPE 1 PRKEY202240CLR RLABL BLNGTH 20 PRKEY20002250CLR RLABL RCODE 1 PRKEY202260CLR RLABL MASK 10 PRKEY202270CLR RLABL DTYPE 10 PRKEY202280CLR RCODE COMP 'O' 20 PRKEY202290CLR 20 EXSR SKIP PRKEY202300C* ********** PRKEY202310CLR RCODE COMP 'L' 20 PRKEY20002320CLR 20 GOTO RITDUP PRKEY202330C* ********** PRKEY202340CLR RCODE COMP 'R' 20 PRKEY202350CLR 20 BUFFER COMP B72 21 PRKEY202360CLR 20N21 EXSR SKIP PRKEY202370C* ********** PRKEY202380CLR 20N21 N SUB 1 N PRKEY20002390CLR 20 21 N SUB 2 N 28 28 PRKEY202400CLRN20 GOTO CHKNUM PRKEY202410C* ********** PRKEY202420CLR N21 GOTO LOOP PRKEY202430C* ********** PRKEY202440CLR 21N26 GOTO NXTMOD RUB ON 1ST PRKEY202450C* ********** PRKEY20002460CLR GOTO LOOP PRKEY202470C* ********** PRKEY202480CLR NXTMOD TAG PRKEY202490C* ********** PRKEY202500CLR EXSR SKIP PRKEY202510CLR SETOF 28 PRKEY202520CLR MOVEL'MODE ' WORD PRKEY20002530CLR Z-ADD5 OLN PRKEY202540CLR Z-ADD1 ILN PRKEY202550CLR EXSR TYPES PRKEY202560C* ********** PRKEY202570CLR MOVELBUFFER MODE PRKEY202580CLR MODE COMP 'P' 60 NEW PROG#ONLY PRKEY202590CLR MODE COMP 'D' 61 AUTO-DUP ONLY PRKEY20002600CLRN60N61 GOTO CHKMOD NEW MODE PRKEY202610C* ********** PRKEY202620CLR EXSR GETPRG PRKEY202630C* ********** PRKEY202640CLR SETOF 6061 PRKEY202650CLR GOTO SAMREC PRKEY202660C* ********** PRKEY20002670CLR CHKNUM TAG PRKEY202680C* ********** PRKEY202690CLR SETON 26 A FLD HAS PRKEY202700C** BEEN ENTERED PRKEY202710CLR MOVELBUFFER MODE PRKEY202720CLR MODE COMP '@' 20 PRKEY202730CLRN20 GOTO NOAT PRKEY20002740C* ********** PRKEY202750CLR 64 GOTO NOAT PRKEY202760C* ********** PRKEY202770CLR SETON 30 30= '@' FLAG PRKEY202780CLR MOVELB72 BUFFER PRKEY202790CLR GOTO SVFLD PRKEY202800C* ********** PRKEY20002810CLR NOAT TAG PRKEY202820C* ********** PRKEY202830CLR SAN,N COMP 'N' 19 PRKEY202840CLRN19 GOTO CHKVER PRKEY202850C* ********** PRKEY202860CLR Z-ADDSLN,N VL 20 PRKEY202870CLR MOVELBUFFER VAR 15 PRKEY20002880CLR EXIT SUBRAJ PRKEY202890C* ********** PRKEY202900CLR RLABL VL PRKEY202910CLR RLABL VAR PRKEY202920CLR MOVELVAR BUFFER PRKEY202930CLR Z-ADDVL BLNGTH PRKEY202940CLR EXSR EXCPT PRKEY20002950C* ********** PRKEY202960CLR CHKVER TAG PRKEY202970C* ********** PRKEY202980CLR EXSR SKIP PRKEY202990CLR N64 GOTO MOVBUF PRKEY203000C* ********** PRKEY203010CLR TBUF COMP BUFFER 2020 PRKEY20003020CLRN20 GOTO MOVBUF PRKEY203030C* ********** PRKEY203040CLR MOVEL'KP VERIF'WORD PRKEY203050CLR MOVE 'Y ERROR 'WORD PRKEY203060CLR MOVELWORD BUFFER PRKEY203070CLR MOVE 'R' TYPE PRKEY203080CLR Z-ADD6 MASK ONLY 'R' OR 'E'PRKEY20003090CLR EXITFSUBRCM PRKEY203100CLR RLABL BUFFER 72 PRKEY203110CLR RLABL TYPE 1 PRKEY203120CLR RLABL BLNGTH 20 PRKEY203130CLR RLABL RCODE 1 PRKEY203140CLR RLABL MASK 10 PRKEY203150CLR RLABL DTYPE 10 PRKEY20003160C* ********** PRKEY203170CLR RCODE COMP 'R' 20 PRKEY203180CLR 20 GOTO OUTFLD PRKEY203190C* ********** PRKEY203200CLR MOVBUF TAG PRKEY203210C* ********** PRKEY203220CLR MOVE SEF,N EDCODE 2 PRKEY20003230CLR EDCODE COMP ' ' 2424 EDITING? PRKEY203240CLRN24 GOTO SVFLD PRKEY203250C* ********** PRKEY203260CLR SETOF 30 PRKEY203270CLR EXSR EDIT PRKEY203280C* ********** PRKEY203290CLRN30 GOTO SVFLD PRKEY20003300C* ********** PRKEY203310CLR SETOF 30 PRKEY203320CLR N SUB 1 N PRKEY203330CLR GOTO LOOP PRKEY203340C* ********** PRKEY203350CLR SVFLD TAG PRKEY203360C* ********** PRKEY20003370CLR MOVE '4' WHICH1 10 PRKEY203380CLR Z-ADDSST,N STRT 30 PRKEY203390CLR Z-ADDSLN,N LEN PRKEY203400CLR EXIT SUBRIN PRKEY203410CLR RLABL WHICH1 10 PRKEY203420CLR RLABL BUFFER 72 PRKEY203430CLR RLABL RECORD PRKEY20003440CLR RLABL BPOS 20 PRKEY203450CLR RLABL FPOS 20 PRKEY203460CLR RLABL STRT 30 PRKEY203470CLR RLABL LEN 20 PRKEY203480C* ********** PRKEY203490CLR GOTO LOOP PRKEY203500C* ********** PRKEY20003510CLR RITDUP TAG PRKEY203520C* ********** PRKEY203530CLR EXSR MVRECD PRKEY203540C* ********** PRKEY203550CLR SETON 19 PRKEY203560CLR Z-ADDSLN,N BLNGTH PRKEY203570CLR EXSR EXCPT PRKEY20003580C* ********** PRKEY203590CLR GOTO MOVBUF PRKEY203600C* ********** PRKEY203610CLR OUTREC TAG PRKEY203620C* ********** PRKEY203630CLR SETON 187084 PRKEY203640CLR EXCPT PRKEY20003650CLR EXSR EXCPT PRKEY203660C* ********** PRKEY203670CLR SETOF 708426 PRKEY203680CLR MOVELRECORD OLDREC128 PRKEY203690CLR SNP,PN COMP 0 22 AUTO PROGRAM PRKEY203700CLR N22 GOTO NXTREC CHANGE? PRKEY203710C* ********** PRKEY20003720CLR SNP,PN COMP 9 2222 CODE .,NEWPROG PRKEY203730CLR N22 EXSR GETPRG PRKEY203740C* ********** PRKEY203750CLR N22 GOTO NXTREC PRKEY203760C* ********** PRKEY203770CLR SNP,PN COMP 8 2222CODE=1-8, PRKEY203780CLR N22 GOTO NXTREC AUTO CHANGE PRKEY20003790C* ********** PRKEY203800CLR Z-ADDSNP,PN PN PRKEY203810CLR EXSR GETPRG PRKEY203820C* ********** PRKEY203830CLR SETOF 22 PRKEY203840CLR GOTO NXTREC PRKEY203850C* ********** PRKEY20003860CLR EOJ TAG PRKEY203870C* ********** PRKEY203880C********************************************************************PRKEY203890C********************************************************************PRKEY203900C* *PRKEY203910C* SUBROUTINE 'EDIT' PERFORMS CUSTOM EDITING. UPON ENTRY, THE *PRKEY203920C* EDIT FLAG IS IN 'EDCODE', THE PROGRAM NAME IS IN THE LEFT-MOST PRKEY20003930C* SIX CHARACTERS OF 'WORD', THE RESPONSE IS IN 'BUFFER'. PRKEY203940C* PRKEY203950C* INDICATOR 30 SHOULD BE SET ON BEFORE RETURNING IF YOU WANT THIS PRKEY203960C* FIELD TO BE RE-ENTERED. INDICATORS 31-59 MAY BE USED BY THIS SUBR.PRKEY203970C* PRKEY203980CSR EDIT BEGSR PRKEY203990C* ********** PRKEY20004000CSR EDCODE COMP 'YN' 31 'Y' OR 'N' PRKEY204010CSR 31 GOTO EYN PRKEY204020C* ********** PRKEY204030CSR EDCODE COMP 'DT' 31 PRKEY204040CSR 31 GOTO EDT PRKEY204050C* ********** PRKEY204060CSR EDCODE COMP 'EM' 31 PRKEY20004070CSR 31 GOTO EEM PRKEY204080C* ********** PRKEY204090CSR EDCODE COMP 'DP' 31 PRKEY204100CSR 31 GOTO EDP PRKEY204110C* ********** PRKEY204120CSR EDCODE COMP 'HD' 31 PRKEY204130CSR 31 GOTO EHD PRKEY20004140C* ********** PRKEY204150CSR EDCODE COMP 'DD' 31 PRKEY204160CSR 31 GOTO EDD PRKEY204170C* PRKEY204180CSR EDCODE COMP 'EB' 31 PRKEY204190CSR 31 GOTO EEB PRKEY204200C* ********** PRKEY20004210CSR EDCODE COMP 'T1' 31 PRKEY204220CSR 31 GOTO ET1 PRKEY204230C* ********** PRKEY204240CSR EDCODE COMP 'T2' 31 PRKEY204250CSR 31 GOTO ET2 PRKEY204260C* ********** PRKEY204270CSR EDCODE COMP 'T3' 31 PRKEY20004280CSR 31 GOTO ET3 PRKEY204290C* ********** PRKEY204300CSR EDCODE COMP 'HR' 31 PRKEY204310CSR 31 GOTO EHR PRKEY204320C* ********** PRKEY204330CSR MOVELWORD A6 6 PRKEY204340CSR A6 COMP 'DAYLAB' 31 PRKEY20004350CSR 31 GOTO DAYLAB PRKEY204360C* ********** PRKEY204370CSR A6 COMP 'DPXFRS' 31 PRKEY204380CSR 31 GOTO DPXFRS PRKEY204390C* ********** PRKEY204400CSR GOTO ENDEDT PRKEY204410C* ********** PRKEY20004420C** PRKEY204430CSR EYN TAG MUST BE 'Y' PRKEY204440C* ********** PRKEY204450CSR MOVELBUFFER A1 1 OR 'N'. PRKEY204460CSR A1 COMP 'Y' 32 PRKEY204470CSRN32 A1 COMP 'N' 32 PRKEY204480CSR 32 GOTO ENDEDT PRKEY20004490CSR MOVELEMS,NE BUFFER MESSAGE & PRKEY204500CSR Z-ADD30 BLNGTH RETRY. PRKEY204510CSR MOVE 'T' TYPE PRKEY204520CSR EXITFSUBRCM PRKEY204530CSR RLABL BUFFER PRKEY204540CSR RLABL TYPE PRKEY204550CSR RLABL BLNGTH PRKEY20004560CSR RLABL RCODE PRKEY204570CSR RLABL MASK PRKEY204580CSR RLABL DTYPE PRKEY204590C* ********** PRKEY204600CSR SETON 30 PRKEY204610C* ********** PRKEY204620CSR GOTO ENDEDT PRKEY20004630C* ********** PRKEY204640C** PRKEY204650CSR EDT TAG VALIDATE PRKEY204660C* ********** PRKEY204670CSR MOVELBUFFER A6 DATE. PRKEY204680CSR MOVELA6 MM 20 00' IN PRKEY206390C* BYTES 1-2. IF NO SUCH RECORD IS FOUND, PROGRAM ENDS. PRKEY206400C* PRKEY206410CSR SEQ1ST BEGSR PRKEY206420C* ********** PRKEY206430CSR Z-ADD1 SEQNO PRKEY206440CSR SQLOOP TAG PRKEY20006450C* ********** PRKEY206460CSR SEQNO CHAINPRINPT 86 PRKEY206470CSR N86 RC COMP '<>' 85 PRKEY206480CSR N85N86SEQNO ADD 1 SEQNO PRKEY206490CSR N85N86 GOTO SQLOOP PRKEY206500C* ********** PRKEY206510CSR MOVELMSG,5 A21 21 PRKEY20006520CSR Z-ADD21 BLNGTH PRKEY206530CSR MOVE SEQNO A21 PRKEY206540CSR 86 MOVE '*NONE*' A21 PRKEY206550CSR MOVELA21 BUFFER PRKEY206560CSR EXSR EXCPT PRKEY206570C* ********** PRKEY206580CSR MOVELB72 BUFFER PRKEY20006590CSR ENDSR PRKEY206600C********************************************************************PRKEY206610C* PRKEY206620C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION PRKEY206630C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. PRKEY206640C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. PRKEY206650C* IF 22 IS ON, THIS IS AN AUTOMATIC CHANGE TO PROG# IN 'PN'. PRKEY20006660C* IF 22 IS ON, THIS IS AN AUTOMATIC PROG CHANGE TO PROG# IN 'PN'. PRKEY206670C* IF 26 IS ON, THIS IS AN INITIAL PROG LOAD FROM 'DUMMY' RECORD. PRKEY206680C* PRKEY206690C********************************************************************PRKEY206700CSR GETPRG BEGSR PRKEY206710C* ********** PRKEY206720CSR 61 GOTO JMPOUT PRKEY20006730C* ********** PRKEY206740CSR 22 GOTO GTPTG1 PRKEY206750C* ********** PRKEY206760CSR 26 GOTO CHNPRG PRKEY206770C* ********** PRKEY206780CSR MOVE B72 OLDREC PRKEY206790CSR MOVELB72 OLDREC PRKEY20006800CSR GETPNO TAG PRKEY206810C* ********** PRKEY206820CSR MOVEL'PROG # -'WORD PRKEY206830CSR Z-ADD8 OLN PRKEY206840CSR Z-ADD1 ILN PRKEY206850CSR EXSR TYPES PRKEY206860C* ********** PRKEY20006870CSR MOVELBUFFER PN 10 PRKEY206880CSR PN COMP 0 2020 PRKEY206890CSR N20 PN COMP 8 20 BAD PROG# PRKEY206900CSR 20 SETON 82 PRKEY206910CSR 82 EXSR EXCPT PRKEY206920C* ********** PRKEY206930CSR SETOF 82 PRKEY20006940CSR 20 GOTO GETPNO TRY PROG# AGAINPRKEY206950C* ********** PRKEY206960CSR GTPTG1 TAG PRKEY206970C* ********** PRKEY206980CSR MOVE PN NAME10 10 PRKEY206990CSR N65 SNM,PN COMP ' ' 6060 PRKEY207000CSR 60 PN SUB 1 BP 30 PRKEY20007010CSR 60 BP MULT NFLDS BP PRKEY207020CSR 60 GOTO JMPOUT PRKEY207030C* ********** PRKEY207040CSR GETPNM TAG PRKEY207050C* ********** PRKEY207060CSR MOVEL'PROG NAM'WORD PRKEY207070CSR MOVE 'E - 'WORD PRKEY20007080CSR Z-ADD11 OLN PRKEY207090CSR Z-ADD6 ILN PRKEY207100CSR EXSR TYPES PRKEY207110C* ********** PRKEY207120CSR MOVELBUFFER PNAME 8 PRKEY207130CSR MOVE ' ' PNAME PRKEY207140CSR CHNPRG TAG PRKEY20007150C* ********** PRKEY207160CSR PNAME CHAINKPROGX 27 PRKEY207170CSRN27 MOVELPNAME SNM,PN PRKEY207180CSRN27 GOTO LOADIT PRKEY207190C* ********** PRKEY207200CSR MOVEL' 'WORD PRKEY207210CSR MOVELPNAME WORD PRKEY20007220CSR MOVE 'ABSENT 'WORD PRKEY207230CSR MOVE 'R' TYPE PRKEY207240CSR MOVELWORD BUFFER PRKEY207250CSR Z-ADD7 MASK 10 PRKEY207260CSR Z-ADD16 BLNGTH PRKEY207270CSR EXITFSUBRCM PRKEY207280CSR RLABL BUFFER 72 PRKEY20007290CSR RLABL TYPE 1 PRKEY207300CSR RLABL BLNGTH 20 PRKEY207310CSR RLABL RCODE 1 PRKEY207320CSR RLABL MASK 10 PRKEY207330CSR RLABL DTYPE 10 PRKEY207340C* ********** PRKEY207350CSR RCODE COMP 'E' 20 PRKEY20007360C*R 20 EXSR PROGMT PRKEY207370C*R 20 GOTO CHNPRG PRKEY207380CSRN20 GOTO GETPNM PRKEY207390CSR MOVE 'F' TYPE PRKEY207400CSR EXITFSUBRCM PRKEY207410CSR RLABL BUFFER PRKEY207420CSR RLABL TYPE PRKEY20007430CSR RLABL BLNGTH PRKEY207440CSR RLABL RCODE PRKEY207450CSR RLABL MASK PRKEY207460CSR RLABL DTYPE PRKEY207470C* ********** PRKEY207480CSR LOADIT TAG PRKEY207490C* ********** PRKEY20007500CSR PN SUB 1 BP PRKEY207510CSR BP MULT NFLDS BP PRKEY207520CSR BP ADD 1 N PRKEY207530CSR Z-ADD1 X 20 PRKEY207540CSR BLDARY TAG PRKEY207550C* ********** PRKEY207560CSR FN COMP B72 20 PRKEY20007570CSR 20 N SUB 1 MAXFLD 30 PRKEY207580CSR 20 MOVE MAXFLD SMX,PN PRKEY207590CSR 20 GOTO JMPOUT PRKEY207600C* ********** PRKEY207610CSR MOVE FN SFN,N FIELD NAME PRKEY207620CSR MOVE AN SAN,N ALPHA OR NUMER PRKEY207630CSR MOVE AD SAD,N AUTO DUP PRKEY20007640CSR MOVE ST SST,N START POSITION PRKEY207650CSR MOVE LN SLN,N PRKEY207660CSR MOVE EF SEF,N PRKEY207670CSR MOVE GP SGP,N PRKEY207680CSR MOVE NPL SNP,PN PRKEY207690CSR MVX TAG PRKEY207700C* ********** PRKEY20007710CSR MOVE X PNAME PRKEY207720CSR PNAME CHAINKPROGX 20 PRKEY207730CSR X ADD 1 X PRKEY207740CSRN20 X COMP NFLDS 20 PRKEY207750CSR 20 Z-ADDN MAXFLD PRKEY207760CSR 20 MOVE MAXFLD SMX,PN PRKEY207770CSR DCODE COMP 'D' 21 PRKEY20007780CSR 21N20 GOTO MVX PRKEY207790C* ********** PRKEY207800CSRN20 N ADD 1 N PRKEY207810CSRN20 GOTO BLDARY PRKEY207820C* ********** PRKEY207830CSR JMPOUT TAG PRKEY207840C* ********** PRKEY20007850CSR 65 GOTO ENDGET PRKEY207860C* ********** PRKEY207870CSR 63 GOTO SETHED PRKEY207880C* ********** PRKEY207890CSR 26 MOVE 'N' AUTO PRKEY207900CSR 26 PRKEY207910COR 22 GOTO GTPTG2 PRKEY20007920C* ********** PRKEY207930CSR MOVEL'AUTO-DUP'WORD PRKEY207940CSR MOVE ' - 'WORD PRKEY207950CSR Z-ADD11 OLN PRKEY207960CSR Z-ADD1 ILN PRKEY207970CSR EXSR TYPES PRKEY207980C* ********** PRKEY20007990CSR MOVELBUFFER AUTO 1 PRKEY208000CSR GTPTG2 TAG PRKEY208010C* ********** PRKEY208020CSR AUTO COMP 'O' 90AUTO-DUP ON PRKEY208030CSR SETHED TAG PRKEY208040C* ********** PRKEY208050CSR MOVELSNM,PN NAME10 PRKEY20008060CSR MOVELNAME10 WORD PRKEY208070CSR MOVE SMX,PN MAXFLD PRKEY208080CSR 90 MOVE ' ON' WORD PRKEY208090CSRN90 MOVE 'OFF' WORD PRKEY208100CSR MOVELWORD HEAD 40 PRKEY208110CSR ENDGET ENDSR PRKEY208120C* ********** PRKEY20008130C********************************************************************PRKEY208140C* PRKEY208150C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST PRKEY208160C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE PRKEY208170C* CHANGED PRKEY208180C* PRKEY208190C********************************************************************PRKEY20008200CSR GETSEQ BEGSR PRKEY208210C* ********** PRKEY208220CSR MOVEL'SEQ # - 'WORD PRKEY208230CSR Z-ADD8 OLN PRKEY208240CSR Z-ADD4 ILN PRKEY208250CSR EXSR TYPES PRKEY208260C* ********** PRKEY20008270CSR Z-ADD4 VL PRKEY208280CSR MOVELBUFFER VAR PRKEY208290CSR EXIT SUBRAJ PRKEY208300CSR RLABL VL 20 PRKEY208310CSR RLABL VAR 15 PRKEY208320C* ********** PRKEY208330CSR MOVELVAR SEQNO PRKEY20008340CSR SEQNO COMP 0 20 PRKEY208350CSRN20 Z-ADD1 SEQNO PRKEY208360CSR SETON 95 PRKEY208370CSR ENDSR PRKEY208380C********************************************************************PRKEY208390C* PRKEY208400C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO PRKEY20008410C* PRKEY208420C********************************************************************PRKEY208430CSR GETREC BEGSR PRKEY208440C* ********** PRKEY208450CSR SEQRD TAG PRKEY208460C* ********** PRKEY208470CSR SEQNO CHAINPRINPT 67 PRKEY20008480CSR 67 SETON 88 PRKEY208490CSR 88 EXSR EXCPT PRKEY208500C* ********** PRKEY208510CSR SETOF 88 PRKEY208520CSR 67 EXSR GETSEQ PRKEY208530C* ********** PRKEY208540CSR 67 GOTO SEQRD PRKEY20008550C* ********** PRKEY208560CSR ENDSR PRKEY208570C********************************************************************PRKEY208580C* PRKEY208590C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY PRKEY208600C* IS DONE IF A RUBOUT IS USED PRKEY208610C* PRKEY20008620C********************************************************************PRKEY208630CSR TYPES BEGSR PRKEY208640C* ********** PRKEY208650CSR OVER TAG PRKEY208660C* ********** PRKEY208670CSR Z-ADDOLN BLNGTH PRKEY208680CSR MOVELWORD BUFFER PRKEY20008690CSR MOVE 'S' TYPE PRKEY208700CSR EXITFSUBRCM PRKEY208710CSR RLABL BUFFER 72 PRKEY208720CSR RLABL TYPE 1 PRKEY208730CSR RLABL BLNGTH 20 PRKEY208740CSR RLABL RCODE 1 PRKEY208750CSR RLABL MASK 10 PRKEY20008760CSR RLABL DTYPE 10 PRKEY208770C* ********** PRKEY208780CSR MOVE 'A' TYPE PRKEY208790CSR Z-ADDILN BLNGTH PRKEY208800CSR EXITFSUBRCM PRKEY208810CSR RLABL BUFFER 72 PRKEY208820CSR RLABL TYPE 1 PRKEY20008830CSR RLABL BLNGTH 20 PRKEY208840CSR RLABL RCODE 1 PRKEY208850CSR RLABL MASK 10 PRKEY208860CSR RLABL DTYPE 10 PRKEY208870C* ********** PRKEY208880CSR RCODE COMP 'R' 25 PRKEY208890CSR 25 EXSR SKIP PRKEY20008900C* ********** PRKEY208910CSR 25 GOTO OVER PRKEY208920C* ********** PRKEY208930CSR RCODE COMP 'O' 25 PRKEY208940CSR 25 EXSR SKIP PRKEY208950C* ********** PRKEY208960CSR ENDSR PRKEY20008970C********************************************************************PRKEY208980C* PRKEY208990C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT PRKEY209000C* PRKEY209010C********************************************************************PRKEY209020CSR SKIP BEGSR PRKEY209030C* ********** PRKEY20009040CSR MOVELBUFFER NBUF 1 PRKEY209050CSR MOVEL' ' BUFFER PRKEY209060CSR Z-ADD1 BLNGTH PRKEY209070CSR MOVE 'T' TYPE PRKEY209080CSR EXITFSUBRCM PRKEY209090CSR RLABL BUFFER 72 PRKEY209100CSR RLABL TYPE 1 PRKEY20009110CSR RLABL BLNGTH 20 PRKEY209120CSR RLABL RCODE 1 PRKEY209130CSR RLABL MASK 10 PRKEY209140CSR RLABL DTYPE 10 PRKEY209150C* ********** PRKEY209160CSR MOVELNBUF BUFFER PRKEY209170CSR ENDSR PRKEY20009180C********************************************************************PRKEY209190C* PRKEY209200C* PRKEY209210C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED PRKEY209220C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER PRKEY209230C* PRKEY209240CSR MVRECD BEGSR PRKEY20009250C* ********** PRKEY209260CSR MOVELB72 BUFFER PRKEY209270CSR MOVE '2' WHICH1 PRKEY209280CSR Z-ADDSST,N STRT PRKEY209290CSR Z-ADD1 FPOS PRKEY209300CSR Z-ADDSLN,N LEN 20 PRKEY209310CSR EXIT SUBRIN PRKEY20009320CSR RLABL WHICH1 10 PRKEY209330CSR RLABL BUFFER 72 PRKEY209340CSR RLABL RECORD PRKEY209350CSR RLABL BPOS 20 PRKEY209360CSR RLABL FPOS 20 PRKEY209370CSR RLABL STRT 30 PRKEY209380CSR RLABL LEN 20 PRKEY20009390CSR ENDSR PRKEY209400C********************************************************************PRKEY209410CSR EXCPT BEGSR PRKEY209420C* ********** PRKEY209430CSRN81N82N83 PRKEY209440CANN84N88 GOTO PUTOUT PRKEY209450C* ********** PRKEY20009460CSR MOVELB72 BUFFER PRKEY209470CSR 81 MOVELMSG,1 BUFFER PRKEY209480CSR 83 MOVELMSG,2 BUFFER PRKEY209490CSR 88 MOVELMSG,3 BUFFER PRKEY209500CSR 82 MOVELMSG,4 BUFFER PRKEY209510CSRN84 GOTO PUTOUT PRKEY209520C* ********** PRKEY20009530CSR MOVELSFN,N BUFFER PRKEY209540CSRN18 SETON 19 PRKEY209550CSRN18 Z-ADD20 BLNGTH PRKEY209560CSRN18 GOTO PUTOUT PRKEY209570C* ********** PRKEY209580CSR MOVE HEAD BUFFER PRKEY209590CSR MOVELSEQNO WORD8 8 PRKEY20009600CSR MOVE WORD8 BUFFER PRKEY209610CSR PUTOUT TAG PRKEY209620C* ********** PRKEY209630CSR MOVE 'T' TYPE PRKEY209640CSRN19 Z-ADD69 BLNGTH PRKEY209650CSR SETOF 19 PRKEY209660CSR EXITFSUBRCM PRKEY20009670CSR RLABL BUFFER 72 PRKEY209680CSR RLABL TYPE 1 PRKEY209690CSR RLABL BLNGTH 20 PRKEY209700CSR RLABL RCODE 1 PRKEY209710CSR RLABL MASK 10 PRKEY209720CSR RLABL DTYPE 10 PRKEY209730C* ********** PRKEY20009740CSR ENDSR PRKEY209750C* PRKEY209760CSR CLRSCR BEGSR PRKEY209770CSR MOVE 'C' TYPE PRKEY209780CSR EXITFSUBRCM PRKEY209790CSR RLABL BUFFER PRKEY209800CSR RLABL TYPE PRKEY20009810CSR RLABL BLNGTH PRKEY209820CSR RLABL RCODE PRKEY209830CSR RLABL MASK PRKEY209840CSR RLABL DTYPE PRKEY209850CSR ENDSR PRKEY209860C********************************************************************PRKEY209870OPRINPT E 70N67 PRKEY20009880O RECORD 128 PRKEY209890O 64 128 'X' PRKEY209900O SEQNO 127 PRKEY209910O E 71 PRKEY209920O 19 'X' PRKEY2** 009930ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00994000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 009950ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 009960ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 009970ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 009980** 009990MODE MUST BE A,C,V,OR E 010000FIRST FIELD NAME BLANK 01001000INVALID SEQ # 010020PROG# MUST BE FROM 1-8 0100301ST AVAIL SEQ#= 010040** 010050# MUST BE 'Y' OR 'N' * 010060# INVALID DATE * 010070# INVALID DEPT/EMP * 01008000# LAST NAME DOES NOT BEGIN- 010090# WRONG TYPE.MUST BE (RSHV)* 010100# EMPLOYEE IS EXEMPT FROM O.T. 010110# NEW DEPT/EMP ALREADY ON FILE 010120# BOOK NUMBER INVALID 010130# G/L ACCT NUMBER INVALID 010140# DED TYPE MUST BE 01-13. 01015000/* 010160__ONG TYPE.MUST BE (RSHV)* 010100# EMPLOYEE IS EXEMPT FROM O.T. 010110# NEW DEPT/EMP ALREADY ON FILE 010120# BOOK NUMBER INVALID 010130# G/L ACCT NUMBER INVALID 010140# DED TYPE MUST BE 01-13. 0101500(hD $TTXPRDUMP P999999111111(000010H S PRDUMP00020X DECK-ID B30 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRDUMP00030F* LISTS PAYROLL MASTER FILE TO PRINTER UNFORMATTED PRDUMP00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRDUMP00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRDUMP00060F* CONTROL DATA PROPRIETARY PRODUCT PRDUMP00070F* PRDUMP0000080F* PRDUMP00090FPRMAST IP AF 600 600 10AI 2 DISK PRDUMP00100FPRMSTB O F 132 132 PRINTER PRDUMP00110IPRMAST NS 01 PRDUMP00120I 001 100 A PRDUMP00130I 101 200 B PRDUMP00140I 201 300 C PRDUMP0000150I 301 400 D PRDUMP00160I 401 500 E PRDUMP00170I 501 600 F PRDUMP00180C SETON 01 PRDUMP00190OPRMSTB D 01 PRDUMP00200O A 100 PRDUMP00210O D 01 PRDUMP0000220O B 100 PRDUMP00230O D 01 PRDUMP00240O C 100 PRDUMP00250O D 01 PRDUMP00260O D 100 PRDUMP00270O D 01 PRDUMP00280O E 100 PRDUMP0000290O D 01 PRDUMP00300O F 100 PRDUMP** 000310ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000320ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000330ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000340ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00035000/* 000360__0O F 100 PRDUMP** 000310ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000320ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000330ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000340ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0003500(h rTTXPRYND P999999111111(000010H S PRYND 00020X DECK-ID B35 MFG/DIST/ACCT SYSTEM SUMMARY-123 PRYND 00030F* ZERO OUT YTD FIELDS IN PRMAST PRYND 00040F* CYBER 18-10M/20 PAYROLL VERSION 1.0PRYND 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PRYND 00060F* CONTROL DATA PROPRIETARY PRODUCT PRYND 00070F* PRYND 0000080F* PRYND 00090F* *************************************************************** PRYND 00100F* * ************************************************* * PRYND 00110F* * * * * PRYND 00120F* * * * COMPUSOURCE PAYROLL PACKAGE * * * PRYND 00130F* * * * * PRYND 00140F* * ************************************************* * PRYND 0000150F* *************************************************************** PRYND 00160F* PRYND 00170F* ---- ZERO OUT Y.T.D. FIELDS ---- PRYND 00180F* PRYND 00190FPRMAST UP AF 600 600 10AI 2 DISK PRYND 00200I* PRYND 00210I* PAY-ROLL MASTER. PRYND 0000220I* PRYND 00230IPRMAST NS 01 PRYND 00240I 172 1782RPAY PRYND 00250I 179 1852SPAY PRYND 00260I 186 1922HPAY PRYND 00270I 193 1992VPAY PRYND 00280I 200 2062OPAY PRYND 0000290I 207 2132CPAY PRYND 00300I 214 2202DPAY PRYND 00310I 231 2351RHRS PRYND 00320I 236 2401SHRS PRYND 00330I 241 2451HHRS PRYND 00340I 246 2501VHRS PRYND 00350I 251 2551OHRS PRYND 0000360I 256 2601DHRS PRYND 00370I 315 3212FEDWH PRYND 00380I 322 3282FICA PRYND 00390I 329 3332SDI PRYND 00400I 334 3402STWH PRYND 00410I 341 3472CTYWH PRYND 00420I 476 4822CRUN PRYND 0000430I 483 4892BONDS PRYND 00440I 490 4962UNION PRYND 00450I 497 5032LIFE PRYND 00460I 504 5102HEALTH PRYND 00470I 511 5172PAYADV PRYND 00480I 518 5242EQUIP PRYND 00490I 526 5322STOCK PRYND 0000500I 533 5392PENS PRYND 00510I 540 5462MISC PRYND 00520C 01 Z-ADD0.00 RPAY PRYND 00530C 01 Z-ADD0.00 SPAY PRYND 00540C 01 Z-ADD0.00 HPAY PRYND 00550C 01 Z-ADD0.00 VPAY PRYND 00560C 01 Z-ADD0.00 OPAY PRYND 0000570C 01 Z-ADD0.00 CPAY PRYND 00580C 01 Z-ADD0.0 RHRS PRYND 00590C 01 Z-ADD0.0 SHRS PRYND 00600C 01 Z-ADD0.0 HHRS PRYND 00610C 01 Z-ADD0.0 VHRS PRYND 00620C 01 Z-ADD0.0 OHRS PRYND 00630C 01 Z-ADD0.0 DHRS PRYND 0000640C 01 Z-ADD0.00 DPAY PRYND 00650C 01 Z-ADD0.00 FEDWH PRYND 00660C 01 Z-ADD0.00 FICA PRYND 00670C 01 Z-ADD0.00 SDI PRYND 00680C 01 Z-ADD0.00 STWH PRYND 00690C 01 Z-ADD0.00 CTYWH PRYND 00700C 01 Z-ADD0.00 CRUN PRYND 0000710C 01 Z-ADD0.00 BONDS PRYND 00720C 01 Z-ADD0.00 UNION PRYND 00730C 01 Z-ADD0.00 LIFE PRYND 00740C 01 Z-ADD0.00 HEALTH PRYND 00750C 01 Z-ADD0.00 PAYADV PRYND 00760C 01 Z-ADD0.00 EQUIP PRYND 00770C 01 Z-ADD0.00 STOCK PRYND 0000780C 01 Z-ADD0.00 PENS PRYND 00790C 01 Z-ADD0.00 MISC PRYND 00800OPRMAST D 01 PRYND 00810O RPAY 178 PRYND 00820O SPAY 185 PRYND 00830O HPAY 192 PRYND 00840O VPAY 199 PRYND 0000850O OPAY 206 PRYND 00860O CPAY 213 PRYND 00870O DPAY 220 PRYND 00880O RHRS 235 PRYND 00890O SHRS 240 PRYND 00900O HHRS 245 PRYND 00910O VHRS 250 PRYND 0000920O OHRS 255 PRYND 00930O DHRS 260 PRYND 00940O FEDWH 321 PRYND 00950O FICA 328 PRYND 00960O SDI 333 PRYND 00970O STWH 340 PRYND 00980O CTYWH 347 PRYND 0000990O CRUN 482 PRYND 01000O BONDS 489 PRYND 01010O UNION 496 PRYND 01020O LIFE 503 PRYND 01030O HEALTH 510 PRYND 01040O PAYADV 517 PRYND 01050O EQUIP 524 PRYND 0001060O STOCK 532 PRYND 01070O PENS 539 PRYND 01080O MISC 546 PRYND ** 001090ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001100ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001110ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00112000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001130/* 001140__0O MISC 546 PRYND ** 001090ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001100ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001110ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0011200(2h 2TXPI010 P"999999111111(000010H S PI010 00020X DECK-ID M44 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI010 00030F* THIS PROGRAM INITIALIZES THE TAGINP FILE PI010 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI010 00060F* CONTROL DATA PROPRIETARY PRODUCT PI010 00070F* PI010 0000080FDUMMY IP F 72 DISK PI010 00090FTAGINP UC F 41R DISK PI010 00100IDUMMY NS 02 PI010 00110I 1 1 A PI010 00120ITAGINP NS 01 PI010 00130I 1 41 REC PI010 00140C SETON LR99 PI010 0000150CLR LOOP TAG PI010 00160CLR RRN ADD 1 RRN 50 PI010 00170CLR RRN CHAINTAGINP 70 PI010 00180CLRN70 EXCPT PI010 00190CLRN70 GOTO LOOP PI010 00200OTAGINP E 99N70 PI010 00210O OR LRN70 PI010 0000220O REC 41 PI010 00230O 2 '<>' PI010 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290_ 00 00 00 __ 0(i TXPI015 P999999111111(000010H S PI015 00020X DECK-ID M45 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI015 00030F* THIS PROGRAM IS THE CRT ENTRY OF THE PHYSICAL INVENTORY TAG DATA PI015 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI015 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI015 00060F* CONTROL DATA PROPRIETARY PRODUCT PI015 00070F* PI015 0000080FDUMMY IPE F 72 DISK PI015 00090FKPROGS IC F 36R 8AI 1 DISK PI015 00100FTAGINP UC F 41R DISK PI015 00110F********************************************************************PI015 00120F* INDICATOR FUNCTION LIST PI015 00130F* 01 DUMMY RECORD PI015 00140F* 02 KEYPYNCH PARAMETER FILE PI015 0000150F* 05 KEYPUNCH DATA FILE PI015 00160F* 18 PI015 00170F* 19 PI015 00180F* 20 PI015 00190F* 21 PI015 00200F* 25 RETRY ON RUBOUT PI015 00210F* 27 AUTO DUP PI015 0000220F* 28 PI015 00230F* 29 PI015 00240F* 40 MODE IS A-ADD PI015 00250F* 41 MODE IS C-CHANGE PI015 00260F* 42 MODE IS V-VERIFY PI015 00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS PI015 00280F* 44 MODE IS E-END OF JOB PI015 0000290F* 56 SEQ NBR NOT IN KPFILE PI015 00300F* 60 NEW PROGRAM NBR ONLY PI015 00310F* 61 AUTO DUP ONLY PI015 00320F* 70 PI015 00330F* 72 PI015 00340F* 73 MODE IS LESS THAN OR = 4 PI015 00350F* 81 MODE IS INVALID PI015 0000360F* 82 BAD PROG NBR PI015 00370F* 83 FIRST FIELD NAME BLANK PI015 00380F* 84 OUTPUT FIELD NAME PI015 00390F* 85 PI015 00400F* 88 SEQ NBR NOT IN KPFILE PI015 00410F* 90 AUTO DUP ON PI015 00420F* 95 PI015 0000430F* 98 RCD WITHIN OPERATOR LIMITS PI015 00440F* LR PI015 00450F********************************************************************PI015 00460E MSG 1 8 25 PI015 00470E SFN 80 20 PI015 00480E SAN 80 1 PI015 00490E SAD 80 1 PI015 0000500E SST 80 3 0 PI015 00510E SLN 80 2 0 PI015 00520E SNM 4 6 PI015 00530E SMX 4 2 0 PI015 00540E NP 4 1 0 PI015 00550E ARY1 1 2 50 PI015 00560IDUMMY NS 01 PI015 0000570I 1 1 A PI015 00580IKPROGS NS 02 PI015 00590I 9 28 FN PI015 00600I 29 29 AN PI015 00610I 30 30 AD PI015 00620I 31 33 ST PI015 00630I 34 35 LN PI015 0000640I 36 36 DCODE PI015 00650ITAGINP NS 05 PI015 00660I 1 41 RECORD PI015 00670C MOVE ' ' B72 72 PI015 00680C EXSR ALMTS PI015 00690C Z-ADDLOW SEQNO PI015 00700C NLR SETON LR PI015 0000710CLR START TAG PI015 00720CLR MOVEL'' WORD PI015 01580CLR Z-ADD1 OLN PI015 01590CLR Z-ADD1 ILN PI015 01600CLR EXSR TYPES PI015 0001610CLR MOVELBUFFER MODE PI015 01620CLR MODE COMP '4' 7373 PI015 01630CLR MODE COMP 'P' 60 NEW PROG#ONLY PI015 01640CLR MODE COMP 'D' 61 AUTO-DUP ONLY PI015 01650CLRN60N61N73 GOTO CHKMOD NEW 46DE PI015 01660CLR 73 MOVE MODE NPN 10 PI015 01670CLR EXSR GETPRG PI015 0001680CLR SETOF 606173 PI015 01690CLR GOTO SAMREC PI015 01700CLR CHKNUM TAG PI015 01710CLR MOVELBUFFER MODE PI015 01720CLR MODE COMP '@' 20 PI015 01730CLR 20N42 GOTO OUTREC PI015 01740CLR SAN,N COMP 'N' 19 PI015 0001750CLRN19 GOTO CHKVER PI015 01760CLR Z-ADDSLN,N VL 20 PI015 01770CLR MOVELBUFFER VAR 15 PI015 01780CLR EXIT SUBRAJ PI015 01790CLR RLABL VL PI015 01800CLR RLABL VAR PI015 01810CLR MOVELVAR BUFFER PI015 0001820CLR Z-ADDVL BLNGTH PI015 01830CLR EXSR EXCPT PI015 01840CLR SETOF 19 PI015 01850CLR CHKVER TAG PI015 01860CLRN42 GOTO MOVBUF PI015 01870CLR TBUF COMP BUFFER 2020 PI015 01880CLRN20 GOTO MOVBUF PI015 0001890CLR MOVEL'KP VERIF'WORD PI015 01900CLR MOVE 'Y ERROR 'WORD PI015 01910CLR MOVELWORD BUFFER PI015 01920CLR MOVE 'R' TYPE PI015 01930CLR Z-ADD6 MASK ONLY 'R' OR 'E'PI015 01940CLR EXSR CRTCOM PI015 01950CLR RCODE COMP 'R' 20 PI015 0001960CLR 20 GOTO OUTFLD PI015 01970CLR MOVBUF TAG PI015 01980CLR Z-ADDSST,N TSTRT 30 PI015 01990CLR Z-ADDSLN,N NCHARS 30 PI015 02000CLR Z-ADD1 SSTRT PI015 02010CLR EXIT SUBRMV PI015 02020CLR RLABL BUFFER PI015 0002030CLR RLABL SSTRT PI015 02040CLR RLABL RECORD PI015 02050CLR RLABL TSTRT PI015 02060CLR RLABL NCHARS PI015 02070CLR GOTO LOOP PI015 02080CLR RITDUP TAG PI015 02090CLR EXSR MVRECD PI015 0002100CLR SETON 19 PI015 02110CLR Z-ADDSLN,N BLNGTH PI015 02120CLRN27 EXSR EXCPT PI015 02130CLR SETOF 19 PI015 02140CLR GOTO MOVBUF PI015 02150CLR OUTREC TAG PI015 02160CLR SETON 187084 PI015 0002170CLR SETON 85 PI015 02180CLR EXCPT PI015 02190CLR EXSR EXCPT PI015 02200CLR SETOF 708485 PI015 02210CLR MOVELRECORD OLDREC 41 PI015 02220CLR NP,PN COMP 0 72 PI015 02230CLRN72 GOTO NXTREC PI015 0002240CLR MOVE NP,PN NPN PI015 02250CLR EXSR GETPRG PI015 02260CLR SETOF 72 PI015 02270CLR GOTO NXTREC PI015 02280CLR EOJ TAG PI015 02290C********************************************************************PI015 02300C* PI015 0002310C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION PI015 02320C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. PI015 02330C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. PI015 02340C* PI015 02350C********************************************************************PI015 02360CSR GETPRG BEGSR PI015 02370CSR 61 GOTO JMPOUT PI015 0002380CSR 72 PI015 02390COR 73 GOTO CHKPN PI015 02400CSR GETPNO TAG PI015 02410CSR MOVEL'PROG # -'WORD PI015 02420CSR Z-ADD8 OLN PI015 02430CSR Z-ADD1 ILN PI015 02440CSR EXSR TYPES PI015 0002450CSR MOVELBUFFER NPN 10 PI015 02460CSR CHKPN TAG PI015 02470CSR NPN COMP 0 2020 PI015 02480CSRN20 NPN COMP 4 20 BAD PROG# PI015 02490CSR 20 SETON 82 PI015 02500CSR 82 EXSR EXCPT PI015 02510CSR SETOF 82 PI015 0002520CSR 20 GOTO GETPNO TRY PROG# AGAINPI015 02530CSR MOVE NPN PN 10 INPI015 02540CSR MOVE PN NAME10 10 PI015 02550CSRN43 SNM,PN COMP ' ' 6060 PI015 02560CSR 60 PN SUB 1 BP 20 PI015 02570CSR 60 BP MULT 20 BP PI015 02580CSR 72 GOTO SETHED PI015 0002590CSR 73 GOTO JMPOUT PI015 02600CSR 60 GOTO JMPOUT PI015 02610CSR GETPNM TAG PI015 02620CSR MOVEL'PROG NAM'WORD PI015 02630CSR MOVE 'E - 'WORD PI015 02640CSR Z-ADD11 OLN PI015 02650CSR Z-ADD6 ILN PI015 0002660CSR EXSR TYPES PI015 02670CSR MOVELBUFFER PNAME 8 PI015 02680CSR MOVE ' ' PNAME PI015 02690CSR CHNPRG TAG PI015 02700CSR PNAME CHAINKPROGS 27 PI015 02710CSRN27 MOVELPNAME SNM,PN PI015 02720CSRN27 GOTO LOADIT PI015 0002730CSR MOVEL' 'WORD PI015 02740CSR MOVELPNAME WORD PI015 02750CSR MOVE 'ABSENT 'WORD PI015 02760CSR MOVE 'R' TYPE 1 PI015 02770CSR MOVELWORD BUFFER PI015 02780CSR Z-ADD7 MASK 10 PI015 02790CSR Z-ADD16 BLNGTH PI015 0002800CSR EXSR CRTCOM PI015 02810CSR RCODE COMP 'E' 20 PI015 02820CSR PRGMT TAG PI015 02830C*R 20 EXSR PROGMT PI015 02840C*R 20 GOTO CHNPRG PI015 02850CSR GOTO GETPNM PI015 02860CSR LOADIT TAG PI015 0002870CSR Z-ADD14 OLN PI015 02880CSR Z-ADD1 ILN PI015 02890CSR MOVEL'NEXT PRO'WORD PI015 02900CSR MOVE 'G # - 'WORD PI015 02910CSR EXSR TYPES PI015 02920CSR MOVELBUFFER NP,PN PI015 02930CSR PN SUB 1 BP PI015 0002940CSR BP MULT 20 BP PI015 02950CSR BP ADD 1 N 20 PI015 02960CSR Z-ADD1 X 20 PI015 02970CSR BLDARY TAG PI015 02980CSR FN COMP B72 20 PI015 02990CSR 20 N SUB 1 MAXFLD 20 PI015 03000CSR 20 MOVE MAXFLD SMX,PN PI015 0003010CSR 20 GOTO JMPOUT PI015 03020CSR MOVE FN SFN,N FIELD NAME PI015 03030CSR MOVE AN SAN,N ALPHA OR NUMER PI015 03040CSR MOVE AD SAD,N AUTO DUP PI015 03050CSR MOVE ST SST,N START POSITION PI015 03060CSR MOVE LN SLN,N PI015 03070CSR MVX TAG PI015 0003080CSR MOVE X PNAME PI015 03090CSR PNAME CHAINKPROGS 20 PI015 03100CSR X ADD 1 X PI015 03110CSRN20 X COMP 20 20 PI015 03120CSR 20 Z-ADDN MAXFLD PI015 03130CSR 20 MOVE MAXFLD SMX,PN PI015 03140CSR DCODE COMP 'D' 21 PI015 0003150CSR 21N20 GOTO MVX PI015 03160CSRN20 N ADD 1 N PI015 03170CSRN20 GOTO BLDARY PI015 03180CSR JMPOUT TAG PI015 03190CSR 43 GOTO ENDGET PI015 03200CSR 41 GOTO SETHED PI015 03210CSR MOVEL'AUTO-DUP'WORD PI015 0003220CSR MOVE ' - 'WORD PI015 03230CSR Z-ADD11 OLN PI015 03240CSR Z-ADD1 ILN PI015 03250CSR EXSR TYPES PI015 03260CSR MOVELBUFFER AUTO 1 PI015 03270CSR AUTO COMP 'O' 90AUTO-DUP ON PI015 03280CSR SETHED TAG PI015 0003290CSR MOVELSNM,PN NAME10 PI015 03300CSR MOVELNAME10 WORD PI015 03310CSR MOVE SMX,PN MAXFLD 20 PI015 03320CSR 90 MOVE ' ON' WORD PI015 03330CSRN90 MOVE 'OFF' WORD PI015 03340CSR MOVELWORD HEAD 40 PI015 03350CSR ENDGET ENDSR PI015 0003360C********************************************************************PI015 03370C* PI015 03380C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST PI015 03390C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE PI015 03400C* CHANGED PI015 03410C* PI015 03420C********************************************************************PI015 0003430CSR GETSEQ BEGSR PI015 03440CSR MOVEL'SEQ # - 'WORD PI015 03450CSR Z-ADD8 OLN PI015 03460CSR Z-ADD5 ILN PI015 03470CSR EXSR TYPES PI015 03480CSR Z-ADD5 VL PI015 03490CSR MOVELBUFFER VAR PI015 0003500CSR EXIT SUBRAJ PI015 03510CSR RLABL VL PI015 03520CSR RLABL VAR PI015 03530CSR MOVELVAR SEQNO PI015 03540CSR SEQNO COMP 0 20 PI015 03550CSRN20 Z-ADD1 SEQNO PI015 03560CSR SETON 95 PI015 0003570CSR ENDSEQ ENDSR PI015 03580C********************************************************************PI015 03590C* PI015 03600C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO PI015 03610C* PI015 03620C********************************************************************PI015 03630CSR GETREC BEGSR PI015 0003640CSR SEQRD TAG PI015 03650CSR EXSR TSTSEQ PI015 03660CSR 94 EXSR GETSEQ PI015 03670CSR 94 GOTO SEQRD PI015 03680CSR SEQNO CHAINTAGINP 56 PI015 03690CSR 40 MOVELRECORD TST 2 PI015 03700CSR 40 TST COMP '<>' 99 PI015 0003710CSR 40N99 SEQNO ADD 1 SEQNO PI015 03720CSR 40N99 GOTO SEQRD PI015 03730CSR 56 SETON 88 PI015 03740CSR 88 EXSR EXCPT PI015 03750CSR SETOF 88 PI015 03760CSR 56 EXSR GETSEQ PI015 03770CSR 56 GOTO SEQRD PI015 0003780CSR ENDSR PI015 03790C********************************************************************PI015 03800C* PI015 03810C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY PI015 03820C* IS DONE IF A RUBOUT IS USED PI015 03830C* PI015 03840C********************************************************************PI015 0003850CSR TYPES BEGSR PI015 03860CSR OVER TAG PI015 03870CSR Z-ADDOLN BLNGTH PI015 03880CSR MOVELWORD BUFFER PI015 03890CSR MOVE 'S' TYPE PI015 03900CSR EXSR CRTCOM PI015 03910CSR MOVE 'A' TYPE PI015 0003920CSR Z-ADDILN BLNGTH PI015 03930CSR EXSR CRTCOM PI015 03940CSR RCODE COMP 'R' 25 PI015 03950CSR 25 EXSR SKIP PI015 03960CSR 25 GOTO OVER PI015 03970CSR RCODE COMP 'O' 25 PI015 03980CSR 25 EXSR SKIP PI015 0003990CSR ENDSR PI015 04000C********************************************************************PI015 04010C* PI015 04020C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT PI015 04030C* PI015 04040C********************************************************************PI015 04050CSR SKIP BEGSR PI015 0004060CSR MOVELBUFFER NBUF 1 PI015 04070CSR MOVEL' ' BUFFER PI015 04080CSR Z-ADD1 BLNGTH PI015 04090CSR MOVE 'T' TYPE PI015 04100CSR EXSR CRTCOM PI015 04110CSR MOVELNBUF BUFFER PI015 04120CSR ENDSR PI015 0004130C********************************************************************PI015 04140C* PI015 04150C* PI015 04160C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED PI015 04170C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER PI015 04180C* PI015 04190CSR MVRECD BEGSR PI015 0004200CSR MOVELB72 BUFFER PI015 04210CSR Z-ADD1 TSTRT PI015 04220CSR Z-ADDSST,N SSTRT PI015 04230CSR Z-ADDSLN,N NCHARS PI015 04240CSR EXIT SUBRMV PI015 04250CSR RLABL OLDREC PI015 04260CSR RLABL SSTRT 30 PI015 0004270CSR RLABL BUFFER PI015 04280CSR RLABL TSTRT 30 PI015 04290CSR RLABL NCHARS 30 PI015 04300CSR ENDSR PI015 04310C********************************************************************PI015 04320CSR EXCPT BEGSR PI015 04330CSRN81N82N83 PI015 0004340CANN84N88 GOTO PUTOUT PI015 04350CSR MOVELB72 BUFFER PI015 04360CSR 81 MOVELMSG,1 BUFFER PI015 04370CSR 83 MOVELMSG,2 BUFFER PI015 04380CSR 88 MOVELMSG,3 BUFFER PI015 04390CSR 82 MOVELMSG,4 BUFFER PI015 04400CSRN84 GOTO PUTOUT PI015 0004410CSRN85 MOVELSFN,N BUFFER PI015 04420CSRN18 SETON 19 PI015 04430CSRN18 Z-ADD20 BLNGTH PI015 04440CSRN18 GOTO PUTOUT PI015 04450CSR MOVE HEAD BUFFER PI015 04460CSR MOVELSEQNO WORD8 8 PI015 04470CSR MOVE WORD8 BUFFER PI015 0004480CSR PUTOUT TAG PI015 04490CSR MOVE 'S' TYPE PI015 04500CSRN19 Z-ADD69 BLNGTH PI015 04510CSR SETOF 19 PI015 04520CSR EXSR CRTCOM PI015 04530CSR ENDSR PI015 04540C* PI015 0004550CSR ALMTS BEGSR PI015 04560CSR MOVE 'C' TYPE 1 PI015 04570CSR Z-ADD0 BLNGTH 20 PI015 04580CSR MOVE ' ' RCODE 1 PI015 04590CSR Z-ADD0 MASK 10 PI015 04600CSR Z-ADD0 DTYPE 10 PI015 04610CSR EXSR CRTCOM PI015 0004620CSR MOVELARY1,1 BUFFER PI015 04630CSR MOVE 'S' TYPE PI015 04640CSR Z-ADD50 BLNGTH PI015 04650CSR EXSR CRTCOM PI015 04660CSR MOVE 'A' TYPE PI015 04670CSR Z-ADD5 BLNGTH PI015 04680CSR Z-ADD1 DTYPE PI015 0004690CSR EXSR CRTCOM PI015 04700CSR EXSR SKIP PI015 04710CSR RCODE COMP 'R' 86 PI015 04720CSR Z-ADD5 VL PI015 04730CSR MOVELBUFFER VAR PI015 04740CSR EXIT SUBRAJ PI015 04750CSR RLABL VL PI015 0004760CSR RLABL VAR PI015 04770CSR MOVELVAR BUFFER PI015 04780CSR MOVELBUFFER LOW 50 PI015 04790CSR MOVELARY1,2 BUFFER PI015 04800CSR MOVE 'S' TYPE PI015 04810CSR Z-ADD50 BLNGTH PI015 04820CSR EXSR CRTCOM PI015 0004830CSR MOVE 'A' TYPE PI015 04840CSR Z-ADD5 BLNGTH PI015 04850CSR Z-ADD1 DTYPE PI015 04860CSR EXSR CRTCOM PI015 04870CSR RCODE COMP 'R' 87 PI015 04880CSR Z-ADD5 VL PI015 04890CSR MOVELBUFFER VAR PI015 0004900CSR EXIT SUBRAJ PI015 04910CSR RLABL VL PI015 04920CSR RLABL VAR PI015 04930CSR MOVELVAR BUFFER PI015 04940CSR MOVELBUFFER HIGH 50 PI015 04950CSR MOVE 'C' TYPE PI015 04960CSR EXSR CRTCOM PI015 0004970CSR 86 PI015 04980COR 87 GOTO ALMTS PI015 04990CSR Z-ADD0 DTYPE PI015 05000CSR ENDSR PI015 05010CSR CRTCOM BEGSR PI015 05020CSR EXITFSUBRCM PI015 05030CSR RLABL BUFFER PI015 0005040CSR RLABL TYPE PI015 05050CSR RLABL BLNGTH PI015 05060CSR RLABL RCODE PI015 05070CSR RLABL MASK PI015 05080CSR RLABL DTYPE PI015 05090CSR ENDSR PI015 05100CSR PUTSEQ BEGSR PI015 0005110CSR MOVELMSG,5 BUFFER 72 PI015 05120CSR MOVE 'S' TYPE PI015 05130CSR Z-ADD25 BLNGTH PI015 05140CSR EXSR CRTCOM PI015 05150CSR MOVELSEQNO BUFFER PI015 05160CSR MOVE 'T' TYPE PI015 05170CSR Z-ADD5 BLNGTH PI015 0005180CSR EXSR CRTCOM PI015 05190CSR ENDSR PI015 05200CSR TSTSEQ BEGSR PI015 05210CSR SETOF 949697 PI015 05220CSR SEQNO COMP LOW 989698 PI015 05230CSR 98 SEQNO COMP HIGH 979898 PI015 05240CSR 98 GOTO ENDTST PI015 0005250CSR 40 96 MOVELMSG,6 BUFFER PI015 05260CSR 40 97 MOVELMSG,7 BUFFER PI015 05270CSRN40 MOVELMSG,8 BUFFER PI015 05280CSRN40 SETON 94 PI015 05290CSR MOVE 'T' TYPE PI015 05300CSR Z-ADD25 BLNGTH PI015 05310CSR EXSR CRTCOM PI015 0005320CSR 40 97 MOVE 'F' TYPE PI015 05330CSR 40 97 EXSR CRTCOM PI015 05340CSR ENDTST ENDSR PI015 05350C********************************************************************PI015 05360OTAGINP E 70N56 PI015 05370O RECORD 41 PI015 05380O 42 41 'X' PI015 00** 005390ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005400ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005410ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005420ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005430** 005440MODE MUST BE A,C,V,OR E 00545000FIRST FIELD NAME BLANK 005460INVALID SEQ # 005470PROG# MUST BE FROM 1-4 005480CURRENT SEQUENCE NBR 005490SEQNO TOO LOW 005500RUN EDIT PROG-FILE FULL 005510SEQNO NOT IN YOUR LIMITS 00552000** 005530ENTER BEGINNING RELATIVE RECORD NUMBER 005540ENTER ENDING RELATIVE RECORD NUMBER 005550/* 005560_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(j ITXPI016 PF999999111111(000010H S PI016 00020X DECK-ID M46 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI016 00030F* THIS IS THE RECOVERY PROGRAM THAT DISPLAYS LAST RECORD ENTERED PI016 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI016 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI016 00060F* CONTROL DATA PROPRIETARY PRODUCT PI016 00070F* PI016 0000080FDUMMY UPE F 72 DISK PI016 00090FTAGINP IC F 41R DISK PI016 00100E MSG 1 5 35 PI016 00110IDUMMY NS 01 PI016 00120I 1 72 ALL PI016 00130ITAGINP NS 02 PI016 00140I 1 41 RCD PI016 0000150C SETOF 60 PI016 00160C SETON LR PI016 00170CLR MOVE ' ' B80 80 PI016 00180CLR EXSR ALMTS PI016 00190CLR Z-ADDLOW SEQNO 50 PI016 00200CLR LOOP TAG PI016 00210CLR SEQNO COMP HIGH 40 PI016 0000220CLR 40 GOTO A PI016 00230CLR SEQNO CHAINTAGINP 50 PI016 00240CLR 50 GOTO A PI016 00250CLR MOVELRCD TST 2 PI016 00260CLR TST COMP '<>' 51 PI016 00270CLRN51 SEQNO ADD 1 SEQNO PI016 00280CLRN51 GOTO LOOP PI016 0000290CLR A TAG PI016 00300CLR SEQNO SUB 1 SUBNO 50 PI016 00310CLR SUBNO CHAINTAGINP 50 PI016 00320CLR MOVELRCD BUFFER PI016 00330CLR MOVE 'T' TYPE PI016 00340CLR Z-ADD32 BLNGTH PI016 00350CLR EXSR CRTCOM PI016 0000360CLR MOVELMSG,3 BUFFER PI016 00370CLR MOVE 'S' TYPE PI016 00380CLR Z-ADD35 BLNGTH PI016 00390CLR EXSR CRTCOM PI016 00400CLR MOVE B80 BUFFER PI016 00410CLR MOVELSEQNO BUFFER PI016 00420CLR MOVE 'T' TYPE PI016 0000430CLR Z-ADD5 BLNGTH PI016 00440CLR EXSR CRTCOM PI016 00450CLR MOVELMSG,4 BUFFER PI016 00460CLR MOVE 'S' TYPE PI016 00470CLR Z-ADD35 BLNGTH PI016 00480CLR EXSR CRTCOM PI016 00490CLR MOVE B80 BUFFER PI016 0000500CLR MOVE 'A' TYPE PI016 00510CLR Z-ADD1 BLNGTH PI016 00520CLR EXSR CRTCOM PI016 00530CLR MOVE 'C' TYPE PI016 00540CLR EXSR CRTCOM PI016 00550CLR MOVE 'F' TYPE PI016 00560CLR EXSR CRTCOM PI016 0000570CSR ALMTS BEGSR PI016 00580CSR MOVE B80 BUFFER 80 PI016 00590CSR MOVE 'C' TYPE 1 PI016 00600CSR Z-ADD0 BLNGTH 20 PI016 00610CSR MOVE ' ' RCODE 1 PI016 00620CSR Z-ADD0 MASK 10 PI016 00630CSR Z-ADD0 DTYPE 10 PI016 0000640CSR EXSR CRTCOM PI016 00650CSR MOVELMSG,1 BUFFER PI016 00660CSR MOVE 'S' TYPE PI016 00670CSR Z-ADD35 BLNGTH PI016 00680CSR EXSR CRTCOM PI016 00690CSR MOVE B80 BUFFER PI016 00700CSR MOVE 'A' TYPE PI016 0000710CSR Z-ADD5 BLNGTH PI016 00720CSR Z-ADD1 DTYPE PI016 00730CSR EXSR CRTCOM PI016 00740CSR EXSR SKIP PI016 00750CSR RCODE COMP 'R' 86 PI016 00760CSR EXSR AJ PI016 00770CSR MOVELBUFFER LOW 50 PI016 0000780CSR MOVE B80 BUFFER PI016 00790CSR MOVELMSG,2 BUFFER PI016 00800CSR MOVE 'S' TYPE PI016 00810CSR Z-ADD35 BLNGTH PI016 00820CSR EXSR CRTCOM PI016 00830CSR MOVE B80 BUFFER PI016 00840CSR MOVE 'A' TYPE PI016 0000850CSR Z-ADD5 BLNGTH PI016 00860CSR Z-ADD1 DTYPE PI016 00870CSR EXSR CRTCOM PI016 00880CSR RCODE COMP 'R' 87 PI016 00890CSR EXSR AJ PI016 00900CSR MOVELBUFFER HIGH 50 PI016 00910CSR MOVE 'C' TYPE PI016 0000920CSR EXSR CRTCOM PI016 00930CSR 86 PI016 00940COR 87 GOTO ALMTS PI016 00950CSR Z-ADD0 DTYPE PI016 00960CSR ENDSR PI016 00970CSR CRTCOM BEGSR PI016 00980CSR EXITFSUBRCM PI016 0000990CSR RLABL BUFFER PI016 01000CSR RLABL TYPE PI016 01010CSR RLABL BLNGTH PI016 01020CSR RLABL RCODE PI016 01030CSR RLABL MASK PI016 01040CSR RLABL DTYPE PI016 01050CSR ENDSR PI016 0001060CSR SKIP BEGSR PI016 01070CSR MOVELBUFFER NBUF 1 PI016 01080CSR MOVEL' ' BUFFER PI016 01090CSR Z-ADD1 BLNGTH PI016 01100CSR MOVE 'T' TYPE PI016 01110CSR EXSR CRTCOM PI016 01120CSR MOVELNBUF BUFFER PI016 0001130CSR ENDSR PI016 01140CSR AJ BEGSR PI016 01150CSR MOVELBUFFER VAR 15 PI016 01160CSR Z-ADD5 VL 20 PI016 01170CSR EXIT SUBRAJ PI016 01180CSR RLABL VL PI016 01190CSR RLABL VAR PI016 0001200CSR MOVELVAR BUFFER PI016 01210CSR ENDSR PI016 01220ODUMMY D 60 PI016 01230O ALL 72 PI016 ** 001240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00126000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001280** 001290ENTER BEGINNING RRN 001300ENTER ENDING RRN 001310TRANSACTION RRN 001320ENTER E FOR END OF JOB 00133000 THIS IS A BLANK ARRAY MEMBER 001340/* 001350_ 00 00 00 00 00 00__ 0(2j^ 2TXPI017 P999999111111(000010H S PI017 00020X DECK-ID M47 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI017 00030F* THIS PROGRAM BYPASSES RECORDS WITH <> IN RECORD POSITION 1 AND 2 PI017 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI017 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI017 00060F* CONTROL DATA PROPRIETARY PRODUCT PI017 00070F* PI017 0000080FTAGINP IPE F 41 DISK PI017 00090FTAGOUT O F 41 DISK PI017 00100ITAGINP NS 01 1 C< 2 C> PI017 00110I 1 1 A PI017 00120I NS 02 1NC< PI017 00130I 1 41 REC PI017 00140OTAGOUT D 02 PI017 0000150O REC 41 PI017 ** 000160ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000170ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000180ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000190ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000200/* 00021000_ 00 00 00 00 __ 0(jt iTXPI020 P\999999111111(000010H S PI020 00020X DECK-ID M48 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI020 00030F* THIS PROGRAM WRITES THE DUPLICATE AND MISSING TAG REPORT PI020 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FTAGS IP AF 41 DISK API02000090FPARTMST IC F 300R20AI 271 DISK 00100FHEADING IT F 40 EDISK 00110F$LP1 O F 132 OF PRINTER API02000120F********************************************************************API02000130F* API02000140F* DUPLICATE AND MISSING API0200000150F* TAG REPORT API02000160F* API02000170F********************************************************************API02000180F* API02000190F* API020 LISTS ALL MISSING TAG NUMBERS, DUPLICATE TAG NUMBERS, API02000200F* AND TAG NUMBERS THAT EXCEED THE LIMITS. TAG#,PART#, DESCRIPTION API02000210F* ARE PRINTED FOR ALL DUPLICATE TAG NUMBERS. API0200000220F* ERRORS PRINTED AT EXCPT OUTPUT. API02000230F* API02000240F* API02000250F********************************************************************API02000260F* ID F C H L FUNCTION OF INDICATORS API02000270F*01 LIMITS RECORD --FROM TAGS API02000280F*02 TAGS RECORD --FROM TAGS API0200000290F*03 INVALID CARD TYPE --FROM TAGS API02000300F*04 IMSTR RECORD --FROM PARTMST API02000310F* 10 SKIP AROUND THINGS DONE ON FIRST CYCLE API02000320F* 51 EXCEEDS LIMIT ERROR API02000330F* 52 TAGS MISSING ERROR API02000340F* 53 COMPARE SHOWS THAT DUPLICATE TAGS EXIST API02000350F* 54 PRINT DUPLICATE TAG INFORMATION API0200000360F* 55 CHAINED AND RECORD NOT FOUND API02000370F* 61 TAG GREATER THAN UPPER LIMIT IN EXCEEDS API02000380F* 63 SAVE STATUS OF GREATER TAG--PERFORM SUBROUTINE API02000390F* 64 ONLY CHECK ONCE FOR MISSING TICKETS TO UPPER LIMIT API02000400F* 65 MTAG AND UPPER LIMIT ARE EQUAL API02000410F* 66 MTAG LESS THAN UPPER LIMIT API02000420F* 67 MTAG IS GREATER THAN TTAG--DON'T ADD ONE API0200000430F* 68 COMBINATION OF 67 OR 65--DON'T ADD ONE 00440F********************************************************************API02000450E HEADING HEAD 1 1 40 00460ITAGS NS 01 1 CL API02000470I 2 60LLIM API02000480I 7 110ULIM API02000490I NS 02 1 CT API0200000500I 2 60TTAG API02000510I 22 41 TPART 00520I 13 14 TUM 00530I 15 210TQTY 00540I NS 03 API02000550I 1 41 DUM1 00560IPARTMST NS 04 0000570I 271 290 PART 00580I 1 37 DESC 00590C* API02000600C* API02000610C* API02000620C 10 GOTO START API02000630C SETON 10 DO ONLY ONCE API0200000640C MOVE LLIM MTAG 60 MISSING TAGS API02000650C MOVEL'*** NOT 'WORK 16 API02000660C MOVE 'ON MASTE'WORK NDESC USED IF API02000670C MOVE 'R *** 'WORK1 24 ITEM NOT FOUND API02000680C MOVELWORK WORK1 WHEN CHAINED API02000690C MOVELWORK1 NDESC 37 TO PARTMST API02000700C MOVE ' ' NDESC API0200000710C* API02000720C START TAG API02000730C 01 API02000740COR 03 GOTO END API02000750C* API02000760C* API02000770C SETOF 515268 0000780C EXSR EXCEED API02000790C N51 API02000800COR 63 EXSR MISS API02000810C EXSR DUPL API02000820C* API02000830C END TAG API02000840C SEQ ADD 1 SEQ 60 PI020 0000850CLR TTAG COMP ULIM 66 00860CLR 66 MOVE MTAG A 60 00870CLR 66 SETON 63 00880CLR SETOF 5152 00890CLR EXCPT 00900C********************************************************************API02000910C* API0200000920C* THIS SUBROUTINE MOVES THE INFORMATION FROM A RECORD JUST API02000930C* READ TO STORAGE FIELDS. THIS IS USED TO CHECK FOR DUPLICATE API02000940C* TAGS. IF ALSO ALLOWS FOR THE PRINTING OF THE DUPLICATE TAGS API02000950C* API02000960C* API02000970C********************************************************************API02000980C* API0200000990CSR SAVE BEGSR API02001000CSR MOVE TTAG STAG 50 API02001010CSR MOVE TPART SPART 6 API02001020CSRN55 MOVE DESC SDESC 37 API02001030CSR 55 MOVE NDESC SDESC API02001040CSR ENDSR API02001050C* API0200001060C********************************************************************API02001070C* API02001080C* THIS SUBROUTINE CHECKS TO SEE IF THE TAG IS LESS THAN THE API02001090C* LOWER LIMIT OR IS GREATER THAN THE UPPER LIMIT. API02001100C* IF YES TO EITHER OF THESE IT IS PRINTED. API02001110C* API02001120C********************************************************************API0200001130C* API02001140CSR EXCEED BEGSR API02001150CSR TTAG COMP LLIM 51 51 LOWER ERROR API02001160CSRN51 TTAG COMP ULIM 61 61 UPPER ERROR API02001170CSR 61 SETON 5163 API02001180CSR 64 SETOF 63 API02001190CSR ENDSR API0200001200C* API02001210C********************************************************************API02001220C* API02001230C* THIS SUBROUTINE CHECKS FOR MISSING TAGS WITHIN THE LIMIT. API02001240C* IF THE TAG EXCEEDS THE LIMIT ONE WAY OR ANOTHER, THIS API02001250C* SUBROUTINE IS NOT PERFORMED. API02001260C* API0200001270C* API02001280C********************************************************************API02001290CSR MISS BEGSR API02001300CSR MTAG COMP ULIM 6665 API02001310CSR 65 GOTO LEND API02001320CSR MTAG COMP TTAG 6752 TAGS MISSING API02001330CSRN52 GOTO LEND API0200001340CSR MOVE MTAG A 60 LOWER TAG GONE API02001350CSR MOVE TTAG B 60 API02001360CSR B SUB 1 B UPPER TAG GONE API02001370CSR MOVE TTAG MTAG BEGIN SEQ AGAINAPI02001380C* API02001390CSR LEND TAG API02001400CSR 66 63 SETOF 52 0001410CSR 67 01420COR 65 SETON 68 01430CSRN68 MTAG ADD 1 MTAG API02001440CSR 63 SETON 64 ONLY DO ONCE API02001450CSR ENDSR API02001460C* API02001470C********************************************************************API0200001480C* API02001490C* THIS SUBROUTINE DISCOVERS DUPLICATE TAGS WITHOUT USE OF API02001500C* LOOK AHEAD FIELDS. PREVIOUS INFORMATION MUST BE STORED SO API02001510C* THAT THE FIRST DUPLICATE CAN BE PRINTED. API02001520C* CHAIN OUT TO PARTMST TO GET THE DESCRIPTION OF ITEM. PI020 01530C* API02001540C* API0200001550C********************************************************************API02001560C* API02001570CSR DUPL BEGSR API02001580CSRN53 SETOF 54 API02001590CSR 02 TTAG COMP STAG 53 DUPLICATE TAG API02001600CSR 53 SETON 54 PRINT TAG API02001610CSR EXCPT PRINT API0200001620CSR TPART CHAINPARTMST 55 NOT FOUND 01630CSR EXSR SAVE API02001640C* API02001650CSR ENDSR API02001660C* API02001670O$LP1 D 102 01 API02001680O OR OFN1P API0200001700O HEAD,1 86 01720O UDATE Y 132 API02001730O 4 'PAGE' API02001740O PAGE Z 8 API02001741O H 2 01 01742O OR OFN1P 01743O 132 'PI020' 0001750O D 2 01 API02001760O OR OFN1P API02001770O 71 'DUPLICATE AND MISSING' API02001780O 82 'TAG REPORT' API02001790O D 2 01 API02001800O OR OFN1P API02001810O 15 'TAG LIMITS' API0200001820O LLIM 3 22 API02001830O 26 'TO' API02001840O ULIM 3 34 API02001850O 35 '.' API02001860O D 2 01 API02001870O OR OFN1P API02001880O 20 'MISSING TAG#' API0200001890O 59 'DUPLICATE TAG#' API02001900O 107 'EXCEEDS LIMITS' API02001910O 125 'SEQ #' PI020 01920O E 1 54 API02001930O STAG 3 40 API02001940O SPART 51 API02001950O SDESC B 91 API0200001960O SEQ J 125 PI020 01970O E 1 66 63 API02001980O A 3 10 API02001990O 16 'THRU' API02002000O ULIM 3 24 API02002010O E 1 51 API02002020O TTAG 3 100 API0200002030O SEQ J 125 PI020 02040O E 1 52 API02002050O A 3 10 API02002060O 16 'THRU' API02002070O B 3 24 API02002080O* API02002090O* API0200002100O D 1 03 API02002110O DUM1 41 02120O 55 '*** INVALID CARD TYPE' API02002130O SEQ J 125 PI020 ** 02140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 02150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0216000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 02170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 02180/* 02190_ 00 00 00 00 __ 0(dj d*TXPI043 P >999999111111(000010H S PI043 00020X DECK-ID M79 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI043 00030F* THIS PROGRAM PRINTS THE QUANTITY VARIANCE REPORT PI043 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI043 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI043 00060F* CONTROL DATA PROPRIETARY PRODUCT PI043 00070F* PI043 0000080FTAGS IP AF 41 DISK PI043 00090FPARTMST IC F 300R20AI 271 DISK PI043 00100FHEADING IT F 40 EDISK PI043 00110F$LP1 O F 132 OF PRINTER PI043 00120F********************************************************************PI043 00130F* PI043 00140F* QUANTITY VARIANCE REPORT PI043 0000150F* PI043 00160F********************************************************************PI043 00170F* PI043 00180F* PI043 00190F********************************************************************PI043 00200F* ID F C H L FUNCTION OF INDICATORS PI043 00210F*01 'T' RECORD FROM TAGS PI043 0000220F*02 NON 'T' RECORD FROM TAGS PI043 00230F* 03 RECORD FROM PARTMST PI043 00240F* 51 PART # NOT ON MASTERFILE--ERROR PI043 00250F* 1P FIRST PAGE PI043 00260F* OF OVERFLOW PI043 00270F* L1 PART NUMBER LEVEL BREAK PI043 00280F* LR LAST RECORD PI043 0000290F********************************************************************PI043 00300E HEADING HEAD 1 1 40 PI043 00310ITAGS NS 02 1NCT PI043 00320I* PI043 00330I* PI043 00340I* PI043 00350I NS 01 PI043 0000360I 22 41 TPART L1 PI043 00370I 13 14 TUM PI043 00380I 15 210TQTY PI043 00390IPARTMST NS 03 PI043 00400I 1 37 DESC PI043 00410I 38 39 UM PI043 00420I 146 1520PQTY PI043 0000430I* PI043 00440C* PI043 00450C L1 TPART CHAINPARTMST 51 PI043 00460C 01N51 TQTY ADD L1QTY L1QTY 80 PI043 00470C* PI043 00480CL1N51 L1QTY SUB PQTY VAR 70 PI043 00490C* PI043 0000500C* PI043 00510O$LP1 H 102 1P PI043 00520O OR OFN1P PI043 00540O HEAD,1 86 PI043 00560O UDATE Y 132 PI043 00570O 4 'PAGE' PI043 00580O PAGE Z 8 PI043 0000581O H 1 1P 00582O OR OFN1P 00583O 132 'PI043 ' 00590O H 2 1P PI043 00600O OR OFN1P PI043 00610O 77 'INVENTORY VARIANCE REPOR' PI043 00620O 78 'T' PI043 0000621O H 1 1P 00622O OR OFN1P 00623O 22 'PART NUMBER' 00630O H 2 1P PI043 00640O OR OFN1P PI043 00660O 23 'DESCRIPTION' PI043 00670O 66 'FILE QTY' PI043 0000680O 83 'ACT QTY' PI043 00690O 91 'U/M' PI043 00700O 102 'VAR' 00701O T 1 L1N51 00702O TPART 31 00710O T 1 L1N51 PI043 00730O DESC 49 PI043 0000740O PQTY J 65 PI043 00750O L1QTY JB 83 PI043 00760O TUM 91 PI043 00770O VAR L 102 PI043 ** 000780ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000790ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00080000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000810ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000820/* 000830_ 00 00 __ 0(dk( d*TXPI035 P 999999111111(000010H S PI035 00020X DECK-ID M33 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI035 00030F* THIS PROGRAM MERGERS TAGS AND OUTTAG INTO STAGS PI035 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI035 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI035 00060F* CONTROL DATA PROPRIETARY PRODUCT PI035 00070F* PI035 0000080FTAGS IP AF 41 DISK PI035 00090FOUTTAG IS AF 41 DISK PI035 00100FSTAGS O F 41 DISK PI035 00110E MSG 1 4 50 PI035 00120ITAGS NS 01 1 CT PI035 00130I 2 60TAGNO M1 PI035 00140I 1 41 RECORD PI035 0000150I NS 06 PI035 00160I 1 41 RECORD PI035 00170IOUTTAG NS 02 1 CT PI035 00180I 2 60TAGNO M1 PI035 00190I 1 41 RECORD PI035 00200I NS 07 PI035 00210I 1 41 RECORD PI035 0000220C N02 PI035 00230CORNMR GOTO END PI035 00240C* REPORT ERROR CONDITION AND REQUEST CANCEL PI035 00250C MOVEL'C' TYPE CLEAR SCREEN PI035 00260C Z-ADD1 BLNGTH PI035 00270C EXSR CRTCOM PI035 00280C MOVEL'T' TYPE PI035 0000290C MOVELMSG,1 BUFFER EXPLAIN PI035 00300C Z-ADD50 BLNGTH ERROR PI035 00310C EXSR CRTCOM SITUATION PI035 00320C MOVELMSG,2 BUFFER PI035 00330C EXSR CRTCOM PI035 00340C Z-ADD5 BLNGTH PI035 00350C MOVELTAGNO BUFFER SHOW DUP. TAG# PI035 0000360C EXSR CRTCOM PI035 00370C MOVELMSG,3 BUFFER REQUIRE PI035 00380C MOVEL'R' TYPE JOB PI035 00390C Z-ADD50 BLNGTH CANCEL-DOES PI035 00400C Z-ADD1 MASK NOT YET PI035 00410C EXSR CRTCOM WORK. PI035 00420C KILLIT TAG JUST IN CASE PI035 0000430C MOVELMSG,4 BUFFER IF SUBRCM PI035 00440C MOVEL'T' TYPE CANCEL FAILS, PI035 00450C Z-ADD50 BLNGTH THIS LOOP WILL PI035 00460C EXSR CRTCOM DO IT INSTEAD. PI035 00470C MOVEL'A' TYPE PI035 00480C Z-ADD1 BLNGTH PI035 00490C EXSR CRTCOM PI035 0000500C GOTO KILLIT PI035 00510C* PI035 00520C END TAG PI035 00530C* PI035 00540C* PI035 00550CSR CRTCOM BEGSR PI035 00560CSR EXITFSUBRCM PI035 0000570CSR RLABL BUFFER 80 PI035 00580CSR RLABL TYPE 1 PI035 00590CSR RLABL BLNGTH 20 PI035 00600CSR RLABL RCODE 1 PI035 00610CSR RLABL MASK 10 PI035 00620CSR RLABL DTYPE 10 PI035 00630CSR ENDSR PI035 0000640C* PI035 00650OSTAGS D 01 PI035 00660O OR 02NMR PI035 00670O RECORD 41 PI035 ** 000680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00070000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000710ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000720** MSG X 000730ERROR CONDITION HAS OCCURED IN PI035. X 000740THE FOLLOWING TAG NUMBER IS ON BOTH INPUT FILES X 000750ENTER 'C' TO CANCEL JOB,CORRECT PROBLEM,THEN RERUNX 000760MANUALLY CANCEL PROGRAM PI035!! X 00077000/* 000780_ 00 00 00 __ 0(Q& ITXPI030 P999999111111(000010H S PI030 00020X DECK-ID M49 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI030 00030F* THIS PROGRAM DOES THE TAG EDIT PI030 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI030 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI030 00060F* CONTROL DATA PROPRIETARY PRODUCT PI030 00070F* PI030 0000080FTAGS IP AF 41 DISK PI030 00090FPARTMST IC F 300R20AI 271 DISK PI030 00100FHEADING IT F 40 EDISK PI030 00110F$LP1 O F 132 OF PRINTER PI030 00120F********************************************************************PI030 00130F* PI030 00140F* INVENTORY TAG EDIT PI030 0000150F* PI030 00160F********************************************************************PI030 00170F* PI030 00180F* PI030 00190F********************************************************************PI030 00200F* ID F C H L FUNCTION OF INDICATORS PI030 00210F*01 'T' RECORD FROM TAGS PI030 0000220F*02 NON 'T' RECORD FROM TAGS PI030 00230F*03 RECORD FROM PARTMST PI030 00240F* 11 ZERO QUANITY--ERROR PI030 00250F* 23 AT LEAST ONE 01 RECORD HAS BEEN PROCESSED PI030 00260F* 51 PART # NOT ON MASTERFILE--ERROR PI030 00270F* 52 U/M NOT SAME AS THAT ON MASTERFILE--ERROR PI030 00280F* N61 NO ERRORS--SKIP ONE LINE PI030 0000290F* 1P FIRST PAGE PI030 00300F* OF OVERFLOW PI030 00310F* L1 BREAK ON EVER 100 TAGS-BREAK ON THIRD DIGIT PI030 00320F* LR LAST RECORD PI030 00330F********************************************************************PI030 00340E HEADING HEAD 1 1 40 PI030 00350ITAGS NS 02 1NCT PI030 0000360I 1 41 DUM1 PI030 00370I* PI030 00380I* PI030 00390I* PI030 00400I NS 01 PI030 00410I 2 60TTAG PI030 00420I 2 40DIGIT L1 PI030 0000430I 22 41 TPART PI030 00440I 13 14 TUM PI030 00450I 15 210TQTY 11 PI030 00460IPARTMST NS 03 PI030 00470I 271 290 PART PI030 00480I 1 37 DESC PI030 00490I 38 39 UM PI030 0000500I* PI030 00510C* PI030 00520C SETOF 515253 PI030 00530C SETOF 616263 PI030 00540C* PI030 00550C N01 GOTO END PI030 00560C* PI030 0000570C SETON 23 PI030 00580C COUNT ADD 1 COUNT 30 PI030 00590C CTQTY ADD TQTY CTQTY 80 PI030 00600C* PI030 00610C TPART CHAINPARTMST 51 PART NOT FOUND PI030 00620C N51 TUM COMP UM 5252 UM NOT SAME PI030 00630C* PI030 0000640C 51 PI030 00650COR 52 PI030 00660COR 11 SETON 61 PI030 00670C SEQ ADD 1 SEQ 60 PI030 00680C END TAG PI030 00690C* PI030 00700CL1N23 SETOF L1 PI030 0000710CL0N23 GOTO LASTL PI030 00720CL1 TOT ADD COUNT TOT 50 PI030 00730CL0 LASTL TAG PI030 00740C* PI030 00750C* PI030 00760C* PI030 00770O$LP1 H 102 1P PI030 0000780O OR OFN1P PI030 00790O HEAD,1 86 PI030 00800O UDATE Y 132 PI030 00810O 4 'PAGE' PI030 00820O PAGE Z 8 PI030 00830O H 2 1P PI030 00840O OR OFN1P PI030 0000850O 75 'INVENTORY TAG EDIT' PI030 00851O 5 'PI030' 00860O H 1 1P 00870O OR OFN1P 00880O 7 'TAG #' 00890O 22 'PART NUMBER' 00900O H 2 1P PI030 0000910O OR OFN1P PI030 00920O 23 'DESCRIPTION' PI030 00930O 63 'QTY' PI030 00940O 72 'U/M' PI030 00950O 125 'SEQ #' PI030 00960O D 01 01 00970O TTAG 3 7 0000980O TPART 31 00990O D 00 01 PI030 01000O N51 DESC 49 PI030 01010O TQTY J 65 PI030 01020O TUM 71 PI030 01030O SEQ J 125 PI030 01040O D 1 01 52 PI030 0001050O 103 '* U/M ON MASTERFILE IS' PI030 01060O UM 106 PI030 01070O 107 '.' PI030 01080O D 1 01 51 PI030 01090O 96 '* PART # NOT ON' PI030 01100O 108 'MASTERFILE.' PI030 01110O D 1 01 11 PI030 0001120O 95 '* QTY IS ZERO.' PI030 01130O D 1 01N61 PI030 01140O 1 ' ' PI030 01150O T 12 L1 PI030 01160O 24 'TOTAL TAGS THIS BLOCK' PI030 01170O COUNT 3B 29 PI030 01180O 44 'QTY TOTAL' PI030 0001190O CTQTY 1B 56 PI030 01200O T 00 LR PI030 01210O 13 'TOTAL TAGS' PI030 01220O TOT 3 21 PI030 ** 001230ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001240ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00125000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001260ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001270/* 001280_ 00 00 00 00 00 00 00__ 0(X7 XTXWP200 PF999999032978(000010H S WP200 00020X DECK-ID P05 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP200 00030F* OPEN WORKORDER TRANSACTION UPDATE PROGRAM WP200 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP200 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP200 00060F* CONTROL DATA PROPRIETARY PRODUCT WP200 00070F* WP200 0000080FSWTRAN UPEAF 60 DISK WP200 00090FWRKORD UC F 160R 5AI 1 DISK A WP200 00100FTRNWO1 O F 65 DISK A WP200 00110FOHEXPL O F 50 DISK WP200 00120F* ID F C H L FUNCTION OF INDICATORS WP200 00130F* 01,02,05 RECORD IDENTIFYING INDICATORS WP200 00140F* 20,21 COMPARE INDICATORS WP200 0000150F* 54 OPNUM = '999' WP200 00160F* 55 NO HIT ON WRKORD FILE OR RECORD DELETED WP200 00170F* 56 OPEN BUT NOT RELEASED (STATUS = 'O') WP200 00180F* 57 RELEASED (STATUS = 'R') WP200 00190F* 58 CLOSED (STATUS = 'C') WP200 00200F* 59 DELETED (STATUS = 'D') WP200 00210F* 60 ADD WHEN RECORD IS PRESENT BUT DELETED WP200 0000220F* 80 OUTPUT WRKORD RECORD WP200 00230F* 88 OUTPUT OHEXPL RECORD WP200 00240F* 89 ADD TRANSAC RECORD WP200 00250F* 90 AT LEAST ONE VALID TRANSACTION FOR THIS WORK ORDER WP200 00260F*H1 INVALID TRANSACTION WP200 00270F********************************************************************WP200 00280F** WP200 0000290F** THIS PROGRAM UPDATES THE WRKORD FILE BY PROCESSING WORK WP200 00300F** ORDER TRANSACTIONS 51,52,53,58,62,63 AND 54,56,57,59 IF WP200 00310F** THE OPERATION # IS '999' ANY TRANSACTIONS WHICH HAVE AN ERROR WP200 00320F** CODE GREATER THAN 20 ARE IGNORED. WP200 00330F** THE TRANSACTION FILE IS READ IN SEQUENITALLY BY WORK ORDER #, WP200 00340F** TRANSACTION # AND 'WRKORD' IS UPDATED AT TOTAL L1 TIME WP200 00350F** WP200 0000360F** THE SWTRAN FILE IS UPDATED WITH AN ERROR CODE IF AN ERROR WP200 00370F** OR WARNING CONDITION IS ENCOUNTERED. WP200 00380F** WP200 00390F** INFORMATION AFFECTING THE 'PARTMST' FILE IS PASSED TO THE WP200 00400F** 'ITA' MODULE VIA INVENTORY TRANSACTIONS ADDED TO TRANSAC. WP200 00410F** WP200 00420ISWTRAN NS 02 1NC 2NC WP200 0000430I 1 20TC WP200 00440I 3 70TWONUML1 WP200 00450I 8 27 TPRTNO WP200 00460I 32 32 TSTAT WP200 00470I 33 390TQTY WP200 00480I 40 450TRLSDT WP200 00490I 46 510TREQDT WP200 0000500I 52 54 TPRI WP200 00510I 55 55 TREQCD WP200 00520I 59 600TERR WP200 00530I* NS 01 WP200 00540I* 1 20TC WP200 00550I* 3 70TWONUML1 WP200 00560I* 8 100OPNUM WP200 0000570I* 11 11 MTYPE WP200 00580I* 12 180TQTY WP200 00590I* 19 20 LABGRD WP200 00600I* 21 260TDLRS WP200 00610I* 27 50 TPRTNO WP200 00620I* 51 541TBRDF WP200 00630I* 55 570TOPER WP200 0000640I* 58 58 TOMTYP WP200 00650I 59 600TERR WP200 00660IWRKORD NS 05 WP200 00670I 6 25 TP WP200 00680I 30 30 F1 WP200 00690I 31 370F2 WP200 00700I 38 440F3 WP200 0000710I 67 720F4 WP200 00720I 73 780F5 WP200 00730I 79 840F6 WP200 00740I 85 900F7 WP200 00750I 91 960F8 WP200 00760I 97 1010F9 WP200 00770I 102 1060F10 WP200 0000780I 107 1130F11 WP200 00790I 51 56 F12 WP200 00800C Z-ADD00 Z6 60 WP200 00810C Z-ADD0 Z5 50 WP200 00820C TERR COMP 20 20 WP200 00830C 20 GOTO DEND WP200 00840C Z-ADD0 ERRNO 20 WP200 0000850C NL1 GOTO CHKST WP200 00860C********************************************************************WP200 00870C* WP200 00880C* THIS SECTION CHAINS TO WRKORD AND MOVES THE INPUT FIELDS WP200 00890C* TO THE EVENTUAL OUTPUT FIELDS. THIS IS DONE BECAUSE THIS WP200 00900C* COMPILING WON'T ALLOW YOU UPDATE AT TOTAL TIME WITHOUT RE-READINGWP200 00910C* THE RECORD. WP200 0000920C* WP200 00930C********************************************************************WP200 00940C SETOF 90 WP200 00950C TWONUM CHAINWRKORD 55 WP200 00960C 55 GOTO CHKST WP200 00970C MOVE TP PARTNO WP200 00980C MOVE F1 STATUS 1 WP200 0000990C MOVE F2 QTY 70 WP200 01000C MOVE F3 QTYCOM 70 WP200 01010C MOVE F4 MAT$ 60 WP200 01020C MOVE F5 LAB$ 60 WP200 01030C MOVE F6 BUR$ 60 WP200 01040C MOVE F7 OPC$ 60 WP200 01050C MOVE F8 RWK$ 60 WP200 0001060C MOVE F9 LHRS 50 WP200 01070C MOVE F10 RHRS 50 WP200 01080C MOVE F11 SCRAP 70 WP200 01090C MOVE F12 REQDAT 60 WP200 01100C********************************************************************WP200 01110C* NOW WE CHECK THE STATUS OF THE WORK ORDER. IT CAN BE OPEN ('O'), WP200 01120C* RELEASED ('R'),CLOSED ('C'), OR DELETED ('D'). IF AN ORDER WP200 0001130C* IS DELETED THE 'NO-HIT' INDICATOR IS ALSO SET ON. WP200 01140C* WP200 01150C********************************************************************WP200 01160C CHKST TAG WP200 01170C L1 55 MOVE ' ' STATUS WP200 01180C STATUS COMP 'O' 56 WP200 01190C STATUS COMP 'R' 57 WP200 0001200C STATUS COMP 'C' 58 WP200 01210C STATUS COMP 'D' 59 WP200 01220C 59 SETON 55 WP200 01230C* OPNUM COMP 999 54 WP200 01240C********************************************************************WP200 01250C TC COMP 51 20 WP200 01260C 20 GOTO TC51 WP200 0001270C TC COMP 52 20 WP200 01280C 20 GOTO TC52 WP200 01290C TC COMP 53 20 WP200 01300C 20 GOTO TC53 WP200 01310C TC COMP 54 20 WP200 01320C 20 GOTO TC54 WP200 01330C TC COMP 55 20 WP200 0001340C 20 GOTO DEND WP200 01350C TC COMP 56 20 WP200 01360C 20 GOTO TC56 WP200 01370C TC COMP 57 20 WP200 01380C 20 GOTO TC57 WP200 01390C TC COMP 58 20 WP200 01400C 20 GOTO TC58 WP200 0001410C TC COMP 59 20 WP200 01420C 20 GOTO TC59 WP200 01430C TC COMP 60 20 WP200 01440C 20 GOTO DEND WP200 01450C TC COMP 61 20 WP200 01460C 20 GOTO DEND WP200 01470C TC COMP 62 20 WP200 0001480C 20 GOTO TC62 WP200 01490C TC COMP 63 20 WP200 01500C 20 GOTO TC63 WP200 01510C BADTC TAG WP200 01520C SETON H1 WP200 01530C GOTO DEND WP200 01540C********************************************************************WP200 0001550C* WP200 01560C* TC 51 ADDS A NEW RECORD TO WRKORD. IF THE RECORD IS PRESENT AND WP200 01570C* NOT DELETED THEN THE TRANSACTION IS REJECTED. IF THE TRANSACTION WP200 01580C* STATUS IS 'R' THEN TC52 IS PROCESSED ALSO WP200 01590C********************************************************************WP200 01600C TC51 TAG WP200 01610C TREQDT COMP 0 2020 WP200 0001620C 20 Z-ADD26 ERRNO WP200 01630C TQTY COMP 0 2020 WP200 01640C 20 Z-ADD27 ERRNO WP200 01650C N55N59 Z-ADD25 ERRNO WP200 01660C 58 Z-ADD40 ERRNO WP200 01670C ERRNO COMP 0 20 WP200 01680C 20 GOTO DEND WP200 0001690C 59 SETON 60 ZERO VARIANCE WP200 01700C SETON 90 WP200 01710C MOVE TWONUM WONUM 50 WP200 01720C MOVE TPRTNO PARTNO 20 WP200 01730C MOVE 'O' STATUS WP200 01740C MOVE TQTY QTY WP200 01750C MOVE TRLSDT RLSDAT 60 WP200 0001760C MOVE TREQDT REQDAT 60 WP200 01770C MOVE TPRI PRI 3 WP200 01780C MOVE TREQCD REQCOD 1 WP200 01790C MOVE ' ' OOOCD 1 WP200 01800C Z-ADD0 QTYCOM WP200 01810C Z-ADD0 RRN 50 WP200 01820C Z-ADDZ6 MAT$ WP200 0001830C Z-ADDZ6 LAB$ WP200 01840C Z-ADDZ6 BUR$ WP200 01850C Z-ADDZ6 OPC$ WP200 01860C Z-ADDZ6 RWK$ WP200 01870C Z-ADDZ5 LHRS WP200 01880C Z-ADDZ5 RHRS WP200 01890C Z-ADD0 SCRAP WP200 0001900C Z-ADD60 ITRN 20 WP200 01910C Z-ADDQTY IQTY 70 WP200 01920C EXSR OUTRNS WP200 01930C TSTAT COMP 'R' 56 WP200 01940C 56 Z-ADD52 TC WP200 01950C 56 GOTO GOOD52 WP200 01960C GOTO DEND WP200 0001970C********************************************************************WP200 01980C* WP200 01990C* TC 52 RELEASES A WORK ORDER. THE PART# AND QTY ARE OUTPUT TO WP200 02000C* 'OHEXPL' WHICH IS USED TO EXPLODE THE PART # INTO A PICK LIST. WP200 02010C* WP200 02020C* IF THE TRANSACTION QUANTITY IS NON-ZERO, THE WRKORD QTY THEN WP200 02030C* AN ITA TRANSACTION IS CREATED WHICH WILL ADJUST STOCK ON ORDER. WP200 0002040C* WP200 02050C********************************************************************WP200 02060C TC52 TAG WP200 02070C N56 Z-ADD29 ERRNO WP200 02080C 55 Z-ADD28 ERRNO WP200 02090C 58 Z-ADD40 ERRNO WP200 02100C N56 WP200 0002110COR 55 WP200 02120COR 58 GOTO DEND WP200 02130C GOOD52 TAG WP200 02140C SETON 90 WP200 02150C MOVE 'R' STATUS WP200 02160C Z-ADDUDATE RLSDAT WP200 02170C MOVELPARTNO TPRTNO WP200 0002180C TQTY COMP 0 20 WP200 02190C N20 GOTO OUTEX WP200 02200C TQTY SUB QTY IQTY 70 WP200 02210C Z-ADDTQTY QTY 20 WP200 02220C Z-ADD64 ITRN WP200 02230C 20 EXSR OUTRNS WP200 02240C OUTEX TAG WP200 0002250C Z-ADDQTY EXQTY 70 20 WP200 02260C 20 EXSR OUTOHX WP200 02270C GOTO DEND WP200 02280C********************************************************************WP200 02290C* WP200 02300C* TC 53 CHANGES THE JOB QUANTITY. IF THE WORK ORDER HAS ALREADY WP200 02310C* BEEN RELEASED (STAUS = 'R'), THEN AN ENTRY IS ADDED TO 'OHEXPL' WP200 0002320C* TO EXPLODE OUT HTE DIFFERENCE IN COMPONENT STOCK-ON-HAND. WP200 02330C* WP200 02340C* IF THE WORK ORDER IS OPEN OR RELEASED THEN AN ITA TRANSACTION WP200 02350C* IS OUTPUT TO ADJUST THE STOCK ON ORDER. WP200 02360C* WP200 02370C********************************************************************WP200 02380C TC53 TAG WP200 0002390C QTYCOM ADD SCRAP TOTCOM 70 WP200 02400C TOTCOM COMP TQTY 20 WP200 02410C 20 Z-ADD30 ERRNO WP200 02420C 55 Z-ADD28 ERRNO WP200 02430C 58 Z-ADD40 ERRNO WP200 02440C 55 WP200 02450COR 58 WP200 0002460COR 20 GOTO DEND WP200 02470C SETON 90 WP200 02480C TQTY SUB QTY IQTY WP200 02490C MOVE TQTY QTY WP200 02500C Z-ADD64 ITRN WP200 02510C EXSR OUTRNS WP200 02520C* WP200 0002530C Z-ADDIQTY EXQTY 2020 WP200 02540C 57 20 EXSR OUTOHX WP200 02550C GOTO DEND WP200 02560C********************************************************************WP200 02570C* WP200 02580C* TC 54 PROCESSES COMPLETIONS. THE TRANSACTION QUANITY CAN BE WP200 02590C* NEGATIVE BUT CAN'T CAUSE THE WORK ORDER QUANTITY TO GO BELOW WP200 0002600C* ZERO. TWO ITA TRANSACTIONS ARE CREATED. ONE IS TO INCREMENT WP200 02610C* (OR DECREMENT) THE STOCK-ON-HAND AND THE OTHER IS TO DECREMENT WP200 02620C* THE STOCK-ON-ORDER. THESE TWO TRANSACTIONS ARE NOT COMBINED WP200 02630C* BECAUSE THE TWO ADJUSTEMNT QUANTITIES CAN BE DIFFERENT. WP200 02640C* WP200 02650C********************************************************************WP200 02660C TC54 TAG WP200 0002670C* N54 GOTO DEND WP200 02680C QTYCOM ADD TQTY NEWQTY 70 20 WP200 02690C 20 Z-ADD31 ERRNO WP200 02700C 55 Z-ADD28 ERRNO WP200 02710C 20 WP200 02720COR 55 GOTO DEND WP200 02730C Z-ADDNEWQTY QTYCOM WP200 0002740C DOITR TAG WP200 02750C SETON 90 WP200 02760C QTYCOM ADD SCRAP TOTCOM 70 WP200 02770C QTY SUB TOTCOM IQTY 21 WP200 02780C IQTY ADD TQTY IQTY 20 WP200 02790C 20 Z-ADD0 IQTY WP200 02800C TQTY COMP IQTY 20 WP200 0002810C 20 Z-ADDTQTY IQTY WP200 02820C Z-ADD73 ITRN WP200 02830C EXSR OUTRNS WP200 02840C Z-ADDTQTY IQTY WP200 02850C Z-ADD72 ITRN WP200 02860C EXSR OUTRNS WP200 02870C 21 Z-ADD2 ERRNO WP200 0002880C 58 Z-ADD3 ERRNO WP200 02890C 58 Z-ADDUDATE RLSDAT WP200 02900C GOTO DEND WP200 02910C********************************************************************WP200 02920C TC56 TAG PROCESS SCRAP WP200 02930C* N54 GOTO DEND REPORT WP200 02940C 55 Z-ADD28 ERRNO WP200 0002950C 55 GOTO DEND WP200 02960C SCRAP ADD TQTY SCRAP 20 WP200 02970C 20 TQTY ADD SCRAP TQTY WP200 02980C 20 Z-ADD0 SCRAP WP200 02990C Z-ADD56 TC WP200 03000C 20 Z-ADD4 ERRNO WP200 03010C GOTO DOITR WP200 0003020C********************************************************************WP200 03030C* WP200 03040C* TC 57 PROCESSES REPORTED LABOR. THE ACCUMULATED LABOR DOLLARS WP200 03050C* IS INCREMENTED.BY THE TRANSACTION DOLLARS. THE BURDEN DOLLARS WP200 03060C* IS INCREMENTED BY THE TRANSACTION DOLLARS MULITIPLIED BY THE WP200 03070C* TRANSACTION BURDEN FACTOR, WP200 03080C* WP200 0003090C* IF THE MATERIAL TYPE = 'R' IN THE TRANSACTION RECORD THEN WP200 03100C* THE REWORK DOLLARS FIELD IS UPDATED INSTEAD OF THE LABOR DOLLARS WP200 03110C* FIELD. WP200 03120C* WP200 03130C********************************************************************WP200 03140C TC57 TAG WP200 03150C* N54 GOTO DEND WP200 0003160C 55 Z-ADD28 ERRNO WP200 03170C 55 GOTO DEND WP200 03180C 58 Z-ADD3 ERRNO WP200 03190C 58 Z-ADDUDATE RLSDAT WP200 03200C SETON 90 WP200 03210C* TBRDF MULT TDLRS BURDEN 70 WP200 03220C* BURDEN ADD BUR$ BUR$ 20 WP200 0003230C 20 Z-ADD0 BUR$ WP200 03240C 20 Z-ADD11 ERRNO WP200 03250C* MTYPE COMP 'R' 20 WP200 03260C 20 GOTO RWORK WP200 03270C LHRS ADD TQTY LHRS 20 WP200 03280C 20 Z-ADD0 LHRS WP200 03290C 20 Z-ADD12 ERRNO WP200 0003300C* LAB$ ADD TDLRS LAB$ 20 WP200 03310C 20 Z-ADD0 LAB$ WP200 03320C 20 Z-ADD5 ERRNO WP200 03330C GOTO DEND WP200 03340C RWORK TAG WP200 03350C RHRS ADD TQTY RHRS 20 WP200 03360C 20 Z-ADD0 RHRS WP200 0003370C 20 Z-ADD14 ERRNO WP200 03380C* RWK$ ADD TDLRS RWK$ 20 WP200 03390C 20 Z-ADD0 RWK$ WP200 03400C 20 Z-ADD13 ERRNO WP200 03410C GOTO DEND WP200 03420C********************************************************************WP200 03430C* WP200 0003440C* TC 58 PROCESSES MATERIAL ISSUED TO A WORK ORDER. THE TRANSACTION WP200 03450C* DOLLARS FIELD IS ADDED TO THE ACCUMULATED MATERIAL DOLLARS. WP200 03460C* WP200 03470C* AN ITA TRANSACTION IS OUTPUT WHICH ADJUSTS STOCK-ON-HAND WP200 03480C* WP200 03490C********************************************************************WP200 03500C TC58 TAG WP200 0003510C 55 Z-ADD28 ERRNO WP200 03520C 55 GOTO DEND WP200 03530C 58 Z-ADD3 ERRNO WP200 03540C 58 Z-ADDUDATE RLSDAT WP200 03550C* MAT$ ADD TDLRS MAT$ 20 WP200 03560C 20 Z-ADD0 MAT$ WP200 03570C 20 Z-ADD6 ERRNO WP200 0003580C Z-ADDTQTY IQTY WP200 03590C Z-ADD63 ITRN WP200 03600C EXSR OUTRNS WP200 03610C SETON 90 WP200 03620C GOTO DEND WP200 03630C********************************************************************WP200 03640C* WP200 0003650C* TC 59 PROCESSES REPORTED OUTSIDE PROCESSING. OUTSIDE PROCESSING WP200 03660C* DOLLARS IS INCREMENTED BY THE TRANSACTION DOLLARS. WP200 03670C* WP200 03680C********************************************************************WP200 03690C TC59 TAG WP200 03700C* N54 GOTO DEND WP200 03710C 55 Z-ADD28 ERRNO WP200 0003720C 55 GOTO DEND WP200 03730C 58 Z-ADD3 ERRNO WP200 03740C 58 Z-ADDUDATE RLSDAT WP200 03750C* OPC$ ADD TDLRS OPC$ 20 WP200 03760C 20 Z-ADD0 OPC$ WP200 03770C 20 Z-ADD7 ERRNO WP200 03780C SETON 90 WP200 0003790C GOTO DEND WP200 03800C********************************************************************WP200 03810C* WP200 03820C* TC 62 MOVES A 'C' IN THE STATUS FIELD. IT ALSO ADDS AN ITA WP200 03830C* TRANSACTION IF THE WORK ORDER WAS CLOSED SHORT. THIS TRANSACTION WP200 03840C* ADJUSTS STOCK-ON-ORDER. WP200 03850C* WP200 0003860C********************************************************************WP200 03870C TC62 TAG WP200 03880C 55 Z-ADD28 ERRNO WP200 03890C 58 Z-ADD32 ERRNO WP200 03900C 55 WP200 03910COR 58 GOTO DEND WP200 03920C MOVE 'C' STATUS WP200 0003930C Z-ADDUDATE RLSDAT WP200 03940C QTY SUB QTYCOM IQTY WP200 03950C IQTY SUB SCRAP IQTY 20 WP200 03960C Z-ADD68 ITRN WP200 03970C 20 EXSR OUTRNS WP200 03980C SETON 90 WP200 03990C GOTO DEND WP200 0004000C********************************************************************WP200 04010C* WP200 04020C* TC 63 MARKS A WORK ORDER AS DELETED. THE TRANSACTION IS REJECTED WP200 04030C* IF THE QUANTITY COMPLETED FIELD IS GREATER THAN ZERO. WP200 04040C* WP200 04050C********************************************************************WP200 04060C TC63 TAG WP200 0004070C 55 Z-ADD28 ERRNO WP200 04080C QTYCOM COMP 0 20 WP200 04090C 20 Z-ADD33 ERRNO WP200 04100C 55 WP200 04110COR 20 GOTO DEND WP200 04120C MOVE 'D' STATUS WP200 04125C Z-ADD66 ITRN 0004126C EXSR OUTRNS 04130C SETON 90 WP200 04140C GOTO DEND WP200 04150C********************************************************************WP200 04160C DEND TAG WP200 04170C ERRNO COMP 0 87 WP200 04180C********************************************************************WP200 0004190C* WP200 04200C* NOW WE ACCESS THE WORK ORDER RECORD AGAIN AND UPDATE IT WP200 04210C* WP200 04220C********************************************************************WP200 04230CL1 90 TWONUM CHAINWRKORD 55 WP200 04240CL1 SETON 80 WP200 04250CL1 90 EXCPT WP200 0004260CL1 SETOF 8060 WP200 04270C********************************************************************WP200 04280C* WP200 04290C* THIS ROUTINE OUTPUTS A RECORD TO THE ON-HAND EXPLODE FILE. WP200 04300C* WP200 04310C********************************************************************WP200 04320CSR OUTOHX BEGSR WP200 0004330CSR SETON 88 WP200 04340CSR EXCPT WP200 04350CSR SETOF 88 WP200 04360CSR ENDSR WP200 04370C********************************************************************WP200 04380C* WP200 04390C* THIS ROUTINE OUTPUTS AN ITA TRANSACTION RECORD. THE REFERENCE WP200 0004400C* NUMBER IS 'WO' FOLLOWED BY THE WORK ORDER # WP200 04410C* WP200 04420C********************************************************************WP200 04430CSR OUTRNS BEGSR WP200 04440CSR TPRTNO COMP ' ' 20 WP200 04450CSR 20 MOVELPARTNO TPRTNO WP200 04460CSR MOVELTPRTNO PRTNUM 20 ONLY 20 IN ITA WP200 0004470CSR MOVEL'WO' REFNO 7 WP200 04480CSR MOVE TWONUM REFNO WP200 04490CSR SETON 89 WP200 04500CSR EXCPT ADD RECORD WP200 04510CSR SETOF 89 WP200 04520CSR ENDSR WP200 04530OWRKORD E 80N55 WP200 0004540O STATUS 30 WP200 04550O QTY 37 WP200 04560O QTYCOM 44 WP200 04570O RLSDAT 50 WP200 04580O MAT$ 72 WP200 04590O LAB$ 78 WP200 04600O BUR$ 84 WP200 0004610O OPC$ 90 WP200 04620O RWK$ 96 WP200 04630O LHRS 101 WP200 04640O RHRS 106 WP200 04650O SCRAP 113 WP200 04660O 60 Z6 119 WP200 04670O 60 Z6 125 WP200 0004680O 60 Z6 131 WP200 04690O 60 Z6 137 WP200 04700O 60 Z6 143 WP200 04710O 60 Z5 148 WP200 04720O 60 Z5 153 WP200 04730O EADD 80 55 WP200 04740O WONUM 5 WP200 0004750O PARTNO 25 WP200 04760O STATUS 30 WP200 04770O QTY 37 WP200 04780O QTYCOM 44 WP200 04790O RLSDAT 50 WP200 04800O REQDAT 56 WP200 04810O PRI 60 WP200 0004820O REQCOD 57 WP200 04830O OOOCD 61 WP200 04840O RRN 66 WP200 04850O MAT$ 72 WP200 04860O LAB$ 78 WP200 04870O BUR$ 84 WP200 04880O OPC$ 90 WP200 0004890O RWK$ 96 WP200 04900O LHRS 101 WP200 04910O RHRS 106 WP200 04920O SCRAP 113 WP200 04930O Z6 119 WP200 04940O Z6 125 WP200 04950O Z6 131 WP200 0004960O Z6 137 WP200 04970O Z6 143 WP200 04980O Z5 148 WP200 04990O Z5 153 WP200 05000OSWTRAN D 87 WP200 05010O ERRNO 60 WP200 05020OOHEXPL E 88 WP200 0005030O TWONUM 5 WP200 05040O TPRTNO 25 WP200 05050O TC 31 WP200 05060O EXQTY 38 WP200 05070O REQDAT 44 WP200 05080OTRNWO1 EADD 89 WP200 05090O PRTNUM 61 WP200 0005100O ITRN 14 WP200 05110O IQTY 21 WP200 05120O REFNO 28 WP200 05130O UDATE 34 WP200 ** 005140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00516000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005180/* 005190_ 00 00 00 00 00 00 00 00 00 00 00 __ 0(2k 2TXPI050 P999999111111(000010H S PI050 00020X DECK-ID M51 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI050 00030F* THIS PROGRAM REFORMATS TAG FILE TO TRANWRK FILE FORMAT PI050 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI050 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI050 00060F* CONTROL DATA PROPRIETARY PRODUCT PI050 00070F* PI050 0000080FOUTTAG IP F 41 DISK PI050 00090FTRANWRK O F 65 DISK PI050 00100IOUTTAG NS 01 1 CT PI050 00110I 2 60TAG PI050 00120I 22 41 PART PI050 00130I 15 210QTY PI050 00140I NS 02 1NCT PI050 0000150I 1 1 A PI050 00160OTRANWRK D 01 PI050 00170O PART 61 PI050 00180O 14 '88' PI050 00190O QTY 21 PI050 00200O TAG 28 PI050 00210O UDATE 34 PI050 00** 000220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000260/* 000270_ 00 00 00 00 __ 0(^=$ ^TXPI650 P 2 091177111111(000010H S PI650 00020X DECK-ID M53 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI650 00030F* THIS PROGRAM IS USED FOR STOCK STATUS LISTINGS PI650 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0PI650 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI650 00060F* CONTROL DATA PROPRIETARY PRODUCT PI650 00070F* PI650 0000080FPARTMST IPEAF 300 20AI 271 DISK PI650 00090FHEADING IT F 40 EDISK PI650 00100F$LP1 O F 132 OF PRINTER PI650 00110F********************************************************************PI650 00120F** PI650 00130F** PACKAGE MANUFACTURING PI650 00140F** SYSTEM INVENTORY TRANSACTION ACCOUNTING PI650 0000150F** PROGRAM STOCK STATUS & EXCEPTION STOCK STATUS PI650 00160F** PI650 00170F** CONTRACTOR COMPUSOURCE PI650 00180F** PROGRAMMER PI650 00190F** DATE PI650 00200F** PI650 00210F********************************************************************PI650 0000220F* PI650 00230F* NARRATIVE: IF U1 -> PRINT EXCEPTION REPORT PI650 00240F* NU1 -> PRINT REGULAR REPORT PI650 00250F* PI650 00260F* EXCEPTION REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT PI650 00270F* BY OPERATOR WITH A BLANK DELETE CODE AND WITH AVAIL < MIN. PI650 00280F* PI650 0000290F* REGULAR REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT PI650 00300F* BY OPERATOR WITH A BLANK DELETE CODE. IF AVAIL < MIN, THEN PI650 00310F* RECORD IS FLAGGED WITH '**' AT END OF LINE ON PRINT OUT. PI650 00320F* PI650 00330F********************************************************************PI650 00340F* PI650 00350F* ID F C H L FUNCTION OF INDICATORS PI650 0000360F* PI650 00370F* 01 PARTMST -- CLASS = 'F' -- DELETE CODE BLANK PI650 00380F* 02 PARTMST -- CLASS = 'P' -- DELETE CODE BLANK PI650 00390F* 03 PARTMST -- CLASS = 'M' -- DELETE CODE BLANK PI650 00400F* 04 PARTMST -- ALL OTHERS PI650 00410F* PI650 00420F* 10 TAKE IN DATA FROM CRT PI650 0000430F* 11 'F'-TYPE INTERESTED IN IS 'F' PI650 00440F* 12 'P'-TYPE INTERESTED IN IS 'P' PI650 00450F* 13 'M'-TYPE INTERESTED IN IS 'M' PI650 00460F* 14 'A'-TYPE INTERESTED IN IS 'F'/'P'/'M' PI650 00470F* 15 AMONGST PRODUCT CLASS ARE INTERESTED IN PI650 00480F* 20 AVAIL < MIN PI650 00490F* 97 CRT LOOP WATCHER PI650 0000500F* 98 CRT LOOP WATCHER PI650 00510F* 99 DUMMY 1P PI650 00520F********************************************************************PI650 00530E HEADING HEAD 1 1 40 COMPANY NAME PI650 00540E MSG 1 9 56 CRT SCREEN PI650 00550E EMP9 1 9 BLANK PI650 00560IPARTMST NS 01 40 CF 74 C PI650 0000570I OR 02 40 CP 74 C PI650 00580I OR 03 40 CM 74 C PI650 00590I OR 04 PI650 00600I 271 290 PARTNO PI650 00610I 1 37 DESCRP PI650 00620I 38 39 UM PI650 00630I 40 40 CLASS PI650 0000640I 146 1520SOH PI650 00650I 153 1590SOO PI650 00660I 167 1730ALLOC PI650 00670I 181 1870MIN PI650 00680I 188 1940MAX PI650 00690I 196 2020MTDUSE PI650 00700I 203 2090AVGUSE PI650 0000710I 212 2180YTDUSE PI650 00720C SETOF 99 PI650 00730C 10 GOTO START PI650 00740C SETON 1099 PI650 00750C EXSR CRT PI650 00760C* PI650 00770C START TAG PI650 0000780C* CRT INPT/REC PI650 00790C SETOF 15 PI650 00800C 11 01 F/F PI650 00810COR 12 02 P/P PI650 00820COR 13 03 M/M PI650 00830COR 14 01 A/F PI650 00840COR 14 02 A/P PI650 0000850COR 14 03 SETON 15A/M PI650 00860C* PI650 00870C N15 GOTO NEXT PI650 00880C* PI650 00890C SOH ADD SOO AVAIL 70 PI650 00900C AVAIL SUB ALLOC AVAIL PI650 00910C* PI650 0000920C AVAIL COMP MIN 20 PI650 00930C* PI650 00940C NEXT TAG PI650 00950C* PI650 00960CLR EXSR CLRSCR PI650 00970C********************************************************************PI650 00980C* PI650 0000990C* THIS SUBROUTINE INQUIRES WHICH PRODUCT CLASS [OR ALL] PI650 01000C* IS TO BE LISTED. PI650 01010C* PI650 01020C* REPLY EFFECT PI650 01030C* ------- --------------------------------------------------- PI650 01040C* F ALL FINISHED GOODS NOT FLAGGED FOR DELETION PI650 01050C* P ALL PURCHASED GOODS NOT FLAGGED FOR DELETION PI650 0001060C* M ALL ASSEMBLIES NOT FLAGGED FOR DELETION PI650 01070C* A ALL GOODS NOT FLAGGED FOR DELETION PI650 01080C* PI650 01090C********************************************************************PI650 01100CSR CRT BEGSR PI650 01110CSR EXSR CLRSCR PI650 01120CSR Z-ADD0 I 20 PI650 0001130CSR LOOP1 TAG PI650 01140CSR I ADD 1 I PI650 01150CSR EXSR SETUP PI650 01160CSRNU1 I COMP 3 98 PI650 01170CSRNU1 98 MOVELEMP9,1 BUFFER PI650 01180CSR EXSR OUTS PI650 01190CSR I COMP 8 97 PI650 0001200CSR 97 GOTO LOOP1 PI650 01210C* PI650 01220CSR INPUT TAG PI650 01230CSR Z-ADD1404 CURPOS 40 PI650 01240CSR EXSR POSCUR PI650 01250CSR Z-ADD1 LNGTH 20 PI650 01260CSR EXSR ACCEPT PI650 0001270CSR MOVELBUFFER CHECK 1 PI650 01280CSR MOVEL']' BUFFER PI650 01290CSR EXSR OUTS PI650 01300CSR CHECK COMP 'F' 11FINISHED GOODS PI650 01310CSR CHECK COMP 'P' 12PURCHASED GOODSPI650 01320CSR CHECK COMP 'M' 13ASSEMBLIES PI650 01330CSR CHECK COMP 'A' 14ALL PI650 0001340CSR Z-ADD9 I PI650 01350CSR EXSR SETUP PI650 01360CSR 11 PI650 01370COR 12 PI650 01380COR 13 PI650 01390COR 14 MOVELEMP9,1 BUFFER PI650 01400CSR EXSR OUTS PI650 0001410CSRN11N12N13 PI650 01420CANN14 GOTO INPUT PI650 01430CSR ENDSR PI650 01440C********************************************************************PI650 01450C* PI650 01460C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. PI650 01470C* IT DEFINES ALL THE RLABL'S NECESSARY PI650 0001480C* PI650 01490C********************************************************************PI650 01500CSR CRTCOM BEGSR PI650 01510CSR EXITFSUBRCM PI650 01520CSR RLABL BUFFER 72 PI650 01530CSR RLABL TYPE 1 PI650 01540CSR RLABL BLNGTH 20 PI650 0001550CSR RLABL RCODE 1 PI650 01560CSR RLABL MASK 10 PI650 01570CSR RLABL DTYPE 10 PI650 01580CSR ENDSR PI650 01590C********************************************************************PI650 01600C* PI650 01610C* THIS SUBROUTINE SPLITS-UP CRT ARRAY ELEMENT, POSITIONS THE PI650 0001620C* CURSOR, AND STUFFS THE BUFFER. PI650 01630C* PI650 01640C********************************************************************PI650 01650CSR SETUP BEGSR PI650 01660CSR MOVELMSG,I WORD6 60 PI650 01670CSR MOVE MSG,I WORD50 50 PI650 01680CSR MOVELWORD6 CURPOS PI650 0001690CSR MOVE WORD6 LNGTH PI650 01700CSR EXSR POSCUR PI650 01710CSR MOVELWORD50 BUFFER PI650 01720CSR ENDSR PI650 01730C********************************************************************PI650 01740C* PI650 01750C* THIS SUBROUTINE CLEARS THE SCREEN. PI650 0001760C* PI650 01770C********************************************************************PI650 01780CSR CLRSCR BEGSR PI650 01790CSR MOVEL'C' TYPE PI650 01800CSR EXSR CRTCOM PI650 01810CSR ENDSR PI650 01820C********************************************************************PI650 0001830C* PI650 01840C* THIS SUBROUTINE POSITIONS THE CURSOR. PI650 01850C* PI650 01860C********************************************************************PI650 01870CSR POSCUR BEGSR PI650 01880CSR MOVELCURPOS BUFFER PI650 01890CSR MOVEL'P' TYPE PI650 0001900CSR EXSR CRTCOM PI650 01910CSR ENDSR PI650 01920C********************************************************************PI650 01930C* PI650 01940C* THIS SUBROUTINE ACCEPTS TYPE TO THE CRT FROM PI650 01950C* THE KEYBOARD. PI650 01960C* PI650 0001970C********************************************************************PI650 01980CSR ACCEPT BEGSR PI650 01990CSR MOVELLNGTH BLNGTH PI650 02000CSR MOVEL'A' TYPE PI650 02010CSR EXSR CRTCOM PI650 02020CSR ENDSR PI650 02030C********************************************************************PI650 0002040C* PI650 02050C* THIS SUBROUTINE OUTPUTS PRINT TO THE CRT AND PI650 02060C* REPOSITIONS THE CURSOR AT (BLNGTH + 1). PI650 02070C* PI650 02080C********************************************************************PI650 02090CSR OUTS BEGSR PI650 02100CSR MOVELLNGTH BLNGTH PI650 0002110CSR MOVEL'S' TYPE PI650 02120CSR EXSR CRTCOM PI650 02130CSR ENDSR PI650 02140C********************************************************************PI650 02150O$LP1 H 202 1P PI650 02160O OR OF PI650 02170O PAGE Z 8 PI650 0002180O 4 'PAGE' PI650 02190O HEAD,1 86 PI650 02200O UDATE Y 132 PI650 02210O H 2 99 PI650 02220O OR OF PI650 02230O U1 57 'EXCEPTION' PI650 02240O 71 'STOCK STATUS-' PI650 0002250O 11 85 'FINISHED GOODS' PI650 02260O 12 86 'PURCHASED GOODS' PI650 02270O 13 81 'ASSEMBLIES' PI650 02280O 14 74 'ALL' PI650 02290O 132 'MFG650' PI650 02291O H 1 99 02292O OR OF 0002293O 11 'PART NUMBER' 02300O H 3 99 PI650 02310O OR OF PI650 02330O 12 'DESCRIPTION' PI650 02340O 43 'CLS' PI650 02350O 46 'UM' PI650 02360O 55 'SOH' PI650 0002370O 64 'SOO' PI650 02380O 73 'ALLOC' PI650 02390O 82 'AVAIL' PI650 02400O 91 'MIN' PI650 02410O 100 'MAX' PI650 02420O 109 'MTD USE' PI650 02430O 118 'AVG USE' PI650 0002440O 127 'YTD USE' PI650 02441O D 11 NU1 15 02442O OR U1 20 15 02443O PARTNO 20 02450O D 01 NU1 15 PI650 02460O OR U1 20 15 PI650 02480O DESCRP 38 PI650 0002490O CLASS 42 PI650 02500O UM 46 PI650 02510O SOH L 56 PI650 02520O SOO L 65 PI650 02530O ALLOC L 74 PI650 02540O AVAIL L 83 PI650 02550O MIN L 92 PI650 0002560O MAX L 101 PI650 02570O MTDUSEL 110 PI650 02580O AVGUSEL 119 PI650 02590O YTDUSEL 128 PI650 02600O NU1 15 20 132 '**' PI650 ** 002610ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00262000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002650** 002660180132INVENTORY TRANSACTION ACCOUNTING 002670620106MFG650 002680190229EXCEPTION STOCK STATUS REPORT 00269000030413PRINT OUT [ ] 002700030918F = FINISHED GOODS 002710031019P = PURCHASED GOODS 002720031114M = ASSEMBLIES 002730031207A = ALL 002740170409**INVALID 002750/* 00276000_ 00 00 00 00 00 00 00 00 00 00__ 0(d d*TXPI040 Pl999999111111(000010H S PI040 00020X DECK-ID M50 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI040 00030F* THIS PROGRAM ISSUES THE TAG LIST REPORT PI040 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI040 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI040 00060F* CONTROL DATA PROPRIETARY PRODUCT PI040 00070F* PI040 0000080FTAGS IPE F 41 DISK PI040 00090FPRINTER O F 132 OF LPRINTER PI040 00100FPARTMST IC F 300R20AI 271 DISK PI040 00110FHEADING IT F 40 EDISK PI040 00120E HEADING HEAD 1 1 40 PI040 00130LPRINTER 66FL 60OL PI040 00140ITAGS NS 01 1 CT PI040 0000150I 2 60TAGNO PI040 00160I 22 41 PARTNOL1 PI040 00170I 13 14 UM PI040 00180I 15 210QTY PI040 00190I NS 02 1NCT PI040 00200I 1 1 A PI040 00210IPARTMST NS 03 PI040 0000220I 1 37 DESC PI040 00230C 01 PARTNO CHAINPARTMST 50 NOT FOUND PI040 00240C 01 50 MOVEL'PART NOT'WORK 16 PI040 00250C 01 50 MOVE ' ON MSTR'WORK PI040 00260C U2 TQTY ADD QTY TQTY 90 PI040 00270OPRINTER H 102 OF PI040 00280O OR 1P PI040 0000290O UDATE Y 132 PI040 00300O HEAD 89 PI040 00310O 4 'PAGE' PI040 00320O PAGE Z 8 PI040 00330O H 1 OF PI040 00340O OR 1P PI040 00350O 5 'PI040' PI040 0000360O H 1 OF PI040 00370O OR 1P PI040 00380O 77 'INVENTORY TAG LIST' PI040 00381O H 2 OF 00382O OR 1P 00390O U2 75 '(BY PART NO)' PI040 00400O H 2 OF PI040 0000410O OR 1P PI040 00420O 16 'TAG NO.' PI040 00430O 35 'PART NUMBER' PI040 00440O 60 'DESCRIPTION' PI040 00450O 91 'U/M' PI040 00460O 111 'QUANTITY' PI040 00470O D 1 01 PI040 0000480O TAGNO Z 15 PI040 00490O PARTNO 44 PI040 00500O N50 DESC 86 PI040 00510O 50 WORK 86 PI040 00520O UM 90 PI040 00530O QTY JB110 PI040 00540O T 12 L1 U2 PI040 0000550O PARTNO 48 PI040 00560O TQTY JB 110 PI040 ** 000570ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000580ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000590ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000600ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00061000/* 000620_ 00 00 00 00 00 __ 0(,l ,}TXPI025 P 999999111111(000010H S PI025 00020X DECK-ID M95 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI025 00030F* THIS PROGRAM WRITES THE DUPLICATE AND MISSING TAG REPORT PI020 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FOUTTAG IP AF 41 DISK 00090FPARTMST IC F 300R20AI 271 DISK 00100FHEADING IT F 40 EDISK 00110F$LP1 O F 132 OF PRINTER API02000120F********************************************************************API02000130F* API02000140F* DUPLICATE AND MISSING API0200000150F* TAG REPORT API02000160F* API02000170F********************************************************************API02000180F* API02000190F* API020 LISTS ALL MISSING TAG NUMBERS, DUPLICATE TAG NUMBERS, API02000200F* AND TAG NUMBERS THAT EXCEED THE LIMITS. TAG#,PART#, DESCRIPTION API02000210F* ARE PRINTED FOR ALL DUPLICATE TAG NUMBERS. API0200000220F* ERRORS PRINTED AT EXCPT OUTPUT. API02000230F* API02000240F* API02000250F********************************************************************API02000260F* ID F C H L FUNCTION OF INDICATORS API02000270F*01 LIMITS RECORD --FROM TAGS API02000280F*02 TAGS RECORD --FROM TAGS API0200000290F*03 INVALID CARD TYPE --FROM TAGS API02000300F*04 IMSTR RECORD --FROM PARTMST API02000310F* 10 SKIP AROUND THINGS DONE ON FIRST CYCLE API02000320F* 51 EXCEEDS LIMIT ERROR API02000330F* 52 TAGS MISSING ERROR API02000340F* 53 COMPARE SHOWS THAT DUPLICATE TAGS EXIST API02000350F* 54 PRINT DUPLICATE TAG INFORMATION API0200000360F* 55 CHAINED AND RECORD NOT FOUND API02000370F* 61 TAG GREATER THAN UPPER LIMIT IN EXCEEDS API02000380F* 63 SAVE STATUS OF GREATER TAG--PERFORM SUBROUTINE API02000390F* 64 ONLY CHECK ONCE FOR MISSING TICKETS TO UPPER LIMIT API02000400F* 65 MTAG AND UPPER LIMIT ARE EQUAL API02000410F* 66 MTAG LESS THAN UPPER LIMIT API02000420F* 67 MTAG IS GREATER THAN TTAG--DON'T ADD ONE API0200000430F* 68 COMBINATION OF 67 OR 65--DON'T ADD ONE 00440F********************************************************************API02000450E HEADING HEAD 1 1 40 00460E ARY1 1 2 50 00470IOUTTAG NS 02 1 CT 00480I 2 60TTAG API02000490I 22 41 TPART 0000500I 13 14 TUM 00510I 15 210TQTY 00520I NS 03 API02000530I 1 41 DUM1 00540IPARTMST NS 04 00550I 271 290 PART 00560I 1 37 DESC 0000570C* API02000580C* API02000590C* API02000600C 02 00610COR 03 SETOF 01 00620C 10 GOTO START API02000630C SETON 10 DO ONLY ONCE API0200000640C EXSR ALMTS 00650C MOVE LLIM MTAG 60 MISSING TAGS API02000660C MOVEL'*** NOT 'WORK 16 API02000670C MOVE 'ON MASTE'WORK NDESC USED IF API02000680C MOVE 'R *** 'WORK1 24 ITEM NOT FOUND API02000690C MOVELWORK WORK1 WHEN CHAINED API02000700C MOVELWORK1 NDESC 37 TO PARTMST API0200000710C MOVE ' ' NDESC API02000720C* API02000730C START TAG API02000740C 01 API02000750COR 03 GOTO END API02000760C* API02000770C* API0200000780C SETOF 515268 00790C EXSR EXCEED API02000800C N51 API02000810COR 63 EXSR MISS API02000820C EXSR DUPL API02000830C* API02000840C END TAG API0200000850C SEQ ADD 1 SEQ 60 PI020 00860CLR TTAG COMP ULIM 66 00870CLR 66 MOVE MTAG A 60 00880CLR 66 SETON 63 00890CLR SETOF 5152 00900CLR EXCPT 00910C********************************************************************API0200000920C* API02000930C* THIS SUBROUTINE MOVES THE INFORMATION FROM A RECORD JUST API02000940C* READ TO STORAGE FIELDS. THIS IS USED TO CHECK FOR DUPLICATE API02000950C* TAGS. IF ALSO ALLOWS FOR THE PRINTING OF THE DUPLICATE TAGS API02000960C* API02000970C* API02000980C********************************************************************API0200000990C* API02001000CSR SAVE BEGSR API02001010CSR MOVE TTAG STAG 50 API02001020CSR MOVE TPART SPART 6 API02001030CSRN55 MOVE DESC SDESC 37 API02001040CSR 55 MOVE NDESC SDESC API02001050CSR ENDSR API0200001060C* API02001070C********************************************************************API02001080C* API02001090C* THIS SUBROUTINE CHECKS TO SEE IF THE TAG IS LESS THAN THE API02001100C* LOWER LIMIT OR IS GREATER THAN THE UPPER LIMIT. API02001110C* IF YES TO EITHER OF THESE IT IS PRINTED. API02001120C* API0200001130C********************************************************************API02001140C* API02001150CSR EXCEED BEGSR API02001160CSR TTAG COMP LLIM 51 51 LOWER ERROR API02001170CSRN51 TTAG COMP ULIM 61 61 UPPER ERROR API02001180CSR 61 SETON 5163 API02001190CSR 64 SETOF 63 API0200001200CSR ENDSR API02001210C* API02001220C********************************************************************API02001230C* API02001240C* THIS SUBROUTINE CHECKS FOR MISSING TAGS WITHIN THE LIMIT. API02001250C* IF THE TAG EXCEEDS THE LIMIT ONE WAY OR ANOTHER, THIS API02001260C* SUBROUTINE IS NOT PERFORMED. API0200001270C* API02001280C* API02001290C********************************************************************API02001300CSR MISS BEGSR API02001310CSR MTAG COMP ULIM 6665 API02001320CSR 65 GOTO LEND API02001330CSR MTAG COMP TTAG 6752 TAGS MISSING API0200001340CSRN52 GOTO LEND API02001350CSR MOVE MTAG A 60 LOWER TAG GONE API02001360CSR MOVE TTAG B 60 API02001370CSR B SUB 1 B UPPER TAG GONE API02001380CSR MOVE TTAG MTAG BEGIN SEQ AGAINAPI02001390C* API02001400CSR LEND TAG API0200001410CSR 66 63 SETOF 52 01420CSR 67 01430COR 65 SETON 68 01440CSRN68 MTAG ADD 1 MTAG API02001450CSR 63 SETON 64 ONLY DO ONCE API02001460CSR ENDSR API02001470C* API0200001480C********************************************************************API02001490C* API02001500C* THIS SUBROUTINE DISCOVERS DUPLICATE TAGS WITHOUT USE OF API02001510C* LOOK AHEAD FIELDS. PREVIOUS INFORMATION MUST BE STORED SO API02001520C* THAT THE FIRST DUPLICATE CAN BE PRINTED. API02001530C* CHAIN OUT TO PARTMST TO GET THE DESCRIPTION OF ITEM. PI020 01540C* API0200001550C* API02001560C********************************************************************API02001570C* API02001580CSR DUPL BEGSR API02001590CSRN53 SETOF 54 API02001600CSR TTAG COMP STAG 53 DUPLICATE TAG API02001610CSR 53 SETON 54 PRINT TAG API0200001620CSR EXCPT PRINT API02001630CSR TPART CHAINPARTMST 55 NOT FOUND 01640CSR EXSR SAVE API02001650C* API02001660CSR ENDSR API02001670C* API02001680CSR ALMTS BEGSR 0001690CSR MOVE 'C' TYPE 01700CSR EXSR CRTCOM 01710CSR MOVELARY1,1 BUFFER 01720CSR MOVE 'S' TYPE 01730CSR Z-ADD50 BLNGTH 01740CSR EXSR CRTCOM 01750CSR MOVE 'A' TYPE 0001760CSR Z-ADD5 BLNGTH 01770CSR Z-ADD1 DTYPE 01780CSR EXSR CRTCOM 01790CSR RCODE COMP 'R' 86 01800CSR Z-ADD5 VL 20 01810CSR MOVELBUFFER VAR 15 01820CSR EXIT SUBRAJ 0001830CSR RLABL VL 01840CSR RLABL VAR 01850CSR MOVELVAR LLIM 50 01860CSR MOVEL' ' BUFFER 01870CSR Z-ADD1 BLNGTH 01880CSR MOVE 'T' TYPE 01890CSR EXSR CRTCOM 0001900CSR MOVELARY1,2 BUFFER 01910CSR MOVE 'S' TYPE 01920CSR Z-ADD50 BLNGTH 01930CSR EXSR CRTCOM 01940CSR MOVE 'A' TYPE 01950CSR Z-ADD5 BLNGTH 01960CSR EXSR CRTCOM 0001970CSR RCODE COMP 'R' 87 01980CSR Z-ADD5 VL 01990CSR MOVELBUFFER VAR 02000CSR EXIT SUBRAJ 02010CSR RLABL VL 02020CSR RLABL VAR 02030CSR MOVELVAR ULIM 50 0002040CSR MOVE 'C' TYPE 02050CSR EXSR CRTCOM 02060CSR 86 02070COR 87 GOTO ALMTS 02080CSR SETON 01 02090CSR ENDSR 02100CSR CRTCOM BEGSR 0002110CSR EXITFSUBRCM 02120CSR RLABL BUFFER 72 02130CSR RLABL TYPE 1 02140CSR RLABL BLNGTH 20 02150CSR RLABL RCODE 1 02160CSR RLABL MASK 10 02170CSR RLABL DTYPE 10 0002180CSR ENDSR 02190O$LP1 D 102 01 02200O OR OFN1P API02002220O HEAD,1 86 02240O UDATE Y 132 API02002250O 4 'PAGE' API02002260O PAGE Z 8 API0200002261O H 2 1 02262O OR OFN1P 02263O 132 'PI020' 02270O D 2 01 02280O OR OFN1P API02002290O 50 'DUPLICATE AND MISSING' API02002300O 61 'TAG REPORT' API0200002310O D 2 01 02320O OR OFN1P API02002330O 15 'TAG LIMITS' API02002340O LLIM 3 22 API02002350O 26 'TO' API02002360O ULIM 3 34 API02002370O 35 '.' API0200002380O D 2 01 02390O OR OFN1P API02002400O 20 'MISSING TAG#' API02002410O 59 'DUPLICATE TAG#' API02002420O 107 'EXCEEDS LIMITS' API02002430O 125 'SEQ #' PI020 02440O E 1 54 API0200002450O STAG 3 40 API02002460O SPART 51 API02002470O SDESC B 91 API02002480O SEQ J 125 PI020 02490O E 1 66 63 API02002500O A 3 10 API02002510O 16 'THRU' API0200002520O ULIM 3 24 API02002530O E 1 51 API02002540O TTAG 3 100 API02002550O SEQ J 125 PI020 02560O E 1 52 API02002570O A 3 10 API02002580O 16 'THRU' API0200002590O B 3 24 API02002600O* API02002610O* API02002620O D 1 03 API02002630O DUM1 41 02640O 55 '*** INVALID CARD TYPE' API02002650O SEQ J 125 PI020 00** 02660ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 02670ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 02680ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 02690ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 02700** 02710ENTER TAG LOW LIMIT-XXXXX 0272000ENTER TAG HIGH LIMIT-XXXXX 02730/* 02740_ 00 00 00 __ 0(l pXOTXOE012 P999999050278(000010H S OE012 00020X DECK-ID A46 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE012 00030F* PRINTS CUSTOMER LIST FROM ARMAST OE012 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE012 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE012 00060F* CONTROL DATA PROPRIETARY PRODUCT OE012 00070F* OE012 0000080F********************************************************************OE012 00090F* *OE012 00100F* PACKAGE- DISTRIBUTION CONTRACTOR- COMPUSOURCE *OE012 00110F* SYSTEM- PROGRAMMER- T. MCCULLY *OE012 00120F* PROGRAM- CUSTOMER FILE LIST DATE- 5/04/76 *OE012 00130F* *OE012 00140F* DESCRIPTION- PRINT ARMAST FILE. OMIT DELETE CODED RECORDS & *OE012 0000150F* PUT CITY, STATE & ZIP ON LINE 2 IF ADDRESS LINE 2 IS BLANK.*OE012 00160F* *OE012 00170F* *OE012 00180F********************************************************************OE012 00190F* ID F C H L FUNCTION OF INDICATORS OE012 00200F* 01 ACTIVE CUSTOMER RECORD (NOT DELETE CODED) OE012 00210F* 12 ADDRESS LINE 2 IS BLANK PRINT CITY, STATE & ZIP ON OE012 0000220F* LINE 2 INSTEAD OF ON LINE 3. OE012 00230F* 02 DELETE CODED RECORD DO NOT PRINT OR COUNT. OE012 00240F********************************************************************OE012 00250FARMAST IPEAF 280 6AI 1 DISK OE012 00260FHEADING IT F 40 EDISK OE012 00270F$LP1 O F 132 OF PRINTER OE012 00280F********************************************************************OE012 0000290E HEADING HDR 1 1 40 COMPANY NAME OE012 00300E********************************************************************OE012 00310IARMAST NS 01 115 C OE012 00320I 2 60CUSTNO OE012 00330I 7 30 NAME OE012 00340I 31 54 ADR1 OE012 00350I 55 78 ADR2 12 OE012 0000360I 79 91 CITY OE012 00370I 92 93 STATE OE012 00380I 94 98 ZIP OE012 00390I 99 1080PHONE OE012 00400I 109 1140CRLIM OE012 00410I 116 116 STMNT OE012 00420I 124 139 PERSON OE012 0000430I 154 1560SLSMAN OE012 00440I 157 158 AREA OE012 00450I 159 159 TAX OE012 00460I 160 160 TERMS OE012 00470I 161 161 PRCODE OE012 00480I 162 163 ACCTYP OE012 00490I NS 02 OE012 0000500I 1 1 UNUSED OE012 00510C********************************************************************OE012 00520C 01 COUNT ADD 1 COUNT 80 OE012 00530C********************************************************************OE012 00540O$LP1 H 202 OF OE012 00550O OR 1P OE012 00560O PAGE Z 10 OE012 0000570O 4 'PAGE' OE012 00580O HDR,1 85 OE012 00590O UDATE Y 132 OE012 00600O UDATE Y 132 OE012 00610O H 2 OF OE012 00620O OR 1P OE012 00630O 72 'CUSTOMER MASTER FILE' OE012 0000640O 80 'LISTING' OE012 00650O 132 'DIS012' OE012 00660O H 1 OF OE012 00670O OR 1P OE012 00680O 65 'PHONE #' OE012 00690O 105 'STMT CD SLSMAN TAX' OE012 00700O 118 'CD ACCT TYP' OE012 0000710O H 1 OF OE012 00720O OR 1P OE012 00730O 21 'CUST # CUSTOMER NAME' OE012 00740O 40 'ADDRESS' OE012 00750O 82 'PERSON TO CONTACT CREDI' OE012 00760O 105 'T LIMIT AREA CD TERMS' OE012 00770O 118 'CD PRICE CD' OE012 0000780O D 11 01 OE012 00790O CUSTNOZ 6 OE012 00800O NAME 32 OE012 00810O ADR1 57 OE012 00820O PHONE 70 ' - - ' OE012 00830O STMNT 89 OE012 00840O SLSMANZ 98 OE012 0000850O TAX 108 OE012 00860O ACCTYP 118 OE012 00870O D 1 01 OE012 00880O 12 CITY 46 OE012 00890O 12 STATE 50 OE012 00900O 12 ZIP 57 OE012 00910O N12 ADR2 57 OE012 0000920O PERSON 74 OE012 00930O CRLIM K 90 OE012 00940O AREA 98 OE012 00950O TERMS 108 OE012 00960O PRCODE 118 OE012 00970O D 1 01N12 OE012 00980O CITY 46 OE012 0000990O STATE 50 OE012 01000O ZIP 57 OE012 01010O T 3 LR OE012 01020O 23 'END OF JOB. THERE WERE' OE012 01030O COUNT J 35 OE012 01040O 56 'ACTIVE RECORDS IN THE' OE012 01050O 78 'CUSTOMER MASTER FILE.' OE012 0001060O********************************************************************OE012 ** 001070ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001080ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001090ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001100ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001110/* 00112000__0O********************************************************************OE012 ** 001070ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001080ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001090ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001100ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001110/* 0011200(dm d*TXBM101 P999999111111(000010H S BM101 00020X DECK-ID M09 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM101 00030F* CREATES BOMINP FROM BM1OUT BM101 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0BM101 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM101 00060F* CONTROL DATA PROPRIETARY PRODUCT BM101 00070F* BM101 0000080FBM1OUT IP AF 128 DISK BM101 00090FBOMINP O F 57 DISK BM101 00100F********************************************************************BM101 00110F* BM101 00120F* PACKAGE MANUFACTURING BM101 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM101 00140F* PROGRAM CREATE BOMINP FROM BM1OUT BM101 0000150F* BM101 00160F********************************************************************BM101 00170F* BM101 00180F* NARRATIVE: BM101 00190F* BM101 00200F* FOR EACH RECORD IN KPFILE WITH DATA IN IT (KEYPCH PUTS A BM101 00210F* REL REC # IN 124-127 OF EACH RECORD IT FILLS), A RECORD IS PUT BM101 0000220F* OUT TO BOMINP. BM101 00230F* BM101 00240F********************************************************************BM101 00250F* BM101 00260F* ID F C H L FUNCTION OF INDICATORS BM101 00270F* BM101 00280F* 01 BM1OUT RECORD BM101 0000290F* BM101 00300F* 91 REL REC NO BLANK NO DATA IN RECORD BM101 00310F* BM101 00320F********************************************************************BM101 00330IBM1OUT NS 01 BM101 00340I 1 2 TST BM101 00350I 1 52 IMAGE BM101 0000360I 124 1270RRN 91 BM101 00370C TST COMP '<>' 9191 BM101 00380OBOMINP D 01 91 BM101 00390O IMAGE 52 BM101 00400O RRN 57 BM101 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00042000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000450/* 000460_ 00 00 00 00 00 00 00 00 __ 0(T $TXBM1ENT P&999999111111(000010H S BM1ENT00020X DECK-ID M25 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM1ENT00030F* ENTER PRODUCT STRUCTURE UPDATES BM1ENT00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM1ENT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM1ENT00060F* CONTROL DATA PROPRIETARY PRODUCT BM1ENT00070F* BM1ENT0000080FBM1DUM IPE F 72 DISK BM1ENT00090FKPROGS IC F 36R 8AI 1 DISK BM1ENT00100FBM1OUT UC F 128R DISK BM1ENT00110F********************************************************************BM1ENT00120F* INDICATOR FUNCTION LIST BM1ENT00130F* 01 DUMMY RECORD BM1ENT00140F* 02 KEYPYNCH PARAMETER FILE BM1ENT0000150F* 05 KEYPUNCH DATA FILE BM1ENT00160F* 18 BM1ENT00170F* 19 BM1ENT00180F* 20 BM1ENT00190F* 21 BM1ENT00200F* 25 RETRY ON RUBOUT BM1ENT00210F* 27 AUTO DUP BM1ENT0000220F* 28 BM1ENT00230F* 29 BM1ENT00240F* 40 MODE IS A-ADD BM1ENT00250F* 41 MODE IS C-CHANGE BM1ENT00260F* 42 MODE IS V-VERIFY BM1ENT00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS BM1ENT00280F* 44 MODE IS E-END OF JOB BM1ENT0000290F* 56 SEQ NBR NOT IN KPFILE BM1ENT00300F* 60 NEW PROGRAM NBR ONLY BM1ENT00310F* 61 AUTO DUP ONLY BM1ENT00320F* 70 BM1ENT00330F* 72 BM1ENT00340F* 73 MODE IS LESS THAN OR = 4 BM1ENT00350F* 81 MODE IS INVALID BM1ENT0000360F* 82 BAD PROG NBR BM1ENT00370F* 83 FIRST FIELD NAME BLANK BM1ENT00380F* 84 OUTPUT FIELD NAME BM1ENT00390F* 85 BM1ENT00400F* 88 SEQ NBR NOT IN KPFILE BM1ENT00410F* 90 AUTO DUP ON BM1ENT00420F* 95 BM1ENT0000430F* 98 RCD WITHIN OPERATOR LIMITS BM1ENT00440F* LR BM1ENT00450F********************************************************************BM1ENT00460E MSG 1 10 25 BM1ENT00470E SFN 80 20 BM1ENT00480E SAN 80 1 BM1ENT00490E SAD 80 1 BM1ENT0000500E SST 80 3 0 BM1ENT00510E SLN 80 2 0 BM1ENT00520E SNM 4 6 BM1ENT00530E SMX 4 2 0 BM1ENT00540E NP 4 1 0 BM1ENT00550E ARY1 1 2 50 BM1ENT00560IBM1DUM NS 01 BM1ENT0000570I 1 1 A BM1ENT00580IKPROGS NS 02 BM1ENT00590I 9 28 FN BM1ENT00600I 29 29 AN BM1ENT00610I 30 30 AD BM1ENT00620I 31 33 ST BM1ENT00630I 34 35 LN BM1ENT0000640I 36 36 DCODE BM1ENT00650IBM1OUT NS 05 BM1ENT00660I 1 128 RECORD BM1ENT00670C MOVE ' ' B72 72 BM1ENT00680C EXSR ALMTS BM1ENT00690C Z-ADDLOW SEQNO BM1ENT00700C NLR SETON LR BM1ENT0000710CLR START TAG BM1ENT00720CLR MOVEL'' WORD BM1ENT01590CLR Z-ADD1 OLN BM1ENT01600CLR Z-ADD1 ILN BM1ENT01610CLR EXSR TYPES BM1ENT0001620CLR MOVELBUFFER MODE BM1ENT01630CLR MODE COMP '4' 7373 BM1ENT01640CLR MODE COMP 'P' 60 NEW PROG#ONLY BM1ENT01650CLR MODE COMP 'D' 61 AUTO-DUP ONLY BM1ENT01660CLRN60N61N73 GOTO CHKMOD NEW 46DE BM1ENT01670CLR 73 MOVE MODE NPN 10 BM1ENT01680CLR EXSR GETPRG BM1ENT0001685CLR SETOF 606173 01690CLR GOTO SAMREC BM1ENT01700CLR CHKNUM TAG BM1ENT01710CLR MOVELBUFFER MODE BM1ENT01720CLR MODE COMP '@' 20 BM1ENT01730CLR 20N42 GOTO OUTREC BM1ENT01740CLR SAN,N COMP 'N' 19 BM1ENT0001750CLRN19 GOTO CHKVER BM1ENT01760CLR Z-ADDSLN,N VL 20 BM1ENT01770CLR MOVELBUFFER VAR 15 BM1ENT01780CLR EXIT SUBRAJ BM1ENT01790CLR RLABL VL BM1ENT01800CLR RLABL VAR BM1ENT01810CLR MOVELVAR BUFFER BM1ENT0001820CLR Z-ADDVL BLNGTH BM1ENT01830CLR EXSR EXCPT BM1ENT01840CLR SETOF 19 BM1ENT01850CLR CHKVER TAG BM1ENT01860CLRN42 GOTO MOVBUF BM1ENT01870CLR TBUF COMP BUFFER 2020 BM1ENT01880CLRN20 GOTO MOVBUF BM1ENT0001890CLR MOVEL'KP VERIF'WORD BM1ENT01900CLR MOVE 'Y ERROR 'WORD BM1ENT01910CLR MOVELWORD BUFFER BM1ENT01920CLR MOVE 'R' TYPE BM1ENT01930CLR Z-ADD6 MASK ONLY 'R' OR 'E'BM1ENT01940CLR EXSR CRTCOM BM1ENT01950CLR RCODE COMP 'R' 20 BM1ENT0001960CLR 20 GOTO OUTFLD BM1ENT01970CLR MOVBUF TAG BM1ENT01980CLR Z-ADDSST,N TSTRT 30 BM1ENT01990CLR Z-ADDSLN,N NCHARS 30 BM1ENT02000CLR Z-ADD1 SSTRT BM1ENT02010CLR EXIT SUBRMV BM1ENT02020CLR RLABL BUFFER BM1ENT0002030CLR RLABL SSTRT BM1ENT02040CLR RLABL RECORD BM1ENT02050CLR RLABL TSTRT BM1ENT02060CLR RLABL NCHARS BM1ENT02070CLR GOTO LOOP BM1ENT02080CLR RITDUP TAG BM1ENT02090CLR EXSR MVRECD BM1ENT0002100CLR SETON 19 BM1ENT02110CLR Z-ADDSLN,N BLNGTH BM1ENT02120CLRN27 EXSR EXCPT BM1ENT02130CLR SETOF 19 BM1ENT02140CLR GOTO MOVBUF BM1ENT02150CLR OUTREC TAG BM1ENT02160CLR SETON 187084 BM1ENT0002170CLR SETON 85 BM1ENT02180CLR EXCPT BM1ENT02190CLR EXSR EXCPT BM1ENT02200CLR SETOF 708485 BM1ENT02210CLR MOVELRECORD OLDREC128 BM1ENT02220CLR NP,PN COMP 0 72 BM1ENT02230CLRN72 GOTO NXTREC BM1ENT0002240CLR MOVE NP,PN NPN BM1ENT02250CLR EXSR GETPRG BM1ENT02260CLR SETOF 72 BM1ENT02270CLR GOTO NXTREC BM1ENT02280CLR EOJ TAG BM1ENT02290C********************************************************************BM1ENT02300C* BM1ENT0002310C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION BM1ENT02320C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. BM1ENT02330C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. BM1ENT02340C* BM1ENT02350C********************************************************************BM1ENT02360CSR GETPRG BEGSR BM1ENT02370CSR 61 GOTO JMPOUT BM1ENT0002380CSR 72 BM1ENT02390COR 73 GOTO CHKPN BM1ENT02400CSR GETPNO TAG BM1ENT02410CSR MOVEL'PROG # -'WORD BM1ENT02420CSR Z-ADD8 OLN BM1ENT02430CSR Z-ADD1 ILN BM1ENT02440CSR EXSR TYPES BM1ENT0002450CSR MOVELBUFFER NPN 10 BM1ENT02460CSR CHKPN TAG BM1ENT02470CSR NPN COMP 0 2020 BM1ENT02480CSRN20 NPN COMP 4 20 BAD PROG# BM1ENT02490CSR 20 SETON 82 BM1ENT02500CSR 82 EXSR EXCPT BM1ENT02510CSR SETOF 82 BM1ENT0002520CSR 20 GOTO GETPNO TRY PROG# AGAINBM1ENT02530CSR MOVE NPN PN 10 INBM1ENT02540CSR MOVE PN NAME10 10 BM1ENT02550CSRN43 SNM,PN COMP ' ' 6060 BM1ENT02560CSR 60 PN SUB 1 BP 20 BM1ENT02570CSR 60 BP MULT 20 BP BM1ENT02580CSR 72 GOTO SETHED BM1ENT0002590CSR 73 GOTO JMPOUT BM1ENT02600CSR 60 GOTO JMPOUT BM1ENT02610CSR GETPNM TAG BM1ENT02620CSR MOVEL'PROG NAM'WORD BM1ENT02630CSR MOVE 'E - 'WORD BM1ENT02640CSR Z-ADD11 OLN BM1ENT02650CSR Z-ADD6 ILN BM1ENT0002660CSR EXSR TYPES BM1ENT02670CSR MOVELBUFFER PNAME 8 BM1ENT02680CSR MOVE ' ' PNAME BM1ENT02690CSR CHNPRG TAG BM1ENT02700CSR PNAME CHAINKPROGS 27 BM1ENT02710CSRN27 MOVELPNAME SNM,PN BM1ENT02720CSRN27 GOTO LOADIT BM1ENT0002730CSR MOVEL' 'WORD BM1ENT02740CSR MOVELPNAME WORD BM1ENT02750CSR MOVE 'ABSENT 'WORD BM1ENT02760CSR MOVE 'R' TYPE 1 BM1ENT02770CSR MOVELWORD BUFFER BM1ENT02780CSR Z-ADD7 MASK 10 BM1ENT02790CSR Z-ADD16 BLNGTH BM1ENT0002800CSR EXSR CRTCOM BM1ENT02810CSR RCODE COMP 'E' 20 BM1ENT02820CSR PRGMT TAG BM1ENT02830C*R 20 EXSR PROGMT BM1ENT02840C*R 20 GOTO CHNPRG BM1ENT02850CSR GOTO GETPNM BM1ENT02860CSR LOADIT TAG BM1ENT0002870CSR Z-ADD14 OLN BM1ENT02880CSR Z-ADD1 ILN BM1ENT02890CSR MOVEL'NEXT PRO'WORD BM1ENT02900CSR MOVE 'G # - 'WORD BM1ENT02910CSR EXSR TYPES BM1ENT02920CSR MOVELBUFFER NP,PN BM1ENT02930CSR PN SUB 1 BP BM1ENT0002940CSR BP MULT 20 BP BM1ENT02950CSR BP ADD 1 N 20 BM1ENT02960CSR Z-ADD1 X 20 BM1ENT02970CSR BLDARY TAG BM1ENT02980CSR FN COMP B72 20 BM1ENT02990CSR 20 N SUB 1 MAXFLD 20 BM1ENT03000CSR 20 MOVE MAXFLD SMX,PN BM1ENT0003010CSR 20 GOTO JMPOUT BM1ENT03020CSR MOVE FN SFN,N FIELD NAME BM1ENT03030CSR MOVE AN SAN,N ALPHA OR NUMER BM1ENT03040CSR MOVE AD SAD,N AUTO DUP BM1ENT03050CSR MOVE ST SST,N START POSITION BM1ENT03060CSR MOVE LN SLN,N BM1ENT03070CSR MVX TAG BM1ENT0003080CSR MOVE X PNAME BM1ENT03090CSR PNAME CHAINKPROGS 20 BM1ENT03100CSR X ADD 1 X BM1ENT03110CSRN20 X COMP 20 20 BM1ENT03120CSR 20 Z-ADDN MAXFLD BM1ENT03130CSR 20 MOVE MAXFLD SMX,PN BM1ENT03140CSR DCODE COMP 'D' 21 BM1ENT0003150CSR 21N20 GOTO MVX BM1ENT03160CSRN20 N ADD 1 N BM1ENT03170CSRN20 GOTO BLDARY BM1ENT03180CSR JMPOUT TAG BM1ENT03190CSR 43 GOTO ENDGET BM1ENT03200CSR 41 GOTO SETHED BM1ENT03210CSR MOVEL'AUTO-DUP'WORD BM1ENT0003220CSR MOVE ' - 'WORD BM1ENT03230CSR Z-ADD11 OLN BM1ENT03240CSR Z-ADD1 ILN BM1ENT03250CSR EXSR TYPES BM1ENT03260CSR MOVELBUFFER AUTO 1 BM1ENT03270CSR AUTO COMP 'O' 90AUTO-DUP ON BM1ENT03280CSR SETHED TAG BM1ENT0003290CSR MOVELSNM,PN NAME10 BM1ENT03300CSR MOVELNAME10 WORD BM1ENT03310CSR MOVE SMX,PN MAXFLD 20 BM1ENT03320CSR 90 MOVE ' ON' WORD BM1ENT03330CSRN90 MOVE 'OFF' WORD BM1ENT03340CSR MOVELWORD HEAD 40 BM1ENT03350CSR ENDGET ENDSR BM1ENT0003360C********************************************************************BM1ENT03370C* BM1ENT03380C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST BM1ENT03390C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE BM1ENT03400C* CHANGED BM1ENT03410C* BM1ENT03420C********************************************************************BM1ENT0003430CSR GETSEQ BEGSR BM1ENT03440CSR MOVEL'SEQ # - 'WORD BM1ENT03450CSR Z-ADD8 OLN BM1ENT03460CSR Z-ADD5 ILN BM1ENT03470CSR EXSR TYPES BM1ENT03480CSR Z-ADD5 VL BM1ENT03490CSR MOVELBUFFER VAR BM1ENT0003500CSR EXIT SUBRAJ BM1ENT03510CSR RLABL VL BM1ENT03520CSR RLABL VAR BM1ENT03530CSR MOVELVAR SEQNO BM1ENT03540CSR SEQNO COMP 0 20 BM1ENT03550CSRN20 Z-ADD1 SEQNO BM1ENT03560CSR SETON 95 BM1ENT0003570CSR ENDSEQ ENDSR BM1ENT03580C********************************************************************BM1ENT03590C* BM1ENT03600C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO BM1ENT03610C* BM1ENT03620C********************************************************************BM1ENT03630CSR GETREC BEGSR BM1ENT0003640CSR SEQRD TAG BM1ENT03650CSR EXSR TSTSEQ BM1ENT03660CSR 94 EXSR GETSEQ BM1ENT03670CSR 94 GOTO SEQRD BM1ENT03680CSR SEQNO CHAINBM1OUT 56 BM1ENT03690CSR MOVELRECORD TST 2 BM1ENT03700CSR TST COMP '<>' 99 BM1ENT0003710CSR 40N99 SEQNO ADD 1 SEQNO BM1ENT03720CSR 40N99 GOTO SEQRD BM1ENT03730CSR 41 99 EXSR NOCHG BM1ENT03740CSR 41 99 GOTO SEQRD BM1ENT03750CSR 56 SETON 88 BM1ENT03760CSR 88 EXSR EXCPT BM1ENT03770CSR SETOF 88 BM1ENT0003780CSR 56 EXSR GETSEQ BM1ENT03790CSR 56 GOTO SEQRD BM1ENT03800CSR ENDSR BM1ENT03810C********************************************************************BM1ENT03820C* BM1ENT03830C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY BM1ENT03840C* IS DONE IF A RUBOUT IS USED BM1ENT0003850C* BM1ENT03860C********************************************************************BM1ENT03870CSR TYPES BEGSR BM1ENT03880CSR OVER TAG BM1ENT03890CSR Z-ADDOLN BLNGTH BM1ENT03900CSR MOVELWORD BUFFER BM1ENT03910CSR MOVE 'S' TYPE BM1ENT0003920CSR EXSR CRTCOM BM1ENT03930CSR MOVE 'A' TYPE BM1ENT03940CSR Z-ADDILN BLNGTH BM1ENT03950CSR EXSR CRTCOM BM1ENT03960CSR RCODE COMP 'R' 25 BM1ENT03970CSR 25 EXSR SKIP BM1ENT03980CSR 25 GOTO OVER BM1ENT0003990CSR RCODE COMP 'O' 25 BM1ENT04000CSR 25 EXSR SKIP BM1ENT04010CSR ENDSR BM1ENT04020C********************************************************************BM1ENT04030C* BM1ENT04040C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT BM1ENT04050C* BM1ENT0004060C********************************************************************BM1ENT04070CSR SKIP BEGSR BM1ENT04080CSR MOVELBUFFER NBUF 1 BM1ENT04090CSR MOVEL' ' BUFFER BM1ENT04100CSR Z-ADD1 BLNGTH BM1ENT04110CSR MOVE 'T' TYPE BM1ENT04120CSR EXSR CRTCOM BM1ENT0004130CSR MOVELNBUF BUFFER BM1ENT04140CSR ENDSR BM1ENT04150C********************************************************************BM1ENT04160C* BM1ENT04170C* BM1ENT04180C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED BM1ENT04190C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER BM1ENT0004200C* BM1ENT04210CSR MVRECD BEGSR BM1ENT04220CSR MOVELB72 BUFFER BM1ENT04230CSR Z-ADD1 TSTRT BM1ENT04240CSR Z-ADDSST,N SSTRT BM1ENT04250CSR Z-ADDSLN,N NCHARS BM1ENT04260CSR EXIT SUBRMV BM1ENT0004270CSR RLABL OLDREC BM1ENT04280CSR RLABL SSTRT 30 BM1ENT04290CSR RLABL BUFFER BM1ENT04300CSR RLABL TSTRT 30 BM1ENT04310CSR RLABL NCHARS 30 BM1ENT04320CSR ENDSR BM1ENT04330C********************************************************************BM1ENT0004340CSR EXCPT BEGSR BM1ENT04350CSRN81N82N83 BM1ENT04360CANN84N88 GOTO PUTOUT BM1ENT04370CSR MOVELB72 BUFFER BM1ENT04380CSR 81 MOVELMSG,1 BUFFER BM1ENT04390CSR 83 MOVELMSG,2 BUFFER BM1ENT04400CSR 88 MOVELMSG,3 BUFFER BM1ENT0004410CSR 82 MOVELMSG,4 BUFFER BM1ENT04420CSRN84 GOTO PUTOUT BM1ENT04430CSRN85 MOVELSFN,N BUFFER BM1ENT04440CSRN18 Z-ADD20 BLNGTH BM1ENT04450CSRN18 GOTO PUTOUT BM1ENT04460CSR MOVELHEAD BUFFER BM1ENT04470CSR MOVE 'T' TYPE BM1ENT0004480CSR Z-ADD69 BLNGTH BM1ENT04490CSR EXSR CRTCOM BM1ENT04500CSR MOVELSFN,N BUFFER BM1ENT04510CSR Z-ADD20 BLNGTH BM1ENT04520CSR PUTOUT TAG BM1ENT04530CSR MOVE 'S' TYPE BM1ENT04540CSR EXSR CRTCOM BM1ENT0004550CSR ENDSR BM1ENT04560C* BM1ENT04570CSR ALMTS BEGSR BM1ENT04580CSR MOVE 'C' TYPE 1 BM1ENT04590CSR Z-ADD0 BLNGTH 20 BM1ENT04600CSR MOVE ' ' RCODE 1 BM1ENT04610CSR Z-ADD0 MASK 10 BM1ENT0004620CSR Z-ADD0 DTYPE 10 BM1ENT04630CSR EXSR CRTCOM BM1ENT04640CSR MOVELARY1,1 BUFFER BM1ENT04650CSR MOVE 'S' TYPE BM1ENT04660CSR Z-ADD50 BLNGTH BM1ENT04670CSR EXSR CRTCOM BM1ENT04680CSR MOVE 'A' TYPE BM1ENT0004690CSR Z-ADD5 BLNGTH BM1ENT04700CSR Z-ADD1 DTYPE BM1ENT04710CSR EXSR CRTCOM BM1ENT04720CSR EXSR SKIP BM1ENT04730CSR RCODE COMP 'R' 86 BM1ENT04740CSR Z-ADD5 VL BM1ENT04750CSR MOVELBUFFER VAR BM1ENT0004760CSR EXIT SUBRAJ BM1ENT04770CSR RLABL VL BM1ENT04780CSR RLABL VAR BM1ENT04790CSR MOVELVAR BUFFER BM1ENT04800CSR MOVELBUFFER LOW 50 BM1ENT04810CSR MOVELARY1,2 BUFFER BM1ENT04820CSR MOVE 'S' TYPE BM1ENT0004830CSR Z-ADD50 BLNGTH BM1ENT04840CSR EXSR CRTCOM BM1ENT04850CSR MOVE 'A' TYPE BM1ENT04860CSR Z-ADD5 BLNGTH BM1ENT04870CSR Z-ADD1 DTYPE BM1ENT04880CSR EXSR CRTCOM BM1ENT04890CSR RCODE COMP 'R' 87 BM1ENT0004900CSR Z-ADD5 VL BM1ENT04910CSR MOVELBUFFER VAR BM1ENT04920CSR EXIT SUBRAJ BM1ENT04930CSR RLABL VL BM1ENT04940CSR RLABL VAR BM1ENT04950CSR MOVELVAR BUFFER BM1ENT04960CSR MOVELBUFFER HIGH 50 BM1ENT0004970CSR MOVE 'C' TYPE BM1ENT04980CSR EXSR CRTCOM BM1ENT04990CSR 86 BM1ENT05000COR 87 GOTO ALMTS BM1ENT05010CSR Z-ADD0 DTYPE BM1ENT05020CSR ENDSR BM1ENT05030CSR CRTCOM BEGSR BM1ENT0005040CSR EXITFSUBRCM BM1ENT05050CSR RLABL BUFFER BM1ENT05060CSR RLABL TYPE BM1ENT05070CSR RLABL BLNGTH BM1ENT05080CSR RLABL RCODE BM1ENT05090CSR RLABL MASK BM1ENT05100CSR RLABL DTYPE BM1ENT0005110CSR ENDSR BM1ENT05120CSR PUTSEQ BEGSR BM1ENT05130CSR MOVELMSG,5 BUFFER 72 BM1ENT05140CSR MOVE 'S' TYPE BM1ENT05150CSR Z-ADD25 BLNGTH BM1ENT05160CSR EXSR CRTCOM BM1ENT05170CSR MOVELSEQNO BUFFER BM1ENT0005180CSR MOVE 'T' TYPE BM1ENT05190CSR Z-ADD5 BLNGTH BM1ENT05200CSR EXSR CRTCOM BM1ENT05210CSR ENDSR BM1ENT05220CSR TSTSEQ BEGSR BM1ENT05230CSR SETOF 949697 BM1ENT05240CSR SEQNO COMP LOW 989698 BM1ENT0005250CSR 98 SEQNO COMP HIGH 979898 BM1ENT05260CSR 98 GOTO ENDTST BM1ENT05270CSR 40 96 MOVELMSG,6 BUFFER BM1ENT05280CSR 40 97 MOVELMSG,7 BUFFER BM1ENT05290CSRN40 MOVELMSG,8 BUFFER BM1ENT05300CSRN40 SETON 94 BM1ENT05310CSR MOVE 'T' TYPE BM1ENT0005320CSR Z-ADD25 BLNGTH BM1ENT05330CSR EXSR CRTCOM BM1ENT05340CSR 40 97 MOVE 'F' TYPE BM1ENT05350CSR 40 97 EXSR CRTCOM BM1ENT05360CSR ENDTST ENDSR BM1ENT05370CSR NOCHG BEGSR BM1ENT05380CSR MOVELMSG,9 BUFFER BM1ENT0005390CSR MOVE 'T' TYPE BM1ENT05400CSR Z-ADD25 BLNGTH BM1ENT05410CSR EXSR CRTCOM BM1ENT05420CSR EXSR GETSEQ BM1ENT05430CSR ENDSR BM1ENT05440C********************************************************************BM1ENT05450OBM1OUT E 70N56 BM1ENT0005460O RECORD 128 BM1ENT05470O 42 128 'X' BM1ENT05480O SEQNO 127 BM1ENT** 005490ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005500ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005510ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00552000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005530** 005540MODE MUST BE A,C,V,OR E 005550FIRST FIELD NAME BLANK 005560INVALID SEQ # 005570PROG# MUST BE FROM 1-4 005580CURRENT SEQUENCE NBR 00559000SEQNO TOO LOW 005600RUN EDIT PROG-FILE FULL 005610SEQNO NOT IN YOUR LIMITS 005620ILLEGAL CHANGE-NO DATA 005630** 005640ENTER BEGINNING RELATIVE RECORD NUMBER 005650ENTER ENDING RELATIVE RECORD NUMBER 00566000/* 005670_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(m TTXBM107 P999999111111(000010H S BM107 00020X DECK-ID M11 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM107 00030F* RECOVERY PROGRAM FOR BM1ENT BM107 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM107 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM107 00060F* CONTROL DATA PROPRIETARY PRODUCT BM107 00070F* BM107 0000080FBM1DUM UPE F 72 DISK BM107 00090FBM1OUT IC F 128R DISK BM107 00100E MSG 1 5 35 BM107 00110IBM1DUM NS 01 BM107 00120I 1 72 ALL BM107 00130IBM1OUT NS 02 BM107 00140I 1 128 RCD BM107 0000150C SETOF 60 BM107 00160C SETON LR BM107 00170CLR MOVE ' ' B80 80 BM107 00180CLR EXSR ALMTS BM107 00190CLR Z-ADDLOW SEQNO 50 BM107 00200CLR LOOP TAG BM107 00210CLR SEQNO COMP HIGH 40 BM107 0000220CLR 40 GOTO A BM107 00230CLR SEQNO CHAINBM1OUT 50 BM107 00240CLR 50 GOTO A BM107 00250CLR MOVELRCD TST 2 BM107 00260CLR TST COMP '<>' 51 BM107 00270CLRN51 SEQNO ADD 1 SEQNO BM107 00280CLRN51 GOTO LOOP BM107 0000290CLR A TAG BM107 00300CLR SEQNO SUB 1 SUBNO 50 BM107 00310CLR SUBNO CHAINBM1OUT 50 BM107 00320CLR MOVELRCD BUFFER BM107 00330CLR MOVE 'T' TYPE BM107 00340CLR Z-ADD80 BLNGTH BM107 00350CLR EXSR CRTCOM BM107 0000360CLR MOVE RCD HOLD 48 BM107 00370CLR MOVE B80 BUFFER BM107 00380CLR MOVE 'T' TYPE BM107 00390CLR MOVELHOLD HOLD1 47 BM107 00400CLR MOVELHOLD HOLD2 42 BM107 00410CLR MOVELHOLD2 BUFFER BM107 00420CLR Z-ADD42 BLNGTH BM107 0000430CLR EXSR CRTCOM BM107 00440CLR MOVE B80 BUFFER BM107 00450CLR MOVELMSG,3 BUFFER BM107 00460CLR MOVE 'S' TYPE BM107 00470CLR Z-ADD35 BLNGTH BM107 00480CLR EXSR CRTCOM BM107 00490CLR MOVE B80 BUFFER BM107 0000500CLR MOVE HOLD1 HLDSEQ 5 BM107 00510CLR MOVELHLDSEQ BUFFER BM107 00520CLR MOVE 'T' TYPE BM107 00530CLR Z-ADD5 BLNGTH BM107 00540CLR EXSR CRTCOM BM107 00550CLR MOVELMSG,4 BUFFER BM107 00560CLR MOVE 'S' TYPE BM107 0000570CLR Z-ADD35 BLNGTH BM107 00580CLR EXSR CRTCOM BM107 00590CLR MOVE B80 BUFFER BM107 00600CLR MOVE 'A' TYPE BM107 00610CLR Z-ADD1 BLNGTH BM107 00620CLR EXSR CRTCOM BM107 00630CLR MOVE 'C' TYPE BM107 0000640CLR EXSR CRTCOM BM107 00650CLR MOVE 'F' TYPE BM107 00660CLR EXSR CRTCOM BM107 00670CSR ALMTS BEGSR BM107 00680CSR MOVE B80 BUFFER 80 BM107 00690CSR MOVE 'C' TYPE 1 BM107 00700CSR Z-ADD0 BLNGTH 20 BM107 0000710CSR MOVE ' ' RCODE 1 BM107 00720CSR Z-ADD0 MASK 10 BM107 00730CSR Z-ADD0 DTYPE 10 BM107 00740CSR EXSR CRTCOM BM107 00750CSR MOVELMSG,1 BUFFER BM107 00760CSR MOVE 'S' TYPE BM107 00770CSR Z-ADD35 BLNGTH BM107 0000780CSR EXSR CRTCOM BM107 00790CSR MOVE B80 BUFFER BM107 00800CSR MOVE 'A' TYPE BM107 00810CSR Z-ADD5 BLNGTH BM107 00820CSR Z-ADD1 DTYPE BM107 00830CSR EXSR CRTCOM BM107 00840CSR EXSR SKIP BM107 0000850CSR RCODE COMP 'R' 86 BM107 00860CSR EXSR AJ BM107 00870CSR MOVELBUFFER LOW 50 BM107 00880CSR MOVE B80 BUFFER BM107 00890CSR MOVELMSG,2 BUFFER BM107 00900CSR MOVE 'S' TYPE BM107 00910CSR Z-ADD35 BLNGTH BM107 0000920CSR EXSR CRTCOM BM107 00930CSR MOVE B80 BUFFER BM107 00940CSR MOVE 'A' TYPE BM107 00950CSR Z-ADD5 BLNGTH BM107 00960CSR Z-ADD1 DTYPE BM107 00970CSR EXSR CRTCOM BM107 00980CSR RCODE COMP 'R' 87 BM107 0000990CSR EXSR AJ BM107 01000CSR MOVELBUFFER HIGH 50 BM107 01010CSR MOVE 'C' TYPE BM107 01020CSR EXSR CRTCOM BM107 01030CSR 86 BM107 01040COR 87 GOTO ALMTS BM107 01050CSR Z-ADD0 DTYPE BM107 0001060CSR ENDSR BM107 01070CSR CRTCOM BEGSR BM107 01080CSR EXITFSUBRCM BM107 01090CSR RLABL BUFFER BM107 01100CSR RLABL TYPE BM107 01110CSR RLABL BLNGTH BM107 01120CSR RLABL RCODE BM107 0001130CSR RLABL MASK BM107 01140CSR RLABL DTYPE BM107 01150CSR ENDSR BM107 01160CSR SKIP BEGSR BM107 01170CSR MOVELBUFFER NBUF 1 BM107 01180CSR MOVEL' ' BUFFER BM107 01190CSR Z-ADD1 BLNGTH BM107 0001200CSR MOVE 'T' TYPE BM107 01210CSR EXSR CRTCOM BM107 01220CSR MOVELNBUF BUFFER BM107 01230CSR ENDSR BM107 01240CSR AJ BEGSR BM107 01250CSR MOVELBUFFER VAR 15 BM107 01260CSR Z-ADD5 VL 20 BM107 0001270CSR EXIT SUBRAJ BM107 01280CSR RLABL VL BM107 01290CSR RLABL VAR BM107 01300CSR MOVELVAR BUFFER BM107 01310CSR ENDSR BM107 01320OBM1DUM D 60 BM107 01330O ALL 72 BM107 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(nC TTXBM108 P999999111111(000010H S BM108 00020X DECK-ID M12 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM108 00030F* RECOVERY PROGRAM FOR BM2ENT BM108 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM108 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM108 00060F* CONTROL DATA PROPRIETARY PRODUCT BM108 00070F* BM108 0000080FBM1DUM UPE F 72 DISK BM108 00090FBM2OUT IC F 128R DISK BM108 00100E MSG 1 5 35 BM108 00110IBM1DUM NS 01 BM108 00120I 1 72 ALL BM108 00130IBM2OUT NS 02 BM108 00140I 1 128 RCD BM108 0000150C SETOF 60 BM108 00160C SETON LR BM108 00170CLR MOVE ' ' B80 80 BM108 00180CLR EXSR ALMTS BM108 00190CLR Z-ADDLOW SEQNO 50 BM108 00200CLR LOOP TAG BM108 00210CLR SEQNO COMP HIGH 40 BM108 0000220CLR 40 GOTO A BM108 00230CLR SEQNO CHAINBM2OUT 50 BM108 00240CLR 50 GOTO A BM108 00250CLR MOVELRCD TST 2 BM108 00260CLR TST COMP '<>' 51 BM108 00270CLRN51 SEQNO ADD 1 SEQNO BM108 00280CLRN51 GOTO LOOP BM108 0000290CLR A TAG BM108 00300CLR SEQNO SUB 1 SUBNO 50 BM108 00310CLR SUBNO CHAINBM2OUT 50 BM108 00320CLR MOVELRCD BUFFER BM108 00330CLR MOVE 'T' TYPE BM108 00340CLR Z-ADD80 BLNGTH BM108 00350CLR EXSR CRTCOM BM108 0000360CLR MOVE RCD HOLD 48 BM108 00370CLR MOVE B80 BUFFER BM108 00380CLR MOVE 'T' TYPE BM108 00390CLR MOVELHOLD HOLD1 47 BM108 00400CLR MOVELHOLD HOLD2 42 BM108 00410CLR MOVELHOLD2 BUFFER BM108 00420CLR Z-ADD42 BLNGTH BM108 0000430CLR EXSR CRTCOM BM108 00440CLR MOVE B80 BUFFER BM108 00450CLR MOVELMSG,3 BUFFER BM108 00460CLR MOVE 'S' TYPE BM108 00470CLR Z-ADD35 BLNGTH BM108 00480CLR EXSR CRTCOM BM108 00490CLR MOVE B80 BUFFER BM108 0000500CLR MOVE HOLD1 HLDSEQ 5 BM108 00510CLR MOVELHLDSEQ BUFFER BM108 00520CLR MOVE 'T' TYPE BM108 00530CLR Z-ADD5 BLNGTH BM108 00540CLR EXSR CRTCOM BM108 00550CLR MOVELMSG,4 BUFFER BM108 00560CLR MOVE 'S' TYPE BM108 0000570CLR Z-ADD35 BLNGTH BM108 00580CLR EXSR CRTCOM BM108 00590CLR MOVE B80 BUFFER BM108 00600CLR MOVE 'A' TYPE BM108 00610CLR Z-ADD1 BLNGTH BM108 00620CLR EXSR CRTCOM BM108 00630CLR MOVE 'C' TYPE BM108 0000640CLR EXSR CRTCOM BM108 00650CLR MOVE 'F' TYPE BM108 00660CLR EXSR CRTCOM BM108 00670CSR ALMTS BEGSR BM108 00680CSR MOVE B80 BUFFER 80 BM108 00690CSR MOVE 'C' TYPE 1 BM108 00700CSR Z-ADD0 BLNGTH 20 BM108 0000710CSR MOVE ' ' RCODE 1 BM108 00720CSR Z-ADD0 MASK 10 BM108 00730CSR Z-ADD0 DTYPE 10 BM108 00740CSR EXSR CRTCOM BM108 00750CSR MOVELMSG,1 BUFFER BM108 00760CSR MOVE 'S' TYPE BM108 00770CSR Z-ADD35 BLNGTH BM108 0000780CSR EXSR CRTCOM BM108 00790CSR MOVE B80 BUFFER BM108 00800CSR MOVE 'A' TYPE BM108 00810CSR Z-ADD5 BLNGTH BM108 00820CSR Z-ADD1 DTYPE BM108 00830CSR EXSR CRTCOM BM108 00840CSR EXSR SKIP BM108 0000850CSR RCODE COMP 'R' 86 BM108 00860CSR EXSR AJ BM108 00870CSR MOVELBUFFER LOW 50 BM108 00880CSR MOVE B80 BUFFER BM108 00890CSR MOVELMSG,2 BUFFER BM108 00900CSR MOVE 'S' TYPE BM108 00910CSR Z-ADD35 BLNGTH BM108 0000920CSR EXSR CRTCOM BM108 00930CSR MOVE B80 BUFFER BM108 00940CSR MOVE 'A' TYPE BM108 00950CSR Z-ADD5 BLNGTH BM108 00960CSR Z-ADD1 DTYPE BM108 00970CSR EXSR CRTCOM BM108 00980CSR RCODE COMP 'R' 87 BM108 0000990CSR EXSR AJ BM108 01000CSR MOVELBUFFER HIGH 50 BM108 01010CSR MOVE 'C' TYPE BM108 01020CSR EXSR CRTCOM BM108 01030CSR 86 BM108 01040COR 87 GOTO ALMTS BM108 01050CSR Z-ADD0 DTYPE BM108 0001060CSR ENDSR BM108 01070CSR CRTCOM BEGSR BM108 01080CSR EXITFSUBRCM BM108 01090CSR RLABL BUFFER BM108 01100CSR RLABL TYPE BM108 01110CSR RLABL BLNGTH BM108 01120CSR RLABL RCODE BM108 0001130CSR RLABL MASK BM108 01140CSR RLABL DTYPE BM108 01150CSR ENDSR BM108 01160CSR SKIP BEGSR BM108 01170CSR MOVELBUFFER NBUF 1 BM108 01180CSR MOVEL' ' BUFFER BM108 01190CSR Z-ADD1 BLNGTH BM108 0001200CSR MOVE 'T' TYPE BM108 01210CSR EXSR CRTCOM BM108 01220CSR MOVELNBUF BUFFER BM108 01230CSR ENDSR BM108 01240CSR AJ BEGSR BM108 01250CSR MOVELBUFFER VAR 15 BM108 01260CSR Z-ADD5 VL 20 BM108 0001270CSR EXIT SUBRAJ BM108 01280CSR RLABL VL BM108 01290CSR RLABL VAR BM108 01300CSR MOVELVAR BUFFER BM108 01310CSR ENDSR BM108 01320OBM1DUM D 60 BM108 01330O ALL 72 BM108 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(dn d*TXBM109 P999999111111(000010H S BM109 00020X DECK-ID M13 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM109 00030F* CREATES BOMINP FROM BM1OUTA BM109 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM109 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM109 00060F* CONTROL DATA PROPRIETARY PRODUCT BM109 00070F* BM109 0000080FBM1OUTA IP AF 128 DISK BM109 00090FBOMINP O F 57 DISK BM109 00100F********************************************************************BM109 00110F* BM109 00120F* PACKAGE MANUFACTURING BM109 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM109 00140F* PROGRAM CREATE BOMINP FROM BM1OUTA BM109 0000150F* BM109 00160F********************************************************************BM109 00170F* BM109 00180F* NARRATIVE: BM109 00190F* BM109 00200F* FOR EACH RECORD IN KPFILE WITH DATA IN IT (KEYPCH PUTS A BM109 00210F* REL REC # IN 124-127 OF EACH RECORD IT FILLS), A RECORD IS PUT BM109 0000220F* OUT TO BOMINP. BM109 00230F* BM109 00240F********************************************************************BM109 00250F* BM109 00260F* ID F C H L FUNCTION OF INDICATORS BM109 00270F* BM109 00280F* 01 BM1OUTA RECORD BM109 0000290F* BM109 00300F* 91 REL REC NO BLANK NO DATA IN RECORD BM109 00310F* BM109 00320F********************************************************************BM109 00330IBM1OUTA NS 01 BM109 00340I 1 2 TST BM109 00350I 1 52 IMAGE BM109 0000360I 123 1270RRN 91 BM109 00370C TST COMP '<>' 9191 BM109 00380OBOMINP D 01 91 BM109 00390O IMAGE 52 BM109 00400O RRN 57 BM109 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00042000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000450/* 000460_ 00 00 00 00 00 00 00 00 __ 0(n TXBM120 P 999999111111(000010H S BM120 00020X DECK-ID M19 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM120 00030F* USING BOMSTR, BOMMST AND BOMINP, CREATE BOMWRK BM120 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM120 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM120 00060F* CONTROL DATA PROPRIETARY PRODUCT BM120 00070F* BM120 0000080FBOMINP IPEAF 57 DISK BM120 00090FBOMMST IC F 47R20AI 28 DISK BM120 00100FBOMSTR IC F 74R DISK BM120 00110FBOMWRK O F 56 DISK BM120 00120F********************************************************************BM120 00130F* BM120 00140F*THERE ARE FOUR MAJOR SECTIONS IN THE CALC BM120 0000150F*MESR FOR ALL MULTI LEVEL EXPLOSIONS BM120 00160F*SESR FOR ALL SINGLE LEVEL EXPLOSIONS BM120 00170F*MWSR FOR ALL MULTI LEVEL WHERE USED BM120 00180F*SWSR FOR ALL SINGLE LEVEL WHERE USED BM120 00190F* BM120 00200F********************************************************************BM120 00210E AR 26 5 0 BM120 0000220E AQ 26 7 3 BM120 00230E AP 26 20 BM120 00240IBOMINP NS 01 1 CP 2 CS 3 C BM120 00250I 4 23 ASY BM120 00260I 4 23 PN BM120 00270I 44 503MQTY BM120 00280I 51 510TYPE BM120 0000290I NS 02 BM120 00300I 1 57 REC BM120 00310IBOMSTR NS 04 BM120 00320I 1 20 STRPRN BM120 00330I 55 74 STRCMP BM120 00340I 25 313STRQTY BM120 00350I 52 52 NXTCOD 06 BM120 0000360I 32 360RRN BM120 00370I 37 410NXTDWN 0809 BM120 00380I 54 54 INVCOD BM120 00390I 42 460NXTWU 07 BM120 00400IBOMMST NS 05 BM120 00410I 13 170STRPN BM120 00420I 18 220WUPN 07 BM120 0000430C********************************************************************BM120 00440C* BM120 00450C*THE FOLLOWING SR ESTABLISHES THE REPORTS TO BE GENERATED BM120 00460C* BM120 00470C********************************************************************BM120 00480C TYPE COMP 1 70 BM120 00490C TYPE COMP 2 71 BM120 0000500C TYPE COMP 3 72 BM120 00510C TYPE COMP 4 73 BM120 00520C TYPE COMP 5 74 BM120 00530C 74 SETON 70 BM120 00540C 70 EXSR MESR BM120 00550C 70 SETOF 7074 BM120 00560C 71 EXSR SESR BM120 0000570C 71 SETOF 71 BM120 00580C 72 EXSR MWSR BM120 00590C 72 SETOF 72 BM120 00600C 73 EXSR SWSR BM120 00610C 73 SETOF 73 BM120 00620C********************************************************************BM120 00630CSR MESR BEGSR BM120 0000640CSR MOVE ASY PART 20 BM120 00650CSR MOVE ASY PRNT 20 BM120 00660CSR EXSR CLEAR BM120 00670CSR EXSR OUTHED BM120 00680CSR EXSR READIT BM120 00690CSR 88 GOTO MEEXIT NO COMPONENTS BM120 00700CSR 06 RRN ADD 1 NXTRRN 50 BM120 0000710CSRN06 Z-ADD0 NXTRRN BM120 00720CSR Z-ADD1 IND BM120 00730CSR MELOOP TAG BM120 00740CSR MOVE STRCMP PART BM120 00750CSR 70 EXSR MEQTY BM120 00760CSR EXSR MEOUT BM120 00770CSR 88 GOTO NXTCMP BM120 0000780CSR MOVE NXTRRN AR,IND BM120 00790CSR MOVE PRNT AP,IND BM120 00800CSR 06 RRN ADD 1 NXTRRN BM120 00810CSRN06 Z-ADD0 NXTRRN BM120 00820CSR MOVE PART PRNT BM120 00830CSR IND ADD 1 IND BM120 00840CSR IND COMP 26 83 BM120 0000850CSR 83 GOTO MEEXIT BM120 00860CSR GOTO MELOOP BM120 00870CSR NXTCMP TAG BM120 00880CSR NXTRRN COMP 0 2525 BM120 00890CSRN25 NXTRRN CHAINBOMSTR 25 BM120 00900CSRN25 PRNT COMP STRPRN 2626 BM120 00910CSRN25N26 NXTRRN ADD 1 NXTRRN BM120 0000920CSRN25N26 GOTO MELOOP BM120 00930CSR IND SUB 1 IND BM120 00940CSR IND COMP 0 2727 BM120 00950CSR 27 GOTO MEEXIT BM120 00960CSR MOVE AP,IND PRNT BM120 00970CSR MOVE AR,IND NXTRRN BM120 00980CSR GOTO NXTCMP BM120 0000990CSR MEEXIT ENDSR BM120 01000C********************************************************************BM120 01010C********************************************************************BM120 01020C* BM120 01030C*THE FOLLOWING SR IS THE MAIN LOGIC FOR SINGLE LEVEL EXPLOSION BM120 01040C********************************************************************BM120 01050C********************************************************************BM120 0001060C* BM120 01070CSR SESR BEGSR BM120 01080CSR EXSR CLEAR BM120 01090CSR EXSR OUTHED BM120 01100CSR MOVE ASY PART BM120 01110CSR MOVE ASY PRNT BM120 01120CSR Z-ADD1 IND BM120 0001130CSR EXSR READIT BM120 01140CSR 88 GOTO SEEXIT NO COMPONENTS BM120 01150CSR RRN ADD 1 NXTRRN BM120 01160CSRN06 EXSR SEOUT BM120 01170CSRN06 GOTO SEEXIT BM120 01180CSR COMPNT TAG BM120 01190CSR EXSR SEOUT BM120 0001200CSR NXTRRN CHAINBOMSTR 25 BM120 01210CSRN25 PRNT COMP STRPRN 2525 BM120 01220CSRN25 NXTRRN ADD 1 NXTRRN BM120 01230CSRN25 GOTO COMPNT BM120 01240CSR SEEXIT ENDSR BM120 01250C********************************************************************BM120 01260C********************************************************************BM120 0001270C* BM120 01280C*THE FOLLOWING SR IS THE MAIN LOGIC FOR MULTI LEVEL WHERE USED BM120 01290C* BM120 01300C********************************************************************BM120 01310C********************************************************************BM120 01320CSR MWSR BEGSR BM120 01330CSR MOVE PN PART BM120 0001340CSR EXSR CLEAR BM120 01350CSR EXSR OUTHED BM120 01360CSR EXSR READIT BM120 01370CSR 88 GOTO MWEXIT NO USAGES BM120 01380CSR Z-ADDNXTWU NXTRRN BM120 01390CSR Z-ADD1 IND BM120 01400CSR MWLOOP TAG BM120 0001410CSR MOVE STRPRN PART BM120 01420CSR EXSR MWOUT BM120 01430CSR 88 GOTO NXTPRN BM120 01440CSR MOVE NXTRRN AR,IND BM120 01450CSR Z-ADDNXTWU NXTRRN BM120 01460CSR IND ADD 1 IND BM120 01470CSR IND COMP 26 83 BM120 0001480CSR 83 GOTO MWEXIT BM120 01490CSR GOTO MWLOOP BM120 01500CSR NXTPRN TAG BM120 01510CSR NXTRRN CHAINBOMSTR 25 BM120 01520CSR NXTRRN COMP 0 2525 BM120 01530CSR Z-ADDNXTWU NXTRRN BM120 01540CSRN25 GOTO MWLOOP BM120 0001550CSR IND SUB 1 IND BM120 01560CSR IND COMP 0 2727 BM120 01570CSR 27 GOTO MWEXIT BM120 01580CSR MOVE AR,IND NXTRRN BM120 01590CSR GOTO NXTPRN BM120 01600CSR MWEXIT ENDSR BM120 01610C********************************************************************BM120 0001620C********************************************************************BM120 01630C* BM120 01640C*THE FOLLOWING SR IS THE MAIN LOGIC FOR SINGLE LEVEL WHEREUSED BM120 01650C* BM120 01660C********************************************************************BM120 01670C********************************************************************BM120 01680CSR SWSR BEGSR BM120 0001690CSR EXSR CLEAR BM120 01700CSR EXSR OUTHED BM120 01710CSR MOVE PN PART BM120 01720CSR Z-ADD1 IND BM120 01730CSR EXSR READIT BM120 01740CSR 88 GOTO SWEXIT NO USAGES BM120 01750CSR PARENT TAG BM120 0001760CSR MOVE STRPRN PART BM120 01770CSR EXSR SWOUT BM120 01780CSR NXTWU COMP 0 2525 BM120 01790CSRN25 NXTWU CHAINBOMSTR 25 BM120 01800CSRN25 GOTO PARENT BM120 01810CSR SWEXIT ENDSR BM120 01820C********************************************************************BM120 0001830C* BM120 01840C* THIS SR READS STRUCTURE OR WHERE USED FILE BY SETLL BM120 01850C* BM120 01860C********************************************************************BM120 01870CSR READIT BEGSR BM120 01880CSR SETOF 88 BM120 01890CSR 09 BM120 0001900COR 86 PART CHAINBOMMST 88 BM120 01910CSRN08N09 87 SETON 88 BM120 01920CSR 88 GOTO ENDRD BM120 01930CSR 09 BM120 01940COR 86 GOTO STRCHN BM120 01950CSR 08 87 NXTDWN CHAINBOMSTR 88 BM120 01960CSR GOTO ENDRD BM120 0001970CSR STRCHN TAG BM120 01980CSR 86N07 SETON 88 BM120 01990CSRN88 86 WUPN CHAINBOMSTR 88 BM120 02000CSRN88 87 STRPN CHAINBOMSTR 88 BM120 02010CSR ENDRD ENDSR BM120 02020C********************************************************************BM120 02030C* BM120 0002040C*THE FOLLOWING SR SELECTS OUTPUT FOR MULTI LEVEL EXPLOSION BM120 02050C* BM120 02060C********************************************************************BM120 02070CSR MEOUT BEGSR BM120 02080CSR EXSR OUTPRE BM120 02090CSR EXCPT BM120 02100CSR ENDSR BM120 0002110C********************************************************************BM120 02120C* BM120 02130C*THE FOLLOWING SR SELECTS OUTPUT FOR SINGLE LEVEL EXPLOSION BM120 02140C* BM120 02150C********************************************************************BM120 02160CSR SEOUT BEGSR BM120 02170CSR EXSR OUTPRE BM120 0002180CSR EXCPT BM120 02190CSR ENDSR BM120 02200C********************************************************************BM120 02210C* BM120 02220C*THE FOLLOWING SR SELECTS OUTPUT FOR MULTI LEVEL WHERE USED BM120 02230C* BM120 02240C********************************************************************BM120 0002250CSR MWOUT BEGSR BM120 02260CSR EXSR OUTPRE BM120 02270CSR EXCPT BM120 02280CSR ENDSR BM120 02290C********************************************************************BM120 02300C* BM120 02310C*THE FOLLOWING SR SELECTS OUTPUT FOR SINGLE LEVEL WHERE USED BM120 0002320C* BM120 02330C********************************************************************BM120 02340CSR SWOUT BEGSR BM120 02350CSR EXSR OUTPRE BM120 02360CSR EXCPT BM120 02370CSR ENDSR BM120 02380C********************************************************************BM120 0002390C* BM120 02400C*THE FOLLOWING SR PREPARES FOR OUTPUT BM120 02410C* BM120 02420C********************************************************************BM120 02430CSR OUTPRE BEGSR BM120 02440CSR MOVE 'X' WRKBRK BM120 02450CSR MOVE INVCOD WRKINV 1 BM120 0002460CSR 87 MOVE STRCMP WRKPN 20 BM120 02470CSR 86 MOVE STRPRN WRKPN BM120 02480CSR Z-ADDSTRQTY WRKQTY 73 BM120 02490CSR MQTY COMP 0 8585 BM120 02500CSR 85 WRKQTY MULT MQTY WRKQTY BM120 02510CSR MOVE IND WRKLEV 20 BM120 02520CSRN71N73 EXSR READIT BM120 0002530CSR ENDSR BM120 02540C********************************************************************BM120 02550C* BM120 02560C*THE FOLLOWING SR OUTPUTS HEADING RECORD FOR EACH REPORT REQUEST BM120 02570C* BM120 02580C********************************************************************BM120 02590CSR OUTHED BEGSR BM120 0002600CSR MOVE ' ' WRKBRK 1 BM120 02610CSR 70 MOVE 70 WRKCOD 20 BM120 02620CSR 71 MOVE 71 WRKCOD BM120 02630CSR 72 MOVE 72 WRKCOD BM120 02640CSR 73 MOVE 73 WRKCOD BM120 02650CSR WRKCOD COMP 72 868786 BM120 02660CSR MQTY COMP 0 85 BM120 0002670CSR 85 Z-ADD1 MQTY BM120 02680CSR MQTY MULT 1 WRKMQT 70H BM120 02690CSR 86 MOVE PN WRKASY 20 BM120 02700CSR 87 MOVE ASY WRKASY BM120 02710CSR 98 EXCPT BM120 02720CSR SETON 99 BM120 02730CSR SETOF 98 BM120 0002740CSR ENDSR BM120 02750C********************************************************************BM120 02760C* BM120 02770C*THE FOLLOWING SR CLEARS INDICATORS FOR EACH REPORT BM120 02780C* BM120 02790C********************************************************************BM120 02800CSR CLEAR BEGSR BM120 0002810CSR IND SUB IND IND 20 BM120 02820CSR CNT SUB CNT CNT 20 BM120 02830CSR SETOF 99 BM120 02840CSR SETON 98 BM120 02850CSR WRKSEQ ADD 1 WRKSEQ 40 BM120 02860CSR SETOF 08 BM120 02870CSR SETOF 8385 BM120 0002880CSR SETOF 868788 BM120 02890CSR SETON 09 BM120 02900CSR ENDSR BM120 02910C********************************************************************BM120 02920C* BM120 02930C*THE FOLLOWING SR CALCULATES EXTENDED QUANTITIES BM120 02940C* BM120 0002950C********************************************************************BM120 02960CSR MEQTY BEGSR BM120 02970CSR Z-ADDSTRQTY AQ,IND BM120 02980CSR MOVE IND CNT BM120 02990CSR Z-ADD1 WRKEQT BM120 03000CSR QTY TAG BM120 03010CSR CNT COMP 0 85 BM120 0003020CSR 85 GOTO QTYEXT BM120 03030CSR AQ,CNT MULT WRKEQT WRKEQT 93H BM120 03040CSR CNT SUB 1 CNT BM120 03050CSR GOTO QTY BM120 03060CSR QTYEXT TAG BM120 03070CSR MQTY COMP 0 8585 BM120 03080CSR 85 WRKEQT MULT MQTY WRKEQT BM120 0003090CSR ENDSR BM120 03100OBOMWRK E 98 BM120 03110O WRKSEQ 4 BM120 03120O WRKBRK B 5 BM120 03130O WRKASY B 56 BM120 03140O WRKCOD B 19 BM120 03150O WRKMQT B 26 BM120 0003160O E 99 BM120 03170O WRKSEQ 4 BM120 03180O WRKBRK B 5 BM120 03190O WRKPN B 56 BM120 03200O WRKLEV B 19 BM120 03210O WRKQTY B 26 BM120 03220O WRKEQT B 35 BM120 0003230O WRKINV B 36 BM120 ** 003240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003280/* 00329000_ 00 00 00 00 00 00 00 00 00 00 __ 0(o TTXBM115 P2999999111111(000010H S BM115 00020X DECK-ID M15 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM115 00030F* USING BOMSEQ AND BOMWOUT, CREATE BOMMST BM115 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM115 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM115 00060F* CONTROL DATA PROPRIETARY PRODUCT BM115 00070F* BM115 0000080FBOMSEQ IPEAF 74 DISK BM115 00090FBOMWOUT USEAF 74 DISK BM115 00100FBOMMST O F 47 20AI 28 DISK BM115 00110F********************************************************************BM115 00120F* BM115 00130F* PACKAGE MANUFACTURING BM115 00140F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM115 0000150F* PROGRAM UPDATE PRODUCT STRUCTURE FILE (BOMWOUT) BM115 00160F* AND CREATE BOMMST BM115 00170F* BM115 00180F* CONTRACTOR COMPUSOURCE BM115 00190F* PROGRAMMER TOM LEE BM115 00200F* DATE SEPTEMBER 26, 1976 BM115 00210F* BM115 0000220F********************************************************************BM115 00230F* BM115 00240F* NARRATIVE: BM115 00250F* BM115 00260F* TWO VERSIONS OF THE PRODUCT STRUCTURE FILE, BOMSEQ IN BM115 00270F* PARENT/COMPONENT ORDER AND BOMWOUT IN COMPONENT/PARENT ORDER, BM115 00280F* ARE USED TO CREATE BOMMST. ALSO, BOMWOUT IS UPDATED AS A STEP BM115 0000290F* TOWARD THE NEW BOMSTR. BM115 00300F* BM115 00310F********************************************************************BM115 00320F* BM115 00330F* ID F C H L FUNCTION OF INDICATORS BM115 00340F* BM115 00350F* 01 BOMSEQ (PARENT/COMPONENT ORDER) BM115 0000360F* 02 BOMWOUT (COMPONENT/PARENT ORDER) BM115 00370F* 25 1ST_WHERE-USED_REL_REC_# FOR COMPONENT IN BOMMST BM115 00380F* L1BOMSEQ/PARENT -AND- BOMWOUT/COMPONENT BM115 00390F* M1BOMSEQ/PARENT -AND- BOMWOUT/COMPONENT BM115 00400F* BM115 00410F********************************************************************BM115 00420IBOMSEQ NS 01 BM115 0000430I 1 20 PN L1M1 BM115 00440IBOMWOUT NS 02 BM115 00450I 55 74 PN L1M1 BM115 00460I 32 360RRN BM115 00470I********************************************************************BM115 00480I* BM115 00490I* BOMSEQ ALL BM115 0000500I* BM115 00510I* PN PARENT PART # BM115 00520I* BM115 00530I* BM115 00540I* BOMWOUT ALL BM115 00550I* BM115 00560I* PN COMPONENT PART # BM115 0000570I* RRN REL REC # THIS RECORD BM115 00580I* REL REC # NEXT DOWN BM115 00590I* REL REC # COMPONENT IN BOMMST BM115 00600I* BM115 00610I* BOMMST ALL BM115 00620I* BM115 00630I* PART BM115 0000640I* 1ST STRUCTURE REL REC # BM115 00650I* 1ST WHERE-USED REL REC # BM115 00660I* REL REC # IN BOMMST BM115 00670I* BM115 00680I********************************************************************BM115 00690C* BM115 00700C* NEW PART #, SO SETOF BOMMST_1ST_WHERE-USED_REL_REC_# INDICATOR. BM115 0000710C* BM115 00720C********************************************************************BM115 00730C L1 SETOF 25 BM115 00740C********************************************************************BM115 00750C* BM115 00760C* NEW PART #, SO INCREMENT BOMMST_REL_REC_# BM115 00770C* (ALSO BOMSTR/BOMWOUT REL_REC_#_COMPONENT_IN_BOMMST). BM115 0000780C* BM115 00790C********************************************************************BM115 00800C L1 BRRN ADD 1 BRRN 50 BM115 00810C********************************************************************BM115 00820C* BM115 00830C* PART IS A PARENT, SO INCREMENT #_OF_STRUCTURES BM115 00840C* (BOMSEQ PARENT/COMPONENT REL REC #). BM115 0000850C* BM115 00860C********************************************************************BM115 00870C 01 NSTR ADD 1 NSTR 50 BM115 00880C********************************************************************BM115 00890C* BM115 00900C* NEW PARENT PART #, SO HAVE 1ST_STRUCTURE_REL_REC_# FOR COMPONENT BM115 00910C* IN BOMMST (ALSO REL_REC_#_NEXT_DOWN FOR COMPONENT IN BM115 0000920C* BOMSTR/BOMWOUT). BM115 00930C* BM115 00940C********************************************************************BM115 00950C 01 L1 Z-ADDNSTR STRN 50 BM115 00960C********************************************************************BM115 00970C* BM115 00980C* NEW PART # NOT A COMPONENT, SO 0 1ST_WHERE-USED_REL_REC_# FOR BM115 0000990C* COMPONENT IN BOMMST. BM115 01000C* BM115 01010C********************************************************************BM115 01020C 01 L1NMR Z-ADD0 WUN 50 BM115 01030C********************************************************************BM115 01040C* BM115 01050C* PART IS A COMPONENT AND THIS IS THE THE FIRST PARENT OF WHICH BM115 0001060C* IT IS A COMPONENT, SO PUT BOMSTR/BOMSEQ REL_REC_#_THIS_RECORD BM115 01070C* INTO THE 1ST_WHERE-USED_REL_REC_# FOR COMPONENT IN BOMMST. BM115 01080C* BM115 01090C********************************************************************BM115 01100C 02N25 Z-ADDRRN WUN 25 BM115 01110C********************************************************************BM115 01120C* BM115 0001130C* NEW PART NOT A PARENT, SO 0 1ST_STRUCTURE_REL_REC_# FOR BM115 01140C* COMPONENT IN BOMMST (ALSO 0 REL_REC_#_NEXT_DOWN FOR COMPONENT BM115 01150C* IN BOMSTR/BOMWOUT). BM115 01160C* BM115 01170C********************************************************************BM115 01180C 02 L1NMR Z-ADD0 STRN BM115 01190C********************************************************************BM115 0001200OBOMWOUT D 02 BM115 01210O STRN 41 BM115 01220O BRRN 51 BM115 01230OBOMMST T L1 BM115 01240O PN 47 BM115 01250O STRN 17 BM115 01260O WUN 22 BM115 0001270O BRRN 27 BM115 ** 001280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001320/* 00133000_ 00 00 00 00 00 00 00 00 00 __ 0(,p= ,}TXBM116 PR999999111111(000010H S BM116 00020X DECK-ID M16 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM116 00030F* USING BOMWOUT,CREATE BOMSTR BM116 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM116 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM116 00060F* CONTROL DATA PROPRIETARY PRODUCT BM116 00070F* BM116 0000080FBOMWOUT IPEAF 74 DISK BM116 00090FBOMSTR OC F 74R DISK BM116 00100F********************************************************************BM116 00110F* BM116 00120F* PACKAGE MANUFACTURING BM116 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM116 00140F* PROGRAM USE BOMWOUT TO CREATE BOMSTR (NEW PRODUCT STRUCTURE) BM116 0000150F* BM116 00160F* CONTRACTOR COMPUSOURCE BM116 00170F* PROGRAMMER TOM LEE BM116 00180F* DATE SEPTEMBER 27, 1976 BM116 00190F* BM116 00200F********************************************************************BM116 00210F* BM116 0000220F* NARRATIVE: BM116 00230F* BM116 00240F* PUTS BOMSTR FILE BACK IN ORDER BY OUTPUTTING EACH RECORD OF BM116 00250F* BOMWOUT TO THE POSITION IN BOMSTR DESIGNATED BY BM116 00260F* REL_REC_#_THIS_RECORD FIELD OF THE BOMWOUT RECORD. BM116 00270F* BM116 00280F* IT ALSO INSERTS THE REL_REC_#_NEXT_WHERE-USED POINTERS BY BM116 0000290F* LOOKING-AHEAD TO THE NEXT BOMWOUT RECORD (SINCE BOMWOUT IS IN BM116 00300F* WHERE-USED ORDER). BM116 00310F* BM116 00320F* THE CALCS ARE HANDLED IN THE COMPLICATED ARRAY MANNER TO SAVE BM116 00330F* PROCESSING TIME (BY CUTTING DOWN ON ARM MOVEMENT). BM116 00340F* BM116 00350F********************************************************************BM116 0000360F* BM116 00370F* ID F C H L FUNCTION OF INDICATORS BM116 00380F* BM116 00390F* 01 BOMWOUT BM116 00400F* BM116 00410F* 20 FOR STUFFING ARRAYS --> FULL = 20 BM116 00420F* FOR PROCESSING FULL ARRAYS --> DONE = N20 BM116 0000430F* 60 LOOK-AHEAD COMPONENT IS SAME BM116 00440F* 80 OUTPUT BM116 00450F* 99 SETUP MAXREC ONCE BM116 00460F* BM116 00470F* LRDONE WITH INPUT --> PROCESS ARRAYS LAST TIME BM116 00480F* BM116 00490F* H1GOT BOMWOUT RECORD WITH REL_REC_#_THIS_RECORD BM116 0000500F* NOT IN BOMSTR --> FILE OVERFLOW VS. BUG SOMEWHERE BM116 00510F* BM116 00520F********************************************************************BM116 00530E* BM116 00540E* THE ARRAYS HAVE 21 ELEMENTS. BM116 00550E* DURING NORMAL PROCESSING, EACH OF THE FIRST 20 ELEMENTS IS BM116 00560E* UPDATED ACCORDING TO THE CONTENTS OF THE NEXT ELEMENT. SO THE BM116 0000570E* 21ST ELEMENT IS USED AS A FORM OF LOOK-AHEAD. AFTER THE BM116 00580E* UPDATING AND OUTPUT OF THE FIRST 20 ELEMENTS, THE CONTENTS OF BM116 00590E* THE 21ST ELEMTNT IS MOVED INTO THE 1ST ELEMENT. BM116 00600E* AT LR TIME, ONLY THE ELEMENTS WITH DATA WILL BE UPDATED AND BM116 00610E* OUTPUT (MAXIMUM OF 20). BM116 00620E* BM116 00630E REC 21 74 RECORDS BM116 0000640E PN 21 20 COMPONENT BM116 00650E* PART #'S BM116 00660E RN 21 5 0 REL_REC_#_THIS_ BM116 00670E* RECORD BM116 00680IBOMWOUT NS 01 BM116 00690I 1 74 RECORD BM116 00700I 55 74 COMPNT BM116 0000710I 32 360RRN BM116 00720I********************************************************************BM116 00730I* BM116 00740I* BOMWOUT ALL BM116 00750I* BM116 00760I* COMPNT COMPONENT PART # BM116 00770I* RRN REL REC # THIS RECORD IN BOMSTR BM116 0000780I* RECORD WHOLE RECORD BM116 00790I* BM116 00800I* BOMSTR ALL BM116 00810I* BM116 00820I* REL REC # NEXT WHERE-USED BM116 00830I* WHOLE RECORD BM116 00840I* BM116 0000850I********************************************************************BM116 00860C* BM116 00870C* SETUP THE MAXIMUM # OF RECORDS (ARRAY ELEMENTS) TO BE PROCESSED BM116 00880C* AT ONE TIME. BM116 00890C* BM116 00900C 99 GOTO START BM116 00910C Z-ADD20 MAXREC 20 BM116 0000920C SETON 99 BM116 00930C* BM116 00940C START TAG BM116 00950C* BM116 00960C********************************************************************BM116 00970C* BM116 00980C* THE FOLLOWING CALCS IS RESPONSIBLE FOR STUFFING BOMWOUT BM116 0000990C* RECORDS AND DATA INTO THE ARRAYS. BM116 01000C* BM116 01010C********************************************************************BM116 01020C* BM116 01030C N01 GOTO DEND IMPOSSIBLE BM116 01040C* BM116 01050C* INCREMENT #_OF_RECORDS (INDEX OF ELEMENT OF ARRAY TO STUFF). BM116 0001060C* BM116 01070C NR ADD 1 NR 20 BM116 01080C* BM116 01090C* STORE DATA INTO PROPER ARRAY ELEMENTS. BM116 01100C* BM116 01110C MOVE RECORD REC,NR BM116 01120C MOVE COMPNT PN,NR BM116 0001130C MOVE RRN RN,NR BM116 01140C* BM116 01150C* #_OF_ELEMENTS_OF_ARRAY_WHICH_ARE_STUFFED COMPARE TO BM116 01160C* MAXIMUM_#_OF_ELEMENTS_OF_ARRAY_TO_BE_PROCESSED = BM116 01170C* HAVE YOU STUFFED ALL 21 ELEMENTS OF ARRAY? BM116 01180C* BM116 01190C NR COMP MAXREC 20 YES --> 20 BM116 0001200C* NO --> N20 BM116 01210C* IF ARRAY IS FULL, THEN PROCEED TO PROCESSING BM116 01220C* (UPDATE AND OUTPUT 1ST 20 ELEMENTS). BM116 01230C* BM116 01240C 20 EXSR RANOUT BM116 01250C* BM116 01260C DEND TAG BM116 0001270C********************************************************************BM116 01280C* BM116 01290C* ARE STUFFING ARRAYS WITH BOMWOUT DATA AND HIT LR. HAVE BM116 01300C* STUFFED X ELEMENTS OF ARRAYS AND NEED TO PROCESS ALL X ELEMENTS. BM116 01310C* WHEN MAXREC WAS 20, STUFFED 21 ELEMENTS. NOW MAXREC IS X, SO BM116 01320C* SAY THAT X+1=NR IS #_OF_ELEMENTS STUFFED. SO INCREMENT BM116 01330C* #_OF_RECORDS. NOW FOR THE LOOK-AHEAD PROBLEM OF THE LAST LIVE BM116 0001340C* RECORD. THE LAST RECORD DEFINITELY SHOULD HAVE 0 IN THE BM116 01350C* REL_REC_#_OF_NEXT_WHERE-USED, SO PUT 0 IN THE REL_REC_#_THIS_ BM116 01360C* RECORD FIELD OF THE MAXREC+1 ELEMENT OF ARRAY. WHEN THE MAXREC BM116 01370C* ELEMENT (LAST LIVE RECORD) IS PROCESSED, IT WILL GET THE 0 BM116 01380C* WHERE-USED. BM116 01390C* BM116 01400C********************************************************************BM116 0001410C* BM116 01420CLR NR ADD 1 NR BM116 01430CLR Z-ADD0 RN,NR BM116 01440CLR EXSR RANOUT BM116 01450CLR Z-ADD0 ZERO 50 SETUP FIELD BM116 01460C* BM116 01470C********************************************************************BM116 0001480C* BM116 01490C* PROCESSES ARRAYS. BM116 01500C* ELEMENTS STUFFED AND TO BE USED = MAXREC+1 = NR. BM116 01510C* ELEMENTS UPDATED AND OUTPUT TO BOMSTR = MAXREC = NR-1. BM116 01520C* LAST STUFFED ELEMENT HAS CONTENTS PLACED IN 1ST ELEMENT OF ARRAY.BM116 01530C* BM116 01540C********************************************************************BM116 0001550C* BM116 01560CSR RANOUT BEGSR BM116 01570C* BM116 01580C* START AT FRONT OF ARRAYS. BM116 01590C* BM116 01600CSR Z-ADD1 M 20 BM116 01610C* BM116 0001620C* THE MTH ELEMENTS ARE BEING UPDATED AND OUTPUT. THE NTH BM116 01630C* ELEMENTS ARE ACTING AS LOOK-AHEADS. IF A GIVEN SET OF M AND N BM116 01640C* COMPONENT #'S ARE THE SAME, THEN THE 2 RECORDS ARE SIBLINGS BM116 01650C* WITH 2 PARENTS OF THE SAME COMPONENT. THE REL_REC_#_THIS_RECORD BM116 01660C* OF THE NTH IS PLACED IN THE REL_REC_#_NEXT_WHERE-USED OF THE BM116 01670C* MTH. ELSE, 0 IS PLACED IN THE REL_RE_#_NEXT_WHERE-USED OF THE BM116 01680C* MTH. BM116 0001690C* BM116 01700CSR RLOOP TAG BM116 01710C* BM116 01720CSR M ADD 1 N 20 BM116 01730CSR PN,M COMP PN,N 60SAME --> 60 BM116 01740C* NO --> N60 BM116 01750CSR EXSR EXCEPT BM116 0001760C* BM116 01770CSR MOVE N M NEXT BM116 01780CSR M COMP NR 20 ALL? YES-->N20 BM116 01790CSR 20 GOTO RLOOP BM116 01800C* BM116 01810CSR Z-ADD1 NR RESETUP ARRAYS BM116 01820CSR MOVE REC,M RECT 74 BM116 0001830CSR MOVE PN,M PNT 20 BM116 01840CSR Z-ADDRN,M RNT 50 BM116 01850CSR MOVE RECT REC,1 BM116 01860CSR MOVE PNT PN,1 BM116 01870CSR Z-ADDRNT RN,1 BM116 01880C* BM116 01890CSR ENDSR BM116 0001900C********************************************************************BM116 01910C* BM116 01920C* ACTUAL UPDATE OF MTH ELEMENT. BM116 01930C* BM116 01940C********************************************************************BM116 01950C* BM116 01960CSR EXCEPT BEGSR BM116 0001970C* BM116 01980CSR Z-ADDRN,M RRN CHAIN TO RIGHT BM116 01990CSR RRN CHAINBOMSTR H1 POSITION BM116 02000CSR H1 GOTO ENDEX IMPOSSIBLE BM116 02010C* BM116 02020CSR SETON 80 BM116 02030CSR EXCPT OUTPUT BM116 0002040CSR SETOF 80 BM116 02050C* BM116 02060CSR ENDEX ENDSR BM116 02070C********************************************************************BM116 02080C* BM116 02090OBOMSTR E 80 BM116 02100O REC,M 74 BM116 0002110O 60 RN,N 46 BM116 02120O N60 ZERO 46 BM116 ** 002130ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002140ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002150ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002160ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00217000/* 002180_ 00 00 00 00 00 00 00 00 00 00 00 __ 0(p TTXBM118 P999999111111(000010H S BM118 00020X DECK-ID M17 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM118 00030F* RECOVERY PROGRAM FOR BM4ENT BM118 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM118 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM118 00060F* CONTROL DATA PROPRIETARY PRODUCT BM118 00070F* BM118 0000080FBM1DUM UPE F 72 DISK BM118 00090FBM4OUT IC F 128R DISK BM118 00100E MSG 1 5 35 BM118 00110IBM1DUM NS 01 BM118 00120I 1 72 ALL BM118 00130IBM4OUT NS 02 BM118 00140I 1 128 RCD BM118 0000150C SETOF 60 BM118 00160C SETON LR BM118 00170CLR MOVE ' ' B80 80 BM118 00180CLR EXSR ALMTS BM118 00190CLR Z-ADDLOW SEQNO 50 BM118 00200CLR LOOP TAG BM118 00210CLR SEQNO COMP HIGH 40 BM118 0000220CLR 40 GOTO A BM118 00230CLR SEQNO CHAINBM4OUT 50 BM118 00240CLR 50 GOTO A BM118 00250CLR MOVELRCD TST 2 BM118 00260CLR TST COMP '<>' 51 BM118 00270CLRN51 SEQNO ADD 1 SEQNO BM118 00280CLRN51 GOTO LOOP BM118 0000290CLR A TAG BM118 00300CLR SEQNO SUB 1 SUBNO 50 BM118 00310CLR SUBNO CHAINBM4OUT 50 BM118 00320CLR MOVELRCD BUFFER BM118 00330CLR MOVE 'T' TYPE BM118 00340CLR Z-ADD80 BLNGTH BM118 00350CLR EXSR CRTCOM BM118 0000360CLR MOVE RCD HOLD 48 BM118 00370CLR MOVE B80 BUFFER BM118 00380CLR MOVE 'T' TYPE BM118 00390CLR MOVELHOLD HOLD1 47 BM118 00400CLR MOVELHOLD HOLD2 42 BM118 00410CLR MOVELHOLD2 BUFFER BM118 00420CLR Z-ADD42 BLNGTH BM118 0000430CLR EXSR CRTCOM BM118 00440CLR MOVE B80 BUFFER BM118 00450CLR MOVELMSG,3 BUFFER BM118 00460CLR MOVE 'S' TYPE BM118 00470CLR Z-ADD35 BLNGTH BM118 00480CLR EXSR CRTCOM BM118 00490CLR MOVE B80 BUFFER BM118 0000500CLR MOVE HOLD1 HLDSEQ 5 BM118 00510CLR MOVELHLDSEQ BUFFER BM118 00520CLR MOVE 'T' TYPE BM118 00530CLR Z-ADD5 BLNGTH BM118 00540CLR EXSR CRTCOM BM118 00550CLR MOVELMSG,4 BUFFER BM118 00560CLR MOVE 'S' TYPE BM118 0000570CLR Z-ADD35 BLNGTH BM118 00580CLR EXSR CRTCOM BM118 00590CLR MOVE B80 BUFFER BM118 00600CLR MOVE 'A' TYPE BM118 00610CLR Z-ADD1 BLNGTH BM118 00620CLR EXSR CRTCOM BM118 00630CLR MOVE 'C' TYPE BM118 0000640CLR EXSR CRTCOM BM118 00650CLR MOVE 'F' TYPE BM118 00660CLR EXSR CRTCOM BM118 00670CSR ALMTS BEGSR BM118 00680CSR MOVE B80 BUFFER 80 BM118 00690CSR MOVE 'C' TYPE 1 BM118 00700CSR Z-ADD0 BLNGTH 20 BM118 0000710CSR MOVE ' ' RCODE 1 BM118 00720CSR Z-ADD0 MASK 10 BM118 00730CSR Z-ADD0 DTYPE 10 BM118 00740CSR EXSR CRTCOM BM118 00750CSR MOVELMSG,1 BUFFER BM118 00760CSR MOVE 'S' TYPE BM118 00770CSR Z-ADD35 BLNGTH BM118 0000780CSR EXSR CRTCOM BM118 00790CSR MOVE B80 BUFFER BM118 00800CSR MOVE 'A' TYPE BM118 00810CSR Z-ADD5 BLNGTH BM118 00820CSR Z-ADD1 DTYPE BM118 00830CSR EXSR CRTCOM BM118 00840CSR EXSR SKIP BM118 0000850CSR RCODE COMP 'R' 86 BM118 00860CSR EXSR AJ BM118 00870CSR MOVELBUFFER LOW 50 BM118 00880CSR MOVE B80 BUFFER BM118 00890CSR MOVELMSG,2 BUFFER BM118 00900CSR MOVE 'S' TYPE BM118 00910CSR Z-ADD35 BLNGTH BM118 0000920CSR EXSR CRTCOM BM118 00930CSR MOVE B80 BUFFER BM118 00940CSR MOVE 'A' TYPE BM118 00950CSR Z-ADD5 BLNGTH BM118 00960CSR Z-ADD1 DTYPE BM118 00970CSR EXSR CRTCOM BM118 00980CSR RCODE COMP 'R' 87 BM118 0000990CSR EXSR AJ BM118 01000CSR MOVELBUFFER HIGH 50 BM118 01010CSR MOVE 'C' TYPE BM118 01020CSR EXSR CRTCOM BM118 01030CSR 86 BM118 01040COR 87 GOTO ALMTS BM118 01050CSR Z-ADD0 DTYPE BM118 0001060CSR ENDSR BM118 01070CSR CRTCOM BEGSR BM118 01080CSR EXITFSUBRCM BM118 01090CSR RLABL BUFFER BM118 01100CSR RLABL TYPE BM118 01110CSR RLABL BLNGTH BM118 01120CSR RLABL RCODE BM118 0001130CSR RLABL MASK BM118 01140CSR RLABL DTYPE BM118 01150CSR ENDSR BM118 01160CSR SKIP BEGSR BM118 01170CSR MOVELBUFFER NBUF 1 BM118 01180CSR MOVEL' ' BUFFER BM118 01190CSR Z-ADD1 BLNGTH BM118 0001200CSR MOVE 'T' TYPE BM118 01210CSR EXSR CRTCOM BM118 01220CSR MOVELNBUF BUFFER BM118 01230CSR ENDSR BM118 01240CSR AJ BEGSR BM118 01250CSR MOVELBUFFER VAR 15 BM118 01260CSR Z-ADD5 VL 20 BM118 0001270CSR EXIT SUBRAJ BM118 01280CSR RLABL VL BM118 01290CSR RLABL VAR BM118 01300CSR MOVELVAR BUFFER BM118 01310CSR ENDSR BM118 01320OBM1DUM D 60 BM118 01330O ALL 72 BM118 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(q TTXBM119 P999999111111(000010H S BM119 00020X DECK-ID M18 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM119 00030F* RECOVERY PROGRAM FOR BM3ENT BM119 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM119 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM119 00060F* CONTROL DATA PROPRIETARY PRODUCT BM119 00070F* BM119 0000080FBM1DUM UPE F 72 DISK BM119 00090FBM3OUT IC F 128R DISK BM119 00100E MSG 1 5 35 BM119 00110IBM1DUM NS 01 BM119 00120I 1 72 ALL BM119 00130IBM3OUT NS 02 BM119 00140I 1 128 RCD BM119 0000150C SETOF 60 BM119 00160C SETON LR BM119 00170CLR MOVE ' ' B80 80 BM119 00180CLR EXSR ALMTS BM119 00190CLR Z-ADDLOW SEQNO 50 BM119 00200CLR LOOP TAG BM119 00210CLR SEQNO COMP HIGH 40 BM119 0000220CLR 40 GOTO A BM119 00230CLR SEQNO CHAINBM3OUT 50 BM119 00240CLR 50 GOTO A BM119 00250CLR MOVELRCD TST 2 BM119 00260CLR TST COMP '<>' 51 BM119 00270CLRN51 SEQNO ADD 1 SEQNO BM119 00280CLRN51 GOTO LOOP BM119 0000290CLR A TAG BM119 00300CLR SEQNO SUB 1 SUBNO 50 BM119 00310CLR SUBNO CHAINBM3OUT 50 BM119 00320CLR MOVELRCD BUFFER BM119 00330CLR MOVE 'T' TYPE BM119 00340CLR Z-ADD80 BLNGTH BM119 00350CLR EXSR CRTCOM BM119 0000360CLR MOVE RCD HOLD 48 BM119 00370CLR MOVE B80 BUFFER BM119 00380CLR MOVE 'T' TYPE BM119 00390CLR MOVELHOLD HOLD1 47 BM119 00400CLR MOVELHOLD HOLD2 42 BM119 00410CLR MOVELHOLD2 BUFFER BM119 00420CLR Z-ADD42 BLNGTH BM119 0000430CLR EXSR CRTCOM BM119 00440CLR MOVE B80 BUFFER BM119 00450CLR MOVELMSG,3 BUFFER BM119 00460CLR MOVE 'S' TYPE BM119 00470CLR Z-ADD35 BLNGTH BM119 00480CLR EXSR CRTCOM BM119 00490CLR MOVE B80 BUFFER BM119 0000500CLR MOVE HOLD1 HLDSEQ 5 BM119 00510CLR MOVELHLDSEQ BUFFER BM119 00520CLR MOVE 'T' TYPE BM119 00530CLR Z-ADD5 BLNGTH BM119 00540CLR EXSR CRTCOM BM119 00550CLR MOVELMSG,4 BUFFER BM119 00560CLR MOVE 'S' TYPE BM119 0000570CLR Z-ADD35 BLNGTH BM119 00580CLR EXSR CRTCOM BM119 00590CLR MOVE B80 BUFFER BM119 00600CLR MOVE 'A' TYPE BM119 00610CLR Z-ADD1 BLNGTH BM119 00620CLR EXSR CRTCOM BM119 00630CLR MOVE 'C' TYPE BM119 0000640CLR EXSR CRTCOM BM119 00650CLR MOVE 'F' TYPE BM119 00660CLR EXSR CRTCOM BM119 00670CSR ALMTS BEGSR BM119 00680CSR MOVE B80 BUFFER 80 BM119 00690CSR MOVE 'C' TYPE 1 BM119 00700CSR Z-ADD0 BLNGTH 20 BM119 0000710CSR MOVE ' ' RCODE 1 BM119 00720CSR Z-ADD0 MASK 10 BM119 00730CSR Z-ADD0 DTYPE 10 BM119 00740CSR EXSR CRTCOM BM119 00750CSR MOVELMSG,1 BUFFER BM119 00760CSR MOVE 'S' TYPE BM119 00770CSR Z-ADD35 BLNGTH BM119 0000780CSR EXSR CRTCOM BM119 00790CSR MOVE B80 BUFFER BM119 00800CSR MOVE 'A' TYPE BM119 00810CSR Z-ADD5 BLNGTH BM119 00820CSR Z-ADD1 DTYPE BM119 00830CSR EXSR CRTCOM BM119 00840CSR EXSR SKIP BM119 0000850CSR RCODE COMP 'R' 86 BM119 00860CSR EXSR AJ BM119 00870CSR MOVELBUFFER LOW 50 BM119 00880CSR MOVE B80 BUFFER BM119 00890CSR MOVELMSG,2 BUFFER BM119 00900CSR MOVE 'S' TYPE BM119 00910CSR Z-ADD35 BLNGTH BM119 0000920CSR EXSR CRTCOM BM119 00930CSR MOVE B80 BUFFER BM119 00940CSR MOVE 'A' TYPE BM119 00950CSR Z-ADD5 BLNGTH BM119 00960CSR Z-ADD1 DTYPE BM119 00970CSR EXSR CRTCOM BM119 00980CSR RCODE COMP 'R' 87 BM119 0000990CSR EXSR AJ BM119 01000CSR MOVELBUFFER HIGH 50 BM119 01010CSR MOVE 'C' TYPE BM119 01020CSR EXSR CRTCOM BM119 01030CSR 86 BM119 01040COR 87 GOTO ALMTS BM119 01050CSR Z-ADD0 DTYPE BM119 0001060CSR ENDSR BM119 01070CSR CRTCOM BEGSR BM119 01080CSR EXITFSUBRCM BM119 01090CSR RLABL BUFFER BM119 01100CSR RLABL TYPE BM119 01110CSR RLABL BLNGTH BM119 01120CSR RLABL RCODE BM119 0001130CSR RLABL MASK BM119 01140CSR RLABL DTYPE BM119 01150CSR ENDSR BM119 01160CSR SKIP BEGSR BM119 01170CSR MOVELBUFFER NBUF 1 BM119 01180CSR MOVEL' ' BUFFER BM119 01190CSR Z-ADD1 BLNGTH BM119 0001200CSR MOVE 'T' TYPE BM119 01210CSR EXSR CRTCOM BM119 01220CSR MOVELNBUF BUFFER BM119 01230CSR ENDSR BM119 01240CSR AJ BEGSR BM119 01250CSR MOVELBUFFER VAR 15 BM119 01260CSR Z-ADD5 VL 20 BM119 0001270CSR EXIT SUBRAJ BM119 01280CSR RLABL VL BM119 01290CSR RLABL VAR BM119 01300CSR MOVELVAR BUFFER BM119 01310CSR ENDSR BM119 01320OBM1DUM D 60 BM119 01330O ALL 72 BM119 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(qe TXBM125 P J |999999111111(000010H S BM125 00020X DECK-ID M20 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM125 00030F* PRINTS BILLS OF MATERIAL AND WHERE USED LISTS BM125 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM125 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM125 00060F* CONTROL DATA PROPRIETARY PRODUCT BM125 00070F* BM125 0000080FBOMWRK IPEAF 56 DISK BM125 00090FPARTMST IC F 300R20AI 271 DISK BM125 00100FHEADING IT F 40 EDISK BM125 00110F$LP1 O F 132 OF PRINTER BM125 00120F********************************************************************BM125 00130F* BM125 00140F* PACKAGE MANUFACTURING BM125 0000150F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM125 00160F* PROGRAM PRINTS BILLS BM125 00170F* BM125 00180F* CONTRACTOR COMPUSOURCE BM125 00190F* PROGRAMMER TOM LEE BM125 00200F* DATE SEPTEMBER 27, 1976 BM125 00210F* BM125 0000220F********************************************************************BM125 00230F* BM125 00240F* NARRATIVE: BM125 00250F* BM125 00260F* PRINTS BILLS AND WHERE-USED LISTS. BM125 00270F* BM125 00280F* BOTH REPORTS EDIT PART #'S (HEADER AND DETAIL). IF THE BM125 0000290F* PART # IS ON PARTMST WITH A BLANK DELETE CODE, THEN ITS BM125 00300F* DESCRIPTION IS PRINTED. IF THE PART # IS ON PARTMST WITH BM125 00310F* A NON-BLANK DELETE CODE, THEN THE MESSAGE BM125 00320F* '* FLAGGED FOR DELETION *' IS PRINTED. IF THE PART # IS NOT BM125 00330F* ON PARTMST, THEN THE MESSAGE '** NOT ON PARTMST **' IS BM125 00340F* PRINTED. BM125 00350F* BM125 0000360F* BILLS FOR HEADER PART #, TAKE INV CODE FROM PARTMST. BM125 00370F* ----- FOR DETAIL PART #'S: BM125 00380F* BM125 00390F* EXAMPLE: PARTMST BOMWRK ---> PRINTED BM125 00400F* ------- ------- ------- BM125 00410F* ' ' ' ' ' ' BM125 00420F* ' ' 'N' '* *' BM125 0000430F* 'N' ' ' '*N*' BM125 00440F* 'N' 'N' ' N ' BM125 00450F* BM125 00460F* PRINTED PARTMST INV CODE AND FLAGGED IF DIFFERENT BM125 00470F* FROM BOMWRK INV CODE. BM125 00480F* BM125 00490F* WHERE-USED LISTS FOR HEADER AND DETAIL PART #'S, TAKE BM125 0000500F* ---------------- INV CODE FROM PARTMST. BM125 00510F* BM125 00520F*-------------------------------------------------------------------BM125 00530F* BM125 00540F* ID F C H L FUNCTION OF INDICATORS BM125 00550F* BM125 00560F* 01 BOMWRK - 1ST REC ON DOC (HEADER)(BREAK CODE = ' ') BM125 0000570F* 02 BOMWRK - REST (DETAIL)(BREAK CODE = 'X') BM125 00580F* 03 PARTMST BM125 00590F* BM125 00600F* 10 PARTMST/DELETE CODE = ' ' --> GOOD PART BM125 00610F* BM125 00620F* 11 HEADER PART #'S PARTMST RECORD HAS BLANK CODE BM125 00630F* 12 FOR BILL --> PART HAS SAME INVENTORY CODE IN BM125 0000640F* BOMSTR AND PARTMST BM125 00650F* 51 LEVEL = 1 (BOMWRK DETAIL RECORD) BM125 00660F* 52 LEVEL = 2 (BOMWRK DETAIL RECORD) BM125 00670F* 53 LEVEL = 3 (BOMWRK DETAIL RECORD) BM125 00680F* 54 LEVEL = 4 (BOMWRK DETAIL RECORD) BM125 00690F* 55 LEVEL = 5 (BOMWRK DETAIL RECORD) BM125 00700F* 56 LEVEL = 6 (BOMWRK DETAIL RECORD) BM125 0000710F* 57 LEVEL = 7 (BOMWRK DETAIL RECORD) BM125 00720F* 58 LEVEL = 8 (BOMWRK DETAIL RECORD) BM125 00730F* 59 LEVEL = 9 (BOMWRK DETAIL RECORD) BM125 00740F* 60 LEVEL = 10 - 26 (BOMWRK DETAIL RECORD) BM125 00750F* 70 EXPLODE TYPE = 70 'ME' (BOMWRK HEADER) BM125 00760F* 71 EXPLODE TYPE = 71 'SE' (BOMWRK HEADER) BM125 00770F* 72 EXPLODE TYPE = 72 'MW' (BOMWRK HEADER) BM125 0000780F* 73 EXPLODE TYPE = 73 'SW' (BOMWRK HEADER) BM125 00790F* 80 REFORMAT QTY IF DECIMAL PORTION IS 0 (BOMWRK DETAIL)BM125 00800F* 90 CHAIN TO PARTMST BY HEADER PART # GOT A MISS BM125 00810F* 91 CHAIN TO PARTMST BY DETAIL PART # GOT A MISS BM125 00820F* BM125 00830F********************************************************************BM125 00840E HEADING HEAD 1 1 40 COMPANY NAME BM125 0000850IBOMWRK NS 01 5 C BM125 00860I 37 56 WRKASY BM125 00870I 18 190WRKCOD BM125 00880I 20 260WRKMQT BM125 00890I NS 02 5 CX BM125 00900I 37 56 WRKPN BM125 00910I 18 190WRKLEV BM125 0000920I 20 263WRKQTY BM125 00930I 36 36 WRKINV BM125 00940IPARTMST NS 03 BM125 00950I 271 290 PARTNO BM125 00960I 1 37 DESCR BM125 00970I 38 39 UM BM125 00980I 40 40 CLS BM125 0000990I 51 51 INVCOD BM125 01000I 74 74 DLT 10 BM125 01010I 219 219 REVL BM125 01020I 220 2250REVD BM125 01030I********************************************************************BM125 01040I* BM125 01050I* BOMWRK ' ' HEADER (1ST RECORD ON BILL) BM125 0001060I* BM125 01070I* WRKASY PART # (FOR WHICH BILL WAS REQUESTED) BM125 01080I* WRKCOD STRUCTURE OR WHERE-USED EXPLODE TYPE BM125 01090I* WRKMQT QUANTITY OF ABOVE PART REQUESTED FOR BILL BM125 01100I* BM125 01110I* 'X' REST OF RECORDS ON BILL (DETAIL) BM125 01120I* BM125 0001130I* WRKPN PART # BM125 01140I* WRKLEV LEVEL # ('01' TO '26') BM125 01150I* WRKQTY QUANTITY = STRUCTURE_QTY_OF_THIS_PART * BM125 01160I* REQUEST_QTY_OF_HEADER_PART BM125 01170I* WRKINV INVENTORY CODE BM125 01180I* BM125 01190I* PARTMST ALL BM125 0001200I* BM125 01210I* PARTNO PART # BM125 01220I* DESCR DESCRIPTION BM125 01230I* UM UNIT OF MEASURE BM125 01240I* CLS PRODUCT CLASS BM125 01250I* INVCOD INVENTORY CODE BM125 01260I* DLT DELETE CODE BM125 0001270I* REVL REVIEW LETTER BM125 01280I* REVD REVIEW DATE BM125 01290I* BM125 01300I********************************************************************BM125 01310C********************************************************************BM125 01320C* BM125 01330C* HEADER RECORD. BM125 0001340C* BM125 01350C********************************************************************BM125 01360C N01 GOTO NEXT BM125 01370C* BM125 01380C* VALIDATE HEADER PART #. BM125 01390C* BM125 01400C WRKASY CHAINPARTMST 90 MISS --> 90 BM125 0001410C 90 GOTO ON HIT -->N90 BM125 01420C MOVE DESCR SDESCR 37 SAVE HEADING BM125 01430C MOVE UM SUM 2 SAVE HEADING BM125 01440C MOVE CLS SCLS 1 SAVE HEADING BM125 01450C MOVE INVCOD SINVCD 1 SAVE HEADING BM125 01460C MOVE DLT SDLT 1 SAVE HEADING BM125 01470C MOVE REVL SREVL 1 SAVE HEADING BM125 0001480C Z-ADDREVD SREVD 60 SAVE HEADING BM125 01490C 10 SETON 11 GOOD BM125 01500C N10 SETOF 11 DELETED BM125 01510C ON TAG BM125 01520C Z-ADD0 PAGE NEW DOCUMENT BM125 01530C* BM125 01540C* SET INDICATOR FOR REPORT TYPE. BM125 0001550C* BM125 01560C* REQUEST EXPLODE TYPE BM125 01570C* ------- ------------ BM125 01580C* 1 70 'ME' BM125 01590C* 2 71 'SE' BM125 01600C* 3 72 'MW' BM125 01610C* 4 73 'SW' BM125 0001620C* 5 70 'ME' BM125 01630C* BM125 01640C WRKCOD COMP 70 70 STRUCTURE BM125 01650C WRKCOD COMP 71 71 STRUCTURE BM125 01660C WRKCOD COMP 72 72 WHERE-USED BM125 01670C WRKCOD COMP 73 73 WHERE-USED BM125 01680C Z-ADD0 ITEM 30 BM125 0001690C********************************************************************BM125 01700C* BM125 01710C* DETAIL RECORDS. BM125 01720C* BM125 01730C********************************************************************BM125 01740C NEXT TAG BM125 01750C N02 GOTO END BM125 0001760C* BM125 01770C* VALIDATE DETAIL PART #. BM125 01780C* BM125 01790C WRKPN CHAINPARTMST 91 MISS --> 91 BM125 01800C* HIT -->N91 BM125 01810C MOVE WRKQTY DECIML 30 REFORMAT QTY BM125 01820C DECIML COMP 0 80IF DEC PART BM125 0001830C 80 Z-ADDWRKQTY WKQTY 40 IS 0 BM125 01840C ITEM ADD 1 ITEM BM125 01850C 70N91 BILL --> COMP BM125 01860COR 71N91 WRKINV COMP INVCOD 12 COMPONENT'S BM125 01870C 70 91 INVENTORY CD BM125 01880COR 71 91 SETOF 12 IN BOMSTR BM125 01890C* WITH ITS BM125 0001900C* INVENTORY CD BM125 01910C* IN PARTMST BM125 01920C* BM125 01930C* DETERMINE LEVEL OF PART. IF 'SE' OR 'SW', THEN ONLY HAVE TO BM125 01940C* DO IT ONCE FOR THIS DOCUMENT (ALL 1ST LEVEL). BM125 01950C* ALSO, IT'S UNNECESSARY TO RESET THE LEVEL FOR ADDITIONAL BM125 01960C* CONTIGUOUS SINGLE-LEVEL REQUESTS. BM125 0001970C* BM125 01980C N70N72 51 GOTO END BM125 01990C WRKLEV COMP 1 51 LEVEL 1 BM125 02000C WRKLEV COMP 2 52 LEVEL 2 BM125 02010C WRKLEV COMP 3 53 LEVEL 3 BM125 02020C WRKLEV COMP 4 54 LEVEL 4 BM125 02030C WRKLEV COMP 5 55 LEVEL 5 BM125 0002040C WRKLEV COMP 6 56 LEVEL 6 BM125 02050C WRKLEV COMP 7 57 LEVEL 7 BM125 02060C WRKLEV COMP 8 58 LEVEL 8 BM125 02070C WRKLEV COMP 9 59 LEVEL 9 BM125 02080C WRKLEV COMP 10 60 60 LEVELS 10-26 BM125 02090C END TAG BM125 02100O$LP1 D 202 01 BM125 0002110O OR OF BM125 02120O PAGE Z 8 BM125 02130O 4 'PAGE' BM125 02140O HEAD,1 86 BM125 02150O UDATE Y 132 BM125 02160O D 2 01 BM125 02170O OR OF BM125 0002180O 70 67 'BILL OF MATERIAL -' BM125 02190O 71 67 'BILL OF MATERIAL -' BM125 02200O 72 67 'WHERE-USED LIST -' BM125 02210O 73 67 'WHERE-USED LIST -' BM125 02220O 70 82 'MULTIPLE LEVEL' BM125 02230O 72 82 'MULTIPLE LEVEL' BM125 02240O 71 80 'SINGLE LEVEL' BM125 0002250O 73 80 'SINGLE LEVEL' BM125 02260O 132 'MFG125' BM125 02270O D 1 01 BM125 02280O OR OF BM125 02290O 11 'PART NUMBER' BM125 02300O 34 'DESCRIPTION' BM125 02310O 71 'QUANTITY' BM125 0002320O 77 'UM' BM125 02330O 82 'CLS' BM125 02340O 86 'INV' BM125 02350O 96 'REV DATE' BM125 02360O 105 'REV LTR' BM125 02370O D 2 01 BM125 02380O OR OF BM125 0002390O WRKASY 20 BM125 02400O N90 11SDESCR 60 BM125 02410O N90N11 47 '* FLAGGED FOR DELETION *' BM125 02420O 90 47 '** NOT ON PARTMST **' BM125 02430O WRKMQTL 72 BM125 02440O N90 SUM 78 BM125 02450O N90 SCLS 81 BM125 0002460O N90 SINVCD 85 BM125 02470O N90 SREVD Y 96 BM125 02480O N90 SREVL 102 BM125 02520O D 2 01 BM125 02530O OR OF BM125 02540O 4 'LINE' BM125 02550O 11 'LEVEL' BM125 0002560O 29 'PART NUMBER' BM125 02570O 52 'DESCRIPTION' BM125 02580O 90 'QUANTITY' BM125 02590O 96 'UM' BM125 02600O 101 'CLS' BM125 02610O 105 'INV' BM125 02620O 113 'REV LTR' BM125 0002630O D 1 02 51 BM125 02640O 1 ' ' BM125 02650O D 1 02 BM125 02660O ITEM 3 4 BM125 02670O 51 7 'X' BM125 02680O 52 8 'XX' BM125 02690O 53 9 'XXX' BM125 0002700O 54 10 'XXXX' BM125 02710O 55 11 'XXXXX' BM125 02720O 56 12 'XXXXXX' BM125 02730O 57 13 'XXXXXXX' BM125 02740O 58 14 'XXXXXXXX' BM125 02750O 59 15 'XXXXXXXXX' BM125 02760O 60 WRKLEV3 15 BM125 0002770O WRKPN 38 BM125 02780O N91 10DESCR 78 BM125 02790O N91N10 65 '* FLAGGED FOR DELETION *' BM125 02800O 91 65 '** NOT ON PARTMST **' BM125 02810O 80WKQTY LB 86 BM125 02820O N80WRKQTYL 91 BM125 02830O N91 UM 96 BM125 0002840O N91 CLS 100 BM125 02850O* 70N91N12 105 '* *' BM125 02860O* 71N91N12 105 '* *' BM125 02870O N91 INVCOD 104 BM125 02880O N91 REVL 110 BM125 ** 002890ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00290000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002910ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002920ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002930/* 002940_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2+ 2KPROGSOS PP999999041478(000010H KPROGO00020FOUTPUT IPE F 80 DISK MFG10O00030FKPROGS O F 36 8AI 1 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 36 ALL MFG10O00060OKPROGS D 01 MFG10O00070O ALL 36 MFG10O00/* 000080_ 00 00 00 00 00 00 __ 0(r TTXBM130 P999999111111(000010H S BM130 00020X DECK-ID M21 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM130 00030F* UPDATES INCREMENTAL COSTS IN PARTMST BM130 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM130 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM130 00060F* CONTROL DATA PROPRIETARY PRODUCT BM130 00070F* BM130 0000080FROUTING IP AF 102 DISK BM130 00090FPARTMST US AF 300 20AI 271 DISK BM130 00100FMACHMST IC F 48R05AI 1 DISK BM130 00110FLABMST IC F 48R02AI 1 DISK BM130 00120E WAR 200 5 WORK STATIONS BM130 00130E BAR 200 7 3 BURDEN/HR FOR WARBM130 00140E GAR 25 2 LABOR GRADES BM130 0000150E LAR 25 7 3 LABOR/HR FOR GAR BM130 00160IROUTING NS 01 BM130 00170I 83 102 PART L1M1 BM130 00180I 66 66 OPTYPE BM130 00190I 49 53 WS BM130 00200I 54 55 LG BM130 00210I 56 582QUEFAC 10 BM130 0000220I 38 423HRSPC BM130 00230I 59 653UOPCST BM130 00240IPARTMST NS 02 BM130 00250I 271 290 PART M1 BM130 00260IMACHMST NS 03 BM130 00270I 26 323BRATE BM130 00280ILABMST NS 04 BM130 0000290I 23 293LRATE BM130 00300C 02 GOTO END BM130 00310C L1 Z-ADD0 ILAB 73 BM130 00320C L1 Z-ADD0 IBUR 73 BM130 00330C L1 Z-ADD0 IOP 73 BM130 00340C L1 Z-ADD0 ILHRS 73 BM130 00350C L1 Z-ADD1 CUMFAC 32 BM130 0000360C SETOF 20 BM130 00370C OPTYPE COMP 'X' 20 BM130 00380C 10 Z-ADD1 QUEFAC BM130 00390C 20 CUMFAC MULT UOPCST UOP 73H BM130 00400C 20 UOP ADD IOP IOP BM130 00410C QUEFAC MULT CUMFAC CUMFAC H BM130 00420C 20 GOTO END BM130 0000430C SETOF 3040 BM130 00440C Z-ADD1 N 30 BM130 00450C WS LOKUPWAR,N 30 BM130 00460C 30 Z-ADDBAR,N BRATE BM130 00470C N30 EXSR BURDEN BM130 00480C Z-ADD1 M 20 BM130 00490C LG LOKUPGAR,M 40 BM130 0000500C 40 Z-ADDLAR,M LRATE BM130 00510C N40 EXSR LABOR BM130 00520C LRATE MULT HRSPC ULAB 73H BM130 00530C HRSPC ADD ILHRS ILHRS BM130 00540C ULAB ADD ILAB ILAB BM130 00550C BRATE MULT HRSPC UBUR 73H BM130 00560C UBUR ADD IBUR IBUR BM130 0000570C END TAG BM130 00580CLR Z-ADD0 Z7 73 BM130 00590CSR BURDEN BEGSR BM130 00600CSR WS CHAINMACHMST 25 BM130 00610CSR 25 Z-ADD0 BRATE BM130 00620CSR 25 GOTO BTAG BM130 00630CSR MOVEL' ' A5 5 BM130 0000640CSR Z-ADD1 N BM130 00650CSR A5 LOKUPWAR 31 BM130 00660CSRN31 GOTO BTAG BM130 00670CSR MOVELWS WAR,N BM130 00680CSR Z-ADDBRATE BAR,N BM130 00690CSR BTAG ENDSR BM130 00700CSR LABOR BEGSR BM130 0000710CSR LG CHAINLABMST 26 BM130 00720CSR 26 Z-ADD0 LRATE BM130 00730CSR 26 GOTO LTAG BM130 00740CSR MOVEL' ' A2 2 BM130 00750CSR Z-ADD1 M BM130 00760CSR A2 LOKUPGAR 41 BM130 00770CSRN41 GOTO LTAG BM130 0000780CSR MOVELLG GAR,M BM130 00790CSR Z-ADDLRATE LAR,M BM130 00800CSR LTAG ENDSR BM130 00810OPARTMST D 02 BM130 00820O MR ILAB 95 BM130 00830O MR IBUR 102 BM130 00840O MR IOP 109 BM130 0000850O MR ILHRS 137 BM130 00860O NMR Z7 95 BM130 00870O NMR Z7 102 BM130 00880O NMR Z7 109 BM130 00890O NMR Z7 137 BM130 00900O NMR Z7 116 BM130 00910O NMR Z7 123 BM130 0000920O NMR Z7 130 BM130 00930O NMR Z7 145 BM130 ** 000940ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000950ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000960ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000970ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00098000/* 000990_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(R TXOE560 P 4999999032778(000010H S OE560 00020X DECK-ID A74 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE560 00030F* PRINTS SALES ANALYSIS (NU1) AND HISTORY (U1) BY PART NUMBER OE560 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE560 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE560 00060F* CONTROL DATA PROPRIETARY PRODUCT OE560 00070F* OE560 0000080FSAMAST IPEAF 140 DISK OE560 00090FPARTMST IC F 300R20AI 271 DISK OE560 00100FCONTROL IC F 256R 7AI 1 DISK OE560 00110FHEADING IT F 40 EDISK OE560 00120F$LP1 O F 132 OF LPRINTER OE560 00130F********************************************************************OE560 00140F* OE560 0000150F* PACKAGE DISTRIBUTION OE560 00160F* SYSTEM SALES ANALYSIS OE560 00170F* PROGRAM HISTORICAL SALES ANALYSIS REPORT BY PART # (U1) OE560 00180F* COMPARATIVE SALES ANALYSIS REPORT BY PART # (NU1) OE560 00190F* OE560 00200F* CONTRACTOR COMPUSOURCE OE560 00210F* PROGRAMMER KATHY HILL OE560 0000220F* DATE JUNE 16, 1976 OE560 00230F* OE560 00240F********************************************************************OE560 00250E HEADING HEAD 1 1 40 COMPANY NAME OE560 00260E TS 12 7 0 LAST 12 MTH SALESOE560 00270E TD 12 2 0 HEADING YEARS U1 OE560 00280L$LP1 66FL 50OL OE560 0000290ISAMAST NS 01 OE560 00300I 121 140 PN OE560 00310I 13 190MTD OE560 00320I 20 210MTH OE560 00330I 22 105 TS OE560 00340I 106 1130YTDLST OE560 00350IPARTMST NS 02 OE560 0000360I 1 37 DESCR OE560 00370I 74 74 DLTPR OE560 00380ICONTROL NS 03 OE560 00390I 17 180REFYR OE560 00400I 19 200REFMTH OE560 00410C********************************************************************OE560 00420C* OE560 0000430C* THIS BLOCK OF LOGIC IS EXECUTED ONCE ONLY AT THE START OE560 00440C* OF THE PROGRAM. OE560 00450C* OE560 00460C* IT CHAINS TO THE CONTROL FILE WITH THE KEY 'CONTROL' OE560 00470C* AND FETCHES THE REFERENCE MONTH (SAMAST) AND THE OE560 00480C* REFERENCE YEAR (SAMAST). OE560 00490C* OE560 0000500C* IF THE 'CONTROL' RECORD IS MISSING, THEN H1 IS SET ON OE560 00510C* AND THE PROGRAM SHOULD BE CANCELLED. OE560 00520C* OE560 00530C* IF THE REFERENCE MONTH (SAMAST) AND/OR THE OE560 00540C* REFERENCE YEAR (SAMAST) IS ZERO, THEN H2 IS SET ON OE560 00550C* AND THE PROGRAM SHOULD BE CANCELLED. OE560 00560C* OE560 0000570C* USING THE REFERENCE MONTH (SAMAST) AND THE OE560 00580C* REFERENCE YEAR (SAMAST), THE PROGRAM DECIDES WHICH OE560 00590C* MONTH'S FIGURE (QTY) IS HELD BY EACH OF THE OE560 00600C* ELEMENTS OF THE SALES HISTORY ARRAY (QTY) OF SAMAST; OE560 00610C* USING THE MONTH/YEAR FROM CONTROL, THE PROGRAM OE560 00620C* ALSO DECIDES WHETHER THE RESPECTIVE MONTH WAS IN THE REFERENCE OE560 00630C* YEAR OR IN THE YEAR PRECEDING THE REFERENCE YEAR. OE560 0000640C* OE560 00650C********************************************************************OE560 00660C* OE560 00670C 97 SETOF 97 OE560 00680C 99 GOTO START OE560 00690C SETON 9799 OE560 00700C* OE560 0000710C MOVEL'CONTROL' KEY 7 OE560 00720C KEY CHAINCONTROL H1 OE560 00730C NH1 REFYR COMP 0 H2 OE560 00740C NH1NH2 REFMTH COMP 0 H2 OE560 00750C H1 OE560 00760COR H2 GOTO FINI OE560 00770C* OE560 0000780C REFMTH SUB 1 LSTMTH 20 OE560 00790C REFYR SUB 1 LSTYR 20 OE560 00800C* OE560 00810C Z-ADD1 INX 20 OE560 00820C MOVE LSTMTH MONTH 20 OE560 00830C* OE560 00840C LOOP1 TAG OE560 0000850C* OE560 00860C MONTH COMP 0 98 OE560 00870C 98 MOVE REFYR TD,INX OE560 00880C N98 MOVE LSTYR TD,INX OE560 00890C INX COMP 12 98 OE560 00900C 98 GOTO GETOUT OE560 00910C INX ADD 1 INX OE560 0000920C MONTH SUB 1 MONTH OE560 00930C GOTO LOOP1 OE560 00940C* OE560 00950C GETOUT TAG OE560 00960C* OE560 00970C********************************************************************OE560 00980C* OE560 0000990C* WITH EVERY RECORD OF SAMAST, PART # IS USED TO CHAIN TO THE OE560 01000C* PARTMST FILE. IF THERE IS A MISS ON THE CHAIN OR IF OE560 01010C* THE DELETE CODE OF THE RECORD IN PARTMST IS NOT BLANK, 25 IS OE560 01020C* SET ON AND '** NOT ON PART MASTER **' WILL PRINT OUT ON THE OE560 01030C* REPORT. IF THE RECORD IS ON PARTMST WITH A BLANK DELETE CODE, OE560 01040C* THEN THE DESCRIPTION OF THE PART WILL PRINT OUT ON THE REPORT. OE560 01050C* OE560 0001060C* ACCORDING TO WHETHER THE SWITCH SETTING IS U1 OR NU1, OE560 01070C* THE PROPER SUBROUTINE IS EXECUTED. OE560 01080C* OE560 01090C********************************************************************OE560 01100C* OE560 01110C START TAG OE560 01120C* OE560 0001130C 01 PN CHAINPARTMST 25 OE560 01140C 01N25 DLTPR COMP ' ' 2525 OE560 01150C* OE560 01160C U1 EXSR HSTSR OE560 01170C NU1 EXSR SASR OE560 01180C FINI TAG OE560 01190C* OE560 0001200C********************************************************************OE560 01210C* OE560 01220C* THIS SUBROUTINE SUMS ALL OF THE ELEMENTS OF THE SALES OE560 01230C* HISTORY ARRAY INTO A SINGLE FIGURE, LAST12. OE560 01240C* OE560 01250C* THEN, SOLELY FOR THE PURPOSES OF THE REPORT, THE OE560 01260C* ELEMENTS OF THE SALES HISTORY ARRAY ARE ROTATED. OE560 0001270C* THE PURPOSE OF THE ROTATION IS TO HAVE THE ELEMENTS OE560 01280C* OF THE ARRAY HOLDING THE SALES FIGURES FOR THE OE560 01290C* MONTHS IN DESCENDING ORDER; ELEMENT 1 HOLDING THE SALES FIGURE OE560 01300C* FOR THE MONTH OF DECEMBER, ELEMENT 2 HOLDING THE SALES OE560 01310C* FIGURE FOR THE MONTH OF NOVEMBER, ETC. OE560 01320C* IN THIS MANNER, THE PROGRAM CAN ALWAYS PRINT OE560 01330C* OUT THE SALES FIGURES JANUARY TO DECEMBER (THE OE560 0001340C* APPROPRIATE YEAR IS PRINTED BESIDE EACH MONTH IN THE HEADINGS). OE560 01350C* THE REFERENCE MONTH FROM CONTROL GUIDES THE OE560 01360C* SUBROUTINE IN THE ROTATION OF THE ARRAY. OE560 01370C* THE ROTATION IS ACCOMPLISHED THROUGH A NESTED LOOP. OE560 01380C* EACH PASS THROUGH THE INNER LOOP MANAGES TO OE560 01390C* ROTATE THE ELEMENTS IN THE ARRAY BY ONE POSITION ONLY OE560 01400C* (EX: MOVING ARRAY,2 INTO ARRAY,1) OE560 0001410C* AND THE REFERENCE MONTH IS USED (IN THE OUTER LOOP) OE560 01420C* TO TELL THE SUBROUTINE HOW MANY TIMES IT MUST OE560 01430C* ROTATE THE ELEMENTS OF THE ARRAY. OE560 01440C* OE560 01450C********************************************************************OE560 01460C* OE560 01470CSR HSTSR BEGSR OE560 0001480C* OE560 01490CSR XFOOTTS LAST12 80 OE560 01500C* OE560 01510CSR MOVE LSTMTH MONTH OE560 01520C* OE560 01530CSR LOOP2 TAG OE560 01540C* OE560 0001550CSR MONTH SUB 1 MONTH OE560 01560CSR MONTH COMP 0 98 OE560 01570CSR 98 GOTO OUT1 OE560 01580CSR Z-ADD1 INX OE560 01590CSR MOVE TS,INX WRK7 70 OE560 01600C* OE560 01610CSR LOOP3 TAG OE560 0001620C* OE560 01630CSR INX ADD 1 IN2 20 OE560 01640CSR MOVE TS,IN2 KWATCH 70 OE560 01650CSR MOVE KWATCH TS,INX OE560 01660CSR IN2 COMP 12 98 OE560 01670CSR 98 MOVE WRK7 TS,12 OE560 01680CSR 98 GOTO LOOP2 OE560 0001690CSR MOVE IN2 INX OE560 01700CSR GOTO LOOP3 OE560 01710C* OE560 01720CSR OUT1 ENDSR OE560 01730C* OE560 01740C********************************************************************OE560 01750C* OE560 0001760C* THIS SUBROUTINE FIGURES THE % INCREASE IN SALES FROM OE560 01770C* LAST MONTH (1ST ELEMENT OF SALES ARRAY) TO THIS MONTH OE560 01780C* (MTD SALES). OE560 01790C* OE560 01800C* IT FIGURES THE % INCREASE IN SALES FROM THE OE560 01810C* CURRENT MONTH THIS YEAR (MTD SALES) COMPARED TO THE OE560 01820C* CURRENT MONTH LAST YEAR (12TH ELEMENT OF SALES ARRAY). OE560 0001830C* OE560 01840C* IT CALCULATES YTD SALES THIS YEAR = MTD SALES + OE560 01850C* VALUES FROM ALL OF THE ELEMENTS OF THE SALES ARRAY WHICH OE560 01860C* HOLD SALES FIGURES FOR MONTHS OF THE REFERENCE YEAR. OE560 01870C* IT THEN FIGURES THE % INCREASE IN SALES OF YTD SALES THIS YEAR OE560 01880C* COMPARED TO YTD SALES LAST YEAR (YTD SALES LAST YEAR). OE560 01890C* OE560 0001900C********************************************************************OE560 01910C* OE560 01920CSR SASR BEGSR OE560 01930C* OE560 01940CSR MTD SUB TS,1 WRK7 70 OE560 01950CSR WRK7 DIV TS,1 WRKPCT 53H OE560 01960CSR WRKPCT MULT 100 PCT1 41 OE560 0001970CSR WRK7 COMP 0 5051 OE560 01980CSR 50 OE560 01990COR 51 TS,1 COMP 0 52 OE560 02000CSR 50 52 Z-ADD100 PCT1 OE560 02010CSR 51 52 Z-SUB100 PCT1 OE560 02020C* OE560 02030CSR MTD SUB TS,12 WRK7 OE560 0002040CSR WRK7 DIV TS,12 WRKPCT H OE560 02050CSR WRKPCT MULT 100 PCT2 41 OE560 02060CSR WRK7 COMP 0 5051 OE560 02070CSR 50 OE560 02080COR 51 TS,12 COMP 0 52 OE560 02090CSR 50 52 Z-ADD100 PCT2 OE560 02100CSR 51 52 Z-SUB100 PCT2 OE560 0002110C* OE560 02120CSR Z-ADD0 YTDCUR 80 OE560 02130CSR MTD ADD YTDCUR YTDCUR OE560 02140CSR Z-ADD1 INX OE560 02150C* OE560 02160CSR LOOP4 TAG OE560 02170C* OE560 0002180CSR LSTMTH COMP INX 98 OE560 02190CSR 98 GOTO OUT2 OE560 02200CSR TS,INX ADD YTDCUR YTDCUR OE560 02210CSR INX ADD 1 INX OE560 02220CSR GOTO LOOP4 OE560 02230C* OE560 02240CSR OUT2 TAG OE560 0002250C* OE560 02260CSR YTDCUR SUB YTDLST WRK7 OE560 02270CSR WRK7 DIV YTDLST WRKPCT H OE560 02280CSR WRKPCT MULT 100 PCT3 41 OE560 02290CSR WRK7 COMP 0 5051 OE560 02300CSR 50 OE560 02310COR 51 YTDLST COMP 0 52 OE560 0002320CSR 50 52 Z-ADD100 PCT3 OE560 02330CSR 51 52 Z-SUB100 PCT3 OE560 02340C* OE560 02350CSR ENDSR OE560 02360C* OE560 02370C********************************************************************OE560 02380O$LP1 H 202 1P OE560 0002390O OR OF OE560 02400O PAGE Z 8 OE560 02410O 4 'PAGE' OE560 02420O HEAD,1 86 OE560 02430O UDATE Y 132 OE560 02440O H 2 1P OE560 02450O OR OF OE560 0002460O U1 77 'SALES HISTORY BY PRODUCT' OE560 02470O NU1 69 'SALES ANALYSIS BY' OE560 02480O NU1 77 'PRODUCT' OE560 02490O 132 'DIS560' OE560 02500O H 1 97 U1 OE560 02510O OR OF U1 OE560 02520O 64 'THIS MTH' OE560 0002530O 73 'JAN' OE560 02540O TD,1 76 OE560 02550O 84 'FEB' OE560 02560O TD,2 87 OE560 02570O 95 'MAR' OE560 02580O TD,3 98 OE560 02590O 106 'APR' OE560 0002600O TD,4 109 OE560 02610O 117 'MAY' OE560 02620O TD,5 120 OE560 02630O 128 'JUN' OE560 02640O TD,6 131 OE560 02641O H 1 97 U1 02642O OR OF U1 0002643O 14 'PRODUCT NUMBER' 02650O H 2 97 U1 OE560 02660O OR OF U1 OE560 02680O 12 'DESCRIPTION' OE560 02690O 64 'LAST 12' OE560 02700O 73 'JUL' OE560 02710O TD,7 76 OE560 0002720O 84 'AUG' OE560 02730O TD,8 87 OE560 02740O 95 'SEP' OE560 02750O TD,9 98 OE560 02760O 106 'OCT' OE560 02770O TD,10 109 OE560 02780O 117 'NOV' OE560 0002790O TD,11 120 OE560 02800O 128 'DEC' OE560 02810O TD,12 131 OE560 02820O H 1 97NU1 OE560 02830O OR OFNU1 OE560 02840O 59 'CURRENT' OE560 02850O 70 'LAST' OE560 0002860O 89 'CUR MTH' OE560 02870O 122 '- - Y E A R T O D A T' OE560 02880O 128 'E - -' OE560 02881O H 1 97NU1 02882O OR OFNU1 02883O 14 'PRODUCT NUMBER' 02890O H 2 97NU1 OE560 0002900O OR OFNU1 OE560 02920O 12 'DESCRIPTION' OE560 02930O 58 'MONTH' OE560 02940O 70 'MONTH' OE560 02950O 76 '%' OE560 02960O 89 'LAST YR' OE560 02970O 95 '%' OE560 0002980O 109 'THIS YR' OE560 02990O 121 'LAST YR' OE560 03000O 127 '%' OE560 03001O D 11 01 U1 03002O PN 20 03010O D 01 01 U1 OE560 03030O N25 DESCR 38 OE560 0003040O 25 38 '** NOT ON PART MASTER **' OE560 03050O MTD J 65 OE560 03060O TS,12 J 77 OE560 03070O TS,11 J 88 OE560 03080O TS,10 J 99 OE560 03090O TS,9 J 110 OE560 03100O TS,8 J 121 OE560 0003110O TS,7 J 132 OE560 03120O D 1 01 U1 OE560 03130O LAST12JB 65 OE560 03140O TS,6 J 77 OE560 03150O TS,5 J 88 OE560 03160O TS,4 J 99 OE560 03170O TS,3 J 110 OE560 0003180O TS,2 J 121 OE560 03190O TS,1 J 132 OE560 03191O D 1 01NU1 03192O PN 20 03200O D 1 01NU1 OE560 03220O N25 DESCR 38 OE560 03230O 25 38 '** NOT ON PART MASTER **' OE560 0003240O MTD J 60 OE560 03250O TS,1 J 71 OE560 03260O PCT1 J 78 OE560 03270O TS,12 J 90 OE560 03280O PCT2 J 97 OE560 03290O YTDCURJB 110 OE560 03300O YTDLSTJ 122 OE560 0003310O PCT3 J 129 OE560 03320O T 2 LR OE560 03330O 11 'END OF JOB.' OE560 ** 003340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003350ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003360ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00337000/* 003380_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(s5 TXBM140 P999999111111(000010H S BM140 00020X DECK-ID M23 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM140 00030F* UPDATES CUMULATIVE COSTS IN PARTMST BM140 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM140 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM140 00060F* CONTROL DATA PROPRIETARY PRODUCT BM140 00070F* BM140 0000080FBOMINP IPEAF 57 DISK BM140 00090FBOMSTR UC F 74R DISK BM140 00100FBOMMST IC F 47R20AI 28 DISK BM140 00110FPARTMST UC F 300R20AI 271 DISK BM140 00120FBOMWRK O F 56 DISK U1 BM140 00130E APQ 10 9 3 BM140 00140E AQ 10 7 3 BM140 0000150E AC 10 20 BM140 00160E AP 10 20 BM140 00170E SVM 10 2 0 BM140 00180E NXA 10 5 0 BM140 00190E MXL 10 2 0 BM140 00200E CMP 100 20 BM140 00210E ND 100 5 0 BM140 0000220E QT 100 7 3 BM140 00230E C1 10 7 3 BM140 00240E C2 10 7 3 BM140 00250E C3 10 7 3 BM140 00260E C4 10 7 3 BM140 00270E C5 10 7 3 BM140 00280E C6 10 7 3 BM140 0000290IBOMINP NS 01 51 C5 BM140 00300I 4 23 ASY BM140 00310I NS 02 BM140 00320I 1 1 A BM140 00330IBOMSTR NS 03 BM140 00340I 1 20 STRPRN BM140 00350I 55 74 COMP BM140 0000360I 25 313QUANTY BM140 00370I 53 53 FLAG 07 BM140 00380I 52 52 NXTCOD 06 BM140 00390I 32 360RRN BM140 00400I 37 410NDOWN 08 BM140 00410IBOMMST NS 04 BM140 00420I 13 170STRPN BM140 0000430IPARTMST NS 11 74 C BM140 00440I 75 813AVGCST BM140 00450I 82 883LSTCST BM140 00460I 131 1373ULHRS BM140 00470I 89 953ULDLS BM140 00480I 138 1453TLHRS BM140 00490I 110 1163TLDLS BM140 0000500I 103 1093UOP BM140 00510I 124 1303TOP BM140 00520I 96 1023UBDLS BM140 00530I 117 1233TBDLS BM140 00540I NS 12 BM140 00550I 1 1 A BM140 00560C********************************************************************BM140 0000570C* BM140 00580C* THIS IS A PRODUCT COST EXPLODE. THE EXPLODE STARTS OFF BY BM140 00590C* READING FROM BOMMST THE 1ST ASSY OF THE PART# BEING EXPLODED. BM140 00600C* IF ANY COMPONENTS IN TURN HAS COMPONENTS THEN THE NXT DWN VALUE BM140 00610C* IN ITS BOMSTR RECORD WILL POINT TO ITS 1ST ASSEMBLY COMPONENT. BM140 00620C* TO FIND THE NEXT PART# ON THE SAME LEVEL THEN THE NEXT PHYSICAL BM140 00630C* RECORD IS READ. THIS PROCESS ALSO ACCESSES THE ITEM MASTER BM140 0000640C* FILE FOR COST INFORMATION. THE UNIT COSTS ARE TOTALED AND BM140 00650C* OUTPUTTED AS TOTAL COSTS TO THE PARENT FOR ALL ASSEMBLIES IN THE BM140 00660C* EXPLODE. THIS PROGRAM ALSO ALLOWS THE PROGRAM TO NOT EXPLODE BM140 00670C* AN ASSEMBLY TWICE. IF U1 IS OFF THEN BOMWRK IS NOT OUTPUT AND BM140 00680C* THE EXPLODE GOES TO THE NEXT COMPONENT IF THE CURRENT COMPONENT BM140 00690C* IS ALSO A PARENT BUT HAS BEEN EXPLODED. IF U1 IS ON THEN BOMWRK BM140 00700C* WILL BE OUTPUT WITH THE ENTIRE BILL OF MATERIAL BUT THE PRODUCT BM140 0000710C* COST INFORMATION WILL ONLY BE UPDATED ONCE. BM140 00720C* BM140 00730C********************************************************************BM140 00740C N01 GOTO DEND BM140 00750C* BM140 00760C* AT THIS POINT WE ZERO OUT THE ARRAYS, INITIALIZE INDICATIORS BM140 00770C* AND VARIABLES AND OUTPUT THE TOP UNIT INFORMATION TO BOMWRK IF BM140 0000780C* U1 IS ON BM140 00790C* BM140 00800C Z-ADD0 C1 BM140 00810C Z-ADD0 C2 BM140 00820C Z-ADD0 C3 BM140 00830C Z-ADD0 C4 BM140 00840C Z-ADD0 C5 BM140 0000850C Z-ADD0 C6 BM140 00860C SETOF 3095 BM140 00870C MOVE ASY PRNT 20 BM140 00880C MOVE ASY PART 20 BM140 00890C SEQNUM ADD 1 SEQNUM 40 BM140 00900C SETON 80 BM140 00910C U1 EXCPT BM140 0000920C SETOF 80 BM140 00930C Z-ADD1 QTYPNT 93 BM140 00940C N99 Z-ADD10 MAXSTR 20 BM140 00950C N99 Z-ADD10 MAXLVL 20 99 BM140 00960C* BM140 00970C* HERE WE START THE EXPLODE OFF BY FINDING THE RELATIVE RECORD BM140 00980C* NUMBER OF THE 1ST COMPONENT BM140 0000990C* BM140 01000C ASY CHAINBOMMST 55 BM140 01010C N55 STRPN COMP 0 5555 BM140 01020C 55 GOTO DEND NO COMPONENTS BM140 01030C* BM140 01040C* ONCE WE HAVE FOUND THE RRN OF THE 1ST COMPONENT WE READ THE BM140 01050C* FIRST -MAXSTR- AMOUNT OF COMPONENTS INTO CORE. THEN WE GO TO BM140 0001060C* NXTCMP WHERE WE BEGIN-PROCESSING -THE INFORMATION IN MAIN BM140 01070C* MEMORY BM140 01080C* BM140 01090C MOVE STRPN NXTDWN BM140 01100C Z-ADD1 L 20 BM140 01110C SETON 9394 BM140 01120C EXSR READEM READ 10 RECS BM140 0001130C SETOF 94 BM140 01140C BADPTR TAG BM140 01150C 90 SETON H1 BM140 01160C H1 GOTO DEND BM140 01170C 95NU1 GOTO DEND BM140 01180C 95 Z-SUB1 CHKLVL 30 BM140 01190C GOTO CALLRD BM140 0001200C* BM140 01210C* IN THIS NEXT SECTION WE HAVE AVAILABLE TO US THE COMPONENT BM140 01220C* INFORMATION. WE CAN EXTEND THE QUANTITY, OUTPUT THE INFORMATION, BM140 01230C* AND DECIDE WHETHER OR NOT THE COMPONENT HAS COMPONENTS OF ITS BM140 01240C* OWN. IF U1 IS OFF WE WON'T OUTPUT TO BOMWRK. IF THIS COMPONENTBM140 01250C* HAS NOT BEEN EXPLODED AND UPDATED AND HAS COMPONENTS OF ITS OWN BM140 01260C* THEN WE GO TO THE DWNMOR SECTION WHICH CONTINUES THE EXPLODE, BM140 0001270C* OTHER WISE WE GO ON AND INCREMENT THE COST ARRAYS BM140 01280C* BM140 01290C MELOOP TAG BM140 01300C QTYPNT MULT QTY EXQTY 93H BM140 01310C SETON 8180 BM140 01320C U1 EXCPT OUTPUT COMPNT BM140 01330C SETOF 8180 BM140 0001340C NXTDWN COMP 0 27 BM140 01350C 30 L COMP CHKLVL 30 BM140 01360C 27 30 U1 GOTO DWNMOR BM140 01370C 30 GOTO NXTCMP BM140 01380C 27 SETON 9394 BM140 01390C 27 EXSR READEM BM140 01400C 27 SETOF 94 BM140 0001410C 90 GOTO BADPTR BM140 01420C 27N95 GOTO DWNMOR BM140 01430C 95 Z-ADDL CHKLVL 20 30 BM140 01440C* BM140 01450C* THIS SECTION GOES TO THE ITEM MASTER FILE AND PULLS OFF THE BM140 01460C* INCREMENTAL COSTS FOR THE COMPONENT WE ARE CURRENTLY PROCESSING. BM140 01470C* WE MULTIPLY THESE COSTS BY THE QTY IN THE BOMSTR RECORD AND BM140 0001480C* ADD THESE EXTENDED COSTS TO THE COST ARRAYS. THESE COST ARRAYS BM140 01490C* ARE AN ACCUMULATION OF THE COSTS OF ALL THE COMPONENTS OF A BM140 01500C* SINGLE PARENT. IF THIS COMPONENT HAS BEEN COSTED AND IT HAS BM140 01510C* COMPONENTS ITSELF THEN TOTAL COSTS ARE USED INSTEAD OF THE BM140 01520C* INCREMENTAL. IF U1 IS OFF WE GO AND PROCESS THE NEXT COMPONENT. BM140 01530C* IF U1 IS ON AND THIS COMPONENT HAS COMPONENTS THEN WE GO TO BM140 01540C* THE DWNMOR SECTION BM140 0001550C* BM140 01560C SETOF 1112 BM140 01570C STRCMP CHAINPARTMST 55 BM140 01580C N55 12 SETON 55 BM140 01590C 55 27 U1 GOTO DWNMOR BM140 01600C 55 GOTO NXTCMP SKIP SECTION BM140 01610C QTY MULT AVGCST EXAVG 73H BM140 0001620C QTY MULT LSTCST EXLST 73H BM140 01630C N27 QTY MULT ULHRS EXLHRS 73H BM140 01640C N27 QTY MULT ULDLS EXLDLS 73H BM140 01650C N27 QTY MULT UOP EXOP 73H BM140 01660C N27 QTY MULT UBDLS EXBDLS 73H BM140 01670C 27 QTY MULT TLHRS EXLHRS H BM140 01680C 27 QTY MULT TLDLS EXLDLS H BM140 0001690C 27 QTY MULT TOP EXOP H BM140 01700C 27 QTY MULT TBDLS EXBDLS H BM140 01710C C1,L ADD EXAVG C1,L BM140 01720C C2,L ADD EXLST C2,L BM140 01730C C3,L ADD EXLHRS C3,L BM140 01740C C4,L ADD EXLDLS C4,L BM140 01750C C5,L ADD EXOP C5,L BM140 0001760C C6,L ADD EXBDLS C6,L BM140 01770C SETOF 95 BM140 01780C NU1 SETOF 93 BM140 01790C NU1 GOTO NXTCMP BM140 01800C N27 GOTO NXTCMP BM140 01810C* BM140 01820C* BM140 0001830C* DWNMOR SECTION TAKES THE EXPLODE TO THE NEXT LEVEL. IN OTHER BM140 01840C* WORDS IT ENCOUNTERED A COMPONENT WHICH WAS ALSO A PARENT OF BM140 01850C* A CHAIN OF COMPONENTS. IT MUST SAVE THE PRESENT STATUS OF THE BM140 01860C* EXPLODE -IN A SET OF ARRAYS, INCREMENT THE LEVEL COUNTER AND BM140 01870C* CONTINUE THE EXPLODE BY READING ITS FIRST -MAXSTR- AMOUNT OF BM140 01880C* COMPONENTS BM140 01890C* BM140 0001900C DWNMOR TAG BM140 01910C MOVE M SVM,L BM140 01920C MOVE QTYPNT APQ,L BM140 01930C Z-ADDEXQTY QTYPNT BM140 01940C MOVE QTY AQ,L BM140 01950C MOVE PRNT AP,L BM140 01960C MOVE STRCMP AC,L BM140 0001970C L ADD 1 L BM140 01980C L COMP MAXLVL H3 LEVEL TOO BIG BM140 01990C H3 GOTO DEND BM140 02000C MOVE STRCMP PRNT FOR CHECKING BM140 02010C CALLRD TAG BM140 02020C EXSR READEM BM140 02030C 90 GOTO BADPTR BM140 0002040C* BM140 02050C* IN THIS SECTION WE PULL OUT OF STORAGE THE BOMSTR INFORMATION BM140 02060C* WE PUT IN WHEN READEM WAS EXECUTED. IF THE PARTICULAR RECORD BM140 02070C* WAS ALREADY PROCESSED 30 IS SET ON. 30 IS ONLY SET OFF BM140 02080C* WHEN WE FIND THE NEXT COMPONENT ON THIS LEVEL OR LOWER. BM140 02090C* 31 IS SETON ON AT THE SAME TIME BUT IS SETOF WHEN EVER WE BM140 02100C* PROCESS THE COST INFORMATION. SO IF 30 IS ON AND 31 IS OFF IT BM140 0002110C* MEANS THAT NOT ONLY THIS COMPONENT HAS BEEN PROCESSED BUT IT'S BM140 02120C* PARENT HAS BEEN PROCESSED TOO. BM140 02130C* BM140 02140C NXTCMP TAG BM140 02150C M ADD 1 M 20 BM140 02160C LM ADD 1 LM 20 BM140 02170C M COMP MXL,L 2525 BM140 0002180C 25 MOVE CMP,LM STRCMP 20 BM140 02190C 25 MOVE ND,LM NXTDWN 50 BM140 02200C 25 MOVE QT,LM QTY 73 BM140 02210C 25 GOTO MELOOP BM140 02220C* BM140 02230C* IF WE GET TO THIS SECTION IT MEANS WE HAVE PULLED OUT AND BM140 02240C* PROCESSED ALL -MAXSTR- NUMBER OF RECORDS FROM THE ARRAYS AND BM140 0002250C* NOW WE MUST GO TO THE BOMSTR FILE AND READ -MAXSTR- MORE BM140 02260C* BM140 02270C M COMP MAXSTR 28 BM140 02280C 28 Z-ADDNXA,L NXTDWN 28 BM140 02290C 28 EXSR READEM BM140 02300C 28 90 GOTO BADPTR BM140 02310C 28 GOTO NXTCMP BM140 0002320C* BM140 02330C* IF WE GET TO THIS SECTION THEN WE HAVE COME TO THE END OF THE BM140 02340C* COMPONENT CHAIN FOR THE PARENT WHOSE LEVEL IS L-1. WE MUST BM140 02350C* TAKE THE TOTAL COST ARRAYS OF THE COMPONENTS AT LEVEL L AND ADD BM140 02360C* THEM TO THE UNIT COST FIGURES OF THE PARENT TO GET THE TOTAL BM140 02370C* COSTS OF THE PARENT. THEN WE MUST EXTEND THESE TOTAL COSTS AND BM140 02380C* ADD THEM TO THE COST ARRAY OF THE PARENT'S PARENT ARRAY - LEVEL BM140 0002390C* L-1. WE MUST OUTPUT THE PARENTS TOTAL COSTS TO THE ITEM MASTER BM140 02400C* AND THEN RESTORE THE EXPLODE STATUS TO WHAT IT WAS BEFORE BM140 02410C* WE EXPLODED THE PARENT BM140 02420C* BM140 02430C L SUB 1 L 2626 BM140 02440C 26 GOTO FINISH BM140 02450C MOVE SVM,L M BM140 0002460C MOVE AP,L PRNT BM140 02470C MOVE AQ,L QTY BM140 02480C MOVE APQ,L QTYPNT BM140 02490C MOVE AC,L STRCMP BM140 02500C L SUB 1 LM BM140 02510C LM MULT MAXSTR LM BM140 02520C LM ADD M LM BM140 0002530C 30 L COMP CHKLVL 30 30 BM140 02540C 30 GOTO NXTCMP BM140 02550C SETOF 1112 BM140 02560C STRCMP CHAINPARTMST 55 BM140 02570C N55 12 SETON 55 BM140 02580C N55 SETON 83 BM140 02590C L ADD 1 L1 20 BM140 0002600C 83 C3,L1 ADD ULHRS C3,L1 BM140 02610C 83 C4,L1 ADD ULDLS C4,L1 BM140 02620C 83 C5,L1 ADD UOP C5,L1 BM140 02630C 83 C6,L1 ADD UBDLS C6,L1 BM140 02640C 83 EXCPT OUTPUT TOTALS BM140 02650C 83 SETOF 83 BM140 02660C C1,L1 MULT QTY C1,L1 BM140 0002670C C2,L1 MULT QTY C2,L1 BM140 02680C C3,L1 MULT QTY C3,L1 BM140 02690C C4,L1 MULT QTY C4,L1 BM140 02700C C5,L1 MULT QTY C5,L1 BM140 02710C C6,L1 MULT QTY C6,L1 BM140 02720C C1,L1 ADD C1,L C1,L BM140 02730C C2,L1 ADD C2,L C2,L BM140 0002740C C3,L1 ADD C3,L C3,L BM140 02750C C4,L1 ADD C4,L C4,L BM140 02760C C5,L1 ADD C5,L C5,L BM140 02770C C6,L1 ADD C6,L C6,L BM140 02780C Z-ADD0 C1,L1 BM140 02790C Z-ADD0 C2,L1 BM140 02800C Z-ADD0 C3,L1 BM140 0002810C Z-ADD0 C4,L1 BM140 02820C Z-ADD0 C5,L1 BM140 02830C Z-ADD0 C6,L1 BM140 02840C GOTO NXTCMP BM140 02850C* BM140 02860C* THIS LAST SECTION UPDATES THE COST OF THE VERY TOP UNIT WHICH BM140 02870C* WAS ORIGINALLY EXPLODED. BM140 0002880C* BM140 02890C FINISH TAG BM140 02900C CHKLVL COMP 0 30 BM140 02910C 30 GOTO DEND BM140 02920C SETOF 1112 BM140 02930C PART CHAINPARTMST 55 BM140 02940C N55 12 SETON 55 BM140 0002950C 55 GOTO DEND BM140 02960C C3,1 ADD ULHRS C3,1 BM140 02970C C4,1 ADD ULDLS C4,1 BM140 02980C C5,1 ADD UOP C5,1 BM140 02990C C6,1 ADD UBDLS C6,1 BM140 03000C Z-ADD1 L1 83 BM140 03010C EXCPT BM140 0003020C SETOF 83 BM140 03030C DEND TAG BM140 03040C********************************************************************BM140 03050C* BM140 03060C* READEM READS -MAXSTR- RECORDS AT A TIME FROM BOMSTR AND STORES BM140 03070C* THE INFORMATION IN ARRAYS WITH MAXSTR X MAXLUL ELEMENTS. BM140 03080C* IF THE RECORD HAS ALREADY BEEN READ AND HAS COMPONENTS THEN THE BM140 0003090C* FLG ARRAY IS MARKED WITH AN 'X' FOR THAT RECORD. IF THE RECORD BM140 03100C* BE RUN BEFORE THIS TO BLANK OUT THIS FLAG FIELD FOR ALL BOMSTR BM140 03110C* RECORDS BM140 03120C* BM140 03130C********************************************************************BM140 03140CSR READEM BEGSR BM140 03150CSR MOVE NXTDWN NXTRRN 50 BM140 0003160CSR 94 GOTO CHNBOM BM140 03170CSR L SUB 1 LM BM140 03180CSR LM MULT MAXSTR LM BM140 03190C* BM140 03200C* THE RANGE OF ELEMENTS AVAILABLE IN THE STORAGE ARRAYS BM140 03210C* ARE LM+1 TO LM+MAXSTR . SO IF WE HAVE L=2 AND MAXSTR = 10 BM140 03220C* THEN THE RANGE IS FROM 11- 20 IF L=3 THEN 21 - 30 ECT. BM140 0003230C* BM140 03240CSR MOVE LM TM 20 BM140 03250CSR Z-ADD0 M BM140 03260CSR Z-ADD0 NXA,L BM140 03270CSR NXTRD TAG BM140 03280CSR M COMP MAXSTR 25 BM140 03290CSR 25 06 RRN ADD 1 NXA,L BM140 0003300CSR 25 GOTO ENDRD BM140 03310CSR CHNBOM TAG BM140 03320CSR 94 BM140 03330CORN93 NXTRRN CHAINBOMSTR 90 BM140 03340CSRN90N94 PRNT COMP STRPRN H2H2 BM140 03350CSRN90 H2 SETON 90 BM140 03360CSRN07 94 SETON 95 BM140 0003370CSR 90 BM140 03380COR 94 GOTO ENDIT BM140 03390CSR 07 93 SETON 79 BM140 03400CSR 79 EXCPT BM140 03410CSR SETOF 7993 BM140 03420CSR M ADD 1 M BM140 03430CSR TM ADD 1 TM BM140 0003440CSR MOVE COMP CMP,TM BM140 03450CSR MOVE NDOWN ND,TM BM140 03460CSR MOVE QUANTY QT,TM BM140 03470CSR 06 RRN ADD 1 NXTRRN BM140 03480CSR 06 GOTO NXTRD BM140 03490CSR ENDRD TAG BM140 03500CSR Z-ADDM MXL,L BM140 0003510CSR Z-ADD0 M BM140 03520CSR ENDIT ENDSR BM140 03530C* BM140 03540C********************************************************************BM140 03550OBOMSTR E 79 BM140 03560O 53 'X' BM140 03570OPARTMST E 83 BM140 0003580O C1,L1 81 BM140 03590O C2,L1 88 BM140 03600O C3,L1 145 BM140 03610O C4,L1 116 BM140 03620O C5,L1 130 BM140 03630O C6,L1 123 BM140 03640OBOMWRK E 80 U1 BM140 0003650O SEQNUM 4 BM140 03660O 5 ' ' BM140 03670O PART 56 BM140 03680O 19 ' ' BM140 03690O 81 5 'X' BM140 03700O 81 STRCMP 56 BM140 03710O 81 L 19 BM140 0003720O 81 QTY 26 BM140 03730O 81 EXQTY 35 BM140 ** 003740ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003750ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003760ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003770ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00378000/* 003790_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(t ?TXMR720 P 999999111111(000010H S MR720 00020X DECK-ID M36 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR720 00030F* FORECAST REPORT MR720 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR720 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR720 00060F* CONTROL DATA PROPRIETARY PRODUCT MR720 00070F* MR720 0000080FFORCST IPEAF 193 DISK MR720 00090FHEADING IT F 40 EDISK MR720 00100FPARTMST IC F 300R20AI 271 DISK MR720 00110F$LP1 O F 132 OF PRINTER MR720 00120F* MR720 00130F* THIS PROGRAM PRINTS THE FORECAST FILE INFORMATION MR720 00140F* MR720 0000150E HEADING HEAD 1 1 40 MR720 00160E F1 12 7 0 MR720 00170E F2 12 7 0 MR720 00180IFORCST NS 02 25NCD MR720 00190I 1 20 PARTNO MR720 00200I 26 109 F1 MR720 00210I 110 193 F2 MR720 0000220I NS 03 MR720 00230I 1 1 A MR720 00240IPARTMST NS 04 74NCD MR720 00250I 1 37 DESC MR720 00260I 38 39 UM MR720 00270I NS 05 MR720 00280I 1 1 A MR720 0000290C N02 GOTO DEND MR720 00300C SETON 99 MR720 00310C PARTNO CHAINPARTMST 55 MR720 00320C 05 SETON 55 MR720 00330C N55 GOTO DEND MR720 00340C MOVELB24 DESC MR720 00350C MOVEL'NOT ON M'T16 16 MR720 0000360C MOVE 'ASTER 'T16 MR720 00370C MOVELT16 DESC MR720 00380C MOVE B24 UM MR720 00390C DEND TAG MR720 00400CLR MOVE ' ' B24 37 MR720 00410O$LP1 H 02 1P MR720 00420O OR OF MR720 0000430O HEAD 86 MR720 00440O UDATE Y 132 MR720 00450O H 1 1P MR720 00460O OR OF MR720 00470O 4 'PAGE' MR720 00480O PAGE Z 8 MR720 00490O 74 'MONTHLY PRODUCTS FORECAS' MR720 0000500O 75 'T' MR720 00510O 132 'MFG720' MR720 00520O H 2 1P MR720 00530O OR OF MR720 00540O 11 'PART NUMBER' MR720 00550O 60 '1 2 3' MR720 00560O 84 '4 5 6' MR720 0000570O 108 '7 8 9' MR720 00580O 132 '10 11 12' MR720 00590O 28 'UM' MR720 00600O H 1 1P MR720 00610O OR OF MR720 00615O 12 'DESCRIPTION' 00620O 60 '13 14 15' MR720 0000630O 84 '16 17 18' MR720 00640O 108 '19 20 21' MR720 00650O 132 '22 23 24' MR720 00660O D 1 02 MR720 00670O PARTNO 20 MR720 00680O UM 28 MR720 00690O F1 132 '& 0' MR720 0000700O D 11 02 MR720 00710O DESC 37 MR720 00720O F2 132 '& 0' MR720 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00076000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000770/* 000780_ 00 00 00 00 00 00 00 00 00 00 __ 0(t $TXBM110 P999999111111(000010H S BM110 00020X DECK-ID M14 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM110 00030F* EDIT STRCHG RECORDS AND CREATE BOMSEQ BM110 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM110 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM110 00060F* CONTROL DATA PROPRIETARY PRODUCT BM110 00070F* BM110 0000080FBOMSTR IPEAF 74 DISK BM110 00090FSTRCHNG ISEAF 57 DISK BM110 00100FPARTMST IC F 300R20AI 271 DISK BM110 00110FHEADING IT F 40 EDISK BM110 00120FBOMSEQ O F 74 DISK BM110 00130F$LP1 O F 132 OF PRINTER BM110 00140F********************************************************************BM110 0000150F* BM110 00160F* PACKAGE MANUFACTURING BM110 00170F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM110 00180F* PROGRAM EDITS STRCHNG -AND- USES GOOD STRCHNG RECORDS BM110 00190F* AND ORIGINAL BOMSTR TO PRODUCE BOMSEQ (AN UPDATED BM110 00200F* VERSION OF BOMSTR) BM110 00210F* BM110 0000220F* CONTRACTOR COMPUSOURCE BM110 00230F* PROGRAMMER TOM LEE BM110 00240F* DATE AUGUST 1, 1976 BM110 00250F********************************************************************BM110 00260F* BM110 00270F* NARRATIVE: BM110 00280F* BM110 0000290F* THE ORIGINAL PRODUCT STRUCTURE FILE, BOMSTR, AND THE BM110 00300F* STRUCTURE CHANGES FILE, STRCHNG, ARE USED TO CREATE AN UPDATED BM110 00310F* FORM OF PRODUCT STRUCTURE FILE IN BOMSEQ. BM110 00320F* BM110 00330F********************************************************************BM110 00340F* ID F C H L FUNCTION OF INDICATORS BM110 00350F* BM110 0000360F* 01 BOMSTR BM110 00370F* 03 STRCHNG ADD BM110 00380F* 05 STRCHNG CHANGE BM110 00390F* 07 STRCHNG DLT BM110 00400F* 09 STRCHNG MULT DLT BM110 00410F* 11 STRCHNG INVALID TRANSACTION BM110 00420F* 12 PARTMST BM110 0000430F* 40 BLANK PARENT PART # ] STRCHNG RECORDS BM110 00440F* 41 BLANK COMPONENT PART # ] BM110 00450F* 42 0 STRUCTURE QUANTITY ] BM110 00460F* 43 BLANK INVENTORY CODE ] BM110 00470F* 10 STRCHNG RECORD --> PRINT BM110 00480F* 25 STRCHNG ADD WITH INVALID PART # BM110 00490F* 26 STRCHNG MULT DLT PARENT NOT PARENT IN BOMSTR BM110 0000500F* 31 DLT BM110 00510F* 32 MULT DLT BM110 00520F* 33 ERROR BM110 00530F* 34 PROCESSING BOMSTR RECORD BM110 00540F* 36 GOOD STRCHNG ADD TO GO TO BOMSEQ BM110 00550F* 50 DUPLICATE TRANSACTION BM110 00560F* 98 END OF PROCESSING (HIT 12-Z BOMSTR RECORD) BM110 0000570F* 99 SETUP Z12 ONCE ONLY AT START OF PROGRAM BM110 00580F* L1COMPONENT PART # ] STRCHNG & BOMSTR RECORDS BM110 00590F* M1COMPONENT PART # ] BM110 00600F* L2PARENT PART # ] BM110 00610F* M2PARENT PART # ] BM110 00620F* LRDONE PROCESSING BM110 00630F* BM110 0000640F********************************************************************BM110 00650E HEADING HEAD 1 1 40 COMPANY NAME BM110 00660IBOMSTR NS 01 BM110 00670I 1 20 PRNT L2M2 BM110 00680I 55 74 CMPNT L1M1 BM110 00690I 25 313QTY BM110 00700I 37 410RRN1 BM110 0000710I 42 460RRN2 BM110 00720I 47 510RRN3 BM110 00730I 52 52 NXTCOD BM110 00740I 54 54 ICODE BM110 00750I 1 74 REC BM110 00760I NS ** BM110 00770I 1 20 LPRNT BM110 0000780ISTRCHNG NS 03 1 CP 2 CS 3 CA BM110 00790I OR 05 1 CP 2 CS 3 CC BM110 00800I OR 07 1 CP 2 CS 3 CD BM110 00810I OR 09 1 CP 2 CS 3 CM BM110 00820I OR 11 BM110 00830I 3 3 TC BM110 00840I 4 23 PRNT L2M2 40 BM110 0000850I 24 43 CMPNT L1M1 41 BM110 00860I 44 503TQTY 42 BM110 00870I 52 52 INVCD 43 BM110 00880I 53 570RRN BM110 00890IPARTMST NS 12 BM110 00900I 271 290 PN BM110 00910I 74 74 DLTPR BM110 0000920I********************************************************************BM110 00930I* BM110 00940I* BOMSTR ALL BM110 00950I* BM110 00960I* PRNT PARENT PART # BM110 00970I* CMPNT COMPONENT PART # BM110 00980I* QTY STRUCTURE QUANTITY BM110 0000990I* RRN1 REL REC # NEXT DOWN BM110 01000I* RRN2 REL REC # NEXT WHERE-USED BM110 01010I* RRN3 REL REC # COMPONENT IN BOMMST BM110 01020I* NXTCOD NEXT CODE [ 1 = END OF CHAIN ] BM110 01030I* ICODE INVENTORY CODE BM110 01040I* REC RECORD BM110 01050I* LPRNT LOOK-AHEAD PARENT PART # BM110 0001060I* BM110 01070I* STRCHNG 'PSA' ADD BM110 01080I* 'PSC' CHANGE BM110 01090I* 'PSD' DELETE BM110 01100I* 'PSM' MULTIPLE DELETE BM110 01110I* REST BM110 01120I* BM110 0001130I* TC TRANSACTION CODE [A, C, D, OR M] BM110 01140I* PRNT PARENT PART # BM110 01150I* CMPNT COMPONENT PART # BM110 01160I* TQTY TRANSACTION STRUCTURE QUANTITY BM110 01170I* INVCD INVENTORY CODE BM110 01180I* RRN REL REC # IN KPFILE BM110 01190I* BM110 0001200I* PARTMST ALL BM110 01210I* BM110 01220I* PN PART # BM110 01230I* DLTPR DELETE CODE BM110 01240I* BM110 01250I********************************************************************BM110 01260C* BM110 0001270C********************************************************************BM110 01280C* BM110 01290C* SETUP Z12 ONCE ONLY AT START OF PROGRAM. BM110 01300C* BM110 01310C********************************************************************BM110 01320C N99 MOVE 'ZZZZZ' Z10 10 BM110 01330C N99 MOVEL'ZZZZZ' Z10 BM110 0001340C N99 MOVE Z10 Z20 20 BM110 01341C N99 MOVELZ10 Z20 01350C N99 SETON 99 BM110 01360C********************************************************************BM110 01370C* BM110 01380C* BOMSTR IS A RANDOM FILE AND THEREFORE, BM110 01390C* TO KEEP FROM WASTING TIME PROCESSING INACTIVE RECORDS, FOLLOWING BM110 0001400C* THE ACTIVE RECORDS IN BOMSTR IS A RECORD WITH 20 Z'S IN ITS BM110 01410C* PARENT PART #. WHEN THIS RECORD IS ENCOUNTERED, IT SIGNALS THE BM110 01420C* PROGRAM THAT IT IS THE LAST RECORD TO BE PROCESSED. BM110 01430C* BM110 01440C********************************************************************BM110 01450C 01 PRNT COMP Z20 98 BM110 01460C 98 SETON LR BM110 0001470C********************************************************************BM110 01480C* BM110 01490C* ONLY PRINT LINES IN THE EDIT LIST FOR STRCHNG RECORDS. BM110 01500C* SETOF STRCHNG_RECORD/PRINT INDICATOR. BM110 01510C* BM110 01520C********************************************************************BM110 01530C SETOF 10 BM110 0001540C********************************************************************BM110 01550C* BM110 01560C* IF THERE IS AN ERROR IN A STRCHNG RECORD, THEN THE RECORD BM110 01570C* HAS NO UPDATE EFFECT. IN THE EDIT LIST, AN APPROPRIATE ERROR BM110 01580C* MESSAGE IN PRINTED WITH THE RECORD. BM110 01590C* SETOF ERROR INDICATOR. BM110 01600C* BM110 0001610C********************************************************************BM110 01620C SETOF 33 BM110 01630C********************************************************************BM110 01640C* BM110 01650C* FOR STRCHNG RECORDS, BOTH THE CORRECTLY NON-BLANK PARENT PART BM110 01660C* #'S AND ANY NON-BLANK COMPONENT PART #'S ARE VALIDATED. TO BE BM110 01670C* VALID, A PART # SHOULD HAVE A RECORD IN PARTMST AND THE PART'S BM110 0001680C* RECORD IN PARTMST SHOULD HAVE A BLANK DELETE CODE. IF A BM110 01690C* STRCHNG RECORD HAS AN INVALID PART #, THEN THE RECORD HAS NO BM110 01700C* EFFECT ON BOMSTR/BOMSEQ. (IN THE EDIT LIST, THE MESSAGE BM110 01710C* 'INVALID PART #' IS PRINTED WITH THE STRCHNG RECORD.) BM110 01720C* SETOF STRCHNG_PART_#_NOT_ACTIVE ERROR INDICATOR. BM110 01730C* BM110 01740C********************************************************************BM110 0001750C SETOF 25 BM110 01760C********************************************************************BM110 01770C* BM110 01780C* WHEN A STRCHNG MULTIPLE DELETE RECORD CORRECTLY HAS A BLANK BM110 01790C* COMPONENT PART #, THE PROGRAM DETERMINES IF THE PARENT PART # BM110 01800C* OF THE MULTIPLE DELETE RECORD APPEARS AS A PARENT PART # IN BM110 01810C* BOMSTR. IF IT DOES, THEN ALL BOMSTR RECORDS WITH THE SAME BM110 0001820C* PARENT PART # AS THAT OF THE MULTIPLE DELETE ARE DELETED FROM BM110 01830C* BOMSTR/BOMSEQ. IF IT DOESN'T, THEN THE STRCHNG MULTIPLE DELETE BM110 01840C* RECORD HAS NO EFFECT ON BOMSTR/BOMSEQ. (IN THE EDIT LIST, THE BM110 01850C* MESSAGE 'PARENT NOT ON FILE' IS PRINTED WITH THE STRCHNG RECORD.)BM110 01860C* SETOF STRCHNG_MULTIPLE_DELETE_PARENT_PART_#_NOT_PARENT_IN_BOMSTR BM110 01870C* INDICATOR. BM110 01880C* BM110 0001890C********************************************************************BM110 01900C SETOF 26 BM110 01910C********************************************************************BM110 01920C* BM110 01930C* ANY PARENT_PART_#/COMPONENT_PART_# COMBINATION FOUND IN BOMSTR BM110 01940C* APPEARS ON A SINGLE BOMSTR RECORD ONLY. BM110 01950C* EVERY RECORD IN BOMSTR GOES OUT TO BOMSEQ UNLESS A STRCHNG BM110 0001960C* RECORD CAUSES ITS DELETION. SPECIAL PRECAUTION ENSURES THAT BM110 01970C* NO BOMSTR/BOMSEQ RECORD IS LOST BECAUSE OF ERRORS IN A STRCHNG BM110 01980C* RECORD WHICH IS ATTEMPTING TO UPDATE THE BOMSTR/BOMSEQ BM110 01990C* RECORD. BM110 02000C* IF GOT A BOMSTR RECORD AND HAVE A NEW COMPONENT PART # AND/OR BM110 02010C* A NEW PARENT PART #, THEN SETON ALREADY_HAVE_PARENT/COMPONENT_ BM110 02020C* COMBINATION_ON_BOMSTR INDICATOR. BM110 0002030C* BM110 02040C********************************************************************BM110 02050C 01 L1 SETON 34 BM110 02060C********************************************************************BM110 02070C* BM110 02080C* IF PROCESSING STRCHNG RECORD, SETON PRINT INDICATOR. BM110 02090C* BM110 0002100C********************************************************************BM110 02110C 03 ADD BM110 02120COR 05 CHG BM110 02130COR 07 DLT BM110 02140COR 09 MULT DLT BM110 02150COR 11 SETON 10 REST --> PRINT BM110 02160C********************************************************************BM110 0002170C* BM110 02180C* A STRCHNG MULT DLT DELETES ALL RECORDS IN BOMSTR WITH THE SAME BM110 02190C* PARENT PART # AS THAT OF THE MULT DLT. BM110 02200C* WHEN GET A RECORD WITH A NEW PARENT PART #, SETOF THE BM110 02210C* MULT_DLT_ACTIVATED_FOR_CURRENT_PARENT_PART_# INDICATOR. BM110 02220C* BM110 02230C********************************************************************BM110 0002240C L2 SETOF 32 BM110 02250C********************************************************************BM110 02260C* BM110 02270C* A STRCHNG DELETE DELETES THE BOMSTR RECORD WITH THE SAME BM110 02280C* PARENT/COMPONENT COMBINATION AS THAT OF THE DLT. BM110 02290C* WHEN GET A RECORD WITH A NEW COMPONENT PART # AND/OR A NEW BM110 02300C* PARENT PART #, SETOF THE DLT_CURRENT_RECORD INDICATOR. BM110 0002310C* BM110 02320C********************************************************************BM110 02330C L1 SETOF 31 BM110 02340C********************************************************************BM110 02350C* BM110 02360C* IT IS AN ERROR FOR A STRCHNG RECORD TO ATTEMPT TO ADD A RECORD BM110 02370C* TO BOMSTR/BOMSEQ WITH A PARENT/COMPONENT COMBINATION FOR WHICH BM110 0002380C* A RECORD IS ALREADY IN BOMSTR. IT IS ALSO AN ERROR FOR MORE BM110 02390C* THAN ONE STRCHNG ADD TO ATTEMPT TO ADD A RECORD TO BOMSTR/BOMSEQ BM110 02400C* FOR A GIVEN PARENT/COMPONENT COMBINATION. IN EITHER CASE, THE BM110 02410C* OFFENDING RECORD DOES NOT AFFECT BOMSTR/BOMSEQ. IF THE RECORD BM110 02420C* IS ALREADY ON BOMSTR, THEN ALL OF THE STRCHNG ADDS ARE REJECTED. BM110 02430C* IF THE RECORD IS NOT ALREADY ON BOMSTR, THEN THE FIRST STRCHNG BM110 02440C* ADD UPDATES BOMSTR/BOMSEQ AND THE OTHERS ARE REJECTED. IN THE BM110 0002450C* FORMER CASE, THE MESSAGE 'ALREADY ON FILE' APPEARS IN THE EDIT BM110 02460C* LIST BESIDE THE REJECTED STRCHNG ADDS. IN THE LATTER CASE, THE BM110 02470C* MESSAGE 'DUPLICATE TRANSACTION' APPEARS WITH THE REJECTED ADDS. BM110 02480C* IF NEW COMPONENT PART # AND/OR NEW PARENT PART #, THEN SETOF THE BM110 02490C* DUPLICATE_TRANSACTION_OF_SOME_SORT ERROR INDICATOR. BM110 02500C* BM110 02510C********************************************************************BM110 0002520C L1 SETOF 50 BM110 02530C********************************************************************BM110 02540C* BM110 02550C* IF MULTIPLE_DELETE INDICATOR IS ACTIVE FOR THIS PARENT PART #, BM110 02560C* THEN SETON THE DELETE_THIS_RECORD INDICATOR. BM110 02570C* BM110 02580C********************************************************************BM110 0002590C 32 SETON 31 BM110 02600C********************************************************************BM110 02610C* BM110 02620C* IF HAVE BOMSTR RECORD, NO NEED TO EDIT. - OR - BM110 02630C* IF STILL DEALING WITH ACTIVE MULTIPLE DELETE AND SO RECORD ARE BM110 02640C* PROCESSING IS TO BE DELETED, NO NEED TO EDIT. BM110 02650C* BM110 0002660C********************************************************************BM110 02670C 01 BM110 02680COR 31 GOTO DEND BM110 02690C********************************************************************BM110 02700C* BM110 02710C* IF DO NOT HAVE NEW COMPONENT AND/OR NEW PARENT AND STRCHNG BM110 02720C* RECORD IS ATTEMPTING ADD, SETON THE DUPLICATE_TRANSACTION_OF_ BM110 0002730C* SOME_SORT INDICATOR. BM110 02740C* BM110 02750C********************************************************************BM110 02760C NL1 03 SETON 50 BM110 02770C********************************************************************BM110 02780C* BM110 02790C* PART # VALIDATION (FOR NON-BLANK PART #'S) FOR ADDS. BM110 0002800C* IF AN INVALID PART # IS FOUND, THEN THE INVALID_PART_# BM110 02810C* INDICATOR IS SETON. BM110 02820C* BM110 02830C********************************************************************BM110 02840C N40 03 PRNT CHAINPARTMST 25 BM110 02850C N40 03N25DLTPR COMP ' ' 2525 BM110 02860C N41 03N25CMPNT CHAINPARTMST 25 BM110 0002870C N41 03N25DLTPR COMP ' ' 2525 BM110 02880C********************************************************************BM110 02890C* BM110 02900C* IF HAVE STRCHNG MULT DLT WITH CORRECTLY BLANK COMPONENT PART #, BM110 02910C* THEN CHECK IF MULT DLT PARENT IS PARENT IN BOMSTR. BM110 02920C* IF NOT, THEN SETON THE STRCHNG_MULTIPLE_DELETE_PARENT_PART_#_ BM110 02930C* NOT_PARENT_IN_BOMSTR INDICATOR. BM110 0002940C* BM110 02950C********************************************************************BM110 02960C 09 41 PRNT COMP LPRNT 2626 BM110 02970C********************************************************************BM110 02980C* BM110 02990C* IF ANY ERRORS ARE FOUND DURING THE EDITING PROCESS, THEN BM110 03000C* SETON THE ERROR INDICATOR, INCREMENT THE NUMBER OF ERRORS, AND BM110 0003010C* SKIP THE UPDATING OF BOMSTR. BM110 03020C* BM110 03030C* INDICATORS PRINTED MESSAGE CONDITIONS BM110 03040C* ---------- ----------------------- ------------------------------ BM110 03050C* BM110 03060C* 03 42 NO QUANTITY ADD / QTY=0 BM110 03070C* BM110 0003080C* 40 NO PARENT PART # PARENT BLANK BM110 03090C* BM110 03100C* N09N11 41 NO COMPONENT PART # NOT MULT DLT / NOT INVALID BM110 03110C* TRANSACTION / COMPONENT BLANK BM110 03120C* BM110 03130C* 05 42 43 NO QUANTITY OR I/N CODE CHANGE / QTY=0 / INVENTORY BM110 03140C* CODE BLANK BM110 0003150C* BM110 03160C* 07NMR PRNT-CMPNT NOT ON FILE DLT / NO SUCH RECORD IN BOMSTR BM110 03170C* BM110 03180C* 05NMR PRNT-CMPNT NOT ON FILE CHG / NO SUCH RECORD IN BOMSTR BM110 03190C* BM110 03200C* 50 DUPLICATE TRANSACTION ADD / TRYING TO ADD SAME BM110 03210C* RECORD MORE THAN ONCE -OR- BM110 0003220C* TRYING TO ADD RECORD ALREADY BM110 03230C* ON BOMSTR BM110 03240C* BM110 03250C* 11 INVALID TRANSACTION NOT ADD, CHG, DLT, OR MULT DLT BM110 03260C* BM110 03270C* 03 MR ALREADY ON FILE ADD / ALREADY ON BOMSTR BM110 03280C* (REPLACES 'DUPLICATE TRANS') BM110 0003290C* BM110 03300C* 25 INVALID PART # ADD / NON-BLANK PART # NOT IN BM110 03310C* PARTMST OR HAS NON-BLANK BM110 03320C* DELETE CODE IN ITS PARTMST REC BM110 03330C* BM110 03340C* 09 41 26 PARENT NOT ON FILE MULT DLT / COMPONENT BLANK / BM110 03350C* PARENT NOT A PARENT IN BOMSTR BM110 0003360C* BM110 03370C* 09N41 INVALID MULT DLT MULT DLT / COMPONENT NOT BLANK BM110 03380C* BM110 03390C********************************************************************BM110 03400C 03 42 BM110 03410COR 40 BM110 03420CORN09N11 41 BM110 0003430COR 05 42 43 BM110 03440COR 07NMR BM110 03450COR 05NMR BM110 03460COR 50 BM110 03470COR 11 NERRS ADD 1 NERRS 40 33 ERROR --> BM110 03480C 33 GOTO DEND NO UPDATE BM110 03490C 03 MR BM110 0003500COR 25 BM110 03510COR 09 41 26 BM110 03520COR 09N41 NERRS ADD 1 NERRS 33 ERROR --> BM110 03530C 33 GOTO DEND NO UPDATE BM110 03540C********************************************************************BM110 03550C* BM110 03560C* IF RECORDS ARE GOOD, THEN INCREMENT COUNTS AND ALLOW RECORDS BM110 0003570C* TO UPDATE BOMSTR/BOMSEQ. BM110 03580C* BM110 03590C********************************************************************BM110 03600C 03 NADDS ADD 1 NADDS 40 BM110 03610C 05 NCHGS ADD 1 NCHGS 40 BM110 03620C 07 NDLTS ADD 1 NDLTS 40 31 DLT ACTIVE BM110 03630C 09 NMDLTS ADD 1 NMDLTS 40 32 MULT DLT ACTIVEBM110 0003640C* BM110 03650C 09 SETON 31 MULT DLT --> BM110 03660C* DLT ACTIVE BM110 03670C 03 BM110 03680COR 05 EXSR CHNGE UPDATE BM110 03690C* BM110 03700C DEND TAG BM110 0003710C********************************************************************BM110 03720C* BM110 03730C* A GOOD STRCHNG ADD SHOULD GO OUT TO BOMSTR/BOMSEQ EVEN THOUGH BM110 03740C* FOLLOWING DUPLICATE TRANSACTIONS SHOULD NOT. ONLY ADDS WITHOUT BM110 03750C* ERROR ARE TO GO OUT TO BOMSTR/BOMSEQ. BM110 03760C* IF ADD WITHOUT ERROR FOUND, THEN SETON THE OUTPUT_ADD_TO_FILE BM110 03770C* INDICATOR. BM110 0003780C* BM110 03790C********************************************************************BM110 03800C 03N33 SETON 36 BM110 03810C********************************************************************BM110 03820C* BM110 03830C* A BOMSTR RECORD SHOULD REMAIN ON FILE UNLESS SPECIFICALLY BM110 03840C* DELETED. IF A RECORD ALREADY EXISTS ON BOMSTR AND THE STRCHNG BM110 0003850C* RECORD ATTEMPTING TO UPDATE BOMSTR HAS AN ERROR, THEN IT IS BM110 03860C* NECESSARY TO SETOF THE ERROR INDICATOR TO PRESERVE THE BM110 03870C* ORIGINAL BOMSTR RECORD. IT IS ALREADY TOO LATE FOR THE BM110 03880C* BAD STRCHNG RECORD TO AFFECT BOMSTR. BM110 03890C* BM110 03900C********************************************************************BM110 03910C 33 34 SETOF 33 BM110 0003920C********************************************************************BM110 03930C* BM110 03940C* NEW COMPONENT AND/OR NEW PARENT, SETOF BOMSTR_RECORD INDICATOR. BM110 03950C* BM110 03960C********************************************************************BM110 03970CL1 SETOF 34 BM110 03980C********************************************************************BM110 0003990C* BM110 04000C* NEW COMPONENT AND/OR NEW PARENT AND HAVE GOOD STRCHNG ADD READY BM110 04010C* TO GO OUT TO BOMSTR/BOMSEQ, THEN SETOF ERROR INDICATOR SO THAT, BM110 04020C* IF DELETE IS NOT ACTIVE, GOOD RECORD WILL UPDATE BOMSTR/BOMSEQ. BM110 04030C* BM110 04040C********************************************************************BM110 04050CL1 36 SETOF 33 BM110 0004060C********************************************************************BM110 04070C* BM110 04080C* RESET GOOD_ADD INDICATOR WHEN GET NEW COMPONENT AND/OR NEW BM110 04090C* PARENT. BM110 04100C* BM110 04110C********************************************************************BM110 04120CL1 SETOF 36 BM110 0004130C********************************************************************BM110 04140C* BM110 04150C* WHEN PUT RECORD OUT TO BOMSEQ, INCREMENT RECORD COUNT. BM110 04160C* BM110 04170C********************************************************************BM110 04180CL1N31N33 NRECS ADD 1 NRECS 50 BM110 04190C********************************************************************BM110 0004200C* BM110 04210C********************************************************************BM110 04220C* BM110 04230C* UPDATING OF BOMSTR/BOMSEQ BY GOOD STRCHNG ADDS AND CHANGES. BM110 04240C* BM110 04250C********************************************************************BM110 04260C* BM110 0004270CSR CHNGE BEGSR BM110 04280C********************************************************************BM110 04290C* BM110 04300C* TRANSACTION STRUCTURE QUANTITY NOT 0, THEN UPDATE STRUCTURE BM110 04310C* QUANTITY. BM110 04320C* BM110 04330C********************************************************************BM110 0004340CSRN42 MOVE TQTY QTY BM110 04350C********************************************************************BM110 04360C* BM110 04370C* TRANSACTION INVENTORY CODE NOT BLANK, THEN UPDATE INVENTORY BM110 04380C* CODE WITH ' ' IF ITS 'I' OR WITH 'N' IF ITS NOT BLANK OR 'I'. BM110 04390C* BM110 04400C********************************************************************BM110 0004410CSRN43 INVCD COMP 'I' 80 BM110 04420CSRN43 80 MOVE ' ' ICODE BM110 04430CSRN43N80 MOVE 'N' ICODE BM110 04440C********************************************************************BM110 04450C* BM110 04460C* IF DEALING WITH AN ADD, THEN 0 REL REC #'S. BM110 04470C* BM110 0004480C********************************************************************BM110 04490CSR 03 Z-ADD0 RRN1 BM110 04500CSR 03 Z-ADD0 RRN2 BM110 04510CSR 03 Z-ADD0 RRN3 BM110 04520C********************************************************************BM110 04530C* BM110 04540CSR ENDSR BM110 0004550C* BM110 04560C********************************************************************BM110 04570C* BM110 04580OBOMSEQ T L1N31N33 BM110 04590O REC 74 BM110 04600O PRNT 20 BM110 04610O CMPNT 74 BM110 0004620O QTY 31 BM110 04630O NRECS 36 BM110 04640O RRN1 41 BM110 04650O RRN2 46 BM110 04660O RRN3 51 BM110 04670O ICODE B 54 BM110 04680O 52 ' ' BM110 0004690O$LP1 H 202 1P BM110 04700O OR OF BM110 04710O PAGE Z 8 BM110 04720O 4 'PAGE' BM110 04730O HEAD,1 86 BM110 04740O UDATE Y 132 BM110 04750O H 2 1P BM110 0004760O OR OF BM110 04770O 73 'PRODUCT STRUCTURE FILE' BM110 04780O 81 'UPDATES' BM110 04790O 132 'MFG110' BM110 04800O H 2 1P BM110 04810O OR OF BM110 04820O 4 'RRN' BM110 0004830O 13 'PARENT' BM110 04840O 38 'COMPONENT' BM110 04850O 62 'QUANTITY' BM110 04860O 68 'I/N' BM110 04870O 77 'ACTION' BM110 04880O 94 'ERRORS/REMARKS' BM110 04890O D 1 10 BM110 0004900O RRN 3 5 BM110 04910O PRNT 27 BM110 04920O CMPNT 49 BM110 04930O TQTY K 63 BM110 04940O INVCD 67 BM110 04950O 03 76 'ADD' BM110 04960O 05 76 'CHG' BM110 0004970O 07 76 'DEL' BM110 04980O 09 76 'MDEL' BM110 04990O 03 42 104 'NO QUANTITY ' BM110 05000O 40 104 'NO PARENT PART # ' BM110 05010O N09N11 41 104 'NO COMPONENT PART # ' BM110 05020O 05 42 43 104 'NO QUANTITY OR I/N CODE ' BM110 05030O 07NMR 104 'PRNT-CMPNT NOT ON FILE ' BM110 0005040O 05NMR 104 'PRNT-CMPNT NOT ON FILE ' BM110 05050O 50 104 'DUPLICATE TRANSACTION ' BM110 05060O 11 104 'INVALID TRANSACTION ' BM110 05070O 03 MR 104 'ALREADY ON FILE ' BM110 05080O 25 104 'INVALID PART # ' BM110 05090O 09 41 26 104 'PARENT NOT ON FILE ' BM110 05100O 09N41 104 'INVALID MULT DEL ' BM110 0005110O T 31 LR BM110 05120O 23 'END OF JOB. THERE WERE' BM110 05130O NADDS 3 28 BM110 05140O 34 'ADDS,' BM110 05150O NCHGS 3 39 BM110 05160O 48 'CHANGES,' BM110 05170O NDLTS 3 53 BM110 0005180O 62 'DELETES,' BM110 05190O NMDLTS3 67 BM110 05200O 85 'MULT DELETES, AND ' BM110 05210O NERRS 3 90 BM110 05220O 98 'ERRORS.' BM110 05230O NRECS 3 105 BM110 05240O 124 'RECORDS NOW EXIST.' BM110 00** 005250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005290/* 005300_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(u $TXBM4ENT P0999999111111(000010H S BM4ENT00020X DECK-ID M28 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM4ENT00030F* ENTER COSTED BOM WITH PRODUCT LOST UPDATING REQUESTS BM4ENT00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM4ENT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM4ENT00060F* CONTROL DATA PROPRIETARY PRODUCT BM4ENT00070F* BM4ENT0000080FBM1DUM IPE F 72 DISK BM4ENT00090FKPROGS IC F 36R 8AI 1 DISK BM4ENT00100FBM4OUT UC F 128R DISK BM4ENT00110F********************************************************************BM4ENT00120F* INDICATOR FUNCTION LIST BM4ENT00130F* 01 DUMMY RECORD BM4ENT00140F* 02 KEYPYNCH PARAMETER FILE BM4ENT0000150F* 05 KEYPUNCH DATA FILE BM4ENT00160F* 18 BM4ENT00170F* 19 BM4ENT00180F* 20 BM4ENT00190F* 21 BM4ENT00200F* 25 RETRY ON RUBOUT BM4ENT00210F* 27 AUTO DUP BM4ENT0000220F* 28 BM4ENT00230F* 29 BM4ENT00240F* 40 MODE IS A-ADD BM4ENT00250F* 41 MODE IS C-CHANGE BM4ENT00260F* 42 MODE IS V-VERIFY BM4ENT00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS BM4ENT00280F* 44 MODE IS E-END OF JOB BM4ENT0000290F* 56 SEQ NBR NOT IN KPFILE BM4ENT00300F* 60 NEW PROGRAM NBR ONLY BM4ENT00310F* 61 AUTO DUP ONLY BM4ENT00320F* 70 BM4ENT00330F* 72 BM4ENT00340F* 73 MODE IS LESS THAN OR = 4 BM4ENT00350F* 81 MODE IS INVALID BM4ENT0000360F* 82 BAD PROG NBR BM4ENT00370F* 83 FIRST FIELD NAME BLANK BM4ENT00380F* 84 OUTPUT FIELD NAME BM4ENT00390F* 85 BM4ENT00400F* 88 SEQ NBR NOT IN KPFILE BM4ENT00410F* 90 AUTO DUP ON BM4ENT00420F* 95 BM4ENT0000430F* 98 RCD WITHIN OPERATOR LIMITS BM4ENT00440F* LR BM4ENT00450F********************************************************************BM4ENT00460E MSG 1 10 25 BM4ENT00470E SFN 80 20 BM4ENT00480E SAN 80 1 BM4ENT00490E SAD 80 1 BM4ENT0000500E SST 80 3 0 BM4ENT00510E SLN 80 2 0 BM4ENT00520E SNM 4 6 BM4ENT00530E SMX 4 2 0 BM4ENT00540E NP 4 1 0 BM4ENT00550E ARY1 1 2 50 BM4ENT00560IBM1DUM NS 01 BM4ENT0000570I 1 1 A BM4ENT00580IKPROGS NS 02 BM4ENT00590I 9 28 FN BM4ENT00600I 29 29 AN BM4ENT00610I 30 30 AD BM4ENT00620I 31 33 ST BM4ENT00630I 34 35 LN BM4ENT0000640I 36 36 DCODE BM4ENT00650IBM4OUT NS 05 BM4ENT00660I 1 128 RECORD BM4ENT00670C MOVE ' ' B72 72 BM4ENT00680C EXSR ALMTS BM4ENT00690C Z-ADDLOW SEQNO BM4ENT00700C NLR SETON LR BM4ENT0000710CLR START TAG BM4ENT00720CLR MOVEL'' WORD BM4ENT01590CLR Z-ADD1 OLN BM4ENT01600CLR Z-ADD1 ILN BM4ENT01610CLR EXSR TYPES BM4ENT0001620CLR MOVELBUFFER MODE BM4ENT01630CLR MODE COMP '4' 7373 BM4ENT01640CLR MODE COMP 'P' 60 NEW PROG#ONLY BM4ENT01650CLR MODE COMP 'D' 61 AUTO-DUP ONLY BM4ENT01660CLRN60N61N73 GOTO CHKMOD NEW 46DE BM4ENT01670CLR 73 MOVE MODE NPN 10 BM4ENT01680CLR EXSR GETPRG BM4ENT0001690CLR SETOF 606173 BM4ENT01700CLR GOTO SAMREC BM4ENT01710CLR CHKNUM TAG BM4ENT01720CLR MOVELBUFFER MODE BM4ENT01730CLR MODE COMP '@' 20 BM4ENT01740CLR 20N42 GOTO OUTREC BM4ENT01750CLR SAN,N COMP 'N' 19 BM4ENT0001760CLRN19 GOTO CHKVER BM4ENT01770CLR Z-ADDSLN,N VL 20 BM4ENT01780CLR MOVELBUFFER VAR 15 BM4ENT01790CLR EXIT SUBRAJ BM4ENT01800CLR RLABL VL BM4ENT01810CLR RLABL VAR BM4ENT01820CLR MOVELVAR BUFFER BM4ENT0001830CLR Z-ADDVL BLNGTH BM4ENT01840CLR EXSR EXCPT BM4ENT01850CLR SETOF 19 BM4ENT01860CLR CHKVER TAG BM4ENT01870CLRN42 GOTO MOVBUF BM4ENT01880CLR TBUF COMP BUFFER 2020 BM4ENT01890CLRN20 GOTO MOVBUF BM4ENT0001900CLR MOVEL'KP VERIF'WORD BM4ENT01910CLR MOVE 'Y ERROR 'WORD BM4ENT01920CLR MOVELWORD BUFFER BM4ENT01930CLR MOVE 'R' TYPE BM4ENT01940CLR Z-ADD6 MASK ONLY 'R' OR 'E'BM4ENT01950CLR EXSR CRTCOM BM4ENT01960CLR RCODE COMP 'R' 20 BM4ENT0001970CLR 20 GOTO OUTFLD BM4ENT01980CLR MOVBUF TAG BM4ENT01990CLR Z-ADDSST,N TSTRT 30 BM4ENT02000CLR Z-ADDSLN,N NCHARS 30 BM4ENT02010CLR Z-ADD1 SSTRT BM4ENT02020CLR EXIT SUBRMV BM4ENT02030CLR RLABL BUFFER BM4ENT0002040CLR RLABL SSTRT BM4ENT02050CLR RLABL RECORD BM4ENT02060CLR RLABL TSTRT BM4ENT02070CLR RLABL NCHARS BM4ENT02080CLR GOTO LOOP BM4ENT02090CLR RITDUP TAG BM4ENT02100CLR EXSR MVRECD BM4ENT0002110CLR SETON 19 BM4ENT02120CLR Z-ADDSLN,N BLNGTH BM4ENT02130CLRN27 EXSR EXCPT BM4ENT02140CLR SETOF 19 BM4ENT02150CLR GOTO MOVBUF BM4ENT02160CLR OUTREC TAG BM4ENT02170CLR SETON 187084 BM4ENT0002180CLR SETON 85 BM4ENT02190CLR EXCPT BM4ENT02200CLR EXSR EXCPT BM4ENT02210CLR SETOF 708485 BM4ENT02220CLR MOVELRECORD OLDREC128 BM4ENT02230CLR NP,PN COMP 0 72 BM4ENT02240CLRN72 GOTO NXTREC BM4ENT0002250CLR MOVE NP,PN NPN BM4ENT02260CLR EXSR GETPRG BM4ENT02270CLR SETOF 72 BM4ENT02280CLR GOTO NXTREC BM4ENT02290CLR EOJ TAG BM4ENT02300C********************************************************************BM4ENT02310C* BM4ENT0002320C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION BM4ENT02330C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. BM4ENT02340C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. BM4ENT02350C* BM4ENT02360C********************************************************************BM4ENT02370CSR GETPRG BEGSR BM4ENT02380CSR 61 GOTO JMPOUT BM4ENT0002390CSR 72 BM4ENT02400COR 73 GOTO CHKPN BM4ENT02410CSR GETPNO TAG BM4ENT02420CSR MOVEL'PROG # -'WORD BM4ENT02430CSR Z-ADD8 OLN BM4ENT02440CSR Z-ADD1 ILN BM4ENT02450CSR EXSR TYPES BM4ENT0002460CSR MOVELBUFFER NPN 10 BM4ENT02470CSR CHKPN TAG BM4ENT02480CSR NPN COMP 0 2020 BM4ENT02490CSRN20 NPN COMP 4 20 BAD PROG# BM4ENT02500CSR 20 SETON 82 BM4ENT02510CSR 82 EXSR EXCPT BM4ENT02520CSR SETOF 82 BM4ENT0002530CSR 20 GOTO GETPNO TRY PROG# AGAINBM4ENT02540CSR MOVE NPN PN 10 INBM4ENT02550CSR MOVE PN NAME10 10 BM4ENT02560CSRN43 SNM,PN COMP ' ' 6060 BM4ENT02570CSR 60 PN SUB 1 BP 20 BM4ENT02580CSR 60 BP MULT 20 BP BM4ENT02590CSR 72 GOTO SETHED BM4ENT0002600CSR 73 GOTO JMPOUT BM4ENT02610CSR 60 GOTO JMPOUT BM4ENT02620CSR GETPNM TAG BM4ENT02630CSR MOVEL'PROG NAM'WORD BM4ENT02640CSR MOVE 'E - 'WORD BM4ENT02650CSR Z-ADD11 OLN BM4ENT02660CSR Z-ADD6 ILN BM4ENT0002670CSR EXSR TYPES BM4ENT02680CSR MOVELBUFFER PNAME 8 BM4ENT02690CSR MOVE ' ' PNAME BM4ENT02700CSR CHNPRG TAG BM4ENT02710CSR PNAME CHAINKPROGS 27 BM4ENT02720CSRN27 MOVELPNAME SNM,PN BM4ENT02730CSRN27 GOTO LOADIT BM4ENT0002740CSR MOVEL' 'WORD BM4ENT02750CSR MOVELPNAME WORD BM4ENT02760CSR MOVE 'ABSENT 'WORD BM4ENT02770CSR MOVE 'R' TYPE 1 BM4ENT02780CSR MOVELWORD BUFFER BM4ENT02790CSR Z-ADD7 MASK 10 BM4ENT02800CSR Z-ADD16 BLNGTH BM4ENT0002810CSR EXSR CRTCOM BM4ENT02820CSR RCODE COMP 'E' 20 BM4ENT02830CSR PRGMT TAG BM4ENT02840C*R 20 EXSR PROGMT BM4ENT02850C*R 20 GOTO CHNPRG BM4ENT02860CSR GOTO GETPNM BM4ENT02870CSR LOADIT TAG BM4ENT0002880CSR Z-ADD14 OLN BM4ENT02890CSR Z-ADD1 ILN BM4ENT02900CSR MOVEL'NEXT PRO'WORD BM4ENT02910CSR MOVE 'G # - 'WORD BM4ENT02920CSR EXSR TYPES BM4ENT02930CSR MOVELBUFFER NP,PN BM4ENT02940CSR PN SUB 1 BP BM4ENT0002950CSR BP MULT 20 BP BM4ENT02960CSR BP ADD 1 N 20 BM4ENT02970CSR Z-ADD1 X 20 BM4ENT02980CSR BLDARY TAG BM4ENT02990CSR FN COMP B72 20 BM4ENT03000CSR 20 N SUB 1 MAXFLD 20 BM4ENT03010CSR 20 MOVE MAXFLD SMX,PN BM4ENT0003020CSR 20 GOTO JMPOUT BM4ENT03030CSR MOVE FN SFN,N FIELD NAME BM4ENT03040CSR MOVE AN SAN,N ALPHA OR NUMER BM4ENT03050CSR MOVE AD SAD,N AUTO DUP BM4ENT03060CSR MOVE ST SST,N START POSITION BM4ENT03070CSR MOVE LN SLN,N BM4ENT03080CSR MVX TAG BM4ENT0003090CSR MOVE X PNAME BM4ENT03100CSR PNAME CHAINKPROGS 20 BM4ENT03110CSR X ADD 1 X BM4ENT03120CSRN20 X COMP 20 20 BM4ENT03130CSR 20 Z-ADDN MAXFLD BM4ENT03140CSR 20 MOVE MAXFLD SMX,PN BM4ENT03150CSR DCODE COMP 'D' 21 BM4ENT0003160CSR 21N20 GOTO MVX BM4ENT03170CSRN20 N ADD 1 N BM4ENT03180CSRN20 GOTO BLDARY BM4ENT03190CSR JMPOUT TAG BM4ENT03200CSR 43 GOTO ENDGET BM4ENT03210CSR 41 GOTO SETHED BM4ENT03220CSR MOVEL'AUTO-DUP'WORD BM4ENT0003230CSR MOVE ' - 'WORD BM4ENT03240CSR Z-ADD11 OLN BM4ENT03250CSR Z-ADD1 ILN BM4ENT03260CSR EXSR TYPES BM4ENT03270CSR MOVELBUFFER AUTO 1 BM4ENT03280CSR AUTO COMP 'O' 90AUTO-DUP ON BM4ENT03290CSR SETHED TAG BM4ENT0003300CSR MOVELSNM,PN NAME10 BM4ENT03310CSR MOVELNAME10 WORD BM4ENT03320CSR MOVE SMX,PN MAXFLD 20 BM4ENT03330CSR 90 MOVE ' ON' WORD BM4ENT03340CSRN90 MOVE 'OFF' WORD BM4ENT03350CSR MOVELWORD HEAD 40 BM4ENT03360CSR ENDGET ENDSR BM4ENT0003370C********************************************************************BM4ENT03380C* BM4ENT03390C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST BM4ENT03400C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE BM4ENT03410C* CHANGED BM4ENT03420C* BM4ENT03430C********************************************************************BM4ENT0003440CSR GETSEQ BEGSR BM4ENT03450CSR MOVEL'SEQ # - 'WORD BM4ENT03460CSR Z-ADD8 OLN BM4ENT03470CSR Z-ADD5 ILN BM4ENT03480CSR EXSR TYPES BM4ENT03490CSR Z-ADD5 VL BM4ENT03500CSR MOVELBUFFER VAR BM4ENT0003510CSR EXIT SUBRAJ BM4ENT03520CSR RLABL VL BM4ENT03530CSR RLABL VAR BM4ENT03540CSR MOVELVAR SEQNO BM4ENT03550CSR SEQNO COMP 0 20 BM4ENT03560CSRN20 Z-ADD1 SEQNO BM4ENT03570CSR SETON 95 BM4ENT0003580CSR ENDSEQ ENDSR BM4ENT03590C********************************************************************BM4ENT03600C* BM4ENT03610C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO BM4ENT03620C* BM4ENT03630C********************************************************************BM4ENT03640CSR GETREC BEGSR BM4ENT0003650CSR SEQRD TAG BM4ENT03660CSR EXSR TSTSEQ BM4ENT03670CSR 94 EXSR GETSEQ BM4ENT03680CSR 94 GOTO SEQRD BM4ENT03690CSR SEQNO CHAINBM4OUT 56 BM4ENT03700CSR MOVELRECORD TST 2 BM4ENT03710CSR TST COMP '<>' 99 BM4ENT0003720CSR 40N99 SEQNO ADD 1 SEQNO BM4ENT03730CSR 40N99 GOTO SEQRD BM4ENT03740CSR 41 99 EXSR NOCHG BM4ENT03750CSR 41 99 GOTO SEQRD BM4ENT03760CSR 56 SETON 88 BM4ENT03770CSR 88 EXSR EXCPT BM4ENT03780CSR SETOF 88 BM4ENT0003790CSR 56 EXSR GETSEQ BM4ENT03800CSR 56 GOTO SEQRD BM4ENT03810CSR ENDSR BM4ENT03820C********************************************************************BM4ENT03830C* BM4ENT03840C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY BM4ENT03850C* IS DONE IF A RUBOUT IS USED BM4ENT0003860C* BM4ENT03870C********************************************************************BM4ENT03880CSR TYPES BEGSR BM4ENT03890CSR OVER TAG BM4ENT03900CSR Z-ADDOLN BLNGTH BM4ENT03910CSR MOVELWORD BUFFER BM4ENT03920CSR MOVE 'S' TYPE BM4ENT0003930CSR EXSR CRTCOM BM4ENT03940CSR MOVE 'A' TYPE BM4ENT03950CSR Z-ADDILN BLNGTH BM4ENT03960CSR EXSR CRTCOM BM4ENT03970CSR RCODE COMP 'R' 25 BM4ENT03980CSR 25 EXSR SKIP BM4ENT03990CSR 25 GOTO OVER BM4ENT0004000CSR RCODE COMP 'O' 25 BM4ENT04010CSR 25 EXSR SKIP BM4ENT04020CSR ENDSR BM4ENT04030C********************************************************************BM4ENT04040C* BM4ENT04050C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT BM4ENT04060C* BM4ENT0004070C********************************************************************BM4ENT04080CSR SKIP BEGSR BM4ENT04090CSR MOVELBUFFER NBUF 1 BM4ENT04100CSR MOVEL' ' BUFFER BM4ENT04110CSR Z-ADD1 BLNGTH BM4ENT04120CSR MOVE 'T' TYPE BM4ENT04130CSR EXSR CRTCOM BM4ENT0004140CSR MOVELNBUF BUFFER BM4ENT04150CSR ENDSR BM4ENT04160C********************************************************************BM4ENT04170C* BM4ENT04180C* BM4ENT04190C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED BM4ENT04200C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER BM4ENT0004210C* BM4ENT04220CSR MVRECD BEGSR BM4ENT04230CSR MOVELB72 BUFFER BM4ENT04240CSR Z-ADD1 TSTRT BM4ENT04250CSR Z-ADDSST,N SSTRT BM4ENT04260CSR Z-ADDSLN,N NCHARS BM4ENT04270CSR EXIT SUBRMV BM4ENT0004280CSR RLABL OLDREC BM4ENT04290CSR RLABL SSTRT 30 BM4ENT04300CSR RLABL BUFFER BM4ENT04310CSR RLABL TSTRT 30 BM4ENT04320CSR RLABL NCHARS 30 BM4ENT04330CSR ENDSR BM4ENT04340C********************************************************************BM4ENT0004350CSR EXCPT BEGSR BM4ENT04360CSRN81N82N83 BM4ENT04370CANN84N88 GOTO PUTOUT BM4ENT04380CSR MOVELB72 BUFFER BM4ENT04390CSR 81 MOVELMSG,1 BUFFER BM4ENT04400CSR 83 MOVELMSG,2 BUFFER BM4ENT04410CSR 88 MOVELMSG,3 BUFFER BM4ENT0004420CSR 82 MOVELMSG,4 BUFFER BM4ENT04430CSRN84 GOTO PUTOUT BM4ENT04440CSRN85 MOVELSFN,N BUFFER BM4ENT04450CSRN18 Z-ADD20 BLNGTH BM4ENT04460CSRN18 GOTO PUTOUT BM4ENT04470CSR MOVELHEAD BUFFER BM4ENT04480CSR MOVE 'T' TYPE BM4ENT0004490CSR Z-ADD69 BLNGTH BM4ENT04500CSR EXSR CRTCOM BM4ENT04510CSR MOVELSFN,N BUFFER BM4ENT04520CSR Z-ADD20 BLNGTH BM4ENT04530CSR PUTOUT TAG BM4ENT04540CSR MOVE 'S' TYPE BM4ENT04550CSR EXSR CRTCOM BM4ENT0004560CSR ENDSR BM4ENT04570C* BM4ENT04580CSR ALMTS BEGSR BM4ENT04590CSR MOVE 'C' TYPE 1 BM4ENT04600CSR Z-ADD0 BLNGTH 20 BM4ENT04610CSR MOVE ' ' RCODE 1 BM4ENT04620CSR Z-ADD0 MASK 10 BM4ENT0004630CSR Z-ADD0 DTYPE 10 BM4ENT04640CSR EXSR CRTCOM BM4ENT04650CSR MOVELARY1,1 BUFFER BM4ENT04660CSR MOVE 'S' TYPE BM4ENT04670CSR Z-ADD50 BLNGTH BM4ENT04680CSR EXSR CRTCOM BM4ENT04690CSR MOVE 'A' TYPE BM4ENT0004700CSR Z-ADD5 BLNGTH BM4ENT04710CSR Z-ADD1 DTYPE BM4ENT04720CSR EXSR CRTCOM BM4ENT04730CSR EXSR SKIP BM4ENT04740CSR RCODE COMP 'R' 86 BM4ENT04750CSR Z-ADD5 VL BM4ENT04760CSR MOVELBUFFER VAR BM4ENT0004770CSR EXIT SUBRAJ BM4ENT04780CSR RLABL VL BM4ENT04790CSR RLABL VAR BM4ENT04800CSR MOVELVAR BUFFER BM4ENT04810CSR MOVELBUFFER LOW 50 BM4ENT04820CSR MOVELARY1,2 BUFFER BM4ENT04830CSR MOVE 'S' TYPE BM4ENT0004840CSR Z-ADD50 BLNGTH BM4ENT04850CSR EXSR CRTCOM BM4ENT04860CSR MOVE 'A' TYPE BM4ENT04870CSR Z-ADD5 BLNGTH BM4ENT04880CSR Z-ADD1 DTYPE BM4ENT04890CSR EXSR CRTCOM BM4ENT04900CSR RCODE COMP 'R' 87 BM4ENT0004910CSR Z-ADD5 VL BM4ENT04920CSR MOVELBUFFER VAR BM4ENT04930CSR EXIT SUBRAJ BM4ENT04940CSR RLABL VL BM4ENT04950CSR RLABL VAR BM4ENT04960CSR MOVELVAR BUFFER BM4ENT04970CSR MOVELBUFFER HIGH 50 BM4ENT0004980CSR MOVE 'C' TYPE BM4ENT04990CSR EXSR CRTCOM BM4ENT05000CSR 86 BM4ENT05010COR 87 GOTO ALMTS BM4ENT05020CSR Z-ADD0 DTYPE BM4ENT05030CSR ENDSR BM4ENT05040CSR CRTCOM BEGSR BM4ENT0005050CSR EXITFSUBRCM BM4ENT05060CSR RLABL BUFFER BM4ENT05070CSR RLABL TYPE BM4ENT05080CSR RLABL BLNGTH BM4ENT05090CSR RLABL RCODE BM4ENT05100CSR RLABL MASK BM4ENT05110CSR RLABL DTYPE BM4ENT0005120CSR ENDSR BM4ENT05130CSR PUTSEQ BEGSR BM4ENT05140CSR MOVELMSG,5 BUFFER 72 BM4ENT05150CSR MOVE 'S' TYPE BM4ENT05160CSR Z-ADD25 BLNGTH BM4ENT05170CSR EXSR CRTCOM BM4ENT05180CSR MOVELSEQNO BUFFER BM4ENT0005190CSR MOVE 'T' TYPE BM4ENT05200CSR Z-ADD5 BLNGTH BM4ENT05210CSR EXSR CRTCOM BM4ENT05220CSR ENDSR BM4ENT05230CSR TSTSEQ BEGSR BM4ENT05240CSR SETOF 949697 BM4ENT05250CSR SEQNO COMP LOW 989698 BM4ENT0005260CSR 98 SEQNO COMP HIGH 979898 BM4ENT05270CSR 98 GOTO ENDTST BM4ENT05280CSR 40 96 MOVELMSG,6 BUFFER BM4ENT05290CSR 40 97 MOVELMSG,7 BUFFER BM4ENT05300CSRN40 MOVELMSG,8 BUFFER BM4ENT05310CSRN40 SETON 94 BM4ENT05320CSR MOVE 'T' TYPE BM4ENT0005330CSR Z-ADD25 BLNGTH BM4ENT05340CSR EXSR CRTCOM BM4ENT05350CSR 40 97 MOVE 'F' TYPE BM4ENT05360CSR 40 97 EXSR CRTCOM BM4ENT05370CSR ENDTST ENDSR BM4ENT05380CSR NOCHG BEGSR BM4ENT05390CSR MOVELMSG,9 BUFFER BM4ENT0005400CSR MOVE 'T' TYPE BM4ENT05410CSR Z-ADD25 BLNGTH BM4ENT05420CSR EXSR CRTCOM BM4ENT05430CSR EXSR GETSEQ BM4ENT05440CSR ENDSR BM4ENT05450C********************************************************************BM4ENT05460OBM4OUT E 70N56 BM4ENT0005470O RECORD 128 BM4ENT05480O 42 128 'X' BM4ENT05490O SEQNO 127 BM4ENT** 005500ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005510ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005520ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00553000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005540** 005550MODE MUST BE A,C,V,OR E 005560FIRST FIELD NAME BLANK 005570INVALID SEQ # 005580PROG# MUST BE FROM 1-4 005590CURRENT SEQUENCE NBR 00560000SEQNO TOO LOW 005610RUN EDIT PROG-FILE FULL 005620SEQNO NOT IN YOUR LIMITS 005630ILLEGAL CHANGE-NO DATA 005640** 005650ENTER BEGINNING RELATIVE RECORD NUMBER 005660ENTER ENDING RELATIVE RECORD NUMBER 00567000/* 005680_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(Mg hXOTXOE120 P999999050978(000010H S OE120 00020X DECK-ID A60 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE120 00030F* PRINT ORDER ENTRY AUDIT OE120 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE120 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE120 00060F* CONTROL DATA PROPRIETARY PRODUCT OE120 00070F* OE120 0000080FSOTEMP IPEAF 9 7AI 1 DISK OE120 00090F$LP1 O F 132 OF PRINTER OE120 00100FHEADING IT F 40 EDISK OE120 00110F* OE120 00120F********************************************************************OE120 00130F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [ORD030] OE120 00140F* OE120 0000150F* PACKAGE DISTRIBUTION OE120 00160F* SYSTEM SALES ORDER PROCESSING OE120 00170F* PROGRAM PRINT ORDER ENTRY AUDIT OE120 00180F* OE120 00190F* CONTRACTOR COMPUSOURCE OE120 00200F* PROGRAMMER KATH HILL OE120 00210F* DATE FEBRUARY 22, 1976 OE120 0000220F* OE120 00230F********************************************************************OE120 00240F* OE120 00250E HEADING HEAD 1 1 40 OE120 00260ISOTEMP XX 01 OE120 00270I 1 50SO OE120 00280I 8 8 CODE 11 OE120 0000290I 9 9 TYPE OE120 00300C N01 GOTO END OE120 00310C 99 GOTO START OE120 00320C Z-ADDSO SAVE 50 1ST CYCLE ONLY OE120 00330C SETON 9899 OE120 00340C GOTO SKIP OE120 00350C* OE120 0000360C START TAG OE120 00370C SETOF 98 OE120 00380C SAVE ADD 1 SAVE OE120 00390C SAVE COMP SO 2020 OE120 00400C 20 Z-ADDSAVE FROM 50 OE120 00410C 20 SO SUB 1 TO 50 OE120 00420C 20 SO SUB FROM DIFF 50 OE120 0000430C 20 MISS ADD DIFF MISS 60 OE120 00440C Z-ADDSO SAVE OE120 00450C* OE120 00460C SKIP TAG OE120 00470C TYPE COMP ' ' 31 OE120 00480C TYPE COMP 'C' 32 OE120 00490C TYPE COMP 'E' 33 OE120 0000500C TYPE COMP 'M' 34 OE120 00510C SOS ADD 1 SOS 60 OE120 00520C N11 ERRORS ADD 1 ERRORS 60 OE120 00530C END TAG OE120 00540O$LP1 H 02 1P OE120 00550O OR OF OE120 00560O 4 'PAGE' OE120 0000570O PAGE Z 8 OE120 00580O HEAD,1 60 OE120 00590O UDATE Y 85 OE120 00600O H 2 1P OE120 00610O OR OF OE120 00620O 51 'ORDER ENTRY SUMMARY' OE120 00630O 85 'DIS120' OE120 0000640O H 2 1P OE120 00650O OR OF OE120 00660O 5 'SALES' OE120 00670O H 11 1P OE120 00680O OR OF OE120 00690O 7 'ORDER #' OE120 00700O 14 'TYPE' OE120 0000710O 25 'COMMENTS' OE120 00720O D 1 01 20 OE120 00730O 31 'SALES ORDERS #' OE120 00740O FROM 37 OE120 00750O 39 '-' OE120 00760O TO 45 OE120 00770O 53 'MISSING' OE120 0000780O D 1 01 OE120 00790O SO 7 OE120 00800O 31 13 'SO' OE120 00810O 32 13 'CM' OE120 00820O 33 13 'DB' OE120 00830O 34 13 'MI' OE120 00840O N11 28 'BATCH ERROR' OE120 0000850O 98 56 'THIS SHOULD BE TODAY''S' OE120 00860O 98 72 'STARTING S.O. #' OE120 00870O T 3 LR OE120 00880O 11 'END OF JOB.' OE120 00890O 23 'THERE WERE' OE120 00900O SOS 1 31 OE120 00910O 44 'VALID ORDERS' OE120 0000920O 53 'OF WHICH' OE120 00930O ERRORS1 61 OE120 00940O 79 'HAD BATCH ERRORS.' OE120 00950O T 1 LR OE120 00960O 23 'THERE WERE' OE120 00970O MISS 1 31 OE120 00980O 47 'MISSING ORDERS.' OE120 00** 000990ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001010ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001020ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001030/* 001040__0O 47 'MISSING ORDERS.' OE120 0(w `TXIN665 P999999032778(000010H S IN665 00020X DECK-ID M64 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN665 00030F* UPDATE AVE, MTD, YTD USAGE AND PRODUCE COSTED INVENTORY REPORT IN665 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN665 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN665 00060F* CONTROL DATA PROPRIETARY PRODUCT IN665 00070F* IN665 0000080FPARTMST UPEAF 300 20AI 271 DISK IN665 00090F$LP1 O F 132 OF PRINTER U3 IN665 00100FHEADING IT F 40 EDISK IN665 00110F********************************************************************IN665 00120F* IN665 00130F* U4: M/E UPDATE UPDATES AVG & YTD IN665 00140F* ZERO OUT MTD IN665 0000150F* U2: ZERO OUT AVG IN665 00160F* IN665 00170F* U1: ZERO OUT YTD IN665 00180F* IN665 00190F* U3: PRINT OUT COSTED INVENTORY REPORT IN665 00200F* IN665 00210F********************************************************************IN665 0000220F* ID F C H L FUNCTION OF INDICATORS IN665 00230F* IN665 00240F* 01 PARTMST IN665 00250F* 02 PARTMST - DELETED RECORD IN665 00260F* IN665 00270F********************************************************************IN665 00280E HEADING HEAD 1 1 40 COMPANY NAME IN665 0000290IPARTMST NS 01 74 C IN665 00300I 271 290 PARTNO IN665 00310I 1 37 DESCR IN665 00320I 38 39 UM IN665 00330I 40 40 CLASS IN665 00340I 75 813STDMAT IN665 00350I 110 1163CUMLAB IN665 0000360I 117 1233CUMBUR IN665 00370I 124 1303CUMOP IN665 00380I 146 1520SOH IN665 00390I 196 2020MTD IN665 00400I 203 2090AVG IN665 00410I 210 2112ALPHA IN665 00420I 212 2180YTD IN665 0000422I 160 1660DIRMTD 00424I 174 1800DIRYTD 00426I 261 2650DIRAVG 00430I NS 02 IN665 00440I 1 1 AIR IN665 00450C N01 GOTO FINI IN665 00460C* IN665 0000470C TRYU4 TAG M/E UPDATE IN665 00480C NU4 GOTO TRYU2 IN665 00490C MTD SUB AVG SAVE1 70 IN665 00500C SAVE1 MULT ALPHA SAVE2 70H IN665 00510C AVG ADD SAVE2 AVG IN665 00520C YTD ADD MTD YTD IN665 00521C Z-ADD0 SAVE1 0000522C DIRMTD SUB DIRAVG SAVE1 00523C SAVE1 MULT ALPHA SAVE2 H 00524C DIRAVG ADD SAVE2 DIRAVG 00525C DIRYTD ADD DIRMTD DIRYTD 00530C Z-ADD0 MTD IN665 00535C Z-ADD0 DIRMTD 00540C* IN665 0000550C TRYU2 TAG ZERO OUT AVG IN665 00560C NU2 GOTO TRYU1 IN665 00570C Z-ADD0 AVG IN665 00575C Z-ADD0 DIRAVG 00580C* IN665 00590C TRYU1 TAG ZERO OUT YTD IN665 00600C NU1 GOTO TRYU3 IN665 0000610C Z-ADD0 YTD IN665 00615C Z-ADD0 DIRYTD 00620C* IN665 00630C TRYU3 TAG IN665 00640C NU3 GOTO FINI IN665 00650C STDMAT ADD CUMLAB UNCOST 73 IN665 00660C UNCOST ADD CUMBUR UNCOST IN665 0000670C UNCOST ADD CUMOP UNCOST IN665 00680C SOH MULT UNCOST EXTCST 92H IN665 00690C TOTAL ADD EXTCST TOTAL 102 IN665 00700C* IN665 00710C FINI TAG IN665 00720OPARTMST D 01 U1 IN665 00730O OR 01 U2 IN665 0000740O OR 01 U4 IN665 00750O U1 YTD 218 IN665 00760O U4 YTD 218 IN665 00770O U2 AVG 209 IN665 00780O U4 AVG 209 IN665 00790O U4 MTD 202 IN665 00791O U1 DIRYTD 180 0000792O U4 DIRYTD 180 00793O U2 DIRAVG 265 00794O U4 DIRAVG 265 00795O U4 DIRMTD 166 00800O$LP1 H 202 1P U3 IN665 00810O OR OF U3 IN665 00820O PAGE Z 8 IN665 0000830O 4 'PAGE' IN665 00840O HEAD,1 86 IN665 00850O UDATE Y 132 IN665 00860O H 2 1P U3 IN665 00870O OR OF U3 IN665 00880O 77 'COSTED INVENTORY REPORT' IN665 00890O 132 'MFG665' IN665 0000891O H 1 1P U3 00892O OR OF U3 00893O 11 'PART NUMBER' 00900O H 2 1P U3 IN665 00910O OR OF U3 IN665 00930O 13 'DESCRIPTION' IN665 00940O 51 'CLS UM ALPH' IN665 0000950O 61 'AVG USE' IN665 00960O 72 'MTD USE' IN665 00970O 83 'YTD USE' IN665 00980O 94 'SOH' IN665 00990O 105 'UNIT COST' IN665 01000O 120 'EXTENDED COST' IN665 01001O D 1 01 U3 0001002O PARTNO 20 01003O DIRMTDJ 73 01004O DIRYTDJ 84 01005O DIRAVGJ 62 01006O 74 'D' 01007O 85 'D' 01008O 63 'D' 0001010O D 2 01 U3 IN665 01030O DESCR 39 IN665 01040O CLASS 42 IN665 01050O UM 46 IN665 01060O ALPHA L 51 IN665 01070O AVG J 62 IN665 01080O MTD J 73 IN665 0001090O YTD J 84 IN665 01100O SOH J 95 IN665 01110O UNCOSTJ 106 IN665 01112O 74 'M' 01114O 85 'M' 01116O 63 'M' 01120O EXTCSTJ 121 IN665 0001130O T 1 LR U3 IN665 01140O 120 '-------------' IN665 01150O T 2 LR U3 IN665 01160O 11 'END OF JOB.' IN665 01170O 106 'TOTAL' IN665 01180O TOTAL J 121 IN665 ** 00119000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001200ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001210ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001220ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001230/* 001240_ 00 00 00 00 00 00 00 00 00 00 00 __ 0(2y TXBMIN1 P999999111111(000010H S BMIN1 00020X DECK-ID M29 MFG/DIST/ACCT SYSTEM SUMMARY-123 BMIN1 00030F* INITIALIZE BM1OUT WITH < > IN POSTIIONS 1 AND 2 BMIN1 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BMIN1 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BMIN1 00060F* CONTROL DATA PROPRIETARY PRODUCT BMIN1 00070F* BMIN1 0000080FBM1DUM IP F 72 DISK BMIN1 00090FBM1OUT UC F 128R DISK BMIN1 00100IBM1DUM NS 02 BMIN1 00110I 1 1 A BMIN1 00120IBM1OUT NS 01 BMIN1 00130I 1 128 REC BMIN1 00140C SETON LR99 BMIN1 0000150CLR LOOP TAG BMIN1 00160CLR RRN ADD 1 RRN 50 BMIN1 00170CLR RRN CHAINBM1OUT 70 BMIN1 00180CLRN70 EXCPT BMIN1 00190CLRN70 GOTO LOOP BMIN1 00200OBM1OUT E 99N70 BMIN1 00210O OR LRN70 BMIN1 0000220O REC 128 BMIN1 00230O 2 '<>' BMIN1 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' BMIN1 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(2y/ TXBMIN2 P999999111111(000010H S BMIN2 00020X DECK-ID M30 MFG/DIST/ACCT SYSTEM SUMMARY-123 BMIN2 00030F* INITIALIZE BM2OUT WITH < > IN POSTIIONS 1 AND 2 BMIN2 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BMIN2 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BMIN2 00060F* CONTROL DATA PROPRIETARY PRODUCT BMIN2 00070F* BMIN2 0000080FBM1DUM IP F 72 DISK BMIN2 00090FBM2OUT UC F 128R DISK BMIN2 00100IBM1DUM NS 02 BMIN2 00110I 1 1 A BMIN2 00120IBM2OUT NS 01 BMIN2 00130I 1 128 REC BMIN2 00140C SETON LR99 BMIN2 0000150CLR LOOP TAG BMIN2 00160CLR RRN ADD 1 RRN 50 BMIN2 00170CLR RRN CHAINBM2OUT 70 BMIN2 00180CLRN70 EXCPT BMIN2 00190CLRN70 GOTO LOOP BMIN2 00200OBM2OUT E 99N70 BMIN2 00210O OR LRN70 BMIN2 0000220O REC 128 BMIN2 00230O 2 '<>' BMIN2 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' BMIN2 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(2yE TXBMIN3 P999999111111(000010H S BMIN3 00020X DECK-ID M31 MFG/DIST/ACCT SYSTEM SUMMARY-123 BMIN3 00030F* INITIALIZE BM3OUT WITH < > IN POSTIIONS 1 AND 2 BMIN3 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BMIN3 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BMIN3 00060F* CONTROL DATA PROPRIETARY PRODUCT BMIN3 00070F* BMIN3 0000080FBM1DUM IP F 72 DISK BMIN3 00090FBM3OUT UC F 128R DISK BMIN3 00100IBM1DUM NS 02 BMIN3 00110I 1 1 A BMIN3 00120IBM3OUT NS 01 BMIN3 00130I 1 128 REC BMIN3 00140C SETON LR99 BMIN3 0000150CLR LOOP TAG BMIN3 00160CLR RRN ADD 1 RRN 50 BMIN3 00170CLR RRN CHAINBM3OUT 70 BMIN3 00180CLRN70 EXCPT BMIN3 00190CLRN70 GOTO LOOP BMIN3 00200OBM3OUT E 99N70 BMIN3 00210O OR LRN70 BMIN3 0000220O REC 128 BMIN3 00230O 2 '<>' BMIN3 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' BMIN3 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(2y[ TXBMIN4 P999999111111(000010H S BMIN4 00020X DECK-ID M32 MFG/DIST/ACCT SYSTEM SUMMARY-123 BMIN4 00030F* INITIALIZE BM4OUT WITH < > IN POSTIIONS 1 AND 2 BMIN4 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BMIN4 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BMIN4 00060F* CONTROL DATA PROPRIETARY PRODUCT BMIN4 00070F* BMIN4 0000080FBM1DUM IP F 72 DISK BMIN4 00090FBM4OUT UC F 128R DISK BMIN4 00100IBM1DUM NS 02 BMIN4 00110I 1 1 A BMIN4 00120IBM4OUT NS 01 BMIN4 00130I 1 128 REC BMIN4 00140C SETON LR99 BMIN4 0000150CLR LOOP TAG BMIN4 00160CLR RRN ADD 1 RRN 50 BMIN4 00170CLR RRN CHAINBM4OUT 70 BMIN4 00180CLRN70 EXCPT BMIN4 00190CLRN70 GOTO LOOP BMIN4 00200OBM4OUT E 99N70 BMIN4 00210O OR LRN70 BMIN4 0000220O REC 128 BMIN4 00230O 2 '<>' BMIN4 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' BMIN4 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(Xyq CTXWP010 P999999033078(000010H S WP010 00020X DECK-ID P01 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP010 00030F* MAINTIAN OPEN WORKORDER FILE WP010 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP010 00060F* CONTROL DATA PROPRIETARY PRODUCT WP010 00070F* WP010 0000080FNULL IPEAF 72 DISK WP010 00090FJPR010 IC F 32R DISK WP010 00100FWRKORD UC F 0160R05AI 0001 DISK A WP010 00110E FN 020 22 FIELD NAME WP010 00120E CP 020 4 CURSOR POSITION WP010 00130E LN 020 2 0 LENGTH WP010 00140E EP 020 4 0 ENDING POSITION WP010 0000150INULL NS 01 WP010 00160I 1 1 A WP010 00170IJPR010 NS 02 WP010 00180I 1 22 FIELDN WP010 00190I 23 26 CURPOS WP010 00200I 27 280LNGTH WP010 00210I 29 310ENDPOS WP010 0000220IWRKORD NS 03 WP010 00230I 10160 RECORD WP010 00240C MOVE ' ' RCODE 1 WP010 00250C MOVE RCODE B22 22 WP010 00260C MOVE RCODE BLANKS 72 WP010 00270C MOVE RCODE FILLER 1 WP010 00280C Z-ADD0 MASK 10 WP010 0000290C SETON LR WP010 00300CLR Z-ADD020 SSIZE 30 WP010 00310CLR Z-ADD003 NSECT 30 WP010 00320CLR BITON'01234567'FF 1 WP010 00330CLR MOVE '[]<>' TEMP4 4 WP010 00340CLR START TAG WP010 00350C* ********** WP010 0000360CLR EXSR FIRSTP WP010 00370C* ********** WP010 00380CLR EXSR CLRSCR WP010 00390C* ********** WP010 00400CLR 40 GOTO EOJ WP010 00410C* ********** WP010 00420CLR Z-ADD2 VL WP010 0000430CLR MOVELSECTON VAR WP010 00440CLR EXSR RTADJ WP010 00450C* ********** WP010 00460CLR MOVELVAR SECTN 20 WP010 00470CLR EXSR GETSEC WP010 00480C* ********** WP010 00490CLRN45 GOTO START WP010 0000500C* ********** WP010 00510CLR EXSR CLRSCR WP010 00520C* ********** WP010 00530CLR EXSR OUTPUT WP010 00540C* ********** WP010 00550CLR EXSR UPDATE WP010 00560C* ********** WP010 0000570CLR GOTO START WP010 00580C* ********** WP010 00590CLR EOJ TAG WP010 00600C* ********** WP010 00610C********************************************************************WP010 00620C* WP010 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND WP010 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. WP010 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDWP010 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN WP010 00670C* WP010 00680C********************************************************************WP010 00690CSR FIRSTP BEGSR WP010 00700C* ********** WP010 0000710CSR EXSR CLRSCR WP010 00720C* ********** WP010 00730CSR Z-ADD0 SECTN WP010 00740CSR EXSR GETSEC WP010 00750C* ********** WP010 00760CSR PGE TAG WP010 00770C* ********** WP010 0000780CSR SETON 61 WP010 00790CSR SETOF 62 WP010 00800CSR EXSR OUTPUT WP010 00810C* ********** WP010 00820C* ********** WP010 00830CSR EXIT SUBRFL WP010 00840CSR RLABL RECORD WP010 0000850CSR RLABL FILLER 1 WP010 00860C* ********** WP010 00870C* ********** WP010 00880C* ********** WP010 00890C* ********** WP010 00900C* ********** WP010 00910C* ********** WP010 0000920C* ********** WP010 00930C* ********** WP010 00940C* ********** WP010 00950C* ********** WP010 00960C* ********** WP010 00970C* ********** WP010 00980C* ********** WP010 0000990C* ********** WP010 01000C* ********** WP010 01010CSR Z-ADD05 NCHARS WP010 01020CSR Z-ADD1 SSTRT WP010 01030CSR Z-ADD1 TSTRT WP010 01040C* ********** WP010 01050CSR EXIT SUBRLM WP010 0001060CSR RLABL KEY 05 WP010 01070CSR RLABL SSTRT 30 WP010 01080CSR RLABL RECORD WP010 01090CSR RLABL TSTRT 30 WP010 01100CSR RLABL NCHARS 30 WP010 01110CSR Z-ADDNOFLDS SVFLDS 30 WP010 01120CSR Z-ADDSX NOFLDS WP010 0001130CSR EXSR UPDATE WP010 01140C* ********** WP010 01150CSR Z-ADDSVFLDS NOFLDS WP010 01160CSR Z-ADD05 NCHARS WP010 01170CSR Z-ADD1 SSTRT WP010 01180CSR Z-ADD1 TSTRT WP010 01190C* ********** WP010 0001200CSR EXIT SUBRLM WP010 01210CSR RLABL RECORD WP010 01220CSR RLABL SSTRT 30 WP010 01230CSR RLABL KEY WP010 01240CSR RLABL TSTRT 30 WP010 01250CSR RLABL NCHARS 30 WP010 01260CSR KEY CHAINWRKORD 55 WP010 0001270CSR MOVELSAVPOS BUFFER WP010 01280CSR MOVELOFC BUFFER WP010 01290CSR EXSR POSCUR WP010 01300C* ********** WP010 01310CSR MOVEL'] NEW R'WORD16 16 WP010 01320CSR MOVE 'ECORD 'WORD16 WP010 01330CSRN55 MOVELBLANKS WORD16 WP010 0001340CSRN55 MOVEL']' WORD16 WP010 01350CSR MOVELWORD16 BUFFER 72 WP010 01360CSR MOVE 'T' TYPE 1 WP010 01370CSR Z-ADD13 BLNGTH 20 WP010 01380CSR EXSR CRTCOM WP010 01390C* ********** WP010 01400CSR SETON 62 WP010 0001410CSR Z-ADDSX X 30 WP010 01420CSR EXSR ACCEPT WP010 01430C* ********** WP010 01440CSR MOVELBUFFER SECTON 2 WP010 01450CSR SECTON COMP 'E ' 40 WP010 01460CSR 40 GOTO ENDFP WP010 01470C* ********** WP010 0001480CSR SECTON COMP 'D ' 40 WP010 01490CSR 40N55 EXCPT WP010 01500CSR 40 GOTO PGE WP010 01510C* ********** WP010 01520CSR SECTON COMP ' 1' 30 30 WP010 01530CSR 30 SECTON COMP ' 9' 3030 WP010 01540CSR 30 GOTO GOOD WP010 0001550C* ********** WP010 01560CSR SECTON COMP '01' 30 30 WP010 01570CSR 30 SECTON COMP '09' 3030 WP010 01580CSR 30 GOTO GOOD WP010 01590C* ********** WP010 01600CSR SECTON COMP '1 ' 30 30 WP010 01610CSR 30 SECTON COMP '9 ' 3030 WP010 0001620CSR 30 GOTO GOOD WP010 01630C* ********** WP010 01640CSR MOVELSECTON TEMP1 1 WP010 01650CSR TEMP1 COMP '1' 30 30 WP010 01660CSR 30 TEMP1 COMP '9' 3030 WP010 01670CSRN30 GOTO PGE WP010 01680C* ********** WP010 0001690CSR MOVE SECTON TEMP1 WP010 01700CSR TEMP1 COMP '0' 30 30 WP010 01710CSR 30 TEMP1 COMP '9' 3030 WP010 01720CSRN30 GOTO PGE WP010 01730C* ********** WP010 01740CSR GOOD TAG WP010 01750C* ********** WP010 0001760CSR SETOF 6162 WP010 01770CSRN55 GOTO ENDFP WP010 01780C* ********** WP010 01790CSR SETON 80 WP010 01800CSR EXCPT WP010 01810CSR SETOF 80 WP010 01820CSR KEY CHAINWRKORD 55 WP010 0001830CSR ENDFP ENDSR WP010 01840C* ********** WP010 01850C********************************************************************WP010 01860C* WP010 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. WP010 01880C* WP010 01890C********************************************************************WP010 0001900CSR GETSEC BEGSR WP010 01910C* ********** WP010 01920CSR 1 ADD SECTN N 20 WP010 01930CSR SETOF 404145 WP010 01940CSR N COMP 0 3030 WP010 01950CSRN30 N COMP NSECT 30 WP010 01960CSR 30 GOTO ENDGET WP010 0001970C* ********** WP010 01980CSR SECTN MULT SSIZE RRN 40 WP010 01990CSR Z-ADD1 X WP010 02000CSR SCLOOP TAG WP010 02010C* ********** WP010 02020CSR RRN ADD 1 RRN WP010 02030CSR RRN CHAINJPR010 50 WP010 0002040CSR 50 GOTO ENDGET WP010 02050C* ********** WP010 02060CSR FIELDN COMP B22 4141 WP010 02070CSRN41 GOTO ENDGET WP010 02080C* ********** WP010 02090CSR 41N45 SETON 45 WP010 02100CSR MOVE FIELDN FN,X WP010 0002110CSR MOVE CURPOS CP,X WP010 02120CSR MOVE LNGTH LN,X WP010 02130CSR Z-ADDENDPOS EP,X WP010 02140CSR 1 ADD X X WP010 02150CSR X COMP SSIZE 32 WP010 02160CSRN32 GOTO SCLOOP WP010 02170C* ********** WP010 0002180CSR ENDGET TAG WP010 02190C* ********** WP010 02200CSR Z-ADDX NOFLDS 30 WP010 02210CSR 45 GOTO FINGET WP010 02220C* ********** WP010 02230CSR EXSR CLRSCR WP010 02240C* ********** WP010 0002250CSR MOVEL'SECT # 'WORD9 9 WP010 02260CSR Z-ADD16 BLNGTH WP010 02270CSR MOVE SECTN WORD9 WP010 02280CSR MOVELWORD9 WORD16 WP010 02290CSRN30 MOVE ' ABSENT' WORD16 WP010 02300CSR 30 MOVE ' ILLEG.' WORD16 WP010 02310CSR MOVELWORD16 BUFFER WP010 0002320CSR MOVEL'T' TYPE WP010 02330CSR EXSR CRTCOM WP010 02340C* ********** WP010 02350CSR FINGET ENDSR WP010 02360C* ********** WP010 02370C********************************************************************WP010 02380C* WP010 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE WP010 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE WP010 02410C* SECTION INDEX IS SAVED. WP010 02420C* WP010 02430C********************************************************************WP010 02440CSR OUTPUT BEGSR WP010 02450C* ********** WP010 0002460CSR EXSR CLRSCR WP010 02470C* ********** WP010 02480CSR Z-ADD1 X WP010 02490CSR 61 SETON 63 WP010 02500CSR OTLOOP TAG WP010 02510C* ********** WP010 02520CSR 61 LN,X COMP 0 31 WP010 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXWP010 02540CSR EXSR OUTFLD WP010 02550C* ********** WP010 02560CSR X ADD 1 X WP010 02570CSR X COMP NOFLDS 31 WP010 02580CSR 31 GOTO OTLOOP WP010 02590C* ********** WP010 0002600CSR SETOF 63 WP010 02610CSR ENDSR WP010 02620C********************************************************************WP010 02630C* WP010 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND WP010 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 WP010 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS WP010 0002670C* THEN NO FIELD INFORMATION IS PRINTED WP010 02680C* WP010 02690C********************************************************************WP010 02700CSR OUTFLD BEGSR WP010 02710C* ********** WP010 02720CSR MOVE FN,X FL 20 WP010 02730CSR EP,X COMP 0 98 WP010 0002740CSR MOVELCP,X FC 20 WP010 02750CSR FC COMP FL 31 WP010 02760CSR 31 Z-ADDFC FL WP010 02770CSR FC SUB FL CC 20 WP010 02780CSR CC ADD 1 CC WP010 02790CSR MOVELCP,X BUFFER WP010 02800CSR MOVELCC BUFFER WP010 0002810CSR EXSR POSCUR WP010 02820C* ********** WP010 02830CSR MOVELBLANKS BUFFER WP010 02840CSR MOVELFN,X FIELDN WP010 02850CSR MOVE ' ' FIELDN WP010 02860CSR MOVELFIELDN BUFFER WP010 02870CSR Z-ADDLN,X LEN 20 WP010 0002880CSR LEN COMP 0 9730 WP010 02890CSR 97 Z-SUBLN,X LEN WP010 02900CSR 30 GOTO SKIPF WP010 02910C* ********** WP010 02920CSR FL ADD 2 BPOS 20 WP010 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS WP010 02940CSR Z-ADDBPOS TSTRT 30 WP010 0002950CSRN98 Z-ADD1 SSTRT 30 WP010 02960CSR 98 Z-ADD3 SSTRT WP010 02970CSR Z-ADD1 NCHARS 30 WP010 02980C* ********** WP010 02990CSR EXIT SUBRLM WP010 03000CSR RLABL TEMP4 WP010 03010CSR RLABL SSTRT 30 WP010 0003020CSR RLABL BUFFER WP010 03030CSR RLABL TSTRT 30 WP010 03040CSR RLABL NCHARS 30 WP010 03050CSR BPOS ADD 1 FPOS 20 WP010 03060CSR EXSR MVRECD WP010 03070C* ********** WP010 03080CSR SKIPF TAG WP010 0003090C* ********** WP010 03100CSR 30 Z-ADDFL BLNGTH WP010 03110CSRN30 FL ADD 3 BLNGTH WP010 03120CSRN30 BLNGTH ADD LEN BLNGTH WP010 03130CSR MOVE 'T' TYPE WP010 03140CSR EXSR CRTCOM WP010 03150C* ********** WP010 0003160CSR ENDSR WP010 03170C********************************************************************WP010 03180C* WP010 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN WP010 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST WP010 03210C* THE RIGHT BRACKET. WP010 03220C********************************************************************WP010 0003230CSR MVRECD BEGSR WP010 03240C* ********** WP010 03250CSR 63 GOTO RBRK WP010 03260C* ********** WP010 03270CSR 98 Z-SUBEP,X END 40 WP010 03280CSRN98 Z-ADDEP,X END WP010 03290CSR END SUB LEN STRT 40 81 81 WP010 0003300CSR STRT ADD 1 STRT WP010 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER WP010 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER WP010 03330CSR Z-ADDLEN NCHARS WP010 03340CSR Z-ADDSTRT SSTRT WP010 03350CSR Z-ADDFPOS TSTRT WP010 03360CSRN81 GOTO RBRK WP010 0003370C* ********** WP010 03380CSR EXIT SUBRLM WP010 03390CSR RLABL RECORD WP010 03400CSR RLABL SSTRT 30 WP010 03410CSR RLABL BUFFER WP010 03420CSR RLABL TSTRT 30 WP010 03430CSR RLABL NCHARS 30 WP010 0003440CSR RBRK TAG WP010 03450C* ********** WP010 03460CSR EXSR RTBRKT WP010 03470C* ********** WP010 03480CSR ENDSR WP010 03490C********************************************************************WP010 03500C* WP010 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS WP010 03520C* WP010 03530C********************************************************************WP010 03540CSR RTBRKT BEGSR WP010 03550C* ********** WP010 03560CSR LEN ADD FPOS FPOS WP010 03570CSR Z-ADDFPOS TSTRT WP010 0003580CSR Z-ADD1 NCHARS WP010 03590CSRN98 Z-ADD2 SSTRT WP010 03600CSR 98 Z-ADD4 SSTRT WP010 03610C* ********** WP010 03620CSR EXIT SUBRLM WP010 03630CSR RLABL TEMP4 WP010 03640CSR RLABL SSTRT 30 WP010 0003650CSR RLABL BUFFER WP010 03660CSR RLABL TSTRT 30 WP010 03670CSR RLABL NCHARS 30 WP010 03680CSR ENDSR WP010 03690C********************************************************************WP010 03700C* WP010 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. WP010 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO WP010 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF WP010 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST WP010 03750C* OF THE FIELDS ARE LEFT UNCHANGED WP010 03760C* WP010 03770C********************************************************************WP010 03780CSR UPDATE BEGSR WP010 0003790C* ********** WP010 03800CSR SETOF 32 WP010 03810CSR Z-ADD1 X WP010 03820CSR UPLOOP TAG WP010 03830C* ********** WP010 03840CSR EP,X COMP 0 98 WP010 03850CSR 98 SETON 30 WP010 0003860CSR 98 GOTO NOUPD WP010 03870C* ********** WP010 03880CSR Z-ADDLN,X LEN WP010 03890CSR LEN COMP 0 9730 WP010 03900CSR 97 Z-SUBLEN LEN WP010 03910CSR NOUPD TAG WP010 03920C* ********** WP010 0003930CSR 30N32 GOTO INCR WP010 03940C* ********** WP010 03950CSR 30 GOTO CHKRUB WP010 03960C* ********** WP010 03970CSR SETOF 3233 WP010 03980CSR EXSR ACCEPT WP010 03990C* ********** WP010 0004000CSR CHKRUB TAG WP010 04010C* ********** WP010 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTWP010 04030CSR 32 31 GOTO UPLOOP WP010 04040C* ********** WP010 04050CSR 32 GOTO ENDUPD WP010 04060C* ********** WP010 0004070CSR MOVELBUFFER ATSIGN 1 WP010 04080CSR ATSIGN COMP '@' 35 WP010 04090CSR 35 GOTO OUTREC WP010 04100C* ********** WP010 04110CSR 33 GOTO INCR WAS LINE FEED WP010 04120C* ********** WP010 04130CSR Z-ADDEP,X END WP010 0004140CSR END SUB LEN STRT 81 81 WP010 04150CSR STRT ADD 1 STRT WP010 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF WP010 04170C* BUFFER TO THE STRT OF RECORD WP010 04180CSR Z-ADD1 SSTRT WP010 04190CSR Z-ADDSTRT TSTRT WP010 04200CSR Z-ADDLEN NCHARS WP010 0004210CSRN81 GOTO AAA WP010 04220C* ********** WP010 04230CSR EXIT SUBRLM WP010 04240CSR RLABL BUFFER WP010 04250CSR RLABL SSTRT 30 WP010 04260CSR RLABL RECORD WP010 04270CSR RLABL TSTRT 30 WP010 0004280CSR RLABL NCHARS 30 WP010 04290CSR AAA TAG WP010 04300CSR MOVELBUFFER TEMP5 5 WP010 04310CSR MOVELSAVPOS BUFFER WP010 04320CSR EXSR POSCUR WP010 04330C* ********** WP010 04340CSR MOVELTEMP5 BUFFER WP010 0004350CSR Z-ADD1 FPOS WP010 04360CSR EXSR RTBRKT WP010 04370C* ********** WP010 04380CSR LEN ADD 1 BLNGTH WP010 04390CSR MOVE 'T' TYPE WP010 04400CSR EXSR CRTCOM WP010 04410C* ********** WP010 0004420CSR INCR TAG WP010 04430C* ********** WP010 04440CSR X ADD 1 X WP010 04450CSR X COMP NOFLDS 30 WP010 04460CSR 30 GOTO UPLOOP WP010 04470C* ********** WP010 04480CSR OUTREC TAG WP010 0004490C* ********** WP010 04500CSR SETON 80 WP010 04510CSRN61 EXCPT WP010 04520CSR SETOF 80 WP010 04530CSR ENDUPD TAG WP010 04540C* ********** WP010 04550CSR ENDSR WP010 0004560C********************************************************************WP010 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE WP010 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X WP010 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND WP010 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT WP010 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED WP010 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS WP010 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS WP010 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO WP010 04650C* TO BE OUTPUT TO THE SCREEN. WP010 04660C* WP010 04670C********************************************************************WP010 04680CSR ACCEPT BEGSR WP010 04690C* ********** WP010 0004700CSR X COMP 1 30 WP010 04710CSRN30 X COMP SSIZE 30 WP010 04720CSR 30 Z-ADD1 X WP010 04730CSR MOVELCP,X FC WP010 04740CSR FC ADD 3 FC WP010 04750CSR MOVELCP,X SAVPOS 4 WP010 04760CSR MOVELFC SAVPOS WP010 0004770CSR Z-ADDLN,X LEN WP010 04780CSR LEN COMP 0 97 WP010 04790CSR 97 Z-SUBLEN LEN WP010 04800CSR LEN ADD FC OFC 20 WP010 04810CSR ACLOOP TAG WP010 04820C* ********** WP010 04830CSR MOVELSAVPOS BUFFER WP010 0004840CSR EXSR POSCUR WP010 04850C* ********** WP010 04860CSR Z-ADDLEN BLNGTH WP010 04870CSR MOVE BLANKS BUFFER WP010 04880CSR MOVE 'A' TYPE WP010 04890CSR EXSR CRTCOM WP010 04900C* ********** WP010 0004910CSR RCODE COMP 'R' 31 WP010 04920CSR 31 BUFFER COMP BLANKS 32 WP010 04930CSR 31 32N62 GOTO DUPIT WP010 04940C* ********** WP010 04950CSR 31 GOTO ACLOOP WP010 04960C* ********** WP010 04970CSR RCODE COMP 'L' 33 WP010 0004980CSR 33 GOTO DUPIT WP010 04990C* ********** WP010 05000CSRN97 GOTO ENDACC WP010 05010C* ********** WP010 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK WP010 05030CSR SIGN COMP '@' 30 WP010 05040CSR 30 GOTO ENDACC WP010 0005050C* ********** WP010 05060CSR Z-ADDLEN VL 20 WP010 05070CSR MOVELBUFFER VAR 15 WP010 05080CSR EXSR RTADJ WP010 05090C* ********** WP010 05100CSR MOVELVAR BUFFER WP010 05110CSR GOTO ENDACC WP010 0005120C* ********** WP010 05130CSR DUPIT TAG WP010 05140C* ********** WP010 05150CSR MOVELSAVPOS BUFFER WP010 05160CSR EXSR POSCUR WP010 05170C* ********** WP010 05180CSR 62 MOVELSECTON BUFFER WP010 0005190CSRN62 Z-ADD1 FPOS WP010 05200CSRN62 EXSR MVRECD WP010 05210C* ********** WP010 05220CSR MOVE 'T' TYPE WP010 05230CSR BLNGTH ADD 1 BLNGTH WP010 05240CSR EXSR CRTCOM WP010 05250C* ********** WP010 0005260CSR ENDACC ENDSR WP010 05270C* ********** WP010 05280C********************************************************************WP010 05290C* WP010 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES WP010 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM WP010 05320C* 4 DUMMY FOR RTADJ WP010 0005330C* WP010 05340C********************************************************************WP010 05350CSR POSCUR BEGSR WP010 05360C* ********** WP010 05370CSR MOVE 'P' TYPE WP010 05380CSR EXSR CRTCOM WP010 05390C* ********** WP010 0005400CSR ENDSR WP010 05410C********************************************************************WP010 05420CSR CLRSCR BEGSR WP010 05430C* ********** WP010 05440CSR MOVE 'C' TYPE WP010 05450CSR EXSR CRTCOM WP010 05460C* ********** WP010 0005470CSR ENDSR WP010 05480C********************************************************************WP010 05490CSR CRTCOM BEGSR WP010 05500C* ********** WP010 05510CSR EXITFSUBRCM WP010 05520CSR RLABL BUFFER 72 WP010 05530CSR RLABL TYPE 1 WP010 0005540CSR RLABL BLNGTH 20 WP010 05550CSR RLABL RCODE 1 WP010 05560CSR RLABL MASK 10 WP010 05570CSR RLABL DTYPE 10 WP010 05580CSR ENDSR WP010 05590C********************************************************************WP010 05600CSR RTADJ BEGSR WP010 0005610C* ********** WP010 05620C* ********** WP010 05630CSR EXIT SUBRAJ WP010 05640CSR RLABL VL WP010 05650CSR RLABL VAR WP010 05660CSR ENDSR WP010 05670C********************************************************************WP010 0005680OWRKORD E 80N55 WP010 05690O RECORD 0160 WP010 05700O E 40N80 WP010 05710O FF 1 WP010 05720O EADD 80 55 WP010 05730O RECORD 0160 WP010 ** 00574000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005750ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005760ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005770ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005780/* 005790__0O RECORD 0160 WP010 ** 0057400(z TERRORCD P999999111111(0AAAAAAAAAAA BBBBBBBBBBB CCCCCCCCCC DDDDDDDDDDD EEEEEEEEEEEE __0O RECORD 0160 WP010 ** 0057400(X{? *TXWP020 P999999111111(000010H S WP020 00020X 1 WP020 00030F* MAINTIAN OPEN WORKORDER OPERATION FILE WP020 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP020 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP020 00060F* CONTROL DATA PROPRIETARY PRODUCT WP020 00070F* WP020 0000080FNULL IPEAF 72 DISK WP020 00090FJPR020 IC F 32R DISK WP020 00100FWRKOPR UC F 90R DISK WP020 00110FWRKORD UC F 0160R05AI 0001 DISK WP020 00120E FN 015 22 FIELD NAME WP020 00130E CP 015 4 CURSOR POSITION WP020 00140E LN 015 2 0 LENGTH WP020 0000150E EP 015 4 0 ENDING POSITION WP020 00160INULL NS 01 WP020 00170I 1 1 A WP020 00180IJPR020 NS 02 WP020 00190I 1 22 FIELDN WP020 00200I 23 26 CURPOS WP020 00210I 27 280LNGTH WP020 0000220I 29 310ENDPOS WP020 00230IWRKOPR NS 03 WP020 00240I 1 50OPWON WP020 00250I 6 80OPOPN WP020 00260I 10090 RECORD WP020 00270IWRKORD NS 04 WP020 00280I 62 660OPRRN WP020 0000290C MOVE ' ' RCODE 1 WP020 00300C MOVE RCODE B22 22 WP020 00310C MOVE RCODE BLANKS 72 WP020 00320C MOVE RCODE FILLER 1 WP020 00330C Z-ADD0 MASK 10 WP020 00340C SETON LR WP020 00350CLR Z-ADD015 SSIZE 30 WP020 0000360CLR Z-ADD002 NSECT 30 WP020 00370CLR BITON'01234567'FF 1 WP020 00380CLR MOVE '[]<>' TEMP4 4 WP020 00390CLR START TAG WP020 00400C* ********** WP020 00410CLR EXSR FIRSTP WP020 00420C* ********** WP020 0000430CLR EXSR CLRSCR WP020 00440C* ********** WP020 00450CLR 40 GOTO EOJ WP020 00460C* ********** WP020 00470CLR Z-ADD2 VL WP020 00480CLR MOVELSECTON VAR WP020 00490CLR EXSR RTADJ WP020 0000500C* ********** WP020 00510CLR MOVELVAR SECTN 20 WP020 00520CLR EXSR GETSEC WP020 00530C* ********** WP020 00540CLRN45 GOTO START WP020 00550C* ********** WP020 00560CLR EXSR CLRSCR WP020 0000570C* ********** WP020 00580CLR EXSR OUTPUT WP020 00590C* ********** WP020 00600CLR EXSR UPDATE WP020 00610C* ********** WP020 00620CLR GOTO START WP020 00630C* ********** WP020 0000640CLR EOJ TAG WP020 00650C* ********** WP020 00660C********************************************************************WP020 00670C* WP020 00680C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND WP020 00690C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. WP020 00700C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDWP020 0000710C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN WP020 00720C* WP020 00730C********************************************************************WP020 00740CSR FIRSTP BEGSR WP020 00750C* ********** WP020 00760CSR EXSR CLRSCR WP020 00770C* ********** WP020 0000780CSR Z-ADD0 SECTN WP020 00790CSR EXSR GETSEC WP020 00800C* ********** WP020 00810CSR PGE TAG WP020 00820C* ********** WP020 00830CSR SETON 61 WP020 00840CSR SETOF 62 WP020 0000850CSR EXSR OUTPUT WP020 00860C* ********** WP020 00870C* ********** WP020 00880CSR EXIT SUBRFL WP020 00890CSR RLABL RECORD WP020 00900CSR RLABL FILLER 1 WP020 00910C* ********** WP020 0000920C* ********** WP020 00930C* ********** WP020 00940C* ********** WP020 00950C* ********** WP020 00960C* ********** WP020 00970C* ********** WP020 00980C* ********** WP020 0000990C* ********** WP020 01000C* ********** WP020 01010C* ********** WP020 01020C* ********** WP020 01030C* ********** WP020 01040C* ********** WP020 01050C* ********** WP020 0001060CSR Z-ADD05 NCHARS WP020 01070CSR Z-ADD1 SSTRT WP020 01080CSR Z-ADD1 TSTRT WP020 01090C* ********** WP020 01100CSR EXIT SUBRLM WP020 01110CSR RLABL KEY 8 WP020 01120CSR RLABL SSTRT 30 WP020 0001130CSR RLABL RECORD WP020 01140CSR RLABL TSTRT 30 WP020 01150CSR RLABL NCHARS 30 WP020 01160CSR Z-ADDNOFLDS SVFLDS 30 WP020 01170CSR Z-ADDSX NOFLDS WP020 01180CSR EXSR UPDATE WP020 01190C* ********** WP020 0001200CSR Z-ADDSVFLDS NOFLDS WP020 01210CSR Z-ADD08 NCHARS WP020 01220CSR Z-ADD1 SSTRT WP020 01230CSR Z-ADD1 TSTRT WP020 01240C* ********** WP020 01250CSR EXIT SUBRLM WP020 01260CSR RLABL RECORD WP020 0001270CSR RLABL SSTRT 30 WP020 01280CSR RLABL KEY WP020 01290CSR RLABL TSTRT 30 WP020 01300CSR RLABL NCHARS 30 WP020 01310CSR MOVELKEY WONUM 50 WP020 01320CSR WONUM CHAINWRKORD 55 WP020 01330CSR MOVELSAVPOS BUFFER WP020 0001340CSR MOVELOFC BUFFER WP020 01350CSR EXSR POSCUR WP020 01360C* ********** WP020 01370CSR MOVEL'] NO WR'WORD16 16 WP020 01380CSR MOVE 'KOPR REC'WORD16 WP020 01390CSRN55 MOVELBLANKS WORD16 WP020 01400CSRN55 MOVEL']' WORD16 WP020 0001410CSR MOVELWORD16 BUFFER 72 WP020 01420CSR MOVE 'T' TYPE 1 WP020 01430CSR Z-ADD16 BLNGTH 20 WP020 01440CSR EXSR CRTCOM WP020 01450C* ********** WP020 01460CSR SETON 62 WP020 01470CSR Z-ADDSX X 30 WP020 0001480CSR EXSR ACCEPT WP020 01490C* ********** WP020 01500CSR MOVELBUFFER SECTON 2 WP020 01510CSR SECTON COMP 'E ' 40 WP020 01520CSR 40 GOTO ENDFP WP020 01530CSR SETOF 6162 WP020 01540CSR MOVE KEY OPNUM 30 WP020 0001550CSR GETOPR TAG WP020 01560CSR OPRRN CHAINWRKOPR 55 WP020 01570CSR 55 GOTO PGE WP020 01580CSR WONUM COMP OPWON 30 WP020 01590CSRN30 GOTO PGE WP020 01600CSR OPNUM COMP OPOPN 30 WP020 01610CSR 30 GOTO ENDFP WP020 0001620CSR OPRRN ADD 1 OPRRN WP020 01630CSR GOTO GETOPR WP020 01640CSR MOVE '01' SECTON WP020 01650CSR ENDFP ENDSR WP020 01660C* ********** WP020 01670C********************************************************************WP020 01680C* WP020 0001690C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. WP020 01700C* WP020 01710C********************************************************************WP020 01720CSR GETSEC BEGSR WP020 01730C* ********** WP020 01740CSR 1 ADD SECTN N 20 WP020 01750CSR SETOF 404145 WP020 0001760CSR N COMP 0 3030 WP020 01770CSRN30 N COMP NSECT 30 WP020 01780CSR 30 GOTO ENDGET WP020 01790C* ********** WP020 01800CSR SECTN MULT SSIZE RRN 40 WP020 01810CSR Z-ADD1 X WP020 01820CSR SCLOOP TAG WP020 0001830C* ********** WP020 01840CSR RRN ADD 1 RRN WP020 01850CSR RRN CHAINJPR020 50 WP020 01860CSR 50 GOTO ENDGET WP020 01870C* ********** WP020 01880CSR FIELDN COMP B22 4141 WP020 01890CSRN41 GOTO ENDGET WP020 0001900C* ********** WP020 01910CSR 41N45 SETON 45 WP020 01920CSR MOVE FIELDN FN,X WP020 01930CSR MOVE CURPOS CP,X WP020 01940CSR MOVE LNGTH LN,X WP020 01950CSR Z-ADDENDPOS EP,X WP020 01960CSR 1 ADD X X WP020 0001970CSR X COMP SSIZE 32 WP020 01980CSRN32 GOTO SCLOOP WP020 01990C* ********** WP020 02000CSR ENDGET TAG WP020 02010C* ********** WP020 02020CSR Z-ADDX NOFLDS 30 WP020 02030CSR 45 GOTO FINGET WP020 0002040C* ********** WP020 02050CSR EXSR CLRSCR WP020 02060C* ********** WP020 02070CSR MOVEL'SECT # 'WORD9 9 WP020 02080CSR Z-ADD16 BLNGTH WP020 02090CSR MOVE SECTN WORD9 WP020 02100CSR MOVELWORD9 WORD16 WP020 0002110CSRN30 MOVE ' ABSENT' WORD16 WP020 02120CSR 30 MOVE ' ILLEG.' WORD16 WP020 02130CSR MOVELWORD16 BUFFER WP020 02140CSR MOVEL'T' TYPE WP020 02150CSR EXSR CRTCOM WP020 02160C* ********** WP020 02170CSR FINGET ENDSR WP020 0002180C* ********** WP020 02190C********************************************************************WP020 02200C* WP020 02210C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE WP020 02220C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE WP020 02230C* SECTION INDEX IS SAVED. WP020 02240C* WP020 0002250C********************************************************************WP020 02260CSR OUTPUT BEGSR WP020 02270C* ********** WP020 02280CSR EXSR CLRSCR WP020 02290C* ********** WP020 02300CSR Z-ADD1 X WP020 02310CSR 61 SETON 63 WP020 0002320CSR OTLOOP TAG WP020 02330C* ********** WP020 02340CSR 61 LN,X COMP 0 31 WP020 02350CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXWP020 02360CSR EXSR OUTFLD WP020 02370C* ********** WP020 02380CSR X ADD 1 X WP020 0002390CSR X COMP NOFLDS 31 WP020 02400CSR 31 GOTO OTLOOP WP020 02410C* ********** WP020 02420CSR SETOF 63 WP020 02430CSR ENDSR WP020 02440C********************************************************************WP020 02450C* WP020 0002460C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND WP020 02470C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 WP020 02480C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS WP020 02490C* THEN NO FIELD INFORMATION IS PRINTED WP020 02500C* WP020 02510C********************************************************************WP020 02520CSR OUTFLD BEGSR WP020 0002530C* ********** WP020 02540CSR MOVE FN,X FL 20 WP020 02550CSR EP,X COMP 0 98 WP020 02560CSR MOVELCP,X FC 20 WP020 02570CSR FC COMP FL 31 WP020 02580CSR 31 Z-ADDFC FL WP020 02590CSR FC SUB FL CC 20 WP020 0002600CSR CC ADD 1 CC WP020 02610CSR MOVELCP,X BUFFER WP020 02620CSR MOVELCC BUFFER WP020 02630CSR EXSR POSCUR WP020 02640C* ********** WP020 02650CSR MOVELBLANKS BUFFER WP020 02660CSR MOVELFN,X FIELDN WP020 0002670CSR MOVE ' ' FIELDN WP020 02680CSR MOVELFIELDN BUFFER WP020 02690CSR Z-ADDLN,X LEN 20 WP020 02700CSR LEN COMP 0 9730 WP020 02710CSR 97 Z-SUBLN,X LEN WP020 02720CSR 30 GOTO SKIPF WP020 02730C* ********** WP020 0002740CSR FL ADD 2 BPOS 20 WP020 02750C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS WP020 02760CSR Z-ADDBPOS TSTRT 30 WP020 02770CSRN98 Z-ADD1 SSTRT 30 WP020 02780CSR 98 Z-ADD3 SSTRT WP020 02790CSR Z-ADD1 NCHARS 30 WP020 02800C* ********** WP020 0002810CSR EXIT SUBRLM WP020 02820CSR RLABL TEMP4 WP020 02830CSR RLABL SSTRT 30 WP020 02840CSR RLABL BUFFER WP020 02850CSR RLABL TSTRT 30 WP020 02860CSR RLABL NCHARS 30 WP020 02870CSR BPOS ADD 1 FPOS 20 WP020 0002880CSR EXSR MVRECD WP020 02890C* ********** WP020 02900CSR SKIPF TAG WP020 02910C* ********** WP020 02920CSR 30 Z-ADDFL BLNGTH WP020 02930CSRN30 FL ADD 3 BLNGTH WP020 02940CSRN30 BLNGTH ADD LEN BLNGTH WP020 0002950CSR MOVE 'T' TYPE WP020 02960CSR EXSR CRTCOM WP020 02970C* ********** WP020 02980CSR ENDSR WP020 02990C********************************************************************WP020 03000C* WP020 03010C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN WP020 0003020C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST WP020 03030C* THE RIGHT BRACKET. WP020 03040C********************************************************************WP020 03050CSR MVRECD BEGSR WP020 03060C* ********** WP020 03070CSR 63 GOTO RBRK WP020 03080C* ********** WP020 0003090CSR 98 Z-SUBEP,X END 40 WP020 03100CSRN98 Z-ADDEP,X END WP020 03110CSR END SUB LEN STRT 40 81 81 WP020 03120CSR STRT ADD 1 STRT WP020 03130C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER WP020 03140C* FROM STRT IN RECORD TO FPOS IN BUFFER WP020 03150CSR Z-ADDLEN NCHARS WP020 0003160CSR Z-ADDSTRT SSTRT WP020 03170CSR Z-ADDFPOS TSTRT WP020 03180C* ********** WP020 03190CSR EXIT SUBRLM WP020 03200CSR RLABL RECORD WP020 03210CSR RLABL SSTRT 30 WP020 03220CSR RLABL BUFFER WP020 0003230CSR RLABL TSTRT 30 WP020 03240CSR RLABL NCHARS 30 WP020 03250CSR RBRK TAG WP020 03260C* ********** WP020 03270CSR EXSR RTBRKT WP020 03280C* ********** WP020 03290CSR ENDSR WP020 0003300C********************************************************************WP020 03310C* WP020 03320C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS WP020 03330C* WP020 03340C********************************************************************WP020 03350CSR RTBRKT BEGSR WP020 03360C* ********** WP020 0003370CSR LEN ADD FPOS FPOS WP020 03380CSR Z-ADDFPOS TSTRT WP020 03390CSR Z-ADD1 NCHARS WP020 03400CSRN98 Z-ADD2 SSTRT WP020 03410CSR 98 Z-ADD4 SSTRT WP020 03420C* ********** WP020 03430CSR EXIT SUBRLM WP020 0003440CSR RLABL TEMP4 WP020 03450CSR RLABL SSTRT 30 WP020 03460CSR RLABL BUFFER WP020 03470CSR RLABL TSTRT 30 WP020 03480CSR RLABL NCHARS 30 WP020 03490CSR ENDSR WP020 03500C********************************************************************WP020 0003510C* WP020 03520C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. WP020 03530C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO WP020 03540C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF WP020 03550C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST WP020 03560C* OF THE FIELDS ARE LEFT UNCHANGED WP020 03570C* WP020 0003580C********************************************************************WP020 03590CSR UPDATE BEGSR WP020 03600C* ********** WP020 03610CSR SETOF 32 WP020 03620CSR Z-ADD1 X WP020 03630CSR UPLOOP TAG WP020 03640C* ********** WP020 0003650CSR EP,X COMP 0 98 WP020 03660CSR 98 SETON 30 WP020 03670CSR 98 GOTO NOUPD WP020 03680C* ********** WP020 03690CSR Z-ADDLN,X LEN WP020 03700CSR LEN COMP 0 9730 WP020 03710CSR 97 Z-SUBLEN LEN WP020 0003720CSR NOUPD TAG WP020 03730CSR 30N32 GOTO INCR WP020 03740C* ********** WP020 03750CSR 30 GOTO CHKRUB WP020 03760C* ********** WP020 03770CSR SETOF 3233 WP020 03780CSR EXSR ACCEPT WP020 0003790C* ********** WP020 03800CSR CHKRUB TAG WP020 03810C* ********** WP020 03820CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTWP020 03830CSR 32 31 GOTO UPLOOP WP020 03840C* ********** WP020 03850CSR 32 GOTO ENDUPD WP020 0003860C* ********** WP020 03870CSR MOVELBUFFER ATSIGN 1 WP020 03880CSR ATSIGN COMP '@' 35 WP020 03890CSR 35 GOTO OUTREC WP020 03900C* ********** WP020 03910CSR 33 GOTO INCR WAS LINE FEED WP020 03920C* ********** WP020 0003930CSR Z-ADDEP,X END WP020 03940CSR END SUB LEN STRT 81 81 WP020 03950CSR STRT ADD 1 STRT WP020 03960C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF WP020 03970C* BUFFER TO THE STRT OF RECORD WP020 03980CSR Z-ADD1 SSTRT WP020 03990CSR Z-ADDSTRT TSTRT WP020 0004000CSR Z-ADDLEN NCHARS WP020 04010C* ********** WP020 04020CSR EXIT SUBRLM WP020 04030CSR RLABL BUFFER WP020 04040CSR RLABL SSTRT 30 WP020 04050CSR RLABL RECORD WP020 04060CSR RLABL TSTRT 30 WP020 0004070CSR RLABL NCHARS 30 WP020 04080CSR MOVELBUFFER TEMP5 5 WP020 04090CSR MOVELSAVPOS BUFFER WP020 04100CSR EXSR POSCUR WP020 04110C* ********** WP020 04120CSR MOVELTEMP5 BUFFER WP020 04130CSR Z-ADD1 FPOS WP020 0004140CSR EXSR RTBRKT WP020 04150C* ********** WP020 04160CSR LEN ADD 1 BLNGTH WP020 04170CSR MOVE 'T' TYPE WP020 04180CSR EXSR CRTCOM WP020 04190C* ********** WP020 04200CSR INCR TAG WP020 0004210C* ********** WP020 04220CSR X ADD 1 X WP020 04230CSR X COMP NOFLDS 30 WP020 04240CSR 30 GOTO UPLOOP WP020 04250C* ********** WP020 04260CSR OUTREC TAG WP020 04270C* ********** WP020 0004280CSR SETON 80 WP020 04290CSRN61 EXCPT WP020 04300CSR SETOF 80 WP020 04310CSR ENDUPD TAG WP020 04320C* ********** WP020 04330CSR ENDSR WP020 04340C********************************************************************WP020 0004350C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE WP020 04360C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X WP020 04370C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND WP020 04380C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT WP020 04390C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED WP020 04400C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS WP020 04410C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS WP020 0004420C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO WP020 04430C* TO BE OUTPUT TO THE SCREEN. WP020 04440C* WP020 04450C********************************************************************WP020 04460CSR ACCEPT BEGSR WP020 04470C* ********** WP020 04480CSR X COMP 1 30 WP020 0004490CSRN30 X COMP SSIZE 30 WP020 04500CSR 30 Z-ADD1 X WP020 04510CSR MOVELCP,X FC WP020 04520CSR FC ADD 3 FC WP020 04530CSR MOVELCP,X SAVPOS 4 WP020 04540CSR MOVELFC SAVPOS WP020 04550CSR Z-ADDLN,X LEN WP020 0004560CSR LEN COMP 0 97 WP020 04570CSR 97 Z-SUBLEN LEN WP020 04580CSR LEN ADD FC OFC 20 WP020 04590CSR ACLOOP TAG WP020 04600C* ********** WP020 04610CSR MOVELSAVPOS BUFFER WP020 04620CSR EXSR POSCUR WP020 0004630C* ********** WP020 04640CSR Z-ADDLEN BLNGTH WP020 04650CSR MOVE BLANKS BUFFER WP020 04660CSR MOVE 'A' TYPE WP020 04670CSR EXSR CRTCOM WP020 04680C* ********** WP020 04690CSR RCODE COMP 'R' 31 WP020 0004700CSR 31 BUFFER COMP BLANKS 32 WP020 04710CSR 31 32N62 GOTO DUPIT WP020 04720C* ********** WP020 04730CSR 31 GOTO ACLOOP WP020 04740C* ********** WP020 04750CSR RCODE COMP 'L' 33 WP020 04760CSR 33 GOTO DUPIT WP020 0004770C* ********** WP020 04780CSRN97 GOTO ENDACC WP020 04790C* ********** WP020 04800CSR MOVELBUFFER SIGN 1 WE MUST CHECK WP020 04810CSR SIGN COMP '@' 30 WP020 04820CSR 30 GOTO ENDACC WP020 04830C* ********** WP020 0004840CSR Z-ADDLEN VL 20 WP020 04850CSR MOVELBUFFER VAR 15 WP020 04860CSR EXSR RTADJ WP020 04870C* ********** WP020 04880CSR MOVELVAR BUFFER WP020 04890CSR GOTO ENDACC WP020 04900C* ********** WP020 0004910CSR DUPIT TAG WP020 04920C* ********** WP020 04930CSR MOVELSAVPOS BUFFER WP020 04940CSR EXSR POSCUR WP020 04950C* ********** WP020 04960CSR 62 MOVELSECTON BUFFER WP020 04970CSRN62 Z-ADD1 FPOS WP020 0004980CSRN62 EXSR MVRECD WP020 04990C* ********** WP020 05000CSR MOVE 'T' TYPE WP020 05010CSR BLNGTH ADD 1 BLNGTH WP020 05020CSR EXSR CRTCOM WP020 05030C* ********** WP020 05040CSR ENDACC ENDSR WP020 0005050C* ********** WP020 05060C********************************************************************WP020 05070C* WP020 05080C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES WP020 05090C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM WP020 05100C* 4 DUMMY FOR RTADJ WP020 05110C* WP020 0005120C********************************************************************WP020 05130CSR POSCUR BEGSR WP020 05140C* ********** WP020 05150CSR MOVE 'P' TYPE WP020 05160CSR EXSR CRTCOM WP020 05170C* ********** WP020 05180CSR ENDSR WP020 0005190C********************************************************************WP020 05200CSR CLRSCR BEGSR WP020 05210C* ********** WP020 05220CSR MOVE 'C' TYPE WP020 05230CSR EXSR CRTCOM WP020 05240C* ********** WP020 05250CSR ENDSR WP020 0005260C********************************************************************WP020 05270CSR CRTCOM BEGSR WP020 05280C* ********** WP020 05290C* ********** WP020 05300CSR EXITFSUBRCM WP020 05310CSR RLABL BUFFER 72 WP020 05320CSR RLABL TYPE 1 WP020 0005330CSR RLABL BLNGTH 20 WP020 05340CSR RLABL RCODE 1 WP020 05350CSR RLABL MASK 10 WP020 05360CSR RLABL DTYPE 10 WP020 05370CSR ENDSR WP020 05380C********************************************************************WP020 05390CSR RTADJ BEGSR WP020 0005400C* ********** WP020 05410CSR EXIT SUBRAJ WP020 05420C* ********** WP020 05430CSR RLABL VL WP020 05440CSR RLABL VAR WP020 05450CSR ENDSR WP020 05460C********************************************************************WP020 0005470OWRKOPR E 80N55 WP020 05480O RECORD 0090 WP020 ** 005490ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005500ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005510ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005520ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00553000/* 005540__0O RECORD 0090 WP020 ** 005490ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005500ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005510ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005520ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0055300(,|: ~}OTXWP100 P040678111111(000010H S WP100 00020X DECK-ID P19 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP100 00030F* WORKORDER TRANSACTION EDIT PROGRAM - BY OPERATION WP100 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP100 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP100 00060F* CONTROL DATA PROPRIETARY PRODUCT WP100 00070F* WP100 0000080FWKOUT IPEAF 128 DISK WP100 00090FPARTMST IC F 300R12AI 1 DISK WP100 00100FLABMST IC F 48R 2AI 1 DISK WP100 00110FWTRANS O F 60 DISK WP100 00120F* WP100 00130F* THIS PROGRAM PERFORMS A PRE-EDIT ON THE WORK ORDER TRANSACTIONS. WP100 00140F* IT ALSO INSERTS SOME INFORMATION FROM THE MASTER PARTS OR MASTER WP100 0000150F* LABOR FILE IN SOME OF THE TRANSACTIONS. WP100 00160F* WP100 00170IWKOUT NS 01 1 C5 2 C1 WP100 00180I 1 20TC WP100 00190I 1 2 ATC WP100 00200I 8 19 PARTNO WP100 00210I 1 55 REC1 WP100 0000220I NS 02 1NC 2NC WP100 00230I 1 20TC WP100 00240I 1 2 ATC WP100 00250I 8 100OPNUM WP100 00260I 12 180QTY WP100 00270I 19 20 LABGRD WP100 00280I 27 38 PARTNO WP100 0000290I 1 58 REC2 WP100 00300I NS 03 WP100 00310I 1 1 A WP100 00320IPARTMST NS 05 WP100 00330I 75 813MAT WP100 00340I 110 1163LAB WP100 00350I 117 1233BUR WP100 0000360I 124 1303OUTPR WP100 00370I 74 74 PDCODE WP100 00380ILABMST NS 07 WP100 00390I 23 293LRATE WP100 00400I 31 341BURDNF WP100 00410I 30 30 LDCODE WP100 00420C ATC COMP '<>' 52 WP100 0000430C 52 GOTO DEND WP100 00440C Z-ADD0 ERRNO 20 WP100 00450C SETOF 80 WP100 00460C Z-ADD0 BURDNF WP100 00470C********************************************************************WP100 00480C* WP100 00490C* TC NUMBERS MUST BE 51-63 WP100 0000500C* WP100 00510C********************************************************************WP100 00520C 03 GOTO DEND WP100 00530C TC COMP 50 20 WP100 00540C 20 TC COMP 64 20 WP100 00550C 20 TC COMP 61 2020 WP100 00560C N20 Z-ADD21 ERRNO 20 INVALID TC# WP100 0000570C N20 GOTO DEND WP100 00580C********************************************************************WP100 00590C* WP100 00600C* PARTNO MUST BE ON THE MASTER FILE FOR TC 51 AND 58 WP100 00610C* WP100 00620C********************************************************************WP100 00630C TC COMP 51 20 WP100 0000640C N20 TC COMP 58 20 WP100 00650C N20 GOTO CHKOP WP100 00660C PARTNO CHAINPARTMST 55 WP100 00670C N55 PDCODE COMP 'D' 55 WP100 00680C 55 Z-ADD22 ERRNO INVALID PART# WP100 00690C 55 GOTO DEND WP100 00700C********************************************************************WP100 0000710C* WP100 00720C* FOR TC = 54,55,56,57,59,+ 60 OPERATION NUMBER MUST BE WP100 00730C* A POSITIVE NUMBER WP100 00740C* WP100 00750C********************************************************************WP100 00760C CHKOP TAG WP100 00770C TC COMP 53 20 WP100 0000780C 20 TC COMP 61 20 WP100 00790C 20 TC COMP 58 2020 WP100 00800C 20 OPNUM COMP 000 21 INVLD OPER # WP100 00810C 20N21 Z-ADD24 ERRNO WP100 00820C 20N21 GOTO DEND WP100 00830C********************************************************************WP100 00840C* WP100 0000850C* TC 57 MUST HAVE A LABOR GRADE CODE WHICH IS ON THE LABOR MASTER WP100 00860C* RECORD. IF IT IS A VDLID LABOR GRADE THE THE LABOR DOLLARS WP100 00870C* ARE COMPUTED BY MULTIPLYING THE HOURS (QTY) BY THE RATE IN THE WP100 00880C* LABOR MASTER FILE. BURDEN FACTOR IS PASSED FROM THE LABOR WP100 00890C* MASTER FILE TO THE WTRANS FILE. WP100 00900C* WP100 00910C********************************************************************WP100 0000920C TC COMP 57 80 WP100 00930C N80 GOTO CHK58 WP100 00940C LABGRD CHAINLABMST 55 WP100 00950C N55 LDCODE COMP 'D' 55 WP100 00960C 55 Z-ADD23 ERRNO INVLD LABOR GRDWP100 00970C N55 QTY MULT LRATE DOLRS 60H WP100 00980C GOTO DEND WP100 0000990C********************************************************************WP100 01000C* WP100 01010C* TO 58 TAKES THE QUANTITY REPORTED IN 'QTY' AND EXTENDS IT BY WP100 01020C* THE TOTAL COST AS FOUND IN THE PARTMST FILE. WP100 01030C* WP100 01040C********************************************************************WP100 01050C CHK58 TAG WP100 0001060C TC COMP 58 80 WP100 01070C N80 GOTO DEND WP100 01080C LAB ADD MAT TOT 83 WP100 01090C TOT ADD BUR TOT WP100 01100C TOT ADD OUTPR TOT WP100 01110C QTY MULT TOT DOLRS H WP100 01120C DEND TAG WP100 0001130OWTRANS D 01N52 WP100 01140O REC1 55 WP100 01150O ERRNO 60 WP100 01160O D 02N52 WP100 01170O REC2 58 WP100 01180O 80DOLRS 26 WP100 01190O BURDNF 54 WP100 0001200O ERRNO 60 WP100 ** 001210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001250/* 00126000__0O ERRNO 60 WP100 ** 001210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001250/* 0012600(| uTOTXWP101 P999999111111(000010H S WP101 00020X DECK-ID P02 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP101 00030F* WORKORDER TRANSACTION EDIT PROGRAM - BY JOB WP101 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP101 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP101 00060F* CONTROL DATA PROPRIETARY PRODUCT WP101 00070F* WP101 0000080FKPFILE IPEAF 128 DISK WP101 00090FPARTMST IC F 300R12AI 1 DISK WP101 00100FLABMST IC F 48R 2AI 1 DISK WP101 00110FWTRANS O F 60 DISK WP101 00120F* WP101 00130F* THIS PROGRAM PERFORMS A PRE-EDIT ON THE WORK ORDER TRANSACTIONS. WP101 00140F* IT ALSO INSERTS SOME INFORMATION FROM THE MASTER PARTS OR MASTER WP101 0000150F* LABOR FILE IN SOME OF THE TRANSACTIONS. WP101 00160F* WP101 00170F* THIS DIFFERS FROM JOB100 IN THE FACT THAT NO OPERATION # WP101 00180F* IS CHECKED FOR IN TRANSACTIONS 54,56,57, & 59 WP101 00190F* IN THESE TRANSACTIONS A '999' IS INSERTED. WP101 00200F* TRANSACTIONS 55 AND 60 ARE FLAGGED AS INVALID WP101 00210F* WP101 0000220IKPFILE NS 01 1 C5 2 C1 WP101 00230I 1 20TC WP101 00240I 8 19 PARTNO WP101 00250I 1 55 REC1 WP101 00260I NS 02 1NC 2NC WP101 00270I 1 20TC WP101 00280I 8 100OPNUM WP101 0000290I 12 180QTY WP101 00300I 19 20 LABGRD WP101 00310I 27 38 PARTNO WP101 00320I 1 58 REC2 WP101 00330I NS 03 WP101 00340I 1 1 A WP101 00350IPARTMST NS 05 WP101 0000360I 75 813MAT WP101 00370I 110 1163LAB WP101 00380I 117 1233BUR WP101 00390I 124 1303OUTPR WP101 00400I 74 74 PDCODE WP101 00410ILABMST NS 07 WP101 00420I 23 293LRATE WP101 0000430I 31 341BURDNF WP101 00440I 30 30 LDCODE WP101 00450C Z-ADD0 ERRNO 20 WP101 00460C Z-ADD0 BURDNF WP101 00470C SETOF 80 WP101 00480C********************************************************************WP101 00490C* WP101 0000500C* TC NUMBERS MUST BE 51-63 WP101 00510C* WP101 00520C********************************************************************WP101 00530C 03 GOTO DEND WP101 00540C TC COMP 50 20 WP101 00550C 20 TC COMP 64 20 WP101 00560C 20 TC COMP 55 2020 WP101 0000570C 20 TC COMP 60 2020 WP101 00580C 20 TC COMP 61 2020 WP101 00590C N20 Z-ADD21 ERRNO 20 INVALID TC# WP101 00600C N20 GOTO DEND WP101 00610C********************************************************************WP101 00620C* WP101 00630C* PARTNO MUST BE ON THE MASTER FILE FOR TC 51 AND 58 WP101 0000640C* WP101 00650C********************************************************************WP101 00660C TC COMP 51 20 WP101 00670C N20 TC COMP 58 20 WP101 00680C N20 GOTO CHK57 WP101 00690C PARTNO CHAINPARTMST 55 WP101 00700C N55 PDCODE COMP 'D' 55 WP101 0000710C 55 Z-ADD22 ERRNO INVALID PART# WP101 00720C 55 GOTO DEND WP101 00730C********************************************************************WP101 00740C* WP101 00750C* TC 57 MUST HAVE A LABOR GRADE CODE WHICH IS ON THE LABOR MASTER WP101 00760C* RECORD. IF IT IS A VDLID LABOR GRADE THE THE LABOR DOLLARS WP101 00770C* ARE COMPUTED BY MULTIPLYING THE HOURS (QTY) BY THE RATE IN THE WP101 0000780C* LABOR MASTER FILE. BURDEN FACTOR IS PASSED FROM THE LABOR WP101 00790C* MASTER FILE TO THE WTRANS FILE. WP101 00800C* WP101 00810C********************************************************************WP101 00820C CHK57 TAG WP101 00830C TC COMP 57 80 WP101 00840C N80 GOTO CHK58 WP101 0000850C LABGRD CHAINLABMST 55 WP101 00860C N55 LDCODE COMP 'D' 55 WP101 00870C 55 Z-ADD23 ERRNO INVLD LABOR GRDWP101 00880C N55 QTY MULT LRATE DOLRS 60H WP101 00890C GOTO DEND WP101 00900C********************************************************************WP101 00910C* WP101 0000920C* TO 58 TAKES THE QUANTITY REPORTED IN 'QTY' AND EXTENDS IT BY WP101 00930C* THE TOTAL COST AS FOUND IN THE PARTMST FILE. WP101 00940C* WP101 00950C********************************************************************WP101 00960C CHK58 TAG WP101 00970C TC COMP 58 80 WP101 00980C N80 GOTO DEND WP101 0000990C LAB ADD MAT TOT 83 WP101 01000C TOT ADD BUR TOT WP101 01010C TOT ADD OUTPR TOT WP101 01020C QTY MULT TOT DOLRS H WP101 01030C DEND TAG WP101 01040OWTRANS D 01 WP101 01050O REC1 55 WP101 0001060O ERRNO 60 WP101 01070O D 02 WP101 01080O REC2 58 WP101 01090O 80 DOLRS 26 WP101 01100O BURDNF 54 WP101 01110O ERRNO 60 WP101 ** 00112000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001160/* 001170__0O ERRNO 60 WP101 ** 0011200(d}C *TXWP102 P999999111111(000010H S WP102 00020X DECK-ID P03 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP102 00030F* INITIALIZE WKOUT WITH < > IN POSITION 1 AND 2 WP102 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP102 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP102 00060F* CONTROL DATA PROPRIETARY PRODUCT WP102 00070F* WP102 0000080FWKDUM IP F 72 DISK WP102 00090FWKOUT UC F 128R DISK WP102 00100IWKDUM NS 02 WP102 00110I 1 1 A WP102 00120IWKOUT NS 01 WP102 00130I 1 128 REC WP102 00140C SETON LR99 WP102 0000150CLR LOOP TAG WP102 00160CLR RRN ADD 1 RRN 50 WP102 00170CLR RRN CHAINWKOUT 70 WP102 00180CLRN70 EXCPT WP102 00190CLRN70 GOTO LOOP WP102 00200OWKOUT E 99N70 WP102 00210O OR LRN70 WP102 0000220O REC 128 WP102 00230O 2 '<>' WP102 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' WP102 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(}n iTXWP103 P999999111111(000010H S WP103 00020X DECK-ID P04 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP103 00030F* RECOVERY PROGRAM FOR WKENT WP103 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP103 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP103 00060F* CONTROL DATA PROPRIETARY PRODUCT WP103 00070F* WP103 0000080FWKDUM UPE F 72 DISK WP103 00090FWKOUT IC F 128R DISK WP103 00100E MSG 1 5 35 WP103 00110IWKDUM NS 01 WP103 00120I 1 72 ALL WP103 00130IWKOUT NS 02 WP103 00140I 1 128 RCD WP103 0000150C SETOF 60 WP103 00160C SETON LR WP103 00170CLR MOVE ' ' B80 80 WP103 00180CLR EXSR ALMTS WP103 00190CLR Z-ADDLOW SEQNO 50 WP103 00200CLR LOOP TAG WP103 00210CLR SEQNO COMP HIGH 40 WP103 0000220CLR 40 GOTO A WP103 00230CLR SEQNO CHAINWKOUT 50 WP103 00240CLR 50 GOTO A WP103 00250CLR MOVELRCD TST 2 WP103 00260CLR TST COMP '<>' 51 WP103 00270CLRN51 SEQNO ADD 1 SEQNO WP103 00280CLRN51 GOTO LOOP WP103 0000290CLR A TAG WP103 00300CLR SEQNO SUB 1 SUBNO 50 WP103 00310CLR SUBNO CHAINWKOUT 50 WP103 00320CLR MOVELRCD BUFFER WP103 00330CLR MOVE 'T' TYPE WP103 00340CLR Z-ADD80 BLNGTH WP103 00350CLR EXSR CRTCOM WP103 0000360CLR MOVE RCD HOLD 48 WP103 00370CLR MOVE B80 BUFFER WP103 00380CLR MOVE 'T' TYPE WP103 00390CLR MOVELHOLD HOLD1 47 WP103 00400CLR MOVELHOLD HOLD2 42 WP103 00410CLR MOVELHOLD2 BUFFER WP103 00420CLR Z-ADD42 BLNGTH WP103 0000430CLR EXSR CRTCOM WP103 00440CLR MOVE B80 BUFFER WP103 00450CLR MOVELMSG,3 BUFFER WP103 00460CLR MOVE 'S' TYPE WP103 00470CLR Z-ADD35 BLNGTH WP103 00480CLR EXSR CRTCOM WP103 00490CLR MOVE B80 BUFFER WP103 0000500CLR MOVE HOLD1 HLDSEQ 5 WP103 00510CLR MOVELHLDSEQ BUFFER WP103 00520CLR MOVE 'T' TYPE WP103 00530CLR Z-ADD5 BLNGTH WP103 00540CLR EXSR CRTCOM WP103 00550CLR MOVELMSG,4 BUFFER WP103 00560CLR MOVE 'S' TYPE WP103 0000570CLR Z-ADD35 BLNGTH WP103 00580CLR EXSR CRTCOM WP103 00590CLR MOVE B80 BUFFER WP103 00600CLR MOVE 'A' TYPE WP103 00610CLR Z-ADD1 BLNGTH WP103 00620CLR EXSR CRTCOM WP103 00630CLR MOVE 'C' TYPE WP103 0000640CLR EXSR CRTCOM WP103 00650CLR MOVE 'F' TYPE WP103 00660CLR EXSR CRTCOM WP103 00670CSR ALMTS BEGSR WP103 00680CSR MOVE B80 BUFFER 80 WP103 00690CSR MOVE 'C' TYPE 1 WP103 00700CSR Z-ADD0 BLNGTH 20 WP103 0000710CSR MOVE ' ' RCODE 1 WP103 00720CSR Z-ADD0 MASK 10 WP103 00730CSR Z-ADD0 DTYPE 10 WP103 00740CSR EXSR CRTCOM WP103 00750CSR MOVELMSG,1 BUFFER WP103 00760CSR MOVE 'S' TYPE WP103 00770CSR Z-ADD35 BLNGTH WP103 0000780CSR EXSR CRTCOM WP103 00790CSR MOVE B80 BUFFER WP103 00800CSR MOVE 'A' TYPE WP103 00810CSR Z-ADD5 BLNGTH WP103 00820CSR Z-ADD1 DTYPE WP103 00830CSR EXSR CRTCOM WP103 00840CSR EXSR SKIP WP103 0000850CSR RCODE COMP 'R' 86 WP103 00860CSR EXSR AJ WP103 00870CSR MOVELBUFFER LOW 50 WP103 00880CSR MOVE B80 BUFFER WP103 00890CSR MOVELMSG,2 BUFFER WP103 00900CSR MOVE 'S' TYPE WP103 00910CSR Z-ADD35 BLNGTH WP103 0000920CSR EXSR CRTCOM WP103 00930CSR MOVE B80 BUFFER WP103 00940CSR MOVE 'A' TYPE WP103 00950CSR Z-ADD5 BLNGTH WP103 00960CSR Z-ADD1 DTYPE WP103 00970CSR EXSR CRTCOM WP103 00980CSR RCODE COMP 'R' 87 WP103 0000990CSR EXSR AJ WP103 01000CSR MOVELBUFFER HIGH 50 WP103 01010CSR MOVE 'C' TYPE WP103 01020CSR EXSR CRTCOM WP103 01030CSR 86 WP103 01040COR 87 GOTO ALMTS WP103 01050CSR Z-ADD0 DTYPE WP103 0001060CSR ENDSR WP103 01070CSR CRTCOM BEGSR WP103 01080CSR EXITFSUBRCM WP103 01090CSR RLABL BUFFER WP103 01100CSR RLABL TYPE WP103 01110CSR RLABL BLNGTH WP103 01120CSR RLABL RCODE WP103 0001130CSR RLABL MASK WP103 01140CSR RLABL DTYPE WP103 01150CSR ENDSR WP103 01160CSR SKIP BEGSR WP103 01170CSR MOVELBUFFER NBUF 1 WP103 01180CSR MOVEL' ' BUFFER WP103 01190CSR Z-ADD1 BLNGTH WP103 0001200CSR MOVE 'T' TYPE WP103 01210CSR EXSR CRTCOM WP103 01220CSR MOVELNBUF BUFFER WP103 01230CSR ENDSR WP103 01240CSR AJ BEGSR WP103 01250CSR MOVELBUFFER VAR 15 WP103 01260CSR Z-ADD5 VL 20 WP103 0001270CSR EXIT SUBRAJ WP103 01280CSR RLABL VL WP103 01290CSR RLABL VAR WP103 01300CSR MOVELVAR BUFFER WP103 01310CSR ENDSR WP103 01320OWKDUM D 60 WP103 01330O ALL 72 WP103 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(X} OTXWP200 P040678111111(000010H S WP200 00020X DECK-ID P05 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP200 00030F* OPEN WORKORDER TRANSACTION UPDATE PROGRAM WP200 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP200 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP200 00060F* CONTROL DATA PROPRIETARY PRODUCT WP200 00070F* WP200 0000080FSWTRAN UPEAF 60 DISK WP200 00090FWRKORD UC F 160R 5AI 1 DISK A WP200 00100FTRNWO1 O F 45 DISK WP200 00110FOHEXPL O F 50 DISK WP200 00120F* ID F C H L FUNCTION OF INDICATORS WP200 00130F* 01,02,05 RECORD IDENTIFYING INDICATORS WP200 00140F* 20,21 COMPARE INDICATORS WP200 0000150F* 54 OPNUM = '999' WP200 00160F* 55 NO HIT ON WRKORD FILE OR RECORD DELETED WP200 00170F* 56 OPEN BUT NOT RELEASED (STATUS = 'O') WP200 00180F* 57 RELEASED (STATUS = 'R') WP200 00190F* 58 CLOSED (STATUS = 'C') WP200 00200F* 59 DELETED (STATUS = 'D') WP200 00210F* 60 ADD WHEN RECORD IS PRESENT BUT DELETED WP200 0000220F* 80 OUTPUT WRKORD RECORD WP200 00230F* 88 OUTPUT OHEXPL RECORD WP200 00240F* 89 ADD TRANSAC RECORD WP200 00250F* 90 AT LEAST ONE VALID TRANSACTION FOR THIS WORK ORDER WP200 00260F*H1 INVALID TRANSACTION WP200 00270F********************************************************************WP200 00280F** WP200 0000290F** THIS PROGRAM UPDATES THE WRKORD FILE BY PROCESSING WORK WP200 00300F** ORDER TRANSACTIONS 51,52,53,58,62,63 AND 54,56,57,59 IF WP200 00310F** THE OPERATION # IS '999' ANY TRANSACTIONS WHICH HAVE AN ERROR WP200 00320F** CODE GREATER THAN 20 ARE IGNORED. WP200 00330F** THE TRANSACTION FILE IS READ IN SEQUENITALLY BY WORK ORDER #, WP200 00340F** TRANSACTION # AND 'WRKORD' IS UPDATED AT TOTAL L1 TIME WP200 00350F** WP200 0000360F** THE SWTRAN FILE IS UPDATED WITH AN ERROR CODE IF AN ERROR WP200 00370F** OR WARNING CONDITION IS ENCOUNTERED. WP200 00380F** WP200 00390F** INFORMATION AFFECTING THE 'PARTMST' FILE IS PASSED TO THE WP200 00400F** 'ITA' MODULE VIA INVENTORY TRANSACTIONS ADDED TO TRANSAC. WP200 00410F** WP200 00420ISWTRAN NS 02 1 C5 2 C1 WP200 0000430I 1 20TC WP200 00440I 3 70TWONUML1 WP200 00450I 8 31 TPRTNO WP200 00460I 32 32 TSTAT WP200 00470I 33 390TQTY WP200 00480I 40 450TRLSDT WP200 00490I 46 510TREQDT WP200 0000500I 52 54 TPRI WP200 00510I 55 55 TREQCD WP200 00520I 59 600TERR WP200 00530I NS 01 WP200 00540I 1 20TC WP200 00550I 3 70TWONUML1 WP200 00560I 8 100OPNUM WP200 0000570I 11 11 MTYPE WP200 00580I 12 180TQTY WP200 00590I 19 20 LABGRD WP200 00600I 21 260TDLRS WP200 00610I 27 50 TPRTNO WP200 00620I 51 541TBRDF WP200 00630I 55 570TOPER WP200 0000640I 58 58 TOMTYP WP200 00650I 59 600TERR WP200 00660IWRKORD NS 05 WP200 00670I 6 29 TP WP200 00680I 30 30 F1 WP200 00690I 31 370F2 WP200 00700I 38 440F3 WP200 0000710I 67 720F4 WP200 00720I 73 780F5 WP200 00730I 79 840F6 WP200 00740I 85 900F7 WP200 00750I 91 960F8 WP200 00760I 97 1010F9 WP200 00770I 102 1060F10 WP200 0000780I 107 1130F11 WP200 00790I 51 56 F12 WP200 00800C Z-ADD00 Z6 60 WP200 00810C Z-ADD0 Z5 50 WP200 00820C TERR COMP 20 20 WP200 00830C 20 GOTO DEND WP200 00840C Z-ADD0 ERRNO 20 WP200 0000850C NL1 GOTO CHKST WP200 00860C********************************************************************WP200 00870C* WP200 00880C* THIS SECTION CHAINS TO WRKORD AND MOVES THE INPUT FIELDS WP200 00890C* TO THE EVENTUAL OUTPUT FIELDS. THIS IS DONE BECAUSE THIS WP200 00900C* COMPILING WON'T ALLOW YOU UPDATE AT TOTAL TIME WITHOUT RE-READINGWP200 00910C* THE RECORD. WP200 0000920C* WP200 00930C********************************************************************WP200 00940C SETOF 90 WP200 00950C TWONUM CHAINWRKORD 55 WP200 00960C 55 GOTO CHKST WP200 00970C MOVE TP PARTNO WP200 00980C MOVE F1 STATUS 1 WP200 0000990C MOVE F2 QTY 70 WP200 01000C MOVE F3 QTYCOM 70 WP200 01010C MOVE F4 MAT$ 60 WP200 01020C MOVE F5 LAB$ 60 WP200 01030C MOVE F6 BUR$ 60 WP200 01040C MOVE F7 OPC$ 60 WP200 01050C MOVE F8 RWK$ 60 WP200 0001060C MOVE F9 LHRS 50 WP200 01070C MOVE F10 RHRS 50 WP200 01080C MOVE F11 SCRAP 70 WP200 01090C MOVE F12 REQDAT 60 WP200 01100C********************************************************************WP200 01110C* NOW WE CHECK THE STATUS OF THE WORK ORDER. IT CAN BE OPEN ('O'), WP200 01120C* RELEASED ('R'),CLOSED ('C'), OR DELETED ('D'). IF AN ORDER WP200 0001130C* IS DELETED THE 'NO-HIT' INDICATOR IS ALSO SET ON. WP200 01140C* WP200 01150C********************************************************************WP200 01160C CHKST TAG WP200 01170C L1 55 MOVE ' ' STATUS WP200 01180C STATUS COMP 'O' 56 WP200 01190C STATUS COMP 'R' 57 WP200 0001200C STATUS COMP 'C' 58 WP200 01210C STATUS COMP 'D' 59 WP200 01220C 59 SETON 55 WP200 01230C OPNUM COMP 999 54 WP200 01240C********************************************************************WP200 01250C TC COMP 51 20 WP200 01260C 20 GOTO TC51 WP200 0001270C TC COMP 52 20 WP200 01280C 20 GOTO TC52 WP200 01290C TC COMP 53 20 WP200 01300C 20 GOTO TC53 WP200 01310C TC COMP 54 20 WP200 01320C 20 GOTO TC54 WP200 01330C TC COMP 55 20 WP200 0001340C 20 GOTO DEND WP200 01350C TC COMP 56 20 WP200 01360C 20 GOTO TC56 WP200 01370C TC COMP 57 20 WP200 01380C 20 GOTO TC57 WP200 01390C TC COMP 58 20 WP200 01400C 20 GOTO TC58 WP200 0001410C TC COMP 59 20 WP200 01420C 20 GOTO TC59 WP200 01430C TC COMP 60 20 WP200 01440C 20 GOTO DEND WP200 01450C TC COMP 61 20 WP200 01460C 20 GOTO DEND WP200 01470C TC COMP 62 20 WP200 0001480C 20 GOTO TC62 WP200 01490C TC COMP 63 20 WP200 01500C 20 GOTO TC63 WP200 01510C BADTC TAG WP200 01520C SETON H1 WP200 01530C GOTO DEND WP200 01540C********************************************************************WP200 0001550C* WP200 01560C* TC 51 ADDS A NEW RECORD TO WRKORD. IF THE RECORD IS PRESENT AND WP200 01570C* NOT DELETED THEN THE TRANSACTION IS REJECTED. IF THE TRANSACTION WP200 01580C* STATUS IS 'R' THEN TC52 IS PROCESSED ALSO WP200 01590C********************************************************************WP200 01600C TC51 TAG WP200 01610C TREQDT COMP 0 2020 WP200 0001620C 20 Z-ADD26 ERRNO WP200 01630C TQTY COMP 0 2020 WP200 01640C 20 Z-ADD27 ERRNO WP200 01650C N55N59 Z-ADD25 ERRNO WP200 01660C 58 Z-ADD40 ERRNO WP200 01670C ERRNO COMP 0 20 WP200 01680C 20 GOTO DEND WP200 0001690C 59 SETON 60 ZERO VARIANCE WP200 01700C SETON 90 WP200 01710C MOVE TWONUM WONUM 50 WP200 01720C MOVE TPRTNO PARTNO 24 WP200 01730C MOVE 'O' STATUS WP200 01740C MOVE TQTY QTY WP200 01750C MOVE TRLSDT RLSDAT 60 WP200 0001760C MOVE TREQDT REQDAT 60 WP200 01770C MOVE TPRI PRI 3 WP200 01780C MOVE TREQCD REQCOD 1 WP200 01790C MOVE ' ' OOOCD 1 WP200 01800C Z-ADD0 QTYCOM WP200 01810C Z-ADD0 RRN 50 WP200 01820C Z-ADDZ6 MAT$ WP200 0001830C Z-ADDZ6 LAB$ WP200 01840C Z-ADDZ6 BUR$ WP200 01850C Z-ADDZ6 OPC$ WP200 01860C Z-ADDZ6 RWK$ WP200 01870C Z-ADDZ5 LHRS WP200 01880C Z-ADDZ5 RHRS WP200 01890C Z-ADD0 SCRAP WP200 0001900C Z-ADD60 ITRN 20 WP200 01910C Z-ADDQTY IQTY 70 WP200 01920C EXSR OUTRNS WP200 01930C TSTAT COMP 'R' 56 WP200 01940C 56 Z-ADD52 TC WP200 01950C 56 GOTO GOOD52 WP200 01960C GOTO DEND WP200 0001970C********************************************************************WP200 01980C* WP200 01990C* TC 52 RELEASES A WORK ORDER. THE PART# AND QTY ARE OUTPUT TO WP200 02000C* 'OHEXPL' WHICH IS USED TO EXPLODE THE PART # INTO A PICK LIST. WP200 02010C* WP200 02020C* IF THE TRANSACTION QUANTITY IS NON-ZERO, THE WRKORD QTY THEN WP200 02030C* AN ITA TRANSACTION IS CREATED WHICH WILL ADJUST STOCK ON ORDER. WP200 0002040C* WP200 02050C********************************************************************WP200 02060C TC52 TAG WP200 02070C N56 Z-ADD29 ERRNO WP200 02080C 55 Z-ADD28 ERRNO WP200 02090C 58 Z-ADD40 ERRNO WP200 02100C N56 WP200 0002110COR 55 WP200 02120COR 58 GOTO DEND WP200 02130C GOOD52 TAG WP200 02140C SETON 90 WP200 02150C MOVE 'R' STATUS WP200 02160C Z-ADDUDATE RLSDAT WP200 02170C MOVELPARTNO TPRTNO WP200 0002180C TQTY COMP 0 20 WP200 02190C N20 GOTO OUTEX WP200 02200C TQTY SUB QTY IQTY 70 WP200 02210C Z-ADDTQTY QTY 20 WP200 02220C Z-ADD64 ITRN WP200 02230C 20 EXSR OUTRNS WP200 02240C OUTEX TAG WP200 0002250C Z-ADDQTY EXQTY 70 20 WP200 02260C 20 EXSR OUTOHX WP200 02270C GOTO DEND WP200 02280C********************************************************************WP200 02290C* WP200 02300C* TC 53 CHANGES THE JOB QUANTITY. IF THE WORK ORDER HAS ALREADY WP200 02310C* BEEN RELEASED (STAUS = 'R'), THEN AN ENTRY IS ADDED TO 'OHEXPL' WP200 0002320C* TO EXPLODE OUT HTE DIFFERENCE IN COMPONENT STOCK-ON-HAND. WP200 02330C* WP200 02340C* IF THE WORK ORDER IS OPEN OR RELEASED THEN AN ITA TRANSACTION WP200 02350C* IS OUTPUT TO ADJUST THE STOCK ON ORDER. WP200 02360C* WP200 02370C********************************************************************WP200 02380C TC53 TAG WP200 0002390C QTYCOM ADD SCRAP TOTCOM 70 WP200 02400C TOTCOM COMP TQTY 20 WP200 02410C 20 Z-ADD30 ERRNO WP200 02420C 55 Z-ADD28 ERRNO WP200 02430C 58 Z-ADD40 ERRNO WP200 02440C 55 WP200 02450COR 58 WP200 0002460COR 20 GOTO DEND WP200 02470C SETON 90 WP200 02480C TQTY SUB QTY IQTY WP200 02490C MOVE TQTY QTY WP200 02500C Z-ADD64 ITRN WP200 02510C EXSR OUTRNS WP200 02520C* WP200 0002530C Z-ADDIQTY EXQTY 2020 WP200 02540C 57 20 EXSR OUTOHX WP200 02550C GOTO DEND WP200 02560C********************************************************************WP200 02570C* WP200 02580C* TC 54 PROCESSES COMPLETIONS. THE TRANSACTION QUANITY CAN BE WP200 02590C* NEGATIVE BUT CAN'T CAUSE THE WORK ORDER QUANTITY TO GO BELOW WP200 0002600C* ZERO. TWO ITA TRANSACTIONS ARE CREATED. ONE IS TO INCREMENT WP200 02610C* (OR DECREMENT) THE STOCK-ON-HAND AND THE OTHER IS TO DECREMENT WP200 02620C* THE STOCK-ON-ORDER. THESE TWO TRANSACTIONS ARE NOT COMBINED WP200 02630C* BECALUSE THE TWO ADJUSTEMNT QUANTITIES CAN BE DIFFERENT. WP200 02640C* WP200 02650C********************************************************************WP200 02660C TC54 TAG WP200 0002670C N54 GOTO DEND WP200 02680C QTYCOM ADD TQTY NEWQTY 70 20 WP200 02690C 20 Z-ADD31 ERRNO WP200 02700C 55 Z-ADD28 ERRNO WP200 02710C 20 WP200 02720COR 55 GOTO DEND WP200 02730C Z-ADDNEWQTY QTYCOM WP200 0002740C DOITR TAG WP200 02750C SETON 90 WP200 02760C QTYCOM ADD SCRAP TOTCOM 70 WP200 02770C QTY SUB TOTCOM IQTY 21 WP200 02780C IQTY ADD TQTY IQTY 20 WP200 02790C 20 Z-ADD0 IQTY WP200 02800C TQTY COMP IQTY 20 WP200 0002810C 20 Z-ADDTQTY IQTY WP200 02820C Z-ADD73 ITRN WP200 02830C EXSR OUTRNS WP200 02840C Z-ADDTQTY IQTY WP200 02850C Z-ADD72 ITRN WP200 02860C EXSR OUTRNS WP200 02870C 21 Z-ADD2 ERRNO WP200 0002880C 58 Z-ADD3 ERRNO WP200 02890C 58 Z-ADDUDATE RLSDAT WP200 02900C GOTO DEND WP200 02910C********************************************************************WP200 02920C TC56 TAG PROCESS SCRAP WP200 02930C N54 GOTO DEND REPORT WP200 02940C 55 Z-ADD28 ERRNO WP200 0002950C 55 GOTO DEND WP200 02960C SCRAP ADD TQTY SCRAP 20 WP200 02970C 20 TQTY ADD SCRAP TQTY WP200 02980C 20 Z-ADD0 SCRAP WP200 02990C Z-ADD56 TC WP200 03000C 20 Z-ADD4 ERRNO WP200 03010C GOTO DOITR WP200 0003020C********************************************************************WP200 03030C* WP200 03040C* TC 57 PROCESSES REPORTED LABOR. THE ACCUMULATED LABOR DOLLARS WP200 03050C* IS INCREMENTED.BY THE TRANSACTION DOLLARS. THE BURDEN DOLLARS WP200 03060C* IS INCREMENTED BY THE TRANSACTION DOLLARS MULITIPLIED BY THE WP200 03070C* TRANSACTION BURDEN FACTOR, WP200 03080C* WP200 0003090C* IF THE MATERIAL TYPE = 'R' IN THE TRANSACTION RECORD THEN WP200 03100C* THE REWORK DOLLARS FIELD IS UPDATED INSTEAD OF THE LABOR DOLLARS WP200 03110C* FIELD. WP200 03120C* WP200 03130C********************************************************************WP200 03140C TC57 TAG WP200 03150C N54 GOTO DEND WP200 0003160C 55 Z-ADD28 ERRNO WP200 03170C 55 GOTO DEND WP200 03180C 58 Z-ADD3 ERRNO WP200 03190C 58 Z-ADDUDATE RLSDAT WP200 03200C SETON 90 WP200 03210C TBRDF MULT TDLRS BURDEN 70 WP200 03220C BURDEN ADD BUR$ BUR$ 20 WP200 0003230C 20 Z-ADD0 BUR$ WP200 03240C 20 Z-ADD11 ERRNO WP200 03250C MTYPE COMP 'R' 20 WP200 03260C 20 GOTO RWORK WP200 03270C LHRS ADD TQTY LHRS 20 WP200 03280C 20 Z-ADD0 LHRS WP200 03290C 20 Z-ADD12 ERRNO WP200 0003300C LAB$ ADD TDLRS LAB$ 20 WP200 03310C 20 Z-ADD0 LAB$ WP200 03320C 20 Z-ADD5 ERRNO WP200 03330C GOTO DEND WP200 03340C RWORK TAG WP200 03350C RHRS ADD TQTY RHRS 20 WP200 03360C 20 Z-ADD0 RHRS WP200 0003370C 20 Z-ADD14 ERRNO WP200 03380C RWK$ ADD TDLRS RWK$ 20 WP200 03390C 20 Z-ADD0 RWK$ WP200 03400C 20 Z-ADD13 ERRNO WP200 03410C GOTO DEND WP200 03420C********************************************************************WP200 03430C* WP200 0003440C* TC 58 PROCESSES MATERILA ISSUED TO A WORK ORDER. THE TRANSACTION WP200 03450C* DOLLARS FIELD IS ADDED TO THE ACCUMULATED MATERIAL DOLLARS. WP200 03460C* WP200 03470C* AN ITA TRANSACTION IS OUTPUT WHICH ADJUSTS STOCK-ON-HAND WP200 03480C* WP200 03490C********************************************************************WP200 03500C TC58 TAG WP200 0003510C 55 Z-ADD28 ERRNO WP200 03520C 55 GOTO DEND WP200 03530C 58 Z-ADD3 ERRNO WP200 03540C 58 Z-ADDUDATE RLSDAT WP200 03550C MAT$ ADD TDLRS MAT$ 20 WP200 03560C 20 Z-ADD0 MAT$ WP200 03570C 20 Z-ADD6 ERRNO WP200 0003580C Z-ADDTQTY IQTY WP200 03590C Z-ADD63 ITRN WP200 03600C EXSR OUTRNS WP200 03610C SETON 90 WP200 03620C GOTO DEND WP200 03630C********************************************************************WP200 03640C* WP200 0003650C* TC 59 PROCESSES REPORTED OUTSIDE PROCESSING. OUTSIDE PROCESSING WP200 03660C* DOLLARS IS INCREMENTED BY THE TRANSACTION DOLLARS. WP200 03670C* WP200 03680C********************************************************************WP200 03690C TC59 TAG WP200 03700C N54 GOTO DEND WP200 03710C 55 Z-ADD28 ERRNO WP200 0003720C 55 GOTO DEND WP200 03730C 58 Z-ADD3 ERRNO WP200 03740C 58 Z-ADDUDATE RLSDAT WP200 03750C OPC$ ADD TDLRS OPC$ 20 WP200 03760C 20 Z-ADD0 OPC$ WP200 03770C 20 Z-ADD7 ERRNO WP200 03780C SETON 90 WP200 0003790C GOTO DEND WP200 03800C********************************************************************WP200 03810C* WP200 03820C* TC 62 MOVES A 'C' IN THE STATUS FIELD. IT ALSO ADDS AN ITA WP200 03830C* TRANSACTION IF THE WORK ORDER WAS CLOSED SHORT. THIS TRANSACTION WP200 03840C* ADJUSTS STOCK-ON-ORDER. WP200 03850C* WP200 0003860C********************************************************************WP200 03870C TC62 TAG WP200 03880C 55 Z-ADD28 ERRNO WP200 03890C 58 Z-ADD32 ERRNO WP200 03900C 55 WP200 03910COR 58 GOTO DEND WP200 03920C MOVE 'C' STATUS WP200 0003930C Z-ADDUDATE RLSDAT WP200 03940C QTY SUB QTYCOM IQTY WP200 03950C IQTY SUB SCRAP IQTY 20 WP200 03960C Z-ADD68 ITRN WP200 03970C 20 EXSR OUTRNS WP200 03980C SETON 90 WP200 03990C GOTO DEND WP200 0004000C********************************************************************WP200 04010C* WP200 04020C* TC 63 MARKS A WORK ORDER AS DELETED. THE TRANSACTION IS REJECTED WP200 04030C* IF THE QUANTITY COMPLETED FIELD IS GREATER THAN ZERO. WP200 04040C* WP200 04050C********************************************************************WP200 04060C TC63 TAG WP200 0004070C 55 Z-ADD28 ERRNO WP200 04080C QTYCOM COMP 0 20 WP200 04090C 20 Z-ADD33 ERRNO WP200 04100C 55 WP200 04110COR 20 GOTO DEND WP200 04120C MOVE 'D' STATUS WP200 04130C SETON 90 WP200 0004140C GOTO DEND WP200 04150C********************************************************************WP200 04160C DEND TAG WP200 04170C ERRNO COMP 0 87 WP200 04180C********************************************************************WP200 04190C* WP200 04200C* NOW WE ACCESS THE WORK ORDER RECORD AGAIN AND UPDATE IT WP200 0004210C* WP200 04220C********************************************************************WP200 04230CL1 90 TWONUM CHAINWRKORD 55 WP200 04240CL1 SETON 80 WP200 04250CL1 90 EXCPT WP200 04260CL1 SETOF 8060 WP200 04270C********************************************************************WP200 0004280C* WP200 04290C* THIS ROUTINE OUTPUTS A RECORD TO THE ON-HAND EXPLODE FILE. WP200 04300C* WP200 04310C********************************************************************WP200 04320CSR OUTOHX BEGSR WP200 04330CSR SETON 88 WP200 04340CSR EXCPT WP200 0004350CSR SETOF 88 WP200 04360CSR ENDSR WP200 04370C********************************************************************WP200 04380C* WP200 04390C* THIS ROUTINE OUTPUTS AN ITA TRANSACTION RECORD. THE REFERENCE WP200 04400C* NUMBER IS 'WO' FOLLOWED BY THE WORK ORDER # WP200 04410C* WP200 0004420C********************************************************************WP200 04430CSR OUTRNS BEGSR WP200 04440CSR TPRTNO COMP ' ' 20 WP200 04450CSR 20 MOVELPARTNO TPRTNO WP200 04460CSR MOVELTPRTNO PRTNUM 12 ONLY 12 IN ITA WP200 04470CSR MOVEL'WO' REFNO 7 WP200 04480CSR MOVE TWONUM REFNO WP200 0004490CSR SETON 89 WP200 04500CSR EXCPT ADD RECORD WP200 04510CSR SETOF 89 WP200 04520CSR ENDSR WP200 04530OWRKORD E 80N55 WP200 04540O STATUS 30 WP200 04550O QTY 37 WP200 0004560O QTYCOM 44 WP200 04570O RLSDAT 50 WP200 04580O MAT$ 72 WP200 04590O LAB$ 78 WP200 04600O BUR$ 84 WP200 04610O OPC$ 90 WP200 04620O RWK$ 96 WP200 0004630O LHRS 101 WP200 04640O RHRS 106 WP200 04650O SCRAP 113 WP200 04660O 60 Z6 119 WP200 04670O 60 Z6 125 WP200 04680O 60 Z6 131 WP200 04690O 60 Z6 137 WP200 0004700O 60 Z6 143 WP200 04710O 60 Z5 148 WP200 04720O 60 Z5 153 WP200 04730O EADD 80 55 WP200 04740O WONUM 5 WP200 04750O PARTNO 29 WP200 04760O STATUS 30 WP200 0004770O QTY 37 WP200 04780O QTYCOM 44 WP200 04790O RLSDAT 50 WP200 04800O REQDAT 56 WP200 04810O PRI 60 WP200 04820O REQCOD 57 WP200 04830O OOOCD 61 WP200 0004840O RRN 66 WP200 04850O MAT$ 72 WP200 04860O LAB$ 78 WP200 04870O BUR$ 84 WP200 04880O OPC$ 90 WP200 04890O RWK$ 96 WP200 04900O LHRS 101 WP200 0004910O RHRS 106 WP200 04920O SCRAP 113 WP200 04930O Z6 119 WP200 04940O Z6 125 WP200 04950O Z6 131 WP200 04960O Z6 137 WP200 04970O Z6 143 WP200 0004980O Z5 148 WP200 04990O Z5 153 WP200 05000OSWTRAN D 87 WP200 05010O ERRNO 60 WP200 05020OOHEXPL E 88 WP200 05030O TWONUM 5 WP200 05040O TPRTNO 29 WP200 0005050O TC 31 WP200 05060O EXQTY 38 WP200 05070O REQDAT 44 WP200 05080OTRNWO1 E 89 WP200 05090O PRTNUM 12 WP200 05100O ITRN 14 WP200 05110O IQTY 21 WP200 0005120O REFNO 28 WP200 05130O UDATE 34 WP200 ** 005140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00518000/* 005190__0O UDATE 34 WP200 ** 005140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0051800(d~ *TXWP290 P999999111111(000010H S WP290 00020X DECK-ID P24 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP290 00030F* BUILDS A TEMPORARY INDEX USED BY WP300 TO ACCESS OPERATION FILE WP290 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP290 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP290 00060F* CONTROL DATA PROPRIETARY PRODUCT WP290 00070F* WP290 0000080FWRKOPR IPEAF 90 DISK WP290 00090FTMPIND O F 13 8AI 1 DISK WP290 00100F* WP290 00110F* THIS PROGRAM BUILDS A TEMPORARY INDEX INTO WP290 00120F* THE WORK OPERATION FILE. THIS INDEX IS ONLY USED IN JOB300 WP290 00130F* WHEN MATERIAL IS MOVED TO A SPECIFIED OPERATION RATHER THAN WP290 00140F* TO THE NEXT SEQUENTIAL OPERATION. WP290 0000150F* WP290 00160IWRKOPR NS 01 WP290 00170I 1 50WONUM WP290 00180I 6 80OPNUM WP290 00190C RRN ADD 1 RRN 50 WP290 00200C WONUM COMP 99999 20 WP290 00210C 20 SETON LR WP290 0000220OTMPIND D 01 WP290 00230O WONUM 5 WP290 00240O OPNUM 8 WP290 00250O RRN 13 WP290 ** 000260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000270ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00028000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000290ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000300/* 000310__0O RRN 13 WP290 ** 000260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000270ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0002800(~ 9OTXWP300 P040678111111(000010H S WP300 00020X DECK-ID P20 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP300 00030F* OPEN WORKORDER OPERATION FILE TRANSACTION UPDATE PROGRAM WP300 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP300 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP300 00060F* CONTROL DATA PROPRIETARY PRODUCT WP300 00070F* WP300 0000080FSWTRAN UPEAF 60 DISK WP300 00090FWRKOPR UC F 90R DISK WP300 00100FWRKORD UC F 160R 5AI 1 DISK WP300 00110FNWKOPR UC F 90R DISK WP300 00120FTMPIND IC F 13R 8AI 1 DISK WP300 00130FROUTING IC F 85R DISK WP300 00140FPARTMST IC F 300R12AI 1 DISK WP300 0000150FDSPFIL D F 68 CONSOLE WP300 00160FTRNWO3 O F 45 DISK WP300 00170F* WP300 00180F* 1-13 RECORD INDICATORS WP300 00190F*20-22 GENERAL COMPARE INDICATORS WP300 00200F* 24 TC=52 WP300 00210F* 25 TC=60 WP300 0000220F* 30 'TO' OPERATION RECORD NOT FOUND WP300 00230F* 31 NOT 1ST TIME THROUGH ADD LOOP IN TC 52 WP300 00240F* 32 'TO' OPERATIONS' QTY QUEUED WENT NEGATIVE WP300 00250F* 34 'TO' MATERIAL TYPE IS NOT 'R' (REWORK) WP300 00260F* 33 'FROM' MATERIAL TYPE IS NOT 'R' (REWORK) WP300 00270F* 35 COMPLETIOON GOES TO ANOTHER OPERATION - NOT TO STOCK WP300 00280F* 50 END OF WRKOPR FILE WP300 0000290F* 54 END OF NEW WORK OPERATION FILE WP300 00300F* 55 NO HIT ON WRKORD FILE WP300 00310F* 56 WORK ORDER IS 'OPEN' WP300 00320F* 57 WORK ORDER IS 'RELEASED' WP300 00330F* 58 WORK ORDER IS 'CLOSED' WP300 00340F* 59 WORK ORDER HAS NON-BLANK OUT-OF-ORDER FLAG ON WP300 00350F*80-89 OUTPUT INDICATORS WP300 0000360F* 99 FIRST OPERATION RECORD HAS BEEN READ WP300 00370F* WP300 00380ISWTRAN NS 03 WP300 00390I 1 20TC WP300 00400I 3 70TWONUML1 WP300 00410I 8 100TOPNUM WP300 00420I 11 11 TMATTP WP300 0000430I 12 180TQTY WP300 00440I 21 260TDLRS WP300 00450I 32 32 TSTAT WP300 00460I 27 50 TPART WP300 00470I 51 541TBRDF WP300 00480I 55 570TTOOP WP300 00490I 58 58 TTMATT WP300 0000500I 59 600TERRNO WP300 00510IWRKOPR NS 01 WP300 00520I 1 50WONUM WP300 00530I 6 80OPNUM WP300 00540I 9 12 DEPT WP300 00550I 13 17 WRKSTA WP300 00560I 18 221PRDRT WP300 0000570I 23 250SETUP WP300 00580I 26 26 OUTPC WP300 00590I 27 330QTYQ WP300 00600I 34 400QTYC WP300 00610I 41 470RWKQ WP300 00620I 48 540RWKC WP300 00630I 55 600LAB$ WP300 0000640I 61 660RWK$ WP300 00650I 67 710LABHRS WP300 00660I 72 760RWKHRS WP300 00670I 77 830SCRAP WP300 00680I 84 84 LSTOP WP300 00690I 85 890RRN WP300 00700IPARTMST NS 11 WP300 0000710I 52 560RTRRN WP300 00720I 74 74 DCODE WP300 00730IROUTING NS 05 WP300 00740I 1 12 RPRTNO WP300 00750I 15 170ROPNUM WP300 00760I 38 423RPRDRT WP300 00770I 43 451RSETUP WP300 0000780I 49 53 RWRKST WP300 00790I 66 66 ROPCD WP300 00800I 82 82 RNOSTA WP300 00810IWRKORD NS 07 WP300 00820I 6 17 OPRTNO WP300 00830I 30 30 STATUS WP300 00840I 38 440OMQTYC WP300 0000850I 45 500OCLSDT WP300 00860I 61 61 OOOOCD WP300 00870I 31 370OMQTY WP300 00880I 73 780OMLAB$ WP300 00890I 85 900OMOUTP WP300 00900I 79 840OMBUR WP300 00910I 91 960OMRWK$ WP300 0000920I 97 1010OMLABH WP300 00930I 102 1060OMRWKH WP300 00940I 107 1130OMSCRP WP300 00950INWKOPR NS 09 WP300 00960I 1 90 REC WP300 00970I 27 330NQTYQ WP300 00980I 34 400NQTYC WP300 0000990I 41 470NRWKQ WP300 01000I 77 830NSCRAP WP300 01010ITMPIND NS 13 WP300 01020I 9 130TRN WP300 01030C Z-ADD0 ERRNO WP300 01040C TC COMP 51 2021 WP300 01050C 21 TSTAT COMP 'R' 2020 WP300 0001060C N20 TERRNO COMP 20 20 WP300 01070C N20 TC COMP 60 20 WP300 01080C N20 TC COMP 58 20 WP300 01090C N20 TOPNUM COMP 999 20 WP300 01100C 20 GOTO DEND WP300 01110C Z-ADDTWONUM WONUMK WP300 01120C L1 EXSR GETMWK WP300 0001130C L1 EXSR MOVWRK WP300 01140C 55 Z-ADD28 ERRNO 20 WP300 01150C 55 GOTO DEND WP300 01160C TC COMP 51 20 WP300 01170C 20 TSTAT COMP 'R' 20 WP300 01180C 20 Z-ADD52 TC WP300 01190C TC COMP 52 24 WP300 0001200C TC COMP 60 25 WP300 01210C CHKWO TAG WP300 01220C TWONUM COMP WONUM 202122 WP300 01230C 22 24 Z-ADD25 ERRNO WP300 01240C 22 24 GOTO DEND WP300 01250C 22 GOTO CHKOP WP300 01260C 21 GOTO CHKADD WP300 0001270C NXTWO TAG WP300 01280C EXSR OPROUT WP300 01290C EXSR GETWOP WP300 01300C GOTO CHKWO WP300 01310C CHKOP TAG WP300 01320C TOPNUM COMP OPNUM 202122 WP300 01330C 22 GOTO MATCH WP300 0001340C 21 GOTO CHKADD WP300 01350C GOTO NXTWO WP300 01360C CHKADD TAG WP300 01370C 25 GOTO TC60 WP300 01380C 24 GOTO TC52 WP300 01390C Z-ADD24 ERRNO WP300 01400C GOTO DEND WP300 0001410C MATCH TAG WP300 01420C TC COMP 60 20 WP300 01430C 20 Z-ADD39 ERRNO WP300 01440C 20 GOTO DEND WP300 01450C TC COMP 53 20 WP300 01460C 20 GOTO TC53 WP300 01470C TC COMP 54 20 WP300 0001480C 20 GOTO TC54 WP300 01490C TC COMP 55 20 WP300 01500C 20 GOTO TC55 WP300 01510C TC COMP 56 20 WP300 01520C 20 GOTO TC56 WP300 01530C TC COMP 57 20 WP300 01540C 20 GOTO TC57 WP300 0001550C TC COMP 59 20 WP300 01560C 20 GOTO TC59 WP300 01570C GOTO DEND WP300 01580C********************************************************************WP300 01590C* WP300 01600C* TC 52 IS USED TO RELEASE A WORK ORDER. A RECORD IS ADDED TO WP300 01610C* THE NEW WORK OPERATION FILE FOR EVERY STATUSABLE OPERATION IN THEWP300 0001620C* ROUTING FILE. THE ACCUMULATED FIELDS ARE SET TO ZERO. THE FIRST WP300 01630C* OPERATION HAS ITS QUANTITY QUEUED FIELD SET TO THE JOB QUANTITY WP300 01640C* AND THE LAST OPERATION HAS THE 'LAST OPERATION' FIELD SET TO 'X'.WP300 01650C* WP300 01660C********************************************************************WP300 01670C TC52 TAG WP300 01680C SETON 82 WP300 0001690C 58 Z-ADD40 ERRNO WP300 01700C 58 GOTO DEND WP300 01710C MOVELPRTNUM P12 12 WP300 01720C P12 CHAINPARTMST 54 WP300 01730C N54 DCODE COMP 'D' 54 WP300 01740C 54 Z-ADD22 ERRNO WP300 01750C 54 GOTO DEND WP300 0001760C RTRRN COMP 0 20 WP300 01770C N20 GOTO DEND WP300 01780C EXSR INIT WP300 01790C Z-ADDMQTY QTYQ WP300 01800C SETOF 31 WP300 01810C LOOP52 TAG WP300 01820C RTRRN CHAINROUTING 54 READ RTG REC WP300 0001830C 54 GOTO CHNEND WP300 01840C P12 COMP RPRTNO 20 WP300 01850C N20 GOTO CHNEND WP300 01860C RNOSTA COMP ' ' 2020 WP300 01870C 20 GOTO NXTOP NON-STATUS OPERWP300 01880C 31 EXSR OPROUT WP300 01890C 31 OFFSET ADD 1 OFFSET 50 WP300 0001900C 31 Z-ADD0 QTYQ WP300 01910C Z-ADDROPNUM TOPNUM WP300 01920C 1 DIV RPRDRT PRDRT WP300 01930C Z-ADDRSETUP SETUP WP300 01940C MOVELRWRKST WRKSTA WP300 01950C MOVELROPCD OUTPC WP300 01960C SETON 31 WP300 0001970C NXTOP TAG WP300 01980C RTRRN ADD 1 RTRRN WP300 01990C GOTO LOOP52 WP300 02000C CHNEND TAG WP300 02010C 31 EXSR OPROUT WP300 02020C 31 OFFSET ADD 1 OFFSET WP300 02030C SETOF 82 WP300 0002040C INRRN CHAINWRKOPR WP300 02050C GOTO DEND WP300 02060C********************************************************************WP300 02070C* WP300 02080C* TC 53 CHANGES THE QUANTITY QUEUED FIELD WP300 02090C* WP300 02100C********************************************************************WP300 0002110C TC53 TAG WP300 02120C 58 Z-ADD40 ERRNO WP300 02130C 58 GOTO DEND WP300 02140C Z-ADDTQTY QTYQ WP300 02150C SCRAP ADD QTYC TOT 70 WP300 02160C TOT COMP QTYQ 20 WP300 02170C 20 Z-ADD9 ERRNO WP300 0002180C GOTO DEND WP300 02190C********************************************************************WP300 02200C* WP300 02210C* TC 54 LOGS IN COPLETIONS. THE MATERIAL IS ASSUMED TO MOVE WP300 02220C* TO THE NEXT OPERATION IN SEQUENCE UNLESS A 'TO' OPERATION IS SPECWP300 02230C* WP300 02240C********************************************************************WP300 0002250C TC54 TAG WP300 02260C SETOF 35 WP300 02270C 58 Z-ADD3 ERRNO WP300 02280C 58 Z-ADDUDATE CLSDTE WP300 02290C QTYC ADD TQTY TEMP 70 20 WP300 02300C 20 Z-ADD34 ERRNO WP300 02310C 20 GOTO DEND WP300 0002320C TTOOP COMP 0 20 WP300 02330C 59N20 Z-ADD38 ERRNO WP300 02340C 59N20 GOTO DEND WP300 02350C TTOOP COMP 999 3535 WP300 02360C SETOF 3334 WP300 02370C 35 EXSR GNXTOP WP300 02380C N35 GOTO CHKMQ WP300 0002390C 30 Z-ADD36 ERRNO WP300 02400C 32 Z-ADD35 ERRNO WP300 02410C 30 WP300 02420COR 32 GOTO DEND WP300 02430C GOTO T541 WP300 02440C CHKMQ TAG WP300 02450C MQTYC ADD TQTY TEMP 20 WP300 0002460C 20 Z-ADD31 ERRNO WP300 02470C 20 GOTO DEND WP300 02480C T541 TAG WP300 02490C QTYC ADD TQTY QTYC WP300 02500C 35 GOTO DEND WP300 02510C T542 TAG WP300 02520C MQTYC ADD TQTY MQTYC WP300 0002530C MQTYC ADD MSCRAP TOTCOM 70 WP300 02540C MQTY SUB TOTCOM IQTY 70 21 WP300 02550C IQTY ADD TQTY IQTY 20 WP300 02560C 20 Z-ADD0 IQTY WP300 02570C TQTY COMP IQTY 20 WP300 02580C 20 Z-ADDTQTY IQTY WP300 02590C Z-ADD73 ITRN 20 WP300 0002600C EXSR OUTRNS WP300 02610C Z-ADDTQTY IQTY WP300 02620C Z-ADD72 ITRN WP300 02630C EXSR OUTRNS WP300 02640C 21 Z-ADD2 ERRNO WP300 02650C GOTO DEND WP300 02660C********************************************************************WP300 0002670C* WP300 02680C* TC 55 IS USED TO MOVE REWORK MATERIAL. WP300 02690C* OPERATION #'S MUST BE SUPPLIED. THE TYPE OF MATERIAL WP300 02700C* IS EITHER BLANK (FOR NORMAL) OR 'R' (FOR REWORK). BOTH WP300 02710C* OPERATIONS MUST NOT BE BLANK. WP300 02720C* WP300 02730C********************************************************************WP300 0002740C TC55 TAG WP300 02750C 58 Z-ADD3 ERRNO WP300 02760C 58 Z-ADDUDATE CLSDTE WP300 02770C TTOOP COMP 0 20 WP300 02780C 20 Z-ADD38 ERRNO WP300 02790C 20 GOTO DEND WP300 02800C TMATTP COMP 'R' 33 WP300 0002810C TTMATT COMP 'R' 34 WP300 02820C N33N34 Z-ADD37 ERRNO WP300 02830C N33N34 GOTO DEND WP300 02840C N33 QTYQ SUB TQTY TEMP 20 WP300 02850C 33 RWKC ADD TQTY TEMP 20 WP300 02860C 20 Z-ADD35 ERRNO WP300 02870C 20N33 Z-ADD34 ERRNO WP300 0002880C 20 GOTO DEND WP300 02890C 34 GOTO T551 WP300 02900C TTOOP COMP 999 20 WP300 02910C N20 GOTO T551 WP300 02920C MQTYC ADD TQTY TEMP 20 WP300 02930C 20 Z-ADD31 ERRNO WP300 02940C 20 GOTO DEND WP300 0002950C GOTO T552 WP300 02960C T551 TAG WP300 02970C EXSR GNXTOP WP300 02980C 30 Z-ADD36 ERRNO WP300 02990C 32 Z-ADD35 ERRNO WP300 03000C 30 WP300 03010COR 32 GOTO DEND WP300 0003020C T552 TAG WP300 03030C N33 QTYQ SUB TQTY QTYQ WP300 03040C 33 RWKC ADD TQTY RWKC WP300 03050C TTOOP COMP 999 20 WP300 03060C 20 GOTO T542 WP300 03070C GOTO DEND WP300 03080C********************************************************************WP300 0003090C* WP300 03100C* TC 56 IS USED TO LOG IN THE AMOUNT OF SCRAP TO THE OPERATION. WP300 03110C* WP300 03120C********************************************************************WP300 03130C TC56 TAG WP300 03140C SCRAP ADD TQTY SCRAP 20 WP300 03150C 20 Z-ADD4 ERRNO WP300 0003160C 20 Z-ADD0 SCRAP WP300 03170C QTYC ADD SCRAP TOTCOM WP300 03180C QTYQ COMP TOTCOM 21 WP300 03190C N20 21 Z-ADD9 ERRNO WP300 03200C 58 Z-ADDUDATE CLSDTE WP300 03210C 58 Z-ADD3 ERRNO WP300 03220C MSCRAP ADD TQTY MSCRAP 20 WP300 0003230C 20 Z-ADD4 ERRNO WP300 03240C 20 Z-ADD0 MSCRAP WP300 03250C GOTO DEND WP300 03260C********************************************************************WP300 03270C* WP300 03280C* TC 57 IS USED TO LOG IN THE AMOUNT OF LABOR HOURS AND DOLLARS WP300 03290C* FOR REWORK OR REGULAR. WP300 0003300C* WP300 03310C********************************************************************WP300 03320C TC57 TAG WP300 03330C 58 Z-ADDUDATE CLSDTE WP300 03340C 58 Z-ADD3 ERRNO WP300 03350C TMATTP COMP 'R' 20 WP300 03360C 20 GOTO RWK57 WP300 0003370C LAB$ ADD TDLRS LAB$ 20 WP300 03380C 20 Z-ADD5 ERRNO WP300 03390C 20 Z-ADD0 LAB$ WP300 03400C N32 MLAB$ ADD TDLRS MLAB$ 20 WP300 03410C 32 MOUTP$ ADD TDLRS MOUTP$ 20 WP300 03420C 20 Z-ADD5 ERRNO WP300 03430C 32 20 Z-ADD0 MOUTP$ WP300 0003440C 32 GOTO END57 WP300 03450C LABHRS ADD TQTY LABHRS 20 WP300 03460C 20 Z-ADD12 ERRNO WP300 03470C 20 Z-ADD0 LABHRS WP300 03480C MLABHR ADD TQTY MLABHR 20 WP300 03490C 20 Z-ADD12 ERRNO WP300 03500C 20 Z-ADD0 MLABHR WP300 0003510C TBRDF MULT TDLRS TDLRS WP300 03520C MBUR ADD TDLRS MBUR 20 WP300 03530C 20 Z-ADD11 ERRNO WP300 03540C 20 Z-ADD0 MBUR WP300 03550C GOTO END57 WP300 03560C RWK57 TAG WP300 03570C RWK$ ADD TDLRS RWK$ 20 WP300 0003580C 20 Z-ADD13 ERRNO WP300 03590C 20 Z-ADD0 RWK$ WP300 03600C RWKHRS ADD TQTY RWKHRS 20 WP300 03610C 20 Z-ADD14 ERRNO WP300 03620C 20 Z-ADD0 RWKHRS WP300 03630C MRWK$ ADD TDLRS MRWK$ 20 WP300 03640C 20 Z-ADD13 ERRNO WP300 0003650C 20 Z-ADD0 MRWK$ WP300 03660C MRWKHR ADD TQTY MRWKHR 20 WP300 03670C 20 Z-ADD14 ERRNO WP300 03680C 20 Z-ADD0 MRWKHR WP300 03690C END57 TAG WP300 03700C SETOF 32 WP300 03710C GOTO DEND WP300 0003720C********************************************************************WP300 03730C* WP300 03740C* TC 59 LOGS IN THE AMOUNT OF OUTSIDE PROCESSING WP300 03750C* WP300 03760C********************************************************************WP300 03770C TC59 TAG WP300 03780C SETON 32 WP300 0003790C MOVE ' ' TMATTP WP300 03800C GOTO TC57 WP300 03810C********************************************************************WP300 03820C* WP300 03830C* TC 60 ADDS AN OPERATION RECORD TO THE OPERATION FILE WP300 03840C* WP300 03850C********************************************************************WP300 0003860C TC60 TAG WP300 03870C EXSR INIT WP300 03880C SETON 82 WP300 03890C EXSR OPROUT WP300 03900C SETOF 82 WP300 03910C OFFSET ADD 1 OFFSET WP300 03920C INRRN CHAINWRKOPR WP300 0003930C GOTO DEND WP300 03940C********************************************************************WP300 03950C DEND TAG WP300 03960C ERRNO COMP 0 87 WP300 03970CL1 Z-ADDTWONUM WOUPD 50 WP300 03980CL1 EXSR MWKOUT WP300 03990CLR LRLOOP TAG WP300 0004000CLR EXSR OPROUT WP300 04010CLR 50 GOTO LEND WP300 04020CLR EXSR GETWOP WP300 04030CLR GOTO LRLOOP WP300 04040CLR LEND TAG WP300 04050C********************************************************************WP300 04060C* WP300 0004070C* THIS ROUTINE SETS THE OPERATION RECORD FIELDS TO 0 OR BLANK WP300 04080C* WP300 04090C********************************************************************WP300 04100CSR INIT BEGSR WP300 04110CSR Z-ADD0 PRDRT WP300 04120CSR Z-ADD0 SETUP WP300 04130CSR MOVE ' ' OUTPC WP300 0004140CSR Z-ADD0 QTYQ WP300 04150CSR Z-ADD0 QTYC WP300 04160CSR Z-ADD0 SCRAP WP300 04170CSR Z-ADD0 RWKQ WP300 04180CSR Z-ADD0 RWKC WP300 04190CSR Z-ADD0 LAB$ WP300 04200CSR Z-ADD0 RWK$ WP300 0004210CSR Z-ADD0 LABHRS WP300 04220CSR Z-ADD0 RWKHRS WP300 04230CSR MOVEL' ' LSTOP WP300 04240CSR MOVEL' ' DEPT WP300 04250CSR MOVEL' ' WRKSTA WP300 04260CSR ENDSR WP300 04270C********************************************************************WP300 0004280C* WP300 04290C* THIS ROUTINE READS THE NEXT RECORD FROM THE WORK OPERATION WP300 04300C* FILE. IF THE WORK ORDER NUMBER IS DIFFERENT FROM THE WP300 04310C* LAST ONE READ THEN THE WORK ORDER RECORD IS READ. WP300 04320C* WP300 04330C********************************************************************WP300 04340CSR GETWOP BEGSR WP300 0004350CSR NXTOPR TAG WP300 04360CSR INRRN ADD 1 INRRN 50 WP300 04370CSRN50 INRRN CHAINWRKOPR 50 WP300 04380CSR 50 GOTO ENDGW WP300 04390CSR WONUM COMP 99999 50 WP300 04400CSR 50 GOTO ENDGW WP300 04410CSR WONUM COMP LASTWO 20 WP300 0004420CSR 20 55 OFFSET SUB 1 OFFSET 50 WP300 04430CSR 20 55 GOTO NXTOPR WP300 04440CSR 20 GOTO ENDGW WP300 04450CSR Z-ADDWONUM WONUMK 50 WP300 04460CSR EXSR GETMWK WP300 04470CSR Z-ADDWONUM LASTWO WP300 04480CSR 55 OFFSET SUB 1 OFFSET WP300 0004490CSR 55 GOTO NXTOPR WP300 04500CSR ENDGW TAG WP300 04510CSR SETOF 55 WP300 04520CSR ENDSR WP300 04530C********************************************************************WP300 04540C* WP300 04550C* THIS ROUTINE READS THE WORK ORDER MASTER FILE. WP300 0004560C* WP300 04570C********************************************************************WP300 04580CSR GETMWK BEGSR WP300 04590CSR WONUMK CHAINWRKORD 55 WP300 04600CSRN55 STATUS COMP 'D' 55 WP300 04610CSR Z-ADDWONUMK LASTWO 50 WP300 04620CSR ENDSR WP300 0004630C********************************************************************WP300 04640C* WP300 04650C* THIS ROUTINE MOVES THE INPUT MASTER WORK ORDER FIELDS TO THE WP300 04660C* OUTPUT AND WORKING FIELDS. WP300 04670C* WP300 04680C********************************************************************WP300 04690CSR MOVWRK BEGSR WP300 0004700CSR STATUS COMP 'O' 56 OPEN WP300 04710CSR STATUS COMP 'R' 57 RELEASED WP300 04720CSR STATUS COMP 'C' 58 CLOSED WP300 04730CSR OOOOCD COMP ' ' 5959 WP300 04740CSR MOVE OMQTYC MQTYC 70 WP300 04750CSR MOVE OCLSDT CLSDTE 60 WP300 04760CSR MOVE OOOOCD OOOCD 1 WP300 0004770CSR MOVE OMQTY MQTY 70 WP300 04780CSR MOVE OMLAB$ MLAB$ 60 WP300 04790CSR MOVE OMOUTP MOUTP$ 60 WP300 04800CSR MOVE OMBUR MBUR 60 WP300 04810CSR MOVE OMRWK$ MRWK$ 60 WP300 04820CSR MOVE OMLABH MLABHR 50 WP300 04830CSR MOVE OMRWKH MRWKHR 50 WP300 0004840CSR MOVE OMSCRP MSCRAP 70 WP300 04850CSR MOVE OPRTNO PRTNUM 12 WP300 04860CSR ENDMWK ENDSR WP300 04870C********************************************************************WP300 04880C* WP300 04890C* THIS ROUTINE UPDATES THE LAST MASTER WORK ORDER RECORD READ. WP300 04900C********************************************************************WP300 0004910C* WP300 04920CSR MWKOUT BEGSR WP300 04930CSR WOUPD CHAINWRKORD 55 WP300 04940CSR SETON 85 WP300 04950CSRN55 EXCPT WP300 04960CSR SETOF 85 WP300 04970CSR ENDSR WP300 0004980C********************************************************************WP300 04990C* WP300 05000C* THIS ROUTINE OUTPUTS A RECORD TO THE NEW WORK OPERATION WP300 05010C* FILE. WP300 05020C* WP300 05030C********************************************************************WP300 05040CSR OPROUT BEGSR WP300 0005050CSRN99 GOTO ENDOUT WP300 05060CSR CRRN ADD 1 CRRN 50 WP300 05070CSR Z-ADDCRRN RRN WP300 05080CSR CRRN CHAINNWKOPR 54 WP300 05090CSR 54 EXSR ENDFIL WP300 05100CSR 54 GOTO ENDOUT WP300 05110CSR Z-ADDWONUM NEWWO 50 WP300 0005120CSR 82 Z-ADDTWONUM NEWWO WP300 05130CSR NEWWO COMP LSTWO 8686 WP300 05140CSR Z-ADDNEWWO LSTWO 50 WP300 05150CSR Z-ADDNEWWO WOUPD WP300 05160CSR 86 EXSR MWKOUT WP300 05170CSR SETOF 86 WP300 05180CSR SETON 80 WP300 0005190CSR EXCPT WP300 05200CSR SETOF 80 WP300 05210CSR ENDOUT TAG WP300 05220CSR SETON 99 WP300 05230CSR ENDSR WP300 05240C********************************************************************WP300 05250C* WP300 0005260C* THIS ROUTINE IS USED TO READ AND UPDATE THE NEXT OPERATION WP300 05270C* TO WHICH ITEMS ARE BEING MOVED. THE OPERATION RECORD MIGHT WP300 05280C* BE LOCATED IN THE NEW OPERATION FILE OR THE OLD ONE. THE CURRENT WP300 05290C* OPERATION RECORD IS SAVED BY OUTPUTING IT THEN READING IT WP300 05300C* BACK AFTER THE UPDATE IS DONE. WP300 05310C* WP300 05320C********************************************************************WP300 0005330CSR GNXTOP BEGSR WP300 05340CSR Z-ADDWONUM FROMWO 50 WP300 05350CSR SETOF 213522 WP300 05360CSR TTOOP COMP 0 20 WP300 05370CSRN20 GOTO NXTRN WP300 05380CSR TTOOP COMP OPNUM 202122 WP300 05390CSR 22 GOTO ADDIT WP300 0005400CSR MOVELWONUM KEY 80 WP300 05410CSR MOVE TTOOP KEY WP300 05420CSR KEY CHAINTMPIND 30 WP300 05430CSR 30 GOTO ENDGN WP300 05440CSR 21 TRN ADD OFFSET TRN WP300 05450CSR TRN SUB 1 TEMP WP300 05460CSR TEMP COMP INRRN 20 WP300 0005470CSRN20N34 MOVE 'X' OOOCD WP300 05480CSR SETON 35 WP300 05490CSR GOTO CHNIT WP300 05500CSR NXTRN TAG WP300 05510CSR INRRN ADD 1 TRN WP300 05520CSR CHNIT TAG WP300 05530CSR SETON 81 WP300 0005540CSR EXCPT OUTPUT CURRENT WP300 05550CSR SETOF 81 WP300 05560CSRN21 GOTO TGN1 WP300 05570CSR TRN CHAINNWKOPR 30 WP300 05580CSR MOVE NQTYQ QTYQ WP300 05590CSR MOVE NQTYC QTYC WP300 05600CSR MOVE NSCRAP SCRAP WP300 0005610CSR MOVE NRWKQ RWKQ WP300 05620CSR TGN1 TAG WP300 05630CSRN21 TRN CHAINWRKOPR 30 WP300 05640CSR 30 GOTO RSTWRK WP300 05650CSR WONUM COMP FROMWO 35 WP300 05660CSRN35 GOTO RSTWRK WP300 05670CSR ADDIT TAG WP300 0005680CSRN34 QTYQ ADD TQTY QTYQ 32 WP300 05690CSR 34 RWKQ ADD TQTY RWKQ 32 WP300 05700CSR 32 GOTO RSTWRK WP300 05710CSR QTYC ADD SCRAP TOTCOM WP300 05720CSR QTYQ COMP TOTCOM 20 WP300 05730CSR 20 Z-ADD9 ERRNO WP300 05740CSR 22 GOTO ENDGN WP300 0005750CSRN21 SETON 81 WP300 05760CSR 21 SETON 83 WP300 05770CSR EXCPT UPDATE 'TO' WP300 05780CSR SETOF 8183 WP300 05790CSR RSTWRK TAG WP300 05800CSR INRRN CHAINWRKOPR RESTORE CURRENTWP300 05810CSR ENDGN ENDSR WP300 0005820C********************************************************************WP300 05830C*** WP300 05840C***THIS ROUTINE OUTPUTS A RECORD TO THE INVENTORY TRANSACTION FILE. WP300 05850C***THESE TRANSACTIONS WILL BE PROCESSED IN THE 'ITA' SYSTEM. WP300 05860C*** WP300 05870C********************************************************************WP300 05880CSR OUTRNS BEGSR WP300 0005890CSR MOVEL'WO' REFNO 7 WP300 05900CSR MOVE WONUM REFNO WP300 05910CSR SETON 89 WP300 05920CSR EXCPT WP300 05930CSR SETOF 89 WP300 05940CSR ENDSR WP300 05950C********************************************************************WP300 0005960CSR ENDFIL BEGSR WP300 05970CSR MOVEL'FILE TOO'MESG 16 WP300 05980CSR MOVEL'SMALL 'MESG WP300 05990CSR MESG DSPLYDSPFIL WP300 06000CSR ENDSR WP300 06010C********************************************************************WP300 06020ONWKOPR E 80 WP300 0006030O N82 WONUM 5 WP300 06040O N82 OPNUM 8 WP300 06050O 82 TWONUM 5 WP300 06060O 82 TOPNUM 8 WP300 06070O WRKSTA 17 WP300 06080O PRDRT 22 WP300 06090O SETUP 25 WP300 0006100O OUTPC 26 WP300 06110O LSTOP 84 WP300 06120O RRN 89 WP300 06130O QTYQ 33 WP300 06140O QTYC 40 WP300 06150O RWKQ 47 WP300 06160O RWKC 54 WP300 0006170O LAB$ 60 WP300 06180O RWK$ 66 WP300 06190O LABHRS 71 WP300 06200O RWKHRS 76 WP300 06210O SCRAP 83 WP300 06220O CRRN 89 WP300 06230O E 83 WP300 0006240O REC 90 WP300 06250O QTYQ 33 WP300 06260O QTYC 40 WP300 06270O SCRAP 83 WP300 06280O RWKQ 47 WP300 06290OWRKOPR E 81 WP300 06300O WONUM 5 WP300 0006310O OPNUM 8 WP300 06320O DEPT 12 WP300 06330O WRKSTA 17 WP300 06340O PRDRT 22 WP300 06350O SETUP 25 WP300 06360O OUTPC 26 WP300 06370O QTYQ 33 WP300 0006380O QTYC 40 WP300 06390O RWKQ 47 WP300 06400O RWKC 54 WP300 06410O LAB$ 60 WP300 06420O RWK$ 66 WP300 06430O LABHRS 71 WP300 06440O RWKHRS 76 WP300 0006450O SCRAP 83 WP300 06460O LSTOP 84 WP300 06470O RRN 89 WP300 06480OSWTRAN D 87 WP300 06490O ERRNO 60 WP300 06500OTRNWO3 E 89 WP300 06510O PRTNUM 12 WP300 0006520O REFNO 28 WP300 06530O ITRN 14 WP300 06540O IQTY 21 WP300 06550O UDATE 34 WP300 06560OWRKORD E 85N86 WP300 06570O MQTYC 44 WP300 06580O MLAB$ 78 WP300 0006590O MBUR 84 WP300 06600O MOUTP$ 90 WP300 06610O MRWK$ 96 WP300 06620O MLABHR 101 WP300 06630O MRWKHR 106 WP300 06640O MSCRAP 113 WP300 06650O CLSDTE 50 WP300 0006660O OOOCD 61 WP300 06670O E 86 WP300 06680O CRRN 66 WP300 ** 006690ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 006700ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 006710ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00672000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 006730/* 006740__0O CRRN 66 WP300 ** 006690ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 006700ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 006710ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0067200(d8 *TXWP310 P999999111111(000010H S WP310 00020X DECK-ID P25 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP310 00030F* COPIES NEW WORK OPERATION FILE TO THE PERMANENT WRKOPR FILE WP310 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP310 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP310 00060F* CONTROL DATA PROPRIETARY PRODUCT WP310 00070F* WP310 0000080FNWKOPR IPEAF 90 DISK WP310 00090FWRKOPR OC F 90R DISK WP310 00100F* WP310 00110F* THIS PROGRAM COPIES THE UPDATED VERSION OF THE WORK OPERATION WP310 00120F* FILE TO THE OLD VERSION WP310 00130F* WP310 00140INWKOPR NS 01 WP310 0000150I 1 50WONUM WP310 00160I 1 90 REC WP310 00170C WONUM COMP 99999 20 WP310 00180C 20 SETON LR WP310 00190C RRN ADD 1 RRN 50 WP310 00200C RRN CHAINWRKOPR 55 WP310 00210OWRKOPR D 01N55 WP310 0000220O REC 90 WP310 ** 000230ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000240ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000250ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000260ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000270/* 00028000__0O REC 90 WP310 ** 000230ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000240ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000250ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000260ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000270/* 0002800(,c }OTXWP400 P999999111111(000010H S WP400 00020X DECK-ID P06 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP400 00030F* EXPLODES PART NUMBERS TO FIRST LEVEL INVENTIONED COMPONENTS WP400 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP400 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP400 00060F* CONTROL DATA PROPRIETARY PRODUCT WP400 00070F* WP400 0000080FOHEXPL IPEAF 50 DISK WP400 00090FBOMMST IC F 28R12AI 1 DISK WP400 00100FBOMSTR IC F 54R DISK WP400 00110FPARTMST UC F 300R12AI 1 DISK WP400 00120FTRNWO2 O F 45 DISK WP400 00130FPICK O F 85 DISK WP400 00140F* THIS PROGRAM EXPLODES THE PART NUMBERS ON 'OHEXPL' INTO 1ST LEVEL WP400 0000150F* COMPONENT PARTS. FOR EACH COMPONENT ENCOUNTERED AN INVENTORY WP400 00160F* TRANSACTION IS ADDED TO THE INVENTORY TRANSACTION FILE. THIS WP400 00170F* TRANSACTION DECREMENTS STOCK ON HAND. IF A PART ENCOUNTERED IN WP400 00180F* THE EXPLODE IS NOT AN INVENTORIED PART THE EXPLODE CONTINUES WP400 00190F* TO THE FIRST LEVEL COMPONENTS OF THE PART. WP400 00200F*** WP400 00210F* IF THE TRANSACTION NUMBER ON THE 'OHEXPL' FILE IS 52 THEN A WP400 0000220F* 'PICK' FILE RECORD IS OUTPUT FOR EVERY COMPONENT ENCOUNTERED WP400 00230F* IN THE EXPLODE WP400 00240F*** WP400 00250F* U1 - IF ON, THE STOCK ON HAND FIGURE IN PARTMST IS UPDATED TO WP400 00260F* REFLECT DRAW ON INVENTORY WP400 00270F* U2 - IF ON THE EXPLODE WILL CONTINUE DOWN IF THERE ARE AREN'T WP400 00280F* ENOUGH PARTS TO FILL PICK REQUIREMENT WP400 0000290E AP 26 24 WP400 00300E AQ 26 7 0 WP400 00310E AR 26 5 0 WP400 00320IOHEXPL NS 01 WP400 00330I 1 50WONUM WP400 00340I 6 17 PARTNO WP400 00350I 30 310TC WP400 0000360I 32 380QTY WP400 00370I 39 440DUEDAT WP400 00380IBOMMST NS 03 WP400 00390I 13 170RRNSTR WP400 00400IBOMSTR NS 05 WP400 00410I 1 12 PARENT WP400 00420I 13 24 COMPNT WP400 0000430I 25 313STRQTY WP400 00440I 32 360RRNREC WP400 00450I 37 410RRNDWN WP400 00460I 52 52 NXTCOD WP400 00470IPARTMST NS 07 WP400 00480I 74 74 DCODE WP400 00490I 51 51 INVCOD WP400 0000500I 13 36 DESC WP400 00510I 38 39 UM WP400 00520I 146 1520SOH WP400 00530I 167 1730ALLOC WP400 00540I 261 265 BINNO WP400 00550C MOVE ' ' BUFFER 72 WP400 00560C MOVE ' ' TYPE 1 WP400 0000570C Z-ADD0 MASK 10 WP400 00580C MOVE ' ' RCODE 1 WP400 00590C Z-ADD0 BLNGTH 20 WP400 00600C N01 GOTO DEND WP400 00610C TC COMP 52 70 WP400 00620C PARTNO CHAINBOMMST 55 WP400 00630C 55 EXSR IGNMSG WP400 0000640C 55 GOTO DEND WP400 00650C MOVELPARTNO PRNT 12 WP400 00660C Z-ADDQTY PQTY 70 WP400 00670C Z-ADDRRNSTR RRN 50 WP400 00680C SETON 81 WP400 00690C 70 EXCPT OUTPUT PARENT WP400 00700C SETOF 81 WP400 0000710C Z-ADD1 IND 20 WP400 00720C LOOP TAG WP400 00730C RRN COMP 0 20 WP400 00740C N20 GOTO SIBEND WP400 00750C RRN CHAINBOMSTR 56 WP400 00760C 56 EXSR BOMBIT WP400 00770C PRNT COMP PARENT 20 WP400 0000780C N20 GOTO SIBEND WP400 00790C NXTCOD COMP '1' 20 WP400 00800C RRN ADD 1 RRN WP400 00810C 20 Z-ADD0 RRN NEXT STR REC WP400 00820C STRQTY MULT PQTY EXQTY 70 WP400 00830C COMPNT CHAINPARTMST 55 WP400 00840C 55 EXSR BOMBIT WP400 0000850C INVCOD COMP 'N' 20 WP400 00860C 20 GOTO NXTDWN WP400 00870C Z-ADDSOH STOCK 70 WP400 00880C SOH SUB EXQTY SOH 20 WP400 00890C 20 ALLOC SUB SOH ALLOC WP400 00900C 20 Z-ADD0 SOH WP400 00910C NU2 WP400 0000920CORN20 GOTO OUTPUT WP400 00930C 0 SUB SOH EXQTY WP400 00940C NXTDWN TAG WP400 00950C RRNDWN COMP 0 2020 WP400 00960C 20 GOTO OUTPUT WP400 00970C Z-ADDPQTY AQ,IND WP400 00980C Z-ADDRRN AR,IND WP400 0000990C MOVELPRNT AP,IND WP400 01000C SETON 8182 WP400 01010C 70 EXCPT WP400 01020C SETOF 8182 WP400 01030C IND ADD 1 IND WP400 01040C IND COMP 26 20 WP400 01050C 20 EXSR BOMBIT WP400 0001060C Z-ADDRRNDWN RRN WP400 01070C Z-ADDEXQTY PQTY WP400 01080C MOVELCOMPNT PRNT WP400 01090C GOTO LOOP WP400 01100C SIBEND TAG WP400 01110C IND COMP 1 2020 WP400 01120C 20 GOTO DEND WP400 0001130C IND SUB 1 IND WP400 01140C MOVELAP,IND PRNT WP400 01150C Z-ADDAR,IND RRN WP400 01160C Z-ADDAQ,IND PQTY WP400 01170C GOTO LOOP WP400 01180C OUTPUT TAG WP400 01190C SETON 80 WP400 0001200C EXCPT WP400 01210C SETOF 80 WP400 01220C GOTO LOOP WP400 01230C DEND TAG WP400 01240C********************************************************************WP400 01250CSR IGNMSG BEGSR WP400 01260CSR Z-ADD12 BLNGTH WP400 0001270CSR MOVE 'T' TYPE WP400 01280CSR MOVELPARTNO BUFFER WP400 01290CSR EXITFSUBRCM WP400 01300CSR RLABL BUFFER 72 WP400 01310CSR RLABL TYPE 1 WP400 01320CSR RLABL BLNGTH 20 WP400 01330CSR RLABL RCODE 1 WP400 0001340CSR RLABL MASK 10 WP400 01350CSR RLABL DTYPE 10 WP400 01360CSR Z-ADD16 BLNGTH WP400 01370CSR MOVEL'NO COMPO'WORD16 16 WP400 01380CSR MOVE 'ONENTS 'WORD16 WP400 01390CSR MOVELWORD16 BUFFER WP400 01400CSR EXITFSUBRCM WP400 0001410CSR RLABL BUFFER 72 WP400 01420CSR RLABL TYPE 1 WP400 01430CSR RLABL BLNGTH 20 WP400 01440CSR RLABL RCODE 1 WP400 01450CSR RLABL MASK 10 WP400 01460CSR RLABL DTYPE 10 WP400 01470CSR ENDSR WP400 0001480C********************************************************************WP400 01490CSR BOMBIT BEGSR WP400 01500CSR MOVE 'R' TYPE WP400 01510CSR MOVEL'BOM FILE'WORD16 WP400 01520CSR MOVE ' ERROR 'WORD16 WP400 01530CSR MOVELWORD16 BUFFER WP400 01540CSR Z-ADD1 MASK WP400 0001550CSR EXITFSUBRCM WP400 01560CSR RLABL BUFFER 72 WP400 01570CSR RLABL TYPE 1 WP400 01580CSR RLABL BLNGTH 20 WP400 01590CSR RLABL RCODE 1 WP400 01600CSR RLABL MASK 10 WP400 01610CSR RLABL DTYPE 10 WP400 0001620CSR ENDSR WP400 01630C********************************************************************WP400 01640OTRNWO2 E 80 WP400 01650O COMPNT 12 WP400 01660O 14 '62' WP400 01670O EXQTY 21 WP400 01680O 23 'WO' WP400 0001690O WONUM 28 WP400 01700O UDATE 34 WP400 01710O U1 45 '1' WP400 01720OPICK E 81 WP400 01730O OR 80 70 WP400 01740O 81 1 'P' WP400 01750O 82 1 'N' WP400 0001760O WONUM 6 WP400 01770O PARTNO 18 WP400 01780O 80 COMPNT 18 WP400 01790O DESC 54 WP400 01800O UM 56 WP400 01810O BINNO 61 WP400 01820O QTY 68 WP400 0001830O DUEDAT 74 WP400 01840O 80 STRQTY 68 WP400 01850O 80 EXQTY 75 WP400 01860O IND 77 WP400 01870O STOCK 84 WP400 01880OPARTMST E 80 U1 WP400 01890O SOH 152 WP400 0001900O ALLOC 173 WP400 ** 001910ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001920ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001930ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001940ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001950/* 00196000__0O ALLOC 173 WP400 ** 001910ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001920ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001930ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001940ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001950/* 0019600( dTOTXWP410 P999999111111(000010H S WP410 00020X DECK-ID P07 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP410 00030F* PRINTS PICK LIST WP410 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP410 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP410 00060F* CONTROL DATA PROPRIETARY PRODUCT WP410 00070F* WP410 0000080FPICK IPEAF 85 DISK WP410 00090FHEADING IT F 40 EDISK WP410 00100F$LP1 O F 132 OF PRINTER WP410 00110F* WP410 00120F* THIS PROGRAM PRINTS THE PICK LIST REPORT FOR EVERY WONUM ON WP410 00130F* THE 'PICK' FILE WP410 00140F* WP410 0000150E HEADING HEAD 1 1 40 WP410 00160IPICK NS 01 1 CP WP410 00170I OR 02 1NCP WP410 00180I 1 1 TYPE WP410 00190I 2 60WONUM L1 WP410 00200I 7 30 PARTNO WP410 00210I 31 54 DESC WP410 0000220I 55 56 UM WP410 00230I 57 610BINNO WP410 00240I 62 680QTY 01 WP410 00250I 69 740DUEDAT 01 WP410 00260I 62 683STRQTY 02 WP410 00270I 69 750EXQTY 02 WP410 00280I 76 770IND 02 WP410 0000290I 78 840SOH 02 WP410 00300C TYPE COMP 'N' 80 WP410 00310C Z-ADDEXQTY ISSAMT 70 WP410 00320C Z-ADDSOH MSOH 70 20 WP410 00330C 20 Z-ADD0 MSOH WP410 00340C EXQTY SUB MSOH SHORT 70 20 WP410 00350C 20 Z-ADD0 SHORT WP410 0000360C N20 Z-ADDMSOH ISSAMT WP410 00370O$LP1 D 02 L1 WP410 00380O HEAD 86 WP410 00390O D 2 L1 WP410 00400O 20 'PICK LIST FOR W.O.#' WP410 00410O WONUM Z 27 WP410 00420O 38 'PART #' WP410 0000430O PARTNO 64 WP410 00440O 81 'QUANTITY :' WP410 00450O QTY J 93 WP410 00460O 100 'UM:' WP410 00470O UM 103 WP410 00480O 132 'JOB410' WP410 00490O D 1 L1 WP410 0000500O 36 'DESC' WP410 00510O DESC 64 WP410 00520O 81 'DUE DATE :' WP410 00530O DUEDATY 92 WP410 00540O UDATE Y 132 WP410 00550O D 2 L1 WP410 00560O 15 'LVL COMPONENT #' WP410 0000570O 40 'DESCRIPTION' WP410 00580O 66 'UM QTY/PER' WP410 00590O 86 'EXTENDED BIN #' WP410 00600O 111 'ISSUE ISSUE' WP410 00610O 132 'SOH SHORT' WP410 00620O D 1 L1 WP410 00630O 66 'UNIT' WP410 0000640O 77 'QTY' WP410 00650O 111 'AMOUNT ADJUSTMENT' WP410 00660O 132 'SHORT ADJUST' WP410 00670O D 1 L1 WP410 00680O 111 '*-----------*----------*' WP410 00690O 132 '*-----------*--------*' WP410 00700O D 1 02 WP410 0000710O IND Z 2 WP410 00720O PARTNO 27 WP410 00730O DESC 53 WP410 00740O 80 53 '*NI*' WP410 00750O UM 55 WP410 00760O STRQTYJ 67 WP410 00770O EXQTY J 78 WP410 0000780O BINNO Z 86 WP410 00790O 88 '*' WP410 00800O NU1 ISSAMT2 98 WP410 00810O 100 '*' WP410 00820O 111 '*' WP410 00830O 123 '*' WP410 00840O SHORT 2 121 WP410 0000850O 132 '*' WP410 00860O D 1 02 WP410 00870O 111 '*-----------*----------*' WP410 00880O 132 '*-----------*--------*' WP410 00890O T 2 L1 WP410 00900O 28 'FILLED BY ___________' WP410 00910O 52 '__________ DATE_________' WP410 0000920O T 2 L1 WP410 00930O 28 'APPROVED BY ___________' WP410 00940O 52 '__________ DATE_________' WP410 ** 000950ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000960ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000970ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00098000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000990/* 001000__0O 52 '__________ DATE_________' WP410 ** 000950ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000960ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000970ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0009800(6 NTOTXWP450 P040678111111(000010H S WP450 00020X DECK-ID P08 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP450 00030F* UPDATE WORKORDER STORTAGE FILE WP450 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP450 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP450 00060F* CONTROL DATA PROPRIETARY PRODUCT WP450 00070F* WP450 0000080FPICK IPEAF 85 DISK WP450 00090FSWTRAN ISEAF 60 DISK WP450 00100FWOSHORT UC F 36R29AI 1 DISK A WP450 00110F* WP450 00120F* THIS PROGRAM UPDATES THE SHORTAGE FILE BY PROCESSING NEW WP450 00130F* PICK LIST RECORDS WHICH ARE SHORT AND ISSUE TRANSACTIONS WP450 00140F* WP450 0000150IPICK NS 01 1NCP 1NCN WP450 00160I 2 30 KEY WP450 00170I 69 750REQ WP450 00180I 78 840SOH WP450 00190I NS 02 WP450 00200I 1 1 A WP450 00210ISWTRAN NS 05 1NC5 WP450 0000220I OR 2NC8 WP450 00230I 1 1 A WP450 00240I NS 06 WP450 00250I 3 70WONUM WP450 00260I 27 50 PARTNO WP450 00270I 12 180QTY WP450 00280I 59 600ERRNO 15 WP450 0000290IWOSHORT NS 09 WP450 00300I 30 360SHORT WP450 00310C 02 WP450 00320COR 05 WP450 00330COR 06 15 GOTO DEND WP450 00340C********************************************************************WP450 00350C* WP450 0000360C* HERE WE PROCESS THE PICK LIST RECORDS. IF THE AMOUNT REQUIRED WP450 00370C* IS GREATER THAN THE STOCK ON HAND,THEN WE HAVE A STOCK SHORTAGE WP450 00380C* FOR THIS WORK ORDER WP450 00390C* WP450 00400C********************************************************************WP450 00410C 06 GOTO D6 WP450 00420C KEY CHAINWOSHORT 55 WP450 0000430C N55 GOTO DEND A WP450 00440C Z-ADDSOH MSOH 70 20 WP450 00450C 20 Z-ADD0 MSOH WP450 00460C REQ SUB MSOH SHORT 80 WP450 00470C 80 EXCPT WP450 00480C SETOF 80 WP450 00490C GOTO DEND WP450 0000500C********************************************************************WP450 00510C* WP450 00520C* HERE WE PROCESS ISSUES TO A WORK ORDER. IF THE W.O.-PART # WP450 00530C* RECORD IS ON THE FILE THEN WE DECREMENT THE AMOUNT SHORT WP450 00540C* WP450 00550C********************************************************************WP450 00560C D6 TAG WP450 0000570C MOVELWONUM KEY WP450 00580C MOVE PARTNO KEY WP450 00590C KEY CHAINWOSHORT 55 WP450 00600C 55 GOTO DEND WP450 00610C SHORT SUB QTY SHORT 20 WP450 00620C 20 Z-ADD0 SHORT WP450 00630C SETON 81 WP450 0000640C EXCPT WP450 00650C SETOF 81 WP450 00660C********************************************************************WP450 00670C DEND TAG WP450 00680OWOSHORT E 81 WP450 00690O SHORT 36 WP450 00700O EADD 80 WP450 0000710O KEY 29 WP450 00720O SHORT 36 WP450 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00077000/* 000780__0O SHORT 36 WP450 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0007700(d <*OTXWP460 P999999111111(000010H S WP460 00020X DECK-ID P09 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP460 00030F* PRINTS WORKORDER STORTAGE REPORT BY WORKORDER NUMBER WP460 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP460 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP460 00060F* CONTROL DATA PROPRIETARY PRODUCT WP460 00070F* WP460 0000080FWOSHORT IPEAF 36 29AI 1 DISK WP460 00090FHEADING IT F 40 EDISK WP460 00100F$LP1 O F 132 OF PRINTER WP460 00110FPARTMST IC F 300R12AI 1 DISK WP460 00120FPRTWOS O F 36 29AI 1 DISK U U1 WP460 00130E HEADING HEAD 1 1 40 WP460 00140IWOSHORT NS 01 WP460 0000150I 1 50WONUM L1 WP460 00160I 6 29 PARTNO WP460 00170I 6 17 PRTNUM WP460 00180I 30 360QTY 15 WP460 00190IPARTMST NS 02 WP460 00200I 13 37 DESC WP460 00210I 38 39 UM WP460 0000220I 74 74 DCODE WP460 00230C PRTNUM CHAINPARTMST 55 WP460 00240C N55 DCODE COMP 'D' 55 WP460 00250O$LP1 H 02 1P WP460 00260O OR OF WP460 00270O 4 'PAGE' WP460 00280O PAGE Z 9 WP460 0000290O HEAD 86 WP460 00300O 132 'JOB460' WP460 00310O H 1 1P WP460 00320O OR OF WP460 00330O 47 'RELEASED' WP460 00340O 72 'WORK ORDER SHORTAGE REPO' WP460 00350O 90 'RT - BY WORK ORDER' WP460 0000360O H 21 1P WP460 00370O OR OF WP460 00380O 14 'W.O.# PART #' WP460 00390O 44 'DESCRIPTION' WP460 00400O 65 'UM' WP460 00410O 80 'QTY SHORT' WP460 00420O D 1 L1 WP460 0000430O 1 ' ' WP460 00440O D 1 01 15 WP460 00450O WONUM 5 WP460 00460O PARTNO 32 WP460 00470O N55 DESC 60 WP460 00480O 55 36 'NOT ON PART MASTER FILE ' WP460 00490O N55 UM 65 WP460 0000500O QTY 1 80 WP460 00510OPRTWOS D 01 15 U1 WP460 00520O PARTNO 24 WP460 00530O WONUM 29 WP460 00540O QTY 36 WP460 ** 000550ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00056000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000570ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000580ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000590/* 000600__0O QTY 36 WP460 ** 000550ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0005600( CTOTXWP470 P999999111111(000010H S WP470 00020X DECK-ID P10 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP470 00030F* PRINTS WORKORDER STORTAGE REPORT BY PART NUMBER WP470 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP470 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP470 00060F* CONTROL DATA PROPRIETARY PRODUCT WP470 00070F* WP470 0000080FPRTWOS IPEAF 36 29AI 1 DISK WP470 00090FHEADING IT F 40 EDISK WP470 00100FPARTMST IC F 300R12AI 1 DISK WP470 00110F$LP1 O F 132 OF PRINTER WP470 00120FWOSHORT O F 36 29AI 1 DISK U U1 WP470 00130E HEADING HEAD 1 1 40 WP470 00140IPRTWOS NS 01 WP470 0000150I 1 24 PARTNOL1 WP470 00160I 1 12 PRTNUM WP470 00170I 25 290WONUM WP470 00180I 30 360QTY WP470 00190IPARTMST NS 02 WP470 00200I 13 37 DESC WP470 00210I 38 39 UM WP470 0000220I 74 74 DCODE WP470 00230C L1 SETOF 60 WP470 00240C L1 Z-ADD0 TQTY 80 WP470 00250C NL1 SETON 60 WP470 00260C QTY ADD TQTY TQTY WP470 00270C NL1 GOTO DEND WP470 00280C PRTNUM CHAINPARTMST 55 WP470 0000290C N55 DCODE COMP 'D' 55 WP470 00300C DEND TAG WP470 00310O$LP1 H 02 1P WP470 00320O OR OF WP470 00330O 4 'PAGE' WP470 00340O PAGE Z 9 WP470 00350O HEAD 86 WP470 0000360O 132 'JOB470' WP470 00370O H 1 1P WP470 00380O OR OF WP470 00390O 47 'RELEASED' WP470 00400O 72 'WORK ORDER SHORTAGE REPO' WP470 00410O 91 'RT - BY PART NUMBER' WP470 00420O H 22 1P WP470 0000430O OR OF WP470 00440O 6 'PART #' WP470 00450O 36 'DESCRIPTION' WP470 00460O 55 'UM' WP470 00470O 85 'W.O.# QTY SHORT' WP470 00480O D 1 01 WP470 00490O PARTNO 24 WP470 0000500O N55 DESC 50 WP470 00510O 55 26 'NOT ON PART MASTER FILE ' WP470 00520O N55 UM 55 WP470 00530O WONUM 71 WP470 00540O QTY 1 85 WP470 00550O T 1 L1 60 WP470 00560O 15 '** TOTAL' WP470 0000570O TQTY 1 85 WP470 00580OWOSHORT D 01 U1 WP470 00590O WONUM 5 WP470 00600O PARTNO 29 WP470 00610O QTY 36 WP470 ** 000620ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00063000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000640ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000650ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000660/* 000670__0O QTY 36 WP470 ** 000620ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0006300( MTOTXWP500 P999999111111(000010H S WP500 00020X DECK-ID P11 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP500 00030F* PRINTS DAILY CLOSED JOB REPORT WP500 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP500 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP500 00060F* CONTROL DATA PROPRIETARY PRODUCT WP500 00070F* WP500 0000080FSWTRAN IPEAF 60 DISK WP500 00090FHEADING IT F 40 EDISK WP500 00100FWRKORD IC F 160R 5AI 1 DISK WP500 00110F$LP1 O F 132 OF PRINTER WP500 00120F* WP500 00130F* THIS PROGRAM LISTS THE JOBS CLOSED TODAY. IT DOES THIS BY WP500 00140F* LISTING ALL WORK ORDES WHICH HAD A 62 TRANSACTION PROCESSED WP500 0000150F* AND NO ERROR GENERATED. WP500 00160F* WP500 00170E HEADING HEAD 1 1 40 WP500 00180ISWTRAN NS 01 1 C6 2 C2 WP500 00190I 3 70WONUM WP500 00200I 59 600ERRCOD WP500 00210I NS 02 WP500 0000220I 1 1 A WP500 00230IWRKORD NS 03 WP500 00240I 6 29 PARTNO WP500 00250I 31 370JOBQTY WP500 00260I 38 440QTYCOM WP500 00270I 51 560REQDAT WP500 00280I 107 1130SCRAP WP500 0000290C SETOF 80 WP500 00300C N01 GOTO DEND WP500 00310C ERRCOD COMP 19 20 WP500 00320C 20 GOTO DEND WP500 00330C WONUM CHAINWRKORD H1 WP500 00340C H1 GOTO DEND WP500 00350C JOBQTY SUB QTYCOM QTYREM 70 WP500 0000360C QTYREM SUB SCRAP QTYREM 20 WP500 00370C 20 Z-ADD0 QTYREM WP500 00380C JOBS ADD 1 JOBS 50 WP500 00390C SETON 80 WP500 00400C DEND TAG WP500 00410O$LP1 H 02 1P WP500 00420O OR OF WP500 0000430O HEAD 86 WP500 00440O H 1 1P WP500 00450O OR OF WP500 00460O 4 'PAGE' WP500 00470O PAGE Z 9 WP500 00480O 78 'DAILY CLOSED JOB REPORT' WP500 00490O UDATE Y 89 WP500 0000500O 132 'JOB500' WP500 00510O H 2 1P WP500 00520O OR OF WP500 00530O 15 'W.O. # PART #' WP500 00540O 52 'JOB QTY' WP500 00550O 84 'QTY REQUIRED SCRAP' WP500 00560O H 11 1P WP500 0000570O OR OF WP500 00580O 53 'QTY COMPLT' WP500 00590O 63 'REMAIN' WP500 00600O 84 'DATE AMOUNT' WP500 00610O D 1 01 80 WP500 00620O WONUM Z 5 WP500 00630O PARTNO 30 WP500 0000640O JOBQTYJ 43 WP500 00650O QTYCOMJ 53 WP500 00660O QTYREMJ 64 WP500 00670O REQDATY 74 WP500 00680O SCRAP J 85 WP500 00690O T 3 L1 WP500 00700O JOBS Z 6 WP500 0000710O 19 'JOBS CLOSED' WP500 ** 000720ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000730ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000740ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000750ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000760/* 00077000__0O 19 'JOBS CLOSED' WP500 ** 000720ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000730ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000740ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000750ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000760/* 0007700(` TOTXWP510 P040678111111(000010H S WP510 00020X DECK-ID P12 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP510 00030F* PRINTS TRANSACTION REGISTER WP510 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP510 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP510 00060F* CONTROL DATA PROPRIETARY PRODUCT WP510 00070F* WP510 0000080FSWTRAN IPEAF 60 DISK WP510 00090FECODES IC F 40R DISK WP510 00100FHEADING IT F 40 EDISK WP510 00110F$LP1 O F 132 OF PRINTER WP510 00120F* WP510 00130F* THIS PROGRAM PRINTS THE TRANSACTIONS IN 'SWTRAN' AND ANY ERROR WP510 00140F* OR WARNING CODES. WP510 0000150F* WP510 00160E HEADING HEAD 1 1 40 WP510 00170ISWTRAN NS 01 1 C5 2 C1 WP510 00180I 1 20TC WP510 00190I 3 70WONUM WP510 00200I 8 31 PARTNO WP510 00210I 32 32 STATUS WP510 0000220I 33 390QTY WP510 00230I 40 450RLSDAT WP510 00240I 46 510REQDAT WP510 00250I 52 54 PRI WP510 00260I 55 55 REQGEN WP510 00270I 59 600ERRCOD WP510 00280I NS 02 WP510 0000290I 1 20TC WP510 00300I 3 70WONUM WP510 00310I 8 100OPNUM WP510 00320I 11 11 MCODE WP510 00330I 12 180QTY WP510 00340I 19 20 LABGRD WP510 00350I 21 260DLRS WP510 0000360I 27 50 PARTNO WP510 00370I 51 541BFACT WP510 00380I 55 570TOOPR WP510 00390I 58 58 TMCODE WP510 00400I 59 600ERRCOD WP510 00410IECODES NS 03 WP510 00420I 1 40 EDESC WP510 0000430C SETOF 1516 WP510 00440C ERRCOD COMP 0 16 16-WARNING WP510 00450C 16 ERRCOD COMP 19 151616 15-ERROR WP510 00460C 15 NERRS ADD 1 NERRS 50 WP510 00470C 16 NWRNS ADD 1 NWRNS 50 WP510 00480C NTRNS ADD 1 NTRNS 50 WP510 00490C********************************************************************WP510 0000500C* IN THIS SECTION WE PRINT ALL THE ERROR CODES AND THEIR WP510 00510C* MEANINGS. THE ERROR CODE IS A RANDOM FILE. THE ERROR CODE WP510 00520C* IS ALSO THE RELATIVE RECORD NUMBER WP510 00530C********************************************************************WP510 00540CLR SETON 81 WP510 00550CLR EXCPT WP510 00560CLR SETOF 81 WP510 0000570CLR SETON 80 WP510 00580CLR Z-ADD1 RRN1 50 WP510 00590CLR LOOP TAG WP510 00600CLR RRN1 CHAINECODES 50 WP510 00610CLR 50 GOTO LEND WP510 00620CLR MOVE EDESC ED1 40 WP510 00630CLR RRN1 ADD 20 RRN2 50 WP510 0000640CLR RRN2 CHAINECODES 50 WP510 00650CLR 50 GOTO LEND WP510 00660CLR EXCPT WP510 00670CLR RRN1 ADD 1 RRN1 WP510 00680CLR RRN1 COMP 20 20 WP510 00690CLRN20 GOTO LOOP WP510 00700CLR LEND TAG WP510 0000710O$LP1 H 02 1P WP510 00720O OR OF WP510 00730O HEAD 84 WP510 00740O H 1 1P WP510 00750O OR OF WP510 00760O 4 'PAGE' WP510 00770O PAGE Z 9 WP510 0000780O 75 'TRANSACTION LISTING' WP510 00790O UDATE Y 85 WP510 00800O 132 'JOB510' WP510 00810O H 2 1P WP510 00820O OR OF WP510 00830O 19 'TRAN# W.O.# OP# MT' WP510 00840O 38 'QUANTITY DOLLARS' WP510 0000850O 52 'PART NUMBER' WP510 00860O 67 'LAB' WP510 00870O 89 'BURDEN - TO - STATUS' WP510 00880O 112 'RELEASE REQUIRED PRI' WP510 00890O 122 'R ERROR' WP510 00900O H 11 1P WP510 00910O OR OF WP510 0000920O 67 'GRD' WP510 00930O 82 'FACTOR OP MT' WP510 00940O 98 'DATE' WP510 00950O 108 'DATE' WP510 00960O 122 'G CODE' WP510 00970O D 1 01 WP510 00980O TC 3 WP510 0000990O WONUM Z 12 WP510 01000O PARTNO 64 WP510 01010O STATUS 89 WP510 01020O QTY L 30 WP510 01030O RLSDATY 99 WP510 01040O REQDATY 108 WP510 01050O PRI 112 WP510 0001060O REQGEN 115 WP510 01070O ERRCODZ 122 WP510 01080O 15 127 '****' WP510 01090O 16 125 '**' WP510 01100O D 1 02 WP510 01110O TC 3 WP510 01120O WONUM Z 12 WP510 0001130O OPNUM Z 16 WP510 01140O MCODE 19 WP510 01150O QTY L 30 WP510 01160O DLRS L 39 WP510 01170O PARTNO 64 WP510 01180O LABGRD 66 WP510 01190O BFACT 4 74 WP510 0001200O TOOPR 78 WP510 01210O TMCODE 82 WP510 01220O ERRCODZ 122 WP510 01230O 15 127 '****' WP510 01240O 16 125 '**' WP510 01250O E 0210 81 WP510 01260O 75 'TRANSACTION SUMMARY' WP510 0001270O UDATE Y 85 WP510 01280O E 1 81 WP510 01290O 25 'THERE WERE ERRORS' WP510 01300O NERRS Z 18 WP510 01310O E 1 81 WP510 01320O 27 'WARNINGS' WP510 01330O NWRNS Z 18 WP510 0001340O E 1 81 WP510 01350O 31 'TRANSACTIONS' WP510 01360O NTRNS Z 18 WP510 01370O E 22 81 WP510 01380O 26 'WARNING CODES' WP510 01390O 87 'ERROR CODES' WP510 01400O E 1 80 WP510 0001410O RRN1 Z 13 WP510 01420O ED1 56 WP510 01430O RRN2 Z 70 WP510 01440O EDESC 113 WP510 ** 001450ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001460ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00147000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001480ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001490/* 001500__0O EDESC 113 WP510 ** 001450ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001460ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0014700( TTXWP600 P4999999111111(000010H S WP600 00020X DECK-ID P13 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP600 00030F* PRINTS THE JOB STATUS REPORT WP600 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP600 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP600 00060F* CONTROL DATA PROPRIETARY PRODUCT WP600 00070F* WP600 0000080FWRKORD IPEAF 160 DISK WP600 00090FHEADING IT F 40 EDISK WP600 00100F$LP1 O F 132 OF PRINTER WP600 00110F* WP600 00120F* THIS PROGRAM PRINTS THE JOB STATUS SUMMARY REPORT. THIS IS JUST WP600 00130F* A FORMATED FILE DUMP OF WRKORD. THE REMAIN FIELD IS COMPUTED WP600 00140F* BY SUBTRACTING QUANTITY COMPLETED AND QTY SCRAPPED FROM THE WP600 0000150F* JOB QUANTITY. WP600 00160F* U1 OFF LISTS ONLY OPEN AND RELEASED JOBS WP600 00170F* U1 ON LISTS ONLY CLOSED JOBS WP600 00180F* U2 ON LISTS OPEN, RELEASED, AND CLOSED JOBS REGARDLESS OF U1 WP600 00190F* WP600 00200E HEADING HEAD 1 1 40 WP600 00210IWRKORD NS 01 WP600 0000220I 1 50WONUM WP600 00230I 6 25 PARTNO WP600 00240I 58 60 PRI WP600 00250I 30 30 STATUS WP600 00260I 31 370JOBQTY WP600 00270I 38 440COMQTY WP600 00280I 107 1130SCRAP WP600 0000290I 45 500RLSDAT WP600 00300I 51 560REQDAT WP600 00310I 57 57 REQGEN WP600 00320I 61 61 OOCODE WP600 00330C SETOF 80 WP600 00340C STATUS COMP 'D' 20 WP600 00350C STATUS COMP 'C' 21 WP600 0000360C NU1N20N21 WP600 00370COR U1 21 WP600 00380COR U2N20 SETON 80 WP600 00390C JOBQTY SUB COMQTY REMAIN 70 WP600 00400C REMAIN SUB SCRAP REMAIN 30 WP600 00410C 30 Z-ADD0 REMAIN WP600 00420O$LP1 H 02 1P WP600 0000430O OR OF WP600 00440O HEAD 86 WP600 00450O H 1 1P WP600 00460O OR OF WP600 00470O 4 'PAGE' WP600 00480O PAGE Z 8 WP600 00490O 75 'JOB STATUS SUMMARY' WP600 0000500O 132 'JOB600' WP600 00510O H 2 1P WP600 00520O OR OF WP600 00530O 21 'W.O.# PART NUMBER' WP600 00540O 47 'PRI S JOB' WP600 00550O 74 'QTY SCRAP QTY' WP600 00560O 95 'RELEASE REQUIRED' WP600 0000570O 110 'REQ OUT-OF' WP600 00580O H 11 1P WP600 00590O OR OF WP600 00600O 56 'C QTY COMPLT' WP600 00610O 74 'QTY REMAIN' WP600 00620O 101 'DATE DATE GEN' WP600 00630O 110 'ORDER' WP600 0000640O D 1 01 80 WP600 00650O WONUM Z 5 WP600 00660O PARTNO 30 WP600 00670O PRI 35 WP600 00680O STATUS 38 WP600 00690O JOBQTYL 48 WP600 00700O COMQTYL 57 WP600 0000710O SCRAP L 66 WP600 00720O REMAINL 75 WP600 00730O RLSDATY 85 WP600 00740O REQDATY 95 WP600 00750O REQGEN 100 WP600 00760O OOCODE 108 WP600 ** 00077000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000780ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000790ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000800ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000810/* 000820_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( TTXWP605 PV999999111111(000010H S WP605 00020X DECK-ID P14 MFG/DIST/ACCT SYSTEM SUMMARY-239 WP605 00030F* PRINTS THE WORK ORDERS TO BE RELEASE REPORT WP605 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP605 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP605 00060F* CONTROL DATA PROPRIETARY PRODUCT WP605 00070F* WP605 0000080FWRKORD IPEAF 160 DISK WP605 00090FHEADING IT F 40 EDISK WP605 00100F$LP1 O F 132 OF PRINTER WP605 00110F$CTKP D F 70 CONSOLE WP605 00120F* WP605 00130F* THIS PROGRAM LISTS ALL 'OPEN' JOBS WHOSE RELEASE DATE IS LESS WP605 00140F* THAN OR EQUAL TO THE MAXIMUM RELEASE DATE. WP605 0000150F* IF U1 IS ON THE OPERATOR SPECIFIES THE MRD, OTHERWISE IT IS WP605 00160F* THE SYSTEM DATE PLUS 7 DAYS WP605 00170F* WP605 00180E HEADING HEAD 1 1 40 WP605 00190E ME 12 12 2 0 WP605 00200IWRKORD NS 01 30 CO WP605 00210I 1 50WONUM WP605 0000220I 6 25 PARTNO WP605 00230I 31 370JOBQTY WP605 00240I 45 500RLSDAT WP605 00250I 51 560REQDAT WP605 00260I 58 60 PRI WP605 00270I 45 500RLSDAT WP605 00280I 45 460RLSMO WP605 0000290I 47 480RLSDA WP605 00300I 49 500RLSYR WP605 00310I NS 02 WP605 00320I 1 1 A WP605 00330C 99 GOTO START WP605 00340C SETON 99 WP605 00350C U1 GOTO GETDAT WP605 0000360C UDAY ADD 7 UDAY WP605 00370C Z-ADDUMONTH X 20 WP605 00380C UDAY COMP ME,X 20 WP605 00390C N20 GOTO BLDUD WP605 00400C UDAY SUB ME,X UDAY WP605 00410C UMONTH ADD 1 UMONTH WP605 00420C UMONTH COMP 12 20 WP605 0000430C N20 GOTO BLDUD WP605 00440C Z-ADD1 UMONTH WP605 00450C UYEAR ADD 1 UYEAR WP605 00460C BLDUD TAG WP605 00470C MOVE UYEAR DAYR 40 WP605 00480C MOVELUDAY DAYR WP605 00490C MOVE DAYR UDATE WP605 0000500C MOVELUMONTH UDATE WP605 00510C EXSR DOHEAD WP605 00520C GOTO START WP605 00530C GETDAT TAG WP605 00540C MOVEL'MAX RELE'WORD16 16 WP605 00550C MOVE 'ASE DATE'WORD16 WP605 00560C WORD16 DSPLY$CTKP UDATE WP605 0000570C MOVELUDATE UMONTH WP605 00580C MOVE UDATE DAYR WP605 00590C MOVELDAYR UDAY WP605 00600C MOVE DAYR UYEAR WP605 00610C EXSR DOHEAD WP605 00620C START TAG WP605 00630C SETOF 80 WP605 0000640C OF EXSR DOHEAD WP605 00650C N01 GOTO DEND WP605 00660C RLSYR COMP UYEAR 2021 WP605 00670C 20 GOTO DEND WP605 00680C N21 RLSMO COMP UMONTH 2022 WP605 00690C 20 GOTO DEND WP605 00700C N21N22 RLSDA COMP UDAY 20 WP605 0000710C 20 GOTO DEND WP605 00720C SETON 80 WP605 00730C NJOBS ADD 1 NJOBS 50 WP605 00740C DEND TAG WP605 00750CSR DOHEAD BEGSR WP605 00760CSR SETON 81 WP605 00770CSR EXCPT WP605 0000780CSR SETOF 81 WP605 00790CSR ENDSR WP605 00800O$LP1 E 02 81 WP605 00810O HEAD 86 WP605 00820O E 1 81 WP605 00830O 4 'PAGE' WP605 00840O PAGE Z 8 WP605 0000850O 72 'JOBS TO BE RELEASED BY' WP605 00860O UDATE Y 81 WP605 00870O 132 'JOB605' WP605 00880O E 2 81 WP605 00890O 21 'W.O.# PART NUMBER' WP605 00900O 56 'QUANTITY RELEASE' WP605 00910O 79 'REQUIRED PRIORITY' WP605 0000920O E 11 81 WP605 00930O 68 'DATE DATE' WP605 00940O D 1 01 80 WP605 00950O WONUM Z 5 WP605 00960O PARTNO 30 WP605 00970O JOBQTYL 44 WP605 00980O RLSDATY 56 WP605 0000990O REQDATY 68 WP605 01000O PRI 74 WP605 01010O T 3 LR WP605 01020O NJOBS Z 5 WP605 01030O 25 'JOBS TO BE RELEASED' WP605 ** 001040ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00105000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001060ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001070ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001080** 001090312831303130313130313031 001100/* 001110_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(_ iTXWP610 PJ|999999111111(000010H S WP610 00020X DECK-ID P21 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP610 00030F* PRINTS THE DETAIL JOB STATUS REPORT WP610 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP610 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP610 00060F* CONTROL DATA PROPRIETARY PRODUCT WP610 00070F* WP610 0000080FWRKORD IPEAF 160 5AI 1 DISK WP610 00090FWRKOPR IC F 90R DISK WP610 00100FHEADING IT F 40 EDISK WP610 00110F$LP1 O F 132 OF PRINTER WP610 00120FSEQOPR O F 100 DISK WP610 00130F* WP610 00140F* THIS PROGRAM PRINTS THE DETAIL JOB STATUS REPORT. WP610 0000150F* THE WORK ORDER FILE POINTS TO A CHAIN OF OPERATIONS IN THE WP610 00160F* WORK UPERATIONS FILE. WP610 00170F* WP610 00180F* THIS ALSO OUTPUTS THE SEQOPR FILE WITH ONE RECORD FOR EACH WP610 00190F* WRKOPR RECORD. THIS FILE IS USED TO PRINT OPERATION INFORMATION WP610 00200F* IN DIFFERENT ORDER. WP610 00210F* WP610 0000220F* U1- ON ONLY CLOSED JOBS WP610 00230F* U1- OFF NO CLOSED JOBS - ONLY RELEASED WP610 00240F* U2- BOTH WP610 00250E HEADING HEAD 1 1 40 WP610 00260IWRKORD NS 01 WP610 00270I 1 50WONO WP610 00280I 6 25 PARTNO WP610 0000290I 51 560DUEDAT WP610 00300I 58 60 PRI WP610 00310I 30 30 STATUS WP610 00320I 62 660RRN1 WP610 00330IWRKOPR NS 02 WP610 00340I 1 50WONUM WP610 00350I 6 80OPNUM WP610 0000360I 9 12 DEPT WP610 00370I 13 170STANO WP610 00380I 18 221PRATE WP610 00390I 23 250SETUP WP610 00400I 26 26 OPCODE WP610 00410I 27 330QTYQ WP610 00420I 34 400QTYC WP610 0000430I 77 830QTYS WP610 00440I 41 470REWRKQ WP610 00450I 48 540REWRKC WP610 00460I 72 760REWRKH WP610 00470I 61 660REWRK$ WP610 00480I 67 710LABH WP610 00490I 55 600LAB$ WP610 0000500I 84 84 LASTOP WP610 00510C STATUS COMP 'R' 20 WP610 00520C STATUS COMP 'C' 21 WP610 00530C NU1N20NU2 WP610 00540COR U1N21NU2 WP610 00550COR U2N20N21 GOTO DEND WP610 00560C SETON 80 WP610 0000570C GETOPR TAG WP610 00580C Z-ADD0 QTYR 70 WP610 00590C Z-ADD0 STDHRS 50 WP610 00600C Z-ADD0 REMHRS 50 WP610 00610C Z-ADD0 VARPCT 41 WP610 00620C RRN1 COMP 0 40 WP610 00630C 40 GOTO DEND WP610 0000640C RRN1 CHAINWRKOPR H1 WP610 00650C H1 GOTO DEND WP610 00660C WONO COMP WONUM 3030 WP610 00670C 30 GOTO DEND WP610 00680C QTYQ SUB QTYC QTYR WP610 00690C QTYR SUB QTYS QTYR 10 WP610 00700C 10 Z-ADD0 QTYR WP610 0000710C PRATE COMP 0 30 WP610 00720C QTYC COMP 0 313232 WP610 00730C 30 GOTO OUTPUT WP610 00740C QTYC DIV PRATE STDHRS H 30 WP610 00750C 31 STDHRS ADD SETUP STDHRS 30 WP610 00760C QTYR DIV PRATE REMHRS H WP610 00770C 32 REMHRS ADD SETUP REMHRS WP610 0000780C 30 GOTO OUTPUT WP610 00790C LABH DIV STDHRS VAR 73H WP610 00800C VAR MULT 100 VARPCT WP610 00810C OUTPUT TAG WP610 00820C SETON 81 WP610 00830C EXCPT WP610 00840C SETOF 8081 WP610 0000850C RRN1 ADD 1 RRN1 WP610 00860C GOTO GETOPR WP610 00870C DEND TAG WP610 00880O$LP1 H 02 1P WP610 00890O OR OF WP610 00900O HEAD,1 86 WP610 00910O H 1 1P WP610 0000920O OR OF WP610 00930O 4 'PAGE' WP610 00940O PAGE Z 8 WP610 00950O 74 'DETAIL JOB STATUS' WP610 00960O UDATE Y 85 WP610 00970O 132 'JOB610' WP610 00980O H 2 1P WP610 0000990O OR OF WP610 01000O 23 'W.O.# OPER# DEPT WORK' WP610 01010O 47 'O ---- Q U A N T I T' WP610 01020O 65 'Y ----* ----' WP610 01030O 81 'H O U R S' WP610 01040O 106 '----* $ LABOR ----' WP610 01050O 130 'R E W O R K ---*' WP610 0001060O H 11 1P WP610 01070O OR OF WP610 01080O 41 'STA C QUEUED COMPLT' WP610 01090O 57 'SCRAP REMAIN' WP610 01100O 84 'SETUP ACTUAL STD VAR%' WP610 01110O 99 'REMAIN OR O.P.' WP610 01120O 123 'QUEUED COMPLT HOURS' WP610 0001130O 130 'LABOR$' WP610 01140O EF31 80 WP610 01150O WONO Z 5 WP610 01160O PARTNO 41 WP610 01170O DUEDATY 65 WP610 01180O PRI 85 WP610 01190O 20 'PART NUMBER:' WP610 0001200O 55 'DUE DATE :' WP610 01210O 80 'PRIORITY :' WP610 01220O 21 6 '*' WP610 01230O E 1 81 WP610 01240O WONUM Z 5 WP610 01250O 21 6 '*' WP610 01260O OPNUM 12 WP610 0001270O DEPT 17 WP610 01280O STANO 23 WP610 01290O OPCODE 25 WP610 01300O QTYQ L 34 WP610 01310O QTYC L 42 WP610 01320O QTYS L 50 WP610 01330O QTYR L 58 WP610 0001340O SETUP L 67 WP610 01350O LABH L 73 WP610 01360O STDHRSL 79 WP610 01370O VARPCTL 85 WP610 01380O REMHRSL 92 WP610 01390O LAB$ L 100 WP610 01400O REWRKQL 110 WP610 0001410O REWRKCL 118 WP610 01420O REWRKHL 124 WP610 01430O REWRK$L 131 WP610 01440OSEQOPR E 81NU1 20 WP610 01450O WONUM 5 WP610 01460O PARTNO 25 WP610 01470O OPNUM 32 WP610 0001480O DEPT 36 WP610 01490O STANO 41 WP610 01500O PRATE 46 WP610 01510O SETUP 49 WP610 01520O OPCODE 50 WP610 01530O QTYQ 57 WP610 01540O QTYC 64 WP610 0001550O REWRKQ 71 WP610 01560O REWRKC 78 WP610 01570O LABH 84 WP610 01580O QTYS 91 WP610 01590O PRI 94 WP610 01600O DUEDAT 100 WP610 ** 00161000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001650/* 001660_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( iTXWP630 P999999111111(000010H S WP630 00020X DECK-ID P23 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP630 00030F* PRINTS THE JOB MOVEMENT WORKSHEET WP630 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP630 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP630 00060F* CONTROL DATA PROPRIETARY PRODUCT WP630 00070F* WP630 0000080FSEQOPR IPEAF 100 DISK WP630 00090FHEADING IT F 40 EDISK WP630 00100F$LP1 O F 132 OF LPRINTER WP630 00110F* WP630 00120F* THIS PROGRAM PRINTS THE JOB MOVEMENT WORK SHEET. THIS IS DESIGNED WP630 00130F* AS A TURN AROUND DOCUMENT FOR RECORDING THE MOVEMENT OF MATERIAL WP630 00140F* FROM ONE OPERATION TO ANOTHER. WP630 0000150F* WP630 00160E HEADING HEAD 1 1 40 WP630 00170L$LP1 66FL 40OL WP630 00180ISEQOPR NS 01 WP630 00190I 33 36 DEPT L2 WP630 00200I 37 41 WRKSTAL1 WP630 00210I 1 50WONUM WP630 0000220I 6 25 PARTNO WP630 00230I 30 320OPNUM WP630 00240I 51 570QTYQ WP630 00250I 58 640QTYC WP630 00260I 85 910QTYS WP630 00270I 65 710RWKQ WP630 00280I 72 780RWKC WP630 0000290I 50 50 OOC WP630 00300C NL1NOF GOTO START WP630 00310C SETON 9882 WP630 00320C EXCPT WP630 00330C SETOF 9882 WP630 00340C Z-ADD40 LEFT 20 WP630 00350C START TAG WP630 0000360C SETON 99 WP630 00370C QTYQ SUB QTYC REMAIN 70 WP630 00380C REMAIN SUB QTYS REMAIN 85 WP630 00390C OOC COMP ' ' 87 WP630 00400C 85 EXSR EXCPT WP630 00410C RWKQ COMP RWKC 86 WP630 00420C 86 SETON 85 WP630 0000430C 85 EXSR EXCPT WP630 00440CL1N99 GOTO TEND WP630 00450CL1 LEFT COMP 11 20 WP630 00460CL1 20 GOTO TEND WP630 00470CL1 LEFT DIV 2 N 20 WP630 00480CL1 N COMP 5 20 WP630 00490CL1 20 Z-ADD6 N WP630 0000500CL1 LOOP TAG WP630 00510CL1 SETON 8082 WP630 00520CL1 EXCPT WP630 00530CL1 SETOF 8082 WP630 00540CL1 N SUB 1 N 20 WP630 00550CL1 20 GOTO LOOP WP630 00560CL1 TEND TAG WP630 0000570CSR EXCPT BEGSR WP630 00580CSR SETON 82 WP630 00590CSR EXCPT WP630 00600CSR SETOF 858687 WP630 00610CSR SETOF 82 WP630 00620CSR LEFT SUB 2 LEFT WP630 00630CSR ENDSR WP630 0000640O$LP1 E 02 98 WP630 00650O 13 'DEPARTMENT:' WP630 00660O DEPT 19 WP630 00670O HEAD 64 WP630 00680O E 1 98 WP630 00690O 13 'WORK STATION:' WP630 00700O WRKSTA 19 WP630 0000710O 54 'JOB MOVEMENT WORK SHEET' WP630 00720O UDATE Y 65 WP630 00730O 84 'JOB630' WP630 00740O E 2 98 WP630 00750O 12 'TRANS# W.O.#' WP630 00755O 26 'PART NUMBER' 00760O 62 'FROM FROM QUANTITY' WP630 0000770O 81 'TO TO' WP630 00780O E 11 98 WP630 00790O 51 'OP# TYPE' WP630 00800O 82 'OP# TYPE' WP630 00810O E 1 85 WP630 00820O 53 '* *' WP630 00830O 83 '* * *' WP630 0000840O 14 '* *' WP630 00850O 39 '*' WP630 00860O 3 '54' WP630 00870O WONUM Z 12 WP630 00880O PARTNO 35 WP630 00890O OPNUM 44 WP630 00900O 86 3 '55' WP630 0000910O 86 50 'R' WP630 00920O 87 74 '****' WP630 00930O 87 81 '**' WP630 00940O E 1 80 WP630 00950O 53 '* *' WP630 00960O 83 '* * *' WP630 00970O 14 '* *' WP630 0000980O 39 '*' WP630 00990O E 1 82 WP630 01000O 14 '* *' WP630 01010O 39 '*' WP630 01020O 53 '* *' WP630 01030O 83 '* * *' WP630 01040O 52 '-----' WP630 0001050O 67 '--------------' WP630 01060O 76 '--------' WP630 01070O 82 '-----' WP630 01080O 5 '-----' WP630 01090O 13 '-------' WP630 01100O 38 '------------------------' WP630 01110O 46 '-------' WP630 00** 001120ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001160/* 001170_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(dtG d*CLRPRT P031678032978(000010H CLRPRT00020FNULL IP F 72 DISK 00030FPARTMST US F 300 20AI 271 DISK 00040IPARTMST NS 01 00050I 1 256 REC1 00060I 257 300 REC2 00070INULL NS 02 0000080C 01 Z-ADD0 ZERO 70 00090C 01 Z-ADD10 TEN 70 00100OPARTMST D 01 00110O REC1 256 00120O REC2 300 00130O TEN 152 00140O ZERO 159 0000150O ZERO 202 00160O ZERO 209 00170O ZERO 218 00180O ZERO 173 00190O ZERO 166 0019000200O ZERO 180 0020000210O ZERO 265 0021000/* 00220_ 00 00 00 00 00 00 00 00 00 00 00 __ 0( TXWP700 P  999999111111(000010H S WP700 00020X DECK-ID P15 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP700 00030F* PRINTS THE MONTHLY CLOSED JOB REPORT WP700 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP700 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP700 00060F* CONTROL DATA PROPRIETARY PRODUCT WP700 00070F* WP700 0000080FWRKORD UPEAF 160 5AI 1 DISK WP700 00090FHEADING IT F 40 EDISK WP700 00100F$LP1 O F 132 OF PRINTER WP700 00110FPARTMST IC F 300R20AI 271 DISK WP700 00120F** WP700 00130F* THIS PROGRAM PRINTS THE MONTHLY CLOSED JOB REPORT. IT LISTS WP700 00140F* ALL JOBS WHICH ARE CLOSED AND WHICH HAVE A CLOSED DATE WITHIN WP700 0000150F* A CERTAIN RANGE. IF U1 IS OFF THE RANGE IS FROM THE FIRST DAY WP700 00160F* OF THE SYSTEM MONTH TO THE LAST DAY. IF U1 IS ON THE OPERATOR WP700 00170F* SPECIFIES THE RANGE. WP700 00180F* THE STANDARD MATERIAL,LABOR,OUTSIDE PROCESSING, AND BURDEN WP700 00190F* COME FROM THE PARTMST FILE. THE OLD VARIANCE IS IN THE WRKORD WP700 00200F* FILE AND THE NEW VARIANCE IS COMPUTED BY SUBTRACTING THE WP700 00210F* OLD VARIANCE AND THE STANDARD FROM THE ACCUMULATED. IF THE WP700 0000220F* OLD VARIANCE OR THE NEW VARIANCE IS ZERO THEN THAT LINE IS NOT WP700 00230F* PRINTED. WP700 00240F* IF U2 IS ON THE NEW VARIANCE DOES NOT REPLACE THE OLD VARIANCE WP700 00250F* IN THE WRKORD FILE. WP700 00260F** WP700 00270F* ID F C H L FUNCTION OF INDICATORS WP700 00280F* 01 CLOSED WORK ORDER WP700 0000290F* 02 NOT CLOSED WP700 00300F* 05 PARTMST RECORD WP700 00310F* 10-16 ZERO VALUE FOR INPUT VARIANCE FIELDS WP700 00320F* 20-26 ZERO VALUE FOR COMPUTED VARIANCE FIELDS WP700 00330F* 40 COMPARE INDICATOR WP700 00340F* 55 NO HIT ON PARTMST WP700 00350F* 70 RUBOUT WAS FIRST CHARACTER WP700 0000360F* 71 DEALING WITH FROM DATE WP700 00370F* 73 INPUT DATE IS OUT-OF RANGE WP700 00380F* 74 COMPARE INDICATOR WP700 00390F* 80 OLD VARIANCE NOT ALL ZERO - OUTPUT OLD VAR LINE WP700 00400F* 81 NEW VARIANCE NOT ALL ZERO - OUTPUT NEW VAR LINE WP700 00410F* 99 NOT FIRST TIME WP700 00420F* U1 ASK OPERATOR FOR RANGE OF VALID DATES WP700 0000430F* U2 DON'T UPDATE VARIANCE FIELDS WP700 00440E HEADING HEAD 1 1 40 WP700 00450E ME 12 12 2 0 WP700 00460IWRKORD NS 01 30 CC WP700 00470I 1 50WONUM WP700 00480I 6 25 PARTNO WP700 00490I 38 440QTYC WP700 0000500I 107 1130QTYS WP700 00510I 45 500CLSDAT WP700 00520I 45 460CLSMO WP700 00530I 47 480CLSDA WP700 00540I 49 500CLSYR WP700 00550I 67 720MAT$ WP700 00560I 73 780LAB$ WP700 0000570I 79 840BUR$ WP700 00580I 85 900OP$ WP700 00590I 91 960RWK$ WP700 00600I 97 1010LABH WP700 00610I 102 1060RWKH WP700 00620I 114 1190VARM$ 10 WP700 00630I 120 1250VARL$ 11 WP700 0000640I 126 1310VARB$ 12 WP700 00650I 132 1370VARO$ 13 WP700 00660I 138 1430VARR$ 14 WP700 00670I 144 1480VARLH 15 WP700 00680I 149 1530VARRH 16 WP700 00690I NS 02 WP700 00700I 1 1 A WP700 0000710IPARTMST NS 05 WP700 00720I 75 813MATS WP700 00730I 110 1163LABS WP700 00740I 117 1233BURS WP700 00750I 124 1303OPS WP700 00760I 138 1453HRSTD 16 WP700 00770I 74 74 DCODE WP700 0000780C SETOF 98 WP700 00790C 99 GOTO START WP700 00800C EXSR GETDAT WP700 00810C SETON 9998 WP700 00820C MOVEL'ENTER DA'WORD16 16 WP700 00830C MOVE 'TE- FROM'WORD16 WP700 00840C START TAG WP700 0000850C SETOF 8081 WP700 00860C N01 GOTO DEND WP700 00870C EXSR CHKDAT WP700 00880C 73 GOTO DEND WP700 00890C SETON 80 WP700 00900C 10 11 12 WP700 00910CAN 13 14 15 WP700 0000920CAN 16 SETOF 80 WP700 00930C MOVELPARTNO KEY 20 WP700 00940C KEY CHAINPARTMST 55 WP700 00950C N55 DCODE COMP 'D' 55 WP700 00960C N55 GOTO GETSTD WP700 00970C Z-ADD0 MATS WP700 00980C Z-ADD0 LABS WP700 0000990C Z-ADD0 BURS WP700 01000C Z-ADD0 OPS WP700 01010C GETSTD TAG WP700 01020C QTYC MULT MATS STDM$ 60H WP700 01030C QTYC MULT LABS STDL$ 60H WP700 01040C QTYC MULT BURS STDB$ 60H WP700 01050C QTYC MULT OPS STDO$ 60H WP700 0001060C Z-ADD0 STDR$ 60H WP700 01070C QTYC MULT HRSTD STDLH 50H WP700 01080C Z-ADD0 STDRH 50H WP700 01090C MAT$ SUB STDM$ NVARM$ 60 WP700 01100C NVARM$ SUB VARM$ NVARM$ 20 WP700 01110C LAB$ SUB STDL$ NVARL$ 60 WP700 01120C NVARL$ SUB VARL$ NVARL$ 21 WP700 0001130C BUR$ SUB STDB$ NVARB$ 60 WP700 01140C NVARB$ SUB VARB$ NVARB$ 22 WP700 01150C OP$ SUB STDO$ NVARO$ 60 WP700 01160C NVARO$ SUB VARO$ NVARO$ 23 WP700 01170C RWK$ SUB STDR$ NVARR$ 60 WP700 01180C NVARR$ SUB VARR$ NVARR$ 24 WP700 01190C LABH SUB STDLH NVARLH 50 WP700 0001200C NVARLH SUB VARLH NVARLH 25 WP700 01210C RWKH SUB STDRH NVARRH 50 WP700 01220C NVARRH SUB VARRH NVARRH 26 WP700 01230C SETON 81 WP700 01240C 20 21 22 WP700 01250CAN 23 24 25 WP700 01260CAN 26 SETOF 81 WP700 0001270C NVARM$ ADD TOTM$ TOTM$ 60 WP700 01280C NVARL$ ADD TOTL$ TOTL$ 60 WP700 01290C NVARB$ ADD TOTB$ TOTB$ 60 WP700 01300C NVARO$ ADD TOTO$ TOTO$ 60 WP700 01310C NVARR$ ADD TOTR$ TOTR$ 60 WP700 01320C NVARLH ADD TOTLH TOTLH 50 WP700 01330C NVARRH ADD TOTRH TOTRH 50 WP700 0001340C DEND TAG WP700 01350CSR GETDAT BEGSR WP700 01360CSR FROMDT TAG WP700 01370CSR SETON 71 WP700 01380CSR MOVEL'FROM' WORD4 4 WP700 01390CSR EXSR GETIT WP700 01400CSR MOVE DATE FRDATE 60 WP700 0001410CSR MOVE MO FRMO 20 WP700 01420CSR MOVE DA FRDA 20 WP700 01430CSR MOVE YR FRYR 20 WP700 01440CSR SETOF 71 WP700 01450CSR MOVEL'TO ' WORD4 WP700 01460CSR EXSR GETIT WP700 01470CSR MOVE DATE TODATE 60 WP700 0001480CSR MOVE MO TOMO 20 WP700 01490CSR MOVE DA TODA 20 WP700 01500CSR MOVE YR TOYR 20 WP700 01510CSR 70 GOTO FROMDT WP700 01520CSR ENDSR WP700 01530CSR GETIT BEGSR WP700 01540CSR U1 GOTO DISPLA WP700 0001550CSR MOVE UMONTH MO WP700 01560CSR MOVE ME,MO DA WP700 01570CSR 71 MOVE '01' DA WP700 01580CSR MOVE UYEAR YR WP700 01590CSR MOVE YR DY WP700 01600CSR MOVELDA DY WP700 01610CSR MOVE DY DATE WP700 0001620CSR MOVELMO DATE WP700 01630CSR GOTO ENDGET WP700 01640CSR DISPLA TAG WP700 01650CSR MOVE WORD4 WORD16 WP700 01660CSR MOVELWORD16 BUFFER 72 WP700 01670CSR MOVE 'T' TYPE 1 WP700 01680CSR Z-ADD16 BLNGTH 20 WP700 0001690CSR EXITFSUBRCM WP700 01700CSR RLABL BUFFER 72 WP700 01710CSR RLABL TYPE 1 WP700 01720CSR RLABL BLNGTH 20 WP700 01730CSR RLABL RCODE 1 WP700 01740CSR RLABL MASK 10 WP700 01750CSR RLABL DTYPE 10 WP700 0001760CSR SETOF 70 WP700 01770CSR MOVE 'A' TYPE WP700 01780CSR Z-ADD7 BLNGTH WP700 01790CSR EXITFSUBRCM WP700 01800CSR RLABL BUFFER 72 WP700 01810CSR RLABL TYPE 1 WP700 01820CSR RLABL BLNGTH 20 WP700 0001830CSR RLABL RCODE 1 WP700 01840CSR RLABL MASK 10 WP700 01850CSR RLABL DTYPE 10 WP700 01860CSR RCODE COMP 'C' 30 WP700 01870CSR 30 GOTO CHEKIT WP700 01880CSR RCODE COMP 'R' 30 WP700 01890CSR 30 BUFFER COMP ' ' 70 WP700 0001900CSR 70 GOTO ENDGET WP700 01910CSR GOTO DISPLA WP700 01920CSR CHEKIT TAG WP700 01930CSR MOVELBUFFER DATE 60 WP700 01940CSR MOVELDATE MO 20 WP700 01950CSR MOVE DATE DY 40 WP700 01960CSR MOVELDY DA 20 WP700 0001970CSR MOVE DY YR 20 WP700 01980CSR MO COMP 0 40 WP700 01990CSRN40 MO COMP 12 40 WP700 02000CSR 40 GOTO DISPLA WP700 02010CSR DA COMP 0 40 WP700 02020CSRN40 DA COMP 31 40 WP700 02030CSR 40 GOTO DISPLA WP700 0002040CSR YR COMP 75 40 WP700 02050CSR 40 GOTO DISPLA WP700 02060CSR ENDGET ENDSR WP700 02070CSR CHKDAT BEGSR WP700 02080CSR CLSYR COMP FRYR 7473 WP700 02090CSRN73N74 CLSYR COMP TOYR 7374 WP700 02100CSR 73 WP700 0002110COR 74 GOTO ENDCHK WP700 02120CSR CLSMO COMP FRMO 7473 WP700 02130CSRN73N74 CLSMO COMP TOMO 7374 WP700 02140CSR 73 WP700 02150COR 74 GOTO ENDCHK WP700 02160CSR CLSDA COMP FRDA 7473 WP700 02170CSRN73N74 CLSDA COMP TODA 7374 WP700 0002180CSR ENDCHK ENDSR WP700 02190O$LP1 H 02 98 WP700 02200O OR OF WP700 02210O HEAD 86 WP700 02220O H 1 98 WP700 02230O OR OF WP700 02240O 4 'PAGE' WP700 0002250O PAGE Z 8 WP700 02260O 77 'MONTHLY CLOSED JOB REPOR' WP700 02270O 78 'T' WP700 02280O 132 'JOB700' WP700 02290O FRDATEY 89 WP700 02300O 93 'TO' WP700 02310O TODATEY 103 WP700 0002320O H 2 98 WP700 02330O OR OF WP700 02340O 21 'W.O.# PART NUMBER' WP700 02350O 48 'QTY CLOSE' WP700 02360O 75 '----- D O L L A R S' WP700 02370O 106 '----- - H O U R S-' WP700 02380O 117 'QTY' WP700 0002390O H 11 98 WP700 02400O OR OF WP700 02410O 48 'COMPLT DATE' WP700 02420O 74 'MATERL LABOR BURDEN' WP700 02430O 90 'OUT-PR REWORK' WP700 02440O 106 'LABOR REWORK' WP700 02450O 117 'SCRAP' WP700 0002460O D 2 01N73 WP700 02470O WONUM Z 5 WP700 02480O PARTNO 30 WP700 02490O QTYC L 39 WP700 02500O CLSDATY 48 WP700 02510O MAT$ L 59 WP700 02520O LAB$ L 67 WP700 0002530O BUR$ L 75 WP700 02540O OP$ L 83 WP700 02550O RWK$ L 91 WP700 02560O LABH L 100 WP700 02570O RWKH L 107 WP700 02580O QTYS L 118 WP700 02590O D 1 01N73 WP700 0002600O 8 'STANDARD' WP700 02610O STDM$ L 59 WP700 02620O STDL$ L 67 WP700 02630O STDB$ L 75 WP700 02640O STDO$ L 83 WP700 02650O STDR$ L 91 WP700 02660O STDLH L 100 WP700 0002670O STDRH L 107 WP700 02680O D 1 01 80 WP700 02690O 8 'OLD VAR' WP700 02700O VARM$ L 59 WP700 02710O VARL$ L 67 WP700 02720O VARB$ L 75 WP700 02730O VARO$ L 83 WP700 0002740O VARR$ L 91 WP700 02750O VARLH L 100 WP700 02760O VARRH L 107 WP700 02770O D 1 01 81 WP700 02780O 8 'NEW VAR' WP700 02790O NVARM$L 59 WP700 02800O NVARL$L 67 WP700 0002810O NVARB$L 75 WP700 02820O NVARO$L 83 WP700 02830O NVARR$L 91 WP700 02840O NVARLHL 100 WP700 02850O NVARRHL 107 WP700 02860O T 3 LR WP700 02870O TOTM$ L 59 WP700 0002880O TOTL$ L 67 WP700 02890O TOTB$ L 75 WP700 02900O TOTO$ L 83 WP700 02910O 14 'TOTAL VARIANCE' WP700 02920OWRKORD D 01NU2 81 WP700 02930O NVARM$ 119 WP700 02940O NVARL$ 125 WP700 0002950O NVARB$ 131 WP700 02960O NVARO$ 137 WP700 02970O NVARR$ 143 WP700 02980O NVARLH 148 WP700 02990O NVARRH 153 WP700 ** 003000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00301000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003020ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003030ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003040** 003050312831303130313130313031 003060/* 003070_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(E iTXWP710 Pd999999111111(000010H S WP710 00020X DECK-ID P16 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP710 00030F* PURGES THE OPEN WORKORDER FILE WP710 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP710 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP710 00060F* CONTROL DATA PROPRIETARY PRODUCT WP710 00070F* WP710 0000080FHEADING IT F 40 EDISK WP710 00090FWRKORD IPEAF 160 5AI 1 DISK WP710 00100FNWKORD O F 160 5AI 1 DISK WP710 00110F$LP1 O F 132 OF PRINTER WP710 00120FCONSOL D F 80 CONSOLE WP710 00130F* ID F C H L FUNCTION OF INDICATORS WP710 00140F* 01 CLOSED WRKORD RECORD WP710 0000150F* 02 DELETED WRKORD RECORD WP710 00160F* 03 NOT DELETED OR CLOSED WP710 00170F* 20 COMPARE INDICATOR WP710 00180F* 80 CLOSED RECORD GREATER THAN CUTOFF DATE - WILL NOT WP710 00190F* BE REMOVED WP710 00200F* 81 COMPARE INDICATOR WP710 00210F* 98 FIRST PAGE WP710 0000220F* 99 FIRST TIME THROUGH WP710 00230F**** WP710 00240F* THIS PROGRAM REMOVES ALL DELETED JOBS AND ALL CLOSE JOBS WHOSE WP710 00250F* CLOSE DATE IS LESS THAN THE CUTOFF DATE. IT LISTS ANY JOBS WP710 00260F* THAT ARE REMOVED. WP710 00270F* IF U1 IS OFF THE CUTOFF DATE IS ASSUMED TO BE 3 MONTHS PREVIOUS WP710 00280F* TO THE SYSTEM DATE. IF U1 IS ON THE OPERATOR MUST SPECIFY THE WP710 0000290F* CUTOFF DATE. WP710 00300E HEADING HEAD 1 1 40 WP710 00310E ME 12 12 2 0 WP710 00320IWRKORD NS 01 30 CC WP710 00330I OR 02 30 CD WP710 00340I 1 50WONUM WP710 00350I 6 25 PARTNO WP710 0000360I 107 1130QTYS WP710 00370I 38 440QTYC WP710 00380I 45 500CLSDAT WP710 00390I 45 460CLSMO WP710 00400I 47 480CLSDA WP710 00410I 49 500CLSYR WP710 00420I 67 720MAT$ WP710 0000430I 73 780LAB$ WP710 00440I 79 840BUR$ WP710 00450I 85 900OP$ WP710 00460I 91 960RWK$ WP710 00470I 97 1010LABH WP710 00480I 102 1060RWKH WP710 00490I 1 160 REC WP710 0000500I NS 03 WP710 00510I 1 160 REC WP710 00520C SETOF 98 WP710 00530C 99 GOTO START WP710 00540C U1 GOTO GETDAT WP710 00550C UMONTH SUB 3 MO 20 20 WP710 00560C 20 MO ADD 12 MO WP710 0000570C 20 UYEAR SUB 1 UYEAR WP710 00580C ME,MO COMP UDAY 20 WP710 00590C MOVE ME,MO UDAY WP710 00600C MOVELUDAY DY 40 WP710 00610C MOVE UYEAR DY WP710 00620C MOVE DY DATE 60 WP710 00630C MOVELMO DATE WP710 0000640C MOVE UDAY DA 20 WP710 00650C MOVE UYEAR YR 20 WP710 00660C SETON 9998 WP710 00670C GOTO START WP710 00680C GETDAT TAG WP710 00690C MOVEL'TYPE CUT'WORD16 16 WP710 00700C MOVE 'OFF DATE'WORD16 WP710 0000710C WORD16 DSPLYCONSOL DATE WP710 00720C MOVELDATE MO WP710 00730C MOVE DATE DY WP710 00740C MOVELDY DA WP710 00750C MOVE DY YR WP710 00760C MO COMP 0 20 WP710 00770C N20 MO COMP 12 20 WP710 0000780C 20 GOTO GETDAT WP710 00790C DA COMP 0 20 WP710 00800C N20 DA COMP 31 20 WP710 00810C 20 GOTO GETDAT WP710 00820C YR COMP 70 20 WP710 00830C 20 GOTO GETDAT WP710 00840C SETON 9998 WP710 0000850C START TAG WP710 00860C 02 WP710 00870COR 03 GOTO DEND WP710 00880C CLSYR COMP YR 81 80 WP710 00890C 80 CLSMO COMP MO 81 80 WP710 00900C 80 CLSDA COMP DA 81 80 WP710 00910C 81 SETON 80 WP710 0000920C DEND TAG WP710 00930O$LP1 H 02 98 WP710 00940O OR OF WP710 00950O HEAD 86 WP710 00960O H 1 98 WP710 00970O OR OF WP710 00980O OR OF WP710 0000990O 4 'PAGE' WP710 01000O PAGE Z 8 WP710 01010O 77 'JOBS REMOVED FROM FILE' WP710 01020O 132 'JOB710' WP710 01030O 93 'CUTOFF DATE' WP710 01040O DATE Y 103 WP710 01050O H 2 98 WP710 0001060O OR OF WP710 01070O 21 'W.O.# PART NUMBER' WP710 01080O 48 'QTY CLOSE' WP710 01090O 75 '----- D O L L A R S' WP710 01100O 106 '----- - H O U R S-' WP710 01110O 117 'QTY' WP710 01120O H 11 98 WP710 0001130O OR OF WP710 01140O 48 'COMPLT DATE' WP710 01150O 74 'MATERL LABOR BURDEN' WP710 01160O 90 'OUT-PR REWORK' WP710 01170O 106 'LABOR REWORK' WP710 01180O 117 'SCRAP' WP710 01190O D 1 01N80 WP710 0001200O OR 02 WP710 01210O WONUM Z 5 WP710 01220O PARTNO 30 WP710 01230O QTYC L 39 WP710 01240O CLSDATY 48 WP710 01250O MAT$ L 59 WP710 01260O LAB$ L 67 WP710 0001270O BUR$ L 75 WP710 01280O OP$ L 83 WP710 01290O RWK$ L 91 WP710 01300O LABH L 100 WP710 01310O RWKH L 107 WP710 01320O 01 131 '*CLOSED' WP710 01330O 02 132 '*DELETED' WP710 0001340O QTYS L 118 WP710 01350ONWKORD D 01 80 WP710 01360O OR 03 WP710 01370O REC 160 WP710 ** 001380ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001390ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00140000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001410ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001420** 001430312831303130313130313031 001440/* 001450_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( 9TXWKENT P999999111111(000010H S WKENT 00020X DECK-ID P17 MFG/DIST/ACCT SYSTEM SUMMARY-123 WKENT 00030F* CYBER 18-10M/20 ROUTING VERSION 1.0WKENT 00040F* ENTER WORKORDER TRANSACTIONS WKENT 00050F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WKENT 00060F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WKENT 00070F* CONTROL DATA PROPRIETARY PRODUCT WKENT 0000080F* WKENT 00090FWKDUM IPE F 72 DISK WKENT 00100FKPROGS IC F 36R 8AI 1 DISK WKENT 00110FWKOUT UC F 128R DISK WKENT 00120F********************************************************************WKENT 00130F* INDICATOR FUNCTION LIST WKENT 00140F* 01 DUMMY RECORD WKENT 0000150F* 02 KEYPYNCH PARAMETER FILE WKENT 00160F* 05 KEYPUNCH DATA FILE WKENT 00170F* 18 WKENT 00180F* 19 WKENT 00190F* 20 WKENT 00200F* 21 WKENT 00210F* 25 RETRY ON RUBOUT WKENT 0000220F* 27 AUTO DUP WKENT 00230F* 28 WKENT 00240F* 29 WKENT 00250F* 40 MODE IS A-ADD WKENT 00260F* 41 MODE IS C-CHANGE WKENT 00270F* 42 MODE IS V-VERIFY WKENT 00280F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS WKENT 0000290F* 44 MODE IS E-END OF JOB WKENT 00300F* 56 SEQ NBR NOT IN KPFILE WKENT 00310F* 60 NEW PROGRAM NBR ONLY WKENT 00320F* 61 AUTO DUP ONLY WKENT 00330F* 70 WKENT 00340F* 72 WKENT 00350F* 73 MODE IS LESS THAN OR = 4 WKENT 0000360F* 81 MODE IS INVALID WKENT 00370F* 82 BAD PROG NBR WKENT 00380F* 83 FIRST FIELD NAME BLANK WKENT 00390F* 84 OUTPUT FIELD NAME WKENT 00400F* 85 WKENT 00410F* 88 SEQ NBR NOT IN KPFILE WKENT 00420F* 90 AUTO DUP ON WKENT 0000430F* 95 WKENT 00440F* 98 RCD WITHIN OPERATOR LIMITS WKENT 00450F* LR WKENT 00460F********************************************************************WKENT 00470E MSG 1 10 25 WKENT 00480E SFN 80 20 WKENT 00490E SAN 80 1 WKENT 0000500E SAD 80 1 WKENT 00510E SST 80 3 0 WKENT 00520E SLN 80 2 0 WKENT 00530E SNM 4 6 WKENT 00540E SMX 4 2 0 WKENT 00550E NP 4 1 0 WKENT 00560E ARY1 1 2 50 WKENT 0000570IWKDUM NS 01 WKENT 00580I 1 1 A WKENT 00590IKPROGS NS 02 WKENT 00600I 9 28 FN WKENT 00610I 29 29 AN WKENT 00620I 30 30 AD WKENT 00630I 31 33 ST WKENT 0000640I 34 35 LN WKENT 00650I 36 36 DCODE WKENT 00660IWKOUT NS 05 WKENT 00670I 1 128 RECORD WKENT 00680C MOVE ' ' B72 72 WKENT 00690C EXSR ALMTS WKENT 00700C Z-ADDLOW SEQNO WKENT 0000710C NLR SETON LR WKENT 00720CLR START TAG WKENT 00730CLR MOVEL'' WORD WKENT 01600CLR Z-ADD1 OLN WKENT 01610CLR Z-ADD1 ILN WKENT 0001620CLR EXSR TYPES WKENT 01630CLR MOVELBUFFER MODE WKENT 01640CLR MODE COMP '4' 7373 WKENT 01650CLR MODE COMP 'P' 60 NEW PROG#ONLY WKENT 01660CLR MODE COMP 'D' 61 AUTO-DUP ONLY WKENT 01670CLRN60N61N73 GOTO CHKMOD WKENT 01680CLR 73 MOVE MODE NPN 10 WKENT 0001690CLR EXSR GETPRG WKENT 01700CLR SETOF 606173 WKENT 01710CLR GOTO SAMREC WKENT 01720CLR CHKNUM TAG WKENT 01730CLR MOVELBUFFER MODE WKENT 01740CLR MODE COMP '@' 20 WKENT 01750CLR 20N42 GOTO OUTREC WKENT 0001760CLR SAN,N COMP 'N' 19 WKENT 01770CLRN19 GOTO CHKVER WKENT 01780CLR Z-ADDSLN,N VL 20 WKENT 01790CLR MOVELBUFFER VAR 15 WKENT 01800CLR EXIT SUBRAJ WKENT 01810CLR RLABL VL WKENT 01820CLR RLABL VAR WKENT 0001830CLR MOVELVAR BUFFER WKENT 01840CLR Z-ADDVL BLNGTH WKENT 01850CLR EXSR EXCPT WKENT 01860CLR SETOF 19 WKENT 01870CLR CHKVER TAG WKENT 01880CLRN42 GOTO MOVBUF WKENT 01890CLR TBUF COMP BUFFER 2020 WKENT 0001900CLRN20 GOTO MOVBUF WKENT 01910CLR MOVEL'KP VERIF'WORD WKENT 01920CLR MOVE 'Y ERROR 'WORD WKENT 01930CLR MOVELWORD BUFFER WKENT 01940CLR MOVE 'R' TYPE WKENT 01950CLR Z-ADD6 MASK ONLY 'R' OR 'E'WKENT 01960CLR EXSR CRTCOM WKENT 0001970CLR RCODE COMP 'R' 20 WKENT 01980CLR 20 GOTO OUTFLD WKENT 01990CLR MOVBUF TAG WKENT 02000CLR Z-ADDSST,N TSTRT 30 WKENT 02010CLR Z-ADDSLN,N NCHARS 30 WKENT 02020CLR Z-ADD1 SSTRT WKENT 02030CLR EXIT SUBRMV WKENT 0002040CLR RLABL BUFFER WKENT 02050CLR RLABL SSTRT WKENT 02060CLR RLABL RECORD WKENT 02070CLR RLABL TSTRT WKENT 02080CLR RLABL NCHARS WKENT 02090CLR GOTO LOOP WKENT 02100CLR RITDUP TAG WKENT 0002110CLR EXSR MVRECD WKENT 02120CLR SETON 19 WKENT 02130CLR Z-ADDSLN,N BLNGTH WKENT 02140CLRN27 EXSR EXCPT WKENT 02150CLR SETOF 19 WKENT 02160CLR GOTO MOVBUF WKENT 02170CLR OUTREC TAG WKENT 0002180CLR SETON 187084 WKENT 02190CLR SETON 85 WKENT 02200CLR EXCPT WKENT 02210CLR EXSR EXCPT WKENT 02220CLR SETOF 708485 WKENT 02230CLR MOVELRECORD OLDREC128 WKENT 02240CLR NP,PN COMP 0 72 WKENT 0002250CLRN72 GOTO NXTREC WKENT 02260CLR MOVE NP,PN NPN WKENT 02270CLR EXSR GETPRG WKENT 02280CLR SETOF 72 WKENT 02290CLR GOTO NXTREC WKENT 02300CLR EOJ TAG WKENT 02310C********************************************************************WKENT 0002320C* WKENT 02330C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION WKENT 02340C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. WKENT 02350C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. WKENT 02360C* WKENT 02370C********************************************************************WKENT 02380CSR GETPRG BEGSR WKENT 0002390CSR 61 GOTO JMPOUT WKENT 02400CSR 72 WKENT 02410COR 73 GOTO CHKPN WKENT 02420CSR GETPNO TAG WKENT 02430CSR MOVEL'PROG # -'WORD WKENT 02440CSR Z-ADD8 OLN WKENT 02450CSR Z-ADD1 ILN WKENT 0002460CSR EXSR TYPES WKENT 02470CSR MOVELBUFFER NPN 10 WKENT 02480CSR CHKPN TAG WKENT 02490CSR NPN COMP 0 2020 WKENT 02500CSRN20 NPN COMP 4 20 BAD PROG# WKENT 02510CSR 20 SETON 82 WKENT 02520CSR 82 EXSR EXCPT WKENT 0002530CSR SETOF 82 WKENT 02540CSR 20 GOTO GETPNO TRY PROG# AGAINWKENT 02550CSR MOVE NPN PN 10 INWKENT 02560CSR MOVE PN NAME10 10 WKENT 02570CSRN43 SNM,PN COMP ' ' 6060 WKENT 02580CSR 60 PN SUB 1 BP 20 WKENT 02590CSR 60 BP MULT 20 BP WKENT 0002600CSR 72 GOTO SETHED WKENT 02610CSR 73 GOTO JMPOUT WKENT 02620CSR 60 GOTO JMPOUT WKENT 02630CSR GETPNM TAG WKENT 02640CSR MOVEL'PROG NAM'WORD WKENT 02650CSR MOVE 'E - 'WORD WKENT 02660CSR Z-ADD11 OLN WKENT 0002670CSR Z-ADD6 ILN WKENT 02680CSR EXSR TYPES WKENT 02690CSR MOVELBUFFER PNAME 8 WKENT 02700CSR MOVE ' ' PNAME WKENT 02710CSR CHNPRG TAG WKENT 02720CSR PNAME CHAINKPROGS 27 WKENT 02730CSRN27 MOVELPNAME SNM,PN WKENT 0002740CSRN27 GOTO LOADIT WKENT 02750CSR MOVEL' 'WORD WKENT 02760CSR MOVELPNAME WORD WKENT 02770CSR MOVE 'ABSENT 'WORD WKENT 02780CSR MOVE 'R' TYPE 1 WKENT 02790CSR MOVELWORD BUFFER WKENT 02800CSR Z-ADD7 MASK 10 WKENT 0002810CSR Z-ADD16 BLNGTH WKENT 02820CSR EXSR CRTCOM WKENT 02830CSR RCODE COMP 'E' 20 WKENT 02840CSR PRGMT TAG WKENT 02850C*R 20 EXSR PROGMT WKENT 02860C*R 20 GOTO CHNPRG WKENT 02870CSR GOTO GETPNM WKENT 0002880CSR LOADIT TAG WKENT 02890CSR Z-ADD14 OLN WKENT 02900CSR Z-ADD1 ILN WKENT 02910CSR MOVEL'NEXT PRO'WORD WKENT 02920CSR MOVE 'G # - 'WORD WKENT 02930CSR EXSR TYPES WKENT 02940CSR MOVELBUFFER NP,PN WKENT 0002950CSR PN SUB 1 BP WKENT 02960CSR BP MULT 20 BP WKENT 02970CSR BP ADD 1 N 20 WKENT 02980CSR Z-ADD1 X 20 WKENT 02990CSR BLDARY TAG WKENT 03000CSR FN COMP B72 20 WKENT 03010CSR 20 N SUB 1 MAXFLD 20 WKENT 0003020CSR 20 MOVE MAXFLD SMX,PN WKENT 03030CSR 20 GOTO JMPOUT WKENT 03040CSR MOVE FN SFN,N FIELD NAME WKENT 03050CSR MOVE AN SAN,N ALPHA OR NUMER WKENT 03060CSR MOVE AD SAD,N AUTO DUP WKENT 03070CSR MOVE ST SST,N START POSITION WKENT 03080CSR MOVE LN SLN,N WKENT 0003090CSR MVX TAG WKENT 03100CSR MOVE X PNAME WKENT 03110CSR PNAME CHAINKPROGS 20 WKENT 03120CSR X ADD 1 X WKENT 03130CSRN20 X COMP 20 20 WKENT 03140CSR 20 Z-ADDN MAXFLD WKENT 03150CSR 20 MOVE MAXFLD SMX,PN WKENT 0003160CSR DCODE COMP 'D' 21 WKENT 03170CSR 21N20 GOTO MVX WKENT 03180CSRN20 N ADD 1 N WKENT 03190CSRN20 GOTO BLDARY WKENT 03200CSR JMPOUT TAG WKENT 03210CSR 43 GOTO ENDGET WKENT 03220CSR 41 GOTO SETHED WKENT 0003230CSR MOVEL'AUTO-DUP'WORD WKENT 03240CSR MOVE ' - 'WORD WKENT 03250CSR Z-ADD11 OLN WKENT 03260CSR Z-ADD1 ILN WKENT 03270CSR EXSR TYPES WKENT 03280CSR MOVELBUFFER AUTO 1 WKENT 03290CSR AUTO COMP 'O' 90AUTO-DUP ON WKENT 0003300CSR SETHED TAG WKENT 03310CSR MOVELSNM,PN NAME10 WKENT 03320CSR MOVELNAME10 WORD WKENT 03330CSR MOVE SMX,PN MAXFLD 20 WKENT 03340CSR 90 MOVE ' ON' WORD WKENT 03350CSRN90 MOVE 'OFF' WORD WKENT 03360CSR MOVELWORD HEAD 40 WKENT 0003370CSR ENDGET ENDSR WKENT 03380C********************************************************************WKENT 03390C* WKENT 03400C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST WKENT 03410C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE WKENT 03420C* CHANGED WKENT 03430C* WKENT 0003440C********************************************************************WKENT 03450CSR GETSEQ BEGSR WKENT 03460CSR MOVEL'SEQ # - 'WORD WKENT 03470CSR Z-ADD8 OLN WKENT 03480CSR Z-ADD5 ILN WKENT 03490CSR EXSR TYPES WKENT 03500CSR Z-ADD5 VL WKENT 0003510CSR MOVELBUFFER VAR WKENT 03520CSR EXIT SUBRAJ WKENT 03530CSR RLABL VL WKENT 03540CSR RLABL VAR WKENT 03550CSR MOVELVAR SEQNO WKENT 03560CSR SEQNO COMP 0 20 WKENT 03570CSRN20 Z-ADD1 SEQNO WKENT 0003580CSR SETON 95 WKENT 03590CSR ENDSEQ ENDSR WKENT 03600C********************************************************************WKENT 03610C* WKENT 03620C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO WKENT 03630C* WKENT 03640C********************************************************************WKENT 0003650CSR GETREC BEGSR WKENT 03660CSR SEQRD TAG WKENT 03670CSR EXSR TSTSEQ WKENT 03680CSR 94 EXSR GETSEQ WKENT 03690CSR 94 GOTO SEQRD WKENT 03700CSR SEQNO CHAINWKOUT 56 WKENT 03710CSR MOVELRECORD TST 2 WKENT 0003720CSR TST COMP '<>' 99 WKENT 03730CSR 40N99 SEQNO ADD 1 SEQNO WKENT 03740CSR 40N99 GOTO SEQRD WKENT 03750CSR 41 99 EXSR NOCHG WKENT 03760CSR 41 99 GOTO SEQRD WKENT 03770CSR 56 SETON 88 WKENT 03780CSR 88 EXSR EXCPT WKENT 0003790CSR SETOF 88 WKENT 03800CSR 56 EXSR GETSEQ WKENT 03810CSR 56 GOTO SEQRD WKENT 03820CSR ENDSR WKENT 03830C********************************************************************WKENT 03840C* WKENT 03850C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY WKENT 0003860C* IS DONE IF A RUBOUT IS USED WKENT 03870C* WKENT 03880C********************************************************************WKENT 03890CSR TYPES BEGSR WKENT 03900CSR OVER TAG WKENT 03910CSR Z-ADDOLN BLNGTH WKENT 03920CSR MOVELWORD BUFFER WKENT 0003930CSR MOVE 'S' TYPE WKENT 03940CSR EXSR CRTCOM WKENT 03950CSR MOVE 'A' TYPE WKENT 03960CSR Z-ADDILN BLNGTH WKENT 03970CSR EXSR CRTCOM WKENT 03980CSR RCODE COMP 'R' 25 WKENT 03990CSR 25 EXSR SKIP WKENT 0004000CSR 25 GOTO OVER WKENT 04010CSR RCODE COMP 'O' 25 WKENT 04020CSR 25 EXSR SKIP WKENT 04030CSR ENDSR WKENT 04040C********************************************************************WKENT 04050C* WKENT 04060C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT WKENT 0004070C* WKENT 04080C********************************************************************WKENT 04090CSR SKIP BEGSR WKENT 04100CSR MOVELBUFFER NBUF 1 WKENT 04110CSR MOVEL' ' BUFFER WKENT 04120CSR Z-ADD1 BLNGTH WKENT 04130CSR MOVE 'T' TYPE WKENT 0004140CSR EXSR CRTCOM WKENT 04150CSR MOVELNBUF BUFFER WKENT 04160CSR ENDSR WKENT 04170C********************************************************************WKENT 04180C* WKENT 04190C* WKENT 04200C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED WKENT 0004210C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER WKENT 04220C* WKENT 04230CSR MVRECD BEGSR WKENT 04240CSR MOVELB72 BUFFER WKENT 04250CSR Z-ADD1 TSTRT WKENT 04260CSR Z-ADDSST,N SSTRT WKENT 04270CSR Z-ADDSLN,N NCHARS WKENT 0004280CSR EXIT SUBRMV WKENT 04290CSR RLABL OLDREC WKENT 04300CSR RLABL SSTRT 30 WKENT 04310CSR RLABL BUFFER WKENT 04320CSR RLABL TSTRT 30 WKENT 04330CSR RLABL NCHARS 30 WKENT 04340CSR ENDSR WKENT 0004350C********************************************************************WKENT 04360CSR EXCPT BEGSR WKENT 04370CSRN81N82N83 WKENT 04380CANN84N88 GOTO PUTOUT WKENT 04390CSR MOVELB72 BUFFER WKENT 04400CSR 81 MOVELMSG,1 BUFFER WKENT 04410CSR 83 MOVELMSG,2 BUFFER WKENT 0004420CSR 88 MOVELMSG,3 BUFFER WKENT 04430CSR 82 MOVELMSG,4 BUFFER WKENT 04440CSRN84 GOTO PUTOUT WKENT 04450CSRN85 MOVELSFN,N BUFFER WKENT 04460CSRN18 Z-ADD20 BLNGTH WKENT 04470CSRN18 GOTO PUTOUT WKENT 04480CSR MOVELHEAD BUFFER WKENT 0004490CSR MOVE 'T' TYPE WKENT 04500CSR Z-ADD69 BLNGTH WKENT 04510CSR EXSR CRTCOM WKENT 04520CSR MOVELSFN,N BUFFER WKENT 04530CSR Z-ADD20 BLNGTH WKENT 04540CSR PUTOUT TAG WKENT 04550CSR MOVE 'S' TYPE WKENT 0004560CSR EXSR CRTCOM WKENT 04570CSR ENDSR WKENT 04580C* WKENT 04590CSR ALMTS BEGSR WKENT 04600CSR MOVE 'C' TYPE 1 WKENT 04610CSR Z-ADD0 BLNGTH 20 WKENT 04620CSR MOVE ' ' RCODE 1 WKENT 0004630CSR Z-ADD0 MASK 10 WKENT 04640CSR Z-ADD0 DTYPE 10 WKENT 04650CSR EXSR CRTCOM WKENT 04660CSR MOVELARY1,1 BUFFER WKENT 04670CSR MOVE 'S' TYPE WKENT 04680CSR Z-ADD50 BLNGTH WKENT 04690CSR EXSR CRTCOM WKENT 0004700CSR MOVE 'A' TYPE WKENT 04710CSR Z-ADD5 BLNGTH WKENT 04720CSR Z-ADD1 DTYPE WKENT 04730CSR EXSR CRTCOM WKENT 04740CSR EXSR SKIP WKENT 04750CSR RCODE COMP 'R' 86 WKENT 04760CSR Z-ADD5 VL WKENT 0004770CSR MOVELBUFFER VAR WKENT 04780CSR EXIT SUBRAJ WKENT 04790CSR RLABL VL WKENT 04800CSR RLABL VAR WKENT 04810CSR MOVELVAR BUFFER WKENT 04820CSR MOVELBUFFER LOW 50 WKENT 04830CSR MOVELARY1,2 BUFFER WKENT 0004840CSR MOVE 'S' TYPE WKENT 04850CSR Z-ADD50 BLNGTH WKENT 04860CSR EXSR CRTCOM WKENT 04870CSR MOVE 'A' TYPE WKENT 04880CSR Z-ADD5 BLNGTH WKENT 04890CSR Z-ADD1 DTYPE WKENT 04900CSR EXSR CRTCOM WKENT 0004910CSR RCODE COMP 'R' 87 WKENT 04920CSR Z-ADD5 VL WKENT 04930CSR MOVELBUFFER VAR WKENT 04940CSR EXIT SUBRAJ WKENT 04950CSR RLABL VL WKENT 04960CSR RLABL VAR WKENT 04970CSR MOVELVAR BUFFER WKENT 0004980CSR MOVELBUFFER HIGH 50 WKENT 04990CSR MOVE 'C' TYPE WKENT 05000CSR EXSR CRTCOM WKENT 05010CSR 86 WKENT 05020COR 87 GOTO ALMTS WKENT 05030CSR Z-ADD0 DTYPE WKENT 05040CSR ENDSR WKENT 0005050CSR CRTCOM BEGSR WKENT 05060CSR EXITFSUBRCM WKENT 05070CSR RLABL BUFFER WKENT 05080CSR RLABL TYPE WKENT 05090CSR RLABL BLNGTH WKENT 05100CSR RLABL RCODE WKENT 05110CSR RLABL MASK WKENT 0005120CSR RLABL DTYPE WKENT 05130CSR ENDSR WKENT 05140CSR PUTSEQ BEGSR WKENT 05150CSR MOVELMSG,5 BUFFER 72 WKENT 05160CSR MOVE 'S' TYPE WKENT 05170CSR Z-ADD25 BLNGTH WKENT 05180CSR EXSR CRTCOM WKENT 0005190CSR MOVELSEQNO BUFFER WKENT 05200CSR MOVE 'T' TYPE WKENT 05210CSR Z-ADD5 BLNGTH WKENT 05220CSR EXSR CRTCOM WKENT 05230CSR ENDSR WKENT 05240CSR TSTSEQ BEGSR WKENT 05250CSR SETOF 949697 WKENT 0005260CSR SEQNO COMP LOW 989698 WKENT 05270CSR 98 SEQNO COMP HIGH 979898 WKENT 05280CSR 98 GOTO ENDTST WKENT 05290CSR 40 96 MOVELMSG,6 BUFFER WKENT 05300CSR 40 97 MOVELMSG,7 BUFFER WKENT 05310CSRN40 MOVELMSG,8 BUFFER WKENT 05320CSRN40 SETON 94 WKENT 0005330CSR MOVE 'T' TYPE WKENT 05340CSR Z-ADD25 BLNGTH WKENT 05350CSR EXSR CRTCOM WKENT 05360CSR 40 97 MOVE 'F' TYPE WKENT 05370CSR 40 97 EXSR CRTCOM WKENT 05380CSR ENDTST ENDSR WKENT 05390CSR NOCHG BEGSR WKENT 0005400CSR MOVELMSG,9 BUFFER WKENT 05410CSR MOVE 'T' TYPE WKENT 05420CSR Z-ADD25 BLNGTH WKENT 05430CSR EXSR CRTCOM WKENT 05440CSR EXSR GETSEQ WKENT 05450CSR ENDSR WKENT 05460C********************************************************************WKENT 0005470OWKOUT E 70N56 WKENT 05480O RECORD 128 WKENT 05490O 42 128 'X' WKENT 05500O SEQNO 127 WKENT ** 005510ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005520ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00553000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005540ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005550** 005560MODE MUST BE A,C,V,OR E 005570FIRST FIELD NAME BLANK 005580INVALID SEQ # 005590PROG# MUST BE FROM 1-4 00560000CURRENT SEQUENCE NBR 005610SEQNO TOO LOW 005620RUN EDIT PROG-FILE FULL 005630SEQNO NOT IN YOUR LIMITS 005640ILLEGAL CHANGE-NO DATA 005650** 005660ENTER BEGINNING RELATIVE RECORD NUMBER 00567000ENTER ENDING RELATIVE RECORD NUMBER 005680/* 005690__EDIT PROG-FILE FULL 005630SEQNO NOT IN YOUR LIMITS 005640ILLEGAL CHANGE-NO DATA 005650** 005660ENTER BEGINNING RELATIVE RECORD NUMBER 0056700({ 4TXWPERR P999999111111(000010H S WPERR 00020X DECK-ID P26 MFG/DIST/ACCT SYSTEM SUMMARY-123 WPERR 00030F* LOAD ERROR CODE FILE FOR WORK IN PROCESS WPERR 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WPERR 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WPERR 00060F* CONTROL DATA PROPRIETARY PRODUCT WPERR 00070F* WPERR 0000080FECSEQ IPE F 80 DISK WPERR 00090FECODES OC F 40R DISK WPERR 00100FPRINT O F 40 PRINTER WPERR 00110IECSEQ NS 02 WPERR 00120I 1 40 FLDB WPERR 00130C 02 MOVE FLDB AREAB 40 WPERR 00140C 02 MOVE 1 CNTR 10 WPERR 0000150C CNTR COMP 1 03 WPERR 00160C 03 SEQ ADD 1 SEQ 50 WPERR 00170C 03 SEQ CHAINECODES 05 WPERR 00180OECODES D 03 WPERR 00190O AREAB 40 WPERR 00200OPRINT D 2 03 WPERR 00210O AREAB 40 WPERR 00** 000220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000260/* 000270__0O AREAB 40 WPERR 0(2 &TXRT209 P999999111111(000010H S RT209 00020X DECK-ID M80 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT209 00030F* BUILDS SEQUENTAL ROUTING REQUEST FILE ROUTUPB RT209 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT209 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT209 00060F* CONTROL DATA PROPRIETARY PRODUCT RT209 00070F* RT209 0000080FRTOUT2 IP AF 128 DISK RT209 00090FROUTUPB O F 128 DISK RT209 00100F********************************************************************RT209 00110F* RT209 00120F* PACKAGE MANUFACTURING RT209 00130F* SYSTEM ROUTING RT209 00140F* PROGRAM USES RTOUT2 TO CREATE ROUTUPB RT209 0000150F* RT209 00160F********************************************************************RT209 00170F* RT209 00180F* NARRATIVE: RT209 00190F* RT209 00200F* ID F C H L FUNCTION OF INDICATORS RT209 00210F* RT209 0000220F* 01 RTOUT2 RECORD RT209 00230F* RT209 00240F* 10 RECORD CONTAINS NO DATA RT209 00250F* RT209 00260F********************************************************************RT209 00270IRTOUT2 NS 01 RT209 00280I 1 2 TST RT209 0000290I 1 128 REC RT209 00300C TST COMP '<>' 10 RT209 00310OROUTUPB D 01N10 RT209 00320O REC 128 RT209 ** 000330ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00035000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000360ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000370/* 000380__0O REC 128 RT209 ** 000330ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0003500(2 &TXRT210 P999999111111(000010H S RT210 00020X DECK-ID M81 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT210 00030F* BUILDS SEQUENTAL ROUTING UPDATES FILE ROUTUP RT210 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT210 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT210 00060F* CONTROL DATA PROPRIETARY PRODUCT RT210 00070F* RT210 0000080FRTOUT1 IP AF 128 DISK RT210 00090FROUTUP O F 128 DISK RT210 00100F********************************************************************RT210 00110F* RT210 00120F* PACKAGE MANUFACTURING RT210 00130F* SYSTEM ROUTING RT210 00140F* PROGRAM USES RTOUT1 TO CREATE ROUTUP RT210 0000150F* RT210 00160F********************************************************************RT210 00170F* RT210 00180F* NARRATIVE: RT210 00190F* RT210 00200F* ID F C H L FUNCTION OF INDICATORS RT210 00210F* RT210 0000220F* 01 RTOUT1 RECORD RT210 00230F* RT210 00240F* 10 RECORD CONTAINS NO DATA RT210 00250F* RT210 00260F********************************************************************RT210 00270IRTOUT1 NS 01 RT210 00280I 1 2 TST RT210 0000290I 1 128 REC RT210 00300C TST COMP '<>' 10 RT210 00310OROUTUP D 01N10 RT210 00320O REC 128 RT210 ** 000330ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00035000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000360ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000370/* 000380__0O REC 128 RT210 ** 000330ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0003500( ?TXRT213 P999999111111(000010H S RT213 00020X DECK-ID M82 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT213 00030F* THIS PROGRAM DISPLAYS LAST RECORD ENTERED BY RKPCHA ENTRY PROG. RT213 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT213 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT213 00060F* CONTROL DATA PROPRIETARY PRODUCT RT213 00070F* RT213 0000080FRTDUM UPE F 72 DISK RT213 00090FRTOUT1 IC F 128R DISK RT213 00100E MSG 1 5 35 RT213 00110IRTDUM NS 01 RT213 00120I 1 72 ALL RT213 00130IRTOUT1 NS 02 RT213 00140I 1 128 RCD RT213 0000150C SETOF 60 RT213 00160C SETON LR RT213 00170CLR MOVE ' ' B80 80 RT213 00180CLR EXSR ALMTS RT213 00190CLR Z-ADDLOW SEQNO 50 RT213 00200CLR LOOP TAG RT213 00210CLR SEQNO COMP HIGH 40 RT213 0000220CLR 40 GOTO A RT213 00230CLR SEQNO CHAINRTOUT1 50 RT213 00240CLR 50 GOTO A RT213 00250CLR MOVELRCD TST 2 RT213 00260CLR TST COMP '<>' 51 RT213 00270CLRN51 SEQNO ADD 1 SEQNO RT213 00280CLRN51 GOTO LOOP RT213 0000290CLR A TAG RT213 00300CLR SEQNO SUB 1 SUBNO 50 RT213 00310CLR SUBNO CHAINRTOUT1 50 RT213 00320CLR MOVELRCD BUFFER RT213 00330CLR MOVE 'T' TYPE RT213 00340CLR Z-ADD80 BLNGTH RT213 00350CLR EXSR CRTCOM RT213 0000360CLR MOVE RCD HOLD 48 RT213 00370CLR MOVE B80 BUFFER RT213 00380CLR MOVE 'T' TYPE RT213 00390CLR MOVELHOLD HOLD1 47 RT213 00400CLR MOVELHOLD HOLD2 42 RT213 00410CLR MOVELHOLD2 BUFFER RT213 00420CLR Z-ADD42 BLNGTH RT213 0000430CLR EXSR CRTCOM RT213 00440CLR MOVE B80 BUFFER RT213 00450CLR MOVELMSG,3 BUFFER RT213 00460CLR MOVE 'S' TYPE RT213 00470CLR Z-ADD35 BLNGTH RT213 00480CLR EXSR CRTCOM RT213 00490CLR MOVE B80 BUFFER RT213 0000500CLR MOVE HOLD1 HLDSEQ 5 RT213 00510CLR MOVELHLDSEQ BUFFER RT213 00520CLR MOVE 'T' TYPE RT213 00530CLR Z-ADD5 BLNGTH RT213 00540CLR EXSR CRTCOM RT213 00550CLR MOVELMSG,4 BUFFER RT213 00560CLR MOVE 'S' TYPE RT213 0000570CLR Z-ADD35 BLNGTH RT213 00580CLR EXSR CRTCOM RT213 00590CLR MOVE B80 BUFFER RT213 00600CLR MOVE 'A' TYPE RT213 00610CLR Z-ADD1 BLNGTH RT213 00620CLR EXSR CRTCOM RT213 00630CLR MOVE 'C' TYPE RT213 0000640CLR EXSR CRTCOM RT213 00650CLR MOVE 'F' TYPE RT213 00660CLR EXSR CRTCOM RT213 00670CSR ALMTS BEGSR RT213 00680CSR MOVE B80 BUFFER 80 RT213 00690CSR MOVE 'C' TYPE 1 RT213 00700CSR Z-ADD0 BLNGTH 20 RT213 0000710CSR MOVE ' ' RCODE 1 RT213 00720CSR Z-ADD0 MASK 10 RT213 00730CSR Z-ADD0 DTYPE 10 RT213 00740CSR EXSR CRTCOM RT213 00750CSR MOVELMSG,1 BUFFER RT213 00760CSR MOVE 'S' TYPE RT213 00770CSR Z-ADD35 BLNGTH RT213 0000780CSR EXSR CRTCOM RT213 00790CSR MOVE B80 BUFFER RT213 00800CSR MOVE 'A' TYPE RT213 00810CSR Z-ADD5 BLNGTH RT213 00820CSR Z-ADD1 DTYPE RT213 00830CSR EXSR CRTCOM RT213 00840CSR EXSR SKIP RT213 0000850CSR RCODE COMP 'R' 86 RT213 00860CSR EXSR AJ RT213 00870CSR MOVELBUFFER LOW 50 RT213 00880CSR MOVE B80 BUFFER RT213 00890CSR MOVELMSG,2 BUFFER RT213 00900CSR MOVE 'S' TYPE RT213 00910CSR Z-ADD35 BLNGTH RT213 0000920CSR EXSR CRTCOM RT213 00930CSR MOVE B80 BUFFER RT213 00940CSR MOVE 'A' TYPE RT213 00950CSR Z-ADD5 BLNGTH RT213 00960CSR Z-ADD1 DTYPE RT213 00970CSR EXSR CRTCOM RT213 00980CSR RCODE COMP 'R' 87 RT213 0000990CSR EXSR AJ RT213 01000CSR MOVELBUFFER HIGH 50 RT213 01010CSR MOVE 'C' TYPE RT213 01020CSR EXSR CRTCOM RT213 01030CSR 86 RT213 01040COR 87 GOTO ALMTS RT213 01050CSR Z-ADD0 DTYPE RT213 0001060CSR ENDSR RT213 01070CSR CRTCOM BEGSR RT213 01080CSR EXITFSUBRCM RT213 01090CSR RLABL BUFFER RT213 01100CSR RLABL TYPE RT213 01110CSR RLABL BLNGTH RT213 01120CSR RLABL RCODE RT213 0001130CSR RLABL MASK RT213 01140CSR RLABL DTYPE RT213 01150CSR ENDSR RT213 01160CSR SKIP BEGSR RT213 01170CSR MOVELBUFFER NBUF 1 RT213 01180CSR MOVEL' ' BUFFER RT213 01190CSR Z-ADD1 BLNGTH RT213 0001200CSR MOVE 'T' TYPE RT213 01210CSR EXSR CRTCOM RT213 01220CSR MOVELNBUF BUFFER RT213 01230CSR ENDSR RT213 01240CSR AJ BEGSR RT213 01250CSR MOVELBUFFER VAR 15 RT213 01260CSR Z-ADD5 VL 20 RT213 0001270CSR EXIT SUBRAJ RT213 01280CSR RLABL VL RT213 01290CSR RLABL VAR RT213 01300CSR MOVELVAR BUFFER RT213 01310CSR ENDSR RT213 01320ORTDUM D 60 RT213 01330O ALL 72 RT213 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000(` ?TXRT214 P999999111111(000010H S RT214 00020X DECK-ID M83 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT214 00030F* THIS PROGRAM DISPLAYS LAST RECORD ENTERED BY RKPCHB ENTRY PROG. RT214 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT214 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT214 00060F* CONTROL DATA PROPRIETARY PRODUCT RT214 00070F* RT214 0000080FRTDUM UPE F 72 DISK RT214 00090FRTOUT2 IC F 128R DISK RT214 00100E MSG 1 5 35 RT214 00110IRTDUM NS 01 RT214 00120I 1 72 ALL RT214 00130IRTOUT2 NS 02 RT214 00140I 1 128 RCD RT214 0000150C SETOF 60 RT214 00160C SETON LR RT214 00170CLR MOVE ' ' B80 80 RT214 00180CLR EXSR ALMTS RT214 00190CLR Z-ADDLOW SEQNO 50 RT214 00200CLR LOOP TAG RT214 00210CLR SEQNO COMP HIGH 40 RT214 0000220CLR 40 GOTO A RT214 00230CLR SEQNO CHAINRTOUT2 50 RT214 00240CLR 50 GOTO A RT214 00250CLR MOVELRCD TST 2 RT214 00260CLR TST COMP '<>' 51 RT214 00270CLRN51 SEQNO ADD 1 SEQNO RT214 00280CLRN51 GOTO LOOP RT214 0000290CLR A TAG RT214 00300CLR SEQNO SUB 1 SUBNO 50 RT214 00310CLR SUBNO CHAINRTOUT2 50 RT214 00320CLR MOVELRCD BUFFER RT214 00330CLR MOVE 'T' TYPE RT214 00340CLR Z-ADD80 BLNGTH RT214 00350CLR EXSR CRTCOM RT214 0000360CLR MOVE RCD HOLD 48 RT214 00370CLR MOVE B80 BUFFER RT214 00380CLR MOVE 'T' TYPE RT214 00390CLR MOVELHOLD HOLD1 47 RT214 00400CLR MOVELHOLD HOLD2 42 RT214 00410CLR MOVELHOLD2 BUFFER RT214 00420CLR Z-ADD42 BLNGTH RT214 0000430CLR EXSR CRTCOM RT214 00440CLR MOVE B80 BUFFER RT214 00450CLR MOVELMSG,3 BUFFER RT214 00460CLR MOVE 'S' TYPE RT214 00470CLR Z-ADD35 BLNGTH RT214 00480CLR EXSR CRTCOM RT214 00490CLR MOVE B80 BUFFER RT214 0000500CLR MOVE HOLD1 HLDSEQ 5 RT214 00510CLR MOVELHLDSEQ BUFFER RT214 00520CLR MOVE 'T' TYPE RT214 00530CLR Z-ADD5 BLNGTH RT214 00540CLR EXSR CRTCOM RT214 00550CLR MOVELMSG,4 BUFFER RT214 00560CLR MOVE 'S' TYPE RT214 0000570CLR Z-ADD35 BLNGTH RT214 00580CLR EXSR CRTCOM RT214 00590CLR MOVE B80 BUFFER RT214 00600CLR MOVE 'A' TYPE RT214 00610CLR Z-ADD1 BLNGTH RT214 00620CLR EXSR CRTCOM RT214 00630CLR MOVE 'C' TYPE RT214 0000640CLR EXSR CRTCOM RT214 00650CLR MOVE 'F' TYPE RT214 00660CLR EXSR CRTCOM RT214 00670CSR ALMTS BEGSR RT214 00680CSR MOVE B80 BUFFER 80 RT214 00690CSR MOVE 'C' TYPE 1 RT214 00700CSR Z-ADD0 BLNGTH 20 RT214 0000710CSR MOVE ' ' RCODE 1 RT214 00720CSR Z-ADD0 MASK 10 RT214 00730CSR Z-ADD0 DTYPE 10 RT214 00740CSR EXSR CRTCOM RT214 00750CSR MOVELMSG,1 BUFFER RT214 00760CSR MOVE 'S' TYPE RT214 00770CSR Z-ADD35 BLNGTH RT214 0000780CSR EXSR CRTCOM RT214 00790CSR MOVE B80 BUFFER RT214 00800CSR MOVE 'A' TYPE RT214 00810CSR Z-ADD5 BLNGTH RT214 00820CSR Z-ADD1 DTYPE RT214 00830CSR EXSR CRTCOM RT214 00840CSR EXSR SKIP RT214 0000850CSR RCODE COMP 'R' 86 RT214 00860CSR EXSR AJ RT214 00870CSR MOVELBUFFER LOW 50 RT214 00880CSR MOVE B80 BUFFER RT214 00890CSR MOVELMSG,2 BUFFER RT214 00900CSR MOVE 'S' TYPE RT214 00910CSR Z-ADD35 BLNGTH RT214 0000920CSR EXSR CRTCOM RT214 00930CSR MOVE B80 BUFFER RT214 00940CSR MOVE 'A' TYPE RT214 00950CSR Z-ADD5 BLNGTH RT214 00960CSR Z-ADD1 DTYPE RT214 00970CSR EXSR CRTCOM RT214 00980CSR RCODE COMP 'R' 87 RT214 0000990CSR EXSR AJ RT214 01000CSR MOVELBUFFER HIGH 50 RT214 01010CSR MOVE 'C' TYPE RT214 01020CSR EXSR CRTCOM RT214 01030CSR 86 RT214 01040COR 87 GOTO ALMTS RT214 01050CSR Z-ADD0 DTYPE RT214 0001060CSR ENDSR RT214 01070CSR CRTCOM BEGSR RT214 01080CSR EXITFSUBRCM RT214 01090CSR RLABL BUFFER RT214 01100CSR RLABL TYPE RT214 01110CSR RLABL BLNGTH RT214 01120CSR RLABL RCODE RT214 0001130CSR RLABL MASK RT214 01140CSR RLABL DTYPE RT214 01150CSR ENDSR RT214 01160CSR SKIP BEGSR RT214 01170CSR MOVELBUFFER NBUF 1 RT214 01180CSR MOVEL' ' BUFFER RT214 01190CSR Z-ADD1 BLNGTH RT214 0001200CSR MOVE 'T' TYPE RT214 01210CSR EXSR CRTCOM RT214 01220CSR MOVELNBUF BUFFER RT214 01230CSR ENDSR RT214 01240CSR AJ BEGSR RT214 01250CSR MOVELBUFFER VAR 15 RT214 01260CSR Z-ADD5 VL 20 RT214 0001270CSR EXIT SUBRAJ RT214 01280CSR RLABL VL RT214 01290CSR RLABL VAR RT214 01300CSR MOVELVAR BUFFER RT214 01310CSR ENDSR RT214 01320ORTDUM D 60 RT214 01330O ALL 72 RT214 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 00140000ENTER ENDING RRN 001410TRANSACTION RRN 001420ENTER E FOR END OF JOB 001430/* 001440__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380** 001390ENTER BEGINNING RRN 0014000( ,TXRT220 P999999111111(000010H S RT220 00020X DECK-ID M84 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT220 00030F* BUILDS UPDATED ROUTING FILE ROUTOUT RT220 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT220 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT220 00060F* CONTROL DATA PROPRIETARY PRODUCT RT220 00070F* RT220 0000080FROUTING IP AF 85 DISK RT220 00090FROUTSRT IS AF 128 DISK RT220 00100FPARTMST IC F 300R12AI 1 DISK RT220 00110FMACHMST IC F 48R 5AI 1 DISK RT220 00120FLABMST IC F 48R 2AI 1 DISK RT220 00130FHEADING IT F 40 EDISK RT220 00140FROUTOUT O F 85 DISK RT220 0000150FROUTUP O F 128 DISK RT220 00160F$LP1 O F 132 OF PRINTER RT220 00170F********************************************************************RT220 00180F* RT220 00190F* PACKAGE MANUFACTURING RT220 00200F* SYSTEM ROUTING RT220 00210F* PROGRAM EDITS ROUTSRT -AND- USES GOOD ROUTSRT RECORDS RT220 0000220F* AND ORIGINAL ROUTING TO PRODUCE ROUTOUT (AN UPDATED RT220 00230F* VERSION OF ROUTING) -AND- FOR ANY PART# WHICH HAS RT220 00240F* ITS ROUTER UPDATED ERRORLESSLY, ROUTER-REQUEST IS RT220 00250F* OUTPUT TO ROUTUP RT220 00260F* RT220 00270F* CONTRACTOR COMPUSOURCE RT220 00280F* PROGRAMMER TOM LEE RT220 0000290F* DATE MARCH 18, 1977 RT220 00300F* RT220 00310F********************************************************************RT220 00320F* ID F C H L FUNCTION OF INDICATORS RT220 00330F* RT220 00340F* 01 ROUTING RT220 00350F* 02 ROUTSRT ---> 'R' IN COL 1 (ROUTING) RT220 0000360F* 03 ROUTSRT ---> NOT 'R' IN COL 1 (NOT ROUTING) INVALIDRT220 00370F* 04 PARTMST RT220 00380F* 05 MACHMST RT220 00390F* 06 LABMST RT220 00400F* RT220 00410F* 10 BLANK PART # ) ROUTSRT RT220 00420F* 11 0 SEQUENCE # ) 02 RECORDS RT220 0000430F* 12 BLANK OPERATION CODE ) RT220 00440F* 13 BLANK OPERATION DESCRIPTION ) RT220 00450F* 14 0 PRODUCTION RATE ) RT220 00460F* 15 0 SET-UP TIME ) RT220 00470F* 16 0 QUEUE TIME ) RT220 00480F* 17 BLANK WORK STATION # ) RT220 00490F* 18 BLANK LABOR GRADE (STD) ) RT220 0000500F* 19 0 QUEUE FACTOR (SET TO 1) ) RT220 00510F* 20 0 O.P. COST/UN ) RT220 00520F* 21 BLANK MACHINE CODE ) RT220 00530F* 22 BLANK COMMENT ) RT220 00540F* RT220 00550F* 25 CHAIN TO PARTMST --> MISS OR DLT-FLAGGED RT220 00560F* 26 CHAIN TO MACHMST --> MISS OR DLT-FLAGGED RT220 0000570F* 27 CHAIN TO LABMST --> MISS OR DLT-FLAGGED RT220 00580F* 30 TRANSACTION CODE 'A' - ADD RT220 00590F* 31 TRANSACTION CODE 'C' - CHANGE RT220 00600F* 32 TRANSACTION CODE 'D' - DLT RT220 00610F* 33 TRANSACTION CODE 'M' - MULT DLT RT220 00620F* 35 MACHINE CODE 'K' - IN HOUSE RT220 00630F* 36 MACHINE CODE 'X' - O.P. RT220 0000640F* 37 MACHINE CODE ' ' - ADD/IN-HOUSE -OR- CHG/IGNORE RT220 00650F* 51 MULT-DLT PART# NOT IN ROUTING RT220 00660F* 60 INVALID TRANSACTION CODE RT220 00670F* 62 PART# BLANK RT220 00680F* 63 ADD,CHG,DLT WITH 0 SEQ# RT220 00690F* 64 CHG OR DLT WITH PART#/SEQ# NOT ON ROUTING RT220 00700F* 65 MULT-DLT WITH NON-O SEQ# RT220 0000710F* 66 DUPLICATE ADD ATTEMPT (PART#/SEQ# ALREADY ON FILE) RT220 00720F* 67 INVALID PART# RT220 00730F* 68 INVALID WORK-STATION-# RT220 00740F* 69 INVALID LABOR-GRADE RT220 00750F* 70 MACHINE CODE NOT VALID (K,X, ) RT220 00760F* 71 MACHINE CODE 'X' - BUT LACKING O.P. COST/UN RT220 00770F* 72 MACHINE CODE 'K, ' - BUT LACKING PRODUCTION RATE RT220 0000780F* 73 BLANK OPERATION CODE RT220 00790F* 74 MACHINE CODE 'K, ' - BUT HAVE O.P. COST/UN RT220 00800F* 75 MACHINE CODE 'X' - BUT HAVE PRODUCTION RATE RT220 00810F* 90 MULT DLT ON FOR THIS PART# RT220 00820F* 91 DLT ON FOR THIS PART#/SEQ# RT220 00830F* 94 PART#/SEQ# IN ROUTING RT220 00840F* 95 12 Z'S PART# ---> EOJ RT220 0000850F* 97 ROUTSRT RECORD FOR THIS PART# RT220 00860F* 98 ERROR TO AT LEAST 1 ROUTSRT RECORD FOR THIS PART# RT220 00870F* RT220 00880F* L1SEQ# 01/02 RT220 00890F* L2PART# 01/02 RT220 00900F* M1SEQ# 01/02 RT220 00910F* M2PART# 01/02 RT220 0000920F* MRPART/SEQ 01/02 RT220 00930F* RT220 00940F********************************************************************RT220 00950E HEADING HEAD 1 1 40 COMPANY NAME RT220 00960IROUTING NS 01 RT220 00970I 1 12 PART L2M2 RT220 00980I 13 140SEQ L1M1 RT220 0000990I 15 17 OPCD RT220 01000I 18 37 DESC RT220 01010I 38 423PRATE RT220 01020I 43 451SETUP RT220 01030I 46 481QUE RT220 01040I 49 53 WS RT220 01050I 54 55 LG RT220 0001060I 56 582QFAC RT220 01070I 59 653OPCST RT220 01080I 66 66 MCD RT220 01090I 67 81 COM RT220 01100I 1 85 REC RT220 01110I NS ** RT220 01120I 1 12 NXTPRT RT220 0001130IROUTSRT NS 02 1 CR RT220 01140I 2 2 RCODE RT220 01150I 3 14 RPART L2M2 10 RT220 01160I 15 160RSEQ L1M1 11 RT220 01170I 17 19 ROPCD 12 RT220 01180I 20 39 RDESC 13 RT220 01190I 40 443RPRATE 14 RT220 0001200I 45 471RSETUP 15 RT220 01210I 48 501RQUE 16 RT220 01220I 51 55 RWS 17 RT220 01230I 56 57 RLG 18 RT220 01240I 58 602RQFAC 19 RT220 01250I 61 673ROPCST 20 RT220 01260I 68 68 RMCD 21 RT220 0001270I 69 83 RCOM 22 RT220 01280I 124 1270RRN RT220 01290I NS 03 1NCR RT220 01300I 1 1 R RT220 01310I 124 1270BADRRN RT220 01320IPARTMST NS 04 RT220 01330I 74 74 DLTPT RT220 0001340IMACHMST NS 05 RT220 01350I 36 36 DLTMCH RT220 01360ILABMST NS 06 RT220 01370I 30 30 DLTLAB RT220 01380I********************************************************************RT220 01390I* RT220 01400I* ROUTING ALL RT220 0001410I* RT220 01420I* PART PART # RT220 01430I* SEQ SEQUENCE # RT220 01440I* OPCD OPERATION CODE RT220 01450I* DESC OPERATION DESCRIPTION RT220 01460I* PRATE PRODUCTION RATE (HRS/PIECE) (FOR MCD = ' ') RT220 01470I* SETUP SET-UP TIME (HRS) RT220 0001480I* QUE QUEUE TIME (HRS) RT220 01490I* WS WORK STATION # RT220 01500I* LG LABOR GRADE (STD) RT220 01510I* QFAC QUEUE FACTOR RT220 01520I* OPCST O.P. COST/UN (FOR MCD = 'X') RT220 01530I* MCD MACHINE OPERATION (' '- MACHINE VS. 'X'-O.P.) RT220 01540I* COM COMMENT RT220 0001550I* REC RECORD RT220 01560I* NXTPRT LOOK-AHEAD PART # RT220 01570I* RT220 01580I* ROUTSRT 'RA' ADD RT220 01590I* 'RC' CHANGE RT220 01600I* 'RD' DELETE RT220 01610I* 'RM' MULTIPLE DELETE RT220 0001620I* REST RT220 01630I* RT220 01640I* RCODE TRANSACTION CODE (A,C,D, OR M) RT220 01650I* RPART PART # RT220 01660I* RSEQ SEQUENCE # RT220 01670I* ROPCD OPERATION CODE RT220 01680I* RDESC OPERATION DESCRIPTION RT220 0001690I* RPRATE PRODUCTION RATE (HRS/PIECE) (FOR RMCD 'K'OR' ') RT220 01700I* RSETUP SET-UP TIME (HRS) RT220 01710I* RQUE QUEUE TIME (HRS) RT220 01720I* RWS WORK STATION # RT220 01730I* RLG LABOR GRADE (STD) RT220 01740I* RQFAC QUEUE FACTOR RT220 01750I* ROPCST O.P. COST/UN (FOR RMCD = 'X') RT220 0001760I* RMCD MACHINE OPERATION ( ,X,K) RT220 01770I* RCOM COMMENT RT220 01780I* RRN REL REC # IN KPFILE RT220 01790I* RT220 01800I* PARTMST ALL RT220 01810I* RT220 01820I* DLTPT DELETE CODE (' '-GOOD / ELSE DELETE-FLAGGED) RT220 0001830I* RT220 01840I* MACHMST ALL RT220 01850I* RT220 01860I* DLTMCH DELETE CODE (' '-GOOD / ELSE DELETE-FLAGGED) RT220 01870I* RT220 01880I* LABMST ALL RT220 01890I* RT220 0001900I* DLTLAB DELETE CODE (' '-GOOD / ELSE DELETE-FLAGGED) RT220 01910I* RT220 01920C********************************************************************RT220 01930C* RT220 01940C* SETUP Z12 ONLY ONCE AT START OF PROGRAM. RT220 01950C* RT220 01960C********************************************************************RT220 0001970C N93 MOVEL'ZZZZZZ' Z12 12 RT220 01980C N93 MOVE 'ZZZZZZ' Z12 RT220 01990C N93 SETON 93 RT220 02000C********************************************************************RT220 02010C* RT220 02020C* IF A PART#'S ROUTER IS UPDATED, THEN WANT TO PRINT OUT A RT220 02030C* NEW ROUTER FOR THE PART. BUT IF SOME OF THE PROPOSED CHANGES RT220 0002040C* TO THE PART#'S ROUTER HAD ERRORS AND SO FAILED TO UPDATE THE RT220 02050C* ROUTER, THEN PRINTING THE ROUTER IS PROBABLY A WASTE OF TIME. RT220 02060C* RT220 02070C* NEW PART#. RE-SETOF THE ERROR-ON-PART#'S-POTENTIAL-UPDATES RT220 02080C* INDICATOR (98) AND THE PART#'S-POTENTIAL-UPDATES INDICATOR (97). RT220 02090C* RT220 02100C********************************************************************RT220 0002110C L2 SETOF 9798 RT220 02120C********************************************************************RT220 02130C* RT220 02140C* ROUTING IS A RANDOM FILE AND THEREFORE, TO KEEP FROM WASTING RT220 02150C* TIME PROCESSING INACTIVE RECORDS, FOLLOWING THE ACTIVE RECORDS RT220 02160C* IN ROUTING IS A RECORD WITH 12 Z'S IN ITS PART#. WHEN THIS RT220 02170C* RECORD IS ENCOUNTERED, IT SIGNALS THE PROGRAM THAT IT IS THE RT220 0002180C* LAST RECORD TO BE PROCESSED. THIS RECORD IS NOT RE-OUTPUT BY RT220 02190C* THIS PROGRAM; THAT'S DONE IN MFG225. RT220 02200C* RT220 02210C********************************************************************RT220 02220C 01 PART COMP Z12 95 RT220 02230C 95 SETON LR RT220 02240C 95 GOTO LREND RT220 0002250C********************************************************************RT220 02260C* RT220 02270C* GOT A ROUTSRT RECORD. SETON THE PART#'S-POTENTIAL-UPDATES RT220 02280C* INDICATOR. RT220 02290C* RT220 02300C********************************************************************RT220 02310C 02 SETON 97 RT220 0002320C********************************************************************RT220 02330C* RT220 02340C* IF HAVE PART#/SEQ# RECORD IN ROUTING, WANT TO BE SURE THAT RT220 02350C* RECORD GOES OUT TO ROUTOUT UNLESS A ROUTSRT RECORD CAUSES ITS RT220 02360C* DELETION. PROGRAM ENSURES THAT NO ROUTING/ROUTOUT RECORD IS RT220 02370C* LOST BEACUSE OF ERRORS IN A ROUTSRT RECORD WHICH IS ATTEMPTING RT220 02380C* TO UPDATE THE ROUTING/ROUTSRT RECORD. RT220 0002390C* RT220 02400C* IF GET A ROUTING RECORD, SETON THE PART#/SEQ#-AREADY-IN-ROUTING RT220 02410C* INDICATOR (94). RT220 02420C* RT220 02430C********************************************************************RT220 02440C 01 SETON 94 RT220 02450C********************************************************************RT220 0002460C* RT220 02470C* IF DEALING WITH A ROUTING RECORD, NO NEED TO EDIT. RT220 02480C* RT220 02490C********************************************************************RT220 02500C 01 GOTO END RT220 02510C********************************************************************RT220 02520C* RT220 0002530C* IF DEALING WITH A ROUTSRT RECORD, NEED TO RESET INDICATORS. RT220 02540C* RT220 02550C********************************************************************RT220 02560C EXSR CLEAR RT220 02570C********************************************************************RT220 02580C* RT220 02590C* IF HAVE AN INVALID RECORD TYPE, SKIP REST OF EDITING. RT220 0002600C* RT220 02610C********************************************************************RT220 02620C 03 GOTO END RT220 02630C********************************************************************RT220 02640C* RT220 02650C* IF HAVE A ROUTSRT RECORD WITH 'R' RECORD TYPE (02), THEN RT220 02660C* EDIT THE RECORD ACCORDING TO TYPE OF TRANSACTION. RT220 0002670C* RT220 02680C********************************************************************RT220 02690C RCODE COMP 'A' 30ADD RT220 02700C RCODE COMP 'C' 31CHANGE RT220 02710C RCODE COMP 'D' 32DELETE RT220 02720C RCODE COMP 'M' 33MULT DLT RT220 02730C N30N31N32 RT220 0002740CANN33 SETON 6099 INVALID RT220 02750C 60 GOTO END TRANSACTION RT220 02760C* CODE = ERROR RT220 02770C* RT220 02780C 10 SETON 6299 PART # BLANK RT220 02790C* = ERROR RT220 02800C* RT220 0002810C 11N33 SETON 6399 ADD,CHG,DLT RT220 02820C* WITH SEQ-# = 0 RT220 02830C* = ERROR RT220 02840C* RT220 02850C N11 33 SETON 6599 MULT-DLT RT220 02860C* WITH NON-0 SEQ#RT220 02870C* = ERROR RT220 0002880C* RT220 02890C MR 30 SETON 6699 ADD WITH RT220 02900C* PART#/SEQ# RT220 02910C* ALREADY ON RT220 02920C* ROUTING = ERRORRT220 02930C* RT220 02940C NMR 31 CHG OR DLT RT220 0002950CORNMR 32 SETON 6499 WITH PART#/SEQ#RT220 02960C* NOT ON ROUTING RT220 02970C* = ERROR RT220 02980C* RT220 02990C 33 RPART COMP NXTPRT 5151 MULT DLT RT220 03000C 51 SETON 6599 WITH PART# NOT RT220 03010C* ON ROUTING RT220 0003020C* (ACCURACY OF THIS EDIT FUNCTION OF 0 SEQ#!) = ERROR RT220 03030C* RT220 03040C N32N33 RPART CHAINPARTMST 25 ADD OR CHG RT220 03050C N32N33N25DLTPT COMP ' ' 2525 WITH PART# NOT RT220 03060C 25 SETON 6799 IN PARTMST OR RT220 03070C* FLAGGED-TO-DLT RT220 03080C* = ERROR RT220 0003090C* RT220 03100C 30 EXSR ADDREC ADD EDITS RT220 03110C* EXCLUSIVELY RT220 03120C 31 EXSR CHGREC CHANGE EDITS RT220 03130C* EXCLUSIVELY RT220 03140C********************************************************************RT220 03150C* RT220 0003160C* IF GOT AN ERROR ON THIS PART#/SEQ# ROUTSRT RECORD, THEN RT220 03170C* SETON THE ERROR-ON-PART#'S-POTENTIAL-UPDATED-INDICATOR. RT220 03180C* RT220 03190C********************************************************************RT220 03200C 99 SETON 98 RT220 03210C********************************************************************RT220 03220C* RT220 0003230C* AFTER THIS TAG, CALCS OCCUR FOR EACH INPUT RECORD. RT220 03240C* RT220 03250C********************************************************************RT220 03260C END TAG RT220 03270C********************************************************************RT220 03280C* RT220 03290C* A ROUTSRT MULT DLT DELETES ALL RECORDS IN ROUTING WITH THE RT220 0003300C* SAME PART# AS THAT OF THE MULT DLT. WHEN GET A RECORD RT220 03310C* WITH A NEW PART#, SETOF THE MULT-DLT-CURRENT-PART# INDICATOR. RT220 03320C* RT220 03330C********************************************************************RT220 03340C L2 SETOF 90 RT220 03350C********************************************************************RT220 03360C* RT220 0003370C* A ROUTSRT DLT DELETES THE ROUTING RECORD WITH THE SAME RT220 03380C* PART#/SEQ# COMBINATION AS THAT OF THE DLT. WHEN GET A RECORD RT220 03390C* WITH A NEW SEQ# AND/OR A NEW PART#, SETOF THE RT220 03400C* DLT-CURRENT-RECORD INDICATOR. RT220 03410C* RT220 03420C********************************************************************RT220 03430C L1 SETOF 91 RT220 0003440C********************************************************************RT220 03450C* RT220 03460C* IF THE MULT-DLT-CURRENT-PART# INDICATOR IS ACTIVE FOR RT220 03470C* THIS PART#, THEN SETON THE DLT-CURRENT-RECORD INDICATOR. RT220 03480C* RT220 03490C********************************************************************RT220 03500C 90 SETON 91 RT220 0003510C********************************************************************RT220 03520C* RT220 03530C* 91 IS ONLY ON IF DEALING WITH SUBSEQUENT-TO-FIRST MULT-DLT RT220 03540C* PASS AGAINST A PART#. DON'T WANT TO COUNT MULT-DLT BUT ONCE, RT220 03550C* SO SKIP COUNTS. RT220 03560C* RT220 03570C********************************************************************RT220 0003580C 91 GOTO OUTPUT RT220 03590C********************************************************************RT220 03600C* RT220 03610C* IF DEALING WITH AN ORIGINAL RECORD, NO NEED TO PERFORM COUNTS. RT220 03620C* RT220 03630C********************************************************************RT220 03640C 01 GOTO OUTPUT RT220 0003650C********************************************************************RT220 03660C* RT220 03670C* COUNTS FOR ROUTSRT RECORDS. RT220 03680C* RT220 03690C********************************************************************RT220 03700C 03 INVLD REC TYPE RT220 03710COR 99 02 NERRS ADD 1 NERRS 40 ERROR RT220 0003720C N99 02 30ADDS ADD 1 ADDS 40 ADDS RT220 03730C N99 02 31CHGS ADD 1 CHGS 40 CHGS RT220 03740C N99 02 32DELS ADD 1 DELS 40 91 DLTS RT220 03750C N99 02 33MDELS ADD 1 MDELS 40 90 MULT DLTS RT220 03760C********************************************************************RT220 03770C* RT220 03780C* IF GOT MULT DLT, THEN SETON DLT-CURRENT-RECORD. RT220 0003790C* RT220 03800C********************************************************************RT220 03810C N99 02 33 SETON 91 DLTS RT220 03820C********************************************************************RT220 03830C* RT220 03840C* GET READY FOR OUTPUT. RT220 03850C* RT220 0003860C********************************************************************RT220 03870C OUTPUT TAG RT220 03880C********************************************************************RT220 03890C* RT220 03900C* A ROUTING RECORD SHOULD REMAIN ON FILE UNLESS SPECIFICALLY RT220 03910C* DELETED. IF A RECORD ALREADY EXISTS ON ROUTING AND THE RT220 03920C* ROUTSRT RECORD ATTEMPTING TO UPDATE IT HAS AN ERROR, THEN IT RT220 0003930C* IS NECESSARY TO SETOF THE ERROR INDICATOR TO PRESERVE THE RT220 03940C* ORIGINAL ROUTING RECORD. IT IS ALREADY TOO LATE FOR THE BAD RT220 03950C* ROUTSRT RECORD TO AFFECT ROUTING. RT220 03960C* RT220 03970C********************************************************************RT220 03980C 94 99 SETOF 99 RT220 03990C********************************************************************RT220 0004000C* RT220 04010C* END OF DETAIL CALCS. RT220 04020C* RT220 04030C********************************************************************RT220 04040C LREND TAG RT220 04050C********************************************************************RT220 04060C* RT220 0004070C* WHEN CHANGING PART#/SEQ#, RE-SETOF THE PART#/SEQ#-ALREADY-IN- RT220 04080C* ROUTING INDICATOR (94). RT220 04090C* RT220 04100C********************************************************************RT220 04110CL1 SETOF 94 RT220 04120C********************************************************************RT220 04130C* RT220 0004140C* ARE ATTEMPTING TO GET A COUNT OF RECORDS IN NEW ROUTING FILE, RT220 04150C* ROUTOUT. IF GOT A NEW PART#/SEQ#, NOT A DELETE, NO ERROR, AND RT220 04160C* IT'S NOT OUR END-OF-FILE FLAG (12 Z'S), THEN INCREMENT THE RT220 04170C* RECORD COUNT. RT220 04180C* RT220 04190C********************************************************************RT220 04200CL1N91N99N95RECS ADD 1 RECS 50 RT220 0004210C********************************************************************RT220 04220C* RT220 04230C* RESET INDICATORS PREPATORY TO PROCESSING ROUTSRT RECORD. RT220 04240C* RT220 04250C********************************************************************RT220 04260CSR CLEAR BEGSR RT220 04270CSR SETOF 252627 RT220 0004280CSR SETOF 303132 RT220 04290CSR SETOF 33 RT220 04300CSR SETOF 353637 RT220 04310CSR SETOF 51 RT220 04320CSR SETOF 606263 RT220 04330CSR SETOF 646566 RT220 04340CSR SETOF 676869 RT220 0004350CSR SETOF 707172 RT220 04360CSR SETOF 737475 RT220 04370CSR SETOF 99 RT220 04380CSR ENDSR RT220 04390C********************************************************************RT220 04400C* RT220 04410C* THIS SUBROUTINE EDITS NEW PART#/SEQ# RECORDS. IF NO ERRORS RT220 0004420C* ARE FOUND, THE RECORD WILL BE ADD TO THE PART'S ROUTER. RT220 04430C* RT220 04440C********************************************************************RT220 04450CSR ADDREC BEGSR RT220 04460CSR 12 SETON 7399 NO OPERATION RT220 04470C** CODE = ERROR RT220 04480C** RT220 0004490CSRN17 RWS CHAINMACHMST 26 BLANK WORK-STN RT220 04500CSRN17N26 DLTMCH COMP ' ' 2626 OR ONE NOT RT220 04510CSR 17 FOUND IN MACHMSRT220 04520COR 26 SETON 6899 OR ONE RT220 04530C** DLT-FLAGGED RT220 04540C** = ERROR RT220 04550C** RT220 0004560CSRN18 RLG CHAINLABMST 27 BLANK LAB-GRD RT220 04570CSRN18N27 DLTLAB COMP ' ' 2727 OR ONE NOT IN RT220 04580CSR 18 LABMST OR RT220 04590COR 27 SETON 6999 DLT-FLAGGED RT220 04600C** = ERROR RT220 04610C** RT220 04620CSR 19 Z-ADD1 QFAC QUEUE FACTOR RT220 0004630C** SET TO 1 IF 0 RT220 04640C** RT220 04650CSR RMCD COMP 'K' 35 NOT O.P. RT220 04660CSR RMCD COMP 'X' 36 O.P. RT220 04670CSR RMCD COMP ' ' 37 NOT O.P. RT220 04680CSRN35N36N37 SETON 7099 MACH CODE RT220 04690C** NOT ( ,K,X) RT220 0004700C** = ERROR RT220 04710C** RT220 04720CSR 35 14 IN HOUSE WITH RT220 04730COR 37 14 SETON 7299 PROD-RATE 0 RT220 04740C** = ERROR RT220 04750C** RT220 04760CSR 35N20 IN HOUSE WITH RT220 0004770COR 37N20 SETON 7499 O.P. COST/UN RT220 04780C** = ERROR RT220 04790C** RT220 04800CSR 36 20 SETON 7199 O.P. WITH RT220 04810C** O.P. COST/UN 0 RT220 04820C** = ERROR RT220 04830C** RT220 0004840CSR 36N14 SETON 7599 O.P. WITH RT220 04850C** PROD RATE RT220 04860C** = ERROR RT220 04870C** RT220 04880CSRN99 EXSR MOVE NO ERROR --> RT220 04890CSR ENDSR READY OUTPUT RT220 04900C********************************************************************RT220 0004910C* RT220 04920C* THIS SUBROUTINE EDITS CHANGES TO ALREADY-EXISTANT PART#/SEQ# RT220 04930C* RECORDS IN ROUTING. IF NO ERRORS ARE FOUND, THE RECORD'S RT220 04940C* CHANGES WILL UPDATE THE PART'S ROUTER. RT220 04950C* RT220 04960C********************************************************************RT220 04970CSR CHGREC BEGSR RT220 0004980CSRN17 RWS CHAINMACHMST 26 NEW WRK-STN RT220 04990CSRN17N26 DLTMCH COMP ' ' 2626 NOT IN MACHMST RT220 05000CSR 26 SETON 6899 OR DLT-FLAGGED RT220 05010C** = ERROR RT220 05020C** RT220 05030CSRN18 RLG CHAINLABMST 27 NEW LAB-GRD RT220 05040CSRN18N27 DLTLAB COMP ' ' 2727 NOT IN LABMST RT220 0005050CSR 27 SETON 6999 OR DLT-FLAGGED RT220 05060C** = ERROR RT220 05070C** RT220 05080CSRN21 RMCD COMP 'K' 35 NOT O.P. RT220 05090CSRN21 RMCD COMP 'X' 36 O.P. RT220 05100CSRN21N35N36 SETON 7099 CHG TO MACHINE RT220 05110C** CODE INVALID RT220 0005120C** RT220 05130CSR 35 14 SETON 7299 CHG TO IN HOUSERT220 05140C** BUT HAVE 0 RT220 05150C** PROD RATE = ERRRT220 05160C** RT220 05170CSR 35N20 SETON 7499 CHG TO IN HOUSERT220 05180C** BUT HAVE RT220 0005190C** O.P. COST/UN RT220 05200C** = ERROR RT220 05210C** RT220 05220CSR 36 20 SETON 7199 CHG TO O.P. BUTRT220 05230C** O.P. COST/UN 0 RT220 05240C** = ERROR RT220 05250C** RT220 0005260CSR 36N14 SETON 7599 CHG TO O.P. BUTRT220 05270C** HAVE PROD RATE RT220 05280C** = ERROR RT220 05290C** RT220 05300CSRN99 EXSR MOVE NO ERROR ---> RT220 05310CSR ENDSR READY OUTPUT RT220 05320C********************************************************************RT220 0005330C* RT220 05340C* IF EDIT PRODUCED NO ERRORS, THIS SUBROUTINES SETS UP RT220 05350C* DATA FOR OUTPUT TO ROUTING (ADDS & CHANGES). RT220 05360C* RT220 05370C********************************************************************RT220 05380CSR MOVE BEGSR RT220 05390CSR MOVE RPART PART RT220 0005400CSR Z-ADDRSEQ SEQ RT220 05410CSRN12 MOVE ROPCD OPCD RT220 05420CSRN13 MOVE RDESC DESC RT220 05430CSRN14N36 Z-ADDRPRATE PRATE IN HOUSE RT220 05440CSRN14 36 Z-ADD0 PRATE O.P. RT220 05450CSRN15 Z-ADDRSETUP SETUP RT220 05460CSRN16 Z-ADDRQUE QUE RT220 0005470CSRN17 MOVE RWS WS RT220 05480CSRN18 MOVE RLG LG RT220 05490CSRN19 Z-ADDRQFAC QFAC RT220 05500CSRN20 36 Z-ADDROPCST OPCST O.P. RT220 05510CSRN20N36 Z-ADD0 OPCST IN HOUSE RT220 05520C** RT220 05530CSR 21 30 MOVE ' ' MCD ADD WITH BLANK RT220 0005540C** MACH CODE RT220 05550C** RT220 05560CSRN21 35 MOVE ' ' MCD ADD OR CHG RT220 05570C** 'K' MACH CODE RT220 05580C** (IN HOUSE) RT220 05590C** RT220 05600CSRN21 36 MOVE 'X' MCD ADD OR CHG RT220 0005610C** 'X' MACH CODE RT220 05620C** (O.P.) RT220 05630C** RT220 05640CSRN22 MOVE RCOM COM RT220 05650CSR ENDSR RT220 05660O********************************************************************RT220 05670O* RT220 0005680O* IF HAVE A NEW PART#/SEQ# RECORD, NO DELETE, NO ERROR, AND RT220 05690O* IT'S NOT END-OF-FILE 12 Z'S PART#, THEN OUTPUT RECORD TO THE RT220 05700O* NEW ROUTING FILE, ROUTOUT. RT220 05710O* RT220 05720O********************************************************************RT220 05730OROUTOUT T L1N91N99 RT220 05740O AND N95 RT220 0005750O PART 12 RT220 05760O SEQ 14 RT220 05770O OPCD B 17 RT220 05780O DESC B 37 RT220 05790O PRATE B 42 RT220 05800O SETUP B 45 RT220 05810O QUE B 48 RT220 0005820O WS B 53 RT220 05830O LG B 55 RT220 05840O QFAC B 58 RT220 05850O OPCST B 65 RT220 05860O MCD B 66 RT220 05870O COM B 81 RT220 05880O********************************************************************RT220 0005890O* RT220 05900O* IF HAVE A NEW PART#, NO ERROR-ON-PART#'S-UPDATES AND RT220 05910O* PART#-UPDATED, THEN OUTPUT A REQUEST-TO-PRINT-ROUTER-FOR-THIS- RT220 05920O* PART# TO ROUTUP. MFG240 WILL PRINT ROUTERS. RT220 05930O* RT220 05940O********************************************************************RT220 05950OROUTUP T L2N98 97 RT220 0005960O 2 'RR' RT220 05970O PART 14 RT220 05980O********************************************************************RT220 05990O* RT220 06000O* ROUTSRT EDIT LISTING. RT220 06010O* RT220 06020O********************************************************************RT220 0006030O$LP1 H 202 1P RT220 06040O OR OF RT220 06050O PAGE Z 10 RT220 06060O 4 'PAGE' RT220 06070O HEAD,1 85 RT220 06080O UDATE Y 132 RT220 06090O H 2 1P RT220 0006100O OR OF RT220 06110O 75 'ROUTING FILE UPDATES' RT220 06120O 132 'MFG220' RT220 06130O H 1 1P RT220 06140O OR OF RT220 06150O 32 'SEQ ------ OPERATION' RT220 06160O 53 '------- WORK LAB MCH' RT220 0006170O 78 'O.P. PRD-RT STUP QUE' RT220 06180O 83 'QUE' RT220 06190O 102 'ACT' RT220 06200O 122 'ERRORS/REMARKS' RT220 06210O H 2 1P RT220 06220O OR OF RT220 06230O 6 'PART #' RT220 0006240O 31 '# CD DESCRIPTION' RT220 06250O 61 'STATN GD OP COST/UN' RT220 06260O 83 'HRS/PC HRS HRS FAC' RT220 06270O 91 'COMMENT' RT220 06280O 120 'RRN # ------------' RT220 06290O 132 '------------' RT220 06300O D 10 L2 02 RT220 0006310O OR 03 RT220 06320O 1 ' ' RT220 06330O D 10 02 RT220 06340O RPART 12 RT220 06350O RSEQ 15 RT220 06360O ROPCD 19 RT220 06370O RDESC 40 RT220 0006380O RWS 46 RT220 06390O RLG 49 RT220 06400O RMCD 52 RT220 06410O ROPCSTM 62 RT220 06420O RPRATEM 69 RT220 06430O RSETUPM 74 RT220 06440O RQUE M 79 RT220 0006450O RQFAC M 84 RT220 06460O RCOM 99 RT220 06470O RCODE 101 RT220 06480O RRN 107 RT220 06490O D 10 03 RT220 06500O BADRRN 107 RT220 06510O D 1 03 RT220 0006520O 132 'INVALID RECORD TYPE ' RT220 06530O D 1 02 99 60 RT220 06540O 132 'INVALID TRANSACTION CODE' RT220 06550O D 1 02 99 62 RT220 06560O 132 'MISSING PART # ' RT220 06570O D 1 02 99 63 RT220 06580O 132 'MISSING SEQUENCE # ' RT220 0006590O D 1 02 99 64 RT220 06600O 132 'PART#/SEQ# NOT ON ROUTIN' RT220 06610O D 1 02 99 65 RT220 06620O 132 'INVALID MULT DELETE ' RT220 06630O D 1 02 99N11 RT220 06640O AND 33 65 RT220 06650O 132 'SEQUENCE # SHOULD BE 0 ' RT220 0006660O D 1 02 99 51 RT220 06670O AND 65 RT220 06680O 132 'PART # NOT ON ROUTING ' RT220 06690O D 1 02 99 66 RT220 06700O 132 'DUPLICATE ADD ' RT220 06710O D 1 02 99 67 RT220 06720O 132 'INVALID PART # ' RT220 0006730O D 1 02 99 68 RT220 06740O 132 'INVALID WORK STATION # ' RT220 06750O D 1 02 99 69 RT220 06760O 132 'INVALID LABOR GRADE ' RT220 06770O D 1 02 99 70 RT220 06780O 132 'INVALID MACHINE OP CODE ' RT220 06790O D 1 02 99 71 RT220 0006800O 132 'O.P. COST/UN MISSING ' RT220 06810O D 1 02 99 72 RT220 06820O 132 'PRODUCTION RATE MISSING ' RT220 06830O D 1 02 99 73 RT220 06840O 132 'OPERATION CODE MISSING ' RT220 06850O D 1 02 99 74 RT220 06860O 132 'O.P. COST/UN SHOULD BE 0' RT220 0006870O D 1 02 99 75 RT220 06880O 132 'PROD RATE SHOULD BE 0 ' RT220 06890O T 31 LR RT220 06900O 23 'END OF JOB. THERE WERE' RT220 06910O ADDS 3 28 RT220 06920O 34 'ADDS,' RT220 06930O CHGS 3 39 RT220 0006940O 48 'CHANGES,' RT220 06950O DELS 3 53 RT220 06960O 62 'DELETES,' RT220 06970O MDELS 3 67 RT220 06980O 85 'MULT DELETES, AND' RT220 06990O NERRS 3 90 RT220 07000O 98 'ERRORS.' RT220 0007010O RECS 3 105 RT220 07020O 124 'RECORDS NOW EXIST.' RT220 ** 007030ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 007040ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 007050ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 007060ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00707000/* 007080__0O 124 'RECORDS NOW EXIST.' RT220 ** 007030ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 007040ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 007050ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 007060ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0070700(K C TXRT225 P999999111111(000010H S RT225 00020X DECK-ID M85 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT225 00030F* RECREATES ROUTING FILE FROM ROUTOUT, UPDATES PART MASTER FILE RT225 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT225 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT225 00060F* CONTROL DATA PROPRIETARY PRODUCT RT225 00070F* RT225 0000080FROUTOUT IPEAF 85 DISK RT225 00090FPARTMST USEAF 300 12AI 1 DISK RT225 00100FROUTING UC F 85R DISK RT225 00110F********************************************************************RT225 00120F* RT225 00130F* PACKAGE MANUFACTURING RT225 00140F* SYSTEM ROUTING RT225 0000150F* PROGRAM USES NEW ROUTER DATA IN ROUTOUT TO REBUILD RT225 00160F* THE ROUTING FILE -AND- STICKS 12 Z'S END-OF-FILE RT225 00170F* RECORD IN ROUTING -AND- PLACES THE REL_REC_#_OF_THE_ RT225 00180F* FIRST_OPERATION_IN_ROUTING IN PARTMST FOR ALL PART#'S RT225 00190F* (0 IF PART#'S NOT IN ROUTING) RT225 00200F* RT225 00210F* CONTRACTOR COMPUSOURCE RT225 0000220F* PROGRAMMER TOM LEE RT225 00230F* DATE MARCH 22, 1977 RT225 00240F* RT225 00250F********************************************************************RT225 00260IROUTOUT NS 01 RT225 00270I 1 12 PN L1M1 RT225 00280I 1 85 REC RT225 0000290IPARTMST NS 02 RT225 00300I 1 12 PN L1M1 RT225 00310IROUTING NS 03 RT225 00320I 1 1 A RT225 00330C N01 GOTO SKIP RT225 00340C 01 RRN ADD 1 RRN 50 RT225 00350C L1 Z-ADDRRN SRRN 50 RT225 0000360C RRN CHAINROUTING 25 RT225 00370C 25 SETON H1 RT225 00380C N25 SETON 90 RT225 00390C 90 EXCPT RT225 00400C SETOF 90 RT225 00410C SKIP TAG RT225 00420CLR MOVE ' ' B85 85 RT225 0000430CLR MOVEL'ZZZZZZ' Z12 12 RT225 00440CLR MOVE 'ZZZZZZ' Z12 RT225 00450CLR Z-ADD0 ZERO 50 RT225 00460CLR SETON 91 RT225 00470CLR LOOP TAG RT225 00480CLR RRN ADD 1 RRN RT225 00490CLR RRN CHAINROUTING 25 RT225 0000500CLR 25 GOTO END RT225 00510CLR SETON 90 RT225 00520CLR 90 EXCPT RT225 00530CLR GOTO LOOP RT225 00540CLR END TAG RT225 00550OROUTING E 90 RT225 00560O REC 85 RT225 0000570O 91 B85 85 RT225 00580O 91Z12 12 RT225 00590OPARTMST D 02 RT225 00600O MR SRRN 56 RT225 00610O NMR ZERO 56 RT225 ** 000620ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00063000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000640ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000650ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000660/* 000670__0O NMR ZERO 56 RT225 ** 000620ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0006300( ITXRT240 P999999111111(000010H S RT240 00020X DECK-ID M86 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT240 00030F* PRINTS ROUTERS FOR ALL PART NUMBERS WITH REQUESTS IN ROUTUP RT240 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT240 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT240 00060F* CONTROL DATA PROPRIETARY PRODUCT RT240 00070F* RT240 0000080FROUTUP IPEAF 128 DISK RT240 00090FPARTMST IC F 300R12AI 1 DISK RT240 00100FROUTING IC F 85R DISK RT240 00110FBOMMST IC F 28R12AI 1 DISK RT240 00120FBOMSTR IC F 54R DISK RT240 00130FHEADING IT F 40 EDISK RT240 00140F$LP1 O F 85 OF PRINTER RT240 0000150E HEADING HEAD 1 1 40 RT240 00160IROUTUP NS 01 1 CR 2 CR RT240 00170I 3 14 PN RT240 00180I NS 02 RT240 00190I 1 1 R RT240 00200IPARTMST NS 03 RT240 00210I 13 37 DESC RT240 0000220I 38 39 UM RT240 00230I 40 40 MORP RT240 00240I 52 560RRN RT240 00250IBOMMST NS 04 RT240 00260I 13 170STRRN 10 RT240 00270IBOMSTR NS 05 RT240 00280I 1 12 PARNT RT240 0000290I 13 24 CMPNT RT240 00300I 25 313QTY RT240 00310I 54 54 ICODE RT240 00320IROUTING NS 06 RT240 00330I 1 12 RPN RT240 00340I 13 140SEQ RT240 00350I 15 17 OP RT240 0000360I 18 37 ODESC RT240 00370I 38 423PRATE RT240 00380I 43 451SETUP RT240 00390I 46 481QUE RT240 00400I 49 53 WS RT240 00410I 54 55 LG RT240 00420I 56 582QFACT RT240 0000430I 59 653OPCST RT240 00440I 66 66 MCODE RT240 00450I 67 81 COMMT RT240 00460C N01 GOTO END RT240 00470C Z-ADD0 TRATE 73 RT240 00480C PN CHAINPARTMST 25 RT240 00490C Z-ADDRRN SRRN 50 RT240 0000500C SETON 80 RT240 00510C 80 EXCPT RT240 00520C SETOF 80 RT240 00530C SETON 81 1ST TIME THRU RT240 00540C SETOF 302728 RT240 00550C PN CHAINBOMMST 26 RT240 00560C 10 RT240 0000570COR 26 GOTO SKIP1 RT240 00580C 26 GOTO DEND1 NOT ON BOMMST RT240 00590C LOOP1 TAG RT240 00600C STRRN CHAINBOMSTR 27 RT240 00610C 27 GOTO DEND1 NOT ON BOMSTR RT240 00620C PN COMP PARNT 30 RT240 00630C 30 CMPNT CHAINPARTMST 28 RT240 0000640C 30 SETON 82 RT240 00650C SKIP1 TAG RT240 00660C 81N30 RT240 00670COR 82 EXCPT RT240 00680C SETOF 8182 RT240 00690C 30 STRRN ADD 1 STRRN RT240 00700C 30 GOTO LOOP1 RT240 0000710C DEND1 TAG RT240 00720C SETOF 81 RT240 00730C SETON 83 RT240 00740C 83 EXCPT RT240 00750C SETOF 83 RT240 00760C SRRN COMP 0 90 RT240 00770C 90 GOTO DEND2 RT240 0000780C SETOF 3129 RT240 00790C LOOP2 TAG RT240 00800C SRRN CHAINROUTING 29 RT240 00810C 29 GOTO END RT240 00820C PN COMP RPN 31 RT240 00830C N31 GOTO DEND2 RT240 00840C MCODE COMP ' ' 40 RT240 0000850C 40 PRATE ADD TRATE TRATE 73 RT240 00860C DEND2 TAG RT240 00870C 90 RT240 00880COR 31 SETON 84 RT240 00890C 84 EXCPT RT240 00900C SETOF 84 RT240 00910C 31 SRRN ADD 1 SRRN RT240 0000920C 31 GOTO LOOP2 RT240 00930C END TAG RT240 00940C 01 SETON 85 RT240 00950C 85 EXCPT RT240 00960C SETOF 85 RT240 00970O$LP1 E 202 80 RT240 00980O HEAD,1 62 RT240 0000990O UDATE Y 85 RT240 01000O E 2 80 RT240 01010O 50 'OPERATION SHEET' RT240 01020O 85 'MFG240' RT240 01030O E 2 80 RT240 01040O 11 'PART NUMBER' RT240 01050O 25 'DESCRIPTION' RT240 0001060O 43 'UM' RT240 01070O E 2 80 RT240 01080O PN 12 RT240 01090O N25 DESC 39 RT240 01100O 25 38 '** NOT ON PART MASTER **' RT240 01110O UM 43 RT240 01120O E 2 81 RT240 0001130O 11 'COMPONENTS-' RT240 01140O 62 'QUANTITY M/P I/N' RT240 01150O E 2 82 RT240 01160O CMPNT 12 RT240 01170O N28 DESC 39 RT240 01180O 28 38 '** NOT ON PART MASTER **' RT240 01190O N28 UM 43 RT240 0001200O QTY L 53 RT240 01210O N28 MORP 56 RT240 01220O ICODE 61 RT240 01230O E 2 81N30 RT240 01240O 23 '**** NO COMPONENTS ****' RT240 01250O E 2 83 RT240 01260O 24 '------------------------' RT240 0001270O 48 '------------------------' RT240 01280O 72 '------------------------' RT240 01290O 85 '-------------' RT240 01300O E 1 83 RT240 01310O 3 'SEQ' RT240 01320O 51 'WORK OP/UM O' RT240 01330O 68 'SET QUE' RT240 0001340O E 2 83 RT240 01350O 13 '# OPERATION' RT240 01360O 51 'CNTR LG HRS/PC P' RT240 01370O 77 'UP QUE FACT COMMENT' RT240 01380O E 22 84 90 RT240 01390O 64 '************************' RT240 01400O E 2 84 90 RT240 0001410O 64 '* NO OPERATIONS *' RT240 01420O E 2 84 90 RT240 01430O 64 '************************' RT240 01440O E 2 84N90 RT240 01450O SEQ 1 2 RT240 01460O OP 7 RT240 01470O ODESC B 29 RT240 0001480O WS B 36 RT240 01490O LG B 39 RT240 01500O 40 PRATE LB 49 RT240 01510O N40 OPCST LB 49 RT240 01520O MCODE B 51 RT240 01530O SETUP 1B 57 RT240 01540O QUE 1B 62 RT240 0001550O QFACT LB 69 RT240 01560O COMMT B 85 RT240 01570O E 1 85 RT240 01580O 20 'TOTAL HOURS/PIECE IS' RT240 01590O TRATE 3B 30 RT240 ** 001600ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00161000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001620ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001630ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001640/* 001650__0O TRATE 3B 30 RT240 ** 001600ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0016100(( 8 TXRT242 P999999111111(000010H S RT242 00020X DECK-ID M87 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT242 00030F* INITIALIES RTOUT1 WITH < > IN POSITIONS 1 AND 2 OF ALL RECORDS RT242 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT242 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT242 00060F* CONTROL DATA PROPRIETARY PRODUCT RT242 00070F* RT242 0000080FRTDUM IP F 72 DISK RT242 00090FRTOUT1 UC F 128R DISK RT242 00100IRTDUM NS 02 RT242 00110I 1 1 A RT242 00120IRTOUT1 NS 01 RT242 00130I 1 128 REC RT242 00140C SETON LR99 RT242 0000150CLR LOOP TAG RT242 00160CLR RRN ADD 1 RRN 50 RT242 00170CLR RRN CHAINRTOUT1 70 RT242 00180CLRN70 EXCPT RT242 00190CLRN70 GOTO LOOP RT242 00200ORTOUT1 E 99N70 RT242 00210O OR LRN70 RT242 0000220O REC 128 RT242 00230O 2 '<>' RT242 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' RT242 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(( J TXRT243 P999999111111(000010H S RT243 00020X DECK-ID M88 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT243 00030F* INITIALIES RTOUT2 WITH < > IN POSITIONS 1 AND 2 OF ALL RECORDS RT243 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT243 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT243 00060F* CONTROL DATA PROPRIETARY PRODUCT RT243 00070F* RT243 0000080FRTDUM IP F 72 DISK RT243 00090FRTOUT2 UC F 128R DISK RT243 00100IRTDUM NS 02 RT243 00110I 1 1 A RT243 00120IRTOUT2 NS 01 RT243 00130I 1 128 REC RT243 00140C SETON LR99 RT243 0000150CLR LOOP TAG RT243 00160CLR RRN ADD 1 RRN 50 RT243 00170CLR RRN CHAINRTOUT2 70 RT243 00180CLRN70 EXCPT RT243 00190CLRN70 GOTO LOOP RT243 00200ORTOUT2 E 99N70 RT243 00210O OR LRN70 RT243 0000220O REC 128 RT243 00230O 2 '<>' RT243 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' RT243 ** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800( \ ITXRT244 P999999111111(000010H S RT244 00020X DECK-ID M89 MFG/DIST/ACCT SYSTEM SUMMARY-123 RT244 00030F* PRINTS ROUTERS FOR ALL PART NUMBERS WITH REQUESTS IN ROUTUPB RT244 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RT244 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RT244 00060F* CONTROL DATA PROPRIETARY PRODUCT RT244 00070F* RT244 0000080FROUTUPB IPEAF 128 DISK RT244 00090FPARTMST IC F 300R12AI 1 DISK RT244 00100FROUTING IC F 85R DISK RT244 00110FBOMMST IC F 28R12AI 1 DISK RT244 00120FBOMSTR IC F 54R DISK RT244 00130FHEADING IT F 40 EDISK RT244 00140F$LP1 O F 85 OF PRINTER RT244 0000150E HEADING HEAD 1 1 40 RT244 00160IROUTUPB NS 01 1 CR 2 CR RT244 00170I 3 14 PN RT244 00180I NS 02 RT244 00190I 1 1 R RT244 00200IPARTMST NS 03 RT244 00210I 13 37 DESC RT244 0000220I 38 39 UM RT244 00230I 40 40 MORP RT244 00240I 52 560RRN RT244 00250IBOMMST NS 04 RT244 00260I 13 170STRRN RT244 00270IBOMSTR NS 05 RT244 00280I 1 12 PARNT RT244 0000290I 13 24 CMPNT RT244 00300I 25 313QTY RT244 00310I 54 54 ICODE RT244 00320IROUTING NS 06 RT244 00330I 1 12 RPN RT244 00340I 13 140SEQ RT244 00350I 15 17 OP RT244 0000360I 18 37 ODESC RT244 00370I 38 423PRATE RT244 00380I 43 451SETUP RT244 00390I 46 481QUE RT244 00400I 49 53 WS RT244 00410I 54 55 LG RT244 00420I 56 582QFACT RT244 0000430I 59 653OPCST RT244 00440I 66 66 MCODE RT244 00450I 67 81 COMMT RT244 00460C N01 GOTO END RT244 00470C Z-ADD0 TRATE 73 RT244 00480C PN CHAINPARTMST 25 RT244 00490C Z-ADDRRN SRRN 50 RT244 0000500C SETON 80 RT244 00510C 80 EXCPT RT244 00520C SETOF 80 RT244 00530C SETON 81 1ST TIME THRU RT244 00540C SETOF 302728 RT244 00550C PN CHAINBOMMST 26 RT244 00560C 10 RT244 0000570COR 26 GOTO SKIP1 RT244 00580C 26 GOTO DEND1 NOT ON BOMMST RT244 00590C LOOP1 TAG RT244 00600C STRRN CHAINBOMSTR 27 RT244 00610C 27 GOTO DEND1 NOT ON BOMSTR RT244 00620C PN COMP PARNT 30 RT244 00630C 30 CMPNT CHAINPARTMST 28 RT244 0000640C 30 SETON 82 RT244 00650C SKIP1 TAG RT244 00660C 81N30 RT244 00670COR 82 EXCPT RT244 00680C SETOF 8182 RT244 00690C 30 STRRN ADD 1 STRRN RT244 00700C 30 GOTO LOOP1 RT244 0000710C DEND1 TAG RT244 00720C SETOF 81 RT244 00730C SETON 83 RT244 00740C 83 EXCPT RT244 00750C SETOF 83 RT244 00760C SRRN COMP 0 90 RT244 00770C 90 GOTO DEND2 RT244 0000780C SETOF 3129 RT244 00790C LOOP2 TAG RT244 00800C SRRN CHAINROUTING 29 RT244 00810C 29 GOTO END RT244 00820C PN COMP RPN 31 RT244 00830C N31 GOTO DEND2 RT244 00840C MCODE COMP ' ' 40 RT244 0000850C 40 PRATE ADD TRATE TRATE 73 RT244 00860C DEND2 TAG RT244 00870C 90 RT244 00880COR 31 SETON 84 RT244 00890C 84 EXCPT RT244 00900C SETOF 84 RT244 00910C 31 SRRN ADD 1 SRRN RT244 0000920C 31 GOTO LOOP2 RT244 00930C END TAG RT244 00940C 01 SETON 85 RT244 00950C 85 EXCPT RT244 00960C SETOF 85 RT244 00970O$LP1 E 202 80 RT244 00980O HEAD,1 62 RT244 0000990O UDATE Y 85 RT244 01000O E 2 80 RT244 01010O 50 'OPERATION SHEET' RT244 01020O 85 'MFG240' RT244 01030O E 2 80 RT244 01040O 11 'PART NUMBER' RT244 01050O 25 'DESCRIPTION' RT244 0001060O 43 'UM' RT244 01070O E 2 80 RT244 01080O PN 12 RT244 01090O N25 DESC 39 RT244 01100O 25 38 '** NOT ON PART MASTER **' RT244 01110O UM 43 RT244 01120O E 2 81 RT244 0001130O 11 'COMPONENTS-' RT244 01140O 62 'QUANTITY M/P I/N' RT244 01150O E 2 82 RT244 01160O CMPNT 12 RT244 01170O N28 DESC 39 RT244 01180O 28 38 '** NOT ON PART MASTER **' RT244 01190O N28 UM 43 RT244 0001200O QTY L 53 RT244 01210O N28 MORP 56 RT244 01220O ICODE 61 RT244 01230O E 2 81N30 RT244 01240O 23 '**** NO COMPONENTS ****' RT244 01250O E 2 83 RT244 01260O 24 '------------------------' RT244 0001270O 48 '------------------------' RT244 01280O 72 '------------------------' RT244 01290O 85 '-------------' RT244 01300O E 1 83 RT244 01310O 3 'SEQ' RT244 01320O 51 'WORK OP/UM O' RT244 01330O 68 'SET QUE' RT244 0001340O E 2 83 RT244 01350O 13 '# OPERATION' RT244 01360O 51 'CNTR LG HRS/PC P' RT244 01370O 77 'UP QUE FACT COMMENT' RT244 01380O E 22 84 90 RT244 01390O 64 '************************' RT244 01400O E 2 84 90 RT244 0001410O 64 '* NO OPERATIONS *' RT244 01420O E 2 84 90 RT244 01430O 64 '************************' RT244 01440O E 2 84N90 RT244 01450O SEQ 1 2 RT244 01460O OP 7 RT244 01470O ODESC B 29 RT244 0001480O WS B 36 RT244 01490O LG B 39 RT244 01500O 40 PRATE LB 49 RT244 01510O N40 OPCST LB 49 RT244 01520O MCODE B 51 RT244 01530O SETUP 1B 57 RT244 01540O QUE 1B 62 RT244 0001550O QFACT LB 69 RT244 01560O COMMT B 85 RT244 01570O E 1 85 RT244 01580O 20 'TOTAL HOURS/PIECE IS' RT244 01590O TRATE 3B 30 RT244 ** 001600ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00161000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001620ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001630ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001640/* 001650__0O TRATE 3B 30 RT244 ** 001600ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0016100(? 7TXRKPCHA P999999111111(000010H S RKPCHA00020X DECK-ID M90 MFG/DIST/ACCT SYSTEM SUMMARY-123 RKPCHA00030F* ENTER ROUTING UPDATES INTO RTOUT1 RKPCHA00040F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RKPCHA00050F* CONTROL DATA PROPRIETARY PRODUCT RKPCHA00060F* RKPCHA00070FRTDUM IPE F 72 DISK RKPCHA0000080FKPROGS IC F 36R 8AI 1 DISK RKPCHA00090FRTOUT1 UC F 128R DISK RKPCHA00100F********************************************************************RKPCHA00110F* INDICATOR FUNCTION LIST RKPCHA00120F* 01 DUMMY RECORD RKPCHA00130F* 02 KEYPYNCH PARAMETER FILE RKPCHA00140F* 05 KEYPUNCH DATA FILE RKPCHA0000150F* 18 RKPCHA00160F* 19 RKPCHA00170F* 20 RKPCHA00180F* 21 RKPCHA00190F* 25 RETRY ON RUBOUT RKPCHA00200F* 27 AUTO DUP RKPCHA00210F* 28 RKPCHA0000220F* 29 RKPCHA00230F* 40 MODE IS A-ADD RKPCHA00240F* 41 MODE IS C-CHANGE RKPCHA00250F* 42 MODE IS V-VERIFY RKPCHA00260F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS RKPCHA00270F* 44 MODE IS E-END OF JOB RKPCHA00280F* 56 SEQ NBR NOT IN KPFILE RKPCHA0000290F* 60 NEW PROGRAM NBR ONLY RKPCHA00300F* 61 AUTO DUP ONLY RKPCHA00310F* 70 RKPCHA00320F* 72 RKPCHA00330F* 73 MODE IS LESS THAN OR = 4 RKPCHA00340F* 81 MODE IS INVALID RKPCHA00350F* 82 BAD PROG NBR RKPCHA0000360F* 83 FIRST FIELD NAME BLANK RKPCHA00370F* 84 OUTPUT FIELD NAME RKPCHA00380F* 85 RKPCHA00390F* 88 SEQ NBR NOT IN KPFILE RKPCHA00400F* 90 AUTO DUP ON RKPCHA00410F* 95 RKPCHA00420F* 98 RCD WITHIN OPERATOR LIMITS RKPCHA0000430F* LR RKPCHA00440F********************************************************************RKPCHA00450E MSG 1 10 25 RKPCHA00460E SFN 80 20 RKPCHA00470E SAN 80 1 RKPCHA00480E SAD 80 1 RKPCHA00490E SST 80 3 0 RKPCHA0000500E SLN 80 2 0 RKPCHA00510E SNM 4 6 RKPCHA00520E SMX 4 2 0 RKPCHA00530E NP 4 1 0 RKPCHA00540E ARY1 1 2 50 RKPCHA00550IRTDUM NS 01 RKPCHA00560I 1 1 A RKPCHA0000570IKPROGS NS 02 RKPCHA00580I 9 28 FN RKPCHA00590I 29 29 AN RKPCHA00600I 30 30 AD RKPCHA00610I 31 33 ST RKPCHA00620I 34 35 LN RKPCHA00630I 36 36 DCODE RKPCHA0000640IRTOUT1 NS 05 RKPCHA00650I 1 128 RECORD RKPCHA00660C MOVE ' ' B72 72 RKPCHA00670C EXSR ALMTS RKPCHA00680C Z-ADDLOW SEQNO RKPCHA00690C NLR SETON LR RKPCHA00700CLR START TAG RKPCHA0000710CLR MOVEL'' WORD RKPCHA01580CLR Z-ADD1 OLN RKPCHA01590CLR Z-ADD1 ILN RKPCHA01600CLR EXSR TYPES RKPCHA01610CLR MOVELBUFFER MODE RKPCHA0001620CLR MODE COMP '4' 7373 RKPCHA01630CLR MODE COMP 'P' 60 NEW PROG#ONLY RKPCHA01640CLR MODE COMP 'D' 61 AUTO-DUP ONLY RKPCHA01650CLRN60N61N73 GOTO CHKMOD NEW 46DE RKPCHA01660CLR 73 MOVE MODE NPN 10 RKPCHA01670CLR EXSR GETPRG RKPCHA01680CLR SETOF 606173 RKPCHA0001690CLR GOTO SAMREC RKPCHA01700CLR CHKNUM TAG RKPCHA01710CLR MOVELBUFFER MODE RKPCHA01720CLR MODE COMP '@' 20 RKPCHA01730CLR 20N42 GOTO OUTREC RKPCHA01740CLR SAN,N COMP 'N' 19 RKPCHA01750CLRN19 GOTO CHKVER RKPCHA0001760CLR Z-ADDSLN,N VL 20 RKPCHA01770CLR MOVELBUFFER VAR 15 RKPCHA01780CLR EXIT SUBRAJ RKPCHA01790CLR RLABL VL RKPCHA01800CLR RLABL VAR RKPCHA01810CLR MOVELVAR BUFFER RKPCHA01820CLR Z-ADDVL BLNGTH RKPCHA0001830CLR EXSR EXCPT RKPCHA01840CLR SETOF 19 RKPCHA01850CLR CHKVER TAG RKPCHA01860CLRN42 GOTO MOVBUF RKPCHA01870CLR TBUF COMP BUFFER 2020 RKPCHA01880CLRN20 GOTO MOVBUF RKPCHA01890CLR MOVEL'KP VERIF'WORD RKPCHA0001900CLR MOVE 'Y ERROR 'WORD RKPCHA01910CLR MOVELWORD BUFFER RKPCHA01920CLR MOVE 'R' TYPE RKPCHA01930CLR Z-ADD6 MASK ONLY 'R' OR 'E'RKPCHA01940CLR EXSR CRTCOM RKPCHA01950CLR RCODE COMP 'R' 20 RKPCHA01960CLR 20 GOTO OUTFLD RKPCHA0001970CLR MOVBUF TAG RKPCHA01980CLR Z-ADDSST,N TSTRT 30 RKPCHA01990CLR Z-ADDSLN,N NCHARS 30 RKPCHA02000CLR Z-ADD1 SSTRT RKPCHA02010CLR EXIT SUBRMV RKPCHA02020CLR RLABL BUFFER RKPCHA02030CLR RLABL SSTRT RKPCHA0002040CLR RLABL RECORD RKPCHA02050CLR RLABL TSTRT RKPCHA02060CLR RLABL NCHARS RKPCHA02070CLR GOTO LOOP RKPCHA02080CLR RITDUP TAG RKPCHA02090CLR EXSR MVRECD RKPCHA02100CLR SETON 19 RKPCHA0002110CLR Z-ADDSLN,N BLNGTH RKPCHA02120CLRN27 EXSR EXCPT RKPCHA02130CLR SETOF 19 RKPCHA02140CLR GOTO MOVBUF RKPCHA02150CLR OUTREC TAG RKPCHA02160CLR SETON 187084 RKPCHA02170CLR SETON 85 RKPCHA0002180CLR EXCPT RKPCHA02190CLR EXSR EXCPT RKPCHA02200CLR SETOF 708485 RKPCHA02210CLR MOVELRECORD OLDREC128 RKPCHA02220CLR NP,PN COMP 0 72 RKPCHA02230CLRN72 GOTO NXTREC RKPCHA02240CLR MOVE NP,PN NPN RKPCHA0002250CLR EXSR GETPRG RKPCHA02260CLR SETOF 72 RKPCHA02270CLR GOTO NXTREC RKPCHA02280CLR EOJ TAG RKPCHA02290C********************************************************************RKPCHA02300C* RKPCHA02310C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION RKPCHA0002320C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. RKPCHA02330C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. RKPCHA02340C* RKPCHA02350C********************************************************************RKPCHA02360CSR GETPRG BEGSR RKPCHA02370CSR 61 GOTO JMPOUT RKPCHA02380CSR 72 RKPCHA0002390COR 73 GOTO CHKPN RKPCHA02400CSR GETPNO TAG RKPCHA02410CSR MOVEL'PROG # -'WORD RKPCHA02420CSR Z-ADD8 OLN RKPCHA02430CSR Z-ADD1 ILN RKPCHA02440CSR EXSR TYPES RKPCHA02450CSR MOVELBUFFER NPN 10 RKPCHA0002460CSR CHKPN TAG RKPCHA02470CSR NPN COMP 0 2020 RKPCHA02480CSRN20 NPN COMP 4 20 BAD PROG# RKPCHA02490CSR 20 SETON 82 RKPCHA02500CSR 82 EXSR EXCPT RKPCHA02510CSR SETOF 82 RKPCHA02520CSR 20 GOTO GETPNO TRY PROG# AGAINRKPCHA0002530CSR MOVE NPN PN 10 INRKPCHA02540CSR MOVE PN NAME10 10 RKPCHA02550CSRN43 SNM,PN COMP ' ' 6060 RKPCHA02560CSR 60 PN SUB 1 BP 20 RKPCHA02570CSR 60 BP MULT 20 BP RKPCHA02580CSR 72 GOTO SETHED RKPCHA02590CSR 73 GOTO JMPOUT RKPCHA0002600CSR 60 GOTO JMPOUT RKPCHA02610CSR GETPNM TAG RKPCHA02620CSR MOVEL'PROG NAM'WORD RKPCHA02630CSR MOVE 'E - 'WORD RKPCHA02640CSR Z-ADD11 OLN RKPCHA02650CSR Z-ADD6 ILN RKPCHA02660CSR EXSR TYPES RKPCHA0002670CSR MOVELBUFFER PNAME 8 RKPCHA02680CSR MOVE ' ' PNAME RKPCHA02690CSR CHNPRG TAG RKPCHA02700CSR PNAME CHAINKPROGS 27 RKPCHA02710CSRN27 MOVELPNAME SNM,PN RKPCHA02720CSRN27 GOTO LOADIT RKPCHA02730CSR MOVEL' 'WORD RKPCHA0002740CSR MOVELPNAME WORD RKPCHA02750CSR MOVE 'ABSENT 'WORD RKPCHA02760CSR MOVE 'R' TYPE 1 RKPCHA02770CSR MOVELWORD BUFFER RKPCHA02780CSR Z-ADD7 MASK 10 RKPCHA02790CSR Z-ADD16 BLNGTH RKPCHA02800CSR EXSR CRTCOM RKPCHA0002810CSR RCODE COMP 'E' 20 RKPCHA02820CSR PRGMT TAG RKPCHA02830C*R 20 EXSR PROGMT RKPCHA02840C*R 20 GOTO CHNPRG RKPCHA02850CSR GOTO GETPNM RKPCHA02860CSR LOADIT TAG RKPCHA02870CSR Z-ADD14 OLN RKPCHA0002880CSR Z-ADD1 ILN RKPCHA02890CSR MOVEL'NEXT PRO'WORD RKPCHA02900CSR MOVE 'G # - 'WORD RKPCHA02910CSR EXSR TYPES RKPCHA02920CSR MOVELBUFFER NP,PN RKPCHA02930CSR PN SUB 1 BP RKPCHA02940CSR BP MULT 20 BP RKPCHA0002950CSR BP ADD 1 N 20 RKPCHA02960CSR Z-ADD1 X 20 RKPCHA02970CSR BLDARY TAG RKPCHA02980CSR FN COMP B72 20 RKPCHA02990CSR 20 N SUB 1 MAXFLD 20 RKPCHA03000CSR 20 MOVE MAXFLD SMX,PN RKPCHA03010CSR 20 GOTO JMPOUT RKPCHA0003020CSR MOVE FN SFN,N FIELD NAME RKPCHA03030CSR MOVE AN SAN,N ALPHA OR NUMER RKPCHA03040CSR MOVE AD SAD,N AUTO DUP RKPCHA03050CSR MOVE ST SST,N START POSITION RKPCHA03060CSR MOVE LN SLN,N RKPCHA03070CSR MVX TAG RKPCHA03080CSR MOVE X PNAME RKPCHA0003090CSR PNAME CHAINKPROGS 20 RKPCHA03100CSR X ADD 1 X RKPCHA03110CSRN20 X COMP 20 20 RKPCHA03120CSR 20 Z-ADDN MAXFLD RKPCHA03130CSR 20 MOVE MAXFLD SMX,PN RKPCHA03140CSR DCODE COMP 'D' 21 RKPCHA03150CSR 21N20 GOTO MVX RKPCHA0003160CSRN20 N ADD 1 N RKPCHA03170CSRN20 GOTO BLDARY RKPCHA03180CSR JMPOUT TAG RKPCHA03190CSR 43 GOTO ENDGET RKPCHA03200CSR 41 GOTO SETHED RKPCHA03210CSR MOVEL'AUTO-DUP'WORD RKPCHA03220CSR MOVE ' - 'WORD RKPCHA0003230CSR Z-ADD11 OLN RKPCHA03240CSR Z-ADD1 ILN RKPCHA03250CSR EXSR TYPES RKPCHA03260CSR MOVELBUFFER AUTO 1 RKPCHA03270CSR AUTO COMP 'O' 90AUTO-DUP ON RKPCHA03280CSR SETHED TAG RKPCHA03290CSR MOVELSNM,PN NAME10 RKPCHA0003300CSR MOVELNAME10 WORD RKPCHA03310CSR MOVE SMX,PN MAXFLD 20 RKPCHA03320CSR 90 MOVE ' ON' WORD RKPCHA03330CSRN90 MOVE 'OFF' WORD RKPCHA03340CSR MOVELWORD HEAD 40 RKPCHA03350CSR ENDGET ENDSR RKPCHA03360C********************************************************************RKPCHA0003370C* RKPCHA03380C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST RKPCHA03390C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE RKPCHA03400C* CHANGED RKPCHA03410C* RKPCHA03420C********************************************************************RKPCHA03430CSR GETSEQ BEGSR RKPCHA0003440CSR MOVEL'SEQ # - 'WORD RKPCHA03450CSR Z-ADD8 OLN RKPCHA03460CSR Z-ADD5 ILN RKPCHA03470CSR EXSR TYPES RKPCHA03480CSR Z-ADD5 VL RKPCHA03490CSR MOVELBUFFER VAR RKPCHA03500CSR EXIT SUBRAJ RKPCHA0003510CSR RLABL VL RKPCHA03520CSR RLABL VAR RKPCHA03530CSR MOVELVAR SEQNO RKPCHA03540CSR SEQNO COMP 0 20 RKPCHA03550CSRN20 Z-ADD1 SEQNO RKPCHA03560CSR SETON 95 RKPCHA03570CSR ENDSEQ ENDSR RKPCHA0003580C********************************************************************RKPCHA03590C* RKPCHA03600C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO RKPCHA03610C* RKPCHA03620C********************************************************************RKPCHA03630CSR GETREC BEGSR RKPCHA03640CSR SEQRD TAG RKPCHA0003650CSR EXSR TSTSEQ RKPCHA03660CSR 94 EXSR GETSEQ RKPCHA03670CSR 94 GOTO SEQRD RKPCHA03680CSR SEQNO CHAINRTOUT1 56 RKPCHA03690CSR MOVELRECORD TST 2 RKPCHA03700CSR TST COMP '<>' 99 RKPCHA03710CSR 40N99 SEQNO ADD 1 SEQNO RKPCHA0003720CSR 40N99 GOTO SEQRD RKPCHA03730CSR 41 99 EXSR NOCHG RKPCHA03740CSR 41 99 GOTO SEQRD RKPCHA03750CSR 56 SETON 88 RKPCHA03760CSR 88 EXSR EXCPT RKPCHA03770CSR SETOF 88 RKPCHA03780CSR 56 EXSR GETSEQ RKPCHA0003790CSR 56 GOTO SEQRD RKPCHA03800CSR ENDSR RKPCHA03810C********************************************************************RKPCHA03820C* RKPCHA03830C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY RKPCHA03840C* IS DONE IF A RUBOUT IS USED RKPCHA03850C* RKPCHA0003860C********************************************************************RKPCHA03870CSR TYPES BEGSR RKPCHA03880CSR OVER TAG RKPCHA03890CSR Z-ADDOLN BLNGTH RKPCHA03900CSR MOVELWORD BUFFER RKPCHA03910CSR MOVE 'S' TYPE RKPCHA03920CSR EXSR CRTCOM RKPCHA0003930CSR MOVE 'A' TYPE RKPCHA03940CSR Z-ADDILN BLNGTH RKPCHA03950CSR EXSR CRTCOM RKPCHA03960CSR RCODE COMP 'R' 25 RKPCHA03970CSR 25 EXSR SKIP RKPCHA03980CSR 25 GOTO OVER RKPCHA03990CSR RCODE COMP 'O' 25 RKPCHA0004000CSR 25 EXSR SKIP RKPCHA04010CSR ENDSR RKPCHA04020C********************************************************************RKPCHA04030C* RKPCHA04040C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT RKPCHA04050C* RKPCHA04060C********************************************************************RKPCHA0004070CSR SKIP BEGSR RKPCHA04080CSR MOVELBUFFER NBUF 1 RKPCHA04090CSR MOVEL' ' BUFFER RKPCHA04100CSR Z-ADD1 BLNGTH RKPCHA04110CSR MOVE 'T' TYPE RKPCHA04120CSR EXSR CRTCOM RKPCHA04130CSR MOVELNBUF BUFFER RKPCHA0004140CSR ENDSR RKPCHA04150C********************************************************************RKPCHA04160C* RKPCHA04170C* RKPCHA04180C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED RKPCHA04190C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER RKPCHA04200C* RKPCHA0004210CSR MVRECD BEGSR RKPCHA04220CSR MOVELB72 BUFFER RKPCHA04230CSR Z-ADD1 TSTRT RKPCHA04240CSR Z-ADDSST,N SSTRT RKPCHA04250CSR Z-ADDSLN,N NCHARS RKPCHA04260CSR EXIT SUBRMV RKPCHA04270CSR RLABL OLDREC RKPCHA0004280CSR RLABL SSTRT 30 RKPCHA04290CSR RLABL BUFFER RKPCHA04300CSR RLABL TSTRT 30 RKPCHA04310CSR RLABL NCHARS 30 RKPCHA04320CSR ENDSR RKPCHA04330C********************************************************************RKPCHA04340CSR EXCPT BEGSR RKPCHA0004350CSRN81N82N83 RKPCHA04360CANN84N88 GOTO PUTOUT RKPCHA04370CSR MOVELB72 BUFFER RKPCHA04380CSR 81 MOVELMSG,1 BUFFER RKPCHA04390CSR 83 MOVELMSG,2 BUFFER RKPCHA04400CSR 88 MOVELMSG,3 BUFFER RKPCHA04410CSR 82 MOVELMSG,4 BUFFER RKPCHA0004420CSRN84 GOTO PUTOUT RKPCHA04430CSRN85 MOVELSFN,N BUFFER RKPCHA04440CSRN18 Z-ADD20 BLNGTH RKPCHA04450CSRN18 GOTO PUTOUT RKPCHA04460CSR MOVELHEAD BUFFER RKPCHA04470CSR MOVE 'T' TYPE RKPCHA04480CSR Z-ADD69 BLNGTH RKPCHA0004490CSR EXSR CRTCOM RKPCHA04500CSR MOVELSFN,N BUFFER RKPCHA04510CSR Z-ADD20 BLNGTH RKPCHA04520CSR PUTOUT TAG RKPCHA04530CSR MOVE 'S' TYPE RKPCHA04540CSR EXSR CRTCOM RKPCHA04550CSR ENDSR RKPCHA0004560C* RKPCHA04570CSR ALMTS BEGSR RKPCHA04580CSR MOVE 'C' TYPE 1 RKPCHA04590CSR Z-ADD0 BLNGTH 20 RKPCHA04600CSR MOVE ' ' RCODE 1 RKPCHA04610CSR Z-ADD0 MASK 10 RKPCHA04620CSR Z-ADD0 DTYPE 10 RKPCHA0004630CSR EXSR CRTCOM RKPCHA04640CSR MOVELARY1,1 BUFFER RKPCHA04650CSR MOVE 'S' TYPE RKPCHA04660CSR Z-ADD50 BLNGTH RKPCHA04670CSR EXSR CRTCOM RKPCHA04680CSR MOVE 'A' TYPE RKPCHA04690CSR Z-ADD5 BLNGTH RKPCHA0004700CSR Z-ADD1 DTYPE RKPCHA04710CSR EXSR CRTCOM RKPCHA04720CSR EXSR SKIP RKPCHA04730CSR RCODE COMP 'R' 86 RKPCHA04740CSR Z-ADD5 VL RKPCHA04750CSR MOVELBUFFER VAR RKPCHA04760CSR EXIT SUBRAJ RKPCHA0004770CSR RLABL VL RKPCHA04780CSR RLABL VAR RKPCHA04790CSR MOVELVAR BUFFER RKPCHA04800CSR MOVELBUFFER LOW 50 RKPCHA04810CSR MOVELARY1,2 BUFFER RKPCHA04820CSR MOVE 'S' TYPE RKPCHA04830CSR Z-ADD50 BLNGTH RKPCHA0004840CSR EXSR CRTCOM RKPCHA04850CSR MOVE 'A' TYPE RKPCHA04860CSR Z-ADD5 BLNGTH RKPCHA04870CSR Z-ADD1 DTYPE RKPCHA04880CSR EXSR CRTCOM RKPCHA04890CSR RCODE COMP 'R' 87 RKPCHA04900CSR Z-ADD5 VL RKPCHA0004910CSR MOVELBUFFER VAR RKPCHA04920CSR EXIT SUBRAJ RKPCHA04930CSR RLABL VL RKPCHA04940CSR RLABL VAR RKPCHA04950CSR MOVELVAR BUFFER RKPCHA04960CSR MOVELBUFFER HIGH 50 RKPCHA04970CSR MOVE 'C' TYPE RKPCHA0004980CSR EXSR CRTCOM RKPCHA04990CSR 86 RKPCHA05000COR 87 GOTO ALMTS RKPCHA05010CSR Z-ADD0 DTYPE RKPCHA05020CSR ENDSR RKPCHA05030CSR CRTCOM BEGSR RKPCHA05040CSR EXITFSUBRCM RKPCHA0005050CSR RLABL BUFFER RKPCHA05060CSR RLABL TYPE RKPCHA05070CSR RLABL BLNGTH RKPCHA05080CSR RLABL RCODE RKPCHA05090CSR RLABL MASK RKPCHA05100CSR RLABL DTYPE RKPCHA05110CSR ENDSR RKPCHA0005120CSR PUTSEQ BEGSR RKPCHA05130CSR MOVELMSG,5 BUFFER 72 RKPCHA05140CSR MOVE 'S' TYPE RKPCHA05150CSR Z-ADD25 BLNGTH RKPCHA05160CSR EXSR CRTCOM RKPCHA05170CSR MOVELSEQNO BUFFER RKPCHA05180CSR MOVE 'T' TYPE RKPCHA0005190CSR Z-ADD5 BLNGTH RKPCHA05200CSR EXSR CRTCOM RKPCHA05210CSR ENDSR RKPCHA05220CSR TSTSEQ BEGSR RKPCHA05230CSR SETOF 949697 RKPCHA05240CSR SEQNO COMP LOW 989698 RKPCHA05250CSR 98 SEQNO COMP HIGH 979898 RKPCHA0005260CSR 98 GOTO ENDTST RKPCHA05270CSR 40 96 MOVELMSG,6 BUFFER RKPCHA05280CSR 40 97 MOVELMSG,7 BUFFER RKPCHA05290CSRN40 MOVELMSG,8 BUFFER RKPCHA05300CSRN40 SETON 94 RKPCHA05310CSR MOVE 'T' TYPE RKPCHA05320CSR Z-ADD25 BLNGTH RKPCHA0005330CSR EXSR CRTCOM RKPCHA05340CSR 40 97 MOVE 'F' TYPE RKPCHA05350CSR 40 97 EXSR CRTCOM RKPCHA05360CSR ENDTST ENDSR RKPCHA05370CSR NOCHG BEGSR RKPCHA05380CSR MOVELMSG,9 BUFFER RKPCHA05390CSR MOVE 'T' TYPE RKPCHA0005400CSR Z-ADD25 BLNGTH RKPCHA05410CSR EXSR CRTCOM RKPCHA05420CSR EXSR GETSEQ RKPCHA05430CSR ENDSR RKPCHA05440C********************************************************************RKPCHA05450ORTOUT1 E 70N56 RKPCHA05460O RECORD 128 RKPCHA0005470O 42 128 'X' RKPCHA05480O SEQNO 127 RKPCHA** 005490ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005500ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005510ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005520ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00553000** 005540MODE MUST BE A,C,V,OR E 005550FIRST FIELD NAME BLANK 005560INVALID SEQ # 005570PROG# MUST BE FROM 1-4 005580CURRENT SEQUENCE NBR 005590SEQNO TOO LOW 00560000RUN EDIT PROG-FILE FULL 005610SEQNO NOT IN YOUR LIMITS 005620ILLEGAL CHANGE-NO DATA 005630** 005640ENTER BEGINNING RELATIVE RECORD NUMBER 005650ENTER ENDING RELATIVE RECORD NUMBER 005660/* 00567000__EDIT PROG-FILE FULL 005610SEQNO NOT IN YOUR LIMITS 005620ILLEGAL CHANGE-NO DATA 005630** 005640ENTER BEGINNING RELATIVE RECORD NUMBER 005650ENTER ENDING RELATIVE RECORD NUMBER 005660/* 0056700(? 8TXRKPCHB P999999111111(000010H S RKPCHB00020X DECK-ID M91 MFG/DIST/ACCT SYSTEM SUMMARY-123 RKPCHB00030F* ENTER ROUTING REQUESTS INTO RTOUT2 RKPCHB00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RKPCHB00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RKPCHB00060F* CONTROL DATA PROPRIETARY PRODUCT RKPCHB00070F* RKPCHB0000080FRTDUM IPE F 72 DISK RKPCHB00090FKPROGS IC F 36R 8AI 1 DISK RKPCHB00100FRTOUT2 UC F 128R DISK RKPCHB00110F********************************************************************RKPCHB00120F* INDICATOR FUNCTION LIST RKPCHB00130F* 01 DUMMY RECORD RKPCHB00140F* 02 KEYPYNCH PARAMETER FILE RKPCHB0000150F* 05 KEYPUNCH DATA FILE RKPCHB00160F* 18 RKPCHB00170F* 19 RKPCHB00180F* 20 RKPCHB00190F* 21 RKPCHB00200F* 25 RETRY ON RUBOUT RKPCHB00210F* 27 AUTO DUP RKPCHB0000220F* 28 RKPCHB00230F* 29 RKPCHB00240F* 40 MODE IS A-ADD RKPCHB00250F* 41 MODE IS C-CHANGE RKPCHB00260F* 42 MODE IS V-VERIFY RKPCHB00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS RKPCHB00280F* 44 MODE IS E-END OF JOB RKPCHB0000290F* 56 SEQ NBR NOT IN KPFILE RKPCHB00300F* 60 NEW PROGRAM NBR ONLY RKPCHB00310F* 61 AUTO DUP ONLY RKPCHB00320F* 70 RKPCHB00330F* 72 RKPCHB00340F* 73 MODE IS LESS THAN OR = 4 RKPCHB00350F* 81 MODE IS INVALID RKPCHB0000360F* 82 BAD PROG NBR RKPCHB00370F* 83 FIRST FIELD NAME BLANK RKPCHB00380F* 84 OUTPUT FIELD NAME RKPCHB00390F* 85 RKPCHB00400F* 88 SEQ NBR NOT IN KPFILE RKPCHB00410F* 90 AUTO DUP ON RKPCHB00420F* 95 RKPCHB0000430F* 98 RCD WITHIN OPERATOR LIMITS RKPCHB00440F* LR RKPCHB00450F********************************************************************RKPCHB00460E MSG 1 10 25 RKPCHB00470E SFN 80 20 RKPCHB00480E SAN 80 1 RKPCHB00490E SAD 80 1 RKPCHB0000500E SST 80 3 0 RKPCHB00510E SLN 80 2 0 RKPCHB00520E SNM 4 6 RKPCHB00530E SMX 4 2 0 RKPCHB00540E NP 4 1 0 RKPCHB00550E ARY1 1 2 50 RKPCHB00560IRTDUM NS 01 RKPCHB0000570I 1 1 A RKPCHB00580IKPROGS NS 02 RKPCHB00590I 9 28 FN RKPCHB00600I 29 29 AN RKPCHB00610I 30 30 AD RKPCHB00620I 31 33 ST RKPCHB00630I 34 35 LN RKPCHB0000640I 36 36 DCODE RKPCHB00650IRTOUT2 NS 05 RKPCHB00660I 1 128 RECORD RKPCHB00670C MOVE ' ' B72 72 RKPCHB00680C EXSR ALMTS RKPCHB00690C Z-ADDLOW SEQNO RKPCHB00700C NLR SETON LR RKPCHB0000710CLR START TAG RKPCHB00720CLR MOVEL'' WORD RKPCHB01590CLR Z-ADD1 OLN RKPCHB01600CLR Z-ADD1 ILN RKPCHB01610CLR EXSR TYPES RKPCHB0001620CLR MOVELBUFFER MODE RKPCHB01630CLR MODE COMP '4' 7373 RKPCHB01640CLR MODE COMP 'P' 60 NEW PROG#ONLY RKPCHB01650CLR MODE COMP 'D' 61 AUTO-DUP ONLY RKPCHB01660CLRN60N61N73 GOTO CHKMOD NEW 46DE RKPCHB01670CLR 73 MOVE MODE NPN 10 RKPCHB01680CLR EXSR GETPRG RKPCHB0001690CLR SETOF 606173 RKPCHB01700CLR GOTO SAMREC RKPCHB01710CLR CHKNUM TAG RKPCHB01720CLR MOVELBUFFER MODE RKPCHB01730CLR MODE COMP '@' 20 RKPCHB01740CLR 20N42 GOTO OUTREC RKPCHB01750CLR SAN,N COMP 'N' 19 RKPCHB0001760CLRN19 GOTO CHKVER RKPCHB01770CLR Z-ADDSLN,N VL 20 RKPCHB01780CLR MOVELBUFFER VAR 15 RKPCHB01790CLR EXIT SUBRAJ RKPCHB01800CLR RLABL VL RKPCHB01810CLR RLABL VAR RKPCHB01820CLR MOVELVAR BUFFER RKPCHB0001830CLR Z-ADDVL BLNGTH RKPCHB01840CLR EXSR EXCPT RKPCHB01850CLR SETOF 19 RKPCHB01860CLR CHKVER TAG RKPCHB01870CLRN42 GOTO MOVBUF RKPCHB01880CLR TBUF COMP BUFFER 2020 RKPCHB01890CLRN20 GOTO MOVBUF RKPCHB0001900CLR MOVEL'KP VERIF'WORD RKPCHB01910CLR MOVE 'Y ERROR 'WORD RKPCHB01920CLR MOVELWORD BUFFER RKPCHB01930CLR MOVE 'R' TYPE RKPCHB01940CLR Z-ADD6 MASK ONLY 'R' OR 'E'RKPCHB01950CLR EXSR CRTCOM RKPCHB01960CLR RCODE COMP 'R' 20 RKPCHB0001970CLR 20 GOTO OUTFLD RKPCHB01980CLR MOVBUF TAG RKPCHB01990CLR Z-ADDSST,N TSTRT 30 RKPCHB02000CLR Z-ADDSLN,N NCHARS 30 RKPCHB02010CLR Z-ADD1 SSTRT RKPCHB02020CLR EXIT SUBRMV RKPCHB02030CLR RLABL BUFFER RKPCHB0002040CLR RLABL SSTRT RKPCHB02050CLR RLABL RECORD RKPCHB02060CLR RLABL TSTRT RKPCHB02070CLR RLABL NCHARS RKPCHB02080CLR GOTO LOOP RKPCHB02090CLR RITDUP TAG RKPCHB02100CLR EXSR MVRECD RKPCHB0002110CLR SETON 19 RKPCHB02120CLR Z-ADDSLN,N BLNGTH RKPCHB02130CLRN27 EXSR EXCPT RKPCHB02140CLR SETOF 19 RKPCHB02150CLR GOTO MOVBUF RKPCHB02160CLR OUTREC TAG RKPCHB02170CLR SETON 187084 RKPCHB0002180CLR SETON 85 RKPCHB02190CLR EXCPT RKPCHB02200CLR EXSR EXCPT RKPCHB02210CLR SETOF 708485 RKPCHB02220CLR MOVELRECORD OLDREC128 RKPCHB02230CLR NP,PN COMP 0 72 RKPCHB02240CLRN72 GOTO NXTREC RKPCHB0002250CLR MOVE NP,PN NPN RKPCHB02260CLR EXSR GETPRG RKPCHB02270CLR SETOF 72 RKPCHB02280CLR GOTO NXTREC RKPCHB02290CLR EOJ TAG RKPCHB02300C********************************************************************RKPCHB02310C* RKPCHB0002320C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION RKPCHB02330C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. RKPCHB02340C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. RKPCHB02350C* RKPCHB02360C********************************************************************RKPCHB02370CSR GETPRG BEGSR RKPCHB02380CSR 61 GOTO JMPOUT RKPCHB0002390CSR 72 RKPCHB02400COR 73 GOTO CHKPN RKPCHB02410CSR GETPNO TAG RKPCHB02420CSR MOVEL'PROG # -'WORD RKPCHB02430CSR Z-ADD8 OLN RKPCHB02440CSR Z-ADD1 ILN RKPCHB02450CSR EXSR TYPES RKPCHB0002460CSR MOVELBUFFER NPN 10 RKPCHB02470CSR CHKPN TAG RKPCHB02480CSR NPN COMP 0 2020 RKPCHB02490CSRN20 NPN COMP 4 20 BAD PROG# RKPCHB02500CSR 20 SETON 82 RKPCHB02510CSR 82 EXSR EXCPT RKPCHB02520CSR SETOF 82 RKPCHB0002530CSR 20 GOTO GETPNO TRY PROG# AGAINRKPCHB02540CSR MOVE NPN PN 10 INRKPCHB02550CSR MOVE PN NAME10 10 RKPCHB02560CSRN43 SNM,PN COMP ' ' 6060 RKPCHB02570CSR 60 PN SUB 1 BP 20 RKPCHB02580CSR 60 BP MULT 20 BP RKPCHB02590CSR 72 GOTO SETHED RKPCHB0002600CSR 73 GOTO JMPOUT RKPCHB02610CSR 60 GOTO JMPOUT RKPCHB02620CSR GETPNM TAG RKPCHB02630CSR MOVEL'PROG NAM'WORD RKPCHB02640CSR MOVE 'E - 'WORD RKPCHB02650CSR Z-ADD11 OLN RKPCHB02660CSR Z-ADD6 ILN RKPCHB0002670CSR EXSR TYPES RKPCHB02680CSR MOVELBUFFER PNAME 8 RKPCHB02690CSR MOVE ' ' PNAME RKPCHB02700CSR CHNPRG TAG RKPCHB02710CSR PNAME CHAINKPROGS 27 RKPCHB02720CSRN27 MOVELPNAME SNM,PN RKPCHB02730CSRN27 GOTO LOADIT RKPCHB0002740CSR MOVEL' 'WORD RKPCHB02750CSR MOVELPNAME WORD RKPCHB02760CSR MOVE 'ABSENT 'WORD RKPCHB02770CSR MOVE 'R' TYPE 1 RKPCHB02780CSR MOVELWORD BUFFER RKPCHB02790CSR Z-ADD7 MASK 10 RKPCHB02800CSR Z-ADD16 BLNGTH RKPCHB0002810CSR EXSR CRTCOM RKPCHB02820CSR RCODE COMP 'E' 20 RKPCHB02830CSR PRGMT TAG RKPCHB02840C*R 20 EXSR PROGMT RKPCHB02850C*R 20 GOTO CHNPRG RKPCHB02860CSR GOTO GETPNM RKPCHB02870CSR LOADIT TAG RKPCHB0002880CSR Z-ADD14 OLN RKPCHB02890CSR Z-ADD1 ILN RKPCHB02900CSR MOVEL'NEXT PRO'WORD RKPCHB02910CSR MOVE 'G # - 'WORD RKPCHB02920CSR EXSR TYPES RKPCHB02930CSR MOVELBUFFER NP,PN RKPCHB02940CSR PN SUB 1 BP RKPCHB0002950CSR BP MULT 20 BP RKPCHB02960CSR BP ADD 1 N 20 RKPCHB02970CSR Z-ADD1 X 20 RKPCHB02980CSR BLDARY TAG RKPCHB02990CSR FN COMP B72 20 RKPCHB03000CSR 20 N SUB 1 MAXFLD 20 RKPCHB03010CSR 20 MOVE MAXFLD SMX,PN RKPCHB0003020CSR 20 GOTO JMPOUT RKPCHB03030CSR MOVE FN SFN,N FIELD NAME RKPCHB03040CSR MOVE AN SAN,N ALPHA OR NUMER RKPCHB03050CSR MOVE AD SAD,N AUTO DUP RKPCHB03060CSR MOVE ST SST,N START POSITION RKPCHB03070CSR MOVE LN SLN,N RKPCHB03080CSR MVX TAG RKPCHB0003090CSR MOVE X PNAME RKPCHB03100CSR PNAME CHAINKPROGS 20 RKPCHB03110CSR X ADD 1 X RKPCHB03120CSRN20 X COMP 20 20 RKPCHB03130CSR 20 Z-ADDN MAXFLD RKPCHB03140CSR 20 MOVE MAXFLD SMX,PN RKPCHB03150CSR DCODE COMP 'D' 21 RKPCHB0003160CSR 21N20 GOTO MVX RKPCHB03170CSRN20 N ADD 1 N RKPCHB03180CSRN20 GOTO BLDARY RKPCHB03190CSR JMPOUT TAG RKPCHB03200CSR 43 GOTO ENDGET RKPCHB03210CSR 41 GOTO SETHED RKPCHB03220CSR MOVEL'AUTO-DUP'WORD RKPCHB0003230CSR MOVE ' - 'WORD RKPCHB03240CSR Z-ADD11 OLN RKPCHB03250CSR Z-ADD1 ILN RKPCHB03260CSR EXSR TYPES RKPCHB03270CSR MOVELBUFFER AUTO 1 RKPCHB03280CSR AUTO COMP 'O' 90AUTO-DUP ON RKPCHB03290CSR SETHED TAG RKPCHB0003300CSR MOVELSNM,PN NAME10 RKPCHB03310CSR MOVELNAME10 WORD RKPCHB03320CSR MOVE SMX,PN MAXFLD 20 RKPCHB03330CSR 90 MOVE ' ON' WORD RKPCHB03340CSRN90 MOVE 'OFF' WORD RKPCHB03350CSR MOVELWORD HEAD 40 RKPCHB03360CSR ENDGET ENDSR RKPCHB0003370C********************************************************************RKPCHB03380C* RKPCHB03390C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST RKPCHB03400C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE RKPCHB03410C* CHANGED RKPCHB03420C* RKPCHB03430C********************************************************************RKPCHB0003440CSR GETSEQ BEGSR RKPCHB03450CSR MOVEL'SEQ # - 'WORD RKPCHB03460CSR Z-ADD8 OLN RKPCHB03470CSR Z-ADD5 ILN RKPCHB03480CSR EXSR TYPES RKPCHB03490CSR Z-ADD5 VL RKPCHB03500CSR MOVELBUFFER VAR RKPCHB0003510CSR EXIT SUBRAJ RKPCHB03520CSR RLABL VL RKPCHB03530CSR RLABL VAR RKPCHB03540CSR MOVELVAR SEQNO RKPCHB03550CSR SEQNO COMP 0 20 RKPCHB03560CSRN20 Z-ADD1 SEQNO RKPCHB03570CSR SETON 95 RKPCHB0003580CSR ENDSEQ ENDSR RKPCHB03590C********************************************************************RKPCHB03600C* RKPCHB03610C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO RKPCHB03620C* RKPCHB03630C********************************************************************RKPCHB03640CSR GETREC BEGSR RKPCHB0003650CSR SEQRD TAG RKPCHB03660CSR EXSR TSTSEQ RKPCHB03670CSR 94 EXSR GETSEQ RKPCHB03680CSR 94 GOTO SEQRD RKPCHB03690CSR SEQNO CHAINRTOUT2 56 RKPCHB03700CSR MOVELRECORD TST 2 RKPCHB03710CSR TST COMP '<>' 99 RKPCHB0003720CSR 40N99 SEQNO ADD 1 SEQNO RKPCHB03730CSR 40N99 GOTO SEQRD RKPCHB03740CSR 41 99 EXSR NOCHG RKPCHB03750CSR 41 99 GOTO SEQRD RKPCHB03760CSR 56 SETON 88 RKPCHB03770CSR 88 EXSR EXCPT RKPCHB03780CSR SETOF 88 RKPCHB0003790CSR 56 EXSR GETSEQ RKPCHB03800CSR 56 GOTO SEQRD RKPCHB03810CSR ENDSR RKPCHB03820C********************************************************************RKPCHB03830C* RKPCHB03840C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY RKPCHB03850C* IS DONE IF A RUBOUT IS USED RKPCHB0003860C* RKPCHB03870C********************************************************************RKPCHB03880CSR TYPES BEGSR RKPCHB03890CSR OVER TAG RKPCHB03900CSR Z-ADDOLN BLNGTH RKPCHB03910CSR MOVELWORD BUFFER RKPCHB03920CSR MOVE 'S' TYPE RKPCHB0003930CSR EXSR CRTCOM RKPCHB03940CSR MOVE 'A' TYPE RKPCHB03950CSR Z-ADDILN BLNGTH RKPCHB03960CSR EXSR CRTCOM RKPCHB03970CSR RCODE COMP 'R' 25 RKPCHB03980CSR 25 EXSR SKIP RKPCHB03990CSR 25 GOTO OVER RKPCHB0004000CSR RCODE COMP 'O' 25 RKPCHB04010CSR 25 EXSR SKIP RKPCHB04020CSR ENDSR RKPCHB04030C********************************************************************RKPCHB04040C* RKPCHB04050C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT RKPCHB04060C* RKPCHB0004070C********************************************************************RKPCHB04080CSR SKIP BEGSR RKPCHB04090CSR MOVELBUFFER NBUF 1 RKPCHB04100CSR MOVEL' ' BUFFER RKPCHB04110CSR Z-ADD1 BLNGTH RKPCHB04120CSR MOVE 'T' TYPE RKPCHB04130CSR EXSR CRTCOM RKPCHB0004140CSR MOVELNBUF BUFFER RKPCHB04150CSR ENDSR RKPCHB04160C********************************************************************RKPCHB04170C* RKPCHB04180C* RKPCHB04190C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED RKPCHB04200C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER RKPCHB0004210C* RKPCHB04220CSR MVRECD BEGSR RKPCHB04230CSR MOVELB72 BUFFER RKPCHB04240CSR Z-ADD1 TSTRT RKPCHB04250CSR Z-ADDSST,N SSTRT RKPCHB04260CSR Z-ADDSLN,N NCHARS RKPCHB04270CSR EXIT SUBRMV RKPCHB0004280CSR RLABL OLDREC RKPCHB04290CSR RLABL SSTRT 30 RKPCHB04300CSR RLABL BUFFER RKPCHB04310CSR RLABL TSTRT 30 RKPCHB04320CSR RLABL NCHARS 30 RKPCHB04330CSR ENDSR RKPCHB04340C********************************************************************RKPCHB0004350CSR EXCPT BEGSR RKPCHB04360CSRN81N82N83 RKPCHB04370CANN84N88 GOTO PUTOUT RKPCHB04380CSR MOVELB72 BUFFER RKPCHB04390CSR 81 MOVELMSG,1 BUFFER RKPCHB04400CSR 83 MOVELMSG,2 BUFFER RKPCHB04410CSR 88 MOVELMSG,3 BUFFER RKPCHB0004420CSR 82 MOVELMSG,4 BUFFER RKPCHB04430CSRN84 GOTO PUTOUT RKPCHB04440CSRN85 MOVELSFN,N BUFFER RKPCHB04450CSRN18 Z-ADD20 BLNGTH RKPCHB04460CSRN18 GOTO PUTOUT RKPCHB04470CSR MOVELHEAD BUFFER RKPCHB04480CSR MOVE 'T' TYPE RKPCHB0004490CSR Z-ADD69 BLNGTH RKPCHB04500CSR EXSR CRTCOM RKPCHB04510CSR MOVELSFN,N BUFFER RKPCHB04520CSR Z-ADD20 BLNGTH RKPCHB04530CSR PUTOUT TAG RKPCHB04540CSR MOVE 'S' TYPE RKPCHB04550CSR EXSR CRTCOM RKPCHB0004560CSR ENDSR RKPCHB04570C* RKPCHB04580CSR ALMTS BEGSR RKPCHB04590CSR MOVE 'C' TYPE 1 RKPCHB04600CSR Z-ADD0 BLNGTH 20 RKPCHB04610CSR MOVE ' ' RCODE 1 RKPCHB04620CSR Z-ADD0 MASK 10 RKPCHB0004630CSR Z-ADD0 DTYPE 10 RKPCHB04640CSR EXSR CRTCOM RKPCHB04650CSR MOVELARY1,1 BUFFER RKPCHB04660CSR MOVE 'S' TYPE RKPCHB04670CSR Z-ADD50 BLNGTH RKPCHB04680CSR EXSR CRTCOM RKPCHB04690CSR MOVE 'A' TYPE RKPCHB0004700CSR Z-ADD5 BLNGTH RKPCHB04710CSR Z-ADD1 DTYPE RKPCHB04720CSR EXSR CRTCOM RKPCHB04730CSR EXSR SKIP RKPCHB04740CSR RCODE COMP 'R' 86 RKPCHB04750CSR Z-ADD5 VL RKPCHB04760CSR MOVELBUFFER VAR RKPCHB0004770CSR EXIT SUBRAJ RKPCHB04780CSR RLABL VL RKPCHB04790CSR RLABL VAR RKPCHB04800CSR MOVELVAR BUFFER RKPCHB04810CSR MOVELBUFFER LOW 50 RKPCHB04820CSR MOVELARY1,2 BUFFER RKPCHB04830CSR MOVE 'S' TYPE RKPCHB0004840CSR Z-ADD50 BLNGTH RKPCHB04850CSR EXSR CRTCOM RKPCHB04860CSR MOVE 'A' TYPE RKPCHB04870CSR Z-ADD5 BLNGTH RKPCHB04880CSR Z-ADD1 DTYPE RKPCHB04890CSR EXSR CRTCOM RKPCHB04900CSR RCODE COMP 'R' 87 RKPCHB0004910CSR Z-ADD5 VL RKPCHB04920CSR MOVELBUFFER VAR RKPCHB04930CSR EXIT SUBRAJ RKPCHB04940CSR RLABL VL RKPCHB04950CSR RLABL VAR RKPCHB04960CSR MOVELVAR BUFFER RKPCHB04970CSR MOVELBUFFER HIGH 50 RKPCHB0004980CSR MOVE 'C' TYPE RKPCHB04990CSR EXSR CRTCOM RKPCHB05000CSR 86 RKPCHB05010COR 87 GOTO ALMTS RKPCHB05020CSR Z-ADD0 DTYPE RKPCHB05030CSR ENDSR RKPCHB05040CSR CRTCOM BEGSR RKPCHB0005050CSR EXITFSUBRCM RKPCHB05060CSR RLABL BUFFER RKPCHB05070CSR RLABL TYPE RKPCHB05080CSR RLABL BLNGTH RKPCHB05090CSR RLABL RCODE RKPCHB05100CSR RLABL MASK RKPCHB05110CSR RLABL DTYPE RKPCHB0005120CSR ENDSR RKPCHB05130CSR PUTSEQ BEGSR RKPCHB05140CSR MOVELMSG,5 BUFFER 72 RKPCHB05150CSR MOVE 'S' TYPE RKPCHB05160CSR Z-ADD25 BLNGTH RKPCHB05170CSR EXSR CRTCOM RKPCHB05180CSR MOVELSEQNO BUFFER RKPCHB0005190CSR MOVE 'T' TYPE RKPCHB05200CSR Z-ADD5 BLNGTH RKPCHB05210CSR EXSR CRTCOM RKPCHB05220CSR ENDSR RKPCHB05230CSR TSTSEQ BEGSR RKPCHB05240CSR SETOF 949697 RKPCHB05250CSR SEQNO COMP LOW 989698 RKPCHB0005260CSR 98 SEQNO COMP HIGH 979898 RKPCHB05270CSR 98 GOTO ENDTST RKPCHB05280CSR 40 96 MOVELMSG,6 BUFFER RKPCHB05290CSR 40 97 MOVELMSG,7 BUFFER RKPCHB05300CSRN40 MOVELMSG,8 BUFFER RKPCHB05310CSRN40 SETON 94 RKPCHB05320CSR MOVE 'T' TYPE RKPCHB0005330CSR Z-ADD25 BLNGTH RKPCHB05340CSR EXSR CRTCOM RKPCHB05350CSR 40 97 MOVE 'F' TYPE RKPCHB05360CSR 40 97 EXSR CRTCOM RKPCHB05370CSR ENDTST ENDSR RKPCHB05380CSR NOCHG BEGSR RKPCHB05390CSR MOVELMSG,9 BUFFER RKPCHB0005400CSR MOVE 'T' TYPE RKPCHB05410CSR Z-ADD25 BLNGTH RKPCHB05420CSR EXSR CRTCOM RKPCHB05430CSR EXSR GETSEQ RKPCHB05440CSR ENDSR RKPCHB05450C********************************************************************RKPCHB05460ORTOUT2 E 70N56 RKPCHB0005470O RECORD 128 RKPCHB05480O 42 128 'X' RKPCHB05490O SEQNO 127 RKPCHB** 005500ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005510ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005520ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00553000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005540** 005550MODE MUST BE A,C,V,OR E 005560FIRST FIELD NAME BLANK 005570INVALID SEQ # 005580PROG# MUST BE FROM 1-4 005590CURRENT SEQUENCE NBR 00560000SEQNO TOO LOW 005610RUN EDIT PROG-FILE FULL 005620SEQNO NOT IN YOUR LIMITS 005630ILLEGAL CHANGE-NO DATA 005640** 005650ENTER BEGINNING RELATIVE RECORD NUMBER 005660ENTER ENDING RELATIVE RECORD NUMBER 00567000/* 005680__EDIT PROG-FILE FULL 005620SEQNO NOT IN YOUR LIMITS 005630ILLEGAL CHANGE-NO DATA 005640** 005650ENTER BEGINNING RELATIVE RECORD NUMBER 005660ENTER ENDING RELATIVE RECORD NUMBER 0056700(wG wTXPO330 P 0 999999032778(000010H S PO330 00020X DECK-ID M71 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO330 00030F* THIS PROGRAM PROCESSES VALID RECEIPTS, REMOVE DELETES + CLOSES PO PO330 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO330 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO330 00060F* CONTROL DATA PROPRIETARY PRODUCT PO330 00070F* PO330 0000080FPURUPD IPEAF 83 DISK PO330 00090FPURCH ISEAF 66 27AI 1 DISK PO330 00100FPARTMST IC F 300R20AI 271 DISK PO330 00110FNEWPUR O F 66 27AI 1 DISK PO330 00120FPOINDX O F 8 7AI 1 DISK PO330 00130FPOREC O F 77 DISK PO330 00140FTRANSAC O F 65 DISK A PO330 0000150F$LP1 O F 132 OF PRINTER PO330 00160FHEADING IT F 40 EDISK PO330 00170F* PO330 00180F* ************************************************************** PO330 00190F* ** ** PO330 00200F* ** COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO330 00210F* ** ** PO330 0000220F* ** SYSTEM - PINS PROGRAMMER- ROBBIE FREEMAN ** PO330 00230F* ** ** PO330 00240F* ** PROGRAM- PROCESS P.O. DATE CODED- 11/17/75 ** PO330 00250F* ** RECEIPTS,REMOVE ** PO330 00260F* ** DELETES. ** PO330 00270F* ** ** PO330 00280F* ************************************************************** PO330 0000290F* PO330 00300F* ************************************************************** PO330 00310F* ** ** PO330 00320F* ** FUNCTION OF INDICATORS ** PO330 00330F* ** ** PO330 00340F* ** 01 PURUPD- RECEIPTS ** PO330 00350F* ** 02 PURUPD- ALL OTHERS ** PO330 0000360F* ** 03 PURCH - OPEN P.O. ** PO330 00370F* ** 04 PURCH - RELEASE P.O. ** PO330 00380F* ** 05 PURCH - BLANKET P.O. ** PO330 00390F* ** 06 PURCH - DELETED P.O. ** PO330 00400F* ** 07 PARTMST ** PO330 00410F* ** 10 NO OVERRIDE BUY COST ON PURUPD ** PO330 00420F* ** 11 P.O. DATE IS ZERO - DON'T PRINT ** PO330 0000430F* ** 12 NO OVERRIDE BUY COST ON PURCH ** PO330 00440F* ** 20 ACTIVE P.O. ITEM ** PO330 00450F* ** 25 MATCHING PURCH REC READ FOR THIS L2(PO#) GROUP ** PO330 00460F* ** 30 THIS PO# ACTIVE- OUTPUT TO POINDX ** PO330 00470F* ** 40 PARTIAL/COMPLETE CODE NOT=P- ASSUME COMPLETE ** PO330 00480F* ** 44 ADD TR#44 TO TRANSAC ** PO330 00490F* ** 45 ADD TR#45 TO TRANSAC ** PO330 0000500F* ** 50 NEXT RECORD ON PURCH IS SAME PO#-PART# ** PO330 00510F* ** 51 QTYDUE-QTYIN IS +: CLOSE ONLY IF P/C NOT P ** PO330 00520F* ** 52N50 QTYDUE-QTYIN IS -: CLOSE- NEXT REC ON PURCH IS ** PO330 00530F* ** NOT SAME PO#-PART# SO OVERSHIP THIS REC ** PO330 00540F* ** 52 50 QTYDUE-QTYIN IS -: CLOSE- NEXT REC ON PURCH IS ** PO330 00550F* ** SAME PO#-PART# SO CARRY OVERAGE TO RECEIVE ** PO330 00560F* ** AGAINST NEXT REC ** PO330 0000570F* ** 53 QTYDUE-QTYIN IS 0: CLOSE ** PO330 00580F* ** 55 RECEIVE AGAINST THIS PO#-PART#. PRINT & OUTPUT ** PO330 00590F* ** TO POREC. ** PO330 00600F* ** 71 PO CODE=D - DELETED PURCH, REGARD AS NO MATCH ** PO330 00610F* ** N72 PO CODE NOT OPEN OR RELEASED - ERROR# 72 ** PO330 00620F* ** 73 NO HIT ON PARTMST- ERROR# 73 ** PO330 00630F* ** 74 ITEM CLOSED & UNDER RECEIVED ** PO330 0000640F* ** 75 ITEM CLOSED & OVER RECEIVED ** PO330 00650F* ** 99 TERMINAL ERROR FOR THIS RECEIPT ** PO330 00660F* ************************************************************** PO330 00670E TABN 1 10 2 0 TABM 32 ERR#'S- MESSAGES PO330 00680E HEADING HEAD 1 1 40 PO330 00690IPURUPD XX 01 8 CL 9 CR 29NCX PO330 00700I 1 70PO L2M2 PO330 0000710I 64 83 PART L1M1 PO330 00720I 46 520QTYREC PO330 00730I 53 593OVCOST 10 PO330 00740I 60 60 PC PO330 00750I XX 02 PO330 00760I 1 70PO L2M2 PO330 00770I 64 83 PROD L1M1 PO330 0000780IPURCH XX 03 66 C PO330 00790I 1 70PO L2M2 PO330 00800I 8 27 PART L1M1 PO330 00810I 28 330DUE PO330 00820I 28 290DYY PO330 00830I 30 330DMMDD PO330 00840I 34 380VEN PO330 0000850I 39 440PODAT 11 PO330 00860I 45 510QTYDUE PO330 00870I 52 580QTYIN PO330 00880I 59 653COST 12 PO330 00890I 66 66 POC PO330 00900I 1 66 ALL PO330 00910I XX 04 66 CR PO330 0000920I 1 70PO L2M2 PO330 00930I 8 27 PART L1M1 PO330 00940I 28 330DUE PO330 00950I 28 290DYY PO330 00960I 30 330DMMDD PO330 00970I 34 380VEN PO330 00980I 39 440PODAT 11 PO330 0000990I 45 510QTYDUE PO330 01000I 52 580QTYIN PO330 01010I 59 653COST 12 PO330 01020I 66 66 POC PO330 01030I 1 66 ALL PO330 01040I XX 05 66 CB PO330 01050I 1 70PO L2M2 PO330 0001060I 8 27 PART L1M1 PO330 01070I 66 66 POC PO330 01080I 1 66 ALL PO330 01090I XX 06 66 CD PO330 01100I 1 70PO L2M2 PO330 01110I 8 27 PART L1M1 PO330 01120I XX 08 PO330 0001130I 1 66 X PO330 01140I XX ** PO330 01150I 1 70LPO PO330 01160I 8 27 LPART PO330 01170I 66 66 LPOC PO330 01180IPARTMST XX 07 PO330 01190I 1 37 DESCR PO330 0001200I 74 74 DLTPT PO330 01210I 75 813MAT$ PO330 01220C SETOF 205599 PO330 01230C SETOF 7475 PO330 01240C Z-ADD0 ERR 20 PO330 01250C L2 SETOF 2530 PO330 01260C L1 SETOF 447345 PO330 0001270C L1 Z-ADD0 TRQTY1 70 PO330 01280C L1 Z-ADD0 TRQTY2 70 PO330 01290C L1 Z-ADD0 TOTREC 70 PO330 01300C L1 01 PART CHAINPARTMST 73 PO330 01310C L1 01N73DLTPT COMP ' ' 7373 PO330 01320C 01 EXSR RECEPT PO330 01330C 03NMR PO330 0001340COR 04NMR PO330 01350COR 05 SETON 2030 PO330 01360C 03 MR PO330 01370COR 04 MR EXSR MASTER PO330 01380C 99 ERR LOKUPTABN TABM 99 PO330 01390C 99 ERRORS ADD 1 ERRORS 40 PO330 01400C* PO330 0001410C* ************************************************************** PO330 01420C* ** SUBR RECEPT PROCESSES RECEIPT RECORDS FROM PURUPD. ** PO330 01430C* ** VALID RECEIPTS ARE ACCUMULATED FOR EACH UNIQUE ** PO330 01440C* ** PO#-PART# AND THIS TOTAL IS USED TO RECEIVE AGAINST ** PO330 01450C* ** THE OLDEST PO#-PART#-DUE DATE RECORD ON PURCH. ** PO330 01460C* ************************************************************** PO330 01470C* PO330 0001480CSR RECEPT BEGSR PO330 01490CSR LPOC COMP 'D' 71 D = NO MATCH PO330 01500CSR LPOC COMP ' ' 72 OPEN PO330 01510CSRN72 LPOC COMP 'R' 72 RELEASED PO330 01520CSRNMR P.O. ON FILE? PO330 01530COR MR 71 Z-ADD71 ERR 99 PO330 01540CSR 99 GOTO ENDR NO PO330 0001550CSRN72 Z-ADD72 ERR 99 NOT OPEN,REL PO330 01560CSR 99 GOTO ENDR PO330 01570CSR 73 Z-ADD73 ERR 99 BAD PART # PO330 01580CSR 99 GOTO ENDR PO330 01590C** PO330 01600C** ALL CHECKS PASSED- ACCUMULATE TOT RECEIVED QTY FOR THIS PART # PO330 01610C** AND APPLY IT TO OLDEST DUE DATE WHEN PURCH READ. PO330 0001620C** PO330 01630CSR TOTREC ADD QTYREC TOTREC PO330 01640CSR PC COMP 'P' 4040 NOT P- ASSUME PO330 01650C** COMPLETE PO330 01660CSR ENDR ENDSR PO330 01670C* PO330 01680C* ************************************************************** PO330 0001690C* ** SUBR MASTER PROCESSES THE MASTER RECORDS AFTER ALL ** PO330 01700C* ** RECEIPTS FOR THIS PART# HAVE BEEN READ FROM PURUPD. ** PO330 01710C* ************************************************************** PO330 01720C* PO330 01730CSR MASTER BEGSR PO330 01740CSR SETON 2025 PO330 01750CSR TOTREC COMP 0 5555 PO330 0001760CSRN55 SETON 30 0 RECEIPT QTY PO330 01770CSRN55 GOTO ENDM FORGET IT PO330 01780CSR PO COMP LPO 50LOOK-AHEAD PO# PO330 01790CSR 50 PART COMP LPART 50LOOK-AHEAD PR# PO330 01800CSR Z-ADDQTYIN SAVEIN 70 PO330 01810CSR RECPTS ADD 1 RECPTS 40 PO330 01820CSR QTYIN ADD TOTREC QTYIN PO330 0001830CSR QTYDUE SUB QTYIN DIFF 70 515253 PO330 01840CSR Z-ADD0 TOTREC PO330 01850C** PO330 01860C** IF DIFF IS NEG & NEXT PURCH RECORD IS SAME PO#-PART#, CLOSE PO330 01870C** THIS RECORD WITH QTYIN = QTYDUE & CARRY OVERAGE TO NEXT RECORD PO330 01880C** TO RECEIVE AGAINST IT. IF DIFF IS POS, CLOSE ONLY IF PARTIAL/ PO330 01890C** COMPLETE CODE ON RECEIPT WAS NOT = 'P', OTHERWISE IT REMAINS PO330 0001900C** ON FILE. IF DIFF IS ZERO, CLOSE THIS RECORD & LEAVE OTHERS PO330 01910C** ON PURCH UNCHANGED. FOR EACH ITEM ON PURCH THAT WE RECEIVE PO330 01920C** AGAINST (55 ON), WE OUTPUT A RECORD TO POREC & PRINT A LINE PO330 01930C** ON REPORT, WHETHER OR NOT IT WAS CLOSED. PO330 01940C** PO330 01950CSR 50 52 Z-ADDQTYDUE QTYIN PO330 01960CSR 50 52 Z-SUBDIFF TOTREC PO330 0001970CSR QTYIN SUB SAVEIN ACTREC 70 PO330 01980CSR TRQTY1 ADD ACTREC TRQTY1 4444 PO330 01990CSR 51 40 PO330 02000COR 52 PO330 02010COR 53 SETOF 20 CLOSE ITEM PO330 02020CSRN20 QTYDUE SUB QTYIN CANCEL 70 PO330 02030CSRN20 TRQTY2 ADD CANCEL TRQTY2 4545 PO330 0002040CSR 20 SETON 30 ACTIVE PO#- PO330 02050C** POINDX OUTPUT PO330 02060C** PO330 02070CSR 51 40 SETON 74 UNDER REC'D PO330 02080CSR 52N50 SETON 75 OVER REC'D PO330 02090CSR ENDM ENDSR PO330 02100ONEWPUR D 20 PO330 0002110O ALL 66 PO330 02120O N05 QTYIN 58 PO330 02130OPOINDX T L2 30 PO330 02140O PO 7 PO330 02150O POC 8 PO330 02160OPOREC D 55 PO330 02170O PART 77 PO330 0002180O PO 19 PO330 02190O DMMDD 23 PO330 02200O DYY 25 PO330 02210O UDATE 31 PO330 02220O VEN 36 PO330 02230O N12 COST 43 PO330 02240O N10 OVCOST 43 PO330 0002250O QTYDUE 50 PO330 02260O ACTREC 57 PO330 02270OTRANSAC TADD L1 44 PO330 02280O PART 61 PO330 02290O 14 '44' PO330 02300O TRQTY1 21 PO330 02310O PO 28 PO330 0002320O UDATE 34 PO330 02330O N12 COST 41 PO330 02340O N10 OVCOST 41 PO330 02350O TADD L1 45 PO330 02360O PART 61 PO330 02370O 14 '45' PO330 02380O TRQTY2 21 PO330 0002390O PO 28 PO330 02400O UDATE 34 PO330 02410O$LP1 H 02 1P PO330 02420O OR OF PO330 02430O 4 'PAGE' PO330 02440O PAGE Z 8 PO330 02450O HEAD 86 PO330 0002460O UDATE Y 132 PO330 02470O H 2 1P PO330 02480O OR OF PO330 02490O 70 'PURCHASE ORDER RECEIPT' PO330 02500O 77 'REPORT' PO330 02510O 132 'MFG330' PO330 02520O H 2 1P PO330 0002530O OR OF PO330 02540O 53 'ORDER' PO330 02550O 62 'DUE' PO330 02560O 78 'RECEIPT' PO330 02570O 86 'RECEIVD' PO330 02580O 95 'OVERRIDE' PO330 02581O H 11 1P 0002582O OR OF 02583O 8 'PO#/LOT#' 02584O 20 'PART NUMBER' 02590O H 01 1P PO330 02600O OR OF PO330 02630O 12 'DESCRIPTION' PO330 02640O 44 'VEND#' PO330 0002650O 53 'DATE' PO330 02660O 62 'DATE' PO330 02670O 70 'ORDERED' PO330 02680O 78 'QTY' PO330 02690O 86 'TO-DATE' PO330 02700O 99 'P/C' PO330 02710O 115 'COMMENTS/ERRORS' PO330 0002711O D 2 01 99 02712O PO 8 ' - ' 02713O PART 29 02720O D 1 01 99 PO330 02750O N73 DESCR 38 PO330 02760O QTYRECL 79 PO330 02770O N10 OVCOSTL 96 PO330 0002780O PC 98 PO330 02790O TABM 132 PO330 02791O D 2 55 02792O PO 8 ' - ' 02793O PART 29 02800O D 1 55 PO330 02830O DESCR 38 PO330 0002840O VEN Z 44 PO330 02850O N11 PODAT Y 53 PO330 02860O DMMDD 59 ' / ' PO330 02870O 60 '/' PO330 02880O DYY 62 PO330 02890O QTYDUEL 71 PO330 02900O ACTRECL 79 PO330 0002910O QTYIN L 87 PO330 02920O N12 COST L 96 PO330 02930O N10 OVCOSTL 96 PO330 02940O PC 98 PO330 02950O 20 117 'ITEM STILL ACTIVE' PO330 02960O N20 111 'ITEM CLOSED' PO330 02970O N20 74 128 '- UNDER RECEIVED' PO330 0002980O N20 75 127 '- OVER RECEIVED' PO330 02990O T 21 L2 25N30 PO330 03000O 108 '**** ENTIRE PO#' PO330 03010O PO 116 ' - ' PO330 03020O 132 'NOW CLOSED ****' PO330 03030O T 3 LR PO330 03040O 11 'END OF JOB.' PO330 0003050O 23 'THERE WERE' PO330 03060O RECPTS3 28 PO330 03070O 44 'ITEMS RECEIVED.' PO330 03080O T 1 LR PO330 03090O 23 'THERE WERE' PO330 03100O ERRORS3 28 PO330 03110O 36 'ERRORS.' PO330 00** 003120ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003160** 00317071PO/PART# NOT ON FILE *REJECTED* 0031800072PO NOT OPEN OR REL'D *REJECTED* 00319073INVALID PART # *REJECTED* 003200 003210 003220 003230 003240 00325000 003260 003270/* 003280_ 00 00 00 00 00 00 __ 0( TTXRINIT P999999111111(000010H S RINIT 00020X DECK-ID M94 MFG/DIST/ACCT SYSTEM SUMMARY-123 RINIT 00030F* INITALIZE THE WORK OPERATION FILE (WRKOPR) TO 99999 RINIT 00040F* CYBER 18-10M/20 ROUTING VERSION 1.0RINIT 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA RINIT 00060F* CONTROL DATA PROPRIETARY PRODUCT RINIT 00070F* RINIT 0000080FNULL IPEAF 72 DISK RINIT 00090FWRKOPR UC F 90R DISK RINIT 00100INULL NS 02 RINIT 00110I 01 72 FIELD RINIT 00120IWRKOPR NS 03 RINIT 00130I 01 050UPD RINIT 00140C MOVE 99999 UPD 50 RINIT 0000150C MOVE 01 RRN 30 RINIT 00160C RRN CHAINWRKOPR 55 RINIT 00170C 55 GOTO END RINIT 00180C SETON 20 RINIT 00190C MOVE 99999 UPD RINIT 00200C END TAG RINIT 00210OWRKOPR D 20 RINIT 0000220O UPD 5 RINIT ** 000230ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000240ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000250ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000260ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000270/* 00028000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( 2 $TXMR700 Pv999999111111(000010H S MR700 00020X DECK-ID M34 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR700 00030F* FORECAST FILE MAINTENANCE MR700 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR700 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR700 00060F* CONTROL DATA PROPRIETARY PRODUCT MR700 00070F* MR700 0000080FNULL IPEAF 72 DISK MR700 00090FPRM700 IC F 32R DISK MR700 00100FFORCST UC F 0193R24AI 0001 DISK A MR700 00110E FN 025 22 FIELD NAME MR700 00120E CP 025 4 CURSOR POSITION MR700 00130E LN 025 2 0 LENGTH MR700 00140E EP 025 4 0 ENDING POSITION MR700 0000150INULL NS 01 MR700 00160I 1 1 A MR700 00170IPRM700 NS 02 MR700 00180I 1 22 FIELDN MR700 00190I 23 26 CURPOS MR700 00200I 27 280LNGTH MR700 00210I 29 310ENDPOS MR700 0000220IFORCST NS 03 MR700 00230I 10193 RECORD MR700 00240C MOVE ' ' RCODE 1 MR700 00250C MOVE RCODE B22 22 MR700 00260C MOVE RCODE BLANKS 72 MR700 00270C MOVE RCODE FILLER 1 MR700 00280C Z-ADD0 MASK 10 MR700 0000290C SETON LR MR700 00300CLR Z-ADD025 SSIZE 30 MR700 00310CLR Z-ADD002 NSECT 30 MR700 00320CLR BITON'01234567'FF 1 MR700 00330CLR MOVE '[]<>' TEMP4 4 MR700 00340CLR START TAG MR700 00350C* ********** MR700 0000360CLR EXSR FIRSTP MR700 00370C* ********** MR700 00380CLR EXSR CLRSCR MR700 00390C* ********** MR700 00400CLR 40 GOTO EOJ MR700 00410C* ********** MR700 00420CLR Z-ADD2 VL MR700 0000430CLR MOVELSECTON VAR MR700 00440CLR EXSR RTADJ MR700 00450C* ********** MR700 00460CLR MOVELVAR SECTN 20 MR700 00470CLR EXSR GETSEC MR700 00480C* ********** MR700 00490CLRN45 GOTO START MR700 0000500C* ********** MR700 00510CLR EXSR CLRSCR MR700 00520C* ********** MR700 00530CLR EXSR OUTPUT MR700 00540C* ********** MR700 00550CLR EXSR UPDATE MR700 00560C* ********** MR700 0000570CLR GOTO START MR700 00580C* ********** MR700 00590CLR EOJ TAG MR700 00600C* ********** MR700 00610C********************************************************************MR700 00620C* MR700 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND MR700 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. MR700 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDMR700 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN MR700 00670C* MR700 00680C********************************************************************MR700 00690CSR FIRSTP BEGSR MR700 00700C* ********** MR700 0000710CSR EXSR CLRSCR MR700 00720C* ********** MR700 00730CSR Z-ADD0 SECTN MR700 00740CSR EXSR GETSEC MR700 00750C* ********** MR700 00760CSR PGE TAG MR700 00770C* ********** MR700 0000780CSR SETON 61 MR700 00790CSR SETOF 62 MR700 00800CSR EXSR OUTPUT MR700 00810C* ********** MR700 00820C* ********** MR700 00830CSR EXIT SUBRFL MR700 00840CSR RLABL RECORD MR700 0000850CSR RLABL FILLER 1 MR700 00860C* ********** MR700 00870C* ********** MR700 00880C* ********** MR700 00890C* ********** MR700 00900C* ********** MR700 00910C* ********** MR700 0000920C* ********** MR700 00930C* ********** MR700 00940C* ********** MR700 00950C* ********** MR700 00960C* ********** MR700 00970C* ********** MR700 00980C* ********** MR700 0000990C* ********** MR700 01000C* ********** MR700 01010CSR Z-ADD24 NCHARS MR700 01020CSR Z-ADD1 SSTRT MR700 01030CSR Z-ADD1 TSTRT MR700 01040C* ********** MR700 01050CSR EXIT SUBRLM MR700 0001060CSR RLABL KEY 24 MR700 01070CSR RLABL SSTRT 30 MR700 01080CSR RLABL RECORD MR700 01090CSR RLABL TSTRT 30 MR700 01100CSR RLABL NCHARS 30 MR700 01110CSR Z-ADDNOFLDS SVFLDS 30 MR700 01120CSR Z-ADDSX NOFLDS MR700 0001130CSR EXSR UPDATE MR700 01140C* ********** MR700 01150CSR Z-ADDSVFLDS NOFLDS MR700 01160CSR Z-ADD24 NCHARS MR700 01170CSR Z-ADD1 SSTRT MR700 01180CSR Z-ADD1 TSTRT MR700 01190C* ********** MR700 0001200CSR EXIT SUBRLM MR700 01210CSR RLABL RECORD MR700 01220CSR RLABL SSTRT 30 MR700 01230CSR RLABL KEY MR700 01240CSR RLABL TSTRT 30 MR700 01250CSR RLABL NCHARS 30 MR700 01260CSR KEY CHAINFORCST 55 MR700 0001270CSR MOVELSAVPOS BUFFER MR700 01280CSR MOVELOFC BUFFER MR700 01290CSR EXSR POSCUR MR700 01300C* ********** MR700 01310CSR MOVEL'] NEW R'WORD16 16 MR700 01320CSR MOVE 'ECORD 'WORD16 MR700 01330CSRN55 MOVELBLANKS WORD16 MR700 0001340CSRN55 MOVEL']' WORD16 MR700 01350CSR MOVELWORD16 BUFFER 72 MR700 01360CSR MOVE 'T' TYPE 1 MR700 01370CSR Z-ADD13 BLNGTH 20 MR700 01380CSR EXSR CRTCOM MR700 01390C* ********** MR700 01400CSR SETON 62 MR700 0001410CSR Z-ADDSX X 30 MR700 01420CSR EXSR ACCEPT MR700 01430C* ********** MR700 01440CSR MOVELBUFFER SECTON 2 MR700 01450CSR SECTON COMP 'E ' 40 MR700 01460CSR 40 GOTO ENDFP MR700 01470C* ********** MR700 0001480CSR SECTON COMP 'D ' 40 MR700 01490CSR 40N55 EXCPT MR700 01500CSR 40 GOTO PGE MR700 01510C* ********** MR700 01520CSR SECTON COMP ' 1' 30 30 MR700 01530CSR 30 SECTON COMP ' 9' 3030 MR700 01540CSR 30 GOTO GOOD MR700 0001550C* ********** MR700 01560CSR SECTON COMP '01' 30 30 MR700 01570CSR 30 SECTON COMP '09' 3030 MR700 01580CSR 30 GOTO GOOD MR700 01590C* ********** MR700 01600CSR SECTON COMP '1 ' 30 30 MR700 01610CSR 30 SECTON COMP '9 ' 3030 MR700 0001620CSR 30 GOTO GOOD MR700 01630C* ********** MR700 01640CSR MOVELSECTON TEMP1 1 MR700 01650CSR TEMP1 COMP '1' 30 30 MR700 01660CSR 30 TEMP1 COMP '9' 3030 MR700 01670CSRN30 GOTO PGE MR700 01680C* ********** MR700 0001690CSR MOVE SECTON TEMP1 MR700 01700CSR TEMP1 COMP '0' 30 30 MR700 01710CSR 30 TEMP1 COMP '9' 3030 MR700 01720CSRN30 GOTO PGE MR700 01730C* ********** MR700 01740CSR GOOD TAG MR700 01750C* ********** MR700 0001760CSR SETOF 6162 MR700 01770CSRN55 GOTO ENDFP MR700 01780C* ********** MR700 01790CSR SETON 80 MR700 01800CSR EXCPT MR700 01810CSR SETOF 80 MR700 01820CSR KEY CHAINFORCST 55 MR700 0001830CSR ENDFP ENDSR MR700 01840C* ********** MR700 01850C********************************************************************MR700 01860C* MR700 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. MR700 01880C* MR700 01890C********************************************************************MR700 0001900CSR GETSEC BEGSR MR700 01910C* ********** MR700 01920CSR 1 ADD SECTN N 20 MR700 01930CSR SETOF 404145 MR700 01940CSR N COMP 0 3030 MR700 01950CSRN30 N COMP NSECT 30 MR700 01960CSR 30 GOTO ENDGET MR700 0001970C* ********** MR700 01980CSR SECTN MULT SSIZE RRN 40 MR700 01990CSR Z-ADD1 X MR700 02000CSR SCLOOP TAG MR700 02010C* ********** MR700 02020CSR RRN ADD 1 RRN MR700 02030CSR RRN CHAINPRM700 50 MR700 0002040CSR 50 GOTO ENDGET MR700 02050C* ********** MR700 02060CSR FIELDN COMP B22 4141 MR700 02070CSRN41 GOTO ENDGET MR700 02080C* ********** MR700 02090CSR 41N45 SETON 45 MR700 02100CSR MOVE FIELDN FN,X MR700 0002110CSR MOVE CURPOS CP,X MR700 02120CSR MOVE LNGTH LN,X MR700 02130CSR Z-ADDENDPOS EP,X MR700 02140CSR 1 ADD X X MR700 02150CSR X COMP SSIZE 32 MR700 02160CSRN32 GOTO SCLOOP MR700 02170C* ********** MR700 0002180CSR ENDGET TAG MR700 02190C* ********** MR700 02200CSR Z-ADDX NOFLDS 30 MR700 02210CSR 45 GOTO FINGET MR700 02220C* ********** MR700 02230CSR EXSR CLRSCR MR700 02240C* ********** MR700 0002250CSR MOVEL'SECT # 'WORD9 9 MR700 02260CSR Z-ADD16 BLNGTH MR700 02270CSR MOVE SECTN WORD9 MR700 02280CSR MOVELWORD9 WORD16 MR700 02290CSRN30 MOVE ' ABSENT' WORD16 MR700 02300CSR 30 MOVE ' ILLEG.' WORD16 MR700 02310CSR MOVELWORD16 BUFFER MR700 0002320CSR MOVEL'T' TYPE MR700 02330CSR EXSR CRTCOM MR700 02340C* ********** MR700 02350CSR FINGET ENDSR MR700 02360C* ********** MR700 02370C********************************************************************MR700 02380C* MR700 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE MR700 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE MR700 02410C* SECTION INDEX IS SAVED. MR700 02420C* MR700 02430C********************************************************************MR700 02440CSR OUTPUT BEGSR MR700 02450C* ********** MR700 0002460CSR EXSR CLRSCR MR700 02470C* ********** MR700 02480CSR Z-ADD1 X MR700 02490CSR 61 SETON 63 MR700 02500CSR OTLOOP TAG MR700 02510C* ********** MR700 02520CSR 61 LN,X COMP 0 31 MR700 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXMR700 02540CSR EXSR OUTFLD MR700 02550C* ********** MR700 02560CSR X ADD 1 X MR700 02570CSR X COMP NOFLDS 31 MR700 02580CSR 31 GOTO OTLOOP MR700 02590C* ********** MR700 0002600CSR SETOF 63 MR700 02610CSR ENDSR MR700 02620C********************************************************************MR700 02630C* MR700 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND MR700 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 MR700 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS MR700 0002670C* THEN NO FIELD INFORMATION IS PRINTED MR700 02680C* MR700 02690C********************************************************************MR700 02700CSR OUTFLD BEGSR MR700 02710C* ********** MR700 02720CSR MOVE FN,X FL 20 MR700 02730CSR EP,X COMP 0 98 MR700 0002740CSR MOVELCP,X FC 20 MR700 02750CSR FC COMP FL 31 MR700 02760CSR 31 Z-ADDFC FL MR700 02770CSR FC SUB FL CC 20 MR700 02780CSR CC ADD 1 CC MR700 02790CSR MOVELCP,X BUFFER MR700 02800CSR MOVELCC BUFFER MR700 0002810CSR EXSR POSCUR MR700 02820C* ********** MR700 02830CSR MOVELBLANKS BUFFER MR700 02840CSR MOVELFN,X FIELDN MR700 02850CSR MOVE ' ' FIELDN MR700 02860CSR MOVELFIELDN BUFFER MR700 02870CSR Z-ADDLN,X LEN 20 MR700 0002880CSR LEN COMP 0 9730 MR700 02890CSR 97 Z-SUBLN,X LEN MR700 02900CSR 30 GOTO SKIPF MR700 02910C* ********** MR700 02920CSR FL ADD 2 BPOS 20 MR700 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS MR700 02940CSR Z-ADDBPOS TSTRT 30 MR700 0002950CSRN98 Z-ADD1 SSTRT 30 MR700 02960CSR 98 Z-ADD3 SSTRT MR700 02970CSR Z-ADD1 NCHARS 30 MR700 02980C* ********** MR700 02990CSR EXIT SUBRLM MR700 03000CSR RLABL TEMP4 MR700 03010CSR RLABL SSTRT 30 MR700 0003020CSR RLABL BUFFER MR700 03030CSR RLABL TSTRT 30 MR700 03040CSR RLABL NCHARS 30 MR700 03050CSR BPOS ADD 1 FPOS 20 MR700 03060CSR EXSR MVRECD MR700 03070C* ********** MR700 03080CSR SKIPF TAG MR700 0003090C* ********** MR700 03100CSR 30 Z-ADDFL BLNGTH MR700 03110CSRN30 FL ADD 3 BLNGTH MR700 03120CSRN30 BLNGTH ADD LEN BLNGTH MR700 03130CSR MOVE 'T' TYPE MR700 03140CSR EXSR CRTCOM MR700 03150C* ********** MR700 0003160CSR ENDSR MR700 03170C********************************************************************MR700 03180C* MR700 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN MR700 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST MR700 03210C* THE RIGHT BRACKET. MR700 03220C********************************************************************MR700 0003230CSR MVRECD BEGSR MR700 03240C* ********** MR700 03250CSR 63 GOTO RBRK MR700 03260C* ********** MR700 03270CSR 98 Z-SUBEP,X END 40 MR700 03280CSRN98 Z-ADDEP,X END MR700 03290CSR END SUB LEN STRT 40 81 81 MR700 0003300CSR STRT ADD 1 STRT MR700 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER MR700 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER MR700 03330CSR Z-ADDLEN NCHARS MR700 03340CSR Z-ADDSTRT SSTRT MR700 03350CSR Z-ADDFPOS TSTRT MR700 03360CSRN81 GOTO RBRK MR700 0003370C* ********** MR700 03380CSR EXIT SUBRLM MR700 03390CSR RLABL RECORD MR700 03400CSR RLABL SSTRT 30 MR700 03410CSR RLABL BUFFER MR700 03420CSR RLABL TSTRT 30 MR700 03430CSR RLABL NCHARS 30 MR700 0003440CSR RBRK TAG MR700 03450C* ********** MR700 03460CSR EXSR RTBRKT MR700 03470C* ********** MR700 03480CSR ENDSR MR700 03490C********************************************************************MR700 03500C* MR700 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS MR700 03520C* MR700 03530C********************************************************************MR700 03540CSR RTBRKT BEGSR MR700 03550C* ********** MR700 03560CSR LEN ADD FPOS FPOS MR700 03570CSR Z-ADDFPOS TSTRT MR700 0003580CSR Z-ADD1 NCHARS MR700 03590CSRN98 Z-ADD2 SSTRT MR700 03600CSR 98 Z-ADD4 SSTRT MR700 03610C* ********** MR700 03620CSR EXIT SUBRLM MR700 03630CSR RLABL TEMP4 MR700 03640CSR RLABL SSTRT 30 MR700 0003650CSR RLABL BUFFER MR700 03660CSR RLABL TSTRT 30 MR700 03670CSR RLABL NCHARS 30 MR700 03680CSR ENDSR MR700 03690C********************************************************************MR700 03700C* MR700 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. MR700 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO MR700 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF MR700 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST MR700 03750C* OF THE FIELDS ARE LEFT UNCHANGED MR700 03760C* MR700 03770C********************************************************************MR700 03780CSR UPDATE BEGSR MR700 0003790C* ********** MR700 03800CSR SETOF 32 MR700 03810CSR Z-ADD1 X MR700 03820CSR UPLOOP TAG MR700 03830C* ********** MR700 03840CSR EP,X COMP 0 98 MR700 03850CSR 98 SETON 30 MR700 0003860CSR 98 GOTO NOUPD MR700 03870C* ********** MR700 03880CSR Z-ADDLN,X LEN MR700 03890CSR LEN COMP 0 9730 MR700 03900CSR 97 Z-SUBLEN LEN MR700 03910CSR NOUPD TAG MR700 03920C* ********** MR700 0003930CSR 30N32 GOTO INCR MR700 03940C* ********** MR700 03950CSR 30 GOTO CHKRUB MR700 03960C* ********** MR700 03970CSR SETOF 3233 MR700 03980CSR EXSR ACCEPT MR700 03990C* ********** MR700 0004000CSR CHKRUB TAG MR700 04010C* ********** MR700 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTMR700 04030CSR 32 31 GOTO UPLOOP MR700 04040C* ********** MR700 04050CSR 32 GOTO ENDUPD MR700 04060C* ********** MR700 0004070CSR MOVELBUFFER ATSIGN 1 MR700 04080CSR ATSIGN COMP '@' 35 MR700 04090CSR 35 GOTO OUTREC MR700 04100C* ********** MR700 04110CSR 33 GOTO INCR WAS LINE FEED MR700 04120C* ********** MR700 04130CSR Z-ADDEP,X END MR700 0004140CSR END SUB LEN STRT 81 81 MR700 04150CSR STRT ADD 1 STRT MR700 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF MR700 04170C* BUFFER TO THE STRT OF RECORD MR700 04180CSR Z-ADD1 SSTRT MR700 04190CSR Z-ADDSTRT TSTRT MR700 04200CSR Z-ADDLEN NCHARS MR700 0004210CSRN81 GOTO AAA MR700 04220C* ********** MR700 04230CSR EXIT SUBRLM MR700 04240CSR RLABL BUFFER MR700 04250CSR RLABL SSTRT 30 MR700 04260CSR RLABL RECORD MR700 04270CSR RLABL TSTRT 30 MR700 0004280CSR RLABL NCHARS 30 MR700 04290CSR AAA TAG MR700 04300CSR MOVELBUFFER TEMP5 5 MR700 04310CSR MOVELSAVPOS BUFFER MR700 04320CSR EXSR POSCUR MR700 04330C* ********** MR700 04340CSR MOVELTEMP5 BUFFER MR700 0004350CSR Z-ADD1 FPOS MR700 04360CSR EXSR RTBRKT MR700 04370C* ********** MR700 04380CSR LEN ADD 1 BLNGTH MR700 04390CSR MOVE 'T' TYPE MR700 04400CSR EXSR CRTCOM MR700 04410C* ********** MR700 0004420CSR INCR TAG MR700 04430C* ********** MR700 04440CSR X ADD 1 X MR700 04450CSR X COMP NOFLDS 30 MR700 04460CSR 30 GOTO UPLOOP MR700 04470C* ********** MR700 04480CSR OUTREC TAG MR700 0004490C* ********** MR700 04500CSR SETON 80 MR700 04510CSRN61 EXCPT MR700 04520CSR SETOF 80 MR700 04530CSR ENDUPD TAG MR700 04540C* ********** MR700 04550CSR ENDSR MR700 0004560C********************************************************************MR700 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE MR700 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X MR700 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND MR700 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT MR700 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED MR700 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS MR700 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS MR700 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO MR700 04650C* TO BE OUTPUT TO THE SCREEN. MR700 04660C* MR700 04670C********************************************************************MR700 04680CSR ACCEPT BEGSR MR700 04690C* ********** MR700 0004700CSR X COMP 1 30 MR700 04710CSRN30 X COMP SSIZE 30 MR700 04720CSR 30 Z-ADD1 X MR700 04730CSR MOVELCP,X FC MR700 04740CSR FC ADD 3 FC MR700 04750CSR MOVELCP,X SAVPOS 4 MR700 04760CSR MOVELFC SAVPOS MR700 0004770CSR Z-ADDLN,X LEN MR700 04780CSR LEN COMP 0 97 MR700 04790CSR 97 Z-SUBLEN LEN MR700 04800CSR LEN ADD FC OFC 20 MR700 04810CSR ACLOOP TAG MR700 04820C* ********** MR700 04830CSR MOVELSAVPOS BUFFER MR700 0004840CSR EXSR POSCUR MR700 04850C* ********** MR700 04860CSR Z-ADDLEN BLNGTH MR700 04870CSR MOVE BLANKS BUFFER MR700 04880CSR MOVE 'A' TYPE MR700 04890CSR EXSR CRTCOM MR700 04900C* ********** MR700 0004910CSR RCODE COMP 'R' 31 MR700 04920CSR 31 BUFFER COMP BLANKS 32 MR700 04930CSR 31 32N62 GOTO DUPIT MR700 04940C* ********** MR700 04950CSR 31 GOTO ACLOOP MR700 04960C* ********** MR700 04970CSR RCODE COMP 'L' 33 MR700 0004980CSR 33 GOTO DUPIT MR700 04990C* ********** MR700 05000CSRN97 GOTO ENDACC MR700 05010C* ********** MR700 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK MR700 05030CSR SIGN COMP '@' 30 MR700 05040CSR 30 GOTO ENDACC MR700 0005050C* ********** MR700 05060CSR Z-ADDLEN VL 20 MR700 05070CSR MOVELBUFFER VAR 15 MR700 05080CSR EXSR RTADJ MR700 05090C* ********** MR700 05100CSR MOVELVAR BUFFER MR700 05110CSR GOTO ENDACC MR700 0005120C* ********** MR700 05130CSR DUPIT TAG MR700 05140C* ********** MR700 05150CSR MOVELSAVPOS BUFFER MR700 05160CSR EXSR POSCUR MR700 05170C* ********** MR700 05180CSR 62 MOVELSECTON BUFFER MR700 0005190CSRN62 Z-ADD1 FPOS MR700 05200CSRN62 EXSR MVRECD MR700 05210C* ********** MR700 05220CSR MOVE 'T' TYPE MR700 05230CSR BLNGTH ADD 1 BLNGTH MR700 05240CSR EXSR CRTCOM MR700 05250C* ********** MR700 0005260CSR ENDACC ENDSR MR700 05270C* ********** MR700 05280C********************************************************************MR700 05290C* MR700 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES MR700 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM MR700 05320C* 4 DUMMY FOR RTADJ MR700 0005330C* MR700 05340C********************************************************************MR700 05350CSR POSCUR BEGSR MR700 05360C* ********** MR700 05370CSR MOVE 'P' TYPE MR700 05380CSR EXSR CRTCOM MR700 05390C* ********** MR700 0005400CSR ENDSR MR700 05410C********************************************************************MR700 05420CSR CLRSCR BEGSR MR700 05430C* ********** MR700 05440CSR MOVE 'C' TYPE MR700 05450CSR EXSR CRTCOM MR700 05460C* ********** MR700 0005470CSR ENDSR MR700 05480C********************************************************************MR700 05490CSR CRTCOM BEGSR MR700 05500C* ********** MR700 05510C* ********** MR700 05520CSR EXITFSUBRCM MR700 05530CSR RLABL BUFFER 72 MR700 0005540CSR RLABL TYPE 1 MR700 05550CSR RLABL BLNGTH 20 MR700 05560CSR RLABL RCODE 1 MR700 05570CSR RLABL MASK 10 MR700 05580CSR RLABL DTYPE 10 MR700 05590CSR ENDSR MR700 05600C********************************************************************MR700 0005610CSR RTADJ BEGSR MR700 05620C* ********** MR700 05630C* ********** MR700 05640CSR EXIT SUBRAJ MR700 05650CSR RLABL VL MR700 05660CSR RLABL VAR MR700 05670CSR ENDSR MR700 0005680C********************************************************************MR700 05690OFORCST E 80N55 MR700 05700O RECORD 0193 MR700 05710O E 40N80 MR700 05720O FF 1 MR700 05730O EADD 80 55 MR700 05740O RECORD 0193 MR700 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(d W *TXMR710 P999999111111(000010H S MR710 00020X DECK-ID M35 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR710 00030F* FORECAST FILE SHIFT MR710 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR710 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR710 00060F* CONTROL DATA PROPRIETARY PRODUCT MR710 00070F* MR710 0000080FFORCST UPEAF 193 24AI 1 DISK MR710 00090F* MR710 00100F* THIS PROGRAM SHIFTS EVERY ELEMENT IN THE FORECAST ARRAY, TO THE MR710 00110F* LEFT ONE ELEMENT. FAR,24 IS ZEROED. MR710 00120F* MR710 00130E FAR 24 7 0 MR710 00140IFORCST NS 01 MR710 0000150I 1 25 FLD MR710 00160I 26 193 FAR MR710 00170C Z-ADD1 X 30 MR710 00180C LOOP TAG MR710 00190C X ADD 1 Y 30 MR710 00200C Z-ADDFAR,Y FAR,X MR710 00210C X ADD 1 X MR710 0000220C X COMP 24 20 MR710 00230C 20 GOTO LOOP MR710 00240C Z-ADD0 FAR,24 MR710 00250OFORCST D 01 MR710 00260O FAR 193 MR710 ** 000270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00028000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000290ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000300ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000310/* 000320__0O FAR 193 MR710 ** 000270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0002800(0 iTXMR750 P999999111111(000010H S MR750 00020X DECK-ID M37 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR750 00030F* EXPLODE ACTUAL ACTIVITY INTO TOP UNITS REQUIRED MR750 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR750 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR750 00060F* CONTROL DATA PROPRIETARY PRODUCT MR750 00070F* MR750 0000080FDUMMY IPEAF 72 DISK MR750 00090FWRKORD ISEAF 160 5AI 1 DISK U2 MR750 00100FPROCORD ISEAF 105 DISK U1 MR750 00110FPURCH ISEAF 66 27AI 1 DISK U3 MR750 00120FBOMMST USEAF 47 20AI 28 DISK MR750 00130FPARTMST IC F 300R20AI 271 DISK MR750 00140FORDERS O F 66 DISK MR750 0000150FTEMRRN UC F 62R DISK MR750 00160IDUMMY NS 03 MR750 00170I 1 1 A MR750 00180IWRKORD NS 01 30 CO MR750 00190I OR 02 30 CR MR750 00200I 1 50WONUM MR750 00210I 30 30 STAT MR750 0000220I 6 25 PN MR750 00230I 31 370WOQTY MR750 00240I 38 440WOCOMP MR750 00250I 45 500TDATE MR750 00260I 51 560WDUEDT MR750 00270I 57 57 RGCOD MR750 00280I NS 03 MR750 0000290I 1 1 A MR750 00300IPROCORD NS 08 8 CH MR750 00310I 1 70SONUM MR750 00320I 9 130CUSTNO MR750 00330I 14 190TDATE MR750 00340I 50 550SDUEDT MR750 00350I NS 05 8 CL 11 CL MR750 0000360I 1 70SONUM MR750 00370I 65 84 PN MR750 00380I 24 300SOQTY MR750 00390I 31 370SOCOMP MR750 00400I* RGCOD MR750 00410I NS 03 MR750 00420I 1 1 A MR750 0000430IPURCH NS 06 MR750 00440I 1 70PONUM MR750 00450I 8 27 PN MR750 00460I 28 330REQDTE MR750 00470I 28 290RYY MR750 00480I 30 330RMMDD MR750 00490I 34 380VENDOR MR750 0000500I 39 440TDATE MR750 00510I 45 510QTYDUE MR750 00520I 52 580QTYIN MR750 00530IBOMMST NS 07 MR750 00540I 28 47 PART MR750 00550I 13 17 FLD MR750 00560IPARTMST NS 09 MR750 0000570I 44 460LEADTM MR750 00580I 146 1520SOH MR750 00590I 153 1590SOO MR750 00600I 181 1870MIN MR750 00610I 188 1940LOTSIZ MR750 00620I 195 195 MMCODE MR750 00630ITEMRRN NS 04 MR750 0000640I 1 1 A MR750 00650C 07 RRN ADD 1 RRN 50 MR750 00660C 07 EXSR GETAVL MR750 00670C 03 MR750 00680COR 08 MR750 00690COR 07 GOTO DEND MR750 00700C 01 RGCOD COMP 'X' 10 MR750 0000710C* 05 RGCOD COMP 'X' 10 MR750 00720C 01 MR750 00730COR 02 SETOF 93 MR750 00740C 01 MR750 00750COR 02 WOQTY SUB WOCOMP DIFF 70 25 MR750 00760C 01 25 MR750 00770COR 02 25 STAT COMP 'C' 93 MR750 0000780C 01 93 MR750 00790COR 02 93 SETOF 25 MR750 00800C 05 SOQTY SUB SOCOMP DIFF 26 MR750 00810C 06 QTYDUE SUB QTYIN DIFF 27 MR750 00820C DEND TAG MR750 00830C* MR750 00840C* MR750 0000850C* MR750 00860CSR GETAVL BEGSR MR750 00870CSR PART CHAINPARTMST 51 MR750 00880CSR 51 Z-ADD0 AVAIL 70 MR750 00890CSR 51 Z-ADD0 LEADTM MR750 00900CSR 51 Z-ADD0 MIN MR750 00910CSR 51 Z-ADD0 LOTSIZ MR750 0000920CSR 51 MOVE ' ' MMCODE MR750 00930CSRN51 SOH ADD SOO AVAIL 16 MR750 00940CSR 16 Z-ADD0 AVAIL IF AVAIL < 0 MR750 00950CSR RRN CHAINTEMRRN 33 MR750 00960CSR ENDSR MR750 00970O* MR750 00980O* FOR OJ, PUT TDATE WHICH IS START DATE IN DUE DATE FIELD, AND MR750 0000990O* PUT DUE DATE IN TDATE. THEY WILL BE REVERSED IN NEXT PROGRAM MR750 01000O* MR750 01010OORDERS D 01 MR750 01020O OR 02 25 MR750 01030O 01 2 'OJ' MR750 01040O 02 2 'RJ' MR750 01050O WONUM 7 MR750 0001060O PN 66 MR750 01070O DIFF 28 MR750 01080O 01 TDATE 34 MR750 01090O 02 WDUEDT 34 MR750 01100O 01 WDUEDT 40 MR750 01110O 02 TDATE 40 MR750 01120O 01 10 46 'X' MR750 0001130O 02 46 'X' MR750 01140O D 05 26 MR750 01150O 2 'SO' MR750 01160O SONUM 9 MR750 01170O PN 66 MR750 01180O DIFF 28 MR750 01190O SDUEDT 34 MR750 0001200O TDATE 40 MR750 01210O CUSTNO 45 MR750 01220O* 10 46 'X' MR750 01230O D 06 27 MR750 01240O 2 'PO' MR750 01250O PONUM 9 MR750 01260O PN 66 MR750 0001270O DIFF 28 MR750 01280O RMMDD 32 MR750 01290O RYY 34 MR750 01300O TDATE 40 MR750 01310O VENDOR 45 MR750 01320O 46 'X' MR750 01330OBOMMST D 07 MR750 0001340O RRN 27 MR750 01350OTEMRRN D 07N33 MR750 01360O FLD 17 MR750 01370O AVAIL 24 MR750 01380O LEADTM 27 MR750 01390O MMCODE 28 MR750 01400O MIN 35 MR750 0001410O LOTSIZ 42 MR750 01415O PART 62 ** 001420ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00146000/* 001470_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(1 TXOE130 P999999032778(000010H S 1 OE130 00020X DECK-ID A61 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE130 00030F* PRINT SHIPPERS AND CREATE TODAYS FILE OE130 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE130 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE130 00060F* CONTROL DATA PROPRIETARY PRODUCT OE130 00070F* OE130 0000080FOPNORDS UPEAF 119 8AI 106 DISK OE130 00090FARMAST IC F 280R 6AI 1 DISK OE130 00100FPARTMST IC F 300R20AI 271 DISK OE130 00110FHEADING IT F 40 EDISK OE130 00120F$LP1 O F 80 OF LPRINTER OE130 00130FTODAYS O F 119 DISK OE130 00140F********************************************************************OE130 0000150F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [ORD040] OE130 00160F* OE130 00170F* PACKAGE DISTRIBUTION OE130 00180F* SYSTEM SALES ORDER PROCESSING OE130 00190F* PROGRAM PRINT SHIPPERS OE130 00200F* OE130 00210F* CONTRACTOR COMPUSOURCE OE130 0000220F* PROGRAMMER KATH HILL OE130 00230F* DATE FEBRUARY 22, 1976 OE130 00240F* OE130 00250F********************************************************************OE130 00260F* OE130 00270F* ************************************************************** OE130 00280F* ** ** OE130 0000290F* ** FUNCTION OF INDICATORS ** OE130 00300F* ** ** OE130 00310F* ** 01 BKORDS- HEADER ** OE130 00320F* ** 02 BKORDS- SHIP-TO N/A ** OE130 00330F* ** 03 BKORDS- 'MARK FOR' OR INVOICE COMMENTS ** OE130 00340F* ** 05 BKORDS- LINE-ITEMS ** OE130 00350F* ** 06 BKORDS- LINE-ITEM COMMENTS ** OE130 0000360F* ** 07 BKORDS- UNDEFINED RECORD TYPE ** OE130 00370F* ** 09 ARMAST ** OE130 00380F* ** 10 PARTMST ** OE130 00390F* ** 11 ORDINP- HEADER ** OE130 00400F* ** 12 ORDINP- SHIP-TO N/A ** OE130 00410F* ** 13 BKORDS- 'MARK FOR' OR INVOICE COMMENTS ** OE130 00420F* ** 15 ORDINP- LINE-ITEMS ** OE130 0000430F* ** 16 ORDINP- LINE-ITEM COMMENTS ** OE130 00440F* ** 17 ORDINP- UNDEFINED RECORD TYPE ** OE130 00450F* ** ** OE130 00460F* ** 22 NO OVERRIDE PRICE CODE ** OE130 00470F* ** 23 NO OVERRIDE SALESMAN# ** OE130 00480F* ** 24 NO OVERRIDE AREA ** OE130 00490F* ** 25 SHIP-TO ZIP CODE = ZERO - DON'T PRINT ** OE130 0000500F* ** ** OE130 00510F* ** 28 LINE-ITEM COMMENT LINE IS BLANK - DON'T PRINT ** OE130 00520F* ** ** OE130 00530F* ** 30 AN INVOICE OR 'MARK FOR' COMMENT LINE IS BLANK ** OE130 00540F* ** 34 COMPRESSED COMMENT #4 IS BLANK-ALLOW FOR SPACE ** OE130 00550F* ** 35 SUBR SUB3 LOOP IS DONE ** OE130 00560F* ** ** OE130 0000570F* ** 50 MULTIPLE PAGES- GO TO NEXT PAGE ** OE130 00580F* ** ** OE130 00590F* ** 60 LINE ITEM OR LINE ITEM COMMENT - ASSIGN LINE# ** OE130 00600F* ** ** OE130 00610F* ** 70 NEW ORDER- NO SHIPPER HAS BEEN PRINTED OE130 00620F* ** 71 BKORD PRINT H,I,K,LM RCDS OE130 00630F* ** 72 BKORD-RCD LL-PRINT ON SHIPPER OE130 0000640F* 85 1ST RECORD INDICATOR OE130 00650F* 88 SALES ORDER WITHIN LIMITS OE130 00660F* ** 90 ARMAST RECORD FLAGGED FOR DELETION ** OE130 00670F* ** 91 PARTMST RECORD FLAGGED FOR DELETION ** OE130 00680F* ** ** OE130 00690F* ** H1 NO HEADER FOR THIS S.O. ** OE130 00700F* ** H2 DUPLICATE HEADERS FOR THIS S.O. ** OE130 0000710F* ** H4 INVALID SOLD-TO CUST# ** OE130 00720F* ** H6 INVALID PART # ** OE130 00730F* ** ** OE130 00740F* ** RETRY SHOULD BE HIT EVERY TIME THAT H6 ** OE130 00750F* ** OCCURS. AFTER JOB, THE LINES WITH INVALID ** OE130 00760F* ** PART #'S SHOULD BE FIXED BEFORE CONTINUE TO ** OE130 00770F* ** DIS140. ** OE130 0000780F* ** ** OE130 00790F* ************************************************************** OE130 00800F* OE130 00810E ARY1 1 2 30 OE130 00820E COM 4 23 K COMMENTS INPUT OE130 00830E COUT 4 23 COMPRESSED K COM OE130 00840E HEADING HEAD 1 1 40 COMPANY NAME OE130 0000850L$LP1 66FL 60OL OE130 00860IOPNORDS XX 01 8 CH OE130 00870I 3 70HALF1 OE130 00880I 3 70SONUM L1 OE130 00890I 9 130CUST OE130 00900I 14 190RDATE OE130 00910I 20 31 PONUM OE130 0000920I 32 41 CARIER OE130 00930I 43 430OVPC 22 OE130 00940I 44 460OVSMAN 23 OE130 00950I 47 48 OVAREA 24 OE130 00960I 50 550PDATE OE130 00970I 1 119 ALL OE130 00980I 105 105 STATUS 70 OE130 0000990I XX 02 8 CI OE130 01000I 3 70SONUM L1 OE130 01010I 9 130SHIPTO OE130 01020I 14 37 SHIP1 OE130 01030I 38 61 SHIP2 OE130 01040I 62 85 SHIP3 OE130 01050I 86 98 SHIPCY OE130 0001060I 99 100 SHIPST OE130 01070I 101 1050SHIPZP 25 OE130 01080I 1 119 ALL OE130 01090I XX 03 8 CK OE130 01100I 3 70SONUM L1 OE130 01110I 9 100 COM OE130 01120I 1 119 ALL OE130 0001130I XX 05 8 CL 11 CL OE130 01140I 3 70SONUM L1 OE130 01150I 65 84 PART OE130 01160I 24 300QTYORD OE130 01170I 1 119 ALL OE130 01180I XX 06 8 CL 11 CM OE130 01190I 3 70SONUM L1 OE130 0001200I 12 49 LICMNT 28 OE130 01210I 1 119 ALL OE130 01220I XX 07 OE130 01230I 1 1 DUMMY OE130 01240IARMAST XX 09 OE130 01250I 7 30 NAME OE130 01260I 31 54 LINE1 OE130 0001270I 55 78 LINE2 OE130 01280I 79 91 CITY OE130 01290I 92 93 STATE OE130 01300I 94 980ZIP OE130 01310I 115 115 DLTAR 90 OE130 01320I 154 1560SLSMN OE130 01330I 157 158 AREA OE130 0001340I 161 1610PC OE130 01350I 162 163 TYP OE130 01360IPARTMST XX 10 OE130 01370I 1 37 PDESC OE130 01380I 74 74 DLTPA 91 OE130 01390C MOVE ' ' B80 80 OE130 01400C N85 EXSR ALMTS ACCEPT LIMITS OE130 0001410C SETON 85 OE130 01420C SETOF 60 OE130 01430C L1 SETOF 7172 OE130 01440C L1N01 SETON H1 NO HEADER OE130 01450C H1 GOTO END OE130 01460C NL1 01 SETON H2 DUP HEADERS OE130 01470C H2 GOTO END OE130 0001480C N70 EXSR PRINT OE130 01490C L1 SETOF 50 OE130 01500C L1 Z-ADD0 COUNT 40 OE130 01510C 01 HALF1 COMP SLOW 87 88 OE130 01520C 01 87 HALF1 COMP SHIGH 8888 OE130 01530C N88 GOTO END OE130 01540C N70N72 GOTO END OE130 0001550C 01 EXSR SUB1 OE130 01560C 03 EXSR SUB3 OE130 01570C 05 EXSR SUB5 OE130 01580C 06N28 EXSR SUB6 OE130 01590C END TAG OE130 01591C H6 SETOF H6 01600CLR MOVE ' ' BLANKS 23 OE130 0001610C** OE130 01620C** OE130 01630CSR PRINT BEGSR OE130 01640CSR 01 STATUS COMP 'B' 72 OE130 01650CSR 01 OE130 01660COR 02 OE130 01670COR 03 OE130 0001680COR 06 OE130 01690CORN72 GOTO ENDPRT OE130 01700CSR QTYORD COMP 0 71 OE130 01710CSR ENDPRT ENDSR OE130 01720CSR SUB1 BEGSR OE130 01730CSR Z-ADDCUST CUST6 60 OE130 01740CSR CUST6 CHAINARMAST H4 OE130 0001750CSRNH4N90 SETON H4 OE130 01760CSR H4 GOTO END1 OE130 01770CSR EXSR SAVEHD OE130 01780CSR END1 ENDSR OE130 01790CSR SUB3 BEGSR OE130 01800CSR MOVE BLANKS COUT OE130 01810CSR Z-ADD0 X 10 OE130 0001820CSR Z-ADD0 Y 10 OE130 01830CSR LOOP TAG OE130 01840CSR X COMP 4 35 OE130 01850CSR 35 GOTO DONE OE130 01860CSR X ADD 1 X OE130 01870CSR COM,X COMP BLANKS 30 OE130 01880CSR 30 GOTO LOOP OE130 0001890CSRN30 Y ADD 1 Y OE130 01900CSR MOVE COM,X COUT,Y OE130 01910CSR GOTO LOOP OE130 01920CSR DONE TAG OE130 01930CSR COUT,4 COMP BLANKS 34 OE130 01940CSR ENDSR OE130 01950C** OE130 0001960C** OE130 01970CSR SUB5 BEGSR OE130 01980CSR SETON 60 OE130 01990CSR PART CHAINPARTMST H6 OE130 02000CSRNH6N91 SETON H6 OE130 02010CSR COUNT COMP 25 50 50 OE130 02020CSR 50 Z-ADD0 COUNT OE130 0002030CSR COUNT ADD 2 COUNT OE130 02040CSR END5 ENDSR OE130 02050C** OE130 02060C** OE130 02070CSR SUB6 BEGSR OE130 02080CSR SETON 60 OE130 02090CSR COUNT COMP 26 50 50 OE130 0002100CSR 50 Z-ADD0 COUNT OE130 02110CSR COUNT ADD 1 COUNT OE130 02120CSR ENDSR OE130 02130C** OE130 02140C** OE130 02150CSR SAVEHD BEGSR OE130 02160CSR MOVE NAME SNAME 24 OE130 0002170CSR MOVE LINE1 SLINE1 24 OE130 02180CSR MOVE LINE2 SLINE2 24 OE130 02190CSR MOVE CITY SCITY 13 OE130 02200CSR MOVE STATE SSTATE 2 OE130 02210CSR MOVE ZIP SZIP 50 OE130 02220CSR 22 MOVE PC SPC 10 OE130 02230CSRN22 MOVE OVPC SPC OE130 0002240CSR 23 MOVE SLSMN SSLSMN 30 OE130 02250CSRN23 MOVE OVSMAN SSLSMN OE130 02260CSR 24 MOVE AREA SAREA 2 OE130 02270CSRN24 MOVE OVAREA SAREA OE130 02280CSR MOVE TYP STYPE 2 OE130 02290CSR ENDSR OE130 02300C** OE130 0002310C** OE130 02320CSR ALMTS BEGSR OE130 02330CSR MOVE ' ' BUFFER 80 OE130 02340CSR MOVE 'C' TYPE 1 OE130 02350CSR Z-ADD0 BLNGTH 20 OE130 02360CSR MOVE ' ' RCODE 1 OE130 02370CSR Z-ADD0 MASK 10 OE130 0002380CSR Z-ADD0 DTYPE 10 OE130 02390CSR EXSR CRTCOM OE130 02400CSR MOVELARY1,1 BUFFER OE130 02410CSR MOVE 'S' TYPE OE130 02420CSR Z-ADD30 BLNGTH OE130 02430CSR EXSR CRTCOM OE130 02440CSR MOVE B80 BUFFER OE130 0002450CSR MOVE 'A' TYPE OE130 02460CSR Z-ADD5 BLNGTH OE130 02470CSR Z-ADD1 DTYPE OE130 02480CSR EXSR CRTCOM OE130 02490CSR RCODE COMP 'R' 86 OE130 02500CSR MOVELBUFFER VAR OE130 02510CSR Z-ADD5 VL OE130 0002520CSR EXIT SUBRAJ OE130 02530CSR RLABL VL 20 OE130 02540CSR RLABL VAR 15 OE130 02550CSR MOVELVAR SLOW 50 OE130 02560CSR MOVE B80 BUFFER OE130 02570CSR Z-ADD1 BLNGTH OE130 02580CSR MOVE 'T' TYPE OE130 0002590CSR EXSR CRTCOM OE130 02600CSR MOVELARY1,2 BUFFER OE130 02610CSR MOVE 'S' TYPE OE130 02620CSR Z-ADD30 BLNGTH OE130 02630CSR EXSR CRTCOM OE130 02640CSR MOVE B80 BUFFER OE130 02650CSR MOVE 'A' TYPE OE130 0002660CSR Z-ADD5 BLNGTH OE130 02670CSR Z-ADD1 DTYPE OE130 02680CSR EXSR CRTCOM OE130 02690CSR RCODE COMP 'R' 87 0OE130 02700CSR MOVELBUFFER VAR OE130 02710CSR Z-ADD5 VL OE130 02720CSR EXIT SUBRAJ OE130 0002730CSR RLABL VL OE130 02740CSR RLABL VAR OE130 02750CSR MOVELVAR SHIGH 50 OE130 02760CSR MOVE 'C' TYPE OE130 02770CSR EXSR CRTCOM OE130 02780CSR 86 OE130 02790COR 87 GOTO ALMTS OE130 0002800CSR ENDSR OE130 02810CSR CRTCOM BEGSR OE130 02820CSR EXITFSUBRCM OE130 02830CSR RLABL BUFFER OE130 02840CSR RLABL TYPE OE130 02850CSR RLABL BLNGTH OE130 02860CSR RLABL RCODE OE130 0002870CSR RLABL MASK OE130 02880CSR RLABL DTYPE OE130 02890CSR ENDSR OE130 02900OOPNORDS D 01 70 88 OE130 02910O 105 'P' OE130 02920O$LP1 H 18 1P OE130 02930O 23 'X XXXXX X XXX XX XX' OE130 0002940O 36 'XXXXXXXXXX' OE130 02950O 51 'XXXXXXXXXXXX' OE130 02960O 70 'XXXXXXXXXXXXXXXXXX' OE130 02970O 80 'XXXXXXXXXX' OE130 02980O D 201 50 OE130 02990O 58 '* CONTINUED - PAGE' OE130 03000O PAGE Z 64 OE130 0003010O 66 '*' OE130 03020O D 103 01 70 88 OE130 03030O OR 01 72 88 OE130 03040O OR 50 OE130 03050O SNAME 32 OE130 03060O D 1 01 70 88 OE130 03070O OR 01 72 88 OE130 0003080O OR 50 OE130 03090O SLINE1 32 OE130 03100O D 1 01 70 88 OE130 03110O OR 01 72 88 OE130 03120O OR 50 OE130 03130O SLINE2 32 OE130 03140O D 1 01 70 88 OE130 0003150O OR 01 72 88 OE130 03160O OR 50 OE130 03170O SCITY 21 OE130 03180O SSTATE 25 OE130 03190O SZIP 32 OE130 03200O D 1 01 70 88 OE130 03210O OR 01 72 88 OE130 0003220O OR 50 OE130 03230O PDATE Y 47 OE130 03240O SONUM 57 OE130 03250O RDATE Y 67 OE130 03260O D 1 02 70 88 OE130 03270O OR 02 72 88 OE130 03280O OR 50 OE130 0003290O SHIP1 32 OE130 03300O D 1 02 70 88 OE130 03310O OR 02 72 88 OE130 03320O OR 50 OE130 03330O SHIP2 32 OE130 03340O D 1 02 70 88 OE130 03350O OR 02 72 88 OE130 0003360O OR 50 OE130 03370O SHIP3 32 OE130 03380O D 1 02 70 88 OE130 03390O OR 02 72 88 OE130 03400O OR 50 OE130 03410O SHIPCY 21 OE130 03420O SHIPST 25 OE130 0003430O N25 SHIPZP 32 OE130 03440O D 1 03 70 88 OE130 03450O OR 03 72 88 OE130 03460O OR 50 OE130 03470O COUT,1 31 OE130 03480O D 1 03 70 88 OE130 03490O OR 03 72 88 OE130 0003500O OR 50 OE130 03510O COUT,2 31 OE130 03520O D 1 03 70 88 OE130 03530O OR 03 72 88 OE130 03540O OR 50 OE130 03550O COUT,3 31 OE130 03560O D 1 03 70 88 OE130 0003570O OR 03 72 88 OE130 03580O OR 50 OE130 03590O COUT,4 31 OE130 03600O D 1 03 70 88 OE130 03610O OR 03 72 88 OE130 03620O OR 50 OE130 03630O CUST 7 OE130 0003640O SPC 10 OE130 03650O SSLSMN 15 OE130 03660O STYPE 19 OE130 03670O SAREA 23 OE130 03680O CARIER 36 OE130 03690O PONUM 51 OE130 03700O D 1 05 70 88 OE130 0003710O OR 05 71 88 OE130 03720O QTYORDL 8 OE130 03730O PART 29 OE130 03740O NH6 PDESC 67 OE130 03750O H6 61 '** INVALID PART # **' OE130 03760O D 01 06N28 70 OE130 03770O AND 88 OE130 0003780O OR 06N28 72 OE130 03790O AND 88 OE130 03800O LICMNT 64 OE130 03810OTODAYS D 01 70 88 OE130 03820O OR 01 72 88 OE130 03830O ALL 119 OE130 03840O D 02 70 88 OE130 0003850O OR 02 72 88 OE130 03860O ALL 119 OE130 03870O D 03 70 88 OE130 03880O OR 03 72 88 OE130 03890O ALL 119 OE130 03900O D 05 70 88 OE130 03910O OR 05 71 88 OE130 0003920O ALL 119 OE130 03930O D 06 70N28 OE130 03940O AND 88 OE130 03950O OR 06 72N28 OE130 03960O AND 88 OE130 03970O ALL 119 OE130 ** 00398000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003990ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004010ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004020** 004030ENTER BEGINNING S.O. NUMBER 004040ENTER ENDING S.O. NUMBER 00405000/* 004060_ 00 00 00 00 00 00 00 00 00 __ 0(0 TXMR752 P 6 h999999111111(000010H S MR752 00020X DECK-ID M38 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR752 00030F* EXPLODE FORECASTED ACTIVITY INTO TOP UNITS REQUIRED MR752 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR752 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR752 00060F* CONTROL DATA PROPRIETARY PRODUCT MR752 00070F* MR752 0000080FFORCST IPEAF 193 24AI 1 DISK MR752 00090FWRKORD ISEAF 160 5AI 1 DISK U2 MR752 00100FPURCH ISEAF 66 27AI 1 DISK U3 MR752 00110FBOMMST USEAF 47 20AI 28 DISK MR752 00120FPARTMST IC F 300R20AI 271 DISK MR752 00130FORDERS O F 66 DISK MR752 00140FTEMRRN UC F 62R DISK MR752 0000150F* MR752 00160F* ************************************************************** MR752 00170F* ** ** MR752 00180F* ** COMPUSOURCE CORPORATION ** MR752 00190F* ** ** MR752 00200F* ** MATERIAL REQUIREMENTS PLANNING ADM ** MR752 00210F* ** ** MR752 0000220F* ** ROBBIE FREEMAN 7/9/76 ** MR752 00230F* ** ** MR752 00240F* ************************************************************** MR752 00250F* ** ** MR752 00260F* ** FUNCTION OF INDICATORS ** MR752 00270F* ** ** MR752 00280F* ** 01 FORCST ** MR752 0000290F* ** 02 WRKORD- OPEN JOB ** MR752 00300F* ** 03 WRKORD- RELEASED JOB ** MR752 00310F* ** 04 WRKORD- OTHERS ** MR752 00320F* ** 05 PURCH ** MR752 00330F* ** 07 BOMMST ** MR752 00340F* ** 08 PARTMST ** MR752 00350F* ** 09 TEMRRN ** MR752 0000360F* ** 10 REQTS GEN CODE FOR OJ = X ** MR752 00370F* ** 16 AVAIL (SOH+SOO) < 0 -- LET = 0 ** MR752 00380F* ** 20 POSITIVE FORECAST QTY - OUTPUT TO 'ORDERS' ** MR752 00390F* ** 21 'FC' & 'DLOOP' CONTROL ** MR752 00400F* ** 25 QTY REMAINING ON OJ IS POS. - OUTPUT ** MR752 00410F* ** 26 QTY REMAINING ON PO IS POS. - OUTPUT ** MR752 00420F* ** 33 NO HIT ON TEMRRN - END OF FILE ** MR752 0000430F* ** 51 NO HIT ON PARTMST ** MR752 00440F* ** 90 DATE OVERFLOW OCCURRED AFTER INCREMENT - FIX ** MR752 00450F* ** 95 BAD DATE ENTERED BY OPERATOR - RETRY ** MR752 00460F* ** 99 1ST CYCLE DONE ** MR752 00470F* ** ** MR752 00480F* ** U1 OPER TO ENTER DATE OF LAST DAY OF 1ST TIME PER ** MR752 00490F* ** U2 INPUT WRKORD ** MR752 0000500F* ** U3 INPUT PURCH ** MR752 00510F* ** U4 TIME PERIOD INCREMENTS = MONTHS (AND, IF U1 IS ** MR752 00520F* ** OFF, USE LAST DAY OF UMONTH FOR 1ST PERIOD) ** MR752 00530F* ** ** MR752 00540F* ************************************************************** MR752 00550F* MR752 00560E FAR 24 7 0 FORECAST ARRAY MR752 0000570E DATE 24 6 0 FORECAST DATES MR752 00580IFORCST XX 01 MR752 00590I 1 20 PN MR752 00600I 26 193 FAR MR752 00610IWRKORD XX 02 30 CO MR752 00620I OR 03 30 CR MR752 00630I 1 50WONUM MR752 0000640I 6 25 PN MR752 00650I 30 30 STAT MR752 00660I 31 370QTYDUE MR752 00670I 38 440QTYIN MR752 00680I 45 500TDATE MR752 00690I 51 560DUEDAT MR752 00700I 57 57 RGCOD MR752 0000710I XX 04 MR752 00720I 1 1 A MR752 00730IPURCH XX 05 MR752 00740I 1 70PONUM MR752 00750I 8 27 PN MR752 00760I 28 290RYY MR752 00770I 30 330RMMDD MR752 0000780I 34 380VENDOR MR752 00790I 39 440TDATE MR752 00800I 45 510QTYDUE MR752 00810I 52 580QTYIN MR752 00820IBOMMST XX 07 MR752 00830I 28 47 PART MR752 00840I 13 17 FLD MR752 0000850IPARTMST XX 08 MR752 00860I 44 460LEADTM MR752 00870I 146 1520SOH MR752 00880I 153 1590SOO MR752 00890I 181 1870MIN MR752 00900I 188 1940LOTSIZ MR752 00910I 195 195 MMCODE MR752 0000920ITEMRRN XX 09 MR752 00930I 1 1 A MR752 00940C 99 GOTO START 1ST CYCLE DONE MR752 00950C SETON 99 MR752 00960C***** MR752 00970C* IF U1 OFF, USE UDATE FOR DATE OF 1ST TIME PERIOD (IF U4 ON, MAKE MR752 00980C* IT THE LAST DAY OF UMONTH). IF U1 ON, GO GET BDATE ON CRT. MR752 0000990C***** MR752 01000C MOVE UDATE DATE,1 DATE,1=UDATE MR752 01010C MOVEL'30' N4 DATE,1=30TH DAYMR752 01020C MOVE UYEAR N4 OF UMONTH MR752 01030C U4 MOVE N4 DATE,1 MR752 01040C U1 EXSR GETDAT ACCEPT DATE,1 MR752 01050C***** MR752 0001060C* IF U4 OFF, TIME PERIOD INCREMENTS = WEEKS. IF ON, = MONTHS. MR752 01070C***** MR752 01080C Z-ADD700 INC 50 WEEKS MR752 01090C U4 Z-ADD10000 INC MONTHS MR752 01100C EXSR DATES LOAD DATE ARY MR752 01110C************************ MR752 01120C START TAG MR752 0001130C************************ MR752 01140C Z-ADD0 X MR752 01150C 01 GOTO FC MR752 01160C 02 MR752 01170COR 03 GOTO WO MR752 01180C 05 GOTO PO MR752 01190C 07 GOTO BOM MR752 0001200C GOTO END MR752 01210C************************ MR752 01220C FC TAG FORCST RECS MR752 01230C************************ MR752 01240C X ADD 1 X MR752 01250C FAR,X COMP 0 20 MR752 01260C 20 EXCPT MR752 0001270C X COMP 24 21 MR752 01280C 21 GOTO FC MR752 01290C GOTO END MR752 01300C************************ MR752 01310C WO TAG WRKORD RECS MR752 01320C************************ MR752 01330C 02 RGCOD COMP 'X' 10 MR752 0001340C 02 SETOF 93 MR752 01350C QTYDUE SUB QTYIN DIFF 70 25 MR752 01360C 02 STAT COMP 'C' 93 MR752 01370C 02 93 SETOF 25 MR752 01380C GOTO END MR752 01390C************************ MR752 01400C PO TAG PURCH RECS MR752 0001410C************************ MR752 01420C QTYDUE SUB QTYIN DIFF 26 MR752 01430C GOTO END MR752 01440C************************ MR752 01450C BOM TAG BOMMST RECS MR752 01460C************************ MR752 01470C RRN ADD 1 RRN 50 MR752 0001480C EXSR GETAVL MR752 01490C************************ MR752 01500C END TAG MR752 01510C********************************************************************MR752 01520C********************************************************************MR752 01530CSR GETDAT BEGSR MR752 01540C************************ MR752 0001550CSR BAD TAG MR752 01560C************************ MR752 01570CSR MOVEL'ENTER ' TEMP 12 MR752 01580CSR MOVE 'DATE- ' TEMP MR752 01590CSR MOVELTEMP BUFFER MR752 01600CSR MOVE 'S' TYPE MR752 01610CSR Z-ADD12 BLNGTH MR752 0001620CSR EXSR CRTCOM MR752 01630CSR MOVE 'A' TYPE MR752 01640CSR Z-ADD6 BLNGTH MR752 01650CSR EXSR CRTCOM MR752 01660CSR MOVELBUFFER DATE,1 MR752 01670CSR MOVEL' ' BUFFER MR752 01680CSR MOVE 'T' TYPE MR752 0001690CSR EXSR CRTCOM MR752 01700CSR MOVELDATE,1 MO 20 MM MR752 01710CSR MOVELDATE,1 N4 40 MMDD MR752 01720CSR MOVE N4 DAY 20 DD MR752 01730CSR MOVE DATE,1 YR 20 YY MR752 01740CSR MO COMP 1 95 MR752 01750CSRN95 MO COMP 12 95 MR752 0001760CSR 95 GOTO BAD MR752 01770CSR DAY COMP 1 95 MR752 01780CSRN95 DAY COMP 30 95 30 DAYS/MONTH MR752 01790CSR 95 GOTO BAD MR752 01800CSR YR COMP 76 95 MR752 01810CSR 95 GOTO BAD MR752 01820CSR ENDSR MR752 0001830C********************************************************************MR752 01840C********************************************************************MR752 01850CSR CRTCOM BEGSR MR752 01860CSR EXITFSUBRCM MR752 01870CSR RLABL BUFFER 72 MR752 01880CSR RLABL TYPE 1 MR752 01890CSR RLABL BLNGTH 20 MR752 0001900CSR RLABL RCODE 1 MR752 01910CSR RLABL MASK 10 MR752 01920CSR RLABL DTYPE 10 MR752 01930CSR ENDSR MR752 01940C********************************************************************MR752 01950C********************************************************************MR752 01960CSR DATES BEGSR LOAD DATES MR752 0001970C************************ MR752 01980CSR DLOOP TAG MR752 01990C************************ MR752 02000CSR X ADD 1 X 20 MR752 02010CSR X ADD 1 Y 20 MR752 02020CSR DATE,X ADD INC DATE,Y MR752 02030CSR EXSR FIXDAT MR752 0002040CSR Y COMP 24 21 MR752 02050CSR 21 GOTO DLOOP MR752 02060CSR ENDSR MR752 02070C********************************************************************MR752 02080C********************************************************************MR752 02090CSR FIXDAT BEGSR MR752 02100CSR MOVELDATE,Y MO MM MR752 0002110CSR MOVELDATE,Y N4 MMDD MR752 02120CSR MOVE N4 DAY DD MR752 02130CSR MOVE DATE,Y YR YY MR752 02140CSR DAY SUB 30 OVER 20 90 ASSUME 30/MO MR752 02150CSR 90 Z-ADDOVER DAY MR752 02160CSR 90 MO ADD 1 MO MR752 02170CSR MO SUB 12 OVER 20 90 MR752 0002180CSR 90 Z-ADDOVER MO MR752 02190CSR 90 YR ADD 1 YR MR752 02200CSR MOVE YR DATE,Y ----YY MR752 02210CSR MOVE DAY N4 --DD MR752 02220CSR MOVELN4 DATE,Y --DDYY MR752 02230CSR MOVELMO DATE,Y MMDDYY MR752 02240CSR ENDSR MR752 0002250C********************************************************************MR752 02260C********************************************************************MR752 02270CSR GETAVL BEGSR MR752 02280CSR PART CHAINPARTMST 51 MR752 02290CSR 51 Z-ADD0 AVAIL 70 MR752 02300CSR 51 Z-ADD0 LEADTM MR752 02310CSR 51 Z-ADD0 MIN MR752 0002320CSR 51 Z-ADD0 LOTSIZ MR752 02330CSR 51 MOVE ' ' MMCODE MR752 02340CSRN51 SOH ADD SOO AVAIL 16 MR752 02350CSR 16 Z-ADD0 AVAIL IF AVAIL < 0 MR752 02360CSR RRN CHAINTEMRRN 33 MR752 02370CSR ENDSR MR752 02380C********************************************************************MR752 0002390C********************************************************************MR752 02400O***** MR752 02410O* FOR OJ'S, PUT TDATE (=PLANNED RELEASE DATE) IN DUE DATE FIELD MR752 02420O* AND PUT DUE DATE IN TDATE. THEY WILL BE REVERSED BACK IN MR752 02430O* MFG755. THIS IS TO INSURE THAT THE 1ST LEVEL COMPS OF THE MR752 02440O* W.O. WILL BE DUE ON THE DATE PLANNED TO START WORK INSTEAD MR752 02450O* OF THE PLANNED COMPLETION DATE. MR752 0002460O***** MR752 02470OORDERS E 01 20 MR752 02480O 2 'SO' MR752 02490O 4 'FC' MR752 02500O X 6 MR752 02510O PN 66 MR752 02520O FAR,X 28 MR752 0002530O DATE,X 34 MR752 02540O UDATE 40 MR752 02550O D 02 MR752 02560O OR 03 25 MR752 02570O 02 2 'OJ' MR752 02580O 03 2 'RJ' MR752 02590O WONUM 7 MR752 0002600O PN 66 MR752 02610O DIFF 28 MR752 02620O 02 TDATE 34 MR752 02630O 03 DUEDAT 34 MR752 02640O 02 DUEDAT 40 MR752 02650O 03 TDATE 40 MR752 02660O 02 10 46 'X' MR752 0002670O 03 46 'X' MR752 02680O D 05 26 MR752 02690O 2 'PO' MR752 02700O PONUM 9 MR752 02710O PN 66 MR752 02720O DIFF 28 MR752 02730O RMMDD 32 MR752 0002740O RYY 34 MR752 02750O TDATE 40 MR752 02760O VENDOR 45 MR752 02770O 46 'X' MR752 02780OBOMMST D 07 MR752 02790O RRN 27 MR752 02800OTEMRRN D 07N33 MR752 0002805O PART 62 02810O FLD 17 MR752 02820O AVAIL 24 MR752 02830O LEADTM 27 MR752 02840O MMCODE 28 MR752 02850O MIN 35 MR752 02860O LOTSIZ 42 MR752 00** 002870ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002880ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002890ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002900ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002910/* 002920_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2= @DIS20IS PPP999999051278(000010H DIS20I00020F@DIS20 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040I@DIS20 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 __ 0(2 @DIS40IS PPP051678051678(000010H DIS40I00020F@DIS40 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040I@DIS40 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 __ 0(x/: x2TXFM080 PB999999111111(000010H S FM080 00020X DECK-ID M07 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM080 00030F* PURGES A MASTER FILE OF RECORDS FLAGGED FOR DELETION FM080 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM080 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM080 00060F* CONTROL DATA PROPRIETARY PRODUCT FM080 00070F* FM080 0000080FPARTMST IPEAF 300 20AI 271 DISK U1 FM080 00090FMACHMST ISEAF 48 5AI 1 DISK U2 FM080 00100FLABMST ISEAF 48 2AI 1 DISK U3 FM080 00110FVENDOR ISEAF 256 5AI 1 DISK U4 FM080 00120FEMPMST ISEAF 100 5AI 1 DISK U5 FM080 00130FPAROUT O F 300 DISK U1 FM080 00140FMACOUT O F 48 DISK U2 FM080 0000150FLABOUT O F 48 DISK U3 FM080 00160FVENOUT O F 256 DISK U4 FM080 00170FEMPOUT O F 100 DISK U5 FM080 00180F$LP1 O F 132 OF PRINTER FM080 00190F********************************************************************FM080 00200F* FM080 00210F* COMPANY FM080 0000220F* SYSTEM FILE MAINTENANCE FM080 00230F* PROGRAM PURGES MASTER FILES OF RECORDS FLAGGED FOR DELETION FM080 00240F* FM080 00250F* CONTRACTOR COMPUSOURCE FM080 00260F* PROGRAMMER FM080 00270F* DATE FM080 00280F* FM080 0000290F********************************************************************FM080 00300F* FM080 00310F* U1 PARTMST FM080 00320F* U2 MACHMST FM080 00330F* U3 LABMST FM080 00340F* U4 VENDOR FM080 00350F* U5 EMPMST FM080 0000360F* FM080 00370F********************************************************************FM080 00380F* FM080 00390F* ID F C H L FUNCTION OF INDICATORS FM080 00400F* FM080 00410F* 01 PARTMST KEEP FM080 00420F* 02 PARTMST DELETE FM080 0000430F* 03 MACHMST KEEP FM080 00440F* 04 MACHMST DELETE FM080 00450F* 05 LABMST KEEP FM080 00460F* 06 LABMST DELETE FM080 00470F* 07 VENDOR KEEP FM080 00480F* 08 VENDOR DELETE FM080 00490F* 09 EMPMST KEEP FM080 0000500F* 10 EMPMST DELETE FM080 00510F* FM080 00520F********************************************************************FM080 00530IPARTMST NS 01 74 C FM080 00540I 1 200 REC01 FM080 00550I 201 300 REC01A FM080 00560I NS 02 FM080 0000570I 271 290 X02 FM080 00580IMACHMST NS 03 36 C FM080 00590I 1 48 REC03 FM080 00600I NS 04 FM080 00610I 1 50X04 FM080 00620ILABMST NS 05 30 C FM080 00630I 1 48 REC05 FM080 0000640I NS 06 FM080 00650I 1 20X06 FM080 00660IVENDOR NS 07 106 C FM080 00670I 1 200 REC07 FM080 00680I 201 256 REC07A FM080 00690I NS 08 FM080 00700I 1 50X08 FM080 0000710IEMPMST NS 09 40 C FM080 00720I 1 100 REC09 FM080 00730I NS 10 FM080 00740I 1 50X10 FM080 00750OPAROUT D 01 FM080 00760O REC01 200 FM080 00770O REC01A 300 FM080 0000780OMACOUT D 03 FM080 00790O REC03 48 FM080 00800OLABOUT D 05 FM080 00810O REC05 48 FM080 00820OVENOUT D 07 FM080 00830O REC07 200 FM080 00840O REC07A 256 FM080 0000850OEMPOUT D 09 FM080 00860O REC09 100 FM080 00870O$LP1 H 202 1P FM080 00880O OR OF FM080 00890O U1 15 'PARTMST DELETES' FM080 00900O U2 15 'MACHMST DELETES' FM080 00910O U3 14 'LABMST DELETES' FM080 0000920O U4 14 'VENDOR DELETES' FM080 00930O U5 14 'EMPMST DELETES' FM080 00935O UDATE Y 30 00940O D 1 02 FM080 00950O OR 04 FM080 00960O OR 06 FM080 00970O OR 08 FM080 0000980O OR 10 FM080 00990O U1X02 20 FM080 01000O U2X04 5 FM080 01010O U3X06 2 FM080 01020O U4X08 5 FM080 01030O U5X10 5 FM080 ** 00104000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001050ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001060ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001070ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001080/* 001090_ 00 00 __ 0(/ ?TXIN620 P999999032778(000010H S IN620 00020X DECK-ID M59 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN620 00030F* THIS PROGRAM ADDS MANUAL TRANSACTIONS TO TRANSAC FILE IN620 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN620 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN620 00060F* CONTROL DATA PROPRIETARY PRODUCT IN620 00070F* IN620 0000080FTRANTMP UPE F 65 DISK IN620 00090FTRNWO1 ISEAF 65 DISK U1 IN620 00100FTRNWO2 ISEAF 65 DISK U1 IN620 00110FTRNWO3 ISEAF 65 DISK U1 IN620 00120FTRANSAC O F 65 DISK A IN620 00130F********************************************************************IN620 00140F* IN620 0000150F* PACKAGE MANUFACTURING IN620 00160F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN620 00170F* PROGRAM ADDS MANUAL INVOICES TO TRANSAC IN620 00180F* IN620 00190F* CONTRACTOR COMPUSOURCE IN620 00200F* PROGRAMMER KATH HILL IN620 00210F* DATE OCTOBER 31, 1975 IN620 0000220F* IN620 00230F********************************************************************IN620 00240F* IN620 00250F* NARRATIVE: ADDS RECORDS IN TRANTMP ONTO END OF TRANSAC. IN620 00260F* TRANSACTION DATE IS GIVEN BY IPL DATE. IN620 00270F* IF U1 IS ON, THE RECORDS IN THE WORK-IN-PROCESS IN620 00280F* SYSTEMS FILES TRNWO1,TRNWO2,AND TRNWO3 ARE ALSO IN620 0000290F* ADDED TO TRANSAC. IN620 00300F* IN620 00310F********************************************************************IN620 00320F* IN620 00330F* ID F C H L FUNCTION OF INDICATORS IN620 00340F* IN620 00350F* 01 TRANTMP IN620 0000360F* 02 TRNWO1 IN620 00370F* 03 TRNWO2 IN620 00380F* 04 TRNWO3 IN620 00390F* 20 WIP IS INPUT IN620 00400F* IN620 00410F********************************************************************IN620 00420ITRANTMP NS 01 IN620 0000430I 42 61 PARTNO IN620 00435I 1 2 TRY2 00440I 13 140TRANNO IN620 00450I 15 210QTY IN620 00460I 22 28 REFNUM IN620 00470I 35 413UNCOST IN620 00480ITRNWO1 NS 02 IN620 0000490I 1 65 REC IN620 00500ITRNWO2 NS 03 IN620 00510I 1 65 REC IN620 00520ITRNWO3 NS 04 IN620 00530I 1 65 REC IN620 00550C N20 TRY2 COMP '<>' 50UNUSED RCD IN620 00560C SETOF 20 IN620 0000570C 02 IN620 00580COR 03 IN620 00590COR 04 SETON 20 IN620 00600OTRANSAC DADD 01N50 IN620 00610O PARTNO 61 IN620 00620O TRANNO 14 IN620 00630O QTY 21 IN620 0000640O REFNUM 28 IN620 00650O UDATE 34 IN620 00660O UNCOST 41 IN620 00670OTRANTMP D 01N50 IN620 00680O 2 '<>' IN620 00690OTRANSAC DADD 20 IN620 00700O REC 65 IN620 00** 000710ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000730ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000750/* 000760_ 00 00 00 00 00 00 00 00 00 00 00 __ 0& PINVDTL K999999051578& 00052123450606780120000010 075000002270505 IAG-30 00052123450606780120000002 000000000118805 I16552 00052123450606780120000003 000000000003605 I16510 00052123450606780120000004 000000000000605 I16513 __ % NSMTHIN J999999051578%__ NSMTHIN J999999051578%03605 I16510 00052123450606780120000004 000000000000605 I16513 __ (I BTXFM020 P999999111111(000010H S FM020 00020X DECK-ID M01 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM020 00030F* INQUIRY/MAINTENANCE OF MACHINE MASTER FILE (MACHMST) FM020 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM020 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM020 00060F* CONTROL DATA PROPRIETARY PRODUCT FM020 00070F* FM020 0000080FNULL IPEAF 72 DISK FM020 00090F@MFG20 IC F 32R DISK FM020 00100FMACHMST UC F 0048R05AI 0001 DISK A FM020 00110E FN 025 22 FIELD NAME FM020 00120E CP 025 4 CURSOR POSITION FM020 00130E LN 025 2 0 LENGTH FM020 00140E EP 025 4 0 ENDING POSITION FM020 0000150INULL NS 01 FM020 00160I 1 1 A FM020 00170I@MFG20 NS 02 FM020 00180I 1 22 FIELDN FM020 00190I 23 26 CURPOS FM020 00200I 27 280LNGTH FM020 00210I 29 310ENDPOS FM020 0000220IMACHMST NS 03 FM020 00230I 10048 RECORD FM020 00240C MOVE ' ' RCODE 1 FM020 00250C MOVE RCODE B22 22 FM020 00260C MOVE RCODE BLANKS 72 FM020 00270C MOVE RCODE FILLER 1 FM020 00280C Z-ADD0 MASK 10 FM020 0000290C SETON LR FM020 00300CLR Z-ADD025 SSIZE 30 FM020 00310CLR Z-ADD002 NSECT 30 FM020 00320CLR MOVEL'D' FF 1 FM020 00330CLR MOVE '[]<>' TEMP4 4 FM020 00340CLR START TAG FM020 00350C* ********** FM020 0000360CLR EXSR FIRSTP FM020 00370C* ********** FM020 00380CLR EXSR CLRSCR FM020 00390C* ********** FM020 00400CLR 40 GOTO EOJ FM020 00410C* ********** FM020 00420CLR Z-ADD2 VL FM020 0000430CLR MOVELSECTON VAR FM020 00440CLR EXSR RTADJ FM020 00450C* ********** FM020 00460CLR MOVELVAR SECTN 20 FM020 00470CLR EXSR GETSEC FM020 00480C* ********** FM020 00490CLRN45 GOTO START FM020 0000500C* ********** FM020 00510CLR EXSR CLRSCR FM020 00520C* ********** FM020 00530CLR EXSR OUTPUT FM020 00540C* ********** FM020 00550CLR EXSR UPDATE FM020 00560C* ********** FM020 0000570CLR GOTO START FM020 00580C* ********** FM020 00590CLR EOJ TAG FM020 00600C* ********** FM020 00610C********************************************************************FM020 00620C* FM020 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND FM020 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. FM020 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDFM020 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN FM020 00670C* FM020 00680C********************************************************************FM020 00690CSR FIRSTP BEGSR FM020 00700C* ********** FM020 0000710CSR EXSR CLRSCR FM020 00720C* ********** FM020 00730CSR Z-ADD0 SECTN FM020 00740CSR EXSR GETSEC FM020 00750C* ********** FM020 00760CSR PGE TAG FM020 00770C* ********** FM020 0000780CSR SETON 61 FM020 00790CSR SETOF 62 FM020 00800CSR EXSR OUTPUT FM020 00810C* ********** FM020 00820C* ********** FM020 00830CSR EXIT SUBRFL FM020 00840CSR RLABL RECORD FM020 0000850CSR RLABL FILLER 1 FM020 00860C* ********** FM020 00870C* ********** FM020 00880C* ********** FM020 00890C* ********** FM020 00900C* ********** FM020 00910C* ********** FM020 0000920C* ********** FM020 00930C* ********** FM020 00940C* ********** FM020 00950C* ********** FM020 00960C* ********** FM020 00970C* ********** FM020 00980C* ********** FM020 0000990C* ********** FM020 01000C* ********** FM020 01010CSR Z-ADD05 NCHARS FM020 01020CSR Z-ADD1 SSTRT FM020 01030CSR Z-ADD1 TSTRT FM020 01040C* ********** FM020 01050CSR EXIT SUBRLM FM020 0001060CSR RLABL KEY 05 FM020 01070CSR RLABL SSTRT 30 FM020 01080CSR RLABL RECORD FM020 01090CSR RLABL TSTRT 30 FM020 01100CSR RLABL NCHARS 30 FM020 01110CSR Z-ADDNOFLDS SVFLDS 30 FM020 01120CSR Z-ADDSX NOFLDS FM020 0001130CSR EXSR UPDATE FM020 01140C* ********** FM020 01150CSR Z-ADDSVFLDS NOFLDS FM020 01160CSR Z-ADD05 NCHARS FM020 01170CSR Z-ADD1 SSTRT FM020 01180CSR Z-ADD1 TSTRT FM020 01190C* ********** FM020 0001200CSR EXIT SUBRLM FM020 01210CSR RLABL RECORD FM020 01220CSR RLABL SSTRT 30 FM020 01230CSR RLABL KEY FM020 01240CSR RLABL TSTRT 30 FM020 01250CSR RLABL NCHARS 30 FM020 01260CSR KEY CHAINMACHMST 55 FM020 0001270CSR MOVELSAVPOS BUFFER FM020 01280CSR MOVELOFC BUFFER FM020 01290CSR EXSR POSCUR FM020 01300C* ********** FM020 01310CSR MOVEL'] NEW R'WORD16 16 FM020 01320CSR MOVE 'ECORD 'WORD16 FM020 01330CSRN55 MOVELBLANKS WORD16 FM020 0001340CSRN55 MOVEL']' WORD16 FM020 01350CSR MOVELWORD16 BUFFER 72 FM020 01360CSR MOVE 'T' TYPE 1 FM020 01370CSR Z-ADD13 BLNGTH 20 FM020 01380CSR EXSR CRTCOM FM020 01390C* ********** FM020 01400CSR SETON 62 FM020 0001410CSR Z-ADDSX X 30 FM020 01420CSR EXSR ACCEPT FM020 01430C* ********** FM020 01440CSR MOVELBUFFER SECTON 2 FM020 01450CSR SECTON COMP 'E ' 40 FM020 01460CSR 40 GOTO ENDFP FM020 01470C* ********** FM020 0001480CSR SECTON COMP 'D ' 40 FM020 01490CSR 40N55 EXCPT FM020 01500CSR 40 GOTO PGE FM020 01510C* ********** FM020 01520CSR SECTON COMP ' 1' 30 30 FM020 01530CSR 30 SECTON COMP ' 9' 3030 FM020 01540CSR 30 GOTO GOOD FM020 0001550C* ********** FM020 01560CSR SECTON COMP '01' 30 30 FM020 01570CSR 30 SECTON COMP '09' 3030 FM020 01580CSR 30 GOTO GOOD FM020 01590C* ********** FM020 01600CSR SECTON COMP '1 ' 30 30 FM020 01610CSR 30 SECTON COMP '9 ' 3030 FM020 0001620CSR 30 GOTO GOOD FM020 01630C* ********** FM020 01640CSR MOVELSECTON TEMP1 1 FM020 01650CSR TEMP1 COMP '1' 30 30 FM020 01660CSR 30 TEMP1 COMP '9' 3030 FM020 01670CSRN30 GOTO PGE FM020 01680C* ********** FM020 0001690CSR MOVE SECTON TEMP1 FM020 01700CSR TEMP1 COMP '0' 30 30 FM020 01710CSR 30 TEMP1 COMP '9' 3030 FM020 01720CSRN30 GOTO PGE FM020 01730C* ********** FM020 01740CSR GOOD TAG FM020 01750C* ********** FM020 0001760CSR SETOF 6162 FM020 01770CSRN55 GOTO ENDFP FM020 01780C* ********** FM020 01790CSR SETON 80 FM020 01800CSR EXCPT FM020 01810CSR SETOF 80 FM020 01820CSR KEY CHAINMACHMST 55 FM020 0001830CSR ENDFP ENDSR FM020 01840C********************************************************************FM020 01850C* FM020 01860C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. FM020 01870C* FM020 01880C********************************************************************FM020 01890CSR GETSEC BEGSR FM020 0001900C* ********** FM020 01910CSR 1 ADD SECTN N 20 FM020 01920CSR SETOF 404145 FM020 01930CSR N COMP 0 3030 FM020 01940CSRN30 N COMP NSECT 30 FM020 01950CSR 30 GOTO ENDGET FM020 01960C* ********** FM020 0001970CSR SECTN MULT SSIZE RRN 40 FM020 01980CSR Z-ADD1 X FM020 01990CSR SCLOOP TAG FM020 02000C* ********** FM020 02010CSR RRN ADD 1 RRN FM020 02020CSR RRN CHAIN@MFG20 50 FM020 02030CSR 50 GOTO ENDGET FM020 0002040C* ********** FM020 02050CSR FIELDN COMP B22 4141 FM020 02060CSRN41 GOTO ENDGET FM020 02070C* ********** FM020 02080CSR 41N45 SETON 45 FM020 02090CSR MOVE FIELDN FN,X FM020 02100CSR MOVE CURPOS CP,X FM020 0002110CSR MOVE LNGTH LN,X FM020 02120CSR Z-ADDENDPOS EP,X FM020 02130CSR 1 ADD X X FM020 02140CSR X COMP SSIZE 32 FM020 02150CSRN32 GOTO SCLOOP FM020 02160C* ********** FM020 02170CSR ENDGET TAG FM020 0002180C* ********** FM020 02190CSR Z-ADDX NOFLDS 30 FM020 02200CSR 45 GOTO FINGET FM020 02210C* ********** FM020 02220CSR EXSR CLRSCR FM020 02230C* ********** FM020 02240CSR MOVEL'SECT # 'WORD9 9 FM020 0002250CSR Z-ADD16 BLNGTH FM020 02260CSR MOVE SECTN WORD9 FM020 02270CSR MOVELWORD9 WORD16 FM020 02280CSRN30 MOVE ' ABSENT' WORD16 FM020 02290CSR 30 MOVE ' ILLEG.' WORD16 FM020 02300CSR MOVELWORD16 BUFFER FM020 02310CSR MOVEL'T' TYPE FM020 0002320CSR EXSR CRTCOM FM020 02330C* ********** FM020 02340CSR FINGET ENDSR FM020 02350C* ********** FM020 02360C********************************************************************FM020 02370C* FM020 02380C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE FM020 0002390C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE FM020 02400C* SECTION INDEX IS SAVED. FM020 02410C* FM020 02420C********************************************************************FM020 02430CSR OUTPUT BEGSR FM020 02440C* ********** FM020 02450CSR EXSR CLRSCR FM020 0002460C* ********** FM020 02470CSR Z-ADD1 X FM020 02480CSR 61 SETON 63 FM020 02490CSR OTLOOP TAG FM020 02500C* ********** FM020 02510CSR 61 LN,X COMP 0 31 FM020 02520CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXFM020 0002530CSR EXSR OUTFLD FM020 02540C* ********** FM020 02550CSR X ADD 1 X FM020 02560CSR X COMP NOFLDS 31 FM020 02570CSR 31 GOTO OTLOOP FM020 02580C* ********** FM020 02590CSR SETOF 63 FM020 0002600CSR ENDSR FM020 02610C********************************************************************FM020 02620C* FM020 02630C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND FM020 02640C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 FM020 02650C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS FM020 02660C* THEN NO FIELD INFORMATION IS PRINTED FM020 0002670C* FM020 02680C********************************************************************FM020 02690CSR OUTFLD BEGSR FM020 02700C* ********** FM020 02710CSR MOVE FN,X FL 20 FM020 02720CSR EP,X COMP 0 98 FM020 02730CSR MOVELCP,X FC 20 FM020 0002740CSR FC COMP FL 31 FM020 02750CSR 31 Z-ADDFC FL FM020 02760CSR FC SUB FL CC 20 FM020 02770CSR CC ADD 1 CC FM020 02780CSR MOVELCP,X BUFFER FM020 02790CSR MOVELCC BUFFER FM020 02800CSR EXSR POSCUR FM020 0002810C* ********** FM020 02820CSR MOVELBLANKS BUFFER FM020 02830CSR MOVELFN,X FIELDN FM020 02840CSR MOVE ' ' FIELDN FM020 02850CSR MOVELFIELDN BUFFER FM020 02860CSR Z-ADDLN,X LEN 20 FM020 02870CSR LEN COMP 0 9730 FM020 0002880CSR 97 Z-SUBLN,X LEN FM020 02890CSR 30 GOTO SKIPF FM020 02900C* ********** FM020 02910CSR FL ADD 2 BPOS 20 FM020 02920C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS FM020 02930CSR Z-ADDBPOS TSTRT 30 FM020 02940CSRN98 Z-ADD1 SSTRT 30 FM020 0002950CSR 98 Z-ADD3 SSTRT FM020 02960CSR Z-ADD1 NCHARS 30 FM020 02970C* ********** FM020 02980CSR EXIT SUBRLM FM020 02990CSR RLABL TEMP4 FM020 03000CSR RLABL SSTRT 30 FM020 03010CSR RLABL BUFFER FM020 0003020CSR RLABL TSTRT 30 FM020 03030CSR RLABL NCHARS 30 FM020 03040CSR BPOS ADD 1 FPOS 20 FM020 03050CSR EXSR MVRECD FM020 03060C* ********** FM020 03070CSR SKIPF TAG FM020 03080C* ********** FM020 0003090CSR 30 Z-ADDFL BLNGTH FM020 03100CSRN30 FL ADD 3 BLNGTH FM020 03110CSRN30 BLNGTH ADD LEN BLNGTH FM020 03120CSR MOVE 'T' TYPE FM020 03130CSR EXSR CRTCOM FM020 03140C* ********** FM020 03150CSR ENDSR FM020 0003160C********************************************************************FM020 03170C* FM020 03180C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN FM020 03190C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST FM020 03200C* THE RIGHT BRACKET. FM020 03210C********************************************************************FM020 03220CSR MVRECD BEGSR FM020 0003230C* ********** FM020 03240CSR 63 GOTO RBRK FM020 03250C* ********** FM020 03260CSR 98 Z-SUBEP,X END 40 FM020 03270CSRN98 Z-ADDEP,X END FM020 03280CSR END SUB LEN STRT 40 81 81 FM020 03290CSR STRT ADD 1 STRT FM020 0003300C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER FM020 03310C* FROM STRT IN RECORD TO FPOS IN BUFFER FM020 03320CSR Z-ADDLEN NCHARS FM020 03330CSR Z-ADDSTRT SSTRT FM020 03340CSR Z-ADDFPOS TSTRT FM020 03350CSRN81 GOTO RBRK FM020 03360C* ********** FM020 0003370CSR EXIT SUBRLM FM020 03380CSR RLABL RECORD FM020 03390CSR RLABL SSTRT 30 FM020 03400CSR RLABL BUFFER FM020 03410CSR RLABL TSTRT 30 FM020 03420CSR RLABL NCHARS 30 FM020 03430CSR RBRK TAG FM020 0003440C* ********** FM020 03450CSR EXSR RTBRKT FM020 03460C* ********** FM020 03470CSR ENDSR FM020 03480C********************************************************************FM020 03490C* FM020 03500C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS FM020 0003510C* FM020 03520C********************************************************************FM020 03530CSR RTBRKT BEGSR FM020 03540C* ********** FM020 03550CSR LEN ADD FPOS FPOS FM020 03560CSR Z-ADDFPOS TSTRT FM020 03570CSR Z-ADD1 NCHARS FM020 0003580CSRN98 Z-ADD2 SSTRT FM020 03590CSR 98 Z-ADD4 SSTRT FM020 03600C* ********** FM020 03610CSR EXIT SUBRLM FM020 03620CSR RLABL TEMP4 FM020 03630CSR RLABL SSTRT 30 FM020 03640CSR RLABL BUFFER FM020 0003650CSR RLABL TSTRT 30 FM020 03660CSR RLABL NCHARS 30 FM020 03670CSR ENDSR FM020 03680C********************************************************************FM020 03690C* FM020 03700C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. FM020 03710C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO FM020 0003720C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF FM020 03730C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST FM020 03740C* OF THE FIELDS ARE LEFT UNCHANGED FM020 03750C* FM020 03760C********************************************************************FM020 03770CSR UPDATE BEGSR FM020 03780C* ********** FM020 0003790CSR SETOF 32 FM020 03800CSR Z-ADD1 X FM020 03810CSR UPLOOP TAG FM020 03820C* ********** FM020 03830CSR EP,X COMP 0 98 FM020 03840CSR 98 SETON 30 FM020 03850CSR 98 GOTO NOUPD FM020 0003860C* ********** FM020 03870CSR Z-ADDLN,X LEN FM020 03880CSR LEN COMP 0 9730 FM020 03890CSR 97 Z-SUBLEN LEN FM020 03900CSR NOUPD TAG FM020 03910C* ********** FM020 03920CSR 30N32 GOTO INCR FM020 0003930C* ********** FM020 03940CSR 30 GOTO CHKRUB FM020 03950C* ********** FM020 03960CSR SETOF 3233 FM020 03970CSR EXSR ACCEPT FM020 03980C* ********** FM020 03990CSR CHKRUB TAG FM020 0004000C* ********** FM020 04010CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTFM020 04020CSR 32 31 GOTO UPLOOP FM020 04030C* ********** FM020 04040CSR 32 GOTO ENDUPD FM020 04050C* ********** FM020 04060CSR MOVELBUFFER ATSIGN 1 FM020 0004070CSR ATSIGN COMP '@' 35 FM020 04080CSR 35 GOTO OUTREC FM020 04090C* ********** FM020 04100CSR 33 GOTO INCR WAS LINE FEED FM020 04110C* ********** FM020 04120CSR Z-ADDEP,X END FM020 04130CSR END SUB LEN STRT 81 81 FM020 0004140CSR STRT ADD 1 STRT FM020 04150C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF FM020 04160C* BUFFER TO THE STRT OF RECORD FM020 04170CSR Z-ADD1 SSTRT FM020 04180CSR Z-ADDSTRT TSTRT FM020 04190CSR Z-ADDLEN NCHARS FM020 04200CSRN81 GOTO AAA FM020 0004210C* ********** FM020 04220CSR EXIT SUBRLM FM020 04230CSR RLABL BUFFER FM020 04240CSR RLABL SSTRT 30 FM020 04250CSR RLABL RECORD FM020 04260CSR RLABL TSTRT 30 FM020 04270CSR RLABL NCHARS 30 FM020 0004280CSR AAA TAG FM020 04290CSR MOVELBUFFER TEMP5 5 FM020 04300CSR MOVELSAVPOS BUFFER FM020 04310CSR EXSR POSCUR FM020 04320C* ********** FM020 04330CSR MOVELTEMP5 BUFFER FM020 04340CSR EXSR RTBRKT FM020 0004350C* ********** FM020 04360CSR LEN ADD 1 BLNGTH FM020 04370CSR MOVE 'T' TYPE FM020 04380CSR EXSR CRTCOM FM020 04390C* ********** FM020 04400CSR INCR TAG FM020 04410C* ********** FM020 0004420CSR X ADD 1 X FM020 04430CSR X COMP NOFLDS 30 FM020 04440CSR 30 GOTO UPLOOP FM020 04450C* ********** FM020 04460CSR OUTREC TAG FM020 04470C* ********** FM020 04480CSR SETON 80 FM020 0004490CSRN61 EXCPT FM020 04500CSR SETOF 80 FM020 04510CSR ENDUPD TAG FM020 04520C* ********** FM020 04530CSR ENDSR FM020 04540C********************************************************************FM020 04550C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE FM020 0004560C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X FM020 04570C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND FM020 04580C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT FM020 04590C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED FM020 04600C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS FM020 04610C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS FM020 04620C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO FM020 0004630C* TO BE OUTPUT TO THE SCREEN. FM020 04640C* FM020 04650C********************************************************************FM020 04660CSR ACCEPT BEGSR FM020 04670C* ********** FM020 04680CSR X COMP 1 30 FM020 04690CSRN30 X COMP SSIZE 30 FM020 0004700CSR 30 Z-ADD1 X FM020 04710CSR MOVELCP,X FC FM020 04720CSR FC ADD 3 FC FM020 04730CSR MOVELCP,X SAVPOS 4 FM020 04740CSR MOVELFC SAVPOS FM020 04750CSR Z-ADDLN,X LEN FM020 04760CSR LEN COMP 0 97 FM020 0004770CSR 97 Z-SUBLEN LEN FM020 04780CSR LEN ADD FC OFC 20 FM020 04790CSR ACLOOP TAG FM020 04800C* ********** FM020 04810CSR MOVELSAVPOS BUFFER FM020 04820CSR EXSR POSCUR FM020 04830C* ********** FM020 0004840CSR Z-ADDLEN BLNGTH FM020 04850CSR MOVE BLANKS BUFFER FM020 04860CSR MOVE 'A' TYPE FM020 04870CSR EXSR CRTCOM FM020 04880C* ********** FM020 04890CSR RCODE COMP 'R' 31 FM020 04900CSR 31 BUFFER COMP BLANKS 32 FM020 0004910CSR 31 32N62 GOTO DUPIT FM020 04920C* ********** FM020 04930CSR 31 GOTO ACLOOP FM020 04940C* ********** FM020 04950CSR RCODE COMP 'L' 33 FM020 04960CSR 33 GOTO DUPIT FM020 04970C* ********** FM020 0004980CSRN97 GOTO ENDACC FM020 04990C* ********** FM020 05000CSR MOVELBUFFER SIGN 1 WE MUST CHECK FM020 05010CSR SIGN COMP '@' 30 FM020 05020CSR 30 GOTO ENDACC FM020 05030C* ********** FM020 05040CSR Z-ADDLEN VL 20 FM020 0005050CSR MOVELBUFFER VAR 15 FM020 05060CSR EXSR RTADJ FM020 05070C* ********** FM020 05080CSR MOVELVAR BUFFER FM020 05090CSR GOTO ENDACC FM020 05100C* ********** FM020 05110CSR DUPIT TAG FM020 0005120C* ********** FM020 05130CSR MOVELSAVPOS BUFFER FM020 05140CSR EXSR POSCUR FM020 05150C* ********** FM020 05160CSR 62 MOVELSECTON BUFFER FM020 05170CSRN62 Z-ADD1 FPOS FM020 05180CSRN62 EXSR MVRECD FM020 0005190C* ********** FM020 05200CSR MOVE 'T' TYPE FM020 05210CSR BLNGTH ADD 1 BLNGTH FM020 05220CSR EXSR CRTCOM FM020 05230C* ********** FM020 05240CSR ENDACC ENDSR FM020 05250C* ********** FM020 0005260C********************************************************************FM020 05270C* FM020 05280C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES FM020 05290C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM FM020 05300C* 4 DUMMY FOR RTADJ FM020 05310C* FM020 05320C********************************************************************FM020 0005330CSR POSCUR BEGSR FM020 05340C* ********** FM020 05350CSR MOVE 'P' TYPE FM020 05360CSR EXSR CRTCOM FM020 05370C* ********** FM020 05380CSR ENDSR FM020 05390C********************************************************************FM020 0005400CSR CLRSCR BEGSR FM020 05410C* ********** FM020 05420CSR MOVE 'C' TYPE FM020 05430CSR EXSR CRTCOM FM020 05440C* ********** FM020 05450CSR ENDSR FM020 05460C********************************************************************FM020 0005470CSR CRTCOM BEGSR FM020 05480C* ********** FM020 05490C* ********** FM020 05500CSR EXITFSUBRCM FM020 05510CSR RLABL BUFFER 72 FM020 05520CSR RLABL TYPE 1 FM020 05530CSR RLABL BLNGTH 20 FM020 0005540CSR RLABL RCODE 1 FM020 05550CSR RLABL MASK 10 FM020 05560CSR RLABL DTYPE 10 FM020 05570CSR ENDSR FM020 05580C********************************************************************FM020 05590CSR RTADJ BEGSR FM020 05600C* ********** FM020 0005610CSR EXIT SUBRAJ FM020 05620C* ********** FM020 05630CSR RLABL VL FM020 05640CSR RLABL VAR FM020 05650CSR ENDSR FM020 05660C********************************************************************FM020 05670OMACHMST E 80N55 FM020 0005680O RECORD 0048 FM020 05690O E 40N80 FM020 05700O FF 36 FM020 05710O EADD 80 55 FM020 05720O RECORD 0048 FM020 ** 005730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00574000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005770/* 005780__0O RECORD 0048 FM020 ** 005730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0057400(U I$TXFM022 P999999111111(000010H S FM022 00020X DECK-ID M02 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM022 00030F* PRINTS ALL RECORDS NOT FLAGGED FOR DELETION ON MACHMST FILE FM022 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM022 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM022 00060F* CONTROL DATA PROPRIETARY PRODUCT FM022 00070F* FM022 0000080FMACHMST IPEAF 48 5AI 1 DISK FM022 00090FHEADING IT F 40 EDISK FM022 00100F$LP1 O F 132 OF PRINTER FM022 00110F********************************************************************FM022 00120F* FM022 00130F* COMPANY FM022 00140F* SYSTEM FILE MAINTENANCE FM022 0000150F* PROGRAM PRINTS AND COUNTS NON-DELETED MEMBERS OF FM022 00160F* WORK STATION MASTER FILE FM022 00170F* FM022 00180F* CONTRACTOR COMPUSOURCE FM022 00190F* PROGRAMMER FM022 00200F* DATE FM022 00210F* FM022 0000220F********************************************************************FM022 00230F* FM022 00240F* ID F C H L FUNCTION OF INDICATORS FM022 00250F* FM022 00260F* 01 MACHMST --- DELETE CODE BLANK FM022 00270F* 02 MACHMST --- DELETE CODE NOT BLANK FM022 00280F* FM022 0000290F********************************************************************FM022 00300E HEADING HEAD 1 1 40 COMPANY NAME FM022 00310IMACHMST NS 01 36 C FM022 00320I 1 5 STATIO FM022 00330I 6 25 DESCRP FM022 00340I 26 323BURDEN FM022 00350I 37 420CAPACI FM022 0000360I NS 02 FM022 00370I 1 1 AIR FM022 00380C 01 COUNT ADD 1 COUNT 40 FM022 00390C* ********** FM022 00400O$LP1 H 202 1P FM022 00410O OR OF FM022 00420O PAGE Z 10 FM022 0000430O 4 'PAGE' FM022 00440O HEAD,1 85 FM022 00450O UDATE Y 132 FM022 00460O H 2 1P FM022 00470O OR OF FM022 00480O 69 'WORK STATION MASTER FILE' FM022 00490O 77 'LISTING' FM022 0000500O 132 'MFG022' FM022 00510O H 2 1P FM022 00520O OR OF FM022 00530O 14 'WORK STATION #' FM022 00540O 27 'DESCRIPTION' FM022 00550O 56 'BURDEN RATE [$/HR]' FM022 00560O 76 'CAPACITY [HRS/MTH]' FM022 0000570O D 1 01 FM022 00580O STATIO 14 FM022 00590O DESCRP 36 FM022 00600O BURDEN3 56 FM022 00610O CAPACI3 76 FM022 00620O T 3 LR FM022 00630O 22 'END OF JOB. THERE ARE' FM022 0000640O COUNT Z 27 FM022 00650O 49 'ACTIVE RECORDS IN THE' FM022 00660O 69 'WORK STATION MASTER' FM022 00670O 75 'FILE.' FM022 ** 000680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00070000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000710ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000720/* 000730__0O 75 'FILE.' FM022 ** 000680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0007000(I CTXFM030 P999999111111(000010H S FM030 00020X DECK-ID M03 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM030 00030F* INQUIRY/MAINTENANCE OF MACHINE LABOR MASTER FILE (LABMST) FM030 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM030 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM030 00060F* CONTROL DATA PROPRIETARY PRODUCT FM030 00070F* FM030 0000080FNULL IPEAF 72 DISK FM030 00090F@MFG30 IC F 32R DISK FM030 00100FLABMST UC F 0048R02AI 0001 DISK A FM030 00110E FN 025 22 FIELD NAME FM030 00120E CP 025 4 CURSOR POSITION FM030 00130E LN 025 2 0 LENGTH FM030 00140E EP 025 4 0 ENDING POSITION FM030 0000150INULL NS 01 FM030 00160I 1 1 A FM030 00170I@MFG30 NS 02 FM030 00180I 1 22 FIELDN FM030 00190I 23 26 CURPOS FM030 00200I 27 280LNGTH FM030 00210I 29 310ENDPOS FM030 0000220ILABMST NS 03 FM030 00230I 10048 RECORD FM030 00240C MOVE ' ' RCODE 1 FM030 00250C MOVE RCODE B22 22 FM030 00260C MOVE RCODE BLANKS 72 FM030 00270C MOVE RCODE FILLER 1 FM030 00280C Z-ADD0 MASK 10 FM030 0000290C SETON LR FM030 00300CLR Z-ADD025 SSIZE 30 FM030 00310CLR Z-ADD002 NSECT 30 FM030 00320CLR MOVEL'D' FF 1 FM030 00330CLR MOVE '[]<>' TEMP4 4 FM030 00340CLR START TAG FM030 00350C* ********** FM030 0000360CLR EXSR FIRSTP FM030 00370C* ********** FM030 00380CLR EXSR CLRSCR FM030 00390C* ********** FM030 00400CLR 40 GOTO EOJ FM030 00410C* ********** FM030 00420CLR Z-ADD2 VL FM030 0000430CLR MOVELSECTON VAR FM030 00440CLR EXSR RTADJ FM030 00450C* ********** FM030 00460CLR MOVELVAR SECTN 20 FM030 00470CLR EXSR GETSEC FM030 00480C* ********** FM030 00490CLRN45 GOTO START FM030 0000500C* ********** FM030 00510CLR EXSR CLRSCR FM030 00520C* ********** FM030 00530CLR EXSR OUTPUT FM030 00540C* ********** FM030 00550CLR EXSR UPDATE FM030 00560C* ********** FM030 0000570CLR GOTO START FM030 00580C* ********** FM030 00590CLR EOJ TAG FM030 00600C* ********** FM030 00610C********************************************************************FM030 00620C* FM030 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND FM030 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. FM030 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDFM030 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN FM030 00670C* FM030 00680C********************************************************************FM030 00690CSR FIRSTP BEGSR FM030 00700C* ********** FM030 0000710CSR EXSR CLRSCR FM030 00720C* ********** FM030 00730CSR Z-ADD0 SECTN FM030 00740CSR EXSR GETSEC FM030 00750C* ********** FM030 00760CSR PGE TAG FM030 00770C* ********** FM030 0000780CSR SETON 61 FM030 00790CSR SETOF 62 FM030 00800CSR EXSR OUTPUT FM030 00810C* ********** FM030 00820C* ********** FM030 00830CSR EXIT SUBRFL FM030 00840CSR RLABL RECORD FM030 0000850CSR RLABL FILLER 1 FM030 00860C* ********** FM030 00870C* ********** FM030 00880C* ********** FM030 00890C* ********** FM030 00900C* ********** FM030 00910C* ********** FM030 0000920C* ********** FM030 00930C* ********** FM030 00940C* ********** FM030 00950C* ********** FM030 00960C* ********** FM030 00970C* ********** FM030 00980C* ********** FM030 0000990C* ********** FM030 01000C* ********** FM030 01010CSR Z-ADD02 NCHARS FM030 01020CSR Z-ADD1 SSTRT FM030 01030CSR Z-ADD1 TSTRT FM030 01040C* ********** FM030 01050CSR EXIT SUBRLM FM030 0001060CSR RLABL KEY 02 FM030 01070CSR RLABL SSTRT 30 FM030 01080CSR RLABL RECORD FM030 01090CSR RLABL TSTRT 30 FM030 01100CSR RLABL NCHARS 30 FM030 01110CSR Z-ADDNOFLDS SVFLDS 30 FM030 01120CSR Z-ADDSX NOFLDS FM030 0001130CSR EXSR UPDATE FM030 01140C* ********** FM030 01150CSR Z-ADDSVFLDS NOFLDS FM030 01160CSR Z-ADD02 NCHARS FM030 01170CSR Z-ADD1 SSTRT FM030 01180CSR Z-ADD1 TSTRT FM030 01190C* ********** FM030 0001200CSR EXIT SUBRLM FM030 01210CSR RLABL RECORD FM030 01220CSR RLABL SSTRT 30 FM030 01230CSR RLABL KEY FM030 01240CSR RLABL TSTRT 30 FM030 01250CSR RLABL NCHARS 30 FM030 01260CSR KEY CHAINLABMST 55 FM030 0001270CSR MOVELSAVPOS BUFFER FM030 01280CSR MOVELOFC BUFFER FM030 01290CSR EXSR POSCUR FM030 01300C* ********** FM030 01310CSR MOVEL'] NEW R'WORD16 16 FM030 01320CSR MOVE 'ECORD 'WORD16 FM030 01330CSRN55 MOVELBLANKS WORD16 FM030 0001340CSRN55 MOVEL']' WORD16 FM030 01350CSR MOVELWORD16 BUFFER 72 FM030 01360CSR MOVE 'T' TYPE 1 FM030 01370CSR Z-ADD13 BLNGTH 20 FM030 01380CSR EXSR CRTCOM FM030 01390C* ********** FM030 01400CSR SETON 62 FM030 0001410CSR Z-ADDSX X 30 FM030 01420CSR EXSR ACCEPT FM030 01430C* ********** FM030 01440CSR MOVELBUFFER SECTON 2 FM030 01450CSR SECTON COMP 'E ' 40 FM030 01460CSR 40 GOTO ENDFP FM030 01470C* ********** FM030 0001480CSR SECTON COMP 'D ' 40 FM030 01490CSR 40N55 EXCPT FM030 01500CSR 40 GOTO PGE FM030 01510C* ********** FM030 01520CSR SECTON COMP ' 1' 30 30 FM030 01530CSR 30 SECTON COMP ' 9' 3030 FM030 01540CSR 30 GOTO GOOD FM030 0001550C* ********** FM030 01560CSR SECTON COMP '01' 30 30 FM030 01570CSR 30 SECTON COMP '09' 3030 FM030 01580CSR 30 GOTO GOOD FM030 01590C* ********** FM030 01600CSR SECTON COMP '1 ' 30 30 FM030 01610CSR 30 SECTON COMP '9 ' 3030 FM030 0001620CSR 30 GOTO GOOD FM030 01630C* ********** FM030 01640CSR MOVELSECTON TEMP1 1 FM030 01650CSR TEMP1 COMP '1' 30 30 FM030 01660CSR 30 TEMP1 COMP '9' 3030 FM030 01670CSRN30 GOTO PGE FM030 01680C* ********** FM030 0001690CSR MOVE SECTON TEMP1 FM030 01700CSR TEMP1 COMP '0' 30 30 FM030 01710CSR 30 TEMP1 COMP '9' 3030 FM030 01720CSRN30 GOTO PGE FM030 01730C* ********** FM030 01740CSR GOOD TAG FM030 01750C* ********** FM030 0001760CSR SETOF 6162 FM030 01770CSRN55 GOTO ENDFP FM030 01780C* ********** FM030 01790CSR SETON 80 FM030 01800CSR EXCPT FM030 01810CSR SETOF 80 FM030 01820CSR KEY CHAINLABMST 55 FM030 0001830CSR ENDFP ENDSR FM030 01840C* ********** FM030 01850C********************************************************************FM030 01860C* FM030 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. FM030 01880C* FM030 01890C********************************************************************FM030 0001900CSR GETSEC BEGSR FM030 01910C* ********** FM030 01920CSR 1 ADD SECTN N 20 FM030 01930CSR SETOF 404145 FM030 01940CSR N COMP 0 3030 FM030 01950CSRN30 N COMP NSECT 30 FM030 01960CSR 30 GOTO ENDGET FM030 0001970C* ********** FM030 01980CSR SECTN MULT SSIZE RRN 40 FM030 01990CSR Z-ADD1 X FM030 02000CSR SCLOOP TAG FM030 02010C* ********** FM030 02020CSR RRN ADD 1 RRN FM030 02030CSR RRN CHAIN@MFG30 50 FM030 0002040CSR 50 GOTO ENDGET FM030 02050C* ********** FM030 02060CSR FIELDN COMP B22 4141 FM030 02070CSRN41 GOTO ENDGET FM030 02080C* ********** FM030 02090CSR 41N45 SETON 45 FM030 02100CSR MOVE FIELDN FN,X FM030 0002110CSR MOVE CURPOS CP,X FM030 02120CSR MOVE LNGTH LN,X FM030 02130CSR Z-ADDENDPOS EP,X FM030 02140CSR 1 ADD X X FM030 02150CSR X COMP SSIZE 32 FM030 02160CSRN32 GOTO SCLOOP FM030 02170C* ********** FM030 0002180CSR ENDGET TAG FM030 02190C* ********** FM030 02200CSR Z-ADDX NOFLDS 30 FM030 02210CSR 45 GOTO FINGET FM030 02220C* ********** FM030 02230CSR EXSR CLRSCR FM030 02240C* ********** FM030 0002250CSR MOVEL'SECT # 'WORD9 9 FM030 02260CSR Z-ADD16 BLNGTH FM030 02270CSR MOVE SECTN WORD9 FM030 02280CSR MOVELWORD9 WORD16 FM030 02290CSRN30 MOVE ' ABSENT' WORD16 FM030 02300CSR 30 MOVE ' ILLEG.' WORD16 FM030 02310CSR MOVELWORD16 BUFFER FM030 0002320CSR MOVEL'T' TYPE FM030 02330CSR EXSR CRTCOM FM030 02340C* ********** FM030 02350CSR FINGET ENDSR FM030 02360C* ********** FM030 02370C********************************************************************FM030 02380C* FM030 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE FM030 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE FM030 02410C* SECTION INDEX IS SAVED. FM030 02420C* FM030 02430C********************************************************************FM030 02440CSR OUTPUT BEGSR FM030 02450C* ********** FM030 0002460CSR EXSR CLRSCR FM030 02470C* ********** FM030 02480CSR Z-ADD1 X FM030 02490CSR 61 SETON 63 FM030 02500CSR OTLOOP TAG FM030 02510C* ********** FM030 02520CSR 61 LN,X COMP 0 31 FM030 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXFM030 02540CSR EXSR OUTFLD FM030 02550C* ********** FM030 02560CSR X ADD 1 X FM030 02570CSR X COMP NOFLDS 31 FM030 02580CSR 31 GOTO OTLOOP FM030 02590C* ********** FM030 0002600CSR SETOF 63 FM030 02610CSR ENDSR FM030 02620C********************************************************************FM030 02630C* FM030 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND FM030 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 FM030 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS FM030 0002670C* THEN NO FIELD INFORMATION IS PRINTED FM030 02680C* FM030 02690C********************************************************************FM030 02700CSR OUTFLD BEGSR FM030 02710C* ********** FM030 02720CSR MOVE FN,X FL 20 FM030 02730CSR EP,X COMP 0 98 FM030 0002740CSR MOVELCP,X FC 20 FM030 02750CSR FC COMP FL 31 FM030 02760CSR 31 Z-ADDFC FL FM030 02770CSR FC SUB FL CC 20 FM030 02780CSR CC ADD 1 CC FM030 02790CSR MOVELCP,X BUFFER FM030 02800CSR MOVELCC BUFFER FM030 0002810CSR EXSR POSCUR FM030 02820C* ********** FM030 02830CSR MOVELBLANKS BUFFER FM030 02840CSR MOVELFN,X FIELDN FM030 02850CSR MOVE ' ' FIELDN FM030 02860CSR MOVELFIELDN BUFFER FM030 02870CSR Z-ADDLN,X LEN 20 FM030 0002880CSR LEN COMP 0 9730 FM030 02890CSR 97 Z-SUBLN,X LEN FM030 02900CSR 30 GOTO SKIPF FM030 02910C* ********** FM030 02920CSR FL ADD 2 BPOS 20 FM030 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS FM030 02940CSR Z-ADDBPOS TSTRT 30 FM030 0002950CSRN98 Z-ADD1 SSTRT 30 FM030 02960CSR 98 Z-ADD3 SSTRT FM030 02970CSR Z-ADD1 NCHARS 30 FM030 02980C* ********** FM030 02990CSR EXIT SUBRLM FM030 03000CSR RLABL TEMP4 FM030 03010CSR RLABL SSTRT 30 FM030 0003020CSR RLABL BUFFER FM030 03030CSR RLABL TSTRT 30 FM030 03040CSR RLABL NCHARS 30 FM030 03050CSR BPOS ADD 1 FPOS 20 FM030 03060CSR EXSR MVRECD FM030 03070C* ********** FM030 03080CSR SKIPF TAG FM030 0003090C* ********** FM030 03100CSR 30 Z-ADDFL BLNGTH FM030 03110CSRN30 FL ADD 3 BLNGTH FM030 03120CSRN30 BLNGTH ADD LEN BLNGTH FM030 03130CSR MOVE 'T' TYPE FM030 03140CSR EXSR CRTCOM FM030 03150C* ********** FM030 0003160CSR ENDSR FM030 03170C********************************************************************FM030 03180C* FM030 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN FM030 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST FM030 03210C* THE RIGHT BRACKET. FM030 03220C********************************************************************FM030 0003230CSR MVRECD BEGSR FM030 03240C* ********** FM030 03250CSR 63 GOTO RBRK FM030 03260C* ********** FM030 03270CSR 98 Z-SUBEP,X END 40 FM030 03280CSRN98 Z-ADDEP,X END FM030 03290CSR END SUB LEN STRT 40 81 81 FM030 0003300CSR STRT ADD 1 STRT FM030 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER FM030 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER FM030 03330CSR Z-ADDLEN NCHARS FM030 03340CSR Z-ADDSTRT SSTRT FM030 03350CSR Z-ADDFPOS TSTRT FM030 03360CSRN81 GOTO RBRK FM030 0003370C* ********** FM030 03380CSR EXIT SUBRLM FM030 03390CSR RLABL RECORD FM030 03400CSR RLABL SSTRT 30 FM030 03410CSR RLABL BUFFER FM030 03420CSR RLABL TSTRT 30 FM030 03430CSR RLABL NCHARS 30 FM030 0003440CSR RBRK TAG FM030 03450C* ********** FM030 03460CSR EXSR RTBRKT FM030 03470C* ********** FM030 03480CSR ENDSR FM030 03490C********************************************************************FM030 03500C* FM030 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS FM030 03520C* FM030 03530C********************************************************************FM030 03540CSR RTBRKT BEGSR FM030 03550C* ********** FM030 03560CSR LEN ADD FPOS FPOS FM030 03570CSR Z-ADDFPOS TSTRT FM030 0003580CSR Z-ADD1 NCHARS FM030 03590CSRN98 Z-ADD2 SSTRT FM030 03600CSR 98 Z-ADD4 SSTRT FM030 03610C* ********** FM030 03620CSR EXIT SUBRLM FM030 03630CSR RLABL TEMP4 FM030 03640CSR RLABL SSTRT 30 FM030 0003650CSR RLABL BUFFER FM030 03660CSR RLABL TSTRT 30 FM030 03670CSR RLABL NCHARS 30 FM030 03680CSR ENDSR FM030 03690C********************************************************************FM030 03700C* FM030 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. FM030 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO FM030 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF FM030 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST FM030 03750C* OF THE FIELDS ARE LEFT UNCHANGED FM030 03760C* FM030 03770C********************************************************************FM030 03780CSR UPDATE BEGSR FM030 0003790C* ********** FM030 03800CSR SETOF 32 FM030 03810CSR Z-ADD1 X FM030 03820CSR UPLOOP TAG FM030 03830C* ********** FM030 03840CSR EP,X COMP 0 98 FM030 03850CSR 98 SETON 30 FM030 0003860CSR 98 GOTO NOUPD FM030 03870C* ********** FM030 03880CSR Z-ADDLN,X LEN FM030 03890CSR LEN COMP 0 9730 FM030 03900CSR 97 Z-SUBLEN LEN FM030 03910CSR NOUPD TAG FM030 03920C* ********** FM030 0003930CSR 30N32 GOTO INCR FM030 03940C* ********** FM030 03950CSR 30 GOTO CHKRUB FM030 03960C* ********** FM030 03970CSR SETOF 3233 FM030 03980CSR EXSR ACCEPT FM030 03990C* ********** FM030 0004000CSR CHKRUB TAG FM030 04010C* ********** FM030 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTFM030 04030CSR 32 31 GOTO UPLOOP FM030 04040C* ********** FM030 04050CSR 32 GOTO ENDUPD FM030 04060C* ********** FM030 0004070CSR MOVELBUFFER ATSIGN 1 FM030 04080CSR ATSIGN COMP '@' 35 FM030 04090CSR 35 GOTO OUTREC FM030 04100C* ********** FM030 04110CSR 33 GOTO INCR WAS LINE FEED FM030 04120C* ********** FM030 04130CSR Z-ADDEP,X END FM030 0004140CSR END SUB LEN STRT 81 81 FM030 04150CSR STRT ADD 1 STRT FM030 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF FM030 04170C* BUFFER TO THE STRT OF RECORD FM030 04180CSR Z-ADD1 SSTRT FM030 04190CSR Z-ADDSTRT TSTRT FM030 04200CSR Z-ADDLEN NCHARS FM030 0004210CSRN81 GOTO AAA FM030 04220C* ********** FM030 04230CSR EXIT SUBRLM FM030 04240CSR RLABL BUFFER FM030 04250CSR RLABL SSTRT 30 FM030 04260CSR RLABL RECORD FM030 04270CSR RLABL TSTRT 30 FM030 0004280CSR RLABL NCHARS 30 FM030 04290CSR AAA TAG FM030 04300CSR MOVELBUFFER TEMP5 5 FM030 04310CSR MOVELSAVPOS BUFFER FM030 04320CSR EXSR POSCUR FM030 04330C* ********** FM030 04340CSR MOVELTEMP5 BUFFER FM030 0004350CSR Z-ADD1 FPOS FM030 04360CSR EXSR RTBRKT FM030 04370C* ********** FM030 04380CSR LEN ADD 1 BLNGTH FM030 04390CSR MOVE 'T' TYPE FM030 04400CSR EXSR CRTCOM FM030 04410C* ********** FM030 0004420CSR INCR TAG FM030 04430C* ********** FM030 04440CSR X ADD 1 X FM030 04450CSR X COMP NOFLDS 30 FM030 04460CSR 30 GOTO UPLOOP FM030 04470C* ********** FM030 04480CSR OUTREC TAG FM030 0004490C* ********** FM030 04500CSR SETON 80 FM030 04510CSRN61 EXCPT FM030 04520CSR SETOF 80 FM030 04530CSR ENDUPD TAG FM030 04540C* ********** FM030 04550CSR ENDSR FM030 0004560C********************************************************************FM030 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE FM030 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X FM030 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND FM030 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT FM030 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED FM030 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS FM030 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS FM030 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO FM030 04650C* TO BE OUTPUT TO THE SCREEN. FM030 04660C* FM030 04670C********************************************************************FM030 04680CSR ACCEPT BEGSR FM030 04690C* ********** FM030 0004700CSR X COMP 1 30 FM030 04710CSRN30 X COMP SSIZE 30 FM030 04720CSR 30 Z-ADD1 X FM030 04730CSR MOVELCP,X FC FM030 04740CSR FC ADD 3 FC FM030 04750CSR MOVELCP,X SAVPOS 4 FM030 04760CSR MOVELFC SAVPOS FM030 0004770CSR Z-ADDLN,X LEN FM030 04780CSR LEN COMP 0 97 FM030 04790CSR 97 Z-SUBLEN LEN FM030 04800CSR LEN ADD FC OFC 20 FM030 04810CSR ACLOOP TAG FM030 04820C* ********** FM030 04830CSR MOVELSAVPOS BUFFER FM030 0004840CSR EXSR POSCUR FM030 04850C* ********** FM030 04860CSR Z-ADDLEN BLNGTH FM030 04870CSR MOVE BLANKS BUFFER FM030 04880CSR MOVE 'A' TYPE FM030 04890CSR EXSR CRTCOM FM030 04900C* ********** FM030 0004910CSR RCODE COMP 'R' 31 FM030 04920CSR 31 BUFFER COMP BLANKS 32 FM030 04930CSR 31 32N62 GOTO DUPIT FM030 04940C* ********** FM030 04950CSR 31 GOTO ACLOOP FM030 04960C* ********** FM030 04970CSR RCODE COMP 'L' 33 FM030 0004980CSR 33 GOTO DUPIT FM030 04990C* ********** FM030 05000CSRN97 GOTO ENDACC FM030 05010C* ********** FM030 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK FM030 05030CSR SIGN COMP '@' 30 FM030 05040CSR 30 GOTO ENDACC FM030 0005050C* ********** FM030 05060CSR Z-ADDLEN VL 20 FM030 05070CSR MOVELBUFFER VAR 15 FM030 05080CSR EXSR RTADJ FM030 05090C* ********** FM030 05100CSR MOVELVAR BUFFER FM030 05110CSR GOTO ENDACC FM030 0005120C* ********** FM030 05130CSR DUPIT TAG FM030 05140C* ********** FM030 05150CSR MOVELSAVPOS BUFFER FM030 05160CSR EXSR POSCUR FM030 05170C* ********** FM030 05180CSR 62 MOVELSECTON BUFFER FM030 0005190CSRN62 Z-ADD1 FPOS FM030 05200CSRN62 EXSR MVRECD FM030 05210C* ********** FM030 05220CSR MOVE 'T' TYPE FM030 05230CSR BLNGTH ADD 1 BLNGTH FM030 05240CSR EXSR CRTCOM FM030 05250C* ********** FM030 0005260CSR ENDACC ENDSR FM030 05270C* ********** FM030 05280C********************************************************************FM030 05290C* FM030 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES FM030 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM FM030 05320C* 4 DUMMY FOR RTADJ FM030 0005330C* FM030 05340C********************************************************************FM030 05350CSR POSCUR BEGSR FM030 05360C* ********** FM030 05370CSR MOVE 'P' TYPE FM030 05380CSR EXSR CRTCOM FM030 05390C* ********** FM030 0005400CSR ENDSR FM030 05410C********************************************************************FM030 05420CSR CLRSCR BEGSR FM030 05430C* ********** FM030 05440CSR MOVE 'C' TYPE FM030 05450CSR EXSR CRTCOM FM030 05460C* ********** FM030 0005470CSR ENDSR FM030 05480C********************************************************************FM030 05490CSR CRTCOM BEGSR FM030 05500C* ********** FM030 05510CSR EXITFSUBRCM FM030 05520CSR RLABL BUFFER 72 FM030 05530CSR RLABL TYPE 1 FM030 0005540CSR RLABL BLNGTH 20 FM030 05550CSR RLABL RCODE 1 FM030 05560CSR RLABL MASK 10 FM030 05570CSR RLABL DTYPE 10 FM030 05580CSR ENDSR FM030 05590C********************************************************************FM030 05600CSR RTADJ BEGSR FM030 0005610C* ********** FM030 05620CSR EXIT SUBRAJ FM030 05630C* ********** FM030 05640CSR RLABL VL FM030 05650CSR RLABL VAR FM030 05660CSR ENDSR FM030 05670C********************************************************************FM030 0005680OLABMST E 80N55 FM030 05690O RECORD 0048 FM030 05700O E 40N80 FM030 05710O FF 30 FM030 05720O EADD 80 55 FM030 05730O RECORD 0048 FM030 ** 00574000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005750ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005760ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005770ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005780/* 005790__0O RECORD 0048 FM030 ** 0057400(U G$TXFM032 P999999111111(000010H S FM032 00020X DECK-ID M04 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM032 00030F* PRINTS ALL RECORDS NOT FLAGGED FOR DELETION ON LABMST FILE FM032 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM032 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM032 00060F* CONTROL DATA PROPRIETARY PRODUCT FM032 00070F* FM032 0000080FLABMST IPEAF 48 2AI 1 DISK FM032 00090FHEADING IT F 40 EDISK FM032 00100F$LP1 O F 132 OF PRINTER FM032 00110F********************************************************************FM032 00120F* FM032 00130F* COMPANY FM032 00140F* SYSTEM FILE MAINTENANCE FM032 0000150F* PROGRAM LISTS LABMST RECORDS THAT AREN'T FLAGGED FOR FM032 00160F* DELETION AND COUNTS THEM FM032 00170F* FM032 00180F* CONTRACTOR COMPUSOURCE FM032 00190F* PROGRAMMER FM032 00200F* DATE FM032 00210F* FM032 0000220F********************************************************************FM032 00230F* FM032 00240F* ID F C H L FUNCTION OF INDICATORS FM032 00250F* FM032 00260F* 01 FM032 00270F* 02 FM032 00280F* FM032 0000290F********************************************************************FM032 00300E HEADING HEAD 1 1 40 COMPANY NAME FM032 00310ILABMST NS 01 30 C FM032 00320I 1 2 GRADE FM032 00330I 3 22 DESCR FM032 00340I 23 293RATE FM032 00350I 31 341FACTOR FM032 0000360I NS 02 FM032 00370I 1 1 AIR FM032 00380C 01 COUNT ADD 1 COUNT 40 FM032 00390O$LP1 H 202 1P FM032 00400O OR OF FM032 00410O PAGE Z 10 FM032 00420O 4 'PAGE' FM032 0000430O HEAD,1 85 FM032 00440O UDATE Y 132 FM032 00450O H 2 1P FM032 00460O OR OF FM032 00470O 71 'LABOR GRADE MASTER FILE' FM032 00480O 79 'LISTING' FM032 00490O 132 'MFG032' FM032 0000500O H 2 1P FM032 00510O OR OF FM032 00520O 11 'LABOR GRADE' FM032 00530O 24 'DESCRIPTION' FM032 00540O 52 'LABOR RATE [$/HR]' FM032 00550O 67 'BURDEN FACTOR' FM032 00560O D 1 01 FM032 0000570O GRADE 2 FM032 00580O DESCR 33 FM032 00590O RATE 3 52 FM032 00600O FACTORL 68 FM032 00610O T 3 LR FM032 00620O 22 'END OF JOB. THERE ARE' FM032 00630O COUNT Z 27 FM032 0000640O 49 'ACTIVE RECORDS IN THE' FM032 00650O 74 'LABOR GRADE MASTER FILE.' FM032 ** 000660ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000670ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000680ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000690ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00070000/* 000710__0O 74 'LABOR GRADE MASTER FILE.' FM032 ** 000660ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000670ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000680ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000690ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0007000(X DTXFM050 P999999111111(000010H S FM050 00020X DECK-ID M05 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM050 00030F* INQUIRY/MAINTENANCE OF VENDOR MASTER FILE (VENDOR) FM050 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM050 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM050 00060F* CONTROL DATA PROPRIETARY PRODUCT FM050 00070F* FM050 0000080FNULL IPEAF 72 DISK FM050 00090F@MFG50 IC F 32R DISK FM050 00100FVENDOR UC F 0256R05AI 0001 DISK A FM050 00110E FN 025 22 FIELD NAME FM050 00120E CP 025 4 CURSOR POSITION FM050 00130E LN 025 2 0 LENGTH FM050 00140E EP 025 4 0 ENDING POSITION FM050 0000150INULL NS 01 FM050 00160I 1 1 A FM050 00170I@MFG50 NS 02 FM050 00180I 1 22 FIELDN FM050 00190I 23 26 CURPOS FM050 00200I 27 280LNGTH FM050 00210I 29 310ENDPOS FM050 0000220IVENDOR NS 03 FM050 00230I 10256 RECORD FM050 00240C MOVE ' ' RCODE 1 FM050 00250C MOVE RCODE B22 22 FM050 00260C MOVE RCODE BLANKS 72 FM050 00270C MOVE RCODE FILLER 1 FM050 00280C Z-ADD0 MASK 10 FM050 0000290C SETON LR FM050 00300CLR Z-ADD025 SSIZE 30 FM050 00310CLR Z-ADD003 NSECT 30 FM050 00320CLR MOVEL'D' FF 1 FM050 00330CLR MOVE '[]<>' TEMP4 4 FM050 00340CLR START TAG FM050 00350C* ********** FM050 0000360CLR EXSR FIRSTP FM050 00370C* ********** FM050 00380CLR EXSR CLRSCR FM050 00390C* ********** FM050 00400CLR 40 GOTO EOJ FM050 00410C* ********** FM050 00420CLR Z-ADD2 VL FM050 0000430CLR MOVELSECTON VAR FM050 00440CLR EXSR RTADJ FM050 00450C* ********** FM050 00460CLR MOVELVAR SECTN 20 FM050 00470CLR EXSR GETSEC FM050 00480C* ********** FM050 00490CLRN45 GOTO START FM050 0000500C* ********** FM050 00510CLR EXSR CLRSCR FM050 00520C* ********** FM050 00530CLR EXSR OUTPUT FM050 00540C* ********** FM050 00550CLR EXSR UPDATE FM050 00560C* ********** FM050 0000570CLR GOTO START FM050 00580C* ********** FM050 00590CLR EOJ TAG FM050 00600C* ********** FM050 00610C********************************************************************FM050 00620C* FM050 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND FM050 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. FM050 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDFM050 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN FM050 00670C* FM050 00680C********************************************************************FM050 00690CSR FIRSTP BEGSR FM050 00700C* ********** FM050 0000710CSR EXSR CLRSCR FM050 00720C* ********** FM050 00730CSR Z-ADD0 SECTN FM050 00740CSR EXSR GETSEC FM050 00750C* ********** FM050 00760CSR PGE TAG FM050 00770C* ********** FM050 0000780CSR SETON 61 FM050 00790CSR SETOF 62 FM050 00800CSR EXSR OUTPUT FM050 00810C* ********** FM050 00820C* ********** FM050 00830CSR EXIT SUBRFL FM050 00840CSR RLABL RECORD FM050 0000850CSR RLABL FILLER 1 FM050 00860C* ********** FM050 00870C* ********** FM050 00880C* ********** FM050 00890C* ********** FM050 00900C* ********** FM050 00910C* ********** FM050 0000920C* ********** FM050 00930C* ********** FM050 00940C* ********** FM050 00950C* ********** FM050 00960C* ********** FM050 00970C* ********** FM050 00980C* ********** FM050 0000990C* ********** FM050 01000C* ********** FM050 01010CSR Z-ADD05 NCHARS FM050 01020CSR Z-ADD1 SSTRT FM050 01030CSR Z-ADD1 TSTRT FM050 01040C* ********** FM050 01050CSR EXIT SUBRLM FM050 0001060CSR RLABL KEY 05 FM050 01070CSR RLABL SSTRT 30 FM050 01080CSR RLABL RECORD FM050 01090CSR RLABL TSTRT 30 FM050 01100CSR RLABL NCHARS 30 FM050 01110CSR Z-ADDNOFLDS SVFLDS 30 FM050 01120CSR Z-ADDSX NOFLDS FM050 0001130CSR EXSR UPDATE FM050 01140C* ********** FM050 01150CSR Z-ADDSVFLDS NOFLDS FM050 01160CSR Z-ADD05 NCHARS FM050 01170CSR Z-ADD1 SSTRT FM050 01180CSR Z-ADD1 TSTRT FM050 01190C* ********** FM050 0001200CSR EXIT SUBRLM FM050 01210CSR RLABL RECORD FM050 01220CSR RLABL SSTRT 30 FM050 01230CSR RLABL KEY FM050 01240CSR RLABL TSTRT 30 FM050 01250CSR RLABL NCHARS 30 FM050 01260CSR KEY CHAINVENDOR 55 FM050 0001270CSR MOVELSAVPOS BUFFER FM050 01280CSR MOVELOFC BUFFER FM050 01290CSR EXSR POSCUR FM050 01300C* ********** FM050 01310CSR MOVEL'] NEW R'WORD16 16 FM050 01320CSR MOVE 'ECORD 'WORD16 FM050 01330CSRN55 MOVELBLANKS WORD16 FM050 0001340CSRN55 MOVEL']' WORD16 FM050 01350CSR MOVELWORD16 BUFFER 72 FM050 01360CSR MOVE 'T' TYPE 1 FM050 01370CSR Z-ADD13 BLNGTH 20 FM050 01380CSR EXSR CRTCOM FM050 01390C* ********** FM050 01400CSR SETON 62 FM050 0001410CSR Z-ADDSX X 30 FM050 01420CSR EXSR ACCEPT FM050 01430C* ********** FM050 01440CSR MOVELBUFFER SECTON 2 FM050 01450CSR SECTON COMP 'E ' 40 FM050 01460CSR 40 GOTO ENDFP FM050 01470C* ********** FM050 0001480CSR SECTON COMP 'D ' 40 FM050 01490CSR 40N55 EXCPT FM050 01500CSR 40 GOTO PGE FM050 01510C* ********** FM050 01520CSR SECTON COMP ' 1' 30 30 FM050 01530CSR 30 SECTON COMP ' 9' 3030 FM050 01540CSR 30 GOTO GOOD FM050 0001550C* ********** FM050 01560CSR SECTON COMP '01' 30 30 FM050 01570CSR 30 SECTON COMP '09' 3030 FM050 01580CSR 30 GOTO GOOD FM050 01590C* ********** FM050 01600CSR SECTON COMP '1 ' 30 30 FM050 01610CSR 30 SECTON COMP '9 ' 3030 FM050 0001620CSR 30 GOTO GOOD FM050 01630C* ********** FM050 01640CSR MOVELSECTON TEMP1 1 FM050 01650CSR TEMP1 COMP '1' 30 30 FM050 01660CSR 30 TEMP1 COMP '9' 3030 FM050 01670CSRN30 GOTO PGE FM050 01680C* ********** FM050 0001690CSR MOVE SECTON TEMP1 FM050 01700CSR TEMP1 COMP '0' 30 30 FM050 01710CSR 30 TEMP1 COMP '9' 3030 FM050 01720CSRN30 GOTO PGE FM050 01730C* ********** FM050 01740CSR GOOD TAG FM050 01750C* ********** FM050 0001760CSR SETOF 6162 FM050 01770CSRN55 GOTO ENDFP FM050 01780C* ********** FM050 01790CSR SETON 80 FM050 01800CSR EXCPT FM050 01810CSR SETOF 80 FM050 01820CSR KEY CHAINVENDOR 55 FM050 0001830CSR ENDFP ENDSR FM050 01840C* ********** FM050 01850C********************************************************************FM050 01860C* FM050 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. FM050 01880C* FM050 01890C********************************************************************FM050 0001900CSR GETSEC BEGSR FM050 01910C* ********** FM050 01920CSR 1 ADD SECTN N 20 FM050 01930CSR SETOF 404145 FM050 01940CSR N COMP 0 3030 FM050 01950CSRN30 N COMP NSECT 30 FM050 01960CSR 30 GOTO ENDGET FM050 0001970C* ********** FM050 01980CSR SECTN MULT SSIZE RRN 40 FM050 01990CSR Z-ADD1 X FM050 02000CSR SCLOOP TAG FM050 02010C* ********** FM050 02020CSR RRN ADD 1 RRN FM050 02030CSR RRN CHAIN@MFG50 50 FM050 0002040CSR 50 GOTO ENDGET FM050 02050C* ********** FM050 02060CSR FIELDN COMP B22 4141 FM050 02070CSRN41 GOTO ENDGET FM050 02080C* ********** FM050 02090CSR 41N45 SETON 45 FM050 02100CSR MOVE FIELDN FN,X FM050 0002110CSR MOVE CURPOS CP,X FM050 02120CSR MOVE LNGTH LN,X FM050 02130CSR Z-ADDENDPOS EP,X FM050 02140CSR 1 ADD X X FM050 02150CSR X COMP SSIZE 32 FM050 02160CSRN32 GOTO SCLOOP FM050 02170C* ********** FM050 0002180CSR ENDGET TAG FM050 02190C* ********** FM050 02200CSR Z-ADDX NOFLDS 30 FM050 02210CSR 45 GOTO FINGET FM050 02220C* ********** FM050 02230CSR EXSR CLRSCR FM050 02240C* ********** FM050 0002250CSR MOVEL'SECT # 'WORD9 9 FM050 02260CSR Z-ADD16 BLNGTH FM050 02270CSR MOVE SECTN WORD9 FM050 02280CSR MOVELWORD9 WORD16 FM050 02290CSRN30 MOVE ' ABSENT' WORD16 FM050 02300CSR 30 MOVE ' ILLEG.' WORD16 FM050 02310CSR MOVELWORD16 BUFFER FM050 0002320CSR MOVEL'T' TYPE FM050 02330CSR EXSR CRTCOM FM050 02340C* ********** FM050 02350CSR FINGET ENDSR FM050 02360C* ********** FM050 02370C********************************************************************FM050 02380C* FM050 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE FM050 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE FM050 02410C* SECTION INDEX IS SAVED. FM050 02420C* FM050 02430C********************************************************************FM050 02440CSR OUTPUT BEGSR FM050 02450C* ********** FM050 0002460CSR EXSR CLRSCR FM050 02470C* ********** FM050 02480CSR Z-ADD1 X FM050 02490CSR 61 SETON 63 FM050 02500CSR OTLOOP TAG FM050 02510C* ********** FM050 02520CSR 61 LN,X COMP 0 31 FM050 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXFM050 02540CSR EXSR OUTFLD FM050 02550C* ********** FM050 02560CSR X ADD 1 X FM050 02570CSR X COMP NOFLDS 31 FM050 02580CSR 31 GOTO OTLOOP FM050 02590C* ********** FM050 0002600CSR SETOF 63 FM050 02610CSR ENDSR FM050 02620C********************************************************************FM050 02630C* FM050 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND FM050 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 FM050 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS FM050 0002670C* THEN NO FIELD INFORMATION IS PRINTED FM050 02680C* FM050 02690C********************************************************************FM050 02700CSR OUTFLD BEGSR FM050 02710C* ********** FM050 02720CSR MOVE FN,X FL 20 FM050 02730CSR EP,X COMP 0 98 FM050 0002740CSR MOVELCP,X FC 20 FM050 02750CSR FC COMP FL 31 FM050 02760CSR 31 Z-ADDFC FL FM050 02770CSR FC SUB FL CC 20 FM050 02780CSR CC ADD 1 CC FM050 02790CSR MOVELCP,X BUFFER FM050 02800CSR MOVELCC BUFFER FM050 0002810CSR EXSR POSCUR FM050 02820C* ********** FM050 02830CSR MOVELBLANKS BUFFER FM050 02840CSR MOVELFN,X FIELDN FM050 02850CSR MOVE ' ' FIELDN FM050 02860CSR MOVELFIELDN BUFFER FM050 02870CSR Z-ADDLN,X LEN 20 FM050 0002880CSR LEN COMP 0 9730 FM050 02890CSR 97 Z-SUBLN,X LEN FM050 02900CSR 30 GOTO SKIPF FM050 02910C* ********** FM050 02920CSR FL ADD 2 BPOS 20 FM050 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS FM050 02940CSR Z-ADDBPOS TSTRT 30 FM050 0002950CSRN98 Z-ADD1 SSTRT 30 FM050 02960CSR 98 Z-ADD3 SSTRT FM050 02970CSR Z-ADD1 NCHARS 30 FM050 02980C* ********** FM050 02990CSR EXIT SUBRLM FM050 03000CSR RLABL TEMP4 FM050 03010CSR RLABL SSTRT 30 FM050 0003020CSR RLABL BUFFER FM050 03030CSR RLABL TSTRT 30 FM050 03040CSR RLABL NCHARS 30 FM050 03050CSR BPOS ADD 1 FPOS 20 FM050 03060CSR EXSR MVRECD FM050 03070C* ********** FM050 03080CSR SKIPF TAG FM050 0003090C* ********** FM050 03100CSR 30 Z-ADDFL BLNGTH FM050 03110CSRN30 FL ADD 3 BLNGTH FM050 03120CSRN30 BLNGTH ADD LEN BLNGTH FM050 03130CSR MOVE 'T' TYPE FM050 03140CSR EXSR CRTCOM FM050 03150C* ********** FM050 0003160CSR ENDSR FM050 03170C********************************************************************FM050 03180C* FM050 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN FM050 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST FM050 03210C* THE RIGHT BRACKET. FM050 03220C********************************************************************FM050 0003230CSR MVRECD BEGSR FM050 03240C* ********** FM050 03250CSR 63 GOTO RBRK FM050 03260C* ********** FM050 03270CSR 98 Z-SUBEP,X END 40 FM050 03280CSRN98 Z-ADDEP,X END FM050 03290CSR END SUB LEN STRT 40 81 81 FM050 0003300CSR STRT ADD 1 STRT FM050 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER FM050 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER FM050 03330CSR Z-ADDLEN NCHARS FM050 03340CSR Z-ADDSTRT SSTRT FM050 03350CSR Z-ADDFPOS TSTRT FM050 03360CSRN81 GOTO RBRK FM050 0003370C* ********** FM050 03380CSR EXIT SUBRLM FM050 03390CSR RLABL RECORD FM050 03400CSR RLABL SSTRT 30 FM050 03410CSR RLABL BUFFER FM050 03420CSR RLABL TSTRT 30 FM050 03430CSR RLABL NCHARS 30 FM050 0003440CSR RBRK TAG FM050 03450C* ********** FM050 03460CSR EXSR RTBRKT FM050 03470C* ********** FM050 03480CSR ENDSR FM050 03490C********************************************************************FM050 03500C* FM050 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS FM050 03520C* FM050 03530C********************************************************************FM050 03540CSR RTBRKT BEGSR FM050 03550C* ********** FM050 03560CSR LEN ADD FPOS FPOS FM050 03570CSR Z-ADDFPOS TSTRT FM050 0003580CSR Z-ADD1 NCHARS FM050 03590CSRN98 Z-ADD2 SSTRT FM050 03600CSR 98 Z-ADD4 SSTRT FM050 03610C* ********** FM050 03620CSR EXIT SUBRLM FM050 03630CSR RLABL TEMP4 FM050 03640CSR RLABL SSTRT 30 FM050 0003650CSR RLABL BUFFER FM050 03660CSR RLABL TSTRT 30 FM050 03670CSR RLABL NCHARS 30 FM050 03680CSR ENDSR FM050 03690C********************************************************************FM050 03700C* FM050 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. FM050 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO FM050 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF FM050 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST FM050 03750C* OF THE FIELDS ARE LEFT UNCHANGED FM050 03760C* FM050 03770C********************************************************************FM050 03780CSR UPDATE BEGSR FM050 0003790C* ********** FM050 03800CSR SETOF 32 FM050 03810CSR Z-ADD1 X FM050 03820CSR UPLOOP TAG FM050 03830C* ********** FM050 03840CSR EP,X COMP 0 98 FM050 03850CSR 98 SETON 30 FM050 0003860CSR 98 GOTO NOUPD FM050 03870C* ********** FM050 03880CSR Z-ADDLN,X LEN FM050 03890CSR LEN COMP 0 9730 FM050 03900CSR 97 Z-SUBLEN LEN FM050 03910CSR NOUPD TAG FM050 03920C* ********** FM050 0003930CSR 30N32 GOTO INCR FM050 03940C* ********** FM050 03950CSR 30 GOTO CHKRUB FM050 03960C* ********** FM050 03970CSR SETOF 3233 FM050 03980CSR EXSR ACCEPT FM050 03990C* ********** FM050 0004000CSR CHKRUB TAG FM050 04010C* ********** FM050 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTFM050 04030CSR 32 31 GOTO UPLOOP FM050 04040C* ********** FM050 04050CSR 32 GOTO ENDUPD FM050 04060C* ********** FM050 0004070CSR MOVELBUFFER ATSIGN 1 FM050 04080CSR ATSIGN COMP '@' 35 FM050 04090CSR 35 GOTO OUTREC FM050 04100C* ********** FM050 04110CSR 33 GOTO INCR WAS LINE FEED FM050 04120C* ********** FM050 04130CSR Z-ADDEP,X END FM050 0004140CSR END SUB LEN STRT 81 81 FM050 04150CSR STRT ADD 1 STRT FM050 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF FM050 04170C* BUFFER TO THE STRT OF RECORD FM050 04180CSR Z-ADD1 SSTRT FM050 04190CSR Z-ADDSTRT TSTRT FM050 04200CSR Z-ADDLEN NCHARS FM050 0004210CSRN81 GOTO AAA FM050 04220C* ********** FM050 04230CSR EXIT SUBRLM FM050 04240CSR RLABL BUFFER FM050 04250CSR RLABL SSTRT 30 FM050 04260CSR RLABL RECORD FM050 04270CSR RLABL TSTRT 30 FM050 0004280CSR RLABL NCHARS 30 FM050 04290CSR AAA TAG FM050 04300CSR MOVELBUFFER TEMP5 5 FM050 04310CSR MOVELSAVPOS BUFFER FM050 04320CSR EXSR POSCUR FM050 04330C* ********** FM050 04340CSR MOVELTEMP5 BUFFER FM050 0004350CSR Z-ADD1 FPOS FM050 04360CSR EXSR RTBRKT FM050 04370C* ********** FM050 04380CSR LEN ADD 1 BLNGTH FM050 04390CSR MOVE 'T' TYPE FM050 04400CSR EXSR CRTCOM FM050 04410C* ********** FM050 0004420CSR INCR TAG FM050 04430C* ********** FM050 04440CSR X ADD 1 X FM050 04450CSR X COMP NOFLDS 30 FM050 04460CSR 30 GOTO UPLOOP FM050 04470C* ********** FM050 04480CSR OUTREC TAG FM050 0004490C* ********** FM050 04500CSR SETON 80 FM050 04510CSRN61 EXCPT FM050 04520CSR SETOF 80 FM050 04530CSR ENDUPD TAG FM050 04540C* ********** FM050 04550CSR ENDSR FM050 0004560C********************************************************************FM050 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE FM050 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X FM050 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND FM050 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT FM050 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED FM050 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS FM050 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS FM050 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO FM050 04650C* TO BE OUTPUT TO THE SCREEN. FM050 04660C* FM050 04670C********************************************************************FM050 04680CSR ACCEPT BEGSR FM050 04690C* ********** FM050 0004700CSR X COMP 1 30 FM050 04710CSRN30 X COMP SSIZE 30 FM050 04720CSR 30 Z-ADD1 X FM050 04730CSR MOVELCP,X FC FM050 04740CSR FC ADD 3 FC FM050 04750CSR MOVELCP,X SAVPOS 4 FM050 04760CSR MOVELFC SAVPOS FM050 0004770CSR Z-ADDLN,X LEN FM050 04780CSR LEN COMP 0 97 FM050 04790CSR 97 Z-SUBLEN LEN FM050 04800CSR LEN ADD FC OFC 20 FM050 04810CSR ACLOOP TAG FM050 04820C* ********** FM050 04830CSR MOVELSAVPOS BUFFER FM050 0004840CSR EXSR POSCUR FM050 04850C* ********** FM050 04860CSR Z-ADDLEN BLNGTH FM050 04870CSR MOVE BLANKS BUFFER FM050 04880CSR MOVE 'A' TYPE FM050 04890CSR EXSR CRTCOM FM050 04900C* ********** FM050 0004910CSR RCODE COMP 'R' 31 FM050 04920CSR 31 BUFFER COMP BLANKS 32 FM050 04930CSR 31 32N62 GOTO DUPIT FM050 04940C* ********** FM050 04950CSR 31 GOTO ACLOOP FM050 04960C* ********** FM050 04970CSR RCODE COMP 'L' 33 FM050 0004980CSR 33 GOTO DUPIT FM050 04990C* ********** FM050 05000CSRN97 GOTO ENDACC FM050 05010C* ********** FM050 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK FM050 05030CSR SIGN COMP '@' 30 FM050 05040CSR 30 GOTO ENDACC FM050 0005050C* ********** FM050 05060CSR Z-ADDLEN VL 20 FM050 05070CSR MOVELBUFFER VAR 15 FM050 05080CSR EXSR RTADJ FM050 05090C* ********** FM050 05100CSR MOVELVAR BUFFER FM050 05110CSR GOTO ENDACC FM050 0005120C* ********** FM050 05130CSR DUPIT TAG FM050 05140C* ********** FM050 05150CSR MOVELSAVPOS BUFFER FM050 05160CSR EXSR POSCUR FM050 05170C* ********** FM050 05180CSR 62 MOVELSECTON BUFFER FM050 0005190CSRN62 Z-ADD1 FPOS FM050 05200CSRN62 EXSR MVRECD FM050 05210C* ********** FM050 05220CSR MOVE 'T' TYPE FM050 05230CSR BLNGTH ADD 1 BLNGTH FM050 05240CSR EXSR CRTCOM FM050 05250C* ********** FM050 0005260CSR ENDACC ENDSR FM050 05270C* ********** FM050 05280C********************************************************************FM050 05290C* FM050 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES FM050 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM FM050 05320C* 4 DUMMY FOR RTADJ FM050 0005330C* FM050 05340C********************************************************************FM050 05350CSR POSCUR BEGSR FM050 05360C* ********** FM050 05370CSR MOVE 'P' TYPE FM050 05380CSR EXSR CRTCOM FM050 05390C* ********** FM050 0005400CSR ENDSR FM050 05410C********************************************************************FM050 05420CSR CLRSCR BEGSR FM050 05430C* ********** FM050 05440CSR MOVE 'C' TYPE FM050 05450CSR EXSR CRTCOM FM050 05460C* ********** FM050 0005470CSR ENDSR FM050 05480C********************************************************************FM050 05490CSR CRTCOM BEGSR FM050 05500C* ********** FM050 05510C* ********** FM050 05520CSR EXITFSUBRCM FM050 05530CSR RLABL BUFFER 72 FM050 0005540CSR RLABL TYPE 1 FM050 05550CSR RLABL BLNGTH 20 FM050 05560CSR RLABL RCODE 1 FM050 05570CSR RLABL MASK 10 FM050 05580CSR RLABL DTYPE 10 FM050 05590CSR ENDSR FM050 05600C********************************************************************FM050 0005610CSR RTADJ BEGSR FM050 05620C* ********** FM050 05630CSR EXIT SUBRAJ FM050 05640C* ********** FM050 05650CSR RLABL VL FM050 05660CSR RLABL VAR FM050 05670CSR ENDSR FM050 0005680C********************************************************************FM050 05690OVENDOR E 80N55 FM050 05700O RECORD 0256 FM050 05710O E 40N80 FM050 05720O FF 106 FM050 05730O EADD 80 55 FM050 05740O RECORD 0256 FM050 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800__0O RECORD 0256 FM050 0(} }5TXFM052 P4f999999111111(000010H S FM052 00020X DECK-ID M06 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM052 00030F* PRINTS ALL RECORDS NOT FLAGGED FOR DELETION ON VENDOR FILE FM052 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM052 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM052 00060F* CONTROL DATA PROPRIETARY PRODUCT FM052 00070F* FM052 0000080FVENDOR IPEAF 256 5AI 1 DISK FM052 00090FHEADING IT F 40 EDISK FM052 00100F$LP1 O F 132 OF PRINTER FM052 00110F********************************************************************FM052 00120F* FM052 00130F* COMPANY FM052 00140F* SYSTEM FILE MAINTENANCE FM052 0000150F* PROGRAM LISTS OUT ACTIVE MEMBERS OF VENDOR MASTER FILE FM052 00160F* (WITH A COUNT) FM052 00170F* FM052 00180F* CONTRACTOR COMPUSOURCE FM052 00190F* PROGRAMMER FM052 00200F* DATE FM052 00210F* FM052 0000220F********************************************************************FM052 00230F* FM052 00240F* ID F C H L FUNCTION OF INDICATORS FM052 00250F* FM052 00260F* 01 VENDOR --- NON-DELETED RECORD [ACTIVE] FM052 00270F* 02 VENDOR --- DELETED RECORD FM052 00280F* 11 ADDRESS LINE 1 IS BLANK FM052 0000290F* 12 ADDRESS LINE 2 IS BLANK FM052 00300F* 13 ADDRESS LINE 3 IS BLANK FM052 00310F* FM052 00320F********************************************************************FM052 00330E HEADING HEAD 1 1 40 COMPANY NAME FM052 00340IVENDOR NS 01 106 C FM052 00350I 1 50VEND FM052 0000360I 6 30 NAME FM052 00370I 31 55 ADDRL1 11 FM052 00380I 56 80 ADDRL2 12 FM052 00390I 81 103 ADDRL3 13 FM052 00400I NS 02 FM052 00410I 1 1 AIR FM052 00420C 01 COUNT ADD 1 COUNT 40 FM052 0000430O$LP1 H 202 1P FM052 00440O OR OF FM052 00450O PAGE Z 8 FM052 00460O 4 'PAGE' FM052 00470O HEAD,1 86 FM052 00480O UDATE Y 132 FM052 00490O H 2 1P FM052 0000500O OR OF FM052 00510O 66 'VENDOR MASTER FILE' FM052 00520O 74 'LISTING' FM052 00530O 132 'MFG052' FM052 00540O H 2 1P FM052 00550O OR OF FM052 00560O 8 'VENDOR #' FM052 0000570O 21 'VENDOR NAME' FM052 00580O 44 'ADDRESS' FM052 00590O D 11 01 FM052 00600O VEND 8 FM052 00610O NAME 35 FM052 00620O N11 ADDRL1 62 FM052 00630O 11N12 ADDRL2 62 FM052 0000640O 11 12N13ADDRL3 60 FM052 00650O D 01 N11N12 FM052 00660O AD 01 FM052 00670O OR N11 12N13 FM052 00680O AD 01 FM052 00690O OR 11N12N13 FM052 00700O AD 01 FM052 0000710O N11N12 ADDRL2 62 FM052 00720O N11 12N13ADDRL3 60 FM052 00730O 11N12N13ADDRL3 60 FM052 00740O D 01 N11N12N13 FM052 00750O AD 01 FM052 00760O N11N12N13ADDRL3 60 FM052 00770O T 3 LR FM052 0000780O 22 'END OF JOB. THERE ARE' FM052 00790O COUNT Z 27 FM052 00800O 49 'ACTIVE RECORDS IN THE' FM052 00810O 69 'VENDOR MASTER FILE.' FM052 ** 000820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00084000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000850ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000860/* 000870_ 00 00 00 00 00 __ 0(d08 d*TXWP460 P&X999999042078(000010H S WP460 00020X DECK-ID P09 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP460 00030F* PRINTS WORKORDER STORTAGE REPORT BY WORKORDER NUMBER WP460 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP460 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP460 00060F* CONTROL DATA PROPRIETARY PRODUCT WP460 00070F* WP460 0000080FWOSHORT IPEAF 36 25AI 1 DISK WP460 00090FHEADING IT F 40 EDISK WP460 00100F$LP1 O F 132 OF PRINTER WP460 00110FPARTMST IC F 300R20AI 271 DISK WP460 00120FPRTWOS O F 36 25AI 1 DISK U U1 WP460 00130E HEADING HEAD 1 1 40 WP460 00140IWOSHORT NS 01 WP460 0000150I 1 50WONUM L1 WP460 00160I 6 25 PARTNO WP460 00170I 6 17 PRTNUM WP460 00180I 30 360QTY 15 WP460 00190IPARTMST NS 02 WP460 00200I 1 37 DESC WP460 00210I 38 39 UM WP460 0000220I 74 74 DCODE WP460 00230C PARTNO CHAINPARTMST 55 WP460 00240C N55 DCODE COMP 'D' 55 WP460 00250O$LP1 H 02 1P WP460 00260O OR OF WP460 00270O 4 'PAGE' WP460 00280O PAGE Z 8 WP460 0000290O HEAD 86 WP460 00300O 132 'JOB460' WP460 00310O H 1 1P WP460 00320O OR OF WP460 00330O 48 'RELEASED' WP460 00340O 73 'WORK ORDER SHORTAGE REPO' WP460 00350O 91 'RT - BY WORK ORDER' WP460 0000360O H 21 1P WP460 00370O OR OF WP460 00380O 19 'W.O.# PART NUMBER' WP460 00390O 44 'DESCRIPTION' WP460 00400O 77 'UM' WP460 00410O 91 'QTY SHORT' WP460 00420O D 1 L1 WP460 0000430O 1 ' ' WP460 00440O D 1 01 15 WP460 00450O WONUM 5 WP460 00460O PARTNO 28 WP460 00470O N55 DESC 70 WP460 00480O 55 56 'NOT ON PART MASTER FILE ' WP460 00490O N55 UM 77 WP460 0000500O QTY 1 91 WP460 00510OPRTWOS D 01 15 U1 WP460 00520O PARTNO 20 WP460 00530O WONUM 25 WP460 00540O QTY 36 WP460 ** 000550ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00056000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000570ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000580ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000590/* 000600_ 00 00 00 00 00 00 __ 0(U\ U$TXFM081 P999999111111(000010H S FM081 00020X DECK-ID M08 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM081 00030F* COPIES A TEMPORARY PURGED MASTER FILE TO THE MASTER FILE FM081 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM081 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM081 00060F* CONTROL DATA PROPRIETARY PRODUCT FM081 00070F* FM081 0000080FPAROUT IPEAF 300 DISK U1 FM081 00090FMACOUT ISEAF 48 DISK U2 FM081 00100FLABOUT ISEAF 48 DISK U3 FM081 00110FVENOUT ISEAF 256 DISK U4 FM081 00120FEMPOUT ISEAF 100 DISK U5 FM081 00130FPARTMST O F 300 20AI 271 DISK U U1 FM081 00140FMACHMST O F 48 5AI 1 DISK U U2 FM081 0000150FLABMST O F 48 2AI 1 DISK U U3 FM081 00160FVENDOR O F 256 5AI 1 DISK U U4 FM081 00170FEMPMST O F 100 5AI 1 DISK U U5 FM081 00180F********************************************************************FM081 00190F* FM081 00200F* COMPANY FM081 00210F* SYSTEM FILE MAINTENANCE FM081 0000220F* PROGRAM COPIES BACK A PURGED MASTER FILE FM081 00230F* FM081 00240F* CONTRACTOR COMPUSOURCE FM081 00250F* PROGRAMMER FM081 00260F* DATE FM081 00270F* FM081 00280F********************************************************************FM081 0000290F* FM081 00300F* U1 PARTMST FM081 00310F* U2 MACHMST FM081 00320F* U3 LABMST FM081 00330F* U4 VENDOR FM081 00340F* U5 EMPMST FM081 00350F* FM081 0000360F********************************************************************FM081 00370F* FM081 00380F* ID F C H L FUNCTION OF INDICATORS FM081 00390F* FM081 00400F* 01 PAROUT FM081 00410F* 02 MACOUT FM081 00420F* 03 LABOUT FM081 0000430F* 04 VENOUT FM081 00440F* 05 EMPOUT FM081 00450F* FM081 00460F********************************************************************FM081 00470IPAROUT NS 01 FM081 00480I 1 200 A FM081 00490I 201 300 B FM081 0000500IMACOUT NS 02 FM081 00510I 1 48 C FM081 00520ILABOUT NS 03 FM081 00530I 1 48 D FM081 00540IVENOUT NS 04 FM081 00550I 1 200 E FM081 00560I 201 256 F FM081 0000570IEMPOUT NS 05 FM081 00580I 1 100 G FM081 00590OPARTMST D 01 FM081 00600O A 200 FM081 00610O B 300 FM081 00620OMACHMST D 02 FM081 00630O C 48 FM081 0000640OLABMST D 03 FM081 00650O D 48 FM081 00660OVENDOR D 04 FM081 00670O E 200 FM081 00680O F 256 FM081 00690OEMPMST D 05 FM081 00700O G 100 FM081 00** 000710ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000730ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000750/* 000760_ 00 00 __ 0(|-D |TXIN650 P x 999999032778(000010H S IN650 00020X DECK-ID M62 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN650 00030F* THIS PROGRAM IS USED FOR STOCK STATUS LISTINGS IN650 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN650 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN650 00060F* CONTROL DATA PROPRIETARY PRODUCT IN650 00070F* IN650 0000080FPARTMST IPEAF 300 20AI 271 DISK IN650 00090FHEADING IT F 40 EDISK IN650 00100F$LP1 O F 132 OF PRINTER IN650 00110F********************************************************************IN650 00120F** IN650 00130F** PACKAGE MANUFACTURING IN650 00140F** SYSTEM INVENTORY TRANSACTION ACCOUNTING IN650 0000150F** PROGRAM STOCK STATUS & EXCEPTION STOCK STATUS IN650 00160F** IN650 00170F** CONTRACTOR COMPUSOURCE IN650 00180F** PROGRAMMER IN650 00190F** DATE IN650 00200F** IN650 00210F********************************************************************IN650 0000220F* IN650 00230F* NARRATIVE: IF U1 -> PRINT EXCEPTION REPORT IN650 00240F* NU1 -> PRINT REGULAR REPORT IN650 00250F* IN650 00260F* EXCEPTION REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT IN650 00270F* BY OPERATOR WITH A BLANK DELETE CODE AND WITH AVAIL < MIN. IN650 00280F* IN650 0000290F* REGULAR REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT IN650 00300F* BY OPERATOR WITH A BLANK DELETE CODE. IF AVAIL < MIN, THEN IN650 00310F* RECORD IS FLAGGED WITH '**' AT END OF LINE ON PRINT OUT. IN650 00320F* IN650 00330F********************************************************************IN650 00340F* IN650 00350F* ID F C H L FUNCTION OF INDICATORS IN650 0000360F* IN650 00370F* 01 PARTMST -- CLASS = 'F' -- DELETE CODE BLANK IN650 00380F* 02 PARTMST -- CLASS = 'P' -- DELETE CODE BLANK IN650 00390F* 03 PARTMST -- CLASS = 'M' -- DELETE CODE BLANK IN650 00400F* 04 PARTMST -- ALL OTHERS IN650 00410F* IN650 00420F* 10 TAKE IN DATA FROM CRT IN650 0000430F* 11 'F'-TYPE INTERESTED IN IS 'F' IN650 00440F* 12 'P'-TYPE INTERESTED IN IS 'P' IN650 00450F* 13 'M'-TYPE INTERESTED IN IS 'M' IN650 00460F* 14 'A'-TYPE INTERESTED IN IS 'F'/'P'/'M' IN650 00470F* 15 AMONGST PRODUCT CLASS ARE INTERESTED IN IN650 00480F* 20 AVAIL < MIN IN650 00490F* 97 CRT LOOP WATCHER IN650 0000500F* 98 CRT LOOP WATCHER IN650 00510F* 99 DUMMY 1P IN650 00520F********************************************************************IN650 00530E HEADING HEAD 1 1 40 COMPANY NAME IN650 00540E MSG 1 9 56 CRT SCREEN IN650 00550E EMP9 1 9 BLANK IN650 00560IPARTMST NS 01 40 CF 74 C IN650 0000570I OR 02 40 CP 74 C IN650 00580I OR 03 40 CM 74 C IN650 00590I OR 04 74 C IN650 00600I 271 290 PARTNO IN650 00610I 1 37 DESCRP IN650 00620I 38 39 UM IN650 00630I 40 40 CLASS IN650 0000640I 146 1520SOH IN650 00650I 153 1590SOO IN650 00660I 167 1730ALLOC IN650 00670I 181 1870MIN IN650 00680I 188 1940MAX IN650 00690I 196 2020MTDUSE IN650 00700I 203 2090AVGUSE IN650 0000710I 212 2180YTDUSE IN650 00720I 160 1660DIRMTD 00730I 174 1800DIRYTD 00740I 261 2650DIRAVG 00750C SETOF 99 IN650 00760C 10 GOTO START IN650 00770C SETON 1099 IN650 0000780C EXSR CRT IN650 00790C* IN650 00800C START TAG IN650 00810C* CRT INPT/REC IN650 00820C SETOF 15 IN650 00830C 11 01 F/F IN650 00840COR 12 02 P/P IN650 0000850COR 13 03 M/M IN650 00860COR 14 01 A/F IN650 00870COR 14 02 A/P IN650 00880COR 14 03 SETON 15A/M IN650 00890C* IN650 00900C N15 GOTO NEXT IN650 00910C* IN650 0000920C SOH ADD SOO AVAIL 70 IN650 00930C AVAIL SUB ALLOC AVAIL IN650 00940C* IN650 00950C AVAIL COMP MIN 20 IN650 00960C* IN650 00970C NEXT TAG IN650 00980C* IN650 0000990CLR EXSR CLRSCR IN650 01000C********************************************************************IN650 01010C* IN650 01020C* THIS SUBROUTINE INQUIRES WHICH PRODUCT CLASS [OR ALL] IN650 01030C* IS TO BE LISTED. IN650 01040C* IN650 01050C* REPLY EFFECT IN650 0001060C* ------- --------------------------------------------------- IN650 01070C* F ALL FINISHED GOODS NOT FLAGGED FOR DELETION IN650 01080C* P ALL PURCHASED GOODS NOT FLAGGED FOR DELETION IN650 01090C* M ALL ASSEMBLIES NOT FLAGGED FOR DELETION IN650 01100C* A ALL GOODS NOT FLAGGED FOR DELETION IN650 01110C* IN650 01120C********************************************************************IN650 0001130CSR CRT BEGSR IN650 01140CSR EXSR CLRSCR IN650 01150CSR Z-ADD0 I 20 IN650 01160CSR LOOP1 TAG IN650 01170CSR I ADD 1 I IN650 01180CSR EXSR SETUP IN650 01190CSRNU1 I COMP 3 98 IN650 0001200CSRNU1 98 MOVELEMP9,1 BUFFER IN650 01210CSR EXSR OUTS IN650 01220CSR I COMP 8 97 IN650 01230CSR 97 GOTO LOOP1 IN650 01240C* IN650 01250CSR INPUT TAG IN650 01260CSR Z-ADD1404 CURPOS 40 IN650 0001270CSR EXSR POSCUR IN650 01280CSR Z-ADD1 LNGTH 20 IN650 01290CSR EXSR ACCEPT IN650 01300CSR MOVELBUFFER CHECK 1 IN650 01310CSR MOVEL']' BUFFER IN650 01320CSR EXSR OUTS IN650 01330CSR CHECK COMP 'F' 11FINISHED GOODS IN650 0001340CSR CHECK COMP 'P' 12PURCHASED GOODSIN650 01350CSR CHECK COMP 'M' 13ASSEMBLIES IN650 01360CSR CHECK COMP 'A' 14ALL IN650 01370CSR Z-ADD9 I IN650 01380CSR EXSR SETUP IN650 01390CSR 11 IN650 01400COR 12 IN650 0001410COR 13 IN650 01420COR 14 MOVELEMP9,1 BUFFER IN650 01430CSR EXSR OUTS IN650 01440CSRN11N12N13 IN650 01450CANN14 GOTO INPUT IN650 01460CSR ENDSR IN650 01470C********************************************************************IN650 0001480C* IN650 01490C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. IN650 01500C* IT DEFINES ALL THE RLABL'S NECESSARY IN650 01510C* IN650 01520C********************************************************************IN650 01530CSR CRTCOM BEGSR IN650 01540CSR EXITFSUBRCM IN650 0001550CSR RLABL BUFFER 72 IN650 01560CSR RLABL TYPE 1 IN650 01570CSR RLABL BLNGTH 20 IN650 01580CSR RLABL RCODE 1 IN650 01590CSR RLABL MASK 10 IN650 01600CSR RLABL DTYPE 10 IN650 01610CSR ENDSR IN650 0001620C********************************************************************IN650 01630C* IN650 01640C* THIS SUBROUTINE SPLITS-UP CRT ARRAY ELEMENT, POSITIONS THE IN650 01650C* CURSOR, AND STUFFS THE BUFFER. IN650 01660C* IN650 01670C********************************************************************IN650 01680CSR SETUP BEGSR IN650 0001690CSR MOVELMSG,I WORD6 60 IN650 01700CSR MOVE MSG,I WORD50 50 IN650 01710CSR MOVELWORD6 CURPOS IN650 01720CSR MOVE WORD6 LNGTH IN650 01730CSR EXSR POSCUR IN650 01740CSR MOVELWORD50 BUFFER IN650 01750CSR ENDSR IN650 0001760C********************************************************************IN650 01770C* IN650 01780C* THIS SUBROUTINE CLEARS THE SCREEN. IN650 01790C* IN650 01800C********************************************************************IN650 01810CSR CLRSCR BEGSR IN650 01820CSR MOVEL'C' TYPE IN650 0001830CSR EXSR CRTCOM IN650 01840CSR ENDSR IN650 01850C********************************************************************IN650 01860C* IN650 01870C* THIS SUBROUTINE POSITIONS THE CURSOR. IN650 01880C* IN650 01890C********************************************************************IN650 0001900CSR POSCUR BEGSR IN650 01910CSR MOVELCURPOS BUFFER IN650 01920CSR MOVEL'P' TYPE IN650 01930CSR EXSR CRTCOM IN650 01940CSR ENDSR IN650 01950C********************************************************************IN650 01960C* IN650 0001970C* THIS SUBROUTINE ACCEPTS TYPE TO THE CRT FROM IN650 01980C* THE KEYBOARD. IN650 01990C* IN650 02000C********************************************************************IN650 02010CSR ACCEPT BEGSR IN650 02020CSR MOVELLNGTH BLNGTH IN650 02030CSR MOVEL'A' TYPE IN650 0002040CSR EXSR CRTCOM IN650 02050CSR ENDSR IN650 02060C********************************************************************IN650 02070C* IN650 02080C* THIS SUBROUTINE OUTPUTS PRINT TO THE CRT AND IN650 02090C* REPOSITIONS THE CURSOR AT (BLNGTH + 1). IN650 02100C* IN650 0002110C********************************************************************IN650 02120CSR OUTS BEGSR IN650 02130CSR MOVELLNGTH BLNGTH IN650 02140CSR MOVEL'S' TYPE IN650 02150CSR EXSR CRTCOM IN650 02160CSR ENDSR IN650 02170C********************************************************************IN650 0002180O$LP1 H 202 1P IN650 02190O OR OF IN650 02200O PAGE Z 8 IN650 02210O 4 'PAGE' IN650 02220O HEAD,1 86 IN650 02230O UDATE Y 132 IN650 02240O H 2 99 IN650 0002250O OR OF IN650 02260O U1 56 'EXCEPTION' IN650 02270O 70 'STOCK STATUS-' IN650 02280O 11 84 'FINISHED GOODS' IN650 02290O 12 85 'PURCHASED GOODS' IN650 02300O 13 80 'ASSEMBLIES' IN650 02310O 14 74 'ALL' IN650 0002320O 132 'MFG650' IN650 02330O H 1 99 02340O OR OF 02350O 11 'PART NUMBER' 02360O H 2 99 IN650 02370O OR OF IN650 02380O 13 'DESCRIPTION' IN650 0002390O 43 'CLS' IN650 02400O 46 'UM' IN650 02410O 55 'SOH' IN650 02420O 64 'SOO' IN650 02430O 73 'ALLOC' IN650 02440O 82 'AVAIL' IN650 02450O 91 'MIN' IN650 0002460O 100 'MAX' IN650 02470O 109 'MTD USE' IN650 02480O 118 'AVG USE' IN650 02490O 127 'YTD USE' IN650 02500O D 1 NU1 15 02510O OR U1 20 15 02520O PARTNO 20 0002522O DIRMTDL 110 02523O DIRYTDL 128 02524O DIRAVGL 119 02525O 111 'D' 02526O 129 'D' 02527O 120 'D' 02530O D 2 NU1 15 IN650 0002540O OR U1 20 15 IN650 02550O DESCRP 39 IN650 02560O CLASS 42 IN650 02570O UM 46 IN650 02580O SOH L 56 IN650 02590O SOO L 65 IN650 02600O ALLOC L 74 IN650 0002610O AVAIL L 83 IN650 02620O MIN L 92 IN650 02630O MAX L 101 IN650 02640O MTDUSEL 110 IN650 02650O AVGUSEL 119 IN650 02660O YTDUSEL 128 IN650 02662O 111 'M' 0002664O 129 'M' 02666O 120 'M' 02670O NU1 15 20 132 '**' IN650 ** 002680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002700ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00271000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002720** 002730180132INVENTORY TRANSACTION ACCOUNTING 002740620106MFG650 002750190229EXCEPTION STOCK STATUS REPORT 002760030413PRINT OUT [ ] 002770030918F = FINISHED GOODS 00278000031019P = PURCHASED GOODS 002790031114M = ASSEMBLIES 002800031207A = ALL 002810170409**INVALID 002820/* 002830_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( KTXOE350 P 999999032978(000010H S OE350 00020X DECK-ID A69 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE350 00030F* UPDATE SALES STATS, UPDATE INVENTORY OE350 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE350 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE350 00060F* CONTROL DATA PROPRIETARY PRODUCT OE350 00070F* OE350 0000080FINVDTL IPEAF 75 DISK OE350 00090FMTHINV O F 74 DISK A OE350 00100FTRANSAC O F 65 DISK A OE350 00110F********************************************************************OE350 00120F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [INV060] OE350 00130F* OE350 00140F* PACKAGE DISTRIBUTION OE350 0000150F* SYSTEM INVOICING OE350 00160F* PROGRAM ADD RECORDS FOR SALES STATS, UPDATE INVENTORY OE350 00170F* OE350 00180F* CONTRACTOR COMPUSOURCE OE350 00190F* PROGRAMMER KATH HILL OE350 00200F* DATE FEBRUARY 25, 1975 OE350 00210F* OE350 0000220F********************************************************************OE350 00230F* OE350 00240F* NARRATIVE: ADDS 1 RECORD TO MTHINV AND 1 RECORD TO TRANSAC OE350 00250F* FOR EACH RECORD IN INVDTL. (UNLESS QTY SHIPPED=0) OE350 00260F********************************************************************OE350 00270F* OE350 00280F* FUNCTION OF INDICATORS OE350 0000290F* OE350 00300F* 10 QTY = ZERO OE350 00310F* 20 TYPE (I) = TRANSACTION # (14) OE350 00320F* 21 (C) = (16) OE350 00330F* 22 (M) = (18) OE350 00340F* 23 (D) = (20) OE350 00350F* OE350 0000360F********************************************************************OE350 00370IINVDTL NS 01 OE350 00380I 1 50INVNUM OE350 00390I 6 100CUSTNO OE350 00400I 11 160INVDAT OE350 00410I 17 190SLSMAN OE350 00420I 20 260QTY 10 OE350 0000430I 56 75 PARTNO OE350 00440I 39 452NETSLS OE350 00450I 46 523UNCOST OE350 00460I 53 54 AREA OE350 00470I 55 55 TYPE OE350 00480C TYPE COMP 'I' 20 OE350 00490C TYPE COMP 'C' 21 OE350 0000500C TYPE COMP 'M' 22 OE350 00510C TYPE COMP 'D' 23 OE350 00520C 20 Z-ADD14 TRANNO 20 OE350 00530C 21 Z-ADD16 TRANNO OE350 00540C 22 Z-ADD18 TRANNO OE350 00550C 23 Z-ADD20 TRANNO OE350 00560OMTHINV DADD 01N10 OE350 0000570O INVNUM 5 OE350 00580O CUSTNO 10 OE350 00590O INVDAT 16 OE350 00600O SLSMAN 19 OE350 00610O QTY 26 OE350 00620O PARTNO 74 OE350 00630O NETSLS 45 OE350 0000640O UNCOST 52 OE350 00650O AREA 54 OE350 00660OTRANSAC DADD 01N10 OE350 00670O PARTNO 61 OE350 00680O TRANNO 14 OE350 00690O QTY 21 OE350 00700O INVNUM 28 OE350 0000710O INVDAT 34 OE350 00720O UNCOST 41 OE350 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00077000/* 000780_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( TTXWP500 P999999042078(000010H S WP500 00020X DECK-ID P11 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP500 00030F* PRINTS DAILY CLOSED JOB REPORT WP500 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP500 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP500 00060F* CONTROL DATA PROPRIETARY PRODUCT WP500 00070F* WP500 0000080FSWTRAN IPEAF 60 DISK WP500 00090FHEADING IT F 40 EDISK WP500 00100FWRKORD IC F 160R 5AI 1 DISK WP500 00110F$LP1 O F 132 OF PRINTER WP500 00120F* WP500 00130F* THIS PROGRAM LISTS THE JOBS CLOSED TODAY. IT DOES THIS BY WP500 00140F* LISTING ALL WORK ORDES WHICH HAD A 62 TRANSACTION PROCESSED WP500 0000150F* AND NO ERROR GENERATED. WP500 00160F* WP500 00170E HEADING HEAD 1 1 40 WP500 00180ISWTRAN NS 01 1 C6 2 C2 WP500 00190I 3 70WONUM WP500 00200I 59 600ERRCOD WP500 00210I NS 02 WP500 0000220I 1 1 A WP500 00230IWRKORD NS 03 WP500 00240I 6 25 PARTNO WP500 00250I 31 370JOBQTY WP500 00260I 38 440QTYCOM WP500 00270I 51 560REQDAT WP500 00280I 107 1130SCRAP WP500 0000290C SETOF 80 WP500 00300C N01 GOTO DEND WP500 00310C ERRCOD COMP 19 20 WP500 00320C 20 GOTO DEND WP500 00330C WONUM CHAINWRKORD H1 WP500 00340C H1 GOTO DEND WP500 00350C JOBQTY SUB QTYCOM QTYREM 70 WP500 0000360C QTYREM SUB SCRAP QTYREM 20 WP500 00370C 20 Z-ADD0 QTYREM WP500 00380C JOBS ADD 1 JOBS 50 WP500 00390C SETON 80 WP500 00400C DEND TAG WP500 00410O$LP1 H 02 1P WP500 00420O OR OF WP500 0000430O HEAD 86 WP500 00440O H 1 1P WP500 00450O OR OF WP500 00460O 4 'PAGE' WP500 00470O PAGE Z 8 WP500 00480O 78 'DAILY CLOSED JOB REPORT' WP500 00490O UDATE Y 89 WP500 0000500O 132 'JOB500' WP500 00510O H 2 1P WP500 00520O OR OF WP500 00540O 52 'JOB QTY' 00550O 84 'QTY REQUIRED SCRAP' 00560O H 11 1P WP500 00570O OR OF WP500 0000580O 21 'W.O. # PART NUMBER' 00585O 55 'QTY COMLT' 00590O 80 'REMAIN REQ DATE' 00595O 92 'AMOUNT' 00610O D 1 01 80 WP500 00620O WONUM Z 5 WP500 00630O PARTNO 30 WP500 0000640O JOBQTYJ 43 WP500 00650O QTYCOMJ 56 WP500 00660O QTYREMJ 69 WP500 00670O REQDATY 81 WP500 00680O SCRAP J 94 WP500 00690O T 3 L1 WP500 00700O JOBS Z 6 WP500 0000710O 19 'JOBS CLOSED' WP500 ** 000720ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000730ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000740ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000750ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000760/* 00077000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(M 9TXWP300 P"T999999032978(000010H S WP300 00020X DECK-ID P20 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP300 00030F* OPEN WORKORDER OPERATION FILE TRANSACTION UPDATE PROGRAM WP300 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP300 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP300 00060F* CONTROL DATA PROPRIETARY PRODUCT WP300 00070F* WP300 0000080FSWTRAN UPEAF 60 DISK WP300 00090FWRKOPR UC F 90R DISK WP300 00100FWRKORD UC F 160R 5AI 1 DISK WP300 00110FNWKOPR UC F 90R DISK WP300 00120FTMPIND IC F 13R 8AI 1 DISK WP300 00130FROUTING IC F 102R DISK WP300 00140FPARTMST IC F 300R20AI 271 DISK WP300 0000150FDSPFIL D F 68 CONSOLE WP300 00160FTRNWO3 O F 65 DISK WP300 00170F* WP300 00180F* 1-13 RECORD INDICATORS WP300 00190F*20-22 GENERAL COMPARE INDICATORS WP300 00200F* 24 TC=52 WP300 00210F* 25 TC=60 WP300 0000220F* 30 'TO' OPERATION RECORD NOT FOUND WP300 00230F* 31 NOT 1ST TIME THROUGH ADD LOOP IN TC 52 WP300 00240F* 32 'TO' OPERATIONS' QTY QUEUED WENT NEGATIVE WP300 00250F* 34 'TO' MATERIAL TYPE IS NOT 'R' (REWORK) WP300 00260F* 33 'FROM' MATERIAL TYPE IS NOT 'R' (REWORK) WP300 00270F* 35 COMPLETION GOES TO ANOTHER OPERATION - NOT TO STOCK WP300 00280F* 50 END OF WRKOPR FILE WP300 0000290F* 54 END OF NEW WORK OPERATION FILE WP300 00300F* 55 NO HIT ON WRKORD FILE WP300 00310F* 56 WORK ORDER IS 'OPEN' WP300 00320F* 57 WORK ORDER IS 'RELEASED' WP300 00330F* 58 WORK ORDER IS 'CLOSED' WP300 00340F* 59 WORK ORDER HAS NON-BLANK OUT-OF-ORDER FLAG ON WP300 00350F*80-89 OUTPUT INDICATORS WP300 0000360F* 99 FIRST OPERATION RECORD HAS BEEN READ WP300 00370F* WP300 00380ISWTRAN NS 03 WP300 00390I 1 20TC WP300 00400I 3 70TWONUML1 WP300 00410I* 8 100TOPNUM WP300 00420I* 11 11 TMATTP WP300 0000430I 33 390TQTY WP300 00440I* 21 260TDLRS WP300 00450I 32 32 TSTAT WP300 00460I 8 27 TPART WP300 00470I* 51 541TBRDF WP300 00480I* 55 570TTOOP WP300 00490I* 58 58 TTMATT WP300 0000500I 59 600TERRNO WP300 00510IWRKOPR NS 01 WP300 00520I 1 50WONUM WP300 00530I 6 80OPNUM WP300 00540I 9 12 DEPT WP300 00550I 13 17 WRKSTA WP300 00560I 18 221PRDRT WP300 0000570I 23 250SETUP WP300 00580I 26 26 OUTPC WP300 00590I 27 330QTYQ WP300 00600I 34 400QTYC WP300 00610I 41 470RWKQ WP300 00620I 48 540RWKC WP300 00630I 55 600LAB$ WP300 0000640I 61 660RWK$ WP300 00650I 67 710LABHRS WP300 00660I 72 760RWKHRS WP300 00670I 77 830SCRAP WP300 00680I 84 84 LSTOP WP300 00690I 85 890RRN WP300 00700IPARTMST NS 11 WP300 0000710I 52 560RTRRN WP300 00720I 74 74 DCODE WP300 00730IROUTING NS 05 WP300 00740I 82 102 RPRTNO WP300 00750I 15 170ROPNUM WP300 00760I 38 423RPRDRT WP300 00770I 43 451RSETUP WP300 0000780I 49 53 RWRKST WP300 00790I 66 66 ROPCD WP300 00800I 82 82 RNOSTA WP300 00810IWRKORD NS 07 WP300 00820I 6 25 OPRTNO WP300 00830I 30 30 STATUS WP300 00840I 38 440OMQTYC WP300 0000850I 45 500OCLSDT WP300 00860I 61 61 OOOOCD WP300 00870I 31 370OMQTY WP300 00880I 73 780OMLAB$ WP300 00890I 85 900OMOUTP WP300 00900I 79 840OMBUR WP300 00910I 91 960OMRWK$ WP300 0000920I 97 1010OMLABH WP300 00930I 102 1060OMRWKH WP300 00940I 107 1130OMSCRP WP300 00950INWKOPR NS 09 WP300 00960I 1 90 REC WP300 00970I 27 330NQTYQ WP300 00980I 34 400NQTYC WP300 0000990I 41 470NRWKQ WP300 01000I 77 830NSCRAP WP300 01010ITMPIND NS 13 WP300 01020I 9 130TRN WP300 01030C Z-ADD0 ERRNO WP300 01040C TC COMP 51 2021 WP300 01050C 21 TSTAT COMP 'R' 2020 WP300 0001060C N20 TERRNO COMP 20 20 WP300 01070C N20 TC COMP 60 20 WP300 01080C N20 TC COMP 58 20 WP300 01090C* N20 TOPNUM COMP 999 20 WP300 01100C 20 GOTO DEND WP300 01110C Z-ADDTWONUM WONUMK WP300 01120C L1 EXSR GETMWK WP300 0001130C L1 EXSR MOVWRK WP300 01140C 55 Z-ADD28 ERRNO 20 WP300 01150C 55 GOTO DEND WP300 01160C TC COMP 51 20 WP300 01170C 20 TSTAT COMP 'R' 20 WP300 01180C 20 Z-ADD52 TC WP300 01190C TC COMP 52 24 WP300 0001200C TC COMP 60 25 WP300 01210C CHKWO TAG WP300 01220C TWONUM COMP WONUM 202122 WP300 01230C 22 24 Z-ADD25 ERRNO WP300 01240C 22 24 GOTO DEND WP300 01250C 22 GOTO CHKOP WP300 01260C 21 GOTO CHKADD WP300 0001270C NXTWO TAG WP300 01280C EXSR OPROUT WP300 01290C EXSR GETWOP WP300 01300C GOTO CHKWO WP300 01310C CHKOP TAG WP300 01320C* TOPNUM COMP OPNUM 202122 WP300 01330C 22 GOTO MATCH WP300 0001340C 21 GOTO CHKADD WP300 01350C GOTO NXTWO WP300 01360C CHKADD TAG WP300 01370C 25 GOTO TC60 WP300 01380C 24 GOTO TC52 WP300 01390C Z-ADD24 ERRNO WP300 01400C GOTO DEND WP300 0001410C MATCH TAG WP300 01420C TC COMP 60 20 WP300 01430C 20 Z-ADD39 ERRNO WP300 01440C 20 GOTO DEND WP300 01450C TC COMP 53 20 WP300 01460C 20 GOTO TC53 WP300 01470C TC COMP 54 20 WP300 0001480C 20 GOTO TC54 WP300 01490C TC COMP 55 20 WP300 01500C 20 GOTO TC55 WP300 01510C TC COMP 56 20 WP300 01520C 20 GOTO TC56 WP300 01530C TC COMP 57 20 WP300 01540C 20 GOTO TC57 WP300 0001550C TC COMP 59 20 WP300 01560C 20 GOTO TC59 WP300 01570C GOTO DEND WP300 01580C********************************************************************WP300 01590C* WP300 01600C* TC 52 IS USED TO RELEASE A WORK ORDER. A RECORD IS ADDED TO WP300 01610C* THE NEW WORK OPERATION FILE FOR EVERY STATUSABLE OPERATION IN THEWP300 0001620C* ROUTING FILE. THE ACCUMULATED FIELDS ARE SET TO ZERO. THE FIRST WP300 01630C* OPERATION HAS ITS QUANTITY QUEUED FIELD SET TO THE JOB QUANTITY WP300 01640C* AND THE LAST OPERATION HAS THE 'LAST OPERATION' FIELD SET TO 'X'.WP300 01650C* WP300 01660C********************************************************************WP300 01670C TC52 TAG WP300 01680C SETON 82 WP300 0001690C 58 Z-ADD40 ERRNO WP300 01700C 58 GOTO DEND WP300 01710C MOVELPRTNUM P12 20 WP300 01720C P12 CHAINPARTMST 54 WP300 01730C N54 DCODE COMP 'D' 54 WP300 01740C 54 Z-ADD22 ERRNO WP300 01750C 54 GOTO DEND WP300 0001760C RTRRN COMP 0 20 WP300 01770C N20 GOTO DEND WP300 01780C EXSR INIT WP300 01790C Z-ADDMQTY QTYQ WP300 01800C SETOF 31 WP300 01810C LOOP52 TAG WP300 01820C RTRRN CHAINROUTING 54 READ RTG REC WP300 0001830C 54 GOTO CHNEND WP300 01840C P12 COMP RPRTNO 20 WP300 01850C N20 GOTO CHNEND WP300 01860C RNOSTA COMP ' ' 2020 WP300 01870C 20 GOTO NXTOP NON-STATUS OPERWP300 01880C 31 EXSR OPROUT WP300 01890C 31 OFFSET ADD 1 OFFSET 50 WP300 0001900C 31 Z-ADD0 QTYQ WP300 01910C* Z-ADDROPNUM TOPNUM WP300 01920C 1 DIV RPRDRT PRDRT WP300 01930C Z-ADDRSETUP SETUP WP300 01940C MOVELRWRKST WRKSTA WP300 01950C MOVELROPCD OUTPC WP300 01960C SETON 31 WP300 0001970C NXTOP TAG WP300 01980C RTRRN ADD 1 RTRRN WP300 01990C GOTO LOOP52 WP300 02000C CHNEND TAG WP300 02010C 31 EXSR OPROUT WP300 02020C 31 OFFSET ADD 1 OFFSET WP300 02030C SETOF 82 WP300 0002040C INRRN CHAINWRKOPR WP300 02050C GOTO DEND WP300 02060C********************************************************************WP300 02070C* WP300 02080C* TC 53 CHANGES THE QUANTITY QUEUED FIELD WP300 02090C* WP300 02100C********************************************************************WP300 0002110C TC53 TAG WP300 02120C 58 Z-ADD40 ERRNO WP300 02130C 58 GOTO DEND WP300 02140C Z-ADDTQTY QTYQ WP300 02150C SCRAP ADD QTYC TOT 70 WP300 02160C TOT COMP QTYQ 20 WP300 02170C 20 Z-ADD9 ERRNO WP300 0002180C GOTO DEND WP300 02190C********************************************************************WP300 02200C* WP300 02210C* TC 54 LOGS IN COPLETIONS. THE MATERIAL IS ASSUMED TO MOVE WP300 02220C* TO THE NEXT OPERATION IN SEQUENCE UNLESS A 'TO' OPERATION IS SPECWP300 02230C* WP300 02240C********************************************************************WP300 0002250C TC54 TAG WP300 02260C SETOF 35 WP300 02270C 58 Z-ADD3 ERRNO WP300 02280C 58 Z-ADDUDATE CLSDTE WP300 02290C QTYC ADD TQTY TEMP 70 20 WP300 02300C 20 Z-ADD34 ERRNO WP300 02310C 20 GOTO DEND WP300 0002320C* TTOOP COMP 0 20 WP300 02330C 59N20 Z-ADD38 ERRNO WP300 02340C 59N20 GOTO DEND WP300 02350C* TTOOP COMP 999 3535 WP300 02360C SETOF 3334 WP300 02370C 35 EXSR GNXTOP WP300 02380C N35 GOTO CHKMQ WP300 0002390C 30 Z-ADD36 ERRNO WP300 02400C 32 Z-ADD35 ERRNO WP300 02410C 30 WP300 02420COR 32 GOTO DEND WP300 02430C GOTO T541 WP300 02440C CHKMQ TAG WP300 02450C MQTYC ADD TQTY TEMP 20 WP300 0002460C 20 Z-ADD31 ERRNO WP300 02470C 20 GOTO DEND WP300 02480C T541 TAG WP300 02490C QTYC ADD TQTY QTYC WP300 02500C 35 GOTO DEND WP300 02510C T542 TAG WP300 02520C MQTYC ADD TQTY MQTYC WP300 0002530C MQTYC ADD MSCRAP TOTCOM 70 WP300 02540C MQTY SUB TOTCOM IQTY 70 21 WP300 02550C IQTY ADD TQTY IQTY 20 WP300 02560C 20 Z-ADD0 IQTY WP300 02570C TQTY COMP IQTY 20 WP300 02580C 20 Z-ADDTQTY IQTY WP300 02590C Z-ADD73 ITRN 20 WP300 0002600C EXSR OUTRNS WP300 02610C Z-ADDTQTY IQTY WP300 02620C Z-ADD72 ITRN WP300 02630C EXSR OUTRNS WP300 02640C 21 Z-ADD2 ERRNO WP300 02650C GOTO DEND WP300 02660C********************************************************************WP300 0002670C* WP300 02680C* TC 55 IS USED TO MOVE REWORK MATERIAL. WP300 02690C* OPERATION #'S MUST BE SUPPLIED. THE TYPE OF MATERIAL WP300 02700C* IS EITHER BLANK (FOR NORMAL) OR 'R' (FOR REWORK). BOTH WP300 02710C* OPERATIONS MUST NOT BE BLANK. WP300 02720C* WP300 02730C********************************************************************WP300 0002740C TC55 TAG WP300 02750C 58 Z-ADD3 ERRNO WP300 02760C 58 Z-ADDUDATE CLSDTE WP300 02770C* TTOOP COMP 0 20 WP300 02780C 20 Z-ADD38 ERRNO WP300 02790C 20 GOTO DEND WP300 02800C* TMATTP COMP 'R' 33 WP300 0002810C* TTMATT COMP 'R' 34 WP300 02820C N33N34 Z-ADD37 ERRNO WP300 02830C N33N34 GOTO DEND WP300 02840C N33 QTYQ SUB TQTY TEMP 20 WP300 02850C 33 RWKC ADD TQTY TEMP 20 WP300 02860C 20 Z-ADD35 ERRNO WP300 02870C 20N33 Z-ADD34 ERRNO WP300 0002880C 20 GOTO DEND WP300 02890C 34 GOTO T551 WP300 02900C* TTOOP COMP 999 20 WP300 02910C N20 GOTO T551 WP300 02920C MQTYC ADD TQTY TEMP 20 WP300 02930C 20 Z-ADD31 ERRNO WP300 02940C 20 GOTO DEND WP300 0002950C GOTO T552 WP300 02960C T551 TAG WP300 02970C EXSR GNXTOP WP300 02980C 30 Z-ADD36 ERRNO WP300 02990C 32 Z-ADD35 ERRNO WP300 03000C 30 WP300 03010COR 32 GOTO DEND WP300 0003020C T552 TAG WP300 03030C N33 QTYQ SUB TQTY QTYQ WP300 03040C 33 RWKC ADD TQTY RWKC WP300 03050C* TTOOP COMP 999 20 WP300 03060C 20 GOTO T542 WP300 03070C GOTO DEND WP300 03080C********************************************************************WP300 0003090C* WP300 03100C* TC 56 IS USED TO LOG IN THE AMOUNT OF SCRAP TO THE OPERATION. WP300 03110C* WP300 03120C********************************************************************WP300 03130C TC56 TAG WP300 03140C SCRAP ADD TQTY SCRAP 20 WP300 03150C 20 Z-ADD4 ERRNO WP300 0003160C 20 Z-ADD0 SCRAP WP300 03170C QTYC ADD SCRAP TOTCOM WP300 03180C QTYQ COMP TOTCOM 21 WP300 03190C N20 21 Z-ADD9 ERRNO WP300 03200C 58 Z-ADDUDATE CLSDTE WP300 03210C 58 Z-ADD3 ERRNO WP300 03220C MSCRAP ADD TQTY MSCRAP 20 WP300 0003230C 20 Z-ADD4 ERRNO WP300 03240C 20 Z-ADD0 MSCRAP WP300 03250C GOTO DEND WP300 03260C********************************************************************WP300 03270C* WP300 03280C* TC 57 IS USED TO LOG IN THE AMOUNT OF LABOR HOURS AND DOLLARS WP300 03290C* FOR REWORK OR REGULAR. WP300 0003300C* WP300 03310C********************************************************************WP300 03320C TC57 TAG WP300 03330C 58 Z-ADDUDATE CLSDTE WP300 03340C 58 Z-ADD3 ERRNO WP300 03350C* TMATTP COMP 'R' 20 WP300 03360C 20 GOTO RWK57 WP300 0003370C* LAB$ ADD TDLRS LAB$ 20 WP300 03380C 20 Z-ADD5 ERRNO WP300 03390C 20 Z-ADD0 LAB$ WP300 03400C* N32 MLAB$ ADD TDLRS MLAB$ 20 WP300 03410C* 32 MOUTP$ ADD TDLRS MOUTP$ 20 WP300 03420C 20 Z-ADD5 ERRNO WP300 03430C 32 20 Z-ADD0 MOUTP$ WP300 0003440C 32 GOTO END57 WP300 03450C LABHRS ADD TQTY LABHRS 20 WP300 03460C 20 Z-ADD12 ERRNO WP300 03470C 20 Z-ADD0 LABHRS WP300 03480C MLABHR ADD TQTY MLABHR 20 WP300 03490C 20 Z-ADD12 ERRNO WP300 03500C 20 Z-ADD0 MLABHR WP300 0003510C* TBRDF MULT TDLRS TDLRS WP300 03520C* MBUR ADD TDLRS MBUR 20 WP300 03530C 20 Z-ADD11 ERRNO WP300 03540C 20 Z-ADD0 MBUR WP300 03550C GOTO END57 WP300 03560C RWK57 TAG WP300 03570C* RWK$ ADD TDLRS RWK$ 20 WP300 0003580C 20 Z-ADD13 ERRNO WP300 03590C 20 Z-ADD0 RWK$ WP300 03600C RWKHRS ADD TQTY RWKHRS 20 WP300 03610C 20 Z-ADD14 ERRNO WP300 03620C 20 Z-ADD0 RWKHRS WP300 03630C* MRWK$ ADD TDLRS MRWK$ 20 WP300 03640C 20 Z-ADD13 ERRNO WP300 0003650C 20 Z-ADD0 MRWK$ WP300 03660C MRWKHR ADD TQTY MRWKHR 20 WP300 03670C 20 Z-ADD14 ERRNO WP300 03680C 20 Z-ADD0 MRWKHR WP300 03690C END57 TAG WP300 03700C SETOF 32 WP300 03710C GOTO DEND WP300 0003720C********************************************************************WP300 03730C* WP300 03740C* TC 59 LOGS IN THE AMOUNT OF OUTSIDE PROCESSING WP300 03750C* WP300 03760C********************************************************************WP300 03770C TC59 TAG WP300 03780C SETON 32 WP300 0003790C* MOVE ' ' TMATTP WP300 03800C GOTO TC57 WP300 03810C********************************************************************WP300 03820C* WP300 03830C* TC 60 ADDS AN OPERATION RECORD TO THE OPERATION FILE WP300 03840C* WP300 03850C********************************************************************WP300 0003860C TC60 TAG WP300 03870C EXSR INIT WP300 03880C SETON 82 WP300 03890C EXSR OPROUT WP300 03900C SETOF 82 WP300 03910C OFFSET ADD 1 OFFSET WP300 03920C INRRN CHAINWRKOPR WP300 0003930C GOTO DEND WP300 03940C********************************************************************WP300 03950C DEND TAG WP300 03960C ERRNO COMP 0 87 WP300 03970CL1 Z-ADDTWONUM WOUPD 50 WP300 03980CL1 EXSR MWKOUT WP300 03990CLR LRLOOP TAG WP300 0004000CLR EXSR OPROUT WP300 04010CLR 50 GOTO LEND WP300 04020CLR EXSR GETWOP WP300 04030CLR GOTO LRLOOP WP300 04040CLR LEND TAG WP300 04050C********************************************************************WP300 04060C* WP300 0004070C* THIS ROUTINE SETS THE OPERATION RECORD FIELDS TO 0 OR BLANK WP300 04080C* WP300 04090C********************************************************************WP300 04100CSR INIT BEGSR WP300 04110CSR Z-ADD0 PRDRT WP300 04120CSR Z-ADD0 SETUP WP300 04130CSR MOVE ' ' OUTPC WP300 0004140CSR Z-ADD0 QTYQ WP300 04150CSR Z-ADD0 QTYC WP300 04160CSR Z-ADD0 SCRAP WP300 04170CSR Z-ADD0 RWKQ WP300 04180CSR Z-ADD0 RWKC WP300 04190CSR Z-ADD0 LAB$ WP300 04200CSR Z-ADD0 RWK$ WP300 0004210CSR Z-ADD0 LABHRS WP300 04220CSR Z-ADD0 RWKHRS WP300 04230CSR MOVEL' ' LSTOP WP300 04240CSR MOVEL' ' DEPT WP300 04250CSR MOVEL' ' WRKSTA WP300 04260CSR ENDSR WP300 04270C********************************************************************WP300 0004280C* WP300 04290C* THIS ROUTINE READS THE NEXT RECORD FROM THE WORK OPERATION WP300 04300C* FILE. IF THE WORK ORDER NUMBER IS DIFFERENT FROM THE WP300 04310C* LAST ONE READ THEN THE WORK ORDER RECORD IS READ. WP300 04320C* WP300 04330C********************************************************************WP300 04340CSR GETWOP BEGSR WP300 0004350CSR NXTOPR TAG WP300 04360CSR INRRN ADD 1 INRRN 50 WP300 04370CSRN50 INRRN CHAINWRKOPR 50 WP300 04380CSR 50 GOTO ENDGW WP300 04390CSR WONUM COMP 99999 50 WP300 04400CSR 50 GOTO ENDGW WP300 04410CSR WONUM COMP LASTWO 20 WP300 0004420CSR 20 55 OFFSET SUB 1 OFFSET 50 WP300 04430CSR 20 55 GOTO NXTOPR WP300 04440CSR 20 GOTO ENDGW WP300 04450CSR Z-ADDWONUM WONUMK 50 WP300 04460CSR EXSR GETMWK WP300 04470CSR Z-ADDWONUM LASTWO WP300 04480CSR 55 OFFSET SUB 1 OFFSET WP300 0004490CSR 55 GOTO NXTOPR WP300 04500CSR ENDGW TAG WP300 04510CSR SETOF 55 WP300 04520CSR ENDSR WP300 04530C********************************************************************WP300 04540C* WP300 04550C* THIS ROUTINE READS THE WORK ORDER MASTER FILE. WP300 0004560C* WP300 04570C********************************************************************WP300 04580CSR GETMWK BEGSR WP300 04590CSR WONUMK CHAINWRKORD 55 WP300 04600CSRN55 STATUS COMP 'D' 55 WP300 04610CSR Z-ADDWONUMK LASTWO 50 WP300 04620CSR ENDSR WP300 0004630C********************************************************************WP300 04640C* WP300 04650C* THIS ROUTINE MOVES THE INPUT MASTER WORK ORDER FIELDS TO THE WP300 04660C* OUTPUT AND WORKING FIELDS. WP300 04670C* WP300 04680C********************************************************************WP300 04690CSR MOVWRK BEGSR WP300 0004700CSR STATUS COMP 'O' 56 OPEN WP300 04710CSR STATUS COMP 'R' 57 RELEASED WP300 04720CSR STATUS COMP 'C' 58 CLOSED WP300 04730CSR OOOOCD COMP ' ' 5959 WP300 04740CSR MOVE OMQTYC MQTYC 70 WP300 04750CSR MOVE OCLSDT CLSDTE 60 WP300 04760CSR MOVE OOOOCD OOOCD 1 WP300 0004770CSR MOVE OMQTY MQTY 70 WP300 04780CSR MOVE OMLAB$ MLAB$ 60 WP300 04790CSR MOVE OMOUTP MOUTP$ 60 WP300 04800CSR MOVE OMBUR MBUR 60 WP300 04810CSR MOVE OMRWK$ MRWK$ 60 WP300 04820CSR MOVE OMLABH MLABHR 50 WP300 04830CSR MOVE OMRWKH MRWKHR 50 WP300 0004840CSR MOVE OMSCRP MSCRAP 70 WP300 04850CSR MOVE OPRTNO PRTNUM 12 WP300 04860CSR ENDMWK ENDSR WP300 04870C********************************************************************WP300 04880C* WP300 04890C* THIS ROUTINE UPDATES THE LAST MASTER WORK ORDER RECORD READ. WP300 04900C********************************************************************WP300 0004910C* WP300 04920CSR MWKOUT BEGSR WP300 04930CSR WOUPD CHAINWRKORD 55 WP300 04940CSR SETON 85 WP300 04950CSRN55 EXCPT WP300 04960CSR SETOF 85 WP300 04970CSR ENDSR WP300 0004980C********************************************************************WP300 04990C* WP300 05000C* THIS ROUTINE OUTPUTS A RECORD TO THE NEW WORK OPERATION WP300 05010C* FILE. WP300 05020C* WP300 05030C********************************************************************WP300 05040CSR OPROUT BEGSR WP300 0005050CSRN99 GOTO ENDOUT WP300 05060CSR CRRN ADD 1 CRRN 50 WP300 05070CSR Z-ADDCRRN RRN WP300 05080CSR CRRN CHAINNWKOPR 54 WP300 05090CSR 54 EXSR ENDFIL WP300 05100CSR 54 GOTO ENDOUT WP300 05110CSR Z-ADDWONUM NEWWO 50 WP300 0005120CSR 82 Z-ADDTWONUM NEWWO WP300 05130CSR NEWWO COMP LSTWO 8686 WP300 05140CSR Z-ADDNEWWO LSTWO 50 WP300 05150CSR Z-ADDNEWWO WOUPD WP300 05160CSR 86 EXSR MWKOUT WP300 05170CSR SETOF 86 WP300 05180CSR SETON 80 WP300 0005190CSR EXCPT WP300 05200CSR SETOF 80 WP300 05210CSR ENDOUT TAG WP300 05220CSR SETON 99 WP300 05230CSR ENDSR WP300 05240C********************************************************************WP300 05250C* WP300 0005260C* THIS ROUTINE IS USED TO READ AND UPDATE THE NEXT OPERATION WP300 05270C* TO WHICH ITEMS ARE BEING MOVED. THE OPERATION RECORD MIGHT WP300 05280C* BE LOCATED IN THE NEW OPERATION FILE OR THE OLD ONE. THE CURRENT WP300 05290C* OPERATION RECORD IS SAVED BY OUTPUTING IT THEN READING IT WP300 05300C* BACK AFTER THE UPDATE IS DONE. WP300 05310C* WP300 05320C********************************************************************WP300 0005330CSR GNXTOP BEGSR WP300 05340CSR Z-ADDWONUM FROMWO 50 WP300 05350CSR SETOF 213522 WP300 05360C* TTOOP COMP 0 20 WP300 05370CSRN20 GOTO NXTRN WP300 05380C* TTOOP COMP OPNUM 202122 WP300 05390CSR 22 GOTO ADDIT WP300 0005400CSR MOVELWONUM KEY 80 WP300 05410C* MOVE TTOOP KEY WP300 05420CSR KEY CHAINTMPIND 30 WP300 05430CSR 30 GOTO ENDGN WP300 05440CSR 21 TRN ADD OFFSET TRN WP300 05450CSR TRN SUB 1 TEMP WP300 05460CSR TEMP COMP INRRN 20 WP300 0005470CSRN20N34 MOVE 'X' OOOCD WP300 05480CSR SETON 35 WP300 05490CSR GOTO CHNIT WP300 05500CSR NXTRN TAG WP300 05510CSR INRRN ADD 1 TRN WP300 05520CSR CHNIT TAG WP300 05530CSR SETON 81 WP300 0005540CSR EXCPT OUTPUT CURRENT WP300 05550CSR SETOF 81 WP300 05560CSRN21 GOTO TGN1 WP300 05570CSR TRN CHAINNWKOPR 30 WP300 05580CSR MOVE NQTYQ QTYQ WP300 05590CSR MOVE NQTYC QTYC WP300 05600CSR MOVE NSCRAP SCRAP WP300 0005610CSR MOVE NRWKQ RWKQ WP300 05620CSR TGN1 TAG WP300 05630CSRN21 TRN CHAINWRKOPR 30 WP300 05640CSR 30 GOTO RSTWRK WP300 05650CSR WONUM COMP FROMWO 35 WP300 05660CSRN35 GOTO RSTWRK WP300 05670CSR ADDIT TAG WP300 0005680CSRN34 QTYQ ADD TQTY QTYQ 32 WP300 05690CSR 34 RWKQ ADD TQTY RWKQ 32 WP300 05700CSR 32 GOTO RSTWRK WP300 05710CSR QTYC ADD SCRAP TOTCOM WP300 05720CSR QTYQ COMP TOTCOM 20 WP300 05730CSR 20 Z-ADD9 ERRNO WP300 05740CSR 22 GOTO ENDGN WP300 0005750CSRN21 SETON 81 WP300 05760CSR 21 SETON 83 WP300 05770CSR EXCPT UPDATE 'TO' WP300 05780CSR SETOF 8183 WP300 05790CSR RSTWRK TAG WP300 05800CSR INRRN CHAINWRKOPR RESTORE CURRENTWP300 05810CSR ENDGN ENDSR WP300 0005820C********************************************************************WP300 05830C*** WP300 05840C***THIS ROUTINE OUTPUTS A RECORD TO THE INVENTORY TRANSACTION FILE. WP300 05850C***THESE TRANSACTIONS WILL BE PROCESSED IN THE 'ITA' SYSTEM. WP300 05860C*** WP300 05870C********************************************************************WP300 05880CSR OUTRNS BEGSR WP300 0005890CSR MOVEL'WO' REFNO 7 WP300 05900CSR MOVE WONUM REFNO WP300 05910CSR SETON 89 WP300 05920CSR EXCPT WP300 05930CSR SETOF 89 WP300 05940CSR ENDSR WP300 05950C********************************************************************WP300 0005960CSR ENDFIL BEGSR WP300 05970CSR MOVEL'FILE TOO'MESG 16 WP300 05980CSR MOVEL'SMALL 'MESG WP300 05990CSR MESG DSPLYDSPFIL WP300 06000CSR ENDSR WP300 06010C********************************************************************WP300 06020ONWKOPR E 80 WP300 0006030O N82 WONUM 5 WP300 06040O N82 OPNUM 8 WP300 06050O 82 TWONUM 5 WP300 06060O* 82 TOPNUM 8 WP300 06070O WRKSTA 17 WP300 06080O PRDRT 22 WP300 06090O SETUP 25 WP300 0006100O OUTPC 26 WP300 06110O LSTOP 84 WP300 06120O RRN 89 WP300 06130O QTYQ 33 WP300 06140O QTYC 40 WP300 06150O RWKQ 47 WP300 06160O RWKC 54 WP300 0006170O LAB$ 60 WP300 06180O RWK$ 66 WP300 06190O LABHRS 71 WP300 06200O RWKHRS 76 WP300 06210O SCRAP 83 WP300 06220O CRRN 89 WP300 06230O E 83 WP300 0006240O REC 90 WP300 06250O QTYQ 33 WP300 06260O QTYC 40 WP300 06270O SCRAP 83 WP300 06280O RWKQ 47 WP300 06290OWRKOPR E 81 WP300 06300O WONUM 5 WP300 0006310O OPNUM 8 WP300 06320O DEPT 12 WP300 06330O WRKSTA 17 WP300 06340O PRDRT 22 WP300 06350O SETUP 25 WP300 06360O OUTPC 26 WP300 06370O QTYQ 33 WP300 0006380O QTYC 40 WP300 06390O RWKQ 47 WP300 06400O RWKC 54 WP300 06410O LAB$ 60 WP300 06420O RWK$ 66 WP300 06430O LABHRS 71 WP300 06440O RWKHRS 76 WP300 0006450O SCRAP 83 WP300 06460O LSTOP 84 WP300 06470O RRN 89 WP300 06480OSWTRAN D 87 WP300 06490O ERRNO 60 WP300 06500OTRNWO3 E 89 WP300 06510O PRTNUM 61 WP300 0006520O REFNO 28 WP300 06530O ITRN 14 WP300 06540O IQTY 21 WP300 06550O UDATE 34 WP300 06560OWRKORD E 85N86 WP300 06570O MQTYC 44 WP300 06580O MLAB$ 78 WP300 0006590O MBUR 84 WP300 06600O MOUTP$ 90 WP300 06610O MRWK$ 96 WP300 06620O MLABHR 101 WP300 06630O MRWKHR 106 WP300 06640O MSCRAP 113 WP300 06650O CLSDTE 50 WP300 0006660O OOOCD 61 WP300 06670O E 86 WP300 06680O CRRN 66 WP300 ** 006690ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 006700ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 006710ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00672000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 006730/* 006740_ 00 00 00 00 00 00 00 00 00 00 00 __ 0(, ,}TXWP100 P999999032978(000010H S WP100 00020X DECK-ID P19 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP100 00030F* WORKORDER TRANSACTION EDIT PROGRAM - BY OPERATION WP100 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP100 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP100 00060F* CONTROL DATA PROPRIETARY PRODUCT WP100 00070F* WP100 0000080FWKOUT IPEAF 128 DISK WP100 00090FPARTMST IC F 300R20AI 271 DISK WP100 00100FLABMST IC F 48R 2AI 1 DISK WP100 00110FWTRANS O F 60 DISK WP100 00120F* WP100 00130F* THIS PROGRAM PERFORMS A PRE-EDIT ON THE WORK ORDER TRANSACTIONS. WP100 00140F* IT ALSO INSERTS SOME INFORMATION FROM THE MASTER PARTS OR MASTER WP100 0000150F* LABOR FILE IN SOME OF THE TRANSACTIONS. WP100 00160F* WP100 00170IWKOUT NS 01 1NC 2NC WP100 00180I 1 20TC WP100 00190I 1 2 ATC WP100 00200I 8 27 PARTNO WP100 00205I 33 390QTY 0000210I 1 55 REC1 WP100 00220I* NS 02 1NC 2NC WP100 00230I* 1 20TC WP100 00240I* 1 2 ATC WP100 00250I* 8 100OPNUM WP100 00260I* 12 180QTY WP100 00270I* 19 20 LABGRD WP100 0000280I* 27 38 PARTNO WP100 00290I* 1 58 REC2 WP100 00300I* NS 03 WP100 00310I* 1 1 A WP100 00320IPARTMST NS 05 WP100 00330I 75 813MAT WP100 00340I 110 1163LAB WP100 0000350I 117 1233BUR WP100 00360I 124 1303OUTPR WP100 00370I 74 74 PDCODE WP100 00380ILABMST NS 07 WP100 00390I 23 293LRATE WP100 00400I 31 341BURDNF WP100 00410I 30 30 LDCODE WP100 0000420C ATC COMP '<>' 52 WP100 00430C 52 GOTO DEND WP100 00440C Z-ADD0 ERRNO 20 WP100 00450C SETOF 80 WP100 00460C Z-ADD0 BURDNF WP100 00470C********************************************************************WP100 00480C* WP100 0000490C* TC NUMBERS MUST BE 51-63 WP100 00500C* WP100 00510C********************************************************************WP100 00520C 03 GOTO DEND WP100 00530C TC COMP 50 20 WP100 00540C 20 TC COMP 64 20 WP100 00550C 20 TC COMP 61 2020 WP100 0000560C N20 Z-ADD21 ERRNO 20 INVALID TC# WP100 00570C N20 GOTO DEND WP100 00580C********************************************************************WP100 00590C* WP100 00600C* PARTNO MUST BE ON THE MASTER FILE FOR TC 51 AND 58 WP100 00610C* WP100 00620C********************************************************************WP100 0000630C TC COMP 51 20 WP100 00640C N20 TC COMP 58 20 WP100 00650C N20 GOTO CHKOP WP100 00660C PARTNO CHAINPARTMST 55 WP100 00670C N55 PDCODE COMP 'D' 55 WP100 00680C 55 Z-ADD22 ERRNO INVALID PART# WP100 00690C 55 GOTO DEND WP100 0000700C********************************************************************WP100 00710C* WP100 00720C* FOR TC = 54,55,56,57,59,+ 60 OPERATION NUMBER MUST BE WP100 00730C* A POSITIVE NUMBER WP100 00740C* WP100 00750C********************************************************************WP100 00760C CHKOP TAG WP100 0000770C* TC COMP 53 20 WP100 00780C* 20 TC COMP 61 20 WP100 00790C* 20 TC COMP 58 2020 WP100 00800C* 20 OPNUM COMP 000 21 INVLD OPER # WP100 00810C* 20N21 Z-ADD24 ERRNO WP100 00820C 20N21 GOTO DEND WP100 00830C********************************************************************WP100 0000840C* WP100 00850C* TC 57 MUST HAVE A LABOR GRADE CODE WHICH IS ON THE LABOR MASTER WP100 00860C* RECORD. IF IT IS A VDLID LABOR GRADE THE THE LABOR DOLLARS WP100 00870C* ARE COMPUTED BY MULTIPLYING THE HOURS (QTY) BY THE RATE IN THE WP100 00880C* LABOR MASTER FILE. BURDEN FACTOR IS PASSED FROM THE LABOR WP100 00890C* MASTER FILE TO THE WTRANS FILE. WP100 00900C* WP100 0000910C********************************************************************WP100 00920C* TC COMP 57 80 WP100 00930C* N80 GOTO CHK58 WP100 00940C* LABGRD CHAINLABMST 55 WP100 00950C* N55 LDCODE COMP 'D' 55 WP100 00960C* 55 Z-ADD23 ERRNO INVLD LABOR GRDWP100 00970C* N55 QTY MULT LRATE DOLRS 60H WP100 0000980C* GOTO DEND WP100 00990C********************************************************************WP100 01000C* WP100 01010C* TO 58 TAKES THE QUANTITY REPORTED IN 'QTY' AND EXTENDS IT BY WP100 01020C* THE TOTAL COST AS FOUND IN THE PARTMST FILE. WP100 01030C* WP100 01040C********************************************************************WP100 0001050C CHK58 TAG WP100 01060C TC COMP 58 80 WP100 01070C N80 GOTO DEND WP100 01080C LAB ADD MAT TOT 83 WP100 01090C TOT ADD BUR TOT WP100 01100C TOT ADD OUTPR TOT WP100 01110C* QTY MULT TOT DOLRS H WP100 0001120C DEND TAG WP100 01130OWTRANS D 01N52 WP100 01140O REC1 55 WP100 01150O ERRNO 60 WP100 01160O* D 02N52 WP100 01170O* REC2 58 WP100 01180O* 80DOLRS 26 WP100 0001190O* BURDNF 54 WP100 01200O* ERRNO 60 WP100 ** 001210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00125000/* 001260_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( TTXWP510 P999999032978(000010H S WP510 00020X DECK-ID P12 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP510 00030F* PRINTS TRANSACTION REGISTER WP510 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP510 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP510 00060F* CONTROL DATA PROPRIETARY PRODUCT WP510 00070F* WP510 0000080FSWTRAN IPEAF 60 DISK WP510 00090FECODES IC F 40R DISK WP510 00100FHEADING IT F 40 EDISK WP510 00110F$LP1 O F 132 OF PRINTER WP510 00120F* WP510 00130F* THIS PROGRAM PRINTS THE TRANSACTIONS IN 'SWTRAN' AND ANY ERROR WP510 00140F* OR WARNING CODES. WP510 0000150F* WP510 00160E HEADING HEAD 1 1 40 WP510 00170ISWTRAN NS 01 1NC 2NC WP510 00180I 1 20TC WP510 00190I 3 70WONUM WP510 00200I 8 27 PARTNO WP510 00210I 32 32 STATUS WP510 0000220I 33 390QTY WP510 00230I 40 450RLSDAT WP510 00240I 46 510REQDAT WP510 00250I 52 54 PRI WP510 00260I 55 55 REQGEN WP510 00270I 59 600ERRCOD WP510 00280I* NS 02 WP510 0000290I* 1 20TC WP510 00300I* 3 70WONUM WP510 00310I* 8 100OPNUM WP510 00320I* 11 11 MCODE WP510 00330I* 12 180QTY WP510 00340I* 19 20 LABGRD WP510 00350I* 21 260DLRS WP510 0000360I* 27 50 PARTNO WP510 00370I* 51 541BFACT WP510 00380I* 55 570TOOPR WP510 00390I* 58 58 TMCODE WP510 00400I* 59 600ERRCOD WP510 00410IECODES NS 03 WP510 00420I 1 40 EDESC WP510 0000430C SETOF 1516 WP510 00440C ERRCOD COMP 0 16 16-WARNING WP510 00450C 16 ERRCOD COMP 19 151616 15-ERROR WP510 00460C 15 NERRS ADD 1 NERRS 50 WP510 00470C 16 NWRNS ADD 1 NWRNS 50 WP510 00480C NTRNS ADD 1 NTRNS 50 WP510 00490C********************************************************************WP510 0000500C* IN THIS SECTION WE PRINT ALL THE ERROR CODES AND THEIR WP510 00510C* MEANINGS. THE ERROR CODE IS A RANDOM FILE. THE ERROR CODE WP510 00520C* IS ALSO THE RELATIVE RECORD NUMBER WP510 00530C********************************************************************WP510 00540CLR SETON 81 WP510 00550CLR EXCPT WP510 00560CLR SETOF 81 WP510 0000570CLR SETON 80 WP510 00580CLR Z-ADD1 RRN1 50 WP510 00590CLR LOOP TAG WP510 00600CLR RRN1 CHAINECODES 50 WP510 00610CLR 50 GOTO LEND WP510 00620CLR MOVE EDESC ED1 40 WP510 00630CLR RRN1 ADD 20 RRN2 50 WP510 0000640CLR RRN2 CHAINECODES 50 WP510 00650CLR 50 GOTO LEND WP510 00660CLR EXCPT WP510 00670CLR RRN1 ADD 1 RRN1 WP510 00680CLR RRN1 COMP 20 20 WP510 00690CLRN20 GOTO LOOP WP510 00700CLR LEND TAG WP510 0000710O$LP1 H 02 1P WP510 00720O OR OF WP510 00730O HEAD 86 WP510 00740O H 1 1P WP510 00750O OR OF WP510 00760O 4 'PAGE' WP510 00770O PAGE Z 8 WP510 0000780O 75 'TRANSACTION LISTING' WP510 00790O UDATE Y 85 WP510 00800O 132 'JOB510' WP510 00810O H 2 1P WP510 00820O OR OF WP510 00830O 19 'TRAN# W.O.# OP# MT' WP510 00840O 38 'QUANTITY DOLLARS' WP510 0000850O 52 'PART NUMBER' WP510 00860O 67 'LAB' WP510 00870O 89 'BURDEN - TO - STATUS' WP510 00880O 112 'RELEASE REQUIRED PRI' WP510 00890O 122 'R ERROR' WP510 00900O H 11 1P WP510 00910O OR OF WP510 0000920O 67 'GRD' WP510 00930O 82 'FACTOR OP MT' WP510 00940O 98 'DATE' WP510 00950O 108 'DATE' WP510 00960O 122 'G CODE' WP510 00970O D 1 01 WP510 00980O TC 3 WP510 0000990O WONUM Z 12 WP510 01000O PARTNO 61 WP510 01010O STATUS 89 WP510 01020O QTY L 30 WP510 01030O RLSDATY 99 WP510 01040O REQDATY 108 WP510 01050O PRI 112 WP510 0001060O REQGEN 115 WP510 01070O ERRCODZ 122 WP510 01080O 15 127 '****' WP510 01090O 16 125 '**' WP510 01100O* D 1 02 WP510 01110O* TC 3 WP510 01120O* WONUM Z 12 WP510 0001130O* OPNUM Z 16 WP510 01140O* MCODE 19 WP510 01150O* QTY L 30 WP510 01160O* DLRS L 39 WP510 01170O* PARTNO 64 WP510 01180O* LABGRD 66 WP510 01190O* BFACT 4 74 WP510 0001200O* TOOPR 78 WP510 01210O* TMCODE 82 WP510 01220O* ERRCODZ 122 WP510 01230O* 15 127 '****' WP510 01240O* 16 125 '**' WP510 01250O E 0210 81 WP510 01260O 75 'TRANSACTION SUMMARY' WP510 0001270O UDATE Y 85 WP510 01280O E 1 81 WP510 01290O 25 'THERE WERE ERRORS' WP510 01300O NERRS Z 18 WP510 01310O E 1 81 WP510 01320O 27 'WARNINGS' WP510 01330O NWRNS Z 18 WP510 0001340O E 1 81 WP510 01350O 31 'TRANSACTIONS' WP510 01360O NTRNS Z 18 WP510 01370O E 22 81 WP510 01380O 26 'WARNING CODES' WP510 01390O 87 'ERROR CODES' WP510 01400O E 1 80 WP510 0001410O RRN1 Z 13 WP510 01420O ED1 56 WP510 01430O RRN2 Z 70 WP510 01440O EDESC 113 WP510 ** 001450ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001460ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00147000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001480ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001490/* 001500_ 00 00 00 00 00 00 00 __ 0(, ,}NTXWP400 Pv999999051278(000010H S WP400N00020X DECK-ID P06 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP400 00030F* EXPLODES PART NUMBERS TO FIRST LEVEL INVENTIONED COMPONENTS WP400 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP400 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP400 00060F* CONTROL DATA PROPRIETARY PRODUCT WP400 00070F* WP400 0000080FOHEXPL IPEAF 50 DISK WP400 00090FBOMMST IC F 47R20AI 28 DISK WP400 00100FBOMSTR IC F 74R DISK WP400 00110FPARTMST UC F 300R20AI 271 DISK WP400 00120FTRNWO2 O F 65 DISK A WP400 00130FPICK O F 104 DISK WP400 00140F* THIS PROGRAM EXPLODES THE PART NUMBERS ON 'OHEXPL' INTO 1ST LEVEL WP400 0000150F* COMPONENT PARTS. FOR EACH COMPONENT ENCOUNTERED AN INVENTORY WP400 00160F* TRANSACTION IS ADDED TO THE INVENTORY TRANSACTION FILE. THIS WP400 00170F* TRANSACTION DECREMENTS STOCK ON HAND. IF A PART ENCOUNTERED IN WP400 00180F* THE EXPLODE IS NOT AN INVENTORIED PART THE EXPLODE CONTINUES WP400 00190F* TO THE FIRST LEVEL COMPONENTS OF THE PART. WP400 00200F*** WP400 00210F* IF THE TRANSACTION NUMBER ON THE 'OHEXPL' FILE IS 52 THEN A WP400 0000220F* 'PICK' FILE RECORD IS OUTPUT FOR EVERY COMPONENT ENCOUNTERED WP400 00230F* IN THE EXPLODE WP400 00240F*** WP400 00250F* SOH, ALLOC AND MTDUSE IN PARTMST ARE UPDATED TO WP400 00260F* REFLECT DRAW ON INVENTORY WP400 00270F* U2 - IF ON THE EXPLODE WILL CONTINUE DOWN IF THERE ARE AREN'T WP400 00280F* ENOUGH PARTS TO FILL PICK REQUIREMENT WP400 0000290E AP 26 24 WP400 00300E AQ 26 7 0 WP400 00310E AR 26 5 0 WP400 00320IOHEXPL NS 01 WP400 00330I 1 50WONUM WP400 00340I 6 25 PARTNO WP400 00350I 30 310TC WP400 0000360I 32 380QTY WP400 00370I 39 440DUEDAT WP400 00380IBOMMST NS 03 WP400 00390I 13 170RRNSTR WP400 00400IBOMSTR NS 05 WP400 00410I 1 20 PARENT WP400 00420I 55 74 COMPNT WP400 0000430I 25 313STRQTY WP400 00440I 32 360RRNREC WP400 00450I 37 410RRNDWN WP400 00460I 52 52 NXTCOD WP400 00470IPARTMST NS 07 WP400 00480I 74 74 DCODE 12 WP400 00490I 51 51 INVCOD WP400 0000500I 1 37 DESC WP400 00510I 38 39 UM WP400 00520I 146 1520SOH WP400 00530I 167 1730ALLOC WP400 00535I 196 2020MTDUSE 00540I 291 296 BINNO WP400 00550C MOVE ' ' BUFFER 72 WP400 0000560C MOVE ' ' TYPE 1 WP400 00570C Z-ADD0 MASK 10 WP400 00580C MOVE ' ' RCODE 1 WP400 00590C Z-ADD0 BLNGTH 20 WP400 00600C N01 GOTO DEND WP400 00610C TC COMP 52 70 WP400 00615C TC COMP 61 75 0000620C PARTNO CHAINBOMMST 55 WP400 00630C 55 EXSR IGNMSG WP400 00640C 55 GOTO DEND WP400 00650C MOVELPARTNO PRNT 20 WP400 00660C Z-ADDQTY PQTY 70 WP400 00670C Z-ADDRRNSTR RRN 50 WP400 00675C PARTNO CHAINPARTMST 57 0000680C SETON 81 WP400 00690C 70 EXCPT OUTPUT PARENT WP400 00700C SETOF 81 WP400 00710C Z-ADD1 IND 20 WP400 00720C LOOP TAG WP400 00730C RRN COMP 0 20 WP400 00740C N20 GOTO SIBEND WP400 0000750C RRN CHAINBOMSTR 56 WP400 00760C 56 EXSR BOMBIT WP400 00770C PRNT COMP PARENT 20 WP400 00780C N20 GOTO SIBEND WP400 00790C NXTCOD COMP '1' 20 WP400 00800C RRN ADD 1 RRN WP400 00810C 20 Z-ADD0 RRN NEXT STR REC WP400 0000820C STRQTY MULT PQTY EXQTY 70 WP400 00830C COMPNT CHAINPARTMST 55 WP400 00840C 55 EXSR BOMBIT WP400 00850C INVCOD COMP 'N' 20 WP400 00860C 20 GOTO NXTDWN WP400 00870C Z-ADDSOH STOCK 70 WP400 00875C 75 ALLOC ADD EXQTY ALLOC 0000880C N75 SOH SUB EXQTY SOH 20 WP400 00885C N20N75 MTDUSE ADD EXQTY MTDUSE 00887C 20N75 MTDUSE ADD STOCK MTDUSE 00890C 20N75 ALLOC SUB STOCK ALLOC WP400 00895C N20N75 ALLOC SUB EXQTY ALLOC 00900C 20N75 Z-ADD0 SOH WP400 00910C NU2 WP400 0000920CORN20 GOTO OUTPUT WP400 00930C 0 SUB SOH EXQTY WP400 00940C NXTDWN TAG WP400 00950C RRNDWN COMP 0 2020 WP400 00960C 20 GOTO OUTPUT WP400 00970C Z-ADDPQTY AQ,IND WP400 00980C Z-ADDRRN AR,IND WP400 0000990C MOVELPRNT AP,IND WP400 01000C SETON 8182 WP400 01010C 70 EXCPT WP400 01020C SETOF 8182 WP400 01030C IND ADD 1 IND WP400 01040C IND COMP 26 20 WP400 01050C 20 EXSR BOMBIT WP400 0001060C Z-ADDRRNDWN RRN WP400 01070C Z-ADDEXQTY PQTY WP400 01080C MOVELCOMPNT PRNT WP400 01090C GOTO LOOP WP400 01100C SIBEND TAG WP400 01110C IND COMP 1 2020 WP400 01120C 20 GOTO DEND WP400 0001130C IND SUB 1 IND WP400 01140C MOVELAP,IND PRNT WP400 01150C Z-ADDAR,IND RRN WP400 01160C Z-ADDAQ,IND PQTY WP400 01170C GOTO LOOP WP400 01180C OUTPUT TAG WP400 01190C SETON 80 WP400 0001200C EXCPT WP400 01210C SETOF 80 WP400 01220C GOTO LOOP WP400 01230C DEND TAG WP400 01240C********************************************************************WP400 01250CSR IGNMSG BEGSR WP400 01260CSR Z-ADD12 BLNGTH WP400 0001270CSR MOVE 'T' TYPE WP400 01280CSR MOVELPARTNO BUFFER WP400 01290CSR EXITFSUBRCM WP400 01300CSR RLABL BUFFER 72 WP400 01310CSR RLABL TYPE 1 WP400 01320CSR RLABL BLNGTH 20 WP400 01330CSR RLABL RCODE 1 WP400 0001340CSR RLABL MASK 10 WP400 01350CSR RLABL DTYPE 10 WP400 01360CSR Z-ADD16 BLNGTH WP400 01370CSR MOVEL'NO COMPO'WORD16 16 WP400 01380CSR MOVE 'ONENTS 'WORD16 WP400 01390CSR MOVELWORD16 BUFFER WP400 01400CSR EXITFSUBRCM WP400 0001410CSR RLABL BUFFER 72 WP400 01420CSR RLABL TYPE 1 WP400 01430CSR RLABL BLNGTH 20 WP400 01440CSR RLABL RCODE 1 WP400 01450CSR RLABL MASK 10 WP400 01460CSR RLABL DTYPE 10 WP400 01470CSR ENDSR WP400 0001480C********************************************************************WP400 01490CSR BOMBIT BEGSR WP400 01500CSR MOVE 'R' TYPE WP400 01510CSR MOVEL'BOM FILE'WORD16 WP400 01520CSR MOVE ' ERROR 'WORD16 WP400 01530CSR MOVELWORD16 BUFFER WP400 01540CSR Z-ADD1 MASK WP400 0001550CSR EXITFSUBRCM WP400 01560CSR RLABL BUFFER 72 WP400 01570CSR RLABL TYPE 1 WP400 01580CSR RLABL BLNGTH 20 WP400 01590CSR RLABL RCODE 1 WP400 01600CSR RLABL MASK 10 WP400 01610CSR RLABL DTYPE 10 WP400 0001620CSR ENDSR WP400 01630C********************************************************************WP400 01640OTRNWO2 EADD 80 WP400 01650O COMPNT 61 WP400 01655O 75 14 '61' 01660O N75 14 '62' WP400 01670O EXQTY 21 WP400 0001680O 23 'WO' WP400 01690O WONUM 28 WP400 01700O UDATE 34 WP400 01710O U1 45 '1' WP400 01720OPICK E 81 WP400 01730O OR 80 70N75 WP400 01740O 81 1 'P' WP400 0001750O 82 1 'N' WP400 01760O WONUM 6 WP400 01770O PARTNO 104 WP400 01780O 80 COMPNT 104 WP400 01790O DESC 43 WP400 01800O UM 56 WP400 01810O 80 BINNO 49 WP400 0001820O QTY 68 WP400 01830O DUEDAT 74 WP400 01840O 80 STRQTY 68 WP400 01850O 80 EXQTY 75 WP400 01860O IND 77 WP400 01870O STOCK 84 WP400 01880OPARTMST E 07N55 12 0001885O AND 80 01890O SOH 152 WP400 01900O ALLOC 173 WP400 01905O MTDUSE 202 ** 001910ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001920ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00193000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001940ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001950/* 001960_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(M J OTXIN010 P999999111111(000010H S IN010 00020X DECK-ID M55 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN010 00030F* THIS IS THE INQUIREY/MAINTENANCE PROGRAM FOR PART MASTER FILE IN010 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN010 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN010 00060F* CONTROL DATA PROPRIETARY PRODUCT IN010 00070F* IN010 0000080FNULL IPEAF 72 DISK IN010 00090F@MFG10 IC F 32R DISK IN010 00100FPARTMST UC F 0300R12AI 0001 DISK A IN010 00110E FN 050 22 FIELD NAME IN010 00120E CP 050 4 CURSOR POSITION IN010 00130E LN 050 2 0 LENGTH IN010 00140E EP 050 4 0 ENDING POSITION IN010 0000150INULL NS 01 IN010 00160I 1 1 A IN010 00170I@MFG10 NS 02 IN010 00180I 1 22 FIELDN IN010 00190I 23 26 CURPOS IN010 00200I 27 280LNGTH IN010 00210I 29 310ENDPOS IN010 0000220IPARTMST NS 03 IN010 00230I 10256 RECORD IN010 00240I 2570300 LEFT01 IN010 00250C MOVE ' ' RCODE 1 IN010 00260C MOVE RCODE B22 22 IN010 00270C MOVE RCODE BLANKS 72 IN010 00280C MOVE RCODE FILLER 1 IN010 0000290C Z-ADD0 MASK 10 IN010 00300C SETON LR IN010 00310CLR Z-ADD050 SSIZE 30 IN010 00320CLR Z-ADD006 NSECT 30 IN010 00330CLR MOVEL'D' FF 1 IN010 00340CLR MOVE '[]<>' TEMP4 4 IN010 00350CLR START TAG IN010 0000360C* ********** IN010 00370CLR EXSR FIRSTP IN010 00380C* ********** IN010 00390CLR EXSR CLRSCR IN010 00400C* ********** IN010 00410CLR 40 GOTO EOJ IN010 00420C* ********** IN010 0000430CLR Z-ADD2 VL IN010 00440CLR MOVELSECTON VAR IN010 00450CLR EXSR RTADJ IN010 00460C* ********** IN010 00470CLR MOVELVAR SECTN 20 IN010 00480CLR EXSR GETSEC IN010 00490C* ********** IN010 0000500CLRN45 GOTO START IN010 00510C* ********** IN010 00520CLR EXSR CLRSCR IN010 00530C* ********** IN010 00540CLR EXSR OUTPUT IN010 00550C* ********** IN010 00560CLR EXSR UPDATE IN010 0000570C* ********** IN010 00580CLR GOTO START IN010 00590C* ********** IN010 00600CLR EOJ TAG IN010 00610C* ********** IN010 00620C********************************************************************IN010 00630C* IN010 0000640C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND IN010 00650C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. IN010 00660C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDIN010 00670C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN IN010 00680C* IN010 00690C********************************************************************IN010 00700CSR FIRSTP BEGSR IN010 0000710C* ********** IN010 00720CSR EXSR CLRSCR IN010 00730C* ********** IN010 00740CSR Z-ADD0 SECTN IN010 00750CSR EXSR GETSEC IN010 00760C* ********** IN010 00770CSR PGE TAG IN010 0000780C* ********** IN010 00790CSR SETON 61 IN010 00800CSR SETOF 62 IN010 00810CSR EXSR OUTPUT IN010 00820C* ********** IN010 00830C* ********** IN010 00840CSR EXIT SUBRFL IN010 0000850CSR RLABL RECORD IN010 00860CSR RLABL FILLER 1 IN010 00870C* ********** IN010 00880CSR EXIT SUBRFL IN010 00890CSR RLABL LEFT01 IN010 00900CSR RLABL FILLER 1 IN010 00910C* ********** IN010 0000920C* ********** IN010 00930C* ********** IN010 00940C* ********** IN010 00950C* ********** IN010 00960C* ********** IN010 00970C* ********** IN010 00980C* ********** IN010 0000990C* ********** IN010 01000C* ********** IN010 01010C* ********** IN010 01020C* ********** IN010 01030C* ********** IN010 01040C* ********** IN010 01050CSR Z-ADD12 NCHARS IN010 0001060CSR Z-ADD1 SSTRT IN010 01070CSR Z-ADD1 TSTRT IN010 01080C* ********** IN010 01090CSR EXIT SUBRLM IN010 01100CSR RLABL KEY 12 IN010 01110CSR RLABL SSTRT 30 IN010 01120CSR RLABL RECORD IN010 0001130CSR RLABL TSTRT 30 IN010 01140CSR RLABL NCHARS 30 IN010 01150CSR Z-ADDNOFLDS SVFLDS 30 IN010 01160CSR Z-ADDSX NOFLDS IN010 01170CSR EXSR UPDATE IN010 01180C* ********** IN010 01190CSR Z-ADDSVFLDS NOFLDS IN010 0001200CSR Z-ADD12 NCHARS IN010 01210CSR Z-ADD1 SSTRT IN010 01220CSR Z-ADD1 TSTRT IN010 01230C* ********** IN010 01240CSR EXIT SUBRLM IN010 01250CSR RLABL RECORD IN010 01260CSR RLABL SSTRT 30 IN010 0001270CSR RLABL KEY IN010 01280CSR RLABL TSTRT 30 IN010 01290CSR RLABL NCHARS 30 IN010 01300CSR KEY CHAINPARTMST 55 IN010 01310CSR MOVELSAVPOS BUFFER IN010 01320CSR MOVELOFC BUFFER IN010 01330CSR EXSR POSCUR IN010 0001340C* ********** IN010 01350CSR MOVEL'] NEW R'WORD16 16 IN010 01360CSR MOVE 'ECORD 'WORD16 IN010 01370CSRN55 MOVELBLANKS WORD16 IN010 01380CSRN55 MOVEL']' WORD16 IN010 01390CSR MOVELWORD16 BUFFER 72 IN010 01400CSR MOVE 'T' TYPE 1 IN010 0001410CSR Z-ADD13 BLNGTH 20 IN010 01420CSR EXSR CRTCOM IN010 01430C* ********** IN010 01440CSR SETON 62 IN010 01450CSR Z-ADDSX X 30 IN010 01460CSR EXSR ACCEPT IN010 01470C* ********** IN010 0001480CSR MOVELBUFFER SECTON 2 IN010 01490CSR SECTON COMP 'E ' 40 IN010 01500CSR 40 GOTO ENDFP IN010 01510C* ********** IN010 01520CSR SECTON COMP 'D ' 40 IN010 01530CSR 40N55 EXCPT IN010 01540CSR 40 GOTO PGE IN010 0001550C* ********** IN010 01560CSR SECTON COMP ' 1' 30 30 IN010 01570CSR 30 SECTON COMP ' 9' 3030 IN010 01580CSR 30 GOTO GOOD IN010 01590C* ********** IN010 01600CSR SECTON COMP '01' 30 30 IN010 01610CSR 30 SECTON COMP '09' 3030 IN010 0001620CSR 30 GOTO GOOD IN010 01630C* ********** IN010 01640CSR SECTON COMP '1 ' 30 30 IN010 01650CSR 30 SECTON COMP '9 ' 3030 IN010 01660CSR 30 GOTO GOOD IN010 01670C* ********** IN010 01680CSR MOVELSECTON TEMP1 1 IN010 0001690CSR TEMP1 COMP '1' 30 30 IN010 01700CSR 30 TEMP1 COMP '9' 3030 IN010 01710CSRN30 GOTO PGE IN010 01720C* ********** IN010 01730CSR MOVE SECTON TEMP1 IN010 01740CSR TEMP1 COMP '0' 30 30 IN010 01750CSR 30 TEMP1 COMP '9' 3030 IN010 0001760CSRN30 GOTO PGE IN010 01770C* ********** IN010 01780CSR GOOD TAG IN010 01790C* ********** IN010 01800CSR SETOF 6162 IN010 01810CSRN55 GOTO ENDFP IN010 01820C* ********** IN010 0001830CSR SETON 80 IN010 01840CSR EXCPT IN010 01850CSR SETOF 80 IN010 01860CSR KEY CHAINPARTMST 55 IN010 01870CSR ENDFP ENDSR IN010 01880C* ********** IN010 01890C********************************************************************IN010 0001900C* IN010 01910C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. IN010 01920C* IN010 01930C********************************************************************IN010 01940CSR GETSEC BEGSR IN010 01950C* ********** IN010 01960CSR 1 ADD SECTN N 20 IN010 0001970CSR SETOF 404145 IN010 01980CSR N COMP 0 3030 IN010 01990CSRN30 N COMP NSECT 30 IN010 02000CSR 30 GOTO ENDGET IN010 02010C* ********** IN010 02020CSR SECTN MULT SSIZE RRN 40 IN010 02030CSR Z-ADD1 X IN010 0002040CSR SCLOOP TAG IN010 02050C* ********** IN010 02060CSR RRN ADD 1 RRN IN010 02070CSR RRN CHAIN@MFG10 50 IN010 02080CSR 50 GOTO ENDGET IN010 02090C* ********** IN010 02100CSR FIELDN COMP B22 4141 IN010 0002110CSRN41 GOTO ENDGET IN010 02120C* ********** IN010 02130CSR 41N45 SETON 45 IN010 02140CSR MOVE FIELDN FN,X IN010 02150CSR MOVE CURPOS CP,X IN010 02160CSR MOVE LNGTH LN,X IN010 02170CSR Z-ADDENDPOS EP,X IN010 0002180CSR 1 ADD X X IN010 02190CSR X COMP SSIZE 32 IN010 02200CSRN32 GOTO SCLOOP IN010 02210C* ********** IN010 02220CSR ENDGET TAG IN010 02230C* ********** IN010 02240CSR Z-ADDX NOFLDS 30 IN010 0002250CSR 45 GOTO FINGET IN010 02260C* ********** IN010 02270CSR EXSR CLRSCR IN010 02280C* ********** IN010 02290CSR MOVEL'SECT # 'WORD9 9 IN010 02300CSR Z-ADD16 BLNGTH IN010 02310CSR MOVE SECTN WORD9 IN010 0002320CSR MOVELWORD9 WORD16 IN010 02330CSRN30 MOVE ' ABSENT' WORD16 IN010 02340CSR 30 MOVE ' ILLEG.' WORD16 IN010 02350CSR MOVELWORD16 BUFFER IN010 02360CSR MOVEL'T' TYPE IN010 02370CSR EXSR CRTCOM IN010 02380C* ********** IN010 0002390CSR FINGET ENDSR IN010 02400C* ********** IN010 02410C********************************************************************IN010 02420C* IN010 02430C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE IN010 02440C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE IN010 02450C* SECTION INDEX IS SAVED. IN010 0002460C* IN010 02470C********************************************************************IN010 02480CSR OUTPUT BEGSR IN010 02490C* ********** IN010 02500CSR EXSR CLRSCR IN010 02510C* ********** IN010 02520CSR Z-ADD1 X IN010 0002530CSR 61 SETON 63 IN010 02540CSR OTLOOP TAG IN010 02550C* ********** IN010 02560CSR 61 LN,X COMP 0 31 IN010 02570CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXIN010 02580CSR EXSR OUTFLD IN010 02590C* ********** IN010 0002600CSR X ADD 1 X IN010 02610CSR X COMP NOFLDS 31 IN010 02620CSR 31 GOTO OTLOOP IN010 02630C* ********** IN010 02640CSR SETOF 63 IN010 02650CSR ENDSR IN010 02660C********************************************************************IN010 0002670C* IN010 02680C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND IN010 02690C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 IN010 02700C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS IN010 02710C* THEN NO FIELD INFORMATION IS PRINTED IN010 02720C* IN010 02730C********************************************************************IN010 0002740CSR OUTFLD BEGSR IN010 02750C* ********** IN010 02760CSR MOVE FN,X FL 20 IN010 02770CSR EP,X COMP 0 98 IN010 02780CSR MOVELCP,X FC 20 IN010 02790CSR FC COMP FL 31 IN010 02800CSR 31 Z-ADDFC FL IN010 0002810CSR FC SUB FL CC 20 IN010 02820CSR CC ADD 1 CC IN010 02830CSR MOVELCP,X BUFFER IN010 02840CSR MOVELCC BUFFER IN010 02850CSR EXSR POSCUR IN010 02860C* ********** IN010 02870CSR MOVELBLANKS BUFFER IN010 0002880CSR MOVELFN,X FIELDN IN010 02890CSR MOVE ' ' FIELDN IN010 02900CSR MOVELFIELDN BUFFER IN010 02910CSR Z-ADDLN,X LEN 20 IN010 02920CSR LEN COMP 0 9730 IN010 02930CSR 97 Z-SUBLN,X LEN IN010 02940CSR 30 GOTO SKIPF IN010 0002950C* ********** IN010 02960CSR FL ADD 2 BPOS 20 IN010 02970C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS IN010 02980CSR Z-ADDBPOS TSTRT 30 IN010 02990CSRN98 Z-ADD1 SSTRT 30 IN010 03000CSR 98 Z-ADD3 SSTRT IN010 03010CSR Z-ADD1 NCHARS 30 IN010 0003020C* ********** IN010 03030CSR EXIT SUBRLM IN010 03040CSR RLABL TEMP4 IN010 03050CSR RLABL SSTRT 30 IN010 03060CSR RLABL BUFFER IN010 03070CSR RLABL TSTRT 30 IN010 03080CSR RLABL NCHARS 30 IN010 0003090CSR BPOS ADD 1 FPOS 20 IN010 03100CSR EXSR MVRECD IN010 03110C* ********** IN010 03120CSR SKIPF TAG IN010 03130C* ********** IN010 03140CSR 30 Z-ADDFL BLNGTH IN010 03150CSRN30 FL ADD 3 BLNGTH IN010 0003160CSRN30 BLNGTH ADD LEN BLNGTH IN010 03170CSR MOVE 'T' TYPE IN010 03180CSR EXSR CRTCOM IN010 03190C* ********** IN010 03200CSR ENDSR IN010 03210C********************************************************************IN010 03220C* IN010 0003230C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN IN010 03240C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST IN010 03250C* THE RIGHT BRACKET. IN010 03260C********************************************************************IN010 03270CSR MVRECD BEGSR IN010 03280C* ********** IN010 03290CSR 63 GOTO RBRK IN010 0003300C* ********** IN010 03310CSR 98 Z-SUBEP,X END 40 IN010 03320CSRN98 Z-ADDEP,X END IN010 03330CSR END SUB LEN STRT 40 81 81 IN010 03340CSR STRT ADD 1 STRT IN010 03350C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER IN010 03360C* FROM STRT IN RECORD TO FPOS IN BUFFER IN010 0003370CSR Z-ADDLEN NCHARS IN010 03380CSR Z-ADDSTRT SSTRT IN010 03390CSR Z-ADDFPOS TSTRT IN010 03400C* ********** IN010 03410CSRN81 GOTO RBRK IN010 03420CSR EXIT SUBRLM IN010 03430CSR RLABL RECORD IN010 0003440CSR RLABL SSTRT 30 IN010 03450CSR RLABL BUFFER IN010 03460CSR RLABL TSTRT 30 IN010 03470CSR RLABL NCHARS 30 IN010 03480CSR RBRK TAG IN010 03490C* ********** IN010 03500CSR EXSR RTBRKT IN010 0003510C* ********** IN010 03520CSR ENDSR IN010 03530C********************************************************************IN010 03540C* IN010 03550C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS IN010 03560C* IN010 03570C********************************************************************IN010 0003580CSR RTBRKT BEGSR IN010 03590C* ********** IN010 03600CSR LEN ADD FPOS FPOS IN010 03610CSR Z-ADDFPOS TSTRT IN010 03620CSR Z-ADD1 NCHARS IN010 03630CSRN98 Z-ADD2 SSTRT IN010 03640CSR 98 Z-ADD4 SSTRT IN010 0003650C* ********** IN010 03660CSR EXIT SUBRLM IN010 03670CSR RLABL TEMP4 IN010 03680CSR RLABL SSTRT 30 IN010 03690CSR RLABL BUFFER IN010 03700CSR RLABL TSTRT 30 IN010 03710CSR RLABL NCHARS 30 IN010 0003720CSR ENDSR IN010 03730C********************************************************************IN010 03740C* IN010 03750C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. IN010 03760C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO IN010 03770C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF IN010 03780C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST IN010 0003790C* OF THE FIELDS ARE LEFT UNCHANGED IN010 03800C* IN010 03810C********************************************************************IN010 03820CSR UPDATE BEGSR IN010 03830C* ********** IN010 03840CSR SETOF 32 IN010 03850CSR Z-ADD1 X IN010 0003860CSR UPLOOP TAG IN010 03870C* ********** IN010 03880CSR EP,X COMP 0 98 IN010 03890CSR 98 SETON 30 IN010 03900CSR 98 GOTO NOUPD IN010 03910C* ********** IN010 03920CSR Z-ADDLN,X LEN IN010 0003930CSR LEN COMP 0 9730 IN010 03940CSR 97 Z-SUBLEN LEN IN010 03950CSR NOUPD TAG IN010 03960C* ********** IN010 03970CSR 30N32 GOTO INCR IN010 03980C* ********** IN010 03990CSR 30 GOTO CHKRUB IN010 0004000C* ********** IN010 04010CSR SETOF 3233 IN010 04020CSR EXSR ACCEPT IN010 04030C* ********** IN010 04040CSR CHKRUB TAG IN010 04050C* ********** IN010 04060CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTIN010 0004070CSR 32 31 GOTO UPLOOP IN010 04080C* ********** IN010 04090CSR 32 GOTO ENDUPD IN010 04100C* ********** IN010 04110CSR MOVELBUFFER ATSIGN 1 IN010 04120CSR ATSIGN COMP '@' 35 IN010 04130CSR 35 GOTO OUTREC IN010 0004140C* ********** IN010 04150CSR 33 GOTO INCR WAS LINE FEED IN010 04160C* ********** IN010 04170CSR Z-ADDEP,X END IN010 04180CSR END SUB LEN STRT 81 81 IN010 04190CSR STRT ADD 1 STRT IN010 04200C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF IN010 0004210C* BUFFER TO THE STRT OF RECORD IN010 04220CSR Z-ADD1 SSTRT IN010 04230CSR Z-ADDSTRT TSTRT IN010 04240CSR Z-ADDLEN NCHARS IN010 04250C* ********** IN010 04260CSRN81 GOTO AAA IN010 04270CSR EXIT SUBRLM IN010 0004280CSR RLABL BUFFER IN010 04290CSR RLABL SSTRT 30 IN010 04300CSR RLABL RECORD IN010 04310CSR RLABL TSTRT 30 IN010 04320CSR RLABL NCHARS 30 IN010 04330CSR AAA TAG IN010 04340CSR MOVELBUFFER TEMP5 5 IN010 0004350CSR MOVELSAVPOS BUFFER IN010 04360CSR EXSR POSCUR IN010 04370C* ********** IN010 04380CSR MOVELTEMP5 BUFFER IN010 04390CSR Z-ADD1 FPOS IN010 04400CSR EXSR RTBRKT IN010 04410C* ********** IN010 0004420CSR LEN ADD 1 BLNGTH IN010 04430CSR MOVE 'T' TYPE IN010 04440CSR EXSR CRTCOM IN010 04450C* ********** IN010 04460CSR INCR TAG IN010 04470C* ********** IN010 04480CSR X ADD 1 X IN010 0004490CSR X COMP NOFLDS 30 IN010 04500CSR 30 GOTO UPLOOP IN010 04510C* ********** IN010 04520CSR OUTREC TAG IN010 04530C* ********** IN010 04540CSR SETON 80 IN010 04550CSRN61 EXCPT IN010 0004560CSR SETOF 80 IN010 04570CSR ENDUPD TAG IN010 04580C* ********** IN010 04590CSR ENDSR IN010 04600C********************************************************************IN010 04610C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE IN010 04620C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X IN010 0004630C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND IN010 04640C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT IN010 04650C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED IN010 04660C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS IN010 04670C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS IN010 04680C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO IN010 04690C* TO BE OUTPUT TO THE SCREEN. IN010 0004700C* IN010 04710C********************************************************************IN010 04720CSR ACCEPT BEGSR IN010 04730C* ********** IN010 04740CSR X COMP 1 30 IN010 04750CSRN30 X COMP SSIZE 30 IN010 04760CSR 30 Z-ADD1 X IN010 0004770CSR MOVELCP,X FC IN010 04780CSR FC ADD 3 FC IN010 04790CSR MOVELCP,X SAVPOS 4 IN010 04800CSR MOVELFC SAVPOS IN010 04810CSR Z-ADDLN,X LEN IN010 04820CSR LEN COMP 0 97 IN010 04830CSR 97 Z-SUBLEN LEN IN010 0004840CSR LEN ADD FC OFC 20 IN010 04850CSR ACLOOP TAG IN010 04860C* ********** IN010 04870CSR MOVELSAVPOS BUFFER IN010 04880CSR EXSR POSCUR IN010 04890C* ********** IN010 04900CSR Z-ADDLEN BLNGTH IN010 0004910CSR MOVE BLANKS BUFFER IN010 04920CSR MOVE 'A' TYPE IN010 04930CSR EXSR CRTCOM IN010 04940C* ********** IN010 04950CSR RCODE COMP 'R' 31 IN010 04960CSR 31 BUFFER COMP BLANKS 32 IN010 04970CSR 31 32N62 GOTO DUPIT IN010 0004980C* ********** IN010 04990CSR 31 GOTO ACLOOP IN010 05000C* ********** IN010 05010CSR RCODE COMP 'L' 33 IN010 05020CSR 33 GOTO DUPIT IN010 05030C* ********** IN010 05040CSRN97 GOTO ENDACC IN010 0005050C* ********** IN010 05060CSR MOVELBUFFER SIGN 1 WE MUST CHECK IN010 05070CSR SIGN COMP '@' 30 IN010 05080CSR 30 GOTO ENDACC IN010 05090C* ********** IN010 05100CSR Z-ADDLEN VL 20 IN010 05110CSR MOVELBUFFER VAR 15 IN010 0005120CSR EXSR RTADJ IN010 05130C* ********** IN010 05140CSR MOVELVAR BUFFER IN010 05150CSR GOTO ENDACC IN010 05160C* ********** IN010 05170CSR DUPIT TAG IN010 05180C* ********** IN010 0005190CSR MOVELSAVPOS BUFFER IN010 05200CSR EXSR POSCUR IN010 05210C* ********** IN010 05220CSR 62 MOVELSECTON BUFFER IN010 05230CSRN62 Z-ADD1 FPOS IN010 05240CSRN62 EXSR MVRECD IN010 05250C* ********** IN010 0005260CSR MOVE 'T' TYPE IN010 05270CSR BLNGTH ADD 1 BLNGTH IN010 05280CSR EXSR CRTCOM IN010 05290C* ********** IN010 05300CSR ENDACC ENDSR IN010 05310C* ********** IN010 05320C********************************************************************IN010 0005330C* IN010 05340C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES IN010 05350C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM IN010 05360C* 4 DUMMY FOR RTADJ IN010 05370C* IN010 05380C********************************************************************IN010 05390CSR POSCUR BEGSR IN010 0005400C* ********** IN010 05410CSR MOVE 'P' TYPE IN010 05420CSR EXSR CRTCOM IN010 05430C* ********** IN010 05440CSR ENDSR IN010 05450C********************************************************************IN010 05460CSR CLRSCR BEGSR IN010 0005470C* ********** IN010 05480CSR MOVE 'C' TYPE IN010 05490CSR EXSR CRTCOM IN010 05500C* ********** IN010 05510CSR ENDSR IN010 05520C********************************************************************IN010 05530CSR CRTCOM BEGSR IN010 0005540C* ********** IN010 05550C* ********** IN010 05560CSR EXITFSUBRCM IN010 05570CSR RLABL BUFFER 72 IN010 05580CSR RLABL TYPE 1 IN010 05590CSR RLABL BLNGTH 20 IN010 05600CSR RLABL RCODE 1 IN010 0005610CSR RLABL MASK 10 IN010 05620CSR RLABL DTYPE 10 IN010 05630CSR ENDSR IN010 05640C********************************************************************IN010 05650CSR RTADJ BEGSR IN010 05660C* ********** IN010 05670CSR EXIT SUBRAJ IN010 0005680C* ********** IN010 05690CSR RLABL VL IN010 05700CSR RLABL VAR IN010 05710CSR ENDSR IN010 05720C********************************************************************IN010 05730OPARTMST E 80N55 IN010 05740O RECORD 0256 IN010 0005750O LEFT01 0300 IN010 05760O E 40N80 IN010 05770O FF 74 IN010 05780O EADD 80 55 IN010 05790O RECORD 0256 IN010 05800O LEFT01 0300 IN010 ** 00581000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005850/* 005860__0O LEFT01 0300 IN010 ** 0058100(U ~`OTXIN012 P999999111111(000010H S IN012 00020X DECK-ID M56 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN012 00030F* THIS PROGRAM LISTS PARTMST FILE RECORDS NOT FLAGGED FOR DELETE IN012 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN012 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN012 00060F* CONTROL DATA PROPRIETARY PRODUCT IN012 00070F* IN012 0000080FPARTMST IPEAF 300 12AI 1 DISK IN012 00090FHEADING IT F 40 EDISK IN012 00100F$LP1 O F 132 OF PRINTER IN012 00110F********************************************************************IN012 00120F* IN012 00130F* COMPANY IN012 00140F* SYSTEM FILE MAINTENANCE IN012 0000150F* PROGRAM LISTS OUT ALL RECORDS IN PARTMST NOT FLAGGED IN012 00160F* FOR DELETION IN012 00170F* IN012 00180F* CONTRACTOR COMPUSOURCE IN012 00190F* PROGRAMMER IN012 00200F* DATE IN012 00210F* IN012 0000220F********************************************************************IN012 00230F* IN012 00240F* ID F C H L FUNCTION OF INDICATORS IN012 00250F* IN012 00260F* 01 RECORD NOT FLAGGED FOR DELETION IN012 00270F* 02 RECORD IS FLAGGED FOR DELETION IN012 00280F* IN012 0000290F********************************************************************IN012 00300E HEADING HEAD 1 1 40 COMPANY NAME IN012 00310IPARTMST NS 01 74 C IN012 00320I 1 12 PARTNO IN012 00330I 13 37 DESCRP IN012 00340I 38 39 UM IN012 00350I 40 40 CLASS IN012 0000360I 41 430GROUP IN012 00370I 44 460LEAD IN012 00380I 47 490SAFETY IN012 00390I 50 50 ABC IN012 00400I 51 51 INVTRY IN012 00410I 57 610VNDNUM IN012 00420I 62 73 VPTNUM IN012 0000430I 75 813MATDLS IN012 00440I 89 953LABDLS IN012 00450I 96 1023BURDLS IN012 00460I 103 1093OPDLS IN012 00470I 131 1373LABHRS IN012 00480I 181 1870MINROP IN012 00490I 188 1940MAXEOQ IN012 0000500I 195 195 MINMAX IN012 00510I 210 2112ALPHA IN012 00520I 219 219 REVLTR IN012 00530I 220 2250REVDAT IN012 00540I 261 2650BIN IN012 00550I NS 02 IN012 00560I 1 1 AIR IN012 0000570C 01 COUNT ADD 1 COUNT 80 IN012 00580O$LP1 H 202 1P IN012 00590O OR OF IN012 00600O PAGE Z 10 IN012 00610O 4 'PAGE' IN012 00620O HEAD,1 85 IN012 00630O UDATE Y 132 IN012 0000640O H 2 1P IN012 00650O OR OF IN012 00660O 74 'PART MASTER FILE LISTING' IN012 00670O 132 'MFG012' IN012 00680O H 1 1P IN012 00690O OR OF IN012 00700O 6 'PART #' IN012 0000710O 24 'DESCRIPTION' IN012 00720O 54 'UM ALP LT ABC' IN012 00730O 76 'VEND # REV LTR' IN012 00740O 84 'MIN' IN012 00750O 104 'MATL $ LABOR $' IN012 00760O 114 'MIN/MAX' IN012 00770O 121 'BIN #' IN012 0000780O H 1 1P IN012 00790O OR OF IN012 00800O 59 '--------------------' IN012 00810O 79 '--------------------' IN012 00820O 99 '--------------------' IN012 00830O 114 '---------------' IN012 00840O 121 '-------' IN012 0000850O H 2 1P IN012 00860O OR OF IN012 00870O 60 'CLS GRP SS INV VEND' IN012 00880O 76 'PART # REV DATE' IN012 00890O 94 'MAX BURDEN $' IN012 00900O 114 'O.P. $ LAB HRS' IN012 00910O D 01 01 IN012 0000920O PARTNO 12 IN012 00930O DESCRP 38 IN012 00940O UM 42 IN012 00950O ALPHA L 47 IN012 00960O LEAD L 51 IN012 00970O ABC 53 IN012 00980O VNDNUM 67 IN012 0000990O REVLTR 76 IN012 01000O MINROPL 85 IN012 01010O MATDLSL 95 IN012 01020O LABDLSL 105 IN012 01030O MINMAX 114 IN012 01040O BIN Z 121 IN012 01050O D 02 01 IN012 0001060O CLASS 42 IN012 01070O GROUP 46 IN012 01080O SAFETYL 51 IN012 01090O INVTRY 53 IN012 01100O VPTNUM 67 IN012 01110O REVDATY 76 IN012 01120O MAXEOQL 85 IN012 0001130O BURDLSL 95 IN012 01140O OPDLS L 105 IN012 01150O LABHRSL 115 IN012 01160O T 3 LR IN012 01170O 22 'END OF JOB. THERE ARE' IN012 01180O COUNT 1 33 IN012 01190O 55 'ACTIVE RECORDS IN THE' IN012 0001200O 73 'PART MASTER FILE.' IN012 ** 001210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001250/* 00126000__0O 73 'PART MASTER FILE.' IN012 ** 001210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001250/* 0012600(,Q ,}GORD P999999040478(0 PROGRAM GORFTN 00010 DIMENSION ITITLE(20) 00020 FMP=0 00030 TOTALI=0 00040 TOTALP=0 00050 5 WRITE(5,300) 00060 WRITE(5,301) 0007000 WRITE(5,302) 00080 READ(5,303) IJOB 00090 6 GO TO (10,19,19,19,19,80),IJOB 00100 10 WRITE(5,350) 00110 READ(5,351)BF 00120 WRITE(5,352) 00130 READ(5,353)DIR 0014000 WRITE(5,354) 00150 READ(5,355)ITM 00160 WRITE(5,356) 00170 READ(5,357)ITITLE 00180 IF(FMP)5,11,121 00190 11 DIR=DIR/1200 00200 ANS=DIR+1 0021000 B=ANS 00220 114 DO 115 ISTEP=2,ITM,1 00230 ANS=ANS*B 00240 115 CONTINUE 00250 A=BF*DIR 00260 B=ANS*A 00270 C=ANS-1 0028000 FMP=B/C 00290 121 WRITE(12,105) 00300 LINE=1 00310 ZERO=0 00320 12 DO 15 ISTEP=1,ITM,1 00330 FI=BF*DIR 00340 PP=FMP-FI 0035000 TOTALP=TOTALP+PP 00360 TOTALI=TOTALI+FI 00370 IF(LINE.LE.50)GO TO 14 00380 WRITE(12,105) 00390 LINE=1 00400 14 WRITE(12,110)BF,PP,FI,TOTALI,TOTALP,ITITLE  00410 LINE=LINE+1 0042000 IF(BF.LE.ZERO)ISTEP=ITM+2 00430 15 BF=BF-PP 00440 GO TO 5 00450 19 WRITE(12,210) 00460 LINE=1 00470 GO TO (6,30,40,50,70,80),IJOB 00480 20 READ(5,200)IJOB,ITITLE,NNS,NOS,POA,PNA,FNP  0049000 21 GO TO (6,30,40,50,70,80),IJOB 00500 30 A=PNA*NOS 00510 B=PNA*NNS 00520 C=NOS*POA 00530 D=A+B-C 00540 FNP=D/NNS 00550 GO TO 60 0056000 40 A=PNA-POA 00570 B=FNP-PNA 00580 NNS=A*NOS/B 00590 GO TO 60 00600 50 A=NNS*FNP 00610 B=NOS*POA 00620 C=NOS+NNS 0063000 PNA=(A+B)/C 00640 60 IF(LINE.LE.30)GO TO 70 00650 WRITE(12,210) 00660 PAUSE 7 00670 LINE=1 00680 70 WRITE(12,215)ITITLE,NNS,NOS,POA,PNA,FNP  00690 LINE=LINE+1 0070000 WRITE(5,400) 00710 WRITE(5,410) 00720 GO TO 20 00730 80 STOP 00740 100 FORMAT(I1,F9.2,F5.4,I3,F6.2,2F9.2,4A10) 00750 105 FORMAT(8H1BAL FWD,6X,14HPRINCIPLE PAID,4X,13HINTEREST PAID, 00760 C4X,14HTOTAL INTEREST,5X,10HTOTAL PRIN,5X,4HNAME) 0077000 110 FORMAT(1H ,5(F9.2,8X),20A2) 00780 200 FORMAT(I1,20A2,I5,I5,3F7.2) 00790 210 FORMAT(1H1,4HNAME,42X,3HNNS,5X,3HNOS,5X,3HPOA,7X,3HPNA,7X,2HNP) 00800 215 FORMAT(1H ,20A2,5X,2(I5,3X),3(F7.2,3X)) 00810 300 FORMAT(*ENTER 1 FOR MORTAGE PAYMENT*) 00820 301 FORMAT(*ENTER 2-5 FOR STOCK CALCULATION*) 00830 302 FORMAT(*ENTER 6 TO STOP*) 0084000 303 FORMAT(I1) 00850 350 FORMAT(*ENTER 9 DIGIT BALANCE FORWARD ON LOAN*) 00860 351 FORMAT(F9.2) 00870 352 FORMAT(*ENTER INTEREST RATE*) 00880 353 FORMAT(F5.4) 00890 354 FORMAT(*ENTER TOTAL MONTHS*) 00900 355 FORMAT(I3) 0091000 356 FORMAT(*ENTER NAME UP TO 40 CHARACTERS*) 00920 357 FORMAT(20A2) 00930 410 FORMAT(*JOB-NAME40-NNS-NOS-POA-PNA-FNP*) 00940 400 FORMAT(*GET READY FOR A MESSAGE*) 00950 CALL PGMOUT 00960 END 00970_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(, ,}GORD1 PF999999040478(0 PROGRAM GORFTN 00010 DIMENSION ITITLE(10) 00020 DATA ICONT/$1807/ 00030 REAL NNS,NOS,POA,PNA,FNP 00040 FMP=0 00050 TOTALI=0 00060 TOTALP=0 0007000 5 WRITE(5,300)ICONT 00080 WRITE(5,301) 00090 WRITE(5,302) 00100 READ(5,303) IJOB 00110 6 GO TO (10,19,19,19,19,80),IJOB 00120 10 WRITE(5,350) 00130 READ(5,351)BF 0014000 WRITE(5,352) 00150 READ(5,353)DIR 00160 WRITE(5,354) 00170 READ(5,355)ITM 00180 WRITE(5,356) 00190 READ(5,357)ITITLE 00200 WRITE(5,400)ICONT 0021000 IF(FMP)5,11,121 00220 11 DIR=DIR/1200 00230 ANS=DIR+1 00240 B=ANS 00250 114 DO 115 ISTEP=2,ITM,1 00260 ANS=ANS*B 00270 115 CONTINUE 0028000 A=BF*DIR 00290 B=ANS*A 00300 C=ANS-1 00310 FMP=B/C 00320 121 WRITE(05,105) 00330 LINE=1 00340 ZERO=0 0035000 12 DO 15 ISTEP=1,ITM,1 00360 FI=BF*DIR 00370 PP=FMP-FI 00380 TOTALP=TOTALP+PP 00390 TOTALI=TOTALI+FI 00400 IF(LINE.LE.25)GO TO 14 00410 WRITE(05,900)ICONT 0042000 READ(05,303)IGORD 00430 WRITE(05,105) 00440 LINE=1 00450 14 WRITE(05,110)BF,PP,FI,TOTALI,TOTALP  00460 LINE=LINE+1 00470 IF(BF.LE.ZERO)ISTEP=ITM+2 00480 15 BF=BF-PP 0049000 GO TO 5 00500 19 WRITE(05,210) 00510 LINE=1 00520 20 WRITE(5,300)ICONT 00530 WRITE(5,301) 00540 WRITE(5,302) 00550 READ(5,303)IJOB 0056000 WRITE(5,356) 00570 READ(5,357)ITITLE 00580 WRITE(5,520)ICONT 00590 READ(5,570)POA 00600 WRITE(5,510)ICONT 00610 READ(5,560)NOS 00620 21 GO TO (6,30,40,50,70,80),IJOB 0063000 30 WRITE(5,530)ICONT 00640 READ(5,580)PNA 00650 WRITE(5,500)ICONT 00660 READ(5,550)NNS 00670 A=PNA*NOS 00680 B=PNA*NNS 00690 C=NOS*POA 0070000 D=A+B-C 00710 FNP=D/NNS 00720 GO TO 60 00730 40 WRITE(5,530)ICONT 00740 READ(5,580)PNA 00750 WRITE(5,540)ICONT 00760 READ(5,590)FNP 0077000 A=PNA-POA 00780 B=FNP-PNA 00790 NNS=A*NOS/B 00800 GO TO 60 00810 50 WRITE(5,500)ICONT 00820 READ(5,550)NNS 00830 WRITE(5,540)ICONT 0084000 READ(5,590)FNP 00850 A=NNS*FNP 00860 B=NOS*POA 00870 C=NOS+NNS 00880 PNA=(A+B)/C 00890 60 IF(LINE.LE.20)GO TO 70 00900 WRITE(05,210) 0091000 00920 LINE=1 00930 70 WRITE(05,215)ITITLE,NNS,NOS,POA,PNA,FNP  00940 LINE=LINE+1 00950 WRITE(5,400) 00960 WRITE(5,410) 00970 READ(5,303) 0098000 GO TO 20 00990 80 CALL PGMOUT 01000 100 FORMAT(I1,F9.2,F5.4,I3,F6.2,2F9.2,4A10) 01010 105 FORMAT(8H1BAL FWD,6X,14HPRINCIPLE PAID,4X,13HINTEREST PAID, 01020 C4X,14HTOTAL INTEREST,5X,10HTOTAL PRIN,5X,4HNAME) 01030 110 FORMAT(1H ,5(F9.2,5X)) 01040 200 FORMAT(I1,20A2,I5,I5,3F7.2) 0105000 210 FORMAT(1H1,4HNAME,42X,3HNNS,5X,3HNOS,5X,3HPOA,7X,3HPNA,7X,2HNP) 01060 215 FORMAT(1H ,10A2,5(F7.2,3X)) 01070 300 FORMAT(A2,*ENTER 1 FOR MORTAGE PAYMENT*) 01080 301 FORMAT(*ENTER 2-5 FOR STOCK CALCULATION*) 01090 302 FORMAT(*ENTER 6 TO STOP*) 01100 303 FORMAT(I1) 01110 350 FORMAT(*ENTER 9 DIGIT BALANCE FORWARD ON LOAN*) 0112000 351 FORMAT(F9.2) 01130 352 FORMAT(*ENTER INTEREST RATE*) 01140 353 FORMAT(F5.4) 01150 354 FORMAT(*ENTER TOTAL MONTHS*) 01160 355 FORMAT(I3) 01170 356 FORMAT(*ENTER NAME UP TO 20 CHARACTERS*) 01180 357 FORMAT(20A2) 0119000 410 FORMAT(*JOB-NAME40-NNS-NOS-POA-PNA-FNP*) 01200 400 FORMAT(I1,*PRESS CAR. RET. OR CONTROL A TO ABORT*) 01210 500 FORMAT(A2,*ENTER NUMBER OF NEW SHARES--NNS*) 01220 510 FORMAT(A2,*ENTER NUMBER OF OLD SHARES--NOS*) 01230 520 FORMAT(A2,*ENTER PRICE OF OLD SHARES--POA*) 01240 530 FORMAT(A2,*ENTER PRICE OF NEW SHARES--PNS*) 01250 540 FORMAT(A2,*ENTER FINAL NEW PRICE--FNP*) 0126000 550 FORMAT(F7.2) 01270 560 FORMAT(F7.2) 01280 570 FORMAT(F7.2) 01290 580 FORMAT(F7.2) 01300 900 FORMAT(A2,*PRESS CAR. RET. TO GO OR CONTROL A TO ABORT*) 01310 590 FORMAT(F7.2) 01320 CALL PGMOUT 0133000 END 01340_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(\n gOTXIN610 P999999111111(000010H S IN610 00020X DECK-ID M57 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN610 00030F* THIS PROGRAM USED FOR ENTER/EDIT MANUAL INVENTORY TRANSACTIONS IN610 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN610 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN610 00060F* CONTROL DATA PROPRIETARY PRODUCT IN610 00070F* IN610 0000080FDUMMY IPEAF 72 DISK IN610 00090FPARTMST IC F 300R12AI 1 DISK IN610 00100FTRANTMP UC F 45R DISK IN610 00110F********************************************************************IN610 00120F* IN610 00130F* PACKAGE MANUFACTURING IN610 00140F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN610 0000150F* PROGRAM MANUAL INVENTORY TRANSACTIONS ENTRY/EDIT IN610 00160F* IN610 00170F* CONTRACTOR COMPUSOURCE IN610 00180F* PROGRAMMER KATH HILL IN610 00190F* DATE OCTOBER 30, 1975 IN610 00200F* IN610 00210F********************************************************************IN610 0000220F* IN610 00230F* NARRATIVE: TRAN # DESCRIPTION IN610 00240F* ---------- ------ ----------------------------------------- IN610 00250F* IN610 00260F* 10 NEW SALES ORDER IN610 00270F* 12 DELETE SALES ORDER IN610 00280F* 14 INVOICE IN610 0000290F* 16 CREDIT MEMO IN610 00300F* 18 MANUAL INVOICE IN610 00310F* 20 DIRECT BILL IN610 00320F* 40 NEW PURCHASE ORDER IN610 00330F* 42 REPLACE P.O. QTY ORDERED IN610 00340F* 43 REPLACE P.O. QTY RECEIVED IN610 00350F* 44 P.O. RECEIPT IN610 0000360F* 45 CANCEL PO QTY OR DELETE PO IN610 00370F* 60 OPEN JOBS IN610 00380F* 61 OPEN JOBS (COMPONENTS) IN610 00390F* 62 RELEASE JOBS IN610 00400F* 63 MATERIAL ISSUES IN610 00410F* 64 CHANGE JOB QTY IN610 00420F* 65 CHANGE JOB QTY (COMPONENTS) IN610 0000430F* 66 DELETE OPEN JOBS IN610 00440F* 67 DELETE OPEN JOBS (COMPONENTS) IN610 00450F* 68 CLOSE JOB SHORT IN610 00460F* 70 ADJUST REQUISITIONS IN610 00470F* 72 COMPLETED PRODUCTION#1 IN610 00480F* 73 COMPLETED PRODUCTION#2 IN610 00490F* 80 ADJUST ALLOCATION IN610 0000500F* 82 ADJUST STOCK ON ORDER IN610 00510F* 84 REPLACE STOCK ON ORDER IN610 00520F* 86 ADJUST STOCK ON HAND IN610 00530F* 88 REPLACE STOCK ON HAND IN610 00540F* 90 ADJUST AVERAGE USAGE IN610 00550F* 92 REPLACE AVERAGE USAGE IN610 00560F* 93 ADJUST MTD USAGE IN610 0000570F* 94 REPLACE MTD USAGE IN610 00580F* 95 ADJUST YTD USAGE IN610 00590F* 96 REPLACE YTD USAGE IN610 00600F* IN610 00610F********************************************************************IN610 00620F* ID F C H L FUNCTION OF INDICATORS IN610 00630F* IN610 0000640F* 01 DUMMY IN610 00650F* 02 PARTMST IN610 00660F* IN610 00670F* 22 DLT CD ' ' (PARTMST) IN610 00680F* IN610 00690F* 10 END OF JOB IN610 00700F* 11 EDIT --- ERROR IN610 0000710F* 12 START A NEW SCREEN IN610 00720F* 31 RUBOUT TO START OF THIS FIELD IN610 00730F* 32 RUBOUT TO START OF LAST FIELD IN610 00740F* 33 LINEFEED IN610 00750F* 50 TRANS # = 16 --> CREDIT MEMO --> Z-SUB QTY IN610 00760F* 55 TRAN # = 43 OR 44 --> BUY COST (OVERRIDE) IN610 00770F* 60 NEG. TRAN QTY IN610 0000780F* 61 TABLE SEARCH HIT IN610 00790F* 90 OUTPT --- ERROR IN610 00800F* 91 TRAN # IN610 00810F* 92 PART # IN610 00820F* 93 TRAN QTY IN610 00830F* 94 REF # IN610 00840F* 95 BUY COST (OVERRIDE) - TRAN #'S 43 AND 44 ONLY IN610 0000850F* 99 HEADINGS FOR CRT IN610 00860F* IN610 00870F********************************************************************IN610 00880E TABA 1 34 2 0 TABB 10 TRAN #/TYPE IN610 00890E MSG 1 25 56 CRT IN610 00900E MES 1 10 50 IN610 00910E BLNKS 1 72 BLANKS IN610 0000920IDUMMY NS 01 IN610 00930I 1 1 AIR IN610 00940IPARTMST NS 02 IN610 00950I 13 37 DESCRP IN610 00960I 74 74 DLTPR 22 IN610 00970ITRANTMP NS 03 IN610 00980I 1 12 PARTNO IN610 0000990I 13 140TN IN610 01000I 15 210BLIND IN610 01010I 22 28 REFNUM 28 IN610 01020I 35 413OVCOST IN610 01030C SETON LR IN610 01040CLR EXSR ALMTS IN610 01050CLR Z-ADDLOW SEQNO IN610 0001060CLR MOVELBLNKS,1 BUFFER 72 IN610 01070CLR MOVE ']' RTBRK 1 IN610 01080CLR MODECK TAG IN610 01090CLR SETOF 80 IN610 01100CLR EXSR CLRSCR IN610 01110CLR MOVEL'MODE-' BUFFER IN610 01120CLR MOVE 'S' TYPE IN610 0001130CLR Z-ADD5 BLNGTH IN610 01140CLR EXSR CRTCOM IN610 01150CLR MOVE 'A' TYPE IN610 01160CLR Z-ADD1 BLNGTH IN610 01170CLR EXSR CRTCOM IN610 01180CLR MOVELBUFFER MODE 1 IN610 01190CLR 'C' COMP MODE 81 CHANGE IN610 0001200CLR 'A' COMP MODE 82 ADD IN610 01210CLRN81N82 MOVEL'MODE NOT'WORDS 14 IN610 01220CLRN81N82 MOVE 'A OR C' WORDS IN610 01230CLRN81N82 MOVELWORDS BUFFER IN610 01240CLRN81N82 Z-ADD14 BLNGTH IN610 01250CLRN81N82 MOVE 'T' TYPE IN610 01260CLRN81N82 EXSR CRTCOM IN610 0001270CLRN81N82 GOTO MODECK IN610 01280CLR NEXT TAG NEW SCREEN IN610 01290CLR Z-ADD0 Z 20 0 LINE INCR. IN610 01300CLR EXSR CLRSCR CLEAR CRT SCRN IN610 01310CLR Z-ADD0 Y 20 0 MSG INCR. IN610 01320CLR LOOP1 TAG ---------------IN610 01330CLR Y ADD 1 Y HEADINGS IN610 0001340CLR EXSR OUTPT IN610 01350CLR Y COMP 7 99 IN610 01360CLR 99 GOTO LOOP1 ---------------IN610 01370CLR LINE TAG NEW LINE IN610 01380CLR SHOW TAG ---------------IN610 01390CLR 81 EXSR GETSEQ IN610 01400CLR EXSR GETREC IN610 0001410CLR Z-ADDY YHOLD 20 PUT OUT IN610 01420CLR SHOW1 TAG IN610 01430CLR SETON 65 IN610 01440CLR Y ADD 1 Y BRACKETS IN610 01450CLR EXSR OUTPT FOR THIS LINE IN610 01460CLR Y COMP 11 99 IN610 01470CLR 99 GOTO SHOW1 IN610 0001480CLR Z-ADDYHOLD Y IN610 01490CLR SETOF 65 IN610 01500CLR INPUT1 TAG ---------------IN610 01510CLR Z-ADD8 Y IN610 01520CLR EXSR OUTPT IN610 01530CLR SETON 91 IN610 01540CLR EXSR ACCEPT TRANSACTION # IN610 0001550CLR SETOF 91 IN610 01560CLR 10 GOTO END END OF JOB IN610 01570CLR 80 GOTO MODECK IN610 01580CLR 31 32 GOTO LINE RUBOUT IN610 01590C* IN610 01600CLR INPUT2 TAG ---------------IN610 01610CLR Z-ADD9 Y IN610 0001620CLR EXSR OUTPT IN610 01630CLR SETON 92 IN610 01640CLR EXSR ACCEPT PART # IN610 01650CLR SETOF 92 IN610 01660CLR 31 32 GOTO INPUT1 BACK TO TRAN # IN610 01670CLR INPUT3 TAG ---------------IN610 01680CLR Z-ADD10 Y IN610 0001690CLR EXSR OUTPT IN610 01700CLR SETON 93 IN610 01710CLR EXSR ACCEPT TRANS. QTY. IN610 01720CLR SETOF 93 IN610 01730CLR 31 32 GOTO INPUT2 BACK TO PART # IN610 01740CLR INPUT4 TAG ---------------IN610 01750CLR Z-ADD11 Y IN610 0001760CLR EXSR OUTPT IN610 01770CLR SETON 94 IN610 01780CLR EXSR ACCEPT REF # IN610 01790CLR SETOF 94 IN610 01800CLR 31 32 GOTO INPUT3 BK TO TRAN QTY IN610 01810C* ---------------IN610 01820CLR INPUT5 TAG IN610 0001830CLR TN COMP 43 55 IN610 01840CLRN55 TN COMP 44 55 IN610 01850CLRN55 GOTO ALLIN IN610 01860CLR Z-ADD11 Y IN610 01870CLR EXSR OUTPT IN610 01880CLR SETON 95 IN610 01890CLR EXSR ACCEPT BUY COST IN610 0001900C* (OVERRIDE) IN610 01910CLR SETOF 95 IN610 01920CLR 31 32 GOTO INPUT4 IN610 01930C* IN610 01940CLR ALLIN TAG IN610 01950C* IN610 01960CLR TN COMP 16 50CREDIT MEMO IN610 0001970CLR 50 Z-SUBQTY BLIND 70 IN610 01980CLRN50 Z-ADDQTY BLIND IN610 01990C* ---------------IN610 02000CLR EXCPT IN610 02010C* IN610 02020CLR Z ADD 1 Z INCR. LINE IN610 02030CLR Z COMP 14 12 15 LINES/SCRN IN610 0002040CLR 12 GOTO NEXT NEXT SCREEN IN610 02050CLR Z-ADD8 Y IN610 02060CLR GOTO LINE NEXT LINE IN610 02070C* IN610 02080CLR END TAG IN610 02090CLR EXSR CLRSCR IN610 02100CLR CLOSE TAG IN610 0002110C********************************************************************IN610 02120C* IN610 02130C* THIS SUBROUTINE ACCEPTS INFORMATION FROM THE CRT. IN610 02140C* IN610 02150C********************************************************************IN610 02160CSR ACCEPT BEGSR IN610 02170CSR AALOOP TAG IN610 0002180CSR 91 Z-ADD12 Y TRAN # IN610 02190CSR 92 Z-ADD13 Y PART # IN610 02200CSR 93 Z-ADD14 Y TRAN QTY IN610 02210CSR 94 Z-ADD15 Y REF # (COMMENT)IN610 02220CSR 95 Z-ADD16 Y BUY COST IN610 02230C* (OVERRIDE) IN610 02240CSR EXSR KEEP1 IN610 0002250CSR ACLOOP TAG IN610 02260CSR MOVELXYPOS BUFFER IN610 02270CSR EXSR POSCUR IN610 02280CSR MOVELBLNKS BUFFER IN610 02290CSR MOVE LENG BLNGTH IN610 02300CSR MOVE 'A' TYPE IN610 02310CSR EXSR CRTCOM IN610 0002320CSR RCODE COMP 'R' 31RUBOUT IN610 02330CSR 31 BUFFER COMP BLNKS,1 32GO BACK A FIELDIN610 02340CSR 31 32 GOTO ENDACP IN610 02350CSR 31 GOTO ACLOOP IN610 02360CSR RCODE COMP 'L' 33LINEFEED IN610 02370CSRN33 91 MOVELBUFFER EOJ 1 IN610 02380CSRN33 91 EOJ COMP 'E' 10END OF JOB IN610 0002390CSRN33 91 10 GOTO ENDACP IN610 02400CSRN33 91 EOJ COMP 'M' 80 IN610 02410CSRN33 91 80 GOTO ENDACP IN610 02420CSRN33 91 MOVELBUFFER ALPH1 2 TRAN # IN610 02430CSRN33 91 EXSR RTADJ IN610 02440CSRN33 92 MOVELBUFFER PARTNO 12 IN610 02450CSRN33 93 MOVELBUFFER MINUS 1 IN610 0002460CSRN33 93 MINUS COMP '-' 60 IN610 02470CSRN33 93 60 MOVELBUFFER ALPH3 8 IN610 02480CSRN33 93 60 MOVE ALPH3 ALPH4 7 IN610 02490CSRN33 93N60 MOVELBUFFER ALPH4 IN610 02500CSRN33 93 EXSR RTADJ IN610 02510CSRN33 93 60 Z-SUBQTY QTY NUMERIC TN QTY IN610 02520CSRN33 94 MOVELBUFFER REFNUM 7 IN610 0002530CSRN33 95 MOVELBUFFER WORD7 7 IN610 02540CSRN33 95 EXSR RTADJ IN610 02550CSRN33 GOTO ENDACC IN610 02560CSR 91 MOVELTN BUFFER IN610 02570CSR 92 MOVELPARTNO BUFFER IN610 02580CSR 93 MOVELBLIND BUFFER IN610 02590CSR 94 MOVELREFNUM BUFFER IN610 0002600CSR 95 MOVELOVCOST BUFFER IN610 02610CSR ENDACC TAG IN610 02620CSR EXSR CONFRM IN610 02630CSR SETOF 11 IN610 02640CSRN93N94N95 EXSR EDIT IN610 02650CSR 11 GOTO AALOOP IN610 02660CSR ENDACP ENDSR IN610 0002670C********************************************************************IN610 02680C* IN610 02690C* THIS SUBROUTINE RIGHT ADJUSTS. PROD #/TRAN #/TRAN QTY IN610 02700C* IN610 02710C********************************************************************IN610 02720CSR RTADJ BEGSR IN610 02730CSR 91 Z-ADDLENG VL IN610 0002740CSR 93 LENG SUB 1 VL IN610 02750CSR 95 Z-ADDLENG VL IN610 02760CSR 91 MOVELALPH1 VAR IN610 02770CSR 93 MOVELALPH4 VAR IN610 02780CSR 95 MOVELWORD7 VAR IN610 02790CSR EXIT SUBRAJ IN610 02800CSR RLABL VL 20 IN610 0002810CSR RLABL VAR 15 IN610 02820CSR 91 MOVELVAR BUFFER IN610 02830CSR 91 MOVELVAR TN 20 IN610 02840CSR 93 MOVELVAR QTY 70 IN610 02850CSR 93 60 MOVEL'-' ALPH3 IN610 02860CSR 93N60 MOVEL' ' ALPH3 IN610 02870CSR 93 MOVE QTY ALPH3 IN610 0002880CSR 93 MOVELALPH3 BUFFER IN610 02890CSR 95 MOVELVAR BUFFER IN610 02900CSR 95 MOVELVAR OVCOST 73 IN610 02910CSR ENDSR IN610 02920C********************************************************************IN610 02930C* IN610 02940C* THIS SUBROUTINE OUTPUTS THE FIELD AGAIN AFTER REPLACING THE IN610 0002950C* RIGHT BRACKET. IN610 02960C* IN610 02970C********************************************************************IN610 02980CSR CONFRM BEGSR IN610 02990CSR MOVE BUFFER FERBUF 72 IN610 03000CSR MOVELXYPOS BUFFER IN610 03010CSR EXSR POSCUR IN610 0003020CSR BLNGTH ADD 1 BLNGTH IN610 03030CSR Z-ADD1 NCHARS 30 IN610 03040CSR Z-ADD1 SSTRT 30 IN610 03050CSR Z-ADDBLNGTH TSTRT 30 IN610 03060CSR EXIT SUBRMV IN610 03070CSR RLABL RTBRK IN610 03080CSR RLABL SSTRT 30 IN610 0003090CSR RLABL FERBUF IN610 03100CSR RLABL TSTRT 30 IN610 03110CSR RLABL NCHARS 30 IN610 03120CSR MOVELFERBUF BUFFER IN610 03130CSR MOVE 'S' TYPE IN610 03140CSR EXSR CRTCOM IN610 03150CSR ENDSR IN610 0003160C********************************************************************IN610 03170C* IN610 03180C* THIS SUBROUTINE EDITS CRT ENTRIES. IN610 03190C* IN610 03200C********************************************************************IN610 03210CSR EDIT BEGSR IN610 03220CSRN91 GOTO TRY92 IN610 0003230C* IN610 03240CSR TN LOKUPTABA TABB 61 IN610 03250CSRN61 SETON 11 IN610 03260CSR Z-ADD17 Y IN610 03270CSRN11 SETON 90 IN610 03280CSR MOVELTABB MESS IN610 03290CSR EXSR OUTPT IN610 0003300CSR SETOF 90 IN610 03310CSR GOTO EEDIT IN610 03320C* IN610 03330CSR TRY92 TAG IN610 03340C* IN610 03350CSR PARTNO CHAINPARTMST 11 IN610 03360CSRN11N22 SETON 11 IN610 0003370CSR Z-ADD18 Y IN610 03380CSRN11 SETON 90 IN610 03390CSR MOVELDESCRP MESS IN610 03400CSR EXSR OUTPT IN610 03410CSR SETOF 90 IN610 03420C* IN610 03430CSR EEDIT ENDSR IN610 0003440C********************************************************************IN610 03450C* IN610 03460C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. IN610 03470C* IN610 03480C********************************************************************IN610 03490CSR CRTCOM BEGSR IN610 03500CSR EXITFSUBRCM IN610 0003510CSR RLABL BUFFER IN610 03520CSR RLABL TYPE 1 IN610 03530CSR RLABL BLNGTH 20 IN610 03540CSR RLABL RCODE 1 IN610 03550CSR RLABL MASK 10 IN610 03560CSR RLABL DTYPE 10 IN610 03570CSR ENDSR IN610 0003580C********************************************************************IN610 03590C* IN610 03600C* THIS SUBROUTINE CLEARS THE SCREEN. IN610 03610C* IN610 03620C********************************************************************IN610 03630CSR CLRSCR BEGSR IN610 03640CSR MOVE 'C' TYPE IN610 0003650CSR EXSR CRTCOM IN610 03660CSR ENDSR IN610 03670C********************************************************************IN610 03680C* IN610 03690C* THIS SUBROUTINE POSITIONS THE CURSOR. IN610 03700C* IN610 03710C********************************************************************IN610 0003720CSR POSCUR BEGSR IN610 03730CSR MOVE 'P' TYPE IN610 03740CSR EXSR CRTCOM IN610 03750CSR ENDSR IN610 03760C********************************************************************IN610 03770C* IN610 03780C* THIS SUBROUTINE UNPACKS THE DATA FROM THE PARAMETER IN610 0003790C* ARRAY 'MSG'. IN610 03800C* IN610 03810C********************************************************************IN610 03820CSR KEEP1 BEGSR IN610 03830CSR MOVE MSG,Y WORD50 50 IN610 03840CSRN90 MOVELWORD50 MESS 50 IN610 03850CSR MOVELMSG,Y WORD6 6 IN610 0003860CSR MOVELWORD6 XYPOS 40 IN610 03870CSR XYPOS ADD Z XYPOS IN610 03880CSR MOVE WORD6 LENG 20 IN610 03890CSR ENDSR IN610 03900C********************************************************************IN610 03910C* IN610 03920C* THIS SUBROUTINE DISPLAYS A SINGLE FIELD OR PROMPTING MESSAGE. IN610 0003930C* IN610 03940C********************************************************************IN610 03950CSR OUTPT BEGSR IN610 03960CSR EXSR KEEP1 IN610 03970CSR MOVELXYPOS BUFFER IN610 03980CSR EXSR POSCUR IN610 03990CSR MOVE LENG BLNGTH IN610 0004000CSR MOVE 'S' TYPE IN610 04010CSR MOVELMESS BUFFER IN610 04020CSR EXSR CRTCOM IN610 04030CSR 65 81N90 EXSR CHGSUB IN610 04040CSR ENDSR IN610 04050C********************************************************************IN610 04060C* THIS SUBROUTINE ACCEPTS SEQ NO IN610 0004070C********************************************************************IN610 04080CSR GETSEQ BEGSR IN610 04090CSR EXSR SKIP IN610 04100CSR MOVEL'SEQ # - 'WORD 8 IN610 04110CSR Z-ADD8 OLN 20 IN610 04120CSR Z-ADD5 ILN 20 IN610 04130CSR EXSR TYPES IN610 0004140CSR Z-ADD5 VL IN610 04150CSR MOVELBUFFER VAR IN610 04160CSR EXIT SUBRAJ IN610 04170CSR RLABL VL IN610 04180CSR RLABL VAR IN610 04190CSR MOVELVAR SEQNO IN610 04200CSR SEQNO COMP 0 20 IN610 0004210CSRN20 Z-ADD1 SEQNO IN610 04220CSR EXSR SKIP IN610 04230CSR ENDSEQ ENDSR IN610 04240C********************************************************************IN610 04250C* THIS SUBROUTINE GETS TRANTMP RECORD IN610 04260C********************************************************************IN610 04270CSR GETREC BEGSR IN610 0004280CSR SEQRD TAG IN610 04290CSR EXSR TSTSEQ IN610 04300CSR 74 EXSR GETSEQ IN610 04310CSR 74 GOTO SEQRD IN610 04320CSR SEQNO CHAINTRANTMP 56 IN610 04330CSR MOVELPARTNO TST 2 IN610 04340CSR TST COMP '<>' 49 IN610 0004350CSR 81 49 EXSR NOCHG IN610 04360CSR 81 49 GOTO SEQRD IN610 04370CSR 82N49 SEQNO ADD 1 SEQNO 50 IN610 04380CSRN49N56 82 GOTO SEQRD IN610 04390CSR 56 82 IN610 04400COR 56 81 MOVELMES,1 BUFFER IN610 04410CSR 56 82 IN610 0004420COR 56 81 MOVE 'T' TYPE IN610 04430CSR 56 82 IN610 04440COR 56 81 Z-ADD50 BLNGTH IN610 04450CSR 56 82 IN610 04460COR 56 81 EXSR CRTCOM IN610 04470CSR 56 82 IN610 04480COR 56 81 EXSR GETSEQ IN610 0004490CSR 56 82 IN610 04500COR 56 81 GOTO SEQRD IN610 04510CSR ENDSR IN610 04520C********************************************************************IN610 04530C* THIS SUBROUTINE SENDS MESSAGE AND ACCEPTS IN610 04540C********************************************************************IN610 04550CSR TYPES BEGSR IN610 0004560CSR OVER TAG IN610 04570CSR Z-ADDOLN BLNGTH IN610 04580CSR MOVELWORD BUFFER IN610 04590CSR MOVE 'S' TYPE IN610 04600CSR EXSR CRTCOM IN610 04610CSR MOVE 'A' TYPE IN610 04620CSR Z-ADDILN BLNGTH IN610 0004630CSR EXSR CRTCOM IN610 04640CSR RCODE COMP 'R' 25 IN610 04650CSR 25 EXSR SKIP IN610 04660CSR 25 GOTO OVER IN610 04670CSR RCODE COMP 'O' 25 IN610 04680CSR 25 EXSR SKIP IN610 04690CSR ENDSR IN610 0004700C********************************************************************IN610 04710C* THIS SUBROUTINE SKIPS TO THE NEXT CRT LINE IN610 04720C********************************************************************IN610 04730CSR SKIP BEGSR IN610 04740CSR Z ADD 1 Z IN610 04750CSR MOVELBUFFER NBUF 1 IN610 04760CSR MOVEL' ' BUFFER IN610 0004770CSR Z-ADD1 BLNGTH IN610 04780CSR MOVE 'T' TYPE IN610 04790CSR EXSR CRTCOM IN610 04800CSR MOVELNBUF BUFFER IN610 04810CSR ENDSR IN610 04820C********************************************************************IN610 04830C* THIS SUBROUTINE ACCEPTS BEGINNING AND ENDING LIMITS IN610 0004840C********************************************************************IN610 04850CSR ALMTS BEGSR IN610 04860CSR EXSR CLRSCR IN610 04870CSR MOVELMES,2 BUFFER IN610 04880CSR MOVE 'S' TYPE IN610 04890CSR Z-ADD50 BLNGTH IN610 04900CSR EXSR CRTCOM IN610 0004910CSR MOVE 'A' TYPE IN610 04920CSR Z-ADD5 BLNGTH IN610 04930CSR Z-ADD1 DTYPE IN610 04940CSR EXSR CRTCOM IN610 04950CSR EXSR SKIP IN610 04960CSR RCODE COMP 'R' 76 IN610 04970CSR Z-ADD5 VL IN610 0004980CSR MOVELBUFFER VAR IN610 04990CSR EXIT SUBRAJ IN610 05000CSR RLABL VL IN610 05010CSR RLABL VAR IN610 05020CSR MOVELVAR BUFFER IN610 05030CSR MOVELBUFFER LOW 50 IN610 05040CSR MOVELMES,3 BUFFER IN610 0005050CSR MOVE 'S' TYPE IN610 05060CSR Z-ADD50 BLNGTH IN610 05070CSR EXSR CRTCOM IN610 05080CSR MOVE 'A' TYPE IN610 05090CSR Z-ADD5 BLNGTH IN610 05100CSR Z-ADD1 DTYPE IN610 05110CSR EXSR CRTCOM IN610 0005120CSR RCODE COMP 'R' 77 IN610 05130CSR Z-ADD5 VL IN610 05140CSR MOVELBUFFER VAR IN610 05150CSR EXIT SUBRAJ IN610 05160CSR RLABL VL IN610 05170CSR RLABL VAR IN610 05180CSR MOVELVAR BUFFER IN610 0005190CSR MOVELBUFFER HIGH 50 IN610 05200CSR MOVE 'C' TYPE IN610 05210CSR EXSR CRTCOM IN610 05220CSR 76 IN610 05230COR 77 GOTO ALMTS IN610 05240CSR Z-ADD0 DTYPE IN610 05250CSR ENDSR IN610 0005260C********************************************************************IN610 05270C* THIS SUBROUTINE VERIFIES THAT RECORD IS WITHIN LIMITS IN610 05280C********************************************************************IN610 05290CSR TSTSEQ BEGSR IN610 05300CSR SETOF 747677 IN610 05310CSR SEQNO COMP LOW 787678 IN610 05320CSR 78 SEQNO COMP HIGH 777878 IN610 0005330CSR 78 GOTO ENDTST IN610 05340CSR 82 76 MOVE MES,4 BUFFER IN610 05350CSR 82 77 MOVE MES,5 BUFFER IN610 05360CSRN82 MOVELMES,6 BUFFER IN610 05370CSRN82 SETON 74 IN610 05380CSR MOVE 'T' TYPE IN610 05390CSR Z-ADD50 BLNGTH IN610 0005400CSR EXSR CRTCOM IN610 05410CSR 82 77 MOVE 'F' TYPE IN610 05420CSR 82 77 EXSR CRTCOM IN610 05430CSR ENDTST ENDSR IN610 05440C********************************************************************IN610 05450C* THIS SUBROUTINE PUTS OUT EXISTING FIELDS IN610 05460CSR CHGSUB BEGSR IN610 0005470CSR XYPOS ADD 100 PXYPOS 40 IN610 05480CSR MOVELPXYPOS BUFFER IN610 05490CSR EXSR POSCUR IN610 05500CSR Y COMP 8 66 IN610 05510CSR 66 MOVELTN BUFFER DISPLAY IN610 05520CSR 66 Z-ADD2 BLNGTH EXISTING IN610 05530CSR 66 GOTO ENDCHG TRAN NO IN610 0005540CSR Y COMP 9 66 DISPLAY IN610 05550CSR 66 MOVELPARTNO BUFFER PART NO IN610 05560CSR 66 Z-ADD12 BLNGTH IN610 05570CSR 66 GOTO ENDCHG IN610 05580CSR Y COMP 10 66 IN610 05590CSR 66 MOVELBLIND BUFFER QTY IN610 05600CSR 66 Z-ADD7 BLNGTH IN610 0005610CSR 66 GOTO ENDCHG IN610 05620CSR Y COMP 11 66 IN610 05630CSRN66 GOTO ENDCHG IN610 05640CSR MOVELREFNUM BUFFER IN610 05650CSR 28 MOVELOVCOST BUFFER IN610 05660CSR Z-ADD7 BLNGTH IN610 05670CSR ENDCHG TAG IN610 0005680CSR MOVE 'S' TYPE IN610 05690CSR EXSR CRTCOM IN610 05700CSR Y COMP 9 66 IN610 05710CSR 66 PARTNO CHAINPARTMST 11 IN610 05720CSR 66N11 MOVELDESCRP MESS IN610 05730CSR 66 SETON 90 IN610 05740CSR 66 Z-ADD18 Y IN610 0005750CSR 66 EXSR OUTPT IN610 05760CSR 66 Z-ADD9 Y IN610 05770CSR 66 SETOF 90 IN610 05780CSR ENDSR IN610 05790CSR NOCHG BEGSR IN610 05800CSR MOVELMES,7 BUFFER IN610 05810CSR Z-ADD50 BLNGTH IN610 0005820CSR MOVE 'T' TYPE IN610 05830CSR EXSR CRTCOM IN610 05840CSR EXSR GETSEQ IN610 05850CSR ENDSR IN610 05860OTRANTMP E 03N56 IN610 05870O PARTNO 12 IN610 05880O TN 14 IN610 0005890O BLIND 21 IN610 05900O REFNUM 28 IN610 05910O 55 OVCOST 41 IN610 ** 005920ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005930ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005940ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00595000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005960** 00597010NEW SO 00598012DELETE SO 00599014INVOICE 00600016CR MEMO 00601018MANUAL INV 0060200020DRECT BILL 00603040NEW PO 00604042RPL PO QTY 00605043RPL PO REC 00606044PO RECEIPT 00607045DELETE PO 00608060OPEN WO 0060900061WO COMPT 00610062RLSE WO 00611063MTL ISSUE 00612064CHG WO QTY 00613065MAT JOB QT 00614066DLT OPN WO 00615067DEC RS DLT 0061600068CL WO SHRT 00617070ADJ STK RQ 00618072COM PRD #1 00619073COM PRD #2 00620080ADJ ALLOC 00621082ADJUST SOO 00622084REPLCE SOO 0062300086ADJUST SOH 00624088REPLCE SOH 00625090ADJ AVGUSE 00626092RPL AVGUSE 00627093ADJ MTDUSE 00628094RPL MTDUSE 00629095ADJ YTDUSE 0063000096RPL YTDUSE 006310** 006320250122INVENTORY TRANSACTIONS 006330020304TRAN 006340070304TYPE 006350190306PART # 006360330311DESCRIPTION 00637000600308QUANTITY 006380700309REF#/COST 006390020504[ ] 006400180514[ ] 006410590510[ ] 006420700509[ ] 006430030502 00644000190512 006450600508 006460710507 006470710507 006480070510**INVALID 006490330525**INVALID PART # 006500** 00651000RECORD NOT IN FILE 006520ENTER BEGINNING RRN 006530ENTER ENDING RRN 006540SEQNO TOO LOW 006550RUN EDIT PROG-FILE FULL 006560SEQNO NOT IN LIMITS 006570RECORD HAS NO DATA-USE MODE A TO ADD 00658000/* 006590__R BEGINNING RRN 006530ENTER ENDING RRN 006540SEQNO TOO LOW 006550RUN EDIT PROG-FILE FULL 006560SEQNO NOT IN LIMITS 006570RECORD HAS NO DATA-USE MODE A TO ADD 0065800( mOTXIN615 P999999111111(000010H S IN615 00020X DECK-ID M58 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN615 00030F* THIS IS THE RECOVERY PROGRAM THAT DISPLAYS LAST RECORD ENTERED IN615 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN615 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN615 00060F* CONTROL DATA PROPRIETARY PRODUCT IN615 00070F* IN615 0000080FDUMMY UPE F 72 DISK IN615 00090FTRANTMP IC F 45R DISK IN615 00100E MSG 1 5 35 IN615 00110IDUMMY NS 01 IN615 00120I 1 72 ALL IN615 00130ITRANTMP NS 02 IN615 00140I 1 45 RCD IN615 0000150C SETOF 60 IN615 00160C SETON LR IN615 00170CLR MOVE ' ' B80 80 IN615 00180CLR EXSR ALMTS IN615 00190CLR Z-ADDLOW SEQNO 50 IN615 00200CLR LOOP TAG IN615 00210CLR SEQNO COMP HIGH 40 IN615 0000220CLR 40 GOTO A IN615 00230CLR SEQNO CHAINTRANTMP 50 IN615 00240CLR 50 GOTO A IN615 00250CLR MOVELRCD TST 2 IN615 00260CLR TST COMP '<>' 51 IN615 00270CLRN51 SEQNO ADD 1 SEQNO IN615 00280CLRN51 GOTO LOOP IN615 0000290CLR A TAG IN615 00300CLR SEQNO SUB 1 SUBNO 50 IN615 00310CLR SUBNO CHAINTRANTMP 50 IN615 00320CLR MOVELRCD BUFFER IN615 00330CLR MOVE 'T' TYPE IN615 00340CLR Z-ADD45 BLNGTH IN615 00350CLR EXSR CRTCOM IN615 0000360CLR MOVE B80 BUFFER IN615 00370CLR MOVELMSG,3 BUFFER IN615 00380CLR MOVE 'S' TYPE IN615 00390CLR Z-ADD35 BLNGTH IN615 00400CLR EXSR CRTCOM IN615 00410CLR MOVE B80 BUFFER IN615 00420CLR MOVELSEQNO BUFFER IN615 0000430CLR MOVE 'T' TYPE IN615 00440CLR Z-ADD5 BLNGTH IN615 00450CLR EXSR CRTCOM IN615 00460CLR MOVELMSG,4 BUFFER IN615 00470CLR MOVE 'S' TYPE IN615 00480CLR Z-ADD35 BLNGTH IN615 00490CLR EXSR CRTCOM IN615 0000500CLR MOVE B80 BUFFER IN615 00510CLR MOVE 'A' TYPE IN615 00520CLR Z-ADD1 BLNGTH IN615 00530CLR EXSR CRTCOM IN615 00540CLR MOVE 'C' TYPE IN615 00550CLR EXSR CRTCOM IN615 00560CLR MOVE 'F' TYPE IN615 0000570CLR EXSR CRTCOM IN615 00580CSR ALMTS BEGSR IN615 00590CSR MOVE B80 BUFFER 80 IN615 00600CSR MOVE 'C' TYPE 1 IN615 00610CSR Z-ADD0 BLNGTH 20 IN615 00620CSR MOVE ' ' RCODE 1 IN615 00630CSR Z-ADD0 MASK 10 IN615 0000640CSR Z-ADD0 DTYPE 10 IN615 00650CSR EXSR CRTCOM IN615 00660CSR MOVELMSG,1 BUFFER IN615 00670CSR MOVE 'S' TYPE IN615 00680CSR Z-ADD35 BLNGTH IN615 00690CSR EXSR CRTCOM IN615 00700CSR MOVE B80 BUFFER IN615 0000710CSR MOVE 'A' TYPE IN615 00720CSR Z-ADD5 BLNGTH IN615 00730CSR Z-ADD1 DTYPE IN615 00740CSR EXSR CRTCOM IN615 00750CSR EXSR SKIP IN615 00760CSR RCODE COMP 'R' 86 IN615 00770CSR EXSR AJ IN615 0000780CSR MOVELBUFFER LOW 50 IN615 00790CSR MOVE B80 BUFFER IN615 00800CSR MOVELMSG,2 BUFFER IN615 00810CSR MOVE 'S' TYPE IN615 00820CSR Z-ADD35 BLNGTH IN615 00830CSR EXSR CRTCOM IN615 00840CSR MOVE B80 BUFFER IN615 0000850CSR MOVE 'A' TYPE IN615 00860CSR Z-ADD5 BLNGTH IN615 00870CSR Z-ADD1 DTYPE IN615 00880CSR EXSR CRTCOM IN615 00890CSR RCODE COMP 'R' 87 IN615 00900CSR EXSR AJ IN615 00910CSR MOVELBUFFER HIGH 50 IN615 0000920CSR MOVE 'C' TYPE IN615 00930CSR EXSR CRTCOM IN615 00940CSR 86 IN615 00950COR 87 GOTO ALMTS IN615 00960CSR Z-ADD0 DTYPE IN615 00970CSR ENDSR IN615 00980CSR CRTCOM BEGSR IN615 0000990CSR EXITFSUBRCM IN615 01000CSR RLABL BUFFER IN615 01010CSR RLABL TYPE IN615 01020CSR RLABL BLNGTH IN615 01030CSR RLABL RCODE IN615 01040CSR RLABL MASK IN615 01050CSR RLABL DTYPE IN615 0001060CSR ENDSR IN615 01070CSR SKIP BEGSR IN615 01080CSR MOVELBUFFER NBUF 1 IN615 01090CSR MOVEL' ' BUFFER IN615 01100CSR Z-ADD1 BLNGTH IN615 01110CSR MOVE 'T' TYPE IN615 01120CSR EXSR CRTCOM IN615 0001130CSR MOVELNBUF BUFFER IN615 01140CSR ENDSR IN615 01150CSR AJ BEGSR IN615 01160CSR MOVELBUFFER VAR 15 IN615 01170CSR Z-ADD5 VL 20 IN615 01180CSR EXIT SUBRAJ IN615 01190CSR RLABL VL IN615 0001200CSR RLABL VAR IN615 01210CSR MOVELVAR BUFFER IN615 01220CSR ENDSR IN615 01230ODUMMY D 60 IN615 01240O ALL 72 IN615 ** 001250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00126000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001290** 001300ENTER BEGINNING RRN 001310ENTER ENDING RRN 001320TRANSACTION RRN 00133000ENTER E FOR END OF JOB 001340/* 001350__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001290** 001300ENTER BEGINNING RRN 001310ENTER ENDING RRN 001320TRANSACTION RRN 0013300( L?OTXIN620 P999999111111(000010H S IN620 00020X DECK-ID M59 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN620 00030F* THIS PROGRAM ADDS MANUAL TRANSACTIONS TO TRANSAC FILE IN620 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN620 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN620 00060F* CONTROL DATA PROPRIETARY PRODUCT IN620 00070F* IN620 0000080FTRANTMP UPE F 45 DISK IN620 00090FTRNWO1 ISEAF 45 DISK U1 IN620 00100FTRNWO2 ISEAF 45 DISK U1 IN620 00110FTRNWO3 ISEAF 45 DISK U1 IN620 00120FTRANSAC O F 45 DISK A IN620 00130F********************************************************************IN620 00140F* IN620 0000150F* PACKAGE MANUFACTURING IN620 00160F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN620 00170F* PROGRAM ADDS MANUAL INVOICES TO TRANSAC IN620 00180F* IN620 00190F* CONTRACTOR COMPUSOURCE IN620 00200F* PROGRAMMER KATH HILL IN620 00210F* DATE OCTOBER 31, 1975 IN620 0000220F* IN620 00230F********************************************************************IN620 00240F* IN620 00250F* NARRATIVE: ADDS RECORDS IN TRANTMP ONTO END OF TRANSAC. IN620 00260F* TRANSACTION DATE IS GIVEN BY IPL DATE. IN620 00270F* IF U1 IS ON, THE RECORDS IN THE WORK-IN-PROCESS IN620 00280F* SYSTEMS FILES TRNWO1,TRNWO2,AND TRNWO3 ARE ALSO IN620 0000290F* ADDED TO TRANSAC. IN620 00300F* IN620 00310F********************************************************************IN620 00320F* IN620 00330F* ID F C H L FUNCTION OF INDICATORS IN620 00340F* IN620 00350F* 01 TRANTMP IN620 0000360F* 02 TRNWO1 IN620 00370F* 03 TRNWO2 IN620 00380F* 04 TRNWO3 IN620 00390F* 20 WIP IS INPUT IN620 00400F* IN620 00410F********************************************************************IN620 00420ITRANTMP NS 01 IN620 0000430I 1 12 PARTNO IN620 00440I 13 140TRANNO IN620 00450I 15 210QTY IN620 00460I 22 28 REFNUM IN620 00470I 35 413UNCOST IN620 00480ITRNWO1 NS 02 IN620 00490I 1 45 REC IN620 0000500ITRNWO2 NS 03 IN620 00510I 1 45 REC IN620 00520ITRNWO3 NS 04 IN620 00530I 1 45 REC IN620 00540C N20 MOVELPARTNO TRY2 2 IN620 00550C N20 TRY2 COMP '<>' 50UNUSED RCD IN620 00560C SETOF 20 IN620 0000570C 02 IN620 00580COR 03 IN620 00590COR 04 SETON 20 IN620 00600OTRANSAC DADD 01N50 IN620 00610O PARTNO 12 IN620 00620O TRANNO 14 IN620 00630O QTY 21 IN620 0000640O REFNUM 28 IN620 00650O UDATE 34 IN620 00660O UNCOST 41 IN620 00670OTRANTMP D 01N50 IN620 00680O 2 '<>' IN620 00690OTRANSAC DADD 20 IN620 00700O REC 45 IN620 00** 000710ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000730ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000750/* 000760__0O REC 45 IN620 0(T OTXIN630 P999999111111(000010H S IN630 00020X DECK-ID M60 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN630 00030F* THIS PROGRAM PROCESSES TRANSACTIONS ONTO THE PARTMST FILE IN630 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN630 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN630 00060F* CONTROL DATA PROPRIETARY PRODUCT IN630 00070F* IN630 0000080FTRANWRK IPEAF 45 DISK IN630 00090FPARTMST UC F 300R12AI 1 DISK IN630 00100F********************************************************************IN630 00110F* IN630 00120F* PACKAGE MANUFACTURING IN630 00130F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN630 00140F* PROGRAM UPDATES PARTMST (SOO, SOH, ALLOCA, MTD USAGE, AVGUSE, IN630 0000150F* AVGMAT COST/UNIT, & YTD USAGE) WITH TRAN QTY'S. IN630 00160F* IN630 00170F* CONTRACTOR COMPUSOURCE IN630 00180F* PROGRAMMER KATH HILL IN630 00190F* DATE OCTOBER 31, 1975 IN630 00200F* IN630 00210F********************************************************************IN630 0000220F* IN630 00230F* NARRATIVE: USES TRANWRK RECORDS TO UPDATE PARTMST. IN630 00240F* IN630 00250F********************************************************************IN630 00260F* IN630 00270F* ID F C H L FUNCTION OF INDICATORS IN630 00280F* IN630 0000290F* 01 TRANTMP IN630 00300F* 02 PARTMST IN630 00310F* IN630 00320F* 11 UNIT COST = 0 IN630 00330F* 12 DELETE CODE ON PARTMST BLANK IN630 00340F* IN630 00350F* 20 CHAIN TO PARTMST A MISS IN630 0000360F* 25 TABLE SEARCH IN630 00370F* 33 FIELD LOOPER GUARD IN630 00380F* 34 FLDX VS. ACTY IN630 00390F* 80 STOCK-ON-HAND X=1 IN630 00400F* 81 STOCK-ON-ORDER X=2 IN630 00410F* 82 ALLOCATE X=3 IN630 00420F* 83 MTD USAGE X=4 IN630 0000430F* 88 AVERAGE USAGE X=5 IN630 00440F* 89 YTD USAGE X=6 IN630 00450F* 84 ' ' Y=1 IN630 00460F* 85 '+' Y=2 IN630 00470F* 86 '-' Y=3 IN630 00480F* 87 'R' Y=4 IN630 00490F* 99 SETUP XPOSS & YPOSS AT START OF PROG IN630 0000500F* IN630 00510F* L1PART # IN630 00520F* IN630 00530F********************************************************************IN630 00540E TABA 1 34 2 0 TABB 6 TRAN #/FIELDS IN630 00550E ACT 4 4 1 /+/-/R IN630 00560E TABC 1 2 2 0 SPECIAL TRAN # IN630 0000570E* UPDATE AVGMAT IN630 00580E FLD 6 1 TABB SPLIT APART IN630 00590ITRANWRK NS 01 IN630 00600I 1 12 PARTNOL1 IN630 00610I 13 140TRANNO IN630 00620I 15 210QTY IN630 00630I 22 28 REFNUM IN630 0000640I 29 340TRANDT IN630 00650I 35 413UNCOST 11 IN630 00660IPARTMST NS 02 IN630 00670I 1 12 PRNUM IN630 00680I 74 74 DLTPR 12 IN630 00690I 75 813STDCST IN630 00700I 82 883AVGMAT IN630 0000710I 146 1520SOH IN630 00720I 153 1590SOO IN630 00730I 167 1730ALLOCA IN630 00740I 196 2020MTDUSE IN630 00750I 203 2090AVGUSE IN630 00760I 212 2180YTDUSE IN630 00770C N99 Z-ADD6 XPOSS 20 SOH/SOO/ALLOCA IN630 0000780C* MTDUSE/AVGUSE IN630 00790C* YTDUSE IN630 00800C N99 Z-ADD4 YPOSS 20 /+/-/R IN630 00810C N99 SETON 99 IN630 00820C* ---------------IN630 00830C L1 PARTNO CHAINPARTMST 20 IN630 00840C L1N20N12 SETON 20 IN630 0000850C 20 GOTO FINI IN630 00860C* IN630 00870C L1 Z-ADDAVGMAT SV1 73 IN630 00880C L1 Z-ADDSOH SV2 70 IN630 00890C L1 Z-ADDSOO SV3 70 IN630 00900C L1 Z-ADDALLOCA SV4 70 IN630 00910C L1 Z-ADDMTDUSE SV5 70 IN630 0000920C L1 Z-ADDAVGUSE SV6 70 IN630 00930C L1 Z-ADDYTDUSE SV7 70 IN630 00940C* IN630 00950C TRANNO LOKUPTABC 25 IN630 00960C 25 EXSR CALC1 IN630 00970C* IN630 00980C TRANNO LOKUPTABA TABB 25 IN630 0000990C N25 GOTO FINI IN630 01000C* IN630 01010C MOVELTABB FLDS2 2 IN630 01020C MOVE TABB FLDS4 4 IN630 01030C MOVELFLDS2 FLD,1 IN630 01040C MOVE FLDS2 FLD,2 IN630 01050C MOVELFLDS4 FLDS2 IN630 0001060C MOVELFLDS2 FLD,3 IN630 01070C MOVE FLDS2 FLD,4 IN630 01080C MOVE FLDS4 FLDS2 IN630 01090C MOVELFLDS2 FLD,5 IN630 01100C MOVE FLDS2 FLD,6 IN630 01110C* IN630 01120C Z-ADD0 X 20 IN630 0001130C LOOP1 TAG IN630 01140C X ADD 1 X IN630 01150C Z-ADD0 Y 20 IN630 01160C X COMP XPOSS 33 IN630 01170C 33 GOTO ENDLP1 IN630 01180C LOOP2 TAG IN630 01190C Y ADD 1 Y IN630 0001200C FLD,X COMP ACT,Y 34 IN630 01210C 34 EXSR CALC2 IN630 01220C 34 GOTO ENDLP2 IN630 01230C GOTO LOOP2 IN630 01240C ENDLP2 TAG IN630 01250C GOTO LOOP1 IN630 01260C ENDLP1 TAG IN630 0001270C* IN630 01280C FINI TAG IN630 01290C* IN630 01300CL1N20 PARTNO CHAINPARTMST 20 ALWAYS HITS! IN630 01310C********************************************************************IN630 01320C* IN630 01330C* THIS SUBROUTINE UPDATES THE AVERAGE MATERIAL COST/UNIT. IN630 0001340C* IN630 01350C********************************************************************IN630 01360CSR CALC1 BEGSR IN630 01370CSR 11 Z-ADDSTDCST UNCOST IN630 01380CSR Z-ADDSV2 SOH 70 IN630 01390CSR SV1 MULT SOH A 100 IN630 01400CSR QTY MULT UNCOST B 100 IN630 0001410CSR A ADD B A IN630 01420CSR SOH ADD QTY B IN630 01430CSR A DIV B SV1 H IN630 01440CSR ENDSR IN630 01450C********************************************************************IN630 01460C* IN630 01470C* THIS SUBROUTINE UPDATES: 1. STOCK-ON-HAND IN630 0001480C* 2. STOCK-ON-ORDER IN630 01490C* 3. ALLOCATION IN630 01500C* 4. MTD USAGE IN630 01510C* 5. AVERAGE USAGE IN630 01520C* 6. YTD USAGE IN630 01530C* IN630 01540C********************************************************************IN630 0001550CSR CALC2 BEGSR IN630 01560CSR X COMP 1 80STOCK-ON-HAND IN630 01570CSR X COMP 2 81STOCK-ON-ORDER IN630 01580CSR X COMP 3 82ALLOCATE IN630 01590CSR X COMP 4 83MTD USAGE IN630 01600CSR X COMP 5 88AVERAGE USAGE IN630 01610CSR X COMP 6 89YTD USAGE IN630 0001620CSR Y COMP 1 84' ' IN630 01630CSR Y COMP 2 85'+' IN630 01640CSR Y COMP 3 86'-' IN630 01650CSR Y COMP 4 87'R' IN630 01660C* IN630 01670CSR 84 GOTO ENDC2 IN630 01680CSR 80 Z-ADDSV2 WORK 70 SOH IN630 0001690CSR 81 Z-ADDSV3 WORK SOO IN630 01700CSR 82 Z-ADDSV4 WORK ALLOCA IN630 01710CSR 83 Z-ADDSV5 WORK MTD USAGE IN630 01720CSR 88 Z-ADDSV6 WORK AVGUSE IN630 01730CSR 89 Z-ADDSV7 WORK YTD USAGE IN630 01740C* IN630 01750CSR 85 WORK ADD QTY WORK FLD + QTY = FLDIN630 0001760CSR 86 WORK SUB QTY WORK FLD - QTY = FLDIN630 01770CSR 87 Z-ADDQTY WORK QTY INTO FLD IN630 01780C* IN630 01790CSR 80 Z-ADDWORK SV2 SOH IN630 01800CSR 81 Z-ADDWORK SV3 SOO IN630 01810CSR 82 Z-ADDWORK SV4 ALLOCA IN630 01820CSR 83 Z-ADDWORK SV5 MTD USAGE IN630 0001830CSR 88 Z-ADDWORK SV6 AVGUSE IN630 01840CSR 89 Z-ADDWORK SV7 YTD USAGE IN630 01850C* IN630 01860CSR ENDC2 ENDSR IN630 01870C********************************************************************IN630 01880OPARTMST T L1N20 IN630 01890O SV1 B 88 IN630 0001900O SV2 B 152 IN630 01910O SV3 B 159 IN630 01920O SV4 B 173 IN630 01930O SV5 B 202 IN630 01940O SV6 B 209 IN630 01950O SV7 B 218 IN630 ** 00196000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001970ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001980ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001990ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002000** 00201010 + 00202012 - 0020300014- -+ 00204016- + 00205018- + 00206020- + 00207040 + 00208042 + 00209043+- 0021000044+- 00211045 - 00212060 + 00213061 + 00214062- -+ 00215063- + 00216064 + 0021700065 + 00218066 - 00219067 - 00220068 - 00221070- + 00222072+ 00223073 - 0022400080 + 00225082 + 00226084 R 00227086+ 00228088R 00229090 + 00230092 R 0023100093 + 00232094 R 00233095 + 00234096 R 002350** 002360 +-R 002370** 0023800043 00239044 002400/* 002410__ R 002350** 002360 +-R 002370** 0023800( uOTXIN640 P999999111111(000010H S IN640 00020X DECK-ID M61 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN640 00030F* THIS PROGRAM LISTS ALL INVENTORY TRANSACTIONS USED IN UPDATING IN640 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN640 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN640 00060F* CONTROL DATA PROPRIETARY PRODUCT IN640 00070F* IN640 0000080FTRANWRK IPEAF 45 DISK IN640 00090FPARTMST IC F 300R12AI 1 DISK IN640 00100FHEADING IT F 40 EDISK IN640 00110F$LP1 O F 132 OF PRINTER IN640 00120F********************************************************************IN640 00130F* IN640 00140F* PACKAGE MANUFACTURING IN640 0000150F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN640 00160F* PROGRAM PRINT TRANSACTION LISTING IN640 00170F* IN640 00180F* CONTRACTOR COMPUSOURCE IN640 00190F* PROGRAMMER KATH HILL IN640 00200F* DATE OCTOBER 31, 1975 IN640 00210F* IN640 0000220F********************************************************************IN640 00230F* IN640 00240F* NARRATIVE: THIS LISTS OUT THE TRANSACTION FILE BY --- IN640 00250F* TRAN #/PART #/TRAN DATE --- IF AN INVALID TRAN # IN640 00260F* OR INVALID PART # IS FOUND, IT'S NOTED ON THE IN640 00270F* PRINTOUT. IN640 00280F* IN640 0000290F* UNIT/COST IS PRINTED FOR TRAN # 44 [P.O. RECEIPT] IN640 00300F* AND TRAN # 43 [REPLACE P.O. QTY RECEIVED] IN640 00310F* ONLY. IN640 00320F* IN640 00330F* IF U1 IS OFF, THEN ALL TRANSACTIONS ARE PRINTED. IN640 00340F* IF U1 IS ON, THEN ONLY MANUAL TRANSACTIONS IN640 00350F* [80,82,84,86,88,90,92,93,94,95,96] ARE PRINTED. IN640 0000360F********************************************************************IN640 00370F* IN640 00380F* ID F C H L FUNCTION OF INDICATORS IN640 00390F* IN640 00400F* 01 TRANTMP IN640 00410F* 02 PARTMST IN640 00420F* IN640 0000430F* 12 GOOD PARTMST RECORD [DELETE CODE BLAND] IN640 00440F* IN640 00450F* 20 CHAIN TO PARTMST = A 'MISS' IN640 00460F* 30 GOOD TRAN # IN640 00470F* 35 TRAN # = 44 OR 43 IN640 00480F* 50 IF U1, THEN AT L2 CHECK TO SEE IF TRANNO IN TABPRT IN640 00490F* 55 PRINT ALL RECORDS IN THIS TRANNO GROUP IN640 0000500F* IN640 00510F* L1PART # ON TRANTMP IN640 00520F* L2TRAN # ON TRANTMP IN640 00530F* IN640 00540F* U1PRINT JUST MANUAL TRANSACTIONS IN640 00550F* NU1PRINT ALL TRANSACTIONS - NOT JUST MANUALS IN640 00560F* IN640 0000570F********************************************************************IN640 00580E TABA 1 34 2 0 TABB 26 TRAN #/DESCRP IN640 00590E HEADING HEAD 1 1 40 COMPANY NAME IN640 00600E TABPRT 1 11 2 0 MANUAL TRAN #'S IN640 00610E* 80/82/84/86/88/ IN640 00620E* 90/92/93/94/95/96IN640 00630ITRANWRK NS 01 IN640 0000640I 1 12 PARTNOL1 IN640 00650I 13 140TRANNOL2 IN640 00660I 15 210QTY IN640 00670I 22 28 REFNUM IN640 00680I 29 340TRANDT IN640 00690I 35 413UNCOST IN640 00700IPARTMST NS 02 IN640 0000710I 1 12 PRNUM IN640 00720I 13 37 DESCRP IN640 00730I 74 74 DLTPR 12 IN640 00740C* IN640 00750C L2 SETOF 355055 IN640 00760C L2 U1 TRANNO LOKUPTABPRT 50 IN640 00770C L2 U1 50 IN640 0000780COR L2NU1 SETON 55 IN640 00790C N55 GOTO END IN640 00800C L2 TRANNO LOKUPTABA TABB 30 IN640 00810C L2 30 TRANNO COMP 44 35 IN640 00820C L2 30N35TRANNO COMP 43 35 IN640 00830C L2N30 SETOF 35 IN640 00840C* IN640 0000850C L1 PARTNO CHAINPARTMST 20 IN640 00860C L1N20N12 SETON 20 IN640 00870C* IN640 00880C END TAG IN640 00890C* IN640 00900O$LP1 H 202 L2NOF 55 IN640 00910O OR OFNL2 55 IN640 0000920O PAGE Z 10 IN640 00930O 4 'PAGE' IN640 00940O HEAD,1 85 IN640 00950O UDATE Y 132 IN640 00960O H 2 L2NOF 55 IN640 00970O OR OFNL2 55 IN640 00980O 70 'INVENTORY TRANSACTION' IN640 0000990O 79 'LISTING' IN640 01000O 132 'MFG640' IN640 01010O H 2 L2NOF 55 IN640 01020O OR OFNL2 55 IN640 01030O 43 'PART #' IN640 01040O 62 'DESCRIPTION' IN640 01050O 86 'QUANTITY' IN640 0001060O 95 'REF #' IN640 01070O 108 'TRAN DATE' IN640 01080O 118 'BUY COST' IN640 01090O D 11 L2NOF 55 IN640 01100O OR OFNL2 55 IN640 01110O 6 'TRAN #' IN640 01120O TRANNOZ 8 IN640 0001130O 30 TABB 35 IN640 01140O N30 30 '** INVALID TRAN # **' IN640 01150O D 1 01 55 IN640 01160O PARTNO 49 IN640 01170O N20 DESCRP 76 IN640 01180O 20 71 '** INVALID PART # **' IN640 01190O QTY J 88 IN640 0001200O REFNUM 97 IN640 01210O TRANDTY 107 IN640 01220O 30 TABB 35 IN640 01230O N30 30 '** INVALID TRAN # **' IN640 01240O 35 UNCOST1 118 IN640 01250O T 2 L2 55 IN640 01260O 1 ' ' IN640 00** 001270ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001280ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001290ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001300ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001310** 00132010SALES ORDERS 0013300012DELETE SALES ORDERS 00134014INVOICES 00135016CREDIT MEMOS 00136018MANUAL INVOICES 00137020DIRECT BILLS 00138040PURCHASE ORDERS 00139042REPLACE P.O. QTY ORDERED 0014000043REPLACE P.O. QTY RECEIVED 00141044P.O. RECEIPT 00142045CANCEL P.O. QTY / DLT P.O. 00143060OPEN JOBS 00144061OPEN JOBS (COMPONENTS) 00145062RELEASE JOBS 00146063MATERIAL ISSUES 0014700064CHANGE JOB QTY 00148065CHANGE JOB QTY (COMPT) 00149066DELETE OPEN JOB 00150067DELETE OPEN JOB (COMPT) 00151068CLOSE JOB SHORT/LONG 00152070ADJUST REQUISITIONS 00153072COMPLETED PRODUCTION #1 0015400073COMPLETED PRODUCTION #2 00155080ADJUST ALLOCATION 00156082ADJUST STOCK ON ORDER 00157084REPLACE STOCK ON ORDER 00158086ADJUST STOCK ON HAND 00159088REPLACE STOCK ON HAND 00160090ADJUST AVERAGE USAGE 0016100092REPLACE AVERAGE USAGE 00162093ADJUST MTD USAGE 00163094REPLACE MTD USAGE 00164095ADJUST YTD USAGE 00165096REPLACE YTD USAGE 001660** 00167080 0016800082 00169084 00170086 00171088 00172090 00173092 00174093 0017500094 00176095 00177096 001780/* 001790__ 00173092 00174093 0017500(|  OTXIN650 P999999111111(000010H S IN650 00020X DECK-ID M62 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN650 00030F* THIS PROGRAM IS USED FOR STOCK STATUS LISTINGS IN650 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN650 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN650 00060F* CONTROL DATA PROPRIETARY PRODUCT IN650 00070F* IN650 0000080FPARTMST IPEAF 300 12AI 1 DISK IN650 00090FHEADING IT F 40 EDISK IN650 00100F$LP1 O F 132 OF PRINTER IN650 00110F********************************************************************IN650 00120F** IN650 00130F** PACKAGE MANUFACTURING IN650 00140F** SYSTEM INVENTORY TRANSACTION ACCOUNTING IN650 0000150F** PROGRAM STOCK STATUS & EXCEPTION STOCK STATUS IN650 00160F** IN650 00170F** CONTRACTOR COMPUSOURCE IN650 00180F** PROGRAMMER IN650 00190F** DATE IN650 00200F** IN650 00210F********************************************************************IN650 0000220F* IN650 00230F* NARRATIVE: IF U1 -> PRINT EXCEPTION REPORT IN650 00240F* NU1 -> PRINT REGULAR REPORT IN650 00250F* IN650 00260F* EXCEPTION REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT IN650 00270F* BY OPERATOR WITH A BLANK DELETE CODE AND WITH AVAIL < MIN. IN650 00280F* IN650 0000290F* REGULAR REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT IN650 00300F* BY OPERATOR WITH A BLANK DELETE CODE. IF AVAIL < MIN, THEN IN650 00310F* RECORD IS FLAGGED WITH '**' AT END OF LINE ON PRINT OUT. IN650 00320F* IN650 00330F********************************************************************IN650 00340F* IN650 00350F* ID F C H L FUNCTION OF INDICATORS IN650 0000360F* IN650 00370F* 01 PARTMST -- CLASS = 'F' -- DELETE CODE BLANK IN650 00380F* 02 PARTMST -- CLASS = 'P' -- DELETE CODE BLANK IN650 00390F* 03 PARTMST -- CLASS = 'M' -- DELETE CODE BLANK IN650 00400F* 04 PARTMST -- ALL OTHERS IN650 00410F* IN650 00420F* 10 TAKE IN DATA FROM CRT IN650 0000430F* 11 'F'-TYPE INTERESTED IN IS 'F' IN650 00440F* 12 'P'-TYPE INTERESTED IN IS 'P' IN650 00450F* 13 'M'-TYPE INTERESTED IN IS 'M' IN650 00460F* 14 'A'-TYPE INTERESTED IN IS 'F'/'P'/'M' IN650 00470F* 15 AMONGST PRODUCT CLASS ARE INTERESTED IN IN650 00480F* 20 AVAIL < MIN IN650 00490F* 97 CRT LOOP WATCHER IN650 0000500F* 98 CRT LOOP WATCHER IN650 00510F* 99 DUMMY 1P IN650 00520F********************************************************************IN650 00530E HEADING HEAD 1 1 40 COMPANY NAME IN650 00540E MSG 1 9 56 CRT SCREEN IN650 00550E EMP9 1 9 BLANK IN650 00560IPARTMST NS 01 40 CF 74 C IN650 0000570I OR 02 40 CP 74 C IN650 00580I OR 03 40 CM 74 C IN650 00590I OR 04 IN650 00600I 1 12 PARTNO IN650 00610I 13 37 DESCRP IN650 00620I 38 39 UM IN650 00630I 40 40 CLASS IN650 0000640I 146 1520SOH IN650 00650I 153 1590SOO IN650 00660I 167 1730ALLOC IN650 00670I 181 1870MIN IN650 00680I 188 1940MAX IN650 00690I 196 2020MTDUSE IN650 00700I 203 2090AVGUSE IN650 0000710I 212 2180YTDUSE IN650 00720C SETOF 99 IN650 00730C 10 GOTO START IN650 00740C SETON 1099 IN650 00750C EXSR CRT IN650 00760C* IN650 00770C START TAG IN650 0000780C* CRT INPT/REC IN650 00790C SETOF 15 IN650 00800C 11 01 F/F IN650 00810COR 12 02 P/P IN650 00820COR 13 03 M/M IN650 00830COR 14 01 A/F IN650 00840COR 14 02 A/P IN650 0000850COR 14 03 SETON 15A/M IN650 00860C* IN650 00870C N15 GOTO NEXT IN650 00880C* IN650 00890C SOH ADD SOO AVAIL 70 IN650 00900C AVAIL SUB ALLOC AVAIL IN650 00910C* IN650 0000920C AVAIL COMP MIN 20 IN650 00930C* IN650 00940C NEXT TAG IN650 00950C* IN650 00960CLR EXSR CLRSCR IN650 00970C********************************************************************IN650 00980C* IN650 0000990C* THIS SUBROUTINE INQUIRES WHICH PRODUCT CLASS [OR ALL] IN650 01000C* IS TO BE LISTED. IN650 01010C* IN650 01020C* REPLY EFFECT IN650 01030C* ------- --------------------------------------------------- IN650 01040C* F ALL FINISHED GOODS NOT FLAGGED FOR DELETION IN650 01050C* P ALL PURCHASED GOODS NOT FLAGGED FOR DELETION IN650 0001060C* M ALL ASSEMBLIES NOT FLAGGED FOR DELETION IN650 01070C* A ALL GOODS NOT FLAGGED FOR DELETION IN650 01080C* IN650 01090C********************************************************************IN650 01100CSR CRT BEGSR IN650 01110CSR EXSR CLRSCR IN650 01120CSR Z-ADD0 I 20 IN650 0001130CSR LOOP1 TAG IN650 01140CSR I ADD 1 I IN650 01150CSR EXSR SETUP IN650 01160CSRNU1 I COMP 3 98 IN650 01170CSRNU1 98 MOVELEMP9,1 BUFFER IN650 01180CSR EXSR OUTS IN650 01190CSR I COMP 8 97 IN650 0001200CSR 97 GOTO LOOP1 IN650 01210C* IN650 01220CSR INPUT TAG IN650 01230CSR Z-ADD1404 CURPOS 40 IN650 01240CSR EXSR POSCUR IN650 01250CSR Z-ADD1 LNGTH 20 IN650 01260CSR EXSR ACCEPT IN650 0001270CSR MOVELBUFFER CHECK 1 IN650 01280CSR MOVEL']' BUFFER IN650 01290CSR EXSR OUTS IN650 01300CSR CHECK COMP 'F' 11FINISHED GOODS IN650 01310CSR CHECK COMP 'P' 12PURCHASED GOODSIN650 01320CSR CHECK COMP 'M' 13ASSEMBLIES IN650 01330CSR CHECK COMP 'A' 14ALL IN650 0001340CSR Z-ADD9 I IN650 01350CSR EXSR SETUP IN650 01360CSR 11 IN650 01370COR 12 IN650 01380COR 13 IN650 01390COR 14 MOVELEMP9,1 BUFFER IN650 01400CSR EXSR OUTS IN650 0001410CSRN11N12N13 IN650 01420CANN14 GOTO INPUT IN650 01430CSR ENDSR IN650 01440C********************************************************************IN650 01450C* IN650 01460C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. IN650 01470C* IT DEFINES ALL THE RLABL'S NECESSARY IN650 0001480C* IN650 01490C********************************************************************IN650 01500CSR CRTCOM BEGSR IN650 01510CSR EXITFSUBRCM IN650 01520CSR RLABL BUFFER 72 IN650 01530CSR RLABL TYPE 1 IN650 01540CSR RLABL BLNGTH 20 IN650 0001550CSR RLABL RCODE 1 IN650 01560CSR RLABL MASK 10 IN650 01570CSR RLABL DTYPE 10 IN650 01580CSR ENDSR IN650 01590C********************************************************************IN650 01600C* IN650 01610C* THIS SUBROUTINE SPLITS-UP CRT ARRAY ELEMENT, POSITIONS THE IN650 0001620C* CURSOR, AND STUFFS THE BUFFER. IN650 01630C* IN650 01640C********************************************************************IN650 01650CSR SETUP BEGSR IN650 01660CSR MOVELMSG,I WORD6 60 IN650 01670CSR MOVE MSG,I WORD50 50 IN650 01680CSR MOVELWORD6 CURPOS IN650 0001690CSR MOVE WORD6 LNGTH IN650 01700CSR EXSR POSCUR IN650 01710CSR MOVELWORD50 BUFFER IN650 01720CSR ENDSR IN650 01730C********************************************************************IN650 01740C* IN650 01750C* THIS SUBROUTINE CLEARS THE SCREEN. IN650 0001760C* IN650 01770C********************************************************************IN650 01780CSR CLRSCR BEGSR IN650 01790CSR MOVEL'C' TYPE IN650 01800CSR EXSR CRTCOM IN650 01810CSR ENDSR IN650 01820C********************************************************************IN650 0001830C* IN650 01840C* THIS SUBROUTINE POSITIONS THE CURSOR. IN650 01850C* IN650 01860C********************************************************************IN650 01870CSR POSCUR BEGSR IN650 01880CSR MOVELCURPOS BUFFER IN650 01890CSR MOVEL'P' TYPE IN650 0001900CSR EXSR CRTCOM IN650 01910CSR ENDSR IN650 01920C********************************************************************IN650 01930C* IN650 01940C* THIS SUBROUTINE ACCEPTS TYPE TO THE CRT FROM IN650 01950C* THE KEYBOARD. IN650 01960C* IN650 0001970C********************************************************************IN650 01980CSR ACCEPT BEGSR IN650 01990CSR MOVELLNGTH BLNGTH IN650 02000CSR MOVEL'A' TYPE IN650 02010CSR EXSR CRTCOM IN650 02020CSR ENDSR IN650 02030C********************************************************************IN650 0002040C* IN650 02050C* THIS SUBROUTINE OUTPUTS PRINT TO THE CRT AND IN650 02060C* REPOSITIONS THE CURSOR AT (BLNGTH + 1). IN650 02070C* IN650 02080C********************************************************************IN650 02090CSR OUTS BEGSR IN650 02100CSR MOVELLNGTH BLNGTH IN650 0002110CSR MOVEL'S' TYPE IN650 02120CSR EXSR CRTCOM IN650 02130CSR ENDSR IN650 02140C********************************************************************IN650 02150O$LP1 H 202 1P IN650 02160O OR OF IN650 02170O PAGE Z 8 IN650 0002180O 4 'PAGE' IN650 02190O HEAD,1 85 IN650 02200O UDATE Y 132 IN650 02210O H 2 99 IN650 02220O OR OF IN650 02230O U1 57 'EXCEPTION' IN650 02240O 71 'STOCK STATUS-' IN650 0002250O 11 85 'FINISHED GOODS' IN650 02260O 12 86 'PURCHASED GOODS' IN650 02270O 13 81 'ASSEMBLIES' IN650 02280O 14 74 'ALL' IN650 02290O 132 'MFG650' IN650 02300O H 3 99 IN650 02310O OR OF IN650 0002320O 11 'PART NUMBER' IN650 02330O 25 'DESCRIPTION' IN650 02340O 43 'CLS' IN650 02350O 46 'UM' IN650 02360O 55 'SOH' IN650 02370O 64 'SOO' IN650 02380O 73 'ALLOC' IN650 0002390O 82 'AVAIL' IN650 02400O 91 'MIN' IN650 02410O 100 'MAX' IN650 02420O 109 'MTD USE' IN650 02430O 118 'AVG USE' IN650 02440O 127 'YTD USE' IN650 02450O D 11 NU1 15 IN650 0002460O OR U1 20 15 IN650 02470O PARTNO 12 IN650 02480O DESCRP 39 IN650 02490O CLASS 42 IN650 02500O UM 46 IN650 02510O SOH L 56 IN650 02520O SOO L 65 IN650 0002530O ALLOC L 74 IN650 02540O AVAIL L 83 IN650 02550O MIN L 92 IN650 02560O MAX L 101 IN650 02570O MTDUSEL 110 IN650 02580O AVGUSEL 119 IN650 02590O YTDUSEL 128 IN650 0002600O NU1 15 20 132 '**' IN650 ** 002610ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002650** 00266000180132INVENTORY TRANSACTION ACCOUNTING 002670620106MFG650 002680190229EXCEPTION STOCK STATUS REPORT 002690030413PRINT OUT [ ] 002700030918F = FINISHED GOODS 002710031019P = PURCHASED GOODS 002720031114M = ASSEMBLIES 00273000031207A = ALL 002740170409**INVALID 002750/* 002760__13PRINT OUT [ ] 002700030918F = FINISHED GOODS 002710031019P = PURCHASED GOODS 002720031114M = ASSEMBLIES 0027300( bOTXIN660 P999999111111(000010H S IN660 00020X DECK-ID M63 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN660 00030F* UPDATES MIN/MAX FIELDS IN THE PARTMST FILE RECORDS IN660 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN660 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN660 00060F* CONTROL DATA PROPRIETARY PRODUCT IN660 00070F* IN660 0000080FPARTMST UPEAF 300 12AI 1 DISK IN660 00090FHEADING IT F 40 EDISK IN660 00100F$LP1 O F 132 OF PRINTER IN660 00110F********************************************************************IN660 00120F* IN660 00130F* COMPANY IN660 00140F* SYSTEM PURCHASE/INVENTORY CONTROL IN660 0000150F* PROGRAM MIN/MAX UPDATES OF PARTMST IN660 00160F* IN660 00170F* CONTRACTOR COMPUSOURCE IN660 00180F* PROGRAMMER KATH HILL IN660 00190F* DATE NOVEMBER 10, 1975 IN660 00200F* IN660 00210F********************************************************************IN660 0000220F* IN660 00230F********************************************************************IN660 00240F* IN660 00250F* NARRATIVE: IN660 00260F* IN660 00270F* THIS PROGRAM LOOKS AT ALL RECORDS IN THE PARTMST FILE THAT IN660 00280F* ARE NOT FLAGGED FOR DELETION, HAVE A ' ' OR 'X' MIN/MAX UPDATE IN660 0000290F* CODE, AND HAVE NON-ZERO VALUES FOR THE PARAMETERS USED TO IN660 00300F* DO THE UPDATING (LEAD TIME DAYS, SAFETY STOCK DAYS, AND IN660 00310F* AVERAGE USAGE). IN660 00320F* IN660 00330F* IT'S POSSIBLE TO (1) UPDATE PARTMST AND GET A REPORT THAT IN660 00340F* SHOWS ALL OF THE RECORDS WHOSE MIN AND/OR MAX ALTERS BY AT LEAST IN660 00350F* XXX.X% --- U1 --- TO SEE ALL OF THE RECORDS, USE 0%. IN660 0000360F* (2) JUST GET THE REPORT, SHOWING HOW THE IN660 00370F* FILE WOULD BE UPDATED --- NU1 --- GIVES A CHANCE TO LOOK IN660 00380F* BEFORE LEAPING. IN660 00390F* IN660 00400F* THOUGH ANY RECORDS WITH ONE OR MORE ZERO PARAMETERS IS NOT IN660 00410F* UPDATED, IF THEY MEET THE OTHER REQUIREMENTS TO BE UPDATED, IN660 00420F* THEN THEY ARE PRINTED OUT IN THE REPORT WITH A WARNING IN660 0000430F* MESSAGE. IN660 00440F* IN660 00450F********************************************************************IN660 00460F* IN660 00470F********************************************************************IN660 00480F* IN660 00490F* ID F C H L FUNCTION OF INDICATORS IN660 0000500F* IN660 00510F* 01 PARTMST RECORDS: IN660 00520F* 1. DELETE CODE BLANK IN660 00530F* 02 ALL OTHER PARTMST RECORDS IN660 00540F* IN660 00550F* 11 LEAD TIME DAYS = 0 IN660 00560F* 12 SAFETY STOCK DAYS = 0 IN660 0000570F* 13 AVERAGE USAGE = 0 IN660 00580F* 20 LOOP-INCREMENT WATCHER IN660 00590F* 40 MIN = 0 IN660 00600F* 45 MAX = 0 IN660 00610F* 50 MINPCT < 0 IN660 00620F* 55 MAXPCT < 0 IN660 00630F* 41 NEWMIN = 0 IN660 0000640F* 46 NEWMAX = 0 IN660 00650F* 80 IF NEWMIN OR NEWMAX VARIES BY X% OR MORE IN660 00660F* 90 MIN/MAX UPDATE CODE ' ' OR 'X' IN660 00670F* N90 MIN/MAX UPDATE CODE 'M' OR 'N' IN660 00680F* 99 ONLY GET X% FROM CRT ONCE IN660 00690F* IN660 00700F********************************************************************IN660 0000710F* IN660 00720E MSG 1 3 38 CRT SCREEN IN660 00730E HEADING HEAD 1 1 40 COMPANY NAME IN660 00740IPARTMST NS 01 74 C IN660 00750I 1 12 PARTNO IN660 00760I 13 37 DESCRP IN660 00770I 38 39 UM IN660 0000780I 40 40 CLASS IN660 00790I 44 460LEAD 11 IN660 00800I 47 490SAFETY 12 IN660 00810I 74 74 DLTCD IN660 00820I 181 1870MIN IN660 00830I 188 1940MAX IN660 00840I 195 195 MINMAX IN660 0000850I 196 2020MTDUSE IN660 00860I 203 2090AVGUSE 13 IN660 00870I 210 2112ALPHA IN660 00880I 212 2180YTDUSE IN660 00890I NS 02 IN660 00900I 1 1 AIR IN660 00910C N99 EXSR INXPCT IN660 0000920C N99 SETON 99 IN660 00930C* IN660 00940C 02 GOTO NEXT IN660 00950C MINMAX COMP ' ' 90 IN660 00960C N90 MINMAX COMP 'X' 90 IN660 00970C N90 GOTO NEXT IN660 00980C SETOF 75 IN660 0000990C 11 IN660 01000COR 12 IN660 01010COR 13 SETON 75 IN660 01020C 75 GOTO NEXT IN660 01030C EXSR FRMULA IN660 01040C* IN660 01050C NEWMIN SUB MIN CHNG1 70 IN660 0001060C NEWMAX SUB MAX CHNG2 70 IN660 01070C* IN660 01080C MIN COMP 0 40 IN660 01090C 40 NEWMIN COMP 0 41 IN660 01100C 40 41 Z-ADD0 PCT 53 IN660 01110C 40N41 Z-ADD1 PCT IN660 01120C N40 CHNG1 DIV MIN PCT IN660 0001130C PCT MULT 100 MINPCT 51 IN660 01140C* IN660 01150C MAX COMP 0 45 IN660 01160C 45 NEWMAX COMP 0 46 IN660 01170C 45 46 Z-ADD0 PCT IN660 01180C 45N46 Z-ADD1 PCT IN660 01190C N45 CHNG2 DIV MAX PCT IN660 0001200C PCT MULT 100 MAXPCT 51 IN660 01210C* IN660 01220C MINPCT COMP 0 50 IN660 01230C 50 Z-SUBMINPCT PCTC1 51 IN660 01240C N50 Z-ADDMINPCT PCTC1 IN660 01250C* IN660 01260C MAXPCT COMP 0 55 IN660 0001270C 55 Z-SUBMAXPCT PCTC2 51 IN660 01280C N55 Z-ADDMAXPCT PCTC2 IN660 01290C* IN660 01300C PCTC1 COMP X 80 80 IN660 01310C N80PCTC2 COMP X 80 80 IN660 01320C* IN660 01330C 80COUNT ADD 1 COUNT 50 IN660 0001340C* IN660 01350C NEXT TAG IN660 01360CLR EXSR CLRSCR IN660 01370C* IN660 01380C********************************************************************IN660 01390C* IN660 01400C* THIS SUBROUTINE ACCEPTS THE MIN/MAX PERCENT (XXX.X%) IN660 0001410C* FROM THE CRT. IN660 01420C* IN660 01430C********************************************************************IN660 01440CSR INXPCT BEGSR IN660 01450CSR EXSR CLRSCR IN660 01460CSR Z-ADD0 I 20 IN660 01470CSR LOOP1 TAG IN660 0001480CSR I ADD 1 I IN660 01490CSR MOVELMSG,I KEEP 60 IN660 01500CSR MOVE MSG,I MESS 32 IN660 01510CSR MOVELKEEP CURPOS 40 IN660 01520CSR MOVE KEEP LNGTH 20 IN660 01530CSR EXSR POSCUR IN660 01540CSR MOVELMESS BUFFER 72 IN660 0001550CSR EXSR OUTS IN660 01560CSR I COMP 3 20 IN660 01570CSR 20 GOTO LOOP1 IN660 01580CSR INX TAG IN660 01590CSR MOVEL'1103' CURPOS IN660 01600CSR EXSR POSCUR IN660 01610CSR MOVEL'[' BUFFER IN660 0001620CSR Z-ADD1 LNGTH IN660 01630CSR EXSR OUTS IN660 01640CSR Z-ADD4 LNGTH IN660 01650CSR EXSR ACCEPT IN660 01660CSR RCODE COMP 'R' 20 IN660 01670CSR 20 GOTO INX IN660 01680CSR MOVELBUFFER XHOLD 4 IN660 0001690CSR Z-ADD4 VL 20 IN660 01700CSR MOVELXHOLD VAR 15 IN660 01710CSR EXSR RTADJ IN660 01720CSR MOVELVAR X 41 IN660 01730CSR MOVEL'1203' CURPOS IN660 01740CSR EXSR POSCUR IN660 01750CSR MOVELVAR BUFFER IN660 0001760CSR EXSR OUTS IN660 01770CSR Z-ADD1 LNGTH IN660 01780CSR MOVEL']' BUFFER IN660 01790CSR EXSR OUTS IN660 01800CSR ENDSR IN660 01810C********************************************************************IN660 01820C* IN660 0001830C* THIS SUBROUTINE CALCULATES THE NEWMIN AND NEWMAX. IN660 01840C* IN660 01850C* AVGUSE AVERAGE MONTHLY USAGE IN660 01860C* LEAD LEAD TIME DAYS IN660 01870C* SAFETY SAFETY STOCK DAYS IN660 01880C* SSQ SAFETY STOCK QTY IN660 01890C* IN660 0001900C* SSQ = (SAFETY * AVGUSE)/30 IN660 01910C* IN660 01920C* NEWMIN = SSQ + (LEAD * AVGUSE)/30 IN660 01930C* IN660 01940C* NEWMAX = SSQ + 2((LEAD * AVGUSE)/30) IN660 01950C* IN660 01960C********************************************************************IN660 0001970CSR FRMULA BEGSR IN660 01980C* IN660 01990CSR SAFETY MULT AVGUSE CACHE1 70 IN660 02000CSR CACHE1 DIV 30 SSQ 82 IN660 02010C* IN660 02020CSR LEAD MULT AVGUSE CACHE2 70 IN660 02030CSR CACHE2 DIV 30 CACHE3 82 IN660 0002040CSR SSQ ADD CACHE3 NEWMIN 70 IN660 02050C* IN660 02060CSR CACHE3 MULT 2 CACHE3 IN660 02070CSR SSQ ADD CACHE3 NEWMAX 70 IN660 02080C* IN660 02090CSR ENDSR IN660 02100C********************************************************************IN660 0002110C* IN660 02120C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. IN660 02130C* IT DEFINES ALL THE RLABL'S NECESSARY IN660 02140C* IN660 02150C********************************************************************IN660 02160CSR CRTCOM BEGSR IN660 02170CSR EXITFSUBRCM IN660 0002180CSR RLABL BUFFER 72 IN660 02190CSR RLABL TYPE 1 IN660 02200CSR RLABL BLNGTH 20 IN660 02210CSR RLABL RCODE 1 IN660 02220CSR RLABL MASK 10 IN660 02230CSR RLABL DTYPE 10 IN660 02240CSR ENDSR IN660 0002250C********************************************************************IN660 02260C* IN660 02270C* THIS SUBROUTINE CLEARS THE SCREEN. IN660 02280C* IN660 02290C********************************************************************IN660 02300C* IN660 02310CSR CLRSCR BEGSR IN660 0002320CSR MOVEL'C' TYPE IN660 02330CSR EXSR CRTCOM IN660 02340CSR ENDSR IN660 02350C********************************************************************IN660 02360C* IN660 02370C* THIS SUBROUTINE POSITIONS THE CURSOR. IN660 02380C* IN660 0002390C********************************************************************IN660 02400C* IN660 02410CSR POSCUR BEGSR IN660 02420CSR MOVELCURPOS BUFFER IN660 02430CSR MOVEL'P' TYPE IN660 02440CSR EXSR CRTCOM IN660 02450CSR ENDSR IN660 0002460C********************************************************************IN660 02470C* IN660 02480C* THIS SUBROUTINE ACCEPTS TYPE TO THE CRT FROM IN660 02490C* THE KEYBOARD. IN660 02500C* IN660 02510C********************************************************************IN660 02520CSR ACCEPT BEGSR IN660 0002530CSR MOVELLNGTH BLNGTH IN660 02540CSR MOVEL'A' TYPE IN660 02550CSR EXSR CRTCOM IN660 02560CSR ENDSR IN660 02570C********************************************************************IN660 02580C* IN660 02590C* THIS SUBROUTINE OUTPUTS PRINT TO THE CRT AND IN660 0002600C* REPOSITIONS THE CURSOR AT (BLNGTH + 1). IN660 02610C* IN660 02620C********************************************************************IN660 02630CSR OUTS BEGSR IN660 02640CSR MOVELLNGTH BLNGTH IN660 02650CSR MOVEL'S' TYPE IN660 02660CSR EXSR CRTCOM IN660 0002670CSR ENDSR IN660 02680C********************************************************************IN660 02690C* IN660 02700C* THIS SUBROUTINE RIGHT ADJSTS NUMERIC FIELDS. IN660 02710C* IN660 02720C********************************************************************IN660 02730CSR RTADJ BEGSR IN660 0002740CSR EXIT SUBRAJ IN660 02750CSR RLABL VL 20 IN660 02760CSR RLABL VAR 15 IN660 02770CSR ENDSR IN660 02780C********************************************************************IN660 02790OPARTMST D 01 80N75 IN660 02800O AND U1 90 IN660 0002810O NEWMIN 187 IN660 02820O NEWMAX 194 IN660 02830O$LP1 H 202 1P IN660 02840O OR OF IN660 02850O PAGE Z 9 IN660 02860O 4 'PAGE' IN660 02870O HEAD,1 85 IN660 0002880O UDATE Y 132 IN660 02890O H 2 1P IN660 02900O OR OF IN660 02910O 72 'MIN/MAX CHANGES' IN660 02920O 132 'MFG660' IN660 02930O H 1 1P IN660 02940O OR OF IN660 0002950O 54 'SAFTY' IN660 02960O 59 'LEAD' IN660 02970O 75 'AVERAGE' IN660 02980O 96 '-------O L D-------' IN660 02990O 117 '-------N E W-------' IN660 03000O 132 '-- % CHANGE--' IN660 03010O H 2 1P IN660 0003020O OR OF IN660 03030O 6 'PART #' IN660 03040O 25 'DESCRIPTION' IN660 03050O 43 'UM' IN660 03060O 48 'CLS' IN660 03070O 53 'STK' IN660 03080O 58 'TIME' IN660 0003090O 65 'ALPH' IN660 03100O 74 'USAGE' IN660 03110O 86 'MIN' IN660 03120O 96 'MAX' IN660 03130O 107 'MIN' IN660 03140O 117 'MAX' IN660 03150O 124 'MIN' IN660 0003160O 131 'MAX' IN660 03170O D 1 01 80N75 IN660 03180O AD 90 IN660 03190O OR 01 75 90 IN660 03200O PARTNO 12 IN660 03210O DESCRP 39 IN660 03220O UM 43 IN660 0003230O CLASS 47 IN660 03240O SAFETYL 53 IN660 03250O LEAD L 58 IN660 03260O ALPHA J 65 IN660 03270O AVGUSEJ 76 IN660 03280O MIN J 87 IN660 03290O MAX J 97 IN660 0003300O N75NEWMINJ 108 IN660 03310O N75NEWMAXJ 118 IN660 03320O N75MINPCTL 125 IN660 03330O N75MAXPCTL 132 IN660 03340O 75 120 '** PARAMETER IS ZERO **' IN660 03350O T 33 LR IN660 03360O 1 ' ' IN660 0003370O T 33 LR IN660 03380O 1 ' ' IN660 03390O T 31 LR IN660 03400O 11 'END OF JOB.' IN660 03410O COUNT Z 18 IN660 03420O 42 'PRODUCTS HAD CHANGES OF' IN660 03430O X 1 48 IN660 0003440O 58 '% OR MORE.' IN660 ** 003450ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003460ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003470ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003480ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003490** 00350000200132UPDATE MIN/MAX LIMITS ON PARTMST 003510650106MFG660 003520030316MIN/MAX [ ] % 003530/* 003540__EQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003480ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003490** 0035000(!| |`OTXIN665 P999999111111(000010H S IN665 00020X DECK-ID M64 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN665 00030F* UPDATE AVE, MTD, YTD USAGE AND PRODUCE COSTED INVENTORY REPORT IN665 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN665 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN665 00060F* CONTROL DATA PROPRIETARY PRODUCT IN665 00070F* IN665 0000080FPARTMST UPEAF 300 12AI 1 DISK IN665 00090F$LP1 O F 132 OF PRINTER U3 IN665 00100FHEADING IT F 40 EDISK IN665 00110F********************************************************************IN665 00120F* IN665 00130F* U4: M/E UPDATE UPDATES AVG & YTD IN665 00140F* ZERO OUT MTD IN665 0000150F* U2: ZERO OUT AVG IN665 00160F* IN665 00170F* U1: ZERO OUT YTD IN665 00180F* IN665 00190F* U3: PRINT OUT COSTED INVENTORY REPORT IN665 00200F* IN665 00210F********************************************************************IN665 0000220F* ID F C H L FUNCTION OF INDICATORS IN665 00230F* IN665 00240F* 01 PARTMST IN665 00250F* 02 PARTMST - DELETED RECORD IN665 00260F* IN665 00270F********************************************************************IN665 00280E HEADING HEAD 1 1 40 COMPANY NAME IN665 0000290IPARTMST NS 01 74 C IN665 00300I 1 12 PARTNO IN665 00310I 13 37 DESCR IN665 00320I 38 39 UM IN665 00330I 40 40 CLASS IN665 00340I 75 813STDMAT IN665 00350I 110 1163CUMLAB IN665 0000360I 117 1233CUMBUR IN665 00370I 124 1303CUMOP IN665 00380I 146 1520SOH IN665 00390I 196 2020MTD IN665 00400I 203 2090AVG IN665 00410I 210 2112ALPHA IN665 00420I 212 2180YTD IN665 0000430I NS 02 IN665 00440I 1 1 AIR IN665 00450C N01 GOTO FINI IN665 00460C* IN665 00470C TRYU4 TAG M/E UPDATE IN665 00480C NU4 GOTO TRYU2 IN665 00490C MTD SUB AVG SAVE1 70 IN665 0000500C SAVE1 MULT ALPHA SAVE2 70H IN665 00510C AVG ADD SAVE2 AVG IN665 00520C YTD ADD MTD YTD IN665 00530C Z-ADD0 MTD IN665 00540C* IN665 00550C TRYU2 TAG ZERO OUT AVG IN665 00560C NU2 GOTO TRYU1 IN665 0000570C Z-ADD0 AVG IN665 00580C* IN665 00590C TRYU1 TAG ZERO OUT YTD IN665 00600C NU1 GOTO TRYU3 IN665 00610C Z-ADD0 YTD IN665 00620C* IN665 00630C TRYU3 TAG IN665 0000640C NU3 GOTO FINI IN665 00650C STDMAT ADD CUMLAB UNCOST 73 IN665 00660C UNCOST ADD CUMBUR UNCOST IN665 00670C UNCOST ADD CUMOP UNCOST IN665 00680C SOH MULT UNCOST EXTCST 92H IN665 00690C TOTAL ADD EXTCST TOTAL 102 IN665 00700C* IN665 0000710C FINI TAG IN665 00720OPARTMST D 01 U1 IN665 00730O OR 01 U2 IN665 00740O OR 01 U4 IN665 00750O U1 YTD 218 IN665 00760O U4 YTD 218 IN665 00770O U2 AVG 209 IN665 0000780O U4 AVG 209 IN665 00790O U4 MTD 202 IN665 00800O$LP1 H 202 1P U3 IN665 00810O OR OF U3 IN665 00820O PAGE Z 10 IN665 00830O 4 'PAGE' IN665 00840O HEAD,1 85 IN665 0000850O UDATE Y 132 IN665 00860O H 2 1P U3 IN665 00870O OR OF U3 IN665 00880O 73 'COSTED INVENTORY REPORT' IN665 00890O 132 'MFG665' IN665 00900O H 2 1P U3 IN665 00910O OR OF U3 IN665 0000920O 6 'PART #' IN665 00930O 25 'DESCRIPTION' IN665 00940O 51 'CLS UM ALPH' IN665 00950O 61 'AVG USE' IN665 00960O 72 'MTD USE' IN665 00970O 83 'YTD USE' IN665 00980O 94 'SOH' IN665 0000990O 105 'UNIT COST' IN665 01000O 120 'EXTENDED COST' IN665 01010O D 1 01 U3 IN665 01020O PARTNO 12 IN665 01030O DESCR 39 IN665 01040O CLASS 42 IN665 01050O UM 46 IN665 0001060O ALPHA L 51 IN665 01070O AVG J 62 IN665 01080O MTD J 73 IN665 01090O YTD J 84 IN665 01100O SOH J 95 IN665 01110O UNCOSTJ 106 IN665 01120O EXTCSTJ 121 IN665 0001130O T 1 LR U3 IN665 01140O 120 '-------------' IN665 01150O T 1 LR U3 IN665 01160O 11 'END OF JOB.' IN665 01170O 106 'TOTAL' IN665 01180O TOTAL J 121 IN665 ** 00119000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001200ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001210ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001220ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001230/* 001240__0O TOTAL J 121 IN665 ** 0011900(! ;OTXININT P999999111111(000010H S ININIT00020X DECK-ID M65 MFG/DIST/ACCT SYSTEM SUMMARY-123 ININIT00030F* INITIALIZES THE INPUT FILE WITH <> IN RECORD POSITION 1 AND 2 ININIT00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0ININIT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA ININIT00060F* CONTROL DATA PROPRIETARY PRODUCT ININIT00070F* ININIT0000080FDUMMY IP F 72 DISK ININIT00090FTRANTMP UC F 45R DISK ININIT00100IDUMMY NS 02 ININIT00110I 1 1 A ININIT00120ITRANTMP NS 01 ININIT00130I 1 45 REC ININIT00140C SETON LR99 ININIT0000150CLR LOOP TAG ININIT00160CLR RRN ADD 1 RRN 50 ININIT00170CLR RRN CHAINTRANTMP 70 ININIT00180CLRN70 EXCPT ININIT00190CLRN70 GOTO LOOP ININIT00200OTRANTMP E 99N70 ININIT00210O OR LRN70 ININIT0000220O REC 45 ININIT00230O 2 '<>' ININIT** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00028000/* 000290__0O 2 '<>' ININIT** 000240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0002800(x" m2OTXFM080 P999999111111(000010H S FM080 00020X DECK-ID M07 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM080 00030F* PURGES A MASTER FILE OF RECORDS FLAGGED FOR DELETION FM080 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM080 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM080 00060F* CONTROL DATA PROPRIETARY PRODUCT FM080 00070F* FM080 0000080FPARTMST IPEAF 300 12AI 1 DISK U1 FM080 00090FMACHMST ISEAF 48 5AI 1 DISK U2 FM080 00100FLABMST ISEAF 48 2AI 1 DISK U3 FM080 00110FVENDOR ISEAF 256 5AI 1 DISK U4 FM080 00120FEMPMST ISEAF 100 5AI 1 DISK U5 FM080 00130FPAROUT O F 300 DISK U1 FM080 00140FMACOUT O F 48 DISK U2 FM080 0000150FLABOUT O F 48 DISK U3 FM080 00160FVENOUT O F 256 DISK U4 FM080 00170FEMPOUT O F 100 DISK U5 FM080 00180F$LP1 O F 132 OF PRINTER FM080 00190F********************************************************************FM080 00200F* FM080 00210F* COMPANY FM080 0000220F* SYSTEM FILE MAINTENANCE FM080 00230F* PROGRAM PURGES MASTER FILES OF RECORDS FLAGGED FOR DELETION FM080 00240F* FM080 00250F* CONTRACTOR COMPUSOURCE FM080 00260F* PROGRAMMER FM080 00270F* DATE FM080 00280F* FM080 0000290F********************************************************************FM080 00300F* FM080 00310F* U1 PARTMST FM080 00320F* U2 MACHMST FM080 00330F* U3 LABMST FM080 00340F* U4 VENDOR FM080 00350F* U5 EMPMST FM080 0000360F* FM080 00370F********************************************************************FM080 00380F* FM080 00390F* ID F C H L FUNCTION OF INDICATORS FM080 00400F* FM080 00410F* 01 PARTMST KEEP FM080 00420F* 02 PARTMST DELETE FM080 0000430F* 03 MACHMST KEEP FM080 00440F* 04 MACHMST DELETE FM080 00450F* 05 LABMST KEEP FM080 00460F* 06 LABMST DELETE FM080 00470F* 07 VENDOR KEEP FM080 00480F* 08 VENDOR DELETE FM080 00490F* 09 EMPMST KEEP FM080 0000500F* 10 EMPMST DELETE FM080 00510F* FM080 00520F********************************************************************FM080 00530IPARTMST NS 01 74 C FM080 00540I 1 200 REC01 FM080 00550I 201 300 REC01A FM080 00560I NS 02 FM080 0000570I 1 12 X02 FM080 00580IMACHMST NS 03 36 C FM080 00590I 1 48 REC03 FM080 00600I NS 04 FM080 00610I 1 50X04 FM080 00620ILABMST NS 05 30 C FM080 00630I 1 48 REC05 FM080 0000640I NS 06 FM080 00650I 1 20X06 FM080 00660IVENDOR NS 07 106 C FM080 00670I 1 200 REC07 FM080 00680I 201 256 REC07A FM080 00690I NS 08 FM080 00700I 1 50X08 FM080 0000710IEMPMST NS 09 40 C FM080 00720I 1 100 REC09 FM080 00730I NS 10 FM080 00740I 1 50X10 FM080 00750OPAROUT D 01 FM080 00760O REC01 200 FM080 00770O REC01A 300 FM080 0000780OMACOUT D 03 FM080 00790O REC03 48 FM080 00800OLABOUT D 05 FM080 00810O REC05 48 FM080 00820OVENOUT D 07 FM080 00830O REC07 200 FM080 00840O REC07A 256 FM080 0000850OEMPOUT D 09 FM080 00860O REC09 100 FM080 00870O$LP1 H 202 1P FM080 00880O OR OF FM080 00890O U1 15 'PARTMST DELETES' FM080 00900O U2 15 'MACHMST DELETES' FM080 00910O U3 14 'LABMST DELETES' FM080 0000920O U4 14 'VENDOR DELETES' FM080 00930O U5 14 'EMPMST DELETES' FM080 00940O D 1 02 FM080 00950O OR 04 FM080 00960O OR 06 FM080 00970O OR 08 FM080 00980O OR 10 FM080 0000990O U1X02 12 FM080 01000O U2X04 5 FM080 01010O U3X06 2 FM080 01020O U4X08 5 FM080 01030O U5X10 5 FM080 ** 001040ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00105000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001060ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001070ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001080/* 001090__0O U5X10 5 FM080 ** 001040ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0010500(U$ L$OTXFM081 P999999111111(000010H S FM081 00020X DECK-ID M08 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM081 00030F* COPIES A TEMPORARY PURGED MASTER FILE TO THE MASTER FILE FM081 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM081 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM081 00060F* CONTROL DATA PROPRIETARY PRODUCT FM081 00070F* FM081 0000080FPAROUT IPEAF 300 DISK U1 FM081 00090FMACOUT ISEAF 48 DISK U2 FM081 00100FLABOUT ISEAF 48 DISK U3 FM081 00110FVENOUT ISEAF 256 DISK U4 FM081 00120FEMPOUT ISEAF 100 DISK U5 FM081 00130FPARTMST O F 300 12AI 1 DISK U U1 FM081 00140FMACHMST O F 48 5AI 1 DISK U U2 FM081 0000150FLABMST O F 48 2AI 1 DISK U U3 FM081 00160FVENDOR O F 256 5AI 1 DISK U U4 FM081 00170FEMPMST O F 100 5AI 1 DISK U U5 FM081 00180F********************************************************************FM081 00190F* FM081 00200F* COMPANY FM081 00210F* SYSTEM FILE MAINTENANCE FM081 0000220F* PROGRAM COPIES BACK A PURGED MASTER FILE FM081 00230F* FM081 00240F* CONTRACTOR COMPUSOURCE FM081 00250F* PROGRAMMER FM081 00260F* DATE FM081 00270F* FM081 00280F********************************************************************FM081 0000290F* FM081 00300F* U1 PARTMST FM081 00310F* U2 MACHMST FM081 00320F* U3 LABMST FM081 00330F* U4 VENDOR FM081 00340F* U5 EMPMST FM081 00350F* FM081 0000360F********************************************************************FM081 00370F* FM081 00380F* ID F C H L FUNCTION OF INDICATORS FM081 00390F* FM081 00400F* 01 PAROUT FM081 00410F* 02 MACOUT FM081 00420F* 03 LABOUT FM081 0000430F* 04 VENOUT FM081 00440F* 05 EMPOUT FM081 00450F* FM081 00460F********************************************************************FM081 00470IPAROUT NS 01 FM081 00480I 1 200 A FM081 00490I 201 300 B FM081 0000500IMACOUT NS 02 FM081 00510I 1 48 C FM081 00520ILABOUT NS 03 FM081 00530I 1 48 D FM081 00540IVENOUT NS 04 FM081 00550I 1 200 E FM081 00560I 201 256 F FM081 0000570IEMPOUT NS 05 FM081 00580I 1 100 G FM081 00590OPARTMST D 01 FM081 00600O A 200 FM081 00610O B 300 FM081 00620OMACHMST D 02 FM081 00630O C 48 FM081 0000640OLABMST D 03 FM081 00650O D 48 FM081 00660OVENDOR D 04 FM081 00670O E 200 FM081 00680O F 256 FM081 00690OEMPMST D 05 FM081 00700O G 100 FM081 00** 000710ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000720ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000730ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000740ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000750/* 000760__0O G 100 FM081 0("L `TXIN012 P999999032778(000010H S IN012 00020X DECK-ID M56 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN012 00030F* THIS PROGRAM LISTS PARTMST FILE RECORDS NOT FLAGGED FOR DELETE IN012 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN012 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN012 00060F* CONTROL DATA PROPRIETARY PRODUCT IN012 00070F* IN012 0000080FPARTMST IPEAF 300 20AI 271 DISK IN012 00090FHEADING IT F 40 EDISK IN012 00100F$LP1 O F 132 OF PRINTER IN012 00110F********************************************************************IN012 00120F* IN012 00130F* COMPANY IN012 00140F* SYSTEM FILE MAINTENANCE IN012 0000150F* PROGRAM LISTS OUT ALL RECORDS IN PARTMST NOT FLAGGED IN012 00160F* FOR DELETION IN012 00170F* IN012 00180F* CONTRACTOR COMPUSOURCE IN012 00190F* PROGRAMMER IN012 00200F* DATE IN012 00210F* IN012 0000220F********************************************************************IN012 00230F* IN012 00240F* ID F C H L FUNCTION OF INDICATORS IN012 00250F* IN012 00260F* 01 RECORD NOT FLAGGED FOR DELETION IN012 00270F* 02 RECORD IS FLAGGED FOR DELETION IN012 00280F* IN012 0000290F********************************************************************IN012 00300E HEADING HEAD 1 1 40 COMPANY NAME IN012 00310IPARTMST NS 01 74 C IN012 00320I 271 290 PARTNO IN012 00330I 1 37 DESCRP IN012 00340I 38 39 UM IN012 00350I 40 40 CLASS IN012 0000360I 41 430GROUP IN012 00370I 44 460LEAD IN012 00380I 47 490SAFETY IN012 00390I 50 50 ABC IN012 00400I 51 51 INVTRY IN012 00410I 57 610VNDNUM IN012 00420I 62 73 VPTNUM IN012 0000430I 75 813MATDLS IN012 00440I 89 953LABDLS IN012 00450I 96 1023BURDLS IN012 00460I 103 1093OPDLS IN012 00470I 131 1373LABHRS IN012 00480I 181 1870MINROP IN012 00490I 188 1940MAXEOQ IN012 0000500I 195 195 MINMAX IN012 00510I 210 2112ALPHA IN012 00520I 219 219 REVLTR IN012 00530I 220 2250REVDAT IN012 00540I 291 296 BIN IN012 00550I NS 02 IN012 00560I 1 1 AIR IN012 0000570C 01 COUNT ADD 1 COUNT 80 IN012 00580O$LP1 H 202 1P IN012 00590O OR OF IN012 00600O PAGE Z 8 IN012 00610O 4 'PAGE' IN012 00620O HEAD,1 86 IN012 00630O UDATE Y 132 IN012 0000640O H 2 1P IN012 00650O OR OF IN012 00660O 78 'PART MASTER FILE LISTING' IN012 00670O 132 'MFG012' IN012 00680O H 1 1P IN012 00690O OR OF IN012 00700O 11 'PART NUMBER' IN012 0000720O 54 'UM ALP LT ABC' IN012 00730O 76 'VEND # REV LTR' IN012 00740O 84 'MIN' IN012 00750O 104 'MATL $ LABOR $' IN012 00760O 114 'MIN/MAX' IN012 00770O 121 'BIN #' IN012 00780O H 1 1P IN012 0000790O OR OF IN012 00800O 59 '--------------------' IN012 00810O 79 '--------------------' IN012 00820O 99 '--------------------' IN012 00830O 114 '---------------' IN012 00840O 121 '-------' IN012 00850O H 2 1P IN012 0000860O OR OF IN012 00865O 12 'DESCRIPTION' 00870O 60 'CLS GRP SS INV VEND' IN012 00880O 76 'PART # REV DATE' IN012 00890O 94 'MAX BURDEN $' IN012 00900O 114 'O.P. $ LAB HRS' IN012 00910O D 01 01 IN012 0000920O PARTNO 20 IN012 00940O UM 42 IN012 00950O ALPHA L 47 IN012 00960O LEAD L 51 IN012 00970O ABC 53 IN012 00980O VNDNUM 67 IN012 00990O REVLTR 76 IN012 0001000O MINROPL 85 IN012 01010O MATDLSL 95 IN012 01020O LABDLSL 105 IN012 01030O MINMAX 114 IN012 01040O BIN 121 IN012 01050O D 02 01 IN012 01055O DESCRP 38 0001060O CLASS 42 IN012 01070O GROUP 46 IN012 01080O SAFETYL 51 IN012 01090O INVTRY 53 IN012 01100O VPTNUM 67 IN012 01110O REVDATY 76 IN012 01120O MAXEOQL 85 IN012 0001130O BURDLSL 95 IN012 01140O OPDLS L 105 IN012 01150O LABHRSL 115 IN012 01160O T 3 LR IN012 01170O 22 'END OF JOB. THERE ARE' IN012 01180O COUNT 1 33 IN012 01190O 55 'ACTIVE RECORDS IN THE' IN012 0001200O 73 'PART MASTER FILE.' IN012 ** 001210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001250/* 00126000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(0y TLABEL4 P999999050878(000010H LABEL400020X 1 1 LABELS00030FLDATA IPE F 276 276 DISK LABELS00040FPRINT O F 132 OF PRINTER LABELS00050FLDATADB O F 138 138 DISK 00060ILDATA NS 01 LABELS00070I 1 30 CN1 0000080I 31 58 ST1 00090I 59 71 CITY1 00100I 72 75 STATE1 00110I 76 80 ZIP1 00120I 81 110 NAME1 00130I 139 168 CN2 00140I 169 196 ST2 0000150I 197 209 CITY2 00160I 210 213 STATE2 00170I 214 218 ZIP2 00180I 219 248 NAME2 00190I 1 138 ALL1 00200I 139 276 ALL2 00202C N99 Z-ADD0 OFLOW 0000203C N99 Z-ADD0 COUNT 00204C N99 SETON 99 00210C 98 SETOF 98 LABEL100220C 77 Z-ADD0 COUNT 10 00230C 77 SETOF 77 00240C COUNT ADD 1 COUNT 00250C COUNT COMP 1 50 0000260C 50 MOVELCN1 CN3 30 0035000270C 50 MOVELST1 ST3 28 0036000280C 50 MOVELCITY1 CITY3 13 0037000290C 50 MOVELSTATE1 STATE3 4 0038000300C 50 MOVELZIP1 ZIP3 5 0039000310C 50 MOVELNAME1 NAME3 30 0040000320C 50 MOVELCN2 CN4 30 004100000330C 50 MOVELST2 ST4 28 0042000340C 50 MOVELCITY2 CITY4 13 0043000350C 50 MOVELSTATE2 STATE4 4 0044000360C 50 MOVELZIP2 ZIP4 5 0045000370C 50 MOVELNAME2 NAME4 30 0046000380C 50 SETOF 50 00390C COUNT COMP 2 51 004700000400C 51 MOVELCN1 CN5 30 0048000410C 51 MOVELST1 ST5 28 0049000420C 51 MOVELCITY1 CITY5 13 0050000430C 51 MOVELSTATE1 STATE5 4 0051000440C 51 MOVELZIP1 ZIP5 5 0052000450C 51 MOVELNAME1 NAME5 30 0053000460C 51 MOVELCN2 CN6 30 005400000470C 51 MOVELST2 ST6 28 0055000480C 51 MOVELCITY2 CITY6 13 0056000490C 51 MOVELSTATE2 STATE6 4 0057000500C 51 MOVELZIP2 ZIP6 5 0058000510C 51 MOVELNAME2 NAME6 30 0059000520C 51 SETON 77 0060000530C 51 Z-ADD0 COUNT 0000540C 51 SETOF 51 00550C 77 OFLOW ADD 1 OFLOW 20 0061000560C OFLOW COMP 10 98 98 0062000570C 98 Z-ADD0 OFLOW 00580OPRINT H 01 1P 00590O 1 ' ' 00600O H 01 98 0000610O 1 ' ' 00620O D 77 0063000630O CN3 B 31 0064000640O CN4 B 63 0065000650O CN5 B 95 0066000660O CN6 B 127 0067000670O D 77 006800000680O ST3 B 29 0069000690O ST4 B 61 0070000700O ST5 B 93 0071000710O ST6 B 125 0072000720O D 77 0073000730O CITY3 B 14 0074000740O STATE3 B 19 007500000750O ZIP3 B 25 0076000760O CITY4 B 46 0077000770O STATE4 B 51 0078000780O ZIP4 B 57 0079000790O CITY5 B 78 0080000800O STATE5 B 83 0081000810O ZIP5 B 89 0000820O CITY6 B 110 00830O STATE6 B 115 00840O ZIP6 B 121 00850O D 77 00860O 6 'ATTN.' 00870O 38 'ATTN.' 00880O 70 'ATTN.' 0000890O 102 'ATTN.' 00900O D 2 77 00910O NAME3 31 00920O NAME4 63 00930O NAME5 95 00940O NAME6 127 00950OLDATADB D 01 0000960O ALL1 0138 00970O D 01 00980O ALL2 0138 /* 000990_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2- @MFG10OS PPP999999041078(000010H MFG10O00020FOUTPUT IPE F 80 DISK MFG10O00030F@MFG10 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060O@MFG10 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 __ 0(d. .*OTXBM101 P999999041178(000010H S BM101 00020X DECK-ID M09 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM101 00030F* CREATES BOMINP FROM BM1OUT BM101 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0BM101 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM101 00060F* CONTROL DATA PROPRIETARY PRODUCT BM101 00070F* BM101 0000080FBM1OUT IP AF 128 DISK BM101 00090FBOMINP O F 54 DISK BM101 00100F********************************************************************BM101 00110F* BM101 00120F* PACKAGE MANUFACTURING BM101 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM101 00140F* PROGRAM CREATE BOMINP FROM BM1OUT BM101 0000150F* BM101 00160F********************************************************************BM101 00170F* BM101 00180F* NARRATIVE: BM101 00190F* BM101 00200F* FOR EACH RECORD IN KPFILE WITH DATA IN IT (KEYPCH PUTS A BM101 00210F* REL REC # IN 124-127 OF EACH RECORD IT FILLS), A RECORD IS PUT BM101 0000220F* OUT TO BOMINP. BM101 00230F* BM101 00240F********************************************************************BM101 00250F* BM101 00260F* ID F C H L FUNCTION OF INDICATORS BM101 00270F* BM101 00280F* 01 BM1OUT RECORD BM101 0000290F* BM101 00300F* 91 REL REC NO BLANK NO DATA IN RECORD BM101 00310F* BM101 00320F********************************************************************BM101 00330IBM1OUT NS 01 BM101 00340I 1 2 TST BM101 00350I 1 36 IMAGE BM101 0000360I 124 1270RRN 91 BM101 00370C TST COMP '<>' 9191 BM101 00380OBOMINP D 01 91 BM101 00390O IMAGE 36 BM101 00400O RRN 41 BM101 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00042000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000450/* 000460__0O RRN 41 BM101 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0004200(d.: 1*OTXBM102 P999999041178(000010H S BM102 00020X DECK-ID M10 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM102 00030F* FOR EVERY FINISHED GOOD IN BOMMST, CREATE A RECORD IN BOMLST BM102 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM102 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM102 00060F* CONTROL DATA PROPRIETARY PRODUCT BM102 00070F* BM102 0000080FBOMMST IPEAF 28 12AI 1 DISK BM102 00090FBOMCST O F 54 DISK BM102 00100F********************************************************************BM102 00110F* BM102 00120F* PACKAGE MANUFACTURING BM102 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM102 00140F* PROGRAM CREATE BOMCST FROM BOMMST BM102 0000150F* BM102 00160F* CONTRACTOR COMPUSOURCE BM102 00170F* PROGRAMMER TOM LEE BM102 00180F* DATE AUGUST 1, 1976 BM102 00190F********************************************************************BM102 00200F* BM102 00210F* NARRATIVE: BM102 0000220F* BM102 00230F* FIRST IN A SERIES OF PROGRAMS UPDATING ALL COSTS. BM102 00240F* BM102 00250F* THIS PROGRAM CREATES A PSEUDO-BOMINP. IN BOMMST, A FINISHED BM102 00260F* GOOD HAS A 0 WHERE-USED REL REC #. FOR EVERY FINISHED GOOD, BM102 00270F* A RECORD IS OUTPUT TO BOMCST. BM102 00280F* BM102 0000290F********************************************************************BM102 00300F* ID F C H L FUNCTION OF INDICATORS BM102 00310F* BM102 00320F* 01 BOMMST RECORD BM102 00330F* BM102 00340F* 10 WHERE-USED_REL_REC_#/BOMMST = 0 ---> FINISHED GOOD BM102 00350F* BM102 0000360F********************************************************************BM102 00370IBOMMST NS 01 BM102 00380I 1 12 PN BM102 00390I 18 220WURRN 10 BM102 00400OBOMCST D 01 10 BM102 00410O 2 'PS' BM102 00420O PN 15 BM102 0000430O 35 '5' BM102 ** 000440ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000450ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000460ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000470ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000480/* 00049000__0O 35 '5' BM102 ** 000440ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000450ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000460ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000470ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000480/* 0004900(d.e .*OTXBM109 P999999041178(000010H S BM109 00020X DECK-ID M13 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM109 00030F* CREATES BOMINP FROM BM1OUTA BM109 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM109 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM109 00060F* CONTROL DATA PROPRIETARY PRODUCT BM109 00070F* BM109 0000080FBM1OUTA IP AF 128 DISK BM109 00090FBOMINP O F 54 DISK BM109 00100F********************************************************************BM109 00110F* BM109 00120F* PACKAGE MANUFACTURING BM109 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM109 00140F* PROGRAM CREATE BOMINP FROM BM1OUTA BM109 0000150F* BM109 00160F********************************************************************BM109 00170F* BM109 00180F* NARRATIVE: BM109 00190F* BM109 00200F* FOR EACH RECORD IN KPFILE WITH DATA IN IT (KEYPCH PUTS A BM109 00210F* REL REC # IN 124-127 OF EACH RECORD IT FILLS), A RECORD IS PUT BM109 0000220F* OUT TO BOMINP. BM109 00230F* BM109 00240F********************************************************************BM109 00250F* BM109 00260F* ID F C H L FUNCTION OF INDICATORS BM109 00270F* BM109 00280F* 01 BM1OUTA RECORD BM109 0000290F* BM109 00300F* 91 REL REC NO BLANK NO DATA IN RECORD BM109 00310F* BM109 00320F********************************************************************BM109 00330IBM1OUTA NS 01 BM109 00340I 1 2 TST BM109 00350I 1 36 IMAGE BM109 0000360I 123 1270RRN 91 BM109 00370C TST COMP '<>' 9191 BM109 00380OBOMINP D 01 91 BM109 00390O IMAGE 36 BM109 00400O RRN 41 BM109 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00042000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000450/* 000460__0O RRN 41 BM109 ** 000410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0004200($ $OTXBM110 P999999041178(000010H S BM110 00020X DECK-ID M14 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM110 00030F* EDIT STRCHG RECORDS AND CREATE BOMSEQ BM110 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM110 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM110 00060F* CONTROL DATA PROPRIETARY PRODUCT BM110 00070F* BM110 0000080FBOMSTR IPEAF 54 DISK BM110 00090FSTRCHNG ISEAF 54 DISK BM110 00100FPARTMST IC F 300R12AI 1 DISK BM110 00110FHEADING IT F 40 EDISK BM110 00120FBOMSEQ O F 54 DISK BM110 00130F$LP1 O F 132 OF PRINTER BM110 00140F********************************************************************BM110 0000150F* BM110 00160F* PACKAGE MANUFACTURING BM110 00170F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM110 00180F* PROGRAM EDITS STRCHNG -AND- USES GOOD STRCHNG RECORDS BM110 00190F* AND ORIGINAL BOMSTR TO PRODUCE BOMSEQ (AN UPDATED BM110 00200F* VERSION OF BOMSTR) BM110 00210F* BM110 0000220F* CONTRACTOR COMPUSOURCE BM110 00230F* PROGRAMMER TOM LEE BM110 00240F* DATE AUGUST 1, 1976 BM110 00250F********************************************************************BM110 00260F* BM110 00270F* NARRATIVE: BM110 00280F* BM110 0000290F* THE ORIGINAL PRODUCT STRUCTURE FILE, BOMSTR, AND THE BM110 00300F* STRUCTURE CHANGES FILE, STRCHNG, ARE USED TO CREATE AN UPDATED BM110 00310F* FORM OF PRODUCT STRUCTURE FILE IN BOMSEQ. BM110 00320F* BM110 00330F********************************************************************BM110 00340F* ID F C H L FUNCTION OF INDICATORS BM110 00350F* BM110 0000360F* 01 BOMSTR BM110 00370F* 03 STRCHNG ADD BM110 00380F* 05 STRCHNG CHANGE BM110 00390F* 07 STRCHNG DLT BM110 00400F* 09 STRCHNG MULT DLT BM110 00410F* 11 STRCHNG INVALID TRANSACTION BM110 00420F* 12 PARTMST BM110 0000430F* 40 BLANK PARENT PART # ] STRCHNG RECORDS BM110 00440F* 41 BLANK COMPONENT PART # ] BM110 00450F* 42 0 STRUCTURE QUANTITY ] BM110 00460F* 43 BLANK INVENTORY CODE ] BM110 00470F* 10 STRCHNG RECORD --> PRINT BM110 00480F* 25 STRCHNG ADD WITH INVALID PART # BM110 00490F* 26 STRCHNG MULT DLT PARENT NOT PARENT IN BOMSTR BM110 0000500F* 31 DLT BM110 00510F* 32 MULT DLT BM110 00520F* 33 ERROR BM110 00530F* 34 PROCESSING BOMSTR RECORD BM110 00540F* 36 GOOD STRCHNG ADD TO GO TO BOMSEQ BM110 00550F* 50 DUPLICATE TRANSACTION BM110 00560F* 98 END OF PROCESSING (HIT 12-Z BOMSTR RECORD) BM110 0000570F* 99 SETUP Z12 ONCE ONLY AT START OF PROGRAM BM110 00580F* L1COMPONENT PART # ] STRCHNG & BOMSTR RECORDS BM110 00590F* M1COMPONENT PART # ] BM110 00600F* L2PARENT PART # ] BM110 00610F* M2PARENT PART # ] BM110 00620F* LRDONE PROCESSING BM110 00630F* BM110 0000640F********************************************************************BM110 00650E HEADING HEAD 1 1 40 COMPANY NAME BM110 00660IBOMSTR NS 01 BM110 00670I 1 12 PRNT L2M2 BM110 00680I 13 24 CMPNT L1M1 BM110 00690I 25 313QTY BM110 00700I 37 410RRN1 BM110 0000710I 42 460RRN2 BM110 00720I 47 510RRN3 BM110 00730I 52 52 NXTCOD BM110 00740I 54 54 ICODE BM110 00750I 1 54 REC BM110 00760I NS ** BM110 00770I 1 12 LPRNT BM110 0000780ISTRCHNG NS 03 1 CP 2 CS 3 CA BM110 00790I OR 05 1 CP 2 CS 3 CC BM110 00800I OR 07 1 CP 2 CS 3 CD BM110 00810I OR 09 1 CP 2 CS 3 CM BM110 00820I OR 11 BM110 00830I 3 3 TC BM110 00840I 4 15 PRNT L2M2 40 BM110 0000850I 16 27 CMPNT L1M1 41 BM110 00860I 28 343TQTY 42 BM110 00870I 36 36 INVCD 43 BM110 00880I 37 410RRN BM110 00890IPARTMST NS 12 BM110 00900I 1 12 PN BM110 00910I 74 74 DLTPR BM110 0000920I********************************************************************BM110 00930I* BM110 00940I* BOMSTR ALL BM110 00950I* BM110 00960I* PRNT PARENT PART # BM110 00970I* CMPNT COMPONENT PART # BM110 00980I* QTY STRUCTURE QUANTITY BM110 0000990I* RRN1 REL REC # NEXT DOWN BM110 01000I* RRN2 REL REC # NEXT WHERE-USED BM110 01010I* RRN3 REL REC # COMPONENT IN BOMMST BM110 01020I* NXTCOD NEXT CODE [ 1 = END OF CHAIN ] BM110 01030I* ICODE INVENTORY CODE BM110 01040I* REC RECORD BM110 01050I* LPRNT LOOK-AHEAD PARENT PART # BM110 0001060I* BM110 01070I* STRCHNG 'PSA' ADD BM110 01080I* 'PSC' CHANGE BM110 01090I* 'PSD' DELETE BM110 01100I* 'PSM' MULTIPLE DELETE BM110 01110I* REST BM110 01120I* BM110 0001130I* TC TRANSACTION CODE [A, C, D, OR M] BM110 01140I* PRNT PARENT PART # BM110 01150I* CMPNT COMPONENT PART # BM110 01160I* TQTY TRANSACTION STRUCTURE QUANTITY BM110 01170I* INVCD INVENTORY CODE BM110 01180I* RRN REL REC # IN KPFILE BM110 01190I* BM110 0001200I* PARTMST ALL BM110 01210I* BM110 01220I* PN PART # BM110 01230I* DLTPR DELETE CODE BM110 01240I* BM110 01250I********************************************************************BM110 01260C* BM110 0001270C********************************************************************BM110 01280C* BM110 01290C* SETUP Z12 ONCE ONLY AT START OF PROGRAM. BM110 01300C* BM110 01310C********************************************************************BM110 01320C N99 MOVE 'ZZZZZZ' Z6 6 BM110 01330C N99 MOVE Z6 Z12 12 BM110 0001340C N99 MOVELZ6 Z12 BM110 01350C N99 SETON 99 BM110 01360C********************************************************************BM110 01370C* BM110 01380C* BOMSTR IS A RANDOM FILE AND THEREFORE, BM110 01390C* TO KEEP FROM WASTING TIME PROCESSING INACTIVE RECORDS, FOLLOWING BM110 01400C* THE ACTIVE RECORDS IN BOMSTR IS A RECORD WITH 12 Z'S IN ITS BM110 0001410C* PARENT PART #. WHEN THIS RECORD IS ENCOUNTERED, IT SIGNALS THE BM110 01420C* PROGRAM THAT IT IS THE LAST RECORD TO BE PROCESSED. BM110 01430C* BM110 01440C********************************************************************BM110 01450C 01 PRNT COMP Z12 98 BM110 01460C 98 SETON LR BM110 01470C********************************************************************BM110 0001480C* BM110 01490C* ONLY PRINT LINES IN THE EDIT LIST FOR STRCHNG RECORDS. BM110 01500C* SETOF STRCHNG_RECORD/PRINT INDICATOR. BM110 01510C* BM110 01520C********************************************************************BM110 01530C SETOF 10 BM110 01540C********************************************************************BM110 0001550C* BM110 01560C* IF THERE IS AN ERROR IN A STRCHNG RECORD, THEN THE RECORD BM110 01570C* HAS NO UPDATE EFFECT. IN THE EDIT LIST, AN APPROPRIATE ERROR BM110 01580C* MESSAGE IN PRINTED WITH THE RECORD. BM110 01590C* SETOF ERROR INDICATOR. BM110 01600C* BM110 01610C********************************************************************BM110 0001620C SETOF 33 BM110 01630C********************************************************************BM110 01640C* BM110 01650C* FOR STRCHNG RECORDS, BOTH THE CORRECTLY NON-BLANK PARENT PART BM110 01660C* #'S AND ANY NON-BLANK COMPONENT PART #'S ARE VALIDATED. TO BE BM110 01670C* VALID, A PART # SHOULD HAVE A RECORD IN PARTMST AND THE PART'S BM110 01680C* RECORD IN PARTMST SHOULD HAVE A BLANK DELETE CODE. IF A BM110 0001690C* STRCHNG RECORD HAS AN INVALID PART #, THEN THE RECORD HAS NO BM110 01700C* EFFECT ON BOMSTR/BOMSEQ. (IN THE EDIT LIST, THE MESSAGE BM110 01710C* 'INVALID PART #' IS PRINTED WITH THE STRCHNG RECORD.) BM110 01720C* SETOF STRCHNG_PART_#_NOT_ACTIVE ERROR INDICATOR. BM110 01730C* BM110 01740C********************************************************************BM110 01750C SETOF 25 BM110 0001760C********************************************************************BM110 01770C* BM110 01780C* WHEN A STRCHNG MULTIPLE DELETE RECORD CORRECTLY HAS A BLANK BM110 01790C* COMPONENT PART #, THE PROGRAM DETERMINES IF THE PARENT PART # BM110 01800C* OF THE MULTIPLE DELETE RECORD APPEARS AS A PARENT PART # IN BM110 01810C* BOMSTR. IF IT DOES, THEN ALL BOMSTR RECORDS WITH THE SAME BM110 01820C* PARENT PART # AS THAT OF THE MULTIPLE DELETE ARE DELETED FROM BM110 0001830C* BOMSTR/BOMSEQ. IF IT DOESN'T, THEN THE STRCHNG MULTIPLE DELETE BM110 01840C* RECORD HAS NO EFFECT ON BOMSTR/BOMSEQ. (IN THE EDIT LIST, THE BM110 01850C* MESSAGE 'PARENT NOT ON FILE' IS PRINTED WITH THE STRCHNG RECORD.)BM110 01860C* SETOF STRCHNG_MULTIPLE_DELETE_PARENT_PART_#_NOT_PARENT_IN_BOMSTR BM110 01870C* INDICATOR. BM110 01880C* BM110 01890C********************************************************************BM110 0001900C SETOF 26 BM110 01910C********************************************************************BM110 01920C* BM110 01930C* ANY PARENT_PART_#/COMPONENT_PART_# COMBINATION FOUND IN BOMSTR BM110 01940C* APPEARS ON A SINGLE BOMSTR RECORD ONLY. BM110 01950C* EVERY RECORD IN BOMSTR GOES OUT TO BOMSEQ UNLESS A STRCHNG BM110 01960C* RECORD CAUSES ITS DELETION. SPECIAL PRECAUTION ENSURES THAT BM110 0001970C* NO BOMSTR/BOMSEQ RECORD IS LOST BECAUSE OF ERRORS IN A STRCHNG BM110 01980C* RECORD WHICH IS ATTEMPTING TO UPDATE THE BOMSTR/BOMSEQ BM110 01990C* RECORD. BM110 02000C* IF GOT A BOMSTR RECORD AND HAVE A NEW COMPONENT PART # AND/OR BM110 02010C* A NEW PARENT PART #, THEN SETON ALREADY_HAVE_PARENT/COMPONENT_ BM110 02020C* COMBINATION_ON_BOMSTR INDICATOR. BM110 02030C* BM110 0002040C********************************************************************BM110 02050C 01 L1 SETON 34 BM110 02060C********************************************************************BM110 02070C* BM110 02080C* IF PROCESSING STRCHNG RECORD, SETON PRINT INDICATOR. BM110 02090C* BM110 02100C********************************************************************BM110 0002110C 03 ADD BM110 02120COR 05 CHG BM110 02130COR 07 DLT BM110 02140COR 09 MULT DLT BM110 02150COR 11 SETON 10 REST --> PRINT BM110 02160C********************************************************************BM110 02170C* BM110 0002180C* A STRCHNG MULT DLT DELETES ALL RECORDS IN BOMSTR WITH THE SAME BM110 02190C* PARENT PART # AS THAT OF THE MULT DLT. BM110 02200C* WHEN GET A RECORD WITH A NEW PARENT PART #, SETOF THE BM110 02210C* MULT_DLT_ACTIVATED_FOR_CURRENT_PARENT_PART_# INDICATOR. BM110 02220C* BM110 02230C********************************************************************BM110 02240C L2 SETOF 32 BM110 0002250C********************************************************************BM110 02260C* BM110 02270C* A STRCHNG DELETE DELETES THE BOMSTR RECORD WITH THE SAME BM110 02280C* PARENT/COMPONENT COMBINATION AS THAT OF THE DLT. BM110 02290C* WHEN GET A RECORD WITH A NEW COMPONENT PART # AND/OR A NEW BM110 02300C* PARENT PART #, SETOF THE DLT_CURRENT_RECORD INDICATOR. BM110 02310C* BM110 0002320C********************************************************************BM110 02330C L1 SETOF 31 BM110 02340C********************************************************************BM110 02350C* BM110 02360C* IT IS AN ERROR FOR A STRCHNG RECORD TO ATTEMPT TO ADD A RECORD BM110 02370C* TO BOMSTR/BOMSEQ WITH A PARENT/COMPONENT COMBINATION FOR WHICH BM110 02380C* A RECORD IS ALREADY IN BOMSTR. IT IS ALSO AN ERROR FOR MORE BM110 0002390C* THAN ONE STRCHNG ADD TO ATTEMPT TO ADD A RECORD TO BOMSTR/BOMSEQ BM110 02400C* FOR A GIVEN PARENT/COMPONENT COMBINATION. IN EITHER CASE, THE BM110 02410C* OFFENDING RECORD DOES NOT AFFECT BOMSTR/BOMSEQ. IF THE RECORD BM110 02420C* IS ALREADY ON BOMSTR, THEN ALL OF THE STRCHNG ADDS ARE REJECTED. BM110 02430C* IF THE RECORD IS NOT ALREADY ON BOMSTR, THEN THE FIRST STRCHNG BM110 02440C* ADD UPDATES BOMSTR/BOMSEQ AND THE OTHERS ARE REJECTED. IN THE BM110 02450C* FORMER CASE, THE MESSAGE 'ALREADY ON FILE' APPEARS IN THE EDIT BM110 0002460C* LIST BESIDE THE REJECTED STRCHNG ADDS. IN THE LATTER CASE, THE BM110 02470C* MESSAGE 'DUPLICATE TRANSACTION' APPEARS WITH THE REJECTED ADDS. BM110 02480C* IF NEW COMPONENT PART # AND/OR NEW PARENT PART #, THEN SETOF THE BM110 02490C* DUPLICATE_TRANSACTION_OF_SOME_SORT ERROR INDICATOR. BM110 02500C* BM110 02510C********************************************************************BM110 02520C L1 SETOF 50 BM110 0002530C********************************************************************BM110 02540C* BM110 02550C* IF MULTIPLE_DELETE INDICATOR IS ACTIVE FOR THIS PARENT PART #, BM110 02560C* THEN SETON THE DELETE_THIS_RECORD INDICATOR. BM110 02570C* BM110 02580C********************************************************************BM110 02590C 32 SETON 31 BM110 0002600C********************************************************************BM110 02610C* BM110 02620C* IF HAVE BOMSTR RECORD, NO NEED TO EDIT. - OR - BM110 02630C* IF STILL DEALING WITH ACTIVE MULTIPLE DELETE AND SO RECORD ARE BM110 02640C* PROCESSING IS TO BE DELETED, NO NEED TO EDIT. BM110 02650C* BM110 02660C********************************************************************BM110 0002670C 01 BM110 02680COR 31 GOTO DEND BM110 02690C********************************************************************BM110 02700C* BM110 02710C* IF DO NOT HAVE NEW COMPONENT AND/OR NEW PARENT AND STRCHNG BM110 02720C* RECORD IS ATTEMPTING ADD, SETON THE DUPLICATE_TRANSACTION_OF_ BM110 02730C* SOME_SORT INDICATOR. BM110 0002740C* BM110 02750C********************************************************************BM110 02760C NL1 03 SETON 50 BM110 02770C********************************************************************BM110 02780C* BM110 02790C* PART # VALIDATION (FOR NON-BLANK PART #'S) FOR ADDS. BM110 02800C* IF AN INVALID PART # IS FOUND, THEN THE INVALID_PART_# BM110 0002810C* INDICATOR IS SETON. BM110 02820C* BM110 02830C********************************************************************BM110 02840C N40 03 PRNT CHAINPARTMST 25 BM110 02850C N40 03N25DLTPR COMP ' ' 2525 BM110 02860C N41 03N25CMPNT CHAINPARTMST 25 BM110 02870C N41 03N25DLTPR COMP ' ' 2525 BM110 0002880C********************************************************************BM110 02890C* BM110 02900C* IF HAVE STRCHNG MULT DLT WITH CORRECTLY BLANK COMPONENT PART #, BM110 02910C* THEN CHECK IF MULT DLT PARENT IS PARENT IN BOMSTR. BM110 02920C* IF NOT, THEN SETON THE STRCHNG_MULTIPLE_DELETE_PARENT_PART_#_ BM110 02930C* NOT_PARENT_IN_BOMSTR INDICATOR. BM110 02940C* BM110 0002950C********************************************************************BM110 02960C 09 41 PRNT COMP LPRNT 2626 BM110 02970C********************************************************************BM110 02980C* BM110 02990C* IF ANY ERRORS ARE FOUND DURING THE EDITING PROCESS, THEN BM110 03000C* SETON THE ERROR INDICATOR, INCREMENT THE NUMBER OF ERRORS, AND BM110 03010C* SKIP THE UPDATING OF BOMSTR. BM110 0003020C* BM110 03030C* INDICATORS PRINTED MESSAGE CONDITIONS BM110 03040C* ---------- ----------------------- ------------------------------ BM110 03050C* BM110 03060C* 03 42 NO QUANTITY ADD / QTY=0 BM110 03070C* BM110 03080C* 40 NO PARENT PART # PARENT BLANK BM110 0003090C* BM110 03100C* N09N11 41 NO COMPONENT PART # NOT MULT DLT / NOT INVALID BM110 03110C* TRANSACTION / COMPONENT BLANK BM110 03120C* BM110 03130C* 05 42 43 NO QUANTITY OR I/N CODE CHANGE / QTY=0 / INVENTORY BM110 03140C* CODE BLANK BM110 03150C* BM110 0003160C* 07NMR PRNT-CMPNT NOT ON FILE DLT / NO SUCH RECORD IN BOMSTR BM110 03170C* BM110 03180C* 05NMR PRNT-CMPNT NOT ON FILE CHG / NO SUCH RECORD IN BOMSTR BM110 03190C* BM110 03200C* 50 DUPLICATE TRANSACTION ADD / TRYING TO ADD SAME BM110 03210C* RECORD MORE THAN ONCE -OR- BM110 03220C* TRYING TO ADD RECORD ALREADY BM110 0003230C* ON BOMSTR BM110 03240C* BM110 03250C* 11 INVALID TRANSACTION NOT ADD, CHG, DLT, OR MULT DLT BM110 03260C* BM110 03270C* 03 MR ALREADY ON FILE ADD / ALREADY ON BOMSTR BM110 03280C* (REPLACES 'DUPLICATE TRANS') BM110 03290C* BM110 0003300C* 25 INVALID PART # ADD / NON-BLANK PART # NOT IN BM110 03310C* PARTMST OR HAS NON-BLANK BM110 03320C* DELETE CODE IN ITS PARTMST REC BM110 03330C* BM110 03340C* 09 41 26 PARENT NOT ON FILE MULT DLT / COMPONENT BLANK / BM110 03350C* PARENT NOT A PARENT IN BOMSTR BM110 03360C* BM110 0003370C* 09N41 INVALID MULT DLT MULT DLT / COMPONENT NOT BLANK BM110 03380C* BM110 03390C********************************************************************BM110 03400C 03 42 BM110 03410COR 40 BM110 03420CORN09N11 41 BM110 03430COR 05 42 43 BM110 0003440COR 07NMR BM110 03450COR 05NMR BM110 03460COR 50 BM110 03470COR 11 NERRS ADD 1 NERRS 40 33 ERROR --> BM110 03480C 33 GOTO DEND NO UPDATE BM110 03490C 03 MR BM110 03500COR 25 BM110 0003510COR 09 41 26 BM110 03520COR 09N41 NERRS ADD 1 NERRS 33 ERROR --> BM110 03530C 33 GOTO DEND NO UPDATE BM110 03540C********************************************************************BM110 03550C* BM110 03560C* IF RECORDS ARE GOOD, THEN INCREMENT COUNTS AND ALLOW RECORDS BM110 03570C* TO UPDATE BOMSTR/BOMSEQ. BM110 0003580C* BM110 03590C********************************************************************BM110 03600C 03 NADDS ADD 1 NADDS 40 BM110 03610C 05 NCHGS ADD 1 NCHGS 40 BM110 03620C 07 NDLTS ADD 1 NDLTS 40 31 DLT ACTIVE BM110 03630C 09 NMDLTS ADD 1 NMDLTS 40 32 MULT DLT ACTIVEBM110 03640C* BM110 0003650C 09 SETON 31 MULT DLT --> BM110 03660C* DLT ACTIVE BM110 03670C 03 BM110 03680COR 05 EXSR CHNGE UPDATE BM110 03690C* BM110 03700C DEND TAG BM110 03710C********************************************************************BM110 0003720C* BM110 03730C* A GOOD STRCHNG ADD SHOULD GO OUT TO BOMSTR/BOMSEQ EVEN THOUGH BM110 03740C* FOLLOWING DUPLICATE TRANSACTIONS SHOULD NOT. ONLY ADDS WITHOUT BM110 03750C* ERROR ARE TO GO OUT TO BOMSTR/BOMSEQ. BM110 03760C* IF ADD WITHOUT ERROR FOUND, THEN SETON THE OUTPUT_ADD_TO_FILE BM110 03770C* INDICATOR. BM110 03780C* BM110 0003790C********************************************************************BM110 03800C 03N33 SETON 36 BM110 03810C********************************************************************BM110 03820C* BM110 03830C* A BOMSTR RECORD SHOULD REMAIN ON FILE UNLESS SPECIFICALLY BM110 03840C* DELETED. IF A RECORD ALREADY EXISTS ON BOMSTR AND THE STRCHNG BM110 03850C* RECORD ATTEMPTING TO UPDATE BOMSTR HAS AN ERROR, THEN IT IS BM110 0003860C* NECESSARY TO SETOF THE ERROR INDICATOR TO PRESERVE THE BM110 03870C* ORIGINAL BOMSTR RECORD. IT IS ALREADY TOO LATE FOR THE BM110 03880C* BAD STRCHNG RECORD TO AFFECT BOMSTR. BM110 03890C* BM110 03900C********************************************************************BM110 03910C 33 34 SETOF 33 BM110 03920C********************************************************************BM110 0003930C* BM110 03940C* NEW COMPONENT AND/OR NEW PARENT, SETOF BOMSTR_RECORD INDICATOR. BM110 03950C* BM110 03960C********************************************************************BM110 03970CL1 SETOF 34 BM110 03980C********************************************************************BM110 03990C* BM110 0004000C* NEW COMPONENT AND/OR NEW PARENT AND HAVE GOOD STRCHNG ADD READY BM110 04010C* TO GO OUT TO BOMSTR/BOMSEQ, THEN SETOF ERROR INDICATOR SO THAT, BM110 04020C* IF DELETE IS NOT ACTIVE, GOOD RECORD WILL UPDATE BOMSTR/BOMSEQ. BM110 04030C* BM110 04040C********************************************************************BM110 04050CL1 36 SETOF 33 BM110 04060C********************************************************************BM110 0004070C* BM110 04080C* RESET GOOD_ADD INDICATOR WHEN GET NEW COMPONENT AND/OR NEW BM110 04090C* PARENT. BM110 04100C* BM110 04110C********************************************************************BM110 04120CL1 SETOF 36 BM110 04130C********************************************************************BM110 0004140C* BM110 04150C* WHEN PUT RECORD OUT TO BOMSEQ, INCREMENT RECORD COUNT. BM110 04160C* BM110 04170C********************************************************************BM110 04180CL1N31N33 NRECS ADD 1 NRECS 50 BM110 04190C********************************************************************BM110 04200C* BM110 0004210C********************************************************************BM110 04220C* BM110 04230C* UPDATING OF BOMSTR/BOMSEQ BY GOOD STRCHNG ADDS AND CHANGES. BM110 04240C* BM110 04250C********************************************************************BM110 04260C* BM110 04270CSR CHNGE BEGSR BM110 0004280C********************************************************************BM110 04290C* BM110 04300C* TRANSACTION STRUCTURE QUANTITY NOT 0, THEN UPDATE STRUCTURE BM110 04310C* QUANTITY. BM110 04320C* BM110 04330C********************************************************************BM110 04340CSRN42 MOVE TQTY QTY BM110 0004350C********************************************************************BM110 04360C* BM110 04370C* TRANSACTION INVENTORY CODE NOT BLANK, THEN UPDATE INVENTORY BM110 04380C* CODE WITH ' ' IF ITS 'I' OR WITH 'N' IF ITS NOT BLANK OR 'I'. BM110 04390C* BM110 04400C********************************************************************BM110 04410CSRN43 INVCD COMP 'I' 80 BM110 0004420CSRN43 80 MOVE ' ' ICODE BM110 04430CSRN43N80 MOVE 'N' ICODE BM110 04440C********************************************************************BM110 04450C* BM110 04460C* IF DEALING WITH AN ADD, THEN 0 REL REC #'S. BM110 04470C* BM110 04480C********************************************************************BM110 0004490CSR 03 Z-ADD0 RRN1 BM110 04500CSR 03 Z-ADD0 RRN2 BM110 04510CSR 03 Z-ADD0 RRN3 BM110 04520C********************************************************************BM110 04530C* BM110 04540CSR ENDSR BM110 04550C* BM110 0004560C********************************************************************BM110 04570C* BM110 04580OBOMSEQ T L1N31N33 BM110 04590O REC 54 BM110 04600O PRNT 12 BM110 04610O CMPNT 24 BM110 04620O QTY 31 BM110 0004630O NRECS 36 BM110 04640O RRN1 41 BM110 04650O RRN2 46 BM110 04660O RRN3 51 BM110 04670O ICODE B 54 BM110 04680O 52 ' ' BM110 04690O$LP1 H 202 1P BM110 0004700O OR OF BM110 04710O PAGE Z 7 BM110 04720O 4 'PAGE' BM110 04730O HEAD,1 85 BM110 04740O UDATE Y 132 BM110 04750O H 2 1P BM110 04760O OR OF BM110 0004770O 72 'PRODUCT STRUCTURE FILE' BM110 04780O 80 'UPDATES' BM110 04790O 132 'MFG110' BM110 04800O H 2 1P BM110 04810O OR OF BM110 04820O 4 'RRN' BM110 04830O 13 'PARENT' BM110 0004840O 30 'COMPONENT' BM110 04850O 44 'QUANTITY' BM110 04860O 50 'I/N' BM110 04870O 59 'ACTION' BM110 04880O 76 'ERRORS/REMARKS' BM110 04890O D 1 10 BM110 04900O RRN 3 5 BM110 0004910O PRNT 19 BM110 04920O CMPNT 33 BM110 04930O TQTY K 45 BM110 04940O INVCD 49 BM110 04950O 03 58 'ADD' BM110 04960O 05 58 'CHG' BM110 04970O 07 58 'DEL' BM110 0004980O 09 58 'MDEL' BM110 04990O 03 42 86 'NO QUANTITY ' BM110 05000O 40 86 'NO PARENT PART # ' BM110 05010O N09N11 41 86 'NO COMPONENT PART # ' BM110 05020O 05 42 43 86 'NO QUANTITY OR I/N CODE ' BM110 05030O 07NMR 86 'PRNT-CMPNT NOT ON FILE ' BM110 05040O 05NMR 86 'PRNT-CMPNT NOT ON FILE ' BM110 0005050O 50 86 'DUPLICATE TRANSACTION ' BM110 05060O 11 86 'INVALID TRANSACTION ' BM110 05070O 03 MR 86 'ALREADY ON FILE ' BM110 05080O 25 86 'INVALID PART # ' BM110 05090O 09 41 26 86 'PARENT NOT ON FILE ' BM110 05100O 09N41 86 'INVALID MULT DEL ' BM110 05110O T 31 LR BM110 0005120O 23 'END OF JOB. THERE WERE' BM110 05130O NADDS 3 28 BM110 05140O 34 'ADDS,' BM110 05150O NCHGS 3 39 BM110 05160O 48 'CHANGES,' BM110 05170O NDLTS 3 53 BM110 05180O 62 'DELETES,' BM110 0005190O NMDLTS3 67 BM110 05200O 85 'MULT DELETES, AND ' BM110 05210O NERRS 3 90 BM110 05220O 98 'ERRORS.' BM110 05230O NRECS 3 105 BM110 05240O 124 'RECORDS NOW EXIST.' BM110 ** 00525000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005290/* 005300__0O 124 'RECORDS NOW EXIST.' BM110 ** 0052500(1 TOTXBM115 P999999041178(000010H S BM115 00020X DECK-ID M15 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM115 00030F* USING BOMSEQ AND BOMWOUT, CREATE BOMMST BM115 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM115 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM115 00060F* CONTROL DATA PROPRIETARY PRODUCT BM115 00070F* BM115 0000080FBOMSEQ IPEAF 54 DISK BM115 00090FBOMWOUT USEAF 54 DISK BM115 00100FBOMMST O F 28 12AI 1 DISK BM115 00110F********************************************************************BM115 00120F* BM115 00130F* PACKAGE MANUFACTURING BM115 00140F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM115 0000150F* PROGRAM UPDATE PRODUCT STRUCTURE FILE (BOMWOUT) BM115 00160F* AND CREATE BOMMST BM115 00170F* BM115 00180F* CONTRACTOR COMPUSOURCE BM115 00190F* PROGRAMMER TOM LEE BM115 00200F* DATE SEPTEMBER 26, 1976 BM115 00210F* BM115 0000220F********************************************************************BM115 00230F* BM115 00240F* NARRATIVE: BM115 00250F* BM115 00260F* TWO VERSIONS OF THE PRODUCT STRUCTURE FILE, BOMSEQ IN BM115 00270F* PARENT/COMPONENT ORDER AND BOMWOUT IN COMPONENT/PARENT ORDER, BM115 00280F* ARE USED TO CREATE BOMMST. ALSO, BOMWOUT IS UPDATED AS A STEP BM115 0000290F* TOWARD THE NEW BOMSTR. BM115 00300F* BM115 00310F********************************************************************BM115 00320F* BM115 00330F* ID F C H L FUNCTION OF INDICATORS BM115 00340F* BM115 00350F* 01 BOMSEQ (PARENT/COMPONENT ORDER) BM115 0000360F* 02 BOMWOUT (COMPONENT/PARENT ORDER) BM115 00370F* 25 1ST_WHERE-USED_REL_REC_# FOR COMPONENT IN BOMMST BM115 00380F* L1BOMSEQ/PARENT -AND- BOMWOUT/COMPONENT BM115 00390F* M1BOMSEQ/PARENT -AND- BOMWOUT/COMPONENT BM115 00400F* BM115 00410F********************************************************************BM115 00420IBOMSEQ NS 01 BM115 0000430I 1 12 PN L1M1 BM115 00440IBOMWOUT NS 02 BM115 00450I 13 24 PN L1M1 BM115 00460I 32 360RRN BM115 00470I********************************************************************BM115 00480I* BM115 00490I* BOMSEQ ALL BM115 0000500I* BM115 00510I* PN PARENT PART # BM115 00520I* BM115 00530I* BM115 00540I* BOMWOUT ALL BM115 00550I* BM115 00560I* PN COMPONENT PART # BM115 0000570I* RRN REL REC # THIS RECORD BM115 00580I* REL REC # NEXT DOWN BM115 00590I* REL REC # COMPONENT IN BOMMST BM115 00600I* BM115 00610I* BOMMST ALL BM115 00620I* BM115 00630I* PART BM115 0000640I* 1ST STRUCTURE REL REC # BM115 00650I* 1ST WHERE-USED REL REC # BM115 00660I* REL REC # IN BOMMST BM115 00670I* BM115 00680I********************************************************************BM115 00690C* BM115 00700C* NEW PART #, SO SETOF BOMMST_1ST_WHERE-USED_REL_REC_# INDICATOR. BM115 0000710C* BM115 00720C********************************************************************BM115 00730C L1 SETOF 25 BM115 00740C********************************************************************BM115 00750C* BM115 00760C* NEW PART #, SO INCREMENT BOMMST_REL_REC_# BM115 00770C* (ALSO BOMSTR/BOMWOUT REL_REC_#_COMPONENT_IN_BOMMST). BM115 0000780C* BM115 00790C********************************************************************BM115 00800C L1 BRRN ADD 1 BRRN 50 BM115 00810C********************************************************************BM115 00820C* BM115 00830C* PART IS A PARENT, SO INCREMENT #_OF_STRUCTURES BM115 00840C* (BOMSEQ PARENT/COMPONENT REL REC #). BM115 0000850C* BM115 00860C********************************************************************BM115 00870C 01 NSTR ADD 1 NSTR 50 BM115 00880C********************************************************************BM115 00890C* BM115 00900C* NEW PARENT PART #, SO HAVE 1ST_STRUCTURE_REL_REC_# FOR COMPONENT BM115 00910C* IN BOMMST (ALSO REL_REC_#_NEXT_DOWN FOR COMPONENT IN BM115 0000920C* BOMSTR/BOMWOUT). BM115 00930C* BM115 00940C********************************************************************BM115 00950C 01 L1 Z-ADDNSTR STRN 50 BM115 00960C********************************************************************BM115 00970C* BM115 00980C* NEW PART # NOT A COMPONENT, SO 0 1ST_WHERE-USED_REL_REC_# FOR BM115 0000990C* COMPONENT IN BOMMST. BM115 01000C* BM115 01010C********************************************************************BM115 01020C 01 L1NMR Z-ADD0 WUN 50 BM115 01030C********************************************************************BM115 01040C* BM115 01050C* PART IS A COMPONENT AND THIS IS THE THE FIRST PARENT OF WHICH BM115 0001060C* IT IS A COMPONENT, SO PUT BOMSTR/BOMSEQ REL_REC_#_THIS_RECORD BM115 01070C* INTO THE 1ST_WHERE-USED_REL_REC_# FOR COMPONENT IN BOMMST. BM115 01080C* BM115 01090C********************************************************************BM115 01100C 02N25 Z-ADDRRN WUN 25 BM115 01110C********************************************************************BM115 01120C* BM115 0001130C* NEW PART NOT A PARENT, SO 0 1ST_STRUCTURE_REL_REC_# FOR BM115 01140C* COMPONENT IN BOMMST (ALSO 0 REL_REC_#_NEXT_DOWN FOR COMPONENT BM115 01150C* IN BOMSTR/BOMWOUT). BM115 01160C* BM115 01170C********************************************************************BM115 01180C 02 L1NMR Z-ADD0 STRN BM115 01190C********************************************************************BM115 0001200OBOMWOUT D 02 BM115 01210O STRN 41 BM115 01220O BRRN 51 BM115 01230OBOMMST T L1 BM115 01240O PN 12 BM115 01250O STRN 17 BM115 01260O WUN 22 BM115 0001270O BRRN 27 BM115 ** 001280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001320/* 00133000__0O BRRN 27 BM115 ** 001280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001320/* 0013300(,%: }OTXBM116 P999999041178(000010H S BM116 00020X DECK-ID M16 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM116 00030F* USING BOMWOUT,CREATE BOMSTR BM116 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM116 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM116 00060F* CONTROL DATA PROPRIETARY PRODUCT BM116 00070F* BM116 0000080FBOMWOUT IPEAF 54 DISK BM116 00090FBOMSTR OC F 54R DISK BM116 00100F********************************************************************BM116 00110F* BM116 00120F* PACKAGE MANUFACTURING BM116 00130F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM116 00140F* PROGRAM USE BOMWOUT TO CREATE BOMSTR (NEW PRODUCT STRUCTURE) BM116 0000150F* BM116 00160F* CONTRACTOR COMPUSOURCE BM116 00170F* PROGRAMMER TOM LEE BM116 00180F* DATE SEPTEMBER 27, 1976 BM116 00190F* BM116 00200F********************************************************************BM116 00210F* BM116 0000220F* NARRATIVE: BM116 00230F* BM116 00240F* PUTS BOMSTR FILE BACK IN ORDER BY OUTPUTTING EACH RECORD OF BM116 00250F* BOMWOUT TO THE POSITION IN BOMSTR DESIGNATED BY BM116 00260F* REL_REC_#_THIS_RECORD FIELD OF THE BOMWOUT RECORD. BM116 00270F* BM116 00280F* IT ALSO INSERTS THE REL_REC_#_NEXT_WHERE-USED POINTERS BY BM116 0000290F* LOOKING-AHEAD TO THE NEXT BOMWOUT RECORD (SINCE BOMWOUT IS IN BM116 00300F* WHERE-USED ORDER). BM116 00310F* BM116 00320F* THE CALCS ARE HANDLED IN THE COMPLICATED ARRAY MANNER TO SAVE BM116 00330F* PROCESSING TIME (BY CUTTING DOWN ON ARM MOVEMENT). BM116 00340F* BM116 00350F********************************************************************BM116 0000360F* BM116 00370F* ID F C H L FUNCTION OF INDICATORS BM116 00380F* BM116 00390F* 01 BOMWOUT BM116 00400F* BM116 00410F* 20 FOR STUFFING ARRAYS --> FULL = 20 BM116 00420F* FOR PROCESSING FULL ARRAYS --> DONE = N20 BM116 0000430F* 60 LOOK-AHEAD COMPONENT IS SAME BM116 00440F* 80 OUTPUT BM116 00450F* 99 SETUP MAXREC ONCE BM116 00460F* BM116 00470F* LRDONE WITH INPUT --> PROCESS ARRAYS LAST TIME BM116 00480F* BM116 00490F* H1GOT BOMWOUT RECORD WITH REL_REC_#_THIS_RECORD BM116 0000500F* NOT IN BOMSTR --> FILE OVERFLOW VS. BUG SOMEWHERE BM116 00510F* BM116 00520F********************************************************************BM116 00530E* BM116 00540E* THE ARRAYS HAVE 21 ELEMENTS. BM116 00550E* DURING NORMAL PROCESSING, EACH OF THE FIRST 20 ELEMENTS IS BM116 00560E* UPDATED ACCORDING TO THE CONTENTS OF THE NEXT ELEMENT. SO THE BM116 0000570E* 21ST ELEMENT IS USED AS A FORM OF LOOK-AHEAD. AFTER THE BM116 00580E* UPDATING AND OUTPUT OF THE FIRST 20 ELEMENTS, THE CONTENTS OF BM116 00590E* THE 21ST ELEMTNT IS MOVED INTO THE 1ST ELEMENT. BM116 00600E* AT LR TIME, ONLY THE ELEMENTS WITH DATA WILL BE UPDATED AND BM116 00610E* OUTPUT (MAXIMUM OF 20). BM116 00620E* BM116 00630E REC 21 54 RECORDS BM116 0000640E PN 21 12 COMPONENT BM116 00650E* PART #'S BM116 00660E RN 21 5 0 REL_REC_#_THIS_ BM116 00670E* RECORD BM116 00680IBOMWOUT NS 01 BM116 00690I 1 54 RECORD BM116 00700I 13 24 COMPNT BM116 0000710I 32 360RRN BM116 00720I********************************************************************BM116 00730I* BM116 00740I* BOMWOUT ALL BM116 00750I* BM116 00760I* COMPNT COMPONENT PART # BM116 00770I* RRN REL REC # THIS RECORD IN BOMSTR BM116 0000780I* RECORD WHOLE RECORD BM116 00790I* BM116 00800I* BOMSTR ALL BM116 00810I* BM116 00820I* REL REC # NEXT WHERE-USED BM116 00830I* WHOLE RECORD BM116 00840I* BM116 0000850I********************************************************************BM116 00860C* BM116 00870C* SETUP THE MAXIMUM # OF RECORDS (ARRAY ELEMENTS) TO BE PROCESSED BM116 00880C* AT ONE TIME. BM116 00890C* BM116 00900C 99 GOTO START BM116 00910C Z-ADD20 MAXREC 20 BM116 0000920C SETON 99 BM116 00930C* BM116 00940C START TAG BM116 00950C* BM116 00960C********************************************************************BM116 00970C* BM116 00980C* THE FOLLOWING CALCS IS RESPONSIBLE FOR STUFFING BOMWOUT BM116 0000990C* RECORDS AND DATA INTO THE ARRAYS. BM116 01000C* BM116 01010C********************************************************************BM116 01020C* BM116 01030C N01 GOTO DEND IMPOSSIBLE BM116 01040C* BM116 01050C* INCREMENT #_OF_RECORDS (INDEX OF ELEMENT OF ARRAY TO STUFF). BM116 0001060C* BM116 01070C NR ADD 1 NR 20 BM116 01080C* BM116 01090C* STORE DATA INTO PROPER ARRAY ELEMENTS. BM116 01100C* BM116 01110C MOVE RECORD REC,NR BM116 01120C MOVE COMPNT PN,NR BM116 0001130C MOVE RRN RN,NR BM116 01140C* BM116 01150C* #_OF_ELEMENTS_OF_ARRAY_WHICH_ARE_STUFFED COMPARE TO BM116 01160C* MAXIMUM_#_OF_ELEMENTS_OF_ARRAY_TO_BE_PROCESSED = BM116 01170C* HAVE YOU STUFFED ALL 21 ELEMENTS OF ARRAY? BM116 01180C* BM116 01190C NR COMP MAXREC 20 YES --> 20 BM116 0001200C* NO --> N20 BM116 01210C* IF ARRAY IS FULL, THEN PROCEED TO PROCESSING BM116 01220C* (UPDATE AND OUTPUT 1ST 20 ELEMENTS). BM116 01230C* BM116 01240C 20 EXSR RANOUT BM116 01250C* BM116 01260C DEND TAG BM116 0001270C********************************************************************BM116 01280C* BM116 01290C* ARE STUFFING ARRAYS WITH BOMWOUT DATA AND HIT LR. HAVE BM116 01300C* STUFFED X ELEMENTS OF ARRAYS AND NEED TO PROCESS ALL X ELEMENTS. BM116 01310C* WHEN MAXREC WAS 20, STUFFED 21 ELEMENTS. NOW MAXREC IS X, SO BM116 01320C* SAY THAT X+1=NR IS #_OF_ELEMENTS STUFFED. SO INCREMENT BM116 01330C* #_OF_RECORDS. NOW FOR THE LOOK-AHEAD PROBLEM OF THE LAST LIVE BM116 0001340C* RECORD. THE LAST RECORD DEFINITELY SHOULD HAVE 0 IN THE BM116 01350C* REL_REC_#_OF_NEXT_WHERE-USED, SO PUT 0 IN THE REL_REC_#_THIS_ BM116 01360C* RECORD FIELD OF THE MAXREC+1 ELEMENT OF ARRAY. WHEN THE MAXREC BM116 01370C* ELEMENT (LAST LIVE RECORD) IS PROCESSED, IT WILL GET THE 0 BM116 01380C* WHERE-USED. BM116 01390C* BM116 01400C********************************************************************BM116 0001410C* BM116 01420CLR NR ADD 1 NR BM116 01430CLR Z-ADD0 RN,NR BM116 01440CLR EXSR RANOUT BM116 01450CLR Z-ADD0 ZERO 50 SETUP FIELD BM116 01460C* BM116 01470C********************************************************************BM116 0001480C* BM116 01490C* PROCESSES ARRAYS. BM116 01500C* ELEMENTS STUFFED AND TO BE USED = MAXREC+1 = NR. BM116 01510C* ELEMENTS UPDATED AND OUTPUT TO BOMSTR = MAXREC = NR-1. BM116 01520C* LAST STUFFED ELEMENT HAS CONTENTS PLACED IN 1ST ELEMENT OF ARRAY.BM116 01530C* BM116 01540C********************************************************************BM116 0001550C* BM116 01560CSR RANOUT BEGSR BM116 01570C* BM116 01580C* START AT FRONT OF ARRAYS. BM116 01590C* BM116 01600CSR Z-ADD1 M 20 BM116 01610C* BM116 0001620C* THE MTH ELEMENTS ARE BEING UPDATED AND OUTPUT. THE NTH BM116 01630C* ELEMENTS ARE ACTING AS LOOK-AHEADS. IF A GIVEN SET OF M AND N BM116 01640C* COMPONENT #'S ARE THE SAME, THEN THE 2 RECORDS ARE SIBLINGS BM116 01650C* WITH 2 PARENTS OF THE SAME COMPONENT. THE REL_REC_#_THIS_RECORD BM116 01660C* OF THE NTH IS PLACED IN THE REL_REC_#_NEXT_WHERE-USED OF THE BM116 01670C* MTH. ELSE, 0 IS PLACED IN THE REL_RE_#_NEXT_WHERE-USED OF THE BM116 01680C* MTH. BM116 0001690C* BM116 01700CSR RLOOP TAG BM116 01710C* BM116 01720CSR M ADD 1 N 20 BM116 01730CSR PN,M COMP PN,N 60SAME --> 60 BM116 01740C* NO --> N60 BM116 01750CSR EXSR EXCEPT BM116 0001760C* BM116 01770CSR MOVE N M NEXT BM116 01780CSR M COMP NR 20 ALL? YES-->N20 BM116 01790CSR 20 GOTO RLOOP BM116 01800C* BM116 01810CSR Z-ADD1 NR RESETUP ARRAYS BM116 01820CSR MOVE REC,M RECT 54 BM116 0001830CSR MOVE PN,M PNT 12 BM116 01840CSR Z-ADDRN,M RNT 50 BM116 01850CSR MOVE RECT REC,1 BM116 01860CSR MOVE PNT PN,1 BM116 01870CSR Z-ADDRNT RN,1 BM116 01880C* BM116 01890CSR ENDSR BM116 0001900C********************************************************************BM116 01910C* BM116 01920C* ACTUAL UPDATE OF MTH ELEMENT. BM116 01930C* BM116 01940C********************************************************************BM116 01950C* BM116 01960CSR EXCEPT BEGSR BM116 0001970C* BM116 01980CSR Z-ADDRN,M RRN CHAIN TO RIGHT BM116 01990CSR RRN CHAINBOMSTR H1 POSITION BM116 02000CSR H1 GOTO ENDEX IMPOSSIBLE BM116 02010C* BM116 02020CSR SETON 80 BM116 02030CSR EXCPT OUTPUT BM116 0002040CSR SETOF 80 BM116 02050C* BM116 02060CSR ENDEX ENDSR BM116 02070C********************************************************************BM116 02080C* BM116 02090OBOMSTR E 80 BM116 02100O REC,M 54 BM116 0002110O 60 RN,N 46 BM116 02120O N60 ZERO 46 BM116 ** 002130ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002140ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002150ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002160ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00217000/* 002180__0O N60 ZERO 46 BM116 ** 002130ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002140ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002150ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002160ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0021700(% OTXBM120 P999999041178(000010H S BM120 00020X DECK-ID M19 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM120 00030F* USING BOMSTR, BOMMST AND BOMINP, CREATE BOMWRK BM120 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM120 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM120 00060F* CONTROL DATA PROPRIETARY PRODUCT BM120 00070F* BM120 0000080FBOMINP IPEAF 54 DISK BM120 00090FBOMMST IC F 28R12AI 1 DISK BM120 00100FBOMSTR IC F 54R DISK BM120 00110FBOMWRK O F 36 DISK BM120 00120F********************************************************************BM120 00130F* BM120 00140F*THERE ARE FOUR MAJOR SECTIONS IN THE CALC BM120 0000150F*MESR FOR ALL MULTI LEVEL EXPLOSIONS BM120 00160F*SESR FOR ALL SINGLE LEVEL EXPLOSIONS BM120 00170F*MWSR FOR ALL MULTI LEVEL WHERE USED BM120 00180F*SWSR FOR ALL SINGLE LEVEL WHERE USED BM120 00190F* BM120 00200F********************************************************************BM120 00210E AR 26 5 0 BM120 0000220E AQ 26 7 3 BM120 00230E AP 26 12 BM120 00240IBOMINP NS 01 1 CP 2 CS 3 C BM120 00250I 4 15 ASY BM120 00260I 4 15 PN BM120 00270I 28 343MQTY BM120 00280I 35 350TYPE BM120 0000290I NS 02 BM120 00300I 1 54 REC BM120 00310IBOMSTR NS 04 BM120 00320I 1 12 STRPRN BM120 00330I 13 24 STRCMP BM120 00340I 25 313STRQTY BM120 00350I 52 52 NXTCOD 06 BM120 0000360I 32 360RRN BM120 00370I 37 410NXTDWN 0809 BM120 00380I 54 54 INVCOD BM120 00390I 42 460NXTWU 07 BM120 00400IBOMMST NS 05 BM120 00410I 13 170STRPN BM120 00420I 18 220WUPN 07 BM120 0000430C********************************************************************BM120 00440C* BM120 00450C*THE FOLLOWING SR ESTABLISHES THE REPORTS TO BE GENERATED BM120 00460C* BM120 00470C********************************************************************BM120 00480C TYPE COMP 1 70 BM120 00490C TYPE COMP 2 71 BM120 0000500C TYPE COMP 3 72 BM120 00510C TYPE COMP 4 73 BM120 00520C TYPE COMP 5 74 BM120 00530C 74 SETON 70 BM120 00540C 70 EXSR MESR BM120 00550C 70 SETOF 7074 BM120 00560C 71 EXSR SESR BM120 0000570C 71 SETOF 71 BM120 00580C 72 EXSR MWSR BM120 00590C 72 SETOF 72 BM120 00600C 73 EXSR SWSR BM120 00610C 73 SETOF 73 BM120 00620C********************************************************************BM120 00630CSR MESR BEGSR BM120 0000640CSR MOVE ASY PART 12 BM120 00650CSR MOVE ASY PRNT 12 BM120 00660CSR EXSR CLEAR BM120 00670CSR EXSR OUTHED BM120 00680CSR EXSR READIT BM120 00690CSR 88 GOTO MEEXIT NO COMPONENTS BM120 00700CSR 06 RRN ADD 1 NXTRRN 50 BM120 0000710CSRN06 Z-ADD0 NXTRRN BM120 00720CSR Z-ADD1 IND BM120 00730CSR MELOOP TAG BM120 00740CSR MOVE STRCMP PART BM120 00750CSR 70 EXSR MEQTY BM120 00760CSR EXSR MEOUT BM120 00770CSR 88 GOTO NXTCMP BM120 0000780CSR MOVE NXTRRN AR,IND BM120 00790CSR MOVE PRNT AP,IND BM120 00800CSR 06 RRN ADD 1 NXTRRN BM120 00810CSRN06 Z-ADD0 NXTRRN BM120 00820CSR MOVE PART PRNT BM120 00830CSR IND ADD 1 IND BM120 00840CSR IND COMP 26 83 BM120 0000850CSR 83 GOTO MEEXIT BM120 00860CSR GOTO MELOOP BM120 00870CSR NXTCMP TAG BM120 00880CSR NXTRRN COMP 0 2525 BM120 00890CSRN25 NXTRRN CHAINBOMSTR 25 BM120 00900CSRN25 PRNT COMP STRPRN 2626 BM120 00910CSRN25N26 NXTRRN ADD 1 NXTRRN BM120 0000920CSRN25N26 GOTO MELOOP BM120 00930CSR IND SUB 1 IND BM120 00940CSR IND COMP 0 2727 BM120 00950CSR 27 GOTO MEEXIT BM120 00960CSR MOVE AP,IND PRNT BM120 00970CSR MOVE AR,IND NXTRRN BM120 00980CSR GOTO NXTCMP BM120 0000990CSR MEEXIT ENDSR BM120 01000C********************************************************************BM120 01010C********************************************************************BM120 01020C* BM120 01030C*THE FOLLOWING SR IS THE MAIN LOGIC FOR SINGLE LEVEL EXPLOSION BM120 01040C********************************************************************BM120 01050C********************************************************************BM120 0001060C* BM120 01070CSR SESR BEGSR BM120 01080CSR EXSR CLEAR BM120 01090CSR EXSR OUTHED BM120 01100CSR MOVE ASY PART BM120 01110CSR MOVE ASY PRNT BM120 01120CSR Z-ADD1 IND BM120 0001130CSR EXSR READIT BM120 01140CSR 88 GOTO SEEXIT NO COMPONENTS BM120 01150CSR RRN ADD 1 NXTRRN BM120 01160CSRN06 EXSR SEOUT BM120 01170CSRN06 GOTO SEEXIT BM120 01180CSR COMPNT TAG BM120 01190CSR EXSR SEOUT BM120 0001200CSR NXTRRN CHAINBOMSTR 25 BM120 01210CSRN25 PRNT COMP STRPRN 2525 BM120 01220CSRN25 NXTRRN ADD 1 NXTRRN BM120 01230CSRN25 GOTO COMPNT BM120 01240CSR SEEXIT ENDSR BM120 01250C********************************************************************BM120 01260C********************************************************************BM120 0001270C* BM120 01280C*THE FOLLOWING SR IS THE MAIN LOGIC FOR MULTI LEVEL WHERE USED BM120 01290C* BM120 01300C********************************************************************BM120 01310C********************************************************************BM120 01320CSR MWSR BEGSR BM120 01330CSR MOVE PN PART BM120 0001340CSR EXSR CLEAR BM120 01350CSR EXSR OUTHED BM120 01360CSR EXSR READIT BM120 01370CSR 88 GOTO MWEXIT NO USAGES BM120 01380CSR Z-ADDNXTWU NXTRRN BM120 01390CSR Z-ADD1 IND BM120 01400CSR MWLOOP TAG BM120 0001410CSR MOVE STRPRN PART BM120 01420CSR EXSR MWOUT BM120 01430CSR 88 GOTO NXTPRN BM120 01440CSR MOVE NXTRRN AR,IND BM120 01450CSR Z-ADDNXTWU NXTRRN BM120 01460CSR IND ADD 1 IND BM120 01470CSR IND COMP 26 83 BM120 0001480CSR 83 GOTO MWEXIT BM120 01490CSR GOTO MWLOOP BM120 01500CSR NXTPRN TAG BM120 01510CSR NXTRRN CHAINBOMSTR 25 BM120 01520CSR NXTRRN COMP 0 2525 BM120 01530CSR Z-ADDNXTWU NXTRRN BM120 01540CSRN25 GOTO MWLOOP BM120 0001550CSR IND SUB 1 IND BM120 01560CSR IND COMP 0 2727 BM120 01570CSR 27 GOTO MWEXIT BM120 01580CSR MOVE AR,IND NXTRRN BM120 01590CSR GOTO NXTPRN BM120 01600CSR MWEXIT ENDSR BM120 01610C********************************************************************BM120 0001620C********************************************************************BM120 01630C* BM120 01640C*THE FOLLOWING SR IS THE MAIN LOGIC FOR SINGLE LEVEL WHEREUSED BM120 01650C* BM120 01660C********************************************************************BM120 01670C********************************************************************BM120 01680CSR SWSR BEGSR BM120 0001690CSR EXSR CLEAR BM120 01700CSR EXSR OUTHED BM120 01710CSR MOVE PN PART BM120 01720CSR Z-ADD1 IND BM120 01730CSR EXSR READIT BM120 01740CSR 88 GOTO SWEXIT NO USAGES BM120 01750CSR PARENT TAG BM120 0001760CSR MOVE STRPRN PART BM120 01770CSR EXSR SWOUT BM120 01780CSR NXTWU COMP 0 2525 BM120 01790CSRN25 NXTWU CHAINBOMSTR 25 BM120 01800CSRN25 GOTO PARENT BM120 01810CSR SWEXIT ENDSR BM120 01820C********************************************************************BM120 0001830C* BM120 01840C* THIS SR READS STRUCTURE OR WHERE USED FILE BY SETLL BM120 01850C* BM120 01860C********************************************************************BM120 01870CSR READIT BEGSR BM120 01880CSR SETOF 88 BM120 01890CSR 09 BM120 0001900COR 86 PART CHAINBOMMST 88 BM120 01910CSRN08N09 87 SETON 88 BM120 01920CSR 88 GOTO ENDRD BM120 01930CSR 09 BM120 01940COR 86 GOTO STRCHN BM120 01950CSR 08 87 NXTDWN CHAINBOMSTR 88 BM120 01960CSR GOTO ENDRD BM120 0001970CSR STRCHN TAG BM120 01980CSR 86N07 SETON 88 BM120 01990CSRN88 86 WUPN CHAINBOMSTR 88 BM120 02000CSRN88 87 STRPN CHAINBOMSTR 88 BM120 02010CSR ENDRD ENDSR BM120 02020C********************************************************************BM120 02030C* BM120 0002040C*THE FOLLOWING SR SELECTS OUTPUT FOR MULTI LEVEL EXPLOSION BM120 02050C* BM120 02060C********************************************************************BM120 02070CSR MEOUT BEGSR BM120 02080CSR EXSR OUTPRE BM120 02090CSR EXCPT BM120 02100CSR ENDSR BM120 0002110C********************************************************************BM120 02120C* BM120 02130C*THE FOLLOWING SR SELECTS OUTPUT FOR SINGLE LEVEL EXPLOSION BM120 02140C* BM120 02150C********************************************************************BM120 02160CSR SEOUT BEGSR BM120 02170CSR EXSR OUTPRE BM120 0002180CSR EXCPT BM120 02190CSR ENDSR BM120 02200C********************************************************************BM120 02210C* BM120 02220C*THE FOLLOWING SR SELECTS OUTPUT FOR MULTI LEVEL WHERE USED BM120 02230C* BM120 02240C********************************************************************BM120 0002250CSR MWOUT BEGSR BM120 02260CSR EXSR OUTPRE BM120 02270CSR EXCPT BM120 02280CSR ENDSR BM120 02290C********************************************************************BM120 02300C* BM120 02310C*THE FOLLOWING SR SELECTS OUTPUT FOR SINGLE LEVEL WHERE USED BM120 0002320C* BM120 02330C********************************************************************BM120 02340CSR SWOUT BEGSR BM120 02350CSR EXSR OUTPRE BM120 02360CSR EXCPT BM120 02370CSR ENDSR BM120 02380C********************************************************************BM120 0002390C* BM120 02400C*THE FOLLOWING SR PREPARES FOR OUTPUT BM120 02410C* BM120 02420C********************************************************************BM120 02430CSR OUTPRE BEGSR BM120 02440CSR MOVE 'X' WRKBRK BM120 02450CSR MOVE INVCOD WRKINV 1 BM120 0002460CSR 87 MOVE STRCMP WRKPN 12 BM120 02470CSR 86 MOVE STRPRN WRKPN BM120 02480CSR Z-ADDSTRQTY WRKQTY 73 BM120 02490CSR MQTY COMP 0 8585 BM120 02500CSR 85 WRKQTY MULT MQTY WRKQTY BM120 02510CSR MOVE IND WRKLEV 20 BM120 02520CSRN71N73 EXSR READIT BM120 0002530CSR ENDSR BM120 02540C********************************************************************BM120 02550C* BM120 02560C*THE FOLLOWING SR OUTPUTS HEADING RECORD FOR EACH REPORT REQUEST BM120 02570C* BM120 02580C********************************************************************BM120 02590CSR OUTHED BEGSR BM120 0002600CSR MOVE ' ' WRKBRK 1 BM120 02610CSR 70 MOVE 70 WRKCOD 20 BM120 02620CSR 71 MOVE 71 WRKCOD BM120 02630CSR 72 MOVE 72 WRKCOD BM120 02640CSR 73 MOVE 73 WRKCOD BM120 02650CSR WRKCOD COMP 72 868786 BM120 02660CSR MQTY COMP 0 85 BM120 0002670CSR 85 Z-ADD1 MQTY BM120 02680CSR MQTY MULT 1 WRKMQT 70H BM120 02690CSR 86 MOVE PN WRKASY 12 BM120 02700CSR 87 MOVE ASY WRKASY BM120 02710CSR 98 EXCPT BM120 02720CSR SETON 99 BM120 02730CSR SETOF 98 BM120 0002740CSR ENDSR BM120 02750C********************************************************************BM120 02760C* BM120 02770C*THE FOLLOWING SR CLEARS INDICATORS FOR EACH REPORT BM120 02780C* BM120 02790C********************************************************************BM120 02800CSR CLEAR BEGSR BM120 0002810CSR IND SUB IND IND 20 BM120 02820CSR CNT SUB CNT CNT 20 BM120 02830CSR SETOF 99 BM120 02840CSR SETON 98 BM120 02850CSR WRKSEQ ADD 1 WRKSEQ 40 BM120 02860CSR SETOF 08 BM120 02870CSR SETOF 8385 BM120 0002880CSR SETOF 868788 BM120 02890CSR SETON 09 BM120 02900CSR ENDSR BM120 02910C********************************************************************BM120 02920C* BM120 02930C*THE FOLLOWING SR CALCULATES EXTENDED QUANTITIES BM120 02940C* BM120 0002950C********************************************************************BM120 02960CSR MEQTY BEGSR BM120 02970CSR Z-ADDSTRQTY AQ,IND BM120 02980CSR MOVE IND CNT BM120 02990CSR Z-ADD1 WRKEQT BM120 03000CSR QTY TAG BM120 03010CSR CNT COMP 0 85 BM120 0003020CSR 85 GOTO QTYEXT BM120 03030CSR AQ,CNT MULT WRKEQT WRKEQT 93H BM120 03040CSR CNT SUB 1 CNT BM120 03050CSR GOTO QTY BM120 03060CSR QTYEXT TAG BM120 03070CSR MQTY COMP 0 8585 BM120 03080CSR 85 WRKEQT MULT MQTY WRKEQT BM120 0003090CSR ENDSR BM120 03100OBOMWRK E 98 BM120 03110O WRKSEQ 4 BM120 03120O WRKBRK B 5 BM120 03130O WRKASY B 17 BM120 03140O WRKCOD B 19 BM120 03150O WRKMQT B 26 BM120 0003160O E 99 BM120 03170O WRKSEQ 4 BM120 03180O WRKBRK B 5 BM120 03190O WRKPN B 17 BM120 03200O WRKLEV B 19 BM120 03210O WRKQTY B 26 BM120 03220O WRKEQT B 35 BM120 0003230O WRKINV B 36 BM120 ** 003240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003260ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003280/* 00329000_ 00 00 00 00 00 00 00 00 00 00 __ 0(&` &OTXBM125 P999999041178(000010H S BM125 00020X DECK-ID M20 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM125 00030F* PRINTS BILLS OF MATERIAL AND WHERE USED LISTS BM125 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM125 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM125 00060F* CONTROL DATA PROPRIETARY PRODUCT BM125 00070F* BM125 0000080FBOMWRK IPEAF 36 DISK BM125 00090FPARTMST IC F 300R12AI 1 DISK BM125 00100FHEADING IT F 40 EDISK BM125 00110F$LP1 O F 85 OF PRINTER BM125 00120F********************************************************************BM125 00130F* BM125 00140F* PACKAGE MANUFACTURING BM125 0000150F* SYSTEM BILL-OF-MATERIALS PROCESSOR BM125 00160F* PROGRAM PRINTS BILLS BM125 00170F* BM125 00180F* CONTRACTOR COMPUSOURCE BM125 00190F* PROGRAMMER TOM LEE BM125 00200F* DATE SEPTEMBER 27, 1976 BM125 00210F* BM125 0000220F********************************************************************BM125 00230F* BM125 00240F* NARRATIVE: BM125 00250F* BM125 00260F* PRINTS BILLS AND WHERE-USED LISTS. BM125 00270F* BM125 00280F* BOTH REPORTS EDIT PART #'S (HEADER AND DETAIL). IF THE BM125 0000290F* PART # IS ON PARTMST WITH A BLANK DELETE CODE, THEN ITS BM125 00300F* DESCRIPTION IS PRINTED. IF THE PART # IS ON PARTMST WITH BM125 00310F* A NON-BLANK DELETE CODE, THEN THE MESSAGE BM125 00320F* '* FLAGGED FOR DELETION *' IS PRINTED. IF THE PART # IS NOT BM125 00330F* ON PARTMST, THEN THE MESSAGE '** NOT ON PARTMST **' IS BM125 00340F* PRINTED. BM125 00350F* BM125 0000360F* BILLS FOR HEADER PART #, TAKE INV CODE FROM PARTMST. BM125 00370F* ----- FOR DETAIL PART #'S: BM125 00380F* BM125 00390F* EXAMPLE: PARTMST BOMWRK ---> PRINTED BM125 00400F* ------- ------- ------- BM125 00410F* ' ' ' ' ' ' BM125 00420F* ' ' 'N' '* *' BM125 0000430F* 'N' ' ' '*N*' BM125 00440F* 'N' 'N' ' N ' BM125 00450F* BM125 00460F* PRINTED PARTMST INV CODE AND FLAGGED IF DIFFERENT BM125 00470F* FROM BOMWRK INV CODE. BM125 00480F* BM125 00490F* WHERE-USED LISTS FOR HEADER AND DETAIL PART #'S, TAKE BM125 0000500F* ---------------- INV CODE FROM PARTMST. BM125 00510F* BM125 00520F*-------------------------------------------------------------------BM125 00530F* BM125 00540F* ID F C H L FUNCTION OF INDICATORS BM125 00550F* BM125 00560F* 01 BOMWRK - 1ST REC ON DOC (HEADER)(BREAK CODE = ' ') BM125 0000570F* 02 BOMWRK - REST (DETAIL)(BREAK CODE = 'X') BM125 00580F* 03 PARTMST BM125 00590F* BM125 00600F* 10 PARTMST/DELETE CODE = ' ' --> GOOD PART BM125 00610F* BM125 00620F* 11 HEADER PART #'S PARTMST RECORD HAS BLANK CODE BM125 00630F* 12 FOR BILL --> PART HAS SAME INVENTORY CODE IN BM125 0000640F* BOMSTR AND PARTMST BM125 00650F* 51 LEVEL = 1 (BOMWRK DETAIL RECORD) BM125 00660F* 52 LEVEL = 2 (BOMWRK DETAIL RECORD) BM125 00670F* 53 LEVEL = 3 (BOMWRK DETAIL RECORD) BM125 00680F* 54 LEVEL = 4 (BOMWRK DETAIL RECORD) BM125 00690F* 55 LEVEL = 5 (BOMWRK DETAIL RECORD) BM125 00700F* 56 LEVEL = 6 (BOMWRK DETAIL RECORD) BM125 0000710F* 57 LEVEL = 7 (BOMWRK DETAIL RECORD) BM125 00720F* 58 LEVEL = 8 (BOMWRK DETAIL RECORD) BM125 00730F* 59 LEVEL = 9 (BOMWRK DETAIL RECORD) BM125 00740F* 60 LEVEL = 10 - 26 (BOMWRK DETAIL RECORD) BM125 00750F* 70 EXPLODE TYPE = 70 'ME' (BOMWRK HEADER) BM125 00760F* 71 EXPLODE TYPE = 71 'SE' (BOMWRK HEADER) BM125 00770F* 72 EXPLODE TYPE = 72 'MW' (BOMWRK HEADER) BM125 0000780F* 73 EXPLODE TYPE = 73 'SW' (BOMWRK HEADER) BM125 00790F* 80 REFORMAT QTY IF DECIMAL PORTION IS 0 (BOMWRK DETAIL)BM125 00800F* 90 CHAIN TO PARTMST BY HEADER PART # GOT A MISS BM125 00810F* 91 CHAIN TO PARTMST BY DETAIL PART # GOT A MISS BM125 00820F* BM125 00830F********************************************************************BM125 00840E HEADING HEAD 1 1 40 COMPANY NAME BM125 0000850IBOMWRK NS 01 5 C BM125 00860I 6 17 WRKASY BM125 00870I 18 190WRKCOD BM125 00880I 20 260WRKMQT BM125 00890I NS 02 5 CX BM125 00900I 6 17 WRKPN BM125 00910I 18 190WRKLEV BM125 0000920I 20 263WRKQTY BM125 00930I 36 36 WRKINV BM125 00940IPARTMST NS 03 BM125 00950I 1 12 PARTNO BM125 00960I 13 37 DESCR BM125 00970I 38 39 UM BM125 00980I 40 40 CLS BM125 0000990I 51 51 INVCOD BM125 01000I 74 74 DLT 10 BM125 01010I 219 219 REVL BM125 01020I 220 2250REVD BM125 01030I********************************************************************BM125 01040I* BM125 01050I* BOMWRK ' ' HEADER (1ST RECORD ON BILL) BM125 0001060I* BM125 01070I* WRKASY PART # (FOR WHICH BILL WAS REQUESTED) BM125 01080I* WRKCOD STRUCTURE OR WHERE-USED EXPLODE TYPE BM125 01090I* WRKMQT QUANTITY OF ABOVE PART REQUESTED FOR BILL BM125 01100I* BM125 01110I* 'X' REST OF RECORDS ON BILL (DETAIL) BM125 01120I* BM125 0001130I* WRKPN PART # BM125 01140I* WRKLEV LEVEL # ('01' TO '26') BM125 01150I* WRKQTY QUANTITY = STRUCTURE_QTY_OF_THIS_PART * BM125 01160I* REQUEST_QTY_OF_HEADER_PART BM125 01170I* WRKINV INVENTORY CODE BM125 01180I* BM125 01190I* PARTMST ALL BM125 0001200I* BM125 01210I* PARTNO PART # BM125 01220I* DESCR DESCRIPTION BM125 01230I* UM UNIT OF MEASURE BM125 01240I* CLS PRODUCT CLASS BM125 01250I* INVCOD INVENTORY CODE BM125 01260I* DLT DELETE CODE BM125 0001270I* REVL REVIEW LETTER BM125 01280I* REVD REVIEW DATE BM125 01290I* BM125 01300I********************************************************************BM125 01310C********************************************************************BM125 01320C* BM125 01330C* HEADER RECORD. BM125 0001340C* BM125 01350C********************************************************************BM125 01360C N01 GOTO NEXT BM125 01370C* BM125 01380C* VALIDATE HEADER PART #. BM125 01390C* BM125 01400C WRKASY CHAINPARTMST 90 MISS --> 90 BM125 0001410C 90 GOTO ON HIT -->N90 BM125 01420C MOVE DESCR SDESCR 25 SAVE HEADING BM125 01430C MOVE UM SUM 2 SAVE HEADING BM125 01440C MOVE CLS SCLS 1 SAVE HEADING BM125 01450C MOVE INVCOD SINVCD 1 SAVE HEADING BM125 01460C MOVE DLT SDLT 1 SAVE HEADING BM125 01470C MOVE REVL SREVL 1 SAVE HEADING BM125 0001480C Z-ADDREVD SREVD 60 SAVE HEADING BM125 01490C 10 SETON 11 GOOD BM125 01500C N10 SETOF 11 DELETED BM125 01510C ON TAG BM125 01520C Z-ADD0 PAGE NEW DOCUMENT BM125 01530C* BM125 01540C* SET INDICATOR FOR REPORT TYPE. BM125 0001550C* BM125 01560C* REQUEST EXPLODE TYPE BM125 01570C* ------- ------------ BM125 01580C* 1 70 'ME' BM125 01590C* 2 71 'SE' BM125 01600C* 3 72 'MW' BM125 01610C* 4 73 'SW' BM125 0001620C* 5 70 'ME' BM125 01630C* BM125 01640C WRKCOD COMP 70 70 STRUCTURE BM125 01650C WRKCOD COMP 71 71 STRUCTURE BM125 01660C WRKCOD COMP 72 72 WHERE-USED BM125 01670C WRKCOD COMP 73 73 WHERE-USED BM125 01680C Z-ADD0 ITEM 30 BM125 0001690C********************************************************************BM125 01700C* BM125 01710C* DETAIL RECORDS. BM125 01720C* BM125 01730C********************************************************************BM125 01740C NEXT TAG BM125 01750C N02 GOTO END BM125 0001760C* BM125 01770C* VALIDATE DETAIL PART #. BM125 01780C* BM125 01790C WRKPN CHAINPARTMST 91 MISS --> 91 BM125 01800C* HIT -->N91 BM125 01810C MOVE WRKQTY DECIML 30 REFORMAT QTY BM125 01820C DECIML COMP 0 80IF DEC PART BM125 0001830C 80 Z-ADDWRKQTY WKQTY 40 IS 0 BM125 01840C ITEM ADD 1 ITEM BM125 01850C 70N91 BILL --> COMP BM125 01860COR 71N91 WRKINV COMP INVCOD 12 COMPONENT'S BM125 01870C 70 91 INVENTORY CD BM125 01880COR 71 91 SETOF 12 IN BOMSTR BM125 01890C* WITH ITS BM125 0001900C* INVENTORY CD BM125 01910C* IN PARTMST BM125 01920C* BM125 01930C* DETERMINE LEVEL OF PART. IF 'SE' OR 'SW', THEN ONLY HAVE TO BM125 01940C* DO IT ONCE FOR THIS DOCUMENT (ALL 1ST LEVEL). BM125 01950C* ALSO, IT'S UNNECESSARY TO RESET THE LEVEL FOR ADDITIONAL BM125 01960C* CONTIGUOUS SINGLE-LEVEL REQUESTS. BM125 0001970C* BM125 01980C N70N72 51 GOTO END BM125 01990C WRKLEV COMP 1 51 LEVEL 1 BM125 02000C WRKLEV COMP 2 52 LEVEL 2 BM125 02010C WRKLEV COMP 3 53 LEVEL 3 BM125 02020C WRKLEV COMP 4 54 LEVEL 4 BM125 02030C WRKLEV COMP 5 55 LEVEL 5 BM125 0002040C WRKLEV COMP 6 56 LEVEL 6 BM125 02050C WRKLEV COMP 7 57 LEVEL 7 BM125 02060C WRKLEV COMP 8 58 LEVEL 8 BM125 02070C WRKLEV COMP 9 59 LEVEL 9 BM125 02080C WRKLEV COMP 10 60 60 LEVELS 10-26 BM125 02090C END TAG BM125 02100O$LP1 D 202 01 BM125 0002110O OR OF BM125 02120O PAGE Z 10 BM125 02130O 4 'PAGE' BM125 02140O HEAD,1 62 BM125 02150O UDATE Y 85 BM125 02160O D 2 01 BM125 02170O OR OF BM125 0002180O 70 44 'BILL OF MATERIAL -' BM125 02190O 71 44 'BILL OF MATERIAL -' BM125 02200O 72 44 'WHERE-USED LIST -' BM125 02210O 73 44 'WHERE-USED LIST -' BM125 02220O 70 59 'MULTIPLE LEVEL' BM125 02230O 72 59 'MULTIPLE LEVEL' BM125 02240O 71 57 'SINGLE LEVEL' BM125 0002250O 73 57 'SINGLE LEVEL' BM125 02260O 85 'MFG125' BM125 02270O D 1 01 BM125 02280O OR OF BM125 02290O 11 'PART NUMBER' BM125 02300O 24 'DESCRIPTION' BM125 02310O 46 'QTY' BM125 0002320O 49 'UM' BM125 02330O 53 'CLS' BM125 02340O 57 'INV' BM125 02350O 66 'REV DATE' BM125 02360O 74 'REV LTR' BM125 02370O D 2 01 BM125 02380O OR OF BM125 0002390O WRKASY 12 BM125 02400O N90 11SDESCR 38 BM125 02410O N90N11 37 '* FLAGGED FOR DELETION *' BM125 02420O 90 37 '** NOT ON PARTMST **' BM125 02430O WRKMQTL 47 BM125 02440O N90 SUM 49 BM125 02450O N90 SCLS 52 BM125 0002460O N90 SINVCD 56 BM125 02470O N90 SREVD Y 66 BM125 02480O N90 SREVL 71 BM125 02490O D 1 01 BM125 02500O OR OF BM125 02510O 85 'REV' BM125 02520O D 2 01 BM125 0002530O OR OF BM125 02540O 4 'LINE' BM125 02550O 11 'LEVEL' BM125 02560O 23 'PART #' BM125 02570O 42 'DESCRIPTION' BM125 02580O 66 'QUANTITY' BM125 02590O 70 'UM' BM125 0002600O 75 'CLS' BM125 02610O 80 'INV' BM125 02620O 85 'LTR' BM125 02630O D 1 02 51 BM125 02640O 1 ' ' BM125 02650O D 1 02 BM125 02660O ITEM 3 4 BM125 0002670O 51 7 'X' BM125 02680O 52 8 'XX' BM125 02690O 53 9 'XXX' BM125 02700O 54 10 'XXXX' BM125 02710O 55 11 'XXXXX' BM125 02720O 56 12 'XXXXXX' BM125 02730O 57 13 'XX7XXXX' BM125 0002740O 58 14 'XXXXXXXX' BM125 02750O 59 15 'XXXXXXXXX' BM125 02760O 60 WRKLEV3 15 BM125 02770O WRKPN 29 BM125 02780O N91 10DESCR 56 BM125 02790O N91N10 55 '* FLAGGED FOR DELETION *' BM125 02800O 91 55 '** NOT ON PARTMST **' BM125 0002810O 80WKQTY LB 63 BM125 02820O N80WRKQTYL 67 BM125 02830O N91 UM 70 BM125 02840O N91 CLS 74 BM125 02850O* 70N91N12 80 '* *' BM125 02860O* 71N91N12 80 '* *' BM125 02870O N91 INVCOD 79 BM125 0002880O N91 REVL 84 BM125 ** 002890ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002900ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002910ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002920ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002930/* 00294000__0O N91 REVL 84 BM125 ** 002890ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002900ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002910ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002920ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002930/* 0029400(' cTOTXBM130 P999999041178(000010H S BM130 00020X DECK-ID M21 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM130 00030F* UPDATES INCREMENTAL COSTS IN PARTMST BM130 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM130 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM130 00060F* CONTROL DATA PROPRIETARY PRODUCT BM130 00070F* BM130 0000080FROUTING IP AF 85 DISK BM130 00090FPARTMST US AF 300 12AI 1 DISK BM130 00100FMACHMST IC F 48R05AI 1 DISK BM130 00110FLABMST IC F 48R02AI 1 DISK BM130 00120E WAR 200 5 WORK STATIONS BM130 00130E BAR 200 7 3 BURDEN/HR FOR WARBM130 00140E GAR 25 2 LABOR GRADES BM130 0000150E LAR 25 7 3 LABOR/HR FOR GAR BM130 00160IROUTING NS 01 BM130 00170I 1 12 PART L1M1 BM130 00180I 66 66 OPTYPE BM130 00190I 49 53 WS BM130 00200I 54 55 LG BM130 00210I 56 582QUEFAC 10 BM130 0000220I 38 423HRSPC BM130 00230I 59 653UOPCST BM130 00240IPARTMST NS 02 BM130 00250I 1 12 PART M1 BM130 00260IMACHMST NS 03 BM130 00270I 26 323BRATE BM130 00280ILABMST NS 04 BM130 0000290I 23 293LRATE BM130 00300C 02 GOTO END BM130 00310C L1 Z-ADD0 ILAB 73 BM130 00320C L1 Z-ADD0 IBUR 73 BM130 00330C L1 Z-ADD0 IOP 73 BM130 00340C L1 Z-ADD0 ILHRS 73 BM130 00350C L1 Z-ADD1 CUMFAC 32 BM130 0000360C SETOF 20 BM130 00370C OPTYPE COMP 'X' 20 BM130 00380C 10 Z-ADD1 QUEFAC BM130 00390C 20 CUMFAC MULT UOPCST UOP 73H BM130 00400C 20 UOP ADD IOP IOP BM130 00410C QUEFAC MULT CUMFAC CUMFAC H BM130 00420C 20 GOTO END BM130 0000430C SETOF 3040 BM130 00440C Z-ADD1 N 30 BM130 00450C WS LOKUPWAR,N 30 BM130 00460C 30 Z-ADDBAR,N BRATE BM130 00470C N30 EXSR BURDEN BM130 00480C Z-ADD1 M 20 BM130 00490C LG LOKUPGAR,M 40 BM130 0000500C 40 Z-ADDLAR,M LRATE BM130 00510C N40 EXSR LABOR BM130 00520C LRATE MULT HRSPC ULAB 73H BM130 00530C HRSPC ADD ILHRS ILHRS BM130 00540C ULAB ADD ILAB ILAB BM130 00550C BRATE MULT HRSPC UBUR 73H BM130 00560C UBUR ADD IBUR IBUR BM130 0000570C END TAG BM130 00580CLR Z-ADD0 Z7 73 BM130 00590CSR BURDEN BEGSR BM130 00600CSR WS CHAINMACHMST 25 BM130 00610CSR 25 Z-ADD0 BRATE BM130 00620CSR 25 GOTO BTAG BM130 00630CSR MOVEL' ' A5 5 BM130 0000640CSR Z-ADD1 N BM130 00650CSR A5 LOKUPWAR 31 BM130 00660CSRN31 GOTO BTAG BM130 00670CSR MOVELWS WAR,N BM130 00680CSR Z-ADDBRATE BAR,N BM130 00690CSR BTAG ENDSR BM130 00700CSR LABOR BEGSR BM130 0000710CSR LG CHAINLABMST 26 BM130 00720CSR 26 Z-ADD0 LRATE BM130 00730CSR 26 GOTO LTAG BM130 00740CSR MOVEL' ' A2 2 BM130 00750CSR Z-ADD1 M BM130 00760CSR A2 LOKUPGAR 41 BM130 00770CSRN41 GOTO LTAG BM130 0000780CSR MOVELLG GAR,M BM130 00790CSR Z-ADDLRATE LAR,M BM130 00800CSR LTAG ENDSR BM130 00810OPARTMST D 02 BM130 00820O MR ILAB 95 BM130 00830O MR IBUR 102 BM130 00840O MR IOP 109 BM130 0000850O MR ILHRS 137 BM130 00860O NMR Z7 95 BM130 00870O NMR Z7 102 BM130 00880O NMR Z7 109 BM130 00890O NMR Z7 137 BM130 00900O NMR Z7 116 BM130 00910O NMR Z7 123 BM130 0000920O NMR Z7 130 BM130 00930O NMR Z7 145 BM130 ** 000940ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000950ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000960ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000970ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00098000/* 000990__0O NMR Z7 145 BM130 ** 000940ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000950ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000960ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000970ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0009800(d. +*OTXBM135 P999999041178(000010H S BM135 00020X DECK-ID M22 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM135 00030F* BLANKS ENCOUNTER CODE AND UPDATES NEXT CODE IN BOMSTR BM135 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM135 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM135 00060F* CONTROL DATA PROPRIETARY PRODUCT BM135 00070F* BM135 0000080FBOMSTR UC F 54R DISK BM135 00090FBM5DUM IPEAF 80 DISK BM135 00100IBOMSTR NS 01 BM135 00110I 1 12 PN 10 BM135 00120IBM5DUM NS 02 BM135 00130I 1 1 A BM135 00140C SETON LR BM135 0000150CLR LOOP TAG BM135 00160CLR RRN ADD 1 RRN 50 BM135 00170CLR RRN CHAINBOMSTR 20 BM135 00180CLR N20 MOVE PN SPN 12 BM135 00190CLR N20 SETON 90 BM135 00200CLR 90 EXCPT BM135 00210CLR SETOF 90 BM135 0000220CLR PN COMP LPN 2525 BM135 00230CLR LRRN COMP 0 26 BM135 00240CLR 25N26LRRN CHAINBOMSTR 21 BM135 00250CLRN21 25N26 SETON 91 BM135 00260CLR 91 EXCPT BM135 00270CLR SETOF 91 BM135 00280CLR 10 GOTO END BM135 0000290CLR MOVE RRN LRRN 50 BM135 00300CLR MOVE SPN LPN 12 BM135 00310CLR GOTO LOOP BM135 00320CLR END TAG BM135 00330OBOMSTR E 90 BM135 00340O 52 ' ' BM135 00350O 53 ' ' BM135 0000360O E 91 BM135 00370O 52 '1' BM135 ** 000380ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000390ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000400ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000410ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00042000/* 000430__0O 52 '1' BM135 ** 000380ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000390ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000400ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000410ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0004200('] {OTXBM140 P999999041178(000010H S BM140 00020X DECK-ID M23 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM140 00030F* UPDATES CUMULATIVE COSTS IN PARTMST BM140 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM140 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM140 00060F* CONTROL DATA PROPRIETARY PRODUCT BM140 00070F* BM140 0000080FBOMINP IPEAF 54 DISK BM140 00090FBOMSTR UC F 54R DISK BM140 00100FBOMMST IC F 28R12AI 1 DISK BM140 00110FPARTMST UC F 300R12AI 1 DISK BM140 00120FBOMWRK O F 36 DISK U1 BM140 00130E APQ 10 9 3 BM140 00140E AQ 10 7 3 BM140 0000150E AC 10 12 BM140 00160E AP 10 12 BM140 00170E SVM 10 2 0 BM140 00180E NXA 10 5 0 BM140 00190E MXL 10 2 0 BM140 00200E CMP 100 12 BM140 00210E ND 100 5 0 BM140 0000220E QT 100 7 3 BM140 00230E C1 10 7 3 BM140 00240E C2 10 7 3 BM140 00250E C3 10 7 3 BM140 00260E C4 10 7 3 BM140 00270E C5 10 7 3 BM140 00280E C6 10 7 3 BM140 0000290IBOMINP NS 01 35 C5 BM140 00300I 4 15 ASY BM140 00310I NS 02 BM140 00320I 1 1 A BM140 00330IBOMSTR NS 03 BM140 00340I 1 12 STRPRN BM140 00350I 13 24 COMP BM140 0000360I 25 313QUANTY BM140 00370I 53 53 FLAG 07 BM140 00380I 52 52 NXTCOD 06 BM140 00390I 32 360RRN BM140 00400I 37 410NDOWN 08 BM140 00410IBOMMST NS 04 BM140 00420I 13 170STRPN BM140 0000430IPARTMST NS 11 74 C BM140 00440I 75 813AVGCST BM140 00450I 82 883LSTCST BM140 00460I 131 1373ULHRS BM140 00470I 89 953ULDLS BM140 00480I 138 1453TLHRS BM140 00490I 110 1163TLDLS BM140 0000500I 103 1093UOP BM140 00510I 124 1303TOP BM140 00520I 96 1023UBDLS BM140 00530I 117 1233TBDLS BM140 00540I NS 12 BM140 00550I 1 1 A BM140 00560C********************************************************************BM140 0000570C* BM140 00580C* THIS IS A PRODUCT COST EXPLODE. THE EXPLODE STARTS OFF BY BM140 00590C* READING FROM BOMMST THE 1ST ASSY OF THE PART# BEING EXPLODED. BM140 00600C* IF ANY COMPONENTS IN TURN HAS COMPONENTS THEN THE NXT DWN VALUE BM140 00610C* IN ITS BOMSTR RECORD WILL POINT TO ITS 1ST ASSEMBLY COMPONENT. BM140 00620C* TO FIND THE NEXT PART# ON THE SAME LEVEL THEN THE NEXT PHYSICAL BM140 00630C* RECORD IS READ. THIS PROCESS ALSO ACCESSES THE ITEM MASTER BM140 0000640C* FILE FOR COST INFORMATION. THE UNIT COSTS ARE TOTALED AND BM140 00650C* OUTPUTTED AS TOTAL COSTS TO THE PARENT FOR ALL ASSEMBLIES IN THE BM140 00660C* EXPLODE. THIS PROGRAM ALSO ALLOWS THE PROGRAM TO NOT EXPLODE BM140 00670C* AN ASSEMBLY TWICE. IF U1 IS OFF THEN BOMWRK IS NOT OUTPUT AND BM140 00680C* THE EXPLODE GOES TO THE NEXT COMPONENT IF THE CURRENT COMPONENT BM140 00690C* IS ALSO A PARENT BUT HAS BEEN EXPLODED. IF U1 IS ON THEN BOMWRK BM140 00700C* WILL BE OUTPUT WITH THE ENTIRE BILL OF MATERIAL BUT THE PRODUCT BM140 0000710C* COST INFORMATION WILL ONLY BE UPDATED ONCE. BM140 00720C* BM140 00730C********************************************************************BM140 00740C N01 GOTO DEND BM140 00750C* BM140 00760C* AT THIS POINT WE ZERO OUT THE ARRAYS, INITIALIZE INDICATIORS BM140 00770C* AND VARIABLES AND OUTPUT THE TOP UNIT INFORMATION TO BOMWRK IF BM140 0000780C* U1 IS ON BM140 00790C* BM140 00800C Z-ADD0 C1 BM140 00810C Z-ADD0 C2 BM140 00820C Z-ADD0 C3 BM140 00830C Z-ADD0 C4 BM140 00840C Z-ADD0 C5 BM140 0000850C Z-ADD0 C6 BM140 00860C SETOF 3095 BM140 00870C MOVE ASY PRNT 12 BM140 00880C MOVE ASY PART 12 BM140 00890C SEQNUM ADD 1 SEQNUM 40 BM140 00900C SETON 80 BM140 00910C U1 EXCPT BM140 0000920C SETOF 80 BM140 00930C Z-ADD1 QTYPNT 93 BM140 00940C N99 Z-ADD10 MAXSTR 20 BM140 00950C N99 Z-ADD10 MAXLVL 20 99 BM140 00960C* BM140 00970C* HERE WE START THE EXPLODE OFF BY FINDING THE RELATIVE RECORD BM140 00980C* NUMBER OF THE 1ST COMPONENT BM140 0000990C* BM140 01000C ASY CHAINBOMMST 55 BM140 01010C N55 STRPN COMP 0 5555 BM140 01020C 55 GOTO DEND NO COMPONENTS BM140 01030C* BM140 01040C* ONCE WE HAVE FOUND THE RRN OF THE 1ST COMPONENT WE READ THE BM140 01050C* FIRST -MAXSTR- AMOUNT OF COMPONENTS INTO CORE. THEN WE GO TO BM140 0001060C* NXTCMP WHERE WE BEGIN-PROCESSING -THE INFORMATION IN MAIN BM140 01070C* MEMORY BM140 01080C* BM140 01090C MOVE STRPN NXTDWN BM140 01100C Z-ADD1 L 20 BM140 01110C SETON 9394 BM140 01120C EXSR READEM READ 10 RECS BM140 0001130C SETOF 94 BM140 01140C BADPTR TAG BM140 01150C 90 SETON H1 BM140 01160C H1 GOTO DEND BM140 01170C 95NU1 GOTO DEND BM140 01180C 95 Z-SUB1 CHKLVL 30 BM140 01190C GOTO CALLRD BM140 0001200C* BM140 01210C* IN THIS NEXT SECTION WE HAVE AVAILABLE TO US THE COMPONENT BM140 01220C* INFORMATION. WE CAN EXTEND THE QUANTITY, OUTPUT THE INFORMATION, BM140 01230C* AND DECIDE WHETHER OR NOT THE COMPONENT HAS COMPONENTS OF ITS BM140 01240C* OWN. IF U1 IS OFF WE WON'T OUTPUT TO BOMWRK. IF THIS COMPONENTBM140 01250C* HAS NOT BEEN EXPLODED AND UPDATED AND HAS COMPONENTS OF ITS OWN BM140 01260C* THEN WE GO TO THE DWNMOR SECTION WHICH CONTINUES THE EXPLODE, BM140 0001270C* OTHER WISE WE GO ON AND INCREMENT THE COST ARRAYS BM140 01280C* BM140 01290C MELOOP TAG BM140 01300C QTYPNT MULT QTY EXQTY 93H BM140 01310C SETON 8180 BM140 01320C U1 EXCPT OUTPUT COMPNT BM140 01330C SETOF 8180 BM140 0001340C NXTDWN COMP 0 27 BM140 01350C 30 L COMP CHKLVL 30 BM140 01360C 27 30 U1 GOTO DWNMOR BM140 01370C 30 GOTO NXTCMP BM140 01380C 27 SETON 9394 BM140 01390C 27 EXSR READEM BM140 01400C 27 SETOF 94 BM140 0001410C 90 GOTO BADPTR BM140 01420C 27N95 GOTO DWNMOR BM140 01430C 95 Z-ADDL CHKLVL 20 30 BM140 01440C* BM140 01450C* THIS SECTION GOES TO THE ITEM MASTER FILE AND PULLS OFF THE BM140 01460C* INCREMENTAL COSTS FOR THE COMPONENT WE ARE CURRENTLY PROCESSING. BM140 01470C* WE MULTIPLY THESE COSTS BY THE QTY IN THE BOMSTR RECORD AND BM140 0001480C* ADD THESE EXTENDED COSTS TO THE COST ARRAYS. THESE COST ARRAYS BM140 01490C* ARE AN ACCUMULATION OF THE COSTS OF ALL THE COMPONENTS OF A BM140 01500C* SINGLE PARENT. IF THIS COMPONENT HAS BEEN COSTED AND IT HAS BM140 01510C* COMPONENTS ITSELF THEN TOTAL COSTS ARE USED INSTEAD OF THE BM140 01520C* INCREMENTAL. IF U1 IS OFF WE GO AND PROCESS THE NEXT COMPONENT. BM140 01530C* IF U1 IS ON AND THIS COMPONENT HAS COMPONENTS THEN WE GO TO BM140 01540C* THE DWNMOR SECTION BM140 0001550C* BM140 01560C SETOF 1112 BM140 01570C STRCMP CHAINPARTMST 55 BM140 01580C N55 12 SETON 55 BM140 01590C 55 27 U1 GOTO DWNMOR BM140 01600C 55 GOTO NXTCMP SKIP SECTION BM140 01610C QTY MULT AVGCST EXAVG 73H BM140 0001620C QTY MULT LSTCST EXLST 73H BM140 01630C N27 QTY MULT ULHRS EXLHRS 73H BM140 01640C N27 QTY MULT ULDLS EXLDLS 73H BM140 01650C N27 QTY MULT UOP EXOP 73H BM140 01660C N27 QTY MULT UBDLS EXBDLS 73H BM140 01670C 27 QTY MULT TLHRS EXLHRS H BM140 01680C 27 QTY MULT TLDLS EXLDLS H BM140 0001690C 27 QTY MULT TOP EXOP H BM140 01700C 27 QTY MULT TBDLS EXBDLS H BM140 01710C C1,L ADD EXAVG C1,L BM140 01720C C2,L ADD EXLST C2,L BM140 01730C C3,L ADD EXLHRS C3,L BM140 01740C C4,L ADD EXLDLS C4,L BM140 01750C C5,L ADD EXOP C5,L BM140 0001760C C6,L ADD EXBDLS C6,L BM140 01770C SETOF 95 BM140 01780C NU1 SETOF 93 BM140 01790C NU1 GOTO NXTCMP BM140 01800C N27 GOTO NXTCMP BM140 01810C* BM140 01820C* BM140 0001830C* DWNMOR SECTION TAKES THE EXPLODE TO THE NEXT LEVEL. IN OTHER BM140 01840C* WORDS IT ENCOUNTERED A COMPONENT WHICH WAS ALSO A PARENT OF BM140 01850C* A CHAIN OF COMPONENTS. IT MUST SAVE THE PRESENT STATUS OF THE BM140 01860C* EXPLODE -IN A SET OF ARRAYS, INCREMENT THE LEVEL COUNTER AND BM140 01870C* CONTINUE THE EXPLODE BY READING ITS FIRST -MAXSTR- AMOUNT OF BM140 01880C* COMPONENTS BM140 01890C* BM140 0001900C DWNMOR TAG BM140 01910C MOVE M SVM,L BM140 01920C MOVE QTYPNT APQ,L BM140 01930C Z-ADDEXQTY QTYPNT BM140 01940C MOVE QTY AQ,L BM140 01950C MOVE PRNT AP,L BM140 01960C MOVE STRCMP AC,L BM140 0001970C L ADD 1 L BM140 01980C L COMP MAXLVL H3 LEVEL TOO BIG BM140 01990C H3 GOTO DEND BM140 02000C MOVE STRCMP PRNT FOR CHECKING BM140 02010C CALLRD TAG BM140 02020C EXSR READEM BM140 02030C 90 GOTO BADPTR BM140 0002040C* BM140 02050C* IN THIS SECTION WE PULL OUT OF STORAGE THE BOMSTR INFORMATION BM140 02060C* WE PUT IN WHEN READEM WAS EXECUTED. IF THE PARTICULAR RECORD BM140 02070C* WAS ALREADY PROCESSED 30 IS SET ON. 30 IS ONLY SET OFF BM140 02080C* WHEN WE FIND THE NEXT COMPONENT ON THIS LEVEL OR LOWER. BM140 02090C* 31 IS SETON ON AT THE SAME TIME BUT IS SETOF WHEN EVER WE BM140 02100C* PROCESS THE COST INFORMATION. SO IF 30 IS ON AND 31 IS OFF IT BM140 0002110C* MEANS THAT NOT ONLY THIS COMPONENT HAS BEEN PROCESSED BUT IT'S BM140 02120C* PARENT HAS BEEN PROCESSED TOO. BM140 02130C* BM140 02140C NXTCMP TAG BM140 02150C M ADD 1 M 20 BM140 02160C LM ADD 1 LM 20 BM140 02170C M COMP MXL,L 2525 BM140 0002180C 25 MOVE CMP,LM STRCMP 12 BM140 02190C 25 MOVE ND,LM NXTDWN 50 BM140 02200C 25 MOVE QT,LM QTY 73 BM140 02210C 25 GOTO MELOOP BM140 02220C* BM140 02230C* IF WE GET TO THIS SECTION IT MEANS WE HAVE PULLED OUT AND BM140 02240C* PROCESSED ALL -MAXSTR- NUMBER OF RECORDS FROM THE ARRAYS AND BM140 0002250C* NOW WE MUST GO TO THE BOMSTR FILE AND READ -MAXSTR- MORE BM140 02260C* BM140 02270C M COMP MAXSTR 28 BM140 02280C 28 Z-ADDNXA,L NXTDWN 28 BM140 02290C 28 EXSR READEM BM140 02300C 28 90 GOTO BADPTR BM140 02310C 28 GOTO NXTCMP BM140 0002320C* BM140 02330C* IF WE GET TO THIS SECTION THEN WE HAVE COME TO THE END OF THE BM140 02340C* COMPONENT CHAIN FOR THE PARENT WHOSE LEVEL IS L-1. WE MUST BM140 02350C* TAKE THE TOTAL COST ARRAYS OF THE COMPONENTS AT LEVEL L AND ADD BM140 02360C* THEM TO THE UNIT COST FIGURES OF THE PARENT TO GET THE TOTAL BM140 02370C* COSTS OF THE PARENT. THEN WE MUST EXTEND THESE TOTAL COSTS AND BM140 02380C* ADD THEM TO THE COST ARRAY OF THE PARENT'S PARENT ARRAY - LEVEL BM140 0002390C* L-1. WE MUST OUTPUT THE PARENTS TOTAL COSTS TO THE ITEM MASTER BM140 02400C* AND THEN RESTORE THE EXPLODE STATUS TO WHAT IT WAS BEFORE BM140 02410C* WE EXPLODED THE PARENT BM140 02420C* BM140 02430C L SUB 1 L 2626 BM140 02440C 26 GOTO FINISH BM140 02450C MOVE SVM,L M BM140 0002460C MOVE AP,L PRNT BM140 02470C MOVE AQ,L QTY BM140 02480C MOVE APQ,L QTYPNT BM140 02490C MOVE AC,L STRCMP BM140 02500C L SUB 1 LM BM140 02510C LM MULT MAXSTR LM BM140 02520C LM ADD M LM BM140 0002530C 30 L COMP CHKLVL 30 30 BM140 02540C 30 GOTO NXTCMP BM140 02550C SETOF 1112 BM140 02560C STRCMP CHAINPARTMST 55 BM140 02570C N55 12 SETON 55 BM140 02580C N55 SETON 83 BM140 02590C L ADD 1 L1 20 BM140 0002600C 83 C3,L1 ADD ULHRS C3,L1 BM140 02610C 83 C4,L1 ADD ULDLS C4,L1 BM140 02620C 83 C5,L1 ADD UOP C5,L1 BM140 02630C 83 C6,L1 ADD UBDLS C6,L1 BM140 02640C 83 EXCPT OUTPUT TOTALS BM140 02650C 83 SETOF 83 BM140 02660C C1,L1 MULT QTY C1,L1 BM140 0002670C C2,L1 MULT QTY C2,L1 BM140 02680C C3,L1 MULT QTY C3,L1 BM140 02690C C4,L1 MULT QTY C4,L1 BM140 02700C C5,L1 MULT QTY C5,L1 BM140 02710C C6,L1 MULT QTY C6,L1 BM140 02720C C1,L1 ADD C1,L C1,L BM140 02730C C2,L1 ADD C2,L C2,L BM140 0002740C C3,L1 ADD C3,L C3,L BM140 02750C C4,L1 ADD C4,L C4,L BM140 02760C C5,L1 ADD C5,L C5,L BM140 02770C C6,L1 ADD C6,L C6,L BM140 02780C Z-ADD0 C1,L1 BM140 02790C Z-ADD0 C2,L1 BM140 02800C Z-ADD0 C3,L1 BM140 0002810C Z-ADD0 C4,L1 BM140 02820C Z-ADD0 C5,L1 BM140 02830C Z-ADD0 C6,L1 BM140 02840C GOTO NXTCMP BM140 02850C* BM140 02860C* THIS LAST SECTION UPDATES THE COST OF THE VERY TOP UNIT WHICH BM140 02870C* WAS ORIGINALLY EXPLODED. BM140 0002880C* BM140 02890C FINISH TAG BM140 02900C CHKLVL COMP 0 30 BM140 02910C 30 GOTO DEND BM140 02920C SETOF 1112 BM140 02930C PART CHAINPARTMST 55 BM140 02940C N55 12 SETON 55 BM140 0002950C 55 GOTO DEND BM140 02960C C3,1 ADD ULHRS C3,1 BM140 02970C C4,1 ADD ULDLS C4,1 BM140 02980C C5,1 ADD UOP C5,1 BM140 02990C C6,1 ADD UBDLS C6,1 BM140 03000C Z-ADD1 L1 83 BM140 03010C EXCPT BM140 0003020C SETOF 83 BM140 03030C DEND TAG BM140 03040C********************************************************************BM140 03050C* BM140 03060C* READEM READS -MAXSTR- RECORDS AT A TIME FROM BOMSTR AND STORES BM140 03070C* THE INFORMATION IN ARRAYS WITH MAXSTR X MAXLUL ELEMENTS. BM140 03080C* IF THE RECORD HAS ALREADY BEEN READ AND HAS COMPONENTS THEN THE BM140 0003090C* FLG ARRAY IS MARKED WITH AN 'X' FOR THAT RECORD. IF THE RECORD BM140 03100C* BE RUN BEFORE THIS TO BLANK OUT THIS FLAG FIELD FOR ALL BOMSTR BM140 03110C* RECORDS BM140 03120C* BM140 03130C********************************************************************BM140 03140CSR READEM BEGSR BM140 03150CSR MOVE NXTDWN NXTRRN 50 BM140 0003160CSR 94 GOTO CHNBOM BM140 03170CSR L SUB 1 LM BM140 03180CSR LM MULT MAXSTR LM BM140 03190C* BM140 03200C* THE RANGE OF ELEMENTS AVAILABLE IN THE STORAGE ARRAYS BM140 03210C* ARE LM+1 TO LM+MAXSTR . SO IF WE HAVE L=2 AND MAXSTR = 10 BM140 03220C* THEN THE RANGE IS FROM 11- 20 IF L=3 THEN 21 - 30 ECT. BM140 0003230C* BM140 03240CSR MOVE LM TM 20 BM140 03250CSR Z-ADD0 M BM140 03260CSR Z-ADD0 NXA,L BM140 03270CSR NXTRD TAG BM140 03280CSR M COMP MAXSTR 25 BM140 03290CSR 25 06 RRN ADD 1 NXA,L BM140 0003300CSR 25 GOTO ENDRD BM140 03310CSR CHNBOM TAG BM140 03320CSR 94 BM140 03330CORN93 NXTRRN CHAINBOMSTR 90 BM140 03340CSRN90N94 PRNT COMP STRPRN H2H2 BM140 03350CSRN90 H2 SETON 90 BM140 03360CSRN07 94 SETON 95 BM140 0003370CSR 90 BM140 03380COR 94 GOTO ENDIT BM140 03390CSR 07 93 SETON 79 BM140 03400CSR 79 EXCPT BM140 03410CSR SETOF 7993 BM140 03420CSR M ADD 1 M BM140 03430CSR TM ADD 1 TM BM140 0003440CSR MOVE COMP CMP,TM BM140 03450CSR MOVE NDOWN ND,TM BM140 03460CSR MOVE QUANTY QT,TM BM140 03470CSR 06 RRN ADD 1 NXTRRN BM140 03480CSR 06 GOTO NXTRD BM140 03490CSR ENDRD TAG BM140 03500CSR Z-ADDM MXL,L BM140 0003510CSR Z-ADD0 M BM140 03520CSR ENDIT ENDSR BM140 03530C* BM140 03540C********************************************************************BM140 03550OBOMSTR E 79 BM140 03560O 53 'X' BM140 03570OPARTMST E 83 BM140 0003580O C1,L1 81 BM140 03590O C2,L1 88 BM140 03600O C3,L1 145 BM140 03610O C4,L1 116 BM140 03620O C5,L1 130 BM140 03630O C6,L1 123 BM140 03640OBOMWRK E 80 U1 BM140 0003650O SEQNUM 4 BM140 03660O 5 ' ' BM140 03670O PART 17 BM140 03680O 19 ' ' BM140 03690O 81 5 'X' BM140 03700O 81 STRCMP 17 BM140 03710O 81 L 19 BM140 0003720O 81 QTY 26 BM140 03730O 81 EXQTY 35 BM140 ** 003740ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003750ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003760ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003770ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00378000/* 003790__0O 81 EXQTY 35 BM140 ** 003740ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003750ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003760ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003770ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0037800() $TXBM3ENT P0999999111111(000010H S BM3ENT00020X DECK-ID M27 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM3ENT00030F* ENTER COSTED BILL OF MATERIAL REQUESTS BM3ENT00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM3ENT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM3ENT00060F* CONTROL DATA PROPRIETARY PRODUCT BM3ENT00070F* BM3ENT0000080FBM1DUM IPE F 72 DISK BM3ENT00090FKPROGS IC F 36R 8AI 1 DISK BM3ENT00100FBM3OUT UC F 128R DISK BM3ENT00110F********************************************************************BM3ENT00120F* INDICATOR FUNCTION LIST BM3ENT00130F* 01 DUMMY RECORD BM3ENT00140F* 02 KEYPYNCH PARAMETER FILE BM3ENT0000150F* 05 KEYPUNCH DATA FILE BM3ENT00160F* 18 BM3ENT00170F* 19 BM3ENT00180F* 20 BM3ENT00190F* 21 BM3ENT00200F* 25 RETRY ON RUBOUT BM3ENT00210F* 27 AUTO DUP BM3ENT0000220F* 28 BM3ENT00230F* 29 BM3ENT00240F* 40 MODE IS A-ADD BM3ENT00250F* 41 MODE IS C-CHANGE BM3ENT00260F* 42 MODE IS V-VERIFY BM3ENT00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS BM3ENT00280F* 44 MODE IS E-END OF JOB BM3ENT0000290F* 56 SEQ NBR NOT IN KPFILE BM3ENT00300F* 60 NEW PROGRAM NBR ONLY BM3ENT00310F* 61 AUTO DUP ONLY BM3ENT00320F* 70 BM3ENT00330F* 72 BM3ENT00340F* 73 MODE IS LESS THAN OR = 4 BM3ENT00350F* 81 MODE IS INVALID BM3ENT0000360F* 82 BAD PROG NBR BM3ENT00370F* 83 FIRST FIELD NAME BLANK BM3ENT00380F* 84 OUTPUT FIELD NAME BM3ENT00390F* 85 BM3ENT00400F* 88 SEQ NBR NOT IN KPFILE BM3ENT00410F* 90 AUTO DUP ON BM3ENT00420F* 95 BM3ENT0000430F* 98 RCD WITHIN OPERATOR LIMITS BM3ENT00440F* LR BM3ENT00450F********************************************************************BM3ENT00460E MSG 1 10 25 BM3ENT00470E SFN 80 20 BM3ENT00480E SAN 80 1 BM3ENT00490E SAD 80 1 BM3ENT0000500E SST 80 3 0 BM3ENT00510E SLN 80 2 0 BM3ENT00520E SNM 4 6 BM3ENT00530E SMX 4 2 0 BM3ENT00540E NP 4 1 0 BM3ENT00550E ARY1 1 2 50 BM3ENT00560IBM1DUM NS 01 BM3ENT0000570I 1 1 A BM3ENT00580IKPROGS NS 02 BM3ENT00590I 9 28 FN BM3ENT00600I 29 29 AN BM3ENT00610I 30 30 AD BM3ENT00620I 31 33 ST BM3ENT00630I 34 35 LN BM3ENT0000640I 36 36 DCODE BM3ENT00650IBM3OUT NS 05 BM3ENT00660I 1 128 RECORD BM3ENT00670C MOVE ' ' B72 72 BM3ENT00680C EXSR ALMTS BM3ENT00690C Z-ADDLOW SEQNO BM3ENT00700C NLR SETON LR BM3ENT0000710CLR START TAG BM3ENT00720CLR MOVEL'' WORD BM3ENT01590CLR Z-ADD1 OLN BM3ENT01600CLR Z-ADD1 ILN BM3ENT01610CLR EXSR TYPES BM3ENT0001620CLR MOVELBUFFER MODE BM3ENT01630CLR MODE COMP '4' 7373 BM3ENT01640CLR MODE COMP 'P' 60 NEW PROG#ONLY BM3ENT01650CLR MODE COMP 'D' 61 AUTO-DUP ONLY BM3ENT01660CLRN60N61N73 GOTO CHKMOD NEW 46DE BM3ENT01670CLR 73 MOVE MODE NPN 10 BM3ENT01680CLR EXSR GETPRG BM3ENT0001690CLR SETOF 606173 BM3ENT01700CLR GOTO SAMREC BM3ENT01710CLR CHKNUM TAG BM3ENT01720CLR MOVELBUFFER MODE BM3ENT01730CLR MODE COMP '@' 20 BM3ENT01740CLR 20N42 GOTO OUTREC BM3ENT01750CLR SAN,N COMP 'N' 19 BM3ENT0001760CLRN19 GOTO CHKVER BM3ENT01770CLR Z-ADDSLN,N VL 20 BM3ENT01780CLR MOVELBUFFER VAR 15 BM3ENT01790CLR EXIT SUBRAJ BM3ENT01800CLR RLABL VL BM3ENT01810CLR RLABL VAR BM3ENT01820CLR MOVELVAR BUFFER BM3ENT0001830CLR Z-ADDVL BLNGTH BM3ENT01840CLR EXSR EXCPT BM3ENT01850CLR SETOF 19 BM3ENT01860CLR CHKVER TAG BM3ENT01870CLRN42 GOTO MOVBUF BM3ENT01880CLR TBUF COMP BUFFER 2020 BM3ENT01890CLRN20 GOTO MOVBUF BM3ENT0001900CLR MOVEL'KP VERIF'WORD BM3ENT01910CLR MOVE 'Y ERROR 'WORD BM3ENT01920CLR MOVELWORD BUFFER BM3ENT01930CLR MOVE 'R' TYPE BM3ENT01940CLR Z-ADD6 MASK ONLY 'R' OR 'E'BM3ENT01950CLR EXSR CRTCOM BM3ENT01960CLR RCODE COMP 'R' 20 BM3ENT0001970CLR 20 GOTO OUTFLD BM3ENT01980CLR MOVBUF TAG BM3ENT01990CLR Z-ADDSST,N TSTRT 30 BM3ENT02000CLR Z-ADDSLN,N NCHARS 30 BM3ENT02010CLR Z-ADD1 SSTRT BM3ENT02020CLR EXIT SUBRMV BM3ENT02030CLR RLABL BUFFER BM3ENT0002040CLR RLABL SSTRT BM3ENT02050CLR RLABL RECORD BM3ENT02060CLR RLABL TSTRT BM3ENT02070CLR RLABL NCHARS BM3ENT02080CLR GOTO LOOP BM3ENT02090CLR RITDUP TAG BM3ENT02100CLR EXSR MVRECD BM3ENT0002110CLR SETON 19 BM3ENT02120CLR Z-ADDSLN,N BLNGTH BM3ENT02130CLRN27 EXSR EXCPT BM3ENT02140CLR SETOF 19 BM3ENT02150CLR GOTO MOVBUF BM3ENT02160CLR OUTREC TAG BM3ENT02170CLR SETON 187084 BM3ENT0002180CLR SETON 85 BM3ENT02190CLR EXCPT BM3ENT02200CLR EXSR EXCPT BM3ENT02210CLR SETOF 708485 BM3ENT02220CLR MOVELRECORD OLDREC128 BM3ENT02230CLR NP,PN COMP 0 72 BM3ENT02240CLRN72 GOTO NXTREC BM3ENT0002250CLR MOVE NP,PN NPN BM3ENT02260CLR EXSR GETPRG BM3ENT02270CLR SETOF 72 BM3ENT02280CLR GOTO NXTREC BM3ENT02290CLR EOJ TAG BM3ENT02300C********************************************************************BM3ENT02310C* BM3ENT0002320C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION BM3ENT02330C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. BM3ENT02340C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. BM3ENT02350C* BM3ENT02360C********************************************************************BM3ENT02370CSR GETPRG BEGSR BM3ENT02380CSR 61 GOTO JMPOUT BM3ENT0002390CSR 72 BM3ENT02400COR 73 GOTO CHKPN BM3ENT02410CSR GETPNO TAG BM3ENT02420CSR MOVEL'PROG # -'WORD BM3ENT02430CSR Z-ADD8 OLN BM3ENT02440CSR Z-ADD1 ILN BM3ENT02450CSR EXSR TYPES BM3ENT0002460CSR MOVELBUFFER NPN 10 BM3ENT02470CSR CHKPN TAG BM3ENT02480CSR NPN COMP 0 2020 BM3ENT02490CSRN20 NPN COMP 4 20 BAD PROG# BM3ENT02500CSR 20 SETON 82 BM3ENT02510CSR 82 EXSR EXCPT BM3ENT02520CSR SETOF 82 BM3ENT0002530CSR 20 GOTO GETPNO TRY PROG# AGAINBM3ENT02540CSR MOVE NPN PN 10 INBM3ENT02550CSR MOVE PN NAME10 10 BM3ENT02560CSRN43 SNM,PN COMP ' ' 6060 BM3ENT02570CSR 60 PN SUB 1 BP 20 BM3ENT02580CSR 60 BP MULT 20 BP BM3ENT02590CSR 72 GOTO SETHED BM3ENT0002600CSR 73 GOTO JMPOUT BM3ENT02610CSR 60 GOTO JMPOUT BM3ENT02620CSR GETPNM TAG BM3ENT02630CSR MOVEL'PROG NAM'WORD BM3ENT02640CSR MOVE 'E - 'WORD BM3ENT02650CSR Z-ADD11 OLN BM3ENT02660CSR Z-ADD6 ILN BM3ENT0002670CSR EXSR TYPES BM3ENT02680CSR MOVELBUFFER PNAME 8 BM3ENT02690CSR MOVE ' ' PNAME BM3ENT02700CSR CHNPRG TAG BM3ENT02710CSR PNAME CHAINKPROGS 27 BM3ENT02720CSRN27 MOVELPNAME SNM,PN BM3ENT02730CSRN27 GOTO LOADIT BM3ENT0002740CSR MOVEL' 'WORD BM3ENT02750CSR MOVELPNAME WORD BM3ENT02760CSR MOVE 'ABSENT 'WORD BM3ENT02770CSR MOVE 'R' TYPE 1 BM3ENT02780CSR MOVELWORD BUFFER BM3ENT02790CSR Z-ADD7 MASK 10 BM3ENT02800CSR Z-ADD16 BLNGTH BM3ENT0002810CSR EXSR CRTCOM BM3ENT02820CSR RCODE COMP 'E' 20 BM3ENT02830CSR PRGMT TAG BM3ENT02840C*R 20 EXSR PROGMT BM3ENT02850C*R 20 GOTO CHNPRG BM3ENT02860CSR GOTO GETPNM BM3ENT02870CSR LOADIT TAG BM3ENT0002880CSR Z-ADD14 OLN BM3ENT02890CSR Z-ADD1 ILN BM3ENT02900CSR MOVEL'NEXT PRO'WORD BM3ENT02910CSR MOVE 'G # - 'WORD BM3ENT02920CSR EXSR TYPES BM3ENT02930CSR MOVELBUFFER NP,PN BM3ENT02940CSR PN SUB 1 BP BM3ENT0002950CSR BP MULT 20 BP BM3ENT02960CSR BP ADD 1 N 20 BM3ENT02970CSR Z-ADD1 X 20 BM3ENT02980CSR BLDARY TAG BM3ENT02990CSR FN COMP B72 20 BM3ENT03000CSR 20 N SUB 1 MAXFLD 20 BM3ENT03010CSR 20 MOVE MAXFLD SMX,PN BM3ENT0003020CSR 20 GOTO JMPOUT BM3ENT03030CSR MOVE FN SFN,N FIELD NAME BM3ENT03040CSR MOVE AN SAN,N ALPHA OR NUMER BM3ENT03050CSR MOVE AD SAD,N AUTO DUP BM3ENT03060CSR MOVE ST SST,N START POSITION BM3ENT03070CSR MOVE LN SLN,N BM3ENT03080CSR MVX TAG BM3ENT0003090CSR MOVE X PNAME BM3ENT03100CSR PNAME CHAINKPROGS 20 BM3ENT03110CSR X ADD 1 X BM3ENT03120CSRN20 X COMP 20 20 BM3ENT03130CSR 20 Z-ADDN MAXFLD BM3ENT03140CSR 20 MOVE MAXFLD SMX,PN BM3ENT03150CSR DCODE COMP 'D' 21 BM3ENT0003160CSR 21N20 GOTO MVX BM3ENT03170CSRN20 N ADD 1 N BM3ENT03180CSRN20 GOTO BLDARY BM3ENT03190CSR JMPOUT TAG BM3ENT03200CSR 43 GOTO ENDGET BM3ENT03210CSR 41 GOTO SETHED BM3ENT03220CSR MOVEL'AUTO-DUP'WORD BM3ENT0003230CSR MOVE ' - 'WORD BM3ENT03240CSR Z-ADD11 OLN BM3ENT03250CSR Z-ADD1 ILN BM3ENT03260CSR EXSR TYPES BM3ENT03270CSR MOVELBUFFER AUTO 1 BM3ENT03280CSR AUTO COMP 'O' 90AUTO-DUP ON BM3ENT03290CSR SETHED TAG BM3ENT0003300CSR MOVELSNM,PN NAME10 BM3ENT03310CSR MOVELNAME10 WORD BM3ENT03320CSR MOVE SMX,PN MAXFLD 20 BM3ENT03330CSR 90 MOVE ' ON' WORD BM3ENT03340CSRN90 MOVE 'OFF' WORD BM3ENT03350CSR MOVELWORD HEAD 40 BM3ENT03360CSR ENDGET ENDSR BM3ENT0003370C********************************************************************BM3ENT03380C* BM3ENT03390C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST BM3ENT03400C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE BM3ENT03410C* CHANGED BM3ENT03420C* BM3ENT03430C********************************************************************BM3ENT0003440CSR GETSEQ BEGSR BM3ENT03450CSR MOVEL'SEQ # - 'WORD BM3ENT03460CSR Z-ADD8 OLN BM3ENT03470CSR Z-ADD5 ILN BM3ENT03480CSR EXSR TYPES BM3ENT03490CSR Z-ADD5 VL BM3ENT03500CSR MOVELBUFFER VAR BM3ENT0003510CSR EXIT SUBRAJ BM3ENT03520CSR RLABL VL BM3ENT03530CSR RLABL VAR BM3ENT03540CSR MOVELVAR SEQNO BM3ENT03550CSR SEQNO COMP 0 20 BM3ENT03560CSRN20 Z-ADD1 SEQNO BM3ENT03570CSR SETON 95 BM3ENT0003580CSR ENDSEQ ENDSR BM3ENT03590C********************************************************************BM3ENT03600C* BM3ENT03610C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO BM3ENT03620C* BM3ENT03630C********************************************************************BM3ENT03640CSR GETREC BEGSR BM3ENT0003650CSR SEQRD TAG BM3ENT03660CSR EXSR TSTSEQ BM3ENT03670CSR 94 EXSR GETSEQ BM3ENT03680CSR 94 GOTO SEQRD BM3ENT03690CSR SEQNO CHAINBM3OUT 56 BM3ENT03700CSR MOVELRECORD TST 2 BM3ENT03710CSR TST COMP '<>' 99 BM3ENT0003720CSR 40N99 SEQNO ADD 1 SEQNO BM3ENT03730CSR 40N99 GOTO SEQRD BM3ENT03740CSR 41 99 EXSR NOCHG BM3ENT03750CSR 41 99 GOTO SEQRD BM3ENT03760CSR 56 SETON 88 BM3ENT03770CSR 88 EXSR EXCPT BM3ENT03780CSR SETOF 88 BM3ENT0003790CSR 56 EXSR GETSEQ BM3ENT03800CSR 56 GOTO SEQRD BM3ENT03810CSR ENDSR BM3ENT03820C********************************************************************BM3ENT03830C* BM3ENT03840C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY BM3ENT03850C* IS DONE IF A RUBOUT IS USED BM3ENT0003860C* BM3ENT03870C********************************************************************BM3ENT03880CSR TYPES BEGSR BM3ENT03890CSR OVER TAG BM3ENT03900CSR Z-ADDOLN BLNGTH BM3ENT03910CSR MOVELWORD BUFFER BM3ENT03920CSR MOVE 'S' TYPE BM3ENT0003930CSR EXSR CRTCOM BM3ENT03940CSR MOVE 'A' TYPE BM3ENT03950CSR Z-ADDILN BLNGTH BM3ENT03960CSR EXSR CRTCOM BM3ENT03970CSR RCODE COMP 'R' 25 BM3ENT03980CSR 25 EXSR SKIP BM3ENT03990CSR 25 GOTO OVER BM3ENT0004000CSR RCODE COMP 'O' 25 BM3ENT04010CSR 25 EXSR SKIP BM3ENT04020CSR ENDSR BM3ENT04030C********************************************************************BM3ENT04040C* BM3ENT04050C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT BM3ENT04060C* BM3ENT0004070C********************************************************************BM3ENT04080CSR SKIP BEGSR BM3ENT04090CSR MOVELBUFFER NBUF 1 BM3ENT04100CSR MOVEL' ' BUFFER BM3ENT04110CSR Z-ADD1 BLNGTH BM3ENT04120CSR MOVE 'T' TYPE BM3ENT04130CSR EXSR CRTCOM BM3ENT0004140CSR MOVELNBUF BUFFER BM3ENT04150CSR ENDSR BM3ENT04160C********************************************************************BM3ENT04170C* BM3ENT04180C* BM3ENT04190C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED BM3ENT04200C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER BM3ENT0004210C* BM3ENT04220CSR MVRECD BEGSR BM3ENT04230CSR MOVELB72 BUFFER BM3ENT04240CSR Z-ADD1 TSTRT BM3ENT04250CSR Z-ADDSST,N SSTRT BM3ENT04260CSR Z-ADDSLN,N NCHARS BM3ENT04270CSR EXIT SUBRMV BM3ENT0004280CSR RLABL OLDREC BM3ENT04290CSR RLABL SSTRT 30 BM3ENT04300CSR RLABL BUFFER BM3ENT04310CSR RLABL TSTRT 30 BM3ENT04320CSR RLABL NCHARS 30 BM3ENT04330CSR ENDSR BM3ENT04340C********************************************************************BM3ENT0004350CSR EXCPT BEGSR BM3ENT04360CSRN81N82N83 BM3ENT04370CANN84N88 GOTO PUTOUT BM3ENT04380CSR MOVELB72 BUFFER BM3ENT04390CSR 81 MOVELMSG,1 BUFFER BM3ENT04400CSR 83 MOVELMSG,2 BUFFER BM3ENT04410CSR 88 MOVELMSG,3 BUFFER BM3ENT0004420CSR 82 MOVELMSG,4 BUFFER BM3ENT04430CSRN84 GOTO PUTOUT BM3ENT04440CSRN85 MOVELSFN,N BUFFER BM3ENT04450CSRN18 Z-ADD20 BLNGTH BM3ENT04460CSRN18 GOTO PUTOUT BM3ENT04470CSR MOVELHEAD BUFFER BM3ENT04480CSR MOVE 'T' TYPE BM3ENT0004490CSR Z-ADD69 BLNGTH BM3ENT04500CSR EXSR CRTCOM BM3ENT04510CSR MOVELSFN,N BUFFER BM3ENT04520CSR Z-ADD20 BLNGTH BM3ENT04530CSR PUTOUT TAG BM3ENT04540CSR MOVE 'S' TYPE BM3ENT04550CSR EXSR CRTCOM BM3ENT0004560CSR ENDSR BM3ENT04570C* BM3ENT04580CSR ALMTS BEGSR BM3ENT04590CSR MOVE 'C' TYPE 1 BM3ENT04600CSR Z-ADD0 BLNGTH 20 BM3ENT04610CSR MOVE ' ' RCODE 1 BM3ENT04620CSR Z-ADD0 MASK 10 BM3ENT0004630CSR Z-ADD0 DTYPE 10 BM3ENT04640CSR EXSR CRTCOM BM3ENT04650CSR MOVELARY1,1 BUFFER BM3ENT04660CSR MOVE 'S' TYPE BM3ENT04670CSR Z-ADD50 BLNGTH BM3ENT04680CSR EXSR CRTCOM BM3ENT04690CSR MOVE 'A' TYPE BM3ENT0004700CSR Z-ADD5 BLNGTH BM3ENT04710CSR Z-ADD1 DTYPE BM3ENT04720CSR EXSR CRTCOM BM3ENT04730CSR EXSR SKIP BM3ENT04740CSR RCODE COMP 'R' 86 BM3ENT04750CSR Z-ADD5 VL BM3ENT04760CSR MOVELBUFFER VAR BM3ENT0004770CSR EXIT SUBRAJ BM3ENT04780CSR RLABL VL BM3ENT04790CSR RLABL VAR BM3ENT04800CSR MOVELVAR BUFFER BM3ENT04810CSR MOVELBUFFER LOW 50 BM3ENT04820CSR MOVELARY1,2 BUFFER BM3ENT04830CSR MOVE 'S' TYPE BM3ENT0004840CSR Z-ADD50 BLNGTH BM3ENT04850CSR EXSR CRTCOM BM3ENT04860CSR MOVE 'A' TYPE BM3ENT04870CSR Z-ADD5 BLNGTH BM3ENT04880CSR Z-ADD1 DTYPE BM3ENT04890CSR EXSR CRTCOM BM3ENT04900CSR RCODE COMP 'R' 87 BM3ENT0004910CSR Z-ADD5 VL BM3ENT04920CSR MOVELBUFFER VAR BM3ENT04930CSR EXIT SUBRAJ BM3ENT04940CSR RLABL VL BM3ENT04950CSR RLABL VAR BM3ENT04960CSR MOVELVAR BUFFER BM3ENT04970CSR MOVELBUFFER HIGH 50 BM3ENT0004980CSR MOVE 'C' TYPE BM3ENT04990CSR EXSR CRTCOM BM3ENT05000CSR 86 BM3ENT05010COR 87 GOTO ALMTS BM3ENT05020CSR Z-ADD0 DTYPE BM3ENT05030CSR ENDSR BM3ENT05040CSR CRTCOM BEGSR BM3ENT0005050CSR EXITFSUBRCM BM3ENT05060CSR RLABL BUFFER BM3ENT05070CSR RLABL TYPE BM3ENT05080CSR RLABL BLNGTH BM3ENT05090CSR RLABL RCODE BM3ENT05100CSR RLABL MASK BM3ENT05110CSR RLABL DTYPE BM3ENT0005120CSR ENDSR BM3ENT05130CSR PUTSEQ BEGSR BM3ENT05140CSR MOVELMSG,5 BUFFER 72 BM3ENT05150CSR MOVE 'S' TYPE BM3ENT05160CSR Z-ADD25 BLNGTH BM3ENT05170CSR EXSR CRTCOM BM3ENT05180CSR MOVELSEQNO BUFFER BM3ENT0005190CSR MOVE 'T' TYPE BM3ENT05200CSR Z-ADD5 BLNGTH BM3ENT05210CSR EXSR CRTCOM BM3ENT05220CSR ENDSR BM3ENT05230CSR TSTSEQ BEGSR BM3ENT05240CSR SETOF 949697 BM3ENT05250CSR SEQNO COMP LOW 989698 BM3ENT0005260CSR 98 SEQNO COMP HIGH 979898 BM3ENT05270CSR 98 GOTO ENDTST BM3ENT05280CSR 40 96 MOVELMSG,6 BUFFER BM3ENT05290CSR 40 97 MOVELMSG,7 BUFFER BM3ENT05300CSRN40 MOVELMSG,8 BUFFER BM3ENT05310CSRN40 SETON 94 BM3ENT05320CSR MOVE 'T' TYPE BM3ENT0005330CSR Z-ADD25 BLNGTH BM3ENT05340CSR EXSR CRTCOM BM3ENT05350CSR 40 97 MOVE 'F' TYPE BM3ENT05360CSR 40 97 EXSR CRTCOM BM3ENT05370CSR ENDTST ENDSR BM3ENT05380CSR NOCHG BEGSR BM3ENT05390CSR MOVELMSG,9 BUFFER BM3ENT0005400CSR MOVE 'T' TYPE BM3ENT05410CSR Z-ADD25 BLNGTH BM3ENT05420CSR EXSR CRTCOM BM3ENT05430CSR EXSR GETSEQ BM3ENT05440CSR ENDSR BM3ENT05450C********************************************************************BM3ENT05460OBM3OUT E 70N56 BM3ENT0005470O RECORD 128 BM3ENT05480O 42 128 'X' BM3ENT05490O SEQNO 127 BM3ENT** 005500ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005510ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005520ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00553000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005540** 005550MODE MUST BE A,C,V,OR E 005560FIRST FIELD NAME BLANK 005570INVALID SEQ # 005580PROG# MUST BE FROM 1-4 005590CURRENT SEQUENCE NBR 00560000SEQNO TOO LOW 005610RUN EDIT PROG-FILE FULL 005620SEQNO NOT IN YOUR LIMITS 005630ILLEGAL CHANGE-NO DATA 005640** 005650ENTER BEGINNING RELATIVE RECORD NUMBER 005660ENTER ENDING RELATIVE RECORD NUMBER 00567000/* 005680_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(( 7$OTXBM1EN P999999041178(000010H S BM1ENT00020X DECK-ID M25 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM1ENT00030F* ENTER PRODUCT STRUCTURE UPDATES BM1ENT00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM1ENT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM1ENT00060F* CONTROL DATA PROPRIETARY PRODUCT BM1ENT00070F* BM1ENT0000080FBM1DUM IPE F 72 DISK BM1ENT00090FKPROGS IC F 36R 8AI 1 DISK BM1ENT00100FBM1OUT UC F 128R DISK BM1ENT00110F********************************************************************BM1ENT00120F* INDICATOR FUNCTION LIST BM1ENT00130F* 01 DUMMY RECORD BM1ENT00140F* 02 KEYPYNCH PARAMETER FILE BM1ENT0000150F* 05 KEYPUNCH DATA FILE BM1ENT00160F* 18 BM1ENT00170F* 19 BM1ENT00180F* 20 BM1ENT00190F* 21 BM1ENT00200F* 25 RETRY ON RUBOUT BM1ENT00210F* 27 AUTO DUP BM1ENT0000220F* 28 BM1ENT00230F* 29 BM1ENT00240F* 40 MODE IS A-ADD BM1ENT00250F* 41 MODE IS C-CHANGE BM1ENT00260F* 42 MODE IS V-VERIFY BM1ENT00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS BM1ENT00280F* 44 MODE IS E-END OF JOB BM1ENT0000290F* 56 SEQ NBR NOT IN KPFILE BM1ENT00300F* 60 NEW PROGRAM NBR ONLY BM1ENT00310F* 61 AUTO DUP ONLY BM1ENT00320F* 70 BM1ENT00330F* 72 BM1ENT00340F* 73 MODE IS LESS THAN OR = 4 BM1ENT00350F* 81 MODE IS INVALID BM1ENT0000360F* 82 BAD PROG NBR BM1ENT00370F* 83 FIRST FIELD NAME BLANK BM1ENT00380F* 84 OUTPUT FIELD NAME BM1ENT00390F* 85 BM1ENT00400F* 88 SEQ NBR NOT IN KPFILE BM1ENT00410F* 90 AUTO DUP ON BM1ENT00420F* 95 BM1ENT0000430F* 98 RCD WITHIN OPERATOR LIMITS BM1ENT00440F* LR BM1ENT00450F********************************************************************BM1ENT00460E MSG 1 10 25 BM1ENT00470E SFN 80 20 BM1ENT00480E SAN 80 1 BM1ENT00490E SAD 80 1 BM1ENT0000500E SST 80 3 0 BM1ENT00510E SLN 80 2 0 BM1ENT00520E SNM 4 6 BM1ENT00530E SMX 4 2 0 BM1ENT00540E NP 4 1 0 BM1ENT00550E ARY1 1 2 50 BM1ENT00560IBM1DUM NS 01 BM1ENT0000570I 1 1 A BM1ENT00580IKPROGS NS 02 BM1ENT00590I 9 28 FN BM1ENT00600I 29 29 AN BM1ENT00610I 30 30 AD BM1ENT00620I 31 33 ST BM1ENT00630I 34 35 LN BM1ENT0000640I 36 36 DCODE BM1ENT00650IBM1OUT NS 05 BM1ENT00660I 1 128 RECORD BM1ENT00670C MOVE ' ' B72 72 BM1ENT00680C EXSR ALMTS BM1ENT00690C Z-ADDLOW SEQNO BM1ENT00700C NLR SETON LR BM1ENT0000710CLR START TAG BM1ENT00720CLR MOVEL'' WORD BM1ENT01590CLR Z-ADD1 OLN BM1ENT01600CLR Z-ADD1 ILN BM1ENT01610CLR EXSR TYPES BM1ENT0001620CLR MOVELBUFFER MODE BM1ENT01630CLR MODE COMP '4' 7373 BM1ENT01640CLR MODE COMP 'P' 60 NEW PROG#ONLY BM1ENT01650CLR MODE COMP 'D' 61 AUTO-DUP ONLY BM1ENT01660CLRN60N61N73 GOTO CHKMOD NEW 46DE BM1ENT01670CLR 73 MOVE MODE NPN 10 BM1ENT01680CLR EXSR GETPRG BM1ENT0001690CLR GOTO SAMREC BM1ENT01700CLR CHKNUM TAG BM1ENT01710CLR MOVELBUFFER MODE BM1ENT01720CLR MODE COMP '@' 20 BM1ENT01730CLR 20N42 GOTO OUTREC BM1ENT01740CLR SAN,N COMP 'N' 19 BM1ENT01750CLRN19 GOTO CHKVER BM1ENT0001760CLR Z-ADDSLN,N VL 20 BM1ENT01770CLR MOVELBUFFER VAR 15 BM1ENT01780CLR EXIT SUBRAJ BM1ENT01790CLR RLABL VL BM1ENT01800CLR RLABL VAR BM1ENT01810CLR MOVELVAR BUFFER BM1ENT01820CLR Z-ADDVL BLNGTH BM1ENT0001830CLR EXSR EXCPT BM1ENT01840CLR SETOF 19 BM1ENT01850CLR CHKVER TAG BM1ENT01860CLRN42 GOTO MOVBUF BM1ENT01870CLR TBUF COMP BUFFER 2020 BM1ENT01880CLRN20 GOTO MOVBUF BM1ENT01890CLR MOVEL'KP VERIF'WORD BM1ENT0001900CLR MOVE 'Y ERROR 'WORD BM1ENT01910CLR MOVELWORD BUFFER BM1ENT01920CLR MOVE 'R' TYPE BM1ENT01930CLR Z-ADD6 MASK ONLY 'R' OR 'E'BM1ENT01940CLR EXSR CRTCOM BM1ENT01950CLR RCODE COMP 'R' 20 BM1ENT01960CLR 20 GOTO OUTFLD BM1ENT0001970CLR MOVBUF TAG BM1ENT01980CLR Z-ADDSST,N TSTRT 30 BM1ENT01990CLR Z-ADDSLN,N NCHARS 30 BM1ENT02000CLR Z-ADD1 SSTRT BM1ENT02010CLR EXIT SUBRMV BM1ENT02020CLR RLABL BUFFER BM1ENT02030CLR RLABL SSTRT BM1ENT0002040CLR RLABL RECORD BM1ENT02050CLR RLABL TSTRT BM1ENT02060CLR RLABL NCHARS BM1ENT02070CLR GOTO LOOP BM1ENT02080CLR RITDUP TAG BM1ENT02090CLR EXSR MVRECD BM1ENT02100CLR SETON 19 BM1ENT0002110CLR Z-ADDSLN,N BLNGTH BM1ENT02120CLRN27 EXSR EXCPT BM1ENT02130CLR SETOF 19 BM1ENT02140CLR GOTO MOVBUF BM1ENT02150CLR OUTREC TAG BM1ENT02160CLR SETON 187084 BM1ENT02170CLR SETON 85 BM1ENT0002180CLR EXCPT BM1ENT02190CLR EXSR EXCPT BM1ENT02200CLR SETOF 708485 BM1ENT02210CLR MOVELRECORD OLDREC128 BM1ENT02220CLR NP,PN COMP 0 72 BM1ENT02230CLRN72 GOTO NXTREC BM1ENT02240CLR MOVE NP,PN NPN BM1ENT0002250CLR EXSR GETPRG BM1ENT02260CLR SETOF 72 BM1ENT02270CLR GOTO NXTREC BM1ENT02280CLR EOJ TAG BM1ENT02290C********************************************************************BM1ENT02300C* BM1ENT02310C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION BM1ENT0002320C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. BM1ENT02330C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. BM1ENT02340C* BM1ENT02350C********************************************************************BM1ENT02360CSR GETPRG BEGSR BM1ENT02370CSR 61 GOTO JMPOUT BM1ENT02380CSR 72 BM1ENT0002390COR 73 GOTO CHKPN BM1ENT02400CSR GETPNO TAG BM1ENT02410CSR MOVEL'PROG # -'WORD BM1ENT02420CSR Z-ADD8 OLN BM1ENT02430CSR Z-ADD1 ILN BM1ENT02440CSR EXSR TYPES BM1ENT02450CSR MOVELBUFFER NPN 10 BM1ENT0002460CSR CHKPN TAG BM1ENT02470CSR NPN COMP 0 2020 BM1ENT02480CSRN20 NPN COMP 4 20 BAD PROG# BM1ENT02490CSR 20 SETON 82 BM1ENT02500CSR 82 EXSR EXCPT BM1ENT02510CSR SETOF 82 BM1ENT02520CSR 20 GOTO GETPNO TRY PROG# AGAINBM1ENT0002530CSR MOVE NPN PN 10 INBM1ENT02540CSR MOVE PN NAME10 10 BM1ENT02550CSRN43 SNM,PN COMP ' ' 6060 BM1ENT02560CSR 60 PN SUB 1 BP 20 BM1ENT02570CSR 60 BP MULT 20 BP BM1ENT02580CSR 72 GOTO SETHED BM1ENT02590CSR 73 GOTO JMPOUT BM1ENT0002600CSR 60 GOTO JMPOUT BM1ENT02610CSR GETPNM TAG BM1ENT02620CSR MOVEL'PROG NAM'WORD BM1ENT02630CSR MOVE 'E - 'WORD BM1ENT02640CSR Z-ADD11 OLN BM1ENT02650CSR Z-ADD6 ILN BM1ENT02660CSR EXSR TYPES BM1ENT0002670CSR MOVELBUFFER PNAME 8 BM1ENT02680CSR MOVE ' ' PNAME BM1ENT02690CSR CHNPRG TAG BM1ENT02700CSR PNAME CHAINKPROGS 27 BM1ENT02710CSRN27 MOVELPNAME SNM,PN BM1ENT02720CSRN27 GOTO LOADIT BM1ENT02730CSR MOVEL' 'WORD BM1ENT0002740CSR MOVELPNAME WORD BM1ENT02750CSR MOVE 'ABSENT 'WORD BM1ENT02760CSR MOVE 'R' TYPE 1 BM1ENT02770CSR MOVELWORD BUFFER BM1ENT02780CSR Z-ADD7 MASK 10 BM1ENT02790CSR Z-ADD16 BLNGTH BM1ENT02800CSR EXSR CRTCOM BM1ENT0002810CSR RCODE COMP 'E' 20 BM1ENT02820CSR PRGMT TAG BM1ENT02830C*R 20 EXSR PROGMT BM1ENT02840C*R 20 GOTO CHNPRG BM1ENT02850CSR GOTO GETPNM BM1ENT02860CSR LOADIT TAG BM1ENT02870CSR Z-ADD14 OLN BM1ENT0002880CSR Z-ADD1 ILN BM1ENT02890CSR MOVEL'NEXT PRO'WORD BM1ENT02900CSR MOVE 'G # - 'WORD BM1ENT02910CSR EXSR TYPES BM1ENT02920CSR MOVELBUFFER NP,PN BM1ENT02930CSR PN SUB 1 BP BM1ENT02940CSR BP MULT 20 BP BM1ENT0002950CSR BP ADD 1 N 20 BM1ENT02960CSR Z-ADD1 X 20 BM1ENT02970CSR BLDARY TAG BM1ENT02980CSR FN COMP B72 20 BM1ENT02990CSR 20 N SUB 1 MAXFLD 20 BM1ENT03000CSR 20 MOVE MAXFLD SMX,PN BM1ENT03010CSR 20 GOTO JMPOUT BM1ENT0003020CSR MOVE FN SFN,N FIELD NAME BM1ENT03030CSR MOVE AN SAN,N ALPHA OR NUMER BM1ENT03040CSR MOVE AD SAD,N AUTO DUP BM1ENT03050CSR MOVE ST SST,N START POSITION BM1ENT03060CSR MOVE LN SLN,N BM1ENT03070CSR MVX TAG BM1ENT03080CSR MOVE X PNAME BM1ENT0003090CSR PNAME CHAINKPROGS 20 BM1ENT03100CSR X ADD 1 X BM1ENT03110CSRN20 X COMP 20 20 BM1ENT03120CSR 20 Z-ADDN MAXFLD BM1ENT03130CSR 20 MOVE MAXFLD SMX,PN BM1ENT03140CSR DCODE COMP 'D' 21 BM1ENT03150CSR 21N20 GOTO MVX BM1ENT0003160CSRN20 N ADD 1 N BM1ENT03170CSRN20 GOTO BLDARY BM1ENT03180CSR JMPOUT TAG BM1ENT03190CSR 43 GOTO ENDGET BM1ENT03200CSR 41 GOTO SETHED BM1ENT03210CSR MOVEL'AUTO-DUP'WORD BM1ENT03220CSR MOVE ' - 'WORD BM1ENT0003230CSR Z-ADD11 OLN BM1ENT03240CSR Z-ADD1 ILN BM1ENT03250CSR EXSR TYPES BM1ENT03260CSR MOVELBUFFER AUTO 1 BM1ENT03270CSR AUTO COMP 'O' 90AUTO-DUP ON BM1ENT03280CSR SETHED TAG BM1ENT03290CSR MOVELSNM,PN NAME10 BM1ENT0003300CSR MOVELNAME10 WORD BM1ENT03310CSR MOVE SMX,PN MAXFLD 20 BM1ENT03320CSR 90 MOVE ' ON' WORD BM1ENT03330CSRN90 MOVE 'OFF' WORD BM1ENT03340CSR MOVELWORD HEAD 40 BM1ENT03350CSR ENDGET ENDSR BM1ENT03360C********************************************************************BM1ENT0003370C* BM1ENT03380C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST BM1ENT03390C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE BM1ENT03400C* CHANGED BM1ENT03410C* BM1ENT03420C********************************************************************BM1ENT03430CSR GETSEQ BEGSR BM1ENT0003440CSR MOVEL'SEQ # - 'WORD BM1ENT03450CSR Z-ADD8 OLN BM1ENT03460CSR Z-ADD5 ILN BM1ENT03470CSR EXSR TYPES BM1ENT03480CSR Z-ADD5 VL BM1ENT03490CSR MOVELBUFFER VAR BM1ENT03500CSR EXIT SUBRAJ BM1ENT0003510CSR RLABL VL BM1ENT03520CSR RLABL VAR BM1ENT03530CSR MOVELVAR SEQNO BM1ENT03540CSR SEQNO COMP 0 20 BM1ENT03550CSRN20 Z-ADD1 SEQNO BM1ENT03560CSR SETON 95 BM1ENT03570CSR ENDSEQ ENDSR BM1ENT0003580C********************************************************************BM1ENT03590C* BM1ENT03600C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO BM1ENT03610C* BM1ENT03620C********************************************************************BM1ENT03630CSR GETREC BEGSR BM1ENT03640CSR SEQRD TAG BM1ENT0003650CSR EXSR TSTSEQ BM1ENT03660CSR 94 EXSR GETSEQ BM1ENT03670CSR 94 GOTO SEQRD BM1ENT03680CSR SEQNO CHAINBM1OUT 56 BM1ENT03690CSR MOVELRECORD TST 2 BM1ENT03700CSR TST COMP '<>' 99 BM1ENT03710CSR 40N99 SEQNO ADD 1 SEQNO BM1ENT0003720CSR 40N99 GOTO SEQRD BM1ENT03730CSR 41 99 EXSR NOCHG BM1ENT03740CSR 41 99 GOTO SEQRD BM1ENT03750CSR 56 SETON 88 BM1ENT03760CSR 88 EXSR EXCPT BM1ENT03770CSR SETOF 88 BM1ENT03780CSR 56 EXSR GETSEQ BM1ENT0003790CSR 56 GOTO SEQRD BM1ENT03800CSR ENDSR BM1ENT03810C********************************************************************BM1ENT03820C* BM1ENT03830C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY BM1ENT03840C* IS DONE IF A RUBOUT IS USED BM1ENT03850C* BM1ENT0003860C********************************************************************BM1ENT03870CSR TYPES BEGSR BM1ENT03880CSR OVER TAG BM1ENT03890CSR Z-ADDOLN BLNGTH BM1ENT03900CSR MOVELWORD BUFFER BM1ENT03910CSR MOVE 'S' TYPE BM1ENT03920CSR EXSR CRTCOM BM1ENT0003930CSR MOVE 'A' TYPE BM1ENT03940CSR Z-ADDILN BLNGTH BM1ENT03950CSR EXSR CRTCOM BM1ENT03960CSR RCODE COMP 'R' 25 BM1ENT03970CSR 25 EXSR SKIP BM1ENT03980CSR 25 GOTO OVER BM1ENT03990CSR RCODE COMP 'O' 25 BM1ENT0004000CSR 25 EXSR SKIP BM1ENT04010CSR ENDSR BM1ENT04020C********************************************************************BM1ENT04030C* BM1ENT04040C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT BM1ENT04050C* BM1ENT04060C********************************************************************BM1ENT0004070CSR SKIP BEGSR BM1ENT04080CSR MOVELBUFFER NBUF 1 BM1ENT04090CSR MOVEL' ' BUFFER BM1ENT04100CSR Z-ADD1 BLNGTH BM1ENT04110CSR MOVE 'T' TYPE BM1ENT04120CSR EXSR CRTCOM BM1ENT04130CSR MOVELNBUF BUFFER BM1ENT0004140CSR ENDSR BM1ENT04150C********************************************************************BM1ENT04160C* BM1ENT04170C* BM1ENT04180C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED BM1ENT04190C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER BM1ENT04200C* BM1ENT0004210CSR MVRECD BEGSR BM1ENT04220CSR MOVELB72 BUFFER BM1ENT04230CSR Z-ADD1 TSTRT BM1ENT04240CSR Z-ADDSST,N SSTRT BM1ENT04250CSR Z-ADDSLN,N NCHARS BM1ENT04260CSR EXIT SUBRMV BM1ENT04270CSR RLABL OLDREC BM1ENT0004280CSR RLABL SSTRT 30 BM1ENT04290CSR RLABL BUFFER BM1ENT04300CSR RLABL TSTRT 30 BM1ENT04310CSR RLABL NCHARS 30 BM1ENT04320CSR ENDSR BM1ENT04330C********************************************************************BM1ENT04340CSR EXCPT BEGSR BM1ENT0004350CSRN81N82N83 BM1ENT04360CANN84N88 GOTO PUTOUT BM1ENT04370CSR MOVELB72 BUFFER BM1ENT04380CSR 81 MOVELMSG,1 BUFFER BM1ENT04390CSR 83 MOVELMSG,2 BUFFER BM1ENT04400CSR 88 MOVELMSG,3 BUFFER BM1ENT04410CSR 82 MOVELMSG,4 BUFFER BM1ENT0004420CSRN84 GOTO PUTOUT BM1ENT04430CSRN85 MOVELSFN,N BUFFER BM1ENT04440CSRN18 Z-ADD20 BLNGTH BM1ENT04450CSRN18 GOTO PUTOUT BM1ENT04460CSR MOVELHEAD BUFFER BM1ENT04470CSR MOVE 'T' TYPE BM1ENT04480CSR Z-ADD69 BLNGTH BM1ENT0004490CSR EXSR CRTCOM BM1ENT04500CSR MOVELSFN,N BUFFER BM1ENT04510CSR Z-ADD20 BLNGTH BM1ENT04520CSR PUTOUT TAG BM1ENT04530CSR MOVE 'S' TYPE BM1ENT04540CSR EXSR CRTCOM BM1ENT04550CSR ENDSR BM1ENT0004560C* BM1ENT04570CSR ALMTS BEGSR BM1ENT04580CSR MOVE 'C' TYPE 1 BM1ENT04590CSR Z-ADD0 BLNGTH 20 BM1ENT04600CSR MOVE ' ' RCODE 1 BM1ENT04610CSR Z-ADD0 MASK 10 BM1ENT04620CSR Z-ADD0 DTYPE 10 BM1ENT0004630CSR EXSR CRTCOM BM1ENT04640CSR MOVELARY1,1 BUFFER BM1ENT04650CSR MOVE 'S' TYPE BM1ENT04660CSR Z-ADD50 BLNGTH BM1ENT04670CSR EXSR CRTCOM BM1ENT04680CSR MOVE 'A' TYPE BM1ENT04690CSR Z-ADD5 BLNGTH BM1ENT0004700CSR Z-ADD1 DTYPE BM1ENT04710CSR EXSR CRTCOM BM1ENT04720CSR EXSR SKIP BM1ENT04730CSR RCODE COMP 'R' 86 BM1ENT04740CSR Z-ADD5 VL BM1ENT04750CSR MOVELBUFFER VAR BM1ENT04760CSR EXIT SUBRAJ BM1ENT0004770CSR RLABL VL BM1ENT04780CSR RLABL VAR BM1ENT04790CSR MOVELVAR BUFFER BM1ENT04800CSR MOVELBUFFER LOW 50 BM1ENT04810CSR MOVELARY1,2 BUFFER BM1ENT04820CSR MOVE 'S' TYPE BM1ENT04830CSR Z-ADD50 BLNGTH BM1ENT0004840CSR EXSR CRTCOM BM1ENT04850CSR MOVE 'A' TYPE BM1ENT04860CSR Z-ADD5 BLNGTH BM1ENT04870CSR Z-ADD1 DTYPE BM1ENT04880CSR EXSR CRTCOM BM1ENT04890CSR RCODE COMP 'R' 87 BM1ENT04900CSR Z-ADD5 VL BM1ENT0004910CSR MOVELBUFFER VAR BM1ENT04920CSR EXIT SUBRAJ BM1ENT04930CSR RLABL VL BM1ENT04940CSR RLABL VAR BM1ENT04950CSR MOVELVAR BUFFER BM1ENT04960CSR MOVELBUFFER HIGH 50 BM1ENT04970CSR MOVE 'C' TYPE BM1ENT0004980CSR EXSR CRTCOM BM1ENT04990CSR 86 BM1ENT05000COR 87 GOTO ALMTS BM1ENT05010CSR Z-ADD0 DTYPE BM1ENT05020CSR ENDSR BM1ENT05030CSR CRTCOM BEGSR BM1ENT05040CSR EXITFSUBRCM BM1ENT0005050CSR RLABL BUFFER BM1ENT05060CSR RLABL TYPE BM1ENT05070CSR RLABL BLNGTH BM1ENT05080CSR RLABL RCODE BM1ENT05090CSR RLABL MASK BM1ENT05100CSR RLABL DTYPE BM1ENT05110CSR ENDSR BM1ENT0005120CSR PUTSEQ BEGSR BM1ENT05130CSR MOVELMSG,5 BUFFER 72 BM1ENT05140CSR MOVE 'S' TYPE BM1ENT05150CSR Z-ADD25 BLNGTH BM1ENT05160CSR EXSR CRTCOM BM1ENT05170CSR MOVELSEQNO BUFFER BM1ENT05180CSR MOVE 'T' TYPE BM1ENT0005190CSR Z-ADD5 BLNGTH BM1ENT05200CSR EXSR CRTCOM BM1ENT05210CSR ENDSR BM1ENT05220CSR TSTSEQ BEGSR BM1ENT05230CSR SETOF 949697 BM1ENT05240CSR SEQNO COMP LOW 989698 BM1ENT05250CSR 98 SEQNO COMP HIGH 979898 BM1ENT0005260CSR 98 GOTO ENDTST BM1ENT05270CSR 40 96 MOVELMSG,6 BUFFER BM1ENT05280CSR 40 97 MOVELMSG,7 BUFFER BM1ENT05290CSRN40 MOVELMSG,8 BUFFER BM1ENT05300CSRN40 SETON 94 BM1ENT05310CSR MOVE 'T' TYPE BM1ENT05320CSR Z-ADD25 BLNGTH BM1ENT0005330CSR EXSR CRTCOM BM1ENT05340CSR 40 97 MOVE 'F' TYPE BM1ENT05350CSR 40 97 EXSR CRTCOM BM1ENT05360CSR ENDTST ENDSR BM1ENT05370CSR NOCHG BEGSR BM1ENT05380CSR MOVELMSG,9 BUFFER BM1ENT05390CSR MOVE 'T' TYPE BM1ENT0005400CSR Z-ADD25 BLNGTH BM1ENT05410CSR EXSR CRTCOM BM1ENT05420CSR EXSR GETSEQ BM1ENT05430CSR ENDSR BM1ENT05440C********************************************************************BM1ENT05450OBM1OUT E 70N56 BM1ENT05460O RECORD 128 BM1ENT0005470O 42 128 'X' BM1ENT05480O SEQNO 127 BM1ENT** 005490ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005500ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005510ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005520ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00553000** 005540MODE MUST BE A,C,V,OR E 005550FIRST FIELD NAME BLANK 005560INVALID SEQ # 005570PROG# MUST BE FROM 1-4 005580CURRENT SEQUENCE NBR 005590SEQNO TOO LOW 00560000RUN EDIT PROG-FILE FULL 005610SEQNO NOT IN YOUR LIMITS 005620ILLEGAL CHANGE-NO DATA 005630** 005640ENTER BEGINNING RELATIVE RECORD NUMBER 005650ENTER ENDING RELATIVE RECORD NUMBER 005660/* 00567000__EDIT PROG-FILE FULL 005610SEQNO NOT IN YOUR LIMITS 005620ILLEGAL CHANGE-NO DATA 005630** 005640ENTER BEGINNING RELATIVE RECORD NUMBER 005650ENTER ENDING RELATIVE RECORD NUMBER 005660/* 0056700(,  TXIN010 P999999032778(000010H S I0001000020X DECK-ID M55 MFG/DIST/ACCT SYSTEM SUMMARY-123 I0002000030F* THIS IS THE INQUIREY/MAINTENANCE PROGRAM FOR PART MASTER FILE I0003000040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0I0004000050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0005000060F* CONTROL DATA PROPRIETARY PRODUCT I0006000070F* I000700000080FNULL IPEAF 72 DISK I0008000090F@MFG10 IC F 32R DISK I0009000100FPARTMST UC F 0300R20AI 0271 DISK A I0010000110E FN 050 22 FIELD NAME I0011000120E CP 050 4 CURSOR POSITION I0012000130E LN 050 2 0 LENGTH I0013000140E EP 050 4 0 ENDING POSITION I001400000150INULL NS 01 I0015000160I 1 1 A I0016000170I@MFG10 NS 02 I0017000180I 1 22 FIELDN I0018000190I 23 26 CURPOS I0019000200I 27 280LNGTH I0020000210I 29 310ENDPOS I002100000220IPARTMST NS 03 I0022000230I 10256 RECORD I0023000240I 2570300 LEFT01 I0024000250C MOVE ' ' RCODE 1 I0025000260C MOVE RCODE B22 22 I0026000270C MOVE RCODE BLANKS 72 I0027000280C MOVE RCODE FILLER 1 I002800000290C Z-ADD0 MASK 10 I0029000300C SETON LR I0030000310CLR Z-ADD050 SSIZE 30 I0031000320CLR Z-ADD006 NSECT 30 I0032000330CLR MOVEL'D' FF 1 I0033000340CLR MOVE '[]<>' TEMP4 4 I0034000350CLR START TAG I003500000360C* ********** I0036000370CLR EXSR FIRSTP I0037000380C* ********** I0038000390CLR EXSR CLRSCR I0039000400C* ********** I0040000410CLR 40 GOTO EOJ I0041000420C* ********** I004200000430CLR Z-ADD2 VL I0043000440CLR MOVELSECTON VAR I0044000450CLR EXSR RTADJ I0045000460C* ********** I0046000470CLR MOVELVAR SECTN 20 I0047000480CLR EXSR GETSEC I0048000490C* ********** I004900000500CLRN45 GOTO START I0050000510C* ********** I0051000520CLR EXSR CLRSCR I0052000530C* ********** I0053000540CLR EXSR OUTPUT I0054000550C* ********** I0055000560CLR EXSR UPDATE I005600000570C* ********** I0057000580CLR GOTO START I0058000590C* ********** I0059000600CLR EOJ TAG I0060000610C* ********** I0061000620C********************************************************************I0062000630C* I006300000640C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND I0064000650C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. I0065000660C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDI0066000670C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN I0067000680C* I0068000690C********************************************************************I0069000700CSR FIRSTP BEGSR I007000000710C* ********** I0071000720CSR EXSR CLRSCR I0072000730C* ********** I0073000740CSR Z-ADD0 SECTN I0074000750CSR EXSR GETSEC I0075000760C* ********** I0076000770CSR PGE TAG I007700000780C* ********** I0078000790CSR SETON 61 I0079000800CSR SETOF 62 I0080000810CSR EXSR OUTPUT I0081000820C* ********** I0082000830C* ********** I0083000840CSR EXIT SUBRFL I008400000850CSR RLABL RECORD I0085000860CSR RLABL FILLER 1 I0086000870C* ********** I0087000880CSR EXIT SUBRFL I0088000890CSR RLABL LEFT01 I0089000900CSR RLABL FILLER 1 I0090000910C* ********** I009100000920C* ********** I0092000930C* ********** I0093000940C* ********** I0094000950C* ********** I0095000960C* ********** I0096000970C* ********** I0097000980C* ********** I009800000990C* ********** I0099001000C* ********** I0100001010C* ********** I0101001020C* ********** I0102001030C* ********** I0103001040C* ********** I0104001050CSR Z-ADD20 NCHARS I010500001060CSR Z-ADD1 SSTRT I0106001070CSR Z-ADD271 TSTRT I0107001080C* ********** I0108001090CSR EXIT SUBRLM I0109001100CSR RLABL KEY 20 I0110001110CSR RLABL SSTRT 30 I0111001120CSR RLABL RECORD I011200001130CSR RLABL TSTRT 30 I0113001140CSR RLABL NCHARS 30 I0114001150CSR Z-ADDNOFLDS SVFLDS 30 I0115001160CSR Z-ADDSX NOFLDS I0116001170CSR EXSR UPDATE I0117001180C* ********** I0118001190CSR Z-ADDSVFLDS NOFLDS I011900001200CSR Z-ADD20 NCHARS I0120001210CSR Z-ADD271 SSTRT I0121001220CSR Z-ADD1 TSTRT I0122001230C* ********** I0123001240CSR EXIT SUBRLM I0124001250CSR RLABL RECORD I0125001260CSR RLABL SSTRT 30 I012600001270CSR RLABL KEY I0127001280CSR RLABL TSTRT 30 I0128001290CSR RLABL NCHARS 30 I0129001300CSR KEY CHAINPARTMST 55 I0130001310CSR MOVELSAVPOS BUFFER I0131001320CSR MOVELOFC BUFFER I0132001330CSR EXSR POSCUR I013300001340C* ********** I0134001350CSR MOVEL'] NEW R'WORD16 16 I0135001360CSR MOVE 'ECORD 'WORD16 I0136001370CSRN55 MOVELBLANKS WORD16 I0137001380CSRN55 MOVEL']' WORD16 I0138001390CSR MOVELWORD16 BUFFER 72 I0139001400CSR MOVE 'T' TYPE 1 I014000001410CSR Z-ADD13 BLNGTH 20 I0141001420CSR EXSR CRTCOM I0142001430C* ********** I0143001440CSR SETON 62 I0144001450CSR Z-ADDSX X 30 I0145001460CSR EXSR ACCEPT I0146001470C* ********** I014700001480CSR MOVELBUFFER SECTON 2 I0148001490CSR SECTON COMP 'E ' 40 I0149001500CSR 40 GOTO ENDFP I0150001510C* ********** I0151001520CSR SECTON COMP 'D ' 40 I0152001530CSR 40N55 EXCPT I0153001540CSR 40 GOTO PGE I015400001550C* ********** I0155001560CSR SECTON COMP ' 1' 30 30 I0156001570CSR 30 SECTON COMP ' 9' 3030 I0157001580CSR 30 GOTO GOOD I0158001590C* ********** I0159001600CSR SECTON COMP '01' 30 30 I0160001610CSR 30 SECTON COMP '09' 3030 I016100001620CSR 30 GOTO GOOD I0162001630C* ********** I0163001640CSR SECTON COMP '1 ' 30 30 I0164001650CSR 30 SECTON COMP '9 ' 3030 I0165001660CSR 30 GOTO GOOD I0166001670C* ********** I0167001680CSR MOVELSECTON TEMP1 1 I016800001690CSR TEMP1 COMP '1' 30 30 I0169001700CSR 30 TEMP1 COMP '9' 3030 I0170001710CSRN30 GOTO PGE I0171001720C* ********** I0172001730CSR MOVE SECTON TEMP1 I0173001740CSR TEMP1 COMP '0' 30 30 I0174001750CSR 30 TEMP1 COMP '9' 3030 I017500001760CSRN30 GOTO PGE I0176001770C* ********** I0177001780CSR GOOD TAG I0178001790C* ********** I0179001800CSR SETOF 6162 I0180001810CSRN55 GOTO ENDFP I0181001820C* ********** I018200001830CSR SETON 80 I0183001840CSR EXCPT I0184001850CSR SETOF 80 I0185001860CSR KEY CHAINPARTMST 55 I0186001870CSR ENDFP ENDSR I0187001880C* ********** I0188001890C********************************************************************I018900001900C* I0190001910C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. I0191001920C* I0192001930C********************************************************************I0193001940CSR GETSEC BEGSR I0194001950C* ********** I0195001960CSR 1 ADD SECTN N 20 I019600001970CSR SETOF 404145 I0197001980CSR N COMP 0 3030 I0198001990CSRN30 N COMP NSECT 30 I0199002000CSR 30 GOTO ENDGET I0200002010C* ********** I0201002020CSR SECTN MULT SSIZE RRN 40 I0202002030CSR Z-ADD1 X I020300002040CSR SCLOOP TAG I0204002050C* ********** I0205002060CSR RRN ADD 1 RRN I0206002070CSR RRN CHAIN@MFG10 50 I0207002080CSR 50 GOTO ENDGET I0208002090C* ********** I0209002100CSR FIELDN COMP B22 4141 I021000002110CSRN41 GOTO ENDGET I0211002120C* ********** I0212002130CSR 41N45 SETON 45 I0213002140CSR MOVE FIELDN FN,X I0214002150CSR MOVE CURPOS CP,X I0215002160CSR MOVE LNGTH LN,X I0216002170CSR Z-ADDENDPOS EP,X I021700002180CSR 1 ADD X X I0218002190CSR X COMP SSIZE 32 I0219002200CSRN32 GOTO SCLOOP I0220002210C* ********** I0221002220CSR ENDGET TAG I0222002230C* ********** I0223002240CSR Z-ADDX NOFLDS 30 I022400002250CSR 45 GOTO FINGET I0225002260C* ********** I0226002270CSR EXSR CLRSCR I0227002280C* ********** I0228002290CSR MOVEL'SECT # 'WORD9 9 I0229002300CSR Z-ADD16 BLNGTH I0230002310CSR MOVE SECTN WORD9 I023100002320CSR MOVELWORD9 WORD16 I0232002330CSRN30 MOVE ' ABSENT' WORD16 I0233002340CSR 30 MOVE ' ILLEG.' WORD16 I0234002350CSR MOVELWORD16 BUFFER I0235002360CSR MOVEL'T' TYPE I0236002370CSR EXSR CRTCOM I0237002380C* ********** I023800002390CSR FINGET ENDSR I0239002400C* ********** I0240002410C********************************************************************I0241002420C* I0242002430C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE I0243002440C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE I0244002450C* SECTION INDEX IS SAVED. I024500002460C* I0246002470C********************************************************************I0247002480CSR OUTPUT BEGSR I0248002490C* ********** I0249002500CSR EXSR CLRSCR I0250002510C* ********** I0251002520CSR Z-ADD1 X I025200002530CSR 61 SETON 63 I0253002540CSR OTLOOP TAG I0254002550C* ********** I0255002560CSR 61 LN,X COMP 0 31 I0256002570CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXI0257002580CSR EXSR OUTFLD I0258002590C* ********** I025900002600CSR X ADD 1 X I0260002610CSR X COMP NOFLDS 31 I0261002620CSR 31 GOTO OTLOOP I0262002630C* ********** I0263002640CSR SETOF 63 I0264002650CSR ENDSR I0265002660C********************************************************************I026600002670C* I0267002680C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND I0268002690C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 I0269002700C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS I0270002710C* THEN NO FIELD INFORMATION IS PRINTED I0271002720C* I0272002730C********************************************************************I027300002740CSR OUTFLD BEGSR I0274002750C* ********** I0275002760CSR MOVE FN,X FL 20 I0276002770CSR EP,X COMP 0 98 I0277002780CSR MOVELCP,X FC 20 I0278002790CSR FC COMP FL 31 I0279002800CSR 31 Z-ADDFC FL I028000002810CSR FC SUB FL CC 20 I0281002820CSR CC ADD 1 CC I0282002830CSR MOVELCP,X BUFFER I0283002840CSR MOVELCC BUFFER I0284002850CSR EXSR POSCUR I0285002860C* ********** I0286002870CSR MOVELBLANKS BUFFER I028700002880CSR MOVELFN,X FIELDN I0288002890CSR MOVE ' ' FIELDN I0289002900CSR MOVELFIELDN BUFFER I0290002910CSR Z-ADDLN,X LEN 20 I0291002920CSR LEN COMP 0 9730 I0292002930CSR 97 Z-SUBLN,X LEN I0293002940CSR 30 GOTO SKIPF I029400002950C* ********** I0295002960CSR FL ADD 2 BPOS 20 I0296002970C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS I0297002980CSR Z-ADDBPOS TSTRT 30 I0298002990CSRN98 Z-ADD1 SSTRT 30 I0299003000CSR 98 Z-ADD3 SSTRT I0300003010CSR Z-ADD1 NCHARS 30 I030100003020C* ********** I0302003030CSR EXIT SUBRLM I0303003040CSR RLABL TEMP4 I0304003050CSR RLABL SSTRT 30 I0305003060CSR RLABL BUFFER I0306003070CSR RLABL TSTRT 30 I0307003080CSR RLABL NCHARS 30 I030800003090CSR BPOS ADD 1 FPOS 20 I0309003100CSR EXSR MVRECD I0310003110C* ********** I0311003120CSR SKIPF TAG I0312003130C* ********** I0313003140CSR 30 Z-ADDFL BLNGTH I0314003150CSRN30 FL ADD 3 BLNGTH I031500003160CSRN30 BLNGTH ADD LEN BLNGTH I0316003170CSR MOVE 'T' TYPE I0317003180CSR EXSR CRTCOM I0318003190C* ********** I0319003200CSR ENDSR I0320003210C********************************************************************I0321003220C* I032200003230C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN I0323003240C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST I0324003250C* THE RIGHT BRACKET. I0325003260C********************************************************************I0326003270CSR MVRECD BEGSR I0327003280C* ********** I0328003290CSR 63 GOTO RBRK I032900003300C* ********** I0330003310CSR 98 Z-SUBEP,X END 40 I0331003320CSRN98 Z-ADDEP,X END I0332003330CSR END SUB LEN STRT 40 81 81 I0333003340CSR STRT ADD 1 STRT I0334003350C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER I0335003360C* FROM STRT IN RECORD TO FPOS IN BUFFER I033600003370CSR Z-ADDLEN NCHARS I0337003380CSR Z-ADDSTRT SSTRT I0338003390CSR Z-ADDFPOS TSTRT I0339003400C* ********** I0340003410CSRN81 GOTO RBRK I0341003420CSR EXIT SUBRLM I0342003430CSR RLABL RECORD I034300003440CSR RLABL SSTRT 30 I0344003450CSR RLABL BUFFER I0345003460CSR RLABL TSTRT 30 I0346003470CSR RLABL NCHARS 30 I0347003480CSR RBRK TAG I0348003490C* ********** I0349003500CSR EXSR RTBRKT I035000003510C* ********** I0351003520CSR ENDSR I0352003530C********************************************************************I0353003540C* I0354003550C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS I0355003560C* I0356003570C********************************************************************I035700003580CSR RTBRKT BEGSR I0358003590C* ********** I0359003600CSR LEN ADD FPOS FPOS I0360003610CSR Z-ADDFPOS TSTRT I0361003620CSR Z-ADD1 NCHARS I0362003630CSRN98 Z-ADD2 SSTRT I0363003640CSR 98 Z-ADD4 SSTRT I036400003650C* ********** I0365003660CSR EXIT SUBRLM I0366003670CSR RLABL TEMP4 I0367003680CSR RLABL SSTRT 30 I0368003690CSR RLABL BUFFER I0369003700CSR RLABL TSTRT 30 I0370003710CSR RLABL NCHARS 30 I037100003720CSR ENDSR I0372003730C********************************************************************I0373003740C* I0374003750C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. I0375003760C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO I0376003770C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF I0377003780C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST I037800003790C* OF THE FIELDS ARE LEFT UNCHANGED I0379003800C* I0380003810C********************************************************************I0381003820CSR UPDATE BEGSR I0382003830C* ********** I0383003840CSR SETOF 32 I0384003850CSR Z-ADD1 X I038500003860CSR UPLOOP TAG I0386003870C* ********** I0387003880CSR EP,X COMP 0 98 I0388003890CSR 98 SETON 30 I0389003900CSR 98 GOTO NOUPD I0390003910C* ********** I0391003920CSR Z-ADDLN,X LEN I039200003930CSR LEN COMP 0 9730 I0393003940CSR 97 Z-SUBLEN LEN I0394003950CSR NOUPD TAG I0395003960C* ********** I0396003970CSR 30N32 GOTO INCR I0397003980C* ********** I0398003990CSR 30 GOTO CHKRUB I039900004000C* ********** I0400004010CSR SETOF 3233 I0401004020CSR EXSR ACCEPT I0402004030C* ********** I0403004040CSR CHKRUB TAG I0404004050C* ********** I0405004060CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTI040600004070CSR 32 31 GOTO UPLOOP I0407004080C* ********** I0408004090CSR 32 GOTO ENDUPD I0409004100C* ********** I0410004110CSR MOVELBUFFER ATSIGN 1 I0411004120CSR ATSIGN COMP '@' 35 I0412004130CSR 35 GOTO OUTREC I041300004140C* ********** I0414004150CSR 33 GOTO INCR WAS LINE FEED I0415004160C* ********** I0416004170CSR Z-ADDEP,X END I0417004180CSR END SUB LEN STRT 81 81 I0418004190CSR STRT ADD 1 STRT I0419004200C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF I042000004210C* BUFFER TO THE STRT OF RECORD I0421004220CSR Z-ADD1 SSTRT I0422004230CSR Z-ADDSTRT TSTRT I0423004240CSR Z-ADDLEN NCHARS I0424004250C* ********** I0425004260CSRN81 GOTO AAA I0426004270CSR EXIT SUBRLM I042700004280CSR RLABL BUFFER I0428004290CSR RLABL SSTRT 30 I0429004300CSR RLABL RECORD I0430004310CSR RLABL TSTRT 30 I0431004320CSR RLABL NCHARS 30 I0432004330CSR AAA TAG I0433004340CSR MOVELBUFFER TEMP5 5 I043400004350CSR MOVELSAVPOS BUFFER I0435004360CSR EXSR POSCUR I0436004370C* ********** I0437004380CSR MOVELTEMP5 BUFFER I0438004390CSR Z-ADD1 FPOS I0439004400CSR EXSR RTBRKT I0440004410C* ********** I044100004420CSR LEN ADD 1 BLNGTH I0442004430CSR MOVE 'T' TYPE I0443004440CSR EXSR CRTCOM I0444004450C* ********** I0445004460CSR INCR TAG I0446004470C* ********** I0447004480CSR X ADD 1 X I044800004490CSR X COMP NOFLDS 30 I0449004500CSR 30 GOTO UPLOOP I0450004510C* ********** I0451004520CSR OUTREC TAG I0452004530C* ********** I0453004540CSR SETON 80 I0454004550CSRN61 EXCPT I045500004560CSR SETOF 80 I0456004570CSR ENDUPD TAG I0457004580C* ********** I0458004590CSR ENDSR I0459004600C********************************************************************I0460004610C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE I0461004620C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X I046200004630C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND I0463004640C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT I0464004650C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED I0465004660C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS I0466004670C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS I0467004680C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO I0468004690C* TO BE OUTPUT TO THE SCREEN. I046900004700C* I0470004710C********************************************************************I0471004720CSR ACCEPT BEGSR I0472004730C* ********** I0473004740CSR X COMP 1 30 I0474004750CSRN30 X COMP SSIZE 30 I0475004760CSR 30 Z-ADD1 X I047600004770CSR MOVELCP,X FC I0477004780CSR FC ADD 3 FC I0478004790CSR MOVELCP,X SAVPOS 4 I0479004800CSR MOVELFC SAVPOS I0480004810CSR Z-ADDLN,X LEN I0481004820CSR LEN COMP 0 97 I0482004830CSR 97 Z-SUBLEN LEN I048300004840CSR LEN ADD FC OFC 20 I0484004850CSR ACLOOP TAG I0485004860C* ********** I0486004870CSR MOVELSAVPOS BUFFER I0487004880CSR EXSR POSCUR I0488004890C* ********** I0489004900CSR Z-ADDLEN BLNGTH I049000004910CSR MOVE BLANKS BUFFER I0491004920CSR MOVE 'A' TYPE I0492004930CSR EXSR CRTCOM I0493004940C* ********** I0494004950CSR RCODE COMP 'R' 31 I0495004960CSR 31 BUFFER COMP BLANKS 32 I0496004970CSR 31 32N62 GOTO DUPIT I049700004980C* ********** I0498004990CSR 31 GOTO ACLOOP I0499005000C* ********** I0500005010CSR RCODE COMP 'L' 33 I0501005020CSR 33 GOTO DUPIT I0502005030C* ********** I0503005040CSRN97 GOTO ENDACC I050400005050C* ********** I0505005060CSR MOVELBUFFER SIGN 1 WE MUST CHECK I0506005070CSR SIGN COMP '@' 30 I0507005080CSR 30 GOTO ENDACC I0508005090C* ********** I0509005100CSR Z-ADDLEN VL 20 I0510005110CSR MOVELBUFFER VAR 15 I051100005120CSR EXSR RTADJ I0512005130C* ********** I0513005140CSR MOVELVAR BUFFER I0514005150CSR GOTO ENDACC I0515005160C* ********** I0516005170CSR DUPIT TAG I0517005180C* ********** I051800005190CSR MOVELSAVPOS BUFFER I0519005200CSR EXSR POSCUR I0520005210C* ********** I0521005220CSR 62 MOVELSECTON BUFFER I0522005230CSRN62 Z-ADD1 FPOS I0523005240CSRN62 EXSR MVRECD I0524005250C* ********** I052500005260CSR MOVE 'T' TYPE I0526005270CSR BLNGTH ADD 1 BLNGTH I0527005280CSR EXSR CRTCOM I0528005290C* ********** I0529005300CSR ENDACC ENDSR I0530005310C* ********** I0531005320C********************************************************************I053200005330C* I0533005340C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES I0534005350C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM I0535005360C* 4 DUMMY FOR RTADJ I0536005370C* I0537005380C********************************************************************I0538005390CSR POSCUR BEGSR I053900005400C* ********** I0540005410CSR MOVE 'P' TYPE I0541005420CSR EXSR CRTCOM I0542005430C* ********** I0543005440CSR ENDSR I0544005450C********************************************************************I0545005460CSR CLRSCR BEGSR I054600005470C* ********** I0547005480CSR MOVE 'C' TYPE I0548005490CSR EXSR CRTCOM I0549005500C* ********** I0550005510CSR ENDSR I0551005520C********************************************************************I0552005530CSR CRTCOM BEGSR I055300005540C* ********** I0554005550C* ********** I0555005560CSR EXITFSUBRCM I0556005570CSR RLABL BUFFER 72 I0557005580CSR RLABL TYPE 1 I0558005590CSR RLABL BLNGTH 20 I0559005600CSR RLABL RCODE 1 I056000005610CSR RLABL MASK 10 I0561005620CSR RLABL DTYPE 10 I0562005630CSR ENDSR I0563005640C********************************************************************I0564005650CSR RTADJ BEGSR I0565005660C* ********** I0566005670CSR EXIT SUBRAJ I056700005680C* ********** I0568005690CSR RLABL VL I0569005700CSR RLABL VAR I0570005710CSR ENDSR I0571005720C********************************************************************I0572005730OPARTMST E 80N55 I0573005740O RECORD 0256 I057400005750O LEFT01 0300 I0575005760O E 40N80 I0576005770O FF 74 I0577005780O EADD 80 55 I0578005790O RECORD 0256 I0579005800O LEFT01 0300 I05800** 00581000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005850/* 005860_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(,, }OTXBM145 P999999041478(000010H S BM145 00020X DECK-ID M24 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM145 00030F* PRINTS COSTED BILLS OF MATERIAL BM145 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FBOMWRK IPEAF 36 DISK MFG14500090FPARTMST IC F 300R12AI 1 DISK MFG14500100F$LP1 O F 132 OF PRINTER MFG14500110FHEADING IT F 40 EDISK MFG14500120F* MFG14500130F* PRINTS COSTED BILLS. IF U1 IS OFF STD MATERIAL COST IS USED. MFG14500140F* U1 IS ON LAST PURCHASE COST IS USED. MFG1450000150F* MFG14500160E HEADING HEAD 1 1 40 MFG14500170IBOMWRK NS 40 5 C MFG14500180I 1 40WRKSEQL1 MFG14500190I 6 17 WRKASY MFG14500200I 20 260WRKTQT 00210I 1 40WRKSEQ MFG1450000220I NS 41 5 CX MFG14500230I 1 40WRKSEQL1 MFG14500240I 6 17 WRKPN MFG14500250I 18 190WRKLEV MFG14500260I 20 263WRKQTY MFG14500270I 27 353WRKEQT MFG14500280I NS ** MFG1450000290I 1 40NXTSEQ MFG14500300I 18 190NXTLEV MFG14500310IPARTMST NS 42 MFG14500320I 13 37 DESC MFG14500330I 38 39 UM MFG14500340I 138 1453TLHRS MFG14500350I 89 953ULAB MFG1450000360I 110 1163TLAB MFG14500370I 96 1023UBUR MFG14500380I 117 1233TBUR MFG14500390I 103 1093UOP MFG14500400I 124 1303TOP MFG14500410I 220 2250REVD MFG14500420I 219 219 REVL MFG1450000430I 75 813SUCOST MFG14500440I 82 883LUCOST MFG14500450I 51 51 ICODE MFG14500460C L1 Z-ADD0 PAGE 50 MFG14500470C L1 Z-ADD0 ITEM 30 MFG14500480C L1 Z-ADD0 GTOT 83 MFG14500490C 41 GOTO SKIP MFG1450000500C WRKASY CHAINPARTMST 25 MFG14500510C 25 GOTO END MFG14500520C MOVE DESC SDESC 25 MFG14500530C MOVE UM SUM 2 MFG14500540C MOVE ICODE SICODE 1 MFG14500550C MOVE TLHRS STLHRS 73 MFG14500560C MOVE TLAB STLAB 73 MFG1450000570C MOVE TBUR STBUR 73 MFG14500580C Z-ADDTOP STOP 83 MFG14500590C SMAT ADD STOP STOT 83 00600C STLAB ADD STOT STOT MFG14500610C STBUR ADD STOT STOT MFG14500620C ULAB ADD UBUR UTOT 83 MFG14500630C UOP ADD UTOT UTOT MFG1450000640C UTOT MULT WRKTQT XTOT H 00650C XTOT ADD GTOT GTOT MFG14500660C 40 GOTO END MFG14500670C SKIP TAG MFG14500680C WRKPN CHAINPARTMST 26 MFG14500690C NXTSEQ COMP 99 98 MFG14500700C N98 NXTSEQ COMP WRKSEQ 9898 MFG1450000710C N98 NXTLEV COMP WRKLEV 9898 MFG14500720C 26 GOTO END MFG14500730C U1 MOVE LUCOST UMAT 73 MFG14500740C NU1 MOVE SUCOST UMAT MFG14500750C UMAT ADD SMAT SMAT 73 00760C N51 UMAT ADD SMAT SMAT 73 00770C N98 ULAB ADD UOP UTOT MFG1450000780C N98 UBUR ADD UTOT UTOT MFG14500790C 98 Z-ADDUMAT UTOT MFG14500800C UTOT MULT WRKEQT XTOT 83H MFG14500810C XTOT ADD GTOT GTOT 83 MFG14500820C WRKLEV COMP 1 51 MFG14500830C WRKLEV COMP 2 52 MFG14500840C WRKLEV COMP 3 53 MFG1450000850C WRKLEV COMP 4 54 MFG14500860C WRKLEV COMP 5 55 MFG14500870C WRKLEV COMP 6 56 MFG14500880C WRKLEV COMP 7 57 MFG14500890C WRKLEV COMP 8 58 MFG14500900C WRKLEV COMP 9 60 59 MFG14500910C END TAG MFG1450000920C 41 ITEM ADD 1 ITEM MFG14500930C MOVE WRKEQT XQUAN 83 MFG14500940CL1 GTOT SUB STOT DIFF 81H9999 MFG14500950O$LP1 D 202 40 MFG14500960O OR OF MFG14500970O HEAD,1 85 MFG14500980O UDATE Y 132 MFG1450000990O PAGE Z 7 MFG14501000O 4 'PAGE' MFG14501010O D 2 40 MFG14501020O OR OF MFG14501030O 76 'COSTED BILL OF MATERIAL' MFG14501040O NU1 88 '-AT STANDARD' MFG14501050O U1 88 '-AVERAGE ' MFG1450001060O 132 'MFG145' MFG14501070O D 1 40 MFG14501080O OR OF MFG14501090O 11 'PART NUMBER' MFG14501100O 25 'DESCRIPTION' MFG14501110O 49 'UM INV' MFG14501120O D 2 40 MFG1450001130O OR OF MFG14501140O WRKASY 12 MFG14501150O SDESC 39 MFG14501160O SUM 44 MFG14501170O SICODE 48 MFG14501180O D 1 40 MFG14501190O OR OF MFG1450001200O 62 'EXTENDED' MFG14501210O 90 '- - - - - - - - U N I T' MFG14501220O 102 'C O S T S' MFG14501230O 120 '- - - - - - - - -' MFG14501240O 132 'EXTENDED' MFG14501250O D 2 40 MFG14501260O OR OF MFG1450001270O 10 'NO. LEVEL' MFG14501280O 39 'PART NUMBER DESCRIPTION' MFG14501290O 76 'QUANTITY UM MATERIAL' MFG14501300O 96 'LABOR BURDEN' MFG14501310O 119 'O.P. TOTAL' MFG14501320O 131 'TOTAL' MFG14501330O D 2 40 MFG1450001340O 3 '***' MFG14501350O WRKASY 27 MFG14501360O 40 'TOP ASSEMBLY' MFG14501370O WRKTQTKB 62 01380O SUM 65 MFG14501390O ULAB K 87 MFG14501400O UBUR K 97 MFG1450001410O UOP K 108 MFG14501420O UTOT K 120 MFG14501430O XTOT KB 132 MFG14501440O D 1 41 MFG14501450O ITEM 1 3 MFG14501460O 51 6 'X' MFG14501470O 52 7 'XX' MFG1450001480O 53 8 'XXX' MFG14501490O 54 9 'XXXX' MFG14501500O 55 10 'XXXXX' MFG14501510O 56 11 'XXXXXX' MFG14501520O 57 12 'XXXXXXX' MFG14501530O 58 13 'XXXXXXXX' MFG14501540O 59 14 'XXXXXXXXX' MFG1450001550O 60 WRKLEV 14 MFG14501560O WRKPN 27 MFG14501570O 26 53 'NOT ON PART MASTER FILE' MFG14501580O N26 DESC 53 MFG14501590O XQUAN L 63 MFG14501600O N26 UM 65 MFG14501610O 98 UMAT K 77 MFG1450001620O ULAB K 87 MFG14501630O UBUR K 97 MFG14501640O UOP K 108 MFG14501650O UTOT JB 120 MFG14501660O XTOT J 132 MFG14501670O T 1 L1 MFG14501680O 30 'TOTAL LABOR/UNIT' MFG1450001690O STLHRS1B 39 MFG14501700O 43 'HRS' MFG14501710O 64 'EXTENDED TOTALS' MFG14501720O GTOT JB 132 01730O T 2 L1 99 MFG14501740O 76 'UNIT COSTS NOT UPDATED' MFG14501750O T 2 L1 MFG1450001760O 77 '************************' MFG145** 01770ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 01780ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 01790ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 01800ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 01810/* 0182000__0O 77 '************************' MFG145** 01770ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 01780ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 01790ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 01800ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 01810/* 018200(, #?OTXMR720 P999999041478(000010H S MR740 00020X DECK-ID M92 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR740 00030F* PICK OUT RECORDS FROM OPNORDS + WRITE OUT TO PROCORD MR740 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR740 00050F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR740 00060F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR740 00070F* CONTROL DATA PROPRIETARY PRODUCT MR740 0000080F* MR740 00090FOPNORDS IPEAF 118 8AI 106 DISK MR740 00100FPROCORD O F 105 DISK MR740 00110I* MR740 00120I* ONLY READ RECORDS WITH A 'H' IN COL 8 MR740 00130I* OR A 'L' IN COL 8 AND COL 11 MR740 00140IOPNORDS NS 08 8 CH MR740 0000150I 1 105 ENTIRE MR740 00160I 105 105 STATUS 10 MR740 00170I* INDICATOR 10 IS ON IF STATUS IS BLANK FOR H RECORDS MR740 00180I NS 05 8 CL 11 CL MR740 00190I 1 105 ENTIRE MR740 00200I NS 03 MR740 00210C* MR740 0000220C* SEE IF STATUS IS A BLANK FOR ENTERED OPEN ORDER MR740 00230C* OR A 'P' FOR PICKED UP ORDER MR740 00240C* IGNORE ALL OTHER STATUS MR740 00250C 08N10 STATUS COMP 'P' 10 MR740 00260O* MR740 00270OPROCORD D 10 08 MR740 00280O OR 10 05 MR740 0000290O ENTIRE 105 MR740 ** 000300ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000310ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000320ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000330ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000340/* 00035000__0O ENTIRE 105 MR740 ** 000300ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000310ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000320ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000330ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000340/* 0003500(d, *OTXMR740 P999999041478(0__d, *OTXMR740 P999999041478(4D285D295C2A4E2B6B2C602D4B2E612F 000310ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000320ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000330ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000340/* 0003500(ok iOTXMR750 P999999041478(000010H S MR750 00020X DECK-ID M37 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR750 00030F* EXPLODE ACTUAL ACTIVITY INTO TOP UNITS REQUIRED MR750 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR750 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR750 00060F* CONTROL DATA PROPRIETARY PRODUCT MR750 00070F* MR750 0000080FDUMMY IPEAF 72 DISK MR750 00090FWRKORD ISEAF 160 5AI 1 DISK U2 MR750 00100FPROCORD ISEAF 105 DISK U1 MR750 00110FPURCH ISEAF 60 25AI 1 DISK U3 MR750 00120FBOMMST USEAF 28 12AI 1 DISK MR750 00130FPARTMST IC F 300R12AI 1 DISK MR750 00140FORDERS O F 46 DISK MR750 0000150FTEMRRN UC F 42R DISK MR750 00160IDUMMY NS 03 MR750 00170I 1 1 A MR750 00180IWRKORD NS 01 30 CO MR750 00190I OR 02 30 CR MR750 00200I 1 50WONUM MR750 00210I 30 30 STAT MR750 0000220I 6 17 PN MR750 00230I 31 370WOQTY MR750 00240I 38 440WOCOMP MR750 00250I 45 500TDATE MR750 00260I 51 560WDUEDT MR750 00270I 57 57 RGCOD MR750 00280I NS 03 MR750 0000290I 1 1 A MR750 00300IPROCORD NS 08 8 CH MR750 00310I 1 70SONUM MR750 00320I 9 130CUSTNO MR750 00330I 14 190TDATE MR750 00340I 50 550SDUEDT MR750 00350I NS 05 8 CL 11 CL MR750 0000360I 1 70SONUM MR750 00370I 12 23 PN MR750 00380I 24 300SOQTY MR750 00390I 31 370SOCOMP MR750 00400I* RGCOD MR750 00410I NS 03 MR750 00420I 1 1 A MR750 0000430IPURCH NS 06 MR750 00440I 1 70PONUM MR750 00450I 8 19 PN MR750 00460I 20 250REQDTE MR750 00470I 20 210RYY MR750 00480I 22 250RMMDD MR750 00490I 26 300VENDOR MR750 0000500I 31 360TDATE MR750 00510I 37 430QTYDUE MR750 00520I 44 500QTYIN MR750 00530IBOMMST NS 07 MR750 00540I 1 12 PART MR750 00550I 1 17 FLD MR750 00560IPARTMST NS 09 MR750 0000570I 44 460LEADTM MR750 00580I 146 1520SOH MR750 00590I 153 1590SOO MR750 00600I 181 1870MIN MR750 00610I 188 1940LOTSIZ MR750 00620I 195 195 MMCODE MR750 00630ITEMRRN NS 04 MR750 0000640I 1 1 A MR750 00650C 07 RRN ADD 1 RRN 50 MR750 00660C 07 EXSR GETAVL MR750 00670C 03 MR750 00680COR 08 MR750 00690COR 07 GOTO DEND MR750 00700C 01 RGCOD COMP 'X' 10 MR750 0000710C* 05 RGCOD COMP 'X' 10 MR750 00720C 01 MR750 00730COR 02 SETOF 93 MR750 00740C 01 MR750 00750COR 02 WOQTY SUB WOCOMP DIFF 70 25 MR750 00760C 01 25 MR750 00770COR 02 25 STAT COMP 'C' 93 MR750 0000780C 01 93 MR750 00790COR 02 93 SETOF 25 MR750 00800C 05 SOQTY SUB SOCOMP DIFF 26 MR750 00810C 06 QTYDUE SUB QTYIN DIFF 27 MR750 00820C DEND TAG MR750 00830C* MR750 00840C* MR750 0000850C* MR750 00860CSR GETAVL BEGSR MR750 00870CSR PART CHAINPARTMST 51 MR750 00880CSR 51 Z-ADD0 AVAIL 70 MR750 00890CSR 51 Z-ADD0 LEADTM MR750 00900CSR 51 Z-ADD0 MIN MR750 00910CSR 51 Z-ADD0 LOTSIZ MR750 0000920CSR 51 MOVE ' ' MMCODE MR750 00930CSRN51 SOH ADD SOO AVAIL 16 MR750 00940CSR 16 Z-ADD0 AVAIL IF AVAIL < 0 MR750 00950CSR RRN CHAINTEMRRN 33 MR750 00960CSR ENDSR MR750 00970O* MR750 00980O* FOR OJ, PUT TDATE WHICH IS START DATE IN DUE DATE FIELD, AND MR750 0000990O* PUT DUE DATE IN TDATE. THEY WILL BE REVERSED IN NEXT PROGRAM MR750 01000O* MR750 01010OORDERS D 01 MR750 01020O OR 02 25 MR750 01030O 01 2 'OJ' MR750 01040O 02 2 'RJ' MR750 01050O WONUM 7 MR750 0001060O PN 21 MR750 01070O DIFF 28 MR750 01080O 01 TDATE 34 MR750 01090O 02 WDUEDT 34 MR750 01100O 01 WDUEDT 40 MR750 01110O 02 TDATE 40 MR750 01120O 01 10 46 'X' MR750 0001130O 02 46 'X' MR750 01140O D 05 26 MR750 01150O 2 'SO' MR750 01160O SONUM 9 MR750 01170O PN 21 MR750 01180O DIFF 28 MR750 01190O SDUEDT 34 MR750 0001200O TDATE 40 MR750 01210O CUSTNO 45 MR750 01220O* 10 46 'X' MR750 01230O D 06 27 MR750 01240O 2 'PO' MR750 01250O PONUM 9 MR750 01260O PN 21 MR750 0001270O DIFF 28 MR750 01280O RMMDD 32 MR750 01290O RYY 34 MR750 01300O TDATE 40 MR750 01310O VENDOR 45 MR750 01320O 46 'X' MR750 01330OBOMMST D 07 MR750 0001340O RRN 27 MR750 01350OTEMRRN D 07N33 MR750 01360O FLD 17 MR750 01370O AVAIL 24 MR750 01380O LEADTM 27 MR750 01390O MMCODE 28 MR750 01400O MIN 35 MR750 0001410O LOTSIZ 42 MR750 ** 001420ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001460/* 00147000__0O LOTSIZ 42 MR750 ** 001420ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001430ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001440ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001450ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001460/* 0014700(r $OTXMR752 P999999041478(000010H S MR752 00020X DECK-ID M38 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR752 00030F* EXPLODE FORECASTED ACTIVITY INTO TOP UNITS REQUIRED MR752 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR752 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR752 00060F* CONTROL DATA PROPRIETARY PRODUCT MR752 00070F* MR752 0000080FFORCST IPEAF 193 24AI 1 DISK MR752 00090FWRKORD ISEAF 160 5AI 1 DISK U2 MR752 00100FPURCH ISEAF 60 25AI 1 DISK U3 MR752 00110FBOMMST USEAF 28 12AI 1 DISK MR752 00120FPARTMST IC F 300R12AI 1 DISK MR752 00130FORDERS O F 46 DISK MR752 00140FTEMRRN UC F 42R DISK MR752 0000150F* MR752 00160F* ************************************************************** MR752 00170F* ** ** MR752 00180F* ** COMPUSOURCE CORPORATION ** MR752 00190F* ** ** MR752 00200F* ** MATERIAL REQUIREMENTS PLANNING ADM ** MR752 00210F* ** ** MR752 0000220F* ** ROBBIE FREEMAN 7/9/76 ** MR752 00230F* ** ** MR752 00240F* ************************************************************** MR752 00250F* ** ** MR752 00260F* ** FUNCTION OF INDICATORS ** MR752 00270F* ** ** MR752 00280F* ** 01 FORCST ** MR752 0000290F* ** 02 WRKORD- OPEN JOB ** MR752 00300F* ** 03 WRKORD- RELEASED JOB ** MR752 00310F* ** 04 WRKORD- OTHERS ** MR752 00320F* ** 05 PURCH ** MR752 00330F* ** 07 BOMMST ** MR752 00340F* ** 08 PARTMST ** MR752 00350F* ** 09 TEMRRN ** MR752 0000360F* ** 10 REQTS GEN CODE FOR OJ = X ** MR752 00370F* ** 16 AVAIL (SOH+SOO) < 0 -- LET = 0 ** MR752 00380F* ** 20 POSITIVE FORECAST QTY - OUTPUT TO 'ORDERS' ** MR752 00390F* ** 21 'FC' & 'DLOOP' CONTROL ** MR752 00400F* ** 25 QTY REMAINING ON OJ IS POS. - OUTPUT ** MR752 00410F* ** 26 QTY REMAINING ON PO IS POS. - OUTPUT ** MR752 00420F* ** 33 NO HIT ON TEMRRN - END OF FILE ** MR752 0000430F* ** 51 NO HIT ON PARTMST ** MR752 00440F* ** 90 DATE OVERFLOW OCCURRED AFTER INCREMENT - FIX ** MR752 00450F* ** 95 BAD DATE ENTERED BY OPERATOR - RETRY ** MR752 00460F* ** 99 1ST CYCLE DONE ** MR752 00470F* ** ** MR752 00480F* ** U1 OPER TO ENTER DATE OF LAST DAY OF 1ST TIME PER ** MR752 00490F* ** U2 INPUT WRKORD ** MR752 0000500F* ** U3 INPUT PURCH ** MR752 00510F* ** U4 TIME PERIOD INCREMENTS = MONTHS (AND, IF U1 IS ** MR752 00520F* ** OFF, USE LAST DAY OF UMONTH FOR 1ST PERIOD) ** MR752 00530F* ** ** MR752 00540F* ************************************************************** MR752 00550F* MR752 00560E FAR 24 7 0 FORECAST ARRAY MR752 0000570E DATE 24 6 0 FORECAST DATES MR752 00580IFORCST XX 01 MR752 00590I 1 12 PN MR752 00600I 26 193 FAR MR752 00610IWRKORD XX 02 30 CO MR752 00620I OR 03 30 CR MR752 00630I 1 50WONUM MR752 0000640I 6 17 PN MR752 00650I 30 30 STAT MR752 00660I 31 370QTYDUE MR752 00670I 38 440QTYIN MR752 00680I 45 500TDATE MR752 00690I 51 560DUEDAT MR752 00700I 57 57 RGCOD MR752 0000710I XX 04 MR752 00720I 1 1 A MR752 00730IPURCH XX 05 MR752 00740I 1 70PONUM MR752 00750I 8 19 PN MR752 00760I 20 210RYY MR752 00770I 22 250RMMDD MR752 0000780I 26 300VENDOR MR752 00790I 31 360TDATE MR752 00800I 37 430QTYDUE MR752 00810I 44 500QTYIN MR752 00820IBOMMST XX 07 MR752 00830I 1 12 PART MR752 00840I 1 17 FLD MR752 0000850IPARTMST XX 08 MR752 00860I 44 460LEADTM MR752 00870I 146 1520SOH MR752 00880I 153 1590SOO MR752 00890I 181 1870MIN MR752 00900I 188 1940LOTSIZ MR752 00910I 195 195 MMCODE MR752 0000920ITEMRRN XX 09 MR752 00930I 1 1 A MR752 00940C 99 GOTO START 1ST CYCLE DONE MR752 00950C SETON 99 MR752 00960C***** MR752 00970C* IF U1 OFF, USE UDATE FOR DATE OF 1ST TIME PERIOD (IF U4 ON, MAKE MR752 00980C* IT THE LAST DAY OF UMONTH). IF U1 ON, GO GET BDATE ON CRT. MR752 0000990C***** MR752 01000C MOVE UDATE DATE,1 DATE,1=UDATE MR752 01010C MOVEL'30' N4 DATE,1=30TH DAYMR752 01020C MOVE UYEAR N4 OF UMONTH MR752 01030C U4 MOVE N4 DATE,1 MR752 01040C U1 EXSR GETDAT ACCEPT DATE,1 MR752 01050C***** MR752 0001060C* IF U4 OFF, TIME PERIOD INCREMENTS = WEEKS. IF ON, = MONTHS. MR752 01070C***** MR752 01080C Z-ADD700 INC 50 WEEKS MR752 01090C U4 Z-ADD10000 INC MONTHS MR752 01100C EXSR DATES LOAD DATE ARY MR752 01110C************************ MR752 01120C START TAG MR752 0001130C************************ MR752 01140C Z-ADD0 X MR752 01150C 01 GOTO FC MR752 01160C 02 MR752 01170COR 03 GOTO WO MR752 01180C 05 GOTO PO MR752 01190C 07 GOTO BOM MR752 0001200C GOTO END MR752 01210C************************ MR752 01220C FC TAG FORCST RECS MR752 01230C************************ MR752 01240C X ADD 1 X MR752 01250C FAR,X COMP 0 20 MR752 01260C 20 EXCPT MR752 0001270C X COMP 24 21 MR752 01280C 21 GOTO FC MR752 01290C GOTO END MR752 01300C************************ MR752 01310C WO TAG WRKORD RECS MR752 01320C************************ MR752 01330C 02 RGCOD COMP 'X' 10 MR752 0001340C 02 SETOF 93 MR752 01350C QTYDUE SUB QTYIN DIFF 70 25 MR752 01360C 02 STAT COMP 'C' 93 MR752 01370C 02 93 SETOF 25 MR752 01380C GOTO END MR752 01390C************************ MR752 01400C PO TAG PURCH RECS MR752 0001410C************************ MR752 01420C QTYDUE SUB QTYIN DIFF 26 MR752 01430C GOTO END MR752 01440C************************ MR752 01450C BOM TAG BOMMST RECS MR752 01460C************************ MR752 01470C RRN ADD 1 RRN 50 MR752 0001480C EXSR GETAVL MR752 01490C************************ MR752 01500C END TAG MR752 01510C********************************************************************MR752 01520C********************************************************************MR752 01530CSR GETDAT BEGSR MR752 01540C************************ MR752 0001550CSR BAD TAG MR752 01560C************************ MR752 01570CSR MOVEL'ENTER ' TEMP 12 MR752 01580CSR MOVE 'DATE- ' TEMP MR752 01590CSR MOVELTEMP BUFFER MR752 01600CSR MOVE 'S' TYPE MR752 01610CSR Z-ADD12 BLNGTH MR752 0001620CSR EXSR CRTCOM MR752 01630CSR MOVE 'A' TYPE MR752 01640CSR Z-ADD6 BLNGTH MR752 01650CSR EXSR CRTCOM MR752 01660CSR MOVELBUFFER DATE,1 MR752 01670CSR MOVEL' ' BUFFER MR752 01680CSR MOVE 'T' TYPE MR752 0001690CSR EXSR CRTCOM MR752 01700CSR MOVELDATE,1 MO 20 MM MR752 01710CSR MOVELDATE,1 N4 40 MMDD MR752 01720CSR MOVE N4 DAY 20 DD MR752 01730CSR MOVE DATE,1 YR 20 YY MR752 01740CSR MO COMP 1 95 MR752 01750CSRN95 MO COMP 12 95 MR752 0001760CSR 95 GOTO BAD MR752 01770CSR DAY COMP 1 95 MR752 01780CSRN95 DAY COMP 30 95 30 DAYS/MONTH MR752 01790CSR 95 GOTO BAD MR752 01800CSR YR COMP 76 95 MR752 01810CSR 95 GOTO BAD MR752 01820CSR ENDSR MR752 0001830C********************************************************************MR752 01840C********************************************************************MR752 01850CSR CRTCOM BEGSR MR752 01860CSR EXITFSUBRCM MR752 01870CSR RLABL BUFFER 72 MR752 01880CSR RLABL TYPE 1 MR752 01890CSR RLABL BLNGTH 20 MR752 0001900CSR RLABL RCODE 1 MR752 01910CSR RLABL MASK 10 MR752 01920CSR RLABL DTYPE 10 MR752 01930CSR ENDSR MR752 01940C********************************************************************MR752 01950C********************************************************************MR752 01960CSR DATES BEGSR LOAD DATES MR752 0001970C************************ MR752 01980CSR DLOOP TAG MR752 01990C************************ MR752 02000CSR X ADD 1 X 20 MR752 02010CSR X ADD 1 Y 20 MR752 02020CSR DATE,X ADD INC DATE,Y MR752 02030CSR EXSR FIXDAT MR752 0002040CSR Y COMP 24 21 MR752 02050CSR 21 GOTO DLOOP MR752 02060CSR ENDSR MR752 02070C********************************************************************MR752 02080C********************************************************************MR752 02090CSR FIXDAT BEGSR MR752 02100CSR MOVELDATE,Y MO MM MR752 0002110CSR MOVELDATE,Y N4 MMDD MR752 02120CSR MOVE N4 DAY DD MR752 02130CSR MOVE DATE,Y YR YY MR752 02140CSR DAY SUB 30 OVER 20 90 ASSUME 30/MO MR752 02150CSR 90 Z-ADDOVER DAY MR752 02160CSR 90 MO ADD 1 MO MR752 02170CSR MO SUB 12 OVER 20 90 MR752 0002180CSR 90 Z-ADDOVER MO MR752 02190CSR 90 YR ADD 1 YR MR752 02200CSR MOVE YR DATE,Y ----YY MR752 02210CSR MOVE DAY N4 --DD MR752 02220CSR MOVELN4 DATE,Y --DDYY MR752 02230CSR MOVELMO DATE,Y MMDDYY MR752 02240CSR ENDSR MR752 0002250C********************************************************************MR752 02260C********************************************************************MR752 02270CSR GETAVL BEGSR MR752 02280CSR PART CHAINPARTMST 51 MR752 02290CSR 51 Z-ADD0 AVAIL 70 MR752 02300CSR 51 Z-ADD0 LEADTM MR752 02310CSR 51 Z-ADD0 MIN MR752 0002320CSR 51 Z-ADD0 LOTSIZ MR752 02330CSR 51 MOVE ' ' MMCODE MR752 02340CSRN51 SOH ADD SOO AVAIL 16 MR752 02350CSR 16 Z-ADD0 AVAIL IF AVAIL < 0 MR752 02360CSR RRN CHAINTEMRRN 33 MR752 02370CSR ENDSR MR752 02380C********************************************************************MR752 0002390C********************************************************************MR752 02400O***** MR752 02410O* FOR OJ'S, PUT TDATE (=PLANNED RELEASE DATE) IN DUE DATE FIELD MR752 02420O* AND PUT DUE DATE IN TDATE. THEY WILL BE REVERSED BACK IN MR752 02430O* MFG755. THIS IS TO INSURE THAT THE 1ST LEVEL COMPS OF THE MR752 02440O* W.O. WILL BE DUE ON THE DATE PLANNED TO START WORK INSTEAD MR752 02450O* OF THE PLANNED COMPLETION DATE. MR752 0002460O***** MR752 02470OORDERS E 01 20 MR752 02480O 2 'SO' MR752 02490O 4 'FC' MR752 02500O X 6 MR752 02510O PN 21 MR752 02520O FAR,X 28 MR752 0002530O DATE,X 34 MR752 02540O UDATE 40 MR752 02550O D 02 MR752 02560O OR 03 25 MR752 02570O 02 2 'OJ' MR752 02580O 03 2 'RJ' MR752 02590O WONUM 7 MR752 0002600O PN 21 MR752 02610O DIFF 28 MR752 02620O 02 TDATE 34 MR752 02630O 03 DUEDAT 34 MR752 02640O 02 DUEDAT 40 MR752 02650O 03 TDATE 40 MR752 02660O 02 10 46 'X' MR752 0002670O 03 46 'X' MR752 02680O D 05 26 MR752 02690O 2 'PO' MR752 02700O PONUM 9 MR752 02710O PN 21 MR752 02720O DIFF 28 MR752 02730O RMMDD 32 MR752 0002740O RYY 34 MR752 02750O TDATE 40 MR752 02760O VENDOR 45 MR752 02770O 46 'X' MR752 02780OBOMMST D 07 MR752 02790O RRN 27 MR752 02800OTEMRRN D 07N33 MR752 0002810O FLD 17 MR752 02820O AVAIL 24 MR752 02830O LEADTM 27 MR752 02840O MMCODE 28 MR752 02850O MIN 35 MR752 02860O LOTSIZ 42 MR752 ** 00287000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002880ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002890ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002900ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002910/* 002920__0O LOTSIZ 42 MR752 ** 0028700(* ?OTXMR755 P999999041478(000010H S MR755 00020X DECK-ID M39 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR755 00030F* EXPLODE TOP UNITS INTO PARTS REQUIRED. MR755 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR755 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR755 00060F* CONTROL DATA PROPRIETARY PRODUCT MR755 00070F* MR755 0000080FORDWRK IPEAF 46 DISK MR755 00090FTEMRRN UC F 42R DISK MR755 00100FBOMMST IC F 28R12AI 1 DISK MR755 00110FBOMSTR IC F 54R DISK MR755 00120FEXPLODE O F 60 DISK MR755 00130F* MR755 00140F* ************************************************************** MR755 0000150F* ** ** MR755 00160F* ** COMPUSOURCE ADM- MATERIAL REQUIREMENTS PLANNING ** MR755 00170F* ** ** MR755 00180F* ** MFG755- EXPLODE REQUIREMENTS ** MR755 00190F* ** ** MR755 00200F* ** ROBBIE FREEMAN 7/23/76 ** MR755 00210F* ** ** MR755 0000220F* ************************************************************** MR755 00230F* ** ** MR755 00240F* ** FUNCTION OF INDICATORS ** MR755 00250F* ** ** MR755 00260F* ** 01 ORDWRK- SALES ORDERS ** MR755 00270F* ** 02 ORDWRK- OPEN JOBS ** MR755 00280F* ** 03 ORDWRK- RELEASED JOBS ** MR755 0000290F* ** 04 ORDWRK- PURCHASE ORDERS ** MR755 00300F* ** 05 TEMRRN ** MR755 00310F* ** 06 BOMMST ** MR755 00320F* ** 07 BOMSTR ** MR755 00330F* ** 15 RGCODE BLANK - THIS ITEM WAS EXPLODED FURTHER ** MR755 00340F* ** 20 ASSEMBLY RR# > 0 - THIS PART HAS COMPONENTS ** MR755 00350F* ** 22 BOMSTR 'NEXT CODE' IS BLANK - MORE COMPONENTS ** MR755 0000360F* ** TO BE EXPLODED ON THIS LEVEL. ** MR755 00370F* ** 30 SUBR DDATE FOR OJ'S ONLY - USE PLANNED RELEASE ** MR755 00380F* ** (START) DATE OF PARENT FOR REQ'D DATE OF 1ST ** MR755 00390F* ** LEVEL COMPONENTS (IND=1). ** MR755 00400F* ** 41 CAN'T GO DOWN FURTHER IN EXPLODE - GO ACROSS ** MR755 00410F* ** 42 EXPLODE HAS REACHED NORMAL COMPLETION ** MR755 00420F* ** 50 NO HIT ON BOMMST - NO COMPONENTS ** MR755 0000430F* ** 60 SUBR DECIDE: EXPLODE QTY=LOTSIZ BECAUSE >REQTS ** MR755 00440F* ** 61 MIN/MAX CODE = 'X' OR 'N' - DON'T EXPLODE ** MR755 00450F* ** 64 SAME AS 61 BUT FOR COMPONENTS ** MR755 00460F* ** 65 AVAIL HAS GONE BELOW MIN - EXPLODE ** MR755 00470F* ** 66 !! 15 LEVELS ENCOUNTERED IN EXPLODE - STOP !! ** MR755 00480F* ** 70 SUBR DDATE: DUE DAY > 30 - MAKE IT 30 ** MR755 00490F* ** 71 SUBR DDATE: OVERFLOW TO NEXT MONTH - ADJUST ** MR755 0000500F* ** 72 SUBR DDATE: OVERFLOW TO NEXT YEAR - ADJUST ** MR755 00510F* ** 81 EXCPT OUTPUT NEW AVAILABLE BALANCE TO TEMRRN ** MR755 00520F* ** 82 EXCPT OUTPUT PLANNED REQMT RECS TO EXPLODE ** MR755 00530F* ** 99 STRUCTURE QTY ON BOMSTR = 0 - DEFAULT TO 1 ** MR755 00540F* ** ** MR755 00550F* ** U1 SET MIN = 0 ** MR755 00560F* ** U2 SET LOTSIZ = 0 ** MR755 0000570F* ************************************************************** MR755 00580F* MR755 00590E A1 15 7 0 REQMTS MR755 00600E A2 15 5 0 NXTRRN MR755 00610E A3 15 12 PARENT# MR755 00620E A4 15 6 0 DUE DATE MR755 00630IORDWRK NS 01 1 CS 2 CO MR755 0000640I OR 02 1 CO 2 CJ MR755 00650I OR 03 1 CR 2 CJ MR755 00660I OR 04 1 CP 2 CO MR755 00670I 3 9 REFNO MR755 00680I 10 21 PARTNOL1 MR755 00690I 22 280AMT MR755 00700I 29 340DUEDAT MR755 0000710I 46 46 RGCODE 15 MR755 00720I 35 400TDATE MR755 00730I 41 45 CUSTNO MR755 00740ITEMRRN NS 05 MR755 00750I 1 12 PARTNO MR755 00760I 13 170ASYPTR 20 MR755 00770I 18 240AVAIL MR755 0000780I 25 270LEADTM MR755 00790I 28 28 MMCODE MR755 00800I 29 350MIN MR755 00810I 36 420LOTSIZ MR755 00820IBOMMST NS 06 MR755 00830I 23 270RRNUM MR755 00840IBOMSTR NS 07 MR755 0000850I 1 12 PARENT MR755 00860I 13 24 COMPNT MR755 00870I 25 313QTY MR755 00880I 32 360RRN MR755 00890I 47 510BMPTR MR755 00900I 52 52 NXTCD 22 MR755 00910C********************************************************************MR755 0000920C* MR755 00930C* THIS PROGRAM EXPLODES ALL PART NUMBERS FOUND ON THE SALES ORDERS MR755 00940C* AND OPEN JOBS INTO THEIR COMPONENT PARTS. THE EXPLODE STOPS MR755 00950C* UNDER CERTAIN CONDITIONS: MR755 00960C* MR755 00970C* FOR SALES ORDERS-- EXPLODE QTY = MAX(LOT SIZE,MINIMUM-AVAIL) MR755 00980C* MR755 0000990C* 1.AN 'X' IS ENCOUNTERED IN THE REQUIREMENTS GENERATION CODE MR755 01000C* 2.THERE IS ENOUGH STOCK ON HAND PLUS STOCK ON ORDER TO MEET MR755 01010C* THE REQUIREMENTS (AVAIL > OR EQ TO MINIMUM) MR755 01020C* 3.THE PART IS NOT UNDER REQUIREMENTS GENERATION CONTROL - MR755 01030C* MMCODE IS 'N' OR 'X' MR755 01040C* MR755 01050C* FOR OPEN JOBS-- EXPLODE QTY = JOB QTY MR755 0001060C* MR755 01070C* 1.AN 'X' IS ENCOUNTERED IN THE REQUIREMENTS GENERATION CODE MR755 01080C* 2.THE PART IS NOT UNDER REQUIREMENTS GENERATION CONTROL - MR755 01090C* MMCODE IS 'X' OR 'N' MR755 01100C* MR755 01110C* NOTE- IF U1 IS ON WE ZERO OUT 'MIN' - THIS CAUSES THE EXPLODE MR755 01120C* TO CONTINUE ONLY WHEN THE AVAIL < 0 MR755 0001130C* MR755 01140C* IF U2 IS ON WE ZERO OUT 'LOTSIZ' - THIS CAUSES THE EXPLODE MR755 01150C* QTY = REQMTS ONLY = MINIMUM-AVAIL = -(AVAIL) IF U1 IS ON. MR755 01160C* MR755 01170C* THE EXPLODE FILE CONTAINS ONE ENTRY FOR EVERY WORK ORDER OR MR755 01180C* SALES ORDER ON ORDERS FILE PLUS ONE RECORD FOR EVERY COMPONENT MR755 01190C* FOUND IN THE EXPLODE MR755 0001200C* MR755 01210C* THE REQUIRED DATES FOR COMPONENTS ARE COMPUTED BY SUBTRACTING MR755 01220C* THE LEAD TIME FOR ITS PARENT FROM THE DUE DATE FOR ITS PARENT. MR755 01230C* HOWEVER, FOR OPEN JOBS, OJ'S, WE USE THE START DATE OF THE W.O. MR755 01240C* AS THE DUE DATE OF ITS 1ST ASSY COMPS BECAUSE WE ASSUME THE MR755 01250C* PARTS FOR THE W.O. WILL BE REQUIRED BY THEN. MR755 01260C* MR755 0001270C********************************************************************MR755 01280C* MR755 01290C* MR755 01300C MOVE PARTNO SPART 12 MR755 01310C Z-ADD0 SREQMT 70 MR755 01320C N02 MOVE DUEDAT SDATE 60 MR755 01330C 02 MOVE TDATE SDATE MR755 0001340C 02 MOVE DUEDAT TDATE MR755 01350C L1 PARTNO CHAINBOMMST 50 MR755 01360C 01 50 MR755 01370COR 02 50 MOVE 'X' RGCODE NOT EXPLODED MR755 01380C 50 GOTO DEND NO COMPONENTS MR755 01390C L1 Z-ADDRRNUM RRSAVE 50 MR755 01400C RRSAVE CHAINTEMRRN H6 MR755 0001410C H6 GOTO DEND MR755 01420C N01N02 GOTO DEND SO'S,OJ'S ONLY MR755 01430C 02N15 GOTO DEND OJ & RGCODE=X MR755 01440C MMCODE COMP 'X' 61 MR755 01450C N61 MMCODE COMP 'N' 61 MR755 01460C 61 MOVE 'X' RGCODE NOT EXPLODED MR755 01470C 61 GOTO DEND MR755 0001480C 02N20 MOVE 'X' RGCODE NO COMPONENTS MR755 01490C 02N20 GOTO DEND MR755 01500C 02 Z-ADDAMT REQMT 70 MR755 01510C 02 GOTO EXPLD MR755 01520C********** MR755 01530C* THE FOLLOWING CALCS (UNTIL TAG 'EXPLD') ARE FOR SO'S ONLY. MR755 01540C** MR755 0001550C* DETERMINE WHETHER OR NOT TO EXPLODE MR755 01560C********** MR755 01570C Z-ADDAMT PRQTY 70 MR755 01580C EXSR DECIDE MR755 01590C Z-ADDEXPQTY REQMT MR755 01600C************************ MR755 01610C OUTAVL TAG UPDATE AVAIL MR755 0001620C************************ MR755 01630C SETON 81 MR755 01640C EXCPT MR755 01650C SETOF 81 MR755 01660C 65 15 20 Z-ADDREQMT SREQMT SAVE EXP QTY MR755 01670C 65 15 20 GOTO EXPLD MR755 01680C MOVE 'X' RGCODE NOT EXPLODED MR755 0001690C GOTO DEND MR755 01700C************************ MR755 01710C EXPLD TAG MR755 01720C************************ MR755 01730C MOVE PARTNO PRTNUM 12 MR755 01740C MOVE PARTNO PRNTNO 12 MR755 01750C Z-ADD1 IND 20 MR755 0001760C EXSR DDATE MR755 01770C ASYPTR CHAINBOMSTR H1 MR755 01780C H1 GOTO DEND MR755 01790C 22 RRN ADD 1 NXTRRN 50 MR755 01800C N22 Z-ADD0 NXTRRN MR755 01810C************************ MR755 01820C EXLOOP TAG MR755 0001830C************************ MR755 01840C QTY COMP 0 99 MR755 01850C 99 Z-ADDREQMT EXTREQ 70 MR755 01860C N99 QTY MULT REQMT EXTREQ H MR755 01870C BMPTR CHAINTEMRRN H2 MR755 01880C H2 GOTO DEND MR755 01890C MMCODE COMP 'X' 64 MR755 0001900C N64 MMCODE COMP 'N' 64 MR755 01910C 64 GOTO NXTCMP MR755 01920C Z-ADDEXTREQ PRQTY MR755 01930C EXSR DECIDE MR755 01940C Z-ADDEXPQTY EXTREQ MR755 01950C SETON 82 MR755 01960C EXCPT MR755 0001970C SETOF 82 MR755 01980C N20 GOTO NXTCMP MR755 01990C MOVE COMPNT PRTNUM MR755 02000C ASYPTR CHAINBOMSTR H5 MR755 02010C H5 GOTO DEND MR755 02020C PARTNO COMP PARENT H3H3 MR755 02030C H3 GOTO DEND MR755 0002040C************************ MR755 02050C OUTAV2 TAG MR755 02060C************************ MR755 02070C SETON 81 MR755 02080C EXCPT MR755 02090C SETOF 81 MR755 02100C N65 GOTO NXTCMP MR755 0002110C MOVE REQMT A1,IND MR755 02120C MOVE NXTRRN A2,IND MR755 02130C MOVE PRNTNO A3,IND MR755 02140C MOVE NDUEDT A4,IND MR755 02150C MOVE EXTREQ REQMT MR755 02160C MOVE NDUEDT DUEDAT MR755 02170C* MR755 0002180C 22 RRN ADD 1 NXTRRN MR755 02190C N22 Z-ADD0 NXTRRN MR755 02200C MOVE PRTNUM PRNTNO MR755 02210C IND ADD 1 IND MR755 02220C IND COMP 15 66 MR755 02230C 66 GOTO DEND MR755 02240C EXSR DDATE MR755 0002250C GOTO EXLOOP MR755 02260C************************ MR755 02270C NXTCMP TAG MR755 02280C************************ MR755 02290C NXTRRN COMP 0 4141 MR755 02300C N41 NXTRRN CHAINBOMSTR 41 MR755 02310C N41 PRNTNO COMP PARENT 4141 MR755 0002320C N41 22 NXTRRN ADD 1 NXTRRN MR755 02330C N41N22 Z-ADD0 NXTRRN MR755 02340C N41 GOTO EXLOOP MR755 02350C IND SUB 1 IND 4242 MR755 02360C 42 GOTO DEND MR755 02370C MOVE A1,IND REQMT MR755 02380C MOVE A2,IND NXTRRN MR755 0002390C MOVE A3,IND PRNTNO MR755 02400C MOVE A4,IND NDUEDT MR755 02410C GOTO NXTCMP MR755 02420C************************ MR755 02430C DEND TAG MR755 02440C********************************************************************MR755 02450CSR DECIDE BEGSR MR755 0002460CSR U1 Z-ADD0 MIN MR755 02470CSR U2 Z-ADD0 LOTSIZ MR755 02480CSR AVAIL SUB PRQTY AVAIL MR755 02490CSR MIN SUB AVAIL EXPQTY 70 65 EXPLODE QTY MR755 02500CSR 65 EXPQTY COMP LOTSIZ 60 MR755 02510CSR 65 60 Z-ADDLOTSIZ EXPQTY MR755 02520CSR 65 AVAIL ADD EXPQTY AVAIL MR755 0002530CSR ENDSR MR755 02540C********************************************************************MR755 02550CSR DDATE BEGSR MR755 02560CSR 02 IND COMP 1 30 MR755 02570CSR 02 30 MOVE DUEDAT NDUEDT MR755 02580CSR 02 30 GOTO ENDDUE MR755 02590CSR MOVELDUEDAT DUEMO 20 MR755 0002600CSR MOVE DUEDAT DUEYR 20 MR755 02610CSR MOVE DUEDAT TEMP 40 MR755 02620CSR MOVELTEMP DUEDA 20 MR755 02630CSR DUEDA COMP 31 70 70 MR755 02640CSR 70 Z-ADD30 DUEDA ASSUME 30/MON MR755 02650CSR 70 LEADTM SUB 1 LEADTM MR755 02660CSR LEADTM DIV 30 NMO 20 MR755 0002670CSR MVR NDAYS 20 MR755 02680CSR DUEDA SUB NDAYS NEWDA 20 7171 MR755 02690CSR 71 NMO ADD 1 NMO MR755 02700CSR 71 NEWDA ADD 30 NEWDA MR755 02710CSR NMO DIV 12 NYR 20 MR755 02720CSR MVR NMONS 20 MR755 02730CSR DUEMO SUB NMONS NEWMO 20 7272 MR755 0002740CSR 72 NYR ADD 1 NYR MR755 02750CSR 72 NEWMO ADD 12 NEWMO MR755 02760CSR DUEYR SUB NYR NEWYR 20 MR755 02770CSR MOVELNEWMO NDUEDT 60 MR755 02780CSR MOVELNEWDA TEMP MR755 02790CSR MOVE NEWYR TEMP MR755 02800CSR MOVE TEMP NDUEDT MR755 0002810CSR ENDDUE ENDSR MR755 02820C** MR755 02830C********************************************************************MR755 02840C* MR755 02850OEXPLODE D 01 MR755 02860O OR 02 MR755 02870O OR 03 MR755 0002880O OR 04 MR755 02890O 01 2 'SO' MR755 02900O 02 2 'OJ' MR755 02910O 03 2 'RJ' MR755 02920O 04 2 'PO' MR755 02930O SPART 14 MR755 02940O REFNO 21 MR755 0002950O AMT 28 MR755 02960O SDATE 34 MR755 02970O TDATE 40 MR755 02980O CUSTNO 45 MR755 02990O RGCODE 53 MR755 03000O SREQMT 60 MR755 03010O E 82 MR755 0003020O 2 'PR' MR755 03030O COMPNT 14 MR755 03040O REFNO 21 MR755 03050O PRQTY 28 MR755 03060O NDUEDT 34 MR755 03070O UDATE 40 MR755 03080O SPART 52 MR755 0003090O 53 'X' MR755 03100O 20 65 53 ' ' MR755 03110O 20 65 EXTREQ 60 MR755 03120OTEMRRN E 81 MR755 03130O AVAIL 24 MR755 ** 003140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00315000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003180/* 003190__0O AVAIL 24 MR755 ** 003140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0031500(,(/ }OTXMR760 P999999041478(000010H S MR760 00020X DECK-ID M40 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR760 00030F* MATERIAL REQUIREMENTS REPORT MR760 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR760 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR760 00060F* CONTROL DATA PROPRIETARY PRODUCT MR760 00070F* MR760 0000080FPARTMST IPEAF 300 12AI 1 DISK MR760 00090FSEXPLD ISEAF 60 DISK MR760 00100FHEADING IT F 40 EDISK MR760 00110FORDACT O F 102 DISK MR760 00120F$LP1 O F 132 OF PRINTER U3 MR760 00130E HEADING HEAD 1 1 40 COMPANY NAME MR760 00140IPARTMST NS 01 MR760 0000150I 1 12 PARTNOL1M1 MR760 00160I 13 37 DESC MR760 00170I 38 39 UM MR760 00180I 40 40 CLS MR760 00190I 44 460LEAD MR760 00200I 47 490SSDAYS MR760 00210I 146 1520SOH MR760 0000220I 153 1590SOO MR760 00230I 181 1870MIN 10 10 MR760 00240I 188 1940LOTSIZ MR760 00250I 195 195 INVCOD MR760 00260I 203 2090AVGUSE MR760 00270ISEXPLD NS 03 1 CO 2 CJ MR760 00280I OR 04 1 CR 2 CJ MR760 0000290I OR 05 1 CS 2 CO MR760 00300I OR 06 1 CP 2 CR MR760 00310I OR 07 1 CP 2 CO MR760 00320I 3 14 PARTNOL1M1 MR760 00330I 15 19 REFNO MR760 00340I 20 21 REFLOT 12 MR760 00350I 22 280EXPQTY MR760 0000360I 29 340REQDTE MR760 00370I 35 400TRNDTE MR760 00380I 41 450CUSVEN MR760 00390I 41 52 PARENT MR760 00400I 53 53 RGCODE 15 MR760 00410I 54 600RGQTY MR760 00420I NS 02 MR760 0000430I 1 1 A MR760 00440C SETOF 8090 MR760 00450C 02 GOTO DEND MR760 00460C L1 SETOF 20 MR760 00470C L1 SETOF 659192 MR760 00480C L1 SETOF 959899 MR760 00490C L1 Z-ADD0 RESERV 70 MR760 0000500C L1 Z-ADD0 NEWSOO 70 MR760 00510C L1 Z-ADD0 AVAIL 70 MR760 00520C L1 Z-ADD0 TOTRG 70 MR760 00530C L1N01 Z-ADD0 SOH MR760 00540C 01 Z-ADDSOH AVAIL MR760 00550C 01 U1 Z-ADD0 MIN MR760 00560C 01 U2 Z-ADD0 LOTSIZ MR760 0000570C 01 SOH COMP MIN 90 SOH < MIN? MR760 00580C 01 90 Z-ADDUDATE ORDTE MR760 00590C 01 90 SETON 9192 MR760 00600C 01 SETON 99 PART# ON FILE MR760 00610C 01 INVCOD COMP 'X' 65 NO REQT GEN MR760 00620C 01N65 INVCOD COMP 'N' 65 NO REQT GEN MR760 00630C 01 GOTO DEND MR760 0000640C SETON 8095 MR760 00650C 03 MR760 00660COR 04 MR760 00670COR 07 GOTO ADDSOO MR760 00680C 05 MR760 00690COR 06 GOTO ADDRSV MR760 00700C************************ MR760 0000710C ADDSOO TAG MR760 00720C************************ MR760 00730C EXPQTY ADD NEWSOO NEWSOO MR760 00740C EXPQTY ADD AVAIL AVAIL MR760 00750C AVAIL COMP MIN 90 MR760 00760C 90N92 Z-ADDREQDTE ORDTE 60 MR760 00770C 90 SETON 9192 MR760 0000780C N90 SETOF 92 MR760 00790C GOTO DEND MR760 00800C************************ MR760 00810C ADDRSV TAG MR760 00820C************************ MR760 00830C AVAIL SUB EXPQTY AVAIL MR760 00840C EXPQTY ADD RESERV RESERV MR760 0000850C RGQTY ADD TOTRG TOTRG 20 MR760 00860C AVAIL COMP MIN 90 MR760 00870C 90N92 Z-ADDREQDTE ORDTE MR760 00880C 90 SETON 9192 MR760 00890C N90 SETOF 92 MR760 00900C************************ MR760 00910C DEND TAG MR760 0000920C************************ MR760 00930CL1 65 SETOF 92 MR760 00940CL1 92 EXSR ODATE MR760 00950CL1 99 NEWSOO COMP SOO 9898 MR760 00960C************************ MR760 00970CL1 L1END TAG MR760 00980C************************ MR760 0000990C********************************************************************MR760 01000C* SUBR ODATE CALCULATES REORDER DATE BY SUBTRACTING LEAD TIME MR760 01010C* FROM DUE DATE. MR760 01020C********************************************************************MR760 01030CSR ODATE BEGSR MR760 01040CSR MOVELORDTE DUEMO 20 MR760 01050CSR MOVE ORDTE DUEYR 20 MR760 0001060CSR MOVE ORDTE TEMP 40 MR760 01070CSR MOVELTEMP DUEDA 20 MR760 01080CSR DUEDA COMP 31 70 70 MR760 01090CSR 70 Z-ADD30 DUEDA ASSUME 30/MONTHMR760 01100CSR 70 LEAD SUB 1 LEADTM 30 MR760 01110CSRN70 Z-ADDLEAD LEADTM MR760 01120CSR LEADTM DIV 30 T1 64 MR760 0001130CSR MOVELT1 NMO 20 MR760 01140CSR MOVE T1 T2 44 MR760 01150CSR T2 MULT 30 NDAYS 20H MR760 01160CSR DUEDA SUB NDAYS NEWDA 20 7171 MR760 01170CSR 71 NMO ADD 1 NMO MR760 01180CSR 71 NEWDA ADD 30 NEWDA MR760 01190CSR NMO DIV 12 T1 MR760 0001200CSR MOVELT1 NYR 20 MR760 01210CSR MOVE T1 T2 MR760 01220CSR T2 MULT 12 NMONS 20H MR760 01230CSR DUEMO SUB NMONS NEWMO 20 7272 MR760 01240CSR 72 NYR ADD 1 NYR MR760 01250CSR 72 NEWMO ADD 12 NEWMO MR760 01260CSR DUEYR SUB NYR NEWYR 20 MR760 0001270CSR MOVELNEWMO ORDDAT 60 MR760 01280CSR MOVELNEWDA TEMP MR760 01290CSR MOVE NEWYR TEMP MR760 01300CSR MOVE TEMP ORDDAT MR760 01310CSR ENDSR MR760 01320C********************************************************************MR760 01330C********************************************************************MR760 0001340O$LP1 H 202 1P MR760 01350O OR OF MR760 01360O PAGE Z 9 MR760 01370O 4 'PAGE' MR760 01380O HEAD,1 86 MR760 01390O UDATE Y 132 MR760 01400O H 2 1P MR760 0001410O OR OF MR760 01420O 76 'MATERIAL REQUIREMENTS' MR760 01430O 132 'MFG760' MR760 01440O H 1 1P MR760 01450O OR OF MR760 01460O 86 'CUST/' MR760 01470O H 1 1P MR760 0001480O OR OF MR760 01490O 47 'M I' MR760 01500O 86 'TRAN VEND/' MR760 01510O 103 'REQUIRED' MR760 01520O 125 'AVAIL' MR760 01530O H 2 1P MR760 01540O OR OF MR760 0001550O 11 'PART NUMBER' MR760 01560O 25 'DESCRIPTION' MR760 01570O 43 'UM' MR760 01580O 47 'P C' MR760 01590O 60 'TRANSACTION' MR760 01600O 69 'REF #' MR760 01610O 77 'DATE' MR760 0001620O 87 'PARENT' MR760 01630O 101 'DATE' MR760 01640O 114 'QUANTITY' MR760 01650O 126 'BALANCE' MR760 01660O D 11 L1 MR760 01670O PARTNO 12 MR760 01680O 01 DESC 39 MR760 0001690O N01 36 '** NO MASTER RECORD **' MR760 01700O 01 UM 43 MR760 01710O 01 CLS 45 MR760 01720O 01 INVCOD 47 MR760 01730O 56 'BEG BAL' MR760 01740O SOH J 115 MR760 01750O SOH J 127 MR760 0001760O 90 132 '**' MR760 01770O D 1 80 MR760 01780O 15 RGQTY M 38 MR760 01790O 15 47 'REQT GEN' MR760 01800O 03 60 'OPEN JOB ' MR760 01810O 04 60 'REL JOB ' MR760 01820O 05 60 'SALES ORDER' MR760 0001830O 06 60 'PLND REQT ' MR760 01840O 07 60 'OPEN P.O. ' MR760 01850O REFNO 66 MR760 01860O N12 67 '-' MR760 01870O N12 REFLOT 69 MR760 01880O TRNDTEY 79 MR760 01890O N06 CUSVENZ 86 MR760 0001900O 06 PARENT 93 MR760 01910O REQDTEY 103 MR760 01920O EXPQTYJ 115 MR760 01930O AVAIL J 127 MR760 01940O 90 132 '**' MR760 01950O T 1 L1 95 MR760 01960O OR L1N95 91 MR760 0001970O 20 TOTRG M 38 MR760 01980O 20 47 'TOTAL RG' MR760 01990O 56 'END BAL' MR760 02000O 91 10 94 '(MIN= )' MR760 02010O 91 10 MIN 3 93 MR760 02020O 92 115 '** ACTION **' MR760 02030O AVAIL J 127 MR760 0002040O 98 130 'OB' MR760 02050O 90 132 '**' MR760 02060O T 2 LR MR760 02070O 11 'END OF JOB.' MR760 02080OORDACT T L1 92 MR760 02090O PARTNO 12 MR760 02100O 99 DESC 37 MR760 0002110O N99 36 '** NOT ON PART MASTER **' MR760 02120O 99 UM 39 MR760 02130O 99 CLS 40 MR760 02140O SOH 47 MR760 02150O NEWSOO 54 MR760 02160O RESERV 61 MR760 02170O 99 MIN 68 MR760 0002180O 99 LOTSIZ 75 MR760 02190O ORDTE 81 MR760 02200O ORDDAT 87 MR760 02210O 99 AVGUSE 94 MR760 02220O 99 LEAD 97 MR760 02230O 99 SSDAYS 100 MR760 02240O 98 101 '*' MR760 00** 002250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002290/* 002300__0O 98 101 '*' MR760 0(-9 b$OTXMR765 P999999041478(000010H S MR765 00020X DECK-ID M41 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR765 00030F* TIME SERIES PLANNING REPORT MR765 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR765 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR765 00060F* CONTROL DATA PROPRIETARY PRODUCT MR765 00070F* MR765 0000080FSEXPLD IPEAF 60 DISK MR765 00090FPARTMST USEAF 300 12AI 1 DISK MR765 00100FHEADING IT F 40 EDISK MR765 00110FREXPLD UC F 60R DISK MR765 00120F$LP1 O F 132 OF PRINTER MR765 00130F* ************************************************************** MR765 00140F* ** COMPUSOURCE ADM- MATERIAL REQUIREMENTS PLANNING ** MR765 0000150F* ** ** MR765 00160F* ** MFG765- TIME SERIES PLANNING REPORT ** MR765 00170F* ** ** MR765 00180F* ** ROBBIE FREEMAN 8/3/76 ** MR765 00190F* ************************************************************** MR765 00200F* ** FUNCTION OF INDICATORS ** MR765 00210F* ** ** MR765 0000220F* ** 01 SEXPLD - REQUIREMENTS (SO,PR) ** MR765 00230F* ** 02 SEXPLD - RECEIPTS (OJ,RJ,PO) ** MR765 00240F* ** 03 PARTMST ** MR765 00250F* ** 04 REXPLD ** MR765 00260F* ** 20 AT LEAST ONE SEXPLD READ FOR THIS PART# ** MR765 00270F* ** 25 PARTMST READ FOR THIS PART# ** MR765 00280F* ** 31 SUBR "ACCEPT" - RUBOUT ** MR765 0000290F* ** 32 SUBR "ACCEPT" - RUBOUT @ BEGINNING OF FIELD ** MR765 00300F* ** 33 SUBR "ACCEPT" - LINEFEED ** MR765 00310F* ** 40 LOOP "LOOP" CONTROL ** MR765 00320F* ** 60 SUBR "CNET" - NET(T) > OR EQ TO 0 ** MR765 00330F* ** 61 1ST PASS THRU L1 LOOP "PLAN"-PRINT RCP,RQD,NET ** MR765 00340F* ** 62 2ND PASS THRU L1 LOOP "PLAN"-PRINT PLN ** MR765 00350F* ** 65 LOOPS "PLAN" & "OLOOP" CONTROL ** MR765 0000360F* ** 66 SUBR "CPLN" - NET(T)<0 & LOTSIZ > ABS[NET(T)] ** MR765 00370F* ** 69 PLN(T) NPLN(T) - OUTPUT '*' NEXT TO PLN(T) ** MR765 00380F* ** 70 SUBR "PERIOD"- TOTAL # OF PERIODS SPECIFIED ** MR765 00390F* ** WAS<11 - ADD DIFF TO LAST NON-0 PERIOD. ** MR765 00400F* ** 80 SUBR "CHKDAT" - DATE OVERFLOW TO NEXT MONTH ** MR765 00410F* ** 81 SUBR "PERIOD" - # OF WKS = 0 ** MR765 00420F* ** 82 SUBR "PERIOD" - # OF MOS = 0 ** MR765 0000430F* ** 83 SUBR "PERIOD" - # OF QTRS= 0 ** MR765 00440F* ** 85 LOOP "DONE" CONTROL ** MR765 00450F* ** 90 SUBR "OUTPUT" - DON'T USE MESSAGE IN TABLE ** MR765 00460F* ** 91 ACCEPT BEGINNING DATE ** MR765 00470F* ** 92 ACCEPT # OF WEEKS (ONLY IF U4 ON) ** MR765 00480F* ** 93 ACCEPT # OF MONTHS (ONLY IF U4 ON) ** MR765 00490F* ** 94 ACCEPT # OF QUARTERS (ONLY IF U4 ON) ** MR765 0000500F* ** 96 SUBR "EDIT" - ERROR - DISPLAY ERROR MESSAGE ** MR765 00510F* ** 98 1ST CYCLE ** MR765 00520F* ** 99 INITIALIZATION DONE ** MR765 00530F* ** U1 SET MIN=0; THEN, PLN=MAX(MIN-NET,LOTSIZ) ** MR765 00540F* ** =MAX[ABS(NET),LOTSIZ], IF NET OR EQ TO MIN. **MR765 04830C********************************************************************MR765 0004840CSR CPLN BEGSR MR765 04850CSR 60 Z-ADD0 NPLN,T MR765 04860CSR 60 GOTO ENDC MR765 04870CSR MIN SUB NET,T ABSNET 70 MR765 04880CSR LOTSIZ COMP ABSNET 66 MR765 04890CSR 66 Z-ADDLOTSIZ ABSNET MR765 04900CSR Z-ADDABSNET NPLN,T MR765 0004910CSR ENDC ENDSR MR765 04920C********************************************************************MR765 04930C** CAVL: TOTAL L1 TIME - COMPUTE AVL(T+1) = NET(T), IF NET(T)> OR **MR765 04940C** EQ TO MIN; = PLN(T)+NET(T), IF NET(T) NPLN(T). **MR765 05040C********************************************************************MR765 0005050CSR OPLAN BEGSR MR765 05060CSR Z-ADD0 T MR765 05070C************************ MR765 05080CSR OLOOP TAG MR765 05090C************************ MR765 05100CSR T ADD 1 T MR765 05110CSR Z-ADDPLN,T N7 MR765 0005120CSR MOVE B72 EWORD 24 MR765 05130CSR EXIT SUBRED MR765 05140CSR RLABL N7 70 MR765 05150CSR RLABL ECODE 1 ECODE = 4 MR765 05160CSR RLABL A8 8 MR765 05170CSR RLABL EPOS 20 EPOS = 7 MR765 05180CSR RLABL EWORD 24 MR765 0005190CSR MOVE A8 OPLN,T MR765 05200CSR PLN,T COMP NPLN,T 69 MR765 05210CSR 69 MOVE '*' OPLN,T MR765 05220CSR T COMP 13 65 MR765 05230CSRN65 GOTO OLOOP MR765 05240CSR ENDSR MR765 05250C********************************************************************MR765 0005260C********************************************************************MR765 05270O$LP1 H 02 1P MR765 05280O OR OF MR765 05290O UDATE Y 8 MR765 05300O HEAD,1 86 MR765 05310O H 2 98 MR765 05320O OR OF MR765 0005330O PAGE Z 8 MR765 05340O 4 'PAGE' MR765 05350O 76 'TIME SERIES PLANNING' MR765 05360O MD,1 Y 83 MR765 05370O 84 '/' MR765 05380O BYR 86 MR765 05390O 132 'MFG765' MR765 0005400O D 2 98 MR765 05410O OR OF MR765 05420O 35 'PAST' MR765 05430O D 11 98 MR765 05440O OR OF MR765 05450O 12 'PART NUMBER' MR765 05460O 15 'UM' MR765 0005470O 23 'SOH' MR765 05480O 35 'DUE' MR765 05490O MD,2 Y 43 MR765 05500O MD,3 Y 51 MR765 05510O MD,4 Y 59 MR765 05520O MD,5 Y 67 MR765 05530O MD,6 Y 75 MR765 0005540O MD,7 Y 83 MR765 05550O MD,8 Y 91 MR765 05560O MD,9 Y 99 MR765 05570O MD,10 Y 107 MR765 05580O MD,11 Y 115 MR765 05590O MD,12 Y 123 MR765 05600O 131 'FUTURE' MR765 0005610O E 1 61 MR765 05620O PART 12 MR765 05630O 25 UM 15 MR765 05640O SOH L 24 MR765 05650O 28 'RQD' MR765 05660O RQD 132 ' -' MR765 05670O E 1 61 MR765 0005680O 25 DESC 25 MR765 05690O N25 24 '** NOT ON PART MASTER **' MR765 05700O 28 'RCP' MR765 05710O RCP 132 ' -' MR765 05720O E 1 61 MR765 05730O 3 'LT:' MR765 05740O 25 LEAD M 8 MR765 0005750O 15 'MIN:' MR765 05760O 25 MIN M 24 MR765 05770O 28 'NET' MR765 05780O NET 132 ' -' MR765 05790O E 11 62 MR765 05800O 15 'TOT PLN:' MR765 05810O TOTPLNM 24 MR765 0005820O 28 'PLN' MR765 05830O OPLN 132 MR765 05840OREXPLD D 01 MR765 05850O OR 02 MR765 05860O REC 60 MR765 05870OPARTMST D 03 U3 MR765 05880O SAVERR 270 MR765 0005890O********************************************************************MR765 05900O********************************************************************MR765 ** 005910ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005920ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005930ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005940ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00595000** MSG: POS 1-4=CURPOS,5-6=LENG,7-54=MES 005960270046TIME SERIES PLANNING MFG765 005970130248BEGINNING DATE WEEKS MONTHS QUARTERS 005980160448[ ] [ ] [ ] [ ] 005990170406 006000250402** 006010330402 00602000370402** 006030440402 006040480402** 006050560402 006060600402** 006070** MTH: #DAYS/MONTH 006080312831303130313130313031 00609000/* 006100__02 006040480402** 006050560402 006060600402** 006070** MTH: #DAYS/MONTH 006080312831303130313130313031 0060900(+ W?OTXMR770 P999999041478(000010H S MR770 00020X DECK-ID M42 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR770 00030F* SUGGESTED ORDER ACTION REPORT MR770 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR770 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR770 00060F* CONTROL DATA PROPRIETARY PRODUCT MR770 00070F* MR770 0000080FORDACT IPEAF 102 DISK MR770 00090FHEADING IT F 40 EDISK MR770 00100F$LP1 O F 132 OF PRINTER MR770 00110E HEADING HEAD 1 1 40 MR770 00120IORDACT NS 01 MR770 00130I 1 12 PN MR770 00140I 13 37 DESC MR770 0000150I 38 39 UM MR770 00160I 40 40 CLS MR770 00170I 41 470SOH MR770 00180I 48 540SOO MR770 00190I 55 610RESERV MR770 00200I 62 680MIN MR770 00210I 69 750LOTSIZ MR770 0000220I 76 810RDATE MR770 00230I 82 870ODATE MR770 00240I 88 940USAGE MR770 00250I 95 970LT MR770 00260I 98 1000SS MR770 00270I 101 101 OBFLAG 10 MR770 00280C NU2NU3 SETON H1 MR770 0000290C SETOF 2021 MR770 00300C CLS COMP 'P' 20 MR770 00310C U2 20 MR770 00320COR U3N20 SETON 21 MR770 00330C N21 GOTO END MR770 00340C SOH ADD SOO AVAIL 70 MR770 00350C AVAIL SUB RESERV AVAIL MR770 0000360C END TAG MR770 00370O$LP1 H 202 1P MR770 00380O OR OF MR770 00390O PAGE Z 9 MR770 00400O 4 'PAGE' MR770 00410O HEAD,1 86 MR770 00420O UDATE Y 132 MR770 0000430O H 2 1P MR770 00440O OR OF MR770 00450O 67 'ORDER ACTION-' MR770 00460O U2 77 'BUY ITEMS ' MR770 00470O U3 77 'MAKE ITEMS' MR770 00480O U2 U3 77 'ALL ITEMS ' MR770 00490O NU2NU3 87 'BAD OPT- RESPONSE' MR770 0000500O H 1 1P MR770 00510O OR OF MR770 00520O 43 'M' MR770 00530O 96 'LOT' MR770 00540O 115 'REQUIRED REORDER' MR770 00550O 131 'AVG LD STY' MR770 00560O H 2 1P MR770 0000570O OR OF MR770 00580O 24 'PART NUMBER DESCRIPTION' MR770 00590O 60 'UM P SOH SOO' MR770 00600O 78 'RESERV AVAIL' MR770 00610O 104 'MIN SIZE DATE' MR770 00620O 131 'DATE USAGE TM STK' MR770 00630O D 2 21 MR770 0000640O PN 12 MR770 00650O DESC 38 MR770 00660O UM 41 MR770 00670O CLS 43 MR770 00680O SOH L 52 MR770 00690O SOO L 61 MR770 00700O N10 62 '*' MR770 0000710O RESERVL 70 MR770 00720O AVAIL L 79 MR770 00730O MIN L 88 MR770 00740O LOTSIZL 97 MR770 00750O RDATE Y 106 MR770 00760O ODATE Y 115 MR770 00770O USAGE 4 123 MR770 0000780O LT 4 127 MR770 00790O SS 4 131 MR770 00800O T 1 LR MR770 00810O 11 'END OF JOB.' MR770 ** 000820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00084000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000850ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000860/* 000870__0O 11 'END OF JOB.' MR770 ** 000820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0008400(.^ 9OTXMR780 P999999041478(0 H S MR780 X 1 F* MRP INQUIRY MR780 F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0 F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F* CONTROL DATA PROPRIETARY PRODUCT F* 000102 FDUMMY IPEAF 72 DISK FDISPLY D F 72 CONSOLE 010 FPARTMST IC F 300R12AI 1 DISK MFG7800104 FREXPLD IC F 60R DISK 0105 FHEADING IT F 40 EDISK MFG7800106 F$LP1 O F 72 OF PRINTER U2 MFG7800202 F* MFG780000203 F* ************************************************************** MFG7800204 F* ** ** MFG7800205 F* ** COMPUSOURCE MATERIAL REQUIREMENTS PLANNING ** MFG7800206 F* ** ** MFG7800207 F* ** MFG780 - MRP INQUIRY ** MFG7800208 F* ** ** MFG7800209 F* ** ROBBIE FREEMAN 6/30/76 ** MFG780000210 F* ** ** MFG7800211 F* ************************************************************** MFG7800213 F* ** FUNCTION OF INDICATORS ** MFG7800214 F* ** ** MFG7800301 F* ** 01 DUMMY ** MFG7800302 F* ** 02 PARTMST ** MFG7800303 F* ** 03 REXPLD- OJ,RJ,PO ** MFG780000304 F* ** 04 REXPLD- SO,PR ** MFG7800310 F* ** 10 MIN = 0 - DON'T DISPLAY ** MFG7800311 F* ** 11 RR# OF 1ST MRP=0- NO MRP ON FILE- DON'T CHAIN ** MFG7800312 F* ** 12 REFLOT# IS BLANK (OJ'S & RJ'S) - DON'T DISPLAY ** MFG7800315 F* ** 15 RGCODE IS BLANK - THIS RECORD DID NOT EXPLODE ** MFG7800316 F* ** FURTHER - DON'T DISPLAY RGQTY (= 0) ** MFG7800320 F* ** 20 SUBR SBEDIT: EDIT 6-DIGIT FIELD INSTEAD OF 7. ** MFG780000331 F* ** 31 ACCEPT WAS TERMINATED BY RUBOUT - ASK AGAIN ** MFG7800333 F* ** 33 ACCEPT WAS TERMINATED BY LINEFEED - REDISPLAY ** MFG7800340 F* ** 40 RESPONSE TO PART# OR "CONTINUE?" = 'E' = EOJ ** MFG7800350 F* ** 50 PART# ACCEPTED-DON'T ASK AGAIN TILL END OF MRP ** MFG7800351 F* ** 51 ON WHEN SUBR LINES IS BEING EXECUTED FOR L=1 ** MFG7800352 F* ** (PARTMST 'BB' LINE) - OFF FOR REXPLD LINES ** MFG7800360 F* ** 60 NEW PAGE FOR PRINTING SCREENS-EITHER START OF ** MFG780000360 F* ** NEW PART#, OR 3 SCREENS(3X16=48 LINES) PRINTED** MFG7800364 F* ** 61 COUNT=1 - NEW PART# ** MFG7800364 F* ** 64 COUNT=4 - 3 SCREENS PRINTED ** MFG7800365 F* ** 65 EXCPT OUTPUT LINES ** MFG7800369 F* ** 69 ALL LINES IN THIS ARRAY HAVE BEEN PRINTED ** MFG7800370 F* ** 70 END OF INQUIRY FOR PART# - NO MORE REXPLD RECS ** MFG7800371 F* ** - DO ENDING BALANCE LINE. ** MFG780000380 F* ** 80 AVAIL < MIN FOR THIS TRANS - FLAG WITH "**" ** MFG7800381 F* ** 81 AVAIL WAS < MIN FOR AT LEAST ONE TRANS IN THIS ** MFG7800381 F* ** PART# GROUP -(DISPLAY MIN IF IT IS NOT = 0) ** MFG7800382 F* ** 82 FINAL AVAIL < MIN - DISPLAY "*ACTION*" ** MFG7800383 F* ** 83 TOTAL SOO ON REXPLD DOES NOT MATCH SOO ON ** MFG7800384 F* ** PARTMST - DISPLAY "OB" ** MFG7800390 F* ** 90 USED FOR SUBR GETMSG - GET CURPOS,LENGTH FROM ** MFG7800003905F* ** ARRAY "MSG", BUT NOT MESSAGE. ** MFG7800391 F* ** 91 ACCEPTING PART# ** MFG7800392 F* ** 92 ACCEPTING "CONTINUE?" ** MFG7800399 F* ** 99 ERROR IN EDIT - DISPLAY MESSAGE ** MFG7800401 F* ** U1 SET MIN=0 MFG7800402 F* ** U2 PRINTER NOT SELECTED - NO HARD COPY DESIRED ** MFG7800410 F* ************************************************************** MFG780000411 F* MFG7800501 E HEADING HEAD 1 1 40 COMPANY NAME MFG7800502 E MSG 1 20 32 HEADINGS/MESSAGESMFG7800503 E SED 1 7 3 SUBRED SPECS MFG7800504 E SMV 1 9 6 0 SUBRMV SPECS MFG78005045E******** MFG7800505 E* FORMAT OF MSG : 1-2 IS X, 3-4 IS Y, 5-6 IS LENGTH, 7-32 IS MES MFG780000506 E* FORMAT OF SED : 1-2 IS END POSITION, 3 IS EDIT CODE MFG7800507 E* FORMAT OF SMV : 1-2 IS NCHARS, 3-4 IS SSTRT, 5-6 IS TSTRT MFG7800508 E******** MFG7800509 E LINE 16 72 MRP DETAIL LINES MFG7800701 IDUMMY XX 01 MFG7800702 I 1 1 A MFG7800703 IPARTMST XX 02 MFG780000704 I 13 37 DESC MFG7800705 I 38 39 UM MFG7800706 I 40 40 CLS MFG7800709 I 146 1520SOH MFG7800710 I 153 1590SOO MFG7800711 I 181 1870MIN 10 MFG7800713 I 195 195 MMCODE MFG780000715 I 266 2700RR 11 MFG7800901 IREXPLD XX 03 1 CO 2 CJ MFG7800902 I OR 1 CR 2 CJ MFG7800903 I OR 1 CP 2 CO MFG7800904 I OR 04 1 CP 2 CR MFG7800905 I OR 1 CS 2 CO MFG7800907 I 3 14 PARTNO MFG780000908 I 20 21 REFLOT 12 MFG7800909 I 22 280EXPQTY MFG7800910 I 29 340REQDAT MFG7800911 I 35 400TRDATE MFG7800914 I 53 53 RGCODE 15 MFG7800915 I 54 600RGQTY MFG7800916 I 1 60 REC MFG780001001 C SETON LR MFG7801002 CLR MOVE ' ' RCODE MFG7801003 CLR MOVE ' ' B72 72 MFG7801004 C************************ MFG7801005 CLR BEGIN TAG MFG7801006 C************************ MFG7801201 CLR EXSR CLRSCR MFG780001202 CLR MOVE B72 LINE MFG7801203 C** ***************MFG7801204 CLR Z-ADD1 Y 20 DISPLAY MFG7801205 CLR EXSR OUTPUT HEADINGS MFG7801206 CLR Z-ADD2 Y MFG7801207 CLR EXSR OUTPUT MFG7801208 CLR Z-ADD3 Y MFG780001209 CLR EXSR OUTPUT MFG7801210 CLR Z-ADD6 Y MFG7801211 CLR EXSR OUTPUT MFG7801212 CLR Z-ADD8 Y MFG7801213 CLR EXSR OUTPUT MFG7801214 CLR Z-ADD10 Y MFG7801215 CLR EXSR OUTPUT MFG780001216 CLR Z-ADD12 Y MFG7801217 CLR EXSR OUTPUT MFG7801401 CLR Z-ADD13 Y MFG7801402 CLR EXSR OUTPUT MFG7801403 CLR Z-ADD14 Y MFG7801404 CLR EXSR OUTPUT MFG7801405 CLR Z-ADD15 Y MFG780001406 CLR EXSR OUTPUT MFG7801407 CLRN50 EXSR FIRST ACCEPT PART# MFG78014075CLR 40 GOTO END EOJ MFG7801408 CLRN50 GOTO DDESC MFG78014085C** ***************MFG7801409 CLR SETON 90 DISPLAY PART# MFG7801410 CLR MOVELPART MES MFG780001411 CLR Z-ADD4 Y MFG7801412 CLR EXSR OUTPUT MFG7801413 C************************ ***************MFG7801414 CLR DDESC TAG DISPLAY DESC MFG7801415 C************************ MFG7801416 CLR SETON 5090 MFG7801417 CLR MOVELDESC MES MFG780001418 CLR Z-ADD5 Y MFG7801419 CLR EXSR OUTPUT MFG7801420 C** ***************MFG7801601 CLR SETON 90 DISPLAY UM MFG7801602 CLR MOVELUM MES MFG7801603 CLR Z-ADD7 Y MFG7801604 CLR EXSR OUTPUT MFG780001605 C** ***************MFG7801606 CLR SETON 90 DISPLAY CLASS MFG7801607 CLR MOVELCLS MES MFG7801608 CLR Z-ADD9 Y MFG7801609 CLR EXSR OUTPUT MFG7801610 C** ***************MFG7801611 CLR SETON 90 DISPLAY MMCODE MFG780001612 CLR MOVELMMCODE MES MFG7801613 CLR Z-ADD11 Y MFG7801614 CLR EXSR OUTPUT MFG7801615 C** ***************MFG7801801 CLR EXSR GETREX DISPLAY REXPLD MFG7801802 C** RECORDS MFG7801803 CLR 70 EXSR LAST DO ENDING BAL MFG780001804 CLR 70 SETOF 50 MFG7801805 C** ***************MFG78018053CLR Z-ADDL SAVEL 20 MFG78018055CLR Z-ADD0 L 20 MFG7801806 CLR Z-ADD18 Y DISPLAY'CONT?' MFG7801807 CLR EXSR OUTPUT MFG7801808 CLR SETON 92 MFG780001809 CLR EXSR ACCEPT ACCEPT'CONT?' MFG7801810 CLR SETOF 92 MFG7801811 CLR U1 EXSR PRINT MFG7801812 CLRN40 GOTO BEGIN MFG7801814 C************************ MFG7801815 CLR END TAG MFG7801816 C************************ MFG780001817 CLR EXSR CLRSCR MFG7801818 C********************************************************************MFG7801819 C** SUBR FIRST **MFG7801820 C** ACCEPTS PART# & SETS UP INITIAL CONDITIONS **MFG7801825 C********************************************************************MFG7802000 CSR FIRST BEGSR MFG7802001 CSR SETOF 8182 MFG780002002 CSR Z-ADD0 NEWSOO 70 MFG7802003 CSR Z-ADD0 COUNT 10 MFG78020035CSR Z-ADD1 PAGE MFG7802004 CSR SETON 91 MFG7802005 CSR EXSR ACCEPT MFG7802006 CSR SETOF 91 MFG7802007 CSR Z-ADDSOH AVAIL 70 MFG780002008 CSR Z-ADDSOH EXPQTY MFG78020085CSR U1 Z-ADD0 MIN 10 MFG7802009 CSR SOH COMP MIN 80 SOH < MIN ? MFG7802010 CSR 80 SETON 8182 MFG7802011 CSR SETON 51 MFG7802012 CSR ENDSR MFG7802020 C********************************************************************MFG780002021 C** SUBR GETREX **MFG7802022 C** CHAIN TO REXPLD FOR DETAIL - DO SUBR "LINES" TO SAVE **MFG7802025 C********************************************************************MFG7802201 CSR GETREX BEGSR MFG7802202 CSR Z-ADD0 L MFG7802203 CSR MOVE B72 LINE BLANK ARRAY MFG7802204 CSR 51 L ADD 1 L MFG780002205 CSR 51 EXSR LINES MFG7802206 CSR SETOF 51 MFG7802207 C************************ MFG7802208 CSR GLOOP TAG MFG78022085C************************ MFG78022087CSR SETOF 0304 BUG IN V3,R3 MFG7802209 CSR 11 SETON 70 MFG780002210 CSRN11 RR CHAINREXPLD 70 MFG7802211 CSRN70 PART COMP PARTNO 7070 MFG7802212 CSR 70 GOTO ENDREX MFG7802213 CSR L ADD 1 L MFG7802214 CSR EXSR LINES MFG7802215 CSR L COMP 16 70 MFG7802216 CSRN70 GOTO ENDREX MFG780002217 CSR RR ADD 1 RR MFG7802218 CSR GOTO GLOOP MFG7802219 CSR ENDREX ENDSR MFG7802301 C********************************************************************MFG7802302 C** SUBR LINES **MFG7802303 C** MOVE REXPLD FIELDS INTO ARRAY 'LINE' - DO "DSLINE" TO DISPLAY **MFG7802305 C********************************************************************MFG780002401 CSR LINES BEGSR MFG7802402 CSR 51 GOTO LTR 'BB' LINE MFG7802403 CSRN15 GOTO LREF NO REQTS GEN MFG7802404 C************************ MFG7802405 CSR LRGQTY TAG MOVE RGQTY MFG7802406 C************************ MFG7802407 CSR Z-ADDRGQTY N7 MFG780002408 CSR Z-ADD1 I 10 MFG7802409 CSR EXSR SBEDIT MFG7802410 C************************ MFG7802411 CSR LREF TAG MOVE REF# MFG7802412 C************************ MFG780 CSR MOVELREC SOURCE 2414 CSR Z-ADD2 I MFG780002415 CSR EXSR SBMOVE MFG7802601 CSR 12 GOTO LTRDAT LOT# BLANK MFG7802602 C************************ MFG7802603 CSR LLOT TAG MOVE LOT# MFG7802604 C************************ MFG7802605 CSR MOVEL'-' A3 3 MFG7802606 CSR MOVE REFLOT A3 MFG780002607 CSR MOVELA3 SOURCE MFG7802608 CSR Z-ADD3 I MFG7802609 CSR EXSR SBMOVE MFG7802610 C************************ MFG7802611 CSR LTRDAT TAG MOVE TR DATE MFG7802612 C************************ MFG7802613 CSR Z-ADDTRDATE N6 MFG780002614 CSR Z-ADD2 I MFG7802615 CSR SETON 20 MFG7802616 CSR EXSR SBEDIT MFG7802617 CSR SETOF 20 MFG7802802 C************************ MFG7802803 CSR LPARNT TAG MOVE CUST/VEND MFG7802804 C************************ /PARENT MFG78000 CSR MOVELREC SOURCE 2806 CSR Z-ADD4 I MFG7802807 CSR EXSR SBMOVE MFG7802809 C************************ MFG7802810 CSR LRQDAT TAG MOVE REQ DATE MFG7802811 C************************ MFG7802812 CSR Z-ADDREQDAT N6 MFG780002813 CSR Z-ADD3 I MFG7802814 CSR SETON 20 MFG7802815 CSR EXSR SBEDIT MFG7802816 CSR SETOF 20 MFG7803001 C************************ MFG7803002 CSR LTR TAG MOVE TR MFG7803003 C************************ MFG78000 CSR MOVELREC SOURCE 3004 CSR 51 MOVEL'BB' SOURCE MFG7803005 CSR Z-ADD1 I MFG7803006 CSR EXSR SBMOVE MFG7803007 C************************ MFG7803008 CSR LQTY TAG MOVE QTY MFG7803009 C************************ MFG780003011 CSR Z-ADDEXPQTY N7 MFG7803012 CSR Z-ADD4 I MFG7803013 CSR EXSR SBEDIT MFG7803014 C************************ MFG7803015 CSR LAVAIL TAG MOVE AVAIL MFG7803016 C************************ MFG7803202 CSRN51 EXSR SUBAVL MFG780003203 CSR Z-ADDAVAIL N7 MFG7803204 CSR Z-ADD5 I MFG7803205 CSR EXSR SBEDIT MFG7803206 C************************ MFG7803207 CSR FLAG TAG MOVE FLAG IF MFG7803208 C************************ AVAIL < MIN MFG7803209 CSRN80 GOTO DISPLY MFG780003210 CSR MOVEL'**' SOURCE MFG7803211 CSR EXSR SBMOVE MFG7803212 C************************ MFG7803213 CSR DISPLY TAG DISPLAY LINE MFG7803214 C************************ MFG7803215 CSR EXSR DSLINE MFG7803220 CSR ENDSR MFG780003501 C********************************************************************MFG7803502 C** SUBR LAST **MFG7803503 C** MOVE ENDBAL VALUES TO ARRAY,CHECK FOR ACTION,DISPLAY 'EB' LINE **MFG7803505 C********************************************************************MFG7803601 CSR LAST BEGSR MFG7803602 CSR L ADD 1 L MFG7803603 CSR MOVEL'EB' SOURCE MOVE TR MFG780003604 CSR Z-ADD1 I MFG7803605 CSR EXSR SBMOVE MFG78036055CSR 10 MIN = 0 MFG7803606 CORN81 GOTO ACTION OR NO FLAGS MFG7803607 CSR MOVEL'(MIN= 'A13 13 MFG7803608 CSR MOVE ' )' A13 MFG7803609 CSR MOVELA13 SOURCE MFG780003610 CSR Z-ADD6 I MFG7803611 CSR EXSR SBMOVE MFG7803612 CSR Z-ADDMIN N7 MFG7803613 CSR EXSR SBEDIT MFG7803614 C************************ MFG7803615 CSR ACTION TAG MFG7803616 C************************ MFG780003801 CSRN82 GOTO ENDBAL MFG7803802 CSR MOVEL'*ACTION*'SOURCE MFG7803803 CSR Z-ADD7 I MFG7803804 CSR EXSR SBMOVE MFG7803805 C************************ MFG7803806 CSR ENDBAL TAG MFG7803807 C************************ MFG780003808 CSR Z-ADDAVAIL N7 MFG7803809 CSR Z-ADD5 I MFG7803810 CSR EXSR SBEDIT MFG7803811 C************************ MFG7803812 CSR OB TAG MFG7803813 C************************ MFG7803814 CSR NEWSOO COMP SOO 8383 MFG780003815 CSRN83 GOTO EFLAG SOO IS OK MFG7804001 CSR MOVEL'OB' SOURCE OUT-OF-BALANCE MFG7804002 CSR Z-ADD8 I -MOVE 'OB' MFG7804003 CSR EXSR SBMOVE MFG7804004 C************************ MFG7804005 CSR EFLAG TAG MFG7804006 C************************ MFG780004007 CSRN80 GOTO EDSPLY MFG7804008 CSR MOVEL'**' SOURCE MFG7804009 CSR Z-ADD5 I MFG7804010 CSR EXSR SBMOVE MFG7804011 C************************ MFG7804012 CSR EDSPLY TAG DISPLAY 'EB' MFG7804013 C************************ MFG780004014 CSR EXSR DSLINE MFG7804019 CSR ENDSR MFG7804101 C********************************************************************MFG7804102 C** SUBR SUBAVL **MFG7804103 C** COMPUTE AVAIL - CHECK IF BELOW MIN **MFG7804105 C********************************************************************MFG7804201 CSR SUBAVL BEGSR COMPUTE AVAIL MFG780004202 CSR 03 NEWSOO ADD EXPQTY NEWSOO MFG7804203 CSR 03 AVAIL ADD EXPQTY AVAIL MFG7804204 CSR 04 AVAIL SUB EXPQTY AVAIL MFG7804205 CSR AVAIL COMP MIN 80 MFG7804206 CSR 80 SETON 8182 MFG7804207 CSRN80 SETOF 82 MFG7804208 CSR ENDSR MFG780004301 C********************************************************************MFG7804302 C** SUBR SBMOVE **MFG7804303 C** MOVE REXPLD FIELDS FROM 'SOURCE' TO 'LINE,L' **MFG7804305 C********************************************************************MFG7804400 CSR SBMOVE BEGSR MFG7804401 CSR MOVE LINE,L TARGET MFG7804402 CSR MOVE SMV,I N4 40 MFG78000 CSR MOVELSMV,I TN 20 CSR Z-ADDTN NCHARS CSR MOVELN4 TS 20 CSR MOVE N4 TT 20 CSR Z-ADDTS SSTRT CSR Z-ADDTT TSTRT CSR EXIT SUBRMV SUBMV 004407 CSR RLABL SOURCE 72 CSR RLABL SSTRT 30 SUBMV 4408 CSR RLABL TARGET 72 CSR RLABL TSTRT 30 SUBMV CSR RLABL NCHARS 30 SUBMV 4412 CSR MOVE TARGET LINE,L MFG7804413 CSR ENDSR MFG780004501 C********************************************************************MFG7804502 C** SUBR SBEDIT **MFG7804503 C** MOVE & EDIT REXPLD NUMERIC FIELDS TO 'LINE,L' **MFG7804505 C********************************************************************MFG7804600 CSR SBEDIT BEGSR MFG7804601 CSR MOVE LINE,L TARGET MFG7804602 CSR MOVE SED,I ECODE MFG780004603 CSR MOVELSED,I EPOS MFG780 CSR EPOS COMP 07 71 CSR MOVE EPOS MPOS 30 CSR MOVE 08 EPOS CSR MOVE B72 EWORD 24 MR780 46035CSR 20 GOTO SBED6 MFG780 CSR EXIT SUBRED SUBED 004605 CSR RLABL N7 70 CSR RLABL ECODE 1 SUBED 4607 CSR RLABL TARA 08 CSR RLABL EPOS 20 SUBED CSR RLABL EWORD 24 SUBED CSRN71 MPOS SUB 008 MPOS CSR 71 MOVE 01 MPOS 00 CSR MOVE MPOS TSTRT CSR MOVELTARA SOURCE CSR MOVE 001 SSTRT CSR MOVE LINE,L TARGET CSRN71 MOVE 008 NCHARS CSR 71 MOVE 007 NCHARS CSR 71 MOVE 2 SSTRT 00 CSR EXIT SUBRMV CSR RLABL SOURCE 72 CSR RLABL SSTRT 30 CSR RLABL TARGET 72 CSR RLABL TSTRT 30 CSR RLABL NCHARS 30 4609 CSR GOTO ENDSB MFG780004610 C************************ MFG7804611 CSR SBED6 TAG MFG7804612 C************************ MFG780 CSR EXIT SUBRED SUBED 4614 CSR RLABL N6 60 CSR RLABL ECODE 1 SUBED CSR RLABL TARA 08 00 CSR RLABL EPOS 20 SUBED CSR RLABL EWORD 24 SUBED CSRN71 MPOS SUB 008 MPOS CSR 71 MOVE 001 MPOS CSR MOVE MPOS TSTRT CSR MOVELTARA SOURCE CSR MOVE 001 SSTRT 00 CSR MOVE LINE,L TARGET CSRN71 MOVE 008 NCHARS CSR 71 MOVE 007 NCHARS CSR 71 MOVE 2 SSTRT CSR EXIT SUBRMV CSR RLABL SOURCE 72 CSR RLABL SSTRT 30 00 CSR RLABL TARGET 72 CSR RLABL TSTRT 30 CSR RLABL NCHARS 30 4618 C************************ MFG7804619 CSR ENDSB TAG MFG7804620 C************************ MFG7804621 CSR MOVELTARGET LINE,L 004625 CSR ENDSR MFG7804901 C********************************************************************MFG7804902 C** SUBR ACCEPT **MFG7804903 C** ACCEPT FROM CRT - DO EDIT & DISPLAY ERRORS **MFG7804905 C********************************************************************MFG7805001 CSR ACCEPT BEGSR MFG7805002 C************************ MFG780005003 CSR BEGACC TAG MFG7805004 C************************ MFG7805005 CSR 91 Z-ADD4 Y PART# MFG7805006 CSR 92 Z-ADD19 Y 'CONTINUE?' MFG7805007 CSR EXSR GETMSG MFG7805201 C************************ MFG7805202 CSR ACLOOP TAG MFG780005203 C************************ MFG7805204 CSR MOVELXYPOS BUFFER MFG7805205 CSR EXSR POSCUR MFG7805206 CSR MOVE LENG BLNGTH MFG7805207 CSR MOVE 'A' TYPE MFG7805208 CSR EXSR CRTCOM MFG7805209 CSR RCODE COMP 'R' 31 RUBOUT MFG780005210 CSR 31 GOTO ACLOOP MFG7805211 CSR RCODE COMP 'L' 33 LINE FEED MFG7805212 CSRN33 91 MOVELBUFFER PART 12 MFG7805213 CSRN33 92 MOVELBUFFER CONT 1 MFG7805215 CSR MOVELXYPOS BUFFER MFG7805401 CSR EXSR POSCUR MFG7805402 CSR 91 MOVELPART BUFFER MFG780005403 CSR 92 MOVELCONT BUFFER MFG7805404 CSR MOVE 'S' TYPE MFG7805405 CSR EXSR CRTCOM MFG7805406 C************************ MFG7805407 CSR ENDACC TAG MFG7805408 C************************ MFG7805409 CSR EXSR EDIT MFG780005410 CSR 99 GOTO BEGACC MFG7805411 CSR ENDSR MFG7805501 C********************************************************************MFG7805502 C** SUBR GETMSG **MFG7805503 C** GET XYPOS, LENGTH, MESSAGE FROM 'MSG' ARRAY **MFG7805505 C********************************************************************MFG7805601 CSR GETMSG BEGSR MFG780005602 CSR MOVE MSG,Y WORD26 26 MFG7805603 CSRN90 MOVELWORD26 MES 72 MFG7805604 CSR MOVELMSG,Y WORD6 6 MFG7805605 CSR MOVELWORD6 XYPOS 40 MFG7805606 CSR XYPOS ADD L XYPOS MFG7805607 CSR MOVE WORD6 LENG 20 MFG7805608 CSR ENDSR MFG780005701 C********************************************************************MFG7805702 C** SUBR EDIT **MFG7805703 C** EDIT CRT ACCEPTED FIELDS - DO "OUTPUT" TO DISPLAY ERRORS **MFG7805705 C********************************************************************MFG7805800 CSR EDIT BEGSR MFG7805801 CSR SETOF 99 MFG7805802 CSR MOVE B72 MES MFG780005803 CSR 91 GOTO E91 MFG7805804 CSR 92 GOTO E92 MFG7805805 CSR GOTO EEDIT MFG7805806 C************************ MFG7805807 CSR E91 TAG PART# MFG7805808 C************************ MFG7805809 CSR Z-ADD5 Y MFG780005810 CSR MOVELPART A2 2 MFG7805811 CSR A2 COMP 'E ' 40 EOJ? MFG7805812 CSR 40 SETON 90 YES MFG7805813 CSR 40 GOTO EEDIT MFG7805814 CSR PART CHAINPARTMST 99 PART# OK? MFG7805815 CSRN99 SETON 90 YES MFG7805816 CSR GOTO EEDIT MFG780006001 C************************ MFG7806002 CSR E92 TAG 'CONTINUE?' MFG7806003 C************************ MFG7806004 CSR CONT COMP 'E' 40 EOJ? MFG7806005 CSR 40 SETON 90 YES MFG7806006 C** ELSE, CONTINUE MFG7806007 C************************ MFG780006008 CSR EEDIT TAG MFG7806009 C************************ MFG7806010 CSR EXSR OUTPUT MFG7806011 CSR ENDSR MFG7806101 C********************************************************************MFG7806102 C** SUBR OUTPUT **MFG7806103 C** DISPLAY HEADINGS, MESSAGES **MFG780006105 C********************************************************************MFG7806201 CSR OUTPUT BEGSR MFG7806202 CSR EXSR GETMSG MFG7806203 CSR MOVELXYPOS BUFFER MFG7806204 CSR EXSR POSCUR MFG7806205 CSR MOVE LENG BLNGTH MFG7806206 CSR MOVE 'S' TYPE MFG780006207 CSR MOVELMES BUFFER MFG7806208 CSR EXSR CRTCOM MFG7806209 CSR SETOF 90 MFG7806210 CSR ENDSR MFG7806241 C********************************************************************MFG7806242 C** SUBR DSLINE **MFG7806243 C** DISPLAY 'LINE,L' (DO "OUTPUT" TWICE SINCE BLNGTH CAN'T BE >70) **MFG780006245 C********************************************************************MFG7806250 CSR DSLINE BEGSR MFG7806251 CSR SETON 90 MFG7806252 CSR MOVELLINE,L MES MFG7806253 CSR Z-ADD16 Y MFG7806254 CSR EXSR OUTPUT CRT POS 1-40 MFG7806255 CSR SETON 90 MFG780006256 CSR MOVE LINE,L A32 32 MFG7806257 CSR MOVELA32 MES MFG7806258 CSR Z-ADD17 Y MFG7806259 CSR EXSR OUTPUT CRT POS 41-72 MFG7806260 CSR ENDSR MFG7806301 C********************************************************************MFG7806302 C** SUBR CRTCOM **MFG780006305 C********************************************************************MFG7806401 CSR CRTCOM BEGSR MFG7806402 CSR EXITFSUBRCM MFG7806407 CSR RLABL BUFFER 72 MFG7806405 CSR RLABL TYPE 1 MFG7806403 CSR RLABL BLNGTH 20 MFG7806404 CSR RLABL RCODE 1 MFG780006406 CSR RLABL MASK 10 MFG78064062CSR RLABL DTYPE 10 MFG7806408 CSR ENDSR MFG7806501 C********************************************************************MFG7806502 C** SUBR POSCUR **MFG7806505 C********************************************************************MFG7806601 CSR POSCUR BEGSR MFG780006602 CSR MOVE 'P' TYPE MFG7806603 CSR EXSR CRTCOM MFG7806604 CSR ENDSR MFG7806701 C********************************************************************MFG7806702 C** SUBR CLRSCR **MFG7806705 C********************************************************************MFG7806801 CSR CLRSCR BEGSR MFG780006802 CSR MOVE 'C' TYPE MFG7806803 CSR EXSR CRTCOM MFG7806804 CSR ENDSR MFG7806901 C********************************************************************MFG7806902 C** SUBR PRINT **MFG7806903 C** PRINT HARD COPY OF SCREENS IF U1 ON - UP TO 3 SCREENS PER PAGE **MFG7806905 C********************************************************************MFG780007001 CSR PRINT BEGSR MFG7807002 CSR COUNT ADD 1 COUNT MFG7807003 CSR COUNT COMP 1 61 MFG7807004 CSR COUNT COMP 4 64 MFG7807005 CSR 64 Z-ADD1 COUNT MFG7807006 CSR 61 MFG7807007 COR 64 SETON 60 MFG78000 CSR SETON 60 7008 CSR 60 EXCPT MFG7807009 CSR SETOF 60 MFG7807010 CSR Z-ADD0 P 20 MFG7807012 C************************ MFG7807013 CSR PLOOP TAG MFG7807014 C************************ MFG780007015 CSR P ADD 1 P MFG7807201 CSR SETON 65 MFG7807202 CSR EXCPT MFG7807203 CSR SETOF 65 MFG7807204 CSR P COMP SAVEL 69 MFG7807205 CSRN69 GOTO PLOOP MFG7807206 CSR ENDSR MFG780007301 C********************************************************************MFG7808001 O$LP1 E 01 60 MFG7808002 O PAGE Z 8 MFG7808003 O 4 'PAGE' MFG7808004 O HEAD,1 56 MFG7808005 O UDATE Y 72 MFG7808006 O E 2 60 MFG780008007 O 46 'MATERIAL REQUIREMENTS' MFG7808008 O 72 'MFG780' MFG7808009 O E 2 60 MFG7808010 O 6 'PART#-' MFG7808011 O PART 20 MFG7808012 O DESC 47 MFG7808013 O 52 'UM-' MFG780008014 O UM 55 MFG7808015 O 61 'CLS-' MFG7808016 O CLS 63 MFG7808017 O 70 'CODE-' MFG7808018 O MMCODE 72 MFG7808201 O E 21 60 MFG7808202 O 7 'REQTS?' MFG780008203 O 10 'TR' MFG7808204 O 19 'REF #' MFG7808205 O 28 'TR DATE' MFG7808206 O 39 'C/V/PARENT' MFG7808207 O 50 'REQ DATE' MFG7808208 O 58 'QTY' MFG7808209 O 67 'AVAIL' MFG780008210 O E 1 65 MFG7808211 O LINE,P 72 MFG780** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00** MSG: HEADINGS,MESSAGES MFG780260021MATERIAL REQUIREMENTS MFG780670006MFG780 MFG780010220PART# [ ] MFG780080212 MFG780230225** INVALID MFG780500206UM- MFG78000540202 MFG780580206CLS- MFG780630201 MFG780660207CODE- MFG780720201 MFG780020418REQTS? TR REF # MFG780220418TR DATE C/V/PARENT MFG78000430416REQ DATE QTY MFG780630405AVAIL MFG780010640 MFG780410632 MFG780262214CONTINUE ? [ ] MFG780382201 MFG780 00** SED: SUBRED SPECS (POS. 1 TO 2 IS EPOS, 3 IS EDIT CODE) MFG780074 RGQTY MFG78028Y TRDATE MFG78050Y REQDAT MFG78059L EXPQTY MFG78068L AVAIL MFG780413 MIN MFG78000 ** SMV: SUBRMV SPECS (1-2 IS NCHARS, 3-4 IS SSTRT, 5-6 IS TSTRT) MFG780020109 TR MFG780051512 REF# MFG780030117 A3 = REFLOT MFG780124130 PARENT MFG780020171 FLAG MFG78000130130 A13 = "(MIN= )" MFG780080152 "*ACTION*" MFG780020169 "OB" MFG780 /* __30 PARENT MFG780020171 FLAG MFG7800(Iy OTXOE130 P999999050878(000010H S 1 OE130 00020X DECK-ID A61 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE130 00030F* PRINT SHIPPERS AND CREATE TODAYS FILE OE130 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE130 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE130 00060F* CONTROL DATA PROPRIETARY PRODUCT OE130 00070F* OE130 0000080FOPNORDS UPEAF 118 8AI 106 DISK OE130 00090FARMAST IC F 280R 6AI 1 DISK OE130 00100FPARTMST IC F 300R12AI 1 DISK OE130 00110FHEADING IT F 40 EDISK OE130 00120F$LP1 O F 80 OF LPRINTER OE130 00130FTODAYS O F 118 DISK OE130 00140F********************************************************************OE130 0000150F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [ORD040] OE130 00160F* OE130 00170F* PACKAGE DISTRIBUTION OE130 00180F* SYSTEM SALES ORDER PROCESSING OE130 00190F* PROGRAM PRINT SHIPPERS OE130 00200F* OE130 00210F* CONTRACTOR COMPUSOURCE OE130 0000220F* PROGRAMMER KATH HILL OE130 00230F* DATE FEBRUARY 22, 1976 OE130 00240F* OE130 00250F********************************************************************OE130 00260F* OE130 00270F* ************************************************************** OE130 00280F* ** ** OE130 0000290F* ** FUNCTION OF INDICATORS ** OE130 00300F* ** ** OE130 00310F* ** 01 BKORDS- HEADER ** OE130 00320F* ** 02 BKORDS- SHIP-TO N/A ** OE130 00330F* ** 03 BKORDS- 'MARK FOR' OR INVOICE COMMENTS ** OE130 00340F* ** 05 BKORDS- LINE-ITEMS ** OE130 00350F* ** 06 BKORDS- LINE-ITEM COMMENTS ** OE130 0000360F* ** 07 BKORDS- UNDEFINED RECORD TYPE ** OE130 00370F* ** 09 ARMAST ** OE130 00380F* ** 10 PARTMST ** OE130 00390F* ** 11 ORDINP- HEADER ** OE130 00400F* ** 12 ORDINP- SHIP-TO N/A ** OE130 00410F* ** 13 BKORDS- 'MARK FOR' OR INVOICE COMMENTS ** OE130 00420F* ** 15 ORDINP- LINE-ITEMS ** OE130 0000430F* ** 16 ORDINP- LINE-ITEM COMMENTS ** OE130 00440F* ** 17 ORDINP- UNDEFINED RECORD TYPE ** OE130 00450F* ** ** OE130 00460F* ** 22 NO OVERRIDE PRICE CODE ** OE130 00470F* ** 23 NO OVERRIDE SALESMAN# ** OE130 00480F* ** 24 NO OVERRIDE AREA ** OE130 00490F* ** 25 SHIP-TO ZIP CODE = ZERO - DON'T PRINT ** OE130 0000500F* ** ** OE130 00510F* ** 28 LINE-ITEM COMMENT LINE IS BLANK - DON'T PRINT ** OE130 00520F* ** ** OE130 00530F* ** 30 AN INVOICE OR 'MARK FOR' COMMENT LINE IS BLANK ** OE130 00540F* ** 34 COMPRESSED COMMENT #4 IS BLANK-ALLOW FOR SPACE ** OE130 00550F* ** 35 SUBR SUB3 LOOP IS DONE ** OE130 00560F* ** ** OE130 0000570F* ** 50 MULTIPLE PAGES- GO TO NEXT PAGE ** OE130 00580F* ** ** OE130 00590F* ** 60 LINE ITEM OR LINE ITEM COMMENT - ASSIGN LINE# ** OE130 00600F* ** ** OE130 00610F* ** 70 NEW ORDER- NO SHIPPER HAS BEEN PRINTED OE130 00620F* ** 71 BKORD PRINT H,I,K,LM RCDS OE130 00630F* ** 72 BKORD-RCD LL-PRINT ON SHIPPER OE130 0000640F* 85 1ST RECORD INDICATOR OE130 00650F* 88 SALES ORDER WITHIN LIMITS OE130 00660F* ** 90 ARMAST RECORD FLAGGED FOR DELETION ** OE130 00670F* ** 91 PARTMST RECORD FLAGGED FOR DELETION ** OE130 00680F* ** ** OE130 00690F* ** H1 NO HEADER FOR THIS S.O. ** OE130 00700F* ** H2 DUPLICATE HEADERS FOR THIS S.O. ** OE130 0000710F* ** H4 INVALID SOLD-TO CUST# ** OE130 00720F* ** H6 INVALID PART # ** OE130 00730F* ** ** OE130 00740F* ** RETRY SHOULD BE HIT EVERY TIME THAT H6 ** OE130 00750F* ** OCCURS. AFTER JOB, THE LINES WITH INVALID ** OE130 00760F* ** PART #'S SHOULD BE FIXED BEFORE CONTINUE TO ** OE130 00770F* ** DIS140. ** OE130 0000780F* ** ** OE130 00790F* ************************************************************** OE130 00800F* OE130 00810E ARY1 1 2 30 OE130 00820E COM 4 23 K COMMENTS INPUT OE130 00830E COUT 4 23 COMPRESSED K COM OE130 00840E HEADING HEAD 1 1 40 COMPANY NAME OE130 0000850L$LP1 66FL 60OL OE130 00860IOPNORDS XX 01 8 CH OE130 00870I 3 70HALF1 OE130 00880I 3 70SONUM L1 OE130 00890I 9 130CUST OE130 00900I 14 190RDATE OE130 00910I 20 31 PONUM OE130 0000920I 32 41 CARIER OE130 00930I 43 430OVPC 22 OE130 00940I 44 460OVSMAN 23 OE130 00950I 47 48 OVAREA 24 OE130 00960I 50 550PDATE OE130 00970I 1 118 ALL OE130 00980I 105 105 STATUS 70 OE130 0000990I XX 02 8 CI OE130 01000I 3 70SONUM L1 OE130 01010I 9 130SHIPTO OE130 01020I 14 37 SHIP1 OE130 01030I 38 61 SHIP2 OE130 01040I 62 85 SHIP3 OE130 01050I 86 98 SHIPCY OE130 0001060I 99 100 SHIPST OE130 01070I 101 1050SHIPZP 25 OE130 01080I 1 118 ALL OE130 01090I XX 03 8 CK OE130 01100I 3 70SONUM L1 OE130 01110I 9 100 COM OE130 01120I 1 118 ALL OE130 0001130I XX 05 8 CL 11 CL OE130 01140I 3 70SONUM L1 OE130 01150I 12 23 PART OE130 01160I 24 300QTYORD OE130 01170I 1 118 ALL OE130 01180I XX 06 8 CL 11 CM OE130 01190I 3 70SONUM L1 OE130 0001200I 12 49 LICMNT 28 OE130 01210I 1 118 ALL OE130 01220I XX 07 OE130 01230I 1 1 DUMMY OE130 01240IARMAST XX 09 OE130 01250I 7 30 NAME OE130 01260I 31 54 LINE1 OE130 0001270I 55 78 LINE2 OE130 01280I 79 91 CITY OE130 01290I 92 93 STATE OE130 01300I 94 980ZIP OE130 01310I 115 115 DLTAR 90 OE130 01320I 154 1560SLSMN OE130 01330I 157 158 AREA OE130 0001340I 161 1610PC OE130 01350I 162 163 TYP OE130 01360IPARTMST XX 10 OE130 01370I 13 37 PDESC OE130 01380I 74 74 DLTPA 91 OE130 01390C MOVE ' ' B80 80 OE130 01400C N85 EXSR ALMTS ACCEPT LIMITS OE130 0001410C SETON 85 OE130 01420C SETOF 60 OE130 01430C L1 SETOF 7172 OE130 01440C L1N01 SETON H1 NO HEADER OE130 01450C H1 GOTO END OE130 01460C NL1 01 SETON H2 DUP HEADERS OE130 01470C H2 GOTO END OE130 0001480C N70 EXSR PRINT OE130 01490C L1 SETOF 50 OE130 01500C L1 Z-ADD0 COUNT 40 OE130 01510C 01 HALF1 COMP SLOW 87 88 OE130 01520C 01 87 HALF1 COMP SHIGH 8888 OE130 01530C N88 GOTO END OE130 01540C N70N72 GOTO END OE130 0001550C 01 EXSR SUB1 OE130 01560C 03 EXSR SUB3 OE130 01570C 05 EXSR SUB5 OE130 01580C 06N28 EXSR SUB6 OE130 01590C END TAG OE130 01600CLR MOVE ' ' BLANKS 23 OE130 01610C** OE130 0001620C** OE130 01630CSR PRINT BEGSR OE130 01640CSR 01 STATUS COMP 'B' 72 OE130 01650CSR 01 OE130 01660COR 02 OE130 01670COR 03 OE130 01680COR 06 OE130 0001690CORN72 GOTO ENDPRT OE130 01700CSR QTYORD COMP 0 71 OE130 01710CSR ENDPRT ENDSR OE130 01720CSR SUB1 BEGSR OE130 01730CSR Z-ADDCUST CUST6 60 OE130 01740CSR CUST6 CHAINARMAST H4 OE130 01750CSRNH4N90 SETON H4 OE130 0001760CSR H4 GOTO END1 OE130 01770CSR EXSR SAVEHD OE130 01780CSR END1 ENDSR OE130 01790CSR SUB3 BEGSR OE130 01800CSR MOVE BLANKS COUT OE130 01810CSR Z-ADD0 X 10 OE130 01820CSR Z-ADD0 Y 10 OE130 0001830CSR LOOP TAG OE130 01840CSR X COMP 4 35 OE130 01850CSR 35 GOTO DONE OE130 01860CSR X ADD 1 X OE130 01870CSR COM,X COMP BLANKS 30 OE130 01880CSR 30 GOTO LOOP OE130 01890CSRN30 Y ADD 1 Y OE130 0001900CSR MOVE COM,X COUT,Y OE130 01910CSR GOTO LOOP OE130 01920CSR DONE TAG OE130 01930CSR COUT,4 COMP BLANKS 34 OE130 01940CSR ENDSR OE130 01950C** OE130 01960C** OE130 0001970CSR SUB5 BEGSR OE130 01980CSR SETON 60 OE130 01990CSR PART CHAINPARTMST H6 OE130 02000CSRNH6N91 SETON H6 OE130 02010CSR COUNT COMP 25 50 50 OE130 02020CSR 50 Z-ADD0 COUNT OE130 02030CSR COUNT ADD 2 COUNT OE130 0002040CSR END5 ENDSR OE130 02050C** OE130 02060C** OE130 02070CSR SUB6 BEGSR OE130 02080CSR SETON 60 OE130 02090CSR COUNT COMP 26 50 50 OE130 02100CSR 50 Z-ADD0 COUNT OE130 0002110CSR COUNT ADD 1 COUNT OE130 02120CSR ENDSR OE130 02130C** OE130 02140C** OE130 02150CSR SAVEHD BEGSR OE130 02160CSR MOVE NAME SNAME 24 OE130 02170CSR MOVE LINE1 SLINE1 24 OE130 0002180CSR MOVE LINE2 SLINE2 24 OE130 02190CSR MOVE CITY SCITY 13 OE130 02200CSR MOVE STATE SSTATE 2 OE130 02210CSR MOVE ZIP SZIP 50 OE130 02220CSR 22 MOVE PC SPC 10 OE130 02230CSRN22 MOVE OVPC SPC OE130 02240CSR 23 MOVE SLSMN SSLSMN 30 OE130 0002250CSRN23 MOVE OVSMAN SSLSMN OE130 02260CSR 24 MOVE AREA SAREA 2 OE130 02270CSRN24 MOVE OVAREA SAREA OE130 02280CSR MOVE TYP STYPE 2 OE130 02290CSR ENDSR OE130 02300C** OE130 02310C** OE130 0002320CSR ALMTS BEGSR OE130 02330CSR MOVE ' ' BUFFER 80 OE130 02340CSR MOVE 'C' TYPE 1 OE130 02350CSR Z-ADD0 BLNGTH 20 OE130 02360CSR MOVE ' ' RCODE 1 OE130 02370CSR Z-ADD0 MASK 10 OE130 02380CSR Z-ADD0 DTYPE 10 OE130 0002390CSR EXSR CRTCOM OE130 02400CSR MOVELARY1,1 BUFFER OE130 02410CSR MOVE 'S' TYPE OE130 02420CSR Z-ADD30 BLNGTH OE130 02430CSR EXSR CRTCOM OE130 02440CSR MOVE B80 BUFFER OE130 02450CSR MOVE 'A' TYPE OE130 0002460CSR Z-ADD5 BLNGTH OE130 02470CSR Z-ADD1 DTYPE OE130 02480CSR EXSR CRTCOM OE130 02490CSR RCODE COMP 'R' 86 OE130 02500CSR MOVELBUFFER VAR OE130 02510CSR Z-ADD5 VL OE130 02520CSR EXIT SUBRAJ OE130 0002530CSR RLABL VL 20 OE130 02540CSR RLABL VAR 15 OE130 02550CSR MOVELVAR SLOW 50 OE130 02560CSR MOVE B80 BUFFER OE130 02570CSR Z-ADD1 BLNGTH OE130 02580CSR MOVE 'T' TYPE OE130 02590CSR EXSR CRTCOM OE130 0002600CSR MOVELARY1,2 BUFFER OE130 02610CSR MOVE 'S' TYPE OE130 02620CSR Z-ADD30 BLNGTH OE130 02630CSR EXSR CRTCOM OE130 02640CSR MOVE B80 BUFFER OE130 02650CSR MOVE 'A' TYPE OE130 02660CSR Z-ADD5 BLNGTH OE130 0002670CSR Z-ADD1 DTYPE OE130 02680CSR EXSR CRTCOM OE130 02690CSR RCODE COMP 'R' 87 0OE130 02700CSR MOVELBUFFER VAR OE130 02710CSR Z-ADD5 VL OE130 02720CSR EXIT SUBRAJ OE130 02730CSR RLABL VL OE130 0002740CSR RLABL VAR OE130 02750CSR MOVELVAR SHIGH 50 OE130 02760CSR MOVE 'C' TYPE OE130 02770CSR EXSR CRTCOM OE130 02780CSR 86 OE130 02790COR 87 GOTO ALMTS OE130 02800CSR ENDSR OE130 0002810CSR CRTCOM BEGSR OE130 02820CSR EXITFSUBRCM OE130 02830CSR RLABL BUFFER OE130 02840CSR RLABL TYPE OE130 02850CSR RLABL BLNGTH OE130 02860CSR RLABL RCODE OE130 02870CSR RLABL MASK OE130 0002880CSR RLABL DTYPE OE130 02890CSR ENDSR OE130 02900OOPNORDS D 01 70 88 OE130 02910O 105 'P' OE130 02920O$LP1 H 18 1P OE130 02930O 23 'X XXXXX X XXX XX XX' OE130 02940O 36 'XXXXXXXXXX' OE130 0002950O 51 'XXXXXXXXXXXX' OE130 02960O 70 'XXXXXXXXXXXXXXXXXX' OE130 02970O 80 'XXXXXXXXXX' OE130 02980O D 201 50 OE130 02990O 58 '* CONTINUED - PAGE' OE130 03000O PAGE Z 64 OE130 03010O 66 '*' OE130 0003020O D 103 01 70 88 OE130 03030O OR 01 72 88 OE130 03040O OR 50 OE130 03050O SNAME 32 OE130 03060O D 1 01 70 88 OE130 03070O OR 01 72 88 OE130 03080O OR 50 OE130 0003090O SLINE1 32 OE130 03100O D 1 01 70 88 OE130 03110O OR 01 72 88 OE130 03120O OR 50 OE130 03130O SLINE2 32 OE130 03140O D 1 01 70 88 OE130 03150O OR 01 72 88 OE130 0003160O OR 50 OE130 03170O SCITY 21 OE130 03180O SSTATE 25 OE130 03190O SZIP 32 OE130 03200O D 1 01 70 88 OE130 03210O OR 01 72 88 OE130 03220O OR 50 OE130 0003230O PDATE Y 47 OE130 03240O SONUM 57 OE130 03250O RDATE Y 67 OE130 03260O D 1 02 70 88 OE130 03270O OR 02 72 88 OE130 03280O OR 50 OE130 03290O SHIP1 32 OE130 0003300O D 1 02 70 88 OE130 03310O OR 02 72 88 OE130 03320O OR 50 OE130 03330O SHIP2 32 OE130 03340O D 1 02 70 88 OE130 03350O OR 02 72 88 OE130 03360O OR 50 OE130 0003370O SHIP3 32 OE130 03380O D 1 02 70 88 OE130 03390O OR 02 72 88 OE130 03400O OR 50 OE130 03410O SHIPCY 21 OE130 03420O SHIPST 25 OE130 03430O N25 SHIPZP 32 OE130 0003440O D 1 03 70 88 OE130 03450O OR 03 72 88 OE130 03460O OR 50 OE130 03470O COUT,1 31 OE130 03480O D 1 03 70 88 OE130 03490O OR 03 72 88 OE130 03500O OR 50 OE130 0003510O COUT,2 31 OE130 03520O D 1 03 70 88 OE130 03530O OR 03 72 88 OE130 03540O OR 50 OE130 03550O COUT,3 31 OE130 03560O D 1 03 70 88 OE130 03570O OR 03 72 88 OE130 0003580O OR 50 OE130 03590O COUT,4 31 OE130 03600O D 1 03 70 88 OE130 03610O OR 03 72 88 OE130 03620O OR 50 OE130 03630O CUST 7 OE130 03640O SPC 10 OE130 0003650O SSLSMN 15 OE130 03660O STYPE 19 OE130 03670O SAREA 23 OE130 03680O CARIER 36 OE130 03690O PONUM 51 OE130 03700O D 1 05 70 88 OE130 03710O OR 05 71 88 OE130 0003720O QTYORDL 10 OE130 03730O PART 38 OE130 03740O NH6 PDESC 64 OE130 03750O H6 61 '** INVALID PART # **' OE130 03760O D 10 06N28 70 OE130 03770O AND 88 OE130 03780O OR 06N28 72 OE130 0003790O AND 88 OE130 03800O LICMNT 64 OE130 03810OTODAYS D 01 70 88 OE130 03820O OR 01 72 88 OE130 03830O ALL 118 OE130 03840O D 02 70 88 OE130 03850O OR 02 72 88 OE130 0003860O ALL 118 OE130 03870O D 03 70 88 OE130 03880O OR 03 72 88 OE130 03890O ALL 118 OE130 03900O D 05 70 88 OE130 03910O OR 05 71 88 OE130 03920O ALL 118 OE130 0003930O D 06 70N28 OE130 03940O AND 88 OE130 03950O OR 06 72N28 OE130 03960O AND 88 OE130 03970O ALL 118 OE130 ** 003980ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00399000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004010ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004020** 004030ENTER BEGINNING S.O. NUMBER 004040ENTER ENDING S.O. NUMBER 004050/* 00406000__EQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004010ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004020** 004030ENTER BEGINNING S.O. NUMBER 004040ENTER ENDING S.O. NUMBER 004050/* 0040600( TTXWP470 P999999042178(000010H S WP470 00020X DECK-ID P10 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP470 00030F* PRINTS WORKORDER STORTAGE REPORT BY PART NUMBER WP470 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP470 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP470 00060F* CONTROL DATA PROPRIETARY PRODUCT WP470 00070F* WP470 0000080FPRTWOS IPEAF 36 25AI 1 DISK WP470 00090FHEADING IT F 40 EDISK WP470 00100FPARTMST IC F 300R20AI 271 DISK WP470 00110F$LP1 O F 132 OF PRINTER WP470 00120FWOSHORT O F 36 25AI 1 DISK U U1 WP470 00130E HEADING HEAD 1 1 40 WP470 00140IPRTWOS NS 01 WP470 0000150I 1 20 PARTNOL1 WP470 00170I 21 250WONUM WP470 00180I 30 360QTY WP470 00190IPARTMST NS 02 WP470 00200I 1 37 DESC WP470 00210I 38 39 UM WP470 00220I 74 74 DCODE WP470 0000230C L1 SETOF 60 WP470 00240C L1 Z-ADD0 TQTY 80 WP470 00250C NL1 SETON 60 WP470 00260C QTY ADD TQTY TQTY WP470 00270C NL1 GOTO DEND WP470 00280C PARTNO CHAINPARTMST 55 WP470 00290C N55 DCODE COMP 'D' 55 WP470 0000300C DEND TAG WP470 00310O$LP1 H 02 1P WP470 00320O OR OF WP470 00330O 4 'PAGE' WP470 00340O PAGE Z 8 WP470 00350O HEAD 86 WP470 00360O 132 'JOB470' WP470 0000370O H 1 1P WP470 00380O OR OF WP470 00390O 48 'RELEASED' WP470 00400O 73 'WORK ORDER SHORTAGE REPO' WP470 00410O 92 'RT - BY PART NUMBER' WP470 00420O H 22 1P WP470 00430O OR OF WP470 0000440O 11 'PART NUMBER' WP470 00450O 36 'DESCRIPTION' WP470 00460O 69 'UM' WP470 00470O 93 'W.O.# QTY SHORT' WP470 00480O D 1 01 WP470 00490O PARTNO 20 WP470 00500O N55 DESC 62 WP470 0000510O 55 48 'NOT ON PART MASTER FILE ' WP470 00520O N55 UM 69 WP470 00530O WONUM 79 WP470 00540O QTY 1 93 WP470 00550O T 1 L1 60 WP470 00560O 15 '** TOTAL' WP470 00570O TQTY 1 93 WP470 0000580OWOSHORT D 01 U1 WP470 00590O WONUM 5 WP470 00600O PARTNO 25 WP470 00610O QTY 36 WP470 ** 000620ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000630ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00064000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000650ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000660/* 000670_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(20c 2JPR010OS PP999999042178(000010H JPR10O00020FOUTPUT IPE F 80 DISK MFG10O00030FJPR010 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060OJPR010 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 00 00 00 00 00 __ 0( TTXWP101 P`999999042078(000010H S WP101 00020X DECK-ID P02 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP101 00030F* WORKORDER TRANSACTION EDIT PROGRAM - BY JOB WP101 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP101 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP101 00060F* CONTROL DATA PROPRIETARY PRODUCT WP101 00070F* WP101 0000080FKPFILE IPEAF 128 DISK WP101 00090FPARTMST IC F 300R20AI 271 DISK WP101 00100FLABMST IC F 48R 2AI 1 DISK WP101 00110FWTRANS O F 60 DISK WP101 00120F* WP101 00130F* THIS PROGRAM PERFORMS A PRE-EDIT ON THE WORK ORDER TRANSACTIONS. WP101 00140F* IT ALSO INSERTS SOME INFORMATION FROM THE MASTER PARTS OR MASTER WP101 0000150F* LABOR FILE IN SOME OF THE TRANSACTIONS. WP101 00160F* WP101 00170F* THIS DIFFERS FROM JOB100 IN THE FACT THAT NO OPERATION # WP101 00180F* IS CHECKED FOR IN TRANSACTIONS 54,56,57, & 59 WP101 00190F* IN THESE TRANSACTIONS A '999' IS INSERTED. WP101 00200F* TRANSACTIONS 55 AND 60 ARE FLAGGED AS INVALID WP101 00210F* WP101 0000220IKPFILE NS 01 1NC 2NC WP101 00230I 1 20TC WP101 00240I 8 27 PARTNO WP101 00250I 1 55 REC1 WP101 00260I* NS 02 1NC 2NC WP101 00270I* 1 20TC WP101 00280I* 8 100OPNUM WP101 0000290I* 12 180QTY WP101 00300I* 19 20 LABGRD WP101 00310I* 27 38 PARTNO WP101 00320I* 1 58 REC2 WP101 00330I NS 03 WP101 00340I 1 1 A WP101 00350IPARTMST NS 05 WP101 0000360I 75 813MAT WP101 00370I 110 1163LAB WP101 00380I 117 1233BUR WP101 00390I 124 1303OUTPR WP101 00400I 74 74 PDCODE WP101 00410ILABMST NS 07 WP101 00420I 23 293LRATE WP101 0000430I 31 341BURDNF WP101 00440I 30 30 LDCODE WP101 00450C Z-ADD0 ERRNO 20 WP101 00460C Z-ADD0 BURDNF WP101 00470C SETOF 80 WP101 00480C********************************************************************WP101 00490C* WP101 0000500C* TC NUMBERS MUST BE 51-63 WP101 00510C* WP101 00520C********************************************************************WP101 00530C 03 GOTO DEND WP101 00540C TC COMP 50 20 WP101 00550C 20 TC COMP 64 20 WP101 00560C 20 TC COMP 55 2020 WP101 0000570C 20 TC COMP 60 2020 WP101 00580C 20 TC COMP 61 2020 WP101 00590C N20 Z-ADD21 ERRNO 20 INVALID TC# WP101 00600C N20 GOTO DEND WP101 00610C********************************************************************WP101 00620C* WP101 00630C* PARTNO MUST BE ON THE MASTER FILE FOR TC 51 AND 58 WP101 0000640C* WP101 00650C********************************************************************WP101 00660C TC COMP 51 20 WP101 00670C N20 TC COMP 58 20 WP101 00680C* N20 GOTO CHK57 WP101 00690C PARTNO CHAINPARTMST 55 WP101 00700C N55 PDCODE COMP 'D' 55 WP101 0000710C 55 Z-ADD22 ERRNO INVALID PART# WP101 00720C 55 GOTO DEND WP101 00730C********************************************************************WP101 00740C* WP101 00750C* TC 57 MUST HAVE A LABOR GRADE CODE WHICH IS ON THE LABOR MASTER WP101 00760C* RECORD. IF IT IS A VDLID LABOR GRADE THE THE LABOR DOLLARS WP101 00770C* ARE COMPUTED BY MULTIPLYING THE HOURS (QTY) BY THE RATE IN THE WP101 0000780C* LABOR MASTER FILE. BURDEN FACTOR IS PASSED FROM THE LABOR WP101 00790C* MASTER FILE TO THE WTRANS FILE. WP101 00800C* WP101 00810C********************************************************************WP101 00820C* CHK57 TAG WP101 00830C* TC COMP 57 80 WP101 00840C* N80 GOTO CHK58 WP101 0000850C* LABGRD CHAINLABMST 55 WP101 00860C* N55 LDCODE COMP 'D' 55 WP101 00870C* 55 Z-ADD23 ERRNO INVLD LABOR GRDWP101 00880C* N55 QTY MULT LRATE DOLRS 60H WP101 00890C* GOTO DEND WP101 00900C********************************************************************WP101 00910C* WP101 0000920C* TO 58 TAKES THE QUANTITY REPORTED IN 'QTY' AND EXTENDS IT BY WP101 00930C* THE TOTAL COST AS FOUND IN THE PARTMST FILE. WP101 00940C* WP101 00950C********************************************************************WP101 00960C CHK58 TAG WP101 00970C TC COMP 58 80 WP101 00980C N80 GOTO DEND WP101 0000990C LAB ADD MAT TOT 83 WP101 01000C TOT ADD BUR TOT WP101 01010C TOT ADD OUTPR TOT WP101 01020C* QTY MULT TOT DOLRS H WP101 01030C DEND TAG WP101 01040OWTRANS D 01 WP101 01050O REC1 55 WP101 0001060O ERRNO 60 WP101 01070O* D 02 WP101 01080O* REC2 58 WP101 01090O* 80 DOLRS 26 WP101 01100O* BURDNF 54 WP101 01110O* ERRNO 60 WP101 ** 00112000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001160/* 001170_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d5 d*TXMR740 P^999999111111(000010H S MR740 00020X DECK-ID M92 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR740 00030F* PICK OUT RECORDS FROM OPNORDS + WRITE OUT TO PROCORD MR740 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR740 00050F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR740 00060F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR740 00070F* CONTROL DATA PROPRIETARY PRODUCT MR740 0000080F* MR740 00090FOPNORDS IPEAF 119 8AI 106 DISK MR740 00100FPROCORD O F 105 DISK MR740 00110I* MR740 00120I* ONLY READ RECORDS WITH A 'H' IN COL 8 MR740 00130I* OR A 'L' IN COL 8 AND COL 11 MR740 00140IOPNORDS NS 08 8 CH MR740 0000150I 1 105 ENTIRE MR740 00160I 105 105 STATUS 10 MR740 00165I 1 2 SOCNT 00167I 3 7 SONBR 00170I* INDICATOR 10 IS ON IF STATUS IS BLANK FOR H RECORDS MR740 00180I NS 05 8 CL 11 CL MR740 00190I 1 105 ENTIRE MR740 0000200I NS 03 MR740 00210C* MR740 00220C* SEE IF STATUS IS A BLANK FOR ENTERED OPEN ORDER MR740 00230C* OR A 'P' FOR PICKED UP ORDER MR740 00240C* IGNORE ALL OTHER STATUS MR740 00250C 08N10 STATUS COMP 'P' 10 MR740 00260O* MR740 0000270OPROCORD D 10 08 MR740 00280O OR 10 05 MR740 00290O ENTIRE 105 MR740 00295O SONBR 5 00297O SOCNT 7 ** 000300ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00031000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000320ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000330ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000340/* 000350_ 00 00 00 00 00 00 00 00 00 __ 0(2b TTXWP450 P 999999032978(000010H S WP450 00020X DECK-ID P08 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP450 00030F* UPDATE WORKORDER STORTAGE FILE WP450 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP450 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP450 00060F* CONTROL DATA PROPRIETARY PRODUCT WP450 00070F* WP450 0000080FPICK IPEAF 104 DISK WP450 00090FSWTRAN ISEAF 60 DISK WP450 00100FWOSHORT UC F 36R25AI 1 DISK A WP450 00110F* WP450 00120F* THIS PROGRAM UPDATES THE SHORTAGE FILE BY PROCESSING NEW WP450 00130F* PICK LIST RECORDS WHICH ARE SHORT AND ISSUE TRANSACTIONS WP450 00140F* WP450 0000150IPICK NS 01 1NCP 1NCN WP450 00160I 2 6 KEY1 WP450 00165I 85 104 KEY2 00170I 69 750REQ WP450 00180I 78 840SOH WP450 00190I NS 02 WP450 00200I 1 1 A WP450 0000210ISWTRAN NS 05 1NC5 WP450 00220I OR 2NC8 WP450 00230I 1 1 A WP450 00240I NS 06 WP450 00250I 3 70WONUM WP450 00260I 8 27 PARTNO WP450 00270I 33 390QTY WP450 0000280I 59 600ERRNO 15 WP450 00290IWOSHORT NS 09 WP450 00300I 30 360SHORT WP450 00310C 02 WP450 00320COR 05 WP450 00330COR 06 15 GOTO DEND WP450 00332C MOVE KEY2 KEY 25 0000334C MOVELKEY1 KEY 00340C********************************************************************WP450 00350C* WP450 00360C* HERE WE PROCESS THE PICK LIST RECORDS. IF THE AMOUNT REQUIRED WP450 00370C* IS GREATER THAN THE STOCK ON HAND,THEN WE HAVE A STOCK SHORTAGE WP450 00380C* FOR THIS WORK ORDER WP450 00390C* WP450 0000400C********************************************************************WP450 00410C 06 GOTO D6 WP450 00420C KEY CHAINWOSHORT 55 WP450 00430C N55 GOTO DEND A WP450 00440C Z-ADDSOH MSOH 70 20 WP450 00450C 20 Z-ADD0 MSOH WP450 00460C REQ SUB MSOH SHORT 80 WP450 0000470C 80 EXCPT WP450 00480C SETOF 80 WP450 00490C GOTO DEND WP450 00500C********************************************************************WP450 00510C* WP450 00520C* HERE WE PROCESS ISSUES TO A WORK ORDER. IF THE W.O.-PART # WP450 00530C* RECORD IS ON THE FILE THEN WE DECREMENT THE AMOUNT SHORT WP450 0000540C* WP450 00550C********************************************************************WP450 00560C D6 TAG WP450 00570C MOVELWONUM KEY WP450 00580C MOVE PARTNO KEY WP450 00590C KEY CHAINWOSHORT 55 WP450 00600C 55 GOTO DEND WP450 0000610C SHORT SUB QTY SHORT 20 WP450 00620C 20 Z-ADD0 SHORT WP450 00630C SETON 81 WP450 00640C EXCPT WP450 00650C SETOF 81 WP450 00660C********************************************************************WP450 00670C DEND TAG WP450 0000680OWOSHORT E 81 WP450 00690O SHORT 36 WP450 00700O EADD 80 WP450 00710O KEY 25 WP450 00720O SHORT 36 WP450 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00074000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000770/* 000780_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2 TTXWP410 P999999042078(000010H S WP410 00020X DECK-ID P07 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP410 00030F* PRINTS PICK LIST WP410 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP410 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP410 00060F* CONTROL DATA PROPRIETARY PRODUCT WP410 00070F* WP410 0000080FPICK IPEAF 104 DISK WP410 00090FHEADING IT F 40 EDISK WP410 00100F$LP1 O F 132 OF PRINTER WP410 00110F* WP410 00120F* THIS PROGRAM PRINTS THE PICK LIST REPORT FOR EVERY WONUM ON WP410 00130F* THE 'PICK' FILE WP410 00140F* WP410 0000150E HEADING HEAD 1 1 40 WP410 00160IPICK NS 01 1 CP WP410 00170I OR 02 1NCP WP410 00180I 1 1 TYPE WP410 00190I 2 60WONUM L1 WP410 00200I 85 104 PARTNO WP410 00210I 7 43 DESC WP410 0000220I 55 56 UM WP410 00230I 44 490BINNO WP410 00240I 62 680QTY 01 WP410 00250I 69 740DUEDAT 01 WP410 00260I 62 683STRQTY 02 WP410 00270I 69 750EXQTY 02 WP410 00280I 76 770IND 02 WP410 0000290I 78 840SOH 02 WP410 00300C TYPE COMP 'N' 80 WP410 00310C Z-ADDEXQTY ISSAMT 70 WP410 00320C Z-ADDSOH MSOH 70 20 WP410 00330C 20 Z-ADD0 MSOH WP410 00340C EXQTY SUB MSOH SHORT 70 20 WP410 00350C 20 Z-ADD0 SHORT WP410 0000360C N20 Z-ADDMSOH ISSAMT WP410 00370O$LP1 D 02 L1 WP410 00380O HEAD 86 WP410 00390O D 2 L1 WP410 00400O 20 'PICK LIST FOR W.O.#' WP410 00410O WONUM Z 27 WP410 00420O 38 'PART #' WP410 0000430O PARTNO 60 WP410 00440O 81 'QUANTITY :' WP410 00450O QTY J 93 WP410 00460O 100 'UM:' WP410 00470O UM 103 WP410 00480O 132 'JOB410' WP410 00490O D 1 L1 WP410 0000500O 38 'DESC' WP410 00510O DESC 77 WP410 00520O 100 'DUE DATE :' WP410 00530O DUEDATY 111 WP410 00540O UDATE Y 132 WP410 00550O D 2 L1 WP410 00560O 15 'LVL COMPONENT #' WP410 0000580O 66 'UM QTY/PER' WP410 00590O 85 'EXTENDED BIN #' WP410 00600O 111 'ISSUE ISSUE' WP410 00610O 132 'SOH SHORT' WP410 00620O D 1 L1 WP410 00630O 66 'UNIT' WP410 00635O 16 'DESCRIPTION' 0000640O 77 'QTY' WP410 00650O 111 'AMOUNT ADJUSTMENT' WP410 00660O 132 'SHORT ADJUST' WP410 00670O D 1 L1 WP410 00680O 111 '*-----------*----------*' WP410 00690O 132 '*-----------*--------*' WP410 00700O D 1 02 WP410 0000710O IND Z 2 WP410 00720O PARTNO 27 WP410 00721O 88 '*' 00722O 100 '*' 00723O 111 '*' 00724O 123 '*' 00725O 132 '*' 0000726O D 1 02 00730O DESC 42 WP410 00740O 80 42 '*NI*' WP410 00750O UM 55 WP410 00760O STRQTYJ 67 WP410 00770O EXQTY J 78 WP410 00780O BINNO Z 86 WP410 0000790O 88 '*' WP410 00800O NU1 ISSAMT2 98 WP410 00810O 100 '*' WP410 00820O 111 '*' WP410 00830O 123 '*' WP410 00840O SHORT 2 121 WP410 00850O 132 '*' WP410 0000860O D 1 02 WP410 00870O 111 '*-----------*----------*' WP410 00880O 132 '*-----------*--------*' WP410 00890O T 2 L1 WP410 00900O 28 'FILLED BY ___________' WP410 00910O 52 '__________ DATE_________' WP410 00920O T 2 L1 WP410 0000930O 28 'APPROVED BY ___________' WP410 00940O 52 '__________ DATE_________' WP410 ** 000950ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000960ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000970ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000980ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00099000/* 001000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(d RTOTXWP600 P999999042578(000010H S WP600 00020X DECK-ID P13 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP600 00030F* PRINTS THE JOB STATUS REPORT WP600 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP600 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP600 00060F* CONTROL DATA PROPRIETARY PRODUCT WP600 00070F* WP600 0000080FWRKORD IPEAF 160 DISK WP600 00090FHEADING IT F 40 EDISK WP600 00100F$LP1 O F 132 OF PRINTER WP600 00110F* WP600 00120F* THIS PROGRAM PRINTS THE JOB STATUS SUMMARY REPORT. THIS IS JUST WP600 00130F* A FORMATED FILE DUMP OF WRKORD. THE REMAIN FIELD IS COMPUTED WP600 00140F* BY SUBTRACTING QUANTITY COMPLETED AND QTY SCRAPPED FROM THE WP600 0000150F* JOB QUANTITY. WP600 00160F* U1 OFF LISTS ONLY OPEN AND RELEASED JOBS WP600 00170F* U1 ON LISTS ONLY CLOSED JOBS WP600 00180F* U2 ON LISTS OPEN, RELEASED, AND CLOSED JOBS REGARDLESS OF U1 WP600 00190F* WP600 00200E HEADING HEAD 1 1 40 WP600 00210IWRKORD NS 01 WP600 0000220I 1 50WONUM WP600 00230I 6 29 PARTNO WP600 00240I 58 60 PRI WP600 00250I 30 30 STATUS WP600 00260I 31 370JOBQTY WP600 00270I 38 440COMQTY WP600 00280I 107 1130SCRAP WP600 0000290I 45 500RLSDAT WP600 00300I 51 560REQDAT WP600 00310I 57 57 REQGEN WP600 00320I 61 61 OOCODE WP600 00330C SETOF 80 WP600 00340C STATUS COMP 'D' 20 WP600 00350C STATUS COMP 'C' 21 WP600 0000360C NU1N20N21 WP600 00370COR U1 21 WP600 00380COR U2N20 SETON 80 WP600 00390C JOBQTY SUB COMQTY REMAIN 70 WP600 00400C REMAIN SUB SCRAP REMAIN 30 WP600 00410C 30 Z-ADD0 REMAIN WP600 00420O$LP1 H 02 1P WP600 0000430O OR OF WP600 00440O HEAD 84 WP600 00450O H 1 1P WP600 00460O OR OF WP600 00470O 4 'PAGE' WP600 00480O PAGE Z 9 WP600 00490O 74 'JOB STATUS SUMMARY' WP600 0000500O 132 'JOB600' WP600 00510O H 2 1P WP600 00520O OR OF WP600 00530O 16 'W.O.# PART #' WP600 00540O 47 'PRI S JOB' WP600 00550O 74 'QTY SCRAP QTY' WP600 00560O 95 'RELEASE REQUIRED' WP600 0000570O 110 'REQ OUT-OF' WP600 00580O H 11 1P WP600 00590O OR OF WP600 00600O 56 'C QTY COMPLT' WP600 00610O 74 'QTY REMAIN' WP600 00620O 101 'DATE DATE GEN' WP600 00630O 110 'ORDER' WP600 0000640O D 1 01 80 WP600 00650O WONUM Z 5 WP600 00660O PARTNO 30 WP600 00670O PRI 35 WP600 00680O STATUS 38 WP600 00690O JOBQTYL 48 WP600 00700O COMQTYL 57 WP600 0000710O SCRAP L 66 WP600 00720O REMAINL 75 WP600 00730O RLSDATY 85 WP600 00740O REQDATY 95 WP600 00750O REQGEN 100 WP600 00760O OOCODE 108 WP600 ** 00077000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000780ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000790ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000800ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000810/* 000820__0O OOCODE 108 WP600 ** 0007700(2m 2JPR010IS PP999999042178(000010H JPR10I00020FJPR010 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040IJPR010 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 00 00 00 00 00 __ 0(3 oTOTXWP605 P999999042578(000010H S WP605 00020X DECK-ID P14 MFG/DIST/ACCT SYSTEM SUMMARY-239 WP605 00030F* PRINTS THE WORK ORDERS TO BE RELEASE REPORT WP605 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP605 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP605 00060F* CONTROL DATA PROPRIETARY PRODUCT WP605 00070F* WP605 0000080FWRKORD IPEAF 160 DISK WP605 00090FHEADING IT F 40 EDISK WP605 00100F$LP1 O F 132 OF PRINTER WP605 00110F$CTKP D F 70 CONSOLE WP605 00120F* WP605 00130F* THIS PROGRAM LISTS ALL 'OPEN' JOBS WHOSE RELEASE DATE IS LESS WP605 00140F* THAN OR EQUAL TO THE MAXIMUM RELEASE DATE. WP605 0000150F* IF U1 IS ON THE OPERATOR SPECIFIES THE MRD, OTHERWISE IT IS WP605 00160F* THE SYSTEM DATE PLUS 7 DAYS WP605 00170F* WP605 00180E HEADING HEAD 1 1 40 WP605 00190E ME 12 12 2 0 WP605 00200IWRKORD NS 01 30 CO WP605 00210I 1 50WONUM WP605 0000220I 6 29 PARTNO WP605 00230I 31 370JOBQTY WP605 00240I 45 500RLSDAT WP605 00250I 51 560REQDAT WP605 00260I 58 60 PRI WP605 00270I 45 500RLSDAT WP605 00280I 45 460RLSMO WP605 0000290I 47 480RLSDA WP605 00300I 49 500RLSYR WP605 00310I NS 02 WP605 00320I 1 1 A WP605 00330C 99 GOTO START WP605 00340C SETON 99 WP605 00350C U1 GOTO GETDAT WP605 0000360C UDAY ADD 7 UDAY WP605 00370C Z-ADDUMONTH X 20 WP605 00380C UDAY COMP ME,X 20 WP605 00390C N20 GOTO BLDUD WP605 00400C UDAY SUB ME,X UDAY WP605 00410C UMONTH ADD 1 UMONTH WP605 00420C UMONTH COMP 12 20 WP605 0000430C N20 GOTO BLDUD WP605 00440C Z-ADD1 UMONTH WP605 00450C UYEAR ADD 1 UYEAR WP605 00460C BLDUD TAG WP605 00470C MOVE UYEAR DAYR 40 WP605 00480C MOVELUDAY DAYR WP605 00490C MOVE DAYR UDATE WP605 0000500C MOVELUMONTH UDATE WP605 00510C EXSR DOHEAD WP605 00520C GOTO START WP605 00530C GETDAT TAG WP605 00540C MOVEL'MAX RELE'WORD16 16 WP605 00550C MOVE 'ASE DATE'WORD16 WP605 00560C WORD16 DSPLY$CTKP UDATE WP605 0000570C MOVELUDATE UMONTH WP605 00580C MOVE UDATE DAYR WP605 00590C MOVELDAYR UDAY WP605 00600C MOVE DAYR UYEAR WP605 00610C EXSR DOHEAD WP605 00620C START TAG WP605 00630C SETOF 80 WP605 0000640C OF EXSR DOHEAD WP605 00650C N01 GOTO DEND WP605 00660C RLSYR COMP UYEAR 2021 WP605 00670C 20 GOTO DEND WP605 00680C N21 RLSMO COMP UMONTH 2022 WP605 00690C 20 GOTO DEND WP605 00700C N21N22 RLSDA COMP UDAY 20 WP605 0000710C 20 GOTO DEND WP605 00720C SETON 80 WP605 00730C NJOBS ADD 1 NJOBS 50 WP605 00740C DEND TAG WP605 00750CSR DOHEAD BEGSR WP605 00760CSR SETON 81 WP605 00770CSR EXCPT WP605 0000780CSR SETOF 81 WP605 00790CSR ENDSR WP605 00800O$LP1 E 02 81 WP605 00810O HEAD 84 WP605 00820O E 1 81 WP605 00830O 4 'PAGE' WP605 00840O PAGE Z 9 WP605 0000850O 77 'JOBS TO BE RELEASED BY' WP605 00860O UDATE Y 86 WP605 00870O 132 'JOB605' WP605 00880O E 2 81 WP605 00890O 11 'W.O.# PART#' WP605 00900O 56 'QUANTITY RELEASE' WP605 00910O 79 'REQUIRED PRIORITY' WP605 0000920O E 11 81 WP605 00930O 68 'DATE DATE' WP605 00940O D 1 01 80 WP605 00950O WONUM Z 5 WP605 00960O PARTNO 30 WP605 00970O JOBQTYL 44 WP605 00980O RLSDATY 56 WP605 0000990O REQDATY 68 WP605 01000O PRI 74 WP605 01010O T 3 LR WP605 01020O NJOBS Z 5 WP605 01030O 25 'JOBS TO BE RELEASED' WP605 ** 001040ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00105000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001060ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001070ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001080** 001090312831303130313130313031 001100/* 001110__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0010500(3a iOTXWP610 P999999042578(000010H S WP610 00020X DECK-ID P21 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP610 00030F* PRINTS THE DETAIL JOB STATUS REPORT WP610 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP610 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP610 00060F* CONTROL DATA PROPRIETARY PRODUCT WP610 00070F* WP610 0000080FWRKORD IPEAF 160 5AI 1 DISK WP610 00090FWRKOPR IC F 90R DISK WP610 00100FHEADING IT F 40 EDISK WP610 00110F$LP1 O F 132 OF PRINTER WP610 00120FSEQOPR O F 100 DISK WP610 00130F* WP610 00140F* THIS PROGRAM PRINTS THE DETAIL JOB STATUS REPORT. WP610 0000150F* THE WORK ORDER FILE POINTS TO A CHAIN OF OPERATIONS IN THE WP610 00160F* WORK UPERATIONS FILE. WP610 00170F* WP610 00180F* THIS ALSO OUTPUTS THE SEQOPR FILE WITH ONE RECORD FOR EACH WP610 00190F* WRKOPR RECORD. THIS FILE IS USED TO PRINT OPERATION INFORMATION WP610 00200F* IN DIFFERENT ORDER. WP610 00210F* WP610 0000220F* U1- ON ONLY CLOSED JOBS WP610 00230F* U1- OFF NO CLOSED JOBS - ONLY RELEASED WP610 00240F* U2- BOTH WP610 00250E HEADING HEAD 1 1 40 WP610 00260IWRKORD NS 01 WP610 00270I 1 50WONO WP610 00280I 6 29 PARTNO WP610 0000290I 51 560DUEDAT WP610 00300I 58 60 PRI WP610 00310I 30 30 STATUS WP610 00320I 62 660RRN1 WP610 00330IWRKOPR NS 02 WP610 00340I 1 50WONUM WP610 00350I 6 80OPNUM WP610 0000360I 9 12 DEPT WP610 00370I 13 170STANO WP610 00380I 18 221PRATE WP610 00390I 23 250SETUP WP610 00400I 26 26 OPCODE WP610 00410I 27 330QTYQ WP610 00420I 34 400QTYC WP610 0000430I 77 830QTYS WP610 00440I 41 470REWRKQ WP610 00450I 48 540REWRKC WP610 00460I 72 760REWRKH WP610 00470I 61 660REWRK$ WP610 00480I 67 710LABH WP610 00490I 55 600LAB$ WP610 0000500I 84 84 LASTOP WP610 00510C STATUS COMP 'R' 20 WP610 00520C STATUS COMP 'C' 21 WP610 00530C NU1N20NU2 WP610 00540COR U1N21NU2 WP610 00550COR U2N20N21 GOTO DEND WP610 00560C SETON 80 WP610 0000570C GETOPR TAG WP610 00580C Z-ADD0 QTYR 70 WP610 00590C Z-ADD0 STDHRS 50 WP610 00600C Z-ADD0 REMHRS 50 WP610 00610C Z-ADD0 VARPCT 41 WP610 00620C RRN1 COMP 0 40 WP610 00630C 40 GOTO DEND WP610 0000640C RRN1 CHAINWRKOPR H1 WP610 00650C H1 GOTO DEND WP610 00660C WONO COMP WONUM 3030 WP610 00670C 30 GOTO DEND WP610 00680C QTYQ SUB QTYC QTYR WP610 00690C QTYR SUB QTYS QTYR 10 WP610 00700C 10 Z-ADD0 QTYR WP610 0000710C PRATE COMP 0 30 WP610 00720C QTYC COMP 0 313232 WP610 00730C 30 GOTO OUTPUT WP610 00740C QTYC DIV PRATE STDHRS H 30 WP610 00750C 31 STDHRS ADD SETUP STDHRS 30 WP610 00760C QTYR DIV PRATE REMHRS H WP610 00770C 32 REMHRS ADD SETUP REMHRS WP610 0000780C 30 GOTO OUTPUT WP610 00790C LABH DIV STDHRS VAR 73H WP610 00800C VAR MULT 100 VARPCT WP610 00810C OUTPUT TAG WP610 00820C SETON 81 WP610 00830C EXCPT WP610 00840C SETOF 8081 WP610 0000850C RRN1 ADD 1 RRN1 WP610 00860C GOTO GETOPR WP610 00870C DEND TAG WP610 00880O$LP1 H 02 1P WP610 00890O OR OF WP610 00900O HEAD,1 84 WP610 00910O H 1 1P WP610 0000920O OR OF WP610 00930O 4 'PAGE' WP610 00940O PAGE Z 9 WP610 00950O 73 'DETAIL JOB STATUS' WP610 00960O UDATE Y 85 WP610 00970O 132 'JOB610' WP610 00980O H 2 1P WP610 0000990O OR OF WP610 01000O 23 'W.O.# OPER# DEPT WORK' WP610 01010O 47 'O ---- Q U A N T I T' WP610 01020O 65 'Y ----* ----' WP610 01030O 81 'H O U R S' WP610 01040O 106 '----* $ LABOR ----' WP610 01050O 130 'R E W O R K ---*' WP610 0001060O H 11 1P WP610 01070O OR OF WP610 01080O 41 'STA C QUEUED COMPLT' WP610 01090O 57 'SCRAP REMAIN' WP610 01100O 84 'SETUP ACTUAL STD VAR%' WP610 01110O 99 'REMAIN OR O.P.' WP610 01120O 123 'QUEUED COMPLT HOURS' WP610 0001130O 130 'LABOR$' WP610 01140O EF31 80 WP610 01150O WONO Z 5 WP610 01160O PARTNO 40 WP610 01170O DUEDATY 65 WP610 01180O PRI 85 WP610 01190O 15 'PART # :' WP610 0001200O 55 'DUE DATE :' WP610 01210O 80 'PRIORITY :' WP610 01220O 21 6 '*' WP610 01230O E 1 81 WP610 01240O WONUM Z 5 WP610 01250O 21 6 '*' WP610 01260O OPNUM 12 WP610 0001270O DEPT 17 WP610 01280O STANO 23 WP610 01290O OPCODE 25 WP610 01300O QTYQ L 34 WP610 01310O QTYC L 42 WP610 01320O QTYS L 50 WP610 01330O QTYR L 58 WP610 0001340O SETUP L 67 WP610 01350O LABH L 73 WP610 01360O STDHRSL 79 WP610 01370O VARPCTL 85 WP610 01380O REMHRSL 92 WP610 01390O LAB$ L 100 WP610 01400O REWRKQL 110 WP610 0001410O REWRKCL 118 WP610 01420O REWRKHL 124 WP610 01430O REWRK$L 131 WP610 01440OSEQOPR E 81NU1 20 WP610 01450O WONUM 5 WP610 01460O PARTNO 29 WP610 01470O OPNUM 32 WP610 0001480O DEPT 36 WP610 01490O STANO 41 WP610 01500O PRATE 46 WP610 01510O SETUP 49 WP610 01520O OPCODE 50 WP610 01530O QTYQ 57 WP610 01540O QTYC 64 WP610 0001550O REWRKQ 71 WP610 01560O REWRKC 78 WP610 01570O LABH 84 WP610 01580O QTYS 91 WP610 01590O PRI 94 WP610 01600O DUEDAT 100 WP610 ** 00161000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001650/* 001660__0O DUEDAT 100 WP610 ** 0016100(3 }iOTXWP620 P999999042578(000010H S WP620 00020X DECK-ID P22 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP620 00030F* PRINTS THE WORK STATION STATUS REPORT WP620 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP620 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP620 00060F* CONTROL DATA PROPRIETARY PRODUCT WP620 00070F* WP620 0000080FSWKOPR IPEAF 100 DISK WP620 00090FHEADING IT F 40 EDISK WP620 00100FMACHMST IC F 48R 5AI 1 DISK WP620 00110F$LP1 O F 132 OF PRINTER WP620 00120F* WP620 00130F* THIS PROGRAM PRINTS THE WORK STATION STATUS REPORT WP620 00140F* WP620 0000150E HEADING HEAD 1 1 40 WP620 00160ISWKOPR NS 01 WP620 00170I 33 36 DEPT L2 WP620 00180I 37 41 WRKSTAL1 WP620 00190I 92 94 PRI WP620 00200I 95 1000DUEDAT WP620 00210I 1 50WONUM WP620 0000220I 6 29 PARTNO WP620 00230I 51 570QTYQ WP620 00240I 58 640QTYC WP620 00250I 85 910SCRAP WP620 00260I 47 490SETUP WP620 00270I 80 840LABHRS WP620 00280I 65 710REWRKQ WP620 0000290I 72 780REWRKC WP620 00300I 40 461PRODRT WP620 00310IMACHMST NS 03 WP620 00320I 37 420CAPCTY WP620 00330I 36 36 DCODE WP620 00340C Z-ADD0 STDHRS WP620 00350C Z-ADD0 VAR WP620 0000360C Z-ADD0 REMHRS WP620 00370C L1 Z-ADD0 TRHRSW WP620 00380C L2 Z-ADD0 TRHRSD WP620 00390C L2 Z-ADD0 TCAPD WP620 00400C QTYQ SUB QTYC REMAIN 70 WP620 00410C REMAIN SUB SCRAP REMAIN 25 WP620 00420C 25 Z-ADD0 REMAIN WP620 0000430C QTYC COMP 0 20 WP620 00440C PRODRT COMP 0 21 WP620 00450C 21 QTYC DIV PRODRT STDHRS 50H WP620 00460C 20 STDHRS ADD SETUP STDHRS 22 WP620 00470C 22 LABHRS DIV STDHRS VAR 53H WP620 00480C VAR MULT 100 VARPCT 41H WP620 00490C 21 REMAIN DIV PRODRT REMHRS 50H WP620 0000500C N20 REMHRS ADD SETUP REMHRS WP620 00510C REMHRS ADD TRHRSW TRHRSW 60 WORK STA TOTAL WP620 00520C REMHRS ADD TRHRSD TRHRSD 60 DEPT TOTAL WP620 00530C REMHRS ADD TRHRSC TRHRSC 60 COMPANY TOTAL WP620 00540CL1 WRKSTA CHAINMACHMST 55 WP620 00550CL1N55 DCODE COMP 'D' 55 WP620 00560CL1 55 Z-ADD0 CAPCTY WP620 0000570CL1 CAPCTY ADD TCAPD TCAPD 60 DEPT CAPACITY WP620 00580CL1 CAPCTY ADD TCAP TCAP 60 COMPANY CAP. WP620 00590O$LP1 H 02 L2 WP620 00600O OR OFNL2 WP620 00610O HEAD 84 WP620 00620O H 1 L2 WP620 00630O OR OFNL2 WP620 0000640O 4 'PAGE' WP620 00650O PAGE Z 9 WP620 00660O 76 'WORK STATION STATUS' WP620 00670O UDATE Y 87 WP620 00680O 132 'JOB620' WP620 00690O H 2 L2 WP620 00700O OR OFNL2 WP620 0000710O 24 'DEPT WORK W.O.# PART #' WP620 00720O 59 'PRI DUE DATE ----' WP620 00730O 77 'Q U A N T I T Y' WP620 00740O 91 '---* ----' WP620 00750O 106 'H O U R S' WP620 00760O 131 '---* ----R E W O R K' WP620 00770O* WP620 0000780O D 11 L2 WP620 00790O OR OFNL2 WP620 00800O 9 'STA' WP620 00810O 78 'QUEUED COMPLT REMAIN' WP620 00820O 102 'SCRAP SU ACTUAL STD' WP620 00830O 123 'VAR% REMAIN QUEUED' WP620 00840O 131 'COMPLT' WP620 0000850O D 1 01 WP620 00860O DEPT 4 WP620 00870O WRKSTA 10 WP620 00880O WONUM Z 16 WP620 00890O PARTNO 41 WP620 00900O PRI 45 WP620 00910O DUEDATY 54 WP620 0000920O QTYQ L 63 WP620 00930O QTYC L 71 WP620 00940O REMAINL 79 WP620 00950O SCRAP L 87 WP620 00960O SETUP Z 90 WP620 00970O LABHRSL 97 WP620 00980O STDHRSL 103 WP620 0000990O VARPCTL 109 WP620 01000O REMHRSL 116 WP620 01010O REWRKQL 124 WP620 01020O REWRKCL 131 WP620 01030O T 11 L1 WP620 01040O WRKSTA 10 WP620 01050O 35 'WORK STATION TOTAL' WP620 0001060O 104 'CAPACITY: HRS/MO' WP620 01070O CAPCTYL 97 WP620 01080O TRHRSWL 116 WP620 01090O T 2 L2 WP620 01100O DEPT 4 WP620 01110O 33 'DEPARTMENT TOTAL' WP620 01120O 104 'CAPACITY: HRS/MO' WP620 0001130O TCAPD L 97 WP620 01140O TRHRSDL 116 WP620 01150O T 2 LR WP620 01160O 30 'COMPANY TOTAL' WP620 01170O 104 'CAPACITY: HRS/MO' WP620 01180O TCAP L 97 WP620 01190O TRHRSCL 116 WP620 00** 001200ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001210ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001220ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001230ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001240/* 001250__0O TRHRSCL 116 WP620 0(45 iOTXWP630 P999999042578(0__45 iOTXWP630 P999999042578(F838F9397A3A5E3B4C3C4A5BD05D7E3D 001220ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001230ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001240/* 001250__0O TRHRSCL 116 WP620 0(4 OTXWP700 P999999042578(0__4 OTXWP700 P999999042578(F838F9397A3A5E3B4C3C4A5BD05D7E3D 001220ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001230ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001240/* 001250__0O TRHRSCL 116 WP620 0(5G iOTXWP710 P999999042578(000010H S WP710 00020X DECK-ID P16 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP710 00030F* PURGES THE OPEN WORKORDER FILE WP710 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP710 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP710 00060F* CONTROL DATA PROPRIETARY PRODUCT WP710 00070F* WP710 0000080FHEADING IT F 40 EDISK WP710 00090FWRKORD IPEAF 160 5AI 1 DISK WP710 00100FNWKORD O F 160 5AI 1 DISK WP710 00110F$LP1 O F 132 OF PRINTER WP710 00120FCONSOL D F 80 CONSOLE WP710 00130F* ID F C H L FUNCTION OF INDICATORS WP710 00140F* 01 CLOSED WRKORD RECORD WP710 0000150F* 02 DELETED WRKORD RECORD WP710 00160F* 03 NOT DELETED OR CLOSED WP710 00170F* 20 COMPARE INDICATOR WP710 00180F* 80 CLOSED RECORD GREATER THAN CUTOFF DATE - WILL NOT WP710 00190F* BE REMOVED WP710 00200F* 81 COMPARE INDICATOR WP710 00210F* 98 FIRST PAGE WP710 0000220F* 99 FIRST TIME THROUGH WP710 00230F**** WP710 00240F* THIS PROGRAM REMOVES ALL DELETED JOBS AND ALL CLOSE JOBS WHOSE WP710 00250F* CLOSE DATE IS LESS THAN THE CUTOFF DATE. IT LISTS ANY JOBS WP710 00260F* THAT ARE REMOVED. WP710 00270F* IF U1 IS OFF THE CUTOFF DATE IS ASSUMED TO BE 3 MONTHS PREVIOUS WP710 00280F* TO THE SYSTEM DATE. IF U1 IS ON THE OPERATOR MUST SPECIFY THE WP710 0000290F* CUTOFF DATE. WP710 00300E HEADING HEAD 1 1 40 WP710 00310E ME 12 12 2 0 WP710 00320IWRKORD NS 01 30 CC WP710 00330I OR 02 30 CD WP710 00340I 1 50WONUM WP710 00350I 6 29 PARTNO WP710 0000360I 107 1130QTYS WP710 00370I 38 440QTYC WP710 00380I 45 500CLSDAT WP710 00390I 45 460CLSMO WP710 00400I 47 480CLSDA WP710 00410I 49 500CLSYR WP710 00420I 67 720MAT$ WP710 0000430I 73 780LAB$ WP710 00440I 79 840BUR$ WP710 00450I 85 900OP$ WP710 00460I 91 960RWK$ WP710 00470I 97 1010LABH WP710 00480I 102 1060RWKH WP710 00490I 1 160 REC WP710 0000500I NS 03 WP710 00510I 1 160 REC WP710 00520C SETOF 98 WP710 00530C 99 GOTO START WP710 00540C U1 GOTO GETDAT WP710 00550C UMONTH SUB 3 MO 20 20 WP710 00560C 20 MO ADD 12 MO WP710 0000570C 20 UYEAR SUB 1 UYEAR WP710 00580C ME,MO COMP UDAY 20 WP710 00590C MOVE ME,MO UDAY WP710 00600C MOVELUDAY DY 40 WP710 00610C MOVE UYEAR DY WP710 00620C MOVE DY DATE 60 WP710 00630C MOVELMO DATE WP710 0000640C MOVE UDAY DA 20 WP710 00650C MOVE UYEAR YR 20 WP710 00660C SETON 9998 WP710 00670C GOTO START WP710 00680C GETDAT TAG WP710 00690C MOVEL'TYPE CUT'WORD16 16 WP710 00700C MOVE 'OFF DATE'WORD16 WP710 0000710C WORD16 DSPLYCONSOL DATE WP710 00720C MOVELDATE MO WP710 00730C MOVE DATE DY WP710 00740C MOVELDY DA WP710 00750C MOVE DY YR WP710 00760C MO COMP 0 20 WP710 00770C N20 MO COMP 12 20 WP710 0000780C 20 GOTO GETDAT WP710 00790C DA COMP 0 20 WP710 00800C N20 DA COMP 31 20 WP710 00810C 20 GOTO GETDAT WP710 00820C YR COMP 70 20 WP710 00830C 20 GOTO GETDAT WP710 00840C SETON 9998 WP710 0000850C START TAG WP710 00860C 02 WP710 00870COR 03 GOTO DEND WP710 00880C CLSYR COMP YR 81 80 WP710 00890C 80 CLSMO COMP MO 81 80 WP710 00900C 80 CLSDA COMP DA 81 80 WP710 00910C 81 SETON 80 WP710 0000920C DEND TAG WP710 00930O$LP1 H 02 98 WP710 00940O OR OF WP710 00950O HEAD 84 WP710 00960O H 1 98 WP710 00970O OR OF WP710 00980O OR OF WP710 0000990O 4 'PAGE' WP710 01000O PAGE Z 9 WP710 01010O 74 'JOBS REMOVED FROM FILE' WP710 01020O 132 'JOB710' WP710 01030O 93 'CUTOFF DATE' WP710 01040O DATE Y 103 WP710 01050O H 2 98 WP710 0001060O OR OF WP710 01070O 11 'W.O.# PART#' WP710 01080O 48 'QTY CLOSE' WP710 01090O 75 '----- D O L L A R S' WP710 01100O 106 '----- - H O U R S-' WP710 01110O 117 'QTY' WP710 01120O H 11 98 WP710 0001130O OR OF WP710 01140O 48 'COMPLT DATE' WP710 01150O 74 'MATERL LABOR BURDEN' WP710 01160O 90 'OUT-PR REWORK' WP710 01170O 106 'LABOR REWORK' WP710 01180O 117 'SCRAP' WP710 01190O D 1 01N80 WP710 0001200O OR 02 WP710 01210O WONUM Z 5 WP710 01220O PARTNO 30 WP710 01230O QTYC L 39 WP710 01240O CLSDATY 48 WP710 01250O MAT$ L 59 WP710 01260O LAB$ L 67 WP710 0001270O BUR$ L 75 WP710 01280O OP$ L 83 WP710 01290O RWK$ L 91 WP710 01300O LABH L 100 WP710 01310O RWKH L 107 WP710 01320O 01 131 '*CLOSED' WP710 01330O 02 132 '*DELETED' WP710 0001340O QTYS L 118 WP710 01350ONWKORD D 01 80 WP710 01360O OR 03 WP710 01370O REC 160 WP710 ** 001380ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001390ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00140000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001410ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001420** 001430312831303130313130313031 001440/* 001450__EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001390ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0014000(5 iTXWP620 P999999111111(000010H S WP620 00020X DECK-ID P22 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP620 00030F* PRINTS THE WORK STATION STATUS REPORT WP620 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP620 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP620 00060F* CONTROL DATA PROPRIETARY PRODUCT WP620 00070F* WP620 0000080FSWKOPR IPEAF 100 DISK WP620 00090FHEADING IT F 40 EDISK WP620 00100FMACHMST IC F 48R 5AI 1 DISK WP620 00110F$LP1 O F 132 OF PRINTER WP620 00120F* WP620 00130F* THIS PROGRAM PRINTS THE WORK STATION STATUS REPORT WP620 00140F* WP620 0000150E HEADING HEAD 1 1 40 WP620 00160ISWKOPR NS 01 WP620 00170I 33 36 DEPT L2 WP620 00180I 37 41 WRKSTAL1 WP620 00190I 92 94 PRI WP620 00200I 95 1000DUEDAT WP620 00210I 1 50WONUM WP620 0000220I 6 25 PARTNO WP620 00230I 51 570QTYQ WP620 00240I 58 640QTYC WP620 00250I 85 910SCRAP WP620 00260I 47 490SETUP WP620 00270I 80 840LABHRS WP620 00280I 65 710REWRKQ WP620 0000290I 72 780REWRKC WP620 00300I 40 461PRODRT WP620 00310IMACHMST NS 03 WP620 00320I 37 420CAPCTY WP620 00330I 36 36 DCODE WP620 00340C Z-ADD0 STDHRS WP620 00350C Z-ADD0 VAR WP620 0000360C Z-ADD0 REMHRS WP620 00370C L1 Z-ADD0 TRHRSW WP620 00380C L2 Z-ADD0 TRHRSD WP620 00390C L2 Z-ADD0 TCAPD WP620 00400C QTYQ SUB QTYC REMAIN 70 WP620 00410C REMAIN SUB SCRAP REMAIN 25 WP620 00420C 25 Z-ADD0 REMAIN WP620 0000430C QTYC COMP 0 20 WP620 00440C PRODRT COMP 0 21 WP620 00450C 21 QTYC DIV PRODRT STDHRS 50H WP620 00460C 20 STDHRS ADD SETUP STDHRS 22 WP620 00470C 22 LABHRS DIV STDHRS VAR 53H WP620 00480C VAR MULT 100 VARPCT 41H WP620 00490C 21 REMAIN DIV PRODRT REMHRS 50H WP620 0000500C N20 REMHRS ADD SETUP REMHRS WP620 00510C REMHRS ADD TRHRSW TRHRSW 60 WORK STA TOTAL WP620 00520C REMHRS ADD TRHRSD TRHRSD 60 DEPT TOTAL WP620 00530C REMHRS ADD TRHRSC TRHRSC 60 COMPANY TOTAL WP620 00540CL1 WRKSTA CHAINMACHMST 55 WP620 00550CL1N55 DCODE COMP 'D' 55 WP620 00560CL1 55 Z-ADD0 CAPCTY WP620 0000570CL1 CAPCTY ADD TCAPD TCAPD 60 DEPT CAPACITY WP620 00580CL1 CAPCTY ADD TCAP TCAP 60 COMPANY CAP. WP620 00590O$LP1 H 02 L2 WP620 00600O OR OFNL2 WP620 00610O HEAD 86 WP620 00620O H 1 L2 WP620 00630O OR OFNL2 WP620 0000640O 4 'PAGE' WP620 00650O PAGE Z 8 WP620 00660O 76 'WORK STATION STATUS' WP620 00670O UDATE Y 87 WP620 00680O 132 'JOB620' WP620 00690O H 2 L2 WP620 00700O OR OFNL2 WP620 0000710O 16 'DEPT WORK W.O.#' WP620 00715O 29 'PART NUMBER' 00720O 59 'PRI DUE DATE ----' WP620 00730O 77 'Q U A N T I T Y' WP620 00740O 91 '---* ----' WP620 00750O 106 'H O U R S' WP620 00760O 131 '---* ----R E W O R K' WP620 0000770O* WP620 00780O D 11 L2 WP620 00790O OR OFNL2 WP620 00800O 9 'STA' WP620 00810O 78 'QUEUED COMPLT REMAIN' WP620 00820O 102 'SCRAP SU ACTUAL STD' WP620 00830O 123 'VAR% REMAIN QUEUED' WP620 0000840O 131 'COMPLT' WP620 00850O D 1 01 WP620 00860O DEPT 4 WP620 00870O WRKSTA 10 WP620 00880O WONUM Z 16 WP620 00890O PARTNO 38 WP620 00900O PRI 45 WP620 0000910O DUEDATY 54 WP620 00920O QTYQ L 63 WP620 00930O QTYC L 71 WP620 00940O REMAINL 79 WP620 00950O SCRAP L 87 WP620 00960O SETUP Z 90 WP620 00970O LABHRSL 97 WP620 0000980O STDHRSL 103 WP620 00990O VARPCTL 109 WP620 01000O REMHRSL 116 WP620 01010O REWRKQL 124 WP620 01020O REWRKCL 131 WP620 01030O T 11 L1 WP620 01040O WRKSTA 10 WP620 0001050O 35 'WORK STATION TOTAL' WP620 01060O 104 'CAPACITY: HRS/MO' WP620 01070O CAPCTYL 97 WP620 01080O TRHRSWL 116 WP620 01090O T 2 L2 WP620 01100O DEPT 4 WP620 01110O 33 'DEPARTMENT TOTAL' WP620 0001120O 104 'CAPACITY: HRS/MO' WP620 01130O TCAPD L 97 WP620 01140O TRHRSDL 116 WP620 01150O T 2 LR WP620 01160O 30 'COMPANY TOTAL' WP620 01170O 104 'CAPACITY: HRS/MO' WP620 01180O TCAP L 97 WP620 0001190O TRHRSCL 116 WP620 ** 001200ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001210ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001220ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001230ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001240/* 00125000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(b TXOE110 P=? 999999051778(000010H S OE110 00020X DECK-ID A59 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE110 00030F* THIS IS THE ORDER ENTRY PROGRAM OE110 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE110 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE110 00060F* CONTROL DATA PROPRIETARY PRODUCT OE110 00070F* OE110 0000080FDUMMY IPEAF 72 DISK OE110 00090FDISPR1 IC F 32R DISK OE110 00100FARMAST IC F 280R 6AI 1 DISK OE110 00110FPARTMST UC F 300R20AI 271 DISK OE110 00120FSLSMAN IC F 30R 3AI 1 DISK OE110 00130FAREA IC F 30R 2AI 1 DISK OE110 00140FTERMS IC F 30R 1AI 1 DISK OE110 0000150FSOTEMP UC F 9R 7AI 1 DISK A OE110 00160FOPNORDS UC F 119R 8AI 106 DISK A OE110 00170FNEWPART O F 30 DISK A 00180F********************************************************************OE110 00190F* PACKAGE-DISTRIBUTION CONTRACTOR-COMPUSOURCE OE110 00200F* OE110 00210F* SYSTEM-SALES ORDER PROCESSING BY- GAIL KARON/ROBBIE FREEMAN OE110 0000220F* OE110 00230F* PROGRAM-DIS110 DATE- 8/15/76 OE110 00240F********************************************************************OE110 00250F* DIS110 IS THE ORDER ENTRY PROGRAM. OE110 00260F* IT OUTPUTS HEADER RECORDS, SHIP-TO LINES, COMMENT LINES, OE110 00270F* INVOICE LINES, AND LINE ITEMS TO ORDINP OR INVDIR DEPENDING OE110 00280F* ON THE ORDER TYPE. ALL GOOD SALES ORDER NUMBERS ARE OUTPUT OE110 0000290F* TO SOTEMP. OE110 00300F********************************************************************OE110 00310F* FUNCTION OF INDICATORS OE110 00320F* OE110 00330F* 01 RECORD FROM DUMMY--NO RECORDS EXIST IN THIS FILE OE110 00340F* 02 ORDPR1 RECORD--PARAMETER FILE RECORDS OE110 00350F* 04 RECORD FROM ARMAST--CHAIN TO IT OE110 0000360F* 05 RECORD FROM OPNINDX--CHAIN TO IT OE110 00370F* 06 RECORD FROM PARTMST--CHAIN TO IT OE110 00380F* 07 RECORD FROM SOTEMP--CHAIN TO IT OE110 00390F* 08 RECORD FROM SLSMAN--CHAIN TO IT OE110 00400F* 09 RECORD FROM AREA----CHAIN TO IT OE110 00410F* 10 RECORD FROM TERMS---CHAIN TO IT OE110 00420F* 20 RECRDS SUBROUTINE--ORDER TYPE IS BLANK--SALES ORDER OE110 0000430F* OUTPUT RECORDS TO ORDINP OE110 00440F* 21 RECRDS SUBROUTINE--ORDER TYPE IS C--CREDIT MEMO OE110 00450F* 22 RECRDS SUBROUTINE--ORDER TYPE IS D--DIRECT BILL OE110 00460F* 23 RECRDS SUBROUTINE--ORDER TYPE IS M--MANUAL INVOICE OE110 00470F* OUTPUT RECORDS TO INVDIR OE110 00480F* 25 OUTPUT TO SOTEMP OE110 00490F* OUTPUT HEADER, SHIP, COMMENT, INVOICE RECORDS OE110 0000500F* 26 OUTPUT LINE ITEMS RECORDS OE110 00510F* 30 OUTFLD SUBROUTINE-LEN = 0, IT'S A MESSAGE OE110 00520F* UPDATE SUBROUTINE--N73=TRY ANOTHER X OE110 00530F* -- 73=BEGIN AT X=7 AGAIN OE110 00540F* ACCEPT SUBROUTINE-IS X OUT OF SECTN SIZE RANGE OE110 00550F* -@ SIGN--LEAVE SUBROUTINE OE110 00560F* 31 OUTPUT SUBROUTINE--COMP NOFLDS TO CONTINUE LOOP OE110 0000570F* OUTFLD SUBROUTINE--COMP CONSTANT LENGTH(FL) TO OE110 00580F* END POS OF FIELD(FC)--LEN IS NEGATIVE IMPLIES OE110 00590F* THE FIELD IS NUMERIC OE110 00600F* UPDATE SUBROUTINE--RUBOUT AT FIRST CHARACTER OF OE110 00610F* FIELD IS NOT AT FIRST UPDATE ON SCREEN-CONTINUE OE110 00620F* THE LOOP OE110 00630F* ACCEPT SUBROUTINE--RCODE IS 'R'--RUBOUT OE110 0000640F* 32 BODY OF PROGRAM--RUBOUT AT FIRST UPDATE FIELD-GO OE110 00650F* TO PRIOR SCREEN OE110 00660F* GETSEC SUBROUTINE--X GREATER THAN SECTN SIZE OE110 00670F* UPDATE SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE110 00680F* ACCEPT SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE110 00690F* 33 UPDATE & ACCEPT SUBROUTINE--LINE FEED THROUGH FIELD OE110 00700F* 34 ACCEPT SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE110 0000710F* 35 UPDATE SUBROUTINE--@ AT BEGINNING OF FIELD OE110 00720F* 37 LNGTH SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE110 00730F* 40 END-OF-JOB CONDITION OE110 00740F* 41 GETSEC SUBROUTINE--FIELDN & CURPOS BLANK OE110 00750F* MEANS END OF THAT SECTION IN PARAMETER FILE OE110 00760F* 42 'WHAT SCREEN?' = 2--GOTO SHIPTO SCREEN AFTER HEADER OE110 00770F* 43 'WHAT SCREEN?' = 3--GOTO COMENT SCREEN AFTER HEADER OE110 0000780F* N42N43 GOTO LINE ITEMS AFTER HEADER. OE110 00790F* 50 RRN CHAIN TO PARAMETER FILE--NO MORE RECORDS OE110 00800F* 58 BATCH SUBROUTINE--BATCHES OUT OF BALANCE OE110 00810F* 59 USED IN GET2, POSLIN, EDIT, & BATCH SUBROUTINES OE110 00820F* USED FOR COMPARISIONS TO CONTINUE LOOPS, ETC. OE110 00830F* 60 EDIT SUBROUTINE--OUTPUT PARTMST DESC & PRICE OE110 00840F* 64 RESPONE TO 'OK ?' IS 'R'--GO BACK TO LINE ITEMS OE110 0000850F* 65 'WHAT LINE ?' = Y --SKIP TOTALS BUT OUTPUT ORDER OE110 00860F* 66 'WHAT LINE ?' = T --GO TO TOTALS SECTION (BATCH TOT)OE110 00870F* 67 'WHAT LINE ?' = @ OR IN SOME CASES R OE110 00880F* DO ANOTHER LINE ITEM SCREEN--GO FORWARD OR BACK OE110 00890F* 68 'WHAT LINE ?' = R AND IT'S THE FIRST SCREEN OE110 00900F* GO BACK TO COMMENT SCREEN. OE110 00910F* 69 'OK?' OR 'WHAT LINE?' = N--DON'T OUTPUT RECORDS OE110 0000920F* 70 SCREEN IS HEADER OE110 00930F* 71 SCREEN IS SHIP OE110 00940F* 72 SCREEN IS MARK FOR COMMENTS OE110 00950F* 73 SCREEN IS LINE ITEMS OE110 00960F* 74 SCREEN IS BATCH TOTAL OE110 00970F* 76 LINE ITEM TYPE JUST ENTERED IS BLANK OE110 00980F* 77 LINE ITEM TYPE JUST ENTERED IS L--LINE OE110 0000990F* 78 LINE ITEM TYPE JUST ENTERED IS C--LINE COMMENT OE110 01000F* 83 XTYPE SUBROUTINE--SECTN 3,X=7 WHAT LINE ? OE110 01010F* 84 XTYPE SUBROUTINE--SECTN 3,X=8 TYPE OE110 01020F* 85 XTYPE SUBROUTINE--SECTN 3,X=9 PRODUCT # OE110 01030F* 86 XTYPE SUBROUTINE--SECTN 3,X=10 QUANTITY OE110 01040F* 87 XTYPE SUBROUTINE--SECTN 3,X=11 PRICE OVERRIDE OE110 01050F* 88 XTYPE SUBROUTINE--SECTN 3,X=12 LINE COMMENT OE110 0001060F* 90 LINE ITEM SCREEN IS IN 'WHAT LINE?' MODE OE110 01070F* 96 EDIT SUBROUTINE--ERROR EXISTS OE110 01080F* 97 EDIT SUBROUTINE--GOTO CORRECT TAG OE110 01090F* LR LAST RECORD--BODY OF PROGRAM LOOPS THROUGH LR CALCS OE110 01100F* AVAILABLE INDICATORS----03,05,11-19,24,27,29,36,38-39,44-OE110 01110F* 51-57,75,79-82,89,91-95,98 OE110 01120F* 99 ERROR ROUTINE COMPARISION OE110 0001130E********************************************************************OE110 01140E FN 21 22 FIELD NAME OE110 01150E CP 21 4 CURSOR POSITION OE110 01160E LN 21 2 0 LENGTH OE110 01170E EP 21 3 0 ENDING POSITION OE110 01180E PB 5 7 3 PARTMST PRICES OE110 01190E TABD 12 12 2 0 TABE 2 0 MONTH/DAY TABLE OE110 0001200E LC 36 64 LINE/COMMENT ARY OE110 01210E POV 36 1 PRICE OVRD CHECK OE110 01220E MS 1 4 72 MESSAGE ARRAY OE110 01230E TABA 1 20 3 0 TABB 30 ERROR MESSAGES OE110 01240E* OE110 01250E* TABA CONTAINS SECTION NUMBER AND X COORDINATE TO BE EDITED OE110 01260E* TABB CONTAINS CURPOS AND ERROR MESSAGE OE110 0001270E* OE110 01280E* LC 1ST CHARACTER CONTAINS THE TYPE (L,C). OE110 01290E* THIS DEFINES USE OF REMAINDER OF ARRAY. OE110 01300E* LC ARRAY IS SET UP TO HANDLE PRODUCT #, QTY, & PRICE OVERRIDE OE110 01310E* IF THE TYPE IS 'L' OE110 01320E* PRODUCT # IS IN LOCATIONS 3-14 OE110 01330E* QUANTITY IS IN LOCATIONS 16-22 OE110 0001340E* PRICE OVERRIDE IS IN LOCATIONS 33-39 OE110 01350E* BIN IS IN LOCATIONS 40-44 OE110 01360E* LC ARRAY IS SET UP TO HANDLE LINE ITEM COMMENTS OE110 01370E* IF THE TYPE IS 'C' OE110 01380E* COMMENT IS IN LOCATIONS 2-39 OE110 01390E* INFORMATION IS MOVED AROUND BY SUBRMV & MOVE STATEMENTS. OE110 01400E********************************************************************OE110 0001410IDUMMY NS 01 OE110 01420I 1 1 A OE110 01430IDISPR1 NS 02 OE110 01440I 1 22 FIELDN OE110 01450I 23 26 CURPOS OE110 01460I 27 280LNGTHA OE110 01470I 29 310ENDPOS OE110 0001480I 32 320SET OE110 01490IARMAST NS 04 OE110 01500I 7 30 NAME OE110 01510I 31 54 ADR1 OE110 01520I 55 78 ADR2 OE110 01530I 79 91 CITY OE110 01540I 92 93 STCODE OE110 0001550I 94 980ZIP OE110 01560I 94 98 AZIP OE110 01570I 115 115 DCODE OE110 01580I 161 1610PC OE110 01590IPARTMST NS 06 OE110 01600I 1 37 DESC OE110 01610I 74 74 DPCODE OE110 0001620I 226 260 PB OE110 01630I 261 265 BIN OE110 01640I 146 1520SOH OE110 01650I 167 1730SALLOC OE110 01660IOPNORDS NS 05 OE110 01670I 1 1 A OE110 01680ISOTEMP NS 07 OE110 0001690I 1 1 A OE110 01700ISLSMAN XX 08 OE110 01710I 4 28 SNAME OE110 01720I 30 30 DLTSMN OE110 01730IAREA XX 09 OE110 01740I 3 27 ANAME OE110 01750I 30 30 DLTARA OE110 0001760ITERMS XX 10 OE110 01770I 2 26 TNAME OE110 01780I 30 30 DLTTRM OE110 01790C********************************************************************OE110 01800C* BODY OF PROGRAM IS SUBROUTINES. OE110 01810C* ORDER IS AS FOLLOWS : NAME OF SUBROUTINE : OE110 01820C* 1 BLANK FIELDS AND ARRAYS BLANK OE110 0001830C* 2 HEADER INFORMATION BODY--70 ON--SECTN 0 OE110 01840C* 3 SHIP-TO LINES BODY--71 ON--SECTN 1 OE110 01850C* 4 MARK FOR COMMENT LINES BODY--72 ON--SECTN 2 OE110 01860C* 5 LINE ITEMS AND COMMENTS BODY--73 ON--SECTN 3 OE110 01870C* 6 BATCH TOTALS BODY--74 ON--SECTN 4 OE110 01880C* 7 OUTPUT RECORDS RECRDS OE110 01890C* THE USER WILL BE ABLE TO SKIP FORWARD AND BACKWARD THROUGH OE110 0001900C* SUBROUTINES 2-6. OE110 01910C* RECORDS WILL BE OUTPUT ONLY IF THE USER SAID TO OUTPUT OE110 01920C* THE ORDER. OE110 01930C********************************************************************OE110 01940C SETON LR OE110 01950CLR Z-ADD36 UPPER 20 SET LINE-ITEM OE110 01960CLR MOVE UPPER UPPERA 2 LIMITS OE110 0001970CLR Z-ADD21 SSIZE 20 OE110 01980CLR Z-ADD05 NSECT 20 OE110 01990CLR MOVE ' ' RCODE OE110 02000CLR MOVE B118 B118 118 OE110 02010CLR MOVE B72 B72 72 BLANK FIELD OE110 02020CLR MOVE B39 B39 39 BLANK FIELD OE110 02030CLR MOVE B26 B26 26 BLANK FIELD OE110 0002040CLR MOVE B22 B22 22 BLANK FIELD OE110 02050CLR MOVE B12 B12 20 BLANK FIELD OE110 02060CLR Z-ADD0 DTYPE 10 OE110 02070C* OE110 02080CLR BEGIN TAG OE110 02090CLR EXSR BLANK OE110 02100C* OE110 0002110CLR SUB0 TAG OE110 02120CLR SETON 70 HEADER RECORD OE110 02130CLR Z-ADD0 SECTN 10 OE110 02140CLR EXSR BODY OE110 02150CLR SETOF 70 OE110 02160CLR MOVELRECORD HEADER OE110 02170CLR 32 GOTO SUB0 OE110 0002180CLR 40 EXSR CLRSCR OE110 02190CLR 40 GOTO STOP OE110 02200CLR 42 GOTO SUB1 OE110 02210CLR 43 GOTO SUB2 OE110 02220CLR GOTO SUB3 OE110 02230C* OE110 02240CLR SUB1 TAG OE110 0002250CLR SETON 71 SHIP-TO RECORD OE110 02260CLR Z-ADD1 SECTN OE110 02270CLR EXSR BODY OE110 02280CLR SETOF 71 OE110 02290CLR MOVELRECORD SHIP OE110 02300CLR 32 GOTO SUB0 OE110 02310C* OE110 0002320CLR SUB2 TAG OE110 02330CLR SETON 72 COMMENT RECORD OE110 02340CLR Z-ADD2 SECTN OE110 02350CLR EXSR BODY OE110 02360CLR SETOF 72 OE110 02370CLR MOVELRECORD COMENT OE110 02380CLR 32 GOTO SUB1 OE110 0002390C* OE110 02400CLR SUB3 TAG OE110 02410CLR SETON 73 LINE ITEMS OE110 02420CLR Z-ADD3 SECTN OE110 02430CLR EXSR BODY OE110 02440CLR SETOF 73 OE110 02450CLR 68 GOTO SUB2 OE110 0002460CLR 65 SKIP BATCH OE110 02470COR 69 GOTO NOTOTS TOTALS OE110 02480C* OE110 02490CLR SUB4 TAG OE110 02500CLR SETON 74 BATCH TOTALS OE110 02510CLR Z-ADD4 SECTN OE110 02520CLR EXSR BODY OE110 0002530CLR SETOF 74 OE110 02540CLR 32 OE110 02550COR 64 GOTO SUB3 OE110 02560CLR NOTOTS TAG OE110 02570CLRN69 EXSR RECRDS OE110 02580CLR GOTO BEGIN OE110 02590C* OE110 0002600CLR STOP TAG OE110 02610C********************************************************************OE110 02620C* THIS SUBROUTINE BLANKS ALL FIELDS AND ARRAYS USED DURING OE110 02630C* OUTPUT. THIS IS DONE ONLY AT THE BEGINNING OF EACH NEW ORDER. OE110 02640C********************************************************************OE110 02650CSR BLANK BEGSR OE110 02660CSR MOVE B118 HEADER118 BLNK HEADER OE110 0002670CSR MOVE B118 SHIP 118 BLNK SHIP OE110 02680CSR MOVE B118 COMENT118 BLNK COMMENT OE110 02690CSR MOVE B118 RECORD BLNK RT RECORD OE110 02700CSR MOVE B118 LC BLNK LC ARRAY OE110 02710CSR MOVE B118 POV BLNK CHECK ARY OE110 02720CSR Z-ADD0 SPC 10 SAVE PRICE COD OE110 02730CSR Z-ADD0 OPC 10 OVRD PRICE COD OE110 0002740CSR Z-ADD0 BQTY BATCH QTY OE110 02750CSR Z-ADD0 BPR BATCH PRICE OV OE110 02760CSR SETOF 90 OE110 02770CSR SETOF 58 RESET OE110 02780C* BATCH ERROR OE110 02790C* INDICATOR OE110 02800CSR ENDSR OE110 0002810C********************************************************************OE110 02820C* THIS SUBROUTINE HANDLES THE FOUR DIFFERENT SCREENS THAT OE110 02830C* ARE DISPLAYED. OE110 02840C* IT DOES THE FOLLOWING : OE110 02850C* CLEARS THE SCREEN OE110 02860C* LOADS THE PARAMETER FILE SECTION INTO ARRAYS OE110 02870C* OUTPUTS THE SCREEN OE110 0002880C* ALLOWS THE INFORMATION ON THE SCREEN TO BE UPDATED. OE110 02890C********************************************************************OE110 02900CSR BODY BEGSR OE110 02910CSR MOVELB118 RECORD136 OE110 02920CSR 70 MOVELHEADER RECORD OE110 02930CSR 71 MOVELSHIP RECORD OE110 02940CSR 72 MOVELCOMENT RECORD OE110 0002950CSR EXSR CLRSCR OE110 02960CSR EXSR GETSEC OE110 02970CSR EXSR OUTPUT OE110 02980CSRN73 GOTO BLOOP OE110 02990CSR Z-ADD0 Y LINES ONLY OE110 03000CSR Z-ADD0 YSAVE 20 OE110 03010CSR Z-ADD0 YLAST 20 OE110 0003020CSR Z-ADD1 LB 20 LOWER BOUND OE110 03030CSR Z-ADD18 UB 20 UPPER BOUND OE110 03040CSR BLOOP TAG OE110 03050CSR 73 EXSR GET2 OE110 03060CSR 74 EXSR BATCH OE110 03070CSR EXSR UPDATE OE110 03080CSR 67 EXSR CLRSCR OE110 0003090CSR 67 EXSR OUTPUT OE110 03100CSR 67 GOTO BLOOP OE110 03110CSR ENDSR OE110 03120C********************************************************************OE110 03130C* THIS SUBROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE110 03140C********************************************************************OE110 03150CSR GETSEC BEGSR OE110 0003160CSR SETOF 4041 OE110 03170CSR SECTN MULT SSIZE RRN 40 OE110 03180CSR Z-ADD1 X 20 OE110 03190CSR SCLOOP TAG OE110 03200CSR RRN ADD 1 RRN OE110 03210CSR RRN CHAINDISPR1 50 OE110 03220CSR 50 GOTO ENDGET OE110 0003230CSR FIELDN COMP B22 4141 OE110 03240CSRN41 CURPOS COMP ' ' 4141 OE110 03250CSRN41 GOTO ENDGET OE110 03260CSR MOVE FIELDN FN,X OE110 03270CSR MOVE CURPOS CP,X OE110 03280CSR MOVE LNGTHA LN,X OE110 03290CSR MOVE ENDPOS EP,X OE110 0003300CSR X ADD 1 X OE110 03310CSR X COMP SSIZE 32 OE110 03320CSRN32 GOTO SCLOOP OE110 03330CSR ENDGET TAG OE110 03340CSR Z-ADDX NOFLDS 20 OE110 03350CSR 73 Z-ADD7 NOFLDS OE110 03360CSR ENDSR OE110 0003370C********************************************************************OE110 03380C* THIS SUBROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE110 03390C* THAT OUTPUTS THEM. OE110 03400C********************************************************************OE110 03410CSR OUTPUT BEGSR OE110 03420CSR Z-ADD1 X OE110 03430CSR Z-ADD0 Y 20 OE110 0003440CSR OTLOOP TAG OE110 03450CSR EXSR OUTFLD OE110 03460CSR X ADD 1 X OE110 03470CSR X COMP NOFLDS 31 OE110 03480CSR 31 GOTO OTLOOP OE110 03490CSR ENDSR OE110 03500C********************************************************************OE110 0003510C* THIS SUBROUTINE OUTPUTS THE FIELD NAMES, FIELD INFORMATION, OE110 03520C* AND BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD OE110 03530C* LENGTH IS 0 THEN ONLY THE FIELD NAME IS OUTPUT. OE110 03540C* EACH TYPE OF SCREEN CALLS THE APPROPRIATE ROUTINE TO OE110 03550C* OUTPUT ITS FIELD INFORMATION. OE110 03560C********************************************************************OE110 03570CSR OUTFLD BEGSR OE110 0003580CSR MOVE FN,X FL 20 OE110 03590CSR MOVELCP,X FC 20 OE110 03600CSR FC COMP FL 31 OE110 03610CSR 31 Z-ADDFC FL OE110 03620CSR FC SUB FL CC 20 OE110 03630CSR CC ADD 1 CC OE110 03640CSR MOVELCP,X BUFFER OE110 0003650CSR 73 EXSR POSLIN OE110 03660CSR MOVELCC BUFFER OE110 03670CSR EXSR POSCUR OE110 03680CSR MOVELB72 BUFFER OE110 03690CSR MOVELFN,X FIELDN OE110 03700CSR MOVE ' ' FIELDN OE110 03710CSR MOVELFIELDN BUFFER OE110 0003720CSR Z-ADDLN,X LEN 20 OE110 03730CSR LEN COMP 0 3130 OE110 03740CSR 31 Z-SUBLN,X LEN OE110 03750CSR 30 GOTO SKIPF OE110 03760CSR EXSR LTBRKT OE110 03770CSR BPOS ADD 1 FPOS 20 OE110 03780CSR EXSR GET1 OE110 0003790CSR EXSR RTBRKT OE110 03800CSR SKIPF TAG OE110 03810CSR 30 Z-ADDFL BLNGTH OE110 03820CSRN30 FL ADD 3 BLNGTH OE110 03830CSRN30 BLNGTH ADD LEN BLNGTH OE110 03840CSR MOVE 'S' TYPE OE110 03850CSR EXSR CRTCOM OE110 0003860CSR ENDSR OE110 03870C********************************************************************OE110 03880C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE RECORD. OE110 03890C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE110 03900C* CHARACTERS WERE TYPED, THE CURSOR JUMPS TO THE BEGINNING OE110 03910C* OF THE PREVIOUS FIELD. IF THE 1ST CHARACTER IS AN '@' THEN OE110 03920C* THE REST OF THE FIELDS ARE LEFT UNCHANGED. OE110 0003930C********************************************************************OE110 03940CSR UPDATE BEGSR OE110 03950CSR SETOF 32 OE110 03960CSR Z-ADD1 X OE110 03970CSR Z-ADDYLAST Y OE110 03980CSR UPLOOP TAG OE110 03990CSR EXSR LNGTH OE110 0004000CSR 30N32 GOTO INCR OE110 04010CSR 30 GOTO CHKRUB OE110 04020CSR 73 EXSR XTYPE WHICH 'X' OE110 04030CSR 73 83N90 EXSR @TYPE OE110 04040CSR 73 83N90X ADD 1 X OE110 04050CSR 73 EXSR XTYPE OE110 04060CSR 73 84N90 OE110 0004070CANN32N96 Y ADD 1 Y GOTO NEXT LINE OE110 04080CSR 73 84 EXSR YOUT DISP LINE#,TYPEOE110 04090CSR 73 76N96 GOTO WL IF TYPEOE110 04100CAN 90 Z-ADD7 X BLANK & 90 ON OE110 04110CSR 73 76N96 GO BACK TO TYPEOE110 04120CANN90 Z-ADD8 X IF 90 OFF OE110 04130CSR 73 78N96 Z-ADD12 X GOTO COMMENT OE110 0004140C* IF TYPE IS C OE110 04150CSR SETOF 3233 OE110 04160CSR SETOF 767778 OE110 04170CSR EXSR XTYPE OE110 04180CSR EXSR ACCEPT OE110 04190CSR CHKRUB TAG OE110 04200CSR 32 73 83 NO RUBOUT ON OE110 0004210COR 32 73 84 WHAT LINE? OR OE110 04220CANN90 GOTO UPLOOP TYPE W/90 OFF OE110 04230CSR 32 73 88 Z-ADD9 X OE110 04240CSR 32 X SUB 1 X 31 OE110 04250CSR 32 31 GOTO UPLOOP OE110 04260CSR 32 GOTO ENDUPD OE110 04270CSR MOVELBUFFER ATSIGN 1 OE110 0004280CSR ATSIGN COMP '@' 35 OE110 04290CSR 35 73 83 GOTO ATSG1 @ IN WHAT LINE OE110 04300CSR 35 73 84 EXSR @TYPE @ IN TYPE OE110 04310CSR 35 74 NO @ TOTALS OE110 04320COR 35 73 GOTO UPLOOP NO @ LINE ITEMSOE110 04330CSR 35 GOTO ENDUPD OE110 04340CSR ATSG1 TAG OE110 0004350CSR 33 Z-ADD1 FPOS OE110 04360CSR 33 EXSR GET OE110 04370CSR EXSR EDIT OE110 04380CSR 65 Y=OK,NO BATCH OE110 04390COR 66 T=BATCH TOTALS OE110 04400COR 67 @=NEW LINES OE110 04410COR 68 R=GOTO COMMENTSOE110 0004420COR 69 N=CANCEL OE110 04430COR 40 GOTO ENDUPD E=END OF JOB OE110 04440CSR 96N94 GOTO UPLOOP OE110 04450CSR 33 GOTO INCR LINE FEED OE110 04460CSR EXSR PUT1 OE110 04470CSR EXSR OUTFLD OE110 04480CSR INCR TAG OE110 0004490CSR X ADD 1 X OE110 04500CSRN73 X COMP NOFLDS 30 OE110 04510CSR 73 87 Z-ADD13 X OE110 04520CSR 73 X COMP 13 30 OE110 04530CSR 73 30 Z-ADD7 X OE110 04540CSR 73 OE110 04550COR 30 GOTO UPLOOP OE110 0004560CSR ENDUPD ENDSR OE110 04570C* OE110 04580C********************************************************************OE110 04590C* THIS SUBROUTINE DISPLAYS THE LINE# (=Y) & BRACKETS FOR TYPE. OE110 04600C* USED BY SUBR UPDATE FOR LINE-ITEMS ONLY WHEN TYPE IS BEING OE110 04610C* PROCESSED (X=8). OE110 04620C********************************************************************OE110 0004630CSR YOUT BEGSR OE110 04640CSR MOVELLC,Y RECORD OE110 04650CSR MOVELRECORD DIG1 OE110 04660CSR DIG1 COMP ' ' 59 OE110 04670CSRN59 GOTO ENDY OE110 04680CSR EXSR POSLIN POSITION LINE OE110 04690CSR MOVEL'03' BUFFER OE110 0004700CSR EXSR POSCUR OE110 04710CSR MOVELY BUFFER DISPLAY LINE# OE110 04720CSR MOVE 'S' TYPE OE110 04730CSR Z-ADD2 BLNGTH OE110 04740CSR EXSR CRTCOM OE110 04750CSR EXSR OUTFLD OE110 04760CSR ENDY ENDSR OE110 0004770C********************************************************************OE110 04780C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE110 04790C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE110 04800C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC & OE110 04810C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE110 04820C* WAS USED TO TERMINATE THE OPERATION THEN THE OPERATION IS OE110 04830C* RETIRED IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE OE110 0004840C* INDICATOR 32 IS SETON. IF A LINE FEED WAS USED THEN THE OE110 04850C* ORIGINAL FIELD INFO IS OUTPUT TO THE SCREEN. A NORMAL OE110 04860C* TERMINATION CAUSES THE NEW INFO TO BE OUTPUT TO THE SCREEN. OE110 04870C********************************************************************OE110 04880CSR ACCEPT BEGSR OE110 04890CSR X COMP 1 30 OE110 04900CSRN30 X COMP SSIZE 30 OE110 0004910CSR 30 Z-ADD1 X OE110 04920CSR MOVELCP,X FC OE110 04930CSR FC ADD 3 FC OE110 04940CSR MOVELCP,X SAVPOS 4 OE110 04950CSR 73 EXSR POSLIN OE110 04960CSR MOVELFC SAVPOS OE110 04970CSR LN,X ADD FC OFC 20 OE110 0004980CSR OFC ADD 1 OFC OE110 04990CSR Z-ADDLN,X LEN OE110 05000CSR LEN COMP 0 34 OE110 05010CSR 34 Z-SUBLEN LEN OE110 05020CSR ACLOOP TAG OE110 05030CSR MOVELSAVPOS BUFFER OE110 05040CSR EXSR POSCUR OE110 0005050CSR Z-ADDLEN BLNGTH OE110 05060CSR MOVE B72 BUFFER OE110 05070CSR MOVE 'A' TYPE OE110 05080CSR EXSR CRTCOM OE110 05090CSR RCODE COMP 'R' 31 OE110 05100CSR 31 BUFFER COMP B72 32 OE110 05110CSR 31 32 GOTO ENDACC OE110 0005120CSR 31 GOTO ACLOOP OE110 05130CSR RCODE COMP 'L' 33 OE110 05140CSR 33 GOTO DUPIT OE110 05150CSRN34 GOTO ENDACC OE110 05160CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE110 05170CSR SIGN COMP '@' 30 OE110 05180CSR 30 GOTO ENDACC OE110 0005190CSR Z-ADDLEN VL 20 OE110 05200CSR MOVELBUFFER VAR 15 OE110 05210CSR EXSR RTADJ OE110 05220CSR MOVELVAR BUFFER OE110 05230CSR GOTO ENDACC OE110 05240CSR DUPIT TAG OE110 05250CSR EXSR OUTFLD OE110 0005260CSR ENDACC ENDSR OE110 05270C********************************************************************OE110 05280C* THIS SUBROUTINE MOVES A LEFT BRACKET INTO BUFFER AT BPOS. OE110 05290C********************************************************************OE110 05300CSR LTBRKT BEGSR OE110 05310CSR FL ADD 2 BPOS 20 OE110 05320CSR Z-ADD1 WHICH1 10 OE110 0005330CSRN84 EXIT SUBRIN OE110 05340CSR RLABL WHICH1 OE110 05350CSR RLABL BUFFER OE110 05360CSR RLABL RECORD OE110 05370CSR RLABL BPOS OE110 05380CSR RLABL FPOS OE110 05390CSR RLABL STRT OE110 0005400CSR RLABL LEN OE110 05410CSR ENDSR OE110 05420C********************************************************************OE110 05430C* THIS SUBROUTINE MOVES INFO FROM 'RECORD' INTO BUFFER. OE110 05440C* MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE110 05450C* FROM STRT IN RECORD TO FPOS IN BUFFER. OE110 05460C********************************************************************OE110 0005470CSR GET BEGSR OE110 05480CSR EP,X SUB LEN STRT 30 OE110 05490CSR STRT ADD 1 STRT OE110 05500CSR Z-ADD2 WHICH1 OE110 05510CSR EXIT SUBRIN OE110 05520CSR RLABL WHICH1 OE110 05530CSR RLABL BUFFER 72 OE110 0005540CSR RLABL RECORD OE110 05550CSR RLABL BPOS 20 OE110 05560CSR RLABL FPOS 20 OE110 05570CSR RLABL STRT 30 OE110 05580CSR RLABL LEN 20 OE110 05590CSR ENDSR OE110 05600C********************************************************************OE110 0005610C* THIS SUBROUTINE INSERTS A RIGHT BRACKET INTO BUFFER AT BPOS. OE110 05620C********************************************************************OE110 05630CSR RTBRKT BEGSR OE110 05640CSR LEN ADD FPOS FPOS OE110 05650CSR Z-ADD3 WHICH1 OE110 05660CSRN84 EXIT SUBRIN OE110 05670CSR RLABL WHICH1 OE110 0005680CSR RLABL BUFFER 72 OE110 05690CSR RLABL RECORD OE110 05700CSR RLABL BPOS 20 OE110 05710CSR RLABL FPOS 20 OE110 05720CSR RLABL STRT 30 OE110 05730CSR RLABL LEN 20 OE110 05740CSR ENDSR OE110 0005750C********************************************************************OE110 05760C* THIS SUBROUTINE MOVES LEN NUMBER OF CHARS FROM THE BEGINNING OE110 05770C* OF BUFFER TO THE STRT OF RECORD. OE110 05780C********************************************************************OE110 05790CSR PUT BEGSR OE110 05791CSR 94 Z-ADD20 LEN 05800CSR EP,X SUB LEN STRT OE110 0005810CSR STRT ADD 1 STRT OE110 05820CSR Z-ADD4 WHICH1 OE110 05830CSR EXIT SUBRIN OE110 05840CSR RLABL WHICH1 OE110 05850CSR RLABL BUFFER 72 OE110 05860CSR RLABL RECORD OE110 05870CSR RLABL BPOS 20 OE110 0005880CSR RLABL FPOS 20 OE110 05890CSR RLABL STRT 30 OE110 05900CSR RLABL LEN 20 OE110 05901CSR SETOF 94 05910CSR ENDSR OE110 05920C********************************************************************OE110 05930C* THIS SUBROUTINE RIGHT ADJUSTS FIELDS. OE110 0005940C********************************************************************OE110 05950CSR RTADJ BEGSR OE110 05960CSR EXIT SUBRAJ OE110 05970CSR RLABL VL OE110 05980CSR RLABL VAR OE110 05990CSR ENDSR OE110 06000C********************************************************************OE110 0006010C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. OE110 06020C********************************************************************OE110 06030CSR CRTCOM BEGSR OE110 06040CSR EXITFSUBRCM OE110 06050CSR RLABL BUFFER 72 OE110 06060CSR RLABL TYPE 1 OE110 06070CSR RLABL BLNGTH 20 OE110 0006080CSR RLABL RCODE 1 OE110 06090CSR RLABL MASK 10 OE110 06100CSR RLABL DTYPE 10 OE110 06110CSR ENDSR OE110 06120C********************************************************************OE110 06130C* THIS SUBROUTINE POSITIONS THE CURSOR. OE110 06140C********************************************************************OE110 0006150CSR POSCUR BEGSR OE110 06160CSR MOVE 'P' TYPE OE110 06170CSR EXSR CRTCOM OE110 06180CSR ENDSR OE110 06190C********************************************************************OE110 06200C* THIS SUBROUTINE CLEARS THE SCREEN. OE110 06210C********************************************************************OE110 0006220CSR CLRSCR BEGSR OE110 06230CSR MOVE 'C' TYPE OE110 06240CSR EXSR CRTCOM OE110 06250CSR ENDSR OE110 06260C********************************************************************OE110 06270C* THIS SUBROUTINE IS USED IN VARIOUS SUBROUTINES. OE110 06280C* IT TAKES THE VARIABLE LENGTH FROM THE ARRAYS AND MOVES IT OE110 0006290C* INTO AN RPG FIELD 'LEN'. IF 'LEN' IS NEGATIVE THE VARIABLE OE110 06300C* IS NUMERIC, NOT ALPHA. IF 'LEN' IS ZERO, THERE IS NO VARIABLE, OE110 06310C* ONLY A MESSAGE. OE110 06320C********************************************************************OE110 06330CSR LNGTH BEGSR OE110 06340CSR Z-ADDLN,X LEN OE110 06350CSR LEN COMP 0 3730 OE110 0006360CSR 37 Z-SUBLEN LEN OE110 06370CSR ENDSR OE110 06380C********************************************************************OE110 06390C* THIS SUBROUTINE SETS THINGS UP FOR THE SUBROUTINE 'GET'. OE110 06400C* IT MOVES INFORMATION INTO THE 'RECORD' SO IT CAN BE OE110 06410C* TRANSFERRED INTO THE BUFFER. OE110 06420C********************************************************************OE110 0006430CSR GET1 BEGSR OE110 06440CSR EXSR XTYPE OE110 06450CSR 73N83 MOVELLC,Y RECORD LINE-COMMENTS OE110 06460CSR EXSR GET OE110 06470CSR ENDSR OE110 06480C********************************************************************OE110 06490C* THIS SUBROUTINE DISPLAYS THE LINE ITEMS. OE110 0006500C********************************************************************OE110 06510CSR GET2 BEGSR OE110 06520CSR MOVE YSAVE YLAST OE110 06530CSR MOVE YSAVE Y OE110 06540CSR GLOOP TAG OE110 06550CSR Y ADD 1 Y OE110 06560CSR MOVELLC,Y RECORD OE110 0006570CSR MOVELRECORD DIG1 TYPE BLNK,L,C OE110 06580CSR DIG1 COMP ' ' 59 OE110 06590CSR 59 GOTO GL3 OE110 06600CSR Z-ADDY YLAST OE110 06610CSR Z-ADD8 X OE110 06620CSR EXSR POSLIN POSITION LINE OE110 06630CSR MOVEL'03' BUFFER OE110 0006640CSR EXSR POSCUR OE110 06650CSR MOVELY BUFFER DISPLAY LINE # OE110 06660CSR MOVE 'S' TYPE OE110 06670CSR Z-ADD2 BLNGTH OE110 06680CSR EXSR CRTCOM OE110 06690C* OE110 06700CSR EXSR OUTFLD OE110 0006710CSR DIG1 COMP 'L' 59 OE110 06720CSR 59 GOTO GL2 OE110 06730C* OE110 06740CSR Z-ADD12 X DISPLAY LINE OE110 06750CSR EXSR OUTFLD COMMENT OE110 06760CSR GOTO GL3 OE110 06770C* OE110 0006780CSR GL2 TAG OE110 06790CSR Z-ADD9 X DISPLAY PART#/ OE110 06800CSR EXSR OUTFLD DESC/PRICE OE110 06810CSR EXSR MVLINE OE110 06820CSR MOVELNOFLD BUFFER OE110 06830CSR EXSR XTYPE OE110 06840CSR EXSR EDIT OE110 0006850C* OE110 06860CSR Z-ADD10 X DISPLAY OE110 06870CSR EXSR OUTFLD QUANTITY OE110 06880C* OE110 06890C* OE110 06900CSR GL3 TAG OE110 06910CSR Y DIV 18 P CHECK TO SEE IFOE110 0006920CSR MVR Z AN ENTIRE OE110 06930CSR Z COMP 0 59 SCREEN HAS OE110 06940CSRN59 GOTO GLOOP BEEN OUTPUT OE110 06950CSR ENDSR OE110 06960C********************************************************************OE110 06970C* THIS SUBROUTINE USES 'PUT' SUBROUTINE. OE110 06980C* IT TAKES INFORMATION FROM THE BUFFER AND PUTS IT INTO THE OE110 0006990C* 'RECORD'. FROM THERE, DEPENDING ON THE SECTION, IT MOVES OE110 07000C* THE 'RECORD' INTO THE APPROPRIATE ARRAY ELEMENT. OE110 07010C********************************************************************OE110 07020CSR PUT1 BEGSR OE110 07030CSR EXSR PUT OE110 07040CSR 73N83 MOVELRECORD LC,Y LINE-COMMENTS OE110 07050CSR ENDSR OE110 0007060C********************************************************************OE110 07070C* THIS SUBROUTINE POSITIONS THE CURSOR TO THE PROPER LINE ON OE110 07080C* PAGE DURING LINE ITEMS, ETC. OE110 07090C********************************************************************OE110 07100CSR POSLIN BEGSR OE110 07110CSR X COMP 8 59 OE110 07120CSR 59 GOTO EPOS OE110 0007130CSR Y DIV 18 P 20 P=PAGE OE110 07140CSR MVR Z 40 Z=LINE # ON PGEOE110 07150CSR Z COMP 0 59 OE110 07160CSR Z ADD 2 Z OE110 07170CSR 59 Z ADD 18 Z OE110 07180CSR MOVELZ BUFFER OE110 07190CSR MOVE Z SAVPOS OE110 0007200CSR EPOS TAG OE110 07210CSR SETOF 59 OE110 07220CSR ENDSR OE110 07230C********************************************************************OE110 07240C* THIS SUBROUTINE IS USED FOR LINE ITEMS ONLY. OE110 07250C* IT SETS AN INDICATOR ON ACCORDING TO WHICH 'X' ELEMENT IS OE110 07260C* BEING PROCESSED. IT'S ONLY CONCERNED WITH 'X' ELEMENTS 7-12. OE110 0007270C********************************************************************OE110 07280CSR XTYPE BEGSR OE110 07290CSR X COMP 7 83 WHAT LINE ? OE110 07300CSR X COMP 8 84 TYPE OE110 07310CSR X COMP 9 85 PRODUCT # OE110 07320CSR X COMP 10 86 QUANTITY OE110 07330CSR X COMP 11 87 PRICE OVERRIDEOE110 0007340CSR X COMP 12 88 LINE COMMENT OE110 07350CSR ENDSR OE110 07360C********************************************************************OE110 07370C* THIS SUBROUTINE GOES TO 'WHAT LINE?' MODE IF TYPE = '@' OR OE110 07380C* IF AN ENTIRE SCREEN HAS BEEN OUTPUT (Y = MULTIPLE OF 18). OE110 07390C* **NOTE- IF YSAVE ALSO=MULT OF 18 WE SKIP OUT & DON'T GOTO 'WHAT OE110 07400C* LINE?' BECAUSE THIS MEANS WE JUST WENT FORWARD OR OE110 0007410C* BACKWARD TO A NEW LINE-ITEM SCREEN. OE110 07420C********************************************************************OE110 07430CSR @TYPE BEGSR OE110 07440CSR 84 GOTO @SIGN TYPE = @ OE110 07450CSR Y DIV 18 P CHECK IF WHOLE OE110 07460CSR MVR Z SCREEN DONE OE110 07470CSR Z COMP 0 59 OE110 0007480CSR 59 YSAVE COMP Y 5959 SKIP NEW SCREENOE110 07490CSRN59 GOTO END@ NO- KEEP GOING OE110 07500C************************ OE110 07510CSR @SIGN TAG NOW GOTO 'WHAT OE110 07520C************************ -LINE?' MODE OE110 07530CSR 35 73 84 MOVELB72 LC,Y OE110 07540CSR 35 73 84 MOVELB118 RECORD OE110 0007550CSR Z-ADD7 X OE110 07560CSR 90 GOTO SKIP90 OE110 07570CSR Z-ADD2 NCHARS MOVE Y INTO OE110 07580CSR Z-ADD1 SSTRT RECORD OE110 07590CSR Z-ADD120 TSTRT OE110 07600CSR MOVE Y AY 2 OE110 07610CSR EXIT SUBRMV OE110 0007620CSR RLABL AY OE110 07630CSR RLABL SSTRT 30 OE110 07640CSR RLABL RECORD OE110 07650CSR RLABL TSTRT 30 OE110 07660CSR RLABL NCHARS 30 OE110 07670CSR EXSR OUTFLD DISPLAY OE110 07680CSR SETON 90 OE110 0007690CSR SKIP90 TAG OE110 07700CSR SETOF 59 OE110 07710CSR END@ TAG OE110 07720CSR ENDSR OE110 07730C********************************************************************OE110 07740C* THIS SUBROUTINE BREAKS UP A 6-BYTE DATE IN THE FORM MMDDYY, OE110 07750C* WHICH HAS BEEN MOVED INTO DIG6N, INTO YEAR (@YR), MONTH (@MO), OE110 0007760C* DAY (@DA). OE110 07770C********************************************************************OE110 07780CSR DATE BEGSR OE110 07790CSR MOVE DIG6N @YR 20 OE110 07800CSR MOVELDIG6N @MO 20 OE110 07810CSR MOVE DIG6N @DAYR 40 OE110 07820CSR MOVEL@DAYR @DA 20 OE110 0007830CSR ENDT ENDSR OE110 07840C********************************************************************OE110 07850C* THIS SUBROUTINE EDITS A DATE FIELD. OE110 07860C* IT LOOKS UP MONTH IN A TABLE TO VALIDATE THE DAY. OE110 07870C********************************************************************OE110 07880CSR EDATE BEGSR OE110 07890CSR DIG6N COMP 0 59 OE110 0007900CSR 59 MOVE UDATE DIG6N OE110 07910CSR 59 MOVELUDATE SAVE OE110 07920CSR EXSR DATE OE110 07930CSR @MO COMP 0 96 OE110 07940CSRN96 @DA COMP 0 96 OE110 07950CSRN96 @YR COMP 0 96 OE110 07960CSRN96 @MO LOKUPTABD TABE 59 OE110 0007970CSRN96N59 SETON 96 OE110 07980CSRN96 59 @DA COMP TABE 96 OE110 07990CSR ENDTE ENDSR OE110 08000C********************************************************************OE110 08010C* THIS SUBROUTINE EDITS ANY FIELD SHOWN IN TABA. OE110 08020C* TABA CONTAINS SECTION AND X. OE110 08030C* TABB CONTAINS CURSOR POS, ERROR MESSAGE, & SUBR# FOR SUBRXS. OE110 0008040C********************************************************************OE110 08050CSR EDIT BEGSR OE110 08060CSR SETOF 9796 OE110 08070CSR SETOF 596061 OE110 08080CSR SETOF 626364 OE110 08090CSR SETOF 656667 OE110 08100CSR SETOF 6869 OE110 0008110CSR SETOF 767778 OE110 08120CSR MOVELSECTN XCNT 30 OE110 08130CSR MOVE X XCNT OE110 08140CSR XCNT LOKUPTABA TABB 97 OE110 08150CSRN97 GOTO EEDIT OE110 08160CSR MOVE BUFFER SAVE 72 OE110 08170CSR MOVE B26 WORD26 26 OE110 0008180C* OE110 08190CSR XCNT COMP 003 99 OE110 08200CSR 99 EXSR E003 OE110 08210CSR XCNT COMP 004 99 OE110 08220CSR 99 EXSR E004 OE110 08230CSR XCNT COMP 005 99 OE110 08240CSR 99 EXSR E005 OE110 0008250CSR XCNT COMP 006 99 OE110 08260CSR 99 EXSR E006 OE110 08270CSR XCNT COMP 007 99 OE110 08280CSR 99 EXSR E007 OE110 08290CSR XCNT COMP 008 99 OE110 08300CSR 99 EXSR E007 OE110 08310CSR XCNT COMP 015 99 OE110 0008320CSR 99 EXSR E015 OE110 08330CSR XCNT COMP 016 99 OE110 08340CSR 99 EXSR E016 OE110 08350CSR XCNT COMP 017 99 OE110 08360CSR 99 EXSR E017 OE110 08370CSR XCNT COMP 018 99 OE110 08380CSR 99 EXSR E018 OE110 0008390CSR XCNT COMP 019 99 OE110 08400CSR 99 EXSR E019 OE110 08410CSR XCNT COMP 020 99 OE110 08420CSR 99 EXSR E020 OE110 08430CSR XCNT COMP 021 99 OE110 08440CSR 99 EXSR E021 OE110 08450CSR XCNT COMP 103 99 OE110 0008460CSR 99 EXSR E006 OE110 08470CSR XCNT COMP 307 99 OE110 08480CSR 99 EXSR E307 OE110 08490CSR XCNT COMP 308 99 OE110 08500CSR 99 EXSR E308 OE110 08510CSR XCNT COMP 309 99 OE110 08520CSR 99 EXSR E309 OE110 0008530CSR XCNT COMP 311 99 OE110 08540CSR 99 EXSR E311 OE110 08550CSR XCNT COMP 411 99 OE110 08560CSR 99 EXSR E411 OE110 08570CSR EXSR ERMESS OE110 08580CSR EEDIT ENDSR OE110 08590C********* OE110 0008600C*** THIS SECTION DISPLAYS THE ERROR MESSAGE. OE110 08610C*** IT DISPLAYS BLANKS IF THE MESSAGE SHOUDN'T EXIST. OE110 08620C********* OE110 08630CSR ERMESS BEGSR OE110 08640CSRN97 GOTO ERDIT OE110 08650CSR 96 MOVE TABB WORD26 OE110 08660CSR 96 MOVE ' ' WORD26 OE110 0008670CSR MOVELTABB BUFFER OE110 08680CSR 73 EXSR POSLIN OE110 08690CSR 73 85 MOVEL'31' BUFFER PART # OE110 08700CSR EXSR POSCUR OE110 08710CSR MOVE 'S' TYPE OE110 08720CSRN85 MOVELWORD26 BUFFER OE110 08730CSRN85 Z-ADD26 BLNGTH OE110 0008740CSR 85 96 MOVELWORD26 STR35 OE110 08750CSR 85 MOVELSTR35 BUFFER OE110 08760CSR 85 Z-ADD27 BLNGTH OE110 08770CSR EXSR CRTCOM OE110 08780CSR 60 EXSR OVRIDE DISPLAY PRICE OE110 08790CSR MOVE SAVE BUFFER OE110 08800CSR ERDIT ENDSR OE110 0008810C********************************************************************OE110 08820C*** THIS SECTION EDITS END-OF-JOB. OE110 08830C*** E = END-OF-JOB OE110 08840C*** 2 = GOTO SHIP-TO SCREEN AFTER HEADER SCREEN OE110 08850C*** 3 = GOTO COMMENT SCREEN AFTER HEADER SCREEN OE110 08860C*** OTHER = GOTO LINE ITEM SCREEN AFTER HEADER SCREEN OE110 08870C********************************************************************OE110 0008880CSR E003 BEGSR OE110 08890CSR MOVELBUFFER DIG1 1 OE110 08900CSR DIG1 COMP 'E' 40 OE110 08910CSR DIG1 COMP '2' 42 OE110 08920CSR DIG1 COMP '3' 43 OE110 08930CSR SETOF 97 OE110 08940CSR ENDSR OE110 0008950C********************************************************************OE110 08960C*** THIS SECTION EDITS THE SALES ORDER #. OE110 08970C*** FIRST IT CHAINS TO OPNORDS FILE. IF IT ALREADY EXISTS ITSA OE110 08980C*** DUPLICATE AND THE USER MUST TRY ANOTHER NUMBER. IF IT'S OK, OE110 08990C*** THEN IT CHAINS TO SOTEMP(TODAYS ORDERS). IF IT ALREADY EXISTS OE110 09000C*** ON THAT FILE THE NUMBER IS REJECTED. OE110 09010C********************************************************************OE110 0009020CSR E004 BEGSR OE110 09030CSR MOVELBUFFER DIG5N 50 OE110 09040CSR MOVELBUFFER BLDKEY 8 OE110 09050CSR MOVEL'00' HOLD 3 OE110 09060CSR MOVE 'H' HOLD OE110 09070CSR MOVE HOLD BLDKEY OE110 09080CSR BLDKEY CHAINOPNORDS 59 # NOT FOUND OE110 0009090CSRN59 SETON 96 ERROR OE110 09100CSR 96 GOTO END004 OE110 09110CSR Z-ADD0 SO 50 OE110 09120CSR MOVELDIG5N SO OE110 09130CSR Z-ADD0 DIG7 70 OE110 09140CSR MOVELDIG5N DIG7 OE110 09150CSR DIG7 CHAINSOTEMP 59 OE110 0009160CSRN59 SETON 96 ERROR OE110 09170CSR END004 ENDSR OE110 09180C********************************************************************OE110 09190C*** THIS SECTION EDITS THE ORDER TYPE. OE110 09200C*** IT'S AN ALPHA FIELD THAT'S VALID FOR : OE110 09210C*** BLANK = SALES ORDER OE110 09220C*** E = DIRECT BILL OE110 0009230C*** C = CREDIT MEMO OE110 09240C*** M = MANUAL INVOICE OE110 09250C********************************************************************OE110 09260CSR E005 BEGSR OE110 09270CSR MOVELBUFFER OTYPE 1 OE110 09280CSR SETOF 202122 OE110 09290CSR SETOF 23 OE110 0009300CSR OTYPE COMP ' ' 969620 OE110 09310CSR 96 OTYPE COMP 'C' 969621 OE110 09320CSR 96 OTYPE COMP 'D' 969622 OE110 09322CSR 22 MOVE 'E' OTYPE OE110 09330CSR 96 OTYPE COMP 'M' 969623 OE110 09340CSR ENDSR OE110 09350C********************************************************************OE110 0009360C*** THIS SECTION EDITS THE CUSTOMER NUMBER. OE110 09370C*** IT CHAINS TO ARMAST TO SEE IF THE NUMBER ALREADY EXISTS. OE110 09380C*** IF IT EXISTS, IT'S VALID AND THE SOLD-TO LINES SHOULD OE110 09390C*** BE DISPLAYED. THIS SAME SECTION WILL BE USED TO EDIT THE OE110 09400C*** SHIP-TO CUSTOMER. OE110 09410C********************************************************************OE110 09420CSR E006 BEGSR OE110 0009430CSR MOVELBUFFER DIG5N OE110 09440CSR 71 DIG5N COMP 99999 9696 OE110 09450CSR 71N96 GOTO END006 OE110 09460CSR Z-ADDDIG5N DIG6N 60 OE110 09470CSR DIG6N CHAINARMAST 96 NOT FOUND OE110 09480CSRN96 DCODE COMP ' ' 9696 OE110 09490CSR 96 GOTO END006 OE110 0009500CSR 70 MOVE PC SPC SAVE PRICE COD OE110 09510CSR MOVEL'2605' BUFFER DISPLAY N/A OE110 09520CSR EXSR POSCUR LINE 1 OE110 09530CSR MOVE 'S' TYPE OE110 09540CSR MOVELNAME BUFFER OE110 09550CSR Z-ADD24 BLNGTH OE110 09560CSR EXSR CRTCOM OE110 0009570CSR 70 GOTO SKNAME OE110 09580CSR Z-ADD24 NCHARS 30 OE110 09590CSR Z-ADD1 SSTRT 30 OE110 09600CSR Z-ADD14 TSTRT 30 OE110 09610CSR EXIT SUBRMV OE110 09620CSR RLABL NAME SOURCE OE110 09630CSR RLABL SSTRT 30 OE110 0009640CSR RLABL RECORD TARGET OE110 09650CSR RLABL TSTRT 30 OE110 09660CSR RLABL NCHARS 30 OE110 09670C* OE110 09680C* OE110 09690CSR SKNAME TAG OE110 09700CSR MOVEL'2606' BUFFER DISPLAY OE110 0009710CSR EXSR POSCUR ADDRESS 1 OE110 09720CSR MOVE 'S' TYPE OE110 09730CSR MOVELADR1 BUFFER OE110 09740CSR EXSR CRTCOM OE110 09750CSR 70 GOTO SKADR1 OE110 09760CSR Z-ADD38 TSTRT OE110 09770CSR EXIT SUBRMV OE110 0009780CSR RLABL ADR1 SOURCE OE110 09790CSR RLABL SSTRT 30 OE110 09800CSR RLABL RECORD TARGET OE110 09810CSR RLABL TSTRT 30 OE110 09820CSR RLABL NCHARS 30 OE110 09830C* OE110 09840CSR SKADR1 TAG OE110 0009850CSR MOVEL'2607' BUFFER DISPLAY OE110 09860CSR EXSR POSCUR ADDRESS 2 OE110 09870CSR MOVE 'S' TYPE OE110 09880CSR MOVELADR2 BUFFER OE110 09890CSR EXSR CRTCOM OE110 09900CSR 70 GOTO SKADR2 OE110 09910CSR Z-ADD62 TSTRT OE110 0009920CSR EXIT SUBRMV OE110 09930CSR RLABL ADR2 SOURCE OE110 09940CSR RLABL SSTRT 30 OE110 09950CSR RLABL RECORD TARGET OE110 09960CSR RLABL TSTRT 30 OE110 09970CSR RLABL NCHARS 30 OE110 09980C* OE110 0009990CSR SKADR2 TAG OE110 10000CSR MOVEL'2608' BUFFER DISPLAY OE110 10010CSR EXSR POSCUR CITY OE110 10020CSR MOVE 'S' TYPE OE110 10030CSR MOVELCITY BUFFER OE110 10040CSR Z-ADD13 BLNGTH OE110 10050CSR EXSR CRTCOM OE110 0010060CSR 70 GOTO SKCITY OE110 10070CSR Z-ADD13 NCHARS OE110 10080CSR Z-ADD86 TSTRT OE110 10090CSR EXIT SUBRMV OE110 10100CSR RLABL CITY SOURCE OE110 10110CSR RLABL SSTRT 30 OE110 10120CSR RLABL RECORD TARGET OE110 0010130CSR RLABL TSTRT 30 OE110 10140CSR RLABL NCHARS 30 OE110 10150C* OE110 10160CSR SKCITY TAG OE110 10170CSR MOVEL'4308' BUFFER OE110 10180CSR EXSR POSCUR OE110 10190CSR MOVE 'S' TYPE OE110 0010200CSR MOVELSTCODE BUFFER OE110 10210CSR Z-ADD2 BLNGTH OE110 10220CSR EXSR CRTCOM OE110 10230CSR 70 GOTO SKCODE OE110 10240CSR Z-ADD2 NCHARS OE110 10250CSR Z-ADD99 TSTRT OE110 10260CSR EXIT SUBRMV OE110 0010270CSR RLABL STCODE SOURCE OE110 10280CSR RLABL SSTRT 30 OE110 10290CSR RLABL RECORD TARGET OE110 10300CSR RLABL TSTRT 30 OE110 10310CSR RLABL NCHARS 30 OE110 10320C* OE110 10330CSR SKCODE TAG OE110 0010340CSR MOVEL'4908' BUFFER OE110 10350CSR EXSR POSCUR OE110 10360CSR MOVE 'S' TYPE OE110 10370CSR MOVELZIP BUFFER OE110 10380CSR Z-ADD5 BLNGTH OE110 10390CSR EXSR CRTCOM OE110 10400CSR 70 GOTO SKZIP OE110 0010410CSR Z-ADD5 NCHARS OE110 10420CSR Z-ADD101 TSTRT OE110 10430CSR EXIT SUBRMV OE110 10440CSR RLABL AZIP OE110 10450CSR RLABL SSTRT 30 OE110 10460CSR RLABL RECORD TARGET OE110 10470CSR RLABL TSTRT 30 OE110 0010480CSR RLABL NCHARS 30 OE110 10490C* OE110 10500CSR SKZIP TAG OE110 10510CSR END006 ENDSR OE110 10520C********************************************************************OE110 10530C*** THIS SECTION EDITS A DATE FIELD. OE110 10540C*** IF ZERO IS ENTERED, PROGRAM DEFAULTS TO UDATE. OE110 0010550C********************************************************************OE110 10560CSR E007 BEGSR OE110 10570CSR MOVELBUFFER DIG6N OE110 10580CSR EXSR EDATE OE110 10590CSR ENDSR OE110 10600C********************************************************************OE110 10610C*** THIS SECTION EDITS THE PAYMENT TERMS OVERRIDE. OE110 0010620C********************************************************************OE110 10630CSR E015 BEGSR OE110 10640CSR MOVELBUFFER DIG1 OE110 10650CSR DIG1 COMP ' ' 9696 OE110 10660CSRN96 GOTO END015 OE110 10670CSR DIG1 CHAINTERMS 96 OE110 10680CSRN96 DLTTRM COMP ' ' 9696 OE110 0010690CSRN96 MOVELTNAME WORD26 OE110 10700CSR END015 ENDSR OE110 10710C********************************************************************OE110 10720C*** THIS SECTION EDITS THE PRICE CODE OVERRIDE. OE110 10730C*** IT'S A NUMERIC FIELD THAT'S VALID FOR 0-5. OE110 10740C*** 0 IMPLIES THERE IS NO OVERRIDE. OE110 10750C********************************************************************OE110 0010760CSR E016 BEGSR OE110 10770CSR MOVELBUFFER DIG1N 10 OE110 10780CSR DIG1N COMP 0 96 OE110 10790CSRN96 DIG1N COMP 5 96 OE110 10800CSRN96 MOVE DIG1N OPC OVRD PRICE COD OE110 10810CSR ENDSR OE110 10820C********************************************************************OE110 0010830C*** THIS SECTION EDITS THE TAX CODE OVERRIDE. OE110 10840C*** IT'S AN ALPHA FIELD THAT'S VALID FOR BLANK, C, O, N. OE110 10850C********************************************************************OE110 10860CSR E017 BEGSR OE110 10870CSR MOVELBUFFER DIG1 OE110 10880CSR DIG1 COMP ' ' 9696 OE110 10890CSR 96 DIG1 COMP 'C' 9696 OE110 0010900CSR 96 DIG1 COMP 'O' 9696 OE110 10910CSR 96 DIG1 COMP 'N' 9696 OE110 10920CSR ENDSR OE110 10930C********************************************************************OE110 10940C*** THIS SECTION EDITS THE SALESMAN #. OE110 10950C********************************************************************OE110 10960CSR E018 BEGSR OE110 0010970CSR MOVELBUFFER DIG3N 30 OE110 10980CSR DIG3N COMP 0 9696 OE110 10990CSRN96 GOTO END018 OE110 11000CSR DIG3N CHAINSLSMAN 96 OE110 11010CSRN96 DLTSMN COMP ' ' 9696 OE110 11020CSRN96 MOVELSNAME WORD26 OE110 11030CSR END018 ENDSR OE110 0011040C********************************************************************OE110 11050C*** THIS SECTION EDITS THE AREA. OE110 11060C********************************************************************OE110 11070CSR E019 BEGSR OE110 11080CSR MOVELBUFFER DIG2 2 OE110 11090CSR DIG2 COMP ' ' 9696 OE110 11100CSRN96 GOTO END019 OE110 0011110CSR DIG2 CHAINAREA 96 OE110 11120CSRN96 DLTARA COMP ' ' 9696 OE110 11130CSRN96 MOVELANAME WORD26 OE110 11140CSR END019 ENDSR OE110 11150C********************************************************************OE110 11160C*** THIS SECTION RETAINS THE BATCH QUANTITY. OE110 11170C********************************************************************OE110 0011180CSR E020 BEGSR OE110 11190CSR MOVELBUFFER BQTY 70 OE110 11200CSR SETOF 97 OE110 11210CSR ENDSR OE110 11220C********************************************************************OE110 11230C*** THIS SECTION RETAINS THE BATCH PRICE OVERRIDE. OE110 11240C********************************************************************OE110 0011250CSR E021 BEGSR OE110 11260CSR MOVELBUFFER BPR 73 OE110 11270CSR SETOF 97 OE110 11280CSR ENDSR OE110 11290C********************************************************************OE110 11300C*** THIS SECTION EDITS THE 'WHAT LINE ?' FIELD. OE110 11310C*** 'Y' REPRESENTS THE ARRAY ELEMENT (WHAT LINE ?). OE110 0011320C*** VALID ENTRIES ARE : OE110 11330C*** R = RUBOUT - GO BACK A SCREEN OE110 11340C*** @ = GO FORWARD A SCREEN OE110 11350C*** T = GO TO BATCH TOTALS SECTION OE110 11360C*** ZERO = INCREMENT THE Y ELEMENT BY ONE OE110 11370C*** # = MUST BE WITHIN INTERVAL SHOWN ON THE SCREEN. OE110 11380C*** Y = SKIP BATCH TOTAL SECTION - OUTPUT RECORDS OE110 0011390C*** N = SKIP BATCH TOTAL SECTION - DON'T OUTPUT RECORDS OE110 11400C********************************************************************OE110 11410CSR E307 BEGSR OE110 11420CSR MOVELBUFFER DIG2 OE110 11430CSR DIG2 COMP '@ ' 67 OE110 11440CSRN67 GOTO SKIPE OE110 11450CSR UB COMP UPPER 68 68 OE110 0011460CSRN68 LB ADD 18 LB OE110 11470CSRN68 UB ADD 18 UB OE110 11480CSRN68 YSAVE ADD 18 YSAVE OE110 11490CSR SETOF 6890 OE110 11500CSR GOTO END307 OE110 11510C* OE110 11520CSR SKIPE TAG OE110 0011530CSR DIG2 COMP 'R ' 59 OE110 11540CSRN59 GOTO SKIPX OE110 11550CSR UB COMP 18 676768 OE110 11560CSR 67 LB SUB 18 LB OE110 11570CSR 67 UB SUB 18 UB OE110 11580CSR 67 YSAVE SUB 18 YSAVE OE110 11590CSR SETOF 90 OE110 0011600CSR GOTO END307 OE110 11610C* OE110 11620CSR SKIPX TAG OE110 11630CSR DIG2 COMP 'T ' 66 OE110 11640CSR 66 GOTO END307 OE110 11650CSR DIG2 COMP 'Y ' 65 OE110 11660CSR 65 GOTO END307 OE110 0011670CSR DIG2 COMP 'N ' 69 OE110 11680CSR 69 GOTO END307 OE110 11690C* OE110 11700CSR DIG2 COMP ' ' 9696 OE110 11710CSRN96 GOTO SKIPG OE110 11720CSR DIG2 COMP '00' 96 OE110 11730CSRN96 DIG2 COMP UPPERA 96 OE110 0011740CSR 96 GOTO END307 OE110 11750C* OE110 11760CSR SKIPG TAG OE110 11770CSR Z-ADDY S 20 SAVE Y OE110 11780CSR MOVELBUFFER Y OE110 11790CSR Y COMP 0 59 OE110 11800CSR 59N33 S ADD 1 Y OE110 0011810CSR 59 33 Z-ADDS Y OE110 11820CSR Y COMP LB 96 OE110 11830CSRN96 Y COMP UB 96 OE110 11840CSRN96 MOVELY SAVE OE110 11850CSRN96 MOVELLC,Y RECORD OE110 11860CSR END307 ENDSR OE110 11870C********************************************************************OE110 0011880C*** THIS SECTION EDITS THE TYPE ON LINE ITEM SCREENS. OE110 11890C*** VALID ENTRIES ARE : OE110 11900C*** BLANK = TO OMIT THE LINE OE110 11910C*** L = LINE ITEM OE110 11920C*** C = COMMENT TO LINE ITEM OE110 11930C*** A USER IS NOT ALLOWED TO GO FROM ONE TYPE TO ANOTHER. OE110 11940C********************************************************************OE110 0011950CSR E308 BEGSR OE110 11960CSR SETOF 97 OE110 11970CSR MOVELBUFFER DIG1 OE110 11980CSR SETOF 767778 OE110 11990CSR DIG1 COMP ' ' 969676 OE110 12000CSR 96 DIG1 COMP 'L' 969677 OE110 12010CSR 96 DIG1 COMP 'C' 969678 OE110 0012020CSR 96 GOTO END308 OE110 12030C* OE110 12040CSR MOVELLC,Y LCFLD 1 OE110 12050CSR 77 LCFLD COMP 'C' 96 OE110 12060CSR 78 LCFLD COMP 'L' 96 OE110 12070CSR 96 GOTO END308 OE110 12080C* OE110 0012090CSR LCFLD COMP ' ' 59 OE110 12100CSR 59 77 Z-ADD2 M 10 OE110 12110CSR 59 78 Z-ADD3 M OE110 12120CSR 76 Z-ADD4 M OE110 12130CSR 76 SETON 59 OE110 12140CSRN59 GOTO END308 OE110 12150CSR MOVELZ BUFFER OE110 0012160CSR 77 MOVEL'09' BUFFER 12170CSRN77 MOVEL'12' BUFFER OE110 12180CSR EXSR POSCUR OE110 12190CSR MOVE 'S' TYPE OE110 12200CSR MOVELMS,M BUFFER OE110 12210CSR Z-ADD71 BLNGTH OE110 12220CSR EXSR CRTCOM OE110 0012230CSR MOVELB39 RECORD OE110 12240CSR MOVE ' ' POV,Y OE110 12250CSR MOVELSAVE BUFFER OE110 12260CSR END308 ENDSR OE110 12270C********************************************************************OE110 12280C*** THIS SECTION EDITS THE PART # BY CHAINING TO PARTMST. OE110 12290C*** IF IT EXISTS THE DESCRIPTION IS DISPLAYED. OE110 0012300C*** IF IT DOESN'T EXIST AN ERROR MESSAGE DISPLAYS AND THE OE110 12310C*** USER MUST TRY AGAIN. OE110 12320C********************************************************************OE110 12330CSR E309 BEGSR OE110 12331CSR SETOF 94 12340CSR MOVE B72 WRK9 OE110 12350CSR MOVELBUFFER DIG12 20 OE110 0012360CSR DIG12 CHAINPARTMST 96 NOT FOUND OE110 12370CSRN96 DPCODE COMP ' ' 9696 OE110 12380CSRN96 SETON 60 OE110 12390CSRN96 MOVELDESC WORD16 16 OE110 12391CSR 96 MOVE ' ' BIN 12392CSR 96 SETON 94 12393CSR 94 EXCPT 0012400CSR MOVELBIN BUFFER OE110 12410CSR Z-ADD5 LEN OE110 12420CSR Z-ADD114 STRT OE110 12430CSR Z-ADD4 WHICH1 OE110 12440CSR EXIT SUBRIN OE110 12450CSR RLABL WHICH1 OE110 12460CSR RLABL BUFFER OE110 0012470CSR RLABL RECORD OE110 12480CSR RLABL BPOS 20 OE110 12490CSR RLABL FPOS 20 OE110 12500CSR RLABL STRT 30 OE110 12510CSR RLABL LEN 20 OE110 12520CSRN96 SOH SUB SALLOC NEWSOH 70 89 OE110 12530CSRN96 MOVELWORD16 STR35 27 OE110 0012540CSRN96 Z-ADD8 EPOS OE110 12550CSRN96 MOVE 'L' ECODE OE110 12560CSRN96 EXIT SUBRED OE110 12570CSR RLABL NEWSOH OE110 12580CSR RLABL ECODE OE110 12590CSR RLABL WRK9 8 OE110 12600CSR RLABL EPOS OE110 0012610CSR RLABL EWORD OE110 12620CSRN96 MOVE WRK9 STR35 OE110 12630CSR 96 MOVELB72 STR35 OE110 12640CSR ENDSR OE110 12650C********************************************************************OE110 12660C*** THIS SECTION EDITS THE PRICE OVERRIDE. IF ZERO IS ENTERED, IT OE110 12670C*** IS TREATED AS A LINE FEED- THAT IS, WE REDISPLAY THE PREVIOUS OE110 0012680C*** PRICE STORED IN LC (WHETHER IT'S THE FILE PRICE OR OVERRIDE). OE110 12690C*** IF NON-0 IT'S HANDLED NORMALLY & WE PUT A '1' IN POV TO OE110 12700C*** INDICATE THIS ELEMENT HAS AN OVERRIDE (ONLY OVERRIDE PRICES OE110 12710C*** ARE OUTPUT TO FILES). THE ONLY WAY TO RETRIEVE A FILE PRICE OE110 12720C*** ONCE AN OVERRIDE WAS ENTERED IS TO BLANK THE LINE & RE-ENTER. OE110 12730C********************************************************************OE110 12740CSR E311 BEGSR OE110 0012750CSR SETOF 97 OE110 12760CSR 33 GOTO END311 LINE-FEED:SKIP OE110 12770CSR MOVELBUFFER PRICE 73 OE110 12780CSR PRICE COMP 0 59 OE110 12790CSRN59 MOVE '1' POV,Y OVERRIDE WAS OE110 12800CSRN59 GOTO END311 ENTERED OE110 12810CSR MOVE LC,Y WORK12 12 OE110 0012820CSR MOVELWORK12 PRICE OE110 12830CSR MOVELPRICE SAVE OE110 12840CSR MOVE SAVE BUFFER OE110 12850CSR END311 ENDSR OE110 12860C********************************************************************OE110 12870C*** THIS SECTION EDITS THE OK ? FIELD. OE110 12880C*** VALID ENTRIES ARE : OE110 0012890C*** Y = YES - OK TO OUTPUT RECORDS OE110 12900C*** N = NO - DON'T OUTPUT RECORDS OE110 12910C*** R = RETRY - GO BACK A SCREEN OE110 12920C********************************************************************OE110 12930CSR E411 BEGSR OE110 12940CSR MOVELBUFFER DIG1 OE110 12950CSR DIG1 COMP 'Y' 9696 OE110 0012960CSR 96 DIG1 COMP 'N' 969669 OE110 12970CSR 96 DIG1 COMP 'R' 969664 OE110 12980CSR SETOF 90 OE110 12990CSR ENDSR OE110 13000C********************************************************************OE110 13010C* THIS SUBROUTINE PERFORMS BATCH BALANCING. OE110 13020C* IF THE TYPE IS 'L' IT BRINGS OUT THE ARRAY ELEMENTS INTO OE110 0013030C* RPG FIELD NAMES. THIS ROUTINE ADDS THE QUANTITIES OE110 13040C* AND PRICE OVERRIDES TO TOTAL FIELDS. IT COMPARES ACTUAL OE110 13050C* TOTALS TO BATCH TOTALS. IF THEY DISAGREE, A MESSAGE IS OUTPUT OE110 13060C* TO NOTIFY THE USER THAT BATCHES ARE OUT OF BALANCE. OE110 13070C********************************************************************OE110 13080CSR BATCH BEGSR OE110 13090CSR Z-ADD0 TOTQT 70 OE110 0013100CSR Z-ADD0 TOTPR 73 OE110 13110CSR Z-ADD0 Y OE110 13120C* OE110 13130C*** THIS SECTION LOOPS THROUGH THE ARRAYS AND SUMS THE ELEMENTS. OE110 13140C* OE110 13150CSR LOOPA TAG OE110 13160CSR Y ADD 1 Y OE110 0013170CSR Y COMP UPPER 59 OE110 13180CSR 59 GOTO LOOPB OE110 13190CSR MOVELLC,Y LCFLD OE110 13200CSR LCFLD COMP ' ' 59 BLANK OE110 13210CSR 59 GOTO LOOPA OE110 13220CSR LCFLD COMP 'C' 59 COMMENT OE110 13230CSR 59 GOTO LOOPA OE110 0013240CSR EXSR MVLINE OE110 13250CSR TOTQT ADD QTFLD TOTQT OE110 13260CSR POV,Y COMP ' ' 59 NO OVERRIDE OE110 13270CSR 59 GOTO LOOPA OE110 13280CSR TOTPR ADD PRFLD TOTPR OE110 13290CSR GOTO LOOPA OE110 13300C* OE110 0013310C*** THIS SECTION COMPARES THE ACTUAL TOTALS TO THE BATCH TOTALS. OE110 13320C* OE110 13330CSR LOOPB TAG OE110 13340CSR BQTY SUB TOTQT DIFQT 70 QTY DIFFERENCE OE110 13350CSR BPR SUB TOTPR DIFPR 73 PRICE DIFF OE110 13360C* OE110 13370C*** THIS SECTION DISPLAYS THE TOTALS. OE110 0013380C* OE110 13390CSR MOVE 2004 DIG4N 40 DISPLAYS OE110 13400CSR MOVE BQTY DIG7N 70 BATCH QUANTITYOE110 13410CSR EXSR DISPLY OE110 13420C* OE110 13430CSR MOVE 2006 DIG4N DISPLAYS OE110 13440CSR MOVE TOTQT DIG7N ACTUAL QUANITYOE110 0013450CSR EXSR DISPLY OE110 13460C* OE110 13470CSR MOVE 2008 DIG4N DISPLAYS DIFF OE110 13480CSR MOVE DIFQT DIG7N IN QUANTITIES OE110 13490CSR EXSR DISPLY OE110 13500C* OE110 13510CSR MOVE 5804 DIG4N DISPLAYS BATCH OE110 0013520CSR MOVE BPR DIG7N PRICE OVERRIDEOE110 13530CSR EXSR DISPLY OE110 13540C* OE110 13550CSR MOVE 5806 DIG4N DISPLAYS ACTUALOE110 13560CSR MOVE TOTPR DIG7N PRICE OVERRIDEOE110 13570CSR EXSR DISPLY OE110 13580C* OE110 0013590CSR MOVE 5808 DIG4N OE110 13600CSR MOVE DIFPR DIG7N OE110 13610CSR EXSR DISPLY OE110 13620C* OE110 13630C*** THIS SECTION FINDS OUT IF THERE WAS A BATCH BALANCE ERROR. OE110 13640C*** AN ERROR CAUSES A MESSAGE TO BE OUTPUT. OE110 13650C* OE110 0013660CSR DIFQT COMP 0 5858 BATCH OUT OF OE110 13670CSRN58 DIFPR COMP 0 5858 BALANCE-59 ON OE110 13680CSR 58 Z-ADD1 M OE110 13690CSRN58 Z-ADD4 M OE110 13700CSR MOVEL'1311' BUFFER OE110 13710CSR EXSR POSCUR OE110 13720CSR MOVE 'S' TYPE OE110 0013730CSR MOVELMS,M BUFFER OE110 13740CSR Z-ADD25 BLNGTH OE110 13750CSR EXSR CRTCOM OE110 13760CSR ENDSR OE110 13770C********************************************************************OE110 13780C* THIS SUBROUTINE TAKES INFORMATION FOR LINE ITEMS OUT OF OE110 13790C* THE ARRAY LC AND PUTS THEM INTO FIELD NAMES. OE110 0013800C* PRODUCT # LOCATION 3-14 OE110 13810C* QUANTITY LOCATION 16-22 OE110 13820C* PRICE OVERRIDE LOCATION 33-39 OE110 13830C********************************************************************OE110 13840CSR MVLINE BEGSR OE110 13850CSR MOVE LC,Y WORD44 64 OE110 13860CSR Z-ADD20 NCHARS OE110 0013870CSR Z-ADD3 SSTRT OE110 13880CSR Z-ADD1 TSTRT OE110 13890CSR EXIT SUBRMV TRANSFER OE110 13900CSR RLABL WORD44 PRODUCT # OE110 13910CSR RLABL SSTRT 30 OE110 13920CSR RLABL NOFLD 20 OE110 13930CSR RLABL TSTRT 30 OE110 0013940CSR RLABL NCHARS 30 OE110 13950C* OE110 13960CSR Z-ADD7 NCHARS OE110 13970CSR Z-ADD23 SSTRT OE110 13980CSR EXIT SUBRMV TRANSFER OE110 13990CSR RLABL WORD44 QUANTITY OE110 14000CSR RLABL SSTRT 30 OE110 0014010CSR RLABL WORD7 7 OE110 14020CSR RLABL TSTRT 30 OE110 14030CSR RLABL NCHARS 30 OE110 14040CSR MOVE WORD7 QTFLD 70 OE110 14050C* OE110 14060CSR MOVELWORD44 WORD39 39 OE110 14070CSR MOVE WORD39 PRFLD 73 TRANSFER OE110 0014080C* PRICE OVERRIDEOE110 14090CSR ENDSR OE110 14100C********************************************************************OE110 14110C* THIS SUBROUTINE PICKS UP UNIT PRICES FROM PARTMST, DOES 'PUT' OE110 14120C* TO STORE THEM IN RECORD & LC, AND DOES 'OUTFLD' TO DISPLAY. OE110 14130C* IT USES THE POV ARRAY TO KEEP TRACK OF WHETHER THE PRICE IN LC OE110 14140C* IS AN OVERRIDE OR A FILE PRICE (BLANK=FILE,1=OVERRIDE) BECAUSE OE110 0014150C* ONLY OVERRIDE PRICES WILL BE OUTPUT TO ORDINP. OE110 14160C* X MUST BE RESTORED TO 9 (FOR PART#) AT END OF SUBROUTINE. OE110 14170C********************************************************************OE110 14180CSR OVRIDE BEGSR OE110 14190CSR Z-ADD11 X OE110 14200CSR POV,Y COMP '1' 59 OE110 14210CSR 59 GOTO DPRICE ALREADY IN LC OE110 0014220CSR OPC COMP 0 5959 USE OVRD PC OE110 14230CSR 59 Z-ADDOPC SPC OE110 14240CSR SPC COMP 1 59 59 OE110 14250CSR 59 SPC COMP 5 5959 OE110 14260CSR Z-ADD0 PRICE DEFAULT = 0 OE110 14270CSR 59 Z-ADDPB,SPC PRICE OE110 14280CSR MOVELPRICE BUFFER PUT PRICE IN OE110 0014290CSR EXSR LNGTH RECORD & LC,Y OE110 14300CSR EXSR PUT1 OE110 14310CSR DPRICE TAG DISPLAY PRICE OE110 14320CSR EXSR OUTFLD OE110 14330CSR Z-ADD9 X RESTORE X TO OE110 14340CSR EXSR XTYPE PART# OE110 14350CSR EXSR LNGTH OE110 0014360CSR ENDSR OE110 14370C********************************************************************OE110 14380C* THIS SUBROUTINE POSITIONS THE CURSOR AND DISPLAYS THE OE110 14390C* FIELD. USED IN SUBROUTINE BATCH. OE110 14400C********************************************************************OE110 14410CSR DISPLY BEGSR OE110 14420CSR MOVELDIG4N BUFFER POSITION OE110 0014430CSR EXSR POSCUR CURSOR OE110 14440CSR Z-ADD8 DIG4N OE110 14450CSR Z-ADDDIG4N EPOS OE110 14460CSR MOVE 'L' ECODE OE110 14470CSR MOVELB72 BUFFER OE110 14480CSR EXIT SUBRED OE110 14490CSR RLABL DIG7N FIELD FOR EDIT OE110 0014500CSR RLABL ECODE 1 OE110 14510CSR RLABL EDTWRD 8 OE110 14520CSR RLABL EPOS 20 OE110 14530CSR RLABL EWORD 24 OE110 14540C* OE110 14550CSR MOVELEDTWRD BUFFER OE110 14560CSR MOVE 'S' TYPE OE110 0014570CSR Z-ADD8 BLNGTH OE110 14580CSR EXSR CRTCOM OE110 14590CSR ENDSR OE110 14600C********************************************************************OE110 14610C* THIS SUBROUTINE OUTPUTS ALL THE INFORMATION FOR OE110 14620C* THE SALES ORDER. OE110 14630C* IF THE ORDER TYPE IS BLANK, RECORDS ARE OUTPUT TO ORDINP. OE110 0014640C* IF THE ORDER TYPE IS E,C, OR M, RECORDS ARE OUTPUT OE110 14650C* OE110 14660C* ONLY THE SALES ORDER # & A CODE FOR BATCHES BEING OUT OF OE110 14670C* BALANCE WILL BE OUTPUT TO SOTEMP. OE110 14680C********************************************************************OE110 14690CSR RECRDS BEGSR OE110 14700CSR OTYPE COMP ' ' 20 SALES ORDER OE110 0014710CSR OTYPE COMP 'C' 21 CREDIT MEMO OE110 14720CSR OTYPE COMP 'E' 22 DIRECT BILL OE110 14730CSR OTYPE COMP 'M' 23 MANUAL INVOICEOE110 14731CSR SETOF 94 14740C* OE110 14750CSR 21 OE110 14760COR 22 SETON 23 OE110 0014770CSR SETON 25 OUTPUT HEADER, OE110 14780CSR EXCPT SHIP-TO, OE110 14790CSR SETOF 25 COMMENT RECORDOE110 14800CSR SETOF 94 OUTPUT SOTEMP OE110 14810CSR SETON 26 OE110 14820CSR Z-ADD0 Y OE110 14830CSR Z-ADD0 CNT 20 OE110 0014840CSR RLOOP TAG OE110 14850CSR Y ADD 1 Y OE110 14860CSR Y COMP UPPER 59 OE110 14870CSR 59 GOTO ERECRD OE110 14880CSR MOVELLC,Y LCFLD OE110 14890CSR LCFLD COMP ' ' 59 OE110 14900CSR 59 GOTO RLOOP OE110 0014910CSR LCFLD COMP 'L' 77 OE110 14920CSR 77 EXSR MVLINE OE110 14930CSR 77 NOFLD COMP B12 59SKIP ELEMENTS OE110 14940CSR 59 GOTO RLOOP IF NO PART# OE110 14950CSR 77 POV,Y COMP ' ' 59NO OVRIDE PRCE OE110 14960CSR 59 Z-ADD0 PRFLD -OUTPUT ZERO OE110 14970CSRN77 MOVELLC,Y CMFLD 39 OE110 0014980CSR CNT ADD 1 CNT OE110 14990CSR 77 NOFLD CHAINPARTMST 98 OE110 15000CSRN98 77 SALLOC ADD QTFLD SALLOC OE110 15010CSR EXCPT OE110 15020CSR GOTO RLOOP OE110 15030CSR ERECRD TAG OE110 15040CSR SETOF 26 OE110 0015050CSR ENDSR OE110 15060O********************************************************************OE110 15070O* ALL OUTPUT TO DISK FILES IS EXCEPTION OUTPUT OE110 15080O********************************************************************OE110 15090O* OE110 15100O*** THIS SECTION OUTPUTS SALES ORDER # TO SOTEMP OE110 15110O*** PUTS AN 'X' IN REJECT CODE IF BATCHES WERE OUT OF BALANCE. OE110 0015120O*** ALSO OUTPUTS THE ORDER TYPE. OE110 15130O* OE110 15140OSOTEMP EADD 25 OE110 15150O DIG7 7 OE110 15160O 58 8 'X' OE110 15170O OTYPE 9 OE110 15180O* OE110 0015190O*** THIS SECTION OUTPUTS HEADER RECORD TO ORDINP. OE110 15200O* OE110 15210OOPNORDS EADD 25 20 OE110 15220O OR 25 23 OE110 15230O HEADER 118 OE110 15240O 2 '00' OE110 15250O SO 7 OE110 0015260O 8 'H' OE110 15270O 23 OTYPE 105 OE110 15280O SO 110 OE110 15290O 112 '00' OE110 15300O 113 'H' OE110 15310O* OE110 15320O*** THIS SECTION OUTPUTS SHIP-TO CUST TO ORDINP. OE110 0015330O* OE110 15340O EADD 25 20 OE110 15350O OR 25 23 OE110 15360O SHIP 118 OE110 15370O 2 '00' OE110 15380O SO 7 OE110 15390O 8 'I' OE110 0015400O SO 110 OE110 15410O 112 '00' OE110 15420O 113 'I' OE110 15430O* OE110 15440O*** THIS SECTION OUTPUTS THE MARK FOR COMMENTS RECORD TO ORDINP. OE110 15450O* OE110 15460O EADD 25 20 OE110 0015470O OR 25 23 OE110 15480O COMENT 118 OE110 15490O 2 '00' OE110 15500O SO 7 OE110 15510O 8 'K' OE110 15520O SO 110 OE110 15530O 112 '00' OE110 0015540O 113 'K' OE110 15550O* OE110 15560O*** THIS SECTION OUTPUTS THE LINE ITEMS TO ORDINP. OE110 15570O*** THESE CAN BE LINE ITEMS (77) OR LINE COMMENTS (N77). OE110 15580O* OE110 15590O EADD 26 20 OE110 15600O OR 26 23 OE110 0015610O 2 '00' OE110 15620O SO 7 OE110 15630O 8 'L' OE110 15640O CNT 10 OE110 15650O 77 11 'L' OE110 15670O 77 NOFLD 84 OE110 15680O 77 QTFLD 30 OE110 0015690O 77 PRFLD 58 OE110 15700O N77 CMFLD 49 OE110 15705O N77 11 'M' 15710O SO 110 OE110 15720O CNT 112 OE110 15730O 77 113 'L' OE110 15740O N77 113 'M' OE110 0015750O* OE110 15760OPARTMST E 26 20 77 OE110 15770O AND N98 OE110 15780O SALLOC 173 OE110 15790ONEWPART EADD 94 15800O DIG12 30 15810O********************************************************************OE110 0015820O* OE110 ** 015830ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 015840ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 015850ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 015860ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 015870** 01588000013102290331043005310630073108310930103111301231 015890** 015900 **BATCHES OUT OF BALANCE 1 015910[ ] [ ] [ ] 2 015920 [ ] 3 015930 4 015940** 01595000003 1 0159600044102**INVALID SALES ORDER # 2 0159700054103**INVALID TYPE 3 0159800064104**INVALID CUST # 4 0159900074109**INVALID DATE 5 0160000084110**INVALID DATE 6 0160100154115**INVALID TERMS 7 016020000164116**INVALID PRICE CODE 8 0160300174117**INVALID TAX CODE 9 0160400184118**INVALID SALESMAN # 0 0160500194119**INVALID AREA 1 016060020 2 016070021 3 0160801034102**INVALID CUST # 14 14 016090003072321**INVALID 15 15 0161003081103* 16 16 0161103092703**NOT ON PARTMST 17 17 016120311 18 18 0161304112413**INVALID 19 19 016140 016150/* 01616000_ 00 00 00 00 00 00 00 00 00 00 __ 0(6 OTXPI015 P999999050178(000010H S PI015 00020X DECK-ID M45 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI015 00030F* THIS PROGRAM IS THE CRT ENTRY OF THE PHYSICAL INVENTORY TAG DATA PI015 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI015 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI015 00060F* CONTROL DATA PROPRIETARY PRODUCT PI015 00070F* PI015 0000080FDUMMY IPE F 72 DISK PI015 00090FKPROGS IC F 36R 8AI 1 DISK PI015 00100FTAGINP UC F 32R DISK PI015 00110F********************************************************************PI015 00120F* INDICATOR FUNCTION LIST PI015 00130F* 01 DUMMY RECORD PI015 00140F* 02 KEYPYNCH PARAMETER FILE PI015 0000150F* 05 KEYPUNCH DATA FILE PI015 00160F* 18 PI015 00170F* 19 PI015 00180F* 20 PI015 00190F* 21 PI015 00200F* 25 RETRY ON RUBOUT PI015 00210F* 27 AUTO DUP PI015 0000220F* 28 PI015 00230F* 29 PI015 00240F* 40 MODE IS A-ADD PI015 00250F* 41 MODE IS C-CHANGE PI015 00260F* 42 MODE IS V-VERIFY PI015 00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS PI015 00280F* 44 MODE IS E-END OF JOB PI015 0000290F* 56 SEQ NBR NOT IN KPFILE PI015 00300F* 60 NEW PROGRAM NBR ONLY PI015 00310F* 61 AUTO DUP ONLY PI015 00320F* 70 PI015 00330F* 72 PI015 00340F* 73 MODE IS LESS THAN OR = 4 PI015 00350F* 81 MODE IS INVALID PI015 0000360F* 82 BAD PROG NBR PI015 00370F* 83 FIRST FIELD NAME BLANK PI015 00380F* 84 OUTPUT FIELD NAME PI015 00390F* 85 PI015 00400F* 88 SEQ NBR NOT IN KPFILE PI015 00410F* 90 AUTO DUP ON PI015 00420F* 95 PI015 0000430F* 98 RCD WITHIN OPERATOR LIMITS PI015 00440F* LR PI015 00450F********************************************************************PI015 00460E MSG 1 8 25 PI015 00470E SFN 80 20 PI015 00480E SAN 80 1 PI015 00490E SAD 80 1 PI015 0000500E SST 80 3 0 PI015 00510E SLN 80 2 0 PI015 00520E SNM 4 6 PI015 00530E SMX 4 2 0 PI015 00540E NP 4 1 0 PI015 00550E ARY1 1 2 50 PI015 00560IDUMMY NS 01 PI015 0000570I 1 1 A PI015 00580IKPROGS NS 02 PI015 00590I 9 28 FN PI015 00600I 29 29 AN PI015 00610I 30 30 AD PI015 00620I 31 33 ST PI015 00630I 34 35 LN PI015 0000640I 36 36 DCODE PI015 00650ITAGINP NS 05 PI015 00660I 1 32 RECORD PI015 00670C MOVE ' ' B72 72 PI015 00680C EXSR ALMTS PI015 00690C Z-ADDLOW SEQNO PI015 00700C NLR SETON LR PI015 0000710CLR START TAG PI015 00720CLR MOVEL'' WORD PI015 01580CLR Z-ADD1 OLN PI015 01590CLR Z-ADD1 ILN PI015 01600CLR EXSR TYPES PI015 0001610CLR MOVELBUFFER MODE PI015 01620CLR MODE COMP '4' 7373 PI015 01630CLR MODE COMP 'P' 60 NEW PROG#ONLY PI015 01640CLR MODE COMP 'D' 61 AUTO-DUP ONLY PI015 01650CLRN60N61N73 GOTO CHKMOD NEW 46DE PI015 01660CLR 73 MOVE MODE NPN 10 PI015 01670CLR EXSR GETPRG PI015 0001680CLR SETOF 606173 PI015 01690CLR GOTO SAMREC PI015 01700CLR CHKNUM TAG PI015 01710CLR MOVELBUFFER MODE PI015 01720CLR MODE COMP '@' 20 PI015 01730CLR 20N42 GOTO OUTREC PI015 01740CLR SAN,N COMP 'N' 19 PI015 0001750CLRN19 GOTO CHKVER PI015 01760CLR Z-ADDSLN,N VL 20 PI015 01770CLR MOVELBUFFER VAR 15 PI015 01780CLR EXIT SUBRAJ PI015 01790CLR RLABL VL PI015 01800CLR RLABL VAR PI015 01810CLR MOVELVAR BUFFER PI015 0001820CLR Z-ADDVL BLNGTH PI015 01830CLR EXSR EXCPT PI015 01840CLR SETOF 19 PI015 01850CLR CHKVER TAG PI015 01860CLRN42 GOTO MOVBUF PI015 01870CLR TBUF COMP BUFFER 2020 PI015 01880CLRN20 GOTO MOVBUF PI015 0001890CLR MOVEL'KP VERIF'WORD PI015 01900CLR MOVE 'Y ERROR 'WORD PI015 01910CLR MOVELWORD BUFFER PI015 01920CLR MOVE 'R' TYPE PI015 01930CLR Z-ADD6 MASK ONLY 'R' OR 'E'PI015 01940CLR EXSR CRTCOM PI015 01950CLR RCODE COMP 'R' 20 PI015 0001960CLR 20 GOTO OUTFLD PI015 01970CLR MOVBUF TAG PI015 01980CLR Z-ADDSST,N TSTRT 30 PI015 01990CLR Z-ADDSLN,N NCHARS 30 PI015 02000CLR Z-ADD1 SSTRT PI015 02010CLR EXIT SUBRMV PI015 02020CLR RLABL BUFFER PI015 0002030CLR RLABL SSTRT PI015 02040CLR RLABL RECORD PI015 02050CLR RLABL TSTRT PI015 02060CLR RLABL NCHARS PI015 02070CLR GOTO LOOP PI015 02080CLR RITDUP TAG PI015 02090CLR EXSR MVRECD PI015 0002100CLR SETON 19 PI015 02110CLR Z-ADDSLN,N BLNGTH PI015 02120CLRN27 EXSR EXCPT PI015 02130CLR SETOF 19 PI015 02140CLR GOTO MOVBUF PI015 02150CLR OUTREC TAG PI015 02160CLR SETON 187084 PI015 0002170CLR SETON 85 PI015 02180CLR EXCPT PI015 02190CLR EXSR EXCPT PI015 02200CLR SETOF 708485 PI015 02210CLR MOVELRECORD OLDREC 32 PI015 02220CLR NP,PN COMP 0 72 PI015 02230CLRN72 GOTO NXTREC PI015 0002240CLR MOVE NP,PN NPN PI015 02250CLR EXSR GETPRG PI015 02260CLR SETOF 72 PI015 02270CLR GOTO NXTREC PI015 02280CLR EOJ TAG PI015 02290C********************************************************************PI015 02300C* PI015 0002310C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION PI015 02320C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. PI015 02330C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. PI015 02340C* PI015 02350C********************************************************************PI015 02360CSR GETPRG BEGSR PI015 02370CSR 61 GOTO JMPOUT PI015 0002380CSR 72 PI015 02390COR 73 GOTO CHKPN PI015 02400CSR GETPNO TAG PI015 02410CSR MOVEL'PROG # -'WORD PI015 02420CSR Z-ADD8 OLN PI015 02430CSR Z-ADD1 ILN PI015 02440CSR EXSR TYPES PI015 0002450CSR MOVELBUFFER NPN 10 PI015 02460CSR CHKPN TAG PI015 02470CSR NPN COMP 0 2020 PI015 02480CSRN20 NPN COMP 4 20 BAD PROG# PI015 02490CSR 20 SETON 82 PI015 02500CSR 82 EXSR EXCPT PI015 02510CSR SETOF 82 PI015 0002520CSR 20 GOTO GETPNO TRY PROG# AGAINPI015 02530CSR MOVE NPN PN 10 INPI015 02540CSR MOVE PN NAME10 10 PI015 02550CSRN43 SNM,PN COMP ' ' 6060 PI015 02560CSR 60 PN SUB 1 BP 20 PI015 02570CSR 60 BP MULT 20 BP PI015 02580CSR 72 GOTO SETHED PI015 0002590CSR 73 GOTO JMPOUT PI015 02600CSR 60 GOTO JMPOUT PI015 02610CSR GETPNM TAG PI015 02620CSR MOVEL'PROG NAM'WORD PI015 02630CSR MOVE 'E - 'WORD PI015 02640CSR Z-ADD11 OLN PI015 02650CSR Z-ADD6 ILN PI015 0002660CSR EXSR TYPES PI015 02670CSR MOVELBUFFER PNAME 8 PI015 02680CSR MOVE ' ' PNAME PI015 02690CSR CHNPRG TAG PI015 02700CSR PNAME CHAINKPROGS 27 PI015 02710CSRN27 MOVELPNAME SNM,PN PI015 02720CSRN27 GOTO LOADIT PI015 0002730CSR MOVEL' 'WORD PI015 02740CSR MOVELPNAME WORD PI015 02750CSR MOVE 'ABSENT 'WORD PI015 02760CSR MOVE 'R' TYPE 1 PI015 02770CSR MOVELWORD BUFFER PI015 02780CSR Z-ADD7 MASK 10 PI015 02790CSR Z-ADD16 BLNGTH PI015 0002800CSR EXSR CRTCOM PI015 02810CSR RCODE COMP 'E' 20 PI015 02820CSR PRGMT TAG PI015 02830C*R 20 EXSR PROGMT PI015 02840C*R 20 GOTO CHNPRG PI015 02850CSR GOTO GETPNM PI015 02860CSR LOADIT TAG PI015 0002870CSR Z-ADD14 OLN PI015 02880CSR Z-ADD1 ILN PI015 02890CSR MOVEL'NEXT PRO'WORD PI015 02900CSR MOVE 'G # - 'WORD PI015 02910CSR EXSR TYPES PI015 02920CSR MOVELBUFFER NP,PN PI015 02930CSR PN SUB 1 BP PI015 0002940CSR BP MULT 20 BP PI015 02950CSR BP ADD 1 N 20 PI015 02960CSR Z-ADD1 X 20 PI015 02970CSR BLDARY TAG PI015 02980CSR FN COMP B72 20 PI015 02990CSR 20 N SUB 1 MAXFLD 20 PI015 03000CSR 20 MOVE MAXFLD SMX,PN PI015 0003010CSR 20 GOTO JMPOUT PI015 03020CSR MOVE FN SFN,N FIELD NAME PI015 03030CSR MOVE AN SAN,N ALPHA OR NUMER PI015 03040CSR MOVE AD SAD,N AUTO DUP PI015 03050CSR MOVE ST SST,N START POSITION PI015 03060CSR MOVE LN SLN,N PI015 03070CSR MVX TAG PI015 0003080CSR MOVE X PNAME PI015 03090CSR PNAME CHAINKPROGS 20 PI015 03100CSR X ADD 1 X PI015 03110CSRN20 X COMP 20 20 PI015 03120CSR 20 Z-ADDN MAXFLD PI015 03130CSR 20 MOVE MAXFLD SMX,PN PI015 03140CSR DCODE COMP 'D' 21 PI015 0003150CSR 21N20 GOTO MVX PI015 03160CSRN20 N ADD 1 N PI015 03170CSRN20 GOTO BLDARY PI015 03180CSR JMPOUT TAG PI015 03190CSR 43 GOTO ENDGET PI015 03200CSR 41 GOTO SETHED PI015 03210CSR MOVEL'AUTO-DUP'WORD PI015 0003220CSR MOVE ' - 'WORD PI015 03230CSR Z-ADD11 OLN PI015 03240CSR Z-ADD1 ILN PI015 03250CSR EXSR TYPES PI015 03260CSR MOVELBUFFER AUTO 1 PI015 03270CSR AUTO COMP 'O' 90AUTO-DUP ON PI015 03280CSR SETHED TAG PI015 0003290CSR MOVELSNM,PN NAME10 PI015 03300CSR MOVELNAME10 WORD PI015 03310CSR MOVE SMX,PN MAXFLD 20 PI015 03320CSR 90 MOVE ' ON' WORD PI015 03330CSRN90 MOVE 'OFF' WORD PI015 03340CSR MOVELWORD HEAD 40 PI015 03350CSR ENDGET ENDSR PI015 0003360C********************************************************************PI015 03370C* PI015 03380C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST PI015 03390C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE PI015 03400C* CHANGED PI015 03410C* PI015 03420C********************************************************************PI015 0003430CSR GETSEQ BEGSR PI015 03440CSR MOVEL'SEQ # - 'WORD PI015 03450CSR Z-ADD8 OLN PI015 03460CSR Z-ADD5 ILN PI015 03470CSR EXSR TYPES PI015 03480CSR Z-ADD5 VL PI015 03490CSR MOVELBUFFER VAR PI015 0003500CSR EXIT SUBRAJ PI015 03510CSR RLABL VL PI015 03520CSR RLABL VAR PI015 03530CSR MOVELVAR SEQNO PI015 03540CSR SEQNO COMP 0 20 PI015 03550CSRN20 Z-ADD1 SEQNO PI015 03560CSR SETON 95 PI015 0003570CSR ENDSEQ ENDSR PI015 03580C********************************************************************PI015 03590C* PI015 03600C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO PI015 03610C* PI015 03620C********************************************************************PI015 03630CSR GETREC BEGSR PI015 0003640CSR SEQRD TAG PI015 03650CSR EXSR TSTSEQ PI015 03660CSR 94 EXSR GETSEQ PI015 03670CSR 94 GOTO SEQRD PI015 03680CSR SEQNO CHAINTAGINP 56 PI015 03690CSR 40 MOVELRECORD TST 2 PI015 03700CSR 40 TST COMP '<>' 99 PI015 0003710CSR 40N99 SEQNO ADD 1 SEQNO PI015 03720CSR 40N99 GOTO SEQRD PI015 03730CSR 56 SETON 88 PI015 03740CSR 88 EXSR EXCPT PI015 03750CSR SETOF 88 PI015 03760CSR 56 EXSR GETSEQ PI015 03770CSR 56 GOTO SEQRD PI015 0003780CSR ENDSR PI015 03790C********************************************************************PI015 03800C* PI015 03810C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY PI015 03820C* IS DONE IF A RUBOUT IS USED PI015 03830C* PI015 03840C********************************************************************PI015 0003850CSR TYPES BEGSR PI015 03860CSR OVER TAG PI015 03870CSR Z-ADDOLN BLNGTH PI015 03880CSR MOVELWORD BUFFER PI015 03890CSR MOVE 'S' TYPE PI015 03900CSR EXSR CRTCOM PI015 03910CSR MOVE 'A' TYPE PI015 0003920CSR Z-ADDILN BLNGTH PI015 03930CSR EXSR CRTCOM PI015 03940CSR RCODE COMP 'R' 25 PI015 03950CSR 25 EXSR SKIP PI015 03960CSR 25 GOTO OVER PI015 03970CSR RCODE COMP 'O' 25 PI015 03980CSR 25 EXSR SKIP PI015 0003990CSR ENDSR PI015 04000C********************************************************************PI015 04010C* PI015 04020C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT PI015 04030C* PI015 04040C********************************************************************PI015 04050CSR SKIP BEGSR PI015 0004060CSR MOVELBUFFER NBUF 1 PI015 04070CSR MOVEL' ' BUFFER PI015 04080CSR Z-ADD1 BLNGTH PI015 04090CSR MOVE 'T' TYPE PI015 04100CSR EXSR CRTCOM PI015 04110CSR MOVELNBUF BUFFER PI015 04120CSR ENDSR PI015 0004130C********************************************************************PI015 04140C* PI015 04150C* PI015 04160C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED PI015 04170C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER PI015 04180C* PI015 04190CSR MVRECD BEGSR PI015 0004200CSR MOVELB72 BUFFER PI015 04210CSR Z-ADD1 TSTRT PI015 04220CSR Z-ADDSST,N SSTRT PI015 04230CSR Z-ADDSLN,N NCHARS PI015 04240CSR EXIT SUBRMV PI015 04250CSR RLABL OLDREC PI015 04260CSR RLABL SSTRT 30 PI015 0004270CSR RLABL BUFFER PI015 04280CSR RLABL TSTRT 30 PI015 04290CSR RLABL NCHARS 30 PI015 04300CSR ENDSR PI015 04310C********************************************************************PI015 04320CSR EXCPT BEGSR PI015 04330CSRN81N82N83 PI015 0004340CANN84N88 GOTO PUTOUT PI015 04350CSR MOVELB72 BUFFER PI015 04360CSR 81 MOVELMSG,1 BUFFER PI015 04370CSR 83 MOVELMSG,2 BUFFER PI015 04380CSR 88 MOVELMSG,3 BUFFER PI015 04390CSR 82 MOVELMSG,4 BUFFER PI015 04400CSRN84 GOTO PUTOUT PI015 0004410CSRN85 MOVELSFN,N BUFFER PI015 04420CSRN18 SETON 19 PI015 04430CSRN18 Z-ADD20 BLNGTH PI015 04440CSRN18 GOTO PUTOUT PI015 04450CSR MOVE HEAD BUFFER PI015 04460CSR MOVELSEQNO WORD8 8 PI015 04470CSR MOVE WORD8 BUFFER PI015 0004480CSR PUTOUT TAG PI015 04490CSR MOVE 'S' TYPE PI015 04500CSRN19 Z-ADD69 BLNGTH PI015 04510CSR SETOF 19 PI015 04520CSR EXSR CRTCOM PI015 04530CSR ENDSR PI015 04540C* PI015 0004550CSR ALMTS BEGSR PI015 04560CSR MOVE 'C' TYPE 1 PI015 04570CSR Z-ADD0 BLNGTH 20 PI015 04580CSR MOVE ' ' RCODE 1 PI015 04590CSR Z-ADD0 MASK 10 PI015 04600CSR Z-ADD0 DTYPE 10 PI015 04610CSR EXSR CRTCOM PI015 0004620CSR MOVELARY1,1 BUFFER PI015 04630CSR MOVE 'S' TYPE PI015 04640CSR Z-ADD50 BLNGTH PI015 04650CSR EXSR CRTCOM PI015 04660CSR MOVE 'A' TYPE PI015 04670CSR Z-ADD5 BLNGTH PI015 04680CSR Z-ADD1 DTYPE PI015 0004690CSR EXSR CRTCOM PI015 04700CSR EXSR SKIP PI015 04710CSR RCODE COMP 'R' 86 PI015 04720CSR Z-ADD5 VL PI015 04730CSR MOVELBUFFER VAR PI015 04740CSR EXIT SUBRAJ PI015 04750CSR RLABL VL PI015 0004760CSR RLABL VAR PI015 04770CSR MOVELVAR BUFFER PI015 04780CSR MOVELBUFFER LOW 50 PI015 04790CSR MOVELARY1,2 BUFFER PI015 04800CSR MOVE 'S' TYPE PI015 04810CSR Z-ADD50 BLNGTH PI015 04820CSR EXSR CRTCOM PI015 0004830CSR MOVE 'A' TYPE PI015 04840CSR Z-ADD5 BLNGTH PI015 04850CSR Z-ADD1 DTYPE PI015 04860CSR EXSR CRTCOM PI015 04870CSR RCODE COMP 'R' 87 PI015 04880CSR Z-ADD5 VL PI015 04890CSR MOVELBUFFER VAR PI015 0004900CSR EXIT SUBRAJ PI015 04910CSR RLABL VL PI015 04920CSR RLABL VAR PI015 04930CSR MOVELVAR BUFFER PI015 04940CSR MOVELBUFFER HIGH 50 PI015 04950CSR MOVE 'C' TYPE PI015 04960CSR EXSR CRTCOM PI015 0004970CSR 86 PI015 04980COR 87 GOTO ALMTS PI015 04990CSR Z-ADD0 DTYPE PI015 05000CSR ENDSR PI015 05010CSR CRTCOM BEGSR PI015 05020CSR EXITFSUBRCM PI015 05030CSR RLABL BUFFER PI015 0005040CSR RLABL TYPE PI015 05050CSR RLABL BLNGTH PI015 05060CSR RLABL RCODE PI015 05070CSR RLABL MASK PI015 05080CSR RLABL DTYPE PI015 05090CSR ENDSR PI015 05100CSR PUTSEQ BEGSR PI015 0005110CSR MOVELMSG,5 BUFFER 72 PI015 05120CSR MOVE 'S' TYPE PI015 05130CSR Z-ADD25 BLNGTH PI015 05140CSR EXSR CRTCOM PI015 05150CSR MOVELSEQNO BUFFER PI015 05160CSR MOVE 'T' TYPE PI015 05170CSR Z-ADD5 BLNGTH PI015 0005180CSR EXSR CRTCOM PI015 05190CSR ENDSR PI015 05200CSR TSTSEQ BEGSR PI015 05210CSR SETOF 949697 PI015 05220CSR SEQNO COMP LOW 989698 PI015 05230CSR 98 SEQNO COMP HIGH 979898 PI015 05240CSR 98 GOTO ENDTST PI015 0005250CSR 40 96 MOVELMSG,6 BUFFER PI015 05260CSR 40 97 MOVELMSG,7 BUFFER PI015 05270CSRN40 MOVELMSG,8 BUFFER PI015 05280CSRN40 SETON 94 PI015 05290CSR MOVE 'T' TYPE PI015 05300CSR Z-ADD25 BLNGTH PI015 05310CSR EXSR CRTCOM PI015 0005320CSR 40 97 MOVE 'F' TYPE PI015 05330CSR 40 97 EXSR CRTCOM PI015 05340CSR ENDTST ENDSR PI015 05350C********************************************************************PI015 05360OTAGINP E 70N56 PI015 05370O RECORD 32 PI015 05380O 42 32 'X' PI015 00** 005390ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005400ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005410ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005420ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005430** 005440MODE MUST BE A,C,V,OR E 00545000FIRST FIELD NAME BLANK 005460INVALID SEQ # 005470PROG# MUST BE FROM 1-4 005480CURRENT SEQUENCE NBR 005490SEQNO TOO LOW 005500RUN EDIT PROG-FILE FULL 005510SEQNO NOT IN YOUR LIMITS 00552000** 005530ENTER BEGINNING RELATIVE RECORD NUMBER 005540ENTER ENDING RELATIVE RECORD NUMBER 005550/* 005560_ 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(,0 ,}OTXPI025 P999999050178(000010H S PI025 00020X DECK-ID M95 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI025 00030F* THIS PROGRAM WRITES THE DUPLICATE AND MISSING TAG REPORT PI020 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FOUTTAG IP AF 32 DISK 00090FPARTMST IC F 300R12AI 1 DISK 00100FHEADING IT F 40 EDISK 00110F$LP1 O F 132 OF PRINTER API02000120F********************************************************************API02000130F* API02000140F* DUPLICATE AND MISSING API0200000150F* TAG REPORT API02000160F* API02000170F********************************************************************API02000180F* API02000190F* API020 LISTS ALL MISSING TAG NUMBERS, DUPLICATE TAG NUMBERS, API02000200F* AND TAG NUMBERS THAT EXCEED THE LIMITS. TAG#,PART#, DESCRIPTION API02000210F* ARE PRINTED FOR ALL DUPLICATE TAG NUMBERS. API0200000220F* ERRORS PRINTED AT EXCPT OUTPUT. API02000230F* API02000240F* API02000250F********************************************************************API02000260F* ID F C H L FUNCTION OF INDICATORS API02000270F*01 LIMITS RECORD --FROM TAGS API02000280F*02 TAGS RECORD --FROM TAGS API0200000290F*03 INVALID CARD TYPE --FROM TAGS API02000300F*04 IMSTR RECORD --FROM PARTMST API02000310F* 10 SKIP AROUND THINGS DONE ON FIRST CYCLE API02000320F* 51 EXCEEDS LIMIT ERROR API02000330F* 52 TAGS MISSING ERROR API02000340F* 53 COMPARE SHOWS THAT DUPLICATE TAGS EXIST API02000350F* 54 PRINT DUPLICATE TAG INFORMATION API0200000360F* 55 CHAINED AND RECORD NOT FOUND API02000370F* 61 TAG GREATER THAN UPPER LIMIT IN EXCEEDS API02000380F* 63 SAVE STATUS OF GREATER TAG--PERFORM SUBROUTINE API02000390F* 64 ONLY CHECK ONCE FOR MISSING TICKETS TO UPPER LIMIT API02000400F* 65 MTAG AND UPPER LIMIT ARE EQUAL API02000410F* 66 MTAG LESS THAN UPPER LIMIT API02000420F* 67 MTAG IS GREATER THAN TTAG--DON'T ADD ONE API0200000430F* 68 COMBINATION OF 67 OR 65--DON'T ADD ONE 00440F********************************************************************API02000450E HEADING HEAD 1 1 40 00460E ARY1 1 2 50 00470IOUTTAG NS 02 1 CT 00480I 2 60TTAG API02000490I 7 18 TPART 0000500I 19 20 TUM 00510I 21 270TQTY 00520I NS 03 API02000530I 1 29 DUM1 00540IPARTMST NS 04 00550I 1 12 PART 00560I 13 37 DESC 0000570C* API02000580C* API02000590C* API02000600C 02 00610COR 03 SETOF 01 00620C 10 GOTO START API02000630C SETON 10 DO ONLY ONCE API0200000640C EXSR ALMTS 00650C MOVE LLIM MTAG 60 MISSING TAGS API02000660C MOVEL'*** NOT 'WORK 16 API02000670C MOVE 'ON MASTE'WORK NDESC USED IF API02000680C MOVE 'R *** 'WORK1 24 ITEM NOT FOUND API02000690C MOVELWORK WORK1 WHEN CHAINED API02000700C MOVELWORK1 NDESC 30 TO PARTMST API0200000710C MOVE ' ' NDESC API02000720C* API02000730C START TAG API02000740C 01 API02000750COR 03 GOTO END API02000760C* API02000770C* API0200000780C SETOF 515268 00790C EXSR EXCEED API02000800C N51 API02000810COR 63 EXSR MISS API02000820C EXSR DUPL API02000830C* API02000840C END TAG API0200000850C SEQ ADD 1 SEQ 60 PI020 00860CLR TTAG COMP ULIM 66 00870CLR 66 MOVE MTAG A 60 00880CLR 66 SETON 63 00890CLR SETOF 5152 00900CLR EXCPT 00910C********************************************************************API0200000920C* API02000930C* THIS SUBROUTINE MOVES THE INFORMATION FROM A RECORD JUST API02000940C* READ TO STORAGE FIELDS. THIS IS USED TO CHECK FOR DUPLICATE API02000950C* TAGS. IF ALSO ALLOWS FOR THE PRINTING OF THE DUPLICATE TAGS API02000960C* API02000970C* API02000980C********************************************************************API0200000990C* API02001000CSR SAVE BEGSR API02001010CSR MOVE TTAG STAG 50 API02001020CSR MOVE TPART SPART 6 API02001030CSRN55 MOVE DESC SDESC 30 API02001040CSR 55 MOVE NDESC SDESC API02001050CSR ENDSR API0200001060C* API02001070C********************************************************************API02001080C* API02001090C* THIS SUBROUTINE CHECKS TO SEE IF THE TAG IS LESS THAN THE API02001100C* LOWER LIMIT OR IS GREATER THAN THE UPPER LIMIT. API02001110C* IF YES TO EITHER OF THESE IT IS PRINTED. API02001120C* API0200001130C********************************************************************API02001140C* API02001150CSR EXCEED BEGSR API02001160CSR TTAG COMP LLIM 51 51 LOWER ERROR API02001170CSRN51 TTAG COMP ULIM 61 61 UPPER ERROR API02001180CSR 61 SETON 5163 API02001190CSR 64 SETOF 63 API0200001200CSR ENDSR API02001210C* API02001220C********************************************************************API02001230C* API02001240C* THIS SUBROUTINE CHECKS FOR MISSING TAGS WITHIN THE LIMIT. API02001250C* IF THE TAG EXCEEDS THE LIMIT ONE WAY OR ANOTHER, THIS API02001260C* SUBROUTINE IS NOT PERFORMED. API0200001270C* API02001280C* API02001290C********************************************************************API02001300CSR MISS BEGSR API02001310CSR MTAG COMP ULIM 6665 API02001320CSR 65 GOTO LEND API02001330CSR MTAG COMP TTAG 6752 TAGS MISSING API0200001340CSRN52 GOTO LEND API02001350CSR MOVE MTAG A 60 LOWER TAG GONE API02001360CSR MOVE TTAG B 60 API02001370CSR B SUB 1 B UPPER TAG GONE API02001380CSR MOVE TTAG MTAG BEGIN SEQ AGAINAPI02001390C* API02001400CSR LEND TAG API0200001410CSR 66 63 SETOF 52 01420CSR 67 01430COR 65 SETON 68 01440CSRN68 MTAG ADD 1 MTAG API02001450CSR 63 SETON 64 ONLY DO ONCE API02001460CSR ENDSR API02001470C* API0200001480C********************************************************************API02001490C* API02001500C* THIS SUBROUTINE DISCOVERS DUPLICATE TAGS WITHOUT USE OF API02001510C* LOOK AHEAD FIELDS. PREVIOUS INFORMATION MUST BE STORED SO API02001520C* THAT THE FIRST DUPLICATE CAN BE PRINTED. API02001530C* CHAIN OUT TO PARTMST TO GET THE DESCRIPTION OF ITEM. PI020 01540C* API0200001550C* API02001560C********************************************************************API02001570C* API02001580CSR DUPL BEGSR API02001590CSRN53 SETOF 54 API02001600CSR TTAG COMP STAG 53 DUPLICATE TAG API02001610CSR 53 SETON 54 PRINT TAG API0200001620CSR EXCPT PRINT API02001630CSR TPART CHAINPARTMST 55 NOT FOUND 01640CSR EXSR SAVE API02001650C* API02001660CSR ENDSR API02001670C* API02001680CSR ALMTS BEGSR 0001690CSR MOVE 'C' TYPE 01700CSR EXSR CRTCOM 01710CSR MOVELARY1,1 BUFFER 01720CSR MOVE 'S' TYPE 01730CSR Z-ADD50 BLNGTH 01740CSR EXSR CRTCOM 01750CSR MOVE 'A' TYPE 0001760CSR Z-ADD5 BLNGTH 01770CSR Z-ADD1 DTYPE 01780CSR EXSR CRTCOM 01790CSR RCODE COMP 'R' 86 01800CSR Z-ADD5 VL 20 01810CSR MOVELBUFFER VAR 15 01820CSR EXIT SUBRAJ 0001830CSR RLABL VL 01840CSR RLABL VAR 01850CSR MOVELVAR LLIM 50 01860CSR MOVEL' ' BUFFER 01870CSR Z-ADD1 BLNGTH 01880CSR MOVE 'T' TYPE 01890CSR EXSR CRTCOM 0001900CSR MOVELARY1,2 BUFFER 01910CSR MOVE 'S' TYPE 01920CSR Z-ADD50 BLNGTH 01930CSR EXSR CRTCOM 01940CSR MOVE 'A' TYPE 01950CSR Z-ADD5 BLNGTH 01960CSR EXSR CRTCOM 0001970CSR RCODE COMP 'R' 87 01980CSR Z-ADD5 VL 01990CSR MOVELBUFFER VAR 02000CSR EXIT SUBRAJ 02010CSR RLABL VL 02020CSR RLABL VAR 02030CSR MOVELVAR ULIM 50 0002040CSR MOVE 'C' TYPE 02050CSR EXSR CRTCOM 02060CSR 86 02070COR 87 GOTO ALMTS 02080CSR SETON 01 02090CSR ENDSR 02100CSR CRTCOM BEGSR 0002110CSR EXITFSUBRCM 02120CSR RLABL BUFFER 72 02130CSR RLABL TYPE 1 02140CSR RLABL BLNGTH 20 02150CSR RLABL RCODE 1 02160CSR RLABL MASK 10 02170CSR RLABL DTYPE 10 0002180CSR ENDSR 02190O$LP1 D 202 01 02200O OR OFN1P API02002210O 9 'PI020 ' 02220O HEAD,1 54 02230O 74 'DATE' API02002240O UDATE Y 83 API0200002250O 90 'PAGE' API02002260O PAGE Z 94 API02002270O D 2 01 02280O OR OFN1P API02002290O 50 'DUPLICATE AND MISSING' API02002300O 61 'TAG REPORT' API02002310O D 2 01 0002320O OR OFN1P API02002330O 15 'TAG LIMITS' API02002340O LLIM 3 22 API02002350O 26 'TO' API02002360O ULIM 3 34 API02002370O 35 '.' API02002380O D 2 01 0002390O OR OFN1P API02002400O 20 'MISSING TAG#' API02002410O 59 'DUPLICATE TAG#' API02002420O 107 'EXCEEDS LIMITS' API02002430O 125 'SEQ #' PI020 02440O E 1 54 API02002450O STAG 3 40 API0200002460O SPART 51 API02002470O SDESC B 85 API02002480O SEQ J 125 PI020 02490O E 1 66 63 API02002500O A 3 10 API02002510O 16 'THRU' API02002520O ULIM 3 24 API0200002530O E 1 51 API02002540O TTAG 3 100 API02002550O SEQ J 125 PI020 02560O E 1 52 API02002570O A 3 10 API02002580O 16 'THRU' API02002590O B 3 24 API0200002600O* API02002610O* API02002620O D 1 03 API02002630O DUM1 29 02640O 55 '*** INVALID CARD TYPE' API02002650O SEQ J 125 PI020 ** 0266000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 02670ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 02680ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 02690ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 02700** 02710ENTER TAG LOW LIMIT-XXXXX 02720ENTER TAG HIGH LIMIT-XXXXX 0273000/* 02740_ 00 00 00 __ 0(3 IOTXPI016 P999999050178(000010H S PI016 00020X DECK-ID M46 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI016 00030F* THIS IS THE RECOVERY PROGRAM THAT DISPLAYS LAST RECORD ENTERED PI016 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI016 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI016 00060F* CONTROL DATA PROPRIETARY PRODUCT PI016 00070F* PI016 0000080FDUMMY UPE F 72 DISK PI016 00090FTAGINP IC F 32R DISK PI016 00100E MSG 1 5 35 PI016 00110IDUMMY NS 01 PI016 00120I 1 72 ALL PI016 00130ITAGINP NS 02 PI016 00140I 1 32 RCD PI016 0000150C SETOF 60 PI016 00160C SETON LR PI016 00170CLR MOVE ' ' B80 80 PI016 00180CLR EXSR ALMTS PI016 00190CLR Z-ADDLOW SEQNO 50 PI016 00200CLR LOOP TAG PI016 00210CLR SEQNO COMP HIGH 40 PI016 0000220CLR 40 GOTO A PI016 00230CLR SEQNO CHAINTAGINP 50 PI016 00240CLR 50 GOTO A PI016 00250CLR MOVELRCD TST 2 PI016 00260CLR TST COMP '<>' 51 PI016 00270CLRN51 SEQNO ADD 1 SEQNO PI016 00280CLRN51 GOTO LOOP PI016 0000290CLR A TAG PI016 00300CLR SEQNO SUB 1 SUBNO 50 PI016 00310CLR SUBNO CHAINTAGINP 50 PI016 00320CLR MOVELRCD BUFFER PI016 00330CLR MOVE 'T' TYPE PI016 00340CLR Z-ADD32 BLNGTH PI016 00350CLR EXSR CRTCOM PI016 0000360CLR MOVELMSG,3 BUFFER PI016 00370CLR MOVE 'S' TYPE PI016 00380CLR Z-ADD35 BLNGTH PI016 00390CLR EXSR CRTCOM PI016 00400CLR MOVE B80 BUFFER PI016 00410CLR MOVELSEQNO BUFFER PI016 00420CLR MOVE 'T' TYPE PI016 0000430CLR Z-ADD5 BLNGTH PI016 00440CLR EXSR CRTCOM PI016 00450CLR MOVELMSG,4 BUFFER PI016 00460CLR MOVE 'S' TYPE PI016 00470CLR Z-ADD35 BLNGTH PI016 00480CLR EXSR CRTCOM PI016 00490CLR MOVE B80 BUFFER PI016 0000500CLR MOVE 'A' TYPE PI016 00510CLR Z-ADD1 BLNGTH PI016 00520CLR EXSR CRTCOM PI016 00530CLR MOVE 'C' TYPE PI016 00540CLR EXSR CRTCOM PI016 00550CLR MOVE 'F' TYPE PI016 00560CLR EXSR CRTCOM PI016 0000570CSR ALMTS BEGSR PI016 00580CSR MOVE B80 BUFFER 80 PI016 00590CSR MOVE 'C' TYPE 1 PI016 00600CSR Z-ADD0 BLNGTH 20 PI016 00610CSR MOVE ' ' RCODE 1 PI016 00620CSR Z-ADD0 MASK 10 PI016 00630CSR Z-ADD0 DTYPE 10 PI016 0000640CSR EXSR CRTCOM PI016 00650CSR MOVELMSG,1 BUFFER PI016 00660CSR MOVE 'S' TYPE PI016 00670CSR Z-ADD35 BLNGTH PI016 00680CSR EXSR CRTCOM PI016 00690CSR MOVE B80 BUFFER PI016 00700CSR MOVE 'A' TYPE PI016 0000710CSR Z-ADD5 BLNGTH PI016 00720CSR Z-ADD1 DTYPE PI016 00730CSR EXSR CRTCOM PI016 00740CSR EXSR SKIP PI016 00750CSR RCODE COMP 'R' 86 PI016 00760CSR EXSR AJ PI016 00770CSR MOVELBUFFER LOW 50 PI016 0000780CSR MOVE B80 BUFFER PI016 00790CSR MOVELMSG,2 BUFFER PI016 00800CSR MOVE 'S' TYPE PI016 00810CSR Z-ADD35 BLNGTH PI016 00820CSR EXSR CRTCOM PI016 00830CSR MOVE B80 BUFFER PI016 00840CSR MOVE 'A' TYPE PI016 0000850CSR Z-ADD5 BLNGTH PI016 00860CSR Z-ADD1 DTYPE PI016 00870CSR EXSR CRTCOM PI016 00880CSR RCODE COMP 'R' 87 PI016 00890CSR EXSR AJ PI016 00900CSR MOVELBUFFER HIGH 50 PI016 00910CSR MOVE 'C' TYPE PI016 0000920CSR EXSR CRTCOM PI016 00930CSR 86 PI016 00940COR 87 GOTO ALMTS PI016 00950CSR Z-ADD0 DTYPE PI016 00960CSR ENDSR PI016 00970CSR CRTCOM BEGSR PI016 00980CSR EXITFSUBRCM PI016 0000990CSR RLABL BUFFER PI016 01000CSR RLABL TYPE PI016 01010CSR RLABL BLNGTH PI016 01020CSR RLABL RCODE PI016 01030CSR RLABL MASK PI016 01040CSR RLABL DTYPE PI016 01050CSR ENDSR PI016 0001060CSR SKIP BEGSR PI016 01070CSR MOVELBUFFER NBUF 1 PI016 01080CSR MOVEL' ' BUFFER PI016 01090CSR Z-ADD1 BLNGTH PI016 01100CSR MOVE 'T' TYPE PI016 01110CSR EXSR CRTCOM PI016 01120CSR MOVELNBUF BUFFER PI016 0001130CSR ENDSR PI016 01140CSR AJ BEGSR PI016 01150CSR MOVELBUFFER VAR 15 PI016 01160CSR Z-ADD5 VL 20 PI016 01170CSR EXIT SUBRAJ PI016 01180CSR RLABL VL PI016 01190CSR RLABL VAR PI016 0001200CSR MOVELVAR BUFFER PI016 01210CSR ENDSR PI016 01220ODUMMY D 60 PI016 01230O ALL 72 PI016 ** 001240ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001250ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00126000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001270ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001280** 001290ENTER BEGINNING RRN 001300ENTER ENDING RRN 001310TRANSACTION RRN 001320ENTER E FOR END OF JOB 00133000 THIS IS A BLANK ARRAY MEMBER 001340/* 001350__ 001290ENTER BEGINNING RRN 001300ENTER ENDING RRN 001310TRANSACTION RRN 001320ENTER E FOR END OF JOB 0013300(21n OTXPI017 P999999050178(000010H S PI017 00020X DECK-ID M47 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI017 00030F* THIS PROGRAM BYPASSES RECORDS WITH <> IN RECORD POSITION 1 AND 2 PI017 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI017 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI017 00060F* CONTROL DATA PROPRIETARY PRODUCT PI017 00070F* PI017 0000080FTAGINP IPE F 32 DISK PI017 00090FTAGOUT O F 32 DISK PI017 00100ITAGINP NS 01 1 C< 2 C> PI017 00110I 1 1 A PI017 00120I NS 02 1NC< PI017 00130I 1 32 REC PI017 00140OTAGOUT D 02 PI017 0000150O REC 32 PI017 ** 000160ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000170ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000180ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000190ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000200/* 00021000__0O REC 32 PI017 ** 000160ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000170ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000180ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000190ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000200/* 0002100( IOTXPI030 P999999050178(000010H S PI030 00020X DECK-ID M49 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI030 00030F* THIS PROGRAM DOES THE TAG EDIT PI030 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI030 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI030 00060F* CONTROL DATA PROPRIETARY PRODUCT PI030 00070F* PI030 0000080FTAGS IP AF 32 DISK PI030 00090FPARTMST IC F 300R12AI 1 DISK PI030 00100FHEADING IT F 40 EDISK PI030 00110F$LP1 O F 132 OF PRINTER PI030 00120F********************************************************************PI030 00130F* PI030 00140F* INVENTORY TAG EDIT PI030 0000150F* PI030 00160F********************************************************************PI030 00170F* PI030 00180F* PI030 00190F********************************************************************PI030 00200F* ID F C H L FUNCTION OF INDICATORS PI030 00210F*01 'T' RECORD FROM TAGS PI030 0000220F*02 NON 'T' RECORD FROM TAGS PI030 00230F*03 RECORD FROM PARTMST PI030 00240F* 11 ZERO QUANITY--ERROR PI030 00250F* 23 AT LEAST ONE 01 RECORD HAS BEEN PROCESSED PI030 00260F* 51 PART # NOT ON MASTERFILE--ERROR PI030 00270F* 52 U/M NOT SAME AS THAT ON MASTERFILE--ERROR PI030 00280F* N61 NO ERRORS--SKIP ONE LINE PI030 0000290F* 1P FIRST PAGE PI030 00300F* OF OVERFLOW PI030 00310F* L1 BREAK ON EVER 100 TAGS-BREAK ON THIRD DIGIT PI030 00320F* LR LAST RECORD PI030 00330F********************************************************************PI030 00340E HEADING HEAD 1 1 40 PI030 00350ITAGS NS 02 1NCT PI030 0000360I 1 29 DUM1 PI030 00370I* PI030 00380I* PI030 00390I* PI030 00400I NS 01 PI030 00410I 2 60TTAG PI030 00420I 2 40DIGIT L1 PI030 0000430I 7 18 TPART PI030 00440I 19 20 TUM PI030 00450I 21 270TQTY 11 PI030 00460IPARTMST NS 03 PI030 00470I 1 12 PART PI030 00480I 13 37 DESC PI030 00490I 38 39 UM PI030 0000500I* PI030 00510C* PI030 00520C SETOF 515253 PI030 00530C SETOF 616263 PI030 00540C* PI030 00550C N01 GOTO END PI030 00560C* PI030 0000570C SETON 23 PI030 00580C COUNT ADD 1 COUNT 30 PI030 00590C CTQTY ADD TQTY CTQTY 80 PI030 00600C* PI030 00610C TPART CHAINPARTMST 51 PART NOT FOUND PI030 00620C N51 TUM COMP UM 5252 UM NOT SAME PI030 00630C* PI030 0000640C 51 PI030 00650COR 52 PI030 00660COR 11 SETON 61 PI030 00670C SEQ ADD 1 SEQ 60 PI030 00680C END TAG PI030 00690C* PI030 00700CL1N23 SETOF L1 PI030 0000710CL0N23 GOTO LASTL PI030 00720CL1 TOT ADD COUNT TOT 50 PI030 00730CL0 LASTL TAG PI030 00740C* PI030 00750C* PI030 00760C* PI030 00770O$LP1 H 102 1P PI030 0000780O OR OFN1P PI030 00790O 9 'PI030 ' PI030 00800O HEAD,1 54 PI030 00810O 70 'DATE' PI030 00820O UDATE Y 79 PI030 00830O 91 'PAGE' PI030 00840O PAGE Z 95 PI030 0000850O H 2 1P PI030 00860O OR OFN1P PI030 00870O 56 'INVENTORY TAG EDIT' PI030 00880O H 2 1P PI030 00890O OR OFN1P PI030 00900O 7 'TAG #' PI030 00910O 19 'PART NO.' PI030 0000920O 34 'DESCRIPTION' PI030 00930O 62 'QTY' PI030 00940O 72 'U/M' PI030 00950O 125 'SEQ #' PI030 00960O D 00 01 PI030 00970O TTAG 3 7 PI030 00980O TPART 22 PI030 0000990O N51 DESC 51 PI030 01000O TQTY J 65 PI030 01010O TUM 71 PI030 01020O SEQ J 125 PI030 01030O D 1 01 52 PI030 01040O 103 '* U/M ON MASTERFILE IS' PI030 01050O UM 106 PI030 0001060O 107 '.' PI030 01070O D 1 01 51 PI030 01080O 96 '* PART # NOT ON' PI030 01090O 108 'MASTERFILE.' PI030 01100O D 1 01 11 PI030 01110O 95 '* QTY IS ZERO.' PI030 01120O D 1 01N61 PI030 0001130O 1 ' ' PI030 01140O T 12 L1 PI030 01150O 24 'TOTAL TAGS THIS BLOCK' PI030 01160O COUNT 3B 29 PI030 01170O 44 'QTY TOTAL' PI030 01180O CTQTY 1B 56 PI030 01190O T 00 LR PI030 0001200O 13 'TOTAL TAGS' PI030 01210O TOT 3 21 PI030 ** 001220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00126000/* 001270__0O TOT 3 21 PI030 ** 001220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0012600(7+ iOTXPI020 P999999050178(00101 H S PI020 X DECK-ID M48 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI020 F* THIS PROGRAM WRITES THE DUPLICATE AND MISSING TAG REPORT PI020 F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0 F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F* CONTROL DATA PROPRIETARY PRODUCT F* 001002 FTAGS IP AF 32 DISK API020 FPARTMST IC F 300R12AI 1 DISK FHEADING IT F 40 EDISK 1004 F$LP1 O F 132 OF PRINTER API0202002 F********************************************************************API0202003 F* API0202009 F* DUPLICATE AND MISSING API020002010 F* TAG REPORT API0202011 F* API0202012 F********************************************************************API0202102 F* API0202103 F* API020 LISTS ALL MISSING TAG NUMBERS, DUPLICATE TAG NUMBERS, API0202104 F* AND TAG NUMBERS THAT EXCEED THE LIMITS. TAG#,PART#, DESCRIPTION API0202105 F* ARE PRINTED FOR ALL DUPLICATE TAG NUMBERS. API020002106 F* ERRORS PRINTED AT EXCPT OUTPUT. API0202107 F* API0202108 F* API0202109 F********************************************************************API0202201 F* ID F C H L FUNCTION OF INDICATORS API0202202 F*01 LIMITS RECORD --FROM TAGS API0202203 F*02 TAGS RECORD --FROM TAGS API020002204 F*03 INVALID CARD TYPE --FROM TAGS API0202205 F*04 IMSTR RECORD --FROM PARTMST API0202206 F* 10 SKIP AROUND THINGS DONE ON FIRST CYCLE API0202207 F* 51 EXCEEDS LIMIT ERROR API0202208 F* 52 TAGS MISSING ERROR API0202209 F* 53 COMPARE SHOWS THAT DUPLICATE TAGS EXIST API0202210 F* 54 PRINT DUPLICATE TAG INFORMATION API020002211 F* 55 CHAINED AND RECORD NOT FOUND API0202212 F* 61 TAG GREATER THAN UPPER LIMIT IN EXCEEDS API0202213 F* 63 SAVE STATUS OF GREATER TAG--PERFORM SUBROUTINE API0202214 F* 64 ONLY CHECK ONCE FOR MISSING TICKETS TO UPPER LIMIT API0202215 F* 65 MTAG AND UPPER LIMIT ARE EQUAL API0202216 F* 66 MTAG LESS THAN UPPER LIMIT API0202217 F* 67 MTAG IS GREATER THAN TTAG--DON'T ADD ONE API0200022175F* 68 COMBINATION OF 67 OR 65--DON'T ADD ONE 2218 F********************************************************************API020 E HEADING HEAD 1 1 40 3001 ITAGS NS 01 1 CL API0203002 I 2 60LLIM API0203003 I 7 110ULIM API0203004 I NS 02 1 CT API020003005 I 2 60TTAG API0203006 I 7 18 TPART 3007 I 19 20 TUM 3008 I 21 270TQTY 3010 I NS 03 API0203011 I 1 29 DUM1 3101 IPARTMST NS 04 003102 I 1 12 PART 3103 I 13 37 DESC 4001 C* API0204003 C* API0204004 C* API0204005 C 10 GOTO START API0204006 C SETON 10 DO ONLY ONCE API020004007 C MOVE LLIM MTAG 60 MISSING TAGS API0204008 C MOVEL'*** NOT 'WORK 16 API0204009 C MOVE 'ON MASTE'WORK NDESC USED IF API0204010 C MOVE 'R *** 'WORK1 24 ITEM NOT FOUND API0204011 C MOVELWORK WORK1 WHEN CHAINED API0204012 C MOVELWORK1 NDESC 30 TO PARTMST API0204013 C MOVE ' ' NDESC API020004014 C* API0204015 C START TAG API0204016 C 01 API0204017 COR 03 GOTO END API0204018 C* API0204019 C* API0204020 C SETOF 515268 004101 C EXSR EXCEED API0204102 C N51 API0204103 COR 63 EXSR MISS API0204104 C EXSR DUPL API0204105 C* API0204106 C END TAG API02041061C SEQ ADD 1 SEQ 60 PI020 004107 CLR TTAG COMP ULIM 66 4108 CLR 66 MOVE MTAG A 60 4109 CLR 66 SETON 63 4110 CLR SETOF 5152 4111 CLR EXCPT 4201 C********************************************************************API0204202 C* API020004203 C* THIS SUBROUTINE MOVES THE INFORMATION FROM A RECORD JUST API0204204 C* READ TO STORAGE FIELDS. THIS IS USED TO CHECK FOR DUPLICATE API0204205 C* TAGS. IF ALSO ALLOWS FOR THE PRINTING OF THE DUPLICATE TAGS API0204206 C* API0204207 C* API0204208 C********************************************************************API0204209 C* API020004210 CSR SAVE BEGSR API0204211 CSR MOVE TTAG STAG 50 API0204212 CSR MOVE TPART SPART 6 API0204213 CSRN55 MOVE DESC SDESC 30 API0204214 CSR 55 MOVE NDESC SDESC API0204215 CSR ENDSR API0204216 C* API020004301 C********************************************************************API0204302 C* API0204303 C* THIS SUBROUTINE CHECKS TO SEE IF THE TAG IS LESS THAN THE API0204304 C* LOWER LIMIT OR IS GREATER THAN THE UPPER LIMIT. API0204305 C* IF YES TO EITHER OF THESE IT IS PRINTED. API0204306 C* API0204307 C********************************************************************API020004308 C* API0204309 CSR EXCEED BEGSR API0204310 CSR TTAG COMP LLIM 51 51 LOWER ERROR API0204311 CSRN51 TTAG COMP ULIM 61 61 UPPER ERROR API0204312 CSR 61 SETON 5163 API0204313 CSR 64 SETOF 63 API0204314 CSR ENDSR API020004315 C* API0204401 C********************************************************************API0204402 C* API0204403 C* THIS SUBROUTINE CHECKS FOR MISSING TAGS WITHIN THE LIMIT. API0204404 C* IF THE TAG EXCEEDS THE LIMIT ONE WAY OR ANOTHER, THIS API0204405 C* SUBROUTINE IS NOT PERFORMED. API0204406 C* API020004407 C* API0204408 C********************************************************************API0204409 CSR MISS BEGSR API0204410 CSR MTAG COMP ULIM 6665 API0204411 CSR 65 GOTO LEND API0204412 CSR MTAG COMP TTAG 6752 TAGS MISSING API0204413 CSRN52 GOTO LEND API020004414 CSR MOVE MTAG A 60 LOWER TAG GONE API0204415 CSR MOVE TTAG B 60 API0204416 CSR B SUB 1 B UPPER TAG GONE API0204417 CSR MOVE TTAG MTAG BEGIN SEQ AGAINAPI0204419 C* API0204501 CSR LEND TAG API02045020CSR 66 63 SETOF 52 004503 CSR 67 45035COR 65 SETON 68 4504 CSRN68 MTAG ADD 1 MTAG API0204505 CSR 63 SETON 64 ONLY DO ONCE API0204506 CSR ENDSR API0204507 C* API0204801 C********************************************************************API020004802 C* API0204803 C* THIS SUBROUTINE DISCOVERS DUPLICATE TAGS WITHOUT USE OF API0204804 C* LOOK AHEAD FIELDS. PREVIOUS INFORMATION MUST BE STORED SO API0204805 C* THAT THE FIRST DUPLICATE CAN BE PRINTED. API0204806 C* CHAIN OUT TO PARTMST TO GET THE DESCRIPTION OF ITEM. PI020 4807 C* API0204808 C* API020004809 C********************************************************************API0204810 C* API0204811 CSR DUPL BEGSR API0204812 CSRN53 SETOF 54 API0204813 CSR 02 TTAG COMP STAG 53 DUPLICATE TAG API0204814 CSR 53 SETON 54 PRINT TAG API0204901 CSR EXCPT PRINT API020004902 CSR TPART CHAINPARTMST 55 NOT FOUND 4903 CSR EXSR SAVE API0204904 C* API0204905 CSR ENDSR API0204906 C* API0205001 O$LP1 D 202 01 API0205002 O OR OFN1P API020005003 O 9 'PI020 ' 5004 O HEAD,1 54 5005 O 74 'DATE' API0205006 O UDATE Y 83 API0205007 O 90 'PAGE' API0205008 O PAGE Z 94 API0205009 O D 2 01 API020005010 O OR OFN1P API0205011 O 50 'DUPLICATE AND MISSING' API0205012 O 61 'TAG REPORT' API0205101 O D 2 01 API0205102 O OR OFN1P API0205103 O 15 'TAG LIMITS' API0205104 O LLIM 3 22 API020005105 O 26 'TO' API0205106 O ULIM 3 34 API0205107 O 35 '.' API0205108 O D 2 01 API0205109 O OR OFN1P API0205110 O 20 'MISSING TAG#' API0205111 O 59 'DUPLICATE TAG#' API020005112 O 107 'EXCEEDS LIMITS' API0205113 O 125 'SEQ #' PI020 5201 O E 1 54 API0205202 O STAG 3 40 API0205203 O SPART 51 API0205204 O SDESC B 85 API02052041O SEQ J 125 PI020 005205 O E 1 66 63 API0205206 O A 3 10 API0205207 O 16 'THRU' API0205208 O ULIM 3 24 API0205301 O E 1 51 API0205302 O TTAG 3 100 API02053021O SEQ J 125 PI020 005303 O E 1 52 API0205304 O A 3 10 API0205305 O 16 'THRU' API0205306 O B 3 24 API0205307 O* API0205312 O* API0205313 O D 1 03 API020005314 O DUM1 29 5315 O 55 '*** INVALID CARD TYPE' API02053151O SEQ J 125 PI020 ** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F /* __1O SEQ J 125 PI020 ** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0(; |IOTXPI665 P999999050178(000010H S PI665 00020X DECK-ID M54 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI665 00030F* UPDATE AVE, MTD, YTD USAGE AND PRODUCE COSTED INVENTORY REPORT PI665 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0PI665 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI665 00060F* CONTROL DATA PROPRIETARY PRODUCT PI665 00070F* PI665 0000080FPARTMST UPEAF 300 12AI 1 DISK PI665 00090F$LP1 O F 132 OF PRINTER U3 PI665 00100FHEADING IT F 40 EDISK PI665 00110F********************************************************************PI665 00120F* PI665 00130F* U4: M/E UPDATE UPDATES AVG & YTD PI665 00140F* ZERO OUT MTD PI665 0000150F* U2: ZERO OUT AVG PI665 00160F* PI665 00170F* U1: ZERO OUT YTD PI665 00180F* PI665 00190F* U3: PRINT OUT COSTED INVENTORY REPORT PI665 00200F* PI665 00210F********************************************************************PI665 0000220F* ID F C H L FUNCTION OF INDICATORS PI665 00230F* PI665 00240F* 01 PARTMST PI665 00250F* 02 PARTMST - DELETED RECORD PI665 00260F* PI665 00270F********************************************************************PI665 00280E HEADING HEAD 1 1 40 COMPANY NAME PI665 0000290IPARTMST NS 01 74 C PI665 00300I 1 12 PARTNO PI665 00310I 13 37 DESCR PI665 00320I 38 39 UM PI665 00330I 40 40 CLASS PI665 00340I 75 813STDMAT PI665 00350I 110 1163CUMLAB PI665 0000360I 117 1233CUMBUR PI665 00370I 124 1303CUMOP PI665 00380I 146 1520SOH PI665 00390I 196 2020MTD PI665 00400I 203 2090AVG PI665 00410I 210 2112ALPHA PI665 00420I 212 2180YTD PI665 0000430I NS 02 PI665 00440I 1 1 AIR PI665 00450C N01 GOTO FINI PI665 00460C* PI665 00470C TRYU4 TAG M/E UPDATE PI665 00480C NU4 GOTO TRYU2 PI665 00490C MTD SUB AVG SAVE1 70 PI665 0000500C SAVE1 MULT ALPHA SAVE2 70H PI665 00510C AVG ADD SAVE2 AVG PI665 00520C YTD ADD MTD YTD PI665 00530C Z-ADD0 MTD PI665 00540C* PI665 00550C TRYU2 TAG ZERO OUT AVG PI665 00560C NU2 GOTO TRYU1 PI665 0000570C Z-ADD0 AVG PI665 00580C* PI665 00590C TRYU1 TAG ZERO OUT YTD PI665 00600C NU1 GOTO TRYU3 PI665 00610C Z-ADD0 YTD PI665 00620C* PI665 00630C TRYU3 TAG PI665 0000640C NU3 GOTO FINI PI665 00650C STDMAT ADD CUMLAB UNCOST 73 PI665 00660C UNCOST ADD CUMBUR UNCOST PI665 00670C UNCOST ADD CUMOP UNCOST PI665 00680C SOH MULT UNCOST EXTCST 92H PI665 00690C TOTAL ADD EXTCST TOTAL 102 PI665 00700C* PI665 0000710C FINI TAG PI665 00720OPARTMST D 01 U1 PI665 00730O OR 01 U2 PI665 00740O OR 01 U4 PI665 00750O U1 YTD 218 PI665 00760O U4 YTD 218 PI665 00770O U2 AVG 209 PI665 0000780O U4 AVG 209 PI665 00790O U4 MTD 202 PI665 00800O$LP1 H 202 1P U3 PI665 00810O OR OF U3 PI665 00820O PAGE Z 10 PI665 00830O 4 'PAGE' PI665 00840O HEAD,1 85 PI665 0000850O UDATE Y 132 PI665 00860O H 2 1P U3 PI665 00870O OR OF U3 PI665 00880O 73 'COSTED INVENTORY REPORT' PI665 00890O 132 'MFG665' PI665 00900O H 2 1P U3 PI665 00910O OR OF U3 PI665 0000920O 6 'PART #' PI665 00930O 25 'DESCRIPTION' PI665 00940O 51 'CLS UM ALPH' PI665 00950O 61 'AVG USE' PI665 00960O 72 'MTD USE' PI665 00970O 83 'YTD USE' PI665 00980O 94 'SOH' PI665 0000990O 105 'UNIT COST' PI665 01000O 120 'EXTENDED COST' PI665 01010O D 1 01 U3 PI665 01020O PARTNO 12 PI665 01030O DESCR 39 PI665 01040O CLASS 42 PI665 01050O UM 46 PI665 0001060O ALPHA L 51 PI665 01070O AVG J 62 PI665 01080O MTD J 73 PI665 01090O YTD J 84 PI665 01100O SOH J 95 PI665 01110O UNCOSTJ 106 PI665 01120O EXTCSTJ 121 PI665 0001130O T 1 LR U3 PI665 01140O 120 '-------------' PI665 01150O T 1 LR U3 PI665 01160O 11 'END OF JOB.' PI665 01170O 106 'TOTAL' PI665 01180O TOTAL J 121 PI665 ** 00119000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001200ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001210ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001220ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001230/* 001240__0O TOTAL J 121 PI665 ** 0011900(^;K OTXPI650 P999999050178(000010H S PI650 00020X DECK-ID M53 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI650 00030F* THIS PROGRAM IS USED FOR STOCK STATUS LISTINGS PI650 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0PI650 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI650 00060F* CONTROL DATA PROPRIETARY PRODUCT PI650 00070F* PI650 0000080FPARTMST IPEAF 300 12AI 1 DISK PI650 00090FHEADING IT F 40 EDISK PI650 00100F$LP1 O F 132 OF PRINTER PI650 00110F********************************************************************PI650 00120F** PI650 00130F** PACKAGE MANUFACTURING PI650 00140F** SYSTEM INVENTORY TRANSACTION ACCOUNTING PI650 0000150F** PROGRAM STOCK STATUS & EXCEPTION STOCK STATUS PI650 00160F** PI650 00170F** CONTRACTOR COMPUSOURCE PI650 00180F** PROGRAMMER PI650 00190F** DATE PI650 00200F** PI650 00210F********************************************************************PI650 0000220F* PI650 00230F* NARRATIVE: IF U1 -> PRINT EXCEPTION REPORT PI650 00240F* NU1 -> PRINT REGULAR REPORT PI650 00250F* PI650 00260F* EXCEPTION REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT PI650 00270F* BY OPERATOR WITH A BLANK DELETE CODE AND WITH AVAIL < MIN. PI650 00280F* PI650 0000290F* REGULAR REPORT INCLUDES ALL RECORDS IN PRODUCT CLASS INPUT PI650 00300F* BY OPERATOR WITH A BLANK DELETE CODE. IF AVAIL < MIN, THEN PI650 00310F* RECORD IS FLAGGED WITH '**' AT END OF LINE ON PRINT OUT. PI650 00320F* PI650 00330F********************************************************************PI650 00340F* PI650 00350F* ID F C H L FUNCTION OF INDICATORS PI650 0000360F* PI650 00370F* 01 PARTMST -- CLASS = 'F' -- DELETE CODE BLANK PI650 00380F* 02 PARTMST -- CLASS = 'P' -- DELETE CODE BLANK PI650 00390F* 03 PARTMST -- CLASS = 'M' -- DELETE CODE BLANK PI650 00400F* 04 PARTMST -- ALL OTHERS PI650 00410F* PI650 00420F* 10 TAKE IN DATA FROM CRT PI650 0000430F* 11 'F'-TYPE INTERESTED IN IS 'F' PI650 00440F* 12 'P'-TYPE INTERESTED IN IS 'P' PI650 00450F* 13 'M'-TYPE INTERESTED IN IS 'M' PI650 00460F* 14 'A'-TYPE INTERESTED IN IS 'F'/'P'/'M' PI650 00470F* 15 AMONGST PRODUCT CLASS ARE INTERESTED IN PI650 00480F* 20 AVAIL < MIN PI650 00490F* 97 CRT LOOP WATCHER PI650 0000500F* 98 CRT LOOP WATCHER PI650 00510F* 99 DUMMY 1P PI650 00520F********************************************************************PI650 00530E HEADING HEAD 1 1 40 COMPANY NAME PI650 00540E MSG 1 9 56 CRT SCREEN PI650 00550E EMP9 1 9 BLANK PI650 00560IPARTMST NS 01 40 CF 74 C PI650 0000570I OR 02 40 CP 74 C PI650 00580I OR 03 40 CM 74 C PI650 00590I OR 04 PI650 00600I 1 12 PARTNO PI650 00610I 13 37 DESCRP PI650 00620I 38 39 UM PI650 00630I 40 40 CLASS PI650 0000640I 146 1520SOH PI650 00650I 153 1590SOO PI650 00660I 167 1730ALLOC PI650 00670I 181 1870MIN PI650 00680I 188 1940MAX PI650 00690I 196 2020MTDUSE PI650 00700I 203 2090AVGUSE PI650 0000710I 212 2180YTDUSE PI650 00720C SETOF 99 PI650 00730C 10 GOTO START PI650 00740C SETON 1099 PI650 00750C EXSR CRT PI650 00760C* PI650 00770C START TAG PI650 0000780C* CRT INPT/REC PI650 00790C SETOF 15 PI650 00800C 11 01 F/F PI650 00810COR 12 02 P/P PI650 00820COR 13 03 M/M PI650 00830COR 14 01 A/F PI650 00840COR 14 02 A/P PI650 0000850COR 14 03 SETON 15A/M PI650 00860C* PI650 00870C N15 GOTO NEXT PI650 00880C* PI650 00890C SOH ADD SOO AVAIL 70 PI650 00900C AVAIL SUB ALLOC AVAIL PI650 00910C* PI650 0000920C AVAIL COMP MIN 20 PI650 00930C* PI650 00940C NEXT TAG PI650 00950C* PI650 00960CLR EXSR CLRSCR PI650 00970C********************************************************************PI650 00980C* PI650 0000990C* THIS SUBROUTINE INQUIRES WHICH PRODUCT CLASS [OR ALL] PI650 01000C* IS TO BE LISTED. PI650 01010C* PI650 01020C* REPLY EFFECT PI650 01030C* ------- --------------------------------------------------- PI650 01040C* F ALL FINISHED GOODS NOT FLAGGED FOR DELETION PI650 01050C* P ALL PURCHASED GOODS NOT FLAGGED FOR DELETION PI650 0001060C* M ALL ASSEMBLIES NOT FLAGGED FOR DELETION PI650 01070C* A ALL GOODS NOT FLAGGED FOR DELETION PI650 01080C* PI650 01090C********************************************************************PI650 01100CSR CRT BEGSR PI650 01110CSR EXSR CLRSCR PI650 01120CSR Z-ADD0 I 20 PI650 0001130CSR LOOP1 TAG PI650 01140CSR I ADD 1 I PI650 01150CSR EXSR SETUP PI650 01160CSRNU1 I COMP 3 98 PI650 01170CSRNU1 98 MOVELEMP9,1 BUFFER PI650 01180CSR EXSR OUTS PI650 01190CSR I COMP 8 97 PI650 0001200CSR 97 GOTO LOOP1 PI650 01210C* PI650 01220CSR INPUT TAG PI650 01230CSR Z-ADD1404 CURPOS 40 PI650 01240CSR EXSR POSCUR PI650 01250CSR Z-ADD1 LNGTH 20 PI650 01260CSR EXSR ACCEPT PI650 0001270CSR MOVELBUFFER CHECK 1 PI650 01280CSR MOVEL']' BUFFER PI650 01290CSR EXSR OUTS PI650 01300CSR CHECK COMP 'F' 11FINISHED GOODS PI650 01310CSR CHECK COMP 'P' 12PURCHASED GOODSPI650 01320CSR CHECK COMP 'M' 13ASSEMBLIES PI650 01330CSR CHECK COMP 'A' 14ALL PI650 0001340CSR Z-ADD9 I PI650 01350CSR EXSR SETUP PI650 01360CSR 11 PI650 01370COR 12 PI650 01380COR 13 PI650 01390COR 14 MOVELEMP9,1 BUFFER PI650 01400CSR EXSR OUTS PI650 0001410CSRN11N12N13 PI650 01420CANN14 GOTO INPUT PI650 01430CSR ENDSR PI650 01440C********************************************************************PI650 01450C* PI650 01460C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. PI650 01470C* IT DEFINES ALL THE RLABL'S NECESSARY PI650 0001480C* PI650 01490C********************************************************************PI650 01500CSR CRTCOM BEGSR PI650 01510CSR EXITFSUBRCM PI650 01520CSR RLABL BUFFER 72 PI650 01530CSR RLABL TYPE 1 PI650 01540CSR RLABL BLNGTH 20 PI650 0001550CSR RLABL RCODE 1 PI650 01560CSR RLABL MASK 10 PI650 01570CSR RLABL DTYPE 10 PI650 01580CSR ENDSR PI650 01590C********************************************************************PI650 01600C* PI650 01610C* THIS SUBROUTINE SPLITS-UP CRT ARRAY ELEMENT, POSITIONS THE PI650 0001620C* CURSOR, AND STUFFS THE BUFFER. PI650 01630C* PI650 01640C********************************************************************PI650 01650CSR SETUP BEGSR PI650 01660CSR MOVELMSG,I WORD6 60 PI650 01670CSR MOVE MSG,I WORD50 50 PI650 01680CSR MOVELWORD6 CURPOS PI650 0001690CSR MOVE WORD6 LNGTH PI650 01700CSR EXSR POSCUR PI650 01710CSR MOVELWORD50 BUFFER PI650 01720CSR ENDSR PI650 01730C********************************************************************PI650 01740C* PI650 01750C* THIS SUBROUTINE CLEARS THE SCREEN. PI650 0001760C* PI650 01770C********************************************************************PI650 01780CSR CLRSCR BEGSR PI650 01790CSR MOVEL'C' TYPE PI650 01800CSR EXSR CRTCOM PI650 01810CSR ENDSR PI650 01820C********************************************************************PI650 0001830C* PI650 01840C* THIS SUBROUTINE POSITIONS THE CURSOR. PI650 01850C* PI650 01860C********************************************************************PI650 01870CSR POSCUR BEGSR PI650 01880CSR MOVELCURPOS BUFFER PI650 01890CSR MOVEL'P' TYPE PI650 0001900CSR EXSR CRTCOM PI650 01910CSR ENDSR PI650 01920C********************************************************************PI650 01930C* PI650 01940C* THIS SUBROUTINE ACCEPTS TYPE TO THE CRT FROM PI650 01950C* THE KEYBOARD. PI650 01960C* PI650 0001970C********************************************************************PI650 01980CSR ACCEPT BEGSR PI650 01990CSR MOVELLNGTH BLNGTH PI650 02000CSR MOVEL'A' TYPE PI650 02010CSR EXSR CRTCOM PI650 02020CSR ENDSR PI650 02030C********************************************************************PI650 0002040C* PI650 02050C* THIS SUBROUTINE OUTPUTS PRINT TO THE CRT AND PI650 02060C* REPOSITIONS THE CURSOR AT (BLNGTH + 1). PI650 02070C* PI650 02080C********************************************************************PI650 02090CSR OUTS BEGSR PI650 02100CSR MOVELLNGTH BLNGTH PI650 0002110CSR MOVEL'S' TYPE PI650 02120CSR EXSR CRTCOM PI650 02130CSR ENDSR PI650 02140C********************************************************************PI650 02150O$LP1 H 202 1P PI650 02160O OR OF PI650 02170O PAGE Z 8 PI650 0002180O 4 'PAGE' PI650 02190O HEAD,1 85 PI650 02200O UDATE Y 132 PI650 02210O H 2 99 PI650 02220O OR OF PI650 02230O U1 57 'EXCEPTION' PI650 02240O 71 'STOCK STATUS-' PI650 0002250O 11 85 'FINISHED GOODS' PI650 02260O 12 86 'PURCHASED GOODS' PI650 02270O 13 81 'ASSEMBLIES' PI650 02280O 14 74 'ALL' PI650 02290O 132 'MFG650' PI650 02300O H 3 99 PI650 02310O OR OF PI650 0002320O 11 'PART NUMBER' PI650 02330O 25 'DESCRIPTION' PI650 02340O 43 'CLS' PI650 02350O 46 'UM' PI650 02360O 55 'SOH' PI650 02370O 64 'SOO' PI650 02380O 73 'ALLOC' PI650 0002390O 82 'AVAIL' PI650 02400O 91 'MIN' PI650 02410O 100 'MAX' PI650 02420O 109 'MTD USE' PI650 02430O 118 'AVG USE' PI650 02440O 127 'YTD USE' PI650 02450O D 11 NU1 15 PI650 0002460O OR U1 20 15 PI650 02470O PARTNO 12 PI650 02480O DESCRP 39 PI650 02490O CLASS 42 PI650 02500O UM 46 PI650 02510O SOH L 56 PI650 02520O SOO L 65 PI650 0002530O ALLOC L 74 PI650 02540O AVAIL L 83 PI650 02550O MIN L 92 PI650 02560O MAX L 101 PI650 02570O MTDUSEL 110 PI650 02580O AVGUSEL 119 PI650 02590O YTDUSEL 128 PI650 0002600O NU1 15 20 132 '**' PI650 ** 002610ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002650** 00266000180132INVENTORY TRANSACTION ACCOUNTING 002670620106MFG650 002680190229EXCEPTION STOCK STATUS REPORT 002690030413PRINT OUT [ ] 002700030918F = FINISHED GOODS 002710031019P = PURCHASED GOODS 002720031114M = ASSEMBLIES 00273000031207A = ALL 002740170409**INVALID 002750/* 002760__13PRINT OUT [ ] 002700030918F = FINISHED GOODS 002710031019P = PURCHASED GOODS 002720031114M = ASSEMBLIES 0027300(d7 N*OTXPI035 P999999050178(000010H S PI035 00020X DECK-ID M33 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI035 00030F* THIS PROGRAM MERGERS TAGS AND OUTTAG INTO STAGS PI035 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI035 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI035 00060F* CONTROL DATA PROPRIETARY PRODUCT PI035 00070F* PI035 0000080FTAGS IP AF 32 DISK PI035 00090FOUTTAG IS AF 32 DISK PI035 00100FSTAGS O F 32 DISK PI035 00110E MSG 1 4 50 PI035 00120ITAGS NS 01 1 CT PI035 00130I 2 60TAGNO M1 PI035 00140I 1 32 RECORD PI035 0000150I NS 06 PI035 00160I 1 32 RECORD PI035 00170IOUTTAG NS 02 1 CT PI035 00180I 2 60TAGNO M1 PI035 00190I 1 32 RECORD PI035 00200I NS 07 PI035 00210I 1 32 RECORD PI035 0000220C N02 PI035 00230CORNMR GOTO END PI035 00240C* REPORT ERROR CONDITION AND REQUEST CANCEL PI035 00250C MOVEL'C' TYPE CLEAR SCREEN PI035 00260C Z-ADD1 BLNGTH PI035 00270C EXSR CRTCOM PI035 00280C MOVEL'T' TYPE PI035 0000290C MOVELMSG,1 BUFFER EXPLAIN PI035 00300C Z-ADD50 BLNGTH ERROR PI035 00310C EXSR CRTCOM SITUATION PI035 00320C MOVELMSG,2 BUFFER PI035 00330C EXSR CRTCOM PI035 00340C Z-ADD5 BLNGTH PI035 00350C MOVELTAGNO BUFFER SHOW DUP. TAG# PI035 0000360C EXSR CRTCOM PI035 00370C MOVELMSG,3 BUFFER REQUIRE PI035 00380C MOVEL'R' TYPE JOB PI035 00390C Z-ADD50 BLNGTH CANCEL-DOES PI035 00400C Z-ADD1 MASK NOT YET PI035 00410C EXSR CRTCOM WORK. PI035 00420C KILLIT TAG JUST IN CASE PI035 0000430C MOVELMSG,4 BUFFER IF SUBRCM PI035 00440C MOVEL'T' TYPE CANCEL FAILS, PI035 00450C Z-ADD50 BLNGTH THIS LOOP WILL PI035 00460C EXSR CRTCOM DO IT INSTEAD. PI035 00470C MOVEL'A' TYPE PI035 00480C Z-ADD1 BLNGTH PI035 00490C EXSR CRTCOM PI035 0000500C GOTO KILLIT PI035 00510C* PI035 00520C END TAG PI035 00530C* PI035 00540C* PI035 00550CSR CRTCOM BEGSR PI035 00560CSR EXITFSUBRCM PI035 0000570CSR RLABL BUFFER 80 PI035 00580CSR RLABL TYPE 1 PI035 00590CSR RLABL BLNGTH 20 PI035 00600CSR RLABL RCODE 1 PI035 00610CSR RLABL MASK 10 PI035 00620CSR RLABL DTYPE 10 PI035 00630CSR ENDSR PI035 0000640C* PI035 00650OSTAGS D 01 PI035 00660O OR 02NMR PI035 00670O RECORD 32 PI035 ** 000680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000690ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00070000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000710ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000720** MSG X 000730ERROR CONDITION HAS OCCURED IN PI035. X 000740THE FOLLOWING TAG NUMBER IS ON BOTH INPUT FILES X 000750ENTER 'C' TO CANCEL JOB,CORRECT PROBLEM,THEN RERUNX 000760MANUALLY CANCEL PROGRAM PI035!! X 00077000/* 000780__EQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000720** MSG X 000730ERROR CONDITION HAS OCCURED IN PI035. X 000740THE FOLLOWING TAG NUMBER IS ON BOTH INPUT FILES X 000750ENTER 'C' TO CANCEL JOB,CORRECT PROBLEM,THEN RERUNX 000760MANUALLY CANCEL PROGRAM PI035!! X 0007700(d >*OTXPI040 P999999050178(000010H S PI040 00020X DECK-ID M50 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI040 00030F* THIS PROGRAM ISSUES THE TAG LIST REPORT PI040 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI040 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI040 00060F* CONTROL DATA PROPRIETARY PRODUCT PI040 00070F* PI040 0000080FTAGS IPE F 32 DISK PI040 00090FPRINTER O F 132 OF LPRINTER PI040 00100FPARTMST IC F 300R12AI 1 DISK PI040 00110FHEADING IT F 40 EDISK PI040 00120E HEADING HEAD 1 1 40 PI040 00130LPRINTER 66FL 60OL PI040 00140ITAGS NS 01 1 CT PI040 0000150I 2 60TAGNO PI040 00160I 7 18 PARTNOL1 PI040 00170I 19 20 UM PI040 00180I 21 270QTY PI040 00190I NS 02 1NCT PI040 00200I 1 1 A PI040 00210IPARTMST NS 03 PI040 0000220I 13 37 DESC PI040 00230C 01 PARTNO CHAINPARTMST 50 NOT FOUND PI040 00240C 01 50 MOVEL'PART NOT'WORK 16 PI040 00250C 01 50 MOVE ' ON MSTR'WORK PI040 00260C U2 TQTY ADD QTY TQTY 90 PI040 00270OPRINTER H 102 OF PI040 00280O OR 1P PI040 0000290O UDATE Y 8 PI040 00300O HEAD 89 PI040 00310O 127 'PAGE' PI040 00320O PAGE Z 132 PI040 00330O H 1 OF PI040 00340O OR 1P PI040 00350O 5 'PI040' PI040 0000360O H 2 OF PI040 00370O OR 1P PI040 00380O 77 'INVENTORY TAG LIST' PI040 00390O U2 90 '(BY PART NO)' PI040 00400O H 2 OF PI040 00410O OR 1P PI040 00420O 16 'TAG NO.' PI040 0000430O 38 'PART NO.' PI040 00440O 69 'DESCRIPTION' PI040 00450O 91 'U/M' PI040 00460O 111 'QUANTITY' PI040 00470O D 1 01 PI040 00480O TAGNO Z 15 PI040 00490O PARTNO 40 PI040 0000500O N50 DESC 77 PI040 00510O 50 WORK 77 PI040 00520O UM 90 PI040 00530O QTY J 110 PI040 00540O T 12 L1 U2 PI040 00550O PARTNO 40 PI040 00560O TQTY JB 110 PI040 00** 000570ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000580ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000590ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000600ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000610/* 000620__0O TQTY JB 110 PI040 0(,; ?}OTXPI630 P999999050178(000010H S PI630 00020X DECK-ID M52 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI630 00030F* THIS PROGRAM PROCESSES TRANSACTIONS ONTO THE PARTMST FILE PI630 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0PI630 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI630 00060F* CONTROL DATA PROPRIETARY PRODUCT PI630 00070F* PI630 0000080FTRANWRK IPEAF 45 DISK PI630 00090FPARTMST UC F 300R12AI 1 DISK PI630 00100F********************************************************************PI630 00110F* PI630 00120F* PACKAGE MANUFACTURING PI630 00130F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING PI630 00140F* PI630 0000150F* CONTRACTOR COMPUSOURCE PI630 00160F* PROGRAMMER KATH HILL PI630 00170F* DATE OCTOBER 31, 1975 PI630 00180F* PI630 00190F********************************************************************PI630 00200F* PI630 00210F* NARRATIVE: USES TRANWRK RECORDS TO UPDATE PARTMST. PI630 0000220F* PI630 00230F********************************************************************PI630 00240F* PI630 00250F* ID F C H L FUNCTION OF INDICATORS PI630 00260F* PI630 00270F* 01 TRANTMP PI630 00280F* 02 PARTMST PI630 0000290F* PI630 00300F* 11 UNIT COST = 0 PI630 00310F* 12 DELETE CODE ON PARTMST BLANK PI630 00320F* PI630 00330F* 20 CHAIN TO PARTMST A MISS PI630 00340F* L1PART # PI630 00350F* PI630 0000360F********************************************************************PI630 00370ITRANWRK NS 01 PI630 00380I 1 12 PARTNOL1 PI630 00390I 13 140TRANNO PI630 00400I 15 210QTY PI630 00410I 22 28 REFNUM PI630 00420I 29 340TRANDT PI630 0000430I 35 413UNCOST 11 PI630 00440IPARTMST NS 02 PI630 00450I 74 74 DLTPR 12 PI630 00460C* ---------------PI630 00470C L1 PARTNO CHAINPARTMST 20 PI630 00480C L1N20N12 SETON 20 PI630 00490C 20 GOTO FINI PI630 0000500C* PI630 00510C* PI630 00520C Z-ADDQTY WORK 70 QTY INTO FLD PI630 00530C SV2 ADD WORK SV2 70 SOH PI630 00540C FINI TAG PI630 00550C********************************************************************PI630 00560OPARTMST T L1N20 PI630 0000570O SV2 B 152 PI630 ** 000580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000620/* 00063000__0O SV2 B 152 PI630 ** 000580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000620/* 0006300(d S*OTXPI043 P999999050178(000010H S PI043 00020X DECK-ID M79 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI043 00030F* THIS PROGRAM PRINTS THE QUANTITY VARIANCE REPORT PI043 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI043 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI043 00060F* CONTROL DATA PROPRIETARY PRODUCT PI043 00070F* PI043 0000080FTAGS IP AF 32 DISK PI043 00090FPARTMST IC F 300R12AI 1 DISK PI043 00100FHEADING IT F 40 EDISK PI043 00110F$LP1 O F 132 OF PRINTER PI043 00120F********************************************************************PI043 00130F* PI043 00140F* QUANTITY VARIANCE REPORT PI043 0000150F* PI043 00160F********************************************************************PI043 00170F* PI043 00180F* PI043 00190F********************************************************************PI043 00200F* ID F C H L FUNCTION OF INDICATORS PI043 00210F*01 'T' RECORD FROM TAGS PI043 0000220F*02 NON 'T' RECORD FROM TAGS PI043 00230F* 03 RECORD FROM PARTMST PI043 00240F* 51 PART # NOT ON MASTERFILE--ERROR PI043 00250F* 1P FIRST PAGE PI043 00260F* OF OVERFLOW PI043 00270F* L1 PART NUMBER LEVEL BREAK PI043 00280F* LR LAST RECORD PI043 0000290F********************************************************************PI043 00300E HEADING HEAD 1 1 40 PI043 00310ITAGS NS 02 1NCT PI043 00320I* PI043 00330I* PI043 00340I* PI043 00350I NS 01 PI043 0000360I 7 18 TPART L1 PI043 00370I 19 20 TUM PI043 00380I 21 270TQTY PI043 00390IPARTMST NS 03 PI043 00400I 13 37 DESC PI043 00410I 38 39 UM PI043 00420I 146 1520PQTY PI043 0000430I* PI043 00440C* PI043 00450C L1 TPART CHAINPARTMST 51 PI043 00460C 01N51 TQTY ADD L1QTY L1QTY 80 PI043 00470C* PI043 00480CL1N51 L1QTY SUB PQTY VAR 70 PI043 00490C* PI043 0000500C* PI043 00510O$LP1 H 102 1P PI043 00520O OR OFN1P PI043 00530O 9 'PI043 ' PI043 00540O HEAD,1 54 PI043 00550O 70 'DATE' PI043 00560O UDATE Y 79 PI043 0000570O 91 'PAGE' PI043 00580O PAGE Z 95 PI043 00590O H 2 1P PI043 00600O OR OFN1P PI043 00610O 58 'INVENTORY VARIANCE REPOR' PI043 00620O 59 'T' PI043 00630O H 2 1P PI043 0000640O OR OFN1P PI043 00650O 19 'PART NO.' PI043 00660O 38 'DESCRIPTION' PI043 00670O 66 'FILE QTY' PI043 00680O 83 'ACT QTY' PI043 00690O 91 'U/M' PI043 00700O 102 'VAR' PI043 0000710O T 1 L1N51 PI043 00720O TPART 22 PI043 00730O DESC 51 PI043 00740O PQTY J 65 PI043 00750O L1QTY JB 83 PI043 00760O TUM 91 PI043 00770O VAR L 102 PI043 00** 000780ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000790ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000800ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000810ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000820/* 000830__0O VAR L 102 PI043 0(d) *OTXPI050 P999999050178(000010H S PI050 00020X DECK-ID M51 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI050 00030F* THIS PROGRAM REFORMATS TAG FILE TO TRANWRK FILE FORMAT PI050 00040F* CYBER 18-10M/20 PHYSICAL INVENTORY VERSION 1.0PI050 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI050 00060F* CONTROL DATA PROPRIETARY PRODUCT PI050 00070F* PI050 0000080FSTAGS IP F 32 DISK PI050 00090FTRANWRK O F 45 DISK PI050 00100ISTAGS NS 01 1 CT PI050 00110I 2 60TAG PI050 00120I 7 18 PART PI050 00130I 21 270QTY PI050 00140I NS 02 1NCT PI050 0000150I 1 1 A PI050 00160OTRANWRK D 01 PI050 00170O PART 12 PI050 00180O 14 '88' PI050 00190O QTY 21 PI050 00200O TAG 27 PI050 00210O UDATE 34 PI050 00** 000220ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000230ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000240ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000250ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000260/* 000270__0O UDATE 34 PI050 0(kS ITXPI665 P<n091177111111(000010H S PI665 00020X DECK-ID M54 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI665 00030F* UPDATE AVE, MTD, YTD USAGE AND PRODUCE COSTED INVENTORY REPORT PI665 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0PI665 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI665 00060F* CONTROL DATA PROPRIETARY PRODUCT PI665 00070F* PI665 0000080FPARTMST UPEAF 300 20AI 271 DISK PI665 00090F$LP1 O F 132 OF PRINTER U3 PI665 00100FHEADING IT F 40 EDISK PI665 00110F********************************************************************PI665 00120F* PI665 00130F* U4: M/E UPDATE UPDATES AVG & YTD PI665 00140F* ZERO OUT MTD PI665 0000150F* U2: ZERO OUT AVG PI665 00160F* PI665 00170F* U1: ZERO OUT YTD PI665 00180F* PI665 00190F* U3: PRINT OUT COSTED INVENTORY REPORT PI665 00200F* PI665 00210F********************************************************************PI665 0000220F* ID F C H L FUNCTION OF INDICATORS PI665 00230F* PI665 00240F* 01 PARTMST PI665 00250F* 02 PARTMST - DELETED RECORD PI665 00260F* PI665 00270F********************************************************************PI665 00280E HEADING HEAD 1 1 40 COMPANY NAME PI665 0000290IPARTMST NS 01 74 C PI665 00300I 271 290 PARTNO PI665 00310I 1 37 DESCR PI665 00320I 38 39 UM PI665 00330I 40 40 CLASS PI665 00340I 75 813STDMAT PI665 00350I 110 1163CUMLAB PI665 0000360I 117 1233CUMBUR PI665 00370I 124 1303CUMOP PI665 00380I 146 1520SOH PI665 00390I 196 2020MTD PI665 00400I 203 2090AVG PI665 00410I 210 2112ALPHA PI665 00420I 212 2180YTD PI665 0000430I 160 1660MTDDIR 00440I 174 1800YTDDIR 00450I 261 2650AVGDIR 00460I NS 02 PI665 00470I 1 1 AIR PI665 00480C N01 GOTO FINI PI665 00490C* PI665 0000500C TRYU4 TAG M/E UPDATE PI665 00510C NU4 GOTO TRYU2 PI665 00520C MTD SUB AVG SAVE1 70 PI665 00530C SAVE1 MULT ALPHA SAVE2 70H PI665 00540C AVG ADD SAVE2 AVG PI665 00550C YTD ADD MTD YTD PI665 00560C Z-ADD0 MTD PI665 0000570C* PI665 00580C TRYU2 TAG ZERO OUT AVG PI665 00590C NU2 GOTO TRYU1 PI665 00600C Z-ADD0 AVG PI665 00610C* PI665 00620C TRYU1 TAG ZERO OUT YTD PI665 00630C NU1 GOTO TRYU3 PI665 0000640C Z-ADD0 YTD PI665 00650C* PI665 00660C TRYU3 TAG PI665 00670C NU3 GOTO FINI PI665 00680C STDMAT ADD CUMLAB UNCOST 73 PI665 00690C UNCOST ADD CUMBUR UNCOST PI665 00700C UNCOST ADD CUMOP UNCOST PI665 0000710C SOH MULT UNCOST EXTCST 92H PI665 00720C TOTAL ADD EXTCST TOTAL 102 PI665 00730C* PI665 00740C FINI TAG PI665 00750OPARTMST D 01 U1 PI665 00760O OR 01 U2 PI665 00770O OR 01 U4 PI665 0000780O U1 YTD 218 PI665 00790O U4 YTD 218 PI665 00800O U2 AVG 209 PI665 00810O U4 AVG 209 PI665 00820O U4 MTD 202 PI665 00830O$LP1 H 202 1P U3 PI665 00840O OR OF U3 PI665 0000850O PAGE Z 8 PI665 00860O 4 'PAGE' PI665 00870O HEAD,1 86 PI665 00880O UDATE Y 132 PI665 00890O H 2 1P U3 PI665 00900O OR OF U3 PI665 00910O 78 'COSTED INVENTORY REPORT' PI665 0000920O 132 'PI665' PI665 00930O H 1 1P U3 00940O OR OF U3 00950O 11 'PART NUMBER' 00960O H 2 1P U3 PI665 00970O OR OF U3 PI665 00980O 12 'DESCRIPTION' PI665 0000990O 51 'CLS UM ALPH' PI665 01000O 61 'AVG USE' PI665 01010O 72 'MTD USE' PI665 01020O 83 'YTD USE' PI665 01030O 94 'SOH' PI665 01040O 105 'UNIT COST' PI665 01050O 120 'EXTENDED COST' PI665 0001060O D 1 01 U3 01070O PARTNO 20 01080O AVGDIRJ 62 01090O MTDDIRJ 73 01100O YTDDIRJ 84 01110O 63 'D' 01120O 74 'D' 0001130O 85 'D' 01140O D 2 01 U3 PI665 01150O DESCR 38 PI665 01160O CLASS 42 PI665 01170O UM 46 PI665 01180O ALPHA L 51 PI665 01190O AVG J 62 PI665 0001200O MTD J 73 PI665 01210O YTD J 84 PI665 01220O SOH J 95 PI665 01230O UNCOSTJ 106 PI665 01240O EXTCSTJ 121 PI665 01250O 63 'M' 01260O 74 'M' 0001270O 85 'M' 01280O T 1 LR U3 PI665 01290O 120 '-------------' PI665 01300O T 1 LR U3 PI665 01310O 11 'END OF JOB.' PI665 01320O 106 'TOTAL' PI665 01330O TOTAL J 121 PI665 00** 001340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001350ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001380/* 001390_ 00 00 00 00 00 00__ 0(> J OTXOE020 P999999050278(000010H S OE020 00020X DECK-ID A47 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE020 00030F* THIS PROGRAM IS USED FOR INQUIRY/MAINTENANCE OF PARTMST FILE OE020 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE020 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE020 00060F* CONTROL DATA PROPRIETARY PRODUCT OE020 00070F* OE020 0000080FNULL IPEAF 72 DISK OE020 00090F@DIS20 IC F 32R DISK OE020 00100FPARTMST UC F 0300R12AI 0001 DISK A OE020 00110E FN 050 22 FIELD NAME OE020 00120E CP 050 4 CURSOR POSITION OE020 00130E LN 050 2 0 LENGTH OE020 00140E EP 050 4 0 ENDING POSITION OE020 0000150INULL NS 01 OE020 00160I 1 1 A OE020 00170I@DIS20 NS 02 OE020 00180I 1 22 FIELDN OE020 00190I 23 26 CURPOS OE020 00200I 27 280LNGTH OE020 00210I 29 310ENDPOS OE020 0000220IPARTMST NS 03 OE020 00230I 10256 RECORD OE020 00240I 2570300 LEFT01 OE020 00250C MOVE ' ' RCODE 1 OE020 00260C MOVE RCODE B22 22 OE020 00270C MOVE RCODE BLANKS 72 OE020 00280C MOVE RCODE FILLER 1 OE020 0000290C Z-ADD0 MASK 10 OE020 00300C SETON LR OE020 00310CLR Z-ADD050 SSIZE 30 OE020 00320CLR Z-ADD006 NSECT 30 OE020 00330CLR MOVEL'D' FF 1 OE020 00340CLR MOVE '[]<>' TEMP4 4 OE020 00350CLR START TAG OE020 0000360C* ********** OE020 00370CLR EXSR FIRSTP OE020 00380C* ********** OE020 00390CLR EXSR CLRSCR OE020 00400C* ********** OE020 00410CLR 40 GOTO EOJ OE020 00420C* ********** OE020 0000430CLR Z-ADD2 VL OE020 00440CLR MOVELSECTON VAR OE020 00450CLR EXSR RTADJ OE020 00460C* ********** OE020 00470CLR MOVELVAR SECTN 20 OE020 00480CLR EXSR GETSEC OE020 00490C* ********** OE020 0000500CLRN45 GOTO START OE020 00510C* ********** OE020 00520CLR EXSR CLRSCR OE020 00530C* ********** OE020 00540CLR EXSR OUTPUT OE020 00550C* ********** OE020 00560CLR EXSR UPDATE OE020 0000570C* ********** OE020 00580CLR GOTO START OE020 00590C* ********** OE020 00600CLR EOJ TAG OE020 00610C* ********** OE020 00620C********************************************************************OE020 00630C* OE020 0000640C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE020 00650C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE020 00660C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE020 00670C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE020 00680C* OE020 00690C********************************************************************OE020 00700CSR FIRSTP BEGSR OE020 0000710C* ********** OE020 00720CSR EXSR CLRSCR OE020 00730C* ********** OE020 00740CSR Z-ADD0 SECTN OE020 00750CSR EXSR GETSEC OE020 00760C* ********** OE020 00770CSR PGE TAG OE020 0000780C* ********** OE020 00790CSR SETON 61 OE020 00800CSR SETOF 62 OE020 00810CSR EXSR OUTPUT OE020 00820C* ********** OE020 00830C* ********** OE020 00840CSR EXIT SUBRFL OE020 0000850CSR RLABL RECORD OE020 00860CSR RLABL FILLER 1 OE020 00870C* ********** OE020 00880C* ********** OE020 00890CSR EXIT SUBRFL OE020 00900CSR RLABL LEFT01 OE020 00910CSR RLABL FILLER 1 OE020 0000920C* ********** OE020 00930C* ********** OE020 00940C* ********** OE020 00950C* ********** OE020 00960C* ********** OE020 00970C* ********** OE020 00980C* ********** OE020 0000990C* ********** OE020 01000C* ********** OE020 01010C* ********** OE020 01020C* ********** OE020 01030C* ********** OE020 01040C* ********** OE020 01050CSR Z-ADD12 NCHARS OE020 0001060CSR Z-ADD1 SSTRT OE020 01070CSR Z-ADD0001 TSTRT OE020 01080C* ********** OE020 01090CSR EXIT SUBRLM OE020 01100CSR RLABL KEY 12 OE020 01110CSR RLABL SSTRT 30 OE020 01120CSR RLABL RECORD OE020 0001130CSR RLABL TSTRT 30 OE020 01140CSR RLABL NCHARS 30 OE020 01150CSR Z-ADDNOFLDS SVFLDS 30 OE020 01160CSR Z-ADDSX NOFLDS OE020 01170CSR EXSR UPDATE OE020 01180C* ********** OE020 01190CSR Z-ADDSVFLDS NOFLDS OE020 0001200CSR Z-ADD12 NCHARS OE020 01210CSR Z-ADD0001 SSTRT OE020 01220CSR Z-ADD1 TSTRT OE020 01230C* ********** OE020 01240CSR EXIT SUBRLM OE020 01250CSR RLABL RECORD OE020 01260CSR RLABL SSTRT 30 OE020 0001270CSR RLABL KEY OE020 01280CSR RLABL TSTRT 30 OE020 01290CSR RLABL NCHARS 30 OE020 01300CSR KEY CHAINPARTMST 55 OE020 01310CSR MOVELSAVPOS BUFFER OE020 01320CSR MOVELOFC BUFFER OE020 01330CSR EXSR POSCUR OE020 0001340C* ********** OE020 01350CSR MOVEL'] NEW R'WORD16 16 OE020 01360CSR MOVE 'ECORD 'WORD16 OE020 01370CSRN55 MOVELBLANKS WORD16 OE020 01380CSRN55 MOVEL']' WORD16 OE020 01390CSR MOVELWORD16 BUFFER 72 OE020 01400CSR MOVE 'T' TYPE 1 OE020 0001410CSR Z-ADD13 BLNGTH 20 OE020 01420CSR EXSR CRTCOM OE020 01430C* ********** OE020 01440CSR SETON 62 OE020 01450CSR Z-ADDSX X 30 OE020 01460CSR EXSR ACCEPT OE020 01470C* ********** OE020 0001480CSR MOVELBUFFER SECTON 2 OE020 01490CSR SECTON COMP 'E ' 40 OE020 01500CSR 40 GOTO ENDFP OE020 01510C* ********** OE020 01520CSR SECTON COMP 'D ' 40 OE020 01530CSR 40N55 EXCPT OE020 01540CSR 40 GOTO PGE OE020 0001550C* ********** OE020 01560CSR SECTON COMP ' 1' 30 30 OE020 01570CSR 30 SECTON COMP ' 9' 3030 OE020 01580CSR 30 GOTO GOOD OE020 01590C* ********** OE020 01600CSR SECTON COMP '01' 30 30 OE020 01610CSR 30 SECTON COMP '09' 3030 OE020 0001620CSR 30 GOTO GOOD OE020 01630C* ********** OE020 01640CSR SECTON COMP '1 ' 30 30 OE020 01650CSR 30 SECTON COMP '9 ' 3030 OE020 01660CSR 30 GOTO GOOD OE020 01670C* ********** OE020 01680CSR MOVELSECTON TEMP1 1 OE020 0001690CSR TEMP1 COMP '1' 30 30 OE020 01700CSR 30 TEMP1 COMP '9' 3030 OE020 01710CSRN30 GOTO PGE OE020 01720C* ********** OE020 01730CSR MOVE SECTON TEMP1 OE020 01740CSR TEMP1 COMP '0' 30 30 OE020 01750CSR 30 TEMP1 COMP '9' 3030 OE020 0001760CSRN30 GOTO PGE OE020 01770C* ********** OE020 01780CSR GOOD TAG OE020 01790C* ********** OE020 01800CSR SETOF 6162 OE020 01810CSRN55 GOTO ENDFP OE020 01820C* ********** OE020 0001830CSR SETON 80 OE020 01840CSR EXCPT OE020 01850CSR SETOF 80 OE020 01860CSR KEY CHAINPARTMST 55 OE020 01870CSR ENDFP ENDSR OE020 01880C* ********** OE020 01890C********************************************************************OE020 0001900C* OE020 01910C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE020 01920C* OE020 01930C********************************************************************OE020 01940CSR GETSEC BEGSR OE020 01950C* ********** OE020 01960CSR 1 ADD SECTN N 20 OE020 0001970CSR SETOF 404145 OE020 01980CSR N COMP 0 3030 OE020 01990CSRN30 N COMP NSECT 30 OE020 02000CSR 30 GOTO ENDGET OE020 02010C* ********** OE020 02020CSR SECTN MULT SSIZE RRN 40 OE020 02030CSR Z-ADD1 X OE020 0002040CSR SCLOOP TAG OE020 02050C* ********** OE020 02060CSR RRN ADD 1 RRN OE020 02070CSR RRN CHAIN@DIS20 50 OE020 02080CSR 50 GOTO ENDGET OE020 02090C* ********** OE020 02100CSR FIELDN COMP B22 4141 OE020 0002110CSRN41 GOTO ENDGET OE020 02120C* ********** OE020 02130CSR 41N45 SETON 45 OE020 02140CSR MOVE FIELDN FN,X OE020 02150CSR MOVE CURPOS CP,X OE020 02160CSR MOVE LNGTH LN,X OE020 02170CSR Z-ADDENDPOS EP,X OE020 0002180CSR 1 ADD X X OE020 02190CSR X COMP SSIZE 32 OE020 02200CSRN32 GOTO SCLOOP OE020 02210C* ********** OE020 02220CSR ENDGET TAG OE020 02230C* ********** OE020 02240CSR Z-ADDX NOFLDS 30 OE020 0002250CSR 45 GOTO FINGET OE020 02260C* ********** OE020 02270CSR EXSR CLRSCR OE020 02280C* ********** OE020 02290CSR MOVEL'SECT # 'WORD9 9 OE020 02300CSR Z-ADD16 BLNGTH OE020 02310CSR MOVE SECTN WORD9 OE020 0002320CSR MOVELWORD9 WORD16 OE020 02330CSRN30 MOVE ' ABSENT' WORD16 OE020 02340CSR 30 MOVE ' ILLEG.' WORD16 OE020 02350CSR MOVELWORD16 BUFFER OE020 02360CSR MOVEL'T' TYPE OE020 02370CSR EXSR CRTCOM OE020 02380C* ********** OE020 0002390CSR FINGET ENDSR OE020 02400C* ********** OE020 02410C********************************************************************OE020 02420C* OE020 02430C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE020 02440C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE020 02450C* SECTION INDEX IS SAVED. OE020 0002460C* OE020 02470C********************************************************************OE020 02480CSR OUTPUT BEGSR OE020 02490C* ********** OE020 02500CSR EXSR CLRSCR OE020 02510C* ********** OE020 02520CSR Z-ADD1 X OE020 0002530CSR 61 SETON 63 OE020 02540CSR OTLOOP TAG OE020 02550C* ********** OE020 02560CSR 61 LN,X COMP 0 31 OE020 02570CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE020 02580CSR EXSR OUTFLD OE020 02590C* ********** OE020 0002600CSR X ADD 1 X OE020 02610CSR X COMP NOFLDS 31 OE020 02620CSR 31 GOTO OTLOOP OE020 02630C* ********** OE020 02640CSR SETOF 63 OE020 02650CSR ENDSR OE020 02660C********************************************************************OE020 0002670C* OE020 02680C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE020 02690C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE020 02700C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE020 02710C* THEN NO FIELD INFORMATION IS PRINTED OE020 02720C* OE020 02730C********************************************************************OE020 0002740CSR OUTFLD BEGSR OE020 02750C* ********** OE020 02760CSR MOVE FN,X FL 20 OE020 02770CSR EP,X COMP 0 98 OE020 02780CSR MOVELCP,X FC 20 OE020 02790CSR FC COMP FL 31 OE020 02800CSR 31 Z-ADDFC FL OE020 0002810CSR FC SUB FL CC 20 OE020 02820CSR CC ADD 1 CC OE020 02830CSR MOVELCP,X BUFFER OE020 02840CSR MOVELCC BUFFER OE020 02850CSR EXSR POSCUR OE020 02860C* ********** OE020 02870CSR MOVELBLANKS BUFFER OE020 0002880CSR MOVELFN,X FIELDN OE020 02890CSR MOVE ' ' FIELDN OE020 02900CSR MOVELFIELDN BUFFER OE020 02910CSR Z-ADDLN,X LEN 20 OE020 02920CSR LEN COMP 0 9730 OE020 02930CSR 97 Z-SUBLN,X LEN OE020 02940CSR 30 GOTO SKIPF OE020 0002950C* ********** OE020 02960CSR FL ADD 2 BPOS 20 OE020 02970C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE020 02980CSR Z-ADDBPOS TSTRT 30 OE020 02990CSRN98 Z-ADD1 SSTRT 30 OE020 03000CSR 98 Z-ADD3 SSTRT OE020 03010CSR Z-ADD1 NCHARS 30 OE020 0003020C* ********** OE020 03030CSR EXIT SUBRLM OE020 03040CSR RLABL TEMP4 OE020 03050CSR RLABL SSTRT 30 OE020 03060CSR RLABL BUFFER OE020 03070CSR RLABL TSTRT 30 OE020 03080CSR RLABL NCHARS 30 OE020 0003090CSR BPOS ADD 1 FPOS 20 OE020 03100CSR EXSR MVRECD OE020 03110C* ********** OE020 03120CSR SKIPF TAG OE020 03130C* ********** OE020 03140CSR 30 Z-ADDFL BLNGTH OE020 03150CSRN30 FL ADD 3 BLNGTH OE020 0003160CSRN30 BLNGTH ADD LEN BLNGTH OE020 03170CSR MOVE 'T' TYPE OE020 03180CSR EXSR CRTCOM OE020 03190C* ********** OE020 03200CSR ENDSR OE020 03210C********************************************************************OE020 03220C* OE020 0003230C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE020 03240C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE020 03250C* THE RIGHT BRACKET. OE020 03260C********************************************************************OE020 03270CSR MVRECD BEGSR OE020 03280C* ********** OE020 03290CSR 63 GOTO RBRK OE020 0003300C* ********** OE020 03310CSR 98 Z-SUBEP,X END 40 OE020 03320CSRN98 Z-ADDEP,X END OE020 03330CSR END SUB LEN STRT 40 81 81 OE020 03340CSR STRT ADD 1 STRT OE020 03350C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE020 03360C* FROM STRT IN RECORD TO FPOS IN BUFFER OE020 0003370CSR Z-ADDLEN NCHARS OE020 03380CSR Z-ADDSTRT SSTRT OE020 03390CSR Z-ADDFPOS TSTRT OE020 03400C* ********** OE020 03410CSRN81 GOTO RBRK OE020 03420CSR EXIT SUBRLM OE020 03430CSR RLABL RECORD OE020 0003440CSR RLABL SSTRT 30 OE020 03450CSR RLABL BUFFER OE020 03460CSR RLABL TSTRT 30 OE020 03470CSR RLABL NCHARS 30 OE020 03480CSR RBRK TAG OE020 03490C* ********** OE020 03500CSR EXSR RTBRKT OE020 0003510C* ********** OE020 03520CSR ENDSR OE020 03530C********************************************************************OE020 03540C* OE020 03550C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE020 03560C* OE020 03570C********************************************************************OE020 0003580CSR RTBRKT BEGSR OE020 03590C* ********** OE020 03600CSR LEN ADD FPOS FPOS OE020 03610CSR Z-ADDFPOS TSTRT OE020 03620CSR Z-ADD1 NCHARS OE020 03630CSRN98 Z-ADD2 SSTRT OE020 03640CSR 98 Z-ADD4 SSTRT OE020 0003650C* ********** OE020 03660CSR EXIT SUBRLM OE020 03670CSR RLABL TEMP4 OE020 03680CSR RLABL SSTRT 30 OE020 03690CSR RLABL BUFFER OE020 03700CSR RLABL TSTRT 30 OE020 03710CSR RLABL NCHARS 30 OE020 0003720CSR ENDSR OE020 03730C********************************************************************OE020 03740C* OE020 03750C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE020 03760C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE020 03770C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE020 03780C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE020 0003790C* OF THE FIELDS ARE LEFT UNCHANGED OE020 03800C* OE020 03810C********************************************************************OE020 03820CSR UPDATE BEGSR OE020 03830C* ********** OE020 03840CSR SETOF 32 OE020 03850CSR Z-ADD1 X OE020 0003860CSR UPLOOP TAG OE020 03870C* ********** OE020 03880CSR EP,X COMP 0 98 OE020 03890CSR 98 SETON 30 OE020 03900CSR 98 GOTO NOUPD OE020 03910C* ********** OE020 03920CSR Z-ADDLN,X LEN OE020 0003930CSR LEN COMP 0 9730 OE020 03940CSR 97 Z-SUBLEN LEN OE020 03950CSR NOUPD TAG OE020 03960C* ********** OE020 03970CSR 30N32 GOTO INCR OE020 03980C* ********** OE020 03990CSR 30 GOTO CHKRUB OE020 0004000C* ********** OE020 04010CSR SETOF 3233 OE020 04020CSR EXSR ACCEPT OE020 04030C* ********** OE020 04040CSR CHKRUB TAG OE020 04050C* ********** OE020 04060CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE020 0004070CSR 32 31 GOTO UPLOOP OE020 04080C* ********** OE020 04090CSR 32 GOTO ENDUPD OE020 04100C* ********** OE020 04110CSR MOVELBUFFER ATSIGN 1 OE020 04120CSR ATSIGN COMP '@' 35 OE020 04130CSR 35 GOTO OUTREC OE020 0004140C* ********** OE020 04150CSR 33 GOTO INCR WAS LINE FEED OE020 04160C* ********** OE020 04170CSR Z-ADDEP,X END OE020 04180CSR END SUB LEN STRT 81 81 OE020 04190CSR STRT ADD 1 STRT OE020 04200C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE020 0004210C* BUFFER TO THE STRT OF RECORD OE020 04220CSR Z-ADD1 SSTRT OE020 04230CSR Z-ADDSTRT TSTRT OE020 04240CSR Z-ADDLEN NCHARS OE020 04250C* ********** OE020 04260CSRN81 GOTO AAA OE020 04270CSR EXIT SUBRLM OE020 0004280CSR RLABL BUFFER OE020 04290CSR RLABL SSTRT 30 OE020 04300CSR RLABL RECORD OE020 04310CSR RLABL TSTRT 30 OE020 04320CSR RLABL NCHARS 30 OE020 04330CSR AAA TAG OE020 04340CSR MOVELBUFFER TEMP5 5 OE020 0004350CSR MOVELSAVPOS BUFFER OE020 04360CSR EXSR POSCUR OE020 04370C* ********** OE020 04380CSR MOVELTEMP5 BUFFER OE020 04390CSR Z-ADD1 FPOS OE020 04400CSR EXSR RTBRKT OE020 04410C* ********** OE020 0004420CSR LEN ADD 1 BLNGTH OE020 04430CSR MOVE 'T' TYPE OE020 04440CSR EXSR CRTCOM OE020 04450C* ********** OE020 04460CSR INCR TAG OE020 04470C* ********** OE020 04480CSR X ADD 1 X OE020 0004490CSR X COMP NOFLDS 30 OE020 04500CSR 30 GOTO UPLOOP OE020 04510C* ********** OE020 04520CSR OUTREC TAG OE020 04530C* ********** OE020 04540CSR SETON 80 OE020 04550CSRN61 EXCPT OE020 0004560CSR SETOF 80 OE020 04570CSR ENDUPD TAG OE020 04580C* ********** OE020 04590CSR ENDSR OE020 04600C********************************************************************OE020 04610C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE020 04620C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE020 0004630C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE020 04640C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE020 04650C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE020 04660C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE020 04670C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE020 04680C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE020 04690C* TO BE OUTPUT TO THE SCREEN. OE020 0004700C* OE020 04710C********************************************************************OE020 04720CSR ACCEPT BEGSR OE020 04730C* ********** OE020 04740CSR X COMP 1 30 OE020 04750CSRN30 X COMP SSIZE 30 OE020 04760CSR 30 Z-ADD1 X OE020 0004770CSR MOVELCP,X FC OE020 04780CSR FC ADD 3 FC OE020 04790CSR MOVELCP,X SAVPOS 4 OE020 04800CSR MOVELFC SAVPOS OE020 04810CSR Z-ADDLN,X LEN OE020 04820CSR LEN COMP 0 97 OE020 04830CSR 97 Z-SUBLEN LEN OE020 0004840CSR LEN ADD FC OFC 20 OE020 04850CSR ACLOOP TAG OE020 04860C* ********** OE020 04870CSR MOVELSAVPOS BUFFER OE020 04880CSR EXSR POSCUR OE020 04890C* ********** OE020 04900CSR Z-ADDLEN BLNGTH OE020 0004910CSR MOVE BLANKS BUFFER OE020 04920CSR MOVE 'A' TYPE OE020 04930CSR EXSR CRTCOM OE020 04940C* ********** OE020 04950CSR RCODE COMP 'R' 31 OE020 04960CSR 31 BUFFER COMP BLANKS 32 OE020 04970CSR 31 32N62 GOTO DUPIT OE020 0004980C* ********** OE020 04990CSR 31 GOTO ACLOOP OE020 05000C* ********** OE020 05010CSR RCODE COMP 'L' 33 OE020 05020CSR 33 GOTO DUPIT OE020 05030C* ********** OE020 05040CSRN97 GOTO ENDACC OE020 0005050C* ********** OE020 05060CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE020 05070CSR SIGN COMP '@' 30 OE020 05080CSR 30 GOTO ENDACC OE020 05090C* ********** OE020 05100CSR Z-ADDLEN VL 20 OE020 05110CSR MOVELBUFFER VAR 15 OE020 0005120CSR EXSR RTADJ OE020 05130C* ********** OE020 05140CSR MOVELVAR BUFFER OE020 05150CSR GOTO ENDACC OE020 05160C* ********** OE020 05170CSR DUPIT TAG OE020 05180C* ********** OE020 0005190CSR MOVELSAVPOS BUFFER OE020 05200CSR EXSR POSCUR OE020 05210C* ********** OE020 05220CSR 62 MOVELSECTON BUFFER OE020 05230CSRN62 Z-ADD1 FPOS OE020 05240CSRN62 EXSR MVRECD OE020 05250C* ********** OE020 0005260CSR MOVE 'T' TYPE OE020 05270CSR BLNGTH ADD 1 BLNGTH OE020 05280CSR EXSR CRTCOM OE020 05290C* ********** OE020 05300CSR ENDACC ENDSR OE020 05310C* ********** OE020 05320C********************************************************************OE020 0005330C* OE020 05340C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE020 05350C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE020 05360C* 4 DUMMY FOR RTADJ OE020 05370C* OE020 05380C********************************************************************OE020 05390CSR POSCUR BEGSR OE020 0005400C* ********** OE020 05410CSR MOVE 'P' TYPE OE020 05420CSR EXSR CRTCOM OE020 05430C* ********** OE020 05440CSR ENDSR OE020 05450C********************************************************************OE020 05460CSR CLRSCR BEGSR OE020 0005470C* ********** OE020 05480CSR MOVE 'C' TYPE OE020 05490CSR EXSR CRTCOM OE020 05500C* ********** OE020 05510CSR ENDSR OE020 05520C********************************************************************OE020 05530CSR CRTCOM BEGSR OE020 0005540C* ********** OE020 05550C* ********** OE020 05560CSR EXITFSUBRCM OE020 05570CSR RLABL BUFFER 72 OE020 05580CSR RLABL TYPE 1 OE020 05590CSR RLABL BLNGTH 20 OE020 05600CSR RLABL RCODE 1 OE020 0005610CSR RLABL MASK 10 OE020 05620CSR RLABL DTYPE 10 OE020 05630CSR ENDSR OE020 05640C********************************************************************OE020 05650CSR RTADJ BEGSR OE020 05660C* ********** OE020 05670CSR EXIT SUBRAJ OE020 0005680C* ********** OE020 05690CSR RLABL VL OE020 05700CSR RLABL VAR OE020 05710CSR ENDSR OE020 05720C********************************************************************OE020 05730OPARTMST E 80N55 OE020 05740O RECORD 0256 OE020 0005750O LEFT01 0300 OE020 05760O E 40N80 OE020 05770O FF 74 OE020 05780O EADD 80 55 OE020 05790O RECORD 0256 OE020 05800O LEFT01 0300 OE020 ** 00581000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005820ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005830ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005840ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005850/* 005860__0O LEFT01 0300 OE020 ** 0058100(l qOTXOE022 P999999050278(000010H S OE022 00020X DECK-ID A48 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE022 00030F* PRINTS ALL ACTIVE PARTS IF U1 OFF, PRINTS FINISHED GOODS IF U1 ON OE022 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE022 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE022 00060F* CONTROL DATA PROPRIETARY PRODUCT OE022 00070F* OE022 0000080FPARTMST IPEAF 300 12AI 1 DISK OE022 00090FHEADING IT F 40 EDISK OE022 00100F$LP1 O F 132 OF PRINTER OE022 00110F********************************************************************OE022 00120F* OE022 00130F* PACKAGE DISTRIBUTION OE022 00140F* SYSTEM FILE MAINTENANCE OE022 0000150F* PROGRAM LISTS OUT ALL RECORDS IN PARTMST NOT FLAGGED OE022 00160F* FOR DELETION. IF U1 IS ON PRINT FINISHED GOODS ONLY. OE022 00170F* OE022 00180F* CONTRACTOR COMPUSOURCE OE022 00190F* PROGRAMMER T. MCCULLY OE022 00200F* DATE MAY 4, 1976 OE022 00210F* OE022 0000220F********************************************************************OE022 00230F* OE022 00240F* ID F C H L FUNCTION OF INDICATORS OE022 00250F* OE022 00260F* 01 RECORD NOT FLAGGED FOR DELETION OE022 00270F* 02 RECORD IS FLAGGED FOR DELETION OE022 00280F* NU1 PRINT ALL PARTS OE022 0000290F* U1 PRINT FINISHED GOODS ONLY OE022 00300F* OE022 00310F********************************************************************OE022 00320E HEADING HEAD 1 1 40 COMPANY NAME OE022 00330E PRC 5 7 3 PRICES OE022 00340I********************************************************************OE022 00350IPARTMST NS 01 74 C OE022 0000360I 1 12 PARTNO OE022 00370I 13 37 DESCRP OE022 00380I 38 39 UM OE022 00390I 40 40 CLASS OE022 00400I 41 430GROUP OE022 00410I 44 460LEAD OE022 00420I 47 490SAFETY OE022 0000430I 50 50 ABC OE022 00440I 51 51 INVTRY OE022 00450I 57 610VNDNUM OE022 00460I 62 73 VPTNUM OE022 00470I 75 813MATDLS OE022 00480I 89 953LABDLS OE022 00490I 96 1023BURDLS OE022 0000500I 103 1093OPDLS OE022 00510I 131 1373LABHRS OE022 00520I 181 1870MINROP OE022 00530I 188 1940MAXEOQ OE022 00540I 195 195 MINMAX OE022 00550I 210 2112ALPHA OE022 00560I 219 219 REVLTR OE022 0000570I 220 2250REVDAT OE022 00580I 226 260 PRC OE022 00590I 261 2650BIN OE022 00600I NS 02 OE022 00610I 1 1 AIR OE022 00620C********************************************************************OE022 00630C U1 01 CLASS COMP 'F' 01 OE022 0000640C N01 OE022 00650CORNU1 GOTO XDT OE022 00660C* FINISHED GOODS OE022 00670C MATDLS ADD LABDLS UNCOST 73 PROCESSED HEREOE022 00680C BURDLS ADD UNCOST UNCOST OE022 00690C OPDLS ADD UNCOST UNCOST OE022 00700C XDT TAG OE022 0000710C 01 COUNT ADD 1 COUNT 80 OE022 00720O********************************************************************OE022 00730O$LP1 H 202 1P OE022 00740O OR OF OE022 00750O PAGE Z 10 OE022 00760O 4 'PAGE' OE022 00770O HEAD,1 85 OE022 0000780O UDATE Y 132 OE022 00790O***** BELOW IS ALL PARTS REPORT. OE022 00800O H 2 1PNU1 OE022 00810O OR OFNU1 OE022 00820O 74 'PART MASTER FILE LISTING' OE022 00830O 132 'DIS022' OE022 00840O H 1 1PNU1 OE022 0000850O OR OFNU1 OE022 00860O 6 'PART #' OE022 00870O 24 'DESCRIPTION' OE022 00880O 54 'UM ALP LT ABC' OE022 00890O 76 'VEND # REV LTR' OE022 00900O 84 'MIN' OE022 00910O 104 'MATL $ LABOR $' OE022 0000920O 114 'MIN/MAX' OE022 00930O 121 'BIN #' OE022 00940O H 1 1PNU1 OE022 00950O OR OFNU1 OE022 00960O 59 '--------------------' OE022 00970O 79 '--------------------' OE022 00980O 99 '--------------------' OE022 0000990O 114 '---------------' OE022 01000O 121 '-------' OE022 01010O H 2 1PNU1 OE022 01020O OR OFNU1 OE022 01030O 60 'CLS GRP SS INV VEND' OE022 01040O 76 'PART # REV DATE' OE022 01050O 94 'MAX BURDEN $' OE022 0001060O 114 'O.P. $ LAB HRS' OE022 01070O D 01 01NU1 OE022 01080O PARTNO 12 OE022 01090O DESCRP 38 OE022 01100O UM 42 OE022 01110O ALPHA L 47 OE022 01120O LEAD L 51 OE022 0001130O ABC 53 OE022 01140O VNDNUM 67 OE022 01150O REVLTR 76 OE022 01160O MINROPL 85 OE022 01170O MATDLSL 95 OE022 01180O LABDLSL 105 OE022 01190O MINMAX 114 OE022 0001200O BIN Z 121 OE022 01210O D 02 01NU1 OE022 01220O CLASS 42 OE022 01230O GROUP 46 OE022 01240O SAFETYL 51 OE022 01250O INVTRY 53 OE022 01260O VPTNUM 67 OE022 0001270O REVDATY 76 OE022 01280O MAXEOQL 85 OE022 01290O BURDLSL 95 OE022 01300O OPDLS L 105 OE022 01310O LABHRSL 115 OE022 01320O T 3 LRNU1 OE022 01330O 22 'END OF JOB. THERE ARE' OE022 0001340O COUNT 1 33 OE022 01350O 55 'ACTIVE RECORDS IN THE' OE022 01360O 73 'PART MASTER FILE.' OE022 01370O***** BELOW IS FINISHED GOODS REPORT. OE022 01380O H 2 OF U1 OE022 01390O OR 1P U1 OE022 01400O 74 'FINISHED GOODS LISTING' OE022 0001410O 132 'DIS022' OE022 01420O H 2 OF U1 OE022 01430O OR 1P U1 OE022 01440O 24 'PART # DESCRIPTION' OE022 01450O 60 'BIN # INV UNIT COST' OE022 01460O 87 'PRICE 1 PRICE 2 PRIC' OE022 01470O 110 'E 3 PRICE 4 PRICE 5' OE022 0001480O D 2 01 U1 OE022 01490O PARTNO 12 OE022 01500O DESCRP 38 OE022 01510O BIN Z 44 OE022 01520O INVTRY 48 OE022 01530O UNCOSTL 61 OE022 01540O PRC,1 L 71 OE022 0001550O PRC,2 L 81 OE022 01560O PRC,3 L 91 OE022 01570O PRC,4 L 101 OE022 01580O PRC,5 L 111 OE022 01590O T 3 LR U1 OE022 01600O 22 'END OF JOB. THERE ARE' OE022 01610O COUNT J 34 OE022 0001620O 58 'ACTIVE RECORDS WITH CLAS' OE022 01630O 80 'S - ''F'' IN THE PARTMST' OE022 01640O 86 'FILE.' OE022 ** 001650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00168000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001690/* 001700__0O 86 'FILE.' OE022 ** 001650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0016800(= DOTXOE040 P999999050278(000010H S OE040 00020X DECK-ID A50 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE040 00030F* INQUIRY AND MAINTENANCE OF SAMAST FILE OE040 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE040 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE040 00060F* CONTROL DATA PROPRIETARY PRODUCT OE040 00070F* OE040 0000080FNULL IPEAF 72 DISK OE040 00090F@DIS40 IC F 32R DISK OE040 00100FSAMAST UC F 0120R12AI 0001 DISK A OE040 00110E FN 030 22 FIELD NAME OE040 00120E CP 030 4 CURSOR POSITION OE040 00130E LN 030 2 0 LENGTH OE040 00140E EP 030 4 0 ENDING POSITION OE040 0000150INULL NS 01 OE040 00160I 1 1 A OE040 00170I@DIS40 NS 02 OE040 00180I 1 22 FIELDN OE040 00190I 23 26 CURPOS OE040 00200I 27 280LNGTH OE040 00210I 29 310ENDPOS OE040 0000220ISAMAST NS 03 OE040 00230I 10120 RECORD OE040 00240C MOVE ' ' RCODE 1 OE040 00250C MOVE RCODE B22 22 OE040 00260C MOVE RCODE BLANKS 72 OE040 00270C MOVE RCODE FILLER 1 OE040 00280C Z-ADD0 MASK 10 OE040 0000290C SETON LR OE040 00300CLR Z-ADD030 SSIZE 30 OE040 00310CLR Z-ADD003 NSECT 30 OE040 00320CLR MOVEL'D' FF 1 OE040 00330CLR MOVE '[]<>' TEMP4 4 OE040 00340CLR START TAG OE040 00350C* ********** OE040 0000360CLR EXSR FIRSTP OE040 00370C* ********** OE040 00380CLR EXSR CLRSCR OE040 00390C* ********** OE040 00400CLR 40 GOTO EOJ OE040 00410C* ********** OE040 00420CLR Z-ADD2 VL OE040 0000430CLR MOVELSECTON VAR OE040 00440CLR EXSR RTADJ OE040 00450C* ********** OE040 00460CLR MOVELVAR SECTN 20 OE040 00470CLR EXSR GETSEC OE040 00480C* ********** OE040 00490CLRN45 GOTO START OE040 0000500C* ********** OE040 00510CLR EXSR CLRSCR OE040 00520C* ********** OE040 00530CLR EXSR OUTPUT OE040 00540C* ********** OE040 00550CLR EXSR UPDATE OE040 00560C* ********** OE040 0000570CLR GOTO START OE040 00580C* ********** OE040 00590CLR EOJ TAG OE040 00600C* ********** OE040 00610C********************************************************************OE040 00620C* OE040 00630C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE040 0000640C* SECTION TO BE UPDATED. IT ALSO PRINTS ANY HEADER INFORMATION. OE040 00650C* IF THE RECORD IS NOT ON FILE THEN A NEW RECORD MESSAGE IS PRINTEDOE040 00660C* IF SECTION = 'R' THEN THE EMPLOYEE # IS ASKED FOR AGAIN OE040 00670C* OE040 00680C********************************************************************OE040 00690CSR FIRSTP BEGSR OE040 00700C* ********** OE040 0000710CSR EXSR CLRSCR OE040 00720C* ********** OE040 00730CSR Z-ADD0 SECTN OE040 00740CSR EXSR GETSEC OE040 00750C* ********** OE040 00760CSR PGE TAG OE040 00770C* ********** OE040 0000780CSR SETON 61 OE040 00790CSR SETOF 62 OE040 00800CSR EXSR OUTPUT OE040 00810C* ********** OE040 00820CSR EXIT SUBRFL OE040 00830C* ********** OE040 00840CSR RLABL RECORD OE040 0000850CSR RLABL FILLER 1 OE040 00860C* ********** OE040 00870C* ********** OE040 00880C* ********** OE040 00890C* ********** OE040 00900C* ********** OE040 00910C* ********** OE040 0000920C* ********** OE040 00930C* ********** OE040 00940C* ********** OE040 00950C* ********** OE040 00960C* ********** OE040 00970C* ********** OE040 00980C* ********** OE040 0000990C* ********** OE040 01000C* ********** OE040 01010CSR Z-ADD12 NCHARS OE040 01020CSR Z-ADD1 SSTRT OE040 01030CSR Z-ADD0001 TSTRT OE040 01040C* ********** OE040 01050CSR EXIT SUBRLM OE040 0001060CSR RLABL KEY 12 OE040 01070CSR RLABL SSTRT 30 OE040 01080CSR RLABL RECORD OE040 01090CSR RLABL TSTRT 30 OE040 01100CSR RLABL NCHARS 30 OE040 01110CSR Z-ADDNOFLDS SVFLDS 30 OE040 01120CSR Z-ADDSX NOFLDS OE040 0001130CSR EXSR UPDATE OE040 01140C* ********** OE040 01150CSR Z-ADDSVFLDS NOFLDS OE040 01160CSR Z-ADD12 NCHARS OE040 01170CSR Z-ADD0001 SSTRT OE040 01180CSR Z-ADD1 TSTRT OE040 01190C* ********** OE040 0001200CSR EXIT SUBRLM OE040 01210CSR RLABL RECORD OE040 01220CSR RLABL SSTRT 30 OE040 01230CSR RLABL KEY OE040 01240CSR RLABL TSTRT 30 OE040 01250CSR RLABL NCHARS 30 OE040 01260CSR KEY CHAINSAMAST 55 OE040 0001270CSR MOVELSAVPOS BUFFER OE040 01280CSR MOVELOFC BUFFER OE040 01290CSR EXSR POSCUR OE040 01300C* ********** OE040 01310CSR MOVEL'] NEW R'WORD16 16 OE040 01320CSR MOVE 'ECORD 'WORD16 OE040 01330CSRN55 MOVELBLANKS WORD16 OE040 0001340CSRN55 MOVEL']' WORD16 OE040 01350CSR MOVELWORD16 BUFFER 72 OE040 01360CSR MOVE 'T' TYPE 1 OE040 01370CSR Z-ADD13 BLNGTH 20 OE040 01380CSR EXSR CRTCOM OE040 01390C* ********** OE040 01400CSR SETON 62 OE040 0001410CSR Z-ADDSX X 30 OE040 01420CSR EXSR ACCEPT OE040 01430C* ********** OE040 01440CSR MOVELBUFFER SECTON 2 OE040 01450CSR SECTON COMP 'E ' 40 OE040 01460CSR 40 GOTO ENDFP OE040 01470C* ********** OE040 0001480CSR SECTON COMP 'D ' 40 OE040 01490CSR 40N55 EXCPT OE040 01500CSR 40 GOTO PGE OE040 01510C* ********** OE040 01520CSR SECTON COMP ' 1' 30 30 OE040 01530CSR 30 SECTON COMP ' 9' 3030 OE040 01540CSR 30 GOTO GOOD OE040 0001550C* ********** OE040 01560CSR SECTON COMP '01' 30 30 OE040 01570CSR 30 SECTON COMP '09' 3030 OE040 01580CSR 30 GOTO GOOD OE040 01590C* ********** OE040 01600CSR SECTON COMP '1 ' 30 30 OE040 01610CSR 30 SECTON COMP '9 ' 3030 OE040 0001620CSR 30 GOTO GOOD OE040 01630C* ********** OE040 01640CSR MOVELSECTON TEMP1 1 OE040 01650CSR TEMP1 COMP '1' 30 30 OE040 01660CSR 30 TEMP1 COMP '9' 3030 OE040 01670CSRN30 GOTO PGE OE040 01680C* ********** OE040 0001690CSR MOVE SECTON TEMP1 OE040 01700CSR TEMP1 COMP '0' 30 30 OE040 01710CSR 30 TEMP1 COMP '9' 3030 OE040 01720CSRN30 GOTO PGE OE040 01730C* ********** OE040 01740CSR GOOD TAG OE040 01750C* ********** OE040 0001760CSR SETOF 6162 OE040 01770CSRN55 GOTO ENDFP OE040 01780C* ********** OE040 01790CSR SETON 80 OE040 01800CSR EXCPT OE040 01810CSR SETOF 80 OE040 01820CSR KEY CHAINSAMAST 55 OE040 0001830CSR ENDFP ENDSR OE040 01840C* ********** OE040 01850C********************************************************************OE040 01860C* OE040 01870C* THIS ROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE040 01880C* OE040 01890C********************************************************************OE040 0001900CSR GETSEC BEGSR OE040 01910C* ********** OE040 01920CSR 1 ADD SECTN N 20 OE040 01930CSR SETOF 404145 OE040 01940CSR N COMP 0 3030 OE040 01950CSRN30 N COMP NSECT 30 OE040 01960CSR 30 GOTO ENDGET OE040 0001970C* ********** OE040 01980CSR SECTN MULT SSIZE RRN 40 OE040 01990CSR Z-ADD1 X OE040 02000CSR SCLOOP TAG OE040 02010C* ********** OE040 02020CSR RRN ADD 1 RRN OE040 02030CSR RRN CHAIN@DIS40 50 OE040 0002040CSR 50 GOTO ENDGET OE040 02050C* ********** OE040 02060CSR FIELDN COMP B22 4141 OE040 02070CSRN41 GOTO ENDGET OE040 02080C* ********** OE040 02090CSR 41N45 SETON 45 OE040 02100CSR MOVE FIELDN FN,X OE040 0002110CSR MOVE CURPOS CP,X OE040 02120CSR MOVE LNGTH LN,X OE040 02130CSR Z-ADDENDPOS EP,X OE040 02140CSR 1 ADD X X OE040 02150CSR X COMP SSIZE 32 OE040 02160CSRN32 GOTO SCLOOP OE040 02170C* ********** OE040 0002180CSR ENDGET TAG OE040 02190C* ********** OE040 02200CSR Z-ADDX NOFLDS 30 OE040 02210CSR 45 GOTO FINGET OE040 02220C* ********** OE040 02230CSR EXSR CLRSCR OE040 02240C* ********** OE040 0002250CSR MOVEL'SECT # 'WORD9 9 OE040 02260CSR Z-ADD16 BLNGTH OE040 02270CSR MOVE SECTN WORD9 OE040 02280CSR MOVELWORD9 WORD16 OE040 02290CSRN30 MOVE ' ABSENT' WORD16 OE040 02300CSR 30 MOVE ' ILLEG.' WORD16 OE040 02310CSR MOVELWORD16 BUFFER OE040 0002320CSR MOVEL'T' TYPE OE040 02330CSR EXSR CRTCOM OE040 02340C* ********** OE040 02350CSR FINGET ENDSR OE040 02360C* ********** OE040 02370C********************************************************************OE040 02380C* OE040 0002390C* THIS ROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE040 02400C* THAT OUTPUTS THEM. IF 'PAGE1' CALLED THIS ROUTINE THEN THE OE040 02410C* SECTION INDEX IS SAVED. OE040 02420C* OE040 02430C********************************************************************OE040 02440CSR OUTPUT BEGSR OE040 02450C* ********** OE040 0002460CSR EXSR CLRSCR OE040 02470C* ********** OE040 02480CSR Z-ADD1 X OE040 02490CSR 61 SETON 63 OE040 02500CSR OTLOOP TAG OE040 02510C* ********** OE040 02520CSR 61 LN,X COMP 0 31 OE040 0002530CSR 61 31 Z-ADDX SX 20 SEC FIELD INDEXOE040 02540CSR EXSR OUTFLD OE040 02550C* ********** OE040 02560CSR X ADD 1 X OE040 02570CSR X COMP NOFLDS 31 OE040 02580CSR 31 GOTO OTLOOP OE040 02590C* ********** OE040 0002600CSR SETOF 63 OE040 02610CSR ENDSR OE040 02620C********************************************************************OE040 02630C* OE040 02640C* THIS ROUTINE OUTPUTS THE FIELD NAMES,FIELD INFORMATION,AND OE040 02650C* BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD LENGTH IS 0 OE040 02660C* THEN ONLY THE FIELD NAME IS OUTPUT. IF PAGE1 ROUTINE CALLED THIS OE040 0002670C* THEN NO FIELD INFORMATION IS PRINTED OE040 02680C* OE040 02690C********************************************************************OE040 02700CSR OUTFLD BEGSR OE040 02710C* ********** OE040 02720CSR MOVE FN,X FL 20 OE040 02730CSR EP,X COMP 0 98 OE040 0002740CSR MOVELCP,X FC 20 OE040 02750CSR FC COMP FL 31 OE040 02760CSR 31 Z-ADDFC FL OE040 02770CSR FC SUB FL CC 20 OE040 02780CSR CC ADD 1 CC OE040 02790CSR MOVELCP,X BUFFER OE040 02800CSR MOVELCC BUFFER OE040 0002810CSR EXSR POSCUR OE040 02820C* ********** OE040 02830CSR MOVELBLANKS BUFFER OE040 02840CSR MOVELFN,X FIELDN OE040 02850CSR MOVE ' ' FIELDN OE040 02860CSR MOVELFIELDN BUFFER OE040 02870CSR Z-ADDLN,X LEN 20 OE040 0002880CSR LEN COMP 0 9730 OE040 02890CSR 97 Z-SUBLN,X LEN OE040 02900CSR 30 GOTO SKIPF OE040 02910C* ********** OE040 02920CSR FL ADD 2 BPOS 20 OE040 02930C* HERE WE MOVE A LEFT BRACKET INTO BUFFER AT BPOS OE040 02940CSR Z-ADDBPOS TSTRT 30 OE040 0002950CSRN98 Z-ADD1 SSTRT 30 OE040 02960CSR 98 Z-ADD3 SSTRT OE040 02970CSR Z-ADD1 NCHARS 30 OE040 02980C* ********** OE040 02990CSR EXIT SUBRLM OE040 03000CSR RLABL TEMP4 OE040 03010CSR RLABL SSTRT 30 OE040 0003020CSR RLABL BUFFER OE040 03030CSR RLABL TSTRT 30 OE040 03040CSR RLABL NCHARS 30 OE040 03050CSR BPOS ADD 1 FPOS 20 OE040 03060CSR EXSR MVRECD OE040 03070C* ********** OE040 03080CSR SKIPF TAG OE040 0003090C* ********** OE040 03100CSR 30 Z-ADDFL BLNGTH OE040 03110CSRN30 FL ADD 3 BLNGTH OE040 03120CSRN30 BLNGTH ADD LEN BLNGTH OE040 03130CSR MOVE 'T' TYPE OE040 03140CSR EXSR CRTCOM OE040 03150C* ********** OE040 0003160CSR ENDSR OE040 03170C********************************************************************OE040 03180C* OE040 03190C* THIS ROUTINE MOVES INFO FROM MASTER RECORD TO BUFFER AND THEN OE040 03200C* ADDS A RIGHT BRACKET.IF 61 IS ON NO INFO IS TRANSFERRED- JUST OE040 03210C* THE RIGHT BRACKET. OE040 03220C********************************************************************OE040 0003230CSR MVRECD BEGSR OE040 03240C* ********** OE040 03250CSR 63 GOTO RBRK OE040 03260C* ********** OE040 03270CSR 98 Z-SUBEP,X END 40 OE040 03280CSRN98 Z-ADDEP,X END OE040 03290CSR END SUB LEN STRT 40 81 81 OE040 0003300CSR STRT ADD 1 STRT OE040 03310C* HERE WE MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE040 03320C* FROM STRT IN RECORD TO FPOS IN BUFFER OE040 03330CSR Z-ADDLEN NCHARS OE040 03340CSR Z-ADDSTRT SSTRT OE040 03350CSR Z-ADDFPOS TSTRT OE040 03360C* ********** OE040 0003370CSRN81 GOTO RBRK OE040 03380CSR EXIT SUBRLM OE040 03390CSR RLABL RECORD OE040 03400CSR RLABL SSTRT 30 OE040 03410CSR RLABL BUFFER OE040 03420CSR RLABL TSTRT 30 OE040 03430CSR RLABL NCHARS 30 OE040 0003440CSR RBRK TAG OE040 03450C* ********** OE040 03460CSR EXSR RTBRKT OE040 03470C* ********** OE040 03480CSR ENDSR OE040 03490C********************************************************************OE040 03500C* OE040 0003510C* THIS ROUTINE INSERTS A ']' IN BUFFER AT FPOS OE040 03520C* OE040 03530C********************************************************************OE040 03540CSR RTBRKT BEGSR OE040 03550C* ********** OE040 03560CSR LEN ADD FPOS FPOS OE040 03570CSR Z-ADDFPOS TSTRT OE040 0003580CSR Z-ADD1 NCHARS OE040 03590CSRN98 Z-ADD2 SSTRT OE040 03600CSR 98 Z-ADD4 SSTRT OE040 03610C* ********** OE040 03620CSR EXIT SUBRLM OE040 03630CSR RLABL TEMP4 OE040 03640CSR RLABL SSTRT 30 OE040 0003650CSR RLABL BUFFER OE040 03660CSR RLABL TSTRT 30 OE040 03670CSR RLABL NCHARS 30 OE040 03680CSR ENDSR OE040 03690C********************************************************************OE040 03700C* OE040 03710C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE MASTER FILE. OE040 0003720C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE040 03730C* CHARACTERS WERE TYPED THEN THE CURSOR JUMPS TO THE BEGINNING OF OE040 03740C* THE PREVIOUS FIELD. IF THE 1ST CHAR IS AN '@' THEN THE REST OE040 03750C* OF THE FIELDS ARE LEFT UNCHANGED OE040 03760C* OE040 03770C********************************************************************OE040 03780CSR UPDATE BEGSR OE040 0003790C* ********** OE040 03800CSR SETOF 32 OE040 03810CSR Z-ADD1 X OE040 03820CSR UPLOOP TAG OE040 03830C* ********** OE040 03840CSR EP,X COMP 0 98 OE040 03850CSR 98 SETON 30 OE040 0003860CSR 98 GOTO NOUPD OE040 03870C* ********** OE040 03880CSR Z-ADDLN,X LEN OE040 03890CSR LEN COMP 0 9730 OE040 03900CSR 97 Z-SUBLEN LEN OE040 03910CSR NOUPD TAG OE040 03920C* ********** OE040 0003930CSR 30N32 GOTO INCR OE040 03940C* ********** OE040 03950CSR 30 GOTO CHKRUB OE040 03960C* ********** OE040 03970CSR SETOF 3233 OE040 03980CSR EXSR ACCEPT OE040 03990C* ********** OE040 0004000CSR CHKRUB TAG OE040 04010C* ********** OE040 04020CSR 32 X SUB 1 X 31 1ST CHAR-RUBOUTOE040 04030CSR 32 31 GOTO UPLOOP OE040 04040C* ********** OE040 04050CSR 32 GOTO ENDUPD OE040 04060C* ********** OE040 0004070CSR MOVELBUFFER ATSIGN 1 OE040 04080CSR ATSIGN COMP '@' 35 OE040 04090CSR 35 GOTO OUTREC OE040 04100C* ********** OE040 04110CSR 33 GOTO INCR WAS LINE FEED OE040 04120C* ********** OE040 04130CSR Z-ADDEP,X END OE040 0004140CSR END SUB LEN STRT 81 81 OE040 04150CSR STRT ADD 1 STRT OE040 04160C* HERE WE MOVE LEN NUMBER OF CHARS FROM THE BEGINNING OF OE040 04170C* BUFFER TO THE STRT OF RECORD OE040 04180CSR Z-ADD1 SSTRT OE040 04190CSR Z-ADDSTRT TSTRT OE040 04200CSR Z-ADDLEN NCHARS OE040 0004210C* ********** OE040 04220CSRN81 GOTO AAA OE040 04230CSR EXIT SUBRLM OE040 04240CSR RLABL BUFFER OE040 04250CSR RLABL SSTRT 30 OE040 04260CSR RLABL RECORD OE040 04270CSR RLABL TSTRT 30 OE040 0004280CSR RLABL NCHARS 30 OE040 04290CSR AAA TAG OE040 04300CSR MOVELBUFFER TEMP5 5 OE040 04310CSR MOVELSAVPOS BUFFER OE040 04320CSR EXSR POSCUR OE040 04330C* ********** OE040 04340CSR MOVELTEMP5 BUFFER OE040 0004350CSR Z-ADD1 FPOS OE040 04360CSR EXSR RTBRKT OE040 04370C* ********** OE040 04380CSR LEN ADD 1 BLNGTH OE040 04390CSR MOVE 'T' TYPE OE040 04400CSR EXSR CRTCOM OE040 04410C* ********** OE040 0004420CSR INCR TAG OE040 04430C* ********** OE040 04440CSR X ADD 1 X OE040 04450CSR X COMP NOFLDS 30 OE040 04460CSR 30 GOTO UPLOOP OE040 04470C* ********** OE040 04480CSR OUTREC TAG OE040 0004490C* ********** OE040 04500CSR SETON 80 OE040 04510CSRN61 EXCPT OE040 04520CSR SETOF 80 OE040 04530CSR ENDUPD TAG OE040 04540C* ********** OE040 04550CSR ENDSR OE040 0004560C********************************************************************OE040 04570C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE040 04580C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE040 04590C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC AND OE040 04600C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE040 04610C* WAS USED TO TERMINATE OPERATION THEN THE OPERATION IS RETRIED OE040 04620C* IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE INDICATOR 32 IS OE040 0004630C* SETON. IF A LINE FEED WAS USED THEN THE ORIGINAL FIELD INFO IS OE040 04640C* OUTPUT TO THE SCREEN. A NORMAL TERMINATION CAUSES THE NEW INFO OE040 04650C* TO BE OUTPUT TO THE SCREEN. OE040 04660C* OE040 04670C********************************************************************OE040 04680CSR ACCEPT BEGSR OE040 04690C* ********** OE040 0004700CSR X COMP 1 30 OE040 04710CSRN30 X COMP SSIZE 30 OE040 04720CSR 30 Z-ADD1 X OE040 04730CSR MOVELCP,X FC OE040 04740CSR FC ADD 3 FC OE040 04750CSR MOVELCP,X SAVPOS 4 OE040 04760CSR MOVELFC SAVPOS OE040 0004770CSR Z-ADDLN,X LEN OE040 04780CSR LEN COMP 0 97 OE040 04790CSR 97 Z-SUBLEN LEN OE040 04800CSR LEN ADD FC OFC 20 OE040 04810CSR ACLOOP TAG OE040 04820C* ********** OE040 04830CSR MOVELSAVPOS BUFFER OE040 0004840CSR EXSR POSCUR OE040 04850C* ********** OE040 04860CSR Z-ADDLEN BLNGTH OE040 04870CSR MOVE BLANKS BUFFER OE040 04880CSR MOVE 'A' TYPE OE040 04890CSR EXSR CRTCOM OE040 04900C* ********** OE040 0004910CSR RCODE COMP 'R' 31 OE040 04920CSR 31 BUFFER COMP BLANKS 32 OE040 04930CSR 31 32N62 GOTO DUPIT OE040 04940C* ********** OE040 04950CSR 31 GOTO ACLOOP OE040 04960C* ********** OE040 04970CSR RCODE COMP 'L' 33 OE040 0004980CSR 33 GOTO DUPIT OE040 04990C* ********** OE040 05000CSRN97 GOTO ENDACC OE040 05010C* ********** OE040 05020CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE040 05030CSR SIGN COMP '@' 30 OE040 05040CSR 30 GOTO ENDACC OE040 0005050C* ********** OE040 05060CSR Z-ADDLEN VL 20 OE040 05070CSR MOVELBUFFER VAR 15 OE040 05080CSR EXSR RTADJ OE040 05090C* ********** OE040 05100CSR MOVELVAR BUFFER OE040 05110CSR GOTO ENDACC OE040 0005120C* ********** OE040 05130CSR DUPIT TAG OE040 05140C* ********** OE040 05150CSR MOVELSAVPOS BUFFER OE040 05160CSR EXSR POSCUR OE040 05170C* ********** OE040 05180CSR 62 MOVELSECTON BUFFER OE040 0005190CSRN62 Z-ADD1 FPOS OE040 05200CSRN62 EXSR MVRECD OE040 05210C* ********** OE040 05220CSR MOVE 'T' TYPE OE040 05230CSR BLNGTH ADD 1 BLNGTH OE040 05240CSR EXSR CRTCOM OE040 05250C* ********** OE040 0005260CSR ENDACC ENDSR OE040 05270C* ********** OE040 05280C********************************************************************OE040 05290C* OE040 05300C* HERE WE HAVE 4 ROUTINES 1. POSITION CURSOR BY FIRST 4 BYTES OE040 05310C* IN BUFFER 2. CLEAR THE SCREEN 3 DUMMY FOR CRTCOM OE040 05320C* 4 DUMMY FOR RTADJ OE040 0005330C* OE040 05340C********************************************************************OE040 05350CSR POSCUR BEGSR OE040 05360C* ********** OE040 05370CSR MOVE 'P' TYPE OE040 05380CSR EXSR CRTCOM OE040 05390C* ********** OE040 0005400CSR ENDSR OE040 05410C********************************************************************OE040 05420CSR CLRSCR BEGSR OE040 05430C* ********** OE040 05440CSR MOVE 'C' TYPE OE040 05450CSR EXSR CRTCOM OE040 05460C* ********** OE040 0005470CSR ENDSR OE040 05480C********************************************************************OE040 05490CSR CRTCOM BEGSR OE040 05500C* ********** OE040 05510C* ********** OE040 05520CSR EXITFSUBRCM OE040 05530CSR RLABL BUFFER 72 OE040 0005540CSR RLABL TYPE 1 OE040 05550CSR RLABL BLNGTH 20 OE040 05560CSR RLABL RCODE 1 OE040 05570CSR RLABL MASK 10 OE040 05580CSR RLABL DTYPE 10 OE040 05590CSR ENDSR OE040 05600C********************************************************************OE040 0005610CSR RTADJ BEGSR OE040 05620C* ********** OE040 05630CSR EXIT SUBRAJ OE040 05640C* ********** OE040 05650CSR RLABL VL OE040 05660CSR RLABL VAR OE040 05670CSR ENDSR OE040 0005680C********************************************************************OE040 05690OSAMAST E 80N55 OE040 05700O RECORD 0120 OE040 05710O E 40N80 OE040 05720O FF 120 OE040 05730O EADD 80 55 OE040 05740O RECORD 0120 OE040 00** 005750ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005760ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005770ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005780ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005790/* 005800__0O RECORD 0120 OE040 0(? YPOTXOE042 P999999050278(000010H S OE042 00020X DECK-ID A51 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE042 00030F* PRINTS SALES ANALYSIS MASTER FILE (SAMAST) OE042 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE042 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE042 00060F* CONTROL DATA PROPRIETARY PRODUCT OE042 00070F* OE042 0000080FSAMAST IPEAF 120 12AI 1 DISK OE042 00090FHEADING IT F 40 EDISK OE042 00100F$LP1 O F 132 OF PRINTER OE042 00110F********************************************************************OE042 00120F* OE042 00130F* PACKAGE DISTRIBUTION OE042 00140F* SYSTEM FILE MAINTENANCE OE042 0000150F* PROGRAM LISTS SALES ANALYSIS MASTER FILE RECORDS THAT AREN'T OE042 00160F* FLAGGED FOR DELETION AND COUNTS THEM OE042 00170F* OE042 00180F* CONTRACTOR COMPUSOURCE OE042 00190F* PROGRAMMER KATHY HILL OE042 00200F* DATE OCTOBER 8, 1976 OE042 00210F* OE042 0000220F********************************************************************OE042 00230F* OE042 00240F* ID F C H L FUNCTION OF INDICATORS OE042 00250F* OE042 00260F* 01 SAMAST --> GOOD OE042 00270F* 02 SAMAST --> FLAGGED FOR DELETION OE042 00280F* OE042 0000290F* 20 SALES > 0 OE042 00300F* OE042 00310F********************************************************************OE042 00320E HEADING HEAD 1 1 40 COMPANY NAME OE042 00330E ARY 12 7 0 LAST 12 MONTHS OE042 00340ISAMAST NS 01 120 C OE042 00350I 1 12 PARTNO OE042 0000360I 13 190MTD OE042 00370I 22 105 ARY OE042 00380I 106 1130YTD OE042 00390I NS 02 OE042 00400I 1 1 DLTED OE042 00410C* OE042 00420C 01 CNT ADD 1 CNT 80 OE042 0000430C* OE042 00440C 01 XFOOTARY LAST12 100 OE042 00450C 01 LAST12 ADD MTD TOTAL 100 OE042 00460C 01 YTD ADD TOTAL TOTAL 20 OE042 00470C* OE042 00480O$LP1 H 202 1P OE042 00490O OR OF OE042 0000500O 4 'PAGE' OE042 00510O PAGE Z 10 OE042 00520O HEAD,1 85 OE042 00530O UDATE Y 132 OE042 00540O H 2 1P OE042 00550O OR OF OE042 00560O 62 'SALES ANALYSIS' OE042 0000570O 82 'MASTER FILE LISTING' OE042 00580O 132 'DIS042' OE042 00590O H 1 1P OE042 00600O OR OF OE042 00610O 23 'MTD SALES' OE042 00620O 39 'LAST 12 MONTHS' OE042 00630O 59 'PREVIOUS 12 MONTHS' OE042 0000640O H 2 1P OE042 00650O OR OF OE042 00660O 6 'PART #' OE042 00670O 23 'QUANTITY' OE042 00680O 39 'SALES QUANTITY' OE042 00690O 59 'SALES QUANTITY' OE042 00700O D 1 01 OE042 0000710O PARTNO 12 OE042 00720O MTD J 24 OE042 00730O LAST12J 40 OE042 00740O YTD J 60 OE042 00750O N20 87 '** THIS RECORD SHOULD BE' OE042 00760O N20 99 'DELETED! **' OE042 00770O T 21 LR OE042 0000780O 11 'END OF JOB.' OE042 00790O 23 'THERE WERE' OE042 00800O CNT 1 34 OE042 00810O 56 'ACTIVE RECORDS IN THE' OE042 00820O 71 'SALES ANALYSIS' OE042 00830O 84 'MASTER FILE.' OE042 ** 00084000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000850ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000860ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000870ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000880/* 000890__0O 84 'MASTER FILE.' OE042 ** 0008400(@F FGOTXOE052 P999999050278(000010H S OE052 00020X DECK-ID A53 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE052 00030F* PRINTS SALESMAN MASTER FILE (SLSMAN) OE052 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE052 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE052 00060F* CONTROL DATA PROPRIETARY PRODUCT OE052 00070F* OE052 0000080FSLSMAN IPEAF 30 3AI 1 DISK OE052 00090FHEADING IT F 40 EDISK OE052 00100F$LP1 O F 132 OF PRINTER OE052 00110F********************************************************************OE052 00120F* OE052 00130F* PACKAGE DISTRIBUTION OE052 00140F* SYSTEM FILE MAINTENANCE OE052 0000150F* PROGRAM LISTS SALESMAN MASTER FILE RECORDS THAT AREN'T FLAGGED OE052 00160F* FOR DELETION AND COUNTS THEM OE052 00170F* OE052 00180F* CONTRACTOR COMPUSOURCE OE052 00190F* PROGRAMMER KATHY HILL OE052 00200F* DATE OCTOBER 8, 1976 OE052 00210F* OE052 0000220F********************************************************************OE052 00230F* OE052 00240F* ID F C H L FUNCTION OF INDICATORS OE052 00250F* OE052 00260F* 01 SLSMAN --> GOOD OE052 00270F* 02 SLSMAN --> FLAGGED FOR DELETION OE052 00280F* OE052 0000290F********************************************************************OE052 00300F* OE052 00310E HEADING HEAD 1 1 40 COMPANY NAME OE052 00320ISLSMAN NS 01 30 C OE052 00330I 1 30MANNUM OE052 00340I 4 28 NAME OE052 00350I NS 02 OE052 0000360I 1 1 DLTED OE052 00370C* OE052 00380C 01 CNT ADD 1 CNT 80 OE052 00390C* OE052 00400O$LP1 H 202 1P OE052 00410O OR OF OE052 00420O 4 'PAGE' OE052 0000430O PAGE Z 10 OE052 00440O HEAD,1 85 OE052 00450O UDATE Y 132 OE052 00460O H 2 1P OE052 00470O OR OF OE052 00480O 59 'SALESMAN' OE052 00490O 79 'MASTER FILE LISTING' OE052 0000500O 132 'DIS052' OE052 00510O H 2 1P OE052 00520O OR OF OE052 00530O 10 'SALESMAN #' OE052 00540O 16 'NAME' OE052 00550O D 1 01 OE052 00560O MANNUM 10 OE052 0000570O NAME 37 OE052 00580O T 21 LR OE052 00590O 11 'END OF JOB.' OE052 00600O 23 'THERE WERE' OE052 00610O CNT 1 34 OE052 00620O 56 'ACTIVE RECORDS IN THE' OE052 00630O 65 'SALESMAN' OE052 0000640O 78 'MASTER FILE.' OE052 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000__0O 78 'MASTER FILE.' OE052 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 0007000(@ FGOTXOE062 P999999050278(000010H S OE062 00020X DECK-ID A55 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE062 00030F* PRINTS AREA MASTER FILE OE062 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE062 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE062 00060F* CONTROL DATA PROPRIETARY PRODUCT OE062 00070F* OE062 0000080FAREA IPEAF 30 2AI 1 DISK OE062 00090FHEADING IT F 40 EDISK OE062 00100F$LP1 O F 132 OF PRINTER OE062 00110F********************************************************************OE062 00120F* OE062 00130F* PACKAGE DISTRIBUTION OE062 00140F* SYSTEM FILE MAINTENANCE OE062 0000150F* PROGRAM LISTS AREA MASTER FILE RECORDS THAT AREN'T FLAGGED FOR OE062 00160F* DELETION AND COUNTS THEM OE062 00170F* OE062 00180F* CONTRACTOR COMPUSOURCE OE062 00190F* PROGRAMMER KATHY HILL OE062 00200F* DATE OCTOBER 8, 1976 OE062 00210F* OE062 0000220F********************************************************************OE062 00230F* OE062 00240F* ID F C H L FUNCTION OF INDICATORS OE062 00250F* OE062 00260F* 01 AREA --> GOOD OE062 00270F* 02 AREA --> FLAGGED FOR DELETION OE062 00280F* OE062 0000290F********************************************************************OE062 00300F* OE062 00310E HEADING HEAD 1 1 40 COMPANY NAME OE062 00320IAREA NS 01 30 C OE062 00330I 1 2 AREACD OE062 00340I 3 27 NAME OE062 00350I NS 02 OE062 0000360I 1 1 DLTED OE062 00370C* OE062 00380C 01 CNT ADD 1 CNT 80 OE062 00390C* OE062 00400O$LP1 H 202 1P OE062 00410O OR OF OE062 00420O 4 'PAGE' OE062 0000430O PAGE Z 10 OE062 00440O HEAD,1 85 OE062 00450O UDATE Y 132 OE062 00460O H 2 1P OE062 00470O OR OF OE062 00480O 57 'AREA' OE062 00490O 77 'MASTER FILE LISTING' OE062 0000500O 132 'DIS062' OE062 00510O H 2 1P OE062 00520O OR OF OE062 00530O 9 'AREA CODE' OE062 00540O 15 'NAME' OE062 00550O D 1 01 OE062 00560O AREACD 6 OE062 0000570O NAME 36 OE062 00580O T 21 LR OE062 00590O 11 'END OF JOB.' OE062 00600O 23 'THERE WERE' OE062 00610O CNT 1 34 OE062 00620O 56 'ACTIVE RECORDS IN THE' OE062 00630O 61 'AREA' OE062 0000640O 74 'MASTER FILE.' OE062 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000__0O 74 'MASTER FILE.' OE062 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 0007000(@ FGOTXOE072 P999999050278(000010H S OE072 00020X DECK-ID A57 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE072 00030F* PRINTS TERMS MASTER FILE OE072 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE072 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE072 00060F* CONTROL DATA PROPRIETARY PRODUCT OE072 00070F* OE072 0000080FTERMS IPEAF 30 1AI 1 DISK OE072 00090FHEADING IT F 40 EDISK OE072 00100F$LP1 O F 132 OF PRINTER OE072 00110F********************************************************************OE072 00120F* OE072 00130F* PACKAGE DISTRIBUTION OE072 00140F* SYSTEM FILE MAINTENANCE OE072 0000150F* PROGRAM LISTS PAYMENT TERMS MASTER FILE RECORDS THAT AREN'T OE072 00160F* FLAGGED FOR DELETION AND COUNTS THEM OE072 00170F* OE072 00180F* CONTRACTOR COMPUSOURCE OE072 00190F* PROGRAMMER KATHY HILL OE072 00200F* DATE OCTOBER 8, 1976 OE072 00210F* OE072 0000220F********************************************************************OE072 00230F* OE072 00240F* ID F C H L FUNCTION OF INDICATORS OE072 00250F* OE072 00260F* 01 TERMS --> GOOD OE072 00270F* 02 TERMS --> FLAGGED FOR DELETION OE072 00280F* OE072 0000290F********************************************************************OE072 00300F* OE072 00310E HEADING HEAD 1 1 40 COMPANY NAME OE072 00320ITERMS NS 01 30 C OE072 00330I 1 1 TRMSCD OE072 00340I 2 26 PYMTTM OE072 00350I NS 02 OE072 0000360I 1 1 DLTED OE072 00370C* OE072 00380C 01 CNT ADD 1 CNT 80 OE072 00390C* OE072 00400O$LP1 H 202 1P OE072 00410O OR OF OE072 00420O 4 'PAGE' OE072 0000430O PAGE Z 10 OE072 00440O HEAD,1 85 OE072 00450O UDATE Y 132 OE072 00460O H 2 1P OE072 00470O OR OF OE072 00480O 62 'PAYMENT TERMS' OE072 00490O 82 'MASTER FILE LISTING' OE072 0000500O 132 'DIS072' OE072 00510O H 2 1P OE072 00520O OR OF OE072 00530O 10 'TERMS CODE' OE072 00540O 25 'PAYMENT TERMS' OE072 00550O D 1 01 OE072 00560O TRMSCD 6 OE072 0000570O PYMTTM 37 OE072 00580O T 21 LR OE072 00590O 11 'END OF JOB.' OE072 00600O 23 'THERE WERE' OE072 00610O CNT 1 34 OE072 00620O 56 'ACTIVE RECORDS IN THE' OE072 00630O 70 'PAYMENT TERMS' OE072 0000640O 83 'MASTER FILE.' OE072 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 00070000__0O 83 'MASTER FILE.' OE072 ** 000650ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000660ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000670ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000680ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000690/* 0007000(mR ';OTXOE081 P999999050278(000010H S OE081 00020X DECK-ID A99 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE081 00030F* COPIES A TEMPORARY PURGED MASTER FILE TO THE MASTER FILE OE081 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE081 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE081 00060F* CONTROL DATA PROPRIETARY PRODUCT OE081 00070F* OE081 0000080FPAROUT IPEAF 300 DISK OE081 00090FPARTMST O F 300 12AI 1 DISK OE081 00100F********************************************************************OE081 00110F* OE081 00120F* COMPANY OE081 00130F* SYSTEM FILE MAINTENANCE OE081 00140F* PROGRAM COPIES BACK A PURGED MASTER FILE OE081 0000150F* OE081 00160F* CONTRACTOR COMPUSOURCE OE081 00170F* PROGRAMMER OE081 00180F* DATE OE081 00190F* OE081 00200F********************************************************************OE081 00210F* OE081 0000220F* OE081 00230F* ID F C H L FUNCTION OF INDICATORS OE081 00240F* OE081 00250F* 01 PAROUT OE081 00260F* OE081 00270F********************************************************************OE081 00280IPAROUT NS 01 OE081 0000290I 1 200 A OE081 00300I 201 300 B OE081 00310OPARTMST D 01 OE081 00320O A 200 OE081 00330O B 300 OE081 ** 000340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00035000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000360ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000370ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000380/* 000390__0O B 300 OE081 ** 000340ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0003500(A {`OTXOE080 P999999050278(000010H S OE080 00020X DECK-ID A58 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE080 00030F* PURGES MASTER FILES OF R5CORDS FLAGGED FOR DELETION OE080 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE080 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE080 00060F* CONTROL DATA PROPRIETARY PRODUCT OE080 00070F* OE080 0000080FPARTMST IPEAF 300 DISK U1 OE080 00090FSLSMAN ISEAF 30 DISK U2 OE080 00100FAREA ISEAF 30 DISK U3 OE080 00110FTERMS ISEAF 30 DISK U4 OE080 00120FSAMAST ISEAF 120 DISK U7 OE080 00130FARMAST ISEAF 280 DISK U8 OE080 00140FPAROUT O F 300 DISK U1 OE080 0000150FSMNOUT O F 30 3AI 1 DISK U2 OE080 00160FARAOUT O F 30 2AI 1 DISK U3 OE080 00170FTRMOUT O F 30 1AI 1 DISK U4 OE080 00180FSAOUT O F 120 12AI 1 DISK U7 OE080 00190FAROUT O F 280 6AI 1 DISK U8 OE080 00200F$LP1 O F 132 OF PRINTER OE080 00210F********************************************************************OE080 0000220F* OE080 00230F* PACKAGE DISTRIBUTION OE080 00240F* SYSTEM FILE MAINTENANCE OE080 00250F* PROGRAM PURGES MASTER FILES OF RECORDS FLAGGED FOR DELETION OE080 00260F* OE080 00270F* CONTRACTOR COMPUSOURCE OE080 00280F* PROGRAMMER KATHY HILL OE080 0000290F* DATE MARCH 16, 1976 OE080 00300F* OE080 00310F********************************************************************OE080 00320F* OE080 00330F* U1 PARTMST OE080 00340F* U2 SLSMAN OE080 00350F* U3 AREA OE080 0000360F* U4 TERMS OE080 00370F* U7 SAMAST OE080 00380F* U8 ARMAST OE080 00390F* OE080 00400F********************************************************************OE080 00410F* OE080 00420F* ID F C H L FUNCTION OF INDICATORS OE080 0000430F* OE080 00440F* 01 PARTMST KEEP OE080 00450F* 02 PARTMST DELETE OE080 00460F* 03 SAMAST KEEP OE080 00470F* 04 SAMAST DELETE OE080 00480F* 05 ARMAST KEEP OE080 00490F* 06 ARMAST DELETE OE080 0000500F* 07 SLSMAN KEEP OE080 00510F* 08 SLSMAN DELETE OE080 00520F* 09 AREA KEEP OE080 00530F* 10 AREA DELETE OE080 00540F* 11 TERMS KEEP OE080 00550F* 12 TERMS DELETE OE080 00560F* OE080 0000570F********************************************************************OE080 00580IPARTMST NS 01 74 C OE080 00590I 1 200 A1 OE080 00600I 201 300 A2 OE080 00610I NS 02 OE080 00620I 1 12 X1 OE080 00630ISAMAST NS 03 120 C OE080 0000640I 1 120 B1 OE080 00650I NS 04 OE080 00660I 1 12 X2 OE080 00670IARMAST NS 05 115 C OE080 00680I 1 200 C1 OE080 00690I 201 280 C2 OE080 00700I NS 06 OE080 0000710I 1 60X3 OE080 00720ISLSMAN NS 07 30 C OE080 00730I 1 30 D1 OE080 00740I NS 08 OE080 00750I 1 30X4 OE080 00760IAREA NS 09 30 C OE080 00770I 1 30 E1 OE080 0000780I NS 10 OE080 00790I 1 2 X7 OE080 00800ITERMS NS 11 30 C OE080 00810I 1 30 F1 OE080 00820I NS 12 OE080 00830I 1 1 X8 OE080 00840OPAROUT D 01 OE080 0000850O A1 200 OE080 00860O A2 300 OE080 00870OSAOUT D 03 OE080 00880O B1 120 OE080 00890OAROUT D 05 OE080 00900O C1 200 OE080 00910O C2 280 OE080 0000920OSMNOUT D 07 OE080 00930O D1 30 OE080 00940OARAOUT D 09 OE080 00950O E1 30 OE080 00960OTRMOUT D 11 OE080 00970O F1 30 OE080 00980O$LP1 H 202 1P OE080 0000990O OR OF OE080 01000O U1 15 'PARTMST DELETES' OE080 01010O U2 14 'SLSMAN DELETES' OE080 01020O U3 12 'AREA DELETES' OE080 01030O U4 13 'TERMS DELETES' OE080 01040O U7 14 'SAMAST DELETES' OE080 01050O U8 14 'ARMAST DELETES' OE080 0001060O D 1 02 OE080 01070O OR 04 OE080 01080O OR 06 OE080 01090O OR 08 OE080 01100O OR 10 OE080 01110O OR 12 OE080 01120O U1X1 12 OE080 0001130O U7X2 12 OE080 01140O U8X3 6 OE080 01150O U2X4 3 OE080 01160O U3X7 2 OE080 01170O U4X8 1 OE080 ** 001180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00119000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001210ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001220/* 001230__0O U4X8 1 OE080 ** 001180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0011900(A XTXOE012 P`999999032778(000010H S OE012 00020X DECK-ID A46 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE012 00030F* PRINTS CUSTOMER LIST FROM ARMAST OE012 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE012 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE012 00060F* CONTROL DATA PROPRIETARY PRODUCT OE012 00070F* OE012 0000080F********************************************************************OE012 00090F* *OE012 00100F* PACKAGE- DISTRIBUTION CONTRACTOR- COMPUSOURCE *OE012 00110F* SYSTEM- PROGRAMMER- T. MCCULLY *OE012 00120F* PROGRAM- CUSTOMER FILE LIST DATE- 5/04/76 *OE012 00130F* *OE012 00140F* DESCRIPTION- PRINT ARMAST FILE. OMIT DELETE CODED RECORDS & *OE012 0000150F* PUT CITY, STATE & ZIP ON LINE 2 IF ADDRESS LINE 2 IS BLANK.*OE012 00160F* *OE012 00170F* *OE012 00180F********************************************************************OE012 00190F* ID F C H L FUNCTION OF INDICATORS OE012 00200F* 01 ACTIVE CUSTOMER RECORD (NOT DELETE CODED) OE012 00210F* 12 ADDRESS LINE 2 IS BLANK PRINT CITY, STATE & ZIP ON OE012 0000220F* LINE 2 INSTEAD OF ON LINE 3. OE012 00230F* 02 DELETE CODED RECORD DO NOT PRINT OR COUNT. OE012 00240F********************************************************************OE012 00250FARMAST IPEAF 280 6AI 1 DISK OE012 00260FHEADING IT F 40 EDISK OE012 00270F$LP1 O F 132 OF PRINTER OE012 00280F********************************************************************OE012 0000290E HEADING HDR 1 1 40 COMPANY NAME OE012 00300E********************************************************************OE012 00310IARMAST NS 01 115 C OE012 00320I 2 60CUSTNO OE012 00330I 7 30 NAME OE012 00340I 31 54 ADR1 OE012 00350I 55 78 ADR2 12 OE012 0000360I 79 91 CITY OE012 00370I 92 93 STATE OE012 00380I 94 98 ZIP OE012 00390I 99 1080PHONE OE012 00400I 109 1140CRLIM OE012 00410I 116 116 STMNT OE012 00420I 124 139 PERSON OE012 0000430I 154 1560SLSMAN OE012 00440I 157 158 AREA OE012 00450I 159 159 TAX OE012 00460I 160 160 TERMS OE012 00470I 161 161 PRCODE OE012 00480I 162 163 ACCTYP OE012 00490I NS 02 OE012 0000500I 1 1 UNUSED OE012 00510C********************************************************************OE012 00520C 01 COUNT ADD 1 COUNT 80 OE012 00530C********************************************************************OE012 00540O$LP1 H 202 OF OE012 00550O OR 1P OE012 00560O PAGE Z 8 OE012 0000570O 4 'PAGE' OE012 00580O HDR,1 86 OE012 00590O UDATE Y 132 OE012 00610O H 2 OF OE012 00620O OR 1P OE012 00630O 72 'CUSTOMER MASTER FILE' OE012 00640O 80 'LISTING' OE012 0000650O 132 'DIS012' OE012 00660O H 1 OF OE012 00670O OR 1P OE012 00680O 65 'PHONE #' OE012 00690O 105 'STMT CD SLSMAN TAX' OE012 00700O 118 'CD ACCT TYP' OE012 00710O H 1 OF OE012 0000720O OR 1P OE012 00730O 21 'CUST # CUSTOMER NAME' OE012 00740O 40 'ADDRESS' OE012 00750O 82 'PERSON TO CONTACT CREDI' OE012 00760O 105 'T LIMIT AREA CD TERMS' OE012 00770O 118 'CD PRICE CD' OE012 00780O D 11 01 OE012 0000790O CUSTNOZ 6 OE012 00800O NAME 32 OE012 00810O ADR1 57 OE012 00820O PHONE 70 ' - - ' OE012 00830O STMNT 89 OE012 00840O SLSMANZ 98 OE012 00850O TAX 108 OE012 0000860O ACCTYP 118 OE012 00870O D 1 01 OE012 00880O 12 CITY 46 OE012 00890O 12 STATE 50 OE012 00900O 12 ZIP 57 OE012 00910O N12 ADR2 57 OE012 00920O PERSON 74 OE012 0000930O CRLIM K 90 OE012 00940O AREA 98 OE012 00950O TERMS 108 OE012 00960O PRCODE 118 OE012 00970O D 1 01N12 OE012 00980O CITY 46 OE012 00990O STATE 50 OE012 0001000O ZIP 57 OE012 01010O T 3 LR OE012 01020O 23 'END OF JOB. THERE WERE' OE012 01030O COUNT J 35 OE012 01040O 56 'ACTIVE RECORDS IN THE' OE012 01050O 78 'CUSTOMER MASTER FILE.' OE012 01060O********************************************************************OE012 00** 001070ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001080ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001090ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001100ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001110/* 001120_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0( * f?OTXPO305 P999999050478(000010H S PO305 00020X DECK-ID M66 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO305 00030F* THIS PROGRAM REFORMATS DUE DATES AND CREATE TEMPORARY FILE POTEMP PO305 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO305 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO305 00060F* CONTROL DATA PROPRIETARY PRODUCT PO305 00070F* PO305 0000080FPOOUT IPEAF 128 DISK PO305 00090FPOTEMP O F 72 DISK PO305 00100F* PO305 00110F* ************************************************************** PO305 00120F* ** ** PO305 00130F* ** SYSTEM - PURCHASING PROGRAMMER- ROBBIE F. ** PO305 00140F* ** ** PO305 0000150F* ** PROGRAM- CREATE POTEMP DATE - 11/10/75 ** PO305 00160F* ** REFORMAT DUE DATES ** PO305 00170F* ** ** PO305 00180F* ************************************************************** PO305 00190F* PO305 00200F* ************************************************************** PO305 00210F* ** ** PO305 0000220F* ** FUNCTION OF INDICATORS ** PO305 00230F* ** ** PO305 00240F* ** 01 POOUT - HEADER PO305 00250F* ** 02 POOUT - COMMENT PO305 00260F* ** 03 POOUT - LINE-ITEM PO305 00270F* ** 04 POOUT - UNDEFINED TYPE PO305 00280F* ** 05 POOUT - DELETED RECORD PO305 0000290F* ** 11 BLANK RECORD READ FROM POOUT PO305 00300F* ** 15 LINE-ITEM DUE DATE IS ZERO ** PO305 00310F* ** 20 HEADER READ FOR THIS PO# ** PO305 00320F* ** 15&20 INSERT HEADER DUE DATE IN LINE-ITEM ** PO305 00330F* ************************************************************** PO305 00340F* PO305 00350IPOOUT XX 01 8 CH 128NCD PO305 0000360I 1 2 TST PO305 00370I 1 70PO L1 PO305 00380I 22 250HMD PO305 00390I 26 270HY PO305 00400I 124 1270RR PO305 00410I 1 72 ALL72 PO305 00420I XX 02 8 CK 128NCD PO305 0000430I 1 2 TST PO305 00440I 1 70PO L1 PO305 00450I 124 1270RR PO305 00460I 1 72 ALL72 PO305 00470I XX 03 8 CL 128NCD PO305 00480I 1 2 TST PO305 00490I 1 70PO L1 PO305 0000500I 22 270LMDY 15 PO305 00510I 22 250LMD PO305 00520I 26 270LY PO305 00530I 124 1270RR PO305 00540I 1 72 ALL72 PO305 00550I XX 04 128NCD PO305 00560I 1 2 TST PO305 0000570I 1 70PO L1 PO305 00580I 124 1270RR PO305 00590I 1 72 ALL72 11 PO305 00600I XX 05 128 CD PO305 00610I 1 2 TST PO305 00620I 1 1 DUMMY PO305 00630C TST COMP '<>' 62 PO305 0000640C 62 GOTO PEND PO305 00650C L1 SETOF 20 PO305 00660C 01 SETON 20 PO305 00670C MOVELB12 B12 12 PO305 00680C Z-ADD1 TEST 20 PO305 00690C PEND TAG PO305 00700OPOTEMP D 01N62 PO305 0000710O ALL72 72 PO305 00720O B12 21 PO305 00730O HY 23 PO305 00740O HMD 27 PO305 00750O 28 '0' PO305 00760O 29 ' ' PO305 00770O RR 33 PO305 0000780O D 02N62 PO305 00790O ALL72 72 PO305 00800O B12 21 PO305 00810O 27 '000000' PO305 00820O 29 ' ' PO305 00830O RR 33 PO305 00840O D 03N62 PO305 0000850O ALL72 72 PO305 00860O LY 23 PO305 00870O LMD 27 PO305 00880O 15 20 HY 23 PO305 00890O 15 20 HMD 27 PO305 00900O 28 '0' PO305 00910O 29 ' ' PO305 0000920O RR 33 PO305 00930O D 04N11N62 PO305 00940O ALL72 72 PO305 00950O 29 ' ' PO305 00960O RR 33 PO305 ** 000970ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00098000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000990ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001010/* 001020__0O RR 33 PO305 ** 000970ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0009800(&BJ OTXPO310 P999999050478(000010H S PO310 00020X DECK-ID M69 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO310 00030F* THIS PROGRAM EDITS PURCHASE ORDER TRANSACTIONS AND WRITES EDITRPT PO310 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO310 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO310 00060F* CONTROL DATA PROPRIETARY PRODUCT PO310 00070F* PO310 0000080FPURUPD UPEAF 72 DISK PO310 00090FPURCH IC F 60R25AI 1 DISK PO310 00100FPOINDX IC F 8R 7AI 1 DISK PO310 00110FVENDOR IC F 256R 5AI 1 DISK PO310 00120FPARTMST IC F 300R12AI 1 DISK PO310 00130F$LP1 O F 132 OF PRINTER PO310 00140FHEADING IT F 40 EDISK PO310 0000150F* PO310 00160F* ************************************************************** PO310 00170F* ** ** PO310 00180F* ** COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO310 00190F* ** ** PO310 00200F* ** SYSTEM - PURCHASING PROGRAMMER- ROBBIE FREEMAN ** PO310 00210F* ** ** PO310 0000220F* ** PROGRAM- P.O. EDIT DATE - 11/12/75 ** PO310 00230F* ** ** PO310 00240F* ************************************************************** PO310 00250F* PO310 00260F* ************************************************************** PO310 00270F* ** ** PO310 00280F* ** FUNCTION OF INDICATORS ** PO310 0000290F* ** ** PO310 00300F* ** 01 PURUPD- HEADER ** PO310 00310F* ** 02 PURUPD- COMMENT ** PO310 00320F* ** 03 PURUPD- LINE-ITEM, ALL TRANSACTIONS EXCEPT 'R' ** PO310 00330F* ** 04 PURUPD- LINE-ITEM, TRANS = 'R' = RECEIPTS ** PO310 00340F* ** 05 PURUPD- INVALID RECORD TYPE ** PO310 00350F* ** 06 PURCH ** PO310 0000360F* ** 07 POINDX ** PO310 00370F* ** 08 VENDOR ** PO310 00380F* ** 09 PARTMST ** PO310 00390F* ** 10 NO DUE DATE IN HEADER ** PO310 00400F* ** 17 NO DUE DATE IN LINE-ITEM ** PO310 00410F* ** 18 NO VENDOR # IN LINE-ITEM- MANDATORY FOR ADD TO ** PO310 00420F* ** EXISTING P.O. OR BLANKET. ** PO310 0000430F* ** 19 QTY ORDERED = 0 ** PO310 00440F* ** 20 NO BUY COST OVERRIDE ** PO310 00450F* ** 21 HEADER TRANS = E = RELEASE NEW P.O. ** PO310 00460F* ** 22 HEADER TRANS = A = ADD NEW OPEN P.O. ** PO310 00470F* ** 23 HEADER TRANS = B = ADD NEW BLANKET P.O. ** PO310 00480F* ** 30 THIS LINE ITEM HAS SAME PO# AS LAST ITEM- USED ** PO310 00490F* ** TO CHECK THAT NOT MORE THAN 1 ITEM WITH THE ** PO310 0000500F* ** SAME PO#-PART#-DUE DATE IS BEING ADDED. ** PO310 00510F* ** 31 'L' TRANS = E = RELEASE LINE- NEW P.O. ** PO310 00520F* ** 32 'L' TRANS = A = ADD LINE- NEW OR EXISTING P.O. ** PO310 00530F* ** 33 'L' TRANS = B = ADD LINE- NEW OR EXISTING BLKT ** PO310 00540F* ** 34 'L' TRANS = C = CHANGE LINE ** PO310 00550F* ** 35 'L' TRANS = D = DELETE LINE ** PO310 00560F* ** ** PO310 0000570F* ** WARNING ERRORS ** PO310 00580F* ** 44 RELEASE QTY EXCEEDS BLANKET QTY ** PO310 00590F* ** 45 QTY ORDERED = ZERO ** PO310 00600F* ** 46 BUY COST OVERRIDE ** PO310 00610F* ** ** PO310 00620F* ** TERMINAL ERRORS ** PO310 00630F* ** 50 INVALID RECORD TYPE ** PO310 0000640F* ** 51 INVALID TRANSACTION ** PO310 00650F* ** 52 TRANSACTION DOESN'T MATCH HEADER TRANSACTION ** PO310 00660F* ** 53 NO VALID 'H' INPUT- MANDATORY FOR NEW P.O.'S ** PO310 00670F* ** 54 NO DUE DATE ** PO310 00680F* ** 55 INVALID DUE DATE ** PO310 00690F* ** 56 INVALID VENDOR# ** PO310 00700F* ** 57 INVALID PART # ** PO310 0000710F* ** 58 NO BLANKET ON FILE- MANDATORY FOR RELEASES ** PO310 00720F* ** 59 DUPLICATE ADD ** PO310 00730F* ** 60 P.O. NOT ON FILE ** PO310 00740F* ** 61 THIS PO#-PART#-DUE DATE NOT ON BLANKET ** PO310 00750F* ** 62 THIS PO#-PART#-DUE DATE NOT ON FILE ** PO310 00760F* ** ** PO310 00770F* ** 70 NO HIT TO POINDX OR PURCH FILES ** PO310 0000780F* ** 71 P.O. CODE = RELEASE ** PO310 00790F* ** 72 P.O. CODE = OPEN ** PO310 00800F* ** 73 P.O. CODE = BLANKET ** PO310 00810F* ** ** PO310 00820F* ** 89 AN ERROR HAS OCCURED IN THIS DETAIL CYCLE ** PO310 00830F* ** 90 A VALID HEADER WAS INPUT FOR THIS PO# ** PO310 00840F* ** ** PO310 0000850F* ** 98 A TERMINAL ERROR FOR ENTIRE L1 GROUP ** PO310 00860F* ** 99 A TERMINAL ERROR HAS OCCURRED IN THIS CYCLE ** PO310 00870F* ** ** PO310 00880F* ** H1 POINDX - INVALID P.O. TYPE - 'H' - POP SYS BUG ** PO310 00890F* ** H2 PURCH - INVALID P.O. TYPE - 'L' - POP SYS BUG ** PO310 00900F* ** ** PO310 00910F* ************************************************************** PO310 0000920E TABN 1 20 2 0ATABM 40 ERR#'S- MESSAGES PO310 00930E HEADING HEAD 1 1 40 PO310 00940IPURUPD XX 01 8 CH PO310 00950I 1 70PO L3 PO310 00960I 9 9 HACT PO310 00970I 22 270HDUE 10 PO310 00980I 22 230HYY PO310 0000990I 24 270HMMDD PO310 01000I 30 330RR PO310 01010I 34 380HVEN PO310 01020I XX 02 8 CK PO310 01030I 1 70PO L3 PO310 01040I 9 9 KACT PO310 01050I 28 280LINE PO310 0001060I 30 330RR PO310 01070I 34 63 COM PO310 01080I XX 03 8 CL 9NCR PO310 01090I 1 70PO L3 PO310 01100I 9 9 LACT PO310 01110I 10 21 PART L2 PO310 01120I 22 270LDUE L1 17 PO310 0001130I 30 330RR PO310 01140I 34 380LVEN 18 PO310 01150I 39 450LQTYDU 19 PO310 01160I 46 520LQTYIN PO310 01170I 53 593LCOST 20 PO310 01180I 10 27 FLD18 PO310 01190I 22 230LYY PO310 0001200I 24 270LMMDD PO310 01210I XX 04 8 CL 9 CR PO310 01220I 1 1 DUMMY PO310 01230I XX 05 PO310 01240I 1 70PO PO310 01250I 8 8 ITYPE PO310 01260I 9 9 IACT PO310 0001270I 30 330RR PO310 01280IPURCH XX 06 PO310 01290I 26 300VEN PO310 01300I 37 430QTYDUE PO310 01310I 44 500QTYIN PO310 01320I 58 58 POC PO310 01330IPOINDX XX 07 PO310 0001340I 8 8 POC PO310 01350IVENDOR XX 08 PO310 01360I 1 1 DUMMY PO310 01370I 106 106 DLTVE PO310 01380IPARTMST XX 09 PO310 01390I 1 1 DUMMY PO310 01400I 74 74 DLTPA PO310 0001410C SETOF 44 PO310 01420C SETOF 454689 PO310 01430C SETOF 99 PO310 01440C Z-ADD0 ERR 20 PO310 01450C 03 1 ADD LCNT LCNT 60 PO310 01460C 04 GOTO END IGNORE RECPTS PO310 01470C L3 SETOF 515253 PO310 0001480C L3 SETOF 545556 PO310 01490C L3 SETOF 575859 PO310 01500C L3 SETOF 606162 PO310 01510C L3 SETOF 9098 PO310 01520C 98 51 Z-ADD51 ERR 99 PO310 01530C 98 54 Z-ADD54 ERR 99 PO310 01540C 98 55 Z-ADD55 ERR 99 PO310 0001550C 98 56 Z-ADD56 ERR 99 PO310 01560C 98 58 Z-ADD58 ERR 99 PO310 01570C 98 59 Z-ADD59 ERR 99 PO310 01580C 05 Z-ADD50 ERR 99 PO310 01590C 99 03 1 ADD CNTERR CNTERR PO310 01600C 99 GOTO END PO310 01610C 01 EXSR SUB1 PO310 0001620C 02 EXSR SUB2 PO310 01630C 03 EXSR SUB3 PO310 01640C END TAG PO310 01650C 99 SETON 89 PO310 01660C 89 ERR LOKUPTABN TABM 89 PO310 01670C* PO310 01680C* ************************************************************** PO310 0001690C* ** SUBR SUB1 VALIDATES HEADERS. 'H' INPUT IMPLIES THIS IS PO310 01700C* ** A NEW P.O. SO IF PRIMARY EDITS PASSED, CHECK THAT THIS ** PO310 01710C* ** PO# IS NOT ON POINDX. FOR RELEASES, ALSO CHECK THAT A ** PO310 01720C* ** BLANKET EXISTS FOR IT. ** PO310 01730C* ** ANY 'H' ERROR WILL REJECT ALL RECORDS WITH THIS PO#. ** PO310 01740C* ************************************************************** PO310 01750C* PO310 0001760CSR SUB1 BEGSR PO310 01770CSR SETOF 90 PO310 01780CSR HACT COMP 'E' 21RELEASE PO310 01790CSR HACT COMP 'A' 22ADD PO310 01800CSR HACT COMP 'B' 23BLANKET PO310 01810CSRN21N22N23 Z-ADD51 ERR 99 BAD TRANS PO310 01820CSR 99 SETON 9851 REJECT ALL PO310 0001830CSR 99 GOTO END1 PO310 01840CSR 10 Z-ADD54 ERR 99 NO DUE DATE PO310 01850CSR 99 SETON 9854 REJECT ALL PO310 01860CSR 99 GOTO END1 PO310 01870CSR MOVE HDUE DATE 60 PO310 01880CSR EXSR CHKDAT DUE DATE OK? PO310 01890CSR 99 Z-ADD55 ERR NO PO310 0001900CSR 99 SETON 9855 REJECT ALL PO310 01910CSR 99 GOTO END1 PO310 01920CSR HVEN CHAINVENDOR 99 VENDOR# OK? PO310 01930CSRN99 DLTVE COMP ' ' 9999 PO310 01940CSR 99 Z-ADD56 ERR NO PO310 01950CSR 99 SETON 9856 REJECT ALL PO310 01960CSR 99 GOTO END1 PO310 0001970C** PO310 01980C** NOW DO CHAINS TO CHECK FOR BLANKETS, DUPLICATE ADDS PO310 01990C** PO310 02000CSR 21 GOTO T21 RELEASE PO310 02010CSR 22 ADD PO310 02020COR 23 GOTO T22 BLANKET PO310 02030C** PO310 0002040CSR T21 TAG PO310 02050C** PO310 02060CSR MOVE PO POKEY1 70 PO310 02070CSR MOVE 00 POKEY1 PO310 02080CSR EXSR CHAIN1 BLNKT ON FILE? PO310 02090CSRN73 Z-ADD58 ERR 99 NO PO310 02100CSR 99 SETON 9858 REJECT ALL PO310 0002110CSR 99 GOTO END1 PO310 02120C** PO310 02130CSR T22 TAG PO310 02140C** PO310 02150CSR MOVE PO POKEY1 PO310 02160CSR EXSR CHAIN1 DUPLICATE ADD? PO310 02170CSRN70 Z-ADD59 ERR 99 YES PO310 0002180CSR 99 SETON 9859 REJECT ALL PO310 02190CSR 99 GOTO END1 PO310 02200C** VALID H- ALL PO310 02210CSR SETON 90 CHECKS PASSED PO310 02220CSR END1 ENDSR PO310 02230C** PO310 02240C** PO310 0002250CSR SUB2 BEGSR PO310 02260CSRN90 Z-ADD53 ERR 99 NO VALID H READPO310 02270CSR 99 GOTO END2 PO310 02280CSR KACT COMP 'A' 5151 TRANS OK? PO310 02290CSR 51 KACT COMP 'B' 5151 PO310 02300CSR 51 KACT COMP 'E' 5151 PO310 02310CSR 51 Z-ADD51 ERR 99 NO PO310 0002320CSR 99 GOTO END2 PO310 02330CSR HACT COMP KACT 5252 ACTION NOT PO310 02340CSR 52 Z-ADD52 ERR 99 SAME AS H PO310 02350CSR END2 ENDSR PO310 02360C** PO310 02370C** PO310 02380CSR SUB3 BEGSR PO310 0002390CSR LACT COMP 'E' 31RELEASE PO310 02400CSR LACT COMP 'A' 32ADD PO310 02410CSR LACT COMP 'B' 33BLANKET PO310 02420CSR LACT COMP 'C' 34CHANGE PO310 02430CSR LACT COMP 'D' 35DELETE PO310 02440CSRN31N32N33 PO310 02450CANN34N35 Z-ADD51 ERR 99 BAD TRANS PO310 0002460CSR 99 GOTO END3 PO310 02470C** PO310 02480C** DO PRIMARY EDIT CHECKS PO310 02490C** PO310 02500CSR 31N90 Z-ADD53 ERR 99 NO H INPUT FOR PO310 02510CSR 99 GOTO END3 RELEASE. PO310 02520CSR 31 90N21 TRANS SAME AS PO310 0002530COR 32 90N22 HEADER? PO310 02540COR 33 90N23 Z-ADD52 ERR 99 NO PO310 02550CSR 99 GOTO END3 PO310 02560CSR 17 Z-ADD54 ERR 99 NO DUE DATE PO310 02570CSR 99 GOTO END3 PO310 02580CSR MOVE LDUE DATE PO310 02590CSR EXSR CHKDAT DUE DATE OK? PO310 0002600CSR 99 Z-ADD55 ERR NO PO310 02610CSR 99 GOTO END3 PO310 02620CSR 32N90 PO310 02630COR 33N90 PO310 02640COR 34N18 LVEN CHAINVENDOR 99 PO310 02650CSR 32N90N99 PO310 02660COR 33N90N99 PO310 0002670COR 34N18N99DLTVE COMP ' ' 9999 PO310 02680CSR 99 Z-ADD56 ERR PO310 02690CSR 99 GOTO END3 PO310 02700CSR PART CHAINPARTMST 99 PART # OK? PO310 02710CSRN99 DLTPA COMP ' ' 9999 PO310 02720CSR 99 Z-ADD57 ERR NO PO310 02730CSR 99 GOTO END3 PO310 0002740CSR PO COMP SAVEPO 30 IS THIS A PO310 02750CSR MOVE PO SAVEPO 70 DUPLICATE ADD PO310 02760CSR 31 30NL1 ATTEMPT FROM PO310 02770COR 32 30NL1 PURUPD? PO310 02780COR 33 30NL1 Z-ADD59 ERR 99 YES PO310 02790CSR 99 GOTO END3 PO310 02800C** PO310 0002810CSR 31 GOTO T31 PRIMARY EDITS PO310 02820CSR 32 PASSED- NOW DO PO310 02830COR 33 GOTO T32 CHAINS PO310 02840CSR 34 GOTO T34 PO310 02850CSR 35 GOTO T35 PO310 02860C** PO310 02870CSR T31 TAG RELEASE PO310 0002880C** PO310 02890CSR MOVE PO POKEY1 PO310 02900CSR MOVE 00 POKEY1 PO310 02910CSR MOVELPOKEY1 POKEY2 25 PO310 02920CSR MOVE FLD18 POKEY2 PO310 02930CSR EXSR CHAIN2 BLNKT ON FILE? PO310 02940CSRN73 Z-ADD61 ERR 99 NO PO310 0002950CSR 99 GOTO END3 PO310 02960CSR LQTYDU COMP REMAIN 44 RELQTY>BLKTQTY PO310 02970CSR GOTO WARN CHECK WARNINGS PO310 02980C** PO310 02990CSR T32 TAG ADD,BLANKET PO310 03000C** PO310 03010CSR 90 GOTO WARN NEW PO-NO NEED PO310 0003020C** TO DO CHAINS PO310 03030C** THE FOLLOWING CHECKS ARE FOR ADDING AN ITEM TO AN PO310 03040C** ALREADY EXISTING OPEN OR BLANKET P.O. - IT IS PO310 03050C** ONLY DONE WHEN NO HEADER WAS INPUT IN THIS L3 (PO#) PO310 03060C** GROUP. THE P.O. MUST EXIST IN THIS CASE BUT AN ITEM PO310 03070C** WITH THE SAME PART#-DUE DATE CANNOT. PO310 03080C** PO310 0003090CSR MOVE PO POKEY1 OPEN OR BLNKT PO310 03100CSR EXSR CHAIN1 P.O. ON FILE? PO310 03110CSR 32N72 PO310 03120COR 33N73 Z-ADD60 ERR 99 NO PO310 03130CSR 99 GOTO END3 PO310 03140CSR MOVELPO POKEY2 PO310 03150CSR MOVE FLD18 POKEY2 PO310 0003160CSR EXSR CHAIN2 DUPLICATE ADD? PO310 03170CSRN70 Z-ADD59 ERR 99 YES PO310 03180CSR 99 GOTO END3 PO310 03190CSR GOTO WARN CHECK WARNINGS PO310 03200C** PO310 03210CSR T34 TAG CHANGE PO310 03220C** PO310 0003230CSR MOVELPO POKEY2 PO310 03240CSR MOVE FLD18 POKEY2 PO310 03250CSR EXSR CHAIN2 P.O. ON FILE? PO310 03260CSR 70 Z-ADD62 ERR 99 NO PO310 03270CSR 99 GOTO END3 PO310 03280CSR GOTO WARN PO310 03290C** PO310 0003300CSR T35 TAG DELETE PO310 03310C** PO310 03320CSR MOVELPO POKEY2 PO310 03330CSR MOVE FLD18 POKEY2 PO310 03340CSR EXSR CHAIN2 P.O. ON FILE? PO310 03350CSR 70 Z-ADD62 ERR 99 NO PO310 03360CSR GOTO END3 PO310 0003370C** PO310 03380CSR WARN TAG WARNING ERRORS PO310 03390C** PO310 03400CSR 44 Z-ADD44 ERR 89 RELQTY>BKTQTY? PO310 03410CSR 89 GOTO END3 YES PO310 03420CSR 19N34 Z-ADD45 ERR 89 QTY ORD=0 ? PO310 03430CSR 89 GOTO END3 YES PO310 0003440CSRN20 Z-ADD46 ERR 89 OVERRIDE COST PO310 03450CSR END3 TAG PO310 03460CSR 99 1 ADD CNTERR CNTERR 60 PO310 03470CSR ENDSR PO310 03480C** PO310 03490C** PO310 03500CSR CHAIN1 BEGSR PO310 0003510CSR SETOF 717273 PO310 03520CSR POKEY1 CHAINPOINDX 70 PO310 03530CSR 70 GOTO ENDCH1 PO310 03540CSR POC COMP 'R' 71RELEASE ONFILE PO310 03550CSR POC COMP ' ' 72OPEN ONFILE PO310 03560CSR POC COMP 'B' 73BLANKET ONFILE PO310 03570CSRN71N72N73 SETON H1 PO310 0003580CSR ENDCH1 ENDSR PO310 03590C** PO310 03600C** PO310 03610CSR CHAIN2 BEGSR PO310 03620CSR SETOF 717273 PO310 03630CSR POKEY2 CHAINPURCH 70 PO310 03640CSR 70 GOTO ENDCH2 PO310 0003650CSR POC COMP 'R' 71RELEASE ONFILE PO310 03660CSR POC COMP ' ' 72OPEN ONFILE PO310 03670CSR POC COMP 'B' 73BLANKET ONFILE PO310 03680CSRN71N72N73 SETON H2 PO310 03690CSR 73 QTYDUE SUB QTYIN REMAIN 70 BLKT QTY PO310 03700CSR ENDCH2 ENDSR REMAINING PO310 03710C** PO310 0003720C** PO310 03730CSR CHKDAT BEGSR PO310 03740CSR MOVE DATE MMDD 40 PO310 03750CSR MOVELDATE YY 20 PO310 03760CSR MOVELMMDD MM 20 PO310 03770CSR MOVE MMDD DD 20 PO310 03780CSR YY COMP 75 99 PO310 0003790CSR 99 GOTO ENDCHK PO310 03800CSR MM COMP 1 99 PO310 03810CSRN99 MM COMP 12 99 PO310 03820CSR 99 GOTO ENDCHK PO310 03830CSR DD COMP 1 99 PO310 03840CSRN99 DD COMP 31 99 PO310 03850CSR ENDCHK ENDSR PO310 0003860C** PO310 03870C** PO310 03880OPURUPD D 99 PO310 03890O 29 'X' PO310 03900O$LP1 H 02 1P PO310 03910O OR OF PO310 03920O 4 'PAGE' PO310 0003930O PAGE Z 8 PO310 03940O HEAD 85 PO310 03950O UDATE Y 132 PO310 03960O H 2 1P PO310 03970O OR OF PO310 03980O 75 'PURCHASE ORDER EDIT' PO310 03990O 132 'MFG310' PO310 0004000O H 2 1P PO310 04010O OR OF PO310 04020O 85 'OVERIDE' PO310 04030O 132 'ERROR' PO310 04040O H 12 1P PO310 04050O OR OF PO310 04060O 8 'PO #/LOT' PO310 0004070O 12 'ACT' PO310 04080O 16 'TYP' PO310 04090O 20 'LIN' PO310 04100O 26 'VEND#' PO310 04110O 47 'DUE DATE' PO310 04120O 55 'PART #' PO310 04130O 68 'PO QTY' PO310 0004140O 76 'QTY IN' PO310 04150O 85 'BUY CST' PO310 04160O 90 'RR#' PO310 04170O 98 'ERRORS' PO310 04180O 132 'SEVERITY' PO310 04190O D 2 L3N1P PO310 04200O 1 ' ' PO310 0004210O D 11 01 PO310 04220O PO 8 ' - ' PO310 04230O HACT 11 PO310 04240O 15 'H' PO310 04250O HVEN 26 PO310 04260O HMMDD 44 ' / ' PO310 04270O 45 '/' PO310 0004280O HYY 47 PO310 04290O RR Z 91 PO310 04300O 89 TABM 132 PO310 04310O D 1 02 PO310 04320O PO 8 ' - ' PO310 04330O KACT 11 PO310 04340O 15 'K' PO310 0004350O LINE 19 PO310 04360O COM 51 PO310 04370O RR Z 91 PO310 04380O 89 TABM 132 PO310 04390O D 1 03 PO310 04400O PO 8 ' - ' PO310 04410O LACT 11 PO310 0004420O 15 'L' PO310 04430O LVEN 26 PO310 04440O PART 61 PO310 04450O N17 LMMDD 44 ' / ' PO310 04460O N17 45 '/' PO310 04470O N17 LYY 47 PO310 04480O LQTYDUL 70 PO310 0004490O 34 LQTYINL 78 PO310 04500O N20 LCOST L 87 PO310 04510O RR Z 91 PO310 04520O 89 TABM 132 PO310 04530O 89 TABM 132 PO310 04540O D 11 05 PO310 04550O PO 8 ' - ' PO310 0004560O IACT 11 PO310 04570O ITYPE 15 PO310 04580O RR Z 91 PO310 04590O 89 TABM 132 PO310 04600O T 2 LR PO310 04610O 10 'THERE WERE' PO310 04620O LCNT Z 17 PO310 0004630O 39 'LINE ITEMS PROCESSED.' PO310 04640O T 2 LR PO310 04650O 10 'THERE WERE' PO310 04660O CNTERRZ 17 PO310 04670O 38 'LINE ITEMS REJECTED.' PO310 ** 004680ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00469000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004700ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004710ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004720** 00473044RELEASE QTY EXCEEDS BLANKET QTY WARNING 00474045QTY ORDERED= ZERO WARNING 00475046BUY COST OVERRIDE WARNING 0047600050INVALID RECORD TYPE REJECTED 00477051INVALID TRANSACTION REJECTED 00478052TRANSACTION NOT SAME AS HEADER REJECTED 00479053NO VALID HEADER INPUT REJECTED 00480054NO DUE DATE REJECTED 00481055INVALID DUE DATE REJECTED 00482056INVALID VENDOR# REJECTED 0048300057INVALID PART # REJECTED 00484058BLANKET NOT ON FILE REJECTED 00485059DUPLICATE ADD REJECTED 00486060P.O. NOT ON FILE REJECTED 00487061PO#-PART#-DUEDATE NOT ON BLNKT REJECTED 00488062PO#-PART#-DUEDATE NOT ON FILE REJECTED 00489063 0049000064 00491065 00492066 004930/* 004940__#-PART#-DUEDATE NOT ON BLNKT REJECTED 00488062PO#-PART#-DUEDATE NOT ON FILE REJECTED 00489063 0049000(C1 iOTXPO320 P999999050478(000010H S PO320 00020X DECK-ID M70 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO320 00030F* THIS PROGRAM PROCESSES VALID NEW PURCHASE ORDERS AND CHANGES PO320 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO320 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO320 00060F* CONTROL DATA PROPRIETARY PRODUCT PO320 00070F* PO320 0000080FPURUPD IPEAF 72 DISK PO320 00090FPURCH UC F 60R25AI 1 DISK A PO320 00100FTRANSAC O F 45 DISK A PO320 00110F* PO320 00120F* ************************************************************** PO320 00130F* ** ** PO320 00140F* ** COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO320 0000150F* ** ** PO320 00160F* ** SYSTEM - PINS PROGRAMMER- R. FREEMAN ** PO320 00170F* ** ** PO320 00180F* ** PROGRAM- PROCESS A,B,C,D,E DATE - 11/14/75 ** PO320 00190F* ** TRANSACTIONS TO PURCH ** PO320 00200F* ** ** PO320 00210F* ************************************************************** PO320 0000220F* PO320 00230F* ************************************************************** PO320 00240F* ** ** PO320 00250F* ** FUNCTION OF INDICATORS ** PO320 00260F* ** ** PO320 00270F* ** 01 PURUPD- HEADER (NO ERROR CODE) ** PO320 00280F* ** 02 PURUPD- LINE-ITEM (NO ERROR CODE) ** PO320 0000290F* ** 03 PURUPD- OTHERS ** PO320 00300F* ** 04 PURCH ** PO320 00310F* ** 10 LINE-ITEM VENDOR#=ZERO - DON'T CHANGE ** PO320 00320F* ** 11 LINE-ITEM QTYDUE=ZERO - DON'T CHANGE ** PO320 00330F* ** 12 LINE-ITEM QTYIN=ZERO - DON'T CHANGE ** PO320 00340F* ** 13 LINE-ITEM BUY COST=ZERO- DON'T CHANGE ** PO320 00350F* ** 20 VALID HEADER READ FOR THIS PO#- NEW P.O. ** PO320 0000360F* ** 31 TRANS= RELEASE ** PO320 00370F* ** 32 TRANS= ADD (OPEN) ** PO320 00380F* ** 33 TRANS= BLANKET ** PO320 00390F* ** 34 TRANS= CHANGE ** PO320 00400F* ** 35 TRANS= DELETE ** PO320 00410F* ** 40 ADD TRAN# 40 TO TRANSAC ** PO320 00420F* ** 42 ADD TRAN# 42 TO TRANSAC ** PO320 0000430F* ** 43 ADD TRAN# 43 TO TRANSAC ** PO320 00440F* ** 45 ADD TRAN# 45 TO TRANSAC ** PO320 00450F* ** 71 P.O. CODE ON PURCH = RELEASE ** PO320 00460F* ** 72 P.O. CODE ON PURCH = OPEN ** PO320 00470F* ** 73 P.O. CODE ON PURCH = BLANKET ** PO320 00480F* ** H1 NO HIT ON PURCH - MFG310 HAS BUGS ** PO320 00490F* ** H2 P.O. CODE INVALID- MFG310 HAS BUGS ** PO320 0000500F* ************************************************************** PO320 00510F* PO320 00520IPURUPD XX 01 8 CH 29NCX PO320 00530I 1 70PO L1 PO320 00540I 34 380HVEN PO320 00550I 39 440HPODAT PO320 00560I XX 02 8 CL 9NCR 29NCX PO320 0000570I 1 70PO L1 PO320 00580I 9 9 ACTION PO320 00590I 10 21 PART PO320 00600I 22 270IDUE PO320 00610I 10 27 N18 PO320 00620I 34 380IVEN 10 PO320 00630I 39 450IQTYDU 11 PO320 0000640I 46 520IQTYIN 12 PO320 00650I 53 593ICOST 13 PO320 00660I XX 03 PO320 00670I 1 1 DUMMY PO320 00680IPURCH XX 04 PO320 00690I 26 300VEN PO320 00700I 37 430QTYDUE PO320 0000710I 44 500QTYIN PO320 00720I 58 58 POC PO320 00730C SETOF 404243 PO320 00740C SETOF 45 PO320 00750C L1 SETOF 20 PO320 00760C 01 SETON 20 PO320 00770C N02 GOTO END PO320 0000780C********************************************************************PO320 00790C* CALCS FOR ADD,CHANGE,DELETE LINE-ITEMS. FOR ADDS & BLANKETS PO320 00800C* NO NEED TO DO ANY CHAINS TO PURCH- JUST ADD TO FILE. ADDS (NOT PO320 00810C* BLANKETS) GENERATE TR#40 WITH TRNQTY = QTY ORDERED. RELEASE IS PO320 00820C* SAME AS ADD BUT WE ALSO CHAIN TO ITS BLANKET ON PURCH & UPDATE PO320 00830C* THE RELEASED-TO-DATE WITH THIS RELEASE QTY. ALSO GENERATES PO320 00840C* TR#40. FOR CHANGES, WE CHAIN TO PURCH & REPLACE ANY FIELDS PO320 0000850C* WHICH ARE NON-ZERO ON PURUPD- VENDOR#,QTYDUE,QTYIN,OR OVERRIDE PO320 00860C* BUY COST. CHANGE TO QTYDUE GENERATES TR#42 WITH TRNQTY = NEW PO320 00870C* QTYDUE - OLD QTYDUE, CHANGE TO QTYIN-TR#43 WITH TRNQTY = NEW PO320 00880C* QTYIN - OLD QTYIN. FOR DELETES, WE CHAIN & UPDATE PURCH WITH PO320 00890C* DELETE CODE, GENERATE TR#45 WITH TRNQTY = QTYDUE - QTYIN. PO320 00900C********************************************************************PO320 00910C ACTION COMP 'E' 31RELEASE PO320 0000920C ACTION COMP 'A' 32ADD PO320 00930C ACTION COMP 'B' 33BLANKET PO320 00940C ACTION COMP 'C' 34CHANGE PO320 00950C ACTION COMP 'D' 35DELETE PO320 00960C 31 PO320 00970COR 32 Z-ADDIQTYDU TRQTY1 70 4040 TR# 40 FOR E,A PO320 00980C 31 GOTO T31 PO320 0000990C 34 GOTO T34 PO320 01000C 35 GOTO T35 PO320 01010C GOTO END NO NEED TO DO PO320 01020C* CHAIN FOR A,B PO320 01030C* PO320 01040C T31 TAG REL- UPDATE PO320 01050C** QTY ON BLANKET PO320 0001060C MOVE PO N7 70 PO320 01070C MOVE 00 N7 PO320 01080C MOVELN7 POKEY 25 PO320 01090C MOVE N18 POKEY PO320 01100C EXSR CHAIN PO320 01110C N73 SETON H2 PO320 01120C H2 GOTO END PO320 0001130C QTYIN ADD IQTYDU QTYIN ADD RELEAS QTY PO320 01140C GOTO END PO320 01150C* PO320 01160C T34 TAG CHANGE PO320 01170C* PO320 01180C MOVELPO POKEY PO320 01190C MOVE N18 POKEY PO320 0001200C EXSR CHAIN PO320 01210C N71N72N73 SETON H2 PO320 01220C H2 GOTO END PO320 01230C 73 GOTO END PO320 01240C N11 IQTYDU SUB QTYDUE TRQTY1 4242 CHANGE QTYDUE= PO320 01250C* TR# 42 PO320 01260C N12 IQTYIN SUB QTYIN TRQTY2 70 4343 CHANGE QTYREC= PO320 0001270C* TR# 43 PO320 01280C N71 PO320 01290CORN42 GOTO END PO320 01300C MOVELPO K7 70 PO320 01310C MOVE '00' K7 PO320 01320C MOVELK7 POKEY PO320 01330C EXSR CHAIN PO320 0001340C N73 GOTO REST PO320 01350C QTYIN ADD TRQTY1 QTYIN PO320 01360C SETON 80 PO320 01370C 80 EXCPT PO320 01380C SETOF 80 PO320 01390C REST TAG PO320 01400C MOVELPO POKEY PO320 0001410C MOVE N18 POKEY PO320 01420C EXSR CHAIN PO320 01430C GOTO END PO320 01440C* PO320 01450C T35 TAG DELETE PO320 01460C* PO320 01470C MOVELPO POKEY PO320 0001480C MOVE N18 POKEY PO320 01490C EXSR CHAIN PO320 01500C N71N72N73 SETON H2 PO320 01510C H2 GOTO END PO320 01520C N73 QTYDUE SUB QTYIN TRQTY1 4545 DELETE QTYDUE= PO320 01530C END TAG TR# 45 PO320 01540CSR CHAIN BEGSR PO320 0001550CSR SETOF 717273 PO320 01560CSR POKEY CHAINPURCH H1 PO320 01570CSR H1 GOTO ENDCH PO320 01580CSR POC COMP 'R' 71 PO320 01590CSR POC COMP ' ' 72 PO320 01600CSR POC COMP 'B' 73 PO320 01610CSR ENDCH ENDSR PO320 0001620OPURCH D 02 31 PO320 01630O QTYIN 50 PO320 01640O D 02 34 PO320 01650O N10 IVEN 30 PO320 01660O N11 IQTYDU 43 PO320 01670O N12 IQTYIN 50 PO320 01680O N13 ICOST 57 PO320 0001690O D 02 35 PO320 01700O 58 'D' PO320 01710O E 80 PO320 01720O QTYIN 50 PO320 01730O DADD 02 31 PO320 01740O OR 02 32 PO320 01750O OR 02 33 PO320 0001760O PO 7 PO320 01770O PART 19 PO320 01780O IDUE 25 PO320 01790O 20 HVEN 30 PO320 01800O N20 IVEN 30 PO320 01810O 20 HPODAT 36 PO320 01820O N20 UDATE 36 PO320 0001830O IQTYDU 43 PO320 01840O N13 ICOST 57 PO320 01850O 31 58 'R' PO320 01860O 32 58 ' ' PO320 01870O 33 58 'B' PO320 01880OTRANSAC DADD 02 40 PO320 01890O OR 02 42 PO320 0001900O OR 02 45 PO320 01910O PART 12 PO320 01920O 40 14 '40' PO320 01930O 42 14 '42' PO320 01940O 45 14 '45' PO320 01950O TRQTY1 21 PO320 01960O PO 28 PO320 0001970O 20 HPODAT 34 PO320 01980O N20 UDATE 34 PO320 01990O DADD 02 43 PO320 02000O PART 12 PO320 02010O 14 '43' PO320 02020O TRQTY2 21 PO320 02030O PO 28 PO320 0002040O UDATE 34 PO320 02050O N13 ICOST 41 PO320 ** 002060ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002070ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002080ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002090ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00210000/* 002110__0O N13 ICOST 41 PO320 ** 002060ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002070ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002080ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002090ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 0021000(wC HOTXPO330 P999999050478(000010H S PO330 00020X DECK-ID M71 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO330 00030F* THIS PROGRAM PROCESSES VALID RECEIPTS, REMOVE DELETES + CLOSES PO PO330 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO330 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO330 00060F* CONTROL DATA PROPRIETARY PRODUCT PO330 00070F* PO330 0000080FPURUPD IPEAF 72 DISK PO330 00090FPURCH ISEAF 60 25AI 1 DISK PO330 00100FPARTMST IC F 300R12AI 1 DISK PO330 00110FNEWPUR O F 60 25AI 1 DISK PO330 00120FPOINDX O F 8 7AI 1 DISK PO330 00130FPOREC O F 57 DISK PO330 00140FTRANSAC O F 45 DISK A PO330 0000150F$LP1 O F 132 OF PRINTER PO330 00160FHEADING IT F 40 EDISK PO330 00170F* PO330 00180F* ************************************************************** PO330 00190F* ** ** PO330 00200F* ** COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO330 00210F* ** ** PO330 0000220F* ** SYSTEM - PINS PROGRAMMER- ROBBIE FREEMAN ** PO330 00230F* ** ** PO330 00240F* ** PROGRAM- PROCESS P.O. DATE CODED- 11/17/75 ** PO330 00250F* ** RECEIPTS,REMOVE ** PO330 00260F* ** DELETES. ** PO330 00270F* ** ** PO330 00280F* ************************************************************** PO330 0000290F* PO330 00300F* ************************************************************** PO330 00310F* ** ** PO330 00320F* ** FUNCTION OF INDICATORS ** PO330 00330F* ** ** PO330 00340F* ** 01 PURUPD- RECEIPTS ** PO330 00350F* ** 02 PURUPD- ALL OTHERS ** PO330 0000360F* ** 03 PURCH - OPEN P.O. ** PO330 00370F* ** 04 PURCH - RELEASE P.O. ** PO330 00380F* ** 05 PURCH - BLANKET P.O. ** PO330 00390F* ** 06 PURCH - DELETED P.O. ** PO330 00400F* ** 07 PARTMST ** PO330 00410F* ** 10 NO OVERRIDE BUY COST ON PURUPD ** PO330 00420F* ** 11 P.O. DATE IS ZERO - DON'T PRINT ** PO330 0000430F* ** 12 NO OVERRIDE BUY COST ON PURCH ** PO330 00440F* ** 20 ACTIVE P.O. ITEM ** PO330 00450F* ** 25 MATCHING PURCH REC READ FOR THIS L2(PO#) GROUP ** PO330 00460F* ** 30 THIS PO# ACTIVE- OUTPUT TO POINDX ** PO330 00470F* ** 40 PARTIAL/COMPLETE CODE NOT=P- ASSUME COMPLETE ** PO330 00480F* ** 44 ADD TR#44 TO TRANSAC ** PO330 00490F* ** 45 ADD TR#45 TO TRANSAC ** PO330 0000500F* ** 50 NEXT RECORD ON PURCH IS SAME PO#-PART# ** PO330 00510F* ** 51 QTYDUE-QTYIN IS +: CLOSE ONLY IF P/C NOT P ** PO330 00520F* ** 52N50 QTYDUE-QTYIN IS -: CLOSE- NEXT REC ON PURCH IS ** PO330 00530F* ** NOT SAME PO#-PART# SO OVERSHIP THIS REC ** PO330 00540F* ** 52 50 QTYDUE-QTYIN IS -: CLOSE- NEXT REC ON PURCH IS ** PO330 00550F* ** SAME PO#-PART# SO CARRY OVERAGE TO RECEIVE ** PO330 00560F* ** AGAINST NEXT REC ** PO330 0000570F* ** 53 QTYDUE-QTYIN IS 0: CLOSE ** PO330 00580F* ** 55 RECEIVE AGAINST THIS PO#-PART#. PRINT & OUTPUT ** PO330 00590F* ** TO POREC. ** PO330 00600F* ** 71 PO CODE=D - DELETED PURCH, REGARD AS NO MATCH ** PO330 00610F* ** N72 PO CODE NOT OPEN OR RELEASED - ERROR# 72 ** PO330 00620F* ** 73 NO HIT ON PARTMST- ERROR# 73 ** PO330 00630F* ** 74 ITEM CLOSED & UNDER RECEIVED ** PO330 0000640F* ** 75 ITEM CLOSED & OVER RECEIVED ** PO330 00650F* ** 99 TERMINAL ERROR FOR THIS RECEIPT ** PO330 00660F* ************************************************************** PO330 00670E TABN 1 10 2 0 TABM 32 ERR#'S- MESSAGES PO330 00680E HEADING HEAD 1 1 40 PO330 00690IPURUPD XX 01 8 CL 9 CR 29NCX PO330 00700I 1 70PO L2M2 PO330 0000710I 10 21 PART L1M1 PO330 00720I 46 520QTYREC PO330 00730I 53 593OVCOST 10 PO330 00740I 60 60 PC PO330 00750I XX 02 PO330 00760I 1 70PO L2M2 PO330 00770I 10 21 PROD L1M1 PO330 0000780IPURCH XX 03 58 C PO330 00790I 1 70PO L2M2 PO330 00800I 8 19 PART L1M1 PO330 00810I 20 250DUE PO330 00820I 20 210DYY PO330 00830I 22 250DMMDD PO330 00840I 26 300VEN PO330 0000850I 31 360PODAT 11 PO330 00860I 37 430QTYDUE PO330 00870I 44 500QTYIN PO330 00880I 51 573COST 12 PO330 00890I 58 58 POC PO330 00900I 1 60 ALL PO330 00910I XX 04 58 CR PO330 0000920I 1 70PO L2M2 PO330 00930I 8 19 PART L1M1 PO330 00940I 20 250DUE PO330 00950I 20 210DYY PO330 00960I 22 250DMMDD PO330 00970I 26 300VEN PO330 00980I 31 360PODAT 11 PO330 0000990I 37 430QTYDUE PO330 01000I 44 500QTYIN PO330 01010I 51 573COST 12 PO330 01020I 58 58 POC PO330 01030I 1 60 ALL PO330 01040I XX 05 58 CB PO330 01050I 1 70PO L2M2 PO330 0001060I 8 19 PART L1M1 PO330 01070I 58 58 POC PO330 01080I 1 60 ALL PO330 01090I XX 06 58 CD PO330 01100I 1 70PO L2M2 PO330 01110I 8 19 PART L1M1 PO330 01120I XX 08 PO330 0001130I 1 60 X PO330 01140I XX ** PO330 01150I 1 70LPO PO330 01160I 8 19 LPART PO330 01170I 58 58 LPOC PO330 01180IPARTMST XX 07 PO330 01190I 13 28 DESCR PO330 0001200I 74 74 DLTPT PO330 01210I 75 813MAT$ PO330 01220C SETOF 205599 PO330 01230C SETOF 7475 PO330 01240C Z-ADD0 ERR 20 PO330 01250C L2 SETOF 2530 PO330 01260C L1 SETOF 447345 PO330 0001270C L1 Z-ADD0 TRQTY1 70 PO330 01280C L1 Z-ADD0 TRQTY2 70 PO330 01290C L1 Z-ADD0 TOTREC 70 PO330 01300C L1 01 PART CHAINPARTMST 73 PO330 01310C L1 01N73DLTPT COMP ' ' 7373 PO330 01320C 01 EXSR RECEPT PO330 01330C 03NMR PO330 0001340COR 04NMR PO330 01350COR 05 SETON 2030 PO330 01360C 03 MR PO330 01370COR 04 MR EXSR MASTER PO330 01380C 99 ERR LOKUPTABN TABM 99 PO330 01390C 99 ERRORS ADD 1 ERRORS 40 PO330 01400C* PO330 0001410C* ************************************************************** PO330 01420C* ** SUBR RECEPT PROCESSES RECEIPT RECORDS FROM PURUPD. ** PO330 01430C* ** VALID RECEIPTS ARE ACCUMULATED FOR EACH UNIQUE ** PO330 01440C* ** PO#-PART# AND THIS TOTAL IS USED TO RECEIVE AGAINST ** PO330 01450C* ** THE OLDEST PO#-PART#-DUE DATE RECORD ON PURCH. ** PO330 01460C* ************************************************************** PO330 01470C* PO330 0001480CSR RECEPT BEGSR PO330 01490CSR LPOC COMP 'D' 71 D = NO MATCH PO330 01500CSR LPOC COMP ' ' 72 OPEN PO330 01510CSRN72 LPOC COMP 'R' 72 RELEASED PO330 01520CSRNMR P.O. ON FILE? PO330 01530COR MR 71 Z-ADD71 ERR 99 PO330 01540CSR 99 GOTO ENDR NO PO330 0001550CSRN72 Z-ADD72 ERR 99 NOT OPEN,REL PO330 01560CSR 99 GOTO ENDR PO330 01570CSR 73 Z-ADD73 ERR 99 BAD PART # PO330 01580CSR 99 GOTO ENDR PO330 01590C** PO330 01600C** ALL CHECKS PASSED- ACCUMULATE TOT RECEIVED QTY FOR THIS PART # PO330 01610C** AND APPLY IT TO OLDEST DUE DATE WHEN PURCH READ. PO330 0001620C** PO330 01630CSR TOTREC ADD QTYREC TOTREC PO330 01640CSR PC COMP 'P' 4040 NOT P- ASSUME PO330 01650C** COMPLETE PO330 01660CSR ENDR ENDSR PO330 01670C* PO330 01680C* ************************************************************** PO330 0001690C* ** SUBR MASTER PROCESSES THE MASTER RECORDS AFTER ALL ** PO330 01700C* ** RECEIPTS FOR THIS PART# HAVE BEEN READ FROM PURUPD. ** PO330 01710C* ************************************************************** PO330 01720C* PO330 01730CSR MASTER BEGSR PO330 01740CSR SETON 2025 PO330 01750CSR TOTREC COMP 0 5555 PO330 0001760CSRN55 SETON 30 0 RECEIPT QTY PO330 01770CSRN55 GOTO ENDM FORGET IT PO330 01780CSR PO COMP LPO 50LOOK-AHEAD PO# PO330 01790CSR 50 PART COMP LPART 50LOOK-AHEAD PR# PO330 01800CSR Z-ADDQTYIN SAVEIN 70 PO330 01810CSR RECPTS ADD 1 RECPTS 40 PO330 01820CSR QTYIN ADD TOTREC QTYIN PO330 0001830CSR QTYDUE SUB QTYIN DIFF 70 515253 PO330 01840CSR Z-ADD0 TOTREC PO330 01850C** PO330 01860C** IF DIFF IS NEG & NEXT PURCH RECORD IS SAME PO#-PART#, CLOSE PO330 01870C** THIS RECORD WITH QTYIN = QTYDUE & CARRY OVERAGE TO NEXT RECORD PO330 01880C** TO RECEIVE AGAINST IT. IF DIFF IS POS, CLOSE ONLY IF PARTIAL/ PO330 01890C** COMPLETE CODE ON RECEIPT WAS NOT = 'P', OTHERWISE IT REMAINS PO330 0001900C** ON FILE. IF DIFF IS ZERO, CLOSE THIS RECORD & LEAVE OTHERS PO330 01910C** ON PURCH UNCHANGED. FOR EACH ITEM ON PURCH THAT WE RECEIVE PO330 01920C** AGAINST (55 ON), WE OUTPUT A RECORD TO POREC & PRINT A LINE PO330 01930C** ON REPORT, WHETHER OR NOT IT WAS CLOSED. PO330 01940C** PO330 01950CSR 50 52 Z-ADDQTYDUE QTYIN PO330 01960CSR 50 52 Z-SUBDIFF TOTREC PO330 0001970CSR QTYIN SUB SAVEIN ACTREC 70 PO330 01980CSR TRQTY1 ADD ACTREC TRQTY1 4444 PO330 01990CSR 51 40 PO330 02000COR 52 PO330 02010COR 53 SETOF 20 CLOSE ITEM PO330 02020CSRN20 QTYDUE SUB QTYIN CANCEL 70 PO330 02030CSRN20 TRQTY2 ADD CANCEL TRQTY2 4545 PO330 0002040CSR 20 SETON 30 ACTIVE PO#- PO330 02050C** POINDX OUTPUT PO330 02060C** PO330 02070CSR 51 40 SETON 74 UNDER REC'D PO330 02080CSR 52N50 SETON 75 OVER REC'D PO330 02090CSR ENDM ENDSR PO330 02100ONEWPUR D 20 PO330 0002110O ALL 60 PO330 02120O N05 QTYIN 50 PO330 02130OPOINDX T L2 30 PO330 02140O PO 7 PO330 02150O POC 8 PO330 02160OPOREC D 55 PO330 02170O PART 12 PO330 0002180O PO 19 PO330 02190O DMMDD 23 PO330 02200O DYY 25 PO330 02210O UDATE 31 PO330 02220O VEN 36 PO330 02230O N12 COST 43 PO330 02240O N10 OVCOST 43 PO330 0002250O QTYDUE 50 PO330 02260O ACTREC 57 PO330 02270OTRANSAC TADD L1 44 PO330 02280O PART 12 PO330 02290O 14 '44' PO330 02300O TRQTY1 21 PO330 02310O PO 28 PO330 0002320O UDATE 34 PO330 02330O N12 COST 41 PO330 02340O N10 OVCOST 41 PO330 02350O TADD L1 45 PO330 02360O PART 12 PO330 02370O 14 '45' PO330 02380O TRQTY2 21 PO330 0002390O PO 28 PO330 02400O UDATE 34 PO330 02410O$LP1 H 02 1P PO330 02420O OR OF PO330 02430O 4 'PAGE' PO330 02440O PAGE Z 8 PO330 02450O HEAD 84 PO330 0002460O UDATE Y 132 PO330 02470O H 2 1P PO330 02480O OR OF PO330 02490O 70 'PURCHASE ORDER RECEIPT' PO330 02500O 77 'REPORT' PO330 02510O 132 'MFG330' PO330 02520O H 2 1P PO330 0002530O OR OF PO330 02540O 53 'ORDER' PO330 02550O 62 'DUE' PO330 02560O 78 'RECEIPT' PO330 02570O 86 'RECEIVD' PO330 02580O 95 'OVERRIDE' PO330 02590O H 11 1P PO330 0002600O OR OF PO330 02610O 8 'PO#/LOT#' PO330 02620O 15 'PART #' PO330 02630O 33 'DESCRIPTION' PO330 02640O 44 'VEND#' PO330 02650O 53 'DATE' PO330 02660O 62 'DATE' PO330 0002670O 70 'ORDERED' PO330 02680O 78 'QTY' PO330 02690O 86 'TO-DATE' PO330 02700O 99 'P/C' PO330 02710O 115 'COMMENTS/ERRORS' PO330 02720O D 2 01 99 PO330 02730O PO 8 ' - ' PO330 0002740O PART 21 PO330 02750O N73 DESCR 38 PO330 02760O QTYRECL 79 PO330 02770O N10 OVCOSTL 96 PO330 02780O PC 98 PO330 02790O TABM 132 PO330 02800O D 2 55 PO330 0002810O PO 8 ' - ' PO330 02820O PART 21 PO330 02830O DESCR 38 PO330 02840O VEN Z 44 PO330 02850O N11 PODAT Y 53 PO330 02860O DMMDD 59 ' / ' PO330 02870O 60 '/' PO330 0002880O DYY 62 PO330 02890O QTYDUEL 71 PO330 02900O ACTRECL 79 PO330 02910O QTYIN L 87 PO330 02920O N12 COST L 96 PO330 02930O N10 OVCOSTL 96 PO330 02940O PC 98 PO330 0002950O 20 117 'ITEM STILL ACTIVE' PO330 02960O N20 111 'ITEM CLOSED' PO330 02970O N20 74 128 '- UNDER RECEIVED' PO330 02980O N20 75 127 '- OVER RECEIVED' PO330 02990O T 21 L2 25N30 PO330 03000O 108 '**** ENTIRE PO#' PO330 03010O PO 116 ' - ' PO330 0003020O 132 'NOW CLOSED ****' PO330 03030O T 3 LR PO330 03040O 11 'END OF JOB.' PO330 03050O 23 'THERE WERE' PO330 03060O RECPTS3 28 PO330 03070O 44 'ITEMS RECEIVED.' PO330 03080O T 1 LR PO330 0003090O 23 'THERE WERE' PO330 03100O ERRORS3 28 PO330 03110O 36 'ERRORS.' PO330 ** 003120ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00315000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003160** 00317071PO/PART# NOT ON FILE *REJECTED* 00318072PO NOT OPEN OR REL'D *REJECTED* 00319073INVALID PART # *REJECTED* 003200 003210 00322000 003230 003240 003250 003260 003270/* 003280__ 0032200(D9 iOTXPO340 P999999050478(00101 H S PO340 X DECK-ID M72 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO340 F* THIS PROGRAM WRITES PURCHASE ORDERS PO340 F* CYBER 18-10M/20 PURCHASING VERSION 1.0 F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F* CONTROL DATA PROPRIETARY PRODUCT F* 000102 FPURUPD IPEAF 72 DISK MFG3400103 FVENDOR IC F 256R 5AI 1 DISK MFG3400104 FPARTMST IC F 300R12AI 1 DISK MFG3400105 F$LP1 O F 85 OF LPRINTER MFG340 FCON D F 30 CONSOLE E MSG 1 1 30 0801 E SCOM 4 30 SAVE K COMMENTS MFG340000820 L$LP1 51FL 51OL MFG3401001 IPURUPD XX 01 8 CH 29NCX MFG3401002 I 1 70PO L1 MFG3401003 I 9 9 ACTION MFG3401004 I 22 270HDUE 11 MFG3401005 I 22 230HYY MFG3401006 I 24 270HMMDD MFG340001007 I 34 380VEN MFG3401008 I 39 440PODAT 10 MFG3401201 I XX 02 8 CK 29NCX MFG3401202 I 1 70PO L1 MFG3401204 I 34 63 COM 15 MFG3401401 I XX 03 8 CL 9 CA 29NCX MFG3401402 I OR 8 CL 9 CB 29NCX MFG340001403 I OR 8 CL 9 CE 29NCX MFG3401404 I 1 70PO L1 MFG3401405 I 10 21 PART MFG3401406 I 22 270LDUE 18 MFG3401407 I 22 230LYY MFG3401408 I 24 270LMMDD MFG3401409 I 39 450QTYDUE MFG340001410 I 53 593OVCOST 16 MFG3401601 I XX 04 MFG3401602 I 1 1 DUMMY MFG3401801 IVENDOR XX 05 MFG3401802 I 6 30 NAME MFG3401803 I 31 55 AD1 17 MFG3401804 I 56 80 AD2 MFG340001805 I 81 103 AD3 MFG3402001 IPARTMST XX 06 MFG3402002 I 13 37 DESCR MFG3402003 I 62 73 VPART MFG3402004 I 75 813STDMAT MFG3402005 I 38 39 UM MFG340 C N99 EXSR FORM 003000 C L1 SETOF 202122 MFG3403001 C L1 SETOF 2325 MFG3403002 C L1 SETOF 414243 MFG3403003 C L1 SETOF 445090 MFG3403004 C L1 MOVE BLANKS SCOM MFG3403005 C L1 Z-ADD0 K 10 MFG3403006 C L1 Z-ADD0 LINES 20 MFG340003007 C L1 Z-ADD2 PAGE MFG3403201 C 01 EXSR SUB1 MFG3403202 C 02 EXSR SUB2 MFG3403203 C 03 20 EXSR SUB3 MFG3403301 CL1N20 GOTO L1END MFG3403302 CL1 SCOM,1 COMP BLANKS 4141 MFG3403303 CL1 SCOM,2 COMP BLANKS 4242 MFG340003304 CL1 SCOM,3 COMP BLANKS 4343 MFG3403305 CL1 SCOM,4 COMP BLANKS 4444 MFG3403306 CL1 LINES COMP 11 90 50NEW PAGE FOR MFG3403307 CL1 43 50 SETON 90 COMMENTS? MFG3403308 CL1 L1END TAG MFG3403350 CLR MOVE ' ' BLANKS 30 MFG3403401 CSR SUB1 BEGSR MFG340003402 CSR SETON 20 MFG3403403 CSR ACTION COMP 'E' 21RELEASE MFG3403404 CSR ACTION COMP 'A' 22ADD MFG3403405 CSR ACTION COMP 'B' 23BLANKET MFG3403406 CSR VEN CHAINVENDOR H1 MFG310 BUG MFG3403407 CSR H1 GOTO END1 MFG3403430 CSR 17 SETON 25 MFG340003450 CSR END1 ENDSR MFG3403460 C** MFG3403461 C** MFG3403600 CSR SUB2 BEGSR MFG3403601 CSR 15 GOTO END2 MFG3403602 CSR K ADD 1 K MFG3403603 CSR K COMP 4 30 MFG340003604 CSR 30 GOTO END2 MFG3403605 CSR MOVE COM SCOM,K MFG3403606 CSR END2 ENDSR MFG3403650 C** MFG3403651 C** MFG3403801 CSR SUB3 BEGSR MFG3403802 CSR PART CHAINPARTMST H2 MFG310 BUG MFG340003803 CSR H2 GOTO END3 MFG3403804 CSRN16 Z-ADDOVCOST COST 73 MFG3403805 CSR 16 Z-ADDSTDMAT COST MFG3403806 CSR LINES COMP 12 90 MFG3403807 CSR 90 Z-ADD0 LINES MFG3403808 CSR LINES ADD 1 LINES MFG3403809 CSR END3 ENDSR MFG340003850 C** MFG3403851 C** MFG340 C* C* CSR FORM BEGSR CSR SETON 9997 CSR FLOOP TAG 00 CSR EXCPT CSR MSG,1 DSPLYCON ANS 1 CSR ANS COMP 'Y' 98 CSR 98 GOTO FOUT CSR GOTO FLOOP CSR FOUT TAG CSR SETOF 97 00 CSR ENDSR 40074O$LP1 D 01 03 20 90 MFG34040075O PAGE Z 81 MFG34040076O 77 '** CONTINUED - PAGE' MFG34040077O 84 '**' MFG3404008 O D 02 L1 20 MFG3404009 O OR 90 MFG340004010 O 23 56 'THIS IS A BLANKET' MFG3404011 O PO 84 ' - ' MFG3404201 O D 10 L1 20 MFG3404202 O OR 90 MFG3404203 O NAME 36 MFG3404401 O D 2 L1 20 MFG3404402 O OR 90 MFG340004403 O 1 ' ' MFG3404404 O N25 AD1 36 MFG3404405 O 25 AD2 36 MFG3404601 O D 1 L1 20 MFG3404602 O OR 90 MFG3404603 O 1 ' ' MFG3404604 O N25 AD2 36 MFG340004801 O D 1 L1 20 MFG3404802 O OR 90 MFG3404803 O AD3 34 MFG3405001 O D 32 L1 20 MFG3405002 O OR 90 MFG3405003 O N10 PODAT Y 9 MFG3405004 O 10 UDATE Y 9 MFG340005007 O N11 HMMDD 81 ' / ' MFG3405008 O N11 82 '/' MFG3405009 O N11 HYY 84 MFG3405201 O D 11 03 20 MFG3405202 O QTYDUEL 10 MFG3405204 O PART 23 MFG3405205 O DESCR 49 MFG340005206 O VPART 62 MFG3405207 O COST L 72 MFG3405208 O UM 75 MFG3405209 O N18 LMMDD 81 ' / ' MFG3305210 O N18 82 '/' MFG3305211 O N18 LYY 84 MFG3305220 O T 01 L1 20 90 MFG340005221 O PAGE Z 81 MFG3405222 O 77 '** CONTINUED - PAGE' MFG3405223 O 84 '**' MFG3405225 O T 0219 L1 20 90 MFG3405226 O 23 56 'THIS IS A BLANKET' MFG3405227 O PO 84 ' - ' MFG3405401 O T 1 L1 20 41 MFG340005402 O 23 'NOTES -' MFG3405403 O SCOM,1 54 MFG3405404 O T 1 L1 20 42 MFG3405405 O SCOM,2 54 MFG3405406 O T 1 L1 20 43 MFG3405407 O SCOM,3 54 MFG3405408 O T 1 L1 20 44 MFG340005409 O SCOM,4 54 MFG3404001 O E 2001 97 4002 O 10 'XXXXXXX-' MFG34040022O 23 'XXXXXXXXXXXX' MFG3404003 O 44 'XXXXXXXXXXXXXXXXXXXX' MFG34040032O 49 'XXXXX' MFG3404004 O 62 'XXXXXXXXXXXX' MFG340004005 O 72 'XXXX.XXX-' MFG3404006 O 75 'XX' MFG3404007 O 84 'XX/XX/XX' MFG340** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F ** IS FORM ALLIGNMENT OK Y/N /* __EQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0(d 8*OTXPO345 P999999050478(00101 H S PO345 X DECK-ID M73 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO345 F* THIS PROGRAM UPDATES PURCHASE HISTORY FILE PO345 F* CYBER 18-10M/20 PURCHASING VERSION 1.0 F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F* CONTROL DATA PROPRIETARY PRODUCT F* 000102 FSPOREC IPEAF 57 DISK MFG3450103 FPOHIST ISEAF 57 DISK MFG3450104 FNEWHIS O F 57 DISK MFG3450201 F********************************************************************MFG3450202 F* MFG3450203 F* COMPANY LOS ANGELES BRUSH MFG3450204 F* SYSTEM PURCHASE/INVENTORY CONTROL MFG345000205 F* PROGRAM PUTS 10 MOST RECENT PURCHASES ON A PART # INTO POHIST MFG3450208 F* MFG3450211 F* MFG3450212 F* CONTRACTOR COMPUSOURCE MFG3450213 F* PROGRAMMER STEVE LEVANDOWSKI MFG3450214 F* DATE NOVEMBER 13, 1975 MFG3450215 F* MFG345000216 F********************************************************************MFG3450217 F* MFG3450301 F* ID F C H L FUNCTION OF INDICATORS MFG3450302 F* MFG3450303 F* 01 SPOREC MFG3450304 F* 02 POHIST MFG3450305 F* 10 POHIST WITH NMR MFG345000306 F* L1PART # MFG3450307 F* M1 PART # MFG3450308 F* MFG3450309 F********************************************************************MFG3450401 ISPOREC NS 01 MFG3450402 I 1 12 PN L1M1 MFG3450403 I 1 57 REC MFG345000406 IPOHIST NS 02 MFG3450407 I 1 12 PN L1M1 MFG3450408 I 1 57 REC MFG3450501 C SETOF 10 MFG3450502 C 02NMR SETON 10 MFG3450503 C 02NMR GOTO END MFG3450504 C L1 01 Z-ADD0 CNT 20 MFG345000505 C* MFG3450506 C 01 MFG3450507 COR 02 CNT ADD 1 CNT MFG3450508 C CNT COMP 10 1010 MFG3450509 C* MFG3450515 C END TAG MFG3450601 ONEWHIS D 10 MFG345000602 O REC 57 MFG345** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F /* 00__ O REC 57 MFG345** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F /* 0(&D OTXPO350 P999999050478(00101 H S PO350 X DECK-ID M74 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO350 F* THIS PROGRAM PRINTS PURCHASE HISTORY FILE OR ANY PART REQUESTED PO350 F* CYBER 18-10M/20 PURCHASING VERSION 1.0 F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F* CONTROL DATA PROPRIETARY PRODUCT F* 000102 FPOHIST IPEAF 57 DISK MFG3500103 FPARTMST IC F 300R12AI 1 DISK MFG3500105 F$LP1 O F 85 OF PRINTER MFG3500110 FHEADING IT F 40 EDISK MFG3300201 F********************************************************************MFG3500202 F* MFG3500203 F* COMPANY LOS ANGELES BRUSH MFG350000204 F* SYSTEM PURCHASING/ INVENTORY CONTROL MFG3500205 F* PROGRAM PRINTOUT OF PURCHASING HISTORY MFG3500206 F* MFG3500207 F* CONTRACTOR COMPUSOURCE MFG3500208 F* PROGRAMMER KATH HILL MFG3500209 F* DATE NOVEMBER 15, 1975 MFG3500210 F* MFG350000211 F********************************************************************MFG3500212 F* MFG3500213 F* NARRATIVE: THE PROGRAM WILL EITHER A. PRINT OUT THE ENTIRE MFG3500214 F* PURCHASING HISTORY OF PART #'S IN POHIST FILE MFG3500215 F* OR B. PRINT OUT THE PURCHASING HISTORY OF ANY MFG3500216 F* PARTICULAR PART #'S ENTERED BY THE OPERATOR. MFG3500217 F* MFG350000218 F********************************************************************MFG3500219 F* MFG3500301 F* ID F C H L FUNCTION OF INDICATORS MFG3500302 F* MFG3500303 F* 01 POHIST MFG3500304 F* 02 PARTMST MFG3500306 F* 11 NO OVERRIDE COST/UM - COST AT STANDARD MFG350000307 F* 12 DELETE FIELD BLANK / PARTMST MFG3500309 F* MFG3500310 F* 20 CHAIN TO PARTMST --- A 'MISS' MFG3500312 F* 31 RUBOUT TO START OF ENTRY MFG3500313 F* 32 RUBOUT TO PREVIOUS ENTRY MFG3500314 F* 33 ON FIRST LINE OF SCREEN MFG3500315 F* 34 LINEFEED MFG350000316 F* 35 END PART # INPUT BY '@' IN PART # MFG3500318 F* 41 VARIANCE FROM STANDARD = 0 MFG3500319 F* 50 I LOOP-WATCHER MFG3500320 F* 51 ALL PART #'S MFG3500321 F* 52 NOT ALL PART #'S MFG3500322 F* 95 PRINTOUT THIS POHIST RECORD MFG3500323 F* 96 Z < 15 (SAME SCREEN) MFG350000324 F* 97 J = 100 (PART # ARRAY FULL) MFG3500325 F* 99 CRT ONCE MFG3500326 F* MFG3500327 F* L1PRNUM/POHIST MFG3500328 F* MFG3500329 F********************************************************************MFG3500330 E HEADING HEAD 1 1 40 MFG330000501 E MSG 1 18 50 CRT MESSAGES MFG3500502 E BLNKS 1 1 72 BLANKS MFG3500503 E EDIT 1 1 72 ERROR MESSAGES MFG3500506 E PR 100 12 PART # TO PRINT MFG3500507 E* OUT HISTORY OF MFG3500601 IPOHIST NS 01 MFG3500602 I 1 12 PRNUM L1 MFG350000603 I 13 170PONUM MFG3500604 I 18 190LOTNUM MFG3500605 I 20 250DUEDAT MFG3500606 I 26 310RECDAT MFG3500607 I 32 360VENDNO MFG3500608 I 37 433COSTUM 11 MFG3500609 I 44 500QTYORD MFG350000610 I 51 570QTYREC MFG3500701 IPARTMST NS 02 MFG3500704 I 13 37 DESCR MFG3500705 I 57 610VNO MFG3500706 I 62 73 VPARTN MFG3500707 I 181 1870MINROP MFG3500708 I 188 1940MAXEOQ MFG350000709 I 44 460LEAD MFG35007095I 47 490SAFTY MFG3500710 I 75 813STDCUM MFG3500711 I 74 74 DLTPR 12 MFG3500712 I 203 2090AVGSA MFG3500901 C* MFG3500902 C N99 EXSR CRT1 MFG350000903 C N99N51 52 EXSR CRT2 MFG3500904 C N99 SETON 99 MFG35009045C MOVELAIR12 AIR12 12 MFG3500905 C* MFG3500906 C NL1 GOTO ON1 MFG3500907 C* MFG3500908 C 51N52 SETON 95 MFG350000909 C N51 52 PRNUM LOKUPPR 95 MFG3500910 C* MFG3500911 C N95 GOTO FINI MFG3500912 C* MFG3500913 C PRNUM CHAINPARTMST 20 NEVER MISS! MFG3500914 C N20N12 SETON 20 MFG3500915 C* MFG350000916 C Z-ADD0 I MFG3501008 C* MFG3501009 C ON1 TAG MFG3501010 C* MFG3501013 C I ADD 1 I MFG3501014 C* MFG3501101 C 20 Z-ADD0 STDCUM MFG3500011015C 11 Z-ADDSTDCUM COSTUM MFG3501102 C STDCUM SUB COSTUM A 73 MFG3501103 C A MULT QTYREC VARI 82H MFG3501104 C* MFG3501105 C STDCUM MULT QTYREC B 73H MFG3501106 C B COMP 0 41 MFG3501107 C 41 Z-ADD1 C 43 MFG350001108 C N41 VARI DIV B C 43H MFG3501109 C C MULT 100 XPCT 41 MFG3501110 C* MFG3501111 C FINI TAG MFG3501112 C* MFG3501113 CLR EXSR CLRSCR MFG3501114 C* MFG350001201 C********************************************************************MFG3501202 C* MFG3501203 C* THIS SUBROUTINE HANDLES THE FIRST CRT DISPLAY. MFG3501204 C* MFG3501205 C********************************************************************MFG3501301 CSR CRT1 BEGSR MFG35013015CSR EXSR CLRSCR MFG350001302 CSR Z-ADD0 I 20 MFG3501303 CSR LOOP1 TAG MFG3501304 CSR I ADD 1 I MFG3501305 CSR I COMP 5 50 MFG3501306 CSR 50 GOTO ENDLP1 MFG3501307 CSR MOVELMSG,I HOLD 60 MFG3501308 CSR MOVE MSG,I WORD44 44 MFG350001309 CSR MOVELHOLD CURPOS 40 MFG3501310 CSR MOVE HOLD LNGTH 20 MFG3501311 CSR EXSR POSCUR MFG3501312 CSR MOVELWORD44 BUFFER 72 MFG3501313 CSR EXSR OUTS MFG35013135CSR GOTO LOOP1 MFG3501314 CSR ENDLP1 TAG MFG350001315 C* MFG3501316 CSR IN1 TAG MFG3501401 CSR MOVELMSG,I HOLD MFG3501402 CSR MOVELHOLD CURPOS MFG3501403 CSR MOVE HOLD LNGTH MFG3501404 CSR EXSR POSCUR MFG3501405 CSR EXSR ACCEPT MFG350001406 CSR MOVELBUFFER ALL 1 MFG35014063CSR MOVEL']' BUFFER MFG35014064CSR Z-ADD1 LNGTH MFG35014065CSR EXSR OUTS MFG3501407 CSR ALL COMP 'Y' 51 MFG3501408 CSR N51ALL COMP 'N' 52 MFG3501409 CSR N52N51 GOTO IN1 MFG350001410 C* MFG3501411 CSR ENDSR MFG3501501 C********************************************************************MFG3501502 C* MFG3501503 C* IF THE OPERATOR DOESN'T DESIRE TO PRINT OUT THE PURCHASING MFG3501504 C* HISTORY FOR ALL PART #'S, THEN THIS SUBROUTINE INQUIRES MFG3501505 C* AS TO WHICH PART #'S THE PURCHASING HISTORY SHOULD BE MFG350001506 C* WRITTEN OUT FOR. [SECOND CRT DISPLAY] MFG3501507 C* MFG3501508 C********************************************************************MFG3501601 CSR CRT2 BEGSR MFG3501602 CSR EXSR CLRSCR MFG3501603 CSR Z-ADD5 I MFG3501604 CSR LOOP2 TAG MFG350001605 CSR I ADD 1 I MFG3501606 CSR I COMP 13 50 MFG3501607 CSR 50 GOTO ENDLP2 MFG3501608 CSR MOVELMSG,I HOLD MFG3501609 CSR MOVE MSG,I WORD44 MFG3501610 CSR MOVELHOLD CURPOS MFG3501611 CSR MOVE HOLD LNGTH MFG350001612 CSR EXSR POSCUR MFG3501613 CSR MOVELWORD44 BUFFER MFG3501614 CSR EXSR OUTS MFG35016145CSR GOTO LOOP2 MFG3501615 CSR ENDLP2 TAG MFG3501616 C* MFG3501701 CSR Z-ADD0 J 30 MFG350001702 CSR LOOP3 TAG MFG3501703 CSR Z-ADD0 Z 30 MFG3501704 CSR LINE TAG MFG3501705 CSR Z ADD 1 Z MFG3501706 CSR J ADD 1 J MFG35017061C* MFG35017062CSR MOVEL'0104' CURPOS MFG3500017063CSR CURPOS ADD Z CURPOS MFG35017064CSR Z-ADD72 LNGTH MFG35017065CSR EXSR POSCUR MFG35017066CSR MOVELBLNKS,1 BUFFER MFG35017067CSR EXSR OUTS MFG35017068CSR MOVEL'5004' CURPOS MFG35017069CSR CURPOS ADD Z CURPOS MFG3500017070CSR Z-ADD22 LNGTH MFG35017071CSR EXSR POSCUR MFG35017072CSR MOVELBLNKS,1 BUFFER MFG35017073CSR EXSR OUTS MFG35017075C* MFG3501708 CSR IN2 TAG MFG3501709 CSR Z-ADD13 I MFG350001710 CSR MOVELMSG,I HOLD MFG3501711 CSR MOVELHOLD CURPOS MFG35017115CSR CURPOS ADD Z CURPOS MFG3501712 CSR MOVELHOLD LNGTH MFG3501713 CSR EXSR POSCUR MFG3501714 CSR MOVELJ BUFFER MFG3501715 CSR EXSR OUTS MFG350001716 C* MFG3501801 CSR IN3 TAG MFG3501802 CSR Z-ADD14 I MFG3501803 CSR MOVELMSG,I HOLD MFG3501804 CSR MOVE MSG,I WORD44 MFG3501805 CSR MOVELHOLD CURPOS MFG35018055CSR CURPOS ADD Z CURPOS MFG350001806 CSR MOVE HOLD LNGTH MFG3501807 CSR EXSR POSCUR MFG3501808 CSR MOVELWORD44 BUFFER MFG3501809 CSR EXSR OUTS MFG3501810 C* MFG3501901 CSR IN4 TAG MFG35019015CSR MOVELBLNKS,1 BUFFER MFG350001902 CSR Z-ADD15 I MFG3501903 CSR MOVELMSG,I HOLD MFG3501904 CSR MOVELHOLD CURPOS MFG35019045CSR CURPOS ADD Z CURPOS MFG3501905 CSR MOVE HOLD LNGTH MFG3501906 CSR EXSR POSCUR MFG3501907 CSR EXSR ACCEPT MFG350001908 CSR RCODE COMP 'R' 31 MFG3501909 CSR BUFFER COMP BLNKS,1 32 MFG3501910 CSR 31N32 GOTO IN4 MFG3501911 CSR 31 32 Z COMP 1 33 MFG3501912 CSR 31 32 33 GOTO IN4 MFG3501913 CSR 31 32N33Z SUB 1 Z MFG3501914 CSR 31 32N33J SUB 1 J MFG350001915 CSR 31 32N33 GOTO IN4 MFG3502001 CSR RCODE COMP 'L' 34 MFG3502005 CSRN34 MOVELBUFFER IT 12 MFG3502006 CSRN34 MOVELIT END1 1 MFG3502007 CSRN34 END1 COMP '@' 35 MFG3502008 CSRN34 35 GOTO CRT2E MFG3502012 CSRN34 MOVELIT PR,J MFG350002013 CSR EXSR POSCUR MFG3502014 CSR 34 MOVELPR,J BUFFER MFG35020145CSRN34 MOVELIT BUFFER MFG3502015 CSR EXSR OUTS MFG3502016 CSR Z-ADD1 LNGTH MFG3502017 CSR MOVEL']' BUFFER MFG3502018 CSR EXSR OUTS MFG350002019 C* MFG3502101 CSR CHECK TAG MFG35021015CSR MOVELPR,J PRJ 12 MFG3502102 CSR PRJ CHAINPARTMST 20 MFG3502103 CSRN20N12 SETON 20 MFG3502104 C* MFG3502105 CSRN20 GOTO IN5 MFG350002106 C* MFG3502107 CSR MOVELEDIT,1 HOLD MFG3502108 CSR MOVELHOLD CURPOS MFG35021085CSR CURPOS ADD Z CURPOS MFG3502109 CSR MOVE HOLD LNGTH MFG3502110 CSR MOVE EDIT,1 WORD66 66 MFG3502111 CSR EXSR POSCUR MFG350002112 CSR MOVELWORD66 BUFFER MFG3502113 CSR EXSR OUTS MFG3502114 CSR GOTO IN4 MFG3502115 C* MFG3502125 CSR IN5 TAG MFG3502126 CSR Z-ADD16 I MFG3502127 CSR MOVELMSG,I HOLD MFG350002128 CSR MOVELHOLD CURPOS MFG3502129 CSR CURPOS ADD Z CURPOS MFG3502130 CSR MOVE HOLD LNGTH MFG3502131 CSR EXSR POSCUR MFG3502132 CSR MOVELDESCR BUFFER MFG3502133 CSR EXSR OUTS MFG3502135 C* MFG350002209 C* MFG3502301 CSR IN6 TAG MFG3502302 CSR Z-ADD17 I MFG3502303 CSR MOVELMSG,I HOLD MFG3502304 CSR MOVELHOLD CURPOS MFG35023045CSR CURPOS ADD Z CURPOS MFG3502305 CSR MOVE HOLD LNGTH MFG350002306 CSR EXSR POSCUR MFG3502307 CSR MOVELVNO BUFFER MFG3502308 CSR EXSR OUTS MFG3502309 C* MFG3502401 CSR IN7 TAG MFG3502402 CSR Z-ADD18 I MFG3502403 CSR MOVELMSG,I HOLD MFG350002404 CSR MOVELHOLD CURPOS MFG35024045CSR CURPOS ADD Z CURPOS MFG3502405 CSR MOVE HOLD LNGTH MFG3502406 CSR EXSR POSCUR MFG3502407 CSR MOVELVPARTN BUFFER MFG3502408 CSR EXSR OUTS MFG35/2409 C* MFG35/002501 CSR J COMP 100 97 MFG3502502 CSR 97 GOTO CRT2ED MFG3502503 CSR 97 Z COMP 15 96 MFG3502504 CSR 96 GOTO LINE MFG3502505 CSRN96 GOTO LOOP3 MFG3502506 C* MFG3502507 CSR CRT2E TAG MFG350002508 CSR MOVELAIR12 PR,J MFG3502509 CSR J COMP 100 97 MFG3502510 CSR 97 GOTO CRT2ED MFG35025101CSR J ADD 1 J MFG35025102CSR GOTO CRT2E MFG3502511 C* MFG3502512 CSR CRT2ED TAG MFG350002513 C* MFG3502514 CSR ENDSR MFG3502601 C********************************************************************MFG3502602 C* MFG3502603 C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. MFG3502604 C* IT DEFINES ALL THE RLABLS NECESSARY. MFG3502605 C* MFG350002606 C********************************************************************MFG3502607 CSR CRTCOM BEGSR MFG350 CSR EXITFSUBRCM SUBCM CSR RLABL BUFFER 72 SUBCM CSR RLABL TYPE 1 SUBCM CSR RLABL BLNGTH 20 SUBCM CSR RLABL RCODE 1 SUBCM 00 CSR RLABL MASK 10 SUBCM CSR RLABL DTYPE 10 SUBCM 2614 CSR ENDSR MFG3502701 C********************************************************************MFG3502702 C* MFG3502703 C* THIS SUBROUTINE CLEARS THE CRT SCREEN. MFG3502704 C* MFG350002705 C********************************************************************MFG3502706 CSR CLRSCR BEGSR MFG3502707 CSR MOVEL'C' TYPE MFG3502708 CSR EXSR CRTCOM MFG3502709 CSR ENDSR MFG3502801 C********************************************************************MFG3502802 C* MFG350002803 C* THIS SUBROUTINE POSITIONS THE CURSOR. MFG3502804 C* MFG3502805 C********************************************************************MFG3502806 CSR POSCUR BEGSR MFG3502807 CSR MOVELCURPOS BUFFER MFG3502808 CSR MOVEL'P' TYPE MFG3502809 CSR EXSR CRTCOM MFG350002810 CSR ENDSR MFG3502901 C********************************************************************MFG3502902 C* MFG3502903 C* THIS SUBROUTINE ACCEPTS INPUT TO THE CRT FROM THE KEYBOARD. MFG3502904 C* MFG3502905 C********************************************************************MFG3502906 CSR ACCEPT BEGSR MFG350002907 CSR MOVELLNGTH BLNGTH MFG3502908 CSR MOVEL'A' TYPE MFG3502909 CSR EXSR CRTCOM MFG3502910 CSR ENDSR MFG3503001 C********************************************************************MFG3503002 C* MFG3503003 C* THIS SUBROUTINE OUTPUTS PRINT TO CRT AND REPOSITIONS THE MFG350003004 C* CURSOR AT BLNGTH-+-1. MFG3503005 C* MFG3503006 C********************************************************************MFG3503007 CSR OUTS BEGSR MFG3503008 CSR MOVELLNGTH BLNGTH MFG3503009 CSR MOVEL'S' TYPE MFG3503010 CSR EXSR CRTCOM MFG350003011 CSR ENDSR MFG3503101 C********************************************************************MFG3503201 O$LP1 D 202 L1 95NOF MFG3503202 O OR NL1 95 OF MFG3503203 O HEAD 65 MFG3503204 O UDATE Y 85 MFG3503205 O D 2 L1 95NOF MFG350003206 O OR NL1 95 OF MFG3503207 O 52 'PURCHASING HISTORY' MFG3503208 O 85 'MFG350' MFG3503209 O D 2 L1 95NOF MFG3503210 O OR NL1 95 OF MFG3503211 O 8 'PART # -' MFG3503213 O PRNUM 21 MFG3500032135O N20DESCR 50 MFG3503214 O 20 47 '*** INVALID PART # ***' MFG3503301 O D 2 L1 95NOF MFG3503302 O OR NL1 95 OF MFG3503303 O 15 'VENDOR PART # -' MFG35033044O 40 'VENDOR # -' MFG35033046O N20VNO Z 46 MFG350003304 O N20VPARTN 28 MFG3503305 O 75 'MIN' MFG3503306 O N20MINROP1 85 MFG3503307 O D 1 L1 95NOF MFG3503308 O OR NL1 95 OF MFG3503309 O 11 'LEAD TIME -' MFG3503310 O N20LEAD Z 15 MFG350003311 O 20 'DAYS' MFG3503313 O 75 'MAX' MFG3503314 O MAXEOQ1 85 MFG3503315 O D 2 L1 95NOF MFG3503316 O OR NL1 95 OF MFG3503317 O 14 'SAFETY STOCK -' MFG3503318 O N20SAFTY Z 18 MFG350003320 O 23 'DAYS' MFG3503401 O D 2 L1 95NOF MFG3503402 O OR NL1 95 OF MFG3503403 O 18 'STANDARD COST/UM -' MFG3503404 O N20STDCUM1 27 MFG3503405 O 75 'AVG USAGE' MFG3503406 O N20AVGSA 1 85 MFG350003501 O D 2 L1 95NOF MFG3503502 O OR NL1 95 OF MFG3503503 O 20 '--------------------' MFG3503504 O 40 '--------------------' MFG3503505 O 60 '--------------------' MFG3503506 O 80 '--------------------' MFG3503507 O 85 '-----' MFG3500035072O D 2 L1 95NOF MFG35035074O OR NL1 95 OF MFG35035076O 45 'RECEIPTS' MFG3503508 O D 1 L1 95NOF MFG3503509 O OR NL1 95 OF MFG3503510 O 26 'DUE' MFG3503511 O 38 'RECEIVE' MFG350003512 O 47 'ORDER' MFG3503513 O 56 'RECEIVE' MFG3503514 O 66 'ACTUAL' MFG3503515 O 76 'VARIANCE' MFG3503601 O D 2 L1 95NOF MFG3503602 O OR NL1 95 OF MFG3503603 O 12 'P.O. #' MFG350003604 O 19 'VENDOR' MFG3503605 O 27 'DATE' MFG3503606 O 36 'DATE' MFG3503607 O 46 'QTY' MFG3503608 O 54 'QTY' MFG3503609 O 66 'COST/UM' MFG3503610 O 76 'FROM STD' MFG350003611 O 84 '% VAR' MFG3503701 O D 2 95 MFG3503702 O I Z 2 MFG3503703 O 3 '.' MFG3503704 O PONUM 9 MFG3503705 O 10 '-' MFG3503706 O LOTNUM 12 MFG350003707 O VENDNOZ 19 MFG3503708 O DUEDATY 29 MFG3503709 O RECDATY 38 MFG3503710 O QTYORDL 48 MFG3503711 O QTYRECL 57 MFG3503712 O COSTUM3 66 MFG3503713 O VARI LB 77 MFG350003714 O XPCT LB 85 MFG350** ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F ** MFG35000220132PURCHASING HISTORY --- DISPLAY 1 MFG350640106MFG350 MFG350030334DO YOU DESIRE ALL PART NUMBERS Y/N MFG350380303[ ] MFG350390301 220132PURCHASING HISTORY --- DISPLAY 2 MFG350640106MFG350 MFG35000030304ITEM MFG350090306PART # MFG350230311DESCRIPTION 490305VEND# 550311VEND PART # 030403 MFG350080414[ ] MFG35000090412 MFG350230420 MFG350490405 MFG350550412 MFG350** MFG350 MFG350** 00230450**INVALID MFG350/* __05 MFG350550412 MFG350** MFG350 MFG350** 0(E ZOTXPO360 P999999050478(000010H S PO360 00020X DECK-ID M75 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO360 00030F* THIS PROGRAM WRITES OPEN PURCHASE ORDER REPORT BY P.O. NUMBER PO360 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO360 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO360 00060F* CONTROL DATA PROPRIETARY PRODUCT PO360 00070F* PO360 0000080FPURCHT IPEAF 60 DISK PO360 00090FPARTMST IC F 300R12AI 1 DISK PO360 00100FVENDOR IC F 256R 5AI 1 DISK PO360 00110F$LP1 O F 132 OF PRINTER PO360 00120FHEADING IT F 40 EDISK PO360 00130F********************************************************************PO360 00140F* PO360 0000150F* COMPANY COMPUSOURCE MANUFACTURING SYSTEM PACKAGE PO360 00160F* SYSTEM PURCHASE/INVENTORY CONTROL PO360 00170F* PROGRAM PRINTS OUT: PO360 00180F* 1. PURCH FILE BY P.O. # AND PART # PO360 00190F* 2. CASH REQUIREMENTS FOR NEXT 3 MONTHS PO360 00200F* PO360 00210F* PO360 0000220F* CONTRACTOR COMPUSOURCE PO360 00230F* PROGRAMMER KATH HILL PO360 00240F* DATE NOVEMBER 13, 1975 PO360 00250F* PO360 00260F********************************************************************PO360 00270F* PO360 00280F* ID F C H L FUNCTION OF INDICATORS PO360 0000290F* PO360 00300F* 01 PURCHT PO360 00310F* 02 PARTMST PO360 00320F* 03 VENDOR PO360 00330F* PO360 00340F* 11 COST/UM OVERRIDE (PURCH) BLANK PO360 00350F* 12 DELETE CODE (PARTMST) BLANK PO360 0000360F* 13 DELETE CODE (VENDOR) BLANK PO360 00370F* PO360 00380F* 20 CHAIN TO PARTMST --- 'MISS' PO360 00390F* 30 CHAIN TO VENDOR --- 'MISS' PO360 00400F* 40 LOOK-UP MONTHS IN TABA --- # OF DAYS IN MONTH (TABB)PO360 00410F* 41 I LOOP-WATCHER PO360 00420F* 42 CHECK DAYS AGAINST # OF DAYS IN THIS MONTH PO360 0000430F* 43 COMPARE THIS MONTH TO DECEMBER PO360 00440F* 50 DATE <= IPL DATE (* IN COL 132) PO360 00450F* BUCKET THE $ PO360 00460F* 60 DATE > 6 MONTHS FROM IPL DATE PO360 00470F* BUCKET THE $ PO360 00480F* 75 BLANKET --> NOT INTO SUMMARY FIGURES. PO360 00490F* 55 BUCKET THE $ PO360 0000500F* 99 ONLY FIGURE OUT DATE DIVISIONS OF BUCKETS ONCE PO360 00510F* PO360 00520F* L3POKEY /PURCHT PO360 00530F* L2PART#/PURCHT PO360 00540F* L1VENDOR #/PURCHT PO360 00550F* LRPRINT OUT CASH REQUIREMENTS FORECAST FOR NEXT PO360 00560F* SIX MONTHS PO360 0000570F* PO360 00580F********************************************************************PO360 00590E HEADING HEAD 1 1 40 PO360 00600E TABA 1 12 2 0 TABB 2 0 MTHS/# OF DAYS PO360 00610E DAT 25 6 0 BUCKETS PO360 00620E REQ 26 9 2 $ IN BUCKETS PO360 00630IPURCHT NS 01 PO360 0000640I 1 50PO PO360 00650I 6 70LOT PO360 00660I 1 70POKEY L3 PO360 00670I 8 19 PART L2 PO360 00680I 20 210DUEY PO360 00690I 22 250DUEMD PO360 00700I 20 250DUEDAT PO360 0000710I 26 300VEND L1 PO360 00720I 31 360PODATE PO360 00730I 37 430QTYORD PO360 00740I 44 500QTYREC PO360 00750I 51 573CUMOV 11 PO360 00760I 58 58 POCODE PO360 00770IPARTMST NS 02 PO360 0000780I 13 37 DESCR PO360 00790I 75 813STDCST PO360 00800I 74 74 DLTPR 12 PO360 00810IVENDOR NS 03 PO360 00820I 1 50VENDNO PO360 00830I 6 30 VNAME PO360 00840I 106 106 DLTV 13 PO360 0000850C L3 POCODE COMP 'B' 75BLANKET PO360 00860C N99 EXSR LDDAT PO360 00870C N99 SETON 99 PO360 00880C* PO360 00890C L1 VEND CHAINVENDOR 30 PO360 00900C L1N30N13 SETON 30 PO360 00910C* PO360 0000920C L2 PART CHAINPARTMST 20 PO360 00930C L2N20N12 SETON 20 PO360 00940C* PO360 00950C N11 Z-ADDCUMOV COST 73 PO360 00960C 11 20 Z-ADD0 COST PO360 00970C 11N20 Z-ADDSTDCST COST PO360 00980C* PO360 0000990C QTYORD SUB QTYREC BALDUE 70 PO360 01000C BALDUE MULT COST EXTCST 92H PO360 01010C L3 Z-ADD0 TOTDUE 102 PO360 01020C 01 EXTCST ADD TOTDUE TOTDUE H PO360 01030C* PO360 01040C 75 GOTO ENDLP2 PO360 01050C MOVELDUEY DATE 60 PO360 0001060C MOVE DUEMD DATE PO360 01070C* PO360 01080C MOVELDUEMD OUTDAT 60 PO360 01090C MOVE DUEY OUTDAT PO360 01100C* PO360 01110C DATE COMP DAT,1 5050 PO360 01120C* PO360 0001130C DATE COMP DAT,25 60 PO360 01140C* PO360 01150C 60 REQ,26 ADD EXTCST REQ,26 PO360 01160C 60 GOTO ENDLP2 PO360 01170C* PO360 01180C Z-ADD0 I PO360 01190C LOOP2 TAG PO360 0001200C I ADD 1 I PO360 01210C DATE COMP DAT,I 5555 PO360 01220C 55 REQ,I ADD EXTCST REQ,I PO360 01230C 55 GOTO ENDLP2 PO360 01240C GOTO LOOP2 PO360 01250C ENDLP2 TAG PO360 01260C* PO360 0001270CLR XFOOTREQ TOTREQ 92 PO360 01280C* PO360 01290CLR Z-ADD0 I PO360 01300CLR LOOP3 TAG PO360 01310CLR I ADD 1 I PO360 01320CLR I COMP 26 41 PO360 01330CLR 41 GOTO ENDLP3 PO360 0001340CLR MOVELDAT,I YY PO360 01350CLR MOVE DAT,I MMDD PO360 01360CLR MOVELMMDD DAT,I PO360 01370CLR MOVE YY DAT,I PO360 01380CLR GOTO LOOP3 PO360 01390CLR ENDLP3 TAG PO360 01400C********************************************************************PO360 0001410C* PO360 01420C* THIS SUBROUTINE TAKES THE IPL DATE AND, USING IT, FORMS AN PO360 01430C* ARRAY OF DATES. THE DATE ARRAY IS USED TO FORECAST CASH [YYMMDD] PO360 01440C* REQUIRMENTS FOR THE NEXT 3 MONTHS ON A WEEK-BY-WEEK BASIS. PO360 01450C* PO360 01460C********************************************************************PO360 01470CSR LDDAT BEGSR PO360 0001480CSR MOVELUDATE MMDD 40 PO360 01490CSR MOVE UDATE YY 20 PO360 01500CSR MOVELMMDD MM 20 PO360 01510CSR MOVE MMDD DD 20 PO360 01520C* PO360 01530CSR MM LOKUPTABA TABB 40 PO360 01540CSR Z-ADD1 I 20 PO360 0001550CSR MOVELYY DAT,I PO360 01560CSR MOVE MMDD DAT,I PO360 01570C* PO360 01580CSR LOOP1 TAG PO360 01590CSR MM LOKUPTABA TABB 40 PO360 01600CSR I ADD 1 I PO360 01610CSR I COMP 26 41 PO360 0001620CSR 41 GOTO ENDLP1 PO360 01630CSR DD ADD 7 DD7 20 PO360 01640CSR DD7 COMP TABB 42 PO360 01650CSR 42 DD7 SUB TABB DD7 PO360 01660CSR 42 MM COMP 12 43 PO360 01670CSR 42 43 Z-ADD1 MM PO360 01680CSR 42 43 YY ADD 1 YY PO360 0001690CSR 42N43 MM ADD 1 MM PO360 01700CSR Z-ADDDD7 DD PO360 01710C* PO360 01720CSR MOVELMM MMDD PO360 01730CSR MOVE DD MMDD PO360 01740CSR MOVELYY DAT,I PO360 01750CSR MOVE MMDD DAT,I PO360 0001760CSR GOTO LOOP1 PO360 01770CSR ENDLP1 TAG PO360 01780CSR ENDSR PO360 01790C********************************************************************PO360 01800O$LP1 H 202 1P PO360 01810O OR LRNOF PO360 01820O OR OFNLR PO360 0001830O PAGE Z 8 PO360 01840O 4 'PAGE' PO360 01850O HEAD 85 PO360 01860O UDATE Y 132 PO360 01870O H 2 1P PO360 01880O OR LRNOF PO360 01890O OR OFNLR PO360 0001900O 68 'OPEN PURCHASE ORDERS' PO360 01910O 78 'BY P.O. #' PO360 01920O 132 'MFG360' PO360 01930O H 2 1P PO360 01940O OR OFNLR PO360 01950O 8 'PO/LOT #' PO360 01960O 16 'PART #' PO360 0001970O 35 'DESCRIPTION' PO360 01980O 57 'VEND #' PO360 01990O 71 'TYPE' PO360 02000O 82 'ORDERED' PO360 02010O 94 'RECEIVED' PO360 02020O 106 'BAL DUE' PO360 02030O 118 'COST/UM' PO360 0002040O 130 'DUE DATE' PO360 02050O D 1 01 PO360 02060O L3 PO 5 PO360 02070O L3 6 '-' PO360 02080O L3 LOT 8 PO360 02090O PART 22 PO360 02100O N20 DESCR 49 PO360 0002110O VEND 57 PO360 02120O 30 67 '*INVALID*' PO360 02130O 20 46 '*** INVALID PART # ***' PO360 02140O POCODE 69 PO360 02150O QTYORDJ 83 PO360 02160O QTYRECJ 95 PO360 02170O BALDUEJ 107 PO360 0002180O COST J 119 PO360 02190O OUTDATY 130 PO360 02200O 50 132 '*' PO360 02210O T 12 L3 PO360 02220O 25 '** TOTAL DOLLAR VALUE' PO360 02230O 35 'FOR P.O.#' PO360 02240O PO 41 PO360 0002250O 42 '-' PO360 02260O LOT 44 PO360 02270O 49 'IS $' PO360 02280O TOTDUEJ 63 PO360 02290O T 3 LR PO360 02300O 11 'END OF JOB.' PO360 02310O 36 'TOTAL STOCK-ON-ORDER IS' PO360 0002320O 40 ' $' PO360 02330O TOTREQJ 53 PO360 02340O T 202 LR PO360 02350O HEAD,1 85 PO360 02360O UDATE Y 132 PO360 02370O T 22 LR PO360 02380O 68 'CASH REQUIREMENT ' PO360 0002390O 75 'SUMMARY' PO360 02400O T 3 LR PO360 02410O 17 'VALUE OF PURCHASE' PO360 02420O 34 'ORDERS BY PERIOD' PO360 02430O 70 'PERIOD DATE' PO360 02440O 89 'PURCHASE VALUE' PO360 02450O T 1 LR PO360 0002460O 70 'PAST DUE' PO360 02470O REQ,1 J 90 PO360 02480O T 1 LR PO360 02490O DAT,2 Y 70 PO360 02500O REQ,2 J 90 PO360 02510O T 1 LR PO360 02520O DAT,3 Y 70 PO360 0002530O REQ,3 J 90 PO360 02540O T 1 LR PO360 02550O DAT,4 Y 70 PO360 02560O REQ,4 J 90 PO360 02570O T 1 LR PO360 02580O DAT,5 Y 70 PO360 02590O REQ,5 J 90 PO360 0002600O T 1 LR PO360 02610O DAT,6 Y 70 PO360 02620O REQ,6 J 90 PO360 02630O T 1 LR PO360 02640O DAT,7 Y 70 PO360 02650O REQ,7 J 90 PO360 02660O T 1 LR PO360 0002670O DAT,8 Y 70 PO360 02680O REQ,8 J 90 PO360 02690O T 1 LR PO360 02700O DAT,9 Y 70 PO360 02710O REQ,9 J 90 PO360 02720O T 1 LR PO360 02730O DAT,10Y 70 PO360 0002740O REQ,10J 90 PO360 02750O T 1 LR PO360 02760O DAT,11Y 70 PO360 02770O REQ,11J 90 PO360 02780O T 1 LR PO360 02790O DAT,12Y 70 PO360 02800O REQ,12J 90 PO360 0002810O T 1 LR PO360 02820O DAT,13Y 70 PO360 02830O REQ,13J 90 PO360 02840O T 1 LR PO360 02850O DAT,14Y 70 PO360 02860O REQ,14J 90 PO360 02870O T 1 LR PO360 0002880O DAT,15Y 70 PO360 02890O REQ,15J 90 PO360 02900O T 1 LR PO360 02910O DAT,16Y 70 PO360 02920O REQ,16J 90 PO360 02930O T 1 LR PO360 02940O DAT,17Y 70 PO360 0002950O REQ,17J 90 PO360 02960O T 1 LR PO360 02970O DAT,18Y 70 PO360 02980O REQ,18J 90 PO360 02990O T 1 LR PO360 03000O DAT,19Y 70 PO360 03010O REQ,19J 90 PO360 0003020O T 1 LR PO360 03030O DAT,20Y 70 PO360 03040O REQ,20J 90 PO360 03050O T 1 LR PO360 03060O DAT,21Y 70 PO360 03070O REQ,21J 90 PO360 03080O T 1 LR PO360 0003090O DAT,22Y 70 PO360 03100O REQ,22J 90 PO360 03110O T 1 LR PO360 03120O DAT,23Y 70 PO360 03130O REQ,23J 90 PO360 03140O T 1 LR PO360 03150O DAT,24Y 70 PO360 0003160O REQ,24J 90 PO360 03170O T 1 LR PO360 03180O DAT,25Y 70 PO360 03190O REQ,25J 90 PO360 03200O T 1 LR PO360 03210O 70 'OVER 24' PO360 03220O REQ,26J 90 PO360 0003230O T 1 LR PO360 03240O 90 '---------------' PO360 03250O T 1 LR PO360 03260O 90 '$ ' PO360 03270O TOTREQJ 90 PO360 ** 003280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00329000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003310ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003320** 0033300131 0033400229 0033500331 003360000430 0033700531 0033800630 0033900731 0034000831 0034100930 0034201031 003430001130 0034401231 003450/* 003460__ 0034000831 0034100930 0034201031 0034300(F2 SOTXPO365 P999999050478(000010H S PO365 00020X DECK-ID M76 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO365 00030F* THIS PROGRAM WRITES OPEN PURCHASE ORDER REPORT BY VENDOR NUMBER PO365 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO365 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO365 00060F* CONTROL DATA PROPRIETARY PRODUCT PO365 00070F* PO365 0000080FPURCHT IPEAF 60 DISK PO365 00090FPARTMST IC F 300R12AI 1 DISK PO365 00100FVENDOR IC F 256R 5AI 1 DISK PO365 00110F$LP1 O F 132 OF PRINTER PO365 00120FHEADING IT F 40 EDISK PO365 00130F********************************************************************PO365 00140F* PO365 0000150F* COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE PO365 00160F* SYSTEM PURCHASE/INVENTORY CONTROL PO365 00170F* PROGRAM PRINTS OUT: PO365 00180F* 1. PURCH FILE BY VEND #, PART #, AND PO365 00190F* DUE DATE (YYMMDD) PO365 00200F* 2. CASH REQUIREMENTS FOR NEXT SIX MONTHS PO365 00210F* PO365 0000220F* PO365 00230F* CONTRACTOR COMPUSOURCE PO365 00240F* PROGRAMMER KATH HILL PO365 00250F* DATE NOVEMBER 13, 1975 PO365 00260F* PO365 00270F********************************************************************PO365 00280F* PO365 0000290F* ID F C H L FUNCTION OF INDICATORS PO365 00300F* PO365 00310F* 01 PURCHT PO365 00320F* 02 PARTMST PO365 00330F* 03 VENDOR PO365 00340F* PO365 00350F* 11 COST/UM OVERRIDE (PURCH) BLANK PO365 0000360F* 12 DELETE CODE (PARTMST) BLANK PO365 00370F* 13 DELETE CODE (VENDOR) BLANK PO365 00380F* PO365 00390F* 20 CHAIN TO PARTMST --- 'MISS' PO365 00400F* 30 CHAIN TO VENDOR --- 'MISS' PO365 00410F* 40 LOOK-UP MONTHS IN TABA --- # OF DAYS IN MONTH (TABB)PO365 00420F* 41 I LOOP-WATCHER PO365 0000430F* 42 CHECK DAYS AGAINST # OF DAYS IN THIS MONTH PO365 00440F* 43 COMPARE THIS MONTH TO DECEMBER PO365 00450F* 50 DATE <= IPL DATE (* IN COL 132) PO365 00460F* BUCKET THE $ PO365 00470F* 60 DATE > 3 MONTHS FROM IPL DATE PO365 00480F* BUCKET THE $ PO365 00490F* 55 BUCKET THE $ PO365 0000500F* 75 BLANKET --> NOT INTO BAL DUE OR SUMMARY FIGURES. PO365 00510F* 99 ONLY FIGURE OUT DATE DIVISIONS OF BUCKETS ONCE PO365 00520F* PO365 00530F* L1DUE DATE/PURCHT PO365 00540F* L2PART #/ PURCHT PO365 00550F* L3VENDOR #/PURCHT PO365 00560F* LRPRINT OUT CASH REQUIREMENTS FORECAST FOR NEXT PO365 0000570F* SIX MONTHS PO365 00580F* PO365 00590F********************************************************************PO365 00600E HEADING HEAD 1 1 40 PO365 00610E TABA 1 12 2 0 TABB 2 0 MTHS/# OF DAYS PO365 00620E DAT 25 6 0 BUCKETS PO365 00630E REQ 26 9 2 $ IN BUCKETS PO365 0000640IPURCHT NS 01 PO365 00650I 1 50PO PO365 00660I 6 70LOT PO365 00670I 1 70POKEY PO365 00680I 8 19 PART L2 PO365 00690I 20 210DUEY PO365 00700I 22 250DUEMD PO365 0000710I 20 250DUEDATL1 PO365 00720I 26 300VEND L3 PO365 00730I 31 360PODATE PO365 00740I 37 430QTYORD PO365 00750I 44 500QTYREC PO365 00760I 51 573CUMOV 11 PO365 00770I 58 58 POCODE PO365 0000780IPARTMST NS 02 PO365 00790I 75 813STDCST PO365 00800I 74 74 DLTPR 12 PO365 00810IVENDOR NS 03 PO365 00820I 1 50VENDNO PO365 00830I 6 30 VNAME PO365 00840I 106 106 DLTV 13 PO365 0000850C 01 POCODE COMP 'B' 75BLANKET PO365 00860C N99 EXSR LDDAT PO365 00870C N99 SETON 99 PO365 00880C* PO365 00890C L3 VEND CHAINVENDOR 30 PO365 00900C L3N30N13 SETON 30 PO365 00910C* PO365 0000920C L2 PART CHAINPARTMST 20 PO365 00930C L2N20N12 SETON 20 PO365 00940C* PO365 00950C N11 Z-ADDCUMOV COST 73 PO365 00960C 11 20 Z-ADD0 COST PO365 00970C 11N20 Z-ADDSTDCST COST PO365 00980C* PO365 0000990C 75 GOTO ENDLP2 PO365 01000C QTYORD SUB QTYREC BALDUE 70 PO365 01010C BALDUE MULT COST EXTCST 92H PO365 01020C* PO365 01030C MOVELDUEY DATE 60 PO365 01040C MOVE DUEMD DATE PO365 01050C* PO365 0001060C MOVELDUEMD OUTDAT 60 PO365 01070C MOVE DUEY OUTDAT PO365 01080C* PO365 01090C DATE COMP DAT,1 5050 PO365 01100C* PO365 01110C DATE COMP DAT,25 60 PO365 01120C* PO365 0001130C 60 REQ,26 ADD EXTCST REQ,26 PO365 01140C 60 GOTO ENDLP2 PO365 01150C* PO365 01160C Z-ADD0 I PO365 01170C LOOP2 TAG PO365 01180C I ADD 1 I PO365 01190C DATE COMP DAT,I 5555 PO365 0001200C 55 REQ,I ADD EXTCST REQ,I PO365 01210C 55 GOTO ENDLP2 PO365 01220C GOTO LOOP2 PO365 01230C ENDLP2 TAG PO365 01240C* PO365 01250CLR XFOOTREQ TOTREQ 92 PO365 01260C* PO365 0001270CLR Z-ADD0 I PO365 01280CLR LOOP3 TAG PO365 01290CLR I ADD 1 I PO365 01300CLR I COMP 26 41 PO365 01310CLR 41 GOTO ENDLP3 PO365 01320CLR MOVELDAT,I YY PO365 01330CLR MOVE DAT,I MMDD PO365 0001340CLR MOVELMMDD DAT,I PO365 01350CLR MOVE YY DAT,I PO365 01360CLR GOTO LOOP3 PO365 01370CLR ENDLP3 TAG PO365 01380C********************************************************************PO365 01390C* PO365 01400C* THIS SUBROUTINE TAKES THE IPL DATE AND, USING IT, FORMS AN PO365 0001410C* ARRAY OF DATES. THE DATE ARRAY IS USED TO FORECAST CASH [YYMMDD] PO365 01420C* REQUIRMENTS FOR THE NEXT 3 MONTHS ON A WEEK-BY-WEEK BASIS. PO365 01430C* PO365 01440C********************************************************************PO365 01450CSR LDDAT BEGSR PO365 01460CSR MOVELUDATE MMDD 40 PO365 01470CSR MOVE UDATE YY 20 PO365 0001480CSR MOVELMMDD MM 20 PO365 01490CSR MOVE MMDD DD 20 PO365 01500C* PO365 01510CSR MM LOKUPTABA TABB 40 PO365 01520CSR Z-ADD1 I 20 PO365 01530CSR MOVELYY DAT,I PO365 01540CSR MOVE MMDD DAT,I PO365 0001550C* PO365 01560CSR LOOP1 TAG PO365 01570CSR MM LOKUPTABA TABB 40 PO365 01580CSR I ADD 1 I PO365 01590CSR I COMP 26 41 PO365 01600CSR 41 GOTO ENDLP1 PO365 01610CSR DD ADD 7 DD7 20 PO365 0001620CSR DD7 COMP TABB 42 PO365 01630CSR 42 DD7 SUB TABB DD7 PO365 01640CSR 42 MM COMP 12 43 PO365 01650CSR 42 43 Z-ADD1 MM PO365 01660CSR 42 43 YY ADD 1 YY PO365 01670CSR 42N43 MM ADD 1 MM PO365 01680CSR Z-ADDDD7 DD PO365 0001690C* PO365 01700CSR MOVELMM MMDD PO365 01710CSR MOVE DD MMDD PO365 01720CSR MOVELYY DAT,I PO365 01730CSR MOVE MMDD DAT,I PO365 01740CSR GOTO LOOP1 PO365 01750CSR ENDLP1 TAG PO365 0001760CSR ENDSR PO365 01770C********************************************************************PO365 01780O$LP1 H 202 1P PO365 01790O OR LRNOF PO365 01800O OR OFNLR PO365 01810O PAGE Z 8 PO365 01820O 4 'PAGE' PO365 0001830O HEAD 85 PO365 01840O UDATE Y 132 PO365 01850O H 2 1P PO365 01860O OR LRNOF PO365 01870O OR OFNLR PO365 01880O 70 'OPEN PURCHASE ORDERS' PO365 01890O 80 'BY VENDOR' PO365 0001900O 132 'MFG365' PO365 01910O H 1 1P PO365 01920O OR OFNLR PO365 01930O 5 'VEND#' PO365 01940O 12 'NAME' PO365 01950O 43 'PO/LOT #' PO365 01960O 56 'PART #' PO365 0001970O 71 'TYPE' PO365 01980O 82 'ORDERED' PO365 01990O 94 'RECEIVED' PO365 02000O 106 'BAL DUE' PO365 02010O 118 'COST/UM' PO365 02020O 130 'DUE DATE' PO365 02030O D 1 L2NLR PO365 0002040O 1 ' ' PO365 02050O D 1 01 PO365 02060O L3 VEND Z 5 PO365 02070O L3 N30VNAME 33 PO365 02080O L3 30 30 '*** INVALID VEND # ***' PO365 02090O PO 40 PO365 02100O 41 '-' PO365 0002110O LOT 43 PO365 02120O 20 49 '***' PO365 02130O PART 62 PO365 02140O 20 66 '***' PO365 02150O POCODE 69 PO365 02160O QTYORDJ 83 PO365 02170O QTYRECJ 95 PO365 0002180O N75 BALDUEJ 107 PO365 02190O COST J 119 PO365 02200O OUTDATY 130 PO365 02210O 50 132 '*' PO365 02220O T 3 LR PO365 02230O 11 'END OF JOB.' PO365 02240O 36 'TOTAL STOCK-ON-ORDER IS' PO365 0002250O 40 ' $' PO365 02260O TOTREQJ 53 PO365 02270O T 202 LR PO365 02280O HEAD 85 PO365 02290O UDATE Y 132 PO365 02300O T 3 LR PO365 02310O 68 'CASH REQUIREMENT ' PO365 0002320O 75 'SUMMARY' PO365 02330O T 3 LR PO365 02340O 17 'VALUE OF PURCHASE' PO365 02350O 34 'ORDERS BY PERIOD' PO365 02360O 70 'PERIOD DATE' PO365 02370O 89 'PURCHASE VALUE' PO365 02380O T 1 LR PO365 0002390O 70 'PAST DUE' PO365 02400O REQ,1 J 90 PO365 02410O T 1 LR PO365 02420O DAT,2 Y 70 PO365 02430O REQ,2 J 90 PO365 02440O T 1 LR PO365 02450O DAT,3 Y 70 PO365 0002460O REQ,3 J 90 PO365 02470O T 1 LR PO365 02480O DAT,4 Y 70 PO365 02490O REQ,4 J 90 PO365 02500O T 1 LR PO365 02510O DAT,5 Y 70 PO365 02520O REQ,5 J 90 PO365 0002530O T 1 LR PO365 02540O DAT,6 Y 70 PO365 02550O REQ,6 J 90 PO365 02560O T 1 LR PO365 02570O DAT,7 Y 70 PO365 02580O REQ,7 J 90 PO365 02590O T 1 LR PO365 0002600O DAT,8 Y 70 PO365 02610O REQ,8 J 90 PO365 02620O T 1 LR PO365 02630O DAT,9 Y 70 PO365 02640O REQ,9 J 90 PO365 02650O T 1 LR PO365 02660O DAT,10Y 70 PO365 0002670O REQ,10J 90 PO365 02680O T 1 LR PO365 02690O DAT,11Y 70 PO365 02700O REQ,11J 90 PO365 02710O T 1 LR PO365 02720O DAT,12Y 70 PO365 02730O REQ,12J 90 PO365 0002740O T 1 LR PO365 02750O DAT,13Y 70 PO365 02760O REQ,13J 90 PO365 02770O T 1 LR PO365 02780O DAT,14Y 70 PO365 02790O REQ,14J 90 PO365 02800O T 1 LR PO365 0002810O DAT,15Y 70 PO365 02820O REQ,15J 90 PO365 02830O T 1 LR PO365 02840O DAT,16Y 70 PO365 02850O REQ,16J 90 PO365 02860O T 1 LR PO365 02870O DAT,17Y 70 PO365 0002880O REQ,17J 90 PO365 02890O T 1 LR PO365 02900O DAT,18Y 70 PO365 02910O REQ,18J 90 PO365 02920O T 1 LR PO365 02930O DAT,19Y 70 PO365 02940O REQ,19J 90 PO365 0002950O T 1 LR PO365 02960O DAT,20Y 70 PO365 02970O REQ,20J 90 PO365 02980O T 1 LR PO365 02990O DAT,21Y 70 PO365 03000O REQ,21J 90 PO365 03010O T 1 LR PO365 0003020O DAT,22Y 70 PO365 03030O REQ,22J 90 PO365 03040O T 1 LR PO365 03050O DAT,23Y 70 PO365 03060O REQ,23J 90 PO365 03070O T 1 LR PO365 03080O DAT,24Y 70 PO365 0003090O REQ,24J 90 PO365 03100O T 1 LR PO365 03110O DAT,25Y 70 PO365 03120O REQ,25J 90 PO365 03130O T 1 LR PO365 03140O 70 'OVER 24' PO365 03150O REQ,26J 90 PO365 0003160O T 1 LR PO365 03170O 90 '---------------' PO365 03180O T 1 LR PO365 03190O 90 '$ ' PO365 03200O TOTREQJ 90 PO365 ** 003210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00322000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003240ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003250** 0032600131 0032700229 0032800331 003290000430 0033000531 0033100630 0033200731 0033300831 0033400930 0033501031 003360001130 0033701231 003380/* 003390__ 0033300831 0033400930 0033501031 0033600(F WOTXPO370 P999999050478(000010H S PO370 00020X DECK-ID M77 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO370 00030F* THIS PROGRAM WRITES OPEN PURCHASE ORDER REPORT BY PART NUMBER PO370 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO370 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO370 00060F* CONTROL DATA PROPRIETARY PRODUCT PO370 00070F* PO370 0000080FPURCHT IPEAF 60 DISK PO370 00090FPARTMST IC F 300R12AI 1 DISK PO370 00100FVENDOR IC F 256R 5AI 1 DISK PO370 00110F$LP1 O F 132 OF PRINTER PO370 00120FHEADING IT F 40 EDISK PO370 00130F********************************************************************PO370 00140F* PO370 0000150F* COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE PO370 00160F* SYSTEM PURCHASE/INVENTORY CONTROL PO370 00170F* PROGRAM PRINTS OUT: PO370 00180F* 1. PURCH FILE BY PART#/DUE DATE (YYMMDD) PO370 00190F* 2. CASH REQUIREMENTS FOR NEXT SIX MONTHS PO370 00200F* PO370 00210F* PO370 0000220F* CONTRACTOR COMPUSOURCE PO370 00230F* PROGRAMMER KATH HILL PO370 00240F* DATE NOVEMBER 13, 1975 PO370 00250F* PO370 00260F********************************************************************PO370 00270F* PO370 00280F* ID F C H L FUNCTION OF INDICATORS PO370 0000290F* PO370 00300F* 01 PURCHT PO370 00310F* 02 PARTMST PO370 00320F* 03 VENDOR PO370 00330F* PO370 00340F* 11 COST/UM OVERRIDE (PURCH) BLANK PO370 00350F* 12 DELETE CODE (PARTMST) BLANK PO370 0000360F* 13 DELETE CODE (VENDOR) BLANK PO370 00370F* PO370 00380F* 20 CHAIN TO PARTMST --- 'MISS' PO370 00390F* 30 CHAIN TO VENDOR --- 'MISS' PO370 00400F* 40 LOOK-UP MONTHS IN TABA --- # OF DAYS IN MONTH (TABB)PO370 00410F* 41 I LOOP-WATCHER PO370 00420F* 42 CHECK DAYS AGAINST # OF DAYS IN THIS MONTH PO370 0000430F* 43 COMPARE THIS MONTH TO DECEMBER PO370 00440F* 50 DATE <= IPL DATE (* IN COL 132) PO370 00450F* BUCKET THE $ PO370 00460F* 60 DATE > 6 MONTHS FROM IPL DATE PO370 00470F* BUCKET THE $ PO370 00480F* 55 BUCKET THE $ PO370 00490F* 75 BLANKET --> NOT INTO BAL DUE OR SUMMARY FIGURES. PO370 0000500F* 99 ONLY FIGURE OUT DATE DIVISIONS OF BUCKETS ONCE PO370 00510F* PO370 00520F* L3PART #/PURCHT PO370 00530F* L2DUE DATE/PURCHT PO370 00540F* L1VENDOR #/PURCHT PO370 00550F* LRPRINT OUT CASH REQUIREMENTS FORECAST FOR NEXT PO370 00560F* 3 MONTHS PO370 0000570F* PO370 00580F********************************************************************PO370 00590E HEADING HEAD 1 1 40 PO370 00600E TABA 1 12 2 0 TABB 2 0 MTHS/# OF DAYS PO370 00610E DAT 25 6 0 BUCKETS PO370 00620E REQ 26 9 2 $ IN BUCKETS PO370 00630IPURCHT NS 01 PO370 0000640I 1 50PO PO370 00650I 6 70LOT PO370 00660I 1 70POKEY PO370 00670I 8 19 PART L3 PO370 00680I 20 210DUEY PO370 00690I 22 250DUEMD PO370 00700I 20 250DUEDATL2 PO370 0000710I 26 300VEND L1 PO370 00720I 31 360PODATE PO370 00730I 37 430QTYORD PO370 00740I 44 500QTYREC PO370 00750I 51 573CUMOV 11 PO370 00760I 58 58 POCODE PO370 00770IPARTMST NS 02 PO370 0000780I 13 37 DESCR PO370 00790I 75 813STDCST PO370 00800I 74 74 DLTPR 12 PO370 00810IVENDOR NS 03 PO370 00820I 1 50VENDNO PO370 00830I 6 30 VNAME PO370 00840I 106 106 DLTV 13 PO370 0000850C 01 POCODE COMP 'B' 75BLANKET PO370 00860C N99 EXSR LDDAT PO370 00870C N99 SETON 99 PO370 00880C* PO370 00890C L1 VEND CHAINVENDOR 30 PO370 00900C L1N30N13 SETON 30 PO370 00910C* PO370 0000920C L3 PART CHAINPARTMST 20 PO370 00930C L3N20N12 SETON 20 PO370 00940C* PO370 00950C N11 Z-ADDCUMOV COST 73 PO370 00960C 11 20 Z-ADD0 COST PO370 00970C 11N20 Z-ADDSTDCST COST PO370 00980C* PO370 0000990C 75 GOTO ENDLP2 PO370 01000C QTYORD SUB QTYREC BALDUE 70 PO370 01010C L3 Z-ADD0 TBALDU PO370 01020C BALDUE ADD TBALDU TBALDU 90 PO370 01030C BALDUE MULT COST EXTCST 92H PO370 01040C* PO370 01050C MOVELDUEY DATE 60 PO370 0001060C MOVE DUEMD DATE PO370 01070C* PO370 01080C MOVELDUEMD OUTDAT 60 PO370 01090C MOVE DUEY OUTDAT PO370 01100C* PO370 01110C DATE COMP DAT,1 5050 PO370 01120C* PO370 0001130C DATE COMP DAT,25 60 PO370 01140C* PO370 01150C 60 REQ,26 ADD EXTCST REQ,26 PO370 01160C 60 GOTO ENDLP2 PO370 01170C* PO370 01180C Z-ADD0 I PO370 01190C LOOP2 TAG PO370 0001200C I ADD 1 I PO370 01210C DATE COMP DAT,I 5555 PO370 01220C 55 REQ,I ADD EXTCST REQ,I PO370 01230C 55 GOTO ENDLP2 PO370 01240C GOTO LOOP2 PO370 01250C ENDLP2 TAG PO370 01260C* PO370 0001270CLR XFOOTREQ TOTREQ 92 PO370 01280C* PO370 01290CLR Z-ADD0 I PO370 01300CLR LOOP3 TAG PO370 01310CLR I ADD 1 I PO370 01320CLR I COMP 26 41 PO370 01330CLR 41 GOTO ENDLP3 PO370 0001340CLR MOVELDAT,I YY PO370 01350CLR MOVE DAT,I MMDD PO370 01360CLR MOVELMMDD DAT,I PO370 01370CLR MOVE YY DAT,I PO370 01380CLR GOTO LOOP3 PO370 01390CLR ENDLP3 TAG PO370 01400C********************************************************************PO370 0001410C* PO370 01420C* THIS SUBROUTINE TAKES THE IPL DATE AND, USING IT, FORMS AN PO370 01430C* ARRAY OF DATES. THE DATE ARRAY IS USED TO FORECAST CASH [YYMMDD] PO370 01440C* REQUIRMENTS FOR THE NEXT 3 MONTHS ON A WEEK-BY-WEEK BASIS. PO370 01450C* PO370 01460C********************************************************************PO370 01470CSR LDDAT BEGSR PO370 0001480CSR MOVELUDATE MMDD 40 PO370 01490CSR MOVE UDATE YY 20 PO370 01500CSR MOVELMMDD MM 20 PO370 01510CSR MOVE MMDD DD 20 PO370 01520C* PO370 01530CSR MM LOKUPTABA TABB 40 PO370 01540CSR Z-ADD1 I 20 PO370 0001550CSR MOVELYY DAT,I PO370 01560CSR MOVE MMDD DAT,I PO370 01570C* PO370 01580CSR LOOP1 TAG PO370 01590CSR MM LOKUPTABA TABB 40 PO370 01600CSR I ADD 1 I PO370 01610CSR I COMP 26 41 PO370 0001620CSR 41 GOTO ENDLP1 PO370 01630CSR DD ADD 7 DD7 20 PO370 01640CSR DD7 COMP TABB 42 PO370 01650CSR 42 DD7 SUB TABB DD7 PO370 01660CSR 42 MM COMP 12 43 PO370 01670CSR 42 43 Z-ADD1 MM PO370 01680CSR 42 43 YY ADD 1 YY PO370 0001690CSR 42N43 MM ADD 1 MM PO370 01700CSR Z-ADDDD7 DD PO370 01710C* PO370 01720CSR MOVELMM MMDD PO370 01730CSR MOVE DD MMDD PO370 01740CSR MOVELYY DAT,I PO370 01750CSR MOVE MMDD DAT,I PO370 0001760CSR GOTO LOOP1 PO370 01770CSR ENDLP1 TAG PO370 01780CSR ENDSR PO370 01790C********************************************************************PO370 01800O$LP1 H 202 1P PO370 01810O OR LRNOF PO370 01820O OR OFNLR PO370 0001830O PAGE Z 8 PO370 01840O 4 'PAGE' PO370 01850O HEAD 85 PO370 01860O UDATE Y 132 PO370 01870O H 2 1P PO370 01880O OR LRNOF PO370 01890O OR OFNLR PO370 0001900O 68 'OPEN PURCHASE ORDERS' PO370 01910O 78 'BY PART #' PO370 01920O 132 'MFG370' PO370 01930O H 2 1P PO370 01940O OR OFNLR PO370 01950O 6 'PART #' PO370 01960O 25 'DESCRIPTION' PO370 0001970O 50 'PO/LOT #' PO370 01980O 57 'VEND#' PO370 01990O 71 'TYPE' PO370 02000O 82 'ORDERED' PO370 02010O 94 'RECEIVED' PO370 02020O 106 'BAL DUE' PO370 02030O 118 'COST/UM' PO370 0002040O 130 'DUE DATE' PO370 02050O D 1 01 PO370 02060O L2 PART 12 PO370 02070O L2N20 DESCR 39 PO370 02080O 20 L2 36 '*** INVALID PART # ***' PO370 02090O PO 47 PO370 02100O 48 '-' PO370 0002110O LOT 50 PO370 02120O VEND Z 57 PO370 02130O 30 67 '*INVALID*' PO370 02140O POCODE 69 PO370 02150O QTYORDJ 83 PO370 02160O QTYRECJ 95 PO370 02170O N75 BALDUEJ 107 PO370 0002180O COST J 119 PO370 02190O OUTDATY 130 PO370 02200O 50 132 '*' PO370 02210O T 1 L3 PO370 02220O 107 '-----------' PO370 02230O T 2 L3 PO370 02240O TBALDUJB 107 PO370 0002250O 94 'TOTAL' PO370 02260O T 3 LR PO370 02270O 11 'END OF JOB.' PO370 02280O 36 'TOTAL STOCK-ON-ORDER IS' PO370 02290O 40 ' $' PO370 02300O TOTREQJ 53 PO370 02310O T 202 LR PO370 0002320O HEAD 84 PO370 02330O UDATE Y 132 PO370 02340O T 304 LR PO370 02350O 68 'CASH REQUIREMENT ' PO370 02360O 75 'SUMMARY' PO370 02370O T 3 LR PO370 02380O 17 'VALUE OF PURCHASE' PO370 0002390O 34 'ORDERS BY PERIOD' PO370 02400O 70 'PERIOD DATE' PO370 02410O 89 'PURCHASE VALUE' PO370 02420O T 1 LR PO370 02430O 70 'PAST DUE' PO370 02440O REQ,1 J 90 PO370 02450O T 1 LR PO370 0002460O DAT,2 Y 70 PO370 02470O REQ,2 J 90 PO370 02480O T 1 LR PO370 02490O DAT,3 Y 70 PO370 02500O REQ,3 J 90 PO370 02510O T 1 LR PO370 02520O DAT,4 Y 70 PO370 0002530O REQ,4 J 90 PO370 02540O T 1 LR PO370 02550O DAT,5 Y 70 PO370 02560O REQ,5 J 90 PO370 02570O T 1 LR PO370 02580O DAT,6 Y 70 PO370 02590O REQ,6 J 90 PO370 0002600O T 1 LR PO370 02610O DAT,7 Y 70 PO370 02620O REQ,7 J 90 PO370 02630O T 1 LR PO370 02640O DAT,8 Y 70 PO370 02650O REQ,8 J 90 PO370 02660O T 1 LR PO370 0002670O DAT,9 Y 70 PO370 02680O REQ,9 J 90 PO370 02690O T 1 LR PO370 02700O DAT,10Y 70 PO370 02710O REQ,10J 90 PO370 02720O T 1 LR PO370 02730O DAT,11Y 70 PO370 0002740O REQ,11J 90 PO370 02750O T 1 LR PO370 02760O DAT,12Y 70 PO370 02770O REQ,12J 90 PO370 02780O T 1 LR PO370 02790O DAT,13Y 70 PO370 02800O REQ,13J 90 PO370 0002810O T 1 LR PO370 02820O DAT,14Y 70 PO370 02830O REQ,14J 90 PO370 02840O T 1 LR PO370 02850O DAT,15Y 70 PO370 02860O REQ,15J 90 PO370 02870O T 1 LR PO370 0002880O DAT,16Y 70 PO370 02890O REQ,16J 90 PO370 02900O T 1 LR PO370 02910O DAT,17Y 70 PO370 02920O REQ,17J 90 PO370 02930O T 1 LR PO370 02940O DAT,18Y 70 PO370 0002950O REQ,18J 90 PO370 02960O T 1 LR PO370 02970O DAT,19Y 70 PO370 02980O REQ,19J 90 PO370 02990O T 1 LR PO370 03000O DAT,20Y 70 PO370 03010O REQ,20J 90 PO370 0003020O T 1 LR PO370 03030O DAT,21Y 70 PO370 03040O REQ,21J 90 PO370 03050O T 1 LR PO370 03060O DAT,22Y 70 PO370 03070O REQ,22J 90 PO370 03080O T 1 LR PO370 0003090O DAT,23Y 70 PO370 03100O REQ,23J 90 PO370 03110O T 1 LR PO370 03120O DAT,24Y 70 PO370 03130O REQ,24J 90 PO370 03140O T 1 LR PO370 03150O DAT,25Y 70 PO370 0003160O REQ,25J 90 PO370 03170O T 1 LR PO370 03180O 70 'OVER 24' PO370 03190O REQ,26J 90 PO370 03200O T 1 LR PO370 03210O 90 '---------------' PO370 03220O T 1 LR PO370 0003230O 90 '$ ' PO370 03240O TOTREQJ 90 PO370 ** 003250ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003260ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003270ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003280ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00329000** 0033000131 0033100229 0033200331 0033300430 0033400531 0033500630 003360000731 0033700831 0033800930 0033901031 0034001130 0034101231 003420/* 00343000__ 0033700831 0033800930 0033901031 0034001130 0034101231 003420/* 0034300(G TTXBOMPZ P"T050878050878(000010H S BOMPZ 00020X DECK-ID M93 MFG/DIST/ACCT SYSTEM SUMMARY-123 ROUTZ 00030F* INITALIZE THE BOMSTR FILE TO ZZZZZZZZZZ FOR MATCHING RECORDS ROUTZ 00040F* CYBER 18-10M/20 BILL OF MATERIAL VERSION 1.0ROUTZ 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA ROUTZ 00060F* CONTROL DATA PROPRIETARY PRODUCT ROUTZ 00070F* ROUTZ 0000080FNULL IPEAF 72 DISK ROUTZ 00090FBOMSTR UC F 74R DISK ROUTZ 00100INULL NS 02 ROUTZ 00110I 01 72 FIELD ROUTZ 00120IBOMSTR NS 03 ROUTZ 00130I 01 74 REC ROUTZ 00140C Z-ADD01 RRN ROUTZ 0000150C EXSR CHN ROUTZ 00160CSR CHN BEGSR ROUTZ 00170CSR TAGA TAG ROUTZ 00180CSR RRN CHAINBOMSTR 55 ROUTZ 00190CSR 55 GOTO END ROUTZ 00200CSR RRN ADD 01 RRN 30 ROUTZ 00210CSR SETON 20 ROUTZ 0000220CSR MOVE 'ZZZZZ' Z10 10 ROUTZ 00222CSR MOVEL'ZZZZZ' Z10 00224CSR MOVE Z10 Z20 20 00230CSR MOVELZ10 Z20 ROUTZ 00240CSR EXCPT ROUTZ 00250CSR GOTO TAGA ROUTZ 00260CSR END ENDSR ROUTZ 0000270OBOMSTR E 20 ROUTZ 00280O Z20 20 ROUTZ ** 000290ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000300ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000310ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000320ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00033000/* 000340_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(}# W5OTXFM052 P999999050478(000010H S FM052 00020X DECK-ID M06 MFG/DIST/ACCT SYSTEM SUMMARY-123 FM052 00030F* PRINTS ALL RECORDS NOT FLAGGED FOR DELETION ON VENDOR FILE FM052 00040F* CYBER 18-10M/20 FILE MAINTENANCE VERSION 1.0FM052 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA FM052 00060F* CONTROL DATA PROPRIETARY PRODUCT FM052 00070F* FM052 0000080FVENDOR IPEAF 256 5AI 1 DISK FM052 00090FHEADING IT F 40 EDISK FM052 00100F$LP1 O F 132 OF PRINTER FM052 00110F********************************************************************FM052 00120F* FM052 00130F* COMPANY FM052 00140F* SYSTEM FILE MAINTENANCE FM052 0000150F* PROGRAM LISTS OUT ACTIVE MEMBERS OF VENDOR MASTER FILE FM052 00160F* (WITH A COUNT) FM052 00170F* FM052 00180F* CONTRACTOR COMPUSOURCE FM052 00190F* PROGRAMMER FM052 00200F* DATE FM052 00210F* FM052 0000220F********************************************************************FM052 00230F* FM052 00240F* ID F C H L FUNCTION OF INDICATORS FM052 00250F* FM052 00260F* 01 VENDOR --- NON-DELETED RECORD [ACTIVE] FM052 00270F* 02 VENDOR --- DELETED RECORD FM052 00280F* 11 ADDRESS LINE 1 IS BLANK FM052 0000290F* 12 ADDRESS LINE 2 IS BLANK FM052 00300F* 13 ADDRESS LINE 3 IS BLANK FM052 00310F* FM052 00320F********************************************************************FM052 00330E HEADING HEAD 1 1 40 COMPANY NAME FM052 00340IVENDOR NS 01 106 C FM052 00350I 1 50VEND FM052 0000360I 6 30 NAME FM052 00370I 31 55 ADDRL1 11 FM052 00380I 56 80 ADDRL2 12 FM052 00390I 81 103 ADDRL3 13 FM052 00400I NS 02 FM052 00410I 1 1 AIR FM052 00420C 01 COUNT ADD 1 COUNT 40 FM052 0000430O$LP1 H 202 1P FM052 00440O OR OF FM052 00450O PAGE Z 10 FM052 00460O 4 'PAGE' FM052 00470O HEAD,1 85 FM052 00480O UDATE Y 132 FM052 00490O H 2 1P FM052 0000500O OR OF FM052 00510O 66 'VENDOR MASTER FILE' FM052 00520O 74 'LISTING' FM052 00530O 132 'MFG052' FM052 00540O H 2 1P FM052 00550O OR OF FM052 00560O 8 'VENDOR #' FM052 0000570O 21 'VENDOR NAME' FM052 00580O 44 'ADDRESS' FM052 00590O D 11 01 FM052 00600O VEND 8 FM052 00610O NAME 35 FM052 00620O N11 ADDRL1 62 FM052 00630O 11N12 ADDRL2 62 FM052 0000640O 11 12N13ADDRL3 60 FM052 00650O D 01 N11N12 FM052 00660O AD 01 FM052 00670O OR N11 12N13 FM052 00680O AD 01 FM052 00690O OR 11N12N13 FM052 00700O AD 01 FM052 0000710O N11N12 ADDRL2 62 FM052 00720O N11 12N13ADDRL3 60 FM052 00730O 11N12N13ADDRL3 60 FM052 00740O D 01 N11N12N13 FM052 00750O AD 01 FM052 00760O N11N12N13ADDRL3 60 FM052 00770O T 3 LR FM052 0000780O 22 'END OF JOB. THERE ARE' FM052 00790O COUNT Z 27 FM052 00800O 49 'ACTIVE RECORDS IN THE' FM052 00810O 69 'VENDOR MASTER FILE.' FM052 ** 000820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00084000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000850ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000860/* 000870__0O 69 'VENDOR MASTER FILE.' FM052 ** 000820ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0008400(&H &TXPO350 P999999032778(000010H S PO350 00020X DECK-ID M74 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO350 00030F* THIS PROGRAM PRINTS PURCHASE HISTORY FILE OR ANY PART REQUESTED PO350 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FPOHIST IPEAF 77 DISK MFG35000090FPARTMST IC F 300R20AI 271 DISK MFG35000100F$LP1 O F 85 OF PRINTER MFG35000110FHEADING IT F 40 EDISK MFG33000120F********************************************************************MFG35000130F* MFG35000140F* COMPANY LOS ANGELES BRUSH MFG3500000150F* SYSTEM PURCHASING/ INVENTORY CONTROL MFG35000160F* PROGRAM PRINTOUT OF PURCHASING HISTORY MFG35000170F* MFG35000180F* CONTRACTOR COMPUSOURCE MFG35000190F* PROGRAMMER KATH HILL MFG35000200F* DATE NOVEMBER 15, 1975 MFG35000210F* MFG3500000220F********************************************************************MFG35000230F* MFG35000240F* NARRATIVE: THE PROGRAM WILL EITHER A. PRINT OUT THE ENTIRE MFG35000250F* PURCHASING HISTORY OF PART #'S IN POHIST FILE MFG35000260F* OR B. PRINT OUT THE PURCHASING HISTORY OF ANY MFG35000270F* PARTICULAR PART #'S ENTERED BY THE OPERATOR. MFG35000280F* MFG3500000290F********************************************************************MFG35000300F* MFG35000310F* ID F C H L FUNCTION OF INDICATORS MFG35000320F* MFG35000330F* 01 POHIST MFG35000340F* 02 PARTMST MFG35000350F* 11 NO OVERRIDE COST/UM - COST AT STANDARD MFG3500000360F* 12 DELETE FIELD BLANK / PARTMST MFG35000370F* MFG35000380F* 20 CHAIN TO PARTMST --- A 'MISS' MFG35000390F* 31 RUBOUT TO START OF ENTRY MFG35000400F* 32 RUBOUT TO PREVIOUS ENTRY MFG35000410F* 33 ON FIRST LINE OF SCREEN MFG35000420F* 34 LINEFEED MFG3500000430F* 35 END PART # INPUT BY '@' IN PART # MFG35000440F* 41 VARIANCE FROM STANDARD = 0 MFG35000450F* 50 I LOOP-WATCHER MFG35000460F* 51 ALL PART #'S MFG35000470F* 52 NOT ALL PART #'S MFG35000480F* 95 PRINTOUT THIS POHIST RECORD MFG35000490F* 96 Z < 15 (SAME SCREEN) MFG3500000500F* 97 J = 100 (PART # ARRAY FULL) MFG35000510F* 99 CRT ONCE MFG35000520F* MFG35000530F* L1PRNUM/POHIST MFG35000540F* MFG35000550F********************************************************************MFG35000560E HEADING HEAD 1 1 40 MFG3300000570E MSG 1 18 50 CRT MESSAGES MFG35000580E BLNKS 1 1 72 BLANKS MFG35000590E EDIT 1 1 72 ERROR MESSAGES MFG35000600E PR 100 20 PART # TO PRINT MFG35000610E* OUT HISTORY OF MFG35000620IPOHIST NS 01 MFG35000630I 58 77 PRNUM L1 MFG3500000640I 13 170PONUM MFG35000650I 18 190LOTNUM MFG35000660I 20 250DUEDAT MFG35000670I 26 310RECDAT MFG35000680I 32 360VENDNO MFG35000690I 37 433COSTUM 11 MFG35000700I 44 500QTYORD MFG3500000710I 51 570QTYREC MFG35000720IPARTMST NS 02 MFG35000730I 1 37 DESCR MFG35000740I 57 610VNO MFG35000750I 62 73 VPARTN MFG35000760I 181 1870MINROP MFG35000770I 188 1940MAXEOQ MFG3500000780I 44 460LEAD MFG35000790I 47 490SAFTY MFG35000800I 75 813STDCUM MFG35000810I 74 74 DLTPR 12 MFG35000820I 203 2090AVGSA MFG35000830C* MFG35000840C N99 EXSR CRT1 MFG3500000850C N99N51 52 EXSR CRT2 MFG35000860C N99 SETON 99 MFG35000870C MOVELAIR12 AIR12 20 MFG35000880C* MFG35000890C NL1 GOTO ON1 MFG35000900C* MFG35000910C 51N52 SETON 95 MFG3500000920C N51 52 PRNUM LOKUPPR 95 MFG35000930C* MFG35000940C N95 GOTO FINI MFG35000950C* MFG35000960C PRNUM CHAINPARTMST 20 NEVER MISS! MFG35000970C N20N12 SETON 20 MFG35000980C* MFG3500000990C Z-ADD0 I MFG35001000C* MFG35001010C ON1 TAG MFG35001020C* MFG35001030C I ADD 1 I MFG35001040C* MFG35001050C 20 Z-ADD0 STDCUM MFG3500001060C 11 Z-ADDSTDCUM COSTUM MFG35001070C STDCUM SUB COSTUM A 73 MFG35001080C A MULT QTYREC VARI 82H MFG35001090C* MFG35001100C STDCUM MULT QTYREC B 73H MFG35001110C B COMP 0 41 MFG35001120C 41 Z-ADD1 C 43 MFG3500001130C N41 VARI DIV B C 43H MFG35001140C C MULT 100 XPCT 41 MFG35001150C* MFG35001160C FINI TAG MFG35001170C* MFG35001180CLR EXSR CLRSCR MFG35001190C* MFG3500001200C********************************************************************MFG35001210C* MFG35001220C* THIS SUBROUTINE HANDLES THE FIRST CRT DISPLAY. MFG35001230C* MFG35001240C********************************************************************MFG35001250CSR CRT1 BEGSR MFG35001260CSR EXSR CLRSCR MFG3500001270CSR Z-ADD0 I 20 MFG35001280CSR LOOP1 TAG MFG35001290CSR I ADD 1 I MFG35001300CSR I COMP 5 50 MFG35001310CSR 50 GOTO ENDLP1 MFG35001320CSR MOVELMSG,I HOLD 60 MFG35001330CSR MOVE MSG,I WORD44 44 MFG3500001340CSR MOVELHOLD CURPOS 40 MFG35001350CSR MOVE HOLD LNGTH 20 MFG35001360CSR EXSR POSCUR MFG35001370CSR MOVELWORD44 BUFFER 72 MFG35001380CSR EXSR OUTS MFG35001390CSR GOTO LOOP1 MFG35001400CSR ENDLP1 TAG MFG3500001410C* MFG35001420CSR IN1 TAG MFG35001430CSR MOVELMSG,I HOLD MFG35001440CSR MOVELHOLD CURPOS MFG35001450CSR MOVE HOLD LNGTH MFG35001460CSR EXSR POSCUR MFG35001470CSR EXSR ACCEPT MFG3500001480CSR MOVELBUFFER ALL 1 MFG35001490CSR MOVEL']' BUFFER MFG35001500CSR Z-ADD1 LNGTH MFG35001510CSR EXSR OUTS MFG35001520CSR ALL COMP 'Y' 51 MFG35001530CSR N51ALL COMP 'N' 52 MFG35001540CSR N52N51 GOTO IN1 MFG3500001550C* MFG35001560CSR ENDSR MFG35001570C********************************************************************MFG35001580C* MFG35001590C* IF THE OPERATOR DOESN'T DESIRE TO PRINT OUT THE PURCHASING MFG35001600C* HISTORY FOR ALL PART #'S, THEN THIS SUBROUTINE INQUIRES MFG35001610C* AS TO WHICH PART #'S THE PURCHASING HISTORY SHOULD BE MFG3500001620C* WRITTEN OUT FOR. [SECOND CRT DISPLAY] MFG35001630C* MFG35001640C********************************************************************MFG35001650CSR CRT2 BEGSR MFG35001660CSR EXSR CLRSCR MFG35001670CSR Z-ADD5 I MFG35001680CSR LOOP2 TAG MFG3500001690CSR I ADD 1 I MFG35001700CSR I COMP 13 50 MFG35001710CSR 50 GOTO ENDLP2 MFG35001720CSR MOVELMSG,I HOLD MFG35001730CSR MOVE MSG,I WORD44 MFG35001740CSR MOVELHOLD CURPOS MFG35001750CSR MOVE HOLD LNGTH MFG3500001760CSR EXSR POSCUR MFG35001770CSR MOVELWORD44 BUFFER MFG35001780CSR EXSR OUTS MFG35001790CSR GOTO LOOP2 MFG35001800CSR ENDLP2 TAG MFG35001810C* MFG35001820CSR Z-ADD0 J 30 MFG3500001830CSR LOOP3 TAG MFG35001840CSR Z-ADD0 Z 30 MFG35001850CSR LINE TAG MFG35001860CSR Z ADD 1 Z MFG35001870CSR J ADD 1 J MFG35001880C* MFG35001890CSR MOVEL'0104' CURPOS MFG3500001900CSR CURPOS ADD Z CURPOS MFG35001910CSR Z-ADD72 LNGTH MFG35001920CSR EXSR POSCUR MFG35001930CSR MOVELBLNKS,1 BUFFER MFG35001940CSR EXSR OUTS MFG35001950CSR MOVEL'5004' CURPOS MFG35001960CSR CURPOS ADD Z CURPOS MFG3500001970CSR Z-ADD22 LNGTH MFG35001980CSR EXSR POSCUR MFG35001990CSR MOVELBLNKS,1 BUFFER MFG35002000CSR EXSR OUTS MFG35002010C* MFG35002020CSR IN2 TAG MFG35002030CSR Z-ADD13 I MFG3500002040CSR MOVELMSG,I HOLD MFG35002050CSR MOVELHOLD CURPOS MFG35002060CSR CURPOS ADD Z CURPOS MFG35002070CSR MOVELHOLD LNGTH MFG35002080CSR EXSR POSCUR MFG35002090CSR MOVELJ BUFFER MFG35002100CSR EXSR OUTS MFG3500002110C* MFG35002120CSR IN3 TAG MFG35002130CSR Z-ADD14 I MFG35002140CSR MOVELMSG,I HOLD MFG35002150CSR MOVE MSG,I WORD44 MFG35002160CSR MOVELHOLD CURPOS MFG35002170CSR CURPOS ADD Z CURPOS MFG3500002180CSR MOVE HOLD LNGTH MFG35002190CSR EXSR POSCUR MFG35002200CSR MOVELWORD44 BUFFER MFG35002210CSR EXSR OUTS MFG35002220C* MFG35002230CSR IN4 TAG MFG35002240CSR MOVELBLNKS,1 BUFFER MFG3500002250CSR Z-ADD15 I MFG35002260CSR MOVELMSG,I HOLD MFG35002270CSR MOVELHOLD CURPOS MFG35002280CSR CURPOS ADD Z CURPOS MFG35002290CSR MOVE HOLD LNGTH MFG35002300CSR EXSR POSCUR MFG35002310CSR EXSR ACCEPT MFG3500002320CSR RCODE COMP 'R' 31 MFG35002330CSR BUFFER COMP BLNKS,1 32 MFG35002340CSR 31N32 GOTO IN4 MFG35002350CSR 31 32 Z COMP 1 33 MFG35002360CSR 31 32 33 GOTO IN4 MFG35002370CSR 31 32N33Z SUB 1 Z MFG35002380CSR 31 32N33J SUB 1 J MFG3500002390CSR 31 32N33 GOTO IN4 MFG35002400CSR RCODE COMP 'L' 34 MFG35002410CSRN34 MOVELBUFFER IT 20 MFG35002420CSRN34 MOVELIT END1 1 MFG35002430CSRN34 END1 COMP '@' 35 MFG35002440CSRN34 35 GOTO CRT2E MFG35002450CSRN34 MOVELIT PR,J MFG3500002460CSR EXSR POSCUR MFG35002470CSR 34 MOVELPR,J BUFFER MFG35002480CSRN34 MOVELIT BUFFER MFG35002490CSR EXSR OUTS MFG35002500CSR Z-ADD1 LNGTH MFG35002510CSR MOVEL']' BUFFER MFG35002520CSR EXSR OUTS MFG3500002530C* MFG35002540CSR CHECK TAG MFG35002550CSR MOVELPR,J PRJ 20 MFG35002560CSR PRJ CHAINPARTMST 20 MFG35002570CSRN20N12 SETON 20 MFG35002580C* MFG35002590CSRN20 GOTO IN5 MFG3500002600C* MFG35002610CSR MOVELEDIT,1 HOLD MFG35002620CSR MOVELHOLD CURPOS MFG35002630CSR CURPOS ADD Z CURPOS MFG35002640CSR MOVE HOLD LNGTH MFG35002650CSR MOVE EDIT,1 WORD66 66 MFG35002660CSR EXSR POSCUR MFG3500002670CSR MOVELWORD66 BUFFER MFG35002680CSR EXSR OUTS MFG35002690CSR GOTO IN4 MFG35002700C* MFG35002710CSR IN5 TAG MFG35002720CSR Z-ADD16 I MFG35002730CSR MOVELMSG,I HOLD MFG3500002740CSR MOVELHOLD CURPOS MFG35002750CSR CURPOS ADD Z CURPOS MFG35002760CSR MOVE HOLD LNGTH MFG35002770CSR EXSR POSCUR MFG35002780CSR MOVELDESCR BUFFER MFG35002790CSR EXSR OUTS MFG35002800C* MFG3500002810C* MFG35002820CSR IN6 TAG MFG35002830CSR Z-ADD17 I MFG35002840CSR MOVELMSG,I HOLD MFG35002850CSR MOVELHOLD CURPOS MFG35002860CSR CURPOS ADD Z CURPOS MFG35002870CSR MOVE HOLD LNGTH MFG3500002880CSR EXSR POSCUR MFG35002890CSR MOVELVNO BUFFER MFG35002900CSR EXSR OUTS MFG35002910C* MFG35002920CSR IN7 TAG MFG35002930CSR Z-ADD18 I MFG35002940CSR MOVELMSG,I HOLD MFG3500002950CSR MOVELHOLD CURPOS MFG35002960CSR CURPOS ADD Z CURPOS MFG35002970CSR MOVE HOLD LNGTH MFG35002980CSR EXSR POSCUR MFG35002990CSR MOVELVPARTN BUFFER MFG35003000CSR EXSR OUTS MFG35/03010C* MFG35/0003020CSR J COMP 100 97 MFG35003030CSR 97 GOTO CRT2ED MFG35003040CSR 97 Z COMP 15 96 MFG35003050CSR 96 GOTO LINE MFG35003060CSRN96 GOTO LOOP3 MFG35003070C* MFG35003080CSR CRT2E TAG MFG3500003090CSR MOVELAIR12 PR,J MFG35003100CSR J COMP 100 97 MFG35003110CSR 97 GOTO CRT2ED MFG35003120CSR J ADD 1 J MFG35003130CSR GOTO CRT2E MFG35003140C* MFG35003150CSR CRT2ED TAG MFG3500003160C* MFG35003170CSR ENDSR MFG35003180C********************************************************************MFG35003190C* MFG35003200C* THIS SUBROUTINE CALLS THE SUBROUTINE SUBRCM. MFG35003210C* IT DEFINES ALL THE RLABLS NECESSARY. MFG35003220C* MFG3500003230C********************************************************************MFG35003240CSR CRTCOM BEGSR MFG35003250CSR EXITFSUBRCM SUBCM 03260CSR RLABL BUFFER 72 SUBCM 03270CSR RLABL TYPE 1 SUBCM 03280CSR RLABL BLNGTH 20 SUBCM 03290CSR RLABL RCODE 1 SUBCM 0003300CSR RLABL MASK 10 SUBCM 03310CSR RLABL DTYPE 10 SUBCM 03320CSR ENDSR MFG35003330C********************************************************************MFG35003340C* MFG35003350C* THIS SUBROUTINE CLEARS THE CRT SCREEN. MFG35003360C* MFG3500003370C********************************************************************MFG35003380CSR CLRSCR BEGSR MFG35003390CSR MOVEL'C' TYPE MFG35003400CSR EXSR CRTCOM MFG35003410CSR ENDSR MFG35003420C********************************************************************MFG35003430C* MFG3500003440C* THIS SUBROUTINE POSITIONS THE CURSOR. MFG35003450C* MFG35003460C********************************************************************MFG35003470CSR POSCUR BEGSR MFG35003480CSR MOVELCURPOS BUFFER MFG35003490CSR MOVEL'P' TYPE MFG35003500CSR EXSR CRTCOM MFG3500003510CSR ENDSR MFG35003520C********************************************************************MFG35003530C* MFG35003540C* THIS SUBROUTINE ACCEPTS INPUT TO THE CRT FROM THE KEYBOARD. MFG35003550C* MFG35003560C********************************************************************MFG35003570CSR ACCEPT BEGSR MFG3500003580CSR MOVELLNGTH BLNGTH MFG35003590CSR MOVEL'A' TYPE MFG35003600CSR EXSR CRTCOM MFG35003610CSR ENDSR MFG35003620C********************************************************************MFG35003630C* MFG35003640C* THIS SUBROUTINE OUTPUTS PRINT TO CRT AND REPOSITIONS THE MFG3500003650C* CURSOR AT BLNGTH-+-1. MFG35003660C* MFG35003670C********************************************************************MFG35003680CSR OUTS BEGSR MFG35003690CSR MOVELLNGTH BLNGTH MFG35003700CSR MOVEL'S' TYPE MFG35003710CSR EXSR CRTCOM MFG3500003720CSR ENDSR MFG35003730C********************************************************************MFG35003740O$LP1 D 202 L1 95NOF MFG35003750O OR NL1 95 OF MFG35003760O HEAD 65 MFG35003770O UDATE Y 85 MFG35003780O D 2 L1 95NOF MFG3500003790O OR NL1 95 OF MFG35003800O 52 'PURCHASING HISTORY' MFG35003810O 85 'MFG350' MFG35003820O D 2 L1 95NOF MFG35003830O OR NL1 95 OF MFG35003840O 8 'PART # -' MFG35003850O PRNUM 29 MFG3500003860O N20DESCR 68 MFG35003870O 20 53 '*** INVALID PART # ***' MFG35003880O D 2 L1 95NOF MFG35003890O OR NL1 95 OF MFG35003900O 15 'VENDOR PART # -' MFG35003910O 40 'VENDOR # -' MFG35003920O N20VNO Z 46 MFG3500003930O N20VPARTN 28 MFG35003940O 75 'MIN' MFG35003950O N20MINROP1 85 MFG35003960O D 1 L1 95NOF MFG35003970O OR NL1 95 OF MFG35003980O 11 'LEAD TIME -' MFG35003990O N20LEAD Z 15 MFG3500004000O 20 'DAYS' MFG35004010O 75 'MAX' MFG35004020O MAXEOQ1 85 MFG35004030O D 2 L1 95NOF MFG35004040O OR NL1 95 OF MFG35004050O 14 'SAFETY STOCK -' MFG35004060O N20SAFTY Z 18 MFG3500004070O 23 'DAYS' MFG35004080O D 2 L1 95NOF MFG35004090O OR NL1 95 OF MFG35004100O 18 'STANDARD COST/UM -' MFG35004110O N20STDCUM1 27 MFG35004120O 75 'AVG USAGE' MFG35004130O N20AVGSA 1 85 MFG3500004140O D 2 L1 95NOF MFG35004150O OR NL1 95 OF MFG35004160O 20 '--------------------' MFG35004170O 40 '--------------------' MFG35004180O 60 '--------------------' MFG35004190O 80 '--------------------' MFG35004200O 85 '-----' MFG3500004210O D 2 L1 95NOF MFG35004220O OR NL1 95 OF MFG35004230O 45 'RECEIPTS' MFG35004240O D 1 L1 95NOF MFG35004250O OR NL1 95 OF MFG35004260O 26 'DUE' MFG35004270O 38 'RECEIVE' MFG3500004280O 47 'ORDER' MFG35004290O 56 'RECEIVE' MFG35004300O 66 'ACTUAL' MFG35004310O 76 'VARIANCE' MFG35004320O D 2 L1 95NOF MFG35004330O OR NL1 95 OF MFG35004340O 12 'P.O. #' MFG3500004350O 19 'VENDOR' MFG35004360O 27 'DATE' MFG35004370O 36 'DATE' MFG35004380O 46 'QTY' MFG35004390O 54 'QTY' MFG35004400O 66 'COST/UM' MFG35004410O 76 'FROM STD' MFG3500004420O 84 '% VAR' MFG35004430O D 2 95 MFG35004440O I Z 2 MFG35004450O 3 '.' MFG35004460O PONUM 9 MFG35004470O 10 '-' MFG35004480O LOTNUM 12 MFG3500004490O VENDNOZ 19 MFG35004500O DUEDATY 29 MFG35004510O RECDATY 38 MFG35004520O QTYORDL 48 MFG35004530O QTYRECL 57 MFG35004540O COSTUM3 66 MFG35004550O VARI LB 77 MFG3500004560O XPCT LB 85 MFG350** 04570ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 04580ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 04590ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 04600ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 04610** M0462000220132PURCHASING HISTORY --- DISPLAY 1 M04630640106MFG350 M04640030334DO YOU DESIRE ALL PART NUMBERS Y/N M04650380303[ ] M04660390301 04670220132PURCHASING HISTORY --- DISPLAY 2 M04680640106MFG350 M0469000030304ITEM M04700090306PART # M04710310311DESCRIPTION 04720490305VEND# 04730550311VEND PART # 04740030403 M04750080422[ ] M0476000090420 M04770310417 M04780490405 M04790550412 M04800** M04810 M04820** 0483000310442**INVALID M04840/* 04850_ 00 00 00 00 00 00 00 00 00 __ 0(@J> OTXOE160 P999999050878(000010H S OE160 00020X DECK-ID A62 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE160 00030F* PRINT TODAYS ORDERS OE160 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE160 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE160 00060F* CONTROL DATA PROPRIETARY PRODUCT OE160 00070F* OE160 0000080FTODAYS IPEAF 118 DISK OE160 00090FARMAST IC F 280R 6AI 1 DISK OE160 00100FPARTMST IC F 300R12AI 1 DISK OE160 00110FHEADING IT F 40 EDISK OE160 00120F$LP1 O F 132 OF PRINTER OE160 00130F* OE160 00140F********************************************************************OE160 0000150F* OE160 00160F* PACKAGE DISTRIBUTION OE160 00170F* SYSTEM SALES ORDER PROCESSING OE160 00180F* PROGRAM PRINT TODAY'S ORDERS OE160 00190F* OE160 00200F* OE160 00210F********************************************************************OE160 0000220F* OE160 00230F* ************************************************************** OE160 00240F* ** ** OE160 00250F* ** FUNCTION OF INDICATORS ** OE160 00260F* ** ** OE160 00270F* ** 01 SNEWORD- HEADER ** OE160 00280F* ** 03 SNEWORD- LINE ITEM ** OE160 0000290F* ** 05 SNEWORD- ALL OTHER RECORDS ** OE160 00300F* ** ** OE160 00310F* ** 07 ARMAST ** OE160 00320F* ** ** OE160 00330F* ** 09 PARTMST ** OE160 00340F* ** ** OE160 00350F* ** 11 DASH# PART OF S.O.# IS ZERO - THIS IS NOT A ** OE160 0000360F* ** BACKORDER ** OE160 00370F* ** 12 NO OVERRIDE PRICE CODE ON HEADER ** OE160 00380F* ** 13 NO OVERRIDE PRICE FOR THIS LINE-ITEM ** OE160 00390F* ** 14 NO CREDIT LIMIT FOR THIS CUSTOMER ** OE160 00400F* ** ** OE160 00410F* ** 20 THIS ORDER IS A BACKORDER ** OE160 00420F* ** ** OE160 0000430F* ** 25 THIS CUST HAD NO CREDIT LIMIT ** OE160 00440F* ** ** OE160 00450F* ** 30 DELETED RECORD - ARMAST ** OE160 00460F* ** 31 DELETED RECORD - PARTMST ** OE160 00470F* ** ** OE160 00480F* ** 41 NO OVERRIDE PRICE - USE PRICE 1 FROM PARTMST ** OE160 00490F* ** 42 NO OVERRIDE PRICE - USE PRICE 2 FROM PARTMST ** OE160 0000500F* ** 43 NO OVERRIDE PRICE - USE PRICE 3 FROM PARTMST ** OE160 00510F* ** 44 NO OVERRIDE PRICE - USE PRICE 4 FROM PARTMST ** OE160 00520F* ** 45 NO OVERRIDE PRICE - USE PRICE 5 FROM PARTMST ** OE160 00530F* ** ** OE160 00540F* ** 90 CUSTOMER OVER CREDIT LIMIT - FLAG ** OE160 00550F* ** ** OE160 00560F* ************************************************************** OE160 0000570F* OE160 00580E HEADING HEAD 1 1 40 COMPANY NAME OE160 00590ITODAYS XX 01 8 CH OE160 00600I 3 70SONUM L1 OE160 00610I 9 130CUST OE160 00620I 20 31 PO OE160 00630I 43 430OVPC 12 OE160 0000640I 50 550PDATE OE160 00650I 105 105 STATUS 11 OE160 00660I XX 03 8 CL 11 CL OE160 00670I 3 70SONUM L1 OE160 00680I 12 23 PART OE160 00690I 24 300QTYORD OE160 00700I 52 583OVPRCE 13 OE160 0000710I XX 05 OE160 00720I 3 70SONUM L1 OE160 00730IARMAST XX 07 OE160 00740I 7 30 NAME OE160 00750I 109 1140CREDIT 14 OE160 00760I 115 115 DLTAR 30 OE160 00770I 161 1610PC OE160 0000780I 164 1722ARBAL OE160 00790IPARTMST XX 09 OE160 00800I 74 74 DLTPA 31 OE160 00810I 226 2323PRICE1 OE160 00820I 233 2393PRICE2 OE160 00830I 240 2463PRICE3 OE160 00840I 247 2533PRICE4 OE160 0000850I 254 2603PRICE5 OE160 00860C L1 SETOF 202590 OE160 00870C L1 Z-ADD0 ORDTOT 92 OE160 00880C L1N01 SETON H1 NO HEADER OE160 00890C H1 GOTO END OE160 00900C 01NL1 SETON H2 DUP HEADERS OE160 00910C H2 GOTO END OE160 0000920C 01 EXSR SUB1 HEADER OE160 00930C 03 EXSR SUB3 LINE-ITEM OE160 00940C END TAG OE160 00950CL1 SOTOT ADD ORDTOT SOTOT 102 OE160 00960CL1 20 BOTOT ADD ORDTOT BOTOT 102 OE160 00970CL1 ORDTOT ADD ARBAL TOTAL 92 OE160 00980CL1N25 TOTAL COMP CREDIT 90 OVER LIMIT OE160 0000990C* OE160 01000C* ************************************************************** OE160 01010C* ** ** OE160 01020C* ** SUBR SUB1 PROCESSES THE HEADER RECORDS ** OE160 01030C* ** ** OE160 01040C* ************************************************************** OE160 01050C* OE160 0001060CSR SUB1 BEGSR OE160 01070CSR Z-ADDCUST CUST6 60 OE160 01080CSR CUST6 CHAINARMAST H3 NO HIT OE160 01090CSRNH3N30 SETON H3 OE160 01100CSR H3 GOTO END1 OE160 01110CSRN11 SETON 20 THIS IS A B.O. OE160 01120CSR 12 Z-ADDPC CODE 10 SOLDTO BASIS OE160 0001130CSRN12 Z-ADDOVPC CODE OVRIDE BASIS OE160 01140CSR 14 SETON 25 NO CRED LIMIT OE160 01150CSR SOS ADD 1 SOS 50 # OF S.O.'S OE160 01160CSRN11 BOS ADD 1 BOS 50 # OF BOR'S OE160 01170CSR END1 ENDSR OE160 01180C* OE160 01190C* ************************************************************** OE160 0001200C* ** ** OE160 01210C* ** SUBR SUB3 PROCESSES THE LINE ITEM RECORDS ** OE160 01220C* ** ** OE160 01230C* ************************************************************** OE160 01240C* OE160 01250CSR SUB3 BEGSR OE160 01260CSR Z-ADD0 PRICE 73 PRCE DEFAULT=0 OE160 0001270CSRN13 Z-ADDOVPRCE PRICE OVERRIDE PRICE OE160 01280CSRN13 GOTO SKIP3 OE160 01290CSR PART CHAINPARTMST H5 GET PRICES OE160 01300CSRNH5N31 SETON H5 OE160 01310CSR H5 GOTO END3 NO HIT OE160 01320CSR CODE COMP 1 41PRICE BASIS 1 OE160 01330CSR CODE COMP 2 42PRICE BASIS 2 OE160 0001340CSR CODE COMP 3 43PRICE BASIS 3 OE160 01350CSR CODE COMP 4 44PRICE BASIS 4 OE160 01360CSR CODE COMP 5 45PRICE BASIS 5 OE160 01370CSR 41 Z-ADDPRICE1 PRICE OE160 01380CSR 42 Z-ADDPRICE2 PRICE OE160 01390CSR 43 Z-ADDPRICE3 PRICE OE160 01400CSR 44 Z-ADDPRICE4 PRICE OE160 0001410CSR 45 Z-ADDPRICE5 PRICE OE160 01420CSR SKIP3 TAG OE160 01430CSR QTYORD MULT PRICE EXTAMT 92H OE160 01440CSR ORDTOT ADD EXTAMT ORDTOT OE160 01450CSR END3 ENDSR OE160 01460C** OE160 01470C** OE160 0001480O$LP1 H 202 1P OE160 01490O OR OF OE160 01500O PAGE Z 10 OE160 01510O 4 'PAGE' OE160 01520O HEAD,1 85 OE160 01530O UDATE Y 132 OE160 01540O H 2 1P OE160 0001550O OR OF OE160 01560O 69 'DAILY SALES ORDER' OE160 01570O 78 'REGISTER' OE160 01580O 132 'DIS160' OE160 01590O H 1 1P OE160 01600O OR OF OE160 01610O 5 'SALES' OE160 0001620O 69 'DELIVERY' OE160 01630O 81 'EXTENDED' OE160 01640O 96 'CURRENT' OE160 01650O 108 'CREDIT' OE160 01660O H 2 1P OE160 01670O OR OF OE160 01680O 7 'ORDER #' OE160 0001690O 16 'CUST #' OE160 01700O 31 'CUSTOMER NAME' OE160 01710O 59 'CUSTOMER P.O. #' OE160 01720O 67 'DATE' OE160 01730O 83 'ORDER AMOUNT' OE160 01740O 98 'A/R BALANCE' OE160 01750O 108 'LIMIT' OE160 0001760O 114 'FLAG' OE160 01770O T 1 L1 OE160 01780O SONUM 8 OE160 01790O CUST 16 OE160 01800O NAME 42 OE160 01810O PO 56 OE160 01820O PDATE Y 69 OE160 0001830O ORDTOTJ 84 OE160 01840O ARBAL J 99 OE160 01850O N25 CREDITK 108 OE160 01860O 25 108 '*NONE*' OE160 01870O 90 114 '****' OE160 01880O T 1 LR OE160 01890O 83 '------------' OE160 0001900O T 2 LR OE160 01910O SOTOT J 84 OE160 01920O 96 'TOTAL VALUE' OE160 01930O T 2 LR OE160 01940O BOTOT J 84 OE160 01950O 95 'BACKORDERS' OE160 01960O T 1 LR OE160 0001970O 11 'END OF JOB.' OE160 01980O 23 'THERE WERE' OE160 01990O SOS 3 29 OE160 02000O 51 'ORDERS TODAY OF WHICH' OE160 02010O BOS 3 57 OE160 02020O 74 'WERE BACKORDERS.' OE160 ** 00203000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002040ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002050ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002060ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002070/* 002080__0O 74 'WERE BACKORDERS.' OE160 ** 0020300(,/ {}OTXOE200 P999999050878(000010H S OE200 00020X DECK-ID A63 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE200 00030F* CREATE BKLOGT FILE OE200 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE200 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE200 00060F* CONTROL DATA PROPRIETARY PRODUCT OE200 00070F* OE200 0000080FOPNORDS IPEAF 118 8AI 106 DISK OE200 00090FARMAST IC F 280R 6AI 1 DISK OE200 00100FPARTMST IC F 300R12AI 1 DISK OE200 00110FBKLOGT O F 125 DISK OE200 00120F********************************************************************OE200 00130F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [ORD200] OE200 00140F* OE200 0000150F* PACKAGE DISTRIBUTION OE200 00160F* SYSTEM SALES ORDER PROCESSING OE200 00170F* PROGRAM CREATE BKLOGT FROM OPNORDS OE200 00180F* OE200 00190F* CONTRACTOR COMPUSOURCE OE200 00200F* PROGRAMMER KATH HILL OE200 00210F* DATE FEBRUARY 22, 1976 OE200 0000220F* OE200 00230F********************************************************************OE200 00240F* OE200 00250F* NARRATIVE: IT CREATES A RECORD IN BKLOGT FOR EACH 'LL' RECORD OE200 00260F* IN OPNORDS. OE200 00270F* OE200 00280F********************************************************************OE200 0000290F* ID F C H L FUNCTION OF INDICATORS OE200 00300F* OE200 00310F* 01 OPNORDS (H) OE200 00320F* 03 (LL) OE200 00330F* 04 (ALL OTHERS) OE200 00340F* 05 ARMAST OE200 00350F* 06 PARTMST OE200 0000360F* OE200 00370F* N15 DELETE (ARMAST) OE200 00380F* N16 DELETE (PARTMST) OE200 00390F* 20 UNITPRICEOVERRIDE = 0 (LL) OE200 00400F* 21 PRICECODEOVERRIDE = 0 (H) OE200 00410F* OE200 00420F* 30 CHAIN 'MISS' (ARMAST) OE200 0000430F* 40 CHAIN 'MISS' (PARTMST) OE200 00440F* N50 BAD PRICE CODE ON FILE - DEFAULT TO PRICE = 0 OE200 00450F* OE200 00460F********************************************************************OE200 00470E PRCD 5 7 3 PRICE ARRAY OE200 00480IOPNORDS NS 01 8 CH OE200 00490I 9 130CUSTNO OE200 0000500I 14 190ORDATE OE200 00510I 20 31 CPONUM OE200 00520I 43 430PRCDOV 21 OE200 00530I 50 550PRODAT OE200 00540I 105 105 STATUS 60 OE200 00550I NS 03 8 CL 11 CL OE200 00560I 1 70MSOLL OE200 0000570I 12 23 PART OE200 00580I 24 300QTYORD OE200 00590I 52 583UNPROV 20 OE200 00600I NS 04 OE200 00610I 1 105 IMAGE OE200 00620IARMAST NS 05 OE200 00630I 7 30 NAME OE200 0000640I 115 115 DLTAR 15 OE200 00650I 161 1610PRCODE OE200 00660IPARTMST NS 06 OE200 00670I 1 12 PARTNO OE200 00680I 13 37 DESCR OE200 00690I 74 74 DLTPR 16 OE200 00700I 226 260 PRCD OE200 0000710C* OE200 00720C N01 GOTO TRY3 OE200 00730C N60 STATUS COMP 'P' 60 OE200 00740C N60 STATUS COMP 'B' 60 OE200 00750C N60 GOTO FINI OE200 00760C* OE200 00770C Z-ADDCUSTNO KEY 60 OE200 0000780C KEY CHAINARMAST 30 30 = MISS OE200 00790C N30N15 SETON 30 30 = HIT CODED OE200 00800C* TO DELETE OE200 00810C N21N30 Z-ADDPRCDOV I 10 OVERRIDE BASIS OE200 00820C 21N30 Z-ADDPRCODE I PRICE CODE OE200 00830C 30 Z-ADD0 I INVALID CUST # OE200 00840C* OE200 0000850C TRY3 TAG OE200 00860C N03 GOTO FINI OE200 00870C* OE200 00880C PART CHAINPARTMST 40 40 = MISS OE200 00890C N40N16 SETON 40 40 = HIT CODED OE200 00900C* TO DELETE OE200 00910C 30 INVALID CUST # OE200 0000920COR 40 Z-ADD0 UNITPR 73 INVALID PART # OE200 00930C* OE200 00940C 30 INVALID CUST # OE200 00950COR 40 GOTO FINI INVALID PART # OE200 00960C* OE200 00970C N20 Z-ADDUNPROV UNITPR OVERRIDE PRICE OE200 00980C 20 I COMP 1 50 50BASIS = 1 TO 5?OE200 0000990C 20 50 I COMP 5 5050 OE200 01000C 20 50 Z-ADDPRCD,I UNITPR YES --> PRICE OE200 01010C 20N50 Z-ADD0 UNITPR NO --> 0 OE200 01020C* OE200 01030C FINI TAG OE200 01040C* OE200 01050OBKLOGT D 03 60 OE200 0001060O PART 12 OE200 01070O MSOLL 19 OE200 01080O CUSTNO 24 OE200 01090O CPONUM 36 OE200 01100O PRODAT 42 OE200 01110O QTYORD 49 OE200 01120O UNITPR 56 OE200 0001130O ORDATE 62 OE200 01140O N30 NAME 86 OE200 01150O 30 82 '** INVALID CUST # **' OE200 01160O N40 DESCR 111 OE200 01170O 40 106 '** INVALID PART # **' OE200 ** 001180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00119000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001200ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001210ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001220/* 001230__0O 40 106 '** INVALID PART # **' OE200 ** 001180ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0011900(,J o}OTXOE210 P999999050878(000010H S OE210 00020X DECK-ID A64 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE210 00030F* PRINT BACKLOG BY PART NUMBER OE210 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE210 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE210 00060F* CONTROL DATA PROPRIETARY PRODUCT OE210 00070F* OE210 0000080FBKLOG IPEAF 125 DISK OE210 00090FHEADING IT F 40 EDISK OE210 00100F$LP1 O F 132 OF PRINTER OE210 00110F********************************************************************OE210 00120F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [ORD220] OE210 00130F* OE210 00140F* PACKAGE DISTRIBUTION OE210 0000150F* SYSTEM SALES ORDER PROCESSING OE210 00160F* PROGRAM PRINT BACKLOG BY PART # OE210 00170F* OE210 00180F* CONTRACTOR COMPUSOURCE OE210 00190F* PROGRAMMER KATH HILL OE210 00200F* DATE FEBRUARY 25, 1976 OE210 00210F* OE210 0000220F********************************************************************OE210 00230F* OE210 00240F* NARRATIVE: PROCESSED BKLOG BY PART #. OE210 00250F* OE210 00260F********************************************************************OE210 00270F* OE210 00280F* ID F C H L FUNCTION OF INDICATORS OE210 0000290F* OE210 00300F* 01 BKLOG OE210 00310F* OE210 00320F* L1PART #/BKLOG OE210 00330F* OE210 00340F********************************************************************OE210 00350E HEADING HEAD 1 1 40 COMPANY NAME OE210 0000360IBKLOG NS 01 OE210 00370I 1 12 PART L1 OE210 00380I 13 190MSO1 OE210 00390I 20 240CUST OE210 00400I 25 36 CPONUM OE210 00410I 37 420DUEDAT OE210 00420I 43 490ORDQTY OE210 0000430I 50 563UNITPR OE210 00440I 57 620ORDDAT OE210 00450I 63 86 CNAME OE210 00460I 87 111 DESCRP OE210 00470C* OE210 00480C ORDQTY MULT UNITPR EXTVAL 92H OE210 00490C TOTQTY ADD ORDQTY TOTQTY 70 OE210 0000500C TOTVAL ADD EXTVAL TOTVAL 92 OE210 00510C TOTAL ADD EXTVAL TOTAL 92 OE210 00520C* OE210 00530O$LP1 H 202 1P OE210 00540O OR OF OE210 00550O PAGE Z 10 OE210 00560O 4 'PAGE' OE210 0000570O HEAD,1 85 OE210 00580O UDATE Y 132 OE210 00590O H 2 1P OE210 00600O OR OF OE210 00610O 71 'BACKLOG REPORT' OE210 00620O 132 'DIS210' OE210 00630O H 1 1P OE210 0000640O OR OF OE210 00650O 44 'SALES' OE210 00660O 109 'ORDER DELIVERY' OE210 00670O 118 'ORDER' OE210 00680O 132 'EXTENDED' OE210 00690O H 2 1P OE210 00700O OR OF OE210 0000710O 6 'PART #' OE210 00720O 24 'DESCRIPTION' OE210 00730O 53 'ORDER # CUST#' OE210 00740O 67 'CUSTOMER NAME' OE210 00750O 90 'CUST P.O. #' OE210 00760O 98 'DATE' OE210 00770O 107 'DATE' OE210 0000780O 119 'QUANTITY' OE210 00790O 131 'VALUE' OE210 00800O D 1 01 OE210 00810O L1 PART 12 OE210 00820O OF PART 12 OE210 00830O L1 DESCRP 38 OE210 00840O OF DESCRP 38 OE210 0000850O MSO1 47 OE210 00860O CUST 53 OE210 00870O CNAME 78 OE210 00880O CPONUM 91 OE210 00890O ORDDATY 100 OE210 00900O DUEDATY 109 OE210 00910O ORDQTYJ 120 OE210 0000920O EXTVAL1 132 OE210 00930O T 1 L1 OE210 00940O 119 '---------' OE210 00950O 132 '------------' OE210 00960O T 2 L1 OE210 00970O PART 102 OE210 00980O 109 'TOTALS' OE210 0000990O TOTQTYJB 120 OE210 01000O TOTVAL1B 132 OE210 01010O T 31 LR OE210 01020O 11 'END OF JOB.' OE210 01030O 35 'TOTAL VALUE OF BACKLOG' OE210 01040O 40 'IS $' OE210 01050O TOTAL J 52 OE210 00** 001060ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001070ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001080ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001090ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001100/* 001110__0O TOTAL J 52 OE210 0(,KC }OTXOE220 P999999050878(000010H S OE220 00020X DECK-ID A65 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE220 00030F* PRINT BACKLOG BY SALES ORDER NUMBER OE220 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE220 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE220 00060F* CONTROL DATA PROPRIETARY PRODUCT OE220 00070F* OE220 0000080FOPNORDS IPEAF 118 8AI 106 DISK OE220 00090FARMAST IC F 280R 6AI 1 DISK OE220 00100FPARTMST IC F 300R12AI 1 DISK OE220 00110FHEADING IT F 40 EDISK OE220 00120F$LP1 O F 132 OF PRINTER OE220 00130F********************************************************************OE220 00140F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [ORD240] OE220 0000150F* OE220 00160F* PACKAGE DISTRIBUTION OE220 00170F* SYSTEM SALES ORDER PROCESSING OE220 00180F* PROGRAM PRINT BACKLOG BY SALES ORDER # OE220 00190F* OE220 00200F* CONTRACTOR COMPUSOURCE OE220 00210F* PROGRAMMER KATH HILL OE220 0000220F* DATE FEBRUARY 25, 1976 OE220 00230F* OE220 00240F********************************************************************OE220 00250F* ID F C H L FUNCTION OF INDICATORS OE220 00260F* OE220 00270F* 01 OPNORDS (H) OE220 00280F* 03 (LL) OE220 0000290F* 04 (ALL OTHERS) OE220 00300F* 05 ARMAST OE220 00310F* 06 PARTMST OE220 00320F* OE220 00330F* 15 GOOD RECORD (ARMAST) OE220 00340F* 16 GOOD RECORD (PARTMST) OE220 00350F* 20 UNIT PRICE OVERRIDE = 0 OE220 0000360F* 21 PRICE CODE OVERRIDE = 0 OE220 00370F* OE220 00380F* 30 MISS ON CHAIN (ARMAST) OE220 00390F* 40 MISS ON CHAIN (PARTMST) OE220 00400F* N50 BAD PRICE CODE ON FILE - DEFAULT TO PRICE = 0 OE220 00410F* OE220 00420F********************************************************************OE220 0000430E PRCD 5 7 3 OE220 00440E HEADING HEAD 1 1 40 COMPANY NAME OE220 00450IOPNORDS NS 01 8 CH OE220 00460I 3 70MSO1 L1 OE220 00470I 9 130CUSTNO OE220 00480I 14 190ORDDAT OE220 00490I 20 31 CPONUM OE220 0000500I 43 430PRCDOV 21 OE220 00510I 50 550PRODAT OE220 00520I 105 105 STATUS 60 OE220 00530I NS 03 8 CL 11 CL OE220 00540I 3 70MSOLL OE220 00550I 12 23 PART OE220 00560I 24 300QTYORD OE220 0000570I 52 583UNPROV 20 OE220 00580I NS 04 OE220 00590I 1 105 IMAGE OE220 00600IARMAST NS 05 OE220 00610I 7 30 CNAME OE220 00620I 115 115 DLTAR 15 OE220 00630I 161 1610PRCODE OE220 0000640IPARTMST NS 06 OE220 00650I 74 74 DLTPR 16 OE220 00660I 226 260 PRCD OE220 00670C* OE220 00680C 01N60 STATUS COMP 'P' 60 OE220 00690C 01N60 STATUS COMP 'B' 60 OE220 00700C 01N60 GOTO FINI OE220 0000710C 01 Z-ADDCUSTNO KEY 60 OE220 00720C 01 KEY CHAINARMAST 30 OE220 00730C 01N30N15 SETON 30 OE220 00740C 21 Z-ADDPRCODE I 10 OE220 00750C N21 Z-ADDPRCDOV I OE220 00760C* OE220 00770C N03 GOTO FINI OE220 0000780C N60 GOTO FINI OE220 00790C N20 Z-ADDUNPROV UNITPR 73 OE220 00800C N20 GOTO ON1 OE220 00810C* OE220 00820C 30 Z-ADD0 UNITPR OE220 00830C 30 GOTO ON1 OE220 00840C* OE220 0000850C PART CHAINPARTMST 40 OE220 00860C N40N16 SETON 40 OE220 00870C 40 Z-ADD0 UNITPR OE220 00880C 40 GOTO ON1 OE220 00890C I COMP 1 50 50CODE 1-5 ? OE220 00900C 50 I COMP 5 5050 OE220 00910C N50 Z-ADD0 UNITPR NO. DEFAULT=0 OE220 0000920C 50 Z-ADDPRCD,I UNITPR YES. OE220 00930C* OE220 00940C ON1 TAG OE220 00950C* OE220 00960C QTYORD MULT UNITPR AMT 92H OE220 00970C MSOAMT ADD AMT MSOAMT 92 OE220 00980C TOTAL ADD AMT TOTAL 92 OE220 0000990C* OE220 01000C FINI TAG OE220 01010C* OE220 01020O$LP1 H 202 1P OE220 01030O OR OF OE220 01040O PAGE Z 10 OE220 01050O 4 'PAGE' OE220 0001060O HEAD,1 85 OE220 01070O UDATE Y 132 OE220 01080O H 2 1P OE220 01090O OR OF OE220 01100O 71 'BACKLOG REPORT' OE220 01110O 132 'DIS220' OE220 01120O H 1 1P OE220 0001130O OR OF OE220 01140O 5 'SALES' OE220 01150O 69 'DELIVERY' OE220 01160O 83 'ORDER' OE220 01170O 92 'ORDER' OE220 01180O H 2 1P OE220 01190O OR OF OE220 0001200O 7 'ORDER #' OE220 01210O 16 'CUST #' OE220 01220O 31 'CUSTOMER NAME' OE220 01230O 59 'CUSTOMER P.O. #' OE220 01240O 67 'DATE' OE220 01250O 83 'AMOUNT' OE220 01260O 91 'DATE' OE220 0001270O T 1 L1 60 OE220 01280O MSO1 8 OE220 01290O CUSTNO 16 OE220 01300O N30CNAME 42 OE220 01310O 30 38 '** INVALID CUST #' OE220 01320O CPONUM 56 OE220 01330O PRODATY 69 OE220 0001340O MSOAMTJB 84 OE220 01350O ORDDATY 93 OE220 01360O T 31 LR OE220 01370O 11 'END OF JOB.' OE220 01380O 35 'TOTAL VALUE OF BACKLOG' OE220 01390O 40 'IS $' OE220 01400O TOTAL J 53 OE220 00** 001410ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001420ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001430ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001440ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001450/* 001460__0O TOTAL J 53 OE220 0(<K /OTXOE310 P999999050878(000010H S OE310 00020X DECK-ID A66 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE310 00030F* SALES ORDER INQUIRY/MAINTENANCE OE310 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE310 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE310 00060F* CONTROL DATA PROPRIETARY PRODUCT OE310 00070F* OE310 0000080FDUMMY IPEAF 72 DISK OE310 00090FDISPR2 IC F 32R DISK OE310 00100FARMAST IC F 280R 6AI 1 DISK OE310 00110FPARTMST UC F 300R12AI 1 DISK OE310 00120FOPNORDS UC F 118R 8AI 106 DISK OE310 00130FSLSMAN IC F 30R 3AI 1 DISK OE310 00140FAREA IC F 30R 2AI 1 DISK OE310 0000150FTERMS IC F 30R 1AI 1 DISK OE310 00160F********************************************************************OE310 00170F* PACKAGE-DISTRIBUTION CONTRACTOR-COMPUSOURCE OE310 00180F* OE310 00190F* SYSTEM-INVOICING BY-GAIL KARON/ROBBIE FREEMAN OE310 00200F* OE310 00210F* PROGRAM-SHIPPER CONFIRMATION DATE- 8/27/76 OE310 0000220F********************************************************************OE310 00230F* DIS310 IS SALES ORDER INQUIRY/MAINT PROGRAM. OE310 00240F********************************************************************OE310 00250F* FUNCTION OF INDICATORS OE310 00260F* OE310 00270F* 01 RECORD FROM DUMMY--NO RECORDS EXIST IN THIS FILE OE310 00280F* 02 ORDPR2 RECORD--PARAMETER FILE RECORDS OE310 0000290F* 03 RECORD FROM ARMAST--CHAIN TO IT OE310 00300F* 04 RECORD FROM ORDRRN--CHAIN TO IT OE310 00310F* 05 RECORD FROM PARTMST--CHAIN TO IT OE310 00320F* 06 RECORD FROM ROPNORD OE310 00330F* 08 RECORD FROM SLSMAN OE310 00340F* 09 RECORD FROM AREA OE310 00350F* 10 RECORD FROM TERMS OE310 0000360F* 30 OUTFLD SUBROUTINE-LEN = 0, IT'S A MESSAGE OE310 00370F* UPDATE SUBROUTINE--N73=TRY ANOTHER X OE310 00380F* -- 73=BEGIN AT X=7 AGAIN OE310 00390F* ACCEPT SUBROUTINE-IS X OUT OF SECTN SIZE RANGE OE310 00400F* -@ SIGN--LEAVE SUBROUTINE OE310 00410F* 31 OUTPUT SUBROUTINE--COMP NOFLDS TO CONTINUE LOOP OE310 00420F* OUTFLD SUBROUTINE--COMP CONSTANT LENGTH(FL) TO OE310 0000430F* END POS OF FIELD(FC)--LEN IS NEGATIVE IMPLIES OE310 00440F* THE FIELD IS NUMERIC OE310 00450F* UPDATE SUBROUTINE--RUBOUT AT FIRST CHARACTER OF OE310 00460F* FIELD IS NOT AT FIRST UPDATE ON SCREEN-CONTINUE OE310 00470F* THE LOOP OE310 00480F* ACCEPT SUBROUTINE--RCODE IS 'R'--RUBOUT OE310 00490F* OE310 0000500F* 32 BODY OF PROGRAM--RUBOUT AT FIRST UPDATE FIELD-GO OE310 00510F* TO PRIOR SCREEN OE310 00520F* GETSEC SUBROUTINE--X GREATER THAN SECTN SIZE OE310 00530F* UPDATE SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE310 00540F* ACCEPT SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE310 00550F* 33 UPDATE & ACCEPT SUBROUTINE--LINE FEED THROUGH FIELD OE310 00560F* 34 ACCEPT SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE310 0000570F* 35 UPDATE SUBROUTINE--@ AT BEGINNING OF FIELD OE310 00580F* 37 LNGTH SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE310 00590F* 40 END-OF-JOB CONDITION OE310 00600F* 41 GETSEC SUBROUTINE--FIELDN & CURPOS BLANK OE310 00610F* MEANS END OF THAT SECTION IN PARAMETER FILE OE310 00620F* 42 MODE IS BLANK, D, A, OR I -- EXCPT OUTPUT STATUS OE310 00630F* 43 MODE IS B FOR BACKORDER -- EXCPT OUTPUT STATUS OE310 0000640F* 45 MODE IS D OE310 00650F* 50 RRN CHAIN TO PARAMETER FILE--NO MORE RECORDS OE310 00660F* 58 USED IN GET2 FOR LINE ITEM TYPE OE310 00670F* 59 USED IN GET2, POSLIN, & EDIT SUBROUTINES OE310 00680F* USED FOR COMPARISIONS TO CONTINUE LOOPS, ETC. OE310 00690F* 60 SUBR E412 - PART# - DO SUBR PUTPRC TO STORE PRICE OE310 00700F* 61 FIRSTP SUBROUTINE OE310 0000710F* 62 FIRSTP SUBROUTINE OE310 00720F* 65 SUBR UPDATE - DON'T UPDATE RECORD (DON'T DO 'PUT') OE310 00730F* FOR OVERRIDE PRICE IF RESPONSE WAS LF OR ZERO. OE310 00740F* 66 'WHAT LINE ?' = T --GO TO CONTROL SCREEN OE310 00750F* 67 'WHAT LINE ?' = @ OR R OE310 00760F* DO ANOTHER LINE ITEM SCREEN--GO FORWARD OR BACK OE310 00770F* 68 'WHAT LINE ?' EDIT OE310 0000780F* DON'T ALTER LOWER & UPPER BOUND OE310 00790F* 70 SECTN = 1 HEADER OE310 00800F* 71 SECTN = 2 SHIP-TO CUST OE310 00810F* 72 SECTN = 3 MARK FOR COMMENTS OE310 00820F* 74 SECTN = 4 LINE ITEM UPDATE--PRICE OVERRIDE OE310 00830F* 75 SECTN = 5 LINE ITEM BACKORDER SITUATION OE310 00840F* 76 SECTN = 4 OR 5 EITHER LINE ITEM SCREEN OE310 0000850F* 77 SECTN = 6 OR 5 FREIGHT/SPECIAL CHARGES OE310 00860F* 80 EXCEPTION OUTPUT OF RANDOM RECORD OE310 00870F* 81 DISPLAY FIELD FROM RECORD--DON'T ALLOW UPDATE OE310 00880F* 83 XTYPE SUBROUTINE--SECTN 4 & 5, X=11 WHAT LINE ? OE310 00890F* 84 XTYPE SUBROUTINE--SECTN 4 & 5 X=12 PRODUCT # OE310 00900F* 85 XTYPE SUBROUTINE--SECTN 4 X=13 SHIP-TO-DATE OE310 00910F* XTYPE SUBROUTINE--SECTN 5 X=13 ORDERED OE310 0000920F* 86 XTYPE SUBROUTINE--SECTN 4 X=14 ON ORDER OE310 00930F* XTYPE SUBROUTINE--SECTN 5 X=14 SHIP OE310 00940F* 87 XTYPE SUBROUTINE--SECTN 4 X=15 PRICE OVERRIDE OE310 00950F* XTYPE SUBROUTINE--SECTN 5 X=15 BACKORDER OE310 00960F* 88 XTYPE SUBROUTINE--SECTN 4 & 5 X=16 LINE COMMENT OE310 00970F* 89 'WHAT LINE ?' EDIT IS VALID--INCREMENT X VALUE OE310 00980F* 90 EXCPT OUTPUT TO LINES OE310 0000990F* 95 EDIT SUBROUTINE--OUTPUT STATUS OF SALES ORDER # OE310 01000F* 96 EDIT SUBROUTINE--ERROR EXISTS OE310 01010F* 97 EDIT SUBROUTINE--GOTO CORRECT TAG OE310 01020F* LR LAST RECORD--BODY OF PROGRAM LOOPS THROUGH LR CALCS OE310 01030F* 99 OUTPUT SALLOC TO PARTMST OE310 01040E********************************************************************OE310 01050E FN 27 22 FIELD NAME OE310 0001060E CP 27 4 CURSOR POSITION OE310 01070E LN 27 2 0 LENGTH OE310 01080E EP 27 3 0 ENDING POSITION OE310 01090E PB 5 7 3 PARTMST PRICES OE310 01100E PRC 18 7 3 STORED PRICES OE310 01110E TABD 12 12 2 0 TABE 2 0 MONTH/DAY TABLE OE310 01120E MS 1 4 30 MESSAGE ARRAY OE310 0001130E TABA 1 17 3 0 TABB 30 ERROR MESSAGES OE310 01140E* OE310 01150E* TABA CONTAINS SECTION NUMBER AND X COORDINATE TO BE EDITED OE310 01160E* TABB CONTAINS CURPOS, ERROR MESSAGE, & SUBR# FOR SUBRXS. OE310 01170E********************************************************************OE310 01180IDUMMY NS 01 OE310 01190I 1 1 A OE310 0001200IDISPR2 NS 02 OE310 01210I 1 22 FIELDN OE310 01220I 23 26 CURPOS OE310 01230I 27 280LNGTHA OE310 01240I 29 310ENDPOS OE310 01250I 32 320SET OE310 01260IARMAST NS 03 OE310 0001270I 7 30 NAME OE310 01280I 31 54 ADR1 OE310 01290I 55 78 ADR2 OE310 01300I 79 91 CITY OE310 01310I 92 93 STCODE OE310 01320I 94 980ZIP OE310 01330I 94 98 AZIP OE310 0001340I 115 115 DCODE OE310 01350I 161 1610PC OE310 01360IPARTMST NS 05 OE310 01370I 13 37 DESC OE310 01380I 74 74 DPCODE OE310 01390I 146 1520SOH OE310 01400I 167 1730SALLOC OE310 0001410I 226 260 PB OE310 01420IOPNORDS NS 06 OE310 01430I 1 20BKORD OE310 01440I 3 70SO OE310 01450I 1 118 REC OE310 01460I 12 23 PART OE310 01470I 105 105 STATUS OE310 0001480I 9 130CUST OE310 01490I 43 430OVPC OE310 01500I 11 11 LM OE310 01510I 24 300QO OE310 01520I 38 44 QS OE310 01530ISLSMAN XX 08 OE310 01540I 4 28 SNAME OE310 0001550I 30 30 DLTSMN OE310 01560IAREA XX 09 OE310 01570I 3 27 ANAME OE310 01580I 30 30 DLTARA OE310 01590ITERMS XX 10 OE310 01600I 2 26 TNAME OE310 01610I 30 30 DLTTRM OE310 0001620C MOVE ' ' RCODE OE310 01630C MOVE RCODE B72 72 BLANK FIELDS OE310 01640C MOVE RCODE B26 26 OE310 01650C MOVE RCODE B22 22 OE310 01660C MOVE RCODE B7 7 OE310 01670C SETON LR OE310 01680C* OE310 0001690CLR Z-ADD36 UPPER 20 SET LINE-ITEM OE310 01700CLR MOVE UPPER UPPERA 2 LIMITS OE310 01710CLR Z-ADD27 SSIZE 20 OE310 01720CLR Z-ADD07 NSECT 20 OE310 01730C* OE310 01740CLR START TAG OE310 01750CLR SETOF 4243 OE310 0001760CLR SETOF 707172 OE310 01770CLR SETOF 767475 OE310 01780CLR MOVE ' ' RECORD OE310 01790CLR EXSR FIRSTP OE310 01800CLR 40 EXSR CLRSCR OE310 01810CLR 40 GOTO EOJ OE310 01820CLR 42 GOTO START OE310 0001830CLR EXSR CLRSCR OE310 01840CLR EXSR GETSEC OE310 01850CLR EXSR OUTPUT OE310 01860CLR Z-ADD1 Y 20 OE310 01870CLR MOVE Y YSAVE 20 OE310 01880CLR Z-ADD0 YLIM 20 OE310 01890CLR Z-ADD1 LB 20 LOWER BOUND OE310 0001900CLR Z-ADD18 UB 20 UPPER BOUND OE310 01910CLR BLOOP TAG OE310 01920CLR MOVE B7 PRC BLANK ARRAY OE310 01930CLR 76 EXSR GET2 OE310 01940CLR EXSR UPDATE OE310 01950CLR 67 EXSR CLRSCR OE310 01960CLR 67 EXSR OUTPUT OE310 0001970CLR 67 GOTO BLOOP OE310 01980CLR GOTO START OE310 01990CLR EOJ TAG OE310 02000C********************************************************************OE310 02010C* THIS SUBROUTINE CLEARS THE SCREEN AND ASKS FOR THE KEY AND OE310 02020C* SECTION FOR INQUIRY/UPDATE. OE310 02030C********************************************************************OE310 0002040CSR FIRSTP BEGSR OE310 02050CSR EXSR CLRSCR OE310 02060CSR Z-ADD0 SECTN 10 OE310 02070CSR EXSR GETSEC OE310 02080CSR PGE TAG OE310 02090CSR SETON 6162 OE310 02100CSR EXSR OUTPUT OE310 0002110CSR KXTAG TAG OE310 02120CSR Z-ADDKX X OE310 02130CSR EXSR ACCEPT OE310 02140CSR MOVELBUFFER KEY OE310 02150CSR MOVELSAVPOS BUFFER OE310 02160CSR EXSR POSCUR OE310 02170CSR MOVELKEY BUFFER OE310 0002180CSR MOVE 'S' TYPE OE310 02190CSR EXSR CRTCOM OE310 02200CSR MOVELKEY BUFFER OE310 02210CSR EXSR EDIT OE310 02220CSR 96 GOTO KXTAG OE310 02230CSR SETOF 62 OE310 02240CSR SXTAG TAG OE310 0002250CSR Z-ADDSX X 20 OE310 02260CSR EXSR ACCEPT OE310 02270CSR EXSR EDIT OE310 02280CSR 96 GOTO SXTAG OE310 02290CSR 30 GOTO PGE OE310 02300CSR SETOF 61 OE310 02310CSR ENDSR OE310 0002320C********************************************************************OE310 02330C* THIS SUBROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE310 02340C********************************************************************OE310 02350CSR GETSEC BEGSR OE310 02360CSR SETOF 4041 OE310 02370CSR SECTN MULT SSIZE RRN 50 OE310 02380CSR Z-ADD1 X OE310 0002390CSR SCLOOP TAG OE310 02400CSR RRN ADD 1 RRN OE310 02410CSR RRN CHAINDISPR2 50 OE310 02420CSR 50 GOTO ENDGET OE310 02430CSR FIELDN COMP B22 4141 OE310 02440CSRN41 CURPOS COMP ' ' 4141 OE310 02450CSRN41 GOTO ENDGET OE310 0002460CSR MOVE FIELDN FN,X OE310 02470CSR MOVE CURPOS CP,X OE310 02480CSR MOVE LNGTHA LN,X OE310 02490CSR MOVE ENDPOS EP,X OE310 02500CSR X ADD 1 X OE310 02510CSR X COMP SSIZE 32 OE310 02520CSRN32 GOTO SCLOOP OE310 0002530CSR ENDGET TAG OE310 02540CSR Z-ADDX NOFLDS 20 OE310 02550CSR 76 Z-ADD12 NOFLDS OE310 02560CSR ENDSR OE310 02570C********************************************************************OE310 02580C* THIS SUBROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE310 02590C* THAT OUTPUTS THEM. IF FIRSTP CALLED THIS ROUTINE THEN THE OE310 0002600C* KEY INDEX AND SECTION INDEX IS SAVED. OE310 02610C********************************************************************OE310 02620CSR OUTPUT BEGSR OE310 02630CSR Z-ADD1 X OE310 02640CSR Z-ADD0 Y OE310 02650CSR OTLOOP TAG OE310 02660CSR 61 EP,X COMP 1 31 OE310 0002670CSR 61 31 Z-ADDX KX 20 KEY FIELD INDEXOE310 02680CSR 61 EP,X COMP 2 31 OE310 02690CSR 61 31 Z-ADDX SX 20 SECTION INDEX OE310 02700CSR EXSR OUTFLD OE310 02710CSR X ADD 1 X OE310 02720CSR X COMP NOFLDS 31 OE310 02730CSR 31 GOTO OTLOOP OE310 0002740CSR ENDSR OE310 02750C********************************************************************OE310 02760C* THIS SUBROUTINE OUTPUTS THE FIELD NAMES, FIELD INFORMATION, OE310 02770C* AND BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD OE310 02780C* LENGTH IS 0 THEN ONLY THE FIELD NAME IS OUTPUT. OE310 02790C* EACH TYPE OF SCREEN CALLS THE APPROPRIATE ROUTINE TO OE310 02800C* OUTPUT ITS FIELD INFORMATION. OE310 0002810C********************************************************************OE310 02820CSR OUTFLD BEGSR OE310 02830CSR MOVE FN,X FL 20 OE310 02840CSR FL COMP 0 81 DISPLAY FIELD OE310 02850CSR MOVELCP,X FC 20 OE310 02860CSR FC COMP FL 31 OE310 02870CSR 31 Z-ADDFC FL OE310 0002880CSR FC SUB FL CC 20 OE310 02890CSR CC ADD 1 CC OE310 02900CSR MOVELCP,X BUFFER OE310 02910CSR 76 EXSR POSLIN OE310 02920CSR MOVELCC BUFFER OE310 02930CSR EXSR POSCUR OE310 02940CSR MOVELB72 BUFFER OE310 0002950CSR MOVELFN,X FIELDN OE310 02960CSR MOVE ' ' FIELDN OE310 02970CSR MOVELFIELDN BUFFER OE310 02980CSR Z-ADDLN,X LEN 20 OE310 02990CSR LEN COMP 0 3130 OE310 03000CSR 31 Z-SUBLN,X LEN OE310 03010CSR 30 GOTO SKIPF OE310 0003020CSR EXSR LTBRKT OE310 03030CSR 81 Z-ADDBPOS FPOS OE310 03040CSRN81 BPOS ADD 1 FPOS 20 OE310 03050CSRN61 EXSR GET OE310 03060CSR EXSR XTYPE OE310 03070CSR 74 EXSR GETPRC GET PRICE OE310 03080CSRN81 EXSR RTBRKT OE310 0003090CSR SKIPF TAG OE310 03100CSR 30 Z-ADDFL BLNGTH OE310 03110CSR SETOF 59 OE310 03120CSR 30N61 X COMP 5 59 OE310 03130CSR 59 MOVELKEY BUFFER OE310 03140CSR SETOF 59 OE310 03150CSRN30N81 FL ADD 3 BLNGTH OE310 0003160CSRN30 81 FL ADD 1 BLNGTH OE310 03170CSRN30 BLNGTH ADD LEN BLNGTH OE310 03180CSR MOVE 'S' TYPE OE310 03190CSR EXSR CRTCOM OE310 03200CSR ENDSR OE310 03210C********************************************************************OE310 03220C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE RECORD. OE310 0003230C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE310 03240C* CHARACTERS WERE TYPED, THE CURSOR JUMPS TO THE BEGINNING OE310 03250C* OF THE PREVIOUS FIELD. IF THE 1ST CHARACTER IS AN '@' THEN OE310 03260C* THE REST OF THE FIELDS ARE LEFT UNCHANGED. OE310 03270C********************************************************************OE310 03280CSR UPDATE BEGSR OE310 03290CSR SETOF 32 OE310 0003300CSR Z-ADD1 X OE310 03310CSR Z-ADDYSAVE Y OE310 03320CSR UPLOOP TAG OE310 03330CSR MOVE FN,X FL OE310 03340CSR FL COMP 0 30 OE310 03350CSRN30 EXSR LNGTH OE310 03360CSR 30N32 GOTO INCR OE310 0003370CSR 30 GOTO CHKRUB OE310 03380CSR SETOF 3233 OE310 03390CSR 76 EXSR XTYPE WHICH 'X' OE310 03400CSR 74 89 Z-ADD14 X GET TO X=15 OE310 03410CSR 75 89 Z-ADD14 X GET TO X=14 OE310 03420CSR SETOF 89 OE310 03430CSR EXSR XTYPE OE310 0003440CSR EXSR ACCEPT OE310 03450CSR CHKRUB TAG OE310 03460CSR 32 87 74 NO RUBOUT ON OE310 03470COR 32 86 75 WHAT LINE OR OE310 03480COR 32 83 76 GOTO UPLOOP BACK TO WHAT OE310 03490C* LINE OE310 03500CSR 32 X SUB 1 X 31 OE310 0003510CSR 32 31 GOTO UPLOOP OE310 03520CSR 32 GOTO ENDUPD OE310 03530CSR MOVELBUFFER ATSIGN 1 OE310 03540CSR ATSIGN COMP '@' 35 OE310 03550CSR 35 76 83 GOTO ATSG1 @ IN WHAT LINE OE310 03560CSR 35 76 GOTO UPLOOP NO @ LINE ITEMSOE310 03570CSR 35 GOTO OUTREC OE310 0003580CSR ATSG1 TAG OE310 03590CSR 33 Z-ADD1 FPOS OE310 03600CSR 33 EXSR GET OE310 03610CSR EXSR EDIT OE310 03620C* OE310 03630CSR 66 T=GOTO CONTROL OE310 03640COR 67 R,@= NEW LINES OE310 0003650COR 40 GOTO ENDUPD E=END OF JOB OE310 03660CSR 96 GOTO UPLOOP OE310 03670CSR 33 GOTO INCR OE310 03680CSRN65 EXSR PUT OE310 03690CSR EXSR OUTFLD OE310 03700CSR INCR TAG OE310 03710CSR SETOF 30 OE310 0003720CSR X ADD 1 X OE310 03730CSRN76 X COMP NOFLDS 30 OE310 03740CSR 30 GOTO UPLOOP OE310 03750CSR OUTREC TAG OE310 03760CSR 76 X COMP 16 30 OE310 03770CSR 76N30 GOTO UPLOOP OE310 03780CSR MOVELRECORD REC OE310 0003790CSR SETON 80 OE310 03800CSR EXCPT OE310 03810CSR SETOF 80 OE310 03820CSR 76 30 Z-ADD11 X OE310 03830CSR 76 GOTO UPLOOP OE310 03840CSR ENDUPD ENDSR OE310 03850C********************************************************************OE310 0003860C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE310 03870C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE310 03880C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC & OE310 03890C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE310 03900C* WAS USED TO TERMINATE THE OPERATION THEN THE OPERATION IS OE310 03910C* RETIRED IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE OE310 03920C* INDICATOR 32 IS SETON. IF A LINE FEED WAS USED THEN THE OE310 0003930C* ORIGINAL FIELD INFO IS OUTPUT TO THE SCREEN. A NORMAL OE310 03940C* TERMINATION CAUSES THE NEW INFO TO BE OUTPUT TO THE SCREEN. OE310 03950C********************************************************************OE310 03960CSR ACCEPT BEGSR OE310 03970CSR X COMP 1 30 OE310 03980CSRN30 X COMP SSIZE 30 OE310 03990CSR 30 Z-ADD1 X OE310 0004000CSR MOVELCP,X FC OE310 04010CSR FC ADD 3 FC OE310 04020CSR MOVELCP,X SAVPOS 4 OE310 04030CSR 76 EXSR POSLIN OE310 04040CSR MOVELFC SAVPOS OE310 04050CSR LN,X ADD FC OFC 20 OE310 04060CSR OFC ADD 1 OFC OE310 0004070CSR Z-ADDLN,X LEN OE310 04080CSR LEN COMP 0 34 OE310 04090CSR 34 Z-SUBLEN LEN OE310 04100CSR ACLOOP TAG OE310 04110CSR MOVELSAVPOS BUFFER OE310 04120CSR EXSR POSCUR OE310 04130CSR Z-ADDLEN BLNGTH OE310 0004140CSR MOVE B72 BUFFER OE310 04150CSR MOVE 'A' TYPE OE310 04160CSR EXSR CRTCOM OE310 04170CSR RCODE COMP 'R' 31 OE310 04180CSR 31 BUFFER COMP B72 32 OE310 04190CSR 31 32N61 GOTO ENDACC OE310 04200CSR 31 GOTO ACLOOP OE310 0004210CSR RCODE COMP 'L' 33 OE310 04220CSR 33 GOTO DUPIT OE310 04230CSRN34 GOTO ENDACC OE310 04240CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE310 04250CSR SIGN COMP '@' 30 OE310 04260CSR 30 GOTO ENDACC OE310 04270CSR Z-ADDLEN VL 20 OE310 0004280CSR MOVELBUFFER VAR 15 OE310 04290CSR EXSR RTADJ OE310 04300CSR MOVELVAR BUFFER OE310 04310CSR GOTO ENDACC OE310 04320CSR DUPIT TAG OE310 04330CSRN61 EXSR OUTFLD OE310 04340CSRN61 GOTO ENDACC OE310 0004350CSR MOVELSAVPOS BUFFER OE310 04360CSR EXSR POSCUR OE310 04370CSR 62 MOVELKEY BUFFER OE310 04380CSRN62 MOVELSECTON BUFFER OE310 04390CSR MOVE 'S' TYPE OE310 04400CSR EXSR CRTCOM OE310 04410CSR ENDACC ENDSR OE310 0004420C********************************************************************OE310 04430C* THIS SUBROUTINE MOVES A LEFT BRACKET INTO BUFFER AT BPOS. OE310 04440C********************************************************************OE310 04450CSR LTBRKT BEGSR OE310 04460CSR FL ADD 2 BPOS 20 OE310 04470CSR Z-ADD1 WHICH1 10 OE310 04480CSRN81 EXIT SUBRIN OE310 0004490CSR RLABL WHICH1 10 OE310 04500CSR RLABL BUFFER 72 OE310 04510CSR RLABL RECORD OE310 04520CSR RLABL BPOS 20 OE310 04530CSR RLABL FPOS 20 OE310 04540CSR RLABL STRT 30 OE310 04550CSR RLABL LEN 20 OE310 0004560CSR ENDSR OE310 04570C********************************************************************OE310 04580C* THIS SUBROUTINE MOVES INFO FROM 'RECORD' INTO BUFFER. OE310 04590C* MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE310 04600C* FROM STRT IN RECORD TO FPOS IN BUFFER. OE310 04610C********************************************************************OE310 04620CSR GET BEGSR OE310 0004630CSR EP,X SUB LEN STRT 30 OE310 04640CSR STRT ADD 1 STRT OE310 04650CSR Z-ADD2 WHICH1 10 OE310 04660CSR EXIT SUBRIN OE310 04670CSR RLABL WHICH1 10 OE310 04680CSR RLABL BUFFER 72 OE310 04690CSR RLABL RECORD OE310 0004700CSR RLABL BPOS 20 OE310 04710CSR RLABL FPOS 20 OE310 04720CSR RLABL STRT 30 OE310 04730CSR RLABL LEN 20 OE310 04740CSR ENDSR OE310 04750C********************************************************************OE310 04760C* THIS SUBROUTINE INSERTS A RIGHT BRACKET INTO BUFFER AT BPOS. OE310 0004770C********************************************************************OE310 04780CSR RTBRKT BEGSR OE310 04790CSR LEN ADD FPOS FPOS OE310 04800CSR Z-ADD3 WHICH1 10 OE310 04810CSR EXIT SUBRIN OE310 04820CSR RLABL WHICH1 10 OE310 04830CSR RLABL BUFFER 72 OE310 0004840CSR RLABL RECORD OE310 04850CSR RLABL BPOS 20 OE310 04860CSR RLABL FPOS 20 OE310 04870CSR RLABL STRT 30 OE310 04880CSR RLABL LEN 20 OE310 04890CSR ENDSR OE310 04900C********************************************************************OE310 0004910C* THIS SUBROUTINE MOVES LEN NUMBER OF CHARS FROM THE BEGINNING OE310 04920C* OF BUFFER TO THE STRT OF RECORD. OE310 04930C********************************************************************OE310 04940CSR PUT BEGSR OE310 04950CSR EP,X SUB LEN STRT OE310 04960CSR STRT ADD 1 STRT OE310 04970CSR Z-ADD4 WHICH1 10 OE310 0004980CSR EXIT SUBRIN OE310 04990CSR RLABL WHICH1 10 OE310 05000CSR RLABL BUFFER 72 OE310 05010CSR RLABL RECORD OE310 05020CSR RLABL BPOS 20 OE310 05030CSR RLABL FPOS 20 OE310 05040CSR RLABL STRT 30 OE310 0005050CSR RLABL LEN 20 OE310 05060CSR ENDSR OE310 05070C********************************************************************OE310 05080C* THIS SUBROUTINE RIGHT ADJUSTS FIELDS. OE310 05090C********************************************************************OE310 05100CSR RTADJ BEGSR OE310 05110CSR EXIT SUBRAJ OE310 0005120CSR RLABL VL OE310 05130CSR RLABL VAR OE310 05140CSR ENDSR OE310 05150C********************************************************************OE310 05160C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. OE310 05170C********************************************************************OE310 05180CSR CRTCOM BEGSR OE310 0005190CSR EXITFSUBRCM OE310 05200CSR RLABL BUFFER 72 OE310 05210CSR RLABL TYPE 1 OE310 05220CSR RLABL BLNGTH 20 OE310 05230CSR RLABL RCODE 1 OE310 05240CSR RLABL MASK 10 OE310 05250CSR RLABL DTYPE 10 OE310 0005260CSR ENDSR OE310 05270C********************************************************************OE310 05280C* THIS SUBROUTINE POSITIONS THE CURSOR. OE310 05290C********************************************************************OE310 05300CSR POSCUR BEGSR OE310 05310CSR MOVE 'P' TYPE OE310 05320CSR EXSR CRTCOM OE310 0005330CSR ENDSR OE310 05340C********************************************************************OE310 05350C* THIS SUBROUTINE CLEARS THE SCREEN. OE310 05360C********************************************************************OE310 05370CSR CLRSCR BEGSR OE310 05380CSR MOVE 'C' TYPE OE310 05390CSR EXSR CRTCOM OE310 0005400CSR ENDSR OE310 05410C********************************************************************OE310 05420C* THIS SUBROUTINE IS USED IN VARIOUS SUBROUTINES. OE310 05430C* IT TAKES THE VARIABLE LENGTH FROM THE ARRAYS AND MOVES IT OE310 05440C* INTO AN RPG FIELD 'LEN'. IF 'LEN' IS NEGATIVE THE VARIABLE OE310 05450C* IS NUMERIC, NOT ALPHA. IF 'LEN' IS ZERO, THERE IS NO VARIABLE, OE310 05460C* ONLY A MESSAGE. OE310 0005470C********************************************************************OE310 05480CSR LNGTH BEGSR OE310 05490CSR Z-ADDLN,X LEN OE310 05500CSR LEN COMP 0 3730 OE310 05510CSR 37 Z-SUBLEN LEN OE310 05520CSR ENDSR OE310 05530C********************************************************************OE310 0005540C* THIS SUBROUTINE DISPLAYS THE LINE ITEMS. OE310 05550C********************************************************************OE310 05560CSR GET2 BEGSR OE310 05570CSR MOVE YSAVE Y OE310 05580C* OE310 05590CSR GLOOP TAG OE310 05600CSR MOVELKEY WKEY 8 OE310 0005610CSR MOVELY WRKEY 3 OE310 05620CSR MOVE 'L' WRKEY OE310 05630CSR MOVE WRKEY WKEY OE310 05640CSR WKEY CHAINOPNORDS 59 NOT FOUND OE310 05650CSR MOVELREC RECORD OE310 05660CSRN59 SO COMP SSO 5959 OE310 05670CSR 59 Z-ADDY YLIM OE310 0005680CSR 59 GOTO EGET2 OE310 05690CSR EXSR POSLIN DISPLAY OE310 05700CSR MOVEL'03' BUFFER LINE # OE310 05710CSR EXSR POSCUR OE310 05720CSR MOVELY BUFFER OE310 05730CSR MOVE 'S' TYPE OE310 05740CSR Z-ADD2 BLNGTH OE310 0005750CSR EXSR CRTCOM OE310 05760C* OE310 05770CSR Z-ADD1 NCHARS FIND OUT IF IT OE310 05780CSR Z-ADD11 SSTRT 30 IS A LINE ITEMOE310 05790CSR Z-ADD1 TSTRT 30 OR LINE COMENTOE310 05800CSR EXIT SUBRMV OE310 05810CSR RLABL RECORD SOURCE OE310 0005820CSR RLABL SSTRT 30 OE310 05830CSR RLABL LC 1 TARGET OE310 05840CSR RLABL TSTRT 30 OE310 05850CSR RLABL NCHARS 30 OE310 05860C* OE310 05870CSR LC COMP 'L' 58 OE310 05880CSRN58 Z-ADD16 X OE310 0005890CSR 58 Z-ADD12 X OE310 05900CSR EXSR OUTFLD OE310 05910CSRN58 GOTO GL1 OE310 05920CSR Z-ADD12 NCHARS MOVE PRODUCT # OE310 05930CSR Z-ADD12 SSTRT TO BUFFER OE310 05940CSR Z-ADD1 TSTRT OE310 05950CSR EXIT SUBRMV OE310 0005960CSR RLABL RECORD OE310 05970CSR RLABL SSTRT 30 OE310 05980CSR RLABL BUFFER OE310 05990CSR RLABL TSTRT 30 OE310 06000CSR RLABL NCHARS 30 OE310 06010CSR EXSR XTYPE OE310 06020CSR EXSR EDIT OE310 0006030CSR Z-ADD13 X OE310 06040CSR EXSR OUTFLD OE310 06050CSR Z-ADD14 X OE310 06060CSR EXSR OUTFLD OE310 06070CSR Z-ADD15 X OE310 06080CSR EXSR OUTFLD OE310 06090CSR GL1 TAG OE310 0006100CSR EXSR YTOZ OE310 06110CSR Y ADD 1 Y OE310 06120CSRN59 GOTO GLOOP OE310 06130CSR Z-ADDY YLIM OE310 06140CSR EGET2 TAG OE310 06150CSR SETOF 59 OE310 06160CSR ENDSR OE310 0006170C********************************************************************OE310 06180C* THIS SUBROUTINE POSITIONS THE CURSOR TO THE PROPER LINE ON OE310 06190C* PAGE DURING LINE ITEMS, ETC. OE310 06200C********************************************************************OE310 06210CSR POSLIN BEGSR OE310 06220CSR X COMP 12 59 OE310 06230CSR 59 GOTO EPOS OE310 0006240CSR EXSR YTOZ OE310 06250CSR Z ADD 2 Z OE310 06260CSR MOVELZ BUFFER OE310 06270CSR MOVE Z SAVPOS OE310 06280CSR EPOS TAG OE310 06290CSR SETOF 59 OE310 06300CSR ENDSR OE310 0006310C********************************************************************OE310 06320C* THIS SUBROUTINE IS USED FOR LINE ITEMS ONLY. OE310 06330C* IT SETS AN INDICATOR ON ACCORDING TO WHICH 'X' ELEMENT IS OE310 06340C* BEING PROCESSED. IT'S ONLY CONCERNED WITH 'X' ELEMENTS 11-16. OE310 06350C********************************************************************OE310 06360CSR XTYPE BEGSR OE310 06370CSR X COMP 11 83 WHAT LINE ? OE310 0006380CSR X COMP 12 84 PRODUCT # OE310 06390CSR X COMP 13 85 S-T-D 74ON OE310 06400C** ORDERED 75ON OE310 06410CSR X COMP 14 86 ON ORDER 74ON OE310 06420C** SHIP 75ON OE310 06430CSR X COMP 15 87 PRICE OVRD 74 OE310 06440C** BACKORDER 75 OE310 0006450CSR X COMP 16 88 LINE COMMENT OE310 06460CSR ENDSR OE310 06470C********************************************************************OE310 06480C* THIS SUBROUTINE BREAKS UP A 6-BYTE DATE IN THE FORM MMDDYY, OE310 06490C* WHICH HAS BEEN MOVED INTO DIG6N, INTO YEAR (@YR), MONTH (@MO), OE310 06500C* DAY (@DA). OE310 06510C********************************************************************OE310 0006520CSR DATE BEGSR OE310 06530CSR MOVE DIG6N @YR 20 OE310 06540CSR MOVELDIG6N @MO 20 OE310 06550CSR MOVE DIG6N @DAYR 40 OE310 06560CSR MOVEL@DAYR @DA 20 OE310 06570CSR ENDT ENDSR OE310 06580C********************************************************************OE310 0006590C* THIS SUBROUTINE EDITS A DATE FIELD. OE310 06600C* IT LOOKS UP MONTH IN A TABLE TO VALIDATE THE YEAR. OE310 06610C********************************************************************OE310 06620CSR EDATE BEGSR OE310 06630CSR DIG6N COMP 0 59 OE310 06640CSR 59 MOVE UDATE DIG6N OE310 06650CSR 59 MOVELUDATE SAVE OE310 0006660CSR EXSR DATE OE310 06670CSR @MO COMP 0 96 OE310 06680CSRN96 @DA COMP 0 96 OE310 06690CSRN96 @YR COMP 0 96 OE310 06700CSRN96 @MO LOKUPTABD TABE 59 OE310 06710CSRN96N59 SETON 96 OE310 06720CSRN96 59 @DA COMP TABE 96 OE310 0006730CSR ENDTE ENDSR OE310 06740C********************************************************************OE310 06750C* THIS SUBROUTINE EDITS ANY FIELD SHOWN IN TABA. OE310 06760C* TABA CONTAINS SECTION AND X. OE310 06770C* TABB CONTAINS CURSOR POSITION,ERROR MESSAGE,& SUBR# FOR SUBRXS OE310 06780C********************************************************************OE310 06790CSR EDIT BEGSR OE310 0006800CSR SETOF 979695 OE310 06810CSR SETOF 596065 OE310 06820CSR SETOF 666768 OE310 06830CSR SETOF 4243 OE310 06840CSR MOVELSECTN XCNT 30 OE310 06850CSR MOVE X XCNT OE310 06860CSR XCNT LOKUPTABA TABB 97 OE310 0006870CSRN97 GOTO EEDIT OE310 06880CSR MOVE BUFFER SAVE 72 OE310 06890CSR MOVE B26 WORD26 26 OE310 06900CSR MOVE TABB DIG2N 20 OE310 06910CSR XCNT COMP 004 98 OE310 06920CSR 98 EXSR E004 OE310 06930CSR XCNT COMP 005 98 OE310 0006940CSR 98 EXSR E005 OE310 06950CSR XCNT COMP 106 98 OE310 06960CSR 98 EXSR E106 OE310 06970CSR XCNT COMP 107 98 OE310 06980CSR 98 EXSR E107 OE310 06990CSR XCNT COMP 108 98 OE310 07000CSR 98 EXSR E107 OE310 0007010CSR XCNT COMP 115 98 OE310 07020CSR 98 EXSR E115 OE310 07030CSR XCNT COMP 116 98 OE310 07040CSR 98 EXSR E116 OE310 07050CSR XCNT COMP 117 98 OE310 07060CSR 98 EXSR E117 OE310 07070CSR XCNT COMP 118 98 OE310 0007080CSR 98 EXSR E118 OE310 07090CSR XCNT COMP 119 98 OE310 07100CSR 98 EXSR E119 OE310 07110CSR XCNT COMP 206 98 OE310 07120CSR 98 EXSR E106 OE310 07130CSR XCNT COMP 411 98 OE310 07140CSR 98 EXSR E411 OE310 0007150CSR XCNT COMP 412 98 OE310 07160CSR 98 EXSR E412 OE310 07170CSR XCNT COMP 415 98 OE310 07180CSR 98 EXSR E415 OE310 07190CSR XCNT COMP 511 98 OE310 07200CSR 98 EXSR E411 OE310 07210CSR XCNT COMP 512 98 OE310 0007220CSR 98 EXSR E412 OE310 07230C********* OE310 07240C*** THIS SECTION DISPLAYS THE ERROR MESSAGE. OE310 07250C*** IT DISPLAYS BLANKS IF THE MESSAGE SHOUDN'T EXIST. OE310 07260C********* OE310 07270CSR ERMESS TAG OE310 07280CSRN97 GOTO EEDIT OE310 0007290CSR 96 MOVE TABB WORD26 OE310 07300CSR 96 MOVE ' ' WORD26 OE310 07310CSR MOVELTABB BUFFER OE310 07320CSR 76 EXSR POSLIN OE310 07330CSR 76 84 MOVEL'19' BUFFER PRODUCT DESC OE310 07340CSR EXSR POSCUR OE310 07350CSR MOVE 'S' TYPE OE310 0007360CSR MOVELWORD26 BUFFER OE310 07370CSR Z-ADD26 BLNGTH OE310 07380CSR EXSR CRTCOM OE310 07390CSR MOVE SAVE BUFFER OE310 07400CSR 74 60 EXSR PUTPRC STORE PRICES OE310 07410CSR EEDIT ENDSR OE310 07420C********************************************************************OE310 0007430C*** THIS SECTION EDITS THE SALES ORDER #. OE310 07440C*** CHAIN TO ORDRRN TO VALIDATE. THIS ALSO GIVES THE OE310 07450C*** RELATIVE RECORD # OF THE HEADER RECORD IN ROPNORD. OE310 07460C*** IT ALSO TELLS YOU THE STATUS OF THE S.O.,CUST#,& OVRD PRCE COD OE310 07470C********************************************************************OE310 07480CSR E004 BEGSR OE310 07490CSR MOVELBUFFER KEY 50 OE310 0007500CSR MOVELKEY WKEY OE310 07510CSR MOVEL'00' WRKEY OE310 07520CSR MOVE 'H' WRKEY OE310 07530CSR MOVE WRKEY WKEY OE310 07540CSR WKEY CHAINOPNORDS 96 SO NOT FOUND OE310 07550CSR Z-ADDKEY SSO 50 OE310 07560CSR 96 GOTO END004 OE310 0007570CSR Z-ADDCUST SCUST 60 SAVE CUST# OE310 07580CSR Z-ADDOVPC SOVPC 10 SAVE OVRD PC OE310 07590CSR STATUS COMP 'D' 59 OE310 07600CSR 59 MOVE MS,1 WORD26 OE310 07610CSR STATUS COMP 'I' 59 OE310 07620CSR 59 MOVE MS,2 WORD26 OE310 07630CSR STATUS COMP 'B' 59 OE310 0007640CSR 59 BKORD ADD 1 SBKORD 20 OE310 07650CSR 59 MOVE MS,3 WORD26 OE310 07660CSR STATUS COMP ' ' 59 OE310 07670CSR 59 MOVE MS,4 WORD26 OE310 07680CSR END004 ENDSR OE310 07690C********************************************************************OE310 07700C*** THIS SECTION EDITS THE SECTION # OR MODE. OE310 0007710C*** IT'S VALID FOR OE310 07720C*** A=ACTIVATE DELETED SALES ORDER 1=HEADER RECORD OE310 07730C*** B=BACKORDER SITUATION 2=SHIP-TO CUST OE310 07740C*** D=DELETE SALES ORDER 3=MARK FOR COMMENTS OE310 07750C*** E=END OF JOB 4=LINE ITEMS OE310 07760C*** F=FREIGHT/SPEC. CHARGES OE310 07770C*** I=INVOICE ALL ITEMS OE310 0007780C*** R=RETRY SALES ORDER # OE310 07790C********************************************************************OE310 07800CSR E005 BEGSR OE310 07810CSR MOVELBUFFER SECTON 1 OE310 07820CSR SECTON COMP 'E' 40 END OF JOB OE310 07830CSR 40 GOTO END005 OE310 07840CSR SECTON COMP 'R' 30 RETRY KEY OE310 0007850CSR 30 GOTO END005 OE310 07860CSR SECTON COMP 'A' 42 ACTIVATE ORDEROE310 07870CSR 42 EXSR ACTDEL OE310 07880CSR 42 STATUS COMP 'B' 59 OE310 07890CSR 42 MOVE ' ' STATUS OE310 07900CSR 42 EXCPT OE310 07910CSR 42 GOTO END005 OE310 0007920CSR SECTON COMP 'D' 42 DELETE ORDER OE310 07930CSR 42 SETON 45 OE310 07940CSR 42 EXSR ACTDEL OE310 07950CSR SETOF 45 OE310 07960CSR 42 MOVE 'D' STATUS OE310 07970CSR 42 EXCPT OE310 07980CSR 42 GOTO END005 OE310 0007990CSR SECTON COMP 'I' 42 INVOICE AS IS OE310 08000CSR 42 MOVE 'I' STATUS OE310 08010CSR 42 EXCPT OE310 08020CSR 42 GOTO END005 OE310 08030CSR SECTON COMP 'B' 43 BACKORDER OE310 08040CSR 43 MOVE 'B' STATUS OE310 08050CSR 43 BKORD ADD 1 SBKORD 20 OE310 0008060CSR 43 EXCPT OE310 08070CSR 43 Z-ADD5 SECTN OE310 08080CSR 43 SETON 7576 BACKORDER LINEOE310 08090CSR 43 GOTO END005 OE310 08100CSR SECTON COMP 'F' 77 FREIGHT OE310 08110CSR 77 Z-ADD6 SECTN OE310 08120CSR 77 GOTO FRT OE310 0008130CSR SECTON COMP '1' 96 OE310 08140CSRN96 SECTON COMP '4' 96 OE310 08150CSR 96 GOTO END005 OE310 08160CSR MOVE SECTON SECTN OE310 08170CSR FRT TAG OE310 08180CSR SECTN COMP 1 70 HEADER OE310 08190CSR SECTN COMP 2 71 SHIP-TO CUST OE310 0008200CSR SECTN COMP 3 72 MARK FOR COMNTOE310 08210CSR SECTN COMP 4 74 LINES UPDATE OE310 08220CSR SECTN COMP 6 77 FREIGHT OE310 08230CSR 74 SETON 76 OE310 08240CSR MOVELSSO WKEY OE310 08250CSR MOVEL'00' WRKEY OE310 08260CSR 77 OE310 0008270COR 70 MOVE 'H' WRKEY OE310 08280CSR 71 MOVE 'I' WRKEY OE310 08290CSR 72 MOVE 'K' WRKEY OE310 08300CSR MOVE WRKEY WKEY OE310 08310CSR WKEY CHAINOPNORDS 59 NOT FOUND OE310 08320CSR MOVELREC RECORD120 OE310 08330CSR 74 EXSR CHAIN GET CUST PC OE310 0008340CSR END005 ENDSR OE310 08350C********************************************************************OE310 08360C*** THIS SECTION EDITS THE CUSTOMER NUMBER. OE310 08370C*** IT CHAINS TO ARMAST TO SEE IF THE NUMBER ALREADY EXISTS. OE310 08380C*** IF IT EXISTS, IT'S VALID AND THE SOLD-TO LINES SHOULD OE310 08390C*** BE DISPLAYED. THIS SAME SECTION WILL BE USED TO EDIT THE OE310 08400C*** SHIP-TO CUSTOMER. OE310 0008410C********************************************************************OE310 08420CSR E106 BEGSR OE310 08430CSR MOVELBUFFER DIG5N 50 OE310 08440CSR 71 DIG5N COMP 99999 9696 OE310 08450CSR 71N96 GOTO END106 OE310 08460CSR Z-ADDDIG5N DIG6N 60 OE310 08470CSR DIG6N CHAINARMAST 96 NOT FOUND OE310 0008480CSR 96 GOTO END106 OE310 08490CSRN96 DCODE COMP ' ' 9696 OE310 08500CSR MOVEL'2605' BUFFER DISPLAY N/A OE310 08510CSR EXSR POSCUR LINE 1 OE310 08520CSR MOVE 'S' TYPE OE310 08530CSR MOVELNAME BUFFER OE310 08540CSR Z-ADD24 BLNGTH OE310 0008550CSR EXSR CRTCOM OE310 08560CSR 70 GOTO SKNAME OE310 08570CSR Z-ADD24 NCHARS OE310 08580CSR Z-ADD1 SSTRT OE310 08590CSR Z-ADD14 TSTRT OE310 08600CSR EXIT SUBRMV OE310 08610CSR RLABL NAME SOURCE OE310 0008620CSR RLABL SSTRT 30 OE310 08630CSR RLABL RECORD TARGET OE310 08640CSR RLABL TSTRT 30 OE310 08650CSR RLABL NCHARS 30 OE310 08660C* OE310 08670C* OE310 08680CSR SKNAME TAG OE310 0008690CSR MOVEL'2606' BUFFER DISPLAY OE310 08700CSR EXSR POSCUR ADDRESS 1 OE310 08710CSR MOVE 'S' TYPE OE310 08720CSR MOVELADR1 BUFFER OE310 08730CSR EXSR CRTCOM OE310 08740CSR 70 GOTO SKADR1 OE310 08750CSR Z-ADD38 TSTRT OE310 0008760CSR EXIT SUBRMV OE310 08770CSR RLABL ADR1 SOURCE OE310 08780CSR RLABL SSTRT 30 OE310 08790CSR RLABL RECORD TARGET OE310 08800CSR RLABL TSTRT 30 OE310 08810CSR RLABL NCHARS 30 OE310 08820C* OE310 0008830CSR SKADR1 TAG OE310 08840CSR MOVEL'2607' BUFFER DISPLAY OE310 08850CSR EXSR POSCUR ADDRESS 2 OE310 08860CSR MOVE 'S' TYPE OE310 08870CSR MOVELADR2 BUFFER OE310 08880CSR EXSR CRTCOM OE310 08890CSR 70 GOTO SKADR2 OE310 0008900CSR Z-ADD62 TSTRT OE310 08910CSR EXIT SUBRMV OE310 08920CSR RLABL ADR2 SOURCE OE310 08930CSR RLABL SSTRT 30 OE310 08940CSR RLABL RECORD TARGET OE310 08950CSR RLABL TSTRT 30 OE310 08960CSR RLABL NCHARS 30 OE310 0008970C* OE310 08980CSR SKADR2 TAG OE310 08990CSR MOVEL'2608' BUFFER DISPLAY OE310 09000CSR EXSR POSCUR CITY OE310 09010CSR MOVE 'S' TYPE OE310 09020CSR MOVELCITY BUFFER OE310 09030CSR Z-ADD13 BLNGTH OE310 0009040CSR EXSR CRTCOM OE310 09050CSR 70 GOTO SKCITY OE310 09060CSR Z-ADD13 NCHARS OE310 09070CSR Z-ADD86 TSTRT OE310 09080CSR EXIT SUBRMV OE310 09090CSR RLABL CITY SOURCE OE310 09100CSR RLABL SSTRT 30 OE310 0009110CSR RLABL RECORD TARGET OE310 09120CSR RLABL TSTRT 30 OE310 09130CSR RLABL NCHARS 30 OE310 09140C* OE310 09150CSR SKCITY TAG OE310 09160CSR MOVEL'4308' BUFFER OE310 09170CSR EXSR POSCUR STATE CODE OE310 0009180CSR MOVE 'S' TYPE OE310 09190CSR MOVELSTCODE BUFFER OE310 09200CSR Z-ADD2 BLNGTH OE310 09210CSR EXSR CRTCOM OE310 09220CSR 70 GOTO SKCODE OE310 09230CSR Z-ADD2 NCHARS OE310 09240CSR Z-ADD99 TSTRT OE310 0009250CSR EXIT SUBRMV OE310 09260CSR RLABL STCODE SOURCE OE310 09270CSR RLABL SSTRT 30 OE310 09280CSR RLABL RECORD TARGET OE310 09290CSR RLABL TSTRT 30 OE310 09300CSR RLABL NCHARS 30 OE310 09310C* OE310 0009320CSR SKCODE TAG OE310 09330CSR MOVEL'4908' BUFFER DISPLAY OE310 09340CSR EXSR POSCUR ZIP OE310 09350CSR MOVE 'S' TYPE OE310 09360CSR MOVELAZIP BUFFER OE310 09370CSR Z-ADD5 BLNGTH OE310 09380CSR EXSR CRTCOM OE310 0009390CSR 70 GOTO SKZIP OE310 09400CSR Z-ADD5 NCHARS OE310 09410CSR Z-ADD101 TSTRT OE310 09420CSR EXIT SUBRMV OE310 09430CSR RLABL AZIP SOURCE OE310 09440CSR RLABL SSTRT 30 OE310 09450CSR RLABL RECORD TARGET OE310 0009460CSR RLABL TSTRT 30 OE310 09470CSR RLABL NCHARS 30 OE310 09480C* OE310 09490CSR SKZIP TAG OE310 09500CSR END106 ENDSR OE310 09510C********************************************************************OE310 09520C*** THIS SECTION EDITS A DATE FIELD. OE310 0009530C********************************************************************OE310 09540CSR E107 BEGSR OE310 09550CSR MOVELBUFFER DIG6N OE310 09560CSR EXSR EDATE OE310 09570CSR ENDSR OE310 09580C********************************************************************OE310 09590C*** THIS SECTION EDITS THE PAYMENT TERMS OVERRIDE. OE310 0009600C********************************************************************OE310 09610CSR E115 BEGSR OE310 09620CSR MOVELBUFFER DIG1 1 OE310 09630CSR DIG1 COMP ' ' 9696 OE310 09640CSRN96 GOTO END115 OE310 09650CSR DIG1 CHAINTERMS 96 OE310 09660CSRN96 MOVELTNAME WORD26 OE310 0009670CSRN96 DLTTRM COMP ' ' 9696 OE310 09680CSR END115 ENDSR OE310 09690C********************************************************************OE310 09700C*** THIS SECTION EDITS THE PRICE CODE OVERRIDE. OE310 09710C*** IT'S A NUMERIC FIELD THAT'S VALID FOR 0-5. OE310 09720C*** 0 IMPLIES THERE IS NO OVERRIDE. OE310 09730C********************************************************************OE310 0009740CSR E116 BEGSR OE310 09750CSR MOVELBUFFER DIG1N 10 OE310 09760CSR DIG1N COMP 0 96 OE310 09770CSRN96 DIG1N COMP 5 96 OE310 09780CSR ENDSR OE310 09790C********************************************************************OE310 09800C*** THIS SECTION EDITS THE TAX CODE OVERRIDE. OE310 0009810C*** IT'S AN ALPHA FIELD THAT'S VALID FOR BLANK, C, O, N. OE310 09820C********************************************************************OE310 09830CSR E117 BEGSR OE310 09840CSR MOVELBUFFER DIG1 OE310 09850CSR DIG1 COMP ' ' 9696 OE310 09860CSR 96 DIG1 COMP 'C' 9696 OE310 09870CSR 96 DIG1 COMP 'O' 9696 OE310 0009880CSR 96 DIG1 COMP 'N' 9696 OE310 09890CSR ENDSR OE310 09900C********************************************************************OE310 09910C*** THIS SECTION EDITS THE SALESMAN# OE310 09920C********************************************************************OE310 09930CSR E118 BEGSR OE310 09940CSR MOVELBUFFER DIG3N 30 OE310 0009950CSR DIG3N COMP 0 9696 OE310 09960CSRN96 GOTO END118 OE310 09970CSR DIG3N CHAINSLSMAN 96 OE310 09980CSRN96 DLTSMN COMP ' ' 9696 OE310 09990CSRN96 MOVELSNAME WORD26 OE310 10000CSR END118 ENDSR OE310 10010C********************************************************************OE310 0010020C*** THIS SECTION EDITS THE AREA OE310 10030C********************************************************************OE310 10040CSR E119 BEGSR OE310 10050CSR MOVELBUFFER DIG2 2 OE310 10060CSR DIG2 COMP ' ' 9696 OE310 10070CSRN96 GOTO END119 OE310 10080CSR DIG2 CHAINAREA 96 OE310 0010090CSRN96 DLTARA COMP ' ' 9696 OE310 10100CSRN96 MOVELANAME WORD26 OE310 10110CSR END119 ENDSR OE310 10120C********************************************************************OE310 10130C*** THIS SECTION EDITS THE 'WHAT LINE ?' FIELD. OE310 10140C*** 'Y' REPRESENTS THE ARRAY ELEMENT (WHAT LINE ?). OE310 10150C*** VALID ENTRIES ARE : OE310 0010160C*** R = RUBOUT - GO BACK A SCREEN OE310 10170C*** @ = GO FORWARD A SCREEN OE310 10180C*** T = GO BACK TO CONTROL SCREEN OE310 10190C*** ZERO = INCREMENT THE Y ELEMENT BY ONE OE310 10200C*** # = MUST BE WITHIN INTERVAL SHOWN ON THE SCREEN. OE310 10210C********************************************************************OE310 10220CSR E411 BEGSR OE310 0010230CSR SETOF 53 OE310 10240CSR MOVELBUFFER DIG2 OE310 10250CSR DIG2 COMP '@ ' 67 OE310 10260CSRN67 GOTO SKIPE OE310 10270CSR UB COMP UPPER 68 68 OE310 10280CSRN68 LB ADD 18 LB OE310 10290CSRN68 UB ADD 18 UB OE310 0010300CSRN68 YSAVE ADD 18 YSAVE OE310 10310CSR GOTO END411 OE310 10320C* OE310 10330CSR SKIPE TAG OE310 10340CSR DIG2 COMP 'R ' 67 OE310 10350CSRN67 GOTO SKIPX OE310 10360CSR UB COMP 18 68 OE310 0010370CSRN68 LB SUB 18 LB OE310 10380CSRN68 UB SUB 18 UB OE310 10390CSRN68 YSAVE SUB 18 YSAVE OE310 10400CSR GOTO END411 OE310 10410C* OE310 10420CSR SKIPX TAG OE310 10430CSR DIG2 COMP 'T ' 66 OE310 0010440CSR 66 GOTO END411 OE310 10450C* OE310 10460CSR DIG2 COMP ' ' 9696 OE310 10470CSRN96 GOTO SKIPG OE310 10480CSR DIG2 COMP '00' 96 OE310 10490CSRN96 DIG2 COMP UPPERA 96 OE310 10500CSR 96 GOTO END411 OE310 0010510CSR SKIPG TAG OE310 10520CSR SETON 53 OE310 10530CSR Z-ADDY S 20 SAVE Y OE310 10540CSR MOVELBUFFER Y OE310 10550CSR Y COMP 0 59 OE310 10560CSR 59N33N52S COMP 1 51 OE310 10570CSR 51 Z-ADD0 S OE310 0010580CSR 51 SETON 52 OE310 10590CSR SETOF 51 OE310 10600CSR 59N33 S ADD 1 Y OE310 10610CSR 59 33 Z-ADDS Y OE310 10620CSR Y COMP LB 96 OE310 10630CSRN96 Y COMP UB 96 OE310 10640CSRN96 Y COMP YLIM 96 96 OE310 0010650CSR 96 GOTO END411 OE310 10660CSR MOVELY SAVE OE310 10670CSR MOVELSSO WKEY OE310 10680CSR MOVELY WRKEY OE310 10690CSR MOVE 'L' WRKEY OE310 10700CSR MOVE WRKEY WKEY OE310 10710CSR WKEY CHAINOPNORDS 59 NOT FOUND OE310 0010720CSR 59 SETON 96 OE310 10730CSR 59 GOTO END411 OE310 10740CSR MOVELREC RECORD OE310 10750CSR Z-ADD1 NCHARS OE310 10760CSR Z-ADD11 SSTRT OE310 10770CSR Z-ADD1 TSTRT OE310 10780CSR EXIT SUBRMV OE310 0010790CSR RLABL RECORD OE310 10800CSR RLABL SSTRT 30 OE310 10810CSR RLABL LC OE310 10820CSR RLABL TSTRT 30 OE310 10830CSR RLABL NCHARS 30 OE310 10840CSR LC COMP 'L' 9696 OE310 10850CSRN96 SETON 89 INCREMENT X OE310 0010860CSR END411 TAG OE310 10870CSRN53 SETOF 52 OE310 10880CSR ENDSR OE310 10890C********************************************************************OE310 10900C*** THIS SECTION EDITS THE PRODUCT # BY CHAINING TO PARTMST. OE310 10910C*** IF IT EXISTS THE DESCRIPTION IS DISPLAYED. OE310 10920C*** IF IT DOESN'T EXIST AN ERROR MESSAGE DISPLAYS AND THE OE310 0010930C*** USER MUST TRY AGAIN. OE310 10940C********************************************************************OE310 10950CSR E412 BEGSR OE310 10960CSR MOVELBUFFER DIG12 12 OE310 10970CSR Z-ADD0 PB OE310 10980CSR DIG12 CHAINPARTMST 96 NOT FOUND OE310 10990CSRN96 DPCODE COMP ' ' 9696 OE310 0011000CSRN96 SETON 60 OE310 11010CSRN96 MOVELDESC WORD26 OE310 11020CSR ENDSR OE310 11030C********************************************************************OE310 11040C*** THIS SECTION EDITS THE PRICE OVERRIDE. OE310 11050C*** LINE-FEED OR CR: DISPLAY PRICE STORED IN 'PRC' ARRAY/DON'T OE310 11060C*** UPDATE RECORD. OE310 0011070C*** OTHER: RE-DISPLAY NEW OVERRIDE/UPDATE RECORD. OE310 11080C********************************************************************OE310 11090CSR E415 BEGSR OE310 11100CSR SETOF 97 OE310 11110CSR MOVELBUFFER PRICE OE310 11120CSR PRICE COMP 0 56 OE310 11130CSR 33 LINE-FEED OR OE310 0011140COR 56 SETON 65 ZERO: DON'T OE310 11150C* UPDATE RECORD OE310 11160CSR EXSR YTOZ CONVERT Y OE310 11170CSRN56 Z-ADDPRICE PRC,Z OE310 11180CSR MOVELPRC,Z SAVE ZERO ENTRY: OE310 11190CSR MOVE SAVE BUFFER USE FILE PRICE OE310 11200CSR END415 ENDSR OE310 0011210C********************************************************************OE310 11220C* THIS SUBROUTINE GETS THE PRICE CODE FOR THIS ORDER. OE310 11230C* IF THE OVERRIDE PC IS ZERO, IT CHAINS TO ARMAST TO GET IT. OE310 11240C********************************************************************OE310 11250CSR CHAIN BEGSR GET PRICE CODE OE310 11260CSR SOVPC COMP 0 59 IF NO OVRIDE OE310 11270CSRN59 Z-ADDSOVPC PC OE310 0011280CSR 59 SCUST CHAINARMAST 59 MUST HIT OE310 11290CSR ENDCHN ENDSR OE310 11300C********************************************************************OE310 11310C* THIS SUBROUTINE STORES PRICES FOR EACH PART IN THE 'PRC' ARRAY. OE310 11320C* PRICES COME FROM RECORD IF OVERRIDE, OTHERWISE FROM PARTMST 'PB' OE310 11330C* ARRAY (USING PRICE CODE FROM CHAIN SUBR). OE310 11340C********************************************************************OE310 0011350CSR PUTPRC BEGSR OE310 11360CSR EXSR MVPRCE GET FROM REC OE310 11370CSR PRICE COMP 0 59 OE310 11380CSRN59 GOTO STORE USE OVRIDE PRC OE310 11390CSR PC COMP 1 59 59 OE310 11400CSR 59 PC COMP 5 5959 OE310 11410CSR 59 Z-ADDPB,PC PRICE USE FILE PRICE OE310 0011420CSR STORE TAG STORE IN 'PRC' OE310 11430CSR EXSR YTOZ OE310 11440CSR Z-ADDPRICE PRC,Z OE310 11450CSR ENDSR OE310 11460C********************************************************************OE310 11470C* THIS SUBROUTINE MOVES OVERRIDE PRICE FIELD FROM RECORD TO PRICE. OE310 11480C********************************************************************OE310 0011490CSR MVPRCE BEGSR OE310 11500CSR Z-ADD7 NCHARS OE310 11510CSR Z-ADD52 SSTRT OE310 11520CSR Z-ADD1 TSTRT OE310 11530CSR EXIT SUBRMV OE310 11540CSR RLABL RECORD OE310 11550CSR RLABL SSTRT 30 OE310 0011560CSR RLABL APRCE OE310 11570CSR RLABL TSTRT 30 OE310 11580CSR RLABL NCHARS 30 OE310 11590CSR MOVE APRCE PRICE 73 OE310 11600CSR ENDSR OE310 11610C* THIS SUBROUTINE CALCULATES NEW SALLOC AND PUTS IN PARTMST OE310 11620C********************************************************************OE310 0011630CSR ACTDEL BEGSR OE310 11640CSR Z-ADD0 ADKEY OE310 11650CSR MOVELSSO ADKEY 70 OE310 11660CSR ADKEY ADD 1 ADKEY OE310 11670CSR LOOPA TAG OE310 11680CSR MOVELADKEY WKEY OE310 11690CSR MOVE 'L' WKEY OE310 0011700CSR WKEY CHAINOPNORDS 96 OE310 11710CSR 96 GOTO ENDACT OE310 11720CSR LM COMP 'L' 96 OE310 11730CSRN96 GOTO BYPACT OE310 11740CSR PART CHAINPARTMST 96 OE310 11750CSR 96 GOTO BYPACT OE310 11760CSR 42N45 SALLOC ADD QO SALLOC OE310 0011770CSR 45 SALLOC SUB QO SALLOC OE310 11780CSR SETON 99 OE310 11790CSR EXCPT OE310 11800CSR SETOF 99 OE310 11810CSR BYPACT TAG OE310 11820CSR ADKEY ADD 1 ADKEY OE310 11830CSR GOTO LOOPA OE310 0011840CSR ENDACT TAG OE310 11850CSR Z-ADD0 ADKEY OE310 11860CSR MOVELSSO ADKEY OE310 11870CSR MOVELADKEY WKEY OE310 11880CSR MOVE 'H' WKEY OE310 11890CSR WKEY CHAINOPNORDS 59 OE310 11900CSR SETOF 96 OE310 0011910CSR ENDSR OE310 11920C********************************************************************OE310 11930C* THIS SUBROUTINE MOVES PRICE FROM 'PRC' TO BUFFER (DONE INSTEAD OE310 11940C* OF 'GET' SUBR FOR PRICES ONLY). OE310 11950C********************************************************************OE310 11960CSR GETPRC BEGSR OE310 11970CSRN87 GOTO EGPRC OE310 0011980CSR EXSR YTOZ OE310 11990CSR Z-ADDPRC,Z PRICE OE310 12000CSR Z-ADDLEN NCHARS OE310 12010CSR Z-ADD1 SSTRT OE310 12020CSR Z-ADDFPOS TSTRT OE310 12030CSR MOVE PRICE APRCE 7 OE310 12040CSR EXIT SUBRMV OE310 0012050CSR RLABL APRCE OE310 12060CSR RLABL SSTRT 30 OE310 12070CSR RLABL BUFFER OE310 12080CSR RLABL TSTRT 30 OE310 12090CSR RLABL NCHARS 30 OE310 12100CSR EGPRC ENDSR OE310 12110C********************************************************************OE310 0012120C* THIS SUBROUTINE CONVERTS Y TO THE CORRECT ARRAY ELEMENT# (1-18) OE310 12130C********************************************************************OE310 12140CSR YTOZ BEGSR OE310 12150CSR Y DIV 18 P 20 P=PAGE OE310 12160CSR MVR Z 40 Z=LINE# ON PGE OE310 12170CSR Z COMP 0 59 OE310 12180CSR 59 Z ADD 18 Z OE310 0012190CSR ENDSR OE310 12200O* OE310 12210O********************************************************************OE310 12220O* THIS SECTION OUTPUTS THE RECORDS AT EXCEPTION TIME. OE310 12230O********************************************************************OE310 12240OOPNORDS E 80 OE310 12250O REC 118 OE310 0012260O E 42 OE310 12270O STATUS 105 OE310 12280O E 43 OE310 12290O SBKORD 2 OE310 12300O STATUS 105 OE310 12310O* OE310 12320O* OE310 0012330OPARTMST E 99 OE310 12340O SALLOC 173 OE310 ** 012350ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 012360ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 012370ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 012380ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 01239000** 012400013102290331043005310630073108310930103111301231 012410** 0124203602**DELETED SALES ORDER 1 0124303602**INVOICED ALL ITEMS 2 0124403602**BACKORDER SITUATION 3 0124503602 4 01246000** 0124700043602**INVALID SALES ORDER # 01 1 0124800053104**INVALID MODE 02 2 0124901064104**INVALID CUST # 03 3 0125001074109**INVALID DATE 04 4 0125101084110**INVALID DATE 05 5 0125201154115**INVALID TERMS 06 6 012530001164116**INVALID PRICE CODE 07 7 0125401174117**INVALID TAX CODE 08 8 0125501184118**INVALID SALESMAN # 09 9 0125601194119**INVALID AREA 10 10 0125702064104**INVALID CUST # 11 11 0125804112321**INVALID 12 12 0125904121703**INVALID PART # 13 13 01260000415 14 14 0126105112321**INVALID 15 15 0126205121703**INVALID PART # 16 16 012630 012640/* 012650__321**INVALID 12 12 0125904121703**INVALID PART # 13 13 0126000(M OTXOE320 P999999050878(000010H S OE320 00020X DECK-ID A67 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE320 00030F* PRINT DELETED, SHIPPED ORDERS OE320 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE320 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE320 00060F* CONTROL DATA PROPRIETARY PRODUCT OE320 00070F* OE320 0000080FOPNORDS UPEAF 118 8AI 106 DISK OE320 00090FARMAST IC F 280R 6AI 1 DISK OE320 00100F$LP1 O F 132 OF PRINTER OE320 00110FHEADING IT F 40 EDISK OE320 00120F* OE320 00130F********************************************************************OE320 00140F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [ORD140] OE320 0000150F* OE320 00160F* PACKAGE DISTRIBUTION OE320 00170F* SYSTEM INVOICING OE320 00180F* PROGRAM PRINT DELETED, SHIPPED ORDERS OE320 00190F* OE320 00200F* CONTRACTOR COMPUSOURCE OE320 00210F* PROGRAMMER KATH HILL OE320 0000220F* DATE FEBRUARY 25, 1976 OE320 00230F* OE320 00240F********************************************************************OE320 00250F* OE320 00260F* ************************************************************** OE320 00270F* ** ** OE320 00280F* ** FUNCTION OF INDICATORS ** OE320 0000290F* ** ** OE320 00300F* ** 01 OPNORDS- HEADER ** OE320 00310F* ** 02 OPNORDS- SHIP-TO N/A ** OE320 00320F* ** 03 OPNORDS- 'MARK FOR' OR INVOICE COMMENTS ** OE320 00330F* ** 05 OPNORDS- LINE-ITEM ** OE320 00340F* ** 06 OPNORDS- LINE-ITEM COMMENT ** OE320 00350F* ** ** OE320 0000360F* ** 09 ARMAST ** OE320 00370F* ** 11 INVOICE DATE IS ZERO - USE UDATE ** OE320 00380F* ** 12 QTYSHP IS ZERO ** OE320 00390F* ** 13 QTYBOR IS ZERO ** OE320 00400F* ** 14 LINE-ITEM COMMENT IS BLANK ** OE320 00410F* ** ** OE320 00420F* ** 21 S.O. STATUS BLANK ** OE320 0000430F* ** 22 S.O. STATUS D ** OE320 00440F* ** 23 S.O. STATUS I ** OE320 00450F* ** 24 S.O. STATUS B ** OE320 00460F* ** ** OE320 00470F* ** ** OE320 00480F* ** 80 S.O. HAS SHIPMENTS ** OE320 00490F* ** ** OE320 0000500F* ** 90 S.O. HAS BACKORDERS ** OE320 00510F* ** ** OE320 00520F* ************************************************************** OE320 00530E HEADING HEAD 1 1 40 COMPANY NAME OE320 00540E* OE320 00550IOPNORDS XX 01 8 CH OE320 00560I 1 20BKORD 60 OE320 0000570I 3 70SONUM L1 OE320 00580I 9 130CUST OE320 00590I 14 190RDATE 11 OE320 00600I 20 31 PO OE320 00610I 105 105 STATUS OE320 00620I XX 02 8 CI OE320 00630I OR 03 8 CK OE320 0000640I 3 70SONUM L1 OE320 00650I XX 05 8 CL 11 CL OE320 00660I 3 70SONUM L1 OE320 00670I 9 100LINE OE320 00680I 12 23 PART OE320 00690I 24 300QTYORD OE320 00700I 31 370SHIPTD OE320 0000710I 38 440QTYSHP 12 OE320 00720I 45 510QTYBOR 13 OE320 00730I 52 583OVPRCE OE320 00740I XX 06 8 CL 11 CM OE320 00750I 3 70SONUM L1 OE320 00760I 9 100LINE OE320 00770I 12 49 LICMNT 14 OE320 0000780IARMAST XX 09 OE320 00790I 7 30 NAME OE320 00800I 115 115 DLTAR OE320 00810C SETOF 40 OE320 00820C L1N01 SETON H1 OE320 00830C H1 GOTO END OE320 00840C 01NL1 SETON H2 OE320 0000850C H2 GOTO END OE320 00860C L1 SETOF 212223 OE320 00870C L1 SETOF 248090 OE320 00880C L1 SETOF 5099 OE320 00890C 90 SETOF 91 OUTPUT HEADERS OE320 00900C 01 EXSR SUB1 OE320 00910C 50 GOTO END OE320 0000920C 05 EXSR SUB5 OE320 00930C END TAG OE320 00940C* OE320 00950C* ************************************************************** OE320 00960C* ** SUBR SUB1 - HEADER ** OE320 00970C* ** CHECK STATUS & DETERMINE ACTION FOR THIS ORDER. ** OE320 00980C* ** IF STATUS = ** OE320 0000990C* ** BLANK- OPEN S.O. - ENTIRE ORDER IS OUTPUT TO NEWOPN ** OE320 01000C* ** WITH NO CHANGE. NO INVENTORY TRANSACTIONS ARE ** OE320 01010C* ** GENERATED. NOT PRINTED ON REPORT. ** OE320 01020C* ** D- DELETE - ENTIRE ORDER IS DELETED. THE S.O. IS ** OE320 01030C* ** NOT OUTPUT TO ANY FILE BUT A 12 TRANSACTION IS ** OE320 01040C* ** OUTPUT TO TRANSAC FOR EACH LINE ITEM WITH TRANS ** OE320 01050C* ** QTY = QTY DELETED = QTYORD . PRINTED ON REPORT. ** OE320 0001060C* ** I- INVOICE ENTIRE ORDER - ALL RECORDS ARE OUTPUT TO ** OE320 01070C* ** INVINP ONLY. QTYORD IS PUT IN QTYSHP & ADDED TO ** OE320 01080C* ** SHIPPED-TO-DATE FOR LINE ITEMS. NO TRANSACTIONS ** OE320 01090C* ** ARE GENERATED. PRINTED ON REPORT. ** OE320 01100C* ** B- BACKORDER SITUATION - SOME LINE ITEMS TO BE ** OE320 01110C* ** INVOICED, SOME TO BE BACKORDERED OR CANCELED. ** OE320 01120C* ** ** OE320 0001130C* ************************************************************** OE320 01140C* OE320 01150CSR SUB1 BEGSR OE320 01160CSR STATUS COMP 'P' 20 OE320 01170CSR 20 SETON 21 OE320 01180CSR STATUS COMP ' ' 21NO CHANGE OE320 01190CSR STATUS COMP 'D' 22DELETE OE320 0001200CSR STATUS COMP 'I' 23SHIP COMPLETE OE320 01210CSR STATUS COMP 'B' 24BO/PARTIAL SHP OE320 01220CSR 20N60 SETON 24 OE320 01230CSR 20N60 SETOF 21 OE320 01240CSRN23N22N24 SETON 50 OE320 01250CSRN21N22N23 OE320 01260CANN24 SETON 99 OE320 0001270CSR 11 Z-ADDUDATE RDATE OE320 01280CSRN99 SOS ADD 1 SOS 50 OE320 01290CSR 21 A ADD 1 A 50 OE320 01300CSR 22 B ADD 1 B 50 OE320 01310CSR 23 C ADD 1 C 50 OE320 01320CSR 24 D ADD 1 D 50 OE320 01330CSR 21 GOTO END1 OE320 0001340CSR Z-ADDCUST CUST6 60 OE320 01350CSR CUST6 CHAINARMAST H3 OE320 01360CSRNH3 DLTAR COMP ' ' H3H3 OE320 01370CSR END1 ENDSR OE320 01380C* OE320 01390C* ************************************************************** OE320 01400C* ** SUBR SUB5 - LINE ITEMS ** OE320 0001410C* ************************************************************** OE320 01420C* OE320 01430CSR SUB5 BEGSR OE320 01440CSR 22 GOTO END5 OE320 01450CSR 99 GOTO END5 OE320 01460CSR 23 GOTO TAG23 OE320 01470CSR 24 GOTO TAG24 OE320 0001480C** OE320 01490C** OE320 01500CSR TAG23 TAG STATUS I OE320 01510C** OE320 01520CSR Z-ADDQTYORD QTYSHP OE320 01530CSR SHIPTD ADD QTYSHP SHIPTD OE320 01540CSR Z-ADD0 QTYBOR OE320 0001550CSR GOTO END5 OE320 01560C** OE320 01570CSR TAG24 TAG STATUS B OE320 01580C** OE320 01590CSRN12 SETON 80 OE320 01600CSR SHIPTD ADD QTYSHP SHIPTD OE320 01610CSRN13N90 SETON 9091 TO BKORDS OE320 0001620CSR END5 ENDSR OE320 01630O$LP1 H 202 1P OE320 01640O OR OF OE320 01650O PAGE Z 10 OE320 01660O 4 'PAGE' OE320 01670O HEAD,1 85 OE320 01680O UDATE Y 132 OE320 0001690O H 2 1P OE320 01700O OR OF OE320 01710O 75 'DELETED ORDERS REPORT' OE320 01720O 132 'DIS320' OE320 01730O H 1 1P OE320 01740O OR OF OE320 01750O 5 'SALES' OE320 0001760O H 2 1P OE320 01770O OR OF OE320 01780O 7 'ORDER #' OE320 01790O 16 'CUST #' OE320 01800O 31 'CUSTOMER NAME' OE320 01810O 59 'CUSTOMER P.O. #' OE320 01820O 68 'ACTION' OE320 0001830O T 1 L1N50 OE320 01840O SONUM 8 OE320 01850O CUST 16 OE320 01860O NAME 42 OE320 01870O PO 56 OE320 01880O 22 69 'DELETED' OE320 01890O 23 78 'SHIPPED COMPLETE' OE320 0001900O 24 90 73 'BACKORDERED' OE320 01910O 24 80N90 78 'PARTIAL SHIPPED/' OE320 01920O 24 80N90 91 'NO BACKORDERS' OE320 01930O 24N80N90 77 'STATUS B BUT NO' OE320 01940O 24N80N90 101 'SHIPMENTS OR BACKORDERS' OE320 01950O 24N80N90 116 '- NULL INVOICE' OE320 01960O T 31 LR OE320 0001970O 14 'END OF REPORT.' OE320 01980O 28 'OLD FILE HAD' OE320 01990O SOS Z 34 OE320 02000O 50 'ORDERS OF WHICH' OE320 02010O A Z 56 OE320 02020O 72 'WERE UNCHANGED,' OE320 02030O B Z 78 OE320 0002040O 92 'WERE DELETED,' OE320 02050O C Z 98 OE320 02060O 121 'WERE SHIPPED COMPLETE,' OE320 02070O T 1 LR OE320 02080O 19 'AND' OE320 02090O D Z 25 OE320 02100O 49 'WERE BACKORDERED AND/OR' OE320 0002110O 66 'PARTIAL SHIPPED.' OE320 02120OOPNORDS D 05 23N50 OE320 02130O OR 05 24N50 OE320 02140O SHIPTD 37 OE320 ** 002150ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002160ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 00217000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002180ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002190/* 002200__0O SHIPTD 37 OE320 ** 002150ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002160ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0021700(:N )OTXOE340 P999999050878(000010H S 1 OE340 00020X DECK-ID A68 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE340 00030F* PRINT INVOICES OE340 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE340 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE340 00060F* CONTROL DATA PROPRIETARY PRODUCT OE340 00070F* OE340 0000080FOPNORDS IPEAF 118 8AI 106 DISK OE340 00090FCONTROL UC F 256R 7AI 1 DISK OE340 00100FARMAST IC F 280R 6AI 1 DISK OE340 00110FPARTMST IC F 300R12AI 1 DISK OE340 00120FTERMS IC F 30R 1AI 1 DISK OE340 00130FCARDS O F 80 7AI 74 DISK A OE340 00140FINVDTL O F 55 DISK OE340 0000150FARIND1 O F 32 7AI 7 DISK A OE340 00160FNOPNORD O F 118 8AI 106 DISK OE340 00170F$LP1 O F 85 OF LPRINTER OE340 00180F* OE340 00190F********************************************************************OE340 00200F* ORIGINAL LABRUSH PROGRAM CODED BY ROBBIE FREEMAN [INV040] OE340 00210F* OE340 0000220F* PACKAGE DISTRIBUTION OE340 00230F* SYSTEM INVOICING OE340 00240F* PROGRAM PRINT INVOICES OE340 00250F* OE340 00260F* CONTRACTOR COMPUSOURCE OE340 00270F* PROGRAMMER KATH HILL OE340 00280F* DATE FEBRUARY 25, 1976 OE340 0000290F* OE340 00300F********************************************************************OE340 00310F* OE340 00320F* ************************************************************** OE340 00330F* ** FUNCTION OF INDICATORS ** OE340 00340F* ** ** OE340 00350F* ** 01 INVINP- HEADER ** OE340 0000360F* ** 02 INVINP- SHIP-TO N/A ** OE340 00370F* ** 03 INVINP- 'MARK FOR' OR INVOICE COMMENTS ** OE340 00380F* ** 05 INVINP- LINE-ITEMS ** OE340 00390F* ** 06 INVINP- LINE-ITEM COMMENTS ** OE340 00400F* ** 08 CONTROL ** OE340 00410F* ** 09 ARMAST ** OE340 00420F* ** 10 PARTMST ** OE340 0000430F* ** 11 TERMS ** OE340 00440F* 21 NO OVERRIDE TERMS CODE ** OE340 00450F* ** 22 NO OVERRIDE PRICE CODE ** OE340 00460F* ** 23 NO OVERRIDE SALESMAN# ** OE340 00470F* ** 24 NO OVERRIDE AREA ** OE340 00480F* ** 25 NO OVERRIDE TAX CODE ** OE340 00490F* ** 26 OVERRIDE TAX CODE = N -- OUTPUT BLANK ** OE340 0000500F* ** 27 NO OVERRIDE PRICE FOR THIS LINE ITEM ** OE340 00510F* ** 28 LINE-ITEM COMMENT LINE IS BLANK ** OE340 00520F* ** 29 SHIP-TO ZIP CODE = ZERO - DON'T PRINT ** OE340 00530F* ** 30 AN INVOICE OR 'MARK FOR' COMMENT LINE IS BLANK ** OE340 00540F* ** 34 COMPRESSED COMMENT #4 IS BLANK ** OE340 00550F* ** 35 SUBR SUB3 LOOP IS DONE ** OE340 00560F* ** 40 SHIP-TO CUST# IS 99999 = MANUAL - DON'T CHAIN ** OE340 0000570F* ** 50 MULTIPLE PAGES- GO TO NEXT PAGE ** OE340 00580F* ** 60 INVALID PART # ** OE340 00590F* ** 65 PRICE CODE IS VALID (=1 TO 5) ** OE340 00600F* ** 80 NO HIT ON TERMS FILE ** OE340 00610F* ** 81 INVOICE TYPE BLANK - NORMAL INVOICE ** OE340 00620F* ** 82 INVOICE TYPE 'C' - CREDIT MEMO ** OE340 00630F* ** 83 INVOICE TYPE 'D' - DIRECT BILL ** OE340 0000640F* ** 84 INVOICE TYPE 'M' - MANUAL INVOICE - NO PRINT ** OE340 00650F* ** 85 PREVIOUS ORDER WAS A CREDIT MEMO ** OE340 00660F* ** N85 PREVIOUS ORDER WAS AN INVOICE ** OE340 00670F* ** 86&87 CHANGE OF BATCH FROM 'CM' TO 'IN' OR VICEVERSA ** OE340 00680F* ** 90 TAXABLE CUSTOMER - COMPUTE & PRINT TAX @ 6% ** OE340 00690F* ** 91 MISCELLANEOUS CHARGES ON THIS INVOICE ** OE340 00700F* ** 92 FREIGHT CHARGES ON THIS INVOICE ** OE340 0000710F* ** 98&99 1ST CYCLE ONLY ** OE340 00720F* ** ** OE340 00730F* ** H1 NO HEADER FOR THIS S.O. ** OE340 00740F* ** H2 DUPLICATE HEADERS FOR THIS S.O. ** OE340 00750F* ** H4 INVALID SOLD-TO CUST# ** OE340 00760F* ** NOTE- IF ANY 'H' HALTS OCCUR, THE ORDER ** OE340 00770F* ** ENTRY PROGRAM, DIS110, HAS BUGS & MUST ** OE340 0000780F* ** BE CORRECTED. ** OE340 00790F* ************************************************************** OE340 00800F* OE340 00810E COM 4 23 K COMMENTS INPUT OE340 00820E COUT 4 23 COMPRESSED K COM OE340 00830E PB 5 7 3 PARTMST PRICES OE340 00840L$LP1 66FL 60OL OE340 0000850IOPNORDS XX 01 8 CH OE340 00860I 1 118 ALL OE340 00870I 1 20BKORDS 56 OE340 00880I 3 70SONUM L1 OE340 00890I 9 130CUST OE340 00900I 14 190IDATE OE340 00910I 20 31 PONUM OE340 0000920I 32 41 CARIER OE340 00930I 42 42 OVTERM 21 OE340 00940I 43 430OVPC 22 OE340 00950I 44 460OVSMAN 23 OE340 00960I 47 48 OVAREA 24 OE340 00970I 49 49 OVTAX 25 OE340 00980I 50 550PDATE OE340 0000990I 56 622FRGHT OE340 01000I 63 692SPCHG OE340 01010I 70 89 SCNOTE OE340 01020I 105 105 ITYPE OE340 01030I XX 02 8 CI OE340 01040I 1 118 ALL OE340 01050I 3 70SONUM L1 OE340 0001060I 9 130SHIPTO OE340 01070I 14 37 SHIP1 OE340 01080I 38 61 SHIP2 OE340 01090I 62 85 SHIP3 OE340 01100I 86 98 SHIPCY OE340 01110I 99 100 SHIPST OE340 01120I 101 1050SHIPZP 29 OE340 0001130I XX 03 8 CK OE340 01140I 1 118 ALL OE340 01150I 3 70SONUM L1 OE340 01160I 9 100 COM OE340 01170I XX 05 8 CL 11 CL OE340 01180I 1 118 ALL OE340 01190I 3 70SONUM L1 OE340 0001200I 12 23 PART OE340 01210I 24 300QTYORD OE340 01220I 31 370SHIPTD OE340 01230I 38 440QTYSHP OE340 01240I 45 510QTYBOR OE340 01250I 52 583OVPRCE 27 OE340 01260I XX 06 8 CL 11 CM OE340 0001270I 1 118 ALL OE340 01280I 3 70SONUM L1 OE340 01290I 12 49 LICMNT 28 OE340 01300ICONTROL XX 08 OE340 01310I 8 120LASTNO OE340 01320I 254 2560CNTRLB OE340 01330IARMAST XX 09 OE340 0001340I 7 30 NAME OE340 01350I 31 54 LINE1 OE340 01360I 55 78 LINE2 OE340 01370I 79 91 CITY OE340 01380I 92 93 STATE OE340 01390I 94 980ZIP OE340 01400I 115 115 DLTAR OE340 0001410I 154 1560SLSMN OE340 01420I 157 158 AREA OE340 01430I 159 159 TXCODE OE340 01440I 160 160 TERM OE340 01450I 161 1610PC OE340 01460I 162 163 TYPE OE340 01470IPARTMST XX 10 OE340 0001480I 13 37 PDESC OE340 01490I 74 74 DLTPR OE340 01500I 75 813MAT$ OE340 01510I 89 953LAB$ OE340 01520I 96 1023BRD$ OE340 01530I 226 260 PB OE340 01540ITERMS XX 11 OE340 0001550I 2 26 TNAME OE340 01560I 30 30 DLTTRM OE340 01570C* OE340 01580C* INITIALIZE- GET LAST INVOICE# ASSIGNED. OE340 01590C* OE340 01600C Z-ADD0 ZROS 70 OE340 01610C 99 SETOF 98 OE340 0001620C 99 GOTO START OE340 01630C 'CONTROL' CHAINCONTROL H1 OE340 01640C H1 GOTO END OE340 01650C Z-ADDCNTRLB BATCH 30 OE340 01660C BATCH COMP 98 40 OE340 01670C 40 Z-ADD1 BATCH OE340 01680C Z-ADDLASTNO INVNO 50 OE340 0001690C MOVE ' ' BLANKS 23 OE340 01700C SETON 9998 OE340 01710C* OE340 01720C START TAG OE340 01730C SETOF 73 OE340 01740C* OE340 01750C L1N01 SETON H2 NO HEADER OE340 0001760C H2 GOTO END OE340 01770C 01NL1 SETON H3 DUP HEADERS OE340 01780C H3 GOTO END OE340 01790C L1 SETOF 50 OE340 01800C L1 Z-ADD0 COUNT 40 OE340 01810C L1 Z-ADD0 NET 92 OE340 01820C 01 EXSR SUB1 OE340 0001830C 03N84 EXSR SUB3 OE340 01840C 05 EXSR SUB5 OE340 01850C 06N84N28 EXSR SUB6 OE340 01860C END TAG OE340 01870CL1 SEQ ADD 1 SEQ OE340 01880CL1 STXCOD COMP 'C' 90 OE340 01890CL1N90 Z-ADD0 TAX 72 OE340 0001900CL1 90 NET MULT .06 TAX H OE340 01910CL1 NET ADD TAX GROSS 92 OE340 01920CL1 GROSS ADD FRGHT GROSS OE340 01930CL1 GROSS ADD SPCHG GROSS OE340 01940CL1 SCNOTE COMP BLANKS 9191 OE340 01950CL1N91 SPCHG COMP 0 9191 OE340 01960CL1 FRGHT COMP 0 9292 OE340 0001970CL1 82 Z-SUBNET NETOUT 92 MAKE CREDIT OE340 01980CL1N82 Z-ADDNET NETOUT MEMO SIGNS OE340 01990CL1 82 Z-SUBTAX TAXOUT 72 POSITIVE FOR OE340 02000CL1N82 Z-ADDTAX TAXOUT OUTPUT TO A/R OE340 02010CL1 82 Z-SUBFRGHT FRTOUT 72 FILE, CARDS. OE340 02020CL1N82 Z-ADDFRGHT FRTOUT OE340 02030CL1 82 Z-SUBSPCHG SPCOUT 72 OE340 0002040CL1N82 Z-ADDSPCHG SPCOUT OE340 02050CL1 82 Z-SUBGROSS GRSOUT 92 OE340 02060CL1N82 Z-ADDGROSS GRSOUT OE340 02070CL1 BOUT ADD GRSOUT BOUT 102 OE340 02080CL1 86 87 EXCPT OE340 02090CLR MOVE ' ' BLANKS OE340 02100C* OE340 0002110C* ************************************************************** OE340 02120C* ** SUBR SUB1 - HEADER ** OE340 02130C* ************************************************************** OE340 02140C* OE340 02150CSR SUB1 BEGSR OE340 02160CSR 86 SETOF 87 OE340 02170CSR SETOF 81 OE340 0002180CSR SETOF 49 OE340 02190CSR ITYPE COMP 'D' 69 OE340 02200CSR ITYPE COMP 'I' 70 OE340 02210CSR ITYPE COMP 'B' 71 OE340 02220CSR 70 OE340 02230COR 71 SETON 81 OE340 02240CSR ITYPE COMP 'C' 82CREDIT MEMO OE340 0002250CSR ITYPE COMP 'E' 83DIRECT BILL OE340 02260CSR ITYPE COMP 'M' 84MANUAL INVOICE OE340 02270CSR ITYPE COMP 'P' 55 OE340 02280CSR 55N56 SETON 81 OE340 02290CSR 55 56 SETON 49 OE340 02300CSR 98 99 1ST CYCLE ONLY OE340 02310CORN82 85 NEW 'IN' BATCH OE340 0002320COR 82N85 SETON 8687 NEW 'CM' BATCH OE340 02330CSRN82 SETOF 85 INVOICE OE340 02340CSR 82 SETON 85 CREDIT MEMO OE340 02350CSR 86 87 BATCH ADD 1 BATCH 30 NEW BATCH OE340 02360CSR 86 87 Z-ADD1 SEQ 40 OE340 02370CSRN84 INVNO ADD 1 INVNO OE340 02380CSR Z-ADDCUST CUST6 60 OE340 0002390CSR CUST6 CHAINARMAST H4 OE340 02400CSRNH4 DLTAR COMP ' ' H4H4 OE340 02410CSR H4 GOTO END1 OE340 02420CSR EXSR SAVEHD SAVE SOLD TO OE340 02430CSR STERM CHAINTERMS 80 CUST FIELDS OE340 02440CSRN80 DLTTRM COMP ' ' 8080 OE340 02450CSR 84 Z-ADDSONUM SINVNO 70 OE340 0002460CSRN84 Z-ADDINVNO SINVNO 70 OE340 02470CSR END1 ENDSR OE340 02480C* OE340 02490C* ************************************************************** OE340 02500C* ** SUBR SUB3 - COMPRESS K COMMENTS ** OE340 02510C* ** COMPRESS COMMENT LINES SO NO BLANK LINES ARE BETWEEN ** OE340 02520C* ** NON-BLANK LINES. THEN CHECK LINE#4- IF BLANK ALLOW ONE ** OE340 0002530C* ** SPACE BEFORE PRINTING OTHER 3 LINES. ** OE340 02540C* ************************************************************** OE340 02550C* OE340 02560CSR SUB3 BEGSR OE340 02570CSR MOVE BLANKS COUT OE340 02580CSR Z-ADD0 X 10 OE340 02590CSR Z-ADD0 Y 10 OE340 0002600CSR LOOP TAG OE340 02610CSR X COMP 4 35 OE340 02620CSR 35 GOTO DONE OE340 02630CSR X ADD 1 X OE340 02640CSR COM,X COMP BLANKS 30 OE340 02650CSR 30 GOTO LOOP OE340 02660CSRN30 Y ADD 1 Y OE340 0002670CSR MOVE COM,X COUT,Y OE340 02680CSR GOTO LOOP OE340 02690CSR DONE TAG OE340 02700CSR COUT,4 COMP BLANKS 34 OE340 02710CSR ENDSR OE340 02720C* OE340 02730C* ************************************************************** OE340 0002740C* ** SUBR SUB5 - LINE ITEMS ** OE340 02750C* ** GET DESC, PRICE, AND COSTS FOR PART. ** OE340 02760C* ** DO LINE# INCREMENTS & CHECK FOR PRINTING A MULTIPLE ** OE340 02770C* ** PAGE INVOICE. ** OE340 02780C* ************************************************************** OE340 02790C* OE340 02800CSR SUB5 BEGSR OE340 0002810CSR 82 Z-SUBQTYORD QTYSHP OE340 02820CSR 83 Z-ADDQTYORD QTYSHP OE340 02830CSR 70 Z-ADDQTYORD QTYSHP OE340 02840CSR Z-ADD0 PRICE 73 DEFAULT PRCE=0 OE340 02850CSR Z-ADD0 COST 73 TOT UNIT COST OE340 02860CSR Z-ADD0 PAMT 72 OE340 02870CSR PART CHAINPARTMST 60 OE340 0002880CSRN60 DLTPR COMP ' ' 6060 OE340 02890CSRN27 Z-ADDOVPRCE PRICE OVERRIDE PRICE OE340 02900CSRN27 GOTO SKIP5 OE340 02910CSR SPC COMP 1 65 65 PC = 1 TO 5? OE340 02920CSR 65 SPC COMP 5 6565 OE340 02930CSR 65 Z-ADDPB,SPC PRICE OE340 02940CSR 60 Z-ADD0 PRICE OE340 0002950CSR SKIP5 TAG OE340 02960CSR QTYSHP MULT PRICE PAMT H OE340 02970CSR 60 Z-ADD0 PAMT OE340 02980CSR NET ADD PAMT NET OE340 02990CSR MAT$ ADD LAB$ COST OE340 03000CSR COST ADD BRD$ COST OE340 03010CSR 60 Z-ADD0 COST OE340 0003020CSR COUNT COMP 22 50 50 OE340 03030CSR 50 Z-ADD0 COUNT OE340 03040CSR COUNT ADD 2 COUNT OE340 03050CSR QTYSHP COMP 0 68 OE340 03060CSR QTYORD COMP SHIPTD 73 OE340 03070CSR END5 ENDSR OE340 03080C* OE340 0003090C* ************************************************************** OE340 03100C* ** SUBR SUB6 - LINE ITEM COMMENTS ** OE340 03110C* ** INCREMENT LINE COUNT & CHECK FOR SKIP TO NEW PAGE ** OE340 03120C* ************************************************************** OE340 03130C* OE340 03140CSR SUB6 BEGSR OE340 03150CSR COUNT COMP 23 50 50 OE340 0003160CSR 50 Z-ADD0 COUNT OE340 03170CSR COUNT ADD 1 COUNT OE340 03180CSR END6 ENDSR OE340 03190C* OE340 03200C* ************************************************************** OE340 03210C* ** SUBR SAVEHD SAVES SOLD-TO CUSTOMER FIELDS FROM BEING ** OE340 03220C* ** LOST IF A 2ND CHAIN TO ARMAST IS NEEDED FOR THE SHIP-TO ** OE340 0003230C* ** CUSTOMER. ** OE340 03240C* ************************************************************** OE340 03250C* OE340 03260CSR SAVEHD BEGSR OE340 03270CSR MOVE NAME SNAME 24 OE340 03280CSR MOVE LINE1 SLINE1 24 OE340 03290CSR MOVE LINE2 SLINE2 24 OE340 0003300CSR MOVE CITY SCITY 13 OE340 03310CSR MOVE STATE SSTATE 2 OE340 03320CSR MOVE ZIP SZIP 50 OE340 03330CSR 21 MOVE TERM STERM 1 OE340 03340CSRN21 MOVE OVTERM STERM OE340 03350CSR 22 MOVE PC SPC 10 OE340 03360CSRN22 MOVE OVPC SPC OE340 0003370CSR 23 MOVE SLSMN SSLSMN 30 OE340 03380CSRN23 MOVE OVSMAN SSLSMN OE340 03390CSR 24 MOVE AREA SAREA 2 OE340 03400CSRN24 MOVE OVAREA SAREA OE340 03410CSR 25 MOVE TXCODE STXCOD 1 OE340 03420CSRN25 MOVE OVTAX STXCOD OE340 03430CSR STXCOD COMP 'N' 26 OE340 0003440CSR 26 MOVE ' ' STXCOD OE340 03450CSR MOVE TYPE STYPE 2 OE340 03460CSR ENDSR OE340 03470C** OE340 03480C** OE340 03490OCARDS EADD L1 86 87 OE340 03500O 2 'BH' OE340 0003510O BATCH 5 OE340 03520O N82 7 'IN' OE340 03530O 82 7 'CM' OE340 03540O BOUT B 17 OE340 03550O BATCH 76 OE340 03560O 80 '0000' OE340 03570O TADD L1 OE340 0003580O N82 2 'IN' OE340 03590O 82 2 'CM' OE340 03600O CUST6 8 OE340 03610O N84 INVNO 15 OE340 03620O 84 SONUM 15 OE340 03630O IDATE 21 OE340 03640O GRSOUT 30 OE340 0003650O FRTOUT 37 OE340 03660O STXCOD 38 OE340 03670O TAXOUT 45 OE340 03680O NETOUT 54 OE340 03690O SPCOUT 61 OE340 03700O BATCH 76 OE340 03710O SEQ 80 OE340 0003720OINVDTL D 05 OE340 03730O N84 INVNO 5 OE340 03740O 84 SONUM 5 OE340 03750O CUST 10 OE340 03760O IDATE 16 OE340 03770O SSLSMN 19 OE340 03780O QTYSHP 26 OE340 0003790O PART 38 OE340 03800O PAMT 45 OE340 03810O COST 52 OE340 03820O SAREA 54 OE340 03830O ITYPE 55 OE340 03840OCONTROL T LR 99 OE340 03850O INVNO 12 OE340 0003860O BATCH 256 OE340 03870O$LP1 H 18 1P OE340 03880O 15 'XXXXXXX XXXXXXX' OE340 03890O 36 'XXXXXXX XXXXXXXXXXXX' OE340 03900O 58 'XXXXXXXXXXXXXXXXXXXX' OE340 03910O 80 'XXXXX XXXX.XXX XXXXX.XX' OE340 03920O D 201 50N84N69 OE340 0003930O AND N49 OE340 03940O 58 '* CONTINUED - PAGE' OE340 03950O PAGE Z 64 OE340 03960O 66 '*' OE340 03970O D 103 01N84N69 OE340 03980O AND N49 OE340 03990O OR 50N84N69 OE340 0004000O AND N49 OE340 04010O SNAME 32 OE340 04020O D 1 01N84N69 OE340 04030O AND N49 OE340 04040O OR 50N84N69 OE340 04050O AND N49 OE340 04060O SLINE1 32 OE340 0004070O D 1 01N84N69 OE340 04080O AND N49 OE340 04090O OR 50N84N69 OE340 04100O AND N49 OE340 04110O SLINE2 32 OE340 04120O D 1 01N84N69 OE340 04130O AND N49 OE340 0004140O OR 50N84N69 OE340 04150O AND N49 OE340 04160O SCITY 21 OE340 04170O SSTATE 25 OE340 04180O SZIP 32 OE340 04190O D 1 01N84N69 OE340 04200O AND N49 OE340 0004210O OR 50N84N69 OE340 04220O AND N49 OE340 04230O INVNO 45 OE340 04240O IDATE Y 56 OE340 04250O 81 62 'SO#' OE340 04260O 82 62 'CM#' OE340 04270O 83 62 'DB#' OE340 0004280O SONUM 69 OE340 04290O D 1 02N84N69 OE340 04300O AND N49 OE340 04310O OR 50N84N69 OE340 04320O AND N49 OE340 04330O SHIP1 32 OE340 04340O D 1 02N84N69 OE340 0004350O AND N49 OE340 04360O OR 50N84N69 OE340 04370O AND N49 OE340 04380O SHIP2 32 OE340 04390O D 1 02N84N69 OE340 04400O AND N49 OE340 04410O OR 50N84N69 OE340 0004420O AND N49 OE340 04430O SHIP3 32 OE340 04440O D 2 02N84N69 OE340 04450O AND N49 OE340 04460O OR 50N84N69 OE340 04470O AND N49 OE340 04480O SHIPCY 21 OE340 0004490O SHIPST 25 OE340 04500O N29 SHIPZP 32 OE340 04510O D 1 03N84N69 OE340 04520O AND N49 OE340 04530O OR 50N84N69 OE340 04540O AND N49 OE340 04550O COUT,1 31 OE340 0004560O D 1 03N84N69 OE340 04570O AND N49 OE340 04580O OR 50N84N69 OE340 04590O AND N49 OE340 04600O COUT,2 31 OE340 04610O D 1 03N84N69 OE340 04620O AND N49 OE340 0004630O OR 50N84N69 OE340 04640O AND N49 OE340 04650O COUT,3 31 OE340 04660O D 1 03N84N69 OE340 04670O AND N49 OE340 04680O OR 50N84N69 OE340 04690O AND N49 OE340 0004700O COUT,4 31 OE340 04710O D 10 03N84N69 OE340 04720O AND N49 OE340 04730O OR 50N84N69 OE340 04740O AND N49 OE340 04750O CUST 5 OE340 04760O SPC 8 OE340 0004770O SSLSMN 13 OE340 04780O STYPE 17 OE340 04790O SAREA 21 OE340 04800O CARIER 34 OE340 04810O PONUM 49 OE340 04820O N80 TNAME 77 OE340 04830O D 20 05N84N68 OE340 0004840O AND N49 OE340 04850O QTYORDL 8 OE340 04860O QTYSHPL 15 OE340 04870O QTYBORL 23 OE340 04880O PART 36 OE340 04890O N60 PDESC 62 OE340 04900O 60 59 '** INVALID PART # **' OE340 0004910O PRICE L 72 OE340 04920O PAMT L 81 OE340 04930O D 20 06N84N28 OE340 04940O AND 50N49 OE340 04950O LICMNT 62 OE340 04960O D 10 06N84N28 OE340 04970O AND N50N49 OE340 0004980O LICMNT 62 OE340 04990O T 145 L1N84 90 OE340 05000O AND N49 OE340 05010O 71 'TAX -' OE340 05020O TAX L 81 OE340 05030O T 146 L1N84 91 OE340 05040O AND N49 OE340 0005050O 48 'SPECIAL CHARGES FOR' OE340 05060O SCNOTE 69 OE340 05070O 71 '-' OE340 05080O SPCHG L 81 OE340 05090O T 147 L1N84 92 OE340 05100O AND N49 OE340 05110O 71 'FREIGHT -' OE340 0005120O FRGHT L 81 OE340 05130O T 149 L1N84N49 OE340 05140O AND N69 OE340 05150O NET L 11 OE340 05160O NET L 33 OE340 05170O 36 '6%' OE340 05180O TAX L 47 OE340 0005190O SPCHG L 56 OE340 05200O FRGHT L 65 OE340 05210O GROSS L 81 OE340 05220OARIND1 TADD L1 OE340 05230O CUST6 6 OE340 05240O SINVNO 13 OE340 05250O GROSS 22 OE340 0005260O GROSS 31 OE340 05270ONOPNORD D 01N70N82 OE340 05280O AND N83N84N73 OE340 05290O AND N69 OE340 05300O ALL 118 OE340 05310O D 02N70N82 OE340 05320O AND N83N84N73 OE340 0005330O AND N69 OE340 05340O ALL 118 OE340 05350O D 03N70N82 OE340 05360O AND N83N84N73 OE340 05370O AND N69 OE340 05380O ALL 118 OE340 05390O D 05N70N82 OE340 0005400O AND N83N84N73 OE340 05410O AND N69 OE340 05420O ALL 118 OE340 05430O 71 ZROS 44 OE340 05440O D 06N70N82 OE340 05450O AND N83N84N73 OE340 05460O AND N69 OE340 0005470O ALL 118 OE340 ** 005480ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005490ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005500ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005510ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005520/* 00553000__0O ALL 118 OE340 ** 005480ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005490ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005500ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005510ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005520/* 0055300(TO OTXOE510 P999999050878(000010H S OE510 00020X DECK-ID A71 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE510 00030F* MONTH-END UPDATE OF SALES ANALYSIS FIELDS IN CONTROL AND ARMAST OE510 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE510 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE510 00060F* CONTROL DATA PROPRIETARY PRODUCT OE510 00070F* OE510 0000080FSMTHIN IPEAF 54 DISK OE510 00090FARMAST USEAF 280 6AI 1 DISK OE510 00100FCONTROL UC F 256R 7AI 1 DISK OE510 00110FHEADING IT F 40 EDISK OE510 00120F$LP1 O F 132 OF PRINTER OE510 00130F********************************************************************OE510 00140F* OE510 0000150F* PACKAGE DISTRIBUTION OE510 00160F* SYSTEM SALES ANALYSIS OE510 00170F* PROGRAM MONTH/END UPDATING OF SALES ANALYSIS FIELDS IN OE510 00180F* CONTROL AND ARMAST OE510 00190F* OE510 00200F* CONTRACTOR COMPUSOURCE OE510 00210F* PROGRAMMER KATHY HILL OE510 0000220F* DATE JUNE 17, 1976 OE510 00230F* OE510 00240F********************************************************************OE510 00250F* OE510 00260F* NARRATIVE: OE510 00270F* OE510 00280F* THIS PROGRAM SHOULD ONLY BE RUN ONCE AT MONTH/END TO ACCOMPLISH OE510 0000290F* THE MONTH/END UPDATING OF ARMAST AND CONTROL. OE510 00300F* -----------------------------------------------------------------OE510 00310F* THE DETERMINATION OF THE NEW REFERENCE MONTH (ARMAST) FIELD FOR OE510 00320F* THE CONTROL FILE AND OF THE NEW REFERENCE YEAR (ARMAST) FIELD OE510 00330F* FOR THE CONTROL FILE BY USE OF THE OLD REFERENCE MONTH (ARMAST) OE510 00340F* FIELD FROM THE CONTROL FILE, THE OLD REFERENCE YEAR (ARMAST) OE510 00350F* FIELD FROM THE CONTROL FILE, THE IPL MONTH, AND THE IPL YEAR OE510 0000360F* IS DONE ONCE ONLY [AT THE START OF THE PROGRAM]. OE510 00370F* OE510 00380F* CHAINS TO THE CONTROL FILE. IF CHAIN TO CONTROL GETS A MISS, OE510 00390F* THEN H3 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. AFTER OE510 00400F* CONTROL IS ON SYSTEM, OPERATOR CAN RETRY THE PROGRAM. OE510 00410F* OE510 00420F* CHECKS THAT [ 1 <= IPL-MONTH <= 12 ] AND [ 70 <= IPL-YEAR ]. OE510 0000430F* IF EITHER IS OUT OF BOUNDS, THEN H1 IS SET ON AND THE PROGRAM OE510 00440F* SHOULD BE CANCELLED. THE OPERATOR SHOULD IPL CORRECTLY BEFORE OE510 00450F* RETRYING THE PROGRAM. OE510 00460F* OE510 00470F* IF (1) THE REFERENCE MONTH (ARMAST) FIELD IN CONTROL AND/OR OE510 00480F* THE REFERENCE YEAR (ARMAST) FIELD IN CONTROL = 0 OE510 00490F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE510 0000500F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (ARMAST) OE510 00510F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE510 00520F* YEAR (ARMAST) IN CONTROL. OE510 00530F* OE510 00540F* IF (1) THE REFERENCE MONTH (ARMAST) FIELD IN CONTROL AND OE510 00550F* THE REFERENCE YEAR (ARMAST) FIELD IN CONTROL ARE OE510 00560F* NON-ZERO OE510 0000570F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE510 00580F* AND (3) THE IPL MONTH/YEAR COMBINATION CHRONOLOGICALLY OE510 00590F* FOLLOWS THE (ARMAST) REFERENCE MONTH/YEAR COMBINATION OE510 00600F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (ARMAST) OE510 00610F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE510 00620F* YEAR (ARMAST) IN CONTROL. OE510 00630F* OE510 0000640F* IF (1) THE REFERENCE MONTH (ARMAST) FIELD IN CONTROL AND OE510 00650F* THE REFERENCE YEAR (ARMAST) FIELD IN CONTROL ARE OE510 00660F* NON-ZERO OE510 00670F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE510 00680F* BUT (3) THE IPL MONTH/YEAR COMBINATION DOES NOT OE510 00690F* --- OE510 00700F* CHRONOLOGICALLY FOLLOW THE (ARMAST) REFERENCE OE510 0000710F* MONTH/YEAR COMBINATION OE510 00720F* THEN H2 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. OE510 00730F* OPERATOR CAN CHECK CONTROL, IPL CORRECTLY, AND RETRY THE OE510 00740F* PROGRAM. OE510 00750F* -----------------------------------------------------------------OE510 00760F* ALL SALES AGAINST GIVEN CUSTOMER # ARE SUMMED INTO ONE FIGURE. OE510 00770F* -----------------------------------------------------------------OE510 0000780F* IF IT'S JANUARY, THEN THE YTD $ SALES (LAST YEAR) FIELD IS OE510 00790F* ZEROED-OUT. OE510 00800F* -----------------------------------------------------------------OE510 00810F* ARRAY: ELEMENT 11 --> POSITION 12 OE510 00820F* ELEMENT 10 --> POSITION 11 OE510 00830F* ELEMENT 9 --> POSITION 10 OE510 00840F* ELEMENT 8 --> POSITION 9 OE510 0000850F* ELEMENT 7 --> POSITION 8 OE510 00860F* ELEMENT 6 --> POSITION 7 OE510 00870F* ELEMENT 5 --> POSITION 6 OE510 00880F* ELEMENT 4 --> POSITION 5 OE510 00890F* ELEMENT 3 --> POSITION 4 OE510 00900F* ELEMENT 2 --> POSITION 3 OE510 00910F* ELEMENT 1 --> POSITION 2 OE510 0000920F* -----------------------------------------------------------------OE510 00930F* OLD MTD $ SALES (THIS YEAR) INTO POSITION 1 OF SALES ARRAY OE510 00940F* -----------------------------------------------------------------OE510 00950F* IF ANY SALES TO THIS CUSTOMER, TOTAL FIGURE INTO OE510 00960F* MTD $ SALES (THIS YEAR) FIELD. IF THERE WERE NO SALES TO OE510 00970F* THIS CUSTOMER THIS MONTH, THEN THE MTD $ SALES (THIS YEAR) OE510 00980F* FIELD IS ZEROED-OUT. OE510 0000990F* -----------------------------------------------------------------OE510 01000F* YTD $ SALES (LAST YEAR) = YTD $ SALES (LAST YEAR) + OE510 01010F* 12TH ELEMENT OF SALES ARRAY OE510 01020F* -----------------------------------------------------------------OE510 01030F* IPL MONTH --> NEW (ARMAST) REFERENCE MONTH FOR CONTROL OE510 01040F* IPL YEAR --> NEW (ARMAST) REFERENCE YEAR FOR CONTROL OE510 01050F* OE510 0001060F********************************************************************OE510 01070F* ID F C H L FUNCTION OF INDICATORS OE510 01080F* OE510 01090F* 01 SMTHIN OE510 01100F* 02 ARMAST OE510 01110F* 03 CONTROL OE510 01120F* 10 OLD REFERENCE YEAR (ARMAST) FIELD IN CONTROL = 0 OE510 0001130F* 11 OLD REFERENCE MONTH (ARMAST) FIELD IN CONTROL = 0 OE510 01140F* 30 LOOP INCREMENT WATCHER OE510 01150F* N90 SALES FOR A CUSTOMER # WITH THAT CUSTOMER # NOT OE510 01160F* ON ARMAST OE510 01170F* 95 IPL MONTH = 01 [JANUARY] OE510 01180F* 99 GROUP OF CALCS TO BE PERFORMED ONCE ONLY OE510 01190F* H1 IPL_MONTH AND/OR IPL_YEAR OUT OF BOUNDS OE510 0001200F* H2 IPL MONTH/YEAR COMBINATION DOES NOT CHRONOLOGICALLY OE510 01210F* FOLLOW (ARMAST) REFERENCE MONTH/YEAR COMBINATION OE510 01220F* H3 CHAIN TO CONTROL GOT A MISS OE510 01230F* OE510 01240F********************************************************************OE510 01250E TS 12 7 0 OE510 01260E HEADING HEAD 1 1 40 COMPANY NAME OE510 0001270ISMTHIN NS 01 OE510 01280I 1 50INVNUM OE510 01290I 6 100CUSTNOL1M1 OE510 01300I 11 160INVDAT OE510 01310I 17 190SLSMAN OE510 01320I 20 260QTY OE510 01330I 27 38 PARTNO OE510 0001340I 39 452NETSLS OE510 01350I 46 523UNCOST OE510 01360I 53 54 AREA OE510 01370IARMAST NS 02 OE510 01380I 2 60CUSTNOL1M1 OE510 01390I 264 2700OLDMTD OE510 01400I 271 2720OLDMTH OE510 0001410I 173 256 TS OE510 01420I 257 2630OLDYTD OE510 01430ICONTROL NS 03 OE510 01440I 13 140OLDYR 10 OE510 01450I 15 160OLDMTH 11 OE510 01460C 99 GOTO START OE510 01470C* OE510 0001480C MOVE 'CONTROL' KEY 7 OE510 01490C KEY CHAINCONTROL H3 BETTER FIND! OE510 01500C H3 GOTO FINI OE510 01510C* OE510 01520C MOVELUDATE MONTH 20 OE510 01530C MOVE UDATE YEAR 20 OE510 01540C* OE510 0001550C MONTH COMP 1 H1 OE510 01560C NH1 MONTH COMP 12 H1 OE510 01570C NH1 YEAR COMP 70 H1 OE510 01580C H1 GOTO FINI OE510 01590C* OE510 01600C 10 OE510 01610COR 11 GOTO NEXT OE510 0001620C* OE510 01630C MONTH COMP 1 95JANUARY OE510 01640C N95 MONTH SUB 1 CHKMTH 20 OE510 01650C 95 Z-ADD12 CHKMTH OE510 01660C OLDMTH COMP CHKMTH H2H2 OE510 01670C H2 GOTO FINI OE510 01680C N95 Z-ADDYEAR CHKYR 20 OE510 0001690C 95 YEAR SUB 1 CHKYR OE510 01700C OLDYR COMP CHKYR H2H2 OE510 01710C H2 GOTO FINI OE510 01720C* OE510 01730C NEXT TAG OE510 01740C* OE510 01750C Z-ADDMONTH NEWMTH 20 OE510 0001760C Z-ADDYEAR NEWYR 20 OE510 01770C SETON 99 OE510 01780C START TAG OE510 01790C L1 Z-ADD0 SLS 82 OE510 01800C L1 SETOF 90 OE510 01810C 01 NETSLS ADD CUMSLS CUMSLS 92 OE510 01820C 01 NETSLS ADD SLS SLS OE510 0001830C N02 GOTO FINI OE510 01840C SETON 90 OE510 01850C 95 Z-ADD0 OLDYTD JANUARY OE510 01860C Z-ADD12 N 20 OE510 01870C LOOP TAG OE510 01880C N SUB 1 M 20 OE510 01890C MOVE TS,M KWATCH 70 OE510 0001900C MOVE KWATCH TS,N OE510 01910C MOVE M N OE510 01920C M COMP 1 30 OE510 01930C N30 GOTO LOOP OE510 01940C MOVE OLDMTD TS,1 OE510 01950C OLDYTD ADD TS,12 NEWYTD 70 OE510 01960C SLS MULT 1 TOTSLS 70H OE510 0001970C FINI TAG OE510 01980OARMAST D 02 OE510 01990O TOTSLS B 270 OE510 02000O TS 256 OE510 02010O NEWYTD 263 OE510 02020OCONTROL D 03 OE510 02030O NEWYR 14 OE510 0002040O NEWMTH 16 OE510 02050O$LP1 H 202 1P OE510 02060O OR OF OE510 02070O PAGE Z 10 OE510 02080O 4 'PAGE' OE510 02090O HEAD,1 86 OE510 02100O UDATE Y 132 OE510 0002110O H 2 1P OE510 02120O OR OF OE510 02130O 69 'MONTH END SALES ANALYSIS' OE510 02140O 88 'UPDATE BY CUSTOMER' OE510 02150O 132 'DIS510' OE510 02160O T 1 L1N90 OE510 02170O 6 'CUST #' OE510 0002180O CUSTNO3 12 OE510 02190O 25 'NOT ON FILE.' OE510 02200O 40 'SALES WERE $' OE510 02210O TOTSLSJB 51 OE510 02220O 52 '.' OE510 02230O T 2 LR OE510 02240O 24 'END OF JOB. TOTAL SALES' OE510 0002250O 43 'THIS MONTH WERE $' OE510 02260O CUMSLSJ 57 OE510 02270O 58 '.' OE510 ** 002280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00231000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002320/* 002330__0O 58 '.' OE510 ** 002280ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002290ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002300ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0023100(JP$ OTXOE520 P999999050878(000010H S OE520 00020X DECK-ID A72 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE520 00030F* MONTH-END UPDATE OF SALES ANALYSIS FIELDS IN CONTROL AND SAMAST OE520 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE520 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE520 00060F* CONTROL DATA PROPRIETARY PRODUCT OE520 00070F* OE520 0000080FSMTHIN IPEAF 54 DISK OE520 00090FSAMAST ISEAF 120 12AI 1 DISK OE520 00100FCONTROL UC F 256R 7AI 1 DISK OE520 00110FHEADING IT F 40 EDISK OE520 00120FSAMOUT O F 120 DISK OE520 00130F$LP1 O F 132 OF PRINTER OE520 00140F********************************************************************OE520 0000150F* OE520 00160F* PACKAGE DISTRIBUTION OE520 00170F* SYSTEM SALES ANALYSIS OE520 00180F* PROGRAM MONTH/END UPDATING OF SALES ANALYSIS FIELDS IN OE520 00190F* CONTROL AND SAMAST OE520 00200F* OE520 00210F* CONTRACTOR COMPUSOURCE OE520 0000220F* PROGRAMMER KATHY HILL OE520 00230F* DATE JUNE 17, 1976 OE520 00240F* OE520 00250F********************************************************************OE520 00260F* OE520 00270F* NARRATIVE: OE520 00280F* OE520 0000290F* THIS PROGRAM SHOULD ONLY BE RUN ONCE AT MONTH/END TO ACCOMPLISH OE520 00300F* THE MONTH/END UPDATING OF SAMAST AND CONTROL. OE520 00310F* -----------------------------------------------------------------OE520 00320F* THE DETERMINATION OF THE NEW REFERENCE MONTH (SAMAST) FIELD FOR OE520 00330F* THE CONTROL FILE AND OF THE NEW REFERENCE YEAR (SAMAST) FIELD OE520 00340F* FOR THE CONTROL FILE BY USE OF THE OLD REFERENCE MONTH (SAMAST) OE520 00350F* FIELD FROM THE CONTROL FILE, THE OLD REFERENCE YEAR (SAMAST) OE520 0000360F* FIELD FROM THE CONTROL FILE, THE IPL MONTH, AND THE IPL YEAR OE520 00370F* IS DONE ONLY ONCE [AT THE START OF THE PROGRAM]. OE520 00380F* OE520 00390F* CHAINS TO THE CONTROL FILE. IF CHAIN TO CONTROL GETS A MISS, OE520 00400F* THEN H3 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. AFTER OE520 00410F* CONTROL IS ON SYSTEM, OPERATOR CAN RETRY THE PROGRAM. OE520 00420F* OE520 0000430F* CHECKS THAT [ 1 <= IPL_MONTH <= 12 ] AND [ 70 <= IPL_YEAR ]. OE520 00440F* IF EITHER IS OUT OF BOUNDS, THEN H1 IS SET ON AND THE PROGRAM OE520 00450F* SHOULD BE CANCELLED. THE OPERATOR SHOULD IPL CORRECTLY OE520 00460F* BEFORE RETRYING THE PROGRAM. OE520 00470F* OE520 00480F* IF (1) THE REFERENCE MONTH (SAMAST) FIELD IN CONTROL AND/OR OE520 00490F* THE REFERENCE YEAR (SAMAST) FIELD IN CONTROL = 0 OE520 0000500F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE520 00510F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (SAMAST) OE520 00520F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE520 00530F* YEAR (SAMAST) IN CONTROL. OE520 00540F* OE520 00550F* IF (1) THE REFERENCE MONTH (SAMAST) FIELD IN CONTROL AND OE520 00560F* THE REFERENCE YEAR (SAMAST) FIELD IN CONTROL ARE OE520 0000570F* NON-ZERO OE520 00580F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE520 00590F* AND (3) THE IPL MONTH/YEAR COMBINATION CHRONOLIGICALLY OE520 00600F* FOLLOWS THE (SAMAST) REFERENCE MONTH/YEAR COMBINATION OE520 00610F* THEN THE IPL MONTH BECOMES THE NEW REFERENCE MONTH (SAMAST) OE520 00620F* IN CONTROL AND THE IPL YEAR BECOMES THE NEW REFERENCE OE520 00630F* YEAR (SAMAST) IN CONTROL. OE520 0000640F* OE520 00650F* IF (1) THE REFERENCE MONTH (SAMAST) FIELD IN CONTROL AND OE520 00660F* THE REFERENCE YEAR (SAMAST) FIELD IN CONTROL ARE OE520 00670F* NON-ZERO OE520 00680F* AND (2) THE IPL MONTH AND THE IPL YEAR ARE WITHIN BOUNDS OE520 00690F* BUT (3) THE IPL MONTH/YEAR COMBINATION DOES NOT OE520 00700F* --- OE520 0000710F* CHRONOLOGICALLY FOLLOW THE (SAMAST) REFERENCE OE520 00720F* MONTH/YEAR COMBINATION OE520 00730F* THEN H2 IS SET ON AND THE PROGRAM SHOULD BE CANCELLED. OE520 00740F* OPERATOR CAN CHECK CONTROL, IPL CORRECTLY, AND RETRY THE OE520 00750F* PROGRAM. OE520 00760F* -----------------------------------------------------------------OE520 00770F* ALL SALES AGAINST GIVEN CUSTOMER # ARE SUMMED INTO ONE FIGURE. OE520 0000780F* -----------------------------------------------------------------OE520 00790F* IF IT'S JANUARY, THEN THE YTD QTY SALES (LAST YEAR) FIELD IS OE520 00800F* ZEROED-OUT. OE520 00810F* -----------------------------------------------------------------OE520 00820F* ARRAY: ELEMENT 11 --> POSITION 12 OE520 00830F* ELEMENT 10 --> POSITION 11 OE520 00840F* ELEMENT 9 --> POSITION 10 OE520 0000850F* ELEMENT 8 --> POSITION 9 OE520 00860F* ELEMENT 7 --> POSITION 8 OE520 00870F* ELEMENT 6 --> POSITION 7 OE520 00880F* ELEMENT 5 --> POSITION 6 OE520 00890F* ELEMENT 4 --> POSITION 5 OE520 00900F* ELEMENT 3 --> POSITION 4 OE520 00910F* ELEMENT 2 --> POSITION 3 OE520 0000920F* ELEMENT 1 --> POSITION 2 OE520 00930F* -----------------------------------------------------------------OE520 00940F* OLD MTD QTY SALES (THIS YEAR) INTO POSITION 1 OF SALES ARRAY OE520 00950F* -----------------------------------------------------------------OE520 00960F* IF ANY SALES TO THIS CUSTOMER, TOTAL FIGURE INTO OE520 00970F* MTD QTY SALES (THIS YEAR) FIELD. IF THERE WERE NO SALES TO OE520 00980F* THIS CUSTOMER THIS MONTH, THEN THE MTD QTY SALES (THIS YEAR) OE520 0000990F* FIELD IS ZEROED-OUT. OE520 01000F* -----------------------------------------------------------------OE520 01010F* YTD QTY SALES (THIS YEAR) = YTD QTY SALES (THIS YEAR) + OE520 01020F* 12TH ELEMENT OF SALES ARRAY OE520 01030F* -----------------------------------------------------------------OE520 01040F* IPL MONTH --> NEW (SAMAST) REFERENCE MONTH FOR CONTROL OE520 01050F* IPL YEAR --> NEW (SAMAST) REFERENCE YEAR FOR CONTROL OE520 0001060F* OE520 01070F********************************************************************OE520 01080F* ID F C H L FUNCTION OF INDICATORS OE520 01090F* OE520 01100F* 01 SMTHIN OE520 01110F* 02 SAMAST OE520 01120F* 03 CONTROL OE520 0001130F* 10 OLD REFERENCE YEAR (SAMAST) FIELD IN CONTROL = 0 OE520 01140F* 11 OLD REFERENCE MONTH (SAMAST) FIELD IN CONTROL = 0 OE520 01150F* 30 LOOP INCREMENT WATCHER OE520 01160F* 95 IPL MONTH = 01 [JANUARY] OE520 01170F* 99 GROUP OF CALCS TO BE PERFORMED ONLY ONCE OE520 01180F* H1 IPL_MONTH AND/OR IPL_YEAR OUT OF BOUNDS OE520 01190F* H2 IPL MONTH/YEAR COMBINATION DOES NOT CHRONOLOGICALLY OE520 0001200F* FOLLOW (SAMAST) REFERENCE MONTH/YEAR COMBINATION OE520 01210F* H3 CHAIN TO CONTROL GOT A MISS OE520 01220F* OE520 01230F********************************************************************OE520 01240E TS 12 7 0 OE520 01250E HEADING HEAD 1 1 40 COMPANY NAME OE520 01260ISMTHIN NS 01 OE520 0001270I 1 50INVNUM OE520 01280I 6 100CUSTNO OE520 01290I 11 160INVDAT OE520 01300I 17 190SLSMAN OE520 01310I 20 260QTY OE520 01320I 27 38 PARTNOL1M1 OE520 01330I 39 452NETSLS OE520 0001340I 46 523UNCOST OE520 01350I 53 54 AREA OE520 01360ISAMAST NS 02 OE520 01370I 1 12 PARTNOL1M1 OE520 01380I 13 190OLDMTD OE520 01390I 20 210OLDMTH OE520 01400I 22 105 TS OE520 0001410I 106 1130OLDYTD OE520 01420ICONTROL NS 03 OE520 01430I 17 180OLDYR 10 OE520 01440I 19 200OLDMTH 11 OE520 01450C 99 GOTO START OE520 01460C* OE520 01470C* OE520 0001480C MOVE 'CONTROL' KEY 7 OE520 01490C KEY CHAINCONTROL H3 BETTER FIND! OE520 01500C H3 GOTO FINI OE520 01510C* OE520 01520C MOVELUDATE MONTH 20 OE520 01530C MOVE UDATE YEAR 20 OE520 01540C* OE520 0001550C MONTH COMP 1 H1 OE520 01560C NH1 MONTH COMP 12 H1 OE520 01570C NH1 YEAR COMP 70 H1 OE520 01580C H1 GOTO FINI OE520 01590C* OE520 01600C 10 OE520 01610COR 11 GOTO NEXT OE520 0001620C* OE520 01630C MONTH COMP 1 95JANUARY OE520 01640C N95 MONTH SUB 1 CHKMTH 20 OE520 01650C 95 Z-ADD12 CHKMTH OE520 01660C OLDMTH COMP CHKMTH H2H2 OE520 01670C H2 GOTO FINI OE520 01680C N95 Z-ADDYEAR CHKYR 20 OE520 0001690C 95 YEAR SUB 1 CHKYR OE520 01700C OLDYR COMP CHKYR H2H2 OE520 01710C H2 GOTO FINI OE520 01720C* OE520 01730C NEXT TAG OE520 01740C* OE520 01750C Z-ADDMONTH NEWMTH 20 OE520 0001760C Z-ADDYEAR NEWYR 20 OE520 01770C SETON 99 OE520 01780C START TAG OE520 01790C L1 Z-ADD0 TOTQTY 70 OE520 01800C 01 L1NMR Z-ADD0 TS OE520 01810C 01 L1NMR Z-ADD0 NEWYTD 80 OE520 01820C 01 QTY ADD TOTQTY TOTQTY OE520 0001830C 01 NETSLS ADD CUMSLS CUMSLS 92 OE520 01840C N02 GOTO FINI OE520 01850C 95 Z-ADD0 OLDYTD JANUARY OE520 01860C Z-ADD12 N 20 OE520 01870C LOOP TAG OE520 01880C N SUB 1 M 20 OE520 01890C MOVE TS,M KWATCH 70 OE520 0001900C MOVE KWATCH TS,N OE520 01910C MOVE M N OE520 01920C M COMP 1 30 OE520 01930C N30 GOTO LOOP OE520 01940C MOVE OLDMTD TS,1 OE520 01950C OLDYTD ADD TS,12 NEWYTD OE520 01960C FINI TAG OE520 0001970OSAMOUT T L1 OE520 01980O PARTNO 12 OE520 01990O TOTQTY B 19 OE520 02000O TS 105 OE520 02010O NEWYTD 113 OE520 02020OCONTROL D 03 OE520 02030O NEWYR 18 OE520 0002040O NEWMTH 20 OE520 02050O$LP1 H 202 1P OE520 02060O OR OF OE520 02070O PAGE Z 10 OE520 02080O 4 'PAGE' OE520 02090O HEAD,1 85 OE520 02100O UDATE Y 132 OE520 0002110O H 2 1P OE520 02120O OR OF OE520 02130O 68 'MONTH END SALES ANALYSIS' OE520 02140O 86 'UPDATE BY PRODUCT' OE520 02150O 132 'DIS520' OE520 02160O T 2 LR OE520 02170O 24 'END OF JOB. TOTAL SALES' OE520 0002180O 43 'THIS MONTH WERE $' OE520 02190O CUMSLSJ 57 OE520 02200O 58 '.' OE520 ** 002210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00224000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002250/* 002260__0O 58 '.' OE520 ** 002210ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 002220ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002230ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0022400(P OTXOE550 P999999050878(000010H S OE550 00020X DECK-ID A73 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE550 00030F* PRINTS SALES ANALYSIS (NU1) AND HISTORY (U1) BY CUSTOMER NUMBER OE550 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE550 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE550 00060F* CONTROL DATA PROPRIETARY PRODUCT OE550 00070F* OE550 0000080FARMAST IPEAF 280 6AI 1 DISK OE550 00090FCONTROL IC F 256R 7AI 1 DISK OE550 00100FHEADING IT F 40 EDISK OE550 00110F$LP1 O F 132 OF LPRINTER OE550 00120F********************************************************************OE550 00130F* OE550 00140F* PACKAGE DISTRIBUTION OE550 0000150F* SYSTEM SALES ANALYSIS OE550 00160F* PROGRAM HISTORICAL SALES ANALYSIS REPORT BY CUSTOMER # (U1) OE550 00170F* COMPARATIVE SALES ANALYSIS REPORT BY CUSTOMER # (NU1) OE550 00180F* OE550 00190F* CONTRACTOR COMPUSOURCE OE550 00200F* PROGRAMMER KATHY HILL OE550 00210F* DATE JUNE 16, 1976 OE550 0000220F* OE550 00230F********************************************************************OE550 00240E HEADING HEAD 1 1 40 COMPANY NAME OE550 00250E TS 12 7 0 LAST 12 MTH SALESOE550 00260E GS 12 8 0 LR TOTALS OE550 00270E TD 12 2 0 OE550 00280L$LP1 66FL050OL OE550 0000290IARMAST NS 01 OE550 00300I 2 60CUSTNO OE550 00310I 7 30 CNAME OE550 00320I 264 2700MTD OE550 00330I 173 256 TS OE550 00340I 257 2630YTDLST OE550 00350ICONTROL NS 02 OE550 0000360I 13 140REFYR OE550 00370I 15 160REFMTH OE550 00380C********************************************************************OE550 00390C* OE550 00400C* THIS BLOCK OF LOGIC IS EXECUTED ONCE ONLY AT THE START OE550 00410C* OF THE PROGRAM. OE550 00420C* OE550 0000430C* IT CHAINS TO THE CONTROL FILE WITH THE KEY 'CONTROL' OE550 00440C* AND FETCHES THE REFERENCE MONTH (ARMAST) AND THE OE550 00450C* REFERENCE YEAR (ARMAST). OE550 00460C* OE550 00470C* IF THE 'CONTROL' RECORD IS MISSING, THEN H1 IS SET ON OE550 00480C* AND THE PROGRAM SHOULD BE CANCELLED. OE550 00490C* OE550 0000500C* IF THE REFERENCE MONTH (ARMAST) AND/OR THE OE550 00510C* REFERENCE YEAR (ARMAST) IS ZERO, THEN H2 IS SET ON OE550 00520C* AND THE PROGRAM SHOULD BE CANCELLED. OE550 00530C* OE550 00540C* USING THE REFERENCE MONTH (ARMAST) AND THE OE550 00550C* REFERENCE YEAR (ARMAST), THE PROGRAM DECIDES WHICH OE550 00560C* MONTH'S SALES FIGURE ($) IS HELD BY EACH OF THE OE550 0000570C* ELEMENTS OF THE SALES HISTORY ARRAY ($) OF ARMAST; OE550 00580C* USING THE MONTH/YEAR FROM CONTROL, THE PROGRAM OE550 00590C* ALSO DECIDES WHETHER THE RESPECTIVE MONTH WAS IN THE REFERENCE OE550 00600C* YEAR OR IN THE YEAR PRECEDING THE REFERENCE YEAR. OE550 00610C* OE550 00620C********************************************************************OE550 00630C* OE550 0000640C 97 SETOF 97 OE550 00650C 99 GOTO START OE550 00660C SETON 9799 OE550 00670C* OE550 00680C MOVEL'CONTROL' KEY 7 OE550 00690C KEY CHAINCONTROL H1 OE550 00700C NH1 REFYR COMP 0 H2 OE550 0000710C NH1NH2 REFMTH COMP 0 H2 OE550 00720C* OE550 00730C H1 OE550 00740COR H2 GOTO FINI OE550 00750C* OE550 00760C REFMTH SUB 1 LSTMTH 20 OE550 00770C REFYR SUB 1 LSTYR 20 OE550 0000780C* OE550 00790C Z-ADD1 INX 20 OE550 00800C MOVE LSTMTH MONTH 20 OE550 00810C* OE550 00820C LOOP1 TAG OE550 00830C* OE550 00840C MONTH COMP 0 98 OE550 0000850C 98 MOVE REFYR TD,INX OE550 00860C N98 MOVE LSTYR TD,INX OE550 00870C INX COMP 12 98 OE550 00880C 98 GOTO GETOUT OE550 00890C INX ADD 1 INX OE550 00900C MONTH SUB 1 MONTH OE550 00910C GOTO LOOP1 OE550 0000920C* OE550 00930C GETOUT TAG OE550 00940C* OE550 00950C********************************************************************OE550 00960C* OE550 00970C* ACCORDING TO WHETHER THE SWITCH SETTING IS U1 OR NU1, OE550 00980C* THE PROPER SUBROUTINES ARE EXECUTED. OE550 0000990C* OE550 01000C********************************************************************OE550 01010C* OE550 01020C START TAG OE550 01030C* OE550 01040C NU1 EXSR SASR OE550 01050C NU1 EXSR STOT OE550 0001060C U1 EXSR HSTSR OE550 01070C U1 EXSR HTOT OE550 01080C* OE550 01090C FINI TAG OE550 01100C* OE550 01110CLRNU1 EXSR PCT OE550 01120C* OE550 0001130C********************************************************************OE550 01140C* OE550 01150C* THIS SUBROUTINE SUMS ALL OF THE ELEMENTS OF THE SALES OE550 01160C* HISTORY ARRAY INTO A SINGLE FIGURE, LAST12. OE550 01170C* OE550 01180C* THEN, SOLELY FOR THE PURPOSES OF THE REPORT, THE OE550 01190C* ELEMENTS OF THE SALES HISTORY ARRAY ARE ROTATED. OE550 0001200C* THE PURPOSE OF THE ROTATION IS TO HAVE THE ELEMENTS OE550 01210C* OF THE ARRAY HOLDING THE SALES FIGURES FOR THE OE550 01220C* MONTHS IN DESCENDING ORDER; ELEMENT 1 HOLDING THE SALES FIGURE OE550 01230C* FOR THE MONTH OF DECEMBER, ELEMENT 2 HOLDING THE SALES OE550 01240C* FIGURE FOR THE MONTH OF NOVEMBER, ETC. OE550 01250C* IN THIS MANNER, THE PROGRAM CAN ALWAYS PRINT OE550 01260C* OUT THE SALES FIGURES JANUARY TO DECEMBER (THE OE550 0001270C* APPROPRIATE YEAR IS PRINTED BESIDE EACH MONTH IN THE HEADINGS). OE550 01280C* THE REFERENCE MONTH FROM CONTROL GUIDES THE OE550 01290C* SUBROUTINE IN THE ROTATION OF THE ARRAY. OE550 01300C* THE ROTATION IS ACCOMPLISHED THROUGH A NESTED LOOP. OE550 01310C* EACH PASS THROUGH THE INNER LOOP MANAGES TO OE550 01320C* ROTATE THE ELEMENTS IN THE ARRAY BY ONE POSITION ONLY OE550 01330C* (EX: MOVING ARRAY,2 INTO ARRAY,1) OE550 0001340C* AND THE REFERENCE MONTH IS USED (IN THE OUTER LOOP) OE550 01350C* TO TELL THE SUBROUTINE HOW MANY TIMES IT MUST OE550 01360C* ROTATE THE ELEMENTS OF THE ARRAY. OE550 01370C* OE550 01380C* OE550 01390C* OE550 01400CSR HSTSR BEGSR OE550 0001410C* OE550 01420CSR XFOOTTS LAST12 80 OE550 01430C* OE550 01440CSR MOVE LSTMTH MONTH OE550 01450C* OE550 01460CSR LOOP2 TAG OE550 01470C* OE550 0001480CSR MONTH SUB 1 MONTH OE550 01490CSR MONTH COMP 0 98 OE550 01500CSR 98 GOTO OUT1 OE550 01510CSR Z-ADD1 INX OE550 01520CSR MOVE TS,INX WRK7 70 OE550 01530C* OE550 01540CSR LOOP3 TAG OE550 0001550C* OE550 01560CSR INX ADD 1 IN2 20 OE550 01570CSR MOVE TS,IN2 KWATCH 70 OE550 01580CSR MOVE KWATCH TS,INX OE550 01590CSR IN2 COMP 12 98 OE550 01600CSR 98 MOVE WRK7 TS,12 OE550 01610CSR 98 GOTO LOOP2 OE550 0001620CSR MOVE IN2 INX OE550 01630CSR GOTO LOOP3 OE550 01640C* OE550 01650CSR OUT1 ENDSR OE550 01660C* OE550 01670C********************************************************************OE550 01680C* OE550 0001690C* THIS SUBROUTINE FIGURES THE % INCREASE IN SALES FROM OE550 01700C* LAST MONTH (1ST ELEMENT OF SALES ARRAY) TO THIS MONTH OE550 01710C* (MTD SALES). OE550 01720C* OE550 01730C* IT FIGURES THE % INCREASE IN SALES FROM THE OE550 01740C* CURRENT MONTH THIS YEAR (MTD SALES) COMPARED TO THE OE550 01750C* CURRENT MONTH LAST YEAR (12TH ELEMENT OF SALES ARRAY). OE550 0001760C* OE550 01770C* IT CALCULATES YTD SALES THIS YEAR = MTD SALES + OE550 01780C* VALUES FROM ALL OF THE ELEMENTS OF THE SALES ARRAY WHICH OE550 01790C* HOLD SALES FIGURES FOR MONTHS OF THE REFERENCE YEAR. OE550 01800C* IT THEN FIGURES THE % INCREASE IN SALES OF YTD SALES THIS YEAR OE550 01810C* COMPARED TO YTD SALES LAST YEAR (YTD SALES LAST YEAR). OE550 01820C* OE550 0001830C********************************************************************OE550 01840C* OE550 01850CSR SASR BEGSR OE550 01860C* OE550 01870CSR MTD SUB TS,1 WRK7 70 OE550 01880CSR WRK7 DIV TS,1 WRKPCT 53H OE550 01890CSR WRKPCT MULT 100 PCT1 41 OE550 0001900CSR WRK7 COMP 0 5051 OE550 01910CSR 50 OE550 01920COR 51 TS,1 COMP 0 52 OE550 01930CSR 50 52 Z-ADD100 PCT1 OE550 01940CSR 51 52 Z-SUB100 PCT1 OE550 01950C* OE550 01960CSR MTD SUB TS,12 WRK7 OE550 0001970CSR WRK7 DIV TS,12 WRKPCT H OE550 01980CSR WRKPCT MULT 100 PCT2 41 OE550 01990CSR WRK7 COMP 0 5051 OE550 02000CSR 50 OE550 02010COR 51 TS,12 COMP 0 52 OE550 02020CSR 50 52 Z-ADD100 PCT2 OE550 02030CSR 51 52 Z-SUB100 PCT2 OE550 0002040C* OE550 02050CSR Z-ADD0 YTDCUR 80 OE550 02060CSR MTD ADD YTDCUR YTDCUR OE550 02070CSR Z-ADD1 INX OE550 02080C* OE550 02090CSR LOOP4 TAG OE550 02100C* OE550 0002110CSR LSTMTH COMP INX 98 OE550 02120CSR 98 GOTO OUT2 OE550 02130CSR TS,INX ADD YTDCUR YTDCUR OE550 02140CSR INX ADD 1 INX OE550 02150CSR GOTO LOOP4 OE550 02160C* OE550 02170CSR OUT2 TAG OE550 0002180C* OE550 02190CSR YTDCUR SUB YTDLST WRK7 OE550 02200CSR WRK7 DIV YTDLST WRKPCT H OE550 02210CSR WRKPCT MULT 100 PCT3 41 OE550 02220CSR WRK7 COMP 0 5051 OE550 02230CSR 50 OE550 02240COR 51 YTDLST COMP 0 52 OE550 0002250CSR 50 52 Z-ADD100 PCT3 OE550 02260CSR 51 52 Z-SUB100 PCT3 OE550 02270C* OE550 02280CSR ENDSR OE550 02290C* OE550 02300C********************************************************************OE550 02310C* OE550 0002320C* THIS SUBROUTINE KEEPS RUNNING TOTALS. OE550 02330C* THEN THE COMPANY SALES HISOTRY IS PRINTED OUT AT THE END OF THE OE550 02340C* REPORT BY USE OF THESE VALUES. OE550 02350C* OE550 02360C********************************************************************OE550 02370C* OE550 02380CSR HTOT BEGSR OE550 0002390C* OE550 02400CSR MTD ADD HT1 HT1 80 OE550 02410CSR LAST12 ADD HT2 HT2 80 OE550 02420CSR TS ADD GS GS OE550 02430C* OE550 02440CSR ENDSR OE550 02450C* OE550 0002460C********************************************************************OE550 02470C* OE550 02480C* THIS SUBROUTINE KEEPS RUNNING TOTALS. OE550 02490C* THE FIGURES FOR SALES INCREASES BY % THAT WERE OE550 02500C* CALCULATED FOR AN INDIVIDUAL CUSTOMER IN SASR CAN THEN OE550 02510C* BE CALCULATED FOR THE COMPANY AS A WHOLE (IN PCT). OE550 02520C* OE550 0002530C********************************************************************OE550 02540C* OE550 02550CSR STOT BEGSR OE550 02560C* OE550 02570CSR MTD ADD ST1 ST1 80 OE550 02580CSR TS,1 ADD ST2 ST2 80 OE550 02590CSR TS,12 ADD ST3 ST3 80 OE550 0002600CSR YTDCUR ADD ST4 ST4 80 OE550 02610CSR YTDLST ADD ST5 ST5 80 OE550 02620C* OE550 02630CSR ENDSR OE550 02640C* OE550 02650C********************************************************************OE550 02660C* OE550 0002670C* THIS SUBROUTINE CALCULATES % INCREASES IN SALES OE550 02680C* FOR THE COMPANY AS A WHOLE. OE550 02690C* OE550 02700C********************************************************************OE550 02710C* OE550 02720CSR PCT BEGSR OE550 02730C* OE550 0002740CSR ST1 SUB ST2 WRK7 OE550 02750CSR WRK7 DIV ST2 WRKPCT H OE550 02760CSR WRKPCT MULT 100 PCT4 41 OE550 02770CSR WRK7 COMP 0 5051 OE550 02780CSR 50 OE550 02790COR 51 ST2 COMP 0 52 OE550 02800CSR 50 52 Z-ADD100 PCT4 OE550 0002810CSR 51 52 Z-SUB100 PCT4 OE550 02820C* OE550 02830CSR ST1 SUB ST3 WRK7 OE550 02840CSR WRK7 DIV ST3 WRKPCT H OE550 02850CSR WRKPCT MULT 100 PCT5 41 OE550 02860CSR WRK7 COMP 0 5051 OE550 02870CSR 50 OE550 0002880COR 51 ST3 COMP 0 52 OE550 02890CSR 50 52 Z-ADD100 PCT5 OE550 02900CSR 51 52 Z-SUB100 PCT5 OE550 02910C* OE550 02920CSR ST4 SUB ST5 WRK7 OE550 02930CSR WRK7 DIV ST5 WRKPCT H OE550 02940CSR WRKPCT MULT 100 PCT6 41 OE550 0002950CSR WRK7 COMP 0 5051 OE550 02960CSR 50 OE550 02970COR 51 ST5 COMP 0 52 OE550 02980CSR 50 52 Z-ADD100 PCT6 OE550 02990CSR 51 52 Z-SUB100 PCT6 OE550 03000C* OE550 03010CSR ENDSR OE550 0003020C* OE550 03030C********************************************************************OE550 03040O$LP1 H 202 1P OE550 03050O OR OF OE550 03060O PAGE Z 9 OE550 03070O 4 'PAGE' OE550 03080O HEAD,1 86 OE550 0003090O UDATE Y 132 OE550 03100O H 2 1P OE550 03110O OR OF OE550 03120O U1 69 'SALES HISTORY BY' OE550 03130O U1 78 'CUSTOMER' OE550 03140O NU1 70 'SALES ANALYSIS BY' OE550 03150O NU1 79 'CUSTOMER' OE550 0003160O 132 'DIS550' OE550 03170O H 1 97 U1 OE550 03180O OR OF U1 OE550 03190O 64 'THIS MTH' OE550 03200O 73 'JAN' OE550 03210O TD,1 76 OE550 03220O 84 'FEB' OE550 0003230O TD,2 87 OE550 03240O 95 'MAR' OE550 03250O TD,3 98 OE550 03260O 106 'APR' OE550 03270O TD,4 109 OE550 03280O 117 'MAY' OE550 03290O TD,5 120 OE550 0003300O 128 'JUN' OE550 03310O TD,6 131 OE550 03320O H 2 97 U1 OE550 03330O OR OF U1 OE550 03340O 6 'CUST #' OE550 03350O 21 'CUSTOMER NAME' OE550 03360O 64 'LAST 12' OE550 0003370O 73 'JUL' OE550 03380O TD,7 76 OE550 03390O 84 'AUG' OE550 03400O TD,8 87 OE550 03410O 95 'SEP' OE550 03420O TD,9 98 OE550 03430O 106 'OCT' OE550 0003440O TD,10 109 OE550 03450O 117 'NOV' OE550 03460O TD,11 120 OE550 03470O 128 'DEC' OE550 03480O TD,12 131 OE550 03490O H 1 97NU1 OE550 03500O OR OFNU1 OE550 0003510O 59 'CURRENT' OE550 03520O 70 'LAST' OE550 03530O 89 'CUR MTH' OE550 03540O 122 '- - Y E A R T O D A T' OE550 03550O 128 'E - -' OE550 03560O H 2 97NU1 OE550 03570O OR OFNU1 OE550 0003580O 6 'CUST #' OE550 03590O 21 'CUSTOMER NAME' OE550 03600O 58 'MONTH' OE550 03610O 70 'MONTH' OE550 03620O 76 '%' OE550 03630O 89 'LAST YR' OE550 03640O 95 '%' OE550 0003650O 109 'THIS YR' OE550 03660O 121 'LAST YR' OE550 03670O 127 '%' OE550 03680O D 11 01 U1 OE550 03690O CUSTNO 6 OE550 03700O CNAME 32 OE550 03710O MTD J 65 OE550 0003720O TS,12 J 77 OE550 03730O TS,11 J 88 OE550 03740O TS,10 J 99 OE550 03750O TS,9 J 110 OE550 03760O TS,8 J 121 OE550 03770O TS,7 J 132 OE550 03780O D 1 01 U1 OE550 0003790O LAST12JB 65 OE550 03800O TS,6 J 77 OE550 03810O TS,5 J 88 OE550 03820O TS,4 J 99 OE550 03830O TS,3 J 110 OE550 03840O TS,2 J 121 OE550 03850O TS,1 J 132 OE550 0003860O D 1 01NU1 OE550 03870O CUSTNO 6 OE550 03880O CNAME 32 OE550 03890O MTD J 60 OE550 03900O TS,1 J 71 OE550 03910O PCT1 J 78 OE550 03920O TS,12 J 90 OE550 0003930O PCT2 J 97 OE550 03940O YTDCURJB 110 OE550 03950O YTDLSTJ 122 OE550 03960O PCT3 J 129 OE550 03970O T 21 LR U1 OE550 03980O 11 'END OF JOB.' OE550 03990O 51 'COMPANY TOTALS' OE550 0004000O HT1 J 65 OE550 04010O GS,12 J 77 OE550 04020O GS,11 J 88 OE550 04030O GS,10 J 99 OE550 04040O GS,9 J 110 OE550 04050O GS,8 J 121 OE550 04060O GS,7 J 132 OE550 0004070O T 1 LR U1 OE550 04080O HT2 J 65 OE550 04090O GS,6 J 77 OE550 04100O GS,5 J 88 OE550 04110O GS,4 J 99 OE550 04120O GS,3 J 110 OE550 04130O GS,2 J 121 OE550 0004140O GS,1 J 132 OE550 04150O T 2 LRNU1 OE550 04160O 11 'END OF JOB.' OE550 04170O 46 'COMPANY TOTALS' OE550 04180O ST1 J 60 OE550 04190O ST2 J 71 OE550 04200O PCT4 J 78 OE550 0004210O ST3 J 90 OE550 04220O PCT5 J 97 OE550 04230O ST4 J 110 OE550 04240O ST5 J 122 OE550 04250O PCT6 J 129 OE550 ** 004260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00427000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 004280ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 004290ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 004300/* 004310__0O PCT6 J 129 OE550 ** 004260ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0042700(Q ROTXOE560 P999999050878(000010H S OE560 00020X DECK-ID A74 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE560 00030F* PRINTS SALES ANALYSIS (NU1) AND HISTORY (U1) BY PART NUMBER OE560 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE560 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE560 00060F* CONTROL DATA PROPRIETARY PRODUCT OE560 00070F* OE560 0000080FSAMAST IPEAF 120 DISK OE560 00090FPARTMST IC F 300R12AI 1 DISK OE560 00100FCONTROL IC F 256R 7AI 1 DISK OE560 00110FHEADING IT F 40 EDISK OE560 00120F$LP1 O F 132 OF LPRINTER OE560 00130F********************************************************************OE560 00140F* OE560 0000150F* PACKAGE DISTRIBUTION OE560 00160F* SYSTEM SALES ANALYSIS OE560 00170F* PROGRAM HISTORICAL SALES ANALYSIS REPORT BY PART # (U1) OE560 00180F* COMPARATIVE SALES ANALYSIS REPORT BY PART # (NU1) OE560 00190F* OE560 00200F* CONTRACTOR COMPUSOURCE OE560 00210F* PROGRAMMER KATHY HILL OE560 0000220F* DATE JUNE 16, 1976 OE560 00230F* OE560 00240F********************************************************************OE560 00250E HEADING HEAD 1 1 40 COMPANY NAME OE560 00260E TS 12 7 0 LAST 12 MTH SALESOE560 00270E TD 12 2 0 HEADING YEARS U1 OE560 00280L$LP1 66FL 50OL OE560 0000290ISAMAST NS 01 OE560 00300I 1 12 PN OE560 00310I 13 190MTD OE560 00320I 20 210MTH OE560 00330I 22 105 TS OE560 00340I 106 1130YTDLST OE560 00350IPARTMST NS 02 OE560 0000360I 13 37 DESCR OE560 00370I 74 74 DLTPR OE560 00380ICONTROL NS 03 OE560 00390I 17 180REFYR OE560 00400I 19 200REFMTH OE560 00410C********************************************************************OE560 00420C* OE560 0000430C* THIS BLOCK OF LOGIC IS EXECUTED ONCE ONLY AT THE START OE560 00440C* OF THE PROGRAM. OE560 00450C* OE560 00460C* IT CHAINS TO THE CONTROL FILE WITH THE KEY 'CONTROL' OE560 00470C* AND FETCHES THE REFERENCE MONTH (SAMAST) AND THE OE560 00480C* REFERENCE YEAR (SAMAST). OE560 00490C* OE560 0000500C* IF THE 'CONTROL' RECORD IS MISSING, THEN H1 IS SET ON OE560 00510C* AND THE PROGRAM SHOULD BE CANCELLED. OE560 00520C* OE560 00530C* IF THE REFERENCE MONTH (SAMAST) AND/OR THE OE560 00540C* REFERENCE YEAR (SAMAST) IS ZERO, THEN H2 IS SET ON OE560 00550C* AND THE PROGRAM SHOULD BE CANCELLED. OE560 00560C* OE560 0000570C* USING THE REFERENCE MONTH (SAMAST) AND THE OE560 00580C* REFERENCE YEAR (SAMAST), THE PROGRAM DECIDES WHICH OE560 00590C* MONTH'S FIGURE (QTY) IS HELD BY EACH OF THE OE560 00600C* ELEMENTS OF THE SALES HISTORY ARRAY (QTY) OF SAMAST; OE560 00610C* USING THE MONTH/YEAR FROM CONTROL, THE PROGRAM OE560 00620C* ALSO DECIDES WHETHER THE RESPECTIVE MONTH WAS IN THE REFERENCE OE560 00630C* YEAR OR IN THE YEAR PRECEDING THE REFERENCE YEAR. OE560 0000640C* OE560 00650C********************************************************************OE560 00660C* OE560 00670C 97 SETOF 97 OE560 00680C 99 GOTO START OE560 00690C SETON 9799 OE560 00700C* OE560 0000710C MOVEL'CONTROL' KEY 7 OE560 00720C KEY CHAINCONTROL H1 OE560 00730C NH1 REFYR COMP 0 H2 OE560 00740C NH1NH2 REFMTH COMP 0 H2 OE560 00750C H1 OE560 00760COR H2 GOTO FINI OE560 00770C* OE560 0000780C REFMTH SUB 1 LSTMTH 20 OE560 00790C REFYR SUB 1 LSTYR 20 OE560 00800C* OE560 00810C Z-ADD1 INX 20 OE560 00820C MOVE LSTMTH MONTH 20 OE560 00830C* OE560 00840C LOOP1 TAG OE560 0000850C* OE560 00860C MONTH COMP 0 98 OE560 00870C 98 MOVE REFYR TD,INX OE560 00880C N98 MOVE LSTYR TD,INX OE560 00890C INX COMP 12 98 OE560 00900C 98 GOTO GETOUT OE560 00910C INX ADD 1 INX OE560 0000920C MONTH SUB 1 MONTH OE560 00930C GOTO LOOP1 OE560 00940C* OE560 00950C GETOUT TAG OE560 00960C* OE560 00970C********************************************************************OE560 00980C* OE560 0000990C* WITH EVERY RECORD OF SAMAST, PART # IS USED TO CHAIN TO THE OE560 01000C* PARTMST FILE. IF THERE IS A MISS ON THE CHAIN OR IF OE560 01010C* THE DELETE CODE OF THE RECORD IN PARTMST IS NOT BLANK, 25 IS OE560 01020C* SET ON AND '** NOT ON PART MASTER **' WILL PRINT OUT ON THE OE560 01030C* REPORT. IF THE RECORD IS ON PARTMST WITH A BLANK DELETE CODE, OE560 01040C* THEN THE DESCRIPTION OF THE PART WILL PRINT OUT ON THE REPORT. OE560 01050C* OE560 0001060C* ACCORDING TO WHETHER THE SWITCH SETTING IS U1 OR NU1, OE560 01070C* THE PROPER SUBROUTINE IS EXECUTED. OE560 01080C* OE560 01090C********************************************************************OE560 01100C* OE560 01110C START TAG OE560 01120C* OE560 0001130C 01 PN CHAINPARTMST 25 OE560 01140C 01N25 DLTPR COMP ' ' 2525 OE560 01150C* OE560 01160C U1 EXSR HSTSR OE560 01170C NU1 EXSR SASR OE560 01180C FINI TAG OE560 01190C* OE560 0001200C********************************************************************OE560 01210C* OE560 01220C* THIS SUBROUTINE SUMS ALL OF THE ELEMENTS OF THE SALES OE560 01230C* HISTORY ARRAY INTO A SINGLE FIGURE, LAST12. OE560 01240C* OE560 01250C* THEN, SOLELY FOR THE PURPOSES OF THE REPORT, THE OE560 01260C* ELEMENTS OF THE SALES HISTORY ARRAY ARE ROTATED. OE560 0001270C* THE PURPOSE OF THE ROTATION IS TO HAVE THE ELEMENTS OE560 01280C* OF THE ARRAY HOLDING THE SALES FIGURES FOR THE OE560 01290C* MONTHS IN DESCENDING ORDER; ELEMENT 1 HOLDING THE SALES FIGURE OE560 01300C* FOR THE MONTH OF DECEMBER, ELEMENT 2 HOLDING THE SALES OE560 01310C* FIGURE FOR THE MONTH OF NOVEMBER, ETC. OE560 01320C* IN THIS MANNER, THE PROGRAM CAN ALWAYS PRINT OE560 01330C* OUT THE SALES FIGURES JANUARY TO DECEMBER (THE OE560 0001340C* APPROPRIATE YEAR IS PRINTED BESIDE EACH MONTH IN THE HEADINGS). OE560 01350C* THE REFERENCE MONTH FROM CONTROL GUIDES THE OE560 01360C* SUBROUTINE IN THE ROTATION OF THE ARRAY. OE560 01370C* THE ROTATION IS ACCOMPLISHED THROUGH A NESTED LOOP. OE560 01380C* EACH PASS THROUGH THE INNER LOOP MANAGES TO OE560 01390C* ROTATE THE ELEMENTS IN THE ARRAY BY ONE POSITION ONLY OE560 01400C* (EX: MOVING ARRAY,2 INTO ARRAY,1) OE560 0001410C* AND THE REFERENCE MONTH IS USED (IN THE OUTER LOOP) OE560 01420C* TO TELL THE SUBROUTINE HOW MANY TIMES IT MUST OE560 01430C* ROTATE THE ELEMENTS OF THE ARRAY. OE560 01440C* OE560 01450C********************************************************************OE560 01460C* OE560 01470CSR HSTSR BEGSR OE560 0001480C* OE560 01490CSR XFOOTTS LAST12 80 OE560 01500C* OE560 01510CSR MOVE LSTMTH MONTH OE560 01520C* OE560 01530CSR LOOP2 TAG OE560 01540C* OE560 0001550CSR MONTH SUB 1 MONTH OE560 01560CSR MONTH COMP 0 98 OE560 01570CSR 98 GOTO OUT1 OE560 01580CSR Z-ADD1 INX OE560 01590CSR MOVE TS,INX WRK7 70 OE560 01600C* OE560 01610CSR LOOP3 TAG OE560 0001620C* OE560 01630CSR INX ADD 1 IN2 20 OE560 01640CSR MOVE TS,IN2 KWATCH 70 OE560 01650CSR MOVE KWATCH TS,INX OE560 01660CSR IN2 COMP 12 98 OE560 01670CSR 98 MOVE WRK7 TS,12 OE560 01680CSR 98 GOTO LOOP2 OE560 0001690CSR MOVE IN2 INX OE560 01700CSR GOTO LOOP3 OE560 01710C* OE560 01720CSR OUT1 ENDSR OE560 01730C* OE560 01740C********************************************************************OE560 01750C* OE560 0001760C* THIS SUBROUTINE FIGURES THE % INCREASE IN SALES FROM OE560 01770C* LAST MONTH (1ST ELEMENT OF SALES ARRAY) TO THIS MONTH OE560 01780C* (MTD SALES). OE560 01790C* OE560 01800C* IT FIGURES THE % INCREASE IN SALES FROM THE OE560 01810C* CURRENT MONTH THIS YEAR (MTD SALES) COMPARED TO THE OE560 01820C* CURRENT MONTH LAST YEAR (12TH ELEMENT OF SALES ARRAY). OE560 0001830C* OE560 01840C* IT CALCULATES YTD SALES THIS YEAR = MTD SALES + OE560 01850C* VALUES FROM ALL OF THE ELEMENTS OF THE SALES ARRAY WHICH OE560 01860C* HOLD SALES FIGURES FOR MONTHS OF THE REFERENCE YEAR. OE560 01870C* IT THEN FIGURES THE % INCREASE IN SALES OF YTD SALES THIS YEAR OE560 01880C* COMPARED TO YTD SALES LAST YEAR (YTD SALES LAST YEAR). OE560 01890C* OE560 0001900C********************************************************************OE560 01910C* OE560 01920CSR SASR BEGSR OE560 01930C* OE560 01940CSR MTD SUB TS,1 WRK7 70 OE560 01950CSR WRK7 DIV TS,1 WRKPCT 53H OE560 01960CSR WRKPCT MULT 100 PCT1 41 OE560 0001970CSR WRK7 COMP 0 5051 OE560 01980CSR 50 OE560 01990COR 51 TS,1 COMP 0 52 OE560 02000CSR 50 52 Z-ADD100 PCT1 OE560 02010CSR 51 52 Z-SUB100 PCT1 OE560 02020C* OE560 02030CSR MTD SUB TS,12 WRK7 OE560 0002040CSR WRK7 DIV TS,12 WRKPCT H OE560 02050CSR WRKPCT MULT 100 PCT2 41 OE560 02060CSR WRK7 COMP 0 5051 OE560 02070CSR 50 OE560 02080COR 51 TS,12 COMP 0 52 OE560 02090CSR 50 52 Z-ADD100 PCT2 OE560 02100CSR 51 52 Z-SUB100 PCT2 OE560 0002110C* OE560 02120CSR Z-ADD0 YTDCUR 80 OE560 02130CSR MTD ADD YTDCUR YTDCUR OE560 02140CSR Z-ADD1 INX OE560 02150C* OE560 02160CSR LOOP4 TAG OE560 02170C* OE560 0002180CSR LSTMTH COMP INX 98 OE560 02190CSR 98 GOTO OUT2 OE560 02200CSR TS,INX ADD YTDCUR YTDCUR OE560 02210CSR INX ADD 1 INX OE560 02220CSR GOTO LOOP4 OE560 02230C* OE560 02240CSR OUT2 TAG OE560 0002250C* OE560 02260CSR YTDCUR SUB YTDLST WRK7 OE560 02270CSR WRK7 DIV YTDLST WRKPCT H OE560 02280CSR WRKPCT MULT 100 PCT3 41 OE560 02290CSR WRK7 COMP 0 5051 OE560 02300CSR 50 OE560 02310COR 51 YTDLST COMP 0 52 OE560 0002320CSR 50 52 Z-ADD100 PCT3 OE560 02330CSR 51 52 Z-SUB100 PCT3 OE560 02340C* OE560 02350CSR ENDSR OE560 02360C* OE560 02370C********************************************************************OE560 02380O$LP1 H 202 1P OE560 0002390O OR OF OE560 02400O PAGE Z 9 OE560 02410O 4 'PAGE' OE560 02420O HEAD,1 86 OE560 02430O UDATE Y 132 OE560 02440O H 2 1P OE560 02450O OR OF OE560 0002460O U1 77 'SALES HISTORY BY PRODUCT' OE560 02470O NU1 69 'SALES ANALYSIS BY' OE560 02480O NU1 77 'PRODUCT' OE560 02490O 132 'DIS560' OE560 02500O H 1 97 U1 OE560 02510O OR OF U1 OE560 02520O 64 'THIS MTH' OE560 0002530O 73 'JAN' OE560 02540O TD,1 76 OE560 02550O 84 'FEB' OE560 02560O TD,2 87 OE560 02570O 95 'MAR' OE560 02580O TD,3 98 OE560 02590O 106 'APR' OE560 0002600O TD,4 109 OE560 02610O 117 'MAY' OE560 02620O TD,5 120 OE560 02630O 128 'JUN' OE560 02640O TD,6 131 OE560 02650O H 2 97 U1 OE560 02660O OR OF U1 OE560 0002670O 9 'PRODUCT #' OE560 02680O 25 'DESCRIPTION' OE560 02690O 64 'LAST 12' OE560 02700O 73 'JUL' OE560 02710O TD,7 76 OE560 02720O 84 'AUG' OE560 02730O TD,8 87 OE560 0002740O 95 'SEP' OE560 02750O TD,9 98 OE560 02760O 106 'OCT' OE560 02770O TD,10 109 OE560 02780O 117 'NOV' OE560 02790O TD,11 120 OE560 02800O 128 'DEC' OE560 0002810O TD,12 131 OE560 02820O H 1 97NU1 OE560 02830O OR OFNU1 OE560 02840O 59 'CURRENT' OE560 02850O 70 'LAST' OE560 02860O 89 'CUR MTH' OE560 02870O 122 '- - Y E A R T O D A T' OE560 0002880O 128 'E - -' OE560 02890O H 2 97NU1 OE560 02900O OR OFNU1 OE560 02910O 9 'PRODUCT #' OE560 02920O 25 'DESCRIPTION' OE560 02930O 58 'MONTH' OE560 02940O 70 'MONTH' OE560 0002950O 76 '%' OE560 02960O 89 'LAST YR' OE560 02970O 95 '%' OE560 02980O 109 'THIS YR' OE560 02990O 121 'LAST YR' OE560 03000O 127 '%' OE560 03010O D 11 01 U1 OE560 0003020O PN 12 OE560 03030O N25 DESCR 39 OE560 03040O 25 38 '** NOT ON PART MASTER **' OE560 03050O MTD J 65 OE560 03060O TS,12 J 77 OE560 03070O TS,11 J 88 OE560 03080O TS,10 J 99 OE560 0003090O TS,9 J 110 OE560 03100O TS,8 J 121 OE560 03110O TS,7 J 132 OE560 03120O D 1 01 U1 OE560 03130O LAST12JB 65 OE560 03140O TS,6 J 77 OE560 03150O TS,5 J 88 OE560 0003160O TS,4 J 99 OE560 03170O TS,3 J 110 OE560 03180O TS,2 J 121 OE560 03190O TS,1 J 132 OE560 03200O D 1 01NU1 OE560 03210O PN 12 OE560 03220O N25 DESCR 39 OE560 0003230O 25 38 '** NOT ON PART MASTER **' OE560 03240O MTD J 60 OE560 03250O TS,1 J 71 OE560 03260O PCT1 J 78 OE560 03270O TS,12 J 90 OE560 03280O PCT2 J 97 OE560 03290O YTDCURJB 110 OE560 0003300O YTDLSTJ 122 OE560 03310O PCT3 J 129 OE560 03320O T 2 LR OE560 03330O 11 'END OF JOB.' OE560 ** 003340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003350ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00336000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003370/* 003380__0O T 2 LR OE560 03330O 11 'END OF JOB.' OE560 ** 003340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003350ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0033600(d j *OTXCPY1 P999999050878(0__d j *OTXCPY1 P999999050878( OE560 03330O 11 'END OF JOB.' OE560 ** 003340ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003350ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 0033600(,RF ,}TXBM145 P999999111111(000010H S BM145 00020X DECK-ID M24 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM145 00030F* PRINTS COSTED BILLS OF MATERIAL BM145 00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FBOMWRK IPEAF 56 DISK MFG14500090FPARTMST IC F 300R20AI 271 DISK MFG14500100F$LP1 O F 132 OF PRINTER MFG14500110FHEADING IT F 40 EDISK MFG14500120F* MFG14500130F* PRINTS COSTED BILLS. IF U1 IS OFF STD MATERIAL COST IS USED. MFG14500140F* U1 IS ON LAST PURCHASE COST IS USED. MFG1450000150F* MFG14500160E HEADING HEAD 1 1 40 MFG14500170IBOMWRK NS 40 5 C MFG14500180I 1 40WRKSEQL1 MFG14500190I 37 56 WRKASY MFG14500200I 20 260WRKTQT 00210I 1 40WRKSEQ MFG1450000220I NS 41 5 CX MFG14500230I 1 40WRKSEQL1 MFG14500240I 37 56 WRKPN MFG14500250I 18 190WRKLEV MFG14500260I 20 263WRKQTY MFG14500270I 27 353WRKEQT MFG14500280I NS ** MFG1450000290I 1 40NXTSEQ MFG14500300I 18 190NXTLEV MFG14500310IPARTMST NS 42 MFG14500320I 1 37 DESC MFG14500330I 38 39 UM MFG14500340I 138 1453TLHRS MFG14500350I 89 953ULAB MFG1450000360I 110 1163TLAB MFG14500370I 96 1023UBUR MFG14500380I 117 1233TBUR MFG14500390I 103 1093UOP MFG14500400I 124 1303TOP MFG14500410I 220 2250REVD MFG14500420I 219 219 REVL MFG1450000430I 75 813SUCOST MFG14500440I 82 883LUCOST MFG14500450I 51 51 ICODE MFG14500460C L1 Z-ADD0 PAGE 50 MFG14500470C L1 Z-ADD0 ITEM 30 MFG14500480C L1 Z-ADD0 GTOT 83 MFG14500490C 41 GOTO SKIP MFG1450000500C WRKASY CHAINPARTMST 25 MFG14500510C 25 GOTO END MFG14500520C MOVE DESC SDESC 37 MFG14500530C MOVE UM SUM 2 MFG14500540C MOVE ICODE SICODE 1 MFG14500550C MOVE TLHRS STLHRS 73 MFG14500560C MOVE TLAB STLAB 73 MFG1450000570C MOVE TBUR STBUR 73 MFG14500580C Z-ADDTOP STOP 83 MFG14500590C SMAT ADD STOP STOT 83 00600C STLAB ADD STOT STOT MFG14500610C STBUR ADD STOT STOT MFG14500620C ULAB ADD UBUR UTOT 83 MFG14500630C UOP ADD UTOT UTOT MFG1450000640C UTOT MULT WRKTQT XTOT H 00650C XTOT ADD GTOT GTOT MFG14500660C 40 GOTO END MFG14500670C SKIP TAG MFG14500680C WRKPN CHAINPARTMST 26 MFG14500690C NXTSEQ COMP 99 98 MFG14500700C N98 NXTSEQ COMP WRKSEQ 9898 MFG1450000710C N98 NXTLEV COMP WRKLEV 9898 MFG14500720C 26 GOTO END MFG14500730C U1 MOVE LUCOST UMAT 73 MFG14500740C NU1 MOVE SUCOST UMAT MFG14500750C UMAT ADD SMAT SMAT 73 00760C N51 UMAT ADD SMAT SMAT 73 00770C N98 ULAB ADD UOP UTOT MFG1450000780C N98 UBUR ADD UTOT UTOT MFG14500790C 98 Z-ADDUMAT UTOT MFG14500800C UTOT MULT WRKEQT XTOT 83H MFG14500810C XTOT ADD GTOT GTOT 83 MFG14500820C WRKLEV COMP 1 51 MFG14500830C WRKLEV COMP 2 52 MFG14500840C WRKLEV COMP 3 53 MFG1450000850C WRKLEV COMP 4 54 MFG14500860C WRKLEV COMP 5 55 MFG14500870C WRKLEV COMP 6 56 MFG14500880C WRKLEV COMP 7 57 MFG14500890C WRKLEV COMP 8 58 MFG14500900C WRKLEV COMP 9 60 59 MFG14500910C END TAG MFG1450000920C 41 ITEM ADD 1 ITEM MFG14500930C MOVE WRKEQT XQUAN 83 MFG14500940CL1 GTOT SUB STOT DIFF 81H9999 MFG14500950O$LP1 D 202 40 MFG14500960O OR OF MFG14500970O HEAD,1 86 MFG14500980O UDATE Y 132 MFG1450000990O PAGE Z 8 MFG14501000O 4 'PAGE' MFG14501010O D 2 40 MFG14501020O OR OF MFG14501030O 71 'COSTED BILL OF MATERIAL' MFG14501040O NU1 83 '-AT STANDARD' MFG14501050O U1 83 '-AVERAGE ' MFG1450001060O 132 'MFG145' MFG14501070O D 1 40 MFG14501080O OR OF MFG14501090O 11 'PART NUMBER' MFG14501100O 33 'DESCRIPTION' MFG14501110O 69 'UM INV' MFG14501120O D 2 40 MFG1450001130O OR OF MFG14501140O WRKASY 20 MFG14501150O SDESC 59 MFG14501160O SUM 64 MFG14501170O SICODE 68 MFG14501180O D 1 40 MFG14501190O OR OF MFG1450001191O 10 'NO. LEVEL' 01192O 26 'PART NUMBER' 01200O 62 'EXTENDED' MFG14501210O 90 '- - - - - - - - U N I T' MFG14501220O 102 'C O S T S' MFG14501230O 120 '- - - - - - - - -' MFG14501240O 132 'EXTENDED' MFG1450001250O D 2 40 MFG14501260O OR OF MFG14501285O 27 'DESCRIPTION' 01290O 76 'QUANTITY UM MATERIAL' MFG14501300O 96 'LABOR BURDEN' MFG14501310O 119 'O.P. TOTAL' MFG14501320O 131 'TOTAL' MFG1450001330O D 1 40 MFG14501340O 3 '***' MFG14501350O WRKASY 35 MFG14501355O D 2 40 01360O 28 'TOP ASSEMBLY' MFG14501370O WRKTQTKB 62 01380O SUM 65 MFG1450001390O ULAB K 87 MFG14501400O UBUR K 97 MFG14501410O UOP K 108 MFG14501420O UTOT K 120 MFG14501430O XTOT KB 132 MFG14501440O D 1 41 MFG14501450O ITEM 1 3 MFG1450001460O 51 6 'X' MFG14501470O 52 7 'XX' MFG14501480O 53 8 'XXX' MFG14501490O 54 9 'XXXX' MFG14501500O 55 10 'XXXXX' MFG14501510O 56 11 'XXXXXX' MFG14501520O 57 12 'XXXXXXX' MFG1450001530O 58 13 'XXXXXXXX' MFG14501540O 59 14 'XXXXXXXXX' MFG14501550O 60 WRKLEV 14 MFG14501560O WRKPN 35 MFG14501565O D 1 41 01570O 26 38 'NOT ON PART MASTER FILE' MFG14501580O N26 DESC 53 MFG1450001590O XQUAN L 63 MFG14501600O N26 UM 65 MFG14501610O 98 UMAT K 77 MFG14501620O ULAB K 87 MFG14501630O UBUR K 97 MFG14501640O UOP K 108 MFG14501650O UTOT JB 120 MFG1450001660O XTOT J 132 MFG14501670O T 1 L1 MFG14501680O 30 'TOTAL LABOR/UNIT' MFG14501690O STLHRS1B 39 MFG14501700O 43 'HRS' MFG14501710O 64 'EXTENDED TOTALS' MFG14501720O GTOT JB 132 0001730O T 2 L1 99 MFG14501740O 76 'UNIT COSTS NOT UPDATED' MFG14501750O T 2 L1 MFG14501760O 77 '************************' MFG145** 01770ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 01780ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0179000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 01800ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 01810/* 01820_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(dO *OTXOECPY P999999050878(000010H S OECPY100020X DECK-ID A85 MFG/DIST/ACCT SYSTEM SUMMARY-123 OECPY100030F* COPIES TEMPORARY SEQUENTIAL FILE TO PERMANENT INDEXED FILE OECPY100040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OECPY100050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OECPY100060F* CONTROL DATA PROPRIETARY PRODUCT OECPY100070F* OECPY10000080FSAMOUT IPE F 120 DISK OECPY100090FSAMAST O F 120 12AI 1 DISK OECPY100100ISAMOUT NS 01 OECPY100110I 1 120 RCD OECPY100120OSAMAST D 01 OECPY100130O RCD 120 OECPY1** 00014000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000180/* 000190__0O RCD 120 OECPY1** 0001400(S} $TXBM2ENT P0999999111111(000010H S BM2ENT00020X DECK-ID M26 MFG/DIST/ACCT SYSTEM SUMMARY-123 BM2ENT00030F* ENTER EXPLODE/IMPLODE REQUEST BM2ENT00040F* CYBER 18-10M/20 BILL OF MATERIAL PROCESSOR VERSION 1.0BM2ENT00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA BM2ENT00060F* CONTROL DATA PROPRIETARY PRODUCT BM2ENT00070F* BM2ENT0000080FBM1DUM IPE F 72 DISK BM2ENT00090FKPROGS IC F 36R 8AI 1 DISK BM2ENT00100FBM2OUT UC F 128R DISK BM2ENT00110F********************************************************************BM2ENT00120F* INDICATOR FUNCTION LIST BM2ENT00130F* 01 DUMMY RECORD BM2ENT00140F* 02 KEYPYNCH PARAMETER FILE BM2ENT0000150F* 05 KEYPUNCH DATA FILE BM2ENT00160F* 18 BM2ENT00170F* 19 BM2ENT00180F* 20 BM2ENT00190F* 21 BM2ENT00200F* 25 RETRY ON RUBOUT BM2ENT00210F* 27 AUTO DUP BM2ENT0000220F* 28 BM2ENT00230F* 29 BM2ENT00240F* 40 MODE IS A-ADD BM2ENT00250F* 41 MODE IS C-CHANGE BM2ENT00260F* 42 MODE IS V-VERIFY BM2ENT00270F* 43 MODE IS K-LOAD NEW PROGRAM FORMATS BM2ENT00280F* 44 MODE IS E-END OF JOB BM2ENT0000290F* 56 SEQ NBR NOT IN KPFILE BM2ENT00300F* 60 NEW PROGRAM NBR ONLY BM2ENT00310F* 61 AUTO DUP ONLY BM2ENT00320F* 70 BM2ENT00330F* 72 BM2ENT00340F* 73 MODE IS LESS THAN OR = 4 BM2ENT00350F* 81 MODE IS INVALID BM2ENT0000360F* 82 BAD PROG NBR BM2ENT00370F* 83 FIRST FIELD NAME BLANK BM2ENT00380F* 84 OUTPUT FIELD NAME BM2ENT00390F* 85 BM2ENT00400F* 88 SEQ NBR NOT IN KPFILE BM2ENT00410F* 90 AUTO DUP ON BM2ENT00420F* 95 BM2ENT0000430F* 98 RCD WITHIN OPERATOR LIMITS BM2ENT00440F* LR BM2ENT00450F********************************************************************BM2ENT00460E MSG 1 10 25 BM2ENT00470E SFN 80 20 BM2ENT00480E SAN 80 1 BM2ENT00490E SAD 80 1 BM2ENT0000500E SST 80 3 0 BM2ENT00510E SLN 80 2 0 BM2ENT00520E SNM 4 6 BM2ENT00530E SMX 4 2 0 BM2ENT00540E NP 4 1 0 BM2ENT00550E ARY1 1 2 50 BM2ENT00560IBM1DUM NS 01 BM2ENT0000570I 1 1 A BM2ENT00580IKPROGS NS 02 BM2ENT00590I 9 28 FN BM2ENT00600I 29 29 AN BM2ENT00610I 30 30 AD BM2ENT00620I 31 33 ST BM2ENT00630I 34 35 LN BM2ENT0000640I 36 36 DCODE BM2ENT00650IBM2OUT NS 05 BM2ENT00660I 1 128 RECORD BM2ENT00670C MOVE ' ' B72 72 BM2ENT00680C EXSR ALMTS BM2ENT00690C Z-ADDLOW SEQNO BM2ENT00700C NLR SETON LR BM2ENT0000710CLR START TAG BM2ENT00720CLR MOVEL'' WORD BM2ENT01590CLR Z-ADD1 OLN BM2ENT01600CLR Z-ADD1 ILN BM2ENT01610CLR EXSR TYPES BM2ENT0001620CLR MOVELBUFFER MODE BM2ENT01630CLR MODE COMP '4' 7373 BM2ENT01640CLR MODE COMP 'P' 60 NEW PROG#ONLY BM2ENT01650CLR MODE COMP 'D' 61 AUTO-DUP ONLY BM2ENT01660CLRN60N61N73 GOTO CHKMOD NEW 46DE BM2ENT01670CLR 73 MOVE MODE NPN 10 BM2ENT01680CLR EXSR GETPRG BM2ENT0001690CLR SETOF 606173 BM2ENT01700CLR GOTO SAMREC BM2ENT01710CLR CHKNUM TAG BM2ENT01720CLR MOVELBUFFER MODE BM2ENT01730CLR MODE COMP '@' 20 BM2ENT01740CLR 20N42 GOTO OUTREC BM2ENT01750CLR SAN,N COMP 'N' 19 BM2ENT0001760CLRN19 GOTO CHKVER BM2ENT01770CLR Z-ADDSLN,N VL 20 BM2ENT01780CLR MOVELBUFFER VAR 15 BM2ENT01790CLR EXIT SUBRAJ BM2ENT01800CLR RLABL VL BM2ENT01810CLR RLABL VAR BM2ENT01820CLR MOVELVAR BUFFER BM2ENT0001830CLR Z-ADDVL BLNGTH BM2ENT01840CLR EXSR EXCPT BM2ENT01850CLR SETOF 19 BM2ENT01860CLR CHKVER TAG BM2ENT01870CLRN42 GOTO MOVBUF BM2ENT01880CLR TBUF COMP BUFFER 2020 BM2ENT01890CLRN20 GOTO MOVBUF BM2ENT0001900CLR MOVEL'KP VERIF'WORD BM2ENT01910CLR MOVE 'Y ERROR 'WORD BM2ENT01920CLR MOVELWORD BUFFER BM2ENT01930CLR MOVE 'R' TYPE BM2ENT01940CLR Z-ADD6 MASK ONLY 'R' OR 'E'BM2ENT01950CLR EXSR CRTCOM BM2ENT01960CLR RCODE COMP 'R' 20 BM2ENT0001970CLR 20 GOTO OUTFLD BM2ENT01980CLR MOVBUF TAG BM2ENT01990CLR Z-ADDSST,N TSTRT 30 BM2ENT02000CLR Z-ADDSLN,N NCHARS 30 BM2ENT02010CLR Z-ADD1 SSTRT BM2ENT02020CLR EXIT SUBRMV BM2ENT02030CLR RLABL BUFFER BM2ENT0002040CLR RLABL SSTRT BM2ENT02050CLR RLABL RECORD BM2ENT02060CLR RLABL TSTRT BM2ENT02070CLR RLABL NCHARS BM2ENT02080CLR GOTO LOOP BM2ENT02090CLR RITDUP TAG BM2ENT02100CLR EXSR MVRECD BM2ENT0002110CLR SETON 19 BM2ENT02120CLR Z-ADDSLN,N BLNGTH BM2ENT02130CLRN27 EXSR EXCPT BM2ENT02140CLR SETOF 19 BM2ENT02150CLR GOTO MOVBUF BM2ENT02160CLR OUTREC TAG BM2ENT02170CLR SETON 187084 BM2ENT0002180CLR SETON 85 BM2ENT02190CLR EXCPT BM2ENT02200CLR EXSR EXCPT BM2ENT02210CLR SETOF 708485 BM2ENT02220CLR MOVELRECORD OLDREC128 BM2ENT02230CLR NP,PN COMP 0 72 BM2ENT02240CLRN72 GOTO NXTREC BM2ENT0002250CLR MOVE NP,PN NPN BM2ENT02260CLR EXSR GETPRG BM2ENT02270CLR SETOF 72 BM2ENT02280CLR GOTO NXTREC BM2ENT02290CLR EOJ TAG BM2ENT02300C********************************************************************BM2ENT02310C* BM2ENT0002320C* THIS SUBROUTINE BUILDS THE SUPER ARRAYS FROM THE INFORMATION BM2ENT02330C* ON KPROGS. IF 61 IS ON ALL WE DO IS CHANGE THE AUTO-DUP STATUS. BM2ENT02340C* IF 60 IS ON A NEW PROG# IS PUT INTO EFFECT. BM2ENT02350C* BM2ENT02360C********************************************************************BM2ENT02370CSR GETPRG BEGSR BM2ENT02380CSR 61 GOTO JMPOUT BM2ENT0002390CSR 72 BM2ENT02400COR 73 GOTO CHKPN BM2ENT02410CSR GETPNO TAG BM2ENT02420CSR MOVEL'PROG # -'WORD BM2ENT02430CSR Z-ADD8 OLN BM2ENT02440CSR Z-ADD1 ILN BM2ENT02450CSR EXSR TYPES BM2ENT0002460CSR MOVELBUFFER NPN 10 BM2ENT02470CSR CHKPN TAG BM2ENT02480CSR NPN COMP 0 2020 BM2ENT02490CSRN20 NPN COMP 4 20 BAD PROG# BM2ENT02500CSR 20 SETON 82 BM2ENT02510CSR 82 EXSR EXCPT BM2ENT02520CSR SETOF 82 BM2ENT0002530CSR 20 GOTO GETPNO TRY PROG# AGAINBM2ENT02540CSR MOVE NPN PN 10 INBM2ENT02550CSR MOVE PN NAME10 10 BM2ENT02560CSRN43 SNM,PN COMP ' ' 6060 BM2ENT02570CSR 60 PN SUB 1 BP 20 BM2ENT02580CSR 60 BP MULT 20 BP BM2ENT02590CSR 72 GOTO SETHED BM2ENT0002600CSR 73 GOTO JMPOUT BM2ENT02610CSR 60 GOTO JMPOUT BM2ENT02620CSR GETPNM TAG BM2ENT02630CSR MOVEL'PROG NAM'WORD BM2ENT02640CSR MOVE 'E - 'WORD BM2ENT02650CSR Z-ADD11 OLN BM2ENT02660CSR Z-ADD6 ILN BM2ENT0002670CSR EXSR TYPES BM2ENT02680CSR MOVELBUFFER PNAME 8 BM2ENT02690CSR MOVE ' ' PNAME BM2ENT02700CSR CHNPRG TAG BM2ENT02710CSR PNAME CHAINKPROGS 27 BM2ENT02720CSRN27 MOVELPNAME SNM,PN BM2ENT02730CSRN27 GOTO LOADIT BM2ENT0002740CSR MOVEL' 'WORD BM2ENT02750CSR MOVELPNAME WORD BM2ENT02760CSR MOVE 'ABSENT 'WORD BM2ENT02770CSR MOVE 'R' TYPE 1 BM2ENT02780CSR MOVELWORD BUFFER BM2ENT02790CSR Z-ADD7 MASK 10 BM2ENT02800CSR Z-ADD16 BLNGTH BM2ENT0002810CSR EXSR CRTCOM BM2ENT02820CSR RCODE COMP 'E' 20 BM2ENT02830CSR PRGMT TAG BM2ENT02840C*R 20 EXSR PROGMT BM2ENT02850C*R 20 GOTO CHNPRG BM2ENT02860CSR GOTO GETPNM BM2ENT02870CSR LOADIT TAG BM2ENT0002880CSR Z-ADD14 OLN BM2ENT02890CSR Z-ADD1 ILN BM2ENT02900CSR MOVEL'NEXT PRO'WORD BM2ENT02910CSR MOVE 'G # - 'WORD BM2ENT02920CSR EXSR TYPES BM2ENT02930CSR MOVELBUFFER NP,PN BM2ENT02940CSR PN SUB 1 BP BM2ENT0002950CSR BP MULT 20 BP BM2ENT02960CSR BP ADD 1 N 20 BM2ENT02970CSR Z-ADD1 X 20 BM2ENT02980CSR BLDARY TAG BM2ENT02990CSR FN COMP B72 20 BM2ENT03000CSR 20 N SUB 1 MAXFLD 20 BM2ENT03010CSR 20 MOVE MAXFLD SMX,PN BM2ENT0003020CSR 20 GOTO JMPOUT BM2ENT03030CSR MOVE FN SFN,N FIELD NAME BM2ENT03040CSR MOVE AN SAN,N ALPHA OR NUMER BM2ENT03050CSR MOVE AD SAD,N AUTO DUP BM2ENT03060CSR MOVE ST SST,N START POSITION BM2ENT03070CSR MOVE LN SLN,N BM2ENT03080CSR MVX TAG BM2ENT0003090CSR MOVE X PNAME BM2ENT03100CSR PNAME CHAINKPROGS 20 BM2ENT03110CSR X ADD 1 X BM2ENT03120CSRN20 X COMP 20 20 BM2ENT03130CSR 20 Z-ADDN MAXFLD BM2ENT03140CSR 20 MOVE MAXFLD SMX,PN BM2ENT03150CSR DCODE COMP 'D' 21 BM2ENT0003160CSR 21N20 GOTO MVX BM2ENT03170CSRN20 N ADD 1 N BM2ENT03180CSRN20 GOTO BLDARY BM2ENT03190CSR JMPOUT TAG BM2ENT03200CSR 43 GOTO ENDGET BM2ENT03210CSR 41 GOTO SETHED BM2ENT03220CSR MOVEL'AUTO-DUP'WORD BM2ENT0003230CSR MOVE ' - 'WORD BM2ENT03240CSR Z-ADD11 OLN BM2ENT03250CSR Z-ADD1 ILN BM2ENT03260CSR EXSR TYPES BM2ENT03270CSR MOVELBUFFER AUTO 1 BM2ENT03280CSR AUTO COMP 'O' 90AUTO-DUP ON BM2ENT03290CSR SETHED TAG BM2ENT0003300CSR MOVELSNM,PN NAME10 BM2ENT03310CSR MOVELNAME10 WORD BM2ENT03320CSR MOVE SMX,PN MAXFLD 20 BM2ENT03330CSR 90 MOVE ' ON' WORD BM2ENT03340CSRN90 MOVE 'OFF' WORD BM2ENT03350CSR MOVELWORD HEAD 40 BM2ENT03360CSR ENDGET ENDSR BM2ENT0003370C********************************************************************BM2ENT03380C* BM2ENT03390C* THIS SUBROUTINE GETS THE RELATIVE RECORD NUMBER FOR THE FIRST BM2ENT03400C* RECORD TO BE ADDED OR VERIFIED, OR THE RRN OF THE RECORD TO BE BM2ENT03410C* CHANGED BM2ENT03420C* BM2ENT03430C********************************************************************BM2ENT0003440CSR GETSEQ BEGSR BM2ENT03450CSR MOVEL'SEQ # - 'WORD BM2ENT03460CSR Z-ADD8 OLN BM2ENT03470CSR Z-ADD5 ILN BM2ENT03480CSR EXSR TYPES BM2ENT03490CSR Z-ADD5 VL BM2ENT03500CSR MOVELBUFFER VAR BM2ENT0003510CSR EXIT SUBRAJ BM2ENT03520CSR RLABL VL BM2ENT03530CSR RLABL VAR BM2ENT03540CSR MOVELVAR SEQNO BM2ENT03550CSR SEQNO COMP 0 20 BM2ENT03560CSRN20 Z-ADD1 SEQNO BM2ENT03570CSR SETON 95 BM2ENT0003580CSR ENDSEQ ENDSR BM2ENT03590C********************************************************************BM2ENT03600C* BM2ENT03610C* THIS SUBROUTINE READS THE KPFILE AT THE CURRENT SEQNO BM2ENT03620C* BM2ENT03630C********************************************************************BM2ENT03640CSR GETREC BEGSR BM2ENT0003650CSR SEQRD TAG BM2ENT03660CSR EXSR TSTSEQ BM2ENT03670CSR 94 EXSR GETSEQ BM2ENT03680CSR 94 GOTO SEQRD BM2ENT03690CSR SEQNO CHAINBM2OUT 56 BM2ENT03700CSR MOVELRECORD TST 2 BM2ENT03710CSR TST COMP '<>' 99 BM2ENT0003720CSR 40N99 SEQNO ADD 1 SEQNO BM2ENT03730CSR 40N99 GOTO SEQRD BM2ENT03740CSR 41 99 EXSR NOCHG BM2ENT03750CSR 41 99 GOTO SEQRD BM2ENT03760CSR 56 SETON 88 BM2ENT03770CSR 88 EXSR EXCPT BM2ENT03780CSR SETOF 88 BM2ENT0003790CSR 56 EXSR GETSEQ BM2ENT03800CSR 56 GOTO SEQRD BM2ENT03810CSR ENDSR BM2ENT03820C********************************************************************BM2ENT03830C* BM2ENT03840C* THIS SUBROUTINE CALLS CRTCOM WITH AN 'S' THEN AN 'A' A RETRY BM2ENT03850C* IS DONE IF A RUBOUT IS USED BM2ENT0003860C* BM2ENT03870C********************************************************************BM2ENT03880CSR TYPES BEGSR BM2ENT03890CSR OVER TAG BM2ENT03900CSR Z-ADDOLN BLNGTH BM2ENT03910CSR MOVELWORD BUFFER BM2ENT03920CSR MOVE 'S' TYPE BM2ENT0003930CSR EXSR CRTCOM BM2ENT03940CSR MOVE 'A' TYPE BM2ENT03950CSR Z-ADDILN BLNGTH BM2ENT03960CSR EXSR CRTCOM BM2ENT03970CSR RCODE COMP 'R' 25 BM2ENT03980CSR 25 EXSR SKIP BM2ENT03990CSR 25 GOTO OVER BM2ENT0004000CSR RCODE COMP 'O' 25 BM2ENT04010CSR 25 EXSR SKIP BM2ENT04020CSR ENDSR BM2ENT04030C********************************************************************BM2ENT04040C* BM2ENT04050C* THIS SUBROUTINE SKIPS TO NEXT LINE ON CRT BM2ENT04060C* BM2ENT0004070C********************************************************************BM2ENT04080CSR SKIP BEGSR BM2ENT04090CSR MOVELBUFFER NBUF 1 BM2ENT04100CSR MOVEL' ' BUFFER BM2ENT04110CSR Z-ADD1 BLNGTH BM2ENT04120CSR MOVE 'T' TYPE BM2ENT04130CSR EXSR CRTCOM BM2ENT0004140CSR MOVELNBUF BUFFER BM2ENT04150CSR ENDSR BM2ENT04160C********************************************************************BM2ENT04170C* BM2ENT04180C* BM2ENT04190C* THIS SUBROUTINE MOVES THE PORTION OF RECORD SPECIFIED BM2ENT04200C* BY SLN,N AND SST,N TO THE FIRST SLN,N CHARS OF BUFFER BM2ENT0004210C* BM2ENT04220CSR MVRECD BEGSR BM2ENT04230CSR MOVELB72 BUFFER BM2ENT04240CSR Z-ADD1 TSTRT BM2ENT04250CSR Z-ADDSST,N SSTRT BM2ENT04260CSR Z-ADDSLN,N NCHARS BM2ENT04270CSR EXIT SUBRMV BM2ENT0004280CSR RLABL OLDREC BM2ENT04290CSR RLABL SSTRT 30 BM2ENT04300CSR RLABL BUFFER BM2ENT04310CSR RLABL TSTRT 30 BM2ENT04320CSR RLABL NCHARS 30 BM2ENT04330CSR ENDSR BM2ENT04340C********************************************************************BM2ENT0004350CSR EXCPT BEGSR BM2ENT04360CSRN81N82N83 BM2ENT04370CANN84N88 GOTO PUTOUT BM2ENT04380CSR MOVELB72 BUFFER BM2ENT04390CSR 81 MOVELMSG,1 BUFFER BM2ENT04400CSR 83 MOVELMSG,2 BUFFER BM2ENT04410CSR 88 MOVELMSG,3 BUFFER BM2ENT0004420CSR 82 MOVELMSG,4 BUFFER BM2ENT04430CSRN84 GOTO PUTOUT BM2ENT04440CSRN85 MOVELSFN,N BUFFER BM2ENT04450CSRN18 Z-ADD20 BLNGTH BM2ENT04460CSRN18 GOTO PUTOUT BM2ENT04470CSR MOVELHEAD BUFFER BM2ENT04480CSR MOVE 'T' TYPE BM2ENT0004490CSR Z-ADD69 BLNGTH BM2ENT04500CSR EXSR CRTCOM BM2ENT04510CSR MOVELSFN,N BUFFER BM2ENT04520CSR Z-ADD20 BLNGTH BM2ENT04530CSR PUTOUT TAG BM2ENT04540CSR MOVE 'S' TYPE BM2ENT04550CSR EXSR CRTCOM BM2ENT0004560CSR ENDSR BM2ENT04570C* BM2ENT04580CSR ALMTS BEGSR BM2ENT04590CSR MOVE 'C' TYPE 1 BM2ENT04600CSR Z-ADD0 BLNGTH 20 BM2ENT04610CSR MOVE ' ' RCODE 1 BM2ENT04620CSR Z-ADD0 MASK 10 BM2ENT0004630CSR Z-ADD0 DTYPE 10 BM2ENT04640CSR EXSR CRTCOM BM2ENT04650CSR MOVELARY1,1 BUFFER BM2ENT04660CSR MOVE 'S' TYPE BM2ENT04670CSR Z-ADD50 BLNGTH BM2ENT04680CSR EXSR CRTCOM BM2ENT04690CSR MOVE 'A' TYPE BM2ENT0004700CSR Z-ADD5 BLNGTH BM2ENT04710CSR Z-ADD1 DTYPE BM2ENT04720CSR EXSR CRTCOM BM2ENT04730CSR EXSR SKIP BM2ENT04740CSR RCODE COMP 'R' 86 BM2ENT04750CSR Z-ADD5 VL BM2ENT04760CSR MOVELBUFFER VAR BM2ENT0004770CSR EXIT SUBRAJ BM2ENT04780CSR RLABL VL BM2ENT04790CSR RLABL VAR BM2ENT04800CSR MOVELVAR BUFFER BM2ENT04810CSR MOVELBUFFER LOW 50 BM2ENT04820CSR MOVELARY1,2 BUFFER BM2ENT04830CSR MOVE 'S' TYPE BM2ENT0004840CSR Z-ADD50 BLNGTH BM2ENT04850CSR EXSR CRTCOM BM2ENT04860CSR MOVE 'A' TYPE BM2ENT04870CSR Z-ADD5 BLNGTH BM2ENT04880CSR Z-ADD1 DTYPE BM2ENT04890CSR EXSR CRTCOM BM2ENT04900CSR RCODE COMP 'R' 87 BM2ENT0004910CSR Z-ADD5 VL BM2ENT04920CSR MOVELBUFFER VAR BM2ENT04930CSR EXIT SUBRAJ BM2ENT04940CSR RLABL VL BM2ENT04950CSR RLABL VAR BM2ENT04960CSR MOVELVAR BUFFER BM2ENT04970CSR MOVELBUFFER HIGH 50 BM2ENT0004980CSR MOVE 'C' TYPE BM2ENT04990CSR EXSR CRTCOM BM2ENT05000CSR 86 BM2ENT05010COR 87 GOTO ALMTS BM2ENT05020CSR Z-ADD0 DTYPE BM2ENT05030CSR ENDSR BM2ENT05040CSR CRTCOM BEGSR BM2ENT0005050CSR EXITFSUBRCM BM2ENT05060CSR RLABL BUFFER BM2ENT05070CSR RLABL TYPE BM2ENT05080CSR RLABL BLNGTH BM2ENT05090CSR RLABL RCODE BM2ENT05100CSR RLABL MASK BM2ENT05110CSR RLABL DTYPE BM2ENT0005120CSR ENDSR BM2ENT05130CSR PUTSEQ BEGSR BM2ENT05140CSR MOVELMSG,5 BUFFER 72 BM2ENT05150CSR MOVE 'S' TYPE BM2ENT05160CSR Z-ADD25 BLNGTH BM2ENT05170CSR EXSR CRTCOM BM2ENT05180CSR MOVELSEQNO BUFFER BM2ENT0005190CSR MOVE 'T' TYPE BM2ENT05200CSR Z-ADD5 BLNGTH BM2ENT05210CSR EXSR CRTCOM BM2ENT05220CSR ENDSR BM2ENT05230CSR TSTSEQ BEGSR BM2ENT05240CSR SETOF 949697 BM2ENT05250CSR SEQNO COMP LOW 989698 BM2ENT0005260CSR 98 SEQNO COMP HIGH 979898 BM2ENT05270CSR 98 GOTO ENDTST BM2ENT05280CSR 40 96 MOVELMSG,6 BUFFER BM2ENT05290CSR 40 97 MOVELMSG,7 BUFFER BM2ENT05300CSRN40 MOVELMSG,8 BUFFER BM2ENT05310CSRN40 SETON 94 BM2ENT05320CSR MOVE 'T' TYPE BM2ENT0005330CSR Z-ADD25 BLNGTH BM2ENT05340CSR EXSR CRTCOM BM2ENT05350CSR 40 97 MOVE 'F' TYPE BM2ENT05360CSR 40 97 EXSR CRTCOM BM2ENT05370CSR ENDTST ENDSR BM2ENT05380CSR NOCHG BEGSR BM2ENT05390CSR MOVELMSG,9 BUFFER BM2ENT0005400CSR MOVE 'T' TYPE BM2ENT05410CSR Z-ADD25 BLNGTH BM2ENT05420CSR EXSR CRTCOM BM2ENT05430CSR EXSR GETSEQ BM2ENT05440CSR ENDSR BM2ENT05450C********************************************************************BM2ENT05460OBM2OUT E 70N56 BM2ENT0005470O RECORD 128 BM2ENT05480O 42 128 'X' BM2ENT05490O SEQNO 127 BM2ENT** 005500ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005510ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005520ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 00553000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005540** 005550MODE MUST BE A,C,V,OR E 005560FIRST FIELD NAME BLANK 005570INVALID SEQ # 005580PROG# MUST BE FROM 1-4 005590CURRENT SEQUENCE NBR 00560000SEQNO TOO LOW 005610RUN EDIT PROG-FILE FULL 005620SEQNO NOT IN YOUR LIMITS 005630ILLEGAL CHANGE-NO DATA 005640** 005650ENTER BEGINNING RELATIVE RECORD NUMBER 005660ENTER ENDING RELATIVE RECORD NUMBER 00567000/* 005680_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00__ 0(LU LOTXOE110 P999999050978(000010H S OE110 00020X DECK-ID A59 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE110 00030F* THIS IS THE ORDER ENTRY PROGRAM OE110 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE110 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE110 00060F* CONTROL DATA PROPRIETARY PRODUCT OE110 00070F* OE110 0000080FDUMMY IPEAF 72 DISK OE110 00090FDISPR1 IC F 32R DISK OE110 00100FARMAST IC F 280R 6AI 1 DISK OE110 00110FPARTMST UC F 300R12AI 1 DISK OE110 00120FSLSMAN IC F 30R 3AI 1 DISK OE110 00130FAREA IC F 30R 2AI 1 DISK OE110 00140FTERMS IC F 30R 1AI 1 DISK OE110 0000150FSOTEMP UC F 9R 7AI 1 DISK A OE110 00160FOPNORDS UC F 118R 8AI 106 DISK A OE110 00170F********************************************************************OE110 00180F* PACKAGE-DISTRIBUTION CONTRACTOR-COMPUSOURCE OE110 00190F* OE110 00200F* SYSTEM-SALES ORDER PROCESSING BY- GAIL KARON/ROBBIE FREEMAN OE110 00210F* OE110 0000220F* PROGRAM-DIS110 DATE- 8/15/76 OE110 00230F********************************************************************OE110 00240F* DIS110 IS THE ORDER ENTRY PROGRAM. OE110 00250F* IT OUTPUTS HEADER RECORDS, SHIP-TO LINES, COMMENT LINES, OE110 00260F* INVOICE LINES, AND LINE ITEMS TO ORDINP OR INVDIR DEPENDING OE110 00270F* ON THE ORDER TYPE. ALL GOOD SALES ORDER NUMBERS ARE OUTPUT OE110 00280F* TO SOTEMP. OE110 0000290F********************************************************************OE110 00300F* FUNCTION OF INDICATORS OE110 00310F* OE110 00320F* 01 RECORD FROM DUMMY--NO RECORDS EXIST IN THIS FILE OE110 00330F* 02 ORDPR1 RECORD--PARAMETER FILE RECORDS OE110 00340F* 04 RECORD FROM ARMAST--CHAIN TO IT OE110 00350F* 05 RECORD FROM OPNINDX--CHAIN TO IT OE110 0000360F* 06 RECORD FROM PARTMST--CHAIN TO IT OE110 00370F* 07 RECORD FROM SOTEMP--CHAIN TO IT OE110 00380F* 08 RECORD FROM SLSMAN--CHAIN TO IT OE110 00390F* 09 RECORD FROM AREA----CHAIN TO IT OE110 00400F* 10 RECORD FROM TERMS---CHAIN TO IT OE110 00410F* 20 RECRDS SUBROUTINE--ORDER TYPE IS BLANK--SALES ORDER OE110 00420F* OUTPUT RECORDS TO ORDINP OE110 0000430F* 21 RECRDS SUBROUTINE--ORDER TYPE IS C--CREDIT MEMO OE110 00440F* 22 RECRDS SUBROUTINE--ORDER TYPE IS D--DIRECT BILL OE110 00450F* 23 RECRDS SUBROUTINE--ORDER TYPE IS M--MANUAL INVOICE OE110 00460F* OUTPUT RECORDS TO INVDIR OE110 00470F* 25 OUTPUT TO SOTEMP OE110 00480F* OUTPUT HEADER, SHIP, COMMENT, INVOICE RECORDS OE110 00490F* 26 OUTPUT LINE ITEMS RECORDS OE110 0000500F* 30 OUTFLD SUBROUTINE-LEN = 0, IT'S A MESSAGE OE110 00510F* UPDATE SUBROUTINE--N73=TRY ANOTHER X OE110 00520F* -- 73=BEGIN AT X=7 AGAIN OE110 00530F* ACCEPT SUBROUTINE-IS X OUT OF SECTN SIZE RANGE OE110 00540F* -@ SIGN--LEAVE SUBROUTINE OE110 00550F* 31 OUTPUT SUBROUTINE--COMP NOFLDS TO CONTINUE LOOP OE110 00560F* OUTFLD SUBROUTINE--COMP CONSTANT LENGTH(FL) TO OE110 0000570F* END POS OF FIELD(FC)--LEN IS NEGATIVE IMPLIES OE110 00580F* THE FIELD IS NUMERIC OE110 00590F* UPDATE SUBROUTINE--RUBOUT AT FIRST CHARACTER OF OE110 00600F* FIELD IS NOT AT FIRST UPDATE ON SCREEN-CONTINUE OE110 00610F* THE LOOP OE110 00620F* ACCEPT SUBROUTINE--RCODE IS 'R'--RUBOUT OE110 00630F* 32 BODY OF PROGRAM--RUBOUT AT FIRST UPDATE FIELD-GO OE110 0000640F* TO PRIOR SCREEN OE110 00650F* GETSEC SUBROUTINE--X GREATER THAN SECTN SIZE OE110 00660F* UPDATE SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE110 00670F* ACCEPT SUBROUTINE--RUBOUT AT BEGINNING OF FIELD OE110 00680F* 33 UPDATE & ACCEPT SUBROUTINE--LINE FEED THROUGH FIELD OE110 00690F* 34 ACCEPT SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE110 00700F* 35 UPDATE SUBROUTINE--@ AT BEGINNING OF FIELD OE110 0000710F* 37 LNGTH SUBROUTINE--LEN IS NEG--REVERSE THE SIGN OE110 00720F* 40 END-OF-JOB CONDITION OE110 00730F* 41 GETSEC SUBROUTINE--FIELDN & CURPOS BLANK OE110 00740F* MEANS END OF THAT SECTION IN PARAMETER FILE OE110 00750F* 42 'WHAT SCREEN?' = 2--GOTO SHIPTO SCREEN AFTER HEADER OE110 00760F* 43 'WHAT SCREEN?' = 3--GOTO COMENT SCREEN AFTER HEADER OE110 00770F* N42N43 GOTO LINE ITEMS AFTER HEADER. OE110 0000780F* 50 RRN CHAIN TO PARAMETER FILE--NO MORE RECORDS OE110 00790F* 58 BATCH SUBROUTINE--BATCHES OUT OF BALANCE OE110 00800F* 59 USED IN GET2, POSLIN, EDIT, & BATCH SUBROUTINES OE110 00810F* USED FOR COMPARISIONS TO CONTINUE LOOPS, ETC. OE110 00820F* 60 EDIT SUBROUTINE--OUTPUT PARTMST DESC & PRICE OE110 00830F* 64 RESPONE TO 'OK ?' IS 'R'--GO BACK TO LINE ITEMS OE110 00840F* 65 'WHAT LINE ?' = Y --SKIP TOTALS BUT OUTPUT ORDER OE110 0000850F* 66 'WHAT LINE ?' = T --GO TO TOTALS SECTION (BATCH TOT)OE110 00860F* 67 'WHAT LINE ?' = @ OR IN SOME CASES R OE110 00870F* DO ANOTHER LINE ITEM SCREEN--GO FORWARD OR BACK OE110 00880F* 68 'WHAT LINE ?' = R AND IT'S THE FIRST SCREEN OE110 00890F* GO BACK TO COMMENT SCREEN. OE110 00900F* 69 'OK?' OR 'WHAT LINE?' = N--DON'T OUTPUT RECORDS OE110 00910F* 70 SCREEN IS HEADER OE110 0000920F* 71 SCREEN IS SHIP OE110 00930F* 72 SCREEN IS MARK FOR COMMENTS OE110 00940F* 73 SCREEN IS LINE ITEMS OE110 00950F* 74 SCREEN IS BATCH TOTAL OE110 00960F* 76 LINE ITEM TYPE JUST ENTERED IS BLANK OE110 00970F* 77 LINE ITEM TYPE JUST ENTERED IS L--LINE OE110 00980F* 78 LINE ITEM TYPE JUST ENTERED IS C--LINE COMMENT OE110 0000990F* 83 XTYPE SUBROUTINE--SECTN 3,X=7 WHAT LINE ? OE110 01000F* 84 XTYPE SUBROUTINE--SECTN 3,X=8 TYPE OE110 01010F* 85 XTYPE SUBROUTINE--SECTN 3,X=9 PRODUCT # OE110 01020F* 86 XTYPE SUBROUTINE--SECTN 3,X=10 QUANTITY OE110 01030F* 87 XTYPE SUBROUTINE--SECTN 3,X=11 PRICE OVERRIDE OE110 01040F* 88 XTYPE SUBROUTINE--SECTN 3,X=12 LINE COMMENT OE110 01050F* 90 LINE ITEM SCREEN IS IN 'WHAT LINE?' MODE OE110 0001060F* 96 EDIT SUBROUTINE--ERROR EXISTS OE110 01070F* 97 EDIT SUBROUTINE--GOTO CORRECT TAG OE110 01080F* LR LAST RECORD--BODY OF PROGRAM LOOPS THROUGH LR CALCS OE110 01090F* AVAILABLE INDICATORS----03,05,11-19,24,27,29,36,38-39,44-OE110 01100F* 51-57,75,79-82,89,91-95,98 OE110 01110F* 99 ERROR ROUTINE COMPARISION OE110 01120E********************************************************************OE110 0001130E FN 21 22 FIELD NAME OE110 01140E CP 21 4 CURSOR POSITION OE110 01150E LN 21 2 0 LENGTH OE110 01160E EP 21 3 0 ENDING POSITION OE110 01170E PB 5 7 3 PARTMST PRICES OE110 01180E TABD 12 12 2 0 TABE 2 0 MONTH/DAY TABLE OE110 01190E LC 36 44 LINE/COMMENT ARY OE110 0001200E POV 36 1 PRICE OVRD CHECK OE110 01210E MS 1 4 62 MESSAGE ARRAY OE110 01220E TABA 1 20 3 0 TABB 30 ERROR MESSAGES OE110 01230E* OE110 01240E* TABA CONTAINS SECTION NUMBER AND X COORDINATE TO BE EDITED OE110 01250E* TABB CONTAINS CURPOS AND ERROR MESSAGE OE110 01260E* OE110 0001270E* LC 1ST CHARACTER CONTAINS THE TYPE (L,C). OE110 01280E* THIS DEFINES USE OF REMAINDER OF ARRAY. OE110 01290E* LC ARRAY IS SET UP TO HANDLE PRODUCT #, QTY, & PRICE OVERRIDE OE110 01300E* IF THE TYPE IS 'L' OE110 01310E* PRODUCT # IS IN LOCATIONS 3-14 OE110 01320E* QUANTITY IS IN LOCATIONS 16-22 OE110 01330E* PRICE OVERRIDE IS IN LOCATIONS 33-39 OE110 0001340E* BIN IS IN LOCATIONS 40-44 OE110 01350E* LC ARRAY IS SET UP TO HANDLE LINE ITEM COMMENTS OE110 01360E* IF THE TYPE IS 'C' OE110 01370E* COMMENT IS IN LOCATIONS 2-39 OE110 01380E* INFORMATION IS MOVED AROUND BY SUBRMV & MOVE STATEMENTS. OE110 01390E********************************************************************OE110 01400IDUMMY NS 01 OE110 0001410I 1 1 A OE110 01420IDISPR1 NS 02 OE110 01430I 1 22 FIELDN OE110 01440I 23 26 CURPOS OE110 01450I 27 280LNGTHA OE110 01460I 29 310ENDPOS OE110 01470I 32 320SET OE110 0001480IARMAST NS 04 OE110 01490I 7 30 NAME OE110 01500I 31 54 ADR1 OE110 01510I 55 78 ADR2 OE110 01520I 79 91 CITY OE110 01530I 92 93 STCODE OE110 01540I 94 980ZIP OE110 0001550I 94 98 AZIP OE110 01560I 115 115 DCODE OE110 01570I 161 1610PC OE110 01580IPARTMST NS 06 OE110 01590I 13 37 DESC OE110 01600I 74 74 DPCODE OE110 01610I 226 260 PB OE110 0001620I 261 265 BIN OE110 01630I 146 1520SOH OE110 01640I 167 1730SALLOC OE110 01650IOPNORDS NS 05 OE110 01660I 1 1 A OE110 01670ISOTEMP NS 07 OE110 01680I 1 1 A OE110 0001690ISLSMAN XX 08 OE110 01700I 4 28 SNAME OE110 01710I 30 30 DLTSMN OE110 01720IAREA XX 09 OE110 01730I 3 27 ANAME OE110 01740I 30 30 DLTARA OE110 01750ITERMS XX 10 OE110 0001760I 2 26 TNAME OE110 01770I 30 30 DLTTRM OE110 01780C********************************************************************OE110 01790C* BODY OF PROGRAM IS SUBROUTINES. OE110 01800C* ORDER IS AS FOLLOWS : NAME OF SUBROUTINE : OE110 01810C* 1 BLANK FIELDS AND ARRAYS BLANK OE110 01820C* 2 HEADER INFORMATION BODY--70 ON--SECTN 0 OE110 0001830C* 3 SHIP-TO LINES BODY--71 ON--SECTN 1 OE110 01840C* 4 MARK FOR COMMENT LINES BODY--72 ON--SECTN 2 OE110 01850C* 5 LINE ITEMS AND COMMENTS BODY--73 ON--SECTN 3 OE110 01860C* 6 BATCH TOTALS BODY--74 ON--SECTN 4 OE110 01870C* 7 OUTPUT RECORDS RECRDS OE110 01880C* THE USER WILL BE ABLE TO SKIP FORWARD AND BACKWARD THROUGH OE110 01890C* SUBROUTINES 2-6. OE110 0001900C* RECORDS WILL BE OUTPUT ONLY IF THE USER SAID TO OUTPUT OE110 01910C* THE ORDER. OE110 01920C********************************************************************OE110 01930C SETON LR OE110 01940CLR Z-ADD36 UPPER 20 SET LINE-ITEM OE110 01950CLR MOVE UPPER UPPERA 2 LIMITS OE110 01960CLR Z-ADD21 SSIZE 20 OE110 0001970CLR Z-ADD05 NSECT 20 OE110 01980CLR MOVE ' ' RCODE OE110 01990CLR MOVE B118 B118 118 OE110 02000CLR MOVE B72 B72 72 BLANK FIELD OE110 02010CLR MOVE B39 B39 39 BLANK FIELD OE110 02020CLR MOVE B26 B26 26 BLANK FIELD OE110 02030CLR MOVE B22 B22 22 BLANK FIELD OE110 0002040CLR MOVE B12 B12 12 BLANK FIELD OE110 02050CLR Z-ADD0 DTYPE 10 OE110 02060C* OE110 02070CLR BEGIN TAG OE110 02080CLR EXSR BLANK OE110 02090C* OE110 02100CLR SUB0 TAG OE110 0002110CLR SETON 70 HEADER RECORD OE110 02120CLR Z-ADD0 SECTN 10 OE110 02130CLR EXSR BODY OE110 02140CLR SETOF 70 OE110 02150CLR MOVELRECORD HEADER OE110 02160CLR 32 GOTO SUB0 OE110 02170CLR 40 EXSR CLRSCR OE110 0002180CLR 40 GOTO STOP OE110 02190CLR 42 GOTO SUB1 OE110 02200CLR 43 GOTO SUB2 OE110 02210CLR GOTO SUB3 OE110 02220C* OE110 02230CLR SUB1 TAG OE110 02240CLR SETON 71 SHIP-TO RECORD OE110 0002250CLR Z-ADD1 SECTN OE110 02260CLR EXSR BODY OE110 02270CLR SETOF 71 OE110 02280CLR MOVELRECORD SHIP OE110 02290CLR 32 GOTO SUB0 OE110 02300C* OE110 02310CLR SUB2 TAG OE110 0002320CLR SETON 72 COMMENT RECORD OE110 02330CLR Z-ADD2 SECTN OE110 02340CLR EXSR BODY OE110 02350CLR SETOF 72 OE110 02360CLR MOVELRECORD COMENT OE110 02370CLR 32 GOTO SUB1 OE110 02380C* OE110 0002390CLR SUB3 TAG OE110 02400CLR SETON 73 LINE ITEMS OE110 02410CLR Z-ADD3 SECTN OE110 02420CLR EXSR BODY OE110 02430CLR SETOF 73 OE110 02440CLR 68 GOTO SUB2 OE110 02450CLR 65 SKIP BATCH OE110 0002460COR 69 GOTO NOTOTS TOTALS OE110 02470C* OE110 02480CLR SUB4 TAG OE110 02490CLR SETON 74 BATCH TOTALS OE110 02500CLR Z-ADD4 SECTN OE110 02510CLR EXSR BODY OE110 02520CLR SETOF 74 OE110 0002530CLR 32 OE110 02540COR 64 GOTO SUB3 OE110 02550CLR NOTOTS TAG OE110 02560CLRN69 EXSR RECRDS OE110 02570CLR GOTO BEGIN OE110 02580C* OE110 02590CLR STOP TAG OE110 0002600C********************************************************************OE110 02610C* THIS SUBROUTINE BLANKS ALL FIELDS AND ARRAYS USED DURING OE110 02620C* OUTPUT. THIS IS DONE ONLY AT THE BEGINNING OF EACH NEW ORDER. OE110 02630C********************************************************************OE110 02640CSR BLANK BEGSR OE110 02650CSR MOVE B118 HEADER118 BLNK HEADER OE110 02660CSR MOVE B118 SHIP 118 BLNK SHIP OE110 0002670CSR MOVE B118 COMENT118 BLNK COMMENT OE110 02680CSR MOVE B118 RECORD BLNK RT RECORD OE110 02690CSR MOVE B118 LC BLNK LC ARRAY OE110 02700CSR MOVE B118 POV BLNK CHECK ARY OE110 02710CSR Z-ADD0 SPC 10 SAVE PRICE COD OE110 02720CSR Z-ADD0 OPC 10 OVRD PRICE COD OE110 02730CSR Z-ADD0 BQTY BATCH QTY OE110 0002740CSR Z-ADD0 BPR BATCH PRICE OV OE110 02750CSR SETOF 90 OE110 02760CSR SETOF 58 RESET OE110 02770C* BATCH ERROR OE110 02780C* INDICATOR OE110 02790CSR ENDSR OE110 02800C********************************************************************OE110 0002810C* THIS SUBROUTINE HANDLES THE FOUR DIFFERENT SCREENS THAT OE110 02820C* ARE DISPLAYED. OE110 02830C* IT DOES THE FOLLOWING : OE110 02840C* CLEARS THE SCREEN OE110 02850C* LOADS THE PARAMETER FILE SECTION INTO ARRAYS OE110 02860C* OUTPUTS THE SCREEN OE110 02870C* ALLOWS THE INFORMATION ON THE SCREEN TO BE UPDATED. OE110 0002880C********************************************************************OE110 02890CSR BODY BEGSR OE110 02900CSR MOVELB118 RECORD136 OE110 02910CSR 70 MOVELHEADER RECORD OE110 02920CSR 71 MOVELSHIP RECORD OE110 02930CSR 72 MOVELCOMENT RECORD OE110 02940CSR EXSR CLRSCR OE110 0002950CSR EXSR GETSEC OE110 02960CSR EXSR OUTPUT OE110 02970CSRN73 GOTO BLOOP OE110 02980CSR Z-ADD0 Y LINES ONLY OE110 02990CSR Z-ADD0 YSAVE 20 OE110 03000CSR Z-ADD0 YLAST 20 OE110 03010CSR Z-ADD1 LB 20 LOWER BOUND OE110 0003020CSR Z-ADD18 UB 20 UPPER BOUND OE110 03030CSR BLOOP TAG OE110 03040CSR 73 EXSR GET2 OE110 03050CSR 74 EXSR BATCH OE110 03060CSR EXSR UPDATE OE110 03070CSR 67 EXSR CLRSCR OE110 03080CSR 67 EXSR OUTPUT OE110 0003090CSR 67 GOTO BLOOP OE110 03100CSR ENDSR OE110 03110C********************************************************************OE110 03120C* THIS SUBROUTINE LOADS THE FIELD PARAMETERS INTO THE ARRAYS. OE110 03130C********************************************************************OE110 03140CSR GETSEC BEGSR OE110 03150CSR SETOF 4041 OE110 0003160CSR SECTN MULT SSIZE RRN 40 OE110 03170CSR Z-ADD1 X 20 OE110 03180CSR SCLOOP TAG OE110 03190CSR RRN ADD 1 RRN OE110 03200CSR RRN CHAINDISPR1 50 OE110 03210CSR 50 GOTO ENDGET OE110 03220CSR FIELDN COMP B22 4141 OE110 0003230CSRN41 CURPOS COMP ' ' 4141 OE110 03240CSRN41 GOTO ENDGET OE110 03250CSR MOVE FIELDN FN,X OE110 03260CSR MOVE CURPOS CP,X OE110 03270CSR MOVE LNGTHA LN,X OE110 03280CSR MOVE ENDPOS EP,X OE110 03290CSR X ADD 1 X OE110 0003300CSR X COMP SSIZE 32 OE110 03310CSRN32 GOTO SCLOOP OE110 03320CSR ENDGET TAG OE110 03330CSR Z-ADDX NOFLDS 20 OE110 03340CSR 73 Z-ADD7 NOFLDS OE110 03350CSR ENDSR OE110 03360C********************************************************************OE110 0003370C* THIS SUBROUTINE STEPS THROUGH THE FIELDS AND CALLS THE ROUTINE OE110 03380C* THAT OUTPUTS THEM. OE110 03390C********************************************************************OE110 03400CSR OUTPUT BEGSR OE110 03410CSR Z-ADD1 X OE110 03420CSR Z-ADD0 Y 20 OE110 03430CSR OTLOOP TAG OE110 0003440CSR EXSR OUTFLD OE110 03450CSR X ADD 1 X OE110 03460CSR X COMP NOFLDS 31 OE110 03470CSR 31 GOTO OTLOOP OE110 03480CSR ENDSR OE110 03490C********************************************************************OE110 03500C* THIS SUBROUTINE OUTPUTS THE FIELD NAMES, FIELD INFORMATION, OE110 0003510C* AND BRACKETS AROUND THE FIELD INFORMATION. IF THE FIELD OE110 03520C* LENGTH IS 0 THEN ONLY THE FIELD NAME IS OUTPUT. OE110 03530C* EACH TYPE OF SCREEN CALLS THE APPROPRIATE ROUTINE TO OE110 03540C* OUTPUT ITS FIELD INFORMATION. OE110 03550C********************************************************************OE110 03560CSR OUTFLD BEGSR OE110 03570CSR MOVE FN,X FL 20 OE110 0003580CSR MOVELCP,X FC 20 OE110 03590CSR FC COMP FL 31 OE110 03600CSR 31 Z-ADDFC FL OE110 03610CSR FC SUB FL CC 20 OE110 03620CSR CC ADD 1 CC OE110 03630CSR MOVELCP,X BUFFER OE110 03640CSR 73 EXSR POSLIN OE110 0003650CSR MOVELCC BUFFER OE110 03660CSR EXSR POSCUR OE110 03670CSR MOVELB72 BUFFER OE110 03680CSR MOVELFN,X FIELDN OE110 03690CSR MOVE ' ' FIELDN OE110 03700CSR MOVELFIELDN BUFFER OE110 03710CSR Z-ADDLN,X LEN 20 OE110 0003720CSR LEN COMP 0 3130 OE110 03730CSR 31 Z-SUBLN,X LEN OE110 03740CSR 30 GOTO SKIPF OE110 03750CSR EXSR LTBRKT OE110 03760CSR BPOS ADD 1 FPOS 20 OE110 03770CSR EXSR GET1 OE110 03780CSR EXSR RTBRKT OE110 0003790CSR SKIPF TAG OE110 03800CSR 30 Z-ADDFL BLNGTH OE110 03810CSRN30 FL ADD 3 BLNGTH OE110 03820CSRN30 BLNGTH ADD LEN BLNGTH OE110 03830CSR MOVE 'S' TYPE OE110 03840CSR EXSR CRTCOM OE110 03850CSR ENDSR OE110 0003860C********************************************************************OE110 03870C* THIS ROUTINE ACCEPTS NEW FIELD INFO AND UPDATES THE RECORD. OE110 03880C* IF THE ACCEPT COMMAND WAS TERMINATED BY A RUBOUT AND NO OE110 03890C* CHARACTERS WERE TYPED, THE CURSOR JUMPS TO THE BEGINNING OE110 03900C* OF THE PREVIOUS FIELD. IF THE 1ST CHARACTER IS AN '@' THEN OE110 03910C* THE REST OF THE FIELDS ARE LEFT UNCHANGED. OE110 03920C********************************************************************OE110 0003930CSR UPDATE BEGSR OE110 03940CSR SETOF 32 OE110 03950CSR Z-ADD1 X OE110 03960CSR Z-ADDYLAST Y OE110 03970CSR UPLOOP TAG OE110 03980CSR EXSR LNGTH OE110 03990CSR 30N32 GOTO INCR OE110 0004000CSR 30 GOTO CHKRUB OE110 04010CSR 73 EXSR XTYPE WHICH 'X' OE110 04020CSR 73 83N90 EXSR @TYPE OE110 04030CSR 73 83N90X ADD 1 X OE110 04040CSR 73 EXSR XTYPE OE110 04050CSR 73 84N90 OE110 04060CANN32N96 Y ADD 1 Y GOTO NEXT LINE OE110 0004070CSR 73 84 EXSR YOUT DISP LINE#,TYPEOE110 04080CSR 73 76N96 GOTO WL IF TYPEOE110 04090CAN 90 Z-ADD7 X BLANK & 90 ON OE110 04100CSR 73 76N96 GO BACK TO TYPEOE110 04110CANN90 Z-ADD8 X IF 90 OFF OE110 04120CSR 73 78N96 Z-ADD12 X GOTO COMMENT OE110 04130C* IF TYPE IS C OE110 0004140CSR SETOF 3233 OE110 04150CSR SETOF 767778 OE110 04160CSR EXSR XTYPE OE110 04170CSR EXSR ACCEPT OE110 04180CSR CHKRUB TAG OE110 04190CSR 32 73 83 NO RUBOUT ON OE110 04200COR 32 73 84 WHAT LINE? OR OE110 0004210CANN90 GOTO UPLOOP TYPE W/90 OFF OE110 04220CSR 32 73 88 Z-ADD9 X OE110 04230CSR 32 X SUB 1 X 31 OE110 04240CSR 32 31 GOTO UPLOOP OE110 04250CSR 32 GOTO ENDUPD OE110 04260CSR MOVELBUFFER ATSIGN 1 OE110 04270CSR ATSIGN COMP '@' 35 OE110 0004280CSR 35 73 83 GOTO ATSG1 @ IN WHAT LINE OE110 04290CSR 35 73 84 EXSR @TYPE @ IN TYPE OE110 04300CSR 35 74 NO @ TOTALS OE110 04310COR 35 73 GOTO UPLOOP NO @ LINE ITEMSOE110 04320CSR 35 GOTO ENDUPD OE110 04330CSR ATSG1 TAG OE110 04340CSR 33 Z-ADD1 FPOS OE110 0004350CSR 33 EXSR GET OE110 04360CSR EXSR EDIT OE110 04370CSR 65 Y=OK,NO BATCH OE110 04380COR 66 T=BATCH TOTALS OE110 04390COR 67 @=NEW LINES OE110 04400COR 68 R=GOTO COMMENTSOE110 04410COR 69 N=CANCEL OE110 0004420COR 40 GOTO ENDUPD E=END OF JOB OE110 04430CSR 96 GOTO UPLOOP OE110 04440CSR 33 GOTO INCR LINE FEED OE110 04450CSR EXSR PUT1 OE110 04460CSR EXSR OUTFLD OE110 04470CSR INCR TAG OE110 04480CSR X ADD 1 X OE110 0004490CSRN73 X COMP NOFLDS 30 OE110 04500CSR 73 87 Z-ADD13 X OE110 04510CSR 73 X COMP 13 30 OE110 04520CSR 73 30 Z-ADD7 X OE110 04530CSR 73 OE110 04540COR 30 GOTO UPLOOP OE110 04550CSR ENDUPD ENDSR OE110 0004560C* OE110 04570C********************************************************************OE110 04580C* THIS SUBROUTINE DISPLAYS THE LINE# (=Y) & BRACKETS FOR TYPE. OE110 04590C* USED BY SUBR UPDATE FOR LINE-ITEMS ONLY WHEN TYPE IS BEING OE110 04600C* PROCESSED (X=8). OE110 04610C********************************************************************OE110 04620CSR YOUT BEGSR OE110 0004630CSR MOVELLC,Y RECORD OE110 04640CSR MOVELRECORD DIG1 OE110 04650CSR DIG1 COMP ' ' 59 OE110 04660CSRN59 GOTO ENDY OE110 04670CSR EXSR POSLIN POSITION LINE OE110 04680CSR MOVEL'03' BUFFER OE110 04690CSR EXSR POSCUR OE110 0004700CSR MOVELY BUFFER DISPLAY LINE# OE110 04710CSR MOVE 'S' TYPE OE110 04720CSR Z-ADD2 BLNGTH OE110 04730CSR EXSR CRTCOM OE110 04740CSR EXSR OUTFLD OE110 04750CSR ENDY ENDSR OE110 04760C********************************************************************OE110 0004770C* THIS SUBROUTINE POSITIONS THE CURSOR AT THE BEGINNING OF THE OE110 04780C* FIELD AND ALLOWS THE NUMBER OF CHARACTERS SPECIFIED IN LN,X OE110 04790C* TO BE ENTERED. IF LN,X IS NEGATIVE THEN THE FIELD IS NUMERIC & OE110 04800C* MUST BE CHECKED FOR THE SIGN AND RIGHT ADJUSTED. IF A RUBOUT OE110 04810C* WAS USED TO TERMINATE THE OPERATION THEN THE OPERATION IS OE110 04820C* RETIRED IF THE RUBOUT WAS NOT THE 1ST CHAR OTHERWISE OE110 04830C* INDICATOR 32 IS SETON. IF A LINE FEED WAS USED THEN THE OE110 0004840C* ORIGINAL FIELD INFO IS OUTPUT TO THE SCREEN. A NORMAL OE110 04850C* TERMINATION CAUSES THE NEW INFO TO BE OUTPUT TO THE SCREEN. OE110 04860C********************************************************************OE110 04870CSR ACCEPT BEGSR OE110 04880CSR X COMP 1 30 OE110 04890CSRN30 X COMP SSIZE 30 OE110 04900CSR 30 Z-ADD1 X OE110 0004910CSR MOVELCP,X FC OE110 04920CSR FC ADD 3 FC OE110 04930CSR MOVELCP,X SAVPOS 4 OE110 04940CSR 73 EXSR POSLIN OE110 04950CSR MOVELFC SAVPOS OE110 04960CSR LN,X ADD FC OFC 20 OE110 04970CSR OFC ADD 1 OFC OE110 0004980CSR Z-ADDLN,X LEN OE110 04990CSR LEN COMP 0 34 OE110 05000CSR 34 Z-SUBLEN LEN OE110 05010CSR ACLOOP TAG OE110 05020CSR MOVELSAVPOS BUFFER OE110 05030CSR EXSR POSCUR OE110 05040CSR Z-ADDLEN BLNGTH OE110 0005050CSR MOVE B72 BUFFER OE110 05060CSR MOVE 'A' TYPE OE110 05070CSR EXSR CRTCOM OE110 05080CSR RCODE COMP 'R' 31 OE110 05090CSR 31 BUFFER COMP B72 32 OE110 05100CSR 31 32 GOTO ENDACC OE110 05110CSR 31 GOTO ACLOOP OE110 0005120CSR RCODE COMP 'L' 33 OE110 05130CSR 33 GOTO DUPIT OE110 05140CSRN34 GOTO ENDACC OE110 05150CSR MOVELBUFFER SIGN 1 WE MUST CHECK OE110 05160CSR SIGN COMP '@' 30 OE110 05170CSR 30 GOTO ENDACC OE110 05180CSR Z-ADDLEN VL 20 OE110 0005190CSR MOVELBUFFER VAR 15 OE110 05200CSR EXSR RTADJ OE110 05210CSR MOVELVAR BUFFER OE110 05220CSR GOTO ENDACC OE110 05230CSR DUPIT TAG OE110 05240CSR EXSR OUTFLD OE110 05250CSR ENDACC ENDSR OE110 0005260C********************************************************************OE110 05270C* THIS SUBROUTINE MOVES A LEFT BRACKET INTO BUFFER AT BPOS. OE110 05280C********************************************************************OE110 05290CSR LTBRKT BEGSR OE110 05300CSR FL ADD 2 BPOS 20 OE110 05310CSR Z-ADD1 WHICH1 10 OE110 05320CSR EXIT SUBRIN OE110 0005330CSR RLABL WHICH1 OE110 05340CSR RLABL BUFFER OE110 05350CSR RLABL RECORD OE110 05360CSR RLABL BPOS OE110 05370CSR RLABL FPOS OE110 05380CSR RLABL STRT OE110 05390CSR RLABL LEN OE110 0005400CSR ENDSR OE110 05410C********************************************************************OE110 05420C* THIS SUBROUTINE MOVES INFO FROM 'RECORD' INTO BUFFER. OE110 05430C* MOVE LEN NUMBER OF CHARS FROM RECORD TO BUFFER OE110 05440C* FROM STRT IN RECORD TO FPOS IN BUFFER. OE110 05450C********************************************************************OE110 05460CSR GET BEGSR OE110 0005470CSR EP,X SUB LEN STRT 30 OE110 05480CSR STRT ADD 1 STRT OE110 05490CSR Z-ADD2 WHICH1 OE110 05500CSR EXIT SUBRIN OE110 05510CSR RLABL WHICH1 OE110 05520CSR RLABL BUFFER 72 OE110 05530CSR RLABL RECORD OE110 0005540CSR RLABL BPOS 20 OE110 05550CSR RLABL FPOS 20 OE110 05560CSR RLABL STRT 30 OE110 05570CSR RLABL LEN 20 OE110 05580CSR ENDSR OE110 05590C********************************************************************OE110 05600C* THIS SUBROUTINE INSERTS A RIGHT BRACKET INTO BUFFER AT BPOS. OE110 0005610C********************************************************************OE110 05620CSR RTBRKT BEGSR OE110 05630CSR LEN ADD FPOS FPOS OE110 05640CSR Z-ADD3 WHICH1 OE110 05650CSR EXIT SUBRIN OE110 05660CSR RLABL WHICH1 OE110 05670CSR RLABL BUFFER 72 OE110 0005680CSR RLABL RECORD OE110 05690CSR RLABL BPOS 20 OE110 05700CSR RLABL FPOS 20 OE110 05710CSR RLABL STRT 30 OE110 05720CSR RLABL LEN 20 OE110 05730CSR ENDSR OE110 05740C********************************************************************OE110 0005750C* THIS SUBROUTINE MOVES LEN NUMBER OF CHARS FROM THE BEGINNING OE110 05760C* OF BUFFER TO THE STRT OF RECORD. OE110 05770C********************************************************************OE110 05780CSR PUT BEGSR OE110 05790CSR EP,X SUB LEN STRT OE110 05800CSR STRT ADD 1 STRT OE110 05810CSR Z-ADD4 WHICH1 OE110 0005820CSR EXIT SUBRIN OE110 05830CSR RLABL WHICH1 OE110 05840CSR RLABL BUFFER 72 OE110 05850CSR RLABL RECORD OE110 05860CSR RLABL BPOS 20 OE110 05870CSR RLABL FPOS 20 OE110 05880CSR RLABL STRT 30 OE110 0005890CSR RLABL LEN 20 OE110 05900CSR ENDSR OE110 05910C********************************************************************OE110 05920C* THIS SUBROUTINE RIGHT ADJUSTS FIELDS. OE110 05930C********************************************************************OE110 05940CSR RTADJ BEGSR OE110 05950CSR EXIT SUBRAJ OE110 0005960CSR RLABL VL OE110 05970CSR RLABL VAR OE110 05980CSR ENDSR OE110 05990C********************************************************************OE110 06000C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. OE110 06010C********************************************************************OE110 06020CSR CRTCOM BEGSR OE110 0006030CSR EXITFSUBRCM OE110 06040CSR RLABL BUFFER 72 OE110 06050CSR RLABL TYPE 1 OE110 06060CSR RLABL BLNGTH 20 OE110 06070CSR RLABL RCODE 1 OE110 06080CSR RLABL MASK 10 OE110 06090CSR RLABL DTYPE 10 OE110 0006100CSR ENDSR OE110 06110C********************************************************************OE110 06120C* THIS SUBROUTINE POSITIONS THE CURSOR. OE110 06130C********************************************************************OE110 06140CSR POSCUR BEGSR OE110 06150CSR MOVE 'P' TYPE OE110 06160CSR EXSR CRTCOM OE110 0006170CSR ENDSR OE110 06180C********************************************************************OE110 06190C* THIS SUBROUTINE CLEARS THE SCREEN. OE110 06200C********************************************************************OE110 06210CSR CLRSCR BEGSR OE110 06220CSR MOVE 'C' TYPE OE110 06230CSR EXSR CRTCOM OE110 0006240CSR ENDSR OE110 06250C********************************************************************OE110 06260C* THIS SUBROUTINE IS USED IN VARIOUS SUBROUTINES. OE110 06270C* IT TAKES THE VARIABLE LENGTH FROM THE ARRAYS AND MOVES IT OE110 06280C* INTO AN RPG FIELD 'LEN'. IF 'LEN' IS NEGATIVE THE VARIABLE OE110 06290C* IS NUMERIC, NOT ALPHA. IF 'LEN' IS ZERO, THERE IS NO VARIABLE, OE110 06300C* ONLY A MESSAGE. OE110 0006310C********************************************************************OE110 06320CSR LNGTH BEGSR OE110 06330CSR Z-ADDLN,X LEN OE110 06340CSR LEN COMP 0 3730 OE110 06350CSR 37 Z-SUBLEN LEN OE110 06360CSR ENDSR OE110 06370C********************************************************************OE110 0006380C* THIS SUBROUTINE SETS THINGS UP FOR THE SUBROUTINE 'GET'. OE110 06390C* IT MOVES INFORMATION INTO THE 'RECORD' SO IT CAN BE OE110 06400C* TRANSFERRED INTO THE BUFFER. OE110 06410C********************************************************************OE110 06420CSR GET1 BEGSR OE110 06430CSR EXSR XTYPE OE110 06440CSR 73N83 MOVELLC,Y RECORD LINE-COMMENTS OE110 0006450CSR EXSR GET OE110 06460CSR ENDSR OE110 06470C********************************************************************OE110 06480C* THIS SUBROUTINE DISPLAYS THE LINE ITEMS. OE110 06490C********************************************************************OE110 06500CSR GET2 BEGSR OE110 06510CSR MOVE YSAVE YLAST OE110 0006520CSR MOVE YSAVE Y OE110 06530CSR GLOOP TAG OE110 06540CSR Y ADD 1 Y OE110 06550CSR MOVELLC,Y RECORD OE110 06560CSR MOVELRECORD DIG1 TYPE BLNK,L,C OE110 06570CSR DIG1 COMP ' ' 59 OE110 06580CSR 59 GOTO GL3 OE110 0006590CSR Z-ADDY YLAST OE110 06600CSR Z-ADD8 X OE110 06610CSR EXSR POSLIN POSITION LINE OE110 06620CSR MOVEL'03' BUFFER OE110 06630CSR EXSR POSCUR OE110 06640CSR MOVELY BUFFER DISPLAY LINE # OE110 06650CSR MOVE 'S' TYPE OE110 0006660CSR Z-ADD2 BLNGTH OE110 06670CSR EXSR CRTCOM OE110 06680C* OE110 06690CSR EXSR OUTFLD OE110 06700CSR DIG1 COMP 'L' 59 OE110 06710CSR 59 GOTO GL2 OE110 06720C* OE110 0006730CSR Z-ADD12 X DISPLAY LINE OE110 06740CSR EXSR OUTFLD COMMENT OE110 06750CSR GOTO GL3 OE110 06760C* OE110 06770CSR GL2 TAG OE110 06780CSR Z-ADD9 X DISPLAY PART#/ OE110 06790CSR EXSR OUTFLD DESC/PRICE OE110 0006800CSR EXSR MVLINE OE110 06810CSR MOVELNOFLD BUFFER OE110 06820CSR EXSR XTYPE OE110 06830CSR EXSR EDIT OE110 06840C* OE110 06850CSR Z-ADD10 X DISPLAY OE110 06860CSR EXSR OUTFLD QUANTITY OE110 0006870C* OE110 06880C* OE110 06890CSR GL3 TAG OE110 06900CSR Y DIV 18 P CHECK TO SEE IFOE110 06910CSR MVR Z AN ENTIRE OE110 06920CSR Z COMP 0 59 SCREEN HAS OE110 06930CSRN59 GOTO GLOOP BEEN OUTPUT OE110 0006940CSR ENDSR OE110 06950C********************************************************************OE110 06960C* THIS SUBROUTINE USES 'PUT' SUBROUTINE. OE110 06970C* IT TAKES INFORMATION FROM THE BUFFER AND PUTS IT INTO THE OE110 06980C* 'RECORD'. FROM THERE, DEPENDING ON THE SECTION, IT MOVES OE110 06990C* THE 'RECORD' INTO THE APPROPRIATE ARRAY ELEMENT. OE110 07000C********************************************************************OE110 0007010CSR PUT1 BEGSR OE110 07020CSR EXSR PUT OE110 07030CSR 73N83 MOVELRECORD LC,Y LINE-COMMENTS OE110 07040CSR ENDSR OE110 07050C********************************************************************OE110 07060C* THIS SUBROUTINE POSITIONS THE CURSOR TO THE PROPER LINE ON OE110 07070C* PAGE DURING LINE ITEMS, ETC. OE110 0007080C********************************************************************OE110 07090CSR POSLIN BEGSR OE110 07100CSR X COMP 8 59 OE110 07110CSR 59 GOTO EPOS OE110 07120CSR Y DIV 18 P 20 P=PAGE OE110 07130CSR MVR Z 40 Z=LINE # ON PGEOE110 07140CSR Z COMP 0 59 OE110 0007150CSR Z ADD 2 Z OE110 07160CSR 59 Z ADD 18 Z OE110 07170CSR MOVELZ BUFFER OE110 07180CSR MOVE Z SAVPOS OE110 07190CSR EPOS TAG OE110 07200CSR SETOF 59 OE110 07210CSR ENDSR OE110 0007220C********************************************************************OE110 07230C* THIS SUBROUTINE IS USED FOR LINE ITEMS ONLY. OE110 07240C* IT SETS AN INDICATOR ON ACCORDING TO WHICH 'X' ELEMENT IS OE110 07250C* BEING PROCESSED. IT'S ONLY CONCERNED WITH 'X' ELEMENTS 7-12. OE110 07260C********************************************************************OE110 07270CSR XTYPE BEGSR OE110 07280CSR X COMP 7 83 WHAT LINE ? OE110 0007290CSR X COMP 8 84 TYPE OE110 07300CSR X COMP 9 85 PRODUCT # OE110 07310CSR X COMP 10 86 QUANTITY OE110 07320CSR X COMP 11 87 PRICE OVERRIDEOE110 07330CSR X COMP 12 88 LINE COMMENT OE110 07340CSR ENDSR OE110 07350C********************************************************************OE110 0007360C* THIS SUBROUTINE GOES TO 'WHAT LINE?' MODE IF TYPE = '@' OR OE110 07370C* IF AN ENTIRE SCREEN HAS BEEN OUTPUT (Y = MULTIPLE OF 18). OE110 07380C* **NOTE- IF YSAVE ALSO=MULT OF 18 WE SKIP OUT & DON'T GOTO 'WHAT OE110 07390C* LINE?' BECAUSE THIS MEANS WE JUST WENT FORWARD OR OE110 07400C* BACKWARD TO A NEW LINE-ITEM SCREEN. OE110 07410C********************************************************************OE110 07420CSR @TYPE BEGSR OE110 0007430CSR 84 GOTO @SIGN TYPE = @ OE110 07440CSR Y DIV 18 P CHECK IF WHOLE OE110 07450CSR MVR Z SCREEN DONE OE110 07460CSR Z COMP 0 59 OE110 07470CSR 59 YSAVE COMP Y 5959 SKIP NEW SCREENOE110 07480CSRN59 GOTO END@ NO- KEEP GOING OE110 07490C************************ OE110 0007500CSR @SIGN TAG NOW GOTO 'WHAT OE110 07510C************************ -LINE?' MODE OE110 07520CSR 35 73 84 MOVELB72 LC,Y OE110 07530CSR 35 73 84 MOVELB118 RECORD OE110 07540CSR Z-ADD7 X OE110 07550CSR 90 GOTO SKIP90 OE110 07560CSR Z-ADD2 NCHARS MOVE Y INTO OE110 0007570CSR Z-ADD1 SSTRT RECORD OE110 07580CSR Z-ADD120 TSTRT OE110 07590CSR MOVE Y AY 2 OE110 07600CSR EXIT SUBRMV OE110 07610CSR RLABL AY OE110 07620CSR RLABL SSTRT 30 OE110 07630CSR RLABL RECORD OE110 0007640CSR RLABL TSTRT 30 OE110 07650CSR RLABL NCHARS 30 OE110 07660CSR EXSR OUTFLD DISPLAY OE110 07670CSR SETON 90 OE110 07680CSR SKIP90 TAG OE110 07690CSR SETOF 59 OE110 07700CSR END@ TAG OE110 0007710CSR ENDSR OE110 07720C********************************************************************OE110 07730C* THIS SUBROUTINE BREAKS UP A 6-BYTE DATE IN THE FORM MMDDYY, OE110 07740C* WHICH HAS BEEN MOVED INTO DIG6N, INTO YEAR (@YR), MONTH (@MO), OE110 07750C* DAY (@DA). OE110 07760C********************************************************************OE110 07770CSR DATE BEGSR OE110 0007780CSR MOVE DIG6N @YR 20 OE110 07790CSR MOVELDIG6N @MO 20 OE110 07800CSR MOVE DIG6N @DAYR 40 OE110 07810CSR MOVEL@DAYR @DA 20 OE110 07820CSR ENDT ENDSR OE110 07830C********************************************************************OE110 07840C* THIS SUBROUTINE EDITS A DATE FIELD. OE110 0007850C* IT LOOKS UP MONTH IN A TABLE TO VALIDATE THE DAY. OE110 07860C********************************************************************OE110 07870CSR EDATE BEGSR OE110 07880CSR DIG6N COMP 0 59 OE110 07890CSR 59 MOVE UDATE DIG6N OE110 07900CSR 59 MOVELUDATE SAVE OE110 07910CSR EXSR DATE OE110 0007920CSR @MO COMP 0 96 OE110 07930CSRN96 @DA COMP 0 96 OE110 07940CSRN96 @YR COMP 0 96 OE110 07950CSRN96 @MO LOKUPTABD TABE 59 OE110 07960CSRN96N59 SETON 96 OE110 07970CSRN96 59 @DA COMP TABE 96 OE110 07980CSR ENDTE ENDSR OE110 0007990C********************************************************************OE110 08000C* THIS SUBROUTINE EDITS ANY FIELD SHOWN IN TABA. OE110 08010C* TABA CONTAINS SECTION AND X. OE110 08020C* TABB CONTAINS CURSOR POS, ERROR MESSAGE, & SUBR# FOR SUBRXS. OE110 08030C********************************************************************OE110 08040CSR EDIT BEGSR OE110 08050CSR SETOF 9796 OE110 0008060CSR SETOF 596061 OE110 08070CSR SETOF 626364 OE110 08080CSR SETOF 656667 OE110 08090CSR SETOF 6869 OE110 08100CSR SETOF 767778 OE110 08110CSR MOVELSECTN XCNT 30 OE110 08120CSR MOVE X XCNT OE110 0008130CSR XCNT LOKUPTABA TABB 97 OE110 08140CSRN97 GOTO EEDIT OE110 08150CSR MOVE BUFFER SAVE 72 OE110 08160CSR MOVE B26 WORD26 26 OE110 08170C* OE110 08180CSR XCNT COMP 003 99 OE110 08190CSR 99 EXSR E003 OE110 0008200CSR XCNT COMP 004 99 OE110 08210CSR 99 EXSR E004 OE110 08220CSR XCNT COMP 005 99 OE110 08230CSR 99 EXSR E005 OE110 08240CSR XCNT COMP 006 99 OE110 08250CSR 99 EXSR E006 OE110 08260CSR XCNT COMP 007 99 OE110 0008270CSR 99 EXSR E007 OE110 08280CSR XCNT COMP 008 99 OE110 08290CSR 99 EXSR E007 OE110 08300CSR XCNT COMP 015 99 OE110 08310CSR 99 EXSR E015 OE110 08320CSR XCNT COMP 016 99 OE110 08330CSR 99 EXSR E016 OE110 0008340CSR XCNT COMP 017 99 OE110 08350CSR 99 EXSR E017 OE110 08360CSR XCNT COMP 018 99 OE110 08370CSR 99 EXSR E018 OE110 08380CSR XCNT COMP 019 99 OE110 08390CSR 99 EXSR E019 OE110 08400CSR XCNT COMP 020 99 OE110 0008410CSR 99 EXSR E020 OE110 08420CSR XCNT COMP 021 99 OE110 08430CSR 99 EXSR E021 OE110 08440CSR XCNT COMP 103 99 OE110 08450CSR 99 EXSR E006 OE110 08460CSR XCNT COMP 307 99 OE110 08470CSR 99 EXSR E307 OE110 0008480CSR XCNT COMP 308 99 OE110 08490CSR 99 EXSR E308 OE110 08500CSR XCNT COMP 309 99 OE110 08510CSR 99 EXSR E309 OE110 08520CSR XCNT COMP 311 99 OE110 08530CSR 99 EXSR E311 OE110 08540CSR XCNT COMP 411 99 OE110 0008550CSR 99 EXSR E411 OE110 08560CSR EXSR ERMESS OE110 08570CSR EEDIT ENDSR OE110 08580C********* OE110 08590C*** THIS SECTION DISPLAYS THE ERROR MESSAGE. OE110 08600C*** IT DISPLAYS BLANKS IF THE MESSAGE SHOUDN'T EXIST. OE110 08610C********* OE110 0008620CSR ERMESS BEGSR OE110 08630CSRN97 GOTO ERDIT OE110 08640CSR 96 MOVE TABB WORD26 OE110 08650CSR 96 MOVE ' ' WORD26 OE110 08660CSR MOVELTABB BUFFER OE110 08670CSR 73 EXSR POSLIN OE110 08680CSR 73 85 MOVEL'27' BUFFER PART # OE110 0008690CSR EXSR POSCUR OE110 08700CSR MOVE 'S' TYPE OE110 08710CSRN85 MOVELWORD26 BUFFER OE110 08720CSRN85 Z-ADD26 BLNGTH OE110 08730CSR 85 96 MOVELWORD26 STR35 OE110 08740CSR 85 MOVELSTR35 BUFFER OE110 08750CSR 85 Z-ADD36 BLNGTH OE110 0008760CSR EXSR CRTCOM OE110 08770CSR 60 EXSR OVRIDE DISPLAY PRICE OE110 08780CSR MOVE SAVE BUFFER OE110 08790CSR ERDIT ENDSR OE110 08800C********************************************************************OE110 08810C*** THIS SECTION EDITS END-OF-JOB. OE110 08820C*** E = END-OF-JOB OE110 0008830C*** 2 = GOTO SHIP-TO SCREEN AFTER HEADER SCREEN OE110 08840C*** 3 = GOTO COMMENT SCREEN AFTER HEADER SCREEN OE110 08850C*** OTHER = GOTO LINE ITEM SCREEN AFTER HEADER SCREEN OE110 08860C********************************************************************OE110 08870CSR E003 BEGSR OE110 08880CSR MOVELBUFFER DIG1 1 OE110 08890CSR DIG1 COMP 'E' 40 OE110 0008900CSR DIG1 COMP '2' 42 OE110 08910CSR DIG1 COMP '3' 43 OE110 08920CSR SETOF 97 OE110 08930CSR ENDSR OE110 08940C********************************************************************OE110 08950C*** THIS SECTION EDITS THE SALES ORDER #. OE110 08960C*** FIRST IT CHAINS TO OPNORDS FILE. IF IT ALREADY EXISTS ITSA OE110 0008970C*** DUPLICATE AND THE USER MUST TRY ANOTHER NUMBER. IF IT'S OK, OE110 08980C*** THEN IT CHAINS TO SOTEMP(TODAYS ORDERS). IF IT ALREADY EXISTS OE110 08990C*** ON THAT FILE THE NUMBER IS REJECTED. OE110 09000C********************************************************************OE110 09010CSR E004 BEGSR OE110 09020CSR MOVELBUFFER DIG5N 50 OE110 09030CSR MOVELBUFFER BLDKEY 8 OE110 0009040CSR MOVEL'00' HOLD 3 OE110 09050CSR MOVE 'H' HOLD OE110 09060CSR MOVE HOLD BLDKEY OE110 09070CSR BLDKEY CHAINOPNORDS 59 # NOT FOUND OE110 09080CSRN59 SETON 96 ERROR OE110 09090CSR 96 GOTO END004 OE110 09100CSR Z-ADD0 SO 50 OE110 0009110CSR MOVELDIG5N SO OE110 09120CSR Z-ADD0 DIG7 70 OE110 09130CSR MOVELDIG5N DIG7 OE110 09140CSR DIG7 CHAINSOTEMP 59 OE110 09150CSRN59 SETON 96 ERROR OE110 09160CSR END004 ENDSR OE110 09170C********************************************************************OE110 0009180C*** THIS SECTION EDITS THE ORDER TYPE. OE110 09190C*** IT'S AN ALPHA FIELD THAT'S VALID FOR : OE110 09200C*** BLANK = SALES ORDER OE110 09210C*** E = DIRECT BILL OE110 09220C*** C = CREDIT MEMO OE110 09230C*** M = MANUAL INVOICE OE110 09240C********************************************************************OE110 0009250CSR E005 BEGSR OE110 09260CSR MOVELBUFFER OTYPE 1 OE110 09270CSR SETOF 202122 OE110 09280CSR SETOF 23 OE110 09290CSR OTYPE COMP ' ' 969620 OE110 09300CSR 96 OTYPE COMP 'C' 969621 OE110 09310CSR 96 OTYPE COMP 'E' 969622 OE110 0009320CSR 96 OTYPE COMP 'M' 969623 OE110 09330CSR ENDSR OE110 09340C********************************************************************OE110 09350C*** THIS SECTION EDITS THE CUSTOMER NUMBER. OE110 09360C*** IT CHAINS TO ARMAST TO SEE IF THE NUMBER ALREADY EXISTS. OE110 09370C*** IF IT EXISTS, IT'S VALID AND THE SOLD-TO LINES SHOULD OE110 09380C*** BE DISPLAYED. THIS SAME SECTION WILL BE USED TO EDIT THE OE110 0009390C*** SHIP-TO CUSTOMER. OE110 09400C********************************************************************OE110 09410CSR E006 BEGSR OE110 09420CSR MOVELBUFFER DIG5N OE110 09430CSR 71 DIG5N COMP 99999 9696 OE110 09440CSR 71N96 GOTO END006 OE110 09450CSR Z-ADDDIG5N DIG6N 60 OE110 0009460CSR DIG6N CHAINARMAST 96 NOT FOUND OE110 09470CSRN96 DCODE COMP ' ' 9696 OE110 09480CSR 96 GOTO END006 OE110 09490CSR 70 MOVE PC SPC SAVE PRICE COD OE110 09500CSR MOVEL'2605' BUFFER DISPLAY N/A OE110 09510CSR EXSR POSCUR LINE 1 OE110 09520CSR MOVE 'S' TYPE OE110 0009530CSR MOVELNAME BUFFER OE110 09540CSR Z-ADD24 BLNGTH OE110 09550CSR EXSR CRTCOM OE110 09560CSR 70 GOTO SKNAME OE110 09570CSR Z-ADD24 NCHARS 30 OE110 09580CSR Z-ADD1 SSTRT 30 OE110 09590CSR Z-ADD14 TSTRT 30 OE110 0009600CSR EXIT SUBRMV OE110 09610CSR RLABL NAME SOURCE OE110 09620CSR RLABL SSTRT 30 OE110 09630CSR RLABL RECORD TARGET OE110 09640CSR RLABL TSTRT 30 OE110 09650CSR RLABL NCHARS 30 OE110 09660C* OE110 0009670C* OE110 09680CSR SKNAME TAG OE110 09690CSR MOVEL'2606' BUFFER DISPLAY OE110 09700CSR EXSR POSCUR ADDRESS 1 OE110 09710CSR MOVE 'S' TYPE OE110 09720CSR MOVELADR1 BUFFER OE110 09730CSR EXSR CRTCOM OE110 0009740CSR 70 GOTO SKADR1 OE110 09750CSR Z-ADD38 TSTRT OE110 09760CSR EXIT SUBRMV OE110 09770CSR RLABL ADR1 SOURCE OE110 09780CSR RLABL SSTRT 30 OE110 09790CSR RLABL RECORD TARGET OE110 09800CSR RLABL TSTRT 30 OE110 0009810CSR RLABL NCHARS 30 OE110 09820C* OE110 09830CSR SKADR1 TAG OE110 09840CSR MOVEL'2607' BUFFER DISPLAY OE110 09850CSR EXSR POSCUR ADDRESS 2 OE110 09860CSR MOVE 'S' TYPE OE110 09870CSR MOVELADR2 BUFFER OE110 0009880CSR EXSR CRTCOM OE110 09890CSR 70 GOTO SKADR2 OE110 09900CSR Z-ADD62 TSTRT OE110 09910CSR EXIT SUBRMV OE110 09920CSR RLABL ADR2 SOURCE OE110 09930CSR RLABL SSTRT 30 OE110 09940CSR RLABL RECORD TARGET OE110 0009950CSR RLABL TSTRT 30 OE110 09960CSR RLABL NCHARS 30 OE110 09970C* OE110 09980CSR SKADR2 TAG OE110 09990CSR MOVEL'2608' BUFFER DISPLAY OE110 10000CSR EXSR POSCUR CITY OE110 10010CSR MOVE 'S' TYPE OE110 0010020CSR MOVELCITY BUFFER OE110 10030CSR Z-ADD13 BLNGTH OE110 10040CSR EXSR CRTCOM OE110 10050CSR 70 GOTO SKCITY OE110 10060CSR Z-ADD13 NCHARS OE110 10070CSR Z-ADD86 TSTRT OE110 10080CSR EXIT SUBRMV OE110 0010090CSR RLABL CITY SOURCE OE110 10100CSR RLABL SSTRT 30 OE110 10110CSR RLABL RECORD TARGET OE110 10120CSR RLABL TSTRT 30 OE110 10130CSR RLABL NCHARS 30 OE110 10140C* OE110 10150CSR SKCITY TAG OE110 0010160CSR MOVEL'4308' BUFFER OE110 10170CSR EXSR POSCUR OE110 10180CSR MOVE 'S' TYPE OE110 10190CSR MOVELSTCODE BUFFER OE110 10200CSR Z-ADD2 BLNGTH OE110 10210CSR EXSR CRTCOM OE110 10220CSR 70 GOTO SKCODE OE110 0010230CSR Z-ADD2 NCHARS OE110 10240CSR Z-ADD99 TSTRT OE110 10250CSR EXIT SUBRMV OE110 10260CSR RLABL STCODE SOURCE OE110 10270CSR RLABL SSTRT 30 OE110 10280CSR RLABL RECORD TARGET OE110 10290CSR RLABL TSTRT 30 OE110 0010300CSR RLABL NCHARS 30 OE110 10310C* OE110 10320CSR SKCODE TAG OE110 10330CSR MOVEL'4908' BUFFER OE110 10340CSR EXSR POSCUR OE110 10350CSR MOVE 'S' TYPE OE110 10360CSR MOVELZIP BUFFER OE110 0010370CSR Z-ADD5 BLNGTH OE110 10380CSR EXSR CRTCOM OE110 10390CSR 70 GOTO SKZIP OE110 10400CSR Z-ADD5 NCHARS OE110 10410CSR Z-ADD101 TSTRT OE110 10420CSR EXIT SUBRMV OE110 10430CSR RLABL AZIP OE110 0010440CSR RLABL SSTRT 30 OE110 10450CSR RLABL RECORD TARGET OE110 10460CSR RLABL TSTRT 30 OE110 10470CSR RLABL NCHARS 30 OE110 10480C* OE110 10490CSR SKZIP TAG OE110 10500CSR END006 ENDSR OE110 0010510C********************************************************************OE110 10520C*** THIS SECTION EDITS A DATE FIELD. OE110 10530C*** IF ZERO IS ENTERED, PROGRAM DEFAULTS TO UDATE. OE110 10540C********************************************************************OE110 10550CSR E007 BEGSR OE110 10560CSR MOVELBUFFER DIG6N OE110 10570CSR EXSR EDATE OE110 0010580CSR ENDSR OE110 10590C********************************************************************OE110 10600C*** THIS SECTION EDITS THE PAYMENT TERMS OVERRIDE. OE110 10610C********************************************************************OE110 10620CSR E015 BEGSR OE110 10630CSR MOVELBUFFER DIG1 OE110 10640CSR DIG1 COMP ' ' 9696 OE110 0010650CSRN96 GOTO END015 OE110 10660CSR DIG1 CHAINTERMS 96 OE110 10670CSRN96 DLTTRM COMP ' ' 9696 OE110 10680CSRN96 MOVELTNAME WORD26 OE110 10690CSR END015 ENDSR OE110 10700C********************************************************************OE110 10710C*** THIS SECTION EDITS THE PRICE CODE OVERRIDE. OE110 0010720C*** IT'S A NUMERIC FIELD THAT'S VALID FOR 0-5. OE110 10730C*** 0 IMPLIES THERE IS NO OVERRIDE. OE110 10740C********************************************************************OE110 10750CSR E016 BEGSR OE110 10760CSR MOVELBUFFER DIG1N 10 OE110 10770CSR DIG1N COMP 0 96 OE110 10780CSRN96 DIG1N COMP 5 96 OE110 0010790CSRN96 MOVE DIG1N OPC OVRD PRICE COD OE110 10800CSR ENDSR OE110 10810C********************************************************************OE110 10820C*** THIS SECTION EDITS THE TAX CODE OVERRIDE. OE110 10830C*** IT'S AN ALPHA FIELD THAT'S VALID FOR BLANK, C, O, N. OE110 10840C********************************************************************OE110 10850CSR E017 BEGSR OE110 0010860CSR MOVELBUFFER DIG1 OE110 10870CSR DIG1 COMP ' ' 9696 OE110 10880CSR 96 DIG1 COMP 'C' 9696 OE110 10890CSR 96 DIG1 COMP 'O' 9696 OE110 10900CSR 96 DIG1 COMP 'N' 9696 OE110 10910CSR ENDSR OE110 10920C********************************************************************OE110 0010930C*** THIS SECTION EDITS THE SALESMAN #. OE110 10940C********************************************************************OE110 10950CSR E018 BEGSR OE110 10960CSR MOVELBUFFER DIG3N 30 OE110 10970CSR DIG3N COMP 0 9696 OE110 10980CSRN96 GOTO END018 OE110 10990CSR DIG3N CHAINSLSMAN 96 OE110 0011000CSRN96 DLTSMN COMP ' ' 9696 OE110 11010CSRN96 MOVELSNAME WORD26 OE110 11020CSR END018 ENDSR OE110 11030C********************************************************************OE110 11040C*** THIS SECTION EDITS THE AREA. OE110 11050C********************************************************************OE110 11060CSR E019 BEGSR OE110 0011070CSR MOVELBUFFER DIG2 2 OE110 11080CSR DIG2 COMP ' ' 9696 OE110 11090CSRN96 GOTO END019 OE110 11100CSR DIG2 CHAINAREA 96 OE110 11110CSRN96 DLTARA COMP ' ' 9696 OE110 11120CSRN96 MOVELANAME WORD26 OE110 11130CSR END019 ENDSR OE110 0011140C********************************************************************OE110 11150C*** THIS SECTION RETAINS THE BATCH QUANTITY. OE110 11160C********************************************************************OE110 11170CSR E020 BEGSR OE110 11180CSR MOVELBUFFER BQTY 70 OE110 11190CSR SETOF 97 OE110 11200CSR ENDSR OE110 0011210C********************************************************************OE110 11220C*** THIS SECTION RETAINS THE BATCH PRICE OVERRIDE. OE110 11230C********************************************************************OE110 11240CSR E021 BEGSR OE110 11250CSR MOVELBUFFER BPR 73 OE110 11260CSR SETOF 97 OE110 11270CSR ENDSR OE110 0011280C********************************************************************OE110 11290C*** THIS SECTION EDITS THE 'WHAT LINE ?' FIELD. OE110 11300C*** 'Y' REPRESENTS THE ARRAY ELEMENT (WHAT LINE ?). OE110 11310C*** VALID ENTRIES ARE : OE110 11320C*** R = RUBOUT - GO BACK A SCREEN OE110 11330C*** @ = GO FORWARD A SCREEN OE110 11340C*** T = GO TO BATCH TOTALS SECTION OE110 0011350C*** ZERO = INCREMENT THE Y ELEMENT BY ONE OE110 11360C*** # = MUST BE WITHIN INTERVAL SHOWN ON THE SCREEN. OE110 11370C*** Y = SKIP BATCH TOTAL SECTION - OUTPUT RECORDS OE110 11380C*** N = SKIP BATCH TOTAL SECTION - DON'T OUTPUT RECORDS OE110 11390C********************************************************************OE110 11400CSR E307 BEGSR OE110 11410CSR MOVELBUFFER DIG2 OE110 0011420CSR DIG2 COMP '@ ' 67 OE110 11430CSRN67 GOTO SKIPE OE110 11440CSR UB COMP UPPER 68 68 OE110 11450CSRN68 LB ADD 18 LB OE110 11460CSRN68 UB ADD 18 UB OE110 11470CSRN68 YSAVE ADD 18 YSAVE OE110 11480CSR SETOF 6890 OE110 0011490CSR GOTO END307 OE110 11500C* OE110 11510CSR SKIPE TAG OE110 11520CSR DIG2 COMP 'R ' 59 OE110 11530CSRN59 GOTO SKIPX OE110 11540CSR UB COMP 18 676768 OE110 11550CSR 67 LB SUB 18 LB OE110 0011560CSR 67 UB SUB 18 UB OE110 11570CSR 67 YSAVE SUB 18 YSAVE OE110 11580CSR SETOF 90 OE110 11590CSR GOTO END307 OE110 11600C* OE110 11610CSR SKIPX TAG OE110 11620CSR DIG2 COMP 'T ' 66 OE110 0011630CSR 66 GOTO END307 OE110 11640CSR DIG2 COMP 'Y ' 65 OE110 11650CSR 65 GOTO END307 OE110 11660CSR DIG2 COMP 'N ' 69 OE110 11670CSR 69 GOTO END307 OE110 11680C* OE110 11690CSR DIG2 COMP ' ' 9696 OE110 0011700CSRN96 GOTO SKIPG OE110 11710CSR DIG2 COMP '00' 96 OE110 11720CSRN96 DIG2 COMP UPPERA 96 OE110 11730CSR 96 GOTO END307 OE110 11740C* OE110 11750CSR SKIPG TAG OE110 11760CSR Z-ADDY S 20 SAVE Y OE110 0011770CSR MOVELBUFFER Y OE110 11780CSR Y COMP 0 59 OE110 11790CSR 59N33 S ADD 1 Y OE110 11800CSR 59 33 Z-ADDS Y OE110 11810CSR Y COMP LB 96 OE110 11820CSRN96 Y COMP UB 96 OE110 11830CSRN96 MOVELY SAVE OE110 0011840CSRN96 MOVELLC,Y RECORD OE110 11850CSR END307 ENDSR OE110 11860C********************************************************************OE110 11870C*** THIS SECTION EDITS THE TYPE ON LINE ITEM SCREENS. OE110 11880C*** VALID ENTRIES ARE : OE110 11890C*** BLANK = TO OMIT THE LINE OE110 11900C*** L = LINE ITEM OE110 0011910C*** C = COMMENT TO LINE ITEM OE110 11920C*** A USER IS NOT ALLOWED TO GO FROM ONE TYPE TO ANOTHER. OE110 11930C********************************************************************OE110 11940CSR E308 BEGSR OE110 11950CSR SETOF 97 OE110 11960CSR MOVELBUFFER DIG1 OE110 11970CSR SETOF 767778 OE110 0011980CSR DIG1 COMP ' ' 969676 OE110 11990CSR 96 DIG1 COMP 'L' 969677 OE110 12000CSR 96 DIG1 COMP 'C' 969678 OE110 12010CSR 96 GOTO END308 OE110 12020C* OE110 12030CSR MOVELLC,Y LCFLD 1 OE110 12040CSR 77 LCFLD COMP 'C' 96 OE110 0012050CSR 78 LCFLD COMP 'L' 96 OE110 12060CSR 96 GOTO END308 OE110 12070C* OE110 12080CSR LCFLD COMP ' ' 59 OE110 12090CSR 59 77 Z-ADD2 M 10 OE110 12100CSR 59 78 Z-ADD3 M OE110 12110CSR 76 Z-ADD4 M OE110 0012120CSR 76 SETON 59 OE110 12130CSRN59 GOTO END308 OE110 12140CSR MOVELZ BUFFER OE110 12150CSR MOVEL'12' BUFFER OE110 12160CSR EXSR POSCUR OE110 12170CSR MOVE 'S' TYPE OE110 12180CSR MOVELMS,M BUFFER OE110 0012190CSR Z-ADD62 BLNGTH OE110 12200CSR EXSR CRTCOM OE110 12210CSR MOVELB39 RECORD OE110 12220CSR MOVE ' ' POV,Y OE110 12230CSR MOVE SAVE BUFFER OE110 12240CSR END308 ENDSR OE110 12250C********************************************************************OE110 0012260C*** THIS SECTION EDITS THE PART # BY CHAINING TO PARTMST. OE110 12270C*** IF IT EXISTS THE DESCRIPTION IS DISPLAYED. OE110 12280C*** IF IT DOESN'T EXIST AN ERROR MESSAGE DISPLAYS AND THE OE110 12290C*** USER MUST TRY AGAIN. OE110 12300C********************************************************************OE110 12310CSR E309 BEGSR OE110 12320CSR MOVE B72 WRK9 OE110 0012330CSR MOVELBUFFER DIG12 12 OE110 12340CSR DIG12 CHAINPARTMST 96 NOT FOUND OE110 12350CSRN96 DPCODE COMP ' ' 9696 OE110 12360CSRN96 SETON 60 OE110 12370CSRN96 MOVELDESC WORD26 OE110 12380CSR MOVELBIN BUFFER OE110 12390CSR Z-ADD5 LEN OE110 0012400CSR Z-ADD114 STRT OE110 12410CSR Z-ADD4 WHICH1 OE110 12420CSR EXIT SUBRIN OE110 12430CSR RLABL WHICH1 OE110 12440CSR RLABL BUFFER OE110 12450CSR RLABL RECORD OE110 12460CSR RLABL BPOS 20 OE110 0012470CSR RLABL FPOS 20 OE110 12480CSR RLABL STRT 30 OE110 12490CSR RLABL LEN 20 OE110 12500CSRN96 SOH SUB SALLOC NEWSOH 70 89 OE110 12510CSRN96 MOVELWORD26 STR35 36 OE110 12520CSRN96 Z-ADD8 EPOS OE110 12530CSRN96 MOVE 'L' ECODE OE110 0012540CSRN96 EXIT SUBRED OE110 12550CSR RLABL NEWSOH OE110 12560CSR RLABL ECODE OE110 12570CSR RLABL WRK9 8 OE110 12580CSR RLABL EPOS OE110 12590CSR RLABL EWORD OE110 12600CSRN96 MOVE WRK9 STR35 OE110 0012610CSR 96 MOVELB72 STR35 OE110 12620CSR ENDSR OE110 12630C********************************************************************OE110 12640C*** THIS SECTION EDITS THE PRICE OVERRIDE. IF ZERO IS ENTERED, IT OE110 12650C*** IS TREATED AS A LINE FEED- THAT IS, WE REDISPLAY THE PREVIOUS OE110 12660C*** PRICE STORED IN LC (WHETHER IT'S THE FILE PRICE OR OVERRIDE). OE110 12670C*** IF NON-0 IT'S HANDLED NORMALLY & WE PUT A '1' IN POV TO OE110 0012680C*** INDICATE THIS ELEMENT HAS AN OVERRIDE (ONLY OVERRIDE PRICES OE110 12690C*** ARE OUTPUT TO FILES). THE ONLY WAY TO RETRIEVE A FILE PRICE OE110 12700C*** ONCE AN OVERRIDE WAS ENTERED IS TO BLANK THE LINE & RE-ENTER. OE110 12710C********************************************************************OE110 12720CSR E311 BEGSR OE110 12730CSR SETOF 97 OE110 12740CSR 33 GOTO END311 LINE-FEED:SKIP OE110 0012750CSR MOVELBUFFER PRICE 73 OE110 12760CSR PRICE COMP 0 59 OE110 12770CSRN59 MOVE '1' POV,Y OVERRIDE WAS OE110 12780CSRN59 GOTO END311 ENTERED OE110 12790CSR MOVE LC,Y WORK12 12 OE110 12800CSR MOVELWORK12 PRICE OE110 12810CSR MOVELPRICE SAVE OE110 0012820CSR MOVE SAVE BUFFER OE110 12830CSR END311 ENDSR OE110 12840C********************************************************************OE110 12850C*** THIS SECTION EDITS THE OK ? FIELD. OE110 12860C*** VALID ENTRIES ARE : OE110 12870C*** Y = YES - OK TO OUTPUT RECORDS OE110 12880C*** N = NO - DON'T OUTPUT RECORDS OE110 0012890C*** R = RETRY - GO BACK A SCREEN OE110 12900C********************************************************************OE110 12910CSR E411 BEGSR OE110 12920CSR MOVELBUFFER DIG1 OE110 12930CSR DIG1 COMP 'Y' 9696 OE110 12940CSR 96 DIG1 COMP 'N' 969669 OE110 12950CSR 96 DIG1 COMP 'R' 969664 OE110 0012960CSR SETOF 90 OE110 12970CSR ENDSR OE110 12980C********************************************************************OE110 12990C* THIS SUBROUTINE PERFORMS BATCH BALANCING. OE110 13000C* IF THE TYPE IS 'L' IT BRINGS OUT THE ARRAY ELEMENTS INTO OE110 13010C* RPG FIELD NAMES. THIS ROUTINE ADDS THE QUANTITIES OE110 13020C* AND PRICE OVERRIDES TO TOTAL FIELDS. IT COMPARES ACTUAL OE110 0013030C* TOTALS TO BATCH TOTALS. IF THEY DISAGREE, A MESSAGE IS OUTPUT OE110 13040C* TO NOTIFY THE USER THAT BATCHES ARE OUT OF BALANCE. OE110 13050C********************************************************************OE110 13060CSR BATCH BEGSR OE110 13070CSR Z-ADD0 TOTQT 70 OE110 13080CSR Z-ADD0 TOTPR 73 OE110 13090CSR Z-ADD0 Y OE110 0013100C* OE110 13110C*** THIS SECTION LOOPS THROUGH THE ARRAYS AND SUMS THE ELEMENTS. OE110 13120C* OE110 13130CSR LOOPA TAG OE110 13140CSR Y ADD 1 Y OE110 13150CSR Y COMP UPPER 59 OE110 13160CSR 59 GOTO LOOPB OE110 0013170CSR MOVELLC,Y LCFLD OE110 13180CSR LCFLD COMP ' ' 59 BLANK OE110 13190CSR 59 GOTO LOOPA OE110 13200CSR LCFLD COMP 'C' 59 COMMENT OE110 13210CSR 59 GOTO LOOPA OE110 13220CSR EXSR MVLINE OE110 13230CSR TOTQT ADD QTFLD TOTQT OE110 0013240CSR POV,Y COMP ' ' 59 NO OVERRIDE OE110 13250CSR 59 GOTO LOOPA OE110 13260CSR TOTPR ADD PRFLD TOTPR OE110 13270CSR GOTO LOOPA OE110 13280C* OE110 13290C*** THIS SECTION COMPARES THE ACTUAL TOTALS TO THE BATCH TOTALS. OE110 13300C* OE110 0013310CSR LOOPB TAG OE110 13320CSR BQTY SUB TOTQT DIFQT 70 QTY DIFFERENCE OE110 13330CSR BPR SUB TOTPR DIFPR 73 PRICE DIFF OE110 13340C* OE110 13350C*** THIS SECTION DISPLAYS THE TOTALS. OE110 13360C* OE110 13370CSR MOVE 2004 DIG4N 40 DISPLAYS OE110 0013380CSR MOVE BQTY DIG7N 70 BATCH QUANTITYOE110 13390CSR EXSR DISPLY OE110 13400C* OE110 13410CSR MOVE 2006 DIG4N DISPLAYS OE110 13420CSR MOVE TOTQT DIG7N ACTUAL QUANITYOE110 13430CSR EXSR DISPLY OE110 13440C* OE110 0013450CSR MOVE 2008 DIG4N DISPLAYS DIFF OE110 13460CSR MOVE DIFQT DIG7N IN QUANTITIES OE110 13470CSR EXSR DISPLY OE110 13480C* OE110 13490CSR MOVE 5804 DIG4N DISPLAYS BATCH OE110 13500CSR MOVE BPR DIG7N PRICE OVERRIDEOE110 13510CSR EXSR DISPLY OE110 0013520C* OE110 13530CSR MOVE 5806 DIG4N DISPLAYS ACTUALOE110 13540CSR MOVE TOTPR DIG7N PRICE OVERRIDEOE110 13550CSR EXSR DISPLY OE110 13560C* OE110 13570CSR MOVE 5808 DIG4N OE110 13580CSR MOVE DIFPR DIG7N OE110 0013590CSR EXSR DISPLY OE110 13600C* OE110 13610C*** THIS SECTION FINDS OUT IF THERE WAS A BATCH BALANCE ERROR. OE110 13620C*** AN ERROR CAUSES A MESSAGE TO BE OUTPUT. OE110 13630C* OE110 13640CSR DIFQT COMP 0 5858 BATCH OUT OF OE110 13650CSRN58 DIFPR COMP 0 5858 BALANCE-59 ON OE110 0013660CSR 58 Z-ADD1 M OE110 13670CSRN58 Z-ADD4 M OE110 13680CSR MOVEL'1311' BUFFER OE110 13690CSR EXSR POSCUR OE110 13700CSR MOVE 'S' TYPE OE110 13710CSR MOVELMS,M BUFFER OE110 13720CSR Z-ADD25 BLNGTH OE110 0013730CSR EXSR CRTCOM OE110 13740CSR ENDSR OE110 13750C********************************************************************OE110 13760C* THIS SUBROUTINE TAKES INFORMATION FOR LINE ITEMS OUT OF OE110 13770C* THE ARRAY LC AND PUTS THEM INTO FIELD NAMES. OE110 13780C* PRODUCT # LOCATION 3-14 OE110 13790C* QUANTITY LOCATION 16-22 OE110 0013800C* PRICE OVERRIDE LOCATION 33-39 OE110 13810C********************************************************************OE110 13820CSR MVLINE BEGSR OE110 13830CSR MOVE LC,Y WORD44 44 OE110 13840CSR Z-ADD12 NCHARS OE110 13850CSR Z-ADD3 SSTRT OE110 13860CSR Z-ADD1 TSTRT OE110 0013870CSR EXIT SUBRMV TRANSFER OE110 13880CSR RLABL WORD44 PRODUCT # OE110 13890CSR RLABL SSTRT 30 OE110 13900CSR RLABL NOFLD 12 OE110 13910CSR RLABL TSTRT 30 OE110 13920CSR RLABL NCHARS 30 OE110 13930C* OE110 0013940CSR Z-ADD7 NCHARS OE110 13950CSR Z-ADD16 SSTRT OE110 13960CSR EXIT SUBRMV TRANSFER OE110 13970CSR RLABL WORD44 QUANTITY OE110 13980CSR RLABL SSTRT 30 OE110 13990CSR RLABL WORD7 7 OE110 14000CSR RLABL TSTRT 30 OE110 0014010CSR RLABL NCHARS 30 OE110 14020CSR MOVE WORD7 QTFLD 70 OE110 14030C* OE110 14040CSR MOVELWORD44 WORD39 39 OE110 14050CSR MOVE WORD39 PRFLD 73 TRANSFER OE110 14060C* PRICE OVERRIDEOE110 14070CSR ENDSR OE110 0014080C********************************************************************OE110 14090C* THIS SUBROUTINE PICKS UP UNIT PRICES FROM PARTMST, DOES 'PUT' OE110 14100C* TO STORE THEM IN RECORD & LC, AND DOES 'OUTFLD' TO DISPLAY. OE110 14110C* IT USES THE POV ARRAY TO KEEP TRACK OF WHETHER THE PRICE IN LC OE110 14120C* IS AN OVERRIDE OR A FILE PRICE (BLANK=FILE,1=OVERRIDE) BECAUSE OE110 14130C* ONLY OVERRIDE PRICES WILL BE OUTPUT TO ORDINP. OE110 14140C* X MUST BE RESTORED TO 9 (FOR PART#) AT END OF SUBROUTINE. OE110 0014150C********************************************************************OE110 14160CSR OVRIDE BEGSR OE110 14170CSR Z-ADD11 X OE110 14180CSR POV,Y COMP '1' 59 OE110 14190CSR 59 GOTO DPRICE ALREADY IN LC OE110 14200CSR OPC COMP 0 5959 USE OVRD PC OE110 14210CSR 59 Z-ADDOPC SPC OE110 0014220CSR SPC COMP 1 59 59 OE110 14230CSR 59 SPC COMP 5 5959 OE110 14240CSR Z-ADD0 PRICE DEFAULT = 0 OE110 14250CSR 59 Z-ADDPB,SPC PRICE OE110 14260CSR MOVELPRICE BUFFER PUT PRICE IN OE110 14270CSR EXSR LNGTH RECORD & LC,Y OE110 14280CSR EXSR PUT1 OE110 0014290CSR DPRICE TAG DISPLAY PRICE OE110 14300CSR EXSR OUTFLD OE110 14310CSR Z-ADD9 X RESTORE X TO OE110 14320CSR EXSR XTYPE PART# OE110 14330CSR EXSR LNGTH OE110 14340CSR ENDSR OE110 14350C********************************************************************OE110 0014360C* THIS SUBROUTINE POSITIONS THE CURSOR AND DISPLAYS THE OE110 14370C* FIELD. USED IN SUBROUTINE BATCH. OE110 14380C********************************************************************OE110 14390CSR DISPLY BEGSR OE110 14400CSR MOVELDIG4N BUFFER POSITION OE110 14410CSR EXSR POSCUR CURSOR OE110 14420CSR Z-ADD8 DIG4N OE110 0014430CSR Z-ADDDIG4N EPOS OE110 14440CSR MOVE 'L' ECODE OE110 14450CSR MOVELB72 BUFFER OE110 14460CSR EXIT SUBRED OE110 14470CSR RLABL DIG7N FIELD FOR EDIT OE110 14480CSR RLABL ECODE 1 OE110 14490CSR RLABL EDTWRD 8 OE110 0014500CSR RLABL EPOS 20 OE110 14510CSR RLABL EWORD 24 OE110 14520C* OE110 14530CSR MOVELEDTWRD BUFFER OE110 14540CSR MOVE 'S' TYPE OE110 14550CSR Z-ADD8 BLNGTH OE110 14560CSR EXSR CRTCOM OE110 0014570CSR ENDSR OE110 14580C********************************************************************OE110 14590C* THIS SUBROUTINE OUTPUTS ALL THE INFORMATION FOR OE110 14600C* THE SALES ORDER. OE110 14610C* IF THE ORDER TYPE IS BLANK, RECORDS ARE OUTPUT TO ORDINP. OE110 14620C* IF THE ORDER TYPE IS E,C, OR M, RECORDS ARE OUTPUT OE110 14630C* OE110 0014640C* ONLY THE SALES ORDER # & A CODE FOR BATCHES BEING OUT OF OE110 14650C* BALANCE WILL BE OUTPUT TO SOTEMP. OE110 14660C********************************************************************OE110 14670CSR RECRDS BEGSR OE110 14680CSR OTYPE COMP ' ' 20 SALES ORDER OE110 14690CSR OTYPE COMP 'C' 21 CREDIT MEMO OE110 14700CSR OTYPE COMP 'E' 22 DIRECT BILL OE110 0014710CSR OTYPE COMP 'M' 23 MANUAL INVOICEOE110 14720C* OE110 14730CSR 21 OE110 14740COR 22 SETON 23 OE110 14750CSR SETON 25 OUTPUT HEADER, OE110 14760CSR EXCPT SHIP-TO, OE110 14770CSR SETOF 25 COMMENT RECORDOE110 0014780C* OUTPUT SOTEMP OE110 14790CSR SETON 26 OE110 14800CSR Z-ADD0 Y OE110 14810CSR Z-ADD0 CNT 20 OE110 14820CSR RLOOP TAG OE110 14830CSR Y ADD 1 Y OE110 14840CSR Y COMP UPPER 59 OE110 0014850CSR 59 GOTO ERECRD OE110 14860CSR MOVELLC,Y LCFLD OE110 14870CSR LCFLD COMP ' ' 59 OE110 14880CSR 59 GOTO RLOOP OE110 14890CSR LCFLD COMP 'L' 77 OE110 14900CSR 77 EXSR MVLINE OE110 14910CSR 77 NOFLD COMP B12 59SKIP ELEMENTS OE110 0014920CSR 59 GOTO RLOOP IF NO PART# OE110 14930CSR 77 POV,Y COMP ' ' 59NO OVRIDE PRCE OE110 14940CSR 59 Z-ADD0 PRFLD -OUTPUT ZERO OE110 14950CSRN77 MOVE LC,Y CMFLD 38 OE110 14960CSR CNT ADD 1 CNT OE110 14970CSR 77 NOFLD CHAINPARTMST 98 OE110 14980CSRN98 77 SALLOC ADD QTFLD SALLOC OE110 0014990CSR EXCPT OE110 15000CSR GOTO RLOOP OE110 15010CSR ERECRD TAG OE110 15020CSR SETOF 26 OE110 15030CSR ENDSR OE110 15040O********************************************************************OE110 15050O* ALL OUTPUT TO DISK FILES IS EXCEPTION OUTPUT OE110 0015060O********************************************************************OE110 15070O* OE110 15080O*** THIS SECTION OUTPUTS SALES ORDER # TO SOTEMP OE110 15090O*** PUTS AN 'X' IN REJECT CODE IF BATCHES WERE OUT OF BALANCE. OE110 15100O*** ALSO OUTPUTS THE ORDER TYPE. OE110 15110O* OE110 15120OSOTEMP EADD 25 OE110 0015130O DIG7 7 OE110 15140O 58 8 'X' OE110 15150O OTYPE 9 OE110 15160O* OE110 15170O*** THIS SECTION OUTPUTS HEADER RECORD TO ORDINP. OE110 15180O* OE110 15190OOPNORDS EADD 25 20 OE110 0015200O OR 25 23 OE110 15210O HEADER 118 OE110 15220O 2 '00' OE110 15230O SO 7 OE110 15240O 8 'H' OE110 15250O 23 OTYPE 105 OE110 15260O SO 110 OE110 0015270O 112 '00' OE110 15280O 113 'H' OE110 15290O* OE110 15300O*** THIS SECTION OUTPUTS SHIP-TO CUST TO ORDINP. OE110 15310O* OE110 15320O EADD 25 20 OE110 15330O OR 25 23 OE110 0015340O SHIP 118 OE110 15350O 2 '00' OE110 15360O SO 7 OE110 15370O 8 'I' OE110 15380O SO 110 OE110 15390O 112 '00' OE110 15400O 113 'I' OE110 0015410O* OE110 15420O*** THIS SECTION OUTPUTS THE MARK FOR COMMENTS RECORD TO ORDINP. OE110 15430O* OE110 15440O EADD 25 20 OE110 15450O OR 25 23 OE110 15460O COMENT 118 OE110 15470O 2 '00' OE110 0015480O SO 7 OE110 15490O 8 'K' OE110 15500O SO 110 OE110 15510O 112 '00' OE110 15520O 113 'K' OE110 15530O* OE110 15540O*** THIS SECTION OUTPUTS THE LINE ITEMS TO ORDINP. OE110 0015550O*** THESE CAN BE LINE ITEMS (77) OR LINE COMMENTS (N77). OE110 15560O* OE110 15570O EADD 26 20 OE110 15580O OR 26 23 OE110 15590O 2 '00' OE110 15600O SO 7 OE110 15610O 8 'L' OE110 0015620O CNT 10 OE110 15630O 77 11 'L' OE110 15640O N77 11 'M' OE110 15650O 77 NOFLD 23 OE110 15660O 77 QTFLD 30 OE110 15670O 77 PRFLD 58 OE110 15680O N77 CMFLD 49 OE110 0015690O SO 110 OE110 15700O CNT 112 OE110 15710O 77 113 'L' OE110 15720O N77 113 'M' OE110 15730O* OE110 15740OPARTMST E 26 20 77 OE110 15750O AND N98 OE110 0015760O SALLOC 173 OE110 15770O********************************************************************OE110 15780O* OE110 ** 015790ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 015800ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 015810ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 01582000ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 015830** 015840013102290331043005310630073108310930103111301231 015850** 015860 **BATCHES OUT OF BALANCE 1 015870[ ] [ ] [ ] 2 015880 [ ] 3 01589000 4 015900** 015910003 01 1 0159200044102**INVALID SALES ORDER # 02 2 0159300054103**INVALID TYPE 03 3 0159400064104**INVALID CUST # 04 4 0159500074109**INVALID DATE 05 5 015960000084110**INVALID DATE 06 6 0159700154115**INVALID TERMS 07 7 0159800164116**INVALID PRICE CODE 08 8 0159900174117**INVALID TAX CODE 09 9 0160000184118**INVALID SALESMAN # 10 10 0160100194119**INVALID AREA 11 11 016020020 12 12 01603000021 13 13 0160401034102**INVALID CUST # 14 14 0160503072321**INVALID 15 15 0160603081103* 16 16 0160703092703**INVALID PART # 17 17 016080311 18 18 0160904112413**INVALID 19 19 01610000 016110/* 016120__321**INVALID 15 15 0160603081103* 16 16 0160703092703**INVALID PART # 17 17 016080311 18 18 0160904112413**INVALID 19 19 0161000( TTXPOTIK P999999052478(000010H POTIK 00020FPOREC IP F 77 DISK POTIK 00030FPRTWOS IS F 36 25AI 1 DISK POTIK 00040FALLOUT O F 77 DISK POTIK 00050IPOREC NS 01 POTIK 00060I 1 77 ALL POTIK 00070IPRTWOS NS 02 POTIK 0000080I 1 20 PART POTIK 00090I 21 25 WONBR POTIK 00100I 30 36 QTYSRT POTIK 00110OALLOUT D 02 POTIK 00120O PART 77 POTIK 00130O WONBR 18 POTIK 00140O QTYSRT 27 POTIK 0000150O 5 '*****' POTIK 00160O D 01 POTIK 00170O ALL 77 POTIK /* 000190_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(Z TLABEL1 P051678051678(000010H LABEL100020X 1 1 LABELS00030FLDATA IPE F 138 138 DISK LABELS00040FPRINT O F 132 OF PRINTER LABELS00050ILDATA NS 77 00060I 1 30 CN1 00070I 31 58 ST1 0000080I 59 71 CITY1 00090I 72 75 STATE1 00100I 76 80 ZIP1 00110I 81 110 NAME1 00120OPRINT H 01 1P 00130O 1 ' ' 00140O D 3 77 006300000150O CN1 B 31 0064000160O D 1 77 0068000170O ST1 B 29 0069000180O D 1 77 0073000190O CITY1 B 14 0074000200O STATE1 B 19 0075000210O ZIP1 B 25 007600000220O D 1 77 00230O 6 'ATTN.' 00240O D 12 77 00250O NAME1 31 /* 000260_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0( ?OUTPUT P999999051078(0INVLMT ENTER L FOR LIMITS A 1 1 00010INVLMT01LOWER LIMIT XXXXX N 2 5 00020INVLMT02UPPER LIMIT XXXXX N 7 5 00030INVTAG ENTER T FOR TAG RCD A 1 1 00040INVTAG01TAG NO XXXXX N 2 5 00050INVTAG02PART NO XXXXXXXXXXXXA 2220 00060INVTAG03UNIT MEASURE XX A 13 2 0007000INVTAG04QUANTITY XXXXXXX N 15 7 00080JADDS TRANSACTION CODE N 00102 00090JADDS 01WORK ORDER # N 00305 00100JADDS 02PART NUMBER A 00824 00110JADDS 03STATUS A 03201 00120JADDS 04QUANTITY N 03307 00130JADDS 05RELEASE DATE N 04006 0014000JADDS 06REQUIRED DATE N 04606 00150JADDS 07PRIORITY A 05203 00160JADDS 08REQTS GEN CODE A 05501 00170JADDS 09 00000D 00180JCHGS TRANSACTION CODE N 00102 00190JCHGS 01WORK ORDER # N 00305 00200JCHGS 02OPERATION NUMBER N 00803 0021000JCHGS 03MATERIAL TYPE (R,S) A 01101 00220JCHGS 04QUANTITY N 01207 00230JCHGS 05LABOR GRADE A 01902 00240JCHGS 06DOLLARS N 02106 00250JCHGS 07PART NUMBER A 02724 00260JCHGS 08BURDEN FACTOR XXX.X N 05104 00270JCHGS 09'TO' OPERATION # N 05503 0028000JCHGS 10'TO' MATERIAL TYPE A 05801 00290JCHGS 11 00300MFG100 ENTER 'PS' AD00102 00310MFG10001ACTION (A,C,D,M) A 00301 00320MFG10002PARENT PART # A 00420 00330MFG10003COMPONENT PART # A 02420 00340MFG10004QUANTITY (XXXX.XXX) N 04407 0035000MFG10005INVENTORY CODE ( ,N)A 05201 00360MFG105 ENTER 'PS' AD00102 00370MFG10501PART # A 00420 00380MFG10502QUANTITY (XXXX) N 04404 00390MFG10503BOMP REQUEST (1-4) N 05101 00400MFG106 ENTER 'PS' AD00102 00410MFG10601PART # A 00420 0042000MFG10602QUANTITY (XXXX) N 04404 00430MFG10603BOMP REQUEST (1-2) N 05101 00440MFG107 ENTER 'PS' AD00102 00450MFG10701PART # A 00420 00460MFG10702QUANTITY (XXXX) N 04404 00470MFG10703BOMP REQUEST ( 5 ) N 05101 00480MFG200 ENTER 'R' AD 1 1 0049000MFG20001ACTION (A,C,D,M) A 2 1 00500MFG20002PART # A 320 00510MFG20003SEQ # (XX) N 15 2 00520MFG20004OPERATION CODE (XXX)A 17 3 00530MFG20005OP DESCRIPTION A 2020 00540MFG20006HRS/PC (XX.XXX) N 40 5 00550MFG20007SET UP (XX.X HRS) N 45 3 0056000MFG20008QUEUE (XX.X HRS) N 48 3 00570MFG20009WORK CENTER A 51 5 00580MFG20010LABOR GRADE A 56 2 00590MFG20011QUEUE FACTOR (X.XX) N 58 3 00600MFG20012OP CST (XXXX.XXX/UM)N 61 7 00610MFG20013OP CODE ( ,X,K) A 68 1 00620MFG20014 COMMENT A 6915 0063000MFG205 ENTER 'RR' AD 1 2 00640MFG20501PART # A 320 00650POH ENTER 'H' A 00801 00660POH 01PO# (XXXXX) N 00105 00670POH 02LOT# (XX) N 00602 00680POH 03ACTION (A,B,E) A 00901 00690POH 04DUE DATE (MMDDYY) N 02206 0070000POH 05VENDOR# N 03405 00710POH 06P.O. DATE (MMDDYY) N 03906 00720POH 07 00730POK ENTER 'K' A 00801 00740POK 01PO# (XXXXX) ND00105 00750POK 02LOT# (XX) ND00602 00760POK 03ACTION (A,B,E) AD00901 0077000POK 04P.O. COMMENT LINE# N 02801 00780POK 05P.O. COMMENT A 03430 00790POK 06 00800POL ENTER 'L' A 00801 00810POL 01PO# (XXXXX) ND00105 00820POL 02LOT# (XX) ND00602 00830POL 03ACTION (A,B,E) AD00901 0084000POL 04PART# A 01020 00850POL 05DUE DATE (MMDDYY) N 02206 00860POL 06 QTY ORDERED N 03907 00870POL 07BUY COST (XXXX.XXX) N 05307 00880POL 08 00890POLA ENTER 'L' AD00801 00900POLA 01PO# (XXXXX) N 00105 0091000POLA 02LOT# (XX) N 00602 00920POLA 03ACTION (A,B,E) AD00901 00930POLA 04PART# A 01020 00940POLA 05DUE DATE (MMDDYY) N 02206 00950POLA 06VENDOR# N 03405 00960POLA 07 QTY ORDERED N 03907 00970POLA 08BUY COST (XXXX.XXX) N 05307 0098000POLA 09 00990POLC ENTER 'L' AD00801 01000POLC 01PO# (XXXXX) N 00105 01010POLC 02LOT# (XX) N 00602 01020POLC 03ENTER 'C' AD00901 01030POLC 04PART# A 01020 01040POLC 05DUE DATE (MMDDYY) N 02206 0105000POLC 06VENDOR# N 03405 01060POLC 07QTY ORDERED N 03907 01070POLC 08QTY RECEIVED N 04607 01080POLC 09BUY COST (XXXX.XXX) N 05307 01090POLC 10 01100POLD ENTER 'L' AD00801 01110POLD 01PO# (XXXXX) N 00105 0112000POLD 02LOT# (XX) N 00602 01130POLD 03ENTER 'D' AD00901 01140POLD 04PART# A 01020 01150POLD 05DUE DATE (MMDDYY) N 02206 01160POLD 06 01170POLR ENTER 'L' AD00801 01180POLR 01PO# (XXXXX) ND00105 0119000POLR 02LOT# (XX) ND00602 01200POLR 03ENTER 'R' AD00901 01210POLR 04PART# A 01020 01220POLR 05QTY RECEIVED N 04607 01230POLR 06BUY COST (XXXX.XXX) N 05307 01240POLR 07PARTIAL RECEIPT? (P)A 06001 01250POLR 08 0126000_ 00 00 00 __ 0(, ,}TXWP400 Pv999999042078(000010H S WP400 00020X DECK-ID P06 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP400 00030F* EXPLODES PART NUMBERS TO FIRST LEVEL INVENTIONED COMPONENTS WP400 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP400 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP400 00060F* CONTROL DATA PROPRIETARY PRODUCT WP400 00070F* WP400 0000080FOHEXPL IPEAF 50 DISK WP400 00090FBOMMST IC F 47R20AI 28 DISK WP400 00100FBOMSTR IC F 74R DISK WP400 00110FPARTMST UC F 300R20AI 271 DISK WP400 00120FTRNWO2 O F 65 DISK A WP400 00130FPICK O F 104 DISK WP400 00140F* THIS PROGRAM EXPLODES THE PART NUMBERS ON 'OHEXPL' INTO 1ST LEVEL WP400 0000150F* COMPONENT PARTS. FOR EACH COMPONENT ENCOUNTERED AN INVENTORY WP400 00160F* TRANSACTION IS ADDED TO THE INVENTORY TRANSACTION FILE. THIS WP400 00170F* TRANSACTION DECREMENTS STOCK ON HAND. IF A PART ENCOUNTERED IN WP400 00180F* THE EXPLODE IS NOT AN INVENTORIED PART THE EXPLODE CONTINUES WP400 00190F* TO THE FIRST LEVEL COMPONENTS OF THE PART. WP400 00200F*** WP400 00210F* IF THE TRANSACTION NUMBER ON THE 'OHEXPL' FILE IS 52 THEN A WP400 0000220F* 'PICK' FILE RECORD IS OUTPUT FOR EVERY COMPONENT ENCOUNTERED WP400 00230F* IN THE EXPLODE WP400 00240F*** WP400 00250F* U1 - IF ON, THE STOCK ON HAND FIGURE IN PARTMST IS UPDATED TO WP400 00260F* REFLECT DRAW ON INVENTORY WP400 00270F* U2 - IF ON THE EXPLODE WILL CONTINUE DOWN IF THERE ARE AREN'T WP400 00280F* ENOUGH PARTS TO FILL PICK REQUIREMENT WP400 0000290E AP 26 24 WP400 00300E AQ 26 7 0 WP400 00310E AR 26 5 0 WP400 00320IOHEXPL NS 01 WP400 00330I 1 50WONUM WP400 00340I 6 25 PARTNO WP400 00350I 30 310TC WP400 0000360I 32 380QTY WP400 00370I 39 440DUEDAT WP400 00380IBOMMST NS 03 WP400 00390I 13 170RRNSTR WP400 00400IBOMSTR NS 05 WP400 00410I 1 20 PARENT WP400 00420I 55 74 COMPNT WP400 0000430I 25 313STRQTY WP400 00440I 32 360RRNREC WP400 00450I 37 410RRNDWN WP400 00460I 52 52 NXTCOD WP400 00470IPARTMST NS 07 WP400 00480I 74 74 DCODE WP400 00490I 51 51 INVCOD WP400 0000500I 1 37 DESC WP400 00510I 38 39 UM WP400 00520I 146 1520SOH WP400 00530I 167 1730ALLOC WP400 00540I 291 296 BINNO WP400 00550C MOVE ' ' BUFFER 72 WP400 00560C MOVE ' ' TYPE 1 WP400 0000570C Z-ADD0 MASK 10 WP400 00580C MOVE ' ' RCODE 1 WP400 00590C Z-ADD0 BLNGTH 20 WP400 00600C N01 GOTO DEND WP400 00610C TC COMP 52 70 WP400 00620C PARTNO CHAINBOMMST 55 WP400 00630C 55 EXSR IGNMSG WP400 0000640C 55 GOTO DEND WP400 00650C MOVELPARTNO PRNT 20 WP400 00660C Z-ADDQTY PQTY 70 WP400 00670C Z-ADDRRNSTR RRN 50 WP400 00675C PARTNO CHAINPARTMST 57 00680C SETON 81 WP400 00690C 70 EXCPT OUTPUT PARENT WP400 0000700C SETOF 81 WP400 00710C Z-ADD1 IND 20 WP400 00720C LOOP TAG WP400 00730C RRN COMP 0 20 WP400 00740C N20 GOTO SIBEND WP400 00750C RRN CHAINBOMSTR 56 WP400 00760C 56 EXSR BOMBIT WP400 0000770C PRNT COMP PARENT 20 WP400 00780C N20 GOTO SIBEND WP400 00790C NXTCOD COMP '1' 20 WP400 00800C RRN ADD 1 RRN WP400 00810C 20 Z-ADD0 RRN NEXT STR REC WP400 00820C STRQTY MULT PQTY EXQTY 70 WP400 00830C COMPNT CHAINPARTMST 55 WP400 0000840C 55 EXSR BOMBIT WP400 00850C INVCOD COMP 'N' 20 WP400 00860C 20 GOTO NXTDWN WP400 00870C Z-ADDSOH STOCK 70 WP400 00880C SOH SUB EXQTY SOH 20 WP400 00890C 20 ALLOC SUB SOH ALLOC WP400 00900C 20 Z-ADD0 SOH WP400 0000910C NU2 WP400 00920CORN20 GOTO OUTPUT WP400 00930C 0 SUB SOH EXQTY WP400 00940C NXTDWN TAG WP400 00950C RRNDWN COMP 0 2020 WP400 00960C 20 GOTO OUTPUT WP400 00970C Z-ADDPQTY AQ,IND WP400 0000980C Z-ADDRRN AR,IND WP400 00990C MOVELPRNT AP,IND WP400 01000C SETON 8182 WP400 01010C 70 EXCPT WP400 01020C SETOF 8182 WP400 01030C IND ADD 1 IND WP400 01040C IND COMP 26 20 WP400 0001050C 20 EXSR BOMBIT WP400 01060C Z-ADDRRNDWN RRN WP400 01070C Z-ADDEXQTY PQTY WP400 01080C MOVELCOMPNT PRNT WP400 01090C GOTO LOOP WP400 01100C SIBEND TAG WP400 01110C IND COMP 1 2020 WP400 0001120C 20 GOTO DEND WP400 01130C IND SUB 1 IND WP400 01140C MOVELAP,IND PRNT WP400 01150C Z-ADDAR,IND RRN WP400 01160C Z-ADDAQ,IND PQTY WP400 01170C GOTO LOOP WP400 01180C OUTPUT TAG WP400 0001190C SETON 80 WP400 01200C EXCPT WP400 01210C SETOF 80 WP400 01220C GOTO LOOP WP400 01230C DEND TAG WP400 01240C********************************************************************WP400 01250CSR IGNMSG BEGSR WP400 0001260CSR Z-ADD12 BLNGTH WP400 01270CSR MOVE 'T' TYPE WP400 01280CSR MOVELPARTNO BUFFER WP400 01290CSR EXITFSUBRCM WP400 01300CSR RLABL BUFFER 72 WP400 01310CSR RLABL TYPE 1 WP400 01320CSR RLABL BLNGTH 20 WP400 0001330CSR RLABL RCODE 1 WP400 01340CSR RLABL MASK 10 WP400 01350CSR RLABL DTYPE 10 WP400 01360CSR Z-ADD16 BLNGTH WP400 01370CSR MOVEL'NO COMPO'WORD16 16 WP400 01380CSR MOVE 'ONENTS 'WORD16 WP400 01390CSR MOVELWORD16 BUFFER WP400 0001400CSR EXITFSUBRCM WP400 01410CSR RLABL BUFFER 72 WP400 01420CSR RLABL TYPE 1 WP400 01430CSR RLABL BLNGTH 20 WP400 01440CSR RLABL RCODE 1 WP400 01450CSR RLABL MASK 10 WP400 01460CSR RLABL DTYPE 10 WP400 0001470CSR ENDSR WP400 01480C********************************************************************WP400 01490CSR BOMBIT BEGSR WP400 01500CSR MOVE 'R' TYPE WP400 01510CSR MOVEL'BOM FILE'WORD16 WP400 01520CSR MOVE ' ERROR 'WORD16 WP400 01530CSR MOVELWORD16 BUFFER WP400 0001540CSR Z-ADD1 MASK WP400 01550CSR EXITFSUBRCM WP400 01560CSR RLABL BUFFER 72 WP400 01570CSR RLABL TYPE 1 WP400 01580CSR RLABL BLNGTH 20 WP400 01590CSR RLABL RCODE 1 WP400 01600CSR RLABL MASK 10 WP400 0001610CSR RLABL DTYPE 10 WP400 01620CSR ENDSR WP400 01630C********************************************************************WP400 01640OTRNWO2 EADD 80 WP400 01650O COMPNT 61 WP400 01660O 14 '62' WP400 01670O EXQTY 21 WP400 0001680O 23 'WO' WP400 01690O WONUM 28 WP400 01700O UDATE 34 WP400 01710O U1 45 '1' WP400 01720OPICK E 81 WP400 01730O OR 80 70 WP400 01740O 81 1 'P' WP400 0001750O 82 1 'N' WP400 01760O WONUM 6 WP400 01770O PARTNO 104 WP400 01780O 80 COMPNT 104 WP400 01790O DESC 43 WP400 01800O UM 56 WP400 01810O 80 BINNO 49 WP400 0001820O QTY 68 WP400 01830O DUEDAT 74 WP400 01840O 80 STRQTY 68 WP400 01850O 80 EXQTY 75 WP400 01860O IND 77 WP400 01870O STOCK 84 WP400 01880OPARTMST E 80 U1 WP400 0001890O SOH 152 WP400 01900O ALLOC 173 WP400 ** 001910ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001920ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001930ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001940ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00195000/* 001960_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(1 ?TXMR770 Pf999999111111(000010H S MR770 00020X DECK-ID M42 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR770 00030F* SUGGESTED ORDER ACTION REPORT MR770 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR770 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR770 00060F* CONTROL DATA PROPRIETARY PRODUCT MR770 00070F* MR770 0000080FORDACT IPEAF 121 DISK MR770 00090FHEADING IT F 40 EDISK MR770 00100F$LP1 O F 132 OF PRINTER MR770 00110E HEADING HEAD 1 1 40 MR770 00120IORDACT NS 01 MR770 00130I 102 121 PN MR770 00140I 1 37 DESC MR770 0000150I 38 39 UM MR770 00160I 40 40 CLS MR770 00170I 41 470SOH MR770 00180I 48 540SOO MR770 00190I 55 610RESERV MR770 00200I 62 680MIN MR770 00210I 69 750LOTSIZ MR770 0000220I 76 810RDATE MR770 00230I 82 870ODATE MR770 00240I 88 940USAGE MR770 00250I 95 970LT MR770 00260I 98 1000SS MR770 00270I 101 101 OBFLAG 10 MR770 00280C NU2NU3 SETON H1 MR770 0000290C SETOF 2021 MR770 00300C CLS COMP 'P' 20 MR770 00310C U2 20 MR770 00320COR U3N20 SETON 21 MR770 00330C N21 GOTO END MR770 00340C SOH ADD SOO AVAIL 70 MR770 00350C AVAIL SUB RESERV AVAIL MR770 0000360C END TAG MR770 00370O$LP1 H 202 1P MR770 00380O OR OF MR770 00390O PAGE Z 8 MR770 00400O 4 'PAGE' MR770 00410O HEAD,1 86 MR770 00420O UDATE Y 132 MR770 0000430O H 2 1P MR770 00440O OR OF MR770 00450O 67 'ORDER ACTION-' MR770 00460O U2 77 'BUY ITEMS ' MR770 00470O U3 77 'MAKE ITEMS' MR770 00480O U2 U3 77 'ALL ITEMS ' MR770 00490O NU2NU3 87 'BAD OPT- RESPONSE' MR770 0000500O H 1 1P MR770 00510O OR OF MR770 00520O 43 'M' MR770 00530O 96 'LOT' MR770 00540O 115 'REQUIRED REORDER' MR770 00550O 131 'AVG LD STY' MR770 00556O 11 'PART NUMBER' 0000560O H 2 1P MR770 00570O OR OF MR770 00580O 12 'DESCRIPTION' MR770 00590O 60 'UM P SOH SOO' MR770 00600O 78 'RESERV AVAIL' MR770 00610O 104 'MIN SIZE DATE' MR770 00620O 131 'DATE USAGE TM STK' MR770 0000622O D 1 21 00624O PN 20 00630O D 2 21 MR770 00650O DESC 38 MR770 00660O UM 41 MR770 00670O CLS 43 MR770 00680O SOH L 52 MR770 0000690O SOO L 61 MR770 00700O N10 62 '*' MR770 00710O RESERVL 70 MR770 00720O AVAIL L 79 MR770 00730O MIN L 88 MR770 00740O LOTSIZL 97 MR770 00750O RDATE Y 106 MR770 0000760O ODATE Y 115 MR770 00770O USAGE 4 123 MR770 00780O LT 4 127 MR770 00790O SS 4 131 MR770 00800O T 1 LR MR770 00810O 11 'END OF JOB.' MR770 ** 00082000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000830ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000840ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000850ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000860/* 000870_ 00 00 00 00 00 00 00 00 00 __ 0(wZ wNTXPO330 P 052178052178(000010H S PO330N00020X DECK-ID M71 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO330 00030F* THIS PROGRAM PROCESSES VALID RECEIPTS, REMOVE DELETES + CLOSES PO PO330 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO330 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO330 00060F* CONTROL DATA PROPRIETARY PRODUCT PO330 00070F* PO330 0000080FPURUPD IPEAF 83 DISK PO330 00090FPURCH ISEAF 66 27AI 1 DISK PO330 00100FPARTMST UC F 300R20AI 271 DISK PO330 00110FNEWPUR O F 66 27AI 1 DISK PO330 00120FPOINDX O F 8 7AI 1 DISK PO330 00130FPOREC O F 77 DISK PO330 00140FTRANSAC O F 65 DISK A PO330 0000150F$LP1 O F 132 OF PRINTER PO330 00160FHEADING IT F 40 EDISK PO330 00170F* PO330 00180F* ************************************************************** PO330 00190F* ** ** PO330 00200F* ** COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO330 00210F* ** ** PO330 0000220F* ** SYSTEM - PINS PROGRAMMER- ROBBIE FREEMAN ** PO330 00230F* ** ** PO330 00240F* ** PROGRAM- PROCESS P.O. DATE CODED- 11/17/75 ** PO330 00250F* ** RECEIPTS,REMOVE ** PO330 00260F* ** DELETES. ** PO330 00270F* ** ** PO330 00280F* ************************************************************** PO330 0000290F* PO330 00300F* ************************************************************** PO330 00310F* ** ** PO330 00320F* ** FUNCTION OF INDICATORS ** PO330 00330F* ** ** PO330 00340F* ** 01 PURUPD- RECEIPTS ** PO330 00350F* ** 02 PURUPD- ALL OTHERS ** PO330 0000360F* ** 03 PURCH - OPEN P.O. ** PO330 00370F* ** 04 PURCH - RELEASE P.O. ** PO330 00380F* ** 05 PURCH - BLANKET P.O. ** PO330 00390F* ** 06 PURCH - DELETED P.O. ** PO330 00400F* ** 07 PARTMST ** PO330 00410F* ** 10 NO OVERRIDE BUY COST ON PURUPD ** PO330 00420F* ** 11 P.O. DATE IS ZERO - DON'T PRINT ** PO330 0000430F* ** 12 NO OVERRIDE BUY COST ON PURCH ** PO330 00440F* ** 20 ACTIVE P.O. ITEM ** PO330 00450F* ** 25 MATCHING PURCH REC READ FOR THIS L2(PO#) GROUP ** PO330 00460F* ** 30 THIS PO# ACTIVE- OUTPUT TO POINDX ** PO330 00470F* ** 40 PARTIAL/COMPLETE CODE NOT=P- ASSUME COMPLETE ** PO330 00480F* ** 44 ADD TR#44 TO TRANSAC ** PO330 00490F* ** 45 ADD TR#45 TO TRANSAC ** PO330 0000500F* ** 50 NEXT RECORD ON PURCH IS SAME PO#-PART# ** PO330 00510F* ** 51 QTYDUE-QTYIN IS +: CLOSE ONLY IF P/C NOT P ** PO330 00520F* ** 52N50 QTYDUE-QTYIN IS -: CLOSE- NEXT REC ON PURCH IS ** PO330 00530F* ** NOT SAME PO#-PART# SO OVERSHIP THIS REC ** PO330 00540F* ** 52 50 QTYDUE-QTYIN IS -: CLOSE- NEXT REC ON PURCH IS ** PO330 00550F* ** SAME PO#-PART# SO CARRY OVERAGE TO RECEIVE ** PO330 00560F* ** AGAINST NEXT REC ** PO330 0000570F* ** 53 QTYDUE-QTYIN IS 0: CLOSE ** PO330 00580F* ** 55 RECEIVE AGAINST THIS PO#-PART#. PRINT & OUTPUT ** PO330 00590F* ** TO POREC. ** PO330 00600F* ** 71 PO CODE=D - DELETED PURCH, REGARD AS NO MATCH ** PO330 00610F* ** N72 PO CODE NOT OPEN OR RELEASED - ERROR# 72 ** PO330 00620F* ** 73 NO HIT ON PARTMST- ERROR# 73 ** PO330 00630F* ** 74 ITEM CLOSED & UNDER RECEIVED ** PO330 0000640F* ** 75 ITEM CLOSED & OVER RECEIVED ** PO330 00650F* ** 99 TERMINAL ERROR FOR THIS RECEIPT ** PO330 00660F* ************************************************************** PO330 00670E TABN 1 10 2 0 TABM 32 ERR#'S- MESSAGES PO330 00680E HEADING HEAD 1 1 40 PO330 00690IPURUPD XX 01 8 CL 9 CR 29NCX PO330 00700I 1 70PO L2M2 PO330 0000710I 64 83 PART L1M1 PO330 00720I 46 520QTYREC PO330 00730I 53 593OVCOST 10 PO330 00740I 60 60 PC PO330 00750I XX 02 PO330 00760I 1 70PO L2M2 PO330 00770I 64 83 PROD L1M1 PO330 0000780IPURCH XX 03 66 C PO330 00790I 1 70PO L2M2 PO330 00800I 8 27 PART L1M1 PO330 00810I 28 330DUE PO330 00820I 28 290DYY PO330 00830I 30 330DMMDD PO330 00840I 34 380VEN PO330 0000850I 39 440PODAT 11 PO330 00860I 45 510QTYDUE PO330 00870I 52 580QTYIN PO330 00880I 59 653COST 12 PO330 00890I 66 66 POC PO330 00900I 1 66 ALL PO330 00910I XX 04 66 CR PO330 0000920I 1 70PO L2M2 PO330 00930I 8 27 PART L1M1 PO330 00940I 28 330DUE PO330 00950I 28 290DYY PO330 00960I 30 330DMMDD PO330 00970I 34 380VEN PO330 00980I 39 440PODAT 11 PO330 0000990I 45 510QTYDUE PO330 01000I 52 580QTYIN PO330 01010I 59 653COST 12 PO330 01020I 66 66 POC PO330 01030I 1 66 ALL PO330 01040I XX 05 66 CB PO330 01050I 1 70PO L2M2 PO330 0001060I 8 27 PART L1M1 PO330 01070I 66 66 POC PO330 01080I 1 66 ALL PO330 01090I XX 06 66 CD PO330 01100I 1 70PO L2M2 PO330 01110I 8 27 PART L1M1 PO330 01120I XX 08 PO330 0001130I 1 66 X PO330 01140I XX ** PO330 01150I 1 70LPO PO330 01160I 8 27 LPART PO330 01170I 66 66 LPOC PO330 01180IPARTMST XX 07 PO330 01190I 1 37 DESCR PO330 0001200I 74 74 DLTPT PO330 01202I 146 1520SOH 01204I 153 1590SOO 01210I 75 813MAT$ PO330 01220C SETOF 205599 PO330 01230C SETOF 7475 PO330 01240C Z-ADD0 ERR 20 PO330 0001250C L2 SETOF 2530 PO330 01260C L1 SETOF 447345 PO330 01270C L1 Z-ADD0 TRQTY1 70 PO330 01280C L1 Z-ADD0 TRQTY2 70 PO330 01290C L1 Z-ADD0 TOTREC 70 PO330 01300C L1 01 PART CHAINPARTMST 73 PO330 01310C L1 01N73DLTPT COMP ' ' 7373 PO330 0001320C 01 EXSR RECEPT PO330 01330C 03NMR PO330 01340COR 04NMR PO330 01350COR 05 SETON 2030 PO330 01360C 03 MR PO330 01370COR 04 MR EXSR MASTER PO330 01380C 99 ERR LOKUPTABN TABM 99 PO330 0001390C 99 ERRORS ADD 1 ERRORS 40 PO330 01400C* PO330 01410C* ************************************************************** PO330 01420C* ** SUBR RECEPT PROCESSES RECEIPT RECORDS FROM PURUPD. ** PO330 01430C* ** VALID RECEIPTS ARE ACCUMULATED FOR EACH UNIQUE ** PO330 01440C* ** PO#-PART# AND THIS TOTAL IS USED TO RECEIVE AGAINST ** PO330 01450C* ** THE OLDEST PO#-PART#-DUE DATE RECORD ON PURCH. ** PO330 0001460C* ************************************************************** PO330 01470C* PO330 01480CSR RECEPT BEGSR PO330 01490CSR LPOC COMP 'D' 71 D = NO MATCH PO330 01500CSR LPOC COMP ' ' 72 OPEN PO330 01510CSRN72 LPOC COMP 'R' 72 RELEASED PO330 01520CSRNMR P.O. ON FILE? PO330 0001530COR MR 71 Z-ADD71 ERR 99 PO330 01540CSR 99 GOTO ENDR NO PO330 01550CSRN72 Z-ADD72 ERR 99 NOT OPEN,REL PO330 01560CSR 99 GOTO ENDR PO330 01570CSR 73 Z-ADD73 ERR 99 BAD PART # PO330 01580CSR 99 GOTO ENDR PO330 01590C** PO330 0001600C** ALL CHECKS PASSED- ACCUMULATE TOT RECEIVED QTY FOR THIS PART # PO330 01610C** AND APPLY IT TO OLDEST DUE DATE WHEN PURCH READ. PO330 01620C** PO330 01630CSR TOTREC ADD QTYREC TOTREC PO330 01640CSR PC COMP 'P' 4040 NOT P- ASSUME PO330 01650C** COMPLETE PO330 01660CSR ENDR ENDSR PO330 0001670C* PO330 01680C* ************************************************************** PO330 01690C* ** SUBR MASTER PROCESSES THE MASTER RECORDS AFTER ALL ** PO330 01700C* ** RECEIPTS FOR THIS PART# HAVE BEEN READ FROM PURUPD. ** PO330 01710C* ************************************************************** PO330 01720C* PO330 01730CSR MASTER BEGSR PO330 0001740CSR SETON 2025 PO330 01750CSR TOTREC COMP 0 5555 PO330 01760CSRN55 SETON 30 0 RECEIPT QTY PO330 01770CSRN55 GOTO ENDM FORGET IT PO330 01780CSR PO COMP LPO 50LOOK-AHEAD PO# PO330 01790CSR 50 PART COMP LPART 50LOOK-AHEAD PR# PO330 01800CSR Z-ADDQTYIN SAVEIN 70 PO330 0001810CSR RECPTS ADD 1 RECPTS 40 PO330 01820CSR QTYIN ADD TOTREC QTYIN PO330 01830CSR QTYDUE SUB QTYIN DIFF 70 515253 PO330 01840CSR Z-ADD0 TOTREC PO330 01850C** PO330 01860C** IF DIFF IS NEG & NEXT PURCH RECORD IS SAME PO#-PART#, CLOSE PO330 01870C** THIS RECORD WITH QTYIN = QTYDUE & CARRY OVERAGE TO NEXT RECORD PO330 0001880C** TO RECEIVE AGAINST IT. IF DIFF IS POS, CLOSE ONLY IF PARTIAL/ PO330 01890C** COMPLETE CODE ON RECEIPT WAS NOT = 'P', OTHERWISE IT REMAINS PO330 01900C** ON FILE. IF DIFF IS ZERO, CLOSE THIS RECORD & LEAVE OTHERS PO330 01910C** ON PURCH UNCHANGED. FOR EACH ITEM ON PURCH THAT WE RECEIVE PO330 01920C** AGAINST (55 ON), WE OUTPUT A RECORD TO POREC & PRINT A LINE PO330 01930C** ON REPORT, WHETHER OR NOT IT WAS CLOSED. PO330 01940C** PO330 0001950CSR 50 52 Z-ADDQTYDUE QTYIN PO330 01960CSR 50 52 Z-SUBDIFF TOTREC PO330 01970CSR QTYIN SUB SAVEIN ACTREC 70 PO330 01980CSR TRQTY1 ADD ACTREC TRQTY1 4444 PO330 01982CSR 44 SOH ADD TRQTY1 SOH 01984CSR 44 SOO SUB TRQTY1 SOO 01990CSR 51 40 PO330 0002000COR 52 PO330 02010COR 53 SETOF 20 CLOSE ITEM PO330 02020CSRN20 QTYDUE SUB QTYIN CANCEL 70 PO330 02030CSRN20 TRQTY2 ADD CANCEL TRQTY2 4545 PO330 02035CSR 45 SOO SUB TRQTY2 SOO 02040CSR 20 SETON 30 ACTIVE PO#- PO330 02050C** POINDX OUTPUT PO330 0002060C** PO330 02070CSR 51 40 SETON 74 UNDER REC'D PO330 02080CSR 52N50 SETON 75 OVER REC'D PO330 02090CSR ENDM ENDSR PO330 02100ONEWPUR D 20 PO330 02110O ALL 66 PO330 02120O N05 QTYIN 58 PO330 0002130OPOINDX T L2 30 PO330 02140O PO 7 PO330 02150O POC 8 PO330 02160OPOREC D 55 PO330 02170O PART 77 PO330 02180O PO 19 PO330 02190O DMMDD 23 PO330 0002200O DYY 25 PO330 02210O UDATE 31 PO330 02220O VEN 36 PO330 02230O N12 COST 43 PO330 02240O N10 OVCOST 43 PO330 02250O QTYDUE 50 PO330 02260O ACTREC 57 PO330 0002270OTRANSAC TADD L1 44 PO330 02280O PART 61 PO330 02290O 14 '44' PO330 02300O TRQTY1 21 PO330 02310O PO 28 PO330 02320O UDATE 34 PO330 02330O N12 COST 41 PO330 0002340O N10 OVCOST 41 PO330 02350O TADD L1 45 PO330 02360O PART 61 PO330 02370O 14 '45' PO330 02380O TRQTY2 21 PO330 02390O PO 28 PO330 02400O UDATE 34 PO330 0002410O$LP1 H 02 1P PO330 02420O OR OF PO330 02430O 4 'PAGE' PO330 02440O PAGE Z 8 PO330 02450O HEAD 86 PO330 02460O UDATE Y 132 PO330 02470O H 2 1P PO330 0002480O OR OF PO330 02490O 70 'PURCHASE ORDER RECEIPT' PO330 02500O 77 'REPORT' PO330 02510O 132 'MFG330' PO330 02520O H 2 1P PO330 02530O OR OF PO330 02540O 53 'ORDER' PO330 0002550O 62 'DUE' PO330 02560O 78 'RECEIPT' PO330 02570O 86 'RECEIVD' PO330 02580O 95 'OVERRIDE' PO330 02581O H 11 1P 02582O OR OF 02583O 8 'PO#/LOT#' 0002584O 20 'PART NUMBER' 02590O H 01 1P PO330 02600O OR OF PO330 02630O 12 'DESCRIPTION' PO330 02640O 44 'VEND#' PO330 02650O 53 'DATE' PO330 02660O 62 'DATE' PO330 0002670O 70 'ORDERED' PO330 02680O 78 'QTY' PO330 02690O 86 'TO-DATE' PO330 02700O 99 'P/C' PO330 02710O 115 'COMMENTS/ERRORS' PO330 02711O D 2 01 99 02712O PO 8 ' - ' 0002713O PART 29 02720O D 1 01 99 PO330 02750O N73 DESCR 38 PO330 02760O QTYRECL 79 PO330 02770O N10 OVCOSTL 96 PO330 02780O PC 98 PO330 02790O TABM 132 PO330 0002791O D 2 55 02792O PO 8 ' - ' 02793O PART 29 02800O D 1 55 PO330 02830O DESCR 38 PO330 02840O VEN Z 44 PO330 02850O N11 PODAT Y 53 PO330 0002860O DMMDD 59 ' / ' PO330 02870O 60 '/' PO330 02880O DYY 62 PO330 02890O QTYDUEL 71 PO330 02900O ACTRECL 79 PO330 02910O QTYIN L 87 PO330 02920O N12 COST L 96 PO330 0002930O N10 OVCOSTL 96 PO330 02940O PC 98 PO330 02950O 20 117 'ITEM STILL ACTIVE' PO330 02960O N20 111 'ITEM CLOSED' PO330 02970O N20 74 128 '- UNDER RECEIVED' PO330 02980O N20 75 127 '- OVER RECEIVED' PO330 02990O T 21 L2 25N30 PO330 0003000O 108 '**** ENTIRE PO#' PO330 03010O PO 116 ' - ' PO330 03020O 132 'NOW CLOSED ****' PO330 03030O T 3 LR PO330 03040O 11 'END OF JOB.' PO330 03050O 23 'THERE WERE' PO330 03060O RECPTS3 28 PO330 0003070O 44 'ITEMS RECEIVED.' PO330 03080O T 1 LR PO330 03090O 23 'THERE WERE' PO330 03100O ERRORS3 28 PO330 03110O 36 'ERRORS.' PO330 03112OPARTMST T L1N73 44 03113O OR L1N73 45 0003114O SOH 152 03116O SOO 159 ** 003120ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00316000** 00317071PO/PART# NOT ON FILE *REJECTED* 00318072PO NOT OPEN OR REL'D *REJECTED* 00319073INVALID PART # *REJECTED* 003200 003210 003220 00323000 003240 003250 003260 003270/* 003280_ 00 00 00 00 00 __ 0(2S @DIS20OS PPP999999051278(000010H DIS20O00020FOUTPUT IPE F 80 DISK MFG10O00030F@DIS20 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060O@DIS20 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 __ 0(2 @DIS10OS PPP999999051278(000010H DIS10O00020FOUTPUT IPE F 80 DISK MFG10O00030F@DIS10 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060O@DIS10 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 __ 0(2 @DIS10IS PPP999999051278(000010H DIS10I00020F@DIS10 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040I@DIS10 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 __ 0( 9TXMR780 P999999111111(000010H S MR780 00020X 1 00030F* MRP INQUIRY MR780 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00060F* CONTROL DATA PROPRIETARY PRODUCT 00070F* 0000080FDUMMY IPEAF 72 DISK 00090FDISPLY D F 72 CONSOLE 00100FPARTMST IC F 300R20AI 271 DISK MFG78000110FREXPLD IC F 100R DISK 00120FHEADING IT F 40 EDISK MFG78000130F$LP1 O F 72 OF PRINTER U2 MFG78000140F* MFG7800000150F* ************************************************************** MFG78000160F* ** ** MFG78000170F* ** COMPUSOURCE MATERIAL REQUIREMENTS PLANNING ** MFG78000180F* ** ** MFG78000190F* ** MFG780 - MRP INQUIRY ** MFG78000200F* ** ** MFG78000210F* ** ROBBIE FREEMAN 6/30/76 ** MFG7800000220F* ** ** MFG78000230F* ************************************************************** MFG78000240F* ** FUNCTION OF INDICATORS ** MFG78000250F* ** ** MFG78000260F* ** 01 DUMMY ** MFG78000270F* ** 02 PARTMST ** MFG78000280F* ** 03 REXPLD- OJ,RJ,PO ** MFG7800000290F* ** 04 REXPLD- SO,PR ** MFG78000300F* ** 10 MIN = 0 - DON'T DISPLAY ** MFG78000310F* ** 11 RR# OF 1ST MRP=0- NO MRP ON FILE- DON'T CHAIN ** MFG78000320F* ** 12 REFLOT# IS BLANK (OJ'S & RJ'S) - DON'T DISPLAY ** MFG78000330F* ** 15 RGCODE IS BLANK - THIS RECORD DID NOT EXPLODE ** MFG78000340F* ** FURTHER - DON'T DISPLAY RGQTY (= 0) ** MFG78000350F* ** 20 SUBR SBEDIT: EDIT 6-DIGIT FIELD INSTEAD OF 7. ** MFG7800000360F* ** 31 ACCEPT WAS TERMINATED BY RUBOUT - ASK AGAIN ** MFG78000370F* ** 33 ACCEPT WAS TERMINATED BY LINEFEED - REDISPLAY ** MFG78000380F* ** 40 RESPONSE TO PART# OR "CONTINUE?" = 'E' = EOJ ** MFG78000390F* ** 50 PART# ACCEPTED-DON'T ASK AGAIN TILL END OF MRP ** MFG78000400F* ** 51 ON WHEN SUBR LINES IS BEING EXECUTED FOR L=1 ** MFG78000410F* ** (PARTMST 'BB' LINE) - OFF FOR REXPLD LINES ** MFG78000420F* ** 60 NEW PAGE FOR PRINTING SCREENS-EITHER START OF ** MFG7800000430F* ** NEW PART#, OR 3 SCREENS(3X16=48 LINES) PRINTED** MFG78000440F* ** 61 COUNT=1 - NEW PART# ** MFG78000450F* ** 64 COUNT=4 - 3 SCREENS PRINTED ** MFG78000460F* ** 65 EXCPT OUTPUT LINES ** MFG78000470F* ** 69 ALL LINES IN THIS ARRAY HAVE BEEN PRINTED ** MFG78000480F* ** 70 END OF INQUIRY FOR PART# - NO MORE REXPLD RECS ** MFG78000490F* ** - DO ENDING BALANCE LINE. ** MFG7800000500F* ** 80 AVAIL < MIN FOR THIS TRANS - FLAG WITH "**" ** MFG78000510F* ** 81 AVAIL WAS < MIN FOR AT LEAST ONE TRANS IN THIS ** MFG78000520F* ** PART# GROUP -(DISPLAY MIN IF IT IS NOT = 0) ** MFG78000530F* ** 82 FINAL AVAIL < MIN - DISPLAY "*ACTION*" ** MFG78000540F* ** 83 TOTAL SOO ON REXPLD DOES NOT MATCH SOO ON ** MFG78000550F* ** PARTMST - DISPLAY "OB" ** MFG78000560F* ** 90 USED FOR SUBR GETMSG - GET CURPOS,LENGTH FROM ** MFG7800000570F* ** ARRAY "MSG", BUT NOT MESSAGE. ** MFG78000580F* ** 91 ACCEPTING PART# ** MFG78000590F* ** 92 ACCEPTING "CONTINUE?" ** MFG78000600F* ** 99 ERROR IN EDIT - DISPLAY MESSAGE ** MFG78000610F* ** U1 SET MIN=0 MFG78000620F* ** U2 PRINTER NOT SELECTED - NO HARD COPY DESIRED ** MFG78000630F* ************************************************************** MFG7800000640F* MFG78000650E HEADING HEAD 1 1 40 COMPANY NAME MFG78000660E MSG 1 20 34 HEADINGS/MESSAGESMFG78000670E SED 1 7 3 SUBRED SPECS MFG78000680E SMV 1 9 6 0 SUBRMV SPECS MFG78000690E******** MFG78000700E* FORMAT OF MSG : 1-2 IS X, 3-4 IS Y, 5-6 IS LENGTH, 7-32 IS MES MFG7800000710E* FORMAT OF SED : 1-2 IS END POSITION, 3 IS EDIT CODE MFG78000720E* FORMAT OF SMV : 1-2 IS NCHARS, 3-4 IS SSTRT, 5-6 IS TSTRT MFG78000730E******** MFG78000740E LINE 16 72 MRP DETAIL LINES MFG78000750IDUMMY XX 01 MFG78000760I 1 1 A MFG78000770IPARTMST XX 02 MFG7800000780I 1 37 DESC MFG78000790I 38 39 UM MFG78000800I 40 40 CLS MFG78000810I 146 1520SOH MFG78000820I 153 1590SOO MFG78000830I 181 1870MIN 10 MFG78000840I 195 195 MMCODE MFG7800000850I 266 2700RR 11 MFG78000860IREXPLD XX 03 1 CO 2 CJ MFG78000870I OR 1 CR 2 CJ MFG78000880I OR 1 CP 2 CO MFG78000890I OR 04 1 CP 2 CR MFG78000900I OR 1 CS 2 CO MFG78000910I 61 80 PARTNO MFG7800000920I 20 21 REFLOT 12 MFG78000930I 22 280EXPQTY MFG78000940I 29 340REQDAT MFG78000950I 35 400TRDATE MFG78000960I 53 53 RGCODE 15 MFG78000970I 54 600RGQTY MFG78000980I 1 100 REC MFG7800000985I NS 05 00990C SETON LR MFG78001000CLR MOVE ' ' RCODE MFG78001010CLR MOVE ' ' B72 72 MFG78001020C************************ MFG78001030CLR BEGIN TAG MFG78001040C************************ MFG7800001050CLR EXSR CLRSCR MFG78001060CLR MOVE B72 LINE MFG78001070C** ***************MFG78001080CLR Z-ADD1 Y 20 DISPLAY MFG78001090CLR EXSR OUTPUT HEADINGS MFG78001100CLR Z-ADD2 Y MFG78001110CLR EXSR OUTPUT MFG7800001120CLR Z-ADD3 Y MFG78001130CLR EXSR OUTPUT MFG78001140CLR Z-ADD6 Y MFG78001150CLR EXSR OUTPUT MFG78001160CLR Z-ADD8 Y MFG78001170CLR EXSR OUTPUT MFG78001180CLR Z-ADD10 Y MFG7800001190CLR EXSR OUTPUT MFG78001200CLR Z-ADD12 Y MFG78001210CLR EXSR OUTPUT MFG78001220CLR Z-ADD13 Y MFG78001230CLR EXSR OUTPUT MFG78001240CLR Z-ADD14 Y MFG78001250CLR EXSR OUTPUT MFG7800001260CLR Z-ADD15 Y MFG78001270CLR EXSR OUTPUT MFG78001280CLRN50 EXSR FIRST ACCEPT PART# MFG78001290CLR 40 GOTO END EOJ MFG78001300CLRN50 GOTO DDESC MFG78001310C** ***************MFG78001320CLR SETON 90 DISPLAY PART# MFG7800001330CLR MOVELPART MES MFG78001340CLR Z-ADD4 Y MFG78001350CLR EXSR OUTPUT MFG78001360C************************ ***************MFG78001370CLR DDESC TAG DISPLAY DESC MFG78001380C************************ MFG78001390CLR SETON 5090 MFG7800001400CLR MOVELDESC MES MFG78001410CLR Z-ADD5 Y MFG78001420CLR EXSR OUTPUT MFG78001430C** ***************MFG78001440CLR SETON 90 DISPLAY UM MFG78001450CLR MOVELUM MES MFG78001460CLR Z-ADD7 Y MFG7800001470CLR EXSR OUTPUT MFG78001480C** ***************MFG78001490CLR SETON 90 DISPLAY CLASS MFG78001500CLR MOVELCLS MES MFG78001510CLR Z-ADD9 Y MFG78001520CLR EXSR OUTPUT MFG78001530C** ***************MFG7800001540CLR SETON 90 DISPLAY MMCODE MFG78001550CLR MOVELMMCODE MES MFG78001560CLR Z-ADD11 Y MFG78001570CLR EXSR OUTPUT MFG78001580C** ***************MFG78001590CLR EXSR GETREX DISPLAY REXPLD MFG78001600C** RECORDS MFG7800001610CLR 70 EXSR LAST DO ENDING BAL MFG78001620CLR 70 SETOF 50 MFG78001630C** ***************MFG78001640CLR Z-ADDL SAVEL 20 MFG78001650CLR Z-ADD0 L 20 MFG78001660CLR Z-ADD18 Y DISPLAY'CONT?' MFG78001670CLR EXSR OUTPUT MFG7800001680CLR SETON 92 MFG78001690CLR EXSR ACCEPT ACCEPT'CONT?' MFG78001700CLR SETOF 92 MFG78001710CLR U1 EXSR PRINT MFG78001720CLRN40 GOTO BEGIN MFG78001730C************************ MFG78001740CLR END TAG MFG7800001750C************************ MFG78001760CLR EXSR CLRSCR MFG78001770C********************************************************************MFG78001780C** SUBR FIRST **MFG78001790C** ACCEPTS PART# & SETS UP INITIAL CONDITIONS **MFG78001800C********************************************************************MFG78001810CSR FIRST BEGSR MFG7800001820CSR SETOF 8182 MFG78001830CSR Z-ADD0 NEWSOO 70 MFG78001840CSR Z-ADD0 COUNT 10 MFG78001850CSR Z-ADD1 PAGE MFG78001860CSR SETON 91 MFG78001870CSR EXSR ACCEPT MFG78001880CSR SETOF 91 MFG7800001890CSR Z-ADDSOH AVAIL 70 MFG78001900CSR Z-ADDSOH EXPQTY MFG78001910CSR U1 Z-ADD0 MIN 10 MFG78001920CSR SOH COMP MIN 80 SOH < MIN ? MFG78001930CSR 80 SETON 8182 MFG78001940CSR SETON 51 MFG78001950CSR ENDSR MFG7800001960C********************************************************************MFG78001970C** SUBR GETREX **MFG78001980C** CHAIN TO REXPLD FOR DETAIL - DO SUBR "LINES" TO SAVE **MFG78001990C********************************************************************MFG78002000CSR GETREX BEGSR MFG78002010CSR Z-ADD0 L MFG78002020CSR MOVE B72 LINE BLANK ARRAY MFG7800002030CSR 51 L ADD 1 L MFG78002040CSR 51 EXSR LINES MFG78002050CSR SETOF 51 MFG78002060C************************ MFG78002070CSR GLOOP TAG MFG78002080C************************ MFG78002090CSR SETOF 0304 BUG IN V3,R3 MFG7800002100CSR 11 SETON 70 MFG78002110CSRN11 RR CHAINREXPLD 70 MFG78002120CSRN70 PART COMP PARTNO 7070 MFG78002130CSR 70 GOTO ENDREX MFG78002140CSR L ADD 1 L MFG78002150CSR EXSR LINES MFG78002160CSR L COMP 16 70 MFG7800002170CSRN70 GOTO ENDREX MFG78002180CSR RR ADD 1 RR MFG78002190CSR GOTO GLOOP MFG78002200CSR ENDREX ENDSR MFG78002210C********************************************************************MFG78002220C** SUBR LINES **MFG78002230C** MOVE REXPLD FIELDS INTO ARRAY 'LINE' - DO "DSLINE" TO DISPLAY **MFG7800002240C********************************************************************MFG78002250CSR LINES BEGSR MFG78002260CSR 51 GOTO LTR 'BB' LINE MFG78002270CSRN15 GOTO LREF NO REQTS GEN MFG78002280C************************ MFG78002290CSR LRGQTY TAG MOVE RGQTY MFG78002300C************************ MFG7800002310CSR Z-ADDRGQTY N7 MFG78002320CSR Z-ADD1 I 10 MFG78002330CSR EXSR SBEDIT MFG78002340C************************ MFG78002350CSR LREF TAG MOVE REF# MFG78002360C************************ MFG78002370CSR MOVELREC SOURCE 0002380CSR Z-ADD2 I MFG78002390CSR EXSR SBMOVE MFG78002400CSR 12 GOTO LTRDAT LOT# BLANK MFG78002410C************************ MFG78002420CSR LLOT TAG MOVE LOT# MFG78002430C************************ MFG78002440CSR MOVEL'-' A3 3 MFG7800002450CSR MOVE REFLOT A3 MFG78002460CSR MOVELA3 SOURCE MFG78002470CSR Z-ADD3 I MFG78002480CSR EXSR SBMOVE MFG78002490C************************ MFG78002500CSR LTRDAT TAG MOVE TR DATE MFG78002510C************************ MFG7800002520CSR Z-ADDTRDATE N6 MFG78002530CSR Z-ADD2 I MFG78002540CSR SETON 20 MFG78002550CSR EXSR SBEDIT MFG78002560CSR SETOF 20 MFG78002570C************************ MFG78002580CSR LPARNT TAG MOVE CUST/VEND MFG7800002590C************************ /PARENT MFG78002600CSR MOVELREC SOURCE 02610CSR Z-ADD4 I MFG78002620CSR EXSR SBMOVE MFG78002630C************************ MFG78002640CSR LRQDAT TAG MOVE REQ DATE MFG78002650C************************ MFG7800002660CSR Z-ADDREQDAT N6 MFG78002670CSR Z-ADD3 I MFG78002680CSR SETON 20 MFG78002690CSR EXSR SBEDIT MFG78002700CSR SETOF 20 MFG78002710C************************ MFG78002720CSR LTR TAG MOVE TR MFG7800002730C************************ MFG78002740CSR MOVELREC SOURCE 02750CSR 51 MOVEL'BB' SOURCE MFG78002760CSR Z-ADD1 I MFG78002770CSR EXSR SBMOVE MFG78002780C************************ MFG78002790CSR LQTY TAG MOVE QTY MFG7800002800C************************ MFG78002810CSR Z-ADDEXPQTY N7 MFG78002820CSR Z-ADD4 I MFG78002830CSR EXSR SBEDIT MFG78002840C************************ MFG78002850CSR LAVAIL TAG MOVE AVAIL MFG78002860C************************ MFG7800002870CSRN51 EXSR SUBAVL MFG78002880CSR Z-ADDAVAIL N7 MFG78002890CSR Z-ADD5 I MFG78002900CSR EXSR SBEDIT MFG78002910C************************ MFG78002920CSR FLAG TAG MOVE FLAG IF MFG78002930C************************ AVAIL < MIN MFG7800002940CSRN80 GOTO DISPLY MFG78002950CSR MOVEL'**' SOURCE MFG78002960CSR EXSR SBMOVE MFG78002970C************************ MFG78002980CSR DISPLY TAG DISPLAY LINE MFG78002990C************************ MFG78003000CSR EXSR DSLINE MFG7800003010CSR ENDSR MFG78003020C********************************************************************MFG78003030C** SUBR LAST **MFG78003040C** MOVE ENDBAL VALUES TO ARRAY,CHECK FOR ACTION,DISPLAY 'EB' LINE **MFG78003050C********************************************************************MFG78003060CSR LAST BEGSR MFG78003070CSR L ADD 1 L MFG7800003080CSR MOVEL'EB' SOURCE MOVE TR MFG78003090CSR Z-ADD1 I MFG78003100CSR EXSR SBMOVE MFG78003110CSR 10 MIN = 0 MFG78003120CORN81 GOTO ACTION OR NO FLAGS MFG78003130CSR MOVEL'(MIN= 'A13 13 MFG78003140CSR MOVE ' )' A13 MFG7800003150CSR MOVELA13 SOURCE MFG78003160CSR Z-ADD6 I MFG78003170CSR EXSR SBMOVE MFG78003180CSR Z-ADDMIN N7 MFG78003190CSR EXSR SBEDIT MFG78003200C************************ MFG78003210CSR ACTION TAG MFG7800003220C************************ MFG78003230CSRN82 GOTO ENDBAL MFG78003240CSR MOVEL'*ACTION*'SOURCE MFG78003250CSR Z-ADD7 I MFG78003260CSR EXSR SBMOVE MFG78003270C************************ MFG78003280CSR ENDBAL TAG MFG7800003290C************************ MFG78003300CSR Z-ADDAVAIL N7 MFG78003310CSR Z-ADD5 I MFG78003320CSR EXSR SBEDIT MFG78003330C************************ MFG78003340CSR OB TAG MFG78003350C************************ MFG7800003360CSR NEWSOO COMP SOO 8383 MFG78003370CSRN83 GOTO EFLAG SOO IS OK MFG78003380CSR MOVEL'OB' SOURCE OUT-OF-BALANCE MFG78003390CSR Z-ADD8 I -MOVE 'OB' MFG78003400CSR EXSR SBMOVE MFG78003410C************************ MFG78003420CSR EFLAG TAG MFG7800003430C************************ MFG78003440CSRN80 GOTO EDSPLY MFG78003450CSR MOVEL'**' SOURCE MFG78003460CSR Z-ADD5 I MFG78003470CSR EXSR SBMOVE MFG78003480C************************ MFG78003490CSR EDSPLY TAG DISPLAY 'EB' MFG7800003500C************************ MFG78003510CSR EXSR DSLINE MFG78003520CSR ENDSR MFG78003530C********************************************************************MFG78003540C** SUBR SUBAVL **MFG78003550C** COMPUTE AVAIL - CHECK IF BELOW MIN **MFG78003560C********************************************************************MFG7800003570CSR SUBAVL BEGSR COMPUTE AVAIL MFG78003580CSR 03 NEWSOO ADD EXPQTY NEWSOO MFG78003590CSR 03 AVAIL ADD EXPQTY AVAIL MFG78003600CSR 04 AVAIL SUB EXPQTY AVAIL MFG78003610CSR AVAIL COMP MIN 80 MFG78003620CSR 80 SETON 8182 MFG78003630CSRN80 SETOF 82 MFG7800003640CSR ENDSR MFG78003650C********************************************************************MFG78003660C** SUBR SBMOVE **MFG78003670C** MOVE REXPLD FIELDS FROM 'SOURCE' TO 'LINE,L' **MFG78003680C********************************************************************MFG78003690CSR SBMOVE BEGSR MFG78003700CSR MOVE LINE,L TARGET MFG7800003710CSR MOVE SMV,I N4 40 MFG78003720CSR MOVELSMV,I TN 20 03730CSR Z-ADDTN NCHARS 03740CSR MOVELN4 TS 20 03750CSR MOVE N4 TT 20 03760CSR Z-ADDTS SSTRT 03770CSR Z-ADDTT TSTRT 0003780CSR EXIT SUBRMV SUBMV 03790CSR RLABL SOURCE 72 03800CSR RLABL SSTRT 30 SUBMV 03810CSR RLABL TARGET 72 03820CSR RLABL TSTRT 30 SUBMV 03830CSR RLABL NCHARS 30 SUBMV 03840CSR MOVE TARGET LINE,L MFG7800003850CSR ENDSR MFG78003860C********************************************************************MFG78003870C** SUBR SBEDIT **MFG78003880C** MOVE & EDIT REXPLD NUMERIC FIELDS TO 'LINE,L' **MFG78003890C********************************************************************MFG78003900CSR SBEDIT BEGSR MFG78003910CSR MOVE LINE,L TARGET MFG7800003920CSR MOVE SED,I ECODE MFG78003930CSR MOVELSED,I EPOS MFG78003940CSR EPOS COMP 07 71 03950CSR MOVE EPOS MPOS 30 03960CSR MOVE 08 EPOS 03970CSR MOVE B72 EWORD 24 MR780 03980CSR 20 GOTO SBED6 MFG7800003990CSR EXIT SUBRED SUBED 04000CSR RLABL N7 70 04010CSR RLABL ECODE 1 SUBED 04020CSR RLABL TARA 08 04030CSR RLABL EPOS 20 SUBED 04040CSR RLABL EWORD 24 SUBED 04050CSRN71 MPOS SUB 008 MPOS 0004060CSR 71 MOVE 01 MPOS 04070CSR MOVE MPOS TSTRT 04080CSR MOVELTARA SOURCE 04090CSR MOVE 001 SSTRT 04100CSR MOVE LINE,L TARGET 04110CSRN71 MOVE 008 NCHARS 04120CSR 71 MOVE 007 NCHARS 0004130CSR 71 MOVE 2 SSTRT 04140CSR EXIT SUBRMV 04150CSR RLABL SOURCE 72 04160CSR RLABL SSTRT 30 04170CSR RLABL TARGET 72 04180CSR RLABL TSTRT 30 04190CSR RLABL NCHARS 30 0004200CSR GOTO ENDSB MFG78004210C************************ MFG78004220CSR SBED6 TAG MFG78004230C************************ MFG78004240CSR EXIT SUBRED SUBED 04250CSR RLABL N6 60 04260CSR RLABL ECODE 1 SUBED 0004270CSR RLABL TARA 08 04280CSR RLABL EPOS 20 SUBED 04290CSR RLABL EWORD 24 SUBED 04300CSRN71 MPOS SUB 008 MPOS 04310CSR 71 MOVE 001 MPOS 04320CSR MOVE MPOS TSTRT 04330CSR MOVELTARA SOURCE 0004340CSR MOVE 001 SSTRT 04350CSR MOVE LINE,L TARGET 04360CSRN71 MOVE 008 NCHARS 04370CSR 71 MOVE 007 NCHARS 04380CSR 71 MOVE 2 SSTRT 04390CSR EXIT SUBRMV 04400CSR RLABL SOURCE 72 0004410CSR RLABL SSTRT 30 04420CSR RLABL TARGET 72 04430CSR RLABL TSTRT 30 04440CSR RLABL NCHARS 30 04450C************************ MFG78004460CSR ENDSB TAG MFG78004470C************************ MFG7800004480CSR MOVELTARGET LINE,L 04490CSR ENDSR MFG78004500C********************************************************************MFG78004510C** SUBR ACCEPT **MFG78004520C** ACCEPT FROM CRT - DO EDIT & DISPLAY ERRORS **MFG78004530C********************************************************************MFG78004540CSR ACCEPT BEGSR MFG7800004550C************************ MFG78004560CSR BEGACC TAG MFG78004570C************************ MFG78004580CSR 91 Z-ADD4 Y PART# MFG78004590CSR 92 Z-ADD19 Y 'CONTINUE?' MFG78004600CSR EXSR GETMSG MFG78004610C************************ MFG7800004620CSR ACLOOP TAG MFG78004630C************************ MFG78004640CSR MOVELXYPOS BUFFER MFG78004650CSR EXSR POSCUR MFG78004660CSR MOVE LENG BLNGTH MFG78004670CSR MOVE 'A' TYPE MFG78004680CSR EXSR CRTCOM MFG7800004690CSR RCODE COMP 'R' 31 RUBOUT MFG78004700CSR 31 GOTO ACLOOP MFG78004710CSR RCODE COMP 'L' 33 LINE FEED MFG78004720CSRN33 91 MOVELBUFFER PART 20 MFG78004730CSRN33 92 MOVELBUFFER CONT 1 MFG78004740CSR MOVELXYPOS BUFFER MFG78004750CSR EXSR POSCUR MFG7800004760CSR 91 MOVELPART BUFFER MFG78004770CSR 92 MOVELCONT BUFFER MFG78004780CSR MOVE 'S' TYPE MFG78004790CSR EXSR CRTCOM MFG78004800C************************ MFG78004810CSR ENDACC TAG MFG78004820C************************ MFG7800004830CSR EXSR EDIT MFG78004840CSR 99 GOTO BEGACC MFG78004850CSR ENDSR MFG78004860C********************************************************************MFG78004870C** SUBR GETMSG **MFG78004880C** GET XYPOS, LENGTH, MESSAGE FROM 'MSG' ARRAY **MFG78004890C********************************************************************MFG7800004900CSR GETMSG BEGSR MFG78004910CSR MOVE MSG,Y WORD26 28 MFG78004920CSRN90 MOVELWORD26 MES 72 MFG78004930CSR MOVELMSG,Y WORD6 6 MFG78004940CSR MOVELWORD6 XYPOS 40 MFG78004950CSR XYPOS ADD L XYPOS MFG78004960CSR MOVE WORD6 LENG 20 MFG7800004970CSR ENDSR MFG78004980C********************************************************************MFG78004990C** SUBR EDIT **MFG78005000C** EDIT CRT ACCEPTED FIELDS - DO "OUTPUT" TO DISPLAY ERRORS **MFG78005010C********************************************************************MFG78005020CSR EDIT BEGSR MFG78005030CSR SETOF 99 MFG7800005040CSR MOVE B72 MES MFG78005050CSR 91 GOTO E91 MFG78005060CSR 92 GOTO E92 MFG78005070CSR GOTO EEDIT MFG78005080C************************ MFG78005090CSR E91 TAG PART# MFG78005100C************************ MFG7800005110CSR Z-ADD5 Y MFG78005120CSR MOVELPART A2 2 MFG78005130CSR A2 COMP 'E ' 40 EOJ? MFG78005140CSR 40 SETON 90 YES MFG78005150CSR 40 GOTO EEDIT MFG78005160CSR PART CHAINPARTMST 99 PART# OK? MFG78005170CSRN99 SETON 90 YES MFG7800005180CSR GOTO EEDIT MFG78005190C************************ MFG78005200CSR E92 TAG 'CONTINUE?' MFG78005210C************************ MFG78005220CSR CONT COMP 'E' 40 EOJ? MFG78005230CSR 40 SETON 90 YES MFG78005240C** ELSE, CONTINUE MFG7800005250C************************ MFG78005260CSR EEDIT TAG MFG78005270C************************ MFG78005280CSR EXSR OUTPUT MFG78005290CSR ENDSR MFG78005300C********************************************************************MFG78005310C** SUBR OUTPUT **MFG7800005320C** DISPLAY HEADINGS, MESSAGES **MFG78005330C********************************************************************MFG78005340CSR OUTPUT BEGSR MFG78005350CSR EXSR GETMSG MFG78005360CSR MOVELXYPOS BUFFER MFG78005370CSR EXSR POSCUR MFG78005380CSR MOVE LENG BLNGTH MFG7800005390CSR MOVE 'S' TYPE MFG78005400CSR MOVELMES BUFFER MFG78005410CSR EXSR CRTCOM MFG78005420CSR SETOF 90 MFG78005430CSR ENDSR MFG78005440C********************************************************************MFG78005450C** SUBR DSLINE **MFG7800005460C** DISPLAY 'LINE,L' (DO "OUTPUT" TWICE SINCE BLNGTH CAN'T BE >70) **MFG78005470C********************************************************************MFG78005480CSR DSLINE BEGSR MFG78005490CSR SETON 90 MFG78005500CSR MOVELLINE,L MES MFG78005510CSR Z-ADD16 Y MFG78005520CSR EXSR OUTPUT CRT POS 1-40 MFG7800005530CSR SETON 90 MFG78005540CSR MOVE LINE,L A32 32 MFG78005550CSR MOVELA32 MES MFG78005560CSR Z-ADD17 Y MFG78005570CSR EXSR OUTPUT CRT POS 41-72 MFG78005580CSR ENDSR MFG78005590C********************************************************************MFG7800005600C** SUBR CRTCOM **MFG78005610C********************************************************************MFG78005620CSR CRTCOM BEGSR MFG78005630CSR EXITFSUBRCM MFG78005640CSR RLABL BUFFER 72 MFG78005650CSR RLABL TYPE 1 MFG78005660CSR RLABL BLNGTH 20 MFG7800005670CSR RLABL RCODE 1 MFG78005680CSR RLABL MASK 10 MFG78005690CSR RLABL DTYPE 10 MFG78005700CSR ENDSR MFG78005710C********************************************************************MFG78005720C** SUBR POSCUR **MFG78005730C********************************************************************MFG7800005740CSR POSCUR BEGSR MFG78005750CSR MOVE 'P' TYPE MFG78005760CSR EXSR CRTCOM MFG78005770CSR ENDSR MFG78005780C********************************************************************MFG78005790C** SUBR CLRSCR **MFG78005800C********************************************************************MFG7800005810CSR CLRSCR BEGSR MFG78005820CSR MOVE 'C' TYPE MFG78005830CSR EXSR CRTCOM MFG78005840CSR ENDSR MFG78005850C********************************************************************MFG78005860C** SUBR PRINT **MFG78005870C** PRINT HARD COPY OF SCREENS IF U1 ON - UP TO 3 SCREENS PER PAGE **MFG7800005880C********************************************************************MFG78005890CSR PRINT BEGSR MFG78005900CSR COUNT ADD 1 COUNT MFG78005910CSR COUNT COMP 1 61 MFG78005920CSR COUNT COMP 4 64 MFG78005930CSR 64 Z-ADD1 COUNT MFG78005940CSR 61 MFG7800005950COR 64 SETON 60 MFG78005960CSR SETON 60 05970CSR 60 EXCPT MFG78005980CSR SETOF 60 MFG78005990CSR Z-ADD0 P 20 MFG78006000C************************ MFG78006010CSR PLOOP TAG MFG7800006020C************************ MFG78006030CSR P ADD 1 P MFG78006040CSR SETON 65 MFG78006050CSR EXCPT MFG78006060CSR SETOF 65 MFG78006070CSR P COMP SAVEL 69 MFG78006080CSRN69 GOTO PLOOP MFG7800006090CSR ENDSR MFG78006100C********************************************************************MFG78006110O$LP1 E 01 60 MFG78006120O PAGE Z 8 MFG78006130O 4 'PAGE' MFG78006140O HEAD,1 56 MFG78006150O UDATE Y 72 MFG7800006160O E 2 60 MFG78006170O 46 'MATERIAL REQUIREMENTS' MFG78006180O 72 'MFG780' MFG78006190O E 1 60 MFG78006200O 6 'PART#-' MFG78006210O PART 28 MFG78006215O E 2 60 0006220O DESC 37 MFG78006230O 52 'UM-' MFG78006240O UM 55 MFG78006250O 61 'CLS-' MFG78006260O CLS 63 MFG78006270O 70 'CODE-' MFG78006280O MMCODE 72 MFG7800006290O E 21 60 MFG78006300O 7 'REQTS?' MFG78006310O 10 'TR' MFG78006320O 19 'REF #' MFG78006330O 28 'TR DATE' MFG78006340O 39 'C/V/PARENT' MFG78006350O 50 'REQ DATE' MFG7800006360O 58 'QTY' MFG78006370O 67 'AVAIL' MFG78006380O E 1 65 MFG78006390O LINE,P 72 MFG780** 06400ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 06410ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 0642000ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 06430ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 06440** MSG: HEADINGS,MESSAGES M06450260021MATERIAL REQUIREMENTS M06460670006MFG780 M06470010128PART# [ ] M06480080120 M0649000010237**INVALID PART NUMBER M06500500206UM- M06510540202 M06520580206CLS- M06530630201 M06540660207CODE- M06550720201 M0656000020418REQTS? TR REF # M06570220418TR DATE C/V/PARENT M06580430416REQ DATE QTY M06590630405AVAIL M06600010640 M06610410632 M06620262214CONTINUE ? [ ] M0663000382201 M06640 06650** SED: SUBRED SPECS (POS. 1 TO 2 IS EPOS, 3 IS EDIT CODE) M06660074 RGQTY M0667028Y TRDATE M0668050Y REQDAT M0669059L EXPQTY M067000068L AVAIL M06710413 MIN M06720 06730** SMV: SUBRMV SPECS (1-2 IS NCHARS, 3-4 IS SSTRT, 5-6 IS TSTRT) M06740020109 TR M06750051512 REF# M06760030117 A3 = REFLOT M0677000124130 PARENT M06780020171 FLAG M06790130130 A13 = "(MIN= )" M06800080152 "*ACTION*" M06810020169 "OB" M06820 06830/* 0684000_ 00 00 00 00 00 00 00 00 00 __ 0(21 DISPR1IS PPP051378051378(000010H DISPRI00020FDISPR1 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040IDISPR1 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 __ 0(2k DISPR1OS PPP051378051378(000010H DISPRO00020FOUTPUT IPE F 80 DISK MFG10O00030FDISPR1 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060ODISPR1 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 __ 0(, ,}TXPI630 PDv091177111111(000010H S PI630 00020X DECK-ID M52 MFG/DIST/ACCT SYSTEM SUMMARY-123 PI630 00030F* THIS PROGRAM PROCESSES TRANSACTIONS ONTO THE PARTMST FILE PI630 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0PI630 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PI630 00060F* CONTROL DATA PROPRIETARY PRODUCT PI630 00070F* PI630 0000080FTRANWRK IPEAF 65 DISK PI630 00090FPARTMST UC F 300R20AI 271 DISK PI630 00100F********************************************************************PI630 00110F* PI630 00120F* PACKAGE MANUFACTURING PI630 00130F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING PI630 00140F* PI630 0000150F* CONTRACTOR COMPUSOURCE PI630 00160F* PROGRAMMER KATH HILL PI630 00170F* DATE OCTOBER 31, 1975 PI630 00180F* PI630 00190F********************************************************************PI630 00200F* PI630 00210F* NARRATIVE: USES TRANWRK RECORDS TO UPDATE PARTMST. PI630 0000220F* PI630 00230F********************************************************************PI630 00240F* PI630 00250F* ID F C H L FUNCTION OF INDICATORS PI630 00260F* PI630 00270F* 01 TRANTMP PI630 00280F* 02 PARTMST PI630 0000290F* PI630 00300F* 11 UNIT COST = 0 PI630 00310F* 12 DELETE CODE ON PARTMST BLANK PI630 00320F* PI630 00330F* 20 CHAIN TO PARTMST A MISS PI630 00340F* L1PART # PI630 00350F* PI630 0000360F********************************************************************PI630 00370ITRANWRK NS 01 PI630 00380I 42 61 PARTNOL1 PI630 00390I 13 140TRANNO PI630 00400I 15 210QTY PI630 00410I 22 28 REFNUM PI630 00420I 29 340TRANDT PI630 0000440IPARTMST NS 02 PI630 00450I 74 74 DLTPR 12 PI630 00460C* ---------------PI630 00470C L1 MOVELPARTNO PRTNUM 20 PI630 00480C QTY ADD WORK WORK 70 PI630 00490CL1 PRTNUM CHAINPARTMST 20 PI630 00500C* PI630 0000510C* PI630 00520CL1 20 GOTO FINI PI630 00530CL1 Z-ADDWORK SV2 70 SOH PI630 00540CL1 FINI TAG PI630 00545CL1 Z-ADD0 WORK 00550C********************************************************************PI630 00560OPARTMST T L1N20 PI630 0000570O SV2 B 152 PI630 ** 000580ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000620/* 00063000_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(/m \TXOE360 P999999032778(000010H S OE360 00020X DECK-ID A70 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE360 00030F* PRINT INVOICE REGISTER OE360 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE360 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE360 00060F* CONTROL DATA PROPRIETARY PRODUCT OE360 00070F* OE360 0000080FCARDS IPEAF 80 DISK OE360 00090FARMAST IC F 280R 6AI 1 DISK OE360 00100FHEADING IT F 40 EDISK OE360 00110F$LP1 O F 132 OF PRINTER OE360 00120E HEADING HEAD 1 1 40 COMPANY NAME OE360 00130ICARDS XX 01 1 CI 2 CN OE360 00140I OR 1 CD 2 CB OE360 0000141I OR 1 CM 2 CI 00150I OR 02 1 CC 2 CM OE360 00160I 1 2 TR OE360 00170I 3 80CUST OE360 00180I 9 150INV OE360 00190I 16 210DATE OE360 00200I 22 302GROSS OE360 0000210I 31 372FRT OE360 00220I 38 38 TXCODE OE360 00230I 39 452TAX OE360 00240I 46 542NET OE360 00250I 55 612MSC OE360 00260I XX 03 OE360 00270I 1 1 A OE360 0000280IARMAST XX 08 OE360 00290I 7 30 NAME OE360 00300I 115 115 DLT OE360 00310C SETOF 20 OE360 00320C N01N02 GOTO END OE360 00330C SETON 20 OE360 00340C N02 GOTO SKIP OE360 0000350C Z-SUBGROSS GROSS OE360 00360C Z-SUBTAX TAX OE360 00370C Z-SUBFRT FRT OE360 00380C Z-SUBMSC MSC OE360 00390C Z-SUBNET NET OE360 00400C SKIP TAG OE360 00410C LRAMT ADD GROSS LRAMT 102 OE360 0000420C LRTAX ADD TAX LRTAX 82 OE360 00430C LRFRT ADD FRT LRFRT 82 OE360 00440C LRMSC ADD MSC LRMSC 82 OE360 00450C LRNET ADD NET LRNET 102 OE360 00460C TXCODE COMP ' ' 21CAL NONTAXABLE OE360 00470C TXCODE COMP 'C' 22CAL TAXABLE OE360 00480C TXCODE COMP 'O' 23OUT-OF-STATE OE360 0000490C 21 CNTAX ADD NET CNTAX 102 OE360 00500C 22 CTAX ADD NET CTAX 102 OE360 00510C 23 OUTST ADD NET OUTST 102 OE360 00520C N21N22N23INVLD ADD NET INVLD 102 OE360 00530C CUST CHAINARMAST 99 OE360 00540C N99 DLT COMP ' ' 9999 OE360 00550C END TAG OE360 0000560O$LP1 H 202 1P OE360 00570O OR OF OE360 00580O PAGE Z 8 OE360 00590O 4 'PAGE' OE360 00600O HEAD,1 86 OE360 00610O UDATE Y 132 OE360 00620O H 2 1P OE360 0000630O OR OF OE360 00640O 63 'I N V O I C E' OE360 00650O 82 'R E G I S T E R' OE360 00660O 132 'DIS360' OE360 00670O H 2 1P OE360 00680O OR OF OE360 00690O 8 'INVOICE#' OE360 0000700O 15 'CUST#' OE360 00710O 21 'NAME' OE360 00720O 58 'GROSS AMT TX' OE360 00730O 69 'TAX' OE360 00740O 81 'FREIGHT' OE360 00750O 93 'MISC CHGS' OE360 00760O 109 'NET AMT' OE360 0000770O 114 'TR' OE360 00780O D 1 20 OE360 00790O INV Z 8 OE360 00800O CUST Z 15 OE360 00810O N99 NAME 41 OE360 00820O 99 28 '* UNKNOWN *' OE360 00830O GROSS J 55 OE360 0000840O N21N22N23 57 '*' OE360 00850O TXCODE 58 OE360 00860O N21N22N23 59 '*' OE360 00870O TAX J 70 OE360 00880O FRT J 82 OE360 00890O MSC J 94 OE360 00900O NET J 110 OE360 0000910O TR 114 OE360 00920O T 12 LR OE360 00930O 17 'END OF REPORT' OE360 00940O 39 'GRAND TOTALS' OE360 00950O LRAMT J 55 OE360 00960O LRTAX J 70 OE360 00970O LRFRT J 82 OE360 0000980O LRMSC J 94 OE360 00990O LRNET J 110 OE360 01000O T 1 LR OE360 01010O CTAX J 110 OE360 01020O 124 'CALIF TAXABLE' OE360 01030O T 1 LR OE360 01040O CNTAX J 110 OE360 0001050O 124 'CALIF NON-TAX' OE360 01060O T 1 LR OE360 01070O OUTST J 110 OE360 01080O 123 'OUT OF STATE' OE360 01090O T 1 LR OE360 01100O INVLD J 110 OE360 01110O 120 '**INVALID' OE360 00** 001120ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 001130ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 001140ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 001150ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 001160/* 001170_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(xU TXMR755 P D v999999111111(000010H S MR755 00020X DECK-ID M39 MFG/DIST/ACCT SYSTEM SUMMARY-123 MR755 00030F* EXPLODE TOP UNITS INTO PARTS REQUIRED. MR755 00040F* CYBER 18-10M/20 MATERIAL REQUIREMENT PLANNING VERSION 1.0MR755 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA MR755 00060F* CONTROL DATA PROPRIETARY PRODUCT MR755 00070F* MR755 0000080FORDWRK IPEAF 66 DISK MR755 00090FTEMRRN UC F 62R DISK MR755 00100FBOMMST IC F 47R20AI 28 DISK MR755 00110FBOMSTR IC F 74R DISK MR755 00120FEXPLODE O F 100 DISK MR755 00130F* MR755 00140F* ************************************************************** MR755 0000150F* ** ** MR755 00160F* ** COMPUSOURCE ADM- MATERIAL REQUIREMENTS PLANNING ** MR755 00170F* ** ** MR755 00180F* ** MFG755- EXPLODE REQUIREMENTS ** MR755 00190F* ** ** MR755 00200F* ** ROBBIE FREEMAN 7/23/76 ** MR755 00210F* ** ** MR755 0000220F* ************************************************************** MR755 00230F* ** ** MR755 00240F* ** FUNCTION OF INDICATORS ** MR755 00250F* ** ** MR755 00260F* ** 01 ORDWRK- SALES ORDERS ** MR755 00270F* ** 02 ORDWRK- OPEN JOBS ** MR755 00280F* ** 03 ORDWRK- RELEASED JOBS ** MR755 0000290F* ** 04 ORDWRK- PURCHASE ORDERS ** MR755 00300F* ** 05 TEMRRN ** MR755 00310F* ** 06 BOMMST ** MR755 00320F* ** 07 BOMSTR ** MR755 00330F* ** 15 RGCODE BLANK - THIS ITEM WAS EXPLODED FURTHER ** MR755 00340F* ** 20 ASSEMBLY RR# > 0 - THIS PART HAS COMPONENTS ** MR755 00350F* ** 22 BOMSTR 'NEXT CODE' IS BLANK - MORE COMPONENTS ** MR755 0000360F* ** TO BE EXPLODED ON THIS LEVEL. ** MR755 00370F* ** 30 SUBR DDATE FOR OJ'S ONLY - USE PLANNED RELEASE ** MR755 00380F* ** (START) DATE OF PARENT FOR REQ'D DATE OF 1ST ** MR755 00390F* ** LEVEL COMPONENTS (IND=1). ** MR755 00400F* ** 41 CAN'T GO DOWN FURTHER IN EXPLODE - GO ACROSS ** MR755 00410F* ** 42 EXPLODE HAS REACHED NORMAL COMPLETION ** MR755 00420F* ** 50 NO HIT ON BOMMST - NO COMPONENTS ** MR755 0000430F* ** 60 SUBR DECIDE: EXPLODE QTY=LOTSIZ BECAUSE >REQTS ** MR755 00440F* ** 61 MIN/MAX CODE = 'X' OR 'N' - DON'T EXPLODE ** MR755 00450F* ** 64 SAME AS 61 BUT FOR COMPONENTS ** MR755 00460F* ** 65 AVAIL HAS GONE BELOW MIN - EXPLODE ** MR755 00470F* ** 66 !! 15 LEVELS ENCOUNTERED IN EXPLODE - STOP !! ** MR755 00480F* ** 70 SUBR DDATE: DUE DAY > 30 - MAKE IT 30 ** MR755 00490F* ** 71 SUBR DDATE: OVERFLOW TO NEXT MONTH - ADJUST ** MR755 0000500F* ** 72 SUBR DDATE: OVERFLOW TO NEXT YEAR - ADJUST ** MR755 00510F* ** 81 EXCPT OUTPUT NEW AVAILABLE BALANCE TO TEMRRN ** MR755 00520F* ** 82 EXCPT OUTPUT PLANNED REQMT RECS TO EXPLODE ** MR755 00530F* ** 99 STRUCTURE QTY ON BOMSTR = 0 - DEFAULT TO 1 ** MR755 00540F* ** ** MR755 00550F* ** U1 SET MIN = 0 ** MR755 00560F* ** U2 SET LOTSIZ = 0 ** MR755 0000570F* ************************************************************** MR755 00580F* MR755 00590E A1 15 7 0 REQMTS MR755 00600E A2 15 5 0 NXTRRN MR755 00610E A3 15 20 PARENT# MR755 00620E A4 15 6 0 DUE DATE MR755 00630IORDWRK NS 01 1 CS 2 CO MR755 0000640I OR 02 1 CO 2 CJ MR755 00650I OR 03 1 CR 2 CJ MR755 00660I OR 04 1 CP 2 CO MR755 00670I 3 9 REFNO MR755 00680I 47 66 PARTNOL1 MR755 00690I 22 280AMT MR755 00700I 29 340DUEDAT MR755 0000710I 46 46 RGCODE 15 MR755 00720I 35 400TDATE MR755 00730I 41 45 CUSTNO MR755 00740ITEMRRN NS 05 MR755 00750I 43 62 PARTNO MR755 00760I 13 170ASYPTR 20 MR755 00770I 18 240AVAIL MR755 0000780I 25 270LEADTM MR755 00790I 28 28 MMCODE MR755 00800I 29 350MIN MR755 00810I 36 420LOTSIZ MR755 00820IBOMMST NS 06 MR755 00830I 23 270RRNUM MR755 00840IBOMSTR NS 07 MR755 0000850I 1 20 PARENT MR755 00860I 55 74 COMPNT MR755 00870I 25 313QTY MR755 00880I 32 360RRN MR755 00890I 47 510BMPTR MR755 00900I 52 52 NXTCD 22 MR755 00910C********************************************************************MR755 0000920C* MR755 00930C* THIS PROGRAM EXPLODES ALL PART NUMBERS FOUND ON THE SALES ORDERS MR755 00940C* AND OPEN JOBS INTO THEIR COMPONENT PARTS. THE EXPLODE STOPS MR755 00950C* UNDER CERTAIN CONDITIONS: MR755 00960C* MR755 00970C* FOR SALES ORDERS-- EXPLODE QTY = MAX(LOT SIZE,MINIMUM-AVAIL) MR755 00980C* MR755 0000990C* 1.AN 'X' IS ENCOUNTERED IN THE REQUIREMENTS GENERATION CODE MR755 01000C* 2.THERE IS ENOUGH STOCK ON HAND PLUS STOCK ON ORDER TO MEET MR755 01010C* THE REQUIREMENTS (AVAIL > OR EQ TO MINIMUM) MR755 01020C* 3.THE PART IS NOT UNDER REQUIREMENTS GENERATION CONTROL - MR755 01030C* MMCODE IS 'N' OR 'X' MR755 01040C* MR755 01050C* FOR OPEN JOBS-- EXPLODE QTY = JOB QTY MR755 0001060C* MR755 01070C* 1.AN 'X' IS ENCOUNTERED IN THE REQUIREMENTS GENERATION CODE MR755 01080C* 2.THE PART IS NOT UNDER REQUIREMENTS GENERATION CONTROL - MR755 01090C* MMCODE IS 'X' OR 'N' MR755 01100C* MR755 01110C* NOTE- IF U1 IS ON WE ZERO OUT 'MIN' - THIS CAUSES THE EXPLODE MR755 01120C* TO CONTINUE ONLY WHEN THE AVAIL < 0 MR755 0001130C* MR755 01140C* IF U2 IS ON WE ZERO OUT 'LOTSIZ' - THIS CAUSES THE EXPLODE MR755 01150C* QTY = REQMTS ONLY = MINIMUM-AVAIL = -(AVAIL) IF U1 IS ON. MR755 01160C* MR755 01170C* THE EXPLODE FILE CONTAINS ONE ENTRY FOR EVERY WORK ORDER OR MR755 01180C* SALES ORDER ON ORDERS FILE PLUS ONE RECORD FOR EVERY COMPONENT MR755 01190C* FOUND IN THE EXPLODE MR755 0001200C* MR755 01210C* THE REQUIRED DATES FOR COMPONENTS ARE COMPUTED BY SUBTRACTING MR755 01220C* THE LEAD TIME FOR ITS PARENT FROM THE DUE DATE FOR ITS PARENT. MR755 01230C* HOWEVER, FOR OPEN JOBS, OJ'S, WE USE THE START DATE OF THE W.O. MR755 01240C* AS THE DUE DATE OF ITS 1ST ASSY COMPS BECAUSE WE ASSUME THE MR755 01250C* PARTS FOR THE W.O. WILL BE REQUIRED BY THEN. MR755 01260C* MR755 0001270C********************************************************************MR755 01280C* MR755 01290C* MR755 01300C MOVE PARTNO SPART 20 MR755 01310C Z-ADD0 SREQMT 70 MR755 01320C N02 MOVE DUEDAT SDATE 60 MR755 01330C 02 MOVE TDATE SDATE MR755 0001340C 02 MOVE DUEDAT TDATE MR755 01350C L1 PARTNO CHAINBOMMST 50 MR755 01360C 01 50 MR755 01370COR 02 50 MOVE 'X' RGCODE NOT EXPLODED MR755 01380C 50 GOTO DEND NO COMPONENTS MR755 01390C L1 Z-ADDRRNUM RRSAVE 50 MR755 01400C RRSAVE CHAINTEMRRN H6 MR755 0001410C H6 GOTO DEND MR755 01420C N01N02 GOTO DEND SO'S,OJ'S ONLY MR755 01430C 02N15 GOTO DEND OJ & RGCODE=X MR755 01440C MMCODE COMP 'X' 61 MR755 01450C N61 MMCODE COMP 'N' 61 MR755 01460C 61 MOVE 'X' RGCODE NOT EXPLODED MR755 01470C 61 GOTO DEND MR755 0001480C 02N20 MOVE 'X' RGCODE NO COMPONENTS MR755 01490C 02N20 GOTO DEND MR755 01500C 02 Z-ADDAMT REQMT 70 MR755 01510C 02 GOTO EXPLD MR755 01520C********** MR755 01530C* THE FOLLOWING CALCS (UNTIL TAG 'EXPLD') ARE FOR SO'S ONLY. MR755 01540C** MR755 0001550C* DETERMINE WHETHER OR NOT TO EXPLODE MR755 01560C********** MR755 01570C Z-ADDAMT PRQTY 70 MR755 01580C EXSR DECIDE MR755 01590C Z-ADDEXPQTY REQMT MR755 01600C************************ MR755 01610C OUTAVL TAG UPDATE AVAIL MR755 0001620C************************ MR755 01630C SETON 81 MR755 01640C EXCPT MR755 01650C SETOF 81 MR755 01660C 65 15 20 Z-ADDREQMT SREQMT SAVE EXP QTY MR755 01670C 65 15 20 GOTO EXPLD MR755 01680C MOVE 'X' RGCODE NOT EXPLODED MR755 0001690C GOTO DEND MR755 01700C************************ MR755 01710C EXPLD TAG MR755 01720C************************ MR755 01730C MOVE PARTNO PRTNUM 20 MR755 01740C MOVE PARTNO PRNTNO 20 MR755 01750C Z-ADD1 IND 20 MR755 0001760C EXSR DDATE MR755 01770C ASYPTR CHAINBOMSTR H1 MR755 01780C H1 GOTO DEND MR755 01790C 22 RRN ADD 1 NXTRRN 50 MR755 01800C N22 Z-ADD0 NXTRRN MR755 01810C************************ MR755 01820C EXLOOP TAG MR755 0001830C************************ MR755 01840C QTY COMP 0 99 MR755 01850C 99 Z-ADDREQMT EXTREQ 70 MR755 01860C N99 QTY MULT REQMT EXTREQ H MR755 01870C BMPTR CHAINTEMRRN H2 MR755 01880C H2 GOTO DEND MR755 01890C MMCODE COMP 'X' 64 MR755 0001900C N64 MMCODE COMP 'N' 64 MR755 01910C 64 GOTO NXTCMP MR755 01920C Z-ADDEXTREQ PRQTY MR755 01930C EXSR DECIDE MR755 01940C Z-ADDEXPQTY EXTREQ MR755 01950C SETON 82 MR755 01955C MOVELPARENT SPARTX 12 0001960C EXCPT MR755 01970C SETOF 82 MR755 01980C N20 GOTO NXTCMP MR755 01990C MOVE COMPNT PRTNUM MR755 02000C ASYPTR CHAINBOMSTR H5 MR755 02010C H5 GOTO DEND MR755 02020C PARTNO COMP PARENT H3H3 MR755 0002030C H3 GOTO DEND MR755 02040C************************ MR755 02050C OUTAV2 TAG MR755 02060C************************ MR755 02070C SETON 81 MR755 02080C EXCPT MR755 02090C SETOF 81 MR755 0002100C N65 GOTO NXTCMP MR755 02110C MOVE REQMT A1,IND MR755 02120C MOVE NXTRRN A2,IND MR755 02130C MOVE PRNTNO A3,IND MR755 02140C MOVE NDUEDT A4,IND MR755 02150C MOVE EXTREQ REQMT MR755 02160C MOVE NDUEDT DUEDAT MR755 0002170C* MR755 02180C 22 RRN ADD 1 NXTRRN MR755 02190C N22 Z-ADD0 NXTRRN MR755 02200C MOVE PRTNUM PRNTNO MR755 02210C IND ADD 1 IND MR755 02220C IND COMP 15 66 MR755 02230C 66 GOTO DEND MR755 0002240C EXSR DDATE MR755 02250C GOTO EXLOOP MR755 02260C************************ MR755 02270C NXTCMP TAG MR755 02280C************************ MR755 02290C NXTRRN COMP 0 4141 MR755 02300C N41 NXTRRN CHAINBOMSTR 41 MR755 0002310C N41 PRNTNO COMP PARENT 4141 MR755 02320C N41 22 NXTRRN ADD 1 NXTRRN MR755 02330C N41N22 Z-ADD0 NXTRRN MR755 02340C N41 GOTO EXLOOP MR755 02350C IND SUB 1 IND 4242 MR755 02360C 42 GOTO DEND MR755 02370C MOVE A1,IND REQMT MR755 0002380C MOVE A2,IND NXTRRN MR755 02390C MOVE A3,IND PRNTNO MR755 02400C MOVE A4,IND NDUEDT MR755 02410C GOTO NXTCMP MR755 02420C************************ MR755 02430C DEND TAG MR755 02440C********************************************************************MR755 0002450CSR DECIDE BEGSR MR755 02460CSR U1 Z-ADD0 MIN MR755 02470CSR U2 Z-ADD0 LOTSIZ MR755 02480CSR AVAIL SUB PRQTY AVAIL MR755 02490CSR MIN SUB AVAIL EXPQTY 70 65 EXPLODE QTY MR755 02500CSR 65 EXPQTY COMP LOTSIZ 60 MR755 02510CSR 65 60 Z-ADDLOTSIZ EXPQTY MR755 0002520CSR 65 AVAIL ADD EXPQTY AVAIL MR755 02530CSR ENDSR MR755 02540C********************************************************************MR755 02550CSR DDATE BEGSR MR755 02560CSR 02 IND COMP 1 30 MR755 02570CSR 02 30 MOVE DUEDAT NDUEDT MR755 02580CSR 02 30 GOTO ENDDUE MR755 0002590CSR MOVELDUEDAT DUEMO 20 MR755 02600CSR MOVE DUEDAT DUEYR 20 MR755 02610CSR MOVE DUEDAT TEMP 40 MR755 02620CSR MOVELTEMP DUEDA 20 MR755 02630CSR DUEDA COMP 31 70 70 MR755 02640CSR 70 Z-ADD30 DUEDA ASSUME 30/MON MR755 02650CSR 70 LEADTM SUB 1 LEADTM MR755 0002660CSR LEADTM DIV 30 NMO 20 MR755 02670CSR MVR NDAYS 20 MR755 02680CSR DUEDA SUB NDAYS NEWDA 20 7171 MR755 02690CSR 71 NMO ADD 1 NMO MR755 02700CSR 71 NEWDA ADD 30 NEWDA MR755 02710CSR NMO DIV 12 NYR 20 MR755 02720CSR MVR NMONS 20 MR755 0002730CSR DUEMO SUB NMONS NEWMO 20 7272 MR755 02740CSR 72 NYR ADD 1 NYR MR755 02750CSR 72 NEWMO ADD 12 NEWMO MR755 02760CSR DUEYR SUB NYR NEWYR 20 MR755 02770CSR MOVELNEWMO NDUEDT 60 MR755 02780CSR MOVELNEWDA TEMP MR755 02790CSR MOVE NEWYR TEMP MR755 0002800CSR MOVE TEMP NDUEDT MR755 02810CSR ENDDUE ENDSR MR755 02820C** MR755 02830C********************************************************************MR755 02840C* MR755 02850OEXPLODE D 01 MR755 02860O OR 02 MR755 0002870O OR 03 MR755 02880O OR 04 MR755 02890O 01 2 'SO' MR755 02900O 02 2 'OJ' MR755 02910O 03 2 'RJ' MR755 02920O 04 2 'PO' MR755 02930O SPART 80 MR755 0002940O REFNO 21 MR755 02950O AMT 28 MR755 02960O SDATE 34 MR755 02970O TDATE 40 MR755 02980O CUSTNO 45 MR755 02990O RGCODE 53 MR755 03000O SREQMT 60 MR755 0003010O E 82 MR755 03020O 2 'PR' MR755 03030O COMPNT 80 MR755 03040O REFNO 21 MR755 03050O PRQTY 28 MR755 03060O NDUEDT 34 MR755 03070O UDATE 40 MR755 0003075O SPARTX 52 03080O PARENT 100 MR755 03090O 53 'X' MR755 03100O 20 65 53 ' ' MR755 03110O 20 65 EXTREQ 60 MR755 03120OTEMRRN E 81 MR755 03130O AVAIL 24 MR755 00** 003140ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 003150ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 003160ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 003170ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 003180/* 003190_ 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(2 @DIS40OS PPP051678051678(000010H DIS40O00020FOUTPUT IPE F 80 DISK MFG10O00030F@DIS40 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060O@DIS40 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 __ 0(2 DISPR2IS PPP051878051878(000010H DSPR2I00020FDISPR2 IPE F 32 DISK MFGIS 00030FOUTPUT O F 80 DISK MFGIS 00040IDISPR2 NS 01 MFGIS 00050I 1 32 ALL MFGIS 00060OOUTPUT D 01 MFGIS 00070O ALL 32 MFGIS 00/* 000080_ 00 __ 0(X8 XNTXWP200 P999999051278(000010H S WP200N00020X DECK-ID P05 MFG/DIST/ACCT SYSTEM SUMMARY-123 WP200 00030F* OPEN WORKORDER TRANSACTION UPDATE PROGRAM WP200 00040F* CYBER 18-10M/20 WORK IN PROCESS VERSION 1.0WP200 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA WP200 00060F* CONTROL DATA PROPRIETARY PRODUCT WP200 00070F* WP200 0000080FSWTRAN UPEAF 60 DISK WP200 00090FWRKORD UC F 160R 5AI 1 DISK A WP200 00100FPARTMST UC F 300R20AI 271 DISK 00110FTRNWO1 O F 65 DISK A WP200 00120FOHEXPL O F 50 DISK WP200 00130F* ID F C H L FUNCTION OF INDICATORS WP200 00140F* 01,02,05,06 RECORD IDENTIFYING INDICATORS WP200 0000150F* 12 DELETE CODE ON PARTMST BLANK 00160F* 20,21 COMPARE INDICATORS WP200 00170F* 54 OPNUM = '999' WP200 00180F* 55 NO HIT ON WRKORD FILE OR RECORD DELETED WP200 00190F* 56 OPEN BUT NOT RELEASED (STATUS = 'O') WP200 00200F* 57 RELEASED (STATUS = 'R') WP200 00210F* 58 CLOSED (STATUS = 'C') WP200 0000220F* 59 DELETED (STATUS = 'D') WP200 00230F* 60 ADD WHEN RECORD IS PRESENT BUT DELETED WP200 00240F* 80 OUTPUT WRKORD RECORD WP200 00250F* 88 OUTPUT OHEXPL RECORD WP200 00260F* 89 ADD TRANSAC RECORD WP200 00270F* 90 AT LEAST ONE VALID TRANSACTION FOR THIS WORK ORDER WP200 00280F*H1 INVALID TRANSACTION WP200 0000290F********************************************************************WP200 00300F** WP200 00310F** THIS PROGRAM UPDATES THE WRKORD FILE BY PROCESSING WORK WP200 00320F** ORDER TRANSACTIONS 51,52,53,58,62,63 AND 54,56,57,59 IF WP200 00330F** THE OPERATION # IS '999' ANY TRANSACTIONS WHICH HAVE AN ERROR WP200 00340F** CODE GREATER THAN 20 ARE IGNORED. WP200 00350F** THE TRANSACTION FILE IS READ IN SEQUENITALLY BY WORK ORDER #, WP200 0000360F** TRANSACTION # AND 'WRKORD' IS UPDATED AT TOTAL L1 TIME WP200 00370F** WP200 00380F** THE SWTRAN FILE IS UPDATED WITH AN ERROR CODE IF AN ERROR WP200 00390F** OR WARNING CONDITION IS ENCOUNTERED. WP200 00400F** WP200 00410F** INFORMATION AFFECTING THE 'PARTMST' FILE IS PASSED TO THE WP200 00420F** 'ITA' MODULE VIA INVENTORY TRANSACTIONS ADDED TO TRANSAC. WP200 0000430F** PARTMST SOH, SOO, AND MTD USAGE ARE UPDATED BY WIP 00440F** 51,52,53,54,58,62,AND63 (MAY 78) 00450F** WP200 00460ISWTRAN NS 02 1NC 2NC WP200 00470I 1 20TC WP200 00480I 3 70TWONUML1 WP200 00490I 8 27 TPRTNO WP200 0000500I 32 32 TSTAT WP200 00510I 33 390TQTY WP200 00520I 40 450TRLSDT WP200 00530I 46 510TREQDT WP200 00540I 52 54 TPRI WP200 00550I 55 55 TREQCD WP200 00560I 59 600TERR WP200 0000570I* NS 01 WP200 00580I* 1 20TC WP200 00590I* 3 70TWONUML1 WP200 00600I* 8 100OPNUM WP200 00610I* 11 11 MTYPE WP200 00620I* 12 180TQTY WP200 00630I* 19 20 LABGRD WP200 0000640I* 21 260TDLRS WP200 00650I* 27 50 TPRTNO WP200 00660I* 51 541TBRDF WP200 00670I* 55 570TOPER WP200 00680I* 58 58 TOMTYP WP200 00690I 59 600TERR WP200 00700IWRKORD NS 05 WP200 0000710I 6 25 TP WP200 00720I 30 30 F1 WP200 00730I 31 370F2 WP200 00740I 38 440F3 WP200 00750I 67 720F4 WP200 00760I 73 780F5 WP200 00770I 79 840F6 WP200 0000780I 85 900F7 WP200 00790I 91 960F8 WP200 00800I 97 1010F9 WP200 00810I 102 1060F10 WP200 00820I 107 1130F11 WP200 00830I 51 56 F12 WP200 00840IPARTMST NS 06 0000850I 146 1520SOH 00860I 153 1590SOO 00870I 196 2020MTDUSE 00880I 74 74 DLTPR 12 00890C Z-ADD00 Z6 60 WP200 00900C Z-ADD0 Z5 50 WP200 00910C TERR COMP 20 20 WP200 0000920C 20 GOTO DEND WP200 00930C Z-ADD0 ERRNO 20 WP200 00940C NL1 GOTO CHKST WP200 00950C********************************************************************WP200 00960C* WP200 00970C* THIS SECTION CHAINS TO WRKORD AND MOVES THE INPUT FIELDS WP200 00980C* TO THE EVENTUAL OUTPUT FIELDS. THIS IS DONE BECAUSE THIS WP200 0000990C* COMPILING WON'T ALLOW YOU UPDATE AT TOTAL TIME WITHOUT RE-READINGWP200 01000C* THE RECORD. WP200 01010C* WP200 01020C********************************************************************WP200 01030C SETOF 90 WP200 01040C TWONUM CHAINWRKORD 55 WP200 01050C 55 GOTO CHKST WP200 0001060C MOVE TP PARTNO WP200 01070C MOVE F1 STATUS 1 WP200 01080C MOVE F2 QTY 70 WP200 01090C MOVE F3 QTYCOM 70 WP200 01100C MOVE F4 MAT$ 60 WP200 01110C MOVE F5 LAB$ 60 WP200 01120C MOVE F6 BUR$ 60 WP200 0001130C MOVE F7 OPC$ 60 WP200 01140C MOVE F8 RWK$ 60 WP200 01150C MOVE F9 LHRS 50 WP200 01160C MOVE F10 RHRS 50 WP200 01170C MOVE F11 SCRAP 70 WP200 01180C MOVE F12 REQDAT 60 WP200 01190C********************************************************************WP200 0001200C* NOW WE CHECK THE STATUS OF THE WORK ORDER. IT CAN BE OPEN ('O'), WP200 01210C* RELEASED ('R'),CLOSED ('C'), OR DELETED ('D'). IF AN ORDER WP200 01220C* IS DELETED THE 'NO-HIT' INDICATOR IS ALSO SET ON. WP200 01230C* WP200 01240C********************************************************************WP200 01250C CHKST TAG WP200 01260C L1 55 MOVE ' ' STATUS WP200 0001270C STATUS COMP 'O' 56 WP200 01280C STATUS COMP 'R' 57 WP200 01290C STATUS COMP 'C' 58 WP200 01300C STATUS COMP 'D' 59 WP200 01310C 59 SETON 55 WP200 01320C* OPNUM COMP 999 54 WP200 01330C********************************************************************WP200 0001340C TC COMP 51 20 WP200 01350C 20 GOTO TC51 WP200 01360C TC COMP 52 20 WP200 01370C 20 GOTO TC52 WP200 01380C TC COMP 53 20 WP200 01390C 20 GOTO TC53 WP200 01400C TC COMP 54 20 WP200 0001410C 20 GOTO TC54 WP200 01420C TC COMP 55 20 WP200 01430C 20 GOTO DEND WP200 01440C TC COMP 56 20 WP200 01450C 20 GOTO TC56 WP200 01460C TC COMP 57 20 WP200 01470C 20 GOTO TC57 WP200 0001480C TC COMP 58 20 WP200 01490C 20 GOTO TC58 WP200 01500C TC COMP 59 20 WP200 01510C 20 GOTO TC59 WP200 01520C TC COMP 60 20 WP200 01530C 20 GOTO DEND WP200 01540C TC COMP 61 20 WP200 0001550C 20 GOTO DEND WP200 01560C TC COMP 62 20 WP200 01570C 20 GOTO TC62 WP200 01580C TC COMP 63 20 WP200 01590C 20 GOTO TC63 WP200 01600C BADTC TAG WP200 01610C SETON H1 WP200 0001620C GOTO DEND WP200 01630C********************************************************************WP200 01640C* WP200 01650C* TC 51 ADDS A NEW RECORD TO WRKORD. IF THE RECORD IS PRESENT AND WP200 01660C* NOT DELETED THEN THE TRANSACTION IS REJECTED. IF THE TRANSACTION WP200 01670C* STATUS IS 'R' THEN TC52 IS PROCESSED ALSO WP200 01680C********************************************************************WP200 0001690C TC51 TAG WP200 01700C TREQDT COMP 0 2020 WP200 01710C 20 Z-ADD26 ERRNO WP200 01720C TQTY COMP 0 2020 WP200 01730C 20 Z-ADD27 ERRNO WP200 01740C N55N59 Z-ADD25 ERRNO WP200 01750C 58 Z-ADD40 ERRNO WP200 0001760C ERRNO COMP 0 20 WP200 01770C 20 GOTO DEND WP200 01780C 59 SETON 60 ZERO VARIANCE WP200 01790C SETON 90 WP200 01800C MOVE TWONUM WONUM 50 WP200 01810C MOVE TPRTNO PARTNO 20 WP200 01820C MOVE 'O' STATUS WP200 0001830C MOVE TQTY QTY WP200 01840C MOVE TRLSDT RLSDAT 60 WP200 01850C MOVE TREQDT REQDAT 60 WP200 01860C MOVE TPRI PRI 3 WP200 01870C MOVE TREQCD REQCOD 1 WP200 01880C MOVE ' ' OOOCD 1 WP200 01890C Z-ADD0 QTYCOM WP200 0001900C Z-ADD0 RRN 50 WP200 01910C Z-ADDZ6 MAT$ WP200 01920C Z-ADDZ6 LAB$ WP200 01930C Z-ADDZ6 BUR$ WP200 01940C Z-ADDZ6 OPC$ WP200 01950C Z-ADDZ6 RWK$ WP200 01960C Z-ADDZ5 LHRS WP200 0001970C Z-ADDZ5 RHRS WP200 01980C Z-ADD0 SCRAP WP200 01990C Z-ADD60 ITRN 20 WP200 02000C Z-ADDQTY IQTY 70 WP200 02010C EXSR OUTRNS WP200 02012C Z-ADD61 TC 02014C Z-ADDIQTY EXQTY 20 0002016C 20 EXSR OUTOHX 02020C TSTAT COMP 'R' 56 WP200 02030C 56 Z-ADD52 TC WP200 02040C 56 GOTO GOOD52 WP200 02050C GOTO DEND WP200 02060C********************************************************************WP200 02070C* WP200 0002080C* TC 52 RELEASES A WORK ORDER. THE PART# AND QTY ARE OUTPUT TO WP200 02090C* 'OHEXPL' WHICH IS USED TO EXPLODE THE PART # INTO A PICK LIST. WP200 02100C* WP200 02110C* IF THE TRANSACTION QUANTITY IS NON-ZERO, THE WRKORD QTY THEN WP200 02120C* AN ITA TRANSACTION IS CREATED WHICH WILL ADJUST STOCK ON ORDER. WP200 02130C* WP200 02140C********************************************************************WP200 0002150C TC52 TAG WP200 02160C N56 Z-ADD29 ERRNO WP200 02170C 55 Z-ADD28 ERRNO WP200 02180C 58 Z-ADD40 ERRNO WP200 02190C N56 WP200 02200COR 55 WP200 02210COR 58 GOTO DEND WP200 0002220C GOOD52 TAG WP200 02230C SETON 90 WP200 02240C MOVE 'R' STATUS WP200 02250C Z-ADDUDATE RLSDAT WP200 02260C MOVELPARTNO TPRTNO WP200 02270C TQTY COMP 0 20 WP200 02280C N20 GOTO OUTEX WP200 0002290C TQTY SUB QTY IQTY 70 WP200 02300C Z-ADDTQTY QTY 20 WP200 02310C Z-ADD64 ITRN WP200 02320C 20 EXSR OUTRNS WP200 02330C OUTEX TAG WP200 02340C Z-ADDQTY EXQTY 70 20 WP200 02350C 20 EXSR OUTOHX WP200 0002360C GOTO DEND WP200 02370C********************************************************************WP200 02380C* WP200 02390C* TC 53 CHANGES THE JOB QUANTITY. IF THE WORK ORDER HAS ALREADY WP200 02400C* BEEN RELEASED (STAUS = 'R'), THEN AN ENTRY IS ADDED TO 'OHEXPL' WP200 02410C* TO EXPLODE OUT HTE DIFFERENCE IN COMPONENT STOCK-ON-HAND. WP200 02420C* WP200 0002430C* IF THE WORK ORDER IS OPEN OR RELEASED THEN AN ITA TRANSACTION WP200 02440C* IS OUTPUT TO ADJUST THE STOCK ON ORDER. WP200 02450C* WP200 02460C********************************************************************WP200 02470C TC53 TAG WP200 02480C QTYCOM ADD SCRAP TOTCOM 70 WP200 02490C TOTCOM COMP TQTY 20 WP200 0002500C 20 Z-ADD30 ERRNO WP200 02510C 55 Z-ADD28 ERRNO WP200 02520C 58 Z-ADD40 ERRNO WP200 02530C 55 WP200 02540COR 58 WP200 02550COR 20 GOTO DEND WP200 02560C SETON 90 WP200 0002570C TQTY SUB QTY IQTY WP200 02580C MOVE TQTY QTY WP200 02590C Z-ADD64 ITRN WP200 02600C EXSR OUTRNS WP200 02610C* WP200 02620C Z-ADDIQTY EXQTY 2020 WP200 02630C 57 20 EXSR OUTOHX WP200 0002640C GOTO DEND WP200 02650C********************************************************************WP200 02660C* WP200 02670C* TC 54 PROCESSES COMPLETIONS. THE TRANSACTION QUANITY CAN BE WP200 02680C* NEGATIVE BUT CAN'T CAUSE THE WORK ORDER QUANTITY TO GO BELOW WP200 02690C* ZERO. TWO ITA TRANSACTIONS ARE CREATED. ONE IS TO INCREMENT WP200 02700C* (OR DECREMENT) THE STOCK-ON-HAND AND THE OTHER IS TO DECREMENT WP200 0002710C* THE STOCK-ON-ORDER. THESE TWO TRANSACTIONS ARE NOT COMBINED WP200 02720C* BECAUSE THE TWO ADJUSTEMNT QUANTITIES CAN BE DIFFERENT. WP200 02730C* WP200 02740C********************************************************************WP200 02750C TC54 TAG WP200 02760C* N54 GOTO DEND WP200 02770C QTYCOM ADD TQTY NEWQTY 70 20 WP200 0002780C 20 Z-ADD31 ERRNO WP200 02790C 55 Z-ADD28 ERRNO WP200 02800C 20 WP200 02810COR 55 GOTO DEND WP200 02820C Z-ADDNEWQTY QTYCOM WP200 02830C DOITR TAG WP200 02840C SETON 90 WP200 0002850C QTYCOM ADD SCRAP TOTCOM 70 WP200 02860C QTY SUB TOTCOM IQTY 21 WP200 02862C 20 02864COR 21 02866COR 58 GOTO BY1 02870C IQTY ADD TQTY IQTY 20 WP200 02880C 20 Z-ADD0 IQTY WP200 0002890C TQTY COMP IQTY 20 WP200 02900C 20 Z-ADDTQTY IQTY WP200 02910C Z-ADD73 ITRN WP200 02920C EXSR OUTRNS WP200 02930C Z-ADDTQTY IQTY WP200 02940C Z-ADD72 ITRN WP200 02950C EXSR OUTRNS WP200 0002955C BY1 TAG 02960C 21 Z-ADD2 ERRNO WP200 02970C 58 Z-ADD3 ERRNO WP200 02980C 58 Z-ADDUDATE RLSDAT WP200 02990C GOTO DEND WP200 03000C********************************************************************WP200 03010C TC56 TAG PROCESS SCRAP WP200 0003020C* N54 GOTO DEND REPORT WP200 03030C 55 Z-ADD28 ERRNO WP200 03040C 55 GOTO DEND WP200 03050C SCRAP ADD TQTY SCRAP 20 WP200 03060C 20 TQTY ADD SCRAP TQTY WP200 03070C 20 Z-ADD0 SCRAP WP200 03080C Z-ADD56 TC WP200 0003090C 20 Z-ADD4 ERRNO WP200 03100C GOTO DOITR WP200 03110C********************************************************************WP200 03120C* WP200 03130C* TC 57 PROCESSES REPORTED LABOR. THE ACCUMULATED LABOR DOLLARS WP200 03140C* IS INCREMENTED.BY THE TRANSACTION DOLLARS. THE BURDEN DOLLARS WP200 03150C* IS INCREMENTED BY THE TRANSACTION DOLLARS MULITIPLIED BY THE WP200 0003160C* TRANSACTION BURDEN FACTOR, WP200 03170C* WP200 03180C* IF THE MATERIAL TYPE = 'R' IN THE TRANSACTION RECORD THEN WP200 03190C* THE REWORK DOLLARS FIELD IS UPDATED INSTEAD OF THE LABOR DOLLARS WP200 03200C* FIELD. WP200 03210C* WP200 03220C********************************************************************WP200 0003230C TC57 TAG WP200 03240C* N54 GOTO DEND WP200 03250C 55 Z-ADD28 ERRNO WP200 03260C 55 GOTO DEND WP200 03270C 58 Z-ADD3 ERRNO WP200 03280C 58 Z-ADDUDATE RLSDAT WP200 03290C SETON 90 WP200 0003300C* TBRDF MULT TDLRS BURDEN 70 WP200 03310C* BURDEN ADD BUR$ BUR$ 20 WP200 03320C 20 Z-ADD0 BUR$ WP200 03330C 20 Z-ADD11 ERRNO WP200 03340C* MTYPE COMP 'R' 20 WP200 03350C 20 GOTO RWORK WP200 03360C LHRS ADD TQTY LHRS 20 WP200 0003370C 20 Z-ADD0 LHRS WP200 03380C 20 Z-ADD12 ERRNO WP200 03390C* LAB$ ADD TDLRS LAB$ 20 WP200 03400C 20 Z-ADD0 LAB$ WP200 03410C 20 Z-ADD5 ERRNO WP200 03420C GOTO DEND WP200 03430C RWORK TAG WP200 0003440C RHRS ADD TQTY RHRS 20 WP200 03450C 20 Z-ADD0 RHRS WP200 03460C 20 Z-ADD14 ERRNO WP200 03470C* RWK$ ADD TDLRS RWK$ 20 WP200 03480C 20 Z-ADD0 RWK$ WP200 03490C 20 Z-ADD13 ERRNO WP200 03500C GOTO DEND WP200 0003510C********************************************************************WP200 03520C* WP200 03530C* TC 58 PROCESSES MATERIAL ISSUED TO A WORK ORDER. THE TRANSACTION WP200 03540C* DOLLARS FIELD IS ADDED TO THE ACCUMULATED MATERIAL DOLLARS. WP200 03550C* WP200 03560C* AN ITA TRANSACTION IS OUTPUT WHICH ADJUSTS STOCK-ON-HAND WP200 03570C* WP200 0003580C********************************************************************WP200 03590C TC58 TAG WP200 03600C 55 Z-ADD28 ERRNO WP200 03610C 55 GOTO DEND WP200 03620C 58 Z-ADD3 ERRNO WP200 03630C 58 Z-ADDUDATE RLSDAT WP200 03640C* MAT$ ADD TDLRS MAT$ 20 WP200 0003650C* 20 Z-ADD0 MAT$ WP200 03660C* 20 Z-ADD6 ERRNO WP200 03670C Z-ADDTQTY IQTY WP200 03680C Z-ADD63 ITRN WP200 03690C EXSR OUTRNS WP200 03700C SETON 90 WP200 03710C GOTO DEND WP200 0003720C********************************************************************WP200 03730C* WP200 03740C* TC 59 PROCESSES REPORTED OUTSIDE PROCESSING. OUTSIDE PROCESSING WP200 03750C* DOLLARS IS INCREMENTED BY THE TRANSACTION DOLLARS. WP200 03760C* WP200 03770C********************************************************************WP200 03780C TC59 TAG WP200 0003790C* N54 GOTO DEND WP200 03800C 55 Z-ADD28 ERRNO WP200 03810C 55 GOTO DEND WP200 03820C 58 Z-ADD3 ERRNO WP200 03830C 58 Z-ADDUDATE RLSDAT WP200 03840C* OPC$ ADD TDLRS OPC$ 20 WP200 03850C 20 Z-ADD0 OPC$ WP200 0003860C 20 Z-ADD7 ERRNO WP200 03870C SETON 90 WP200 03880C GOTO DEND WP200 03890C********************************************************************WP200 03900C* WP200 03910C* TC 62 MOVES A 'C' IN THE STATUS FIELD. IT ALSO ADDS AN ITA WP200 03920C* TRANSACTION IF THE WORK ORDER WAS CLOSED SHORT. THIS TRANSACTION WP200 0003930C* ADJUSTS STOCK-ON-ORDER. WP200 03940C* WP200 03950C********************************************************************WP200 03960C TC62 TAG WP200 03970C 55 Z-ADD28 ERRNO WP200 03980C 58 Z-ADD32 ERRNO WP200 03990C 55 WP200 0004000COR 58 GOTO DEND WP200 04010C MOVE 'C' STATUS WP200 04020C Z-ADDUDATE RLSDAT WP200 04030C QTY SUB QTYCOM IQTY WP200 04040C IQTY SUB SCRAP IQTY 20 WP200 04050C Z-ADD68 ITRN WP200 04060C 20 EXSR OUTRNS WP200 0004070C SETON 90 WP200 04080C GOTO DEND WP200 04090C********************************************************************WP200 04100C* WP200 04110C* TC 63 MARKS A WORK ORDER AS DELETED. THE TRANSACTION IS REJECTED WP200 04120C* IF THE QUANTITY COMPLETED FIELD IS GREATER THAN ZERO. WP200 04130C* WP200 0004140C********************************************************************WP200 04150C TC63 TAG WP200 04160C 55 Z-ADD28 ERRNO WP200 04170C QTYCOM COMP 0 20 WP200 04180C 20 Z-ADD33 ERRNO WP200 04190C 55 WP200 04200COR 20 GOTO DEND WP200 0004210C MOVE 'D' STATUS WP200 04215C Z-ADDTQTY IQTY 04220C Z-ADD66 ITRN 04230C EXSR OUTRNS 04240C SETON 90 WP200 04250C GOTO DEND WP200 04260C********************************************************************WP200 0004270C DEND TAG WP200 04280C ERRNO COMP 0 87 WP200 04290C********************************************************************WP200 04300C* WP200 04310C* NOW WE ACCESS THE WORK ORDER RECORD AGAIN AND UPDATE IT WP200 04320C* WP200 04330C********************************************************************WP200 0004340CL1 90 TWONUM CHAINWRKORD 55 WP200 04350CL1 SETON 80 WP200 04360CL1 90 EXCPT WP200 04370CL1 SETOF 8060 WP200 04380C********************************************************************WP200 04390C* WP200 04400C* THIS ROUTINE OUTPUTS A RECORD TO THE ON-HAND EXPLODE FILE. WP200 0004410C* WP200 04420C********************************************************************WP200 04430CSR OUTOHX BEGSR WP200 04440CSR SETON 88 WP200 04450CSR EXCPT WP200 04460CSR SETOF 88 WP200 04470CSR ENDSR WP200 0004480C********************************************************************WP200 04490C* WP200 04500C* THIS ROUTINE OUTPUTS AN ITA TRANSACTION RECORD. THE REFERENCE WP200 04510C* NUMBER IS 'WO' FOLLOWED BY THE WORK ORDER # WP200 04520C* WP200 04530C********************************************************************WP200 04540CSR OUTRNS BEGSR WP200 0004550CSR TPRTNO COMP ' ' 20 WP200 04560CSR 20 MOVELPARTNO TPRTNO WP200 04570CSR MOVELTPRTNO PRTNUM 20 ONLY 20 IN ITA WP200 04580CSR MOVEL'WO' REFNO 7 WP200 04590CSR MOVE TWONUM REFNO WP200 04600CSR PRTNUM CHAINPARTMST 79 04610CSR 79N12 GOTO TAG5 0004620CSR ITRN COMP 60 71 04630CSR 71 GOTO TAG1 04640CSR ITRN COMP 63 72 04650CSR 72 GOTO TAG2 04660CSR ITRN COMP 64 71 04670CSR 71 GOTO TAG1 04680CSR ITRN COMP 66 73 0004690CSR 73 GOTO TAG3 04700CSR ITRN COMP 68 73 04710CSR 73 GOTO TAG3 04720CSR ITRN COMP 72 74 04730CSR 74 GOTO TAG4 04740CSR ITRN COMP 73 73 04750CSR 73 GOTO TAG3 0004755CSR GOTO TAG5 04760CSR TAG1 TAG 04770CSR SOO ADD IQTY SOO 04780CSR GOTO TAG5 04790CSR TAG2 TAG 04800CSR SOH SUB IQTY SOH 04810CSR MTDUSE ADD IQTY MTDUSE 0004820CSR GOTO TAG5 04830CSR TAG3 TAG 04840CSR SOO SUB IQTY SOO 04850CSR GOTO TAG5 04860CSR TAG4 TAG 04870CSR SOH ADD IQTY SOH 04890CSR TAG5 TAG 0004900CSR SETON 89 04910CSR EXCPT ADD RECORDS 04920CSR SETOF 89 71 04930CSR SETOF 727374 04940CSR ENDSR WP200 04950OWRKORD E 80N55 WP200 04960O STATUS 30 WP200 0004970O QTY 37 WP200 04980O QTYCOM 44 WP200 04990O RLSDAT 50 WP200 05000O MAT$ 72 WP200 05010O LAB$ 78 WP200 05020O BUR$ 84 WP200 05030O OPC$ 90 WP200 0005040O RWK$ 96 WP200 05050O LHRS 101 WP200 05060O RHRS 106 WP200 05070O SCRAP 113 WP200 05080O 60 Z6 119 WP200 05090O 60 Z6 125 WP200 05100O 60 Z6 131 WP200 0005110O 60 Z6 137 WP200 05120O 60 Z6 143 WP200 05130O 60 Z5 148 WP200 05140O 60 Z5 153 WP200 05150O EADD 80 55 WP200 05160O WONUM 5 WP200 05170O PARTNO 25 WP200 0005180O STATUS 30 WP200 05190O QTY 37 WP200 05200O QTYCOM 44 WP200 05210O RLSDAT 50 WP200 05220O REQDAT 56 WP200 05230O PRI 60 WP200 05240O REQCOD 57 WP200 0005250O OOOCD 61 WP200 05260O RRN 66 WP200 05270O MAT$ 72 WP200 05280O LAB$ 78 WP200 05290O BUR$ 84 WP200 05300O OPC$ 90 WP200 05310O RWK$ 96 WP200 0005320O LHRS 101 WP200 05330O RHRS 106 WP200 05340O SCRAP 113 WP200 05350O Z6 119 WP200 05360O Z6 125 WP200 05370O Z6 131 WP200 05380O Z6 137 WP200 0005390O Z6 143 WP200 05400O Z5 148 WP200 05410O Z5 153 WP200 05420OSWTRAN D 87 WP200 05430O ERRNO 60 WP200 05440OOHEXPL E 88 WP200 05450O TWONUM 5 WP200 0005460O TPRTNO 25 WP200 05470O TC 31 WP200 05480O EXQTY 38 WP200 05490O REQDAT 44 WP200 05500OTRNWO1 EADD 89 WP200 05510O PRTNUM 61 WP200 05520O ITRN 14 WP200 0005530O IQTY 21 WP200 05540O REFNO 28 WP200 05550O UDATE 34 WP200 05560OPARTMST E 06N79 12 05570O AND 89 05580O SOH 152 05590O SOO 159 0005600O MTDUSE 202 ** 005610ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 005620ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 005630ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 005640ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 005650/* 00566000_ 00 00 00 __ 0(2 DISPR2OS PPP051878051878(000010H DSPR2O00020FOUTPUT IPE F 80 DISK MFG10O00030FDISPR2 O F 32 DISK MFG10O00040IOUTPUT NS 01 MFG10O00050I 1 32 ALL MFG10O00060ODISPR2 D 01 MFG10O00070O ALL 32 MFG10O00/* 000080_ 00 __ 0(1( iNTXPO320 P>052178052178(000010H S PO320N00020X DECK-ID M70 MFG/DIST/ACCT SYSTEM SUMMARY-123 PO320 00030F* THIS PROGRAM PROCESSES VALID NEW PURCHASE ORDERS AND CHANGES PO320 00040F* CYBER 18-10M/20 PURCHASING VERSION 1.0PO320 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA PO320 00060F* CONTROL DATA PROPRIETARY PRODUCT PO320 00070F* PO320 0000080FPURUPD IPEAF 83 DISK PO320 00090FPURCH UC F 66R27AI 1 DISK A PO320 00100FTRANSAC O F 65 DISK A PO320 00105FPARTMST UC F 300R20AI 271 DISK 00110F* PO320 00120F* ************************************************************** PO320 00130F* ** ** PO320 0000140F* ** COMPANY- COMPUSOURCE MANUFACTURING SYSTEM PACKAGE ** PO320 00150F* ** ** PO320 00160F* ** SYSTEM - PINS PROGRAMMER- R. FREEMAN ** PO320 00170F* ** ** PO320 00180F* ** PROGRAM- PROCESS A,B,C,D,E DATE - 11/14/75 ** PO320 00190F* ** TRANSACTIONS TO PURCH ** PO320 00195F* ** PARTMST SOH AND SOO ARE UPDATED BY PO TRANSACTION 0000196F* ** TYPES 40, 42, 43 AND 45 (MAY 78) 00200F* ** ** PO320 00210F* ************************************************************** PO320 00220F* PO320 00230F* ************************************************************** PO320 00240F* ** ** PO320 00250F* ** FUNCTION OF INDICATORS ** PO320 0000260F* ** ** PO320 00270F* ** 01 PURUPD- HEADER (NO ERROR CODE) ** PO320 00280F* ** 02 PURUPD- LINE-ITEM (NO ERROR CODE) ** PO320 00290F* ** 03 PURUPD- OTHERS ** PO320 00300F* ** 04 PURCH ** PO320 00310F* ** 10 LINE-ITEM VENDOR#=ZERO - DON'T CHANGE ** PO320 00320F* ** 11 LINE-ITEM QTYDUE=ZERO - DON'T CHANGE ** PO320 0000330F* ** 12 LINE-ITEM QTYIN=ZERO - DON'T CHANGE ** PO320 00340F* ** 13 LINE-ITEM BUY COST=ZERO- DON'T CHANGE ** PO320 00345F* ** 15 DELETE CODE ON PARTMST BLANK 00350F* ** 20 VALID HEADER READ FOR THIS PO#- NEW P.O. ** PO320 00360F* ** 31 TRANS= RELEASE ** PO320 00370F* ** 32 TRANS= ADD (OPEN) ** PO320 00380F* ** 33 TRANS= BLANKET ** PO320 0000390F* ** 34 TRANS= CHANGE ** PO320 00400F* ** 35 TRANS= DELETE ** PO320 00410F* ** 40 ADD TRAN# 40 TO TRANSAC ** PO320 00420F* ** 42 ADD TRAN# 42 TO TRANSAC ** PO320 00430F* ** 43 ADD TRAN# 43 TO TRANSAC ** PO320 00440F* ** 45 ADD TRAN# 45 TO TRANSAC ** PO320 00450F* ** 71 P.O. CODE ON PURCH = RELEASE ** PO320 0000460F* ** 72 P.O. CODE ON PURCH = OPEN ** PO320 00470F* ** 73 P.O. CODE ON PURCH = BLANKET ** PO320 00480F* ** H1 NO HIT ON PURCH - MFG310 HAS BUGS ** PO320 00490F* ** H2 P.O. CODE INVALID- MFG310 HAS BUGS ** PO320 00500F* ************************************************************** PO320 00510F* PO320 00520IPURUPD XX 01 8 CH 29NCX PO320 0000530I 1 70PO L1 PO320 00540I 34 380HVEN PO320 00550I 39 440HPODAT PO320 00560I XX 02 8 CL 9NCR 29NCX PO320 00570I 1 70PO L1 PO320 00580I 9 9 ACTION PO320 00590I 64 83 PART PO320 0000600I 22 270IDUE PO320 00610I 64 83 N18 PO320 00620I 34 380IVEN 10 PO320 00630I 39 450IQTYDU 11 PO320 00640I 46 520IQTYIN 12 PO320 00650I 53 593ICOST 13 PO320 00660I XX 03 PO320 0000670I 1 1 DUMMY PO320 00680IPURCH XX 04 PO320 00690I 34 380VEN PO320 00700I 45 510QTYDUE PO320 00710I 52 580QTYIN PO320 00720I 66 66 POC PO320 00722IPARTMST NS 06 0000724I 146 1520SOH 00726I 153 1590SOO 00728I 74 74 DLTPR 15 00730C SETOF 404243 PO320 00735C SETOF 818283 00740C SETOF 45 PO320 00750C L1 SETOF 20 PO320 0000760C 01 SETON 20 PO320 00770C N02 GOTO END PO320 00780C********************************************************************PO320 00790C* CALCS FOR ADD,CHANGE,DELETE LINE-ITEMS. FOR ADDS & BLANKETS PO320 00800C* NO NEED TO DO ANY CHAINS TO PURCH- JUST ADD TO FILE. ADDS (NOT PO320 00810C* BLANKETS) GENERATE TR#40 WITH TRNQTY = QTY ORDERED. RELEASE IS PO320 00820C* SAME AS ADD BUT WE ALSO CHAIN TO ITS BLANKET ON PURCH & UPDATE PO320 0000830C* THE RELEASED-TO-DATE WITH THIS RELEASE QTY. ALSO GENERATES PO320 00840C* TR#40. FOR CHANGES, WE CHAIN TO PURCH & REPLACE ANY FIELDS PO320 00850C* WHICH ARE NON-ZERO ON PURUPD- VENDOR#,QTYDUE,QTYIN,OR OVERRIDE PO320 00860C* BUY COST. CHANGE TO QTYDUE GENERATES TR#42 WITH TRNQTY = NEW PO320 00870C* QTYDUE - OLD QTYDUE, CHANGE TO QTYIN-TR#43 WITH TRNQTY = NEW PO320 00880C* QTYIN - OLD QTYIN. FOR DELETES, WE CHAIN & UPDATE PURCH WITH PO320 00890C* DELETE CODE, GENERATE TR#45 WITH TRNQTY = QTYDUE - QTYIN. PO320 0000900C********************************************************************PO320 00910C ACTION COMP 'E' 31RELEASE PO320 00920C ACTION COMP 'A' 32ADD PO320 00930C ACTION COMP 'B' 33BLANKET PO320 00940C ACTION COMP 'C' 34CHANGE PO320 00950C ACTION COMP 'D' 35DELETE PO320 00960C 31 PO320 0000970COR 32 Z-ADDIQTYDU TRQTY1 70 4040 TR# 40 FOR E,A PO320 00980C 31 GOTO T31 PO320 00990C 34 GOTO T34 PO320 01000C 35 GOTO T35 PO320 01010C GOTO END NO NEED TO DO PO320 01020C* CHAIN FOR A,B PO320 01030C* PO320 0001040C T31 TAG REL- UPDATE PO320 01050C** QTY ON BLANKET PO320 01060C MOVE PO N7 70 PO320 01070C MOVE 00 N7 PO320 01080C MOVELN7 POKEY 27 PO320 01090C MOVE N18 POKEY PO320 01100C EXSR CHAIN PO320 0001110C N73 SETON H2 PO320 01120C H2 GOTO END PO320 01130C QTYIN ADD IQTYDU QTYIN ADD RELEAS QTY PO320 01140C GOTO END PO320 01150C* PO320 01160C T34 TAG CHANGE PO320 01170C* PO320 0001180C MOVELPO POKEY PO320 01190C MOVE N18 POKEY PO320 01200C EXSR CHAIN PO320 01210C N71N72N73 SETON H2 PO320 01220C H2 GOTO END PO320 01230C 73 GOTO END PO320 01240C N11 IQTYDU SUB QTYDUE TRQTY1 4242 CHANGE QTYDUE= PO320 0001250C* TR# 42 PO320 01260C N12 IQTYIN SUB QTYIN TRQTY2 70 4343 CHANGE QTYREC= PO320 01270C* TR# 43 PO320 01280C N71 PO320 01290CORN42 GOTO END PO320 01300C MOVELPO K7 70 PO320 01310C MOVE '00' K7 PO320 0001320C MOVELK7 POKEY PO320 01330C EXSR CHAIN PO320 01340C N73 GOTO REST PO320 01350C QTYIN ADD TRQTY1 QTYIN PO320 01360C SETON 80 PO320 01370C 80 EXCPT PO320 01380C SETOF 80 PO320 0001390C REST TAG PO320 01400C MOVELPO POKEY PO320 01410C MOVE N18 POKEY PO320 01420C EXSR CHAIN PO320 01430C GOTO END PO320 01440C* PO320 01450C T35 TAG DELETE PO320 0001460C* PO320 01470C MOVELPO POKEY PO320 01480C MOVE N18 POKEY PO320 01490C EXSR CHAIN PO320 01500C N71N72N73 SETON H2 PO320 01510C H2 GOTO END PO320 01520C N73 QTYDUE SUB QTYIN TRQTY1 4545 DELETE QTYDUE= PO320 0001530C END TAG TR# 45 PO320 01531C 40 Z-ADD40 TRANNO 20 01532C 42 Z-ADD42 TRANNO 01533C 43 Z-ADD43 TRANNO 01534C 45 Z-ADD45 TRANNO 01535C PART CHAINPARTMST 57 01536C 57N15 GOTO END1 0001537C TRANNO COMP 40 81NEW PO 01538C 81 GOTO TAG1 01539C TRANNO COMP 42 81RPL PO QTY 01540C 81 GOTO TAG1 PO320 01541C TRANNO COMP 43 82RPL PO REC 01542C 82 GOTO TAG2 01543C TRANNO COMP 45 83DELETE PO 0001544C 83 GOTO TAG3 01545C GOTO END1 01546C TAG1 TAG 01547C SOO ADD TRQTY1 SOO 01548C GOTO END1 01549C TAG2 TAG 01550C SOH ADD TRQTY2 SOH PO320 0001551C SOO SUB TRQTY2 SOO 01552C GOTO END1 01553C TAG3 TAG 01544C SOO SUB TRQTY1 SOO 01555C END1 TAG 01556CSR CHAIN BEGSR 01557CSR SETOF 717273 0001560CSR POKEY CHAINPURCH H1 PO320 01570CSR H1 GOTO ENDCH PO320 01580CSR POC COMP 'R' 71 PO320 01590CSR POC COMP ' ' 72 PO320 01600CSR POC COMP 'B' 73 PO320 01610CSR ENDCH ENDSR PO320 01620OPURCH D 02 31 PO320 0001630O QTYIN 58 PO320 01640O D 02 34 PO320 01650O N10 IVEN 38 PO320 01660O N11 IQTYDU 51 PO320 01670O N12 IQTYIN 58 PO320 01680O N13 ICOST 65 PO320 01690O D 02 35 PO320 0001700O 66 'D' PO320 01710O E 80 PO320 01720O QTYIN 58 PO320 01730O DADD 02 31 PO320 01740O OR 02 32 PO320 01750O OR 02 33 PO320 01760O PO 7 PO320 0001770O PART 27 PO320 01780O IDUE 33 PO320 01790O 20 HVEN 38 PO320 01800O N20 IVEN 38 PO320 01810O 20 HPODAT 44 PO320 01820O N20 UDATE 44 PO320 01830O IQTYDU 51 PO320 0001840O N13 ICOST 65 PO320 01850O 31 66 'R' PO320 01860O 32 66 ' ' PO320 01870O 33 66 'B' PO320 01880OTRANSAC DADD 02 40 PO320 01890O OR 02 42 PO320 01900O OR 02 45 PO320 0001910O PART 61 PO320 01920O 40 14 '40' PO320 01930O 42 14 '42' PO320 01940O 45 14 '45' PO320 01950O TRQTY1 21 PO320 01960O PO 28 PO320 01970O 20 HPODAT 34 PO320 0001980O N20 UDATE 34 PO320 01990O DADD 02 43 PO320 02000O PART 61 PO320 02010O 14 '43' PO320 02020O TRQTY2 21 PO320 02030O PO 28 PO320 02040O UDATE 34 PO320 0002050O N13 ICOST 41 PO320 02062OPARTMST D 06N57 15 0206202064O AND 02 0206402066O SOH 152 0206602068O SOO 159 02068** 02069ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 00207000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 002080ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 002090ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 002100/* 002110_ __ 02069ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0020700(Y: TXINNPRT PJJ999999052378(000010H INNPRT00020FNEWPART IPE F 30 DISK INNPRT00030FPRINT O F 132 OF PRINTER INNPRT00040INEWPART NS 01 INNPRT00050I 11 30 PART INNPRT00060OPRINT H 201 1P INNPRT00070O OR OF INNPRT0000080O 70 ' HASKEL ENGINEERING AND ' INNPRT00090O 84 'SUPPLY COMPANY' INNPRT00100O 132 'INNPRT' INNPRT00110O H 3 1P INNPRT00120O OR OF INNPRT00130O PAGE 7 INNPRT00140O 4 'PAGE' INNPRT0000150O 74 'INVENTORY MAINTENANCE RE' INNPRT00160O 80 'QUIRED' INNPRT00170O UDATE Y 132 INNPRT00180O H 2 1P INNPRT00190O OR OF INNPRT00200O 30 'THE FOLLOWING PART NUMBE' INNPRT00210O 53 'RS ARE NOT CURRENTLY ON ' INNPRT0000220O 78 'PARTMST FILE BUT WERE AC' INNPRT00230O 101 'CEPTED ON TODAY''S OPEN ' INNPRT00240O 115 'SALES ORDERS.' INNPRT00250O H 3 1P INNPRT00260O OR OF INNPRT00270O 30 'PLACE THEM ON PARTMST FI' INNPRT00280O 54 'LE IMMEDIATELY. USE INV' INNPRT0000290O 78 'ENTORY MAINTENANCE, MENU' INNPRT00300O 98 ' ''IN'', FUNCTION ''A''.' INNPRT00310O D 2 01 INNPRT00320O PART 26 INNPRT/* 000330_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0() TTXOECRS PDv052478052478(000010H S OECRS 00020X DECK-ID A46 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE012 00030F* PRINTS CUSTOMER LIST FROM ARMAST OE012 00040F* IN CUSTOMER NAME ORDER OE012 00050FARMAST1 IPE F 280 DISK OE012 00060FHEADING IT F 40 EDISK OE012 00070F$LP1 O F 132 OF PRINTER OE012 0000080F********************************************************************OE012 00090E HEADING HDR 1 1 40 COMPANY NAME OE012 00100E********************************************************************OE012 00110IARMAST1 NS 01 OE012 00120I 2 60CUSTNO OE012 00130I 7 30 NAME OE012 00140I 31 54 ADR1 OE012 0000150I 55 78 ADR2 12 OE012 00160I 79 91 CITY OE012 00170I 92 93 STATE OE012 00180I 94 98 ZIP OE012 00190I 99 1080PHONE OE012 00200I 109 1140CRLIM OE012 00210I 116 116 STMNT OE012 0000215I 115 115 DELCOD 00220I 124 139 PERSON OE012 00230I 154 1560SLSMAN OE012 00240I 157 158 AREA OE012 00250I 159 159 TAX OE012 00260I 160 160 TERMS OE012 00270I 161 161 PRCODE OE012 0000280I 162 163 ACCTYP OE012 00290I NS 02 OE012 00300I 1 1 UNUSED OE012 00310C********************************************************************OE012 00312C N99 Z-ADD0 COUNT 00314C N99 SETON 99 00320C 01 COUNT ADD 1 COUNT 80 OE012 0000330C********************************************************************OE012 00340O$LP1 H 202 OF OE012 00350O OR 1P OE012 00360O PAGE Z 8 OE012 00370O 4 'PAGE' OE012 00380O HDR,1 86 OE012 00390O UDATE Y 132 OE012 0000400O H 2 OF OE012 00410O OR 1P OE012 00420O 72 'CUSTOMER MASTER FILE ' OE012 00430O 81 'CROSS-REF' OE012 00440O 132 'DISCRS' OE012 00450O H 1 OF 00460O OR 1P 0000470O 21 ' CUSTOMER NAME' 00480O 35 'CUST #' 00485O 52 ' DELETE INDICATOR' 00490O D 11 01 OE012 00500O CUSTNOZ 35 OE012 00510O NAME 25 OE012 00515O DELCOD 44 0000520O T 3 LR OE012 00530O 23 'END OF JOB. THERE WERE' OE012 00540O COUNT J 35 OE012 00550O 56 'ACTIVE RECORDS IN THE' OE012 00560O 78 'CUSTOMER MASTER FILE.' OE012 00570O********************************************************************OE012 ** 00058000ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000590ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000600ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000610ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 000620/* 000630_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0(  KNTXOE350 P 052178052178(000010H S OE350N00020X DECK-ID A69 MFG/DIST/ACCT SYSTEM SUMMARY-123 OE350 00030F* UPDATE SALES STATS, UPDATE INVENTORY OE350 00040F* CYBER 18-10M/20 ORDER ENTRY-INVOICING-SALES ANALYSIS VERSION 1.0OE350 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA OE350 00060F* CONTROL DATA PROPRIETARY PRODUCT OE350 00070F* OE350 0000080FINVDTL IPEAF 75 DISK OE350 00090FMTHINV O F 74 DISK A OE350 00100FTRANSAC O F 65 DISK A OE350 00105FPARTMST UC F 300R20AI 271 DISK 00110F********************************************************************OE350 00120F* ORIGINAL LABRUSH PROGRAM CODED BY KATH HILL [INV060] OE350 00130F* OE350 0000140F* PACKAGE DISTRIBUTION OE350 00150F* SYSTEM INVOICING OE350 00160F* PROGRAM ADD RECORDS FOR SALES STATS, UPDATE INVENTORY OE350 00170F* OE350 00180F* CONTRACTOR COMPUSOURCE OE350 00190F* PROGRAMMER KATH HILL OE350 00200F* DATE FEBRUARY 25, 1975 OE350 0000210F* OE350 00220F********************************************************************OE350 00230F* OE350 00240F* NARRATIVE: ADDS 1 RECORD TO MTHINV AND 1 RECORD TO TRANSAC OE350 00250F* FOR EACH RECORD IN INVDTL. (UNLESS QTY SHIPPED=0) OE350 00255F** PARTMST SOH, ALLOC AND DIRECT MTDUSE ARE UPDATED BY 00256F** TRANSACTION TYPES 12, 14, 16, AND 20 (MAY 78) 0000260F********************************************************************OE350 00270F* OE350 00280F* FUNCTION OF INDICATORS OE350 00290F* OE350 00300F* 10 QTY = ZERO OE350 00305F* 12 DELETE CODE ON PARTMST BLANK 00310F* 20 TYPE (I) = TRANSACTION # (14) OE350 0000320F* 21 (C) = (16) OE350 00330F* 22 (M) = (18) OE350 00340F* 23 (E) = (20) OE350 00350F* OE350 00360F********************************************************************OE350 00370IINVDTL NS 01 OE350 00380I 1 50INVNUM OE350 0000390I 6 100CUSTNO OE350 00400I 11 160INVDAT OE350 00410I 17 190SLSMAN OE350 00420I 20 260QTY 10 OE350 00430I 56 75 PARTNO OE350 00440I 39 452NETSLS OE350 00450I 46 523UNCOST OE350 0000460I 53 54 AREA OE350 00470I 55 55 TYPE OE350 00471IPARTMST NS 06 00472I 146 1520SOH 00473I 167 1730ALLOC 00474I 160 1660MTDUSE 00475I 74 74 DLTPR 12 0000476C SETOF 717273 00480C TYPE COMP 'I' 20 OE350 00490C TYPE COMP 'C' 21 OE350 00500C TYPE COMP 'M' 22 OE350 00510C TYPE COMP 'E' 23 OE350 00520C 20 Z-ADD14 TRANNO 20 OE350 00530C 21 Z-ADD16 TRANNO OE350 0000540C 22 Z-ADD18 TRANNO OE350 00550C 23 Z-ADD20 TRANNO OE350 00551C PARTNO CHAINPARTMST 57 00552C 57N12 GOTO END 00555C TRANNO COMP 14 72INVOICE 00556C 72 GOTO TAG2 00557C TRANNO COMP 16 73CR MEMO 0000558C 73 GOTO TAG3 00559C TRANNO COMP 18 73MANUAL INV 00560C 73 GOTO TAG3 OE350 00561C TRANNO COMP 20 73DRECT BILL 00562C 73 GOTO TAG3 00563C GOTO END 00567C TAG2 TAG 0000568C SOH SUB QTY SOH 00569C ALLOC SUB QTY ALLOC 00570C MTDUSE ADD QTY MTDUSE OE350 00571C GOTO END 00572C TAG3 TAG 00573C SOH SUB QTY SOH 00574C MTDUSE ADD QTY MTDUSE 0000575C END TAG 00578OMTHINV DADD 01N10 00579O INVNUM 5 00580O CUSTNO 10 OE350 00590O INVDAT 16 OE350 00600O SLSMAN 19 OE350 00610O QTY 26 OE350 0000620O PARTNO 74 OE350 00630O NETSLS 45 OE350 00640O UNCOST 52 OE350 00650O AREA 54 OE350 00660OTRANSAC DADD 01N10 OE350 00670O PARTNO 61 OE350 00680O TRANNO 14 OE350 0000690O QTY 21 OE350 00700O INVNUM 28 OE350 00710O INVDAT 34 OE350 00720O UNCOST 41 OE350 00721OPARTMST D 06N57 12 00722O AND 01 00723O SOH 152 0000724O ALLOC 173 00725O MTDUSE 166 ** 000730ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 000740ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 000750ALTSEQ 6E3E6F3F7C40C141C242C343C444C545C646C747C848C949D14AD24BD34CD44D 000760ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 00077000/* 000780_ 00 00 00 00 00 00 00 00 00 __ 0(d\ d*TXPO500 P999999052478(000010H PO500 00020FALLIN IPE F 77 DISK PO500 00030FHEADING IS F 40 DISK PO500 00040FPRINT O F 132 OF PRINTER PO500 00050IALLIN NS 01 1NC* PO500 00060I 13 190PONBR PO500 00070I 51 570QTYREC PO500 0000080I 58 77 PARTNO PO500 00090I NS 02 1 C* PO500 00100I 14 180WONBR PO500 00110I 21 270QTYSRT PO500 00120I 58 77 PART PO500 00130I 1 5 STARS PO500 00140IHEADING NS 03 PO500 0000150I 1 40 HDG PO500 00151C SETOF 55 PO500 00160C 01 MOVELPARTNO SAVE 20 PO500 00170C 01 QTYREC ADD TOTL1 TOTL1 70 PO500 00180C 02 TOTL1 SUB QTYSRT TOTL2 70 50 PO500 00190C 02 50 Z-SUBTOTL2 TOTL2 PO500 00200C 02 SAVE COMP PART 55 PO500 0000210OPRINT H 201 1P PO500 00220O OR OF PO500 00230O 70 'HASKEL ENGINEERING AND ' PO500 00231O 84 'SUPPLY COMPANY' PO500 00260O 132 'PO500' PO500 00270O H 2 1P PO500 00280O OR OF PO500 0000290O 4 'PAGE' PO500 00300O PAGE 9 PO500 00310O 69 'P.O. RECEIPTS VS. WORK' PO500 00320O 84 'ORDER SHORTAGES' PO500 00330O UDATE Y 132 PO500 00340O H 1 1P PO500 00350O OR OF PO500 0000360O 41 'QUANTITY P.O.' PO500 00370O 71 'PART IS' PO500 00380O 97 'QUANTITY QUANTITY' PO500 00390O 108 'SHORTAGE' PO500 00400O H 1 1P PO500 00410O OR OF PO500 00420O 20 'PART NUMBER RECEIVED' PO500 0000430O 42 'RECEIVED NUMBER' PO500 00440O 75 'SHORT ON W.O.' PO500 00450O 97 'SHORT AVAILABLE' PO500 00460O 108 'REMAINING' PO500 00470O H 2 1P PO500 00480O OR OF PO500 00500O D 1 01 PO500 0000510O PARTNO 20 PO500 00520O QTYRECK 32 PO500 00530O PONBR 42 PO500 00540O T 1 55 PO500 00550O 21 'TOTAL NUMBER RECEIVED' PO500 00560O T 3 55 PO500 00570O 13 'AND AVAILABLE' PO500 0000580O TOTL1 K 32 PO500 00590O 33 '**' PO500 00600O T 11 55 PO500 00610O WONBR 70 PO500 00620O QTYSRTK 87 PO500 00630O TOTL1 KB 98 PO500 00640O 50 TOTL2 K 109 PO500 00/* 000650_ 00 00 00 00 00 __ 0(a] TXIN610 P8!z999999042878(000010H S IN610U00020X DECK-ID M57 MFG/DIST/ACCT SYSTEM SUMMARY-123 IN610 00030F* THIS PROGRAM USED FOR ENTER/EDIT MANUAL INVENTORY TRANSACTIONS IN610 00040F* CYBER 18-10M/20 INVENTORY CONTROL VERSION 1.0IN610 00050F* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA IN610 00060F* CONTROL DATA PROPRIETARY PRODUCT IN610 00070F* IN610 0000080FDUMMY IPEAF 72 DISK IN610 00090FPARTMST UC F 300R20AI 271 DISK IN610 00100FTRANTMP UC F 65R DISK IN610 00110F********************************************************************IN610 00120F* IN610 00130F* PACKAGE MANUFACTURING IN610 00140F* SYSTEM INVENTORY TRANSACTIONS ACCOUNTING IN610 0000150F* PROGRAM MANUAL INVENTORY TRANSACTIONS ENTRY/EDIT IN610 00160F* AND UPDATE PARTMST WITH TRAN QTY'S. (S00, SOH, 00170F* ALLOC, MTD USAGE, AVGUSE, AVGMAT COST/UNIT, & 00180F* YTD USAGE). 00190F* IN610 00200F* CONTRACTOR COMPUSOURCE IN610 00210F* PROGRAMMER KATH HILL IN610 0000220F* DATE OCTOBER 30, 1975 IN610 00230F* IN610 00240F********************************************************************IN610 00250F* IN610 00260F* NARRATIVE: USES TRATMP RECORDS TO UPDATE PARTMST. 00270F* NARRATIVE: TRAN # DESCRIPTION IN610 00280F* ---------- ------ ----------------------------------------- IN610 0000290F* IN610 00300F* 10 NEW SALES ORDER IN610 00310F* 12 DELETE SALES ORDER IN610 00320F* 14 INVOICE IN610 00330F* 16 CREDIT MEMO IN610 00340F* 18 MANUAL INVOICE IN610 00350F* 20 DIRECT BILL IN610 0000360F* 40 NEW PURCHASE ORDER IN610 00370F* 42 REPLACE P.O. QTY ORDERED IN610 00380F* 43 REPLACE P.O. QTY RECEIVED IN610 00390F* 44 P.O. RECEIPT IN610 00400F* 45 CANCEL PO QTY OR DELETE PO IN610 00410F* 60 OPEN JOBS IN610 00420F* 61 OPEN JOBS (COMPONENTS) IN610 0000430F* 62 RELEASE JOBS IN610 00440F* 63 MATERIAL ISSUES IN610 00450F* 64 CHANGE JOB QTY IN610 00460F* 65 CHANGE JOB QTY (COMPONENTS) IN610 00470F* 66 DELETE OPEN JOBS IN610 00480F* 67 DELETE OPEN JOBS (COMPONENTS) IN610 00490F* 68 CLOSE JOB SHORT IN610 0000510F* 70 ADJUST REQUISITIONS IN610 00520F* 72 COMPLETED PRODUCTION#1 IN610 00530F* 73 COMPLETED PRODUCTION#2 IN610 00540F* 80 ADJUST ALLOCATION IN610 00550F* 82 ADJUST STOCK ON ORDER IN610 00560F* 84 REPLACE STOCK ON ORDER IN610 00570F* 86 ADJUST STOCK ON HAND IN610 0000580F* 88 REPLACE STOCK ON HAND IN610 00590F* 90 ADJUST AVERAGE USAGE IN610 00600F* 92 REPLACE AVERAGE USAGE IN610 00610F* 93 ADJUST MTD USAGE IN610 00620F* 94 REPLACE MTD USAGE IN610 00630F* 95 ADJUST YTD USAGE IN610 00640F* 96 REPLACE YTD USAGE IN610 0000650F* IN610 00660F********************************************************************IN610 00670F* ID F C H L FUNCTION OF INDICATORS IN610 00680F* IN610 00690F* 01 DUMMY IN610 00700F* 02 PARTMST IN610 00710F* 03 TRNTMP 0000720F* IN610 00730F* 21 UNIT COST = 0 00740F* 22 DLT CD ' ' (PARTMST) IN610 00750F* IN610 00760F* 10 END OF JOB IN610 00770F* 11 EDIT --- ERROR IN610 00780F* 12 START A NEW SCREEN IN610 0000790F* 20 CHAIN TO PARTMST A MISS 00800F* 25 TABLE SEARCH 00810F* 31 RUBOUT TO START OF THIS FIELD IN610 00820F* 32 RUBOUT TO START OF LAST FIELD IN610 00830F* 33 LINEFEED IN610 00840F* 34 FLDX VS. ACTY 00850F* 36 FIELD LOOPER GUARD 0000860F* 50 TRANS # = 16 --> CREDIT MEMO --> Z-SUB QTY IN610 00870F* 55 TRAN # = 43 OR 44 --> BUY COST (OVERRIDE) IN610 00880F* 60 NEG. TRAN QTY IN610 00890F* 61 TABLE SEARCH HIT IN610 00900F* 70 STOCK-ON-HAND X=1 00910F* 71 STOCK-ON ORDER X=2 00920F* 72 ALLOCATE X=3 0000930F* 83 MTD USAGE X=4 00940F* 88 AVERAGE USAGE X=5 00950F* 89 YTD USAGE X=6 00960F* 84 ' ' Y=1 00970F* 85 '+' Y=2 00980F* 86 '-' Y=3 00990F* 87 'R' Y=4 0001000F* 01010F* 01020F* 90 OUTPT --- ERROR 01030F* 01040F* 91 TRAN # 01050F* 92 PART # IN610 01060F* 93 TRAN QTY IN610 0001070F* 94 REF # IN610 01080F* 95 BUY COST (OVERRIDE) - TRAN #'S 43 AND 44 ONLY IN610 01090F* 98 SETUP XPOSS & YPOSS AT START OF PROG 01100F* 99 HEADINGS FOR CRT IN610 01110F* IN610 01120F********************************************************************IN610 01130E TABA 1 35 2 0 TABB 10 TRAN #/TYPE IN610 0001140E MSG 1 25 56 CRT IN610 01150E MES 1 10 50 IN610 01160E BLNKS 1 72 BLANKS IN610 01170E TABD 1 35 2 0 TABE 6 TRAN #/FIELDS 01180E ACT 4 4 1 /+/-/R 01190E TABC 1 2 2 0 SPECIAL TRAN # 01200E* UPDATE AVGMAT 0001210E FLD 6 1 TABE SPLIT APART 01220IDUMMY NS 01 IN610 01230I 1 1 AIR IN610 01240IPARTMST NS 02 IN610 01250I 1 37 DESCRP 01260I 74 74 DLTPR 22 01270I 75 813STDCST 0001280I 82 883AVGMAT 01290I 146 1520SOH 01300I 153 1590SOO 01310I 167 1730ALLOCA 01320I 196 2020MTDUSE 01330I 203 2090AVGUSE 01340I 212 2180YTDUSE 0001350ITRANTMP NS 03 01360I 1 2 TST 01370I 42 61 PARTNO IN610 01380I 13 140TN IN610 01390I 15 210BLIND IN610 01400I 22 28 REFNUM 28 IN610 01410I 35 413OVCOST 21 0001420C SETON LR IN610 01430CLR EXSR ALMTS IN610 01440CLR Z-ADDLOW SEQNO IN610 01450CLR MOVELBLNKS,1 BUFFER 72 IN610 01460CLR MOVE ']' RTBRK 1 IN610 01470CLR MODECK TAG IN610 01480CLR SETOF 80 IN610 0001490CLR EXSR CLRSCR IN610 01500CLR MOVEL'MODE-' BUFFER IN610 01510CLR MOVE 'S' TYPE IN610 01520CLR Z-ADD5 BLNGTH IN610 01530CLR EXSR CRTCOM IN610 01540CLR MOVE 'A' TYPE IN610 01550CLR Z-ADD1 BLNGTH IN610 0001560CLR EXSR CRTCOM IN610 01570CLR MOVELBUFFER MODE 1 IN610 01580CLR 'C' COMP MODE 81 CHANGE IN610 01590CLR 'A' COMP MODE 82 ADD IN610 01600CLRN81N82 MOVEL'MODE NOT'WORDS 14 IN610 01610CLRN81N82 MOVE 'A OR C' WORDS IN610 01620CLRN81N82 MOVELWORDS BUFFER IN610 0001630CLRN81N82 Z-ADD14 BLNGTH IN610 01640CLRN81N82 MOVE 'T' TYPE IN610 01650CLRN81N82 EXSR CRTCOM IN610 01660CLRN81N82 GOTO MODECK IN610 01670CLR NEXT TAG NEW SCREEN IN610 01680CLR Z-ADD0 Z 20 0 LINE INCR. IN610 01690CLR EXSR CLRSCR CLEAR CRT SCRN IN610 0001700CLR Z-ADD0 Y 20 0 MSG INCR. IN610 01710CLR LOOP1 TAG ---------------IN610 01720CLR Y ADD 1 Y HEADINGS IN610 01730CLR EXSR OUTPT IN610 01740CLR Y COMP 7 99 IN610 01750CLR 99 GOTO LOOP1 ---------------IN610 01760CLR LINE TAG NEW LINE IN610 0001770CLR SHOW TAG ---------------IN610 01780CLR 81 EXSR GETSEQ IN610 01790CLR EXSR GETREC IN610 01800CLR Z-ADDY YHOLD 20 PUT OUT IN610 01810CLR SHOW1 TAG IN610 01820CLR SETON 65 IN610 01830CLR Y ADD 1 Y BRACKETS IN610 0001840CLR EXSR OUTPT FOR THIS LINE IN610 01850CLR Y COMP 11 99 IN610 01860CLR 99 GOTO SHOW1 IN610 01870CLR Z-ADDYHOLD Y IN610 01880CLR SETOF 65 IN610 01890CLR INPUT1 TAG ---------------IN610 01900CLR Z-ADD8 Y IN610 0001910CLR EXSR OUTPT IN610 01920CLR SETON 91 IN610 01930CLR EXSR ACCEPT TRANSACTION # IN610 01940CLR SETOF 91 IN610 01950CLR 10 GOTO END END OF JOB IN610 01960CLR 80 GOTO MODECK IN610 01970CLR 31 32 GOTO LINE RUBOUT IN610 0001980C* IN610 01990CLR INPUT2 TAG ---------------IN610 02000CLR Z-ADD9 Y IN610 02010CLR EXSR OUTPT IN610 02020CLR SETON 92 IN610 02030CLR EXSR ACCEPT PART # IN610 02040CLR SETOF 92 IN610 0002050CLR 31 32 GOTO INPUT1 BACK TO TRAN # IN610 02060CLR INPUT3 TAG ---------------IN610 02070CLR Z-ADD10 Y IN610 02080CLR EXSR OUTPT IN610 02090CLR SETON 93 IN610 02100CLR EXSR ACCEPT TRANS. QTY. IN610 02110CLR SETOF 93 IN610 0002120CLR 31 32 GOTO INPUT2 BACK TO PART # IN610 02130CLR INPUT4 TAG ---------------IN610 02140CLR Z-ADD11 Y IN610 02150CLR EXSR OUTPT IN610 02160CLR SETON 94 IN610 02170CLR EXSR ACCEPT REF # IN610 02180CLR SETOF 94 IN610 0002190CLR 31 32 GOTO INPUT3 BK TO TRAN QTY IN610 02200C* ---------------IN610 02210CLR INPUT5 TAG IN610 02220CLR TN COMP 43 55 IN610 02230CLRN55 TN COMP 44 55 IN610 02240CLRN55 GOTO ALLIN IN610 02250CLR Z-ADD11 Y IN610 0002260CLR EXSR OUTPT IN610 02270CLR SETON 95 IN610 02280CLR EXSR ACCEPT BUY COST IN610 02290C* (OVERRIDE) IN610 02300CLR SETOF 95 IN610 02310CLR 31 32 GOTO INPUT4 IN610 02320C* IN610 0002330CLR ALLIN TAG IN610 02340C* IN610 02350CLR TN COMP 16 50CREDIT MEMO IN610 02360CLR 50 Z-SUBQTY BLIND 70 IN610 02370CLRN50 Z-ADDQTY BLIND IN610 02380C******************************************************************** 02390CLR Z-ADD6 XPOSS 20 SOH/SOO/ALLOCA 0002400C* MTDUSE/AVGUSE 02410C* YTDUSE 02420CLRN98 Z-ADD4 YPOSS 20 /+/-/R 02430CLRN98 SETON 98 02440CLR PARTNO CHAINPARTMST 20 02450CLRN20N22 SETON 20 02460CLR 20 GOTO FINI 0002470C* 02480CLR Z-ADDAVGMAT SV1 73 02490CLR Z-ADDSOH SV2 70 02500CLR Z-ADDSOO SV3 70 02510CLR Z-ADDALLOCA SV4 70 02520CLR Z-ADDMTDUSE SV5 70 02530CLR Z-ADDAVGUSE SV6 70 0002540CLR Z-ADDYTDUSE SV7 70 02550C* 02560CLR TN LOKUPTABC 25 02570CLR 25 EXSR CALC1 02580C* 02590CLR TN LOKUPTABD TABE 25 02600CLRN25 GOTO FINI 0002610C* 02620CLR MOVELTABE FLDS2 2 02630CLR MOVE TABE FLDS4 4 02640CLR MOVELFLDS2 FLD,1 02650CLR MOVE FLDS2 FLD,2 02660CLR MOVELFLDS4 FLDS2 02670CLR MOVELFLDS2 FLD,3 0002680CLR MOVE FLDS2 FLD,4 02690CLR MOVE FLDS4 FLDS2 02700CLR MOVELFLDS2 FLD,5 02710CLR MOVE FLDS2 FLD,6 02720C* 02730CLR Z-ADD0 X 20 02740CLR LOOP3 TAG 0002750CLR X ADD 1 X 02760CLR Z-ADD0 Y 20 02770CLR X COMP XPOSS 36 02780CLR 36 GOTO ENDLP1 02790CLR LOOP2 TAG 02800CLR Y ADD 1 Y 02810CLR FLD,X COMP ACT,Y 34 0002820CLR 34 EXSR CALC2 02830CLR 34 GOTO ENDLP2 02840CLR GOTO LOOP2 02850CLR ENDLP2 TAG 02860CLR GOTO LOOP3 02870CLR ENDLP1 TAG 02880C* 0002890CLR FINI TAG 02900C* 02910CLRN20 PARTNO CHAINPARTMST 20 ALWAYS HITS! 02920C* 02930CLR EXCPT 02940CLR Z ADD 1 Z INCR. LINE 02950CLR Z COMP 14 12 15 LINES/SCRN 0002960C******************************************************************** 02970C******************************************************************** 02980CLR 12 GOTO NEXT NEXT SCREEN IN610 02990CLR Z-ADD8 Y IN610 03000CLR GOTO LINE NEXT LINE IN610 03010C* IN610 03020CLR END TAG IN610 0003030CLR EXSR CLRSCR IN610 03040CLR CLOSE TAG IN610 03050C********************************************************************IN610 03060C* IN610 03070C* THIS SUBROUTINE ACCEPTS INFORMATION FROM THE CRT. IN610 03080C* IN610 03090C********************************************************************IN610 0003100CSR ACCEPT BEGSR IN610 03110CSR AALOOP TAG IN610 03120CSR 91 Z-ADD12 Y TRAN # IN610 03130CSR 92 Z-ADD13 Y PART # IN610 03140CSR 93 Z-ADD14 Y TRAN QTY IN610 03150CSR 94 Z-ADD15 Y REF # (COMMENT)IN610 03160CSR 95 Z-ADD16 Y BUY COST IN610 0003170C* (OVERRIDE) IN610 03180CSR EXSR KEEP1 IN610 03190CSR ACLOOP TAG IN610 03200CSR MOVELXYPOS BUFFER IN610 03210CSR EXSR POSCUR IN610 03220CSR MOVELBLNKS BUFFER IN610 03230CSR MOVE LENG BLNGTH IN610 0003240CSR MOVE 'A' TYPE IN610 03250CSR EXSR CRTCOM IN610 03260CSR RCODE COMP 'R' 31RUBOUT IN610 03270CSR 31 BUFFER COMP BLNKS,1 32GO BACK A FIELDIN610 03280CSR 31 32 GOTO ENDACP IN610 03290CSR 31 GOTO ACLOOP IN610 03300CSR RCODE COMP 'L' 33LINEFEED IN610 0003310CSRN33 91 MOVELBUFFER EOJ 1 IN610 03320CSRN33 91 EOJ COMP 'E' 10END OF JOB IN610 03330CSRN33 91 10 GOTO ENDACP IN610 03340CSRN33 91 EOJ COMP 'M' 80 IN610 03350CSRN33 91 80 GOTO ENDACP IN610 03360CSRN33 91 MOVELBUFFER ALPH1 2 TRAN # IN610 03370CSRN33 91 EXSR RTADJ IN610 0003380CSRN33 92 MOVELBUFFER PARTNO 20 IN610 03390CSRN33 93 MOVELBUFFER MINUS 1 IN610 03400CSRN33 93 MINUS COMP '-' 60 IN610 03410CSRN33 93 60 MOVELBUFFER ALPH3 8 IN610 03420CSRN33 93 60 MOVE ALPH3 ALPH4 7 IN610 03430CSRN33 93N60 MOVELBUFFER ALPH4 IN610 03440CSRN33 93 EXSR RTADJ IN610 0003450CSRN33 93 60 Z-SUBQTY QTY NUMERIC TN QTY IN610 03460CSRN33 94 MOVELBUFFER REFNUM 7 IN610 03470CSRN33 95 MOVELBUFFER WORD7 7 IN610 03480CSRN33 95 EXSR RTADJ IN610 03490CSRN33 GOTO ENDACC IN610 03500CSR 91 MOVELTN BUFFER IN610 03510CSR 92 MOVELPARTNO BUFFER IN610 0003520CSR 93 MOVELBLIND BUFFER IN610 03530CSR 94 MOVELREFNUM BUFFER IN610 03540CSR 95 MOVELOVCOST BUFFER IN610 03550CSR ENDACC TAG IN610 03560CSR EXSR CONFRM IN610 03570CSR SETOF 11 IN610 03580CSRN93N94N95 EXSR EDIT IN610 0003590CSR 11 GOTO AALOOP IN610 03600CSR ENDACP ENDSR IN610 03610C********************************************************************IN610 03620C* IN610 03630C* THIS SUBROUTINE RIGHT ADJUSTS. PROD #/TRAN #/TRAN QTY IN610 03640C* IN610 03650C********************************************************************IN610 0003660CSR RTADJ BEGSR IN610 03670CSR 91 Z-ADDLENG VL IN610 03680CSR 93 LENG SUB 1 VL IN610 03690CSR 95 Z-ADDLENG VL IN610 03700CSR 91 MOVELALPH1 VAR IN610 03710CSR 93 MOVELALPH4 VAR IN610 03720CSR 95 MOVELWORD7 VAR IN610 0003730CSR EXIT SUBRAJ IN610 03740CSR RLABL VL 20 IN610 03750CSR RLABL VAR 15 IN610 03760CSR 91 MOVELVAR BUFFER IN610 03770CSR 91 MOVELVAR TN 20 IN610 03780CSR 93 MOVELVAR QTY 70 IN610 03790CSR 93 60 MOVEL'-' ALPH3 IN610 0003800CSR 93N60 MOVEL' ' ALPH3 IN610 03810CSR 93 MOVE QTY ALPH3 IN610 03820CSR 93 MOVELALPH3 BUFFER IN610 03830CSR 95 MOVELVAR BUFFER IN610 03840CSR 95 MOVELVAR OVCOST 73 IN610 03850CSR ENDSR IN610 03860C********************************************************************IN610 0003870C* IN610 03880C* THIS SUBROUTINE OUTPUTS THE FIELD AGAIN AFTER REPLACING THE IN610 03890C* RIGHT BRACKET. IN610 03900C* IN610 03910C********************************************************************IN610 03920CSR CONFRM BEGSR IN610 03930CSR MOVE BUFFER FERBUF 72 IN610 0003940CSR MOVELXYPOS BUFFER IN610 03950CSR EXSR POSCUR IN610 03960CSR BLNGTH ADD 1 BLNGTH IN610 03970CSR Z-ADD1 NCHARS 30 IN610 03980CSR Z-ADD1 SSTRT 30 IN610 03990CSR Z-ADDBLNGTH TSTRT 30 IN610 04000CSR EXIT SUBRMV IN610 0004010CSR RLABL RTBRK IN610 04020CSR RLABL SSTRT 30 IN610 04030CSR RLABL FERBUF IN610 04040CSR RLABL TSTRT 30 IN610 04050CSR RLABL NCHARS 30 IN610 04060CSR MOVELFERBUF BUFFER IN610 04070CSR MOVE 'S' TYPE IN610 0004080CSR EXSR CRTCOM IN610 04090CSR ENDSR IN610 04100C********************************************************************IN610 04110C* IN610 04120C* THIS SUBROUTINE EDITS CRT ENTRIES. IN610 04130C* IN610 04140C********************************************************************IN610 0004150CSR EDIT BEGSR IN610 04160CSRN91 GOTO TRY92 IN610 04170C* IN610 04180CSR TN LOKUPTABA TABB 61 IN610 04190CSRN61 SETON 11 IN610 04200CSR Z-ADD17 Y IN610 04210CSRN11 SETON 90 IN610 0004220CSR MOVELTABB MESS IN610 04230CSR EXSR OUTPT IN610 04240CSR SETOF 90 IN610 04250CSR GOTO EEDIT IN610 04260C* IN610 04270CSR TRY92 TAG IN610 04280C* IN610 0004290CSR PARTNO CHAINPARTMST 11 IN610 04300CSRN11N22 SETON 11 IN610 04310CSR Z-ADD18 Y IN610 04320CSRN11 SETON 90 IN610 04330CSR EXSR OUTPT IN610 04340CSR SETOF 90 IN610 04350C* IN610 0004360CSR EEDIT ENDSR IN610 04370C********************************************************************IN610 04380C* IN610 04390C* THIS SUBROUTINE IS THE DUMMY FOR CRTCOM. IN610 04400C* IN610 04410C********************************************************************IN610 04420CSR CRTCOM BEGSR IN610 0004430CSR EXITFSUBRCM IN610 04440CSR RLABL BUFFER IN610 04450CSR RLABL TYPE 1 IN610 04460CSR RLABL BLNGTH 20 IN610 04470CSR RLABL RCODE 1 IN610 04480CSR RLABL MASK 10 IN610 04490CSR RLABL DTYPE 10 IN610 0004500CSR ENDSR IN610 04510C********************************************************************IN610 04520C* IN610 04530C* THIS SUBROUTINE CLEARS THE SCREEN. IN610 04540C* IN610 04550C********************************************************************IN610 04560CSR CLRSCR BEGSR IN610 0004570CSR MOVE 'C' TYPE IN610 04580CSR EXSR CRTCOM IN610 04590CSR ENDSR IN610 04600C********************************************************************IN610 04610C* IN610 04620C* THIS SUBROUTINE POSITIONS THE CURSOR. IN610 04630C* IN610 0004640C********************************************************************IN610 04650CSR POSCUR BEGSR IN610 04660CSR MOVE 'P' TYPE IN610 04670CSR EXSR CRTCOM IN610 04680CSR ENDSR IN610 04690C********************************************************************IN610 04700C* IN610 0004710C* THIS SUBROUTINE UNPACKS THE DATA FROM THE PARAMETER IN610 04720C* ARRAY 'MSG'. IN610 04730C* IN610 04740C********************************************************************IN610 04750CSR KEEP1 BEGSR IN610 04760CSR MOVE MSG,Y WORD50 50 IN610 04770CSRN90 MOVELWORD50 MESS 50 IN610 0004780CSR MOVELMSG,Y WORD6 6 IN610 04790CSR MOVELWORD6 XYPOS 40 IN610 04800CSR XYPOS ADD Z XYPOS IN610 04810CSR MOVE WORD6 LENG 20 IN610 04820CSR ENDSR IN610 04830C********************************************************************IN610 04840C* IN610 0004850C* THIS SUBROUTINE DISPLAYS A SINGLE FIELD OR PROMPTING MESSAGE. IN610 04860C* IN610 04870C********************************************************************IN610 04880CSR OUTPT BEGSR IN610 04890CSR EXSR KEEP1 IN610 04900CSR MOVELXYPOS BUFFER IN610 04910CSR EXSR POSCUR IN610 0004920CSR MOVE LENG BLNGTH IN610 04930CSR MOVE 'S' TYPE IN610 04940CSR MOVELMESS BUFFER IN610 04950CSR EXSR CRTCOM IN610 04960CSR 65 81N90 EXSR CHGSUB IN610 04970CSR ENDSR IN610 04980C********************************************************************IN610 0004990C* THIS SUBROUTINE ACCEPTS SEQ NO IN610 05000C********************************************************************IN610 05010CSR GETSEQ BEGSR IN610 05020CSR EXSR SKIP IN610 05030CSR MOVEL'SEQ # - 'WORD 8 IN610 05040CSR Z-ADD8 OLN 20 IN610 05050CSR Z-ADD5 ILN 20 IN610 0005060CSR EXSR TYPES IN610 05070CSR Z-ADD5 VL IN610 05080CSR MOVELBUFFER VAR IN610 05090CSR EXIT SUBRAJ IN610 05100CSR RLABL VL IN610 05110CSR RLABL VAR IN610 05120CSR MOVELVAR SEQNO IN610 0005130CSR SEQNO COMP 0 20 IN610 05140CSRN20 Z-ADD1 SEQNO IN610 05150CSR EXSR SKIP IN610 05160CSR ENDSEQ ENDSR IN610 05170C********************************************************************IN610 05180C* THIS SUBROUTINE GETS TRANTMP RECORD IN610 05190C********************************************************************IN610 0005200CSR GETREC BEGSR IN610 05210CSR SEQRD TAG IN610 05220CSR EXSR TSTSEQ IN610 05230CSR 74 EXSR GETSEQ IN610 05240CSR 74 GOTO SEQRD IN610 05250CSR SEQNO CHAINTRANTMP 56 IN610 05260CSR TST COMP '<>' 49 IN610 0005270CSR 81 49 EXSR NOCHG IN610 05280CSR 81 49 GOTO SEQRD IN610 05290CSR 82N49 SEQNO ADD 1 SEQNO 50 IN610 05300CSRN49N56 82 GOTO SEQRD IN610 05310CSR 56 82 IN610 05320COR 56 81 MOVELMES,1 BUFFER IN610 05330CSR 56 82 IN610 0005340COR 56 81 MOVE 'T' TYPE IN610 05350CSR 56 82 IN610 05360COR 56 81 Z-ADD50 BLNGTH IN610 05370CSR 56 82 IN610 05380COR 56 81 EXSR CRTCOM IN610 05390CSR 56 82 IN610 05400COR 56 81 EXSR GETSEQ IN610 0005410CSR 56 82 IN610 05420COR 56 81 GOTO SEQRD IN610 05430CSR ENDSR IN610 05440C********************************************************************IN610 05450C* THIS SUBROUTINE SENDS MESSAGE AND ACCEPTS IN610 05460C********************************************************************IN610 05470CSR TYPES BEGSR IN610 0005480CSR OVER TAG IN610 05490CSR Z-ADDOLN BLNGTH IN610 05500CSR MOVELWORD BUFFER IN610 05510CSR MOVE 'S' TYPE IN610 05520CSR EXSR CRTCOM IN610 05530CSR MOVE 'A' TYPE IN610 05540CSR Z-ADDILN BLNGTH IN610 0005550CSR EXSR CRTCOM IN610 05560CSR RCODE COMP 'R' 25 IN610 05570CSR 25 EXSR SKIP IN610 05580CSR 25 GOTO OVER IN610 05590CSR RCODE COMP 'O' 25 IN610 05600CSR 25 EXSR SKIP IN610 05610CSR ENDSR IN610 0005620C********************************************************************IN610 05630C* THIS SUBROUTINE SKIPS TO THE NEXT CRT LINE IN610 05640C********************************************************************IN610 05650CSR SKIP BEGSR IN610 05660CSR Z ADD 1 Z IN610 05670CSR MOVELBUFFER NBUF 1 IN610 05680CSR MOVEL' ' BUFFER IN610 0005690CSR Z-ADD1 BLNGTH IN610 05700CSR MOVE 'T' TYPE IN610 05710CSR EXSR CRTCOM IN610 05720CSR MOVELNBUF BUFFER IN610 05730CSR ENDSR IN610 05740C********************************************************************IN610 05750C* THIS SUBROUTINE ACCEPTS BEGINNING AND ENDING LIMITS IN610 0005760C********************************************************************IN610 05770CSR ALMTS BEGSR IN610 05780CSR EXSR CLRSCR IN610 05790CSR MOVELMES,2 BUFFER IN610 05800CSR MOVE 'S' TYPE IN610 05810CSR Z-ADD50 BLNGTH IN610 05820CSR EXSR CRTCOM IN610 0005830CSR MOVE 'A' TYPE IN610 05840CSR Z-ADD5 BLNGTH IN610 05850CSR Z-ADD1 DTYPE IN610 05860CSR EXSR CRTCOM IN610 05870CSR EXSR SKIP IN610 05880CSR RCODE COMP 'R' 76 IN610 05890CSR Z-ADD5 VL IN610 0005900CSR MOVELBUFFER VAR IN610 05910CSR EXIT SUBRAJ IN610 05920CSR RLABL VL IN610 05930CSR RLABL VAR IN610 05940CSR MOVELVAR BUFFER IN610 05950CSR MOVELBUFFER LOW 50 IN610 05960CSR MOVELMES,3 BUFFER IN610 0005970CSR MOVE 'S' TYPE IN610 05980CSR Z-ADD50 BLNGTH IN610 05990CSR EXSR CRTCOM IN610 06000CSR MOVE 'A' TYPE IN610 06010CSR Z-ADD5 BLNGTH IN610 06020CSR Z-ADD1 DTYPE IN610 06030CSR EXSR CRTCOM IN610 0006040CSR RCODE COMP 'R' 77 IN610 06050CSR Z-ADD5 VL IN610 06060CSR MOVELBUFFER VAR IN610 06070CSR EXIT SUBRAJ IN610 06080CSR RLABL VL IN610 06090CSR RLABL VAR IN610 06100CSR MOVELVAR BUFFER IN610 0006110CSR MOVELBUFFER HIGH 50 IN610 06120CSR MOVE 'C' TYPE IN610 06130CSR EXSR CRTCOM IN610 06140CSR 76 IN610 06150COR 77 GOTO ALMTS IN610 06160CSR Z-ADD0 DTYPE IN610 06170CSR ENDSR IN610 0006180C********************************************************************IN610 06190C* THIS SUBROUTINE VERIFIES THAT RECORD IS WITHIN LIMITS IN610 06200C********************************************************************IN610 06210CSR TSTSEQ BEGSR IN610 06220CSR SETOF 747677 IN610 06230CSR SEQNO COMP LOW 787678 IN610 06240CSR 78 SEQNO COMP HIGH 777878 IN610 0006250CSR 78 GOTO ENDTST IN610 06260CSR 82 76 MOVE MES,4 BUFFER IN610 06270CSR 82 77 MOVE MES,5 BUFFER IN610 06280CSRN82 MOVELMES,6 BUFFER IN610 06290CSRN82 SETON 74 IN610 06300CSR MOVE 'T' TYPE IN610 06310CSR Z-ADD50 BLNGTH IN610 0006320CSR EXSR CRTCOM IN610 06330CSR 82 77 MOVE 'F' TYPE IN610 06340CSR 82 77 EXSR CRTCOM IN610 06350CSR ENDTST ENDSR IN610 06360C********************************************************************IN610 06370C* THIS SUBROUTINE PUTS OUT EXISTING FIELDS IN610 06380CSR CHGSUB BEGSR IN610 0006390CSR XYPOS ADD 100 PXYPOS 40 IN610 06400CSR MOVELPXYPOS BUFFER IN610 06410CSR EXSR POSCUR IN610 06420CSR Y COMP 8 66 IN610 06430CSR 66 MOVELTN BUFFER DISPLAY IN610 06440CSR 66 Z-ADD2 BLNGTH EXISTING IN610 06450CSR 66 GOTO ENDCHG TRAN NO IN610 0006460CSR Y COMP 9 66 DISPLAY IN610 06470CSR 66 MOVELPARTNO BUFFER PART NO IN610 06480CSR 66 Z-ADD20 BLNGTH IN610 06490CSR 66 GOTO ENDCHG IN610 06500CSR Y COMP 10 66 IN610 06510CSR 66 MOVELBLIND BUFFER QTY IN610 06520CSR 66 Z-ADD7 BLNGTH IN610 0006530CSR 66 GOTO ENDCHG IN610 06540CSR Y COMP 11 66 IN610 06550CSRN66 GOTO ENDCHG IN610 06560CSR MOVELREFNUM BUFFER IN610 06570CSR 28 MOVELOVCOST BUFFER IN610 06580CSR Z-ADD7 BLNGTH IN610 06590CSR ENDCHG TAG IN610 0006600CSR MOVE 'S' TYPE IN610 06610CSR EXSR CRTCOM IN610 06620CSR Y COMP 9 66 IN610 06630CSR 66 PARTNO CHAINPARTMST 11 IN610 06640CSR 66N11 MOVELDESCRP MESS IN610 06650CSR 66 SETON 90 IN610 06660CSR 66 Z-ADD18 Y IN610 0006670CSR 66 EXSR OUTPT IN610 06680CSR 66 Z-ADD9 Y IN610 06690CSR 66 SETOF 90 IN610 06700CSR ENDSR IN610 06710CSR NOCHG BEGSR IN610 06720CSR MOVELMES,7 BUFFER IN610 06730CSR Z-ADD50 BLNGTH IN610 0006740CSR MOVE 'T' TYPE IN610 06750CSR EXSR CRTCOM IN610 06760CSR EXSR GETSEQ IN610 06770CSR ENDSR IN610 06780C*************************************************************************+06790C* 06800C*THIS SUBROUTINE UPDATRES THE AVERAGE MATERIAL COST/UNIT. 0006810C* 06820C**************************************************************************06830CSR CALC1 BEGSR 06840CSR 21 Z-ADDSTDCST OVCOST 06850CSR Z-ADDSV2 SOTT 70 06860CSR SV1 MULT SOH A 100 06870CSR BLIND MULT OVCOST B 100 0006880CSR A ADD B A 06890CSR SOH ADD BLIND B 06900CSR A DIV B SV1 H 06910CSR ENDSR 06920C************************************************************************* 06930C* 06940C* THIS SUBROUTINE UPDATES: 1. STOCK-ON-HAND 0006950C* 2. STOCK-ON-ORDER 06960C* 3. ALLOCATION 06970C* 4. MTD USAGE 06980C* 5. AVERAGE USAGE 06990C* 6. YTD USAGE 07000C* 07010C************************************************************************* 0007020CSR CALC2 BEGSR 07030CSR X COMP 1 70STOCK-ON-HAND 07040CSR X COMP 2 71STOCK-ON-ORDER 07050CSR X COMP 3 72ALLOCATE 07060CSR X COMP 4 83MTD USAGE 07070CSR X COMP 5 88AVERAGE USAGE 07080CSR X COMP 6 89YTD USAGE 0007090CSR Y COMP 1 84' ' 07100CSR Y COMP 2 85'+' 07110CSR Y COMP 3 86'-' 07120CSR Y COMP 4 87'R' 07130C* 07140CSR 84 GOTO ENDC2 07150CSR 70 Z-ADDSV2 WORK 70 SOH 0007160CSR 71 Z-ADDSV3 WORK SOO 07170CSR 72 Z-ADDSV4 WORK ALLOCA 07180CSR 83 Z-ADDSV5 WORK MTD USAGE 07190CSR 88 Z-ADDSV6 WORK AVGUSE 07200CSR 89 Z-ADDSV7 WORK YTD USAGE 07210C* 07220CSR 85 WORK ADD BLIND WORK FLD + QTY = FLD 0007230CSR 86 WORK SUB BLIND WORK FLD - QTY = FLD 07240CSR 87 Z-ADDBLIND WORK QTY INTO FLD 07250C* 07260CSR 70 Z-ADDWORK SV2 SOH 07270CSR 71 Z-ADDWORK SV3 SOO 07280CSR 72 Z-ADDWORK SV4 ALLOCA 07290CSR 83 Z-ADDWORK SV5 MTD USAGE 0007300CSR 88 Z-ADDWORK SV6 AVGUSE 07310CSR 89 Z-ADDWORK SV7 YTD USAGE 07320C* 07330CSR ENDC2 ENDSR 07340OPARTMST E 02N20 07350O SV1 B 88 07360O SV2 B 152 0007370O SV3 B 159 07380O SV4 B 173 07390O SV5 B 202 07400O SV6 B 209 07410O SV7 B 218 07420OTRANTMP E 02N56N20 07425O 2 ' ' 0007430O PARTNO 61 07440O TN 14 07450O BLIND 21 07460O REFNUM 28 07470O 55 OVCOST 41 ** 07480ALTSEQ 40205A217F227B235B246C255C267D274D285D295C2A4E2B6B2C602D4B2E612F 0749000ALTSEQ F030F131F232F333F434F535F636F737F838F9397A3A5E3B4C3C4A5BD05D7E3D 07500ALTSEQ 6E3E6F3F7C40C141C242C343C545C646C747C848C949D14AD24BD34CD44DC444 07510ALTSEQ D54ED64FD750D851D952E253E354E455E556E657E758E859E95A5F5C4F5E6D5F 07520** 00753010NEW SO 00754012DELETE SO 00755014INVOICE 0075600016CR MEMO 00757018MANUAL INV 00758020DRECT BILL 00759040NEW PO 00760042RPL PO QTY 00761043RPL PO REC 00762044PO RECEIPT 0076300045DELETE PO 00764060OPEN WO 00765061WO COMPT 00766062RLSE WO 00767063MTL ISSUE 00768064CHG WO QTY 00769065MAT JOB QT 0077000066DLT OPN WO 00771067DEC RS DLT 00772068CL WO SHRT 00773070ADJ STK RQ 00775072COM PRD #1 00776073COM PRD #2 00777080ADJ ALLOC 0077800082ADJUST SOO 00779084REPLCE SOO 00780086ADJUST SOH 00781088REPLCE SOH 00782090ADJ AVGUSE 00783092RPL AVGUSE 00784093ADJ MTDUSE 0078500094RPL MTDUSE 00786095ADJ YTDUSE 00787096RPL YTDUSE 007880** 007890250122INVENTORY TRANSACTIONS 007900020304TRAN 007910070304TYPE 00792000190306PART # 007930330311 07940600308QUANTITY 007950700309REF#/COST 007960020504[ ] 007970180522[ ] 007980590510[ ] 00799000700509[ ] 008000030502 008010190520 008020600508 008030710507 008040710507 008050070510**INVALID 00806000420516**INVALID PART # 008070** 008080RECORD NOT IN FILE 008090ENTER BEGINNING RRN 008100ENTER ENDING RRN 008110SEQNO TOO LOW 008120RUN EDIT PROG-FILE FULL 00813000SEQNO NOT IN LIMITS 008140RECORD HAS NO DATA-USE MODE A TO ADD 008150** 00816010 + 00817012 - 00818014- -+ 00819016- + 0082000018- + 00821020- + 00822040 + 00823042 + 00824043+- 00825044+- 00826045 - 0082700060 + 00828061 + 00829062- -+ 00830063- + 00831064 + 00832065 + 00833066 - 0083400067 - 00835068 - 00836070- + 00838072+- 00839073 - 00840080 + 00841082 + 0084200084 R 00843086+ 00844088R 00845090 + 00846092 R 00847093 + 00848094 R 0084900095 + 00850096 R 008510** 008520 +-R 008530** 00854043 00855044 00856000/* 008570_ 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 __ 0