*DECK PRIVACY 
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TEXPRES 
USETEXT TXSTD 
#----------------------------------------------------------------------#
#                                                                      #
#     P R I V A C Y                                                    #
#                                                                      #
#     THE DECK *PRIVACY* CONTAINS ALL OF THE PROCS NEEDED TO PROCESS   #
#     THE *ACCESS KEY* DIRECTIVE.  IT RESIDES IN OVERLAY (1,14).       #
#                                                                      #
#     PROCS XDEF-ED IN *PRIVACY*:                                      #
#         CATNAM                                                       #
#         READIS                                                       #
#         RESETPR                                                      #
#         SAVALL                                                       #
#         SAVAREA                                                      #
#         SAVARES                                                      #
#         SAVCAT                                                       #
#         SAVIO                                                        #
#         SAVKEY                                                       #
#         SETIO                                                        #
#         SETPR                                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC PRIVACY; 
      BEGIN 
      XREF ITEM AREATBLPTR I;      # PTR TO BASED ARRAY *AREA$TABLE*   #
      XREF ITEM CATBLPTR I;        # PTR TO BASED ARRAY *CATABLE*      #
      XREF ITEM CATGORD I;         # ORDINAL OF CATALOG                #
      XREF ITEM CDCSCAT B;         # TRUE IF IN CDCS CATALOG MODE      #
      XREF ITEM CDCSDBM B;         # TRUE IF IN CDCS DATABASE MODE     #
      XREF ITEM MXTRNLG I;         # MAX XMISSN LENGTH IN CHARACTERS   #
      XREF ITEM PRINT B;           # IF FALSE, *READ* WILL NOT ECHO    #
                                   # INPUT TO TRACE OR OUTPUT          #
  
      XREF PROC CMOVE;             # CHARACTER MOVE ROUTINE            #
      XREF PROC DB$PVC;            # CDCS PRIVACY ROUTINE - SETS ACCESS#
                                   # KEY OF AREA                       #
      XREF PROC DDIAG;             # DIAG TO FIND CURWORD AFTER        #
                                   # EXECUTING DATA-ATTRIB             #
      XREF PROC DIAG;              # WRITE DIAGNOSTIC TO OUTPUT        #
      XREF PROC LEXINIT;           # RESTART PROCESSING *QUIWSA*       #
      XREF PROC READ;              # READ NEXT TRANSMISSION FROM INPUT #
      XREF PROC RECNO;             # *STDNO* IF RECORDING              #
      XREF PROC RECYES;            # *STDYES* IF RECORDING             #
      XREF PROC WRITE;             # WRITE TO OUTPUT                   #
      XREF PROC WRITEBL;           # WRITE ONE LINE TO OUTPUT          #
  
      DEF CHAR # 0 #;              # TYPE CODE FOR CHARACTER ITEM      #
      DEF INP  # O"40" #;          # CODES FOR I-O OPTIONS             #
      DEF IO   # O"60" #; 
      DEF OUTP # O"20" #; 
  
      ITEM ACC$AREA I;             # ORDINAL OF AREA FOR WHICH KEY GIVN#
      ITEM ACC$ITEM I=0;           # ORDINAL IF TYPE ITEM              #
      ITEM ACC$KEY  C(30);         # 1 - 30 CHARACTER ACCESS KEY       #
      ITEM ACC$OPT I;              # I-O OPTIONS:20B = OUTPUT (UPDATE) #
                                   #             40B = INPUT (RETRIEVAL#
                                   #             60B = I-O (BOTH)      #
      ITEM ACC$TYPE I=1;           # TYPE OF ELEMENT KEYED - ALWAYS    #
                                   # AREA FOR NOW                      #
      ITEM CATNAMED B=TRUE;        # TRUE IF CATALOG NAMED IN DIRECTIVE#
      ITEM DUMMY I;                # DUMMY LOOP CONTROL VARIABLE       #
      ITEM INPTEMP  B;             # SET TRUE IF KEY FOR INPUT         #
      ITEM OUTPTEMP  B;            # SET TRUE IF KEY FOR OUTPUT        #
      ITEM PROMPT B=FALSE;         # IF TRUE, ANY *IS* CLAUSES TO THE  #
                                   # *ACCESS KEY* DIRECTIVE WILL COME  #
                                   # FROM INPUT AND MUST NOT BE ECHOED.#
                                   # IF FALSE, THE ENTIRE DIRECTIVE HAS#
                                   # BEEN GIVEN WITHOUT NEED FOR PROMPT#
      ITEM RC I;                   # ERROR RETURN CODE                 #
      ITEM SAVEP B;                # TEMP STORAGE FOR VALUE OF *PRINT* #
  
      BASED ARRAY KEYTEMP;         # TEMP HOLD FOR MOVING ACCESS KEY   #
        BEGIN 
        ITEM KEY  C(00,00,30);
        END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C A T N A M                                                      #
