|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 3224 (0xc98)
Types: SPC/1-COMAL-80
Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cd
Names: »SYSPTK.B«
└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
└─⟦this⟧ »SYSPTK.B«
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 FKT_MENU
0280 CHAIN PROGRAM$
0290 // =========== Procedurer starter ==============
0300 PROC DIMENSIONER
0310 // Standard variable
0320 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0330 DIM PROGRAM$ OF 17
0340 REAL RESRV,PPAR
0350 INTEGER OK,TRUE,FALSE,I,J
0360 // Variable til filen SYSPARA
0370 DIM SYSPARA$ OF 17
0380 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0390 DIM DATAFL$ OF 8,T_KODE$ OF 1
0400 // Variable til filen @@PARAM
0410 DIM PARAM$ OF 17
0420 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0430 REAL MOMS
0440 ENDPROC DIMENSIONER
0450
0460 PROC INITIER
0470 LET PRGFL$ := "DP2"
0480 LET PROGRAM$ := PRGFL$ + ":SYSP"
0490 LET SPC$ := " "
0500 LET SPC$ := SPC$ + SPC$
0510 LET FALSE := 0 ; TRUE := 1 // boolske variable
0520 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0530 EXEC OPENFIL(SYSPARA$,"R")
0540 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0550 EXEC TERMINAL_IDX
0560 CLOSE SYSPARA$
0570 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0580 EXEC OPENFIL(PARAM$,"R")
0590 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0600 CLOSE PARAM$
0610 ENDPROC INITIER
0620
0630 PROC TERMINAL_IDX
0640 LET PPAR := 5 ; RESRV := 0
0650 CALL R"DDE:PRES"
0660 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
0670 ENDPROC TERMINAL_IDX
0680
0690 PROC OPENFIL(FNAVN$,WAY$)
0700 REPEAT
0710 IF AY$ = "W" OR WAY$ = "w" THEN
0720 OPEN FNAVN$,W
0730 ELSE
0740 OPEN FNAVN$,R
0750 ENDIF
0760 IF (FNAVN$) THEN
0770 PRINT "<SC0123>" ; CHR$ (7)
0780 IF (FNAVN$) = 6 THEN
0790 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
0800 INPUT "" : SVAR$
0810 ELSE
0820 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
0830 PRINT "<S>" ; FNAVN$ ; " ***"
0840 INPUT "" : SVAR$
0850 PRINT "<C0102>" ; SPC$
0860 ENDIF
0870 ENDIF
0880 UNTIL NOT ╱cd╱ (FNAVN$)
0890 ENDPROC OPENFIL
0900
0910 PROC OVERSKRIFT(ST$,L)
0920 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
0930 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
0940 PRINT SYST_DAT$(5 : 2)
0950 CURSOR 36 - INT( ╱cb╱ (ST$) / 2),L
0960 PRINT "*** " ; ST$ ; " ***"
0970 ENDPROC OVERSKRIFT
0980
0990 PROC SL_FEJLLINIE
1000 LET OK := TRUE
1010 PRINT "<C0102>" ; SPC$
1020 ENDPROC SL_FEJLLINIE
1030
1040 PROC FEJL(ST$)
1050 LET OK := FALSE
1060 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1070 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1080 ENDPROC FEJL
1090
1100 PROC FKT_MENU
1110 EXEC OVERSKRIFT("Ændring af terminalkode m.m.",7)
1120 EDIT "<C3011>Terminalkode: " : T_KODE$
1130 REPEAT
1140 EDIT "<C2214>Etikette for datafillager: " : DATAFL$
1150 UNTIL ╱cb╱ (DATAFL$) > 0
1160 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
1170 EXEC OPENFIL(PARAM$,"R")
1180 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
1190 CLOSE PARAM$
1200 EXEC OPENFIL(SYSPARA$,"W")
1210 LET RESRV := 0 ; PPAR := 5
1220 CALL
17732 :PRES"
1230 PUT SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1240 CLOSE SYSPARA$
1250 ENDPROC FKT_MENU