SFORM 
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<51,9>#;           # X COORDINATE PART OF FLDPOS #
DEF  YMASKOF    #B<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<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<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<NOFFSET,NLENGTH>NAME;  # LEFT JUSTIFY PANEL NAME #
  
*IF UNDEF,QTRM
P<PLTABLE> = LOC(PLT);               # REFERENCE PANEL LOAD TABLE # 
*ELSE 
P<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<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<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<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<Q$HEADER> = CHAIN;
  
IF QLEN LS 1 THEN QLEN = 7;          # CRACK PARAMETER #
QUEUENAME = C<QOFF,QLEN>QNAME;
  
WHYLE P<Q$HEADER> NQ 0 DO 
  BEGIN                              # SEARCH FOR QUEUE FOR THIS ACN #
  IF (( NIT$CON EQ Q$ACN ) AND
      ( C<0,3>QNAME EQ C<0,3>Q$NAME )) THEN 
  IF NIT$CON EQ Q$ACN AND QUEUENAME EQ Q$NAME THEN
    BEGIN                            # IF QUEUE IS FOUND #
    P<Q$BUFFER> = P<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<B$CURBIT,12> B$WD0[B$CURWORD] = B<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<Q$HEADER>;           # ADDRESS FOR CMM #
        I = Q$BACK;                  # BACK POINTER # 
        J = Q$FORWARD;               # FORWARD POINTER #
        P<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<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<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<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<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<OFFIND,1>STRING = " ";
  ELSE
    IF C<I,1>RETVAL EQ 0 THEN        # IF BEYOND ACTUAL MODEL NAME #
      C<OFFIND,1>STRING = " ";
    ELSE
      C<OFFIND,1>STRING = C<I,1>RETVAL; 
  OFFIND = OFFIND + 1;
  IF (OFFIND GR 9) THEN 
    BEGIN                            # IF END OF CURRENT WORD # 
    OFFIND = 0; 
    P<TEMP> = P<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<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<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<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<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<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<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<PLTABLE> = LOC(PLT);             # INITIALIZE THE NIT PLT AREA #
  I = PLTNUMENT[0]; 
  P<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<QOFF,QLEN>QNAME;
  
P<B$BUFF> = LOC(BUFFER);
B$CURBIT = 0;                        # START AT BEGINNING OF BUFFER # 
B$CURWORD = 0;
ENTCT = ENTCT + 1;
  
SFNQUE1:  
  
  I = 0;
  P<Q$HEADER> = CHAIN;
  WHYLE P<Q$HEADER> NQ 0 DO 
    BEGIN                            # FIND QUEUE NAME FOR THIS ACN # 
    IF (( NIT$CON EQ Q$ACN ) AND
        ( C<0,3>QNAME EQ C<0,3>Q$NAME )) THEN 
    IF NIT$CON EQ Q$ACN AND QUEUENAME EQ Q$NAME THEN
      BEGIN                          # IF FOUND # 
      P<Q$BUFFER> = P<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<BIT,12>Q$WORD[WORD] = B<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<Q$HEADER>;                 # QUEUE DOESN-T EXIST, CREATE IT # 
    P<Q$HEADER> = Q$FORWARD;         # ADD BLOCK TO END OF CHAIN #
    END 
  
  IF CHAIN EQ 0 THEN
    BEGIN                            # IF NO CHAIN HEADER # 
    P<Q$HEADER> = LOC(CHAIN); 
    END 
  ELSE
    BEGIN                            # CHAIN HEADER EXISTS #
    P<Q$HEADER> = I;
    END 
  
  CMMALF (Q$BLKSIZE,0,0,RCC); 
  Q$FORWARD = RCC;
  I = P<Q$HEADER>;
  P<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<0,6>MODELNAME EQ "      " THEN 
      BEGIN                          # IF TERMINAL UNDEFINED #
      TERMODNAME[0] = "       ";
      OPENSTAT = OPENSTATUS"UNSPTERM";
      END 
    ELSE
      BEGIN                          # SUPPORTED TERMINAL # 
      TERMODNAME[0] = MODELNAME;
      P<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<NOFFSET,NLENGTH>NAME; 
*IF DEF,QTRM
  
# CHECK FOR PANEL IN THIS USERS PLT AREA #
  
  P<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<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<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<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<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<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<NIT> = LOC(NITADDR);               # SAVE NIT ADDRESS # 