#                                                                      #
#     *CATNAM* SETS THE FLAG *CATNAMED* FALSE TO INDICATE THAT THE     #
#     NAME OF THE CATALOG TO BE KEYED WAS NOT SPECIFIED IN THE *ACCESS #
#     KEY* DIRECTIVE.                                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC CATNAM; 
      PROC CATNAM;
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
      CATNAMED = FALSE; 
      STDYES; 
      END                          # PROC *CATNAM*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C K A T K E Y                                                    #
#                                                                      #
#     *CKATKEY* LOOKS AT THE I-O OPTIONS GIVEN IN THE *ACCESS KEY*     #
#     DIRECTIVE AND DETERMINES WHETHER THEY ARE CURRENTLY KEYED FOR    #
#     THIS AREA. IF SO, A DIAGNOSTIC IS PRINTED TO THAT EFFECT AND     #
#     FURTHER PROCESSING OF THIS *IS* CLAUSE IS ABANDONED. IF NOT, THE #
#     AREAS ORDINAL IS SAVED, THE PROPER I-O OPTIONS FLAGS ARE SET     #
#     IN *AREA$TABLE*, AND *PRIVACY* IS CALLED TO PASS ALL ACCESS      #
#     PARAMETERS TO CDCS.                                              #
#     *CKATKEY* IS CALLED BY *SAVAREA*, *SAVARES*, AND *SAVALL*.       #
#                                                                      #
#     INPUT: ACC$OPT - IO OPTIONS GIVEN IN THIS *IS* CLAUSE            #
#            AT$INPUTKEY - FLAGS INDICATING ACCESS KEY ALREADY EXISTS  #
#            AT$OUTPUTKEY  FOR THIS AREA                               #
#                                                                      #
#     OUTPUT: ACC$AREA - ORDINAL OF THIS AREA FILE                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CKATKEY; 
      BEGIN 
      INPTEMP = (ACC$OPT LAN INP) EQ INP;  # TRUE IF INPUT BIT SET     #
                                           # IN ACC$OPT                #
      OUTPTEMP = (ACC$OPT LAN OUTP) EQ OUTP;   # SAME FOR OUTPUT KEY   #
      IF INPTEMP                   # IF NEW KEY IS FOR INPUT           #
        AND AT$INPUTKEY            # AND AREA ALREADY KEYED ON INPUT   #
        THEN
          BEGIN 
          DIAG (384, C<0,7>AT$AFDB$NAME);  # CAN-T CHANGE AREA KEY     #
          RETURN;                  # RETURN WITHOUT CALLING *PRIVACY*  #
          END 
  
      IF OUTPTEMP                  # IF NEW KEY IS FOR OUTPUT          #
        AND AT$OUTPUTKEY           # AND AREA ALREADY KEYED ON OUTPUT  #
        THEN
          BEGIN 
          DIAG (384, C<0,7>AT$AFDB$NAME);  # CAN-T RE-KEY AREA         #
          RETURN;                  # RETURN WITHOUT CALLING *PRIVACY*  #
          END 
  
                                   # IF REACHED THIS PT, KEYING IS OK  #
      IF AT$ACCESS EQ 0            # IF SPACE NOT YET ALLOC FOR KEYS   #
      THEN
        BEGIN                      # ALLOC AND POINT TO ACCESS KEY LOC #
        AT$ACCESS = CMM$ALF (6, 0, AT$GROUPID); 
        END 
  
      IF INPTEMP                   # IF NEW KEY FOR INPUT              #
      THEN
        BEGIN 
        AT$INPUTKEY = TRUE;        # SET INPUT KEY FLAG                #
        P<KEYTEMP> = AT$ACCESS;    # POSN TO INPUT ACCESS KEY LOCN     #
        KEY = ACC$KEY;             # SAVE ACCESS KEY FOR AREA TABLE    #
        END 
  
      IF OUTPTEMP                  # IF NEW KEY (ALSO) FOR OUTPUT      #
      THEN
        BEGIN 
        AT$OUTPUTKEY = TRUE;       # SET OUTPUT KEY FLAG               #
        P<KEYTEMP> = AT$ACCESS + 3;  # POSN TO OUTPUT ACCESS KEY LOCN  #
        KEY = ACC$KEY;             # SAVE ACCESS KEY FOR AREA TABLE    #
        END 
  
      ACC$AREA = AT$AREAORD;       # SAVE AREA ORDINAL                 #
      PRIVACY;                     # PASS ALL PRIVACY PARAMS TO CDCS   #
      RETURN; 
      END                          # PROC *CKATKEY*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     C K C T K E Y                                                    #
