|
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: 26468 (0x6764)
Notes: pts_type(SC)
Names: »RGKLAR.SC«
└─⟦38a30a456⟧ Bits:30009662 Philips computer tape "600104"
└─⟦this⟧ »OD-KOM/RGKLAR.SC«
IDENT RGKLAR 840203/EV DDUM KMD08 PDIV ENTRY RGADM ENTRY CLEJ ENTRY CLEDB ENTRY CLBEH ENTRY RGA120 ENTRY ZERO ENTRY SKIFT ENTRY STRTWR ENTRY STRTID ENTRY SLUTID ENTRY SOPRD ENTRY LAMPOF ENTRY LAMPON ENTRY TCLOSE ENTRY TR2GEN ENTRY WAHEAD ENTRY WALINE ENTRY BCKUP EXT ADM EXT CNFWRT EXT RADEL EXT SETKRE EXT SETDEB EXT WRITJT EXT INITRG EXT SPCLRN EXT SPCLRA EXT PACKCL EXT CLEAR8 EXT SPLIN8 EXT SLUT EXT GRASPV EXT FRMXVO EXT KORT EXT TCONFW EXT CONFWR EXT WRITFD EXT RAREAD EXT RAWRIT EXT ASGVOL EXT ASGFIL EXT CLSVOL EXT CRKJ EXT BACKUP EXT CONRDX EXT WRITID EXT WRITLO EXT WAITF INCLUDE EQUATE EJECT RGADM SET SPPROMPT MOVE SPKEY,CBIN2 ATTFMT ADFRM01 PERF SPCLRA IB SPBINW2,RGADM,RGADM,RGADM,RGADM,RGA100,RGA200,RGA300 B RGADM * RGA100 * ******************************************************** * * OPEN ROUTINE * ******************************************************** * TBT CCONVFLG,RGADM CLEAR GTDYFLG SET SPPROMPT SET SPME MOVE GSWBCD3,=X'FF' ERASE RGA105 ATTFMT OPENFRM PERF SPCLRN IB SPBINW2,RGADM,RGADM,RGA110 B RGADM 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'10001' 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 MOVE GSWSTR20,=C'*' PERF WRITJT,=W'12' B RGADM EJECT TCLOSE PROC CLEAR GTSPECTR NO MORE TR50... 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 MOVE TTSUPMRK,=C' ' MOVE TTSUMMRK,=C' ' MOVE GTTEXT,=C' ' 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),TCL100 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 EJECT TCL100 MOVE GSWSTR9,=C'TOTAL ' PERF CLEJ EJ EDB MOVE TTEJEDB,=D'0' TCL205 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' SET GTTFLG PERF TR2GEN,CBIN0 BNOK TCL205 TBF CCLKTFLG,TCL230 PERF KORT ASK FOR KONTOKORT TCL230 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 TCL230 TBF CCLKTFLG,TCL235 PERF KORT * * WRITING OF DISC JOURNAL AND VOUCHER * TCL235 MOVE GSWSTR9,=C'TOTAL ' PERF CLEDB * * BEHOLDNINGST[LLERE * PERF CLBEH * TCL500 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 TCLRET * ZERONIZE COUNTERS * TRANS 12 COUNTERS CMP CBIN0,CBIN0 DUMMY RET TCLNOK10 TCLMAK CMP CBIN0,CBIN1 RET PEND EJECT RGA200 ************************************************ * * PERFORM OF SELECTED ADM ROUTINE * ************************************************* * MOVE GSWBIN1,GSWBCD3 PERF ADM,GSWBIN1 B RGADM EJECT ZERO PROC * * ZERONIZE COUNTERS * TRANS 12 COUNTERS MOVE GSWBIN1,CTR12(TTASKNR,CBIN1) MOVE GSWBIN2,GSWBIN1 ADD GSWBIN2,CTR12(TTASKNR,CBIN2) TCL610 ADD GSWBIN1,CBIN1 CBG GSWBIN1,GSWBIN2,TCL615 MOVE C12ACC(GSWBIN1,CBIN1),=D'0' MOVE C12ACC(GSWBIN1,CBIN2),=D'0' 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,TCLEJRET PERF WAHEAD,CBIN8 MOVE GTWBCD1,=D'0' TCL110 ADD GTWBCD1,=D'1' MOVE GSWBIN5,GTWBCD1 CONVERT CBG GSWBIN5,CTR12(TTASKNR,CBIN2),TCL200 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',TCL110 CBG TTLINNR,=D'0',TCL190 DSC0 KVOUCH,RLEAS MOVE TTLINNR,=D'25' PERF WAHEAD,CBIN8 TCL190 PERF WALINE,CBIN9 B TCL110 TCL200 DSC0 KVOUCH,RLEAS TCLEJRET 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' TCL240 TBT GTSPGFLG,TCL242 MOVE GTREGNR,=D'11' TCL242 ADD GSWBCD5,=D'1' TCL245 MOVE GSWBIN5,GSWBCD5 CBG GSWBIN5,CBIN6,TCL300 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,TCL290 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 TCL250 PERF WRITFD BNOK TCL250 TCL290 MOVE GSWBIN5,GSWBCD5 RESTORE MOVE GTWBCD1,GSWBCD5 PERF WRITJT,=W'7' PERF WALINE,CBIN10 B TCL240 TCL300 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 TCL310 ADD GSWBIN1,CBIN1 CBG GSWBIN1,CBIN4,TCL320 ADD GTDUPF(CBIN5),TTACC(GSWBIN1,CBIN1) ADD GTDUPF(CBIN6),TTACC(GSWBIN1,CBIN2) B TCL310 TCL320 TBT GTSPGFLG,TCL329 * ADJUST FOR 'KASSE INDBERETNING' MOVE GSWBCD1,TTCASH SUB GSWBCD1,TTSTCASH CBL GSWBCD1,=D'0',TCL323 SUB GTDUPF(CBIN6),GSWBCD1 B TCL325 TCL323 SUB GTDUPF(CBIN5),GSWBCD1 TCL325 * ADJUST FOR 'VERSUR INDBERETNING' MOVE GSWBCD1,TTACC(CBIN6,CBIN1) ADD GSWBCD1,TTACC(CBIN6,CBIN2) MUL GSWBCD1,=D'-1' 'VEND' CBL GSWBCD1,=D'0',TCL328 SUB GTDUPF(CBIN6),GSWBCD1 B TCL329 TCL328 SUB GTDUPF(CBIN5),GSWBCD1 TCL329 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 * TCL400 MOVE TTLINNR,=D'25' MOVE GSWBIN2,CBEH(TTASKNR,CBIN2) CMP GSWBIN2,CBIN0 BE CLBEHRET ADD GSWBIN2,CBEH(TTASKNR,CBIN1) MOVE GTWBCD2,GSWBIN2 TCL405 ATTFMT CLFRM04 SET SPPROMPT PERF SPCLRA IB SPBINW2, C TCL415,TCL415,TCL412,TCL411,TCL415, C TCL415,TCL415,TCL415,TCL413,TCL415, C TCL415,TCL415,TCL413 TCL415 B TCL400 TCL411 TBT GTSPGFLG,TCL400 MOVE GSWSTR20,=C'SLET SALDO ' MOVE GSWBIN6,CBIN1 B TCL420 TCL412 TBT GTSPGFLG,TCL400 MOVE GSWSTR20,=C'SLET PERIODE ' MOVE GSWBIN6,CBIN2 B TCL420 TCL413 MOVE GSWSTR20,=C'SUBTOTAL ' MOVE GSWBIN6,CBIN3 B TCL420 TCL420 MOVE GTWBCD1,=D'0' MOVE GSWBCD6,=D'0' MOVE GSWBCD7,=D'0' TCL425 PERF GRASPV MOVE GSWBIN3,CVOUTOP ADD GSWBIN3,CBIN6 DSC1 KVOUCH,POS,GSWBIN3 PERF CLEAR8 PERF FRMXVO,CBIN13 HEAD ON VOUCHER EDWRT KVOUCH,GTSTRFMT TCL430 ADD GTWBCD1,=D'1' MOVE GSWBIN3,GTWBCD1 ADD GSWBIN3,CBEH(TTASKNR,CBIN1) MOVE GSWBIN4,GTWBCD2 CBG GSWBIN3,GSWBIN4,TCL490 CBE CBACC(GSWBIN3,CBIN1),=D'0',TCL430 * 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,TCL433 IB GSWBIN6,TCL431,TCL432,TCL433 B TCL433 TCL431 MOVE CBACC(GSWBIN3,CBIN3),=D'0' SALDO TCL432 MOVE CBACC(GSWBIN3,CBIN2),=D'0' PERIODE TCL433 SUB TTLINNR,=D'1' CBG TTLINNR,=D'0',TCL430 DSC0 KVOUCH,RLEAS MOVE TTLINNR,=D'25' B TCL425 TCL490 * WRITE TOTAL LINE PERF FRMXVO,CBIN18 EDWRT KVOUCH,GTSTRFMT DSC0 KVOUCH,RLEAS CLBEHRET RET PEND RGA300 PERF ADM,CBIN11 SPG B RGADM ************************************************** * * TR2GEN GENERATES A TRANSACTION 2 * **************************************************** TR2GEN PROC DBKR CLEAR GTSPECTR NOT SPECIAL TRANS 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 PERF SLUT RET PEND ******************************************************** * * 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 * ************************ PERF WAITF,CPFLG SET CSKIFTWN PERF SPLIN8,CBIN8,CBIN2 'DISKETTE SKIFT' TBF CWFLAG,SK15 SUB CRECBCD,=D'1' PERF SLUTID,CPCKBUF,CRECBCD WRITE 'SLUTD' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR SK11 TBF CBCACTVF,SK15 NOT ACTIVE DC TBT CBCSENDF,SK13 SENDING NOW? CBNL CBCFROM,CRECNR,SK15 NO, ALL SEND? SK13 NOT ALL SEND MOVE CBCOPT,CBIN4 SEND REST MOVE GSWBIN1,=W'30' DELAY GSWBIN1 B SK11 SK15 PERF WRITID,CPCKBUF,CBIN2,CBIN2 'DISKETTESKIFT' PERF CLSVOL,CBIN2 PERF LAMPOF,=W'2047' ADD CVOLNO,=D'1' PERF CNFWRT REWRITE CONFDATA CBL CREGVOL,=W'2',SK120 MOVE GSWBIN2,CBIN6 COMPUTE NOW OUTPUTVOLUME SUB GSWBIN2,CREGVOL MOVE CREGVOL,GSWBIN2 PERF ASGVOL,CBIN2 TRY TO ASSIGN IT BNOK SK120 ERROR B SK124 SK120 PERF LAMPON,=W'512' LAMP 2 PERF SOPRD CBNE GSWBIN2,CBIN9,SK120 PERF ASGFIL,CBIN2 BNOK SK120 SK124 PERF LAMPOF,=W'2047' MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'0' TBF CWFLAG,SK130 PERF STRTWR BOK SK130 PERF CLSVOL,CBIN2 B SK120 SK130 TBF CWFLAG,SK150 MOVE CRECBCD,=D'1' PERF WRITID,CPCKBUF,CBIN2,CBIN1 SK150 PERF CLEAR8 PERF WRITJT,=W'11' PERF WRITLO,CBIN5 CLEAR CSKIFTFL CLEAR CSKIFTWN CLEAR CPFLG DISC FREE TBF CBCACTVF,SK900 MOVE CBCOPT,CBIN1 MOVE CBCFROM,CBIN0 SEND FROM START SK900 RET PEND EJECT * LAMPON PROC $NR PLIT $NR ************************************** * * LAMPON - FIRE LAMPS ON OPR. PANEL. * CALL - PERF LAMPON,<$NR> * * THE LAMPS ARE FIRED CORRESPONDING TO 1-BITS IN PARAM * ***************************************** MOVE GSWBIN2,$NR DSC1 DSSOPO,ON,GSWBIN2 RET PEND * LAMPOF PROC $NR PLIT $NR ***************************************** * * LAMPOF - EXTINGUISH LAMPS ON OPR. PANEL * CALL - PERF LAMPOF,<$NR> * * THE LAMPS ARE EXTINGHUISHED CORRESPONDING TO 1-BITS IN PARAM * ******************************************** MOVE GSWBIN2,$NR DSC1 DSSOPO,OFF,GSWBIN2 RET PEND * SOPRD PROC ********************************************* * * SOPRD - READ SYSTEMS OPERATOR PANEL * ********************************************* SOPR10 MOVE GSWBIN1,CBIN1 KI DSSOPI,SOPINP,DUMTAB,GSWBIN1,GSWBIN2 BNOK SOPR10 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,=D'2' BNOK STRTNOK CMP CBIN0,CBIN0 OK RET STRTNOK CMP CBIN1,CBIN0 RET PEND 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 STRTRET RET PEND SLUTID PROC BUF,SLUTNO ******************** * * SLUTID - SETS UP A SLUTD IN BUFFER * * ******************** SET CSWFLAG CBE CRECLGD,=W'128',SLUT10 CLEAR CSWFLAG SLUT10 EDIT BUF,PCKINIT MOVE GSWBCD3,SLUTNO EDIT BUF,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' CBE CBIN1,$OPT,BCK100 NO BACKUP * * * BACKUP * BCK000 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 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 BSOP03 BSOP05 BSOP06 BSOP08 BSOP09 BSOP10 B BCK010 OTHER LAMPS * BSOP01 BACKUP FD999001 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'1024' LAMP 1 PERF BACKUP,DK01,=D'1',=W'32',CCONBUF0,=W'199' BNOK BCK050 ADD CVOLNO,=D'1' PERF WRITID,CPCKBUF,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? B BCK02 * ***** 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 B BCK02R * ***** BCK02R B BCK000 * BSOP04 BACKUP FD999004 PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'128' LAMP 4 PERF BACKUP,DK04,=D'4',=W'30',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 ASGFIL,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,CPCKBUF,CBIN2,CBIN1 CMP CBIN0,CBIN0 RET PEND EJECT * * ************************************************* * * FORMATS * ************************************************* DUMTAB KTAB EORKY1 * FMTFKI FRMT FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * PCKINIT FRMT FBT CSWFLAG,INIT10 FILLR ' ',40 FILLR ' ',40 FILLR X'00',48 FEXIT INIT10 FILLR ' ',40 FILLR ' ',40 FILLR ' ',48 FMEND * FRVOLID FRMT FMEL '999999',CMASKDAT FMEL 'B99999',GSWBCD3 FMEND * SLUTFRM FRMT FCOPY =C'SLUTD' FMEL '99999',GSWBCD3 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 * * 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 FLINK FBELOB FNL FMEL '99999999E-99',GTDUPF(CBIN1) FMEL 'BTTT.TTT.TTT.TT9.99-',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 PERIODE ' FTAB 15 FCOPY =' DEB' FNL FCOPY ='SLET SALDO ' FTAB 15 FCOPY =' KRE' CLF0402 FNL FCOPY ='SUBTOTAL ' FTAB 16 FCOPY ='KVIT' FNL FNL FNL FILLR ' ',1 FCOPY ='BILAG' FLINK FMTFKI FMEND * * FBELOB FRMT FCOPY =C'BEL' FILLR X'5C',1 FILLR 'B',1 FMEND * * * END