Retro1.org codex

SFORM

[00008] SCREEN FORMATTING OBJECT ROUTINES.
[00575] NEXTCHAR - GETS THE NEXT CHARACTER FROM VARDATA.
[00609] UPPER - CONVERT CHARACTER TO UPPER CASE.
[00641] SFATTR$ - SET FIELD ATTRIBUTES.
[00818] SFCLOS$ - CLOSE PANEL.
[01029] SFCSET$ - SET CHARACTER SET.
[01090] SFGETF$ - GET FIELD CHARACTER STRING.
[01140] SFDQUE$ - DEQUEUE A PIECE OF DATA FOR THIS TERMINAL.
[01250] SFGETI$ - GET INTEGER VALUE.
[01352] SFGETK - GET FUNCTION KEY.
[01380] SFGETN$ - GET TERMINAL MODEL NAME.
[01436] SFGETP$ - GET LAST CURSOR POSITION.
[01491] SFGETR$ - GET REAL VALUE.
[01581] SFMODE$ - QTRM MODE SWITCHING FUNCTION.
[01675] SFNQUE$ - ENQUEUE A BLOCK FOR A TERMINAL (ACN).
[01798] SFLUSH$ - FLUSH DATA ALREADY WRITTEN TO SCREEN.
[01839] SFOPEN$ - OPEN PANEL.
[02054] SFPOSR$ - POSITION TABLE ROW.
[02101] SFSETF$ - SET FIELD CHARACTER STRING.
[02151] SFQTRM$ - INTERFACE BETWEEN QTRM AND SFORM.
[02317] SFSETP$ - SET CURSOR POSITION.
[02364] SFSREA$ - READ PANEL USING INSTRING.
[02421] SFSSHO - SHOW PANEL USING INSTRING AND OUTSTRING.
[02468] SFSWRI$ - SCREEN FORMAT WRITE FUNCTION.
[02547] BFIELD - BLANK FIELD IN VARDATA.
[02598] CLRLNS - CLEAR LINES.
[02635] CPANEL - CLEAN PANEL.
[02703] DATEVL - DATE VALIDATION.
[02861] ERRMSG - ERROR MESSAGE PROCEDURE.
[02987] FFIELD - FIND INPUT FIELD.
[03050] FFIRST - FIND FIRST INPUT FIELD.
[03097] FMATCH - FIND ENTRY IN MATCH LIST.
[03207] FUNKEY - PROCESS FUNCTION KEY ACTION.
[03441] GETADD - GET ADDRESS.
[03519] GETNUM - GET NUMERIC VALUE OF SUBFIELD.
[03571] GFIELD - GET FIELD INDEX.
[03638] IRANGE - RANGE VALIDATION FOR INTEGER VARIABLES.
[03692] MATCHV - MATCH VALIDATION.
[03734] MCLEAN - MESSAGE CLEAN.
[03790] MMATCH - MOVE MATCH VALUE INTO VARIABLE FIELD.
[03840] MOVEFLD - MOVE FIELD.
[03969] MOVEST - MOVE STRING.
[04062] MVA8A8 - MOVE ASCII8 STRING.
[04138] MVASA8 - MOVE AND TRANSLATE ASCII TO ASCII8.
[04250] MVA8AS - MOVE AND TRANSLATE ASCII8 TO ASCII.
[04381] MVA8DC - MOVE AND TRANSLATE ASCII8 TO DISPLAY CODE.
[04461] MVDCA8 - MOVE AND TRANSLATE DISPLAY CODE TO ASCII8.
[04540] NCHECK - CHECK NUMERIC FIELD.
[04776] PICVAL - PERFORM PICTURE VALIDATION.
[04866] POSARR - POSITION PANEL RECORD BASED ARRAYS.
[04911] POSTWO - POSITION PANEL RECORD BASED ARRAYS FOR SFATTR.
[04952] PSTRNG - PRINT MESSAGE STRING.
[05188] READIN - READ INPUT FROM TERMINAL.
[05831] READSF - READ SCREEN FORMATTED PANEL.
[05995] RESTFLD - RESTORE DESTROYED FIELD.
[06036] REWFLD - REWRITE FIELDS.
[06106] REALRANGE - RANGE VALIDATION FOR REAL VARIABLES.
[06159] SETATR - SET FIELD ATTRIBUTES.
[06191] SETFSF - SET FIELD STATUS FLAGS FOR PANEL.
[06248] SETSRN - SET SCREEN.
[06312] SFLOAD - LOAD PANEL.
[06432] SKPBLK - SKIP BLANKS.
[06476] TABKEY - PROCESS TAB KEY.
[06571] VALIDF - VALIDATE FIELD.
[06706] WRIALL - WRITE ALL PANELS.
[06781] WRIBOX - WRITE BOX.
[06873] WRIPAN - WRITE PANEL.
[07006] WRITES - WRITE SCREEN.
[07075] WRIVAR - WRITE VARIABLE.
[07169] WRIVCH - WRITE CHARACTER INTO VARDATA.
Source Code

PROC SFORM;
 
# TITLE SFORM - SCREEN FORMATTING OBJECT ROUTINES. #
 
BEGIN  # SFORM #
 
#
***       SFORM - SCREEN FORMATTING OBJECT ROUTINES.
*
*         COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
#
 
DEF  EDITORVDT  #0#;                 # STAND ALONE VERSION OF VIRTERM #
DEF  EUROPEAN   #0#;                 # NOT EUROPEAN NUMERIC FORMAT #
*IF DEF,LIST
DEF  LISTCON    #1#;                 # EXPANDED COMMON DECKS #
*ELSE
DEF  LISTCON    #0#;                 # NO EXPANDED COMMON DECKS #
*ENDIF
DEF  SINGLE     #1#;                 # SINGLE USER (VIRTERM) #
DEF  MULTI      #0#;                 # NOT A MULTI-USER #
*IF UNDEF,QTRM
DEF  QTRMV      #0#;                 # NOT QTRM VERSION #
*ELSE
DEF  QTRMV      #1#;                 # QTRM VERSION #
*ENDIF
 
XDEF
  BEGIN
  PROC SFATTR$;                      # SET FIELD ATTRIBUTES #
  PROC SFCLOS$;                      # UNLOAD PANEL #
  PROC SFCSET$;                      # SET CHARACTER SET #
*IF DEF,QTRM
  PROC SFDQUE$;                      # QTRM DEQUEUE TERMINAL DATA #
*ENDIF
  PROC SFGETF$;                      # GET FIELD CHARACTER STRING #
  PROC SFGETI$;                      # GET INTEGER VALUE #
  PROC SFGETK;                       # GET FUNCTION KEY INPUT #
  PROC SFGETN$;                      # GET TERMINAL MODEL NAME #
  PROC SFGETP$;                      # GET FUNCTION KEY POSITION #
  PROC SFGETR$;                      # GET REAL VALUE #
  PROC SFLUSH$;                      # FLUSH OUTPUT TO SCREEN #
*IF DEF,QTRM
  PROC SFMODE$;                      # QTRM SET TERMINAL MODE #
  PROC SFNQUE$;                      # QTRM ENQUEUE TERMINAL DATA #
*ENDIF
  PROC SFOPEN$;                      # LOAD PANEL AND OPEN FOR USE #
  PROC SFPOSR$;                      # POSITION TABLE ROW #
  PROC SFSETF$;                      # SET FIELD CHARACTER STRING #
*IF DEF,QTRM
  PROC SFQTRM$;                      # QTRM IDENTIFY USER #
*ENDIF
  PROC SFSETP$;                      # SET CURSOR POSITION FOR READ #
  PROC SFSREA$;                      # READ PANEL FROM TERMINAL #
*IF UNDEF,QTRM
  PROC SFSSHO$;                      # WRITE AND READ PANEL #
*ENDIF
  PROC SFSWRI$;                      # WRITE PANEL TO TERMINAL #
  END
 
XREF
  BEGIN
*CALL     COMFXVT
*IF DEF,QTRM
  PROC CMMALF;                       # CMM ALLOCATE A BLOCK #
  PROC CMMFRF;                       # CMM FREE A BLOCK #
*ENDIF
  PROC VDTCLO;                       # CLOSE TERMINAL #
  PROC VDTFOS;                       # FLUSH OUTPUT TO SCREEN #
*IF UNDEF,QTRM
  PROC VDTGSL;                       # GET TERMINAL MODEL #
*ENDIF
  PROC VDTMSG$;                      # DAYFILE AND B-DISPLAY MESSAGE #
*IF UNDEF,QTRM
  PROC VDTOPN;                       # OPEN TERMINAL #
*ENDIF
  END
 
XREF
  BEGIN
  PROC ABORT;                        # ABORT THE PROGRAM/USER #
  FUNC GFP;                          # GENERATE FLOATING POINT VALUE #
  PROC LCP;                          # LOAD CAPSULE #
  PROC PLT;                          # PANEL LOAD TABLE #
  PROC UCP;                          # UNLOAD CAPSULE #
  END
CONTROL EJECT;
 
# DEFINITIONS FOR COMMONLY USED CHARACTER VALUES, PSEUDO WHILE LOOP, #
# AND VALIDFIELD (DEFINED AS =FIELD GQ 0= ) WHICH IS FREQUENTLY USED #
# IN THE CODE TO DETERMINE IF THE FIELD IN QUESTION IS A VALID ONE.  #
 
DEF  ASTERISK   #O"0052"#;           # 12 BIT ASTERISK #
DEF  BLANK      #O"0040"#;           # 12 BIT BLANK #
DEF  CAPA       #O"0101"#;           # 12 BIT UPPER CASE A #
DEF  CAPE       #O"0105"#;           # 12 BIT UPPER CASE E #
DEF  CAPZ       #O"0132"#;           # 12 BIT UPPER CASE Z #
DEF  CSMR       #O"0067"#;           # SYSTEM CHARACTER SET MODE WORD #
DEF  COMMA      #O"0054"#;           # 12 BIT COMMA #
DEF  DOLLAR     #O"0044"#;           # 12 BIT DOLLAR SIGN #
DEF  LOWA       #O"0141"#;           # 12 BIT LOWER CASE A #
DEF  LOWZ       #O"0172"#;           # 12 BIT LOWER CASE Z #
DEF  MINUS      #O"0055"#;           # 12 BIT MINUS SIGN #
DEF  NINECH     #O"0071"#;           # 12 BIT NINE (CHARACTER) #
DEF  PANHEADLEN #5#;                 # LENGTH OF PANEL HEADER #
DEF  PERIOD     #O"0056"#;           # 12 BIT PERIOD #
DEF  PLUS       #O"0053"#;           # 12 BIT PLUS SIGN #
DEF  VALIDFIELD #FIELD GQ 0#;        # VALID INPUT FIELD #
DEF  WHYLE      #FOR DUMMY = DUMMY WHILE#;  # PSUEDO WHILE LOOP #
DEF  XMASKOF    #B&lt;51,9>#;           # X COORDINATE PART OF FLDPOS #
DEF  YMASKOF    #B&lt;45,6>#;           # Y COORDINATE PART OF FLDPOS #
DEF  ZEROCH     #O"0060"#;           # 12 BIT ZERO (CHARACTER) #
 
# COMFVDT CONTAINS STATUS SWITCHES USED BY SFORM, VIRTERM AND FSE.    #
*CALL     COMFVDT
*IF DEF,QTRM
 
# COMFVD3 CONTAINS STORAGE LOCATIONS USED BY BOTH VIRTERM AND SFORM.  #
*ENDIF
*IFCALL QTRM,COMFVD3
CONTROL EJECT;
 
ITEM DUMMY      I;                   # DUMMY PARAMETER #
 
BASED ARRAY ARRLIST [0:0] S(2);      # ARRAY LIST #
  BEGIN
  ITEM ARRNAME    C(00,00,07);       # ARRAY NAME #
  ITEM ARRCURROW  U(01,00,12);       # CURRENT ROW ON SCREEN #
  ITEM ARRTOPROW  U(01,18,18);       # TOP ROW ON SCREEN #
  ITEM ARRNUMROWS U(01,36,08);       # NUMBER OF ROWS ON SCREEN #
  ITEM ARRNUMVARS U(01,44,08);       # NUMBER OF VARIABLES PER ROW #
  END
 
BASED ARRAY ARR2LIST [0:0] S(2);     # ARRAY LIST FOR *SFATTR* #
  BEGIN
  ITEM ARR2CURROW U(01,00,12);       # CURRENT ROW ON SCREEN #
  ITEM ARR2NUMVAR U(01,44,08);       # NUMBER OF VARIABLES PER ROW #
  END
 
BASED ARRAY ATTLIST [0:0] P(1);      # ATTRIBUTE LIST #
  BEGIN
  ITEM ATTMASK    U(00,00,12);       # ATTRIBUTE MASK FOR *VDTSAM* #
  ITEM ATTLINEWT  U(00,58,02);       # LINE WEIGHT FOR *VDTBOX* #
  END
 
BASED ARRAY ATT2LIST [0:0] P(1);     # ATTRIBUTE LIST FOR *SFATTR* #
  BEGIN
  ITEM ATT2MASK   U(00,00,12);       # ATTRIBUTE MASK FOR VDTSAM #
  END
 
BASED ARRAY BOXLIST [0:0] P(1);      # BOX LIST #
  BEGIN
  ITEM BOXWORD    U(00,00,60);       # FULL WORD #
  ITEM BOXATTORD  U(00,00,12);       # ATTRIBUTE ORDINAL #
  ITEM BOXCHAR    U(00,12,04);       # LINE DRAWING CHARACTER #
  ITEM BOXYCORD   U(00,16,06);       # Y COORDINATE #
  ITEM BOXXCORD   U(00,22,09);       # X COORDINATE #
  ITEM BOXREPEAT  U(00,31,09);       # REPEAT COUNT FOR THIS CHAR. #
  END
 
BASED ARRAY CORE[0:0] P(1);          # MEMORY #
  BEGIN
  ITEM COREWORD   I(00,00,60);       # FULL WORD #
  END
 
BASED ARRAY FLDLIST [0:0] P(1);      # FIELD LIST #
  BEGIN
  ITEM FLDENTRY   U(00,00,60);       # FULL WORD #
  ITEM FLDVARFLAG B(00,00,01);       # VARIABLE FIELD FLAG #
  ITEM FLDATTORD  U(00,01,07);       # FIELD ATTRIBUTE ORDINAL #
  ITEM FLDINPUTV  B(00,08,01);       # INPUT FIELD FLAG #
  ITEM FLDOUTPUTV B(00,09,01);       # OUTPUT FIELD FLAG #
  ITEM FLDSTFLAGS U(00,10,04);       # FIELD STATUS FLAGS #
  ITEM FLDENTERED B(00,10,01);       # INPUT ENTERED IN FIELD FLAG #
  ITEM FLDVALID   B(00,11,01);       # INPUT PASSED VALIDATION #
  ITEM FLDREWRITE B(00,12,01);       # REWRITE FIELD ON SCREEN FLAG #
  ITEM FLDACTIVE  B(00,13,01);       # ACTIVE FIELD FLAG #
  ITEM FLDVARORD  U(00,15,08);       # ORDINAL INTO VARLIST FOR FIELD #
  ITEM FLDCONOS   U(00,18,18);       # CONSTANT OFFSET INTO RECORD #
  ITEM FLDVDTCORD U(00,23,13);       # CHARACTER ORDINAL IN VARDATA #
  ITEM FLDLENGTH  U(00,36,09);       # LENGTH IN 12 BIT CHARACTERS #
  ITEM FLDPOS     U(00,45,15);       # COORDINATES OF FIELD #
  ITEM FLDYCORD   U(00,45,06);       # Y COORDINATE OF FIELD #
  ITEM FLDXCORD   U(00,51,09);       # X COORDINATE OF FIELD #
  END
 
BASED ARRAY FLD2LIST [0:0] P(1);     # FIELD LIST FOR *SFATTR* #
  BEGIN
  ITEM FLD2ATTORD U(00,01,07);       # FIELD ATTRIBUTE ORDINAL #
  ITEM FLD2INPUTV B(00,08,01);       # INPUT FIELD FLAG #
  ITEM FLD2OUTPUT B(00,09,01);       # OUTPUT FIELD FLAG #
  ITEM FLD2ENTERE B(00,10,01);       # INPUT ENTERED IN FIELD FLAG #
  ITEM FLD2VALID  B(00,11,01);       # INPUT PASSED VALIDATION #
  ITEM FLD2REWRIT B(00,12,01);       # REWRITE FIELD ON SCREEN FLAG #
  ITEM FLD2VARORD U(00,15,08);       # ORDINAL INTO VARLIST FOR FIELD #
  END
 
BASED ARRAY FROMSTRING [0:0] P(1);   # FROM STRING #
  BEGIN
  ITEM FROMSTRIU  U(00,00,60);       # FROMSTRING WORD (INTEGER) #
  END
 
BASED ARRAY FUNLIST [0:0] S(1);      # FUNCTION LIST #
  BEGIN
  ITEM FUNWORD    U(00,00,60);       # FIRST WORD OF ENTRY #
  ITEM FUNASG     U(00,26,18);       # VARIABLE ASSIGNMENT OFFSET #
  ITEM FUNACT     U(00,44,09);       # FUNCTION ACTION TO BE TAKEN #
  ITEM FUNGENERIC B(00,53,01);       # GENERIC FUNTION KEY FLAG #
  ITEM FUNNUMBER  I(00,54,06);       # FUNCTION NUMBER #
  END
 
BASED ARRAY MATCHLIST [0:0] S(2);    # MATCH LIST #
  BEGIN
  ITEM MATCHWORD  U(00,00,60);       # FIRST WORD OF MATCH LIST ENTRY #
  ITEM MATCH      C(00,00,20);       # TWO WORD MATCH ITEM #
  END
 
BASED ARRAY PANELHEADR [0:0] S(5);   # PANEL HEADER #
  BEGIN
  ITEM PANELNME   C(00,00,07);       # PANEL NAME #
  ITEM PANPRIPAN  B(00,58,01);       # PRIMARY PANEL (NOT OVERLAY) #
  ITEM PANNUMLNES U(01,00,06);       # NUMBER OF LINES IN PANEL #
  ITEM PANRECLEN  U(01,06,18);       # LENGTH OF PANEL IN WORDS #
  ITEM PANSTRFUN  U(01,24,18);       # START OF FUNCTION LIST OFFSET #
  ITEM PANSTRVAR  U(01,42,18);       # START OF VARIABLE LIST OFFSET #
  ITEM PANVERSION U(02,00,06);       # VERSION NUMBER #
  ITEM PANSTRATT  U(02,06,18);       # START OF ATTRIBUTE LIST OFFSET #
  ITEM PANSTRARR  U(02,24,18);       # START OF ARRAY LIST OFFSET #
  ITEM PANSTRFLD  U(02,42,18);       # START OF FIELD LIST OFFSET #
  ITEM PANSTRBOX  U(03,06,18);       # START OF BOX LIST OFFSET #
  ITEM PANMSGLEN  U(03,36,09);       # MESSAGE FIELD LENGTH #
  ITEM PANMSGYCRD U(03,45,06);       # MESSAGE Y COORDINATE #
  ITEM PANMSGXCRD U(03,51,09);       # MESSAGE X CORRDINATE #
  ITEM PANNUMBYTE U(04,00,13);       # NUMBER OF BYTES IN VAR DATA #
  ITEM PANNUMCOLS U(04,13,09);       # NUMBER OF COLUMNS IN PANEL #
  END
CONTROL EJECT;
 
BASED ARRAY PANEL2HEAD [0:0] S(5);   # PANEL HEADER FOR *SFATTR* #
  BEGIN
  ITEM PANEL2NME  C(00,00,07);       # PANEL NAME #
  ITEM PAN2RECLEN U(01,06,18);       # LENGTH OF PANEL IN WORDS #
  ITEM PAN2STRFUN U(01,24,18);       # START OF FUNCTION LIST OFFSET #
  ITEM PAN2STRVAR U(01,42,18);       # START OF VARIABLE LIST OFFSET #
  ITEM PAN2STRATT U(02,06,18);       # START OF ATTRIBUTE LIST OFFSET #
  ITEM PAN2STRARR U(02,24,18);       # START OF ARRAY LIST OFFSET #
  ITEM PAN2STRFLD U(02,42,18);       # START OF FIELD LIST OFFSET #
  ITEM PAN2STRBOX U(03,06,18);       # START OF BOX LIST OFFSET #
  END
 
BASED ARRAY PLTABLE [0:0] S(2);      # PANEL LOAD TABLE #
  BEGIN
  ITEM PLTWORDONE U(00,00,60);       # WORD ONE OF TWO #
  ITEM PLTENAME   C(00,00,07);       # PANEL NAME #
  ITEM PLTENTRYNM U(00,48,12);       # SEQUENCE NUMBER ON SCREEN #
  ITEM PLTWORDTWO U(01,00,60);       # WORD TWO OF TWO #
  ITEM PLTSLFLAG  B(01,00,01);       # STATIC LOAD FLAG #
  ITEM PLTOPENFLG B(01,01,01);       # PANEL OPEN FLAG #
  ITEM PLTNUMQTRM I(01,24,12);       # NUMBER OF QTRM USERS OF PANEL #
  ITEM PLTNUMONSC U(01,36,12);       # NUMBER OF PANELS ON SCREEN #
  ITEM PLTADDR    U(01,42,18);       # MEMORY ADDRESS OF PANEL #
  ITEM PLTNUMENT  U(01,48,12);       # CURRENT NUMBER OF ENTRIES #
  END
 
BASED ARRAY RECORD [0:0] P(1);       # PANEL RECORD #
  BEGIN
  ITEM RECWORDC   C(00,00,10);       # PANEL RECORD WORD (CHARACTER) #
  ITEM RECWORDR   R(00,00,60);       # PANEL RECORD WORD (REAL) #
  ITEM RECWORDU   U(00,00,60);       # PANEL RECORD WORD (INTEGER) #
  END
 
BASED ARRAY TOSTRING [0:0] P(1);     # TO STRING #
  BEGIN
  ITEM TOSTRIU    U(00,00,60);       # TOSTRING WORD (INTEGER) #
  END
 
BASED ARRAY VARLIST [0:0] S(2);      # VARIABLE LIST #
  BEGIN
  ITEM VARMUSCON  B(00,00,01);       # MUST CONTAIN (A VALUE) #
  ITEM VARFLDNUM  U(00,01,09);       # FIELD ORDINAL #
  ITEM VARROWNUM  U(00,10,08);       # ROW NUMBER #
  ITEM VARARRORD  U(00,18,05);       # ARRAY ORDINAL #
  ITEM VARMUSENTR B(00,23,01);       # MUST ENTER DATA IN FIELD #
  ITEM VARMUSFILL B(00,24,01);       # MUST FILL FIELD WITH DATA #
  ITEM VARMUSKNOW B(00,25,01);       # * NOT ALLOWED #
  ITEM VARTYPE    U(00,26,02);       # VARIABLE TYPE (INT CHAR REAL) #
  ITEM VARPICTYPE U(00,28,08);       # PICTURE TYPE #
  ITEM VARVALTYPE U(00,36,06);       # VALIDATION TYPE #
  ITEM VARVALR    B(00,40,01);       # RANGE VALIDATION #
  ITEM VARVALM    B(00,41,01);       # MATCH VALIDATION #
  ITEM VARVALOS   U(00,42,18);       # VALIDATION OFFSET #
  ITEM VARNME     C(01,00,07);       # VARIABLE NAME (DISPLAY CODE) #
  ITEM VARHSOS    U(01,42,18);       # HELP STRING OFFSET #
  END
 
BASED ARRAY VAR2LIST [0:0] S(2);     # VARIABLE LIST FOR *SFATTR* #
  BEGIN
  ITEM VAR2FLDNUM U(00,01,09);       # FIELD ORDINAL #
  ITEM VAR2ARRORD U(00,18,05);       # ARRAY ORDINAL #
  ITEM VAR2TYPE   U(00,26,02);       # VARIABLE TYPE (INT CHAR REAL) #
  ITEM VAR2NME    C(01,00,07);       # VARIABLE NAME (DISPLAY CODE) #
  END
 
BASED ARRAY VDATA [0:0] P(1);        # VAR DATA #
  BEGIN
  ITEM VDATAC     C(00,00,10);       # VARDATA WORD (CHARACTER) #
  ITEM VDATAU     U(00,00,60);       # VARDATA WORD (INTEGER) #
  END
 
ARRAY CHARCONV1 [0:127] P(1);        # DISPLAY CODE TO ASCII8 #
  BEGIN
  ITEM DC2A8 U(00,00,60)= [
  O"0072", O"0101", O"0102", O"0103",  # COLON A B C #
  O"0104", O"0105", O"0106", O"0107",  # D E F G #
  O"0110", O"0111", O"0112", O"0113",  # H I J K #
  O"0114", O"0115", O"0116", O"0117",  # L M N O #
  O"0120", O"0121", O"0122", O"0123",  # P Q R S #
  O"0124", O"0125", O"0126", O"0127",  # T U V W #
  O"0130", O"0131", O"0132", O"0060",  # X Y Z 0 #
  O"0061", O"0062", O"0063", O"0064",  # 1 2 3 4 #
  O"0065", O"0066", O"0067", O"0070",  # 5 6 7 8 #
  O"0071", O"0053", O"0055", O"0052",  # 9 PLUS MINUS ASTERISK #
  O"0057", O"0050", O"0051", O"0044",  # SLANT LPAREN RPAREN DOLLAR #
  O"0075", O"0040", O"0054", O"0056",  # EQUAL BLANK COMMA PERIOD #
  O"0043", O"0133", O"0135", O"0045",  # POUND LBRAC RBRAC PERCENT #
  O"0042", O"0137", O"0041", O"0046",  # QUOTE UNDERLINE XPOINT AMPER #
  O"0047", O"0077", O"0074", O"0076",  # APOSTROPHE QMARK LTHAN GTHAN #
  O"0100", O"0134", O"0136", O"0073",  # ATSIGN REVSLANT CIRCUM SEMI #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040",  # BLANK FILL #
  O"0040", O"0040", O"0040", O"0040"]; # BLANK FILL #
  END
 
ARRAY CHARCONV2 [0:127] P(1);        # ASCII8 TO DISPLAY CODE #
  BEGIN
  ITEM A82DC U(00,00,60)= [
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"55", O"55", O"55",        # BLANK FILL #
  O"55", O"66", O"64", O"60",        # BLANK XMARK QUOTE POUND #
  O"53", O"63", O"67", O"70",        # DOLLAR PERCENT AMPER APOS #
  O"51", O"52", O"47", O"45",        # LPAREN RPAREN ASTERISK PLUS #
  O"56", O"46", O"57", O"50",        # COMMA MINUS PERIOD SLANT #
  O"33", O"34", O"35", O"36",        # 0 1 2 3 #
  O"37", O"40", O"41", O"42",        # 4 5 6 7 #
  O"43", O"44", O"00", O"77",        # 8 9 COLON SEMI #
  O"72", O"54", O"73", O"71",        # LTHAN EQUAL GTHAN QMARK #
  O"74", O"01", O"02", O"03",        # ATSIGN UCA UCB UCC #
  O"04", O"05", O"06", O"07",        # UCD UCE UCF UCG #
  O"10", O"11", O"12", O"13",        # UCH UCI UCJ UCK #
  O"14", O"15", O"16", O"17",        # UCL UCM UCN UCO #
  O"20", O"21", O"22", O"23",        # UCP UCQ UCR UCS #
  O"24", O"25", O"26", O"27",        # UCT UCU UCV UCW #
  O"30", O"31", O"32", O"61",        # UCX UCY UCZ LBRAC #
  O"75", O"62", O"76", O"65",        # RSLANT RBRAC CIRCUM ULINE #
  O"74", O"01", O"02", O"03",        # GRAVE LCA LCB LCC #
  O"04", O"05", O"06", O"07",        # LCD LCE LCF LCG #
  O"10", O"11", O"12", O"13",        # LCH LCI LCJ LCK #
  O"14", O"15", O"16", O"17",        # LCL LCM LCN LCO #
  O"20", O"21", O"22", O"23",        # LCP LCQ LCR LCS #
  O"24", O"25", O"26", O"27",        # LCT LCU LCV LCW #
  O"30", O"31", O"32", O"61",        # LCX LCY LCZ LBRAC #
  O"75", O"62", O"76", O"55"];       # VLINE RBRAC TILDE DEL(NO EQ) #
  END
 
ARRAY CHARCONV3 [1:7] P(1);          # SPECIAL ASCII CODES #
  BEGIN
  ITEM AS2A8 U(00,00,60)= [
  O"0100", O"0136", O"0040",         # ATSIGN CIRCUMFLEX (BLANK) #
  O"0072", O"0040", O"0040",         # COLON (BLANK) (BLANK) #
  O"0140"];                          # RSLANT #
  END
CONTROL EJECT;
 
 
ARRAY TERMSTAT [0:0] P(15);          # TERMINAL STATUS FLAGS          #
  BEGIN
  ITEM TERMSTATWD U(00,00,60) = [0]; # FULL WORD                      #
  ITEM TERABNTERM B(00,00,01);       # ABNORMAL TERMINATION           #
  ITEM TERASCFLAG B(00,01,01);       # ASCII CODE SET FLAG            #
  ITEM TERAS8FLAG B(00,02,01);       # ASCII8 CODE SET FLAG           #
  ITEM TERCURSSET B(00,03,01);       # CURSOR SET BY SFSETP$          #
  ITEM TERCNWRIOV B(00,04,01);       # OVERLAY WRITE ALLOWED          #
  ITEM TERDONTCLR B(00,05,01);       # RESPECT ENTERED/REWRITE        #
  ITEM TERFUNCGEN B(00,06,01);       # GENERIC FUNCTION KEY FLAG      #
  ITEM TERHELPREQ B(00,07,01);       # HELP REQUESTED                 #
  ITEM TERMESREAD B(00,08,01);       # MESSAGE READ BY USER           #
  ITEM TERMESWRIT B(00,09,01);       # MESSAGE WRITTEN                #
  ITEM TERMISSINP B(00,10,01);       # INPUT OUTSIDE OF FIELD         #
  ITEM TERNOINVRS B(00,11,01);       # NO INPUT VARIABLES IN PANEL    #
  ITEM TERNOREWRT B(00,12,01);       # NOT REWRITING VARIABLES        #
  ITEM TERNRMTERM B(00,13,01);       # NORMAL TERMINATION             #
  ITEM TERPENDHLP B(00,14,01);       # HELP (AFTER SOFT TABS)         #
  ITEM TERREADFLG B(00,15,01);       # CALLING PROCEDURE IS READ      #
  ITEM TERREWFLDS B(00,16,01);       # REWRITE FIELDS                 #
  ITEM TERREWSCRN B(00,17,01);       # COMPLETE SCREEN REWRITE        #
  ITEM TERSCREENM B(00,18,01);       # SCREEN/LINE MODE FLAG          #
  ITEM TERSHOWFLG B(00,19,01);       # CALLING PROCEDURE IS SHOW      #
  ITEM TERVDTBOOC B(00,20,01);       # CALLED VDTBOO YET FLAG         #
  ITEM TERRESERV0 U(00,21,37);       # RESERVED                       #
  ITEM TERQTRMSOL B(00,58,01);       # QTRM SCREEN OR LINE FLAG       #
  ITEM TERWAITINP B(00,59,01);       # QTRM WAITING FOR INPUT         #
  ITEM TERACTPANL C(01,00,07) = ["       "];  # ACTIVE PANEL NAME     #
  ITEM TERACTPLTI I(01,42,18) = [0]; # GLOBAL ACTIVE PLT INDEX        #
  ITEM TERHEADTHR U(02,00,60);       # WORD THREE                     #
  ITEM TERPTRHGTC U(02,00,04);       # PROTECTED RIGHT BEHAVIOR       #
  ITEM TERPTLEFTC U(02,04,04);       # PROTECTED LEFT BEHAVIOR        #
  ITEM TERPTUPCUR U(02,08,04);       # PROTECTED UP BEHAVIOR          #
  ITEM TERPTDNCUR U(02,12,04);       # PROTECTED DOWN BEHAVIOR        #
  ITEM TERUNRHGTC U(02,16,04);       # UNPROTECTED RIGHT BEHAVIOR     #
  ITEM TERUNLEFTC U(02,20,04);       # UNPROTECTED LEFT BEHAVIOR      #
  ITEM TERUNUPCUR U(02,24,04);       # UNPROTECTED UP BEHAVIOR        #
  ITEM TERUNDNCUR U(02,28,04);       # UNPROTECTED DOWN BEHAVIOR      #
  ITEM TERRESERV2 U(02,32,28);       # RESERVED                       #
  ITEM TERHEADFOU U(03,00,60);       # WORD FOUR                      #
  ITEM TERCURADDT U(03,00,06);       # CURSOR ADDRESSING TYPE         #
  ITEM TERCURBIAS I(03,06,08);       # CURSOR BIAS FOR POSTIONING     #
  ITEM TERLEFTCUR U(03,14,04);       # CURSOR LEFT BEHAVIOR           #
  ITEM TERRGHTCUR U(03,18,04);       # CURSOR RIGHT BEHAVIOR          #
  ITEM TERUPCURSR U(03,22,04);       # CURSOR UP BEHAVIOR             #
  ITEM TERDWNCRSR U(03,26,04);       # CURSOR DOWN BEHAVIOR           #
  ITEM TERLEFTCHR U(03,30,04);       # CHARACTER LEFT BEHAVIOR        #
  ITEM TERRGHTCHR U(03,34,04);       # CHARACTER RIGHT BEHAVIOR       #
  ITEM TERLASTPOS U(03,38,04);       # LAST POSITION BEHAVIOR (CHAR)  #
  ITEM TERXFIRSTY B(03,42,01);       # X BEFORE Y IN CURSOR OUTPUT    #
  ITEM TERXDECIML U(03,43,03);       # X COORDINATE COUNT IF DECIMAL  #
  ITEM TERYDECIML U(03,46,03);       # Y COORDINATE COUNT IF DECIMAL  #
  ITEM TERRESERV3 U(03,49,11);       # RESERVED                       #
  ITEM TERHEADFIV U(04,00,60);       # WORD FIVE                      #
  ITEM TERVTHOMEU B(04,00,01);       # HOME UP FLAG                   #
  ITEM TERPROTECT B(04,01,01);       # TERMINAL HAS PROTECT           #
  ITEM TERVTDIFSS B(04,02,01);       # DIFFERENT SCREEN SIZES         #
  ITEM TERVTUNUSD B(04,03,01);       # UNUSED                         #
  ITEM TERGUARDMD B(04,04,01);       # TERMINAL HAS GUARD/HIDDEN MODE #
  ITEM TERTABHOME B(04,05,01);       # PROTECTED TAB GOES TO HOME     #
  ITEM TERTABPROT B(04,06,01);       # TABS TO UNPROTECTED FIELDS     #
  ITEM TERVTABSTP B(04,07,01);       # TABS TO TAB STOP               #
  ITEM TERSIZECLR B(04,08,01);       # SIZE CHANGE CLEARS SCREEN      #
  ITEM TERTABAUTO B(04,09,01);       # TERMINAL HAS AUTOMATIC TABBING #
  ITEM TERTYPHEAD B(04,10,01);       # TYPE AHEAD ENABLED             #
  ITEM TERBLCKMDE B(04,11,01);       # BLOCK MODE TERMINAL            #
  ITEM TERPTDWFLN B(04,12,01);       # PROT TABS DO NOT WRAP FWD LINE #
  ITEM TERPTDWFPG B(04,13,01);       # PROT TABS WILL NOT WRAP PAGE   #
  ITEM TERPTDWBLN B(04,14,01);       # PROT TABS DO NOT WRAP BKW LINE #
  ITEM TERPTDWBPG B(04,15,01);       # PROT TABS DO NOT WRAP BKW PAGE #
  ITEM TERUNDWFLN B(04,16,01);       # UNPROT TABS DO NOT WRAP FWD LN #
  ITEM TERUNDWFPG B(04,17,01);       # UNPROT TABS DO NOT WRAP FWD PG #
  ITEM TERUNDWBLN B(04,18,01);       # UNPROT TABS DO NOT WRAP BKW LN #
  ITEM TERUNDWBPG B(04,19,01);       # UNPROT TABS DO NOT WRAP BKW PG #
  ITEM TERATTRCHR B(04,20,01);       # ATTRIBUTE CHARACTER NEEDS BYTE #
  ITEM TERATTRSET B(04,21,01);       # RESET ATTRIBUTES BEFORE VDTPOS #
  ITEM TERSNDSPLR B(04,22,01);       # SEND DISPLAY REWRITE FOR SFORM #
  ITEM TERSNDSPLH B(04,23,01);       # SEND DISPLAY ON HELP FOR SFORM #
  ITEM TERNOTMASK B(04,24,01);       # ATTRIBUTES ARE NOT MASKABLE    #
  ITEM TERNOTCHAR B(04,25,01);       # ATTRIBUTES ARE LINE/PAGE BASED #
  ITEM TERNOVDTEO B(04,26,01);       # DISABLE OUTPUT END (ERR. EXIT) #
  ITEM TERPROCLRS B(04,27,01);       # PROTECT ALL CLEARS THE SCREEN  #
  ITEM TERCLEARSM B(04,28,01);       # CLEARS ACROSS PROTECTED FIELDS #
  ITEM TERRSBIT29 B(04,29,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT30 B(04,30,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT31 B(04,31,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT32 B(04,32,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT33 B(04,33,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT34 B(04,34,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT35 B(04,35,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERRSBIT36 B(04,36,01);       # RESERVED FOR CDC (FUTURE CODE) #
  ITEM TERINSTL01 B(04,37,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL02 B(04,38,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL03 B(04,39,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL04 B(04,40,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL05 B(04,41,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL06 B(04,42,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL07 B(04,43,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL08 B(04,44,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL09 B(04,45,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL10 B(04,46,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL11 B(04,47,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL12 B(04,48,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL13 B(04,49,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL14 B(04,50,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL15 B(04,51,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL16 B(04,52,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL17 B(04,53,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL18 B(04,54,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL19 B(04,55,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERINSTL20 B(04,56,01);       # RESERVED FOR INSTALLATION CODE #
  ITEM TERLEAVESM U(04,57,03);       # FUNCTION KEY MARK COUNT        #
  ITEM TERSOFTPOS I(05,00,24);       # POSITION OF FIRST SOFT TAB     #
  ITEM TERCURSOFF I(05,24,18);       # CURSOR OFFSET POSITION         #
  ITEM TERCURSROW I(05,42,18);       # CURSOR ROW POSITION            #
  ITEM TERCURSVAR C(06,00,07);       # CURSOR VARIABLE POSITION       #
  ITEM TERASC8ATD U(06,42,06) = [58];# ASCII FOR 6/12 AT/D            #
  ITEM TERSOFTTAB I(06,48,12);       # NUMBER OF SOFT TABS PENDING    #
  ITEM TERPREVPOS U(07,00,60);       # PREVIOUS ATTRIBUTE POSITION    #
  ITEM TERFLDADDR U(08,00,60);       # FIELD LIST ADDRESS             #
  ITEM TERFLDFRST I(09,00,30);       # POSITION OF FIRST INPUT FIELD  #
  ITEM TERFLDLAST I(09,30,30);       # POSITION OF LAST INPUT FIELD   #
  ITEM TERFUNCPOS U(10,00,24) = [0]; # LAST FUNCTION KEY POSITION     #
  ITEM TERFUNCORD I(10,24,12);       # FUNCTION KEY ORDINAL           #
  ITEM TERHELPFLD I(10,36,24) = [0]; # HELP FIELD INDEX               #
  ITEM TERMODNAME C(11,00,07) = ["       "];  # TERMINAL MODEL NAME   #
  ITEM TERXXXXXXX U(11,42,18);       # RESERVED FOR FUTURE (CDC) USE  #
  ITEM TERNUMCOLS U(12,00,60) = [0]; # NUMBER OF COLUMNS ON SCREEN    #
  ITEM TERNUMLNES U(13,00,60) = [0]; # NUMBER OF LINES ON SCREEN      #
  ITEM TERCURVORD I(14,00,60);       # CURRENT VIDEO ATTR. ORDINAL    #
  END
*IF DEF,QTRM
CONTROL EJECT;
 
DEF FDASIZE     #17#;                # FIELD DATA AREA - QTRM SWAP #
DEF PLTSIZE     #22#;                # PANEL LOAD TABLE - QTRM SWAP #
DEF Q$HEADLEN   #3#;                 # QTRM QUEUE HEADER LENGTH #
DEF Q$BLKSIZE   #1000#;              # QTRM BUFFER LENGTH #
DEF SFORMOFFSET #00#;                # PANEL CONTROL TABLE OFFSET #
DEF SFORMSIZE   #15#;                # SFORM VARIABLES - QTRM SWAP #
DEF VDTASIZE    #20#;                # VARIABLE DATA - QTRM SWAP   #
DEF VTERMSIZE   #O"336"#;            # VIRTERM VARIABLES - QTRM SWAP #
 
DEF FDAOFFSET   #VTERMOFFSET+VTERMSIZE#;
DEF PCTSIZE     #SFORMSIZE+VTERMSIZE+FDASIZE+PLTSIZE+VDTASIZE #;
DEF PLTOFFSET   #FDAOFFSET+FDASIZE#;
DEF VDTAOFFSET  #PLTOFFSET+PLTSIZE#;
DEF VTERMOFFSET #SFORMOFFSET+SFORMSIZE#;
 
CONTROL EJECT;
 
COMMON COMVDT;                       # VIRTERM COMMON AREA  #
 
BEGIN  # COMVDT #
 
  ARRAY COMVDT$WDS [0:0] P(VTERMSIZE);  # TEMPORARY VIRTERM AREA #
    BEGIN
    ITEM COMVDT$WD0 U(00,00,60);     # WORD ZERO (INTEGER) #
    END
 
END  # COMVDT #
 
ARRAY TERMSTHLD [0:0] P(SFORMSIZE);  # TERMSTAT HOLD AREA #
  BEGIN
  ITEM TERINITHLD U(00,00,60);       # WORD ZERO (INTEGER) #
  END
 
ARRAY VDTSTHLD [0:0] P(VTERMSIZE);   # VIRTERM HOLD AREA (INIT)  #
  BEGIN
  ITEM VDTINITHLD U(00,00,60);       # WORD ZERO (INTEGER) #
  END
*ENDIF
CONTROL EJECT;
 
FUNC NEXTCHAR(FLDIND,INDEX);
 
# TITLE NEXTCHAR - GET NEXT CHARACTER FROM VARDATA. #
 
BEGIN  # NEXTCHAR #
 
#
**    NEXTCHAR - GETS THE NEXT CHARACTER FROM VARDATA.
*
*     THIS FUNCTION RETURNS THE CHARACTER IN POSITION INDEX OF VARIABLE
*     FLDIND IN VARDATA.
*
*     FUNC NEXTCHAR(FLDIND,INDEX)
*
*             FLDIND     = POINTER INTO FIELD LIST FOR VARIABLE.
*             INDEX      = RELATIVE POSITION OF CHARACTER IN VARDATA.
*
*     EXIT    CHARACTER FROM VARDATA.
#
ITEM FLDIND;                         # VARLIST POINTER OF VARIABLE #
ITEM INDEX;                          # RELATIVE POSITION OF CHARACTER #
 
ITEM CHARIND;                        # CHARACTER INDEX IN VARDATA #
ITEM CHARNUM;                        # CHARACTER POSITION IN VARDATA #
ITEM WORDIND;                        # WORD INDEX IN VARDATA #
 
CHARNUM = FLDVDTCORD[FLDIND] + INDEX;
WORDIND = CHARNUM / 5;
CHARIND = CHARNUM - 5*WORDIND;
NEXTCHAR = B&lt;12*CHARIND,12>VDATAU[WORDIND];
 
END  # NEXTCHAR #
CONTROL EJECT;
 
FUNC UPPER(CHARAC);
 
# TITLE UPPER - CONVERT CHARACTER TO UPPER CASE. #
 
BEGIN  # UPPER #
 
#
**    UPPER - CONVERT CHARACTER TO UPPER CASE.
*
*     UPPER CONVERTS LOWER CASE CHARACTERS TO UPPER CASE AND
*     LEAVES UPPER CASE CHARACTERS ALONE.
*
*     PROC UPPER(CHARAC)
*
*     ENTRY   CHARAC     = CHARACTER TO BE CONVERTED.
*
*     EXIT    UPPER CASE CHARACTER.
#
ITEM CHARAC;                         # CHARACTER TO BE CONVERTED #
 
IF CHARAC GQ LOWA AND CHARAC LQ LOWZ THEN
  BEGIN                              # IF LOWER CASE #
  UPPER = CHARAC LXR BLANK;          # CONVERT TO LOWER CASE #
  END
ELSE
  BEGIN                              # IF UPPER CASE #
  UPPER = CHARAC;                    # DON'T CONVERT #
  END
 
END  # UPPER #
CONTROL EJECT;
 
PROC SFATTR$(NAME,NLENGTH,NOFFSET,NEWORD,OLDORD);
 
# TITLE SFATTR$ - SET FIELD ATTRIBUTES. #
 
BEGIN  # SFATTR$ #
 
#
**    SFATTR$ - SET FIELD ATTRIBUTES.
*
*     THIS PROCEDURE SETS NEW FIELD ATTRIBUTES FOR A VARIABLE FIELD.
*
*     PROC SFATTR$(NAME,NLENGTH,NOFFSET,NEWORD,OLDORD)
*
*     ENTRY   NAME       = NAME OF VARIABLE FIELD TO BE CHANGED.
*             NLENGTH    = LENGTH IN SIX BIT CHARACTERS.
*             NOFFSET    = OFFSET INTO VARIABLE NAME.
*             NEWORD     = NEW ATTRIBUTE ORDINAL.
*
*     EXIT    OLDORD     = OLD ATTRIBUTE ORDINAL.
*                        = - 3 IF ORDINAL NOT LEGAL.
*                        = - 2 IF FIELD NOT FOUND IN PANEL.
*                        = - 1 IF ATTRIBUTE NOT FOUND IN PANEL.
*
*     USES    TERREWFLDS.
#
ITEM NAME       C(11);               # NAME OF VARIABLE FIELD #
ITEM NLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM NOFFSET    I;                   # OFFSET INTO NAME #
ITEM NEWORD     I;                   # REQUESTED ATTRIBUTE ORDINAL #
ITEM OLDORD     I;                   # OLD ATTRIBUTE ORDINAL #
 
ITEM FLDINDEX   I;                   # INDEX INTO FIELD LIST #
ITEM FIELDNAME  C(7);                # FIELD NAME, LEFT JUSTIFIED #
ITEM I          I;                   # LOOP COUNTER #
ARRAY ATTRIBUTES [0:0] P(1);         # HOLDS OLD AND NEW ATTRIBUTES #
  BEGIN
  ITEM ATTFULLONE U(00,00,60);       # FULL WORD #
  ITEM ATTUNUSED  U(00,00,18);       # UNUSED #
  ITEM ATTINDEX   I(00,18,18);       # INDEX INTO ATTRIBUTE LIST #
  ITEM ATTNEWMASK U(00,36,12);       # TWELVE BIT ATTRIBUTE MASK #
  ITEM ATTNEWLOGI B(00,36,01);       # LOGICAL OR PHYSICAL ATTRIBUTE #
  ITEM ATTNEWPROT B(00,37,01);       # PROTECT #
  ITEM ATTNEWGARD B(00,38,01);       # GUARD MODE #
  ITEM ATTNEWLORD U(00,42,06);       # LOGICAL ORDINAL #
  ITEM ATTOLDMASK U(00,48,12);       # TWELVE BIT ATTRIBUTE MASK #
  ITEM ATTOLDLOGI B(00,48,01);       # LOGICAL OR PHYSICAL ATTRIBUTE #
  ITEM ATTOLDPROT B(00,49,01);       # PROTECT #
  ITEM ATTOLDGARD B(00,50,01);       # GUARD MODE #
  ITEM ATTOLDLORD U(00,54,06);       # LOGICAL ORDINAL #
  END
ARRAY ATTMORDNLS [0:35] P(1);        # ATTRIBUTE MASK BY ORDINAL #
  BEGIN
  ITEM ATTMASKORD U(00,00,60) = [
  O"6000", O"5000", O"4000", O"6001", O"5001",  #  0  1  2  3  4 #
  O"4001", O"6002", O"5002", O"4002", O"6003",  #  5  6  7  8  9 #
  O"5003", O"4003", O"6004", O"5004", O"4004",  # 10 11 12 13 14 #
  O"6005", O"5005", O"4005", O"6006", O"5006",  # 15 16 17 18 19 #
  O"4006", O"6007", O"5007", O"4007", O"6010",  # 20 21 22 23 24 #
  O"5010", O"4010", O"6011", O"5011", O"4011",  # 25 26 27 28 29 #
  O"6012", O"5012", O"4012", O"6013", O"5013",  # 30 31 32 33 34 #
  O"4013"];                                     # 35             #
  END
 
IF NLENGTH LS 1 THEN NLENGTH = 7;    # CRACK PARAMETER #
FIELDNAME = C&lt;NOFFSET,NLENGTH>NAME;
 
OLDORD = - 3;                        # PRESET ORDINAL NOT LEGAL #
IF NEWORD LS 0 OR NEWORD GQ 36 THEN RETURN;
 
OLDORD = - 2;                        # PRESET FIELD NOT FOUND #
ATTFULLONE[0] = 0;                   # CLEAR WORD #
 
FLDINDEX = -1;
FOR I = 0 STEP 1 WHILE VAR2TYPE[I] NQ 0 AND FLDINDEX EQ - 1 DO
  BEGIN                              # LOOK FOR VARIABLE VARNAME #
  IF VAR2NME[I] EQ FIELDNAME THEN
    BEGIN                            # FOUND SPECIFIED VARIABLE #
    FLDINDEX = I;
    END
  END
 
IF FLDINDEX NQ -1 THEN
  BEGIN                              # IF FIELD FOUND IN VAR2LIST #
  IF VAR2ARRORD[FLDINDEX] NQ 0 THEN
    BEGIN                            # IF ARRAY MEMBER #
    FLDINDEX = FLDINDEX +            # FIND THAT FIELD #
     ARR2NUMVAR[VAR2ARRORD[FLDINDEX]-1] *
     ARR2CURROW[VAR2ARRORD[FLDINDEX]-1];
    END
  FLDINDEX = VAR2FLDNUM[FLDINDEX] - 1;
  ATTNEWMASK[0] = ATTMASKORD[NEWORD];
  ATTOLDMASK[0] = ATT2MASK[FLD2ATTORD[FLDINDEX]];
  IF PAN2STRARR NQ 0 THEN
    BEGIN                            # IF TABLE(S) IN PANEL #
    OLDORD = PAN2STRARR[0] - PAN2STRATT[0];
    END
  ELSE
    BEGIN                            # NO TABLES #
    IF PAN2STRBOX NQ 0 THEN
      BEGIN                          # IF BOXES #
      OLDORD = PAN2STRBOX[0] - PAN2STRATT[0];
      END
    ELSE
      BEGIN                          # NO BOXES OR TABLES #
      OLDORD = (PAN2RECLEN[0] - PAN2STRATT[0]) - 1;
      END
    END
  ATTINDEX[0] = 0;                   # SEARCH ATTRIBUTE LIST IN PANEL #
  WHYLE ATT2MASK[ATTINDEX[0]] NQ ATTNEWMASK[0] AND
    ATTINDEX[0] LS OLDORD DO
    BEGIN                            # UNTIL END OF PANEL ATTRIBUTES #
    ATTINDEX[0] = ATTINDEX[0] + 1;
    END
  IF ATTINDEX[0] LS OLDORD THEN
    BEGIN                            # IF NEW ATTRIBUTE IS IN PANEL #
    OLDORD = - 1;                    # PRESET BAD OLD ATTRIBUTE #
    IF ATTOLDLOGI[0] THEN
      BEGIN                          # IF OLD ATTRIBUTE WAS LOGICAL #
      OLDORD = 0;                    # SEARCH ATTMORDNLS LIST #
      WHYLE ATTOLDMASK[0] NQ ATTMASKORD[OLDORD] AND OLDORD LS 36 DO
        BEGIN                        # UNTIL END OF ATTMORDNLS #
        OLDORD = OLDORD + 1;
        END
      IF OLDORD GQ 36 THEN OLDORD = - 1;
      END
    ELSE
      BEGIN                          # PHYSICAL ATTRIBUTES #
      IF ATTOLDPROT[0] THEN
        BEGIN                        # IF OUTPUT ONLY #
        ATTINDEX[0] = 2;
        OLDORD = 3;
        END
      ELSE
        BEGIN                        # NOT OUTPUT ONLY #
        IF NOT ATTOLDGARD[0] THEN
          BEGIN                      # IF INPUT OUTPUT #
          ATTINDEX[0] = 1;
          OLDORD = 2;
          END
        END
      END
    IF OLDORD GQ 0 THEN
      BEGIN                          # IF CHANGE IS INDEED POSSIBLE #
      FLD2ATTORD[FLDINDEX] = ATTINDEX[0];
      TERREWFLDS[0] = TRUE;          # SIGNAL FIELD REWRITE #
      FLD2VALID[FLDINDEX] = FALSE;   # RESET FIELD STATUS-S #
      FLD2REWRIT[FLDINDEX] = TRUE;
      FLD2ENTERE[FLDINDEX] = FALSE;
      IF ATTNEWGARD[0] THEN
        BEGIN                        # IF NEW MASK SHOWS GUARD #
        FLD2INPUTV[FLDINDEX] = TRUE;
        FLD2OUTPUT[FLDINDEX] = FALSE;
        END
      ELSE
        BEGIN                        # NO GUARD #
        IF ATTNEWPROT[0] THEN
          BEGIN                      # IF NEW MASK SHOWS PROTECT #
          FLD2INPUTV[FLDINDEX] = FALSE;
          FLD2OUTPUT[FLDINDEX] = TRUE;
          END
        ELSE
          BEGIN                      # NO GUARD OR PROTECT #
          FLD2INPUTV[FLDINDEX] = TRUE;
          FLD2OUTPUT[FLDINDEX] = TRUE;
          END
        END
      END
    END
  ELSE
    BEGIN                            # NEW ATTRIBUTE NOT IN PANEL #
    OLDORD = - 1;                    # CHANGE NOT POSSIBLE #
    END
  END
 
END  # SFATTR$ #
CONTROL EJECT;
 
PROC SFCLOS$(NAME,NLENGTH,NOFFSET,MODEFLAG);
 
# TITLE SFCLOS$ - CLOSE PANEL. #
 
BEGIN  # SFCLOS$ #
 
#
**    SFCLOS$ - CLOSE PANEL.
*
*     THIS PROCEDURE CLOSES THE SPECIFIED PANEL (UNLOADING IT USING
*     THE FAST DYNAMIC LOADER IF IT IS NOT A STATICALLY LOADED PANEL)
*     AND UPDATES THE PANEL LOAD TABLE TO REFLECT THE UNLOAD.  IN ADD-
*     ITION IF THE MODEFLAG IS SET TO ONE THE TERMINAL WILL BE RESET
*     TO LINE MODE AND THE SCREEN CLEARED, IF THE MODEFLAG IS SET TO
*     TWO THE TERMINAL WILL BE RESET TO LINE MODE WITH NO CHANGE TO
*     THE DATA ON THE SCREEN.
*
*     PROC SFCLOS$(NAME,NLENGTH,NOFFSET,MODEFLAG)
*
*     ENTRY   NAME       = NAME OF PANEL TO BE CLOSED.
*             NLENGTH    = LENGTH IN SIX BIT CHARACTERS.
*             NOFFSET    = OFFSET INTO NAME.
*             MODEFLAG   = 0, REMAIN IN SCREEN MODE.
*                          1, RESET TERMINAL TO LINE MODE,
*                             CLEAR SCREEN.
*                          2, RESET TERMINAL TO LINE MODE.
*
*     EXIT    PANEL UNLOADED IF POSSIBLE, PLT UPDATED, TERMINAL
*             SET TO LINE MODE IF MODEFLAG IS NON ZERO, SCREEN
*             CLEARED IF MODEFLAG EQUAL TO ONE.
*
*     CALLS   ERRMSG, UCP, VDTBOO, VDTCLO, VDTCLS, VDTMSG$, VDTPOS,
*             VDTSTM.
*
*     USES    TERACTIVEP, TERACTPANI, TERCNWRIOV, TERREADFLG,
*             TERMESREAD, TERMESWRIT, TERSCREENM, TERSHOWFLG.
#
ITEM NAME       C(11);               # NAME OF PANEL TO CLOSE #
ITEM NLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM NOFFSET    I;                   # OFFSET INTO NAME #
ITEM MODEFLAG   I;                   # FLUSH OUTPUT/CLEAR SCREEN FLAG #
 
ITEM BLANKNAME  C(7) = "       ";    # BLANK PANEL NAME #
ITEM FATAL      B = FALSE;           # NOT A FATAL ERROR #
ITEM LINE       I = 0;               # INDICATES LINE MODE TO VDT #
ITEM MSG        C(25);               # DAYFILE ERROR MESSAGE #
ITEM MSGB       I = 0;               # BLANK B DISPLAY #
ITEM NAMEINDEX  I;                   # INDEX OF PANEL IF FOUND #
ITEM NUMBER     I;                   # ON SCREEN SEQUENCE NUMBER #
ITEM PANELADDR  I;                   # MEMORY ADDRESS OF PANEL #
ITEM PANELNAME  C(7);                # PANEL NAME, LEFT JUSTIFIED #
ITEM PLTCOUNT   I;                   # COUNTER TO MOVE UP ENTRIES #
ITEM PLTINDEX   I;                   # INDEX INTO PANEL LOAD TABLE #
ITEM PNAME      C(6) = "SFCLOS";     # PROCEDURE NAME #
ITEM RECALL     I = 1;               # RECALL PARAMTER FOR VDTCLO #
ITEM UNLOADSTAT I;                   # UNLOAD STATUS FROM F.D.L. #
 
IF NLENGTH LS 1 THEN NLENGTH = 7;    # CRACK PARAMETER #
PANELNAME = C&lt;NOFFSET,NLENGTH>NAME;  # LEFT JUSTIFY PANEL NAME #
 
*IF UNDEF,QTRM
P&lt;PLTABLE> = LOC(PLT);               # REFERENCE PANEL LOAD TABLE #
*ELSE
P&lt;PLTABLE> = NIT$PCT[NIT$CON] + PLTOFFSET;  # REFERENCE USER PLT #
 
SFCLOS1:
 
*ENDIF
PANELADDR = 0;
 
FOR PLTINDEX = 1 STEP 1 WHILE
  PANELADDR EQ 0 AND PLTINDEX LQ PLTNUMENT[0] DO
  BEGIN                              # CHECK FOR PANEL NAME IN TABLE #
  IF PLTENAME[PLTINDEX] EQ PANELNAME THEN
    BEGIN                            # IF PANEL NAME FOUND #
    PANELADDR = PLTADDR[PLTINDEX];   # SAVE ADDRESS OF PANEL RECORD #
    NAMEINDEX = PLTINDEX;            # SAVE INDEX INTO PLT #
    END
  END
 
IF PANELADDR NQ 0 THEN
  BEGIN                              # IF PANEL NAME IN TABLE #
*IF DEF,QTRM
  IF P&lt;PLTABLE> NQ LOC(PLT) THEN
    BEGIN                            # IF NOT GLOBAL PLT #
    NUMBER = PLTENTRYNM[NAMEINDEX];
    FOR PLTCOUNT = NAMEINDEX STEP 1 UNTIL PLTNUMENT[0] DO
      BEGIN                          # MOVE ENTRIES UP #
      PLTWORDONE[PLTCOUNT] = PLTWORDONE[PLTCOUNT+1];
      PLTWORDTWO[PLTCOUNT] = PLTWORDTWO[PLTCOUNT+1];
      END
    PLTWORDONE[PLTNUMENT[0]] = 0;    # CLEAR LAST ENTRY #
    PLTWORDTWO[PLTNUMENT[0]] = 0;
    PLTNUMENT[0] = PLTNUMENT[0] - 1;
    IF NUMBER NQ 0 THEN
      BEGIN                          # IF PANEL WAS ON SCREEN #
      FOR PLTCOUNT = 1 STEP 1 UNTIL PLTNUMENT[0] DO
        BEGIN                        # UPDATE SEQUENCE NUMBERS #
        IF PLTENTRYNM[PLTCOUNT] GR NUMBER THEN
          BEGIN
          PLTENTRYNM[PLTCOUNT] = PLTENTRYNM[PLTCOUNT] -1;
          END
        END
      PLTNUMONSC[0] = PLTNUMONSC[0] - 1;
      END
    P&lt;PLTABLE> = LOC(PLT);           # RESET FOR GLOBAL PLT #
    GOTO  SFCLOS1;                   # CONTINUE #
    END
                                     # DECREMENT COUNT IN GLOBAL PLT #
  PLTNUMQTRM[NAMEINDEX] = PLTNUMQTRM[NAMEINDEX] - 1;
 
*ENDIF
  NUMBER = PLTENTRYNM[NAMEINDEX];
  IF PANELNAME EQ TERACTPANL[0] THEN
    BEGIN                            # IF CLOSING ACTIVE PANEL #
    TERACTPANL[0] = BLANKNAME;
    TERACTPLTI[0] = 0;
    END
*IF UNDEF,QTRM
  IF NOT PLTSLFLAG[NAMEINDEX] THEN
*ELSE
  IF NOT PLTSLFLAG[NAMEINDEX] AND PLTNUMQTRM[NAMEINDEX] EQ 0 THEN
*ENDIF
    BEGIN                            # UNLOAD DYNAMIC PANEL #
    UCP(PANELNAME,PANELADDR,UNLOADSTAT);
    IF UNLOADSTAT NQ 0 THEN
      BEGIN                          # ISSUE DAYFILE MESSAGE #
      MSG = " NOT UNLOADED.           ";
      ERRMSG(PANELNAME,PNAME,MSG,FATAL);
      END
    FOR PLTCOUNT = NAMEINDEX STEP 1 UNTIL PLTNUMENT[0] DO
      BEGIN                          # MOVE REMAINING ENTRIES UP ONE #
      PLTWORDONE[PLTCOUNT] = PLTWORDONE[PLTCOUNT+1];
      PLTWORDTWO[PLTCOUNT] = PLTWORDTWO[PLTCOUNT+1];
      END
    PLTWORDONE[PLTNUMENT[0]] = 0;    # CLEAR LAST ENTRY IN TABLE #
    PLTWORDTWO[PLTNUMENT[0]] = 0;
    PLTNUMENT[0] = PLTNUMENT[0] - 1; # UPDATE NUMBER OF ENTRIES #
    END
  ELSE
    BEGIN                            # CHECK STATUS OF STATIC PANEL #
    IF PLTOPENFLG[NAMEINDEX] THEN
      BEGIN                          # IF STATIC PANEL IS OPEN #
      PLTOPENFLG[NAMEINDEX] = FALSE; # CLOSE STATIC PANEL #
      PLTENTRYNM[NAMEINDEX] = 0;     # CLEAR SEQUENCE NUMBER #
      END
    ELSE
      BEGIN                          # IF STATIC PANEL ALREADY CLOSED #
      MSG = " ALREADY CLOSED.         ";
      ERRMSG(PANELNAME,PNAME,MSG,FATAL);
      END
    END
  IF NUMBER NQ 0 THEN
    BEGIN                            # IF PANEL WAS ON SCREEN #
    FOR PLTCOUNT = 1 STEP 1 UNTIL PLTNUMENT[0] DO
      BEGIN                          # UPDATE SEQUENCE NUMBERS #
      IF PLTENTRYNM[PLTCOUNT] GR NUMBER THEN
        BEGIN
        PLTENTRYNM[PLTCOUNT] = PLTENTRYNM[PLTCOUNT] - 1;
        END
      END
    PLTNUMONSC[0] = PLTNUMONSC[0] - 1;
    END
  END
ELSE
  BEGIN                              # IF PANEL NAME NOT IN TABLE #
  MSG = " NOT IN PLT.             ";
  ERRMSG(PANELNAME,PNAME,MSG,FATAL);
  END
IF MODEFLAG NQ 0 THEN
  BEGIN
  IF TERSCREENM[0] THEN
    BEGIN                            # IF REVERSION TO LINE MODE #
    TERSCREENM[0] = FALSE;           # CLEAR FLAGS #
    IF NOT TERVDTBOOC[0] THEN
      BEGIN                          # IF BEGIN OUTPUT NEEDED #
      TERVDTBOOC[0] = TRUE;
      VDTBOO;
      END
    IF MODEFLAG EQ 1 THEN
      BEGIN                          # IF SCREEN IS TO BE CLEARED #
      VDTCLS;                        # CLEAR SCREEN #
      END
    ELSE
      BEGIN                          # POSITION CURSOR TO LAST LINE #
      VDTPOS(0,TERNUMLNES[0]);
      END
    FOR PLTCOUNT = 1 STEP 1 UNTIL PLTNUMENT[0] DO
      BEGIN                          # CLEAR SEQUENCE NUMBERS #
      PLTENTRYNM[PLTCOUNT] = 0;
      END
    PLTNUMONSC[0] = 0;               # NO PANELS ON SCREEN #
    TERMESWRIT[0] = FALSE;
    TERMESREAD[0] = FALSE;
    VDTSTM(LINE,DUMMY);              # SET LINE MODE #
*IF UNDEF,QTRM
    VDTCLO(RECALL);                  # FLUSH OUTPUT WITH RECALL #
    IF TERBLCKMDE[0] THEN TERVDTBOOC[0] = FALSE;
*ENDIF
    END
  TERACTPANL[0] = "       ";         # CLEAR ACTIVE PANEL NAME #
  TERACTPLTI[0] = 0;                 # CLEAR PLT INDEX #
  TERCNWRIOV[0] = FALSE;             # DO NOT ALLOW OVERLAY WRITE #
  VDTMSG$(MSGB,1,1);                 # BLANK B DISPLAY MESSAGE #
  TERSHOWFLG[0] = FALSE;
  TERREADFLG[0] = FALSE;
  END
 
END  # SFCLOS$ #
CONTROL EJECT;
 
PROC SFCSET$(CSET,CLENGTH,COFFSET);
 
# TITLE SFCSET$ - SET CHARACTER SET. #
 
BEGIN  # SFCSET$ #
 
#
**    SFCSET$ - SET CHARACTER SET.
*
*     THIS PROCEDURE SETS AND CLEARS THE GLOBAL FLAGS THAT INDICATE
*     WHAT CHARACTER SET IS IN USE BY THE APPLICATION CALLING THE
*     SCREEN FORMATTING OBJECT ROUTINES.  IT INTERFACES TO COBOL AND
*     FORTRAN APPLICATION PROGRAMS THROUGH A COMPASS INTERFACE MOD-
*     ULE CALLED SFCSET.
*
*     PROC SFCSET$(CSET,CLENGTH,COFFSET)
*
*     ENTRY   CSET       = "DISPLAY", "ASCII", OR "ASCII8",
*                          IN DISPLAY CODE.
*             CLENGTH    = LENGTH IN SIX BIT CHARACTERS IN CHARSET.
*             COFFSET    = OFFSET INTO CHARSET.
*
*     EXIT    CORRECT CHARACTER SET FLAG SET, OTHERS CLEARED.
*
*     USES    TERASCFLAG, TERAS8FLAG.
*
*     NOTES   IF SFCSET$ IS CALLED WITH AN UNRECOGNIZABLE
*             CHARACTER SET THEN THE DEFAULT CHARACTER SET
*             (DISPLAY) WILL BE SET AND ALL OTHERS CLEARED.
*             SFCSET$ ACCEPTS ONLY BLANK FILLED DISPLAY CODE
*             STRINGS FOR THE CHARACTER SET.
#
ITEM CSET       C(11);               # CHAR. SET NAME IN DISPLAY CODE #
ITEM CLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM COFFSET    I;                   # OFFSET INTO CSET #
 
ITEM ASCII      C(7) = "ASCII  ";    # ASCII (IN DISPLAY CODE ) #
ITEM ASCII8     C(7) = "ASCII8 ";    # ASCII8 (IN DISPLAY CODE) #
ITEM SET        C(7);                # CHARACTER SET, LEFT JUSTIFIED #
 
IF CLENGTH LS 1 THEN CLENGTH = 7;    # CRACK PARAMETER #
SET = C&lt;COFFSET,CLENGTH>CSET;
 
IF SET EQ ASCII THEN
  BEGIN                              # IF SIX TWELVE ASCII #
  TERASCFLAG[0] = TRUE;
  TERAS8FLAG[0] = FALSE;
  END
ELSE
  BEGIN
  IF SET EQ ASCII8 THEN
    BEGIN                            # IF TWELVE BIT ASCII #
    TERASCFLAG[0] = FALSE;
    TERAS8FLAG[0] = TRUE;
    END
  ELSE
    BEGIN                            # SET DISPLAY CODE #
    TERASCFLAG[0] = FALSE;
    TERAS8FLAG[0] = FALSE;
    END
  END
 
END  # SFCSET$ #
CONTROL EJECT;
 
PROC SFGETF$(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,STAT);
  BEGIN
#
**        SFGETF$ - GET FIELD CHARACTER STRING.
*
*         SFGETF$ TRANSFERS CHARACTERS FROM A SPECIFIED PANEL FIELD TO
*         A SPECIFIED STRING, USING *MOVEFLD*.
*
*         PROC SFGETF$(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,STAT)
*
*         ENTRY  VNAME     = VARIABLE NAME OF FIELD.
*                VLEN      = LENGTH OF VARNAME PARAMETER.
*                VOS       = OFFSET OF VARNAME PARAMETER.
*                STRG      = VARIABLE FIELD STRING.
*                SLEN      = LENGTH OF STRING PARAMETER.
*                SOS       = OFFSET OF STRING PARAMETER.
*                CSET      = CHARACTER SET OF STRING (SEE SFCSET$).
*                CLEN      = LENGTH OF CSET PARAMETER.
*                COS       = OFFSET OF CSET PARAMETER.
*
*         EXIT   STAT     GQ 0, NUMBER OF 6 BIT CHARACTERS MOVED.
*                         LS 0, VARIABLE NOT FOUND IN ACTIVE PANELS.
*
*         CALLS  MOVEFLD.
#
 
  ITEM VNAME      I;                 # VARIABLE NAME #
  ITEM VLEN       I;                 # LENGTH OF VARNAME PARAMETER #
  ITEM VOS        I;                 # OFFSET INTO VARNAME PARAMETER #
  ITEM STRG       I;                 # INSTRING PARAMETER #
  ITEM SLEN       I;                 # LENGTH OF INSTRING #
  ITEM SOS        I;                 # OFFSET INTO INSTRING #
  ITEM CSET       I;                 # CHARACTER SET #
  ITEM CLEN       I;                 # LENGTH OF CHARACTER SET #
  ITEM COS        I;                 # OFFSET INTO CHARACTER SET #
  ITEM STAT       I;                 # STATUS FIELD #
 
 
  STAT = 0;
  MOVEFLD(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,STAT);
  RETURN;
 
END  # SFGETF$#
*IF DEF,QTRM
CONTROL EJECT;
 
PROC SFDQUE$(QNAME,QLEN,QOFF,BUFFER,RC,LENGTH);
 
# TITLE SFDQUE$ - DEQUEUE A PIECE OF DATA FOR THIS TERMINAL. #
 
BEGIN  # SFDQUE$ #
 
#
**    SFDQUE$ - DEQUEUE A PIECE OF DATA FOR THIS TERMINAL.
*
*     THIS PROCEDURE REMOVES *LENGTH* CHARACTERS FROM THE SPECIFIED
*     QUEUE AND PLACES THE CHARACTERS INTO *BUFFER*.  IT INTERFACES
*     TO COBOL5 AND FTN5 APPLICATION PROGRAMS THROUGH A COMPASS
*     INTERFACE CALLED SFDQUE.
*
*     PROC SFDQUE$(QNAME,QLEN,QOFF,BUFFER,RC,LENGTH)
*
*     ENTRY   QNAME      = QUEUE TO PLACE DATA INTO (GET OR PUT).
*             QLEN       = LENGTH OF QUEUE NAME.
*             QOFF       = OFFSET OF QUEUE NAME.
*             LENGTH     = BUFFER SIZE IN 12 BIT CHARACTERS.
*
*     EXIT    NIT$CTLC   = COUNT OF CHARACTERS DEQUEUED.
*             RC         = 0, IF DATA DEQUEUED (NO ERROR).
*                          1, IF MORE DATA AVAILABLE.
*                          2, IF NO MESSAGES IN THE QUEUE.
*             BUFFER     = DEQUEUED DATA.
*
*     CALLS   CMMFRF.
#
ITEM QNAME      C(7);                # QUEUE NAME #
ITEM QLEN       I;                   # QUEUE NAME LENGTH #
ITEM QOFF       I;                   # QUEUE NAME OFFSET #
ARRAY BUFFER [0:0] P(1);             # BUFFER #
  BEGIN
  ITEM B$WD0      U(00,00,60);       # BUFFER WORD (INTEGER) #
  END
ITEM RC         I;                   # RETURN CODE #
ITEM LENGTH     I;                   # BUFFER SIZE IN CHARACTERS #
 
ITEM BIT        I;                   # BIT POSITION #
ITEM B$CURBIT   I;                   # CURRENT BIT #
ITEM B$CURWORD  I;                   # CURRENT WORD #
ITEM I          I;                   # LOOP VARIABLE #
ITEM J          I;                   # LOOP VARIABLE #
ITEM MAX$CHARS  I;                   # MAXIMUM NUMBER OF CHARACTERS #
ITEM QUEUENAME  C(7);                # QUEUE NAME #
ITEM RCC        I;                   # RETURN CODE #
ITEM WORD       I;                   # BUFFER WORD #
 
B$CURBIT = 0;                        # POSITION TO START OF BUFFER #
B$CURWORD = 0;
P&lt;Q$HEADER> = CHAIN;
 
IF QLEN LS 1 THEN QLEN = 7;          # CRACK PARAMETER #
QUEUENAME = C&lt;QOFF,QLEN>QNAME;
 
WHYLE P&lt;Q$HEADER> NQ 0 DO
  BEGIN                              # SEARCH FOR QUEUE FOR THIS ACN #
  IF (( NIT$CON EQ Q$ACN ) AND
      ( C&lt;0,3>QNAME EQ C&lt;0,3>Q$NAME )) THEN
  IF NIT$CON EQ Q$ACN AND QUEUENAME EQ Q$NAME THEN
    BEGIN                            # IF QUEUE IS FOUND #
    P&lt;Q$BUFFER> = P&lt;Q$HEADER> + Q$HEADLEN;
    FOR I = 1 STEP 1 UNTIL LENGTH DO
      BEGIN                          # MOVE THIS USER-S DATA #
      WORD = Q$OUTCHAR / 5;
      BIT = (Q$OUTCHAR - (WORD * 5)) * 12;
      B&lt;B$CURBIT,12> B$WD0[B$CURWORD] = B&lt;BIT,12>Q$WORD[WORD];
      Q$OUTCHAR = Q$OUTCHAR + 1;
      B$CURBIT = B$CURBIT + 12;
      IF B$CURBIT GQ 60 THEN
        BEGIN                        # IF COMPLETE WORD MOVED #
        B$CURBIT = 0;
        B$CURWORD = B$CURWORD + 1;
        END
 
      IF Q$OUTCHAR GR Q$INCHAR THEN
        BEGIN                        # IF #
        NIT$CTLC = I - 1;
        RC = 0;
        Q$INCHAR = 0;
        Q$OUTCHAR = 0;
        RCC = P&lt;Q$HEADER>;           # ADDRESS FOR CMM #
        I = Q$BACK;                  # BACK POINTER #
        J = Q$FORWARD;               # FORWARD POINTER #
        P&lt;Q$HEADER> = I;             # SET TO PREVIOUS PTR WORD #
        Q$FORWARD = J;               # AND SET TO NEXT PTR WORD #
        IF J NQ 0 THEN
          BEGIN                      # IF NEXT PTR WORD EXISTS #
          P&lt;Q$HEADER> = J;           # SET PTR TO PREVIOUS PTR WORD #
          Q$BACK = I;
          END
        CMMFRF (RCC);                # RELEASE BUFFER #
        RETURN;                      # RETURN #
        END
      END
 
    RC = 1;                          # USER-S BUFFER IS FULL #
    NIT$CTLC = LENGTH;
    RETURN;                          # RETURN #
    END
  P&lt;Q$HEADER> = Q$FORWARD;
  END
 
RC = 2;                              # NOTHING TO DEQUEUE #
 
END  # SFDQUE$ #
*ENDIF
CONTROL EJECT;
 
PROC SFGETI$(VARNAME,VLEN,VOFF,VALUE);
 
# TITLE SFGETI$ - GET INTEGER VALUE. #
 
BEGIN  # SFGETI$ #
 
#
**    SFGETI$ - GET INTEGER VALUE.
*
*     SFGETI$ RETURNS THE INTEGER NUMERIC VALUE OF THE FIELD
*     SPECIFIED BY VARNAME AND ROWNUM.
*
*     PROC SFGETI$(VARNAME,VLEN,VOFF,VALUE)
*
*     ENTRY   VARNAME    = VARIABLE NAME OF FIELD.
*             VLEN       = LENGTH OF VARP.
*             VOFF       = OFFSET OF VARP.
*
*     EXIT    VALUE      = INTEGER VALUE OF SPECIFIED FIELD.
*
*     CALLS   DATEVL, GFIELD, NCHECK.
#
ITEM VARNAME    C(11);               # VARIABLE NAME #
ITEM VLEN       I;                   # LENGTH OF VARNAME PARAMETER #
ITEM VOFF       I;                   # OFFSET INTO VARNAME PARAMETER #
ITEM VALUE      I;                   # VALUE OF INPUT #
 
ITEM ALLBLANK   B;                   # ALL BLANK CHARACTERS IN FIELD #
ITEM CURRENCY   B;                   # TRUE IF DOLLAR SIGN INPUT #
ITEM ERRORVAL   I = 0;               # RETURNED IF ERROR IN FIELD #
ITEM EVALUE     I;                   # EXPONENT VALUE #
ITEM FLDIND     I;                   # FIELD ORDINAL #
ITEM FORMAT     I;                   # FORMAT OF INPUT #
ITEM HOLDVALID  B;                   # SAVE FLDVALID VALUE #
ITEM I          I;                   # LOOP COUNTER #
ITEM IVALUE     I;                   # INTEGER VALUE #
ITEM USEROW     B = FALSE;           # DO NOT USE TERCURSROW #
ITEM VNAME      C(7);                # VARIABLE NAME LEFT JUSTIFIED #
 
IF VLEN LS 1 THEN VLEN = 7;          # CRACK PARAMETER #
VNAME = C&lt;VOFF,VLEN>VARNAME;
 
GFIELD(VNAME,USEROW,FLDIND);         # GET ASSOCIATED FIELD #
IF FLDIND EQ -1 THEN GOTO INTERROR;  # FIELD NOT FOUND #
 
ALLBLANK = TRUE;
FOR I = 0 STEP 1 WHILE ALLBLANK AND I LQ FLDLENGTH[FLDIND] -1 DO
  BEGIN                              # CHECK IF BLANK FIELD #
  IF NEXTCHAR(FLDIND,I) NQ BLANK THEN ALLBLANK = FALSE;
  END
IF ALLBLANK THEN
  BEGIN                              # BLANK FIELD #
  VALUE = 0;
  RETURN;
  END
 
HOLDVALID = FLDVALID[FLDIND];        # SAVE VALID FLAG #
FLDVALID[FLDIND] = TRUE;
IF VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"Y"
  OR VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"M"
  OR VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"D" THEN
  BEGIN                              # DATE FORMAT FIELD #
  FORMAT = VARPICTYPE[FLDVARORD[FLDIND]];  # SET FORMAT TYPE #
  DATEVL(FLDIND,IVALUE);             # GET VALUE #
  END
ELSE
  BEGIN                              # NUMERIC FIELD #
  NCHECK(FLDIND,IVALUE,EVALUE,FORMAT,CURRENCY);
  IF VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"$" THEN
    BEGIN                            # WEIGHT CURRENCY INPUT #
    IF EVALUE EQ 0 THEN IVALUE = IVALUE * 100;
    ELSE IF EVALUE EQ -1 THEN IVALUE = IVALUE * 10;
    END
  ELSE
    BEGIN                            # NOT CURRENCY #
    IF EVALUE LS 0 THEN
      BEGIN                          # TRUNCATE DECIMAL DIGITS #
      FOR I = -1 STEP -1 UNTIL EVALUE DO IVALUE = IVALUE/10;
      END
    ELSE
      BEGIN                          # RAISE TO POWER OF EXPONENT #
      FOR I = 1 STEP 1 UNTIL EVALUE DO IVALUE = IVALUE*10;
      END
    END
  END
 
IF NOT FLDVALID[FLDIND] OR FORMAT EQ FORMTYPE"BAD"THEN
  BEGIN                              # ERRORS IN INPUT #
  GOTO INTERROR;
  END
FLDVALID[FLDIND] = HOLDVALID;        # RESET VALID FLAG #
VALUE = IVALUE;
RETURN;
 
INTERROR:                            # CANNOT RETURN VALUE #
 
  IF FLDIND NQ -1 THEN FLDVALID[FLDIND] = HOLDVALID;
  VALUE = ERRORVAL;
 
END  # SFGETI$ #
CONTROL EJECT;
 
PROC SFGETK(GENERIC,ORDINAL);
 
# TITLE SFGETK - GET FUNCTION KEY. #
 
BEGIN  # SFGETK #
 
#
**    SFGETK - GET FUNCTION KEY.
*
*     SFGETK RETURNS THE ORDINAL OF THE LAST FUNCTION KEY PROCESSED.
*
*     PROC SFGETK(GENERIC,ORDINAL)
*
*     ENTRY   TERFUNCGEN = TRUE IF GENERIC FUNCTION KEY.
*             TERFUNCORD = ORDINAL OF FUNCTION KEY.
*
*     EXIT    GENERIC    = TRUE IF GENERIC FUNCTION KEY.
*             ORDINAL    = ORDINAL OF FUNCTION KEY.
#
ITEM GENERIC    B;                   # GENERIC/APPLICATION KEY FLAG #
ITEM ORDINAL    I;                   # FUNCTION KEY ORDINAL #
 
GENERIC = TERFUNCGEN[0];             # RETURN GENERIC FLAG #
ORDINAL = TERFUNCORD[0];             # RETURN FUNCTION ORDINAL #
 
END  # SFGETK #
CONTROL EJECT;
 
PROC SFGETN$(MODEL,MLEN,MOFF);
 
# TITLE SFGETN$ - GET TERMINAL MODEL NAME. #
 
BEGIN  # SFGETN$ #
 
#
**    SFGETN$ - GET TERMINAL MODEL NAME.
*
*     SFGETN$ RETURNS THE TERMINAL MODEL NAME LEFT JUSTIFIED BLANK
*     FILLED.  IF MODEL NAME IS NOT FOUND, SPACES ARE RETURNED.
*
*     PROC SFGETN$(MODEL,MLEN,MOFF)
*
*     ENTRY   MLEN       = LENGTH OF MODEL NAME FIELD.
*             MOFF       = OFFSET OF MODEL NAME FIELD.
*
*     EXIT    MODEL      = TERMINAL MODEL NAME.
*
*     CALLS   VDTITD.
#
 
BASED ARRAY TEMP [0:0];
  BEGIN
  ITEM STRING     C(00,00,10);       # MODEL NAME TEMPLATE #
  END
ITEM MODEL      C(6);                # TERMINAL MODEL NAME #
ITEM MLEN       I;                   # LENGTH OF MODEL PARAMETER #
ITEM MOFF       I;                   # OFFSET INTO MODEL PARAMETER #
ITEM RETVAL     C(6);                # RETURNED VALUE #
ITEM OFFIND     I;                   # OFFSET INDEX #
ITEM I          I;                   # LOOP INDEX #
 
VDTITD(RETVAL);                      # GET MODEL NAME #
P&lt;TEMP> = LOC(MODEL);
OFFIND = MOFF;
FOR I = 0 STEP 1 UNTIL MLEN - 1 DO
  BEGIN                              # BLANK FILL MODEL NAME #
  IF I GR 6 THEN                     # IF BEYOND POSSIBLE MODEL NAME #
    C&lt;OFFIND,1>STRING = " ";
  ELSE
    IF C&lt;I,1>RETVAL EQ 0 THEN        # IF BEYOND ACTUAL MODEL NAME #
      C&lt;OFFIND,1>STRING = " ";
    ELSE
      C&lt;OFFIND,1>STRING = C&lt;I,1>RETVAL;
  OFFIND = OFFIND + 1;
  IF (OFFIND GR 9) THEN
    BEGIN                            # IF END OF CURRENT WORD #
    OFFIND = 0;
    P&lt;TEMP> = P&lt;TEMP> + 1;
    END
  END
 
END  # SFGETN$ #
CONTROL EJECT;
 
PROC SFGETP$(VARNAME,VLEN,VOFF,OFFSET,ROWNUM);
 
# TITLE SFGETP$ - GET LAST CURSOR POSITION. #
 
BEGIN  # SFGETP$ #
 
#
**    SFGETP$ - GET LAST CURSOR POSITION.
*
*     SFGETP$ RETURNS VALUES THAT DEFINE THE LAST POSITION OF THE
*     SCREEN CURSOR.
*
*     PROC SFGETP$(VARNAME,VLEN,VOFF,OFFSET,ROWNUM)
*
*     ENTRY   VARNAME    = LOCATION OF VARIABLE PARAMETER.
*             VLEN       = LENGTH OF VARNAME.
*             VOFF       = OFFSET OF VARNAME.
*
*     EXIT    VARNAME    = VARIABLE NAME OF FIELD.
*             OFFSET     = OFFSET OF CURSOR IN FIELD.
*             ROWNUM     = ROW NUMBER OF FIELD.
*
*     CALLS   FFIELD.
#
ITEM VARNAME    C(11);               # VARIABLE NAME #
ITEM VLEN       I;                   # LENGTH OF VARNAME PARAMETER #
ITEM VOFF       I;                   # OFFSET INTO VARNAME PARAMETER #
ITEM OFFSET     I;                   # OFFSET INTO FIELD #
ITEM ROWNUM     I;                   # ROW NUMBER IN ARRAY #
 
ITEM FIELD      I;                   # FUNCTION FIELD #
ITEM I          I;                   # LOOP COUNTER #
ITEM OUTSEARCH  B=TRUE;              # INCLUDE OUTPUT ONLY FIELDS #
ITEM VARIND     I;                   # VARIABLE ORDINAL OF FIELD #
 
IF VLEN LS 1 THEN VLEN = 7;          # CRACK PARAMETER #
C&lt;VOFF,VLEN>VARNAME = "       ";
 
ROWNUM = 0;                          # FIND FIELD #
FFIELD(TERFUNCPOS[0],FIELD,OFFSET,OUTSEARCH);
 
IF VALIDFIELD THEN
  BEGIN                              # IF FIELD FOUND #
  OFFSET = OFFSET + 1;
  VARIND = FLDVARORD[FIELD];
  C&lt;VOFF,VLEN>VARNAME = VARNME[VARIND];
  IF VARARRORD[VARIND] NQ 0 THEN
    BEGIN                            # IF ARRAY MEMBER #
    ROWNUM = VARROWNUM[VARIND] + 1;
    END
  END
 
END  # SFGETP$ #
CONTROL EJECT;
 
PROC SFGETR$(VARNAME,VLEN,VOFF,VALUE);
 
# TITLE SFGETR$ - GET REAL VALUE. #
 
BEGIN  # SFGETR$ #
 
#
**    SFGETR$ - GET REAL VALUE.
*
*     SFGETR$ RETURNS THE REAL NUMERIC VALUE OF THE FIELD
*     SPECIFIED BY VARNAME.
*
*     PROC SFGETR$(VARNAME,VLEN,VOFF,VALUE)
*
*     ENTRY   VARNAME    = VARIABLE NAME OF FIELD.
*             VLEN       = LENGTH OF VARNAME.
*             VOFF       = OFFSET OF VARNAME.
*
*     EXIT    VALUE      = REAL VALUE OF SPECIFIED FIELD.
*
*     CALLS   DATEVL, GFIELD, NCHECK.
#
ITEM VARNAME    C(11);               # VARIABLE NAME #
ITEM VLEN       I;                   # LENGTH OF VARNAME PARAMETER #
ITEM VOFF       I;                   # OFFSET INTO VARNAME PARAMETER #
ITEM VALUE      R;                   # VALUE OF INPUT #
 
ITEM ALLBLANK   B;                   # ALL CHARACTERS IN FIELD BLANK #
ITEM CURRENCY   B;                   # TRUE IF DOLLAR SIGN INPUT #
ITEM ERRORVAL   R = 0;               # RETURNED IF ERROR IN FIELD #
ITEM EVALUE     I;                   # EXPONENT VALUE #
ITEM FLDIND     I;                   # FIELD ORDINAL #
ITEM FORMAT     I;                   # FORMAT OF INPUT #
ITEM FPSTAT     I;                   # GFP OVERFLOW STATUS #
ITEM HOLDVALID  B;                   # HOLD FLDVALID VALUE #
ITEM I          I;                   # LOOP COUNTER #
ITEM IVALUE     I;                   # INTEGER VALUE #
ITEM USEROW     B = FALSE;           # DO NOT USE TERCURSROW #
ITEM VNAME      C(7);                # VARIABLE NAME LEFT JUSTIFIED #
 
IF VLEN LS 1 THEN VLEN = 7;          # CRACK PARAMETER #
VNAME = C&lt;VOFF,VLEN>VARNAME;
 
GFIELD(VNAME,USEROW,FLDIND);         # GET ASSOCIATED FIELD #
IF FLDIND EQ -1 THEN GOTO REALERROR;  # FIELD NOT FOUND #
 
ALLBLANK = TRUE;
FOR I = 0 STEP 1 WHILE ALLBLANK AND I LQ FLDLENGTH[FLDIND] -1 DO
  BEGIN                              # CHECK IF BLANK FIELD #
  IF NEXTCHAR(FLDIND,I) NQ BLANK THEN ALLBLANK = FALSE;
  END
IF ALLBLANK THEN
  BEGIN                              # BLANK FIELD #
  VALUE = 0;
  RETURN;
  END
 
HOLDVALID = FLDVALID[FLDIND];        # SAVE FLDVALID #
FLDVALID[FLDIND] = TRUE;
 
IF VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"Y"
  OR VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"M"
  OR VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"D" THEN
  BEGIN                              # IF DATE FORMAT #
  DATEVL(FLDIND,IVALUE);             # GET VALUE #
  EVALUE = 0;
  END
ELSE
  BEGIN                              # GET NUMERIC VALUE #
  NCHECK(FLDIND,IVALUE,EVALUE,FORMAT,CURRENCY);
  END
 
IF NOT FLDVALID[FLDIND] OR FORMAT EQ FORMTYPE"BAD"THEN
  BEGIN                              # ERRORS IN INPUT #
  GOTO REALERROR;
  END
FLDVALID[FLDIND] = HOLDVALID;
 
FPSTAT = GFP(IVALUE,EVALUE,VALUE);   # GENERATE REAL VALUE #
IF FPSTAT EQ 0 THEN RETURN;          # IF NO OVERFLOW ERROR #
 
REALERROR:                           # CANNOT RETURN VALUE #
 
  IF FLDIND NQ -1 THEN FLDVALID[FLDIND] = HOLDVALID;
  VALUE = ERRORVAL;
 
END  # SFGETR$ #
*IF DEF,QTRM
CONTROL EJECT;
 
PROC SFMODE$(MODE,MODEL,MLEN,MOFF);
 
# TITLE SFMODE$ - QTRM MODE SWITCHING FUNCTION. #
 
BEGIN  # SFMODE$ #
 
#
**    SFMODE$ - QTRM MODE SWITCHING FUNCTION.
*
*     THIS PROCEDURE SWITCHES A TERMINAL TO AND FROM SCREEN MODE.  IT
*     INTERFACES TO COBOL5 AND FTN5 APPLICATION PROGRAMS THROUGH A
*     COMPASS INTERFACE CALLED SFMODE.
*
*     PROC SFMODE$(MODE,MODEL,MLEN,MOFF)
*
*     ENTRY   MODE       = 0, IF REQUESTED MODE IS SCREEN.
*                          1, IF REQUESTED MODE IS LINE.
*             MODEL      = TERMINAL MODEL NAME.
*             MLEN       = LENGTH OF MODEL NAME.
*             MOFF       = OFFSET OF MODEL NAME.
*
*     EXIT    THE NIT RETURN CODE FIELD IN THE NIT WILL BE SET TO 0 IF
*             THE REQUEST WAS SUCCESSFUL, NON-ZERO IF NOT.
#
ITEM MODE     I;                     # REQUESTED MODE #
ITEM MODEL    C(7);                  # TERMINAL MODEL (OR 'NONE') #
ITEM MLEN     I;                     # LENGTH OF MODEL NAME #
ITEM MOFF     I;                     # OFFSET OF MODEL NAME #
 
ITEM I        I;                     # SCRATCH VARIABLE #
ITEM MODELNAME  C(7);                # TERMINAL MODEL NAME #
 
IF MLEN LS 1 THEN MLEN = 7;          # CRACK PARAMETER #
MODELNAME = C&lt;MOFF,MLEN>MODEL;
 
IF NIT$STATE[NIT$CON] NQ 2 THEN
  BEGIN                              # IF CMM BLOCKS TO CLEAR UP #
  NIT$RC = NITRTC"OK";
  IF NIT$PCT [NIT$CON] EQ 0 THEN RETURN;
  P&lt;PCT> = NIT$PCT [NIT$CON];
  IF PCT$VRDATA NQ 0 THEN CMMFRF (PCT$VRDATA);
  PCT$VRDATA = 0;                    # INSURE THIS IS DONE ONLY ONCE #
  CMMFRF (NIT$PCT[NIT$CON]);
  NIT$PCT[NIT$CON] = 0;
  RETURN;                            # RETURN #
  END
 
IF NIT$PCT[NIT$CON] EQ 0 THEN
  BEGIN                              # IF CMM BLOCK NEEDED #
  CMMALF (PCTSIZE,0,0,I);            # GET A BLOCK FOR THE PCT #
  NIT$PCT[NIT$CON] = I;
  P&lt;PCT> = I;
  FOR I = 0 STEP 1 UNTIL PCTSIZE - 1 DO
    BEGIN                            # ZERO THE ENTIRE PCT #
    PCT$WD0[I] = 0;
    END
 
  FOR I = 0 STEP 1 UNTIL SFORMSIZE - 1 DO
    BEGIN                            # INITIALIZE TERMSTAT AREA #
    TERMSTATWD[I] = TERINITHLD[I];
    END
  FOR I = 0 STEP 1 UNTIL VTERMSIZE - 1 DO
    BEGIN
    COMVDT$WD0[I] = VDTINITHLD[I];   # INIT VDT AREAS #
    END
 
  TERMODNAME[0] = "       ";
  TERACTPANL[0] = "       ";
  TERACTPLTI[0] = 0;
  TERFUNCPOS[0] = 0;
  TERNUMCOLS[0] = 0;
  TERNUMLNES[0] = 0;
 
  P&lt;PLTABLE> = LOC(PLT);             # INITIALIZE THE NIT PLT AREA #
  I = PLTNUMENT[0];
  P&lt;PLTABLE> = NIT$PCT[NIT$CON] + PLTOFFSET;
  FOR I = 1 STEP 1 UNTIL 10 DO
    BEGIN                            # ZERO PLT WORD #
    PLTWORDONE[I] = 0;
    PLTWORDTWO[I] = 0;
    END
  PLTENTRYNM[0] = 10;
  IF MODELNAME NQ "NONE" THEN        # SET MODEL #
  NIT$TRNAM[NIT$CON] = MODELNAME;
  IF      MODELNAME EQ "NONE   " THEN NIT$MODEL [NIT$CON] = 0;
  ELSE IF MODELNAME EQ "721    " THEN NIT$MODEL [NIT$CON] = 2;
  ELSE                           NIT$MODEL [NIT$CON] = 1;
 
  TERQTRMSOL[0] = MODE NQ 1;         # SAVE SCREEN/LINE MODE #
  END
 
END  # SFMODE$ #
CONTROL EJECT;
 
PROC SFNQUE$(QNAME,QLEN,QOFF,BUFFER,RC);
 
#  TITLE SFNQUE$ - ENQUEUE A BLOCK FOR A TERMINAL (ACN). #
 
BEGIN  # SFNQUE$ #
 
#
**    SFNQUE$ - ENQUEUE A BLOCK FOR A TERMINAL (ACN).
*
*     THIS PROCEDURE ACCUMULATES DATA INTO A QUEUE FOR A SPECIFIED
*     TERMINAL.  VALID QUEUE NAMES ARE *GET* AND *PUT*. A BLOCK OF
*     1600 WORDS IS ALLOCATED FOR EACH QUEUE.  EACH SFNQUE$ CALL ADDS
*     DATA TO THE QUEUE WITH THE SPECIFIED QNAME AND TERMINAL NUMBER.
*     IT INTERFACES TO COBOL5 AND FTN5 APPLICATION PROGRAMS THROUGH
*     A COMPASS INTERFACE CALLED SFNQUE.
*
*     PROC SFNQUE$(QNAME,QLEN,QOFF,BUFFER,RC)
*
*     ENTRY   QNAME      = QUEUE TO PLACE DATA INTO (GET OR PUT).
*             QLEN       = LENGTH OF QUEUE NAME.
*             QOFF       = OFFSET OF QUEUE NAME.
*             BUFFER     = DATA TO ADD TO THE QUEUE.
*             RC         = RETURN CODE.
*             NIT$CTLC   = COUNT (IN 12 BIT CHARACTERS) IN BUFFER.
*
*     EXIT    RC         = 0, IF DATA ENQUEUED (NO ERROR).
*                          1, IF DATA NOT ENQUEUED.
*
*     CALLS   CMMALF.
#
ITEM QNAME      C(7);                # QUEUE TO PLACE DATA #
ITEM QLEN       I;                   # LENGTH OF QUEUE NAME #
ITEM QOFF       I;                   # OFFSET OF QUEUE NAME #
ITEM BUFFER     U;                   # DATA TO ADD TO QUEUE #
ITEM RC         I;                   # RETURN CODE #
 
BASED ARRAY B$BUFF [0:0] P(1);       # BUFFER #
  BEGIN
  ITEM B$WD0      U(00,00,60);       # BUFFER WORD (INTEGER) #
  END
 
ITEM BIT        I;                   # BIT POSITION #
ITEM B$CURBIT   I;                   # CURRENT BIT #
ITEM B$CURWORD  I;                   # CURRENT WORD #
ITEM ENTCT      I = 0;               # QTRM #
ITEM I          I = 0;               # LOOP VARIABLE #
ITEM QUEUENAME  C(7);                # QUEUE TO PLACE DATA #
ITEM RCC        I;                   # RETURN CODE #
ITEM WORD       I;                   # BUFFER WORD #
 
IF QLEN LS 1 THEN QLEN = 7;          # LEFT JUSTIFY QUEUE NAME #
QUEUENAME = C&lt;QOFF,QLEN>QNAME;
 
P&lt;B$BUFF> = LOC(BUFFER);
B$CURBIT = 0;                        # START AT BEGINNING OF BUFFER #
B$CURWORD = 0;
ENTCT = ENTCT + 1;
 
SFNQUE1:
 
  I = 0;
  P&lt;Q$HEADER> = CHAIN;
  WHYLE P&lt;Q$HEADER> NQ 0 DO
    BEGIN                            # FIND QUEUE NAME FOR THIS ACN #
    IF (( NIT$CON EQ Q$ACN ) AND
        ( C&lt;0,3>QNAME EQ C&lt;0,3>Q$NAME )) THEN
    IF NIT$CON EQ Q$ACN AND QUEUENAME EQ Q$NAME THEN
      BEGIN                          # IF FOUND #
      P&lt;Q$BUFFER> = P&lt;Q$HEADER> + Q$HEADLEN;
      FOR I = 1 STEP 1 UNTIL NIT$CTLC DO
        BEGIN                        # ADD DATA TO QUEUE #
        WORD = Q$INCHAR / 5;
        IF WORD GQ Q$SIZE THEN
          BEGIN                      # IF BLOCK OVERFLOW #
          RC = 1;                    # SET ERROR #
          RETURN;                    # RETURN #
          END
        BIT = (Q$INCHAR - (WORD * 5)) * 12;
        B&lt;BIT,12>Q$WORD[WORD] = B&lt;B$CURBIT,12>B$WD0[B$CURWORD];
        Q$INCHAR = Q$INCHAR + 1;
        B$CURBIT = B$CURBIT + 12;
        IF B$CURBIT GQ 60 THEN
          BEGIN                      # IF FULL WORD #
          B$CURBIT = 0;
          B$CURWORD = B$CURWORD + 1;
          END
        END
      RC = 0;                        # CLEAR RETURN CODE #
      RETURN;                        # RETURN #
      END
 
    I = P&lt;Q$HEADER>;                 # QUEUE DOESN-T EXIST, CREATE IT #
    P&lt;Q$HEADER> = Q$FORWARD;         # ADD BLOCK TO END OF CHAIN #
    END
 
  IF CHAIN EQ 0 THEN
    BEGIN                            # IF NO CHAIN HEADER #
    P&lt;Q$HEADER> = LOC(CHAIN);
    END
  ELSE
    BEGIN                            # CHAIN HEADER EXISTS #
    P&lt;Q$HEADER> = I;
    END
 
  CMMALF (Q$BLKSIZE,0,0,RCC);
  Q$FORWARD = RCC;
  I = P&lt;Q$HEADER>;
  P&lt;Q$HEADER> = Q$FORWARD;
  Q$WD0 = 0;                         # CLEAR THE ENTRY HEADER AREA #
  Q$WD1 = 0;
  Q$WD2 = 0;
  Q$BACK = I;                        # SET THE BACKWARD POINTER #
  Q$ACN = NIT$CON;                   # SET THE TERMINAL ACN #
  Q$NAME = QUEUENAME;                # SET QUEUE NAME #
  Q$SIZE = Q$BLKSIZE - Q$HEADLEN;
  Q$CHARSET = NIT$CH$SET;            # DEFAULT IS 12 BIT ASCII #
 
  GOTO SFNQUE1;                      # ADD THE DATA TO THE QUEUE #
 
END  # SFNQUE$ #
*ENDIF
CONTROL EJECT;
 
PROC SFLUSH$;
 
# TITLE SFLUSH$ - FLUSH DATA ALREADY WRITTEN TO SCREEN #
 
BEGIN  # SFLUSH$ #
 
#
**    SFLUSH$ - FLUSH DATA ALREADY WRITTEN TO SCREEN.
*
*     THIS PROCEDURE FORCES DATA WHICH HAS ALREADY BEEN WRITTEN TO THE
*     SCREEN BY MEANS OF *SFSWRI$* TO BE DISPLAYED UPON THE SCREEN, BY
*     WRITING AN *EOR* TO THE SCREEN.  NO PARAMETERS ARE REQUIRED.
*
*     PROC SFLUSH$
*
*     ENTRY   NONE.
*
*     EXIT    PREVIOUSLY WRITTEN PANEL DATA FLUSHED TO SCREEN.
*
*     CALLS   VDTFOS.
*
*     USES    TERVDTBOOC.
*
#
*IF UNDEF,QTRM
ITEM RECALL     I = 1;               # RECALL PARAMETER FOR VDTFOS #
 
IF TERVDTBOOC[0] THEN
  BEGIN                              # IF DATA IN BUFFER TO FLUSH #
  IF NOT TERNOVDTEO[0] THEN VDTEOO;
  TERVDTBOOC[0] = FALSE;
  VDTFOS(RECALL);                    # FLUSH OUTPUT TO SCREEN, RECALL #
  END
*ELSE
 
NIT$RC = NITRTC"OK";                 # SET RETURN CODE #
*ENDIF
 
END  # SFLUSH$ #
CONTROL EJECT;
 
PROC SFOPEN$(NAME,NLENGTH,NOFFSET,OPENSTAT);
 
# TITLE SFOPEN$ - OPEN PANEL. #
 
BEGIN  # SFOPEN$ #
 
#
**    SFOPEN$ - OPEN PANEL.
*
*     THIS PROCEDURE CHECKS (VIA VDTGSL/VDTITD) TO SEE IF THE TERMINAL
*     IN USE IS SUPPORTED UNDER SCREEN FORMATTING (UNLESS THIS HAS
*     ALREADY BEEN DONE BY A PREVIOUS CALL TO SFOPEN.)  IF THE TERM-
*     INAL IS SUPPORTED THEN *SFLOAD* IS CALLED TO LOAD THE PANEL
*     VIA THE FAST DYNAMIC LOADER (EXCEPT FOR THOSE PANELS THAT ARE
*     STATICALLY LOADED AND THUS ALWAYS PRESENT IN MEMORY) AND THE
*     PANEL LOAD TABLE IS UPDATED IF THE LOAD WAS SUCCESSFUL.  THE
*     STATUS OF THE OPEN IS RETURNED TO THE CALLING APPLICATION IN
*     ALL CASES INDICATING THAT THE OPEN WAS SUCCESSFUL OR AN ERROR
*     CODE INDICATING WHY NOT.  SFOPEN$ INTERFACES TO COBOL AND FOR-
*     TRAN PROGRAMS THROUGH A COMPASS INTERFACE MODULE CALLED SFOPEN.
*
*     PROC SFOPEN$(NAME,NLENGTH,NOFFSET,OPENSTAT)
*
*     ENTRY   NAME       = NAME OF PANEL TO BE OPENED.
*             NLENGTH    = LENGTH IN SIX BIT CHARACTERS.
*             NOFFSET    = OFFSET INTO NAME.
*
*     EXIT    PANEL OPENED IF POSSIBLE, OPENSTAT SET REGARDLESS.
*
*IF UNDEF,QTRM
*     CALLS   SETSRN, SFLOAD, VDTITD, VDTGSL.
*ELSE
*     CALLS   SETFSF, SETSRN, SFLOAD, VDTITD.
*ENDIF
*
*     NOTES   OPENSTAT IS SET BY SFOPEN IN SOME CASES AND IS ALSO
*             A PARAMETER ON THE CALL TO SFLOAD IN THOSE INSTANCES
*             WHERE THE FAST DYNAMIC LOADER IS TO BE CALLED.
*
*             OPENSTAT   SIGNIFICANCE                     PROCEDURE
*             .....................................................
*             .   0   .  NO ERROR                        .  BOTH  .
*             .   1   .  UNKNOWN PANEL NAME              . SFLOAD .
*             .   2   .  INCORRECT CAPSULE FORMAT        . SFLOAD .
*             .   3   .  PLT FULL (TOO MANY OPEN PANELS) . SFOPEN .
*             .   4   .  PANEL ALREADY OPEN              . SFOPEN .
*             .   5   .  INTERNAL (FAST DYNAMIC LOADER)  . SFLOAD .
*             .   6   .  NO SCREEN COMMAND ISSUED        . SFOPEN .
*             .   7   .  UNSUPPORTED TERMINAL            . SFOPEN .
*             .....................................................
#
ITEM NAME       C(11);               # NAME OF PANEL TO OPEN #
ITEM NLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM NOFFSET    I;                   # OFFSET INTO NAME #
ITEM OPENSTAT   I;                   # RETURNS STATUS TO APPLICATION #
 
ITEM MODELNAME  C(7);                # MODEL NAME FOR VDTITD CALL #
ITEM NAMEINDEX  I;                   # INDEX OF PANEL IF FOUND #
ITEM PANELADDR  I;                   # MEMORY ADDRESS OF PANEL #
ITEM PANELNAME  C(7);                # PANEL NAME, LEFT JUSTIFIED #
ITEM PLTINDEX   I;                   # INDEX INTO PANEL LOAD TABLE #
ITEM SCREEN     I = 1;               # INDICATES SCREEN MODE TO VDT #
ITEM SCREENDIM  I;                   # SCREEN DIMENSIONS FOR SETSRN #
*IF DEF,QTRM
ITEM QTPLTINDEX I;                   # INDEX INTO QTRM USERS PLT #
*ENDIF
 
OPENSTAT = OPENSTATUS"NOERROR";      # CLEAR OPEN STATUS #
IF TERMODNAME[0] EQ "       " THEN
  BEGIN                              # IF *TDU* TABLE NOT YET READ #
*IF UNDEF,QTRM
  VDTGSL(DUMMY,OPENSTAT);            # CHECK SYSTEM SCREEN/LINE #
*ELSE
  OPENSTAT = NIT$MODEL[NIT$CON];     # GET SCREEN MODE #
  MODELNAME = NIT$TRNAM[NIT$CON];    # GET MODEL NAME #
*ENDIF
  IF OPENSTAT EQ 0 THEN
    BEGIN                            # IF NO MODEL SPECIFIED #
    OPENSTAT = OPENSTATUS"NOSCREEN"; # NONE SPECIFIED #
    END
  ELSE
    BEGIN                            # MODEL SPECIFIED #
    OPENSTAT = OPENSTATUS"NOERROR";  # CLEAR OPEN STATUS #
    VDTITD(MODELNAME);               # INITIALIZE *TDU* TABLE #
    IF C&lt;0,6>MODELNAME EQ "      " THEN
      BEGIN                          # IF TERMINAL UNDEFINED #
      TERMODNAME[0] = "       ";
      OPENSTAT = OPENSTATUS"UNSPTERM";
      END
    ELSE
      BEGIN                          # SUPPORTED TERMINAL #
      TERMODNAME[0] = MODELNAME;
      P&lt;CORE>=0;
      IF COREWORD[CSMR] GQ 0 THEN
        BEGIN                        # IF 63 CHARACTER SET SYSTEM #
        DC2A8[00] = O"0040";         # 00B = UNDEFINED #
        DC2A8[51] = O"0072";         # 63B = COLON #
        A82DC[37] = O"0055";         # PERCENT = UNDEFINED #
        A82DC[58] = O"0063";         # COLON = 63B #
        AS2A8[03] = O"0045";         # 7404B = PERCENT #
        TERASC8ATD[0] = 37;          # PERCENT = 7404B #
        END
      END
    END
  END
 
IF OPENSTAT EQ OPENSTATUS"NOERROR" THEN
  BEGIN                              # IF TERMINAL CAN BE USED #
  IF NOT TERSCREENM[0] THEN
    BEGIN                            # IF NOT IN SCREEN MODE #
    SCREENDIM = 1;                   # ASK FOR SMALLEST SCREEN SIZE #
    SETSRN(SCREENDIM,SCREENDIM);     # SET SCREEN MODE #
    END
  IF NLENGTH LS 1 THEN NLENGTH = 7;  # LEFT JUSTIFY PANEL NAME #
  PANELNAME = C&lt;NOFFSET,NLENGTH>NAME;
*IF DEF,QTRM
 
# CHECK FOR PANEL IN THIS USERS PLT AREA #
 
  P&lt;PLTABLE> = NIT$PCT[NIT$CON] + PLTOFFSET;
  PANELADDR = 0;
  QTPLTINDEX = 0;
  FOR PLTINDEX = 1 STEP 1 WHILE
    PANELADDR EQ 0 AND PLTINDEX LQ PLTNUMENT[0] DO
    BEGIN
    IF PLTENAME[PLTINDEX] EQ PANELNAME THEN
      BEGIN
      PANELADDR = PLTADDR[PLTINDEX];
      NAMEINDEX = PLTINDEX;
      END
    END
  IF PANELADDR EQ 0 THEN
    BEGIN                            # IF NOT IN USER PLT #
    P&lt;PLTABLE> = LOC(PLT);           # CHECK GLOBAL PLT #
    FOR PLTINDEX = 1 STEP 1 WHILE
      PANELADDR EQ 0 AND PLTINDEX LQ PLTNUMENT[0] DO
      BEGIN
      IF PLTENAME[PLTINDEX] EQ PANELNAME THEN
        BEGIN
        PANELADDR = PLTADDR[PLTINDEX];
        NAMEINDEX = PLTINDEX;
        END
      END
    END
  IF PANELADDR NQ 0 THEN
    BEGIN                            # UPDATE USER PLT FROM GLOBAL #
    PLTNUMQTRM[NAMEINDEX] = PLTNUMQTRM[NAMEINDEX] + 1;
    P&lt;PLTABLE> = NIT$PCT[NIT$CON] + PLTOFFSET;
    PLTNUMENT[0] = PLTNUMENT[0] + 1;
    NAMEINDEX = PLTNUMENT[0];
    PLTENAME[NAMEINDEX] = PANELNAME;
    PLTSLFLAG[NAMEINDEX] = FALSE;
    PLTOPENFLG[NAMEINDEX] = TRUE;
    PLTADDR[NAMEINDEX] = PANELADDR;
    SETFSF(PANELADDR);               # SET FIELD STATUS FLAGS #
    RETURN;
    END
*ENDIF
  P&lt;PLTABLE> = LOC(PLT);             # REFERENCE PANEL LOAD TABLE #
  PANELADDR = 0;                     # CHECK FOR PANEL NAME IN TABLE #
  FOR PLTINDEX = 1 STEP 1 WHILE
    PANELADDR EQ 0 AND PLTINDEX LQ PLTNUMENT[0] DO
    BEGIN
    IF PLTENAME[PLTINDEX] EQ PANELNAME THEN
      BEGIN                          # IF PANEL NAME FOUND #
      PANELADDR = PLTADDR[PLTINDEX]; # SET PANEL ADDRESS #
      NAMEINDEX = PLTINDEX;          # SET INDEX INTO PLT #
      END
    END
  IF PANELADDR EQ 0 THEN
    BEGIN                            # IF PANELNAME NOT IN PLT #
    IF PLTNUMENT[0] GQ PLTENTRYNM[0] THEN
      BEGIN                          # IF PANEL LOAD TABLE IS FULL #
      OPENSTAT = OPENSTATUS"PLTFULL";
      END
    ELSE
      BEGIN                          # LOAD VIA FAST DYNAMIC LOADER #
      SFLOAD(PANELNAME,PANELADDR,OPENSTAT);
      IF OPENSTAT EQ 0 THEN
        BEGIN                        # IF LOADED WITHOUT ERROR #
        GETADD(PANELNAME,PANELADDR,NAMEINDEX);
        POSTWO(PANELADDR);           # POSITION SFATTR ARRAYS #
        END
*IF DEF,QTRM
        PLTNUMQTRM[PLTINDEX] = PLTNUMQTRM[PLTINDEX] + 1; # USER COUNT #
        P&lt;PLTABLE> = NIT$PCT[NIT$CON] + PLTOFFSET;
        PLTNUMENT[0] = PLTNUMENT[0] + 1;
        NAMEINDEX = PLTNUMENT[0];
        PLTENAME[NAMEINDEX] = PANELNAME;
        PLTSLFLAG[NAMEINDEX] = FALSE;
        PLTOPENFLG[NAMEINDEX] = TRUE;
        PLTADDR[NAMEINDEX] = PANELADDR;
*ENDIF
      END
    END
  ELSE
    BEGIN                            # IF PANEL ALREADY IN PLT #
    IF PLTOPENFLG[NAMEINDEX] THEN
      BEGIN                          # IF PANEL IS ALREADY OPEN #
      OPENSTAT = OPENSTATUS"PANELOPEN";
      END
    ELSE
      BEGIN                          # OPEN STATICALLY LOADED PANEL #
      PLTOPENFLG[NAMEINDEX] = TRUE;  # SET PANEL OPEN #
*IF DEF,QTRM
        SETFSF(PANELADDR);           # SET FIELD STATUS FLAGS #
*ENDIF
      END
    POSTWO(PANELADDR);               # POSITION SFATTR ARRAYS #
    END
  END
 
END  # SFOPEN$ #
CONTROL EJECT;
 
PROC SFPOSR$(TABLENAME,TLEN,TOFF,ROWNUMBER);
 
# TITLE SFPOSR$ - POSITION TABLE ROW. #
 
BEGIN  # SFPOSR$ #
 
#
**    SFPOSR$ - POSITION TABLE ROW.
*
*     SFPOSR$ POSITIONS TABLENAME TO ROWNUMBER.
*
*     PROC SFPOSR$(TABLENAME,TLEN,TOFF,ROWNUMBER)
*
*     ENTRY   TABLENAME  = TABLE NAME.
*             TLEN       = LENGTH OF TABLENAME.
*             TOFF       = OFFSET OF TABLENAME.
*             ROWNUMBER  = ROW NUMBER.
*
*     EXIT    ARRCURROW[TABLENAME] = ROWNUMBER.
#
ITEM TABLENAME  C(11);               # TABLE NAME #
ITEM TLEN       I;                   # LENGTH OF TABLENAME PARAMETER #
ITEM TOFF       I;                   # OFFSET IN TABLENAME PARAMETER #
ITEM ROWNUMBER  I;                   # ROW NUMBER IN ARRAY #
 
ITEM I          I;                   # LOOP COUNTER #
ITEM NOTFOUND   B;                   # TABLE NOT FOUND #
ITEM TNAME      C(7);                # TABLE NAME LEFT JUSTIFIED #
 
IF PANSTRARR[0] EQ 0 THEN RETURN;    # IF NO TABLES IN PANEL #
 
IF TLEN LS 1 THEN TLEN = 7;          # CRACK PARAMETER #
TNAME = C&lt;TOFF,TLEN>TABLENAME;
 
NOTFOUND = TRUE;
FOR I = 0 STEP 1 WHILE ARRNUMVARS[I] NQ 0 AND NOTFOUND DO
  BEGIN                              # SEARCH ARRAY LIST FOR TABLE #
  IF ARRNAME[I] EQ TNAME THEN
    BEGIN                            # IF TABLE NAME FOUND #
    NOTFOUND = FALSE;
    IF ROWNUMBER LS 1 OR ROWNUMBER GR ARRNUMROWS[I] THEN
      BEGIN                          # IF ILLEGAL ROW NUMBER #
      ARRCURROW[I] = 0;
      END
    ELSE ARRCURROW[I] = ROWNUMBER - 1;
    END
  END
 
END  # SFPOSR$ #
CONTROL EJECT;
 
PROC SFSETF$(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,STAT);
  BEGIN
#
**        SFSETF$ - SET FIELD CHARACTER STRING.
*
*         SFGETF$ TRANSFERS CHARACTERS TO A SPECIFIED PANEL FIELD FROM
*         A SPECIFIED STRING, USING *MOVEFLD*.
*
*         PROC SFGETF$(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,STAT)
*
*         ENTRY  VNAME     = VARIABLE NAME OF FIELD.
*                VLEN      = LENGTH OF VARNAME PARAMETER.
*                VOS       = OFFSET OF VARNAME PARAMETER.
*                STRG      = VARIABLE FIELD STRING.
*                SLEN      = LENGTH OF STRING PARAMETER.
*                SOS       = OFFSET OF STRING PARAMETER.
*                CSET      = CHARACTER SET OF STRING (SEE SFCSET$).
*                CLEN      = LENGTH OF CSET PARAMETER.
*                COS       = OFFSET OF CSET PARAMETER.
*
*         EXIT   STAT     GQ 0, NUMBER OF 6 BIT CHARACTERS MOVED.
*                         LS 0, VARIABLE NOT FOUND IN ACTIVE PANELS.
*
*         CALLS  MOVEFLD.
#
 
  ITEM VNAME      I;                 # VARIABLE NAME #
  ITEM VLEN       I;                 # LENGTH OF VARNAME PARAMETER #
  ITEM VOS        I;                 # OFFSET INTO VARNAME PARAMETER #
  ITEM STRG       I;                 # INSTRING PARAMETER #
  ITEM SLEN       I;                 # LENGTH OF INSTRING #
  ITEM SOS        I;                 # OFFSET INTO INSTRING #
  ITEM CSET       I;                 # CHARACTER SET #
  ITEM CLEN       I;                 # LENGTH OF CHARACTER SET #
  ITEM COS        I;                 # OFFSET INTO CHARACTER SET #
  ITEM STAT       I;                 # STATUS FIELD #
 
 
  STAT = 1;                          # INDICATE *SFSETF* #
  MOVEFLD(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,STAT);
  RETURN;
 
END  # SFSETF$#
*IF DEF,QTRM
CONTROL EJECT;
 
PROC SFQTRM$(NITADDR,BUFFER);
 
# TITLE SFQTRM$ - INTERFACE BETWEEN QTRM AND SFORM #
 
BEGIN  # SFQTRM$ #
 
#
**    SFQTRM$ - INTERFACE BETWEEN QTRM AND SFORM.
*
*     THIS PROCEDURE IS THE INTERFACE BETWEEN QTRM AND SFORM THAT
*     IDENTIFIES THE QTRM NETWORK INFORMATION TABLE, DATA BUFFER,
*     AND CURRENT TERMINAL TO SFORM.  SFQTRM$ INTERFACES TO COBOL
*     AND FORTRAN PROGRAMS THROUGH A COMPASS INTERFACE MODULE
*     CALLED SFQTRM.
*
*     PROC SFQTRM$(NITADDR,BUFFER)
*
*     ENTRY  NITADDR    = ADDRESS OF QTRM USER-S QTRM NETWORK
*                         INFORMATION TABLE.
*            BUFFER     = ADDRESS OF BUFFER FOR THE SCREEN FORMATTING
*                         ROUTINES SFSREA AND SFSWRI TO USE. THE
*
*     EXIT   POINTERS TO BUFFER INITIALIZED.
#
ITEM NITADDR    U;                   # ADDRESS OF THE USERS NIT #
ARRAY BUFFER [0:0] P(1);;            # BUFFER #
 
ITEM CHARIND    I = 0;               # CHAR INDEX FOR FLAG MOVE #
ITEM CURRNT$ACN I = 0;               # CURRENT ACN POINTER #
ITEM I          I;                   # LOOP COUNTER #
ITEM HOLDADR    U;                   # HOLDS BUFFER ADDRESS #
ITEM PANELNAME  C(7);                # PANEL NAME FOR ARRAY RESET #
ITEM PANELADDR  I;                   # PANEL ADDR FOR ARRAY RESET #
ITEM VDATALEN   I;                   # VARDATA LENGTH #
ITEM PLTINDEX   I;                   # ACTIVE PANEL INDEX TO RESET #
ITEM WORDIND    I = 0;               # WORD INDEX FOR FLAG MOVE #
 
HOLDADR = LOC(BUFFER);               # SAVE BUFFER ADDRESS #
P&lt;NIT> = LOC(NITADDR);               # SAVE NIT ADDRESS #
IF CURRNT$ACN EQ 0 THEN
  BEGIN                              # IF FIRST CALL TO SFQTRM$ #
  CURRNT$ACN = NIT$CON[0];
  P&lt;QTRM$BUFFER> = LOC(BUFFER);
  FOR I = 0 STEP 1 UNTIL SFORMSIZE -1 DO
    BEGIN                            # SAVE TERMSTAT DEFAULTS #
    TERINITHLD[I] = TERMSTATWD[I];
    END
  FOR I = 0 STEP 1 UNTIL VTERMSIZE -1 DO
    BEGIN                            # SAVE VDT AREA DEFAULTS #
    VDTINITHLD[I] = COMVDT$WD0[I];
    END
  RETURN;
  END
 
IF CURRNT$ACN NQ NIT$CON[0] THEN
BEGIN                                # IF NEW USER #
  IF CURRNT$ACN NQ 0 AND NIT$PCT[CURRNT$ACN] NQ 0 THEN
    BEGIN                            # IF THERE IS A CURRENT USER #
    P&lt;PCT> = NIT$PCT[CURRNT$ACN];    # SAVE PREVIOUS TERMINAL-S STATE #
    TERFLDADDR  = P&lt;FLDLIST>;        # SAVE FIELD LIST ADDRESS #
    P&lt;QTRM$BUFFER> = P&lt;PCT> + SFORMOFFSET;
    FOR I = 0 STEP 1 UNTIL SFORMSIZE -1 DO
      BEGIN                          # MOVE SFORM DATA #
      QTRM$WD0[I] = TERMSTATWD[I];
      END
    P&lt;QTRM$BUFFER> = P&lt;PCT> + VTERMOFFSET;
    FOR I = 0 STEP 1 UNTIL VTERMSIZE - 1 DO
      BEGIN                          # MOVE VIRTERM DATA #
      QTRM$WD0[I] = COMVDT$WD0[I];
      END
    P&lt;QTRM$BUFFER> = P&lt;PCT> + FDAOFFSET;
    IF TERFLDADDR[0] NQ 0 THEN
      BEGIN                          # IF FIELD STATUS FLAGS EXIST #
      FOR I = 0 STEP 1 WHILE FLDENTRY[I] NQ 0 DO
        BEGIN                        # MOVE FIELD STATUS FLAGS #
        WORDIND = I / 15;
        CHARIND = I - 15*WORDIND;
        B&lt;CHARIND*4,4>QTRM$WD0[WORDIND] = FLDSTFLAGS[I];
        END
      END
    P&lt;QTRM$BUFFER> = P&lt;PCT> + VDTAOFFSET;
    PANELADDR = P&lt;VDATA> - PANHEADLEN;
    IF PANSTRFLD[0] NQ 0 THEN
      BEGIN                          # IF FIELDS EXISTS #
      VDATALEN = P&lt;FLDLIST> - (PANELADDR + PANHEADLEN);
      END
    ELSE
      BEGIN                          # NO FIELDS #
      VDATALEN = P&lt;VARLIST> - (PANELADDR + PANHEADLEN);
      END
    FOR I = 0 STEP 1 UNTIL VDATALEN -1 DO
      BEGIN
      QTRM$WD0[I] = VDATAU[I];
      END
    END
  CURRNT$ACN = NIT$CON[0];           # LOAD ITEMS FOR NEW TERMINAL #
  IF NIT$PCT[CURRNT$ACN] NQ 0 THEN
    BEGIN                            # IF USER HAS A PCT #
      P&lt;PCT> = NIT$PCT[CURRNT$ACN];
      P&lt;PLTABLE> = NIT$PCT[CURRNT$ACN] + PLTOFFSET;
      P&lt;QTRM$BUFFER> = P&lt;PCT> + SFORMOFFSET;
      FOR I = 0 STEP 1 UNTIL SFORMSIZE - 1 DO
        BEGIN                        # MOVE SFORM DATA #
        TERMSTATWD[I] = QTRM$WD0[I];
        END
      P&lt;FLDLIST> = TERFLDADDR;       # FLDLIST ADDRESS #
      P&lt;QTRM$BUFFER> = P&lt;PCT> + VTERMOFFSET;
      FOR I = 0 STEP 1 UNTIL VTERMSIZE - 1 DO
        BEGIN                        # MOVE VIRTERM DATA #
        COMVDT$WD0[I] = QTRM$WD0[I];
        END
      IF TERACTPANL[0] NQ "       " THEN
        BEGIN                        # IF PANEL ACTIVE #
        P&lt;QTRM$BUFFER> = P&lt;PCT> + FDAOFFSET;
        IF TERFLDADDR[0] NQ 0 THEN
          BEGIN                      # IF FIELD STATUS FLAGS EXIST #
          FOR I = 0 STEP 1 WHILE FLDENTRY[I] NQ 0 DO
            BEGIN                    # MOVE FIELD STATUS FLAGS #
            WORDIND = I / 15;
            CHARIND = I - 15*WORDIND;
            FLDSTFLAGS[I] = B&lt;CHARIND*4,4>QTRM$WD0[WORDIND];
            END
          END
        PANELNAME = TERACTPANL[0];   # GET PANEL NAME #
        GETADD(PANELNAME,PANELADDR,PLTINDEX);
        POSARR(PANELADDR);
        P&lt;QTRM$BUFFER> = P&lt;PCT> + VDTAOFFSET;
        PANELADDR = P&lt;VDATA> - PANHEADLEN;
        IF PANSTRFLD[0] NQ 0 THEN
          BEGIN
          VDATALEN = P&lt;FLDLIST> - (PANELADDR + PANHEADLEN);
          END
        ELSE
          BEGIN
          VDATALEN = P&lt;VARLIST> - (PANELADDR + PANHEADLEN);
          END
        FOR I = 0 STEP 1 UNTIL VDATALEN -1 DO
          BEGIN
          VDATAU[I] = QTRM$WD0[I];
          END
        END
      END
    ELSE
      BEGIN                          # NO PCT FOR THIS USER #
      FOR I = 0 STEP 1 UNTIL SFORMSIZE -1 DO
        BEGIN                        # INITIALIZE TERMSTAT #
        TERMSTATWD[I] = TERINITHLD[I];
        END
      FOR I = 0 STEP 1 UNTIL VTERMSIZE -1 DO
        BEGIN                        # INITIALIZE VDT AREA #
        COMVDT$WD0[I] = VDTINITHLD[I];
        END
      TERMODNAME[0] = "       ";
      TERACTPANL[0] = "       ";
      TERACTPLTI[0] = 0;
      TERFUNCPOS[0] = 0;
      TERNUMCOLS[0] = 0;
      TERNUMLNES[0] = 0;
      END
    P&lt;QTRM$BUFFER> = HOLDADR;
    END
 
END  # SFQTRM$ #
*ENDIF
CONTROL EJECT;
 
PROC SFSETP$(VARNAME,VLEN,VOFF,OFFSET,ROWNUM);
 
# TITLE SFSETP$ - SET CURSOR POSITION. #
 
BEGIN  # SFSETP$ #
 
#
**    SFSETP$ - SET CURSOR POSITION.
*
*     SFSETP$ SPECIFIES WHAT FIELD THE CURSOR WILL
*     BE POSITIONED AT FOR THE NEXT READ.
*
*     PROC SFSETP$(VARNAME,VLEN,VOFF,OFFSET,ROWNUM)
*
*     ENTRY   VARNAME    = VARIABLE NAME OF FIELD.
*             VLEN       = LENGTH OF VARP.
*             VOFF       = OFFSET OF VARP.
*             OFFSET     = OFFSET INTO SPECIFIED FIELD.
*             ROWNUM     = ROW NUMBER OF SPECIFIED FIELD.
*
*     EXIT    TERCURSVAR = VARIABLE NAME OF SPECIFIED FIELD.
*             TERCURSROW = ROW NUMBER OF SPECIFIED FIELD.
*             TERCURSOFF = OFFSET OF SPECIFIED FIELD.
*             TERCURSSET = TRUE.
*
*     USES    TERCURSOFF, TERCURSROW, TERCURSSET, TERCURSVAR.
*
*     NOTES   ROUTINE READSF WILL SET THE ACTUAL CURSOR POSITION.
#
ITEM VARNAME    C(11);               # VARIABLE NAME #
ITEM VLEN       I;                   # LENGTH OF VARNAME PARAMETER #
ITEM VOFF       I;                   # OFFSET INTO VARNAME PARAMETER #
ITEM OFFSET     I;                   # OFFSET INTO FIELD #
ITEM ROWNUM     I;                   # ROW NUMBER IN ARRAY #
 
IF VLEN LS 1 THEN VLEN = 7;          # CRACK PARAMETER #
TERCURSVAR[0] = C&lt;VOFF,VLEN>VARNAME;
 
TERCURSSET[0] = TRUE;                # SET GLOBAL VARIABLES #
IF OFFSET GR 0 THEN TERCURSOFF[0] = OFFSET - 1;
  ELSE TERCURSOFF[0] = 0;
IF ROWNUM LS 1 THEN TERCURSROW[0] = 0;
  ELSE TERCURSROW[0] = ROWNUM - 1;
 
END  # SFSETP$ #
CONTROL EJECT;
 
PROC SFSREA$(PANELP,PANLEN,PANOFF,INSP,INSLEN,INSOFF);
 
# TITLE SFSREA$ - READ PANEL USING INSTRING. #
 
BEGIN  # SFSREA$ #
 
#
**    SFSREA$ - READ PANEL USING INSTRING.
*
*     SFSREA$ READS A PANEL AND PLACES THE INPUT IN
*     INSTRING.
*
*     PROC SFSREA$(PANELP,PANLEN,PANOFF,INSP,INSLEN,INSOFF)
*
*     ENTRY   PANELP     = NAME OF PANEL TO READ.
*             PANLEN     = LENGTH OF PANELP.
*             PANOFF     = OFFSET OF PANELP.
*             INSP       = INSTRING TO RECEIVE DATA.
*             INSLEN     = LENGTH OF INSP.
*             INSOFF     = OFFSET OF INSP.
*
*     EXIT    INSP CONTAINS INPUT DATA.
*
*     CALLS   CPANEL, MOVEST, READSF.
*
*     USES    TERREADFLG.
#
ITEM PANELP     C(11);               # PANEL PARAMETER #
ITEM PANLEN     I;                   # LENGTH OF PANEL PARAMETER #
ITEM PANOFF     I;                   # OFFSET OF PANEL PARAMETER #
ITEM INSP       I;                   # ADDRESS OF INSTRING #
ITEM INSLEN     I;                   # LENGTH OF INSTRING #
ITEM INSOFF     I;                   # OFFSET OF INSTRING #
 
ITEM PANEL      C(7);                # NAME OF INPUT PANEL #
 
*IF DEF,QTRM
NIT$RC = NITRTC"OK";                 # SET STATUS OK #
 
*ENDIF
IF PANLEN LS 1 THEN PANLEN = 7;      # CRACK PARAMETER #
PANEL = C&lt;PANOFF,PANLEN>PANELP;
 
READSF(PANEL);                       # READ PANEL #
CPANEL;                              # REWRITE SCREEN AS NEEDED #
 
IF PANNUMBYTE[0] NQ 0 THEN
  BEGIN                              # IF VARIABLES IN PANEL #
  TERREADFLG[0] = TRUE;
  MOVEST(LOC(INSP),INSOFF,INSLEN);   # MOVE VARDATA TO INSTRING #
  TERREADFLG[0] = FALSE;
  END
 
END  # SFSREA$ #
*IF UNDEF, QTRM
CONTROL EJECT;
 
PROC SFSSHO$(PANELP,PANLEN,PANOFF,OUTP,OLEN,OOFF,INSP,ILEN,IOFF);
 
# TITLE SFSSHO$ - SHOW PANEL USING INSTRING AND OUTSTRING. #
 
BEGIN  # SFSSHO$ #
 
#
**    SFSSHO - SHOW PANEL USING INSTRING AND OUTSTRING.
*
*     THIS PROCEDURE CALLS SFSWRI$ AND SFSREA$.
*
*     PROC SFSSHO$(PANELP,PANLEN,PANOFF,OUTP,OLEN,OOFF,INSP,ILEN,IOFF)
*
*     ENTRY   PANELP     = NAME OF PANEL TO READ.
*             PANLEN     = LENGTH OF PANELP.
*             PANOFF     = OFFSET OF PANELP.
*             OUTP       = OUTSTRING DISPLAY DATA.
*             OLEN       = LENGTH OF OUTP.
*             OOFF       = OFFSET OF OUTP.
*             ILEN       = LENGTH OF INSP.
*             IOFF       = OFFSET OF INSP.
*
*     EXIT    INSP       = CONTAINS INPUT DATA.
*
*     CALLS   SFSREA$, SFSWRI$.
*
*     USES    TERSHOWFLG.
#
ITEM PANELP     I;                   # NAME OF PANEL TO READ #
ITEM PANLEN     I;                   # LENGTH OF PANELP #
ITEM PANOFF     I;                   # OFFSET OF PANELP #
ITEM OUTP       I;                   # OUTSTRING DISPLAY DATA #
ITEM OLEN       I;                   # LENGTH OF OUTP #
ITEM OOFF       I;                   # OFFSET OF OUTP #
ITEM INSP       I;                   # INSTRING TO RECEIVE DATA #
ITEM ILEN       I;                   # LENGTH OF INSP #
ITEM IOFF       I;                   # OFFSET OF INSP #
 
TERSHOWFLG[0] = TRUE;
SFSWRI$(PANELP,PANLEN,PANOFF,OUTP,OLEN,OOFF);  # WRITE PANEL #
SFSREA$(PANELP,PANLEN,PANOFF,INSP,ILEN,IOFF);  # READ PANEL #
TERSHOWFLG[0] = FALSE;
 
END  # SFSSHO$ #
*ENDIF
CONTROL EJECT;
 
PROC SFSWRI$(NAME,NLENGTH,NOFFSET,STRING,SLENGTH,SOFFSET);
 
# TITLE SFSWRI$ - SCREEN FORMAT STRING WRITE FUNCTION. #
 
BEGIN  # SFSWRI$ #
 
#
**    SFSWRI$ - SCREEN FORMAT WRITE FUNCTION.
*
*     THIS PROCEDURE WRITES THE SPECIFIED PANEL USING THE CONCATENATED
*     VARIABLE DATA FOUND IN OUTSTRING (OR IN THE CASE OF AN ATTEMPTED
*     READ BEFORE WRITE USING THE VARIABLE DATA ALREADY PRESENT IN THE
*     VARDATA SECTION OF THE PANEL RECORD) AND THE CONSTANT DATA FOUND
*     IN THE PANEL RECORD.  IT INTERFACES TO COBOL AND FORTRAN APPLICA-
*     TION PROGRAMS THROUGH A COMPASS INTERFACE MODULE CALLED SFSWRI.
*
*     PROC SFSWRI$(NAME,NLENGTH,NOFFSET,STRING,SLENGTH,SOFFSET)
*
*     ENTRY   NAME       = THE NAME OF THE PANEL TO BE WRITTEN.
*             NLENGTH    = LENGTH IN SIX BIT CHARACTERS.
*             NOFFSET    = OFFSET INTO NAME.
*             STRING     = CONTAINS THE CONCATENATED VARIABLE DATA.
*             SLENGTH    = LENGTH IN SIX BIT CHARACTERS.
*             SOFFSET    = OFFSET INTO STRING.
*
*     EXIT    PANEL WRITTEN TO SCREEN.
*
*     CALLS   GETADD, MOVEST, POSARR, WRIPAN.
*
*     USES    TERACTIVEP, TERACTPANI.
*
*     NOTES   IF TERREADFLG IS SET SFSWRI HAS BEEN CALLED BY SFSREA
*             AND HENCE THERE IS NO OUTSTRING TO MOVE INTO VARDATA
*             AND WHATEVER VARIABLE DATA IS PRESENTLY THERE WILL BE
*             WRITTEN TO THE SCREEN.
#
ITEM NAME       C(11);               # NAME OF PANEL TO BE WRITTEN #
ITEM NLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM NOFFSET    I;                   # OFFSET INTO NAME #
ITEM STRING     I;                   # OUTSTRING PARAMETER #
ITEM SLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM SOFFSET    I;                   # OFFSET INTO OUTSTRING #
 
ITEM PANELNAME  C(7);                # PANEL NAME, LEFT JUSTIFIED #
ITEM PANELADDR  I;                   # ADDRESS OF PANEL RECORD #
ITEM PLTINDEX   I;                   # PANEL LOAD TABLE INDEX #
ITEM STRINGADDR I;                   # ADDRESS OF OUTSTRING #
 
*IF DEF,QTRM
NIT$RC = NITRTC"OK";                 # SET RETURN CODE #
TERMODNAME[0] = NIT$MODEL[NIT$CON];  # GET THE USERS MODEL FROM NIT #
*ENDIF
IF NLENGTH LS 1 THEN NLENGTH = 7;    # CRACK PARAMETER #
PANELNAME = C&lt;NOFFSET,NLENGTH>NAME;  # LEFT JUSTIFY PANEL NAME #
 
IF PANELNAME NQ TERACTPANL[0] THEN
  BEGIN                              # IF NOT THE ACTIVE PANEL #
  TERACTPANL[0] = PANELNAME;         # UPDATE ACTIVE PANEL NAME #
  GETADD(PANELNAME,PANELADDR,PLTINDEX);
  TERACTPLTI[0] = PLTINDEX;
  POSARR(PANELADDR);                 # POSITION BASED ARRAYS #
  END
 
IF PANNUMBYTE[0] NQ 0 AND NOT TERREADFLG[0] THEN
  BEGIN                              # IF VARIABLE DATA PRESENT #
  STRINGADDR = LOC(STRING);          # ADDRESS OF OUTSTRING #
  MOVEST(STRINGADDR,SOFFSET,SLENGTH);  # MOVE OUTSTRING TO VARDATA #
  END
 
IF NOT TERVDTBOOC[0] THEN
  BEGIN                              # IF FIRST WRITE #
  TERVDTBOOC[0] = TRUE;
  VDTBOO;                            # BEGIN OUTPUT SEQUENCE #
  END
WRIPAN;                              # WRITE PANEL #
 
END  # SFSWRI$ #
CONTROL EJECT;
 
PROC BFIELD(FIELD,STARTCHAR,LASTDIRTY);
 
# TITLE BFIELD - BLANK FIELD IN VARDATA. #
 
BEGIN  # BFIELD #
 
#
**    BFIELD - BLANK FIELD IN VARDATA.
*
*     THIS PROCEDURE BLANK FILLS A FIELD IN VARDATA.
*
*     PROC BFIELD(FIELD,STARTCHAR,LASTDIRTY)
*
*     ENTRY   FIELD      = INDEX OF FIELD IN FLDLIST.
*             STARTCHAR  = POSITION TO START BLANK FILL.
*
*     EXIT    LASTDIRTY  = LAST POSITION WITH PREVIOUS
*                          NON-BLANK CHARACTER.
#
ITEM FIELD      I;                   # FIELD TO INITIALIZE #
ITEM STARTCHAR  I;                   # STARTING CHARACTER POSITION #
ITEM LASTDIRTY  I;                   # LAST NON-BLANK CHARACTER #
 
ITEM CHARNUM    I;                   # CHARACTER POSITION IN VARDATA #
ITEM CHARIND    I;                   # CHARACTER INDEX IN VARDATA #
ITEM I          I;                   # LOOP COUNTER #
ITEM WORDIND    I;                   # WORD INDEX IN VARDATA #
 
LASTDIRTY = -1;
CHARNUM = FLDVDTCORD[FIELD] + STARTCHAR;
WORDIND = CHARNUM / 5;
CHARIND = CHARNUM - (5 * WORDIND);
 
FOR I = STARTCHAR STEP 1 UNTIL FLDLENGTH[FIELD] -1 DO
  BEGIN                              # BLANK FILL FIELD IN VDATA #
  IF NEXTCHAR(FIELD,I) NQ BLANK THEN
    BEGIN                            # NON-BLANK CHARACTER #
    LASTDIRTY = I;                   # UPDATE LAST DIRTY CHARACTER #
    END
  B&lt;CHARIND*12,12>VDATAU[WORDIND] = BLANK;  # BLANK CHARACTER POS #
  CHARIND = CHARIND + 1;
  IF CHARIND EQ 5 THEN
    BEGIN
    CHARIND = 0;
    WORDIND = WORDIND + 1;
    END
  END
 
END  # BFIELD #
CONTROL EJECT;
 
PROC CLRLNS;
 
# TITLE CLRLNS - CLEAR LINES. #
 
BEGIN  # CLRLNS #
 
#
**    CLRLNS - CLEAR LINES.
*
*     THIS PROCEDURE CLEARS THE PROPER LINES BEFORE AN OVERLAY
*     WRITE.
*
*     PROC CLRLNS
*
*     EXIT    PROPER LINES CLEARED ON SCREEN.
*
*     CALLS   VDTCLL.
#
ITEM CURYCORD   I;                   # CURRENT Y COORDINATE #
ITEM FLDINDEX   I;                   # INDEX INTO FIELD LIST #
 
IF PANSTRFLD[0] EQ 0 THEN RETURN;
 
CURYCORD = -1;                       # NO CURRENT Y COORDINATE YET #
FOR FLDINDEX = 0 STEP 1 WHILE FLDENTRY[FLDINDEX] NQ 0 DO
  BEGIN
  IF FLDACTIVE[FLDINDEX] AND FLDYCORD[FLDINDEX] NQ CURYCORD THEN
    BEGIN                            # IF ACTIVE FIELD ON NEW LINE #
    CURYCORD = FLDYCORD[FLDINDEX];   # RESET CURRENT Y COORDINATE #
    VDTCLL(0,CURYCORD);              # CLEAR LINE #
    END
  END
IF TERNOTCHAR[0] THEN VDTCAA(0);     # IF LINE OR PAGE TYPE ATTRS. #
 
END  # CLRLNS #
CONTROL EJECT;
 
PROC CPANEL;
 
# TITLE CPANEL - CLEAN PANEL. #
 
BEGIN  # CPANEL #
 
#
**    CPANEL - CLEAN PANEL.
*
*     THIS PROCEDURE CHECKS FLAGS PERTAINING TO REWRITING THE
*     SCREEN AND THEN CALLS THE APPROPRIATE PROCEDURES.
*
*     PROC CPANEL
*
*     ENTRY    TERMESWRIT = TRUE, IF THE MESSAGE CONTAINS A MESSAGE.
*              TERMESREAD = TRUE, IF THE MESSAGE AREA CAN BE CLEARED.
*              TERREWFLDS = TRUE, IF ONE OR MORE FIELDS NEED REWRITING.
*              TERREWSCRN = TRUE, IF THE ENTIRE SCREEN NEEDS REWRITING.
*
*     EXIT     TERMESREAD = FALSE.
*              TERREWFLDS = FALSE.
*              TERREWSCRN = FALSE.
*
*     CALLS    REWFLD, MCLEAN, VDTSAM, WRIALL.
*
*     USES     TERDONTCLR, TERMESREAD, TERNOREWRT, TERREWFLDS,
*              TERREWSCRN.
#
ITEM I          I;                   # LOOP COUNTER #
 
IF TERMESWRIT[0] AND TERMESREAD[0] AND NOT TERREWSCRN[0] THEN
  BEGIN                              # CLEAR MESSAGE AREA #
  MCLEAN(DUMMY,DUMMY);               # CLEAN MESSAGE LINE #
  IF NOT TERBLCKMDE[0] THEN
    BEGIN
    VDTSAM(0);
    END
  ELSE
    BEGIN
    VDTSAM(O"6001");
    END
  END
 
IF TERREWFLDS[0] OR TERREWSCRN[0] THEN
  BEGIN                              # REWRITE FLAGGED FIELDS #
  TERREADFLG[0] = TRUE;
  TERDONTCLR[0] = TRUE;              # DO NOT CLEAR REWRITE/ENTERED #
  IF TERREWSCRN[0] THEN
    BEGIN                            # FULL REWRITE OF SCREEN #
    WRIALL;
    TERREWSCRN[0] = FALSE;
    END
  ELSE                               # REWRITE FLAGGED FIELDS #
    BEGIN
    TERNOREWRT[0] = TRUE;
    REWFLD;                          # REWRITE FIELDS #
    TERNOREWRT[0] = FALSE;
    END
  TERDONTCLR[0] = FALSE;
  TERREADFLG[0] = FALSE;
  END
 
TERMESREAD[0] = FALSE;
TERREWFLDS[0] = FALSE;
 
END  # CPANEL #
CONTROL EJECT;
 
PROC DATEVL(FLDIND,IVAL);
 
# TITLE DATEVL - DATE VALIDATION. #
 
BEGIN  # DATEVL #
 
#
**    DATEVL - DATE VALIDATION.
*
*     THIS PROCEDURE CHECKS THAT THE INPUT IS A VALID DATE.
*
*     PROC DATEVL(FLDIND,IVAL)
*
*     ENTRY   FLDIND     = INDEX OF CURRENT FIELD IN FLDLIST.
*
*     EXIT    IVAL       = INTEGER VALUE OF INPUT.
*             FLDVALID[FLDIND] = FALSE, IF INVALID INPUT.
*
*     CALLS   GETNUM, SKPBLK.
#
ITEM FLDIND     I;                   # VARIABLE TO BE VALIDATED #
ITEM IVAL       I;                   # INTEGER VALUE OF INPUT #
 
ITEM CHAR       I;                   # INPUT CHARACTER #
ITEM CHARPOS    I;                   # CHARACTER POSITION IN FIELD #
ITEM DATEIND    I;                   # INDEX TO DATEARRAY #
ITEM DD         I;                   # DAY #
ITEM DIGITS     I;                   # NUMBER OF DIGITS IN SUBFIELD #
ITEM FVAL       I;                   # SUBFIELD VALUE #
ITEM I          I;                   # LOOP COUNTER #
ITEM INPIND     I;                   # INDEX TO NEXT INPUT CHARACTER #
ITEM MM         I;                   # MONTH #
ITEM TEMP1      I;                   # USED FOR LEAP YEAR CALCULATION #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
ITEM YY         I;                   # YEAR #
 
ARRAY DATEARRAY[0:7] P(1);
  BEGIN
  ITEM DATECHAR   U(00,00,60);       # HOLDS INPUT CHARACTERS #
  END
 
ARRAY DATEDELS[0:2] P(1);
  BEGIN
  ITEM DATEDEL    U(00,00,60);       # DATE DELIMETER #
  END
 
ARRAY FIELDARRAY[0:2] P(1);
  BEGIN
  ITEM FIELD      U(00,00,60);       # HOLDS MONTH, DAY, YEAR FIELDS #
  END
 
ARRAY MONTHS [0:12] P(1);            # NUMBER OF DAYS IN EACH MONTH #
  BEGIN                              # 0TH MONTH = LEAP YEAR FEBRUARY #
  ITEM MONLENGTH  U(00,00,60) =
                 [29,31,28,31,30,31,30,31,31,30,31,30,31];
  END
 
SWITCH DATETYPE:FORMTYPE
  YYMMDD : Y,
  MMDDYY : M,
  DDMMYY : D;
 
DATEIND = 0;
INPIND = 0;
CHARPOS = 0;
 
VARIND = FLDVARORD[FLDIND];          # SET INDEX TO VARLIST #
IVAL = 0;
SKPBLK(FLDIND,CHARPOS,CHAR);
IF CHARPOS GQ FLDLENGTH[FLDIND] THEN
  BEGIN                              # BLANK FIELD #
  FLDVALID[FLDIND] = FALSE;
  RETURN;
  END
 
FOR I = 0 STEP 1 UNTIL 2 DO
  BEGIN
  FVAL = 0;
  GETNUM(FLDIND,CHARPOS,FVAL,DIGITS);
  IF I NQ 2 THEN
    BEGIN
    CHAR = NEXTCHAR(FLDIND,CHARPOS);
    DATEDEL[I] = CHAR;
    END
  ELSE CHARPOS = CHARPOS -1;
  IF NOT(DIGITS EQ 1 OR DIGITS EQ 2) THEN
    BEGIN
    FLDVALID[FLDIND] = FALSE;
    RETURN;
    END
  CHARPOS = CHARPOS + 1;
  FIELD[I] = FVAL;
  END
 
IF CHARPOS NQ FLDLENGTH[FLDIND] THEN
  BEGIN                              # CHECK FOR EXTRA CHARACTERS #
  SKPBLK(FLDIND,CHARPOS,CHAR);
  IF CHARPOS LQ FLDLENGTH[FLDIND] - 1 THEN
    BEGIN                            # NON-BLANK CHAR AFTER DATE #
    FLDVALID[FLDIND] = FALSE;
    RETURN;
    END
  END
 
IF DATEDEL[1] NQ DATEDEL[0] THEN
  BEGIN
  FLDVALID[FLDIND] = FALSE;
  RETURN;
  END
GOTO DATETYPE[VARPICTYPE[VARIND]];
 
MMDDYY:                              # SET MONTH, DAY, YEAR VALUES #
 
  MM = FIELD[0];
  DD = FIELD[1];
  YY = FIELD[2];
  GOTO CHECKDATE;
 
YYMMDD:                              # SET MONTH, DAY, YEAR VALUES #
 
  YY = FIELD[0];
  MM = FIELD[1];
  DD = FIELD[2];
  GOTO CHECKDATE;
 
DDMMYY:                              # SET MONTH, DAY, YEAR VALUES #
 
  DD = FIELD[0];
  MM = FIELD[1];
  YY = FIELD[2];
 
CHECKDATE:                           # CHECK FOR VALID DATE VALUE #
 
  IF MM GR 12 OR MM LS 1 THEN
    BEGIN                            # INVALID MONTH #
    FLDVALID[FLDIND] = FALSE;
    RETURN;
    END
 
  IF MM EQ 2 THEN                    # CHECK IF LEAP YEAR FEBRUARY #
    BEGIN
    TEMP1 = YY / 4;
    TEMP1 = YY - (4 * TEMP1);
    IF TEMP1 EQ 0 THEN MM = 0;
    END
 
  IF DD GR MONLENGTH[MM] OR DD LS 1 THEN
    BEGIN                            # INVALID DAY #
    FLDVALID[FLDIND] = FALSE;
    RETURN;
    END
 
  IF MM EQ 0 THEN MM = 2;
  IVAL = YY*10000 + MM*100 + DD;
 
END  # DATEVL #
CONTROL EJECT;
 
PROC ERRMSG(PANELNAME,PROCNAME,PROCMSG,FATAL);
 
# TITLE ERRMSG - ERROR MESSAGE PROCEDURE. #
 
BEGIN  # ERRMSG #
 
#
**    ERRMSG - ERROR MESSAGE PROCEDURE.
*
*     THIS PROCEDURE ISSUES A DAYFILE MESSAGE INDICATING WHICH
*     PANEL CAUSED AN ERROR AND THE PROCEDURE THAT DETECTED IT.
*     IT ALSO TERMINATES THE PROGRAM IF THE ERROR IS FATAL.
*
*     PROC ERRMSG(PANELNAME,PROCNAME,PROCMSG,FATAL)
*
*     ENTRY   PANELNAME  = THE NAME OF THE PANEL.
*             PROCNAME   = THE NAME OF THE EXTERNAL PROCEDURE
*                          THAT DETECTED THE ERROR.
*             PROCMSG    = THE ERROR MESSAGE.
*             FATAL      = TRUE IF THE ERROR IS FATAL, FALSE OTHERWISE.
*
*     EXIT    MESSAGE ISSUED TO DAYFILE, PROGRAM TERMINATED IF FATAL
*             IS TRUE.
*
*IF UNDEF,QTRM
*     CALLS   VDTCLO, VDTCLS, VDTMSG$, VDTSTM.
*ELSE
*ENDIF
*
*     USES    TERACTIVEP, TERACTPANI, TERCNWRIOV, TERMESREAD,
*             TERMESWRIT, TERSCREENM, TERSHOWFLG.
*
*     NOTES   THIS PROCEDURE IS CALLED BY SFCLOS WHEN A PANEL CANNOT BE
*             CLOSED (INFORMATIVE MESSAGE ONLY), BY GETADD WHEN A READ,
*             WRITE, OR SHOW OF A PANEL THAT IS NOT IN THE PANEL LOAD
*             TABLE IS ATTEMPTED (INFORMATIVE MESSAGE AND TERMINATION
*             OF PROGRAM), BY WRIPAN WHEN AN ATTEMPT IS MADE TO WRITE
*             AN OVERLAY PANEL BEFORE A PRIMARY PANEL (INFORMATIVE
*             MESSAGE AND TERMINATION OF PROGRAM) AND BY SFLOAD IF
*             AN INTERNAL FAST DYNAMIC LOADER ERROR HAS OCCURRED
*             (INFORMATIVE MESSAGE ONLY).
#
ITEM PANELNAME  C(7);                # PANEL NAME #
ITEM PROCNAME   C(6);                # PROCEDURE NAME #
ITEM PROCMSG    C(20);               # DAYFILE ERROR MESSAGE #
ITEM FATAL      B;                   # PANEL NAME #
 
ITEM DAYFILE    I = 0;               # ISSUE MESSAGE TO DAYFILE #
ITEM DAYMESSAGE C(41) = " XXXXXX - PANEL                          ";
ITEM EMPTY      I = O"00";           # OCTAL ZERO / COLON #
*IF UNDEF,QTRM
ITEM LINE       I = 0;               # INDICATES LINE MODE TO VDT #
ITEM NOMSG      I = 0;               # NO B-DISPLAY MESSAGE #
*ENDIF
ITEM NONAME     C(25) = "NAME IS BLANK.           ";  # ERROR MSG. #
*IF UNDEF,QTRM
ITEM RECALL     I = 1;               # RECALL PARAMETER FOR VDTCLO #
*ENDIF
ITEM PANINDEX   I;                   # INDEX INTO PANEL NAME #
ITEM PANLEN     I;                   # LENGTH OF PANEL NAME #
*IF UNDEF,QTRM
ITEM PLTCOUNT   I;                   # COUNTER TO CLEAR PLT #
*ENDIF
ITEM SPACE      I = O"55";           # DISPLAY CODE BLANK #
 
C&lt;1,6>DAYMESSAGE = PROCNAME;         # PUT IN PROCEDURE NAME #
 
PANLEN = 0;
FOR PANINDEX = 0 STEP 1 UNTIL 6 DO
  BEGIN                              # FIND PANEL NAME LENGTH #
  IF C&lt;PANINDEX,1>PANELNAME NQ SPACE
    AND C&lt;PANINDEX,1>PANELNAME NQ EMPTY THEN
    BEGIN                            # IF NOT AT END OF PANEL NAME #
    PANLEN = PANINDEX + 1;
    END
  END
 
IF PANLEN EQ 0 OR PANELNAME EQ 0 THEN
  BEGIN                              # IF BLANK PANEL NAME #
  C&lt;16,25>DAYMESSAGE = NONAME;       # OVER RIDE PROCEDURE MSG. #
  END
ELSE
  BEGIN                              # PUT IN NAME AND MESSAGE #
  C&lt;16,PANLEN>DAYMESSAGE = PANELNAME;
  C&lt;16+PANLEN,25-PANLEN>DAYMESSAGE = PROCMSG;
  END
 
VDTMSG$(DAYMESSAGE,DAYFILE,1);       # ISSUE DAYFILE MESSAGE #
 
IF FATAL THEN
  BEGIN                              # IF FATAL ERROR #
*IF UNDEF,QTRM
    IF TERSCREENM[0] THEN
      BEGIN                          # IF IN SCREEN MODE #
      IF NOT TERVDTBOOC[0] THEN
        BEGIN                        # IF FIRST WRITE #
        VDTBOO;                      # BEGIN OUTPUT SEQUENCE #
        END
      VDTCLS;                        # CLEAR SCREEN #
      FOR PLTCOUNT = 1 STEP 1 UNTIL PLTNUMENT[0] DO
        BEGIN                        # CLEAR SEQUENCE NUMBERS #
        PLTENTRYNM[PLTCOUNT] = 0;
        END
      PLTNUMONSC[0] = 0;             # NO PANELS ON SCREEN #
      TERMESWRIT[0] = FALSE;
      TERMESREAD[0] = FALSE;
      VDTSTM(LINE,DUMMY);            # SET LINE MODE #
      IF NOT TERNOVDTEO[0] THEN VDTEOO;
      TERVDTBOOC[0] = FALSE;
      VDTCLO(RECALL);                # FLUSH OUTPUT, RECALL #
      END
    TERACTPANL[0] = "       ";       # CLEAR ACTIVE PANEL NAME #
    TERACTPLTI[0] = 0;               # CLEAR PLT INDEX #
    TERCNWRIOV[0] = FALSE;           # DO NOT ALLOW OVERLAY WRITE #
    VDTMSG$(NOMSG,1,1);              # CLEAR B-DISPLAY #
    TERSHOWFLG[0] = FALSE;
    TERREADFLG[0] = FALSE;
  ABORT;                             # ABORT THE PROGRAM #
*ELSE
  ABORT;                             # ABORT THE USER #
*ENDIF
  END
 
END  # ERRMSG #
CONTROL EJECT;
 
PROC FFIELD(INPOS,FIELD,OFFSET,OUTFLAG);
 
# TITLE FFIELD - FIND INPUT FIELD. #
 
BEGIN  # FFIELD #
 
#
**    FFIELD - FIND INPUT FIELD.
*
*     THIS PROCEDURE FINDS THE ACTIVE INPUT FIELD ASSOCIATED WITH
*     THE INPUT RECEIVED FROM SCREEN POSITION INPOS.
*
*     PROC FFIELD(INPOS,FIELD,OFFSET)
*
*     ENTRY   INPOS      = X/Y POSITION
*             OUTFLAG    = TRUE, INCLUDE ACTIVE OUTPUT ONLY
*                          FIELDS IN THE SEARCH.
*
*     EXIT    FIELD      = FIELD ASSOCIATED WITH INPUT.
*                        = -1 IF NOT IN A FIELD.
*             OFFSET     = OFFSET OF INPUT INTO FIELD.
*
*     NOTES   FFIELD ASSUMES THAT FIELDS DO NOT SPAN LINES.
#
ITEM INPOS      I;                   # X/Y POSITION #
ITEM FIELD      I;                   # INDEX INTO FLDLIST #
ITEM OFFSET     I;                   # OFFSET INTO FIELD #
ITEM OUTFLAG    B;                   # INCLUDE OUT-ONLY FIELDS #
 
ITEM I          I;                   # LOOP COUNTER #
ITEM NOTEND     B;                   # NOT END OF SEARCH #
 
FIELD = -1;                          # NOT FOUND UNTIL PROVEN FOUND #
NOTEND = TRUE;
OFFSET = 0;
 
FOR I = 0 STEP 1 WHILE NOTEND
  AND FLDENTRY[I] NQ 0 DO
  BEGIN                              # FIND FIELD CHAR WAS ENTERED IN #
  IF INPOS LS FLDPOS[I] AND FLDACTIVE[I] THEN NOTEND = FALSE;
  ELSE
    BEGIN
    IF (FLDINPUTV[I] AND FLDACTIVE[I])
      OR (FLDVARFLAG[I] AND OUTFLAG AND FLDACTIVE[I]) THEN
      BEGIN
      FIELD = I;
      END
    END
  END
 
IF VALIDFIELD THEN
  BEGIN                              # IF VALID FIELD FOUND #
  OFFSET = INPOS - FLDPOS[FIELD];
  IF OFFSET GQ FLDLENGTH[FIELD] THEN
    BEGIN                            # INPUT BEYOND END OF FIELD #
    OFFSET = 0;
    FIELD = -1;
    END
  END
 
END  # FFIELD #
CONTROL EJECT;
 
PROC FFIRST(FLDIND);
 
# TITLE FFIRST - FIND FIRST INPUT FIELD. #
 
BEGIN  # FFIRST #
 
#
**    FFIRST - FIND FIRST INPUT FIELD.
*
*     THIS PROCEDURE FINDS THE FIRST ACTIVE INPUT FIELD IN THE PANEL
*     THAT DOES NOT HAVE A VALID ENTRY.  IF ALL INPUT FIELDS ARE BOTH
*     ENTERED AND VALID THEN THE FIRST ACTIVE INPUT FIELD IS RETURNED.
*
*     PROC FFIRST(FLDIND)
*
*     EXIT     FLDIND    = INDEX OF FIRST INPUT FIELD
*                        = -1, IF NO INPUT FIELD FOUND.
#
ITEM FLDIND     I;                   # FIELD INDEX #
 
ITEM FIRST      B;                   # STILL LOOKING FOR FIRST FIELD #
ITEM FOUND      B;                   # FOUND AN UNENTERED INPUT FIELD #
ITEM I          I;                   # LOOP COUNTER #
 
FLDIND = -1;
FIRST = TRUE;
FOUND = FALSE;
 
FOR I = 0 STEP 1 WHILE NOT FOUND AND FLDENTRY[I] NQ 0 DO
  BEGIN                              # SEARCH FIELD LIST #
  IF FLDINPUTV[I] AND NOT FOUND AND FLDACTIVE[I]
    AND (NOT FLDENTERED[I] OR NOT FLDVALID[I]) THEN
    BEGIN                            # FIRST AVAILABLE FIELD #
    FIRST = FALSE;
    FOUND = TRUE;
    FLDIND = I;
    END
  ELSE IF FIRST AND FLDINPUTV[I] AND FLDACTIVE[I] THEN
    BEGIN                            # FIRST INPUT FIELD #
    FIRST = FALSE;
    FLDIND = I;
    END
  END
 
END  # FFIRST #
CONTROL EJECT;
 
PROC FMATCH(FLDIND,MATCHIND,MATCHCOUNT);
 
# TITLE FMATCH - FIND ENTRY IN MATCH LIST. #
 
BEGIN  # FMATCH #
 
#
**    FMATCH - FIND ENTRY IN MATCH LIST.
*
*     THIS PROCEDURE FINDS THE FIRST ENTRY IN THE VARIABLE MATCH LIST
*     WHICH MATCHES THE ENTERED CHARACTERS COMPLETELY OR IN PART.
*
*     PROC FMATCH(FLDIND,MATCHIND,MATCHCOUNT)
*
*     ENTRY   FLDIND     = POINTER INTO FLDLIST OF CURRENT FIELD.
*
*     EXIT    MATCHIND   = INDEX INTO MATCHLIST OF FIRST VALID MATCH.
*                        = -1 IF NO VALID MATCH FOUND.
*             MATCHCOUNT = NUMBER OF VALID MATCHES FOUND.
*                          -1 IF EXACT (TO 10 CHARACTERS) MATCH FOUND.
#
ITEM FLDIND     I;                   # INDEX OF FIELD IN FLDLIST #
ITEM MATCHIND   I;                   # INDEX OF MATCH IN MATCHLIST #
ITEM MATCHCOUNT I;                   # NUMBER OF VALID MATCHES FOUND #
 
ITEM CHARPOS    I;                   # INPUT CHAR POSITION IN FIELD #
ITEM EXACT      B;                   # EXACT MATCH FOUND #
ITEM I          I;                   # LOOP COUNTER #
ITEM INPCHAR    I;                   # INPUT CHARACTER #
ITEM LASTCHARP  I;                   # LAST INPUT CHARACTER POSITION #
ITEM MATCHCHAR  I;                   # MATCH CHARACTER #
ITEM MATCHCI    I;                   # CHAR INDEX OF MATCH CHARACTER #
ITEM MATCHED    B;                   # INPUT MATCHED LIST ENTRY #
ITEM MATCHLEN   I;                   # LENGTH OF MATCH STRING #
ITEM MATCHMAX   I;                   # EXACT MATCH CHARACTER COUNT   #
ITEM MATCHWDS   I;                   # NUMBER OF WORDS TO HOLD FIELD #
ITEM MATCHWI    I;                   # WORD INDEX OF MATCH CHARACTER #
ITEM STARTCHARP I;                   # FIRST INPUT CHARACTER POSITION #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
 
VARIND = FLDVARORD[FLDIND];
P&lt;MATCHLIST> = LOC(RECWORDC[0]) + VARVALOS[VARIND];
MATCHCHAR = 0;
 
LASTCHARP = -1;
STARTCHARP = -1;
 
FOR I = 0 STEP 1 UNTIL FLDLENGTH[FLDIND] - 1 DO
  BEGIN                              # LOOK FOR FIRST AND LAST CHAR #
  IF NEXTCHAR(FLDIND,I) NQ BLANK THEN
    BEGIN                            # NON-BLANK CHARACTER #
    LASTCHARP = I;
    IF STARTCHARP EQ -1 THEN STARTCHARP = I;
    END
  END
 
IF STARTCHARP EQ -1 THEN
  BEGIN                              # NO CHARACTERS FOUND #
  STARTCHARP = 0;
  LASTCHARP = 0;
  END
MATCHLEN = LASTCHARP - STARTCHARP + 1;
MATCHMAX = FLDLENGTH[FLDIND];
IF PANVERSION[0] EQ 0 THEN
  BEGIN                              # IF MATCH ENTRIES ONLY 10 CHAR. #
  IF MATCHMAX GR 10 THEN
    BEGIN
    MATCHMAX = 10;
    IF MATCHLEN GR 10 THEN MATCHLEN = 10;
    END
  END
MATCHWDS = (MATCHMAX+9)/10;          # WORDS PER MATCH ENTRY #
MATCHIND = -MATCHWDS;                # DEFAULT INDEX IF NO MATCH #
MATCHCOUNT = 0;
 
FOR MATCHWI = 0 STEP MATCHWDS WHILE MATCHWORD[MATCHWI] NQ 0
  AND MATCHCOUNT GQ 0 DO
  BEGIN
  MATCHED = TRUE;
  CHARPOS = STARTCHARP;
  FOR MATCHCI = 0 STEP 1 WHILE MATCHED AND MATCHCI LS MATCHLEN DO
    BEGIN                            # CHECK CHARACTERS FOR MATCH #
    B&lt;48,12>MATCHCHAR = C&lt;MATCHCI*2,2>MATCH[MATCHWI];
    INPCHAR = NEXTCHAR(FLDIND,CHARPOS);
    IF UPPER(MATCHCHAR) NQ UPPER(INPCHAR) THEN MATCHED = FALSE;
    CHARPOS = CHARPOS + 1;
    END
  IF MATCHED THEN
    BEGIN                            # FIRST (MATCHLEN) CHARS MATCH #
    EXACT = TRUE;
    FOR MATCHCI = MATCHLEN STEP 1 UNTIL MATCHMAX-1 DO
      BEGIN                          # CHECK REST OF CHARS FOR BLANKS #
      IF C&lt;MATCHCI*2,2>MATCH[MATCHWI] NQ BLANK THEN EXACT = FALSE;
      END
    IF EXACT THEN
      BEGIN                          # EXACT MATCH FOUND #
      MATCHCOUNT = -1;               # FLAG ENTRY FOUND #
      MATCHIND = MATCHWI;
      END
    ELSE
      BEGIN                          # PARTIAL MATCH FOUND #
      MATCHCOUNT = MATCHCOUNT + 1;
      IF MATCHCOUNT EQ 1 THEN MATCHIND = MATCHWI;  # IF FIRST ONE #
      END
    END
  END
 
END  # FMATCH #
CONTROL EJECT;
 
PROC FUNKEY(INPOS,OFFSET,FUNTYPE,ORDINAL,FIELD);
 
# TITLE FUNKEY - PROCESS FUNCTION KEY ACTION. #
 
BEGIN  # FUNKEY #
 
#
**    FUNKEY - PROCESS FUNCTION KEY ACTION.
*
*     THIS PROCEDURE SEARCHES THE FUNCTION LIST TO FIND THE ACTION TO
*     AKE FOR THE FUNCTION KEY, IF ANY.  IT THEN TAKES THE DEFINED
*     ACTION IF NO SOFT TABS ARE PENDING.  IF SOFT TABS ARE PENDING
*     THE FUNCTION IS IGNORED AND IF THE FUNCTION KEY DOES NOT HAVE
*     A DEFINED ACTION THE SOFT TAB COUNTER WILL BE INCREMENTED.  THE
*     ONLY EXCEPTION IS A HELP REQUEST WHICH WILL SET HELP PENDING
*     TO BE PROCESSED AFTER ALL SOFT TABS HAVE BEEN PROCESSED.
*
*     PROC FUNKEY(INPOS,OFFSET,FUNTYPE,ORDINAL,FIELD)
*
*     ENTRY   INPOS      = X/Y POSITION WHERE FUNCTION WAS ENTERED.
*             OFFSET     = OFFSET INTO FIELD WHERE FUNCTION WAS ENTERED.
*             FUNTYPE    = 24, GENERIC FUNCTION KEY.
*                        = 23, APPLICATION FUNCTION KEY.
*             ORDINAL    = FUNCTION KEY ORDINAL.
*             FIELD      = FIELD WHERE FIELD WAS ENTERED.
*             TERSOFTTAB = COUNT OF CURRENT SOFT TABS PENDING.
*
*     EXIT    INPOS      = NEW X/Y POSITION
*             FIELD      = NEW FIELD POSITION
*             TERSOFTTAB = UPDATED SOFT TAB COUNT
*             TERSOFTPOS = INPOS IF FIRST SOFT TAB CREATED
*             TERABNTERM = TRUE, TERMINATE INPUT ABNORMALLY
*             TERNRMTERM = TRUE, TERMINATE INPUT NORMALLY
*
*     CALLS   FMATCH, MMATCH, TABKEY.
*
*     USES    TERABNTERM, TERFUNCGEN, TERFUNCORD, TERFUNCPOS,
*             TERHELPFLD, TERHELPREQ, TERNRMTERM, TERPENDHLP,
*             TERSOFTPOS, TERSOFTTAB.
*
*     NOTES   FLDENTERED, FLDVALID, FLDREWRITE, TERREWFLDS AND VARDATA
*             UPDATED IF MATCH ADVANCE OCCURRED.  SWITCH ACTTYPE MUST
*             PARALLEL PDU DEFINITION FOR FUNCTION KEY ACTIONS.
#
ITEM INPOS      I;                   # X/Y POSITION OF CURSOR #
ITEM OFFSET     I;                   # OFFSET INTO FIELD #
ITEM FUNTYPE    I;                   # APPLICATION OR GENERIC #
ITEM ORDINAL    I;                   # FUNCTION KEY ORDINAL #
ITEM FIELD      I;                   # INDEX OF FIELD #
 
DEF  FH         #9#;                 # ORDINAL FOR HELP AS AN ACTION #
DEF  FM         #10#;                # ORDINAL FOR MATCH ADVANCE #
 
ITEM ACTION     I;                   # ORDINAL OF ACTION #
ITEM CHAR       I;                   # 12-BIT CHARACTER #
ITEM I          I;                   # LOOP COUNTER #
ITEM MATCHCOUNT I;                   # NUMBER OF VALID MATCHES #
ITEM MATCHIND   I;                   # INDEX INTO MATCHLIST #
ITEM NOTDONE    B;                   # FUNCTION LIST ENTRY NOT FOUND #
ITEM SCRPOS     I;                   # SCRATCH POSITION FOR TABKEY #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
 
SWITCH ACTTYPE                       # TYPE OF ACTION TO TAKE #
  TABSOFTLY,                         # PROCESS SOFT TAB #
  NORMTOAPP,                         # RETURN NORMALLY TO APPLICATION #
  NORMTONOS,                         # RETURN NORMALLY TO OPER. SYS. #
  ABNORTOAPP,                        # RETURN ABNORMALLY TO APPL. #
  ABNORTONOS,                        # RETURN ABNORMALLY TO OPER. SYS #
  PAGEFORWARD,                       # PAGE TABLE FORWARD #
  PAGEBAKWARD,                       # PAGE TABLE BACKWARD #
  INSERTROW,                         # INSERT ROW IN TABLE #
  DELETEROW,                         # DELETE ROW IN TABLE #
  GIVEHELP,                          # PROVIDE HELP #
  MATCHADV;                          # ADVANCE MATCH ENTRY #
 
# SAVE FUNCTION KEY ORDINAL AND KEY TYPE #
 
TERFUNCORD[0] = ORDINAL;
TERFUNCGEN[0] = FUNTYPE EQ SCREENST"GKEY";
TERFUNCPOS[0] = INPOS;
 
IF TERSOFTTAB[0] NQ 0 AND TERFUNCGEN[0]
  AND ORDINAL EQ GENERICST"GNEXT" THEN
  BEGIN                              # NEXT FOLLOWING SOFT TAB #
  GOTO NOACTION;
  END
 
IF PANSTRFUN[0] EQ 0 THEN
  BEGIN                              # NO FUNCTION LIST #
  IF TERFUNCGEN[0] AND ORDINAL EQ GENERICST"GSTOP" THEN
    BEGIN                            # DEFAULT STOP ACTION #
    IF TERSOFTTAB[0] EQ 0 THEN
      BEGIN                          # IF NO SOFT TABS PENDING #
      GOTO ABNORTOAPP;
      END
    ELSE
      BEGIN                          # IF SOFT TABS PENDING #
      GOTO NOACTION;
      END
    END
  IF TERFUNCGEN[0] AND ORDINAL EQ GENERICST"GHELP" THEN
     BEGIN                           # IF HELP REQUESTED #
     GOTO GIVEHELP;                  # PROVIDE HELP #
     END
  GOTO NORMTOAPP;                    # TAKE DEFAULT ACTION #
  END
 
NOTDONE = TRUE;
FOR I = 0 STEP 1 WHILE NOTDONE AND FUNWORD[I] NQ 0 DO
  BEGIN                              # LOOK FOR ENTRY IN FUNLIST #
  IF ((FUNGENERIC[I] AND TERFUNCGEN[0])
    OR (NOT FUNGENERIC[I] AND NOT TERFUNCGEN[0]))
    AND FUNNUMBER[I] EQ ORDINAL THEN
    BEGIN                            # FOUND FUNLIST ENTRY #
    NOTDONE = FALSE;
    ACTION = FUNACT[I];              # ASSIGN DEFINED ACTION #
    END
  END
 
IF NOTDONE THEN
  BEGIN                              # NOT IN LIST #
  IF TERFUNCGEN[0] AND ORDINAL EQ GENERICST"GHELP" THEN
    BEGIN
    GOTO GIVEHELP;
    END
  ELSE GOTO TABSOFTLY;               # PROCESS SOFT TAB #
  END
IF TERFUNCGEN[0] AND ORDINAL EQ GENERICST"GHELP"
  AND FIELD NQ -1 THEN
  BEGIN                              # HELP KEY ENTERED IN A FIELD #
  IF VARHSOS[FLDVARORD[FIELD]] NQ 0 THEN
    BEGIN                            # HELP STRING DEFINED #
    GOTO GIVEHELP;                   # GIVE HELP #
    END
  END
IF TERSOFTTAB[0] NQ 0 AND ACTION NQ FM AND ACTION NQ FH THEN
  BEGIN                              # IF SOFT TABS PENDING #
  GOTO NOACTION;                     # IGNORE UNLESS MATCH OR HELP #
  END
ELSE
  BEGIN                              # NO SOFT TABS PENDING #
  GOTO ACTTYPE[ACTION];              # GO TO ASSIGNED ACTION #
  END
 
PAGEFORWARD:                         # CURRENTLY A NO-OP #
PAGEBAKWARD:                         # CURRENTLY A NO-OP #
INSERTROW:                           # CURRENTLY A NO-OP #
DELETEROW:                           # CURRENTLY A NO-OP #
 
  TERNRMTERM[0] = FALSE;
  TERABNTERM[0] = FALSE;
  RETURN;
 
TABSOFTLY:                           # PROCESS SOFT TAB #
 
  IF TERSOFTTAB[0] EQ 0 THEN TERSOFTPOS[0] = INPOS;
  TERSOFTTAB[0] = TERSOFTTAB[0] + 1; # INCREMENT TAB COUNT #
 
NOACTION:                            # NO ACTION TO OCCUR #
 
  TERNRMTERM[0] = FALSE;
  TERABNTERM[0] = FALSE;
  RETURN;
 
NORMTOAPP:                           # NORMAL TERMINATION AND #
                                     # RETURN TO APPLICATION #
  TERNRMTERM[0] = TRUE;
  TERABNTERM[0] = FALSE;
  RETURN;
 
NORMTONOS:                           # NORMAL TERMINATION AND RETURN #
                                     # TO OPERATING SYSTEM #
  TERNRMTERM[0] = TRUE;
  TERABNTERM[0] = FALSE;
  RETURN;
 
ABNORTOAPP:                          # ABNORMAL TERMINATION AND #
                                     # RETURN TO APPLICATION #
  TERNRMTERM[0] = FALSE;
  TERABNTERM[0] = TRUE;
  RETURN;
 
ABNORTONOS:                          # ABNORMAL TERMINATION AND #
                                     # RETURN TO OPERATING SYSTEM #
  TERNRMTERM[0] = FALSE;
  TERABNTERM[0] = TRUE;
  RETURN;
 
GIVEHELP:                            # PROVIDE HELP #
 
  IF TERSOFTTAB[0] NQ 0 THEN
    BEGIN                            # IF SOFT TABS PENDING #
    TERPENDHLP[0] = TRUE;            # SET HELP PENDING FLAG #
    END
  ELSE
    BEGIN                            # NO SOFT TABS PENDING #
    IF FIELD EQ -1 THEN
      BEGIN
      TABKEY(SCREENST"FTAB",INPOS,FIELD,SCRPOS);  # TAB TO NEXT FIELD #
      IF FIELD EQ -1 THEN TABKEY(SCREENST"FTAB",SCRPOS,FIELD,SCRPOS);
      TERHELPFLD[0] = FIELD;
      FIELD = -1;
      END
    ELSE
      BEGIN                          # GIVE HELP FOR THIS FIELD #
      TERHELPFLD[0] = FIELD;
      END
    TERHELPREQ[0] = TRUE;
    END
  RETURN;
 
MATCHADV:                            # ADVANCE MATCH ENTRY #
 
  IF TERSOFTTAB[0] NQ 0 OR NOT VALIDFIELD THEN GOTO TABSOFTLY;
  IF FIELD EQ -1 THEN GOTO TABSOFTLY;
  VARIND = FLDVARORD[FIELD];
  IF (NOT VARVALM[VARIND]) OR (VARVALOS[VARIND] EQ 0)
    THEN GOTO TABSOFTLY;
  FMATCH(FIELD,MATCHIND,MATCHCOUNT);
  IF PANVERSION[0] GR 0 THEN
    BEGIN                            # IF ENTRIES CAN BE ANY LENGTH #
    MATCHIND = MATCHIND + (FLDLENGTH[FIELD]+9)/10;
    END
  ELSE
    BEGIN                            # IF ENTRIES ONLY 10 CHARACTERS #
    MATCHIND = MATCHIND + 1;
    END
  IF MATCHWORD[MATCHIND] EQ 0 THEN MATCHIND = 0;  # IF WRAPAROUND #
  MMATCH(MATCHIND,FIELD);            # MOVE MATCH ENTRY TO FIELD #
  RETURN;
 
END  # FUNKEY#
CONTROL EJECT;
 
PROC GETADD(PANELNAME,PANELADDR,PLTINDEX);
 
# TITLE GETADD - GETS PANEL ADDRESS. #
 
BEGIN  # GETADD #
 
#
**    GETADD - GET ADDRESS.
*
*     THIS PROCEDURE GETS THE MEMORY ADDRESS FOR THE SPECIFIED
*     PANEL FROM THE PANEL LOAD TABLE.  IF THE PANEL IS NOT IN
*     THE PANEL LOAD TABLE OR HAS NOT BEEN OPENED FOR USE THEN
*     A DAYFILE MESSAGE WILL BE ISSUED AND CONTROL WILL BE RE-
*     TURNED TO THE OPERATING SYSTEM.
*
*     PROC GETADD(PANELNAME,PANELADDR,PLTINDEX)
*
*     ENTRY   PANELNAME  = THE NAME OF THE PANEL.
*
*     EXIT    PANELADDR  = THE ADDRESS OF THE PANEL RECORD.
*                          TO O.S. IF THE ADDRESS IS NOT FOUND
*                          OR THE PANEL IS NOT OPEN.
*             PLTINDEX   = THE PANEL LOAD TABLE INDEX FOR THE PANEL.
*
*     CALLS   ERRMSG.
*
*     NOTES   IF THE PANEL IS NOT IN THE PANEL LOAD TABLE THEN
*             THE APPLICATION HAS NOT OPENED THE PANEL FOR USE
*             OR HAS IGNORED AN ERROR RETURN FROM SFOPEN AFTER
*             ATTEMPTING TO DO SO.  IF THE PANEL IS IN THE LOAD
*             TABLE BUT NOT OPEN IT IS A STATICALLY LOADED PANEL
*             THAT THE APPLICATION HAS NOT YET OPENED.  IN EITHER
*             CASE PROCEDURE ERRMSG IS CALLED TO ISSUE A DAYFILE
*             MESSAGE AND RETURN CONTROL TO THE OPERATING SYSTEM.
#
ITEM PANELNAME  C(7);                # PANEL NAME #
ITEM PANELADDR  I;                   # PANEL ADDRESS #
ITEM PLTINDEX   I;                   # PANEL LOAD TABLE INDEX #
 
ITEM CHARINDEX  I;                   # CHARACTER INDEX #
ITEM FATAL      B = TRUE;            # FATAL ERROR #
ITEM INDEX      I;                   # INDEX INTO PANEL LOAD TABLE #
ITEM MSG        C(25) = " NOT OPENED.             ";  # ERROR MSG. #
ITEM PNAME      C(6);                # PROCEDURE NAME #
 
PANELADDR = 0;
FOR INDEX = 1 STEP 1 WHILE PANELADDR EQ 0
  AND INDEX LQ PLTNUMENT[0] DO
  BEGIN                              # FIND SPECIFIED PANEL #
  IF PLTENAME[INDEX] EQ PANELNAME
    AND PLTOPENFLG[INDEX] THEN
    BEGIN                            # IF SPECIFIED PANEL FOUND #
    PANELADDR = PLTADDR[INDEX];      # RETURN ADDRESS #
    PLTINDEX = INDEX;
    RETURN;
    END
  END
 
IF TERSHOWFLG[0] THEN
  BEGIN                              # IF SFSSHO CALL #
  PNAME = "SFSSHO";
  END
ELSE
  BEGIN                              # IF SFSREA CALL #
  IF TERREADFLG[0] THEN
    BEGIN
    PNAME = "SFSREA";
    END
  ELSE                               # SFSWRI CALL #
    BEGIN
    PNAME = "SFSWRI";
    END
  END
ERRMSG(PANELNAME,PNAME,MSG,FATAL);   # ISSUE MESSAGE AND ABORT #
 
END  # GETADD #
CONTROL EJECT;
 
PROC GETNUM(FLDIND,CHARPOS,VALUE,NUMDIG);
 
# TITLE GETNUM - GET NUMERIC VALUE OF SUBFIELD. #
 
BEGIN  # GETNUM #
 
#
**    GETNUM - GET NUMERIC VALUE OF SUBFIELD.
*
*     GETNUM GETS THE NUMERIC VALUE OF A SUBFIELD STARTING AT
*     CHARPOS AND ENDING AT THE FIRST NON-NUMERIC INPUT OR AT
*     THE END OF THE FIELD.
*
*     PROC GETNUM(FLDIND,CHARPOS,VALUE,NUMDIG)
*
*     ENTRY   FLDIND     = INDEX IN FLDLIST.
*             CHARPOS    = STARTING CHARACTER POSITION IN FIELD.
*             VALUE      = STARTING VALUE.
*
*     EXIT    CHARPOS    = ENDING CHARACTER POSITION IN FIELD.
*             VALUE      = ENDING VALUE.
*             NUMDIG     = NUMBER OF DIGITS IN SUBFIELD.
#
ITEM FLDIND     I;                   # INDEX IN FLDLIST #
ITEM CHARPOS    I;                   # POSITION OF CHARACTER IN FIELD #
ITEM VALUE      I;                   # NUMERIC VALUE OF SUBFIELD #
ITEM NUMDIG     I;                   # NUMBER OF DIGITS IN SUBFIELD #
 
ITEM CHAR       I;                   # INPUT CHARACTER #
ITEM SAMESUBFLD B;                   # STILL IN SAME SUBFIELD #
 
SAMESUBFLD = TRUE;
NUMDIG = 0;
 
WHYLE SAMESUBFLD AND CHARPOS LQ FLDLENGTH[FLDIND] -1 DO
  BEGIN
  CHAR = NEXTCHAR(FLDIND,CHARPOS);
  IF CHAR GQ ZEROCH AND CHAR LQ NINECH THEN
    BEGIN                            # IF CHARACTER IS NUMERIC #
    VALUE = 10 * VALUE + (CHAR LXR ZEROCH);
    NUMDIG = NUMDIG + 1;
    CHARPOS = CHARPOS + 1;
    END
  ELSE
    BEGIN                            # END OF SUBFIELD #
    SAMESUBFLD = FALSE;
    END
  END
 
END  # GETNUM #
CONTROL EJECT;
 
PROC GFIELD(VARNAME,USEROW,FLDIND);
 
# TITLE GFIELD - GET FIELD INDEX. #
 
BEGIN  # GFIELD #
 
#
**    GFIELD - GET FIELD INDEX.
*
*     THIS PROCEDURE GETS THE FIELD INDEX FOR THE VARIABLE VARNAME.
*
*     PROC GFIELD(VARNAME,USEROW,FLDIND)
*
*     ENTRY   VARNAME    = VARIABLE NAME OF FIELD.
*             USEROW     = TRUE, USE TERCURSROW.
*                        = FALSE, USE ARRCURROW.
*
*     EXIT    FLDIND     = FIELD INDEX.
*                        = -1 IF NOT FOUND.
#
ITEM VARNAME    C(7);                # VARIABLE NAME OF FIELD #
ITEM USEROW     B;                   # USE TERCURSROW #
ITEM FLDIND     I;                   # POINTER TO FIELD LIST #
 
ITEM ARRAYORD   I;                   # ARRAY ORDINAL #
ITEM FOUND      B;                   # FIELD HAS BEEN FOUND #
ITEM I          I;                   # LOOP COUNTER #
ITEM ROWNUMBER  I;                   # ROW NUMBER #
ITEM VARIND     I;                   # POINTER TO VARIABLE LIST #
 
FLDIND = -1;
FOUND = FALSE;
 
FOR I = 0 STEP 1 WHILE VARTYPE[I] NQ 0 AND NOT FOUND DO
  BEGIN                              # LOOK FOR VARIABLE VARNAME #
  IF VARNME[I] EQ VARNAME THEN
    BEGIN                            # FOUND SPECIFIED VARIABLE #
    FOUND = TRUE;
    VARIND = I;
    END
  END
 
IF FOUND THEN
  BEGIN
  ARRAYORD = VARARRORD[VARIND];
  IF ARRAYORD NQ 0 THEN
    BEGIN                            # ARRAY MEMBER #
    ROWNUMBER = 0;
    IF USEROW THEN
      BEGIN                          # USE TERCURSROW #
      IF TERCURSSET[0] AND TERCURSROW[0] LS ARRNUMROWS[ARRAYORD-1] THEN
        BEGIN                        # VALID ROW NUMBER #
        ROWNUMBER = TERCURSROW[0];
        END
      END
    ELSE
      BEGIN                          # USE CURRENT ROW #
      ROWNUMBER = ARRCURROW[ARRAYORD-1];
      END
    VARIND = VARIND + ARRNUMVARS[ARRAYORD-1]*ROWNUMBER;
    END
  FLDIND = VARFLDNUM[VARIND] - 1;    # ADJUST PDU VALUE #
  END
 
END  # GFIELD #
CONTROL EJECT;
 
PROC IRANGE(FLDIND,VALUE,EVALUE);
 
# TITLE IRANGE - RANGE VALIDATION FOR INTEGER VARIABLES. #
 
BEGIN  # IRANGE #
 
#
**    IRANGE - RANGE VALIDATION FOR INTEGER VARIABLES.
*
*     THIS PROCEDURE VALIDATES THAT INPUT TO THE FIELD POINTED TO
*     BY FLDIND IS WITHIN THE RANGE SPECIFIED IN THE PANEL RECORD.
*
*     PROC IRANGE(FLDIND,VALUE,EVALUE)
*
*     ENTRY   FLDIND     = INDEX OF CURRENT FIELD IN FLDLIST.
*             VALUE      = THE INTEGER VALUE OF THE INPUT.
*             EVALUE     = THE EXPONENT VALUE OF THE INPUT
*
*     EXIT    FLDVALID[FLDIND] = FALSE, IF INPUT IS INVALID.
#
ITEM FLDIND     I;                   # INDEX OF VARIABLE TO VALIDATE #
ITEM VALUE      I;                   # INTEGER VALUE OF INPUT #
ITEM EVALUE     I;                   # EXPONENT VALUE OF INPUT #
 
ITEM MAXVAL     I;                   # MAXIMUM ALLOWED VALUE #
ITEM MINVAL     I;                   # MINIMUM ALLOWED VALUE #
ITEM OFFSET     I;                   # OFFSET OF VALIDATION IN RECORD #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
 
VARIND = FLDVARORD[FLDIND];
OFFSET = VARVALOS[VARIND];
MINVAL = RECWORDU[OFFSET];           # MINIMUM VALID VALUE #
MAXVAL = RECWORDU[OFFSET + 1];       # MAXIMUM VALID VALUE #
 
IF VARPICTYPE[FLDVARORD[FLDIND]] EQ FORMTYPE"$" THEN
  BEGIN                              # WEIGHT CURRENCY INPUT #
  IF EVALUE EQ 0 THEN
    BEGIN
    VALUE = VALUE * 100;
    END
  ELSE
    BEGIN
    IF EVALUE EQ -1 THEN VALUE = VALUE * 10;
    END
  END
 
IF VALUE LS MINVAL OR VALUE GR MAXVAL THEN
  BEGIN                              # IF VALUE OUTSIDE OF RANGE #
  FLDVALID[FLDIND] = FALSE;
  END
 
END  # IRANGE #
CONTROL EJECT;
 
PROC MATCHV(FLDIND);
 
# TITLE MATCHV - MATCH VALIDATION. #
 
BEGIN  # MATCHV #
 
#
**    MATCHV - MATCH VALIDATION.
*
*     THIS PROCEDURE PERFORMS MATCH VALIDATION FOR THE VARIABLE
*     USING THE MATCH LIST IN THE PANEL RECORD.
*
*     PROC MATCHV(FLDIND)
*
*     ENTRY   FLDIND     = POINTER INTO FLDLIST OF CURRENT FIELD.
*
*     EXIT    FLDVALID[FLDIND] = FALSE, IF INPUT IS INVALID.
*
*     CALLS   FMATCH, MMATCH.
#
ITEM FLDIND     I;                   # INDEX OF FIELD IN FLDLIST #
 
ITEM MATCHIND   I;                   # INDEX INTO MATCHLIST #
ITEM MATCHCOUNT I;                   # NUMBER OF VALID MATCHES #
 
IF VARVALOS[FLDVARORD[FLDIND]]
  EQ 0 THEN RETURN;                  # IF NO VALIDATION REQUIRED #
 
FMATCH(FLDIND,MATCHIND,MATCHCOUNT);  # FIND MATCH #
 
IF ABS(MATCHCOUNT) NQ 1 THEN
  BEGIN                              # NO MATCH OR TOO MANY MATCHES #
  FLDVALID[FLDIND] = FALSE;
  END
ELSE
  BEGIN                              # EXACT OR PARTIAL MATCH FOUND #
  MMATCH(MATCHIND,FLDIND);           # RETURN IDENTICAL MATCH VALUE #
  END
 
END  # MATCHV #
CONTROL EJECT;
 
PROC MCLEAN(MCOUNT,MSGFIT);
 
# TITLE MCLEAN - MESSAGE CLEAN. #
 
BEGIN  # MCLEAN #
 
#
**    MCLEAN - MESSAGE CLEAN.
*
*     THIS PROCEDURE CLEANS THE MESSAGE AREA.
*
*     PROC MCLEAN(MCOUNT,MSGFIT)
*
*     EXIT    MCOUNT     = THE LENGTH OF THE MESSAGE AREA.
*             MSGFIT     = TRUE, IF LONGEST MESSAGE WILL FIT.
*
*     CALLS     VDTCHR, VDTCLL, VDTPOS, VDTSAM.
*
*     USES      TERMESWRIT.
#
ITEM MCOUNT     I;                   # LENGTH OF MESSAGE AREA #
ITEM MSGFIT     B;                   # TRUNCATION FLAG #
 
ITEM I          I;                   # LOOP VARIABLE #
 
IF PANMSGLEN[0] LS TERNUMCOLS[0] THEN
  BEGIN                              # IF LONGEST MESSAGE FITS #
  MSGFIT = TRUE;
  MCOUNT = PANMSGLEN[0] -1;
  IF MCOUNT LS 24 THEN MCOUNT = 24;  # LONGEST SMF MESSAGE #
  END
ELSE
  BEGIN                              # USER HELP MAY NEED TRUNCATION #
  MSGFIT = FALSE;
  MCOUNT = TERNUMCOLS[0] - 1;
  END
 
VDTSAM(ATTMASK[0]);                  # SET MESSAGE ATTRIBUTES #
IF TERTABPROT[0] THEN
  BEGIN                              # IF TABS TO UNPROTECTED TRUE #
  VDTPOS(0,0);                       # POSITION TO MESSAGE AREA #
  FOR I = 0 STEP 1 UNTIL MCOUNT DO
    BEGIN                            # BLANK OUT MESSAGE AREA #
    VDTCHR(BLANK);
    END
  END
ELSE
  BEGIN                              # NO PROTECT #
  VDTCLL(0,0);                       # POSITION AND CLEAR LINE #
  END
 
TERMESWRIT[0] = FALSE;               # CLEAR MESSAGE WRITTEN FLAG #
 
END  # MCLEAN #
CONTROL EJECT;
 
PROC MMATCH(MATCHIND,FIELD);
 
# TITLE MMATCH - MOVE MATCH VALUE INTO VARIABLE FIELD . #
 
BEGIN  # MMATCH #
 
#
**    MMATCH - MOVE MATCH VALUE INTO VARIABLE FIELD.
*
*     THIS PROCEDURE MOES THE MATCH VALUE INTO THE VARIABLE FIELD
*     IN VARDATA.
*
*     PROC MMATCH(MATCHIND,FIELD)
*
*     ENTRY   MATCHIND   = INDEX INTO MATCHLIST FOR MATCH TO MOVE.
*             FIELD      = INDEX OF FIELD TO RECEIVE MATCH VALUE.
*
*     EXIT    FLDENTERED, FLDVALID AND FLDREWRITE FLAGS SET FOR
*             VARIABLE, AS WELL AS TERREWFLDS, MATCH VALUE MOVED.
*
*     CALLS   WRIVCH.
*
*     USES    TERREWFLDS.
#
ITEM MATCHIND   I;                   # INDEX INTO MATCHLIST #
ITEM MATCHLEN   I;                   # MATCH ENTRY LENGTH #
ITEM FIELD      I;                   # INDEX OF FIELD IN FLDLIST #
 
ITEM CHAR       I;                   # 12-BIT CHARACTER #
ITEM I          I;                   # CHARACTER INDEX #
 
MATCHLEN = FLDLENGTH[FIELD];
IF PANVERSION[0] EQ 0 THEN MATCHLEN = 10;
FOR I = 0 STEP 1 UNTIL FLDLENGTH[FIELD] - 1 DO
  BEGIN                              # MOVE MATCH ENTRY TO FIELD #
  IF I LS MATCHLEN THEN
    BEGIN                            # IF NO BLANK FILL NEEDED #
    CHAR = C&lt;I*2,2>MATCH[MATCHIND];
    END
  ELSE
    BEGIN                            # MORE THAN TEN CHARACTERS #
    CHAR = BLANK;
    END
  WRIVCH(FIELD,I,CHAR);              # WRITE CHARACTER INTO VARDATA #
  END
 
TERREWFLDS[0] = TRUE;                # SET REWRITE, ENTERED AND VALID #
FLDVALID[FIELD] = TRUE;
FLDENTERED[FIELD] = TRUE;
FLDREWRITE[FIELD] = TRUE;
 
END  # MMATCH #
CONTROL EJECT;
 
PROC MOVEFLD(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,IOSTAT);
  BEGIN
#
**    MOVEFLD - MOVE FIELD.
*
*     MOVEFLD TRANSFERS CHARACTERS TO/FROM A SPECIFIED PANEL FIELD
*     FROM/TO A SPECIFIED STRING.
*
*     PROC MOVEFLD(VNAME,VLEN,VOS,STRG,SLEN,SOS,CSET,CLEN,COS,IOSTAT)
*
*     ENTRY   VNAME     = VARIABLE NAME OF FIELD.
*             VLEN      = LENGTH OF VARNAME PARAMETER.
*             VOS       = OFFSET OF VARNAME PARAMETER.
*             STRG      = VARIABLE FIELD STRING.
*             SLEN      = LENGTH OF STRING PARAMETER.
*             SOS       = OFFSET OF STRING PARAMETER.
*             CSET      = CHARACTER SET OF STRING (SEE SFCSET$).
*             CLEN      = LENGTH OF CSET PARAMETER.
*             COS       = OFFSET OF CSET PARAMETER.
*             IOSTAT    = 0, CALL WAS SFGETF.
*                       = 1, CALL WAS SFSETF.
*
*     EXIT    STRING MOVED, AND TRANSLATED IF NECESSARY.
*             IOSTAT   GQ 0, NUMBER OF 6 BIT CHARACTERS MOVED.
*                      LS 0, VARIABLE NOT FOUND IN ACTIVE PANELS.
#
 
  ITEM VNAME      C(11);             # VARIABLE NAME #
  ITEM VLEN       I;                 # LENGTH OF VARNAME PARAMETER #
  ITEM VOS        I;                 # OFFSET INTO VARNAME PARAMETER #
  ITEM STRG       C(11);             # INSTRING PARAMETER #
  ITEM SLEN       I;                 # LENGTH OF INSTRING #
  ITEM SOS        I;                 # OFFSET INTO INSTRING #
  ITEM CSET       C(11);             # CHARACTER SET #
  ITEM CLEN       I;                 # LENGTH OF CHARACTER SET #
  ITEM COS        I;                 # OFFSET INTO CHARACTER SET #
  ITEM IOSTAT     I;                 # MOVE DIRECTION, STATUS RETURN #
 
  ITEM ASCFLAG    B;                 # CURRENT DEFAULT CHARACTER SET #
  ITEM AS8FLAG    B;                 # FLAGS #
  ITEM CHARIND    I;                 # VARDATA WORD CHARACTER INDEX #
  ITEM CHARNUM    I;                 # START OF FIELD IN VARDATA #
  ITEM FLDIND     I;                 # FIELD ORDINAL #
  ITEM FLDLEN     I;                 # FIELD LENGTH #
  ITEM FROMCHAROS I;                 # SOURCE STRING OFFSET #
  ITEM I          I;                 # LOOP COUNTER #
  ITEM TOCHAROS   I;                 # DESTINATION STRING OFFSET #
  ITEM USEROW     B = FALSE;         # DON-T USE CURSORROW #
  ITEM VAR        C(7);              # VARIABLE NAME LEFT JUSTIFIED #
  ITEM WORDIND    I;                 # WORD INDEX INTO VARDATA #
 
 
  IF VLEN LS 1 THEN VLEN = 7;
  VAR = C&lt;VOS,VLEN>VNAME;
  GFIELD(VAR,USEROW,FLDIND);         # GET ASSOCIATED FIELD #
  IF FLDIND LS 0 THEN
    BEGIN                            # IF FIELD NOT FOUND #
    IOSTAT = -1;
    RETURN;
    END
  ASCFLAG = TERASCFLAG[0];           # SAVE CURRENT CHARACTER SET #
  AS8FLAG = TERAS8FLAG[0];
  IF C&lt;COS,1>CSET NQ " " THEN SFCSET$(CSET,CLEN,COS);
  CHARNUM = FLDVDTCORD[FLDIND];      # START OF FIELD IN VARDATA #
  WORDIND = CHARNUM/5;               # WORD INDEX INTO VARDATA #
  CHARIND = CHARNUM - (5 * WORDIND); # VARDATA WORD CHARACTER INDEX #
  FLDLEN = FLDLENGTH[FLDIND];
  IF IOSTAT EQ 0 THEN
    BEGIN                            # IF MOVING VARDATA TO INSTRING #
    P&lt;FROMSTRING> = LOC(VDATAU[WORDIND]);
    P&lt;TOSTRING> = LOC(STRG);
    TOCHAROS = SOS;                  # CHARACTER OFFSET / TO STRING #
    FROMCHAROS = CHARIND*2;          # CHARACTER OFFSET / VARDATA   #
    IF TERAS8FLAG[0] THEN
      BEGIN                          # IF NO TRANSLATION REQUIRED #
      IF SLEN LQ 0 THEN SLEN = FLDLEN * 2;
      MVA8A8(FROMCHAROS,TOCHAROS,FLDLEN*2,SLEN,TRUE);
      END
    ELSE
      BEGIN
      IF TERASCFLAG[0] THEN
        BEGIN                        # IF 6/12 ASCII #
        MVA8AS(TOCHAROS,FROMCHAROS,SLEN,FLDLEN,TRUE);
        END
      ELSE
        BEGIN                        # IF SIX BIT DISPLAY CODE #
        MVA8DC(TOCHAROS,FROMCHAROS,SLEN,FLDLEN,TRUE);
        END
      END
    END
  ELSE
    BEGIN                            # IF MOVING OUTSTRING TO VARDATA #
    P&lt;FROMSTRING> = LOC(STRG);
    FROMCHAROS = SOS;                # CHARACTER OFFSET / FROM STRING #
    P&lt;TOSTRING> = LOC(VDATAU[WORDIND]);
    TOCHAROS = CHARIND * 2;          # CHARACTER OFFSET / VARDATA #
    IF TERAS8FLAG[0] THEN
      BEGIN                          # IF NO TRANSLATION REQUIRED #
      IF SLEN LQ 0 THEN SLEN = FLDLEN * 2;
      MVA8A8(FROMCHAROS,TOCHAROS,SLEN,FLDLEN*2,TRUE);
      END
    ELSE
      BEGIN
      IF TERASCFLAG[0] THEN
        BEGIN                        # IF 6/12 ASCII #
        MVASA8(FROMCHAROS,TOCHAROS,SLEN,FLDLEN,TRUE);
        END
      ELSE
        BEGIN                        # IF SIX BIT DISPLAY CODE #
        MVDCA8(FROMCHAROS,TOCHAROS,SLEN,FLDLEN,TRUE);
        END
      END
    FLDREWRITE[FLDIND] = TRUE;
    TERREWFLDS[0] = FALSE;           # REWRITE UPDATED FIELD #
    REWFLD;
    TERREWFLDS[0] = TRUE;            # RESET FLAG TO DEFAULT #
    END
  TERASCFLAG[0] = ASCFLAG;           # RESTORE INITIAL VALUES #
  TERAS8FLAG[0] = AS8FLAG;
  IOSTAT = SLEN;
  RETURN;
 
END  # MOVEFLD#
CONTROL EJECT;
 
PROC MOVEST(STRINGADDR,STRINGOS,SLENGTH);
 
# TITLE MOVEST - MOVE STRING. #
 
BEGIN  # MOVEST #
 
#
**    MOVEST - MOVE STRING.
*
*     THIS PROCEDURE POSITIONS THE BASED ARRAYS TOSTRING
*     AND FROMSTRING AND THEN CALLS THE PROPER PROCEDURE
*     TO DO THE ACTUAL TRANSLATION AND TO MOVE THE STRING
*     FROM OUTSTRING TO VARDATA (IF A WRITE OPERATION IS
*     STARTING) OR FROM VARDATA TO INSTRING (IF A READ
*     OPERATION IS FINISHED).
*
*     PROC MOVEST(STRINGADDR,STRINGOS,SLENGTH)
*
*     ENTRY   STRINGADDR = THE FIRST WORD ADDRESS OF INSTRING
*                          OR OUTSTRING (DEPENDING ON WHICH
*                          DIRECTION THE CHARACTER DATA IS
*                          BEING MOVED).
*             STRINGOS   = CHARACTER OFFSET (IN SIX BIT CHAR-
*                          CTERS) INTO EITHER INSTRING OR OUT-
*                          STRING (DEPENDING ON WHICH DIRECTION
*                          THE CHARACTER DATA IS BEING MOVED).
*             SLENGTH    = LENGTH IN SIX BIT CHARACTERS.
*             TERREADFLG = TRUE, IF MOVING FROM VARDATA TO INSTRING
*                          DURING AN SFSREA CALL, FALSE IF MOVING
*                          FROM OUTSTRING TO VARDATA DURING AN SFS-
*                          WRI CALL.
*
*     EXIT    STRING MOVED, AND TRANSLATED IF NECESSARY.
*
*     CALLS   MVASA8, MVA8AS, MVA8A8, MVA8DC, MVDCA8.
#
ITEM STRINGADDR I;                   # ADDRESS OF IN/OUTSTRING #
ITEM STRINGOS   I;                   # CHARACTER OFFSET INTO STRING #
ITEM SLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
 
ITEM FROMCHAROS I;                   # CHARACTER OFFSET / FROM STRING #
ITEM TOCHAROS   I;                   # CHARACTER OFFSET / TO STRING #
 
IF NOT TERREADFLG[0] THEN
  BEGIN                              # IF MOVING OUTSTRING TO VARDATA #
  P&lt;FROMSTRING> = STRINGADDR;        # POSITION FROM AND TO STRING #
  P&lt;TOSTRING> = LOC(VDATAU[0]);
  FROMCHAROS = STRINGOS;             # CHARACTER OFFSET / FROM STRING #
  TOCHAROS = 0;                      # NO CHARACTER OFFSET / VARDATA #
  IF TERAS8FLAG[0] THEN
    BEGIN                            # IF NO TRANSLATION REQUIRED #
    IF SLENGTH LQ 0 THEN SLENGTH = PANNUMBYTE[0] * 2;
    MVA8A8(FROMCHAROS,TOCHAROS,SLENGTH,PANNUMBYTE[0]*2,FALSE);
    END
  ELSE
    BEGIN
    IF TERASCFLAG[0] THEN
      BEGIN                          # IF SIX TWELVE ASCII #
      MVASA8(FROMCHAROS,TOCHAROS,SLENGTH,PANNUMBYTE[0],FALSE);
      END
    ELSE
      BEGIN                          # IF SIX BIT DISPLAY CODE #
        MVDCA8(FROMCHAROS,TOCHAROS,SLENGTH,PANNUMBYTE[0],FALSE);
      END
    END
  END
ELSE
  BEGIN                              # IF MOVING VARDATA TO INSTRING #
  P&lt;FROMSTRING> = LOC(VDATAU[0]);    # POSITION FROM AND TO STRING #
  P&lt;TOSTRING> = STRINGADDR;
  TOCHAROS = STRINGOS;               # CHARACTER OFFSET / TO STRING #
  FROMCHAROS = 0;                    # NO CHARACTER OFFSET / VARDATA #
  IF TERAS8FLAG[0] THEN
    BEGIN                            # IF NO TRANSLATION REQUIRED #
    IF SLENGTH LQ 0 THEN SLENGTH = PANNUMBYTE[0] * 2;
    MVA8A8(FROMCHAROS,TOCHAROS,PANNUMBYTE[0]*2,SLENGTH,FALSE);
    END
  ELSE
    BEGIN
    IF TERASCFLAG[0] THEN
      BEGIN                          # IF SIX TWELVE ASCII #
      MVA8AS(TOCHAROS,FROMCHAROS,SLENGTH,PANNUMBYTE[0],FALSE);
      END
    ELSE
      BEGIN                          # IF SIX BIT DISPLAY CODE #
      MVA8DC(TOCHAROS,FROMCHAROS,SLENGTH,PANNUMBYTE[0],FALSE);
      END
    END
  END
 
END  # MOVEST #
CONTROL EJECT;
 
PROC MVA8A8(FROMCHAROS,TOCHAROS,FROMLENGTH,TOLENGTH,FILL);
 
# TITLE MVA8A8 - MOVE ASCII8 STRING. #
 
BEGIN  # MVA8A8 #
 
#
**    MVA8A8 - MOVE ASCII8 STRING.
*
*     THIS PROCEDURE MOVES THE ASCII8 CHARACTER DATA FROM OUTSTRING
*     TO VARDATA BEFORE A WRITE, OR FROM VARDATA TO INSTRING AFTER
*     A READ, USING THE BASED ARRAYS FROMSTRING AND TOSTRING.  IF THE
*     DESTINATION FIELD IS SHORTER THAN THE SOURCE FIELD, THE STRING
*     WILL BE TRUNCATED.  IF THE SOURCE FIELD IS SHORTER AND *FILL* IS
*     *TRUE*, THE DESTINATION FIELD WILL BE BLANK FILLED.
*
*     PROC MVA8A8(FROMCHAROS,TOCHAROS,FROMLENGTH,TOLENGTH,FILL)
*
*     ENTRY   BASED ARRAYS FROMSTRING AND TOSTRING POSITIONED.
*             FROMCHAROS = THE CHARACTER OFFSET INTO FROMSTRING.
*             TOCHAROS   = THE CHARACTER OFFSET INTO TOSTRING.
*             FROMLENGTH = LENGTH OF SOURCE FIELD.
*             TOLENGTH   = LENGTH OF DESTINATION FIELD.
*             FILL       = TRUE IF BLANK FILL REQUIRED.
*
*     EXIT    STRING MOVED.
*
*     NOTE    THE FIELD LENGTHS SPECIFY THE NUMBER OF SIX-BIT PARCELS
*             RATHER THAN THE NUMBER OF TWELVE-BIT CHARACTERS.
#
ITEM FROMCHAROS I;                   # CHARACTER OFFSET / FROM STRING #
ITEM TOCHAROS   I;                   # CHARACTER OFFSET / TO STRING #
ITEM FROMLENGTH I;                   # FROM STRING LENGTH #
ITEM TOLENGTH   I;                   # TO STRING LENGTH #
ITEM FILL       B;                   # TRUE IF BLANK FILL REQUIRED #
 
ITEM FROMINDEX  I;                   # INDEX INTO FROMSTRING #
ITEM NUMCHARS   I;                   # NUMBER OF PARCELS TO MOVE #
ITEM SPACE      I = BLANK;           # ASCII SPACE FOR BLANK FILL #
ITEM TOINDEX    I;                   # INDEX INTO TOSTRING #
 
FROMINDEX = 0;                       # GET FIRST WORD FROM FROMSTRING #
TOINDEX = 0;                         # SET TOSTRING INDEX #
IF TOLENGTH LS FROMLENGTH THEN FROMLENGTH = TOLENGTH;
FOR NUMCHARS = 1 STEP 2 UNTIL FROMLENGTH DO
  BEGIN                              # TRANSFER SIX BIT PARCELS #
  C&lt;TOCHAROS,2>TOSTRIU[TOINDEX] =
    C&lt;FROMCHAROS,2>FROMSTRIU[FROMINDEX];
  FROMCHAROS = FROMCHAROS + 2;       # INCREMENT FROMSTRING OFFSET #
  IF FROMCHAROS EQ 10 THEN
    BEGIN                            # IF FROMSTRING WORD IS EMPTY #
    FROMCHAROS = 0;                  # RESET CHARACTER OFFSET #
    FROMINDEX = FROMINDEX + 1;       # UPDATE FROMSTRING WORD INDEX #
    END
  TOCHAROS = TOCHAROS + 2;           # INCREMENT TOSTRING OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD IS FULL #
    TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
    TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
    END
  END
WHYLE FILL AND FROMLENGTH LS TOLENGTH DO
  BEGIN
  TOLENGTH = TOLENGTH - 2;
  C&lt;TOCHAROS,2>TOSTRIU[TOINDEX] = B&lt;48,12>SPACE;
  TOCHAROS = TOCHAROS + 2;           # UPDATE TOSTRING OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD EXHAUSTED #
    TOINDEX = TOINDEX + 2;           # UPDATE TOSTRING WORD INDEX #
    TOCHAROS = 0;
    END
  END
 
END  # MVA8A8 #
CONTROL EJECT;
 
PROC MVASA8(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL);
 
# TITLE MVASA8 - MOVE AND TRANSLATE ASCII TO ASCII8. #
 
BEGIN  # MVASA8 #
 
#
**    MVASA8 - MOVE AND TRANSLATE ASCII TO ASCII8.
*
*     THIS PROCEDURE MOVES THE CHARACTER DATA FROM OUTSTRING TO
*     VARDATA BEFORE A WRITE, USING THE BASED ARRAYS FROMSTRING
*     AND TOSTRING, TRANSLATING FROM ASCII TO ASCII8.
*
*     PROC MVASA8(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL)
*
*     ENTRY   BASED ARRAYS FROMSTRING AND TOSTRING POSITIONED.
*             STRINGOS   = THE CHARACTER OFFSET INTO OUTSTRING.
*             VAROS      = THE CHARACTER OFFSET INTO VARDATA.
*             SLENGTH    = OUTSTRING LENGTH IN SIX BIT CHARACTERS.
*             NUMVDCHARS = NUMBER OF CHARACTERS IN VARDATA.
*             FILL       = TRUE IF BLANK FILL REQUIRED.
*
*     EXIT    STRING MOVED AND TRANSLATED.
*
*     NOTE    SLENGTH IS NOT NECESSARILY THE NUMBER OF CHARACTERS
*             (SINCE THEY CAN BE EITHER SIX OR TWELVE BITS LONG) BUT
*             RATHER THE NUMBER OF SIX BIT PARCELS IN OUTSTRING.
#
ITEM STRINGOS   I;                   # CHARACTER OFFSET / OUTSTRING #
ITEM SLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM VAROS      I;                   # CHARACTER OFFSET / VARDATA #
ITEM NUMVDCHARS I;                   # NUMBER OF CHARS. IN VARDATA #
ITEM FILL       B;                   # TRUE IF BLANK FILL REQUIRED #
 
ITEM ASCIICHR   I;                   # HOLDS AN ASCII CHARACTER #
ITEM ASCII8CHR  I;                   # HOLDS AN ASCII8 CHARACTER #
ITEM ESCAPECODE I;                   # ESCAPE CODE FOR 12 BIT CHARS. #
ITEM FROMCHAROS I;                   # CHARACTER OFFSET / FROMSTRING #
ITEM FROMINDEX  I;                   # INDEX INTO FROMSTRING #
ITEM NUMOTCHARS I;                   # NUMBER OF CHARS. IN OUTSTRING #
ITEM SPACE      I = BLANK;           # ASCII SPACE FOR BLANK FILL #
ITEM TOCHAROS   I;                   # CHARACTER OFFSET / TOSTRING #
ITEM TOINDEX    I;                   # INDEX INTO TOSTRING #
 
FROMINDEX = 0;                       # GET FIRST WORD FROM FROMSTRING #
FROMCHAROS = STRINGOS;               # CHARACTER OFFSET IN FROMSTRING #
TOINDEX = 0;                         # START AT BEGINNING OF VARDATA #
TOCHAROS = VAROS;                    # CHARACTER OFFSET IN VARDATA #
ESCAPECODE = 0;                      # CLEAR ESCAPE CODE #
IF SLENGTH GR NUMVDCHARS * 2 OR SLENGTH LQ 0 THEN
  SLENGTH = NUMVDCHARS * 2;          # IF LENGTH ADJUSTMENT NEEDED #
NUMOTCHARS = 0;                      # INITIALIZE LOOP #
WHYLE NUMOTCHARS LS SLENGTH AND NUMVDCHARS GR 0 DO
  BEGIN                              # TRANSLATE CHARACTERS #
  NUMOTCHARS = NUMOTCHARS + 1;       # INCREMENT OUTSTRING COUNT #
  ASCIICHR = B&lt;6*FROMCHAROS,6>FROMSTRIU[FROMINDEX];
  FROMCHAROS = FROMCHAROS + 1;       # UPDATE FROMSTRING CHAR. OFFSET #
  IF FROMCHAROS EQ 10 THEN
    BEGIN                            # IF FROMSTRING WORD EXHAUSTED #
    FROMINDEX = FROMINDEX + 1;       # UPDATE FROMSTRING WORD INDEX #
    FROMCHAROS = 0;
    END
  IF ESCAPECODE NQ 0 THEN
    BEGIN                            # IF HALF WAY THROUGH TWELVE BIT #
    IF ESCAPECODE EQ 62 THEN
      BEGIN                          # IF LOWER CASE ALPHABETIC #
      ASCII8CHR = ASCIICHR + 96;
      END
    ELSE
      BEGIN                          # IF SPECIAL ASCII CHARACTER #
      ASCII8CHR = AS2A8[ASCIICHR];
      END
    ESCAPECODE = 0;                  # CLEAR ESCAPE CODE #
    END
  ELSE
    BEGIN                            # IF SIX BIT ASCII CHARACTER #
    IF ASCIICHR NQ 60 AND ASCIICHR NQ 62 THEN
      BEGIN                          # IF NOT ESCAPE CODE #
      ASCII8CHR = DC2A8[ASCIICHR];
      END
    ELSE
      BEGIN
      ESCAPECODE = ASCIICHR;         # SAVE ESCAPE CODE #
      END
    END
  IF ESCAPECODE EQ 0 THEN
    BEGIN                            # IF CHARACTER TO MOVE #
    NUMVDCHARS = NUMVDCHARS - 1;     # DECREMENT VARDATA COUNT #
    B&lt;6*TOCHAROS,12>TOSTRIU[TOINDEX] = ASCII8CHR;
    TOCHAROS = TOCHAROS + 2;         # UPDATE TOSTRING CHAR. OFFSET #
    IF TOCHAROS EQ 10 THEN
      BEGIN                          # IF TOSTRING WORD IS FULL #
      TOINDEX = TOINDEX + 1;         # UPDATE TOSTRING WORD INDEX #
      TOCHAROS = 0;                  # RESET CHARACTER OFFSET #
      END
    END
  END
WHYLE FILL AND NUMVDCHARS GR 0 DO
  BEGIN
  NUMVDCHARS = NUMVDCHARS - 1;
  C&lt;TOCHAROS,2>TOSTRIU[TOINDEX] = B&lt;48,12>SPACE;
  TOCHAROS = TOCHAROS + 2;           # UPDATE TOSTRING OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD EXHAUSTED #
    TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
    TOCHAROS = 0;
    END
  END
 
END  # MVASA8 #
CONTROL EJECT;
 
PROC MVA8AS(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL);
 
# TITLE MVA8AS - MOVE AND TRANSLATE ASCII8 TO ASCII. #
 
BEGIN  # MVA8AS #
 
#
**    MVA8AS - MOVE AND TRANSLATE ASCII8 TO ASCII.
*
*     THIS PROCEDURE MOVES THE CHARACTER DATA FROM VARDATA TO
*     INSTRING AFTER A READ, USING THE BASED ARRAYS FROMSTRING
*     AND TOSTRING, TRANSLATING FROM ASCII8 TO ASCII.
*
*     PROC MVA8AS(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL)
*
*     ENTRY   BASED ARRAYS FROMSTRING AND TOSTRING POSITIONED.
*             STRINGOS   = THE CHARACTER OFFSET INTO INSTRING.
*             VAROS      = THE CHARACTER OFFSET INTO VARDATA.
*             SLENGTH    = INSTRING LENGTH IN SIX BIT CHARACTERS.
*             NUMVDCHARS = NUMBER OF CHARACTERS IN VARDATA.
*             FILL       = TRUE IF BLANK FILL REQUIRED.
*
*     EXIT    STRING MOVED AND TRANSLATED.
*
*     NOTE    SLENGTH IS NOT NECESSARILY THE NUMBER OF CHARACTERS
*             (SINCE THEY CAN BE EITHER SIX OR TWELVE BITS LONG) BUT
*             RATHER THE NUMBER OF SIX BIT PARCELS IN INSTRING.
#
ITEM STRINGOS   I;                   # CHARACTER OFFSET / OUTSTRING #
ITEM SLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM VAROS      I;                   # CHARACTER OFFSET / VARDATA #
ITEM NUMVDCHARS I;                   # NUMBER OF CHARS. IN VARDATA #
ITEM FILL       B;                   # TRUE IF BLANK FILL REQUIRED #
 
ITEM ASCIICHR   I;                   # HOLDS AN ASCII CHARACTER #
ITEM ASCII8CHR  I;                   # HOLDS AN ASCII8 CHARACTER #
ITEM ESCAPECODE I;                   # ESCAPE CODE #
ITEM FROMCHAROS I;                   # CHARACTER OFFSET / FROMSTRING #
ITEM FROMINDEX  I;                   # INDEX INTO FROMSTRING #
ITEM NUMINCHARS I;                   # NUMBER OF CHARS. IN INSTRING #
ITEM TOCHAROS   I;                   # CHARACTER OFFSET / TOSTRING #
ITEM TOINDEX    I;                   # INDEX INTO TOSTRING #
 
FROMINDEX = 0;                       # GET FIRST WORD FROM FROMSTRING #
FROMCHAROS = VAROS;                  # CHARACTER OFFSET / VARDATA #
TOINDEX = 0;
TOCHAROS = STRINGOS;                 # CHARACTER OFFSET / INSTRING #
ESCAPECODE = 0;                      # CLEAR ESCAPE CODE #
IF SLENGTH LQ 0 THEN SLENGTH = NUMVDCHARS * 2;
NUMINCHARS = 0;                      # INITIALIZE LOOP #
WHYLE NUMINCHARS LS SLENGTH AND NUMVDCHARS GR 0 DO
  BEGIN                              # TRANSLATE CHARACTERS #
  ASCII8CHR = B&lt;6*FROMCHAROS,12>FROMSTRIU[FROMINDEX];
  NUMVDCHARS = NUMVDCHARS - 1;       # DECREMENT VARDATA COUNT #
  FROMCHAROS = FROMCHAROS + 2;       # UPDATE FROMSTRING CHAR. OFFSET #
  IF FROMCHAROS EQ 10 THEN
    BEGIN                            # IF FROMSTRING WORD IS EMPTY #
    FROMINDEX = FROMINDEX + 1;       # UPDATE FROMSTRING WORD INDEX #
    FROMCHAROS = 0;                  # RESET CHARACTER OFFSET #
    END
  IF ASCII8CHR GQ 97 THEN
    BEGIN                            # IF LOWER CASE #
    ESCAPECODE = 62;
    ASCIICHR = ASCII8CHR - 96;       # CONVERT TO UPPER CASE #
    END
  ELSE IF ASCII8CHR EQ TERASC8ATD[0] THEN
    BEGIN                            # IF 64-COLON OR 63-PERCENT #
    ESCAPECODE = 60;                 # SET ESCAPE CODE AND CHAR. #
    ASCIICHR = 04;
    END
  ELSE IF ASCII8CHR EQ 64 THEN
    BEGIN                            # IF AT SIGN #
    ESCAPECODE = 60;                 # SET ESCAPE CODE AND CHAR. #
    ASCIICHR = 01;
    END
  ELSE IF ASCII8CHR EQ 94 THEN
    BEGIN                            # IF CIRCUMFLEX #
    ESCAPECODE = 60;                 # SET ESCAPE CODE AND CHAR. #
    ASCIICHR = 02;
    END
  ELSE IF ASCII8CHR EQ 96 THEN
    BEGIN                            # IF REVERSE SLANT #
    ESCAPECODE = 60;                 # SET ESCAPE CODE AND CHAR. #
    ASCIICHR = 07;
    END
  IF ESCAPECODE NQ 0 THEN
    BEGIN                            # IF TWELVE BIT CHARACTER #
    IF NUMINCHARS LS SLENGTH-1 THEN
      BEGIN                          # IF ROOM FOR ALL TWELVE BITS #
      NUMINCHARS = NUMINCHARS + 1;   # INCREMENT CHARACTER COUNT #
      B&lt;6*TOCHAROS,6>TOSTRIU[TOINDEX] = ESCAPECODE;
      TOCHAROS = TOCHAROS + 1;       # UPDATE TOSTRING CHAR. OFFSET #
      IF TOCHAROS EQ 10 THEN
        BEGIN                        # IF TOSTRING WORD IS FULL #
        TOCHAROS = 0;                # RESET CHARACTER OFFSET #
        TOINDEX = TOINDEX + 1;       # UPDATE TOSTRING WORD INDEX #
        END
      END
    ESCAPECODE = 0;                  # CLEAR ESCAPE CODE #
    END
  ELSE
    BEGIN
    ASCIICHR = A82DC[ASCII8CHR];     # TRANSLATE CHARACTER #
    END
  IF ESCAPECODE EQ 0 THEN
    BEGIN
    NUMINCHARS = NUMINCHARS + 1;       # INCREMENT CHARACTER COUNT #
    B&lt;6*TOCHAROS,6>TOSTRIU[TOINDEX] = ASCIICHR;
    TOCHAROS = TOCHAROS + 1;           # UPDATE TOSTRING CHAR. OFFSET #
    IF TOCHAROS EQ 10 THEN
      BEGIN                            # IF TOSTRING WORD IS FULL #
      TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
      TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
      END
    END
  END
WHYLE FILL AND NUMINCHARS LS SLENGTH DO
  BEGIN                              # IF BLANK FILL REQUIRED #
  B&lt;6*TOCHAROS,6>TOSTRIU[TOINDEX] = O"55";
  SLENGTH = SLENGTH - 1;             # DECREMENT CHARACTER COUNT #
  TOCHAROS = TOCHAROS + 1;           # UPDATE TOSTRING CHAR. OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD IS FULL #
    TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
    TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
    END
  END
 
END  # MVA8AS #
CONTROL EJECT;
 
PROC MVA8DC(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL);
 
# TITLE MVA8DC - MOVE AND TRANSLATE ASCII8 TO DISPLAY CODE. #
 
BEGIN  # MVA8DC #
 
#
**    MVA8DC - MOVE AND TRANSLATE ASCII8 TO DISPLAY CODE.
*
*     THIS PROCEDURE MOVES THE CHARACTER DATA FROM VARDATA TO
*     INSTRING AFTER A READ, USING THE BASED ARRAYS FROMSTRING
*     AND TOSTRING, TRANSLATING FROM ASCII8 TO DISPLAY CODE.
*
*     PROC MVA8DC(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL)
*
*     ENTRY   BASED ARRAYS FROMSTRING AND TOSTRING POSITIONED.
*             STRINGOS   = THE CHARACTER OFFSET INTO INSTRING.
*             VAROS      = THE CHARACTER OFFSET INTO VARDATA.
*             SLENGTH    = INSTRING LENGTH IN SIX BIT CHARACTERS.
*             NUMVDCHARS = LENGTH OF FIELD OR PANEL STRING.
*             FILL       = TRUE IF BLANK FILL REQUIRED.
*
*     EXIT    STRING MOVED AND TRANSLATED.
*
*     NOTES   SINCE INSTRING IS DEFINED IN THE APPLICATION PROGRAM
*             AND THUS DOES NOT NECESSARILY START ON A WORD BOUNDARY
*             TOCHAROS IS SET TO STRINGOS BEFORE THE LOOP IS BEGUN.
#
ITEM STRINGOS   I;                   # CHARACTER OFFSET / OUTSTRING #
ITEM SLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM VAROS      I;                   # VARIABLE CHARACTER OFFSET #
ITEM NUMVDCHARS I;                   # FIELD/PANEL STRING LENGTH #
ITEM FILL       B;                   # TRUE IF BLANK FILL REQUIRED #
 
ITEM FROMCHAROS I;                   # CHARACTER OFFSET / FROMSTRING #
ITEM FROMINDEX  I;                   # INDEX INTO FROMSTRING #
ITEM NUMCHARS   I;                   # NUMBER OF CHARACTERS TO TRANS. #
ITEM TOCHAROS   I;                   # CHARACTER OFFSET / TOSTRING #
ITEM TOINDEX    I;                   # INDEX INTO TOSTRING #
 
FROMCHAROS = VAROS;                  # CHARACTER OFFSET / VARDATA #
FROMINDEX = 0;                       # GET FIRST WORD FROM VARDATA #
TOINDEX = 0;
TOCHAROS = STRINGOS;                 # CHARACTER OFFSET / INSTRING #
IF SLENGTH LQ 0 THEN SLENGTH = NUMVDCHARS;
IF SLENGTH LS NUMVDCHARS THEN NUMVDCHARS = SLENGTH;
NUMCHARS = 0;                        # INITIALIZE CHARACTER COUNT #
WHYLE NUMCHARS LS NUMVDCHARS DO
  BEGIN                              # MOVE AND TRANSLATE CHARACTER #
  NUMCHARS = NUMCHARS +1;            # INCREMENT CHARACTER COUNT #
  B&lt;6*TOCHAROS,6>TOSTRIU[TOINDEX] =
    A82DC[B&lt;6*FROMCHAROS,12>FROMSTRIU[FROMINDEX]];
  FROMCHAROS = FROMCHAROS + 2;       # UPDATE FROMSTRING CHAR. OFFSET #
  IF FROMCHAROS EQ 10 THEN
    BEGIN                            # IF FROMSTRING WORD IS EMPTY #
    FROMCHAROS = 0;                  # RESET CHARACTER OFFSET #
    FROMINDEX = FROMINDEX + 1;       # UPDATE FROMSTRING WORD INDEX #
    END
  TOCHAROS = TOCHAROS + 1;           # UPDATE TOSTRING CHAR. OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD IS FULL #
    TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
    TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
    END
  END
WHYLE FILL AND NUMCHARS LS SLENGTH DO
  BEGIN                              # IF BLANK FILL REQUIRED #
  SLENGTH = SLENGTH - 1;
  B&lt;6*TOCHAROS,6>TOSTRIU[TOINDEX] = O"55";
  TOCHAROS = TOCHAROS + 1;           # UPDATE TOSTRING OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD IS FULL #
    TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
    TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
    END
  END
 
END  # MVA8DC #
CONTROL EJECT;
 
PROC MVDCA8(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL);
 
# TITLE MVDCA8 - MOVE AND TRANSLATE DISPLAY CODE TO ASCII8. #
 
BEGIN  # MVDCA8 #
 
#
**    MVDCA8 - MOVE AND TRANSLATE DISPLAY CODE TO ASCII8.
*
*     THIS PROCEDURE MOVES THE CHARACTER DATA FROM OUTSTRING TO
*     VARDATA BEFORE A WRITE, USING THE BASED ARRAYS FROMSTRING
*     AND TOSTRING, TRANSLATING FROM DISPLAY CODE TO ASCII8.
*
*     PROC MVDCA8(STRINGOS,VAROS,SLENGTH,NUMVDCHARS,FILL)
*
*     ENTRY   BASED ARRAYS FROMSTRING AND TOSTRING POSITIONED.
*             STRINGOS   = THE CHARACTER OFFSET INTO OUTSTRING.
*             VAROS      = THE CHARACTER OFFSET INTO VARDATA.
*             SLENGTH    = OUTSTRING LENGTH IN SIX BIT CHARACTERS.
*             NUMVDCHARS = LENGTH OF FIELD OR PANEL STRING.
*             FILL       = TRUE IF BLANK FILL REQUIRED.
*
*     EXIT    STRING MOVED AND TRANSLATED.
*
*     NOTES   SINCE OUTSTRING IS DEFINED IN THE APPLICATION PROGRAM
*             AND THUS DOES NOT NECESSARILY START ON A WORD BOUNDARY
*             FROMCHAROS IS SET TO STRINGOS BEFORE THE LOOP IS BEGUN.
#
ITEM STRINGOS   I;                   # CHARACTER OFFSET / OUTSTRING #
ITEM SLENGTH    I;                   # LENGTH IN SIX BIT CHARACTERS #
ITEM VAROS      I;                   # VARIABLE CHARACTER OFFSET #
ITEM NUMVDCHARS I;                   # FIELD/PANEL STRING LENGTH #
ITEM FILL       B;                   # TRUE IF BLANK FILL REQUIRED #
 
ITEM FROMCHAROS I;                   # CHARACTER OFFSET / FROMSTRING #
ITEM FROMINDEX  I;                   # INDEX INTO FROMSTRING #
ITEM NUMCHARS   I;                   # NUMBER OF CHARACTERS TO TRANS. #
ITEM SPACE      I = BLANK;           # ASCII SPACE FOR BLANK FILL #
ITEM TOCHAROS   I;                   # CHARACTER OFFSET / TOSTRING #
ITEM TOINDEX    I;                   # INDEX INTO TOSTRING #
 
FROMCHAROS = STRINGOS;               # CHARACTER OFFSET / OUTSTRING #
FROMINDEX = 0;                       # GET FIRST WORD FROM FROMSTRING #
TOINDEX = 0;
TOCHAROS = VAROS;                    # CHARACTER OFFSET / VARDATA #
IF SLENGTH GR NUMVDCHARS OR SLENGTH LQ 0 THEN
  SLENGTH = NUMVDCHARS;              # IF LENGTH ADJUSTMENT NEEDED #
FOR NUMCHARS = 1 STEP 1 UNTIL SLENGTH DO
  BEGIN                              # TRANSLATE CHARACTERS #
  B&lt;6*TOCHAROS,12>TOSTRIU[TOINDEX] =
    DC2A8[B&lt;6*FROMCHAROS,6>FROMSTRIU[FROMINDEX]];
  FROMCHAROS = FROMCHAROS + 1;       # UPDATE FROMSTRING CHAR. OFFSET #
  IF FROMCHAROS EQ 10 THEN
    BEGIN                            # IF FROMSTRING WORD IS EMPTY #
    FROMCHAROS = 0;                  # RESET CHARACTER OFFSET #
    FROMINDEX = FROMINDEX + 1;       # UPDATE FROMSTRING WORD INDEX #
    END
  TOCHAROS = TOCHAROS + 2;           # UPDATE TOSTRING CHAR. OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF TOSTRING WORD IS FULL #
    TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
    TOINDEX = TOINDEX + 1;           # UPDATE TOSTRING WORD INDEX #
    END
  END
WHYLE FILL AND SLENGTH LS NUMVDCHARS DO
  BEGIN
  NUMVDCHARS = NUMVDCHARS - 1;
  B&lt;6*TOCHAROS,12>TOSTRIU[TOINDEX] = B<48,12>SPACE;
  TOCHAROS = TOCHAROS + 2;           # INCREMENT TOSTRING OFFSET #
  IF TOCHAROS EQ 10 THEN
    BEGIN                            # IF FROMSTRING WORD IS EMPTY #
    TOCHAROS = 0;                    # RESET CHARACTER OFFSET #
    TOINDEX = TOINDEX + 1;           # UPDATE FROMSTRING WORD INDEX #
    END
  END
 
END  # MVDCA8 #
CONTROL EJECT;
 
PROC NCHECK(FLDIND,IVAL,EVAL,INPUTTYPE,DOLLARSIGN);
 
# TITLE NCHECK - NUMERIC CHECK OF INPUT FIELD. #
 
BEGIN  # NCHECK #
 
#
**    NCHECK - CHECK NUMERIC FIELD.
*
*     THIS PROCEDURE CHECKS THAT THE INPUT FITS THE FORMAT SPECIFIED
*     FOR THE FIELD AND CALULATES THE NUMERIC  VALUE OF THE INPUT.
*
*     PROC NCHECK(FLDIND,IVAL,EVAL,INPUTTYPE,DOLLARSIGN)
*
*     ENTRY   FLDIND     = INDEX OF CURRENT FIELD IN FLDLIST.
*
*     EXIT    IVAL       = INTEGER VALUE OF INPUT.
*             EVAL       = EXPONENT VALUE OF INPUT.
*             INPUTTYPE  = FORMAT TYPE OF INPUT.
*             DOLLARSIGN = TRUE IF $ IN INPUT.
*             FLDVALID[FLDIND] = FALSE, IF INVALID INPUT.
*
*     CALLS   GETNUM, SKPBLK.
#
ITEM FLDIND     I;                   # INDEX IN FLDLIST #
ITEM IVAL       I;                   # INTEGER VALUE #
ITEM EVAL       I;                   # EXPONENT VALUE #
ITEM INPUTTYPE  I;                   # FORMAT TYPE (9 N $ E BAD)#
ITEM DOLLARSIGN B;                   # $ IN INPUT #
 
ITEM CHAR       I;                   # INPUT CHARACTER #
ITEM CHARPOS    I;                   # CHARACTER POSITION IN FIELD #
ITEM COMMADEL   I = O"0054";         # COMMA DELIMETER #
ITEM COMMATHERE B;                   # COMMA PRESENT FLAG #
ITEM DECIMALPT  B;                   # DECIMAL POINT IN INPUT #
ITEM DIGITINT   I;                   # NUMBER OF DIGITS IN INTEGER #
ITEM DIGITLIMIT I=17;                # MAXIMUM DIGITS ALLOWED #
ITEM DIGITS     I;                   # NUMBER OF DIGITS IN SUBFIELD #
ITEM DVAL       I;                   # DECIMAL VALUE #
ITEM ESIGN      I;                   # EXPONENT SIGN VALUE #
ITEM EXPONLIMIT I=322;               # MAXIMUM EXPONENT ALLOWED #
ITEM I          I;                   # LOOP COUNTER #
ITEM ISIGN      I;                   # INTEGER SIGN VALUE #
ITEM PERIODDEL  I = O"0056";         # PERIOD DELIMITER #
ITEM SOMEDIGITS B;                   # IF ANY NUMERIC INPUT #
ITEM TVAL       I;                   # TEMPORARY VALUE #
ITEM VARIND     I;                   # INDEX INTO VARLIST OF VARIABLE #
 
SOMEDIGITS = FALSE;                  # INITIAL VALUES #
COMMATHERE = FALSE;
DOLLARSIGN = FALSE;
DECIMALPT = FALSE;
VARIND = FLDVARORD[FLDIND];
 
CONTROL IFEQ EUROPEAN,1;             # IF EUROPEAN CURRENCY FORMAT #
  IF VARPICTYPE[VARIND] EQ FORMTYPE"$" THEN
    BEGIN                            # CURRENCY FORMAT #
    COMMADEL = PERIOD;
    PERIODDEL = COMMA;
    END
  ELSE
    BEGIN                            # NOT CURRENCY FORMAT #
    COMMADEL = COMMA;
    PERIODDEL = PERIOD;
    END
CONTROL FI;                          # END EUROPEAN #
 
INPUTTYPE = FORMTYPE"BAD";
IVAL = 0;
DVAL = 0;
EVAL = 0;
TVAL = 0;
ISIGN = 1;
ESIGN = 1;
CHARPOS = 0;
DIGITINT = 0;
 
SKPBLK(FLDIND,CHARPOS,CHAR);         # FIND START OF FIELD #
 
IF UPPER(CHAR) EQ CAPE THEN GOTO EXPSUBFLD;  # START OF EXPONENT #
 
IF CHAR EQ DOLLAR THEN
  BEGIN                              # CURRENCY INPUT #
  DOLLARSIGN = TRUE;
  INPUTTYPE = FORMTYPE"$";
  CHARPOS = CHARPOS + 1;
  END
 
IF CHAR EQ PLUS OR CHAR EQ MINUS THEN
  BEGIN                              # SIGNED INPUT #
  INPUTTYPE = FORMTYPE"N";
  IF CHAR EQ MINUS THEN ISIGN = -1;
  CHARPOS = CHARPOS + 1;
  END
 
IF CHAR EQ PERIODDEL THEN GOTO DECSUBFLD;  # START OF DECIMAL #
 
INTSUBFLD:                           # GET VALUE OF INTEGER SUBFIELD #
 
  GETNUM(FLDIND,CHARPOS,IVAL,DIGITS);
  DIGITINT = DIGITINT + DIGITS;
  IF (COMMATHERE AND DIGITS NQ 3)
    OR (DIGITINT GR DIGITLIMIT AND VARTYPE[VARIND] GR 1) THEN
    BEGIN
    INPUTTYPE = FORMTYPE"BAD";
    RETURN;
    END
  IF DIGITS NQ 0 THEN SOMEDIGITS = TRUE;
  IF NEXTCHAR(FLDIND,CHARPOS) EQ COMMADEL THEN
    BEGIN                            # CURRENCY TYPE INPUT #
    IF (NOT COMMATHERE AND DIGITS GR 3) OR DIGITS LS 1 THEN
      BEGIN
      INPUTTYPE = FORMTYPE"BAD";
      RETURN;
      END
    DOLLARSIGN = TRUE;
    COMMATHERE = TRUE;
    IF CHARPOS GQ FLDLENGTH[FLDIND] - 1 THEN GOTO ENDOFFLD;
    CHARPOS = CHARPOS + 1;
    CHAR = NEXTCHAR(FLDIND,CHARPOS);
    IF CHAR LS ZEROCH OR CHAR GR NINECH THEN
      BEGIN                          # INVALID CHARACTER #
      INPUTTYPE = FORMTYPE"BAD";
      RETURN;
      END
    INPUTTYPE = FORMTYPE"$";
    GOTO INTSUBFLD;
    END
  IVAL = ISIGN * IVAL;
  IF CHARPOS GQ FLDLENGTH[FLDIND] THEN GOTO ENDOFFLD;
  CHAR = NEXTCHAR(FLDIND,CHARPOS);   # LOOK AT NEXT CHARACTER #
  IF UPPER(CHAR) EQ CAPE THEN GOTO EXPSUBFLD;  # START OF EXPONENT #
  IF CHAR EQ PERIODDEL THEN GOTO DECSUBFLD;  # START OF DECIMAL #
  IF CHAR EQ MINUS OR CHAR EQ PLUS AND SOMEDIGITS THEN
    BEGIN                            # START OF EXPONENT #
    GOTO EXPSUBFLD;
    END
  IF CHAR EQ BLANK THEN GOTO ENDOFFLD;  # END OF FIELD #
  INPUTTYPE = FORMTYPE"BAD";         # BAD INPUT #
  RETURN;
 
DECSUBFLD:                           # GET VALUE OF DECIMAL SUBFIELD #
 
  DECIMALPT = TRUE;
  INPUTTYPE = FORMTYPE"$";
  CHARPOS = CHARPOS + 1;
  IF CHARPOS GQ FLDLENGTH[FLDIND] THEN GOTO ENDOFFLD;
  GETNUM(FLDIND,CHARPOS,DVAL,DIGITS);
  DIGITINT = DIGITINT + DIGITS;
  IF DIGITINT GR DIGITLIMIT AND VARTYPE[VARIND] GR 1 THEN
    BEGIN                            # TOO MANY DIGITS ENTERED #
    INPUTTYPE = FORMTYPE"BAD";
    RETURN;
    END
  IF DIGITS NQ 0 THEN
    BEGIN                            # SOME DECIMAL DIGITS ENTERED #
    IF DIGITINT LQ DIGITLIMIT THEN
      BEGIN
      FOR I = 1 STEP 1 UNTIL DIGITS DO
        BEGIN
        IVAL = IVAL * 10;
        END
      IVAL = IVAL + DVAL*ISIGN;
      END
    SOMEDIGITS = TRUE;
    END
  EVAL = -DIGITS;
  IF DIGITS GR 2 THEN INPUTTYPE = FORMTYPE"E";
  IF CHARPOS GQ FLDLENGTH[FLDIND] THEN GOTO ENDOFFLD;  # END OF FIELD #
  CHAR = NEXTCHAR(FLDIND,CHARPOS);
  IF CHAR EQ PLUS OR CHAR EQ MINUS
    OR UPPER(CHAR) EQ CAPE THEN
    BEGIN                            # START OF EXPONENT #
    GOTO EXPSUBFLD;
    END
  IF CHAR EQ BLANK THEN GOTO ENDOFFLD;  # END OF FIELD #
  INPUTTYPE = FORMTYPE"BAD";
  RETURN;
 
EXPSUBFLD:                           # GET VALUE OF EXPONENT SUBFIELD #
 
  INPUTTYPE = FORMTYPE"E";
  IF UPPER(CHAR) EQ CAPE THEN
    BEGIN                            # SKIP E CHARACTER #
    CHARPOS = CHARPOS + 1;
    CHAR = NEXTCHAR(FLDIND,CHARPOS);
    END
  IF CHAR EQ MINUS THEN
    BEGIN                            # NEGATIVE EXPONENT #
    ESIGN = -1;
    CHARPOS = CHARPOS + 1;
    CHAR = NEXTCHAR(FLDIND,CHARPOS);
    END
  ELSE IF CHAR EQ PLUS THEN
    BEGIN                            # POSITIVE EXPONENT #
    CHARPOS = CHARPOS + 1;
    CHAR = NEXTCHAR(FLDIND,CHARPOS);
    END
  GETNUM(FLDIND,CHARPOS,TVAL,DIGITS);
  IF DIGITS EQ 0 OR DIGITS GR DIGITLIMIT THEN
    BEGIN                            # TOO MANY OR NO DIGITS IN EXP #
    INPUTTYPE = FORMTYPE"BAD";
    RETURN;
    END
  EVAL = ESIGN * TVAL + EVAL;
 
ENDOFFLD:                            # END OF INPUT FIELD #
 
  IF ABS(EVAL) + DIGITINT GR EXPONLIMIT THEN
    BEGIN                            # INPUT NUMBER TOO LARGE #
    INPUTTYPE = FORMTYPE"BAD";
    RETURN;
    END
 
  IF (DOLLARSIGN AND (INPUTTYPE EQ FORMTYPE"E")) OR NOT SOMEDIGITS THEN
    BEGIN                            # REAL INPUT WITH $ OR NO DIGITS #
    INPUTTYPE = FORMTYPE"BAD";
    RETURN;
    END
 
  IF SOMEDIGITS AND (FORMTYPE"NINE" GR INPUTTYPE) THEN
    BEGIN                            # UNSIGNED INTEGER INPUT #
    INPUTTYPE = FORMTYPE"NINE";
    END
 
  IF CHARPOS LQ FLDLENGTH[FLDIND] -1 THEN
    BEGIN                            # CHECK FOR EXTRA CHARACTERS #
    FOR I = CHARPOS STEP 1 UNTIL FLDLENGTH[FLDIND] -1 DO
      BEGIN
      IF NEXTCHAR(FLDIND,I) NQ BLANK THEN INPUTTYPE = FORMTYPE"BAD";
      END
    END
 
END  # NCHECK #
CONTROL EJECT;
 
PROC PICVAL(FLDIND);
 
# TITLE PICVAL - PERFORM PICTURE VALIDATION. #
 
BEGIN  # PICVAL #
 
#
**    PICVAL - PERFORM PICTURE VALIDATION.
*
*     THIS PROCEDURE VALIDATES THAT INPUT TO THE VARIABLE POINTED TO
*     BY FLDIND CONFORMS WITH THE PICTURE TYPE SPECIFIED IN VARLIST.
*
*     PROC PICVAL(FLDIND)
*
*     ENTRY   FLDIND     = FLDLIST INDEX FOR FIELD TO BE CHECKED.
*
*     EXIT    FLDVALID[FLDIND] = FALSE, IF INPUT IS INVALID.
*
*     CALLS   DATEVL, NCHECK.
#
ITEM FLDIND     I;                   # INDEX OF VARIABLE TO VALIDATE #
 
ITEM DOLLARSIGN B;                   # $ IN INPUT #
ITEM EVAL       I;                   # EXPONENT VALUE OF INPUT #
ITEM INPIND     I;                   # INDEX OF CHARACTER IN INPUT #
ITEM INPTYPE    I;                   # FORMAT TYPE OF INPUT #
ITEM IVAL       I;                   # INTEGER VALUE OF INPUT #
ITEM NCHAR      I;                   # NEXT CHARACTER IN VARDATA #
ITEM PTYPE      I;                   # PICTURE TYPE #
ITEM VARIND     I;                   # INDEX INTO VARLIST OF VARIABLE #
 
SWITCH PICTURTYPE                    # PICTURE TYPE SWITCH #
  ,
  PICX,                              # X PICTURE(DEFAULT) #
  PICA,                              # ALPHA PICTURE #
  PIC9,                              # INTEGER PICTURE #
  PICN,                              # NUMERIC PICTURE #
  PIC$,                              # DOLLAR PICTURE #
  PICE,                              # REAL PICTURE #
  PICY,                              # YYMMDD DATE PICTURE #
  PICM,                              # MMDDYY DATE PICTURE #
  PICD;                              # DDMMYY DATE PICTURE #
 
VARIND = FLDVARORD[FLDIND];
PTYPE = VARPICTYPE[VARIND] ;
 
GOTO PICTURTYPE[PTYPE];
 
PICX:                                # DISPLAYABLE CHARACTER TYPE #
 
  RETURN;
 
PICA:                                # ALPHABETIC FORMAT #
 
  FOR INPIND = 0 STEP 1 UNTIL FLDLENGTH[FLDIND] -1 DO
    BEGIN
    NCHAR = NEXTCHAR(FLDIND,INPIND);
    IF NOT(NCHAR GQ CAPA AND NCHAR LQ CAPZ)
       AND NOT(NCHAR GQ LOWA AND NCHAR LQ LOWZ)
       AND NOT(NCHAR EQ BLANK) THEN
      BEGIN                          # NOT ALPHABETIC INPUT #
      FLDVALID[FLDIND] = FALSE;
      END
    END
 
  RETURN;
 
PICY:
PICM:
PICD:                                # DATE FORMATS #
 
  DATEVL(FLDIND,IVAL,EVAL);
  RETURN;
 
PICE:                                # REAL FORMAT #
PIC9:                                # INTEGER FORMAT #
PICN:                                # SIGNED INTEGER FORMAT #
PIC$:                                # CURRENCY FORMAT #
 
  NCHECK(FLDIND,IVAL,EVAL,INPTYPE,DOLLARSIGN);
  IF (VARPICTYPE[VARIND] EQ FORMTYPE"E" AND DOLLARSIGN)
    OR INPTYPE GR VARPICTYPE[VARIND] OR INPTYPE EQ FORMTYPE"BAD" THEN
    BEGIN
    FLDVALID[FLDIND] = FALSE;
    END
  RETURN;
 
END  # PICVAL #
CONTROL EJECT;
 
PROC POSARR(PANELADDR);
 
# TITLE POSARR - POSITION PANEL RECORD BASED ARRAYS. #
 
BEGIN  # POSARR #
 
#
**    POSARR - POSITION PANEL RECORD BASED ARRAYS.
*
*     THIS PROCEDURE POSITIONS THE BASED ARRAYS THAT DESCRIBE THE
*     FORMAT OF THE INFORMATION IN PANEL RECORD USING THE ADDRESS
*     PASSED IN PANELADDR.
*
*     PROC POSARR(PANELADDR)
*
*     ENTRY   PANELADDR  = FWA OF THE PANEL RECORD IN MEMORY.
*
*     EXIT    ALL PANEL RECORD BASED ARRAYS POSITIONED.
#
ITEM PANELADDR  I;                   # THE ADDRESS OF THE PANEL #
 
ITEM ZEROWORD   I = 0;               # DUMMY FIELD LIST #
 
P&lt;RECORD> = PANELADDR;               # POSITION BASED ARRAYS #
P&lt;PANELHEADR> = PANELADDR;
P&lt;VDATA> = PANELADDR + PANHEADLEN;
 
IF PANSTRFLD[0] NQ 0 THEN
  BEGIN                              # IF PANEL HAS FIELD LIST #
  P&lt;FLDLIST> = PANELADDR + PANSTRFLD[0];
  END
ELSE
  BEGIN                              # NO FIELD LIST, ONLY BOXES #
  P&lt;FLDLIST> = LOC(ZEROWORD);
  END
 
P&lt;VARLIST> = PANELADDR + PANSTRVAR[0];
P&lt;FUNLIST> = PANELADDR + PANSTRFUN[0];
P&lt;ATTLIST> = PANELADDR + PANSTRATT[0];
P&lt;ARRLIST> = PANELADDR + PANSTRARR[0];
P&lt;BOXLIST> = PANELADDR + PANSTRBOX[0];
 
END  # POSARR #
CONTROL EJECT;
 
PROC POSTWO(PANELADDR);
 
# TITLE POSTWO - POSITION PANEL RECORD BASED ARRAYS FOR SFATTR. #
 
BEGIN  # POSTWO #
 
#
**    POSTWO - POSITION PANEL RECORD BASED ARRAYS FOR SFATTR.
*
*     THIS PROCEDURE POSITIONS THE BASED ARRAYS THAT DESCRIBE THE
*     FORMAT OF THE INFORMATION IN PANEL RECORD USING THE ADDRESS
*     PASSED IN PANELADDR FOR USE BY SFATTR.
*
*     PROC POSTWO(PANELADDR)
*
*     ENTRY   PANELADDR  = FWA OF THE PANEL RECORD IN MEMORY.
*
*     EXIT    ALL PANEL RECORD BASED ARRAYS POSITIONED.
#
ITEM PANELADDR  I;                   # THE ADDRESS OF THE PANEL #
 
ITEM ZEROWORD   I = 0;               # DUMMY FIELD LIST #
 
P&lt;PANEL2HEAD> = PANELADDR;
 
IF PAN2STRFLD[0] NQ 0 THEN
  BEGIN                              # IF PANEL HAS FIELD LIST #
  P&lt;FLD2LIST> = PANELADDR + PAN2STRFLD[0];
  END
ELSE
  BEGIN                              # NO FIELD LIST, ONLY BOXES #
  P&lt;FLD2LIST> = LOC(ZEROWORD);
  END
 
P&lt;VAR2LIST> = PANELADDR + PAN2STRVAR[0];
P&lt;ATT2LIST> = PANELADDR + PAN2STRATT[0];
P&lt;ARR2LIST> = PANELADDR + PAN2STRARR[0];
 
END  # POSTWO #
CONTROL EJECT;
 
PROC PSTRNG(FLDIND,MESSNUM);
 
# TITLE PSTRNG - PRINT MESSAGE STRING. #
 
BEGIN  # PSTRNG #
 
#
**    PSTRNG - PRINT MESSAGE STRING.
*
*     THIS PROCEDURE CLEARS THE MESSAGE AREA AND PRINTS A USER OR
*     SMF MESSAGE.
*
*     PROC PSTRNG(FLDIND,MESSNUM)
*
*     ENTRY   FLDIND     = INDEX OF FIELD FOR HELP STRING.
*             MESSNUM    = SWITCH VALUE FOR MESSAGE PROMPT.
*
*     EXIT    MESSAGE TRUNCATED IF NECESSARY AND WRITTEN.
*
*     CALLS   CPANEL, MCLEAN, VDTCHR, VDTPOS, VDTSAM, VDTSTR.
*
*     USES    TERHELPREQ, TERMESREAD, TERMESWRIT.
#
ITEM FLDIND     I;                   # INDEX INTO FIELD LIST #
ITEM MESSNUM    S:MESSSTAT;          # SWITCH FOR MESSAGE PROMPT #
 
ITEM CINDEX     I;                   # CHARACTER INDEX INTO MESSAGE #
ITEM I          I;                   # LOOP VARIABLE #
ITEM MESCHR     I;                   # HOLDS ONE CHARACTER OF MESSAGE #
ITEM MCOUNT     I;                   # CHARACTER COUNT FOR MESSAGE #
ITEM MSGFIT     B;                   # MESSAGE TRUNCATION FLAG #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
ITEM WINDEX     I;                   # WORD INDEX INTO MESSAGE #
 
*IF UNDEF,QTRM
ARRAY CONMESS[0:3] P(1);
  BEGIN                              # PLEASE CONFIRM #
  ITEM CONMESSAGE U(00,00,60) = [
    O"41204154414541414163",
    O"41454040414341574156",
    O"41464151416241550000"];
  END
 
ARRAY CORMESS[0:3] P(1);
  BEGIN                              # PLEASE CORRECT #
  ITEM CORMESSAGE U(00,00,60) = [
    O"41204154414541414163",
    O"41454040414341574162",
    O"41624145414341640000"];
  END
 
ARRAY DEFMESS[0:2] P(1);
  BEGIN                              # PLEASE ENTER #
  ITEM DEFMESSAGE U(00,00,60) = [
    O"41204154414541414163",
    O"41454040414541564164",
    O"41454162000000000000"];
  END
 
ARRAY ERRMESS[0:4] P(1);
  BEGIN                              # PLEASE REENTER INPUT #
  ITEM ERRMESSAGE U(00,00,60) = [
    O"41204154414541414163",
    O"41454040416241454145",
    O"41564164414541624040",
    O"41514156416041654164",
    O"00000000000000000000"];
  END
 
ARRAY FUNMESS[0:5] P(1);
  BEGIN                              # PLEASE PRESS FUNCTION KEY #
  ITEM FUNMESSAGE U(00,00,60) = [
    O"41204154414541414163",
    O"41454040416041624145",
    O"41634163404041464165",
    O"41564143416441514157",
    O"41564040415341454171",
    O"00000000000000000000"];
  END
*ELSE
ARRAY CONMESS[0:3] P(1);
  BEGIN                              # PLEASE CONFIRM #
  ITEM CONMESSAGE U(00,00,60) = [
    O"40404040412041544145",
    O"41414163414540404143",
    O"41574156414641514162",
    O"41550000000000000000"];
  END
 
ARRAY CORMESS[0:3] P(1);
  BEGIN                              # PLEASE CORRECT #
  ITEM CORMESSAGE U(00,00,60) = [
    O"40404040412041544145",
    O"41414163414540404143",
    O"41574162416241454143",
    O"41640000000000000000"];
  END
 
ARRAY DEFMESS[0:2] P(1);
  BEGIN                              # PLEASE ENTER #
  ITEM DEFMESSAGE U(00,00,60) = [
    O"40404040412041544145",
    O"41414163414540404145",
    O"41564164414541620000"];
  END
 
ARRAY ERRMESS[0:4] P(1);
  BEGIN                              # PLEASE REENTER INPUT #
  ITEM ERRMESSAGE U(00,00,60) = [
    O"40404040412041544145",
    O"41414163414540404162",
    O"41454145415641644145",
    O"41624040415141564160",
    O"41654164000000000000"];
  END
 
ARRAY FUNMESS[0:5] P(1);
  BEGIN                              # PLEASE PRESS FUNCTION KEY #
  ITEM FUNMESSAGE U(00,00,60) = [
    O"40404040412041544145",
    O"41414163414540404160",
    O"41624145416341634040",
    O"41464165415641434164",
    O"41514157415640404153",
    O"41454171000000000000"];
  END
*ENDIF
 
BASED ARRAY MESSNAME [0:0] P(1);     # MESSAGE STRING #
  BEGIN
  ITEM MESSWORD   U(00,00,60);       # MESSAGE WORD #
  END
 
SWITCH JUMPCASE:MESSSTAT
       JUMPHELP:HELP,                # SMF OR USER HELP #
       JUMPCONF:CONFIRM,             # PLEASE CONFIRM #
       JUMPRENT:REENTER;             # PLEASE RENTER INPUT #
 
MCLEAN(MCOUNT,MSGFIT);               # CLEAN MESSAGE AREA #
 
GOTO JUMPCASE[MESSNUM];              # ISSUE MESSAGE #
 
JUMPHELP:                            # PRINT HELP MESSAGE #
 
  IF FLDIND NQ -1 THEN
    BEGIN                            # IF INPUT FIELD #
    VARIND = FLDVARORD[FLDIND];
    IF VARHSOS[VARIND] NQ 0 THEN
      BEGIN                          # IF USER HELP MESSAGE DEFINED #
      P&lt;MESSNAME> = LOC(RECWORDU[0])+ VARHSOS[VARIND];
      END
    ELSE
      BEGIN                          # NO USER HELP MESSAGE DEFINED #
      MSGFIT = TRUE;                 # SMF MESSAGE WILL FIT #
      IF NOT FLDENTERED[FLDIND] THEN
        BEGIN                        # IF DATA NOT ENTERED IN FIELD #
        P&lt;MESSNAME> = LOC(DEFMESSAGE[0]);  # *PLEASE ENTER* #
        END
      ELSE
        BEGIN                        # DATA ENTERED IN FIELD #
        P&lt;MESSNAME> = LOC(CORMESSAGE[0]);  # *PLEASE CORRECT* #
        END
      END
    END
  ELSE
    BEGIN                            # NO INPUT FIELD #
    MSGFIT = TRUE;                   # SMF MESSAGE WILL FIT #
    P&lt;MESSNAME> = LOC(FUNMESSAGE[0]);  # *PLEASE PRESS FUNCTION KEY* #
    END
  TERHELPREQ[0] = FALSE;             # HELP REQUEST HONORED #
  GOTO PRINTMSG;
 
JUMPRENT:
 
  MSGFIT = TRUE;                     # SMF MESSAGE WILL FIT #
  P&lt;MESSNAME> = LOC(ERRMESSAGE[0]);  # *PLEASE REENTER INPUT* #
  GOTO PRINTMSG;
 
JUMPCONF:
 
  MSGFIT = TRUE;                     # SMF MESSAGE WILL FIT #
  IF FLDIND NQ -1 THEN
    BEGIN                            # IF INPUT FIELD #
    P&lt;MESSNAME> = LOC(CONMESSAGE[0]);  # *PLEASE CONFIRM* #
    END
  ELSE
    BEGIN                            # NO INPUT FIELD #
    P&lt;MESSNAME> = LOC(FUNMESSAGE[0]);  # *PLEASE PRESS FUNCTION KEY* #
    END
 
PRINTMSG:                            # PRINT MESSAGE #
 
  VDTPOS(0,0);                       # POSITION TO MESSAGE LINE #
  IF MSGFIT THEN
    BEGIN                            # IF MESSAGE WILL FIT #
    VDTSTR(MESSNAME);                # PRINT ENTIRE MESSAGE #
    END
  ELSE
    BEGIN                            # TRUNCATE AS NEEDED #
    CONTROL IFEQ QTRMV,0;            # IF NOT QTRM VARIANT #
      CINDEX = 2;                    # SKIP 0007 BYTE #
   CONTROL FI;                       # END OF IF NOT QTRM #
   CONTROL IFEQ QTRMV,1;             # IF QTRM VARIANT #
     CINDEX = 0;                     # START AT BEGINNING OF LINE #
   CONTROL FI;                       # END OF IF QTRM #
    WINDEX = 0;
    MESCHR = C&lt;CINDEX,2>MESSWORD[WINDEX];
    FOR I = 0 STEP 1 WHILE MESCHR NQ 0 AND I LQ MCOUNT DO
      BEGIN                          # WRITE MESSAGE #
      VDTCHR(MESCHR);
      CINDEX = CINDEX + 2;
      IF CINDEX GQ 10 THEN
        BEGIN                        # IF WORD EXHAUSTED #
        CINDEX = 0;                  # RESET CHARACTER INDEX #
        WINDEX = WINDEX + 1;         # GET NEXT WORD #
        END
      MESCHR = C&lt;CINDEX,2>MESSWORD[WINDEX];
      END
    END
 
  TERMESWRIT[0] = TRUE;              # MESSAGE WRITTEN #
  TERMESREAD[0] = FALSE;             # MESSAGE NOT READ BY USER YET #
 
  IF NOT TERBLCKMDE[0] THEN
    BEGIN
    VDTSAM(0);
    END
  ELSE
    BEGIN
    VDTSAM(O"6001");
    END
  CPANEL;                            # REWRITE SCREEN AS NEEDED #
 
END  # PSTRNG #
CONTROL EJECT;
 
PROC READIN(FLDIND,COFFSET);
 
# TITLE READIN - READ INPUT FROM TERMINAL. #
 
BEGIN  # READIN #
 
#
**    READIN - READ INPUT FROM TERMINAL.
*
*     THIS PROCEDURE READS INPUT FROM THE TERMINAL AND STORES
*     IT IN THE APPROPRIATE PLACE IN VARDATA.
*
*     PROC READIN(FLDIND,COFFSET)
*
*     ENTRY   FLDIND     = INDEX OF FIELD FOR STARTING CURSOR POSITION.
*             COFFSET    = CURSOR OFFSET IN FIELD.
*
*     EXIT    FLDIND     = LAST FIELD ENTERED.
*             VARDATA CONTAINS INPUT DATA.
*
*     CALLS   BFIELD, CPANEL, FFIELD, FUNKEY, PSTRNG, TABKEY, VDTBOI,
*             VDTCOR, VDTEOO, VDTINP, VDTOUT, VDTPOS, WRIVCH.
*
*     USES    TERABNTERM, TERHELPFLD, TERHELPREQ, TERMESREAD,
*             TERMISSINP, TERNRMTERM, TERPENDHLP, TERREWFLDS,
*IF UNDEF,QTRM
*             TERREWSCRN, TERSOFTPOS, TERSOFTTAB.
*ELSE
*             TERREWSCRN, TERSOFTPOS, TERSOFTTAB, TERWAITINP.
*ENDIF
#
  ITEM FLDIND     I;                 # INDEX OF FIELD IN FLDLIST #
  ITEM COFFSET    I;                 # CURSOR POSITION OFFSET #
 
  ITEM CHAR       I;                 # VDT INPUT CHARACTER #
  ITEM FIELD      I;                 # INDEX OF FIELD IN FLDLIST #
  ITEM I          I;                 # LOOP COUNTER #
  ITEM INPOS      U = 0;             # LINE AND COLUMN OF INPUT #
  ITEM INPUTERROR B;                 # ERROR IN INPUT #
  ITEM INSEARCH   B = FALSE;         # DO NOT INCLUDE OUT-ONLY FIELDS #
  ITEM LASTFIELD  I;                 # LAST FIELD THAT RECEIVED INPUT #
  ITEM LASTORD    I;                 # PREVIOUS INPUT ORDINAL #
  ITEM LASTPOS    U = 0;             # LAST X AND Y POSITION #
  ITEM OFFSET     I;                 # CHARACTER OFFSET WITHIN FIELD #
  ITEM ORD        I;                 # VDT INPUT ORDINAL #
  ITEM SKIPINP    B;                 # SKIP DATA TIL NEXT INPUT READ #
  ITEM STARTFIELD I;                 # FIELD TO START SEARCH #
  ITEM STARTPOS   I;                 # X/Y POSITION TO START SEARCH #
  ITEM XPOS       I;                 # VDT INPUT COLUMN NUMBER #
  ITEM YPOS       I;                 # VDT INPUT LINE NUMBER #
 
  SWITCH INPUTTYPE:SCREENST          # VDT INPUT ORDINALS #
    CONTINUE   : CLRALL,             # CLEAR ALL TABS - IGNORED #
    CHARACTER  : CHAR,               # OVERSTRIKE CHARACTER #
    INSERTCHAR : INSC,               # INSERT CHARACTER #
    DELETECHAR : DELC,               # DELETE CHARACTER #
    INSERTLINE : INSL,               # INSERT LINE #
    DELETELINE : DELL,               # DELETE LINE #
    CLEARPAGE  : CLRPAG,             # CLEAR PAGE #
    CLEARPAGE  : CLREOP,             # CLEAR TO END OF PAGE #
    CLEARPAGE  : CLRUNP,             # CLEAR UNPROTECTED #
    CLEAREOL   : CLREOL,             # CLEAR TO END OF LINE #
    CONTINUE   : POS,                # POSITION CURSOR #
    HOMEKEY    : HOME,               # POSITION HOME #
    CONTINUE   : UP,                 # CURSOR UP #
    CONTINUE   : DOWN,               # CURSOR DOWN #
    LEFTKEY    : LEFT,               # CURSOR LEFT #
    RIGHTKEY   : RIGHT,              # CURSOR RIGHT #
    FORWARDTAB : FTAB,               # TAB FORWARD #
    BACKWRDTAB : BTAB,               # TAB BACKWARD #
    CONTINUE   : RET,                # RETURN #
    ERASECHAR  : ERAC,               # ERASE CHARACTER #
    ERASELINE  : ERAL,               # ERASE LINE #
    ENDOFINPUT : EOI,                # END OF INFORMATION #
    CONTINUE   : RESET,              # RESET #
    APPLICFUN  : FKEY,               # FUNCTION KEY #
    GENERICFUN : GKEY,               # GENERIC KEY #
    BADINPUT   : BAD,                # BAD #
    CONTINUE   : NOOP,               # NOOP #
    CONTINUE   : COORD,              # COORDINATES #
    CONTINUE   : PROTECT,            # PROTECT ALL #
    NEWFIELD   : STRTFLD,            # START OF NEW FIELD #
    CONTINUE   : CLRTAB,             # CLEAR TAB STOP - IGNORED #
    CONTINUE   : SETTAB;             # SET TAB STOP - IGNORED #
 
INPOS = 0;
FIELD = FLDIND;
LASTFIELD = FLDIND;
INPUTERROR = FALSE;
TERHELPREQ[0] = FALSE;
 
*IF DEF,QTRM
IF TERWAITINP[0] THEN
  BEGIN                              # IF INPUT RECEIVED #
  TERWAITINP[0] = FALSE;             # CLEAR FLAG #
  GOTO DOREAD1;                      # CONTINUE #
  END
 
*ENDIF
DOREAD:                              # READ INPUT FROM TERMINAL #
 
  ORD = SCREENST"EOI";               # SET LAST ORDINAL TO EOI #
  TERSOFTTAB[0] = 0;                 # NUMBER OF SOFT TABS PENDING #
  SKIPINP = FALSE;
  TERMISSINP[0] = FALSE;
 
  IF INPUTERROR THEN
    BEGIN                            # BAD INPUT #
    PSTRNG(DUMMY,MESSSTAT"REENTER");
    INPUTERROR = FALSE;
    END
  ELSE
    BEGIN                            # NO INPUT ERROR #
    IF TERHELPREQ[0] THEN
      BEGIN                          # HELP REQUESTED FOR FIELD #
      PSTRNG(TERHELPFLD[0],MESSSTAT"HELP");
      FIELD = TERHELPFLD[0];
      END
    ELSE
      BEGIN                          # NO HELP REQUESTED #
      CPANEL;                        # REWRITE SCREEN AS NEEDED #
      END
    END
 
  IF VALIDFIELD THEN
    BEGIN                            # VALID FIELD #
    XPOS = COFFSET + FLDXCORD[FIELD];
    YPOS = FLDYCORD[FIELD];
    END
  ELSE
    BEGIN                            # INVALID FIELD #
    XPOS = 0;
    YPOS = 0;
    END
  VDTPOS(XPOS,YPOS);                 # POSITION CURSOR #
  VDTEOO;
*IF DEF,QTRM
  TERWAITINP[0] = TRUE;              # SET WAITING FOR INPUT #
  NIT$RC = 23;                       # SET RETURN CODE #
  RETURN;                            # RETURN #
 
DOREAD1:                             # CONTINUE AFTER QTRM INPUT #
 
*ENDIF
  VDTBOI(LASTORD);                   # CHECK FOR TYPE AHEAD #
  VDTBOO;                            # BEGIN OUTPUT SEQUENCE #
  IF LASTORD NQ 0 THEN
    BEGIN                            # TYPE AHEAD WAS ENTERED #
    PSTRNG(FIELD,MESSSTAT"REENTER");  # PLEASE REENTER #
    GOTO DOREAD;
    END
  COFFSET = 0;                       # OFFSET NO LONGER VALID #
  TERMESREAD[0] = TRUE;              # MESSAGE HAS BEEN SEEN BY USER #
  TERNRMTERM[0] = FALSE;
  TERABNTERM[0] = FALSE;
 
GETINP:                              # WHILE STILL LOOKING FOR INPUT #
 
  YMASKOF TERPREVPOS = YPOS;         # RETAIN PREVIOUS Y POSITION #
  XMASKOF TERPREVPOS = XPOS;         # RETAIN PREVIOUS X POSITION #
  LASTORD = ORD;                     # RETAIN PREVIOUS ORDINAL #
  VDTINP(ORD,XPOS,YPOS,CHAR,DUMMY);  # GET INPUT FROM BUFFER #
 
SKIPREAD:
 
  YMASKOF INPOS = YPOS;
  XMASKOF INPOS = XPOS;
  FFIELD(INPOS,FIELD,OFFSET,INSEARCH);  # FIND INPUT FIELD #
  IF VALIDFIELD THEN LASTFIELD = FIELD;  # UPDATE LAST FIELD #
 
  GOTO INPUTTYPE[ORD];               # PROCESS INPUT BY TYPE #
 
CHARACTER:                           # DISPLAYABLE CHARACTER INPUT #
 
  IF (NOT SKIPINP) AND (TERSOFTTAB[0] EQ 0) THEN
    BEGIN                            # PROCESS CHARACTER #
    IF NOT VALIDFIELD THEN
      BEGIN                          # CHAR NOT IN AN INPUT FIELD #
      IF TERTABAUTO[0] AND NOT TERNOINVRS[0] THEN
        BEGIN                        # IF AUTOMATIC TABBING #
        TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
        IF INPOS EQ 0 AND NOT TERTABHOME[0] THEN
          BEGIN                      # IF TAB DOES NOT STOP AT HOME #
          TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
          END
        OFFSET = 0;                  # CLEAR FIELD OFFSET #
        LASTFIELD = FIELD;           # UPDATE LAST VALID FIELD #
        XPOS = XMASKOF INPOS;        # RESET INTERNAL POSITION #
        YPOS = YMASKOF INPOS;
        VDTCOR(YPOS,XPOS);
        END
      END
    IF VALIDFIELD THEN
      BEGIN                          # CHAR IN AN INPUT FIELD #
      WRIVCH(FIELD,OFFSET,CHAR);     # WRITE CHARACTER INTO VARDATA #
      FLDENTERED[FIELD] = TRUE;
      FLDVALID[FIELD] = FALSE;       # INVALID UNTIL PROVEN VALID #
      IF NOT FLDOUTPUTV[FIELD] THEN
        BEGIN                        # IF INPUT ONLY FIELD #
        IF NOT TERGUARDMD[0] THEN
          BEGIN                      # IF NO GUARD MODE AVAILABLE #
          FLDREWRITE[FIELD] = TRUE;  # SET REWRITE BIT FOR FIELD #
          TERREWFLDS[0] = TRUE;
          END
        END
      IF TERTABAUTO[0] THEN
        BEGIN                        # IF AUTOMATIC TABBING #
        IF OFFSET EQ FLDLENGTH[FIELD] - 1 THEN
          BEGIN                      # IF AUTO-TAB TO NEXT FIELD #
          TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
          IF INPOS EQ 0 THEN
            BEGIN                    # IF TABBING PAST LAST FIELD #
            IF TERPTDWFPG[0] THEN
              BEGIN                  # IF NO WRAP AROUND SCREEN #
              TABKEY(SCREENST"BTAB",INPOS,FIELD,INPOS);
              OFFSET = FLDLENGTH[FIELD] - 1;
              INPOS = INPOS + OFFSET;
              END
            ELSE
              BEGIN                  # WRAPPING TO FIRST FIELD #
              IF NOT TERTABHOME[0] THEN
                BEGIN                # IF TAB DOES NOT STOP AT HOME #
                TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
                END
              OFFSET = 0;
              END
            END
          OFFSET = 0;                # CLEAR FIELD OFFSET #
          LASTFIELD = FIELD;         # UPDATE LAST VALID FIELD #
          INPOS = INPOS - 1;         # RESET INTERNAL POSITION #
          YPOS = YMASKOF INPOS;
          XPOS = XMASKOF INPOS;
          VDTCOR(YPOS,XPOS);
          END
        END
      END
    ELSE
      BEGIN                          # CHAR NOT IN AN INPUT FIELD #
      IF NOT TERTABAUTO[0] THEN
        BEGIN                        # IF NEED TO REFRESH SCREEN #
        RESTFLD (INPOS);
        TERMISSINP[0] = TRUE;        # ERROR CONDITION #
        END
 
      RESTFLD (INPOS);
      END
    END
  ELSE
    BEGIN                            # IGNORE CHARACTER #
    IF VALIDFIELD AND NOT TERREWSCRN[0] THEN
      BEGIN                          # IF NEED TO SET REWRITE BIT #
      FLDREWRITE[FIELD] = TRUE;
      TERREWFLDS[0] = TRUE;
      END
    ELSE
      BEGIN                          # BAD CHARACTER IS NOT IN FIELD #
      IF CHAR NQ BLANK AND NOT TERREWSCRN[0] THEN
        BEGIN                        # IF NEED TO CLEAR ON SCREEN #
        VDTPOS(XPOS,YPOS);           # ERASE CHARACTER #
        VDTOUT(BLANK);
        END
      END
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
HOMEKEY:                             # HOME KEY WAS PRESSED #
 
  IF TERTABAUTO[0] THEN
    BEGIN                            # IF AUTOMATIC TABBING #
    IF NOT TERNOINVRS[0] THEN
      BEGIN                          # IF INPUT VARIABLES EXIST #
      IF NOT TERTABHOME[0] THEN
        BEGIN                        # CURSOR HAS MOVED TO FIELD #
        TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
        OFFSET = 0;                  # CLEAR FIELD OFFSET #
        LASTFIELD = FIELD;           # UPDATE LAST VALID FIELD #
        YPOS = YMASKOF INPOS;        # RESET INTERNAL POSITION #
        XPOS = XMASKOF INPOS;
        VDTCOR(YPOS,XPOS);
        END
      END
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
LEFTKEY:                             # CURSOR LEFT #
 
  IF TERTABAUTO[0] AND NOT TERTABHOME[0] THEN
    BEGIN                            # IF AUTOMATIC TABBING #
    IF NOT TERNOINVRS[0] AND NOT VALIDFIELD THEN
      BEGIN                          # IF AUTO-TAB TO PREVIOUS FIELD #
      LASTPOS = INPOS;               # SAVE CURRENT POSITION #
      TABKEY(SCREENST"BTAB",INPOS,FIELD,INPOS);
      IF INPOS EQ 0 AND TERPTDWBPG[0] THEN
        BEGIN                        # IF NO BACKWARD WRAP FROM HOME #
        INPOS = LASTPOS;             # RESTORE PREVIOUS POSITION #
        GOTO GETINP;                 # CONTINUE LOOKING AT INPUT #
        END
      IF INPOS EQ 0 AND NOT TERTABHOME[0] THEN
        BEGIN                        # IF TAB DOES NOT STOP AT HOME #
        TABKEY(SCREENST"BTAB",INPOS,FIELD,INPOS);
        END
      OFFSET = FLDLENGTH[FIELD] - 1; # SET OFFSET TO END OF FIELD #
      LASTFIELD = FIELD;             # UPDATE LAST VALID FIELD #
      INPOS = INPOS + OFFSET;        # RESET INTERNAL POSITION #
      YPOS = YMASKOF INPOS;
      XPOS = XMASKOF INPOS;
      VDTCOR(YPOS,XPOS);
      END
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
RIGHTKEY:                            # CURSOR RIGHT #
 
  IF TERTABAUTO[0] AND NOT TERTABHOME[0] THEN
    BEGIN                            # IF AUTOMATIC TABBING #
    IF NOT TERNOINVRS[0] AND NOT VALIDFIELD THEN
      BEGIN                          # IF AUTO-TAB TO NEXT FIELD #
      TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
      IF INPOS EQ 0 AND NOT TERTABHOME[0] THEN
        BEGIN                        # IF TAB DOES NOT STOP AT HOME #
        TABKEY(SCREENST"FTAB",INPOS,FIELD,INPOS);
        END
      OFFSET = 0;                    # CLEAR FIELD OFFSET #
      LASTFIELD = FIELD;             # UPDATE LAST VALID FIELD #
      YPOS = YMASKOF INPOS;          # RESET INTERNAL POSITION #
      XPOS = XMASKOF INPOS;
      VDTCOR(YPOS,XPOS);
      END
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
FORWARDTAB:                          # FORWARD TAB KEY PRESSED #
 
  IF TERTABPROT[0] THEN
    BEGIN                            # CAN TAB TO UNPROTECTED FIELD #
    LASTPOS = INPOS;                 # SAVE POSITION #
    TABKEY(ORD,INPOS,FIELD,INPOS);
    IF INPOS EQ 0 THEN
      BEGIN                          # IF LOGICALLY AT HOME #
      IF NOT TERPTDWFPG[0] THEN
        BEGIN                        # IF TAB CAN REALLY WRAP #
        IF NOT TERTABHOME[0] THEN
          BEGIN                      # IF TAB DOES NOT STOP AT HOME #
          TABKEY(ORD,INPOS,FIELD,INPOS);
          END
        OFFSET = 0;                  # CLEAR FIELD OFFSET #
        LASTFIELD = FIELD;           # UPDATE LAST VALID FIELD #
        END
      ELSE
        BEGIN                        # TAB DID NOT OCCUR ON SCREEN #
        INPOS = LASTPOS;
        END
      END
    YPOS = YMASKOF INPOS;            # RESET INTERNAL POSITION #
    XPOS = XMASKOF INPOS;
    VDTCOR(YPOS,XPOS);
    END
  ELSE
    BEGIN                            # SIMULATE WITH SOFT TAB #
    IF TERSOFTTAB[0] EQ 0 THEN TERSOFTPOS[0] = INPOS;
    TERSOFTTAB[0] = TERSOFTTAB[0] + 1;
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
BACKWRDTAB:                          # BACK TAB KEY PRESSED #
 
  IF TERTABPROT[0] THEN
    BEGIN                            # CAN TAB TO UNPROTECTED FIELD #
    LASTPOS = INPOS;                 # SAVE POSITION #
    TABKEY(ORD,INPOS,FIELD,INPOS);
    IF INPOS EQ 0 THEN
      BEGIN                          # IF LOGICALLY AT HOME #
      IF NOT TERPTDWBPG[0] THEN
        BEGIN                        # IF TAB CAN REALLY WRAP #
        IF NOT TERTABHOME[0] THEN
          BEGIN                      # IF TAB DOES NOT STOP AT HOME #
          TABKEY(ORD,INPOS,FIELD,INPOS);
          END
        OFFSET = 0;                  # CLEAR FIELD OFFSET #
        LASTFIELD = FIELD;           # UPDATE LAST VALID FIELD #
        END
      ELSE
        BEGIN                        # TAB DID NOT OCCUR ON SCREEN #
        INPOS = LASTPOS;
        END
      END
    YPOS = YMASKOF INPOS;            # RESET INTERNAL POSITION #
    XPOS = XMASKOF INPOS;
    VDTCOR(YPOS,XPOS);
    END
  ELSE
    BEGIN                            # SIMULATE WITH SOFT TAB #
    IF TERSOFTTAB[0] EQ 0 THEN TERSOFTPOS[0] = INPOS;
    TERSOFTTAB[0] = TERSOFTTAB[0] - 1;
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
CLEARPAGE:                           # CLEAR PAGE PRESSED #
 
  TERREWSCRN[0] = TRUE;              # COMPLETE REWRITE OF SCREEN #
  TERREWFLDS[0] = TRUE;
  SKIPINP = TRUE;                    # SKIP TO NEXT INPUT #
  GOTO GETINP;                       # GET INPUT AGAIN #
 
CLEAREOL:                            # CLEAR TO END OF LINE PRESSED #
 
  IF VALIDFIELD THEN
    BEGIN                            # IF IN ACTIVE INPUT FIELD #
    BFIELD(FIELD,OFFSET,DUMMY);      # BLANK FIELD IN VARDATA #
    FLDVALID[FIELD] = FALSE;
    FLDENTERED[FIELD] = TRUE;
    FLDREWRITE[FIELD] = TRUE;
    TERREWFLDS[0] = TRUE;
    END
 
REWRTLINE:                           # REWRITE REST OF FIELDS ON LINE #
 
  STARTFIELD = FIELD + 1;
  IF NOT TERTABPROT[0] OR TERCLEARSM[0] THEN
    BEGIN                            # IF MORE THAN ONE CLEARED #
    FOR I = STARTFIELD STEP 1 WHILE FLDENTRY[I] NQ 0
      AND FLDYCORD[I] LQ YPOS DO
      BEGIN                          # IF NOT PAST AFFECTED LINE #
      IF FLDYCORD[I] EQ YPOS AND FLDACTIVE[I]
        AND FLDXCORD[I]+FLDLENGTH[I] GQ XPOS THEN
        BEGIN                        # IF ACTIVE FIELD ON SAME LINE #
        IF FLDINPUTV[I] THEN
          BEGIN                      # IF ACTIVE INPUT FIELD #
          BFIELD(I,0,DUMMY);         # BLANK FIELD IN VARDATA #
          FLDVALID[I] = FALSE;
          FLDENTERED[I] = TRUE;
          END
        FLDREWRITE[I] = TRUE;
        TERREWFLDS[0] = TRUE;
        END
      END
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
 
ERASELINE:                           # SHIFT ERASE PRESSED #
 
  IF NOT TERTABPROT[0] THEN
    BEGIN                            # IF NO PROTECT #
    XPOS = 0;
    XMASKOF INPOS = XPOS;
    VDTCOR(YPOS,XPOS);               # REPOSITION TO START OF LINE #
    STARTFIELD = -1;
    GOTO REWRTLINE;                  # REWRITE ALL FIELDS ON LINE #
    END
  FFIELD(TERPREVPOS,FIELD,OFFSET,INSEARCH);
  IF FIELD GQ 0 THEN
    BEGIN                            # FOUND FIELD #
    BFIELD(FIELD,0,DUMMY);           # BLANK FIELD IN VARDATA #
    TERREWFLDS[0] = TRUE;
    FLDREWRITE[FIELD] = TRUE;
    FLDENTERED[FIELD] = TRUE;
    FLDVALID[FIELD] = FALSE;
    VDTCOR(FLDYCORD[FIELD],FLDXCORD[FIELD]);  # RESET INTERNAL POS #
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
ERASECHAR:                           # ERASE KEY PRESSED #
 
  IF TERTABAUTO[0] THEN
    BEGIN                            # IF AUTOMATIC TABBING #
    IF NOT TERNOINVRS[0] AND NOT VALIDFIELD THEN
      BEGIN                          # IF AUTO-TAB TO PREVIOUS FIELD #
      TABKEY(SCREENST"BTAB",INPOS,FIELD,INPOS);
      IF INPOS EQ 0 AND NOT TERTABHOME[0] THEN
        BEGIN                        # IF TAB DOES NOT STOP AT HOME #
        TABKEY(SCREENST"BTAB",INPOS,FIELD,INPOS);
        END
      OFFSET = FLDLENGTH[FIELD] - 1; # SET OFFSET TO END OF FIELD #
      LASTFIELD = FIELD;             # UPDATE LAST VALID FIELD #
      INPOS = INPOS + OFFSET;        # RESET INTERNAL POSITION #
      YPOS = YMASKOF INPOS;
      XPOS = XMASKOF INPOS;
      VDTCOR(YPOS,XPOS);
      END
    END
  IF VALIDFIELD THEN
    BEGIN                            # IF VALID FIELD #
    WRIVCH(FIELD,OFFSET,BLANK);      # WRITE BLANK INTO VARDATA #
    FLDENTERED[FIELD] = TRUE;
    FLDVALID[FIELD] = FALSE;         # INVALID UNTIL PROVEN VALID #
    END
  ELSE IF NOT TERTABAUTO[0] THEN
    BEGIN
    RESTFLD (INPOS);
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
APPLICFUN:
GENERICFUN:                          # FUNCTION KEY PRESSED #
 
  IF TERLEAVESM[0] NQ 0 THEN
    BEGIN                            # IF FUNCTION KEY LEFT MARK #
    IF VALIDFIELD THEN
      BEGIN                          # IF IN INPUT FIELD #
      FLDREWRITE[FIELD] = TRUE;      # SET REWRITE BIT FOR FIELD #
      TERREWFLDS[0] = TRUE;
      END
    ELSE
      BEGIN                          # IF NOT IN INPUT FIELD #
      RESTFLD (INPOS);
      END
    END
  IF NOT SKIPINP THEN
    BEGIN                            # PROCESS FUNCTION KEY #
    FUNKEY(INPOS,OFFSET,ORD,CHAR,FIELD);
    IF TERSOFTTAB[0] EQ 0 THEN
      BEGIN                          # IF FUNCTION KEY NOT SOFT TAB #
      SKIPINP = TRUE;                # SKIP INPUT #
      END
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
INSERTLINE:                          # INSERT LINE PRESSED #
DELETELINE:                          # DELETE LINE PRESSED #
  TERREWSCRN[0] = TRUE;              # FORCE SCREEN REWRITE #
  TERREWFLDS[0] = TRUE;
BADINPUT:                            # BAD INPUT RETURNED #
 
  INPUTERROR = TRUE;                 # UNSUPPORTED KEY ENTERED #
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
INSERTCHAR:                          # INSERT CHARACTER PRESSED #
 
  IF VALIDFIELD THEN
    BEGIN                            # SHIFT CHARACTERS IN VARDATA #
    FOR I = FLDLENGTH[FIELD] - 1 STEP - 1 UNTIL OFFSET + 1 DO
      BEGIN
      DUMMY = NEXTCHAR(FIELD,I-1);
      WRIVCH(FIELD,I,DUMMY);         # WRITE CHARACTER INTO VARDATA #
      END
    WRIVCH(FIELD,OFFSET,CHAR);       # WRITE CHARACTER INTO VARDATA #
    FLDENTERED[FIELD] = TRUE;
    FLDVALID[FIELD] = FALSE;
    FLDREWRITE[FIELD] = TRUE;
    TERREWFLDS[0] = TRUE;
    END
  IF NOT TERTABPROT[0] THEN
    BEGIN
    VDTCLL(XPOS,YPOS);               # CLEAR THE REST OF THE LINE #
    VDTPOS(XPOS,YPOS);
    GOTO REWRTLINE;                  # REWRITE THE REST OF THE LINE #
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
DELETECHAR:                          # DELETE CHARACTER PRESSED #
 
  IF VALIDFIELD THEN
    BEGIN                            # IF VALID FIELD #
    FOR I = OFFSET  STEP 1 UNTIL FLDLENGTH[FIELD] - 2 DO
      BEGIN                          # SHIFT CHARACTERS IN VARDATA #
      CHAR = NEXTCHAR(FIELD,I+1);
      WRIVCH(FIELD,I,CHAR);          # WRITE CHARACTER INTO VARDATA #
      END
    WRIVCH(FIELD,FLDLENGTH[FIELD]-1,BLANK);  # BLANK LAST CHARACTER #
    FLDENTERED[FIELD] = TRUE;
    FLDVALID[FIELD] = FALSE;
    FLDREWRITE[FIELD] = TRUE;
    TERREWFLDS[0] = TRUE;
    END
  IF NOT TERTABPROT[0] THEN
    BEGIN
    VDTCLL(XPOS,YPOS);               # CLEAR THE REST OF THE LINE #
    VDTPOS(XPOS,YPOS);
    GOTO REWRTLINE;                  # REWRITE THE REST OF THE LINE #
    END
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
NEWFIELD:                            # START OF NEW FIELD #
 
  IF VALIDFIELD THEN
    BEGIN                            # IF VALID INPUT FIELD #
    VDTINP(ORD,XPOS,YPOS,CHAR,DUMMY);
    FOR OFFSET = 0 STEP 1 WHILE ORD EQ SCREENST"CHAR" DO
      BEGIN                          # WHILE INPUT IS CHARACTERS #
      WRIVCH(FIELD,OFFSET,CHAR);     # WRITE CHARACTER INTO VARDATA #
      VDTINP(ORD,XPOS,YPOS,CHAR,DUMMY);
      END
    BFIELD(FIELD,OFFSET,DUMMY);      # BLANK FILL FIELD #
    FLDENTERED[FIELD] = TRUE;        # FIELD ENTERED #
    FLDVALID[FIELD] = FALSE;         # INVALID UNTIL PROVEN VALID #
    GOTO SKIPREAD;                   # CONTINUE #
    END
  ELSE
    BEGIN                            # INVALID FIELD #
    GOTO GETINP;                     # CONTINUE WITH INPUT #
    END
 
CONTINUE:                            # IGNORABLE INPUT ENTERED #
 
  GOTO GETINP;                       # CONTINUE LOOKING AT INPUT #
 
ENDOFINPUT:                          # END OF INPUT BUFFER #
 
  IF NOT (SKIPINP OR INPUTERROR OR TERHELPREQ[0]) THEN
    BEGIN                            # NEXT KEY WAS PRESSED #
    FUNKEY(INPOS,OFFSET,SCREENST"GKEY",GENERICST"GNEXT",FIELD);
    END
  IF TERSOFTTAB[0] NQ 0 THEN
    BEGIN                            # PERFORM SOFT TABS #
    STARTPOS = TERSOFTPOS[0];
    WHYLE TERSOFTTAB[0] NQ 0 DO
      BEGIN                          # UNTIL DONE WITH SOFT TABS #
      TABKEY(SCREENST"FTAB",STARTPOS,FIELD,STARTPOS);
      TERSOFTTAB[0] = TERSOFTTAB[0] - 1;
      IF FIELD EQ -1 THEN
        BEGIN
        TABKEY(SCREENST"FTAB",STARTPOS,FIELD,STARTPOS);
        END
      END
    OFFSET = 0;                      # CLEAR FIELD OFFSET #
    LASTFIELD = FIELD;               # UPDATE LAST VALID FIELD #
    YPOS = YMASKOF STARTPOS;
    XPOS = XMASKOF STARTPOS;
    VDTCOR(YPOS,XPOS);
    IF TERPENDHLP[0] THEN
      BEGIN                          # IF HELP PENDING #
      TERPENDHLP[0] = FALSE;         # CLEAR HELP PENDING #
      TERHELPFLD[0] = FIELD;         # SET FIELD REQUESTING HELP #
      TERHELPREQ[0] = TRUE;          # SET HELP REQUESTED FLAG#
      END
    END
  IF TERABNTERM[0] OR TERNRMTERM[0] THEN
    BEGIN                            # TERMINATION REQUESTED #
    IF (TERNRMTERM[0] AND NOT (INPUTERROR OR TERHELPREQ[0])) OR
       (TERABNTERM[0]) THEN
      BEGIN
      FLDIND = LASTFIELD;
      CPANEL;
      RETURN;
      END
    END
  IF NOT VALIDFIELD THEN FIELD = LASTFIELD;
  GOTO DOREAD;                       # READ INPUT AGAIN #
 
END  # READIN #
CONTROL EJECT;
 
PROC READSF(PANEL);
 
# TITLE READSF - READ SCREEN FORMATTED PANEL. #
 
BEGIN  # READSF #
 
#
**    READSF - READ SCREEN FORMATTED PANEL.
*
*     READSF CHECKS THAT ALL INPUT TO THE PANEL IS VALID.
*
*     PROC READSF(PANEL)
*
*     ENTRY   PANEL      = NAME OF PANEL TO READ.
*
*     EXIT    VARDATA CONTAINS INPUT DATA.
*
*     CALLS   CPANEL, FFIRST, GFIELD, PSTRNG, READIN, SFSWRI$, VALIDF.
*
*     USES    TERABNTERM, TERCURSROW, TERCURSSET, TERCURSVAR,
*             TERNRMTERM, TERREADFLG, TERREWFLDS,
*IF UNDEF,QTRM
*             TERNOINVRS, TERREWSCRN.
*ELSE
*             TERNOINVRS, TERREWSCRN, TERWAITINP.
*ENDIF
*
*     NOTES   IF PANEL IS NOT THE ACTIVE PANEL THEN SFSWRI$
*             IS CALLED TO WRITE THE PANEL TO THE SCREEN.
#
ITEM PANEL      C(7);              # INPUT PANEL NAME #
 
ITEM CHARIND    I;                 # CHARACTER OFFSET WITHIN FIELD #
ITEM CUROFF     I;                 # INITIAL CURSOR OFFSET #
*IF DEF,QTRM
ITEM FATAL      B = TRUE;          # FATAL ERROR #
*ENDIF
ITEM FLDIND     I;                 # POINTER INTO FIELD LIST #
ITEM INSP       C(10);             # DUMMY PARAMETER FOR SFSWRI$ #
ITEM LASTFIELD  I;                 # LAST FIELD ENTERED #
ITEM LEN        I = 7;             # FIXED PANEL NAME LENGTH #
*IF DEF,QTRM
ITEM MSG        C(43) = " PANEL MUST BE WRITTEN BEFORE READ IN QTRM.";
*ENDIF
ITEM OFF        I = 0;             # FIXED PANEL NAME OFFSET #
*IF DEF,QTRM
ITEM PNAME      C(7) = "SFSREA ";  # CALLING PROCEDURE #
*ENDIF
ITEM USEROW     B = TRUE;          # USE TERCURSROW #
ITEM VARIND     I;                 # INDEX INTO VARLIST #
*IF,DEF,QTRM
 
IF TERWAITINP[0] THEN GOTO READFIELDS;  # RESUME AFTER QTRM I/O #
 
*ENDIF
 
# INITIALIZE TERMINATION, REWRITE AND VARIABLE FLAGS #
 
TERABNTERM[0] = FALSE;
TERHELPREQ[0] = FALSE;
TERNOINVRS[0] = FALSE;
TERNRMTERM[0] = FALSE;
TERREWSCRN[0] = FALSE;
 
IF PANEL NQ TERACTPANL[0] THEN
  BEGIN                              # IF NEW ACTIVE PANEL #
*IF UNDEF,QTRM
  TERREADFLG[0] = TRUE;              # WRITE PANEL BEFORE READ #
  SFSWRI$(PANEL,LEN,OFF,INSP,LEN,OFF);
  TERREADFLG[0] = FALSE;
*ELSE
  ERRMSG(PANEL,PNAME,MSG,FATAL);     # NO READ BEFORE WRITE IN QTRM #
*ENDIF
  END
 
FLDIND = -1;
 
IF TERCURSSET[0] THEN
  BEGIN                              # IF SFSETP$ HAS BEEN CALLED #
  GFIELD(TERCURSVAR[0],USEROW,FLDIND);
  END
 
IF (FLDIND NQ -1 AND FLDINPUTV[FLDIND]) AND FLDACTIVE[FLDIND] THEN
  BEGIN                              # IF VALID FIELD #
  IF TERCURSSET[0] AND TERCURSOFF[0] LQ FLDLENGTH[FLDIND] - 1 THEN
    BEGIN                            # SFSETP$ SPECIFIED POSITION #
    CUROFF = TERCURSOFF[0];
    END
  ELSE
    BEGIN
    CUROFF = 0;                      # CLEAR OFFSET #
    END
  END
ELSE
  BEGIN                              # FIELD NOT FOUND #
  FFIRST(FLDIND);                    # FIND FIRST INPUT FIELD #
  IF FLDIND EQ -1 THEN
    BEGIN                            # IF NO ACTIVE INPUT FIELDS #
    TERNOINVRS[0] = TRUE;            # NO INPUT VARIABLES #
    END
  CUROFF = 0;
  END
 
  TERCURSSET[0] = FALSE;             # CLEAR SFSETP$ VARIABLES #
  TERCURSVAR[0] = "       ";
  TERCURSROW[0] = 0;
 
READFIELDS:                          # READ INPUT FIELDS #
 
  READIN(FLDIND,CUROFF);             # READ INPUT FROM TERMINAL #
*IF DEF,QTRM
 
  IF TERWAITINP[0] THEN RETURN;      # IF WAITING FOR INPUT, RETURN #
 
*ENDIF
  LASTFIELD = FLDIND;
  CUROFF = 0;
  FLDIND = 0;                        # CHECK ALL FIELDS #
 
  IF TERABNTERM[0] THEN RETURN;      # ABNORMAL TERMINATION #
 
  IF TERNOINVRS[0] THEN GOTO CHEKMISSED;  # NO FIELDS TO CHECK #
 
WHYLE FLDENTRY[FLDIND] NQ 0 DO
  BEGIN                              # UNTIL FIELD LIST EXHAUSTED #
  VARIND = FLDVARORD[FLDIND];        # CHECK FIELD VALIDATION #
  IF FLDACTIVE[FLDIND] AND FLDINPUTV[FLDIND] THEN
    BEGIN                            # IF ACTIVE INPUT FIELD #
    IF TERBLCKMDE[0] THEN
      BEGIN
      FOR CHARIND = FLDLENGTH[FLDIND]-1 STEP -1 UNTIL 0 DO
        BEGIN
        IF NEXTCHAR(FLDIND,CHARIND) NQ O"137" THEN CHARIND = 0;
        ELSE WRIVCH(FLDIND,CHARIND,O"40");
        END
      END
    IF(FLDENTERED[FLDIND] OR VARMUSENTR[VARIND] OR
      VARMUSCON[VARIND]) AND NOT FLDVALID[FLDIND] THEN
      BEGIN                          # IF FIELD TO BE CHECKED #
      VALIDF(FLDIND);
      IF NOT FLDVALID[FLDIND] THEN
        BEGIN                        # IF VALIDATION FAILED #
        PSTRNG(FLDIND,MESSSTAT"HELP");
        GOTO READFIELDS;             # NOTIFY USER OF ERROR #
        END
      END
    END
  FLDIND = FLDIND + 1;
END
 
CHEKMISSED:                          # TERMINATE IF NO FIELD MISSED #
 
  IF TERMISSINP[0] THEN
    BEGIN                            # IF INPUT OUTSIDE OF FIELDS #
    PSTRNG(LASTFIELD,MESSSTAT"CONFIRM");
    FLDIND = LASTFIELD;              # POSITION TO LAST FIELD ENTERED #
    GOTO READFIELDS;                 # REQUEST CONFIRMATION OF INPUT #
    END
 
TERREWFLDS[0] = FALSE;
 
END  # READSF #
CONTROL EJECT;
 
PROC RESTFLD (INPOS);
 
# TITLE RESTFLD - RESTORE DESTROYED FIELD. #
 
BEGIN  # RESTFLD #
 
#
**    RESTFLD - RESTORE DESTROYED FIELD.
*
*     RESTFLD MARKS AN ACTIVE FIELD AT *INPOS* FOR REWRITING,
*     OR WRITES A BLANK IF *INPOS* IS NOT IN AN ACTIVE FIELD.
*
*     PROC RESTFLD (INPOS)
*
*     ENTRY   INPOS = POSITION ON SCREEN.
*
*     EXIT    *FLDREWRITE* FLAG SET OR BLANK WRITTEN TO SCREEN.
#
ITEM INPOS      U;
 
ITEM FIELD      I;
ITEM I          I;
 
FIELD = -1;
FOR I = 0 STEP 1 WHILE FLDENTRY[I] NQ 0 AND FLDPOS[I] LS INPOS DO
  BEGIN                              # SEARCH FOR ACTIVE FIELD #
  IF FLDACTIVE[I] THEN FIELD = I;
  END
IF VALIDFIELD AND INPOS - FLDPOS[FIELD] LS FLDLENGTH[FIELD] THEN
  BEGIN                              # IF WITHIN THIS FIELD #
  FLDREWRITE[FIELD] = TRUE;
  TERREWFLDS[0] = TRUE;
  END
ELSE
  BEGIN                              # IF NOT IN ANY ACTIVE FIELD #
  VDTPOS(XMASKOF INPOS,YMASKOF INPOS);
  VDTOUT(BLANK);
  END
END  # RESTFLD #
CONTROL EJECT;
 
PROC REWFLD;
 
# TITLE REWFLD - REWRITE FIELDS. #
 
BEGIN  # REWFLD #
 
#
**    REWFLD - REWRITE FIELDS.
*
*     THIS PROCEDURE REWRITES FIELDS.
*
*     PROC REWFLD
*
*     ENTRY   TERNOREWRT = FALSE, IF REWRITING ALL VARIABLES.
*                        = TRUE, IF HONORING FIELD LIST REWRITE FLAG.
*
*     EXIT    FIELDS REWRITTEN TO SCREEN.
*
*     CALLS   SETATR, VDTSAM, VDTSTR, WRIVAR.
#
ITEM FLDINDEX  I;                    # INDEX INTO FIELD LIST #
ITEM VARINDEX I;                     # INDEX TO LAST VAR WRITTEN #
BASED ARRAY CONSTRING;;              # PASSES ADDRESS TO VDTSTR #
 
VARINDEX = - 2;                      # NO VARIABLES WRITTEN YET #
TERCURVORD[0] = - 1;                 # NO CURRENT ATTRIBUTES YET #
TERPREVPOS[0] = - 1;                 # LAST ATTRIBUTE POSITION #
FOR FLDINDEX = 0 STEP 1 WHILE FLDENTRY[FLDINDEX] NQ 0 DO
  BEGIN
  IF FLDACTIVE[FLDINDEX] AND (FLDREWRITE[FLDINDEX] OR
    ((NOT TERNOREWRT[0]) AND FLDVARFLAG[FLDINDEX])) OR
    (TERATTRCHR[0] AND VARINDEX EQ FLDINDEX - 1) THEN
    BEGIN                            # IF ACTIVE FIELD TO REWRITE #
    SETATR(FLDINDEX);                # SET FIELD ATTRIBUTES #
    IF FLDVARFLAG[FLDINDEX] THEN     # IF VARIABLE FIELD #
      BEGIN
      WRIVAR(FLDINDEX);              # WRITE VARIABLE FIELD #
      VARINDEX = FLDINDEX;
      END
    ELSE
      BEGIN                          # WRITE CONSTANT FIELD #
      P&lt;CONSTRING>=LOC(RECWORDC[FLDCONOS[FLDINDEX]]);
      VDTSTR(CONSTRING);
      FLDREWRITE[FLDINDEX] = FALSE;  # CLEAR REWRITE FIELD FLAG #
      END
    IF TERTABPROT[0] THEN
      BEGIN                          # IF PROTECTED TABBING #
      IF TERATTRSET[0] THEN
        BEGIN                        # RESET ATTRIBUTES BEFORE VDTPOS #
        IF TERCURVORD[0] NQ 2 THEN
          BEGIN                      # IF NOT PROTECTED OUTPUT #
          TERCURVORD[0] = 2;         # SET ORDINAL AND ISSUE IT #
          VDTSAM(O"6001");
          END
        END
      END
    END
  END
  IF NOT TERBLCKMDE[0] THEN
    BEGIN
    VDTSAM(0);
    END
  ELSE
    BEGIN
    VDTSAM(O"6001");
    END
 
END  # REWFLD #
CONTROL EJECT;
 
PROC REALRANGE(FLDIND,IVALUE,EVALUE);
 
# TITLE RRANGE - RANGE VALIDATION FOR REAL VARIABLES. #
 
BEGIN  # RRANGE #
 
#
**    REALRANGE - RANGE VALIDATION FOR REAL VARIABLES.
*
*     THIS PROCEDURE VALIDATES THAT INPUT TO THE VARIABLE POINTED TO
*     BY FLDIND IS WITHIN THE RANGE SPECIFIED IN THE PANEL RECORD.
*
*     PROC REALRANGE(FLDIND,IVALUE,EVALUE)
*
*     ENTRY   FLDIND     = INDEX OF CURRENT FIELD IN FLDLIST.
*             IVALUE     = THE INTEGER VALUE OF THE INPUT.
*             EVALUE     = THE EXPONENT VALUE OF THE INPUT.
*
*     EXIT    FLDVALID[FLDIND] = FALSE, IF INPUT IS INVALID.
#
ITEM FLDIND     I;                   # INDEX OF VARIABLE TO VALIDATE #
ITEM IVALUE     I;                   # INTEGER VALUE OF INPUT #
ITEM EVALUE     I;                   # EXPONENT VALUE OF INPUT #
 
ITEM FPSTAT     I;                   # GFP OVERFLOW STATUS #
ITEM MAXVAL     R;                   # MAXIMUM ALLOWED VALUE #
ITEM MINVAL     R;                   # MINIMUM ALLOWED VALUE #
ITEM OFFSET     I;                   # OFFSET OF VALIDATION IN RECORD #
ITEM RVALUE     R;                   # REAL VALUE OF INPUT #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
 
VARIND = FLDVARORD[FLDIND];
OFFSET = VARVALOS[VARIND];
MINVAL = RECWORDR[OFFSET];
MAXVAL = RECWORDR[OFFSET + 1];
 
FPSTAT = GFP(IVALUE,EVALUE,RVALUE);  # GENERATE REAL VALUE #
 
IF FPSTAT EQ 0 THEN
  BEGIN                              # IF NO ERROR IN REAL VALUE #
  IF (RVALUE LS MINVAL) OR (RVALUE GR MAXVAL) THEN
    BEGIN                            # IF VALUE OUTSIDE OF RANGE #
    FLDVALID[FLDIND] = FALSE;
    END
  END
ELSE
  BEGIN                              # ERROR IN REAL VALUE #
  FLDVALID[FLDIND] = FALSE;
  END
 
END  # REALRANGE #
CONTROL EJECT;
 
PROC SETATR(FLDINDEX);
 
# TITLE SETATR - SET FIELD ATTRIBUTES. #
 
BEGIN  # SETATR #
 
#
**    SETATR - SET FIELD ATTRIBUTES.
*
*     THIS PROCEDURE SETS THE FIELD ATTRIBUTES FOR A GIVEN FIELD.
*
*     PROC SETATR(FLDINDEX)
*
*     ENTRY   FLDINDEX   = INDEX INTO FIELD TABLE
*
*     CALLS   VDTSAM, VDTSAP.
#
ITEM FLDINDEX   I;                   # FIELD INDEX #
 
VDTSAP(TERPREVPOS[0],FLDXCORD[FLDINDEX],FLDYCORD[FLDINDEX]);
TERPREVPOS[0] = TERPREVPOS[0] + FLDLENGTH[FLDINDEX] + 1;
IF (FLDATTORD[FLDINDEX] NQ TERCURVORD[0])
  OR TERBLCKMDE[0] OR TERATTRCHR[0] THEN
  BEGIN                              # IF NEED TO SET ATTRIBUTES #
  TERCURVORD[0] = FLDATTORD[FLDINDEX];
  VDTSAM(ATTMASK[TERCURVORD[0]]);
  END
 
END  # SETATR #
*IF DEF,QTRM
CONTROL EJECT;
 
PROC SETFSF(PANELADDR);
 
# TITLE SETFSF - SET FIELD STATUS FLAGS FOR PANEL. #
 
BEGIN  # SETFSF #
 
#
**    SETFSF - SET FIELD STATUS FLAGS FOR PANEL.
*
*     THIS PROCEDURE GOES THROUGH THE FIELD LIST ENTRIES IN THE PANEL
*     (FLDLIST)SETTING THE ENTERED, VALID, REWRITE AND ACTIVE FLAGS
*     TO THEIR DEFAULT VALUE.  THIS ASSURES THAT PANELS USED BY MORE
*     THAN ONE USER WILL PRODUCE COMPLETE OUTPUT THE FIRST TIME THEY
*     ARE WRITTEN TO THE SCREEN.  THE ENTRY AND VALIDATION FIELDS
*     ARE SET FALSE AND THE REWRITE AND ACTIVE FIELDS ARE SET TO TRUE.
*     AT THIS TIME VARDATA IS ALSO RESET (TO ALL BLANKS).
*
*     PROC SETFSF
*
*     ENTRY   PANELADDR  = ADDRESS OF PANEL.
*
*     EXIT    FIELD STATUS FLAGS RESET TO DEFAULT VALUES.
*             VARDATA BLANKED OUT.
#
ITEM PANELADDR  I;                   # PANEL ADDRESS #
 
ITEM I          I;                   # COUNTER #
ITEM VDATALEN   I;                   # VARDATA LENGTH #
 
POSARR(PANELADDR);                   # POSITION BASED ARRAYS #
 
FOR I = 0 STEP 1 WHILE FLDENTRY[I] NQ 0 DO
  BEGIN                              # FOR ENTIRE FIELD LIST #
  FLDENTERED[I] = FALSE;
  FLDVALID[I] = FALSE;
  FLDREWRITE[I] = TRUE;
  FLDACTIVE[I] = TRUE;
  END
 
  IF PANSTRFLD[0] NQ 0 THEN
    BEGIN                            # IF FIELDS EXIST #
    VDATALEN = P&lt;FLDLIST> - (PANELADDR + PANHEADLEN);
    END
  ELSE
    BEGIN                            # NO FIELDS #
    VDATALEN = P&lt;VARLIST> - (PANELADDR + PANHEADLEN);
    END
                                     # RESET VARDATA #
  FOR I = 0 STEP 1 UNTIL VDATALEN - 1 DO
    BEGIN                            # CLEAR VARDATA TO BLANKS #
    VDATAU[I] = O"0040 0040 0040 0040 0040";
    END
 
END  # SETFSF #
*ENDIF
CONTROL EJECT;
 
PROC SETSRN(COLUMNS,LINES);
 
# TITLE SETSRN - SET SCREEN. #
 
BEGIN  # SETSRN #
 
#
**    SETSRN - SET SCREEN.
*
*     THIS PROCEDURE SETS THE TERMINAL INTO SCREEN MODE, USING LINES
*     AND COLUMNS AS THE DESIRED SCREEN SIZE, AND UPDATES THE GLOBAL
*     VARIABLES THAT HOLD THE ACTUAL NUMBER OF LINES AND COLUMNS AND
*     THE TERMINAL ATTRIBUTE CHARACTERISTICS.
*
*     PROC SETSRN(COLUMNS,LINES)
*
*     ENTRY   COLUMNS     = THE NUMBER OF DESIRED COLUMNS.
*             LINES       = THE NUMBER OF DESIRED LINES.
*
*     EXIT    TERPROTECT = TRUE IF TERMINAL HAS PROTECT.
*             TERGUARDMD = TRUE IF TERMINAL HAS GUARD MODE.
*             TERTABHOME = TRUE IF HARD TAB GOES TO HOME.
*             TERTABPROT = TRUE IF CAN TAB TO PROTECTED FIELDS.
*             TERSIZECLR = TRUE IF RESET OF SIZE CLEARS SCREEN.
*             TERTABAUTO = TRUE IF AUTOMATIC TABBING AVAILABLE.
*             TERNUMCOLS = THE ACTUAL NUMBER OF COLUMNS.
*             TERNUMLNES = THE ACTUAL NUMBER OF LINES.
*             TERLEAVESM = FUNCTION KEY LEAVES MARK COUNT.
*             TERSCREENM = TRUE.
*
*IF UNDEF,QTRM
*     CALLS   VDTGTD, VDTGTF, VDTOPN, VDTSTD, VDTSTM.
*ELSE
*     CALLS   VDTGTD, VDTGTF, VDTSTD, VDTSTM.
*ENDIF
*
*     USES    TERGUARDMD, TERLEAVESM, TERNUMCOLS, TERNUMLNES,
*             TERPROTECT, TERSCREENM, TERSIZECLR, TERTABAUTO,
*             TERTABHOME, TERTABPROT.
#
ITEM COLUMNS    U;                   # DESIRED NUMBER OF COLUMNS #
ITEM LINES      U;                   # DESIRED NUMBER OF LINES #
 
ITEM SCREEN     I = 1;               # INDICATES SCREEN MODE TO VDT #
ITEM ATTRWORD   U;                   # TERMINAL ATTRIBUTES WORD #
 
*IF UNDEF,QTRM
VDTOPN;                              # OPEN TERMINAL #
*ENDIF
VDTSTM(SCREEN,DUMMY);                # SET SCREEN MODE #
VDTSTD(COLUMNS,LINES);               # SET SCREEN DIMENSIONS #
VDTGTD(COLUMNS,LINES);               # GET ACTUAL VALUES #
TERNUMCOLS[0] = COLUMNS - 1;         # SET INTERNAL VALUE #
TERNUMLNES[0] = LINES - 1;           # SET INTERNAL VALUE #
FOR DUMMY = 2 STEP 1 UNTIL 4 DO
  BEGIN
  VDTGTF(ATTRWORD,DUMMY);            # GET TERMINAL ATTRIBUTES #
  TERMSTATWD[DUMMY] = ATTRWORD;      # SAVE TERMINAL ATTRIBUTES #
  END
TERSCREENM[0] = TRUE;                # TERMINAL IS IN SCREEN MODE #
 
END  # SETSRN #
CONTROL EJECT;
 
PROC SFLOAD(PANELNAME,PANELADDR,OPENSTAT);
 
# TITLE SFLOAD - LOAD PANEL. #
 
BEGIN  # SFLOAD #
 
#
**    SFLOAD - LOAD PANEL.
*
*     THIS PROCEDURE CALLS THE FAST DYNAMIC LOADER TO LOAD THE
*     SPECIFIED PANEL AND ISSUES AN INFORMATIVE MESSAGE IF THE
*     LOAD WAS UNSUCCESSFUL DUE TO AN INTERNAL F.D.L. ERROR.
*
*     PROC SFLOAD(PANELNAME,PANELADDR,OPENSTAT)
*
*     ENTRY   PANELNAME  = NAME OF PANEL TO BE LOADED.
*
*     EXIT    PANEL LOADED IF POSSIBLE, OPENSTAT SET, INFORMATIVE
*             DAYFILE MESSAGE ISSUED IF NECESSARY.
*
*     CALLS   ERRMSG, LCP.
*
*     NOTES   OPENSTAT IS SET BY SFLOAD (AND RETURNED TO SFOPEN)
*             IN THOSE INSTANCES WHERE THE FAST DYNAMIC LOADER
*             IS CALLED.
*
*             OPENSTAT   SIGNIFICANCE                     PROCEDURE
*             .....................................................
*             .   0   .  NO ERROR                        .  BOTH  .
*             .   1   .  UNKNOWN PANEL NAME              . SFLOAD .
*             .   2   .  INCORRECT CAPSULE FORMAT        . SFLOAD .
*             .   3   .  PLT FULL (TOO MANY OPEN PANELS) . SFOPEN .
*             .   4   .  PANEL ALREADY OPEN              . SFOPEN .
*             .   5   .  INTERNAL (FAST DYNAMIC LOADER)  . SFLOAD .
*             .   6   .  NO SCREEN COMMAND ISSUED        . SFOPEN .
*             .   7   .  UNSUPPORTED TERMINAL            . SFOPEN .
*             .....................................................
#
ITEM PANELNAME  C(7);                # NAME OF PANEL TO LOAD #
ITEM PANELADDR  I;                   # MEMORY ADDRESS OF PANEL #
ITEM OPENSTAT   I;                   # RETURNS STATUS TO APPLICATION #
 
ITEM FATAL      B = FALSE;           # OPEN ERRORS ARE NOT FATAL #
ITEM FDLSTAT    I;                   # RETURNS STATUS FROM LOADER #
ITEM MSG        C(25);               # DAYFILE ERROR MESSAGE #
ITEM PNAME      C(6) = "SFOPEN";     # PROCEDURE NAME #
 
SWITCH LOADCASE                      # F.D.L. STATUS RETURN SWITCH #
  NOERROR,                           # SUCCESSFUL LOAD #
  BADLIBRARY,                        # BAD LIBRARY LIST #
  BADGROUP,                          # BAD GROUP NAME #
  UNKNOWNCAP,                        # UNKNOWN CAPSULE NAME #
  BADFORMAT,                         # BAD CAPSULE FORMAT #
  BADENTRY,                          # BAD PASSLOC/ENTRY FORMAT #
  DUPLOAD,                           # CAPSULE ALREADY IN MEMORY #
  CAPOVCAP;                          # CAPSULE/OVCAP CONFUSION #
 
LCP(PANELNAME,PANELADDR,FDLSTAT);    # CALL FAST DYNAMIC LOADER #
 
#
*  SIMULATED CASE STATEMENT FOR PROCESSING LOADER RETURN STATUS.
#
 
GOTO LOADCASE[FDLSTAT];              # PROCESS STATUS FROM LOADER #
 
NOERROR:                             # NO ERROR #
  OPENSTAT = OPENSTATUS"NOERROR";    # UPDATE PANEL LOAD TABLE #
  PLTNUMENT[0] = PLTNUMENT[0]+1;
  PLTENAME[PLTNUMENT[0]]=PANELNAME;
  PLTSLFLAG[PLTNUMENT[0]]=FALSE;
  PLTOPENFLG[PLTNUMENT[0]]=TRUE;
  PLTADDR[PLTNUMENT[0]]=PANELADDR;
  GOTO ENDCASE;
 
BADLIBRARY:                          # BAD LIBRARY LIST #
  OPENSTAT = OPENSTATUS"INTERNAL";   # ISSUE INFORMATIVE MESSAGE #
  MSG = " BAD LIBRARY LIST.       ";
  ERRMSG(PANELNAME,PNAME,MSG,FATAL);
  GOTO ENDCASE;
 
BADGROUP:                            # UNKNOWN GROUP NAME #
  OPENSTAT = OPENSTATUS"INTERNAL";   # ISSUE INFORMATIVE MESSAGE #
  MSG = " BAD GROUP NAME.         ";
  ERRMSG(PANELNAME,PNAME,MSG,FATAL);
  GOTO ENDCASE;
 
UNKNOWNCAP:                          # UNKNOWN CAPSULE NAME #
  OPENSTAT = OPENSTATUS"UNPANEL";    # UNKNOWN CAPSULE NAME #
  GOTO ENDCASE;
 
BADFORMAT:                           # BAD CAPSULE FORMAT #
  OPENSTAT = OPENSTATUS"INCAPFOR";   # BAD CAPSULE FORMAT #
  GOTO ENDCASE;
 
BADENTRY:                            # BAD PASSLOC/ENTRY FORMAT #
  OPENSTAT = OPENSTATUS"INTERNAL";   # ISSUE INFORMATIVE MESSAGE #
  MSG = " BAD ENTRY FORMAT.       ";
  ERRMSG(PANELNAME,PNAME,MSG,FATAL);
  GOTO ENDCASE;
 
DUPLOAD:                             # CAPSULE ALREADY IN MEMORY #
  OPENSTAT = OPENSTATUS"INTERNAL";   # ISSUE INFORMATIVE MESSAGE #
  MSG = " DUPLICATE LOAD.         ";
  ERRMSG(PANELNAME,PNAME,MSG,FATAL);
  GOTO ENDCASE;
 
CAPOVCAP:                            # CAPSULE/OVCAP CONFUSION #
  OPENSTAT = OPENSTATUS"INTERNAL";   # ISSUE INFORMATIVE MESSAGE #
  MSG = " OVCAP CONFUSION.        ";
  ERRMSG(PANELNAME,PNAME,MSG,FATAL);
 
ENDCASE:
 
#
*  END OF CASE STATEMENT FOR PROCESSING LOADER RETURN STATUS.
#
 
END  # SFLOAD #
CONTROL EJECT;
 
PROC SKPBLK(FLDIND,CHARPOS,CHAR);
 
# TITLE SKPBLK - SKIP BLANKS. #
 
BEGIN  # SKPBLK #
 
#
**    SKPBLK - SKIP BLANKS.
*
*     THIS PROCEDURE SKIPS BLANKS IN A FIELD IN VARDATA AND RETURNS
*     THE POSITION OF THE FIRST NON-BLANK CHARACTER.
*
*     PROC SKPBLK(FLDIND,CHARPOS,CHAR)
*
*     ENTRY   FLDIND     = INDEX OF FIELD IN FLDLIST.
*             CHARPOS    = STARTING CHARACTER POSITION IN FIELD.
*
*     EXIT    CHARPOS    = POSTION OF FIRST NON-BLANK CHARACTER.
*             CHAR       = FIRST NON-BLANK CHARACTER.
#
ITEM FLDIND     I;                   # INDEX OF FIELD IN FLDLIST #
ITEM CHARPOS    I;                   # CHARACTER POSITION IN FIELD #
ITEM CHAR       I;                   # INPUT CHARACTER #
 
ITEM BLANKCHAR  B;                   # BLANK CHARACTER INPUT #
 
BLANKCHAR = TRUE;
 
WHYLE BLANKCHAR AND CHARPOS LQ FLDLENGTH[FLDIND] DO
  BEGIN
  CHAR = NEXTCHAR(FLDIND,CHARPOS);
  IF CHAR NQ BLANK THEN
    BEGIN                            # IF NOT BLANK CHARACTER #
    BLANKCHAR = FALSE;
    END
  ELSE
    BEGIN                            # BLANK CHARACTER #
    CHARPOS = CHARPOS + 1;
    END
  END
 
END  # SKPBLK #
CONTROL EJECT;
 
PROC TABKEY(ORDINAL,INPOS,NEWFIELD,OUTPOS);
 
# TITLE TABKEY - PROCESS TABKEY. #
 
BEGIN  # TABKEY #
 
#
**    TABKEY - PROCESS TAB KEY.
*
*     THIS PROCEDURE IS CALLED TO PROCESS TABS.  IN THE CASE OF
*     OF A HARD TAB ON A TERMINAL WITH PROTECT MODE VIRTERM HAS
*     AN INCORRECT INTERNAL CURSOR POSITION WHICH WILL HAVE TO BE
*     RESET.  TABKEY DETERMINES THE CURSOR POSITION AND NOTIFIES
*     VIRTEM THROUGH VDTCOR.  FOR SOFT TABS (INCLUDING TAB KEYS
*     ON TERMINALS WITHOUT PROTECT MODE) THE CURSOR POSITION IS
*     INCORRECT BUT WILL BE FIXED THE NEXT TIME THAT PROCEDURE
*     READIN DOES A VDTPOS.
*
*     PROC TABKEY(ORDINAL,INPOS,FIELD,OUTPOS)
*
*     ENTRY    ORDINAL     = FTAB, FORWARD TAB KEY
*                          = BTAB, BACKWARD TAB KEY
*              INPOS       = LINE AND COLUMN WHERE TAB KEY WAS PRESSED
*
*     EXIT     OUTPOS      = NEW X/Y POSITION
*              NEWFIELD    = NEW FIELD POSITION
*
*     NOTES    CURSOR IS POSITIONED TO HOME IF TABBED BEYOND FIRST OR
*              LAST INPUT FIELD.
#
ITEM ORDINAL    I;                   # ORDINAL OF TAB KEY #
ITEM INPOS      I;                   # LINE AND COLUMN WHERE PRESSED #
ITEM NEWFIELD   I;                   # ORDINAL OF FIELD TABBED TO #
ITEM OUTPOS     I;                   # NEW LINE AND COLUMN #
 
ITEM FIELDFOUND B;                   # FOUND FIELD TABBED TO #
ITEM I          I;                   # LOOP COUNTER #
ITEM P          I;                   # POINTER TO PREVIOUS FIELD #
 
P = -1;
NEWFIELD = -1;
FIELDFOUND = FALSE;
 
IF ORDINAL EQ SCREENST"FTAB" THEN
  BEGIN                              # FORWARD TAB KEY PRESSED #
  FOR I = 0 STEP 1 WHILE FLDENTRY[I] NQ 0
    AND NOT FIELDFOUND DO
    BEGIN                            # LOOK FOR NEXT INPUT FIELD #
    IF FLDINPUTV[I] AND FLDACTIVE[I] THEN
      BEGIN
      IF INPOS LS FLDPOS[I]
        AND (TERPTDWFLN[0] OR NOT (P GQ 0
        AND FLDYCORD[P] EQ FLDYCORD[I]-1 AND FLDXCORD[I] EQ 0
        AND FLDXCORD[P]+FLDLENGTH[P] EQ TERNUMCOLS[0]+1)) THEN
        BEGIN                        # IF NEXT NON-CONTIGUOUS FIELD #
        FIELDFOUND = TRUE;
        NEWFIELD = I;
        END
      ELSE P = I;
      END
    END
  END
ELSE
  BEGIN                            # BACKWARD TAB KEY PRESSED #
  IF INPOS EQ 0 THEN
    BEGIN
    XMASKOF INPOS = TERNUMCOLS[0];
    YMASKOF INPOS = TERNUMLNES[0];
    END
  P = -1;
  FOR I = 0 STEP 1 WHILE FLDENTRY[I] NQ 0 AND FLDPOS[I] LS INPOS DO
    BEGIN                            # LOOK FOR NEXT INPUT FIELD #
    IF FLDINPUTV[I] AND FLDACTIVE[I] THEN
      BEGIN
      IF TERPTDWBLN[0] OR NOT (P GQ 0
        AND FLDYCORD[P] EQ FLDYCORD[I]-1 AND FLDXCORD[I] EQ 0
        AND FLDXCORD[P]+FLDLENGTH[P] EQ TERNUMCOLS[0]+1) THEN
        NEWFIELD = I;                # IF FIELDS NOT CONTIGUOUS #
      P = I;
      END
    END
  END
 
IF NEWFIELD GQ 0 THEN
  BEGIN                              # IF FIELD FOUND #
  OUTPOS = FLDPOS[NEWFIELD];
  END
ELSE
  BEGIN                              # FIELD NOT FOUND #
  OUTPOS = 0;
  END
 
END  # TABKEY #
CONTROL EJECT;
 
PROC VALIDF(FLDIND);
 
# TITLE VALIDF - VALIDATE FIELD. #
 
BEGIN  # VALIDF #
 
#
**    VALIDF - VALIDATE FIELD.
*
*     THIS PROCEDURE CALLS THE APPROPRIATE VALIDATION PROCEDURE
*     AS WELL AS CONVERTING INTEGER AND REAL VARIABLE INPUT TO
*     THE CORRECT NUMERIC VALUE.
*
*     PROC VALIDF(FLDIND)
*
*     ENTRY   FLDIND     = INDEX OF CURRENT FIELD IN FLDLIST.
*
*     EXIT    FLDVALID[FLDIND] = FALSE, IF NUMERIC INPUT IS INVALID.
*
*     CALLS   DATEVL, IRANGE, MATCHV, NCHECK, PICVAL, RRANGE.
#
ITEM FLDIND     I;                   # INDEX OF FIELD #
 
ITEM ALLBLANK   B;                   # ALL BLANKS IN FIELD #
ITEM DOLLARSIGN B;                   # $ IN INPUT #
ITEM EVAL       I;                   # EXPONENT VALUE OF INPUT #
ITEM I          I;                   # LOOP COUNTER #
ITEM INPTYPE    I;                   # INPUT FORMAT TYPE #
ITEM IVAL       I;                   # INTEGER VALUE OF INPUT #
ITEM NOTFULL    B;                   # FIELD CONTAINS A BLANK #
ITEM STARRED    B;                   # * ("DON-T KNOW") ENTERED #
ITEM VARIND     I;                   # INDEX INTO VARLIST #
 
SWITCH VARITYPE                      # VARIABLE TYPE #
  RESERV,                            # RESERVED #
  CHARACVAR,                         # CHARACTER VARIABLE #
  INTEGERVAR,                        # INTEGER VARIABLE #
  REALVAR;                           # REAL VARIABLE #
 
VARIND = FLDVARORD[FLDIND];
FLDVALID[FLDIND] = TRUE;             # TRUE UNTIL PROVEN FALSE #
 
IF VARMUSENTR[VARIND] AND NOT FLDENTERED[FLDIND] THEN
  BEGIN                              # IF MUST ENTERED AND NOT #
  FLDVALID[FLDIND] = FALSE;          # PROVEN FALSE #
  RETURN;
  END
 
ALLBLANK = TRUE;                     # SET FLAGS AND CHECK CHARACTER #
STARRED = FALSE;
NOTFULL = FALSE;
IF NEXTCHAR(FLDIND,0) EQ ASTERISK AND NOT VARMUSKNOW[VARIND] THEN
  BEGIN                              # IF ASTERISK AND NOT MUST KNOW #
  STARRED = TRUE;
  END
IF NEXTCHAR(FLDIND,0) NQ BLANK THEN
  BEGIN                              # IF NOT A BLANK #
  ALLBLANK = FALSE;                  # NOT ALL BLANKS #
  END
ELSE
  BEGIN                              # A BLANK #
  NOTFULL = TRUE;                    # UNFULL #
  END
FOR I = 1 STEP 1 WHILE I LQ FLDLENGTH[FLDIND] -1 DO
  BEGIN                              # EXAMINE THE REST OF THE FIELD #
  IF NEXTCHAR(FLDIND,I) NQ BLANK THEN
    BEGIN                            # IF NOT A BLANK #
    ALLBLANK = FALSE;                # NOT ALL BLANKS #
    STARRED = FALSE;                 # NOT STARRED #
    END
  ELSE
    BEGIN                            # A BLANK #
    NOTFULL = TRUE;                  # UNFULL #
    END
  END
IF STARRED THEN RETURN;              # ASTERISK AND NOT *MUST KNOW* #
IF(VARMUSFILL[VARIND] AND FLDENTERED[FLDIND] AND
  (NOTFULL AND NOT ALLBLANK)) OR (VARMUSCON[VARIND] AND ALLBLANK) THEN
  BEGIN                              # IF MUST FILL AND NOT FULL OR #
  FLDVALID[FLDIND] = FALSE;          # MUST CONTAIN AND ALL BLANKS  #
  RETURN;
  END
IF NOT VARMUSENTR[VARIND] AND ALLBLANK THEN RETURN;
 
GOTO VARITYPE[VARTYPE[VARIND]];
 
RESERV:
CHARACVAR:                           # VALIDATE CHARACTER VARIABLE #
 
  IF VARVALM[VARIND] THEN MATCHV(FLDIND);
  IF VARPICTYPE[VARIND] NQ 0 THEN PICVAL(FLDIND);
  RETURN;
 
INTEGERVAR:                          # VALIDATE INTEGER VARIABLE #
 
  IF VARPICTYPE[VARIND] GR FORMTYPE"E" THEN
    BEGIN                            # DATE VALIDATION #
    DATEVL(FLDIND,IVAL,EVAL);
    END
  ELSE
    BEGIN
    NCHECK(FLDIND,IVAL,EVAL,INPTYPE,DOLLARSIGN);
    IF INPTYPE EQ FORMTYPE"BAD" OR INPTYPE GR VARPICTYPE[VARIND]
      OR VARPICTYPE[VARIND] EQ FORMTYPE"E" AND DOLLARSIGN THEN
      BEGIN
      FLDVALID[FLDIND] = FALSE;
      RETURN;
      END
    END
  IF VARVALM[VARIND] THEN MATCHV(FLDIND);
  IF VARVALR[VARIND] THEN IRANGE(FLDIND,IVAL,EVAL);
  RETURN;
 
REALVAR:                             # VALIDATE REAL VARIABLE #
 
  IF VARPICTYPE[VARIND] GR FORMTYPE"E" THEN
    BEGIN
    DATEVL(FLDIND,IVAL,EVAL);
    END
  ELSE
    BEGIN
    NCHECK(FLDIND,IVAL,EVAL,INPTYPE,DOLLARSIGN);
    IF INPTYPE EQ FORMTYPE"BAD" OR INPTYPE GR VARPICTYPE[VARIND]
      OR VARPICTYPE[VARIND] EQ FORMTYPE"E" AND DOLLARSIGN THEN
      BEGIN
      FLDVALID[FLDIND] = FALSE;
      RETURN;
      END
    END
  IF VARVALM[VARIND] THEN MATCHV(FLDIND);
  IF VARVALR[VARIND] THEN REALRANGE(FLDIND,IVAL,EVAL);
 
END  # VALIDF #
CONTROL EJECT;
 
PROC WRIALL;
 
# TITLE WRIALL - WRITE ALL PANELS. #
 
BEGIN  # WRIALL #
 
#
**    WRIALL - WRITE ALL PANELS.
*
*     THIS PROCEDURE REWRITES ALL PANELS THAT ARE ON THE SCREEN IN
*     THE ORDER THAT THEY WERE WRITTEN.
*
*     PROC WRIALL
*
*     ENTRY    TERACTPANL = THE NAME OF THE ACTIVE PANEL.
*              PLTNUMONSC = THE NUMBER OF PANELS ON THE SCREEN.
*
*     EXIT     COMPLETE SCREEN REWRITTEN.
*
*     CALLS    CLRLNS, POSARR, REWFLD, VDTCAA, VDTCLS, VDTPRO, VDTSAM,
*              WRIBOX, WRITES.
*
*     NOTES    THIS PROCEDURE IS CALLED BY READ IN THE CASE OF
*              A CLEAR PAGE AND BY WRIPAN IF AN OVERLAY WRITE
*              HAS CAUSED A SHIFT FROM 80 TO 132 COLUMN MODE.
*              IF THE ACTIVE PANEL IS NOT THE LAST PANEL TO BE
*              REWRITTEN THEN ITS VARIABLES WILL BE REWRITTEN
*              ONCE MORE TO INSURE THAT THEY ARE CORRECT.
#
ITEM PANELADDR  I;                   # PANEL ADDRESS #
ITEM PANELNAME  C(7);                # PANEL NAME #
ITEM PLTINDEX   I;                   # PANEL LOAD TABLE INDEX #
ITEM NUMWRITTEN I;                   # NUMBER OF PANELS WRITTEN #
 
VDTCLS;                              # CLEAR SCREEN #
NUMWRITTEN = 0;                      # NO PANELS WRITTEN YET #
 
WHYLE NUMWRITTEN NQ PLTNUMONSC[0] DO
  BEGIN
  NUMWRITTEN = NUMWRITTEN + 1;
  PLTINDEX = 1;                      # FIND CORRECT PANEL #
  WHYLE PLTENTRYNM[PLTINDEX] NQ NUMWRITTEN DO
    BEGIN
    PLTINDEX = PLTINDEX + 1;
    END
  PANELNAME = PLTENAME[PLTINDEX];    # WRITE PANEL #
  PANELADDR = PLTADDR[PLTINDEX];
  IF PLTNUMONSC[0] NQ 1 THEN POSARR(PANELADDR);
  IF NOT PANPRIPAN[0] THEN CLRLNS;
  IF PANSTRFLD[0] NQ 0 THEN WRITES;
  IF PANSTRBOX[0] NQ 0 THEN WRIBOX;
  END
 
IF PANELNAME NQ TERACTPANL[0] THEN
  BEGIN                              # IF NEED TO REWRITE VARIABLES #
  PANELADDR = PLTADDR[TERACTPLTI[0]];
  POSARR(PANELADDR);
  IF PANPRIPAN[0] THEN
    BEGIN                            # IF PRIMARY PANEL #
    IF NOT TERPROCLRS[0] THEN VDTPRO(OUT"PROTECTALL");
    IF PANNUMBYTE[0] NQ 0 THEN REWFLD;
    END
  ELSE
    BEGIN                            # IF OVERLAY PANEL #
    CLRLNS;
    IF PANSTRFLD[0] NQ 0 THEN WRITES;
    IF PANSTRBOX[0] NQ 0 THEN WRIBOX;
    END
  END
 
  IF NOT TERBLCKMDE[0] THEN VDTSAM(0); ELSE VDTCAA(0);
 
END  # WRIALL #
CONTROL EJECT;
 
PROC WRIBOX;
 
# TITLE WRIBOX - WRITE BOX. #
 
BEGIN  # WRIBOX #
 
#
**    WRIBOX - WRITE BOX.
*
*     THIS PROCEDURE WRITES THE BOXES DEFINED IN THE BOX LIST OF
*     THE ACTIVE PANEL TO THE SCREEN.
*
*     PROC WRIBOX
*
*     CALLS   VDTBOX, VDTDRW, VDTPOS, VDTPRO, VDTSAM.
*
*     NOTES   WRIBOX DOES CURSOR POSITIONING AND ATTRIBUTE SELECTION
*             (WHICH INCLUDES SELECTION OF THE PROPER LINE WEIGHT
*             FOR THE LINE DRAWING CHARACTER SET) AND DOES NOT DE-
*             PEND ON THE CALLING PROCEDURE FOR THESE FUNCTIONS.
#
ITEM BOXINDEX   I;                   # INDEX INTO THE BOX LIST #
ITEM CURWEIGHT  I;                   # CURRENT LINE WEIGHT #
ITEM NUMCHARS   I;                   # NUMBER OF CHARACTERS #
 
IF PANSTRFLD[0] EQ 0 AND NOT TERPROCLRS[0] THEN
  BEGIN                              # IF NO FIELDS AND NO CLEAR #
  VDTPRO(OUT"PROTECTALL");           # ISSUE GLOBAL PROTECT #
  END
 
TERCURVORD[0] = -1;                  # NO CURRENT ATTRIBUTES YET #
CURWEIGHT = -1;                      # NO CURRENT LINE WEIGHT YET #
 
FOR BOXINDEX = 0 STEP 1 WHILE BOXWORD[BOXINDEX] NQ 0 DO
  BEGIN                              # CHECK FOR ATTRIBUTE CHANGE #
  IF BOXATTORD[BOXINDEX] NQ TERCURVORD[0] THEN
    BEGIN                            # SET NEW ATTRIBUTES #
    TERCURVORD[0] = BOXATTORD[BOXINDEX];
    IF NOT TERATTRCHR[0] THEN VDTSAM(ATTMASK[TERCURVORD[0]]);
    END
  IF ATTLINEWT[TERCURVORD[0]] NQ CURWEIGHT THEN
    BEGIN                            # SET NEW LINE WEIGHT #
    CURWEIGHT = ATTLINEWT[TERCURVORD[0]];
    VDTDRW(CURWEIGHT);
    END
  IF BOXREPEAT[BOXINDEX] GR 1 THEN
    BEGIN                            # IF HORIZONTAL / VERTICAL LINE #
    IF BOXCHAR[BOXINDEX] EQ 0 THEN
      BEGIN                          # IF HORIZONTAL LINE #
      IF BOXYCORD[BOXINDEX] LQ TERNUMLNES[0] THEN
        BEGIN                        # IF LINE WITHIN LINE BOUNDARY #
        VDTPOS(BOXXCORD[BOXINDEX],BOXYCORD[BOXINDEX]);
        FOR NUMCHARS = 0 STEP 1 UNTIL BOXREPEAT[BOXINDEX]-1 DO
          BEGIN                      # OUTPUT HORIZONTAL LINE #
          IF BOXXCORD[BOXINDEX] + NUMCHARS LQ TERNUMCOLS[0] THEN
            BEGIN                    # IF WITHIN COLUMN BOUNDARY #
            VDTBOX(BOXCHAR[BOXINDEX]);
            END
          END
        END
      END
    ELSE
      BEGIN                          # IF VERTICAL LINE #
      IF BOXXCORD[BOXINDEX] LQ TERNUMCOLS[0] THEN
        BEGIN                        # IF LINE WITHIN COLUMN BOUNDARY #
        FOR NUMCHARS = 0 STEP 1 UNTIL BOXREPEAT[BOXINDEX]-1 DO
          BEGIN                      # OUTPUT VERTICAL LINE #
          IF BOXYCORD[BOXINDEX] + NUMCHARS LQ TERNUMLNES[0]THEN
            BEGIN                    # IF WITHIN LINE BOUNDARY #
            VDTPOS(BOXXCORD[BOXINDEX],BOXYCORD[BOXINDEX]+NUMCHARS);
            VDTBOX(BOXCHAR[BOXINDEX]);
            END
          END
        END
      END
    END
  ELSE
    BEGIN                            # OUTPUT SINGLE BOX CHARACTER #
    IF BOXYCORD[BOXINDEX] LQ TERNUMLNES[0]
      AND BOXXCORD[BOXINDEX] LQ TERNUMCOLS[0] THEN
      BEGIN                          # IF CHARACTER WITHIN BOUNDARIES #
      VDTPOS(BOXXCORD[BOXINDEX],BOXYCORD[BOXINDEX]);
      VDTBOX(BOXCHAR[BOXINDEX]);
      END
    END
  END
 
VDTDRW(0);                           # TURN OFF LINE DRAWING #
 
END  # WRIBOX #
CONTROL EJECT;
 
PROC WRIPAN;
 
# TITLE WRIPAN - WRITE PANEL. #
 
BEGIN  # WRIPAN #
 
#
**    WRIPAN - WRITE PANEL.
*
*     THIS PROCEDURE DETERMINES IF THE PANEL TO BE WRITTEN IS
*     A PRIMARY OR AN OVERLAY PANEL, ASSURES THAT THE TERMINAL
*     IS IN SCREEN MODE AND CALLS THE PROPER ROUTINES TO WRITE
*     THE PANEL TO THE SCREEN.
*
*     PROC WRIPAN
*
*     ENTRY   TERACTPANL = THE NAME OF THE PANEL TO BE WRITTEN.
*             TERACTPLTI = THE CORRESPONDING PLT INDEX.
*
*     EXIT    PANEL WRITTEN TO SCREEN.
*
*     CALLS   REWFLD, SETSRN, WRIALL, WRIBOX, WRITES, VDTCAA, VDTCLS,
*             VDTGTD, VDTPRO, VDTSAM, VDTSTD.
*
*     NOTES   IF AN ATTEMPT IS MADE TO WRITE AN OVERLAY PANEL
*             WITHOUT A PREVIOUS PRIMARY PANEL BEING WRITTEN
*             (I.E. THE TERMINAL IS IN LINE MODE) THEN A DAY-
*             FILE MESSAGE WILL BE ISSUED AND THE PROGRAM WILL
*             BE ABORTED.
#
ITEM FATAL      B = TRUE;            # FATAL ERROR #
ITEM HOLDCOLS   I;                   # NUMBER OF REQUESTED COLUMNS #
ITEM HOLDLINES  I;                   # NUMBER OF REQUESTED LINES #
ITEM MSG        C(25) = " NOT PRIMARY.            ";  # ERROR MSG. #
ITEM PANELADDR  I;                   # ADDRESS OF PANEL RECORD #
ITEM PLTCOUNT   I;                   # COUNTER TO CLEAR PLT #
ITEM PNAME      C(6) = "SFSWRI";     # PROCEDURE NAME #
 
IF PLTENTRYNM[TERACTPLTI[0]] NQ 0 THEN
  BEGIN                              # IF PANEL IS ON SCREEN #
  IF PANPRIPAN[0] THEN
    BEGIN                            # IF PRIMARY ON SCREEN #
    IF PLTNUMONSC[0] GR 1 AND NOT TERPROCLRS[0] THEN
      BEGIN                          # IF MORE THAN 1 AND NO CLEAR #
      VDTPRO(OUT"PROTECTALL");       # ISSUE GLOBAL PROTECT #
      END
    IF PANNUMBYTE[0] NQ 0 THEN REWFLD;
    END
  ELSE
    BEGIN                            # IF OVERLAY ON SCREEN #
    CLRLNS;                          # CLEAR NECESSARY LINES #
    IF PANSTRFLD[0] NQ 0 THEN WRITES;
    IF PANSTRBOX[0] NQ 0 THEN WRIBOX;
    IF NOT TERBLCKMDE[0] THEN VDTSAM(0); ELSE VDTCAA(0);
    FOR PLTCOUNT = 1 STEP 1 UNTIL PLTNUMENT[0] DO
      BEGIN                          # UPDATE SEQUENCE NUMBERS #
      IF PLTENTRYNM[PLTCOUNT] GR PLTENTRYNM[TERACTPLTI[0]] THEN
        BEGIN
        PLTENTRYNM[PLTCOUNT] = PLTENTRYNM[PLTCOUNT]-1;
        END
      END
    PLTENTRYNM[TERACTPLTI[0]] = PLTNUMENT[0];
    END
  END
ELSE
  BEGIN                              # IF PANEL NOT ON SCREEN #
  HOLDCOLS = PANNUMCOLS[0];          # GET REQUESTED COLUMNS #
  HOLDLINES = PANNUMLNES[0];         # GET REQUESTED LINES #
  IF PANPRIPAN[0] THEN
    BEGIN                            # IF PRIMARY NOT ON SCREEN #
    IF NOT TERSCREENM[0] THEN
      BEGIN                          # IF NOT IN SCREEN MODE #
      SETSRN(HOLDCOLS,HOLDLINES);    # SET SCREEN MODE #
      END
    ELSE
      BEGIN
      VDTSTD(HOLDCOLS,HOLDLINES);    # SET SCREEN SIZE #
      VDTGTD(HOLDCOLS,HOLDLINES);    # GET ACTUAL VALUES #
      TERNUMCOLS[0] = HOLDCOLS - 1;  # SET INTERNAL VALUE #
      TERNUMLNES[0] = HOLDLINES - 1; # SET INTERNAL VALUE #
      END
    VDTCLS;
    TERCNWRIOV[0] = TRUE;            # ALLOW OVERLAY WRITE #
    FOR PLTCOUNT = 1 STEP 1 UNTIL PLTNUMENT[0] DO
      BEGIN                          # CLEAR SEQUENCE NUMBERS #
      PLTENTRYNM[PLTCOUNT] = 0;
      END
    PLTNUMONSC[0] = 1;               # ONE PANEL ON SCREEN #
    PLTENTRYNM[TERACTPLTI[0]] = 1;
    TERMESWRIT[0] = FALSE;
    TERMESREAD[0] = FALSE;
    IF TERPROCLRS[0] THEN VDTPRO(OUT"PROTECTALL");
    IF PANSTRFLD[0] NQ 0 THEN WRITES;
    IF PANSTRBOX[0] NQ 0 THEN WRIBOX;
    IF NOT TERBLCKMDE[0] THEN VDTSAM(0); ELSE VDTCAA(0);
    END
  ELSE
    BEGIN                            # IF OVERLAY NOT ON SCREEN #
    IF NOT TERCNWRIOV[0] THEN ERRMSG(TERACTPANL[0],PNAME,MSG,FATAL);
    PLTNUMONSC[0] = PLTNUMONSC[0] + 1;
    PLTENTRYNM[TERACTPLTI[0]] = PLTNUMONSC[0];
    IF HOLDCOLS GR TERNUMCOLS[0] OR HOLDLINES GR TERNUMLNES[0] THEN
      BEGIN
      VDTSTD(HOLDCOLS,HOLDLINES);    # SET SCREEN SIZE #
      VDTGTD(HOLDCOLS,HOLDLINES);    # GET ACTUAL VALUES #
      IF HOLDCOLS NQ TERNUMCOLS[0] + 1 OR
         HOLDLINES NQ TERNUMLNES[0] + 1 THEN
        BEGIN                        # IF SCREEN SIZE CHANGED, RESET #
        TERNUMCOLS[0] = HOLDCOLS - 1;
        TERNUMLNES[0] = HOLDLINES - 1;
        WRIALL;                      # WRITE ALL PANELS #
        END
      ELSE
        BEGIN                        # NO CHANGE TO SCREEN SIZE #
        CLRLNS;                      # CLEAR NECESSARY LINES #
        IF PANSTRFLD[0] NQ 0 THEN WRITES;
        IF PANSTRBOX[0] NQ 0 THEN WRIBOX;
        IF NOT TERBLCKMDE[0] THEN VDTSAM(0); ELSE VDTCAA(0);
        END
      END
    ELSE
      BEGIN
      CLRLNS;                        # CLEAR NECESSARY LINES #
      IF PANSTRFLD[0] NQ 0 THEN WRITES;
      IF PANSTRBOX[0] NQ 0 THEN WRIBOX;
      IF NOT TERBLCKMDE[0] THEN VDTSAM(0); ELSE VDTCAA(0);
      END
    END
  END
 
END  # WRIPAN #
CONTROL EJECT;
 
PROC WRITES;
 
# TITLE WRITES - WRITE SCREEN. #
 
BEGIN  # WRITES #
 
#
**    WRITES - WRITE SCREEN.
*
*     THIS PROCEDURE WRITES THE PANEL TO THE SCREEN USING THE
*     POSITIONING INFORMATION FOUND IN THE FIELD LIST AND THE
*     DATA FOUND IN THE CONSTANT LIST AND VARIABLE DATA AREAS.
*
*     PROC WRITES
*
*     EXIT    PANEL WRITTEN TO SCREEN.
*
*     CALLS   SETATR, VDTCAA, VDTPRO, VDTSAM, VDTSTR, WRIVAR.
#
ITEM FLDINDEX  I;                    # INDEX INTO FIELD LIST #
BASED ARRAY CONSTRING;;              # PASSES ADDRESS TO VDTSTR #
 
TERCURVORD[0] = -1;                  # NO CURRENT ATTRIBUTES YET #
TERPREVPOS[0] = -1;                  # LAST ATTRIBUTE POSITION #
 
IF NOT TERPROCLRS[0] THEN VDTPRO(OUT"PROTECTALL");
 
FOR FLDINDEX = 0 STEP 1 WHILE FLDENTRY[FLDINDEX] NQ 0 DO
  BEGIN
  IF FLDACTIVE[FLDINDEX] THEN
    BEGIN
    IF FLDXCORD[FLDINDEX] + FLDLENGTH[FLDINDEX] LQ TERNUMCOLS[0] + 1
      AND FLDYCORD[FLDINDEX] LQ TERNUMLNES[0] THEN
      BEGIN                          # IF FIELD ON SCREEN #
      SETATR(FLDINDEX);              # SET FIELD ATTRIBUTES #
      IF FLDVARFLAG[FLDINDEX] THEN   # IF VARIABLE FIELD #
        BEGIN
        WRIVAR(FLDINDEX);            # WRITE VARIABLE FIELD #
        END
      ELSE
        BEGIN                        # WRITE CONSTANT FIELD #
        P&lt;CONSTRING>=LOC(RECWORDC[FLDCONOS[FLDINDEX]]);
        VDTSTR(CONSTRING);
        FLDREWRITE[FLDINDEX] = FALSE;  # CLEAR REWRITE FIELD FLAG #
        END
        IF TERTABPROT[0] THEN
          BEGIN                      # IF PROTECTED TABBING #
          IF TERATTRSET[0] THEN
            BEGIN                    # RESET ATTRIBUTES BEFORE VDTPOS #
            IF TERCURVORD[0] NQ 2 THEN
              BEGIN                  # IF NOT PROTECTED OUTPUT #
              TERCURVORD[0] = 2;     # SET ORDINAL AND ISSUE IT #
              VDTSAM(O"6001");
              END
            END
          END
      END
    ELSE
      BEGIN                          # IF FIELD NOT ON SCREEN #
      FLDACTIVE[FLDINDEX] = FALSE;   # CLEAR ACTIVE FIELD FLAG #
      FLDREWRITE[FLDINDEX] = FALSE;  # CLEAR REWRITE FIELD FLAG #
      END
    END
  END
  IF NOT TERBLCKMDE[0] THEN VDTSAM(0); ELSE VDTSAM(O"6001");
 
END  # WRITES #
CONTROL EJECT;
 
PROC WRIVAR(FLDINDEX);
 
# TITLE WRIVAR - WRITE VARIABLE. #
 
BEGIN  # WRIVAR #
 
#
**    WRIVAR - WRITE VARIABLE.
*
*     THIS PROCEDURE WRITES THE VARIABLE POINTED AT BY FLDINDEX
*     TO THE SCREEN.
*
*     PROC WRIVAR(FLDINDEX)
*
*     ENTRY   FLDINDEX   = INDEX INTO THE FIELD LIST.
*
*     EXIT    VARIABLE WRITTEN TO SCREEN.
*
*     NOTES   CURSOR POSITIONING HAS BEEN DONE BY THE CALLING
*             PROCEDURE AS WELL AS ATTRIBUTE SELECTION.
*
*     CALLS     VDTPSU.
#
ITEM FLDINDEX   I;                   # INDEX INTO THE FIELD LIST #
 
ITEM CHARACTER  I;                   # HOLDS ONE CHARACTER FOR VDTCHR #
ITEM CHARINDEX  I;                   # CHARACTER OFFSET INTO VARDATA #
ITEM ENDCHAR    I;                   # LOCATION OF LAST NON-BLANK #
ITEM NUMCHARS   I;                   # NUMCHARS TO WRITE #
ITEM WORDINDEX  I;                   # WORD OFFSET INTO VARDATA #
 
FLDREWRITE[FLDINDEX] = FALSE;        # CLEAR REWRITE FIELD FLAG #
 
IF NOT TERDONTCLR[0] THEN
  BEGIN                              # CLEAR READ FLAGS #
  FLDENTERED[FLDINDEX] = FALSE;
  FLDVALID[FLDINDEX] = FALSE;
  END
ENDCHAR = 0;
IF FLDOUTPUTV[FLDINDEX] THEN
  BEGIN                              # IF NOT INPUT ONLY VARIABLE #
  CHARINDEX = FLDVDTCORD[FLDINDEX]+FLDLENGTH[FLDINDEX];
  WORDINDEX = CHARINDEX / 5;
  CHARINDEX = 2*(CHARINDEX - (WORDINDEX * 5));
  FOR NUMCHARS = FLDLENGTH[FLDINDEX] STEP -1
    WHILE NUMCHARS GR ENDCHAR DO
    BEGIN                            # FIND LAST NON-BLANK CHARACTER #
    IF CHARINDEX GR 0 THEN CHARINDEX = CHARINDEX - 2;
    ELSE
      BEGIN                          # IF AT END OF WORD #
      CHARINDEX = 8;
      WORDINDEX = WORDINDEX - 1;     # UPDATE WORD INDEX #
      END
    CHARACTER =  C&lt;CHARINDEX,2>VDATAC[WORDINDEX];
    IF CHARACTER GR O"40" AND CHARACTER LQ O"176" THEN
      ENDCHAR = NUMCHARS;            # IF DISPLAYABLE NON-BLANK #
    END
  WORDINDEX = FLDVDTCORD[FLDINDEX] / 5;
  CHARINDEX = 2*(FLDVDTCORD[FLDINDEX] - (WORDINDEX * 5));
  FOR NUMCHARS = 1 STEP 1 UNTIL ENDCHAR DO
    BEGIN                            # OUTPUT VARIABLE #
    IF CHARINDEX EQ 10 THEN
      BEGIN                          # UPDATE WORD INDEX #
      CHARINDEX = 0;
      WORDINDEX = WORDINDEX + 1;
      END
    CHARACTER = C&lt;CHARINDEX,2>VDATAC[WORDINDEX];
    IF CHARACTER GR O"40"
      AND CHARACTER LQ O"176" THEN
      BEGIN                          # IF NON-BLANK AND DISPLAYABLE #
      VDTCHR(CHARACTER);             # OUTPUT CHARACTER #
      END
    ELSE
      BEGIN                          # BLANK OR NONDISPLAYABLE #
      VDTPSU;                        # PSEUDO UNDERLINE #
      END
    CHARINDEX = CHARINDEX + 2;       # UPDATE CHARACTER INDEX #
    END
  END
FOR NUMCHARS = ENDCHAR+1 STEP 1 UNTIL FLDLENGTH[FLDINDEX] DO
  BEGIN
  IF TERBLCKMDE[0] AND FLDINPUTV[FLDINDEX] THEN
    BEGIN
    VDTCHR(O"137");                  # SEND UNDERLINE TO SCREEN #
    END
  ELSE
    BEGIN
    VDTPSU;
    END
  END
 
END  # WRIVAR #
CONTROL EJECT;
 
PROC WRIVCH(FIELD,OFFSET,CHAR);
 
# TITLE WRIVCH - WRITE CHARACTER INTO VARDATA. #
 
BEGIN  # WRIVCH #
 
#
**    WRIVCH - WRITE CHARACTER INTO VARDATA.
*
*     PROC WRIVCH(FIELD,OFFSET,CHAR)
*
*     ENTRY   FIELD      = FIELD INDEX.
*             OFFSET     = CHARACTER POSITION IN FIELD.
*             CHAR       = CHARACTER INPUT.
*
*     EXIT    CHAR WRITTEN INTO VARDATA.
#
ITEM FIELD      I;                   # INDEX OF CURRENT FIELD #
ITEM OFFSET     I;                   # CHARACTER OFFSET INTO FIELD #
ITEM CHAR       I;                   # CHARACTER TO PUT INTO VARDATA #
 
ITEM CHARIND    I;                   # CHARACTER INDEX INTO VARDATA #
ITEM CHARPOS    I;                   # CHARACTER POSITION IN VARDATA #
ITEM WORDIND    I;                   # WORD INDEX INTO VARDATA #
 
CHARPOS = FLDVDTCORD[FIELD] + OFFSET;
WORDIND = CHARPOS/5;
CHARIND = CHARPOS - 5*WORDIND;
B&lt;CHARIND*12,12>VDATAU[WORDIND] = CHAR;
 
END  # WRIVCH #
 
END  # SFORM #  TERM
Retro1.org codex

Table of Contents

SFORM

Table Of Contents

Source Code
