⟦f393d86c4⟧

Mikados K File

0010DIM CPR(10),POST3$(55),POST4$(34),FIL2$(20),POST5$(55),POST6$(55) 
0025DIM NUL$(11),TV$(45,11),FIL1$(20),DAD$(6) 
0040PROC CPRCHECK(NR4,OK4) 
0055OK4=E 
0070FOR I=E TO 10 
0085CPR(I)=ORD(NR4$(I))-48 
0100NEXT I 
0115DATO=CPR(E)*10+CPR(G) 
0130MÅNED=CPR(V)*10+CPR(4) 
0145ÅR=CPR(5)*10+CPR(6) 
0160IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK4=B 
0175IF OK4=B THEN EXIT  
0190CASE MÅNED OF  
0205WHEN 4,6,W,11 
0220IF DATO>30 THEN OK4=B 
0235WHEN G 
0250IF DATO>29 THEN OK4=B 
0265IF DATO=29 AND ÅR MOD 4<>B THEN OK4=B 
0280ENDCASE  
0295IF OK4=B THEN EXIT  
0310MODULC=CPR(E)*4+CPR(G)*V+CPR(V)*G+CPR(4)*7+CPR(5)*6+CPR(6)*5+CPR(7)*4 
0325MODULC=MODULC+CPR(8)*V+CPR(W)*G+CPR(10) 
0340IF MODULC MOD 11<>B THEN OK4=B 
0355ENDPROC  
0370PROC DATOCHECK(NR5,OK5) 
0385OK5=E 
0400ÅR=(ORD(NR5$(E))-48)*10+ORD(NR5$(G))-48 
0415MÅNED=(ORD(NR5$(V))-48)*10+ORD(NR5$(4))-48 
0430DATO=(ORD(NR5$(5))-48)*10+ORD(NR5$(6))-48 
0445IF DATO<E OR MÅNED<E OR MÅNED>12 OR DATO>31 THEN OK5=B 
0460IF OK5=B THEN EXIT  
0475CASE MÅNED OF  
0490WHEN 4,6,W,11 
0505IF DATO>30 THEN OK5=B 
0520WHEN G 
0535IF DATO>29 THEN OK5=B 
0550IF DATO=29 AND ÅR MOD 4<>B THEN OK5=B 
0565ENDCASE  
0580ENDPROC  
0581PROC NULTRANS(N) 
0582J=(N-E)*ATPLM 
0583FOR I=E TO ATPLM 
0584PUT FIL1$,J+I:BL$(E,37) 
0585NEXT I 
0586EXEC FEJL(N,ATPLM,FIL1$) 
0587ENDPROC  
0595PROC NULTÆL(N) 
0610J=W*(N-E)+E 
0625FOR I=J TO J+8 
0640PUT FIL2$,I:POST6$ 
0655NEXT I 
0670EXEC FEJL(I,N,FIL2$) 
0685ENDPROC  
0700PROC INDTÆL(N) 
0715J=W*(N-E) 
0730FOR K=6 TO W 
0745GET FIL2$,J+K:POST5$ 
0760FOR I=E TO 5 
0775TV$((K-E)*5+I)=POST5$((I-E)*11+E:11) 
0790NEXT I 
0805NEXT K 
0820EXEC FEJL(N,K,FIL2$) 
0835ENDPROC  
0850PROC INLØNMOD(N) 
0865GET FIL$,G*N-E:POST1$ 
0880GET FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0895EXEC FEJL(E,N,FIL$) 
0910ENDPROC  
0925PROC UDLØNMOD(N) 
0940PUT FIL$,G*N-E:POST1$ 
0955PUT FIL$,G*N:POST2$,C1,C2,LT,LF,LR,LA,RPI,K1,K2,FG,FD 
0970EXEC FEJL(G,N,FIL$) 
0985ENDPROC  
1000PROC CONV(NR2,OK22,CIF) 
1015OK2=OK22 
1030NR2$="" 
1045REPEAT  
1060NR2$=CHR((OK2 MOD 10)+48)+NR2$ 
1075CIF=CIF-E 
1090OK2=OK2 DIV 10 
1105IF CIF<B AND OK2=B THEN CIF=B 
1120UNTIL CIF=B 
1135ENDPROC  
1150PROC CHECK(NR1,OK1) 
1165OK1=B 
1180RESULT=B 
1195IF LEN(NR1$)>B THEN  
1210IF NR1$(E)="-" THEN  
1225FORTEGN=-E 
1240OK1=E 
1255ELSE  
1270FORTEGN=E 
1285ENDIF  
1300WHILE LEN(NR1$)>OK1 
1315OK1=OK1+E 
1330IF NR1$(OK1)<"0" OR NR1$(OK1)>"9" THEN  
1345FORTEGN=B 
1360OK1=LEN(NR1$) 
1375ENDIF  
1390RESULT=RESULT*10+ORD(NR1$(OK1))-48 
1405ENDWHILE  
1420OK1=OK1*FORTEGN 
1435IF OK1<B THEN OK1=OK1+E 
1450ENDIF  
1465ENDPROC  
1480PROC INOPL(OPL) 
1495EXEC INLINE(OPL) 
1510CASE OPL OF  
1525WHEN E 
1540LMNR=RESULT 
1555WHEN G 
1570POST1$(E,25)=LINE$ 
1585WHEN V 
1600POST1$(26,48)=LINE$ 
1615WHEN 4 
1630POST1$(49,71)=LINE$ 
1645WHEN 5 
1660POST2$(E,4)=LINE$ 
1675WHEN 6 
1690POST2$(5,18)=LINE$ 
1705WHEN 7 
1720EXEC CPRCHECK(LINE$,C1) 
1735WHILE C1=B 
1750EXEC INLINE(OPL) 
1765EXEC CPRCHECK(LINE$,C1) 
1780ENDWHILE  
1795C1=DATO*10000+MÅNED*100+ÅR 
1810C2=CPR(10)+CPR(W)*10+CPR(8)*100+CPR(7)*1000 
1825WHEN 8 
1840WHILE RESULT<B OR RESULT>99 
1855EXEC INLINE(OPL) 
1870ENDWHILE  
1885LT=RESULT 
1900WHEN W 
1915WHILE RESULT<B OR RESULT>999999 
1930EXEC INLINE(OPL) 
1945ENDWHILE  
1960LF=RESULT 
1975IF LF>B THEN  
1990LR=B 
2005EXEC CONV(LINE$,LR,6) 
2020EXEC OUTLINE(10) 
2035ENDIF  
2050WHEN 10 
2065WHILE RESULT<B OR RESULT>999999 
2080EXEC INLINE(OPL) 
2095ENDWHILE  
2110LR=RESULT 
2125IF LR>B THEN  
2140LF=B 
2155EXEC CONV(LINE$,LF,6) 
2170EXEC OUTLINE(9) 
2185ENDIF  
2200WHEN 11 
2215EXEC DATOCHECK(LINE$,LA) 
2230WHILE LA=B 
2245EXEC INLINE(OPL) 
2260EXEC DATOCHECK(LINE$,LA) 
2275ENDWHILE  
2290LA=RESULT 
2305WHEN 12 
2320POST2$(19,20)=LINE$ 
2335WHEN 13 
2350RPI=RESULT 
2365WHEN 14 
2380K1=(ORD(LINE$(E))-48)*10000+(ORD(LINE$(G))-48)*1000 
2395K1=K1+(ORD(LINE$(V))-48)*100+(ORD(LINE$(4))-48)*10+ORD(LINE$(5))-48 
2410K2=(ORD(LINE$(6))-48)*10000+(ORD(LINE$(7))-48)*1000 
2425K2=K2+(ORD(LINE$(8))-48)*100+(ORD(LINE$(W))-48)*10+ORD(LINE$(10))-48 
2440WHEN 15 
2455WHILE RESULT<E OR RESULT>7 
2470EXEC INLINE(OPL) 
2485ENDWHILE  
2500POST2$(21)=LINE$ 
2515WHEN 16 
2530WHILE RESULT<E OR RESULT>5 
2545EXEC INLINE(OPL) 
2560ENDWHILE  
2575POST2$(22)=LINE$ 
2590WHEN 17 
2605WHILE RESULT<E OR RESULT>4 
2620EXEC INLINE(OPL) 
2635ENDWHILE  
2650POST2$(23)=LINE$ 
2665WHEN 18 
2680WHILE RESULT<E 
2695EXEC INLINE(OPL) 
2710ENDWHILE  
2725POST2$(24,25)=LINE$ 
2740WHEN 19 
2755FG=RESULT 
2770WHEN 20 
2785WHILE RESULT<B OR RESULT>V 
2800EXEC INLINE(OPL) 
2815ENDWHILE  
2830POST2$(26)=LINE$ 
2845WHEN 21 
2860EXEC DATOCHECK(LINE$,FD) 
2875WHILE FD=B AND RESULT<>B 
2890EXEC INLINE(OPL) 
2905EXEC DATOCHECK(LINE$,FD) 
2920ENDWHILE  
2935FD=RESULT 
2950ENDCASE  
2965ENDPROC  
2980PROC SKRIVOPL 
2995IF OUTP=B THEN CLEAR  
3000PRINT "L Ø N M O D T A G E R K A R T O T E K";TAB(60);"Dato ";DAD$ 
3010FOR J=E TO A 
3025CASE J OF  
3040WHEN E 
3055EXEC CONV(LINE$,LMNR,0) 
3070WHEN G 
3085LINE$=POST1$(E,25) 
3100WHEN V 
3115LINE$=POST1$(26,48) 
3130WHEN 4 
3145LINE$=POST1$(49,71) 
3160WHEN 5 
3175LINE$=POST2$(E,4) 
3190WHEN 6 
3205LINE$=POST2$(5,18) 
3220WHEN 7 
3235EXEC CONV(LINE$,C1,6) 
3250EXEC CONV(LINE1$,C2,4) 
3265LINE$=LINE$+LINE1$ 
3280WHEN 8 
3295EXEC CONV(LINE$,LT,0) 
3310WHEN W 
3325EXEC CONV(LINE$,LF,6) 
3340WHEN 10 
3355EXEC CONV(LINE$,LR,6) 
3370WHEN 11 
3385EXEC CONV(LINE$,LA,6) 
3400WHEN 12 
3415LINE$=POST2$(19,20) 
3430WHEN 13 
3445EXEC CONV(LINE$,RPI,6) 
3460WHEN 14 
3475EXEC CONV(LINE$,K1,5) 
3490EXEC CONV(LINE1$,K2,5) 
3505LINE$=LINE$+LINE1$ 
3520WHEN 15 
3535LINE$=POST2$(21) 
3550WHEN 16 
3565LINE$=POST2$(22) 
3580WHEN 17 
3595LINE$=POST2$(23) 
3610WHEN 18 
3625LINE$=POST2$(24,25) 
3640WHEN 19 
3655EXEC CONV(LINE$,FG,5) 
3670WHEN 20 
3685LINE$=POST2$(26) 
3700WHEN 21 
3715EXEC CONV(LINE$,FD,6) 
3730ENDCASE  
3745IF OUTP=B THEN  
3760EXEC OUTLINE(J) 
3775ELSE  
3790EXEC OUTPLINE(J) 
3805ENDIF  
3820NEXT J 
3835ENDPROC  
3850PROC OUTLINE(N) 
3865CURSOR X(N),Y(N) 
3880PRINT USING "### ":N; 
3895PRINT PICT$(N);":";LINE$ 
3910ENDPROC  
3925PROC INDVIRK 
3940OPEN FIL$,W 
3955EXEC FEJL(B,B,FIL$) 
3970GET FIL$,E:POST3$ 
3985GET FIL$,G:POST4$,SLJNR,MLMNR,ATPLM 
3990GET FIL$,V:DAD$ 
4000ENDPROC  
4015PROC FEJL(P1,P2,P3) 
4030IF STATUS(P3$)<>B THEN  
4045OUTPUT T 
4060PRINT "FIL-FEJL ";P3$;STATUS(P3$),P1;P2 
4075STOP  
4090ENDIF  
4105ENDPROC  
4120PROC INLINE(N) 
4135REPEAT  
4150CURSOR X(N)+5+LEN(PICT$(N)),Y(N) 
4165PRINT BL$(E:ABS(TYPE(N))+V) 
4180CURSOR X(N),Y(N) 
4195PRINT USING "### ":N; 
4210PRINT PICT$(N);":"; 
4225INPUT "",LINE$ 
4240IF TYPE(N)<B THEN  
4255IF LEN(LINE$)<=ABS(TYPE(N)) THEN  
4270OK=E 
4285FOR I=LEN(LINE$)+E TO ABS(TYPE(N)) 
4300LINE$(I)=" " 
4315NEXT I 
4330ELSE  
4345OK=B 
4360ENDIF  
4375ELSE  
4390EXEC CHECK(LINE$,OK) 
4405IF TYPE(N)>B AND TYPE(N)<>OK THEN OK=B 
4420ENDIF  
4435UNTIL OK<>B 
4450ENDPROC  
4465PROC SKRIVPICT 
4480CLEAR  
4495FOR I=E TO A 
4510CURSOR X(I),Y(I) 
4525PRINT USING "### ":I; 
4540PRINT PICT$(I);":" 
4555NEXT I 
4570ENDPROC  
4585PROC OUTPLINE(N) 
4600PRINT TAB(X(N)); 
4615PRINT USING "### ":N; 
4630PRINT PICT$(N);":";LINE$; 
4632IF N=21 THEN  
4634PRINT  
4636ELSE  
4638IF Y(N)<Y(N+E) THEN PRINT  
4640ENDIF  
4645ENDPROC  
4660A=21 
4675DIM X(A),Y(A),PICT$(A,20),TYPE(A) 
4690DIM POST1$(71),POST2$(27) 
4705DIM BL$(79),LINE$(30),FIL$(20),LINE1$(30) 
4720FOR I=E TO 79 
4735BL$=BL$+" " 
4750NEXT I 
4765FIL$="P641220:VIRKKART" 
4780X(E)=E 
4795X(G)=30 
4810X(V)=E 
4825X(4)=E 
4840X(5)=E 
4855X(6)=30 
4870X(7)=E 
4885X(8)=30 
4900X(W)=E 
4915X(10)=30 
4930X(11)=E 
4945X(12)=30 
4960X(13)=E 
4975X(14)=30 
4990X(15)=E 
5005X(16)=30 
5020X(17)=60 
5035X(18)=E 
5050X(19)=30 
5065X(20)=60 
5080X(21)=E 
5095Y(E)=G 
5110Y(G)=G 
5125Y(V)=4 
5140Y(4)=6 
5155Y(5)=8 
5170Y(6)=8 
5185Y(7)=10 
5200Y(8)=10 
5215Y(W)=12 
5230Y(10)=12 
5245Y(11)=14 
5260Y(12)=14 
5275Y(13)=16 
5290Y(14)=16 
5305Y(15)=18 
5320Y(16)=18 
5335Y(17)=18 
5350Y(18)=20 
5365Y(19)=20 
5380Y(20)=20 
5395Y(21)=22 
5410TYPE(E)=B 
5425TYPE(G)=-25 
5440TYPE(V)=-23 
5455TYPE(4)=-23 
5470TYPE(5)=4 
5485TYPE(6)=-14 
5500TYPE(7)=10 
5515TYPE(8)=B 
5530TYPE(W)=B 
5545TYPE(10)=B 
5560TYPE(11)=6 
5575TYPE(12)=B 
5590TYPE(13)=6 
5605TYPE(14)=10 
5620TYPE(15)=E 
5635TYPE(16)=E 
5650TYPE(17)=E 
5665TYPE(18)=G 
5680TYPE(19)=5 
5695TYPE(20)=E 
5710TYPE(21)=6 
5725PICT$(E)="Lønnr" 
5740PICT$(G)="Navn" 
5755PICT$(V)="Adresse 1" 
5770PICT$(4)="Adresse 2" 
5785PICT$(5)="Postnr" 
5800PICT$(6)="By" 
5815PICT$(7)="CPR-nr" 
5830PICT$(8)="Trækpct" 
5845PICT$(W)="Skattefr 1 md" 
5860PICT$(10)="Rest frikort" 
5875PICT$(11)="Ansættelses dato" 
5890PICT$(12)="Afd-nr" 
5905PICT$(13)="Reg-nr, PI" 
5920PICT$(14)="Kto-nr, PI" 
5935PICT$(15)="Lønperiode" 
5950PICT$(16)="Feriekode" 
5965PICT$(17)="SH-kode" 
5980PICT$(18)="OR-kode" 
5995PICT$(19)="Faggr-kode" 
6010PICT$(20)="Dagp-kode" 
6025PICT$(21)="Fratrædelsesdato" 
6040EXEC INDVIRK 
6055CLOSE FIL$ 
6070FIL$="P641220:LØNMODRG" 
6085OPEN FIL$,W 
6100EXEC FEJL(B,B,FIL$) 
6115NUL$="         0+" 
6130OUTP=B 
6145FIL2$="P641220:TÆLLEREG" 
6160OPEN FIL2$,W 
6175EXEC FEJL(B,B,FIL2$) 
6190POST6$="" 
6205FOR J=E TO 5 
6220POST6$=POST6$+NUL$ 
6235NEXT J 
6236FIL1$="P641220:TRANSREG" 
6237OPEN FIL1$,W 
6238EXEC FEJL(B,B,FIL1$) 
6250REPEAT  
6265SV=G 
6280CLEAR  
6295CURSOR 10,10 
6310PRINT "L Ø N M O D T A G E R - K A R T O T E K" 
6325PRINT  
6340PRINT TAB(10);"0 Færdig" 
6355PRINT TAB(10);"1 Ændring" 
6370PRINT TAB(10);"2 Udskrift på skærm" 
6385PRINT TAB(10);"3 Udskrift på printer" 
6400PRINT TAB(10);"4 Oprettelse" 
6415PRINT TAB(10);"5 Sletning" 
6430PRINT  
6445REPEAT  
6460CURSOR E,19 
6475EDIT "          ",SV 
6490UNTIL SV=>B AND SV<=5 
6505IF SV>B THEN  
6520REPEAT  
6535EXEC INOPL(1) 
6550UNTIL LMNR=>B AND LMNR<=MLMNR 
6551LISTE=B 
6552IF LMNR=B THEN LISTE=E 
6553REPEAT  
6554IF LISTE=E THEN LMNR=LMNR+E 
6565EXEC INLØNMOD(LMNR) 
6580CASE SV OF  
6595WHEN E 
6610IF LA<>B THEN  
6625EXEC SKRIVOPL 
6640REPEAT  
6655REPEAT  
6670SV1=B 
6685CURSOR E,23 
6700EDIT "Feltnr ",SV1 
6715UNTIL SV1>E AND SV1<22 OR SV1=B 
6730IF SV1>B THEN  
6745EXEC INOPL(SV1) 
6760ENDIF  
6775UNTIL SV1=B 
6790EXEC UDLØNMOD(LMNR) 
6805ELSE  
6820PRINT "Lønmodtager findes ikke" 
6835INPUT "RETURN",LINE$ 
6850ENDIF  
6865WHEN G 
6880IF LA<>B THEN  
6895OUTP=B 
6910EXEC SKRIVOPL 
6925INPUT "RETURN",LINE$ 
6940ELSE  
6955PRINT "Lønmodtager findes ikke" 
6970INPUT "RETURN",LINE$ 
6985ENDIF  
7000WHEN V 
7015IF LA<>B OR LISTE=E THEN  
7016IF LA<>B THEN  
7030OUTPUT P 
7045OUTP=E 
7060EXEC SKRIVOPL 
7062FOR I=13 TO 72 
7064PRINT  
7066NEXT I 
7075OUTP=B 
7090OUTPUT T 
7095ENDIF  
7105ELSE  
7120PRINT "Lønmodtager findes ikke" 
7135INPUT "RETURN",LINE$ 
7150ENDIF  
7165WHEN 4 
7180IF LA<>B THEN  
7195PRINT "Lønmodtager findes allerede" 
7210INPUT "RETURN",LINE$ 
7225ELSE  
7240EXEC SKRIVPICT 
7255EXEC CONV(LINE$,LMNR,0) 
7270EXEC OUTLINE(1) 
7275FD=B 
7285FOR J=G TO 18 
7300EXEC INOPL(J) 
7315NEXT J 
7330IF RESULT<80 THEN  
7345EXEC INOPL(19) 
7360EXEC INOPL(20) 
7375ELSE  
7390FG=B 
7405POST2$(26)="0" 
7420ENDIF  
7435REPEAT  
7450REPEAT  
7465SV1=B 
7480CURSOR E,23 
7495EDIT "Feltnr ",SV1 
7510UNTIL SV1>E AND SV1<22 OR SV1=B 
7525IF SV1>B THEN  
7540EXEC INOPL(SV1) 
7555ENDIF  
7570UNTIL SV1=B 
7585EXEC NULTÆL(LMNR) 
7600EXEC UDLØNMOD(LMNR) 
7615ENDIF  
7630WHEN 5 
7645IF LA<>B THEN  
7660SV1=G 
7675EXEC INDTÆL(LMNR) 
7705IF TV$(34)<>NUL$ THEN SV1=B 
7706IF TV$(35)<>NUL$ THEN SV1=B 
7707IF TV$(36)<>NUL$ THEN SV1=B 
7708IF TV$(37)<>NUL$ THEN SV1=B 
7709IF TV$(38)<>NUL$ THEN SV1=B 
7710IF TV$(39)<>NUL$ THEN SV1=B 
7735IF SV1=B THEN  
7750CURSOR E,23 
7765INPUT "Sletning ikke tilladt  RETURN ",LINE$ 
7780ELSE  
7795EXEC SKRIVOPL 
7800ENDIF  
7810 WHILE SV1<>0 AND SV1<>1
7812 SV1=0
7825 CURSOR 1,23
7840 EDIT "Sletning korrekt 1:  ",SV1
7855 ENDWHILE 
7870 IF SV1=1 THEN 
7885 LA=0
7900 EXEC UDLØNMOD(LMNR)
7910 EXEC NULTRANS(LMNR)
7915 EXEC NULTÆL(LMNR)
7930 ENDIF 
7945 ELSE 
7960 PRINT "Lønmodtager findes ikke"
7975 INPUT "RETURN",LINE$
7990 ENDIF 
8005 ENDCASE 
8006 UNTIL LISTE=0 OR LMNR=>MLMNR
8010 ENDIF 
8020 UNTIL SV=0
8035 CLOSE FIL$
8050 CLOSE FIL2$
8065 CHAIN "P641210:STARTB"
DataMuseum.dk

MIKADOS

⟦f393d86c4⟧ TextFile

Derivation

Mikados K File

Full view
