|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 33248 (0x81e0)
Notes: pts_type(SC)
Names: »REMTR.SC«
└─⟦75255755f⟧ Bits:30009693 Philips computer tape "600410"
└─⟦this⟧ »NJREMIT/REMTR.SC«
└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
└─⟦this⟧ »REMIT2/REMTR.SC«
IDENT REMTR DDUM KMD08 PDIV ENTRY TRREAD ENTRY TRRMV ENTRY TRINIT ENTRY TRINS ENTRY TRGET ENTRY TRGETF ENTRY BDTPRT ENTRY BDTSCA ENTRY BDTDEL EXT RAREAD EXT RAWRIT EXT SPERR EXT CHDATO EXT XCOP EXT VARRD EXT VARWRT EXT WCHUPD EXT IDXGET EXT LEVRD EXT GETNXT EXT KFREAD EXT KFWRIT EXT NEWLIN EXT GENWRF EXT BSAMPR EXT BCHKPR EXT BGIRPR EXT SPLIN8 EXT CLEAR8 EXT PRTADJ EXT KBTEST EXT TXTRD EXT STREDT EXT WAITF EJECT BDTSCA PROC * * THE PROCEDURE SCANS LEV - VAR.INFO - TRANS * IN ORDER TO BUILD UP A PRINTLEV * OR WRITE ADVISLIST * * LEV 01 : BFO 1,6 * LEV 02 : BFO 2,7 * LEV 03 : BFO 3,8 * LEV 04 : BFO 4,9 * LEV 10 : FREE LIST * LEV 11 : SPECIFICATIONS LEV 01 * LEV 12 : SPECIFICATIONS LEV 02 * LEV 13 : SPECIFICATIONS LEV 03 * LEV 14 : SPECIFICATIONS LEV 04 * TRANSACTIONS ARE MOVED TO LEV 11/12/13/14 IF ANY * CREDIT AMOUNT OCCURS * P = 1 : BUILD PRINTLEV * P = 2 : ADVISLISTE ONLY * PERF CLEAR8 TBF CADVIS,BDTS05 PERF BSAMPR,CBIN0 BDTS05 PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 BOK BDTS08 FOUND BDTS10 PERF KBTEST MAK ? BOK BDTS90 PERF GETNXT READ NEXT VALID LEV BNOK BDTS80 BDTS08 MOVE GTWBCD2,GTLEVNR PERF SPLIN8,CBIN10,CBIN3 PERF VARRD BNOK BDTS95 CBE GTTRKEY,CBIN0,BDTS10 NOTHING TO DECLARE PERF LEVRD READ STAMINFO BNOK BDTS95 CBL GTPRTFRA,=D'1',BDTS11 FOR ALL BFO CBE GTLEVBFO,GTPRTFRA,BDTS11 SUB GTLEVBFO,=D'5' CBNE GTLEVBFO,GTPRTFRA,BDTS10 BDTS11 * CHECK MIN VALOER DATO MOVE GSWBCD6,GTREGF(CBIN13) GET MIN VALOER DATO CBNL GSWBCD6,=D'800000',BDTS112 PERF CHDATO MOVE GTREGF(CBIN13),GSWBCD7 BDTS112 CBG GTREGF(CBIN13),GTPRTDAT,BDTS10 NOT TO BE PAID YET * INITIATE READING TRANS MOVE GTBSUM1,=D'0' TOTAL VALUE TO BE PAID MOVE GSWBIN9,CBIN0 NO OF TRANS TO BE PAID MOVE GSWBIN6,GTTRKEY SET POINTER TO TRANS CLEAR CKRESP FLAG FOR KREDIT CLEAR CSPECFLG FLAG FOR >3 TRANS BDTS114 CLEAR GTSWFLAG PERF TRREAD,GSWBIN6 READ TRANS BNOK BDTS95 CBG GTDUPF(CBIN7),GTPRTDAT,BDTS116 NOT PAY YET CBNL GTDUPF(CBIN4),=D'0',BDTS115 CHECK AMOUNT SET CKRESP KREDIT AMOUNT BDTS115 ADD GTBSUM1,GTDUPF(CBIN4) ADD AMOUNT ADD GSWBIN9,CBIN1 ADD COUNT BDTS116 MOVE GSWBIN6,GTDUPF(CBIN22) POINTER TO NEXT TRANS CBNE GSWBIN6,CBIN0,BDTS114 READ NEXT TRANS * NO MORE TRANS CBL GSWBIN9,CBIN1,BDTS10 TO NEXT LEV, NO TRANS TBT C821FLG,BDTS117 HJORRING ? CBL GSWBIN9,CBIN4,BDTS117 SET CSPECFLG >3 TRANS BDTS117 CBL GTBSUM1,=D'1',BDTS12 AMOUNT<=0, ONLY SPEC. TBF CSPECFLG,BDTS15 NO SPEC, IF <3 TRANS TBT CKRESP,BDTS12 SPEC IF KREDIT * >3, ALWAYS SPEC IF CSPEC=T CLEAR CSPECFLG CBNE GTLEVBFO,=D'1',BDTS15 NO SPEC IF NOT CHECK TBF CSPEC,BDTS15 NO SPEC IF NO KRE BDTS12 CREDIT SET CSPECFLG SPECIFICATION TBT CADVIS,BDTS20 IF ADVIS * IF CREDIT AMOUNTS, AN EXTRA TRANS MUST BE INSERTED * ON PRINTLEV, WITH THE TOTAL AMOUNT (IF >0). * IF AMOUNT IS <= 0 NOTHING IS DONE MOVE GTDUPF(CBIN4),GTBSUM1 TOTAL AMOUNT CBL GTBSUM1,=D'1',BDTS15 ONLY SPECIFICATION MOVE GTDUPF(CBIN2),GTLEVNR MOVE GTDUPF(CBIN7),GTDATO MOVE GTDUPF(CBIN15),=D'9' TEKST NR 9 MOVE GTDUPF(CBIN18),GTPRTDAT MOVE GTTXTTKO,=D'4' TEXT CODE MOVE GTDUPF(CBIN6),GTDATO REGNSKABSAAR MOVE GTDUPF(CBIN1),=D'0' MOVE GTKFVAL,GTLEVNR SAVE GTLEVNR PERF TRGETF,GSWBIN8 GET A FREE RECORD BNOK BDTS95 MOVE GTLEVNR,GTLEVBFO SET PRINT LEV CLEAR GTSWFLAG CBL GTLEVALT,=D'1',BDTS13 MOVE GTDUPF(CBIN2),GTLEVALT BDTS13 PERF VARRD BNOK BDTS95 PERF TRINS,GSWBIN8 BNOK BDTS95 MOVE GTLEVNR,GTKFVAL RESTORE LEV PERF VARRD REREAD LEV BNOK BDTS95 BDTS15 * SET PRINTLEV NO IN GTLEVPNR (SAME FOR ALL TRANS) MOVE GTLEVPNR,GTLEVBFO CBNG GTLEVPNR,=D'5',BDTS205 SUB GTLEVPNR,=D'5' BDTS205 TBF CSPECFLG,BDTS208 ADD GTLEVPNR,=D'10' SPECIFICATION LEV BDTS208 * BDTS20 MOVE GTBSUM1,=D'999999' MOVE GTKFVAL,=D'0' MOVE GSWBIN9,CBIN0 MOVE GSWBIN6,GTTRKEY MOVE GSWBIN7,CBIN0 BDTS21 CLEAR GTSWFLAG PERF TRREAD,GSWBIN6 READ TRANS BNOK BDTS95 TBT CADVIS,BDTS40 CBG GTDUPF(CBIN7),GTPRTDAT,BDTS70 NOT TO BE PAID; NEXT BDTS30 PERF TRRMV * NOW GSWBIN3 POINTS TO NEXT RECORD BNOK BDTS95 * NOW WE HAVE A TRANS TO BE INSERTED * INTO THE PRINTLEV PERF BDTBOG BNOK BDTS95 MOVE GTKFVAL,GTLEVNR SAVE OLD GTLEVNR MOVE GTLEVNR,GTLEVPNR CLEAR GTSWFLAG CBL GTLEVALT,=D'1',BDTS34 MOVE GTDUPF(CBIN2),GTLEVALT TO BE PAID TO SOMEONE ELSE BDTS34 PERF VARRD READ PRINTLEV BNOK BDTS95 PERF TRINS,GSWBIN6 INSERT ON PRINTLEV BNOK BDTS95 MOVE GTLEVNR,GTKFVAL REREAD OLD LEV PERF VARRD BNOK BDTS95 MOVE GSWBIN6,GSWBIN3 SET POINTER TO NEXT B BDTS60 BDTS40 * CBG GTDUPF(CBIN7),GTPRTDAT,BDTS55 NOT TO BE PAID; NEXT BDTS45 ADD GSWBIN9,CBIN1 MOVE GSWBCD5,GSWBIN9 PERF BSAMPR,GSWBIN9 CBL GSWBIN9,CBIN3,BDTS55 MOVE GSWBIN9,CBIN0 B BDTS55 * BDTS50 MOVE GSWBIN7,GSWBIN6 SET PREVIOUS RECORD NO BDTS55 MOVE GSWBIN6,GTDUPF(CBIN22) POINT TO NEXT TRANS BDTS60 CBNE GSWBIN6,CBIN0,BDTS21 IF ANY TBT CADVIS,BDTS65 ADVISLISTE ? CBNE GTBSUM1,=D'999999',BDTS61 MOVE GTBSUM1,=D'0' BDTS61 MOVE GTREGF(CBIN13),GTBSUM1 PERF VARWRT BNOK BDTS95 MOVE GTBSUM1,=D'999999' B BDTS10 CONTINUE BDTS65 MOVE GSWBCD5,GSWBIN9 IB GSWBIN9,BDTS66,BDTS67,BDTS67 B BDTS68 BDTS66 MOVE GSWBCD5,=D'2' MAKE SURE A LINE IS PRINTED BDTS67 PERF BSAMPR,CBIN4 BDTS68 CLEAR CSWFLAG B BDTS10 BDTS70 CBNG GTBSUM1,GTDUPF(CBIN7),BDTS50 LOWER VALORDATO? MOVE GTBSUM1,GTDUPF(CBIN7) B BDTS50 BDTS80 TBF CADVIS,BDTS90 PERF BSAMPR,CBIN5 BDTS90 PERF CLEAR8 CMP CBIN0,CBIN0 RET BDTS95 PERF CLEAR8 CMP CBIN0,CBIN1 RET PEND EJECT BDTPRT PROC P * THE PROCEDURE LISTS ALL TRANSES CONNECTED * TO THE SPEC. LEVNR IN <GTLEVNR> * P = 1: CHECK/GIRO * P = 2: BUNDTLISTE * P = 3: KREDIT SPECIFICATION MOVE GSWBIN1,P IB GSWBIN1,BDTP10,BDTP20,BDTP30 BDTP10 MOVE GSWBIN1,GTPRTTIL IB GSWBIN1,BDTP40,BDTP60 USE BFO AS INDEX B BDTP90 * BDTP20 PERF BSAMPR,CBIN0 PRINT HEADER PERF VARRD BNOK BDTP95 MOVE GSWBCD5,=D'1' MOVE GSWBIN8,GTTRKEY CMP GSWBIN8,CBIN0 BE BDTP90 NO TRANSACTIONS BDTP21 PERF KBTEST <MAK> PRESSED ? BOK BDTP90 YES, OUT OF ROUTINE CLEAR GTSWFLAG PERF TRREAD,GSWBIN8 BNOK BDTP95 CBE GTLEVNR,GTDUPF(CBIN2),BDTP25 CBL GTLEVNR,=D'19',BDTP23 PERF BSAMPR,CBIN4 BDTP23 MOVE GTLEVNR,GTDUPF(CBIN2) PERF LEVRD BOK BDTP24 PERF SETLEV BDTP24 MOVE GSWBCD5,=D'1' BDTP25 MOVE GSWBIN4,GSWBCD5 PERF BSAMPR,GSWBIN4 PRINT NEXT INFO ADD GSWBCD5,=D'1' CBL GSWBCD5,=D'4',BDTP27 LINE FILLED UP ? MOVE GSWBCD5,=D'1' BDTP27 MOVE GSWBIN8,GTDUPF(CBIN22) CBE GSWBIN8,CBIN0,BDTP29 B BDTP21 BDTP29 PERF BSAMPR,CBIN4 WRITE LAST LINE PERF BSAMPR,CBIN5 WRITE TOTAL B BDTP90 * * BDTP30 KREDIT SPECIFICATION PERF VARRD READ PRINTLEV BNOK BDTP95 MOVE GSWBIN8,GTTRKEY CMP GSWBIN8,CBIN0 BE BDTP90 NO TRANSACTIONS * BDTP31 PERF KBTEST <MAK> PRESSED? BOK BDTP90 YES, OUT OF ROUTINE CLEAR GTSWFLAG PERF TRREAD,GSWBIN8 READ TRANSACTION BNOK BDTP95 CBE GTLEVNR,GTDUPF(CBIN2),BDTP36 SAME LEV? CBL GTLEVNR,=D'19',BDTP325 FIRST TIME? BDTP320 WRITE TOTAL SET CSWFLAG PERF NEWLIN,CBIN1 MOVE GSWBCD4,GSWBIN10 PERF GENWRF,GTHCDEV,FBDTSLUT WRITE TOTAL ADD GSWBIN3,CBIN2 PERF NEWLIN,GSWBIN3 CMP GSWBIN8,CBIN0 FINISHED? BE BDTP90 YES * BDTP325 * NULSTIL COUNTERS, SET PAGE MOVE GTBSUM3,=D'0' TOTAL MOVE GSWBIN10,CBIN0 * BDTP33 WRITE HEADING MOVE GTKFVAL,GTDUPF(CBIN2) SAVE LEV NO MOVE GTLEVNR,GTPRTTIL SET PRINTLEV ADD GTLEVNR,=D'10' KREDIT SPECIFICATION PERF LEVRD BOK BDTP34 PERF SETLEV BDTP34 PERF GENWRF,GTHCDEV,FRMTNVN WRITE NAME MOVE GTLEVNR,GTKFVAL RESET LEV NO PERF LEVRD BOK BDTP35 PERF SETLEV BDTP35 ADD GSWBIN10,CBIN1 MOVE GSWBCD4,GSWBIN10 NEXT PAGE PERF GENWRF,GTHCDEV,FKRE10 WRITE LEV NO PERF GENWRF,GTHCDEV,FRMTNVN WRITE NAME PERF GENWRF,GTHCDEV,FKRE20 WRITE DATE MOVE GSWBIN3,=W'30' SET LINECOUNT B BDTP37 * BDTP36 CHEC FOR NEW PAGE CBG GSWBIN3,CBIN4,BDTP37 PERF NEWLIN,CBIN10 B BDTP33 * BDTP37 WRITE SPECIFICATION MOVE GSWBIN7,GTDUPF(CBIN15) TEXT NR PERF TXTRD,GSWBIN7 PERF STREDT PERF GENWRF,GTHCDEV,FRMSPE WRITE LINE SUB GSWBIN3,CBIN1 SET LINECOUNT ADD GTBSUM3,GTDUPF(CBIN4) ADD TO TOTAL * SET POINTER TO NEXT TRANSACTION MOVE GSWBIN8,GTDUPF(CBIN22) CBNE GSWBIN8,CBIN0,BDTP31 B BDTP320 * ***** * BDTP40 CHECK PRINT PERF BCHKPR,CBIN0 PERF BCHKPR,CBIN0 PERF PRTADJ BL BDTP40 BG BDTP90 PERF VARRD BNOK BDTP95 MOVE GSWBCD5,=D'1' MOVE GSWBIN8,GTTRKEY CMP GSWBIN8,CBIN0 BE BDTP90 BDTP41 PERF KBTEST BOK BDTP90 CLEAR GTSWFLAG PERF TRREAD,GSWBIN8 BNOK BDTP95 CBG GTDUPF(CBIN2),GTPRTFRA,BDTP47 CBE GTLEVNR,GTDUPF(CBIN2),BDTP45 CBL GTLEVNR,=D'19',BDTP43 CLEAR CWORK1 CLEAR CWORK1 PERF BCHKPR,CBIN4 BDTP43 MOVE GTLEVNR,GTDUPF(CBIN2) PERF LEVRD BOK BDTP44 PERF SETLEV BDTP44 MOVE GSWBCD5,=D'1' BDTP45 SET CWORK1 SET CWORK1 MOVE GSWBIN4,GSWBCD5 PERF BCHKPR,GSWBIN4 ADD GSWBCD5,=D'1' TBT C821FLG,BDTP47 CBL GSWBCD5,=D'4',BDTP47 MOVE GSWBCD5,=D'1' BDTP47 MOVE GSWBIN8,GTDUPF(CBIN22) CBE GSWBIN8,CBIN0,BDTP49 B BDTP41 BDTP49 CLEAR CWORK1 PERF BCHKPR,CBIN4 B BDTP90 * BDTP60 PERF BGIRPR,CBIN0 PERF PRTADJ BL BDTP60 BG BDTP90 PERF VARRD BNOK BDTP95 MOVE GSWBCD5,=D'1' MOVE GSWBIN8,GTTRKEY CBE GSWBIN8,CBIN0,BDTP90 BDTP61 PERF KBTEST BOK BDTP90 CLEAR GTSWFLAG PERF TRREAD,GSWBIN8 BNOK BDTP95 CBG GTDUPF(CBIN2),GTPRTFRA,BDTP67 CBE GTLEVNR,GTDUPF(CBIN2),BDTP65 CBL GTLEVNR,=D'19',BDTP64 * DEPENDING ON THE VALUE OF GSWBIN4 (W LINE) * WE HAVE TO DECIDE IF WE HAVE TO SHIFT TO THE RIGHT * HALF OF THE GIROFORM, OR START ON A NEW ONE MOVE GSWBIN4,GSWBCD5 IB GSWBIN4, C BDTP64,BDTP62,BDTP62,BDTP62,BDTP63,BDTP63 BDTP62 MOVE GSWBCD5,=D'4' START ON RIGHT HALF B BDTP650 BDTP63 PERF BGIRPR,CBIN7 PRINT AND START ON NEW FORM BDTP64 MOVE GSWBCD5,=D'1' BDTP650 MOVE GTLEVNR,GTDUPF(CBIN2) PERF LEVRD BOK BDTP65 PERF SETLEV BDTP65 MOVE GSWBIN4,GSWBCD5 PERF BGIRPR,GSWBIN4 ADD GSWBCD5,=D'1' CBL GSWBCD5,=D'7',BDTP67 MOVE GSWBCD5,=D'1' BDTP67 MOVE GSWBIN8,GTDUPF(CBIN22) CBE GSWBIN8,CBIN0,BDTP69 B BDTP61 BDTP69 CBE GSWBCD5,=D'1',BDTP90 EMPTY FORM ? PERF BGIRPR,CBIN7 PRINT LAST FORM B BDTP90 * BDTP90 CMP CBIN0,CBIN0 RET * BDTP95 CMP CBIN0,CBIN1 RET PEND EJECT BDTBOG PROC * * BOOKKEEPING OF A TRANSACTION * DURING THE MOVE FROM LEV TO PRINTLEV * ADD TO VERSUR * SUB FROM PENGE * UPDAT VAR. INFO * CBL GTDUPF(CBIN4),=D'0',BDTB30 KREDIT MOVE GSWBIN4,CBIN2 SUB GTREGF(CBIN14),GTDUPF(CBIN4) VENT DEBET B BDTB40 BDTB30 MOVE GSWBIN4,CBIN1 SUB GTREGF(CBIN15),GTDUPF(CBIN4) VENT KREDIT BDTB40 * BOGFORING MOVE GSWBIN5,GTLEVBFO CBL GSWBIN5,CBIN5,BDTB45 SUB GSWBIN5,CBIN5 ADJUST FOR BUNDT ONLY BDTB45 PERF KFREAD,CBIN3,GSWBIN4,GSWBIN5,GTKFVAL ADD GTKFVAL,GTDUPF(CBIN4) ADD TO VERSUR PERF KFWRIT,CBIN3,GSWBIN4,GSWBIN5,GTKFVAL PERF KFREAD,CBIN2,CBIN1,GSWBIN5,GTKFVAL SUB GTKFVAL,GTDUPF(CBIN4) SUB FROM PENGE PERF KFWRIT,CBIN2,CBIN1,GSWBIN5,GTKFVAL PERF VARWRT BNOK BDTB95 CMP CBIN0,CBIN0 RET BDTB95 CMP CBIN0,CBIN1 RET PEND EJECT BDTDEL PROC * * THE PROCEDURE MOVES ALL RECORDS * FROM A GIVEN PRINTLEV TO THE FREE LEV * * 1) READ PRINTLEV AR.INFO * 2) UPDATE ALL RECORDS, APART FROM LAST-IN-CHAIN * 3) READ FREE LEV VAR.INFO * 4) UPDATE LAST TRANS WITH GTTRKEY, AND REWRITE * 5) UPDATE FREE LEV WITH GTTRKEY FROM PRINTLEV * 6) UPDATE PRINTLEV WITH GTTRKEY := ZERO * 1) MOVE GTBSUM1,=D'0' MOVE GTKFVAL,GTLEVNR SAVE PRINTLEV IDENT PERF VARRD READ POINTER TO 1. TRANS BNOK BDTB095 CBE GTTRKEY,CBIN0,BDTB090 NOTHING TO DELETE MOVE GSWBIN7,GTTRKEY MOVE GSWBIN8,GTTRKEY MOVE GTLEVNR,=D'10' * 2) BDTB020 SET GTSWFLAG POINTER ONLY PERF TRREAD,GSWBIN8 READ TRANS BNOK BDTB095 ADD GTBSUM1,=D'1' MOVE GTDUPF(CBIN7),=D'0' VALORDATO MOVE GTDUPF(CBIN13),=D'0' MOVE GTDUPF(CBIN14),=D'0' MOVE GTDUPF(CBIN18),=D'0' MOVE GTDUPF(CBIN19),=D'0' MOVE GTDUPF(CBIN15),=D'0' TEXTNR MOVE GTDUPF(CBIN21),=D'0' TEXTCODE MOVE GTDUPF(CBIN4),=D'0' UDB. BELOB MOVE GTDUPF(CBIN6),=D'0' REGNSKABS]R MOVE GTDUPF(CBIN1),=D'0' REGKONTONR MOVE GTDUPF(CBIN2),=D'0' LEVNR CBL GTDUPF(CBIN22),=D'1',BDTB030 LAST IN CHAIN? CLEAR GTSWFLAG PERF TRPUT,GSWBIN8 REWRITE BNOK BDTB095 MOVE GSWBIN8,GTDUPF(CBIN22) B BDTB020 * 3) BDTB030 MOVE GTLEVNR,=D'10' PERF WAITF,CVAREXFL WAIT FOR ACCESS TO VARRD PERF VARRD READ FREE LEV BNOK BDTB085 * 4) MOVE GTDUPF(CBIN22),GTTRKEY CLEAR GTSWFLAG PERF TRPUT,GSWBIN8 REWRITE LAST TRANS; BNOK BDTB085 POINTS NOW TO 'OLD' FIRST RECORD IN FREE LEV * 5) ADD GTREGF(CBIN11),GTBSUM1 AVAIL. RECORDS MOVE GTTRKEY,GSWBIN7 POINT TO FIRST RECORD IN PERF VARWRT ORIG. PRINTLEV BNOK BDTB085 AND REWRITE * 6) MOVE GTLEVNR,GTKFVAL PERF VARRD READ PRINTLEV BNOK BDTB085 MOVE GTREGF(CBIN10),=D'0' MOVE GTREGF(CBIN11),=D'0' MOVE GTREGF(CBIN12),=D'0' MOVE GTREGF(CBIN13),=D'0' MOVE GTREGF(CBIN14),=D'0' MOVE GTREGF(CBIN15),=D'0' MOVE GTTRKEY,CBIN0 PERF VARWRT BNOK BDTB085 * CLEAR CVAREXFL B BDTB090 BDTB085 CLEAR CVAREXFL B BDTB095 * BDTB090 CMP CBIN0,CBIN0 OK B BDTB099 BDTB095 CMP CBIN0,CBIN1 BDTB099 RET PEND EJECT TRINIT PROC * * THE PROCEDURE MOVES ALL TRANSACTIONRECORDS * TO THE SPECIAL SUPPLIER CONTAINING ALL * FREE RECORDS * GTDUPF(15) CONTAINS KEY OF LAST * READABLE/WRITABLE RECORD * MOVE GTLEVNR,=D'10' PERF CLEAR8 MOVE GSWBIN8,CBIN1 MOVE GTDUPF(CBIN17),=D'0' PERF TRREAD,GSWBIN8 READ 1. TRANS BOK TRIN10 B TRIN95 TRIN10 CBNE GTWBCD1,=D'4',TRIN90 B TRIN30 TRIN20 PERF TRREAD,GSWBIN8 BOK TRIN30 CBE GTWBCD1,=D'10',TRIN25 END MEDIUM B TRIN40 CHANGE LAST POINTER TO ZERO TRIN25 MOVE GSWBIN8,GTDUPF(CBIN17) SET GTSWFLAG PERF TRREAD,GSWBIN8 BNOK TRIN95 MOVE GTDUPF(CBIN22),=D'0' PERF TRPUT,GSWBIN8 BNOK TRIN95 * UPDATE VAR.INFO TO REFLECT * 1) POINTER TO FIRST FREE RECORD (ALWAYS 1) * 2) NUMBER OF FREE RECORDS (DEPENDING ON FILE SIZE) MOVE GTLEVNR,=D'10' FREE-LIST SUPPLIER PERF VARRD READ VAR.INFO BNOK TRIN95 MOVE GTTRKEY,CBIN1 FIRST IN FREE LIST MOVE GTREGF(CBIN11),GSWBIN8 NBR OF FREE RECORDS MOVE GTREGF(CBIN12),GSWBIN8 PERF VARWRT REWRITE BNOK TRIN95 B TRIN90 * TRIN30 MOVE GTWBCD2,GSWBIN8 PERF SPLIN8,CBIN10,CBIN3 MOVE GTDUPF(CBIN2),=D'10' LEVNR MOVE GTDUPF(CBIN7),=D'0' VALORDATO MOVE GTDUPF(CBIN13),=D'0' NR-1 MOVE GTDUPF(CBIN14),=D'0' NR-2 MOVE GTDUPF(CBIN18),=D'0' DATO-1 MOVE GTDUPF(CBIN19),=D'0' DATO-2 MOVE GTDUPF(CBIN15),=D'0' TEXTNR MOVE GTDUPF(CBIN21),=D'3' TEXTCODE MOVE GTDUPF(CBIN4),=D'0' UDB. BELOB MOVE GTDUPF(CBIN6),=D'0' REGNSKABS]R MOVE GTDUPF(CBIN1),=D'0' REGKONTONR MOVE GTDUPF(CBIN22),GSWBIN8 OLD POINTER ADD GTDUPF(CBIN22),=D'1' PLUS ONE GIVES NEW POINTER CLEAR GTSWFLAG PERF TRPUT,GSWBIN8 BNOK TRIN95 MOVE GTDUPF(CBIN17),GSWBIN8 SAVE LAST USEABLE POINTER ADD GSWBIN8,CBIN1 B TRIN20 * TRIN40 READ ERROR, DROP THE RECORD(S) ADD GSWBIN8,CBIN1 CONTINUE TO READ PERF TRREAD,GSWBIN8 UNTIL NO ERROR IS FOUND BOK TRIN40A CBE GTWBCD1,=D'10',TRIN25 B TRIN40 TRIN40A MOVE GTDUPF(CBIN16),GSWBIN8 SAVE NEW RECORDNBR MOVE GSWBIN8,GTDUPF(CBIN17) TRIN41 PERF TRREAD,GSWBIN8 THE LAST USEABLE BOK TRIN43 HAS TO BE UPDATED TRIN42 SUB GSWBIN8,CBIN1 B TRIN41 ONE MORE ERROR TRIN43 MOVE GTDUPF(CBIN22),GTDUPF(CBIN16) PERF TRPUT,GSWBIN8 BNOK TRIN42 MOVE GSWBIN8,GTDUPF(CBIN16) B TRIN20 * TRIN90 PERF CLEAR8 CMP CBIN0,CBIN0 ALL OK B TRIN99 TRIN95 PERF CLEAR8 CMP CBIN0,CBIN1 TRIN99 RET PEND EJECT TRINS PROC PT * * THE PROCEDURE INSERTS A TRANSACTION INTO THE TRANSFILE * <PT> POINTS TO A FREE RECORD * 1) LEV ALREADY READ * 2) MOVE POINTER FROM LEV TO 'FREE' RECORD * 3) MOVE POINTER TO LEV * 4) WRITE 'FREE' RECORD AFTER PACKING FROM GTDUPF * 5) UPDATE LEV * 6) REWRITE LEV * * 1) * LEV READ BEFORE ENTRY * 2) MOVE GTDUPF(CBIN22),GTTRKEY * 3) MOVE GTTRKEY,PT * 4) PERF TRPUT,PT INSERT BNOK TRINS95 * 5) PERF WCHUPD * 6) CBNE GTLEVNR,=D'10',TRINS50 ADD GTREGF(CBIN11),=D'1' AVAILABLE RECORDS TRINS50 PERF VARWRT BNOK TRINS95 CMP CBIN0,CBIN0 B TRINS99 TRINS95 CMP CBIN1,CBIN0 TRINS99 RET PEND EJECT TRGETF PROC PT * THE PROCEDURE GETS A RECORD FROM THE FREE LEV. * THE POINTER IS RETURNED IN <PT> PERF WAITF,CVAREXFL MOVE GTLEVNR,=D'10' PERF VARRD BNOK TRGETF95 PERF TRGET,CBIN0,PT BNOK TRGETF95 CLEAR CVAREXFL CMP CBIN0,CBIN0 B TRGETF99 TRGETF95 CLEAR CVAREXFL CMP CBIN0,CBIN1 TRGETF99 RET PEND TRPUT PROC PT * THE PROC WRITES THE RECORD TO THE SPECIFIED RECORDNBR PERF WAITF,CTRFFLG PERF TRPACK PERF RAWRIT,DK11,=D'11',CTRBUF,PT BNOK TRPUT95 CLEAR CTRFFLG CMP CBIN0,CBIN0 B TRPUT99 TRPUT95 CLEAR CTRFFLG CMP CBIN0,CBIN1 TRPUT99 RET PEND EJECT TRREAD PROC PT * * THE PROCEDURE READS THE TRANSRECORD * WITH THE SPECIFIED RECORDNBR AND UNPACKS IT * PERF WAITF,CTRFFLG MOVE GSWBIN1,=W'39' MOVE CTRBUF,CBLANKS PERF RAREAD,DK11,=D'11',CTRBUF,GSWBIN1,PT BNOK TRREA95 PERF TRUNP CLEAR CTRFFLG CMP CBIN0,CBIN0 B TRREA99 TRREA95 CLEAR CTRFFLG CMP CBIN0,CBIN1 TRREA99 RET PEND EJECT TRRMV PROC * THE PROCEDURE REMOVES THE CURRENT RECORD FROM THE CHAIN * IN GTKFVAL A POINTER TO THE PREVIOUS RECORD MUST * BE AVAILABLE, IN ORDER TO BE ABLE TO COPY * THE POINTER FROM THE REMOVED RECORD INTO THE PREVIOUS. MOVE GSWBIN3,GTDUPF(CBIN22) CBE GSWBIN7,CBIN0,TRR10 FIRST IN CHAIN? SET GTSWFLAG MOVE GSWBIN8,GSWBIN7 PERF TRREAD,GSWBIN8 BNOK TRR95 MOVE GTDUPF(CBIN22),GSWBIN3 PERF TRPUT,GSWBIN8 BNOK TRR95 B TRR90 TRR10 MOVE GTTRKEY,GTDUPF(CBIN22) PERF VARWRT BNOK TRR95 B TRR90 TRR90 CMP CBIN0,CBIN0 B TRR99 TRR95 CMP CBIN0,CBIN1 TRR99 RET PEND EJECT TRGET PROC OLD,PT * THE PROCEDURE REMOVES THE TRANS POINTED AT * BY <OLD> FROM THE CHAIN. * IF <OLD> = 0, THE VAR.INFO POINTER IS UPDATED. SET GTSWFLAG CBE OLD,CBIN0,TRGET30 PERF TRREAD,OLD BNOK TRGET95 MOVE GSWBIN8,GTDUPF(CBIN22) MOVE THE POINTER RECENTLY READ MOVE PT,GTDUPF(CBIN22) PERF TRREAD,GSWBIN8 BNOK TRGET95 PERF TRPUT,OLD UPDATE OLD WITH <PT>'S POINTER BNOK TRGET95 B TRGET90 TRGET30 FIRST TRANS IN CHAIN MOVE GSWBIN8,GTTRKEY MOVE PT,GTTRKEY PERF TRREAD,GSWBIN8 BNOK TRGET95 MOVE GTTRKEY,GTDUPF(CBIN22) CBNE GTLEVNR,=D'10',TRGET80 SUB GTREGF(CBIN11),=D'1' AVAILABLE RECORDS MOVE GSWBCD6,GTREGF(CBIN11) MUL GSWBCD6,=D'20' CBL GTREGF(CBIN12),GSWBCD6,TRGET80 MOVE GTWBCD2,=D'11' MOVE SPBINW4,CBIN21 MOVE GTWBCD1,=D'50' MOVE GSWSTR9,='DISKFEJL ' PERF SPERR TRGET80 PERF VARWRT BNOK TRGET95 TRGET90 CMP CBIN0,CBIN0 B TRGET99 TRGET95 CMP CBIN0,CBIN1 TRGET99 RET PEND EJECT TRUNP PROC * UNPACK INFO FROM TRANS * IF GTSWFLAG IS SET, ONLY THE POINTER WILL BE * UNPACKED, TO AVOID OVERWRITING THE OLD INFO TBT GTSWFLAG,TRU070 PERF XCOP,GSWBIN1,=W'0',=W'2',CTRBUF,=W'36' MOVE GTDUPF(CBIN20),GSWBIN1 MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'0' MOVE GTDUPF(CBIN2),GSWBCD7 LEVNR MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'4',=W'3',CTRBUF,=W'5' MOVE GTDUPF(CBIN7),GSWBCD7 VALORDATO PERF XCOP,GSWBIN1,=W'0',=W'2',CTRBUF,=W'18' MOVE GTDUPF(CBIN15),GSWBIN1 TEXTNR MOVE GSWBIN1,CBIN0 PERF XCOP,GSWBIN1,=W'1',=W'1',CTRBUF,=W'20' MOVE GTDUPF(CBIN21),GSWBIN1 PERF XCOP,GSWBCD7,=W'0',=W'7',CTRBUF,=W'21' MOVE GTDUPF(CBIN4),GSWBCD7 UDB. BELOB MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'6',=W'1',CTRBUF,=W'28' MOVE GTDUPF(CBIN6),GSWBCD7 REGNSKABS]R MOVE GSWBCD7,=D'1' REGKONTONR PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'29' MOVE GTDUPF(CBIN1),GSWBCD7 MOVE GTDUPF(CBIN13),=D'0' MOVE GTDUPF(CBIN14),=D'0' MOVE GTDUPF(CBIN18),=D'0' MOVE GTDUPF(CBIN19),=D'0' MOVE GSWBCD7,=D'1' MOVE GSWBIN1,GTDUPF(CBIN21) TEXTCODE GOVERNS UNPACKING OF TEXTINFO1 AND -2 MOVE GTTXTTKO,GSWBIN1 IB GSWBIN1,TRU010,TRU020,TRU030,TRU040,TRU050,TRU060 TRU010 B TRU070 NO EXTRA INFO TRU020 NR-1 MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'8' MOVE GTDUPF(CBIN13),GSWBCD7 B TRU070 TRU030 NR-1 NR-2 MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'8' MOVE GTDUPF(CBIN13),GSWBCD7 PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'13' MOVE GTDUPF(CBIN14),GSWBCD7 B TRU070 TRU040 DATO-1 MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'8' MOVE GTDUPF(CBIN18),GSWBCD7 B TRU070 TRU050 DATO-1 DATO-2 MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'8' MOVE GTDUPF(CBIN18),GSWBCD7 PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'13' MOVE GTDUPF(CBIN19),GSWBCD7 B TRU070 TRU060 NR-1 DATO-1 MOVE GSWBCD7,=D'1' PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'8' MOVE GTDUPF(CBIN13),GSWBCD7 PERF XCOP,GSWBCD7,=W'2',=W'5',CTRBUF,=W'13' MOVE GTDUPF(CBIN18),GSWBCD7 TRU070 PERF XCOP,GSWBIN1,=W'0',=W'2',CTRBUF,=W'34' MOVE GTDUPF(CBIN22),GSWBIN1 NEXT TRANS POINTER CLEAR CTRFFLG RELEASE BUFFER RET PEND EJECT TRPACK PROC * IF GTSWFLAG IS SET, ONLY THE POINTER WILL BE MOVED, * TO AVOID OVERWRITING THE BUFFER TBT GTSWFLAG,TRP070 MOVE GSWBIN2,CBIN0 CBG GTLEVNR,=D'18',TRP005 MOVE GSWBIN2,GTLEVNR TRP005 PERF XCOP,CTRBUF,=W'36',=W'2',GSWBIN2,=W'0' MOVE GSWBCD7,GTDUPF(CBIN2) LEVNR PERF XCOP,CTRBUF,=W'0',=W'5',GSWBCD7,=W'2' MOVE GSWBCD7,GTDUPF(CBIN7) VALORDATO MOVE GSWBCD6,GSWBCD7 PERF CHDATO PERF XCOP,CTRBUF,=W'5',=W'3',GSWBCD7,=W'4' MOVE GSWBIN2,GTDUPF(CBIN15) TEXTNR PERF XCOP,CTRBUF,=W'18',=W'2',GSWBIN2,=W'0' MOVE GSWBIN2,GTTXTTKO TEXTKODE PERF XCOP,CTRBUF,=W'20',=W'1',GSWBIN2,=W'1' MOVE GSWBCD7,GTDUPF(CBIN4) UDB. BELOB PERF XCOP,CTRBUF,=W'21',=W'7',GSWBCD7,=W'0' MOVE GSWBCD7,GTDUPF(CBIN6) REGNSKABS]R PERF XCOP,CTRBUF,=W'28',=W'1',GSWBCD7,=W'6' MOVE GSWBCD7,GTDUPF(CBIN1) REGKONTONR PERF XCOP,CTRBUF,=W'29',=W'5',GSWBCD7,=W'2' MOVE GSWBIN1,GTTXTTKO IB GSWBIN1,TRP010,TRP020,TRP030,TRP040,TRP050,TRP060 B TRP070 TRP010 NO EXTRA INFO B TRP070 TRP020 NR-1 MOVE GSWBCD7,GTDUPF(CBIN13) TRP025 PERF XCOP,CTRBUF,=W'8',=W'5',GSWBCD7,=W'2' B TRP070 TRP030 NR-1 NR-2 MOVE GSWBCD7,GTDUPF(CBIN13) PERF XCOP,CTRBUF,=W'8',=W'5',GSWBCD7,=W'2' MOVE GSWBCD7,GTDUPF(CBIN14) TRP035 PERF XCOP,CTRBUF,=W'13',=W'5',GSWBCD7,=W'2' B TRP070 TRP040 DATO-1 MOVE GSWBCD7,GTDUPF(CBIN18) B TRP025 TRP050 MOVE GSWBCD7,GTDUPF(CBIN18) PERF XCOP,CTRBUF,=W'8',=W'5',GSWBCD7,=W'2' MOVE GSWBCD7,GTDUPF(CBIN19) B TRP035 TRP060 MOVE GSWBCD7,GTDUPF(CBIN13) PERF XCOP,CTRBUF,=W'8',=W'5',GSWBCD7,=W'2' MOVE GSWBCD7,GTDUPF(CBIN18) B TRP035 TRP070 MOVE GSWBIN2,GTDUPF(CBIN22) POINTER PERF XCOP,CTRBUF,=W'34',=W'2',GSWBIN2,=W'0' RET PEND EJECT SETLEV PROC * INITIATES A LEV FOR PRINT OUT MOVE GTLEVNVN,CBLANKS EDIT GSWSTR20,FSAMLEV LEV MISSING, INSERT IDENT PERF XCOP,GTLEVNVN,=W'0',=W'10',GSWSTR20,=W'0' MOVE GTLEVADR,CBLANKS MOVE GTLEVBY,CBLANKS MOVE GTLEVPDI,CBLANKS MOVE GTLEVPNR,=D'0' RET PEND FSAMLEV FRMT FMEL '9999999999',GTLEVNR FMEND EJECT * * FORMATS * FRMSPE FRMT FNL FCOPY GTLEVTXT FILLR ' ',1 FCOPY SPINPUT FILLR ' ',1 FMEL 'ZZZVZZZVZZZVZZ9E,99-',GTDUPF(CBIN4) FMEND FBDTSLUT FRMT FNL FBT CSWFLAG,FBDTSL10 GRAND TOTAL ? FNL FMEL 'ZZZZZZZVZZ9,99-',GTBSUM2 FILLR ' ',14 FCOPY ='SIDE' FCOPY ='TOTAL' FB FBDTSL99 FBDTSL10 FMEL 'ZZZZZZZVZZ9,99-',GTBSUM3 PAGETOTAL FILLR ' ',14 FCOPY ='TOTAL' FTEXT ' IALT' FMEL 'ZZ9',GSWBCD4 FTEXT ' SIDE(R)' FBDTSL99 FNL FNL FMEND * FRMTNVN FRMT FILLR '+',2 FCOPY GTLEVNVN FNL FCOPY GTLEVADR FNL FCOPY GTLEVBY FNL FMEL 'ZZZZ',GTLEVPNR FILLR ' ',2 FCOPY GTLEVPDI FMEND * * FKRE10 FRMT FNL FILLR ' ',47 FMEL 'ZZZ9999999',GTLEVNR FILLR ' ',10 FMEL 'ZZZZZZZ',GTLEVGI FNL FNL FMEND * * FKRE20 FRMT FNL FNL FNL FNL FCOPY ='SPECIFIKATION ' FTEXT 'AF FREMSENDT BEL' FILLR X'5C',1 FTEXT 'B PR. ' FBT CBDTGIR,FKREL21 FCOPY =C'CHECK' FB FKREL22 FKREL21 FCOPY =C'GIRO ' FKREL22 FILLR ' ',2 FCOPY =C'DATO' FILLR ' ',2 FMEL '99E-99E-99',GTPRTDAT FILLR ' ',5 FCOPY =C'SIDE' FMEL 'ZZZZ',GSWBCD4 FNL FNL FMEND * * END