#                                                                      #
#     *CKCTKEY* LOOKS AT THE I-O OPTIONS GIVEN IN THE *ACCESS KEY*     #
#     DIRECTIVE AND DETERMINES WHETHER THEY ARE CURRENTLY KEYED FOR    #
#     THIS CATALOG. IF SO, A DIAGNOSTIC IS PRINTED TO THAT EFFECT AND  #
#     FURTHER PROCESSING OF THIS *IS* CLAUSE IS ABANDONED. IF NOT, THE #
#     CATALOGS ORDINAL IS SAVED, THE PROPER I-O OPTIONS FLAGS ARE SET  #
#     IN *CATABLE*, AND *PRIVACY* IS CALLED TO PASS ALL ACCESS         #
#     PARAMETERS TO CDCS.                                              #
#     *CKCTKEY* IS CALLED BY *SAVCAT* AND *SAVALL*.                    #
#                                                                      #
#     INPUT: ACC$OPT - IO OPTIONS GIVEN IN THIS *IS* CLAUSE            #
#            CAT$INPKEY - FLAGS INDICATING ACCESS KEY ALREADY EXISTS   #
#            CAT$OUTPKEY     FOR THIS CATALOG                          #
#                                                                      #
#     OUTPUT: ACC$AREA - ORDINAL OF THIS CATALOG FILE                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC CKCTKEY; 
      BEGIN 
      INPTEMP = (ACC$OPT LAN INP) EQ INP;  # TRUE IF INPUT BIT SET     #
                                           # IN ACC$OPT                #
      OUTPTEMP = (ACC$OPT LAN OUTP) EQ OUTP;   # SAME FOR OUTPUT       #
      IF INPTEMP                   # IF NEW KEY IS FOR INPUT           #
        AND CAT$INPKEY             # AND CATALOG ALREADY KEYED ON INPUT#
        THEN
          BEGIN 
          DIAG (384, CAT$NAML);    # CAN-T CHANGE CATALOG KEY          #
          RETURN;                  # RETURN WITHOUT CALLING *PRIVACY*  #
          END 
  
      IF OUTPTEMP                  # IF NEW KEY IS FOR OUTPUT          #
        AND CAT$OUTPKEY            # AND CATALOG ALREADY KEYED ON OUTPT#
        THEN
          BEGIN 
          DIAG (384, CAT$NAML);    # CAN-T RE-KEY CATALOG              #
          RETURN;                  # RETURN WITHOUT CALLING *PRIVACY*  #
          END 
  
                                   # IF REACHED THIS PT, KEYING IS OK  #
      IF INPTEMP                   # IF NEW KEY FOR INPUT              #
      THEN
        BEGIN 
        CAT$INPKEY = TRUE;         # SET INPUT KEY FLAG                #
        CAT$KEYIN = ACC$KEY;       # SAVE ACCESS KEY IN AREA TABLE     #
        END 
  
      IF OUTPTEMP                  # IF NEW KEY (ALSO) FOR OUTPUT      #
      THEN
        BEGIN 
        CAT$OUTPKEY = TRUE;        # SET OUTPUT KEY FLAG               #
        CAT$KEYOUT = ACC$KEY;      # SAVE ACCESS KEY IN AREA TABLE     #
        END 
  
      ACC$AREA = CATGORD;          # SAVE CATALOG ORDINAL              #
      PRIVACY;                     # PASS ALL PRIVACY PARAMS TO CDCS   #
      RETURN; 
      END                          # PROC *CKCTKEY*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     R E S E T P R                                                    #
