|
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: 30344 (0x7688)
Notes: pts_type(SC)
Names: »RGKLAR.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/RGKLAR.SC«
IDENT RGKLAR 820615 NJ DDUM KMD08 PDIV ENTRY RGKLAR ENTRY CLEJ ENTRY CLEDB ENTRY CLBEH ENTRY CLKF ENTRY RGA120 ENTRY ZERO ENTRY SKIFT ENTRY STRTWR ENTRY STRTID ENTRY SLUTID ENTRY BCKUP ENTRY KLRFMT * EXT ADM EXT SOPRD EXT LAMPON EXT LAMPOF EXT WRITJT EXT SPCLRN EXT SPCLRA EXT PACKCL EXT CLEAR8 EXT SPLIN8 EXT GRASPV EXT FRMXVO EXT KORT EXT TCONFW EXT RAREAD EXT RAWRIT EXT ASGVOL EXT CLSVOL EXT WRITID EXT CNFWRT EXT RADEL EXT SETKRE EXT SETDEB EXT INITRG EXT SLUT EXT CONFWR EXT WRITFD EXT CRKJ EXT BACKUP EXT CONRDX EXT RSTORE EXT KFWRIT EXT KFREAD EXT KTPLAN EXT WAITF INCLUDE EQUATE EJECT RGKLAR SET SPPROMPT MOVE SPKEY,CBIN2 ATTFMT ADFRM01 PERF SPCLRA IB SPBINW2, C RGKLAR,RGKLAR,RGKLAR,RGKLAR,RGA100, C RGA200,RGA300,RGKLAR,RGKLAR,RGA007 B RGKLAR * RGA007 GO ONLINE TBT CCONVERT,RGKLAR PERF ADM,CBIN7 B RGKLAR * RGA100 * ******************************************************** * * OPEN ROUTINE * ******************************************************** * TBT CCONVERT,RGKLAR TBF GTTTPFLG,RGKLAR NO TTP TBT CCONVFLG,RGKLAR CLEAR GTDYFLG SET SPPROMPT SET SPME MOVE GSWBCD3,=X'FF' ERASE CBG GTDATO,=D'1',RGA105 MOVE GTDATO,=X'FF' RGA105 ATTFMT OPENFRM PERF SPCLRN IB SPBINW2,RGKLAR,RGKLAR,RGA110 B RGKLAR RGA110 MOVE TTEJEDB,=D'0' MUL TTSTLBNR,=D'-1' SET POSITIVE (OPEN) MUL CMASK(TTASKNR),=D'-1' SET CMASK >0, OPEN MOVE TTCASH,TTSTCASH CBNE TTSTLBNR,=D'0',RGA115 MOVE TTSTLBNR,=D'1' RGA115 MOVE TTLBNR,TTSTLBNR SUB TTLBNR,=D'1' MOVE TTRECOPN,CRECBCD PERF ZERO PERF TCONFW,TTASKNR STORE INF FROM ADM FUNC. PERF CONFWR PERF WRITJT,=W'5' OPEN MES ON JT SET GTKASSE ADD CTASKNR,CBIN1 RGA120 PERF INITRG START REGISTRATION PERF TCLOSE CLOSE BNOK RGA120 SUB CTASKNR,CBIN1 B RGKLAR EJECT TCLOSE PROC MOVE SPKEY,CBIN2 TCL000 SET SPPROMPT ATTFMT CLFRM01 PERF SPCLRA IB SPBINW2,TCLMAK,TCLMAK,TCL010 B TCL000 TCL010 * CLEAR FLAGS CLEAR GTSUMKEY CLEAR TTTSTFLG CLEAR TTCY1FLG CLEAR TTCY2FLG CLEAR TTLSTFLG CLEAR TTPSEFLG CLEAR TTSUMFLG CLEAR TTSUPFLG CLEAR GTCYFLG CLEAR GTSUBFLG CLEAR GTBDTFLG CLEAR GTSTRFLG CLEAR GTKORTFL MOVE TTSUPMRK,=' ' MOVE GTTEXT,=' ' MOVE GTSUM,=D'0' WAIT KVOUCH DSC0 KVOUCH,RLEAS * TR12 ACCUMULATORS MOVE GTREGNR,=D'2' MOVE GTREGDEX,CBIN2 PERF PACKCL MOVE GSWBIN1,CBIN1 TCL025 MOVE GTDUPF(GSWBIN1),=X'FF' ADD GSWBIN1,CBIN1 CBL GSWBIN1,CBINMAX,TCL025 MOVE GSWBCD5,=D'0' TCL030 ADD GSWBCD5,=D'1' ACC NR TCL035 MOVE GSWBIN5,GSWBCD5 CONVERT CBG GSWBIN5,CTR12(TTASKNR,CBIN2),TCL090 ADD GSWBIN5,CTR12(TTASKNR,CBIN1) MOVE GTDUPF(CBIN1),CTR12NR(GSWBIN5) CBE GTDUPF(CBIN1),=D'0',TCL030 MOVE GTUSED(CBIN1),CBIN5 INDICATE UPDATED MOVE GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN1) CBE GTDUPF(CBIN4),=D'0',TCL040 MOVE GTUSED(CBIN4),=W'-8' MOVE GSWSTR20,=C'EJ-EDB T[LLER ' MOVE GTWBCD1,GSWBCD5 PERF TR2GEN,CBIN1 GENERATE TR2 WITH KREDIT BNOK TCL035 TCL040 MOVE GSWBIN5,GSWBCD5 ADD GSWBIN5,CTR12(TTASKNR,CBIN1) MOVE GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN2) CBE GTDUPF(CBIN4),=D'0',TCL030 MOVE GTUSED(CBIN4),=W'-8' MOVE GSWSTR20,=C'EJ-EDB T[LLER ' MOVE GTWBCD1,GSWBCD5 PERF TR2GEN,CBIN2 GENERATE TR2 WITH DEBET BNOK TCL040 B TCL030 TCL090 MOVE GSWSTR9,=C'TOTAL ' PERF CLEJ EJ EDB MOVE TTEJEDB,=D'0' EJECT * VERSUR AND PENGEKONTI TBF CSTRKFLG,TCL150 MOVE GSWBCD5,=D'0' B TCL130 TCL110 * VERSUR MOVE GSWBIN5,GSWBCD5 PERF KFREAD,CBIN3,CBIN0,GSWBIN5,GTKFVAL KONTONR BNOK TCL130 CBE GTKFVAL,=D'0',TCL130 MOVE GTDUPF(CBIN1),GTKFVAL MOVE GTUSED(CBIN1),CBIN5 INDICATE UPDATE PERF KFREAD,CBIN3,CBIN1,GSWBIN5,GTKFVAL KREDIT BNOK TCL120 CBE GTKFVAL,=D'0',TCL120 MOVE GTDUPF(CBIN4),GTKFVAL MOVE GTUSED(CBIN4),=W'-8' MOVE GTWBCD1,GSWBCD5 BFO NR MOVE GSWSTR20,=C'VERSUR KONTO ' PERF TR2GEN,CBIN1 GENERATE TR2 DEBET BNOK TCL120 TCL120 MOVE GSWBIN5,GSWBCD5 PERF KFREAD,CBIN3,CBIN2,GSWBIN5,GTKFVAL DEBET BNOK TCL130 CBE GTKFVAL,=D'0',TCL130 MOVE GTDUPF(CBIN4),GTKFVAL MOVE GTUSED(CBIN4),=W'-8' MOVE GTWBCD1,GSWBCD5 BFONR MOVE GSWSTR20,=C'VERSUR KONTO ' PERF TR2GEN,CBIN2 GENERATE TR2 KREDIT BNOK TCL130 TCL130 * PENGE MOVE GSWBIN5,GSWBCD5 PERF KFREAD,CBIN2,CBIN0,GSWBIN5,GTKFVAL KONTONR BNOK TCL140 CBE GTKFVAL,=D'0',TCL140 MOVE GTDUPF(CBIN1),GTKFVAL MOVE GTUSED(CBIN1),CBIN5 INDICATE UPDATE PERF KFREAD,CBIN2,CBIN1,GSWBIN5,GTKFVAL BEV BNOK TCL140 CBE GTKFVAL,=D'0',TCL140 MOVE GTDUPF(CBIN4),GTKFVAL MOVE GTUSED(CBIN4),=W'-8' MOVE GTWBCD1,GSWBCD5 BFONR MOVE GSWSTR20,=C'PENGE KONTO ' PERF TR2GEN,CBIN0 GENERATE TR 2 BNOK TCL140 TCL140 ADD GSWBCD5,=D'1' CBL GSWBCD5,=D'5',TCL110 TCL150 EJECT * VERSUR - KASSE TCL205 SET GTTFLG CBE TVERSUR,=D'0',TCL235 MOVE GTDUPF(CBIN1),TVERSUR REMIT ACC MOVE GTDUPF(CBIN4),TTACC(CBIN6,CBIN1) ADD GTDUPF(CBIN4),TTACC(CBIN6,CBIN2) CBE GTDUPF(CBIN4),=D'0',TCL235 MOVE GTUSED(CBIN1),CBIN5 MOVE GTUSED(CBIN4),=W'-8' MUL GTDUPF(CBIN4),=D'-1' MOVE GSWSTR20,=C'VERSUR KONTONR REMIT ' MOVE GTWBCD1,=D'0' PERF TR2GEN,CBIN0 BNOK TCL205 TCL235 CASH MOVEMENT MOVE GTDUPF(CBIN1),TTCASHAC ACCOUNTNR MOVE GTDUPF(CBIN4),TTCASH CURRENT CASH SUB GTDUPF(CBIN4),TTSTCASH INITIAL CASH MOVE GTUSED(CBIN1),CBIN5 MOVE GTUSED(CBIN4),=W'-8' MOVE GSWSTR20,=C'KASSE-KONTO ' MOVE GTWBCD1,=D'0' PERF TR2GEN,CBIN0 BNOK TCL235 * * WRITING OF DISC JOURNAL AND VOUCHER * MOVE GSWSTR9,=C'TOTAL ' PERF CLEDB * PRINT KONTOFILE MOVE GSWSTR9,=C'TOTAL ' PERF CLKF * * BEHOLDNINGST[LLERE * PERF CLBEH * MOVE TTSTCASH,TTCASH MOVE TTSTLBNR,TTLBNR ADD TTSTLBNR,=D'1' MUL TTSTLBNR,=D'-1' SET NEGATIVE (CLOSE) MUL CMASK(TTASKNR),=D'-1' SET CMASK < 0, CLOSE CLEAR GTTFLG TCL550 MOVE TTRECOPN,CRECBCD PERF ZERO PERF TCONFW,TTASKNR STORE NEW INITIAL VALUES PERF CONFWR BNOK TCL550 CLEAR GTKASSE * ZERONIZE COUNTERS * TRANS 12 COUNTERS MOVE GSWSTR20,=C'*' PERF WRITJT,=W'12' CMP CBIN0,CBIN0 DUMMY RET TCLMAK CMP CBIN0,CBIN1 RET PEND EJECT RGA200 ************************************************ * * PERFORM OF SELECTED ADM ROUTINE * ************************************************* * MOVE GSWBIN1,GSWBCD3 PERF ADM,GSWBIN1 B RGKLAR EJECT ZERO PROC * * ZERONIZE COUNTERS * TRANS 12 COUNTERS MOVE GSWBIN3,CTR12(TTASKNR,CBIN1) MOVE GSWBIN2,GSWBIN3 ADD GSWBIN2,CTR12(TTASKNR,CBIN2) TCL610 ADD GSWBIN3,CBIN1 CBG GSWBIN3,GSWBIN2,TCL615 MOVE C12ACC(GSWBIN3,CBIN1),=D'0' MOVE C12ACC(GSWBIN3,CBIN2),=D'0' MOVE GTKFVAL,=D'0' PERF KFWRIT,CBIN1,CBIN1,GSWBIN3,GTKFVAL PERF KFWRIT,CBIN1,CBIN2,GSWBIN3,GTKFVAL B TCL610 TCL615 * ACCUMULATORS MOVE GSWBIN1,CBIN0 TCL620 ADD GSWBIN1,CBIN1 MOVE TTACC(GSWBIN1,CBIN1),=D'0' MOVE TTACC(GSWBIN1,CBIN2),=D'0' CBL GSWBIN1,CBIN8,TCL620 RET PEND EJECT CLEJ PROC ***************************************************** * * NOW ALL ACCUMULATORS NOT = 0 * HAS BEEN REGISTRATED * A VOUCHER PRINT OF ALL TR12 ACC * IS NOW PERFORMED ** ******************************************************** MOVE TTLINNR,=D'25' MOVE GSWSTR20,='EJ-EDB T[LLER ' CBE CTR12(TTASKNR,CBIN2),CBIN0,CLEJRET PERF WAHEAD,CBIN8 MOVE GTWBCD1,=D'0' CLEJ10 ADD GTWBCD1,=D'1' MOVE GSWBIN5,GTWBCD1 CONVERT CBG GSWBIN5,CTR12(TTASKNR,CBIN2),CLEJ90 ADD GSWBIN5,CTR12(TTASKNR,CBIN1) MOVE GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN1) ADD GTDUPF(CBIN4),C12ACC(GSWBIN5,CBIN2) MOVE GTDUPF(CBIN1),CTR12NR(GSWBIN5) CBE GTDUPF(CBIN1),=D'0',CLEJ10 CBG TTLINNR,=D'0',CLEJ20 DSC0 KVOUCH,RLEAS MOVE TTLINNR,=D'25' PERF WAHEAD,CBIN8 CLEJ20 PERF WALINE,CBIN9 B CLEJ10 CLEJ90 DSC0 KVOUCH,RLEAS CLEJRET RET PEND EJECT CLKF PROC ********************* * CLOSE KONTOFILE * UDSKRIV OG NULSTIL VERSUR OG PENGEKONTI ********************* TBF CREMITFL,CLKFRET MOVE GSWSTR20,=C'LOKAL REMITTERING ' CLEAR GTDYFLG CLEAR GTSWFLAG PERF WAHEAD,CBIN8 MOVE GSWBCD5,=D'0' LOOP ON BFO MOVE GTREGF(CBIN1),=D'0' TOTAL KREDIT-VERSUR MOVE GTREGF(CBIN2),=D'0' TOTAL DEBET - VERSUR MOVE GTREGF(CBIN3),=D'0' TOTAL BEV-PENGE B CLKF100 CLKF010 MOVE GSWBIN5,GSWBCD5 BFO NR PERF KFREAD,CBIN3,CBIN0,GSWBIN5,GTKFVAL KONTONR MOVE GTDUPF(CBIN1),GTKFVAL PERF KFREAD,CBIN3,CBIN1,GSWBIN5,GTKFVAL KREDIT MOVE GTDUPF(CBIN6),GTKFVAL PUT INTO KREDIT ADD GTREGF(CBIN2),GTKFVAL ADD TO TOTAL PERF KFREAD,CBIN3,CBIN2,GSWBIN5,GTKFVAL DEBET MOVE GTDUPF(CBIN5),GTKFVAL PUT INTO DEBET ADD GTREGF(CBIN1),GTKFVAL ADD TO TOTAL MOVE GTWBCD1,GSWBCD5 MOVE GSWBIN5,GSWBCD5 SET GTSWFLAG PERF WALINE,CBIN20 CLKF100 PENGE MOVE GSWBIN5,GSWBCD5 PERF KFREAD,CBIN2,CBIN0,GSWBIN5,GTKFVAL KONTONR MOVE GTDUPF(CBIN1),GTKFVAL PERF KFREAD,CBIN2,CBIN1,GSWBIN5,GTKFVAL BEV ADD GTREGF(CBIN3),GTKFVAL ADD TO TOTAL MOVE GTDUPF(CBIN4),GTKFVAL CLEAR GTSWFLAG MOVE GTWBCD1,GSWBCD5 MOVE GSWBIN5,GSWBCD5 PERF WALINE,CBIN20 ADD GSWBCD5,=D'1' CBL GSWBCD5,=D'5',CLKF010 * WRITE TOTAL MOVE GTDUPF(CBIN1),=X'FF' CLEAR KONTONR MOVE GTWBCD1,=X'FF' CLEAR BFUND MOVE GTDUPF(CBIN4),GTREGF(CBIN3) TOTAL BEV MOVE GTDUPF(CBIN5),GTREGF(CBIN1) KREDIT MOVE GTDUPF(CBIN6),GTREGF(CBIN2) DEBET SET GTDYFLG SET GTSWFLAG PERF WALINE,CBIN20 VERSUR CLEAR GTDYFLG CLEAR GTSWFLAG PERF WALINE,CBIN20 BEV DSC0 KVOUCH,RLEAS TBT GTSPGFLG,CLKFRET * NULSTIL VERSUR + PENGE MOVE GSWBCD5,=D'0' MOVE GTKFVAL,=D'0' B CLKF210 CLKF200 MOVE GSWBIN5,GSWBCD5 PERF KFWRIT,CBIN3,CBIN1,GSWBIN5,GTKFVAL PERF KFWRIT,CBIN3,CBIN2,GSWBIN5,GTKFVAL CLKF210 MOVE GSWBIN5,GSWBCD5 PERF KFWRIT,CBIN2,CBIN1,GSWBIN5,GTKFVAL ADD GSWBCD5,=D'1' CBL GSWBCD5,=D'5',CLKF200 CLKFRET RET PEND EJECT CLEDB PROC * * WRITING OF DISC JOURNAL AND VOUCHER * MOVE GSWSTR20,=C'EDB-T[LLERE ' PERF WRITJT,=W'6' PERF WAHEAD,CBIN8 MOVE GSWBCD5,=D'0' MOVE GTREGF(CBIN1),=D'0' TOTAL MOVE GTREGF(CBIN2),=D'0' CLEDB010 TBT GTSPGFLG,CLEDB020 MOVE GTREGNR,=D'11' CLEDB020 ADD GSWBCD5,=D'1' CLEDB030 MOVE GSWBIN5,GSWBCD5 CBG GSWBIN5,CBIN6,CLEDB100 ADD GTREGF(CBIN1),TTACC(GSWBIN5,CBIN1) ADD GTREGF(CBIN2),TTACC(GSWBIN5,CBIN2) MOVE GTUSED(CBIN4),CBIN0 MOVE GTDUPF(CBIN4),TTACC(GSWBIN5,CBIN1) ADD GTDUPF(CBIN4),TTACC(GSWBIN5,CBIN2) MOVE GTDUPF(CBIN6),TTACC(GSWBIN5,CBIN1) MOVE GTDUPF(CBIN5),TTACC(GSWBIN5,CBIN2) DEBET TBT GTSPGFLG,CLEDB040 MOVE GTUSED(CBIN6),=W'-53' MOVE GTUSED(CBIN5),=W'-52' MOVE GTDUPF(CBIN1),GSWBCD5 MOVE GTUSED(CBIN1),=W'50' MOVE GTDUPF(CBIN2),=D'2' MARK FOR TOTAL MOVE GTUSED(CBIN2),=W'51' PERF CRKJ PERF WRITFD BNOK CLEDB030 CLEDB040 MOVE GSWBIN5,GSWBCD5 RESTORE MOVE GTWBCD1,GSWBCD5 PERF WRITJT,=W'7' PERF WALINE,CBIN10 B CLEDB010 CLEDB100 PERF PACKCL MOVE GTDUPF(CBIN4),GTREGF(CBIN1) ADD GTDUPF(CBIN4),GTREGF(CBIN2) MOVE GTDUPF(CBIN5),TTACC(CBIN8,CBIN1) ADD GTDUPF(CBIN5),TTACC(CBIN8,CBIN2) PERF WALINE,CBIN11 MOVE GTDUPF(CBIN5),TTACC(CBIN1,CBIN1) MOVE GTDUPF(CBIN6),TTACC(CBIN1,CBIN2) MOVE GSWBIN1,CBIN1 CLEDB110 ADD GSWBIN1,CBIN1 CBG GSWBIN1,CBIN4,CLEDB120 ADD GTDUPF(CBIN5),TTACC(GSWBIN1,CBIN1) ADD GTDUPF(CBIN6),TTACC(GSWBIN1,CBIN2) B CLEDB110 CLEDB120 TBT GTSPGFLG,CLEDB160 * ADJUST FOR 'KASSE INDBERETNING' MOVE GSWBCD1,TTCASH SUB GSWBCD1,TTSTCASH CBL GSWBCD1,=D'0',CLEDB130 SUB GTDUPF(CBIN6),GSWBCD1 B CLEDB140 CLEDB130 SUB GTDUPF(CBIN5),GSWBCD1 CLEDB140 * ADJUST FOR 'VERSUR INDBERETNING' MOVE GSWBCD1,TTACC(CBIN6,CBIN1) ADD GSWBCD1,TTACC(CBIN6,CBIN2) MUL GSWBCD1,=D'-1' 'VEND' CBL GSWBCD1,=D'0',CLEDB150 SUB GTDUPF(CBIN6),GSWBCD1 B CLEDB160 CLEDB150 SUB GTDUPF(CBIN5),GSWBCD1 CLEDB160 MUL GTDUPF(CBIN5),=D'-1' MUL GTDUPF(CBIN6),=D'-1' MOVE GSWBCD1,TTCASH SUB GSWBCD1,TTSTCASH MOVE GTDUPF(CBIN4),GSWBCD1 PERF WALINE,CBIN12 DSC0 KVOUCH,RLEAS RET PEND EJECT CLBEH PROC * * BEHOLDNINGST[LLERE * CLBEH010 MOVE TTLINNR,=D'25' MOVE GSWBIN2,CBEH(TTASKNR,CBIN2) CMP GSWBIN2,CBIN0 BE CLBEHRET ADD GSWBIN2,CBEH(TTASKNR,CBIN1) MOVE GTWBCD2,GSWBIN2 ATTFMT CLFRM04 SET SPPROMPT PERF SPCLRA IB SPBINW2, C CLBEH030,CLBEH030,CLBEH050,CLBEH040,CLBEH030, C CLBEH030,CLBEH030,CLBEH030,CLBEH060,CLBEH030, C CLBEH030,CLBEH030,CLBEH060 CLBEH030 B CLBEH010 CLBEH040 TBT GTSPGFLG,CLBEH010 MOVE GSWSTR20,=C'SLET SALDO ' MOVE GSWBIN6,CBIN1 B CLBEH100 CLBEH050 TBT GTSPGFLG,CLBEH010 MOVE GSWSTR20,=C'SLET PERIODE ' MOVE GSWBIN6,CBIN2 B CLBEH100 CLBEH060 MOVE GSWSTR20,=C'SUBTOTAL ' MOVE GSWBIN6,CBIN3 B CLBEH100 CLBEH100 MOVE GTWBCD1,=D'0' MOVE GSWBCD6,=D'0' MOVE GSWBCD7,=D'0' CLBEH110 PERF GRASPV MOVE GSWBIN3,CVOUTOP ADD GSWBIN3,CBIN6 DSC1 KVOUCH,POS,GSWBIN3 PERF CLEAR8 PERF FRMXVO,CBIN13 HEAD ON VOUCHER EDWRT KVOUCH,GTSTRFMT CLBEH120 ADD GTWBCD1,=D'1' MOVE GSWBIN3,GTWBCD1 ADD GSWBIN3,CBEH(TTASKNR,CBIN1) MOVE GSWBIN4,GTWBCD2 CBG GSWBIN3,GSWBIN4,CLBEH160 CBE CBACC(GSWBIN3,CBIN1),=D'0',CLBEH120 * ADD TO TOTAL, PERIODE AND SALDO ADD GSWBCD6,CBACC(GSWBIN3,CBIN2) PERIODE ADD GSWBCD7,CBACC(GSWBIN3,CBIN3) SALDO PERF FRMXVO,CBIN14 EDWRT KVOUCH,GTSTRFMT TBT GTTESTFL,CLBEH150 IB GSWBIN6,CLBEH130,CLBEH140,CLBEH150 B CLBEH150 CLBEH130 MOVE CBACC(GSWBIN3,CBIN3),=D'0' SALDO CLBEH140 MOVE CBACC(GSWBIN3,CBIN2),=D'0' PERIODE CLBEH150 SUB TTLINNR,=D'1' CBG TTLINNR,=D'0',CLBEH120 DSC0 KVOUCH,RLEAS MOVE TTLINNR,=D'25' B CLBEH110 CLBEH160 * WRITE TOTAL LINE PERF FRMXVO,CBIN18 EDWRT KVOUCH,GTSTRFMT DSC0 KVOUCH,RLEAS CLBEHRET RET PEND RGA300 TBT CCONVERT,RG310 PERF ADM,CBIN11 SPG RG310 B RGKLAR EJECT ************************************************** * * TR2GEN GENERATES A TRANSACTION 2 * **************************************************** TR2GEN PROC DBKR MOVE TTDKDEX,DBKR CBNE TTDKDEX,=W'0',TR2DBKR MOVE TTDKDEX,CBIN1 CBL GTDUPF(CBIN4),=D'0',TR2DBKR MOVE TTDKDEX,CBIN2 TR2DBKR PERFI TTDKDEX,SETKRE,SETDEB EDWRT SCREEN,CLFRM02 MOVE GSWBCD1,GTDUPF(CBIN1) REG KONTO NR PERF KTPLAN,GSWBCD1,GTKTTYP 'KORT' REQUIRED? PERF SLUT BNOK TR2NOK TBF CCLKTFLG,TR2OK TBF GTKORTFL,TR2OK PERF KORT TR2OK CLEAR GTKORTFL CMP CBIN0,CBIN0 OK TR2NOK RET PEND EJECT ******************************************************** * * WAHEAD - GRASP AND WRITE HEADLINE ON VOUCHER * ******************************************************** WAHEAD PROC VOXDEX EDWRT SCREEN,CLFRM03 PERF SPLIN8,CBIN5,CBIN2 PERF GRASPV DSC1 KVOUCH,POS,CVOUTOP PERF CLEAR8 PERF FRMXVO,VOXDEX EDWRT KVOUCH,GTSTRFMT RET PEND ********************************************************* * * WALINE WRITE ACCUMULATORLINE * ********************************************************** WALINE PROC LINDEX PERF FRMXVO,LINDEX EDWRT KVOUCH,GTSTRFMT SUB TTLINNR,=D'1' RET PEND * EJECT SKIFT PROC ************************* * * SKIFT - THIS PROCEDURE TAKES HAND OF SHIFT * OF DISKS, IS ACTIVATED AFTER * 12 ADM * ************************ SK00 PERF WAITF,CPFLG SET CSKIFTWN PERF SPLIN8,CBIN8,CBIN2 'DISKETTE SKIFT' TBF CWFLAG,SK15 SUB CRECBCD,=D'1' PERF SLUTID,CRECBCD WRITE 'SLUTD' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR SK15 PERF WRITID,CBIN2,CBIN2 PERF CLSVOL,CBIN2 PERF LAMPOF,=W'2047' ADD CVOLNO,=D'1' SET CRKCOPY FD2 EMPTY SK120 PERF LAMPON,=W'512' LAMP 2 PERF SOPRD TBF CRKCOPY,SK120 FD2 NOT EMPTY YET CBNE GSWBIN2,CBIN9,SK120 PERF ASGVOL,CBIN2 BNOK SK120 PERF LAMPOF,=W'2047' MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'0' TBF CWFLAG,SK130 PERF STRTWR BNOK SK120 SK130 PERF CNFWRT REWRITE CONFDATA TBF CWFLAG,SK150 MOVE CRECBCD,=D'1' PERF WRITID,CBIN2,CBIN1 SK150 PERF CLEAR8 PERF WRITJT,=W'11' CLEAR CSKIFTFL CLEAR CSKIFTWN CLEAR CPFLG DISC FREE RET PEND STRTWR PROC ********************* * * STRTWR - SET UP AND WRITE START RECORD * * *********************** PERF STRTID,CVOLNO PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR BNOK STRTNOK ADD CRECNR,CBIN1 PERF RADEL,DK02,CRECNR BNOK STRTNOK CMP CBIN0,CBIN0 OK RET STRTNOK CMP CBIN1,CBIN0 RET PEND EJECT STRTID PROC VOLID ******************** * STRTID - SETS UP A START ID IN PACK BUFFER * CALL - PERF STRTID,<VOLID> ******************** SET CSWFLAG CBE CRECLGD,=W'128',STRT10 CLEAR CSWFLAG STRT10 MOVE GSWBIN6,CBIN2 EDIT CPCKBUF,PCKINIT EDIT CPCKBUF,STARTFR MOVE GSWBCD3,VOLID EDIT GSWSTR20,FRVOLID MOVE GSWBIN1,=W'40' COPY CPCKBUF,GSWBIN1,CBIN12,GSWSTR20,CBIN0 RET PEND SLUTID PROC SLUTNO ******************** * SLUTID - SETS UP A SLUTD IN CPCKBUF ******************** SET CSWFLAG CBE CRECLGD,=W'128',SLUT10 CLEAR CSWFLAG SLUT10 EDIT CPCKBUF,PCKINIT MOVE CRECBCD,SLUTNO EDIT CPCKBUF,SLUTFRM RET PEND EJECT BCKUP PROC $OPT PLIT $OPT ******************** * * THIS PROCEDURE TAKES CARE OF ADMINISTRATION * OB BACKUP * * CALL: PERF BCKUP,<=W'X'> * $OPT = 1 : WITHOUT BACKUP * $OPT = 2 : WITH BACKUP * * ******************** * MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'1' ADD CVOLNO,=D'1' NEXT VOLUME NO PERF CNFWRT REWRITE CONFIGURATION SUB CVOLNO,=D'1' CMP CBIN1,$OPT BE BCK100 NO BACKUP * * * BACKUP BCK000 PERF CLEAR8 PERF LAMPOF,=W'2047' LAMPS OFF BCK005 PERF LAMPON,=W'1024' LAMP 1 PERF LAMPON,=W'128' LAMP 4 PERF LAMPON,=W'16' LAMP 7 TBF CTEXTFLG,BCK008 PERF LAMPON,=W'64' LAMP 5 BCK008 TBF CSTRKFLG,BCK009 PERF LAMPON,=W'256' LAMP 3 BCK009 TBF CGLREGFL,BCK010 PERF LAMPON,=W'512' LAMP 2 BCK010 PERF SOPRD READ SOP LAMPS IB GSWBIN2, C BSOP10,BSOP09,BSOP08,BSOP07,BSOP06, C BSOP05,BSOP04,BSOP03,BSOP02,BSOP01 BSOP06 BSOP08 BSOP09 BSOP10 B BCK010 OTHER LAMPS * BSOP01 BACKUP FD999001 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'1024' LAMP 1 MOVE GSWBIN5,=W'32' NO OF RECORDS PERF BACKUP,DK01,=D'1',GSWBIN5,CCONBUF0,=W'199' BNOK BCK050 ADD CVOLNO,=D'1' PERF WRITID,CBIN6,CBIN4 BACKUP OK SUB CVOLNO,=D'1' PERF CONRDX,CCONBUF0,CBIN1 RESTORE BUFFER AREA B BCK000 BCK050 PERF CONRDX,CCONBUF0,CBIN1 RESTORE BUFFER AREA B BCK005 * BSOP02 COPY FD999002 TO FD999005 TBF CGLREGFL,BCK010 ALLOWED? * ***** BCK02 COPY FD999002 TO FD999005 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'512' LAMP 2 SET CPFLG PERF ASGVOL,CBIN2 ASSIGN REGSET BNOK BCK0290 MOVE CGLRECNR,CBIN0 BCK0250 ADD CGLRECNR,CBIN1 MOVE GSWBIN1,=W'128' LENGTH OF RECORD PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,CGLRECNR BNOK BCK0270 ERROR CBE GTWBCD1,=D'4',BCK0280 NO DATA MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CPCKBUF,CBIN0,CBIN5 BE BCK0280 SLUTD PERF RAWRIT,DK05,=D'5',CPCKBUF,CGLRECNR BOK BCK0250 BCK0270 ERROR PERF LAMPON,=W'2' LAMP 10 BCK0280 FINISH MOVE TTGLREC,CGLRECNR PERF TCONFW,CBIN1 SAVE LAST RECORD NO. BCK0290 CLEAR CPFLG DSC0 DK02,CLOSE CLOSE VOLUME 2 * ***** BCK02R B BCK000 * * ***** * BSOP03 BACKUP INDEX,STAM,VAR,TRANS TBF CSTRKFLG,BCK010 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'256' LAMP 3 PERF BACKUP,DK07,=D'7',CBIN0,GTREMBUF,=W'8' INDX PERF BACKUP,DK08,=D'8',CBIN0,GTREMBUF,=W'128' STAM PERF BACKUP,DK09,=D'9',CBIN0,GTREMBUF,=W'49' VAR TBF CBUDTFLG,BCK000 PERF BACKUP,DK11,=D'11',CBIN0,GTREMBUF,=W'39' TRANS TBF C173FLG,BCK000 PERF BACKUP,DK17,=D'17',CBIN0,GTREMBUF,=W'8' * * ***** * BSOP05 BACKUP TEXT TBF CTEXTFLG,BCK010 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'64' LAMP 5 PERF BACKUP,DK06,=D'6',CBIN0,CTXBUF,=W'24' BNOK BCK005 NOK B BCK000 * ***** * BSOP04 BACKUP FD999004 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'128' LAMP 4 PERF BACKUP,DK04,=D'4',CKTMAX,CKTBUF,=W'128' BNOK BCK005 NOK B BCK000 OK * BSOP07 FINISH PERF LAMPOF,=W'2047' LAMPS OFF PERF ASGVOL,CBIN1 ASSIGN SYSTEM FILES BNOK BCKNOK BCK100 PERF ASGVOL,CBIN2 BNOK BCKNOK ADD CVOLNO,=D'1' PERF STRTWR BOK BCKOK SUB CVOLNO,=D'1' PERF LAMPON,=W'2' LAMP 10 B BCKNOK * BCKNOK CMP CBIN1,CBIN0 NOK RET * BCKOK PERF WRITID,CBIN2,CBIN1 CMP CBIN0,CBIN0 RET PEND EJECT * * ************************************************* * * FORMATS * ************************************************* * KLRFMT PROC FMTDEX * ********** * * ATTACH KLAR ADM FORMAT * ********** * KLRFTB FTABLE OPENFRM ATTFMT KLRFTB(FMTDEX) RET PEND * * FMTFKI FRMT FNL FKI 3 FMEL 'B',TSWBCD2 FMEND * OPENFRM FRMT FSL FCOPY ='ADM ' FBT GTDYFLG,OPFR05 FTAB 1 FCOPY =C'KASSE]BNING' OPFR05 FNL FBF GTMASTFL,OPFR10 FCOPY =C'DAGS-DATO' FKI 11,MINL=6,MAXL=6,ME,SCHK=2,REWRT,NCLR FMEL '99E-99E-99',CMASKDAT FNL FCOPY =C'DAG NR' FKI 11,MINL=1,MAXL=3,ME,APPL=102 FMEL 'ZZZ',CRELDAY FNL OPFR10 FCOPY ='POST-DATO' FKI 11,MINL=6,MAXL=6,ME,SCHK=2,REWRT,APPL=107 FMEL '99E-99E-99',GTDATO FMEND * CLFRM01 FRMT FSL FCOPY =C'KASSELUKNING' FILLR X'07',1 FLINK FMTFKI FMEND * CLFRM02 FRMT FILLR '1',2 FCOPY =C'KASSELUKNING' FNL FCOPY GSWSTR20 TEXT FMEL 'ZZ',GTWBCD1 COUNTER NR FILLR ' ',4 FCOPY GTDBKRC DEB-KRE FNL FCOPY =C'KONTONR' FILLR ' ',5 FCOPY =C'BEL' FILLR X'5C',1 FILLR 'B',1 FNL FMEL '99999999E-99',GTDUPF(CBIN1) FMEL 'BTTTVTTTVTTTVTT9V99-',GTDUPF(CBIN4) FMEND * CLFRM03 FRMT FILLR '1',2 FBT GTSPGFLG,CLF0301 FCOPY =C'KASSELUKNING' CLF0301 FNL FCOPY GSWSTR20 FMEND * CLFRM04 FRMT FSL FBT GTSPGFLG,CLF0401 FCOPY ='KASSELUKNING' CLF0401 FNL FCOPY ='BEHOLDNINGST[LLERE' FNL FNL FBT GTSPGFLG,CLF0402 FCOPY ='SLET ' FCOPY ='PERIODE ' FTAB 15 FCOPY =' DEB' FNL FCOPY ='SLET ' FCOPY ='SALDO ' FTAB 15 FCOPY =' KRE' CLF0402 FNL FCOPY ='SUBTOTAL ' FTAB 16 FCOPY ='KVIT' FNL FNL FNL FILLR ' ',1 FCOPY ='BILAG' FLINK FMTFKI FMEND * PCKINIT FRMT FILLR ' ',40 FILLR ' ',40 FBT CSWFLAG,INIT10 FILLR X'00',48 FEXIT INIT10 FILLR ' ',48 FMEND * FRVOLID FRMT FMEL '999999',CMASKDAT FILLR ' ',1 FMEL '99999',GSWBCD3 FMEND * SLUTFRM FRMT FCOPY =C'SLUTD' FMEL '99999',CRECBCD FMEND * STARTFR FRMT FCOPY =C'Z300 ' FMEL '9999',CKMDNR KOMMUNE NR FILLR C'2',1 FCOPY CVOL(GSWBIN6) FMEL '999',CRELDAY DAG NR FILLR C'1',1 MIXED TRANS FILLR ' ',6 FMEND * ADFRM01 FRMT FSL FCOPY ='KLAR ' FCOPY ='ADM ' FKI 12,MINL=1,MAXL=2 FMEL 'ZZ',GSWBCD3 FMEND * * * END