|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/36 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/36 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10752 (0x2a00)
Notes: MEMBER_S, Member_Text
Names: »BOG070 «
└─⟦2142406c2⟧ Bits:30009842 APAR ÅÅBOG ØLIBRARY - Seebach Data Aps
└─⟦1fc10e824⟧
└─⟦this⟧ ».BOG070 «
U B BOG070
H/TITLE *BOG070* FORESP@RGSEL P$ KONTOPLAN
H 18 D.J 1 BOG070
F****************************************************************
F* *
F* COPYRIGHT= *
F* 5797-TFT COPYRIGHT IBM DANMARK 1983 LICENSED MATERIAL - *
F* PROGRAM PROPERTY OF IBM *
F* DER HENVISES TIL INSTRUCTIONS ON COPYRIGHT NOTICE - FORM *
F* NO G120-2083 *
F* ----------------------------------------------------------- *
F* RPG SRT *
F* PROGRAM B O G 0 7 0 - FORESP@RGSEL P$ KONTOPLAN *
F* ----------- *
F* *
F* FORESP@RGSEL P$ ENKELTE KONTI MED MULIGHED FOR AT SE DE *
F* ENKELTE POSTERINGER I HVILKEN SOM HELST PERIODE. *
F* *
F****************************************************************
F/COPY FMBOG,KPLAN
FPLAN I
F/COPY FMBOG,BPOST
FPOST IF L
F/COPY FMBOG,BKODE
FLISTE O 82 82 OF PRINTER
E UL 13 11 2 PRIMO/ULTIMO PER.
E TABMO 1 12 2 0ATABPE 2 0 REGNSK.$R
E M$N 1 12 9 M$NEDSNAVN
E COIBM 1 1 79 COPYRIGHT NOTICE
FSK#RM CD F 666 WORKSTN
F KSLN VLN
F KID WS
F KINFDS EXERDS
F KINFSR EXER
ISK#RM NS 40 1 C0
I* FORMAT- BOG07000
I 2 90KTOKEY
I NS 41 1 C1
I* FORMAT- BOG07002
I 2 30P0
I NS
I* DS TIL KEY
I DS
I 1 10FI
I 2 30AFD
I 4 80KTONR
I 1 80KTOKEY
I DS
I 1 80GEMKTO
I 9 100GP0
I 11 160NULDAT
I 1 16 PSTKEY
I DS
I 1 60DATO
I 1 20$R
I 3 40MD
I 5 60DG
I 7 100MIC
I 7 12 MSG
I 13 190WRK07
I* X OG Y FLYTTET 10 POS. OPAD /PS 1987
I 26 270X
I 28 290Y
I 20 250TMS
I 20 230TM
I 24 250M
IEXERDS DS
I *STATUS STATUS
C* I N D I K A T O R O V E R S I G T
C*
C* 40 - INPUT AF KONTONUMMER
C* 41 - INPUT AF CMD-KEY ELLER @NSKET PERIODE
C* 49 - EXEPTION/ERROR CONDITION I SK#RM-FILE
C* 50 - OUTPUT AF SK#RMBILLEDE FOR INPUT AF KONTONUMMER
C* 51 - OUTPUT AF SK#RMBILLEDE MED KONTOOPLYSNINGER
C* 52 - OUTPUT AF SK#RMBILLEDE MED INPUT AF CMD EL. PERIODE
C* 53 - OUTPUT AF HEADINGS TIL POSTERINGER
C* 54 - OUTPUT AF POSTERINGER MED VLN
C* 60 - IKKE FLERE POSTERINGER P$ DENNE KONTO
C* 61 - IKKE FLERE POSTERINGER I DENNE PERIODE
C* 62 - INGEN POSTERINGER P$ DENNE KONTO
C* 64 - PRIMO SALDO ER KREDIT
C* 65 - POSTERINGSBEL@B ER KREDIT
C* 66 - ULTIMO SALDO ER KREDIT
C* 67 - MOMSBEL@B UDTRUKKET
C* 70 - BILLEDE MED KONTOOPLYSNINGER VISES
C* 71 - STYRING AF F@RSTE PRINT HEADING
C* 72 - UDSKRIFT AF HEADINGS FOR KONTO
C* 73 - UDSKRIFT AF PRIMOSALSO
C* 74 - UDSKRIFT AF POSTERINGER
C* 75 - UDSKRIFT AF ULTIMOSALDO
C* 76 - END OF FILE POST
C* 77 - BLADRE FREM
C SETON 9098
C U8 SETOF 98
C READ TAG
C SETOF 404149
C SETOF 505152
C SETOF 535475
C SETOF 8083KC
C READ SK#RM 4980
C 80 SETON LR
C 80 GOTO END
C*
C KG GOTO END
C*
C 49 EXSR EXER EXCPT/ERROR
C 49 GOTO DISP2
C* TEST OM 'STOP SYSTEM' @NSKET
C SHTDN 80
C 80 SETOF 90
C*
C 40 GOTO REC0
C 41 GOTO REC1
C*
C 89 Z-ADD4 MIC MSG 4
C 89 SETON 83
C 89 GOTO STARTX
C SETON 89
C TIME TMS
C*
C START0 TAG
C SETOF 606162
C SETON 50
C*
C STARTX TAG
C EXCPT
C GOTO READ
C*
C******************************************************
C* BEHANDLING AF SK#RMBILLEDE 0 - FORMAT BOG07000 *
C* KONTONUMMER *
C******************************************************
C REC0 TAG
C*
C EXSR CHAIN
C N02 SETON 80
C 80 Z-ADD13 MIC 83 MSG 13
C 83 GOTO START0
C* HENT TEKSTER FRA KODEKARTOTEK
C MOVE 'A ' KEY
C MOVELFI KODE FIRMA
C EXSR CHNKOD
C MOVE 'B' TYPE
C MOVE AFD KODE AFDELING
C EXSR CHNKOD
C MOVE STAKOD STAKOP 1
C EXSR BUDGET
C* BEREGN PRIMO/ULTIMO SALDI PR. PERIODE
C Z-ADDCBALF UL,1
C Z-ADD1 X
C Z-ADD2 Y
C ULTSUM TAG
C UL,X ADD CAM,X UL,Y
C ADD 1 X
C ADD 1 Y
C X COMP 12 80
C N80 GOTO ULTSUM
C* ULTIMO SIDSTE $R
C XFOOTPAM ULTS$ 112
C ADD PBALF ULTS$
C Z-ADDKTOKEY GEMKTO
C XFOOTREL WRK07 62
C*
C DISP0 TAG
C SETOF 6061
C SETON 515270
C GOTO STARTX
C*
C******************************************************
C* BEHANDLING AF SK#RMBILLEDE 1 - FORMAT BOG07002 *
C* CMD-KEY ELLER @NSKET PERIODE *
C******************************************************
C REC1 TAG
C*
C KA GOTO START0
C*
C KC 62 Z-ADD2 MIC 83 MSG 2
C KC 70 Z-ADD1 GP0 SKRIV $RETS
C KCN83 EXSR PRINT SKRIV POSTER
C KC 70 Z-ADD0 GP0 NULSTIL
C KC GOTO DISP2
C*
C Z-ADDP0 P0 8380
C 80 Z-ADDGEMKTO KTOKEY
C 80 GOTO DISP0
C N83 P0 COMP 12 83
C 83 Z-ADD1001 MIC MSG 1001
C 83 GOTO DISP2
C Z-ADDREL,P0 WRK07 83
C 83 Z-ADD71 MIC MSG 71
C 83 GOTO DISP2
C Z-ADD0 LIN 40
C Z-ADDP0 GP0
C EXSR POSTER
C* DISPLAY BILLEDE 2 MED DATA 1
C DISP2 TAG
C SETON 52
C GOTO STARTX
C*
C END TAG
C*
C******************************************************
C* S U B R U T I N E R *
C* ------------------- *
C******************************************************
C* C H A I N
C* CHAIN TIL KONTOPLAN - - - - -
C*
C CHAIN BEGSR
C SETOF 0102
C KTOKEY CHAINPLAN 80
C ENDSR
C****************************************************** E X E R
C* - - - -
C* BEHANDLING AF EXEPTION/ERROR FRA SK#RM
C*
C EXER BEGSR
C STATUS COMP 01122 80
C 80 GOTO ROLUP ROLL UP
C STATUS COMP 01123 80
C 80 GOTO ROLDWN ROLL DOWN
C GOTO EXER98
C ROLUP TAG
C 62 Z-ADD2 MIC 83 MSG 2
C 83 GOTO EXER98
C 70 Z-ADD0 GP0
C ROLU01 TAG
C 70 ADD 1 GP0
C 70 Z-ADDREL,GP0 WRK07 80
C 70 80 GOTO ROLU01
C*
C 60 Z-ADD2 MIC 83 MSG 2
C 83 GOTO EXER98
C*
C 61 Z-ADDPOSTPR GP0
C 61 Z-ADD0 LIN
C N61N70 SETON 77
C GOTO EXER97
C***
C ROLDWN TAG
C 62 Z-ADD2 MIC 83 MSG 2
C 83 GOTO EXER98
C 70 Z-ADD13 GP0
C ROLD01 TAG
C 70 GP0 SUB 1 GP0
C 70 Z-ADDREL,GP0 WRK07 80
C 70 80 GOTO ROLD01
C 70 GOTO EXER97
C*
C LIN COMP 10 80
C 80 Z-ADD0 LIN
C 80 SETOF 60
C 80 GOTO EXER97
C*
C Z-ADDGP0 P0
C ROLD02 TAG
C SUB 1 P0 83
C 83 Z-ADD2 MIC MSG 2
C 83 GOTO EXER98
C REL,P0 COMP 0 80
C 80 GOTO ROLD02
C SETOF 60
C Z-ADDREL,P0 WRK07
C Z-ADDP0 GP0
C Z-ADD0 LIN
C*
C EXER97 TAG
C EXSR POSTER
C EXER98 TAG
C ENDSR
C****************************************************** P O S T E R
C* - - - - - -
C* DISPLAY DE ENKELTE POSTERINGER MED VLN
C*
C POSTER BEGSR
C SETOF 617660
C SETON 53
C Z-ADD0 VLN
C 70 Z-ADD0 LIN
C GP0 ADD 1 PU 20
C Z-ADDUL,GP0 UL,GP0 64
C Z-ADDUL,PU UL,PU 66
C GP0 LOKUPTABPE TABMO 80
C Z-ADDTABMO M
C N77 PSTKEY SETLLPOST
C SETOF 77
C POST01 TAG
C ADD 1 VLN
C VLN COMP 10 80
C 80 GOTO POST98
C ADD 1 LIN
C READ POST 76
C 76 SETON 60
C 76 GOTO POST98
C KTOKEY COMP GEMKTO 6060
C 60 GOTO POST98
C POSTPR COMP GP0 6161
C 61 GOTO POST98
C Z-ADDBEL@B BEL@B 65
C BRUTTO COMP BEL@B 6767
C Z-ADDBILDAT DATO
C MOVELDG BILDAT
C MOVE $R BILDAT
C SETON 54
C EXCPT
C SETOF 5354
C****** ADD 1 LIN
C GOTO POST01
C POST98 TAG
C SETOF 70
C ENDSR
C****************************************************** P R I N T
C* - - - - -
C* KONTROL AF UDSKRIFT P$ PRINTER
C*
C PRINT BEGSR
C PSTKEY SETLLPOST
C Z-ADD0 PAGE 76
C 70 Z-ADDUL,1 UL,1 64 DEB/KRE ?
C 70 Z-ADDUL,13 UL,13 66 DEB/KRE ?
C SETON 73OF NY SIDE/KONTO
C PRIN01 TAG
C READ POST 76
C 76 GOTO PRIN80
C KTOKEY COMP GEMKTO 8080
C N70N80 POSTPR COMP GP0 8080
C 80 GOTO PRIN80
C Z-ADDBEL@B BEL@B 65
C BRUTTO COMP BEL@B 6767
C Z-ADDBILDAT DATO
C MOVELDG BILDAT
C MOVE $R BILDAT
C SETON 74
C OF
CORN71 SETON 7172
C SETOF OF
C EXCPT
C SETOF 727374
C GOTO PRIN01
C*
C PRIN80 TAG
C SETON 75
C ENDSR
C/COPY FMBOG,BOGKOD
C/COPY FMBOG,BOGBUL
OSK#RM E 50
O K8 'BOG07000'
O WS 2
O UDATE Y 10
O 83MSG 16
O E 51
O K8 'BOG07001'
O FI 1
O FITXT 31
O STAKOP 32
O AFD 34
O AFDTXT 64
O PALCD 66
O KTONR 71
O KTONVN 101
O MOMKT1 102
O PBALF J 117
O CBALF J 132
O PAM,1 J 147
O CAM,1 J 162
O BUD,1 K 174
O PAM,2 J 189
O CAM,2 J 204
O BUD,2 K 216
O PAM,3 J 231
O CAM,3 J 246
O BUD,3 K 258
O PAM,4 J 273
O CAM,4 J 288
O BUD,4 K 300
O PAM,5 J 315
O CAM,5 J 330
O BUD,5 K 342
O PAM,6 J 357
O CAM,6 J 372
O BUD,6 K 384
O PAM,7 J 399
O CAM,7 J 414
O BUD,7 K 426
O PAM,8 J 441
O CAM,8 J 456
O BUD,8 K 468
O PAM,9 J 483
O CAM,9 J 498
O BUD,9 K 510
O PAM,10J 525
O CAM,10J 540
O BUD,10K 552
O PAM,11J 567
O CAM,11J 582
O BUD,11K 594
O PAM,12J 609
O CAM,12J 624
O BUD,12K 636
O ULTS$ J 651
O UL,13 J 666
O E 53
O K8 'BOG07003'
O GP0 Z 2
O M$N,M 11
O N64 UL,GP01 25
O 64 UL,GP01 38
O E 54
O K8 'BOG07004'
O LIN Z 4
O BILDATY 12
O BILAG Z 18
O TEKST 48
O N65 BEL@B 1 61
O 65 BEL@B 1 74
O 67 49 'M'
O E 60N83NKC
O OR 61N83NKC
O K8 'BOG07005'
O N66 UL,PU 1 14
O 66 UL,PU 1 27
O 60 31 '0072'
O 61 31 '0073'
O E 52
O K8 'BOG07002'
O 83MSG 6
OLISTE E 102 72
O 5 'DATO'
O UDATE Y 14
O 19 'KL'
O TM Y 25
O 44 'KONTOUDSKRIFT'
O FI 51
O FITXT 82
O E 2 72
O 70 20 'PERIODE : HELE $RET'
O N70 8 'PERIODE'
O N70 GP0 11
O N70 15 'MD'
O N70 M$N,M 25
O U8 47 '*EFTERPOSTERINGER*'
O AFD 51
O AFDTXT 82
O E 2 72
O KTOKEY 13 '0 - - - '
O KTONVN 45
O 77 'SIDE'
O PAGE Z 82
O E 1 72
O 13 'DATO'
O 29 'BILAG TEKST'
O 56 'MOMS'
O 68 'DEBET'
O 68 'DEBET'
O 80 'KREDIT'
O E 1 73
O 37 '** PRIMO SALDO'
O N64 UL,GP01 68
O 64 UL,GP01 80
O E 1 74
O BILDATY 15
O BILAG Z 22
O TEKST 54
O N65 BEL@B 1 68
O 65 BEL@B 1 80
O 67 56 'M'
O E 1 75
O 38 '** ULTIMO SALDO'
O N66N70UL,PU 1 68
O 66N70UL,PU 1 80
O N66 70UL,13 1 68
O 66 70UL,13 1 80
O/COPY FMBOG,BOG$R
**
JANUAR
FEBRUAR
MARTS
APRIL
MAJ
JUNI
JULI
AUGUST
SEPTEMBER
OKTOBER
NOVEMBER
DECEMBER
**
5797-TFT COPYRIGHT IBM DANMARK 1983 LICENSED MATERIAL - PROGRAM PROPERTY OF IBM