#                                                                      #
#     *RESETPR* IS CALLED FROM SYNGEN BEFORE ERROR TERMINATION OF THE  #
#     *ACCESS* DIRECTIVE TO RESET *PROMPT* TO FALSE.                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC RESETPR;
      PROC RESETPR; 
      BEGIN 
      PROMPT = FALSE; 
      STDNO;
      END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V A L L                                                      #
#                                                                      #
#     *SAVALL* IS CALLED FROM SYNGEN TO SET THE GIVEN ACCESS KEY FOR   #
#     THE GIVEN I-O OPTIONS FOR THE CATALOG FILE AND ALL AREAS, IF     #
#     POSSIBLE. THOSE ALREADY KEYED WILL BE IDENTIFIED IN A DIAGNOSTIC #
#     AND IGNORED. *SAVALL* IS CALLED BY DEFAULT WHEN NO *FOR* CLAUSE  #
#     IS SPECIFIED IN THE DIRECTIVE.                                   #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVALL; 
      XDEF PROC SAVARES;
      PROC SAVALL;
      BEGIN 
      RECNO;                       # RETURN IF RECORDING               #
      P<CATABLE> = CATBLPTR;       # POSITION THE CATALOG TABLE        #
      IF NOT CDCSCAT               # IF NOT A CDCS CATALOG             #
      THEN
        BEGIN 
        DIAG (385);                # NON-CDCS CATALOG CANNOT BE KEYED  #
        END 
      ELSE
        BEGIN 
        CKCTKEY;                   # CHECK/SET IO KEYS, CALL *PRIVACY* #
        END 
      GOTO AREAS; 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     S A V A R E S                                                    #
#                                                                      #
#     *SAVARES* IS CALLED FROM SYNGEN (OR FLOWED INTO FROM *SAVALL*)   #
#     TO SET THE GIVEN ACCESS FOR ALL AREAS NOT ALREADY KEYED. IT CALLS#
#     *CKATKEY* TO CHECK THE APPROPRIATE IO FLAGS FOR EACH AREA TABLE, #
#     AND IF NOT ALREADY SET, SET THEM AND CALL *PRIVACY*. IF SET,     #
#     *CKATKEY* WILL ISSUE A DIAGNOSTIC AND RETURN IMMEDIATELY.        #
#     *SAVARES* IS CALLED WHEN *FOR AREAS* IS SPECIFIED IN THE         #
#     DIRECTIVE.                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      ENTRY PROC SAVARES; 
AREAS:  
      RECNO;                       # RETURN IF RECORDING               #
      IF NOT CDCSDBM               # NOT IN CDCS DATABASE MODE         #
      THEN
        BEGIN 
        DIAG (386);                # NO ACCESS KEY ALLOWED             #
        STDNO;
        END 
      P<AREA$TABLE> = AREATBLPTR;  # POSITION AREA TABLE               #
      FOR DUMMY = DUMMY            # ONLY EXIT FROM LOOP IS *STDNO*    #
      DO
        BEGIN 
        IF AT$FORWARD EQ 0         # IF NO MORE AREAS IN USE           #
        THEN
          BEGIN 
          STDNO;                   # FINISHED PROCESSING THIS KEY      #
          END 
  
        ELSE
          BEGIN                    # IF STILL ANOTHER AREA IN USE      #
          P<AREA$TABLE> = AT$FORWARD;  # POSITION TO ITS TABLE         #
          END 
        CKATKEY;                   # CHECK/SET IO FLAGS, CALL *PRIVACY*#
        END                        # END OF *FOR* LOOP                 #
      END                          # PROCS *SAVALL* AND *SAVARES*      #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V A R E A                                                    #
