DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »VIRK.K«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »VIRK.K« 

Mikados K File

0010PROC DATOCHECK(NR5,OK5) 
0015OK5=E 
0020ÅR=(ORD(NR5$(E))-48)*10+ORD(NR5$(G))-48 
0025MÅNED=(ORD(NR5$(V))-48)*10+ORD(NR5$(4))-48 
0030DATO=(ORD(NR5$(5))-48)*10+ORD(NR5$(6))-48 
0035IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK5=B 
0040IF OK5=B THEN EXIT  
0045CASE MÅNED OF  
0050WHEN 4,6,W,11 
0055IF DATO>30 THEN OK5=B 
0060WHEN G 
0065IF DATO>29 THEN OK5=B 
0070IF DATO=29 AND ÅR MOD 4<>B THEN OK5=B 
0075ENDCASE  
0080ENDPROC  
0100PROC CHECK(NR1,OK1) 
0110OK1=B 
0115RESULT=B 
0120IF LEN(NR1$)>B THEN  
0130IF NR1$(E)="-" THEN  
0140FORTEGN=-E 
0150OK1=E 
0160ELSE  
0170FORTEGN=E 
0180ENDIF  
0190WHILE LEN(NR1$)>OK1 
0200OK1=OK1+E 
0210IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
0220FORTEGN=B 
0230OK1=LEN(NR1$) 
0240ENDIF  
0245RESULT=RESULT*10+ORD(NR1$(OK1))-48 
0250ENDWHILE  
0260OK1=OK1*FORTEGN 
0270IF OK1<B THEN OK1=OK1+E 
0280ENDIF  
0290ENDPROC  
0300PROC INOPL(OPL) 
0305EXEC INLINE(OPL) 
0310CASE OPL OF  
0315WHEN E 
0320POST1$(E,7)=LINE$ 
0325WHEN G 
0330POST1$(8,32)=LINE$ 
0335WHEN V 
0340POST1$(33,55)=LINE$ 
0345WHEN 4 
0350POST2$(E,4)=LINE$ 
0355WHEN 5 
0360POST2$(5,18)=LINE$ 
0365WHEN 6 
0370POST2$(19,24)=LINE$ 
0375WHEN 7 
0380POST2$(25,34)=LINE$ 
0381WHEN 8 
0382REPEAT  
0383EXEC DATOCHECK(LINE$,J) 
0384IF J=B THEN EXEC INLINE(OPL) 
0385UNTIL J>B 
0386DAD$=LINE$ 
0387ENDCASE  
0390ENDPROC  
0395PROC SKRIVOPL 
0400IF OUTP=B THEN CLEAR  
0405FOR J=E TO A 
0410CASE J OF  
0415WHEN E 
0420LINE$=POST1$(E,7) 
0425WHEN G 
0430LINE$=POST1$(8,32) 
0435WHEN V 
0440LINE$=POST1$(33,55) 
0445WHEN 4 
0450LINE$=POST2$(E,4) 
0455WHEN 5 
0460LINE$=POST2$(5,18) 
0465WHEN 6 
0470LINE$=POST2$(19,24) 
0475WHEN 7 
0480LINE$=POST2$(25,34) 
0481WHEN 8 
0482LINE$=DAD$ 
0485ENDCASE  
0487IF OUTP=B THEN  
0490EXEC OUTLINE(J) 
0491ELSE  
0492EXEC OUTPLINE(J) 
0493ENDIF  
0495NEXT J 
0500ENDPROC  
0505PROC OUTLINE(N) 
0510CURSOR X(N),Y(N) 
0515PRINT USING "### ":N; 
0520PRINT PICT$(N); 
0525CURSOR X(N)+25,Y(N) 
0530PRINT LINE$ 
0535ENDPROC  
0540PROC INDVIRK 
0545OPEN FIL$,W 
0550EXEC FEJL(B,B,FIL$) 
0555GET FIL$,E:POST1$ 
0560GET FIL$,G:POST2$,SLJNR,MLMNR,ATPLM 
0563GET FIL$,V:DAD$ 
0565ENDPROC  
0570PROC UDVIRK 
0575PUT FIL$,E:POST1$ 
0580PUT FIL$,G:POST2$,SLJNR,MLMNR,ATPLM 
0583PUT FIL$,V:DAD$ 
0585CLOSE FIL$ 
0590EXEC FEJL(E,B,FIL$) 
0595ENDPROC  
0600PROC FEJL(P1,P2,P3) 
0605IF STATUS(P3$)<>B THEN  
0610OUTPUT T 
0615PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
0620STOP  
0625ENDIF  
0630ENDPROC  
0680PROC INLINE(N) 
0690REPEAT  
0700CURSOR X(N),Y(N) 
0705PRINT USING "###":N; 
0710PRINT BL$(X(N)+V,79) 
0720CURSOR X(N)+4,Y(N) 
0730PRINT PICT$(N) 
0740CURSOR X(N)+25,Y(N) 
0750INPUT "",LINE$ 
0760IF TYPE(N)<B THEN  
0770IF LEN(LINE$)<=ABS(TYPE(N)) THEN  
0780OK=E 
0790FOR I=LEN(LINE$)+E TO ABS(TYPE(N)) 
0800LINE$(I)=" " 
0810NEXT I 
0820ELSE  
0830OK=B 
0840ENDIF  
0850ELSE  
0860EXEC CHECK(LINE$,OK) 
0870IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B 
0880ENDIF  
0890UNTIL OK<>B 
0900ENDPROC  
0910PROC SKRIVPICT 
0920CLEAR  
0930FOR I=E TO A 
0940CURSOR X(I),Y(I) 
0945PRINT USING "### ":I; 
0950PRINT PICT$(I) 
0960NEXT I 
0970ENDPROC  
0975PROC OUTPLINE(N) 
0977PRINT TAB(X(N)); 
0979PRINT USING "### ":N; 
0981PRINT PICT$(N);TAB(X(N)+25);LINE$ 
0983ENDPROC  
9000A=8 
9010DIM X(A),Y(A),PICT$(A,20),TYPE(A) 
9011DIM POST1$(55),POST2$(34),DAD$(6) 
9020DIM BL$(79),LINE$(30),FIL$(20) 
9025OUTP=B 
9030FOR I=E TO 79 
9031BL$=BL$+" " 
9032NEXT I 
9040FIL$="P641220:VIRKKART" 
9200FOR I=E TO A 
9210X(I)=E 
9220Y(I)=E+G*I 
9230NEXT I 
9240PICT$(E)="CIR-nr" 
9250TYPE(E)=7 
9260PICT$(G)="Navn" 
9270TYPE(G)=-25 
9280PICT$(V)="Adresse" 
9290TYPE(V)=-23 
9300PICT$(4)="Postnr" 
9310TYPE(4)=4 
9320PICT$(5)="By" 
9330TYPE(5)=-14 
9340PICT$(6)="Aftalenr i PI" 
9350TYPE(6)=6 
9360PICT$(7)="Kontonr i PI" 
9370TYPE(7)=10 
9372PICT$(8)="System-dato" 
9374TYPE(8)=6 
9380Æ=B 
9390EXEC INDVIRK 
9400REPEAT  
9405SV=G 
9410CLEAR  
9420CURSOR 10,10 
9430PRINT "V I R K S O M H E D S - K A R T O T E K" 
9440PRINT  
9450PRINT TAB(10);"0 Færdig" 
9460PRINT TAB(10);"1 Ændring" 
9470PRINT TAB(10);"2 Udskrift på skærm" 
9480PRINT TAB(10);"3 Udskrift på printer" 
9490PRINT  
9500REPEAT  
9510CURSOR E,17 
9520EDIT "          ",SV 
9530UNTIL SV=>B AND SV<=V 
9540CASE SV OF  
9550WHEN E 
9560EXEC SKRIVOPL 
9570REPEAT  
9580REPEAT  
9585SV1=B 
9590CURSOR E,23 
9600EDIT "Feltnr ",SV1 
9610UNTIL SV1=>B AND SV1<W 
9620IF SV1>B THEN  
9630EXEC INOPL(SV1) 
9640Æ=E 
9650ENDIF  
9660UNTIL SV1=B 
9670WHEN G 
9675OUTP=B 
9680EXEC SKRIVOPL 
9685INPUT "RETURN",LINE$ 
9690WHEN V 
9700OUTPUT P 
9705OUTP=E 
9710EXEC SKRIVOPL 
9711FOR I=W TO 72 
9712PRINT  
9713NEXT I 
9715OUTP=B 
9720OUTPUT T 
9730ENDCASE  
9740UNTIL SV=B 
9750IF Æ=E THEN  
9760EXEC UDVIRK 
9790ENDIF  
9800CLOSE  
9810CHAIN "P641210:STARTB"