PROC MIKES_RECORD_HANDLER (MRH) IS ( LITERAL INFILE := "", LITERAL OUTFILE := "", LITERAL USE_DEFN_FILE := "", LITERAL SAVE_DEFN_FILE := "", LITERAL VALIDATE := 'Y', RESPONSE (RESPONSE) RESP := RESULT) BEGIN STOPT(NAM = NOLCS) STRING PHASE INT FLAG, SFLAG WHENEVER FLAG NE 0 THEN IF FLAG > 0 THEN SMSG("ERRORS WHEN " + PHASE) RESP := FLAG RETURN ELSE SMSG("WARNINGS WHEN " + PHASE) SRSMSG(FLAG) FLAG := 0 FI FI STRING RUNTYPE, FLD_START, FLD_END, AMSG_SCR, MSG_FIELD, REPLY, REPLY_FLD, IN_REC, SIGN_CHAR, LAST_REPLY, CHECK_CHAR, REC_BUFF, RECORD_NAME, DEFN_BUFF, FIELD_NAME, FIELD_TYPE, FIELD_LEN, FIELD_VALIDATION, FIRST_FIELD_LEN SUPERSTRING FLD_NAME, FLD_TYPE, FLD_LEN, FLD_VLDN STRING BIN_LEN IS "011223344455667788899", HEX_CHARS IS "0123456789ABCDEF", PRINTABLE IS " [.<(+!&]$*);^-/|,%_>?`: @" + HEX(7D) + "=" + HEX(7F) + "abcdefghi" + "jklmnopqr~stuvwxyz{ABCDEFGHI}JKLMNOPQR\" + "STUVWXYZ0123456789" STRING STUNF := HEX(13), @ Start UNprotected Flashing STPR := HEX(11), @ STart PRotected STUN := HEX(3C), @ STart UNprotected CLS := HEX(0C), @ CLear Screen NL := HEX(15), @ New Line SOM := HEX(2706), @ Set SOM to Cursor VP := HEX(22), @ Vertical position HP := HEX(23), @ Horizontal position MSP := HEX(20), @ Multiple SPace MNL := HEX(21) @ Multiple NewLine INT REPLY_LEN, REPLY_PTR, IN_PTR, FLD_PTR, VALID_PTR, REC_FLD_LEN, SCR_FLD_LEN, REPLY_FLD_NUM, LINE_PTR, BIN_PTR, PART_PTR, SEGMENT_LEN, SOM_POSN BOOL VALIDATE_FLD, REC_VALID, END_OF_FILE [500] BOOL FLD_VALID IF ((VALIDATE = '') OR ('Yy' INCLUDES SUBSTR(VALIDATE))) THEN VALIDATE_FLD := TRUE ELSE VALIDATE_FLD := FALSE FI @ Use a previously existing definition or get the input from screen @ (and save it to a new definition file) ? IF USE_DEFN_FILE = "" THEN DEFN_FILE := SAVE_DEFN_FILE IF DEFN_FILE = "" THEN DEFN_FILE := RECORD_NAME + "DEFN" FI PHASE := "CREATING SAVED DEFN FILE" CRF(NAM = VAL DEFN_FILE, LNA = SAVE_DEFN, RES = FLAG) SVF(RES = FLAG) PHASE := "OPENING DEFN FILE FOR WRITE" OPF(NAM = *SAVE_DEFN, CHA = DEFN, ACC = O, RES = FLAG) AMSG_SCR := CLS + STPR + HP + BIN(22) + "Generating definition file" + VP + BIN(2) + HP + BIN(10) + "Field name" + HP + BIN(34) + "Type" + HP + BIN(39) + "Length" + HP + BIN(58) + "Validation" + NL + STUN + SOM + MSP + BIN(30) + STPR + " " + STUN + " " + STPR + " " + STUN + MSP + BIN(3) + STPR + " " + STUN + MSP + BIN(34) + STPR FOR LINE_PTR FROM 1 BY 1 TO 18 DO AMSG_SCR := AMSG_SCR + NL + STUN + MSP + BIN(30) + STPR + " " + STUN + " " + STPR + " " + STUN + MSP + BIN(3) + STPR + " " + STUN + MSP + BIN(34) + STPR REPEAT AMSG_SCR := AMSG_SCR + VP + BIN(3) + HP + BIN(1) REPLY_LEN := 0 REPLY := FILL(2000) PHASE := "DOING AMSG (1)" AMSG(PRO = AMSG_SCR, MES = REPLY, LEN = REPLY_LEN, RES = FLAG) UNTIL ((REPLY = "") OR (REPLY = "Q")) DO FOR LINE_PTR FROM 1 BY 1 UNTIL LINE_PTR > 19 DO REPLY_PTR := (LINE_PTR - 1) * 68 FIELD_NAME := SUBSTR(REPLY, REPLY_PTR, 30) FIELD_TYPE := SUBSTR(REPLY, REPLY_PTR + 30, 1) FIELD_LEN := SUBSTR(REPLY, REPLY_PTR + 31, 3) FIELD_VLDN := SUBSTR(REPLY, REPLY_PTR + 34, 34) WHILE FIELD_NAME STARTSWITH " " DO FIELD_NAME := FIELD_NAME AFTER " " REPEAT WHILE FIELD_LEN STARTSWITH " " DO FIELD_LEN := FIELD_LEN AFTER " " REPEAT IF (((FIELD_NAME NE "") AND (FIELD_TYPE NE "")) AND (FIELD_LEN NE "")) THEN REC_BUFF := SUBSTR(FIELD_NAME + FILL(30),,30) + SUBSTR(FIELD_TYPE + " ") + SUBSTR(FIELD_LEN + " ",,3) + SUBSTR(FIELD_VLDN + FILL(34),,34) PHASE := "WRITING SAVED DEFN FILE" WRR(CHA = DEFN, REC = REC_BUFF, RES = FLAG) FI REPEAT REPLY_LEN := 0 REPLY := FILL(2000) PHASE := "DOING AMSG (2)" AMSG(PRO = AMSG_SCR, MES = REPLY, LEN = REPLY_LEN, RES = FLAG) REPEAT PHASE := "CLOSING SAVE_DEFN FILE" CLOF(CHA = DEFN, RES = FLAG) SMSG(HEX(0C)) ELSE DEFN_FILE := USE_DEFN_FILE FI @ Now fetch the input definition into the arrays @ PHASE := "ASSIGNING DEFN_FILE" AF(NAM = VAL DEFN_FILE, LNA = USE_DEFN, RES = FLAG) PHASE := "OPENING DEFN_FILE" OPF(NAM = *USE_DEFN, CHA = DEFN, ACC = R, RES = FLAG) PHASE := "READING USE_DEFN RECORD (1)" RDR(CHA = DEFN, REC = REC_BUFF, RES = SFLAG) FOR FLD_PTR FROM 0 BY 1 UNTIL SFLAG NE 0 DO REC_BUFF := REC_BUFF + " " FIELD_NAME := SUBSTR(REC_BUFF, 0, 30) FIELD_TYPE := SUBSTR(REC_BUFF, 30, 1) FIELD_LEN := SUBSTR(REC_BUFF, 31, 3) IF LENGTH(REC_BUFF) > 34 THEN FIELD_VLDN := SUBSTR(REC_BUFF, 34, LENGTH(REC_BUFF) - 34) ELSE FIELD_VLDN := "" FI WHILE FIELD_NAME ENDSWITH " " DO FIELD_NAME := SUBSTR(FIELD_NAME,,LENGTH FIELD_NAME - 1) REPEAT WHILE FIELD_LEN ENDSWITH " " DO FIELD_LEN := SUBSTR(FIELD_LEN,,LENGTH FIELD_LEN - 1) REPEAT FLD_NAME[FLD_PTR] := FIELD_NAME FLD_TYPE[FLD_PTR] := FIELD_TYPE FLD_LEN[FLD_PTR] := FIELD_LEN FLD_VLDN[FLD_PTR] := FIELD_VLDN PHASE := "READING USE_DEFN RECORD (2)" RDR(CHA = DEFN, REC = REC_BUFF, RES = SFLAG) REPEAT IF SFLAG NE 26272 THEN FLAG := SFLAG FI PHASE := "CLOSING DEFINTION FILE" CLOF(CHA = DEFN, RES = FLAG) @ The definition is now in the arrays. Now we come to the real processing. @ First, open and/or create the appropriate files. FOR FLD_PTR FROM 0 BY 1 TO BOUND FLD_VALID DO FLD_VALID[FLD_PTR] := TRUE REPEAT IF INFILE NE '' THEN IF OUTFILE NE '' THEN RUNTYPE := 'E' FLD_START := '3C' ELSE RUNTYPE := 'B' FLD_START := '11' FI ELSE IF OUTFILE NE '' THEN RUNTYPE := 'C' FLD_START := '3C' ELSE SMSG('NEITHER INFILE NOR OUTFILE SUPPLIED') RETURN FI FI IF RUNTYPE NE 'C' THEN PHASE := 'OPENING INPUT FILE FOR READ' OPF(NAM = VAL INFILE, CHA = IN, ACC = R, RES = FLAG) END_OF_FILE := FALSE FI IF RUNTYPE NE 'B' THEN PHASE := 'CREATING OUTPUT FILE' CRF(NAM = VAL OUTFILE, LNA = OUTFL, RES = FLAG) SVF(RES = FLAG) PHASE := "OPENING OUTPUT FILE FOR WRITE" OPF(NAM = *OUTFL, CHA = OUT, ACC = O, RES = FLAG) FI IF RUNTYPE NE "C" THEN PHASE := "READING INPUT FILE (1)" RDR(CHA = IN, REC = IN_REC, RES = SFLAG) IF SFLAG = 26272 THEN END_OF_FILE := TRUE ELSE FLAG := SFLAG FI ELSE SFLAG := 0 FI REC_VALID := TRUE UNTIL (((((END_OF_FILE AND (RUNTYPE = "B")) OR (REPLY STARTSWITH "E")) OR (REPLY STARTSWITH "e")) OR (REPLY STARTSWITH "Q")) OR (REPLY STARTSWITH "q")) DO IN_PTR := 0 VALID_PTR := 0 IF NOT REC_VALID THEN IF RUNTYPE = "C" THEN REPLY_PTR := 0 ELSE REPLY_PTR := 1 FI FI IF RUNTYPE = "C" THEN REPLY := "" AMSG_SCR := CLS + STPR + VP + BIN(1) + HP + BIN(0) ELSE REPLY := " " AMSG_SCR := CLS + STPR + VP + BIN(1) + HP + BIN(5) + 'Action: ' + STUN + " " + STPR + VP + BIN(2) + HP + BIN(0) FI SOM_POSN := LENGTH FLD_NAME[0] + 1 LINE_PTR := 0 @ Build up screen, field by field FOR FLD_PTR FROM 0 BY 1 TO COUNT FLD_NAME DO FIELD_NAME := FLD_NAME[FLD_PTR] FIELD_TYPE := FLD_TYPE[FLD_PTR] FIELD_LEN := FLD_LEN[FLD_PTR] SCR_FLD_LEN := CHARTOINT(FIELD_LEN) SEGMENT_LEN := SCR_FLD_LEN + LENGTH FIELD_NAME + 4 IF ((SEGMENT_LEN > 80) OR ((SEGMENT_LEN + LINE_PTR) > 80)) THEN AMSG_SCR := AMSG_SCR + HEX(15) LINE_PTR := 0 FI LINE_PTR := LINE_PTR + SEGMENT_LEN AMSG_SCR := AMSG_SCR + FIELD_NAME @ decide on start byte for fields - protected, unprotected, or @ unprotected flashing (for errors) IF FLD_VALID[FLD_PTR] THEN AMSG_SCR := AMSG_SCR + HEX(40) + HEX(VAL(FLD_START)) ELSE AMSG_SCR := AMSG_SCR + HEX(5C13) FLD_VALID[FLD_PTR] := TRUE FI @ This starts to get a bit complicated now... @ If it's a build or edit, we want to output the actual contents @ of the record as they currently exist, otherwise just put a @ blank field there, unless it's an error record, when we want @ to put the previously input contents in there FLD_END := STPR + " " IF NOT REC_VALID THEN MSG_FIELD := SUBSTR(LAST_REPLY, REPLY_PTR, SCR_FLD_LEN) REPLY_PTR := REPLY_PTR + SCR_FLD_LEN ELSE IF ((RUNTYPE NE 'C') AND (NOT END_OF_FILE)) THEN FLD_END := STPR + " " IF FIELD_TYPE = "X" THEN @ set up a type X field content, making sure all the @ characters to be displayed are printables MSG_FIELD := SUBSTR(IN_REC, IN_PTR, SCR_FLD_LEN) FOR CHAR_PTR FROM 0 BY 1 TO LENGTH MSG_FIELD - 1 DO CHECK_CHAR := SUBSTR(MSG_FIELD, CHAR_PTR, 1) IF INDEX(PRINTABLE, CHECK_CHAR) = -1 THEN SUBSTR(MSG_FIELD, CHAR_PTR, 1) := " " FI REPEAT IN_PTR := IN_PTR + SCR_FLD_LEN ELSF FIELD_TYPE = "H" THEN @ set up a type H field content REC_FLD_LEN := SCR_FLD_LEN / 2 MSG_FIELD := HEXTOCHAR(SUBSTR(IN_REC, IN_PTR, REC_FLD_LEN)) IN_PTR := IN_PTR + REC_FLD_LEN ELSF FIELD_TYPE = "D" THEN @ set up a type D (display numeric) field content and @ flag with an "!" after the field and "?" in the @ appropriate position in the field if there are any @ non-numeric characters present MSG_FIELD := SUBSTR(IN_REC, IN_PTR, SCR_FLD_LEN) WHILE MSG_FIELD STARTSWITH "0" DO MSG_FIELD := (MSG_FIELD AFTER "0") + " " REPEAT IF MSG_FIELD = "" THEN MSG_FIELD := "0" + (MSG_FIELD AFTER " ") FI FOR CHAR_PTR FROM 0 BY 1 TO LENGTH MSG_FIELD - 1 DO CHECK_CHAR := SUBSTR(MSG_FIELD, CHAR_PTR, 1) IF INDEX(" 1234567890", CHECK_CHAR) = -1 THEN SUBSTR(MSG_FIELD, CHAR_PTR, 1) := "?" FLD_END := STPR + "!" FI REPEAT IN_PTR := IN_PTR + SCR_FLD_LEN ELSF "US" INCLUDES FIELD_TYPE THEN @ set up type U and S (comp unsigned and signed) field @ content and flag with an "!" after the field if the @ value is too large for the field IF FIELD_TYPE = "U" THEN REC_FLD_LEN := CHARTOINT(SUBSTR(BIN_LEN, SCR_FLD_LEN)) ELSE REC_FLD_LEN := CHARTOINT(SUBSTR(BIN_LEN, SCR_FLD_LEN - 1)) FI MSG_FIELD := NUMERIC(STINT(SUBSTR(IN_REC, IN_PTR, REC_FLD_LEN))) IF LENGTH MSG_FIELD < SCR_FLD_LEN THEN MSG_FIELD := MSG_FIELD + FILL(SCR_FLD_LEN - LENGTH MSG_FIELD) ELSF LENGTH MSG_FIELD > SCR_FLD_LEN THEN MSG_FIELD := SUBSTR(MSG_FIELD, 0, SCR_FLD_LEN) FLD_END := STPR + "!" FI IN_PTR := IN_PTR + REC_FLD_LEN ELSF FIELD_TYPE = "P" THEN @ set up packed (COMP-3) field content REC_FLD_LEN := (SCR_FLD_LEN / 2) + 1 MSG_FIELD := HEXTOCHAR(SUBSTR(IN_REC, IN_PTR, REC_FLD_LEN)) SIGN_CHAR := SUBSTR(MSG_FIELD) MSG_FIELD := MSG_FIELD AFTER SIGN_CHAR IF SIGN_CHAR = 'D' THEN MSG_FIELD := '-' + MSG_FIELD FI IF LENGTH MSG_FIELD < SCR_FLD_LEN THEN MSG_FIELD := MSG_FIELD + FILL(SCR_FLD_LEN - LENGTH MSG_FIELD) FI IN_PTR := IN_PTR + REC_FLD_LEN FI @ for create, output empty field (unless redisplaying an @ error) and for others, display field content REPLY := REPLY + MSG_FIELD ELSE MSG_FIELD := MSP + BIN(SCR_FLD_LEN, 1) FI FI AMSG_SCR := AMSG_SCR + MSG_FIELD + FLD_END REPEAT @ call AMSG to get the next record and decide what to do with it @ after checking the ACTION IF RUNTYPE = 'C' THEN AMSG_SCR := AMSG_SCR + VP + BIN(1) + HP + BIN(SOM_POSN) + SOM + HP + BIN(SOM_POSN + 1) ELSE AMSG_SCR := AMSG_SCR + VP + BIN(1) + HP + BIN(14) FI REC_VALID := TRUE VALID_PTR := 0 REC_BUFF := "" REPLY_LEN := 0 REPLY := REPLY + FILL(2000 - LENGTH REPLY) PHASE := 'DOING AMSG (1)' AMSG(PRO = AMSG_SCR, MES = REPLY, LEN = REPLY_LEN, RES = FLAG) REPLY := REPLY + FILL(2001 - REPLY_LEN) IF RUNTYPE NE "C" THEN IF REPLY_LEN > 0 THEN ACTION := SUBSTR(REPLY) OR HEX(40) ELSE ACTION := " " FI FI IF (((RUNTYPE = "C") AND ((REPLY = "") OR (REPLY = "Q"))) OR ((RUNTYPE NE "C") AND ("SEQ" INCLUDES ACTION))) THEN @ skip record @ ELSF ((RUNTYPE = "E") AND (ACTION = "C")) THEN WRR(CHA = OUT, REC = IN_REC, RES = FLAG) ELSF RUNTYPE NE "B" THEN IF RUNTYPE = "C" THEN REPLY_PTR := 0 ELSE REPLY_PTR := 1 FI FOR FLD_PTR FROM 0 BY 1 TO COUNT FLD_NAME DO @ get a field from the screen input FIELD_TYPE := FLD_TYPE[FLD_PTR] FIELD_LEN := FLD_LEN[FLD_PTR] FIELD_VLDN := FLD_VLDN[FLD_PTR] SCR_FLD_LEN := CHARTOINT(FIELD_LEN) REPLY_FLD := SUBSTR(REPLY, REPLY_PTR, SCR_FLD_LEN) IF "DSUP" INCLUDES FIELD_TYPE THEN @ Separate the sign and number, and do basic @ validation if required REPLY_FLD := SUBSTR(REPLY, REPLY_PTR, SCR_FLD_LEN) REPLY_FLD := (REPLY_FLD + " ") BEFORE " " IF REPLY_FLD = "" THEN REPLY_FLD := "0" FI IF REPLY_FLD STARTSWITH "-" THEN SIGN_CHAR := "-" REPLY_FLD := REPLY_FLD AFTER "-" ELSE SIGN_CHAR := "+" IF REPLY_FLD STARTSWITH "+" THEN REPLY_FLD := REPLY_FLD AFTER "+" FI FI IF (VALIDATE_FLD AND (NOT DIGITS(REPLY_FLD))) THEN FLD_VALID[FLD_PTR] := FALSE REC_VALID := FALSE ELSE REPLY_FLD_NUM := CHARTOINT(SIGN_CHAR + REPLY_FLD) FI ELSE SIGN_CHAR := "" FI IF ((VALIDATE_FLD AND (FIELD_VLDN NE "")) AND (FLD_VALID[FLD_PTR])) THEN @ perform custom validation WHILE FIELD_VLDN INCLUDES "%F" DO IF ((FIELD_TYPE = "X") OR (FIELD_TYPE = "H")) THEN FIELD_VLDN := (FIELD_VLDN BEFORE "%F") + "REPLY_FLD" + (FIELD_VLDN AFTER "%F") ELSE FIELD_VLDN := (FIELD_VLDN BEFORE "%F") + "REPLY_FLD_NUM" + (FIELD_VLDN AFTER "%F") FI REPEAT WHILE FIELD_VLDN ENDSWITH " " DO FIELD_VLDN := SUBSTR(FIELD_VLDN,, LENGTH FIELD_VLDN - 1) REPEAT FIELD_VLDN := "IF NOT (" + FIELD_VLDN + ") THEN " + "FLD_VALID[VALID_PTR] := FALSE; " + "REC_VALID := FALSE FI" EXSCL(LIN = FIELD_VLDN) FI REPLY_PTR := REPLY_PTR + SCR_FLD_LEN IF FIELD_TYPE = "X" THEN @ copies input straight to output record REC_BUFF := REC_BUFF + REPLY_FLD ELSF FIELD_TYPE = "H" THEN @ validates hex input and sets up output field REC_FLD_LEN := SCR_FLD_LEN / 2 FOR CHAR_PTR FROM 0 BY 1 UNTIL CHAR_PTR >= SCR_FLD_LEN DO HEX_CHAR := SUBSTR(REPLY_FLD, CHAR_PTR) IF NOT (HEX_CHARS INCLUDES HEX_CHAR) THEN FLD_VALID[FLD_PTR] := FALSE REC_VALID := FALSE FI REPEAT IF FLD_VALID[FLD_PTR] THEN REC_BUFF := REC_BUFF + HEX(VAL REPLY_FLD, REC_FLD_LEN) FI ELSF FIELD_TYPE = "D" THEN @ validates display numeric input and sets up output @ field IF FLD_VALID[FLD_PTR] THEN FILL_LEN := SCR_FLD_LEN - LENGTH REPLY_FLD REC_BUFF := REC_BUFF + FILL(FILL_LEN, '0') + REPLY_FLD FI ELSF FIELD_TYPE = "U" THEN @ validates unsigned numeric input and sets up comp @ output field REC_FLD_LEN := CHARTOINT(SUBSTR(BIN_LEN, SCR_FLD_LEN)) IF SIGN_CHAR = '-' THEN FLD_VALID[FLD_PTR] := FALSE REC_VALID := FALSE FI IF FLD_VALID[FLD_PTR] THEN REC_BUFF := REC_BUFF + BIN(CHARTOINT(REPLY_FLD), REC_FLD_LEN) FI ELSF FIELD_TYPE = "S" THEN @ validates signed numeric input and sets up comp @ output field REC_FLD_LEN := CHARTOINT(SUBSTR(BIN_LEN, SCR_FLD_LEN)) IF FLD_VALID[VALID_PTR] THEN REPLY_FLD := SIGN_CHAR + REPLY_FLD REC_BUFF := REC_BUFF + BIN(CHARTOINT(REPLY_FLD), REC_FLD_LEN) FI ELSF FIELD_TYPE = "P" THEN @ validates signed input and sets up packed output @ field REC_FLD_LEN := (SCR_FLD_LEN / 2) + 1 IF FLD_VALID[FLD_PTR] THEN IF SIGN_CHAR = "-" THEN REPLY_FLD := REPLY_FLD + "D" ELSE REPLY_FLD := REPLY_FLD + "C" FI REC_BUFF := REC_BUFF + HEX(VAL REPLY_FLD, REC_FLD_LEN) FI FI REPEAT IF REC_VALID THEN PHASE := 'WRITING RECORD AWAY' WRR(CHA = OUT, REC = REC_BUFF, RES = FLAG) FI FI REC_BUFF := "" REPLY_LEN := 0 REPLY_ACTION := SUBSTR(REPLY) OR HEX(40) IF "EQ" INCLUDES REPLY_ACTION THEN @ leave the reply alone so loop can finish ELSE IF ((RUNTYPE = "E") AND (REPLY_ACTION = "I")) THEN @ redisplay the last record read ELSF NOT REC_VALID THEN @ redisplay the screen with bad fields highlighted LAST_REPLY := REPLY ELSF RUNTYPE NE 'C' THEN IF NOT END_OF_FILE THEN PHASE := "READING INPUT FILE (2)" RDR(CHA = IN, REC = IN_REC, RES = SFLAG) IF SFLAG = 26272 THEN END_OF_FILE := TRUE ELSE FLAG := SFLAG FI FI FI FI REPEAT IF ((RUNTYPE = 'E') AND (REPLY_ACTION = 'E')) THEN PHASE := 'COPYING TO END OF FILE' UNTIL END_OF_FILE DO WRR(CHA = OUT, REC = IN_REC, RES = FLAG) RDR(CHA = IN, REC = IN_REC, RES = SFLAG) IF SFLAG = 26272 THEN END_OF_FILE := TRUE ELSE FLAG := SFLAG FI REPEAT FI IF RUNTYPE NE "C" THEN PHASE := "CLOSING INPUT FILE" CLOF(CHA = IN, RES = FLAG) FI IF RUNTYPE NE "B" THEN PHASE := "CLOSING OUTPUT FILE" CLOF(CHA = OUT, RES = FLAG) FI SMSG(HEX(0C)) END