#                                                                      #
#     *SAVAREA* IS CALLED DURING SYNGEN PROCESSING OF *ACCESS KEY*     #
#     WHEN *FOR AREA* SPECIFIES AN AREA-NAME. IT LOOPS THROUGH THE AREA#
#     TABLES LOOKING FOR THE AREA NAMED IN *CURWORD*. IF FOUND, IT     #
#     CALLS *CKATKEY* TO FINISH PROCESSING THE ACCESS PARAMETERS FOR   #
#     THIS KEY. IF NOT FOUND, A DIAGNOSTIC IS CALLED STATING THAT FACT.#
#                                                                      #
#     INPUT: CURWORD - AREA-NAME GIVEN IN DIRECTIVE                    #
#            CURLENG - LENGTH IN CHARACTERS OF CURWORD                 #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVAREA;
      PROC SAVAREA; 
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
      IF NOT CDCSDBM               # NOT IN CDCS DATABASE MODE         #
      THEN
        BEGIN 
        DIAG (386);                # NO ACCESS KEY ALLOWED             #
        STDYES; 
        END 
      P<AREA$TABLE> = AREATBLPTR;  # POSITION AREA TABLE               #
      FOR DUMMY = DUMMY            # *STDYES* ONLY EXIT FROM LOOP      #
      DO
        BEGIN 
        IF AT$FORWARD EQ 0         # IF NO MORE AREAS IN USE           #
        THEN
          BEGIN 
          DIAG (381);              # AREA NOT IN USE                   #
          STDYES; 
          END 
  
        ELSE
          BEGIN 
          P<AREA$TABLE> = AT$FORWARD;  # POSN TO NEXT AREA TABLE IN USE#
          END 
        IF AT$AFDBLENG EQ CURLENG  # IF AREANAME AND CURWORD SAME LENGT#
                                   # AND SAME CONTENT                  #
          AND C<0,CURLENG>AT$AFDB$NAME EQ C<0,CURLENG>ICWC[0] 
        THEN
          BEGIN                    # FOUND SPECIFIED AREA              #
          CKATKEY;                 # CHECK/SET IO FLAGS, CALL *PRIVACY*#
          STDYES;                  # SUCCESSFUL RETURN TO SYNGEN       #
          END 
        END                        # END OF *FOR* LOOP                 #
      END                          # PROC *SAVAREA*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V C A T                                                      #
#                                                                      #
#     *SAVCAT* IS CALLED FROM SYNGEN WHEN *FOR CATALOG* IS SPECIFIED   #
#     IN THE *ACCESS KEY* DIRECTIVE. IF THE CURRENT CATALOG IS A CDCS, #
#     NOT CRM, FILE, AND IT IS THE SAME FILE AS THAT NAMED (IF CATALOG #
#     NAME GIVEN IN THE DIRECTIVE), THEN *SAVCAT* CALLS *CKCTKEY* TO   #
#     CHECK AND SET THE IO FLAGS FOR THE CURRENT CATALOG AND CALL      #
#     *PRIVACY* TO SEND THE PRIVACY PARAMETERS TO CDCS.                #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVCAT; 
      PROC SAVCAT;
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
      P<CATABLE> = CATBLPTR;       # POSITION CATALOG TABLE            #
      IF CATNAMED                  # IF CATALOG NAMED ON DIRECTIVE     #
        AND (CAT$LENG NQ CURLENG   # AND CATALOG NAME AND CURWORD ARE  #
                                   # NOT SAME LENGTH OR SAME CONTENT   #
          OR C<0,CURLENG>CAT$NAM NQ C<0,CURLENG>ICW[0]) 
      THEN
        BEGIN 
        DIAG (382);                # NOT THE CURRENT CATALOG           #
        END 
      ELSE
        BEGIN 
        IF NOT CDCSCAT             # IF NOT A CDCS CATALOG             #
        THEN
          BEGIN 
          DIAG (385);              # NON-CDCS CATALOG CANNOT BE KEYED  #
          END 
        ELSE
          BEGIN 
          CKCTKEY;                 # CHECK/SET IO KEYS, CALL *PRIVACY* #
          END 
        END 
      CATNAMED = TRUE;             # RESET CATALOG NAMED FLAG          #
      STDYES; 
      END                          # PROC *SAVCAT*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V I O                                                        #
