DataMuseum.dk

top - metrics - download

    Length: 21595 (0x545b)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_01, UNKNOWN_TOKEN_02, UNKNOWN_TOKEN_05, UNKNOWN_TOKEN_08, UNKNOWN_TOKEN_09, UNKNOWN_TOKEN_0b, UNKNOWN_TOKEN_0c, UNKNOWN_TOKEN_11, UNKNOWN_TOKEN_19, UNKNOWN_TOKEN_1a, UNKNOWN_TOKEN_1f, UNKNOWN_TOKEN_7f, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd, UNKNOWN_TOKEN_ce, UNKNOWN_TOKEN_d4, UNKNOWN_TOKEN_dd, UNKNOWN_TOKEN_f7
    Names: »SYSR«

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

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 // **************************************************
00120 EXEC DIMENSIONER
00130 EXEC INITIER
00120 EXEC FUNKTIONSMENU
00280 CHAIN PROGRAM $
00250 // ===========…Procedurer…starter…==============
00260 PROC DIMENSIONER
00270 // Standard…variable
00280 DIM SPC $ OF 80 , SVAR $ OF 10 , PRGFL $ OF 8 , ALFA $ OF 28 , TAL $ OF 10
00170 DIM PROGRAM $ OF 17 , PRTNR $ OF 1
00300 REAL RESRV , PPAR
00310 INTEGER OK , TRUE , FALSE , I , J , LIN_T , MAX_LIN , SIDENR
00340 // Variable…til…filen…KTOIDX…m.m.
00350 DIM KTOIDX $ OF 17
00360 INTEGER I_H\JREC , I_MAXREC , LOW , HIGH , POS , IDXPOS , RECNR
00370 DIM KTONR $ OF 8
00380 // Variable…til…filen…@@KONTO
00390 DIM KONTO $ OF 17
00400 DIM ST_DATO $ OF 6
00410 INTEGER N_FRIREC , N_MAXREC , ANT_PER , PER_NR
00420 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00430 REAL KTO_PRIMO , KTO_ULTIMO
00440 INTEGER KTO_FP , KTO_SP
00450 // Variable…til…filen…SYSPARA
00460 DIM SYSPARA $ OF 17
00470 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00480 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00490 // Variable…til…filen…@@PARAM
00500 DIM PARAM $ OF 17
00510 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00520 REAL MOMS
00530 REAL SALDO
00540 DIM FIL $ OF 17 , S_KTONR $ OF 8
00550 // Variable…til…filen…drift|
00420 DIM DRIFT\ $ OF 17
00570 DIM PRIMODAT $ OF 6
00580 REAL DRIFT ( 2 )
00610 // Filnavne…til…regnskabsanalysen
00620 DIM KAPOMK $ OF 17 , OMS[TN $ OF 17 , VAREFO $ OF 17 , AFSKRI $ OF 17
00630 DIM EGENKA $ OF 17 , AKTIVE $ OF 17 , RENTEO $ OF 17
00640 DIM VARELA $ OF 17 , DEBITO $ OF 17 , KREDIT $ OF 17
00650 REAL S_KAPOMK , S_OMS[TN , S_VAREFO , S_AFSKRI , S_EGENKA , S_AKTIVE , S_RENTEO
00660 REAL S_VARELA , S_DEBITO , S_KREDIT , S_VARELA_P
00590 ENDPROC DIMENSIONER
00600
00610 PROC INITIER
00630 LET PRGFL $ := "DP2"
00640 LET PROGRAM $ := PRGFL $ + ":SYS"
00650 LET SPC $ := "………………………………………………………………………………………………………………………"
00660 LET SPC $ := SPC $ + SPC $
00670 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00680 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00690 EXEC OPENFIL ( SYSPARA $ , "R" )
00700 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00710 EXEC TERMINAL_IDX
00720 CLOSE SYSPARA $
00730 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00740 EXEC OPENFIL ( PARAM $ , "R" )
00750 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00760 CLOSE PARAM $
00840 LET OMS[TN $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "OMS[TN"
00850 LET VAREFO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "VAREFO"
00860 LET KAPOMK $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KAPOMK"
00870 LET AFSKRI $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "AFSKRI"
00880 LET RENTEO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "RENTEO"
00890 LET AKTIVE $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "AKTIVE"
00900 LET VARELA $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "VARELA"
00910 LET DEBITO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "DEBITO"
00920 LET KREDIT $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KREDIT"
00930 LET EGENKA $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "EGENKA"
00780 LET DRIFT\ $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "DRIFT\"
00790 LET KTOIDX $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOIDX"
00800 LET KONTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KONTO"
00810 EXEC OPENFIL ( DRIFT\ $ , "R" )
00820 GET DRIFT\ $ , 1 : PRIMODAT $
00830 EXEC OPENFIL ( KTOIDX $ , "R" )
00840 EXEC OPENFIL ( KONTO $ , "R" )
00850 ENDPROC INITIER
01020
01030 PROC OPSUMER
01040 EXEC SAMMENT[L ( OMS[TN $ )
01050 LET S_OMS[TN := SALDO
01060 EXEC SAMMENT[L ( VAREFO $ )
01070 LET S_VAREFO := SALDO
01080 EXEC SAMMENT[L ( KAPOMK $ )
01090 LET S_KAPOMK := SALDO
01100 EXEC SAMMENT[L ( AFSKRI $ )
01110 LET S_AFSKRI := SALDO
01120 EXEC SAMMENT[L ( RENTEO $ )
01130 LET S_RENTEO := SALDO
01140 EXEC SAMMENT[L ( AKTIVE $ )
01150 LET S_AKTIVE := SALDO * ( - 1 )
01160 EXEC SAMMENT[L ( EGENKA $ )
01170 LET S_EGENKA := SALDO
01180 EXEC SAMMENT[L ( VARELA $ )
01190 LET S_VARELA := SALDO * ( - 1 )
01200 EXEC SAMMENT[L ( DEBITO $ )
01210 LET S_DEBITO := SALDO * ( - 1 )
01220 EXEC SAMMENT[L ( KREDIT $ )
01230 LET S_KREDIT := SALDO
01240 ENDPROC OPSUMER
00860
00870 PROC TERMINAL_IDX
00880 LET PPAR := 5 ; RESRV := 0
00890 CALL :PRES"
00900 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
00910 ENDPROC TERMINAL_IDX
00920
00930 PROC L[S_KONTO ( P )
00940 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
00950 ENDPROC L[S_KONTO
00960
00970 PROC OPENFIL ( FNAVN $ , WAY $ )
00980 REPEAT
00990 IF AY $ = "W" OR WAY $ = "w" THEN
01000 OPEN FNAVN $ , W
01010 ELSE
01020 OPEN FNAVN $ , R
01030 ENDIF
01040 IF ( FNAVN $ ) THEN
01050 PRINT "<SC0123>" ; CHR$ ( 7 )
01060 IF ( FNAVN $ ) = 6 THEN
01070 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
01080 INPUT "" : SVAR $
01090 ELSE
01100 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01110 PRINT "<S>" ; FNAVN $ ; "…***"
01120 INPUT "" : SVAR $
01130 PRINT "<C0102>" ; SPC $
01140 ENDIF
01150 ENDIF
01160 UNTIL NOT ╱cd╱ ( FNAVN $ )
01170 ENDPROC OPENFIL
01180
01190 PROC OVERSKRIFT ( ST $ , L )
01200 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01210 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01220 PRINT SYST_DAT $ ( 5 : 2 )
01230 CURSOR 36 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
01240 PRINT "***…" ; ST $ ; "…***"
01250 ENDPROC OVERSKRIFT
01260
01270 PROC SL_FEJLLINIE
01280 LET OK := TRUE
01290 PRINT "<C0102>" ; SPC $
01300 ENDPROC SL_FEJLLINIE
01310
01320 PROC FEJL ( ST $ )
01330 LET OK := FALSE
01340 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
01350 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
01360 ENDPROC FEJL
01370
01380 PROC FIND_KTO ( REF R_KTONR $ )
01390 LET OK := FALSE
01400 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
01410 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
01420 IF IGH > 1 THEN
01430 REPEAT
01440 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
01450 GET KTOIDX $ , POS : KTONR $ , RECNR
01460 IF TONR $ > R_KTONR $ THEN
01470 LET HIGH := POS
01480 ELSE
01490 IF TONR $ < R_KTONR $ THEN
01500 LET LOW := POS
01510 ENDIF
01520 ENDIF
01530 UNTIL HIGH - LOW =< 1 OR R_KTONR $ = KTONR $
01540 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
01550 GET KTOIDX $ , POS : KTONR $ , RECNR
01560 IF KTONR $ = R_KTONR $ THEN LET OK := TRUE
01570 IF KTONR $ < R_KTONR $ AND POS = I_H\JREC THEN LET POS := POS + 1
01580 ENDIF
01590 LET FIND_KTO := POS
01600 ENDPROC FIND_KTO
02000 PROC SAMMENT[L ( REF SAMFIL $ )
02010 EXEC OPENFIL ( SAMFIL $ , "R" )
02020 GET SAMFIL $ : SALDO
02030 LET SALDO := 0
02040 GET SAMFIL $ : S_KTONR $
02050 WHILE NOT ╱cd╱ ( SAMFIL $ ) DO
02060 LET IDXPOS := FIND_KTO ( S_KTONR $ )
02070 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
02080 WHILE S_KTONR $ = KTONR $ ( 1 : ╱cb╱ ( S_KTONR $ ) ) DO
02090 GET DRIFT\ $ , RECNR : DRIFT ( 1 ) , DRIFT ( 2 )
02100 LET SALDO := SALDO + DRIFT ( 2 )
02110 LET IDXPOS := IDXPOS + 1
02120 IF IDXPOS > I_H\JREC THEN EXIT
02130 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
02140 ENDWHILE
02150 GET SAMFIL $ : S_KTONR $
02160 ENDWHILE
02170 LET SALDO := SALDO * ( - 1 )
02180 CLOSE SAMFIL $
02190 EXEC OPENFIL ( SAMFIL $ , "W" )
02200 PUT SAMFIL $ : SALDO
02210 CLOSE SAMFIL $
02220 ENDPROC SAMMENT[L
02230
02240 PROC UDSKRIV
02250 LET MAX_LIN := 72 ; LIN_T := 200 ; SIDENR := 0
02260 EXEC PRINTRES ( "smal…EDB-liste" , 17 )
02270 EXEC SIDESKIFT
02280 PRINT "Regnskab…for…perioden…" ; PRIMODAT $ ( 1 : 2 ) ; "." ; PRIMODAT $ ( 3 : 2 ) ; "." ;
02290 PRINT PRIMODAT $ ( 5 : 2 ) ; "…-…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ;
02300 PRINT SYST_DAT $ ( 5 : 2 )
02310 PRINT "================================================================"
02320 PRINT "Nettooms{tning" ; TAB ( 53 ) ; CHR$ ( S_OMS[TN , 9 , 2 )
02330 PRINT "-…Vareforbrug" ; TAB ( 53 ) ; CHR$ ( S_VAREFO * ( - 1 ) , 9 , 2 )
02340 PRINT TAB ( 53 ) ; "------------"
02350 LET BRUTTO := S_OMS[TN + S_VAREFO
02360 PRINT "Bruttofortjeneste" ; TAB ( 53 ) ; CHR$ ( BRUTTO , 9 , 2 )
02370 PRINT "-…\vrige…variable…omkostningninger" ; TAB ( 53 ) ;
02380 PRINT CHR$ ( \VR_VAR * ( - 1 ) , 9 , 2 )
02390 LET D[KNING := BRUTTO + \VR_VAR
02400 PRINT TAB ( 53 ) ; "------------"
02410 PRINT "D{kningsbidrag" ; TAB ( 53 ) ; CHR$ ( D[KNING , 9 , 2 )
02420 PRINT "-…Kontante…kap.…omkostninger" ; TAB ( 53 ) ;
02430 PRINT CHR$ ( ( S_KAPOMK - \VR_VAR ) * ( - 1 ) , 9 , 2 )
02440 PRINT TAB ( 53 ) ; "------------"
02450 LET INDTJEN := D[KNING + ( S_KAPOMK - \VR_VAR )
02460 PRINT "Indtjeningsbidrag…" ; TAB ( 53 ) ; CHR$ ( INDTJEN , 9 , 2 )
02470 PRINT "-…Afskrivninger" ; TAB ( 53 ) ; CHR$ ( S_AFSKRI * ( - 1 ) , 9 , 2 )
02480 PRINT TAB ( 53 ) ; "------------"
02490 LET RES_F_R := INDTJEN + S_AFSKRI
02500 PRINT "Resultat…af…ordin{r…drift…f|r…renter" ; TAB ( 53 ) ; CHR$ ( RES_F_R , 9 , 2 )
02510 PRINT "-…Renteomkostninger" ; TAB ( 53 ) ; CHR$ ( S_RENTEO * ( - 1 ) , 9 , 2 )
02520 PRINT TAB ( 53 ) ; "------------"
02530 LET RESULTAT := RES_F_R + S_RENTEO
02540 PRINT "Resultat…af…ordin{r…drift" ; TAB ( 53 ) ; CHR$ ( RESULTAT , 9 , 2 )
02550 PRINT TAB ( 53 ) ; "============"
02560 PRINT
02570 PRINT
02580 PRINT
02590 PRINT "****…R…E…N…T…A…B…I…L…I…T…E…T…****"
02600 PRINT "---------------------------------"
02610 PRINT
02620 PRINT "…(1)…Afkastningsgrad…………………………………………………………:" ;
02630 PRINT USING "###.##…%" : ( RES_F_R + L_I ) * 100 / S_AKTIVE
02640 PRINT
02650 PRINT "…(2)…Overskudsgrad………………………………………………………………:" ;
02660 PRINT USING "###.##…%" : ( RES_F_R + L_I ) * 100 / S_OMS[TN
02670 PRINT
02680 PRINT "…(3)…Aktivernes…oms{tningshastighed…………………:" ;
02690 PRINT USING "###.##…g" : S_OMS[TN / S_AKTIVE
02700 PRINT
02710 PRINT "…(4)…Egenkap.…forrentning……………………………………………:" ;
02720 PRINT USING "###.##…%" : ( RESULTAT + L_I ) * 100 / S_EGENKA
02730 PRINT
02740 PRINT
02750 PRINT "****…I…N…D…T…J…E…N…I…N…G…S…E…V…N…E…****"
02760 PRINT "---------------------------------------"
02770 PRINT
02780 PRINT "…(1)…Bruttofortjeneste…i…%…af…oms{tning………:" ;
02790 PRINT USING "###.##…%" : BRUTTO * 100 / S_AKTIVE
02800 PRINT
02810 PRINT "…(2)…D{kningsgrad…………………………………………………………………:" ;
02820 PRINT USING "###.##…%" : D[KNING * 100 / S_AKTIVE
02830 PRINT
02840 PRINT "…(3)…Omkostninger…i…%…af…oms{tningen"
02850 LET LIN_T := LIN_T + 42
02860 EXEC OMK_I_PROCENT ( VAREFO $ )
02870 EXEC OMK_I_PROCENT ( KAPOMK $ )
02880 EXEC OMK_I_PROCENT ( AFSKRI $ )
02890 EXEC OMK_I_PROCENT ( RENTEO $ )
02900 EXEC SIDESKIFT
02910 PRINT
02920 PRINT "****…O…M…S…[…T…N…I…N…G…S…H…A…S…T…I…G…H…E…D…E…R…****"
02930 PRINT "---------------------------------------------------"
02940 PRINT
02950 PRINT "…(1)…Varedebitorer………………………………………………………………:" ;
02960 PRINT USING "###.##…g" : S_OMS[TN * ( ( 100 + MOMS ) / 100 ) / S_DEBITO
02970 PRINT
02980 PRINT "…(2)…Varelager…………………………………………………………………………:" ;
02990 PRINT USING "###.##…g" : ABS ( S_VAREFO ) / S_VARELA
03000 PRINT
03010 PRINT "…(3)…Varekreditorer……………………………………………………………:" ;
03020 LET VAREK\B := ( ABS ( S_VAREFO ) + ( S_VARELA - S_VARELA_P ) ) * ( ( 100 + MOMS ) / 100 )
03030 PRINT USING "###.##…g" : VAREK\B / S_KREDIT
03040 PRINT
03050 PRINT
03060 PRINT "****…K…R…E…D…I…T…-………O…G………L…A…G…E…R…D…A…G…E…****"
03070 PRINT "-------------------------------------------------"
03080 PRINT
03090 PRINT "…(1)…Varedebitorer………………………………………………………………:" ;
03100 PRINT USING "####.#…dg" : S_DEBITO * 360 / ( S_OMS[TN * ( ( 100 + MOMS ) / 100 ) )
03110 PRINT
03120 PRINT "…(2)…Varelager…………………………………………………………………………:" ;
03130 PRINT USING "####.#…dg" : S_VARELA * 360 / ABS ( S_VAREFO )
03140 PRINT
03150 PRINT "…(3)…Varekreditorer……………………………………………………………:" ;
03160 PRINT USING "####.#…dg" : S_KREDIT * 360 / VAREK\B
03170 LET LIN_T := LIN_T + 19
03180 FOR I := LIN_T TO AX_LIN DO PRINT
03190 EXEC PRINTREL
03200 ENDPROC UDSKRIV
03210 PROC OMK_I_PROCENT ( REF SAMFIL $ )
03220 EXEC OPENFIL ( SAMFIL $ , "R" )
03230 GET SAMFIL $ : SALDO
03240 LET SALDO := 0
03250 GET SAMFIL $ : S_KTONR $
03260 WHILE NOT ╱cd╱ ( SAMFIL $ ) DO
03270 LET IDXPOS := FIND_KTO ( S_KTONR $ )
03280 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
03290 WHILE S_KTONR $ = KTONR $ ( 1 : ╱cb╱ ( S_KTONR $ ) ) DO
03300 EXEC L[S_KONTO ( RECNR )
03310 GET DRIFT\ $ , RECNR : DRIFT ( 1 ) , DRIFT ( 2 )
03320 IF TO_TYPE $ = "A" THEN
03330 PRINT "………………" ; KTO_NAVN $ ; TAB ( 43 ) ; ":" ;
03340 PRINT USING "###.##…%" : ABS ( DRIFT ( 2 ) * 100 ) / S_OMS[TN
03350 LET LIN_T := LIN_T + 1
03360 ENDIF
03370 LET IDXPOS := IDXPOS + 1
03380 IF IDXPOS > I_H\JREC THEN EXIT
03390 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
03400 ENDWHILE
03410 GET SAMFIL $ : S_KTONR $
03420 ENDWHILE
03430 CLOSE SAMFIL $
03440 ENDPROC OMK_I_PROCENT
03450 PROC SIDESKIFT
03460 FOR I := LIN_T TO AX_LIN DO PRINT
03470 LET SIDENR := SIDENR + 1 ; LIN_T := 8
03480 PRINT
03490 PRINT "***…" ; SYST_NAVN $ ; "…***"
03500 PRINT
03510 PRINT "****…R…E…G…N…S…K…A…B…S…A…N…A…L…Y…S…E…****" ; TAB ( 58 ) ; "SIDE:…" ;
03520 PRINT SIDENR
03530 PRINT
03540 PRINT "Firmanavn:…" ; FIRMANAVN $
03550 PRINT
03560 ENDPROC SIDESKIFT
03570
03580 PROC FUNKTIONSMENU
03590 EXEC OVERSKRIFT ( "Regnskabsanalyse" , 6 )
03600 INPUT "<C0809>Indtast…venligst:…………\vrige…var.…omkostninger:…" : \VR_VAR
03610 LET \VR_VAR := \VR_VAR * ( - 1 )
03620 INPUT "<C0811>………………………………………………………L|n…til…indehaver…………………:…" : L_I
03630 LET L_I := L_I * ( - 1 )
03640 INPUT "<C1013>…………………………………………………Varelager…primo………………………:…" : S_VARELA_P
03650 PRINT "<C3515>Nu…opt{lles…der!"
03660 EXEC OPSUMER
03670 EXEC UDSKRIV
03680 ENDPROC FUNKTIONSMENU
01610 //
01600 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
01610 LET PRTNR $ := "1" ; OK := TRUE
01620 REPEAT
01630 CURSOR 21 , LINE
01640 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
01650 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
01660 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
01670 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
01680 INPUT "" : SVAR $
01690 SELECT OUTPUT "P" + PRTNR $
01700 IF ( "P" ) THEN
01710 CURSOR 12 , LINE
01720 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
01730 CURSOR 12 , LINE + 1
01740 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
01750 IF VAR $ = "J" OR SVAR $ = "j" THEN
01760 CURSOR 12 , LINE
01770 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
01780 PRINT "<SZ>"
01790 WHILE ╱cd╱ ( "P" ) DO
01800 LET SEK := ╱ca╱ ( 5 )
01810 SELECT OUTPUT "P" + PRTNR $
01820 ENDWHILE
01830 ELSE
01840 LET OK := FALSE
01850 ENDIF
01860 ENDIF
01870 CURSOR 1 , LINE
01880 PRINT "<Z>"
01890 PRINT "<SZ>"
01900 ENDPROC PRINTRES
01620 //
01630 PROC PRINTREL // RELEASE…PRINTER
01640 SELECT OUTPUT "T"
01800 ENDPROC PRINTREL
01810 // DIM…S$…OF…80,KTONR$…OF…10,X(20)
01820 PROC OPDEL ( A $ )
01830 LET KTONR $ := ""
01840 LET I := 1
01850 WHILE A $ ( I ) >< "*" DO
01860 IF A $ ( I ) = "/" THEN LET KTONR $ := "" ; I := I + 1
01870 WHILE ( A $ ( I ) >< "/" ) AND ( A $ ( I ) >< "*" ) DO
01880 LET KTONR $ := KTONR $ + A $ ( I )
01890 LET I := I + 1
01900 ENDWHILE
01910 EXEC OPSUM ( KTONR $ )
01920 ENDWHILE
01930 ENDPROC OPDEL
01940 PROC OPSUM ( KN $ )
01950 LET X ( P ) := X ( P ) + 1
01960 PRINT KN $ , X ( P )
01970 ENDPROC OPSUM
01980 LET P := 0
01990 OPEN "DP2:ZATAL" , R
02000 GET "DP2:ZATAL" : S $
02010 WHILE NOT ╱cd╱ ( "DP2:ZATAL" ) DO
02020 LET P := P + 1
02030 EXEC OPDEL ( S $ )
02040 GET "DP2:ZATAL" : S $
02050 ENDWHILE
02060 CLOSE
01975 PROC OPT[L
01990 EXEC OPENFIL ( OPTF $ , "R" )
02000 GET OPTF $ : S $
02010 WHILE NOT ╱cd╱ ( OPTF $ ) DO
02020 LET P := P + 1
02030 EXEC OPDEL ( S $ )
02040 GET OPTF $ : S $
02050 ENDWHILE
02060 CLOSE
02070 ENDPROC OPT[L
00320 // HJ[LPE…VARIABLE
00192 REAL X ( 20 ) , R ( 40 )
07967 ╱1f╱ ╱1f╱ ARAPSYS:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ R ╱00╱ ╱00╱ ╱01╱ ╱00╱ g OR SELECT OUTPUT ╱00╱ EXEC OPT[L
01951 LET IDXPOS := FIND_KTO ( KN $ )
01952 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
01953 WHILE KN $ = KTONR $ ( 1 : ╱cb╱ ( KN $ ) ) DO
01954 GET DRIFT\ $ , RECNR : DRIFT ( 1 ) , DRIFT ( 2 )
01955 LET X ( P ) := X ( P ) + DRIFT ( 2 )
01956 LET IDXPOS := IDXPOS + 1
01957 IF IDXPOS > I_H\JREC THEN EXIT
01958 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
01959 ENDWHILE
01650 ENDPROC PRINTREL
01660 // DIM…S$…OF…80,KTONR$…OF…10,X(20)
01670 PROC OPDEL ( A $ )
01680 LET S_KTONR $ := ""
01690 LET I := 1
01700 WHILE A $ ( I ) >< "*" DO
01710 IF A $ ( I ) = "/" THEN LET S_KTONR $ := "" ; I := I + 1
01720 WHILE ( A $ ( I ) >< "/" ) AND ( A $ ( I ) >< "*" ) DO
01730 LET S_KTONR $ := S_KTONR $ + A $ ( I )
01740 LET I := I + 1
01750 ENDWHILE
01760 EXEC OPSUM ( S_KTONR $ )
01770 ENDWHILE
01780 ENDPROC OPDEL
01790 PROC OPSUM ( KN $ )
02060 LET X ( P ) := X ( P ) + 1
01810 LET IDXPOS := FIND_KTO ( KN $ )
01820 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
01830 WHILE KN $ = KTONR $ ( 1 : ╱cb╱ ( KN $ ) ) DO
01840 GET DRIFT\ $ , RECNR : DRIFT ( 1 ) , DRIFT ( 2 )
02110 LET X ( P ) := X ( P ) + DRIFT ( 2 )
01860 LET IDXPOS := IDXPOS + 1
01870 IF IDXPOS > I_H\JREC THEN EXIT
01880 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
01890 ENDWHILE
02160 PRINT KN $ , X ( P )
01910 ENDPROC OPSUM
01920 PROC OPT[L
01930 LET P := 0
01940 EXEC OPENFIL ( OPTF $ , "R" )
01950 GET OPTF $ : S $
01960 WHILE NOT ╱cd╱ ( OPTF $ ) DO
01970 LET P := P + 1
01980 EXEC OPDEL ( S $ )
02000 GET OPTF $ : S $
02010 ENDWHILE
02020 CLOSE
02030 ENDPROC OPT[L
00560 DIM DRIFT\ $ OF 17 , OPTF $ OF 17
00770 LET OPTF $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "TAL"
00290 DIM PROGRAM $ OF 17 , PRTNR $ OF 1 , S $ OF 80
00100 // ``````…REGNSKABSANALYSE…VERSION…2.0…''''''''
00110 // ``````…by…Peter…Kristensen…1984…''''''''''
02040 PROC BEREGNMAJ
02050 LET X ( 9 ) := X ( 9 ) - X ( 20 )
02060 LET R ( 1 ) := X ( 1 )
02070 LET R ( 2 ) := X ( 5 )
02080 LET R ( 3 ) := R ( 1 ) - R ( 2 )
02090 LET R ( 4 ) := X ( 20 )
02100 LET R ( 5 ) := R ( 3 ) - R ( 4 )
02110 LET R ( 6 ) := X ( 9 )
02120 LET R ( 7 ) := R ( 5 ) - R ( 6 )
02130 LET R ( 8 ) := X ( 10 )
02140 LET R ( 9 ) := R ( 7 ) - R ( 8 )
02150 LET R ( 10 ) := X ( 11 )
02160 LET R ( 11 ) := R ( 9 ) - R ( 10 )
02170 LET R ( 12 ) := X ( 25 )
02180 LET R ( 13 ) := R ( 11 ) - R ( 12 )
02190 LET X ( 26 ) := R ( 5 )
02200 LET R ( 14 ) := ( R ( 9 ) - X ( 25 ) ) * 100 / X ( 18 )
02210 LET R ( 15 ) := ( R ( 11 ) - X ( 25 ) ) * 100 / X ( 19 )
02220 FOR I := 1 TO DO
02230 LET R ( 15 + I ) := ( X ( I ) - X ( 4 + I ) ) * 100 / X ( I )
02490 LET R ( 19 + I ) := X ( 25 + I ) / X ( I )
02250 NEXT I
02510 LET R ( 24 ) := ( R ( 9 ) - R ( 10 ) ) * 100 / R ( 20 )
02270 LET R ( 25 ) := ( R ( 1 ) - R ( 24 ) ) * 100 / R ( 1 )
02280 FOR I := 1 TO DO
02290 LET R ( 25 + I ) := X ( 4 + I ) / X ( 11 + I )
02300 NEXT I
02310 LET R ( 30 ) := ( R ( 1 ) * 1.22 ) / X ( 16 )
02320 LET R ( 31 ) := ( ( ( X ( 5 ) + X ( 12 ) ) - X ( 21 ) ) * 1.22 ) / X ( 17 )
02330 FOR I := 1 TO DO
02340 LET R ( 31 + I ) := 360 / R ( 25 + I )
02350 NEXT I
02360 LET R ( 38 ) := X ( 19 ) * 100 / X ( 18 )
02370 ENDPROC BEREGNMAJ
00330 REAL X ( 30 ) , R ( 40 )
00170 EXEC INPUTTAL
00180 IF _KODE $ = "Y" THEN
00190 EXEC BEREGNMAJ
00210 ELSE
00220 EXEC BEREGNKAMET
00230 ENDIF
02380 PROC INPUTTAL
02390 EXEC OVERSKRIFT ( "Regnskabanalyse" , 5 )
02400 REPEAT
06030 INPUT "<C2408Z>Indtast…driftslederl|n………:…" : X ( 25 )
06040 INPUT "<C2409Z………………………primolager…A……………:…" : X ( 22 )
06050 INPUT "<C2410Z>……………………primolager…B……………:…" : X ( 23 )
06060 INPUT "<C2411Z>……………………primolager…C……………:…" : X ( 24 )
06070 INPUT "<C2412Z>……………………\vr.…var.…omk.………:…" : X ( 20 )
06080 INPUT "<C2413Z>……………………d{kningsbidrag…A…:…" : X ( 27 )
06090 INPUT "<C2414Z>……………………d{kningsbidrag…B…:…" : X ( 28 )
06100 INPUT "<C2415Z>……………………d{kningsbidrag…C…:…" : X ( 29 )
02710 INPUT "<C2418Z>Er…alle…tal…korrekt…indtastede…?…(j/n)…" : SVAR $
02760 UNTIL SVAR $ = "j" OR SVAR $ = "J"
02780 FOR I := 1 TO DO
06140 LET X ( 21 ) := X ( 21 ) + X ( 21 + I )
02800 LET X ( 26 ) := X ( 26 ) + X ( 26 + I )
02810 NEXT I
02820 ENDPROC INPUTTAL
06040 INPUT "<C2409Z>……………………primolager…A……………:…" : X ( 22 )
06040 INPUT "<C2409Z>……………………primolager…………………:…" : X ( 22 )
06050 INPUT "<C2410Z>……………………\vr.…var.…omk.…A…:…" : X ( 23 )
02730 INPUT "<C2411Z>……………………\vr.…var.…omk.…B…:…" : X ( 28 )
02740 INPUT "<C2412Z>……………………\vr.…var.…omk.…C…:…" : X ( 29 )
06080 INPUT "<C2413Z>……………………d{kningsbidrag…A…:…" : X ( 27 )
06090 INPUT "<C2414Z>……………………d{kningsbidrag…B…:…" : X ( 28 )
06100 INPUT "<C2415Z>……………………d{kningsbidrag…C…:…" : X ( 29 )
02720 INPUT "<C2410Z>……………………\vr.…var.…omk.…A…:…" : X ( 27 )
02770 FOR I := 1 TO DO LET X ( 20 ) := X ( 20 ) + X ( 26 + I )
02700 INPUT "<C2408Z>Indtast…driftslederl|n………:…" : X ( 25 )
02710 INPUT "<C2409Z>……………………primolager…………………:…" : X ( 21 )
02790 LET X ( 26 + I ) := X ( 1 + I ) - ( X ( 5 + I ) + X ( 26 + I ) )
02830 PROC UDSKRIVMAJ
02840 DIM UDFIL $ OF 17
07020 LET UDFIL $ := S_KODE $ + "RSKELET"
07030 EXEC OPENFILE ( UDFIL $ , "R" )
02870 GET UDFIL $ : S $
02900 WHILE NOT ╱cd╱ ( UDFIL $ ) DO
02910 IF #" IN S $ THEN
02590 LET I := I + 1
02600 PRINT USING S $ : R ( I )
02610 ELSE
02620 PRINT S $
02630 ENDIF
02640 GET UDFIL $ : S $
02650 ENDWHILE
02660 CLOSE UDFIL $
02680 ENDPROC UDSKRIVMAJ
02890 LET I := 0
07967 ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ LATAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ R ╱00╱ ╱00╱ ╱01╱ ╱00╱ ╱19╱ ╱ce╱ SGN ╱00╱ EXEC UDSKRIVMAJ
02860 EXEC OPENFIL ( UDFIL $ , "R" )
07967 ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ gurbroferaV…………*120 ╱00╱ ╱00╱ P ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ 120 ╱00╱ ╱00╱ ╱08╱ ╱00╱ SELECT OUTPUT ╱d4╱ " ╱0b╱ LET UDFIL $ := DATAFL $ + ":" + S_KODE $ + "RSKELET"
02880 EXEC PRINTRES ( "smal…EDB-liste" , 20 )
02670 EXEC PRINTREL
02750 INPUT "<C2218Z>Er…alle…tal…korrekt…indtastede…?…(j/n)…" : SVAR $
00205 CHAIN PROGRAM $
02101 IF KTONR $ ( 1 ) = "0" THEN LET DRIFT ( 2 ) := - DRIFT ( 2 )
07075 IF I =< 12 THEN LET R ( I ) := ABS ( R ( I ) )
07967 ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ A…eppurgeraV………*11121 ╱00╱ ╱00╱ P ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ 11121 ╱00╱ ╱00╱ ╱08╱ ╱00╱ ╱1a╱ SGN > ╱08╱ LET X ( P ) := X ( P ) + ABS ( DRIFT ( 2 ) )
01850 LET X ( P ) := X ( P ) + DRIFT ( 2 )
02160 PRINT "<XC1212>Der…opt{lles!"
02151 LET X ( P ) := ABS ( X ( P ) )
01800 LET X ( P ) := X ( P )
01990 LET X ( P ) := ABS ( X ( P ) )
02490 LET R ( 19 + I ) := X ( 25 + I ) / X ( I ) * 100
07967 ╱1f╱ XDIOTKAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ R ╱00╱ ╱00╱ ╱01╱ ╱00╱ E ╱cc╱ TAN ╱08╱ LET R ( 19 + I ) := X ( 25 + I ) * 100 / X ( I )
02160 PRINT "<XC1212>Der…opt{lles!" ; KTONR $ ; "………………" ; X ( P )
07967 ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ LATAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ R ╱00╱ ╱00╱ ╱01╱ ╱00╱ ╱7f╱ SGN p ╱08╱ PRINT "<1212>Der…opt{lles!" ; KTONR $ ; "………………" ; X ( P )
02160 PRINT "Der…opt{lles!" ; KTONR $ ; "………………" ; X ( P )
00141 FOR I := 1 TO 000 DO LET I := I
02160 // PRINT…"Der…opt{lles!";KTONR$;"………………";X(P)
02115 PRINT KTONR $ ; "…………………………………" ; X ( P )
00160 FOR I := 1 TO 00 DO LET I := I
02260 LET R ( 24 ) := ( R ( 6 ) + R ( 8 ) ) * 100 / R ( 20 )
00240 CHAIN PROGRAM $
01900 PRINT "<XC1412>Der…opt{lles!"
02700 INPUT "<C2008Z>Indtast…driftslederl|n………………………………:…" : X ( 25 )
02710 INPUT "<C2409Z>……………………lager…ialt,…primo………………………:…" : X ( 21 )
02720 INPUT "<C2410Z>……………………\vrige…variable…omk.……A………:…" : X ( 27 )
02730 INPUT "<C2411Z>……………………\vrige…variable…omk.……B………:…" : X ( 28 )
02740 INPUT "<C2412Z>……………………\vrige…variable…omk.……C………:…" : X ( 29 )
02440 INPUT "<C2218Z>Er…alle…tal…korrekt…indtastede…?…(j/n)…" : SVAR $
02430 UNTIL SVAR $ = "j" OR SVAR $ = "J"
02440 FOR I := 1 TO DO LET X ( 20 ) := X ( 20 ) + X ( 26 + I )
02450 FOR I := 1 TO DO
02460 LET X ( 26 + I ) := X ( 1 + I ) - ( X ( 5 + I ) + X ( 26 + I ) )
02470 LET X ( 26 ) := X ( 26 ) + X ( 26 + I )
02480 NEXT I
02490 ENDPROC INPUTTAL
02500 PROC UDSKRIVMAJ
02510 DIM UDFIL $ OF 17
02520 LET UDFIL $ := DATAFL $ + ":" + S_KODE $ + "RSKELET"
02530 EXEC OPENFIL ( UDFIL $ , "R" )
02540 GET UDFIL $ : S $
02880 EXEC PRINTRES ( "smal…EDB-liste" , 20 )
02560 LET I := 0
02570 WHILE NOT ╱cd╱ ( UDFIL $ ) DO
02580 IF #" IN S $ THEN
02550 EXEC PRINTRES ( "papir" , 20 )
02700 INPUT "<C2008Z>Indtast…driftslederl|n……………………………………………:…" : X ( 25 )
02400 INPUT "<C2009Z>……………………lager…ialt,…primo………………………:…" : X ( 21 )
02410 INPUT "<C2010Z>……………………\vrige…variable…omk.……A………:…" : X ( 27 )
02420 INPUT "<C2011Z>……………………\vrige…variable…omk.……B………:…" : X ( 28 )
02430 INPUT "<C2012Z>……………………\vrige…variable…omk.……C………:…" : X ( 29 )
02390 INPUT "<C2008Z>Indtast…driftslederl|n………………………………:…" : X ( 25 )
24944 p ╱00╱ ╱00╱ ╱05╱ ╱00╱ s ╱dd╱ IF //
02700 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
02710 LET PRTNR $ := "1" ; OK := TRUE
02720 REPEAT
02730 CURSOR 15 , LINE
02740 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
02750 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
02760 CURSOR 1 , LINE
02770 PRINT "<Z>"
02780 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
02790 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
02800 INPUT "" : SVAR $
02810 SELECT OUTPUT "P" + PRTNR $
02820 IF ( "P" ) THEN
02830 CURSOR 12 , LINE
02840 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
02850 CURSOR 12 , LINE + 1
02860 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
02870 IF VAR $ = "J" OR SVAR $ = "j" THEN
02880 CURSOR 12 , LINE
02890 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
02900 PRINT "<SZ>"
02910 WHILE ╱cd╱ ( "P" ) DO
02920 LET SEK := ╱ca╱ ( 5 )
02930 SELECT OUTPUT "P" + PRTNR $
02940 ENDWHILE
02950 ELSE
02960 LET OK := FALSE
02970 ENDIF
02980 ENDIF
02990 CURSOR 1 , LINE
03000 PRINT "<Z>"
03010 PRINT "<SZ>"
03020 ENDPROC PRINTRES
04000 PROC EDITTAL
04010 PROC EDTAL
04020 IF = 0 THEN
04030 LET S $ := ""
04040 ELSE
04050 LET S $ := CHR$ ( A , 8 , 0 )
04060 ENDIF
04070 REPEAT
04080 CURSOR X1 , Y1
04090 PRINT "<ZS>" ; T1 $
04100 EDIT S $
04110 EXEC TAL_CONTROL ( S $ )
04120 UNTIL OK
04130 LET A := ASC ( S $ )
04140 ENDPROC EDTAL
04010 PROC EDTAL ( X1 , Y1 , T1 $ )
04150 LET A := 5
04160 EXEC EDTAL ( 12 , 12 , "Indtast…et…tal…:…" )
04170 PRINT A
03260 ENDPROC EDITTAL
03270
09001 PROC TAL_CONTROL ( REF RST $ )
09002 LET J := 0 ; OK := TRUE
09003 FOR I := 1 TO ( RST $ ) DO
09004 IF RST $ ( I ) IN TAL $ + "." THEN LET J := J + 1 ; RST $ ( J ) := RST $ ( I )
09005 NEXT I
09006 IF = 0 THEN
09007 LET OK := FALSE
09008 ELSE
09009 LET RST $ := RST $ ( 1 : J )
09010 ENDIF
09011 ENDPROC TAL_CONTROL
03390
00140 EXEC EDITTAL
27680 at…te…tsatdnI ╱00╱ ╱00╱ ╱11╱ ╱00╱ J PROC ╱02╱ LET TAL $ := "0123456789"
07967 ╱1f╱ ╱1f╱ OTNOKAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ R ╱00╱ ╱00╱ ╱01╱ ╱00╱ ╱cc╱ =< CHR$ ╱0c╱ PROC TAL_CONTROL ( REF R[T $ )
03290 LET J := 0 ; OK := TRUE
03300 FOR I := 1 TO ( R[T $ ) DO
03310 IF R[T $ ( I ) IN TAL $ + "." THEN LET J := J + 1 ; R[T $ ( J ) := R[T $ ( I )
03320 NEXT I
03330 IF = 0 THEN
03340 LET OK := FALSE
03350 ELSE
03360 LET R[T $ := R[T $ ( 1 : J )
03370 ENDIF
03380 ENDPROC TAL_CONTROL
03030 PROC EDITTAL
03040 PROC EDTAL ( X1 , Y1 , T1 $ )
03050 IF = 0 THEN
03060 LET S $ := ""
03070 ELSE
03080 LET S $ := CHR$ ( [ , 8 , 0 )
03090 ENDIF
03100 REPEAT
03110 CURSOR X1 , Y1
03120 PRINT "<ZS>" ; T1 $
03130 EDIT S $
03140 EXEC TAL_CONTROL ( S $ )
03150 UNTIL OK
03160 LET [ := ASC ( S $ )
03170 ENDPROC EDTAL
03180 LET [ := 5
03240 EXEC EDTAL ( 12 , 12 , "Indtast…et…tal…:…" )
03250 PRINT [
03190 EXEC EDTAL ( 20 , 8 , "Indtast…driftslederl|n……………25……………:…" )
03200 EXEC EDTAL ( 20 , 9 , "……………………lager…ialt,…primo……21……………:…" )
03210 EXEC EDTAL ( 20 , 10 , "……………………\vrige…variable…omk.……A…27:…" )
03220 EXEC EDTAL ( 20 , 11 , "……………………\vrige…variable…omk.……B…28:…" )
03230 EXEC EDTAL ( 20 , 12 , "……………………\vrige…variable…omk.……C…29:…" )
02420 INPUT "<C2218Z>Er…alle…tal…korrekt…indtastede?…(j/n)…" : SVAR $
02410 EXEC EDITTAL
03180 LET [ := X ( 25 )
03191 LET X ( 25 ) := [
03199 LET [ := X ( 25 )
03201 LET X ( 21 ) := [
03209 LET [ := X ( 27 )
03211 LET X ( 27 ) := [
03219 LET [ := X ( 28 )
03221 LET X ( 28 ) := [
03229 LET [ := X ( 29 )
03231 LET X ( 29 ) := [
03199 LET [ := X ( 21 )
03130 EDIT "" : S $
00140 EXEC INPUTTAL
12857 …C…….kmo…elbairav…egirv\…………………… ╱00╱ ╱00╱ $ ╱00╱ 0 * v ╱0c╱ EXEC EDTAL ( 20 , 8 , "Indtast…driftslederl|n………………………………:…" )
03191 LET X ( 25 ) := [
03199 LET [ := X ( 21 )
03200 EXEC EDTAL ( 20 , 9 , "……………………lager…ialt,…primo………………………:…" )
03201 LET X ( 21 ) := [
03209 LET [ := X ( 27 )
03210 EXEC EDTAL ( 20 , 10 , "……………………\vrige…variable…omk.……A………:…" )
03211 LET X ( 27 ) := [
03219 LET [ := X ( 28 )
03220 EXEC EDTAL ( 20 , 11 , "……………………\vrige…variable…omk.……B………:…" )
03221 LET X ( 28 ) := [
03229 LET [ := X ( 29 )
03230 EXEC EDTAL ( 20 , 12 , "……………………\vrige…variable…omk.……C………:…" )
03231 LET X ( 29 ) := [
03260 ENDPROC EDITTAL
03270
24944 p ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ^ ╱f7╱ ╱09╱ PRINT
02552 PRINT "***…" ; SYSTNAVN $ ; "…***"
02553 PRINT
02554 PRINT "Firma:…" ; FIRMANAVN $
02555 PRINT
02552 PRINT "***…" ; SYST_NAVN $ ; "…***"
00611 DIM SYST_NAVN $ OF 30
00612 LET SYST_NAVN $ := "Bogf|ringssystemet…'SYSKAS-1'"
07967 ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ retneR……*70/60 ╱00╱ ╱00╱ P ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ 70 ╱00╱ ╱00╱ ╱08╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ regnintsokmoseteticapak…etnatnoK……*40/30 ╱00╱ ╱00╱ P ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ 40 ╱00╱ ╱00╱ ╱08╱ ╱00╱ ) OTHERWISE LN ╱00╱ ╱00╱