*DECK DCDMS320
       IDENTIFICATION DIVISION. 
       PROGRAM-ID.   DMS320.
  
      ******************************************************************
      * 
      * THIS MODULE GENERATES NOS-170 FILE CARDS FOR ALL AREAS IN THE 
      * GIVEN DMS-170 SCHEMA.  ALL INPUT/OUTPUT IS DONE THROUGH A 
      * TEMPORARY EXIT BACK TO "DMS300".
      * 
      ******************************************************************
  
       ENVIRONMENT DIVISION.
  
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER.   CYBER.
       OBJECT-COMPUTER.   CYBER.
  
      ******************************************************************
      * 
       DATA DIVISION. 
  
  
      ******************************************************************
      * 
*CALL GENCS 
  
  
      ******************************************************************
      * 
       WORKING-STORAGE SECTION. 
*CALL DATAGEN 
*CALL DATAVER 
  
      ******************************************************************
      * 
      * VALUES RELATING TO INDENTATION OF LINES.
  
       01  INDENT-VALUES. 
           03  INDENT-INIT        PICTURE 99     VALUE 0. 
           03  INDENT-INC         PICTURE 99     VALUE 0. 
           03  INDENT-MAX         PICTURE 99     VALUE 0. 
  
      ******************************************************************
      * 
       01  MISCELLANEOUS. 
           03  AREA-CATNAME       PICTURE X(32).
           03  AREA-LFN           PICTURE X(7). 
           03  AREA-LFN-LEN       PICTURE 99. 
           03  INDEX-PFN          PICTURE X(7). 
           03  PICK-IDX           PICTURE 99. 
           03  STRIP-FIELD        PICTURE X(10).
  
      ******************************************************************
      * 
      * LIST OF KEYWORDS USED IN DMS FILE CARD GENERATION.
      * 
       01  KEYWORD-LST. 
           03  KW-BT              PICTURE X(4)   VALUE ",BT=".
           03  KW-BT-LEN          PICTURE 99     VALUE 4. 
           03  KW-CL              PICTURE X(4)   VALUE ",CL=".
           03  KW-CL-LEN          PICTURE 99     VALUE 4. 
           03  KW-CP              PICTURE X(4)   VALUE ",CP=".
           03  KW-CP-LEN          PICTURE 99     VALUE 4. 
           03  KW-C1              PICTURE X(4)   VALUE ",C1=".
           03  KW-C1-LEN          PICTURE 99     VALUE 4. 
           03  KW-EMK             PICTURE X(5)   VALUE ",EMK=". 
           03  KW-EMK-LEN         PICTURE 99     VALUE 5. 
           03  KW-FILE            PICTURE X(5)   VALUE "FILE,". 
           03  KW-FILE-LEN        PICTURE 99     VALUE 5. 
           03  KW-FO              PICTURE X(4)   VALUE ",FO=".
           03  KW-FO-LEN          PICTURE 99     VALUE 4. 
           03  KW-HL              PICTURE X(4)   VALUE ",HL=".
           03  KW-HL-LEN          PICTURE 99     VALUE 4. 
           03  KW-HMB             PICTURE X(5)   VALUE ",HMB=". 
           03  KW-HMB-LEN         PICTURE 99     VALUE 5. 
           03  KW-KL              PICTURE X(4)   VALUE ",KL=".
           03  KW-KL-LEN          PICTURE 99     VALUE 4. 
           03  KW-KP              PICTURE X(4)   VALUE ",KP=".
           03  KW-KP-LEN          PICTURE 99     VALUE 4. 
           03  KW-KT              PICTURE X(4)   VALUE ",KT=".
           03  KW-KT-LEN          PICTURE 99     VALUE 4. 
           03  KW-LL              PICTURE X(4)   VALUE ",LL=".
           03  KW-LL-LEN          PICTURE 99     VALUE 4. 
           03  KW-LP              PICTURE X(4)   VALUE ",LP=".
           03  KW-LP-LEN          PICTURE 99     VALUE 4. 
           03  KW-MBL             PICTURE X(5)   VALUE ",MBL=". 
           03  KW-MBL-LEN         PICTURE 99     VALUE 5. 
           03  KW-MNR             PICTURE X(5)   VALUE ",MNR=". 
           03  KW-MNR-LEN         PICTURE 99     VALUE 5. 
           03  KW-MRL             PICTURE X(5)   VALUE ",MRL=". 
           03  KW-MRL-LEN         PICTURE 99     VALUE 5. 
           03  KW-NO              PICTURE X(2)   VALUE "NO".
           03  KW-NO-LEN          PICTURE 99     VALUE 2. 
           03  KW-ORG             PICTURE X(5)   VALUE ",ORG=". 
           03  KW-ORG-LEN         PICTURE 99     VALUE 5. 
           03  KW-RB              PICTURE X(4)   VALUE ",RB=".
           03  KW-RB-LEN          PICTURE 99     VALUE 4. 
           03  KW-RKP             PICTURE X(5)   VALUE ",RKP=". 
           03  KW-RKP-LEN         PICTURE 99     VALUE 5. 
           03  KW-RKW             PICTURE X(5)   VALUE ",RKW=". 
           03  KW-RKW-LEN         PICTURE 99     VALUE 5. 
           03  KW-RMK             PICTURE X(5)   VALUE ",RMK=". 
           03  KW-RMK-LEN         PICTURE 99     VALUE 5. 
           03  KW-RT              PICTURE X(4)   VALUE ",RT=".
           03  KW-RT-LEN          PICTURE 99     VALUE 4. 
           03  KW-TL              PICTURE X(4)   VALUE ",TL=".
           03  KW-TL-LEN          PICTURE 99     VALUE 4. 
           03  KW-XN              PICTURE X(4)   VALUE ",XN=".
           03  KW-XN-LEN          PICTURE 99     VALUE 4. 
           03  KW-YES             PICTURE X(3)   VALUE "YES". 
           03  KW-YES-LEN         PICTURE 99     VALUE 3. 