#                                                                      #
#     *SAVIO* IS CALLED FROM SYNGEN PROCESSING OF THE *ACCESS KEY*     #
#     DIRECTIVE TO SAVE THE I-O OPTION(S) GIVEN IN THE *ON* CLAUSE.    #
#     SINCE ANY COMBINATION OF THE OPTIONS *INPUT* (RETRIEVAL),        #
#     *OUTPUT* (UPDATE), AND *I-O* (BOTH) MAY BE SPECIFIED, THE        #
#     APPROPRIATE BITS ARE OR-ED INTO *ACC$OPT* ONE AT A TIME.  IF NO  #
#     *ON* CLAUSE IS PRESENT IN THE DIRECTIVE, *SETIO* WILL BE CALLED  #
#     INSTEAD OF *SAVIO* TO SET *ACC$OPT* TO *I-O*, THE DEFAULT VALUE. #
#                                                                      #
#     INPUT: ICW - THE OPTION JUST SCANNED                             #
#                                                                      #
#     OUTPUT: ACC$OPT - 20B OUTPUT                                     #
#                       40B INPUT                                      #
#                       60B I-O                                        #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVIO;
      PROC SAVIO; 
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
      IF ICW[0] EQ "INPUT"         # IF *ON INPUT*                     #
      THEN
        BEGIN 
        ACC$OPT = ACC$OPT LOR INP;
        END 
      ELSE
        BEGIN 
        IF ICW[0] EQ "I-O"         # IF *ON I-O*                       #
        THEN
          BEGIN 
          ACC$OPT = ACC$OPT LOR IO; 
          END 
        ELSE
          BEGIN                    # IF *ON OUTPUT*                    #
          ACC$OPT = ACC$OPT LOR OUTP; 
          END 
        END 
      STDYES; 
      END                          # PROC *SAVIO*                      #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V K E Y                                                      #
#                                                                      #
#     *SAVKEY* IS CALLED FROM SYNGEN TO SAVE IN *ACC$KEY* THE ADDRESS  #
#     OF THE PRIVACY KEY GIVEN IN THE *ACCESS KEY* DIRECTIVE IF IT     #
#     PASSES ALL VALIDITY TESTS.                                       #
#                                                                      #
#     INPUT: DATAWORDADDR - WORD ADDRESS OF KEY - IN COMMON CEXPRESS   #
#                                                                      #
#     OUTPUT: ACC$KEY - PRIVACY KEY                                    #
#             ACC$OPT - I-O OPTIONS FLAG RESET TO 0                    #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVKEY; 
      PROC SAVKEY;
      BEGIN 
      RECYES;                      # RETURN IF RECORDING               #
      ACC$OPT = 0;                 # RESET I-O OPTIONS FLAG            #
                                   # CHECK FOR VALIDITY OF KEY         #
      IF (DATATYPE NQ CHAR)        # THE ACC KEY MUST BE TYPE CHARACTER#
        OR (DATALENG LS 1          # OF LENGTH 1-30 CHARACTERS,        #
          OR DATALENG GR 30)
        OR (FIGLITDATA NQ S"LITERAL"      # EITHER A LITERAL CONSTANT, #
          AND FIGLITDATA NQ S"TEMPNAME")  # OR A DEFINED ITEM,         #
        OR INDICED                 # AND NOT SUBSCRIPTED.              #
      THEN
        BEGIN 
        DDIAG (379);               # INVALID ACCESS KEY                #
        PROMPT = FALSE;            # RESET *PROMPT* SINCE DIRECTIVE    #
                                   # WILL BE TERMINATED                #
        STDNO;
        END 
                                   # PASSED ALL VALIDITY TESTS         #
        C<0,30>ACC$KEY = " ";      # BLANK FILL ACCESS KEY             #
      P<KEYTEMP> = DATAWORDADDR;   # TEMPORARY NAME OF KEY             #
      CMOVE (KEYTEMP, 0, DATALENG, ACC$KEY, 0);  # MOVE KEY TO ACC$KEY #
      STDYES; 
      END                          # PROC *SAVKEY*                     #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T I O                                                        #
#                                                                      #
#     *SETIO* IS CALLED FROM SYNGEN PROCESSING OF THE *ACCESS KEY*     #
#     DIRECTIVE.  IF NO *ON* CLAUSE WAS GIVEN IT WILL SET THE OPTIONS  #
#     FLAG, *ACC$OPT*, TO ITS DEFAULT VALUE OF *I-O* = 60B, SPECIFYING #
#     BOTH UPDATE AND RETRIEVAL ARE PERMITTED ON THE KEYED AREA.       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETIO;
      PROC SETIO; 
      BEGIN 
      RECNO;                       # RETURN IF RECORDING               #
      IF ACC$OPT EQ 0              # IF *ON* CLAUSE OMITTED            #
      THEN
        BEGIN 
        ACC$OPT = IO;              # SET OPTIONS FLAG TO INDICATE I-O  #
                                   # AS DEFAULT VALUE                  #
        END 
      STDNO;
      END                          # PROC *SETIO*                      #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S E T P R                                                        #
