DataMuseum.dk

top - download

    Length: 4159 (0x103f)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cd
    Names: »SYSA.B«

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

SPC/1 COMAL-80

0100 // **************************************************
0110 // *                                                *
0120 // *          Bogføringssystemet 'SYS-KAS'          *
0130 // *                  vers. 1.0                     *
0140 // *                                                *
0150 // * Udviklet marts 1983 på en 'SPC/1' mikrodatamat *
0160 // * Programsystemet er skrevet i COMAL80 vers. 1.2 *
0170 // *                                                *
0180 // * Udviklet af : Peter Kristensen                 *
0190 // *               Vestervang 6, 6920 Videbæk       *
0200 // *                                                *
0210 // *   (C)       : forlaget systime a/s             *
0220 // *               Klokkebakken 20, Gjellerup       *
0230 // *               7400  Herning                    *
0240 // **************************************************
0250 EXEC DIMENSIONER
0260 EXEC INITIER
0270 EXEC FUNKTIONSMENU
0280 // =========== Procedurer starter ==============
0290 PROC DIMENSIONER
0300 // Standard variable
0310 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0320 DIM PROGRAM$ OF 17
0330 REAL RESRV,PPAR
0340 INTEGER OK,TRUE,FALSE,I,J
0350 // Variable til filen SYSPARA
0360 DIM SYSPARA$ OF 17
0370 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0380 DIM DATAFL$ OF 8,T_KODE$ OF 1
0390 // Variable til filen @@PARAM
0400 DIM PARAM$ OF 17
0410 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0420 REAL MOMS
0430 ENDPROC DIMENSIONER
0440
0450 PROC INITIER
0460 LET PRGFL$ := "DP2"
0470 LET PROGRAM$ := PRGFL$ + ":SYSIP"
0480 LET SPC$ := "                                             "
0490 LET SPC$ := SPC$ + SPC$
0500 LET FALSE := 0 ; TRUE := 1 // boolske variable
0510 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0520 EXEC OPENFIL(SYSPARA$,"R")
0530 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0540 EXEC TERMINAL_IDX
0550 CLOSE SYSPARA$
0560 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0570 EXEC OPENFIL(PARAM$,"R")
0580 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0590 CLOSE PARAM$
0600 ENDPROC INITIER
0610
0620 PROC TERMINAL_IDX
0630 LET PPAR := 5 ; RESRV := 0
0640 CALL DIM "DDE:PRES"
0650 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
0660 ENDPROC TERMINAL_IDX
0670
0680 PROC OPENFIL(FNAVN$,WAY$)
0690 REPEAT
0700 IF AY$ = "W" OR WAY$ = "w" THEN
0710 OPEN FNAVN$,W
0720 ELSE
0730 OPEN FNAVN$,R
0740 ENDIF
0750 IF (FNAVN$) THEN
0760 PRINT "<SC0123>" ; CHR$ (7)
0770 IF (FNAVN$) = 6 THEN
0780 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
0790 INPUT "" : SVAR$
0800 ELSE
0810 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
0820 PRINT "<S>" ; FNAVN$ ; " ***"
0830 INPUT "" : SVAR$
0840 PRINT "<C0102>" ; SPC$
0850 ENDIF
0860 ENDIF
0870 UNTIL NOT ╱cd╱ (FNAVN$)
0880 ENDPROC OPENFIL
0890
0900 PROC OVERSKRIFT(ST$,L)
0910 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
0920 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
0930 PRINT SYST_DAT$(5 : 2)
0940 CURSOR 36 - INT( ╱cb╱ (ST$) / 2),L
0950 PRINT "*** " ; ST$ ; " ***"
0960 ENDPROC OVERSKRIFT
0970
0980 PROC SL_FEJLLINIE
0990 LET OK := TRUE
1000 PRINT "<C0102>" ; SPC$
1010 ENDPROC SL_FEJLLINIE
1020
1030 PROC FEJL(ST$)
1040 LET OK := FALSE
1050 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1060 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1070 ENDPROC FEJL
1080
1090 PROC FUNKTIONSMENU
1100 EXEC OVERSKRIFT("Start og afslutning af regnskab",7)
1110 PRINT "<C1810>Indtastning af åbningssaldi               IÅ"
1120 PRINT "<C1812>Afslutning af regnskab                    AR"
1130 PRINT "<C1814>Fremførsel af balancetal i ny regning     FB"
1140 PRINT "<C1817>Programfordeler                         RETURN"
1150 REPEAT
1160 EDIT "<C2720>Indtast funktionskode: " : SVAR$(1 : 2)
1170 EXEC SL_FEJLLINIE
1180 IF "/" + SVAR$ + "/" IN "/IÅ/iå/AR/ar/FB/fb//  / /" THEN
1190 EXEC FEJL("Ulovlig funktionskode: '" + SVAR$ + "'")
1200 ENDIF
1210 UNTIL OK
1220 LET PROGRAM$ := PRGFL$ + ":SYS" + SVAR$
1230 CASE SVAR$ OF
1240 WHILE "AR","ar"
1250 EXEC SYSTEMDATO("Dato for afslutning af regnskab (ÅÅMMDD) ")
1260 WHILE "FB","fb"
1270 EXEC SYSTEMDATO("Dato for fremførsel af balancetal (ÅÅMMDD) ")
1280 ENDCASE
1290 CHAIN PROGRAM$
1300 ENDPROC FUNKTIONSMENU
1310 PROC DATO_CONTROL( REF RST$)
1320 LET OK := TRUE
1330 IF RST$(1 : 2) < "00" OR RST$(1 : 2) > "99" THEN LET OK := FALSE
1340 IF RST$(3 : 2) < "01" OR RST$(3 : 2) > "12" THEN LET OK := FALSE
1350 IF RST$(5 : 2) < "01" OR RST$(5 : 2) > "31" THEN LET OK := FALSE
1360 IF NOT OK THEN EXEC FEJL("Ulovlig dato")
1370 ENDPROC DATO_CONTROL
1380 PROC SYSTEMDATO(DATTXT$)
1390 EXEC OVERSKRIFT("Indtastning af systemdato",6)
1400 REPEAT
1410 PRINT "<SZC1212>" ; DATTXT$
1420 EDIT "" : SYST_DAT$
1430 EXEC SL_FEJLLINIE
1440 EXEC DATO_CONTROL(SYST_DAT$)
1450 UNTIL OK
1460 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1470 PRINT SYST_DAT$(5 : 2)
1480 EXEC OPENFIL(PARAM$,"W")
1490 PUT PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
1500 CLOSE PARAM$
1510 ENDPROC SYSTEMDATO
1520