PROCEDURE TEN; (* CREATE TEN RECORDS AT THE BEGINNING OF A PROJECT *) (* VAR -----make global 8/22/89jmb A_NUM,LINEPART,COMMENCE,TERMINATE,T_F_UNITS,T_FACTOR,O_AND_C, SC_CODE,CINITIALS:S; RELEV_CODE,RUN_CODE:CHAR; AGENCY:SS;*) VAR TENREC:SS; PROCEDURE CREATETEN; (* ACTUALLY CREATES AND WRITES OUT THE TEN RECORD *) BEGIN TENREC:=CONCAT('*10*',JUSTIFY( A_NUM,-8),JUSTIFY(LINEPART,-4), RELEV_CODE,JUSTIFY(COMMENCE,-8),JUSTIFY(TERMINATE,-8),T_F_UNITS, JUSTIFY(T_FACTOR,-4),O_AND_C,JUSTIFY(SC_CODE,-6), JUSTIFY(CINITIALS,-3),JUSTIFY(AGENCY,-20),' ',RUN_CODE,' '); WRITEREC(TENREC); END; PROCEDURE PRINTTEN; (* DISPLAY THE CURRENT TEN RECORD INFORMATION ON THE SCREEN *) BEGIN PCLEAR; DO_LETTERS('n',41); DWRITEXY(4,1,'SEQUENCE NUMBER',3); DWRITEXY(43,1,FRSTR(SEQNUM,1,0),3); DWRITEXY(4,2,'DATA CODE',3); DWRITEXY(43,2,'*10*',3); DWRITEXY(4,3,'ACCESSION NUMBER',3); DWRITEXY(43,3,A_NUM,3); DWRITEXY(4,4,'LINE/PART',3); DWRITEXY(43,4,LINEPART,3); DWRITEXY(4,5,'RELEVELING CODE',3); DWRITEXY(43,5,RELEV_CODE,3); DWRITEXY(4,6,'DATE FIELD OPERATIONS COMMENCED',3); DWRITEXY(43,6,COMMENCE,3); DWRITEXY(4,7,'DATE FIELD OPERATIONS TERMINATED',3); DWRITEXY(43,7,TERMINATE,3); DWRITEXY(4,8,'UNITS FOR TOLERANCE FACTOR',3); DWRITEXY(43,8,T_F_UNITS,3); DWRITEXY(4,9,'TOLERANCE FACTOR',3); DWRITEXY(43,9,T_FACTOR,3); DWRITEXY(4,10,'ORDER AND CLASS OF SURVEY',3); DWRITEXY(43,10,O_AND_C,3); DWRITEXY(4,11,'STATE OR COUNTRY CODE',3); DWRITEXY(43,11,SC_CODE,3); DWRITEXY(4,12,'INITIALS OF CHIEF OF PARTY',3); DWRITEXY(43,12,CINITIALS,3); DWRITEXY(4,13,'AGENCY',3); DWRITEXY(43,13,AGENCY,3); DWRITEXY(4,14,'RUN CODE',3); DWRITEXY(43,14,RUN_CODE,3); END; PROCEDURE INPUTTEN(CC:CHAR); (* USED FOR INPUTTING AND EDITTING TEN RECORD INFORMATION *) BEGIN CASE CC OF 'A','a','B','b' : INPUTALL(CC); 'C','c':BEGIN CURVAL(CC,A_NUM); WRITELN(' L@@@@@@@'); REPEAT WRITE('ACCESSION NUMBER- '); READLN(A_NUM); UNTIL LENGTH(A_NUM)<9; AllCaps(A_Num); END; 'D','d':BEGIN CURVAL(CC,LINEPART); WRITELN(' @@@@'); REPEAT WRITE('LINE/PART- '); READLN(LINEPART); UNTIL LENGTH(LINEPART)<5; AllCaps(LinePart); END; 'E','e':BEGIN CURVAL(CC,RELEV_CODE); TEXTCOLOR(11); WRITELN('ENTER ''R'' IF RELEVELING OVER PREVIOUSLY ESTABLISHED LINE. OTHERWISE LEAVE'); WRITE( 'BLANK.'); TEXTCOLOR(2); WRITELN( ' @'); REPEAT WRITE('RELEVELING CODE- '); READLN(TEMP); IF TEMP='' THEN TEMP:=' '; RELEV_CODE:=UPCASE(TEMP[1]); UNTIL (LENGTH(TEMP)=1) AND (POS(RELEV_CODE,'R ')<>0); END; 'F','f':BEGIN CURVAL(CC,COMMENCE); WRITELN(MAKESTRING(33,' '),'CCYYMMDD'); REPEAT WRITE('DATE FIELD OPERATIONS COMMENCED- '); READLN(COMMENCE); IF (VALUE(COPY(COMMENCE,5,2))>12) OR (VALUE(COPY(COMMENCE,7,2))>31) THEN COMMENCE:=''; UNTIL (LENGTH(COMMENCE)=8) AND (NUMBER(COMMENCE,'D')); END; 'G','g':BEGIN CURVAL(CC,TERMINATE); WRITELN(MAKESTRING(34,' '),'CCYYMMDD'); REPEAT WRITE('DATE FIELD OPERATIONS TERMINATED- '); READLN(TERMINATE); IF (VALUE(COPY(TERMINATE,5,2))>12) OR (VALUE(COPY(TERMINATE,7,2))>31) THEN TERMINATE:=''; UNTIL (LENGTH(TERMINATE)=8) AND (NUMBER(TERMINATE,'D')); END; 'H','h':BEGIN CURVAL(CC,T_F_UNITS); TWRITELN('POSSIBLE: MM=mm/ûkm OR FT=feet/ûstatute miles'); WRITELN(MAKESTRING(28,' '),'@@'); REPEAT WRITE('UNITS FOR TOLERANCE FACTOR- '); READLN(T_F_UNITS); ALLCAPS(T_F_UNITS); UNTIL (LENGTH(T_F_UNITS)=2) AND (ODD(POS(T_F_UNITS,'MMFT'))); END; 'I','i':BEGIN CURVAL(CC,T_FACTOR); WRITELN(' ####'); REPEAT WRITE('TOLERANCE FACTOR- '); READLN(T_FACTOR); UNTIL (LENGTH(T_FACTOR)<5) AND (NUMBER(T_FACTOR,'R')); END; 'J','j':BEGIN CURVAL(CC,O_AND_C); TWRITELN(' ORDER AND CLASS OF SURVEY'); TWRITELN('ÉÍÍÍÍÍËÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÑÍÍÍÑÍÍÍÍÍ»'); TWRITELN('ºORDERº 1ST ³ 2ND ³3RD³LOWERº'); TWRITELN('ÇÄÄÄÄÄ×ÄÄÂÄÄÂÄÄÅÄÄÂÄÄÂÄÄÅÄÄÄÅÄÄÄÄĶ'); TWRITELN('ºCLASSº* ³I ³II³* ³I ³II³** ³ ** º'); TWRITELN('ÇÄÄÄÄÄ×ÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄÅÄÄÄÅÄÄÄÄĶ'); TWRITELN('ºCODE º10³11³12³20³21³22³30 ³ 40 º'); TWRITELN('ÈÍÍÍÍÍÊÍÍÏÍÍÏÍÍÏÍÍÏÍÍÏÍÍÏÍÍÍÏÍÍÍÍͼ'); TWRITELN('*Class unspecified **No class subdivision'); WRITELN; WRITELN(' ##'); REPEAT WRITE('ORDER AND CLASS OF SURVEY- '); READLN(O_AND_C); IF O_AND_C='' THEN O_AND_C:=' '; UNTIL (LENGTH(O_AND_C)=2) AND ((O_AND_C=' ') OR (ODD(POS(O_AND_C,'1011123021222040')))); END; 'K','k':BEGIN CURVAL(CC,SC_CODE); WRITELN(' @@@@@@'); REPEAT WRITE('STATE OR COUNTRY CODE- '); READLN(SC_CODE); UNTIL LENGTH(SC_CODE)<7; AllCaps(Sc_Code); END; 'L','l':BEGIN CURVAL(CC,CINITIALS); WRITELN(MAKESTRING(28,' '),'@@@'); REPEAT WRITE('INITIALS OF CHIEF OF PARTY- '); READLN(CINITIALS); UNTIL LENGTH(CINITIALS)<4; AllCaps(CInitials); END; 'M','m':BEGIN CURVAL(CC,AGENCY); WRITELN(MAKESTRING(32,' '),'@@@@@@@@@@@@@@@@@@@@'); REPEAT WRITE('AGENCY WHICH MADE OBSERVATIONS- '); READLN(AGENCY); UNTIL LENGTH(AGENCY)<21; AllCaps(Agency); END; 'N','n':BEGIN CURVAL(CC,RUN_CODE); TWRITELN('1 = SINGLE OR DOUBLE - SIMULTANEOUS RUN. 2 = DOUBLE RUN'); WRITELN(' @'); REPEAT WRITE('TYPE OF RUN- '); READLN(TEMP); RUN_CODE:=UPCASE(TEMP[1]); UNTIL (LENGTH(TEMP)=1) AND (POS(RUN_CODE,'12')<>0); END; END; END; PROCEDURE REENTER; (* CHECK FOR CERTAIN IMPOSSIBILITIES *) VAR CH:CHAR; BEGIN IF ((C>='G') OR (POS(C,'fg')<>0)) AND (VALUER(COMMENCE)>VALUER(TERMINATE)) THEN REPEAT WRITELN; WRITELN; SOUND(1500); TWRITELN('TERMINATING DATE BEFORE COMMENCING DATE?!...REENTER'); NOSOUND; FOR CH:='f' TO 'g' DO BEGIN WRITELN; WRITELN; INPUTTEN(CH); END; UNTIL (VALUER(COMMENCE)<=VALUER(TERMINATE)); END; BEGIN (* MAIN LINE OF TEN *) REPEAT TELLREC('*10* LINE INFORMATION'); IF NEWLINE = FALSE THEN FOR C:='C' TO 'N' DO BEGIN INPUTTEN(C); REENTER; END ELSE BEGIN FOR C:='F' TO 'G' DO INPUTTEN(C); REENTER; WRITELN('CURRENT LINENUMBER IS ',A_NUM); WRITELN('CURRENT PART NUMBER IS ',LINEPART); INPUTTEN('D'); END; REPEAT PRINTTEN; REPEAT CLR(16); CMESSAGE('Y OR a-n'); SREAD(C); UNTIL C IN['A'..'N','Y']; IF C<>'Y' THEN BEGIN CLRSCR; C:=CHR(ORD(C)+32); INPUTTEN(C); REENTER; END; UNTIL C='Y'; CREATETEN; UNTIL NOT CANCELLED; END; PROCEDURE ELEVEN___(REC:INTEGER); (* CREATE AND WRITE OUT 11 TO 15 RECORDS (IF DESIRED) ON THE DISK *) VAR (* LINE_TITLE,ELEVEN___REC:SS; *) ELEVEN___REC:SS; LABEL 1; PROCEDURE CREATEELEVEN___; (* CREATES 11 TO 15 RECORDS AND WRITES THEM TO DISK *) BEGIN ELEVEN___REC:=CONCAT('*',FISTR(REC),'*',JUSTIFY(LINE_TITLE,-70)); WRITEREC(ELEVEN___REC); END; PROCEDURE PRINTELEVEN___; (* DISPLAYS 11 TO 15 RECORD INFORMATION ON THE SCREEN *) BEGIN PCLEAR; DO_LETTERS('c',41); DWRITEXY(4,1,'SEQUENCE NUMBER',3); DWRITEXY(43,1,FRSTR(SEQNUM,1,0),3); DWRITEXY(4,2,'DATA CODE',3); DWRITEXY(43,2,CONCAT('*',FISTR(REC),'*'),3); DWRITEXY(4,3,'LINE TITLE',3); DWRITEXY(4,4,'==>',11); IF NEWLINE=TRUE THEN LINE_TITLE:= TITLE_ELEVEN; BEGIN CASE REC OF 12..14 : DWRITEXY(15,3,'CONTINUATION',3); 15 : DWRITEXY(15,3,'COMMENT',3); END; DWRITEXY(7,4,LINE_TITLE,3); END; END; PROCEDURE INPUTELEVEN___(CC:CHAR); (* USED FOR INPUTTING AND EDITTING 11 TO 15 RECORDS *) BEGIN CASE CC OF 'A','a','B','b' : INPUTALL(CC); 'C','c':BEGIN CURVAL(CC,LINE_TITLE); CASE REC OF 11 : WRITELN('WHAT IS THE LINE''S TITLE?'); 12..14 : WRITELN('TYPE IN THE TITLE CONTINUATION'); 15 : WRITELN('WHAT COMMENT DO YOU HAVE?'); END; WRITELN(' ',MAKESTRING(70,'@')); REPEAT CASE REC OF 11 : WRITE('TITLE - '); 12..14 : WRITE('CONT. - '); 15 : WRITE('COMMENT- '); END; READLN(LINE_TITLE); UNTIL LENGTH(LINE_TITLE)<71; AllCaps(Line_Title); IF REC=11 THEN TITLE_ELEVEN := LINE_TITLE; END; END; END; BEGIN (* MAIN LINES OF PROCEDURE ELEVEN___ *) IF NEWLINE=TRUE THEN REC:=11; IF REC>11 THEN GOTO 1; REPEAT CASE REC OF 11 : TELLREC('*11* LINE TITLE'); 12..14 : TELLREC(CONCAT('*',FISTR(REC),'* LINE TITLE CONTINUATION')); 15 : TELLREC('*15* LINE COMMENT'); END; IF NEWLINE = FALSE THEN INPUTELEVEN___('C'); REPEAT PRINTELEVEN___; REPEAT CLR(6); CMESSAGE('Y OR a-c'); SREAD(C); UNTIL C IN['A'..'C','Y']; IF C<>'Y' THEN BEGIN CLRSCR; INPUTELEVEN___(CHR(ORD(C)+32)); END; UNTIL C='Y'; BEGIN CREATEELEVEN___; NEWLINE:=FALSE; END; IF CANCELLED THEN C:='\' ELSE IF REC<>15 THEN REC:=REC+1; 1:CLRSCR; IF (REC<=15) AND (REC>11) THEN BEGIN CLRSCR; WRITELN(' @'); REPEAT WRITE('WANT A ',REC:1,' RECORD? [Y/N]- '); READLN(TEMP); C:=UPCASE(TEMP[1]); UNTIL (LENGTH(TEMP)=1) AND (POS(C,'YN')<>0); END; IF (C='N') AND (REC<15) THEN BEGIN REC:=15; GOTO 1; END; UNTIL (C='N') OR (REC>15); END; PROCEDURE THIRTY; (* CREATES AND WRITES OUT THIRTY RECORDS *) VAR SPSN,AD,FE,ACRN,LAT,LON:S; DESIGNATION,THIRTYREC:SS; PROCEDURE CREATETHIRTY; (* ACTUALLY CREATE THIRTY RECORD AND WRITES IT OUT TO THE FILE *) BEGIN THIRTYREC:=CONCAT('*30*',SPSN,JUSTIFY(DESIGNATION,-25),D_UNITS, JUSTIFY(AD,-8),E_UNITS,JUSTIFY(FE,-10),ACRN,JUSTIFY(LAT,6), JUSTIFY(LON,7)); WRITEREC(THIRTYREC); END; PROCEDURE PRINTTHIRTY; (* DISPLAYS CURRENT THIRTY RECORD INFORMATION ON THE DISPLAY *) BEGIN PCLEAR; DO_LETTERS('k',41); DWRITEXY(4,1,'SEQUENCE NUMBER',3); DWRITEXY(43,1,FRSTR(SEQNUM,1,0),3); DWRITEXY(4,2,'DATA CODE',3); DWRITEXY(43,2,'*30*',3); DWRITEXY(4,3,'SURVEY POINT SERIAL NUMBER',3); DWRITEXY(43,3,SPSN,3); DWRITEXY(4,4,'DESIGNATION',3); DWRITEXY(43,4,DESIGNATION,3); DWRITEXY(4,5,'UNITS FOR ACCUMULATED DISTANCE',3); DWRITEXY(43,5,D_UNITS,3); DWRITEXY(4,6,'ACCUMULATED DISTANCE',3); DWRITEXY(43,6,AD,3); DWRITEXY(4,7,'UNITS FOR FIELD ELEVATION',3); DWRITEXY(43,7,E_UNITS,3); DWRITEXY(4,8,'FIELD ELEVATION',3); DWRITEXY(43,8,FE,3); DWRITEXY(4,9,'ACRN',3); DWRITEXY(43,9,ACRN,3); DWRITEXY(4,10,'LATITUDE',3); DWRITEXY(43,10,LAT,3); DWRITEXY(4,11,'LONGITUDE',3); DWRITEXY(43,11,LON,3); END; PROCEDURE INPUTTHIRTY(CC:CHAR); (* EDITS AND INPUTS THIRTY RECORD INFORMATION *) BEGIN CASE CC OF 'A','a','B','b' : INPUTALL(CC); 'C','c':BEGIN CURVAL(CC,SPSN); WRITELN(MAKESTRING(35,' '),'####'); REPEAT WRITE('SURVEY POINT SERIAL NUMBER (SPSN)- '); READLN(SPSN); If SPSN = '' then begin SPSN[0] := #6; end; UNTIL (LENGTH(SPSN)<5) AND (NUMBER(SPSN,'I')); SPSN:=CONCAT(MAKESTRING(4-LENGTH(SPSN),'0'),SPSN); END; 'D','d':BEGIN CURVAL(CC,DESIGNATION); WRITELN(' @@@@@@@@@@@@@@@@@@@@@@@@@'); REPEAT WRITE('DESIGNATION- '); READLN(DESIGNATION); UNTIL LENGTH(DESIGNATION)<26; AllCaps(Designation); END; 'e' :INPUTALL('D'); 'F','f':BEGIN CURVAL(CC,AD); WRITELN(' ########'); REPEAT WRITE('ACCUMULATED DISTANCE (',D_UNITS,')- '); READLN(AD); UNTIL (LENGTH(AD)<9) AND (NUMBER(AD,'R')); END; 'g' :INPUTALL('E'); 'H','h':BEGIN CURVAL(CC,FE); WRITELN(' ##########'); REPEAT WRITE('FIELD ELEV (',E_UNITS,')- '); READLN(FE); UNTIL (LENGTH(FE)<11) AND (NUMBER(FE,'R')); END; 'I','i':BEGIN CURVAL(CC,ACRN); TWRITELN('IF ACRN NOT AVAILABLE, PRESS .'); WRITELN(' @@####'); REPEAT WRITE('ACRN- '); READLN(ACRN); IF ACRN<>'' THEN BEGIN TEMP:=COPY(ACRN,1,2); IF NOT ((TEMP[1] IN ['A'..'Z','a'..'z']) AND (TEMP[2] IN ['A'..'Z','a'..'z'])) THEN ACRN:='\' ELSE BEGIN TEMP:=COPY(ACRN,3,4); IF ((TEMP<'0') OR (TEMP>'9999')) AND (LENGTH(TEMP)>0) THEN ACRN:='\' ELSE IF LENGTH(TEMP)<4 THEN INSERT(MAKESTRING(4-LENGTH(TEMP),'0'),ACRN,3); END; END ELSE ACRN:=' '; UNTIL LENGTH(ACRN)=6; AllCaps(ACRN); END; 'J','j':BEGIN CURVAL(CC,LAT); TWRITELN('IF LATITUDE NOT AVAILABLE, PRESS .'); WRITELN(' DDMMSS'); REPEAT WRITE('LATITUDE- '); READLN(LAT); UNTIL ((LENGTH(LAT)=6) AND (NUMBER(LAT,'L'))) OR (LAT=''); END; 'K','k':BEGIN CURVAL(CC,LON); TWRITELN('IF LONGITUDE NOT AVAILABLE, PRESS .'); WRITELN(' DDDMMSS or'); WRITELN(' DDMMSS'); REPEAT WRITE('LONGITUDE- '); READLN(LON); UNTIL (((LENGTH(LON)=6) OR (LENGTH(LON)=7)) AND (NUMBER(LON,'L'))) OR (LON=''); END; END; END; BEGIN (* MAIN LINE OF PROCEDURE THIRTY *) TELLREC('*30* FIELD ABSTRACT'); FOR C:='C' TO 'K' DO INPUTTHIRTY(C); REPEAT PRINTTHIRTY; REPEAT CLR(13); CMESSAGE('Y OR a-k'); SREAD(C); UNTIL C IN['Y','A'..'K']; IF C<>'Y' THEN BEGIN CLRSCR; INPUTTHIRTY(CHR(ORD(C)+32)); END; UNTIL C='Y'; CREATETHIRTY; END; PROCEDURE FORTY; (* CREATES FORTY RECORDS *) VAR TANERROR,TIME:S; FORTYREC:SS; PROCEDURE CREATEFORTY; (* ACTUALLY CREATES AND WRITES THE FORTY RECORDS OUT ON THE DISK *) BEGIN FORTYREC:=CONCAT('*40*',DATE,INSTCODE40,JUSTIFY(INSTNUM40,-8),MICROMETER40, ROD1CODE40,JUSTIFY(ROD1NUM40,-8),ROD2CODE40,JUSTIFY(ROD2NUM40,-8),AH40, UH40,LH40,MH40,' ',JUSTIFY(TANERROR,5),TIMEZONE,TIME,' '); WRITEREC(FORTYREC); END; PROCEDURE PRINTFORTY; (* DISPLAYS FORTY RECORD INFORMATION ON THE SCREEN *) BEGIN PCLEAR; DO_LETTERS('c',62); DWRITEXY(4,1,'SEQUENCE NUMBER',3); DWRITEXY(64,1,FRSTR(SEQNUM,1,0),3); DWRITEXY(4,2,'DATA CODE',3); DWRITEXY(64,2,'*40*',3); DWRITEXY(4,3,'DATE OF RUNNING(S)',3); DWRITEXY(64,3,DATE,3); DWRITEXY(37,4,'*** INSTRUMENT ***',3); DWRITEXY(1,5,'d) NGS SURVEY EQUIPMENT CODE',3); DWRITEXY(62,5,CONCAT('= ',INSTCODE40),3); DWRITEXY(1,6,'e) INSTRUMENT SERIAL NUMBER',3); DWRITEXY(62,6,CONCAT('= ',INSTNUM40),3); DWRITEXY(1,7,'f) MICROMETER USED?',3); IF MICROMETER40='M' THEN DWRITEXY(62,7,'= YES',3) ELSE DWRITEXY(62,7,'= NO',3); DWRITEXY(39,8,'*** ROD 1 ***',3); DWRITEXY(1,9,'g) NGS SURVEY EQUIPMENT CODE',3); DWRITEXY(62,9,CONCAT('= ',ROD1CODE40),3); DWRITEXY(1,10,'h) ROD SERIAL NUMBER',3); DWRITEXY(62,10,CONCAT('= ',ROD1NUM40),3); DWRITEXY(39,11,'*** ROD 2 ***',3); DWRITEXY(1,12,'i) NGS SURVEY EQUIPMENT CODE',3); DWRITEXY(62,12,CONCAT('= ',ROD2CODE40),3); DWRITEXY(1,13,'j) ROD SERIAL NUMBER',3); DWRITEXY(62,13,CONCAT('= ',ROD2NUM40),3); DWRITEXY(39,14,'*************',3); DWRITEXY(1,15,'k) AVERAGE HEIGHT OF INSTRUMENT (cm)',3); DWRITEXY(62,15,CONCAT('= ',AH40),3); DWRITEXY(1,16,'l) HEIGHT OF UPPER TEMP PROBE (cm)',3); DWRITEXY(62,16,CONCAT('= ',UH40),3); DWRITEXY(1,17,'m) HEIGHT OF LOWER TEMP PROBE (cm)',3); DWRITEXY(62,17,CONCAT('= ',LH40),3); DWRITEXY(1,18,'n) HEIGHT OF MIDDLE TEMP PROBE (cm)',3); DWRITEXY(62,18,CONCAT('= ',MH40),3); DWRITEXY(1,19,'o) TANGENT OF COLLIMATION ERROR',3); DWRITEXY(62,19,CONCAT('= ',TANERROR),3); DWRITEXY(1,20,'p) TIME ZONE',3); DWRITEXY(62,20,CONCAT('= ',TIMEZONE),3); DWRITEXY(1,21,'q) LOCAL TIME OF COLLIMATION ERROR DETECTION',3); DWRITEXY(62,21,CONCAT('= ',TIME),3); END; PROCEDURE INPUTFORTY(CC:CHAR); (* INPUTS AND EDITS FORTY RECORD INFORMATION *) BEGIN CASE CC OF 'A','B','C','a','b','c','p' : INPUTALL(CC); 'D','d':BEGIN CURVAL(CC,INSTCODE40); WRITELN(' 2##'); REPEAT WRITE('EQUIPMENT CODE- '); READLN(INSTCODE40); UNTIL (LENGTH(INSTCODE40)=3) AND (NUMBER(INSTCODE40,'I')) AND (INSTCODE40[1] = '2'); END; 'E','e':BEGIN CURVAL(CC,INSTNUM40); WRITELN(MAKESTRING(38,' '),'@@@@@@@@'); REPEAT WRITE( 'WHAT IS THE INSTRUMENT SERIAL NUMBER? '); READLN(INSTNUM40); UNTIL LENGTH(INSTNUM40)<9; AllCaps(InstNum40); END; 'F','f':BEGIN IF MICROMETER40='M' THEN TEMP:='YES' ELSE TEMP:='NO'; CURVAL(CC,TEMP); WRITELN(' @'); REPEAT WRITE('MICROMETER USED? [Y/N]- '); READLN(TEMP); TEMP[1]:=UPCASE(TEMP[1]); UNTIL (LENGTH(TEMP)=1) AND (POS(TEMP,'YN')<>0); IF TEMP='Y' THEN MICROMETER40:='M' ELSE MICROMETER40:=' '; END; 'G','g':BEGIN CURVAL(CC,ROD1CODE40); WRITELN(' 3##'); REPEAT WRITE('ROD 1 EQUIPMENT CODE- '); READLN(ROD1CODE40); UNTIL (LENGTH(ROD1CODE40)=3) AND (NUMBER(ROD1CODE40,'I')) AND (ROD1CODE40[1] = '3'); END; 'H','h':BEGIN CURVAL(CC,ROD1NUM40); WRITELN(' @@@@@@@@'); REPEAT WRITE('ROD 1 SERIAL NUMBER- '); READLN(ROD1NUM40); UNTIL LENGTH(ROD1NUM40)<=8; AllCaps(Rod1Num40); END; 'I','i':BEGIN CURVAL(CC,ROD2CODE40); WRITELN(' 3##'); REPEAT WRITE('ROD 2 EQUIPMENT CODE- '); READLN(ROD2CODE40); UNTIL (LENGTH(ROD2CODE40)=3) AND (NUMBER(ROD2CODE40,'I')) AND (ROD2CODE40[1] = '3'); END; 'J','j':BEGIN CURVAL(CC,ROD2NUM40); WRITELN(' @@@@@@@@'); REPEAT WRITE('ROD 2 SERIAL NUMBER- '); READLN(ROD2NUM40); UNTIL LENGTH(ROD2NUM40)<=8; AllCaps(Rod2Num40); END; 'K','k':BEGIN CURVAL(CC,AH40); WRITELN(MAKESTRING(28,' '),'###'); REPEAT WRITE('AVG HGT OF INSTRUMENT (cm)- '); READLN(AH40); UNTIL (AH40='') OR ((LENGTH(AH40)<=3) AND (NUMBER(AH40,'R'))); IF AH40='' THEN AH40:=' '; IF LENGTH(AH40)<3 THEN AH40:=CONCAT(MAKESTRING(3-LENGTH(AH40),'0'),AH40); END; 'L','l':BEGIN CURVAL(CC,UH40); WRITELN(MAKESTRING(30,' '),'###'); REPEAT WRITE('HGT OF UPPER TEMP PROBE (cm)- '); READLN(UH40); UNTIL (UH40='') OR ((LENGTH(UH40)<=3) AND (NUMBER(UH40,'R'))); IF UH40='' THEN UH40:=' '; IF LENGTH(UH40)<3 THEN UH40:=CONCAT(MAKESTRING(3-LENGTH(UH40),'0'),UH40); END; 'M','m':BEGIN CURVAL(CC,LH40); WRITELN(MAKESTRING(30,' '),'###'); REPEAT WRITE('HGT OF LOWER TEMP PROBE (cm)- '); READLN(LH40); UNTIL (LH40='') OR ((LENGTH(LH40)<=3) AND (NUMBER(LH40,'R'))); IF LH40='' THEN LH40:=' '; IF LENGTH(LH40)<3 THEN LH40:=CONCAT(MAKESTRING(3-LENGTH(LH40),'0'),LH40); END; 'N','n':BEGIN CURVAL(CC,MH40); TWRITELN('IF NOT AVAILABLE, PRESS '); WRITELN(MAKESTRING(31,' '),'###'); REPEAT WRITE('HGT OF MIDDLE TEMP PROBE (cm)- '); READLN(MH40); UNTIL (MH40='') OR ((LENGTH(MH40)<=3) AND (NUMBER(MH40,'R'))); IF MH40='' THEN MH40:=' '; IF LENGTH(MH40)<3 THEN MH40:=CONCAT(MAKESTRING(3-LENGTH(MH40),'0'),MH40); END; 'O','o':BEGIN CURVAL(CC,TANERROR); TWRITELN('JUST PRESS IF NOT AVAILABLE. ENTER USING MILLIMETERS PER METER.'); WRITELN(' #####'); REPEAT WRITE('TANGENT OF COLLIMATION ERROR (x1000)? '); READLN(TANERROR); UNTIL (LENGTH(TANERROR)<6) AND (NUMBER(TANERROR,'R')); END; 'Q','q':BEGIN CURVAL(CC,TIME); TWRITELN('TIME OF COLLIMATION ERROR DETERMINATION.'); WRITELN(' HHMM'); REPEAT WRITE('LOCAL TIME- '); READLN(TIME); UNTIL (TIME='') OR ((LENGTH(TIME)=4) AND (NUMBER(TIME,'T')) AND ((VALUE(TIME)>=0) AND (VALUE(TIME)<2400))); END; END; END; PROCEDURE REENTER; TYPE HEIGHTS=(LH,MH,UH); VAR H:HEIGHTS; NOT_BLANK:ARRAY[LH..UH] OF BOOLEAN; I:BYTE; CH:CHAR; PROCEDURE LOAD_BLANKS; BEGIN IF LH40=' ' THEN NOT_BLANK[LH]:=FALSE ELSE NOT_BLANK[LH]:=TRUE; IF MH40=' ' THEN NOT_BLANK[MH]:=FALSE ELSE NOT_BLANK[MH]:=TRUE; IF UH40=' ' THEN NOT_BLANK[UH]:=FALSE ELSE NOT_BLANK[UH]:=TRUE; END; FUNCTION Z(S1,S2:S):BOOLEAN; BEGIN IF VALUER(S1)>VALUER(S2) THEN Z:=TRUE ELSE Z:=FALSE; END; BEGIN IF POS(UPCASE(C),'LMN')<>0 THEN BEGIN LOAD_BLANKS; WHILE ((NOT_BLANK[LH]) AND (NOT_BLANK[MH]) AND (Z(LH40,MH40))) OR ((NOT_BLANK[MH]) AND (NOT_BLANK[UH]) AND (Z(MH40,UH40))) OR ((NOT_BLANK[LH]) AND (NOT_BLANK[UH]) AND (Z(LH40,UH40))) DO BEGIN LOAD_BLANKS; WRITELN; WRITELN; SOUND(1500); IF (NOT_BLANK[LH]) AND (NOT_BLANK[UH]) THEN BEGIN IF Z(LH40,UH40) THEN BEGIN TWRITELN('LOWER HGT > UPPER HGT?...REENTER'); IF (NOT_BLANK[MH]) AND ((Z(LH40,MH40)) OR (Z(MH40,UH40))) THEN WRITELN('IN ADDITION...'); END; END; IF (NOT_BLANK[LH]) AND (NOT_BLANK[MH]) THEN BEGIN IF Z(LH40,MH40) THEN BEGIN TWRITELN('LOWER HGT > MIDDLE HGT?...REENTER'); IF (NOT_BLANK[UH]) AND (Z(MH40,UH40)) THEN WRITELN('IN ADDITION...'); END; END; IF (Z(MH40,UH40)) AND (NOT_BLANK[MH]) AND (NOT_BLANK[UH]) THEN TWRITELN('MIDDLE HGT > UPPER HGT?...REENTER'); NOSOUND; FOR CH:='l' TO 'n' DO BEGIN WRITELN; WRITELN; INPUTFORTY(CH); END; END; END; END; PROCEDURE ININ(Z:CHAR); VAR BB,EE:CHAR; BEGIN BB:='d'; EE:='n'; IF Z=UPCASE(Z) THEN BEGIN BB:='D'; EE:='N'; END ELSE BEGIN BB:='d'; EE:='n'; END; FOR C:=BB TO EE DO BEGIN IF Z<>UPCASE(Z) THEN BEGIN WRITELN; WRITELN; END; INPUTFORTY(C); REENTER; END; END; BEGIN TELLREC('*40* SURVEY EQUIPMENT'); INPUTFORTY('C'); C:='\'; IF INSTCODE40<>'\\\' THEN BEGIN CURVAL('Z',TEMP); TEXTCOLOR(11); WRITELN('INSTRUMENT: CODE= ',INSTCODE40,TAB(40),' SERIAL #= ',INSTNUM40); WRITELN(' ROD 1: CODE= ',ROD1CODE40,TAB(40),' SERIAL #= ',ROD1NUM40); WRITELN(' ROD 2: CODE= ',ROD2CODE40,TAB(40),' SERIAL #= ',ROD2NUM40); WRITELN; WRITELN('UPPER HGT= ',UH40,TAB(20),'MIDDLE HGT= ',MH40,TAB(40),'LOWER HGT= ',LH40); WRITELN('AVG HGT OF INSTRUMENT= ',AH40); TEXTCOLOR(2); CURVAL('Z',TEMP); WRITELN(MAKESTRING(34,' '),'@'); REPEAT WRITE('CHANGE THE EQUIPMENT INFORMATION? '); READLN(TEMP); C:=UPCASE(TEMP[1]); UNTIL (LENGTH(TEMP)=1) AND (POS(C,'YN')<>0); END; IF C='Y' THEN ININ('a'); IF INSTCODE40='\\\' THEN ININ('A'); FOR C:='O' TO 'Q' DO BEGIN INPUTFORTY(C); REENTER; END; REPEAT PRINTFORTY; REPEAT CLR(23); CMESSAGE('Y OR a-q'); SREAD(C); UNTIL C IN['Y','A'..'Q']; IF C<>'Y' THEN BEGIN CLRSCR; C:=CHR(ORD(C)+32); INPUTFORTY(C); REENTER; END; UNTIL C='Y'; CREATEFORTY; END;