#                                                                      #
#     *SETPR* IS CALLED FROM SYNGEN WHEN AN *ACCESS KEY* DIRECTIVE     #
#     HAS BEEN ENTERED WITH NO *IS* CLAUSE.  THIS MEANS THE USER WANTS #
#     TO ENTER THE PRIVACY INFORMATION WITHOUT IT BEING ECHOED TO TRACE#
#     OR OUTPUT.  *PROMPT* IS SET TRUE TO INDICATE THIS TO *READIS*.   #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SETPR;
      XDEF PROC READIS; 
      PROC SETPR; 
      BEGIN 
      RECNO;                       # RETURN IF RECORDING               #
      PROMPT = TRUE;
      GOTO RDIS;                   # GO READ IN FIRST *IS* CLAUSE      #
  
#----------------------------------------------------------------------#
#                                                                      #
#     R E A D I S                                                      #
#                                                                      #
#     *READIS* IS CALLED FROM SYNGEN AFTER EVERY EOT ENCOUNTERED IN AN #
#     *ACCESS KEY* DIRECTIVE.  IF TRUE, *PROMPT* INDICATES THAT AN *IS*#
#     CLAUSE IS EXPECTED FROM INPUT.  A PROMPT MUST BE WRITTEN AND THE #
#     NEXT TRANSMISSION READ WITHOUT ECHOING TO TRACE OR OUTPUT, FOR   #
#     SECURITY REASONS.  INPUT = "*END" OR *PROMPT* = FALSE INDICATES  #
#     END OF DIRECTIVE.                                                #
#                                                                      #
#----------------------------------------------------------------------#
  
      ENTRY PROC READIS;
RDIS:                              # ENTRY AFTER INITIAL CALL TO       #
                                   # *SETPR*                           #
      RECNO;                       # RETURN IF RECORDING               #
      IF PROMPT                    # IF ANOTHER *IS* CLAUSE EXPECTED   #
      THEN
        BEGIN 
        WRITE (" >>>", 4, RC);     # WRITE PROMPT TO OUTPUT            #
        SAVEP = PRINT;             # SAVE CURRENT VALUE OF *PRINT*     #
        PRINT = FALSE;             # SET FALSE SO *READ* WON-T ECHO INP#
        READ (QUIWSA, QUIRL, MXTRNLG, RC);  # READ NEXT XMISSN INTO    #
                                            # THE BUFFER *QUIWSA*      #
        PRINT = SAVEP;             # RESTORE *PRINT*                   #
        IF C<0,4>INWORD[0] EQ "*END"  # IF INPUT WAS "*END"            #
        THEN
          BEGIN 
          WRITEBL ("          *END", 14, RC);  # ECHO "*END" TO OUTPUT #
          PROMPT = FALSE;          # RESET *PROMPT*                    #
          STDNO;                   # NEG EXIT MEANS FINISHED DIRECTIVE #
          END 
  
        ELSE
          BEGIN 
          WP = 0;                  # TELL *LEXINIT* NOT REALLY EOT,    #
                                   # BUT NEW RECORD IN *QUIWSA*        #
          LEXINIT;                 # BACK TO BEGINNING OF *QUIWSA*     #
          STDYES;                  # POS EXIT MEANS CONTINUE SYNTAX    #
                                   # CRACKING OF *ACCESS KEY*          #
          END 
        END                        # END *PROMPT* TRUE                 #
  
      ELSE
        BEGIN                      # NO INPUT EXPECTED                 #
        STDNO;                     # FINISHED WITH DIRECTIVE           #
        END 
      END                          # PROCS *SETPR* AND *READIS*        #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     P R I V A C Y                                                    #
#                                                                      #
#     *PRIVACY* IS THE LAST ROUTINE CALLED FOR EACH *IS* CLAUSE OF THE #
#     *ACCESS KEY* DIRECTIVE.  ITS ONLY FUNCTION IS TO CALL THE CDCS   #
#     PRIVACY ROUTINE *DB$PVC* WITH THE ACCESS PARAMETERS GIVEN IN     #
#     THE LAST *IS* CLAUSE.                                            #
#     *PRIVACY* IS CALLED BY *CKATKEY* AND *CKCTKEY*.                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      DB$PVC (ACC$KEY, ACC$TYPE, ACC$AREA, ACC$ITEM, ACC$OPT);
      RETURN; 
      END                          # PROC *PRIVACY*                    #
      TERM; 
