|
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: 26814 (0x68be)
Notes: pts_type(SC)
Names: »BUDGET.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/BUDGET.SC«
IDENT BUDGET 820804 NJ DDUM KMD08 PDIV ENTRY BUDREG EXT SPCLRA EXT SPCLRN EXT SPERR EXT RAWRIT EXT RAREAD EXT GENWRS EXT GENWRF EXT SKIP EXT FMOVE EXT FRMBUD EXT PACKST EXT WRITFD EXT PACKCL EXT NEWLIN EXT FRMBUP EXT SETDEB EXT RGREAD EXT WAITF EJECT BUDREG PROC ************************************************ * * THIS PROCEDURE PROCESSES TRANS 40-49 * *********************************************** TEST CBUDGET BE BUDRET TEST CCONVFLG BNZ BUDRET DATATRANSM OR CONVERSION ADD CTASKNR,CBIN1 INDICATE TERMINAL ACTIVE PERF BUDSTRT RESTART ON 1. CALL BNOK BUDEND CLEAR GTASTFLG BUD000 SET SPPROMPT ATTFMT BU00FRMT BUD010 PERF SPCLRA IB SPBINW2,BUD000,BUDEND,BUD050,BUD700,BUDEND, C BUDEND,BUDEND,BUDEND,BUD900 B BUD000 INVALID KEY BUD050 PERF NULSTIL MOVE GTANTAL,=D'0' MOVE GSWBIN1,GTREGNR SUB GSWBIN1,=W'39' IB GSWBIN1,BUD400,BUD410,BUD420,BUD010, C BUD010,BUD450,BUD460,BUD470,BUD480,BUD490 B BUD010 INVALID TRANSACTION BUD400 ATTFMT BU40FRM BUD401 MOVE GTDUPF(CBIN14),GTDUPF(CBIN15) RESTORE FIRST YEAR SUB GTDUPF(CBIN14),=D'1' ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR40GEN B BUD401 BUD410 ATTFMT BU41FRM BUD411 MOVE GTDUPF(CBIN14),GTDUPF(CBIN15) SUB GTDUPF(CBIN14),=D'1' ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR41GEN B BUD411 BUD420 ATTFMT BU42FRM BUD421 MOVE GTDUPF(CBIN14),GTDUPF(CBIN15) SUB GTDUPF(CBIN14),=D'1' PERF SETDEB ADD GTANTAL,=D'1' PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR42GEN B BUD421 BUD450 ATTFMT BU45FRM BUD451 ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR45GEN CLEAR SPPROMPT B BUD451 BUD460 ATTFMT BU46FRM BUD461 ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR46GEN CLEAR SPPROMPT B BUD461 BUD470 ATTFMT BU47FRM BUD471 ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR47GEN CLEAR SPPROMPT B BUD471 BUD480 ATTFMT BU48FRM BUD481 ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR48GEN CLEAR SPPROMPT B BUD481 BUD490 ATTFMT BU49FRM BUD491 ADD GTANTAL,=D'1' PERF SETDEB PERF SPCLRA IB SPBINW2,BUD000,BUD500 PERF TR49GEN CLEAR SPPROMPT B BUD491 BUD500 MOVE GSWBIN1,GTREGNR SUB GSWBIN1,=W'29' FIND FORMAT FOR TOTALLINE PERF FRMBUD,GSWBIN1 PERF BUWRIT CALL FMOVE,GTSTRFMT,STJFRM PERF BUWRIT INDICATE TRANSCHANGE B BUD000 BUD700 * THE PART OF THE PROGRAM SEEKS FOR REG. TRANSACTIONS * THE TRANS WILL BE DISPLAYED AND CAN BE * CORRECTED. AFTERWARDS IT WILL BE WRITTEN BACK ATTFMT BUSPFRMT SET SPPROMPT PERF SPCLRA IB SPBINW2,BUD700,BUD760,BUD710 B BUD700 BUD710 * GSWBCD6 CONTAINS TRANSCODE (40-49) * GSWBCD7 CONTAINS REGKONTONR MOVE GTRECNR,CRECNR BUD712 SUB GTRECNR,CBIN1 NEXT RECORD CBNG GTRECNR,CBIN1,BUD750 FINISHED ? PERF RGREAD,DK02,=D'2',CBIN2 READ RECORD BOK BUD730 B BUD712 BUD730 CBNE GTREGNR,GSWBCD6,BUD712 CBNE GTREGF(CBIN1),GSWBCD7,BUD712 * PERF NULSTIL MOVE GSWBIN1,GTREGNR SUB GSWBIN1,=W'39' CLEAR TTEORFLG IB GSWBIN1,BUD740,BUD741,BUD742,BUD743,BUD744, C BUD745,BUD746,BUD747,BUD748,BUD749 BUD740 ATTFMT BU40FRM PERF SETDEB PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR40GEN B BUD749A BUD741 ATTFMT BU41FRM PERF SETDEB PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR41GEN B BUD749A BUD742 ATTFMT BU42FRM PERF SETDEB PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR42GEN B BUD749A BUD743 BUD744 B BUD750 BUD745 ATTFMT BU45FRM PERF SETDEB PERF MOV56INV PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR45GEN B BUD749A BUD746 ATTFMT BU46FRM PERF SETDEB PERF MOV56INV PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR45GEN B BUD749A BUD747 ATTFMT BU47FRM PERF SETDEB PERF MOV56INV PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR47GEN B BUD749A BUD748 ATTFMT BU48FRM PERF SETDEB PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR48GEN B BUD749A BUD749 ATTFMT BU49FRM PERF SETDEB PERF SPCLRN CBNE SPBINW2,CBIN3,BUD750 PERF TR49GEN BUD749A PERF DELRECS BUD750 B BUD700 BUD760 CALL FMOVE,GTSTRFMT,STJFRM PERF BUWRIT B BUD000 BUD900 * PRINT LOGFILE, INSERT HEADERS MOVE CBUDPT,CBIN1 PRT022 MOVE GSWBIN8,=W'128' PERF RAREAD,DK12,=D'12',GTREMBUF,GSWBIN8,CBUDPT BNOK PRT095 MOVE GSWSTR2,GTREMBUF CBE GSWSTR2,='SL',PRT080 EMPTY PRINTFILE CBNE GSWSTR2,='**',PRT024 ADD CBUDPT,CBIN1 B PRT022 PRT024 PERF OVSKR PRT030 DLETE GTREMBUF,CBIN0,CBIN2 IB GSWBIN10,PRT031,PRT031,PRT031,PRT034,PRT034, C PRT034,PRT034,PRT034,PRT034,PRT034 * THIS PIECE OF CODING SPLITS PRINTLINES FROM * THE PRINTFILE (DK12) INTO TWO PHYSICAL PRINTLINES. PRT031 MOVE GSWSTR9,='*' MOVE GSWBIN1,CBIN0 MOVE GSWBIN2,=W'128' MATCH GTREMBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN1 BNOK PRT034 NOT FOUND, TRY TO PRINT PERF WAITF,CPFLG MOVE CPCKBUF,GTREMBUF SAVE OLD BUFFER MOVE GSWBIN10,GSWBIN1 SAVE POS ON '*' MOVE GSWBIN1,=W'128' SUB GSWBIN1,GSWBIN10 DLETE GTREMBUF,GSWBIN10,GSWBIN1 DELETE LAST PART PERF GENWRF,GTHCDEV,BUSUB10 PRINT FIRST PART MOVE GTREMBUF,=' ' MOVE GSWBIN1,=W'128' SUB GSWBIN1,GSWBIN10 SUB GSWBIN1,CBIN3 COPY GTREMBUF,CBIN0,GSWBIN1,CPCKBUF,GSWBIN10 CLEAR CPFLG RELEASE BUFFER ADD GTLINE,CBIN2 ADJUST LINE COUNTER PRT034 PERF GENWRF,GTHCDEV,BUSUB10 ADD CBUDPT,CBIN1 ADD GTLINE,CBIN2 MOVE GSWBIN8,=W'128' PERF RAREAD,DK12,=D'12',GTREMBUF,GSWBIN8,CBUDPT BNOK PRT095 MOVE GSWSTR2,GTREMBUF CBE GSWSTR2,='SL',PRT080 CBE GSWSTR2,='**',PRT040 NEW PAGE ? CBNL GTLINE,=W'43',PRT035 MOVE GSWBCD2,GSWSTR2 MOVE GSWBIN10,GSWBCD2 SUB GSWBIN10,=W'39' B PRT030 PRT035 MOVE GSWBCD5,=D'1' PERF SKIP CBE GSWSTR2,='SL',PRT080 CBNE GSWSTR2,='**',PRT024 ADD CBUDPT,CBIN1 B PRT022 PRT040 MOVE GSWBIN10,=W'43' SUB GSWBIN10,GTLINE HOW MANY NEW LINES DO WE NEED? PERF NEWLIN,GSWBIN10 B PRT035 PRT080 * RESET VARIOUS POINTERS MOVE GTREMBUF,=C'SLUTD ' PERF RAWRIT,DK12,=D'12',GTREMBUF,CBIN1 BNOK PRT095 MOVE CBUDPT,CBIN1 CMP CBIN0,CBIN0 B PRT099 PRT095 MOVE CBUDPT,CBIN0 CMP CBIN0,CBIN1 PRT099 B BUD000 BUDEND SUB CTASKNR,CBIN1 REMOVE FROM ACTIVITY PERF PACKCL CLEAR GTASTFLG BUDRET RET PEND EJECT BUDSTRT PROC * * THE PROCEDURE HAS TWO OBJECTIVES: * 1. WHEN A NEW FLOPPY HAS BEEN LOADED, * THE FILE WILL BE INITIATED * (ONLY AFTER PROGRAM-LOAD) * 2. WHEN THE PROGRAM IS LOADED AND * THE FILE IS NOT EMPTY, THE PROC * WILL SCAN THE FILE IN SEARCH FOR * A 'SLUTD' RECORD, AND CBUDPT * WILL BE UPDATED ACCORDINGLY. * 3. AT LAST SOME FIELDS WILL BE * INITIATED WITH <YEAR-1>, <YEAR>, * ......,<YEAR+6>. * CBNE CBUDPT,CBIN0,BST090 FIRST RUN AFTER LOAD ? MOVE GTREMBUF,=' ' MOVE CBUDPT,CBIN1 MOVE GSWBIN8,=W'128' PERF RAREAD,DK12,=D'12',GTREMBUF,GSWBIN8,CBUDPT BNOK BST095 MOVE GSWSTR20,GTREMBUF CBE GSWSTR20,=C' ',BST060 CLEAN DISKFILE CBE GSWSTR20,=C'SLUTD ',BST080 READY FOR USE MOVE CBUDPT,CBIN2 BST045 MOVE GSWBIN8,=W'128' PERF RAREAD,DK12,=D'12',GTREMBUF,GSWBIN8,CBUDPT BNOK BST095 MOVE GSWSTR20,GTREMBUF CBE GSWSTR20,=C'SLUTD ',BST080 ADD CBUDPT,CBIN1 B BST045 BST060 INITIATE MOVE GTREMBUF,=C'SLUTD ' PERF RAWRIT,DK12,=D'12',GTREMBUF,CBUDPT BNOK BST095 BST080 BST090 * ISOLATE YEAR MOVE GSWBCD1,CMASKDAT DDMMYY DIV GSWBCD1,=D'100' DDMM MUL GSWBCD1,=D'100' DDMM00 MOVE GSWBCD2,CMASKDAT SUB GSWBCD2,GSWBCD1 YY SUB GSWBCD2,=D'2' MOVE GSWBIN2,CBIN13 BST092 MOVE GTDUPF(GSWBIN2),GSWBCD2 ADD GSWBIN2,CBIN1 ADD GSWBCD2,=D'1' CBL GSWBIN2,CBIN22,BST092 CMP CBIN0,CBIN0 B BST099 BST095 MOVE CBUDPT,CBIN0 CMP CBIN0,CBIN1 BST099 RET PEND EJECT TR40GEN PROC CBG SPBINW2,CBIN3,TR40EX PERF TOTADD PERF TRGEN,=W'16' PERF BUEDIT TR40EX RET PEND TR41GEN PROC CBG SPBINW2,CBIN3,TR41EX PERF TOTADD PERF TRGEN,=W'17' PERF BUEDIT TR41EX RET PEND TR42GEN PROC CBG SPBINW2,CBIN3,TR42EX PERF TOTADD PERF TRGEN,=W'18' PERF BUEDIT TR42EX RET PEND TR45GEN PROC CBG SPBINW2,CBIN3,TR45EX PERF MOV56 ADD GTREGF(CBIN18),GTREGF(CBIN17) PERF BUEDIT MOVE GTDUPF(CBIN14),GTREGF(CBIN14) PERF TRGEN,=W'19' TR45EX RET PEND TR46GEN PROC CBG SPBINW2,CBIN3,TR46EX PERF MOV56 ADD GTREGF(CBIN18),GTREGF(CBIN17) PERF BUEDIT MOVE GTDUPF(CBIN14),GTREGF(CBIN14) PERF TRGEN,=W'20' TR46EX RET PEND TR47GEN PROC CBG SPBINW2,CBIN3,TR47EX PERF MOV56 ADD GTREGF(CBIN18),GTREGF(CBIN17) PERF BUEDIT MOVE GTDUPF(CBIN14),GTREGF(CBIN14) PERF TRGEN,=W'21' TR47EX RET PEND TR48GEN PROC CBG SPBINW2,CBIN3,TR48EX ADD GTREGF(CBIN18),GTREGF(CBIN4) PERF TRGEN,=W'22' PERF BUEDIT TR48EX RET PEND TR49GEN PROC CBG SPBINW2,CBIN3,TR49EX ADD GTREGF(CBIN18),GTREGF(CBIN4) PERF TRGEN,=W'23' PERF BUEDIT TR49EX RET PEND TOTADD PROC ADD GTREGF(CBIN14),GTREGF(CBIN3) ADD GTREGF(CBIN15),GTREGF(CBIN4) ADD GTREGF(CBIN16),GTREGF(CBIN5) ADD GTREGF(CBIN17),GTREGF(CBIN6) ADD GTREGF(CBIN18),GTREGF(CBIN7) ADD GTREGF(CBIN19),GTREGF(CBIN8) ADD GTREGF(CBIN20),GTREGF(CBIN9) ADD GTREGF(CBIN21),GTREGF(CBIN10) RET PEND OVSKR PROC MOVE GSWSTR2,GTREMBUF MOVE GSWBCD2,GSWSTR2 MOVE GSWBIN1,GSWBCD2 SUB GSWBIN1,=W'39' MOVE GSWSTR20,=' ' MOVE GSWBIN10,GSWBIN1 IB GSWBIN1,OVS40,OVS41,OVS42,OVSERR,OVSERR, C OVS45,OVS46,OVS47,OVS48,OVS49 B OVSERR OVS40 MOVE GSWSTR20,='BUDGETTAL ' B OVSPR OVS41 MOVE GSWSTR20,='BUDGETTAL ' B OVSPR OVS42 MOVE GSWSTR20,='BUDGETTAL ' B OVSPR OVS45 MOVE GSWSTR20,='TILL[GSBEV. BUDGET ' B OVSPR OVS46 MOVE GSWSTR20,='OMPLACERINGER ' B OVSPR OVS47 MOVE GSWSTR20,='SUM AF R]DIGHEDSB. ' B OVSPR OVS48 MOVE GSWSTR20,='ANL[GSUDGIFTER-TB ' B OVSPR OVS49 MOVE GSWSTR20,='ANL[GSINDT[GTER-TB ' OVSPR OVSERR PERF FRMBUP PERF GENWRS,GTHCDEV,GTSTRFMT MOVE GTLINE,CBIN4 RET PEND BUEDIT PROC MOVE GSWBIN1,GTREGNR SUB GSWBIN1,=W'39' PERF FRMBUD,GSWBIN1 PERF BUWRIT RET PEND BUWRIT PROC EDIT GTREMBUF,GTSTRFMT MOVE GSWSTR2,GTREMBUF CBNE GSWSTR2,='**',BUW020 TBT GTASTFLG,BUW090 BUW020 CLEAR GTASTFLG ADD CBUDPT,CBIN1 WRITE A NEW SLUTD BEFORE MOVE GTREMBUF,=C'SLUTD ' CORRUPTING THE OLD ONE PERF RAWRIT,DK12,=D'12',GTREMBUF,CBUDPT BNOK BUW095 SUB CBUDPT,CBIN1 EDIT GTREMBUF,GTSTRFMT PERF RAWRIT,DK12,=D'12',GTREMBUF,CBUDPT BNOK BUW095 ADD CBUDPT,CBIN1 MOVE GSWSTR2,GTREMBUF CBNE GSWSTR2,='**',BUW090 SET GTASTFLG BUW090 CMP CBIN0,CBIN0 B BUW099 BUW095 CMP CBIN0,CBIN1 BUW099 RET PEND MOV56 PROC * THE AMOUNT MUST BE MOVED TO FIELD * 55,56,57, DEPENING ON WHICH YEAR * IT BELONGS TO. * THE FORMEL IS: * FIELDNR := REGYEAR + 4 - ACTYEAR MOVE GTUSED(CBIN5),CBIN0 MOVE GSWBCD1,GTREGF(CBIN14) ADD GSWBCD1,=D'4' SUB GSWBCD1,GTDUPF(CBIN15) MOVE GSWBIN1,GSWBCD1 MOVE GTREGF(GSWBIN1),GTREGF(CBIN17) MOVE GSWBIN2,GSWBIN1 ADD GSWBIN2,=W'52' MUL GSWBIN2,=W'-1' MOVE GTUSED(GSWBIN1),GSWBIN2 MOVE GTPRTDAT,GTREGF(CBIN14) RET PEND MOV56INV PROC CBE GTUSED(CBIN3),CBIN0,MOV561 MOVE GSWBIN1,CBIN3 B MOV563 MOV561 CBE GTUSED(CBIN4),CBIN0,MOV562 MOVE GSWBIN1,CBIN4 B MOV563 MOV562 MOVE GSWBIN1,CBIN5 MOV563 MOVE GTREGF(CBIN17),GTREGF(GSWBIN1) MOVE GSWBIN2,GTDUPF(CBIN15) ADD GSWBIN2,GSWBIN1 SUB GSWBIN2,CBIN4 MOVE GTPRTDAT,GSWBIN2 YEEAR MOVE GTREGF(CBIN14),GSWBIN2 RET PEND DELRECS PROC PERF WAITF,CPFLG MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,GSWBIN9 BNOK DELREC2 MOVE GSWSTR20,CPCKBUF DELREC1 SET GTSWFLAG CBE CRECLGD,=W'128',DELREC3 CLEAR GTSWFLAG DELREC3 EDIT CPCKBUF,PCKINIT COPY CPCKBUF,CBIN0,CBIN20,GSWSTR20,CBIN0 MOVE GSWSTR9,=X'7F' COPY CPCKBUF,CBIN20,CBIN1,GSWSTR9,CBIN0 PERF RAWRIT,DK02,=D'2',CPCKBUF,GSWBIN9 BNOK DELREC2 DELREC2 CBNL GSWBIN9,GSWBIN10,DELREC9 ADD GSWBIN9,CBIN1 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,GSWBIN9 BNOK DELREC2 COPY GSWSTR20,CBIN6,CBIN5,CPCKBUF,CBIN6 MOVE LOBENR ONLY B DELREC1 AND DELETE CONT.RECORD DELREC9 CLEAR CPFLG RET PEND TRGEN PROC $W MOVE GTUSED(CBIN14),CBIN0 MOVE GTUSED(CBIN15),CBIN0 MOVE GTUSED(CBIN16),CBIN0 MOVE GTUSED(CBIN17),CBIN0 MOVE GTUSED(CBIN18),CBIN0 MOVE GTUSED(CBIN19),CBIN0 MOVE GTUSED(CBIN20),CBIN0 MOVE GTUSED(CBIN21),CBIN0 MOVE GTREGDEX,$W CBG SPBINW2,CBIN3,TRGEN1 PERF PACKST,CBIN15 PERF WRITFD BOK TRGEN1 MOVE SPBINW4,CBIN17 PERF SPERR B TRGEN9 TRGEN1 PERF PACKCL TRGEN9 RET PEND NULSTIL PROC MOVE GTREGF(CBIN14),=D'0' MOVE GTREGF(CBIN15),=D'0' MOVE GTREGF(CBIN16),=D'0' MOVE GTREGF(CBIN17),=D'0' MOVE GTREGF(CBIN18),=D'0' MOVE GTREGF(CBIN19),=D'0' MOVE GTREGF(CBIN20),=D'0' MOVE GTREGF(CBIN21),=D'0' RET PEND EJECT BU00FRMT FRMT MENU FSL FCOPY =X'5C343020' FCOPY ='BUDGETTAL ' FCOPY ='UDEN ' FCOPY ='BUDGETTERINGSKODE' FNL FCOPY =X'5C343120' FCOPY ='BUDGETTAL ' FCOPY ='MED ' FCOPY ='BUDGETTERINGSKODE' FNL FCOPY =X'5C343220' FCOPY ='[NDRING/SLETNING AF ' FCOPY ='BUDGETTAL ' FCOPY ='MED ' FCOPY ='BUDGETTERINGSKODE' FNL FCOPY =X'5C343520' FCOPY ='TILL[GSBEV. BUDGET ' FNL FCOPY =X'5C343620' FCOPY ='OMPLACERINGER ' FNL FCOPY =X'5C343720' FCOPY ='SUM AF R]DIGHEDSB. ' FNL FCOPY =X'5C343820' FCOPY ='ANL[GSUDGIFTER-TB ' FNL FCOPY =X'5C343920' FCOPY ='ANL[GSINDT[GTER-TB ' FNL FNL FCOPY ='INDTAST TRANSKODE:' FILLR X'5C',1 FKI 29,MINL=2,MAXL=2,NUM FMEL 'XX',GTREGNR FNL FCOPY ='ELLER TRYK "KVIT" ELLER "KRE"' FMEND BUSPFRMT FRMT FSL FCOPY ='INDTAST TRANSKODE: ' FILLR X'5C',1 FKI 21,MINL=2,MAXL=2,ME,NUM FMEL 'ZZ',GSWBCD6 FTAB 25 FCOPY ='PLUS' FCOPY ='REGKONTONR:' FKI 41,MINL=4,MAXL=10,ME,NUM,REWRT FMEL '999E-999E-99E-99',GSWBCD7 FMEND BU40FRM FRMT FSL FCOPY =X'5C343020' FLINK BUSUB1 FLINK BUSUB2 FMEND BU41FRM FRMT FSL FCOPY =X'5C343120' FLINK BUSUB1 FLINK BUSUB3 FLINK BUSUB2 FMEND BU42FRM FRMT FSL FCOPY =X'5C343220' FLINK BUSUB1 FLINK BUSUB3 FLINK BUSUB2 FMEND BU45FRM FRMT FSL FCOPY =X'5C343520' FCOPY ='TILL[GSBEV. BUDGET ' FLINK BUSUB4 FLINK BUSUB5 FMEND BU46FRM FRMT FSL FCOPY =X'5C343620' FCOPY ='OMPLACERINGER ' FLINK BUSUB4 FILLR ' ',5 FCOPY ='DET.KODE/LBNR: ' FLINK BUSUB7 FLINK BUSUB5 FMEND BU47FRM FRMT FSL FCOPY =X'5C343720' FCOPY ='SUM AF R]DIGHEDSB. ' FNL FLINK BUBEL1 FLINK BUSUB8 FLINK BUSUB5 FMEND BU48FRM FRMT FSL FCOPY =X'5C343820' FCOPY ='ANL[GSUDGIFTER-TB ' FLINK BUSUB6 FLINK BUSUB9 FMEND BU49FRM FRMT FSL FCOPY =X'5C343920' FCOPY ='ANL[GSINDT[GTER-TB ' FLINK BUSUB6 FLINK BUSUB9 FMEND BUBEL1 FRMT FCOPY ='BUDGETBEL' FILLR X'5C',1 FCOPY ='B ]R: ' FMEND BUSUB1 FRMT FCOPY ='INDBERETNING LOKAL' FILLR ' ',18 FCOPY ='PRISREG.KODE: ' FKI 55,APPL=64,MINL=1,MAXL=1,ME,DUPL=GTDUPF(CBIN12) FMEL 'X',GTREGF(CBIN12) FNL FNL FCOPY ='LINNR: ' FMEL 'ZZZ9',GTANTAL FILLR ' ',5 FCOPY ='REGKONTONR:' FKI 33,APPL=5,MINL=10,MAXL=10,ME,SCHK=1,REWRT, C DUPL=GTDUPF(CBIN1) FMEL '999E-999E-99E-99',GTREGF(CBIN1) FMEND BUSUB2 FRMT FNL FNL FCOPY ='BUDGET]R' FMEL 'B99',GTDUPF(CBIN14) FCOPY =' BUDGET]R' FMEL 'B99',GTDUPF(CBIN15) FNL FKI 1,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=55 FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN3) FKI 14,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=56, C DUPL=GTREGF(CBIN3) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN4) FNL FNL FCOPY ='BUDGET]R' FMEL 'B99',GTDUPF(CBIN16) FCOPY =' BUDGET]R' FMEL 'B99',GTDUPF(CBIN17) FCOPY =' BUDGET]R' FMEL 'B99',GTDUPF(CBIN18) FCOPY =' BUDGET]R' FMEL 'B99',GTDUPF(CBIN19) FCOPY =' BUDGET]R' FMEL 'B99',GTDUPF(CBIN20) FCOPY =' BUDGET]R' FMEL 'B99',GTDUPF(CBIN21) FNL FKI 1,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=57, C DUPL=GTREGF(CBIN4) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN5) FKI 14,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=58, C DUPL=GTREGF(CBIN5) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN6) FKI 27,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=59, C DUPL=GTREGF(CBIN6) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN7) FKI 40,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=60, C DUPL=GTREGF(CBIN7) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN8) FKI 53,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=61, C DUPL=GTREGF(CBIN8) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN9) FKI 66,MINL=1,MAXL=10,NUM,SCHK=4,REWRT,APPL=62, C DUPL=GTREGF(CBIN9) FMEL 'ZZZZZZZVZZX-B',GTREGF(CBIN10) FNL FNL FNL FNL FCOPY ='TOTAL:' FNL FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN14) FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN15) FNL FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN16) FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN17) FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN18) FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN19) FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN20) FMEL 'ZZZZZZZVZZ9-B',GTREGF(CBIN21) FMEND BUSUB3 FRMT FILLR ' ',3 FCOPY ='BUDGETTERINGSKODE: ' FKI 67,APPL=54,MINL=1,MAXL=10,ME,REWRT, C DUPL=GTDUPF(CBIN2) FMEL 'XBXXXXBXXXBXX',GTREGF(CBIN2) FMEND BUSUB4 FRMT FLINK BUSUB6 FILLR ' ',5 FLINK BUBEL1 FKI 52,MINL=2,MAXL=2,ME,NUM,APPL=120, C DUPL=GTPRTDAT FMEL 'XX',GTREGF(CBIN14) FMEND BUSUB5 FRMT FNL FCOPY ='REGKONTONR ' FILLR ' ',4 FLINK BUBEL1 FNL FKI 1,MINL=10,MAXL=10,ME,SCHK=1,NUM,REWRT,APPL=5 FMEL '999E-999E-99E-99',GTREGF(CBIN1) FKI 16,MINL=1,MAXL=11,ME,APPL=57,NUM,SCHK=4,REWRT FMEL 'ZZZZZZZVZZX-',GTREGF(CBIN17) FMEND BUSUB6 FRMT FNL FNL FCOPY ='TILL[GSBEV.DATO: ' FKI 18,MINL=6,MAXL=6,APPL=63, C ME,NUM,REWRT,SCHK=2,DUPL=GTDUPF(CBIN11) FMEL 'XXVXXVXX',GTREGF(CBIN11) FMEND BUSUB7 FRMT FKI 75,NUM,MINL=1,MAXL=4,APPL=65,ME,DUPL=GTDUPF(CBIN13) FMEL 'XXXX',GTREGF(CBIN13) FMEND BUSUB8 FRMT FKI 18,MINL=2,MAXL=2,NUM,ME,APPL=120,DUPL=GTPRTDAT FMEL 'XX',GTREGF(CBIN14) FMEND BUSUB9 FRMT FNL FCOPY ='PROJEKT NR ' FILLR ' ',4 FLINK BUBEL1 FNL FKI 1,MINL=4,MAXL=4,ME,NUM,REWRT, C APPL=5,DUPL=GTDUPF(CBIN1) FMEL 'XXXX',GTREGF(CBIN1) FKI 16,MINL=1,MAXL=11,ME,APPL=56,NUM,SCHK=4,REWRT FMEL 'ZZZZZZZVZZX-',GTREGF(CBIN4) FMEND BUSUB10 FRMT FILLR '0',2 FCOPY GTREMBUF FEOR FMEND STJFRM FRMT FILLR '*',5 FMEND PCKINIT FRMT FILLR ' ',40 FILLR ' ',40 FBT GTSWFLAG,PCKI10 FILLR X'00',48 FEXIT PCKI10 FILLR ' ',48 FMEND END