*CALL DATAIO
*CALL DATSAV1 
*CALL DATSAV2 
*CALL DATCON1 
*CALL DATCONF 
  
*CALL MAST1WS 
  
*CALL TESTWACOM 
  
*CALL DCDWA20 
  
*CALL DCDWA22 
  
*CALL DCDWA26 
      /*****************************************************************
      * 
       PROCEDURE DIVISION.
  
      ******************************************************************
      * 
      * INITIALIZATION. 
  
       000-INITIALIZE.
  
      * FIRST CHECK IF RETURNING TO MODULE FROM INPUT/OUTPUT REQUEST. 
           IF GTBL-REQ = REQ-INPUT
           THEN 
             GO TO READ-RETURN
           END-IF 
  
           IF GTBL-REQ = REQ-OUTPUT 
           THEN 
             GO TO OUTPUT-RETURN
           END-IF 
  
      * INITIAL ENTRY OF MODULE --- SO INITIALIZE.
           MOVE INDENT-INIT TO INDENT.
           MOVE SPACES TO DMS-LINE. 
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           MOVE "N" TO DATANAME-OK. 
  
      * INITIALIZE CMM CONSTANT PARAMETERS. 
           MOVE MASTER-SIZE TO BLK-SIZE.
           MOVE ZERO TO GRP-TYPE. 
           MOVE ZERO TO SIZE-CODE.
  
       100-FILE-CARD. 
  
      * FIRST OF ALL, OUTPUT A BLANK LINE.
           ADD 1 TO GTBL-COUNT. 
           MOVE DMS-LINE TO GTBL-CARD-IMAGE (GTBL-COUNT). 
  
      * READ FIRST RECORD OF SCHEMA ENTRY INTO "DATA-RECORD". 
           MOVE SCHEMA-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF SCHEMA ENTRY MISSING, DIAGNOSE AND GIVE UP.
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-500 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO 150-NORMAL-TERMINATION 
           END-IF 
  
      * FOR EACH AREA INCLUDED IN THE SCHEMA, GENERATE AT LEAST ONE 
      * FILE CARD.
  
      * MOVE SCHEMA'S FIRST STRUCTURE LINE INTO "CAT-WORK". 
           MOVE CAT-NO-STC TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * INITIALIZE FOR MASTER AREA CATNAME CHECK. 
           ENTER "CMMAGR" USING GRP-TYPE, GRP-ID. 
           MOVE ZERO TO MASTER-FWA. 
           MOVE 1 TO MASTER-IDX.
           MOVE "N" TO FOUND-MASTER.
  
      * FOR EACH INCLUDED AREA IN THE MASTER VERSION, GENERATE A FILE 
      * CARD. 
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             PERFORM CON-SCH-STC THRU CON-SCH-STC-XIT 
  
             IF SCH-STC-CNAME NOT = SPACES
               AND SCH-STC-INCL NOT = "N" 
               AND SCH-STC-CTYPE = "A"
             THEN 
  
      * ALL OF THE MASTER AREAS MUST COME BEFORE THE FIRST ALTERNATE
      * VERSION AREA. 
               IF SCH-STC-AVERS = SPACES OR "MASTER"
               THEN 
                 MOVE "Y" TO FOUND-MASTER 
                 MOVE SCH-STC-CNAME TO AREA-CATNAME 
                 PERFORM SAVE-MASTER-AREAS THRU SAVE-MASTER-AREAS-XIT 
                 PERFORM FILE-CARD THRU FILE-CARD-XIT 
  
      * FIRST ALTERNATE VERSION FOUND -- GO PROCESS THEM. 
               ELSE 
                 IF FOUND-MASTER = "Y"
                 THEN 
                   GO TO 110-ALTERNATE-VERSION
  
      * ERROR IF ALTERNATE VERSION FOUND BEFORE MASTER. 
                 ELSE 
                   MOVE IDX-730 TO MSG-IDX
                   MOVE SCH-STC-AVERS TO MSG-NAME 
                   PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
                 END-IF 
               END-IF 
             END-IF 
           END-PERFORM
  
       110-ALTERNATE-VERSION. 
  
      * FLUSH MASTER AREA CATNAME BUFFER IF NEEDED. 
           IF MASTER-IDX NOT = 1
           THEN 
             MOVE 99 TO MASTER-IDX
             PERFORM SAVE-MASTER-AREAS THRU SAVE-MASTER-AREAS-XIT 
           END-IF 
  
      * LOOP THROUGH REMAINING STRUCTURE LINES TO GENERATE FILE 
      * CARDS FOR ALL AREAS IN ALTERNATE VERSIONS.
           PERFORM UNTIL SCH-STC-CNAME = SPACES 
             IF SCH-STC-INCL NOT = "N"
               AND SCH-STC-CTYPE = "A"
             THEN 
  
      * ERROR IF MASTER AREA OCCURS AFTER FIRST ALTERNATE VERSION AREA. 
               IF SCH-STC-AVERS = SPACES OR "MASTER"
               THEN 
                 MOVE IDX-730 TO MSG-IDX
                 MOVE "MASTER" TO MSG-NAME
                 PERFORM ERROR-TYPE2 THRU ERROR-TYPE2-XIT 
  
      * CHECK AREA'S CATNAME AGAINST MASTER AREA CATNAMES FOR A MATCH.
               ELSE 
                 MOVE "Y" TO FOUND-VERSION
                 MOVE SCH-STC-CNAME TO AREA-CATNAME 
                 PERFORM CHECK-MASTER-AREAS THRU CHECK-MASTER-AREAS-XIT 
  
      * IF CATNAME NOT SAME AS ANY MASTER, GENERATE A FILE CARD FOR IT. 
                 IF FOUND-VERSION = "Y" 
                 THEN 
                   PERFORM FILE-CARD THRU FILE-CARD-XIT 
                 END-IF 
               END-IF 
             END-IF 
  
      * CONSOLIDATE NEXT STRUCTURE LINE IF NEEDED.
             PERFORM CON-SCH-STC THRU CON-SCH-STC-XIT 
           END-PERFORM
  
      * FREE MASTER-AREA CATNAME LIST.
           ENTER "CMMFGR" USING GRP-ID. 
  
       150-NORMAL-TERMINATION.
           MOVE REQ-TERMINATE TO GTBL-REQ.
           EXIT PROGRAM.
      /*****************************************************************
      * 
      * FILE CARD GENERATION. 
      * 
      * INPUT:   AREA-CATNAME     - CATNAME OF AREA FOR WHICH FILE CARD 
      *                             TO BE GENERATED 
      *          CAT-WORK         - SCHEMA STRUCTURE
  
       FILE-CARD. 
  
      * MOVE AREA'S FIRST RECORD INTO "DATA-RECORD".
           PERFORM SAVE-SCH-INFO THRU SAVE-SCH-INFO-XIT.
           PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT.
           MOVE AREA-CATNAME TO DATA-ENTRY-NAME.
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
  
      * IF AREA ENTRY MISSING, DIAGNOSE AND RETURN. 
           IF DATA-RETURN-CODE NOT = ZERO 
           THEN 
             MOVE IDX-500 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO END-FILE-CARD
           END-IF 
  
      * IF ENTRY NOT FOR AREA ENTITY, DIAGNOSE AND RETURN.
           IF DATA-HDR-ENT-ID NOT = ENT-ID-AREA 
           THEN 
             MOVE IDX-535 TO MSG-IDX
             PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
             GO TO END-FILE-CARD
           END-IF 
  
      * FIND AREA'S LFN AND GENERATE FILE CARD FOR INDEX FILE IF GIVEN. 
           PERFORM FIND-AREA-LFN THRU FIND-AREA-LFN-XIT.
  
      * MOVE AREA'S ATTRIBUTES CATEGORY INTO "CAT-WORK".
           MOVE CAT-NO-ATT TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "N" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * START NEW FILE CARD FOR EACH ATTRIBUTE LINE.
           PERFORM UNTIL DATA-RETURN-CODE NOT = ZERO
             PERFORM START-FILE-CARD THRU START-FILE-CARD-XIT 
  
      * CHECK FOR EACH POSSIBLE FILE PARAMETER AND ADD IT IF GIVEN. 
             IF ATTR-A-BT NOT = SPACES
             THEN 
               MOVE KW-BT TO OUT-FIELD
               MOVE ATTR-A-BT TO OUT-FIELD (KW-BT-LEN + 1 : 1)
               ADD KW-BT-LEN, 1 GIVING OUT-LEN
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-CL NOT = SPACES
             THEN 
               MOVE ATTR-A-CL TO OUT-FIELD
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-CL TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-CL-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-CP NOT = SPACES
             THEN 
               MOVE ATTR-A-CP TO OUT-FIELD
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-CP TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-CP-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-C1 NOT = SPACES
             THEN 
               MOVE KW-C1 TO OUT-FIELD
               IF ATTR-A-C1 = "Y" 
               THEN 
                 MOVE KW-YES TO OUT-FIELD (KW-C1-LEN + 1 : KW-YES-LEN)
                 ADD KW-C1-LEN, KW-YES-LEN GIVING OUT-LEN 
               ELSE 
                 MOVE KW-NO TO OUT-FIELD (KW-C1-LEN + 1 : KW-NO-LEN)
                 ADD KW-C1-LEN, KW-NO-LEN GIVING OUT-LEN
               END-IF 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-EMK NOT = SPACES 
             THEN 
               MOVE KW-EMK TO OUT-FIELD 
               IF ATTR-A-EMK = "Y"
               THEN 
                 MOVE KW-YES TO OUT-FIELD (KW-EMK-LEN + 1 : KW-YES-LEN) 
                 ADD KW-EMK-LEN, KW-YES-LEN GIVING OUT-LEN
               ELSE 
                 MOVE KW-NO TO OUT-FIELD (KW-EMK-LEN + 1 : KW-NO-LEN) 
                 ADD KW-EMK-LEN, KW-NO-LEN GIVING OUT-LEN 
               END-IF 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-FO NOT = SPACES
             THEN 
               MOVE KW-FO TO OUT-FIELD
               MOVE ATTR-A-FO TO OUT-FIELD (KW-FO-LEN + 1 : 2)
               ADD KW-FO-LEN, 2 GIVING OUT-LEN
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-HL NOT = SPACES
             THEN 
               MOVE ATTR-A-HL TO OUT-FIELD
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-HL TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-HL-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-HMB NOT = SPACES 
             THEN 
               MOVE ATTR-A-HMB TO OUT-FIELD 
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-HMB TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-HMB-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-KL NOT = SPACES
             THEN 
               MOVE ATTR-A-KL TO OUT-FIELD
               MOVE 4 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-KL TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-KL-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-KP NOT = SPACES
             THEN 
               MOVE KW-KP TO OUT-FIELD
               MOVE ATTR-A-KP TO OUT-FIELD (KW-KP-LEN + 1 : 1)
               ADD KW-KP-LEN, 1 GIVING OUT-LEN
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-KT NOT = SPACES
             THEN 
               MOVE KW-KT TO OUT-FIELD
               MOVE ATTR-A-KT TO OUT-FIELD (KW-KT-LEN + 1 : 1)
               ADD KW-KT-LEN, 1 GIVING OUT-LEN
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-LL NOT = SPACES
             THEN 
               MOVE KW-LL TO OUT-FIELD
               MOVE ATTR-A-LL TO OUT-FIELD (KW-LL-LEN + 1 : 1)
               ADD KW-LL-LEN, 1 GIVING OUT-LEN
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-LP NOT = SPACES
             THEN 
               MOVE ATTR-A-LP TO OUT-FIELD
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-LP TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-LP-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-MBL NOT = SPACES 
             THEN 
               MOVE ATTR-A-MBL TO OUT-FIELD 
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-MBL TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-MBL-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-MNR NOT = SPACES 
             THEN 
               MOVE ATTR-A-MNR TO OUT-FIELD 
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-MNR TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-MNR-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-MRL NOT = SPACES 
             THEN 
               MOVE ATTR-A-MRL TO OUT-FIELD 
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-MRL TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-MRL-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-ORG NOT = SPACES 
             THEN 
               MOVE KW-ORG TO OUT-FIELD 
               MOVE ATTR-A-ORG TO OUT-FIELD (KW-ORG-LEN + 1 : 3)
               ADD KW-ORG-LEN, 3 GIVING OUT-LEN 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-RB NOT = SPACES
             THEN 
               MOVE ATTR-A-RB TO OUT-FIELD
               MOVE 4 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-RB TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-RB-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-RKP NOT = SPACES 
             THEN 
               MOVE ATTR-A-RKP TO OUT-FIELD 
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-RKP TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-RKP-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-RKW NOT = SPACES 
             THEN 
               MOVE ATTR-A-RKW TO OUT-FIELD 
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-RKW TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-RKW-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-RMK NOT = SPACES 
             THEN 
               MOVE ATTR-A-RMK TO OUT-FIELD 
               MOVE 10 TO OUT-LEN 
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-RMK TO OUT-FIELD 
               MOVE STRIP-FIELD TO OUT-FIELD (KW-RMK-LEN + 1 : OUT-LEN) 
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-RT NOT = SPACES
             THEN 
               MOVE KW-RT TO OUT-FIELD
               MOVE ATTR-A-RT TO OUT-FIELD (KW-RT-LEN + 1 : 1)
               ADD KW-RT-LEN, 1 GIVING OUT-LEN
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
             IF ATTR-A-TL NOT = SPACES
             THEN 
               MOVE ATTR-A-TL TO OUT-FIELD
               MOVE 6 TO OUT-LEN
               PERFORM STRIP-ZEROS THRU STRIP-ZEROS-XIT 
               MOVE KW-TL TO OUT-FIELD
               MOVE STRIP-FIELD TO OUT-FIELD (KW-TL-LEN + 1 : OUT-LEN)
               PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
               PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             END-IF 
  
      * IF FILE CARD GENERATED, MOVE IT TO OUTPUT BUFFER. 
             IF FOUND-FILE = "Y"
             THEN 
               PERFORM OUTPUT-FILE-CARD THRU OUTPUT-FILE-CARD-XIT 
             END-IF 
  
      * MOVE NEXT ATTRIBUTE LINE INTO "CAT-WORK". 
             PERFORM MOVE-NEXT-LINE THRU MOVE-NEXT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
           END-PERFORM
  
       END-FILE-CARD. 
           PERFORM RESTORE-SCH-INFO THRU RESTORE-SCH-INFO-XIT.
  
       FILE-CARD-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * FIND AREA'S LFN.
      * 
      * SAVE THE FIRST SEVEN CHARACTERS OF THE AREA'S DATANAME AS ITS 
      * LOCAL FILE NAME, AND CREATE A FILE CARD FOR ITS INDEX FILE IF 
      * ONE IS GIVEN. 
      * 
      * INPUT:   DATA-RECORD      - AREA
      *          CAT-WORK         - BLANK 
      * 
      * OUTPUT:  AREA-LFN         - FILE NAME FOR AREA
      *          AREA-LFN-LEN     - LENGTH OF AREA'S PFN
  
       FIND-AREA-LFN. 
  
      * FOR AREA'S LFN, USE FIRST SEVEN CHARACTERS OF AREA'S DATANAME.
           MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           MOVE "Y" TO SKIP-COMMENTS. 
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
           IF DATA-RETURN-CODE NOT = ZERO 
             OR NAME-A-DMS = SPACES 
           THEN 
             MOVE AREA-CATNAME (1 : 7) TO AREA-LFN
           ELSE 
             MOVE NAME-A-DMS (1 : 7) TO AREA-LFN
           END-IF 
  
      * FIND LENGTH OF AREA'S FILE NAME.
           MOVE AREA-LFN TO OUT-FIELD.
           PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT.
           MOVE OUT-LEN TO AREA-LFN-LEN.
  
      * MOVE AREA'S MDINFO CATEGORY INTO "CAT-WORK" AND CONSOLIDATE IF
      * NECESSARY.
           MOVE CAT-NO-MDI TO DATA-ENTRY-CAT. 
           PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT.
           PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT.
           PERFORM CON-AREA-MDI THRU CON-AREA-MDI-XIT.
  
      * IF INDEX FILE EXISTS, CREATE A FILE CARD FOR IT.
           IF A-MDI-XN NOT = SPACES 
           THEN 
  
      * MOVE FILE'S FIRST RECORD INTO "DATA-RECORD".
             PERFORM SAVE-AREA-INFO THRU SAVE-AREA-INFO-XIT 
             PERFORM CLEAR-DATA-ENTRY THRU CLEAR-DATA-ENTRY-XIT 
             MOVE A-MDI-XN TO DATA-ENTRY-NAME 
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
  
      * IF FILE ENTRY MISSING, DIAGNOSE AND RETURN. 
             IF DATA-RETURN-CODE NOT = ZERO 
             THEN 
               MOVE IDX-500 TO MSG-IDX
               PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
               PERFORM RESTORE-AREA-INFO THRU RESTORE-AREA-INFO-XIT 
               GO TO FIND-AREA-LFN-XIT
             END-IF 
  
      * IF ENTRY NOT FOR FILE ENTITY, DIAGNOSE AND RETURN.
             IF DATA-HDR-ENT-ID NOT = ENT-ID-FILE 
             THEN 
               MOVE IDX-532 TO MSG-IDX
               PERFORM ERROR-TYPE1 THRU ERROR-TYPE1-XIT 
               PERFORM RESTORE-AREA-INFO THRU RESTORE-AREA-INFO-XIT 
               GO TO FIND-AREA-LFN-XIT
             END-IF 
  
      * MOVE FILE'S NAMES CATEGORY INTO "CAT-WORK". 
             MOVE CAT-NO-NAMES TO DATA-ENTRY-CAT
             PERFORM MOVE-CAT-LINE THRU MOVE-CAT-LINE-XIT 
             PERFORM CHECK-COMMENTS THRU CHECK-COMMENTS-XIT 
  
      * IF NO DMSNAME GIVEN, ASSUME THE CATNAME.
             IF DATA-RETURN-CODE NOT = ZERO 
               OR NAME-FILE-DMS = SPACES
             THEN 
               MOVE A-MDI-XN (1 : 7) TO INDEX-PFN 
             ELSE 
               MOVE NAME-FILE-DMS TO INDEX-PFN
             END-IF 
  
      * NOW GENERATE THE FILE CARD. 
             PERFORM START-FILE-CARD THRU START-FILE-CARD-XIT 
             MOVE KW-XN TO OUT-FIELD
             MOVE INDEX-PFN TO OUT-FIELD (KW-XN-LEN + 1 : 7)
             PERFORM FIND-LENGTH THRU FIND-LENGTH-XIT 
             PERFORM ADD-TO-FILE-CARD THRU ADD-TO-FILE-CARD-XIT 
             PERFORM OUTPUT-FILE-CARD THRU OUTPUT-FILE-CARD-XIT 
             PERFORM RESTORE-AREA-INFO THRU RESTORE-AREA-INFO-XIT 
           END-IF 
  
       FIND-AREA-LFN-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * START FILE CARD.
      * 
      * INITIALIZE "DMS-LINE" TO HOLD A NEW FILE CARD.  START THE LINE
      * WITH THE KEYWORD "FILE" AND THE AREA'S FILE NAME. 
      * 
      * INPUT:   AREA-LFN         - AREA'S FILE NAME
      *          AREA-LFN-LEN     - LENGTH OF AREA'S FILE NAME
      * 
      * OUTPUT:  COLUMN-OUT       - NEXT AVAILABLE COLUMN IN "DMS-LINE" 
  
       START-FILE-CARD. 
           MOVE "N" TO FOUND-FILE.
           MOVE SPACES TO DMS-LINE. 
  
           MOVE KW-FILE TO DMS-LINE.
           MOVE AREA-LFN TO DMS-LINE (KW-FILE-LEN + 1 : AREA-LFN-LEN).
           ADD KW-FILE-LEN, AREA-LFN-LEN, 1 GIVING COLUMN-OUT.
  
       START-FILE-CARD-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * ADD PARAMETER TO FILE CARD. 
      * 
      * INPUT:     OUT-FIELD      - FIELD TO ADD TO "DMS-LINE"
      *            OUT-LEN        - LENGTH OF "OUT-FIELD" 
      *            COLUMN-OUT     - NEXT AVAILABLE COLUMN IN "DMS-LINE" 
      * 
      * OUTPUT:    FOUND-FILE     - "Y" TO INDICATE FILE CARD CONTAINS
      *                             PARAMETERS
  
       ADD-TO-FILE-CARD.
  
      * FIRST CHECK IF FITS ON LINE.  IF NOT, OUTPUT PREVIOUS FILE CARD 
      * AND START NEW ONE.
           IF COLUMN-OUT + OUT-LEN > 80 
           THEN 
             PERFORM OUTPUT-FILE-CARD THRU OUTPUT-FILE-CARD-XIT 
             PERFORM START-FILE-CARD THRU START-FILE-CARD-XIT 
           END-IF 
  
      * ADD PARAMETER TO FILE CARD. 
           MOVE OUT-FIELD TO DMS-LINE (COLUMN-OUT : OUT-LEN). 
           ADD OUT-LEN TO COLUMN-OUT. 
           MOVE "Y" TO FOUND-FILE.
  
       ADD-TO-FILE-CARD-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * STRIP-ZEROS.
      * 
      * STRIP THE LEADING ZEROS FROM THE VALUE OF A NUMERIC FILE CARD 
      * PARAMETER.
      * 
      * INPUT:   OUT-FIELD        - ORIGINAL PARAMETER VALUE
      *          OUT-LEN          - CHAR LENGTH OF STRIP-FIELD
      * 
      * OUTPUT:  STRIP-FIELD      - VALUE STRIPPED OF LEADING ZEROS 
      *          OUT-LEN          - CHAR LENGTH OF OUT-FIELD
  
       STRIP-ZEROS. 
           MOVE 1 TO OUT-START
           PERFORM UNTIL OUT-FIELD (OUT-START : 1) NOT = ZERO 
             OR OUT-LEN = 1 
  
             ADD 1 TO OUT-START 
             SUBTRACT 1 FROM OUT-LEN
           END-PERFORM
           MOVE OUT-FIELD (OUT-START : OUT-LEN) TO STRIP-FIELD. 
  
       STRIP-ZEROS-XIT. 
           EXIT.
      /*****************************************************************
      * 
      * OUTPUT FILE CARD. 
      * 
      * INPUT:   DMS-LINE         - COMPLETED FILE CARD 
      *          COLUMN-OUT       - NEXT AVAILABLE COLUMN IN "DMS-LINE" 
      *          GTBL-COUNT       - INDEX INTO OUTPUT BUFFER
  
       OUTPUT-FILE-CARD.
  
      * END FILE CARD WITH A PERIOD 
           MOVE "." TO DMS-LINE (COLUMN-OUT : 1). 
  
      * MOVE FILE CARD TO OUTPUT BUFFER.
           ADD 1 TO GTBL-COUNT. 
           MOVE DMS-LINE TO GTBL-CARD-IMAGE (GTBL-COUNT). 
  
      * CHECK IF IT'S TIME TO FLUSH OUTPUT BUFFER.
           PERFORM OUTPUT-CHECK THRU OUTPUT-CHECK-XIT.
  
       OUTPUT-FILE-CARD-XIT.
           EXIT.
      /*****************************************************************
      * 
      * OUTPUT COMMENT. 
      * 
      * MOVE THE CONTENTS OF "CAT-DETAIL" TO THE OUTPUT BUFFER. 
  
       OUTPUT-COMMENT.
  
      * INCREMENT INDEX INTO OUTPUT BUFFER AND INITIALIZE COMMENT-LINE
      * POINTERS. 
           ADD 1 TO GTBL-COUNT. 
           MOVE 2 TO COMMENT-COL. 
  
      * FIND LENGTH OF COMMENT WITHOUT TRAILING BLANKS. 
           SUBTRACT 2 FROM DETAIL-LEN.
           PERFORM VARYING COMMENT-LEN FROM DETAIL-LEN  BY -1 
             UNTIL CAT-DETAIL (COMMENT-COL + COMMENT-LEN : 1) 
               NOT = SPACE
               OR COMMENT-LEN = ZERO
             CONTINUE 
           END-PERFORM
           ADD 2 TO DETAIL-LEN. 
           ADD 1 TO COMMENT-LEN.
  
       700-COMMENT-LOOP.
  
      * IF COMMENT IS TOO LONG FOR ONE LINE, SPLIT IT ON A WORD BOUNDARY
      * AND MOVE THE FIRST PART TO THE COMMENT-LINE.
           IF COMMENT-LEN > 79
           THEN 
             PERFORM VARYING PICK-IDX FROM 78 BY -1 
               UNTIL CAT-DETAIL (COMMENT-COL + PICK-IDX : 1) = SPACE
                 OR PICK-IDX < ZERO 
               CONTINUE 
             END-PERFORM
  
             IF PICK-IDX < ZERO 
             THEN 
               MOVE 79 TO PICK-IDX
             ELSE 
               ADD 1 TO PICK-IDX
             END-IF 
             MOVE CAT-DETAIL (COMMENT-COL : PICK-IDX) TO FILE-CMNT
             ADD PICK-IDX TO COMMENT-COL
             SUBTRACT PICK-IDX FROM COMMENT-LEN 
  
      * IF COMMENT FITS ON LINE, JUST MOVE IT.
           ELSE 
             MOVE CAT-DETAIL (COMMENT-COL : COMMENT-LEN) TO FILE-CMNT 
             MOVE ZERO TO COMMENT-LEN 
           END-IF 
  
      * MOVE LINE IMAGE INTO OUTPUT BUFFER AND CHECK IF IT'S FULL.
           MOVE FILE-COMMENT TO GTBL-CARD-IMAGE (GTBL-COUNT). 
           PERFORM OUTPUT-CHECK THRU OUTPUT-CHECK-XIT.
  
      * IF NOT FINISHED WITH COMMENT, GO BACK AND OUTPUT THE REST OF IT.
           IF COMMENT-LEN > ZERO
           THEN 
             ADD 1 TO GTBL-COUNT
             GO TO 700-COMMENT-LOOP 
           END-IF 
  
       OUTPUT-COMMENT-XIT.
           EXIT.
  
  
      ******************************************************************
      * 
      * OUTPUT-DMS. 
      * 
      * FILE CARD GENERATION USES SPECIALIZED OUTPUT ROUTINES, SO 
      * "OUTPUT-DMS" IS NOT NEEDED. 
  
       OUTPUT-DMS.
       OUTPUT-DMS-XIT.
           EXIT.
*CALL DMSVERS 
*CALL DMSIO 
*CALL DMSSAV1 
*CALL DMSSAV2 
*CALL DMSCON1 
*CALL DMSCONF 
