|
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: 3950 (0xf6e)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »ETIKETT1«
└─⟦22252c168⟧ Bits:30008711 DDMQ1-0151_Programmers_Disk_Copy
└─⟦this⟧ »ETIKETT1«
└─⟦23915e280⟧ Bits:30008593 DDMQ1-0026
└─⟦this⟧ »ETIKETT1«
└─⟦3dd001c96⟧ Bits:30008706 DDMQ1-0146_PROGRAMMERS_DISK_TILLHÖR_HS
└─⟦this⟧ »ETIKETT1«
/* ETIK1 RATIUS TD */
DCL 1 KUND,2 NAMN CHAR(30),2 GADR CHAR(20),2 UTDAD CHAR(20),
2 PADR CHAR(20),2 CO CHAR(25),2 TEL CHAR(11),2 BR(3) CHAR(2),
2 UPDAT CHAR(4),2 OMS(3) FIXED(4);
DCL DEL1 BINARY,DEL2 BINARY,LONG BINARY,STR(3) CHAR(30),XNAMN CHAR(30);
DCL URVALFIL FILE;
DCL ENAMN(4) CHAR(25), EADR(4) CHAR(20), ECO(4) CHAR(25),
EBR(4,3) CHAR(2),X FIXED(1),XX CHAR(25) INIT(' '),
EPAD(4) CHAR(20),SVAR CHAR(30),LETA FIXED(1); LETA=0;X=0;
DO I= 1 TO 4; ENAMN(I)=XX;ECO(I)=XX;EADR(I)=XX;EPAD(I)=XX;
DO J=1 TO 3;EBR(I,J)=XX;END;END;
ST:OPEN URVALFIL;
PUT FILE(D) SKIP EDIT('VAR SKA UTSKRIFTEN BÖRJA?')(A(37))
('OM FRÅN BÖRJAN,TRYCK RETURN')(A(37))
('ANGE ANNARS FÖRSTA NAMN (I KODFORM)')(A(37));
GET SKIP LIST(SVAR);IF SUBSTR(SVAR,1,6)¬=' ' THEN LETA=1;ELSE LETA=0;
PUT FILE(D) SKIP EDIT(XX)(A(80))('UTSKRIFT PÅGÅR')(A(216));
START:DO I=1 TO 4;IF LETA=1 THEN DO;ON ERROR GO TO ST;
READ KEY(SVAR) FILE(URVALFIL) INTO(KUND);END;
IF LETA=0 THEN DO;X=1;ON ENDFILE GO TO PRT;
READ FILE(URVALFIL) INTO(KUND);X=0;END;
ENAMN(I)=NAMN;ECO(I)=CO;DO K=1 TO 3;EBR(I,K)=BR(K);END;
EADR(I)=GADR;IF SUBSTR(UTDAD,1,4)¬=' ' THEN EADR(I)=UTDAD;EPAD(I)=PADR;
LETA=0;END;
PRT:IF I¬=1 THEN DO;PUT SKIP;DO J=1 TO I-1;PUT EDIT(XX)(A(20))
(EBR(J,1))(A(3))(EBR(J,2))(A(3))(EBR(J,3))(A(10));END;
PUT SKIP;DO J=1 TO I-1;
/*NAMNET SKA NU VÄNDAS*/
DEL1=INDEX(ENAMN(J),'+');DEL2=INDEX(ENAMN(J),' ,');LONG=INDEX(ENAMN(J),' ');
IF LONG=0 THEN LONG=28;
IF DEL1¬=0 THEN DO;STR(1)=SUBSTR(ENAMN(J),DEL1+1,LONG-DEL1-1);
STR(2)=SUBSTR(ENAMN(J),DEL2+2,DEL1-DEL2-2);STR(3)=SUBSTR(ENAMN(J),1,DEL2-1);
XNAMN=STR(1) CAT ' ' CAT STR(2) CAT ' ' CAT STR(3);END;
IF DEL1=0 THEN DO;
IF DEL2¬=0 THEN DO;STR(1)=SUBSTR(ENAMN(J),DEL2+2,LONG-DEL2-2);
STR(2)=SUBSTR(ENAMN(J),1,DEL2-1);XNAMN=STR(1) CAT ' ' CAT STR(2);END;
IF DEL2=0 THEN XNAMN=ENAMN(J);END;
PUT EDIT(XNAMN)(A(36));END;
PUT SKIP;DO J=1 TO I-1;PUT EDIT(ECO(J))(A(36));END;
PUT SKIP;DO J=1 TO I-1;PUT EDIT(EADR(J))(A(36));END;
PUT SKIP;DO J=1 TO I-1;PUT EDIT(SUBSTR(EPAD(J),1,3))(A(4))
(SUBSTR(EPAD(J),4,17))(A(32));
END;PUT SKIP;END;
DO I = 1 TO 4;ENAMN(I)=XX;EADR(I)=XX;ECO(I)=XX;
DO K=1 TO 3;EBR(I,K)=XX;END;
EPAD(I)=XX; END;IF X=0 THEN GO TO START;
SLUT: END;