|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 14615 (0x3917) Types: Q1_Text, reclen=79 Notes: q1file Names: »BOKRUT1«
└─⟦aeb45b905⟧ Bits:30008623 DDMQ1-0063__LMC_Original_Generella_pgm_for_bokforing_Sid1_PL1_Sid2_kompil_781105_side1 └─⟦this⟧ »BOKRUT1« └─⟦f4c608b16⟧ Bits:30008624 DDMQ1-0064_LMC_Kopia_Generall_pgm_for_bokforing_Endast_PL1-vers_781105_B └─⟦this⟧ »BOKRUT1«
/*FÖRSTA RADEN*/ /*BOKRUT TABLÅPROGRAM FÖR NYA VERS AV BOKFÖRINGSRUTINER. GENERELL. REV 781104 PROGR:TD */ /*FÖLJANDE DATAFILER BEHÖVS: MON:AKTUELL VERFIL VERSORT:ATT KOPIERA MON I SAMFIL, KTOTX, SAMSORT:ATT KOPIERA SAMFIL OCH KTOTX I DATFIL:SORTERINGSDATA,DATUM OSV SORTERINGSDATA: 1-12 GÄLLER VERFILERNA 1-12 (T.EX JAN-DEC), K=KONTONR.ORDN,V=VER.NR ORDN. 13 GÄLLER SAMFIL. K=KONTONUMMERORDN,A=AVDELN.ORDN,P=PROJEKTORDN (ANV.EJ HÄR) 14 GÄLLER KTOTX. K=KONTONR.ORDN NUMERISK,k=NUMMERORDN 1,10,101,1010,11,110 OSV. */ DCL DATFIL FILE,S CHAR(2),ANT BINARY,SUB CHAR(90),INFO(5) CHAR(128), LB(24) LABEL INIT(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16, A17,A18,A19,A20,A21,A22,A23,A24),SAMFIL FILE,INF CHAR(128),KTOTX FILE; DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SORTKOD(14) CHAR(1), 2 CO FIXED(1); DCL M_STR CHAR(50) INIT(' JAN,FEB,MAR,APR,MAJ,JUN,JUL,AUG,SEP,OKT,NOV,DEC'); OPEN DATFIL;READ FILE(DATFIL)INTO(DATREC); L0: PUT FILE(D) SKIP EDIT (' ******* VAD VILL DU GÖRA? *******') (A(37))(' (TRYCK RETURN FÖR NY TABLÅ)')(A(37)) (' 1 - AVSLUTA PROGRAMKÖRNINGEN')(A(37)) (' 2 - MAN. REGISTRERING AV VERIF.')(A(37)) (' 3 - VERIFIKATIONSLISTA')(A(37)) (' 4 - AKTUELLT SALDO,VISSA KONTON')(A(37)) (' 5 - UTSKRIFT AV KONTOPLANEN')(A(37)) (' 6 - HUVUDBOK')(A(35)); GET SKIP LIST(S);PUT FILE(D) SKIP; IF S='1 ' THEN GO TO A1; IF S='2 'öS='3 'öS='4 'öS='5 'öS='6 ' THEN GO TO PER; L1:PUT FILE(D) SKIP EDIT('')(A(42))('(TRYCK RETURN FÖR NY TABLÅ)')(A(32)) (' 7 - RES.RÄKN. (TOT ELLER PER AVD)')(A(37)) (' 8 - BAL.RÄKN.')(A(37)) (' 9 - RÅBALANS FÖR BOKSLUT')(A(37)) (' 10 - UTSKRIFT AV INGÅENDE BALANSER')(A(37)) (' 11 - UTSKRIFT AV BUDGET')(A(34));GET SKIP LIST(S);PUT FILE(D)SKIP; IF S='7 'öS='8 'öS='9 'öS='10'öS='11' THEN GO TO PER; L2:PUT FILE(D)EDIT('')(A(42))('(TRYCK RETURN FÖR NY TABLÅ)')(A(32)) (' 12 - UPPLÄGGNING AV NYA KONTON')(A(37)) (' 13 - ÄNDRINGAR I KONTOPLANEN')(A(37)) (' 14 - INMATNING AV INGÅENDE BALANSER')(A(37)) (' 15 - INMATNING AV BUDGET')(A(37)) (' 16 - RUTIN FÖR NYTT BOKFÖRINGSÅR')(A(34)); GET SKIP LIST(S);PUT FILE(D)SKIP; IF S='12'öS='13'öS='14'öS='15' THEN GO TO PER; IF S='16' THEN GO TO A16; GO TO L0; PER:MON=' ';MNR=0;PUT FILE(D)SKIP; IF S='2 ' THEN PUT FILE(D)EDIT(' BOKF.')(A); ELSE PUT FILE(D)SKIP EDIT(' ANGE ')(A); PUT FILE(D)EDIT('DAGENS DATUM (ÅÅMMDD):')(A(25)); GET SKIP LIST(DAG);PUT FILE(D) SKIP; IF S='6 'ö S='7 'öS='2 'öS='3 'öS='4 'öS='8 ' THEN GO TO MONIN;GO TO VX; MONIN:PUT FILE(D) SKIP EDIT('VILKEN MÅNAD SKA AVSES?')(A(37)) ('SVARA "JAN" "APR" ELLER LIKN')(A(37))('ANGE ALLTID TRE BOKSTÄVER:')(A(34)); GET SKIP LIST(MON);PUT FILE(D) SKIP; MNR=0; MNR=INDEX(M_STR,MON)/4; IF MNR=0 THEN GO TO MONIN; MNR=MNR-8; /* HÄR LÄGGER MAN TILL DET ANTAL MÅNADERS "OFFSET" SOM BOKFÖRINGSÅRET HAR I DET AKTUELLA FALLET. OM FÖRSTA MÅNADEN T.EX ÄR JULI SUBTRAHERAS EN SEXA (6) */ IF MNR<1 THEN MNR=MNR+12; VX:II=S;IF II¬=0 THEN GO TO LB(II); GO TO L0; A2:INF='VERIFIN ' CAT MON; REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,11);GO TO UT; A3:ANT=0; INFO(1)='';IF SORTKOD(MNR)¬='V' THEN DO; INFO(1)='SORT,O ' CAT MON CAT ' VERSORT 9 ';ANT=21;END; SORTKOD(MNR)='V';REWRITE FILE(DATFIL)FROM(DATREC); INFO(2)='VERIFUT ' CAT MON;ANT=ANT+11; INF=INFO(1) CAT INFO(2); CALL LOAD(INF,ANT);GO TO UT; A6:OPEN SAMFIL;CALL SEOF(SAMFIL); IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K'; ANT=0;INFO(1)='';INFO(2)=''; IF SORTKOD(MNR)¬='K' THEN DO; INFO(1)='SORT ' CAT MON CAT ' VERSORT ';ANT=17;END; IF SORTKOD(13)¬='K' THEN DO;INFO(2)='SORT SAMFIL ' CAT 'SAMSORT ';ANT=ANT+20;END; SORTKOD(MNR)='K';SORTKOD(13)='K';REWRITE FILE(DATFIL)FROM(DATREC); INF=INFO(1) CAT INFO(2) CAT 'HUVBOK ' CAT MON;ANT=ANT+10; CALL LOAD(INF,ANT); GO TO UT; A7:PUT FILE(D)SKIP EDIT('1 - PER AVDELNING')(A(37)) ('2 - TOTALT ALLA AVD.')(A(35)); GET SKIP LIST(S); IF VERIFY(SUBSTR(S,1,1),'12')=0 THEN GO TO A7; PUT FILE(D)SKIP; INFO(1)='';INFO(2)=''; IF S='1 ' THEN DO; OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0; ANT=0;IF SORTKOD(13)¬='A' THEN DO;INFO(1)='ALTA ' CAT 'SORT SAMFIL SAMSORT ALTB ';ANT=30;SORTKOD(13)='A';END; IF SORTKOD(14)¬='A' THEN DO;INFO(2)='ALTE SORT KTOTX SAMSORT ALTF '; ANT=ANT+29;SORTKOD(14)='A';END; INFO(3)='AVDRES';ANT=ANT+6;END; IF S='2 ' THEN DO; OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0; ANT=0;IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT ' CAT 'SAMFIL SAMSORT ';ANT=20;SORTKOD(13)='K';END; IF SORTKOD(14)¬='K' THEN DO;INFO(2)='SORT KTOTX ' CAT 'SAMSORT ';SORTKOD(14)='K';ANT=ANT+19;END; INFO(3)='RESRÄKN';ANT=ANT+7;END; INF=INFO(1) CAT INFO(2) CAT INFO(3); REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A8:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0; ANT=0;INFO(1)='';INFO(2)=''; IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT SAMFIL SAMSORT ';ANT=20;END; IF SORTKOD(14)¬='K' THEN DO;INFO(2)='SORT KTOTX ' CAT 'SAMSORT ';ANT=ANT+19;END; INF=INFO(1) CAT INFO(2) CAT 'BALRÄKN';ANT=ANT+7; SORTKOD(13)='K';SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A12:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('KOUPP',5);GO TO UT; A14:ANT=0;INFO(1)='';IF SORTKOD(14)¬='K' THEN DO; INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END; SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC); INF=INFO(1) CAT 'IBALIN';ANT=ANT+6; CALL LOAD(INF,ANT);GO TO UT; A13:REWRITE FILE(DATFIL)FROM(DATREC);CALL LOAD('KOALT',5);GO TO UT; A5:ANT=0;INFO(1)='';IF SORTKOD(14)¬='k' THEN DO; INFO(1)='SORT,O KTOTX SAMSORT 4 ';ANT=23;END; INF=INFO(1) CAT 'KOUT';ANT=ANT+4; SORTKOD(14)='k';REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A10:ANT=0;INFO(1)='';IF SORTKOD(14)¬='K' THEN DO; INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END; INF=INFO(1) CAT 'IBALUT';ANT=ANT+6; SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A15:REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD('BUDGIN',6);GO TO UT; A11:ANT=0;INFO(1)='';IF SORTKOD(14)¬='K' THEN DO; INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END; INF=INFO(1) CAT 'BUDGUT';ANT=ANT+6; SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A9:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN GO TO L0; ANT=0;INFO(1)='';INFO(2)=''; IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT SAMFIL SAMSORT ';ANT=20;END; IF SORTKOD(14)¬='K' THEN DO;INFO(2)='SORT KTOTX ' CAT 'SAMSORT ';ANT=ANT+19;END; INF=INFO(1) CAT INFO(2) CAT 'BOKSLUT';ANT=ANT+7; SORTKOD(13)='K';SORTKOD(14)='K';REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A1:GO TO UT; A4:OPEN SAMFIL;CALL SEOF(SAMFIL);IF UNSPEC(SAMFIL)=0 THEN SORTKOD(13)='K'; ANT=0;INFO(1)='';INFO(2)=''; IF SORTKOD(13)¬='K' THEN DO;INFO(1)='SORT SAMFIL SAMSORT ';ANT=20;END; IF SORTKOD(MNR)¬='K' THEN DO; INFO(2)='SORT ' CAT MON CAT ' VERSORT ';ANT=ANT+17;END; INF=INFO(1) CAT INFO(2) CAT 'AKTSAL ' CAT MON;ANT=ANT+10; SORTKOD(13)='K';SORTKOD(MNR)='K';REWRITE FILE(DATFIL)FROM(DATREC); CALL LOAD(INF,ANT);GO TO UT; A16:DAG='YYYYYY';REWRITE FILE(DATFIL)FROM(DATREC); PUT FILE(D) SKIP EDIT ('SÄTT IN EN DISKETT MED EN FIL')(A(37)) ('SOM HETER NYKTOTX,MED RECORDLÄNGD=55')(A(37)) ('OCH MINST LIKA STOR SOM KTOTX.')(A(37)) ('VERIFIKATIONSDISKETTEN BEHÖVS EJ')(A(37)) ('FILEN SAMSORT FÅR EJ TAS BORT')(A(37)) ('ÄR DU KLAR?')(A(74)) ('SVARA "J" ELLER "N":')(A(36));GET SKIP LIST(S); IF S¬='J ' THEN GO TO L0; PUT FILE(D)SKIP; ANT=0;INFO(1)='';INFO(2)='';INFO(3)='';IF SORTKOD(14)¬='K' THEN DO; INFO(1)='SORT KTOTX SAMSORT ';ANT=19;END; INFO(2)='DISK C KTOTX NYKTOTX ';ANT=ANT+21; IF SORTKOD(13)¬='K' THEN DO;INFO(3)='SORT SAMFIL SAMSORT ';ANT=ANT+20;END; SORTKOD(13)='K'; INF=INFO(1) CAT INFO(3) CAT INFO(2) CAT 'NYÅR';ANT=ANT+4; CALL LOAD(INF,ANT);GO TO UT; UT:END;