IF CURRNT$ACN EQ 0 THEN 
  BEGIN                              # IF FIRST CALL TO SFQTRM$ # 
  CURRNT$ACN = NIT$CON[0];
  P<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<PCT> = NIT$PCT[CURRNT$ACN];    # SAVE PREVIOUS TERMINAL-S STATE # 
    TERFLDADDR  = P<FLDLIST>;        # SAVE FIELD LIST ADDRESS #
    P<QTRM$BUFFER> = P<PCT> + SFORMOFFSET;
    FOR I = 0 STEP 1 UNTIL SFORMSIZE -1 DO
      BEGIN                          # MOVE SFORM DATA #
      QTRM$WD0[I] = TERMSTATWD[I];
      END 
    P<QTRM$BUFFER> = P<PCT> + VTERMOFFSET;
    FOR I = 0 STEP 1 UNTIL VTERMSIZE - 1 DO 
      BEGIN                          # MOVE VIRTERM DATA #
      QTRM$WD0[I] = COMVDT$WD0[I];
      END 
    P<QTRM$BUFFER> = P<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<CHARIND*4,4>QTRM$WD0[WORDIND] = FLDSTFLAGS[I];
        END 
      END 
    P<QTRM$BUFFER> = P<PCT> + VDTAOFFSET; 
    PANELADDR = P<VDATA> - PANHEADLEN;
    IF PANSTRFLD[0] NQ 0 THEN 
      BEGIN                          # IF FIELDS EXISTS # 
      VDATALEN = P<FLDLIST> - (PANELADDR + PANHEADLEN); 
      END 
    ELSE
      BEGIN                          # NO FIELDS #
      VDATALEN = P<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<PCT> = NIT$PCT[CURRNT$ACN]; 
      P<PLTABLE> = NIT$PCT[CURRNT$ACN] + PLTOFFSET; 
      P<QTRM$BUFFER> = P<PCT> + SFORMOFFSET;
      FOR I = 0 STEP 1 UNTIL SFORMSIZE - 1 DO 
        BEGIN                        # MOVE SFORM DATA #
        TERMSTATWD[I] = QTRM$WD0[I];
        END 
      P<FLDLIST> = TERFLDADDR;       # FLDLIST ADDRESS #
      P<QTRM$BUFFER> = P<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<QTRM$BUFFER> = P<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<CHARIND*4,4>QTRM$WD0[WORDIND];
            END 
          END 
        PANELNAME = TERACTPANL[0];   # GET PANEL NAME # 
        GETADD(PANELNAME,PANELADDR,PLTINDEX); 
        POSARR(PANELADDR);
        P<QTRM$BUFFER> = P<PCT> + VDTAOFFSET; 
        PANELADDR = P<VDATA> - PANHEADLEN;
        IF PANSTRFLD[0] NQ 0 THEN 
          BEGIN 
          VDATALEN = P<FLDLIST> - (PANELADDR + PANHEADLEN); 
          END 
        ELSE
          BEGIN 
          VDATALEN = P<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<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<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<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<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<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<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<PANINDEX,1>PANELNAME NQ SPACE
    AND C<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<16,25>DAYMESSAGE = NONAME;       # OVER RIDE PROCEDURE MSG. # 
  END 
ELSE
  BEGIN                              # PUT IN NAME AND MESSAGE #
  C<16,PANLEN>DAYMESSAGE = PANELNAME; 
  C<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<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<48,12>MATCHCHAR = C<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<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<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<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<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<FROMSTRING> = LOC(VDATAU[WORDIND]); 
    P<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<FROMSTRING> = LOC(STRG);
    FROMCHAROS = SOS;                # CHARACTER OFFSET / FROM STRING # 
    P<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<FROMSTRING> = STRINGADDR;        # POSITION FROM AND TO STRING #
  P<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<FROMSTRING> = LOC(VDATAU[0]);    # POSITION FROM AND TO STRING #
  P<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<TOCHAROS,2>TOSTRIU[TOINDEX] = 
    C<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<TOCHAROS,2>TOSTRIU[TOINDEX] = B<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<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<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<TOCHAROS,2>TOSTRIU[TOINDEX] = B<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<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<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<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<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<6*TOCHAROS,6>TOSTRIU[TOINDEX] = 
    A82DC[B<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<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<6*TOCHAROS,12>TOSTRIU[TOINDEX] =
    DC2A8[B<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<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<RECORD> = PANELADDR;               # POSITION BASED ARRAYS #
P<PANELHEADR> = PANELADDR;
P<VDATA> = PANELADDR + PANHEADLEN;
  
IF PANSTRFLD[0] NQ 0 THEN 
  BEGIN                              # IF PANEL HAS FIELD LIST #
  P<FLDLIST> = PANELADDR + PANSTRFLD[0];
  END 
ELSE
  BEGIN                              # NO FIELD LIST, ONLY BOXES #
  P<FLDLIST> = LOC(ZEROWORD); 
  END 
  
P<VARLIST> = PANELADDR + PANSTRVAR[0];
P<FUNLIST> = PANELADDR + PANSTRFUN[0];
P<ATTLIST> = PANELADDR + PANSTRATT[0];
P<ARRLIST> = PANELADDR + PANSTRARR[0];
P<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<PANEL2HEAD> = PANELADDR;
  
IF PAN2STRFLD[0] NQ 0 THEN
  BEGIN                              # IF PANEL HAS FIELD LIST #
  P<FLD2LIST> = PANELADDR + PAN2STRFLD[0];
  END 
ELSE
  BEGIN                              # NO FIELD LIST, ONLY BOXES #
  P<FLD2LIST> = LOC(ZEROWORD);
  END 
  
P<VAR2LIST> = PANELADDR + PAN2STRVAR[0];
P<ATT2LIST> = PANELADDR + PAN2STRATT[0];
P<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<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<MESSNAME> = LOC(DEFMESSAGE[0]);  # *PLEASE ENTER* # 
        END 
      ELSE
        BEGIN                        # DATA ENTERED IN FIELD #
        P<MESSNAME> = LOC(CORMESSAGE[0]);  # *PLEASE CORRECT* # 
        END 
      END 
    END 
  ELSE
    BEGIN                            # NO INPUT FIELD # 
    MSGFIT = TRUE;                   # SMF MESSAGE WILL FIT # 
    P<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<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<MESSNAME> = LOC(CONMESSAGE[0]);  # *PLEASE CONFIRM* # 
    END 
  ELSE
    BEGIN                            # NO INPUT FIELD # 
    P<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<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<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<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<FLDLIST> - (PANELADDR + PANHEADLEN); 
    END 
  ELSE
    BEGIN                            # NO FIELDS #
    VDATALEN = P<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<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<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<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<CHARIND*12,12>VDATAU[WORDIND] = CHAR; 
  
END  # WRIVCH # 
  
END  # SFORM #  TERM
