DataMuseum.dk

top - metrics - download

    Length: 12726 (0x31b6)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSBPY«

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYSBPY« 

SPC/1 COMAL-80

00100 // **************************************************
00110 // *………………………………………………………………………………………………………………………………*
00120 // *…………………………Bogf|ringssystemet…'SYS-KAS'…………………………*
00130 // *………………………………………………vers.…1.0………………………………………………………*
00140 // *………………………………………………………………………………………………………………………………*
00150 // *…Udviklet…marts…1983…p}…en…'SPC/1'…mikrodatamat…*
00160 // *…Programsystemet…er…skrevet…i…COMAL80…vers.…1.2…*
00170 // *………………………………………………………………………………………………………………………………*
00180 // *…Udviklet…af…:…Peter…Kristensen……………………………………………*
00190 // *………………………………………Vestervang…6,…6920…Videb{k…………………*
00200 // *………………………………………………………………………………………………………………………………*
00210 // *………(C)…………………:…forlaget…systime…a/s…………………………………*
00220 // *………………………………………Klokkebakken…20,…Gjellerup…………………*
00230 // *………………………………………7400……Herning……………………………………………………*
00240 // **************************************************
00250 EXEC DIMENSIONER
00260 EXEC INITIER
00270 EXEC FKT_MENU
00280 CHAIN PROGRAM $
00290 // ===========…Procedurer…starter…==============
00300 PROC DIMENSIONER
00310 // Standard…variable
00320 DIM SPC $ OF 80 , SVAR $ OF 10 , PRGFL $ OF 8 , ALFA $ OF 28 , TAL $ OF 10
00330 DIM PROGRAM $ OF 17 , PRTNR $ OF 1
00340 REAL RESRV , PPAR
00350 INTEGER OK , TRUE , FALSE , I , J
00360 // Hj{lpevariable
00370 REAL MOMS_KR , NULR
00380 INTEGER HIGH , LOW , POS , KREDIT , DEBET , LIN_T , MAX_LIN , T_IDX , K , NUL
00390 // Variable…til…filen…SYSPARA
00400 DIM SYSPARA $ OF 17
00410 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00420 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00430 // Variable…til…filen…@@PARAM
00440 DIM PARAM $ OF 17
00450 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00460 REAL MOMS
00470 // Variable…til…filen…@@KONTO
00480 DIM KONTO $ OF 17
00490 DIM ST_DATO $ OF 6
00500 INTEGER N_FRIREC , N_MAXREC , ANT_PER , PER_NR
00510 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00520 REAL KTO_PRIMO , KTO_ULTIMO
00530 INTEGER KTO_FP , KTO_SP
00540 // Variable…til…filen…@@KTOIDX
00550 DIM KTOIDX $ OF 17
00560 INTEGER I_H\JREC , I_MAXREC
00570 DIM KTONR $ OF 8
00580 INTEGER RECNR
00590 // Variable…til…filen…@@DG_POS
00600 DIM DG_POS $ OF 17
00610 DIM P_BDAT $ OF 6
00620 REAL P_DEB , P_KRED
00630 INTEGER P_H\JREC , P_MAXREC , S_NR_DG_POS
00640 DIM P_BKTO $ OF 8 , P_MKOD $ OF 1 , P_BNR $ OF 5 , P_TXT $ OF 20
00650 REAL P_BKR
00660 INTEGER P_DK
00670 // Variable…til…filen…@@ST_KTO
00680 DIM ST_KTO $ OF 17
00690 DIM UDMOMS_KTO $ OF 8 , INDMOMS_KTO $ OF 8
00700 // Variable…til…file…@@TRANS
00710 DIM TRANS $ OF 17
00720 INTEGER T_H\JREC , T_MAXREC
00730 DIM BKTONR $ OF 8 , BDATO $ OF 6 , BLGNR $ OF 5 , BTXT $ OF 20
00740 REAL BMOMS , BBEL\B
00750 INTEGER DK , NTRANS
00760 ENDPROC DIMENSIONER
00770
00780 PROC INITIER
00790 LET PRGFL $ := "DP2"
00800 LET PROGRAM $ := PRGFL $ + ":SYSKA"
00810 LET TAL $ := "0123456789"
00820 FOR I := ╱cc╱ ( "A" ) TO ( "]" ) DO LET ALFA $ := ALFA $ + CHR$ ( I )
00830 LET SPC $ := "………………………………………………………………………………………………………………………"
00840 LET SPC $ := SPC $ + SPC $ ; NUL := 0 ; NULR := 0
00850 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00860 LET KREDIT := - 1 ; DEBET := 1
00870 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00880 EXEC OPENFIL ( SYSPARA $ , "R" )
00890 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00900 EXEC TERMINAL_IDX
00910 CLOSE SYSPARA $
00930 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00940 EXEC OPENFIL ( PARAM $ , "R" )
00950 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00960 CLOSE PARAM $
00970 LET KTOIDX $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOIDX"
00980 LET KONTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KONTO"
00990 LET DG_POS $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "DG_POS"
01000 LET TRANS $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "TRANS"
01010 LET ST_KTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "ST_KTO"
01020 EXEC OPENFIL ( KTOIDX $ , "R" )
01030 EXEC OPENFIL ( KONTO $ , "W" )
01040 EXEC OPENFIL ( DG_POS $ , "W" )
01050 EXEC OPENFIL ( TRANS $ , "W" )
01060 EXEC OPENFIL ( ST_KTO $ , "R" )
01070 GET ST_KTO $ , 5 : INDMOMS_KTO $
01080 GET ST_KTO $ , 6 : UDMOMS_KTO $
01090 CLOSE ST_KTO $
01100 ENDPROC INITIER
01110
01120 PROC TERMINAL_IDX
01130 LET PPAR := 5 ; RESRV := 0
01140 CALL T"DDE:PRES"
01150 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01160 ENDPROC TERMINAL_IDX
01170
01180 PROC OPENFIL ( FNAVN $ , WAY $ )
01190 REPEAT
01200 IF AY $ = "W" OR WAY $ = "w" THEN
01210 OPEN FNAVN $ , W
01220 ELSE
01230 OPEN FNAVN $ , R
01240 ENDIF
01250 IF ( FNAVN $ ) THEN
01260 PRINT "<SC0123>" ; CHR$ ( 7 )
01270 IF ( FNAVN $ ) = 6 THEN
01280 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
01290 INPUT "" : SVAR $
01300 ELSE
01310 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01320 PRINT "<S>" ; FNAVN $ ; "…***"
01330 INPUT "" : SVAR $
01340 PRINT "<C0102>" ; SPC $
01350 ENDIF
01360 ENDIF
01370 UNTIL NOT ╱cd╱ ( FNAVN $ )
01380 ENDPROC OPENFIL
01390
01400 PROC TAL_CONTROL ( REF RST $ )
01410 LET J := 0 ; OK := TRUE
01420 FOR I := 1 TO ( RST $ ) DO
01430 IF RST $ ( I ) IN TAL $ + "." THEN LET J := J + 1 ; RST $ ( J ) := RST $ ( I )
01440 NEXT I
01450 IF = 0 THEN
01460 LET OK := FALSE
01470 ELSE
01480 LET RST $ := RST $ ( 1 : J )
01490 ENDIF
01500 ENDPROC TAL_CONTROL
01510
01520 PROC DIV_POSHOVED
01530 EXEC OVERSKRIFT ( "BOGF\RING…AF…DIVERSE…POSTERINGER" , 4 )
01530 PRINT "<C0105>………BILAG……TEKST……………………………………………MOMS……KO"
01540 PRINT "<C0106>…………NR……………………………………………………………………KODE……NU"
01550 PRINT "<C0107>----------------------------------------"
01560 PRINT "<C4105>NTO-…………………DEBET………………KREDIT………………F/R/S…"
01570 PRINT "<C4106>MMER……………………………………………………………………………………………"
01580 PRINT "<C4107>----------------------------------------"
01590 ENDPROC DIV_POSHOVED
01600
01610 PROC OVERSKRIFT ( ST $ , L )
01620 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01630 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01640 PRINT SYST_DAT $ ( 5 : 2 )
01660 CURSOR 34 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
01670 PRINT "***…" ; ST $ ; "…***"
01680 ENDPROC OVERSKRIFT
01690
01700 PROC SL_FEJLLINIE
01710 LET OK := TRUE
01720 PRINT "<C0102>" ; SPC $
01730 ENDPROC SL_FEJLLINIE
01740
01750 PROC FEJL ( ST $ )
01760 LET OK := FALSE
01770 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
01780 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
01790 ENDPROC FEJL
01800
01810 PROC L[S_KONTO ( P )
01820 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
01830 ENDPROC L[S_KONTO
01840
01850 PROC ST_BGST ( REF RST $ )
01860 FOR I := 1 TO ( RST $ ) DO
01870 IF RST $ ( I ) =< "}" AND RST $ ( I ) >= "a" THEN LET RST $ ( I ) := CHR$ ( ╱cc╱ ( RST $ ( I ) ) - 32 )
01880 NEXT I
01890 ENDPROC ST_BGST
01900 PROC FIND_KTO ( REF R_KTONR $ )
01910 LET OK := FALSE
01920 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
01930 LET LOW := 1 ; HIGH := I_H\JREC + 1 ; POS := 2
01940 IF IGH > 1 THEN
01950 REPEAT
01960 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
01970 GET KTOIDX $ , POS : KTONR $ , RECNR
01980 IF TONR $ > R_KTONR $ THEN
01990 LET HIGH := POS
02000 ELSE
02010 IF TONR $ < R_KTONR $ THEN
02020 LET LOW := POS
02030 ENDIF
02040 ENDIF
02050 UNTIL HIGH - LOW =< 1 OR R_KTONR $ = KTONR $
02060 IF KTONR $ = R_KTONR $ THEN LET OK := TRUE
02070 ENDIF
02080 LET FIND_KTO := POS
02090 ENDPROC FIND_KTO
02100
02110 PROC SKRIV_DG_POS ( P )
02120 PUT DG_POS $ , P + 1 : P_BKTO $ , P_MKOD $ , P_BNR $ , P_TXT $ , P_BKR , P_DK
02130 ENDPROC SKRIV_DG_POS
02140
02150 PROC L[S_DG_POS ( P )
02160 GET DG_POS $ , P + 1 : P_BKTO $ , P_MKOD $ , P_BNR $ , P_TXT $ , P_BKR , P_DK
02170 ENDPROC L[S_DG_POS
02180
02190 PROC SKRIV_LIN ( R_LIN )
02200 IF P_BNR $ = "*****" THEN EXIT
02210 LET R_SLIN := R_LIN MOD 12 + 7
02220 IF R_SLIN = 7 THEN LET R_SLIN := 12 + R_SLIN
02230 CURSOR 1 , R_SLIN
02240 PRINT CHR$ ( R_LIN , 2 )
02250 CURSOR 4 , R_SLIN
02260 PRINT P_BNR $
02270 CURSOR 11 , R_SLIN
02280 PRINT P_TXT $
02290 CURSOR 34 , R_SLIN
02300 PRINT P_MKOD $
02310 CURSOR 39 , R_SLIN
02320 PRINT P_BKTO $
02330 IF _DK = DEBET THEN
02340 CURSOR 49 , R_SLIN
02350 ELSE
02360 CURSOR 61 , R_SLIN
02370 ENDIF
02380 PRINT CHR$ ( P_BKR , 7 , 2 )
02390 ENDPROC SKRIV_LIN
02400
02410 PROC UDSKRIV_POSTER
02420 EXEC OVERSKRIFT ( "Udskrivning…af…konteringsliste" , 7 )
02420 EXEC PRINTRES ( "smal…EDB-liste" , 12 )
02440 LET LIN_T := 100 ; MAX_LIN := 72
02450 GET DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
02460 LET P_DEB , P_KRED := 0
02470 FOR J := 1 TO _H\JREC - 1 DO
02480 EXEC L[S_DG_POS ( J )
02490 EXEC PRINT_LIN
02500 NEXT J
02510 IF LIN_T >< 100 THEN EXEC AFSLUT
02520 EXEC PRINTREL
02530 PUT DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
02540 ENDPROC UDSKRIV_POSTER
02550
02560 PROC SIDESKIFT
02570 FOR I := LIN_T TO AX_LIN DO PRINT
02580 LET LIN_T := 9
02590 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 58 ) ; "SIDE:…" ; S_NR_DG_POS
02600 PRINT
02610 PRINT "Firmanavn:…" ; FIRMANAVN $
02620 PRINT
02630 PRINT "<S>***…KONTERINGSLISTE…PR.…" ; P_BDAT $ ( 1 : 2 ) ; "." ; P_BDAT $ ( 3 : 2 ) ; "."
02640 PRINT "<S>" ; P_BDAT $ ( 5 : 2 ) ; "…**…**…UDSKREVET…PR.…"
02650 PRINT SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ; SYST_DAT $ ( 5 : 2 ) ; "…***"
02660 PRINT
02660 PRINT "<S>BILAG……TEKST……………………………………………MK……KONTONR……………DEBET………"
02680 PRINT "…………KREDIT……"
02680 PRINT "<S>-----……--------------------……--……--------……----------"
02700 PRINT "……----------"
02710 IF _DEB > 0 OR P_KRED > 0 THEN
02720 PRINT TAB ( 8 ) ; "TRANSPORT" ; TAB ( 41 ) ; CHR$ ( P_DEB , 9 , 2 ) ; CHR$ ( P_KRED , 9 , 2 )
02730 LET LIN_T := LIN_T + 1
02740 ENDIF
02750 LET S_NR_DG_POS := S_NR_DG_POS + 1
02760 ENDPROC SIDESKIFT
02770
02780 PROC PRINT_LIN
02790 IF P_BNR $ = "*****" THEN EXIT
02800 IF IN_T + 5 > MAX_LIN THEN
02810 IF _DEB > 0 OR P_KRED > 0 THEN
02810 PRINT "<S>-----……--------------------……--……--------……----------……"
02830 PRINT "----------"
02840 PRINT TAB ( 9 ) ; "TRANSPORT" ; TAB ( 41 ) ; CHR$ ( P_DEB , 9 , 2 ) ; CHR$ ( P_KRED , 9 , 2 )
02850 LET LIN_T := LIN_T + 2
02860 ENDIF
02870 EXEC SIDESKIFT
02880 ENDIF
02890 LET LIN_T := LIN_T + 1
02900 PRINT "<S>" ; P_BNR $ ; TAB ( 11 ) ; P_TXT $ ; TAB ( 33 ) ; P_MKOD $ ; TAB ( 37 )
02910 PRINT "<S>" ; P_BKTO $ ; TAB ( 14 )
02920 IF _DK = DEBET THEN
02930 PRINT CHR$ ( P_BKR , 7 , 2 )
02940 LET P_DEB := P_DEB + P_BKR
02950 ELSE
02960 PRINT TAB ( 13 ) ; CHR$ ( P_BKR , 7 , 2 )
02970 LET P_KRED := P_KRED + P_BKR
02980 ENDIF
02990 ENDPROC PRINT_LIN
03000
03010 PROC AFSLUT
03020 LET LIN_T := LIN_T + 2
03020 PRINT "<S>-----……--------------------……--……--------……----------……"
03040 PRINT "----------"
03050 PRINT TAB ( 8 ) ; "DEBET/KREDIT…TOTAL" ; TAB ( 42 ) ; CHR$ ( P_DEB , 9 , 2 ) ;
03060 PRINT CHR$ ( P_KRED , 9 , 2 )
03070 IF _DEB > P_KRED THEN
03080 PRINT TAB ( 11 ) ; "DIFFERENCE" ; TAB ( 42 ) ; CHR$ ( P_DEB - P_KRED , 9 , 2 )
03090 LET LIN_T := LIN_T + 1
03100 ELSE
03110 IF _KRED > P_DEB THEN
03120 PRINT TAB ( 11 ) ; "DIFFERENCE" ; TAB ( 54 ) ; CHR$ ( P_KRED - P_DEB , 9 , 2 )
03130 LET LIN_T := LIN_T + 1
03140 ENDIF
03150 ENDIF
03160 FOR I := LIN_T TO AX_LIN DO PRINT
03170 ENDPROC AFSLUT
03180
03190 PROC L[S_TRANS ( P )
03200 GET TRANS $ , P : BKTONR $ , BDATO $ , BLGNR $ , BTXT $ , BMOMS , BBEL\B , DK , NTRANS
03210 ENDPROC L[S_TRANS
03220
03230 PROC SKRIV_TRANS ( P )
03240 PUT TRANS $ , P : BKTONR $ , BDATO $ , BLGNR $ , BTXT $ , BMOMS , BBEL\B , DK , NTRANS
03250 ENDPROC SKRIV_TRANS
03260
03270 PROC SKRIV_KONTO ( P )
03280 PUT KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
03290 ENDPROC SKRIV_KONTO
03300
03310 PROC BOGF\R ( REF Q_KTO $ , REF Q_DAT $ , REF Q_TXT $ , REF Q_M , REF Q_KR , Q_DK , QN $ )
03320 EXEC FIND_KTO ( Q_KTO $ )
03330 IF OK THEN
03340 EXEC FEJL ( "UKENDT…KONTONR:…" + Q_KTO $ )
03350 EXIT
03360 ELSE
03370 EXEC L[S_KONTO ( RECNR )
03380 IF TO_TYPE $ >< "A" THEN
03390 EXEC FEJL ( "ULOVLIG…KONTONR:…" + Q_KTO $ )
03400 EXIT
03410 ENDIF
03420 ENDIF
03430 GET TRANS $ , 1 : T_H\JREC , T_MAXREC
03440 IF _H\JREC = T_MAXREC THEN
03450 EXEC FEJL ( "TRANSAKTIONSFILEN…ER…FULD" )
03460 EXIT
03470 ENDIF
03480 LET T_H\JREC := T_H\JREC + 1
03490 IF TO_FP > 0 THEN
03500 EXEC L[S_TRANS ( KTO_SP )
03510 LET NTRANS := T_H\JREC
03520 EXEC SKRIV_TRANS ( KTO_SP )
03530 ELSE
03540 LET KTO_FP := T_H\JREC
03550 ENDIF
03560 LET BKTONR $ := Q_KTO $ ; BDATO $ := Q_DAT $ ; BTXT $ := Q_TXT $ ; BMOMS := Q_M ; BBEL\B := Q_KR
03570 LET DK := Q_DK ; NTRANS := NUL ; BLGNR $ := QN $
03580 EXEC SKRIV_TRANS ( T_H\JREC )
03590 LET KTO_SP := T_H\JREC
03600 IF K = DEBET THEN
03610 LET KTO_ULTIMO := KTO_ULTIMO + BBEL\B
03620 ELSE
03630 LET KTO_ULTIMO := KTO_ULTIMO - BBEL\B
03640 ENDIF
03650 EXEC SKRIV_KONTO ( RECNR )
03660 PUT TRANS $ , 1 : T_H\JREC , T_MAXREC
03670 ENDPROC BOGF\R
03680
03690 PROC BOGF\R_POSTER
03700 FOR K := 1 TO _H\JREC - 1 DO
03710 EXEC L[S_DG_POS ( K )
03720 IF _BNR $ >< "*****" THEN
03730 IF ( K + 11 ) MOD 12 = 0 THEN EXEC DIV_POSHOVED
03740 EXEC SKRIV_LIN ( K )
03750 IF /" + P_MKOD $ + "/" IN "/I/U/" THEN
03760 LET MOMS_KR := INT ( MOMS * 100 * ( P_BKR / ( MOMS + 100 ) ) + .5 ) / 100 ; P_BKR := P_BKR - MOMS_KR
03770 IF _MKOD $ = "I" THEN
03780 EXEC BOGF\R ( INDMOMS_KTO $ , P_BDAT $ , P_TXT $ , NULR , MOMS_KR , P_DK , P_BNR $ )
03790 ELSE
03800 EXEC BOGF\R ( UDMOMS_KTO $ , P_BDAT $ , P_TXT $ , NULR , MOMS_KR , P_DK , P_BNR $ )
03810 ENDIF
03820 ELSE
03830 LET MOMS_KR := 0
03840 ENDIF
03850 EXEC BOGF\R ( P_BKTO $ , P_BDAT $ , P_TXT $ , MOMS_KR , P_BKR , P_DK , P_BNR $ )
03860 LET P_BKR := 0 ; P_BNR $ := "*****"
03870 CURSOR 4 , R_SLIN
03880 PRINT "*…*…*…*…*…*…*…*…*…*…*……B…O…G…F…\…R…T……*…*…*…*…*…*…*…*…*…*…*…*" ;
03890 PRINT SPC $ ( 1 : 10 )
03900 EXEC SKRIV_DG_POS ( K )
03910 ENDIF
03920 NEXT K
03930 LET P_H\JREC := 1 ; P_DEB , P_KRED := 0
03940 PUT DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
03950 ENDPROC BOGF\R_POSTER
03960 PROC FKT_MENU
03970 EXEC UDSKRIV_POSTER
03980 EXEC BOGF\R_POSTER
03990 ENDPROC FKT_MENU
04000 //
09901 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
09902 LET PRTNR $ := "1" ; OK := TRUE
09903 REPEAT
09904 CURSOR 15 , LINE
09905 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
09906 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
09907 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
09908 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
09909 INPUT "" : SVAR $
09910 SELECT OUTPUT "P" + PRTNR $
09911 IF ( "P" ) THEN
09912 CURSOR 12 , LINE
09913 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
09914 CURSOR 12 , LINE + 1
09915 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
09916 IF VAR $ = "J" OR SVAR $ = "j" THEN
09917 CURSOR 12 , LINE
09918 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
09919 PRINT "<SZ>"
09920 WHILE ╱cd╱ ( "P" ) DO
09921 LET SEK := ╱ca╱ ( 5 )
09922 SELECT OUTPUT "P" + PRTNR $
09923 ENDWHILE
09924 ELSE
09925 LET OK := FALSE
09926 ENDIF
09927 ENDIF
09928 CURSOR 1 , LINE
09929 PRINT "<Z>"
09930 PRINT "<SZ>"
09931 ENDPROC PRINTRES
04010 //
04020 PROC PRINTREL // RELEASE…PRINTER
04030 SELECT OUTPUT "T"
04040 ENDPROC PRINTREL
00920 LET PROGRAM $ := PROGRAM $ + S_KODE $
01540 PRINT "<C0105>………BILAG……TEKST……………………………………………………………KO"
01550 PRINT "<C0106>…………NR……………………………………………………………………………………NU"
01560 PRINT "<C0107>----------------------------------------"
01570 PRINT "<C4105>NTO-…………………DEBET………………KREDIT………………F/R/S…"
01580 PRINT "<C4106>MMER……………………………………………………………………………………………"
01590 PRINT "<C4107>----------------------------------------"
01600 ENDPROC DIV_POSHOVED
01610
01620 PROC OVERSKRIFT ( ST $ , L )
01630 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01640 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01650 PRINT SYST_DAT $ ( 5 : 2 )
02430 EXEC PRINTRES ( "papir" , 12 )
02670 PRINT "<S>BILAG……TEKST………………………………………………………KONTONR……………DEBET………"
02690 PRINT "<S>-----……------------------------……--------……----------"
02820 PRINT "<S>-----……------------------------……--------……----------……"
03030 PRINT "<S>-----……------------------------……--------……----------……"
04050 //
04060 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
04070 LET PRTNR $ := "1" ; OK := TRUE
04080 REPEAT
04090 CURSOR 15 , LINE
04100 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
04110 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
04120 CURSOR 1 , LINE
04130 PRINT "<Z>"
04140 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
04150 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
04160 INPUT "" : SVAR $
04170 SELECT OUTPUT "P" + PRTNR $
04180 IF ( "P" ) THEN
04190 CURSOR 12 , LINE
04200 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
04210 CURSOR 12 , LINE + 1
04220 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
04230 IF VAR $ = "J" OR SVAR $ = "j" THEN
04240 CURSOR 12 , LINE
04250 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
04260 PRINT "<SZ>"
04270 WHILE ╱cd╱ ( "P" ) DO
04280 LET SEK := ╱ca╱ ( 5 )
04290 SELECT OUTPUT "P" + PRTNR $
04300 ENDWHILE
04310 ELSE
04320 LET OK := FALSE
04330 ENDIF
04340 ENDIF
04350 CURSOR 1 , LINE
04360 PRINT "<Z>"
04370 PRINT "<SZ>"
04380 ENDPROC PRINTRES
38382 ╱00╱ ╱00╱